artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Split-out builtins.c.

Browse source 
* src/mes.c make_builtin_type, make_builtin, builtin_name,
builtin_arity, builtin_function, builtin_p, builtin_printer,
init_builtin, mes_builtins): Move to ..
* src/builtins.c: New file.
* build-aux/configure-lib.sh (mes_SOURCES): Add it.
* build-aux/snarf.sh: Likewise.
* build-aux/build-mes.sh (mes_sources): Remove.  Include
configure-lib.sh
* include/mes/builtins.h: Remove constants.
* include/mes/mes.h: Add prototypes.
* include/mes/constants.h (cell_symbol_test): Rename from cell_test.
* simple.make: New file.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-04-19 10:49:48 +02:00
parent 3470e47561
commit 94143959af
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
10 changed files with 339 additions and 548 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
.gitignore vendored
View file

@ -33,7 +33,18 @@
*.mini-hex2 *.mini-hex2
*.a *.a
*.o *.o
*.h.m2
*.c.m2
*.seed-out *.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/*/[0-9a][0-9a-z]-*
!/lib/tests/*/*.c !/lib/tests/*/*.c
@ -56,7 +67,6 @@
/.store /.store
/.tarball-version /.tarball-version
/out
? ?
?.mes ?.mes
\#*# \#*#

17
build-aux/build-mes.sh
View file

@ -30,24 +30,11 @@ fi
. ./config.sh . ./config.sh
. ${srcdest}build-aux/trace.sh . ${srcdest}build-aux/trace.sh
. ${srcdest}build-aux/cc.sh . ${srcdest}build-aux/cc.sh
. ${srcdest}build-aux/configure-lib.sh
trap 'test -f .log && cat .log' EXIT trap 'test -f .log && cat .log' EXIT
mes_sources=" for c in $mes_SOURCES; do
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
compile $c compile $c
done done
if test $mes_libc = system; then if test $mes_libc = system; then

1
build-aux/configure-lib.sh
View file

@ -429,6 +429,7 @@ lib/linux/symlink.c
fi fi
mes_SOURCES=" mes_SOURCES="
src/builtins.c
src/gc.c src/gc.c
src/hash.c src/hash.c
src/lib.c src/lib.c

1
build-aux/snarf.sh
View file

@ -23,6 +23,7 @@ set -e
. ${srcdest}build-aux/config.sh . ${srcdest}build-aux/config.sh
. ${srcdest}build-aux/trace.sh . ${srcdest}build-aux/trace.sh
trace "SNARF$snarf builtins.c" ${srcdest}build-aux/mes-snarf.scm src/builtins.c
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.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 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 lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c

268
include/mes/builtins.h
View file

@ -21,10 +21,15 @@
#ifndef __MES_BUILTINS_H #ifndef __MES_BUILTINS_H
#define __MES_BUILTINS_H #define __MES_BUILTINS_H
// src/gc.mes /* src/builtins.mes */
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);
/* src/gc.mes */
SCM gc_check (); SCM gc_check ();
SCM gc (); SCM gc ();
// src/hash.mes /* src/hash.mes */
SCM hashq (SCM x, SCM size); SCM hashq (SCM x, SCM size);
SCM hash (SCM x, SCM size); SCM hash (SCM x, SCM size);
SCM hashq_get_handle (SCM table, SCM key, SCM dflt); SCM hashq_get_handle (SCM table, SCM key, SCM dflt);
@ -34,7 +39,7 @@ SCM hashq_set_x (SCM table, SCM key, SCM value);
SCM hash_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 hash_table_printer (SCM table);
SCM make_hash_table (SCM x); SCM make_hash_table (SCM x);
// src/lib.mes /* src/lib.mes */
SCM procedure_name_ (SCM x); SCM procedure_name_ (SCM x);
SCM display_ (SCM x); SCM display_ (SCM x);
SCM display_error_ (SCM x); SCM display_error_ (SCM x);
@ -52,7 +57,7 @@ SCM memq (SCM x, SCM a);
SCM equal2_p (SCM a, SCM b); SCM equal2_p (SCM a, SCM b);
SCM last_pair (SCM x); SCM last_pair (SCM x);
SCM pair_p (SCM x); SCM pair_p (SCM x);
// src/math.mes /* src/math.mes */
SCM greater_p (SCM x); SCM greater_p (SCM x);
SCM less_p (SCM x); SCM less_p (SCM x);
SCM is_p (SCM x); SCM is_p (SCM x);
@ -66,7 +71,7 @@ SCM logior (SCM x);
SCM lognot (SCM x); SCM lognot (SCM x);
SCM logxor (SCM x); SCM logxor (SCM x);
SCM ash (SCM n, SCM count); SCM ash (SCM n, SCM count);
// src/mes.mes /* src/mes.mes */
SCM make_cell_ (SCM type, SCM car, SCM cdr); SCM make_cell_ (SCM type, SCM car, SCM cdr);
SCM type_ (SCM x); SCM type_ (SCM x);
SCM car_ (SCM x); SCM car_ (SCM x);
@ -95,254 +100,13 @@ SCM set_env_x (SCM x, SCM e, SCM a);
SCM macro_get_handle (SCM name); SCM macro_get_handle (SCM name);
SCM add_formals (SCM formals, SCM x); SCM add_formals (SCM formals, SCM x);
SCM eval_apply (); SCM eval_apply ();
SCM make_builtin_type (); /* src/module.mes */
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 make_module_type ();
SCM module_printer (SCM module); SCM module_printer (SCM module);
SCM module_variable (SCM module, SCM name); SCM module_variable (SCM module, SCM name);
SCM module_ref (SCM module, SCM name); SCM module_ref (SCM module, SCM name);
SCM module_define_x (SCM module, SCM name, SCM value); SCM module_define_x (SCM module, SCM name, SCM value);
// src/posix.mes /* src/posix.mes */
SCM peek_byte (); SCM peek_byte ();
SCM read_byte (); SCM read_byte ();
SCM unread_byte (SCM i); SCM unread_byte (SCM i);
@ -376,7 +140,7 @@ SCM getcwd_ ();
SCM dup_ (SCM port); SCM dup_ (SCM port);
SCM dup2_ (SCM old, SCM new); SCM dup2_ (SCM old, SCM new);
SCM delete_file (SCM file_name); SCM delete_file (SCM file_name);
// src/reader.mes /* src/reader.mes */
SCM read_input_file_env_ (SCM e, SCM a); SCM read_input_file_env_ (SCM e, SCM a);
SCM read_input_file_env (SCM a); SCM read_input_file_env (SCM a);
SCM read_env (SCM a); SCM read_env (SCM a);
@ -386,7 +150,7 @@ SCM reader_read_binary ();
SCM reader_read_octal (); SCM reader_read_octal ();
SCM reader_read_hex (); SCM reader_read_hex ();
SCM reader_read_string (); SCM reader_read_string ();
// src/strings.mes /* src/strings.mes */
SCM string_equal_p (SCM a, SCM b); SCM string_equal_p (SCM a, SCM b);
SCM symbol_to_string (SCM symbol); SCM symbol_to_string (SCM symbol);
SCM symbol_to_keyword (SCM symbol); SCM symbol_to_keyword (SCM symbol);
@ -399,12 +163,12 @@ SCM read_string (SCM port);
SCM string_append (SCM x); SCM string_append (SCM x);
SCM string_length (SCM string); SCM string_length (SCM string);
SCM string_ref (SCM str, SCM k); SCM string_ref (SCM str, SCM k);
// src/struct.mes /* src/struct.mes */
SCM make_struct (SCM type, SCM fields, SCM printer); SCM make_struct (SCM type, SCM fields, SCM printer);
SCM struct_length (SCM x); SCM struct_length (SCM x);
SCM struct_ref (SCM x, SCM i); SCM struct_ref (SCM x, SCM i);
SCM struct_set_x (SCM x, SCM i, SCM e); SCM struct_set_x (SCM x, SCM i, SCM e);
// src/vector.mes /* src/vector.mes */
SCM make_vector_ (SCM n); SCM make_vector_ (SCM n);
SCM vector_length (SCM x); SCM vector_length (SCM x);
SCM vector_ref (SCM x, SCM i); SCM vector_ref (SCM x, SCM i);

