scaffold: Add local-static-array.c.

GCC gives

    12:35:54 janneke@dundal:~/src/mes/wip-m2 [env]
    $ gcc scaffold/local-static-array.c
    12:36:01 janneke@dundal:~/src/mes/wip-m2 [env]
    $ ./a.out
    hello local static
    hello local static
    12:36:04 janneke@dundal:~/src/mes/wip-m2 [env]

M2-Planet gives

    12:36:04 janneke@dundal:~/src/mes/wip-m2 [env]
    $ kaem --verbose --strict --file scaffold/local-static-array.kaem
     +> M2-Planet --debug --architecture x86 -f lib/mes/globals.c -f lib/linux/x86-mes-m2/mini.c -f lib/mes/mini-write.c -f lib/string/strlen.c -f lib/string/strcpy.c -f lib/mes/eputs.c -f scaffold/local-static-array.c -o scaffold/local-static-array.M1
    scaffold/local-static-array.c:29:static is not a defined symbol
    Subprocess error 256
    ABORTING HARD
    [1]12:36:07 janneke@dundal:~/src/mes/wip-m2 [env]

* scaffold/local-static-array.c: New file.
* scaffold/local-static-array.kaem: New file.

.dir-locals.el

@@ -1,5 +1,5 @@
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -35,6 +35,14 @@
   .
   ((geiser-active-implementations . (guile))
 
+   ;; Guile syntax
+   (eval . (put 'pass-if             'scheme-indent-function 1))
+   (eval . (put 'pass-if-not         'scheme-indent-function 1))
+   (eval . (put 'pass-if-eq          'scheme-indent-function 2))
+   (eval . (put 'pass-if-equal       'scheme-indent-function 2))
+   (eval . (put 'expect-fail         'scheme-indent-function 2))
+   (eval . (put 'pass-if-timeout     'scheme-indent-function 2))
+
    ;; Guix package
    (eval . (put 'package 'scheme-indent-function 0))
    (eval . (put 'origin 'scheme-indent-function 0))
@@ -50,6 +58,7 @@
 
    (eval
     .
+
     (progn
       (defun prefix-dir-locals-dir (elt)
         (concat (locate-dominating-file buffer-file-name ".dir-locals.el") elt))

.gitignore

@@ -33,30 +33,45 @@
 *.mini-hex2
 *.a
 *.o
+*.h.m2
+*.c.m2
 *.seed-out
+*.stderr
+*.stdout
+
+*.x86-out
+
+/TAGS
+
+/lib/x86-mes/0exit-42
+/lib/x86-mes/exit-42
 
 /lib/tests/*/[0-9a][0-9a-z]-*
 !/lib/tests/*/*.c
 !/lib/tests/*/*.exit
 !/lib/tests/*/*.stdout
 
+/scaffold/*.M1
+/scaffold/*.m2
+/scaffold/*.hex2
 /scaffold/argv
 /scaffold/hello
 /scaffold/main
 /scaffold/micro-mes
+/scaffold/read
 /scaffold/tiny-mes
 
-/scaffold/tests/[0-9a][0-9a-z]-*
-/scaffold/tests/t.*
-!/scaffold/tests/*.c
-!/scaffold/tests/*.exit
-!/scaffold/tests/*.stdout
+/scaffold/argv-m2
+/scaffold/hello-m2
+/scaffold/main-m2
+/scaffold/micro-mes-m2
+/scaffold/read-m2
+/scaffold/tiny-mes-m2
 
 /.config.make
 /.store
 /.tarball-version
 
-/out
 ?
 ?.mes
 \#*#

AUTHORS

@@ -13,6 +13,8 @@ Additions and fixes throughout
 Jeremiah Orians <jeremiah@pdp10.guru>
 lib/stdio/fopen.c (first simple version of fopen)
 scaffold/tests/98-fopen.c
+Initial work on elf headers:
+lib/linux/x86-mes/elf32-header.hex2 and similar
 
 Han-Wen Nienhuys <hanwen@xs4all.nl>
 lib/string/memmem.c (_memmem, memmem)
@@ -56,11 +58,8 @@ module/mes/getopt-long.scm
 Optargs from Guile
 mes/module/mes/optargs.scm
 
-PEG from Guile
-mes/module/mes/peg/
-
 Pmatch from Guile
-mes/module/mes/pmatch.scm
+mes/module/system/base/pmatch.scm
 
 Pretty-print from Guile
 mes/module/mes/pretty-print.scm
@@ -84,6 +83,10 @@ lib/mach/msg.c
 lib/mach/mach-init.c
 lib/mach/*.S
 
+M2-Planet dependencies
+lib/m2/x86/x86_defs.M1
+lib/m2/x86/ELF-i386-debug.hex2
+
 * legalese
 Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 

HACKING

@@ -49,6 +49,23 @@ Configure to compile with Tiny CC
      - bytes read
   6) globals
 
+* TESTING
+** make check recheck=true TESTS="tests/base lib/tests/scaffold/t.c"
+** mescc
+
+*** To skip MES tests, in "./check.sh", comment-out check-boot.sh, check-mes.sh.
+
+*** Running individual tests
+#+BEGIN_SRC bash
+cd gcc-lib
+V=2 CC=i686-unknown-linux-gnu-gcc ../pre-inst-env test-c.sh ../lib/tests/scaffold/t.c
+#+END_SRC
+
+#+BEGIN_SRC bash
+cd mescc-lib
+V=2 CC=mescc ../pre-inst-env test-c.sh ../lib/tests/scaffold/t.c
+#+END_SRC
+
 * Bugs
 ** mes: performance, Mes is now 2-10x slower than Guile.
 ** mes/mescc lack support for fork/exec on the Hurd.
@@ -184,7 +201,7 @@ https://notabug.org/rain1/hex86/src/master/tests/hex0b3.hex86
 ** linux syscalls: https://fedora.juszkiewicz.com.pl/syscalls.html
 * legalese
 
-Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+Copyright © 2016,2017,2018,2019,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 
   Copying and distribution of this file, with or without modification,
   are permitted in any medium without royalty provided the copyright

README

@@ -11,8 +11,8 @@ create a full source bootstrap as part of the [[http://bootstrappable.org][boots
 effort for UNIX-like operating systems.
 
 The Scheme interpreter is written in ~5,000 LOC of simple C, and the C
-compiler written in Scheme and these are mutual self-hosting.  This
-mes.c is now being simplified to be transpiled by [[https://github.com/oriansj/m2-planet][M2-Planet]].
+compiler written in Scheme and these are mutual self-hosting.  Mes can
+now be bootstrapped by [[https://github.com/oriansj/m2-planet][M2-Planet]] and [[https://savannah.nongnu.org/projects/mescc-tools][Mescc-Tools]].
 
 Mes has a Garbage Collector, a library of loadable Scheme modules--
 notably Dominique Boucher's [[https://github.com/schemeway/lalr-scm][LALR]], Pre-R6RS [[https://www.cs.indiana.edu/chezscheme/syntax-case/old-psyntax.html][portable syntax-case]] with
@@ -71,17 +71,18 @@ General Public Licence version 3 or later.  See the file [[file:COPYING][COPYING
   [2] https://www.gnu.org/software/guix
   [3] https://bootstrappable.org
   [4] https://github.com/oriansj/m2-planet
-  [5] https://github.com/schemeway/lalr-scm
-  [6] https://www.cs.indiana.edu/chezscheme/syntax-case/old-psyntax.html
-  [7] https://www.nongnu.org/nyacc
-  [8] https://gitlab.com/janneke/tinycc
-  [9] [[http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf]]
-  [10] https://github.com/oriansj/stage0
-  [11] https://nlnet.nl/project/GNUMes
-  [12] https://nlnet.nl/project/GNUMes-arm
+  [5] https://savannah.nongnu.org/projects/mescc-tools
+  [6] https://github.com/schemeway/lalr-scm
+  [7] https://www.cs.indiana.edu/chezscheme/syntax-case/old-psyntax.html
+  [8] https://www.nongnu.org/nyacc
+  [9] https://gitlab.com/janneke/tinycc
+  [10] [[http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf]]
+  [11] https://savannah.nongnu.org/projects/stage0
+  [12] https://nlnet.nl/project/GNUMes
+  [13] https://nlnet.nl/project/GNUMes-arm
 
 * Legalese
-Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <[[mailto:janneke@gnu.org][janneke@gnu.org]]>
+Copyright © 2016,2017,2018,2019,2020,2021 Jan (janneke) Nieuwenhuizen <[[mailto:janneke@gnu.org][janneke@gnu.org]]>
 
   Copying and distribution of this file, with or without modification,
   are permitted in any medium without royalty provided the copyright

build-aux/GNUmakefile.in

@@ -135,7 +135,7 @@ maintainer-clean: distclean
 	rm -f doc/version.texi
 
 TAGS:
-	etags ${srcdest}lib/*.c ${srcdest}lib/*/*.c ${srcdest}src/*.c ${srcdest}include/*.h ${srcdest}include/sys/*.h
+	etags ${srcdest}lib/*.c ${srcdest}lib/*/*.c ${srcdest}src/*.c ${srcdest}include/*.h ${srcdest}include/*/*.h ${srcdest}include/sys/*.h
 
 all-go:
 	${srcdest}build-aux/build-guile.sh

build-aux/bootstrap.sh.in

@@ -35,6 +35,11 @@ MES_PREFIX=${MES_PREFIX-$PWD}
 . ${srcdest}build-aux/configure-lib.sh
 . ${srcdest}build-aux/cflags.sh
 
+if test -n "@M2_PLANET@"; then
+    echo "  KAEM         kaem.run"
+    kaem --strict --verbose
+fi
+
 CPPFLAGS="-D HAVE_CONFIG_H=1 -I include"
 libdir=$PWD/lib
 export libdir

build-aux/build-mes.sh

@@ -30,24 +30,11 @@ fi
 . ./config.sh
 . ${srcdest}build-aux/trace.sh
 . ${srcdest}build-aux/cc.sh
+. ${srcdest}build-aux/configure-lib.sh
 
 trap 'test -f .log && cat .log' EXIT
 
-mes_sources="
-src/gc.c
-src/hash.c
-src/lib.c
-src/math.c
-src/mes.c
-src/module.c
-src/posix.c
-src/reader.c
-src/string.c
-src/struct.c
-src/vector.c
-"
-
-for c in $mes_sources; do
+for c in $mes_SOURCES; do
     compile $c
 done
 if test $mes_libc = system; then

build-aux/build.sh.in

@@ -97,11 +97,27 @@ fi
 -I ${srcdest}include
 -I ${srcdest}include/$mes_kernel/$mes_cpu
 "
-    if test $compiler = gcc; then
+    if test "$compiler" != bootstrap; then
         ${SHELL} ${srcdest}build-aux/build-mes.sh
     fi
 )
 
+if test -n "$M2_PLANET"; then
+    (
+        . ${srcdest}build-aux/trace.sh
+        if [ -z "$V" -o "$V" = 0 ]; then
+            __verbose=
+        else
+            __verbose=--verbose
+        fi
+        trace "KAEM       scaffold/main.kaem" kaem --strict $__verbose -f scaffold/main.kaem
+        trace "KAEM       scaffold/hello.kaem" kaem --strict $__verbose -f scaffold/hello.kaem
+        trace "KAEM       scaffold/argv.kaem" kaem --strict $__verbose -f scaffold/argv.kaem
+        trace "KAEM       scaffold/read.kaem" kaem --strict $__verbose -f scaffold/read.kaem
+        trace "KAEM       kaem.run" kaem --strict $__verbose
+    )
+fi
+
 (
     mkdir -p mescc-lib
     cp config.sh mescc-lib

build-aux/check-boot.sh

@@ -110,6 +110,7 @@ scaffold/boot/50-primitive-load.scm
 scaffold/boot/53-closure-display.scm
 scaffold/boot/60-let-syntax.scm
 scaffold/boot/call-cc.scm
+scaffold/boot/gc.scm
 scaffold/boot/memory.scm
 scaffold/boot/numbers.scm
 "

build-aux/check-mes.sh

@@ -27,6 +27,7 @@ tests/boot.test
 tests/read.test
 tests/srfi-0.test
 tests/macro.test
+tests/gc.test
 tests/perform.test
 tests/base.test
 tests/quasiquote.test

build-aux/check-mescc.sh

@@ -105,6 +105,7 @@ lib/tests/assert/50-assert.c
 lib/tests/mes/50-itoa.c
 lib/tests/posix/50-getenv.c
 lib/tests/stdlib/50-malloc.c
+lib/tests/string/50-memcmp.c
 lib/tests/string/50-strcmp.c
 lib/tests/string/50-strcmp-itoa.c
 lib/tests/string/50-strcpy.c

build-aux/config.sh.in

@@ -35,8 +35,10 @@ GUIX="@GUIX@"
 HELP2MAN="@HELP2MAN@"
 HEX2="@HEX2@"
 LDFLAGS=${LDFLAGS-"@LDFLAGS@"}
+KAEM="@KAEM@"
 MAKEINFO="@MAKEINFO@"
 M1="@M1@"
+M2_PLANET="@M2_PLANET@"
 MES_FOR_BUILD="@MES_FOR_BUILD@"
 NYACC="@NYACC@"
 PACKAGE="@PACKAGE@"

build-aux/configure-lib.sh

@@ -93,6 +93,7 @@ libmes_SOURCES="
 $libc_mini_shared_SOURCES
 lib/ctype/isnumber.c
 lib/mes/abtol.c
+lib/mes/cast.c
 lib/mes/eputc.c
 lib/mes/fdgetc.c
 lib/mes/fdputc.c
@@ -106,6 +107,7 @@ lib/mes/ntoab.c
 lib/mes/oputc.c
 lib/mes/ultoa.c
 lib/mes/utoa.c
+lib/stub/__raise.c
 "
 
 if test $mes_libc = mes; then
@@ -113,6 +115,7 @@ if test $mes_libc = mes; then
 lib/ctype/isdigit.c
 lib/ctype/isspace.c
 lib/ctype/isxdigit.c
+lib/mes/assert_msg.c
 lib/posix/write.c
 lib/stdlib/atoi.c
 "
@@ -187,7 +190,7 @@ lib/stub/execve.c
 lib/stub/fork.c
 lib/stub/_getcwd.c
 lib/stub/gettimeofday.c
-lib/stub/ioctl.c
+lib/stub/ioctl3.c
 lib/stub/time.c
 lib/stub/unlink.c
 lib/stub/waitpid.c
@@ -207,7 +210,7 @@ lib/linux/fork.c
 lib/linux/fsync.c
 lib/linux/_getcwd.c
 lib/linux/gettimeofday.c
-lib/linux/ioctl.c
+lib/linux/ioctl3.c
 lib/linux/_open3.c
 lib/linux/_read.c
 lib/linux/time.c
@@ -411,6 +414,7 @@ lib/linux/getgid.c
 lib/linux/getppid.c
 lib/linux/getrusage.c
 lib/linux/getuid.c
+lib/linux/ioctl.c
 lib/linux/link.c
 lib/linux/lstat.c
 lib/linux/mkdir.c
@@ -429,6 +433,11 @@ lib/linux/symlink.c
 fi
 
 mes_SOURCES="
+src/builtins.c
+src/cc.c
+src/core.c
+src/display.c
+src/eval-apply.c
 src/gc.c
 src/hash.c
 src/lib.c
@@ -437,7 +446,9 @@ src/mes.c
 src/module.c
 src/posix.c
 src/reader.c
+src/stack.c
 src/string.c
 src/struct.c
+src/symbol.c
 src/vector.c
 "

build-aux/install.sh.in

@@ -47,6 +47,9 @@ cp $_v bin/mes ${DESTDIR}${bindir}/mes
 if test -f bin/mes-gcc; then
     cp $_v bin/mes-gcc ${DESTDIR}${bindir}/mes-gcc
 fi
+if test -f bin/mes-m2; then
+    cp $_v bin/mes-m2 ${DESTDIR}${bindir}/mes-m2
+fi
 if test -f bin/mes-mescc; then
     cp $_v bin/mes-mescc ${DESTDIR}${bindir}/mes-mescc
 fi

build-aux/mes-snarf.scm

@@ -4,7 +4,7 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
 !#
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; mes-snarf.scm: This file is part of GNU Mes.
 ;;;
@@ -85,8 +85,7 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
                     (cut string-replace-string <> "_to_" "->")
                     (cut string-replace-suffix <> "_x" "!")
                     (cut string-replace-suffix <> "_x_" "!-")
-                    (cut string-replace-suffix <> "_p" "?")
-                    )
+                    (cut string-replace-suffix <> "_p" "?"))
                    (function.name f))))
         (if (not (string-suffix? "-" name)) name
             (string-append "core:" (string-drop-right name 1))))))
@@ -105,19 +104,26 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
    (format #f "// CONSTANT ~a ~a\n" s i)
    (format #f "#define ~a ~a\n" s i)))
 
+(define (symbol->header s i)
+  (let ((c (string-upcase s)))
+    (string-append
+     (format #f "\n// CONSTANT ~a ~a\n" c i)
+     (format #f "#define ~a ~a\n" c i)
+     (format #f "struct scm *~a; /* ~a */\n" s i))))
+
 (define (function->header f i)
   (let* ((arity (or (assoc-ref (function.annotation f) 'arity)
                     (if (string-null? (function.formals f)) 0
                         (length (string-split (function.formals f) #\,)))))
          (n (if (eq? arity 'n) -1 arity)))
-    (format #f "SCM ~a (~a);\n" (function.name f) (function.formals f))))
+    (format #f "struct scm *~a (~a);\n" (function.name f) (function.formals f))))
 
 (define (function->source f i)
   (let* ((arity (or (assoc-ref (function.annotation f) 'arity)
                     (if (string-null? (function.formals f)) 0
                         (length (string-split (function.formals f) #\,)))))
          (n (if (eq? arity 'n) -1 arity)))
-    (format #f "  a = init_builtin (builtin_type, ~s, ~a, &~a, a);\n" (function.name f) n (function.name f))))
+    (format #f "  a = init_builtin (builtin_type, ~s, ~a, &~a, a);\n" (function-scm-name f) n (function.name f))))
 
 (define (disjoin . predicates)
   (lambda (. arguments)
@@ -125,11 +131,11 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
 
 (define (snarf-symbols string)
   (let* ((lines (string-split string #\newline))
-         (symbols (filter (cut string-prefix? "  init_symbol (" <>) lines)))
+         (symbols (filter (cut string-contains <> " = init_symbol (") lines)))
     (define (line->symbol line)
       ((compose
-        (lambda (s) (string-take s (string-index s #\,)))
-        (cut string-drop <> (string-length "  init_symbol (")))
+        string-trim-both
+        (lambda (s) (string-take s (string-index s #\=))))
        line))
     (map line->symbol symbols)))
 
@@ -144,20 +150,28 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
        (receive (function rest)
            (apply values (string-split-string line " "))
          (and function
-              (equal? (string-trim previous) "SCM")
+              (or (equal? (string-trim previous) "struct scm*")
+                  (equal? (string-trim previous) "struct scm *"))
               (not (string-null? function))
               (not (string-prefix? "#" function))
               (not (string-prefix? "/" function))
               rest
               (receive (parameter-list annotation)
-                  (apply values (string-split-string rest " ///"))
-                (let* ((parameters (string-drop parameter-list 1))
+                  (apply values (string-split-string rest " /*:"))
+                (let* ((parameters (string-trim-both parameter-list))
+                       (parameters (string-drop parameters 1))
                        (parameters (string-drop-right parameters 1))
+                       (annotation (if (string? annotation) (string-trim-both annotation)
+                                       annotation))
+                       (annotation (if (and (string? annotation)
+                                            (string-suffix? "*/" annotation))
+                                       (string-drop-right annotation 2)
+                                       annotation))
                        (formals (if (string-null? parameters) '()
                                     (string-split parameters #\,)))
                        (formals (map string-trim formals)))
                   (and parameters
-                       (let* ((non-SCM (filter (negate (cut string-prefix? "SCM" <>)) formals)))
+                       (let* ((non-SCM (filter (negate (cut string-prefix? "struct scm" <>)) formals)))
                          (and (null? non-SCM)
                               (let ((annotation (and annotation (with-input-from-string annotation read))))
                                 (make-function function parameters annotation))))))))))

build-aux/pointer.sh

@@ -0,0 +1,72 @@
+#! /bin/sh
+
+set -x
+
+ptr_once='s,([^N])(MACRO|NAME|VALUE) \(([^()]*)\),\1\3->\L\2,'
+ptr_once='s,([^N])(BYTES|CAR|CDR|CLOSURE|CONTINUATION|LENGTH|MACRO|NAME|PORT|REF|STRING|STRUCT|TYPE|VALUE|VARIABLE|VECTOR) \(([^()]*)\),\1\3->\L\2,'
+n_once='s,N(TYPE|CAR|CDR|LENGTH|VALUE|VECTOR) \(([^()]*)\),\2->\L\1,'
+ncbytes='s,NC(BYTES) \(([^()]*)\),news_\L\1 (\2),'
+cbytes='s,([^N])C(BYTES) \(([^()]*)\),\1cell_\L\2 (\3),'
+cstring='s,C(STRING) \(([^()]*)\),cell_bytes (STRING (\2)),'
+struct='s,SCM,struct scm *,g'
+struct_scm_p='s,struct scm\* ?,struct scm *,g'
+
+sed -ri                                                         \
+    -e 's,POINTER_CELLS=0,POINTER_CELLS=1',                     \
+    -e 's,#define POINTER_CELLS 0,#define POINTER_CELLS 1',     \
+    -e "$ncbytes"                                               \
+    -e "$cbytes"                                                \
+    -e "$cstring"                                               \
+                                                                \
+    -e "$ncbytes"                                               \
+    -e "$cbytes"                                                \
+    -e "$cstring"                                               \
+                                                                \
+    -e "$ptr_once"                                              \
+    -e "$ptr_once"                                              \
+    -e "$ptr_once"                                              \
+    -e 's,->\<struct\>,->structure,g'                           \
+    -e "$struct"                                                \
+    -e "$struct_scm_p"                                          \
+                                                                \
+    -e "$n_once"                                                \
+    -e "$n_once"                                                \
+                                                                \
+    -e 's,CAR \(([^()]*)\),\1->cdr,'                            \
+    -e 's,CAAR \(([^()]*)\),\1->car->car,'                      \
+    -e 's,CADR \(([^()]*)\),\1->cdr->car,'                      \
+    -e 's,CDAR \(([^()]*)\),\1->car->cdr,'                      \
+    -e 's,CDDR \(([^()]*)\),\1->cdr->cdr,'                      \
+    -e 's,CADAR \(([^()]*)\),\1->car->cdr->car,'                \
+    -e 's,CADDR \(([^()]*)\),\1->cdr->cdr->car,'                \
+    -e 's,CDADR \(([^()]*)\),\1->cdr->car->cdr,'                \
+    -e 's,CDDDR \(([^()]*)\),\1->cdr->cdr->cdr,'                \
+    -e 's,CDDAR \(([^()]*)\),\1->car->cdr->cdr,'                \
+    -e 's,CDADAR \(([^()]*)\),\1->cdr->car->cdr->car,'          \
+                                                                \
+    include/mes/builtins.h                                      \
+    include/mes/mes.h                                           \
+    include/mes/symbols.h                                       \
+    include/mes/builtins.h                                      \
+    include/m2/lib.h                                            \
+    src/builtins.c                                              \
+    src/cc.c                                                    \
+    src/core.c                                                  \
+    src/display.c                                               \
+    src/eval-apply.c                                            \
+    src/gc.c                                                    \
+    src/hash.c                                                  \
+    src/lib.c                                                   \
+    src/m2.c                                                    \
+    src/math.c                                                  \
+    src/mes.c                                                   \
+    src/module.c                                                \
+    src/posix.c                                                 \
+    src/reader.c                                                \
+    src/stack.c                                                 \
+    src/string.c                                                \
+    src/struct.c                                                \
+    src/symbol.c                                                \
+    src/vector.c                                                \
+    src/test/gc.c                                               \
+    simple.make                                                 \

build-aux/snarf.sh

@@ -1,7 +1,7 @@
 #! /bin/sh
 
 # GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Mes.
 #
@@ -20,17 +20,43 @@
 
 set -e
 
-. ${srcdest}build-aux/config.sh
+srcdest=${srcdest-./}
+. ${srcdest}config.sh
 . ${srcdest}build-aux/trace.sh
 
-trace "SNARF$snarf  gc.c"      ${srcdest}build-aux/mes-snarf.scm src/gc.c
-trace "SNARF$snarf  hash.c"    ${srcdest}build-aux/mes-snarf.scm src/hash.c
-trace "SNARF$snarf  lib.c"     ${srcdest}build-aux/mes-snarf.scm src/lib.c
-trace "SNARF$snarf  math.c"    ${srcdest}build-aux/mes-snarf.scm src/math.c
-trace "SNARF$snarf  mes.c"     ${srcdest}build-aux/mes-snarf.scm src/mes.c
-trace "SNARF$snarf  module.c"  ${srcdest}build-aux/mes-snarf.scm src/module.c
-trace "SNARF$snarf  posix.c"   ${srcdest}build-aux/mes-snarf.scm src/posix.c
-trace "SNARF$snarf  reader.c"  ${srcdest}build-aux/mes-snarf.scm src/reader.c
-trace "SNARF$snarf  strings.c" ${srcdest}build-aux/mes-snarf.scm src/string.c
-trace "SNARF$snarf  struct.c"  ${srcdest}build-aux/mes-snarf.scm src/struct.c
-trace "SNARF$snarf  vector.c"  ${srcdest}build-aux/mes-snarf.scm src/vector.c
+trace "SNARF$snarf  builtins.c"   ${srcdest}build-aux/mes-snarf.scm src/builtins.c
+trace "SNARF$snarf  core.c"       ${srcdest}build-aux/mes-snarf.scm src/core.c
+trace "SNARF$snarf  display.c"    ${srcdest}build-aux/mes-snarf.scm src/display.c
+trace "SNARF$snarf  eval-apply.c" ${srcdest}build-aux/mes-snarf.scm src/eval-apply.c
+trace "SNARF$snarf  gc.c"         ${srcdest}build-aux/mes-snarf.scm src/gc.c
+trace "SNARF$snarf  hash.c"       ${srcdest}build-aux/mes-snarf.scm src/hash.c
+trace "SNARF$snarf  lib.c"        ${srcdest}build-aux/mes-snarf.scm src/lib.c
+trace "SNARF$snarf  math.c"       ${srcdest}build-aux/mes-snarf.scm src/math.c
+trace "SNARF$snarf  mes.c"        ${srcdest}build-aux/mes-snarf.scm src/mes.c
+trace "SNARF$snarf  module.c"     ${srcdest}build-aux/mes-snarf.scm src/module.c
+trace "SNARF$snarf  posix.c"      ${srcdest}build-aux/mes-snarf.scm src/posix.c
+trace "SNARF$snarf  reader.c"     ${srcdest}build-aux/mes-snarf.scm src/reader.c
+trace "SNARF$snarf  stack.c"      ${srcdest}build-aux/mes-snarf.scm src/stack.c
+trace "SNARF$snarf  strings.c"    ${srcdest}build-aux/mes-snarf.scm src/string.c
+trace "SNARF$snarf  struct.c"     ${srcdest}build-aux/mes-snarf.scm src/struct.c
+trace "SNARF$snarf  symbol.c"     ${srcdest}build-aux/mes-snarf.scm src/symbol.c
+trace "SNARF$snarf  vector.c"     ${srcdest}build-aux/mes-snarf.scm src/vector.c
+
+for i in src/*.symbols.h; do
+    n=$(basename $i .symbols.h)
+    echo "/* src/$n.c */"
+    cat $i
+    mv $i $(basename $i .symbols.h).s
+done > s
+
+for i in src/*.h; do
+    n=$(basename $i .h)
+    echo "/* src/$n.c */"
+    cat $i
+done > h
+
+for i in src/*.i; do
+    n=$(basename $i .i)
+    echo "  /* src/$n.c */"
+    cat $i
+done > c

configure

@@ -453,7 +453,9 @@ Some influential environment variables:
            (deps (fold (lambda (program results)
                          (cons (check-program-version program) results))
                        '()
-                       (list (make-dep "hex2")
+                       (list (make-dep "kaem" #:version '(0 6) #:optional? #t)
+                             (make-dep "M2-Planet" #:version '(0 1 3) #:optional? #t)
+                             (make-dep "hex2")
                              (make-dep "M1")
                              (make-dep "blood-elf")
                              (make-dep "diff" #:optional? #t)
@@ -513,7 +515,7 @@ Some influential environment variables:
 "))
                            deps)
                      deps))
-           (mesc? (file-name "cc is MES C" deps))
+           (mescc? (file-name "cc is Mes C" deps))
            (deps (if cc
                      (cons (check-compile-c cc (make-dep "cc is Tiny C" #:data "#if !defined (__TINYC__)
 #error no tinycc
@@ -542,7 +544,7 @@ Some influential environment variables:
                                       (cut member <> '("pc" "portbld" "unknown")))
                              (cdr host-type-list))))
            (mes-kernel (if (string-prefix? "freebsd" mes-kernel) "freebsd" mes-kernel))
-           (mes-compiler (cond (gcc? "gcc") (tcc? "gcc") (else "mescc")))
+           (mes-compiler (cond (gcc? "gcc") (tcc? "gcc") (mescc? "mescc") (else "bootstrap")))
            (mes-system (string-join (list mes-cpu mes-kernel "mes") "-"))
            (bash (or (and (file-exists? "/bin/bash") "/bin/bash")
                      (file-name "bash" deps)
@@ -636,6 +638,8 @@ See \"Porting GNU Mes\" in the manual, or try --with-courage\n" mes-system)
                      ("@GUILE_LOAD_PATH@" . ,(string-join guile-load-path ":"))
                      ("@GUIX@" . ,(or (file-name "guix" deps) ""))
                      ("@HELP2MAN@" . ,(or (file-name "help2man" deps) ""))
+                     ("@KAEM@" . ,(or (file-name "kaem" deps) ""))
+                     ("@M2_PLANET@" . ,(or (file-name "M2-Planet" deps) ""))
                      ("@MAKEINFO@" . ,(or (file-name "makeinfo" deps) ""))
                      ("@MES_FOR_BUILD@" . ,(or (file-name "mes" deps)
                                                guile))
@@ -656,8 +660,8 @@ See \"Porting GNU Mes\" in the manual, or try --with-courage\n" mes-system)
                           (cons (string-append "@" (variable-name o) "@") (or (format #f "~a" (dependency-file-name o)) "")))
                         deps))))
 
-        (unless cc
-          (format (current-error-port) "must supply a C compiler")
+        (unless (or cc m2-planet)
+          (format (current-error-port) "must supply C compiler or M2-Planet\n")
           (exit 2))
         (for-each (lambda (o)
                     (let* ((src (string-append srcdest o))

configure.sh

@@ -1,7 +1,7 @@
 #! /bin/sh
 
 # GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2018,2019,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Mes.
 #
@@ -77,6 +77,8 @@ GUILE=${GUILE-$(command -v guile)} || true
 HEX2=${HEX2-$(command -v hex2)}
 LDPFLAGS=${LDFLAGS-}
 M1=${M1-$(command -v M1)}
+M2_PLANET=${M1-$(command -v M2-Planet)}
+KAEM=${KAEM-$(command -v kaem)}
 MES_FOR_BUILD=${MES_FOR_BUILD-$(command -v mes || command -v guile || echo mes)}
 GIT=${GIT-$(command -v git)} || true
 PERL=${PERL-$(command -v perl)} || true
@@ -167,6 +169,8 @@ subst () {
     -e s,"@HEX2FLAGS@,$HEX2FLAGS,"\
     -e s,"@M1@,$M1,"\
     -e s,"@M1FLAGS@,$M1FLAGS,"\
+    -e s,"@M2_PLANET@,$M2_PLANET,"\
+    -e s,"@KAEM@,$KAEM,"\
     -e s,"@MES_FOR_BUILD@,$MES_FOR_BUILD,"\
     -e s,"@numbered_arch@,$numbered_arch,"\
     -e s,"@SHELL@,$SHELL,"\
@@ -217,7 +221,13 @@ elif $CC --version | grep tcc; then
     compiler=gcc
 else
     compiler=mescc
-    AR=${AR-$PWD/scripts/mesar}
+    if ! $CC --version; then
+        CC="$PWD/pre-inst-env mescc"
+    fi
+    if test "$CC" = "M2-Planet"; then
+        CC="$PWD/pre-inst-env mescc"
+    fi
+    AR=${AR-$PWD/pre-inst-env mesar}
 fi
 
 AR=${AR-$(command -v ar)} || true

guix/git/mes.scm

@@ -54,7 +54,7 @@
 (define-public mescc-tools
   (package
     (name "mescc-tools")
-    (version "0.7.0")
+    (version "1.1.0")
     (source
      (origin
        (method url-fetch)
@@ -65,7 +65,7 @@
        (file-name (string-append name "-" version ".tar.gz"))
        (sha256
         (base32
-         "1p1ijia4rm3002f5sypidl9v5gq0mlch9b0n61rpxkdsaaxjqax3"))))
+         "12cjryqfd6m6j807pvhk7i4vr2q0jiibpfrpnq5s67iq9l4rrc6b"))))
     (build-system gnu-build-system)
     (supported-systems
      '("aarch64-linux" "armhf-linux" "i686-linux" "x86_64-linux"))
@@ -78,7 +78,7 @@
                   (add-after 'unpack 'patch-prefix
                     (lambda _
                       (substitute* "sha256.sh"
-                        (("/usr/bin/sha256sum") (which "sha256sum")))
+                        (("\\$\\(which sha256sum\\)") (which "sha256sum")))
                       #t)))))
     (synopsis "Tools for the full source bootstrapping process")
     (description
@@ -89,6 +89,41 @@ get_machine.")
     (home-page "https://savannah.nongnu.org/projects/mescc-tools")
     (license gpl3+)))
 
+(define-public m2-planet
+  (package
+    (name "m2-planet")
+    (version "1.7.0-31-g358b6cf")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://lilypond.org/janneke/guix/20210101/"
+                    "m2-planet-" version ".tar.gz"))
+              (sha256
+               (base32
+                "1l20drk9pgxxqbbz635p7cb26s6cw70qlgrzmf46p2vfs3pyalks"))))
+    (native-inputs
+     `(("mescc-tools" ,mescc-tools)))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
+                          (string-append "CC=" ,(cc-for-target)))
+       #:tests? #f
+       #:phases (modify-phases %standard-phases
+                  (delete 'bootstrap)
+                  (delete 'configure)
+                  (add-after 'unpack 'patch-prefix
+                    (lambda _
+                      (substitute* "sha256.sh"
+                        (("\\$\\(which sha256sum\\)") (which "sha256sum")))
+                      #t)))))
+    (synopsis "The PLAtform NEutral Transpiler")
+    (description
+     "M2-Planet, The PLAtform NEutral Transpiler, when combined with
+mescc-tools compiles a subset of the C language into working binaries
+with introspective steps inbetween.")
+    (home-page "https://savannah.nongnu.org/projects/mescc-tools")
+    (license gpl3+)))
+
 (define-public nyacc-0.99
   (package
     (name "nyacc")
@@ -192,6 +227,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
                 '()))
        ("graphviz" ,graphviz)
        ("help2man" ,help2man)
+       ("m2-planet" ,m2-planet)
        ("perl" ,perl)                   ; build-aux/gitlog-to-changelog
        ("texinfo" ,texinfo)))
     (arguments

include/linux/x86/syscall.h

@@ -20,34 +20,61 @@
 #ifndef __MES_LINUX_X86_SYSCALL_H
 #define __MES_LINUX_X86_SYSCALL_H 1
 
-// libc-mini
-// #define SYS_exit    0x01
-// #define SYS_write   0x04
+/* libc-mini */
+#ifndef SYS_exit
+// CONSTANT SYS_exit 0x01
+#define SYS_exit    0x01
+#endif
+#ifndef SYS_write
+// CONSTANT SYS_write 0x04
+#define SYS_write   0x04
+#endif
 
-// libc
+/* libc */
+// CONSTANT SYS_fork 0x02
 #define SYS_fork    0x02
+// CONSTANT SYS_read 0x03
 #define SYS_read    0x03
+// CONSTANT SYS_open 0x05
 #define SYS_open    0x05
+// CONSTANT SYS_waitpid 0x07
 #define SYS_waitpid 0x07
+// CONSTANT SYS_wait4 0x72
 #define SYS_wait4   0x72
+// CONSTANT SYS_execve 0x0b
 #define SYS_execve  0x0b
+// CONSTANT SYS_chmod 0x0f
 #define SYS_chmod   0x0f
+// CONSTANT SYS_access 0x21
 #define SYS_access  0x21
+// CONSTANT SYS_brk 0x2d
 #define SYS_brk     0x2d
+// CONSTANT SYS_ioctl 0x36
 #define SYS_ioctl   0x36
+// CONSTANT SYS_fsync 0x76
 #define SYS_fsync   0x76
-
-// libc+tcc
-#define SYS_close  0x06
-#define SYS_time   0x0d
-#define SYS_lseek  0x13
-#define SYS_unlink 0x0a
-#define SYS_rmdir  0x28
-#define SYS_gettimeofday 0x4e
-#define SYS_stat   0x6a
+// CONSTANT SYS_getcwd 0xb7
 #define SYS_getcwd 0xb7
+// CONSTANT SYS_dup 0x29
+#define SYS_dup       0x29
+// CONSTANT SYS_dup2 0x3f
+#define SYS_dup2      0x3f
+// CONSTANT SYS_unlink 0x0a
+#define SYS_unlink 0x0a
+// CONSTANT SYS_gettimeofday 0x4e
+#define SYS_gettimeofday 0x4e
+// CONSTANT SYS_clock_gettime 0x109
+#define SYS_clock_gettime 0x109
+// CONSTANT SYS_time 0x0d
+#define SYS_time   0x0d
 
-// libc+gnu
+/* libc+tcc */
+#define SYS_close  0x06
+#define SYS_lseek  0x13
+#define SYS_rmdir  0x28
+#define SYS_stat   0x6a
+
+/* libc+gnu */
 
 #define SYS_chdir     0x0c
 #define SYS_link      0x09
@@ -56,7 +83,6 @@
 #define SYS_kill      0x25
 #define SYS_rename    0x26
 #define SYS_mkdir     0x27
-#define SYS_dup       0x29
 #define SYS_pipe      0x2a
 #define SYS_getgid    0x2f
 #define SYS_signal    0x30
@@ -64,28 +90,26 @@
 #define SYS_rt_sigaction 0xae
 #define SYS_signal    0x30
 #define SYS_fcntl     0x37
-#define SYS_dup2      0x3f
 #define SYS_getrusage 0x4d
 #define SYS_lstat     0x6b
 #define SYS_setitimer 0x68
 #define SYS_fstat     0x6c
 #define SYS_nanosleep 0xa2
 #define SYS_getdents  0x8d
-#define SYS_clock_gettime 0x109
 
-// bash
+/* bash */
 #define SYS_setuid    0x17
 #define SYS_geteuid   0x31
 #define SYS_getegid   0x32
 #define SYS_setgid    0x3e
 #define SYS_getppid   0x40
 
-// make+POSIX
+/* make+POSIX */
 #define SYS_sigprocmask 0x7e
 
-// tar
+/* tar */
 #define SYS_symlink   0x53
 #define SYS_readlink  0x55
 #define SYS_mknod     0x0e
 
-#endif // __MES_LINUX_X86_SYSCALL_H
+#endif /* __MES_LINUX_X86_SYSCALL_H */

include/m2/lib.h

@@ -0,0 +1,70 @@
+/*
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#ifndef __M2_LIB_H
+#define __M2_LIB_H
+
+char **environ;
+int __stdin;
+int __stdout;
+int __stderr;
+int errno;
+
+// CONSTANT EOF 0xffffffff
+// CONSTANT __FILEDES_MAX 512
+
+char* cast_intp_to_charp (int *i);
+char* cast_long_to_charp (long i);
+long cast_charp_to_long (char const *);
+long cast_int_to_long (int i);
+long cast_voidp_to_long (void const *);
+
+char *itoa (int number);
+char *ltoa (long number);
+int __ungetc_p (int filedes);
+int eputs (char *s);
+int oputs (char *s);
+int puts (char *s);
+size_t strlen (char *s);
+ssize_t _write ();
+ssize_t write (int filedes, void *buffer, size_t size);
+void __ungetc_clear (int filedes);
+void __ungetc_init ();
+void __ungetc_set (int filedes, int c);
+
+struct timezone
+{
+  int tz_minuteswest;
+  int tz_dsttime;
+};
+
+struct timespec
+{
+  long tv_sec;
+  long tv_nsec;
+};
+
+struct timeval
+{
+  long tv_sec;
+  long tv_usec;
+};
+
+#endif /* __M2_LIB_H */

include/mes/builtins.h

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -21,396 +21,162 @@
 #ifndef __MES_BUILTINS_H
 #define __MES_BUILTINS_H
 
-// src/gc.mes
-SCM gc_check ();
-SCM gc ();
-// src/hash.mes
-SCM hashq (SCM x, SCM size);
-SCM hash (SCM x, SCM size);
-SCM hashq_get_handle (SCM table, SCM key, SCM dflt);
-SCM hashq_ref (SCM table, SCM key, SCM dflt);
-SCM hash_ref (SCM table, SCM key, SCM dflt);
-SCM hashq_set_x (SCM table, SCM key, SCM value);
-SCM hash_set_x (SCM table, SCM key, SCM value);
-SCM hash_table_printer (SCM table);
-SCM make_hash_table (SCM x);
-// src/lib.mes
-SCM procedure_name_ (SCM x);
-SCM display_ (SCM x);
-SCM display_error_ (SCM x);
-SCM display_port_ (SCM x, SCM p);
-SCM write_ (SCM x);
-SCM write_error_ (SCM x);
-SCM write_port_ (SCM x, SCM p);
-SCM exit_ (SCM x);
-SCM frame_printer (SCM frame);
-SCM make_stack (SCM stack);
-SCM stack_length (SCM stack);
-SCM stack_ref (SCM stack, SCM index);
-SCM xassq (SCM x, SCM a);
-SCM memq (SCM x, SCM a);
-SCM equal2_p (SCM a, SCM b);
-SCM last_pair (SCM x);
-SCM pair_p (SCM x);
-// src/math.mes
-SCM greater_p (SCM x);
-SCM less_p (SCM x);
-SCM is_p (SCM x);
-SCM minus (SCM x);
-SCM plus (SCM x);
-SCM divide (SCM x);
-SCM modulo (SCM a, SCM b);
-SCM multiply (SCM x);
-SCM logand (SCM x);
-SCM logior (SCM x);
-SCM lognot (SCM x);
-SCM logxor (SCM x);
-SCM ash (SCM n, SCM count);
-// src/mes.mes
-SCM make_cell_ (SCM type, SCM car, SCM cdr);
-SCM type_ (SCM x);
-SCM car_ (SCM x);
-SCM cdr_ (SCM x);
-SCM arity_ (SCM x);
-SCM cons (SCM x, SCM y);
-SCM car (SCM x);
-SCM cdr (SCM x);
-SCM list (SCM x);
-SCM null_p (SCM x);
-SCM eq_p (SCM x, SCM y);
-SCM values (SCM x);
-SCM acons (SCM key, SCM value, SCM alist);
-SCM length (SCM x);
-SCM error (SCM key, SCM x);
-SCM append2 (SCM x, SCM y);
-SCM append_reverse (SCM x, SCM y);
-SCM reverse_x_ (SCM x, SCM t);
-SCM pairlis (SCM x, SCM y, SCM a);
-SCM call (SCM fn, SCM x);
-SCM assq (SCM x, SCM a);
-SCM assoc (SCM x, SCM a);
-SCM set_car_x (SCM x, SCM e);
-SCM set_cdr_x (SCM x, SCM e);
-SCM set_env_x (SCM x, SCM e, SCM a);
-SCM macro_get_handle (SCM name);
-SCM add_formals (SCM formals, SCM x);
-SCM eval_apply ();
-SCM make_builtin_type ();
-SCM make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function);
-SCM builtin_arity (SCM builtin);
-SCM builtin_p (SCM x);
-SCM builtin_printer (SCM builtin);
-// CONSTANT cell_nil 1
-#define cell_nil 1
-// CONSTANT cell_f 2
-#define cell_f 2
-// CONSTANT cell_t 3
-#define cell_t 3
-// CONSTANT cell_dot 4
-#define cell_dot 4
-// CONSTANT cell_arrow 5
-#define cell_arrow 5
-// CONSTANT cell_undefined 6
-#define cell_undefined 6
-// CONSTANT cell_unspecified 7
-#define cell_unspecified 7
-// CONSTANT cell_closure 8
-#define cell_closure 8
-// CONSTANT cell_circular 9
-#define cell_circular 9
-// CONSTANT cell_begin 10
-#define cell_begin 10
-// CONSTANT cell_call_with_current_continuation 11
-#define cell_call_with_current_continuation 11
-// CONSTANT cell_vm_apply 12
-#define cell_vm_apply 12
-// CONSTANT cell_vm_apply2 13
-#define cell_vm_apply2 13
-// CONSTANT cell_vm_begin 14
-#define cell_vm_begin 14
-// CONSTANT cell_vm_begin_eval 15
-#define cell_vm_begin_eval 15
-// CONSTANT cell_vm_begin_expand 16
-#define cell_vm_begin_expand 16
-// CONSTANT cell_vm_begin_expand_eval 17
-#define cell_vm_begin_expand_eval 17
-// CONSTANT cell_vm_begin_expand_macro 18
-#define cell_vm_begin_expand_macro 18
-// CONSTANT cell_vm_begin_expand_primitive_load 19
-#define cell_vm_begin_expand_primitive_load 19
-// CONSTANT cell_vm_begin_primitive_load 20
-#define cell_vm_begin_primitive_load 20
-// CONSTANT cell_vm_begin_read_input_file 21
-#define cell_vm_begin_read_input_file 21
-// CONSTANT cell_vm_call_with_current_continuation2 22
-#define cell_vm_call_with_current_continuation2 22
-// CONSTANT cell_vm_call_with_values2 23
-#define cell_vm_call_with_values2 23
-// CONSTANT cell_vm_eval 24
-#define cell_vm_eval 24
-// CONSTANT cell_vm_eval2 25
-#define cell_vm_eval2 25
-// CONSTANT cell_vm_eval_check_func 26
-#define cell_vm_eval_check_func 26
-// CONSTANT cell_vm_eval_define 27
-#define cell_vm_eval_define 27
-// CONSTANT cell_vm_eval_macro_expand_eval 28
-#define cell_vm_eval_macro_expand_eval 28
-// CONSTANT cell_vm_eval_macro_expand_expand 29
-#define cell_vm_eval_macro_expand_expand 29
-// CONSTANT cell_vm_eval_pmatch_car 30
-#define cell_vm_eval_pmatch_car 30
-// CONSTANT cell_vm_eval_pmatch_cdr 31
-#define cell_vm_eval_pmatch_cdr 31
-// CONSTANT cell_vm_eval_set_x 32
-#define cell_vm_eval_set_x 32
-// CONSTANT cell_vm_evlis 33
-#define cell_vm_evlis 33
-// CONSTANT cell_vm_evlis2 34
-#define cell_vm_evlis2 34
-// CONSTANT cell_vm_evlis3 35
-#define cell_vm_evlis3 35
-// CONSTANT cell_vm_if 36
-#define cell_vm_if 36
-// CONSTANT cell_vm_if_expr 37
-#define cell_vm_if_expr 37
-// CONSTANT cell_vm_macro_expand 38
-#define cell_vm_macro_expand 38
-// CONSTANT cell_vm_macro_expand_car 39
-#define cell_vm_macro_expand_car 39
-// CONSTANT cell_vm_macro_expand_cdr 40
-#define cell_vm_macro_expand_cdr 40
-// CONSTANT cell_vm_macro_expand_define 41
-#define cell_vm_macro_expand_define 41
-// CONSTANT cell_vm_macro_expand_define_macro 42
-#define cell_vm_macro_expand_define_macro 42
-// CONSTANT cell_vm_macro_expand_lambda 43
-#define cell_vm_macro_expand_lambda 43
-// CONSTANT cell_vm_macro_expand_set_x 44
-#define cell_vm_macro_expand_set_x 44
-// CONSTANT cell_vm_return 45
-#define cell_vm_return 45
-// CONSTANT cell_symbol_dot 46
-#define cell_symbol_dot 46
-// CONSTANT cell_symbol_lambda 47
-#define cell_symbol_lambda 47
-// CONSTANT cell_symbol_begin 48
-#define cell_symbol_begin 48
-// CONSTANT cell_symbol_if 49
-#define cell_symbol_if 49
-// CONSTANT cell_symbol_quote 50
-#define cell_symbol_quote 50
-// CONSTANT cell_symbol_define 51
-#define cell_symbol_define 51
-// CONSTANT cell_symbol_define_macro 52
-#define cell_symbol_define_macro 52
-// CONSTANT cell_symbol_quasiquote 53
-#define cell_symbol_quasiquote 53
-// CONSTANT cell_symbol_unquote 54
-#define cell_symbol_unquote 54
-// CONSTANT cell_symbol_unquote_splicing 55
-#define cell_symbol_unquote_splicing 55
-// CONSTANT cell_symbol_syntax 56
-#define cell_symbol_syntax 56
-// CONSTANT cell_symbol_quasisyntax 57
-#define cell_symbol_quasisyntax 57
-// CONSTANT cell_symbol_unsyntax 58
-#define cell_symbol_unsyntax 58
-// CONSTANT cell_symbol_unsyntax_splicing 59
-#define cell_symbol_unsyntax_splicing 59
-// CONSTANT cell_symbol_set_x 60
-#define cell_symbol_set_x 60
-// CONSTANT cell_symbol_sc_expand 61
-#define cell_symbol_sc_expand 61
-// CONSTANT cell_symbol_macro_expand 62
-#define cell_symbol_macro_expand 62
-// CONSTANT cell_symbol_portable_macro_expand 63
-#define cell_symbol_portable_macro_expand 63
-// CONSTANT cell_symbol_sc_expander_alist 64
-#define cell_symbol_sc_expander_alist 64
-// CONSTANT cell_symbol_call_with_values 65
-#define cell_symbol_call_with_values 65
-// CONSTANT cell_symbol_call_with_current_continuation 66
-#define cell_symbol_call_with_current_continuation 66
-// CONSTANT cell_symbol_boot_module 67
-#define cell_symbol_boot_module 67
-// CONSTANT cell_symbol_current_module 68
-#define cell_symbol_current_module 68
-// CONSTANT cell_symbol_primitive_load 69
-#define cell_symbol_primitive_load 69
-// CONSTANT cell_symbol_read_input_file 70
-#define cell_symbol_read_input_file 70
-// CONSTANT cell_symbol_write 71
-#define cell_symbol_write 71
-// CONSTANT cell_symbol_display 72
-#define cell_symbol_display 72
-// CONSTANT cell_symbol_car 73
-#define cell_symbol_car 73
-// CONSTANT cell_symbol_cdr 74
-#define cell_symbol_cdr 74
-// CONSTANT cell_symbol_not_a_number 75
-#define cell_symbol_not_a_number 75
-// CONSTANT cell_symbol_not_a_pair 76
-#define cell_symbol_not_a_pair 76
-// CONSTANT cell_symbol_system_error 77
-#define cell_symbol_system_error 77
-// CONSTANT cell_symbol_throw 78
-#define cell_symbol_throw 78
-// CONSTANT cell_symbol_unbound_variable 79
-#define cell_symbol_unbound_variable 79
-// CONSTANT cell_symbol_wrong_number_of_args 80
-#define cell_symbol_wrong_number_of_args 80
-// CONSTANT cell_symbol_wrong_type_arg 81
-#define cell_symbol_wrong_type_arg 81
-// CONSTANT cell_symbol_buckets 82
-#define cell_symbol_buckets 82
-// CONSTANT cell_symbol_builtin 83
-#define cell_symbol_builtin 83
-// CONSTANT cell_symbol_frame 84
-#define cell_symbol_frame 84
-// CONSTANT cell_symbol_hashq_table 85
-#define cell_symbol_hashq_table 85
-// CONSTANT cell_symbol_module 86
-#define cell_symbol_module 86
-// CONSTANT cell_symbol_procedure 87
-#define cell_symbol_procedure 87
-// CONSTANT cell_symbol_record_type 88
-#define cell_symbol_record_type 88
-// CONSTANT cell_symbol_size 89
-#define cell_symbol_size 89
-// CONSTANT cell_symbol_stack 90
-#define cell_symbol_stack 90
-// CONSTANT cell_symbol_argv 91
-#define cell_symbol_argv 91
-// CONSTANT cell_symbol_mes_prefix 92
-#define cell_symbol_mes_prefix 92
-// CONSTANT cell_symbol_mes_version 93
-#define cell_symbol_mes_version 93
-// CONSTANT cell_symbol_internal_time_units_per_second 94
-#define cell_symbol_internal_time_units_per_second 94
-// CONSTANT cell_symbol_compiler 95
-#define cell_symbol_compiler 95
-// CONSTANT cell_symbol_arch 96
-#define cell_symbol_arch 96
-// CONSTANT cell_symbol_pmatch_car 97
-#define cell_symbol_pmatch_car 97
-// CONSTANT cell_symbol_pmatch_cdr 98
-#define cell_symbol_pmatch_cdr 98
-// CONSTANT cell_type_bytes 99
-#define cell_type_bytes 99
-// CONSTANT cell_type_char 100
-#define cell_type_char 100
-// CONSTANT cell_type_closure 101
-#define cell_type_closure 101
-// CONSTANT cell_type_continuation 102
-#define cell_type_continuation 102
-// CONSTANT cell_type_function 103
-#define cell_type_function 103
-// CONSTANT cell_type_keyword 104
-#define cell_type_keyword 104
-// CONSTANT cell_type_macro 105
-#define cell_type_macro 105
-// CONSTANT cell_type_number 106
-#define cell_type_number 106
-// CONSTANT cell_type_pair 107
-#define cell_type_pair 107
-// CONSTANT cell_type_port 108
-#define cell_type_port 108
-// CONSTANT cell_type_ref 109
-#define cell_type_ref 109
-// CONSTANT cell_type_special 110
-#define cell_type_special 110
-// CONSTANT cell_type_string 111
-#define cell_type_string 111
-// CONSTANT cell_type_struct 112
-#define cell_type_struct 112
-// CONSTANT cell_type_symbol 113
-#define cell_type_symbol 113
-// CONSTANT cell_type_values 114
-#define cell_type_values 114
-// CONSTANT cell_type_variable 115
-#define cell_type_variable 115
-// CONSTANT cell_type_vector 116
-#define cell_type_vector 116
-// CONSTANT cell_type_broken_heart 117
-#define cell_type_broken_heart 117
-// CONSTANT cell_symbol_test 118
-#define cell_symbol_test 118
-// src/module.mes
-SCM make_module_type ();
-SCM module_printer (SCM module);
-SCM module_variable (SCM module, SCM name);
-SCM module_ref (SCM module, SCM name);
-SCM module_define_x (SCM module, SCM name, SCM value);
-// src/posix.mes
-SCM peek_byte ();
-SCM read_byte ();
-SCM unread_byte (SCM i);
-SCM peek_char ();
-SCM read_char (SCM port);
-SCM unread_char (SCM i);
-SCM write_char (SCM i);
-SCM write_byte (SCM x);
-SCM getenv_ (SCM s);
-SCM setenv_ (SCM s, SCM v);
-SCM access_p (SCM file_name, SCM mode);
-SCM current_input_port ();
-SCM open_input_file (SCM file_name);
-SCM open_input_string (SCM string);
-SCM set_current_input_port (SCM port);
-SCM current_output_port ();
-SCM current_error_port ();
-SCM open_output_file (SCM x);
-SCM set_current_output_port (SCM port);
-SCM set_current_error_port (SCM port);
-SCM force_output (SCM p);
-SCM chmod_ (SCM file_name, SCM mode);
-SCM isatty_p (SCM port);
-SCM primitive_fork ();
-SCM execl_ (SCM file_name, SCM args);
-SCM waitpid_ (SCM pid, SCM options);
-SCM current_time ();
-SCM gettimeofday_ ();
-SCM get_internal_run_time ();
-SCM getcwd_ ();
-SCM dup_ (SCM port);
-SCM dup2_ (SCM old, SCM new);
-SCM delete_file (SCM file_name);
-// src/reader.mes
-SCM read_input_file_env_ (SCM e, SCM a);
-SCM read_input_file_env (SCM a);
-SCM read_env (SCM a);
-SCM reader_read_sexp (SCM c, SCM s, SCM a);
-SCM reader_read_character ();
-SCM reader_read_binary ();
-SCM reader_read_octal ();
-SCM reader_read_hex ();
-SCM reader_read_string ();
-// src/strings.mes
-SCM string_equal_p (SCM a, SCM b);
-SCM symbol_to_string (SCM symbol);
-SCM symbol_to_keyword (SCM symbol);
-SCM keyword_to_string (SCM keyword);
-SCM string_to_symbol (SCM string);
-SCM make_symbol (SCM string);
-SCM string_to_list (SCM string);
-SCM list_to_string (SCM list);
-SCM read_string (SCM port);
-SCM string_append (SCM x);
-SCM string_length (SCM string);
-SCM string_ref (SCM str, SCM k);
-// src/struct.mes
-SCM make_struct (SCM type, SCM fields, SCM printer);
-SCM struct_length (SCM x);
-SCM struct_ref (SCM x, SCM i);
-SCM struct_set_x (SCM x, SCM i, SCM e);
-// src/vector.mes
-SCM make_vector_ (SCM n);
-SCM vector_length (SCM x);
-SCM vector_ref (SCM x, SCM i);
-SCM vector_entry (SCM x);
-SCM vector_set_x (SCM x, SCM i, SCM e);
-SCM list_to_vector (SCM x);
-SCM vector_to_list (SCM v);
+/* src/builtins.c */
+struct scm *make_builtin (struct scm *builtin_type, struct scm *name, struct scm *arity, struct scm *function);
+struct scm *builtin_name (struct scm *builtin);
+struct scm *builtin_arity (struct scm *builtin);
+struct scm *builtin_p (struct scm *x);
+struct scm *builtin_printer (struct scm *builtin);
+/* src/core.c */
+struct scm *car (struct scm *x);
+struct scm *cdr (struct scm *x);
+struct scm *list (struct scm *x);
+struct scm *null_p (struct scm *x);
+struct scm *eq_p (struct scm *x, struct scm *y);
+struct scm *values (struct scm *x);
+struct scm *acons (struct scm *key, struct scm *value, struct scm *alist);
+struct scm *length (struct scm *x);
+struct scm *error (struct scm *key, struct scm *x);
+struct scm *append2 (struct scm *x, struct scm *y);
+struct scm *append_reverse (struct scm *x, struct scm *y);
+struct scm *reverse_x_ (struct scm *x, struct scm *t);
+struct scm *assq (struct scm *x, struct scm *a);
+struct scm *assoc (struct scm *x, struct scm *a);
+/* src/display.c */
+struct scm *display_ (struct scm *x);
+struct scm *display_error_ (struct scm *x);
+struct scm *display_port_ (struct scm *x, struct scm *p);
+struct scm *write_ (struct scm *x);
+struct scm *write_error_ (struct scm *x);
+struct scm *write_port_ (struct scm *x, struct scm *p);
+/* src/eval-apply.c */
+struct scm *pairlis (struct scm *x, struct scm *y, struct scm *a);
+struct scm *set_car_x (struct scm *x, struct scm *e);
+struct scm *set_cdr_x (struct scm *x, struct scm *e);
+struct scm *set_env_x (struct scm *x, struct scm *e, struct scm *a);
+struct scm *add_formals (struct scm *formals, struct scm *x);
+struct scm *eval_apply ();
+/* src/gc.c */
+struct scm *gc_stats ();
+struct scm *cons (struct scm *x, struct scm *y);
+struct scm *gc_check ();
+struct scm *gc ();
+/* src/hash.c */
+struct scm *hashq (struct scm *x, struct scm *size);
+struct scm *hash (struct scm *x, struct scm *size);
+struct scm *hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt);
+struct scm *hashq_ref (struct scm *table, struct scm *key, struct scm *dflt);
+struct scm *hash_ref (struct scm *table, struct scm *key, struct scm *dflt);
+struct scm *hashq_set_x (struct scm *table, struct scm *key, struct scm *value);
+struct scm *hash_set_x (struct scm *table, struct scm *key, struct scm *value);
+struct scm *hash_table_printer (struct scm *table);
+struct scm *make_hash_table (struct scm *x);
+/* src/lib.c */
+struct scm *type_ (struct scm *x);
+struct scm *car_ (struct scm *x);
+struct scm *cdr_ (struct scm *x);
+struct scm *xassq (struct scm *x, struct scm *a);
+struct scm *memq (struct scm *x, struct scm *a);
+struct scm *equal2_p (struct scm *a, struct scm *b);
+struct scm *last_pair (struct scm *x);
+struct scm *pair_p (struct scm *x);
+struct scm *char_to_integer (struct scm *x);
+struct scm *integer_to_char (struct scm *x);
+/* src/math.c */
+struct scm *greater_p (struct scm *x);
+struct scm *less_p (struct scm *x);
+struct scm *is_p (struct scm *x);
+struct scm *minus (struct scm *x);
+struct scm *plus (struct scm *x);
+struct scm *divide (struct scm *x);
+struct scm *modulo (struct scm *a, struct scm *b);
+struct scm *multiply (struct scm *x);
+struct scm *logand (struct scm *x);
+struct scm *logior (struct scm *x);
+struct scm *lognot (struct scm *x);
+struct scm *logxor (struct scm *x);
+struct scm *ash (struct scm *n, struct scm *count);
+/* src/module.c */
+struct scm *make_module_type ();
+struct scm *module_printer (struct scm *module);
+struct scm *module_variable (struct scm *module, struct scm *name);
+struct scm *module_ref (struct scm *module, struct scm *name);
+struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value);
+/* src/posix.c */
+struct scm *abort_ ();
+struct scm *exit_ (struct scm *x);
+struct scm *peek_byte ();
+struct scm *read_byte ();
+struct scm *unread_byte (struct scm *i);
+struct scm *peek_char ();
+struct scm *read_char (struct scm *port);
+struct scm *unread_char (struct scm *i);
+struct scm *write_char (struct scm *i);
+struct scm *write_byte (struct scm *x);
+struct scm *getenv_ (struct scm *s);
+struct scm *setenv_ (struct scm *s, struct scm *v);
+struct scm *access_p (struct scm *file_name, struct scm *mode);
+struct scm *current_input_port ();
+struct scm *open_input_file (struct scm *file_name);
+struct scm *open_input_string (struct scm *string);
+struct scm *set_current_input_port (struct scm *port);
+struct scm *current_output_port ();
+struct scm *current_error_port ();
+struct scm *open_output_file (struct scm *x);
+struct scm *set_current_output_port (struct scm *port);
+struct scm *set_current_error_port (struct scm *port);
+struct scm *chmod_ (struct scm *file_name, struct scm *mode);
+struct scm *isatty_p (struct scm *port);
+struct scm *primitive_fork ();
+struct scm *execl_ (struct scm *file_name, struct scm *args);
+struct scm *waitpid_ (struct scm *pid, struct scm *options);
+struct scm *current_time ();
+struct scm *gettimeofday_ ();
+struct scm *get_internal_run_time ();
+struct scm *getcwd_ ();
+struct scm *dup_ (struct scm *port);
+struct scm *dup2_ (struct scm *old, struct scm *new);
+struct scm *delete_file (struct scm *file_name);
+/* src/reader.c */
+struct scm *read_input_file_env_ (struct scm *e, struct scm *a);
+struct scm *read_input_file_env (struct scm *a);
+struct scm *read_env (struct scm *a);
+struct scm *reader_read_sexp (struct scm *c, struct scm *s, struct scm *a);
+struct scm *reader_read_character ();
+struct scm *reader_read_binary ();
+struct scm *reader_read_octal ();
+struct scm *reader_read_hex ();
+struct scm *reader_read_string ();
+/* src/stack.c */
+struct scm *frame_printer (struct scm *frame);
+struct scm *make_stack (struct scm *stack);
+struct scm *stack_length (struct scm *stack);
+struct scm *stack_ref (struct scm *stack, struct scm *index);
+/* src/string.c */
+struct scm *string_equal_p (struct scm *a, struct scm *b);
+struct scm *symbol_to_string (struct scm *symbol);
+struct scm *symbol_to_keyword (struct scm *symbol);
+struct scm *keyword_to_string (struct scm *keyword);
+struct scm *string_to_symbol (struct scm *string);
+struct scm *make_symbol (struct scm *string);
+struct scm *string_to_list (struct scm *string);
+struct scm *list_to_string (struct scm *list);
+struct scm *read_string (struct scm *port);
+struct scm *string_append (struct scm *x);
+struct scm *string_length (struct scm *string);
+struct scm *string_ref (struct scm *str, struct scm *k);
+/* src/struct.c */
+struct scm *make_struct (struct scm *type, struct scm *fields, struct scm *printer);
+struct scm *struct_length (struct scm *x);
+struct scm *struct_ref (struct scm *x, struct scm *i);
+struct scm *struct_set_x (struct scm *x, struct scm *i, struct scm *e);
+/* src/vector.c */
+struct scm *make_vector (struct scm *x);
+struct scm *vector_length (struct scm *x);
+struct scm *vector_ref (struct scm *x, struct scm *i);
+struct scm *vector_entry (struct scm *x);
+struct scm *vector_set_x (struct scm *x, struct scm *i, struct scm *e);
+struct scm *list_to_vector (struct scm *x);
+struct scm *vector_to_list (struct scm *v);
 
-#endif //__MES_BUILTINS_H
+#endif /* __MES_BUILTINS_H */

include/mes/cc.h

@@ -0,0 +1,42 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#ifndef __MES_CC_H
+#define __MES_CC_H
+
+typedef struct scm* SCM;
+
+#if __MESC__
+typedef long FUNCTION;
+typedef long function0_t;
+typedef long function1_t;
+typedef long function2_t;
+typedef long function3_t;
+typedef long functionn_t;
+#else // !__MESC__
+typedef SCM (*FUNCTION) (void);
+typedef SCM (*function0_t) (void);
+typedef SCM (*function1_t) (SCM);
+typedef SCM (*function2_t) (SCM, SCM);
+typedef SCM (*function3_t) (SCM, SCM, SCM);
+typedef SCM (*functionn_t) (SCM);
+#endif // !__MESC__
+
+#endif //__MES_CC_H

include/mes/constants.h

@@ -21,263 +21,13 @@
 #ifndef __MES_CONSTANTS_H
 #define __MES_CONSTANTS_H
 
-/* Symbols */
-
-// CONSTANT cell_nil 1
-#define cell_nil 1
-// CONSTANT cell_f 2
-#define cell_f 2
-// CONSTANT cell_t 3
-#define cell_t 3
-// CONSTANT cell_dot 4
-#define cell_dot 4
-// CONSTANT cell_arrow 5
-#define cell_arrow 5
-// CONSTANT cell_undefined 6
-#define cell_undefined 6
-// CONSTANT cell_unspecified 7
-#define cell_unspecified 7
-// CONSTANT cell_closure 8
-#define cell_closure 8
-// CONSTANT cell_circular 9
-#define cell_circular 9
-// CONSTANT cell_begin 10
-#define cell_begin 10
-// CONSTANT cell_call_with_current_continuation 11
-#define cell_call_with_current_continuation 11
-
-// CONSTANT cell_vm_apply 12
-#define cell_vm_apply 12
-// CONSTANT cell_vm_apply2 13
-#define cell_vm_apply2 13
-// CONSTANT cell_vm_begin 14
-#define cell_vm_begin 14
-// CONSTANT cell_vm_begin_eval 15
-#define cell_vm_begin_eval 15
-// CONSTANT cell_vm_begin_expand 16
-#define cell_vm_begin_expand 16
-// CONSTANT cell_vm_begin_expand_eval 17
-#define cell_vm_begin_expand_eval 17
-// CONSTANT cell_vm_begin_expand_macro 18
-#define cell_vm_begin_expand_macro 18
-// CONSTANT cell_vm_begin_expand_primitive_load 19
-#define cell_vm_begin_expand_primitive_load 19
-// CONSTANT cell_vm_begin_primitive_load 20
-#define cell_vm_begin_primitive_load 20
-// CONSTANT cell_vm_begin_read_input_file 21
-#define cell_vm_begin_read_input_file 21
-// CONSTANT cell_vm_call_with_current_continuation2 22
-#define cell_vm_call_with_current_continuation2 22
-// CONSTANT cell_vm_call_with_values2 23
-#define cell_vm_call_with_values2 23
-// CONSTANT cell_vm_eval 24
-#define cell_vm_eval 24
-// CONSTANT cell_vm_eval2 25
-#define cell_vm_eval2 25
-// CONSTANT cell_vm_eval_check_func 26
-#define cell_vm_eval_check_func 26
-// CONSTANT cell_vm_eval_define 27
-#define cell_vm_eval_define 27
-// CONSTANT cell_vm_eval_macro_expand_eval 28
-#define cell_vm_eval_macro_expand_eval 28
-// CONSTANT cell_vm_eval_macro_expand_expand 29
-#define cell_vm_eval_macro_expand_expand 29
-// CONSTANT cell_vm_eval_pmatch_car 30
-#define cell_vm_eval_pmatch_car 30
-// CONSTANT cell_vm_eval_pmatch_cdr 31
-#define cell_vm_eval_pmatch_cdr 31
-// CONSTANT cell_vm_eval_set_x 32
-#define cell_vm_eval_set_x 32
-// CONSTANT cell_vm_evlis 33
-#define cell_vm_evlis 33
-// CONSTANT cell_vm_evlis2 34
-#define cell_vm_evlis2 34
-// CONSTANT cell_vm_evlis3 35
-#define cell_vm_evlis3 35
-// CONSTANT cell_vm_if 36
-#define cell_vm_if 36
-// CONSTANT cell_vm_if_expr 37
-#define cell_vm_if_expr 37
-// CONSTANT cell_vm_macro_expand 38
-#define cell_vm_macro_expand 38
-// CONSTANT cell_vm_macro_expand_car 39
-#define cell_vm_macro_expand_car 39
-// CONSTANT cell_vm_macro_expand_cdr 40
-#define cell_vm_macro_expand_cdr 40
-// CONSTANT cell_vm_macro_expand_define 41
-#define cell_vm_macro_expand_define 41
-// CONSTANT cell_vm_macro_expand_define_macro 42
-#define cell_vm_macro_expand_define_macro 42
-// CONSTANT cell_vm_macro_expand_lambda 43
-#define cell_vm_macro_expand_lambda 43
-// CONSTANT cell_vm_macro_expand_set_x 44
-#define cell_vm_macro_expand_set_x 44
-// CONSTANT cell_vm_return 45
-#define cell_vm_return 45
-
-// CONSTANT cell_symbol_dot 46
-#define cell_symbol_dot 46
-// CONSTANT cell_symbol_lambda 47
-#define cell_symbol_lambda 47
-// CONSTANT cell_symbol_begin 48
-#define cell_symbol_begin 48
-// CONSTANT cell_symbol_if 49
-#define cell_symbol_if 49
-// CONSTANT cell_symbol_quote 50
-#define cell_symbol_quote 50
-// CONSTANT cell_symbol_define 51
-#define cell_symbol_define 51
-// CONSTANT cell_symbol_define_macro 52
-#define cell_symbol_define_macro 52
-
-// CONSTANT cell_symbol_quasiquote 53
-#define cell_symbol_quasiquote 53
-// CONSTANT cell_symbol_unquote 54
-#define cell_symbol_unquote 54
-// CONSTANT cell_symbol_unquote_splicing 55
-#define cell_symbol_unquote_splicing 55
-// CONSTANT cell_symbol_syntax 56
-#define cell_symbol_syntax 56
-// CONSTANT cell_symbol_quasisyntax 57
-#define cell_symbol_quasisyntax 57
-// CONSTANT cell_symbol_unsyntax 58
-#define cell_symbol_unsyntax 58
-// CONSTANT cell_symbol_unsyntax_splicing 59
-#define cell_symbol_unsyntax_splicing 59
-
-// CONSTANT cell_symbol_set_x 60
-#define cell_symbol_set_x 60
-
-// CONSTANT cell_symbol_sc_expand 61
-#define cell_symbol_sc_expand 61
-// CONSTANT cell_symbol_macro_expand 62
-#define cell_symbol_macro_expand 62
-// CONSTANT cell_symbol_portable_macro_expand 63
-#define cell_symbol_portable_macro_expand 63
-// CONSTANT cell_symbol_sc_expander_alist 64
-#define cell_symbol_sc_expander_alist 64
-
-// CONSTANT cell_symbol_call_with_values 65
-#define cell_symbol_call_with_values 65
-// CONSTANT cell_symbol_call_with_current_continuation 66
-#define cell_symbol_call_with_current_continuation 66
-// CONSTANT cell_symbol_boot_module 67
-#define cell_symbol_boot_module 67
-// CONSTANT cell_symbol_current_module 68
-#define cell_symbol_current_module 68
-// CONSTANT cell_symbol_primitive_load 69
-#define cell_symbol_primitive_load 69
-// CONSTANT cell_symbol_read_input_file 70
-#define cell_symbol_read_input_file 70
-// CONSTANT cell_symbol_write 71
-#define cell_symbol_write 71
-// CONSTANT cell_symbol_display 72
-#define cell_symbol_display 72
-
-// CONSTANT cell_symbol_car 73
-#define cell_symbol_car 73
-// CONSTANT cell_symbol_cdr 74
-#define cell_symbol_cdr 74
-// CONSTANT cell_symbol_not_a_number 75
-#define cell_symbol_not_a_number 75
-// CONSTANT cell_symbol_not_a_pair 76
-#define cell_symbol_not_a_pair 76
-// CONSTANT cell_symbol_system_error 77
-#define cell_symbol_system_error 77
-// CONSTANT cell_symbol_throw 78
-#define cell_symbol_throw 78
-// CONSTANT cell_symbol_unbound_variable 79
-#define cell_symbol_unbound_variable 79
-// CONSTANT cell_symbol_wrong_number_of_args 80
-#define cell_symbol_wrong_number_of_args 80
-// CONSTANT cell_symbol_wrong_type_arg 81
-#define cell_symbol_wrong_type_arg 81
-
-// CONSTANT cell_symbol_buckets 82
-#define cell_symbol_buckets 82
-// CONSTANT cell_symbol_builtin 83
-#define cell_symbol_builtin 83
-// CONSTANT cell_symbol_frame 84
-#define cell_symbol_frame 84
-// CONSTANT cell_symbol_hashq_table 85
-#define cell_symbol_hashq_table 85
-// CONSTANT cell_symbol_module 86
-#define cell_symbol_module 86
-// CONSTANT cell_symbol_procedure 87
-#define cell_symbol_procedure 87
-// CONSTANT cell_symbol_record_type 88
-#define cell_symbol_record_type 88
-// CONSTANT cell_symbol_size 89
-#define cell_symbol_size 89
-// CONSTANT cell_symbol_stack 90
-#define cell_symbol_stack 90
-
-// CONSTANT cell_symbol_argv 91
-#define cell_symbol_argv 91
-// CONSTANT cell_symbol_mes_datadir 92
-#define cell_symbol_mes_datadir 92
-// CONSTANT cell_symbol_mes_version 93
-#define cell_symbol_mes_version 93
-
-// CONSTANT cell_symbol_internal_time_units_per_second 94
-#define cell_symbol_internal_time_units_per_second 94
-// CONSTANT cell_symbol_compiler 95
-#define cell_symbol_compiler 95
-// CONSTANT cell_symbol_arch 96
-#define cell_symbol_arch 96
-// CONSTANT cell_symbol_pmatch_car 97
-#define cell_symbol_pmatch_car 97
-// CONSTANT cell_symbol_pmatch_cdr 98
-#define cell_symbol_pmatch_cdr 98
-
-// CONSTANT cell_type_bytes 99
-#define cell_type_bytes 99
-// CONSTANT cell_type_char 100
-#define cell_type_char 100
-// CONSTANT cell_type_closure 101
-#define cell_type_closure 101
-// CONSTANT cell_type_continuation 102
-#define cell_type_continuation 102
-// CONSTANT cell_type_function 103
-#define cell_type_function 103
-// CONSTANT cell_type_keyword 104
-#define cell_type_keyword 104
-// CONSTANT cell_type_macro 105
-#define cell_type_macro 105
-// CONSTANT cell_type_number 106
-#define cell_type_number 106
-// CONSTANT cell_type_pair 107
-#define cell_type_pair 107
-// CONSTANT cell_type_port 108
-#define cell_type_port 108
-// CONSTANT cell_type_ref 109
-#define cell_type_ref 109
-// CONSTANT cell_type_special 110
-#define cell_type_special 110
-// CONSTANT cell_type_string 111
-#define cell_type_string 111
-// CONSTANT cell_type_struct 112
-#define cell_type_struct 112
-// CONSTANT cell_type_symbol 113
-#define cell_type_symbol 113
-// CONSTANT cell_type_values 114
-#define cell_type_values 114
-// CONSTANT cell_type_variable 115
-#define cell_type_variable 115
-// CONSTANT cell_type_vector 116
-#define cell_type_vector 116
-// CONSTANT cell_type_broken_heart 117
-#define cell_type_broken_heart 117
-
-// CONSTANT cell_test 118
-#define cell_test 118
-
 /* Cell types */
 
-// CONSTANT TBYTES         0
-#define TBYTES             0
-// CONSTANT TCHAR          1
-#define TCHAR              1
+// CONSTANT TCHAR          0
+#define TCHAR              0
+
+// CONSTANT TBYTES         1
+#define TBYTES             1
 // CONSTANT TCLOSURE       2
 #define TCLOSURE           2
 // CONSTANT TCONTINUATION  3
@@ -318,7 +68,31 @@
 // CONSTANT STRUCT_PRINTER 1
 #define STRUCT_PRINTER 1
 
+// CONSTANT FRAME_SIZE 5
 #define FRAME_SIZE 5
+// CONSTANT FRAME_PROCEDURE 4
 #define FRAME_PROCEDURE 4
 
-#endif //__MES_CONSTANTS_H
+// CONSTANT STDIN 0
+// CONSTANT STDOUT 1
+// CONSTANT STDERR 2
+
+/* Unknown type 1
+// CONSTANT EOF -1
+*/
+
+// CONSTANT O_RDONLY 0
+// CONSTANT O_WRONLY 1
+// CONSTANT O_CREAT 0x40
+// CONSTANT O_TRUNC 0x200
+
+// CONSTANT PATH_MAX 1024
+// CONSTANT __FILEDES_MAX 512
+
+// CONSTANT S_IRUSR 00400
+// CONSTANT S_IWUSR 00200
+
+// CONSTANT CLOCK_PROCESS_CPUTIME_ID 2
+
+
+#endif /* __MES_CONSTANTS_H */

include/mes/lib.h

@@ -23,6 +23,12 @@
 
 #include <mes/lib-mini.h>
 
+char *cast_intp_to_charp (int const *i);
+char *cast_long_to_charp (long i);
+long cast_charp_to_long (char const *);
+long cast_int_to_long (int i);
+long cast_voidp_to_long (void const *);
+
 int __mes_debug ();
 void __ungetc_init ();
 void __ungetc_clear (int filedes);
@@ -43,7 +49,8 @@ char * fdgets (char *s, int count, int fd);
 int fdputc (int c, int fd);
 int fdputs (char const *s, int fd);
 int fdungetc (int c, int fd);
-char * _getcwd (char *buffer, size_t size);
+char *_getcwd (char *buffer, size_t size);
+int ioctl3 (int filedes, size_t command, long data);
 int isnumber (int c, int base);
 int mes_open (char const *file_name, int flags, int mask);
 int _open2 (char const *file_name, int flags);
@@ -52,6 +59,7 @@ int oputc (int c);
 int oputs (char const *s);
 char *search_path (char const *file_name);
 ssize_t _read (int fd, void *buffer, size_t size);
+void assert_msg (int check, char *msg);
 
 extern char *__brk;
 extern void (*__call_at_exit) (void);
@@ -76,5 +84,6 @@ unsigned long __mesabi_uldiv (unsigned long a, unsigned long b,
 void *__memcpy (void *dest, void const *src, size_t n);
 void *__memmove (void *dest, void const *src, size_t n);
 void *__memset (void *s, int c, size_t n);
+int __raise (int signal);
 
 #endif //__MES_LIB_H

include/mes/macros.h

@@ -1,80 +0,0 @@
-/* -*-comment-start: "//";comment-end:""-*-
- * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
- *
- * This file is part of GNU Mes.
- *
- * GNU Mes 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 3 of the License, or (at
- * your option) any later version.
- *
- * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
- */
-
-#ifndef __MES_MACROS_H
-#define __MES_MACROS_H
-
-#define TYPE(x) g_cells[x].type
-#define CAR(x) g_cells[x].car
-#define CDR(x) g_cells[x].cdr
-
-#define NTYPE(x) g_news[x].type
-#define NCAR(x) g_news[x].car
-#define NCDR(x) g_news[x].cdr
-
-#define BYTES(x) g_cells[x].car
-#define LENGTH(x) g_cells[x].car
-#define REF(x) g_cells[x].car
-#define START(x) (g_cells[x].car >> 16)
-#define LEN(x) (g_cells[x].car & 0xffff)
-#define VARIABLE(x) g_cells[x].car
-
-#define CLOSURE(x) g_cells[x].cdr
-#define CONTINUATION(x) g_cells[x].cdr
-
-#define CBYTES(x) (char*)&g_cells[x].cdr
-#define CSTRING_STRUCT(x) (char*)&g_cells[x.cdr].cdr
-
-#define MACRO(x) g_cells[x].car
-#define NAME(x) g_cells[x].cdr
-#define PORT(x) g_cells[x].car
-#define STRING(x) g_cells[x].cdr
-#define STRUCT(x) g_cells[x].cdr
-#define VALUE(x) g_cells[x].cdr
-#define VECTOR(x) g_cells[x].cdr
-
-#define NLENGTH(x) g_news[x].car
-#define NCBYTES(x) (char*)&g_news[x].cdr
-#define NVALUE(x) g_news[x].cdr
-#define NSTRING(x) g_news[x].cdr
-#define NVECTOR(x) g_news[x].cdr
-
-#define CSTRING(x) CBYTES (STRING (x))
-
-#define MAKE_BYTES0(x) make_bytes (x, strlen (x))
-#define NAME_SYMBOL(symbol,name) {size_t s = strlen (name); CAR (symbol) = s; CDR (symbol) = make_bytes (name, s);}
-
-#define MAKE_CHAR(n) make_cell__ (TCHAR, 0, n)
-#define MAKE_CONTINUATION(n) make_cell__ (TCONTINUATION, n, g_stack)
-#define MAKE_NUMBER(n) make_cell__ (TNUMBER, 0, (long)n)
-#define MAKE_REF(n) make_cell__ (TREF, n, 0)
-#define MAKE_STRING0(x) make_string (x, strlen (x))
-#define MAKE_STRING_PORT(x) make_cell__ (TPORT, -length__ (g_ports) - 2, x)
-#define MAKE_MACRO(name, x) make_cell__ (TMACRO, x, STRING (name))
-
-#define CAAR(x) CAR (CAR (x))
-#define CADR(x) CAR (CDR (x))
-#define CDAR(x) CDR (CAR (x))
-#define CDDR(x) CDR (CDR (x))
-#define CADAR(x) CAR (CDR (CAR (x)))
-#define CADDR(x) CAR (CDR (CDR (x)))
-#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
-
-#endif //__MES_MACROS_H

include/mes/mes.h

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -22,85 +22,160 @@
 #define __MES_MES_H
 
 #include <sys/types.h>
-
-typedef long SCM;
+#include "mes/cc.h"
 
 struct scm
 {
   long type;
-  SCM car;
-  SCM cdr;
+  union
+  {
+    struct scm *car;
+    long car_value;
+    char *bytes;
+    long length;
+    struct scm *ref;
+    struct scm *variable;
+    struct scm *macro;
+    long port;
+  };
+  union
+  {
+    struct scm *cdr;
+    long cdr_value;
+    struct scm *closure;
+    struct scm *continuation;
+    char *name;
+    struct scm *string;
+    struct scm *structure;
+    long value;
+    FUNCTION function;
+    struct scm *vector;
+  };
 };
 
-// mes
-extern int g_debug;
-extern char *g_buf;
-extern SCM g_continuations;
-extern SCM g_symbols;
-extern SCM g_symbol_max;
+/* mes */
+char *g_datadir;
+int g_debug;
+char *g_buf;
+int g_continuations;
+struct scm *g_symbols;
+struct scm *g_symbol_max;
+int g_mini;
 
-// a/env
-extern SCM r0;
-// param 1
-extern SCM r1;
-// save 2
-extern SCM r2;
-// continuation
-extern SCM r3;
-// current-module
-extern SCM m0;
-// macro
-extern SCM g_macros;
-extern SCM g_ports;
+/* a/env */
+struct scm *R0;
+/* param 1 */
+struct scm *R1;
+/* save 2 */
+struct scm *R2;
+/* continuation */
+struct scm *R3;
+/* current-module */
+struct scm *M0;
+/* macro */
+struct scm *g_macros;
+struct scm *g_ports;
 
-// gc
-extern long ARENA_SIZE;
-extern long MAX_ARENA_SIZE;
-extern long STACK_SIZE;
-extern long JAM_SIZE;
-extern long GC_SAFETY;
-extern long MAX_STRING;
-extern char *g_arena;
-extern long g_free;
-extern SCM g_stack;
-extern SCM *g_stack_array;
-extern struct scm *g_cells;
-extern struct scm *g_news;
+/* gc */
+size_t ARENA_SIZE;
+size_t MAX_ARENA_SIZE;
+size_t STACK_SIZE;
+size_t JAM_SIZE;
+size_t GC_SAFETY;
+size_t MAX_STRING;
+char *g_arena;
+struct scm *cell_arena;
+struct scm *cell_zero;
 
-SCM alloc (long n);
-SCM apply (SCM f, SCM x, SCM a);
-SCM apply_builtin (SCM fn, SCM x);
-SCM cstring_to_list (char const *s);
-SCM cstring_to_symbol (char const *s);
-SCM display_ (SCM x);
-SCM fdisplay_ (SCM, int, int);
-SCM gc_init ();
-SCM gc_peek_frame ();
-SCM gc_pop_frame ();
-SCM gc_push_frame ();
-SCM init_time (SCM a);
-SCM make_bytes (char const *s, size_t length);
-SCM make_cell__ (long type, SCM car, SCM cdr);
-SCM make_hash_table_ (long size);
-SCM make_hashq_type ();
-SCM make_initial_module (SCM a);
-SCM make_string (char const *s, size_t length);
-SCM make_vector__ (long k);
-SCM read_input_file_env (SCM);
-SCM string_equal_p (SCM a, SCM b);
-SCM struct_ref_ (SCM x, long i);
-SCM struct_set_x_ (SCM x, long i, SCM e);
-SCM vector_ref_ (SCM x, long i);
-SCM vector_set_x_ (SCM x, long i, SCM e);
+struct scm *g_free;
+struct scm *g_symbol;
+
+struct scm **g_stack_array;
+struct scm *g_cells;
+struct scm *g_news;
+long g_stack;
+size_t gc_count;
+struct timespec *gc_start_time;
+struct timespec *gc_end_time;
+size_t gc_time;
+
+char **__execl_c_argv;
+char *__open_boot_buf;
+char *__open_boot_file_name;
+char *__setenv_buf;
+char *__reader_read_char_buf;
+struct timespec *g_start_time;
+struct timeval *__gettimeofday_time;
+struct timespec *__get_internal_run_time_ts;
+
+struct scm *cast_charp_to_scmp (char const *i);
+struct scm **cast_charp_to_scmpp (char const *i);
+char *cast_voidp_to_charp (void const *i);
+long cast_scmp_to_long (struct scm *i);
+char *cast_scmp_to_charp (struct scm *i);
+
+struct scm *alloc (long n);
+struct scm *apply (struct scm *f, struct scm *x, struct scm *a);
+struct scm *apply_builtin (struct scm *fn, struct scm *x);
+struct scm *apply_builtin0 (struct scm *fn);
+struct scm *apply_builtin1 (struct scm *fn, struct scm *x);
+struct scm *apply_builtin2 (struct scm *fn, struct scm *x, struct scm *y);
+struct scm *apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z);
+struct scm *builtin_name (struct scm *builtin);
+struct scm *cstring_to_list (char const *s);
+struct scm *cstring_to_symbol (char const *s);
+struct scm *cell_ref (struct scm *cell, long index);
+struct scm *fdisplay_ (struct scm *, int, int);
+struct scm *init_symbols ();
+struct scm *init_time (struct scm *a);
+struct scm *make_builtin_type ();
+struct scm *make_bytes (char const *s, size_t length);
+struct scm *make_cell (long type, struct scm *car, struct scm *cdr);
+struct scm *make_pointer_cell (long type, long car, void *cdr);
+struct scm *make_value_cell (long type, long car, long cdr);
+struct scm *make_char (int n);
+struct scm *make_continuation (long n);
+struct scm *make_hash_table_ (long size);
+struct scm *make_hashq_type ();
+struct scm *make_initial_module (struct scm *a);
+struct scm *make_macro (struct scm *name, struct scm *x);
+struct scm *make_number (long n);
+struct scm *make_ref (struct scm *x);
+struct scm *make_string (char const *s, size_t length);
+struct scm *make_string0 (char const *s);
+struct scm *make_string_port (struct scm *x);
+struct scm *make_vector_ (long k, struct scm *e);
+struct scm *mes_builtins (struct scm *a);
+struct scm *push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c);
+struct scm *struct_ref_ (struct scm *x, long i);
+struct scm *struct_set_x_ (struct scm *x, long i, struct scm *e);
+struct scm *vector_ref_ (struct scm *x, long i);
+struct scm *vector_set_x_ (struct scm *x, long i, struct scm *e);
+FUNCTION builtin_function (struct scm *builtin);
+char *cell_bytes (struct scm *x);
+char *news_bytes (struct scm *x);
 int peekchar ();
 int readchar ();
 int unreadchar ();
-long length__ (SCM x);
+long gc_free ();
+long length__ (struct scm *x);
 size_t bytes_cells (size_t length);
-void assert_max_string (size_t i, char const *msg, char *string);
+void assert_max_string (size_t i, char const *msg, char const *string);
+void assert_msg (int check, char *msg);
+void assert_number (char const *name, struct scm *x);
+void copy_cell (struct scm *to, struct scm *from);
+void gc_ ();
+void gc_dump_arena (struct scm *cells, long size);
+void gc_init ();
+void gc_peek_frame ();
+void gc_pop_frame ();
+void gc_push_frame ();
+void gc_stats_ (char const* where);
+void init_symbols_ ();
+long seconds_and_nanoseconds_to_long (long s, long ns);
 
 #include "mes/builtins.h"
 #include "mes/constants.h"
-#include "mes/macros.h"
+#include "mes/symbols.h"
 
-#endif //__MES_MES_H
+#endif /* __MES_MES_H */

include/mes/symbols.h

@@ -0,0 +1,150 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#ifndef __MES_SYMBOLS_H
+#define __MES_SYMBOLS_H
+
+struct scm *cell_nil;
+struct scm *cell_f;
+struct scm *cell_t;
+struct scm *cell_dot;
+struct scm *cell_arrow;
+struct scm *cell_undefined;
+struct scm *cell_unspecified;
+struct scm *cell_closure;
+struct scm *cell_circular;
+
+struct scm *cell_vm_apply;
+struct scm *cell_vm_apply2;
+struct scm *cell_vm_begin;
+struct scm *cell_vm_begin_eval;
+struct scm *cell_vm_begin_expand;
+struct scm *cell_vm_begin_expand_eval;
+struct scm *cell_vm_begin_expand_macro;
+struct scm *cell_vm_begin_expand_primitive_load;
+struct scm *cell_vm_begin_primitive_load;
+struct scm *cell_vm_begin_read_input_file;
+struct scm *cell_vm_call_with_current_continuation2;
+struct scm *cell_vm_call_with_values2;
+struct scm *cell_vm_eval;
+struct scm *cell_vm_eval2;
+struct scm *cell_vm_eval_check_func;
+struct scm *cell_vm_eval_define;
+struct scm *cell_vm_eval_macro_expand_eval;
+struct scm *cell_vm_eval_macro_expand_expand;
+struct scm *cell_vm_eval_pmatch_car;
+struct scm *cell_vm_eval_pmatch_cdr;
+struct scm *cell_vm_eval_set_x;
+struct scm *cell_vm_evlis;
+struct scm *cell_vm_evlis2;
+struct scm *cell_vm_evlis3;
+struct scm *cell_vm_if;
+struct scm *cell_vm_if_expr;
+struct scm *cell_vm_macro_expand;
+struct scm *cell_vm_macro_expand_car;
+struct scm *cell_vm_macro_expand_cdr;
+struct scm *cell_vm_macro_expand_define;
+struct scm *cell_vm_macro_expand_define_macro;
+struct scm *cell_vm_macro_expand_lambda;
+struct scm *cell_vm_macro_expand_set_x;
+struct scm *cell_vm_return;
+
+struct scm *cell_symbol_lambda;
+struct scm *cell_symbol_begin;
+struct scm *cell_symbol_if;
+struct scm *cell_symbol_quote;
+struct scm *cell_symbol_define;
+struct scm *cell_symbol_define_macro;
+struct scm *cell_symbol_quasiquote;
+struct scm *cell_symbol_unquote;
+struct scm *cell_symbol_unquote_splicing;
+struct scm *cell_symbol_syntax;
+struct scm *cell_symbol_quasisyntax;
+struct scm *cell_symbol_unsyntax;
+struct scm *cell_symbol_unsyntax_splicing;
+struct scm *cell_symbol_set_x;
+struct scm *cell_symbol_sc_expand;
+struct scm *cell_symbol_macro_expand;
+struct scm *cell_symbol_portable_macro_expand;
+struct scm *cell_symbol_sc_expander_alist;
+struct scm *cell_symbol_call_with_values;
+struct scm *cell_symbol_call_with_current_continuation;
+struct scm *cell_symbol_boot_module;
+struct scm *cell_symbol_current_module;
+struct scm *cell_symbol_primitive_load;
+struct scm *cell_symbol_car;
+struct scm *cell_symbol_cdr;
+struct scm *cell_symbol_not_a_number;
+struct scm *cell_symbol_not_a_pair;
+struct scm *cell_symbol_system_error;
+struct scm *cell_symbol_throw;
+struct scm *cell_symbol_unbound_variable;
+struct scm *cell_symbol_wrong_number_of_args;
+struct scm *cell_symbol_wrong_type_arg;
+struct scm *cell_symbol_buckets;
+struct scm *cell_symbol_builtin;
+struct scm *cell_symbol_frame;
+struct scm *cell_symbol_hashq_table;
+struct scm *cell_symbol_module;
+struct scm *cell_symbol_procedure;
+struct scm *cell_symbol_record_type;
+struct scm *cell_symbol_size;
+struct scm *cell_symbol_stack;
+struct scm *cell_symbol_argv;
+struct scm *cell_symbol_mes_datadir;
+struct scm *cell_symbol_mes_version;
+struct scm *cell_symbol_internal_time_units_per_second;
+struct scm *cell_symbol_compiler;
+struct scm *cell_symbol_arch;
+struct scm *cell_symbol_pmatch_car;
+struct scm *cell_symbol_pmatch_cdr;
+struct scm *cell_type_bytes;
+struct scm *cell_type_char;
+struct scm *cell_type_closure;
+struct scm *cell_type_continuation;
+struct scm *cell_type_function;
+struct scm *cell_type_keyword;
+struct scm *cell_type_macro;
+struct scm *cell_type_number;
+struct scm *cell_type_pair;
+struct scm *cell_type_port;
+struct scm *cell_type_ref;
+struct scm *cell_type_special;
+struct scm *cell_type_string;
+struct scm *cell_type_struct;
+struct scm *cell_type_symbol;
+struct scm *cell_type_values;
+struct scm *cell_type_variable;
+struct scm *cell_type_vector;
+struct scm *cell_type_broken_heart;
+struct scm *cell_symbol_program;
+struct scm *cell_symbol_test;
+
+// CONSTANT SYMBOL_MAX 114
+#define SYMBOL_MAX 114
+
+// CONSTANT CELL_UNSPECIFIED 7
+#define CELL_UNSPECIFIED 7
+
+// CONSTANT CELL_SYMBOL_RECORD_TYPE 82
+#define CELL_SYMBOL_RECORD_TYPE 82
+
+
+#endif /* __MES_SYMBOLS_H */

kaem.run

@@ -0,0 +1,140 @@
+#! /bin/sh
+# Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of GNU Mes.
+#
+# GNU Mes 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 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+# Usage:
+# kaem --verbose --strict
+
+mkdir -p m2
+
+M2-Planet                                       \
+    --debug                                     \
+    --architecture x86                          \
+    -f include/m2/lib.h                         \
+    -f lib/linux/x86-mes-m2/crt1.c              \
+    -f lib/linux/x86-mes-m2/mini.c              \
+    -f lib/mes/globals.c                        \
+    -f lib/m2/cast.c                            \
+    -f lib/m2/exit.c                            \
+    -f lib/mes/mini-write.c                     \
+    -f lib/linux/x86-mes-m2/syscall.c           \
+    -f include/linux/x86/syscall.h              \
+    -f lib/stub/__raise.c                       \
+    -f lib/linux/brk.c                          \
+    -f lib/stdlib/malloc.c                      \
+    -f lib/string/memset.c                      \
+    -f lib/m2/read.c                            \
+    -f lib/mes/fdgetc.c                         \
+    -f lib/stdio/getchar.c                      \
+    -f lib/stdio/putchar.c                      \
+    -f lib/m2/open.c                            \
+    -f lib/m2/mes_open.c                        \
+    -f lib/string/strlen.c                      \
+    -f lib/mes/eputs.c                          \
+    -f lib/mes/fdputc.c                         \
+    -f lib/mes/eputc.c                          \
+                                                \
+    -f include/mes/mes.h                        \
+    -f include/mes/builtins.h                   \
+    -f include/mes/constants.h                  \
+    -f include/mes/symbols.h                    \
+                                                \
+    -f lib/mes/__assert_fail.c                  \
+    -f lib/mes/assert_msg.c                     \
+                                                \
+    -f lib/mes/fdputc.c                         \
+    -f lib/string/strncmp.c                     \
+    -f lib/posix/getenv.c                       \
+    -f lib/mes/fdputs.c                         \
+    -f lib/mes/ntoab.c                          \
+    -f lib/ctype/isdigit.c                      \
+    -f lib/ctype/isxdigit.c                     \
+    -f lib/ctype/isspace.c                      \
+    -f lib/ctype/isnumber.c                     \
+    -f lib/mes/abtol.c                          \
+    -f lib/stdlib/atoi.c                        \
+    -f lib/string/memcpy.c                      \
+    -f lib/stdlib/free.c                        \
+    -f lib/stdlib/realloc.c                     \
+    -f lib/string/strcpy.c                      \
+    -f lib/mes/itoa.c                           \
+    -f lib/mes/ltoa.c                           \
+    -f lib/mes/fdungetc.c                       \
+    -f lib/posix/setenv.c                       \
+    -f lib/linux/access.c                       \
+    -f lib/m2/chmod.c                           \
+    -f lib/linux/ioctl3.c                       \
+    -f lib/m2/isatty.c                          \
+    -f lib/linux/fork.c                         \
+    -f lib/m2/execve.c                          \
+    -f lib/m2/execv.c                           \
+    -f lib/linux/waitpid.c                      \
+    -f lib/linux/gettimeofday.c                 \
+    -f lib/m2/clock_gettime.c                   \
+    -f lib/m2/time.c                            \
+    -f lib/linux/_getcwd.c                      \
+    -f lib/m2/getcwd.c                          \
+    -f lib/linux/dup.c                          \
+    -f lib/linux/dup2.c                         \
+    -f lib/string/strcmp.c                      \
+    -f lib/string/memcmp.c                      \
+    -f lib/linux/unlink.c                       \
+    -f src/builtins.c                           \
+    -f src/core.c                               \
+    -f src/display.c                            \
+    -f src/eval-apply.c                         \
+    -f src/gc.c                                 \
+    -f src/hash.c                               \
+    -f src/lib.c                                \
+    -f src/m2.c                                 \
+    -f src/math.c                               \
+    -f src/mes.c                                \
+    -f src/module.c                             \
+    -f src/posix.c                              \
+    -f src/reader.c                             \
+    -f src/stack.c                              \
+    -f src/string.c                             \
+    -f src/struct.c                             \
+    -f src/symbol.c                             \
+    -f src/vector.c                             \
+    -o m2/mes.M1
+
+blood-elf -f m2/mes.M1 -o m2/mes.blood-elf-M1
+
+M1                                              \
+    --LittleEndian                              \
+    --architecture x86                          \
+    -f lib/m2/x86/x86_defs.M1                   \
+    -f lib/x86-mes/x86.M1                       \
+    -f lib/linux/x86-mes-m2/crt1.M1             \
+    -f m2/mes.M1                                \
+    -f m2/mes.blood-elf-M1                      \
+    -o m2/mes.hex2
+
+mkdir -p bin
+hex2                                            \
+    --LittleEndian                              \
+    --architecture x86                          \
+    --BaseAddress 0x1000000                     \
+    --exec_enable                               \
+    -f lib/m2/x86/ELF-i386-debug.hex2           \
+    -f m2/mes.hex2                              \
+    -o bin/mes-m2
+
+echo Running mes-m2
+./bin/mes-m2 -c "(display 'Hello,M2-mes!) (newline)"
+cp bin/mes-m2 bin/mes

lib/linux/_getcwd.c

@@ -18,14 +18,15 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <mes/lib-mini.h>
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 
 char *
 _getcwd (char *buffer, size_t size)
 {
-  int r = _sys_call2 (SYS_getcwd, (long) buffer, (long) size);
+  long long_buffer = cast_charp_to_long (buffer);
+  int r = _sys_call2 (SYS_getcwd, long_buffer, size);
   if (r >= 0)
     return buffer;
   return 0;

lib/linux/_open3.c

@@ -27,7 +27,6 @@ int
 _open3 (char const *file_name, int flags, int mask)
 {
   int r = _sys_call3 (SYS_open, (long) file_name, (int) flags, (int) mask);
-  __ungetc_init ();
   if (r > 2)
     {
       __ungetc_clear (r);

lib/linux/access.c

@@ -18,11 +18,14 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 
 int
 access (char const *file_name, int how)
 {
-  return _sys_call2 (SYS_access, (long) file_name, (int) how);
+  long long_file_name = cast_charp_to_long (file_name);
+  long long_how = cast_int_to_long (how);
+  return _sys_call2 (SYS_access, long_file_name, long_how);
 }

lib/linux/brk.c

@@ -18,11 +18,13 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 
 long
 brk (void *addr)
 {
-  return _sys_call1 (SYS_brk, (long) addr);
+  long long_addr = cast_voidp_to_long (addr);
+  return _sys_call1 (SYS_brk, long_addr);
 }

lib/linux/chmod.c

@@ -18,6 +18,7 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 #include <sys/stat.h>
@@ -25,5 +26,7 @@
 int
 chmod (char const *file_name, mode_t mask)
 {
-  return _sys_call2 (SYS_chmod, (long) file_name, (long) mask);
+  long long_file_name = cast_charp_to_long (file_name);
+  long long_mask = cast_int_to_long (mask);
+  return _sys_call2 (SYS_chmod, long_file_name, long_mask);
 }

lib/linux/clock_gettime.c

@@ -18,6 +18,7 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 #include <time.h>
@@ -25,5 +26,7 @@
 int
 clock_gettime (clockid_t clk_id, struct timespec *tp)
 {
-  return _sys_call2 (SYS_clock_gettime, (long) clk_id, (long) tp);
+  long long_clk_id = cast_int_to_long (clk_id);
+  long long_tp = cast_voidp_to_long (tp);
+  return _sys_call2 (SYS_clock_gettime, long_clk_id, long_tp);
 }

lib/linux/dup.c

@@ -24,5 +24,6 @@
 int
 dup (int old)
 {
-  return _sys_call1 (SYS_dup, (int) old);
+  long long_old = old;
+  return _sys_call1 (SYS_dup, long_old);
 }

lib/linux/dup2.c

@@ -24,5 +24,7 @@
 int
 dup2 (int old, int new)
 {
-  return _sys_call2 (SYS_dup2, (int) old, (int) new);
+  long long_old = old;
+  long long_new = new;
+  return _sys_call2 (SYS_dup2, long_old, long_new);
 }

lib/linux/gettimeofday.c

@@ -18,6 +18,7 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 #include <sys/time.h>
@@ -25,5 +26,7 @@
 int
 gettimeofday (struct timeval *tv, struct timezone *tz)
 {
-  return _sys_call2 (SYS_gettimeofday, (long) tv, (long) tz);
+  long long_tv = cast_voidp_to_long (tv);
+  long long_tz = cast_voidp_to_long (tz);
+  return _sys_call2 (SYS_gettimeofday, long_tv, long_tz);
 }

lib/linux/ioctl.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -33,10 +33,3 @@ ioctl (int filedes, unsigned long command, ...)
   va_end (ap);
   return r;
 }
-
-int
-ioctl3 (int filedes, unsigned long command, long data)
-{
-  int r = _sys_call3 (SYS_ioctl, filedes, command, data);
-  return r;
-}

lib/linux/ioctl3.c

@@ -0,0 +1,31 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+#include <mes/lib.h>
+
+int
+ioctl3 (int filedes, size_t command, long data)
+{
+  long long_filedes = cast_int_to_long (filedes);
+  int r = _sys_call3 (SYS_ioctl, long_filedes, command, data);
+  return r;
+}

lib/linux/read.c

@@ -26,21 +26,23 @@
 ssize_t
 read (int filedes, void *buffer, size_t size)
 {
-  ssize_t bytes = _sys_call3 (SYS_read, (int) filedes, (long) buffer, (long) size);
+  long long_filedes = filedes;
+  ssize_t bytes = _sys_call3 (SYS_read, long_filedes, buffer, size);
   if (__mes_debug () > 4)
     {
       if (bytes == 1)
         {
           eputs ("read fd=");
-          eputs (itoa ((int) filedes));
+          eputs (itoa (filedes));
           eputs (" c=");
-          eputc (*(char *) buffer);
+          char *s = buffer;
+          eputc (s[0]);
           eputs ("\n");
         }
       else
         {
           eputs ("read fd=");
-          eputs (itoa ((int) filedes));
+          eputs (itoa (filedes));
           eputs (" bytes=");
           eputs (itoa (bytes));
           eputs ("\n");

lib/linux/unlink.c

@@ -18,11 +18,13 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 
 int
 unlink (char const *file_name)
 {
-  return _sys_call1 (SYS_unlink, (long) file_name);
+  long long_file_name = cast_charp_to_long (file_name);
+  return _sys_call1 (SYS_unlink, long_file_name);
 }

lib/linux/waitpid.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -18,17 +18,21 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <linux/syscall.h>
 #include <syscall.h>
 #include <sys/types.h>
 
-pid_t
-waitpid (pid_t pid, int *status_ptr, int options)
+int
+waitpid (int pid, int *status_ptr, int options)
 {
+  long long_pid = pid;
+  long long_status_ptr = cast_voidp_to_long (status_ptr);
+  long long_options = options;
 #if __i386__
-  return _sys_call3 (SYS_waitpid, (long) pid, (long) status_ptr, (int) options);
-#elif __x86_64__ || __arm__
-  return _sys_call4 (SYS_wait4, (long) pid, (long) status_ptr, (int) options, 0);
+  return _sys_call3 (SYS_waitpid, long_pid, long_status_ptr, long_options);
+#elif __x86_64__
+  return _sys_call4 (SYS_wait4, long_pid, long_status_ptr, long_options, 0);
 #else
 #error arch not supported
 #endif

lib/linux/x86-mes-m2/crt1.M1

@@ -0,0 +1,59 @@
+### GNU Mes --- Maxwell Equations of Software
+### Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+###
+### This file is part of GNU Mes.
+###
+### GNU Mes 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 3 of the License, or (at
+### your option) any later version.
+###
+### GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+:_start
+	push___%ebp
+	mov____%esp,%ebp
+	sub____$i32,%esp %0x1054
+	mov____$i8,%eax !0
+	mov____%eax,0x32 &GLOBAL___stdin
+	mov____$i8,%eax !1
+	mov____%eax,0x32 &GLOBAL___stdout
+	mov____$i8,%eax !2
+	mov____%eax,0x32 &GLOBAL___stderr
+	mov____%ebp,%eax
+	add____$i8,%eax !4
+	movzbl_(%eax),%eax
+	add____$i8,%eax !3
+	shl____$i8,%eax !0x02
+	add____%ebp,%eax
+	mov____%eax,0x32 &GLOBAL_environ
+
+	mov____%esp,%edi  	; M2-Planet calling convention pushes forward
+	mov____%ebp,%eax 	; argc
+	add____$i8,%eax !4
+	movzbl_(%eax),%eax
+	push___%eax
+
+	mov____%ebp,%eax 	; argv
+	add____$i8,%eax !8
+	push___%eax
+
+	mov____0x32,%eax &GLOBAL_environ
+	push___%eax
+
+	mov____%edi,%ebp    	; M2-Planet calling convention
+	call32 %FUNCTION_main
+	add____$i8,%esp !0x0
+	test___%eax,%eax
+	mov____%eax,%ebx
+	mov____$i32,%eax %1
+	int____$0x80
+	hlt
+	leave
+	ret

lib/linux/x86-mes-m2/crt1.c

@@ -0,0 +1,68 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "mes/lib-mini.h"
+
+int __stdin;
+int __stdout;
+int __stderr;
+char **environ;
+int main (int argc, char **argv, char **envp);
+
+/* FIXME: this is going to be called `FUNCTION__start'
+int
+_start ()
+{
+  asm ("mov____$i8,%eax !0");
+  asm ("mov____%eax,0x32 &GLOBAL___stdin");
+
+  asm ("mov____$i8,%eax !1");
+  asm ("mov____%eax,0x32 &GLOBAL___stdout");
+
+  asm ("mov____$i8,%eax !2");
+  asm ("mov____%eax,0x32 &GLOBAL___stderr");
+
+  asm ("mov____%ebp,%eax");
+  asm ("add____$i8,%eax !4");
+
+  asm ("movzbl_(%eax),%eax");
+  asm ("add____$i8,%eax !3");
+
+  asm ("shl____$i8,%eax !0x02");
+  asm ("add____%ebp,%eax");
+  asm ("mov____%eax,0x32 &GLOBAL_environ");
+  asm ("push___%eax");
+
+  asm ("mov____%ebp,%eax");
+  asm ("add____$i8,%eax !8");
+  asm ("push___%eax");
+
+  asm ("mov____%ebp,%eax");
+  asm ("add____$i8,%eax !4");
+  asm ("movzbl_(%eax),%eax");
+  asm ("push___%eax");
+  main ();
+
+  asm ("mov____%eax,%ebx");
+  asm ("mov____$i32,%eax %1");
+  asm ("int____$0x80");
+  asm ("hlt");
+}
+*/

lib/linux/x86-mes-m2/mini.c

@@ -0,0 +1,37 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+void
+_exit ()
+{
+  asm ("mov____$i32,%eax SYS_exit");
+  asm ("mov____0x8(%ebp),%ebx !-4");
+  asm ("int____$0x80");
+}
+
+void
+_write (int filedes, void *buffer, int size)
+{
+  asm ("mov____$i32,%eax SYS_write");
+  asm ("mov____0x8(%ebp),%ebx !-4");
+  asm ("mov____0x8(%ebp),%ecx !-8");
+  asm ("mov____0x8(%ebp),%edx !-12");
+  asm ("int____$0x80");
+}

lib/linux/x86-mes-m2/syscall.c

@@ -0,0 +1,139 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <errno.h>
+#include <linux/x86/syscall.h>
+
+int errno;
+
+int
+__sys_call (int sys_call)
+{
+  asm ("mov____0x8(%ebp),%eax !-4");
+  asm ("int____$0x80");
+}
+
+int
+__sys_call1 (int sys_call, int one)
+{
+  asm ("mov____0x8(%ebp),%eax !-4");
+  asm ("mov____0x8(%ebp),%ebx !-8");
+  asm ("int____$0x80");
+}
+
+int
+__sys_call2 (int sys_call, int one, int two)
+{
+  asm ("mov____0x8(%ebp),%eax !-4");
+  asm ("mov____0x8(%ebp),%ebx !-8");
+  asm ("mov____0x8(%ebp),%ecx !-12");
+  asm ("int____$0x80");
+}
+
+int
+__sys_call3 (int sys_call, int one, int two, int three)
+{
+  asm ("mov____0x8(%ebp),%eax !-4");
+  asm ("mov____0x8(%ebp),%ebx !-8");
+  asm ("mov____0x8(%ebp),%ecx !-12");
+  asm ("mov____0x8(%ebp),%edx !-16");
+  asm ("int____$0x80");
+}
+
+int
+__sys_call4 (int sys_call, int one, int two, int three, int four)
+{
+  asm ("mov____0x8(%ebp),%eax !-4");
+  asm ("mov____0x8(%ebp),%ebx !-8");
+  asm ("mov____0x8(%ebp),%ecx !-12");
+  asm ("mov____0x8(%ebp),%edx !-16");
+  asm ("mov____0x8(%ebp),%esi !-24");
+  asm ("int____$0x80");
+}
+
+int
+_sys_call (int sys_call)
+{
+  int r = __sys_call (sys_call);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+int
+_sys_call1 (int sys_call, int one)
+{
+  int r = __sys_call1 (sys_call, one);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+int
+_sys_call2 (int sys_call, int one, int two)
+{
+  int r = __sys_call2 (sys_call, one, two);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+int
+_sys_call3 (int sys_call, int one, int two, int three)
+{
+  int r = __sys_call3 (sys_call, one, two, three);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+int
+_sys_call4 (int sys_call, int one, int two, int three, int four)
+{
+  int r = __sys_call4 (sys_call, one, two, three, four);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}

lib/m2/cast.c

@@ -0,0 +1,51 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+
+char*
+cast_intp_to_charp (int const *i)
+{
+  return i;
+}
+
+char*
+cast_long_to_charp (long i)
+{
+  return i;
+}
+
+long
+cast_charp_to_long (char const *i)
+{
+  return i;
+}
+
+long
+cast_int_to_long (int i)
+{
+  return i;
+}
+
+long
+cast_voidp_to_long (void const *i)
+{
+  return i;
+}

lib/m2/chmod.c

@@ -0,0 +1,31 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+#include <sys/stat.h>
+
+int
+chmod (char const *file_name, int mask)
+{
+  long long_file_name = file_name;
+  long long_mask = mask;
+  return _sys_call2 (SYS_chmod, long_file_name, long_mask);
+}

lib/m2/clock_gettime.c

@@ -0,0 +1,30 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+#include <time.h>
+
+int
+clock_gettime (long clk_id, struct timespec *tp)
+{
+  long long_tp = tp;
+  return _sys_call2 (SYS_clock_gettime, clk_id, tp);
+}

lib/m2/execv.c

@@ -0,0 +1,25 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+int
+execv (char *file_name, char **argv)
+{
+  return execve (file_name, argv, environ);
+}

lib/m2/execve.c

@@ -0,0 +1,31 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+
+int
+execve (char const *file_name, char **argv, char **env)
+{
+  long long_file_name = file_name;
+  long long_argv = argv;
+  long long_env = env;
+  return _sys_call3 (SYS_execve, file_name, argv, env);
+}

lib/m2/exit.c

@@ -0,0 +1,29 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+
+void _exit (int code);
+
+void
+exit (int code)
+{
+  _exit (code);
+}

lib/m2/getcwd.c

@@ -0,0 +1,42 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+#include <mes/mes.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <sys/types.h>
+
+// CONSTANT PATH_MAX 1024
+
+char *__getcwd_buf;
+
+char *
+getcwd (char *buffer, int size)
+{
+  if (buffer == 0)
+    buffer = __getcwd_buf;
+  if (buffer == 0)
+    {
+      __getcwd_buf = malloc (PATH_MAX);
+      buffer = __getcwd_buf;
+    }
+  return _getcwd (buffer, size);
+}

lib/m2/isatty.c

@@ -0,0 +1,51 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+#include <sys/ioctl.h>
+#include <stdlib.h>
+#include <string.h>
+#include <termio.h>
+
+// CONSTANT TCGETS 0x5401
+#define TCGETS 0x5401
+
+struct ktermios
+{
+  unsigned c_iflag;
+  unsigned c_oflag;
+  unsigned c_cflag;
+  unsigned c_lflag;
+  char c_line;
+  char c_cc[19];
+  unsigned c_ispeed;
+  unsigned c_ospeed;
+};
+
+struct ktermios *__isatty_kernel_termios;
+
+int
+isatty (int filedes)
+{
+  if (__isatty_kernel_termios == 0)
+    __isatty_kernel_termios = malloc (sizeof (struct ktermios));
+  int r = ioctl3 (filedes, TCGETS, __isatty_kernel_termios);
+  return r == 0;
+}

lib/m2/mes_open.c

@@ -0,0 +1,28 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+int
+mes_open (char *file_name, int flags, int mask)
+{
+  int filedes = open (file_name, flags, mask);
+  if (filedes > 2)
+    __ungetc_clear (filedes);
+  return filedes;
+}

lib/m2/open.c

@@ -0,0 +1,32 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+#include <fcntl.h>
+#include <stdarg.h>
+
+int
+open (char *file_name, int flags, int mask)
+{
+  int r = _sys_call3 (SYS_open, file_name, flags, mask);
+  if (r > 2)
+    __ungetc_clear (r);
+  return r;
+}

lib/m2/read.c

@@ -0,0 +1,31 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+#include <mes/lib.h>
+#include <fcntl.h>
+
+long
+read (int filedes, void *buffer, long size)
+{
+  long bytes = _sys_call3 (SYS_read, filedes, buffer, size);
+  return bytes;
+}

lib/m2/time.c

@@ -0,0 +1,29 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <linux/syscall.h>
+#include <syscall.h>
+#include <time.h>
+
+long
+time (long *result)
+{
+  return _sys_call1 (SYS_time, result);
+}

lib/m2/x86/ELF-i386-debug.hex2

@@ -0,0 +1,74 @@
+### Copyright (C) 2016 Jeremiah Orians
+### Copyright (C) 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+### This file is part of M2-Planet.
+###
+### M2-Planet 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 3 of the License, or
+### (at your option) any later version.
+###
+### M2-Planet 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 M2-Planet.  If not, see <http://www.gnu.org/licenses/>.
+
+### stage0's hex2 format
+###    !<label>          1 byte relative
+###    $<label>          2 byte address
+###    @<label>          2 byte relative
+###    &<label>          4 byte address
+###    %<label>          4 byte relative
+
+### if you wish to use this header, you need to add :ELF_end to the end of your
+### M1 or hex2 files.
+
+## ELF Header
+
+:ELF_base
+7F 45 4C 46                    # e_ident[EI_MAG0-3] ELF's magic number
+
+01                             # e_ident[EI_CLASS] Indicating 32 bit
+01                             # e_ident[EI_DATA] Indicating little endianness
+01                             # e_ident[EI_VERSION] Indicating original elf
+
+03                             # e_ident[EI_OSABI] Set at 3 because FreeBSD is strict
+00                             # e_ident[EI_ABIVERSION] See above
+
+00 00 00 00 00 00 00           # e_ident[EI_PAD]
+
+02 00                          # e_type Indicating Executable
+03 00                          # e_machine Indicating 386
+01 00 00 00                    # e_version Indicating original elf
+
+&ELF_text                      # e_entry Address of the entry point
+%ELF_program_headers>ELF_base  # e_phoff Address of program header table
+%ELF_section_headers>ELF_base  # e_shoff Address of section header table
+
+00 00 00 00                    # e_flags
+
+34 00                          # e_ehsize Indicating our 52 Byte header
+
+20 00                          # e_phentsize size of a program header table
+01 00                          # e_phnum number of entries in program table
+
+28 00                          # e_shentsize size of a section header table
+05 00                          # e_shnum number of entries in section table
+
+02 00                          # e_shstrndx index of the section names
+
+
+:ELF_program_headers
+:ELF_program_header__text
+01 00 00 00                    # ph_type: PT-LOAD = 1
+00 00 00 00                    # ph_offset
+&ELF_base                      # ph_vaddr
+&ELF_base                      # ph_physaddr
+%ELF_end>ELF_base              # ph_filesz
+%ELF_end>ELF_base              # ph_memsz
+07 00 00 00                    # ph_flags: PF-X|PF-W|PF-R = 7
+01 00 00 00                    # ph_alignment
+
+:ELF_text

lib/m2/x86/x86_defs.M1

@@ -0,0 +1,103 @@
+## Copyright (C) 2017 Jeremiah Orians
+## Copyright (C) 2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+## This file is part of M2-Planet.
+##
+## M2-Planet 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 3 of the License, or
+## (at your option) any later version.
+##
+## M2-Planet 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 M2-Planet.  If not, see <http://www.gnu.org/licenses/>.
+
+
+DEFINE ADD_IMMEDIATE_to_eax 81C0
+DEFINE ADD_IMMEDIATE_to_ebp 81C5
+DEFINE ADD_eax_to_ebx 01C3
+DEFINE ADD_ebp_to_eax 01E8
+DEFINE ADD_ebx_to_eax 01D8
+DEFINE AND_eax_ebx 21D8
+DEFINE CALL_IMMEDIATE E8
+DEFINE CALL_eax FFD0
+DEFINE CMP 39C3
+DEFINE COPY_eax_to_ebx 89C3
+DEFINE COPY_eax_to_ecx 89C1
+DEFINE COPY_ebp_to_eax 89E8
+DEFINE COPY_ebx_to_eax 89D8
+DEFINE COPY_ebx_to_edx 89DA
+DEFINE COPY_ecx_to_ebp 89CD
+DEFINE COPY_edi_to_ebp 89fd
+DEFINE COPY_esp_to_ebp 89E5
+DEFINE COPY_esp_to_ecx 89E1
+DEFINE COPY_esp_to_edi 89E7
+DEFINE CDTQ 99
+DEFINE DIVIDE_eax_by_ebx_into_eax F7F3
+DEFINE DIVIDES_eax_by_ebx_into_eax F7FB
+DEFINE INT_80 CD80
+DEFINE JUMP E9
+DEFINE JUMP_EQ 0F84
+DEFINE JUMP_NE 0F85
+DEFINE JUMP_EQ8 74
+DEFINE JUMP_NE8 75
+DEFINE LOAD_BASE_ADDRESS_eax 8D85
+DEFINE LOAD_BYTE 0FBE00
+DEFINE LOAD_EFFECTIVE_ADDRESS 8D8424
+DEFINE LOAD_EFFECTIVE_ADDRESS_ebx 8D9C24
+DEFINE LOAD_EFFECTIVE_ADDRESS_ecx 8D8C24
+DEFINE LOAD_EFFECTIVE_ADDRESS_edx 8D9424
+DEFINE LOAD_ESP_IMMEDIATE_into_eax 8B8424
+DEFINE LOAD_IMMEDIATE_eax B8
+DEFINE LOAD_IMMEDIATE_ebx BB
+DEFINE LOAD_IMMEDIATE_ecx B9
+DEFINE LOAD_IMMEDIATE_edx BA
+DEFINE LOAD_INTEGER 8B00
+DEFINE LOAD_INTEGER_ebx 8B1B
+DEFINE LOAD_INTEGER_ecx 8B09
+DEFINE LOAD_INTEGER_edx 8B12
+DEFINE MODULUS_eax_from_ebx_into_ebx F7F3
+DEFINE MODULUSS_eax_from_ebx_into_ebx F7FB
+DEFINE MOVEZBL 0FB6C0
+DEFINE MOVE_ebx_to_eax 89D8
+DEFINE MOVE_ecx_to_eax 89C8
+DEFINE MOVE_edx_to_eax 89D0
+DEFINE MULTIPLY_eax_by_ebx_into_eax F7EB
+DEFINE MULTIPLYS_eax_by_ebx_into_eax F7E3
+DEFINE NULL 00000000
+DEFINE NOT_eax F7D0
+DEFINE NOP 00000000
+DEFINE OR_eax_ebx 09D8
+DEFINE POP_eax 58
+DEFINE POP_ebx 5B
+DEFINE POP_ebp 5D
+DEFINE POP_edi 5F
+DEFINE PUSH_eax 50
+DEFINE PUSH_ebx 53
+DEFINE PUSH_ebp 55
+DEFINE PUSH_edi 57
+DEFINE RETURN C3
+DEFINE SAL_eax_Immediate8 C1E0
+DEFINE SHL_eax_cl D3E0
+DEFINE SAL_eax_cl D3F0
+DEFINE SHR_eax_cl D3E8
+DEFINE SAR_eax_cl D3F8
+DEFINE SETA 0F97C0
+DEFINE SETAE 0F93C0
+DEFINE SETB 0F92C0
+DEFINE SETBE 0F96C0
+DEFINE SETE 0F94C0
+DEFINE SETLE 0F9EC0
+DEFINE SETL 0F9CC0
+DEFINE SETGE 0F9DC0
+DEFINE SETG 0F9FC0
+DEFINE SETNE 0F95C0
+DEFINE STORE_CHAR 8803
+DEFINE STORE_INTEGER 8903
+DEFINE SUBTRACT_eax_from_ebx_into_ebx 29C3
+DEFINE TEST 85C0
+DEFINE XCHG_eax_ebx 93
+DEFINE XOR_ebx_eax_into_eax 31D8

lib/mes/__assert_fail.c

@@ -28,5 +28,5 @@ __assert_fail (char *s)
   eputs ("\n");
   char *fail = s;
   fail = 0;
-  *fail = 0;
+  fail[0] = 0;
 }

lib/mes/abtol.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -24,27 +24,32 @@
 long
 abtol (char const **p, int base)
 {
-  char const *s = *p;
+  char const *s = p[0];
   int i = 0;
   int sign_p = 0;
-  if (!base)
+  int m = '0';
+  if (base == 0)
     base = 10;
-  while (isspace (*s))
-    s++;
-  if (*s && *s == '+')
-    s++;
-  if (*s && *s == '-')
+  while (isspace (s[0]) != 0)
+    s = s + 1;
+  if (s[0] != 0 && s[0] == '+')
+    s = s + 1;
+  if (s[0] != 0 && s[0] == '-')
     {
       sign_p = 1;
-      s++;
+      s = s + 1;
     }
-  while (isnumber (*s, base))
+  while (isnumber (s[0], base) != 0)
     {
-      i *= base;
-      int m = *s > '9' ? 'a' - 10 : '0';
-      i += *s - m;
-      s++;
+      i = i * base;
+      if (s[0] > '9')
+        m = 'a' - 10;
+      i = i + s[0] - m;
+      s = s + 1;
     }
-  *p = s;
-  return sign_p ? -i : i;
+  p[0] = s;
+  if (sign_p != 0)
+    return -i;
+
+  return i;
 }

lib/mes/assert_msg.c

@@ -0,0 +1,30 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019 Jeremiah Orians <jeremiah@pdp10.guru>
+ * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+#include <stdlib.h>
+
+void
+assert_msg (int bool, char *msg)
+{
+  if (bool == 0)
+    __assert_fail (msg);
+}

lib/mes/cast.c

@@ -0,0 +1,57 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+
+#undef cast_intp_to_charp
+#undef cast_long_to_charp
+#undef cast_charp_to_long
+#undef cast_int_to_long
+#undef cast_voidp_to_long
+
+char*
+cast_intp_to_charp (int const *i)
+{
+  return (char*)i;
+}
+
+char*
+cast_long_to_charp (long i)
+{
+  return (char*)i;
+}
+
+long
+cast_charp_to_long (char const *i)
+{
+  return (long)i;
+}
+
+long
+cast_int_to_long (int i)
+{
+  return (long)i;
+}
+
+long
+cast_voidp_to_long (void const *i)
+{
+  return (long)i;
+}

lib/mes/div.c

@@ -33,7 +33,7 @@ struct ldiv_t
 
 int __raise (int);
 
-#if __TINYC__
+#if __TINYC__ || SYSTEM_LIBC
 #define __raise(x) -1
 #endif
 

lib/mes/fdgetc.c

@@ -19,42 +19,57 @@
  */
 
 #include <mes/lib.h>
+#include <errno.h>
 #include <limits.h>
+#include <stdlib.h>
 #include <string.h>
 #include <sys/resource.h>
 #include <unistd.h>
 
-int __ungetc_buf[__FILEDES_MAX + 1] = { 0 };
+int errno;
+int *__ungetc_buf;
 
 int
 __ungetc_p (int filedes)
 {
+  if (__ungetc_buf == 0)
+    __ungetc_init ();
   return __ungetc_buf[filedes] >= 0;
 }
 
 void
 __ungetc_init ()
 {
-  if (__ungetc_buf[__FILEDES_MAX] == 0)
-    memset (__ungetc_buf, -1, (__FILEDES_MAX + 1) * sizeof (int));
+  if (__ungetc_buf == 0)
+    {
+      int save_errno = errno;
+      __ungetc_buf = malloc ((__FILEDES_MAX + 1) * sizeof (int));
+      errno = save_errno;
+      memset (__ungetc_buf, -1, (__FILEDES_MAX + 1) * sizeof (int));
+    }
 }
 
 void
 __ungetc_clear (int filedes)
 {
+  if (__ungetc_buf == 0)
+    __ungetc_init ();
   __ungetc_buf[filedes] = -1;
 }
 
 void
 __ungetc_set (int filedes, int c)
 {
+  if (__ungetc_buf == 0)
+    __ungetc_init ();
   __ungetc_buf[filedes] = c;
 }
 
 int
 fdgetc (int fd)
 {
-  __ungetc_init ();
+  if (__ungetc_buf == 0)
+    __ungetc_init ();
 
   char c;
   int i = __ungetc_buf[fd];
@@ -65,10 +80,10 @@ fdgetc (int fd)
       int r = read (fd, &c, 1);
       if (r < 1)
         return -1;
-      i = (int) c;
+      i = c;
     }
   if (i < 0)
-    i += 256;
+    i = i + 256;
 
   return i;
 }

lib/mes/fdputc.c

@@ -23,6 +23,7 @@
 int
 fdputc (int c, int fd)
 {
-  write (fd, (char *) &c, 1);
+  char *p = cast_intp_to_charp (&c);
+  write (fd, p, 1);
   return 0;
 }

lib/mes/fdungetc.c

@@ -19,12 +19,10 @@
  */
 
 #include <mes/lib.h>
-#include <assert.h>
 
 int
 fdungetc (int c, int fd)
 {
-  __ungetc_init ();
   if (c == -1)
     return c;
   else if (__ungetc_p (fd))
@@ -32,7 +30,7 @@ fdungetc (int c, int fd)
       eputs (" ***MES C LIB*** fdungetc ungetc buffer overflow fd=");
       eputs (itoa (fd));
       eputs ("\n");
-      assert (0);
+      assert_msg (0, "0");
     }
   __ungetc_set (fd, c);
   return c;

lib/mes/mes_open.c

@@ -32,7 +32,6 @@ int __stderr = STDERR;
 int
 mes_open (char const *file_name, int flags, int mask)
 {
-  __ungetc_init ();
   int filedes = open (file_name, flags, mask);
   if (filedes > 2)
     __ungetc_clear (filedes);

lib/mes/ntoab.c

@@ -18,48 +18,63 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <assert.h>
 #include <mes/lib.h>
-#include <stdint.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
 
-#define STR(x) #x
-#define XSTR(s) STR(s)
+#if __M2_PLANET__ || !(__MESC__ && __arm__)
+size_t
+__mesabi_uldiv (size_t a, size_t b, size_t *remainder)
+{
+  remainder[0] = a % b;
+  return a / b;
+}
+#endif
+
+char *__itoa_buf;
 
 char *
 ntoab (long x, unsigned base, int signed_p)
 {
-  static char itoa_buf[20];
-  char *p = itoa_buf + 11;
-  *p-- = 0;
-  assert(base > 1);
+  if (__itoa_buf == 0)
+    __itoa_buf = malloc (20);
+  char *p = __itoa_buf + 11;
+
+  p[0] = 0;
+  p = p - 1;
+  assert_msg (base > 0, "base > 0");
 
   int sign_p = 0;
-  unsigned long u;
-  if (signed_p && x < 0)
+  size_t i;
+  size_t u;
+  size_t b = base;
+  if (signed_p != 0 && x < 0)
     {
       sign_p = 1;
       /* Avoid LONG_MIN */
-      u = (unsigned long) (-(x + 1));
-      ++u;
+      u = (-(x + 1));
+      u = u + 1;
     }
   else
     u = x;
 
   do
     {
-      unsigned long i;
-#if __MESC__ && __arm__
-      u = __mesabi_uldiv (u, (unsigned long) base, &i);
-#else
-      i = u % base;
-      u = u / base;
-#endif
-      *p-- = i > 9 ? 'a' + i - 10 : '0' + i;
+      u = __mesabi_uldiv (u, b, &i);
+      if (i > 9)
+        p[0] = 'a' + i - 10;
+      else
+        p[0] = '0' + i;
+      p = p - 1;
     }
-  while (u);
+  while (u != 0);
 
-  if (sign_p && *(p + 1) != '0')
-    *p-- = '-';
+  if (sign_p && p[1] != '0')
+    {
+      p[0] = '-';
+      p = p - 1;
+    }
 
   return p + 1;
 }

lib/posix/getcwd.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -23,11 +23,13 @@
 #include <sys/types.h>
 #include <mes/lib.h>
 
+char *__getcwd_buf;
+
 char *
 getcwd (char *buffer, size_t size)
 {
   static char buf[PATH_MAX];
-  if (buffer)
-    return _getcwd (buffer, size);
-  return _getcwd (buf, PATH_MAX);
+  if (buffer == 0)
+    buffer = buf;
+  return _getcwd (buffer, size);
 }

lib/posix/getenv.c

@@ -1,6 +1,6 @@
-/* -*-comment-start: "//";comment-end:""-*-
+/*
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -22,16 +22,31 @@
 #include <string.h>
 #include <stdlib.h>
 
+// CONSTANT M2_PTR_SIZE 4
+#define M2_PTR_SIZE 1
+
 char *
 getenv (char const *s)
 {
+  /* eputs ("\ngetenv s="); eputs (s); eputs ("\n"); */
   char **p = environ;
+  char *q;
   int length = strlen (s);
-  while (*p)
+
+  while (p[0] != 0)
     {
-      if (!strncmp (s, *p, length) && *(*p + length) == '=')
-        return (*p + length + 1);
-      p++;
+      /* eputs ("getenv p[0]="); eputs (p[0]); eputs ("\n"); */
+      if (strncmp (s, p[0], length) == 0)
+        {
+          /* eputs ("found!\n"); */
+          q = p[0] + length;
+          if (q[0] == '=')
+            return q + 1;
+        }
+      /* else */
+      /*   eputs ("not found!\n"); */
+      p = p + M2_PTR_SIZE;
     }
+
   return 0;
 }

lib/posix/setenv.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -22,25 +22,35 @@
 #include <string.h>
 #include <stdlib.h>
 
+// CONSTANT M2_PTR_SIZE 4
+#define M2_PTR_SIZE 1
+
 int
 setenv (char const *s, char const *v, int overwrite_p)
 {
   char **p = environ;
   int length = strlen (s);
-  while (*p)
+  char* q;
+
+  while (p[0] != 0)
     {
-      if (!strncmp (s, *p, length) && *(*p + length) == '=')
-        break;
-      p++;
+      if (strncmp (s, p[0], length) == 0)
+        {
+          q = p[0] + length;
+          if (q[0] == '=')
+            break;
+        }
+      p = p + M2_PTR_SIZE;
     }
   char *entry = malloc (length + strlen (v) + 2);
-  int end_p = *p == 0;
-  *p = entry;
+  int end_p = p[0] == 0;
+  p[0] = entry;
   strcpy (entry, s);
   strcpy (entry + length, "=");
   strcpy (entry + length + 1, v);
-  *(entry + length + strlen (v) + 2) = 0;
-  if (end_p)
-    *++p = 0;
+  entry[length + strlen (v) + 2] = 0;
+  if (end_p != 0)
+    p[1] = 0;
+
   return 0;
 }

lib/stdio/putchar.c

@@ -18,11 +18,13 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <mes/lib.h>
 #include <stdio.h>
 
 int
 putchar (int c)
 {
-  write (STDOUT, (char *) &c, 1);
+  char *p = cast_intp_to_charp (&c);
+  write (__stdout, p, 1);
   return 0;
 }

lib/stdlib/abort.c

@@ -23,9 +23,10 @@
 void
 abort (void)
 {
-  if (raise (SIGABRT) < 0) { /* could not raise SIGABRT */
-    /* Fail in any way possible */
-    unsigned char* x = (unsigned char*) 0;
-    *x = 2;
-  }
+  if (raise (SIGABRT) < 0) /* could not raise SIGABRT */
+    {
+      /* Fail in any way possible */
+      unsigned char* x = (unsigned char*) 0;
+      *x = 2;
+    }
 }

lib/stdlib/malloc.c

@@ -39,14 +39,14 @@ void *
 malloc (size_t size)
 {
   if (!__brk)
-    __brk = (char *) brk (0);
+    __brk = cast_long_to_charp (brk (0));
   /* align what we give back. */
   __brk = (char*) (((uintptr_t) __brk
                     + sizeof (max_align_t) - 1) & -sizeof (max_align_t));
   if (brk (__brk + size) == -1)
     return 0;
   char *p = __brk;
-  __brk += size;
+  __brk = __brk + size;
   return p;
 }
 #endif /* !__GNU__ */

lib/stdlib/realloc.c

@@ -25,7 +25,7 @@ void *
 realloc (void *ptr, size_t size)
 {
   void *new = malloc (size);
-  if (ptr && new)
+  if (ptr != 0 && new != 0)
     {
       memcpy (new, ptr, size);
       free (ptr);

lib/string/memchr.c

@@ -24,11 +24,14 @@ void *
 memchr (void const *block, int c, size_t size)
 {
   char const *p = block;
-  while (size--)
+
+  while (size != 0)
     {
-      if (c == *p)
-        return (void *) p;
-      p++;
+      size = size - 1;
+      if (c == p[0])
+        return p;
+      p = p + 1;
     }
+
   return 0;
 }

lib/string/memcmp.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -23,14 +23,18 @@
 int
 memcmp (void const *s1, void const *s2, size_t size)
 {
-  if (!size)
+  if (size == 0)
     return 0;
+
   char const *a = s1;
   char const *b = s2;
-  while (*a == *b && --size)
+
+  while (a[0] == b[0] && size > 1)
     {
-      a++;
-      b++;
+      size = size - 1;
+      a = a + 1;
+      b = b + 1;
     }
-  return *a - *b;
+
+  return a[0] - b[0];
 }

lib/string/memcpy.c

@@ -21,12 +21,24 @@
 #include <mes/lib.h>
 #include <string.h>
 
+char *
+_memcpy (char *dest, char const *src, size_t n)
+{
+  char *p = dest;
+
+  while (n != 0)
+    {
+      n = n - 1;
+      dest[0] = src[0];
+      dest = dest + 1;
+      src = src + 1;
+    }
+
+  return p;
+}
+
 void *
 memcpy (void *dest, void const *src, size_t n)
 {
-  char *p = dest;
-  char const *q = src;
-  while (n--)
-    *p++ = *q++;
-  return dest;
+  return _memcpy (dest, src, n);
 }

lib/string/memset.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -20,11 +20,21 @@
 
 #include <string.h>
 
+char *
+_memset (char *s, int c, size_t n)
+{
+  char *p = s;
+  while (n != 0)
+    {
+      n = n - 1;
+      s[0] = c;
+      s = s + 1;
+    }
+  return p;
+}
+
 void *
 memset (void *s, int c, size_t n)
 {
-  char *p = s;
-  while (n--)
-    *p++ = c;
-  return s;
+  return _memset (s, c, n);
 }

lib/string/strcmp.c

@@ -23,10 +23,11 @@
 int
 strcmp (char const *a, char const *b)
 {
-  while (*a && *b && *a == *b)
+  while (a[0] != 0 && b[0] != 0 && a[0] == b[0])
     {
-      a++;
-      b++;
+      a = a + 1;
+      b = b + 1;
     }
-  return *a - *b;
+
+  return a[0] - b[0];
 }

lib/string/strcpy.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -24,8 +24,14 @@ char *
 strcpy (char *dest, char const *src)
 {
   char *p = dest;
-  while (*src)
-    *p++ = *src++;
-  *p = 0;
+
+  while (src[0] != 0)
+    {
+      p[0] = src[0];
+      p = p + 1;
+      src = src + 1;
+    }
+  p[0] = 0;
+
   return dest;
 }

lib/string/strlen.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -24,7 +24,9 @@ size_t
 strlen (char const *s)
 {
   int i = 0;
-  while (s[i])
-    i++;
+
+  while (s[i] != 0)
+    i = i + 1;
+
   return i;
 }

lib/string/strncmp.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -23,12 +23,15 @@
 int
 strncmp (char const *a, char const *b, size_t size)
 {
-  if (!size)
+  if (size == 0)
     return 0;
-  while (*a && *b && *a == *b && --size)
+
+  while (a[0] != 0 && b[0] != 0 && a[0] == b[0] && size > 1)
     {
-      a++;
-      b++;
+      size = size - 1;
+      a = a + 1;
+      b = b + 1;
     }
-  return *a - *b;
+
+  return a[0] - b[0];
 }

lib/stub/__raise.c

@@ -0,0 +1,27 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+// CONSTANT SIGABRT 0
+
+int
+__raise (int signum)
+{
+  return -1;
+}

lib/stub/ioctl.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -32,14 +32,3 @@ ioctl (int filedes, unsigned long command, ...)
   errno = 0;
   return 0;
 }
-
-int
-ioctl3 (int filedes, unsigned long command, long data)
-{
-  static int stub = 0;
-  if (__mes_debug () && !stub)
-    eputs ("ioctl3 stub\n");
-  stub = 1;
-  errno = 0;
-  return 0;
-}

lib/stub/ioctl3.c

@@ -0,0 +1,33 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+#include <errno.h>
+
+int
+ioctl3 (int filedes, unsigned long command, long data)
+{
+  static int stub = 0;
+  if (__mes_debug () && !stub)
+    eputs ("ioctl3 stub\n");
+  stub = 1;
+  errno = 0;
+  return 0;
+}

lib/tests/string/50-memcmp.c

@@ -0,0 +1,46 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes 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 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <mes/lib.h>
+
+#include <string.h>
+
+int
+main ()
+{
+  char *p = "mes";
+
+  if (!memcmp (p, "foo", 3))
+    return 1;
+
+  if (memcmp (p, "mes", 3))
+    return 2;
+
+  if (memcmp (p, "mes", 4))
+    return 3;
+
+  if (!memcmp (p, "mesx", 4))
+    return 4;
+
+  if (memcmp (p, "mesx", 3))
+    return 5;
+
+  return 0;
+}

lib/x86-mes/x86.M1

@@ -107,9 +107,11 @@ DEFINE mov____%ebx,0x32 891d
 DEFINE mov____%ebx,0x32(%ebp) 899d
 DEFINE mov____%ebx,0x8(%ebp) 895d
 DEFINE mov____%ecx,(%ebx) 890b
+DEFINE mov____%edi,%ebp 89fd
 DEFINE mov____%edx,%eax 89d0
 DEFINE mov____%edx,%ebx 89d3
 DEFINE mov____%esp,%ebp 89e5
+DEFINE mov____%esp,%edi 89e7
 DEFINE mov____(%eax),%cl 8a08
 DEFINE mov____(%eax),%cx 668b08
 DEFINE mov____(%eax),%eax 8b00

mes/module/mes/base.mes

@@ -119,12 +119,6 @@
 
 (define else #t)
 
-(define (procedure? p)
-  (cond ((builtin? p) #t)
-        ((and (pair? p) (eq? (car p) 'lambda)))
-        ((closure? p) #t)
-        (#t #f)))
-
 (define (map f h . t)
   (if (or (null? h)
           (and (pair? t) (null? (car t)))

mes/module/mes/catch.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -23,17 +23,14 @@
 
 (define %eh (make-fluid
              (lambda (key . args)
-               (if #f ;;(defined? 'simple-format)
-                   (simple-format (current-error-port) "unhandled exception:~a:~a\n" key args)
-                   (begin
-                     (core:display-error "unhandled exception:")
-                     (core:display-error key)
-                     (core:display-error ":")
-                     (core:write-error args)
-                     (core:display-error "\n")))
+               (core:display-error "unhandled exception: ")
+               (core:display-error key)
+               (core:display-error ": ")
+               (core:write-error args)
+               (core:display-error "\n")
                (core:display-error "Backtrace:\n")
                (display-backtrace (make-stack) (current-error-port))
-               (exit 1))))
+               (abort))))
 
 (define (catch key thunk handler)
   (let ((previous-eh (fluid-ref %eh)))
@@ -58,14 +55,33 @@
 (define with-throw-handler catch) ; FIXME: hack for Nyacc 0.75
 
 (define (frame-procedure frame)
-  (struct-ref frame 3))
+  (let ((f (struct-ref frame 3)))
+    (or (builtin? f)
+        (closure? f))))
+
+(define (display-frame frame port)
+  (core:display-error "  ")
+  (let ((f (struct-ref frame 3)))
+    (cond ((builtin? f)
+           (core:display-error "[b] ")
+           (core:display-error "(")
+           (core:display-error (struct-ref f 3))
+           (for-each (lambda (i) (core:display-error " _")) (iota (struct-ref f 4)))
+           (core:display-error ")"))
+          ((closure? f)
+           (core:display-error "[c] ")
+           (let* ((circ (core:car (core:cdr f)))
+                  (name (core:car (core:car (core:cdr circ))))
+                  (args (core:car (core:cdr (core:cdr f)))))
+             (core:display-error (cons name args))))
+          (else
+           (core:display-error "[u] ")
+           (core:display-error f))))
+  (core:display-error "\n"))
 
 (define (display-backtrace stack port . rest)
   (let* ((frames (map (lambda (i) (stack-ref stack i)) (iota (stack-length stack))))
          (call-frames (filter frame-procedure frames))
-         (display-frames (drop-right call-frames 2)))
-    (for-each (lambda (f)
-                (core:display-error "  ")
-                (core:display-error f)
-                (core:display-error "\n"))
-              display-frames)))
+         (trace-frames (reverse call-frames))
+         (display-frames (cdr trace-frames)))
+    (for-each (lambda (f) (display-frame f port)) display-frames)))

mes/module/mes/peg/cache.scm

@@ -1,47 +0,0 @@
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Taken from GNU Guile
-;;; cache.scm --- cache the results of parsing
-
-(define-module (ice-9 peg cache)
-  #:export (cg-cached-parser))
-
-;; The results of parsing using a nonterminal are cached.  Think of it like a
-;; hash with no conflict resolution.  Process for deciding on the cache size
-;; wasn't very scientific; just ran the benchmarks and stopped a little after
-;; the point of diminishing returns on my box.
-(define *cache-size* 512)
-
-(define (make-cache)
-  (make-vector *cache-size* #f))
-
-;; given a syntax object which is a parser function, returns syntax
-;; which, if evaluated, will become a parser function that uses a cache.
-(define (cg-cached-parser parser)
-  #`(let ((cache (make-cache)))
-      (lambda (str strlen at)
-        (let* ((vref (vector-ref cache (modulo at *cache-size*))))
-          ;; Check to see whether the value is cached.
-          (if (and vref (eq? (car vref) str) (= (cadr vref) at))
-              (caddr vref);; If it is return it.
-              (let ((fres ;; Else calculate it and cache it.
-                     (#,parser str strlen at)))
-                (vector-set! cache (modulo at *cache-size*)
-                             (list str at fres))
-                fres))))))

mes/module/mes/peg/codegen.scm

@@ -1,361 +0,0 @@
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright (C) 2011 Free Software Foundation, Inc.
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Taken from GNU Guile
-
-;;; codegen.scm --- code generation for composable parsers
-
-(define-module (ice-9 peg codegen)
-  #:export (compile-peg-pattern wrap-parser-for-users add-peg-compiler!)
-  #:use-module (ice-9 pretty-print)
-  #:use-module (system base pmatch))
-
-(define-syntax single?
-  (syntax-rules ()
-    ;;"Return #t if X is a list of one element."
-    ((_ x)
-     (pmatch x
-       ((_) #t)
-       (else #f)))))
-
-(define-syntax single-filter
-  (syntax-rules ()
-    ;;"If EXP is a list of one element, return the element.  Otherwise return EXP."
-    ((_ exp)
-     (pmatch exp
-       ((,elt) elt)
-       (,elts elts)))))
-
-(define-syntax push-not-null!
-  (syntax-rules ()
-    ;;"If OBJ is non-null, push it onto LST, otherwise do nothing."
-    ((_ lst obj)
-     (if (not (null? obj))
-         (push! lst obj)))))
-
-(define-syntax push!
-  (syntax-rules ()
-    ;;"Push an object onto a list."
-    ((_ lst obj)
-     (set! lst (cons obj lst)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; CODE GENERATORS
-;; These functions generate scheme code for parsing PEGs.
-;; Conventions:
-;;   accum: (all name body none)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Code we generate will have a certain return structure depending on how we're
-;; accumulating (the ACCUM variable).
-(define (cg-generic-ret accum name body-uneval at)
-  ;; name, body-uneval and at are syntax
-  #`(let ((body #,body-uneval))
-     #,(cond
-        ((and (eq? accum 'all) name)
-         #`(list #,at
-                 (cond
-                  ((not (list? body)) (list '#,name body))
-                  ((null? body) '#,name)
-                  ((symbol? (car body)) (list '#,name body))
-                  (else (cons '#,name body)))))
-        ((eq? accum 'name)
-         #`(list #,at '#,name))
-        ((eq? accum 'body)
-         #`(list #,at
-                 (cond
-                  ((single? body) (car body))
-                  (else body))))
-        ((eq? accum 'none)
-         #`(list #,at '()))
-        (else
-         (begin
-           (pretty-print `(cg-generic-ret-error ,accum ,name ,body-uneval ,at))
-           (pretty-print "Defaulting to accum of none.\n")
-           #`(list #,at '()))))))
-
-;; The short name makes the formatting below much easier to read.
-(define cggr cg-generic-ret)
-
-;; Generates code that matches a particular string.
-;; E.g.: (cg-string syntax "abc" 'body)
-(define (cg-string pat accum)
-  (let ((plen (string-length pat)))
-    #`(lambda (str len pos)
-        (let ((end (+ pos #,plen)))
-          (and (<= end len)
-               (string= str #,pat pos end)
-               #,(case accum
-                   ((all) #`(list end (list 'cg-string #,pat)))
-                   ((name) #`(list end 'cg-string))
-                   ((body) #`(list end #,pat))
-                   ((none) #`(list end '()))
-                   (else (error "bad accum" accum))))))))
-
-;; Generates code for matching any character.
-;; E.g.: (cg-peg-any syntax 'body)
-(define (cg-peg-any accum)
-  #`(lambda (str len pos)
-      (and (< pos len)
-           #,(case accum
-               ((all) #`(list (1+ pos)
-                              (list 'cg-peg-any (substring str pos (1+ pos)))))
-               ((name) #`(list (1+ pos) 'cg-peg-any))
-               ((body) #`(list (1+ pos) (substring str pos (1+ pos))))
-               ((none) #`(list (1+ pos) '()))
-               (else (error "bad accum" accum))))))
-
-;; Generates code for matching a range of characters between start and end.
-;; E.g.: (cg-range syntax #\a #\z 'body)
-(define (cg-range pat accum)
-  (syntax-case pat ()
-    ((start end)
-     (if (not (and (char? (syntax->datum #'start))
-                   (char? (syntax->datum #'end))))
-         (error "range PEG should have characters after it; instead got"
-                #'start #'end))
-     #`(lambda (str len pos)
-         (and (< pos len)
-              (let ((c (string-ref str pos)))
-                (and (char>=? c start)
-                     (char<=? c end)
-                     #,(case accum
-                         ((all) #`(list (1+ pos) (list 'cg-range (string c))))
-                         ((name) #`(list (1+ pos) 'cg-range))
-                         ((body) #`(list (1+ pos) (string c)))
-                         ((none) #`(list (1+ pos) '()))
-                         (else (error "bad accum" accum))))))))))
-
-;; Generate code to match a pattern and do nothing with the result
-(define (cg-ignore pat accum)
-  (syntax-case pat ()
-    ((inner)
-     (compile-peg-pattern #'inner 'none))))
-
-(define (cg-capture pat accum)
-  (syntax-case pat ()
-    ((inner)
-     (compile-peg-pattern #'inner 'body))))
-
-;; Filters the accum argument to compile-peg-pattern for buildings like string
-;; literals (since we don't want to tag them with their name if we're doing an
-;; "all" accum).
-(define (builtin-accum-filter accum)
-  (cond
-   ((eq? accum 'all) 'body)
-   ((eq? accum 'name) 'name)
-   ((eq? accum 'body) 'body)
-   ((eq? accum 'none) 'none)))
-(define baf builtin-accum-filter)
-
-;; Top-level function builder for AND.  Reduces to a call to CG-AND-INT.
-(define (cg-and clauses accum)
-  #`(lambda (str len pos)
-      (let ((body '()))
-        #,(cg-and-int clauses (baf accum) #'str #'len #'pos #'body))))
-
-;; Internal function builder for AND (calls itself).
-(define (cg-and-int clauses accum str strlen at body)
-  (syntax-case clauses ()
-    (()
-     (cggr accum 'cg-and #`(reverse #,body) at))
-    ((first rest ...)
-     #`(let ((res (#,(compile-peg-pattern #'first accum) #,str #,strlen #,at)))
-         (and res
-              ;; update AT and BODY then recurse
-              (let ((newat (car res))
-                    (newbody (cadr res)))
-                (set! #,at newat)
-                (push-not-null! #,body (single-filter newbody))
-                #,(cg-and-int #'(rest ...) accum str strlen at body)))))))
-
-;; Top-level function builder for OR.  Reduces to a call to CG-OR-INT.
-(define (cg-or clauses accum)
-  #`(lambda (str len pos)
-      #,(cg-or-int clauses (baf accum) #'str #'len #'pos)))
-
-;; Internal function builder for OR (calls itself).
-(define (cg-or-int clauses accum str strlen at)
-  (syntax-case clauses ()
-    (()
-     #f)
-    ((first rest ...)
-     #`(or (#,(compile-peg-pattern #'first accum) #,str #,strlen #,at)
-           #,(cg-or-int #'(rest ...) accum str strlen at)))))
-
-(define (cg-* args accum)
-  (syntax-case args ()
-    ((pat)
-     #`(lambda (str strlen at)
-         (let ((body '()))
-           (let lp ((end at) (count 0))
-             (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
-                            str strlen end))
-                    (new-end (if match (car match) end))
-                    (count (if (> new-end end) (1+ count) count)))
-               (if (> new-end end)
-                   (push-not-null! body (single-filter (cadr match))))
-               (if (and (> new-end end)
-                        #,#t)
-                   (lp new-end count)
-                   (let ((success #,#t))
-                     #,#`(and success
-                                 #,(cggr (baf accum) 'cg-body
-                                         #'(reverse body) #'new-end)))))))))))
-
-(define (cg-+ args accum)
-  (syntax-case args ()
-    ((pat)
-     #`(lambda (str strlen at)
-         (let ((body '()))
-           (let lp ((end at) (count 0))
-             (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
-                            str strlen end))
-                    (new-end (if match (car match) end))
-                    (count (if (> new-end end) (1+ count) count)))
-               (if (> new-end end)
-                   (push-not-null! body (single-filter (cadr match))))
-               (if (and (> new-end end)
-                        #,#t)
-                   (lp new-end count)
-                   (let ((success #,#'(>= count 1)))
-                     #,#`(and success
-                                 #,(cggr (baf accum) 'cg-body
-                                         #'(reverse body) #'new-end)))))))))))
-
-(define (cg-? args accum)
-  (syntax-case args ()
-    ((pat)
-     #`(lambda (str strlen at)
-         (let ((body '()))
-           (let lp ((end at) (count 0))
-             (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
-                            str strlen end))
-                    (new-end (if match (car match) end))
-                    (count (if (> new-end end) (1+ count) count)))
-               (if (> new-end end)
-                   (push-not-null! body (single-filter (cadr match))))
-               (if (and (> new-end end)
-                        #,#'(< count 1))
-                   (lp new-end count)
-                   (let ((success #,#t))
-                     #,#`(and success
-                                 #,(cggr (baf accum) 'cg-body
-                                         #'(reverse body) #'new-end)))))))))))
-
-(define (cg-followed-by args accum)
-  (syntax-case args ()
-    ((pat)
-     #`(lambda (str strlen at)
-         (let ((body '()))
-           (let lp ((end at) (count 0))
-             (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
-                            str strlen end))
-                    (new-end (if match (car match) end))
-                    (count (if (> new-end end) (1+ count) count)))
-               (if (> new-end end)
-                   (push-not-null! body (single-filter (cadr match))))
-               (if (and (> new-end end)
-                        #,#'(< count 1))
-                   (lp new-end count)
-                   (let ((success #,#'(= count 1)))
-                     #,#`(and success
-                              #,(cggr (baf accum) 'cg-body #''() #'at)))))))))))
-
-(define (cg-not-followed-by args accum)
-  (syntax-case args ()
-    ((pat)
-     #`(lambda (str strlen at)
-         (let ((body '()))
-           (let lp ((end at) (count 0))
-             (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
-                            str strlen end))
-                    (new-end (if match (car match) end))
-                    (count (if (> new-end end) (1+ count) count)))
-               (if (> new-end end)
-                   (push-not-null! body (single-filter (cadr match))))
-               (if (and (> new-end end)
-                        #,#'(< count 1))
-                   (lp new-end count)
-                   (let ((success #,#'(= count 1)))
-                     #,#`(if success
-                                #f
-                                #,(cggr (baf accum) 'cg-body #''() #'at)))))))))))
-
-;; Association list of functions to handle different expressions as PEGs
-(define peg-compiler-alist '())
-
-(define (add-peg-compiler! symbol function)
-  (set! peg-compiler-alist
-        (assq-set! peg-compiler-alist symbol function)))
-
-(add-peg-compiler! 'range cg-range)
-(add-peg-compiler! 'ignore cg-ignore)
-(add-peg-compiler! 'capture cg-capture)
-(add-peg-compiler! 'and cg-and)
-(add-peg-compiler! 'or cg-or)
-(add-peg-compiler! '* cg-*)
-(add-peg-compiler! '+ cg-+)
-(add-peg-compiler! '? cg-?)
-(add-peg-compiler! 'followed-by cg-followed-by)
-(add-peg-compiler! 'not-followed-by cg-not-followed-by)
-
-;; Takes an arbitrary expressions and accumulation variable, then parses it.
-;; E.g.: (compile-peg-pattern syntax '(and "abc" (or "-" (range #\a #\z))) 'all)
-(define (compile-peg-pattern pat accum)
-  (syntax-case pat (peg-any)
-    (peg-any
-     (cg-peg-any (baf accum)))
-    (sym (identifier? #'sym) ;; nonterminal
-     #'sym)
-    (str (string? (syntax->datum #'str)) ;; literal string
-     (cg-string (syntax->datum #'str) (baf accum)))
-    ((name . args) (let* ((nm (syntax->datum #'name))
-                          (entry (assq-ref peg-compiler-alist nm)))
-                     (if entry
-                         (entry #'args accum)
-                         (error "Bad peg form" nm #'args
-                                "Not one of" (map car peg-compiler-alist)))))))
-
-;; Packages the results of a parser
-(define (wrap-parser-for-users for-syntax parser accumsym s-syn)
-   #`(lambda (str strlen at)
-      (let ((res (#,parser str strlen at)))
-        ;; Try to match the nonterminal.
-        (if res
-            ;; If we matched, do some post-processing to figure out
-            ;; what data to propagate upward.
-            (let ((at (car res))
-                  (body (cadr res)))
-              #,(cond
-                 ((eq? accumsym 'name)
-                  #`(list at '#,s-syn))
-                 ((eq? accumsym 'all)
-                  #`(list (car res)
-                          (cond
-                           ((not (list? body))
-                            (list '#,s-syn body))
-                           ((null? body) '#,s-syn)
-                           ((symbol? (car body))
-                            (list '#,s-syn body))
-                           (else (cons '#,s-syn body)))))
-                 ((eq? accumsym 'none) #`(list (car res) '()))
-                 (else #`(begin res))))
-            ;; If we didn't match, just return false.
-            #f))))

mes/module/mes/peg/simplify-tree.scm

@@ -1,100 +0,0 @@
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Taken from GNU Guile
-
-;;; simplify-tree.scm --- utility functions for the PEG parser
-
-(define-module (ice-9 peg simplify-tree)
-  #:export (keyword-flatten context-flatten string-collapse)
-  #:use-module (system base pmatch))
-
-(define-syntax single?
-  (syntax-rules ()
-    ;;"Return #t if X is a list of one element."
-    ((_ x)
-     (pmatch x
-       ((_) #t)
-       (else #f)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; POST-PROCESSING FUNCTIONS (TO CANONICALIZE MATCH TREES)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Is everything in LST true?
-(define (andlst lst)
-  (or (null? lst)
-      (and (car lst) (andlst (cdr lst)))))
-
-;; Is LST a list of strings?
-(define (string-list? lst)
-  (and (list? lst) (not (null? lst))
-       (andlst (map string? lst))))
-
-;; Groups all strings that are next to each other in LST.  Used in
-;; STRING-COLLAPSE.
-(define (string-group lst)
-  (if (not (list? lst))
-      lst
-      (if (null? lst)
-          '()
-          (let ((next (string-group (cdr lst))))
-            (if (not (string? (car lst)))
-                (cons (car lst) next)
-                (if (and (not (null? next))
-                         (list? (car next))
-                         (string? (caar next)))
-                    (cons (cons (car lst) (car next)) (cdr next))
-                    (cons (list (car lst)) next)))))))
-
-
-;; Collapses all the string in LST.
-;; ("a" "b" (c d) "e" "f") -> ("ab" (c d) "ef")
-(define (string-collapse lst)
-  (if (list? lst)
-      (let ((res (map (lambda (x) (if (string-list? x)
-                                      (apply string-append x)
-                                      x))
-                      (string-group (map string-collapse lst)))))
-        (if (single? res) (car res) res))
-      lst))
-
-;; If LST is an atom, return (list LST), else return LST.
-(define (mklst lst)
-  (if (not (list? lst)) (list lst) lst))
-
-;; Takes a list and "flattens" it, using the predicate TST to know when to stop
-;; instead of terminating on atoms (see tutorial).
-(define (context-flatten tst lst)
-  (if (or (not (list? lst)) (null? lst))
-      lst
-      (if (tst lst)
-          (list lst)
-          (apply append
-                 (map (lambda (x) (mklst (context-flatten tst x)))
-                      lst)))))
-
-;; Takes a list and "flattens" it, using the list of keywords KEYWORD-LST to
-;; know when to stop at (see tutorial).
-(define (keyword-flatten keyword-lst lst)
-  (context-flatten
-   (lambda (x)
-     (if (or (not (list? x)) (null? x))
-         #t
-         (member (car x) keyword-lst)))
-   lst))

mes/module/mes/peg/string-peg.scm

@@ -1,275 +0,0 @@
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Taken from GNU Guile
-
-;;; string-peg.scm --- representing PEG grammars as strings
-
-(define-module (ice-9 peg string-peg)
-  #:export (peg-as-peg
-            define-peg-string-patterns
-            peg-grammar)
-  #:use-module (ice-9 peg using-parsers)
-  #:use-module (ice-9 peg codegen)
-  #:use-module (ice-9 peg simplify-tree))
-
-;; Gets the left-hand depth of a list.
-(define (depth lst)
-  (if (or (not (list? lst)) (null? lst))
-      0
-      (+ 1 (depth (car lst)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; Parse string PEGs using sexp PEGs.
-;; See the variable PEG-AS-PEG for an easier-to-read syntax.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Grammar for PEGs in PEG grammar.
-(define peg-as-peg
-"grammar <-- (nonterminal ('<--' / '<-' / '<') sp pattern)+
-pattern <-- alternative (SLASH sp alternative)*
-alternative <-- ([!&]? sp suffix)+
-suffix <-- primary ([*+?] sp)*
-primary <-- '(' sp pattern ')' sp / '.' sp / literal / charclass / nonterminal !'<'
-literal <-- ['] (!['] .)* ['] sp
-charclass <-- LB (!']' (CCrange / CCsingle))* RB sp
-CCrange <-- . '-' .
-CCsingle <-- .
-nonterminal <-- [a-zA-Z0-9-]+ sp
-sp < [ \t\n]*
-SLASH < '/'
-LB < '['
-RB < ']'
-")
-
-(define-syntax define-sexp-parser
-  (lambda (x)
-    (syntax-case x ()
-      ((_ sym accum pat)
-       (let* ((matchf (compile-peg-pattern #'pat (syntax->datum #'accum)))
-              (accumsym (syntax->datum #'accum))
-              (syn (wrap-parser-for-users x matchf accumsym #'sym)))
-           #`(define sym #,syn))))))
-
-(define-sexp-parser peg-grammar all
-  (+ (and peg-nonterminal (or "<--" "<-" "<") peg-sp peg-pattern)))
-(define-sexp-parser peg-pattern all
-  (and peg-alternative
-       (* (and (ignore "/") peg-sp peg-alternative))))
-(define-sexp-parser peg-alternative all
-  (+ (and (? (or "!" "&")) peg-sp peg-suffix)))
-(define-sexp-parser peg-suffix all
-  (and peg-primary (* (and (or "*" "+" "?") peg-sp))))
-(define-sexp-parser peg-primary all
-  (or (and "(" peg-sp peg-pattern ")" peg-sp)
-      (and "." peg-sp)
-      peg-literal
-      peg-charclass
-      (and peg-nonterminal (not-followed-by "<"))))
-(define-sexp-parser peg-literal all
-  (and "'" (* (and (not-followed-by "'") peg-any)) "'" peg-sp))
-(define-sexp-parser peg-charclass all
-  (and (ignore "[")
-       (* (and (not-followed-by "]")
-               (or charclass-range charclass-single)))
-       (ignore "]")
-       peg-sp))
-(define-sexp-parser charclass-range all (and peg-any "-" peg-any))
-(define-sexp-parser charclass-single all peg-any)
-(define-sexp-parser peg-nonterminal all
-  (and (+ (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9) "-")) peg-sp))
-(define-sexp-parser peg-sp none
-  (* (or " " "\t" "\n")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; PARSE STRING PEGS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Takes a string representing a PEG grammar and returns syntax that
-;; will define all of the nonterminals in the grammar with equivalent
-;; PEG s-expressions.
-(define (peg-parser str for-syntax)
-  (let ((parsed (match-pattern peg-grammar str)))
-    (if (not parsed)
-        (begin
-          ;; (display "Invalid PEG grammar!\n")
-          #f)
-        (let ((lst (peg:tree parsed)))
-          (cond
-           ((or (not (list? lst)) (null? lst))
-            lst)
-           ((eq? (car lst) 'peg-grammar)
-            #`(begin
-                #,@(map (lambda (x) (peg-nonterm->defn x for-syntax))
-                        (context-flatten (lambda (lst) (<= (depth lst) 2))
-                                         (cdr lst))))))))))
-
-;; Macro wrapper for PEG-PARSER.  Parses PEG grammars expressed as strings and
-;; defines all the appropriate nonterminals.
-(define-syntax define-peg-string-patterns
-  (lambda (x)
-    (syntax-case x ()
-      ((_ str)
-       (peg-parser (syntax->datum #'str) x)))))
-
-;; lst has format (nonterm grabber pattern), where
-;;   nonterm is a symbol (the name of the nonterminal),
-;;   grabber is a string (either "<", "<-" or "<--"), and
-;;   pattern is the parse of a PEG pattern expressed as as string.
-(define (peg-nonterm->defn lst for-syntax)
-  (let* ((nonterm (car lst))
-         (grabber (cadr lst))
-         (pattern (caddr lst))
-         (nonterm-name (datum->syntax for-syntax
-                                      (string->symbol (cadr nonterm)))))
-    #`(define-peg-pattern #,nonterm-name
-       #,(cond
-          ((string=? grabber "<--") (datum->syntax for-syntax 'all))
-          ((string=? grabber "<-") (datum->syntax for-syntax 'body))
-          (else (datum->syntax for-syntax 'none)))
-       #,(compressor (peg-pattern->defn pattern for-syntax) for-syntax))))
-
-;; lst has format ('peg-pattern ...).
-;; After the context-flatten, (cdr lst) has format
-;;   (('peg-alternative ...) ...), where the outer list is a collection
-;;   of elements from a '/' alternative.
-(define (peg-pattern->defn lst for-syntax)
-  #`(or #,@(map (lambda (x) (peg-alternative->defn x for-syntax))
-                (context-flatten (lambda (x) (eq? (car x) 'peg-alternative))
-                                 (cdr lst)))))
-
-;; lst has format ('peg-alternative ...).
-;; After the context-flatten, (cdr lst) has the format
-;;   (item ...), where each item has format either ("!" ...), ("&" ...),
-;;   or ('peg-suffix ...).
-(define (peg-alternative->defn lst for-syntax)
-  #`(and #,@(map (lambda (x) (peg-body->defn x for-syntax))
-                 (context-flatten (lambda (x) (or (string? (car x))
-                                             (eq? (car x) 'peg-suffix)))
-                                  (cdr lst)))))
-
-;; lst has the format either
-;;   ("!" ('peg-suffix ...)), ("&" ('peg-suffix ...)), or
-;;     ('peg-suffix ...).
-(define (peg-body->defn lst for-syntax)
-    (cond
-      ((equal? (car lst) "&")
-       #`(followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
-      ((equal? (car lst) "!")
-       #`(not-followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
-      ((eq? (car lst) 'peg-suffix)
-       (peg-suffix->defn lst for-syntax))
-      (else `(peg-parse-body-fail ,lst))))
-
-;; lst has format ('peg-suffix <peg-primary> (? (/ "*" "?" "+")))
-(define (peg-suffix->defn lst for-syntax)
-  (let ((inner-defn (peg-primary->defn (cadr lst) for-syntax)))
-    (cond
-      ((null? (cddr lst))
-       inner-defn)
-      ((equal? (caddr lst) "*")
-       #`(* #,inner-defn))
-      ((equal? (caddr lst) "?")
-       #`(? #,inner-defn))
-      ((equal? (caddr lst) "+")
-       #`(+ #,inner-defn)))))
-
-;; Parse a primary.
-(define (peg-primary->defn lst for-syntax)
-  (let ((el (cadr lst)))
-  (cond
-   ((list? el)
-    (cond
-     ((eq? (car el) 'peg-literal)
-      (peg-literal->defn el for-syntax))
-     ((eq? (car el) 'peg-charclass)
-      (peg-charclass->defn el for-syntax))
-     ((eq? (car el) 'peg-nonterminal)
-      (datum->syntax for-syntax (string->symbol (cadr el))))))
-   ((string? el)
-    (cond
-     ((equal? el "(")
-      (peg-pattern->defn (caddr lst) for-syntax))
-     ((equal? el ".")
-      (datum->syntax for-syntax 'peg-any))
-     (else (datum->syntax for-syntax
-                          `(peg-parse-any unknown-string ,lst)))))
-   (else (datum->syntax for-syntax
-                        `(peg-parse-any unknown-el ,lst))))))
-
-;; Trims characters off the front and end of STR.
-;; (trim-1chars "'ab'") -> "ab"
-(define (trim-1chars str) (substring str 1 (- (string-length str) 1)))
-
-;; Parses a literal.
-(define (peg-literal->defn lst for-syntax)
-  (datum->syntax for-syntax (trim-1chars (cadr lst))))
-
-;; Parses a charclass.
-(define (peg-charclass->defn lst for-syntax)
-  #`(or
-     #,@(map
-         (lambda (cc)
-           (cond
-            ((eq? (car cc) 'charclass-range)
-             #`(range #,(datum->syntax
-                         for-syntax
-                         (string-ref (cadr cc) 0))
-                      #,(datum->syntax
-                         for-syntax
-                         (string-ref (cadr cc) 2))))
-            ((eq? (car cc) 'charclass-single)
-             (datum->syntax for-syntax (cadr cc)))))
-         (context-flatten
-          (lambda (x) (or (eq? (car x) 'charclass-range)
-                          (eq? (car x) 'charclass-single)))
-          (cdr lst)))))
-
-;; Compresses a list to save the optimizer work.
-;; e.g. (or (and a)) -> a
-(define (compressor-core lst)
-  (if (or (not (list? lst)) (null? lst))
-      lst
-      (cond
-       ((and (or (eq? (car lst) 'or) (eq? (car lst) 'and))
-             (null? (cddr lst)))
-        (compressor-core (cadr lst)))
-       ((and (eq? (car lst) 'body)
-             (eq? (cadr lst) 'lit)
-             (eq? (cadddr lst) 1))
-        (compressor-core (caddr lst)))
-       (else (map compressor-core lst)))))
-
-(define (compressor syn for-syntax)
-  (datum->syntax for-syntax
-                 (compressor-core (syntax->datum syn))))
-
-;; Builds a lambda-expressions for the pattern STR using accum.
-(define (peg-string-compile args accum)
-  (syntax-case args ()
-    ((str-stx) (string? (syntax->datum #'str-stx))
-     (let ((string (syntax->datum #'str-stx)))
-       (compile-peg-pattern
-        (compressor
-         (peg-pattern->defn
-          (peg:tree (match-pattern peg-pattern string)) #'str-stx)
-         #'str-stx)
-        (if (eq? accum 'all) 'body accum))))
-     (else (error "Bad embedded PEG string" args))))
-
-(add-peg-compiler! 'peg peg-string-compile)

mes/module/mes/peg/using-parsers.scm

@@ -1,118 +0,0 @@
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Taken from GNU Guile
-
-;;; using-parsers.scm --- utilities to make using parsers easier
-
-(define-module (ice-9 peg using-parsers)
-  #:use-module (ice-9 peg simplify-tree)
-  #:use-module (ice-9 peg codegen)
-  #:use-module (ice-9 peg cache)
-  #:export (match-pattern define-peg-pattern search-for-pattern
-            prec make-prec peg:start peg:end peg:string
-            peg:tree peg:substring peg-record?))
-
-;;;
-;;; Helper Macros
-;;;
-
-(define-syntax until
-  (syntax-rules ()
-    ;;"Evaluate TEST.  If it is true, return its value.  Otherwise,execute the STMTs and try again."
-    ((_ test stmt stmt* ...)
-     (let lp ()
-       (or test
-           (begin stmt stmt* ... (lp)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; FOR DEFINING AND USING NONTERMINALS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Parses STRING using NONTERM
-(define (match-pattern nonterm string)
-  ;; We copy the string before using it because it might have been modified
-  ;; in-place since the last time it was parsed, which would invalidate the
-  ;; cache.  Guile uses copy-on-write for strings, so this is fast.
-  (let ((res (nonterm (string-copy string) (string-length string) 0)))
-    (if (not res)
-        #f
-        (make-prec 0 (car res) string (string-collapse (cadr res))))))
-
-;; Defines a new nonterminal symbol accumulating with ACCUM.
-(define-syntax define-peg-pattern
-  (lambda (x)
-    (syntax-case x ()
-      ((_ sym accum pat)
-       (let ((matchf (compile-peg-pattern #'pat (syntax->datum #'accum)))
-             (accumsym (syntax->datum #'accum)))
-         ;; CODE is the code to parse the string if the result isn't cached.
-         (let ((syn (wrap-parser-for-users x matchf accumsym #'sym)))
-           #`(define sym #,(cg-cached-parser syn))))))))
-
-(define (peg-like->peg pat)
-  (syntax-case pat ()
-    (str (string? (syntax->datum #'str)) #'(peg str))
-    (else pat)))
-
-;; Searches through STRING for something that parses to PEG-MATCHER.  Think
-;; regexp search.
-(define-syntax search-for-pattern
-  (lambda (x)
-    (syntax-case x ()
-      ((_ pattern string-uncopied)
-       (let ((pmsym (syntax->datum #'pattern)))
-         (let ((matcher (compile-peg-pattern (peg-like->peg #'pattern) 'body)))
-           ;; We copy the string before using it because it might have been
-           ;; modified in-place since the last time it was parsed, which would
-           ;; invalidate the cache.  Guile uses copy-on-write for strings, so
-           ;; this is fast.
-           #`(let ((string (string-copy string-uncopied))
-                   (strlen (string-length string-uncopied))
-                   (at 0))
-               (let ((ret (until (or (>= at strlen)
-                                     (#,matcher string strlen at))
-                                 (set! at (+ at 1)))))
-                 (if (eq? ret #t) ;; (>= at strlen) succeeded
-                     #f
-                     (let ((end (car ret))
-                           (match (cadr ret)))
-                       (make-prec
-                        at end string
-                        (string-collapse match))))))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; PMATCH STRUCTURE MUNGING
-;; Pretty self-explanatory.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define prec
-  (make-record-type "peg" '(start end string tree)))
-(define make-prec
-  (record-constructor prec '(start end string tree)))
-(define (peg:start pm)
-  (if pm ((record-accessor prec 'start) pm) #f))
-(define (peg:end pm)
-  (if pm ((record-accessor prec 'end) pm) #f))
-(define (peg:string pm)
-  (if pm ((record-accessor prec 'string) pm) #f))
-(define (peg:tree pm)
-  (if pm ((record-accessor prec 'tree) pm) #f))
-(define (peg:substring pm)
-  (if pm (substring (peg:string pm) (peg:start pm) (peg:end pm)) #f))
-(define peg-record? (record-predicate prec))