├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── i.c ├── i.h ├── k.c ├── misc ├── Skint-postlude.scm ├── Skint-prelude.scm ├── skint-12x12.png ├── skint-252x100.png ├── skint-298x128.png ├── skint-896x384.png ├── syntax-rules.md └── test.scm ├── n.c ├── n.h ├── pre ├── README.md ├── k.sf ├── ksf2c.ssc ├── n.sf ├── nsf2c.ssc ├── nsf2h.ssc ├── s.scm ├── scm2c.ssc └── t.scm ├── s.c ├── s.h └── t.c /.gitignore: -------------------------------------------------------------------------------- 1 | # Prerequisites 2 | *.d 3 | 4 | # Object files 5 | *.o 6 | *.ko 7 | *.obj 8 | *.elf 9 | 10 | # Linker output 11 | *.ilk 12 | *.map 13 | *.exp 14 | 15 | # Precompiled Headers 16 | *.gch 17 | *.pch 18 | 19 | # Libraries 20 | *.lib 21 | *.a 22 | *.la 23 | *.lo 24 | 25 | # Shared objects (inc. Windows DLLs) 26 | *.dll 27 | *.so 28 | *.so.* 29 | *.dylib 30 | 31 | # Executables 32 | *.exe 33 | *.out 34 | *.app 35 | *.i*86 36 | *.x86_64 37 | *.hex 38 | 39 | # Debug files 40 | *.dSYM/ 41 | *.su 42 | *.idb 43 | *.pdb 44 | 45 | # Kernel Module Compile Results 46 | *.mod* 47 | *.cmd 48 | .tmp_versions/ 49 | modules.order 50 | Module.symvers 51 | Mkfile.old 52 | dkms.conf 53 | 54 | save/ 55 | .vs/ 56 | 57 | tests/r5rstest.ss 58 | tests/r7rstest.ss 59 | tmp1 60 | tmp2 61 | tmp3 62 | skint 63 | /skint-vs2022 64 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2023, false-schemers 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | 3. Neither the name of the copyright holder nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CFLAGS = -O3 -DNDEBUG 2 | LDFLAGS = 3 | PREFIX = /usr/local 4 | INSTALL = install -m 755 -s 5 | UNINSTALL = rm -f 6 | RM = rm -f 7 | ARCH = unknown 8 | 9 | ifneq ($(shell which clang),) 10 | $(info clang is detected) 11 | CC = clang 12 | else 13 | CC = gcc 14 | endif 15 | 16 | ifeq ($(OS),Windows_NT) 17 | ifeq ($(PROCESSOR_ARCHITEW6432),AMD64) 18 | ARCH = AMD64 19 | else 20 | ifeq ($(PROCESSOR_ARCHITECTURE),AMD64) 21 | ARCH = AMD64 22 | endif 23 | ifeq ($(PROCESSOR_ARCHITECTURE),x86) 24 | ARCH = IA32 25 | endif 26 | endif 27 | else 28 | UNAME := $(shell uname -p) 29 | ifeq ($(UNAME),unknown) 30 | UNAME := $(shell uname -m) 31 | endif 32 | ifeq ($(UNAME),x86_64) 33 | ARCH = AMD64 34 | endif 35 | ifneq ($(filter %86,$(UNAME)),) 36 | ARCH = IA32 37 | endif 38 | ifneq ($(filter arm%,$(UNAME)),) 39 | ARCH = ARM 40 | endif 41 | ifeq ($(UNAME),riscv64) 42 | ARCH = RV64 43 | endif 44 | endif 45 | 46 | ifeq ($(ARCH),AMD64) 47 | $(info x86_64 architecture is detected) 48 | CFLAGS += -D NAN_BOXING 49 | endif 50 | ifeq ($(ARCH),RV64) 51 | $(info RISCV_64 architecture is detected) 52 | CFLAGS += -D NAN_BOXING 53 | endif 54 | 55 | .PHONY: all clean realclean test install uninstall 56 | 57 | exe = ./skint 58 | 59 | sources = s.c \ 60 | k.c \ 61 | i.c \ 62 | n.c \ 63 | t.c 64 | 65 | includes = i.h \ 66 | n.h \ 67 | s.h 68 | 69 | objects = $(sources:%.c=%.o) 70 | 71 | all: $(exe) 72 | 73 | test: 74 | $(exe) misc/test.scm 75 | 76 | clean: 77 | $(RM) $(objects) 78 | 79 | realclean: 80 | $(RM) $(objects) $(exe) 81 | 82 | install: 83 | $(INSTALL) $(exe) $(PREFIX)/bin 84 | 85 | uninstall: 86 | $(UNINSTALL) $(exe) $(PREFIX)/bin 87 | 88 | $(exe): $(objects) 89 | $(CC) $(LDFLAGS) $(CFLAGS) -o $@ $(objects) -lm 90 | 91 | $(objects): %.o: %.c 92 | $(CC) $(CFLAGS) -c -o $@ $< 93 | 94 | $(objects): $(includes) 95 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![](https://raw.githubusercontent.com/false-schemers/skint/master/misc/skint-252x100.png) 2 | 3 | # Cheap and fast R7RS Scheme Interpreter 4 | 5 | SKINT is a portable interpreter for the R7RS Scheme programming language. 6 | It can be built from five C source files (10K lines of code) with a single command. There are no distributives or packages; 7 | just compile the source files with your favorite C compiler, link them with the standard C runtime libraries, 8 | and you're done. For some platforms, precompiled binaries are available (please see [releases](https://github.com/false-schemers/skint/releases)). 9 | 10 | ## Installation 11 | 12 | Here's how you can compile SKINT on a unix box using GCC: 13 | 14 | ``` 15 | gcc -o skint [skint].c -lm 16 | ``` 17 | 18 | Some compilers link `` library automatically, some require explicit option like `-lm` above. It can be built on 32-bit 19 | and 64-bit systems. 20 | 21 | For *much* better performance (especially in floating-point calculations) you may pick another compiler, add optimization flags 22 | and some SKINT-specific options, e.g.: 23 | 24 | ``` 25 | clang -o skint -O3 -D NDEBUG -D NAN_BOXING [skint].c -lm 26 | ``` 27 | 28 | The NAN_BOXING option assumes that the upper 16 bits of heap pointers are zero (48-bit address space). It is recommended to use this 29 | option on 64-bit systems that guarantee this. 30 | 31 | The resulting interpreter has no dependencies (except for C runtime and standard -lm math library) and can be run from any location. 32 | If linked statically, it can be easily moved between systems with the same ABI. 33 | 34 | For a more traditional install, please follow the instructions below. Skint will be 35 | installed as `/usr/local/bin/skint` command. 36 | 37 | ``` 38 | git clone https://github.com/false-schemers/skint.git 39 | cd skint 40 | make 41 | make test 42 | sudo make install 43 | ``` 44 | 45 | ## Scheme Compatibility 46 | 47 | SKINT is true to basic Scheme principles -- it features a precise garbage collector, supports proper tail recursion, `call/cc`, 48 | `dynamic-wind`, multiple return values, has a hygienic macro system, and a library system. It is almost fully compatible 49 | with R7RS-small, but has the following known limitations and deviations from the standard: 50 | 51 | * fixnums are 30 bit long, flonums are doubles 52 | * no support for bignums/rational/complex numbers 53 | * no support for Unicode; strings are 8-bit clean, use system locale 54 | * source code literals cannot be circular (R7RS allows this) 55 | 56 | Some features of the R7RS-Small standard are not yet implemented or implemented in a simplified or non-conforming way: 57 | 58 | * `read` procedure is always case-sensitive (all ports operate in no-fold-case mode) 59 | * `#!fold-case` and `#!no-fold-case` directives have no effect 60 | * `include` and `include-ci` forms work in case-sensitive mode 61 | * `current-jiffy` and `jiffies-per-second` return inexact integers 62 | * `current-second` is defined as C `difftime(time(0), 0)+37` 63 | 64 | Here are some details on SKINT's interactive Read-Eval-Print-Loop (REPL) and evaluation/libraries support: 65 | 66 | * `read` supports R7RS notation for circular structures, but both `eval` and `load` reject them 67 | * all R7RS-small forms are available in the built-in `(skint)` library and REPL environment 68 | * `-I` and `-A` command-line options extend library search path; initial path is `./` 69 | * `cond-expand` checks against `(features)` and available libraries 70 | * `environment` may dynamically fetch external library definitions from `.sld` files 71 | * both `eval` and `load` accept optional environment argument 72 | * command-line options can be shown by running `skint --help` 73 | * both `import` and `define-library` forms can be entered interactively into REPL 74 | * REPL supports single-line “comma-commands” — type `,help` for a full list 75 | * on Un*x-like systems, interactive use of skint with line exiting requires external readline wrapper 76 | such as [rlwrap](https://github.com/hanslub42/rlwrap) 77 | 78 | Please note that SKINT's interaction environment exposes bindings for all R7RS-small procedures 79 | and syntax forms directly, so there is no need to use `import`. All R7RS-small libraries are built-in and 80 | do not rely on any external .sld files. 81 | 82 | ## Origins 83 | 84 | Parts of SKINT's run-time system and startup code are written in [#F](https://github.com/false-schemers/sharpF), 85 | a language for building Scheme-like systems. Its #F source code can be found there in `precursors` directory: 86 | 87 | [skint/pre](https://github.com/false-schemers/skint/tree/main/pre) 88 | 89 | SKINT's hygienic macroexpander is derived from Al Petrofsky's EIOD 1.17 (please see the t.scm file for the original copyright info). 90 | SKINT's VM and compiler follow the stack machine approach described in “Three Implementation Models for Scheme” thesis by R. Kent Dybvig 91 | ([TR87-011](https://www.cs.unc.edu/techreports/87-011.pdf), 1987). 92 | Supporting library code comes from #F's [LibL library](https://raw.githubusercontent.com/false-schemers/sharpF/master/lib/libl.sf). 93 | 94 | ## Family 95 | 96 | Please see [SIOF](https://github.com/false-schemers/siof) repository for a single-file R7RS-small interpreter. It is 97 | more portable and easier to build, but is less complete and runs significantly slower. 98 | -------------------------------------------------------------------------------- /i.h: -------------------------------------------------------------------------------- 1 | /* i.h -- instructions */ 2 | 3 | #ifndef glue 4 | #define glue(a, b) a##b 5 | #endif 6 | #ifndef AUTOGL 7 | #define AUTOGL NULL 8 | #endif 9 | #ifndef INLINED 10 | #define INLINED "" 11 | #endif 12 | 13 | #if defined(VM_GEN_DEFGLOBAL) 14 | #define declare_instruction(name, enc, etyp, igname, arity, lcode) \ 15 | declare_instruction_global(name) 16 | #define declare_integrable(name, enc, etyp, igname, arity, lcode) 17 | #elif defined(VM_GEN_ENCTABLE) 18 | #define declare_instruction(name, enc, etyp, igname, arity, lcode) \ 19 | declare_enctable_entry(name, enc, etyp) 20 | #define declare_integrable(name, enc, etyp, igname, arity, lcode) 21 | #elif defined(VM_GEN_INTGTABLE) 22 | #define declare_instruction(name, enc, etyp, igname, arity, lcode) \ 23 | declare_intgtable_entry(enc, igname, arity, lcode) 24 | #define declare_integrable(name, enc, etyp, igname, arity, lcode) \ 25 | declare_intgtable_entry(enc, igname, arity, lcode) 26 | #else /* regular include */ 27 | #define declare_instruction(name, enc, etyp, igname, arity, lcode) \ 28 | extern obj glue(cx_ins_2D, name); 29 | #define declare_integrable(name, enc, etyp, igname, arity, lcode) 30 | extern obj vmcases[]; /* vm host */ 31 | #endif 32 | 33 | /* basic vm machinery: generated by compiler and used in hand-coded functions */ 34 | declare_instruction(halt, NULL, 0, NULL, 0, NULL) 35 | declare_instruction(litf, "f", 0, NULL, 0, NULL) 36 | declare_instruction(litt, "t", 0, NULL, 0, NULL) 37 | declare_instruction(litn, "n", 0, NULL, 0, NULL) 38 | declare_instruction(lit, "'", 1, NULL, 0, NULL) 39 | declare_instruction(sref, ".", 1, NULL, 0, NULL) 40 | declare_instruction(dref, ":", 1, NULL, 0, NULL) 41 | declare_instruction(gref, "@", 'g', NULL, 0, NULL) 42 | declare_instruction(iref, "^", 0, NULL, 0, NULL) 43 | declare_instruction(iset, "^!", 0, NULL, 0, NULL) 44 | declare_instruction(dclose, "&", 'd', NULL, 0, NULL) 45 | declare_instruction(sbox, "#", 1, NULL, 0, NULL) 46 | declare_instruction(br, NULL, 'b', NULL, 0, NULL) 47 | declare_instruction(brnot, "?", 'b', NULL, 0, NULL) 48 | declare_instruction(brt, "~?", 'b', NULL, 0, NULL) 49 | declare_instruction(andbo, ";", 'a', NULL, 0, NULL) 50 | declare_instruction(sseti, ".!", 1, NULL, 0, NULL) 51 | declare_instruction(dseti, ":!", 1, NULL, 0, NULL) 52 | declare_instruction(gloc, "`", 'g', NULL, 0, NULL) 53 | declare_instruction(gset, "@!", 'g', NULL, 0, NULL) 54 | declare_instruction(appl, "K3", 0, NULL, 0, NULL) 55 | declare_instruction(cwmv, "K4", 0, NULL, 0, NULL) 56 | declare_instruction(rcmv, "K5", 0, NULL, 0, NULL) 57 | declare_instruction(sdmv, "K6", 0, NULL, 0, NULL) 58 | declare_instruction(lck, "k", 1, NULL, 0, NULL) 59 | declare_instruction(lck0, "k0", 0, NULL, 0, NULL) 60 | declare_instruction(rck, "k!", 0, NULL, 0, NULL) 61 | declare_instruction(wck, "w", 0, NULL, 0, NULL) 62 | declare_instruction(wckr, "w!", 0, NULL, 0, NULL) 63 | declare_instruction(dys, "y", 0, NULL, 0, NULL) 64 | declare_instruction(setdys, "sy", 0, NULL, 0, NULL) 65 | declare_instruction(save, "$", 's', NULL, 0, NULL) 66 | declare_instruction(push, ",", 0, NULL, 0, NULL) 67 | declare_instruction(jdceq, "|", 2, NULL, 0, NULL) 68 | declare_instruction(jdcge, "|!", 2, NULL, 0, NULL) 69 | declare_instruction(jdref, "|!0", 1, NULL, 0, NULL) 70 | declare_instruction(call, "[0", 1, NULL, 0, NULL) 71 | declare_instruction(scall, "[", 2, NULL, 0, NULL) 72 | declare_instruction(return, "]0", 0, NULL, 0, NULL) 73 | declare_instruction(sreturn, "]", 1, NULL, 0, NULL) 74 | declare_instruction(adrop, "_", 1, NULL, 0, NULL) 75 | declare_instruction(pop, "_!", 0, NULL, 0, NULL) 76 | declare_instruction(atest, "%", 1, NULL, 0, NULL) 77 | declare_instruction(shrarg, "%!", 1, NULL, 0, NULL) 78 | declare_instruction(aerr, "%%", 0, NULL, 0, NULL) 79 | 80 | /* popular instruction combos */ 81 | declare_instruction(shlit, ",'", 1, NULL, 0, NULL) 82 | declare_instruction(shi0, ",'0", 0, NULL, 0, NULL) 83 | declare_instruction(pushlitf, "f,", 0, NULL, 0, NULL) 84 | declare_instruction(pushlitt, "t,", 0, NULL, 0, NULL) 85 | declare_instruction(pushlitn, "n,", 0, NULL, 0, NULL) 86 | declare_instruction(lit0, "'0", 0, NULL, 0, NULL) 87 | declare_instruction(lit1, "'1", 0, NULL, 0, NULL) 88 | declare_instruction(lit2, "'2", 0, NULL, 0, NULL) 89 | declare_instruction(lit3, "'3", 0, NULL, 0, NULL) 90 | declare_instruction(lit4, "'4", 0, NULL, 0, NULL) 91 | declare_instruction(lit5, "'5", 0, NULL, 0, NULL) 92 | declare_instruction(lit6, "'6", 0, NULL, 0, NULL) 93 | declare_instruction(lit7, "'7", 0, NULL, 0, NULL) 94 | declare_instruction(lit8, "'8", 0, NULL, 0, NULL) 95 | declare_instruction(lit9, "'9", 0, NULL, 0, NULL) 96 | declare_instruction(pushlit0, "'0,", 0, NULL, 0, NULL) 97 | declare_instruction(pushlit1, "'1,", 0, NULL, 0, NULL) 98 | declare_instruction(pushlit2, "'2,", 0, NULL, 0, NULL) 99 | declare_instruction(pushlit3, "'3,", 0, NULL, 0, NULL) 100 | declare_instruction(pushlit4, "'4,", 0, NULL, 0, NULL) 101 | declare_instruction(pushlit5, "'5,", 0, NULL, 0, NULL) 102 | declare_instruction(pushlit6, "'6,", 0, NULL, 0, NULL) 103 | declare_instruction(pushlit7, "'7,", 0, NULL, 0, NULL) 104 | declare_instruction(pushlit8, "'8,", 0, NULL, 0, NULL) 105 | declare_instruction(pushlit9, "'9,", 0, NULL, 0, NULL) 106 | declare_instruction(sref0, ".0", 0, NULL, 0, NULL) 107 | declare_instruction(sref1, ".1", 0, NULL, 0, NULL) 108 | declare_instruction(sref2, ".2", 0, NULL, 0, NULL) 109 | declare_instruction(sref3, ".3", 0, NULL, 0, NULL) 110 | declare_instruction(sref4, ".4", 0, NULL, 0, NULL) 111 | declare_instruction(sref5, ".5", 0, NULL, 0, NULL) 112 | declare_instruction(sref6, ".6", 0, NULL, 0, NULL) 113 | declare_instruction(sref7, ".7", 0, NULL, 0, NULL) 114 | declare_instruction(sref8, ".8", 0, NULL, 0, NULL) 115 | declare_instruction(sref9, ".9", 0, NULL, 0, NULL) 116 | declare_instruction(pushsref0, ".0,", 0, NULL, 0, NULL) 117 | declare_instruction(pushsref1, ".1,", 0, NULL, 0, NULL) 118 | declare_instruction(pushsref2, ".2,", 0, NULL, 0, NULL) 119 | declare_instruction(pushsref3, ".3,", 0, NULL, 0, NULL) 120 | declare_instruction(pushsref4, ".4,", 0, NULL, 0, NULL) 121 | declare_instruction(pushsref5, ".5,", 0, NULL, 0, NULL) 122 | declare_instruction(pushsref6, ".6,", 0, NULL, 0, NULL) 123 | declare_instruction(pushsref7, ".7,", 0, NULL, 0, NULL) 124 | declare_instruction(pushsref8, ".8,", 0, NULL, 0, NULL) 125 | declare_instruction(pushsref9, ".9,", 0, NULL, 0, NULL) 126 | declare_instruction(srefi0, ".0^", 0, NULL, 0, NULL) 127 | declare_instruction(srefi1, ".1^", 0, NULL, 0, NULL) 128 | declare_instruction(srefi2, ".2^", 0, NULL, 0, NULL) 129 | declare_instruction(srefi3, ".3^", 0, NULL, 0, NULL) 130 | declare_instruction(srefi4, ".4^", 0, NULL, 0, NULL) 131 | declare_instruction(pushsrefi0, ".0^,", 0, NULL, 0, NULL) 132 | declare_instruction(pushsrefi1, ".1^,", 0, NULL, 0, NULL) 133 | declare_instruction(pushsrefi2, ".2^,", 0, NULL, 0, NULL) 134 | declare_instruction(pushsrefi3, ".3^,", 0, NULL, 0, NULL) 135 | declare_instruction(pushsrefi4, ".4^,", 0, NULL, 0, NULL) 136 | declare_instruction(dref0, ":0", 0, NULL, 0, NULL) 137 | declare_instruction(dref1, ":1", 0, NULL, 0, NULL) 138 | declare_instruction(dref2, ":2", 0, NULL, 0, NULL) 139 | declare_instruction(dref3, ":3", 0, NULL, 0, NULL) 140 | declare_instruction(dref4, ":4", 0, NULL, 0, NULL) 141 | declare_instruction(pushdref0, ":0,", 0, NULL, 0, NULL) 142 | declare_instruction(pushdref1, ":1,", 0, NULL, 0, NULL) 143 | declare_instruction(pushdref2, ":2,", 0, NULL, 0, NULL) 144 | declare_instruction(pushdref3, ":3,", 0, NULL, 0, NULL) 145 | declare_instruction(pushdref4, ":4,", 0, NULL, 0, NULL) 146 | declare_instruction(drefi0, ":0^", 0, NULL, 0, NULL) 147 | declare_instruction(drefi1, ":1^", 0, NULL, 0, NULL) 148 | declare_instruction(drefi2, ":2^", 0, NULL, 0, NULL) 149 | declare_instruction(drefi3, ":3^", 0, NULL, 0, NULL) 150 | declare_instruction(drefi4, ":4^", 0, NULL, 0, NULL) 151 | declare_instruction(pushdrefi0, ":0^,", 0, NULL, 0, NULL) 152 | declare_instruction(pushdrefi1, ":1^,", 0, NULL, 0, NULL) 153 | declare_instruction(pushdrefi2, ":2^,", 0, NULL, 0, NULL) 154 | declare_instruction(pushdrefi3, ":3^,", 0, NULL, 0, NULL) 155 | declare_instruction(pushdrefi4, ":4^,", 0, NULL, 0, NULL) 156 | declare_instruction(call0, "[00", 0, NULL, 0, NULL) 157 | declare_instruction(call1, "[01", 0, NULL, 0, NULL) 158 | declare_instruction(call2, "[02", 0, NULL, 0, NULL) 159 | declare_instruction(call3, "[03", 0, NULL, 0, NULL) 160 | declare_instruction(call4, "[04", 0, NULL, 0, NULL) 161 | declare_instruction(scall1, "[1", 1, NULL, 0, NULL) 162 | declare_instruction(scall10, "[10", 0, NULL, 0, NULL) 163 | declare_instruction(scall11, "[11", 0, NULL, 0, NULL) 164 | declare_instruction(scall12, "[12", 0, NULL, 0, NULL) 165 | declare_instruction(scall13, "[13", 0, NULL, 0, NULL) 166 | declare_instruction(scall14, "[14", 0, NULL, 0, NULL) 167 | declare_instruction(scall2, "[2", 1, NULL, 0, NULL) 168 | declare_instruction(scall20, "[20", 0, NULL, 0, NULL) 169 | declare_instruction(scall21, "[21", 0, NULL, 0, NULL) 170 | declare_instruction(scall22, "[22", 0, NULL, 0, NULL) 171 | declare_instruction(scall23, "[23", 0, NULL, 0, NULL) 172 | declare_instruction(scall24, "[24", 0, NULL, 0, NULL) 173 | declare_instruction(scall3, "[3", 1, NULL, 0, NULL) 174 | declare_instruction(scall30, "[30", 0, NULL, 0, NULL) 175 | declare_instruction(scall31, "[31", 0, NULL, 0, NULL) 176 | declare_instruction(scall32, "[32", 0, NULL, 0, NULL) 177 | declare_instruction(scall33, "[33", 0, NULL, 0, NULL) 178 | declare_instruction(scall34, "[34", 0, NULL, 0, NULL) 179 | declare_instruction(scall4, "[4", 1, NULL, 0, NULL) 180 | declare_instruction(scall40, "[40", 0, NULL, 0, NULL) 181 | declare_instruction(scall41, "[41", 0, NULL, 0, NULL) 182 | declare_instruction(scall42, "[42", 0, NULL, 0, NULL) 183 | declare_instruction(scall43, "[43", 0, NULL, 0, NULL) 184 | declare_instruction(scall44, "[44", 0, NULL, 0, NULL) 185 | declare_instruction(sreturn1, "]1", 0, NULL, 0, NULL) 186 | declare_instruction(sreturn2, "]2", 0, NULL, 0, NULL) 187 | declare_instruction(sreturn3, "]3", 0, NULL, 0, NULL) 188 | declare_instruction(sreturn4, "]4", 0, NULL, 0, NULL) 189 | declare_instruction(atest0, "%0", 0, NULL, 0, NULL) 190 | declare_instruction(atest1, "%1", 0, NULL, 0, NULL) 191 | declare_instruction(atest2, "%2", 0, NULL, 0, NULL) 192 | declare_instruction(atest3, "%3", 0, NULL, 0, NULL) 193 | declare_instruction(atest4, "%4", 0, NULL, 0, NULL) 194 | /* declare_instruction(brnotlt, "0", 0, "fxpositive?", '1', AUTOGL) 234 | declare_instruction(inegp, "I<0", 0, "fxnegative?", '1', AUTOGL) 235 | declare_instruction(ievnp, "Ie", 0, "fxeven?", '1', AUTOGL) 236 | declare_instruction(ioddp, "Io", 0, "fxodd?", '1', AUTOGL) 237 | declare_instruction(iadd, "I+\0'0", 0, "fx+", 'p', AUTOGL) 238 | declare_instruction(isub, "I-\0I-!", 0, "fx-", 'm', AUTOGL) 239 | declare_instruction(imul, "I*\0'1", 0, "fx*", 'p', AUTOGL) 240 | declare_instruction(idiv, "I/\0,'1I/", 0, "fx/", 'm', AUTOGL) 241 | declare_instruction(iquo, "Iq", 0, "fxquotient", '2', AUTOGL) 242 | declare_instruction(irem, "Ir", 0, "fxremainder", '2', AUTOGL) 243 | declare_instruction(ilt, "I<", 0, "fx", 0, "fx>?", 'c', AUTOGL) 245 | declare_instruction(ile, "I>!", 0, "fx<=?", 'c', AUTOGL) 246 | declare_instruction(ige, "I=?", 'c', AUTOGL) 247 | declare_instruction(ieq, "I=", 0, "fx=?", 'c', AUTOGL) 248 | declare_instruction(ine, "I=!", 0, "fx!=?", '2', AUTOGL) 249 | declare_instruction(imin, "In", 0, "fxmin", 'x', AUTOGL) 250 | declare_instruction(imax, "Ix", 0, "fxmax", 'x', AUTOGL) 251 | declare_instruction(ineg, "I-!", 0, "fxneg", '1', AUTOGL) 252 | declare_instruction(iabs, "Ia", 0, "fxabs", '1', AUTOGL) 253 | declare_instruction(itoj, "Ij", 0, "fixnum->flonum", '1', AUTOGL) 254 | declare_instruction(fixp, "I0", 0, "fixnum?", '1', AUTOGL) 255 | declare_instruction(imqu, "Il", 0, "fxmodquo", '2', AUTOGL) 256 | declare_instruction(imlo, "Im", 0, "fxmodulo", '2', AUTOGL) 257 | declare_instruction(ieuq, "I5", 0, "fxeucquo", '2', AUTOGL) 258 | declare_instruction(ieur, "I6", 0, "fxeucrem", '2', AUTOGL) 259 | declare_instruction(igcd, "Ig\0'0", 0, "fxgcd", 'p', AUTOGL) 260 | declare_instruction(ipow, "Ip", 0, "fxexpt", '2', AUTOGL) 261 | declare_instruction(isqrt, "It\0f", 0, "%fxsqrt", 'b', AUTOGL) 262 | declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL) 263 | declare_instruction(iand, "D1\0'(i-1)", 0, "fxand", 'p', AUTOGL) 264 | declare_instruction(iior, "D2\0'0", 0, "fxior", 'p', AUTOGL) 265 | declare_instruction(ixor, "D3\0'0", 0, "fxxor", 'p', AUTOGL) 266 | declare_instruction(iasl, "D4", 0, "fxsll", '2', AUTOGL) 267 | declare_instruction(iasr, "D5", 0, "fxsra", '2', AUTOGL) 268 | declare_instruction(ilsr, "D6", 0, "fxsrl", '2', AUTOGL) 269 | declare_instruction(iaddc, "D+", 0, "fxaddc", '3', AUTOGL) 270 | declare_instruction(isubc, "D-", 0, "fxsubc", '3', AUTOGL) 271 | declare_instruction(imulc, "D*", 0, "fxmulc", '3', AUTOGL) 272 | declare_instruction(jzerop, "J=0", 0, "flzero?", '1', AUTOGL) 273 | declare_instruction(jposp, "J>0", 0, "flpositive?", '1', AUTOGL) 274 | declare_instruction(jnegp, "J<0", 0, "flnegative?", '1', AUTOGL) 275 | declare_instruction(jevnp, "Je", 0, "fleven?", '1', AUTOGL) 276 | declare_instruction(joddp, "Jo", 0, "flodd?", '1', AUTOGL) 277 | declare_instruction(jintp, "Jw", 0, "flinteger?", '1', AUTOGL) 278 | declare_instruction(jnanp, "Ju", 0, "flnan?", '1', AUTOGL) 279 | declare_instruction(jfinp, "Jf", 0, "flfinite?", '1', AUTOGL) 280 | declare_instruction(jinfp, "Jh", 0, "flinfinite?", '1', AUTOGL) 281 | declare_instruction(jadd, "J+\0'(j0)", 0, "fl+", 'p', AUTOGL) 282 | declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL) 283 | declare_instruction(jmul, "J*\0'(j1)", 0, "fl*", 'p', AUTOGL) 284 | declare_instruction(jdiv, "J/\0,'(j1)J/", 0, "fl/", 'm', AUTOGL) 285 | declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL) 286 | declare_instruction(jrem, "Jr", 0, "flremainder", '2', AUTOGL) 287 | declare_instruction(jlt, "J<", 0, "fl", 0, "fl>?", 'c', AUTOGL) 289 | declare_instruction(jle, "J>!", 0, "fl<=?", 'c', AUTOGL) 290 | declare_instruction(jge, "J=?", 'c', AUTOGL) 291 | declare_instruction(jeq, "J=", 0, "fl=?", 'c', AUTOGL) 292 | declare_instruction(jne, "J=!", 0, "fl!=?", '2', AUTOGL) 293 | declare_instruction(jmin, "Jn", 0, "flmin", 'x', AUTOGL) 294 | declare_instruction(jmax, "Jx", 0, "flmax", 'x', AUTOGL) 295 | declare_instruction(jneg, "J-!", 0, "flneg", '1', AUTOGL) 296 | declare_instruction(jabs, "Ja", 0, "flabs", '1', AUTOGL) 297 | declare_instruction(jgcd, "Jg\0'(j0)", 0, "flgcd", 'p', AUTOGL) 298 | declare_instruction(jpow, "Jp", 0, "flexpt", '2', AUTOGL) 299 | declare_instruction(jsqrt, "Jt", 0, "flsqrt", '1', AUTOGL) 300 | declare_instruction(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL) 301 | declare_instruction(jmqu, "Jl", 0, "flmodquo", '2', AUTOGL) 302 | declare_instruction(jmlo, "Jm", 0, "flmodulo", '2', AUTOGL) 303 | declare_instruction(jfloor, "Jb", 0, "flfloor", '1', AUTOGL) 304 | declare_instruction(jceil, "Jc", 0, "flceiling", '1', AUTOGL) 305 | declare_instruction(jtrunc, "Jk", 0, "fltruncate", '1', AUTOGL) 306 | declare_instruction(jround, "Jd", 0, "flround", '1', AUTOGL) 307 | declare_instruction(flop, "J0", 0, "flonum?", '1', AUTOGL) 308 | declare_instruction(jexp, "J1", 0, "flexp", '1', AUTOGL) 309 | declare_instruction(jlog, "J2\0f", 0, "fllog", 'b', AUTOGL) 310 | declare_instruction(jsin, "J3", 0, "flsin", '1', AUTOGL) 311 | declare_instruction(jcos, "J4", 0, "flcos", '1', AUTOGL) 312 | declare_instruction(jtan, "J5", 0, "fltan", '1', AUTOGL) 313 | declare_instruction(jasin, "J6", 0, "flasin", '1', AUTOGL) 314 | declare_instruction(jacos, "J7", 0, "flacos", '1', AUTOGL) 315 | declare_instruction(jatan, "J8\0f", 0, "flatan", 'b', AUTOGL) 316 | declare_instruction(zerop, "=0", 0, "zero?", '1', AUTOGL) 317 | declare_instruction(posp, ">0", 0, "positive?", '1', AUTOGL) 318 | declare_instruction(negp, "<0", 0, "negative?", '1', AUTOGL) 319 | declare_instruction(add, "+\0'0", 0, "+", 'p', AUTOGL) 320 | declare_instruction(sub, "-\0-!", 0, "-", 'm', AUTOGL) 321 | declare_instruction(mul, "*\0'1", 0, "*", 'p', AUTOGL) 322 | declare_instruction(div, "/\0,'1/", 0, "/", 'm', AUTOGL) 323 | declare_instruction(lt, "<", 0, "<", 'c', AUTOGL) 324 | declare_instruction(gt, ">", 0, ">", 'c', AUTOGL) 325 | declare_instruction(le, ">!", 0, "<=", 'c', AUTOGL) 326 | declare_instruction(ge, "=", 'c', AUTOGL) 327 | declare_instruction(eq, "=", 0, "=", 'c', AUTOGL) 328 | declare_instruction(ne, "=!", 0, "!=", '2', AUTOGL) 329 | declare_instruction(min, "Nn", 0, "min", 'x', AUTOGL) 330 | declare_instruction(max, "Nx", 0, "max", 'x', AUTOGL) 331 | declare_instruction(neg, "-!", 0, "neg", '1', AUTOGL) 332 | declare_instruction(abs, "Na", 0, "abs", '1', AUTOGL) 333 | declare_instruction(gcd, "Ng\0'0", 0, "gcd", 'p', AUTOGL) 334 | declare_instruction(pow, "Np", 0, "expt", '2', AUTOGL) 335 | declare_instruction(sqrt, "Nt", 0, "sqrt", '1', AUTOGL) 336 | declare_instruction(mqu, "Nl", 0, "floor-quotient", '2', AUTOGL) 337 | declare_instruction(mlo, "Nm", 0, "floor-remainder", '2', AUTOGL) 338 | declare_instruction(quo, "Nq", 0, "truncate-quotient", '2', AUTOGL) 339 | declare_instruction(rem, "Nr", 0, "truncate-remainder", '2', AUTOGL) 340 | declare_instruction(nump, "N0", 0, "number?", '1', AUTOGL) 341 | declare_instruction(exp, "N1", 0, "exp", '1', AUTOGL) 342 | declare_instruction(log, "N2\0f", 0, "log", 'b', AUTOGL) 343 | declare_instruction(sin, "N3", 0, "sin", '1', AUTOGL) 344 | declare_instruction(cos, "N4", 0, "cos", '1', AUTOGL) 345 | declare_instruction(tan, "N5", 0, "tan", '1', AUTOGL) 346 | declare_instruction(asin, "N6", 0, "asin", '1', AUTOGL) 347 | declare_instruction(acos, "N7", 0, "acos", '1', AUTOGL) 348 | declare_instruction(atan, "N8\0f", 0, "atan", 'b', AUTOGL) 349 | declare_instruction(ratp, "Nv", 0, "rational?", '1', AUTOGL) 350 | declare_instruction(intp, "Nw", 0, "integer?", '1', AUTOGL) 351 | declare_instruction(nanp, "Nu", 0, "nan?", '1', AUTOGL) 352 | declare_instruction(finp, "Nf", 0, "finite?", '1', AUTOGL) 353 | declare_instruction(infp, "Nh", 0, "infinite?", '1', AUTOGL) 354 | declare_instruction(evnp, "Ne", 0, "even?", '1', AUTOGL) 355 | declare_instruction(oddp, "No", 0, "odd?", '1', AUTOGL) 356 | declare_instruction(ntoi, "Ni", 0, "exact", '1', AUTOGL) 357 | declare_instruction(ntoj, "Nj", 0, "inexact", '1', AUTOGL) 358 | declare_instruction(floor, "Nb", 0, "floor", '1', AUTOGL) 359 | declare_instruction(ceil, "Nc", 0, "ceiling", '1', AUTOGL) 360 | declare_instruction(trunc, "Nk", 0, "truncate", '1', AUTOGL) 361 | declare_instruction(round, "Nd", 0, "round", '1', AUTOGL) 362 | declare_instruction(listp, "L0", 0, "list?", '1', AUTOGL) 363 | declare_instruction(list, "l", 1, "list", '#', "%!0_!]0") 364 | declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL) 365 | declare_instruction(llen, "g", 0, "length", '1', AUTOGL) 366 | declare_instruction(lget, "L4", 0, "list-ref", '2', AUTOGL) 367 | declare_instruction(lput, "L5", 0, "list-set!", '3', AUTOGL) 368 | declare_instruction(lcat, "L6", 0, "list-cat", '2', AUTOGL) 369 | declare_instruction(lcpy, "L7", 0, "list-copy", '1', AUTOGL) 370 | declare_instruction(circp, "L9", 0, "circular?", '1', AUTOGL) 371 | declare_instruction(memq, "A0", 0, "memq", '2', AUTOGL) 372 | declare_instruction(memv, "A1", 0, "memv", '2', AUTOGL) 373 | declare_instruction(meme, "A2", 0, "meme", '2', AUTOGL) 374 | declare_instruction(assq, "A3", 0, "assq", '2', AUTOGL) 375 | declare_instruction(assv, "A4", 0, "assv", '2', AUTOGL) 376 | declare_instruction(asse, "A5", 0, "asse", '2', AUTOGL) 377 | declare_instruction(ltail, "A6", 0, "list-tail", '2', AUTOGL) 378 | declare_instruction(lpair, "A7", 0, "last-pair", '1', AUTOGL) 379 | declare_instruction(lrev, "A8", 0, "reverse", '1', AUTOGL) 380 | declare_instruction(lrevi, "A9", 0, "reverse!", '1', AUTOGL) 381 | declare_instruction(charp, "C0", 0, "char?", '1', AUTOGL) 382 | declare_instruction(cwsp, "C1", 0, "char-whitespace?", '1', AUTOGL) 383 | declare_instruction(clcp, "C2", 0, "char-lower-case?", '1', AUTOGL) 384 | declare_instruction(cucp, "C3", 0, "char-upper-case?", '1', AUTOGL) 385 | declare_instruction(calp, "C4", 0, "char-alphabetic?", '1', AUTOGL) 386 | declare_instruction(cnup, "C5", 0, "char-numeric?", '1', AUTOGL) 387 | declare_instruction(cupc, "Cu", 0, "char-upcase", '1', AUTOGL) 388 | declare_instruction(cdnc, "Cd", 0, "char-downcase", '1', AUTOGL) 389 | declare_instruction(cflc, "Cf", 0, "char-foldcase", '1', AUTOGL) 390 | declare_instruction(cdgv, "Cv", 0, "digit-value", '1', AUTOGL) 391 | declare_instruction(ccmp, "C-", 0, "char-cmp", '2', AUTOGL) 392 | declare_instruction(ceq, "C=", 0, "char=?", 'c', AUTOGL) 393 | declare_instruction(clt, "C<", 0, "char", 0, "char>?", 'c', AUTOGL) 395 | declare_instruction(cle, "C>!", 0, "char<=?", 'c', AUTOGL) 396 | declare_instruction(cge, "C=?", 'c', AUTOGL) 397 | declare_instruction(cicmp, "Ci-", 0, "char-ci-cmp", '2', AUTOGL) 398 | declare_instruction(cieq, "Ci=", 0, "char-ci=?", 'c', AUTOGL) 399 | declare_instruction(cilt, "Ci<", 0, "char-ci", 0, "char-ci>?", 'c', AUTOGL) 401 | declare_instruction(cile, "Ci>!", 0, "char-ci<=?", 'c', AUTOGL) 402 | declare_instruction(cige, "Ci=?", 'c', AUTOGL) 403 | declare_instruction(strp, "S0", 0, "string?", '1', AUTOGL) 404 | declare_instruction(str, "S1", 1, "string", '#', "%!0.0X3]1") 405 | declare_instruction(smk, "S2\0'(c )", 0, "make-string", 'b', AUTOGL) 406 | declare_instruction(slen, "S3", 0, "string-length", '1', AUTOGL) 407 | declare_instruction(sget, "S4", 0, "string-ref", '2', AUTOGL) 408 | declare_instruction(sput, "S5", 0, "string-set!", '3', AUTOGL) 409 | declare_instruction(scat, "S6", 0, "string-cat", '2', AUTOGL) 410 | declare_instruction(ssub, "S7", 0, "substring", '3', AUTOGL) 411 | declare_instruction(spos, "S8", 0, "string-position", '2', AUTOGL) 412 | declare_instruction(supc, "Su", 0, "string-upcase", '1', AUTOGL) 413 | declare_instruction(sdnc, "Sd", 0, "string-downcase", '1', AUTOGL) 414 | declare_instruction(sflc, "Sf", 0, "string-foldcase", '1', AUTOGL) 415 | declare_instruction(scmp, "S-", 0, "string-cmp", '2', AUTOGL) 416 | declare_instruction(seq, "S=", 0, "string=?", 'c', AUTOGL) 417 | declare_instruction(slt, "S<", 0, "string", 0, "string>?", 'c', AUTOGL) 419 | declare_instruction(sle, "S>!", 0, "string<=?", 'c', AUTOGL) 420 | declare_instruction(sge, "S=?", 'c', AUTOGL) 421 | declare_instruction(sicmp, "Si-", 0, "string-ci-cmp", '2', AUTOGL) 422 | declare_instruction(sieq, "Si=", 0, "string-ci=?", 'c', AUTOGL) 423 | declare_instruction(silt, "Si<", 0, "string-ci", 0, "string-ci>?", 'c', AUTOGL) 425 | declare_instruction(sile, "Si>!", 0, "string-ci<=?", 'c', AUTOGL) 426 | declare_instruction(sige, "Si=?", 'c', AUTOGL) 427 | declare_instruction(vecp, "V0", 0, "vector?", '1', AUTOGL) 428 | declare_instruction(vec, "V1", 1, "vector", '#', "%!0.0X1]1") 429 | declare_instruction(vmk, "V2\0f", 0, "make-vector", 'b', AUTOGL) 430 | declare_instruction(vlen, "V3", 0, "vector-length", '1', AUTOGL) 431 | declare_instruction(vget, "V4", 0, "vector-ref", '2', AUTOGL) 432 | declare_instruction(vput, "V5", 0, "vector-set!", '3', AUTOGL) 433 | declare_instruction(vcat, "V6", 0, "vector-cat", '2', AUTOGL) 434 | declare_instruction(bvecp, "B0", 0, "bytevector?", '1', AUTOGL) 435 | declare_instruction(bvec, "B1", 1, "bytevector", '#', "%!0.0E1]1") 436 | declare_instruction(bmk, "B2\0'0", 0, "make-bytevector", 'b', AUTOGL) 437 | declare_instruction(blen, "B3", 0, "bytevector-length", '1', AUTOGL) 438 | declare_instruction(bget, "B4", 0, "bytevector-u8-ref", '2', AUTOGL) 439 | declare_instruction(bput, "B5", 0, "bytevector-u8-set!", '3', AUTOGL) 440 | declare_instruction(bsub, "B7", 0, "subbytevector", '3', AUTOGL) 441 | declare_instruction(beq, "B=", 0, "bytevector=?", 'c', AUTOGL) 442 | declare_instruction(recp, "O0\0Y9", 0, "record?", 'b', AUTOGL) 443 | declare_instruction(rmk, "O2\0f", 0, "make-record", 't', AUTOGL) 444 | declare_instruction(rlen, "O3", 0, "record-length", '1', AUTOGL) 445 | declare_instruction(rget, "O4", 0, "record-ref", '2', AUTOGL) 446 | declare_instruction(rput, "O5", 0, "record-set!", '3', AUTOGL) 447 | declare_instruction(rrtd, "O6", 0, "record-type-descriptor", '1', AUTOGL) 448 | declare_instruction(vtol, "X0", 0, "%vector->list1", '1', AUTOGL) 449 | declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL) 450 | declare_instruction(stol, "X2", 0, "%string->list1", '1', AUTOGL) 451 | declare_instruction(ltos, "X3", 0, "list->string", '1', AUTOGL) 452 | declare_instruction(ytos, "X4", 0, "symbol->string", '1', AUTOGL) 453 | declare_instruction(stoy, "X5", 0, "string->symbol", '1', AUTOGL) 454 | declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b', AUTOGL) 455 | declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL) 456 | declare_instruction(ctoi, "X8", 0, "char->integer", '1', AUTOGL) 457 | declare_instruction(itoc, "X9", 0, "integer->char", '1', AUTOGL) 458 | declare_instruction(ltob, "E1", 0, "list->bytevector", '1', AUTOGL) 459 | declare_instruction(jtos, "E6\0f", 0, "flonum->string", 'b', AUTOGL) 460 | declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL) 461 | declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL) 462 | declare_instruction(ston, "E9\0'(i10)", 0, "string->number", 'b', AUTOGL) 463 | declare_instruction(symp, "Y0", 0, "symbol?", '1', AUTOGL) 464 | declare_instruction(boolp, "Y1", 0, "boolean?", '1', AUTOGL) 465 | declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL) 466 | declare_instruction(shebangp, "Y5", 0, "shebang?", '1', AUTOGL) 467 | declare_instruction(ytosb, "Y6", 0, "symbol->shebang", '1', AUTOGL) 468 | declare_instruction(sbtoy, "Y7", 0, "shebang->symbol", '1', AUTOGL) 469 | declare_instruction(voidp, "Y8", 0, "void?", '1', AUTOGL) 470 | declare_instruction(void, "Y9", 0, "void", '0', AUTOGL) 471 | declare_instruction(cin, "Pi", 0, "%current-input-port", '0', AUTOGL) 472 | declare_instruction(cout, "Po", 0, "%current-output-port", '0', AUTOGL) 473 | declare_instruction(cerr, "Pe", 0, "%current-error-port", '0', AUTOGL) 474 | declare_instruction(setcin, "Psi", 0, "%set-current-input-port!", '1', AUTOGL) 475 | declare_instruction(setcout, "Pso", 0, "%set-current-output-port!",'1', AUTOGL) 476 | declare_instruction(setcerr, "Pse", 0, "%set-current-error-port!", '1', AUTOGL) 477 | declare_instruction(funp, "K0", 0, "procedure?", '1', AUTOGL) 478 | declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL) 479 | declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL) 480 | declare_instruction(ttyp, "P09", 0, "tty-port?", '1', AUTOGL) 481 | declare_instruction(sip, "P10", 0, "standard-input-port", '0', AUTOGL) 482 | declare_instruction(sop, "P11", 0, "standard-output-port", '0', AUTOGL) 483 | declare_instruction(sep, "P12", 0, "standard-error-port", '0', AUTOGL) 484 | declare_instruction(ipop, "P20", 0, "input-port-open?", '1', AUTOGL) 485 | declare_instruction(opop, "P21", 0, "output-port-open?", '1', AUTOGL) 486 | declare_instruction(oif, "P40", 0, "%open-input-file", '1', AUTOGL) 487 | declare_instruction(oof, "P41", 0, "%open-output-file", '1', AUTOGL) 488 | declare_instruction(obif, "P42", 0, "%open-binary-input-file", '1', AUTOGL) 489 | declare_instruction(obof, "P43", 0, "%open-binary-output-file", '1', AUTOGL) 490 | declare_instruction(ois, "P50", 0, "open-input-string", '1', AUTOGL) 491 | declare_instruction(oos, "P51", 0, "open-output-string", '0', AUTOGL) 492 | declare_instruction(oib, "P52", 0, "open-input-bytevector", '1', AUTOGL) 493 | declare_instruction(oob, "P53", 0, "open-output-bytevector", '0', AUTOGL) 494 | declare_instruction(cip, "P60", 0, "close-input-port", '1', AUTOGL) 495 | declare_instruction(cop, "P61", 0, "close-output-port", '1', AUTOGL) 496 | declare_instruction(fop, "P71", 0, "flush-output-port", '1', AUTOGL) 497 | declare_instruction(pfc, "P78", 0, "port-fold-case?", '1', AUTOGL) 498 | declare_instruction(spfc, "P79", 0, "set-port-fold-case!", '2', AUTOGL) 499 | declare_instruction(gos, "P90", 0, "get-output-string", '1', AUTOGL) 500 | declare_instruction(gob, "P91", 0, "get-output-bytevector", '1', AUTOGL) 501 | declare_instruction(rdc, "R0\0Pi", 0, "read-char", 'u', AUTOGL) 502 | declare_instruction(rdac, "R1\0Pi", 0, "peek-char", 'u', AUTOGL) 503 | declare_instruction(rdcr, "R2\0Pi", 0, "char-ready?", 'u', AUTOGL) 504 | declare_instruction(rd8, "R3\0Pi", 0, "read-u8", 'u', AUTOGL) 505 | declare_instruction(rda8, "R4\0Pi", 0, "peek-u8", 'u', AUTOGL) 506 | declare_instruction(rd8r, "R5\0Pi", 0, "u8-ready?", 'u', AUTOGL) 507 | declare_instruction(eofp, "R8", 0, "eof-object?", '1', AUTOGL) 508 | declare_instruction(eof, "R9", 0, "eof-object", '0', AUTOGL) 509 | declare_instruction(wrc, "W0\0Po", 0, "write-char", 'b', AUTOGL) 510 | declare_instruction(wrs, "W1", 0, "%write-string1", '2', AUTOGL) 511 | declare_instruction(wr8, "W2\0Po", 0, "write-u8", 'b', AUTOGL) 512 | declare_instruction(wrb, "W3", 0, "%write-bytevector1", '2', AUTOGL) 513 | declare_instruction(wrcd, "W4\0Po", 0, "display", 'b', AUTOGL) 514 | declare_instruction(wrcw, "W5\0Po", 0, "write", 'b', AUTOGL) 515 | declare_instruction(wrnl, "W6\0Po", 0, "newline", 'u', AUTOGL) 516 | declare_instruction(wrhw, "W7\0Po", 0, "write-shared", 'b', AUTOGL) 517 | declare_instruction(wriw, "W8\0Po", 0, "write-simple", 'b', AUTOGL) 518 | declare_instruction(fexis, "F0", 0, "file-exists?", '1', AUTOGL) 519 | declare_instruction(frem, "F1", 0, "delete-file", '1', AUTOGL) 520 | declare_instruction(fren, "F2", 0, "rename-file", '2', AUTOGL) 521 | declare_instruction(getcwd, "F8", 0, "%cwd", '0', AUTOGL) 522 | declare_instruction(setcwd, "F9", 0, "%set-cwd!", '1', AUTOGL) 523 | declare_instruction(argvref, "Z0", 0, "%argv-ref", '1', AUTOGL) 524 | declare_instruction(getenv, "Z1", 0, "get-environment-variable", '1', AUTOGL) 525 | declare_instruction(envvref, "Z2", 0, "%envv-ref", '1', AUTOGL) 526 | declare_instruction(clock, "Z3", 0, "current-jiffy", '0', AUTOGL) 527 | declare_instruction(clops, "Z4", 0, "jiffies-per-second", '0', AUTOGL) 528 | declare_instruction(cursec, "Z5", 0, "current-second", '0', AUTOGL) 529 | declare_instruction(system, "Z6", 0, "%system", '1', AUTOGL) 530 | declare_instruction(panic, "Z7", 0, "%panic", '2', AUTOGL) 531 | declare_instruction(abort, "Z8\0t", 0, "%abort", 'u', AUTOGL) 532 | declare_instruction(exit, "Z9\0t", 0, "%exit", 'u', AUTOGL) 533 | declare_instruction(gc, "Zg", 0, "%gc", '0', AUTOGL) 534 | declare_instruction(gccnt, "Zc", 0, "%gc-count", '0', AUTOGL) 535 | declare_instruction(bumpcnt, "Zb", 0, "%bump-count", '0', AUTOGL) 536 | declare_instruction(heapsz, "Zh", 0, "%heap-size", '0', AUTOGL) 537 | declare_instruction(dirsep, "Zs", 0, "directory-separator", '0', AUTOGL) 538 | 539 | /* serialization, deserialization, compilation-related instructions */ 540 | declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL) 541 | declare_instruction(itrs, "U1", 0, "initial-transformers", '0', AUTOGL) 542 | declare_instruction(glos, "U2", 0, "global-store", '0', AUTOGL) 543 | declare_instruction(rdsx, "U3", 0, "deserialize-sexp", '1', AUTOGL) 544 | declare_instruction(rdsc, "U4", 0, "deserialize-code", '1', AUTOGL) 545 | declare_instruction(iglk, "U5", 0, "lookup-integrable", '1', AUTOGL) 546 | declare_instruction(igty, "U6", 0, "integrable-type", '1', AUTOGL) 547 | declare_instruction(iggl, "U7", 0, "integrable-global", '1', AUTOGL) 548 | declare_instruction(igco, "U8", 0, "integrable-code", '2', AUTOGL) 549 | declare_instruction(vmclo, "U9", 1, "closure", '#', INLINED) 550 | declare_instruction(hshim, "H2\0f", 0, "immediate-hash", 'b', AUTOGL) 551 | 552 | /* inlined integrables (no custom instructions) */ 553 | declare_integrable(NULL, "N0", 0, "complex?", '1', AUTOGL) 554 | declare_integrable(NULL, "N0", 0, "real?", '1', AUTOGL) 555 | declare_integrable(NULL, "I0", 0, "exact-integer?", '1', AUTOGL) 556 | declare_integrable(NULL, "%nI0", 0, "exact?", '1', AUTOGL) 557 | declare_integrable(NULL, "%nJ0", 0, "inexact?", '1', AUTOGL) 558 | declare_integrable(NULL, "Nm", 0, "modulo", '2', AUTOGL) 559 | declare_integrable(NULL, "Nq", 0, "quotient", '2', AUTOGL) 560 | declare_integrable(NULL, "Nr", 0, "remainder", '2', AUTOGL) 561 | declare_integrable(NULL, "Ij", 0, "exact->inexact", '1', AUTOGL) 562 | declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL) 563 | declare_integrable(NULL, "q", 0, "boolean=?", 'c', AUTOGL) 564 | declare_integrable(NULL, "q", 0, "symbol=?", 'c', AUTOGL) 565 | declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL) 566 | declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL) 567 | declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL) 568 | declare_integrable(NULL, "dda", 0, "caddr", '1', AUTOGL) 569 | declare_integrable(NULL, "aad", 0, "cdaar", '1', AUTOGL) 570 | declare_integrable(NULL, "dad", 0, "cdadr", '1', AUTOGL) 571 | declare_integrable(NULL, "add", 0, "cddar", '1', AUTOGL) 572 | declare_integrable(NULL, "ddd", 0, "cdddr", '1', AUTOGL) 573 | declare_integrable(NULL, "aaaa", 0, "caaaar", '1', AUTOGL) 574 | declare_integrable(NULL, "daaa", 0, "caaadr", '1', AUTOGL) 575 | declare_integrable(NULL, "adaa", 0, "caadar", '1', AUTOGL) 576 | declare_integrable(NULL, "ddaa", 0, "caaddr", '1', AUTOGL) 577 | declare_integrable(NULL, "aada", 0, "cadaar", '1', AUTOGL) 578 | declare_integrable(NULL, "dada", 0, "cadadr", '1', AUTOGL) 579 | declare_integrable(NULL, "adda", 0, "caddar", '1', AUTOGL) 580 | declare_integrable(NULL, "ddda", 0, "cadddr", '1', AUTOGL) 581 | declare_integrable(NULL, "aaad", 0, "cdaaar", '1', AUTOGL) 582 | declare_integrable(NULL, "daad", 0, "cdaadr", '1', AUTOGL) 583 | declare_integrable(NULL, "adad", 0, "cdadar", '1', AUTOGL) 584 | declare_integrable(NULL, "ddad", 0, "cdaddr", '1', AUTOGL) 585 | declare_integrable(NULL, "aadd", 0, "cddaar", '1', AUTOGL) 586 | declare_integrable(NULL, "dadd", 0, "cddadr", '1', AUTOGL) 587 | declare_integrable(NULL, "addd", 0, "cdddar", '1', AUTOGL) 588 | declare_integrable(NULL, "dddd", 0, "cddddr", '1', AUTOGL) 589 | 590 | /* non-integrable global definitions */ 591 | declare_integrable(NULL, NULL, 0, "apply-to-list", '@', "%2_!K3") 592 | declare_integrable(NULL, NULL, 0, "call-with-values", '@', "%2_!K4") 593 | declare_integrable(NULL, NULL, 0, "values", '@', "K6") 594 | 595 | #undef declare_instruction 596 | #undef declare_integrable 597 | -------------------------------------------------------------------------------- /k.c: -------------------------------------------------------------------------------- 1 | /* k.c -- generated via skint ksf2c.ssc k.sf */ 2 | 3 | #include "n.h" 4 | #include "i.h" 5 | 6 | #define MODULE module_k 7 | #define LOAD() 8 | 9 | /* cx globals */ 10 | obj cx__2Acurrent_2Derror_2A; /* *current-error* */ 11 | obj cx__2Acurrent_2Dinput_2A; /* *current-input* */ 12 | obj cx__2Acurrent_2Doutput_2A; /* *current-output* */ 13 | obj cx__2Adynamic_2Dstate_2A; /* *dynamic-state* */ 14 | obj cx__2Aglobals_2A; /* *globals* */ 15 | obj cx__2Atransformers_2A; /* *transformers* */ 16 | obj cx_callmv_2Dadapter_2Dclosure; /* callmv-adapter-closure */ 17 | obj cx_continuation_2Dadapter_2Dcode; /* continuation-adapter-code */ 18 | obj cx_decode; /* decode */ 19 | obj cx_decode_2Dsexp; /* decode-sexp */ 20 | obj cx_execute_2Dthunk_2Dclosure; /* execute-thunk-closure */ 21 | obj cx_initialize_2Dmodules; /* initialize-modules */ 22 | obj cx_install_2Dglobal_2Dlambdas; /* install-global-lambdas */ 23 | obj cx_main; /* main */ 24 | obj cx_make_2Dclosure; /* make-closure */ 25 | obj cx_tcode_2Drepl; /* tcode-repl */ 26 | static obj cx__2312; /* constant #12 */ 27 | static obj cx__2316; /* constant #16 */ 28 | 29 | /* gc roots */ 30 | static obj *globv[] = { 31 | &cx__2Acurrent_2Derror_2A, 32 | &cx__2Acurrent_2Dinput_2A, 33 | &cx__2Acurrent_2Doutput_2A, 34 | &cx__2Adynamic_2Dstate_2A, 35 | &cx__2Aglobals_2A, 36 | &cx__2Atransformers_2A, 37 | &cx_callmv_2Dadapter_2Dclosure, 38 | &cx_continuation_2Dadapter_2Dcode, 39 | &cx_decode, 40 | &cx_decode_2Dsexp, 41 | &cx_execute_2Dthunk_2Dclosure, 42 | &cx_initialize_2Dmodules, 43 | &cx_install_2Dglobal_2Dlambdas, 44 | &cx_make_2Dclosure, 45 | &cx__2312, 46 | &cx__2316, 47 | }; 48 | 49 | static cxroot_t root = { 50 | sizeof(globv)/sizeof(obj *), globv, NULL 51 | }; 52 | 53 | /* entry points */ 54 | static obj host(obj); 55 | static obj cases[10] = { 56 | (obj)host, (obj)host, (obj)host, (obj)host, (obj)host, 57 | (obj)host, (obj)host, (obj)host, (obj)host, (obj)host, 58 | }; 59 | 60 | /* host procedure */ 61 | #define MAX_HOSTREGS 16 62 | static obj host(obj pc) 63 | { 64 | register obj *r = cxg_regs; 65 | register obj *hp = cxg_hp; 66 | register int rc = cxg_rc; 67 | rreserve(MAX_HOSTREGS); 68 | jump: 69 | switch (case_from_obj(pc)) { 70 | 71 | case 0: /* load module */ 72 | cx__2312 = (hpushstr(0, newstring("K5"))); 73 | { static char s[] = { 36, 123, 64, 40, 121, 52, 58, 114, 101, 112, 108, 41, 91, 48, 48, 125, 0 }; 74 | cx__2316 = (hpushstr(0, newstring(s))); } 75 | { /* make-vector */ 76 | obj o; int i = 0, c = (+991); 77 | hreserve(hbsz(c+1), 0); /* 0 live regs */ 78 | o = (mknull()); /* gc-safe */ 79 | while (i++ < c) *--hp = o; 80 | *--hp = obj_from_size(VECTOR_BTAG); 81 | cx__2Aglobals_2A = (hendblk(c+1)); } 82 | { /* cons */ 83 | hreserve(hbsz(3), 0); /* 0 live regs */ 84 | *--hp = (mknull()); 85 | *--hp = obj_from_bool(0); 86 | *--hp = obj_from_size(PAIR_BTAG); 87 | cx__2Adynamic_2Dstate_2A = (hendblk(3)); } 88 | cx__2Acurrent_2Dinput_2A = obj_from_bool(0); 89 | cx__2Acurrent_2Doutput_2A = obj_from_bool(0); 90 | cx__2Acurrent_2Derror_2A = obj_from_bool(0); 91 | { /* define execute-thunk-closure */ 92 | static obj c[] = { obj_from_objptr(vmcases+0) }; 93 | cx_execute_2Dthunk_2Dclosure = obj_from_objptr(c); } 94 | { /* define make-closure */ 95 | static obj c[] = { obj_from_objptr(vmcases+1) }; 96 | cx_make_2Dclosure = obj_from_objptr(c); } 97 | { /* define decode-sexp */ 98 | static obj c[] = { obj_from_objptr(vmcases+2) }; 99 | cx_decode_2Dsexp = obj_from_objptr(c); } 100 | { /* define decode */ 101 | static obj c[] = { obj_from_objptr(vmcases+3) }; 102 | cx_decode = obj_from_objptr(c); } 103 | cx__2Atransformers_2A = (mknull()); 104 | cx_continuation_2Dadapter_2Dcode = obj_from_bool(0); 105 | { /* define decode */ 106 | static obj c[] = { obj_from_objptr(vmcases+3) }; 107 | r[0] = obj_from_objptr(c); } 108 | hreserve(hbsz(0+1), 1); /* 1 live regs */ 109 | *--hp = obj_from_case(1); 110 | r[1] = (hendblk(0+1)); 111 | r[2+0] = r[0]; 112 | pc = objptr_from_obj(r[2+0])[0]; 113 | r[2+1] = r[1]; 114 | r[2+2] = (cx__2312); 115 | r += 2; /* shift reg wnd */ 116 | rreserve(MAX_HOSTREGS); 117 | rc = 3; 118 | goto jump; 119 | 120 | case 1: /* clo ek r */ 121 | assert(rc == 3); 122 | r += 1; /* shift reg. wnd */ 123 | /* ek r */ 124 | { /* define make-closure */ 125 | static obj c[] = { obj_from_objptr(vmcases+1) }; 126 | r[2] = obj_from_objptr(c); } 127 | hreserve(hbsz(0+1), 3); /* 3 live regs */ 128 | *--hp = obj_from_case(2); 129 | r[3] = (hendblk(0+1)); 130 | r[4+0] = r[2]; 131 | pc = objptr_from_obj(r[4+0])[0]; 132 | r[4+1] = r[3]; 133 | r[4+2] = r[1]; 134 | r += 4; /* shift reg wnd */ 135 | rreserve(MAX_HOSTREGS); 136 | rc = 3; 137 | goto jump; 138 | 139 | case 2: /* clo ek r */ 140 | assert(rc == 3); 141 | r += 1; /* shift reg. wnd */ 142 | /* ek r */ 143 | cx_callmv_2Dadapter_2Dclosure = r[1]; 144 | { /* define install-global-lambdas */ 145 | static obj c[] = { obj_from_objptr(vmcases+6) }; 146 | cx_install_2Dglobal_2Dlambdas = obj_from_objptr(c); } 147 | { /* define install-global-lambdas */ 148 | static obj c[] = { obj_from_objptr(vmcases+6) }; 149 | r[2] = obj_from_objptr(c); } 150 | hreserve(hbsz(0+1), 3); /* 3 live regs */ 151 | *--hp = obj_from_case(3); 152 | r[3] = (hendblk(0+1)); 153 | r[0] = r[2]; 154 | pc = objptr_from_obj(r[0])[0]; 155 | r[1] = r[3]; 156 | rreserve(MAX_HOSTREGS); 157 | rc = 2; 158 | goto jump; 159 | 160 | case 3: /* clo ek . */ 161 | assert(rc >= 2); 162 | r[2] = obj_from_void(0); /* ignored */ 163 | r += 1; /* shift reg. wnd */ 164 | /* ek . */ 165 | { /* define initialize-modules */ 166 | static obj c[] = { obj_from_objptr(vmcases+7) }; 167 | cx_initialize_2Dmodules = obj_from_objptr(c); } 168 | { /* define initialize-modules */ 169 | static obj c[] = { obj_from_objptr(vmcases+7) }; 170 | r[2] = obj_from_objptr(c); } 171 | hreserve(hbsz(0+1), 3); /* 3 live regs */ 172 | *--hp = obj_from_case(4); 173 | r[3] = (hendblk(0+1)); 174 | r[0] = r[2]; 175 | pc = objptr_from_obj(r[0])[0]; 176 | r[1] = r[3]; 177 | rreserve(MAX_HOSTREGS); 178 | rc = 2; 179 | goto jump; 180 | 181 | case 4: /* clo ek . */ 182 | assert(rc >= 2); 183 | r[2] = obj_from_void(0); /* ignored */ 184 | r += 1; /* shift reg. wnd */ 185 | /* ek . */ 186 | { static obj c[] = { obj_from_case(5) }; cx_tcode_2Drepl = (obj)c; } 187 | { static obj c[] = { obj_from_case(8) }; cx_main = (obj)c; } 188 | r[2] = obj_from_void(0); 189 | r[3+0] = r[0]; 190 | pc = 0; /* exit from module init */ 191 | r[3+1] = r[2]; 192 | r += 3; /* shift reg wnd */ 193 | rc = 2; 194 | goto jump; 195 | 196 | case 5: /* tcode-repl k */ 197 | assert(rc == 2); 198 | r += 1; /* shift reg. wnd */ 199 | gs_tcode_2Drepl: /* k */ 200 | { /* define decode */ 201 | static obj c[] = { obj_from_objptr(vmcases+3) }; 202 | r[1] = obj_from_objptr(c); } 203 | hreserve(hbsz(1+1), 2); /* 2 live regs */ 204 | *--hp = r[0]; 205 | *--hp = obj_from_case(6); 206 | r[2] = (hendblk(1+1)); 207 | r[3+0] = r[1]; 208 | pc = objptr_from_obj(r[3+0])[0]; 209 | r[3+1] = r[2]; 210 | r[3+2] = (cx__2316); 211 | r += 3; /* shift reg wnd */ 212 | rreserve(MAX_HOSTREGS); 213 | rc = 3; 214 | goto jump; 215 | 216 | case 6: /* clo ek r */ 217 | assert(rc == 3); 218 | { obj* p = objptr_from_obj(r[0]); 219 | r[1+2] = p[1]; } 220 | r += 1; /* shift reg. wnd */ 221 | /* ek r k */ 222 | { /* define make-closure */ 223 | static obj c[] = { obj_from_objptr(vmcases+1) }; 224 | r[3] = obj_from_objptr(c); } 225 | hreserve(hbsz(1+1), 4); /* 4 live regs */ 226 | *--hp = r[2]; 227 | *--hp = obj_from_case(7); 228 | r[4] = (hendblk(1+1)); 229 | r[5+0] = r[3]; 230 | pc = objptr_from_obj(r[5+0])[0]; 231 | r[5+1] = r[4]; 232 | r[5+2] = r[1]; 233 | r += 5; /* shift reg wnd */ 234 | rreserve(MAX_HOSTREGS); 235 | rc = 3; 236 | goto jump; 237 | 238 | case 7: /* clo ek r */ 239 | assert(rc == 3); 240 | { obj* p = objptr_from_obj(r[0]); 241 | r[1+2] = p[1]; } 242 | r += 1; /* shift reg. wnd */ 243 | /* ek r k */ 244 | { /* define execute-thunk-closure */ 245 | static obj c[] = { obj_from_objptr(vmcases+0) }; 246 | r[3] = obj_from_objptr(c); } 247 | r[4+0] = r[3]; 248 | pc = objptr_from_obj(r[4+0])[0]; 249 | r[4+1] = r[2]; 250 | r[4+2] = r[1]; 251 | r += 4; /* shift reg wnd */ 252 | rreserve(MAX_HOSTREGS); 253 | rc = 3; 254 | goto jump; 255 | 256 | case 8: /* main k argv */ 257 | assert(rc == 3); 258 | r += 1; /* shift reg. wnd */ 259 | gs_main: /* k argv */ 260 | hreserve(hbsz(1+1), 2); /* 2 live regs */ 261 | *--hp = r[0]; 262 | *--hp = obj_from_case(9); 263 | r[2] = (hendblk(1+1)); 264 | r[0] = r[2]; 265 | goto gs_tcode_2Drepl; 266 | 267 | case 9: /* clo ek r */ 268 | assert(rc == 3); 269 | { obj* p = objptr_from_obj(r[0]); 270 | r[1+2] = p[1]; } 271 | r += 1; /* shift reg. wnd */ 272 | /* ek r k */ 273 | if (((r[1]) == obj_from_bool(1))) { 274 | r[0] = r[2]; 275 | pc = objptr_from_obj(r[0])[0]; 276 | r[1] = obj_from_ktrap(); 277 | r[2] = obj_from_bool(0); 278 | rreserve(MAX_HOSTREGS); 279 | rc = 3; 280 | goto jump; 281 | } else { 282 | r[0] = r[2]; 283 | r[1] = obj_from_bool(0); 284 | goto gs_main; 285 | } 286 | 287 | default: /* inter-host call */ 288 | cxg_hp = hp; 289 | cxm_rgc(r, MAX_HOSTREGS); 290 | cxg_rc = rc; 291 | return pc; 292 | } 293 | } 294 | 295 | /* module load */ 296 | void MODULE(void) 297 | { 298 | obj pc; 299 | if (!root.next) { 300 | root.next = cxg_rootp; 301 | cxg_rootp = &root; 302 | LOAD(); 303 | pc = obj_from_case(0); 304 | cxg_rc = 0; 305 | while (pc) pc = (*(cxhost_t*)pc)(pc); 306 | assert(cxg_rc == 2); 307 | } 308 | } 309 | 310 | /* basic runtime */ 311 | #define HEAP_SIZE 131072 /* 2^17 */ 312 | #define REGS_SIZE 4092 313 | 314 | obj *cxg_heap = NULL; 315 | cxoint_t cxg_hmask = 0; 316 | obj *cxg_hp = NULL; 317 | static cxroot_t cxg_root = { 0, NULL, NULL }; 318 | cxroot_t *cxg_rootp = &cxg_root; 319 | obj *cxg_regs = NULL, *cxg_rend = NULL; 320 | int cxg_rc = 0; 321 | char **cxg_argv = NULL; 322 | 323 | static obj *cxg_heap2 = NULL; 324 | size_t cxg_hsize = 0; 325 | static cxoint_t cxg_hmask2 = 0; 326 | int cxg_gccount = 0, cxg_bumpcount = 0; 327 | 328 | static obj *toheap2(obj* p, obj *hp, obj *h1, cxoint_t m1, obj *h2, cxoint_t m2) 329 | { 330 | obj o = *p, *op, fo, *fop; 331 | if (((char*)(o) - (char*)h1) & m1) return hp; 332 | fo = (op = objptr_from_obj(o))[-1]; assert(fo); 333 | if (notaptr(fo)) { 334 | fop = op + size_from_obj(fo); while (fop >= op) *--hp = *--fop; 335 | *p = *fop = obj_from_objptr(hp+1); 336 | } else if (((char*)(fo) - (char*)h2) & m2) { 337 | *--hp = *op--; *--hp = *op; 338 | *p = *op = obj_from_objptr(hp+1); 339 | } else *p = fo; 340 | return hp; 341 | } 342 | 343 | static void finalize(obj *hp1, obj *he1, obj *h2, cxoint_t m2) 344 | { 345 | while (hp1 < he1) { 346 | obj fo = *hp1++; assert(fo); 347 | if (notaptr(fo)) hp1 += size_from_obj(fo); 348 | else if (((char*)(fo) - (char*)h2) & m2) ((cxtype_t*)fo)->free((void*)*hp1++); 349 | else if (notaptr(fo = objptr_from_obj(fo)[-1])) hp1 += size_from_obj(fo); 350 | else ++hp1; 351 | } assert(hp1 == he1); 352 | } 353 | 354 | static obj *relocate(cxroot_t *pr, obj *regs, obj *regp, 355 | obj *he2, obj *he1, obj *hp, obj *h1, cxoint_t m1, obj *h2, cxoint_t m2) 356 | { 357 | obj *p, *hp1 = hp; hp = he2; 358 | for (p = regs; p < regp; ++p) hp = toheap2(p, hp, h1, m1, h2, m2); 359 | for (; pr; pr = pr->next) { 360 | obj **pp = pr->globv; int c = pr->globc; 361 | while (c-- > 0) hp = toheap2(*pp++, hp, h1, m1, h2, m2); 362 | } 363 | for (p = he2; p > hp; --p) hp = toheap2(p-1, hp, h1, m1, h2, m2); 364 | if (he1) finalize(hp1, he1, h2, m2); 365 | return hp; 366 | } 367 | 368 | obj *cxm_hgc(obj *regs, obj *regp, obj *hp, size_t needs) 369 | { 370 | obj *h1 = cxg_heap, *h2 = cxg_heap2; cxoint_t m1 = cxg_hmask, m2 = cxg_hmask2; 371 | size_t hs = cxg_hsize; cxroot_t *pr = cxg_rootp; 372 | 373 | obj *h = h1, *he1 = h1 + hs, *he2 = h2 + hs; 374 | ++cxg_gccount; 375 | if (h1) hp = relocate(pr, regs, regp, he2, he1, hp, h1, m1, h2, m2), 376 | needs += (h2 + hs - hp)*2; /* make heap half empty */ 377 | else hp = h2 + hs; 378 | if (hs < needs) { 379 | size_t s = HEAP_SIZE; while (s < needs) s *= 2; 380 | m2 = 1 | ~(s*sizeof(obj)-1); 381 | if (!(h = realloc(h1, s*sizeof(obj)))) { perror("alloc[h]"); exit(2); } 382 | h1 = h2; h2 = h; he2 = h2 + s; he1 = 0; /* no finalize flag */ 383 | if (h1) hp = relocate(pr, regs, regp, he2, he1, hp, h1, m1, h2, m2); 384 | else hp = h2 + s; 385 | if (!(h = realloc(h1, s*sizeof(obj)))) { perror("alloc[h]"); exit(2); } 386 | hs = s; m1 = m2; ++cxg_bumpcount; 387 | } 388 | h1 = h2; h2 = h; 389 | 390 | cxg_heap = h1; cxg_hmask = m1; cxg_heap2 = h2; cxg_hmask2 = m2; 391 | cxg_hsize = hs; return cxg_hp = hp; 392 | } 393 | 394 | obj *cxm_rgc(obj *regs, size_t needs) 395 | { 396 | obj *p = cxg_regs; assert(needs > 0); 397 | if (!p || cxg_rend < p + needs) { 398 | size_t roff = regs ? regs - p : 0; 399 | if (!(p = realloc(p, needs*sizeof(obj)))) { perror("alloc[r]"); exit(2); } 400 | cxg_regs = p; cxg_rend = p + needs; 401 | regs = p + roff; 402 | } 403 | if (regs && regs > p) while (needs--) *p++ = *regs++; 404 | return cxg_regs; 405 | } 406 | 407 | void cxm_check(int x, char *msg) 408 | { 409 | if (!x) { 410 | perror(msg); exit(2); 411 | } 412 | } 413 | 414 | void *cxm_cknull(void *p, char *msg) 415 | { 416 | cxm_check(p != NULL, msg); 417 | return p; 418 | } 419 | 420 | /* os entry point */ 421 | int main(int argc, char **argv) { 422 | int res; obj pc; 423 | obj retcl[1] = { 0 }; 424 | cxm_rgc(NULL, REGS_SIZE); 425 | cxg_argv = argv; 426 | MODULE(); 427 | cxg_regs[0] = cx_main; 428 | cxg_regs[1] = (obj)retcl; 429 | cxg_regs[2] = (obj)argv; 430 | cxg_rc = 3; 431 | pc = objptr_from_obj(cx_main)[0]; 432 | while (pc) pc = (*(cxhost_t*)pc)(pc); 433 | assert(cxg_rc == 3); 434 | res = (cxg_regs[2] != 0); 435 | return res; 436 | } 437 | -------------------------------------------------------------------------------- /misc/Skint-postlude.scm: -------------------------------------------------------------------------------- 1 | (define (this-scheme-implementation-name) 2 | (string-append "skint-" (implementation-version))) 3 | -------------------------------------------------------------------------------- /misc/Skint-prelude.scm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/false-schemers/skint/bff49d54b9a2d21832979ab65e0005388b9c1dc7/misc/Skint-prelude.scm -------------------------------------------------------------------------------- /misc/skint-12x12.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/false-schemers/skint/bff49d54b9a2d21832979ab65e0005388b9c1dc7/misc/skint-12x12.png -------------------------------------------------------------------------------- /misc/skint-252x100.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/false-schemers/skint/bff49d54b9a2d21832979ab65e0005388b9c1dc7/misc/skint-252x100.png -------------------------------------------------------------------------------- /misc/skint-298x128.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/false-schemers/skint/bff49d54b9a2d21832979ab65e0005388b9c1dc7/misc/skint-298x128.png -------------------------------------------------------------------------------- /misc/skint-896x384.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/false-schemers/skint/bff49d54b9a2d21832979ab65e0005388b9c1dc7/misc/skint-896x384.png -------------------------------------------------------------------------------- /misc/syntax-rules.md: -------------------------------------------------------------------------------- 1 | # Syntax-rules extensions 2 | 3 | SKINT implements all standard features of R7RS `syntax-rules`, including custom ellipsis, non-final ellipsis patterns, non-binding underscore pattern, and `(... tpl)` template escapes. It also supports the following extensions: 4 | 5 | ## Support for boxes 6 | 7 | Boxes, as defined by SRFI-111 and the future `(scheme box)` library, are supported natively, and can be parts of both patterns and templates. See examples of their use below. 8 | 9 | ## Simple pattern escape 10 | 11 | A pattern of the form `( )` where `` is the current ellipsis is interpreted as if it were ``, but ellipses and underscores in `` lose their special meaning; e.g.: 12 | 13 | ```scheme 14 | (define-syntax underscored 15 | (syntax-rules () 16 | [(_ (... _) (... ...)) (list (... ...) (... _))])) 17 | 18 | (underscored 1 2) 19 | ; => (2 1) 20 | ``` 21 | Note that R7RS prescribes special treatment of the keyword identifier at the beginning of the pattern in a ``: it is matched automatically with the head of the use form, but is not considered a pattern variable, so can't be substituted. SKINT's pattern escape extension drops this positional restriction and matches its sub-pattern in a normal way; e.g.: 22 | 23 | ```scheme 24 | ; in R7RS, x is not a pattern variable here due to its head position: 25 | (let-syntax ([ttt (syntax-rules () [(x y) '(x y)])]) (ttt 123)) 26 | ; => (x 123) 27 | 28 | ; x is a pattern variable here, even though it is in the head position: 29 | (let-syntax ([ttt (syntax-rules () [((... x) y) '(x y)])]) (ttt 123)) 30 | ; => (ttt 123) 31 | 32 | ; same thing, but with pattern template escaped via template escape to work properly: 33 | ((syntax-rules () ; NB: anonymous transformer positioned at the head of the use form 34 | [(_) (let-syntax ([ttt (syntax-rules () [(((... ...) x) y) '(x y)])]) (ttt 123))])) 35 | ; => (ttt 123) 36 | ``` 37 | 38 | The importance of this feature will be clear when we get to circumventing hygiene below. 39 | 40 | ## Named pattern escapes 41 | 42 | A pattern of the form `( )`, where `` is the current ellipsis, is interpreted as if it were `` as long as the matching S-expression satisfies the constraint specified by ``. The matching fails if the predicate returns `#f`. Predicate names are compared to predefined symbols according to `free-identifier=?` rules. The following named pattern escapes are supported: 43 | 44 | * `(... number? )` 45 | * `(... exact-integer? )` 46 | * `(... boolean? )` 47 | * `(... char? )` 48 | * `(... string? )` 49 | * `(... bytevector? )` 50 | * `(... id? )` 51 | 52 | All but the last predicate have the same meaning as the corresponding Scheme procedures. The `id?` predicate checks if the corresponding S-expression is either a symbol or a syntax object representing an identifier. 53 | 54 | The rationale for adding these escapes is obvious: while `syntax-rules`-based macros can perform very complex calculations with structured S-expressions, they lack an ability to deal with *atomic* S-expressions (with the exception of identifiers – they can be recognized, but the technique for that is quite complicated). 55 | 56 | Example (also uses box templates): 57 | 58 | ```scheme 59 | (define-syntax wrap-by-type 60 | (syntax-rules () 61 | [(_ (... string? x)) '#&x] 62 | [(_ (... number? x)) '#(x)] 63 | [(_ x) 'x])) 64 | 65 | (list (wrap-by-type 42) (wrap-by-type "yes") (wrap-by-type #\c)) 66 | ; => (#(42) #&"yes" #\c) 67 | ``` 68 | 69 | ## Named template escapes 70 | 71 | A template of the form `( )` where `` is the current ellipsis is interpreted as follows: First, `` (which can be any nonempty sequence of `