4
include/mes/constants.h
View file

@ -269,8 +269,8 @@
// CONSTANT cell_type_broken_heart 117 // CONSTANT cell_type_broken_heart 117
#define cell_type_broken_heart 117 #define cell_type_broken_heart 117
// CONSTANT cell_test 118 // CONSTANT cell_symbol_test 118
#define cell_test 118 #define cell_symbol_test 118
/* Cell types */ /* Cell types */

25
include/mes/mes.h
View file

@ -32,6 +32,20 @@ struct scm
SCM cdr; SCM cdr;
}; };
#if __MESC__
typedef long function0_t;
typedef long function1_t;
typedef long function2_t;
typedef long function3_t;
typedef long functionn_t;
#else // !__MESC__
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__
// mes // mes
extern int g_debug; extern int g_debug;
extern char *g_buf; extern char *g_buf;
@ -70,15 +84,21 @@ extern struct scm *g_news;
SCM alloc (long n); SCM alloc (long n);
SCM apply (SCM f, SCM x, SCM a); SCM apply (SCM f, SCM x, SCM a);
SCM apply_builtin (SCM fn, SCM x); SCM apply_builtin (SCM fn, SCM x);
SCM builtin_name (SCM builtin);
#if __MESC__
long builtin_function (SCM builtin);
#else
SCM (*builtin_function (SCM builtin)) (SCM);
#endif
SCM cstring_to_list (char const *s); SCM cstring_to_list (char const *s);
SCM cstring_to_symbol (char const *s); SCM cstring_to_symbol (char const *s);
SCM display_ (SCM x);
SCM fdisplay_ (SCM, int, int); SCM fdisplay_ (SCM, int, int);
SCM gc_init (); SCM gc_init ();
SCM gc_peek_frame (); SCM gc_peek_frame ();
SCM gc_pop_frame (); SCM gc_pop_frame ();
SCM gc_push_frame (); SCM gc_push_frame ();
SCM init_time (SCM a); SCM init_time (SCM a);
SCM make_builtin_type ();
SCM make_bytes (char const *s, size_t length); SCM make_bytes (char const *s, size_t length);
SCM make_cell__ (long type, SCM car, SCM cdr); SCM make_cell__ (long type, SCM car, SCM cdr);
SCM make_hash_table_ (long size); SCM make_hash_table_ (long size);
@ -86,8 +106,7 @@ SCM make_hashq_type ();
SCM make_initial_module (SCM a); SCM make_initial_module (SCM a);
SCM make_string (char const *s, size_t length); SCM make_string (char const *s, size_t length);
SCM make_vector__ (long k); SCM make_vector__ (long k);
SCM read_input_file_env (SCM); SCM mes_builtins (SCM a);
SCM string_equal_p (SCM a, SCM b);
SCM struct_ref_ (SCM x, long i); SCM struct_ref_ (SCM x, long i);
SCM struct_set_x_ (SCM x, long i, SCM e); SCM struct_set_x_ (SCM x, long i, SCM e);
SCM vector_ref_ (SCM x, long i); SCM vector_ref_ (SCM x, long i);

1
simple.make
View file

