From e9d3954f9d6aab2173f8152e6a9ad936054873dd Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 25 Aug 2025 22:07:26 +0200 Subject: [PATCH 01/90] Implement a Lisp test suite runner. See test/1_dired.lsp for a demo test suite Run `make ltest` to execute it. --- makefile | 5 +++++ test/1_dired.lsp | 11 +++++++++++ test/tap.lsp | 32 ++++++++++++++++++++++++++++++++ 3 files changed, 48 insertions(+) create mode 100644 test/1_dired.lsp create mode 100644 test/tap.lsp diff --git a/makefile b/makefile index 3adb791..41fbded 100644 --- a/makefile +++ b/makefile @@ -121,6 +121,8 @@ replace.o: replace.c header.h search.o: search.c header.h $(CC) $(CPPFLAGS) $(CFLAGS) -c search.c +test.rc: test.sht lisp/core.lsp + undo.o: undo.c header.h $(CC) $(CPPFLAGS) $(CFLAGS) -c undo.c @@ -191,6 +193,9 @@ ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +8 lisp.c FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +6 lisp/core.lsp +ltest: femto test.rc + FEMTOLIB=lisp FEMTORC=test.rc FEMTO_DEBUG=1 FEMTO_BATCH=1 ./femto 3> test/test.out + test_core: test/core.lsp flisp <$< FLISPRC= FLISPLIB= ./flisp > test/core.now && sed 's/Stream 0x\(.\+\),/Stream /' test/core.now | diff -q - test/core.out test/core.out: test/core.lsp flisp diff --git a/test/1_dired.lsp b/test/1_dired.lsp new file mode 100644 index 0000000..113094f --- /dev/null +++ b/test/1_dired.lsp @@ -0,0 +1,11 @@ +;;; Note: dummy test suite; for now. +(defun dummy-1 () "failure simulation") +;;; Note: the following line would go into a macro '(test comment-string body)' +(setq tests (append tests (list (cons "dummy-1 this test always fails" dummy-1)))) + +(defun dummy-2 () "success simulation" nil) +(setq tests (append tests (list (cons "dummy-2 this test always succeeds" dummy-2)))) + +(defun dummy-3 () (throw 'we-just-fail-here "showcase of an error in a test function")) +(setq tests (append tests (list (cons "dummy-3 this test throws an error" dummy-3)))) + diff --git a/test/tap.lsp b/test/tap.lsp new file mode 100644 index 0000000..3071e2c --- /dev/null +++ b/test/tap.lsp @@ -0,0 +1,32 @@ +;;; Poor mans unit test framework in Femto Lisp + +(require 'core) + +(setq reportFd (open ">3")) + +(defun pr args + (map1 (lambda (o) (write o :stream reportFd)) args) + (write "\n" :stream reportFd)) + +(defmacro test (comment . body) + ;;; Note: my macro skills fail on me again, this does not work + (list 'setq 'tests (list 'append 'tests comment (list 'lambda () body)))) + +(defun ok (num test) + ;; Ok runs 'test' and prints out a TAP14 conform message + (let ((result (catch ((cdr test))))) + (cond ((car result) (pr "not ok " num " - " (car test) " test failed with '" (car result) ": " (cadr result))) + ((cond ((caddr result) (pr "not ok " num "- " (car test) " " (caddr result))) + ((pr "ok " num " - " (car test))))))) + (+ num 1)) + +(defun tap (suite) + (setq tests nil) + (let ((result (catch (load (concat "test/" suite)))) + (tests nil)) + (cond ((car result) (pr "error: failed to load test suite" suite ":" (cadr result))) + (t + (pr "TAP version 14") + (pr "1.." (length (caddr result))) + (pr "# " suite) + (fold-left ok 1 (caddr result)))))) From 859bb483098fea4c22ba6b058b14ff8238358101 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 26 Aug 2025 15:55:48 +0200 Subject: [PATCH 02/90] Add two dired tests to the dired test suite, print tests on stdout tap code is simplified: instead of appending a test to the test list it is prepended and the list of tests is reversed before iterating over it. This adds `reverse` and `flip` to the flisp library. --- docs/flisp.md | 48 +++++++++++++++++++++-------------------------- lisp/flisp.lsp | 3 +++ makefile | 2 +- pdoc/flisp.html | 4 ++++ test/1_dired.lsp | 18 +++++++++++++++--- test/3_flisp.test | 9 ++++++++- test/tap.lsp | 5 +++-- 7 files changed, 55 insertions(+), 34 deletions(-) diff --git a/docs/flisp.md b/docs/flisp.md index c95ea4d..e57a961 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -169,10 +169,9 @@ interpreter, extension functions behave the same as core functions. #### Syntax Program text is written as a sequence of symbolic expressions - -sexp's - in -parenthesized form. A [sexp](https://en.wikipedia.org/wiki/S-expression) -is either a single symbol or a sequence of symbols or sexp's enclosed in -parenthesis. +sexp's - in parenthesized form. A +[sexp](https://en.wikipedia.org/wiki/S-expression) is either a single +symbol or a sequence of symbols or sexp's enclosed in parenthesis. The following characters are special to the reader: @@ -184,8 +183,7 @@ Starts a function or macro invocation, a *list* or *cons* object (see Finishes a function invocation, *list* or *cons* object. `'` and `:` -With a single quote or a colon prefix before a -sexp, the sexp is +With a single quote or a colon prefix before a sexp, the sexp is expanded to `(quote «sexp»)` before it is evaluated. `.` @@ -747,14 +745,10 @@ only one *num* is given they all return `t`. This library implements commonly excpected Lisp idioms. *fLisp* implements a carefully selected minimum set of commonly used functions. -listp - -and - -or - -`(reduce «func» «list» «start»)` D - +listp +and +or +`(reduce «func» «list» «start»)` D `reduce` applies the binary *func* to the first element of *list* and *start* and then recursively to the first element of the rest of the *list* and the result of the previous invocation: it is “right binding”. @@ -762,19 +756,19 @@ or Since `reduce` is right associative and *start* is not optional, it differs significantly both from Common Lisp and Scheme. -max - -min - -nthcdr - -nth - -`(fold-right «func» «end» «list»)` Cs - -`(unfold «func» «init» «pred»)` Cs - -`(iota «count»[ «start»[ «step»]])` Cs +max +min +nthcdr +nth +`(fold-right «func» «end» «list»)` Cs +`(unfold «func» «init» «pred»)` Cs +`(iota «count»[ «start»[ «step»]])` Cs +`(flip «func»)` f +Returns a lambda which calls binary *func* with it's two arguments +reversed (flipped). + +`(reverse «l»)` +Returns a list with all elements of *l* in reverse order #### Standard Library diff --git a/lisp/flisp.lsp b/lisp/flisp.lsp index c5b0189..74597b0 100644 --- a/lisp/flisp.lsp +++ b/lisp/flisp.lsp @@ -64,4 +64,7 @@ (pred (lambda (n) (= 0 count)))) (unfold func start pred)))) +(defun flip (func) (lambda (o1 o2) (func o2 o1))) +(defun reverse (l) (fold-left (flip cons) nil l)) + (provide 'flisp) diff --git a/makefile b/makefile index 41fbded..4ae7e1d 100644 --- a/makefile +++ b/makefile @@ -194,7 +194,7 @@ ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +6 lisp/core.lsp ltest: femto test.rc - FEMTOLIB=lisp FEMTORC=test.rc FEMTO_DEBUG=1 FEMTO_BATCH=1 ./femto 3> test/test.out + FEMTOLIB=lisp FEMTORC=test.rc FEMTO_DEBUG=1 FEMTO_BATCH=1 ./femto 3>&1 test_core: test/core.lsp flisp <$< FLISPRC= FLISPLIB= ./flisp > test/core.now && sed 's/Stream 0x\(.\+\),/Stream /' test/core.now | diff -q - test/core.out diff --git a/pdoc/flisp.html b/pdoc/flisp.html index 40eda79..a2ca2bc 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -772,6 +772,10 @@

fLisp Library

(fold-right func end list) Cs
(unfold func init pred) Cs
(iota count[ start[ step]]) Cs
+
(flip func) f
+
Returns a lambda which calls binary func with it's two arguments reversed (flipped).
+
(reverse l)
+
Returns a list with all elements of l in reverse order

Standard Library

diff --git a/test/1_dired.lsp b/test/1_dired.lsp index 113094f..912a714 100644 --- a/test/1_dired.lsp +++ b/test/1_dired.lsp @@ -1,11 +1,23 @@ ;;; Note: dummy test suite; for now. (defun dummy-1 () "failure simulation") ;;; Note: the following line would go into a macro '(test comment-string body)' -(setq tests (append tests (list (cons "dummy-1 this test always fails" dummy-1)))) +(setq tests (cons (cons "dummy-1 this test always fails" dummy-1) tests)) +;;; Like this: +;;;(test "dummy-1 this test always fails" "failure simulation") +;;;(pr tests); debug (defun dummy-2 () "success simulation" nil) -(setq tests (append tests (list (cons "dummy-2 this test always succeeds" dummy-2)))) +(setq tests (cons (cons "dummy-2 this test always succeeds" dummy-2) tests)) (defun dummy-3 () (throw 'we-just-fail-here "showcase of an error in a test function")) -(setq tests (append tests (list (cons "dummy-3 this test throws an error" dummy-3)))) +(setq tests (cons (cons "dummy-3 this test throws an error" dummy-3) tests)) +(require 'dired) + +(defun de-up-dir-1 () + (cond ((not (eq (de-up-dir "/home/hugh") "/home"))))) +(setq tests (cons (cons "de-dir-up-1 moves up 1 subdir" de-up-dir-1) tests)) + +(defun de-up-dir-2 () + (cond ((not (eq (de-up-dir "/") "/"))))) +(setq tests (cons (cons "de-dir-up-2 root returns root" de-up-dir-2) tests)) diff --git a/test/3_flisp.test b/test/3_flisp.test index e014c30..8eb589e 100755 --- a/test/3_flisp.test +++ b/test/3_flisp.test @@ -178,7 +178,7 @@ flisplib 1; ok nth-1 yields element false; ok foldr-1 \# TODO -false; ok unfold-1 \# TODO +true; ok unfold-1 \# TODO unfold is tested by its application in iota IN="(iota 5)" OUT="(0 1 2 3 4)" flisplib 1; ok iota-1 iota count gives count @@ -189,6 +189,13 @@ flisplib 1; ok iota-1 iota count start gives count from start IN="(iota 5 10 2)" OUT="(10 12 14 16 18)" flisplib 1; ok iota-1 iota count step gives count from start by step +IN="((flip -) 2 3)" OUT="1" +flisplib 1; ok flip-1 flip - on '2-3' is 1 + +IN="(reverse '(1 2 3))" OUT="(3 2 1)" +flisplib 1; ok reverse-1 reverse 1 2 3 is 3 2 1 + + # Local Variables: # mode: sh diff --git a/test/tap.lsp b/test/tap.lsp index 3071e2c..c03e6ea 100644 --- a/test/tap.lsp +++ b/test/tap.lsp @@ -10,7 +10,8 @@ (defmacro test (comment . body) ;;; Note: my macro skills fail on me again, this does not work - (list 'setq 'tests (list 'append 'tests comment (list 'lambda () body)))) + ;;; want: `(setq tests (cons (cons ,comment (lambda () ,body)) tests)) + (list 'setq 'tests (list 'cons (list 'cons comment (list 'lambda '() body)) 'tests))) (defun ok (num test) ;; Ok runs 'test' and prints out a TAP14 conform message @@ -29,4 +30,4 @@ (pr "TAP version 14") (pr "1.." (length (caddr result))) (pr "# " suite) - (fold-left ok 1 (caddr result)))))) + (fold-left ok 1 (reverse (caddr result))))))) From bcc738ce64128df923a853957530c8e43175908b Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 19:28:52 +0200 Subject: [PATCH 03/90] Integrated femto testing in test suite The `run` test suite runner is renamed to `test` and it got proper command line parsing. All test suites must be named *.test. The first line determines if it is to be tested by poor mans shell test runner within flips or by the Lisp implementation tap.lsp within femto. The first line must contain the Emacs mode string: -*- mode: _type_ -*- where type is `sh` for flisp and `lisp` for femto. `tap.lsp` has a simple command line parser to specifiy the test(s) to run. For writing test scripts: Write a function which returns a true value if the test passes. Register the function and a test comment with tap.lsp: `(tap-register comment function)` --- makefile | 30 +++++++------ misc/ROADMAP.flisp.txt | 9 ++-- test/1_dired.lsp | 23 ---------- test/1_primitives.test | 8 +--- test/2_core.test | 7 +-- test/3_flisp.test | 8 +--- test/4_stdlib.test | 7 +-- test/5_femto.test | 8 +--- test/6_string.test | 2 +- test/7_dired.test | 27 ++++-------- test/run | 99 ------------------------------------------ test/tap.lsp | 14 +++--- test/test.sht | 31 +++++++++++++ 13 files changed, 79 insertions(+), 194 deletions(-) delete mode 100644 test/1_dired.lsp mode change 100755 => 100644 test/7_dired.test delete mode 100755 test/run create mode 100644 test/test.sht diff --git a/makefile b/makefile index 4ae7e1d..b975d43 100644 --- a/makefile +++ b/makefile @@ -121,8 +121,6 @@ replace.o: replace.c header.h search.o: search.c header.h $(CC) $(CPPFLAGS) $(CFLAGS) -c search.c -test.rc: test.sht lisp/core.lsp - undo.o: undo.c header.h $(CC) $(CPPFLAGS) $(CFLAGS) -c undo.c @@ -182,9 +180,22 @@ run: femto FORCE splint: FORCE splint +posixlib -macrovarprefix "M_" *.c *.h -test: flisp femto FORCE - (cd test && SUMMARY=1 ./run) +test: flisp femto test/test.rc FORCE + @(cd test && ./test -as) + +# Exit 1 if any testsuite fails +check: flisp femto test/test.rc FORCE + @(cd test && ./test -sa | grep tests, | \ + while read RESULT; do \ + RESULT=$${RESULT#* tests, }; \ + RESULT=$${RESULT% failures*}; \ + [ "$$RESULT" = 0 ] || { echo failed >&2; exit 1; } \ + done ) + +test/test.rc: test/test.sht lisp/core.lsp + +# Manually test femto invocation and review syntax highlighting ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto _no_file_ @@ -193,14 +204,6 @@ ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +8 lisp.c FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +6 lisp/core.lsp -ltest: femto test.rc - FEMTOLIB=lisp FEMTORC=test.rc FEMTO_DEBUG=1 FEMTO_BATCH=1 ./femto 3>&1 - -test_core: test/core.lsp flisp - <$< FLISPRC= FLISPLIB= ./flisp > test/core.now && sed 's/Stream 0x\(.\+\),/Stream /' test/core.now | diff -q - test/core.out -test/core.out: test/core.lsp flisp - <$< FLISPRC= FLISPLIB= ./flisp | sed 's/Stream 0x\(.\+\),/Stream /' > test/core.out - val: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 valgrind ./femto 2> val.log @@ -212,9 +215,10 @@ clean: FORCE -$(RM) -f $(OBJ) $(FLISP_OBJ) $(BINARIES) $(RC_FILES) -$(RM) -rf doxygen -$(RM) -f $(MOREDOCS) - -$(RM) -f val.log debug.out f.log test/f.log + -$(RM) -f val.log debug.out f.log -$(RM) -rf debian/femto debian/files \ debian/femto.debhelper.log debian/femto.substvars + -$(RM) -f test/test.rc test/debug.out deb: FORCE dpkg-buildpackage -b -us -uc diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index ce74423..923d289 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -4,20 +4,23 @@ + Implement type-of, curry and move all type predicates except null and consp from C to Lisp. + Add search to string library + implement fold ++ start a test library ++ Move string-to-number to Lisp by using (read f) from a memory stream. ++ Fix string library, - Showcase lisp_eval2 with (catch (fread)) mechanism - Implement fstat and improve femto.rc - Implement mkdir and fix file save bug -- Move string-to-number to Lisp by using (read f) from a memory stream. +- Implement popen, pclose +- improve/support batch mode: output = stdout +- expose envSet to Lisp and move setq from C to Lisp - Implement backquote and friends - Fix reduce, implement map, consider simplifying core functions and make them n-ary in Lisp. -- Fix string library, - Unify stdlib into flisp.lsp - Implement simple repl in Lisp - needs getline - isatty() can set an 'interactive' flag - rename global argv to command-line-args, argv0 to invocation-name - rename os.env to getenv -- improve/support batch mode, start a test library - make extensions plugable - test more then one interpreter - ? CSP between interpreters? diff --git a/test/1_dired.lsp b/test/1_dired.lsp deleted file mode 100644 index 912a714..0000000 --- a/test/1_dired.lsp +++ /dev/null @@ -1,23 +0,0 @@ -;;; Note: dummy test suite; for now. -(defun dummy-1 () "failure simulation") -;;; Note: the following line would go into a macro '(test comment-string body)' -(setq tests (cons (cons "dummy-1 this test always fails" dummy-1) tests)) -;;; Like this: -;;;(test "dummy-1 this test always fails" "failure simulation") -;;;(pr tests); debug - -(defun dummy-2 () "success simulation" nil) -(setq tests (cons (cons "dummy-2 this test always succeeds" dummy-2) tests)) - -(defun dummy-3 () (throw 'we-just-fail-here "showcase of an error in a test function")) -(setq tests (cons (cons "dummy-3 this test throws an error" dummy-3) tests)) - -(require 'dired) - -(defun de-up-dir-1 () - (cond ((not (eq (de-up-dir "/home/hugh") "/home"))))) -(setq tests (cons (cons "de-dir-up-1 moves up 1 subdir" de-up-dir-1) tests)) - -(defun de-up-dir-2 () - (cond ((not (eq (de-up-dir "/") "/"))))) -(setq tests (cons (cons "de-dir-up-2 root returns root" de-up-dir-2) tests)) diff --git a/test/1_primitives.test b/test/1_primitives.test index 4a9cb1d..8501d0e 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -1,4 +1,5 @@ -#!./run +#!./test # -*- mode: sh -*- +# # test executable and fLisp functionality # leg20231128: Femto @@ -458,8 +459,3 @@ false; ok file extension \# TODO # Femto editor extension false; ok femto editor extension \# TODO - - -# Local Variables: -# mode: sh -# End: diff --git a/test/2_core.test b/test/2_core.test index 5cf0e7a..7294abf 100755 --- a/test/2_core.test +++ b/test/2_core.test @@ -1,4 +1,4 @@ -#!./run +#!./test # -*- mode: sh -*- # test the fLisp core library # leg20231129: Femto @@ -264,8 +264,3 @@ flisp_expr 2; ok require-3 requiring existing feature returns feature IN="(require 'flisp)" OUT="(core) flisp" flisp_expr 2; ok require-4 requiring new feature returns feature - - -# Local Variables: -# mode: sh -# End: diff --git a/test/3_flisp.test b/test/3_flisp.test index 8eb589e..14db3d2 100755 --- a/test/3_flisp.test +++ b/test/3_flisp.test @@ -1,4 +1,4 @@ -#!./run +#!./test# -*- mode: sh -*- # test the fLisp library # leg20231129: Femto tap 56 @@ -194,9 +194,3 @@ flisplib 1; ok flip-1 flip - on '2-3' is 1 IN="(reverse '(1 2 3))" OUT="(3 2 1)" flisplib 1; ok reverse-1 reverse 1 2 3 is 3 2 1 - - - -# Local Variables: -# mode: sh -# End: diff --git a/test/4_stdlib.test b/test/4_stdlib.test index c7c49d1..b28213e 100755 --- a/test/4_stdlib.test +++ b/test/4_stdlib.test @@ -1,4 +1,5 @@ -#!./run +#!./test# -*- mode: sh -*- +# # test the Lisp standard library # leg20231129 tap 16 @@ -61,7 +62,3 @@ stdlib 1; ok print-1 write string escaped # princ IN='(write "ans\\wer")' OUT='ans\wer"ans\\wer"' stdlib 1; ok princ-1 write string unescaped - -# Local Variables: -# mode: sh -# End: diff --git a/test/5_femto.test b/test/5_femto.test index ff23efc..936bebf 100755 --- a/test/5_femto.test +++ b/test/5_femto.test @@ -1,4 +1,5 @@ -#!./run +#!./test# -*- mode: sh -*- +# # test the femto Lisp extensions # leg20231213 @@ -31,8 +32,3 @@ false; ok describe-key \# TODO false; ok find_end_p \# TODO false; ok find_start_p \# TODO false; ok find_and_eval_sexp \# TODO - - -# Local Variables: -# mode: sh -# End: diff --git a/test/6_string.test b/test/6_string.test index f4212f0..a98bec1 100755 --- a/test/6_string.test +++ b/test/6_string.test @@ -1,4 +1,4 @@ -#!./run +#!./test # -*- mode: sh -*- # test executable and fLisp functionality # leg20231128: Femto diff --git a/test/7_dired.test b/test/7_dired.test old mode 100755 new mode 100644 index dab33e6..cd62476 --- a/test/7_dired.test +++ b/test/7_dired.test @@ -1,22 +1,11 @@ -#!./run -# test executable and dired functionality -# Created By Hugh Barney 24 August 2025 +;; -*- mode: lisp -*- -# we set the FLISPRC to dired.lsp, not sure ? -export FLISPRC=../lisp/dired.lsp +(require 'dired) -# The tap value should be set to the number of tests in the file -tap 2 - -# define sub functions to be used in this test file -stringlib() { IN="(require 'string) $IN" flisp_expr "$@"; } -stringlib_err() { IN="(require 'string) $IN" flisp_err "$@"; } - -# test 1 -IN='(de-dir-up "/home/hugh")' OUT='"/home"' -stringlib 1; ok de-dir-up-1 moves up 1 subdir - -# test 2, check that de-dir-up returns / when there is only 1 character in the path -IN='(de-dir-up "/")' OUT='"/"' -stringlib 2; ok de-dir-up-2 1 char path returns root +(defun de-up-dir-1 () + (eq (de-up-dir "/home/hugh") "/home")) +(tap-register "de-dir-up-1 moves up 1 subdir" de-up-dir-1) +(defun de-up-dir-2 () + (eq (de-up-dir "/") "/")) +(tap-register "de-up-dir-2 root returns root" de-up-dir-2) diff --git a/test/run b/test/run deleted file mode 100755 index a09991a..0000000 --- a/test/run +++ /dev/null @@ -1,99 +0,0 @@ -#!/bin/sh -# leg20231128 -# -# Poor mans unit test framework -# - -: ${VERBOSE:=} -FLISP=../flisp - - -[ "$1" = "-?" ] && { - cat <&1 | tail -n ${1:-5} |{ - read PRE REST - : $PRE - : $REST - MSG=${REST#*, } - [ "$OBJ" ] && { - EOBJ=${REST%%\',*} - EOBJ=${EOBJ#\'} - [ "$PRE" = "error:" -a "$MSG" = "$ERR" -a "$OBJ" = "$EOBJ" ] - RC=$? ERR= OBJ= - return $RC - } - [ "$PRE" = "error:" -a "$MSG" = "$ERR" ] - RC=$? PRE= OBJ= - return $RC - } -} - -femto_expr () { - [ "$( echo -n "$IN" | FEMTO_BATCH=1 FEMTORC=- FEMTOLIB=$FLISP ../femto | tail -n $(($1+3)) )" = "$OUT -t" ] -} -femto_err () { - [ "$( echo -n "$IN" | FEMTO_BATCH=1 FEMTORC=- FEMTOLIB=$FLISP ../femto | tail -n $(($1+3)) )" = "$OUT -nil" ] -} - -if [ "$SUMMARY" ]; then SUMMARY=./tapview; else SUMMARY=cat; fi - -for test; do ( - #mkdir -p tmp - #rm -rf tmp/* - - export FEMTOLIB=../lisp - export FLISPLIB=../lisp - echo testsuite: $test - [ "$VERBOSE" ] && set -x - . ./${test} | $SUMMARY - set +x -); done -#rm -rf tmp diff --git a/test/tap.lsp b/test/tap.lsp index c03e6ea..024842b 100644 --- a/test/tap.lsp +++ b/test/tap.lsp @@ -8,26 +8,28 @@ (map1 (lambda (o) (write o :stream reportFd)) args) (write "\n" :stream reportFd)) -(defmacro test (comment . body) +;(defmacro test (comment . body) ;;; Note: my macro skills fail on me again, this does not work ;;; want: `(setq tests (cons (cons ,comment (lambda () ,body)) tests)) - (list 'setq 'tests (list 'cons (list 'cons comment (list 'lambda '() body)) 'tests))) +; (list 'setq 'tests (list 'cons (list 'cons comment (list 'lambda '() body)) 'tests))) + +(defun tap-register (comment test) + (setq tests (cons (cons comment (lambda () (null (test)))) tests))) (defun ok (num test) ;; Ok runs 'test' and prints out a TAP14 conform message (let ((result (catch ((cdr test))))) (cond ((car result) (pr "not ok " num " - " (car test) " test failed with '" (car result) ": " (cadr result))) - ((cond ((caddr result) (pr "not ok " num "- " (car test) " " (caddr result))) + ((cond ((caddr result) (pr "not ok " num " - " (car test) " " (caddr result))) ((pr "ok " num " - " (car test))))))) (+ num 1)) (defun tap (suite) (setq tests nil) - (let ((result (catch (load (concat "test/" suite)))) - (tests nil)) + (let ((result (catch (load suite)))) (cond ((car result) (pr "error: failed to load test suite" suite ":" (cadr result))) (t (pr "TAP version 14") (pr "1.." (length (caddr result))) (pr "# " suite) - (fold-left ok 1 (reverse (caddr result))))))) + (fold-left ok 1 (reverse tests)))))) diff --git a/test/test.sht b/test/test.sht new file mode 100644 index 0000000..610c60f --- /dev/null +++ b/test/test.sht @@ -0,0 +1,31 @@ +;; -*-Lisp-*- +;; +;; flisp/femto test suite startup file + +$(cat lisp/core.lsp) + +(require 'flisp) +(require 'stdlib) + +(load "tap.lsp") ; poor mans test framework + +(defun usage () + (pr "test [testsuite ..] - run the named testsuites +test -a - run all testsuites +test [-?|-h|-help] - this help text")) + +(defun argv-opt (o) + (cond + ((null o)) + ((memq o '("-?" "-h" "--help")) (usage)) + ((tap o)))) + +(defun argv-parse (opts) + (cond + ((null opts)) + (t + (argv-opt (car opts)) + (argv-parse (cdr opts))))) + +(cond ((null argv) (usage)) + ((argv-parse argv))) From 5206ff5984d512cc2c0533b0e0c4940c7a9629ef Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 19:29:54 +0200 Subject: [PATCH 04/90] Simplify the or macro --- lisp/flisp.lsp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/flisp.lsp b/lisp/flisp.lsp index 74597b0..8d1de0a 100644 --- a/lisp/flisp.lsp +++ b/lisp/flisp.lsp @@ -12,8 +12,7 @@ ((null (cdr args)) (car args)) (t (list 'cond (list (car args) (cons 'and (cdr args))))))) -(defmacro or args - (cond (args (cons (quote cond) (map1 list args))))) +(defmacro or args (cons 'cond (map1 list args))) (defun reduce (func seq start) (cond ((null seq) start) From 9d6b66c18a434a7581719c027c014cdd7c8d3ef4 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 22:22:15 +0200 Subject: [PATCH 05/90] Fix: add renamed/missing test script --- test/test | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100755 test/test diff --git a/test/test b/test/test new file mode 100755 index 0000000..6e57252 --- /dev/null +++ b/test/test @@ -0,0 +1,177 @@ +#!/bin/sh +# leg20231128 +# +# Poor mans unit test framework +# + +# Augmented for testing fLisp and femto +# +# fLisp is tested via the flisp command line interpreter, the femto +# editor extensions via the batch mode of femto. +# +# The test files must have an extension .test and the first line must +# indicate if the test is run with flisp or with femto: +# +# fLisp test files are written in POSIX shell and start with a hash: # +# femto test files are written in Lisp and start with a semicolon: ; +# +# In summary mode test output is filtered through ESR's tapview +# program, to get a progress indication and then a summary of +# successful, failed and skipped tests. +# +# Debugging of fLisp test files is done by setting the environment +# variable VERBOSE to 1. +# +# femto test files are run with FEMTO_DEBUG set, debug output is +# written to the file debug.out. +# +# Get information on how to run with the -? command line option. + +: ${VERBOSE:=} +: ${SUMMARY:=} +: ${TEST_ALL=} + +FLISP=../flisp +FLISP_DEBUG= +FEMTO_DEBUG= + +usage () { + cat <&1 | tail -n ${1:-5} |{ + read PRE REST + : $PRE + : $REST + MSG=${REST#*, } + [ "$OBJ" ] && { + EOBJ=${REST%%\',*} + EOBJ=${EOBJ#\'} + [ "$PRE" = "error:" -a "$MSG" = "$ERR" -a "$OBJ" = "$EOBJ" ] + RC=$? ERR= OBJ= + return $RC + } + [ "$PRE" = "error:" -a "$MSG" = "$ERR" ] + RC=$? PRE= OBJ= + return $RC + } +} + +test_femto () { + FEMTOLIB=../lisp FEMTORC=test.rc FEMTO_BATCH=1 ../femto "$@" 3>&1 +} + + +if [ "$SUMMARY" ]; then SUMMARY=./tapview; else SUMMARY=cat; fi + +[ "$TEST_ALL" = 1 ] && set -- *.test + +[ $# = 0 ] && { + echo "error: no test file(s) specified\n" + usage +} +echo $@ + +for test; do ( + #mkdir -p tmp + #rm -rf tmp/* + + echo testsuite: $test + + TEST_TYPE="$(head -1 $test)" + TEST_TYPE=${TEST_TYPE#*mode: } + TEST_TYPE=${TEST_TYPE% -\*-*} + case "$TEST_TYPE" in + lisp) + [ "$VERBOSE" ] && set -x + FEMTOLIB=../lisp FEMTORC=test.rc FEMTO_BATCH=1 \ + ../femto $test 3>&1 | $SUMMARY + ;; + sh) + export FLISPLIB=../lisp + [ "$VERBOSE" ] && set -x + . ./${test} | $SUMMARY + ;; + *) + echo error: cannot detect type of testsuite >&2 + exit 1 + ;; + esac + set +x +); done +#rm -rf tmp From 07d7061ccfc6d904c2c36d0b3c24ea56b544d529 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 22:27:41 +0200 Subject: [PATCH 06/90] Update string tests to match new function names --- test/6_string.test | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/test/6_string.test b/test/6_string.test index a98bec1..aa30855 100755 --- a/test/6_string.test +++ b/test/6_string.test @@ -71,17 +71,17 @@ IN='(string-startswith "abcde" "cd")' OUT='nil' stringlib 1; ok string-startswith-4 string starts not with start string is nil -IN='(string-drop_first "")' OUT='""' -stringlib 1; ok string-drop_first-1 drop from empty string is empty string +IN='(string-shrink-right "")' OUT='""' +stringlib 1; ok string-shrink-right-1 drop from empty string is empty string -IN='(string-drop_first "abcde")' OUT='"bcde"' -stringlib 1; ok string-drop_first-2 drop from string is on char less +IN='(string-shrink-right "abcde")' OUT='"bcde"' +stringlib 1; ok string-shrink-right-2 drop from string is on char less -IN='(shrink "")' OUT='""' -stringlib 1; ok string-shrink-1 shrink from empty string is empty string +IN='(string-shrink-left "")' OUT='""' +stringlib 1; ok string-string-shrink-left-1 string-shrink-left from empty string is empty string -IN='(shrink "abcde")' OUT='"abcd"' -stringlib 1; ok string-shrink-2 shrink from string is on char less +IN='(string-shrink-left "abcde")' OUT='"abcd"' +stringlib 1; ok string-string-shrink-left-2 string-shrink-left from string is on char less IN='(string-contains "" "")' OUT='nil' stringlib 1; ok string-contains-1 emtpy string is not contained in empty string From 8b1ff550d5cf70ace5a2404b5aa01cb40a9be0cc Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 23:31:23 +0200 Subject: [PATCH 07/90] Add bitwise integer arithmetic Will need this for file mode operations. --- docs/flisp.md | 33 ++++++++++++++++++++++----- femto.sht | 4 +--- flisp.sht | 4 +--- lisp.c | 34 +++++++++++++++++++++++++++- lisp/startup.lsp | 2 +- pdoc/flisp.html | 18 +++++++++++++++ test/1_primitives.test | 51 ++++++++++++++++++++++++++++++------------ test/3_flisp.test | 2 +- 8 files changed, 120 insertions(+), 28 deletions(-) diff --git a/docs/flisp.md b/docs/flisp.md index e57a961..eb380a0 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -50,7 +50,8 @@ This manual refers to version 0.6 or later of fLisp. 2. [Input / Output and Others](#in_out) 3. [Object Operations](#object_ops) 4. [Arithmetic Operations](#arithmetic_ops) - 5. [String Operations](#string_ops) + 5. [Bitwise Integer Operations](#bitwise_ops) + 6. [String Operations](#string_ops) 6. [Double Extension](#double) 7. [Lisp Libraries](#libraries) 1. [Library Loading](#startup) @@ -169,9 +170,10 @@ interpreter, extension functions behave the same as core functions. #### Syntax Program text is written as a sequence of symbolic expressions - -sexp's - in parenthesized form. A -[sexp](https://en.wikipedia.org/wiki/S-expression) is either a single -symbol or a sequence of symbols or sexp's enclosed in parenthesis. +sexp's - in +parenthesized form. A [sexp](https://en.wikipedia.org/wiki/S-expression) +is either a single symbol or a sequence of symbols or sexp's enclosed in +parenthesis. The following characters are special to the reader: @@ -183,7 +185,8 @@ Starts a function or macro invocation, a *list* or *cons* object (see Finishes a function invocation, *list* or *cons* object. `'` and `:` -With a single quote or a colon prefix before a sexp, the sexp is +With a single quote or a colon prefix before a +sexp, the sexp is expanded to `(quote «sexp»)` before it is evaluated. `.` @@ -516,6 +519,26 @@ Returns the rest (modulo) of the integer division of *i* by *j*. Throws These predicate functions apply the respective comparison operator between *i* *j*. +#### Bitwise Integer Operations + +`(& «i» «j»)` +Returns the bitwise and operation on *i* and *j*. + +`(| «i» «j»)` +Returns the bitwise or operation on *i* and *j*. + +`(^ «i» «j»)` +Returns the bitwise xor operation on *i* and *j*. + +`(<< «i» «j»)` +Returns *i* shift left by *j* bits. + +`(>> «i» «j»)` +Returns *i* shift right by *j* bits. + +`(~ «i»)` +Returns the bitwise negation of *i*. + #### String Operations `(string-length «string»)` diff --git a/femto.sht b/femto.sht index 001fcd9..3ab28b7 100644 --- a/femto.sht +++ b/femto.sht @@ -13,9 +13,7 @@ $(cat lisp/core.lsp) ;; Batch mode processing and Femto editor startup -(setq - ~ (os.getenv "HOME") - env-batch-mode (os.getenv "FEMTO_BATCH")) +(setq env-batch-mode (os.getenv "FEMTO_BATCH")) (cond ((eq "0" env-batch-mode) (require 'startup)) diff --git a/flisp.sht b/flisp.sht index 8ac0ead..2220a46 100644 --- a/flisp.sht +++ b/flisp.sht @@ -5,9 +5,7 @@ $(cat lisp/core.lsp) ;; flisp initialzation -(setq - ~ (os.getenv "HOME") - config_file (concat ~ "/" ".config/flisp/flisp.rc")) +(setq config_file (concat ~ "/" ".config/flisp/flisp.rc")) (defun getopts (opts pos) (setq o (car opts)) diff --git a/lisp.c b/lisp.c index 11a0539..97eec71 100644 --- a/lisp.c +++ b/lisp.c @@ -807,7 +807,7 @@ int streamUngetc(Interpreter *interp, FILE *fd, int c) // Begin helpers ////////// int isSymbolChar(int ch) { - static const char *valid = "!#$%&*+-./:<=>?@^_~"; + static const char *valid = "!#$%&*+-./:<=>?@^_|~"; return isalnum(ch) || strchr(valid, ch); } @@ -1893,6 +1893,32 @@ Object *integerGreaterEqual(Interpreter *interp, Object **args, Object **env) return (FLISP_ARG_ONE->integer >= FLISP_ARG_TWO->integer) ? t : nil; } +// Integer bit operations ////// +Object *integerAnd(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer & FLISP_ARG_TWO->integer); +} +Object *integerOr(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer | FLISP_ARG_TWO->integer); +} +Object *integerXor(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer ^ FLISP_ARG_TWO->integer); +} +Object *integerShiftLeft(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer << FLISP_ARG_TWO->integer); +} +Object *integerShiftRight(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer >> FLISP_ARG_TWO->integer); +} +Object *integerNot(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, ~FLISP_ARG_ONE->integer); +} + // STREAMS ////////////////////////////////////////////////// @@ -2241,6 +2267,12 @@ Primitive primitives[] = { {"i<=", 2, 2, TYPE_INTEGER, integerLessEqual}, {"i>", 2, 2, TYPE_INTEGER, integerGreater}, {"i>=", 2, 2, TYPE_INTEGER, integerGreaterEqual}, + {"&", 2, 2, TYPE_INTEGER, integerAnd}, + {"|", 2, 2, TYPE_INTEGER, integerOr}, + {"^", 2, 2, TYPE_INTEGER, integerXor}, + {"<<", 2, 2, TYPE_INTEGER, integerShiftLeft}, + {">>", 2, 2, TYPE_INTEGER, integerShiftRight}, + {"~", 1, 1, TYPE_INTEGER, integerNot}, {"string-equal", 2, 2, TYPE_STRING, stringEqual}, {"string-length", 1, 1, TYPE_STRING, stringLength}, {"string-append", 2, 2, TYPE_STRING, stringAppend}, diff --git a/lisp/startup.lsp b/lisp/startup.lsp index a768f94..1603b71 100644 --- a/lisp/startup.lsp +++ b/lisp/startup.lsp @@ -38,7 +38,7 @@ (t (throw wrong-type-argument "(getopts opts pos) - opts must be list")))) (defun confn(fn) - (concat ~ "/" config_dir "/" fn)) + (concat (os.getenv "HOME") "/" config_dir "/" fn)) (defun edit-config() (find-file (confn config_file))) diff --git a/pdoc/flisp.html b/pdoc/flisp.html index a2ca2bc..b7a834f 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -67,6 +67,7 @@

Table of Contents

  • Input / Output and Others
  • Object Operations
  • Arithmetic Operations
    • +
  • Bitwise Integer Operations
  • String Operations
  • Double Extension
    • @@ -523,6 +524,23 @@

    Arithmetic Operations

    +

    Bitwise Integer Operations

    + +
    +
    (& i j)
    +
    Returns the bitwise and operation on i and j.
    +
    (| i j)
    +
    Returns the bitwise or operation on i and j.
    +
    (^ i j)
    +
    Returns the bitwise xor operation on i and j.
    +
    (<< i j)
    +
    Returns i shift left by j bits.
    +
    (>> i j)
    +
    Returns i shift right by j bits.
    +
    (~ i)
    +
    Returns the bitwise negation of i.
    +
    +

    String Operations

    diff --git a/test/1_primitives.test b/test/1_primitives.test index 8501d0e..049881b 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -5,7 +5,7 @@ export FLISPRC= -tap 150 +tap 161 [ -x ../femto ] ok femto-1 femto exists and is executable; @@ -33,7 +33,22 @@ IN='\\' OBJ="nil" ERR="unexpected character, \`'" flisp_err; ok reader-3 unexpected character error msg IN="0" OUT='0' -flisp_expr; ok reader-4 read number +flisp_expr; ok reader-4-1 read integer 0 + +IN="10" OUT='10' +flisp_expr; ok reader-4-2 read integer 10 + +IN="010" OUT='8' +flisp_expr; ok reader-4-3 read integer octal 10 is 8 + +IN="0x10" OUT='16' +flisp_expr; ok reader-4-4 read integer hex 10 is 16 + +IN=".1" OUT='0.1' +flisp_expr; ok reader-4-5 read double .1 is 0.1 + +IN="3.14" OUT='3.14' +flisp_expr; ok reader-4-6 read double 3.14 is 3.14 IN="t" OUT='t' flisp_expr; ok reader-5 read constant t @@ -368,18 +383,26 @@ flisp_err; ok throw-1_1 throw w/o object IN="(throw 'fourty-three \"answer\" 1)" ERR='answer' OBJ=1 flisp_err; ok throw-1_2 throw with object -## Math - -IN='(i+ 42 7)' OUT='49' flisp_expr; ok add-3 add 42 7 is 49 -IN='(i- 42 7)' OUT='35' flisp_expr; ok minus-3 minus 42 7 is 35 -IN='(i* 42 7)' OUT='294' flisp_expr; ok times-3 times 42 7 is 294 -IN='(i/ 42 7)' OUT='6' flisp_expr; ok divide-2 divide 42 7 is 6 -IN='(i% 42 5)' OUT='2' flisp_expr; ok mod-2 mod 42 5 is 2 -IN='(i= 42 7)' OUT='nil' flisp_expr; ok arith-equal-2 arith-equal 42 7 is nil -IN='(i< 7 42)' OUT='t' flisp_expr; ok less-2 less 7 42 is t -IN='(i<= 42 7)' OUT='nil' flisp_expr; ok less-equal-2 less-equal 42 7 is nil -IN='(i> 42 7)' OUT='t' flisp_expr; ok greater-2 greater 42 7 is t -IN='(i>= 7 42)' OUT='nil' flisp_expr; ok greater-equal-2 greater-equal 7 42 is t +## Integer arithmetic + +IN='(i+ 42 7)' OUT='49' flisp_expr; ok add-1 add 42 7 is 49 +IN='(i- 42 7)' OUT='35' flisp_expr; ok minus-1 minus 42 7 is 35 +IN='(i* 42 7)' OUT='294' flisp_expr; ok times-1 times 42 7 is 294 +IN='(i/ 42 7)' OUT='6' flisp_expr; ok divide-1 divide 42 7 is 6 +IN='(i% 42 5)' OUT='2' flisp_expr; ok mod-1 mod 42 5 is 2 +IN='(i= 42 7)' OUT='nil' flisp_expr; ok arith-equal-1 arith-equal 42 7 is nil +IN='(i< 7 42)' OUT='t' flisp_expr; ok less-1 less 7 42 is t +IN='(i<= 42 7)' OUT='nil' flisp_expr; ok less-equal-1 less-equal 42 7 is nil +IN='(i> 42 7)' OUT='t' flisp_expr; ok greater-1 greater 42 7 is t +IN='(i>= 7 42)' OUT='nil' flisp_expr; ok greater-equal-1 greater-equal 7 42 is t + +## Integer bitwise +IN='(& 7 2)' OUT='2' flisp_expr; ok and-1 and 7 2 is 2 +IN='(| 2 5)' OUT='7' flisp_expr; ok or-1 or 2 5 is 7 +IN='(^ 2 7)' OUT='5' flisp_expr; ok xor-1 xor 2 7 is 5 +IN='(<< 1 3)' OUT='8' flisp_expr; ok left-shift-1 left shift 1 3 is 8 +IN='(>> 8 3)' OUT='1' flisp_expr; ok right-shift-1 right shift 8 3 is 1 +IN='(~ 7)' OUT='-8' flisp_expr; ok not-1 not 7 is -8 ## Strings diff --git a/test/3_flisp.test b/test/3_flisp.test index 14db3d2..d0ee789 100755 --- a/test/3_flisp.test +++ b/test/3_flisp.test @@ -1,7 +1,7 @@ #!./test# -*- mode: sh -*- # test the fLisp library # leg20231129: Femto -tap 56 +tap 58 export FLISPRC=../lisp/core.lsp flisplib() { IN="(require 'flisp) $IN" flisp_expr "$@"; } From e4150a97cdbb65468c5fdfb226a3446ecd7dd6fe Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 23:31:50 +0200 Subject: [PATCH 08/90] Extend reader to accept hex notation 0xnn --- lisp.c | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp.c b/lisp.c index 97eec71..3df2f00 100644 --- a/lisp.c +++ b/lisp.c @@ -1021,9 +1021,17 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) (void)addCharToBuf(interp, streamGetc(interp, fd)); ch = streamPeek(interp, fd); } - // try to read a number in integer or decimal format - // Note: readInteger support hex and octal, but we do not support it here. + // Try to read a number in integer or decimal (float) format. + // C notation applies: 010 = 8, 0x10 = 16 if (ch == '.' || isdigit(ch)) { + if (ch == '0') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + if (ch == 'x') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + } + } if (isdigit(ch)) ch = readWhile(interp, fd, isdigit); if (!isSymbolChar(ch)) From 3dce275340e494b33c67c5d162cfa1ba25e689bb Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 23:31:50 +0200 Subject: [PATCH 09/90] Extend reader to accept hex notation 0xnn --- lisp.c | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp.c b/lisp.c index 97eec71..3df2f00 100644 --- a/lisp.c +++ b/lisp.c @@ -1021,9 +1021,17 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) (void)addCharToBuf(interp, streamGetc(interp, fd)); ch = streamPeek(interp, fd); } - // try to read a number in integer or decimal format - // Note: readInteger support hex and octal, but we do not support it here. + // Try to read a number in integer or decimal (float) format. + // C notation applies: 010 = 8, 0x10 = 16 if (ch == '.' || isdigit(ch)) { + if (ch == '0') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + if (ch == 'x') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + } + } if (isdigit(ch)) ch = readWhile(interp, fd, isdigit); if (!isSymbolChar(ch)) From eeabf50d6ab45cb92ca1a5577c266f07b7e498b4 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 23:33:21 +0200 Subject: [PATCH 10/90] Fix: remove incorrect comment --- lisp.c | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp.c b/lisp.c index 3df2f00..218929e 100644 --- a/lisp.c +++ b/lisp.c @@ -882,7 +882,6 @@ Object *readInteger(Interpreter *interp) addCharToBuf(interp, '\0'); errno = 0; - /* Note: we allow hex and octal scanning, but the reader does not support it */ n = strtoimax(interp->buf, NULL, 0); if (errno == ERANGE) exception(interp, range_error, "integer out of range,: %"PRId64, n); From ab1e3387891947f03f24a0612afdc757b8b37579 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 27 Aug 2025 23:49:27 +0200 Subject: [PATCH 11/90] Prepare reader for macro templates. --- lisp.c | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lisp.c b/lisp.c index 218929e..2b98afe 100644 --- a/lisp.c +++ b/lisp.c @@ -1149,6 +1149,17 @@ Object *readExpr(Interpreter *interp, FILE *fd) return NULL; else if (ch == '\'' || ch == ':') return readUnary(interp, fd, "quote"); + else if (ch == '`') + return readUnary(interp, fd, "quasiquote"); + else if (ch == ',') { + ch = streamPeek(interp, fd); + if (ch == '@') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + return readUnary(interp, fd, "splice-unquote"); + } + else + return readUnary(interp, fd, "unquote"); + } else if (ch == '"') return readString(interp, fd); else if (ch == '(') From 3525bf6f21199dca0fa4d5c684679aaf1e5a6606 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 07:44:44 +0200 Subject: [PATCH 12/90] Fix: replace deprecated ~ with HOME env var --- flisp.sht | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flisp.sht b/flisp.sht index 2220a46..352ce05 100644 --- a/flisp.sht +++ b/flisp.sht @@ -5,7 +5,7 @@ $(cat lisp/core.lsp) ;; flisp initialzation -(setq config_file (concat ~ "/" ".config/flisp/flisp.rc")) +(setq config_file (concat (os.getenv "HOME") "/" ".config/flisp/flisp.rc")) (defun getopts (opts pos) (setq o (car opts)) From f86ca477b757b036d2f44346dd54594b275231de Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 07:47:53 +0200 Subject: [PATCH 13/90] Make file.c a "real" fLisp extension Added file.h, flisp_file_primitives struct in file.c and load it in initRootEnv() in lisp.c --- double.c | 5 ----- double.h | 2 +- file.c | 14 ++++++++++---- file.h | 19 +++++++++++++++++++ lisp.c | 22 +++++++++++++++------- lisp.h | 15 ++++----------- makefile | 2 +- 7 files changed, 50 insertions(+), 29 deletions(-) create mode 100644 file.h diff --git a/double.c b/double.c index 41408a7..f6bd7c5 100644 --- a/double.c +++ b/double.c @@ -1,6 +1,3 @@ -#ifndef DOUBLE_C -#define DOUBLE_C - #include #include #include @@ -92,8 +89,6 @@ Object *doubleMod(Interpreter *interp, Object **args, Object **env) return newDouble(interp, fmod(FLISP_ARG_ONE->number, FLISP_ARG_TWO->number)); } -#endif - /* * Local Variables: * c-file-style: "k&r" diff --git a/double.h b/double.h index 51cfdfe..621cb90 100644 --- a/double.h +++ b/double.h @@ -10,7 +10,7 @@ extern Object *double_one; extern Object *newDouble(Interpreter *, double); extern Object *readDouble(Interpreter *); -extern Object *readNumberOrSymbol(Interpreter *, FILE *); + extern Object *integerFromDouble(Interpreter *, Object **, Object **); extern Object *doubleFromInteger(Interpreter *, Object **, Object **); extern Object *doubleAdd(Interpreter *, Object **, Object **); diff --git a/file.c b/file.c index 47dccbb..917acc9 100644 --- a/file.c +++ b/file.c @@ -1,5 +1,13 @@ -#ifndef FILE_C -#define FILE_C +#include + +#include "lisp.h" +#include "file.h" + +Primitive flisp_file_primitives[] = { + {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, + {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, + {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, +}; /** file_fflush - flush output stream * @@ -42,8 +50,6 @@ Object *primitiveFgetc(Interpreter *interp, Object** args, Object **env) s[0] = (char)c; return newString(interp, s); } -#endif - /* * Local Variables: diff --git a/file.h b/file.h new file mode 100644 index 0000000..ad20f44 --- /dev/null +++ b/file.h @@ -0,0 +1,19 @@ +#ifndef FILE_H +#define FILE_H + +#include "lisp.h" + +extern Primitive flisp_file_primitives[]; + +extern Object *primitiveFflush(Interpreter *, Object** , Object **); +extern Object *primitiveFtell(Interpreter *, Object** , Object **); +extern Object *primitiveFgetc(Interpreter *, Object** , Object **); + +#endif +/* + * Local Variables: + * c-file-style: "k&r" + * c-basic-offset: 4 + * indent-tabs-mode: nil + * End: + */ diff --git a/lisp.c b/lisp.c index 2b98afe..c49966b 100644 --- a/lisp.c +++ b/lisp.c @@ -26,6 +26,10 @@ #include "double.h" #endif +#ifdef FLISP_FILE_EXTENSION +#include "file.h" +#endif + #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif @@ -2109,10 +2113,6 @@ Object *primitiveFclose(Interpreter *interp, Object**args, Object **env) GC_RETURN(newCons(interp, &(FLISP_ARG_ONE->path), gcObject)); } -#ifdef FLISP_FILE_EXTENSION -#include "file.c" -#endif - /* OS interface */ Object *fl_system(Interpreter *interp, Object **args, Object **env) @@ -2300,7 +2300,7 @@ Primitive primitives[] = { {"ascii->number", 1, 1, TYPE_STRING, asciiToInteger}, {"os.getenv", 1, 1, TYPE_STRING, os_getenv}, {"system", 1, 1, TYPE_STRING, fl_system}, - FLISP_REGISTER_FILE_EXTENSION +// FLISP_REGISTER_FILE_EXTENSION #ifdef FLISP_FEMTO_EXTENSION #include "femto.register.c" #endif @@ -2353,14 +2353,22 @@ void initRootEnv(Interpreter *interp) envSet(interp, gcVar, gcVal, &interp->global, true); } - +#ifdef FLISP_DOUBLE_EXTENSION for (Primitive *entry = flisp_double_primitives; entry->name != NULL; entry++) { *gcVar = newSymbol(interp, entry->name); *gcVal = newPrimitive(interp, entry); envSet(interp, gcVar, gcVal, &interp->global, true); } - +#endif +#ifdef FLISP_FILE_EXTENSION + for (Primitive *entry = flisp_file_primitives; entry->name != NULL; entry++) { + *gcVar = newSymbol(interp, entry->name); + *gcVal = newPrimitive(interp, entry); + + envSet(interp, gcVar, gcVal, &interp->global, true); + } +#endif GC_RELEASE; } diff --git a/lisp.h b/lisp.h index 8710ecd..e31076b 100644 --- a/lisp.h +++ b/lisp.h @@ -141,11 +141,14 @@ typedef struct Interpreter { // PROGRAMMING INTERFACE //////////////////////////////////////////////// -extern Object * newObject(Interpreter *, Object *); +extern Object *newObject(Interpreter *, Object *); extern Object *newObjectFrom(Interpreter *, Object **); extern Object *newInteger(Interpreter *, int64_t); +extern Object *newString(Interpreter *, char *); + extern size_t addCharToBuf(Interpreter *, int); extern void resetBuf(Interpreter *); + extern void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...); #define exception(interp, result, ...) exceptionWithObject(interp, nil, result, __VA_ARGS__) #define GC_PASTE1(name, id) name ## id @@ -190,16 +193,6 @@ extern void lisp_eval2(Interpreter *); extern void lisp_eval3(Interpreter *, char *); extern void lisp_eval_string2(Interpreter *, char *); -#ifdef FLISP_FILE_EXTENSION -#define FLISP_REGISTER_FILE_EXTENSION \ - {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, \ - {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, \ - {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, -#else -#define FLISP_REGISTER_FILE_EXTENSION -#endif - - #endif /* * Local Variables: diff --git a/makefile b/makefile index b975d43..40266de 100644 --- a/makefile +++ b/makefile @@ -30,7 +30,7 @@ OBJ = command.o display.o complete.o data.o gap.o key.o search.o \ buffer.o replace.o window.o undo.o funcmap.o utils.o hilite.o \ femto_lisp.o double.o main.o -FLISP_OBJ = flisp.o lisp.o double.o +FLISP_OBJ = flisp.o lisp.o double.o file.o FLISP_LIBS = -lm BINARIES = femto flisp RC_FILES = femto.rc flisp.rc From de28582e10d0cca2b2feea176b5105453f58c4de Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 07:49:05 +0200 Subject: [PATCH 14/90] Make double extension removable Parametrized readNumberOrSymbol to compile for integer only if double extension is not required. --- lisp.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp.c b/lisp.c index c49966b..881afef 100644 --- a/lisp.c +++ b/lisp.c @@ -1024,9 +1024,14 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) (void)addCharToBuf(interp, streamGetc(interp, fd)); ch = streamPeek(interp, fd); } - // Try to read a number in integer or decimal (float) format. - // C notation applies: 010 = 8, 0x10 = 16 + /* Try to read a number in integer or decimal (float) format. + * C notation applies: 010 = 8, 0x10 = 16 + */ +#ifdef FLISP_DOUBLE_EXTENSION if (ch == '.' || isdigit(ch)) { +#else + if (isdigit(ch)) { +#endif if (ch == '0') { (void)addCharToBuf(interp, streamGetc(interp, fd)); ch = streamPeek(interp, fd); @@ -1039,6 +1044,7 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) ch = readWhile(interp, fd, isdigit); if (!isSymbolChar(ch)) return readInteger(interp); +#ifdef FLISP_DOUBLE_EXTENSION if (ch == '.') { addCharToBuf(interp, ch); ch = streamGetc(interp, fd); @@ -1048,6 +1054,7 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) return readDouble(interp); } } +#endif } // non-numeric character encountered, read a symbol readWhile(interp, fd, isSymbolChar); From 1dab404c93693141bdc7b9b4c253a16003b95f77 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 09:07:33 +0200 Subject: [PATCH 15/90] file extension. add feof, fgets, popen, pclose --- file.c | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ file.h | 4 ++++ 2 files changed, 64 insertions(+) diff --git a/file.c b/file.c index 917acc9..2e08345 100644 --- a/file.c +++ b/file.c @@ -1,4 +1,6 @@ #include +#include +#include #include "lisp.h" #include "file.h" @@ -6,7 +8,11 @@ Primitive flisp_file_primitives[] = { {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, + {"feof", 1, 1, TYPE_STREAM, primitiveFeof}, {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, + {"fgets", 1, 1, TYPE_STREAM, primitiveFgets}, + {"popen", 2, 2, TYPE_STRING, primitivePopen}, + {"pclose", 1, 1, TYPE_STREAM, primitivePclose}, }; /** file_fflush - flush output stream @@ -39,6 +45,12 @@ Object *primitiveFtell(Interpreter *interp, Object** args, Object **env) exception(interp, invalid_value, "(ftell stream) - stream already closed"); return newInteger(interp, file_ftell(interp, FLISP_ARG_ONE)); } +Object *primitiveFeof(Interpreter *interp, Object** args, Object **env) +{ + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(feof stream) - stream already closed"); + return (feof(FLISP_ARG_ONE->fd)) ? t : nil; +} Object *primitiveFgetc(Interpreter *interp, Object** args, Object **env) { @@ -50,6 +62,54 @@ Object *primitiveFgetc(Interpreter *interp, Object** args, Object **env) s[0] = (char)c; return newString(interp, s); } +Object *primitiveFgets(Interpreter *interp, Object** args, Object **env) +{ + Object *string = nil; + char *input; + + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fgets stream) - stream already closed"); + + input = malloc(INPUT_FMT_BUFSIZ); + if(input == NULL) + exception(interp, out_of_memory, "fgets() failed, %s", strerror(errno)); + + *input = '\0'; + + if(fgets(input, INPUT_FMT_BUFSIZ, FLISP_ARG_ONE->fd) != NULL) { + string = newString(interp, input); + free(input); + return string; + } + free(input); + if (!feof(FLISP_ARG_ONE->fd)) + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "fgetc() failed: %s", strerror(errno)); + return end_of_file; +} + +Object *primitivePopen(Interpreter *interp, Object** args, Object **env) +{ + FILE *fd; + + if (strcmp(FLISP_ARG_TWO->string, "r") && strcmp(FLISP_ARG_TWO->string, "w")) + exception(interp, invalid_value, + "(popen path mode) - mode must be \"r\" or \"w\", got: %s", FLISP_ARG_TWO->string); + + fd = popen(FLISP_ARG_ONE->string, FLISP_ARG_TWO->string); + if (fd == NULL) + exception(interp, io_error, "popen() failed: %s", strerror(errno)); + + return newStreamObject(interp, fd, FLISP_ARG_ONE->string); +} +Object *primitivePclose(Interpreter *interp, Object** args, Object **env) +{ + int result = pclose(FLISP_ARG_ONE->fd); + + if (result == -1) + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "pclose() failed: %s", strerror(errno)); + + return newInteger(interp, result); +} /* * Local Variables: diff --git a/file.h b/file.h index ad20f44..85d44b3 100644 --- a/file.h +++ b/file.h @@ -7,7 +7,11 @@ extern Primitive flisp_file_primitives[]; extern Object *primitiveFflush(Interpreter *, Object** , Object **); extern Object *primitiveFtell(Interpreter *, Object** , Object **); +extern Object *primitiveFeof(Interpreter *, Object** , Object **); extern Object *primitiveFgetc(Interpreter *, Object** , Object **); +extern Object *primitiveFgets(Interpreter *, Object** , Object **); +extern Object *primitivePopen(Interpreter *, Object** , Object **); +extern Object *primitivePclose(Interpreter *, Object** , Object **); #endif /* From 136350a64df8f5f1919f6c2ad3f990dc3ed1dd42 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 09:09:58 +0200 Subject: [PATCH 16/90] Fix: build of file extensions needs declared double extension Since the double extension is practically required, it must be declared in the build of all extension files to not get the type enums wrongly ordered. --- makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/makefile b/makefile index 40266de..b55c938 100644 --- a/makefile +++ b/makefile @@ -84,6 +84,9 @@ femto.rc: femto.sht lisp/core.lsp femto_lisp.o: lisp.c femto.register.c $(CC) $(CPPFLAGS) $(CFLAGS) -D FLISP_FEMTO_EXTENSION -D FLISP_DOUBLE_EXTENSION -c lisp.c -o $@ +file.o: file.c file.h lisp.h + $(CC) $(CPPFLAGS) $(CFLAGS) -D FLISP_DOUBLE_EXTENSION -c $< + flisp: $(FLISP_OBJ) flisp.rc $(LD) $(LDFLAGS) -o $@ $(FLISP_OBJ) $(FLISP_LIBS) From 146d4a0ba3ebacfc50b4ea41138836e8d37cc0d8 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 09:10:35 +0200 Subject: [PATCH 17/90] Whitespace cleanup, move flisp constants to programming interface section --- lisp.c | 16 ++++++++-------- lisp.h | 54 +++++++++++++++++++++++++++++------------------------- 2 files changed, 37 insertions(+), 33 deletions(-) diff --git a/lisp.c b/lisp.c index 881afef..5a2d928 100644 --- a/lisp.c +++ b/lisp.c @@ -2136,7 +2136,7 @@ Object *os_getenv(Interpreter *interp, Object **args, Object **env) /* Strings */ -// (string-append s a) +// (string-append s a) Object *stringAppend(Interpreter *interp, Object **args, Object **env) { int len1 = strlen(FLISP_ARG_ONE->string); @@ -2219,7 +2219,7 @@ Object *stringLength(Interpreter *interp, Object **args, Object **env) Object *stringSearch(Interpreter *interp, Object **args, Object **env) { char *pos; - + pos = strstr(FLISP_ARG_TWO->string, FLISP_ARG_ONE->string); if (pos) return newInteger(interp, pos - FLISP_ARG_TWO->string); @@ -2302,7 +2302,7 @@ Primitive primitives[] = { {"string-length", 1, 1, TYPE_STRING, stringLength}, {"string-append", 2, 2, TYPE_STRING, stringAppend}, {"substring", 1, 3, 0, stringSubstring}, - {"string-search", 2, 2, TYPE_STRING, stringSearch}, + {"string-search", 2, 2, TYPE_STRING, stringSearch}, {"ascii", 1, 1, TYPE_INTEGER, asciiToString}, {"ascii->number", 1, 1, TYPE_STRING, asciiToInteger}, {"os.getenv", 1, 1, TYPE_STRING, os_getenv}, @@ -2349,7 +2349,7 @@ void initRootEnv(Interpreter *interp) ok->type = type_cons; ok->car = nil; ok->cdr = okMessage; - + // add primitives GC_TRACE(gcVar, nil); GC_TRACE(gcVal, nil); @@ -2367,7 +2367,7 @@ void initRootEnv(Interpreter *interp) envSet(interp, gcVar, gcVal, &interp->global, true); } -#endif +#endif #ifdef FLISP_FILE_EXTENSION for (Primitive *entry = flisp_file_primitives; entry->name != NULL; entry++) { *gcVar = newSymbol(interp, entry->name); @@ -2375,7 +2375,7 @@ void initRootEnv(Interpreter *interp) envSet(interp, gcVar, gcVal, &interp->global, true); } -#endif +#endif GC_RELEASE; } @@ -2739,11 +2739,11 @@ void cerf(Interpreter *interp, FILE *fd) if (fd == NULL) readCons.cdr = nil; Object readApply = (Object) { type_cons, .car = &readCons, .cdr = nil }; - + Object eval = (Object) { type_primitive, .primitive = &evalPrimitive, .type_check = nil }; Object evalCons = (Object) { type_cons, .car = &eval, .cdr = &readApply }; Object *evalApply = &(Object) { type_cons, .car = &evalCons, .cdr = nil }; - + (void) evalCatch(interp, &evalApply, &interp->global); } diff --git a/lisp.h b/lisp.h index e31076b..6208a30 100644 --- a/lisp.h +++ b/lisp.h @@ -33,31 +33,6 @@ typedef struct Object Object; typedef struct Interpreter Interpreter; typedef Object *(*LispEval) (Interpreter *, Object **, Object **); -/* Constants */ -/* Fundamentals */ -extern Object *nil; -extern Object *t; -/* Types */ -extern Object *type_integer; -extern Object *type_double; -extern Object *type_string; -extern Object *type_symbol; -extern Object *type_cons; -extern Object *type_lambda; -extern Object *type_macro; -extern Object *type_primitive; -extern Object *type_stream; -/* internal */ -extern Object *type_env; -extern Object *type_moved; -/* Exceptions */ -extern Object *end_of_file; -extern Object *range_error; -extern Object *wrong_type_argument; -extern Object *invalid_value; -extern Object *wrong_num_of_arguments; -extern Object *io_error; -extern Object *out_of_memory; typedef enum ObjectType { TYPE_MOVED, @@ -140,11 +115,40 @@ typedef struct Interpreter { /*@null@*/extern Interpreter *lisp_interpreters; // PROGRAMMING INTERFACE //////////////////////////////////////////////// +/* Constants */ +/* Fundamentals */ +extern Object *nil; +extern Object *t; +/* Types */ +extern Object *type_integer; +extern Object *type_double; +extern Object *type_string; +extern Object *type_symbol; +extern Object *type_cons; +extern Object *type_lambda; +extern Object *type_macro; +extern Object *type_primitive; +extern Object *type_stream; +/* internal */ +extern Object *type_env; +extern Object *type_moved; +/* Exceptions */ +extern Object *end_of_file; +extern Object *range_error; +extern Object *wrong_type_argument; +extern Object *invalid_value; +extern Object *wrong_num_of_arguments; +extern Object *io_error; +extern Object *out_of_memory; +/* utility */ +extern Object *one; +extern Object *empty; extern Object *newObject(Interpreter *, Object *); extern Object *newObjectFrom(Interpreter *, Object **); extern Object *newInteger(Interpreter *, int64_t); extern Object *newString(Interpreter *, char *); +extern Object *newStreamObject(Interpreter *, FILE *, char *); extern size_t addCharToBuf(Interpreter *, int); extern void resetBuf(Interpreter *); From 2b42e353318d1430671e76cd54bba873647b4334 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Thu, 28 Aug 2025 23:30:03 +0200 Subject: [PATCH 18/90] Add fstat function fstat returns a property list with size, mode uid, gid and type, type as string. It throws one of the following exceptions: - permission-denied - not-found - io-error (catch (fstat path)) can therefore be used to test for existence of files. --- file.c | 128 +++++++++++++++++++++++++++++++++++++++++++++++++++------ file.h | 11 ++--- lisp.c | 10 ++++- lisp.h | 2 + 4 files changed, 130 insertions(+), 21 deletions(-) diff --git a/file.c b/file.c index 2e08345..95591b6 100644 --- a/file.c +++ b/file.c @@ -1,18 +1,19 @@ #include #include #include +#include +#include #include "lisp.h" #include "file.h" -Primitive flisp_file_primitives[] = { - {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, - {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, - {"feof", 1, 1, TYPE_STREAM, primitiveFeof}, - {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, - {"fgets", 1, 1, TYPE_STREAM, primitiveFgets}, - {"popen", 2, 2, TYPE_STRING, primitivePopen}, - {"pclose", 1, 1, TYPE_STREAM, primitivePclose}, +Object *permission_denied = &(Object) { NULL, .string = "permission-denied" }; +Object *not_found = &(Object) { NULL, .string = "not-found" }; + +Constant flisp_file_constants[] = { + { &permission_denied, &permission_denied }, + { ¬_found, ¬_found }, + { NULL, NULL } }; /** file_fflush - flush output stream @@ -34,16 +35,26 @@ Object *primitiveFflush(Interpreter *interp, Object** args, Object **env) exception(interp, invalid_value, "(fflush stream) - stream already closed"); return newInteger(interp, file_fflush(interp, FLISP_ARG_ONE)); } - -off_t file_ftell(Interpreter *interp, Object *stream) +Object *primitiveFseek(Interpreter *interp, Object** args, Object **env) { - return ftello(stream->fd); + int result, whence = SEEK_SET; + CHECK_TYPE(FLISP_ARG_ONE, type_stream, "(fseek stream offset) - stream"); + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fseek stream) - stream already closed"); + CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(fseek stream offset) - offset"); + if (FLISP_ARG_TWO->integer < 0) + whence = SEEK_END; + result = fseeko(FLISP_ARG_ONE->fd, FLISP_ARG_TWO->integer, whence); + if (result == -1) + exception(interp, io_error, "fseeko() failed: %s", strerror(errno)); + + return newInteger(interp, ftello(FLISP_ARG_ONE->fd)); } Object *primitiveFtell(Interpreter *interp, Object** args, Object **env) { if (FLISP_ARG_ONE->fd == NULL) exception(interp, invalid_value, "(ftell stream) - stream already closed"); - return newInteger(interp, file_ftell(interp, FLISP_ARG_ONE)); + return newInteger(interp, ftello(FLISP_ARG_ONE->fd)); } Object *primitiveFeof(Interpreter *interp, Object** args, Object **env) { @@ -111,6 +122,99 @@ Object *primitivePclose(Interpreter *interp, Object** args, Object **env) return newInteger(interp, result); } +Object *primitiveFstat(Interpreter *interp, Object** args, Object **env) +{ + struct stat info; + int result; + Object *object; + char *type; + + CHECK_TYPE(FLISP_ARG_ONE, type_string, "(fstat string[ linkp]) - stream"); + + if (FLISP_HAS_ARG_TWO && FLISP_ARG_TWO != nil) + result = lstat(FLISP_ARG_ONE->string, &info); + else + result = stat(FLISP_ARG_ONE->string, &info); + + if (result == -1) { + switch(errno) { + case EACCES: + exceptionWithObject(interp, FLISP_ARG_ONE, permission_denied, "(fstat string[ linkp]): %s", strerror(errno)); + break; + case ENOENT: + case ENOTDIR: + exceptionWithObject(interp, FLISP_ARG_ONE, not_found, "(fstat string[ linkp]): %s", strerror(errno)); + break; + case ENAMETOOLONG: + exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, "(fstat string[ linkp]): %s", strerror(errno)); + } + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "l/stat() failed: %s", strerror(errno)); + } + + /* (size _size_ type _type_ mode _mode_ uid _uid_ gid _gid_ ) */ + GC_CHECKPOINT; + if (S_ISBLK(info.st_mode)) type = "b"; + else if (S_ISCHR(info.st_mode)) type = "c"; + else if (S_ISDIR(info.st_mode)) type = "d"; + else if (S_ISFIFO(info.st_mode)) type = "p"; + else if (S_ISREG(info.st_mode)) type = "f"; + else if (S_ISLNK(info.st_mode)) type = "l"; + else if (S_ISSOCK(info.st_mode)) type = "s"; + else if (S_TYPEISMQ(info)) type = "Q"; + else if (S_TYPEISSEM(info)) type = "S"; + else if (S_TYPEISSHM(info)) type = "M"; + else if (S_TYPEISTMO(info)) type = "T"; + else type = "-"; + + object = newString(interp, type); + GC_TRACE(gcObject, object); + object = newCons(interp, gcObject, &nil); + GC_TRACE(gcResult, object); + + *gcObject = newSymbol(interp, "type"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_gid); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "gid"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_uid); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "uid"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_mode & 07777); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "mode"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_size); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "size"); + *gcResult = newCons(interp, gcObject, gcResult); + + GC_RETURN(*gcResult); +} + + +Primitive flisp_file_primitives[] = { + {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, + {"fseek", 2, 3, 0, primitiveFseek}, + {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, + {"feof", 1, 1, TYPE_STREAM, primitiveFeof}, + {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, + {"fgets", 1, 1, TYPE_STREAM, primitiveFgets}, + {"popen", 2, 2, TYPE_STRING, primitivePopen}, + {"pclose", 1, 1, TYPE_STREAM, primitivePclose}, + {"fstat", 1, 2, 0, primitiveFstat}, +}; + + /* * Local Variables: * c-file-style: "k&r" diff --git a/file.h b/file.h index 85d44b3..09dfe41 100644 --- a/file.h +++ b/file.h @@ -5,13 +5,10 @@ extern Primitive flisp_file_primitives[]; -extern Object *primitiveFflush(Interpreter *, Object** , Object **); -extern Object *primitiveFtell(Interpreter *, Object** , Object **); -extern Object *primitiveFeof(Interpreter *, Object** , Object **); -extern Object *primitiveFgetc(Interpreter *, Object** , Object **); -extern Object *primitiveFgets(Interpreter *, Object** , Object **); -extern Object *primitivePopen(Interpreter *, Object** , Object **); -extern Object *primitivePclose(Interpreter *, Object** , Object **); +extern Object *permission_denied; +extern Object *not_found; + +extern Constant flisp_file_constants[]; #endif /* diff --git a/lisp.c b/lisp.c index 5a2d928..b450894 100644 --- a/lisp.c +++ b/lisp.c @@ -2318,7 +2318,7 @@ Primitive primitives[] = { void initRootEnv(Interpreter *interp) { - int i; + int i, nConstants; GC_CHECKPOINT; GC_TRACE(gcEnv, newEnv(interp, &nil, &nil)); @@ -2326,7 +2326,7 @@ void initRootEnv(Interpreter *interp) interp->global = *gcEnv; // add constants - int nConstants = sizeof(flisp_constants) / sizeof(flisp_constants[0]); + nConstants = sizeof(flisp_constants) / sizeof(flisp_constants[0]); for (i = 0; i < nConstants; i++) { (*flisp_constants[i].symbol)->type = type_symbol; envSet(interp, flisp_constants[i].symbol, flisp_constants[i].value, &interp->global, true); @@ -2369,6 +2369,12 @@ void initRootEnv(Interpreter *interp) } #endif #ifdef FLISP_FILE_EXTENSION + for (Constant *constant = flisp_file_constants; constant->symbol != NULL; constant++) { + (*constant->symbol)->type = type_symbol; + envSet(interp, constant->symbol, constant->value, &interp->global, true); + interp->symbols = newCons(interp, constant->symbol, &interp->symbols); + } + for (Primitive *entry = flisp_file_primitives; entry->name != NULL; entry++) { *gcVar = newSymbol(interp, entry->name); *gcVal = newPrimitive(interp, entry); diff --git a/lisp.h b/lisp.h index 6208a30..b14b093 100644 --- a/lisp.h +++ b/lisp.h @@ -148,6 +148,8 @@ extern Object *newObject(Interpreter *, Object *); extern Object *newObjectFrom(Interpreter *, Object **); extern Object *newInteger(Interpreter *, int64_t); extern Object *newString(Interpreter *, char *); +extern Object *newCons(Interpreter *, Object **, Object **); +extern Object *newSymbol(Interpreter *, char *); extern Object *newStreamObject(Interpreter *, FILE *, char *); extern size_t addCharToBuf(Interpreter *, int); From 37d5f6dcc48b8c6f27ac5b3d0c5a750bf8d5d5d6 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 12:55:31 +0200 Subject: [PATCH 19/90] Replace lisp_eval_string() with lisp_eval() and changed C interface Duplicate "catch" code in lisp-eval() is replaced by using evalCatch. The only interface with the interpreter is now interp->object, which receives a catch object (error_type message object). If error_type == nil, object is the result, otherwise object is the err'ed object (or nil) and message a string object, message->string the error message. --- docs/flisp.md | 193 ++++++++++++++++++----------------- flisp.c | 22 ++-- lisp.c | 226 +++++++++-------------------------------- lisp.h | 17 ++-- main.c | 11 +- makefile | 33 +++--- misc/ROADMAP.flisp.txt | 49 +++++---- pdoc/flisp.html | 198 +++++++++++++++++------------------- test/1_primitives.test | 2 +- 9 files changed, 315 insertions(+), 436 deletions(-) diff --git a/docs/flisp.md b/docs/flisp.md index eb380a0..94d80b9 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -288,22 +288,11 @@ is then replaced by its object. #### Error handling Whenever fLisp encounters an error an exception is thrown. Exceptions -have an error type symbol and a human readable error message. fLisp does -not implement stack backtracking. Exceptions are either caught on the -top level of an evaluation or by a `catch` statement. - -In the `flisp` interpreter the error message is formated as -`error: «message»` if the error object is `nil` otherwise as -`error: '«object»', «message»`, where *object* is the serialization of -the object causing the error and *message* is the error message. - -When an exception occurs while calling `lisp_eval()` or -`lisp_eval_string()` from C-code, the `object` field of the interpreter -is set to the object causing the error, the `result` field is set to the -error type symbol and the `msg_buf` field is set to the error message. - -Exceptions can be thrown from within in Lisp code via the -[`throw`](#interp_ops) function. +have an error type symbol a human readable +error message and the object +in error, which is nil with generic errors. fLisp does not +implement stack backtracking. Exceptions are either caught on the top +level of an evaluation or by a [`catch`](#interp_ops) statement. The following error type symbols are defined and used internally: @@ -319,6 +308,14 @@ The following error type symbols are defined and used internally: - `out-of-memory` - `gc-error` +Exceptions can be thrown via the [`throw`](#interp_ops) function. As +long as applicable use one of the existing error codes with `throw`. + +*fLisp* outputs an error message formated as `error: «message»` if the +error object is `nil` otherwise as `error: '«object»', «message»`, where +*object* is the serialization of the object causing the error. *message* +is the error message. + [^](#toc) ### *fLisp* Primitives @@ -381,8 +378,8 @@ Returns *expr* without evaluating it. `(catch «expr»)` D Evaluates *expr* and returns a list with three elements: -*result* -`0` on success or any other number indicating an error. +*error_type* +`nil` on success or an error type symbol. *message* A human readable error message. @@ -610,16 +607,16 @@ default location and name of this startup file are hardcoded in the binary and can be overwritten with environment variables: -Library path -femto: `/usr/local/share/femto`, `FEMTOLIB` - -flisp: `/usr/local/share/flisp`, `FLISPLIB` - Startup file femto: `femto.rc`, `FEMTORC` flisp: `flisp.rc`, `FLISPRC` +Library path +femto: `/usr/local/share/femto`, `FEMTOLIB` + +flisp: `/usr/local/share/flisp`, `FLISPLIB` + The library path is exposed to the Lisp interpreter as the variable `script_dir`. @@ -628,12 +625,29 @@ allows to load Lisp files from the library path conveniently and without repetition. The command to load the file `example.lsp` from the library is `(require 'example)`. -Femto provides a set of libraries, some of them are required by the -editor +Femto provides the following set of libraries: -#### Core Library +core +Integrated in the `.rc` files, always loaded. The core library +implements the minimum required Lisp features for loading libraries. + +flisp +Implements expected standard Lisp functions and additions expected by +`femto` and `flisp`. -This library is built into the startup file. +string +String manipulation library. + +femto +`femto` editor specific functions. + +bufmenu, defmacro, dired, info +`femto` editor utilities + +git, grep, oxo +`femto` editor modules + +#### Core Library `(list` \[*element* ..\]`)` C Returns the list of all provided elements. @@ -795,6 +809,8 @@ Returns a list with all elements of *l* in reverse order #### Standard Library +To be integrated into the flisp library + This library implements some Common Lisp functions, which are not used in the editor libraries. They are provided for reference. @@ -1159,7 +1175,7 @@ Returns the complete version string of Femto, including the copyright. #### Embedding Overview fLisp can be embedded into a C application. Two examples of embedding -are the \`femto\` editor and the simplistic \`flisp\` command line Lisp +are the `femto` editor and the simplistic `flisp` command line Lisp interpreter. Currently embedding can only be done by extending the build system. @@ -1169,7 +1185,7 @@ file. Two extensions are provided: the Femto extension which provides the editor functionality and the file extension which provides access to the low level stream I/O functions and adds some more. -fLisp exposes the following public interface functions: +*fLisp* exposes the following public interface functions: `lisp_new()` Create a new interpreter. @@ -1178,10 +1194,7 @@ Create a new interpreter. Destroy an interpreter, releasing resources. `lisp_eval()` -Evaluate input stream until exhausted or error. - -`lisp_eval_string()` -Evaluate given string until exhausted or error. +Evaluate a string or the input stream until exhausted or error. `lisp_write_object()` Format and write object to file descriptor. @@ -1190,33 +1203,32 @@ Format and write object to file descriptor. Format and write the error object and error message of an interpreter to a file descriptor. -Different flows of operation can be implemented. The Femto editor +Different flows of operation can be implemented. The *femto* editor initializes the interpreter without input/output file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed or upon explicit request via the editor interface. The `flisp` command line interpreter sets `stdout` as the default output -file descriptors of the fLisp interpreter and feeds it with strings of +file descriptors of the *fLisp* interpreter and feeds it with strings of lines read from the terminal. If the standard input is not a terminal -`stdin` is set as the default input file descriptor and fLisp reads it +`stdin` is set as the default input file descriptor and *fLisp* reads it through until end of file. -After processing the given input, the interpreter puts a pointer to the -object which is the result of the last evaluation into the `object` -field of the interpreter structure. The `result` field is set to the -`nil` and the `msg_buf` field is set to the empty string. - -fLisp sends all output to the default output stream. If `NULL` is given -on initialization, output is suppressed altogether. +After processing the input, the interpreter puts a [`catch`](interp_ops) +result in the form `(«error_type» «message» «object»)` object into the +`object` field of the interpreter structure. Upon success *error_type* +is nil and the *object* element is the result of the last evaluation. +They can be accessed with the C-macros `FLISP_RESULT_CODE` and +`FLISP_RESULT_OBJECT`. -If an exception is thrown inside the Lisp interpreter an error message -is formatted and copied to the `msg_buf` buffer of the interpreter, A -pointer to the object causing the error is set to the `object` field. -The `result` field is set to the respective error type symbol. +On error use `lisp_write_error()` to write the standard error message to +a file descriptor of choice, or use the above C-macros and +`FLISP_ERROR_MESSAGE` for taking specific action. Note that these macros +evaluate to a Lisp object, you have to dereference their content to used +it. -In this error state of the interpreter, the -function `lisp_write_error()` can be used to write a standardized error -message including the error object to a file descriptor of choice +*fLisp* sends all output to the default output stream. If `NULL` is +given on initialization, output is suppressed altogether. #### fLisp C Interface @@ -1258,13 +1270,16 @@ Debug output stream. If set to `NULL` no debug information is generated. `void lisp_destroy(Interpreter *«interp»)` Frees all resources used by the interpreter. -`void lisp_eval(Interpreter *«interp»)` -Evaluates the input file set in the *input* field of the fLisp -interpreter *interp* until end of file. If no input file is set, -`interp` is set to a respective error state. +`void lisp_eval(Interpreter *«interp», char *«string»)` +If *string* is not `NULL` evaluates all Lisp expressions in *string*. -`void lisp_eval_string(Interpreter *«interp», char *«string»)` -Evaluates all Lisp expressions in *string*. +If *string* is `NULL` input from the file descriptor in the *input* +field of the *fLisp* interpreter *interp* is evaluated until end of +file. + +If no memory can be allocated for the input string or the input file +descriptor is `NULL` no Lisp evaluation takes place and the `object` +field of the interpreter is set to an `io-error`. `void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` Format *object* into a string and write it to *stream*. If *readably* is @@ -1285,8 +1300,8 @@ An extensions has to create C functions with the signature: `Object *«primitive»(Interpreter *interp, Object **args, Object **env)`, where *primitive* is a distinct name in C space. This function has to be added to the global variable `primitives` in the following format: -`{"«name»", «argMin», «argMax», «primitive»}`. Here *name* is a distinct -name in Lisp space. +`{"«name»", «argMin», «argMax», «type_check», «primitive»}`. Here *name* +is a distinct name in Lisp space. *interp* is the fLisp interpreter in which *primitive* is executed. *argMin* is the minimum number of arguments, *argMax* is the maximum @@ -1294,6 +1309,11 @@ number of arguments allowed for the function. If *argMax* is a negative number, arguments must be given in tuples of *argMax* and the number of tuples is not restricted. +When type check is set to a type C-macro the interpreter assures that +all arguments are of the given type and creates a standardized exception +otherwise. When type check is set to `0` the primitive has to take care +of type checking by itself. The C-macro `CHECK_TYPE` helps with this. + When creating more then one new objects within a primitive, care has to be taken to register them with the garbage collector. Registration is started with the `GC_CHECKPOINT` CPP macro. `GC_TRACE(«name», «value»` @@ -1302,25 +1322,27 @@ with the garbage collector. The macro `GC_RELEASE` must be called to finalize the registration. The convenience macro `GC_RETURN(«object»)` calls `GC_RELEASE` and returns *object*. -Some CPP macros are provided to simplify argument validation in -primitives, all of them receive the *name* of the primitive as a -parameter: +Some CPP macros are provided to simplify argument access and validation +in primitives: -`TWO_STRING_ARGS(«name»)` -Assures that the first two arguments are of type string. They are -assigned to the `Object *` variables *first* and *second*. - -`ONE_STRING_ARG(«name»)` -Assures that the first argument is of type string. It is assigned to the -`Object *` variable *arg*. +`FLISP_HAS_ARGS` +`FLISP_HAS_ARG_TWO` +`FLISP_HAS_ARG_THREE` +Evaluate to true if there are arguments or the respective argument is +available. `ONE_NUMBER_ARG(«name»)` -Assures that the first argument is of type number. It is assigned to the -`Object *` variable *num*. - -`ONE_STREAM_ARG(«name»)` -Assures that the first argument is of type stream. It is assigned to the -`Object *` variable *stream*. +`FLISP_ARG_ONE` +`FLISP_ARG_TWO` +`FLISP_ARG_THREE` +Evaluate to the respective argument. + +`CHECK_TYPE(«argument», «type», «signature»)` +Assures that the given argument is of the given type. *type* must be a +type variable like `type_string`. *signature* is the signature of the +primitive followed by “` - `” and the name of the argument to be type +checked. This is used to form a standardized `wrong-type-argument` error +message. [^](#toc) @@ -1328,7 +1350,7 @@ Assures that the first argument is of type stream. It is assigned to the #### Garbage Collection -fLisp implements Cheney's copying garbage collector, with which memory +*fLisp* implements Cheney's copying garbage collector, with which memory is divided into two equal halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used during garbage collection. @@ -1383,7 +1405,7 @@ Output buffer 2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting buffer. -fLisp can live with as little as 300k object memory. The Femto editor +*fLisp* can live with as little as 400k object memory. The Femto editor requires 16M since the “OXO” game requires a lot of memory. #### Future Directions @@ -1399,23 +1421,8 @@ together with the `(eval)` primitive would allow to write the repl directly in Lisp, and reading and eval'ing until no more “incomplete input” result codes are returned. -Integer arithmetic would be sufficient for all current purposes and -increase portability and speed while reducing size. - -The file extension only contains `(fflush)`, `(ftell)` and `(fgetc)` and -could easily be extended into something useful. `(fstat)` would be most -pressing for improving `femto.rc` and `flisp.rc`. - -The string library should implement Elisp `substring` to replace -`string.substring` and a simplified version of `string-search` without -start index. - -Implement `(type «object»)` returning symbols for each type in C and -implement individual type checking predicates in Lisp. - -loop programming is availble via the labelled let macro. It could made -easier, by any combination of: +Loops are availble via the labelled let macro and supported by `iota`. +It could made easier, by any combination of: -- iota - loop/while/for macro - Demoing hand crafted loops including breaking with throw. diff --git a/flisp.c b/flisp.c index 96ccdf7..077013e 100644 --- a/flisp.c +++ b/flisp.c @@ -54,12 +54,12 @@ void repl(Interpreter *interp) continue; } - lisp_eval3(interp, input); - if (interp->object->car != nil) - lisp_write_error2(interp, stderr); + lisp_eval(interp, input); + if (FLISP_RESULT_CODE != nil) + lisp_write_error(interp, stderr); } - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); + if (FLISP_RESULT_CODE != nil) { + lisp_write_error(interp, stderr); exit_code = 1; } return; @@ -93,9 +93,9 @@ int main(int argc, char **argv) else { // load inifile interp->input = fd; - lisp_eval3(interp, NULL); - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); + lisp_eval(interp, NULL); + if (FLISP_RESULT_CODE != nil) { + lisp_write_error(interp, stderr); fprintf(stderr, "failed to load inifile %s: %s\n", init_file, interp->msg_buf); // Note: if we could implement the repl in fLisp itself we'd bail out here. } @@ -112,9 +112,9 @@ int main(int argc, char **argv) // Just eval the standard input interp->input = stdin; - lisp_eval3(interp, NULL); - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); + lisp_eval(interp, NULL); + if (FLISP_RESULT_CODE != nil) { + lisp_write_error(interp, stderr); exit_code = 1; } } diff --git a/lisp.c b/lisp.c index b450894..f6614b6 100644 --- a/lisp.c +++ b/lisp.c @@ -1180,7 +1180,7 @@ Object *readExpr(Interpreter *interp, FILE *fd) return readNumberOrSymbol(interp, fd); } else - exception(interp, invalid_read_syntax, "unexpected character, `%c'", ch); + exception(interp, invalid_read_syntax, "unexpected character: '%c'", ch); } } @@ -1201,7 +1201,7 @@ Object *primitiveRead(Interpreter *interp, Object **args, Object **env) FILE *fd = interp->input; GC_CHECKPOINT; - if (*args != nil) { + if (FLISP_HAS_ARGS) { stream = (*args)->car; if (stream->type != type_stream) exceptionWithObject(interp, stream, invalid_value, "(read [fd ..]) - arg 1 expected %s, got: %s", type_stream->string, stream->type->string); @@ -2546,191 +2546,28 @@ void lisp_destroy(Interpreter *interp) free(interp); } -/** lisp_eval - protected evaluation of input stream - * - * @param interp fLisp interpreter - * @param stream open readable stream object - * @param gcRoots gc root object - * - */ -void lisp_eval(Interpreter *interp) -{ - if (interp->input == NULL) { - interp->result = invalid_value; - strncpy(interp->msg_buf, "no input stream to evaluate", sizeof(interp->msg_buf)); - interp->object = nil; - return; - } - - interp->result = nil; - interp->msg_buf[0] = '\0'; - - // start the garbage collector - interp->gcTop = nil; - GC_CHECKPOINT; - GC_TRACE(gcObject, nil); // will not be released at all - - for (;;) { - interp->result = nil; - interp->msg_buf[0] = '\0'; - switch (setjmp(*interp->catch)) { - case FLISP_OK: break; - case FLISP_RETURN: return; - default: - fl_debug(interp, "error: %s, '%s'", interp->result->string, interp->msg_buf); - GC_RELEASE; - return; - } - if ((*gcObject = readExpr(interp, interp->input)) == NULL) { - interp->result = nil; - interp->msg_buf[0] = '0'; - return; - } - lisp_write_object(interp, interp->debug, *gcObject, true); - writeChar(interp, interp->debug, '\n'); - *gcObject = evalExpr(interp, gcObject, &interp->global); - interp->object = *gcObject; - lisp_write_object(interp, interp->output, *gcObject, true); - writeChar(interp, interp->output, '\n'); - if (interp->output) fflush(interp->output); - } - longjmp(*interp->catch, FLISP_RETURN); - GC_RELEASE; // make the compiler happy -} - -/** lisp_write_error - format error message and write to file +/** lisp_write_error - write error message to file descriptor * * @param interp fLisp interpreter * @param fd open writable file descriptor * - * Formats the error message and inserts the error object if not nil, - * then writes it to the given file descriptor. + * Formats an error message from a (catch) result and writes it to the + * given file descriptor. If the error object is nil, it is not + * inserted. * - * It is an error to use an interpreter without error. */ void lisp_write_error(Interpreter *interp, FILE *fd) { - if (interp->object == nil) - fprintf(fd, "error: %s\n", interp->msg_buf); + if (FLISP_RESULT_OBJECT == nil) + fprintf(fd, "error: %s\n", FLISP_RESULT_MESSAGE->string); else { - fprintf(fd, "%s", "error: '"); - lisp_write_object(interp, fd, interp->object, true); - fprintf(fd, "', %s\n", interp->msg_buf); + fprintf(fd, "error: '"); + lisp_write_object(interp, fd, FLISP_RESULT_OBJECT, true); + fprintf(fd, "', %s\n", FLISP_RESULT_MESSAGE->string); } fflush(fd); } -/** lisp_eval_string() - interpret a string in Lisp - * - * @param interp fLisp interpreter - * @param input string to evaluate - * - * Before calling `lisp_eval_string()` initialize: - * - * - interp->result is set to the result symbol of the evaluation, nil if succesful. - * - interp->object is set to the resulting object - * - * If an error occurs during evaluation: - * - * - interp->object is set to the object causing the exception, or nil. - * - interp->msg_buf is set to an error message. - * - */ -void lisp_eval_string(Interpreter *interp, char * input) -{ - FILE *fd, *prev; - - fl_debug(interp, "lisp_eval_string(\"%s\")", input); - - if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - strncpy(interp->msg_buf, "failed to allocate input stream", sizeof(interp->msg_buf)); - goto io_error; - } - prev = interp->input; - interp->input = fd; - lisp_eval(interp); - interp->input = prev; - (void)fclose(fd); - if (interp->result == nil) { - fl_debug(interp, "lisp_eval_string() result: nil"); - lisp_write_object(interp, interp->debug, interp->object, true); - } - else - fl_debug(interp, "lisp_eval_string() result: error: %s", interp->msg_buf); - return; - -io_error: - interp->result = io_error; - interp->object = nil; - return; -} - - -void lisp_write_error2(Interpreter *interp, FILE *fd) -{ - fprintf(fd, "error: '"); - lisp_write_object(interp, fd, interp->object->cdr->cdr->car, true); - fprintf(fd, "', %s\n", interp->object->cdr->car->string); - fflush(fd); -} - -void lisp_eval2(Interpreter *interp) -{ - // reset the garbage collector - interp->gcTop = nil; - GC_CHECKPOINT; - GC_TRACE(gcObject, nil); - Primitive readPrimitive = { "read", 0, 2, 0, primitiveRead }; - Object *readObject = &(Object) { type_primitive, .primitive = &readPrimitive, .type_check = nil }; - Object *readInvocation = &(Object) { type_cons, .car = readObject, .cdr = nil }; - Object *readApply = &(Object) { type_cons, .car = readInvocation, .cdr = nil }; - - Object *okObject = &(Object) { type_cons, .car = nil, .cdr = nil }; - Object *okString = &(Object) { type_cons, .car = empty, .cdr = okObject }; - Object *result = &(Object) { type_cons, .car = nil, .cdr = okString }; - - for (;;) { - /* read */ - *gcObject = evalCatch(interp, &readApply, &interp->global); - if (interp->object->car == end_of_file) { - interp->object = result; - break; - } - if (interp->object->car != nil) - break; - /* eval */ - *gcObject = newCons(interp, &interp->object->cdr->cdr->car, &nil); - *gcObject = evalCatch(interp, gcObject, &interp->global); - if ((*gcObject)->car != nil) - break; - lisp_write_object(interp, interp->output, (*gcObject)->cdr->cdr->car, true); - writeChar(interp, interp->output, '\n'); - if (interp->output) fflush(interp->output); - result = *gcObject; - } - GC_RELEASE; -} -void lisp_eval_string2(Interpreter *interp, char *input) -{ - - FILE *fd, *prev; - fl_debug(interp, "lisp_eval_string2(\"%s\")", input); - - if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - strncpy(interp->msg_buf, "failed to allocate input stream", sizeof(interp->msg_buf)); - interp->result = io_error; - interp->object = nil; - return; - } - prev = interp->input; - interp->input = fd; - - lisp_eval2(interp); - interp->input = prev; - (void)fclose(fd); -} - - /** (catch (eval (read f))) */ void cerf(Interpreter *interp, FILE *fd) @@ -2755,19 +2592,50 @@ void cerf(Interpreter *interp, FILE *fd) Object *openInputStreamError(void) { - Object *m = &(Object) { type_string, .string = "alloc stream failed" }; + Object *m = &(Object) { type_string, .string = "cannot open input stream" }; Object *o = &(Object) { type_cons, .car = nil, .cdr = nil }; o = &(Object) { type_cons, .car = m, .cdr = o }; return &(Object) { type_cons, .car = io_error, .cdr = o }; } -void lisp_eval3(Interpreter *interp, char *input) +/** lisp_eval() - interpret a string or file in Lisp + * + * @param interp fLisp interpreter + * @param input string to evaluate + * + * If input is NULL, the interpreters input stream is evaluated + * instead. + * + * After evaluation, the result of evaluation is available in + * interp->object. It is a (catch) result which is a three element + * list: + * + * (code message result) + * + * If evaluation was successful, code is nil and message is an empty + * string. Otherwise, code is an error symbol, message is a human + * readable error message and result the object causing the error. + * + * The following macros can be used to access the list elements: + * + * - FLISP_RESULT_CODE + * - FLISP_RESULT_MESSAGE + * - FLISP_RESULT_OBJECT + * + */ +void lisp_eval(Interpreter *interp, char *input) { FILE *fd = NULL; Object *result; - if (input != NULL) { - fl_debug(interp, "lisp_eval3(\"%s\")", input); + if (input == NULL) { + fl_debug(interp, "lisp_eval()"); + if (interp->input == NULL) { + interp->object = openInputStreamError(); + return; + } + } else { + fl_debug(interp, "lisp_eval(\"%s\")", input); if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { interp->object = openInputStreamError(); return; @@ -2783,8 +2651,8 @@ void lisp_eval3(Interpreter *interp, char *input) } if (interp->object->car != nil) break; + lisp_write_object(interp, interp->output, FLISP_RESULT_OBJECT, true); result = interp->object; - lisp_write_object(interp, interp->output, result->cdr->cdr->car, true); writeChar(interp, interp->output, '\n'); } if (interp->output) fflush(interp->output); diff --git a/lisp.h b/lisp.h index b14b093..33989bb 100644 --- a/lisp.h +++ b/lisp.h @@ -11,7 +11,7 @@ #include #define FL_NAME "fLisp" -#define FL_VERSION "0.10" +#define FL_VERSION "0.11" #define FL_INITFILE "flisp.rc" #define FL_LIBDIR "/usr/local/share/flisp" @@ -86,11 +86,13 @@ typedef struct Memory { } Memory; typedef struct Interpreter { + Object *object; /* result or error object */ + + /* private */ Object *result; /* result symbol */ char msg_buf[WRITE_FMT_BUFSIZ]; /* error string */ - /* private */ FILE *input; /* default input stream object */ FILE *output; /* default output file descriptor */ FILE *debug; /* debug stream */ @@ -178,6 +180,7 @@ void fl_debug(Interpreter *, char *, ...); #define FLISP_ARG_TWO (*args)->cdr->car #define FLISP_ARG_THREE (*args)->cdr->cdr->car +#define FLISP_HAS_ARGS *args != nil #define FLISP_HAS_ARG_TWO ((*args)->cdr != nil) #define FLISP_HAS_ARG_THREE ((*args)->cdr->cdr != nil) @@ -189,15 +192,13 @@ void fl_debug(Interpreter *, char *, ...); // PUBLIC INTERFACE /////////////////////////////////////////////////////// extern Interpreter *lisp_new(size_t, char**, char*, FILE*, FILE*, FILE*); extern void lisp_destroy(Interpreter *); -extern void lisp_eval(Interpreter *); -extern void lisp_eval_string(Interpreter *, char *); +extern void lisp_eval(Interpreter *, char *); extern void lisp_write_object(Interpreter *, FILE *, Object *, bool); extern void lisp_write_error(Interpreter *, FILE *); -extern void lisp_write_error2(Interpreter *, FILE *); -extern void lisp_eval2(Interpreter *); -extern void lisp_eval3(Interpreter *, char *); -extern void lisp_eval_string2(Interpreter *, char *); +#define FLISP_RESULT_CODE interp->object->car +#define FLISP_RESULT_MESSAGE interp->object->cdr->car +#define FLISP_RESULT_OBJECT interp->object->cdr->cdr->car #endif /* diff --git a/main.c b/main.c index 233a631..2224a74 100644 --- a/main.c +++ b/main.c @@ -38,10 +38,9 @@ void load_file(char *file) } interp->input = fd; interp->output = debug_fp; - lisp_eval(interp); - if (interp->result != nil) { - // Note: the error object can be printed with lisp_write_object - debug("failed to load file %s: %s\n", file, interp->msg_buf); + lisp_eval(interp, NULL); + if (FLISP_RESULT_CODE != nil) { + debug("failed to load file %s:\n", file); lisp_write_error(interp, debug_fp); } if (fclose(fd)) @@ -149,8 +148,8 @@ char *eval_string(bool do_format, char *format, ...) prev = interp->output; // Note: save for double invocation with user defined functions. interp->output = open_memstream(&output, &len); - lisp_eval_string(interp, input); - if (interp->result == nil) + lisp_eval(interp, input); + if (FLISP_RESULT_CODE == nil) return output; if (interp->output) fflush(interp->output); diff --git a/makefile b/makefile index b55c938..b50d1b0 100644 --- a/makefile +++ b/makefile @@ -41,6 +41,7 @@ LISPFILES = femto.rc lisp/startup.lsp lisp/defmacro.lsp \ lisp/string.lsp FLISPFILES = flisp.rc lisp/flisp.lsp lisp/stdlib.lsp +FLISPSOURCES = lisp.c lisp.h double.c double.h file.c file.h DOCFILES = BUGS CHANGE.LOG.md README.md pdoc/flisp.html MOREDOCS = README.html docs/flisp.md docs/femto.md @@ -162,20 +163,24 @@ flv: flisp FORCE frama-c: FORCE frama-c -c11 -cpp-extra-args="-I$(frama-c -print-path)/libc -I/usr/include -I." -kernel-msg-key pp -metrics *.c -measure: strip FORCE +measure: $(RC_FILES) $(BINARIES) strip FORCE + @ln -s femto.rc femto.lsp + @ln -s flisp.rc flisp.lsp @echo Total - @echo binsize: $$(set -- $$(ls -l femto); echo $$5) - @echo C-lines: $$(cat *.c *.h | wc -l) - @echo linecount: $$(cat *.c *.h $(LISPFILES) | wc -l) - @echo sloccount: $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h $(LISPFILES) | grep ansic=; }); echo $$3) - @echo files: $$(ls *.c *.h $(LISPFILES) | wc -l) - @echo C-files: $$(ls *.c *.h | wc -l) + @echo "binsize: " $$(set -- $$(ls -l femto); echo $$5) + @echo "C/Lisp lines: " $$(cat *.c *.h | wc -l) / $$(cat $(LISPFILES) | wc -l) + @echo "Total lines: " $$(cat *.c *.h $(LISPFILES) | wc -l) + @echo "Total slocs: " $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h femto.lsp $(LISPFILES) | grep ansic=; }); echo $$3) + @echo "C/Lisp files: " $$(ls *.c *.h | wc -l) / $$(echo $(LISPFILES) | wc -w) + @echo "Total files: " $$(ls *.c *.h $(LISPFILES) | wc -l) @echo Minimum - @echo flisp: $$(cat flisp.c | wc -l) - @echo flispsloc: $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.c | grep ansic=; }); echo $$3) - @echo linecount: $$(cat *.c *.h $(LISPFILES) | wc -l) - @echo sloccount: $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h *.rc $(LISPFILES) | grep ansic=; }); echo $$3) - @echo files: $$(ls *.c *.h $(LISPFILES) | wc -l) + @echo "binsize: " $$(set -- $$(ls -l flisp); echo $$5) + @echo "flisp: " $$(cat flisp.c | wc -l) + @echo "flispsloc: " $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.c | grep ansic=; }); echo $$3) + @echo "linecount: " $$(cat $(FLISPSOURCES) $(FLISPFILES) | wc -l) + @echo "sloccount: " $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.lsp $(FLISPSOURCES) $(FLISPFILES) | grep ansic=; }); echo $$3) + @echo "files: " $$(ls $(FLISPSOURCES) $(FLISPFILES) | wc -l) + @rm femto.lsp flisp.lsp run: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto @@ -211,8 +216,8 @@ val: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 valgrind ./femto 2> val.log # Install/package -strip: femto FORCE - strip femto +strip: femto flisp FORCE + strip femto flisp clean: FORCE -$(RM) -f $(OBJ) $(FLISP_OBJ) $(BINARIES) $(RC_FILES) diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index 923d289..b8cb4c7 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -1,26 +1,33 @@ -+ Bump fLisp version: reason: error type symbols instead of result codes -+ Add error type symbols to the top level environment -+ Change to 64 bit integers ++ Bump fLisp version: reason: error type symbols instead of result codes. ++ Add error type symbols to the top level environment. ++ Change to 64 bit integers. + Implement type-of, curry and move all type predicates except null and consp from C to Lisp. -+ Add search to string library -+ implement fold -+ start a test library ++ Add search to string library. ++ Implement fold. ++ start a test library. + Move string-to-number to Lisp by using (read f) from a memory stream. -+ Fix string library, -- Showcase lisp_eval2 with (catch (fread)) mechanism -- Implement fstat and improve femto.rc -- Implement mkdir and fix file save bug -- Implement popen, pclose -- improve/support batch mode: output = stdout -- expose envSet to Lisp and move setq from C to Lisp -- Implement backquote and friends ++ Fix string library. ++ Showcase lisp_eval2 with (catch (fread)) mechanism. ++ Implement fstat. ++ Implement popen, pclose. +- Make femto.rc use fstat. +- Implement mkdir and fix file save bug. +- Improve/support batch mode: output = stdout. +- Expose envSet to Lisp and move setq from C to Lisp. +- Implement backquote and friends. + + The reader already implements '`', ',' and ',@' as `quasiquote`, `unquote` and `splice-unquote`. - Fix reduce, implement map, consider simplifying core functions and make them n-ary in Lisp. -- Unify stdlib into flisp.lsp +- Unify stdlib into flisp.lsp. - Implement simple repl in Lisp - - needs getline - - isatty() can set an 'interactive' flag -- rename global argv to command-line-args, argv0 to invocation-name -- rename os.env to getenv -- make extensions plugable -- test more then one interpreter + - needs getline. + - isatty() can set an 'interactive' flag. +- Rename global argv to command-line-args, argv0 to invocation-name. +- Rename os.env to getenv. +- Make extensions plugable. +- Test more then one interpreter. - ? CSP between interpreters? +- Size reduction: + - Make double extensions optional. + - Replace string-contains with string-search. + - Make file extension optional. + - Reduce binary operators to 'and' and 'xor' and write needed rest in Lisp. diff --git a/pdoc/flisp.html b/pdoc/flisp.html index b7a834f..2806027 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -289,24 +289,10 @@

    Environments, Functions, Evaluation

    Error handling

    - Whenever fLisp encounters an error an exception is thrown. Exceptions have an error type symbol and a human - readable error message. fLisp does not implement stack backtracking. Exceptions are either caught on the top level - of an evaluation or by a catch statement. -

    -

    - In the flisp interpreter the error message is formated as error: message if - the error object is nil otherwise as error: 'object', message, - where object is the serialization of the object causing the error and message is the error - message. -

    -

    - When an exception occurs while calling lisp_eval() or lisp_eval_string() from C-code, - the object field of the interpreter is set to the object causing the error, the result - field is set to the error type symbol and the msg_buf field is set to the error message. -

    -

    - Exceptions can be thrown from within in Lisp code via the throw - function. + Whenever fLisp encounters an error an exception is thrown. Exceptions have an error type symbol a human + readable error message and the object in error, which is nil with generic errors. fLisp does + not implement stack backtracking. Exceptions are either caught on the top level of an evaluation or by + a catch statement.

    The following error type symbols are defined and used internally: @@ -324,7 +310,18 @@

    Error handling

  • out-of-memory
  • gc-error
    • - +

    + Exceptions can be thrown via the throw function. As long as applicable use + one of the existing error codes with throw. +

    +

    + fLisp outputs an error message formated as error: message if the error object + is nil otherwise as error: 'object', message, + where object is the serialization of the object causing the error. message is the error + message. +

    + +

    fLisp Primitives

    @@ -390,8 +387,8 @@

    Interpreter Operations

    Evaluates expr and returns a list with three elements:

    -
    result
    -
    0 on success or any other number indicating an error.
    +
    error_type
    +
    nil on success or an error type symbol.
    message
    A human readable error message.
    object
    The result of the the expression or the object in error.
    @@ -616,12 +613,12 @@

    Library Loading

    variables:

    -
    Library path
    -
    femto: /usr/local/share/femto, FEMTOLIB
    -
    flisp: /usr/local/share/flisp, FLISPLIB
    Startup file
    femto: femto.rc, FEMTORC
    flisp: flisp.rc, FLISPRC
    +
    Library path
    +
    femto: /usr/local/share/femto, FEMTOLIB
    +
    flisp: /usr/local/share/flisp, FLISPLIB

    The library path is exposed to the Lisp interpreter as the variable script_dir. @@ -631,12 +628,24 @@

    Library Loading

    path conveniently and without repetition. The command to load the file example.lsp from the library is (require 'example).

    -

    Femto provides a set of libraries, some of them are required by the editor

    +

    Femto provides the following set of libraries:

    +
    +
    core
    +
    + Integrated in the .rc files, always loaded. The core library implements the minimum required Lisp + features for loading libraries. +
    +
    flisp
    +
    + Implements expected standard Lisp functions and additions expected by femto and flisp. +
    +
    string
    String manipulation library.
    +
    femto
    femto editor specific functions.
    +
    bufmenu, defmacro, dired, info
    femto editor utilities
    +
    git, grep, oxo
    femto editor modules
    +

    Core Library

    -

    - This library is built into the startup file. -

    (list [element ..]) C
    Returns the list of all provided elements.
    @@ -797,6 +806,7 @@

    fLisp Library

    Standard Library

    +

    To be integrated into the flisp library

    This library implements some Common Lisp functions, which are not used in the editor libraries. They are provided for reference. @@ -1140,8 +1150,8 @@

    Embedding fLisp

    Embedding Overview

    - fLisp can be embedded into a C application. Two examples of embedding are the `femto` editor and the simplistic - `flisp` command line Lisp interpreter. + fLisp can be embedded into a C application. Two examples of embedding are the femto editor and the + simplistic flisp command line Lisp interpreter.

    Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions @@ -1149,44 +1159,42 @@

    Embedding Overview

    file. Two extensions are provided: the Femto extension which provides the editor functionality and the file extension which provides access to the low level stream I/O functions and adds some more.

    - fLisp exposes the following public interface functions: + fLisp exposes the following public interface functions:

    lisp_new()
    Create a new interpreter.
    lisp_destroy()
    Destroy an interpreter, releasing resources.
    -
    lisp_eval()
    Evaluate input stream until exhausted or error.
    -
    lisp_eval_string()
    Evaluate given string until exhausted or error.
    +
    lisp_eval()
    Evaluate a string or the input stream until exhausted or error.
    lisp_write_object()
    Format and write object to file descriptor.
    lisp_write_error()
    Format and write the error object and error message of an interpreter to a file descriptor.

    - Different flows of operation can be implemented. The Femto editor initializes the interpreter without input/output - file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed or upon - explicit request via the editor interface. + Different flows of operation can be implemented. The femto editor initializes the interpreter without + input/output file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed + or upon explicit request via the editor interface.

    The flisp command line interpreter sets stdout as the default output file descriptors of - the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is not a - terminal stdin is set as the default input file descriptor and fLisp reads it through until end of - file. + the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is + not a terminal stdin is set as the default input file descriptor and fLisp reads it through + until end of file.

    - After processing the given input, the interpreter puts a pointer to the object which is the result of the last - evaluation into the object field of the interpreter structure. The result field is set - to the nil and the msg_buf field is set to the empty string. + After processing the input, the interpreter puts a catch result in the + form (error_type message object) object into the object + field of the interpreter structure. Upon success error_type is nil and the object element + is the result of the last evaluation. They can be accessed with the C-macros FLISP_RESULT_CODE + and FLISP_RESULT_OBJECT.

    - fLisp sends all output to the default output stream. If NULL is given on initialization, output is - suppressed altogether. -

    - If an exception is thrown inside the Lisp interpreter an error message is formatted and copied to - the msg_buf buffer of the interpreter, A pointer to the object causing the error is set to - the object field. The result field is set to the respective error type symbol. + On error use lisp_write_error() to write the standard error message to a file descriptor of choice, + or use the above C-macros and FLISP_ERROR_MESSAGE for taking specific action. Note that these macros + evaluate to a Lisp object, you have to dereference their content to used it.

    - In this error state of the interpreter, the function lisp_write_error() can be used to - write a standardized error message including the error object to a file descriptor of choice + fLisp sends all output to the default output stream. If NULL is given on initialization, output is + suppressed altogether.

    fLisp C Interface

    @@ -1232,19 +1240,19 @@

    fLisp C Interface

    Frees all resources used by the interpreter.
    - void lisp_eval(Interpreter *interp) -
    + void lisp_eval(Interpreter *interp, char *string)
    -

    - Evaluates the input file set in the input field of the fLisp interpreter interp until - end of file. If no input file is set, interp is set to a respective error state. -

    + If string is not NULL evaluates all Lisp expressions in string.
    -
    - void lisp_eval_string(Interpreter *interp, char *string) -
    - Evaluates all Lisp expressions in string.
    + If string is NULL input from the file descriptor in the input field of + the fLisp interpreter interp is evaluated until end of file. + + +
    + If no memory can be allocated for the input string or the input file descriptor is NULL no Lisp + evaluation takes place and the object field of the interpreter is set to an io-error. +
    void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool readably) @@ -1269,7 +1277,7 @@

    Building Extensions

    signature: Object *primitive(Interpreter *interp, Object **args, Object **env), where primitive is a distinct name in C space. This function has to be added to the global variable primitives in the following - format: {"name", argMin, argMax, primitive}. Here + format: {"name", argMin, argMax, type_check, primitive}. Here name is a distinct name in Lisp space.

    @@ -1278,6 +1286,11 @@

    Building Extensions

    for the function. If argMax is a negative number, arguments must be given in tuples of argMax and the number of tuples is not restricted.

    +

    + When type check is set to a type C-macro the interpreter assures that all arguments are of the given type and + creates a standardized exception otherwise. When type check is set to 0 the primitive has to take + care of type checking by itself. The C-macro CHECK_TYPE helps with this. +

    When creating more then one new objects within a primitive, care has to be taken to register them with the garbage collector. Registration is started with the @@ -1287,29 +1300,24 @@

    Building Extensions

    macro GC_RETURN(object) calls GC_RELEASE and returns object.

    - Some CPP macros are provided to simplify argument validation in primitives, all of them receive - the name of the primitive as a parameter: + Some CPP macros are provided to simplify argument access and validation in primitives:

    -
    TWO_STRING_ARGS(name)
    -
    - Assures that the first two arguments are of type string. They are assigned to the Object * - variables first and second. -
    -
    ONE_STRING_ARG(name)
    -
    - Assures that the first argument is of type string. It is assigned to the Object * - variable arg. -
    +
    FLISP_HAS_ARGS
    +
    FLISP_HAS_ARG_TWO
    +
    FLISP_HAS_ARG_THREE
    +
    Evaluate to true if there are arguments or the respective argument is available.
    ONE_NUMBER_ARG(name)
    +
    FLISP_ARG_ONE
    +
    FLISP_ARG_TWO
    +
    FLISP_ARG_THREE
    +
    Evaluate to the respective argument.
    +
    CHECK_TYPE(argument, type, signature)
    - Assures that the first argument is of type number. It is assigned to the Object * - variable num. -
    -
    ONE_STREAM_ARG(name)
    -
    - Assures that the first argument is of type stream. It is assigned to the Object * - variable stream. + Assures that the given argument is of the given type. type must be a type variable + like type_string. signature is the signature of the primitive followed + by  -  and the name of the argument to be type checked. This is used to form a + standardized wrong-type-argument error message.
    @@ -1318,9 +1326,9 @@

    Implementation Details

    Garbage Collection

    - fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal halves - (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used during - garbage collection. + fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal + halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used + during garbage collection.

    When garbage collection is performed, objects that are still in use (live) are copied from from-space to @@ -1371,7 +1379,8 @@

    Memory Usage

    Output buffer
    2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.

    - fLisp can live with as little as 300k object memory. The Femto editor requires 16M since the OXO game requires a lot of memory. + fLisp can live with as little as 400k object memory. The Femto editor requires 16M since the OXO + game requires a lot of memory.

    Future Directions

    @@ -1386,27 +1395,10 @@

    Future Directions

    input result codes are returned.

    - Integer arithmetic would be sufficient for all current purposes and increase portability and speed while reducing - size. -

    -

    - The file extension only contains (fflush), (ftell) and (fgetc) and could - easily be extended into something useful. (fstat) would be most pressing for - improving femto.rc and flisp.rc. -

    -

    - The string library should implement Elisp substring to replace string.substring and a - simplified version of string-search without start index. -

    -

    - Implement (type object) returning symbols for each type in C and implement individual type - checking predicates in Lisp. -

    -

    - loop programming is availble via the labelled let macro. It could made easier, by any combination of: + Loops are availble via the labelled let macro and supported by iota. It could made easier, by any + combination of:

      -
    • iota
    • loop/while/for macro
    • Demoing hand crafted loops including breaking with throw.
    diff --git a/test/1_primitives.test b/test/1_primitives.test index 049881b..19bd687 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -29,7 +29,7 @@ flisp_err; ok reader-1 incomplete sexp error msg IN='"' ERR='unexpected end of stream in string literal' flisp_err; ok reader-2 incomplete string error msg -IN='\\' OBJ="nil" ERR="unexpected character, \`'" +IN='}' OBJ="" ERR="unexpected character: '}'" flisp_err; ok reader-3 unexpected character error msg IN="0" OUT='0' From 5261d801eb256d7cde4d18d84682dd06b973ef2f Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 12:57:06 +0200 Subject: [PATCH 20/90] Fix: fstat does not test on POSIX extended file types, glibc does not support them --- file.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/file.c b/file.c index 95591b6..222063d 100644 --- a/file.c +++ b/file.c @@ -160,10 +160,13 @@ Object *primitiveFstat(Interpreter *interp, Object** args, Object **env) else if (S_ISREG(info.st_mode)) type = "f"; else if (S_ISLNK(info.st_mode)) type = "l"; else if (S_ISSOCK(info.st_mode)) type = "s"; +#if 0 + /* This works with muslc, but not gnu libc */ else if (S_TYPEISMQ(info)) type = "Q"; else if (S_TYPEISSEM(info)) type = "S"; else if (S_TYPEISSHM(info)) type = "M"; else if (S_TYPEISTMO(info)) type = "T"; +#endif else type = "-"; object = newString(interp, type); From e8849e07c0e85cd0660e9114d6250c4c4100257a Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 23:17:52 +0200 Subject: [PATCH 21/90] Dynamic memory allocation to- and fromSpace are allocated individually and resized on demand. FLISP_MEMORY_INC_SIZE determines the size of allocation junks. Note: While all tests pass when sufficient initial memory is given, gc_always still segfaults. --- flisp.c | 30 ++++++---- header.h | 23 ++++---- lisp.c | 121 +++++++++++++++++++++++++++++------------ lisp.h | 1 + main.c | 4 ++ test/1_primitives.test | 12 ++-- 6 files changed, 127 insertions(+), 64 deletions(-) diff --git a/flisp.c b/flisp.c index 077013e..ac6a28a 100644 --- a/flisp.c +++ b/flisp.c @@ -9,10 +9,14 @@ #include #include "lisp.h" -// Specify in kByte. -#define FLISP_MEMORY_SIZE 400 -// less then this is too small for femto.lsp - +/* Specify in kByte. Less then 263 is too small for loading stdlib.lsp + * and running the tests. + */ +// +// +#define FLISP_MEMORY_SIZE 363 +//Note: debugging: #define FLISP_MEMORY_SIZE 263 +//Note: debugging: #define FLISP_MEMORY_SIZE 200 #define CPP_XSTR(s) CPP_STR(s) #define CPP_STR(s) #s @@ -55,11 +59,12 @@ void repl(Interpreter *interp) } lisp_eval(interp, input); - if (FLISP_RESULT_CODE != nil) + if (FLISP_RESULT_CODE != nil) { lisp_write_error(interp, stderr); + if (FLISP_RESULT_CODE == out_of_memory) break; + } } if (FLISP_RESULT_CODE != nil) { - lisp_write_error(interp, stderr); exit_code = 1; } return; @@ -95,9 +100,11 @@ int main(int argc, char **argv) interp->input = fd; lisp_eval(interp, NULL); if (FLISP_RESULT_CODE != nil) { + fprintf(stderr, "failed to load inifile %s:\n", init_file); lisp_write_error(interp, stderr); - fprintf(stderr, "failed to load inifile %s: %s\n", init_file, interp->msg_buf); - // Note: if we could implement the repl in fLisp itself we'd bail out here. + if (FLISP_RESULT_CODE == out_of_memory) + return 1; + // Note: if we could implement the repl in fLisp itself we'd done here. } if (fclose(fd)) // Note: the error object can be printed with lisp_write_object @@ -113,12 +120,11 @@ int main(int argc, char **argv) // Just eval the standard input interp->input = stdin; lisp_eval(interp, NULL); - if (FLISP_RESULT_CODE != nil) { + if (FLISP_RESULT_CODE != nil) lisp_write_error(interp, stderr); - exit_code = 1; - } } - lisp_destroy(interp); + if (FLISP_RESULT_CODE != out_of_memory) + lisp_destroy(interp); return exit_code; } diff --git a/header.h b/header.h index 0ab868e..3b3225f 100644 --- a/header.h +++ b/header.h @@ -506,17 +506,20 @@ extern window_t *popup_window(char *); extern window_t *split_current_window(void); /* fLisp interpreter used for femto */ -//#define FLISP_MEMORY_SIZE 131072UL // 128k -//#define FLISP_MEMORY_SIZE 262144UL // 256k -//#define FLISP_MEMORY_SIZE 524288UL // 512k -//#define FLISP_MEMORY_SIZE 1048576UL // 1M -//#define FLISP_MEMORY_SIZE 1572864UL // 1.5M -//#define FLISP_MEMORY_SIZE 2097152UL // 2M -//#define FLISP_MEMORY_SIZE 4194304UL // 4M -//#define FLISP_MEMORY_SIZE 6291456UL // 6M -//#define FLISP_MEMORY_SIZE 8388608UL // 8M -#define FLISP_MEMORY_SIZE 16777216UL // 16M +/* size test done with oxo */ +//#define FLISP_MEMORY_SIZE 524288UL // 512k - OOM on start +#define FLISP_MEMORY_SIZE 1048576UL // 1M +//#define FLISP_MEMORY_SIZE 2097152UL // 2M +//#define FLISP_MEMORY_SIZE 4194304UL // 4M +//#define FLISP_MEMORY_SIZE 8388608UL // 8M +//#define FLISP_MEMORY_SIZE 16777216UL // 16M //#define FLISP_MEMORY_SIZE 33554432UL // 32M +//#define FLISP_MEMORY_SIZE 67108864UL // 64M +//#define FLISP_MEMORY_SIZE 134217728UL // 128M +//#define FLISP_MEMORY_SIZE 268435456UL // 256M +//#define FLISP_MEMORY_SIZE 402653184UL // 384M +//#define FLISP_MEMORY_SIZE 536870912UL // 512M + extern char *eval_string(bool, char *, ...); extern void free_lisp_output(void); diff --git a/lisp.c b/lisp.c index f6614b6..04e7307 100644 --- a/lisp.c +++ b/lisp.c @@ -30,6 +30,11 @@ #include "file.h" #endif +#define EXCEPTION_MEM_RESERVE 4*sizeof(Object) +//Note: debugging //#define EXCEPTION_MEM_RESERVE 8*sizeof(Object) + +/* No user servicable parts inside */ + #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif @@ -341,7 +346,7 @@ void gc(Interpreter *interp) Object *object; gcStats stats = {0}; - fl_debug(interp, "collecting garbage, memory: %lu/%lu", interp->memory->fromOffset, interp->memory->capacity); + fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu", interp->memory->fromOffset, interp->memory->capacity, interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE); interp->memory->toOffset = 0; @@ -395,10 +400,13 @@ void gc(Interpreter *interp) interp->memory->fromSpace = interp->memory->toSpace; interp->memory->toSpace = swap; - fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu", + /* report before overwriting offset difference */ + fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu free: %lu(%lu) bytes", stats.moved, stats.skipped, stats.constant, interp->memory->fromOffset - interp->memory->toOffset, - interp->memory->toOffset, interp->memory->capacity + interp->memory->toOffset, interp->memory->capacity, + interp->memory->capacity - interp->memory->toOffset - EXCEPTION_MEM_RESERVE, + interp->memory->capacity - interp->memory->toOffset ); interp->memory->fromOffset = interp->memory->toOffset; @@ -412,31 +420,77 @@ size_t memoryAlign(size_t size, size_t alignment) return (size + alignment - 1) & ~(alignment - 1); } +/** memoryAllocObject() - Acquire memory for a new Lisp object + * + * Lisp object space is divided intox 'from' space and 'to' space. + * Objects are always allocated in 'from' space. If memory there is + * exhausted, active objects are garbage collected into 'to' space and + * 'to' and 'from' spaces are swapped by gc(). + * + * If gc() does not release sufficient space, 'from' and 'to' space + * are increased by a multiple of FLISP_MEMORY_INC_SIZE. + * + */ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) { size = memoryAlign(size, sizeof(void *)); - // allocate from- and to-space + /* If not done already allocate to space */ if (!interp->memory->fromSpace) { - if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity * 2, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { - if (!interp->catch) return nil; - exception(interp, out_of_memory, "mmap() failed, %s", strerror(errno)); + if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { + fprintf(stderr, "OOM, allocating from space, exiting\n"); + exit(2); } - interp->memory->toSpace = (char *)interp->memory->fromSpace + interp->memory->capacity; } - // run garbage collection if capacity exceeded -#if DEBUG_GC - if (gc_always) + /* Run garbage collection if capacity exceeded */ + if ( + (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) +#if DEBUG_GC_ALWAYS + || gc_always +#endif + ) { + fl_debug(interp, "memoryAllocObject: requesting %lu bytes", size); + /* If not done already allocate to space */ + if (!interp->memory->toSpace) { + if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { + fprintf(stderr, "OOM allocating to space, exiting\n"); + exit(2); + } + } gc(interp); -#else - if ((interp->memory->fromOffset + size >= interp->memory->capacity)) + } + /* Check if we now have enough space */ + if (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) { + int blocks = size / FLISP_MEMORY_INC_SIZE + 1; + size_t memory = blocks * FLISP_MEMORY_INC_SIZE; + fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu", size, memory); + /* Increase to space */ + void *new; + new = mmap(NULL, interp->memory->capacity + FLISP_MEMORY_INC_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + if (new == (void *) -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "OOM reallocating toSpace: %s", strerror(errno)); + } + if (munmap(interp->memory->toSpace, interp->memory->capacity) == -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "munmap(toSpace) failed: %s", strerror(errno)); + } + interp->memory->toSpace = new; + interp->memory->capacity += memory; gc(interp); -#endif - if (interp->memory->fromOffset + size >= interp->memory->capacity) { - if (!interp->catch) return nil; - exception(interp, out_of_memory, "out of memory, %lu bytes", (unsigned long)size); + /* Increase former from space */ + new = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + if (new == (void *) -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "OOM reallocating fromSpace: %s", strerror(errno)); + } + if (munmap(interp->memory->toSpace, interp->memory->capacity - memory) == -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "munmap(fromSpace) failed: %s", strerror(errno)); + } + interp->memory->toSpace = new; } - // allocate object in from-space + /* Allocate object in from-space */ Object *object = (Object *) ((char *)interp->memory->fromSpace + interp->memory->fromOffset); object->type = type; object->size = size; @@ -2433,6 +2487,7 @@ Interpreter *lisp_new( if (size/2 < FLISP_MIN_MEMORY) { interp->result = invalid_value; + /* Note: obsolete error reporting - update needed */ strncpy(interp->msg_buf, "fLisp needs at least" CPP_STR(FLISP_MIN_MEMORY) "bytes to start up", sizeof(interp->msg_buf)); return NULL; @@ -2467,17 +2522,16 @@ Interpreter *lisp_new( object = newCons(interp, &nil, &nil); object = newCons(interp, &t, &object); interp->symbols = object; - fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity); - /* gc region start */ - - /* global environment */ - initRootEnv(interp); interp->catch = &interp->exceptionEnv; interp->next = interp; lisp_interpreters = interp; + /* global environment */ + initRootEnv(interp); + + /* gc region start */ /* Add argv0 to the environment */ Object *var = newSymbol(interp, "argv0"); Object *val = newString(interp, *argv); @@ -2512,7 +2566,9 @@ Interpreter *lisp_new( var = newSymbol(interp, "*OUTPUT*"); (void)envSet(interp, &var, &val, &interp->global, true); } -#if DEBUG_GC && DEBUG_GC_ALWAYS + fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity/2); + +#if DEBUG_GC_ALWAYS gc_always = true; #endif return interp; @@ -2525,20 +2581,11 @@ void lisp_destroy(Interpreter *interp) i->next = interp->next; i = NULL; -#if 0 if (interp->memory->fromSpace) - (void)munmap(interp->memory->fromSpace, interp->memory->capacity * 2); + (void)munmap(interp->memory->fromSpace, interp->memory->capacity); // Note: we do not know which one it is, so we free both. if (interp->memory->toSpace) - (void)munmap(interp->memory->toSpace, interp->memory->capacity * 2); -#else - if (interp->memory->fromSpace && interp->memory->toSpace) { - if (interp->memory->fromSpace < interp->memory->toSpace) - (void)munmap(interp->memory->fromSpace, interp->memory->capacity * 2); - else - (void)munmap(interp->memory->toSpace, interp->memory->capacity * 2); - } -#endif + (void)munmap(interp->memory->toSpace, interp->memory->capacity); if (interp->debug) fclose(interp->debug); @@ -2568,10 +2615,11 @@ void lisp_write_error(Interpreter *interp, FILE *fd) fflush(fd); } -/** (catch (eval (read f))) +/** (catch (eval (read f))) or (catch (eval (read))) */ void cerf(Interpreter *interp, FILE *fd) { + /* Note: find a way to not construct this all the time anew */ Primitive readPrimitive = { "read", 0, 2, 0, primitiveRead }; Primitive evalPrimitive = { "eval", 1, 1, 0, primitiveEval }; @@ -2592,6 +2640,7 @@ void cerf(Interpreter *interp, FILE *fd) Object *openInputStreamError(void) { + /* Note: find a way to not construct this all the time anew */ Object *m = &(Object) { type_string, .string = "cannot open input stream" }; Object *o = &(Object) { type_cons, .car = nil, .cdr = nil }; o = &(Object) { type_cons, .car = m, .cdr = o }; diff --git a/lisp.h b/lisp.h index 33989bb..46b92b6 100644 --- a/lisp.h +++ b/lisp.h @@ -18,6 +18,7 @@ /* minimal Lisp object space size */ #define FLISP_MIN_MEMORY 26624UL /* currently ~26k */ +#define FLISP_MEMORY_INC_SIZE 8192UL /* Resize by this amount */ /* buffersize for Lisp eval input */ #define INPUT_FMT_BUFSIZ 2048 diff --git a/main.c b/main.c index 2224a74..8e9c448 100644 --- a/main.c +++ b/main.c @@ -42,6 +42,8 @@ void load_file(char *file) if (FLISP_RESULT_CODE != nil) { debug("failed to load file %s:\n", file); lisp_write_error(interp, debug_fp); + if (FLISP_RESULT_CODE == out_of_memory) + fatal("OOM, exiting.."); } if (fclose(fd)) debug("failed to close file %s\n", file); @@ -158,6 +160,8 @@ char *eval_string(bool do_format, char *format, ...) lisp_write_error(interp, debug_fp); debug("=> %s\n", output); } + if (FLISP_RESULT_CODE == out_of_memory) + fatal("OOM, exiting.."); free_lisp_output(); return NULL; } diff --git a/test/1_primitives.test b/test/1_primitives.test index 19bd687..b3e764e 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -5,7 +5,7 @@ export FLISPRC= -tap 161 +tap 160 [ -x ../femto ] ok femto-1 femto exists and is executable; @@ -13,7 +13,7 @@ ok femto-1 femto exists and is executable; (FEMTORC= FEMTO_BATCH=1 ../femto >/dev/null) ok femto-2 w/o femto.rc femto in batch mode succeds -(: | FEMTORC=- FEMTO_BATCH=1 ../femto >/dev/null) +(: | FEMTORC= FEMTO_BATCH=1 ../femto >/dev/null) ok femto-3 empty input succeeds [ -x ../flisp ] @@ -195,6 +195,10 @@ flisp_expr; ok lambda-6 args nil nil IN='((lambda (a b) a b) 0 "a")' OUT='"a"' flisp_expr; ok lambda-7 apply return b string a +# Time for memory allocator test +#IN='(setq r (lambda args (r args))) (r)' OBJ='out of memory, 48 bytes' ERR='48 bytes' +#flisp_err 1; ok memory-1 exhausting memory exits with error code + # macro IN='(macro nil)' OUT='#' flisp_expr; ok macro-1 arg nil @@ -478,7 +482,3 @@ false; ok os.getenv \# TODO # File extension false; ok file extension \# TODO - -# Femto editor extension - -false; ok femto editor extension \# TODO From 706ece738b59d6c5955eac1a1b8cf68904342d57 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 23:19:53 +0200 Subject: [PATCH 22/90] Fix nthcdr for indexes greater then length of list --- lisp/flisp.lsp | 21 +++++++++++++++------ test/3_flisp.test | 26 +++++++++++++++++++++----- 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/lisp/flisp.lsp b/lisp/flisp.lsp index 8d1de0a..2f69aed 100644 --- a/lisp/flisp.lsp +++ b/lisp/flisp.lsp @@ -30,16 +30,25 @@ (defun min (n . args) (cond ((null (numberp n)) - (throw 'wrong-type-argument "not a number" n)) + (throw wrong-type-argument "not a number" n)) ((null args) n) (t (reduce (lambda (a b) (cond ((< a b) a) (t b))) args n)) )) -(defun nthcdr (n list) - (cond - ((> 0 n) (throw 'range-error "negativ index" n)) - ((= 0 n) list) - (t (nthcdr (- n 1) (cdr list))))) +(defun nthcdr (n l) + (cond + ((not (integerp n)) + (throw wrong-type-argument + (concat "(nthcdr n l) - n expected type-integer, got: " (type-of n)) + n)) + ((< n 0) (throw range-error "negative index" n)) + ((null l) nil) + ((= 0 n) l) + ((not (consp l)) + (throw wrong-type-argument + (concat "(nthcdr n l) - l expected type-cons, got: " (type-of l)) + l)) + (t (nthcdr (- n 1) (cdr l))))) (defun nth (n list) (car (nthcdr n list))) diff --git a/test/3_flisp.test b/test/3_flisp.test index d0ee789..de79dc3 100755 --- a/test/3_flisp.test +++ b/test/3_flisp.test @@ -1,7 +1,7 @@ #!./test# -*- mode: sh -*- # test the fLisp library # leg20231129: Femto -tap 58 +tap 62 export FLISPRC=../lisp/core.lsp flisplib() { IN="(require 'flisp) $IN" flisp_expr "$@"; } @@ -160,18 +160,34 @@ IN='(min 1 2 3)' OUT=1 flisplib 1; ok min-6 with more then two args IN='(nthcdr -1 nil)' -ERR="negativ index" +ERR="negative index" OBJ='-1' flisplib_err 1; ok nthcdr-1 negativ index fails IN="(nthcdr 0 '(a b c))" OUT='(a b c)' -flisplib 1; ok nthcdr-2 0 index yields list +flisplib 1; ok nthcdr-2 0 index is list IN="(nthcdr 2 '(a b c))" OUT='(c)' -flisplib 1; ok nthcdr-3 last index yields last element list +flisplib 1; ok nthcdr-3 last index is last element IN="(nthcdr 40 '(a b c))" OUT=nil -flisplib 1; ok nthcdr-4 index over length yields nil +flisplib 1; ok nthcdr-4 index over length is nil + +IN="(nthcdr 40 nil)" OUT=nil +flisplib 1; ok nthcdr-5 of nil is nil + +IN="(nthcdr 1 '(2 . 3))" OUT=3 +flisplib 1; ok nthcdr-6 of 1 of cons is cdr + +IN="(nthcdr 'a nil)" +ERR="(nthcdr n l) - n expected type-integer, got: type-symbol" +OBJ='a' +flisplib_err 1; ok nthcdr-7 wrong index type fails + +IN="(nthcdr 1 'a)" +ERR="(nthcdr n l) - l expected type-cons, got: type-symbol" +OBJ='a' +flisplib_err 1; ok nthcdr-8 wrong list type fails IN="(nth 1 '(a b c))" OUT=b flisplib 1; ok nth-1 yields element From 885b8b375741d1b3d183247d5f982f81f97cbf1a Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 23:21:06 +0200 Subject: [PATCH 23/90] For the moment disable femto.test Must be rewritten in Lisp --- test/{5_femto.test => 6_femto.test.disabled} | 6 ++++++ 1 file changed, 6 insertions(+) rename test/{5_femto.test => 6_femto.test.disabled} (77%) diff --git a/test/5_femto.test b/test/6_femto.test.disabled similarity index 77% rename from test/5_femto.test rename to test/6_femto.test.disabled index 936bebf..da60728 100755 --- a/test/5_femto.test +++ b/test/6_femto.test.disabled @@ -1,3 +1,9 @@ +# Note: the femto library cannot be loaded into the flisp interpreter: +# We do not have the editor extension compiled in and the library is +# just to big. +# This file must be rewritten to use the *lisp* testmode. Anyway: +# The tests are only enumerated, but not written yet. + #!./test# -*- mode: sh -*- # # test the femto Lisp extensions From 253f684566ded1c495da2b56a9ea71cbc03b1498 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 23:21:30 +0200 Subject: [PATCH 24/90] String test renumbered before femto test --- test/{6_string.test => 5_string.test} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test/{6_string.test => 5_string.test} (100%) diff --git a/test/6_string.test b/test/5_string.test similarity index 100% rename from test/6_string.test rename to test/5_string.test From 1d48a646f93051b4a1afb6deab5be281fbe1392f Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 29 Aug 2025 23:48:11 +0200 Subject: [PATCH 25/90] Remove gc tracing from initRootEnv and lisp_init. --- lisp.c | 40 ++++++++++++++++------------------------ lisp.h | 4 ++-- 2 files changed, 18 insertions(+), 26 deletions(-) diff --git a/lisp.c b/lisp.c index 04e7307..ba56d3e 100644 --- a/lisp.c +++ b/lisp.c @@ -2373,11 +2373,9 @@ Primitive primitives[] = { void initRootEnv(Interpreter *interp) { int i, nConstants; + Object *var, *val; - GC_CHECKPOINT; - GC_TRACE(gcEnv, newEnv(interp, &nil, &nil)); - - interp->global = *gcEnv; + interp->global = newEnv(interp, &nil, &nil); // add constants nConstants = sizeof(flisp_constants) / sizeof(flisp_constants[0]); @@ -2405,21 +2403,19 @@ void initRootEnv(Interpreter *interp) ok->cdr = okMessage; // add primitives - GC_TRACE(gcVar, nil); - GC_TRACE(gcVal, nil); int nPrimitives = sizeof(primitives) / sizeof(primitives[0]); for (i = 0; i < nPrimitives; ++i) { - *gcVar = newSymbol(interp, primitives[i].name); - *gcVal = newPrimitive(interp, &primitives[i]); + var = newSymbol(interp, primitives[i].name); + val = newPrimitive(interp, &primitives[i]); - envSet(interp, gcVar, gcVal, &interp->global, true); + envSet(interp, &var, &val, &interp->global, true); } #ifdef FLISP_DOUBLE_EXTENSION for (Primitive *entry = flisp_double_primitives; entry->name != NULL; entry++) { - *gcVar = newSymbol(interp, entry->name); - *gcVal = newPrimitive(interp, entry); + var = newSymbol(interp, entry->name); + val = newPrimitive(interp, entry); - envSet(interp, gcVar, gcVal, &interp->global, true); + envSet(interp, &var, &val, &interp->global, true); } #endif #ifdef FLISP_FILE_EXTENSION @@ -2430,13 +2426,12 @@ void initRootEnv(Interpreter *interp) } for (Primitive *entry = flisp_file_primitives; entry->name != NULL; entry++) { - *gcVar = newSymbol(interp, entry->name); - *gcVal = newPrimitive(interp, entry); + var = newSymbol(interp, entry->name); + val = newPrimitive(interp, entry); - envSet(interp, gcVar, gcVal, &interp->global, true); + envSet(interp, &var, &val, &interp->global, true); } #endif - GC_RELEASE; } Memory *newMemory(size_t size) @@ -2498,40 +2493,36 @@ Interpreter *lisp_new( Memory *memory = newMemory(size); if (memory == NULL) { interp->result = out_of_memory; + /* Note: obsolete error reporting - update needed */ strncpy(interp->msg_buf, "failed to allocate memory for the interpreter", sizeof(interp->msg_buf)); return NULL; } interp->memory = memory; + /* Note: obsolete initialization - update needed */ interp->object = ok; interp->msg_buf[0] = '\0'; interp->result = nil; - interp->catch = NULL; - interp->buf = NULL; resetBuf(interp); - // dynamic gc trace stack interp->gcTop = nil; + interp->catch = &interp->exceptionEnv; - /* gc setup */ /* symbols */ Object *object; object = newCons(interp, &nil, &nil); object = newCons(interp, &t, &object); interp->symbols = object; - interp->catch = &interp->exceptionEnv; - interp->next = interp; lisp_interpreters = interp; /* global environment */ initRootEnv(interp); - /* gc region start */ /* Add argv0 to the environment */ Object *var = newSymbol(interp, "argv0"); Object *val = newString(interp, *argv); @@ -2541,6 +2532,7 @@ Interpreter *lisp_new( var = newSymbol(interp, "argv"); val = nil; Object **i; + /* Note: this can trigger a gc() if argv has many elements, check with max commandline length */ for (i = &val; *++argv; i = &(*i)->cdr) { *i = newCons(interp, &nil, &nil); (*i)->car = newString(interp, *argv); @@ -2566,7 +2558,7 @@ Interpreter *lisp_new( var = newSymbol(interp, "*OUTPUT*"); (void)envSet(interp, &var, &val, &interp->global, true); } - fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity/2); + fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity); #if DEBUG_GC_ALWAYS gc_always = true; diff --git a/lisp.h b/lisp.h index 46b92b6..45fc94b 100644 --- a/lisp.h +++ b/lisp.h @@ -26,8 +26,8 @@ #define WRITE_FMT_BUFSIZ 2048 /* Debugging */ -#define DEBUG_GC 0 -#define DEBUG_GC_ALWAYS 0 +#define DEBUG_GC 1 +#define DEBUG_GC_ALWAYS 1 /* Lisp objects */ From 76a45088a38a64f2a9f354bc1f6cbcfacaa4d743 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Sat, 30 Aug 2025 05:54:10 +0200 Subject: [PATCH 26/90] Change fl_debug to not print \n by default --- lisp.c | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/lisp.c b/lisp.c index ba56d3e..d4c78d0 100644 --- a/lisp.c +++ b/lisp.c @@ -169,7 +169,6 @@ void fl_debug(Interpreter *interp, char *format, ...) (void)fprintf(interp->debug, "fatal: failed to print debug message: %d, %s", errno, format); } va_end(args); - (void)fputc('\n', interp->debug); (void)fflush(interp->debug); } @@ -325,10 +324,10 @@ Object *gcMoveObject(Interpreter *interp, Object *object, gcStats *stats) #if DEBUG_GC if (object->type == type_stream) - fl_debug(interp, "moved stream %p, path %p/%s %s to %p", + fl_debug(interp, "moved stream %p, path %p/%s %s to %p\n", (void *)object, (void *)object->path, object->path->string, object->path->type->string, (void *)forward); if (object->type == type_symbol) - fl_debug(interp, "moved symbol %s", object->string); + fl_debug(interp, "moved symbol %s\n", object->string); #endif // mark object as moved and set forwarding pointer object->type = type_moved; @@ -346,19 +345,19 @@ void gc(Interpreter *interp) Object *object; gcStats stats = {0}; - fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu", interp->memory->fromOffset, interp->memory->capacity, interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE); + fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu\n", interp->memory->fromOffset, interp->memory->capacity, interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE); interp->memory->toOffset = 0; // move trace, symbols and root objects for (object = interp->gcTop; object != nil; object = object->cdr) { #if DEBUG_GC - fl_debug(interp, "moving gc traced object %p of type %s", (void *)object->car, object->car->type->string); + fl_debug(interp, "moving gc traced object %p of type %s\n", (void *)object->car, object->car->type->string); #endif object->car = gcMoveObject(interp, object->car, &stats); } #if DEBUG_GC - fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu", stats.moved, stats.skipped, stats.constant); + fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu\n", stats.moved, stats.skipped, stats.constant); #endif interp->symbols = gcMoveObject(interp, interp->symbols, &stats); interp->global = gcMoveObject(interp, interp->global, &stats); @@ -370,7 +369,7 @@ void gc(Interpreter *interp) if (object->type == type_stream) { #if DEBUG_GC - fl_debug(interp, "moving path %p/%s of stream %p", (void *)object->path, object->path->string, (void *)object); + fl_debug(interp, "moving path %p/%s of stream %p\n", (void *)object->path, object->path->string, (void *)object); #endif object->path = gcMoveObject(interp, object->path, &stats); } else if (object->type == type_cons) { @@ -401,7 +400,7 @@ void gc(Interpreter *interp) interp->memory->toSpace = swap; /* report before overwriting offset difference */ - fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu free: %lu(%lu) bytes", + fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu free: %lu(%lu) bytes\n", stats.moved, stats.skipped, stats.constant, interp->memory->fromOffset - interp->memory->toOffset, interp->memory->toOffset, interp->memory->capacity, @@ -449,7 +448,7 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) || gc_always #endif ) { - fl_debug(interp, "memoryAllocObject: requesting %lu bytes", size); + fl_debug(interp, "memoryAllocObject: requesting %lu bytes\n", size); /* If not done already allocate to space */ if (!interp->memory->toSpace) { if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { @@ -463,7 +462,7 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) if (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) { int blocks = size / FLISP_MEMORY_INC_SIZE + 1; size_t memory = blocks * FLISP_MEMORY_INC_SIZE; - fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu", size, memory); + fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu\n", size, memory); /* Increase to space */ void *new; new = mmap(NULL, interp->memory->capacity + FLISP_MEMORY_INC_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); @@ -1487,7 +1486,8 @@ Object *evalCatch(Interpreter *interp, Object **args, Object **env) interp->msg_buf[0] = '\0'; interp->result = nil; if (setjmp(exceptionEnv)) { - fl_debug(interp, "catch: %s, '%s'", interp->result->string, interp->msg_buf); + fl_debug(interp, "catch: %s, '%s'\n", interp->result->string, interp->msg_buf); + interp->gcTop = nil; } else { do { interp->object = evalExpr(interp, &(*args)->car, env); @@ -2558,7 +2558,7 @@ Interpreter *lisp_new( var = newSymbol(interp, "*OUTPUT*"); (void)envSet(interp, &var, &val, &interp->global, true); } - fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity); + fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc\n", interp->memory->fromOffset, interp->memory->capacity); #if DEBUG_GC_ALWAYS gc_always = true; @@ -2667,35 +2667,36 @@ Object *openInputStreamError(void) void lisp_eval(Interpreter *interp, char *input) { FILE *fd = NULL; - Object *result; if (input == NULL) { - fl_debug(interp, "lisp_eval()"); + fl_debug(interp, "lisp_eval()\n"); if (interp->input == NULL) { interp->object = openInputStreamError(); return; } } else { - fl_debug(interp, "lisp_eval(\"%s\")", input); + fl_debug(interp, "lisp_eval(\"%s\")\n", input); if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { interp->object = openInputStreamError(); return; } } interp->gcTop = nil; - interp->object = result = ok; + GC_CHECKPOINT; + GC_TRACE(gcResult, ok); for (;;) { cerf(interp, fd); if (interp->object->car == end_of_file) { - interp->object = result; + interp->object = *gcResult; break; } if (interp->object->car != nil) break; lisp_write_object(interp, interp->output, FLISP_RESULT_OBJECT, true); - result = interp->object; + *gcResult = interp->object; writeChar(interp, interp->output, '\n'); } + GC_RELEASE; if (interp->output) fflush(interp->output); if (fd) fclose(fd); } From 683e6249b3bb95e9d2da8a796197b1f92a2b0268 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Sat, 30 Aug 2025 05:55:10 +0200 Subject: [PATCH 27/90] Add trace facility for primitives --- lisp.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp.c b/lisp.c index d4c78d0..a4bdd65 100644 --- a/lisp.c +++ b/lisp.c @@ -1589,6 +1589,14 @@ Object *evalExpr(Interpreter *interp, Object ** object, Object **env) (*flisp_object_type[primitive->type_check])->string, args->car->type->string ); +#if FLISP_TRACE + fl_debug(interp, "(%s", primitive->name); + for (args = *gcArgs; args != nil; args = args->cdr, nArgs++) { + fl_debug(interp, " "); + lisp_write_object(interp, interp->debug, args->car, true); + } + fl_debug(interp, ")\n"); +#endif GC_RETURN(primitive->eval(interp, gcArgs, gcEnv)); } } else { From 1b3c7bd3b9408b2437b9abcd098bd7030d6a52cb Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Sat, 30 Aug 2025 05:58:37 +0200 Subject: [PATCH 28/90] WIP: implement dynamic memory allocation. lisp_new() doesn't need memory size The interpreter allocates a minimal chunk of memory to boot itself on start. After that, every time the Lisp object memory is to small, it is increased by a specific chunk size. Both parameters: FLISP_MIN_MEMORY and FLISP_MEMORY_INC_SIZE are defined lisp.h. While the approach is working well, there are problems with segfaults, when using gc_always. These seem to be related to wrong GC_TRACE'ing Note: on startup the interpreter prints out, how much memory is used for the initial startup. We round it up manually to the chunk size. --- flisp.c | 11 +---------- header.h | 16 ---------------- lisp.c | 33 +++++++++++++-------------------- lisp.h | 12 +++++++----- main.c | 2 +- 5 files changed, 22 insertions(+), 52 deletions(-) diff --git a/flisp.c b/flisp.c index ac6a28a..92d2e2a 100644 --- a/flisp.c +++ b/flisp.c @@ -9,15 +9,6 @@ #include #include "lisp.h" -/* Specify in kByte. Less then 263 is too small for loading stdlib.lsp - * and running the tests. - */ -// -// -#define FLISP_MEMORY_SIZE 363 -//Note: debugging: #define FLISP_MEMORY_SIZE 263 -//Note: debugging: #define FLISP_MEMORY_SIZE 200 - #define CPP_XSTR(s) CPP_STR(s) #define CPP_STR(s) #s @@ -88,7 +79,7 @@ int main(int argc, char **argv) fprintf(stderr, "failed to open debug file %s for writing: %d\n", debug_file, errno); } - interp = lisp_new(FLISP_MEMORY_SIZE*1024, argv, library_path, stdin, stdout, fd); + interp = lisp_new(argv, library_path, stdin, stdout, fd); if (interp == NULL) fatal("fLisp interpreter initialization failed"); diff --git a/header.h b/header.h index 3b3225f..9654450 100644 --- a/header.h +++ b/header.h @@ -505,22 +505,6 @@ extern window_t* new_window(void); extern window_t *popup_window(char *); extern window_t *split_current_window(void); -/* fLisp interpreter used for femto */ -/* size test done with oxo */ -//#define FLISP_MEMORY_SIZE 524288UL // 512k - OOM on start -#define FLISP_MEMORY_SIZE 1048576UL // 1M -//#define FLISP_MEMORY_SIZE 2097152UL // 2M -//#define FLISP_MEMORY_SIZE 4194304UL // 4M -//#define FLISP_MEMORY_SIZE 8388608UL // 8M -//#define FLISP_MEMORY_SIZE 16777216UL // 16M -//#define FLISP_MEMORY_SIZE 33554432UL // 32M -//#define FLISP_MEMORY_SIZE 67108864UL // 64M -//#define FLISP_MEMORY_SIZE 134217728UL // 128M -//#define FLISP_MEMORY_SIZE 268435456UL // 256M -//#define FLISP_MEMORY_SIZE 402653184UL // 384M -//#define FLISP_MEMORY_SIZE 536870912UL // 512M - - extern char *eval_string(bool, char *, ...); extern void free_lisp_output(void); diff --git a/lisp.c b/lisp.c index a4bdd65..4ecff61 100644 --- a/lisp.c +++ b/lisp.c @@ -478,16 +478,16 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) interp->memory->capacity += memory; gc(interp); /* Increase former from space */ - new = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); - if (new == (void *) -1) { - interp->memory->capacity+= EXCEPTION_MEM_RESERVE; - exception(interp, out_of_memory, "OOM reallocating fromSpace: %s", strerror(errno)); - } + //new = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + //if (new == (void *) -1) { + // interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + // exception(interp, out_of_memory, "OOM reallocating fromSpace: %s", strerror(errno)); + //} if (munmap(interp->memory->toSpace, interp->memory->capacity - memory) == -1) { interp->memory->capacity+= EXCEPTION_MEM_RESERVE; exception(interp, out_of_memory, "munmap(fromSpace) failed: %s", strerror(errno)); } - interp->memory->toSpace = new; + interp->memory->toSpace = NULL; } /* Allocate object in from-space */ Object *object = (Object *) ((char *)interp->memory->fromSpace + interp->memory->fromOffset); @@ -2447,7 +2447,7 @@ Memory *newMemory(size_t size) Memory *memory = malloc(sizeof(Memory)); if (!memory) return NULL; - memory->capacity = size/2; + memory->capacity = size; memory->fromOffset = 0; memory->toOffset = 0; memory->fromSpace = NULL; @@ -2477,7 +2477,7 @@ Memory *newMemory(size_t size) * */ Interpreter *lisp_new( - size_t size, char **argv, char *library_path, + char **argv, char *library_path, FILE *input, FILE *output, FILE* debug) { Interpreter *interp; @@ -2488,17 +2488,8 @@ Interpreter *lisp_new( interp = malloc(sizeof(Interpreter)); if (interp == NULL) return NULL; - if (size/2 < FLISP_MIN_MEMORY) { - interp->result = invalid_value; - /* Note: obsolete error reporting - update needed */ - strncpy(interp->msg_buf, - "fLisp needs at least" CPP_STR(FLISP_MIN_MEMORY) "bytes to start up", sizeof(interp->msg_buf)); - return NULL; - } - - interp->debug = debug; - - Memory *memory = newMemory(size); + /* Note: we might want to allocate more to take into account the size of argv and library_path */ + Memory *memory = newMemory(FLISP_MIN_MEMORY); if (memory == NULL) { interp->result = out_of_memory; /* Note: obsolete error reporting - update needed */ @@ -2516,7 +2507,6 @@ Interpreter *lisp_new( interp->buf = NULL; resetBuf(interp); - interp->gcTop = nil; interp->catch = &interp->exceptionEnv; /* symbols */ @@ -2528,6 +2518,9 @@ Interpreter *lisp_new( interp->next = interp; lisp_interpreters = interp; + /* enable debug output */ + interp->debug = debug; + /* global environment */ initRootEnv(interp); diff --git a/lisp.h b/lisp.h index 45fc94b..f70529e 100644 --- a/lisp.h +++ b/lisp.h @@ -11,13 +11,14 @@ #include #define FL_NAME "fLisp" -#define FL_VERSION "0.11" +#define FL_VERSION "0.12" #define FL_INITFILE "flisp.rc" #define FL_LIBDIR "/usr/local/share/flisp" /* minimal Lisp object space size */ -#define FLISP_MIN_MEMORY 26624UL /* currently ~26k */ +//#define FLISP_MIN_MEMORY 24576UL /* currently ~21k for flisp */ +#define FLISP_MIN_MEMORY 40960UL /* currently ~34k for femto */ #define FLISP_MEMORY_INC_SIZE 8192UL /* Resize by this amount */ /* buffersize for Lisp eval input */ @@ -26,8 +27,9 @@ #define WRITE_FMT_BUFSIZ 2048 /* Debugging */ -#define DEBUG_GC 1 -#define DEBUG_GC_ALWAYS 1 +#define DEBUG_GC 0 +#define DEBUG_GC_ALWAYS 0 +#define FLISP_TRACE 0 /* Lisp objects */ @@ -191,7 +193,7 @@ void fl_debug(Interpreter *, char *, ...); SIGNATURE " expected %s, got: %s", TYPE->string, PARAM->type->string) // PUBLIC INTERFACE /////////////////////////////////////////////////////// -extern Interpreter *lisp_new(size_t, char**, char*, FILE*, FILE*, FILE*); +extern Interpreter *lisp_new(char **, char*, FILE*, FILE*, FILE*); extern void lisp_destroy(Interpreter *); extern void lisp_eval(Interpreter *, char *); extern void lisp_write_object(Interpreter *, FILE *, Object *, bool); diff --git a/main.c b/main.c index 8e9c448..4b931a1 100644 --- a/main.c +++ b/main.c @@ -80,7 +80,7 @@ int main(int argc, char **argv) setup_keys(); /* Lisp interpreter */ - interp = lisp_new(FLISP_MEMORY_SIZE, argv, library_path, NULL, NULL, debug_fp); + interp = lisp_new(argv, library_path, NULL, NULL, debug_fp); if (interp == NULL) fatal("fLisp initialization failed"); From bd70145bd36c6b87421c1f4aa9583a78bccf1a81 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Sat, 30 Aug 2025 06:12:36 +0200 Subject: [PATCH 29/90] WIP: save gcTop in evalCatch Does not solve segfaults, but seems more correct then resetting on error. --- lisp.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp.c b/lisp.c index 4ecff61..5fdb5cf 100644 --- a/lisp.c +++ b/lisp.c @@ -1479,20 +1479,21 @@ Object *evalList(Interpreter *interp, Object **args, Object **env) Object *evalCatch(Interpreter *interp, Object **args, Object **env) { jmp_buf exceptionEnv, *prevEnv; - Object *object; + Object *object, *gcTopPrev; prevEnv = interp->catch; interp->catch = &exceptionEnv; interp->msg_buf[0] = '\0'; interp->result = nil; + gcTopPrev = interp->gcTop; if (setjmp(exceptionEnv)) { fl_debug(interp, "catch: %s, '%s'\n", interp->result->string, interp->msg_buf); - interp->gcTop = nil; } else { do { interp->object = evalExpr(interp, &(*args)->car, env); } while(0); } + interp->gcTop = gcTopPrev; interp->catch = prevEnv; GC_CHECKPOINT; object = newCons(interp, &interp->object, &nil); From d29730779096bca267e632a9c937c560cbd9b529 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Sat, 30 Aug 2025 11:11:44 +0200 Subject: [PATCH 30/90] Add gcTop tracking feature --- lisp.c | 50 ++++++++++++++++++++++++++++++++++++-------------- lisp.h | 1 + 2 files changed, 37 insertions(+), 14 deletions(-) diff --git a/lisp.c b/lisp.c index 5fdb5cf..0bf1277 100644 --- a/lisp.c +++ b/lisp.c @@ -306,7 +306,7 @@ bool gcCollectableObject(Interpreter *interp, Object *object) { typedef struct gcStats { size_t moved, constant, skipped; } gcStats; Object *gcMoveObject(Interpreter *interp, Object *object, gcStats *stats) { - // skip object if it is not within from-space (i.e. on the stack) + /* Skip object if it is not within from-space, i.e. on the stack or a constant */ if (!gcCollectableObject(interp, object)) { stats->constant++; return object; @@ -325,7 +325,9 @@ Object *gcMoveObject(Interpreter *interp, Object *object, gcStats *stats) #if DEBUG_GC if (object->type == type_stream) fl_debug(interp, "moved stream %p, path %p/%s %s to %p\n", - (void *)object, (void *)object->path, object->path->string, object->path->type->string, (void *)forward); + (void *)object, (void *)object->path, object->path->string, + object->path->type->string, (void *)forward + ); if (object->type == type_symbol) fl_debug(interp, "moved symbol %s\n", object->string); #endif @@ -345,19 +347,29 @@ void gc(Interpreter *interp) Object *object; gcStats stats = {0}; - fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu\n", interp->memory->fromOffset, interp->memory->capacity, interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE); - + fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu\n", + interp->memory->fromOffset, interp->memory->capacity, + interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE + ); interp->memory->toOffset = 0; // move trace, symbols and root objects for (object = interp->gcTop; object != nil; object = object->cdr) { -#if DEBUG_GC - fl_debug(interp, "moving gc traced object %p of type %s\n", (void *)object->car, object->car->type->string); +#if DEBUG_GC | FLISP_TRACK_GCTOP + fl_debug(interp, "moving gc traced object %p of type %s\n", + (void *)object->car, object->car->type->string + ); +#if FLISP_TRACK_GCTOP + lisp_write_object(interp, interp->debug, object->car, true); + fl_debug(interp, "\n"); +#endif #endif object->car = gcMoveObject(interp, object->car, &stats); } #if DEBUG_GC - fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu\n", stats.moved, stats.skipped, stats.constant); + fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu\n", + stats.moved, stats.skipped, stats.constant + ); #endif interp->symbols = gcMoveObject(interp, interp->symbols, &stats); interp->global = gcMoveObject(interp, interp->global, &stats); @@ -369,7 +381,9 @@ void gc(Interpreter *interp) if (object->type == type_stream) { #if DEBUG_GC - fl_debug(interp, "moving path %p/%s of stream %p\n", (void *)object->path, object->path->string, (void *)object); + fl_debug(interp, "moving path %p/%s of stream %p\n", + (void *)object->path, object->path->string, (void *)object + ); #endif object->path = gcMoveObject(interp, object->path, &stats); } else if (object->type == type_cons) { @@ -400,7 +414,8 @@ void gc(Interpreter *interp) interp->memory->toSpace = swap; /* report before overwriting offset difference */ - fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu free: %lu(%lu) bytes\n", + fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, " + "memory: %lu/%lu free: %lu(%lu) bytes\n", stats.moved, stats.skipped, stats.constant, interp->memory->fromOffset - interp->memory->toOffset, interp->memory->toOffset, interp->memory->capacity, @@ -451,7 +466,10 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) fl_debug(interp, "memoryAllocObject: requesting %lu bytes\n", size); /* If not done already allocate to space */ if (!interp->memory->toSpace) { - if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { + if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, + PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, + -1, 0)) + ) { fprintf(stderr, "OOM allocating to space, exiting\n"); exit(2); } @@ -462,7 +480,9 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) if (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) { int blocks = size / FLISP_MEMORY_INC_SIZE + 1; size_t memory = blocks * FLISP_MEMORY_INC_SIZE; - fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu\n", size, memory); + fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu\n", + size, memory + ); /* Increase to space */ void *new; new = mmap(NULL, interp->memory->capacity + FLISP_MEMORY_INC_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); @@ -1762,9 +1782,11 @@ void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool reada writeFmt(interp, fd, " - "); lisp_write_object(interp, fd, object->vals, readably); writeChar(interp, fd, '>'); - } else if (object->type == type_moved) - exception(interp, gc_error, "won't write a garbage collected item"); - else + } else if (object->type == type_moved) { + fl_debug(interp, " => "); + lisp_write_object(interp, fd, object->forward, readably); + //exception(interp, gc_error, "won't write a garbage collected item"); + } else exception(interp, gc_error, "unidentified object: %s", object->type->string); fflush(fd); diff --git a/lisp.h b/lisp.h index f70529e..389aa9d 100644 --- a/lisp.h +++ b/lisp.h @@ -30,6 +30,7 @@ #define DEBUG_GC 0 #define DEBUG_GC_ALWAYS 0 #define FLISP_TRACE 0 +#define FLISP_TRACK_GCTOP 1 /* Lisp objects */ From e79796bfdfb4afc0c1bb60a33fe8144c969fc28e Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 1 Sep 2025 18:04:04 +0200 Subject: [PATCH 31/90] Some small reformatting and output improvements --- flisp.c | 7 +++---- lisp.c | 21 +++++++++++---------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/flisp.c b/flisp.c index 92d2e2a..8b0a8f1 100644 --- a/flisp.c +++ b/flisp.c @@ -76,7 +76,7 @@ int main(int argc, char **argv) debug_file=getenv("FLISP_DEBUG"); if (debug_file != NULL) { if (!(fd = fopen(debug_file, "w"))) - fprintf(stderr, "failed to open debug file %s for writing: %d\n", debug_file, errno); + fprintf(stderr, "failed to open debug file %s for writing: %s\n", debug_file, strerror(errno)); } interp = lisp_new(argv, library_path, stdin, stdout, fd); @@ -85,7 +85,7 @@ int main(int argc, char **argv) if (strlen(init_file)) { if (!(fd = fopen(init_file, "r"))) - fprintf(stderr, "failed to open inifile %s: %d\n", init_file, errno); + fprintf(stderr, "failed to open inifile %s: %s\n", init_file, strerror(errno)); else { // load inifile interp->input = fd; @@ -98,8 +98,7 @@ int main(int argc, char **argv) // Note: if we could implement the repl in fLisp itself we'd done here. } if (fclose(fd)) - // Note: the error object can be printed with lisp_write_object - fprintf(stderr, "failed to close inifile %s %s\n", init_file, interp->msg_buf); + fprintf(stderr, "failed to close inifile %s %s\n", init_file, strerror(errno)); } } // Start repl diff --git a/lisp.c b/lisp.c index 0bf1277..176899c 100644 --- a/lisp.c +++ b/lisp.c @@ -143,6 +143,12 @@ bool gc_always = false; Interpreter *lisp_interpreters = NULL; +void fl_fatal(char *message, int code) +{ + fprintf(stderr, message); + exit(code); +} + // DEBUG LOG /////////////////////////////////////////////////////////////////// #ifdef __GNUC__ @@ -451,10 +457,8 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) /* If not done already allocate to space */ if (!interp->memory->fromSpace) { - if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { - fprintf(stderr, "OOM, allocating from space, exiting\n"); - exit(2); - } + if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) + fl_fatal("OOM, allocating from space, exiting\n", 64); } /* Run garbage collection if capacity exceeded */ if ( @@ -468,11 +472,8 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) if (!interp->memory->toSpace) { if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, - -1, 0)) - ) { - fprintf(stderr, "OOM allocating to space, exiting\n"); - exit(2); - } + -1, 0))) + fl_fatal("OOM allocating to space, exiting\n", 65); } gc(interp); } @@ -2599,7 +2600,7 @@ void lisp_destroy(Interpreter *interp) if (interp->memory->fromSpace) (void)munmap(interp->memory->fromSpace, interp->memory->capacity); - // Note: we do not know which one it is, so we free both. + if (interp->memory->toSpace) (void)munmap(interp->memory->toSpace, interp->memory->capacity); From 01448bab2c3542bb83bf444f81fa2d31f2337374 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 1 Sep 2025 18:06:20 +0200 Subject: [PATCH 32/90] WIP: refactor evalCatch/result reporting --- lisp.c | 166 +++++++++++++++++++++++++++++++++------------------------ lisp.h | 16 +++--- 2 files changed, 105 insertions(+), 77 deletions(-) diff --git a/lisp.c b/lisp.c index 176899c..6dfd528 100644 --- a/lisp.c +++ b/lisp.c @@ -73,9 +73,6 @@ Object *type_env = &(Object) { NULL, .string = "type-env" }; Object *type_moved = &(Object) { NULL, .string = "type-moved" }; Object *empty = &(Object) { NULL, .string = "\0" }; Object *one = &(Object) { NULL, .integer = 1 }; -Object *okObject = &(Object) { NULL }; -Object *okMessage = &(Object) { NULL }; -Object *ok = &(Object) { NULL }; Constant flisp_constants[] = { /* Fundamentals */ @@ -183,42 +180,83 @@ void fl_debug(Interpreter *interp, char *format, ...) void resetBuf(Interpreter *); +/** err() - set interpreter catch object to error + * + * @param interp interpreter in which the error occured. + * @param object object on which an error occured, set to nil if none. + * @param error error type symbol + * @param format ... printf style human readable error message + * + * *object* and *error* are stored in the interpreter structure. + * + * The error message specified with *format* and it's va_args is + * formatted into the message object of the interpreter. If it is + * longer then WRITE_FMT_BUFSIZ - by default 2048 characters - it is + * truncated and the last three characters are overwritten with "..." + */ +#ifdef __GNUC__ +void err(Interpreter *, Object *, Object *, char *, ...) + __attribute__ ((format(printf, 4, 5))); +#endif +void err(Interpreter *interp, Object *object, Object *error, char *format, ...) +{ + size_t written; + + interp->result.car = object; + interp->error.car = error; + resetBuf(interp); + + size_t len = sizeof(interp->message.string); + va_list(args); + va_start(args, format); + written = vsnprintf(interp->message.string, len, format, args); + va_end(args); + if (written > len) + strcpy(interp->message.string+len-4, "..."); + else if (written < 0) + strncpy(interp->message.string, "failed to format error message", len); +} + +/* Note: this is really err(); longjmp(), but we could not make it + * into a macro yet. + */ /** exceptionWithObject - break out of errors * * @param interp interpreter in which the error occured. * @param object object on which an error occured, set to nil if none. - * @param result result symbol corresponding to error type. + * @param error error type symbol * @param format ... printf style human readable error message * - * *object* and *result* are stored in the interpreter structure. + * *object* and *error* are stored in the interpreter structure. * The return code for longjmp is FLISP_ERROR * - * The error message is formatted into the message buffer of the interpreter. If it has to - * be truncated the last three characters are overwritten with "..." + * The error message is formatted into the message object of the + * interpreter. If it is longer then WRITE_FMT_BUFSIZ - by default + * 2047 characters - it is truncated and the last three characters are + * overwritten with "..." */ #ifdef __GNUC__ -void exceptionWithObject(Interpreter *, Object *object, Object *result, char *format, ...) +void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...) __attribute__ ((noreturn, format(printf, 4, 5))); #endif -void exceptionWithObject(Interpreter *interp, Object *object, Object *result, char *format, ...) +void exceptionWithObject(Interpreter *interp, Object *object, Object *error, char *format, ...) { size_t written; - interp->object = object; - interp->result = result; + interp->result.car = object; + interp->error.car = error; resetBuf(interp); - size_t len = sizeof(interp->msg_buf); + size_t len = sizeof(interp->message.string); va_list(args); va_start(args, format); - written = vsnprintf(interp->msg_buf, len, format, args); + written = vsnprintf(interp->message.string, len, format, args); va_end(args); if (written > len) - strcpy(interp->msg_buf+len-4, "..."); + strcpy(interp->message.string+len-4, "..."); else if (written < 0) - strncpy(interp->msg_buf, "failed to format error message", len); + strncpy(interp->message.string, "failed to format error message", len); - assert(interp->catch != NULL); longjmp(*interp->catch, FLISP_ERROR); } @@ -234,7 +272,6 @@ void exceptionWithObject(Interpreter *interp, Object *object, Object *result, ch * The error message is formatted into the message buffer of the interpreter. If it has to * be truncated the last three characters are overwritten with "..." */ -// #define exception(interp, result, ...) exceptionWithObject(interp, nil, result, __VA_ARGS__) // GARBAGE COLLECTION ///////////////////////////////////////////////////////// @@ -1497,37 +1534,36 @@ Object *evalList(Interpreter *interp, Object **args, Object **env) } } + +Object *ok(Interpreter *interp, Object *object) +{ + interp->error.car = nil; + interp->message.string[0] = '\0'; + interp->result.car = object; + return object; +} + Object *evalCatch(Interpreter *interp, Object **args, Object **env) { jmp_buf exceptionEnv, *prevEnv; - Object *object, *gcTopPrev; prevEnv = interp->catch; interp->catch = &exceptionEnv; - interp->msg_buf[0] = '\0'; - interp->result = nil; - gcTopPrev = interp->gcTop; + ok(interp, nil); + GC_CHECKPOINT; if (setjmp(exceptionEnv)) { - fl_debug(interp, "catch: %s, '%s'\n", interp->result->string, interp->msg_buf); + fl_debug(interp, "catch:%s: '%s'\n", FLISP_RESULT_CODE->string, FLISP_RESULT_MESSAGE->string); } else { - do { - interp->object = evalExpr(interp, &(*args)->car, env); + do { + ok(interp, evalExpr(interp, &(*args)->car, env)); + fl_debug(interp, "eval result: "); + lisp_write_object(interp, interp->debug, FLISP_RESULT_OBJECT, true); + //ok(interp, nil); } while(0); } - interp->gcTop = gcTopPrev; - interp->catch = prevEnv; - GC_CHECKPOINT; - object = newCons(interp, &interp->object, &nil); - GC_TRACE(gcObj, object); - object = newString(interp, interp->msg_buf); - GC_TRACE(gcMessage, object); - *gcObj = newCons(interp, gcMessage, gcObj); - object = interp->result; - *gcObj = newCons(interp, &object, gcObj); GC_RELEASE; - interp->object = *gcObj; - interp->result = nil; - return *gcObj; + interp->catch = prevEnv; + return interp->object; } @@ -2425,14 +2461,6 @@ void initRootEnv(Interpreter *interp) #ifdef FLISP_DOUBLE_EXTENSION double_one->type = type_double; #endif - okObject->type = type_cons; - okObject->car = okObject->cdr = nil; - okMessage->type = type_cons; - okMessage->car = empty; - okMessage->cdr = okObject; - ok->type = type_cons; - ok->car = nil; - ok->cdr = okMessage; // add primitives int nPrimitives = sizeof(primitives) / sizeof(primitives[0]); @@ -2512,28 +2540,33 @@ Interpreter *lisp_new( interp = malloc(sizeof(Interpreter)); if (interp == NULL) return NULL; + /* catch object */ + interp->object = &interp->error; + interp->error.type = type_cons; + interp->error.cdr = &interp->_message; + interp->_message.type = type_cons; + interp->_message.car = (Object *)(&interp->message); + interp->_message.cdr = &interp->result; + interp->result.type = type_cons; + interp->result.cdr = nil; + interp->message.type = type_string; + ok(interp, nil); + /* Note: we might want to allocate more to take into account the size of argv and library_path */ Memory *memory = newMemory(FLISP_MIN_MEMORY); if (memory == NULL) { - interp->result = out_of_memory; - /* Note: obsolete error reporting - update needed */ - strncpy(interp->msg_buf, - "failed to allocate memory for the interpreter", sizeof(interp->msg_buf)); + err(interp, nil, out_of_memory, "failed to allocate memory for the interpreter"); return NULL; } interp->memory = memory; - /* Note: obsolete initialization - update needed */ - interp->object = ok; - interp->msg_buf[0] = '\0'; - interp->result = nil; - + /* read buffer */ interp->buf = NULL; resetBuf(interp); interp->catch = &interp->exceptionEnv; - /* symbols */ + /* symbols */ Object *object; object = newCons(interp, &nil, &nil); object = newCons(interp, &t, &object); @@ -2655,15 +2688,6 @@ void cerf(Interpreter *interp, FILE *fd) (void) evalCatch(interp, &evalApply, &interp->global); } -Object *openInputStreamError(void) -{ - /* Note: find a way to not construct this all the time anew */ - Object *m = &(Object) { type_string, .string = "cannot open input stream" }; - Object *o = &(Object) { type_cons, .car = nil, .cdr = nil }; - o = &(Object) { type_cons, .car = m, .cdr = o }; - return &(Object) { type_cons, .car = io_error, .cdr = o }; -} - /** lisp_eval() - interpret a string or file in Lisp * * @param interp fLisp interpreter @@ -2696,29 +2720,29 @@ void lisp_eval(Interpreter *interp, char *input) if (input == NULL) { fl_debug(interp, "lisp_eval()\n"); if (interp->input == NULL) { - interp->object = openInputStreamError(); + err(interp, nil, invalid_value, "no input stream configured"); return; } } else { fl_debug(interp, "lisp_eval(\"%s\")\n", input); if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - interp->object = openInputStreamError(); + err(interp, nil, io_error, "fmemopen() for input string failed: %s", strerror(errno)); return; } } interp->gcTop = nil; GC_CHECKPOINT; - GC_TRACE(gcResult, ok); + GC_TRACE(gcResult, nil); for (;;) { cerf(interp, fd); - if (interp->object->car == end_of_file) { - interp->object = *gcResult; + if (FLISP_RESULT_CODE == end_of_file) { + (void)ok(interp, *gcResult); break; } - if (interp->object->car != nil) + if (FLISP_RESULT_CODE != nil) break; lisp_write_object(interp, interp->output, FLISP_RESULT_OBJECT, true); - *gcResult = interp->object; + *gcResult = FLISP_RESULT_OBJECT; writeChar(interp, interp->output, '\n'); } GC_RELEASE; diff --git a/lisp.h b/lisp.h index 389aa9d..326ca83 100644 --- a/lisp.h +++ b/lisp.h @@ -30,7 +30,7 @@ #define DEBUG_GC 0 #define DEBUG_GC_ALWAYS 0 #define FLISP_TRACE 0 -#define FLISP_TRACK_GCTOP 1 +#define FLISP_TRACK_GCTOP 0 /* Lisp objects */ @@ -91,12 +91,15 @@ typedef struct Memory { typedef struct Interpreter { - Object *object; /* result or error object */ + Object *object; /* catch result */ /* private */ - Object *result; /* result symbol */ - char msg_buf[WRITE_FMT_BUFSIZ]; /* error string */ - + /* catch result: (error_type message result) */ + Object error; /* error code cons */ + Object _message; /* message cons */ + struct { Object * type; size_t size; char string[WRITE_FMT_BUFSIZ]; } message; + Object result; /* result or error object cons */ + FILE *input; /* default input stream object */ FILE *output; /* default output file descriptor */ FILE *debug; /* debug stream */ @@ -162,7 +165,8 @@ extern size_t addCharToBuf(Interpreter *, int); extern void resetBuf(Interpreter *); extern void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...); -#define exception(interp, result, ...) exceptionWithObject(interp, nil, result, __VA_ARGS__) +#define exception(interp, error, ...) exceptionWithObject(interp, nil, error, __VA_ARGS__) + #define GC_PASTE1(name, id) name ## id #define GC_PASTE2(name, id) GC_PASTE1(name, id) #define GC_UNIQUE(name) GC_PASTE2(name, __LINE__) From 651d4c5ae7dc9af954a6f2babd751c5f6068b015 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 1 Sep 2025 21:41:21 +0200 Subject: [PATCH 33/90] WIP: evalCatch: create catch object from interp. Result access via C macros interp->object is removed, instead use C-macros: - FLISP_RESULT_CODE - FLISP_RESULT_MESSAGE - FLISP_RESULT_OBJECT evalCatch allocates the result object from the Lisp object space. Note: tests work, except segfault in femto with read-hook: root cause unidentified --- lisp.c | 169 +++++++++++++++++++++++---------------------------------- lisp.h | 24 ++++---- 2 files changed, 80 insertions(+), 113 deletions(-) diff --git a/lisp.c b/lisp.c index 6dfd528..863ce41 100644 --- a/lisp.c +++ b/lisp.c @@ -128,12 +128,6 @@ Object **flisp_object_type[] = { }; -typedef enum ResultCode { - FLISP_OK, - FLISP_ERROR, - FLISP_RETURN, /* successful return */ -} ResultCode; - bool gc_always = false; /* List of interpreters */ @@ -180,9 +174,9 @@ void fl_debug(Interpreter *interp, char *format, ...) void resetBuf(Interpreter *); -/** err() - set interpreter catch object to error +/** setInterpreterResult() - set the interpreter catch object * - * @param interp interpreter in which the error occured. + * @param interp interpreter in which to set the catch object. * @param object object on which an error occured, set to nil if none. * @param error error type symbol * @param format ... printf style human readable error message @@ -193,19 +187,24 @@ void resetBuf(Interpreter *); * formatted into the message object of the interpreter. If it is * longer then WRITE_FMT_BUFSIZ - by default 2048 characters - it is * truncated and the last three characters are overwritten with "..." + * + * If format is NULL, the message is set to the empty string. */ #ifdef __GNUC__ -void err(Interpreter *, Object *, Object *, char *, ...) +void setInterpreterResult(Interpreter *, Object *, Object *, char *, ...) __attribute__ ((format(printf, 4, 5))); #endif -void err(Interpreter *interp, Object *object, Object *error, char *format, ...) +void setInterpreterResult(Interpreter *interp, Object *object, Object *error, char *format, ...) { size_t written; - interp->result.car = object; - interp->error.car = error; - resetBuf(interp); + interp->result = object; + interp->error = error; + if (format == NULL) { + interp->message.string[0] = '\0'; + return; + } size_t len = sizeof(interp->message.string); va_list(args); va_start(args, format); @@ -217,63 +216,6 @@ void err(Interpreter *interp, Object *object, Object *error, char *format, ...) strncpy(interp->message.string, "failed to format error message", len); } -/* Note: this is really err(); longjmp(), but we could not make it - * into a macro yet. - */ -/** exceptionWithObject - break out of errors - * - * @param interp interpreter in which the error occured. - * @param object object on which an error occured, set to nil if none. - * @param error error type symbol - * @param format ... printf style human readable error message - * - * *object* and *error* are stored in the interpreter structure. - * The return code for longjmp is FLISP_ERROR - * - * The error message is formatted into the message object of the - * interpreter. If it is longer then WRITE_FMT_BUFSIZ - by default - * 2047 characters - it is truncated and the last three characters are - * overwritten with "..." - */ -#ifdef __GNUC__ -void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...) - __attribute__ ((noreturn, format(printf, 4, 5))); -#endif -void exceptionWithObject(Interpreter *interp, Object *object, Object *error, char *format, ...) -{ - size_t written; - - interp->result.car = object; - interp->error.car = error; - resetBuf(interp); - - size_t len = sizeof(interp->message.string); - va_list(args); - va_start(args, format); - written = vsnprintf(interp->message.string, len, format, args); - va_end(args); - if (written > len) - strcpy(interp->message.string+len-4, "..."); - else if (written < 0) - strncpy(interp->message.string, "failed to format error message", len); - - longjmp(*interp->catch, FLISP_ERROR); -} - -/** exception - break out of errors - * - * @param interp interpreter in which the error occurred. - * @param result result symbol corresponding to error type. - * - * *result* is stored in the interpreter structures result field, nil in the object field - * The longjmp return code is FLISP_ERROR. - * - * - * The error message is formatted into the message buffer of the interpreter. If it has to - * be truncated the last three characters are overwritten with "..." - */ - - // GARBAGE COLLECTION ///////////////////////////////////////////////////////// /* This implements Cheney's copying garbage collector, with which memory is @@ -559,11 +501,26 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) // CONSTRUCTING OBJECTS /////////////////////////////////////////////////////// +/** newObject - allocate a new object in the Lisp object store and set + * it's type. + * + * @param interp fLisp Interpreter + * @param type Type object to set in the new Object + * + * @returns New Object + */ Object *newObject(Interpreter *interp, Object *type) { return memoryAllocObject(interp, type, sizeof(Object)); } +/** newObjectFrom - allocate a new object in the Lisp object store by cloning an existing one. + * + * @param interp fLisp Interpreter + * @param from Object to clone. + * + * @returns New Object + */ Object *newObjectFrom(Interpreter *interp, Object ** from) { GC_CHECKPOINT; @@ -574,6 +531,13 @@ Object *newObjectFrom(Interpreter *interp, Object ** from) return object; } +/** newInteger - allocate a new Integer object in the Lisp object store and set it's value + * + * @param interp fLisp Interpreter + * @param number Integer value of the object. + * + * @returns New Object + */ Object *newInteger(Interpreter *interp, int64_t number) { Object *object = newObject(interp, type_integer); @@ -581,6 +545,17 @@ Object *newInteger(Interpreter *interp, int64_t number) return object; } +/** newObjectWithString - allocate a new variable size Object in the Lisp object store + * + * @param interp fLisp Interpreter + * @param type Object type of the new Object + * @param size Number of bytes to allocate + * + * If the size fit's directly into the "standard object" (abount 24 + * bytes) only allocate the object, otherwise allocate the missing bytes. + * + * @returns New Object + */ Object *newObjectWithString(Interpreter *interp, Object *type, size_t size) { size = (size > sizeof(((Object *) NULL)->string)) @@ -1534,13 +1509,20 @@ Object *evalList(Interpreter *interp, Object **args, Object **env) } } - -Object *ok(Interpreter *interp, Object *object) +/* + *Allocate a clone of the result object in the Lisp object storage + */ +Object *newResultObject(Interpreter *interp) { - interp->error.car = nil; - interp->message.string[0] = '\0'; - interp->result.car = object; - return object; + GC_CHECKPOINT; + GC_TRACE(gcResult, interp->result); + GC_TRACE(gcError, interp->error); + GC_TRACE(gcObject, newCons(interp, gcResult, &nil)); + /* Note: newObjectFrom() for interp->message would cost an + * additional Object * variable here */ + GC_TRACE(gcMessage, newString(interp, interp->message.string)); + *gcObject = newCons(interp, gcMessage, gcObject); + GC_RETURN(newCons(interp, gcError, gcObject)); } Object *evalCatch(Interpreter *interp, Object **args, Object **env) @@ -1549,21 +1531,18 @@ Object *evalCatch(Interpreter *interp, Object **args, Object **env) prevEnv = interp->catch; interp->catch = &exceptionEnv; - ok(interp, nil); + setInterpreterResult(interp, nil, nil, NULL); GC_CHECKPOINT; if (setjmp(exceptionEnv)) { fl_debug(interp, "catch:%s: '%s'\n", FLISP_RESULT_CODE->string, FLISP_RESULT_MESSAGE->string); } else { - do { - ok(interp, evalExpr(interp, &(*args)->car, env)); - fl_debug(interp, "eval result: "); - lisp_write_object(interp, interp->debug, FLISP_RESULT_OBJECT, true); - //ok(interp, nil); + do { + setInterpreterResult(interp, evalExpr(interp, &(*args)->car, env), nil, NULL); } while(0); } GC_RELEASE; interp->catch = prevEnv; - return interp->object; + return newResultObject(interp); } @@ -1822,9 +1801,8 @@ void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool reada } else if (object->type == type_moved) { fl_debug(interp, " => "); lisp_write_object(interp, fd, object->forward, readably); - //exception(interp, gc_error, "won't write a garbage collected item"); } else - exception(interp, gc_error, "unidentified object: %s", object->type->string); + fl_fatal("lisp-write_error(): unidentifiable object", 66); fflush(fd); } @@ -2514,7 +2492,6 @@ Memory *newMemory(size_t size) /** Initialize and return an fLisp interpreter. * - * @param size memory size for the Lisp objects. * @param argv null terminated array to arguments to be imported. * @param library_path path to Lisp library, aka 'script_dir'. * @param input open readable file descriptor for default input or NULL @@ -2540,22 +2517,10 @@ Interpreter *lisp_new( interp = malloc(sizeof(Interpreter)); if (interp == NULL) return NULL; - /* catch object */ - interp->object = &interp->error; - interp->error.type = type_cons; - interp->error.cdr = &interp->_message; - interp->_message.type = type_cons; - interp->_message.car = (Object *)(&interp->message); - interp->_message.cdr = &interp->result; - interp->result.type = type_cons; - interp->result.cdr = nil; - interp->message.type = type_string; - ok(interp, nil); - /* Note: we might want to allocate more to take into account the size of argv and library_path */ Memory *memory = newMemory(FLISP_MIN_MEMORY); if (memory == NULL) { - err(interp, nil, out_of_memory, "failed to allocate memory for the interpreter"); + setInterpreterResult(interp, nil, out_of_memory, "failed to allocate memory for the interpreter"); return NULL; } interp->memory = memory; @@ -2720,13 +2685,13 @@ void lisp_eval(Interpreter *interp, char *input) if (input == NULL) { fl_debug(interp, "lisp_eval()\n"); if (interp->input == NULL) { - err(interp, nil, invalid_value, "no input stream configured"); + setInterpreterResult(interp, nil, invalid_value, "no input stream configured"); return; } } else { fl_debug(interp, "lisp_eval(\"%s\")\n", input); if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - err(interp, nil, io_error, "fmemopen() for input string failed: %s", strerror(errno)); + setInterpreterResult(interp, nil, io_error, "fmemopen() for input string failed: %s", strerror(errno)); return; } } @@ -2736,7 +2701,7 @@ void lisp_eval(Interpreter *interp, char *input) for (;;) { cerf(interp, fd); if (FLISP_RESULT_CODE == end_of_file) { - (void)ok(interp, *gcResult); + setInterpreterResult(interp, *gcResult, nil, NULL); break; } if (FLISP_RESULT_CODE != nil) diff --git a/lisp.h b/lisp.h index 326ca83..bc0ec83 100644 --- a/lisp.h +++ b/lisp.h @@ -91,15 +91,11 @@ typedef struct Memory { typedef struct Interpreter { - Object *object; /* catch result */ - /* private */ - /* catch result: (error_type message result) */ - Object error; /* error code cons */ - Object _message; /* message cons */ + Object *error; /* error code cons */ struct { Object * type; size_t size; char string[WRITE_FMT_BUFSIZ]; } message; - Object result; /* result or error object cons */ - + Object *result; /* result or error object */ + FILE *input; /* default input stream object */ FILE *output; /* default output file descriptor */ FILE *debug; /* debug stream */ @@ -164,7 +160,13 @@ extern Object *newStreamObject(Interpreter *, FILE *, char *); extern size_t addCharToBuf(Interpreter *, int); extern void resetBuf(Interpreter *); -extern void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...); +extern void setInterpreterResult(Interpreter *, Object *, Object *, char *, ...); +#define exceptionWithObject(interp, object, error, ...) \ + do { \ + resetBuf(interp); \ + setInterpreterResult(interp, object, error, __VA_ARGS__); \ + longjmp(*interp->catch, 2); \ + } while(0) #define exception(interp, error, ...) exceptionWithObject(interp, nil, error, __VA_ARGS__) #define GC_PASTE1(name, id) name ## id @@ -204,9 +206,9 @@ extern void lisp_eval(Interpreter *, char *); extern void lisp_write_object(Interpreter *, FILE *, Object *, bool); extern void lisp_write_error(Interpreter *, FILE *); -#define FLISP_RESULT_CODE interp->object->car -#define FLISP_RESULT_MESSAGE interp->object->cdr->car -#define FLISP_RESULT_OBJECT interp->object->cdr->cdr->car +#define FLISP_RESULT_CODE interp->error +#define FLISP_RESULT_MESSAGE ((Object *)&interp->message) +#define FLISP_RESULT_OBJECT interp->result #endif /* From b7176e6b73c1b18053a4a926f7ab876632e2a69f Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 1 Sep 2025 21:41:36 +0200 Subject: [PATCH 34/90] Whitespace cleanup --- lisp/startup.lsp | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/lisp/startup.lsp b/lisp/startup.lsp index 1603b71..cf907a6 100644 --- a/lisp/startup.lsp +++ b/lisp/startup.lsp @@ -4,19 +4,19 @@ (cond ((eq "*scratch*" (get-buffer-name)) (insert-string "\n\n\n\n") (insert-string " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ; / _| ___ _ __ ___ | |_ ___ \n") (insert-string " ; | |_ / _ \ '_ ` _ \| __/ _ \ \n") (insert-string " ; | _| __/ | | | | | || (_) | \n") (insert-string " ; |_| \___|_| |_| |_|\__\___/' \n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ; C-x h for help\n") - (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n\n\n") (insert-string " Tiny Emacs clone with Tiny-Lisp extension language\n ") (insert-string (get-version-string)) @@ -36,7 +36,7 @@ (cond ((> pos 0) (goto-line pos))) (getopts (cdr opts) 0)))) (t (throw wrong-type-argument "(getopts opts pos) - opts must be list")))) - + (defun confn(fn) (concat (os.getenv "HOME") "/" config_dir "/" fn)) @@ -109,5 +109,3 @@ ;;(getopts argv 0) (log-debug (concat "getopts: " (catch (getopts argv 0)))) - - From 9ca6b9e7d4920318754c87d2c5eb16963d1a0178 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Mon, 1 Sep 2025 21:42:05 +0200 Subject: [PATCH 35/90] Fix: flush output before returning. --- main.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main.c b/main.c index 4b931a1..7117d98 100644 --- a/main.c +++ b/main.c @@ -151,10 +151,10 @@ char *eval_string(bool do_format, char *format, ...) prev = interp->output; // Note: save for double invocation with user defined functions. interp->output = open_memstream(&output, &len); lisp_eval(interp, input); - if (FLISP_RESULT_CODE == nil) - return output; if (interp->output) fflush(interp->output); + if (FLISP_RESULT_CODE == nil) + return output; msg_lisp_err(interp); if (debug_mode) { lisp_write_error(interp, debug_fp); From e35c6b2e03822948b49d8cd7587c95999119aaad Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 2 Sep 2025 09:02:38 +0200 Subject: [PATCH 36/90] Update ROADMAP for dynamic memory allocation --- misc/ROADMAP.flisp.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index b8cb4c7..eb55ac9 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -10,6 +10,10 @@ + Showcase lisp_eval2 with (catch (fread)) mechanism. + Implement fstat. + Implement popen, pclose. +- WIP: dynamic memory allocation + - cleanup cerf + - tune chunk size (and initial memory?) + - Fix all related Note's. - Make femto.rc use fstat. - Implement mkdir and fix file save bug. - Improve/support batch mode: output = stdout. From 54fdc3ab6d5032b9af053b64f34a8afdce6f4af0 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 2 Sep 2025 09:08:41 +0200 Subject: [PATCH 37/90] WIP: align result between lisp_eval and evalCatch --- lisp.c | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp.c b/lisp.c index 863ce41..936959f 100644 --- a/lisp.c +++ b/lisp.c @@ -2632,7 +2632,7 @@ void lisp_write_error(Interpreter *interp, FILE *fd) /** (catch (eval (read f))) or (catch (eval (read))) */ -void cerf(Interpreter *interp, FILE *fd) +Object *cerf(Interpreter *interp, FILE *fd) { /* Note: find a way to not construct this all the time anew */ Primitive readPrimitive = { "read", 0, 2, 0, primitiveRead }; @@ -2650,7 +2650,7 @@ void cerf(Interpreter *interp, FILE *fd) Object evalCons = (Object) { type_cons, .car = &eval, .cdr = &readApply }; Object *evalApply = &(Object) { type_cons, .car = &evalCons, .cdr = nil }; - (void) evalCatch(interp, &evalApply, &interp->global); + return evalCatch(interp, &evalApply, &interp->global); } /** lisp_eval() - interpret a string or file in Lisp @@ -2698,17 +2698,18 @@ void lisp_eval(Interpreter *interp, char *input) interp->gcTop = nil; GC_CHECKPOINT; GC_TRACE(gcResult, nil); + Object *object; for (;;) { - cerf(interp, fd); - if (FLISP_RESULT_CODE == end_of_file) { + object = cerf(interp, fd); + if (object->car == end_of_file) { setInterpreterResult(interp, *gcResult, nil, NULL); break; } - if (FLISP_RESULT_CODE != nil) + if (object->car != nil) break; - lisp_write_object(interp, interp->output, FLISP_RESULT_OBJECT, true); - *gcResult = FLISP_RESULT_OBJECT; + lisp_write_object(interp, interp->output, object->cdr->cdr->car, true); writeChar(interp, interp->output, '\n'); + *gcResult = object->cdr->cdr->car; } GC_RELEASE; if (interp->output) fflush(interp->output); From bd533359ba55997fe25312f6ba155fee487c6b88 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 2 Sep 2025 23:09:42 +0200 Subject: [PATCH 38/90] Fix: buffer overflow in substring. Simplify. --- lisp.c | 42 ++++++++++++++++++++++++------------------ test/1_primitives.test | 10 +++++----- 2 files changed, 29 insertions(+), 23 deletions(-) diff --git a/lisp.c b/lisp.c index 936959f..f88bf47 100644 --- a/lisp.c +++ b/lisp.c @@ -2253,27 +2253,34 @@ Object *stringAppend(Interpreter *interp, Object **args, Object **env) return str; } -// (substring ...) +/** (substring string [start [end]]) - return substring of string within range [start, end) + * + * @param string Input string + * @param start Start index, 0 based + * @param end End index, not included + * + * @return Substring of string starting from end until character + * end-1. Length of string is default for *end*, 0 is default for + * *start*. + */ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) { int64_t start = 0, end, len; - if (FLISP_ARG_ONE->type != type_string) - exceptionWithObject(interp, FLISP_ARG_ONE, wrong_type_argument, "(substring str [start [end]]) - arg 1 expected %s, got: %s", type_string->string, FLISP_ARG_ONE->type->string); - len = strlen(FLISP_ARG_ONE->string); + CHECK_TYPE(FLISP_ARG_ONE, type_string, "(substring string [start [end]]) - string"); + len = strlen(FLISP_ARG_ONE->string); if (len == 0) return empty; - end = start + len; - if ((*args)->cdr != nil) { - CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(substring str [start [end]]) - start"); + if (FLISP_HAS_ARG_TWO) { + CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(substring string [start [end]]) - start"); start = (FLISP_ARG_TWO->integer); if (start < 0) start = end + start; if ((*args)->cdr->cdr != nil) { - CHECK_TYPE(FLISP_ARG_THREE, type_integer, "(substring str [start [end]]) - end"); + CHECK_TYPE(FLISP_ARG_THREE, type_integer, "(substring string [start [end]]) - end"); if (FLISP_ARG_THREE->integer < 0) end = end + FLISP_ARG_THREE->integer; else @@ -2282,21 +2289,20 @@ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) } if (start < 0 || start > len) - exceptionWithObject(interp, FLISP_ARG_TWO, range_error, "(substring str [start [end]]) - start out of range"); + exceptionWithObject(interp, FLISP_ARG_TWO, range_error, + "(substring string [start [end]]) - start out of range"); if (end < 0 || end > len) - exceptionWithObject(interp, FLISP_ARG_THREE, range_error, "(substring str [start [end]]) - end out of range"); + exceptionWithObject(interp, FLISP_ARG_THREE, range_error, + "(substring string [start [end]]) - end out of range"); if (start > end) - exceptionWithObject(interp, FLISP_ARG_TWO, range_error, "(substring str [start [end]]) - end > start"); + exceptionWithObject(interp, FLISP_ARG_TWO, range_error, + "(substring string [start [end]]) - end > start"); if (start == end) return empty; - - char *sub = strdup(FLISP_ARG_ONE->string); + int newlen = end - start; - - memcpy(sub, (FLISP_ARG_ONE->string + start), newlen+1); - *(sub + newlen + 1) = '\0'; - Object * new = newStringWithLength(interp, sub, newlen); - free(sub); + Object *new = newStringWithLength(interp, (FLISP_ARG_ONE->string)+start, newlen+1); + new->string[newlen] = '\0'; return new; } diff --git a/test/1_primitives.test b/test/1_primitives.test index b3e764e..6374217 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -442,19 +442,19 @@ flisp_expr; ok substring-6 substring answer 1 -3 ns IN='(substring "answer" -3 -1)' OUT='"we"' flisp_expr; ok substring-6 substring answer -3 -1 we -IN='(substring "answer" 7)' ERR='(substring str [start [end]]) - start out of range' OBJ= +IN='(substring "answer" 7)' ERR='(substring string [start [end]]) - start out of range' OBJ= flisp_err; ok substring-7 substring answer 7 range-error -IN='(substring "answer" -7)' ERR='(substring str [start [end]]) - start out of range' OBJ= +IN='(substring "answer" -7)' ERR='(substring string [start [end]]) - start out of range' OBJ= flisp_err; ok substring-8 substring answer -7 range-error -IN='(substring "answer" 1 7)' ERR='(substring str [start [end]]) - end out of range' OBJ= +IN='(substring "answer" 1 7)' ERR='(substring string [start [end]]) - end out of range' OBJ= flisp_err; ok substring-9 substring answer 1 7 range-error -IN='(substring "answer" 1 -7)' ERR='(substring str [start [end]]) - end out of range' OBJ= +IN='(substring "answer" 1 -7)' ERR='(substring string [start [end]]) - end out of range' OBJ= flisp_err; ok substring-10 substring answer 1 7 range-error -IN='(substring "answer" 2 1)' ERR='(substring str [start [end]]) - end > start' OBJ= +IN='(substring "answer" 2 1)' ERR='(substring string [start [end]]) - end > start' OBJ= flisp_err; ok substring-11 substring answer 2 1 range-error IN='(string-search "" "")' OUT='0' From 5c40a0ee69124c58fc55bb6c39ebf9f7f762a5ac Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 2 Sep 2025 23:12:42 +0200 Subject: [PATCH 39/90] WIP: hunt heisenbug Somewhere - probably in (cond) is a heisenbug causing segfaults on startup of femto with commandline arguments. (string-contains) showed the problem, replacing it with the (string-search) search primitives resolves the issue. The heisenbug is still there - and not. --- lisp/startup.lsp | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/startup.lsp b/lisp/startup.lsp index cf907a6..9ef7b98 100644 --- a/lisp/startup.lsp +++ b/lisp/startup.lsp @@ -89,10 +89,9 @@ ;; (defun read-hook (s) (cond - ((string-contains "|c|h|cpp|" (get-buffer-file-extension)) (add-mode "cmode")) - ((string-contains "|rc|lsp|" (get-buffer-file-extension)) (add-mode "lispmode")) - ((string-contains "|py|" (get-buffer-file-extension)) (add-mode "python")))) - + ((string-search (get-buffer-file-extension) "|c|h|cpp|") (add-mode "cmode")) + ((string-search (get-buffer-file-extension) "|rc|lsp|") (add-mode "lispmode")) + ((string-search (get-buffer-file-extension) "|py|") (add-mode "python")))) ;; Load and edit user specific config (setq From c34ba4b732882b89b6d352471ea1410b511a8c92 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Tue, 2 Sep 2025 23:26:51 +0200 Subject: [PATCH 40/90] WIP: documentation --- lisp.c | 7 +++++-- misc/ROADMAP.flisp.txt | 6 ++++-- pdoc/flisp.html | 2 +- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp.c b/lisp.c index f88bf47..37a8d38 100644 --- a/lisp.c +++ b/lisp.c @@ -2287,7 +2287,6 @@ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) end = FLISP_ARG_THREE->integer; } } - if (start < 0 || start > len) exceptionWithObject(interp, FLISP_ARG_TWO, range_error, "(substring string [start [end]]) - start out of range"); @@ -2299,7 +2298,7 @@ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) "(substring string [start [end]]) - end > start"); if (start == end) return empty; - + int newlen = end - start; Object *new = newStringWithLength(interp, (FLISP_ARG_ONE->string)+start, newlen+1); new->string[newlen] = '\0'; @@ -2637,6 +2636,10 @@ void lisp_write_error(Interpreter *interp, FILE *fd) } /** (catch (eval (read f))) or (catch (eval (read))) + * + * (eval (read f)) or (eval (read)) + * (eval . (read . (f . nil)) or + * (eval . (read . nil) */ Object *cerf(Interpreter *interp, FILE *fd) { diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index eb55ac9..714c19c 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -11,9 +11,11 @@ + Implement fstat. + Implement popen, pclose. - WIP: dynamic memory allocation - - cleanup cerf - - tune chunk size (and initial memory?) + - Cleanup cerf + - Fix FLISP_RESULT macros: they must have interp as parameter. + - Tune chunk size (and initial memory?) - Fix all related Note's. + - Update dokumentation. - Make femto.rc use fstat. - Implement mkdir and fix file save bug. - Improve/support batch mode: output = stdout. diff --git a/pdoc/flisp.html b/pdoc/flisp.html index 2806027..da625d3 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -1251,7 +1251,7 @@

    fLisp C Interface

    If no memory can be allocated for the input string or the input file descriptor is NULL no Lisp - evaluation takes place and the object field of the interpreter is set to an io-error. + evaluation takes place and FLISP_RESULT_CODE field of the interpreter is set to an io-error.
    void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, From d1cd5a9a5a18df3167d59ed5004b13c6bdf08650 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 12:42:06 +0200 Subject: [PATCH 41/90] Fix: Re-add strdup to substring Would not survive gc_always --- lisp.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp.c b/lisp.c index 37a8d38..175731f 100644 --- a/lisp.c +++ b/lisp.c @@ -2300,7 +2300,11 @@ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) return empty; int newlen = end - start; - Object *new = newStringWithLength(interp, (FLISP_ARG_ONE->string)+start, newlen+1); + char *buf = strdup(FLISP_ARG_ONE->string); + if (buf == NULL) + fl_fatal("OOM allocating buffer for (substring)\n",67); + Object *new = newStringWithLength(interp, buf+start, newlen+1); + free(buf); new->string[newlen] = '\0'; return new; From 38a7c3476af2a6a8d98764613239191ae37a34f7 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 12:44:12 +0200 Subject: [PATCH 42/90] Dynamic memory management survives gc_always --- lisp.c | 4 +++- misc/ROADMAP.flisp.txt | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp.c b/lisp.c index 175731f..d55d8ef 100644 --- a/lisp.c +++ b/lisp.c @@ -338,7 +338,7 @@ void gc(Interpreter *interp) ); interp->memory->toOffset = 0; - // move trace, symbols and root objects + // move trace, symbols, root and interp result objects for (object = interp->gcTop; object != nil; object = object->cdr) { #if DEBUG_GC | FLISP_TRACK_GCTOP fl_debug(interp, "moving gc traced object %p of type %s\n", @@ -358,6 +358,8 @@ void gc(Interpreter *interp) #endif interp->symbols = gcMoveObject(interp, interp->symbols, &stats); interp->global = gcMoveObject(interp, interp->global, &stats); + interp->result = gcMoveObject(interp, interp->result, &stats); + interp->error = gcMoveObject(interp, interp->error, &stats); // iterate over objects in to-space and move all objects they reference for (object = interp->memory->toSpace; diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index 714c19c..e2d3bd4 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -11,6 +11,7 @@ + Implement fstat. + Implement popen, pclose. - WIP: dynamic memory allocation + + Run with gc_always on - Cleanup cerf - Fix FLISP_RESULT macros: they must have interp as parameter. - Tune chunk size (and initial memory?) @@ -32,6 +33,7 @@ - Make extensions plugable. - Test more then one interpreter. - ? CSP between interpreters? +- Add read and eval tracing. - Size reduction: - Make double extensions optional. - Replace string-contains with string-search. From 2a82ba5759ba392ba51b4cbf9c00ab2ff222bde9 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 13:45:11 +0200 Subject: [PATCH 43/90] Fix: make FLISP_RESULT_* macros take the interpreter as argument Otherwise the interpreter pointer is hardcoded as 'interp' --- flisp.c | 14 +++++++------- lisp.c | 16 ++++++++-------- lisp.h | 6 +++--- main.c | 10 +++++----- misc/ROADMAP.flisp.txt | 2 +- 5 files changed, 24 insertions(+), 24 deletions(-) diff --git a/flisp.c b/flisp.c index 8b0a8f1..d009ecd 100644 --- a/flisp.c +++ b/flisp.c @@ -50,12 +50,12 @@ void repl(Interpreter *interp) } lisp_eval(interp, input); - if (FLISP_RESULT_CODE != nil) { + if (FLISP_RESULT_CODE(interp) != nil) { lisp_write_error(interp, stderr); - if (FLISP_RESULT_CODE == out_of_memory) break; + if (FLISP_RESULT_CODE(interp) == out_of_memory) break; } } - if (FLISP_RESULT_CODE != nil) { + if (FLISP_RESULT_CODE(interp) != nil) { exit_code = 1; } return; @@ -90,10 +90,10 @@ int main(int argc, char **argv) // load inifile interp->input = fd; lisp_eval(interp, NULL); - if (FLISP_RESULT_CODE != nil) { + if (FLISP_RESULT_CODE(interp) != nil) { fprintf(stderr, "failed to load inifile %s:\n", init_file); lisp_write_error(interp, stderr); - if (FLISP_RESULT_CODE == out_of_memory) + if (FLISP_RESULT_CODE(interp) == out_of_memory) return 1; // Note: if we could implement the repl in fLisp itself we'd done here. } @@ -110,10 +110,10 @@ int main(int argc, char **argv) // Just eval the standard input interp->input = stdin; lisp_eval(interp, NULL); - if (FLISP_RESULT_CODE != nil) + if (FLISP_RESULT_CODE(interp) != nil) lisp_write_error(interp, stderr); } - if (FLISP_RESULT_CODE != out_of_memory) + if (FLISP_RESULT_CODE(interp) != out_of_memory) lisp_destroy(interp); return exit_code; } diff --git a/lisp.c b/lisp.c index d55d8ef..3c54ad7 100644 --- a/lisp.c +++ b/lisp.c @@ -1536,7 +1536,7 @@ Object *evalCatch(Interpreter *interp, Object **args, Object **env) setInterpreterResult(interp, nil, nil, NULL); GC_CHECKPOINT; if (setjmp(exceptionEnv)) { - fl_debug(interp, "catch:%s: '%s'\n", FLISP_RESULT_CODE->string, FLISP_RESULT_MESSAGE->string); + fl_debug(interp, "catch:%s: '%s'\n", FLISP_RESULT_CODE(interp)->string, FLISP_RESULT_MESSAGE(interp)->string); } else { do { setInterpreterResult(interp, evalExpr(interp, &(*args)->car, env), nil, NULL); @@ -2631,12 +2631,12 @@ void lisp_destroy(Interpreter *interp) */ void lisp_write_error(Interpreter *interp, FILE *fd) { - if (FLISP_RESULT_OBJECT == nil) - fprintf(fd, "error: %s\n", FLISP_RESULT_MESSAGE->string); + if (FLISP_RESULT_OBJECT(interp) == nil) + fprintf(fd, "error: %s\n", FLISP_RESULT_MESSAGE(interp)->string); else { fprintf(fd, "error: '"); - lisp_write_object(interp, fd, FLISP_RESULT_OBJECT, true); - fprintf(fd, "', %s\n", FLISP_RESULT_MESSAGE->string); + lisp_write_object(interp, fd, FLISP_RESULT_OBJECT(interp), true); + fprintf(fd, "', %s\n", FLISP_RESULT_MESSAGE(interp)->string); } fflush(fd); } @@ -2688,9 +2688,9 @@ Object *cerf(Interpreter *interp, FILE *fd) * * The following macros can be used to access the list elements: * - * - FLISP_RESULT_CODE - * - FLISP_RESULT_MESSAGE - * - FLISP_RESULT_OBJECT + * - FLISP_RESULT_CODE(INTERPRETER) + * - FLISP_RESULT_MESSAGE(INTERPRETER) + * - FLISP_RESULT_OBJECT(INTERPRETER) * */ void lisp_eval(Interpreter *interp, char *input) diff --git a/lisp.h b/lisp.h index bc0ec83..2781742 100644 --- a/lisp.h +++ b/lisp.h @@ -206,9 +206,9 @@ extern void lisp_eval(Interpreter *, char *); extern void lisp_write_object(Interpreter *, FILE *, Object *, bool); extern void lisp_write_error(Interpreter *, FILE *); -#define FLISP_RESULT_CODE interp->error -#define FLISP_RESULT_MESSAGE ((Object *)&interp->message) -#define FLISP_RESULT_OBJECT interp->result +#define FLISP_RESULT_CODE(INTERPRETER) INTERPRETER->error +#define FLISP_RESULT_MESSAGE(INTERPRETER) ((Object *)&INTERPRETER->message) +#define FLISP_RESULT_OBJECT(INTERPRETER) INTERPRETER->result #endif /* diff --git a/main.c b/main.c index 7117d98..757d9fe 100644 --- a/main.c +++ b/main.c @@ -39,10 +39,10 @@ void load_file(char *file) interp->input = fd; interp->output = debug_fp; lisp_eval(interp, NULL); - if (FLISP_RESULT_CODE != nil) { + if (FLISP_RESULT_CODE(interp) != nil) { debug("failed to load file %s:\n", file); lisp_write_error(interp, debug_fp); - if (FLISP_RESULT_CODE == out_of_memory) + if (FLISP_RESULT_CODE(interp) == out_of_memory) fatal("OOM, exiting.."); } if (fclose(fd)) @@ -52,7 +52,7 @@ void load_file(char *file) int main(int argc, char **argv) { char *envv, *library_path, *init_file; - + batch_mode = ((envv=getenv("FEMTO_BATCH")) != NULL && strcmp(envv, "0")); debug_mode = ((envv=getenv("FEMTO_DEBUG")) != NULL && strcmp(envv, "0")); @@ -153,14 +153,14 @@ char *eval_string(bool do_format, char *format, ...) lisp_eval(interp, input); if (interp->output) fflush(interp->output); - if (FLISP_RESULT_CODE == nil) + if (FLISP_RESULT_CODE(interp) == nil) return output; msg_lisp_err(interp); if (debug_mode) { lisp_write_error(interp, debug_fp); debug("=> %s\n", output); } - if (FLISP_RESULT_CODE == out_of_memory) + if (FLISP_RESULT_CODE(interp) == out_of_memory) fatal("OOM, exiting.."); free_lisp_output(); return NULL; diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index e2d3bd4..ee34c48 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -12,8 +12,8 @@ + Implement popen, pclose. - WIP: dynamic memory allocation + Run with gc_always on + + Fix FLISP_RESULT macros: they must have interp as parameter. - Cleanup cerf - - Fix FLISP_RESULT macros: they must have interp as parameter. - Tune chunk size (and initial memory?) - Fix all related Note's. - Update dokumentation. From 5347143535baad624138231dd81ff4331ac413f7 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 14:21:29 +0200 Subject: [PATCH 44/90] Account for size of argv and library_path when allocating memory --- lisp.c | 43 ++++++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/lisp.c b/lisp.c index 3c54ad7..7e94cf1 100644 --- a/lisp.c +++ b/lisp.c @@ -547,7 +547,19 @@ Object *newInteger(Interpreter *interp, int64_t number) return object; } -/** newObjectWithString - allocate a new variable size Object in the Lisp object store +/** objectSize() - Calculate expected space to allocate for object with string + * + * @param size length of string to store + * + * @returns Size of an object if string fits into it completely, the needed size otherwise. + */ +size_t objectSize(size_t size) +{ + return sizeof(Object) + + ((size > sizeof(((Object *) NULL)->string)) ? size - sizeof(((Object *) NULL)->string) : 0); +} + +/** newObjectWithString() - allocate a new variable size Object in the Lisp object store * * @param interp fLisp Interpreter * @param type Object type of the new Object @@ -560,13 +572,10 @@ Object *newInteger(Interpreter *interp, int64_t number) */ Object *newObjectWithString(Interpreter *interp, Object *type, size_t size) { - size = (size > sizeof(((Object *) NULL)->string)) - ? size - sizeof(((Object *) NULL)->string) - : 0; - - return memoryAllocObject(interp, type, sizeof(Object) + size); + return memoryAllocObject(interp, type, objectSize(size)); } -/** unescapeString - copy a string, converting escaped symbols + +/** unescapeString() - copy a string, converting escaped symbols * * @param dst destination * @param src escaped string to copy @@ -2521,6 +2530,8 @@ Interpreter *lisp_new( FILE *input, FILE *output, FILE* debug) { Interpreter *interp; + size_t count = 0; + char **s = argv; if (lisp_interpreters != NULL) return NULL; @@ -2528,8 +2539,15 @@ Interpreter *lisp_new( interp = malloc(sizeof(Interpreter)); if (interp == NULL) return NULL; - /* Note: we might want to allocate more to take into account the size of argv and library_path */ - Memory *memory = newMemory(FLISP_MIN_MEMORY); + /* enable debug output */ + interp->debug = debug; + + /* Account for the size of argv and library_path objects and their symbols */ + for (int i = 0; s[i]; count += objectSize(strlen(s[i++]))); + count += objectSize(strlen(library_path)); + count += 2*sizeof(Object); + fl_debug(interp, "lisp_new(): additional memory for argv and library path storage: %lu\n", count); + Memory *memory = newMemory(FLISP_MIN_MEMORY+count+FLISP_INITIAL_MEMORY); if (memory == NULL) { setInterpreterResult(interp, nil, out_of_memory, "failed to allocate memory for the interpreter"); return NULL; @@ -2565,11 +2583,10 @@ Interpreter *lisp_new( /* Add argv to the environement */ var = newSymbol(interp, "argv"); val = nil; - Object **i; /* Note: this can trigger a gc() if argv has many elements, check with max commandline length */ - for (i = &val; *++argv; i = &(*i)->cdr) { - *i = newCons(interp, &nil, &nil); - (*i)->car = newString(interp, *argv); + for (Object **j = &val; *++argv; j = &(*j)->cdr) { + *j = newCons(interp, &nil, &nil); + (*j)->car = newString(interp, *argv); } (void)envSet(interp, &var, &val, &interp->global, true); From 9ec3406208da200d785c95f3c6724b70cbe7d456 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 14:23:57 +0200 Subject: [PATCH 45/90] Re-add facility to specify initial memory If FLISP_INITIAL_MEMORY is specified, it adds to the minimum amount needed to start the fLisp interpreter. Please note that only half of the amount is actually available, the other half is used for garbage collection. For femto currently 512k(256k) is enough to start up without initiating garbage collection cycles. --- header.h | 2 ++ lisp.c | 12 ++++++------ 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/header.h b/header.h index 9654450..75bc512 100644 --- a/header.h +++ b/header.h @@ -508,6 +508,8 @@ extern window_t *split_current_window(void); extern char *eval_string(bool, char *, ...); extern void free_lisp_output(void); +#define FLISP_INITIAL_MEMORY 5242886UL /* 256k Lisp object space, no gc on startup */ + /* * Local Variables: * c-file-style: "k&r" diff --git a/lisp.c b/lisp.c index 7e94cf1..c74496a 100644 --- a/lisp.c +++ b/lisp.c @@ -35,6 +35,11 @@ /* No user servicable parts inside */ +#ifndef FLISP_INITIAL_MEMORY +#define FLISP_INITIAL_MEMORY 0 +#endif + + #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif @@ -1366,8 +1371,6 @@ Object *evalSetVar(Interpreter *interp, Object **args, Object **env, bool top) if (var->type != type_symbol) exceptionWithObject(interp, var, wrong_type_argument, "(setq/define name value) - name is not a symbol"); - /* Note: we want to check for all constants here */ - //if (var == nil || var == t) if (!gcCollectableObject(interp, var)) exceptionWithObject(interp, var, wrong_type_argument, "(setq/define name value) name is a constant and cannot be redefined"); @@ -1940,7 +1943,7 @@ Object *primitiveCons(Interpreter *interp, Object **args, Object **env) // Introspection /////// Object *primitiveGc(Interpreter *interp, Object **args, Object **env) { - // Note: + // Note: we really want to return respective data gc(interp); return t; } @@ -2569,9 +2572,6 @@ Interpreter *lisp_new( interp->next = interp; lisp_interpreters = interp; - /* enable debug output */ - interp->debug = debug; - /* global environment */ initRootEnv(interp); From a7268124233a4eabfb7e4ea6e80fef552885d4b0 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Wed, 3 Sep 2025 17:43:02 +0200 Subject: [PATCH 46/90] Update dokumentation --- docs/flisp.md | 137 +++++++++++++++++++++------------- lisp.c | 1 - lisp/flisp.lsp | 2 +- misc/ROADMAP.flisp.txt | 8 +- pdoc/flisp.html | 166 ++++++++++++++++++++++++----------------- 5 files changed, 190 insertions(+), 124 deletions(-) diff --git a/docs/flisp.md b/docs/flisp.md index 94d80b9..6124212 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -32,7 +32,7 @@ use other resources eg. or - [The Scheme Programming Language](https://www.scheme.org/). -This manual refers to version 0.6 or later of fLisp. +This manual refers to version 0.12 or later of fLisp. ### Table of Contents @@ -782,9 +782,17 @@ only one *num* is given they all return `t`. This library implements commonly excpected Lisp idioms. *fLisp* implements a carefully selected minimum set of commonly used functions. -listp -and -or +`(listp «o»)` D +Returns true if *o* is `nil` or a *cons*. + +`(and[ o..])` +Returns `t` or the last object *o* if none is given or all evaluate to +non `nil`, `nil` otherwise. + +`(or[ o..])` +Returns `nil` if all objects o are `nil`, otherwise returns the first +object which evaluates to non `nil`. + `(reduce «func» «list» «start»)` D `reduce` applies the binary *func* to the first element of *list* and *start* and then recursively to the first element of the rest of the @@ -1181,9 +1189,10 @@ interpreter. Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions are stored in separated C files and the interface code is conditionally included into the `lisp.c` -file. Two extensions are provided: the Femto extension which provides -the editor functionality and the file extension which provides access to -the low level stream I/O functions and adds some more. +file. Three extensions are provided: the Femto extension which provides +the editor functionality, the file extension which provides access to +the low level stream I/O functions and others and the double extensions +which provides double float arithmetic. *fLisp* exposes the following public interface functions: @@ -1211,30 +1220,46 @@ pressed or upon explicit request via the editor interface. The `flisp` command line interpreter sets `stdout` as the default output file descriptors of the *fLisp* interpreter and feeds it with strings of lines read from the terminal. If the standard input is not a terminal -`stdin` is set as the default input file descriptor and *fLisp* reads it -through until end of file. +`stdin` is set as the default input file descriptor and *fLisp* reads +through it until end of file. -After processing the input, the interpreter puts a [`catch`](interp_ops) -result in the form `(«error_type» «message» «object»)` object into the -`object` field of the interpreter structure. Upon success *error_type* -is nil and the *object* element is the result of the last evaluation. -They can be accessed with the C-macros `FLISP_RESULT_CODE` and -`FLISP_RESULT_OBJECT`. +After processing the input, the interpreter holds the results +corresponding to a [`catch`](interp_ops) result in its internal +structure. They can be accessed with the following C-macros: + +*error_type* +`FLISP_RESULT_CODE(interpreter)` + +*message* +`FLISP_RESULT_MESSAGE(interpreter)` + +*object* +`FLISP_RESULT_OBJECT(interpreter)` + +Check for `(FLISP_RESULT_OBJECT(interpreter) != nil)` to find out if the +result is an error. Then check for +`(FLISP_RESULT_OBJECT(interpreter) == out_of_memory)` to see if a fatal +condition occured. On error use `lisp_write_error()` to write the standard error message to a file descriptor of choice, or use the above C-macros and -`FLISP_ERROR_MESSAGE` for taking specific action. Note that these macros -evaluate to a Lisp object, you have to dereference their content to used -it. +`FLISP_ERROR_MESSAGE(interpreter)->string` for executing a specific +action. -*fLisp* sends all output to the default output stream. If `NULL` is -given on initialization, output is suppressed altogether. +*fLisp* sends all output to the default output stream. If it is set to +`NULL` on initialization, output is suppressed altogether. #### fLisp C Interface -*Interpreter*` *lisp_new(int «size», char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` -`lisp_new()` creates and initializes an fLisp interpreter. The initial -environment contains the following symbols: +*Interpreter*` *lisp_new(char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` +`lisp_new()` creates and initializes an fLisp interpreter and returns a +pointer to an *Interpreter* struct to be used in the other functions. +The arguments to `lisp_new()` are: + +*argv* +*library_path* +The fLisp environment is initialized with this two argument to contain +the following symbols: *argv0* The string stored in `*«argv»[0]`, if any @@ -1245,16 +1270,6 @@ The list of strings stored in *argv* *script_dir* The string stored in *library_path* -A pointer to an *Interpreter* struct is returned, which is used to -operate the interpreter. - -The other arguments to `lisp_new()` are: - -*size* -Memory size to allocate for the Lisp objects. This is divided into two -pages for garbage collection. Only one page is used by the interpreter -at any moment. - *input* Default input stream. If *input* is set to `NULL`, the input stream has to be specified for each invocation of `lisp_eval()`. @@ -1278,8 +1293,8 @@ field of the *fLisp* interpreter *interp* is evaluated until end of file. If no memory can be allocated for the input string or the input file -descriptor is `NULL` no Lisp evaluation takes place and the `object` -field of the interpreter is set to an `io-error`. +descriptor is `NULL` no Lisp evaluation takes place and +`FLISP_RESULT_CODE` field of the interpreter is set to an `io-error`. `void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` Format *object* into a string and write it to *stream*. If *readably* is @@ -1309,10 +1324,11 @@ number of arguments allowed for the function. If *argMax* is a negative number, arguments must be given in tuples of *argMax* and the number of tuples is not restricted. -When type check is set to a type C-macro the interpreter assures that -all arguments are of the given type and creates a standardized exception -otherwise. When type check is set to `0` the primitive has to take care -of type checking by itself. The C-macro `CHECK_TYPE` helps with this. +When type check is set to on of the `TYPE_*` C-macros the interpreter +assures that all arguments are of the given type and creates a +standardized exception otherwise. When type check is set to `0` the +primitive has to take care of type checking by itself. The C-macro +`CHECK_TYPE` helps with this. When creating more then one new objects within a primitive, care has to be taken to register them with the garbage collector. Registration is @@ -1331,7 +1347,6 @@ in primitives: Evaluate to true if there are arguments or the respective argument is available. -`ONE_NUMBER_ARG(«name»)` `FLISP_ARG_ONE` `FLISP_ARG_TWO` `FLISP_ARG_THREE` @@ -1353,7 +1368,8 @@ message. *fLisp* implements Cheney's copying garbage collector, with which memory is divided into two equal halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used -during garbage collection. +during garbage collection. The from-space part of the memory is also +called the Lisp object space. When garbage collection is performed, objects that are still in use (live) are copied from from-space to to-space. To-space then becomes the @@ -1393,28 +1409,41 @@ points to the objects pointer inside the list. Information about the garbage collection process and memory status is written to the debug file descriptor. -#### Memory Usage +#### Memory Allocation + +Object allocation adjusts the size of the Lisp object space on demand: +If after garbage collection the free space is less then the required +memory plus some reserved space for exception reporting, the memory is +increased by a multiple of the amount specified in the C-macro +`FLISP_MEMORY_INC`, defined in `lisp.h`. The multiple is calculated to +hold at least the additional requested space. + +`lisp_new()` allocates `FLISP_MIN_MEMORY`, defined in `lisp.h`, and then +allocates all initial objects without taking care of garbage collection. +Then it prints out the amount of Lisp object space consumed to the debug +file descriptor. For *fLisp* this is currently about 21 kB, for *femto* +about 34 kB. -Some compile time adjustable limits in `lisp.h`: +In order to reduce garbage collection frequency, especially during +startup, one can set `FLISP_INITIAL_MEMORY` to a desired additional +amount of memory to allocate on startup. + +Some other compile time adjustable limits in `lisp.h`: Input buffer 2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for -`lisp_eval()`. +`lisp_eval()` and for the input buffer of `(fgets)`. Output buffer 2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting buffer. -*fLisp* can live with as little as 400k object memory. The Femto editor -requires 16M since the “OXO” game requires a lot of memory. +*fLisp* can live with as little as 50k object memory up to startup. The +Femto editor requires much more memory because of the needs of the “OXO” +game. #### Future Directions -The two memory pages should be separated and the second one should be -allocated only during garbage collection. When memory runs out, the -garbage collection should be restarted with an increased capacity of the -new page. - It is now possible to catch exceptions within Lisp code and exceptions return differentiated error codes and use POSIX stream I/O. This, together with the `(eval)` primitive would allow to write the repl @@ -1426,3 +1455,9 @@ It could made easier, by any combination of: - loop/while/for macro - Demoing hand crafted loops including breaking with throw. + +Implement backquote and friends. + +Pluggable extensions. + +Take away more things. diff --git a/lisp.c b/lisp.c index c74496a..82d10d3 100644 --- a/lisp.c +++ b/lisp.c @@ -2583,7 +2583,6 @@ Interpreter *lisp_new( /* Add argv to the environement */ var = newSymbol(interp, "argv"); val = nil; - /* Note: this can trigger a gc() if argv has many elements, check with max commandline length */ for (Object **j = &val; *++argv; j = &(*j)->cdr) { *j = newCons(interp, &nil, &nil); (*j)->car = newString(interp, *argv); diff --git a/lisp/flisp.lsp b/lisp/flisp.lsp index 2f69aed..a0bacdd 100644 --- a/lisp/flisp.lsp +++ b/lisp/flisp.lsp @@ -4,7 +4,7 @@ (require 'core) -(defun listp (x) (cond ((null x)) ((consp x)))) +(defun listp (o) (cond ((null o)) ((consp o)))) (defmacro and args (cond diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt index ee34c48..6c1a16a 100644 --- a/misc/ROADMAP.flisp.txt +++ b/misc/ROADMAP.flisp.txt @@ -13,10 +13,10 @@ - WIP: dynamic memory allocation + Run with gc_always on + Fix FLISP_RESULT macros: they must have interp as parameter. - - Cleanup cerf - - Tune chunk size (and initial memory?) - - Fix all related Note's. - - Update dokumentation. + + Tune chunk size (and initial memory?) + + Fix all related Note's. + + Update documentation. + - Cleanup cerf: not so easy to do - Make femto.rc use fstat. - Implement mkdir and fix file save bug. - Improve/support batch mode: output = stdout. diff --git a/pdoc/flisp.html b/pdoc/flisp.html index da625d3..d6025b2 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -46,7 +46,7 @@

    Introduction

  • The Scheme Programming Language.
    • - This manual refers to version 0.6 or later of fLisp. + This manual refers to version 0.12 or later of fLisp.

    Table of Contents

      @@ -521,7 +521,7 @@

      Arithmetic Operations

      -

      Bitwise Integer Operations

      +

      Bitwise Integer Operations

      (& i j)
      @@ -779,9 +779,18 @@

      fLisp Library

      of commonly used functions.

      -
      listp
      -
      and
      -
      or
      +
      (listp o) D
      +
      Returns true if o is nil or a cons.
      +
      (and[ o..])
      +
      + Returns t or the last object o if none is given or all evaluate to non + nil, nil otherwise. +
      +
      (or[ o..])
      +
      + Returns nil if all objects o are nil, otherwise returns the first object + which evaluates to non nil. +
      (reduce func list start) D
      reduce applies the binary func to the first element of list @@ -875,7 +884,7 @@

      Buffers

      flags: special, modified.
      Mode flags determine the syntax highlighter mode: cmode and lispmode are - available. If none is set text mode is used for syntax hightlighting.
      + available. If none is set text mode is used for syntax hightlighting.

      In the following, any mention to one of them refers to the respective current buffers property.

      @@ -1156,8 +1165,9 @@

      Embedding Overview

      Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions are stored in separated C files and the interface code is conditionally included into the lisp.c - file. Two extensions are provided: the Femto extension which provides the editor functionality and the file - extension which provides access to the low level stream I/O functions and adds some more. + file. Three extensions are provided: the Femto extension which provides the editor functionality, the file + extension which provides access to the low level stream I/O functions and others and the double extensions which + provides double float arithmetic.

      fLisp exposes the following public interface functions:

      @@ -1177,65 +1187,72 @@

      Embedding Overview

      The flisp command line interpreter sets stdout as the default output file descriptors of the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is - not a terminal stdin is set as the default input file descriptor and fLisp reads it through + not a terminal stdin is set as the default input file descriptor and fLisp reads through it until end of file.

      - After processing the input, the interpreter puts a catch result in the - form (error_type message object) object into the object - field of the interpreter structure. Upon success error_type is nil and the object element - is the result of the last evaluation. They can be accessed with the C-macros FLISP_RESULT_CODE - and FLISP_RESULT_OBJECT. + After processing the input, the interpreter holds the results corresponding to + a catch result in its internal structure. They can be accessed with the + following C-macros: +

      +
      +
      error_type
      +
      FLISP_RESULT_CODE(interpreter)
      +
      message
      +
      FLISP_RESULT_MESSAGE(interpreter)
      +
      object
      +
      FLISP_RESULT_OBJECT(interpreter)
      +
      +

      + Check for (FLISP_RESULT_OBJECT(interpreter) != nil) to find out if the result is an error. Then check + for (FLISP_RESULT_OBJECT(interpreter) == out_of_memory) to see if a fatal condition occured.

      On error use lisp_write_error() to write the standard error message to a file descriptor of choice, - or use the above C-macros and FLISP_ERROR_MESSAGE for taking specific action. Note that these macros - evaluate to a Lisp object, you have to dereference their content to used it. + or use the above C-macros and FLISP_ERROR_MESSAGE(interpreter)->string for executing a specific + action.

      - fLisp sends all output to the default output stream. If NULL is given on initialization, output is - suppressed altogether. + fLisp sends all output to the default output stream. If it is set to NULL on initialization, + output is suppressed altogether.

      fLisp C Interface

      -
      Interpreter *lisp_new(int size, char **argv, char - *library_path, FILE *input, FILE *output, FILE* debug)
      +
      Interpreter *lisp_new(char **argv, char *library_path, FILE *input, + FILE *output, FILE* debug)
      -

      lisp_new() creates and initializes an fLisp interpreter. The initial environment contains the - following symbols: +

      + lisp_new() creates and initializes an fLisp interpreter and returns a pointer to + an Interpreter struct to be used in the other functions. The arguments to lisp_new() + are:

      +
      -
      argv0
      The string stored in *argv[0], if any
      -
      argv
      The list of strings stored in argv
      -
      script_dir
      The string stored in library_path
      +
      argv
      +
      library_path
      +
      + The fLisp environment is initialized with this two argument to contain the following symbols: +
      +
      argv0
      The string stored in *argv[0], if any
      +
      argv
      The list of strings stored in argv
      +
      script_dir
      The string stored in library_path
      +
      +
      +
      input
      +
      + Default input stream. If input is set to NULL, the input stream has to be + specified for each invocation of lisp_eval(). +
      +
      output
      +
      + Default output stream. If output is set to NULL a memory stream is created at the + first invocation of the interpreter and set as the default output stream. +
      debug
      +
      Debug output stream. If set to NULL no debug information is generated.
      -

      A pointer to an Interpreter struct is returned, which is used to operate the interpreter.

      -
      -
      -

      - The other arguments to lisp_new() are: -

      -
      size
      -
      - Memory size to allocate for the Lisp objects. This is divided into two pages for garbage - collection. Only one page is used by the interpreter at any moment. -
      -
      input
      -
      - Default input stream. If input is set to NULL, the input stream has to be - specified for each invocation of lisp_eval(). -
      -
      output
      -
      - Default output stream. If output is set to NULL a memory stream is created at the - first invocation of the interpreter and set as the default output stream. -
      debug
      -
      Debug output stream. If set to NULL no debug information is generated.
      -
      -

      - +
      void lisp_destroy(Interpreter *interp)
      Frees all resources used by the interpreter.
      @@ -1287,9 +1304,9 @@

      Building Extensions

      of argMax and the number of tuples is not restricted.

      - When type check is set to a type C-macro the interpreter assures that all arguments are of the given type and - creates a standardized exception otherwise. When type check is set to 0 the primitive has to take - care of type checking by itself. The C-macro CHECK_TYPE helps with this. + When type check is set to on of the TYPE_* C-macros the interpreter assures that all arguments are of + the given type and creates a standardized exception otherwise. When type check is set to 0 the + primitive has to take care of type checking by itself. The C-macro CHECK_TYPE helps with this.

      When creating more then one new objects within a primitive, care has to be taken to register them with the garbage @@ -1307,7 +1324,6 @@

      Building Extensions

      FLISP_HAS_ARG_TWO
      FLISP_HAS_ARG_THREE
      Evaluate to true if there are arguments or the respective argument is available.
      -
      ONE_NUMBER_ARG(name)
      FLISP_ARG_ONE
      FLISP_ARG_TWO
      FLISP_ARG_THREE
      @@ -1323,12 +1339,12 @@

      Building Extensions

      Implementation Details

      - +

      Garbage Collection

      fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used - during garbage collection. + during garbage collection. The from-space part of the memory is also called the Lisp object space.

      When garbage collection is performed, objects that are still in use (live) are copied from from-space to @@ -1369,30 +1385,43 @@

      Garbage Collection

      Information about the garbage collection process and memory status is written to the debug file descriptor.

      - -

      Memory Usage

      +

      Memory Allocation

      - Some compile time adjustable limits in lisp.h: + Object allocation adjusts the size of the Lisp object space on demand: If after garbage collection the free space + is less then the required memory plus some reserved space for exception reporting, the memory is increased by a + multiple of the amount specified in the C-macro FLISP_MEMORY_INC, defined in lisp.h. The + multiple is calculated to hold at least the additional requested space. +

      + lisp_new() allocates FLISP_MIN_MEMORY, defined in lisp.h, and then + allocates all initial objects without taking care of garbage collection. Then it prints out the amount of Lisp + object space consumed to the debug file descriptor. For fLisp this is currently about 21 kB, + for femto about 34 kB. +

      +

      + In order to reduce garbage collection frequency, especially during startup, one can + set FLISP_INITIAL_MEMORY to a desired additional amount of memory to allocate on startup. +

      + Some other compile time adjustable limits in lisp.h:

      -
      Input buffer
      2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval().
      +
      Input buffer
      +
      + 2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval() and for the + input buffer of (fgets). +
      Output buffer
      2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.

      - fLisp can live with as little as 400k object memory. The Femto editor requires 16M since the OXO - game requires a lot of memory. + fLisp can live with as little as 50k object memory up to startup. The Femto editor requires much more + memory because of the needs of the OXO game.

      Future Directions

      -

      - The two memory pages should be separated and the second one should be allocated only during garbage collection. - When memory runs out, the garbage collection should be restarted with an increased capacity of the new page. -

      It is now possible to catch exceptions within Lisp code and exceptions return differentiated error codes and use POSIX stream I/O. This, together with the (eval) primitive would allow to write the repl directly in Lisp, and reading and eval'ing until no more incomplete - input result codes are returned. + input result codes are returned.

      Loops are availble via the labelled let macro and supported by iota. It could made easier, by any @@ -1402,6 +1431,9 @@

      Future Directions

    1. loop/while/for macro
    2. Demoing hand crafted loops including breaking with throw.
      3. +

      Implement backquote and friends.

      +

      Pluggable extensions.

      +

      Take away more things.

      From fb1d664f2f0799ce9c0ef2a3e4604b7ef163160c Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 12 Sep 2025 21:47:25 +0200 Subject: [PATCH 86/90] Test: split fLisp documentation --- docs/develop.md | 293 +++++++++++++++++++++++++++++++++++++++++++ docs/flisp.md | 289 +----------------------------------------- pdoc/develop.html | 311 ++++++++++++++++++++++++++++++++++++++++++++++ pdoc/flisp.html | 289 +----------------------------------------- 4 files changed, 610 insertions(+), 572 deletions(-) create mode 100644 docs/develop.md create mode 100644 pdoc/develop.html diff --git a/docs/develop.md b/docs/develop.md new file mode 100644 index 0000000..a995c34 --- /dev/null +++ b/docs/develop.md @@ -0,0 +1,293 @@ +# fLisp Implementation Details + +[fLisp Manual](flisp.html) [(Markdown)](flisp.md) + +### Table of Contents + +1. [Embedding Overview](#embedding) +2. [fLisp C Interface](#c_api) +3. [Building Extensions](#extensions) + +[Implementation Details](implementation) + +1. [Garbage Collection](#gc) +2. [Memory Usage](#memory) +3. [Future Directions](#future) + +### Embedding fLisp + +#### Embedding Overview + +fLisp can be embedded into a C application. Two examples of embedding +are the `femto` editor and the simplistic `flisp` command line Lisp +interpreter. + +Currently embedding can only be done by extending the build system. +Application specific binary Lisp extensions are stored in separated C +files and the interface code is conditionally included into the `lisp.c` +file. Three extensions are provided: the Femto extension which provides +the editor functionality, the file extension which provides access to +the low level stream I/O functions and others and the double extensions +which provides double float arithmetic. + +*fLisp* exposes the following public interface functions: + +`lisp_new()` +Create a new interpreter. + +`lisp_destroy()` +Destroy an interpreter, releasing resources. + +`lisp_eval()` +Evaluate a string or the input stream until exhausted or error. + +`lisp_write_object()` +Format and write object to file descriptor. + +`lisp_write_error()` +Format and write the error object and error message of an interpreter to +a file descriptor. + +Different flows of operation can be implemented. The *femto* editor +initializes the interpreter without input/output file descriptors and +sends strings of Lisp commands to the interpreter, either when a key is +pressed or upon explicit request via the editor interface. + +The `flisp` command line interpreter sets `stdout` as the default output +file descriptors of the *fLisp* interpreter and feeds it with strings of +lines read from the terminal. If the standard input is not a terminal +`stdin` is set as the default input file descriptor and *fLisp* reads +through it until end of file. + +After processing the input, the interpreter holds the results +corresponding to a [`catch`](interp_ops) result in its internal +structure. They can be accessed with the following C-macros: + +*error_type* +`FLISP_RESULT_CODE(interpreter)` + +*message* +`FLISP_RESULT_MESSAGE(interpreter)` + +*object* +`FLISP_RESULT_OBJECT(interpreter)` + +Check for `(FLISP_RESULT_OBJECT(interpreter) != nil)` to find out if the +result is an error. Then check for +`(FLISP_RESULT_OBJECT(interpreter) == out_of_memory)` to see if a fatal +condition occured. + +On error use `lisp_write_error()` to write the standard error message to +a file descriptor of choice, or use the above C-macros and +`FLISP_ERROR_MESSAGE(interpreter)->string` for executing a specific +action. + +*fLisp* sends all output to the default output stream. If it is set to +`NULL` on initialization, output is suppressed altogether. + +#### fLisp C Interface + +*Interpreter*` *lisp_new(char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` +`lisp_new()` creates and initializes an fLisp interpreter and returns a +pointer to an *Interpreter* struct to be used in the other functions. +The arguments to `lisp_new()` are: + +*argv* +*library_path* +The fLisp environment is initialized with this two argument to contain +the following symbols: + +*argv0* +The string stored in `*«argv»[0]`, if any + +*argv* +The list of strings stored in *argv* + +*script_dir* +The string stored in *library_path* + +*input* +Default input stream. If *input* is set to `NULL`, the input stream has +to be specified for each invocation of `lisp_eval()`. + +*output* +Default output stream. If *output* is set to `NULL` a memory stream is +created at the first invocation of the interpreter and set as the +default output stream. + +*debug* +Debug output stream. If set to `NULL` no debug information is generated. + +`void lisp_destroy(Interpreter *«interp»)` +Frees all resources used by the interpreter. + +`void lisp_eval(Interpreter *«interp», char *«string»)` +If *string* is not `NULL` evaluates all Lisp expressions in *string*. + +If *string* is `NULL` input from the file descriptor in the *input* +field of the *fLisp* interpreter *interp* is evaluated until end of +file. + +If no memory can be allocated for the input string or the input file +descriptor is `NULL` no Lisp evaluation takes place and +`FLISP_RESULT_CODE` field of the interpreter is set to an `io-error`. + +`void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` +Format *object* into a string and write it to *stream*. If *readably* is +true, the string can be read in by the interpreter and results in the +same object. + +`void lisp_write_error(Interpreter *«interp», FILE «*fd»)` +Format the error *object* and the error message of the interpreter into +a string and write it to *fd*. The *object* is written with *readably* +`true`. + +Note: currently only creating one interpreter has +been tested. + +#### Building Extensions + +An extensions has to create C functions with the signature: +`Object *«primitive»(Interpreter *interp, Object **args, Object **env)`, +where *primitive* is a distinct name in C space. This function has to be +added to the global variable `primitives` in the following format: +`{"«name»", «argMin», «argMax», «type_check», «primitive»}`. Here *name* +is a distinct name in Lisp space. + +*interp* is the fLisp interpreter in which *primitive* is executed. +*argMin* is the minimum number of arguments, *argMax* is the maximum +number of arguments allowed for the function. If *argMax* is a negative +number, arguments must be given in tuples of *argMax* and the number of +tuples is not restricted. + +When type check is set to on of the `TYPE_*` C-macros the interpreter +assures that all arguments are of the given type and creates a +standardized exception otherwise. When type check is set to `0` the +primitive has to take care of type checking by itself. The C-macro +`CHECK_TYPE` helps with this. + +When creating more then one new objects within a primitive, care has to +be taken to register them with the garbage collector. Registration is +started with the `GC_CHECKPOINT` CPP macro. `GC_TRACE(«name», «value»` +creates an object variable *name*, sets it to *value* and registers it +with the garbage collector. The macro `GC_RELEASE` must be called to +finalize the registration. The convenience macro `GC_RETURN(«object»)` +calls `GC_RELEASE` and returns *object*. + +Some CPP macros are provided to simplify argument access and validation +in primitives: + +`FLISP_HAS_ARGS` +`FLISP_HAS_ARG_TWO` +`FLISP_HAS_ARG_THREE` +Evaluate to true if there are arguments or the respective argument is +available. + +`FLISP_ARG_ONE` +`FLISP_ARG_TWO` +`FLISP_ARG_THREE` +Evaluate to the respective argument. + +`CHECK_TYPE(«argument», «type», «signature»)` +Assures that the given argument is of the given type. *type* must be a +type variable like `type_string`. *signature* is the signature of the +primitive followed by “` - `” and the name of the argument to be type +checked. This is used to form a standardized `wrong-type-argument` error +message. + +### Implementation Details + +#### Garbage Collection + +*fLisp* implements Cheney's copying garbage collector, with which memory +is divided into two equal halves (semi spaces): from- and to-space. +From-space is where new objects are allocated, whereas to-space is used +during garbage collection. The from-space part of the memory is also +called the Lisp object space. + +When garbage collection is performed, objects that are still in use +(live) are copied from from-space to to-space. To-space then becomes the +new from-space and vice versa, thereby discarding all objects that have +not been copied. + +Our garbage collector takes as input a list of root objects. Objects +that can be reached by recursively traversing this list are considered +live and will be moved to to-space. When we move an object, we must also +update its pointer within the list to point to the objects new location +in memory. + +However, this implies that our interpreter cannot use raw pointers to +objects in any function that might trigger garbage collection (or risk +causing a SEGV when accessing an object that has been moved). Instead, +objects must be added to the list and then only accessed through the +pointer inside the list. + +Thus, whenever we would have used a raw pointer to an object, we use a +pointer to the pointer inside the list instead: + + function: pointer to pointer inside list (Object **) + | + v + list of root objects: pointer to object (Object *) + | + v + semi space: object in memory + + +*GC_TRACE* adds an object to the list and declares a variable which +points to the objects pointer inside the list. + +*GC_TRACE*`(«gcX», «X»)`: add object *X* to the list and declare +`Object **«gcX»` to point to the pointer to *X* inside the list. + +Information about the garbage collection process and memory status is +written to the debug file descriptor. + +#### Memory Allocation + +Object allocation adjusts the size of the Lisp object space on demand: +If after garbage collection the free space is less then the required +memory plus some reserved space for exception reporting, the memory is +increased by a multiple of the amount specified in the C-macro +`FLISP_MEMORY_INC`, defined in `lisp.h`. The multiple is calculated to +hold at least the additional requested space. + +`lisp_new()` allocates `FLISP_MIN_MEMORY`, defined in `lisp.h`, and then +allocates all initial objects without taking care of garbage collection. +Then it prints out the amount of Lisp object space consumed to the debug +file descriptor. For *fLisp* this is currently about 21 kB, for *femto* +about 34 kB. + +In order to reduce garbage collection frequency, especially during +startup, one can set `FLISP_INITIAL_MEMORY` to a desired additional +amount of memory to allocate on startup. + +Some other compile time adjustable limits in `lisp.h`: + +Input buffer +2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for +`lisp_eval()` and for the input buffer of `(fgets)`. + +Output buffer +2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting +buffer. + +*fLisp* can live with as little as 50k object memory up to startup. The +Femto editor requires much more memory because of the needs of the “OXO” +game. + +#### Future Directions + +Loops are availble via the labelled let macro and supported by `iota`. +It could made easier, by any combination of: + +- loop/while/for macro +- Demoing hand crafted loops including breaking with throw. + +Implement backquote and friends. + +Pluggable extensions. + +Take away more things. + +[^](#toc) diff --git a/docs/flisp.md b/docs/flisp.md index 35c0d7b..b6b89ed 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -71,15 +71,8 @@ This manual refers to version 0.13 or later of fLisp. 2. [Message Line](#message_line) 3. [Keyboard Handling](#keyboard) 4. [Programming and System Interaction](#programming_system) -10. [Embedding fLisp](#embedding) - 1. [Embedding Overview](#embedding) - 2. [fLisp C Interface](#c_api) - 3. [Building Extensions](#extensions) -11. [Implementation Details](implementation.html) - (Markdown) - 1. [Garbage Collection](#gc) - 2. [Memory Usage](#memory) - 3. [Future Directions](#future) +10. [fLisp Embedding and + Development](develop.html) [(Markdown)](develop.md) #### Notation Convention @@ -1232,281 +1225,3 @@ Logs string to the file `debug.out`. Returns the complete version string of Femto, including the copyright. [^](#toc) - -### Embedding fLisp - -#### Embedding Overview - -fLisp can be embedded into a C application. Two examples of embedding -are the `femto` editor and the simplistic `flisp` command line Lisp -interpreter. - -Currently embedding can only be done by extending the build system. -Application specific binary Lisp extensions are stored in separated C -files and the interface code is conditionally included into the `lisp.c` -file. Three extensions are provided: the Femto extension which provides -the editor functionality, the file extension which provides access to -the low level stream I/O functions and others and the double extensions -which provides double float arithmetic. - -*fLisp* exposes the following public interface functions: - -`lisp_new()` -Create a new interpreter. - -`lisp_destroy()` -Destroy an interpreter, releasing resources. - -`lisp_eval()` -Evaluate a string or the input stream until exhausted or error. - -`lisp_write_object()` -Format and write object to file descriptor. - -`lisp_write_error()` -Format and write the error object and error message of an interpreter to -a file descriptor. - -Different flows of operation can be implemented. The *femto* editor -initializes the interpreter without input/output file descriptors and -sends strings of Lisp commands to the interpreter, either when a key is -pressed or upon explicit request via the editor interface. - -The `flisp` command line interpreter sets `stdout` as the default output -file descriptors of the *fLisp* interpreter and feeds it with strings of -lines read from the terminal. If the standard input is not a terminal -`stdin` is set as the default input file descriptor and *fLisp* reads -through it until end of file. - -After processing the input, the interpreter holds the results -corresponding to a [`catch`](interp_ops) result in its internal -structure. They can be accessed with the following C-macros: - -*error_type* -`FLISP_RESULT_CODE(interpreter)` - -*message* -`FLISP_RESULT_MESSAGE(interpreter)` - -*object* -`FLISP_RESULT_OBJECT(interpreter)` - -Check for `(FLISP_RESULT_OBJECT(interpreter) != nil)` to find out if the -result is an error. Then check for -`(FLISP_RESULT_OBJECT(interpreter) == out_of_memory)` to see if a fatal -condition occured. - -On error use `lisp_write_error()` to write the standard error message to -a file descriptor of choice, or use the above C-macros and -`FLISP_ERROR_MESSAGE(interpreter)->string` for executing a specific -action. - -*fLisp* sends all output to the default output stream. If it is set to -`NULL` on initialization, output is suppressed altogether. - -#### fLisp C Interface - -*Interpreter*` *lisp_new(char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` -`lisp_new()` creates and initializes an fLisp interpreter and returns a -pointer to an *Interpreter* struct to be used in the other functions. -The arguments to `lisp_new()` are: - -*argv* -*library_path* -The fLisp environment is initialized with this two argument to contain -the following symbols: - -*argv0* -The string stored in `*«argv»[0]`, if any - -*argv* -The list of strings stored in *argv* - -*script_dir* -The string stored in *library_path* - -*input* -Default input stream. If *input* is set to `NULL`, the input stream has -to be specified for each invocation of `lisp_eval()`. - -*output* -Default output stream. If *output* is set to `NULL` a memory stream is -created at the first invocation of the interpreter and set as the -default output stream. - -*debug* -Debug output stream. If set to `NULL` no debug information is generated. - -`void lisp_destroy(Interpreter *«interp»)` -Frees all resources used by the interpreter. - -`void lisp_eval(Interpreter *«interp», char *«string»)` -If *string* is not `NULL` evaluates all Lisp expressions in *string*. - -If *string* is `NULL` input from the file descriptor in the *input* -field of the *fLisp* interpreter *interp* is evaluated until end of -file. - -If no memory can be allocated for the input string or the input file -descriptor is `NULL` no Lisp evaluation takes place and -`FLISP_RESULT_CODE` field of the interpreter is set to an `io-error`. - -`void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` -Format *object* into a string and write it to *stream*. If *readably* is -true, the string can be read in by the interpreter and results in the -same object. - -`void lisp_write_error(Interpreter *«interp», FILE «*fd»)` -Format the error *object* and the error message of the interpreter into -a string and write it to *fd*. The *object* is written with *readably* -`true`. - -Note: currently only creating one interpreter has -been tested. - -#### Building Extensions - -An extensions has to create C functions with the signature: -`Object *«primitive»(Interpreter *interp, Object **args, Object **env)`, -where *primitive* is a distinct name in C space. This function has to be -added to the global variable `primitives` in the following format: -`{"«name»", «argMin», «argMax», «type_check», «primitive»}`. Here *name* -is a distinct name in Lisp space. - -*interp* is the fLisp interpreter in which *primitive* is executed. -*argMin* is the minimum number of arguments, *argMax* is the maximum -number of arguments allowed for the function. If *argMax* is a negative -number, arguments must be given in tuples of *argMax* and the number of -tuples is not restricted. - -When type check is set to on of the `TYPE_*` C-macros the interpreter -assures that all arguments are of the given type and creates a -standardized exception otherwise. When type check is set to `0` the -primitive has to take care of type checking by itself. The C-macro -`CHECK_TYPE` helps with this. - -When creating more then one new objects within a primitive, care has to -be taken to register them with the garbage collector. Registration is -started with the `GC_CHECKPOINT` CPP macro. `GC_TRACE(«name», «value»` -creates an object variable *name*, sets it to *value* and registers it -with the garbage collector. The macro `GC_RELEASE` must be called to -finalize the registration. The convenience macro `GC_RETURN(«object»)` -calls `GC_RELEASE` and returns *object*. - -Some CPP macros are provided to simplify argument access and validation -in primitives: - -`FLISP_HAS_ARGS` -`FLISP_HAS_ARG_TWO` -`FLISP_HAS_ARG_THREE` -Evaluate to true if there are arguments or the respective argument is -available. - -`FLISP_ARG_ONE` -`FLISP_ARG_TWO` -`FLISP_ARG_THREE` -Evaluate to the respective argument. - -`CHECK_TYPE(«argument», «type», «signature»)` -Assures that the given argument is of the given type. *type* must be a -type variable like `type_string`. *signature* is the signature of the -primitive followed by “` - `” and the name of the argument to be type -checked. This is used to form a standardized `wrong-type-argument` error -message. - -[^](#toc) - -### Implementation Details - -#### Garbage Collection - -*fLisp* implements Cheney's copying garbage collector, with which memory -is divided into two equal halves (semi spaces): from- and to-space. -From-space is where new objects are allocated, whereas to-space is used -during garbage collection. The from-space part of the memory is also -called the Lisp object space. - -When garbage collection is performed, objects that are still in use -(live) are copied from from-space to to-space. To-space then becomes the -new from-space and vice versa, thereby discarding all objects that have -not been copied. - -Our garbage collector takes as input a list of root objects. Objects -that can be reached by recursively traversing this list are considered -live and will be moved to to-space. When we move an object, we must also -update its pointer within the list to point to the objects new location -in memory. - -However, this implies that our interpreter cannot use raw pointers to -objects in any function that might trigger garbage collection (or risk -causing a SEGV when accessing an object that has been moved). Instead, -objects must be added to the list and then only accessed through the -pointer inside the list. - -Thus, whenever we would have used a raw pointer to an object, we use a -pointer to the pointer inside the list instead: - - function: pointer to pointer inside list (Object **) - | - v - list of root objects: pointer to object (Object *) - | - v - semi space: object in memory - - -*GC_TRACE* adds an object to the list and declares a variable which -points to the objects pointer inside the list. - -*GC_TRACE*`(«gcX», «X»)`: add object *X* to the list and declare -`Object **«gcX»` to point to the pointer to *X* inside the list. - -Information about the garbage collection process and memory status is -written to the debug file descriptor. - -#### Memory Allocation - -Object allocation adjusts the size of the Lisp object space on demand: -If after garbage collection the free space is less then the required -memory plus some reserved space for exception reporting, the memory is -increased by a multiple of the amount specified in the C-macro -`FLISP_MEMORY_INC`, defined in `lisp.h`. The multiple is calculated to -hold at least the additional requested space. - -`lisp_new()` allocates `FLISP_MIN_MEMORY`, defined in `lisp.h`, and then -allocates all initial objects without taking care of garbage collection. -Then it prints out the amount of Lisp object space consumed to the debug -file descriptor. For *fLisp* this is currently about 21 kB, for *femto* -about 34 kB. - -In order to reduce garbage collection frequency, especially during -startup, one can set `FLISP_INITIAL_MEMORY` to a desired additional -amount of memory to allocate on startup. - -Some other compile time adjustable limits in `lisp.h`: - -Input buffer -2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for -`lisp_eval()` and for the input buffer of `(fgets)`. - -Output buffer -2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting -buffer. - -*fLisp* can live with as little as 50k object memory up to startup. The -Femto editor requires much more memory because of the needs of the “OXO” -game. - -#### Future Directions - -Loops are availble via the labelled let macro and supported by `iota`. -It could made easier, by any combination of: - -- loop/while/for macro -- Demoing hand crafted loops including breaking with throw. - -Implement backquote and friends. - -Pluggable extensions. - -Take away more things. diff --git a/pdoc/develop.html b/pdoc/develop.html new file mode 100644 index 0000000..6077e64 --- /dev/null +++ b/pdoc/develop.html @@ -0,0 +1,311 @@ + + + + fLisp Embedding and Development + + + + + + + +

      fLisp Implementation Details

      + + fLisp Manual (Markdown) + +

      Table of Contents

      +
        +
      1. Embedding Overview
        2. +
      2. fLisp C Interface
        3. +
      3. Building Extensions
        4. +
      +
    3. Implementation Details +
        +
      1. Garbage Collection
        2. +
      2. Memory Usage
        3. +
      3. Future Directions
        4. +
      +
    + +

    Embedding fLisp

    +

    Embedding Overview

    + +

    + fLisp can be embedded into a C application. Two examples of embedding are the femto editor and the + simplistic flisp command line Lisp interpreter. +

    +

    + Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions + are stored in separated C files and the interface code is conditionally included into the lisp.c + file. Three extensions are provided: the Femto extension which provides the editor functionality, the file + extension which provides access to the low level stream I/O functions and others and the double extensions which + provides double float arithmetic. +

    + fLisp exposes the following public interface functions: +

    +
    +
    lisp_new()
    Create a new interpreter.
    +
    lisp_destroy()
    Destroy an interpreter, releasing resources.
    +
    lisp_eval()
    Evaluate a string or the input stream until exhausted or error.
    +
    lisp_write_object()
    Format and write object to file descriptor.
    +
    lisp_write_error()
    +
    Format and write the error object and error message of an interpreter to a file descriptor.
    +
    +

    + Different flows of operation can be implemented. The femto editor initializes the interpreter without + input/output file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed + or upon explicit request via the editor interface. +

    +

    + The flisp command line interpreter sets stdout as the default output file descriptors of + the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is + not a terminal stdin is set as the default input file descriptor and fLisp reads through it + until end of file. +

    +

    + After processing the input, the interpreter holds the results corresponding to + a catch result in its internal structure. They can be accessed with the + following C-macros: +

    +
    +
    error_type
    +
    FLISP_RESULT_CODE(interpreter)
    +
    message
    +
    FLISP_RESULT_MESSAGE(interpreter)
    +
    object
    +
    FLISP_RESULT_OBJECT(interpreter)
    +
    +

    + Check for (FLISP_RESULT_OBJECT(interpreter) != nil) to find out if the result is an error. Then check + for (FLISP_RESULT_OBJECT(interpreter) == out_of_memory) to see if a fatal condition occured. +

    +

    + On error use lisp_write_error() to write the standard error message to a file descriptor of choice, + or use the above C-macros and FLISP_ERROR_MESSAGE(interpreter)->string for executing a specific + action. +

    +

    + fLisp sends all output to the default output stream. If it is set to NULL on initialization, + output is suppressed altogether. +

    + +

    fLisp C Interface

    +
    +
    Interpreter *lisp_new(char **argv, char *library_path, FILE *input, + FILE *output, FILE* debug)
    +
    +

    + lisp_new() creates and initializes an fLisp interpreter and returns a pointer to + an Interpreter struct to be used in the other functions. The arguments to lisp_new() + are: +

    +
    +
    +
    argv
    +
    library_path
    +
    + The fLisp environment is initialized with this two argument to contain the following symbols: +
    +
    argv0
    The string stored in *argv[0], if any
    +
    argv
    The list of strings stored in argv
    +
    script_dir
    The string stored in library_path
    +
    +
    +
    input
    +
    + Default input stream. If input is set to NULL, the input stream has to be + specified for each invocation of lisp_eval(). +
    +
    output
    +
    + Default output stream. If output is set to NULL a memory stream is created at the + first invocation of the interpreter and set as the default output stream. +
    debug
    +
    Debug output stream. If set to NULL no debug information is generated.
    +
    +
    + +
    void lisp_destroy(Interpreter *interp)
    +
    Frees all resources used by the interpreter.
    + +
    + void lisp_eval(Interpreter *interp, char *string)
    +
    + If string is not NULL evaluates all Lisp expressions in string. +
    +
    + If string is NULL input from the file descriptor in the input field of + the fLisp interpreter interp is evaluated until end of file. +
    + +
    + If no memory can be allocated for the input string or the input file descriptor is NULL no Lisp + evaluation takes place and FLISP_RESULT_CODE field of the interpreter is set to an io-error. +
    +
    + void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, + bool readably) +
    +
    + Format object into a string and write it to stream. If readably is true, the + string can be read in by the interpreter and results in the same object. +
    +
    void lisp_write_error(Interpreter *interp, FILE *fd)
    +
    + Format the error object and the error message of the interpreter into a string and write it + to fd. The object is written with readably true. +
    +
    + +

    Note: currently only creating one interpreter has been tested.

    + +

    Building Extensions

    + +

    + An extensions has to create C functions with the + signature: Object *primitive(Interpreter *interp, Object **args, Object **env), + where primitive is a distinct name in C space. This function has to be added to the global + variable primitives in the following + format: {"name", argMin, argMax, type_check, primitive}. Here + name is a distinct name in Lisp space. +

    +

    + interp is the fLisp interpreter in which primitive is executed. + argMin is the minimum number of arguments, argMax is the maximum number of arguments allowed + for the function. If argMax is a negative number, arguments must be given in tuples + of argMax and the number of tuples is not restricted. +

    +

    + When type check is set to on of the TYPE_* C-macros the interpreter assures that all arguments are of + the given type and creates a standardized exception otherwise. When type check is set to 0 the + primitive has to take care of type checking by itself. The C-macro CHECK_TYPE helps with this. +

    +

    + When creating more then one new objects within a primitive, care has to be taken to register them with the garbage + collector. Registration is started with the + GC_CHECKPOINT CPP macro. GC_TRACE(name, value creates an object + variable name, sets it to value and registers it with the garbage collector. The + macro GC_RELEASE must be called to finalize the registration. The convenience + macro GC_RETURN(object) calls GC_RELEASE and returns object. +

    +

    + Some CPP macros are provided to simplify argument access and validation in primitives: +

    +
    +
    FLISP_HAS_ARGS
    +
    FLISP_HAS_ARG_TWO
    +
    FLISP_HAS_ARG_THREE
    +
    Evaluate to true if there are arguments or the respective argument is available.
    +
    FLISP_ARG_ONE
    +
    FLISP_ARG_TWO
    +
    FLISP_ARG_THREE
    +
    Evaluate to the respective argument.
    +
    CHECK_TYPE(argument, type, signature)
    +
    + Assures that the given argument is of the given type. type must be a type variable + like type_string. signature is the signature of the primitive followed + by  -  and the name of the argument to be type checked. This is used to form a + standardized wrong-type-argument error message. +
    +
    + +

    Implementation Details

    + +

    Garbage Collection

    +

    + fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal + halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used + during garbage collection. The from-space part of the memory is also called the Lisp object space. +

    +

    + When garbage collection is performed, objects that are still in use (live) are copied from from-space to + to-space. To-space then becomes the new from-space and vice versa, thereby discarding all objects that have not + been copied. +

    +

    + Our garbage collector takes as input a list of root objects. Objects that can be reached by recursively traversing + this list are considered live and will be moved to to-space. When we move an object, we must also update its + pointer within the list to point to the objects new location in memory. +

    +

    + However, this implies that our interpreter cannot use raw pointers to objects in any function that might trigger + garbage collection (or risk causing a SEGV when accessing an object that has been moved). Instead, objects must be + added to the list and then only accessed through the pointer inside the list. +

    +

    + Thus, whenever we would have used a raw pointer to an object, we use a pointer to the pointer inside the list + instead: +

    + 
    +      function:              pointer to pointer inside list (Object **)
+      |
+      v
+      list of root objects:  pointer to object (Object *)
+      |
+      v
+      semi space:             object in memory
+
    +

    + GC_TRACE adds an object to the list and declares a variable which points to the objects + pointer inside the list. +

    +

    + GC_TRACE(gcX, X): add object X to the list and + declare Object **gcX to point to the pointer to X inside the list. +

    +

    + Information about the garbage collection process and memory status is written to the debug file descriptor. +

    +

    Memory Allocation

    +

    + Object allocation adjusts the size of the Lisp object space on demand: If after garbage collection the free space + is less then the required memory plus some reserved space for exception reporting, the memory is increased by a + multiple of the amount specified in the C-macro FLISP_MEMORY_INC, defined in lisp.h. The + multiple is calculated to hold at least the additional requested space. +

    + lisp_new() allocates FLISP_MIN_MEMORY, defined in lisp.h, and then + allocates all initial objects without taking care of garbage collection. Then it prints out the amount of Lisp + object space consumed to the debug file descriptor. For fLisp this is currently about 21 kB, + for femto about 34 kB. +

    +

    + In order to reduce garbage collection frequency, especially during startup, one can + set FLISP_INITIAL_MEMORY to a desired additional amount of memory to allocate on startup. +

    + Some other compile time adjustable limits in lisp.h: +

    +
    +
    Input buffer
    +
    + 2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval() and for the + input buffer of (fgets). +
    +
    Output buffer
    2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.
    +
    +

    + fLisp can live with as little as 50k object memory up to startup. The Femto editor requires much more + memory because of the needs of the OXO game. +

    + +

    Future Directions

    +

    + Loops are availble via the labelled let macro and supported by iota. It could made easier, by any + combination of: +

    +
      +
    • loop/while/for macro
      • +
    • Demoing hand crafted loops including breaking with throw.
      • +
    +

    Implement backquote and friends.

    +

    Pluggable extensions.

    +

    Take away more things.

    + + + + + diff --git a/pdoc/flisp.html b/pdoc/flisp.html index d88013c..eaeb2b6 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -97,20 +97,11 @@

    Table of Contents

  • Programming and System Interaction
    • -
  • Embedding fLisp
    • -
      -
    1. Embedding Overview
      2. -
    2. fLisp C Interface
      3. -
    3. Building Extensions
      4. -
    -
  • Implementation Details (Markdown)
    • -
      -
    1. Garbage Collection
      2. -
    2. Memory Usage
      3. -
    3. Future Directions
      4. -
    +
  • + fLisp Embedding and Development (Markdown) +
    • - +

    Notation Convention

    We use the following notation rule to describe the fLisp syntax:

    @@ -1237,279 +1228,7 @@
    Programming and System Interaction
    -

    Embedding fLisp

    -

    Embedding Overview

    -

    - fLisp can be embedded into a C application. Two examples of embedding are the femto editor and the - simplistic flisp command line Lisp interpreter. -

    -

    - Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions - are stored in separated C files and the interface code is conditionally included into the lisp.c - file. Three extensions are provided: the Femto extension which provides the editor functionality, the file - extension which provides access to the low level stream I/O functions and others and the double extensions which - provides double float arithmetic. -

    - fLisp exposes the following public interface functions: -

    -
    -
    lisp_new()
    Create a new interpreter.
    -
    lisp_destroy()
    Destroy an interpreter, releasing resources.
    -
    lisp_eval()
    Evaluate a string or the input stream until exhausted or error.
    -
    lisp_write_object()
    Format and write object to file descriptor.
    -
    lisp_write_error()
    -
    Format and write the error object and error message of an interpreter to a file descriptor.
    -
    -

    - Different flows of operation can be implemented. The femto editor initializes the interpreter without - input/output file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed - or upon explicit request via the editor interface. -

    -

    - The flisp command line interpreter sets stdout as the default output file descriptors of - the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is - not a terminal stdin is set as the default input file descriptor and fLisp reads through it - until end of file. -

    -

    - After processing the input, the interpreter holds the results corresponding to - a catch result in its internal structure. They can be accessed with the - following C-macros: -

    -
    -
    error_type
    -
    FLISP_RESULT_CODE(interpreter)
    -
    message
    -
    FLISP_RESULT_MESSAGE(interpreter)
    -
    object
    -
    FLISP_RESULT_OBJECT(interpreter)
    -
    -

    - Check for (FLISP_RESULT_OBJECT(interpreter) != nil) to find out if the result is an error. Then check - for (FLISP_RESULT_OBJECT(interpreter) == out_of_memory) to see if a fatal condition occured. -

    -

    - On error use lisp_write_error() to write the standard error message to a file descriptor of choice, - or use the above C-macros and FLISP_ERROR_MESSAGE(interpreter)->string for executing a specific - action. -

    -

    - fLisp sends all output to the default output stream. If it is set to NULL on initialization, - output is suppressed altogether. -

    - -

    fLisp C Interface

    -
    -
    Interpreter *lisp_new(char **argv, char *library_path, FILE *input, - FILE *output, FILE* debug)
    -
    -

    - lisp_new() creates and initializes an fLisp interpreter and returns a pointer to - an Interpreter struct to be used in the other functions. The arguments to lisp_new() - are: -

    -
    -
    -
    argv
    -
    library_path
    -
    - The fLisp environment is initialized with this two argument to contain the following symbols: -
    -
    argv0
    The string stored in *argv[0], if any
    -
    argv
    The list of strings stored in argv
    -
    script_dir
    The string stored in library_path
    -
    -
    -
    input
    -
    - Default input stream. If input is set to NULL, the input stream has to be - specified for each invocation of lisp_eval(). -
    -
    output
    -
    - Default output stream. If output is set to NULL a memory stream is created at the - first invocation of the interpreter and set as the default output stream. -
    debug
    -
    Debug output stream. If set to NULL no debug information is generated.
    -
    -
    - -
    void lisp_destroy(Interpreter *interp)
    -
    Frees all resources used by the interpreter.
    - -
    - void lisp_eval(Interpreter *interp, char *string)
    -
    - If string is not NULL evaluates all Lisp expressions in string. -
    -
    - If string is NULL input from the file descriptor in the input field of - the fLisp interpreter interp is evaluated until end of file. -
    - -
    - If no memory can be allocated for the input string or the input file descriptor is NULL no Lisp - evaluation takes place and FLISP_RESULT_CODE field of the interpreter is set to an io-error. -
    -
    - void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, - bool readably) -
    -
    - Format object into a string and write it to stream. If readably is true, the - string can be read in by the interpreter and results in the same object. -
    -
    void lisp_write_error(Interpreter *interp, FILE *fd)
    -
    - Format the error object and the error message of the interpreter into a string and write it - to fd. The object is written with readably true. -
    -
    - -

    Note: currently only creating one interpreter has been tested.

    - -

    Building Extensions

    - -

    - An extensions has to create C functions with the - signature: Object *primitive(Interpreter *interp, Object **args, Object **env), - where primitive is a distinct name in C space. This function has to be added to the global - variable primitives in the following - format: {"name", argMin, argMax, type_check, primitive}. Here - name is a distinct name in Lisp space. -

    -

    - interp is the fLisp interpreter in which primitive is executed. - argMin is the minimum number of arguments, argMax is the maximum number of arguments allowed - for the function. If argMax is a negative number, arguments must be given in tuples - of argMax and the number of tuples is not restricted. -

    -

    - When type check is set to on of the TYPE_* C-macros the interpreter assures that all arguments are of - the given type and creates a standardized exception otherwise. When type check is set to 0 the - primitive has to take care of type checking by itself. The C-macro CHECK_TYPE helps with this. -

    -

    - When creating more then one new objects within a primitive, care has to be taken to register them with the garbage - collector. Registration is started with the - GC_CHECKPOINT CPP macro. GC_TRACE(name, value creates an object - variable name, sets it to value and registers it with the garbage collector. The - macro GC_RELEASE must be called to finalize the registration. The convenience - macro GC_RETURN(object) calls GC_RELEASE and returns object. -

    -

    - Some CPP macros are provided to simplify argument access and validation in primitives: -

    -
    -
    FLISP_HAS_ARGS
    -
    FLISP_HAS_ARG_TWO
    -
    FLISP_HAS_ARG_THREE
    -
    Evaluate to true if there are arguments or the respective argument is available.
    -
    FLISP_ARG_ONE
    -
    FLISP_ARG_TWO
    -
    FLISP_ARG_THREE
    -
    Evaluate to the respective argument.
    -
    CHECK_TYPE(argument, type, signature)
    -
    - Assures that the given argument is of the given type. type must be a type variable - like type_string. signature is the signature of the primitive followed - by  -  and the name of the argument to be type checked. This is used to form a - standardized wrong-type-argument error message. -
    -
    - - -

    Implementation Details

    - -

    Garbage Collection

    -

    - fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal - halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used - during garbage collection. The from-space part of the memory is also called the Lisp object space. -

    -

    - When garbage collection is performed, objects that are still in use (live) are copied from from-space to - to-space. To-space then becomes the new from-space and vice versa, thereby discarding all objects that have not - been copied. -

    -

    - Our garbage collector takes as input a list of root objects. Objects that can be reached by recursively traversing - this list are considered live and will be moved to to-space. When we move an object, we must also update its - pointer within the list to point to the objects new location in memory. -

    -

    - However, this implies that our interpreter cannot use raw pointers to objects in any function that might trigger - garbage collection (or risk causing a SEGV when accessing an object that has been moved). Instead, objects must be - added to the list and then only accessed through the pointer inside the list. -

    -

    - Thus, whenever we would have used a raw pointer to an object, we use a pointer to the pointer inside the list - instead: -

    - 
    -      function:              pointer to pointer inside list (Object **)
-      |
-      v
-      list of root objects:  pointer to object (Object *)
-      |
-      v
-      semi space:             object in memory
-
    -

    - GC_TRACE adds an object to the list and declares a variable which points to the objects - pointer inside the list. -

    -

    - GC_TRACE(gcX, X): add object X to the list and - declare Object **gcX to point to the pointer to X inside the list. -

    -

    - Information about the garbage collection process and memory status is written to the debug file descriptor. -

    -

    Memory Allocation

    -

    - Object allocation adjusts the size of the Lisp object space on demand: If after garbage collection the free space - is less then the required memory plus some reserved space for exception reporting, the memory is increased by a - multiple of the amount specified in the C-macro FLISP_MEMORY_INC, defined in lisp.h. The - multiple is calculated to hold at least the additional requested space. -

    - lisp_new() allocates FLISP_MIN_MEMORY, defined in lisp.h, and then - allocates all initial objects without taking care of garbage collection. Then it prints out the amount of Lisp - object space consumed to the debug file descriptor. For fLisp this is currently about 21 kB, - for femto about 34 kB. -

    -

    - In order to reduce garbage collection frequency, especially during startup, one can - set FLISP_INITIAL_MEMORY to a desired additional amount of memory to allocate on startup. -

    - Some other compile time adjustable limits in lisp.h: -

    -
    -
    Input buffer
    -
    - 2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval() and for the - input buffer of (fgets). -
    -
    Output buffer
    2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.
    -
    -

    - fLisp can live with as little as 50k object memory up to startup. The Femto editor requires much more - memory because of the needs of the OXO game. -

    - -

    Future Directions

    -

    - Loops are availble via the labelled let macro and supported by iota. It could made easier, by any - combination of: -

    -
      -
    • loop/while/for macro
      • -
    • Demoing hand crafted loops including breaking with throw.
      • -
    -

    Implement backquote and friends.

    -

    Pluggable extensions.

    -

    Take away more things.

    diff --git a/pdoc/flisp.html b/pdoc/flisp.html index eaeb2b6..e289442 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -21,20 +21,19 @@

    Introduction

    — Antoine de Saint-Exupery

    - fLisp is a tiny yet practical interpreter for a dialect of the Lisp programming language. It is used as - extension language for the Femto text editor. + fLisp is a tiny yet practical interpreter for a dialect of the Lisp programming language. It can be + embedded into other applications and is extensible via C libraries. fLisp is used as extension language for + the Femto text editor, see the editor extension + manual (Markdown) for details.

    - fLisp is hosted in the Femto Github repository, it is + fLisp is hosted in the Femto Github repository and released to the public domain.

    fLisp is a Lisp-1 interpreter with Scheme like lexical scoping, tailcall optimization and other Scheme - influences. -

    -

    - fLisp originates from Tiny-Lisp by matp (pre 2014), was - integrated into Femto by Hugh Barney (pre 2016) and compacted by - Georg Lehner in 2023. + influences. fLisp originates from Tiny-Lisp by matp (pre + 2014), was integrated into Femto by Hugh Barney (pre 2016) and + extended by Georg Lehner since 2023.

    This is a reference manual. If you want to learn about Lisp programming use other resources eg.

      @@ -70,36 +69,18 @@

      Table of Contents

    • Bitwise Integer Operations
    • String Operations
      • -
    • File Extension
      • -
    • Double Extension
      • +
    • Extensions
      • +
        +
      1. File Extension
        2. +
      2. Double Extension
        3. +
    • Lisp Libraries
      1. Library Loading
      2. Core Library
      3. fLlisp Library
        4. -
      4. Standard Library
        5. -
      5. Femto Library
      -
    • Editor Extension
      • -
        -
      1. Buffers
        2. -
          -
        1. Text manipulation
          2. -
        2. Selection
          3. -
        3. Cursor Movement
          4. -
        4. Buffer management
          5. -
        -
      2. User Interaction
        3. -
          -
        1. Window Handling"
          2. -
        2. Message Line
          3. -
        3. Keyboard Handling
          4. -
        4. Programming and System Interaction
          5. -
        -
      -
    • - fLisp Embedding and Development (Markdown) -
      • +
    • fLisp Embedding and Development (Markdown)

      • Notation Convention

      @@ -121,13 +102,13 @@

      Notation Convention

      syntactical elements.

      - Variables names convey the following context: + Variable names convey the following context:

      Lisp object of any type:
      object value o a b c
      Program elements:
      -
      arg args params opt body expr pred
      +
      arg args params opt body expr pred p
      Integer:
      i j k
      Double:
      @@ -648,7 +629,7 @@

      Library Loading

      path conveniently and without repetition. The command to load the file example.lsp from the library is (require 'example).

      -

      Femto provides the following set of libraries:

      +

      fLisp provides the following set of libraries:

      core
      @@ -660,11 +641,13 @@

      Library Loading

      Implements expected standard Lisp functions and additions expected by femto and flisp.
      string
      String manipulation library.
      -
      femto
      femto editor specific functions.
      -
      bufmenu, defmacro, dired, info
      femto editor utilities
      -
      git, grep, oxo
      femto editor modules
      +

      + The Femto specific libraries are described together with + the editor (Markdown) extension. +

      +

      Core Library

      (list [element ..]) C
      @@ -903,330 +886,6 @@

      fLisp Library

      (equal o1 o2)
      Return nil if o1 and o2 are not isomorphic.
      -

      Femto Library

      -

      - This library implements helper function required by the Femto editor. It is written only in Lisp idioms provided - by fLisp itself plus the fLisp Library. -

      - - -

      Editor Extension

      - -

      The editor extensions introduces several types of objects/functionality:

      -
        -
      • Buffers hold text
        • -
      • Windows display buffer contents to the user
        • -
      • Keyboard Input allows the user to interact with buffers and windows
        • -
      • The Message Line gives feedback to the user
        • -
      • Several other function for operating system or user interaction
        • -
      - -

      Buffers

      - -

      - This section describes the buffer related functions added by Femto to fLisp. The description is separated in - function related to buffer management and text manipulation. Text manipulation always operates on - the current buffer. Buffer management creates, deletes buffers, or selects one of the existing buffers - as the current buffer. -

      - -

      Buffers store text and allow to manipulate it. A buffer has the following properties:

      -
      -
      name
      -
      - Buffers are identified by their name. If a buffer name is enclosed in *asterisks* the - buffer receives special treatment. -
      -
      text
      -
      zero or more characters.
      -
      point
      -
      - The position in the text where text manipulation takes place. The first position in the text is 0. Note: - in Emacs the first position is 1. -
      -
      mark
      -
      - An optional second position in the text. If the mark is set, the text between point - and mark is called the selection or region. -
      -
      filename
      -
      If set the buffer is associated with the respective file.
      -
      flags
      -
      - Different flags determine the behavior of the buffer. Editor specific - flags: special, modified. -
      -
      Mode flags determine the syntax highlighter mode: cmode and lispmode are - available. If none is set text mode is used for syntax hightlighting.
      -
      - -

      In the following, any mention to one of them refers to the respective current buffers property.

      - -
      Text manipulation
      - -
      -
      (insert-string string)
      -
      Inserts string before point. S: insert.
      -
      (insert-file-contents-literally string [flag])
      -
      - Inserts the file string after point. If flag is not nil the buffer is marked as not - modified. B -
      -
      -

      - Note: Currently the flag is forced to nil. The function should - return (filename count) but it returns a flag indicating if the operation - succeeded. -

      -
      -
      (erase-buffer)
      -
      Erases all text in the current buffer. C
      -
      (delete)
      -
      Deletes the character after point. S: delete-char
      -
      (backspace)
      -
      Deletes the character to the left of point. S: delete-backward-char
      -
      (get-char)
      -
      Returns the character at point. S: get-byte
      -
      (copy-region)
      -
      Copies region to the clipboard. S: copy-region-as-kill
      -
      (kill-region)
      -
      Deletes the text in the region and copies it to the clipboard. D
      -
      (yank)
      -
      Pastes the clipboard before point. C
      -
      - -
      Selection
      - -
      -
      (set-mark)
      -
      Sets mark to point. D
      -
      (get-mark)
      -
      Returns the position of mark, -1 if mark is unset. S: mark
      -
      (get-point)
      -
      Returns the position of point. S: point
      -
      (get-point-max)
      -
      Returns the maximum accessible value of point in the current buffer. S: point-max
      -
      (set-clipboard variable)
      -
      Sets clipboard to the contents of variable. S: gui-set-selection
      -
      (get-clipboard)
      -
      Returns the clipboard contents. S: gui-get-selection
      -
      - -
      Cursor Movement
      - -
      -
      (set-point number)
      -
      Sets the point to in the current buffer to the position number. S: goto-char
      -
      (goto-line number)
      -
      - Sets the point in the current buffer to the first character on line number. S: goto-line, not - an Elisp function. -
      -
      (search-forward string)
      -
      - Searches for string in the current buffer, starting from point forward. If string is found, sets the - point after the first occurrence of string and returns t, otherwise leaves point alone - and returns nil. D -
      -
      (search-backward string)
      -
      - Searches for string in the current buffer, starting from point backwards. If string is found, sets - the point before the first occurrence of string and returns t, otherwise leaves point - alone and returns nil. D -
      -
      (beginning-of-buffer)
      -
      - Sets the point in the current buffer to the first buffer position, leaving mark in its current - position. C -
      -
      (end-of-buffer)
      -
      - Sets the point in the current buffer to the last buffer position, leaving mark in its current position. C -
      -
      (beginning-of-line)
      -
      - Sets point before the first character of the current line, leaving mark in its current position. S: - move-beginning-of-line -
      -
      (end-of-line)
      -
      - Sets point after the last character of the current line, i.e. before the end-of-line character sequence, leaving - mark in its current position. S: move-end-of-line -
      -
      (forward-word)
      -
      - Moves the point in the current buffer forward before the first char of the next word. If there is no word left - the point is set to the end of the buffer. If the point is already at the start or within a word, the current - word is skipped. D: Note: Elisp moves to the end of the the next word. -
      -
      (backward-word)
      -
      - Moves the point in the current buffer backward after the last char of the previous word. If there is no word - left the point is set to the beginning of the buffer. If the point is already at the end or within a word, the - current word is skipped. D: Note: Elisp moves to the beginning of the previous word. -
      -
      (forward-char)
      -
      Moves the point in the current buffer one character forward, but not past the end of the buffer. C
      -
      (backward-char)
      -
      - Moves the point in the current buffer one character backward, but not before the end of the - buffer. C -
      -
      (forward-page)
      -
      - Moves the point of the current buffer to the beginning of the last visible line of the associated screen and - scrolls the screen up to show it as the first line. S: scroll-up -
      -
      (backward-page)
      -
      - Moves the point of the current buffer to the beginning of the first visible line of the associated screen and - scrolls the screen down to show it as the last line. S: scroll-down -
      -
      (next-line)
      -
      - Moves the point in the current buffer to the same character position in the next line, or to the end of the next - line if there are not enough characters. In the last line of the buffer moves the point to the end of the - buffer. C -
      -
      (previous-line)
      -
      - Moves the point in the current buffer to the same character position in the previous line, or to the end of the - previous line if there are not enough characters. In the first line of the buffer the point is not - moved. C -
      -
      - -
      Buffer management
      - -
      -
      (list-buffers)
      -
      Lists all the buffers in a buffer called *buffers*.
      -
      (get-buffer-count)
      -
      Returns the number of buffers, includes all special buffers and *buffers*.
      -
      (select-buffer string)
      -
      Makes the buffer named string the current buffer. Note: C to set-buffer in Elisp.
      -
      (rename-buffer string)
      -
      Rename the current buffer to string. C
      -
      (kill-buffer string)
      -
      Kill the buffer names string. Unsaved changes are discarded. C
      -
      (get-buffer-name)
      -
      Return the name of the current buffer. Note: C to buffer-name in Elisp.
      -
      (add-mode-global string)
      -
      Sets global mode string for all buffers. Currently the only global mode is undo.
      -
      (add-mode string)
      -
      Set a flag for the current buffer.
      -
      (delete-mode string)
      -
      Reset a flag for the current buffer.
      -
      (find-file string)
      -
      - Loads file with path string into a new buffer. After - loading (read-hook string) is called. C -
      -
      (save-buffer string)
      -
      Saves the buffer named string to disk. C
      -
      - -

      User Interaction

      - -

      - This section lists function related to window and message line manipulation, keyboard input and system - interaction. -

      - -
      Window Handling
      - -
      -
      (delete-other-windows)
      -
      Make current window the only window. C
      -
      (split-window)
      -
      Splits the current window. Creates a new window for the current buffer. C
      -
      (other-window)
      -
      - Moves the cursor to the next window down on the screen. Makes the buffer in that window the current - buffer. D -
      -
      -

      Note: Elisp other-window has a required parameter count, which specifies the number - of windows to move down or up. -

      -
      -
      (update-display)
      -
      Updates all modified windows.
      -
      (refresh)
      -
      Updates all windows by marking them modified and calling update-display.
      -
      - -
      Message Line
      -
      -
      (message string)
      -
      Displays string in the message line. D
      -
      (clear-message-line)
      -
      Displays the empty string in the message line.
      -
      (prompt prompt default)
      -
      - Displays prompt in the command line and sets default as initial value for the user - response. The user can edit the response. When hitting return, the final response is returned. -
      -
      (show-prompt prompt default)
      -
      - Displays prompt and default in the command line, but does not allow - editing. Returns t. -
      -
      (prompt-filename prompt)
      -
      - Displays prompt in the command line and allows to enter or search for a file name. Returns the - relative path to the selected file name or the response typed by the user. -
      -
      - -
      Keyboard Handling
      - -
      -
      (set-key key-name lisp-func)
      -
      Binds key key-name to the lisp function lisp-func.
      -
      (get-key-name)
      -
      Returns the name of the currently pressed key, eg: c-k for control-k.
      -
      (get-key-funcname)
      -
      Return the name of the function bound to the currently pressed key.
      -
      (execute-key)
      -
      Executes the function of the last bound key. Tbd. bound or pressed?
      -
      (describe-bindings)
      -
      - Creates a listing of all current key bindings, in a buffer named *help* and displays it in a new - window. C -
      -
      (describe-functions)
      -
      - Creates a listing of all functions bound to keys in a buffer named *help* and displays it in a new - window. -
      -
      (getch)
      -
      - Waits for a key to be pressed and returns the key as string. See - also get-key-name, get-key-funcname and execute-key. -
      -
      - -
      Programming and System Interaction
      - -
      -
      (exit)
      -
      Exit Femto without saving modified buffers.
      -
      (eval-block)
      -
      - Evaluates the region in the current buffer, inserts the result at point and returns - it. If mark in the current buffer is before point eval-block evaluates - this region and inserts the result at point. If point is - before mark eval-block does nothing but returning t. -
      -
      (log-message string)
      -
      Logs string to the *messages* buffer.
      -
      (log-debug string)
      -
      Logs string to the file debug.out.
      -
      (get-version-string)
      -
      Returns the complete version string of Femto, including the copyright.
      -
      - From 1d6e9cd80251269e69ec9e8892471fe091b1fd4d Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 12 Sep 2025 23:26:39 +0200 Subject: [PATCH 89/90] Doc: add missing editor.md file --- docs/editor.md | 392 +++++++++++++++++++++++++++++++++++++++++++++++++ makefile | 8 +- 2 files changed, 397 insertions(+), 3 deletions(-) create mode 100644 docs/editor.md diff --git a/docs/editor.md b/docs/editor.md new file mode 100644 index 0000000..03832d1 --- /dev/null +++ b/docs/editor.md @@ -0,0 +1,392 @@ +# fLisp Femto Editor Extension + +[fLisp Manual](flisp.html) [(Markdown)](flisp.md) + +### Overview + +The [editor extension](#primitives) introduces several types of objects: + +- Buffers hold text +- Windows display buffer contents to the user +- Keyboard Input allows the user to interact + with buffers and windows +- The Message Line gives feedback to the user +- Several other function for operating system or user interaction + +Several [Lisp libraries](#libraries) make use of the extensions +primitives to provide advanced functionality. + +### Table of Contents + +1. [Overview](#overview) +2. Table of Contents +3. [Editor Extension](#primitives) + 1. [Buffers](#buffers) + 1. [Text manipulation](#text) + 2. [Selection](#selection) + 3. [Cursor Movement](#cursor) + 4. [Buffer management](#buffer_management) + 2. [User Interaction](#ui) + 1. [Window Handling"](#windows) + 2. [Message Line](#message_line) + 3. [Keyboard Handling](#keyboard) + 4. [Programming and System Interaction](#programming_system) +4. [Lisp Libraries](#libraries) + 1. [`femto`](#femto_lib) + 2. [`bufmenu`](#bufmenu) Buffer Selection Menu + 3. [`defmacro`](#defmacro) Editor Macros + 4. [`dired`](#dired) Directory Navigation + 5. [`info`](#info) Builtin Help + 6. [`git`](#git) Git Repo Helper + 7. [`grep`](#grep) File Content Search + 8. [`oxo`](#oxo) Tic-Tac-Toe Game + +### Editor Extension + +#### Buffers + +This section describes the buffer related functions added by Femto to +fLisp. The description is separated in function related to buffer +management and text manipulation. Text manipulation always operates on +the current buffer. Buffer management creates, +deletes buffers, or selects one of the existing buffers as the current +buffer. + +Buffers store text and allow to manipulate it. A buffer has the +following properties: + +*name* +Buffers are identified by their name. If a buffer name is enclosed in +`*`asterisks`*` the buffer receives special treatment. + +*text* +zero or more characters. + +*point* +The position in the text where text manipulation takes place. The first +position in the text is 0. Note: in Emacs the first position is 1. + +*mark* +An optional second position in the text. If the *mark* is set, the text +between *point* and *mark* is called the +selection or region. + +*filename* +If set the buffer is associated with the respective file. + +*flags* +Different flags determine the behavior of the buffer. Editor specific +flags: `special`, `modified`. + +Mode flags determine the syntax highlighter mode: `cmode` and `lispmode` +are available. If none is set `text` mode is used for syntax +hightlighting. + +In the following, any mention to one of them refers to the respective +current buffers property. + +##### Text manipulation + +`(insert-string «string»)` +Inserts *string* before *point*. S: insert. + +`(insert-file-contents-literally «string» `\[*flag*\]`)` +Inserts the file *string* after *point*. If *flag* is not nil the buffer +is marked as not modified. B + +Note: Currently the flag is forced to nil. The function should return +`(«filename» «count»)` but it returns a flag indicating if the operation +succeeded. + +`(erase-buffer)` +Erases all text in the current buffer. C + +`(delete)` +Deletes the character after *point*. S: delete-char + +`(backspace)` +Deletes the character to the left of *point*. S: +delete-backward-char + +`(get-char)` +Returns the character at *point*. S: get-byte + +`(copy-region)` +Copies *region* to the *clipboard*. S: copy-region-as-kill + +`(kill-region)` +Deletes the text in the *region* and copies it to the *clipboard*. +D + +`(yank)` +Pastes the *clipboard* before *point*. C + +##### Selection + +`(set-mark)` +Sets *mark* to *point*. D + +`(get-mark)` +Returns the position of *mark*, -1 if *mark* is unset. S: mark + +`(get-point)` +Returns the position of *point*. S: point + +`(get-point-max)` +Returns the maximum accessible value of point in the current buffer. +S: point-max + +`(set-clipboard «variable»)` +`Sets «clipboard» to the contents of «variable».` S: +gui-set-selection + +`(get-clipboard)` +Returns the *clipboard* contents. S: gui-get-selection + +##### Cursor Movement + +`(set-point «number»)` +Sets the point to in the current buffer to the position *number*. S: +goto-char + +`(goto-line «number»)` +Sets the point in the current buffer to the first character on line +*number*. S: goto-line, not an Elisp function. + +`(search-forward «string»)` +Searches for *string* in the current buffer, starting from point +forward. If string is found, sets the point after the first occurrence +of *string* and returns `t`, otherwise leaves point alone and returns +`nil`. D + +`(search-backward «string»)` +Searches for *string* in the current buffer, starting from point +backwards. If string is found, sets the point before the first +occurrence of *string* and returns `t`, otherwise leaves point alone and +returns `nil`. D + +`(beginning-of-buffer)` +Sets the point in the current buffer to the first buffer position, +leaving mark in its current position. C + +`(end-of-buffer)` +Sets the point in the current buffer to the last buffer position, +leaving mark in its current position. C + +`(beginning-of-line)` +Sets point before the first character of the current line, leaving mark +in its current position. S: move-beginning-of-line + +`(end-of-line)` +Sets point after the last character of the current line, i.e. before the +end-of-line character sequence, leaving mark in its current position. +S: move-end-of-line + +`(forward-word)` +Moves the point in the current buffer forward before the first char of +the next word. If there is no word left the point is set to the end of +the buffer. If the point is already at the start or within a word, the +current word is skipped. D: **Note**: Elisp moves to the *end* of +the the next word. + +`(backward-word)` +Moves the point in the current buffer backward after the last char of +the previous word. If there is no word left the point is set to the +beginning of the buffer. If the point is already at the end or within a +word, the current word is skipped. D: **Note**: Elisp moves to +the *beginning* of the previous word. + +`(forward-char)` +Moves the point in the current buffer one character forward, but not +past the end of the buffer. C + +`(backward-char)` +Moves the point in the current buffer one character backward, but not +before the end of the buffer. C + +`(forward-page)` +Moves the point of the current buffer to the beginning of the last +visible line of the associated screen and scrolls the screen up to show +it as the first line. S: scroll-up + +`(backward-page)` +Moves the point of the current buffer to the beginning of the first +visible line of the associated screen and scrolls the screen down to +show it as the last line. S: scroll-down + +`(next-line)` +Moves the point in the current buffer to the same character position in +the next line, or to the end of the next line if there are not enough +characters. In the last line of the buffer moves the point to the end of +the buffer. C + +`(previous-line)` +Moves the point in the current buffer to the same character position in +the previous line, or to the end of the previous line if there are not +enough characters. In the first line of the buffer the point is not +moved. C + +##### Buffer management + +`(list-buffers)` +Lists all the buffers in a buffer called `*buffers*`. + +`(get-buffer-count)` +Returns the number of buffers, includes all special buffers and +`*buffers*`. + +`(select-buffer «string»)` +Makes the buffer named *string* the current buffer. Note: C to +`set-buffer` in Elisp. + +`(rename-buffer «string»)` +Rename the current buffer to *string*. C + +`(kill-buffer «string»)` +Kill the buffer names *string*. Unsaved changes are discarded. C + +`(get-buffer-name)` +Return the name of the current buffer. Note: C to `buffer-name` +in Elisp. + +`(add-mode-global «string»)` +Sets global mode *string* for all buffers. Currently the only global +mode is undo. + +`(add-mode «string»)` +Set a flag for the current buffer. + +`(delete-mode «string»)` +Reset a flag for the current buffer. + +`(find-file «string»)` +Loads file with path *string* into a new buffer. After loading +`(read-hook «string»)` is called. C + +`(save-buffer «string»)` +Saves the buffer named *string* to disk. C + +#### User Interaction + +This section lists function related to window and message line +manipulation, keyboard input and system interaction. + +##### Window Handling + +`(delete-other-windows)` +Make current window the only window. C + +`(split-window)` +Splits the current window. Creates a new window for the current buffer. +C + +`(other-window)` +Moves the cursor to the next window down on the screen. Makes the buffer +in that window the current buffer. D + +Note: Elisp `other-window` has a required parameter *count*, which +specifies the number of windows to move down or up. + +`(update-display)` +Updates all modified windows. + +`(refresh)` +Updates all windows by marking them modified and calling +`update-display`. + +##### Message Line + +`(message «string»)` +Displays *string* in the message line. D + +`(clear-message-line)` +Displays the empty string in the message line. + +`(prompt «prompt» «default»)` +Displays *prompt* in the command line and sets *default* as initial +value for the user response. The user can edit the response. When +hitting return, the final response is returned. + +`(show-prompt «prompt» «default»)` +Displays *prompt* and *default* in the command line, but does not allow +editing. Returns `t`. + +`(prompt-filename «prompt»)` +Displays *prompt* in the command line and allows to enter or search for +a file name. Returns the relative path to the selected file name or the +response typed by the user. + +##### Keyboard Handling + +`(set-key «key-name» «lisp-func»)` +Binds key key-name to the lisp function *lisp-func*. + +`(get-key-name)` +Returns the name of the currently pressed key, eg: `c-k` for control-k. + +`(get-key-funcname)` +Return the name of the function bound to the currently pressed key. + +`(execute-key)` +Executes the function of the last bound key. Tbd. +bound or pressed? + +`(describe-bindings)` +Creates a listing of all current key bindings, in a buffer named +`*help*` and displays it in a new window. C + +`(describe-functions)` +Creates a listing of all functions bound to keys in a buffer named +`*help*` and displays it in a new window. + +`(getch)` +Waits for a key to be pressed and returns the key as string. See also +`get-key-name`, `get-key-funcname` and `execute-key`. + +##### Programming and System Interaction + +`(exit)` +Exit Femto without saving modified buffers. + +`(eval-block)` +Evaluates the *region* in the current buffer, inserts the result at +*point* and returns it. If *mark* in the current buffer is before +*point* `eval-block` evaluates this *region* and inserts the result at +*point*. If *point* is before *mark* `eval-block` does nothing but +returning `t`. + +`(log-message «string»)` +Logs *string* to the `*messages*` buffer. + +`(log-debug «string»)` +Logs string to the file `debug.out`. + +`(get-version-string)` +Returns the complete version string of Femto, including the copyright. + +### Lisp Libraries + +Tbd.: document the libraries. + +#### `femto` + +*Femto* editor specific functions. + +This library implements helper function required by the Femto editor. It +is written only in *fLisp* primitives and plus the `flisp` Library. + +#### `bufmenu` Buffer Selection Menu + +#### `defmacro` Editor Macros + +#### `dired` Directory Navigation + +#### `info` Builtin Help + +#### `git` Git Repo Helper + +#### `grep` File Content Search + +#### `oxo` Tic-Tac-Toe Game + +[^](#toc) diff --git a/makefile b/makefile index df1a385..ef6d3c6 100644 --- a/makefile +++ b/makefile @@ -44,9 +44,11 @@ FLISPFILES = flisp.rc lisp/flisp.lsp FLISPSOURCES = lisp.c lisp.h double.c double.h file.c file.h DOCFILES = BUGS CHANGE.LOG.md README.md pdoc/flisp.html -MOREDOCS = README.html docs/flisp.md docs/develop.md docs/femto.md - -FLISP_DOCFILES = README.flisp.md docs/flisp.md pdoc/flisp.html docs/develop.md pdoc/develop.html +MOREDOCS = README.html docs/flisp.md docs/develop.md docs/femto.md \ + docs/editor.md +FLISP_DOCFILES = README.flisp.md docs/flisp.md pdoc/flisp.html \ + docs/develop.md pdoc/develop.html docs/editor.md \ + pdoc/editor.html .SUFFIXES: .rc .sht .md .html From 4ef645f52c5a66e01d8379dfeebc4610a750d2e9 Mon Sep 17 00:00:00 2001 From: Georg Lehner Date: Fri, 12 Sep 2025 23:30:34 +0200 Subject: [PATCH 90/90] Update roadmap --- misc/ROADMAP.flisp | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/ROADMAP.flisp b/misc/ROADMAP.flisp index 1d52431..253c9c5 100644 --- a/misc/ROADMAP.flisp +++ b/misc/ROADMAP.flisp @@ -42,6 +42,7 @@ - Make double extensions optional. - Replace string-contains with string-search. - Make file extension optional. + - (file-readable-p filename) in core to replace (fstat) in femto.rc/flisp.rc - Reduce binary operators to 'and' and 'xor' and write needed rest in Lisp. - Event based I/O - Buffered I/O operations throw yield exception if buffers are full (w) /empty