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/
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/
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
"")
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
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'`
#
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 \
telemini-v3.svg \
easymega.svg
-RELNOTES_PDF=$(RELNOTES_INC:.inc=.pdf)
RELNOTES_HTML=$(RELNOTES_INC:.inc=.html)
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 \
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
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
.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:
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:
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
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
</legalnotice>
<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>
</legalnotice>
<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>
[appendix]
== Release Notes
+ :leveloffset: 2
+ include::release-notes-1.8.4.raw[]
+
+ <<<<
:leveloffset: 2
include::release-notes-1.8.3.raw[]
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
+++ /dev/null
-<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>
--- /dev/null
+= 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.
+++ /dev/null
-<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>
[appendix]
== Release Notes
+ :leveloffset: 2
+ include::release-notes-1.8.4.raw[]
+
+ <<<<
+
:leveloffset: 2
include::release-notes-1.8.3.raw[]
[appendix]
== Release Notes
+ :leveloffset: 2
+ include::release-notes-1.8.4.raw[]
+
+ <<<<
+
:leveloffset: 2
include::release-notes-1.8.3.raw[]
--- /dev/null
+/*
+ * 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;
+}
void
ao_eeprom_write(uint16_t addr, void *buf, uint16_t len);
+uint16_t
+ao_adc_read(uint8_t mux);
+
#endif /* _AO_ARCH_H_ */
#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 */
#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)
#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
void
ao_cmd_init(void);
+void
+ao_cmd(void);
+
#if HAS_CMD_FILTER
/*
* Provided by an external module to filter raw command lines
}
#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" },
ao_cmd_init(void)
{
ao_cmd_register(&ao_base_cmds[0]);
+#if HAS_TASK
ao_add_task(&ao_cmd_task, ao_cmd, "cmd");
+#endif
}
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)
{
lambdakey-*
ao_product.h
+ao_scheme_const.h
ao_product.h \
ao_task.h \
$(SCHEME_HDRS) \
+ ao_scheme_const.h \
stm32f0.h \
Makefile
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
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)
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:
{
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();
}
--- /dev/null
+;
+; 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)
#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
#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
*/
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
/* Data -- relocated to RAM, but written to ROM
*/
- .data : {
+ .data BLOCK(8): {
*(.data) /* initialized data */
- . = ALIGN(4);
+ . = ALIGN(8);
__data_end__ = .;
} >ram AT>rom
PROVIDE(end = .);
PROVIDE(__stack__ = ORIGIN(stack) + LENGTH(stack));
-
- __flash__ = ORIGIN(flash);
}
ENTRY(start);
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
*(.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
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)
-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 > $@
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:
#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>
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))
#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)
#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
/* 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
#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
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);
char name[];
};
+struct ao_scheme_string {
+ uint8_t type;
+ char val[];
+};
+
struct ao_scheme_val {
ao_poly atom;
ao_poly val;
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;
};
#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;
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)
{
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 *
return ao_scheme_ref(poly);
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
static inline ao_poly
ao_scheme_float_poly(struct ao_scheme_float *f)
{
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)
{
{
return ao_scheme_ref(poly);
}
+#endif
/* memory functions */
extern uint64_t ao_scheme_freed[2];
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);
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
#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);
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;
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);
/* 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;
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);
/* 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);
}
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);
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);
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;
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);
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);
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);
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);
/* 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 */
/* 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)
#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)
{
#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++)
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;
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;
}
}
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);
}
};
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
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
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[] = {
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));
}
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;
}
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
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
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(" ");
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)) {
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)
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:
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;
}
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;
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:
default:
break;
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
} else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) {
float l, r;
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))
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;
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;
ao_poly
ao_scheme_do_string_set(struct ao_scheme_cons *cons)
{
- char *string;
+ char *string;
int32_t ref;
int32_t val;
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;
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));
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;
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;
}
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))) {
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
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;
}
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
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
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;
}
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)
{
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)));
}
return ao_scheme_do_typep(AO_SCHEME_VECTOR, cons);
}
+#endif /* AO_SCHEME_FEATURE_VECTOR */
+
#define AO_SCHEME_BUILTIN_FUNCS
#include "ao_scheme_builtin.h"
-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?
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);
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;
}
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;
}
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;
}
}
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));
}
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;
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;
}
}
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);
}
}
}
(macro (first . rest)
; check for alternate lambda definition form
- (cond ((list? first)
+ (cond ((pair? first)
(set! rest
(append
(list
(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))
)
(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)))
- ;
-;
-
#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;
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 *));
}
void
-ao_scheme_printf(char *format, ...)
+ao_scheme_printf(const char *format, ...)
{
va_list args;
va_start(args, format);
}
ao_poly
-ao_scheme_error(int error, char *format, ...)
+ao_scheme_error(int error, const char *format, ...)
{
va_list args;
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;
}
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)
}
/* 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;
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);
DBGI(".. frame "); DBG_POLY(ao_scheme_frame_poly(ao_scheme_frame_current)); DBG("\n");
break;
}
- ao_scheme_skip_cons_free = 0;
return 1;
}
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;
}
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;
}
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");
#include "ao_scheme.h"
#include <math.h>
+#ifdef AO_SCHEME_FEATURE_FLOAT
+
static void float_mark(void *addr)
{
(void) addr;
#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)) {
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;
}
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
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"));
}
}
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)
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;
.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
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);
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);
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);
#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
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);
}
};
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 */
#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;
ao_scheme_poly_mark(lambda->frame, 0);
}
-void
+static void
lambda_move(void *addr)
{
struct ao_scheme_lambda *lambda = addr;
};
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);
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;
}
}
- 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;
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;
#!/usr/bin/nickle
typedef struct {
+ string feature;
string type;
string c_name;
string[*] lisp_names;
"macro" => "MACRO",
"f_lambda" => "F_LAMBDA",
"atom" => "atom",
+ "feature" => "feature",
};
string[*]
{
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
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),
};
}
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");
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");
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");
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");
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");
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");
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]);
}
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);
dump_decls(builtins);
dump_consts(builtins);
dump_atoms(builtins);
+ dump_atom_names(builtins);
+ dump_features(builtins);
}
}
#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) {
}
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;
return crc;
}
-uint16_t
+static uint16_t
ao_fec_crc(const uint8_t *bytes, uint8_t len)
{
uint16_t crc = AO_FEC_CRC_INIT;
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;
return 0;
}
-void
+static void
ao_scheme_macro_pop(void)
{
struct ao_scheme_macro_stack *m = macro_stack;
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);
return AO_SCHEME_NIL;
}
-ao_poly
+static ao_poly
ao_is_macro(ao_poly p)
{
struct ao_scheme_builtin *builtin;
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) {
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;
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;
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)
{
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;
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");
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) {
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));
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");
#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;
}
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) {
#else
#define ao_scheme_record_reset()
+#define ao_scheme_record(t,a,s)
#endif
uint8_t ao_scheme_exception;
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,
#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];
/* 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;
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);
}
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);
note_chunk(uint16_t offset, uint16_t size)
{
int l;
+ int end;
if (offset < chunk_low || chunk_high <= offset)
return;
/* 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],
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
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,
[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)
{
#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;
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)
/* 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();
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
/* 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)
#endif
}
+#if DBG_MEM_STATS
+ loops++;
+#endif
/* If we ran into the end of the heap, then
* there's no need to keep walking
*/
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;
}
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)) {
*/
-/*
- * 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
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);
/*
* Mark an object and all that it refereces
*/
-int
+static int
ao_scheme_mark(const struct ao_scheme_type *type, void *addr)
{
int ret;
{
uint8_t type;
void *addr;
+ int ret;
type = ao_scheme_poly_base_type(p);
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;
}
}
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;
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;
}
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;
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;
}
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;
}
#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 *
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;
}
PRINTABLE|SPECIAL, /* ) */
PRINTABLE, /* * */
PRINTABLE|SIGN, /* + */
- PRINTABLE|SPECIAL, /* , */
+ PRINTABLE|SPECIAL_QUASI, /* , */
PRINTABLE|SIGN, /* - */
PRINTABLE|DOTC|FLOATC, /* . */
PRINTABLE, /* / */
PRINTABLE, /* ] */
PRINTABLE, /* ^ */
PRINTABLE, /* _ */
- PRINTABLE|SPECIAL, /* ` */
+ PRINTABLE|SPECIAL_QUASI, /* ` */
PRINTABLE, /* a */
PRINTABLE, /* b */
PRINTABLE, /* c */
}
}
+#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)
token_string[token_len] = '\0';
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
+static float token_float;
+
struct namedfloat {
const char *name;
float value;
};
#define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
+#endif
static int
_lex(void)
return QUOTE;
case '.':
return DOT;
+#ifdef AO_SCHEME_FEATURE_QUASI
case '`':
return QUASIQUOTE;
case ',':
lex_unget(c);
return UNQUOTE;
}
+#endif
}
}
if (lex_class & POUND) {
add_token(c);
end_token();
return BOOL;
+#ifdef AO_SCHEME_FEATURE_VECTOR
case '(':
return OPEN_VECTOR;
+#endif
case '\\':
for (;;) {
int alphabetic;
}
}
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 &&
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') {
else
epos = token_len + 1;
}
+#endif
if (lex_class & DIGIT) {
hasdigit = 1;
if (isint)
}
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);
token_int = -token_int;
return NUM;
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
if (isfloat && hasdigit) {
token_float = strtof(token_string, NULL);
return FLOAT;
token_float = namedfloats[u].value;
return FLOAT;
}
+#endif
return NAME;
}
}
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;
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;
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++;
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;
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++;
case QUOTE:
v = _ao_scheme_atom_quote;
break;
+#ifdef AO_SCHEME_FEATURE_QUASI
case QUASIQUOTE:
v = _ao_scheme_atom_quasiquote;
break;
case UNQUOTE_SPLICING:
v = _ao_scheme_atom_unquote2dsplicing;
break;
+#endif
}
break;
case CLOSE:
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) {
# 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
# 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 - ' ' */
break;
ao_scheme_exception = 0;
} else {
- ao_scheme_poly_write(out);
+ ao_scheme_poly_write(out, true);
putchar ('\n');
}
}
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);
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");
}
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);
+ }
+ }
}
/*
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;
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");
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)
.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;
}
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);
}
--- /dev/null
+/*
+ * 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 */
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 $@
-ao_scheme_test
+ao-scheme
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 $^
#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);
}
}
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]);
(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
}
--- /dev/null
+ao-scheme-tiny
--- /dev/null
+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
--- /dev/null
+/*
+ * 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
--- /dev/null
+/*
+ * 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
+}
--- /dev/null
+;
+; 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)
} >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
__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
projects / fw / altos / commitdiff