@ -46,6 +46,7 @@ CFLAGS:= \
-Wno-int-conversion -Wno-int-conversion
MES_SOURCES = \ MES_SOURCES = \
src/builtins.c \
src/gc.c \ src/gc.c \
src/hash.c \ src/hash.c \
src/lib.c \ src/lib.c \

272
src/builtins.c Normal file
View file

@ -0,0 +1,272 @@
/* -*-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 "mes/mes.h"
SCM
make_builtin_type () ///(internal))
{
SCM record_type = cell_symbol_record_type;
SCM fields = cell_nil;
fields = cons (cstring_to_symbol ("address"), fields);
fields = cons (cstring_to_symbol ("arity"), fields);
fields = cons (cstring_to_symbol ("name"), fields);
fields = cons (fields, cell_nil);
fields = cons (cell_symbol_builtin, fields);
return make_struct (record_type, fields, cell_unspecified);
}
SCM
make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function)
{
SCM values = cell_nil;
values = cons (function, values);
values = cons (arity, values);
values = cons (name, values);
values = cons (cell_symbol_builtin, values);
return make_struct (builtin_type, values, cstring_to_symbol ("builtin-printer"));
}
SCM
builtin_name (SCM builtin)
{
return struct_ref_ (builtin, 3);
}
SCM
builtin_arity (SCM builtin)
{
return struct_ref_ (builtin, 4);
}
#if __MESC__
long
builtin_function (SCM builtin)
{
return VALUE (struct_ref_ (builtin, 5));
}
#else
SCM (*builtin_function (SCM builtin)) (SCM)
{
return (function1_t) VALUE (struct_ref_ (builtin, 5));
}
#endif
SCM
builtin_p (SCM x)
{
return (TYPE (x) == TSTRUCT && struct_ref_ (x, 2) == cell_symbol_builtin) ? cell_t : cell_f;
}
SCM
builtin_printer (SCM builtin)
{
fdputs ("#<procedure ", __stdout);
display_ (builtin_name (builtin));
fdputc (' ', __stdout);
int arity = VALUE (builtin_arity (builtin));
if (arity == -1)
fdputc ('_', __stdout);
else
{
fdputc ('(', __stdout);
for (int i = 0; i < arity; i++)
{
if (i)
fdputc (' ', __stdout);
fdputc ('_', __stdout);
}
}
fdputc ('>', __stdout);
}
SCM
init_builtin (SCM builtin_type, char const *name, int arity, SCM (*function) (SCM), SCM a)
{
SCM s = cstring_to_symbol (name);
return acons (s,
make_builtin (builtin_type, symbol_to_string (s), MAKE_NUMBER (arity),
MAKE_NUMBER (function)), a);
}
SCM
mes_builtins (SCM a) ///((internal))
{
// TODO minimal: cons, car, cdr, list, null_p, eq_p minus, plus
// display_, display_error_, getenv
SCM builtin_type = make_builtin_type ();
/* src/builtins.c */
a = init_builtin (builtin_type, "make-builtin-type", 0, (function1_t) & make_builtin_type, a);
a = init_builtin (builtin_type, "make-builtin", 4, (function1_t) & make_builtin, a);
a = init_builtin (builtin_type, "builtin-name", 1, (function1_t) & builtin_name, a);
a = init_builtin (builtin_type, "builtin-arity", 1, (function1_t) & builtin_arity, a);
a = init_builtin (builtin_type, "builtin?", 1, (function1_t) & builtin_p, a);
a = init_builtin (builtin_type, "builtin-printer", 1, (function1_t) & builtin_printer, a);
/* src/gc.c */
a = init_builtin (builtin_type, "gc-check", 0, (function1_t) & gc_check, a);
a = init_builtin (builtin_type, "gc", 0, (function1_t) & gc, a);
/* src/hash.c */
a = init_builtin (builtin_type, "hashq", 2, (function1_t) & hashq, a);
a = init_builtin (builtin_type, "hash", 2, (function1_t) & hash, a);
a = init_builtin (builtin_type, "hashq-get-handle", 3, (function1_t) & hashq_get_handle, a);
a = init_builtin (builtin_type, "hashq-ref", 3, (function1_t) & hashq_ref, a);
a = init_builtin (builtin_type, "hash-ref", 3, (function1_t) & hash_ref, a);
a = init_builtin (builtin_type, "hashq-set!", 3, (function1_t) & hashq_set_x, a);
a = init_builtin (builtin_type, "hash-set!", 3, (function1_t) & hash_set_x, a);
a = init_builtin (builtin_type, "hash-table-printer", 1, (function1_t) & hash_table_printer, a);
a = init_builtin (builtin_type, "make-hash-table", 1, (function1_t) & make_hash_table, a);
/* src/lib.c */
a = init_builtin (builtin_type, "core:display", 1, (function1_t) & display_, a);
a = init_builtin (builtin_type, "core:display-error", 1, (function1_t) & display_error_, a);
a = init_builtin (builtin_type, "core:display-port", 2, (function1_t) & display_port_, a);
a = init_builtin (builtin_type, "core:write", 1, (function1_t) & write_, a);
a = init_builtin (builtin_type, "core:write-error", 1, (function1_t) & write_error_, a);
a = init_builtin (builtin_type, "core:write-port", 2, (function1_t) & write_port_, a);
a = init_builtin (builtin_type, "exit", 1, (function1_t) & exit_, a);
a = init_builtin (builtin_type, "frame-printer", 1, (function1_t) & frame_printer, a);
a = init_builtin (builtin_type, "make-stack", -1, (function1_t) & make_stack, a);
a = init_builtin (builtin_type, "stack-length", 1, (function1_t) & stack_length, a);
a = init_builtin (builtin_type, "stack-ref", 2, (function1_t) & stack_ref, a);
a = init_builtin (builtin_type, "xassq", 2, (function1_t) & xassq, a);
a = init_builtin (builtin_type, "memq", 2, (function1_t) & memq, a);
a = init_builtin (builtin_type, "equal2?", 2, (function1_t) & equal2_p, a);
a = init_builtin (builtin_type, "last-pair", 1, (function1_t) & last_pair, a);
a = init_builtin (builtin_type, "pair?", 1, (function1_t) & pair_p, a);
/* src/math.c */
a = init_builtin (builtin_type, ">", -1, (function1_t) & greater_p, a);
a = init_builtin (builtin_type, "<", -1, (function1_t) & less_p, a);
a = init_builtin (builtin_type, "=", -1, (function1_t) & is_p, a);
a = init_builtin (builtin_type, "-", -1, (function1_t) & minus, a);
a = init_builtin (builtin_type, "+", -1, (function1_t) & plus, a);
a = init_builtin (builtin_type, "/", -1, (function1_t) & divide, a);
a = init_builtin (builtin_type, "modulo", 2, (function1_t) & modulo, a);
a = init_builtin (builtin_type, "*", -1, (function1_t) & multiply, a);
a = init_builtin (builtin_type, "logand", -1, (function1_t) & logand, a);
a = init_builtin (builtin_type, "logior", -1, (function1_t) & logior, a);
a = init_builtin (builtin_type, "lognot", 1, (function1_t) & lognot, a);
a = init_builtin (builtin_type, "logxor", -1, (function1_t) & logxor, a);
a = init_builtin (builtin_type, "ash", 2, (function1_t) & ash, a);
/* src/mes.c */
a = init_builtin (builtin_type, "core:make-cell", 3, (function1_t) & make_cell_, a);
a = init_builtin (builtin_type, "core:type", 1, (function1_t) & type_, a);
a = init_builtin (builtin_type, "core:car", 1, (function1_t) & car_, a);
a = init_builtin (builtin_type, "core:cdr", 1, (function1_t) & cdr_, a);
a = init_builtin (builtin_type, "cons", 2, (function1_t) & cons, a);
a = init_builtin (builtin_type, "car", 1, (function1_t) & car, a);
a = init_builtin (builtin_type, "cdr", 1, (function1_t) & cdr, a);
a = init_builtin (builtin_type, "list", -1, (function1_t) & list, a);
a = init_builtin (builtin_type, "null?", 1, (function1_t) & null_p, a);
a = init_builtin (builtin_type, "eq?", 2, (function1_t) & eq_p, a);
a = init_builtin (builtin_type, "values", -1, (function1_t) & values, a);
a = init_builtin (builtin_type, "acons", 3, (function1_t) & acons, a);
a = init_builtin (builtin_type, "length", 1, (function1_t) & length, a);
a = init_builtin (builtin_type, "error", 2, (function1_t) & error, a);
a = init_builtin (builtin_type, "append2", 2, (function1_t) & append2, a);
a = init_builtin (builtin_type, "append-reverse", 2, (function1_t) & append_reverse, a);
a = init_builtin (builtin_type, "core:reverse!", 2, (function1_t) & reverse_x_, a);
a = init_builtin (builtin_type, "pairlis", 3, (function1_t) & pairlis, a);
a = init_builtin (builtin_type, "assq", 2, (function1_t) & assq, a);
a = init_builtin (builtin_type, "assoc", 2, (function1_t) & assoc, a);
a = init_builtin (builtin_type, "set-car!", 2, (function1_t) & set_car_x, a);
a = init_builtin (builtin_type, "set-cdr!", 2, (function1_t) & set_cdr_x, a);
a = init_builtin (builtin_type, "set-env!", 3, (function1_t) & set_env_x, a);
a = init_builtin (builtin_type, "macro-get-handle", 1, (function1_t) & macro_get_handle, a);
a = init_builtin (builtin_type, "add-formals", 2, (function1_t) & add_formals, a);
a = init_builtin (builtin_type, "eval-apply", 0, (function1_t) & eval_apply, a);
/* src/module.c */
a = init_builtin (builtin_type, "make-module-type", 0, (function1_t) & make_module_type, a);
a = init_builtin (builtin_type, "module-printer", 1, (function1_t) & module_printer, a);
a = init_builtin (builtin_type, "module-variable", 2, (function1_t) & module_variable, a);
a = init_builtin (builtin_type, "module-ref", 2, (function1_t) & module_ref, a);
a = init_builtin (builtin_type, "module-define!", 3, (function1_t) & module_define_x, a);
/* src/posix.c */
a = init_builtin (builtin_type, "peek-byte", 0, (function1_t) & peek_byte, a);
a = init_builtin (builtin_type, "read-byte", 0, (function1_t) & read_byte, a);
a = init_builtin (builtin_type, "unread-byte", 1, (function1_t) & unread_byte, a);
a = init_builtin (builtin_type, "peek-char", 0, (function1_t) & peek_char, a);
a = init_builtin (builtin_type, "read-char", -1, (function1_t) & read_char, a);
a = init_builtin (builtin_type, "unread-char", 1, (function1_t) & unread_char, a);
a = init_builtin (builtin_type, "write-char", -1, (function1_t) & write_char, a);
a = init_builtin (builtin_type, "write-byte", -1, (function1_t) & write_byte, a);
a = init_builtin (builtin_type, "getenv", 1, (function1_t) & getenv_, a);
a = init_builtin (builtin_type, "setenv", 2, (function1_t) & setenv_, a);
a = init_builtin (builtin_type, "access?", 2, (function1_t) & access_p, a);
a = init_builtin (builtin_type, "current-input-port", 0, (function1_t) & current_input_port, a);
a = init_builtin (builtin_type, "open-input-file", 1, (function1_t) & open_input_file, a);
a = init_builtin (builtin_type, "open-input-string", 1, (function1_t) & open_input_string, a);
a = init_builtin (builtin_type, "set-current-input-port", 1, (function1_t) & set_current_input_port, a);
a = init_builtin (builtin_type, "current-output-port", 0, (function1_t) & current_output_port, a);
a = init_builtin (builtin_type, "current-error-port", 0, (function1_t) & current_error_port, a);
a = init_builtin (builtin_type, "open-output-file", -1, (function1_t) & open_output_file, a);
a = init_builtin (builtin_type, "set-current-output-port", 1, (function1_t) & set_current_output_port, a);
a = init_builtin (builtin_type, "set-current-error-port", 1, (function1_t) & set_current_error_port, a);
a = init_builtin (builtin_type, "chmod", 2, (function1_t) & chmod_, a);
a = init_builtin (builtin_type, "isatty?", 1, (function1_t) & isatty_p, a);
a = init_builtin (builtin_type, "primitive-fork", 0, (function1_t) & primitive_fork, a);
a = init_builtin (builtin_type, "execl", 2, (function1_t) & execl_, a);
a = init_builtin (builtin_type, "core:waitpid", 2, (function1_t) & waitpid_, a);
a = init_builtin (builtin_type, "current-time", 0, (function1_t) & current_time, a);
a = init_builtin (builtin_type, "gettimeofday", 0, (function1_t) & gettimeofday_, a);
a = init_builtin (builtin_type, "get-internal-run-time", 0, (function1_t) & get_internal_run_time, a);
a = init_builtin (builtin_type, "getcwd", 0, (function1_t) & getcwd_, a);
a = init_builtin (builtin_type, "dup", 1, (function1_t) & dup_, a);
a = init_builtin (builtin_type, "dup2", 2, (function1_t) & dup2_, a);
a = init_builtin (builtin_type, "delete-file", 1, (function1_t) & delete_file, a);
/* src/reader.c */
a = init_builtin (builtin_type, "core:read-input-file-env", 2, (function1_t) & read_input_file_env_, a);
a = init_builtin (builtin_type, "read-input-file-env", 1, (function1_t) & read_input_file_env, a);
a = init_builtin (builtin_type, "read-env", 1, (function1_t) & read_env, a);
a = init_builtin (builtin_type, "reader-read-sexp", 3, (function1_t) & reader_read_sexp, a);
a = init_builtin (builtin_type, "reader-read-character", 0, (function1_t) & reader_read_character, a);
a = init_builtin (builtin_type, "reader-read-binary", 0, (function1_t) & reader_read_binary, a);
a = init_builtin (builtin_type, "reader-read-octal", 0, (function1_t) & reader_read_octal, a);
a = init_builtin (builtin_type, "reader-read-hex", 0, (function1_t) & reader_read_hex, a);
a = init_builtin (builtin_type, "reader-read-string", 0, (function1_t) & reader_read_string, a);
/* src/string.c */
a = init_builtin (builtin_type, "string=?", 2, (function1_t) & string_equal_p, a);
a = init_builtin (builtin_type, "symbol->string", 1, (function1_t) & symbol_to_string, a);
a = init_builtin (builtin_type, "symbol->keyword", 1, (function1_t) & symbol_to_keyword, a);
a = init_builtin (builtin_type, "keyword->string", 1, (function1_t) & keyword_to_string, a);
a = init_builtin (builtin_type, "string->symbol", 1, (function1_t) & string_to_symbol, a);
a = init_builtin (builtin_type, "make-symbol", 1, (function1_t) & make_symbol, a);
a = init_builtin (builtin_type, "string->list", 1, (function1_t) & string_to_list, a);
a = init_builtin (builtin_type, "list->string", 1, (function1_t) & list_to_string, a);
a = init_builtin (builtin_type, "read-string", -1, (function1_t) & read_string, a);
a = init_builtin (builtin_type, "string-append", -1, (function1_t) & string_append, a);
a = init_builtin (builtin_type, "string-length", 1, (function1_t) & string_length, a);
a = init_builtin (builtin_type, "string-ref", 2, (function1_t) & string_ref, a);
/* src/struct.c */
a = init_builtin (builtin_type, "make-struct", 3, (function1_t) & make_struct, a);
a = init_builtin (builtin_type, "struct-length", 1, (function1_t) & struct_length, a);
a = init_builtin (builtin_type, "struct-ref", 2, (function1_t) & struct_ref, a);
a = init_builtin (builtin_type, "struct-set!", 3, (function1_t) & struct_set_x, a);
/* src/vector.c */
a = init_builtin (builtin_type, "core:make-vector", 1, (function1_t) & make_vector_, a);
a = init_builtin (builtin_type, "vector-length", 1, (function1_t) & vector_length, a);
a = init_builtin (builtin_type, "vector-ref", 2, (function1_t) & vector_ref, a);
a = init_builtin (builtin_type, "vector-entry", 1, (function1_t) & vector_entry, a);
a = init_builtin (builtin_type, "vector-set!", 3, (function1_t) & vector_set_x, a);
a = init_builtin (builtin_type, "list->vector", 1, (function1_t) & list_to_vector, a);
a = init_builtin (builtin_type, "vector->list", 1, (function1_t) & vector_to_list, a);
return a;
}

