diff options
| author | Bdale Garbee <bdale@gag.com> | 2017-12-21 19:07:13 -0700 |
|---|---|---|
| committer | Bdale Garbee <bdale@gag.com> | 2017-12-21 19:07:13 -0700 |
| commit | 456c27a7ed26e4edde02aa0a0b8ef4f46f1ea464 (patch) | |
| tree | 7c259a612e315ac439c2d6ac87e08f6c67b68485 | |
| parent | fe2fe0f4b8382d7e0a5eceaeccced28ef004dab8 (diff) | |
| parent | 16a9d8617b2d2092d166a85ada4349601afb0dce (diff) | |
Merge branch 'branch-1.8' into debian
95 files changed, 3208 insertions, 1753 deletions
@@ -1,3 +1,435 @@ +commit dbb78c8222c45f4430601deee0194b0c9dc2e79a +Merge: fe38c225 87aab995 +Author: Bdale Garbee <bdale@gag.com> +Date: Thu Dec 21 19:05:46 2017 -0700 + + Merge branch 'master' into branch-1.8 + +commit 87aab99521dc44d1d29fbb0b7f227f868f074836 +Author: Keith Packard <keithp@keithp.com> +Date: Thu Dec 21 17:37:10 2017 -0800 + + Bump for version 1.8.4 + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 4bcdc106df2c5e8572570e57b4d97121df94799a +Author: Keith Packard <keithp@keithp.com> +Date: Thu Dec 21 17:36:24 2017 -0800 + + Doc updates for version 1.8.4 + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 46304aa257635d14afc4d8567eedba0f93a5742f +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 16:57:33 2017 -0800 + + altos/micropeak: Remove all compiler results + + Not just the current version. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 99299986e194337b05ee81cfb7c4aa1cb9e9a74e +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 16:56:33 2017 -0800 + + altos/attiny: Add ADC implementation + + It's primitive, but might serve to read ADC values. Untested. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 342132a8869d530b6893bb84becf03cb30490600 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 16:21:23 2017 -0800 + + ao-bringup: turnon_easymini was left with dfu_util disabled + + This was presumably changed for some test and left in the wrong + state. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 6d05747941b8e31afb1f8522ac0b8c1ad12aa90f +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 16:19:40 2017 -0800 + + altos/easymini-v2.0: Adapt to final hardware pin assignment changes + + Beeper moved from PB0 to PB1 (Tim3 CH4) + Drogue fire moved from PB6 to PB3 + Bootloader moved from PB1 to PB6 + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 9826845f952abe898f029e31cc0f7080708e2eae +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 13:09:24 2017 -0800 + + altos/lambdakey-v1.0: Add back and/or macros + + With scheme shrinking a bit, there's now space for these useful macros. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit ed1f7b79abc7400a54b35fbf62c9db6855f9129a +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 12:39:20 2017 -0800 + + altos/scheme: Replace per-type indexed stash with poly stash heap + + Instead of having a random set of stash arrays with explicit indices + used by callers, just have a general heap. Less error prone, and less code. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 71fb79492cb955af4bd52e79f1fa69d17e084dbc +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 12:16:24 2017 -0800 + + altos/scheme: Replace memory pool macros with inlines + + AO_SCHEME_IS_CONST -> ao_scheme_is_const_addr + AO_SCHEME_IS_POOL -> ao_scheme_is_pool_addr + + Provides better typechecking and avoids confusion with + ao_scheme_is_const inline (which takes an ao_poly instead of a void *) + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 34f998d147d08e966daad1ab76c40906018d3d8d +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:51:33 2017 -0800 + + altos/scheme: AO_SCHEME_IS_CONS -> ao_scheme_is_cons + + This inline was already defined; just use it. Also, switch some places + to use ao_scheme_is_pair instead as appropriate. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit fa6f4b331db9d37da6767005fd375b696485b46b +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:43:23 2017 -0800 + + altos/scheme: ao_scheme__cons -> ao_scheme_cons + + Fix the double underscore in this name. Ick. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 00390fb09f47654905824af671b966ffca0a38b3 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:40:08 2017 -0800 + + altos/scheme: Don't optimize ao_scheme_make_const + + Performance isn't interesting, and it's nice to have a bare system + ready for debugging. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit ba472dda57e134fe0f0e4a571a6d0c1e5a1ea6eb +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:39:39 2017 -0800 + + altos/scheme: Clean up test CFLAGS + + make it easy to switch between debug and optimized builds. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 53b99e0419cb44c7983e41026bf0430deae58940 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:37:33 2017 -0800 + + altos/scheme: (define (foo . bar)) has a pair, not list as card + + When defining a lambda with varargs, the args are not a list as the + final element is not a pair or nil. Use pair? instead of list? to + detect this form correctly. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit fbe5dc9f215e7014aa8f9d325c1fba939816be03 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:35:09 2017 -0800 + + altos/scheme: apply also needs to not free value list on lambdas + + When apply is invoked on any function, the cons in the argument list + cannot be immediately freed as they have been passed to the + function. That applies to both built-ins as well as lambdas; this + patch removes the special ao_scheme_skip_cons_free global and just + marks the stack in both cases. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 431165e5fa72ba6dffd477de32960745cdec332c +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 19 11:33:36 2017 -0800 + + altos/scheme: Rework display/write code + + Unify output functions and add bool to switch between write and + display mode. Make that only affect strings (as per r⁷rs). + + Use print recursion detection in frame and stack code, eliminating + PRINT flags in type field. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 5628b983497d9d03e10cccee157419210a49cfa9 +Author: Keith Packard <keithp@keithp.com> +Date: Mon Dec 18 02:14:57 2017 -0800 + + altos/scheme: Compile scheme test with -O3 + + This level of optimization caused trouble, so use it all of the time. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 6593570418e087b9f83ed7f90303d4e1e7d20e83 +Author: Keith Packard <keithp@keithp.com> +Date: Mon Dec 18 02:12:04 2017 -0800 + + altos/scheme: Work around gcc 7.2.0 optimization bug in memory manager + + After marking a set of memory chunks, it's possible that all of them + will be packed tight against 'top', in which case none of them will be + moving. In that case, gcc 7.2.0 appears to generate incorrect code + causing the loop to be abandoned, meaning that we don't actually + collect anything at all. + + Add a quick short-circuit test just after the mark phase that skips + the code which wouldn't do anything in this case. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 9f1849e548e35498f88a0b8adbbc4a57c7a39222 +Author: Keith Packard <keithp@keithp.com> +Date: Mon Dec 18 02:11:07 2017 -0800 + + altos/scheme: rearrange debugging defines + + Allow applications to redefine these as desired, add more flexibility + in what the various memory debugging flags can do. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 2def6abebb3d14a29fe0e03bac09b9d74d2d1578 +Author: Keith Packard <keithp@keithp.com> +Date: Mon Dec 18 02:08:23 2017 -0800 + + altos/scheme: abort when we try to print an invalid value + + This can catch a host of interpreter bugs; best to abandon the program + when it happens. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit e1a6b3bf458f311d832aea7eec34935d42f8efed +Author: Keith Packard <keithp@keithp.com> +Date: Sun Dec 17 22:22:50 2017 -0800 + + altos/scheme: Use memory manager mark code to note recursive print + + This flags any object being printed and checks before recursing to + avoid infinite loops. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 9d1131da911f7220ac8b6cb7ba5a0afd3deef657 +Author: Keith Packard <keithp@keithp.com> +Date: Sun Dec 17 22:19:38 2017 -0800 + + altos/scheme: Use AO_SCHEME_IS_CONS in cons memory funcs + + More efficient than ao_scheme_poly_type as it doesn't care about + non-prim types. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit b866b3ca249dce61f8ff16c8d28514d1b80386d7 +Author: Keith Packard <keithp@keithp.com> +Date: Thu Dec 14 23:10:43 2017 -0800 + + ao-bringup/test-chaoskey: Make finding most recent device more reliable + + Use dmesg -t to strip off the timestamp, which avoids having a + variable number of fields for awk to look at. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit a4c9233aa8a2f1b1dca6580d6d6275b48c40f01f +Author: Keith Packard <keithp@keithp.com> +Date: Thu Dec 14 23:09:02 2017 -0800 + + altos/lambdakey-v1.0: shrink scheme code to fit the ROM + + scheme has grown a bit; adapt + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 32f6877288ea6b7eb1cae9a42fbe8e2c5dbb2f08 +Author: Keith Packard <keithp@keithp.com> +Date: Thu Dec 14 23:04:39 2017 -0800 + + altos/scheme: swap BIGINT and STRING types + + This lets BIGINT be a primitive type, allowing it to use all 32 bits + for storage. This does make strings another byte longer, and also + slightly harder to deal with. It's a trade off. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 2e11cae044cd2c053049effd76df9c5adecb84d7 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 18:07:06 2017 -0800 + + altos/scheme: integer? is builtin on all versions + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 0614c653a8ca8c4ccbf59d34296ca4b3e7d9f3a0 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 18:02:17 2017 -0800 + + altos/lambdakey-v1.0: Make stack larger + + scheme doesn't like to run with less than a 1kB stack. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 839a7454686415a52f532d0e4f379061a68d5f1b +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 18:01:21 2017 -0800 + + altos/scheme: inline some mem calls to reduce stack usage. + + Also includes some code to display stack usage during collect calls. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit c490efdf90befdf048ff7d9cbbe26bcc6f942820 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 18:00:12 2017 -0800 + + altos/scheme: Use direct calls from frame to frame_vals mem functions + + Avoids the extra stack depth of the poly versions. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit ca27d467198c556be483961a6ca3b8f97bbe96a6 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 17:59:26 2017 -0800 + + altos/scheme: More compiler warning cleanups + + Make local funcs static. Don't mix decls and code.x + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 4bfce37e7567d9c2a09ea4da8113e7639516ed6e +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 17:54:03 2017 -0800 + + altos/scheme: apply const to places taking const strings. + + Mostly printf and friends. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 28dbe9a04b16f79db255baecbf0cd486c510ef58 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 15:31:27 2017 -0800 + + altos/stm: Align 'data' to 8 bytes, just like textram + + The textram section must be aligned to 8 bytes to keep the linker + happy. However, if that section contains no data, the declaration will + set the __data_start__ value to that alignment, but the data section + itself would start on a 4-byte alignment, potentially 4 bytes lower + than the value indicated by __data_start__. This completely scrambles + initialized memory as the startup code will copy the data segment to + __data_start__, 4 bytes off of the actual data segment start. + + Fix this by forcing the data segment to also be aligned to 8 bytes. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit db352bd0723e8d640bb034bc14e5ad193f0afe1d +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 15:30:45 2017 -0800 + + altos/kernel: Allow ao_cmd to be built without tasking + + Useful for single-threaded applications, like lambdakey + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 09ea349f5b37e257e8ca23ead493ba1694395530 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 15:27:26 2017 -0800 + + altos/lambdakey-v1.0: Get this building again + + The lambdakey can't hold a full implementation of the scheme + interpreter, so use only a subset, removing floats, bigints and + vectors. Also reduce the pre-loaded lisp code as well. + + It's pretty spare at this point; but it does fill the ROM. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit d8c9024f3829dc3f241b16869f165f3ee01764f3 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 15:25:51 2017 -0800 + + altos/scheme: Support scheme subsetting via feature settings + + This provides for the creation of smaller versions of the interpreter, + leaving out options like floating point numbers and vectors. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit a15166c435f65cb36f487ec8e5a4ff558a7e0502 +Author: Keith Packard <keithp@keithp.com> +Date: Tue Dec 12 15:15:41 2017 -0800 + + altos/scheme: Add ao_scheme_vector.c + + Useful to include the code for implementing vectors + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 5cf77306257517a3d1ec8cea85fca34f576a8f22 +Author: Keith Packard <keithp@keithp.com> +Date: Mon Dec 11 22:36:00 2017 -0800 + + doc: Don't 'publish' release notes, don't build pdf release notes + + All we use the release notes for is to include into the main AltOS + page. Also remove the docinfo for these files so that information + isn't duplicated for each set of release notes. + + Signed-off-by: Keith Packard <keithp@keithp.com> + +commit 40236913922e0395780cd7d90354546ecaf279f9 +Author: Bdale Garbee <bdale@gag.com> +Date: Mon Dec 11 22:15:46 2017 -0700 + + update Releasing with changes discovered in 1.8.3 release process + +commit fe38c22595b050435dbacd35f1baae064fb7de75 +Author: Bdale Garbee <bdale@gag.com> +Date: Mon Dec 11 21:38:59 2017 -0700 + + releasing 1.8.3 + commit ea0aa97fb93e669868a6f2c49c5d4b46e7615b1f Merge: 216ea638 9adf8b23 Author: Bdale Garbee <bdale@gag.com> @@ -108,6 +108,7 @@ These are Bdale's notes on how to do a release. src/telegps-v2.0/{*.elf,*.ihx} \ src/telemega-v1.0/{*.elf,*.ihx} \ src/telemega-v2.0/{*.elf,*.ihx} \ + src/telemega-v3.0/{*.elf,*.ihx} \ src/telemetrum-v2.0/{*.elf,*.ihx} \ src/telemini-v3.0/{*.elf,*.ihx} \ ~/altusmetrumllc/Binaries/ @@ -122,6 +123,7 @@ These are Bdale's notes on how to do a release. src/telegps-v2.0/flash-loader/*.elf \ src/telemega-v1.0/flash-loader/*.elf \ src/telemega-v2.0/flash-loader/*.elf \ + src/telemega-v3.0/flash-loader/*.elf \ src/telemetrum-v2.0/flash-loader/*.elf \ src/telemini-v3.0/flash-loader/{*.elf,*.bin} \ ~/altusmetrumllc/Binaries/loaders/ diff --git a/ao-bringup/test-chaoskey b/ao-bringup/test-chaoskey index f64b1f84..26684875 100755 --- a/ao-bringup/test-chaoskey +++ b/ao-bringup/test-chaoskey @@ -12,8 +12,8 @@ case "$#" in serial="--serial $1" ;; 0) - snum=`sudo dmesg | awk '/usb.*Product:/ { ck = index($0, "ChaosKey"); } - /usb.*SerialNumber:/ { if (ck) print $5; }' | tail -1` + snum=`sudo dmesg -t | awk '/usb.*Product:/ { ck = index($0, "ChaosKey"); } + /usb.*SerialNumber:/ { if (ck) print $4; }' | tail -1` case "$snum" in "") diff --git a/ao-bringup/turnon_easymini b/ao-bringup/turnon_easymini index 9b66dc5e..7db72665 100755 --- a/ao-bringup/turnon_easymini +++ b/ao-bringup/turnon_easymini @@ -54,7 +54,7 @@ ALTOS_FILE=~/altusmetrumllc/Binaries/easymini-v2.0-*.elf echo $DFU_UTIL -a 0 -s 0x08000000:leave -D $FLASH_FILE -#$DFU_UTIL -a 0 -s 0x08000000:leave -D $FLASH_FILE || exit 1 +$DFU_UTIL -a 0 -s 0x08000000:leave -D $FLASH_FILE || exit 1 sleep 2 diff --git a/configure.ac b/configure.ac index 02fca439..7f27dfad 100644 --- a/configure.ac +++ b/configure.ac @@ -18,13 +18,13 @@ dnl dnl Process this file with autoconf to create configure. AC_PREREQ(2.57) -AC_INIT([altos], 1.8.3) +AC_INIT([altos], 1.8.4) ANDROID_VERSION=16 AC_CONFIG_SRCDIR([src/kernel/ao.h]) AM_INIT_AUTOMAKE([foreign dist-bzip2]) AM_MAINTAINER_MODE -RELEASE_DATE=2017-12-11 +RELEASE_DATE=2017-12-21 AC_SUBST(RELEASE_DATE) VERSION_DASH=`echo $VERSION | sed 's/\./-/g'` diff --git a/doc/Makefile b/doc/Makefile index feb1de8f..7d33149d 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -3,6 +3,7 @@ # RELNOTES_INC=\ + release-notes-1.8.4.inc \ release-notes-1.8.3.inc \ release-notes-1.8.2.inc \ release-notes-1.8.1.inc \ @@ -186,7 +187,6 @@ SVG=\ telemini-v3.svg \ easymega.svg -RELNOTES_PDF=$(RELNOTES_INC:.inc=.pdf) RELNOTES_HTML=$(RELNOTES_INC:.inc=.html) ONEFILE_TXT_FILES=\ @@ -196,10 +196,13 @@ ONEFILE_TXT_FILES=\ ONEFILE_RAW_FILES=$(ONEFILE_TXT_FILES:.txt=.raw) ONEFILE_PDF_FILES=$(ONEFILE_TXT_FILES:.txt=.pdf) +ONEFILE_HTML_FILES=$(ONEFILE_TXT_FILES:.txt=.html) AM_HTML=am.html -HTML=altusmetrum.html micropeak.html telegps.html easymini.html $(RELNOTES_HTML) $(ONEFILE_HTML_FILES) +PUBLISH_HTML=altusmetrum.html micropeak.html telegps.html easymini.html $(ONEFILE_HTML_FILES) + +HTML=$(PUBLISH_HTML) $(RELNOTES_HTML) HTML_REVHISTORY=\ altusmetrum-revhistory.html \ @@ -207,7 +210,7 @@ HTML_REVHISTORY=\ telegps-revhistory.html \ easymini-revhistory.html -PDF=altusmetrum.pdf micropeak.pdf telegps.pdf easymini.pdf $(RELNOTES_PDF) $(ONEFILE_PDF_FILES) \ +PDF=altusmetrum.pdf micropeak.pdf telegps.pdf easymini.pdf $(ONEFILE_PDF_FILES) \ $(OUTLINE_PDF_FILES) FOP_STYLE=am-fo.xsl @@ -235,6 +238,8 @@ TEMPLATES_XSL=$(TEMPLATES_TMPL:.tmpl=.xsl) PDF_CONFIG_FILES=$(FOP_STYLE) $(COMMON_STYLE) $(FOP_XCONF) $(TEMPLATES_XSL) HTML_CONFIG_FILES=$(HTML_STYLE) $(COMMON_STYLE) $(TEMPLATES_XSL) +PUBLISH_DOC=$(PUBLISH_HTML) $(HTML_REVHISTORY) $(PDF) $(IMAGES) $(STYLESHEET) + DOC=$(HTML) $(HTML_REVHISTORY) $(PDF) $(IMAGES) $(STYLESHEET) .SUFFIXES: .tmpl .xsl .inc .txt .raw .pdf .html @@ -245,12 +250,12 @@ DOC=$(HTML) $(HTML_REVHISTORY) $(PDF) $(IMAGES) $(STYLESHEET) .inc.raw: sed -e 's/^[ ]*//' -e 's/^\\//' $*.inc > $@ -.raw.pdf: +.raw.html: a2x --verbose -a docinfo -f pdf --xsltproc-opts "--stringparam toc.section.depth 2" --xsl-file $(FOP_STYLE) --fop --fop-opts="-c $(FOP_XCONF)" $*.raw a2x --verbose -a docinfo -f xhtml --xsltproc-opts "--stringparam toc.section.depth 2" --xsl-file $(HTML_STYLE) --stylesheet=$(STYLESHEET) $*.raw case $* in release-notes*) ./fix-html $*.html ;; esac -.pdf.html: +.html.pdf: @touch $@ .tmpl.xsl: @@ -278,19 +283,21 @@ telemini-v3-outline.pdf: telemini-v3-outline.txt telemini-v3.svg install: all -publish: $(DOC) $(FONTS) - cp $(DOC) /home/bdale/web/altusmetrum/AltOS/doc/ - mkdir -p /home/bdale/web/altusmetrum/AltOS/doc/fonts/ - cp $(FONTS) /home/bdale/web/altusmetrum/AltOS/doc/fonts/ - (cd /home/bdale/web/altusmetrum ; \ - git add /home/bdale/web/altusmetrum/AltOS/doc/* ; \ - git add /home/bdale/web/altusmetrum/AltOS/doc/fonts/* ; \ +WEB_ROOT=/home/bdale/web/ + +publish: $(PUBLISH_DOC) $(FONTS) + cp $(PUBLISH_DOC) $(WEB_ROOT)/altusmetrum/AltOS/doc/ + mkdir -p $(WEB_ROOT)/altusmetrum/AltOS/doc/fonts/ + cp $(FONTS) $(WEB_ROOT)/altusmetrum/AltOS/doc/fonts/ + (cd $(WEB_ROOT)/altusmetrum ; \ + git add $(WEB_ROOT)/altusmetrum/AltOS/doc/* ; \ + git add $(WEB_ROOT)/altusmetrum/AltOS/doc/fonts/* ; \ echo "update docs" | \ - git commit -F - /home/bdale/web/altusmetrum/AltOS/doc/* /home/bdale/web/altusmetrum/AltOS/doc/fonts/* ; \ + git commit -F - $(WEB_ROOT)/altusmetrum/AltOS/doc/* $(WEB_ROOT)/altusmetrum/AltOS/doc/fonts/* ; \ git push) -publish-keithp: am.html $(DOC) $(FONTS) - scp -p am.html $(DOC) keithp.com:~keithp/public_html/altos +publish-keithp: am.html $(PUBLISH_DOC) $(FONTS) + scp -p am.html $(PUBLISH_DOC) keithp.com:~keithp/public_html/altos scp -p $(FONTS) keithp.com:~keithp/public_html/altos/fonts clean: diff --git a/doc/RELNOTES b/doc/RELNOTES index 8f7d2540..c3980882 100644 --- a/doc/RELNOTES +++ b/doc/RELNOTES @@ -1,7 +1,6 @@ Creating documentation for a new release of AltOS -* Write release notes in release-notes-${version}.inc. Write docinfo - for release notes in release-notes-${version}-docinfo.xml. Add to +* Write release notes in release-notes-${version}.inc. Add to Makefile * Add references to that as appropriate from each of the @@ -30,5 +29,4 @@ Creating documentation for a new release of AltOS telegps-docinfo.xml telemetry-docinfo.xml -* Add release-notes-${version}.inc and - release-notes-${version}-docinfo.xml to git +* Add release-notes-${version}.inc to git diff --git a/doc/altusmetrum-docinfo.xml b/doc/altusmetrum-docinfo.xml index 3b0793b8..235111fc 100644 --- a/doc/altusmetrum-docinfo.xml +++ b/doc/altusmetrum-docinfo.xml @@ -47,6 +47,13 @@ <revhistory> <?dbhtml filename="altusmetrum-revhistory.html"?> <revision> + <revnumber>1.8.4</revnumber> + <date>20 Dec 2017</date> + <revremark> + Support EasyMini v2.0 hardware. + </revremark> + </revision> + <revision> <revnumber>1.8.3</revnumber> <date>11 Dec 2017</date> <revremark> diff --git a/doc/easymini-docinfo.xml b/doc/easymini-docinfo.xml index cf3f27d2..85baba1e 100644 --- a/doc/easymini-docinfo.xml +++ b/doc/easymini-docinfo.xml @@ -39,6 +39,13 @@ <revhistory> <?dbhtml filename="easymini-revhistory.html"?> <revision> + <revnumber>1.8.4</revnumber> + <date>20 Dec 2017</date> + <revremark> + Support EasyMini v2.0 hardware. + </revremark> + </revision> + <revision> <revnumber>1.6.3</revnumber> <date>21 April 2016</date> <revremark> diff --git a/doc/easymini-release-notes.inc b/doc/easymini-release-notes.inc index f4f45fd7..dae928a6 100644 --- a/doc/easymini-release-notes.inc +++ b/doc/easymini-release-notes.inc @@ -1,6 +1,10 @@ [appendix] == Release Notes :leveloffset: 2 + include::release-notes-1.8.4.raw[] + + <<<< + :leveloffset: 2 include::release-notes-1.8.3.raw[] <<<< diff --git a/doc/release-notes-0.7.1-docinfo.xml b/doc/release-notes-0.7.1-docinfo.xml deleted file mode 100644 index 9657f2a6..00000000 --- a/doc/release-notes-0.7.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>29 September 2010</date> -<copyright> - <year>2010</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-0.8-docinfo.xml b/doc/release-notes-0.8-docinfo.xml deleted file mode 100644 index d593da31..00000000 --- a/doc/release-notes-0.8-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>24 November 2010</date> -<copyright> - <year>2010</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-0.9-docinfo.xml b/doc/release-notes-0.9-docinfo.xml deleted file mode 100644 index 605472f2..00000000 --- a/doc/release-notes-0.9-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>18 January 2011</date> -<copyright> - <year>2011</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-0.9.2-docinfo.xml b/doc/release-notes-0.9.2-docinfo.xml deleted file mode 100644 index 40e53634..00000000 --- a/doc/release-notes-0.9.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>19 March 2011</date> -<copyright> - <year>2011</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.0.1-docinfo.xml b/doc/release-notes-1.0.1-docinfo.xml deleted file mode 100644 index 23972104..00000000 --- a/doc/release-notes-1.0.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>24 August 2011</date> -<copyright> - <year>2011</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.1-docinfo.xml b/doc/release-notes-1.1-docinfo.xml deleted file mode 100644 index 93273918..00000000 --- a/doc/release-notes-1.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>13 September 2012</date> -<copyright> - <year>2013</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.1.1-docinfo.xml b/doc/release-notes-1.1.1-docinfo.xml deleted file mode 100644 index 41ea12da..00000000 --- a/doc/release-notes-1.1.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>16 September 2012</date> -<copyright> - <year>2012</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.2-docinfo.xml b/doc/release-notes-1.2-docinfo.xml deleted file mode 100644 index ba2c9d56..00000000 --- a/doc/release-notes-1.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>18 April 2013</date> -<copyright> - <year>2013</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.2.1-docinfo.xml b/doc/release-notes-1.2.1-docinfo.xml deleted file mode 100644 index d0f08b9c..00000000 --- a/doc/release-notes-1.2.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>21 May 2013</date> -<copyright> - <year>2013</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.3-docinfo.xml b/doc/release-notes-1.3-docinfo.xml deleted file mode 100644 index aa569df4..00000000 --- a/doc/release-notes-1.3-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>12 November 2013</date> -<copyright> - <year>2013</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.3.1-docinfo.xml b/doc/release-notes-1.3.1-docinfo.xml deleted file mode 100644 index f67cf3b8..00000000 --- a/doc/release-notes-1.3.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>21 January 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.3.2-docinfo.xml b/doc/release-notes-1.3.2-docinfo.xml deleted file mode 100644 index 82b7677e..00000000 --- a/doc/release-notes-1.3.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>24 January 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.4-docinfo.xml b/doc/release-notes-1.4-docinfo.xml deleted file mode 100644 index 12a38ce5..00000000 --- a/doc/release-notes-1.4-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>15 June 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.4.1-docinfo.xml b/doc/release-notes-1.4.1-docinfo.xml deleted file mode 100644 index 6224b16e..00000000 --- a/doc/release-notes-1.4.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>20 June 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.4.2-docinfo.xml b/doc/release-notes-1.4.2-docinfo.xml deleted file mode 100644 index 8fd94324..00000000 --- a/doc/release-notes-1.4.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>17 August 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.5-docinfo.xml b/doc/release-notes-1.5-docinfo.xml deleted file mode 100644 index 0c0cace7..00000000 --- a/doc/release-notes-1.5-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>6 September 2014</date> -<copyright> - <year>2014</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6-docinfo.xml b/doc/release-notes-1.6-docinfo.xml deleted file mode 100644 index 5ae58bb5..00000000 --- a/doc/release-notes-1.6-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>8 January 2015</date> -<copyright> - <year>2015</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.1-docinfo.xml b/doc/release-notes-1.6.1-docinfo.xml deleted file mode 100644 index dc0a2d67..00000000 --- a/doc/release-notes-1.6.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>15 July 2015</date> -<copyright> - <year>2015</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.2-docinfo.xml b/doc/release-notes-1.6.2-docinfo.xml deleted file mode 100644 index 78206e2a..00000000 --- a/doc/release-notes-1.6.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>10 January 2016</date> -<copyright> - <year>2016</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.3-docinfo.xml b/doc/release-notes-1.6.3-docinfo.xml deleted file mode 100644 index ce22ebcb..00000000 --- a/doc/release-notes-1.6.3-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>6 May 2016</date> -<copyright> - <year>2016</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.4-docinfo.xml b/doc/release-notes-1.6.4-docinfo.xml deleted file mode 100644 index 76af3557..00000000 --- a/doc/release-notes-1.6.4-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>17 June 2016</date> -<copyright> - <year>2016</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.5-docinfo.xml b/doc/release-notes-1.6.5-docinfo.xml deleted file mode 100644 index a07d6f0f..00000000 --- a/doc/release-notes-1.6.5-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>4 July 2016</date> -<copyright> - <year>2016</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.6.8-docinfo.xml b/doc/release-notes-1.6.8-docinfo.xml deleted file mode 100644 index 776c244c..00000000 --- a/doc/release-notes-1.6.8-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>5 September 2016</date> -<copyright> - <year>2016</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.7-docinfo.xml b/doc/release-notes-1.7-docinfo.xml deleted file mode 100644 index 61d77d92..00000000 --- a/doc/release-notes-1.7-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>24 April 2017</date> -<copyright> - <year>2017</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.8-docinfo.xml b/doc/release-notes-1.8-docinfo.xml deleted file mode 100644 index 3b40421a..00000000 --- a/doc/release-notes-1.8-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>12 August 2017</date> -<copyright> - <year>2017</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.8.1-docinfo.xml b/doc/release-notes-1.8.1-docinfo.xml deleted file mode 100644 index 29a4fe7a..00000000 --- a/doc/release-notes-1.8.1-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>28 August 2017</date> -<copyright> - <year>2017</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.8.2-docinfo.xml b/doc/release-notes-1.8.2-docinfo.xml deleted file mode 100644 index a5fbc6e2..00000000 --- a/doc/release-notes-1.8.2-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>18 September 2017</date> -<copyright> - <year>2017</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.8.3-docinfo.xml b/doc/release-notes-1.8.3-docinfo.xml deleted file mode 100644 index e0366586..00000000 --- a/doc/release-notes-1.8.3-docinfo.xml +++ /dev/null @@ -1,29 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<date>11 December 2017</date> -<copyright> - <year>2017</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="altusmetrum-oneline.svg" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes-1.8.4.inc b/doc/release-notes-1.8.4.inc new file mode 100644 index 00000000..f8cb4f11 --- /dev/null +++ b/doc/release-notes-1.8.4.inc @@ -0,0 +1,9 @@ += Release Notes for Version 1.8.4 +:toc!: +:doctype: article + + Version 1.8.4 includes support for EasyMini version 2.0 + + == AltOS + + * Support for EasyMini version 2.0 hardware. diff --git a/doc/release-notes-docinfo.xml b/doc/release-notes-docinfo.xml deleted file mode 100644 index 4f842cde..00000000 --- a/doc/release-notes-docinfo.xml +++ /dev/null @@ -1,28 +0,0 @@ -<author> - <firstname>Bdale</firstname> - <surname>Garbee</surname> - <email>bdale@gag.com</email> -</author> -<author> - <firstname>Keith</firstname> - <surname>Packard</surname> - <email>keithp@keithp.com</email> -</author> -<copyright> - <year>2015</year> - <holder>Bdale Garbee and Keith Packard</holder> -</copyright> -<mediaobject> - <imageobject> - <imagedata fileref="../themes/background.png" width="6.0in"/> - </imageobject> -</mediaobject> -<legalnotice> - <para> - This document is released under the terms of the - <ulink url="http://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons ShareAlike 3.0 - </ulink> - license. - </para> -</legalnotice> diff --git a/doc/release-notes.inc b/doc/release-notes.inc index 1c177afa..50b27ab5 100644 --- a/doc/release-notes.inc +++ b/doc/release-notes.inc @@ -2,6 +2,11 @@ == Release Notes :leveloffset: 2 + include::release-notes-1.8.4.raw[] + + <<<< + + :leveloffset: 2 include::release-notes-1.8.3.raw[] <<<< diff --git a/doc/telegps-release-notes.inc b/doc/telegps-release-notes.inc index 0c506c28..5c5da8f6 100644 --- a/doc/telegps-release-notes.inc +++ b/doc/telegps-release-notes.inc @@ -2,6 +2,11 @@ == Release Notes :leveloffset: 2 + include::release-notes-1.8.4.raw[] + + <<<< + + :leveloffset: 2 include::release-notes-1.8.3.raw[] <<<< diff --git a/src/attiny/ao_adc_attiny.c b/src/attiny/ao_adc_attiny.c new file mode 100644 index 00000000..3a835d13 --- /dev/null +++ b/src/attiny/ao_adc_attiny.c @@ -0,0 +1,48 @@ +/* + * Copyright © 2017 Keith Packard <keithp@keithp.com> + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + */ + +#include <ao.h> + +/* + * ATtiny ADC interface + */ + +uint16_t +ao_adc_read(uint8_t mux) +{ + uint8_t low, high; + + /* Set the mux */ + ADMUX = mux; + + /* Start conversion */ + ADCSRA = ((1 << ADEN) | + (1 << ADSC) | + (0 << ADATE) | + (0 << ADIF) | + (0 << ADIE) | + (0 << ADPS2) | + (0 << ADPS1) | + (0 << ADPS0)); + + /* Await conversion complete */ + while ((ADCSRA & (1 << ADSC)) != 0) + ; + + /* Read low first */ + low = ADCL; + high = ADCH; + + return (((uint16_t) high) << 8) | low; +} diff --git a/src/attiny/ao_arch.h b/src/attiny/ao_arch.h index 3a34f417..68f5702d 100644 --- a/src/attiny/ao_arch.h +++ b/src/attiny/ao_arch.h @@ -85,4 +85,7 @@ ao_eeprom_read(uint16_t addr, void *buf, uint16_t len); void ao_eeprom_write(uint16_t addr, void *buf, uint16_t len); +uint16_t +ao_adc_read(uint8_t mux); + #endif /* _AO_ARCH_H_ */ diff --git a/src/easymini-v2.0/ao_pins.h b/src/easymini-v2.0/ao_pins.h index 2ec0e90b..47eb577e 100644 --- a/src/easymini-v2.0/ao_pins.h +++ b/src/easymini-v2.0/ao_pins.h @@ -60,11 +60,11 @@ #define HAS_IGNITE 1 #define HAS_IGNITE_REPORT 1 -/* Beeper is on Tim3 CH3 */ +/* Beeper is on Tim3 CH4 */ #define BEEPER_TIMER 3 -#define BEEPER_CHANNEL 3 +#define BEEPER_CHANNEL 4 #define BEEPER_PORT (&stm_gpiob) -#define BEEPER_PIN 0 +#define BEEPER_PIN 1 #define BEEPER_AFR STM_AFR_AF1 /* SPI */ @@ -130,8 +130,8 @@ struct ao_adc { #define AO_IGNITER_CLOSED 400 #define AO_IGNITER_OPEN 60 -#define AO_IGNITER_DROGUE_PORT (&stm_gpiob) -#define AO_IGNITER_DROGUE_PIN 6 +#define AO_IGNITER_DROGUE_PORT (&stm_gpioa) +#define AO_IGNITER_DROGUE_PIN 3 #define AO_IGNITER_SET_DROGUE(v) ao_gpio_set(AO_IGNITER_DROGUE_PORT, AO_IGNITER_DROGUE_PIN, AO_IGNITER_DROGUE, v) #define AO_IGNITER_MAIN_PORT (&stm_gpiob) diff --git a/src/easymini-v2.0/flash-loader/ao_pins.h b/src/easymini-v2.0/flash-loader/ao_pins.h index 3098fc22..9cba43e5 100644 --- a/src/easymini-v2.0/flash-loader/ao_pins.h +++ b/src/easymini-v2.0/flash-loader/ao_pins.h @@ -21,11 +21,11 @@ #include <ao_flash_stm_pins.h> -/* pin 5 (PB1) on debug header to gnd for boot mode */ +/* pin 27 (PB6) on debug header to gnd for boot mode */ #define AO_BOOT_PIN 1 #define AO_BOOT_APPLICATION_GPIO stm_gpiob -#define AO_BOOT_APPLICATION_PIN 1 +#define AO_BOOT_APPLICATION_PIN 6 #define AO_BOOT_APPLICATION_VALUE 1 #define AO_BOOT_APPLICATION_MODE AO_EXTI_MODE_PULL_UP diff --git a/src/kernel/ao.h b/src/kernel/ao.h index 139050cf..2bd0e367 100644 --- a/src/kernel/ao.h +++ b/src/kernel/ao.h @@ -218,6 +218,9 @@ ao_cmd_register(const __code struct ao_cmds *cmds); void ao_cmd_init(void); +void +ao_cmd(void); + #if HAS_CMD_FILTER /* * Provided by an external module to filter raw command lines diff --git a/src/kernel/ao_cmd.c b/src/kernel/ao_cmd.c index c1e9cef2..405fd126 100644 --- a/src/kernel/ao_cmd.c +++ b/src/kernel/ao_cmd.c @@ -423,11 +423,13 @@ ao_loader(void) } #endif +#if HAS_TASK __xdata struct ao_task ao_cmd_task; +#endif __code struct ao_cmds ao_base_cmds[] = { { help, "?\0Help" }, -#if HAS_TASK_INFO +#if HAS_TASK_INFO && HAS_TASK { ao_task_info, "T\0Tasks" }, #endif { echo, "E <0 off, 1 on>\0Echo" }, @@ -445,5 +447,7 @@ void ao_cmd_init(void) { ao_cmd_register(&ao_base_cmds[0]); +#if HAS_TASK ao_add_task(&ao_cmd_task, ao_cmd, "cmd"); +#endif } diff --git a/src/kernel/ao_notask.c b/src/kernel/ao_notask.c index 00fe1ed6..7207353a 100644 --- a/src/kernel/ao_notask.c +++ b/src/kernel/ao_notask.c @@ -39,6 +39,21 @@ ao_sleep(__xdata void *wchan) return 0; } +#if HAS_AO_DELAY +void +ao_delay(uint16_t ticks) +{ + AO_TICK_TYPE target; + + if (!ticks) + ticks = 1; + target = ao_tick_count + ticks; + do { + ao_sleep(&ao_time); + } while ((int16_t) (target - ao_tick_count) > 0); +} +#endif + void ao_wakeup(__xdata void *wchan) { diff --git a/src/lambdakey-v1.0/.gitignore b/src/lambdakey-v1.0/.gitignore index 6462d930..a57994e8 100644 --- a/src/lambdakey-v1.0/.gitignore +++ b/src/lambdakey-v1.0/.gitignore @@ -1,2 +1,3 @@ lambdakey-* ao_product.h +ao_scheme_const.h diff --git a/src/lambdakey-v1.0/Makefile b/src/lambdakey-v1.0/Makefile index 4eb045b6..bffe7d4f 100644 --- a/src/lambdakey-v1.0/Makefile +++ b/src/lambdakey-v1.0/Makefile @@ -20,6 +20,7 @@ INC = \ ao_product.h \ ao_task.h \ $(SCHEME_HDRS) \ + ao_scheme_const.h \ stm32f0.h \ Makefile @@ -27,20 +28,16 @@ ALTOS_SRC = \ ao_boot_chain.c \ ao_interrupt.c \ ao_product.c \ - ao_romconfig.c \ ao_cmd.c \ - ao_config.c \ - ao_task.c \ + ao_notask.c \ ao_led.c \ - ao_dma_stm.c \ ao_stdio.c \ - ao_mutex.c \ + ao_stdio_newlib.c \ ao_panic.c \ ao_timer.c \ ao_usb_stm.c \ - ao_flash_stm.c \ - $(SCHEME_SRCS) \ - ao_scheme_os_save.c + ao_romconfig.c \ + $(SCHEME_SRCS) PRODUCT=LambdaKey-v1.0 PRODUCT_DEF=-DLAMBDAKEY @@ -65,7 +62,7 @@ OBJ=$(SRC:.c=.o) all: $(PROG) $(HEX) -$(PROG): Makefile $(OBJ) lambda.ld altos.ld +$(PROG): Makefile $(OBJ) lambda.ld $(call quiet,CC) $(LDFLAGS) $(CFLAGS) -o $(PROG) $(OBJ) $(LIBS) $(OBJ): $(INC) @@ -73,13 +70,16 @@ $(OBJ): $(INC) ao_product.h: ao-make-product.5c ../Version $(call quiet,NICKLE,$<) $< -m altusmetrum.org -i $(IDPRODUCT) -p $(PRODUCT) -v $(VERSION) > $@ +ao_scheme_const.h: ../scheme/make-const/ao_scheme_make_const ao_lambdakey_const.scheme + ../scheme/make-const/ao_scheme_make_const -d FLOAT,VECTOR,QUASI,BIGINT -o $@ ao_lambdakey_const.scheme + load: $(PROG) stm-load $(PROG) distclean: clean clean: - rm -f *.o $(PROGNAME)-*.elf $(PROGNAME)-*.ihx + rm -f *.o $(PROGNAME)-*.elf $(PROGNAME)-*.ihx ao_scheme_const.h rm -f ao_product.h install: diff --git a/src/lambdakey-v1.0/ao_lambdakey.c b/src/lambdakey-v1.0/ao_lambdakey.c index d0996eb4..73962e29 100644 --- a/src/lambdakey-v1.0/ao_lambdakey.c +++ b/src/lambdakey-v1.0/ao_lambdakey.c @@ -29,13 +29,11 @@ void main(void) { ao_led_init(LEDS_AVAILABLE); ao_clock_init(); - ao_task_init(); ao_timer_init(); - ao_dma_init(); ao_usb_init(); ao_cmd_init(); ao_cmd_register(blink_cmds); - ao_start_scheduler(); + ao_cmd(); } diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme new file mode 100644 index 00000000..a912b8ae --- /dev/null +++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme @@ -0,0 +1,428 @@ +; +; Copyright © 2016 Keith Packard <keithp@keithp.com> +; +; This program is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation, either version 2 of the License, or +; (at your option) any later version. +; +; This program is distributed in the hope that it will be useful, but +; WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; General Public License for more details. +; +; Lisp code placed in ROM + + ; return a list containing all of the arguments +(def (quote list) (lambda l l)) + +(def (quote def!) + (macro (a b) + (list + def + (list quote a) + b) + ) + ) + +(begin + (def! append + (lambda args + (def! a-l + (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (a-l (cdr a) b))) + ) + ) + ) + + (def! a-ls + (lambda (l) + (cond ((null? l) l) + ((null? (cdr l)) (car l)) + (else (a-l (car l) (a-ls (cdr l)))) + ) + ) + ) + (a-ls args) + ) + ) + 'append) + +(append '(a) '(b)) + + ; + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated. + ; + ; Also accepts the alternate + ; form for defining lambdas of + ; (define (name a y z) sexprs ...) + ; + +(begin + (def (quote define) + (macro (a . b) + ; check for alternate lambda definition form + + (cond ((pair? a) + (set! b + (cons lambda (cons (cdr a) b))) + (set! a (car a)) + ) + (else + (set! b (car b)) + ) + ) + (cons begin + (cons + (cons def + (cons (cons quote (cons a '())) + (cons b '()) + ) + ) + (cons + (cons quote (cons a '())) + '()) + ) + ) + ) + ) + 'define + ) + + ; boolean operators + +(begin + (def! or + (macro a + (def! _or + (lambda (a) + (cond ((null? a) #f) + ((null? (cdr a)) + (car a)) + (else + (list + cond + (list + (car a)) + (list + 'else + (_or (cdr a)) + ) + ) + ) + ) + ) + ) + (_or a))) + 'or) + + ; execute to resolve macros + +(or #f #t) + +(begin + (def! and + (macro a + (def! _and + (lambda (a) + (cond ((null? a) #t) + ((null? (cdr a)) + (car a)) + (else + (list + cond + (list + (car a) + (_and (cdr a)) + ) + ) + ) + ) + ) + ) + (_and a) + ) + ) + 'and) + + ; execute to resolve macros + +(and #t #f) + + ; basic list accessors + +(define (caar a) (car (car a))) + +(define (cadr a) (car (cdr a))) + +; (define (cdar a) (cdr (car a))) + + ; (if <condition> <if-true>) + ; (if <condition> <if-true> <if-false) + +(define if + (macro (test . b) + (cond ((null? (cdr b)) + (list cond (list test (car b))) + ) + (else + (list cond + (list test (car b)) + (list 'else (cadr b)) + ) + ) + ) + ) + ) + +(if (> 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + + ; simple math operators + +(define zero? (macro (value) (list eqv? value 0))) + +(zero? 1) +(zero? 0) +(zero? "hello") + +(define positive? (macro (value) (list > value 0))) + +(positive? 12) +(positive? -12) + +(define negative? (macro (value) (list < value 0))) + +(negative? 12) +(negative? -12) + +(define (abs a) (if (>= a 0) a (- a))) + +(abs 12) +(abs -12) + +(define max (lambda (a . b) + (while (not (null? b)) + (cond ((< a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(max 1 2 3) +(max 3 2 1) + +(define min (lambda (a . b) + (while (not (null? b)) + (cond ((> a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(min 1 2 3) +(min 3 2 1) + +(define (even? a) (zero? (% a 2))) + +(even? 2) +(even? -2) +(even? 3) +(even? -1) + +(define (odd? a) (not (even? a))) + +(odd? 2) +(odd? -2) +(odd? 3) +(odd? -1) + + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a) (- b 1)) + ) + ) + +(define (list-ref a b) + (car (list-tail a b)) + ) + +(list-ref '(1 2 3) 2) + + + ; define a set of local + ; variables one at a time and + ; then evaluate a list of + ; sexprs + ; + ; (let* (var-defines) sexprs) + ; + ; where var-defines are either + ; + ; (name value) + ; + ; or + ; + ; (name) + ; + ; e.g. + ; + ; (let* ((x 1) (y)) (set! y (+ x 1)) y) + +(define let* + (macro (a . b) + + ; + ; make the list of names in the let + ; + + (define (_n a) + (cond ((not (null? a)) + (cons (car (car a)) + (_n (cdr a)))) + (else ()) + ) + ) + + ; the set of expressions is + ; the list of set expressions + ; pre-pended to the + ; expressions to evaluate + + (define (_v a b) + (cond ((null? a) b) (else + (cons + (list set + (list quote + (car (car a)) + ) + (cond ((null? (cdr (car a))) ()) + (else (cadr (car a)))) + ) + (_v (cdr a) b) + ) + ) + ) + ) + + ; the parameters to the lambda is a list + ; of nils of the right length + + (define (_z a) + (cond ((null? a) ()) + (else (cons () (_z (cdr a)))) + ) + ) + ; build the lambda. + + (cons (cons lambda (cons (_n a) (_v a b))) (_z a)) + ) + ) + +(let* ((a 1) (y a)) (+ a y)) + +(define let let*) + ; recursive equality + +(define (equal? a b) + (cond ((eq? a b) #t) + ((pair? a) + (cond ((pair? b) + (cond ((equal? (car a) (car b)) + (equal? (cdr a) (cdr b))) + ) + ) + ) + ) + ) + ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b)) + +(define (member a b . t?) + (cond ((null? b) + #f + ) + (else + (if (null? t?) (set! t? equal?) (set! t? (car t?))) + (if (t? a (car b)) + b + (member a (cdr b) t?)) + ) + ) + ) + +(member '(2) '((1) (2) (3))) + +(member '(4) '((1) (2) (3))) + +(define (memq a b) (member a b eq?)) + +(memq 2 '(1 2 3)) + +(memq 4 '(1 2 3)) + +(memq '(2) '((1) (2) (3))) + +(define (_as a b t?) + (if (null? b) + #f + (if (t? a (caar b)) + (car b) + (_as a (cdr b) t?) + ) + ) + ) + +(define (assq a b) (_as a b eq?)) +(define (assoc a b) (_as a b equal?)) + +(assq 'a '((a 1) (b 2) (c 3))) +(assoc '(c) '((a 1) (b 2) ((c) 3))) + +(define string (lambda a (list->string a))) + +(define map + (lambda (a . b) + (define (_a b) + (cond ((null? b) ()) + (else + (cons (caar b) (_a (cdr b))) + ) + ) + ) + (define (_n b) + (cond ((null? b) ()) + (else + (cons (cdr (car b)) (_n (cdr b))) + ) + ) + ) + (define (_d b) + (cond ((null? (car b)) ()) + (else + (cons (apply a (_a b)) (_d (_n b))) + ) + ) + ) + (_d b) + ) + ) + +(map cadr '((a b) (d e) (g h))) + +(define (newline) (write-char #\newline)) + +(newline) diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h index 2ba79c01..48b9db16 100644 --- a/src/lambdakey-v1.0/ao_pins.h +++ b/src/lambdakey-v1.0/ao_pins.h @@ -19,6 +19,9 @@ #ifndef _AO_PINS_H_ #define _AO_PINS_H_ +#define HAS_TASK 0 +#define HAS_AO_DELAY 1 + #define LED_PORT_ENABLE STM_RCC_AHBENR_IOPBEN #define LED_PORT (&stm_gpiob) #define LED_PIN_RED 4 diff --git a/src/lambdakey-v1.0/ao_scheme_os.h b/src/lambdakey-v1.0/ao_scheme_os.h index a620684f..b3080f31 100644 --- a/src/lambdakey-v1.0/ao_scheme_os.h +++ b/src/lambdakey-v1.0/ao_scheme_os.h @@ -20,9 +20,8 @@ #include "ao.h" -#define AO_SCHEME_SAVE 1 - -#define AO_SCHEME_POOL_TOTAL 2048 +#define AO_SCHEME_POOL 3584 +#define AO_SCHEME_TOKEN_MAX 64 #ifndef __BYTE_ORDER #define __LITTLE_ENDIAN 1234 diff --git a/src/lambdakey-v1.0/lambda.ld b/src/lambdakey-v1.0/lambda.ld index 5de65eb5..b09fdb4a 100644 --- a/src/lambdakey-v1.0/lambda.ld +++ b/src/lambdakey-v1.0/lambda.ld @@ -17,10 +17,9 @@ */ MEMORY { - rom (rx) : ORIGIN = 0x08001000, LENGTH = 25K - flash (r): ORIGIN = 0x08007400, LENGTH = 3k - ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 128 - stack (!w) : ORIGIN = 0x20000000 + 6k - 128, LENGTH = 128 + rom (rx) : ORIGIN = 0x08001000, LENGTH = 28K + ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 1k + stack (!w) : ORIGIN = 0x20000000 + 6k - 1k, LENGTH = 1k } INCLUDE registers.ld @@ -93,9 +92,9 @@ SECTIONS { /* Data -- relocated to RAM, but written to ROM */ - .data : { + .data BLOCK(8): { *(.data) /* initialized data */ - . = ALIGN(4); + . = ALIGN(8); __data_end__ = .; } >ram AT>rom @@ -110,8 +109,6 @@ SECTIONS { PROVIDE(end = .); PROVIDE(__stack__ = ORIGIN(stack) + LENGTH(stack)); - - __flash__ = ORIGIN(flash); } ENTRY(start); diff --git a/src/micropeak-v2.0/micropeak.ld b/src/micropeak-v2.0/micropeak.ld index 77717e16..baeae5b8 100644 --- a/src/micropeak-v2.0/micropeak.ld +++ b/src/micropeak-v2.0/micropeak.ld @@ -19,8 +19,8 @@ MEMORY { rom (rx) : ORIGIN = 0x08001000, LENGTH = 20K flash(rx) : ORIGIN = 0x08006000, LENGTH = 8K - ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 128 - stack (!w) : ORIGIN = 0x20000000 + 6k - 128, LENGTH = 128 + ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 512 + stack (!w) : ORIGIN = 0x20000000 + 6k - 512, LENGTH = 512 } INCLUDE registers.ld @@ -94,11 +94,11 @@ SECTIONS { *(.ramtext) } >ram AT>rom - /* Data -- relocated to RAM, but written to ROM + /* Data -- relocated to RAM, but written to ROM, + * also aligned to 8 bytes to agree with textram */ - .data : { + .data BLOCK(8): { *(.data) /* initialized data */ - . = ALIGN(4); __data_end__ = .; } >ram AT>rom diff --git a/src/micropeak/Makefile b/src/micropeak/Makefile index ac00f635..6e8cae14 100644 --- a/src/micropeak/Makefile +++ b/src/micropeak/Makefile @@ -103,7 +103,7 @@ ao_product.o: ao_product.c ao_product.h distclean: clean clean: - rm -f *.o $(PROG) $(HEX) $(SCRIPT) + rm -f *.o *.elf *.ihx $(SCRIPT) rm -f ao_product.h publish: $(PUBLISH_HEX) $(PUBLISH_SCRIPT) diff --git a/src/scheme/Makefile b/src/scheme/Makefile index dc36dde1..e600d5f7 100644 --- a/src/scheme/Makefile +++ b/src/scheme/Makefile @@ -1,12 +1,10 @@ -all: ao_scheme_builtin.h ao_scheme_const.h test/ao_scheme_test +all: ao_scheme_builtin.h make-const/ao_scheme_make_const test/ao-scheme tiny-test/ao-scheme-tiny clean: +cd make-const && make clean +cd test && make clean - rm -f ao_scheme_const.h ao_scheme_builtin.h - -ao_scheme_const.h: ao_scheme_const.scheme make-const/ao_scheme_make_const - make-const/ao_scheme_make_const -o $@ ao_scheme_const.scheme + +cd tiny-test && make clean + rm -f ao_scheme_builtin.h ao_scheme_builtin.h: ao_scheme_make_builtin ao_scheme_builtin.txt nickle ao_scheme_make_builtin ao_scheme_builtin.txt > $@ @@ -14,7 +12,10 @@ ao_scheme_builtin.h: ao_scheme_make_builtin ao_scheme_builtin.txt make-const/ao_scheme_make_const: FRC ao_scheme_builtin.h +cd make-const && make ao_scheme_make_const -test/ao_scheme_test: FRC ao_scheme_const.h ao_scheme_builtin.h - +cd test && make ao_scheme_test +test/ao-scheme: FRC ao_scheme_builtin.h make-const/ao_scheme_make_const + +cd test && make + +tiny-test/ao-scheme-tiny: FRC ao_scheme_builtin.h make-const/ao_scheme_make_const + +cd tiny-test && make FRC: diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 2fa1ed60..d4c9bc05 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -15,14 +15,26 @@ #ifndef _AO_SCHEME_H_ #define _AO_SCHEME_H_ +#ifndef DBG_MEM #define DBG_MEM 0 +#endif +#ifndef DBG_EVAL #define DBG_EVAL 0 +#endif +#ifndef DBG_READ #define DBG_READ 0 +#endif +#ifndef DBG_FREE_CONS #define DBG_FREE_CONS 0 +#endif #define NDEBUG 1 #include <stdint.h> #include <string.h> +#include <stdbool.h> +#define AO_SCHEME_BUILTIN_FEATURES +#include "ao_scheme_builtin.h" +#undef AO_SCHEME_BUILTIN_FEATURES #include <ao_scheme_os.h> #ifndef __BYTE_ORDER #include <endian.h> @@ -40,6 +52,10 @@ struct ao_scheme_os_save { uint16_t const_checksum_inv; }; +#ifndef AO_SCHEME_POOL_TOTAL +#error Must define AO_SCHEME_POOL_TOTAL for AO_SCHEME_SAVE +#endif + #define AO_SCHEME_POOL_EXTRA (sizeof(struct ao_scheme_os_save)) #define AO_SCHEME_POOL ((int) (AO_SCHEME_POOL_TOTAL - AO_SCHEME_POOL_EXTRA)) @@ -60,7 +76,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4))) #define ao_scheme_pool ao_scheme_const #define AO_SCHEME_POOL AO_SCHEME_POOL_CONST -#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern(n)) +#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern((char *) n)) #define _bool(v) ao_scheme_bool_poly(ao_scheme_bool_get(v)) #define _ao_scheme_bool_true _bool(1) @@ -75,7 +91,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4))) #else #include "ao_scheme_const.h" #ifndef AO_SCHEME_POOL -#define AO_SCHEME_POOL 3072 +#error Must define AO_SCHEME_POOL #endif #ifndef AO_SCHEME_POOL_EXTRA #define AO_SCHEME_POOL_EXTRA 0 @@ -86,7 +102,7 @@ extern uint8_t ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribut /* Primitive types */ #define AO_SCHEME_CONS 0 #define AO_SCHEME_INT 1 -#define AO_SCHEME_STRING 2 +#define AO_SCHEME_BIGINT 2 #define AO_SCHEME_OTHER 3 #define AO_SCHEME_TYPE_MASK 0x0003 @@ -102,10 +118,20 @@ extern uint8_t ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribut #define AO_SCHEME_LAMBDA 8 #define AO_SCHEME_STACK 9 #define AO_SCHEME_BOOL 10 -#define AO_SCHEME_BIGINT 11 +#define AO_SCHEME_STRING 11 +#ifdef AO_SCHEME_FEATURE_FLOAT #define AO_SCHEME_FLOAT 12 +#define _AO_SCHEME_FLOAT AO_SCHEME_FLOAT +#else +#define _AO_SCHEME_FLOAT 12 +#endif +#ifdef AO_SCHEME_FEATURE_VECTOR #define AO_SCHEME_VECTOR 13 -#define AO_SCHEME_NUM_TYPE 14 +#define _AO_SCHEME_VECTOR AO_SCHEME_VECTOR +#else +#define _AO_SCHEME_VECTOR _AO_SCHEME_FLOAT +#endif +#define AO_SCHEME_NUM_TYPE (_AO_SCHEME_VECTOR+1) /* Leave two bits for types to use as they please */ #define AO_SCHEME_OTHER_TYPE_MASK 0x3f @@ -129,9 +155,17 @@ ao_scheme_is_const(ao_poly poly) { return poly & AO_SCHEME_CONST; } -#define AO_SCHEME_IS_CONST(a) (ao_scheme_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_const + AO_SCHEME_POOL_CONST) -#define AO_SCHEME_IS_POOL(a) (ao_scheme_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_pool + AO_SCHEME_POOL) -#define AO_SCHEME_IS_INT(p) (ao_scheme_poly_base_type(p) == AO_SCHEME_INT) +static inline int +ao_scheme_is_const_addr(const void *addr) { + const uint8_t *a = addr; + return (ao_scheme_const <= a) && (a < ao_scheme_const + AO_SCHEME_POOL_CONST); +} + +static inline int +ao_scheme_is_pool_addr(const void *addr) { + const uint8_t *a = addr; + return (ao_scheme_pool <= a) && (a < ao_scheme_pool + AO_SCHEME_POOL); +} void * ao_scheme_ref(ao_poly poly); @@ -158,6 +192,11 @@ struct ao_scheme_atom { char name[]; }; +struct ao_scheme_string { + uint8_t type; + char val[]; +}; + struct ao_scheme_val { ao_poly atom; ao_poly val; @@ -182,54 +221,41 @@ struct ao_scheme_bool { uint16_t pad; }; -struct ao_scheme_bigint { - uint32_t value; -}; +#ifdef AO_SCHEME_FEATURE_FLOAT struct ao_scheme_float { uint8_t type; uint8_t pad1; uint16_t pad2; float value; }; +#endif +#ifdef AO_SCHEME_FEATURE_VECTOR struct ao_scheme_vector { uint8_t type; uint8_t pad1; uint16_t length; ao_poly vals[]; }; - -#if __BYTE_ORDER == __LITTLE_ENDIAN -static inline uint32_t -ao_scheme_int_bigint(int32_t i) { - return AO_SCHEME_BIGINT | (i << 8); -} -static inline int32_t -ao_scheme_bigint_int(uint32_t bi) { - return (int32_t) bi >> 8; -} -#else -static inline uint32_t -ao_scheme_int_bigint(int32_t i) { - return (uint32_t) (i & 0xffffff) | (AO_SCHEME_BIGINT << 24); -} -static inlint int32_t -ao_scheme_bigint_int(uint32_t bi) { - return (int32_t) (bi << 8) >> 8; -} #endif #define AO_SCHEME_MIN_INT (-(1 << (15 - AO_SCHEME_TYPE_SHIFT))) #define AO_SCHEME_MAX_INT ((1 << (15 - AO_SCHEME_TYPE_SHIFT)) - 1) -#define AO_SCHEME_MIN_BIGINT (-(1 << 24)) -#define AO_SCHEME_MAX_BIGINT ((1 << 24) - 1) -#define AO_SCHEME_NOT_INTEGER 0x7fffffff +#ifdef AO_SCHEME_FEATURE_BIGINT + +struct ao_scheme_bigint { + uint32_t value; +}; + +#define AO_SCHEME_MIN_BIGINT INT32_MIN +#define AO_SCHEME_MAX_BIGINT INT32_MAX + +#endif /* AO_SCHEME_FEATURE_BIGINT */ /* Set on type when the frame escapes the lambda */ #define AO_SCHEME_FRAME_MARK 0x80 -#define AO_SCHEME_FRAME_PRINT 0x40 static inline int ao_scheme_frame_marked(struct ao_scheme_frame *f) { return f->type & AO_SCHEME_FRAME_MARK; @@ -281,7 +307,6 @@ struct ao_scheme_stack { }; #define AO_SCHEME_STACK_MARK 0x80 /* set on type when a reference has been taken */ -#define AO_SCHEME_STACK_PRINT 0x40 /* stack is being printed */ static inline int ao_scheme_stack_marked(struct ao_scheme_stack *s) { return s->type & AO_SCHEME_STACK_MARK; @@ -433,6 +458,7 @@ ao_scheme_int_poly(int32_t i) return ((ao_poly) i << 2) | AO_SCHEME_INT; } +#ifdef AO_SCHEME_FEATURE_BIGINT static inline struct ao_scheme_bigint * ao_scheme_poly_bigint(ao_poly poly) { @@ -442,19 +468,20 @@ ao_scheme_poly_bigint(ao_poly poly) static inline ao_poly ao_scheme_bigint_poly(struct ao_scheme_bigint *bi) { - return ao_scheme_poly(bi, AO_SCHEME_OTHER); + return ao_scheme_poly(bi, AO_SCHEME_BIGINT); } +#endif /* AO_SCHEME_FEATURE_BIGINT */ -static inline char * +static inline struct ao_scheme_string * ao_scheme_poly_string(ao_poly poly) { return ao_scheme_ref(poly); } static inline ao_poly -ao_scheme_string_poly(char *s) +ao_scheme_string_poly(struct ao_scheme_string *s) { - return ao_scheme_poly(s, AO_SCHEME_STRING); + return ao_scheme_poly(s, AO_SCHEME_OTHER); } static inline struct ao_scheme_atom * @@ -493,6 +520,7 @@ ao_scheme_poly_bool(ao_poly poly) return ao_scheme_ref(poly); } +#ifdef AO_SCHEME_FEATURE_FLOAT static inline ao_poly ao_scheme_float_poly(struct ao_scheme_float *f) { @@ -507,7 +535,9 @@ ao_scheme_poly_float(ao_poly poly) float ao_scheme_poly_number(ao_poly p); +#endif +#ifdef AO_SCHEME_FEATURE_VECTOR static inline ao_poly ao_scheme_vector_poly(struct ao_scheme_vector *v) { @@ -519,6 +549,7 @@ ao_scheme_poly_vector(ao_poly poly) { return ao_scheme_ref(poly); } +#endif /* memory functions */ @@ -528,19 +559,8 @@ extern uint64_t ao_scheme_loops[2]; /* returns 1 if the object was already marked */ int -ao_scheme_mark(const struct ao_scheme_type *type, void *addr); - -/* returns 1 if the object was already marked */ -int ao_scheme_mark_memory(const struct ao_scheme_type *type, void *addr); -void * -ao_scheme_move_map(void *addr); - -/* returns 1 if the object was already moved */ -int -ao_scheme_move(const struct ao_scheme_type *type, void **ref); - /* returns 1 if the object was already moved */ int ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref); @@ -548,6 +568,21 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref); void * ao_scheme_alloc(int size); +/* Marks an object as being printed, returns 1 if it was already marked */ +int +ao_scheme_print_mark_addr(void *addr); + +void +ao_scheme_print_clear_addr(void *addr); + +/* Notes that printing has started */ +void +ao_scheme_print_start(void); + +/* Notes that printing has ended, returns 1 if printing is still happening */ +int +ao_scheme_print_stop(void); + #define AO_SCHEME_COLLECT_FULL 1 #define AO_SCHEME_COLLECT_INCREMENTAL 0 @@ -560,48 +595,82 @@ ao_scheme_cons_check(struct ao_scheme_cons *cons); #endif void -ao_scheme_cons_stash(int id, struct ao_scheme_cons *cons); +ao_scheme_poly_stash(ao_poly poly); -struct ao_scheme_cons * -ao_scheme_cons_fetch(int id); +ao_poly +ao_scheme_poly_fetch(void); -void -ao_scheme_poly_stash(int id, ao_poly poly); +static inline void +ao_scheme_cons_stash(struct ao_scheme_cons *cons) { + ao_scheme_poly_stash(ao_scheme_cons_poly(cons)); +} -ao_poly -ao_scheme_poly_fetch(int id); +static inline struct ao_scheme_cons * +ao_scheme_cons_fetch(void) { + return ao_scheme_poly_cons(ao_scheme_poly_fetch()); +} -void -ao_scheme_string_stash(int id, char *string); +static inline void +ao_scheme_atom_stash(struct ao_scheme_atom *atom) { + ao_scheme_poly_stash(ao_scheme_atom_poly(atom)); +} -char * -ao_scheme_string_fetch(int id); +static inline struct ao_scheme_atom * +ao_scheme_atom_fetch(void) { + return ao_scheme_poly_atom(ao_scheme_poly_fetch()); +} static inline void -ao_scheme_stack_stash(int id, struct ao_scheme_stack *stack) { - ao_scheme_poly_stash(id, ao_scheme_stack_poly(stack)); +ao_scheme_string_stash(struct ao_scheme_string *string) { + ao_scheme_poly_stash(ao_scheme_string_poly(string)); +} + +static inline struct ao_scheme_string * +ao_scheme_string_fetch(void) { + return ao_scheme_poly_string(ao_scheme_poly_fetch()); +} + +#ifdef AO_SCHEME_FEATURE_VECTOR +static inline void +ao_scheme_vector_stash(struct ao_scheme_vector *vector) { + ao_scheme_poly_stash(ao_scheme_vector_poly(vector)); +} + +static inline struct ao_scheme_vector * +ao_scheme_vector_fetch(void) { + return ao_scheme_poly_vector(ao_scheme_poly_fetch()); +} +#endif + +static inline void +ao_scheme_stack_stash(struct ao_scheme_stack *stack) { + ao_scheme_poly_stash(ao_scheme_stack_poly(stack)); } static inline struct ao_scheme_stack * -ao_scheme_stack_fetch(int id) { - return ao_scheme_poly_stack(ao_scheme_poly_fetch(id)); +ao_scheme_stack_fetch(void) { + return ao_scheme_poly_stack(ao_scheme_poly_fetch()); } -void -ao_scheme_frame_stash(int id, struct ao_scheme_frame *frame); +static inline void +ao_scheme_frame_stash(struct ao_scheme_frame *frame) { + ao_scheme_poly_stash(ao_scheme_frame_poly(frame)); +} -struct ao_scheme_frame * -ao_scheme_frame_fetch(int id); +static inline struct ao_scheme_frame * +ao_scheme_frame_fetch(void) { + return ao_scheme_poly_frame(ao_scheme_poly_fetch()); +} /* bool */ extern const struct ao_scheme_type ao_scheme_bool_type; void -ao_scheme_bool_write(ao_poly v); +ao_scheme_bool_write(ao_poly v, bool write); #ifdef AO_SCHEME_MAKE_CONST -struct ao_scheme_bool *ao_scheme_true, *ao_scheme_false; +extern struct ao_scheme_bool *ao_scheme_true, *ao_scheme_false; struct ao_scheme_bool * ao_scheme_bool_get(uint8_t value); @@ -618,7 +687,7 @@ struct ao_scheme_cons * ao_scheme_cons_cdr(struct ao_scheme_cons *cons); ao_poly -ao_scheme__cons(ao_poly car, ao_poly cdr); +ao_scheme_cons(ao_poly car, ao_poly cdr); extern struct ao_scheme_cons *ao_scheme_cons_free_list; @@ -626,10 +695,7 @@ void ao_scheme_cons_free(struct ao_scheme_cons *cons); void -ao_scheme_cons_write(ao_poly); - -void -ao_scheme_cons_display(ao_poly); +ao_scheme_cons_write(ao_poly, bool write); int ao_scheme_cons_length(struct ao_scheme_cons *cons); @@ -640,23 +706,26 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons); /* string */ extern const struct ao_scheme_type ao_scheme_string_type; -char * -ao_scheme_string_copy(char *a); +struct ao_scheme_string * +ao_scheme_string_copy(struct ao_scheme_string *a); -char * -ao_scheme_string_cat(char *a, char *b); +struct ao_scheme_string * +ao_scheme_string_make(char *a); + +struct ao_scheme_string * +ao_scheme_atom_to_string(struct ao_scheme_atom *a); + +struct ao_scheme_string * +ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b); ao_poly ao_scheme_string_pack(struct ao_scheme_cons *cons); ao_poly -ao_scheme_string_unpack(char *a); +ao_scheme_string_unpack(struct ao_scheme_string *a); void -ao_scheme_string_write(ao_poly s); - -void -ao_scheme_string_display(ao_poly s); +ao_scheme_string_write(ao_poly s, bool write); /* atom */ extern const struct ao_scheme_type ao_scheme_atom_type; @@ -666,7 +735,10 @@ extern struct ao_scheme_frame *ao_scheme_frame_global; extern struct ao_scheme_frame *ao_scheme_frame_current; void -ao_scheme_atom_write(ao_poly a); +ao_scheme_atom_write(ao_poly a, bool write); + +struct ao_scheme_atom * +ao_scheme_string_to_atom(struct ao_scheme_string *string); struct ao_scheme_atom * ao_scheme_atom_intern(char *name); @@ -685,10 +757,11 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val); /* int */ void -ao_scheme_int_write(ao_poly i); +ao_scheme_int_write(ao_poly i, bool write); +#ifdef AO_SCHEME_FEATURE_BIGINT int32_t -ao_scheme_poly_integer(ao_poly p); +ao_scheme_poly_integer(ao_poly p, bool *fail); ao_poly ao_scheme_integer_poly(int32_t i); @@ -700,17 +773,27 @@ ao_scheme_integer_typep(uint8_t t) } void -ao_scheme_bigint_write(ao_poly i); +ao_scheme_bigint_write(ao_poly i, bool write); extern const struct ao_scheme_type ao_scheme_bigint_type; -/* vector */ +#else -void -ao_scheme_vector_write(ao_poly v); +#define ao_scheme_poly_integer(a,b) ao_scheme_poly_int(a) +#define ao_scheme_integer_poly ao_scheme_int_poly + +static inline int +ao_scheme_integer_typep(uint8_t t) +{ + return (t == AO_SCHEME_INT); +} + +#endif /* AO_SCHEME_FEATURE_BIGINT */ + +/* vector */ void -ao_scheme_vector_display(ao_poly v); +ao_scheme_vector_write(ao_poly v, bool write); struct ao_scheme_vector * ao_scheme_vector_alloc(uint16_t length, ao_poly fill); @@ -730,11 +813,10 @@ ao_scheme_vector_to_list(struct ao_scheme_vector *vector); extern const struct ao_scheme_type ao_scheme_vector_type; /* prim */ -void -ao_scheme_poly_write(ao_poly p); +void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write); -void -ao_scheme_poly_display(ao_poly p); +static inline void +ao_scheme_poly_write(ao_poly p, bool write) { (*ao_scheme_poly_write_func(p))(p, write); } int ao_scheme_poly_mark(ao_poly p, uint8_t note_cons); @@ -758,26 +840,29 @@ ao_poly ao_scheme_set_cond(struct ao_scheme_cons *cons); /* float */ +#ifdef AO_SCHEME_FEATURE_FLOAT extern const struct ao_scheme_type ao_scheme_float_type; void -ao_scheme_float_write(ao_poly p); +ao_scheme_float_write(ao_poly p, bool write); ao_poly ao_scheme_float_get(float value); +#endif +#ifdef AO_SCHEME_FEATURE_FLOAT static inline uint8_t ao_scheme_number_typep(uint8_t t) { return ao_scheme_integer_typep(t) || (t == AO_SCHEME_FLOAT); } - -float -ao_scheme_poly_number(ao_poly p); +#else +#define ao_scheme_number_typep ao_scheme_integer_typep +#endif /* builtin */ void -ao_scheme_builtin_write(ao_poly b); +ao_scheme_builtin_write(ao_poly b, bool write); extern const struct ao_scheme_type ao_scheme_builtin_type; @@ -836,7 +921,7 @@ ao_poly ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val); void -ao_scheme_frame_write(ao_poly p); +ao_scheme_frame_write(ao_poly p, bool write); void ao_scheme_frame_init(void); @@ -850,7 +935,7 @@ struct ao_scheme_lambda * ao_scheme_lambda_new(ao_poly cons); void -ao_scheme_lambda_write(ao_poly lambda); +ao_scheme_lambda_write(ao_poly lambda, bool write); ao_poly ao_scheme_lambda_eval(void); @@ -861,6 +946,8 @@ extern const struct ao_scheme_type ao_scheme_stack_type; extern struct ao_scheme_stack *ao_scheme_stack; extern struct ao_scheme_stack *ao_scheme_stack_free_list; +extern int ao_scheme_frame_print_indent; + void ao_scheme_stack_reset(struct ao_scheme_stack *stack); @@ -874,7 +961,7 @@ void ao_scheme_stack_clear(void); void -ao_scheme_stack_write(ao_poly stack); +ao_scheme_stack_write(ao_poly stack, bool write); ao_poly ao_scheme_stack_eval(void); @@ -882,19 +969,13 @@ ao_scheme_stack_eval(void); /* error */ void -ao_scheme_vprintf(char *format, va_list args); +ao_scheme_vprintf(const char *format, va_list args); void -ao_scheme_printf(char *format, ...); - -void -ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last); - -void -ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame); +ao_scheme_printf(const char *format, ...); ao_poly -ao_scheme_error(int error, char *format, ...); +ao_scheme_error(int error, const char *format, ...); /* builtins */ @@ -903,9 +984,11 @@ ao_scheme_error(int error, char *format, ...); /* debugging macros */ -#if DBG_EVAL || DBG_READ || DBG_MEM -#define DBG_CODE 1 +#if DBG_EVAL || DBG_READ int ao_scheme_stack_depth; +#endif + +#if DBG_EVAL #define DBG_DO(a) a #define DBG_INDENT() do { int _s; for(_s = 0; _s < ao_scheme_stack_depth; _s++) printf(" "); } while(0) #define DBG_IN() (++ao_scheme_stack_depth) @@ -913,10 +996,10 @@ int ao_scheme_stack_depth; #define DBG_RESET() (ao_scheme_stack_depth = 0) #define DBG(...) ao_scheme_printf(__VA_ARGS__) #define DBGI(...) do { printf("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0) -#define DBG_CONS(a) ao_scheme_cons_write(ao_scheme_cons_poly(a)) -#define DBG_POLY(a) ao_scheme_poly_write(a) +#define DBG_CONS(a) ao_scheme_cons_write(ao_scheme_cons_poly(a), true) +#define DBG_POLY(a) ao_scheme_poly_write(a, true) #define OFFSET(a) ((a) ? (int) ((uint8_t *) a - ao_scheme_pool) : -1) -#define DBG_STACK() ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack)) +#define DBG_STACK() ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true) static inline void ao_scheme_frames_dump(void) { @@ -942,27 +1025,46 @@ ao_scheme_frames_dump(void) #endif #if DBG_READ -#define RDBGI(...) DBGI(__VA_ARGS__) -#define RDBG_IN() DBG_IN() -#define RDBG_OUT() DBG_OUT() +#define RDBGI(...) do { printf("%4d: ", __LINE__); DBG_INDENT(); ao_scheme_printf(__VA_ARGS__); } while (0) +#define RDBG_IN() (++ao_scheme_stack_depth) +#define RDBG_OUT() (--ao_scheme_stack_depth) #else #define RDBGI(...) #define RDBG_IN() #define RDBG_OUT() #endif -#define DBG_MEM_START 1 +static inline int +ao_scheme_mdbg_offset(void *a) +{ + uint8_t *u = a; + + if (u == 0) + return -1; + + if (ao_scheme_pool <= u && u < ao_scheme_pool + AO_SCHEME_POOL) + return u - ao_scheme_pool; + +#ifndef AO_SCHEME_MAKE_CONST + if (ao_scheme_const <= u && u < ao_scheme_const + AO_SCHEME_POOL_CONST) + return - (int) (u - ao_scheme_const); +#endif + return -2; +} + +#define MDBG_OFFSET(a) ao_scheme_mdbg_offset(a) #if DBG_MEM +#define DBG_MEM_START 1 + #include <assert.h> extern int dbg_move_depth; #define MDBG_DUMP 1 -#define MDBG_OFFSET(a) ((a) ? (int) ((uint8_t *) (a) - ao_scheme_pool) : -1) extern int dbg_mem; -#define MDBG_DO(a) DBG_DO(a) +#define MDBG_DO(a) a #define MDBG_MOVE(...) do { if (dbg_mem) { int d; for (d = 0; d < dbg_move_depth; d++) printf (" "); printf(__VA_ARGS__); } } while (0) #define MDBG_MORE(...) do { if (dbg_mem) printf(__VA_ARGS__); } while (0) #define MDBG_MOVE_IN() (dbg_move_depth++) diff --git a/src/scheme/ao_scheme_atom.c b/src/scheme/ao_scheme_atom.c index cb32b7fe..c72a2b27 100644 --- a/src/scheme/ao_scheme_atom.c +++ b/src/scheme/ao_scheme_atom.c @@ -71,8 +71,8 @@ const struct ao_scheme_type ao_scheme_atom_type = { struct ao_scheme_atom *ao_scheme_atoms; -struct ao_scheme_atom * -ao_scheme_atom_intern(char *name) +static struct ao_scheme_atom * +ao_scheme_atom_find(char *name) { struct ao_scheme_atom *atom; @@ -86,15 +86,43 @@ ao_scheme_atom_intern(char *name) return atom; } #endif - ao_scheme_string_stash(0, name); - atom = ao_scheme_alloc(name_size(name)); - name = ao_scheme_string_fetch(0); + return NULL; +} + +static void +ao_scheme_atom_init(struct ao_scheme_atom *atom, char *name) +{ if (atom) { atom->type = AO_SCHEME_ATOM; + strcpy(atom->name, name); atom->next = ao_scheme_atom_poly(ao_scheme_atoms); ao_scheme_atoms = atom; - strcpy(atom->name, name); } +} + +struct ao_scheme_atom * +ao_scheme_string_to_atom(struct ao_scheme_string *string) +{ + struct ao_scheme_atom *atom = ao_scheme_atom_find(string->val); + + if (atom) + return atom; + ao_scheme_string_stash(string); + atom = ao_scheme_alloc(name_size(string->val)); + string = ao_scheme_string_fetch(); + ao_scheme_atom_init(atom, string->val); + return atom; +} + +struct ao_scheme_atom * +ao_scheme_atom_intern(char *name) +{ + struct ao_scheme_atom *atom = ao_scheme_atom_find(name); + if (atom) + return atom; + + atom = ao_scheme_alloc(name_size(name)); + ao_scheme_atom_init(atom, name); return atom; } @@ -160,8 +188,9 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val) } void -ao_scheme_atom_write(ao_poly a) +ao_scheme_atom_write(ao_poly a, bool write) { struct ao_scheme_atom *atom = ao_scheme_poly_atom(a); + (void) write; printf("%s", atom->name); } diff --git a/src/scheme/ao_scheme_bool.c b/src/scheme/ao_scheme_bool.c index c1e880ca..88970667 100644 --- a/src/scheme/ao_scheme_bool.c +++ b/src/scheme/ao_scheme_bool.c @@ -38,10 +38,11 @@ const struct ao_scheme_type ao_scheme_bool_type = { }; void -ao_scheme_bool_write(ao_poly v) +ao_scheme_bool_write(ao_poly v, bool write) { struct ao_scheme_bool *b = ao_scheme_poly_bool(v); + (void) write; if (b->value) printf("#t"); else diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 1754e677..81fd9010 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -52,7 +52,7 @@ char *ao_scheme_args_name(uint8_t args) { case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name; case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name; case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name; - default: return "???"; + default: return (char *) "???"; } } #else @@ -64,7 +64,7 @@ static char * ao_scheme_builtin_name(enum ao_scheme_builtin_id b) { if (b < _builtin_last) return ao_scheme_poly_atom(builtin_names[b])->name; - return "???"; + return (char *) "???"; } static const ao_poly ao_scheme_args_atoms[] = { @@ -79,14 +79,15 @@ ao_scheme_args_name(uint8_t args) args &= AO_SCHEME_FUNC_MASK; if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0]) return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name; - return "(unknown)"; + return (char *) "(unknown)"; } #endif void -ao_scheme_builtin_write(ao_poly b) +ao_scheme_builtin_write(ao_poly b, bool write) { struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b); + (void) write; printf("%s", ao_scheme_builtin_name(builtin->func)); } @@ -127,13 +128,14 @@ ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int ty return _ao_scheme_bool_true; } -int32_t +static int32_t ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc) { - ao_poly p = ao_scheme_arg(cons, argc); - int32_t i = ao_scheme_poly_integer(p); + ao_poly p = ao_scheme_arg(cons, argc); + bool fail = false; + int32_t i = ao_scheme_poly_integer(p, &fail); - if (i == AO_SCHEME_NOT_INTEGER) + if (fail) (void) ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, p); return i; } @@ -166,7 +168,7 @@ ao_scheme_do_cons(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; car = ao_scheme_arg(cons, 0); cdr = ao_scheme_arg(cons, 1); - return ao_scheme__cons(car, cdr); + return ao_scheme_cons(car, cdr); } ao_poly @@ -251,10 +253,10 @@ ao_scheme_do_setq(struct ao_scheme_cons *cons) return ao_scheme_error(AO_SCHEME_INVALID, "set! of non-atom %v", name); if (!ao_scheme_atom_ref(name, NULL)) return ao_scheme_error(AO_SCHEME_INVALID, "atom %v not defined", name); - return ao_scheme__cons(_ao_scheme_atom_set, - ao_scheme__cons(ao_scheme__cons(_ao_scheme_atom_quote, - ao_scheme__cons(name, AO_SCHEME_NIL)), - cons->cdr)); + return ao_scheme_cons(_ao_scheme_atom_set, + ao_scheme_cons(ao_scheme_cons(_ao_scheme_atom_quote, + ao_scheme_cons(name, AO_SCHEME_NIL)), + cons->cdr)); } ao_poly @@ -286,7 +288,7 @@ ao_scheme_do_write(struct ao_scheme_cons *cons) ao_poly val = AO_SCHEME_NIL; while (cons) { val = cons->car; - ao_scheme_poly_write(val); + ao_scheme_poly_write(val, true); cons = ao_scheme_cons_cdr(cons); if (cons) printf(" "); @@ -300,16 +302,16 @@ ao_scheme_do_display(struct ao_scheme_cons *cons) ao_poly val = AO_SCHEME_NIL; while (cons) { val = cons->car; - ao_scheme_poly_display(val); + ao_scheme_poly_write(val, false); cons = ao_scheme_cons_cdr(cons); } return _ao_scheme_bool_true; } -ao_poly +static ao_poly ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) { - struct ao_scheme_cons *cons = cons; + struct ao_scheme_cons *cons; ao_poly ret = AO_SCHEME_NIL; for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) { @@ -319,55 +321,74 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) if (cons == orig_cons) { ret = car; - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); if (cons->cdr == AO_SCHEME_NIL) { switch (op) { case builtin_minus: if (ao_scheme_integer_typep(ct)) - ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret)); + ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret, NULL)); +#ifdef AO_SCHEME_FEATURE_FLOAT else if (ct == AO_SCHEME_FLOAT) ret = ao_scheme_float_get(-ao_scheme_poly_number(ret)); +#endif break; case builtin_divide: - if (ao_scheme_integer_typep(ct) && ao_scheme_poly_integer(ret) == 1) - ; - else if (ao_scheme_number_typep(ct)) { - float v = ao_scheme_poly_number(ret); - ret = ao_scheme_float_get(1/v); + if (ao_scheme_poly_integer(ret, NULL) == 1) { + } else { +#ifdef AO_SCHEME_FEATURE_FLOAT + if (ao_scheme_number_typep(ct)) { + float v = ao_scheme_poly_number(ret); + ret = ao_scheme_float_get(1/v); + } +#else + ret = ao_scheme_integer_poly(0); +#endif } break; default: break; } } - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) { - int32_t r = ao_scheme_poly_integer(ret); - int32_t c = ao_scheme_poly_integer(car); + int32_t r = ao_scheme_poly_integer(ret, NULL); + int32_t c = ao_scheme_poly_integer(car, NULL); +#ifdef AO_SCHEME_FEATURE_FLOAT int64_t t; +#endif switch(op) { case builtin_plus: r += c; check_overflow: +#ifdef AO_SCHEME_FEATURE_FLOAT if (r < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < r) goto inexact; +#endif break; case builtin_minus: r -= c; goto check_overflow; break; case builtin_times: +#ifdef AO_SCHEME_FEATURE_FLOAT t = (int64_t) r * (int64_t) c; if (t < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < t) goto inexact; r = (int32_t) t; +#else + r = r * c; +#endif break; case builtin_divide: +#ifdef AO_SCHEME_FEATURE_FLOAT if (c != 0 && (r % c) == 0) r /= c; else goto inexact; +#else + r /= c; +#endif break; case builtin_quotient: if (c == 0) @@ -392,9 +413,10 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) default: break; } - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_integer_poly(r); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); +#ifdef AO_SCHEME_FEATURE_FLOAT } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) { float r, c; inexact: @@ -420,15 +442,16 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) default: break; } - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_float_get(r); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); +#endif } else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) { - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret), ao_scheme_poly_string(car))); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); if (!ret) return ret; } @@ -480,7 +503,7 @@ ao_scheme_do_remainder(struct ao_scheme_cons *cons) return ao_scheme_math(cons, builtin_remainder); } -ao_poly +static ao_poly ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) { ao_poly left; @@ -498,8 +521,8 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) uint8_t lt = ao_scheme_poly_type(left); uint8_t rt = ao_scheme_poly_type(right); if (ao_scheme_integer_typep(lt) && ao_scheme_integer_typep(rt)) { - int32_t l = ao_scheme_poly_integer(left); - int32_t r = ao_scheme_poly_integer(right); + int32_t l = ao_scheme_poly_integer(left, NULL); + int32_t r = ao_scheme_poly_integer(right, NULL); switch (op) { case builtin_less: @@ -524,6 +547,7 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) default: break; } +#ifdef AO_SCHEME_FEATURE_FLOAT } else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) { float l, r; @@ -553,9 +577,10 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) default: break; } +#endif /* AO_SCHEME_FEATURE_FLOAT */ } else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) { - int c = strcmp(ao_scheme_poly_string(left), - ao_scheme_poly_string(right)); + int c = strcmp(ao_scheme_poly_string(left)->val, + ao_scheme_poly_string(right)->val); switch (op) { case builtin_less: if (!(c < 0)) @@ -641,16 +666,16 @@ ao_scheme_do_string_to_list(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_string_ref(struct ao_scheme_cons *cons) { - char *string; + char *string; int32_t ref; if (!ao_scheme_check_argc(_ao_scheme_atom_string2dref, cons, 2, 2)) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_string2dref, cons, 0, AO_SCHEME_STRING, 0)) return AO_SCHEME_NIL; ref = ao_scheme_arg_int(_ao_scheme_atom_string2dref, cons, 1); - if (ref == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; - string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val; while (*string && ref) { ++string; --ref; @@ -666,20 +691,20 @@ ao_scheme_do_string_ref(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_string_length(struct ao_scheme_cons *cons) { - char *string; + struct ao_scheme_string *string; if (!ao_scheme_check_argc(_ao_scheme_atom_string2dlength, cons, 1, 1)) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_string2dlength, cons, 0, AO_SCHEME_STRING, 0)) return AO_SCHEME_NIL; string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); - return ao_scheme_integer_poly(strlen(string)); + return ao_scheme_integer_poly(strlen(string->val)); } ao_poly ao_scheme_do_string_copy(struct ao_scheme_cons *cons) { - char *string; + struct ao_scheme_string *string; if (!ao_scheme_check_argc(_ao_scheme_atom_string2dcopy, cons, 1, 1)) return AO_SCHEME_NIL; @@ -692,7 +717,7 @@ ao_scheme_do_string_copy(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_string_set(struct ao_scheme_cons *cons) { - char *string; + char *string; int32_t ref; int32_t val; @@ -700,12 +725,12 @@ ao_scheme_do_string_set(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_string2dset21, cons, 0, AO_SCHEME_STRING, 0)) return AO_SCHEME_NIL; - string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val; ref = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 1); - if (ref == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2); - if (val == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; while (*string && ref) { ++string; @@ -736,7 +761,7 @@ ao_scheme_do_led(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; led = ao_scheme_arg_int(_ao_scheme_atom_led, cons, 0); - if (led == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; led = ao_scheme_arg(cons, 0); ao_scheme_os_led(ao_scheme_poly_int(led)); @@ -751,7 +776,7 @@ ao_scheme_do_delay(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_delay, cons, 1, 1)) return AO_SCHEME_NIL; delay = ao_scheme_arg_int(_ao_scheme_atom_delay, cons, 0); - if (delay == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; ao_scheme_os_delay(delay); return delay; @@ -831,7 +856,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; v = ao_scheme_arg(cons, 0); - if (v != AO_SCHEME_NIL && ao_scheme_poly_type(v) == AO_SCHEME_CONS) + if (ao_scheme_is_pair(v)) return _ao_scheme_bool_true; return _ao_scheme_bool_false; } @@ -839,6 +864,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_integerp(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_FEATURE_BIGINT if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) { @@ -848,21 +874,32 @@ ao_scheme_do_integerp(struct ao_scheme_cons *cons) default: return _ao_scheme_bool_false; } +#else + return ao_scheme_do_typep(AO_SCHEME_INT, cons); +#endif } ao_poly ao_scheme_do_numberp(struct ao_scheme_cons *cons) { +#if defined(AO_SCHEME_FEATURE_BIGINT) || defined(AO_SCHEME_FEATURE_FLOAT) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) { case AO_SCHEME_INT: +#ifdef AO_SCHEME_FEATURE_BIGINT case AO_SCHEME_BIGINT: +#endif +#ifdef AO_SCHEME_FEATURE_FLOAT case AO_SCHEME_FLOAT: +#endif return _ao_scheme_bool_true; default: return _ao_scheme_bool_false; } +#else + return ao_scheme_do_integerp(cons); +#endif } ao_poly @@ -910,7 +947,7 @@ ao_scheme_do_listp(struct ao_scheme_cons *cons) for (;;) { if (v == AO_SCHEME_NIL) return _ao_scheme_bool_true; - if (ao_scheme_poly_type(v) != AO_SCHEME_CONS) + if (!ao_scheme_is_cons(v)) return _ao_scheme_bool_false; v = ao_scheme_poly_cons(v)->cdr; } @@ -943,7 +980,7 @@ ao_scheme_do_symbol_to_string(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_ATOM, 0)) return AO_SCHEME_NIL; - return ao_scheme_string_poly(ao_scheme_string_copy(ao_scheme_poly_atom(ao_scheme_arg(cons, 0))->name)); + return ao_scheme_string_poly(ao_scheme_atom_to_string(ao_scheme_poly_atom(ao_scheme_arg(cons, 0)))); } ao_poly @@ -954,7 +991,7 @@ ao_scheme_do_string_to_symbol(struct ao_scheme_cons *cons) if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_STRING, 0)) return AO_SCHEME_NIL; - return ao_scheme_atom_poly(ao_scheme_atom_intern(ao_scheme_poly_string(ao_scheme_arg(cons, 0)))); + return ao_scheme_atom_poly(ao_scheme_string_to_atom(ao_scheme_poly_string(ao_scheme_arg(cons, 0))));; } ao_poly @@ -974,7 +1011,7 @@ ao_scheme_do_write_char(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0)) return AO_SCHEME_NIL; - putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0))); + putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0), NULL)); return _ao_scheme_bool_true; } @@ -1017,6 +1054,8 @@ ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons) return (ao_scheme_int_poly(AO_SCHEME_JIFFIES_PER_SECOND)); } +#ifdef AO_SCHEME_FEATURE_VECTOR + ao_poly ao_scheme_do_vector(struct ao_scheme_cons *cons) { @@ -1031,7 +1070,7 @@ ao_scheme_do_make_vector(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_make2dvector, cons, 2, 2)) return AO_SCHEME_NIL; k = ao_scheme_arg_int(_ao_scheme_atom_make2dvector, cons, 0); - if (k == AO_SCHEME_NOT_INTEGER) + if (ao_scheme_exception) return AO_SCHEME_NIL; return ao_scheme_vector_poly(ao_scheme_vector_alloc(k, ao_scheme_arg(cons, 1))); } @@ -1092,5 +1131,7 @@ ao_scheme_do_vectorp(struct ao_scheme_cons *cons) return ao_scheme_do_typep(AO_SCHEME_VECTOR, cons); } +#endif /* AO_SCHEME_FEATURE_VECTOR */ + #define AO_SCHEME_BUILTIN_FUNCS #include "ao_scheme_builtin.h" diff --git a/src/scheme/ao_scheme_builtin.txt b/src/scheme/ao_scheme_builtin.txt index 17f5ea0c..23adf6ed 100644 --- a/src/scheme/ao_scheme_builtin.txt +++ b/src/scheme/ao_scheme_builtin.txt @@ -1,81 +1,84 @@ -f_lambda eval -f_lambda read -nlambda lambda -nlambda nlambda -nlambda macro -f_lambda car -f_lambda cdr -f_lambda cons -f_lambda last -f_lambda length -f_lambda list_copy list-copy -nlambda quote -atom quasiquote -atom unquote -atom unquote_splicing unquote-splicing -f_lambda set -macro setq set! -f_lambda def -nlambda cond -nlambda begin -nlambda while -f_lambda write -f_lambda display -f_lambda plus + string-append -f_lambda minus - -f_lambda times * -f_lambda divide / -f_lambda modulo modulo % -f_lambda remainder -f_lambda quotient -f_lambda equal = eq? eqv? -f_lambda less < string<? -f_lambda greater > string>? -f_lambda less_equal <= string<=? -f_lambda greater_equal >= string>=? -f_lambda flush_output flush-output -f_lambda delay -f_lambda led -f_lambda save -f_lambda restore -f_lambda call_cc call-with-current-continuation call/cc -f_lambda collect -f_lambda nullp null? -f_lambda not -f_lambda listp list? -f_lambda pairp pair? -f_lambda integerp integer? exact? exact-integer? -f_lambda numberp number? real? -f_lambda booleanp boolean? -f_lambda set_car set-car! -f_lambda set_cdr set-cdr! -f_lambda symbolp symbol? -f_lambda list_to_string list->string -f_lambda string_to_list string->list -f_lambda symbol_to_string symbol->string -f_lambda string_to_symbol string->symbol -f_lambda stringp string? -f_lambda string_ref string-ref -f_lambda string_set string-set! -f_lambda string_copy string-copy -f_lambda string_length string-length -f_lambda procedurep procedure? -lambda apply -f_lambda read_char read-char -f_lambda write_char write-char -f_lambda exit -f_lambda current_jiffy current-jiffy -f_lambda current_second current-second -f_lambda jiffies_per_second jiffies-per-second -f_lambda finitep finite? -f_lambda infinitep infinite? -f_lambda inexactp inexact? -f_lambda sqrt -f_lambda vector_ref vector-ref -f_lambda vector_set vector-set! -f_lambda vector -f_lambda make_vector make-vector -f_lambda list_to_vector list->vector -f_lambda vector_to_list vector->list -f_lambda vector_length vector-length -f_lambda vectorp vector? +BIGINT feature bigint +all atom eof +all atom else +all f_lambda eval +all f_lambda read +all nlambda lambda +all nlambda nlambda +all nlambda macro +all f_lambda car +all f_lambda cdr +all f_lambda cons +all f_lambda last +all f_lambda length +all f_lambda list_copy list-copy +all nlambda quote +QUASI atom quasiquote +QUASI atom unquote +QUASI atom unquote_splicing unquote-splicing +all f_lambda set +all macro setq set! +all f_lambda def +all nlambda cond +all nlambda begin +all nlambda while +all f_lambda write +all f_lambda display +all f_lambda plus + string-append +all f_lambda minus - +all f_lambda times * +all f_lambda divide / +all f_lambda modulo modulo % +all f_lambda remainder +all f_lambda quotient +all f_lambda equal = eq? eqv? +all f_lambda less < string<? +all f_lambda greater > string>? +all f_lambda less_equal <= string<=? +all f_lambda greater_equal >= string>=? +all f_lambda flush_output flush-output +TIME f_lambda delay +GPIO f_lambda led +all f_lambda save +all f_lambda restore +all f_lambda call_cc call-with-current-continuation call/cc +all f_lambda collect +all f_lambda nullp null? +all f_lambda not +all f_lambda listp list? +all f_lambda pairp pair? +all f_lambda integerp integer? exact? exact-integer? +all f_lambda numberp number? real? +all f_lambda booleanp boolean? +all f_lambda set_car set-car! +all f_lambda set_cdr set-cdr! +all f_lambda symbolp symbol? +all f_lambda list_to_string list->string +all f_lambda string_to_list string->list +all f_lambda symbol_to_string symbol->string +all f_lambda string_to_symbol string->symbol +all f_lambda stringp string? +all f_lambda string_ref string-ref +all f_lambda string_set string-set! +all f_lambda string_copy string-copy +all f_lambda string_length string-length +all f_lambda procedurep procedure? +all lambda apply +all f_lambda read_char read-char +all f_lambda write_char write-char +all f_lambda exit +TIME f_lambda current_jiffy current-jiffy +TIME f_lambda current_second current-second +TIME f_lambda jiffies_per_second jiffies-per-second +FLOAT f_lambda finitep finite? +FLOAT f_lambda infinitep infinite? +FLOAT f_lambda inexactp inexact? +FLOAT f_lambda sqrt +VECTOR f_lambda vector_ref vector-ref +VECTOR f_lambda vector_set vector-set! +VECTOR f_lambda vector +VECTOR f_lambda make_vector make-vector +VECTOR f_lambda list_to_vector list->vector +VECTOR f_lambda vector_to_list vector->list +VECTOR f_lambda vector_length vector-length +VECTOR f_lambda vectorp vector? diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index 02512e15..a9ff5acd 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -24,8 +24,8 @@ static void cons_mark(void *addr) ao_scheme_poly_mark(cons->car, 1); if (!cdr) break; - if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) { - ao_scheme_poly_mark(cdr, 1); + if (!ao_scheme_is_cons(cdr)) { + ao_scheme_poly_mark(cdr, 0); break; } cons = ao_scheme_poly_cons(cdr); @@ -58,7 +58,7 @@ static void cons_move(void *addr) cdr = cons->cdr; if (!cdr) break; - if (ao_scheme_poly_base_type(cdr) != AO_SCHEME_CONS) { + if (!ao_scheme_is_cons(cdr)) { (void) ao_scheme_poly_move(&cons->cdr, 0); break; } @@ -92,11 +92,11 @@ ao_scheme_cons_cons(ao_poly car, ao_poly cdr) cons = ao_scheme_cons_free_list; ao_scheme_cons_free_list = ao_scheme_poly_cons(cons->cdr); } else { - ao_scheme_poly_stash(0, car); - ao_scheme_poly_stash(1, cdr); + ao_scheme_poly_stash(car); + ao_scheme_poly_stash(cdr); cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); - cdr = ao_scheme_poly_fetch(1); - car = ao_scheme_poly_fetch(0); + cdr = ao_scheme_poly_fetch(); + car = ao_scheme_poly_fetch(); if (!cons) return NULL; } @@ -111,7 +111,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) ao_poly cdr = cons->cdr; if (cdr == AO_SCHEME_NIL) return NULL; - if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) { + if (!ao_scheme_is_cons(cdr)) { (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr); return NULL; } @@ -119,7 +119,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) } ao_poly -ao_scheme__cons(ao_poly car, ao_poly cdr) +ao_scheme_cons(ao_poly car, ao_poly cdr) { return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr)); } @@ -134,13 +134,13 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons) struct ao_scheme_cons *new; ao_poly cdr; - ao_scheme_cons_stash(0, cons); - ao_scheme_cons_stash(1, head); - ao_scheme_poly_stash(0, ao_scheme_cons_poly(tail)); + ao_scheme_cons_stash(cons); + ao_scheme_cons_stash(head); + ao_scheme_cons_stash(tail); new = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); - cons = ao_scheme_cons_fetch(0); - head = ao_scheme_cons_fetch(1); - tail = ao_scheme_poly_cons(ao_scheme_poly_fetch(0)); + tail = ao_scheme_cons_fetch(); + head = ao_scheme_cons_fetch(); + cons = ao_scheme_cons_fetch(); if (!new) return AO_SCHEME_NIL; new->car = cons->car; @@ -151,7 +151,7 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons) tail->cdr = ao_scheme_cons_poly(new); tail = new; cdr = cons->cdr; - if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) { + if (!ao_scheme_is_cons(cdr)) { tail->cdr = cdr; break; } @@ -175,52 +175,51 @@ ao_scheme_cons_free(struct ao_scheme_cons *cons) } void -ao_scheme_cons_write(ao_poly c) +ao_scheme_cons_write(ao_poly c, bool write) { struct ao_scheme_cons *cons = ao_scheme_poly_cons(c); + struct ao_scheme_cons *clear = cons; ao_poly cdr; - int first = 1; + int written = 0; + ao_scheme_print_start(); printf("("); while (cons) { - if (!first) + if (written != 0) printf(" "); - ao_scheme_poly_write(cons->car); - cdr = cons->cdr; - if (cdr == c) { - printf(" ..."); + + /* Note if there's recursion in printing. Not + * as good as actual references, but at least + * we don't infinite loop... + */ + if (ao_scheme_print_mark_addr(cons)) { + printf("..."); break; } - if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) { - cons = ao_scheme_poly_cons(cdr); - first = 0; - } else { + + ao_scheme_poly_write(cons->car, write); + + /* keep track of how many pairs have been printed */ + written++; + + cdr = cons->cdr; + if (!ao_scheme_is_cons(cdr)) { printf(" . "); - ao_scheme_poly_write(cdr); - cons = NULL; + ao_scheme_poly_write(cdr, write); + break; } + cons = ao_scheme_poly_cons(cdr); } printf(")"); -} -void -ao_scheme_cons_display(ao_poly c) -{ - struct ao_scheme_cons *cons = ao_scheme_poly_cons(c); - ao_poly cdr; + if (ao_scheme_print_stop()) { - while (cons) { - ao_scheme_poly_display(cons->car); - cdr = cons->cdr; - if (cdr == c) { - printf("..."); - break; - } - if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) - cons = ao_scheme_poly_cons(cdr); - else { - ao_scheme_poly_display(cdr); - cons = NULL; + /* If we're still printing, clear the print marks on + * all printed pairs + */ + while (written--) { + ao_scheme_print_clear_addr(clear); + clear = ao_scheme_poly_cons(clear->cdr); } } } diff --git a/src/scheme/ao_scheme_const.scheme b/src/scheme/ao_scheme_const.scheme index ab6a309a..4616477f 100644 --- a/src/scheme/ao_scheme_const.scheme +++ b/src/scheme/ao_scheme_const.scheme @@ -248,7 +248,7 @@ (macro (first . rest) ; check for alternate lambda definition form - (cond ((list? first) + (cond ((pair? first) (set! rest (append (list @@ -640,7 +640,7 @@ (char-whitespace? #\0) (char-whitespace? #\space) -(define (char->integer c) c) +(define char->integer (macro (v) v)) (define integer->char char->integer) (define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c)) @@ -805,9 +805,3 @@ ) (case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) - -;(define number->string (lambda (arg . opt) -; (let ((base (if (null? opt) 10 (car opt))) - ; -; - diff --git a/src/scheme/ao_scheme_error.c b/src/scheme/ao_scheme_error.c index d580a2c0..6a71ca51 100644 --- a/src/scheme/ao_scheme_error.c +++ b/src/scheme/ao_scheme_error.c @@ -16,74 +16,7 @@ #include <stdarg.h> void -ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last) -{ - int first = 1; - printf("\t\t%s(", name); - if (ao_scheme_poly_type(poly) == AO_SCHEME_CONS) { - if (poly) { - while (poly) { - struct ao_scheme_cons *cons = ao_scheme_poly_cons(poly); - if (!first) - printf("\t\t "); - else - first = 0; - ao_scheme_poly_write(cons->car); - printf("\n"); - if (poly == last) - break; - poly = cons->cdr; - } - printf("\t\t )\n"); - } else - printf(")\n"); - } else { - ao_scheme_poly_write(poly); - printf("\n"); - } -} - -static void tabs(int indent) -{ - while (indent--) - printf("\t"); -} - -void -ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame) -{ - int f; - - tabs(indent); - printf ("%s{", name); - if (frame) { - struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); - if (frame->type & AO_SCHEME_FRAME_PRINT) - printf("recurse..."); - else { - frame->type |= AO_SCHEME_FRAME_PRINT; - for (f = 0; f < frame->num; f++) { - if (f != 0) { - tabs(indent); - printf(" "); - } - ao_scheme_poly_write(vals->vals[f].atom); - printf(" = "); - ao_scheme_poly_write(vals->vals[f].val); - printf("\n"); - } - if (frame->prev) - ao_scheme_error_frame(indent + 1, "prev: ", ao_scheme_poly_frame(frame->prev)); - frame->type &= ~AO_SCHEME_FRAME_PRINT; - } - tabs(indent); - printf(" }\n"); - } else - printf ("}\n"); -} - -void -ao_scheme_vprintf(char *format, va_list args) +ao_scheme_vprintf(const char *format, va_list args) { char c; @@ -91,7 +24,10 @@ ao_scheme_vprintf(char *format, va_list args) if (c == '%') { switch (c = *format++) { case 'v': - ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int)); + ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), true); + break; + case 'V': + ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), false); break; case 'p': printf("%p", va_arg(args, void *)); @@ -112,7 +48,7 @@ ao_scheme_vprintf(char *format, va_list args) } void -ao_scheme_printf(char *format, ...) +ao_scheme_printf(const char *format, ...) { va_list args; va_start(args, format); @@ -121,7 +57,7 @@ ao_scheme_printf(char *format, ...) } ao_poly -ao_scheme_error(int error, char *format, ...) +ao_scheme_error(int error, const char *format, ...) { va_list args; @@ -133,7 +69,7 @@ ao_scheme_error(int error, char *format, ...) ao_scheme_printf("Value: %v\n", ao_scheme_v); ao_scheme_printf("Frame: %v\n", ao_scheme_frame_poly(ao_scheme_frame_current)); printf("Stack:\n"); - ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack)); + ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true); ao_scheme_printf("Globals: %v\n", ao_scheme_frame_poly(ao_scheme_frame_global)); return AO_SCHEME_NIL; } diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c index 907ecf0b..91f6a84f 100644 --- a/src/scheme/ao_scheme_eval.c +++ b/src/scheme/ao_scheme_eval.c @@ -17,7 +17,6 @@ struct ao_scheme_stack *ao_scheme_stack; ao_poly ao_scheme_v; -uint8_t ao_scheme_skip_cons_free; ao_poly ao_scheme_set_cond(struct ao_scheme_cons *c) @@ -207,7 +206,7 @@ ao_scheme_eval_formal(void) } /* Append formal to list of values */ - formal = ao_scheme__cons(ao_scheme_v, AO_SCHEME_NIL); + formal = ao_scheme_cons(ao_scheme_v, AO_SCHEME_NIL); if (!formal) return 0; @@ -265,7 +264,7 @@ ao_scheme_eval_exec(void) DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n"); }); builtin = ao_scheme_poly_builtin(ao_scheme_v); - if (builtin && (builtin->args & AO_SCHEME_FUNC_FREE_ARGS) && !ao_scheme_stack_marked(ao_scheme_stack) && !ao_scheme_skip_cons_free) { + if (builtin && (builtin->args & AO_SCHEME_FUNC_FREE_ARGS) && !ao_scheme_stack_marked(ao_scheme_stack)) { struct ao_scheme_cons *cons = ao_scheme_poly_cons(ao_scheme_stack->values); ao_scheme_stack->values = AO_SCHEME_NIL; ao_scheme_cons_free(cons); @@ -294,7 +293,6 @@ ao_scheme_eval_exec(void) DBGI(".. frame "); DBG_POLY(ao_scheme_frame_poly(ao_scheme_frame_current)); DBG("\n"); break; } - ao_scheme_skip_cons_free = 0; return 1; } @@ -325,7 +323,7 @@ ao_scheme_eval_apply(void) ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->values)->car; DBGI("apply: "); DBG_POLY(ao_scheme_stack->values); DBG ("\n"); ao_scheme_stack->state = eval_exec; - ao_scheme_skip_cons_free = 1; + ao_scheme_stack_mark(ao_scheme_stack); return 1; } @@ -350,7 +348,7 @@ ao_scheme_eval_cond(void) ao_scheme_stack->state = eval_val; } else { ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->sexprs)->car; - if (!ao_scheme_v || ao_scheme_poly_type(ao_scheme_v) != AO_SCHEME_CONS) { + if (!ao_scheme_is_pair(ao_scheme_v)) { ao_scheme_error(AO_SCHEME_INVALID, "invalid cond clause"); return 0; } @@ -494,7 +492,7 @@ ao_scheme_eval_macro(void) if (ao_scheme_v == AO_SCHEME_NIL) ao_scheme_abort(); - if (ao_scheme_poly_type(ao_scheme_v) == AO_SCHEME_CONS) { + if (ao_scheme_is_cons(ao_scheme_v)) { *ao_scheme_poly_cons(ao_scheme_stack->sexprs) = *ao_scheme_poly_cons(ao_scheme_v); ao_scheme_v = ao_scheme_stack->sexprs; DBGI("sexprs rewritten to: "); DBG_POLY(ao_scheme_v); DBG("\n"); diff --git a/src/scheme/ao_scheme_float.c b/src/scheme/ao_scheme_float.c index 99249030..d8501548 100644 --- a/src/scheme/ao_scheme_float.c +++ b/src/scheme/ao_scheme_float.c @@ -15,6 +15,8 @@ #include "ao_scheme.h" #include <math.h> +#ifdef AO_SCHEME_FEATURE_FLOAT + static void float_mark(void *addr) { (void) addr; @@ -44,11 +46,12 @@ const struct ao_scheme_type ao_scheme_float_type = { #endif void -ao_scheme_float_write(ao_poly p) +ao_scheme_float_write(ao_poly p, bool write) { struct ao_scheme_float *f = ao_scheme_poly_float(p); float v = f->value; + (void) write; if (isnanf(v)) printf("+nan.0"); else if (isinff(v)) { @@ -67,10 +70,10 @@ ao_scheme_poly_number(ao_poly p) switch (ao_scheme_poly_base_type(p)) { case AO_SCHEME_INT: return ao_scheme_poly_int(p); + case AO_SCHEME_BIGINT: + return ao_scheme_poly_bigint(p)->value; case AO_SCHEME_OTHER: switch (ao_scheme_other_type(ao_scheme_poly_other(p))) { - case AO_SCHEME_BIGINT: - return ao_scheme_bigint_int(ao_scheme_poly_bigint(p)->value); case AO_SCHEME_FLOAT: return ao_scheme_poly_float(p)->value; } @@ -150,3 +153,4 @@ ao_scheme_do_sqrt(struct ao_scheme_cons *cons) return ao_scheme_error(AO_SCHEME_INVALID, "%s: non-numeric", ao_scheme_poly_atom(_ao_scheme_atom_sqrt)->name); return ao_scheme_float_get(sqrtf(ao_scheme_poly_number(value))); } +#endif diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c index e5d481e7..16da62fb 100644 --- a/src/scheme/ao_scheme_frame.c +++ b/src/scheme/ao_scheme_frame.c @@ -41,7 +41,6 @@ frame_vals_mark(void *addr) ao_scheme_poly_atom(v->atom)->name, MDBG_OFFSET(ao_scheme_ref(v->atom)), MDBG_OFFSET(ao_scheme_ref(v->val)), f); - MDBG_DO(ao_scheme_poly_write(v->val)); MDBG_DO(printf("\n")); } } @@ -84,10 +83,11 @@ frame_mark(void *addr) struct ao_scheme_frame *frame = addr; for (;;) { + struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); + MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame)); - if (!AO_SCHEME_IS_POOL(frame)) - break; - ao_scheme_poly_mark(frame->vals, 0); + if (!ao_scheme_mark_memory(&ao_scheme_frame_vals_type, vals)) + frame_vals_mark(vals); frame = ao_scheme_poly_frame(frame->prev); MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame)); if (!frame) @@ -103,13 +103,17 @@ frame_move(void *addr) struct ao_scheme_frame *frame = addr; for (;;) { - struct ao_scheme_frame *prev; - int ret; + struct ao_scheme_frame *prev; + struct ao_scheme_frame_vals *vals; + int ret; MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame)); - if (!AO_SCHEME_IS_POOL(frame)) - break; - ao_scheme_poly_move(&frame->vals, 0); + vals = ao_scheme_poly_frame_vals(frame->vals); + if (!ao_scheme_move_memory(&ao_scheme_frame_vals_type, (void **) &vals)) + frame_vals_move(vals); + if (vals != ao_scheme_poly_frame_vals(frame->vals)) + frame->vals = ao_scheme_frame_vals_poly(vals); + prev = ao_scheme_poly_frame(frame->prev); if (!prev) break; @@ -133,32 +137,53 @@ const struct ao_scheme_type ao_scheme_frame_type = { .name = "frame", }; +int ao_scheme_frame_print_indent; + +static void +ao_scheme_frame_indent(int extra) +{ + int i; + putchar('\n'); + for (i = 0; i < ao_scheme_frame_print_indent+extra; i++) + putchar('\t'); +} + void -ao_scheme_frame_write(ao_poly p) +ao_scheme_frame_write(ao_poly p, bool write) { struct ao_scheme_frame *frame = ao_scheme_poly_frame(p); + struct ao_scheme_frame *clear = frame; struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); int f; + int written = 0; - printf ("{"); - if (frame) { - if (frame->type & AO_SCHEME_FRAME_PRINT) + ao_scheme_print_start(); + while (frame) { + if (written != 0) + printf(", "); + if (ao_scheme_print_mark_addr(frame)) { printf("recurse..."); - else { - frame->type |= AO_SCHEME_FRAME_PRINT; - for (f = 0; f < frame->num; f++) { - if (f != 0) - printf(", "); - ao_scheme_poly_write(vals->vals[f].atom); - printf(" = "); - ao_scheme_poly_write(vals->vals[f].val); - } - if (frame->prev) - ao_scheme_poly_write(frame->prev); - frame->type &= ~AO_SCHEME_FRAME_PRINT; + break; + } + + putchar('{'); + written++; + for (f = 0; f < frame->num; f++) { + ao_scheme_frame_indent(1); + ao_scheme_poly_write(vals->vals[f].atom, write); + printf(" = "); + ao_scheme_poly_write(vals->vals[f].val, write); + } + frame = ao_scheme_poly_frame(frame->prev); + ao_scheme_frame_indent(0); + putchar('}'); + } + if (ao_scheme_print_stop()) { + while (written--) { + ao_scheme_print_clear_addr(clear); + clear = ao_scheme_poly_frame(clear->prev); } } - printf("}"); } static int @@ -225,9 +250,9 @@ ao_scheme_frame_new(int num) frame->num = 0; frame->prev = AO_SCHEME_NIL; frame->vals = AO_SCHEME_NIL; - ao_scheme_frame_stash(0, frame); + ao_scheme_frame_stash(frame); vals = ao_scheme_frame_vals_new(num); - frame = ao_scheme_frame_fetch(0); + frame = ao_scheme_frame_fetch(); if (!vals) return NULL; frame->vals = ao_scheme_frame_vals_poly(vals); @@ -271,9 +296,9 @@ ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num) if (new_num == frame->num) return frame; - ao_scheme_frame_stash(0, frame); + ao_scheme_frame_stash(frame); new_vals = ao_scheme_frame_vals_new(new_num); - frame = ao_scheme_frame_fetch(0); + frame = ao_scheme_frame_fetch(); if (!new_vals) return NULL; vals = ao_scheme_poly_frame_vals(frame->vals); @@ -306,11 +331,11 @@ ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val) if (!ref) { int f = frame->num; - ao_scheme_poly_stash(0, atom); - ao_scheme_poly_stash(1, val); + ao_scheme_poly_stash(atom); + ao_scheme_poly_stash(val); frame = ao_scheme_frame_realloc(frame, f + 1); - val = ao_scheme_poly_fetch(1); - atom = ao_scheme_poly_fetch(0); + val = ao_scheme_poly_fetch(); + atom = ao_scheme_poly_fetch(); if (!frame) return AO_SCHEME_NIL; ao_scheme_frame_bind(frame, frame->num - 1, atom, val); diff --git a/src/scheme/ao_scheme_int.c b/src/scheme/ao_scheme_int.c index 350a5d35..01b571c0 100644 --- a/src/scheme/ao_scheme_int.c +++ b/src/scheme/ao_scheme_int.c @@ -15,23 +15,29 @@ #include "ao_scheme.h" void -ao_scheme_int_write(ao_poly p) +ao_scheme_int_write(ao_poly p, bool write) { int i = ao_scheme_poly_int(p); + (void) write; printf("%d", i); } +#ifdef AO_SCHEME_FEATURE_BIGINT + int32_t -ao_scheme_poly_integer(ao_poly p) +ao_scheme_poly_integer(ao_poly p, bool *fail) { + if (fail) + *fail = false; switch (ao_scheme_poly_base_type(p)) { case AO_SCHEME_INT: return ao_scheme_poly_int(p); - case AO_SCHEME_OTHER: - if (ao_scheme_other_type(ao_scheme_poly_other(p)) == AO_SCHEME_BIGINT) - return ao_scheme_bigint_int(ao_scheme_poly_bigint(p)->value); + case AO_SCHEME_BIGINT: + return ao_scheme_poly_bigint(p)->value; } - return AO_SCHEME_NOT_INTEGER; + if (fail) + *fail = true; + return 0; } ao_poly @@ -42,7 +48,7 @@ ao_scheme_integer_poly(int32_t p) if (AO_SCHEME_MIN_INT <= p && p <= AO_SCHEME_MAX_INT) return ao_scheme_int_poly(p); bi = ao_scheme_alloc(sizeof (struct ao_scheme_bigint)); - bi->value = ao_scheme_int_bigint(p); + bi->value = p; return ao_scheme_bigint_poly(bi); } @@ -71,9 +77,11 @@ const struct ao_scheme_type ao_scheme_bigint_type = { }; void -ao_scheme_bigint_write(ao_poly p) +ao_scheme_bigint_write(ao_poly p, bool write) { struct ao_scheme_bigint *bi = ao_scheme_poly_bigint(p); - printf("%d", ao_scheme_bigint_int(bi->value)); + (void) write; + printf("%d", bi->value); } +#endif /* AO_SCHEME_FEATURE_BIGINT */ diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c index ec6f858c..e818d7b0 100644 --- a/src/scheme/ao_scheme_lambda.c +++ b/src/scheme/ao_scheme_lambda.c @@ -17,14 +17,14 @@ #include "ao_scheme.h" -int +static int lambda_size(void *addr) { (void) addr; return sizeof (struct ao_scheme_lambda); } -void +static void lambda_mark(void *addr) { struct ao_scheme_lambda *lambda = addr; @@ -33,7 +33,7 @@ lambda_mark(void *addr) ao_scheme_poly_mark(lambda->frame, 0); } -void +static void lambda_move(void *addr) { struct ao_scheme_lambda *lambda = addr; @@ -50,7 +50,7 @@ const struct ao_scheme_type ao_scheme_lambda_type = { }; void -ao_scheme_lambda_write(ao_poly poly) +ao_scheme_lambda_write(ao_poly poly, bool write) { struct ao_scheme_lambda *lambda = ao_scheme_poly_lambda(poly); struct ao_scheme_cons *cons = ao_scheme_poly_cons(lambda->code); @@ -59,13 +59,13 @@ ao_scheme_lambda_write(ao_poly poly) printf("%s", ao_scheme_args_name(lambda->args)); while (cons) { printf(" "); - ao_scheme_poly_write(cons->car); + ao_scheme_poly_write(cons->car, write); cons = ao_scheme_poly_cons(cons->cdr); } printf(")"); } -ao_poly +static ao_poly ao_scheme_lambda_alloc(struct ao_scheme_cons *code, int args) { struct ao_scheme_lambda *lambda; @@ -89,9 +89,9 @@ ao_scheme_lambda_alloc(struct ao_scheme_cons *code, int args) } } - ao_scheme_cons_stash(0, code); + ao_scheme_cons_stash(code); lambda = ao_scheme_alloc(sizeof (struct ao_scheme_lambda)); - code = ao_scheme_cons_fetch(0); + code = ao_scheme_cons_fetch(); if (!lambda) return AO_SCHEME_NIL; @@ -160,9 +160,9 @@ ao_scheme_lambda_eval(void) return ao_scheme_error(AO_SCHEME_INVALID, "need at least %d args, got %d", args_wanted, args_provided); } - ao_scheme_poly_stash(1, varargs); + ao_scheme_poly_stash(varargs); next_frame = ao_scheme_frame_new(args_wanted + (varargs != AO_SCHEME_NIL)); - varargs = ao_scheme_poly_fetch(1); + varargs = ao_scheme_poly_fetch(); if (!next_frame) return AO_SCHEME_NIL; diff --git a/src/scheme/ao_scheme_make_builtin b/src/scheme/ao_scheme_make_builtin index 8e9c2c0b..a4d8326f 100644 --- a/src/scheme/ao_scheme_make_builtin +++ b/src/scheme/ao_scheme_make_builtin @@ -1,6 +1,7 @@ #!/usr/bin/nickle typedef struct { + string feature; string type; string c_name; string[*] lisp_names; @@ -12,6 +13,7 @@ string[string] type_map = { "macro" => "MACRO", "f_lambda" => "F_LAMBDA", "atom" => "atom", + "feature" => "feature", }; string[*] @@ -19,9 +21,9 @@ make_lisp(string[*] tokens) { string[...] lisp = {}; - if (dim(tokens) < 3) + if (dim(tokens) < 4) return (string[1]) { tokens[dim(tokens) - 1] }; - return (string[dim(tokens)-2]) { [i] = tokens[i+2] }; + return (string[dim(tokens)-3]) { [i] = tokens[i+3] }; } builtin_t @@ -30,8 +32,9 @@ read_builtin(file f) { string[*] tokens = String::wordsplit(line, " \t"); return (builtin_t) { - .type = dim(tokens) > 0 ? type_map[tokens[0]] : "#", - .c_name = dim(tokens) > 1 ? tokens[1] : "#", + .feature = dim(tokens) > 0 ? tokens[0] : "#", + .type = dim(tokens) > 1 ? type_map[tokens[1]] : "#", + .c_name = dim(tokens) > 2 ? tokens[2] : "#", .lisp_names = make_lisp(tokens), }; } @@ -49,16 +52,37 @@ read_builtins(file f) { return builtins; } +void +dump_ifdef(builtin_t builtin) +{ + if (builtin.feature != "all") + printf("#ifdef AO_SCHEME_FEATURE_%s\n", builtin.feature); +} + +void +dump_endif(builtin_t builtin) +{ + if (builtin.feature != "all") + printf("#endif /* AO_SCHEME_FEATURE_%s */\n", builtin.feature); +} + bool is_atom(builtin_t b) = b.type == "atom"; +bool is_func(builtin_t b) = b.type != "atom" && b.type != "feature"; + +bool is_feature(builtin_t b) = b.type == "feature"; + void dump_ids(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_ID\n"); printf("#undef AO_SCHEME_BUILTIN_ID\n"); printf("enum ao_scheme_builtin_id {\n"); for (int i = 0; i < dim(builtins); i++) - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\tbuiltin_%s,\n", builtins[i].c_name); + dump_endif(builtins[i]); + } printf("\t_builtin_last\n"); printf("};\n"); printf("#endif /* AO_SCHEME_BUILTIN_ID */\n"); @@ -71,10 +95,13 @@ dump_casename(builtin_t[*] builtins) { printf("static char *ao_scheme_builtin_name(enum ao_scheme_builtin_id b) {\n"); printf("\tswitch(b) {\n"); for (int i = 0; i < dim(builtins); i++) - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\tcase builtin_%s: return ao_scheme_poly_atom(_atom(\"%s\"))->name;\n", builtins[i].c_name, builtins[i].lisp_names[0]); - printf("\tdefault: return \"???\";\n"); + dump_endif(builtins[i]); + } + printf("\tdefault: return (char *) \"???\";\n"); printf("\t}\n"); printf("}\n"); printf("#endif /* AO_SCHEME_BUILTIN_CASENAME */\n"); @@ -97,11 +124,13 @@ dump_arrayname(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_ARRAYNAME\n"); printf("static const ao_poly builtin_names[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\t[builtin_%s] = _ao_scheme_atom_", builtins[i].c_name); cify_lisp(builtins[i].lisp_names[0]); printf(",\n"); + dump_endif(builtins[i]); } } printf("};\n"); @@ -114,10 +143,13 @@ dump_funcs(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_FUNCS\n"); printf("const ao_scheme_func_t ao_scheme_builtins[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\t[builtin_%s] = ao_scheme_do_%s,\n", builtins[i].c_name, builtins[i].c_name); + dump_endif(builtins[i]); + } } printf("};\n"); printf("#endif /* AO_SCHEME_BUILTIN_FUNCS */\n"); @@ -128,10 +160,12 @@ dump_decls(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_DECLS\n"); printf("#undef AO_SCHEME_BUILTIN_DECLS\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("ao_poly\n"); printf("ao_scheme_do_%s(struct ao_scheme_cons *cons);\n", builtins[i].c_name); + dump_endif(builtins[i]); } } printf("#endif /* AO_SCHEME_BUILTIN_DECLS */\n"); @@ -143,13 +177,16 @@ dump_consts(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_CONSTS\n"); printf("struct builtin_func funcs[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); for (int j = 0; j < dim(builtins[i].lisp_names); j++) { - printf ("\t{ .name = \"%s\", .args = AO_SCHEME_FUNC_%s, .func = builtin_%s },\n", + printf ("\t{ .feature = \"%s\", .name = \"%s\", .args = AO_SCHEME_FUNC_%s, .func = builtin_%s },\n", + builtins[i].feature, builtins[i].lisp_names[j], builtins[i].type, builtins[i].c_name); } + dump_endif(builtins[i]); } } printf("};\n"); @@ -161,15 +198,60 @@ dump_atoms(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_ATOMS\n"); printf("#undef AO_SCHEME_BUILTIN_ATOMS\n"); for (int i = 0; i < dim(builtins); i++) { - for (int j = 0; j < dim(builtins[i].lisp_names); j++) { - printf("#define _ao_scheme_atom_"); - cify_lisp(builtins[i].lisp_names[j]); - printf(" _atom(\"%s\")\n", builtins[i].lisp_names[j]); + if (!is_feature(builtins[i])) { + for (int j = 0; j < dim(builtins[i].lisp_names); j++) { + printf("#define _ao_scheme_atom_"); + cify_lisp(builtins[i].lisp_names[j]); + printf(" _atom(\"%s\")\n", builtins[i].lisp_names[j]); + } } } printf("#endif /* AO_SCHEME_BUILTIN_ATOMS */\n"); } +void +dump_atom_names(builtin_t[*] builtins) { + printf("#ifdef AO_SCHEME_BUILTIN_ATOM_NAMES\n"); + printf("#undef AO_SCHEME_BUILTIN_ATOM_NAMES\n"); + printf("static struct builtin_atom atoms[] = {\n"); + for (int i = 0; i < dim(builtins); i++) { + if (is_atom(builtins[i])) { + for (int j = 0; j < dim(builtins[i].lisp_names); j++) { + printf("\t{ .feature = \"%s\", .name = \"%s\" },\n", + builtins[i].feature, + builtins[i].lisp_names[j]); + } + } + } + printf("};\n"); + printf("#endif /* AO_SCHEME_BUILTIN_ATOM_NAMES */\n"); +} + +bool +has_feature(string[*] features, string feature) +{ + for (int i = 0; i < dim(features); i++) + if (features[i] == feature) + return true; + return false; +} + +void +dump_features(builtin_t[*] builtins) { + string[...] features = {}; + printf("#ifdef AO_SCHEME_BUILTIN_FEATURES\n"); + for (int i = 0; i < dim(builtins); i++) { + if (builtins[i].feature != "all") { + string feature = builtins[i].feature; + if (!has_feature(features, feature)) { + features[dim(features)] = feature; + printf("#define AO_SCHEME_FEATURE_%s\n", feature); + } + } + } + printf("#endif /* AO_SCHEME_BUILTIN_FEATURES */\n"); +} + void main() { if (dim(argv) < 2) { File::fprintf(stderr, "usage: %s <file>\n", argv[0]); @@ -177,6 +259,8 @@ void main() { } twixt(file f = File::open(argv[1], "r"); File::close(f)) { builtin_t[*] builtins = read_builtins(f); + + printf("/* %d builtins */\n", dim(builtins)); dump_ids(builtins); dump_casename(builtins); dump_arrayname(builtins); @@ -184,6 +268,8 @@ void main() { dump_decls(builtins); dump_consts(builtins); dump_atoms(builtins); + dump_atom_names(builtins); + dump_features(builtins); } } diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c index cf42ec52..e34792c4 100644 --- a/src/scheme/ao_scheme_make_const.c +++ b/src/scheme/ao_scheme_make_const.c @@ -17,6 +17,7 @@ #include <ctype.h> #include <unistd.h> #include <getopt.h> +#include <stdbool.h> static struct ao_scheme_builtin * ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) { @@ -29,15 +30,25 @@ ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) { } struct builtin_func { - char *name; - int args; + const char *feature; + const char *name; + int args; enum ao_scheme_builtin_id func; }; +struct builtin_atom { + const char *feature; + const char *name; +}; + #define AO_SCHEME_BUILTIN_CONSTS +#define AO_SCHEME_BUILTIN_ATOM_NAMES + #include "ao_scheme_builtin.h" -#define N_FUNC (sizeof funcs / sizeof funcs[0]) +#define N_FUNC (sizeof funcs / sizeof funcs[0]) + +#define N_ATOM (sizeof atoms / sizeof atoms[0]) struct ao_scheme_frame *globals; @@ -69,7 +80,7 @@ ao_fec_crc_byte(uint8_t byte, uint16_t crc) return crc; } -uint16_t +static uint16_t ao_fec_crc(const uint8_t *bytes, uint8_t len) { uint16_t crc = AO_FEC_CRC_INIT; @@ -86,7 +97,7 @@ struct ao_scheme_macro_stack { struct ao_scheme_macro_stack *macro_stack; -int +static int ao_scheme_macro_push(ao_poly p) { struct ao_scheme_macro_stack *m = macro_stack; @@ -103,7 +114,7 @@ ao_scheme_macro_push(ao_poly p) return 0; } -void +static void ao_scheme_macro_pop(void) { struct ao_scheme_macro_stack *m = macro_stack; @@ -130,7 +141,7 @@ void indent(void) ao_poly ao_has_macro(ao_poly p); -ao_poly +static ao_poly ao_macro_test_get(ao_poly atom) { ao_poly *ref = ao_scheme_atom_ref(atom, NULL); @@ -139,7 +150,7 @@ ao_macro_test_get(ao_poly atom) return AO_SCHEME_NIL; } -ao_poly +static ao_poly ao_is_macro(ao_poly p) { struct ao_scheme_builtin *builtin; @@ -209,7 +220,7 @@ ao_has_macro(ao_poly p) list = cons->cdr; p = AO_SCHEME_NIL; - while (list != AO_SCHEME_NIL && ao_scheme_poly_type(list) == AO_SCHEME_CONS) { + while (ao_scheme_is_pair(list)) { cons = ao_scheme_poly_cons(list); m = ao_has_macro(cons->car); if (m) { @@ -228,7 +239,37 @@ ao_has_macro(ao_poly p) return p; } -int +static struct ao_scheme_builtin * +ao_scheme_get_builtin(ao_poly p) +{ + if (ao_scheme_poly_type(p) == AO_SCHEME_BUILTIN) + return ao_scheme_poly_builtin(p); + return NULL; +} + +struct seen_builtin { + struct seen_builtin *next; + struct ao_scheme_builtin *builtin; +}; + +static struct seen_builtin *seen_builtins; + +static int +ao_scheme_seen_builtin(struct ao_scheme_builtin *b) +{ + struct seen_builtin *s; + + for (s = seen_builtins; s; s = s->next) + if (s->builtin == b) + return 1; + s = malloc (sizeof (struct seen_builtin)); + s->builtin = b; + s->next = seen_builtins; + seen_builtins = s; + return 0; +} + +static int ao_scheme_read_eval_abort(void) { ao_poly in, out = AO_SCHEME_NIL; @@ -239,7 +280,7 @@ ao_scheme_read_eval_abort(void) out = ao_scheme_eval(in); if (ao_scheme_exception) return 0; - ao_scheme_poly_write(out); + ao_scheme_poly_write(out, true); putchar ('\n'); } return 1; @@ -248,6 +289,50 @@ ao_scheme_read_eval_abort(void) static FILE *in; static FILE *out; +struct feature { + struct feature *next; + char name[]; +}; + +static struct feature *enable; +static struct feature *disable; + +static void +ao_scheme_add_feature(struct feature **list, char *name) +{ + struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1); + strcpy(feature->name, name); + feature->next = *list; + *list = feature; +} + +static bool +ao_scheme_has_feature(struct feature *list, const char *name) +{ + while (list) { + if (!strcmp(list->name, name)) + return true; + list = list->next; + } + return false; +} + +static void +ao_scheme_add_features(struct feature **list, const char *names) +{ + char *saveptr = NULL; + char *name; + char *copy = strdup(names); + char *save = copy; + + while ((name = strtok_r(copy, ",", &saveptr)) != NULL) { + copy = NULL; + if (!ao_scheme_has_feature(*list, name)) + ao_scheme_add_feature(list, name); + } + free(save); +} + int ao_scheme_getc(void) { @@ -256,35 +341,46 @@ ao_scheme_getc(void) static const struct option options[] = { { .name = "out", .has_arg = 1, .val = 'o' }, + { .name = "disable", .has_arg = 1, .val = 'd' }, + { .name = "enable", .has_arg = 1, .val = 'e' }, { 0, 0, 0, 0 } }; static void usage(char *program) { - fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program); + fprintf(stderr, "usage: %s [--out=<output>] [--disable={feature,...}] [--enable={feature,...} [input]\n", program); exit(1); } int main(int argc, char **argv) { - int f, o; + int f, o, an; ao_poly val; struct ao_scheme_atom *a; struct ao_scheme_builtin *b; + struct feature *d; int in_atom = 0; char *out_name = NULL; int c; enum ao_scheme_builtin_id prev_func; + enum ao_scheme_builtin_id target_func; + enum ao_scheme_builtin_id func_map[_builtin_last]; in = stdin; out = stdout; - while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) { + while ((c = getopt_long(argc, argv, "o:d:e:", options, NULL)) != -1) { switch (c) { case 'o': out_name = optarg; break; + case 'd': + ao_scheme_add_features(&disable, optarg); + break; + case 'e': + ao_scheme_add_features(&enable, optarg); + break; default: usage(argv[0]); break; @@ -298,21 +394,35 @@ main(int argc, char **argv) ao_scheme_bool_get(1); prev_func = _builtin_last; + target_func = 0; + b = NULL; for (f = 0; f < (int) N_FUNC; f++) { - if (funcs[f].func != prev_func) - b = ao_scheme_make_builtin(funcs[f].func, funcs[f].args); - a = ao_scheme_atom_intern(funcs[f].name); - ao_scheme_atom_def(ao_scheme_atom_poly(a), - ao_scheme_builtin_poly(b)); + if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) { + if (funcs[f].func != prev_func) { + prev_func = funcs[f].func; + b = ao_scheme_make_builtin(prev_func, funcs[f].args); + + /* Target may have only a subset of + * the enum values; record what those + * values will be here. This obviously + * depends on the functions in the + * array being in the same order as + * the enumeration; which + * ao_scheme_make_builtin ensures. + */ + func_map[prev_func] = target_func++; + } + a = ao_scheme_atom_intern((char *) funcs[f].name); + ao_scheme_atom_def(ao_scheme_atom_poly(a), + ao_scheme_builtin_poly(b)); + } } - /* end of file value */ - a = ao_scheme_atom_intern("eof"); - ao_scheme_atom_def(ao_scheme_atom_poly(a), - ao_scheme_atom_poly(a)); - - /* 'else' */ - a = ao_scheme_atom_intern("else"); + /* atoms */ + for (an = 0; an < (int) N_ATOM; an++) { + if (ao_scheme_has_feature(enable, atoms[an].feature) || !ao_scheme_has_feature(disable, atoms[an].feature)) + a = ao_scheme_atom_intern((char *) atoms[an].name); + } if (argv[optind]){ in = fopen(argv[optind], "r"); @@ -331,14 +441,22 @@ main(int argc, char **argv) for (f = 0; f < ao_scheme_frame_global->num; f++) { struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(ao_scheme_frame_global->vals); + val = ao_has_macro(vals->vals[f].val); if (val != AO_SCHEME_NIL) { printf("error: function %s contains unresolved macro: ", ao_scheme_poly_atom(vals->vals[f].atom)->name); - ao_scheme_poly_write(val); + ao_scheme_poly_write(val, true); printf("\n"); exit(1); } + + /* Remap builtin enum values to match target set */ + b = ao_scheme_get_builtin(vals->vals[f].val); + if (b != NULL) { + if (!ao_scheme_seen_builtin(b)) + b->func = func_map[b->func]; + } } if (out_name) { @@ -351,6 +469,9 @@ main(int argc, char **argv) fprintf(out, "/* Generated file, do not edit */\n\n"); + for (d = disable; d; d = d->next) + fprintf(out, "#undef AO_SCHEME_FEATURE_%s\n", d->name); + fprintf(out, "#define AO_SCHEME_POOL_CONST %d\n", ao_scheme_top); fprintf(out, "extern const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)));\n"); fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_scheme_atom_poly(ao_scheme_atoms)); @@ -361,32 +482,33 @@ main(int argc, char **argv) fprintf(out, "#define _ao_scheme_bool_true 0x%04x\n", ao_scheme_bool_poly(ao_scheme_true)); for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) { - char *n = a->name, c; + const char *n = a->name; + char ch; fprintf(out, "#define _ao_scheme_atom_"); - while ((c = *n++)) { - if (isalnum(c)) - fprintf(out, "%c", c); + while ((ch = *n++)) { + if (isalnum(ch)) + fprintf(out, "%c", ch); else - fprintf(out, "%02x", c); + fprintf(out, "%02x", ch); } fprintf(out, " 0x%04x\n", ao_scheme_atom_poly(a)); } fprintf(out, "#ifdef AO_SCHEME_CONST_BITS\n"); fprintf(out, "const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute((aligned(4))) = {"); for (o = 0; o < ao_scheme_top; o++) { - uint8_t c; + uint8_t ch; if ((o & 0xf) == 0) fprintf(out, "\n\t"); else fprintf(out, " "); - c = ao_scheme_const[o]; + ch = ao_scheme_const[o]; if (!in_atom) in_atom = is_atom(o); if (in_atom) { - fprintf(out, " '%c',", c); + fprintf(out, " '%c',", ch); in_atom--; } else { - fprintf(out, "0x%02x,", c); + fprintf(out, "0x%02x,", ch); } } fprintf(out, "\n};\n"); diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c index 45d4de98..c9215072 100644 --- a/src/scheme/ao_scheme_mem.c +++ b/src/scheme/ao_scheme_mem.c @@ -41,11 +41,47 @@ uint8_t ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribute__((ali #define DBG_MEM_STATS DBG_MEM #endif +#define DBG_MEM_STACK 0 +#if DBG_MEM_STACK +char *mem_collect_stack; +int64_t mem_collect_max_depth; + +static void +ao_scheme_check_stack(void) +{ + char x; + int64_t depth; + + depth = mem_collect_stack - &x; + if (depth > mem_collect_max_depth) + mem_collect_max_depth = depth; +} + +static void +_ao_scheme_reset_stack(char *x) +{ + mem_collect_stack = x; +// mem_collect_max_depth = 0; +} +#define ao_scheme_declare_stack char x; +#define ao_scheme_reset_stack() _ao_scheme_reset_stack(&x) +#else +#define ao_scheme_check_stack() +#define ao_scheme_declare_stack +#define ao_scheme_reset_stack() +#endif + +#if DBG_MEM +#define DBG_MEM_RECORD 1 +#endif + #if DBG_MEM int dbg_move_depth; int dbg_mem = DBG_MEM_START; int dbg_validate = 0; +#endif +#if DBG_MEM_RECORD struct ao_scheme_record { struct ao_scheme_record *next; const struct ao_scheme_type *type; @@ -99,9 +135,9 @@ ao_scheme_record_save(void) } static void -ao_scheme_record_compare(char *where, - struct ao_scheme_record *a, - struct ao_scheme_record *b) +ao_scheme_record_compare(const char *where, + struct ao_scheme_record *a, + struct ao_scheme_record *b) { while (a && b) { if (a->type != b->type || a->size != b->size) { @@ -138,6 +174,7 @@ ao_scheme_record_compare(char *where, #else #define ao_scheme_record_reset() +#define ao_scheme_record(t,a,s) #endif uint8_t ao_scheme_exception; @@ -147,43 +184,34 @@ struct ao_scheme_root { void **addr; }; -static struct ao_scheme_cons *save_cons[2]; -static char *save_string[2]; -static struct ao_scheme_frame *save_frame[1]; -static ao_poly save_poly[3]; +#define AO_SCHEME_NUM_STASH 6 +static ao_poly stash_poly[AO_SCHEME_NUM_STASH]; +static int stash_poly_ptr; static const struct ao_scheme_root ao_scheme_root[] = { { - .type = &ao_scheme_cons_type, - .addr = (void **) &save_cons[0], - }, - { - .type = &ao_scheme_cons_type, - .addr = (void **) &save_cons[1], - }, - { - .type = &ao_scheme_string_type, - .addr = (void **) &save_string[0], + .type = NULL, + .addr = (void **) (void *) &stash_poly[0] }, { - .type = &ao_scheme_string_type, - .addr = (void **) &save_string[1], + .type = NULL, + .addr = (void **) (void *) &stash_poly[1] }, { - .type = &ao_scheme_frame_type, - .addr = (void **) &save_frame[0], + .type = NULL, + .addr = (void **) (void *) &stash_poly[2] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[0] + .addr = (void **) (void *) &stash_poly[3] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[1] + .addr = (void **) (void *) &stash_poly[4] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[2] + .addr = (void **) (void *) &stash_poly[5] }, { .type = &ao_scheme_atom_type, @@ -250,6 +278,10 @@ static const void ** const ao_scheme_cache[] = { #define AO_SCHEME_BUSY_SIZE ((AO_SCHEME_POOL + 31) / 32) +static int ao_scheme_printing, ao_scheme_print_cleared; +#if DBG_MEM +static int ao_scheme_collecting; +#endif static uint8_t ao_scheme_busy[AO_SCHEME_BUSY_SIZE]; static uint8_t ao_scheme_cons_note[AO_SCHEME_BUSY_SIZE]; static uint8_t ao_scheme_cons_last[AO_SCHEME_BUSY_SIZE]; @@ -272,7 +304,7 @@ static struct ao_scheme_chunk ao_scheme_chunk[AO_SCHEME_NCHUNK]; /* Offset of an address within the pool. */ static inline uint16_t pool_offset(void *addr) { #if DBG_MEM - if (!AO_SCHEME_IS_POOL(addr)) + if (!ao_scheme_is_pool_addr(addr)) ao_scheme_abort(); #endif return ((uint8_t *) addr) - ao_scheme_pool; @@ -281,6 +313,7 @@ static inline uint16_t pool_offset(void *addr) { static inline void mark(uint8_t *tag, int offset) { int byte = offset >> 5; int bit = (offset >> 2) & 7; + ao_scheme_check_stack(); tag[byte] |= (1 << bit); } @@ -303,7 +336,7 @@ static inline int limit(int offset) { return min(AO_SCHEME_POOL, max(offset, 0)); } -static void +static inline void note_cons(uint16_t offset) { MDBG_MOVE("note cons %d\n", offset); @@ -335,6 +368,7 @@ static void note_chunk(uint16_t offset, uint16_t size) { int l; + int end; if (offset < chunk_low || chunk_high <= offset) return; @@ -354,10 +388,13 @@ note_chunk(uint16_t offset, uint16_t size) /* Off the left side */ if (l == 0 && chunk_last && offset > ao_scheme_chunk[0].old_offset) ao_scheme_abort(); + + if (l < chunk_last && ao_scheme_chunk[l].old_offset == offset) + ao_scheme_abort(); #endif /* Shuffle existing entries right */ - int end = min(AO_SCHEME_NCHUNK, chunk_last + 1); + end = min(AO_SCHEME_NCHUNK, chunk_last + 1); memmove(&ao_scheme_chunk[l+1], &ao_scheme_chunk[l], @@ -433,20 +470,19 @@ static void dump_busy(void) { int i; - MDBG_MOVE("busy:"); + printf("busy:"); for (i = 0; i < ao_scheme_top; i += 4) { if ((i & 0xff) == 0) { - MDBG_MORE("\n"); - MDBG_MOVE("%s", ""); + printf("\n\t"); } else if ((i & 0x1f) == 0) - MDBG_MORE(" "); + printf(" "); if (busy(ao_scheme_busy, i)) - MDBG_MORE("*"); + printf("*"); else - MDBG_MORE("-"); + printf("-"); } - MDBG_MORE ("\n"); + printf ("\n"); } #define DUMP_BUSY() dump_busy() #else @@ -456,7 +492,9 @@ dump_busy(void) static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] = { [AO_SCHEME_CONS] = &ao_scheme_cons_type, [AO_SCHEME_INT] = NULL, - [AO_SCHEME_STRING] = &ao_scheme_string_type, +#ifdef AO_SCHEME_FEATURE_BIGINT + [AO_SCHEME_BIGINT] = &ao_scheme_bigint_type, +#endif [AO_SCHEME_OTHER] = (void *) 0x1, [AO_SCHEME_ATOM] = &ao_scheme_atom_type, [AO_SCHEME_BUILTIN] = &ao_scheme_builtin_type, @@ -465,12 +503,22 @@ static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] = [AO_SCHEME_LAMBDA] = &ao_scheme_lambda_type, [AO_SCHEME_STACK] = &ao_scheme_stack_type, [AO_SCHEME_BOOL] = &ao_scheme_bool_type, - [AO_SCHEME_BIGINT] = &ao_scheme_bigint_type, + [AO_SCHEME_STRING] = &ao_scheme_string_type, +#ifdef AO_SCHEME_FEATURE_FLOAT [AO_SCHEME_FLOAT] = &ao_scheme_float_type, +#endif +#ifdef AO_SCHEME_FEATURE_VECTOR [AO_SCHEME_VECTOR] = &ao_scheme_vector_type, +#endif }; static int +ao_scheme_mark(const struct ao_scheme_type *type, void *addr); + +static int +ao_scheme_move(const struct ao_scheme_type *type, void **ref); + +static int ao_scheme_mark_ref(const struct ao_scheme_type *type, void **ref) { return ao_scheme_mark(type, *ref); @@ -489,26 +537,39 @@ uint64_t ao_scheme_loops[2]; #endif int ao_scheme_last_top; +int ao_scheme_collect_counts; int ao_scheme_collect(uint8_t style) { + ao_scheme_declare_stack int i; int top; #if DBG_MEM_STATS int loops = 0; #endif -#if DBG_MEM +#if DBG_MEM_RECORD struct ao_scheme_record *mark_record = NULL, *move_record = NULL; - - MDBG_MOVE("collect %d\n", ao_scheme_collects[style]); #endif + MDBG_MOVE("collect %lu\n", ao_scheme_collects[style]); + MDBG_DO(ao_scheme_frame_write(ao_scheme_frame_poly(ao_scheme_frame_global))); + MDBG_DO(++ao_scheme_collecting); + + ao_scheme_reset_stack(); /* The first time through, we're doing a full collect */ if (ao_scheme_last_top == 0) style = AO_SCHEME_COLLECT_FULL; + /* One in a while, just do a full collect */ + + if (ao_scheme_collect_counts >= 128) + style = AO_SCHEME_COLLECT_FULL; + + if (style == AO_SCHEME_COLLECT_FULL) + ao_scheme_collect_counts = 0; + /* Clear references to all caches */ for (i = 0; i < (int) AO_SCHEME_CACHE; i++) *ao_scheme_cache[i] = NULL; @@ -518,15 +579,12 @@ ao_scheme_collect(uint8_t style) chunk_low = top = ao_scheme_last_top; } for (;;) { -#if DBG_MEM_STATS - loops++; -#endif MDBG_MOVE("move chunks from %d to %d\n", chunk_low, top); /* Find the sizes of the first chunk of objects to move */ reset_chunks(); walk(ao_scheme_mark_ref, ao_scheme_poly_mark_ref); -#if DBG_MEM +#if DBG_MEM_RECORD ao_scheme_record_free(mark_record); mark_record = ao_scheme_record_save(); if (mark_record && move_record) @@ -538,7 +596,6 @@ ao_scheme_collect(uint8_t style) /* Find the first moving object */ for (i = 0; i < chunk_last; i++) { uint16_t size = ao_scheme_chunk[i].size; - #if DBG_MEM if (!size) ao_scheme_abort(); @@ -557,6 +614,20 @@ ao_scheme_collect(uint8_t style) top += size; } + /* Short-circuit the rest of the loop when all of the + * found objects aren't moving. This isn't strictly + * necessary as the rest of the loop is structured to + * work in this case, but GCC 7.2.0 with optimization + * greater than 2 generates incorrect code for this... + */ + if (i == AO_SCHEME_NCHUNK) { + chunk_low = chunk_high; +#if DBG_MEM_STATS + loops++; +#endif + continue; + } + /* * Limit amount of chunk array used in mapping moves * to the active region @@ -590,7 +661,7 @@ ao_scheme_collect(uint8_t style) /* Relocate all references to the objects */ walk(ao_scheme_move, ao_scheme_poly_move); -#if DBG_MEM +#if DBG_MEM_RECORD ao_scheme_record_free(move_record); move_record = ao_scheme_record_save(); if (mark_record && move_record) @@ -598,6 +669,9 @@ ao_scheme_collect(uint8_t style) #endif } +#if DBG_MEM_STATS + loops++; +#endif /* If we ran into the end of the heap, then * there's no need to keep walking */ @@ -622,6 +696,10 @@ ao_scheme_collect(uint8_t style) MDBG_DO(memset(ao_scheme_chunk, '\0', sizeof (ao_scheme_chunk)); walk(ao_scheme_mark_ref, ao_scheme_poly_mark_ref)); +#if DBG_MEM_STACK + fprintf(stderr, "max collect stack depth %lu\n", mem_collect_max_depth); +#endif + MDBG_DO(--ao_scheme_collecting); return AO_SCHEME_POOL - ao_scheme_top; } @@ -636,7 +714,7 @@ ao_scheme_cons_check(struct ao_scheme_cons *cons) reset_chunks(); walk(ao_scheme_mark_ref, ao_scheme_poly_mark_ref); while (cons) { - if (!AO_SCHEME_IS_POOL(cons)) + if (!ao_scheme_is_pool_addr(cons)) break; offset = pool_offset(cons); if (busy(ao_scheme_busy, offset)) { @@ -657,28 +735,6 @@ ao_scheme_cons_check(struct ao_scheme_cons *cons) /* - * Mark a block of memory with an explicit size - */ - -int -ao_scheme_mark_block(void *addr, int size) -{ - int offset; - if (!AO_SCHEME_IS_POOL(addr)) - return 1; - - offset = pool_offset(addr); - MDBG_MOVE("mark memory %d\n", MDBG_OFFSET(addr)); - if (busy(ao_scheme_busy, offset)) { - MDBG_MOVE("already marked\n"); - return 1; - } - mark(ao_scheme_busy, offset); - note_chunk(offset, size); - return 0; -} - -/* * Note a reference to memory and collect information about a few * object sizes at a time */ @@ -687,7 +743,7 @@ int ao_scheme_mark_memory(const struct ao_scheme_type *type, void *addr) { int offset; - if (!AO_SCHEME_IS_POOL(addr)) + if (!ao_scheme_is_pool_addr(addr)) return 1; offset = pool_offset(addr); @@ -704,7 +760,7 @@ ao_scheme_mark_memory(const struct ao_scheme_type *type, void *addr) /* * Mark an object and all that it refereces */ -int +static int ao_scheme_mark(const struct ao_scheme_type *type, void *addr) { int ret; @@ -731,6 +787,7 @@ ao_scheme_poly_mark(ao_poly p, uint8_t do_note_cons) { uint8_t type; void *addr; + int ret; type = ao_scheme_poly_base_type(p); @@ -738,23 +795,33 @@ ao_scheme_poly_mark(ao_poly p, uint8_t do_note_cons) return 1; addr = ao_scheme_ref(p); - if (!AO_SCHEME_IS_POOL(addr)) + if (!ao_scheme_is_pool_addr(addr)) return 1; if (type == AO_SCHEME_CONS && do_note_cons) { note_cons(pool_offset(addr)); return 1; } else { + const struct ao_scheme_type *lisp_type; + if (type == AO_SCHEME_OTHER) type = ao_scheme_other_type(addr); - const struct ao_scheme_type *lisp_type = ao_scheme_types[type]; + lisp_type = ao_scheme_types[type]; #if DBG_MEM if (!lisp_type) ao_scheme_abort(); #endif - return ao_scheme_mark(lisp_type, addr); + MDBG_MOVE("mark %d\n", MDBG_OFFSET(addr)); + MDBG_MOVE_IN(); + ret = ao_scheme_mark_memory(lisp_type, addr); + if (!ret) { + MDBG_MOVE("mark recurse\n"); + lisp_type->mark(addr); + } + MDBG_MOVE_OUT(); + return ret; } } @@ -788,7 +855,7 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref) void *addr = *ref; uint16_t offset, orig_offset; - if (!AO_SCHEME_IS_POOL(addr)) + if (!ao_scheme_is_pool_addr(addr)) return 1; (void) type; @@ -798,7 +865,7 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref) offset = move_map(orig_offset); if (offset != orig_offset) { MDBG_MOVE("update ref %d %d -> %d\n", - AO_SCHEME_IS_POOL(ref) ? MDBG_OFFSET(ref) : -1, + ao_scheme_is_pool_addr(ref) ? MDBG_OFFSET(ref) : -1, orig_offset, offset); *ref = ao_scheme_pool + offset; } @@ -807,11 +874,11 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref) return 1; } mark(ao_scheme_busy, offset); - MDBG_DO(ao_scheme_record(type, addr, ao_scheme_size(type, addr))); + ao_scheme_record(type, addr, ao_scheme_size(type, addr)); return 0; } -int +static int ao_scheme_move(const struct ao_scheme_type *type, void **ref) { int ret; @@ -829,53 +896,59 @@ ao_scheme_move(const struct ao_scheme_type *type, void **ref) int ao_scheme_poly_move(ao_poly *ref, uint8_t do_note_cons) { - uint8_t type; ao_poly p = *ref; int ret; void *addr; uint16_t offset, orig_offset; - uint8_t base_type; - base_type = type = ao_scheme_poly_base_type(p); - - if (type == AO_SCHEME_INT) + if (ao_scheme_poly_base_type(p) == AO_SCHEME_INT) return 1; addr = ao_scheme_ref(p); - if (!AO_SCHEME_IS_POOL(addr)) + if (!ao_scheme_is_pool_addr(addr)) return 1; orig_offset = pool_offset(addr); offset = move_map(orig_offset); - if (type == AO_SCHEME_CONS && do_note_cons) { + if (ao_scheme_poly_base_type(p) == AO_SCHEME_CONS && do_note_cons) { note_cons(orig_offset); ret = 1; } else { + uint8_t type = ao_scheme_poly_base_type(p); + const struct ao_scheme_type *lisp_type; + if (type == AO_SCHEME_OTHER) type = ao_scheme_other_type(ao_scheme_pool + offset); - const struct ao_scheme_type *lisp_type = ao_scheme_types[type]; + lisp_type = ao_scheme_types[type]; #if DBG_MEM if (!lisp_type) ao_scheme_abort(); #endif - - ret = ao_scheme_move(lisp_type, &addr); + /* inline ao_scheme_move to save stack space */ + MDBG_MOVE("move object %d\n", MDBG_OFFSET(addr)); + MDBG_MOVE_IN(); + ret = ao_scheme_move_memory(lisp_type, &addr); + if (!ret) { + MDBG_MOVE("move recurse\n"); + lisp_type->move(addr); + } + MDBG_MOVE_OUT(); } /* Re-write the poly value */ if (offset != orig_offset) { - ao_poly np = ao_scheme_poly(ao_scheme_pool + offset, base_type); + ao_poly np = ao_scheme_poly(ao_scheme_pool + offset, ao_scheme_poly_base_type(p)); MDBG_MOVE("poly %d moved %d -> %d\n", - type, orig_offset, offset); + ao_scheme_poly_type(np), orig_offset, offset); *ref = np; } return ret; } #if DBG_MEM -void +static void ao_scheme_validate(void) { chunk_low = 0; @@ -909,61 +982,80 @@ ao_scheme_alloc(int size) } void -ao_scheme_cons_stash(int id, struct ao_scheme_cons *cons) +ao_scheme_poly_stash(ao_poly p) { - assert(save_cons[id] == 0); - save_cons[id] = cons; + assert(stash_poly_ptr < AO_SCHEME_NUM_STASH); + stash_poly[stash_poly_ptr++] = p; } -struct ao_scheme_cons * -ao_scheme_cons_fetch(int id) +ao_poly +ao_scheme_poly_fetch(void) { - struct ao_scheme_cons *cons = save_cons[id]; - save_cons[id] = NULL; - return cons; -} + ao_poly p; -void -ao_scheme_poly_stash(int id, ao_poly poly) -{ - assert(save_poly[id] == AO_SCHEME_NIL); - save_poly[id] = poly; + assert (stash_poly_ptr > 0); + p = stash_poly[--stash_poly_ptr]; + stash_poly[stash_poly_ptr] = AO_SCHEME_NIL; + return p; } -ao_poly -ao_scheme_poly_fetch(int id) +int +ao_scheme_print_mark_addr(void *addr) { - ao_poly poly = save_poly[id]; - save_poly[id] = AO_SCHEME_NIL; - return poly; + int offset; + +#if DBG_MEM + if (ao_scheme_collecting) + ao_scheme_abort(); +#endif + + if (!ao_scheme_is_pool_addr(addr)) + return 0; + + if (!ao_scheme_print_cleared) { + ao_scheme_print_cleared = 1; + memset(ao_scheme_busy, '\0', sizeof (ao_scheme_busy)); + } + offset = pool_offset(addr); + if (busy(ao_scheme_busy, offset)) + return 1; + mark(ao_scheme_busy, offset); + return 0; } void -ao_scheme_string_stash(int id, char *string) +ao_scheme_print_clear_addr(void *addr) { - assert(save_string[id] == NULL); - save_string[id] = string; -} + int offset; -char * -ao_scheme_string_fetch(int id) -{ - char *string = save_string[id]; - save_string[id] = NULL; - return string; +#if DBG_MEM + if (ao_scheme_collecting) + ao_scheme_abort(); +#endif + + if (!ao_scheme_is_pool_addr(addr)) + return; + + if (!ao_scheme_print_cleared) + return; + offset = pool_offset(addr); + clear(ao_scheme_busy, offset); } +/* Notes that printing has started */ void -ao_scheme_frame_stash(int id, struct ao_scheme_frame *frame) +ao_scheme_print_start(void) { - assert(save_frame[id] == NULL); - save_frame[id] = frame; + ao_scheme_printing++; } -struct ao_scheme_frame * -ao_scheme_frame_fetch(int id) +/* Notes that printing has ended. Returns 1 if printing is still going on */ +int +ao_scheme_print_stop(void) { - struct ao_scheme_frame *frame = save_frame[id]; - save_frame[id] = NULL; - return frame; + ao_scheme_printing--; + if (ao_scheme_printing != 0) + return 1; + ao_scheme_print_cleared = 0; + return 0; } diff --git a/src/scheme/ao_scheme_poly.c b/src/scheme/ao_scheme_poly.c index 553585db..0cffc196 100644 --- a/src/scheme/ao_scheme_poly.c +++ b/src/scheme/ao_scheme_poly.c @@ -14,92 +14,41 @@ #include "ao_scheme.h" -struct ao_scheme_funcs { - void (*write)(ao_poly); - void (*display)(ao_poly); -}; +static void ao_scheme_invalid_write(ao_poly p, bool write) { + printf("??? type %d poly 0x%04x ???", ao_scheme_poly_type (p), p); + (void) write; + ao_scheme_abort(); +} -static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = { - [AO_SCHEME_CONS] = { - .write = ao_scheme_cons_write, - .display = ao_scheme_cons_display, - }, - [AO_SCHEME_STRING] = { - .write = ao_scheme_string_write, - .display = ao_scheme_string_display, - }, - [AO_SCHEME_INT] = { - .write = ao_scheme_int_write, - .display = ao_scheme_int_write, - }, - [AO_SCHEME_ATOM] = { - .write = ao_scheme_atom_write, - .display = ao_scheme_atom_write, - }, - [AO_SCHEME_BUILTIN] = { - .write = ao_scheme_builtin_write, - .display = ao_scheme_builtin_write, - }, - [AO_SCHEME_FRAME] = { - .write = ao_scheme_frame_write, - .display = ao_scheme_frame_write, - }, - [AO_SCHEME_FRAME_VALS] = { - .write = NULL, - .display = NULL, - }, - [AO_SCHEME_LAMBDA] = { - .write = ao_scheme_lambda_write, - .display = ao_scheme_lambda_write, - }, - [AO_SCHEME_STACK] = { - .write = ao_scheme_stack_write, - .display = ao_scheme_stack_write, - }, - [AO_SCHEME_BOOL] = { - .write = ao_scheme_bool_write, - .display = ao_scheme_bool_write, - }, - [AO_SCHEME_BIGINT] = { - .write = ao_scheme_bigint_write, - .display = ao_scheme_bigint_write, - }, - [AO_SCHEME_FLOAT] = { - .write = ao_scheme_float_write, - .display = ao_scheme_float_write, - }, - [AO_SCHEME_VECTOR] = { - .write = ao_scheme_vector_write, - .display = ao_scheme_vector_display - }, +static void (*const ao_scheme_write_funcs[AO_SCHEME_NUM_TYPE]) (ao_poly p, bool write) = { + [AO_SCHEME_CONS] = ao_scheme_cons_write, +#ifdef AO_SCHEME_FEATURE_BIGINT + [AO_SCHEME_BIGINT] = ao_scheme_bigint_write, +#endif + [AO_SCHEME_INT] = ao_scheme_int_write, + [AO_SCHEME_ATOM] = ao_scheme_atom_write, + [AO_SCHEME_BUILTIN] = ao_scheme_builtin_write, + [AO_SCHEME_FRAME] = ao_scheme_frame_write, + [AO_SCHEME_FRAME_VALS] = ao_scheme_invalid_write, + [AO_SCHEME_LAMBDA] = ao_scheme_lambda_write, + [AO_SCHEME_STACK] = ao_scheme_stack_write, + [AO_SCHEME_BOOL] = ao_scheme_bool_write, + [AO_SCHEME_STRING] = ao_scheme_string_write, +#ifdef AO_SCHEME_FEATURE_FLOAT + [AO_SCHEME_FLOAT] = ao_scheme_float_write, +#endif +#ifdef AO_SCHEME_FEATURE_VECTOR + [AO_SCHEME_VECTOR] = ao_scheme_vector_write, +#endif }; -static const struct ao_scheme_funcs * -funcs(ao_poly p) +void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write) { uint8_t type = ao_scheme_poly_type(p); if (type < AO_SCHEME_NUM_TYPE) - return &ao_scheme_funcs[type]; - return NULL; -} - -void -ao_scheme_poly_write(ao_poly p) -{ - const struct ao_scheme_funcs *f = funcs(p); - - if (f && f->write) - f->write(p); -} - -void -ao_scheme_poly_display(ao_poly p) -{ - const struct ao_scheme_funcs *f = funcs(p); - - if (f && f->display) - f->display(p); + return ao_scheme_write_funcs[type]; + return ao_scheme_invalid_write; } void * @@ -116,7 +65,7 @@ ao_scheme_poly(const void *addr, ao_poly type) { const uint8_t *a = addr; if (a == NULL) return AO_SCHEME_NIL; - if (AO_SCHEME_IS_CONST(a)) + if (ao_scheme_is_const_addr(a)) return AO_SCHEME_CONST | (a - ao_scheme_const + 4) | type; return (a - ao_scheme_pool + 4) | type; } diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c index 9ed54b9f..e93466fc 100644 --- a/src/scheme/ao_scheme_read.c +++ b/src/scheme/ao_scheme_read.c @@ -62,7 +62,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE|SPECIAL, /* ) */ PRINTABLE, /* * */ PRINTABLE|SIGN, /* + */ - PRINTABLE|SPECIAL, /* , */ + PRINTABLE|SPECIAL_QUASI, /* , */ PRINTABLE|SIGN, /* - */ PRINTABLE|DOTC|FLOATC, /* . */ PRINTABLE, /* / */ @@ -114,7 +114,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* ] */ PRINTABLE, /* ^ */ PRINTABLE, /* _ */ - PRINTABLE|SPECIAL, /* ` */ + PRINTABLE|SPECIAL_QUASI, /* ` */ PRINTABLE, /* a */ PRINTABLE, /* b */ PRINTABLE, /* c */ @@ -244,12 +244,13 @@ lex_quoted(void) } } +#ifndef AO_SCHEME_TOKEN_MAX #define AO_SCHEME_TOKEN_MAX 128 +#endif static char token_string[AO_SCHEME_TOKEN_MAX]; static int32_t token_int; static int token_len; -static float token_float; static inline void add_token(int c) { if (c && token_len < AO_SCHEME_TOKEN_MAX - 1) @@ -265,6 +266,9 @@ static inline void end_token(void) { token_string[token_len] = '\0'; } +#ifdef AO_SCHEME_FEATURE_FLOAT +static float token_float; + struct namedfloat { const char *name; float value; @@ -278,6 +282,7 @@ static const struct namedfloat namedfloats[] = { }; #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0]) +#endif static int _lex(void) @@ -315,6 +320,7 @@ _lex(void) return QUOTE; case '.': return DOT; +#ifdef AO_SCHEME_FEATURE_QUASI case '`': return QUASIQUOTE; case ',': @@ -327,6 +333,7 @@ _lex(void) lex_unget(c); return UNQUOTE; } +#endif } } if (lex_class & POUND) { @@ -340,8 +347,10 @@ _lex(void) add_token(c); end_token(); return BOOL; +#ifdef AO_SCHEME_FEATURE_VECTOR case '(': return OPEN_VECTOR; +#endif case '\\': for (;;) { int alphabetic; @@ -393,23 +402,23 @@ _lex(void) } } if (lex_class & PRINTABLE) { - int isfloat; - int hasdigit; - int isneg; - int isint; - int epos; - - isfloat = 1; - isint = 1; - hasdigit = 0; +#ifdef AO_SCHEME_FEATURE_FLOAT + int isfloat = 1; + int epos = 0; +#endif + int hasdigit = 0; + int isneg = 0; + int isint = 1; + token_int = 0; - isneg = 0; - epos = 0; for (;;) { if (!(lex_class & NUMBER)) { isint = 0; +#ifdef AO_SCHEME_FEATURE_FLOAT isfloat = 0; +#endif } else { +#ifdef AO_SCHEME_FEATURE_FLOAT if (!(lex_class & INTEGER)) isint = 0; if (token_len != epos && @@ -418,8 +427,10 @@ _lex(void) isint = 0; isfloat = 0; } +#endif if (c == '-') isneg = 1; +#ifdef AO_SCHEME_FEATURE_FLOAT if (c == '.' && epos != 0) isfloat = 0; if (c == 'e' || c == 'E') { @@ -428,6 +439,7 @@ _lex(void) else epos = token_len + 1; } +#endif if (lex_class & DIGIT) { hasdigit = 1; if (isint) @@ -436,8 +448,14 @@ _lex(void) } add_token (c); c = lexc (); - if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) { + if ((lex_class & (NOTNAME)) +#ifdef AO_SCHEME_FEATURE_FLOAT + && (c != '.' || !isfloat) +#endif + ) { +#ifdef AO_SCHEME_FEATURE_FLOAT unsigned int u; +#endif // if (lex_class & ENDOFFILE) // clearerr (f); lex_unget(c); @@ -447,6 +465,7 @@ _lex(void) token_int = -token_int; return NUM; } +#ifdef AO_SCHEME_FEATURE_FLOAT if (isfloat && hasdigit) { token_float = strtof(token_string, NULL); return FLOAT; @@ -456,6 +475,7 @@ _lex(void) token_float = namedfloats[u].value; return FLOAT; } +#endif return NAME; } } @@ -490,7 +510,7 @@ push_read_stack(int read_state) RDBG_IN(); if (ao_scheme_read_list) { ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons), - ao_scheme__cons(ao_scheme_int_poly(read_state), + ao_scheme_cons(ao_scheme_int_poly(read_state), ao_scheme_cons_poly(ao_scheme_read_stack))); if (!ao_scheme_read_stack) return 0; @@ -525,11 +545,17 @@ pop_read_stack(void) return read_state; } +#ifdef AO_SCHEME_FEATURE_VECTOR +#define is_open(t) ((t) == OPEN || (t) == OPEN_VECTOR) +#else +#define is_open(t) ((t) == OPEN) +#endif + ao_poly ao_scheme_read(void) { struct ao_scheme_atom *atom; - char *string; + struct ao_scheme_string *string; int read_state; ao_poly v = AO_SCHEME_NIL; @@ -538,9 +564,11 @@ ao_scheme_read(void) ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0; for (;;) { parse_token = lex(); - while (parse_token == OPEN || parse_token == OPEN_VECTOR) { + while (is_open(parse_token)) { +#ifdef AO_SCHEME_FEATURE_VECTOR if (parse_token == OPEN_VECTOR) read_state |= READ_SAW_VECTOR; +#endif if (!push_read_stack(read_state)) return AO_SCHEME_NIL; ao_scheme_read_list++; @@ -565,9 +593,11 @@ ao_scheme_read(void) case NUM: v = ao_scheme_integer_poly(token_int); break; +#ifdef AO_SCHEME_FEATURE_FLOAT case FLOAT: v = ao_scheme_float_get(token_float); break; +#endif case BOOL: if (token_string[0] == 't') v = _ao_scheme_bool_true; @@ -575,16 +605,18 @@ ao_scheme_read(void) v = _ao_scheme_bool_false; break; case STRING: - string = ao_scheme_string_copy(token_string); + string = ao_scheme_string_make(token_string); if (string) v = ao_scheme_string_poly(string); else v = AO_SCHEME_NIL; break; case QUOTE: +#ifdef AO_SCHEME_FEATURE_QUASI case QUASIQUOTE: case UNQUOTE: case UNQUOTE_SPLICING: +#endif if (!push_read_stack(read_state)) return AO_SCHEME_NIL; ao_scheme_read_list++; @@ -593,6 +625,7 @@ ao_scheme_read(void) case QUOTE: v = _ao_scheme_atom_quote; break; +#ifdef AO_SCHEME_FEATURE_QUASI case QUASIQUOTE: v = _ao_scheme_atom_quasiquote; break; @@ -602,6 +635,7 @@ ao_scheme_read(void) case UNQUOTE_SPLICING: v = _ao_scheme_atom_unquote2dsplicing; break; +#endif } break; case CLOSE: @@ -612,8 +646,10 @@ ao_scheme_read(void) v = ao_scheme_cons_poly(ao_scheme_read_cons); --ao_scheme_read_list; read_state = pop_read_stack(); +#ifdef AO_SCHEME_FEATURE_VECTOR if (read_state & READ_SAW_VECTOR) v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v))); +#endif break; case DOT: if (!ao_scheme_read_list) { diff --git a/src/scheme/ao_scheme_read.h b/src/scheme/ao_scheme_read.h index e10a7d05..1aa11a3a 100644 --- a/src/scheme/ao_scheme_read.h +++ b/src/scheme/ao_scheme_read.h @@ -24,15 +24,21 @@ # define OPEN 2 # define CLOSE 3 # define QUOTE 4 +#ifdef AO_SCHEME_FEATURE_QUASI # define QUASIQUOTE 5 # define UNQUOTE 6 # define UNQUOTE_SPLICING 7 +#endif # define STRING 8 # define NUM 9 +#ifdef AO_SCHEME_FEATURE_FLOAT # define FLOAT 10 +#endif # define DOT 11 # define BOOL 12 +#ifdef AO_SCHEME_FEATURE_VECTOR # define OPEN_VECTOR 13 +#endif /* * character classes @@ -40,11 +46,20 @@ # define PRINTABLE 0x0001 /* \t \n ' ' - ~ */ # define SPECIAL 0x0002 /* ( [ { ) ] } ' ` , */ +#ifdef AO_SCHEME_FEATURE_QUASI +# define SPECIAL_QUASI SPECIAL +#else +# define SPECIAL_QUASI 0 +#endif # define DOTC 0x0004 /* . */ # define WHITE 0x0008 /* ' ' \t \n */ # define DIGIT 0x0010 /* [0-9] */ # define SIGN 0x0020 /* +- */ +#ifdef AO_SCHEME_FEATURE_FLOAT # define FLOATC 0x0040 /* . e E */ +#else +# define FLOATC 0 +#endif # define ENDOFFILE 0x0080 /* end of file */ # define COMMENT 0x0100 /* ; */ # define IGNORE 0x0200 /* \0 - ' ' */ diff --git a/src/scheme/ao_scheme_rep.c b/src/scheme/ao_scheme_rep.c index 5b94d940..b35ba5b8 100644 --- a/src/scheme/ao_scheme_rep.c +++ b/src/scheme/ao_scheme_rep.c @@ -30,7 +30,7 @@ ao_scheme_read_eval_print(void) break; ao_scheme_exception = 0; } else { - ao_scheme_poly_write(out); + ao_scheme_poly_write(out, true); putchar ('\n'); } } diff --git a/src/scheme/ao_scheme_save.c b/src/scheme/ao_scheme_save.c index af9345b8..3a595d71 100644 --- a/src/scheme/ao_scheme_save.c +++ b/src/scheme/ao_scheme_save.c @@ -17,11 +17,15 @@ ao_poly ao_scheme_do_save(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_SAVE + struct ao_scheme_os_save *os; +#endif + if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0)) return AO_SCHEME_NIL; #ifdef AO_SCHEME_SAVE - struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; + os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; ao_scheme_collect(AO_SCHEME_COLLECT_FULL); os->atoms = ao_scheme_atom_poly(ao_scheme_atoms); @@ -38,12 +42,15 @@ ao_scheme_do_save(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_restore(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_SAVE + struct ao_scheme_os_save save; + struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; +#endif if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0)) return AO_SCHEME_NIL; #ifdef AO_SCHEME_SAVE - struct ao_scheme_os_save save; - struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; + os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; if (!ao_scheme_os_restore_save(&save, AO_SCHEME_POOL)) return ao_scheme_error(AO_SCHEME_INVALID, "header restore failed"); diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c index d19dd6d6..863df3ca 100644 --- a/src/scheme/ao_scheme_stack.c +++ b/src/scheme/ao_scheme_stack.c @@ -158,26 +158,35 @@ ao_scheme_stack_clear(void) } void -ao_scheme_stack_write(ao_poly poly) +ao_scheme_stack_write(ao_poly poly, bool write) { - struct ao_scheme_stack *s = ao_scheme_poly_stack(poly); + struct ao_scheme_stack *s = ao_scheme_poly_stack(poly); + struct ao_scheme_stack *clear = s; + int written = 0; + (void) write; + ao_scheme_print_start(); + ao_scheme_frame_print_indent += 2; while (s) { - if (s->type & AO_SCHEME_STACK_PRINT) { + if (ao_scheme_print_mark_addr(s)) { printf("[recurse...]"); - return; + break; } - s->type |= AO_SCHEME_STACK_PRINT; + written++; printf("\t[\n"); - printf("\t\texpr: "); ao_scheme_poly_write(s->list); printf("\n"); - printf("\t\tstate: %s\n", ao_scheme_state_names[s->state]); - ao_scheme_error_poly ("values: ", s->values, s->values_tail); - ao_scheme_error_poly ("sexprs: ", s->sexprs, AO_SCHEME_NIL); - ao_scheme_error_frame(2, "frame: ", ao_scheme_poly_frame(s->frame)); + ao_scheme_printf("\t\texpr: %v\n", s->list); + ao_scheme_printf("\t\tvalues: %v\n", s->values); + ao_scheme_printf("\t\tframe: %v\n", s->frame); printf("\t]\n"); - s->type &= ~AO_SCHEME_STACK_PRINT; s = ao_scheme_poly_stack(s->prev); } + ao_scheme_frame_print_indent -= 2; + if (ao_scheme_print_stop()) { + while (written--) { + ao_scheme_print_clear_addr(clear); + clear = ao_scheme_poly_stack(clear->prev); + } + } } /* @@ -190,13 +199,13 @@ ao_scheme_stack_copy(struct ao_scheme_stack *old) struct ao_scheme_stack *n, *prev = NULL; while (old) { - ao_scheme_stack_stash(0, old); - ao_scheme_stack_stash(1, new); - ao_scheme_stack_stash(2, prev); + ao_scheme_stack_stash(old); + ao_scheme_stack_stash(new); + ao_scheme_stack_stash(prev); n = ao_scheme_stack_new(); - prev = ao_scheme_stack_fetch(2); - new = ao_scheme_stack_fetch(1); - old = ao_scheme_stack_fetch(0); + prev = ao_scheme_stack_fetch(); + new = ao_scheme_stack_fetch(); + old = ao_scheme_stack_fetch(); if (!n) return NULL; @@ -221,11 +230,12 @@ ao_scheme_stack_copy(struct ao_scheme_stack *old) ao_poly ao_scheme_stack_eval(void) { + struct ao_scheme_cons *cons; struct ao_scheme_stack *new = ao_scheme_stack_copy(ao_scheme_poly_stack(ao_scheme_v)); if (!new) return AO_SCHEME_NIL; - struct ao_scheme_cons *cons = ao_scheme_poly_cons(ao_scheme_stack->values); + cons = ao_scheme_poly_cons(ao_scheme_stack->values); if (!cons || !cons->cdr) return ao_scheme_error(AO_SCHEME_INVALID, "continuation requires a value"); diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index e25306cb..dfc74966 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -24,9 +24,10 @@ static void string_mark(void *addr) static int string_size(void *addr) { + struct ao_scheme_string *string = addr; if (!addr) return 0; - return strlen(addr) + 1; + return strlen(string->val) + 2; } static void string_move(void *addr) @@ -41,72 +42,122 @@ const struct ao_scheme_type ao_scheme_string_type = { .name = "string", }; -char * -ao_scheme_string_copy(char *a) +static struct ao_scheme_string * +ao_scheme_string_alloc(int len) { - int alen = strlen(a); + struct ao_scheme_string *s; - ao_scheme_string_stash(0, a); - char *r = ao_scheme_alloc(alen + 1); - a = ao_scheme_string_fetch(0); + s = ao_scheme_alloc(len + 2); + if (!s) + return NULL; + s->type = AO_SCHEME_STRING; + return s; +} + +struct ao_scheme_string * +ao_scheme_string_copy(struct ao_scheme_string *a) +{ + int alen = strlen(a->val); + struct ao_scheme_string *r; + + ao_scheme_string_stash(a); + r = ao_scheme_string_alloc(alen); + a = ao_scheme_string_fetch(); if (!r) return NULL; - strcpy(r, a); + strcpy(r->val, a->val); return r; } -char * -ao_scheme_string_cat(char *a, char *b) +struct ao_scheme_string * +ao_scheme_string_make(char *a) { - int alen = strlen(a); - int blen = strlen(b); - - ao_scheme_string_stash(0, a); - ao_scheme_string_stash(1, b); - char *r = ao_scheme_alloc(alen + blen + 1); - a = ao_scheme_string_fetch(0); - b = ao_scheme_string_fetch(1); + struct ao_scheme_string *r; + + r = ao_scheme_string_alloc(strlen(a)); if (!r) return NULL; - strcpy(r, a); - strcpy(r+alen, b); + strcpy(r->val, a); + return r; +} + +struct ao_scheme_string * +ao_scheme_atom_to_string(struct ao_scheme_atom *a) +{ + int alen = strlen(a->name); + struct ao_scheme_string *r; + + ao_scheme_atom_stash(a); + r = ao_scheme_string_alloc(alen); + a = ao_scheme_atom_fetch(); + if (!r) + return NULL; + strcpy(r->val, a->name); + return r; +} + +struct ao_scheme_string * +ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b) +{ + int alen = strlen(a->val); + int blen = strlen(b->val); + struct ao_scheme_string *r; + + ao_scheme_string_stash(a); + ao_scheme_string_stash(b); + r = ao_scheme_string_alloc(alen + blen); + b = ao_scheme_string_fetch(); + a = ao_scheme_string_fetch(); + if (!r) + return NULL; + strcpy(r->val, a->val); + strcpy(r->val+alen, b->val); return r; } ao_poly ao_scheme_string_pack(struct ao_scheme_cons *cons) { - int len = ao_scheme_cons_length(cons); - ao_scheme_cons_stash(0, cons); - char *r = ao_scheme_alloc(len + 1); - cons = ao_scheme_cons_fetch(0); - char *s = r; + struct ao_scheme_string *r; + char *rval; + int len; + + len = ao_scheme_cons_length(cons); + ao_scheme_cons_stash(cons); + r = ao_scheme_string_alloc(len); + cons = ao_scheme_cons_fetch(); + if (!r) + return AO_SCHEME_NIL; + rval = r->val; while (cons) { - if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car))) + bool fail = false; + ao_poly car = cons->car; + *rval++ = ao_scheme_poly_integer(car, &fail); + if (fail) return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack"); - *s++ = ao_scheme_poly_integer(cons->car); - cons = ao_scheme_poly_cons(cons->cdr); + cons = ao_scheme_cons_cdr(cons); } - *s++ = 0; + *rval++ = 0; return ao_scheme_string_poly(r); } ao_poly -ao_scheme_string_unpack(char *a) +ao_scheme_string_unpack(struct ao_scheme_string *a) { struct ao_scheme_cons *cons = NULL, *tail = NULL; int c; int i; - for (i = 0; (c = a[i]); i++) { - ao_scheme_cons_stash(0, cons); - ao_scheme_cons_stash(1, tail); - ao_scheme_string_stash(0, a); - struct ao_scheme_cons *n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL); - a = ao_scheme_string_fetch(0); - cons = ao_scheme_cons_fetch(0); - tail = ao_scheme_cons_fetch(1); + for (i = 0; (c = a->val[i]); i++) { + struct ao_scheme_cons *n; + ao_scheme_cons_stash(cons); + ao_scheme_cons_stash(tail); + ao_scheme_string_stash(a); + n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL); + a = ao_scheme_string_fetch(); + tail = ao_scheme_cons_fetch(); + cons = ao_scheme_cons_fetch(); if (!n) { cons = NULL; @@ -122,40 +173,36 @@ ao_scheme_string_unpack(char *a) } void -ao_scheme_string_write(ao_poly p) +ao_scheme_string_write(ao_poly p, bool write) { - char *s = ao_scheme_poly_string(p); - char c; - - putchar('"'); - while ((c = *s++)) { - switch (c) { - case '\n': - printf ("\\n"); - break; - case '\r': - printf ("\\r"); - break; - case '\t': - printf ("\\t"); - break; - default: - if (c < ' ') - printf("\\%03o", c); - else - putchar(c); - break; + struct ao_scheme_string *s = ao_scheme_poly_string(p); + char *sval = s->val; + char c; + + if (write) { + putchar('"'); + while ((c = *sval++)) { + switch (c) { + case '\n': + printf ("\\n"); + break; + case '\r': + printf ("\\r"); + break; + case '\t': + printf ("\\t"); + break; + default: + if (c < ' ') + printf("\\%03o", c); + else + putchar(c); + break; + } } + putchar('"'); + } else { + while ((c = *sval++)) + putchar(c); } - putchar('"'); -} - -void -ao_scheme_string_display(ao_poly p) -{ - char *s = ao_scheme_poly_string(p); - char c; - - while ((c = *s++)) - putchar(c); } diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c new file mode 100644 index 00000000..afdc89a8 --- /dev/null +++ b/src/scheme/ao_scheme_vector.c @@ -0,0 +1,178 @@ +/* + * Copyright © 2017 Keith Packard <keithp@keithp.com> + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + */ + +#include "ao_scheme.h" + +#ifdef AO_SCHEME_FEATURE_VECTOR + +static void vector_mark(void *addr) +{ + struct ao_scheme_vector *vector = addr; + unsigned int i; + + for (i = 0; i < vector->length; i++) { + ao_poly v = vector->vals[i]; + + ao_scheme_poly_mark(v, 1); + } +} + +static int vector_len_size(uint16_t length) +{ + return sizeof (struct ao_scheme_vector) + length * sizeof (ao_poly); +} + +static int vector_size(void *addr) +{ + struct ao_scheme_vector *vector = addr; + + return vector_len_size(vector->length); +} + +static void vector_move(void *addr) +{ + struct ao_scheme_vector *vector = addr; + unsigned int i; + + for (i = 0; i < vector->length; i++) + (void) ao_scheme_poly_move(&vector->vals[i], 1); +} + +const struct ao_scheme_type ao_scheme_vector_type = { + .mark = vector_mark, + .size = vector_size, + .move = vector_move, + .name = "vector", +}; + +struct ao_scheme_vector * +ao_scheme_vector_alloc(uint16_t length, ao_poly fill) +{ + struct ao_scheme_vector *vector; + unsigned int i; + + vector = ao_scheme_alloc(vector_len_size(length)); + if (!vector) + return NULL; + vector->type = AO_SCHEME_VECTOR; + vector->length = length; + for (i = 0; i < length; i++) + vector->vals[i] = fill; + return vector; +} + +void +ao_scheme_vector_write(ao_poly v, bool write) +{ + struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); + unsigned int i; + int was_marked = 0; + + ao_scheme_print_start(); + was_marked = ao_scheme_print_mark_addr(vector); + if (was_marked) { + printf ("..."); + } else { + printf("#("); + for (i = 0; i < vector->length; i++) { + if (i != 0) + printf(" "); + ao_scheme_poly_write(vector->vals[i], write); + } + printf(")"); + } + if (ao_scheme_print_stop() && !was_marked) + ao_scheme_print_clear_addr(vector); +} + +static int32_t +ao_scheme_vector_offset(struct ao_scheme_vector *vector, ao_poly i) +{ + bool fail; + int32_t offset = ao_scheme_poly_integer(i, &fail); + + if (fail) + ao_scheme_error(AO_SCHEME_INVALID, "vector index %v not integer", i); + if (offset < 0 || vector->length <= offset) { + ao_scheme_error(AO_SCHEME_INVALID, "vector index %v out of range (max %d)", + i, vector->length); + offset = -1; + } + return offset; +} + +ao_poly +ao_scheme_vector_get(ao_poly v, ao_poly i) +{ + struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); + int32_t offset = ao_scheme_vector_offset(vector, i); + + if (offset < 0) + return AO_SCHEME_NIL; + return vector->vals[offset]; +} + +ao_poly +ao_scheme_vector_set(ao_poly v, ao_poly i, ao_poly p) +{ + struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); + int32_t offset = ao_scheme_vector_offset(vector, i); + + if (offset < 0) + return AO_SCHEME_NIL; + return vector->vals[offset] = p; +} + +struct ao_scheme_vector * +ao_scheme_list_to_vector(struct ao_scheme_cons *cons) +{ + uint16_t length; + uint16_t i; + struct ao_scheme_vector *vector; + + length = (uint16_t) ao_scheme_cons_length (cons); + if (ao_scheme_exception) + return NULL; + + ao_scheme_cons_stash(cons); + vector = ao_scheme_vector_alloc(length, AO_SCHEME_NIL); + cons = ao_scheme_cons_fetch(); + if (!vector) + return NULL; + i = 0; + while (cons) { + vector->vals[i++] = cons->car; + cons = ao_scheme_cons_cdr(cons); + } + return vector; +} + +struct ao_scheme_cons * +ao_scheme_vector_to_list(struct ao_scheme_vector *vector) +{ + unsigned int i; + uint16_t length = vector->length; + struct ao_scheme_cons *cons = NULL; + + for (i = length; i-- > 0;) { + ao_scheme_vector_stash(vector); + cons = ao_scheme_cons_cons(vector->vals[i], ao_scheme_cons_poly(cons)); + vector = ao_scheme_vector_fetch(); + if (!cons) + return NULL; + } + return cons; +} + +#endif /* AO_SCHEME_FEATURE_VECTOR */ diff --git a/src/scheme/make-const/Makefile b/src/scheme/make-const/Makefile index caf7acbe..a8e3a7f5 100644 --- a/src/scheme/make-const/Makefile +++ b/src/scheme/make-const/Makefile @@ -10,7 +10,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_os.h OBJS=$(SRCS:.c=.o) CC=cc -CFLAGS=-DAO_SCHEME_MAKE_CONST -O0 -g -I. -Wall -Wextra +CFLAGS=-DAO_SCHEME_MAKE_CONST -O0 -g -I. -Wall -Wextra -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast .c.o: $(CC) -c $(CFLAGS) $< -o $@ diff --git a/src/scheme/test/.gitignore b/src/scheme/test/.gitignore index 3cdae594..3622bc1d 100644 --- a/src/scheme/test/.gitignore +++ b/src/scheme/test/.gitignore @@ -1 +1 @@ -ao_scheme_test +ao-scheme diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile index c48add1f..ee46118e 100644 --- a/src/scheme/test/Makefile +++ b/src/scheme/test/Makefile @@ -5,18 +5,26 @@ vpath %.c .. vpath %.h .. SRCS=$(SCHEME_SRCS) ao_scheme_test.c +HDRS=$(SCHEME_HDRS) ao_scheme_const.h OBJS=$(SRCS:.c=.o) -CFLAGS=-O2 -g -Wall -Wextra -I. -I.. +#PGFLAGS=-pg -no-pie +OFLAGS=-O3 +#DFLAGS=-O0 -ao_scheme_test: $(OBJS) +CFLAGS=$(DFLAGS) $(OFLAGS) $(PGFLAGS) -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast + +ao-scheme: $(OBJS) cc $(CFLAGS) -o $@ $(OBJS) -lm -$(OBJS): $(SCHEME_HDRS) +$(OBJS): $(HDRS) + +ao_scheme_const.h: ../make-const/ao_scheme_make_const ../ao_scheme_const.scheme + ../make-const/ao_scheme_make_const -o $@ ../ao_scheme_const.scheme clean:: - rm -f $(OBJS) ao_scheme_test + rm -f $(OBJS) ao-scheme ao_scheme_const.h -install: ao_scheme_test - cp ao_scheme_test $$HOME/bin/ao-scheme +install: ao-scheme + install -t $$HOME/bin $^ diff --git a/src/scheme/test/ao_scheme_os.h b/src/scheme/test/ao_scheme_os.h index ea363fb3..b225b2e8 100644 --- a/src/scheme/test/ao_scheme_os.h +++ b/src/scheme/test/ao_scheme_os.h @@ -24,12 +24,11 @@ #define AO_SCHEME_POOL_TOTAL 32768 #define AO_SCHEME_SAVE 1 -#define DBG_MEM_STATS 1 extern int ao_scheme_getc(void); static inline void -ao_scheme_os_flush() { +ao_scheme_os_flush(void) { fflush(stdout); } diff --git a/src/scheme/test/ao_scheme_test.c b/src/scheme/test/ao_scheme_test.c index 0c77d8d5..45068369 100644 --- a/src/scheme/test/ao_scheme_test.c +++ b/src/scheme/test/ao_scheme_test.c @@ -107,6 +107,7 @@ main (int argc, char **argv) } ao_scheme_read_eval_print(); +#ifdef DBG_MEM_STATS printf ("collects: full: %lu incremental %lu\n", ao_scheme_collects[AO_SCHEME_COLLECT_FULL], ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); @@ -136,4 +137,5 @@ main (int argc, char **argv) (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL], (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] / (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]); +#endif } diff --git a/src/scheme/tiny-test/.gitignore b/src/scheme/tiny-test/.gitignore new file mode 100644 index 00000000..7c4c3956 --- /dev/null +++ b/src/scheme/tiny-test/.gitignore @@ -0,0 +1 @@ +ao-scheme-tiny diff --git a/src/scheme/tiny-test/Makefile b/src/scheme/tiny-test/Makefile new file mode 100644 index 00000000..6b1fe003 --- /dev/null +++ b/src/scheme/tiny-test/Makefile @@ -0,0 +1,28 @@ +include ../Makefile-inc + +vpath %.o . +vpath %.c .. +vpath %.h .. + +DEFS= + +SRCS=$(SCHEME_SRCS) ao_scheme_test.c +HDRS=$(SCHEME_HDRS) ao_scheme_const.h + +OBJS=$(SRCS:.c=.o) + +CFLAGS=-O0 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast + +ao-scheme-tiny: $(OBJS) + cc $(CFLAGS) -o $@ $(OBJS) -lm + +$(OBJS): $(HDRS) + +ao_scheme_const.h: ../make-const/ao_scheme_make_const ao_scheme_tiny_const.scheme + ../make-const/ao_scheme_make_const -o $@ -d FLOAT,VECTOR,QUASI,BIGINT ao_scheme_tiny_const.scheme + +clean:: + rm -f $(OBJS) ao-scheme-tiny ao_scheme_const.h + +install: ao-scheme-tiny + cp $^ $$HOME/bin diff --git a/src/scheme/tiny-test/ao_scheme_os.h b/src/scheme/tiny-test/ao_scheme_os.h new file mode 100644 index 00000000..b9f3e31f --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_os.h @@ -0,0 +1,67 @@ +/* + * Copyright © 2016 Keith Packard <keithp@keithp.com> + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; version 2 of the License. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. + */ + +#ifndef _AO_SCHEME_OS_H_ +#define _AO_SCHEME_OS_H_ + +#include <stdio.h> +#include <stdlib.h> +#include <time.h> + +#define AO_SCHEME_POOL_TOTAL 4096 +#define AO_SCHEME_SAVE 1 + +extern int ao_scheme_getc(void); + +static inline void +ao_scheme_os_flush(void) { + fflush(stdout); +} + +static inline void +ao_scheme_abort(void) +{ + abort(); +} + +static inline void +ao_scheme_os_led(int led) +{ + printf("leds set to 0x%x\n", led); +} + +#define AO_SCHEME_JIFFIES_PER_SECOND 100 + +static inline void +ao_scheme_os_delay(int jiffies) +{ + struct timespec ts = { + .tv_sec = jiffies / AO_SCHEME_JIFFIES_PER_SECOND, + .tv_nsec = (jiffies % AO_SCHEME_JIFFIES_PER_SECOND) * (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND) + }; + nanosleep(&ts, NULL); +} + +static inline int +ao_scheme_os_jiffy(void) +{ + struct timespec tp; + clock_gettime(CLOCK_MONOTONIC, &tp); + return tp.tv_sec * AO_SCHEME_JIFFIES_PER_SECOND + (tp.tv_nsec / (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND)); +} + +#endif diff --git a/src/scheme/tiny-test/ao_scheme_test.c b/src/scheme/tiny-test/ao_scheme_test.c new file mode 100644 index 00000000..45068369 --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_test.c @@ -0,0 +1,141 @@ +/* + * Copyright © 2016 Keith Packard <keithp@keithp.com> + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + */ + +#include "ao_scheme.h" +#include <stdio.h> + +static FILE *ao_scheme_file; +static int newline = 1; + +static char save_file[] = "scheme.image"; + +int +ao_scheme_os_save(void) +{ + FILE *save = fopen(save_file, "w"); + + if (!save) { + perror(save_file); + return 0; + } + fwrite(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, save); + fclose(save); + return 1; +} + +int +ao_scheme_os_restore_save(struct ao_scheme_os_save *save, int offset) +{ + FILE *restore = fopen(save_file, "r"); + size_t ret; + + if (!restore) { + perror(save_file); + return 0; + } + fseek(restore, offset, SEEK_SET); + ret = fread(save, sizeof (struct ao_scheme_os_save), 1, restore); + fclose(restore); + if (ret != 1) + return 0; + return 1; +} + +int +ao_scheme_os_restore(void) +{ + FILE *restore = fopen(save_file, "r"); + size_t ret; + + if (!restore) { + perror(save_file); + return 0; + } + ret = fread(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, restore); + fclose(restore); + if (ret != AO_SCHEME_POOL_TOTAL) + return 0; + return 1; +} + +int +ao_scheme_getc(void) +{ + int c; + + if (ao_scheme_file) + return getc(ao_scheme_file); + + if (newline) { + if (ao_scheme_read_list) + printf("+ "); + else + printf("> "); + newline = 0; + } + c = getchar(); + if (c == '\n') + newline = 1; + return c; +} + +int +main (int argc, char **argv) +{ + (void) argc; + + while (*++argv) { + ao_scheme_file = fopen(*argv, "r"); + if (!ao_scheme_file) { + perror(*argv); + exit(1); + } + ao_scheme_read_eval_print(); + fclose(ao_scheme_file); + ao_scheme_file = NULL; + } + ao_scheme_read_eval_print(); + +#ifdef DBG_MEM_STATS + printf ("collects: full: %lu incremental %lu\n", + ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf ("freed: full %lu incremental %lu\n", + ao_scheme_freed[AO_SCHEME_COLLECT_FULL], + ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("loops: full %lu incremental %lu\n", + ao_scheme_loops[AO_SCHEME_COLLECT_FULL], + ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("loops per collect: full %f incremental %f\n", + (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("freed per collect: full %f incremental %f\n", + (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("freed per loop: full %f incremental %f\n", + (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]); +#endif +} diff --git a/src/scheme/tiny-test/ao_scheme_tiny_const.scheme b/src/scheme/tiny-test/ao_scheme_tiny_const.scheme new file mode 100644 index 00000000..d0c0e578 --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_tiny_const.scheme @@ -0,0 +1,389 @@ +; +; Copyright © 2016 Keith Packard <keithp@keithp.com> +; +; This program is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation, either version 2 of the License, or +; (at your option) any later version. +; +; This program is distributed in the hope that it will be useful, but +; WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +; General Public License for more details. +; +; Lisp code placed in ROM + + ; return a list containing all of the arguments +(def (quote list) (lambda l l)) + +(def (quote def!) + (macro (a b) + (list + def + (list quote a) + b) + ) + ) + +(begin + (def! append + (lambda args + (def! a-l + (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (a-l (cdr a) b))) + ) + ) + ) + + (def! a-ls + (lambda (l) + (cond ((null? l) l) + ((null? (cdr l)) (car l)) + (else (a-l (car l) (a-ls (cdr l)))) + ) + ) + ) + (a-ls args) + ) + ) + 'append) + +(append '(a b c) '(d e f) '(g h i)) + + ; + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated. + ; + ; Also accepts the alternate + ; form for defining lambdas of + ; (define (name a y z) sexprs ...) + ; + +(begin + (def (quote define) + (macro (a . b) + ; check for alternate lambda definition form + + (cond ((list? a) + (set! b + (cons lambda (cons (cdr a) b))) + (set! a (car a)) + ) + (else + (set! b (car b)) + ) + ) + (cons begin + (cons + (cons def + (cons (cons quote (cons a '())) + (cons b '()) + ) + ) + (cons + (cons quote (cons a '())) + '()) + ) + ) + ) + ) + 'define + ) + + ; basic list accessors + +(define (caar l) (car (car l))) + +(define (cadr l) (car (cdr l))) + +(define (cdar l) (cdr (car l))) + +(define (caddr l) (car (cdr (cdr l)))) + + ; (if <condition> <if-true>) + ; (if <condition> <if-true> <if-false) + +(define if + (macro (test . args) + (cond ((null? (cdr args)) + (list cond (list test (car args))) + ) + (else + (list cond + (list test (car args)) + (list 'else (cadr args)) + ) + ) + ) + ) + ) + +(if (> 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + + ; simple math operators + +(define zero? (macro (value) (list eqv? value 0))) + +(zero? 1) +(zero? 0) +(zero? "hello") + +(define positive? (macro (value) (list > value 0))) + +(positive? 12) +(positive? -12) + +(define negative? (macro (value) (list < value 0))) + +(negative? 12) +(negative? -12) + +(define (abs a) (if (>= a 0) a (- a))) + +(abs 12) +(abs -12) + +(define max (lambda (a . b) + (while (not (null? b)) + (cond ((< a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(max 1 2 3) +(max 3 2 1) + +(define min (lambda (a . b) + (while (not (null? b)) + (cond ((> a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(min 1 2 3) +(min 3 2 1) + +(define (even? a) (zero? (% a 2))) + +(even? 2) +(even? -2) +(even? 3) +(even? -1) + +(define (odd? a) (not (even? a))) + +(odd? 2) +(odd? -2) +(odd? 3) +(odd? -1) + + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a (- b 1))) + ) + ) + +(define (list-ref a b) + (car (list-tail a b)) + ) + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a) (- b 1)))) + +(list-tail '(1 2 3) 2) + +(define (list-ref a b) (car (list-tail a b))) + +(list-ref '(1 2 3) 2) + + + ; define a set of local + ; variables one at a time and + ; then evaluate a list of + ; sexprs + ; + ; (let* (var-defines) sexprs) + ; + ; where var-defines are either + ; + ; (name value) + ; + ; or + ; + ; (name) + ; + ; e.g. + ; + ; (let* ((x 1) (y)) (set! y (+ x 1)) y) + +(define let* + (macro (a . b) + + ; + ; make the list of names in the let + ; + + (define (_n a) + (cond ((not (null? a)) + (cons (car (car a)) + (_n (cdr a)))) + (else ()) + ) + ) + + ; the set of expressions is + ; the list of set expressions + ; pre-pended to the + ; expressions to evaluate + + (define (_v a b) + (cond ((null? a) b) (else + (cons + (list set + (list quote + (car (car a)) + ) + (cond ((null? (cdr (car a))) ()) + (else (cadr (car a)))) + ) + (_v (cdr a) b) + ) + ) + ) + ) + + ; the parameters to the lambda is a list + ; of nils of the right length + + (define (_z a) + (cond ((null? a) ()) + (else (cons () (_z (cdr a)))) + ) + ) + ; build the lambda. + + (cons (cons lambda (cons (_n a) (_v a b))) (_z a)) + ) + ) + +(let* ((a 1) (y a)) (+ a y)) + +(define let let*) + ; recursive equality + +(define (equal? a b) + (cond ((eq? a b) #t) + ((pair? a) + (cond ((pair? b) + (cond ((equal? (car a) (car b)) + (equal? (cdr a) (cdr b))) + ) + ) + ) + ) + ) + ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b)) + +(define member (lambda (obj a . test?) + (cond ((null? a) + #f + ) + (else + (if (null? test?) (set! test? equal?) (set! test? (car test?))) + (if (test? obj (car a)) + a + (member obj (cdr a) test?)) + ) + ) + ) + ) + +(member '(2) '((1) (2) (3))) + +(member '(4) '((1) (2) (3))) + +(define (memq obj a) (member obj a eq?)) + +(memq 2 '(1 2 3)) + +(memq 4 '(1 2 3)) + +(memq '(2) '((1) (2) (3))) + +(define (_assoc a b t?) + (if (null? b) + #f + (if (t? a (caar b)) + (car b) + (_assoc a (cdr b) t?) + ) + ) + ) + +(define (assq a b) (_assoc a b eq?)) +(define (assoc a b) (_assoc a b equal?)) + +(assq 'a '((a 1) (b 2) (c 3))) +(assoc '(c) '((a 1) (b 2) ((c) 3))) + +(define string (lambda a (list->string a))) + +(display "apply\n") +(apply cons '(a b)) + +(define map + (lambda (a . b) + (define (args b) + (cond ((null? b) ()) + (else + (cons (caar b) (args (cdr b))) + ) + ) + ) + (define (next b) + (cond ((null? b) ()) + (else + (cons (cdr (car b)) (next (cdr b))) + ) + ) + ) + (define (domap b) + (cond ((null? (car b)) ()) + (else + (cons (apply a (args b)) (domap (next b))) + ) + ) + ) + (domap b) + ) + ) + +(map cadr '((a b) (d e) (g h))) + +(define for-each (lambda (a . b) + (apply map a b) + #t)) + +(for-each display '("hello" " " "world" "\n")) + +(define (newline) (write-char #\newline)) + +(newline) diff --git a/src/stm/altos-loader.ld b/src/stm/altos-loader.ld index a4a7dc43..806b4842 100644 --- a/src/stm/altos-loader.ld +++ b/src/stm/altos-loader.ld @@ -72,8 +72,9 @@ SECTIONS { } >ram AT>rom /* Data -- relocated to RAM, but written to ROM + * Also aligned to 8 bytes to agree with textram */ - .data : { + .data BLOCK(8): { *(.data) /* initialized data */ __data_end__ = .; } >ram AT>rom diff --git a/src/stmf0/altos-loader.ld b/src/stmf0/altos-loader.ld index c458116b..05887d0e 100644 --- a/src/stmf0/altos-loader.ld +++ b/src/stmf0/altos-loader.ld @@ -72,9 +72,10 @@ SECTIONS { __text_ram_end = .; } >ram AT>rom - /* Data -- relocated to RAM, but written to ROM + /* Data -- relocated to RAM, but written to ROM. + * also aligned to 8 bytes in case textram is empty */ - .data : { + .data BLOCK(8): { *(.data) /* initialized data */ __data_end__ = .; } >ram AT>rom |