264
src/mes.c
View file

@ -48,20 +48,6 @@ SCM m0;
SCM g_macros; SCM g_macros;
SCM g_ports; SCM g_ports;
#if __MESC__
typedef long function0_t;
typedef long function1_t;
typedef long function2_t;
typedef long function3_t;
typedef long functionn_t;
#else // !__MESC__
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__
SCM SCM
alloc (long n) alloc (long n)
{ {
@ -1441,92 +1427,6 @@ mes_environment (int argc, char *argv[])
return mes_g_stack (a); return mes_g_stack (a);
} }
SCM
init_builtin (SCM builtin_type, char const *name, int arity, SCM (*function) (SCM), SCM a)
{
SCM s = cstring_to_symbol (name);
return acons (s,
make_builtin (builtin_type, symbol_to_string (s), MAKE_NUMBER (arity),
MAKE_NUMBER (function)), a);
}
SCM
make_builtin_type () ///(internal))
{
SCM record_type = cell_symbol_record_type;
SCM fields = cell_nil;
fields = cons (cstring_to_symbol ("address"), fields);
fields = cons (cstring_to_symbol ("arity"), fields);
fields = cons (cstring_to_symbol ("name"), fields);
fields = cons (fields, cell_nil);
fields = cons (cell_symbol_builtin, fields);
return make_struct (record_type, fields, cell_unspecified);
}
SCM
make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function)
{
SCM values = cell_nil;
values = cons (function, values);
values = cons (arity, values);
values = cons (name, values);
values = cons (cell_symbol_builtin, values);
return make_struct (builtin_type, values, cstring_to_symbol ("builtin-printer"));
}
SCM
builtin_name (SCM builtin)
{
return struct_ref_ (builtin, 3);
}
SCM
builtin_arity (SCM builtin)
{
return struct_ref_ (builtin, 4);
}
#if __MESC__
long
builtin_function (SCM builtin)
{
return VALUE (struct_ref_ (builtin, 5));
}
#else
SCM (*builtin_function (SCM builtin)) (SCM)
{
return (function1_t) VALUE (struct_ref_ (builtin, 5));
}
#endif
SCM
builtin_p (SCM x)
{
return (TYPE (x) == TSTRUCT && struct_ref_ (x, 2) == cell_symbol_builtin) ? cell_t : cell_f;
}
SCM
builtin_printer (SCM builtin)
{
fdputs ("#<procedure ", __stdout);
display_ (builtin_name (builtin));
fdputc (' ', __stdout);
int arity = VALUE (builtin_arity (builtin));
if (arity == -1)
fdputc ('_', __stdout);
else
{
fdputc ('(', __stdout);
for (int i = 0; i < arity; i++)
{
if (i)
fdputc (' ', __stdout);
fdputc ('_', __stdout);
}
}
fdputc ('>', __stdout);
}
SCM SCM
apply_builtin (SCM fn, SCM x) ///((internal)) apply_builtin (SCM fn, SCM x) ///((internal))
{ {
@ -1582,170 +1482,6 @@ apply_builtin (SCM fn, SCM x) ///((internal))
return cell_unspecified; return cell_unspecified;
} }
SCM
mes_builtins (SCM a) ///((internal))
{
// TODO minimal: cons, car, cdr, list, null_p, eq_p minus, plus
// display_, display_error_, getenv
SCM builtin_type = make_builtin_type ();
// src/gc.mes
a = init_builtin (builtin_type, "gc-check", 0, (function1_t) & gc_check, a);
a = init_builtin (builtin_type, "gc", 0, (function1_t) & gc, a);
// src/hash.mes
a = init_builtin (builtin_type, "hashq", 2, (function1_t) & hashq, a);
a = init_builtin (builtin_type, "hash", 2, (function1_t) & hash, a);
a = init_builtin (builtin_type, "hashq-get-handle", 3, (function1_t) & hashq_get_handle, a);
a = init_builtin (builtin_type, "hashq-ref", 3, (function1_t) & hashq_ref, a);
a = init_builtin (builtin_type, "hash-ref", 3, (function1_t) & hash_ref, a);
a = init_builtin (builtin_type, "hashq-set!", 3, (function1_t) & hashq_set_x, a);
a = init_builtin (builtin_type, "hash-set!", 3, (function1_t) & hash_set_x, a);
a = init_builtin (builtin_type, "hash-table-printer", 1, (function1_t) & hash_table_printer, a);
a = init_builtin (builtin_type, "make-hash-table", 1, (function1_t) & make_hash_table, a);
// src/lib.mes
a = init_builtin (builtin_type, "core:display", 1, (function1_t) & display_, a);
a = init_builtin (builtin_type, "core:display-error", 1, (function1_t) & display_error_, a);
a = init_builtin (builtin_type, "core:display-port", 2, (function1_t) & display_port_, a);
a = init_builtin (builtin_type, "core:write", 1, (function1_t) & write_, a);
a = init_builtin (builtin_type, "core:write-error", 1, (function1_t) & write_error_, a);
a = init_builtin (builtin_type, "core:write-port", 2, (function1_t) & write_port_, a);
a = init_builtin (builtin_type, "exit", 1, (function1_t) & exit_, a);
a = init_builtin (builtin_type, "frame-printer", 1, (function1_t) & frame_printer, a);
a = init_builtin (builtin_type, "make-stack", -1, (function1_t) & make_stack, a);
a = init_builtin (builtin_type, "stack-length", 1, (function1_t) & stack_length, a);
a = init_builtin (builtin_type, "stack-ref", 2, (function1_t) & stack_ref, a);
a = init_builtin (builtin_type, "xassq", 2, (function1_t) & xassq, a);
a = init_builtin (builtin_type, "memq", 2, (function1_t) & memq, a);
a = init_builtin (builtin_type, "equal2?", 2, (function1_t) & equal2_p, a);
a = init_builtin (builtin_type, "last-pair", 1, (function1_t) & last_pair, a);
a = init_builtin (builtin_type, "pair?", 1, (function1_t) & pair_p, a);
// src/math.mes
a = init_builtin (builtin_type, ">", -1, (function1_t) & greater_p, a);
a = init_builtin (builtin_type, "<", -1, (function1_t) & less_p, a);
a = init_builtin (builtin_type, "=", -1, (function1_t) & is_p, a);
a = init_builtin (builtin_type, "-", -1, (function1_t) & minus, a);
a = init_builtin (builtin_type, "+", -1, (function1_t) & plus, a);
a = init_builtin (builtin_type, "/", -1, (function1_t) & divide, a);
a = init_builtin (builtin_type, "modulo", 2, (function1_t) & modulo, a);
a = init_builtin (builtin_type, "*", -1, (function1_t) & multiply, a);
a = init_builtin (builtin_type, "logand", -1, (function1_t) & logand, a);
a = init_builtin (builtin_type, "logior", -1, (function1_t) & logior, a);
a = init_builtin (builtin_type, "lognot", 1, (function1_t) & lognot, a);
a = init_builtin (builtin_type, "logxor", -1, (function1_t) & logxor, a);
a = init_builtin (builtin_type, "ash", 2, (function1_t) & ash, a);
// src/mes.mes
a = init_builtin (builtin_type, "core:make-cell", 3, (function1_t) & make_cell_, a);
a = init_builtin (builtin_type, "core:type", 1, (function1_t) & type_, a);
a = init_builtin (builtin_type, "core:car", 1, (function1_t) & car_, a);
a = init_builtin (builtin_type, "core:cdr", 1, (function1_t) & cdr_, a);
a = init_builtin (builtin_type, "cons", 2, (function1_t) & cons, a);
a = init_builtin (builtin_type, "car", 1, (function1_t) & car, a);
a = init_builtin (builtin_type, "cdr", 1, (function1_t) & cdr, a);
a = init_builtin (builtin_type, "list", -1, (function1_t) & list, a);
a = init_builtin (builtin_type, "null?", 1, (function1_t) & null_p, a);
a = init_builtin (builtin_type, "eq?", 2, (function1_t) & eq_p, a);
a = init_builtin (builtin_type, "values", -1, (function1_t) & values, a);
a = init_builtin (builtin_type, "acons", 3, (function1_t) & acons, a);
a = init_builtin (builtin_type, "length", 1, (function1_t) & length, a);
a = init_builtin (builtin_type, "error", 2, (function1_t) & error, a);
a = init_builtin (builtin_type, "append2", 2, (function1_t) & append2, a);
a = init_builtin (builtin_type, "append-reverse", 2, (function1_t) & append_reverse, a);
a = init_builtin (builtin_type, "core:reverse!", 2, (function1_t) & reverse_x_, a);
a = init_builtin (builtin_type, "pairlis", 3, (function1_t) & pairlis, a);
a = init_builtin (builtin_type, "assq", 2, (function1_t) & assq, a);
a = init_builtin (builtin_type, "assoc", 2, (function1_t) & assoc, a);
a = init_builtin (builtin_type, "set-car!", 2, (function1_t) & set_car_x, a);
a = init_builtin (builtin_type, "set-cdr!", 2, (function1_t) & set_cdr_x, a);
a = init_builtin (builtin_type, "set-env!", 3, (function1_t) & set_env_x, a);
a = init_builtin (builtin_type, "macro-get-handle", 1, (function1_t) & macro_get_handle, a);
a = init_builtin (builtin_type, "add-formals", 2, (function1_t) & add_formals, a);
a = init_builtin (builtin_type, "eval-apply", 0, (function1_t) & eval_apply, a);
a = init_builtin (builtin_type, "make-builtin-type", 0, (function1_t) & make_builtin_type, a);
a = init_builtin (builtin_type, "make-builtin", 4, (function1_t) & make_builtin, a);
a = init_builtin (builtin_type, "builtin-name", 1, (function1_t) & builtin_name, a);
a = init_builtin (builtin_type, "builtin-arity", 1, (function1_t) & builtin_arity, a);
a = init_builtin (builtin_type, "builtin?", 1, (function1_t) & builtin_p, a);
a = init_builtin (builtin_type, "builtin-printer", 1, (function1_t) & builtin_printer, a);
// src/module.mes
a = init_builtin (builtin_type, "make-module-type", 0, (function1_t) & make_module_type, a);
a = init_builtin (builtin_type, "module-printer", 1, (function1_t) & module_printer, a);
a = init_builtin (builtin_type, "module-variable", 2, (function1_t) & module_variable, a);
a = init_builtin (builtin_type, "module-ref", 2, (function1_t) & module_ref, a);
a = init_builtin (builtin_type, "module-define!", 3, (function1_t) & module_define_x, a);
// src/posix.mes
a = init_builtin (builtin_type, "peek-byte", 0, (function1_t) & peek_byte, a);
a = init_builtin (builtin_type, "read-byte", 0, (function1_t) & read_byte, a);
a = init_builtin (builtin_type, "unread-byte", 1, (function1_t) & unread_byte, a);
a = init_builtin (builtin_type, "peek-char", 0, (function1_t) & peek_char, a);
a = init_builtin (builtin_type, "read-char", -1, (function1_t) & read_char, a);
a = init_builtin (builtin_type, "unread-char", 1, (function1_t) & unread_char, a);
a = init_builtin (builtin_type, "write-char", -1, (function1_t) & write_char, a);
a = init_builtin (builtin_type, "write-byte", -1, (function1_t) & write_byte, a);
a = init_builtin (builtin_type, "getenv", 1, (function1_t) & getenv_, a);
a = init_builtin (builtin_type, "setenv", 2, (function1_t) & setenv_, a);
a = init_builtin (builtin_type, "access?", 2, (function1_t) & access_p, a);
a = init_builtin (builtin_type, "current-input-port", 0, (function1_t) & current_input_port, a);
a = init_builtin (builtin_type, "open-input-file", 1, (function1_t) & open_input_file, a);
a = init_builtin (builtin_type, "open-input-string", 1, (function1_t) & open_input_string, a);
a = init_builtin (builtin_type, "set-current-input-port", 1, (function1_t) & set_current_input_port, a);
a = init_builtin (builtin_type, "current-output-port", 0, (function1_t) & current_output_port, a);
a = init_builtin (builtin_type, "current-error-port", 0, (function1_t) & current_error_port, a);
a = init_builtin (builtin_type, "open-output-file", -1, (function1_t) & open_output_file, a);
a = init_builtin (builtin_type, "set-current-output-port", 1, (function1_t) & set_current_output_port, a);
a = init_builtin (builtin_type, "set-current-error-port", 1, (function1_t) & set_current_error_port, a);
a = init_builtin (builtin_type, "chmod", 2, (function1_t) & chmod_, a);
a = init_builtin (builtin_type, "isatty?", 1, (function1_t) & isatty_p, a);
a = init_builtin (builtin_type, "primitive-fork", 0, (function1_t) & primitive_fork, a);
a = init_builtin (builtin_type, "execl", 2, (function1_t) & execl_, a);
a = init_builtin (builtin_type, "core:waitpid", 2, (function1_t) & waitpid_, a);
a = init_builtin (builtin_type, "current-time", 0, (function1_t) & current_time, a);
a = init_builtin (builtin_type, "gettimeofday", 0, (function1_t) & gettimeofday_, a);
a = init_builtin (builtin_type, "get-internal-run-time", 0, (function1_t) & get_internal_run_time, a);
a = init_builtin (builtin_type, "getcwd", 0, (function1_t) & getcwd_, a);
a = init_builtin (builtin_type, "dup", 1, (function1_t) & dup_, a);
a = init_builtin (builtin_type, "dup2", 2, (function1_t) & dup2_, a);
a = init_builtin (builtin_type, "delete-file", 1, (function1_t) & delete_file, a);
// src/reader.mes
a = init_builtin (builtin_type, "core:read-input-file-env", 2, (function1_t) & read_input_file_env_, a);
a = init_builtin (builtin_type, "read-input-file-env", 1, (function1_t) & read_input_file_env, a);
a = init_builtin (builtin_type, "read-env", 1, (function1_t) & read_env, a);
a = init_builtin (builtin_type, "reader-read-sexp", 3, (function1_t) & reader_read_sexp, a);
a = init_builtin (builtin_type, "reader-read-character", 0, (function1_t) & reader_read_character, a);
a = init_builtin (builtin_type, "reader-read-binary", 0, (function1_t) & reader_read_binary, a);
a = init_builtin (builtin_type, "reader-read-octal", 0, (function1_t) & reader_read_octal, a);
a = init_builtin (builtin_type, "reader-read-hex", 0, (function1_t) & reader_read_hex, a);
a = init_builtin (builtin_type, "reader-read-string", 0, (function1_t) & reader_read_string, a);
// src/strings.mes
a = init_builtin (builtin_type, "string=?", 2, (function1_t) & string_equal_p, a);
a = init_builtin (builtin_type, "symbol->string", 1, (function1_t) & symbol_to_string, a);
a = init_builtin (builtin_type, "symbol->keyword", 1, (function1_t) & symbol_to_keyword, a);
a = init_builtin (builtin_type, "keyword->string", 1, (function1_t) & keyword_to_string, a);
a = init_builtin (builtin_type, "string->symbol", 1, (function1_t) & string_to_symbol, a);
a = init_builtin (builtin_type, "make-symbol", 1, (function1_t) & make_symbol, a);
a = init_builtin (builtin_type, "string->list", 1, (function1_t) & string_to_list, a);
a = init_builtin (builtin_type, "list->string", 1, (function1_t) & list_to_string, a);
a = init_builtin (builtin_type, "read-string", -1, (function1_t) & read_string, a);
a = init_builtin (builtin_type, "string-append", -1, (function1_t) & string_append, a);
a = init_builtin (builtin_type, "string-length", 1, (function1_t) & string_length, a);
a = init_builtin (builtin_type, "string-ref", 2, (function1_t) & string_ref, a);
// src/struct.mes
a = init_builtin (builtin_type, "make-struct", 3, (function1_t) & make_struct, a);
a = init_builtin (builtin_type, "struct-length", 1, (function1_t) & struct_length, a);
a = init_builtin (builtin_type, "struct-ref", 2, (function1_t) & struct_ref, a);
a = init_builtin (builtin_type, "struct-set!", 3, (function1_t) & struct_set_x, a);
// src/vector.mes
a = init_builtin (builtin_type, "core:make-vector", 1, (function1_t) & make_vector_, a);
a = init_builtin (builtin_type, "vector-length", 1, (function1_t) & vector_length, a);
a = init_builtin (builtin_type, "vector-ref", 2, (function1_t) & vector_ref, a);
a = init_builtin (builtin_type, "vector-entry", 1, (function1_t) & vector_entry, a);
a = init_builtin (builtin_type, "vector-set!", 3, (function1_t) & vector_set_x, a);
a = init_builtin (builtin_type, "list->vector", 1, (function1_t) & list_to_vector, a);
a = init_builtin (builtin_type, "vector->list", 1, (function1_t) & vector_to_list, a);
return a;
}
int int
try_open_boot (char *file_name, char const *boot, char const *location) try_open_boot (char *file_name, char const *boot, char const *location)
{ {