diff --git a/build-aux/pointer.sh b/build-aux/pointer.sh index 2254f325..384b0689 100755 --- a/build-aux/pointer.sh +++ b/build-aux/pointer.sh @@ -49,7 +49,6 @@ sed -ri \ include/mes/symbols.h \ include/mes/builtins.h \ include/m2/lib.h \ - include/mes/m2.h \ src/builtins.c \ src/cc.c \ src/core.c \ diff --git a/include/mes/builtins.h b/include/mes/builtins.h index 09d44d61..1c7463db 100644 --- a/include/mes/builtins.h +++ b/include/mes/builtins.h @@ -22,159 +22,159 @@ #define __MES_BUILTINS_H /* src/builtins.c */ -SCM make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function); -SCM builtin_name (SCM builtin); -SCM builtin_arity (SCM builtin); -SCM builtin_p (SCM x); -SCM builtin_printer (SCM builtin); +struct scm *make_builtin (struct scm *builtin_type, struct scm *name, struct scm *arity, struct scm *function); +struct scm *builtin_name (struct scm *builtin); +struct scm *builtin_arity (struct scm *builtin); +struct scm *builtin_p (struct scm *x); +struct scm *builtin_printer (struct scm *builtin); /* src/core.c */ -SCM car (SCM x); -SCM cdr (SCM x); -SCM list (SCM x); -SCM null_p (SCM x); -SCM eq_p (SCM x, SCM y); -SCM values (SCM x); -SCM acons (SCM key, SCM value, SCM alist); -SCM length (SCM x); -SCM error (SCM key, SCM x); -SCM append2 (SCM x, SCM y); -SCM append_reverse (SCM x, SCM y); -SCM reverse_x_ (SCM x, SCM t); -SCM assq (SCM x, SCM a); -SCM assoc (SCM x, SCM a); +struct scm *car (struct scm *x); +struct scm *cdr (struct scm *x); +struct scm *list (struct scm *x); +struct scm *null_p (struct scm *x); +struct scm *eq_p (struct scm *x, struct scm *y); +struct scm *values (struct scm *x); +struct scm *acons (struct scm *key, struct scm *value, struct scm *alist); +struct scm *length (struct scm *x); +struct scm *error (struct scm *key, struct scm *x); +struct scm *append2 (struct scm *x, struct scm *y); +struct scm *append_reverse (struct scm *x, struct scm *y); +struct scm *reverse_x_ (struct scm *x, struct scm *t); +struct scm *assq (struct scm *x, struct scm *a); +struct scm *assoc (struct scm *x, struct scm *a); /* src/display.c */ -SCM display_ (SCM x); -SCM display_error_ (SCM x); -SCM display_port_ (SCM x, SCM p); -SCM write_ (SCM x); -SCM write_error_ (SCM x); -SCM write_port_ (SCM x, SCM p); +struct scm *display_ (struct scm *x); +struct scm *display_error_ (struct scm *x); +struct scm *display_port_ (struct scm *x, struct scm *p); +struct scm *write_ (struct scm *x); +struct scm *write_error_ (struct scm *x); +struct scm *write_port_ (struct scm *x, struct scm *p); /* src/eval-apply.c */ -SCM pairlis (SCM x, SCM y, SCM a); -SCM set_car_x (SCM x, SCM e); -SCM set_cdr_x (SCM x, SCM e); -SCM set_env_x (SCM x, SCM e, SCM a); -SCM add_formals (SCM formals, SCM x); -SCM eval_apply (); +struct scm *pairlis (struct scm *x, struct scm *y, struct scm *a); +struct scm *set_car_x (struct scm *x, struct scm *e); +struct scm *set_cdr_x (struct scm *x, struct scm *e); +struct scm *set_env_x (struct scm *x, struct scm *e, struct scm *a); +struct scm *add_formals (struct scm *formals, struct scm *x); +struct scm *eval_apply (); /* src/gc.c */ -SCM cons (SCM x, SCM y); -SCM gc_check (); -SCM gc (); +struct scm *cons (struct scm *x, struct scm *y); +struct scm *gc_check (); +struct scm *gc (); /* src/hash.c */ -SCM hashq (SCM x, SCM size); -SCM hash (SCM x, SCM size); -SCM hashq_get_handle (SCM table, SCM key, SCM dflt); -SCM hashq_ref (SCM table, SCM key, SCM dflt); -SCM hash_ref (SCM table, SCM key, SCM dflt); -SCM hashq_set_x (SCM table, SCM key, SCM value); -SCM hash_set_x (SCM table, SCM key, SCM value); -SCM hash_table_printer (SCM table); -SCM make_hash_table (SCM x); +struct scm *hashq (struct scm *x, struct scm *size); +struct scm *hash (struct scm *x, struct scm *size); +struct scm *hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt); +struct scm *hashq_ref (struct scm *table, struct scm *key, struct scm *dflt); +struct scm *hash_ref (struct scm *table, struct scm *key, struct scm *dflt); +struct scm *hashq_set_x (struct scm *table, struct scm *key, struct scm *value); +struct scm *hash_set_x (struct scm *table, struct scm *key, struct scm *value); +struct scm *hash_table_printer (struct scm *table); +struct scm *make_hash_table (struct scm *x); /* src/lib.c */ -SCM type_ (SCM x); -SCM car_ (SCM x); -SCM cdr_ (SCM x); -SCM xassq (SCM x, SCM a); -SCM memq (SCM x, SCM a); -SCM equal2_p (SCM a, SCM b); -SCM last_pair (SCM x); -SCM pair_p (SCM x); -SCM char_to_integer (SCM x); -SCM integer_to_char (SCM x); +struct scm *type_ (struct scm *x); +struct scm *car_ (struct scm *x); +struct scm *cdr_ (struct scm *x); +struct scm *xassq (struct scm *x, struct scm *a); +struct scm *memq (struct scm *x, struct scm *a); +struct scm *equal2_p (struct scm *a, struct scm *b); +struct scm *last_pair (struct scm *x); +struct scm *pair_p (struct scm *x); +struct scm *char_to_integer (struct scm *x); +struct scm *integer_to_char (struct scm *x); /* src/math.c */ -SCM greater_p (SCM x); -SCM less_p (SCM x); -SCM is_p (SCM x); -SCM minus (SCM x); -SCM plus (SCM x); -SCM divide (SCM x); -SCM modulo (SCM a, SCM b); -SCM multiply (SCM x); -SCM logand (SCM x); -SCM logior (SCM x); -SCM lognot (SCM x); -SCM logxor (SCM x); -SCM ash (SCM n, SCM count); +struct scm *greater_p (struct scm *x); +struct scm *less_p (struct scm *x); +struct scm *is_p (struct scm *x); +struct scm *minus (struct scm *x); +struct scm *plus (struct scm *x); +struct scm *divide (struct scm *x); +struct scm *modulo (struct scm *a, struct scm *b); +struct scm *multiply (struct scm *x); +struct scm *logand (struct scm *x); +struct scm *logior (struct scm *x); +struct scm *lognot (struct scm *x); +struct scm *logxor (struct scm *x); +struct scm *ash (struct scm *n, struct scm *count); /* src/module.c */ -SCM make_module_type (); -SCM module_printer (SCM module); -SCM module_variable (SCM module, SCM name); -SCM module_ref (SCM module, SCM name); -SCM module_define_x (SCM module, SCM name, SCM value); +struct scm *make_module_type (); +struct scm *module_printer (struct scm *module); +struct scm *module_variable (struct scm *module, struct scm *name); +struct scm *module_ref (struct scm *module, struct scm *name); +struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value); /* src/posix.c */ -SCM exit_ (SCM x); -SCM peek_byte (); -SCM read_byte (); -SCM unread_byte (SCM i); -SCM peek_char (); -SCM read_char (SCM port); -SCM unread_char (SCM i); -SCM write_char (SCM i); -SCM write_byte (SCM x); -SCM getenv_ (SCM s); -SCM setenv_ (SCM s, SCM v); -SCM access_p (SCM file_name, SCM mode); -SCM current_input_port (); -SCM open_input_file (SCM file_name); -SCM open_input_string (SCM string); -SCM set_current_input_port (SCM port); -SCM current_output_port (); -SCM current_error_port (); -SCM open_output_file (SCM x); -SCM set_current_output_port (SCM port); -SCM set_current_error_port (SCM port); -SCM chmod_ (SCM file_name, SCM mode); -SCM isatty_p (SCM port); -SCM primitive_fork (); -SCM execl_ (SCM file_name, SCM args); -SCM waitpid_ (SCM pid, SCM options); -SCM current_time (); -SCM gettimeofday_ (); -SCM get_internal_run_time (); -SCM getcwd_ (); -SCM dup_ (SCM port); -SCM dup2_ (SCM old, SCM new); -SCM delete_file (SCM file_name); +struct scm *exit_ (struct scm *x); +struct scm *peek_byte (); +struct scm *read_byte (); +struct scm *unread_byte (struct scm *i); +struct scm *peek_char (); +struct scm *read_char (struct scm *port); +struct scm *unread_char (struct scm *i); +struct scm *write_char (struct scm *i); +struct scm *write_byte (struct scm *x); +struct scm *getenv_ (struct scm *s); +struct scm *setenv_ (struct scm *s, struct scm *v); +struct scm *access_p (struct scm *file_name, struct scm *mode); +struct scm *current_input_port (); +struct scm *open_input_file (struct scm *file_name); +struct scm *open_input_string (struct scm *string); +struct scm *set_current_input_port (struct scm *port); +struct scm *current_output_port (); +struct scm *current_error_port (); +struct scm *open_output_file (struct scm *x); +struct scm *set_current_output_port (struct scm *port); +struct scm *set_current_error_port (struct scm *port); +struct scm *chmod_ (struct scm *file_name, struct scm *mode); +struct scm *isatty_p (struct scm *port); +struct scm *primitive_fork (); +struct scm *execl_ (struct scm *file_name, struct scm *args); +struct scm *waitpid_ (struct scm *pid, struct scm *options); +struct scm *current_time (); +struct scm *gettimeofday_ (); +struct scm *get_internal_run_time (); +struct scm *getcwd_ (); +struct scm *dup_ (struct scm *port); +struct scm *dup2_ (struct scm *old, struct scm *new); +struct scm *delete_file (struct scm *file_name); /* src/reader.c */ -SCM read_input_file_env_ (SCM e, SCM a); -SCM read_input_file_env (SCM a); -SCM read_env (SCM a); -SCM reader_read_sexp (SCM c, SCM s, SCM a); -SCM reader_read_character (); -SCM reader_read_binary (); -SCM reader_read_octal (); -SCM reader_read_hex (); -SCM reader_read_string (); +struct scm *read_input_file_env_ (struct scm *e, struct scm *a); +struct scm *read_input_file_env (struct scm *a); +struct scm *read_env (struct scm *a); +struct scm *reader_read_sexp (struct scm *c, struct scm *s, struct scm *a); +struct scm *reader_read_character (); +struct scm *reader_read_binary (); +struct scm *reader_read_octal (); +struct scm *reader_read_hex (); +struct scm *reader_read_string (); /* src/stack.c */ -SCM frame_printer (SCM frame); -SCM make_stack (SCM stack); -SCM stack_length (SCM stack); -SCM stack_ref (SCM stack, SCM index); +struct scm *frame_printer (struct scm *frame); +struct scm *make_stack (struct scm *stack); +struct scm *stack_length (struct scm *stack); +struct scm *stack_ref (struct scm *stack, struct scm *index); /* src/string.c */ -SCM string_equal_p (SCM a, SCM b); -SCM symbol_to_string (SCM symbol); -SCM symbol_to_keyword (SCM symbol); -SCM keyword_to_string (SCM keyword); -SCM string_to_symbol (SCM string); -SCM make_symbol (SCM string); -SCM string_to_list (SCM string); -SCM list_to_string (SCM list); -SCM read_string (SCM port); -SCM string_append (SCM x); -SCM string_length (SCM string); -SCM string_ref (SCM str, SCM k); +struct scm *string_equal_p (struct scm *a, struct scm *b); +struct scm *symbol_to_string (struct scm *symbol); +struct scm *symbol_to_keyword (struct scm *symbol); +struct scm *keyword_to_string (struct scm *keyword); +struct scm *string_to_symbol (struct scm *string); +struct scm *make_symbol (struct scm *string); +struct scm *string_to_list (struct scm *string); +struct scm *list_to_string (struct scm *list); +struct scm *read_string (struct scm *port); +struct scm *string_append (struct scm *x); +struct scm *string_length (struct scm *string); +struct scm *string_ref (struct scm *str, struct scm *k); /* src/struct.c */ -SCM make_struct (SCM type, SCM fields, SCM printer); -SCM struct_length (SCM x); -SCM struct_ref (SCM x, SCM i); -SCM struct_set_x (SCM x, SCM i, SCM e); +struct scm *make_struct (struct scm *type, struct scm *fields, struct scm *printer); +struct scm *struct_length (struct scm *x); +struct scm *struct_ref (struct scm *x, struct scm *i); +struct scm *struct_set_x (struct scm *x, struct scm *i, struct scm *e); /* src/vector.c */ -SCM make_vector (SCM x); -SCM vector_length (SCM x); -SCM vector_ref (SCM x, SCM i); -SCM vector_entry (SCM x); -SCM vector_set_x (SCM x, SCM i, SCM e); -SCM list_to_vector (SCM x); -SCM vector_to_list (SCM v); +struct scm *make_vector (struct scm *x); +struct scm *vector_length (struct scm *x); +struct scm *vector_ref (struct scm *x, struct scm *i); +struct scm *vector_entry (struct scm *x); +struct scm *vector_set_x (struct scm *x, struct scm *i, struct scm *e); +struct scm *list_to_vector (struct scm *x); +struct scm *vector_to_list (struct scm *v); #endif /* __MES_BUILTINS_H */ diff --git a/include/mes/m2.h b/include/mes/m2.h deleted file mode 100644 index d3a4231c..00000000 --- a/include/mes/m2.h +++ /dev/null @@ -1,24 +0,0 @@ -/* -*-comment-start: "//";comment-end:""-*- - * GNU Mes --- Maxwell Equations of Software - * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen - * - * 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 . - */ - -#ifndef __MES_M2_H -#define __MES_M2_H - -#endif /* __MES_M2_H */ diff --git a/include/mes/macros.h b/include/mes/macros.h deleted file mode 100644 index af402f20..00000000 --- a/include/mes/macros.h +++ /dev/null @@ -1,66 +0,0 @@ -/* -*-comment-start: "//";comment-end:""-*- - * GNU Mes --- Maxwell Equations of Software - * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen - * - * 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 . - */ - -#ifndef __MES_MACROS_H -#define __MES_MACROS_H - -#define TYPE(x) g_cells[x - g_cells].type -#define CAR(x) g_cells[x - g_cells].car -#define CDR(x) g_cells[x - g_cells].cdr - -#define NTYPE(x) g_news[x - g_news].type -#define NCAR(x) g_news[x - g_news].car -#define NCDR(x) g_news[x - g_news].cdr - -#define STYPE(x) TYPE (g_stack_array[x]) -#define SCAR(x) CAR (g_stack_array[x]) -#define SCDR(x) CDR (g_stack_arraynews[x]) - -#define BYTES(x) g_cells[x - g_cells].bytes -#define LENGTH(x) g_cells[x - g_cells].length -#define MACRO(x) g_cells[x - g_cells].macro -#define PORT(x) g_cells[x - g_cells].port -#define REF(x) g_cells[x - g_cells].ref -#define VARIABLE(x) g_cells[x - g_cells].variable - -#define CLOSURE(x) g_cells[x - g_cells].closure -#define CONTINUATION(x) g_cells[x - g_cells].continuation - -#define NAME(x) g_cells[x - g_cells].name -#define STRING(x) g_cells[x - g_cells].string -#define STRUCT(x) g_cells[x - g_cells].structure -#define VALUE(x) g_cells[x - g_cells].value -#define VECTOR(x) g_cells[x - g_cells].vector - -#define NLENGTH(x) g_news[x - g_news].length -#define NVALUE(x) g_news[x - g_news].value -#define NSTRING(x) g_news[x - g_news].string -#define NVECTOR(x) g_news[x - g_news].vector - -#define CAAR(x) CAR (CAR (x)) -#define CADR(x) CAR (CDR (x)) -#define CDAR(x) CDR (CAR (x)) -#define CDDR(x) CDR (CDR (x)) -#define CADAR(x) CAR (CDR (CAR (x))) -#define CADDR(x) CAR (CDR (CDR (x))) -#define CDADR(x) CDR (CAR (CDR (x))) -#define CDDAR(x) CDR (CDR (CAR (x))) - -#endif //__MES_MACROS_H diff --git a/include/mes/mes.h b/include/mes/mes.h index 189ef76d..dc8dab55 100644 --- a/include/mes/mes.h +++ b/include/mes/mes.h @@ -29,24 +29,24 @@ struct scm long type; union { - SCM car; + struct scm *car; char *bytes; long length; - SCM ref; - SCM variable; - SCM macro; + struct scm *ref; + struct scm *variable; + struct scm *macro; long port; }; union { - SCM cdr; - SCM closure; - SCM continuation; + struct scm *cdr; + struct scm *closure; + struct scm *continuation; char *name; - SCM string; - SCM structure; + struct scm *string; + struct scm *structure; long value; - SCM vector; + struct scm *vector; }; }; @@ -54,24 +54,24 @@ struct scm char *g_datadir; int g_debug; char *g_buf; -SCM g_continuations; -SCM g_symbols; -SCM g_symbol_max; +struct scm *g_continuations; +struct scm *g_symbols; +struct scm *g_symbol_max; int g_mini; /* a/env */ -SCM R0; +struct scm *R0; /* param 1 */ -SCM R1; +struct scm *R1; /* save 2 */ -SCM R2; +struct scm *R2; /* continuation */ -SCM R3; +struct scm *R3; /* current-module */ -SCM M0; +struct scm *M0; /* macro */ -SCM g_macros; -SCM g_ports; +struct scm *g_macros; +struct scm *g_ports; /* gc */ long ARENA_SIZE; @@ -81,13 +81,13 @@ long JAM_SIZE; long GC_SAFETY; long MAX_STRING; char *g_arena; -SCM cell_arena; -SCM cell_zero; +struct scm *cell_arena; +struct scm *cell_zero; -SCM g_free; -SCM g_symbol; +struct scm *g_free; +struct scm *g_symbol; -SCM *g_stack_array; +struct scm **g_stack_array; struct scm *g_cells; struct scm *g_news; long g_stack; @@ -102,54 +102,54 @@ struct timespec *g_start_time; struct timeval *__gettimeofday_time; struct timespec *__get_internal_run_time_ts; -SCM alloc (long n); -SCM apply (SCM f, SCM x, SCM a); -SCM apply_builtin (SCM fn, SCM x); -SCM apply_builtin0 (SCM fn); -SCM apply_builtin1 (SCM fn, SCM x); -SCM apply_builtin2 (SCM fn, SCM x, SCM y); -SCM apply_builtin3 (SCM fn, SCM x, SCM y, SCM z); -SCM builtin_name (SCM builtin); -SCM cstring_to_list (char const *s); -SCM cstring_to_symbol (char const *s); -SCM cell_ref (SCM cell, long index); -SCM fdisplay_ (SCM, int, int); -SCM init_symbols (); -SCM init_time (SCM a); -SCM make_builtin_type (); -SCM make_bytes (char const *s, size_t length); -SCM make_cell (long type, SCM car, SCM cdr); -SCM make_char (int n); -SCM make_continuation (long n); -SCM make_hash_table_ (long size); -SCM make_hashq_type (); -SCM make_initial_module (SCM a); -SCM make_macro (SCM name, SCM x); -SCM make_number (long n); -SCM make_ref (SCM x); -SCM make_string (char const *s, size_t length); -SCM make_string0 (char const *s); -SCM make_string_port (SCM x); -SCM make_vector_ (long k, SCM e); -SCM mes_builtins (SCM a); -SCM push_cc (SCM p1, SCM p2, SCM a, SCM c); -SCM struct_ref_ (SCM x, long i); -SCM struct_set_x_ (SCM x, long i, SCM e); -SCM vector_ref_ (SCM x, long i); -SCM vector_set_x_ (SCM x, long i, SCM e); -FUNCTION builtin_function (SCM builtin); -char *cell_bytes (SCM x); -char *news_bytes (SCM x); +struct scm *alloc (long n); +struct scm *apply (struct scm *f, struct scm *x, struct scm *a); +struct scm *apply_builtin (struct scm *fn, struct scm *x); +struct scm *apply_builtin0 (struct scm *fn); +struct scm *apply_builtin1 (struct scm *fn, struct scm *x); +struct scm *apply_builtin2 (struct scm *fn, struct scm *x, struct scm *y); +struct scm *apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z); +struct scm *builtin_name (struct scm *builtin); +struct scm *cstring_to_list (char const *s); +struct scm *cstring_to_symbol (char const *s); +struct scm *cell_ref (struct scm *cell, long index); +struct scm *fdisplay_ (struct scm *, int, int); +struct scm *init_symbols (); +struct scm *init_time (struct scm *a); +struct scm *make_builtin_type (); +struct scm *make_bytes (char const *s, size_t length); +struct scm *make_cell (long type, struct scm *car, struct scm *cdr); +struct scm *make_char (int n); +struct scm *make_continuation (long n); +struct scm *make_hash_table_ (long size); +struct scm *make_hashq_type (); +struct scm *make_initial_module (struct scm *a); +struct scm *make_macro (struct scm *name, struct scm *x); +struct scm *make_number (long n); +struct scm *make_ref (struct scm *x); +struct scm *make_string (char const *s, size_t length); +struct scm *make_string0 (char const *s); +struct scm *make_string_port (struct scm *x); +struct scm *make_vector_ (long k, struct scm *e); +struct scm *mes_builtins (struct scm *a); +struct scm *push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c); +struct scm *struct_ref_ (struct scm *x, long i); +struct scm *struct_set_x_ (struct scm *x, long i, struct scm *e); +struct scm *vector_ref_ (struct scm *x, long i); +struct scm *vector_set_x_ (struct scm *x, long i, struct scm *e); +FUNCTION builtin_function (struct scm *builtin); +char *cell_bytes (struct scm *x); +char *news_bytes (struct scm *x); int peekchar (); int readchar (); int unreadchar (); long gc_free (); -long length__ (SCM x); +long length__ (struct scm *x); size_t bytes_cells (size_t length); void assert_max_string (size_t i, char const *msg, char *string); void assert_msg (int check, char *msg); -void assert_number (char const *name, SCM x); -void copy_cell (SCM to, SCM from); +void assert_number (char const *name, struct scm *x); +void copy_cell (struct scm *to, struct scm *from); void gc_ (); void gc_dump_arena (struct scm *cells, long size); void gc_init (); @@ -161,7 +161,6 @@ void init_symbols_ (); #include "mes/builtins.h" #include "mes/constants.h" -#include "mes/macros.h" #include "mes/symbols.h" #endif /* __MES_MES_H */ diff --git a/include/mes/symbols.h b/include/mes/symbols.h index 6311c64f..ec185bdc 100644 --- a/include/mes/symbols.h +++ b/include/mes/symbols.h @@ -21,121 +21,121 @@ #ifndef __MES_SYMBOLS_H #define __MES_SYMBOLS_H -SCM cell_nil; -SCM cell_f; -SCM cell_t; -SCM cell_dot; -SCM cell_arrow; -SCM cell_undefined; -SCM cell_unspecified; -SCM cell_closure; -SCM cell_circular; +struct scm *cell_nil; +struct scm *cell_f; +struct scm *cell_t; +struct scm *cell_dot; +struct scm *cell_arrow; +struct scm *cell_undefined; +struct scm *cell_unspecified; +struct scm *cell_closure; +struct scm *cell_circular; -SCM cell_vm_apply; -SCM cell_vm_apply2; -SCM cell_vm_begin; -SCM cell_vm_begin_eval; -SCM cell_vm_begin_expand; -SCM cell_vm_begin_expand_eval; -SCM cell_vm_begin_expand_macro; -SCM cell_vm_begin_expand_primitive_load; -SCM cell_vm_begin_primitive_load; -SCM cell_vm_begin_read_input_file; -SCM cell_vm_call_with_current_continuation2; -SCM cell_vm_call_with_values2; -SCM cell_vm_eval; -SCM cell_vm_eval2; -SCM cell_vm_eval_check_func; -SCM cell_vm_eval_define; -SCM cell_vm_eval_macro_expand_eval; -SCM cell_vm_eval_macro_expand_expand; -SCM cell_vm_eval_pmatch_car; -SCM cell_vm_eval_pmatch_cdr; -SCM cell_vm_eval_set_x; -SCM cell_vm_evlis; -SCM cell_vm_evlis2; -SCM cell_vm_evlis3; -SCM cell_vm_if; -SCM cell_vm_if_expr; -SCM cell_vm_macro_expand; -SCM cell_vm_macro_expand_car; -SCM cell_vm_macro_expand_cdr; -SCM cell_vm_macro_expand_define; -SCM cell_vm_macro_expand_define_macro; -SCM cell_vm_macro_expand_lambda; -SCM cell_vm_macro_expand_set_x; -SCM cell_vm_return; +struct scm *cell_vm_apply; +struct scm *cell_vm_apply2; +struct scm *cell_vm_begin; +struct scm *cell_vm_begin_eval; +struct scm *cell_vm_begin_expand; +struct scm *cell_vm_begin_expand_eval; +struct scm *cell_vm_begin_expand_macro; +struct scm *cell_vm_begin_expand_primitive_load; +struct scm *cell_vm_begin_primitive_load; +struct scm *cell_vm_begin_read_input_file; +struct scm *cell_vm_call_with_current_continuation2; +struct scm *cell_vm_call_with_values2; +struct scm *cell_vm_eval; +struct scm *cell_vm_eval2; +struct scm *cell_vm_eval_check_func; +struct scm *cell_vm_eval_define; +struct scm *cell_vm_eval_macro_expand_eval; +struct scm *cell_vm_eval_macro_expand_expand; +struct scm *cell_vm_eval_pmatch_car; +struct scm *cell_vm_eval_pmatch_cdr; +struct scm *cell_vm_eval_set_x; +struct scm *cell_vm_evlis; +struct scm *cell_vm_evlis2; +struct scm *cell_vm_evlis3; +struct scm *cell_vm_if; +struct scm *cell_vm_if_expr; +struct scm *cell_vm_macro_expand; +struct scm *cell_vm_macro_expand_car; +struct scm *cell_vm_macro_expand_cdr; +struct scm *cell_vm_macro_expand_define; +struct scm *cell_vm_macro_expand_define_macro; +struct scm *cell_vm_macro_expand_lambda; +struct scm *cell_vm_macro_expand_set_x; +struct scm *cell_vm_return; -SCM cell_symbol_lambda; -SCM cell_symbol_begin; -SCM cell_symbol_if; -SCM cell_symbol_quote; -SCM cell_symbol_define; -SCM cell_symbol_define_macro; -SCM cell_symbol_quasiquote; -SCM cell_symbol_unquote; -SCM cell_symbol_unquote_splicing; -SCM cell_symbol_syntax; -SCM cell_symbol_quasisyntax; -SCM cell_symbol_unsyntax; -SCM cell_symbol_unsyntax_splicing; -SCM cell_symbol_set_x; -SCM cell_symbol_sc_expand; -SCM cell_symbol_macro_expand; -SCM cell_symbol_portable_macro_expand; -SCM cell_symbol_sc_expander_alist; -SCM cell_symbol_call_with_values; -SCM cell_symbol_call_with_current_continuation; -SCM cell_symbol_boot_module; -SCM cell_symbol_current_module; -SCM cell_symbol_primitive_load; -SCM cell_symbol_car; -SCM cell_symbol_cdr; -SCM cell_symbol_not_a_number; -SCM cell_symbol_not_a_pair; -SCM cell_symbol_system_error; -SCM cell_symbol_throw; -SCM cell_symbol_unbound_variable; -SCM cell_symbol_wrong_number_of_args; -SCM cell_symbol_wrong_type_arg; -SCM cell_symbol_buckets; -SCM cell_symbol_builtin; -SCM cell_symbol_frame; -SCM cell_symbol_hashq_table; -SCM cell_symbol_module; -SCM cell_symbol_procedure; -SCM cell_symbol_record_type; -SCM cell_symbol_size; -SCM cell_symbol_stack; -SCM cell_symbol_argv; -SCM cell_symbol_mes_datadir; -SCM cell_symbol_mes_version; -SCM cell_symbol_internal_time_units_per_second; -SCM cell_symbol_compiler; -SCM cell_symbol_arch; -SCM cell_symbol_pmatch_car; -SCM cell_symbol_pmatch_cdr; -SCM cell_type_bytes; -SCM cell_type_char; -SCM cell_type_closure; -SCM cell_type_continuation; -SCM cell_type_function; -SCM cell_type_keyword; -SCM cell_type_macro; -SCM cell_type_number; -SCM cell_type_pair; -SCM cell_type_port; -SCM cell_type_ref; -SCM cell_type_special; -SCM cell_type_string; -SCM cell_type_struct; -SCM cell_type_symbol; -SCM cell_type_values; -SCM cell_type_variable; -SCM cell_type_vector; -SCM cell_type_broken_heart; -SCM cell_symbol_program; -SCM cell_symbol_test; +struct scm *cell_symbol_lambda; +struct scm *cell_symbol_begin; +struct scm *cell_symbol_if; +struct scm *cell_symbol_quote; +struct scm *cell_symbol_define; +struct scm *cell_symbol_define_macro; +struct scm *cell_symbol_quasiquote; +struct scm *cell_symbol_unquote; +struct scm *cell_symbol_unquote_splicing; +struct scm *cell_symbol_syntax; +struct scm *cell_symbol_quasisyntax; +struct scm *cell_symbol_unsyntax; +struct scm *cell_symbol_unsyntax_splicing; +struct scm *cell_symbol_set_x; +struct scm *cell_symbol_sc_expand; +struct scm *cell_symbol_macro_expand; +struct scm *cell_symbol_portable_macro_expand; +struct scm *cell_symbol_sc_expander_alist; +struct scm *cell_symbol_call_with_values; +struct scm *cell_symbol_call_with_current_continuation; +struct scm *cell_symbol_boot_module; +struct scm *cell_symbol_current_module; +struct scm *cell_symbol_primitive_load; +struct scm *cell_symbol_car; +struct scm *cell_symbol_cdr; +struct scm *cell_symbol_not_a_number; +struct scm *cell_symbol_not_a_pair; +struct scm *cell_symbol_system_error; +struct scm *cell_symbol_throw; +struct scm *cell_symbol_unbound_variable; +struct scm *cell_symbol_wrong_number_of_args; +struct scm *cell_symbol_wrong_type_arg; +struct scm *cell_symbol_buckets; +struct scm *cell_symbol_builtin; +struct scm *cell_symbol_frame; +struct scm *cell_symbol_hashq_table; +struct scm *cell_symbol_module; +struct scm *cell_symbol_procedure; +struct scm *cell_symbol_record_type; +struct scm *cell_symbol_size; +struct scm *cell_symbol_stack; +struct scm *cell_symbol_argv; +struct scm *cell_symbol_mes_datadir; +struct scm *cell_symbol_mes_version; +struct scm *cell_symbol_internal_time_units_per_second; +struct scm *cell_symbol_compiler; +struct scm *cell_symbol_arch; +struct scm *cell_symbol_pmatch_car; +struct scm *cell_symbol_pmatch_cdr; +struct scm *cell_type_bytes; +struct scm *cell_type_char; +struct scm *cell_type_closure; +struct scm *cell_type_continuation; +struct scm *cell_type_function; +struct scm *cell_type_keyword; +struct scm *cell_type_macro; +struct scm *cell_type_number; +struct scm *cell_type_pair; +struct scm *cell_type_port; +struct scm *cell_type_ref; +struct scm *cell_type_special; +struct scm *cell_type_string; +struct scm *cell_type_struct; +struct scm *cell_type_symbol; +struct scm *cell_type_values; +struct scm *cell_type_variable; +struct scm *cell_type_vector; +struct scm *cell_type_broken_heart; +struct scm *cell_symbol_program; +struct scm *cell_symbol_test; // CONSTANT SYMBOL_MAX 114 #define SYMBOL_MAX 114 diff --git a/kaem.run b/kaem.run index 343f1b8e..84f2f5f1 100644 --- a/kaem.run +++ b/kaem.run @@ -19,12 +19,6 @@ # Usage: # kaem --verbose --strict -./build-aux/pointer.sh -./build-aux/pointer.sh -./build-aux/pointer.sh -./build-aux/pointer.sh -./build-aux/pointer.sh - mes_cpu=${mes_cpu:-x86} stage0_cpu=${stage0_cpu:-x86} @@ -55,7 +49,6 @@ M2-Planet \ -f lib/mes/eputc.c \ \ -f include/mes/mes.h \ - -f include/mes/m2.h \ -f include/mes/builtins.h \ -f include/mes/constants.h \ -f include/mes/symbols.h \ diff --git a/simple.make b/simple.make index 0d3f3640..6b8401d4 100644 --- a/simple.make +++ b/simple.make @@ -191,7 +191,6 @@ M2_PLANET_INCLUDES = \ include/m2/lib.h \ include/linux/x86/syscall.h \ include/mes/mes.h \ - include/mes/m2.h \ include/mes/builtins.h \ include/mes/constants.h \ include/mes/symbols.h \ diff --git a/src/builtins.c b/src/builtins.c index 4c0747ad..e02beff4 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -21,11 +21,11 @@ #include "mes/lib.h" #include "mes/mes.h" -SCM +struct scm * make_builtin_type () /*:((internal)) */ { - SCM record_type = cell_symbol_record_type; - SCM fields = cell_nil; + struct scm *record_type = cell_symbol_record_type; + struct 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); @@ -34,10 +34,10 @@ make_builtin_type () /*:((internal)) */ return make_struct (record_type, fields, cell_unspecified); } -SCM -make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function) +struct scm * +make_builtin (struct scm *builtin_type, struct scm *name, struct scm *arity, struct scm *function) { - SCM values = cell_nil; + struct scm *values = cell_nil; values = cons (function, values); values = cons (arity, values); values = cons (name, values); @@ -45,42 +45,42 @@ make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function) return make_struct (builtin_type, values, cstring_to_symbol ("builtin-printer")); } -SCM -builtin_name (SCM builtin) +struct scm * +builtin_name (struct scm *builtin) { return struct_ref_ (builtin, 3); } -SCM -builtin_arity (SCM builtin) +struct scm * +builtin_arity (struct scm *builtin) { return struct_ref_ (builtin, 4); } FUNCTION -builtin_function (SCM builtin) +builtin_function (struct scm *builtin) { - SCM x = struct_ref_ (builtin, 5); - return VALUE (x); + struct scm *x = struct_ref_ (builtin, 5); + return x->value; } -SCM -builtin_p (SCM x) +struct scm * +builtin_p (struct scm *x) { - if (TYPE (x) == TSTRUCT) + if (x->type == TSTRUCT) if (struct_ref_ (x, 2) == cell_symbol_builtin) return cell_t; return cell_f; } -SCM -builtin_printer (SCM builtin) +struct scm * +builtin_printer (struct scm *builtin) { fdputs ("#value; if (arity == -1) fdputc ('_', __stdout); else @@ -97,19 +97,19 @@ builtin_printer (SCM builtin) fdputc ('>', __stdout); } -SCM -init_builtin (SCM builtin_type, char const *name, int arity, FUNCTION function, SCM a) +struct scm * +init_builtin (struct scm *builtin_type, char const *name, int arity, FUNCTION function, struct scm *a) { - SCM s = cstring_to_symbol (name); + struct 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)) */ +struct scm * +mes_builtins (struct scm *a) /*:((internal)) */ { - SCM builtin_type = make_builtin_type (); + struct scm *builtin_type = make_builtin_type (); if (g_mini != 0) { diff --git a/src/cc.c b/src/cc.c index 2b377584..1ab604df 100644 --- a/src/cc.c +++ b/src/cc.c @@ -21,30 +21,30 @@ #include "mes/lib.h" #include "mes/mes.h" -SCM -apply_builtin0 (SCM fn) +struct scm * +apply_builtin0 (struct scm *fn) { - SCM (*fp) (void) = (function0_t) builtin_function (fn); + struct scm *(*fp) (void) = (function0_t) builtin_function (fn); return fp (); } -SCM -apply_builtin1 (SCM fn, SCM x) +struct scm * +apply_builtin1 (struct scm *fn, struct scm *x) { - SCM (*fp) (SCM) = (function1_t) builtin_function (fn); + struct scm *(*fp) (struct scm *) = (function1_t) builtin_function (fn); return fp (x); } -SCM -apply_builtin2 (SCM fn, SCM x, SCM y) +struct scm * +apply_builtin2 (struct scm *fn, struct scm *x, struct scm *y) { - SCM (*fp) (SCM, SCM) = (function2_t) builtin_function (fn); + struct scm *(*fp) (struct scm *, struct scm *) = (function2_t) builtin_function (fn); return fp (x, y); } -SCM -apply_builtin3 (SCM fn, SCM x, SCM y, SCM z) +struct scm * +apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z) { - SCM (*fp) (SCM, SCM, SCM) = (function3_t) builtin_function (fn); + struct scm *(*fp) (struct scm *, struct scm *, struct scm *) = (function3_t) builtin_function (fn); return fp (x, y, z); } diff --git a/src/core.c b/src/core.c index 556101c6..15585e45 100644 --- a/src/core.c +++ b/src/core.c @@ -29,127 +29,127 @@ #include -SCM -assoc_string (SCM x, SCM a) /*:((internal)) */ +struct scm * +assoc_string (struct scm *x, struct scm *a) /*:((internal)) */ { - SCM b; + struct scm *b; while (a != cell_nil) { - b = CAR (a); - if (TYPE (CAR (b)) == TSTRING) - if (string_equal_p (x, CAR (b)) == cell_t) + b = a->car; + if (b->car->type == TSTRING) + if (string_equal_p (x, b->car) == cell_t) return b; - a = CDR (a); + a = a->cdr; } if (a != cell_nil) - return CAR (a); + return a->car; return cell_f; } -SCM -car (SCM x) +struct scm * +car (struct scm *x) { #if !__MESC_MES__ - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car)); #endif - return CAR (x); + return x->car; } -SCM -cdr (SCM x) +struct scm * +cdr (struct scm *x) { #if !__MESC_MES__ - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr)); #endif - return CDR (x); + return x->cdr; } -SCM -list (SCM x) /*:((arity . n)) */ +struct scm * +list (struct scm *x) /*:((arity . n)) */ { return x; } -SCM -null_p (SCM x) +struct scm * +null_p (struct scm *x) { if (x == cell_nil) return cell_t; return cell_f; } -SCM -eq_p (SCM x, SCM y) +struct scm * +eq_p (struct scm *x, struct scm *y) { if (x == y) return cell_t; - int t = TYPE (x); + int t = x->type; if (t == TKEYWORD) { - if (TYPE (y) == TKEYWORD) + if (y->type == TKEYWORD) return string_equal_p (x, y); return cell_f; } if (t == TCHAR) { - if (TYPE (y) != TCHAR) + if (y->type != TCHAR) return cell_f; - if (VALUE (x) == VALUE (y)) + if (x->value == y->value) return cell_t; return cell_f; } if (t == TNUMBER) { - if (TYPE (y) != TNUMBER) + if (y->type != TNUMBER) return cell_f; - if (VALUE (x) == VALUE (y)) + if (x->value == y->value) return cell_t; return cell_f; } return cell_f; } -SCM -values (SCM x) /*:((arity . n)) */ +struct scm * +values (struct scm *x) /*:((arity . n)) */ { - SCM v = cons (0, x); - TYPE (v) = TVALUES; + struct scm *v = cons (0, x); + v->type = TVALUES; return v; } -SCM -acons (SCM key, SCM value, SCM alist) +struct scm * +acons (struct scm *key, struct scm *value, struct scm *alist) { return cons (cons (key, value), alist); } long -length__ (SCM x) /*:((internal)) */ +length__ (struct scm *x) /*:((internal)) */ { long n = 0; while (x != cell_nil) { n = n + 1; - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) return -1; - x = CDR (x); + x = x->cdr; } return n; } -SCM -length (SCM x) +struct scm * +length (struct scm *x) { return make_number (length__ (x)); } -SCM -error (SCM key, SCM x) +struct scm * +error (struct scm *key, struct scm *x) { #if !__MESC_MES__ && !__M2_PLANET__ - SCM throw = module_ref (R0, cell_symbol_throw); + struct scm *throw = module_ref (R0, cell_symbol_throw); if (throw != cell_undefined) return apply (throw, cons (key, cons (x, cell_nil)), R0); #endif @@ -161,107 +161,107 @@ error (SCM key, SCM x) exit (1); } -SCM -append2 (SCM x, SCM y) +struct scm * +append2 (struct scm *x, struct scm *y) { if (x == cell_nil) return y; - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("append2"))); - SCM r = cell_nil; + struct scm *r = cell_nil; while (x != cell_nil) { - r = cons (CAR (x), r); - x = CDR (x); + r = cons (x->car, r); + x = x->cdr; } return reverse_x_ (r, y); } -SCM -append_reverse (SCM x, SCM y) +struct scm * +append_reverse (struct scm *x, struct scm *y) { if (x == cell_nil) return y; - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("append-reverse"))); while (x != cell_nil) { - y = cons (CAR (x), y); - x = CDR (x); + y = cons (x->car, y); + x = x->cdr; } return y; } -SCM -reverse_x_ (SCM x, SCM t) +struct scm * +reverse_x_ (struct scm *x, struct scm *t) { - if (x != cell_nil && TYPE (x) != TPAIR) + if (x != cell_nil && x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("core:reverse!"))); - SCM r = t; + struct scm *r = t; while (x != cell_nil) { - t = CDR (x); - CDR (x) = r; + t = x->cdr; + x->cdr = r; r = x; x = t; } return r; } -SCM -assq (SCM x, SCM a) +struct scm * +assq (struct scm *x, struct scm *a) { - if (TYPE (a) != TPAIR) + if (a->type != TPAIR) return cell_f; - int t = TYPE (x); + int t = x->type; if (t == TSYMBOL || t == TSPECIAL) while (a != cell_nil) { - if (x == CAAR (a)) - return CAR (a); - a = CDR (a); + if (x == a->car->car) + return a->car; + a = a->cdr; } else if (t == TCHAR || t == TNUMBER) { - long v = VALUE (x); + long v = x->value; while (a != cell_nil) { - if (v == VALUE (CAAR (a))) - return CAR (a); - a = CDR (a); + if (v == a->car->car->value) + return a->car; + a = a->cdr; } } else if (t == TKEYWORD) { while (a != cell_nil) { - if (string_equal_p (x, CAAR (a)) == cell_t) - return CAR (a); - a = CDR (a); + if (string_equal_p (x, a->car->car) == cell_t) + return a->car; + a = a->cdr; } } else /* pointer equality, e.g. on strings. */ while (a != cell_nil) { - if (x == CAAR (a)) - return CAR (a); - a = CDR (a); + if (x == a->car->car) + return a->car; + a = a->cdr; } return cell_f; } -SCM -assoc (SCM x, SCM a) +struct scm * +assoc (struct scm *x, struct scm *a) { - if (TYPE (x) == TSTRING) + if (x->type == TSTRING) return assoc_string (x, a); while (a != cell_nil) { - if (equal2_p (x, CAAR (a)) == cell_t) - return CAR (a); - a = CDR (a); + if (equal2_p (x, a->car->car) == cell_t) + return a->car; + a = a->cdr; } return cell_f; } diff --git a/src/display.c b/src/display.c index bda01a07..adf230ac 100644 --- a/src/display.c +++ b/src/display.c @@ -98,34 +98,34 @@ fdwrite_string (char *s, int length, int fd) fdwrite_string_char (s[i], fd); } -SCM display_helper (SCM x, int cont, char *sep, int fd, int write_p); +struct scm *display_helper (struct scm *x, int cont, char *sep, int fd, int write_p); -SCM -display_helper (SCM x, int cont, char *sep, int fd, int write_p) +struct scm * +display_helper (struct scm *x, int cont, char *sep, int fd, int write_p) { fdputs (sep, fd); if (g_depth == 0) return cell_unspecified; g_depth = g_depth - 1; - int t = TYPE (x); + int t = x->type; if (t == TCHAR) { if (write_p == 0) - fdputc (VALUE (x), fd); + fdputc (x->value, fd); else { fdputs ("#", fd); - fdwrite_char (VALUE (x), fd); + fdwrite_char (x->value, fd); } } else if (t == TCLOSURE) { fdputs ("#cdr->car; + struct scm *name = circ->cdr->car; + struct scm *args = x->cdr->cdr->car; + display_helper (name->car, 0, "", fd, 0); fdputc (' ', fd); display_helper (args, 0, "", fd, 0); fdputs (">", fd); @@ -133,48 +133,48 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p) else if (t == TMACRO) { fdputs ("#cdr, cont, "", fd, 0); fdputs (">", fd); } else if (t == TVARIABLE) { fdputs ("#variable->car, cont, "", fd, 0); fdputs (">", fd); } else if (t == TNUMBER) { - fdputs (itoa (VALUE (x)), fd); + fdputs (itoa (x->value), fd); } else if (t == TPAIR) { if (cont == 0) fdputs ("(", fd); - if (CAR (x) == cell_circular && CADR (x) != cell_closure) + if (x->car == cell_circular && x->cdr->car != cell_closure) { fdputs ("(*circ* . ", fd); int i = 0; - x = CDR (x); + x = x->cdr; while (x != cell_nil && i < 10) { i = i + 1; - fdisplay_ (CAAR (x), fd, write_p); + fdisplay_ (x->car->car, fd, write_p); fdputs (" ", fd); - x = CDR (x); + x = x->cdr; } fdputs (" ...)", fd); } else { if (x != 0 && x != cell_nil) - fdisplay_ (CAR (x), fd, write_p); - if (CDR (x) != 0 && TYPE (CDR (x)) == TPAIR) - display_helper (CDR (x), 1, " ", fd, write_p); - else if (CDR (x) != 0 && CDR (x) != cell_nil) + fdisplay_ (x->car, fd, write_p); + if (x->cdr != 0 && x->cdr->type == TPAIR) + display_helper (x->cdr, 1, " ", fd, write_p); + else if (x->cdr != 0 && x->cdr != cell_nil) { - if (TYPE (CDR (x)) != TPAIR) + if (x->cdr->type != TPAIR) fdputs (" . ", fd); - fdisplay_ (CDR (x), fd, write_p); + fdisplay_ (x->cdr, fd, write_p); } } if (cont == 0) @@ -183,52 +183,52 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p) else if (t == TPORT) { fdputs ("#port), fd); fdputs (" ", fd); - x = STRING (x); + x = x->string; fdputc ('"', fd); - fdwrite_string (cell_bytes (STRING (x)), LENGTH (x), fd); + fdwrite_string (cell_bytes (x->string), x->length, fd); fdputc ('"', fd); fdputs (">", fd); } else if (t == TKEYWORD) { fdputs ("#:", fd); - fdwrite_string (cell_bytes (STRING (x)), LENGTH (x), fd); + fdwrite_string (cell_bytes (x->string), x->length, fd); } else if (t == TSTRING) { if (write_p == 1) { fdputc ('"', fd); - fdwrite_string (cell_bytes (STRING (x)), LENGTH (x), fd); + fdwrite_string (cell_bytes (x->string), x->length, fd); fdputc ('"', fd); } else - fdputs (cell_bytes (STRING (x)), fd); + fdputs (cell_bytes (x->string), fd); } else if (t == TSPECIAL || t == TSYMBOL) - fdwrite_string (cell_bytes (STRING (x)), LENGTH (x), fd); + fdwrite_string (cell_bytes (x->string), x->length, fd); else if (t == TREF) - fdisplay_ (REF (x), fd, write_p); + fdisplay_ (x->ref, fd, write_p); else if (t == TSTRUCT) { - SCM printer = struct_ref_ (x, STRUCT_PRINTER); - if (TYPE (printer) == TREF) - printer = REF (printer); - if (TYPE (printer) == TCLOSURE || builtin_p (printer) == cell_t) + struct scm *printer = struct_ref_ (x, STRUCT_PRINTER); + if (printer->type == TREF) + printer = printer->ref; + if (printer->type == TCLOSURE || builtin_p (printer) == cell_t) apply (printer, cons (x, cell_nil), R0); else { fdputs ("#<", fd); - fdisplay_ (STRUCT (x), fd, write_p); - SCM t = CAR (x); - long size = LENGTH (x); + fdisplay_ (x->structure, fd, write_p); + struct scm *t = x->car; + long size = x->length; long i; for (i = 2; i < size; i = i + 1) { fdputc (' ', fd); - fdisplay_ (cell_ref (STRUCT (x), i), fd, write_p); + fdisplay_ (cell_ref (x->structure, i), fd, write_p); } fdputc ('>', fd); } @@ -236,13 +236,13 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p) else if (t == TVECTOR) { fdputs ("#(", fd); - SCM t = CAR (x); + struct scm *t = x->car; long i; - for (i = 0; i < LENGTH (x); i = i + 1) + for (i = 0; i < x->length; i = i + 1) { if (i != 0) fdputc (' ', fd); - fdisplay_ (cell_ref (VECTOR (x), i), fd, write_p); + fdisplay_ (cell_ref (x->vector, i), fd, write_p); } fdputc (')', fd); } @@ -257,50 +257,50 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p) return cell_unspecified; } -SCM -display_ (SCM x) +struct scm * +display_ (struct scm *x) { g_depth = 5; return display_helper (x, 0, "", __stdout, 0); } -SCM -display_error_ (SCM x) +struct scm * +display_error_ (struct scm *x) { g_depth = 5; return display_helper (x, 0, "", __stderr, 0); } -SCM -display_port_ (SCM x, SCM p) +struct scm * +display_port_ (struct scm *x, struct scm *p) { - assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER"); - return fdisplay_ (x, VALUE (p), 0); + assert_msg (p->type == TNUMBER, "p->type == TNUMBER"); + return fdisplay_ (x, p->value, 0); } -SCM -write_ (SCM x) +struct scm * +write_ (struct scm *x) { g_depth = 5; return display_helper (x, 0, "", __stdout, 1); } -SCM -write_error_ (SCM x) +struct scm * +write_error_ (struct scm *x) { g_depth = 5; return display_helper (x, 0, "", __stderr, 1); } -SCM -write_port_ (SCM x, SCM p) +struct scm * +write_port_ (struct scm *x, struct scm *p) { - assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER"); - return fdisplay_ (x, VALUE (p), 1); + assert_msg (p->type == TNUMBER, "p->type == TNUMBER"); + return fdisplay_ (x, p->value, 1); } -SCM -fdisplay_ (SCM x, int fd, int write_p) /*:((internal)) */ +struct scm * +fdisplay_ (struct scm *x, int fd, int write_p) /*:((internal)) */ { g_depth = 5; return display_helper (x, 0, "", fd, write_p); diff --git a/src/eval-apply.c b/src/eval-apply.c index 6ae8f2ff..c5f47801 100644 --- a/src/eval-apply.c +++ b/src/eval-apply.c @@ -23,20 +23,20 @@ #include -SCM -assert_defined (SCM x, SCM e) /*:((internal)) */ +struct scm * +assert_defined (struct scm *x, struct scm *e) /*:((internal)) */ { if (e == cell_undefined) return error (cell_symbol_unbound_variable, x); return e; } -SCM -check_formals (SCM f, SCM formals, SCM args) /*:((internal)) */ +struct scm * +check_formals (struct scm *f, struct scm *formals, struct scm *args) /*:((internal)) */ { long flen; - if (TYPE (formals) == TNUMBER) - flen = VALUE (formals); + if (formals->type == TNUMBER) + flen = formals->value; else flen = length__ (formals); long alen = length__ (args); @@ -49,14 +49,14 @@ check_formals (SCM f, SCM formals, SCM args) /*:((internal)) */ eputs (itoa (alen)); eputs ("\n"); write_error_ (f); - SCM e = make_string0 (s); + struct scm *e = make_string0 (s); return error (cell_symbol_wrong_number_of_args, cons (e, f)); } return cell_unspecified; } -SCM -check_apply (SCM f, SCM e) /*:((internal)) */ +struct scm * +check_apply (struct scm *f, struct scm *e) /*:((internal)) */ { char *type = 0; if (f == cell_f || f == cell_t) @@ -67,15 +67,15 @@ check_apply (SCM f, SCM e) /*:((internal)) */ type = "*unspecified*"; if (f == cell_undefined) type = "*undefined*"; - if (TYPE (f) == TCHAR) + if (f->type == TCHAR) type = "char"; - if (TYPE (f) == TNUMBER) + if (f->type == TNUMBER) type = "number"; - if (TYPE (f) == TSTRING) + if (f->type == TSTRING) type = "string"; - if (TYPE (f) == TSTRUCT && builtin_p (f) == cell_f) + if (f->type == TSTRUCT && builtin_p (f) == cell_f) type = "#<...>"; - if (TYPE (f) == TBROKEN_HEART) + if (f->type == TBROKEN_HEART) type = "<3"; if (type != 0) @@ -86,104 +86,104 @@ check_apply (SCM f, SCM e) /*:((internal)) */ eputs ("["); write_error_ (e); eputs ("]\n"); - SCM e = make_string0 (s); + struct scm *e = make_string0 (s); return error (cell_symbol_wrong_type_arg, cons (e, f)); } return cell_unspecified; } -SCM -pairlis (SCM x, SCM y, SCM a) +struct scm * +pairlis (struct scm *x, struct scm *y, struct scm *a) { if (x == cell_nil) return a; - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) return cons (cons (x, y), a); return cons (cons (car (x), car (y)), pairlis (cdr (x), cdr (y), a)); } -SCM -set_car_x (SCM x, SCM e) +struct scm * +set_car_x (struct scm *x, struct scm *e) { - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-car!"))); - CAR (x) = e; + x->car = e; return cell_unspecified; } -SCM -set_cdr_x (SCM x, SCM e) +struct scm * +set_cdr_x (struct scm *x, struct scm *e) { - if (TYPE (x) != TPAIR) + if (x->type != TPAIR) error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-cdr!"))); - CDR (x) = e; + x->cdr = e; return cell_unspecified; } -SCM -set_env_x (SCM x, SCM e, SCM a) +struct scm * +set_env_x (struct scm *x, struct scm *e, struct scm *a) { - SCM p; - if (TYPE (x) == TVARIABLE) - p = VARIABLE (x); + struct scm *p; + if (x->type == TVARIABLE) + p = x->variable; else p = assert_defined (x, module_variable (a, x)); - if (TYPE (p) != TPAIR) + if (p->type != TPAIR) error (cell_symbol_not_a_pair, cons (p, x)); return set_cdr_x (p, e); } -SCM -call_lambda (SCM e, SCM x, SCM aa, SCM a) /*:((internal)) */ +struct scm * +call_lambda (struct scm *e, struct scm *x, struct scm *aa, struct scm *a) /*:((internal)) */ { - SCM cl = cons (cons (cell_closure, x), x); + struct scm *cl = cons (cons (cell_closure, x), x); R1 = e; R0 = cl; return cell_unspecified; } -SCM -make_closure_ (SCM args, SCM body, SCM a) /*:((internal)) */ +struct scm * +make_closure_ (struct scm *args, struct scm *body, struct scm *a) /*:((internal)) */ { return make_cell (TCLOSURE, cell_f, cons (cons (cell_circular, a), cons (args, body))); } -SCM -make_variable_ (SCM var) /*:((internal)) */ +struct scm * +make_variable_ (struct scm *var) /*:((internal)) */ { return make_cell (TVARIABLE, var, 0); } -SCM -macro_get_handle (SCM name) /*:((internal)) */ +struct scm * +macro_get_handle (struct scm *name) /*:((internal)) */ { - if (TYPE (name) == TSYMBOL) + if (name->type == TSYMBOL) return hashq_get_handle (g_macros, name, cell_nil); return cell_f; } -SCM -get_macro (SCM name) /*:((internal)) */ +struct scm * +get_macro (struct scm *name) /*:((internal)) */ { - SCM m = macro_get_handle (name); + struct scm *m = macro_get_handle (name); if (m != cell_f) { - SCM d = CDR (m); - return MACRO (d); + struct scm *d = m->cdr; + return d->macro; } return cell_f; } -SCM -macro_set_x (SCM name, SCM value) /*:((internal)) */ +struct scm * +macro_set_x (struct scm *name, struct scm *value) /*:((internal)) */ { return hashq_set_x (g_macros, name, value); } -SCM -push_cc (SCM p1, SCM p2, SCM a, SCM c) /*:((internal)) */ +struct scm * +push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c) /*:((internal)) */ { - SCM x = R3; + struct scm *x = R3; R3 = c; R2 = p2; gc_push_frame (); @@ -193,159 +193,159 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) /*:((internal)) */ return cell_unspecified; } -SCM -add_formals (SCM formals, SCM x) +struct scm * +add_formals (struct scm *formals, struct scm *x) { - while (TYPE (x) == TPAIR) + while (x->type == TPAIR) { - formals = cons (CAR (x), formals); - x = CDR (x); + formals = cons (x->car, formals); + x = x->cdr; } - if (TYPE (x) == TSYMBOL) + if (x->type == TSYMBOL) formals = cons (x, formals); return formals; } int -formal_p (SCM x, SCM formals) /*:((internal)) */ +formal_p (struct scm *x, struct scm *formals) /*:((internal)) */ { - if (TYPE (formals) == TSYMBOL) + if (formals->type == TSYMBOL) { if (x == formals) return 1; else return 0; } - while (TYPE (formals) == TPAIR) + while (formals->type == TPAIR) { - if (CAR (formals) == x) + if (formals->car == x) break; - formals = CDR (formals); + formals = formals->cdr; } - if (TYPE (formals) == TSYMBOL) + if (formals->type == TSYMBOL) return formals == x; - return TYPE (formals) == TPAIR; + return formals->type == TPAIR; } -SCM -expand_variable_ (SCM x, SCM formals, int top_p) /*:((internal)) */ +struct scm * +expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((internal)) */ { - while (TYPE (x) == TPAIR) + while (x->type == TPAIR) { - SCM a = CAR (x); - if (TYPE (a) == TPAIR) + struct scm *a = x->car; + if (a->type == TPAIR) { - if (CAR (a) == cell_symbol_lambda) + if (a->car == cell_symbol_lambda) { - SCM f = CADR (a); + struct scm *f = a->cdr->car; formals = add_formals (formals, f); } - else if (CAR (a) == cell_symbol_define || CAR (a) == cell_symbol_define_macro) + else if (a->car == cell_symbol_define || a->car == cell_symbol_define_macro) { - SCM f = CADR (a); + struct scm *f = a->cdr->car; formals = add_formals (formals, f); } - if (CAR (a) != cell_symbol_quote) + if (a->car != cell_symbol_quote) expand_variable_ (a, formals, 0); } else { if (a == cell_symbol_lambda) { - SCM f = CADR (x); + struct scm *f = x->cdr->car; formals = add_formals (formals, f); - x = CDR (x); + x = x->cdr; } else if (a == cell_symbol_define || a == cell_symbol_define_macro) { - SCM f = CADR (x); - if (top_p != 0 && TYPE (f) == TPAIR) - f = CDR (f); + struct scm *f = x->cdr->car; + if (top_p != 0 && f->type == TPAIR) + f = f->cdr; formals = add_formals (formals, f); - x = CDR (x); + x = x->cdr; } else if (a == cell_symbol_quote) return cell_unspecified; - else if (TYPE (a) == TSYMBOL + else if (a->type == TSYMBOL && a != cell_symbol_boot_module && a != cell_symbol_current_module && a != cell_symbol_primitive_load - && formal_p (CAR (x), formals) == 0) + && formal_p (x->car, formals) == 0) { - SCM v = module_variable (R0, a); + struct scm *v = module_variable (R0, a); if (v != cell_f) - CAR (x) = make_variable_ (v); + x->car = make_variable_ (v); } } - x = CDR (x); + x = x->cdr; top_p = 0; } return cell_unspecified; } -SCM -expand_variable (SCM x, SCM formals) /*:((internal)) */ +struct scm * +expand_variable (struct scm *x, struct scm *formals) /*:((internal)) */ { return expand_variable_ (x, formals, 1); } -SCM -apply_builtin (SCM fn, SCM x) /*:((internal)) */ +struct scm * +apply_builtin (struct scm *fn, struct scm *x) /*:((internal)) */ { - SCM a = builtin_arity (fn); - int arity = VALUE (a); + struct scm *a = builtin_arity (fn); + int arity = a->value; if ((arity > 0 || arity == -1) && x != cell_nil) { - SCM a = CAR (x); - if (TYPE (a) == TVALUES) - x = cons (CADR (a), CDR (x)); + struct scm *a = x->car; + if (a->type == TVALUES) + x = cons (a->cdr->car, x->cdr); } if ((arity > 1 || arity == -1) && x != cell_nil) { - SCM a = CAR (x); - SCM d = CDR (x); - if (TYPE (d) == TPAIR) - if (TYPE (CAR (d)) == TVALUES) - x = cons (a, cons (CADAR (d), d)); + struct scm *a = x->car; + struct scm *d = x->cdr; + if (d->type == TPAIR) + if (d->car->type == TVALUES) + x = cons (a, cons (d->car->cdr->car, d)); } if (arity == 0) return apply_builtin0 (fn); if (arity == 1) - return apply_builtin1 (fn, CAR (x)); + return apply_builtin1 (fn, x->car); else if (arity == 2) - return apply_builtin2 (fn, CAR (x), CADR (x)); + return apply_builtin2 (fn, x->car, x->cdr->car); else if (arity == 3) - return apply_builtin3 (fn, CAR (x), CADR (x), CAR (CDDR (x))); + return apply_builtin3 (fn, x->car, x->cdr->car, x->cdr->cdr->car); else if (arity == -1) return apply_builtin1 (fn, x); return cell_unspecified; } -SCM +struct scm * eval_apply () { - SCM aa; - SCM args; - SCM body; - SCM cl; - SCM entry; - SCM expanders; - SCM formals; - SCM input; - SCM name; - SCM macro; - SCM p; - SCM program; - SCM sc_expand; - SCM v; - SCM x; + struct scm *aa; + struct scm *args; + struct scm *body; + struct scm *cl; + struct scm *entry; + struct scm *expanders; + struct scm *formals; + struct scm *input; + struct scm *name; + struct scm *macro; + struct scm *p; + struct scm *program; + struct scm *sc_expand; + struct scm *v; + struct scm *x; int global_p; int macro_p; - SCM a; - SCM c; - SCM d; + struct scm *a; + struct scm *c; + struct scm *d; int t; long i; @@ -425,87 +425,87 @@ eval_apply: evlis: if (R1 == cell_nil) goto vm_return; - if (TYPE (R1) != TPAIR) + if (R1->type != TPAIR) goto eval; - push_cc (CAR (R1), R1, R0, cell_vm_evlis2); + push_cc (R1->car, R1, R0, cell_vm_evlis2); goto eval; evlis2: - push_cc (CDR (R2), R1, R0, cell_vm_evlis3); + push_cc (R2->cdr, R1, R0, cell_vm_evlis3); goto evlis; evlis3: R1 = cons (R2, R1); goto vm_return; apply: - g_stack_array[g_stack + FRAME_PROCEDURE] = CAR (R1); - a = CAR (R1); - t = TYPE (a); - if (t == TSTRUCT && builtin_p (CAR (R1)) == cell_t) + g_stack_array[g_stack + FRAME_PROCEDURE] = R1->car; + a = R1->car; + t = a->type; + if (t == TSTRUCT && builtin_p (R1->car) == cell_t) { - check_formals (CAR (R1), builtin_arity (CAR (R1)), CDR (R1)); - R1 = apply_builtin (CAR (R1), CDR (R1)); + check_formals (R1->car, builtin_arity (R1->car), R1->cdr); + R1 = apply_builtin (R1->car, R1->cdr); goto vm_return; } else if (t == TCLOSURE) { - cl = CLOSURE (CAR (R1)); - body = CDDR (cl); - formals = CADR (cl); - args = CDR (R1); - aa = CDAR (cl); - aa = CDR (aa); - check_formals (CAR (R1), formals, CDR (R1)); + cl = R1->car->closure; + body = cl->cdr->cdr; + formals = cl->cdr->car; + args = R1->cdr; + aa = cl->car->cdr; + aa = aa->cdr; + check_formals (R1->car, formals, R1->cdr); p = pairlis (formals, args, aa); call_lambda (body, p, aa, R0); goto begin; } else if (t == TCONTINUATION) { - a = CAR (R1); - v = CONTINUATION (a); - if (LENGTH (v) != 0) + a = R1->car; + v = a->continuation; + if (v->length != 0) { - for (i = 0; i < LENGTH (v); i = i + 1) - g_stack_array[STACK_SIZE - LENGTH (v) + i] = vector_ref_ (v, i); - g_stack = STACK_SIZE - LENGTH (v); + for (i = 0; i < v->length; i = i + 1) + g_stack_array[STACK_SIZE - v->length + i] = vector_ref_ (v, i); + g_stack = STACK_SIZE - v->length; } x = R1; gc_pop_frame (); - R1 = CADR (x); + R1 = x->cdr->car; goto eval_apply; } else if (t == TSPECIAL) { - c = CAR (R1); + c = R1->car; if (c == cell_vm_apply) { - push_cc (cons (CADR (R1), CADDR (R1)), R1, R0, cell_vm_return); + push_cc (cons (R1->cdr->car, R1->cdr->cdr->car), R1, R0, cell_vm_return); goto apply; } else if (c == cell_vm_eval) { - push_cc (CADR (R1), R1, CADDR (R1), cell_vm_return); + push_cc (R1->cdr->car, R1, R1->cdr->cdr->car, cell_vm_return); goto eval; } else if (c == cell_vm_begin_expand) { - push_cc (cons (CADR (R1), cell_nil), R1, CADDR (R1), cell_vm_return); + push_cc (cons (R1->cdr->car, cell_nil), R1, R1->cdr->cdr->car, cell_vm_return); goto begin_expand; } else - check_apply (cell_f, CAR (R1)); + check_apply (cell_f, R1->car); } else if (t == TSYMBOL) { - c = CAR (R1); + c = R1->car; if (c == cell_symbol_call_with_current_continuation) { - R1 = CDR (R1); + R1 = R1->cdr; goto call_with_current_continuation; } if (c == cell_symbol_call_with_values) { - R1 = CDR (R1); + R1 = R1->cdr; goto call_with_values; } if (c == cell_symbol_current_module) @@ -521,79 +521,79 @@ apply: } else if (t == TPAIR) { - if (CAAR (R1) == cell_symbol_lambda) + if (R1->car->car == cell_symbol_lambda) { - formals = CADAR (R1); - args = CDR (R1); - body = CDDAR (R1); - p = pairlis (formals, CDR (R1), R0); + formals = R1->car->cdr->car; + args = R1->cdr; + body = R1->car->cdr->cdr; + p = pairlis (formals, R1->cdr, R0); check_formals (R1, formals, args); call_lambda (body, p, p, R0); goto begin; } } - push_cc (CAR (R1), R1, R0, cell_vm_apply2); + push_cc (R1->car, R1, R0, cell_vm_apply2); goto eval; apply2: - check_apply (R1, CAR (R2)); - R1 = cons (R1, CDR (R2)); + check_apply (R1, R2->car); + R1 = cons (R1, R2->cdr); goto apply; eval: - t = TYPE (R1); + t = R1->type; if (t == TPAIR) { - c = CAR (R1); + c = R1->car; if (c == cell_symbol_pmatch_car) { - push_cc (CADR (R1), R1, R0, cell_vm_eval_pmatch_car); + push_cc (R1->cdr->car, R1, R0, cell_vm_eval_pmatch_car); goto eval; eval_pmatch_car: x = R1; gc_pop_frame (); - R1 = CAR (x); + R1 = x->car; goto eval_apply; } else if (c == cell_symbol_pmatch_cdr) { - push_cc (CADR (R1), R1, R0, cell_vm_eval_pmatch_cdr); + push_cc (R1->cdr->car, R1, R0, cell_vm_eval_pmatch_cdr); goto eval; eval_pmatch_cdr: x = R1; gc_pop_frame (); - R1 = CDR (x); + R1 = x->cdr; goto eval_apply; } else if (c == cell_symbol_quote) { x = R1; gc_pop_frame (); - R1 = CADR (x); + R1 = x->cdr->car; goto eval_apply; } else if (c == cell_symbol_begin) goto begin; else if (c == cell_symbol_lambda) { - R1 = make_closure_ (CADR (R1), CDDR (R1), R0); + R1 = make_closure_ (R1->cdr->car, R1->cdr->cdr, R0); goto vm_return; } else if (c == cell_symbol_if) { - R1 = CDR (R1); + R1 = R1->cdr; goto vm_if; } else if (c == cell_symbol_set_x) { - push_cc (CADDR (R1), R1, R0, cell_vm_eval_set_x); + push_cc (R1->cdr->cdr->car, R1, R0, cell_vm_eval_set_x); goto eval; eval_set_x: - R1 = set_env_x (CADR (R2), R1, R0); + R1 = set_env_x (R2->cdr->car, R1, R0); goto vm_return; } else if (c == cell_vm_macro_expand) { - push_cc (CADR (R1), R1, R0, cell_vm_eval_macro_expand_eval); + push_cc (R1->cdr->car, R1, R0, cell_vm_eval_macro_expand_eval); goto eval; eval_macro_expand_eval: push_cc (R1, R2, R0, cell_vm_eval_macro_expand_expand); @@ -603,21 +603,21 @@ eval: } else { - if (TYPE (R1) == TPAIR) - if (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro) + if (R1->type == TPAIR) + if (R1->car == cell_symbol_define || R1->car == cell_symbol_define_macro) { global_p = 0; - if (CAAR (R0) != cell_closure) + if (R0->car->car != cell_closure) global_p = 1; macro_p = 0; - if (CAR (R1) == cell_symbol_define_macro) + if (R1->car == cell_symbol_define_macro) macro_p = 1; if (global_p != 0) { - name = CADR (R1); - aa = CADR (R1); - if (TYPE (aa) == TPAIR) - name = CAR (name); + name = R1->cdr->car; + aa = R1->cdr->car; + if (aa->type == TPAIR) + name = name->car; if (macro_p != 0) { entry = assq (name, g_macros); @@ -632,17 +632,17 @@ eval: } } R2 = R1; - aa = CADR (R1); - if (TYPE (aa) != TPAIR) + aa = R1->cdr->car; + if (aa->type != TPAIR) { - push_cc (CADDR (R1), R2, cons (cons (CADR (R1), CADR (R1)), R0), cell_vm_eval_define); + push_cc (R1->cdr->cdr->car, R2, cons (cons (R1->cdr->car, R1->cdr->car), R0), cell_vm_eval_define); goto eval; } else { - p = pairlis (CADR (R1), CADR (R1), R0); - formals = CDADR (R1); - body = CDDR (R1); + p = pairlis (R1->cdr->car, R1->cdr->car, R0); + formals = R1->cdr->car->cdr; + body = R1->cdr->cdr; if (macro_p != 0 || global_p != 0) expand_variable (body, formals); @@ -651,10 +651,10 @@ eval: goto eval; } eval_define: - name = CADR (R2); - aa = CADR (R2); - if (TYPE (aa) == TPAIR) - name = CAR (name); + name = R2->cdr->car; + aa = R2->cdr->car; + if (aa->type == TPAIR) + name = name->car; if (macro_p != 0) { entry = macro_get_handle (name); @@ -678,14 +678,14 @@ eval: R1 = cell_unspecified; goto vm_return; } - push_cc (CAR (R1), R1, R0, cell_vm_eval_check_func); + push_cc (R1->car, R1, R0, cell_vm_eval_check_func); gc_check (); goto eval; eval_check_func: - push_cc (CDR (R2), R2, R0, cell_vm_eval2); + push_cc (R2->cdr, R2, R0, cell_vm_eval2); goto evlis; eval2: - R1 = cons (CAR (R2), R1); + R1 = cons (R2->car, R1); goto apply; } } @@ -704,8 +704,8 @@ eval: } else if (t == TVARIABLE) { - x = VARIABLE (R1); - R1 = CDR (x); + x = R1->variable; + R1 = x->cdr; goto vm_return; } else if (t == TBROKEN_HEART) @@ -714,38 +714,38 @@ eval: goto vm_return; macro_expand: - if (TYPE (R1) != TPAIR || CAR (R1) == cell_symbol_quote) + if (R1->type != TPAIR || R1->car == cell_symbol_quote) goto vm_return; - if (CAR (R1) == cell_symbol_lambda) + if (R1->car == cell_symbol_lambda) { - push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_lambda); + push_cc (R1->cdr->cdr, R1, R0, cell_vm_macro_expand_lambda); goto macro_expand; macro_expand_lambda: - CDDR (R2) = R1; + R2->cdr->cdr = R1; R1 = R2; goto vm_return; } - if (TYPE (R1) == TPAIR) + if (R1->type == TPAIR) { - macro = get_macro (CAR (R1)); + macro = get_macro (R1->car); if (macro != cell_f) { - R1 = cons (macro, CDR (R1)); + R1 = cons (macro, R1->cdr); push_cc (R1, cell_nil, R0, cell_vm_macro_expand); goto apply; } } - if (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro) + if (R1->car == cell_symbol_define || R1->car == cell_symbol_define_macro) { - push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_define); + push_cc (R1->cdr->cdr, R1, R0, cell_vm_macro_expand_define); goto macro_expand; macro_expand_define: - CDDR (R2) = R1; + R2->cdr->cdr = R1; R1 = R2; - if (CAR (R1) == cell_symbol_define_macro) + if (R1->car == cell_symbol_define_macro) { push_cc (R1, R1, R0, cell_vm_macro_expand_define_macro); goto eval; @@ -755,20 +755,20 @@ macro_expand: goto vm_return; } - if (CAR (R1) == cell_symbol_set_x) + if (R1->car == cell_symbol_set_x) { - push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_set_x); + push_cc (R1->cdr->cdr, R1, R0, cell_vm_macro_expand_set_x); goto macro_expand; macro_expand_set_x: - CDDR (R2) = R1; + R2->cdr->cdr = R1; R1 = R2; goto vm_return; } - if (TYPE (R1) == TPAIR) + if (R1->type == TPAIR) { - a = CAR (R1); - if (TYPE (a) == TSYMBOL && a != cell_symbol_begin) + a = R1->car; + if (a->type == TSYMBOL && a != cell_symbol_begin) { macro = macro_get_handle (cell_symbol_portable_macro_expand); if (macro != cell_f) @@ -776,7 +776,7 @@ macro_expand: expanders = module_ref (R0, cell_symbol_sc_expander_alist); if (expanders != cell_undefined) { - macro = assq (CAR (R1), expanders); + macro = assq (R1->car, expanders); if (macro != cell_f) { sc_expand = module_ref (R0, cell_symbol_macro_expand); @@ -792,20 +792,20 @@ macro_expand: } } - push_cc (CAR (R1), R1, R0, cell_vm_macro_expand_car); + push_cc (R1->car, R1, R0, cell_vm_macro_expand_car); goto macro_expand; macro_expand_car: - CAR (R2) = R1; + R2->car = R1; R1 = R2; - if (CDR (R1) == cell_nil) + if (R1->cdr == cell_nil) goto vm_return; - push_cc (CDR (R1), R1, R0, cell_vm_macro_expand_cdr); + push_cc (R1->cdr, R1, R0, cell_vm_macro_expand_cdr); goto macro_expand; macro_expand_cdr: - CDR (R2) = R1; + R2->cdr = R1; R1 = R2; goto vm_return; @@ -815,38 +815,38 @@ begin: while (R1 != cell_nil) { gc_check (); - if (TYPE (R1) == TPAIR) + if (R1->type == TPAIR) { - if (CAAR (R1) == cell_symbol_primitive_load) + if (R1->car->car == cell_symbol_primitive_load) { - program = cons (CAR (R1), cell_nil); + program = cons (R1->car, cell_nil); push_cc (program, R1, R0, cell_vm_begin_primitive_load); goto begin_expand; begin_primitive_load: - CAR (R2) = R1; + R2->car = R1; R1 = R2; } } - if (TYPE (R1) == TPAIR) + if (R1->type == TPAIR) { - a = CAR (R1); - if (TYPE (a) == TPAIR) + a = R1->car; + if (a->type == TPAIR) { - if (CAR (a) == cell_symbol_begin) - R1 = append2 (CDR (a), CDR (R1)); + if (a->car == cell_symbol_begin) + R1 = append2 (a->cdr, R1->cdr); } } - if (CDR (R1) == cell_nil) + if (R1->cdr == cell_nil) { - R1 = CAR (R1); + R1 = R1->car; goto eval; } - push_cc (CAR (R1), R1, R0, cell_vm_begin_eval); + push_cc (R1->car, R1, R0, cell_vm_begin_eval); goto eval; begin_eval: x = R1; - R1 = CDR (R2); + R1 = R2->cdr; } R1 = x; goto vm_return; @@ -859,22 +859,22 @@ begin_expand: begin_expand_while: gc_check (); - if (TYPE (R1) == TPAIR) + if (R1->type == TPAIR) { - a = CAR (R1); - if (TYPE (a) == TPAIR) - if (CAAR (R1) == cell_symbol_begin) - R1 = append2 (CDAR (R1), CDR (R1)); - if (CAAR (R1) == cell_symbol_primitive_load) + a = R1->car; + if (a->type == TPAIR) + if (R1->car->car == cell_symbol_begin) + R1 = append2 (R1->car->cdr, R1->cdr); + if (R1->car->car == cell_symbol_primitive_load) { - push_cc (CADAR (R1), R1, R0, cell_vm_begin_expand_primitive_load); + push_cc (R1->car->cdr->car, R1, R0, cell_vm_begin_expand_primitive_load); goto eval; begin_expand_primitive_load: - if ((TYPE (R1) == TNUMBER) && VALUE (R1) == 0) + if ((R1->type == TNUMBER) && R1->value == 0) 0; - else if (TYPE (R1) == TSTRING) + else if (R1->type == TSTRING) input = set_current_input_port (open_input_file (R1)); - else if (TYPE (R1) == TPORT) + else if (R1->type == TPORT) input = set_current_input_port (R1); else { @@ -892,48 +892,48 @@ begin_expand: R1 = x; set_current_input_port (input); R1 = cons (cell_symbol_begin, R1); - CAR (R2) = R1; + R2->car = R1; R1 = R2; goto begin_expand_while; continue; /* FIXME: M2-PLanet */ } } - push_cc (CAR (R1), R1, R0, cell_vm_begin_expand_macro); + push_cc (R1->car, R1, R0, cell_vm_begin_expand_macro); goto macro_expand; begin_expand_macro: - if (R1 != CAR (R2)) + if (R1 != R2->car) { - CAR (R2) = R1; + R2->car = R1; R1 = R2; goto begin_expand_while; continue; /* FIXME: M2-PLanet */ } R1 = R2; - expand_variable (CAR (R1), cell_nil); - push_cc (CAR (R1), R1, R0, cell_vm_begin_expand_eval); + expand_variable (R1->car, cell_nil); + push_cc (R1->car, R1, R0, cell_vm_begin_expand_eval); goto eval; begin_expand_eval: x = R1; - R1 = CDR (R2); + R1 = R2->cdr; } R1 = x; goto vm_return; vm_if: - push_cc (CAR (R1), R1, R0, cell_vm_if_expr); + push_cc (R1->car, R1, R0, cell_vm_if_expr); goto eval; if_expr: x = R1; R1 = R2; if (x != cell_f) { - R1 = CADR (R1); + R1 = R1->cdr->car; goto eval; } - if (CDDR (R1) != cell_nil) + if (R1->cdr->cdr != cell_nil) { - R1 = CAR (CDDR (R1)); + R1 = R1->cdr->cdr->car; goto eval; } R1 = cell_unspecified; @@ -946,24 +946,24 @@ call_with_current_continuation: v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified); for (i = g_stack; i < STACK_SIZE; i = i + 1) vector_set_x_ (v, i - g_stack, g_stack_array[i]); - CONTINUATION (x) = v; + x->continuation = v; gc_pop_frame (); - push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2); + push_cc (cons (R1->car, cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2); goto apply; call_with_current_continuation2: v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified); for (i = g_stack; i < STACK_SIZE; i = i + 1) vector_set_x_ (v, i - g_stack, g_stack_array[i]); - CONTINUATION (R2) = v; + R2->continuation = v; goto vm_return; call_with_values: - push_cc (cons (CAR (R1), cell_nil), R1, R0, cell_vm_call_with_values2); + push_cc (cons (R1->car, cell_nil), R1, R0, cell_vm_call_with_values2); goto apply; call_with_values2: - if (TYPE (R1) == TVALUES) - R1 = CDR (R1); - R1 = cons (CADR (R2), R1); + if (R1->type == TVALUES) + R1 = R1->cdr; + R1 = cons (R2->cdr->car, R1); goto apply; vm_return: @@ -973,8 +973,8 @@ vm_return: goto eval_apply; } -SCM -apply (SCM f, SCM x, SCM a) /*:((internal)) */ +struct scm * +apply (struct scm *f, struct scm *x, struct scm *a) /*:((internal)) */ { push_cc (cons (f, x), cell_unspecified, R0, cell_unspecified); R3 = cell_vm_apply; diff --git a/src/gc.c b/src/gc.c index faa90e70..47b47539 100644 --- a/src/gc.c +++ b/src/gc.c @@ -32,14 +32,14 @@ int g_dump_filedes; // CONSTANT M2_CELL_SIZE 12 char * -cell_bytes (SCM x) +cell_bytes (struct scm *x) { char *p = x; return p + (2 * sizeof (long)); } char * -news_bytes (SCM x) +news_bytes (struct scm *x) { char *p = x; return p + (2 * sizeof (long)); @@ -98,12 +98,12 @@ gc_init () g_cells = g_cells + M2_CELL_SIZE; /* Hmm? */ - TYPE (cell_arena) = TVECTOR; - LENGTH (cell_arena) = 1000; - VECTOR (cell_arena) = cell_zero; + cell_arena->type = TVECTOR; + cell_arena->length = 1000; + cell_arena->vector = cell_zero; - TYPE (cell_zero) = TCHAR; - VALUE (cell_zero) = 'c'; + cell_zero->type = TCHAR; + cell_zero->value = 'c'; g_free = g_cells + M2_CELL_SIZE; @@ -128,10 +128,10 @@ gc_stats_ (char const* where) eputs ("]\n"); } -SCM +struct scm * alloc (long n) { - SCM x = g_free; + struct scm *x = g_free; g_free = g_free + (n * M2_CELL_SIZE); long i = g_free - g_cells; i = i / M2_CELL_SIZE; @@ -141,51 +141,51 @@ alloc (long n) return x; } -SCM -make_cell (long type, SCM car, SCM cdr) +struct scm * +make_cell (long type, struct scm *car, struct scm *cdr) { - SCM x = g_free; + struct scm *x = g_free; g_free = g_free + M2_CELL_SIZE; long i = g_free - g_cells; i = i / M2_CELL_SIZE; if (i > ARENA_SIZE) assert_msg (0, "alloc: out of memory"); - TYPE (x) = type; - CAR (x) = car; - CDR (x) = cdr; + x->type = type; + x->car = car; + x->cdr = cdr; return x; } void -copy_cell (SCM to, SCM from) +copy_cell (struct scm *to, struct scm *from) { - TYPE (to) = TYPE (from); - CAR (to) = CAR (from); - CDR (to) = CDR (from); + to->type = from->type; + to->car = from->car; + to->cdr = from->cdr; } void -copy_news (SCM to, SCM from) +copy_news (struct scm *to, struct scm *from) { - NTYPE (to) = TYPE (from); - NCAR (to) = CAR (from); - NCDR (to) = CDR (from); + to->type = from->type; + to->car = from->car; + to->cdr = from->cdr; } void -copy_stack (long index, SCM from) +copy_stack (long index, struct scm *from) { g_stack_array[index] = from; } -SCM -cell_ref (SCM cell, long index) +struct scm * +cell_ref (struct scm *cell, long index) { return cell + (index * M2_CELL_SIZE); } -SCM -cons (SCM x, SCM y) +struct scm * +cons (struct scm *x, struct scm *y) { return make_cell (TPAIR, x, y); } @@ -193,16 +193,16 @@ cons (SCM x, SCM y) size_t bytes_cells (size_t length) { - return (sizeof (long) + sizeof (long) + length - 1 + sizeof (SCM)) / sizeof (SCM); + return (sizeof (long) + sizeof (long) + length - 1 + sizeof (struct scm *)) / sizeof (struct scm *); } -SCM +struct scm * make_bytes (char const *s, size_t length) { size_t size = bytes_cells (length); - SCM x = alloc (size); - TYPE (x) = TBYTES; - LENGTH (x) = length; + struct scm *x = alloc (size); + x->type = TBYTES; + x->length = length; char *p = cell_bytes (x); if (length == 0) p[0] = 0; @@ -212,55 +212,55 @@ make_bytes (char const *s, size_t length) return x; } -SCM +struct scm * make_char (int n) { return make_cell (TCHAR, 0, n); } -SCM +struct scm * make_continuation (long n) { return make_cell (TCONTINUATION, n, g_stack); } -SCM -make_macro (SCM name, SCM x) /*:((internal)) */ +struct scm * +make_macro (struct scm *name, struct scm *x) /*:((internal)) */ { - return make_cell (TMACRO, x, STRING (name)); + return make_cell (TMACRO, x, name->string); } -SCM +struct scm * make_number (long n) { return make_cell (TNUMBER, 0, n); } -SCM -make_ref (SCM x) /*:((internal)) */ +struct scm * +make_ref (struct scm *x) /*:((internal)) */ { return make_cell (TREF, x, 0); } -SCM +struct scm * make_string (char const *s, size_t length) { if (length > MAX_STRING) assert_max_string (length, "make_string", s); - SCM x = make_cell (TSTRING, length, 0); - SCM v = make_bytes (s, length + 1); - CDR (x) = v; + struct scm *x = make_cell (TSTRING, length, 0); + struct scm *v = make_bytes (s, length + 1); + x->cdr = v; return x; } -SCM +struct scm * make_string0 (char const *s) { return make_string (s, strlen (s)); } -SCM -make_string_port (SCM x) /*:((internal)) */ +struct scm * +make_string_port (struct scm *x) /*:((internal)) */ { return make_cell (TPORT, -length__ (g_ports) - 2, x); } @@ -269,17 +269,17 @@ void gc_init_news () { g_news = g_free; - SCM ncell_arena = g_news; - SCM ncell_zero = ncell_arena + M2_CELL_SIZE; + struct scm *ncell_arena = g_news; + struct scm *ncell_zero = ncell_arena + M2_CELL_SIZE; g_news = g_news + M2_CELL_SIZE; - NTYPE (ncell_arena) = TVECTOR; - NLENGTH (ncell_arena) = LENGTH (cell_arena); - NVECTOR (ncell_arena) = g_news; + ncell_arena->type = TVECTOR; + ncell_arena->length = cell_arena->length; + ncell_arena->vector = g_news; - NTYPE (ncell_zero) = TCHAR; - NVALUE (ncell_zero) = 'n'; + ncell_zero->type = TCHAR; + ncell_zero->value = 'n'; } void @@ -311,7 +311,7 @@ gc_up_arena () exit (1); } g_cells = p; - memcpy (p + stack_offset, p + old_arena_bytes, STACK_SIZE * sizeof (SCM)); + memcpy (p + stack_offset, p + old_arena_bytes, STACK_SIZE * sizeof (struct scm *)); g_cells = g_cells + M2_CELL_SIZE; } @@ -423,29 +423,29 @@ gc_flip () gc_stats_ (";;; => jam"); } -SCM -gc_copy (SCM old) /*:((internal)) */ +struct scm * +gc_copy (struct scm *old) /*:((internal)) */ { - if (TYPE (old) == TBROKEN_HEART) - return CAR (old); - SCM new = g_free; + if (old->type == TBROKEN_HEART) + return old->car; + struct scm *new = g_free; g_free = g_free + M2_CELL_SIZE; copy_news (new, old); - if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR) + if (new->type == TSTRUCT || new->type == TVECTOR) { - NVECTOR (new) = g_free; + new->vector = g_free; long i; - for (i = 0; i < LENGTH (old); i = i + 1) + for (i = 0; i < old->length; i = i + 1) { - copy_news (g_free, cell_ref (VECTOR (old), i)); + copy_news (g_free, cell_ref (old->vector, i)); g_free = g_free + M2_CELL_SIZE; } } - else if (NTYPE (new) == TBYTES) + else if (new->type == TBYTES) { char const *src = cell_bytes (old); char *dest = news_bytes (new); - size_t length = NLENGTH (new); + size_t length = new->length; memcpy (dest, src, length); g_free = g_free + ((bytes_cells (length) - 1) * M2_CELL_SIZE); @@ -455,43 +455,43 @@ gc_copy (SCM old) /*:((internal)) */ eputs (src); eputs ("\n"); eputs (" length: "); - eputs (ltoa (LENGTH (old))); + eputs (ltoa (old->length)); eputs ("\n"); eputs (" nlength: "); - eputs (ltoa (NLENGTH (new))); + eputs (ltoa (new->length)); eputs ("\n"); eputs (" ==> "); eputs (dest); eputs ("\n"); } } - TYPE (old) = TBROKEN_HEART; - CAR (old) = new; + old->type = TBROKEN_HEART; + old->car = new; return new; } -SCM -gc_relocate_car (SCM new, SCM car) /*:((internal)) */ +struct scm * +gc_relocate_car (struct scm *new, struct scm *car) /*:((internal)) */ { - NCAR (new) = car; + new->car = car; return cell_unspecified; } -SCM -gc_relocate_cdr (SCM new, SCM cdr) /*:((internal)) */ +struct scm * +gc_relocate_cdr (struct scm *new, struct scm *cdr) /*:((internal)) */ { - NCDR (new) = cdr; + new->cdr = cdr; return cell_unspecified; } void -gc_loop (SCM scan) +gc_loop (struct scm *scan) { - SCM car; - SCM cdr; + struct scm *car; + struct scm *cdr; while (scan < g_free) { - long t = NTYPE (scan); + long t = scan->type; if (t == TBROKEN_HEART) assert_msg (0, "gc_loop: broken heart"); /* *INDENT-OFF* */ @@ -501,7 +501,7 @@ gc_loop (SCM scan) || t == TVARIABLE) /* *INDENT-ON* */ { - car = gc_copy (NCAR (scan)); + car = gc_copy (scan->car); gc_relocate_car (scan, car); } /* *INDENT-OFF* */ @@ -520,18 +520,18 @@ gc_loop (SCM scan) ) /* *INDENT-ON* */ { - cdr = gc_copy (NCDR (scan)); + cdr = gc_copy (scan->cdr); gc_relocate_cdr (scan, cdr); } if (t == TBYTES) - scan = scan + (bytes_cells (NLENGTH (scan)) * M2_CELL_SIZE); + scan = scan + (bytes_cells (scan->length) * M2_CELL_SIZE); else scan = scan + M2_CELL_SIZE; } gc_flip (); } -SCM +struct scm * gc_check () { long used = ((g_free - g_cells) / M2_CELL_SIZE) + GC_SAFETY; @@ -574,8 +574,8 @@ gc_ () gc_up_arena (); } - SCM new_cell_nil = g_free; - SCM s; + struct scm *new_cell_nil = g_free; + struct scm *s; for (s = cell_nil; s < g_symbol_max; s = s + M2_CELL_SIZE) gc_copy (s); @@ -591,7 +591,7 @@ gc_ () gc_loop (new_cell_nil); } -SCM +struct scm * gc () { if (getenv ("MES_DUMP") != 0) @@ -665,7 +665,7 @@ dumps (char const *s) } void -gc_dump_register (char const* n, SCM r) +gc_dump_register (char const* n, struct scm *r) { dumps (n); dumps (": "); long i = r; @@ -706,7 +706,7 @@ gc_dump_stack () void gc_dump_arena (struct scm *cells, long size) { - SCM end = g_cells + (size * M2_CELL_SIZE); + struct scm *end = g_cells + (size * M2_CELL_SIZE); struct scm *dist = cells; if (g_dump_filedes == 0) g_dump_filedes = mes_open ("dump.mo", O_CREAT|O_WRONLY, 0644); @@ -714,7 +714,7 @@ gc_dump_arena (struct scm *cells, long size) dumps ("size="); dumps (ltoa (size)); dumpc ('\n'); gc_dump_state (); gc_dump_stack (); - while (TYPE (end) == 0 && CAR (end) == 0 && CDR (end) == 0) + while (end->type == 0 && end->car == 0 && end->cdr == 0) { end = end - M2_CELL_SIZE; size = size - 1; diff --git a/src/hash.c b/src/hash.c index f6e0e68a..64305879 100644 --- a/src/hash.c +++ b/src/hash.c @@ -36,116 +36,116 @@ hash_cstring (char const *s, long size) } int -hashq_ (SCM x, long size) +hashq_ (struct scm *x, long size) { - if (TYPE (x) == TSPECIAL || TYPE (x) == TSYMBOL) - return hash_cstring (cell_bytes (STRING (x)), size); /* FIXME: hash x directly. */ + if (x->type == TSPECIAL || x->type == TSYMBOL) + return hash_cstring (cell_bytes (x->string), size); /* FIXME: hash x directly. */ error (cell_symbol_system_error, cons (make_string0 ("hashq_: not a symbol"), x)); } int -hash_ (SCM x, long size) +hash_ (struct scm *x, long size) { - if (TYPE (x) != TSTRING) + if (x->type != TSTRING) { eputs ("hash_ failed, not a string:"); display_error_ (x); assert_msg (0, "0"); } - return hash_cstring (cell_bytes (STRING (x)), size); + return hash_cstring (cell_bytes (x->string), size); } -SCM -hashq (SCM x, SCM size) +struct scm * +hashq (struct scm *x, struct scm *size) { eputs ("hashq not supporteed\n"); assert_msg (0, "0"); } -SCM -hash (SCM x, SCM size) +struct scm * +hash (struct scm *x, struct scm *size) { eputs ("hash not supporteed\n"); assert_msg (0, "0"); } -SCM -hashq_get_handle (SCM table, SCM key, SCM dflt) +struct scm * +hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt) { - SCM s = struct_ref_ (table, 3); - long size = VALUE (s); + struct scm *s = struct_ref_ (table, 3); + long size = s->value; unsigned hash = hashq_ (key, size); - SCM buckets = struct_ref_ (table, 4); - SCM bucket = vector_ref_ (buckets, hash); - SCM x = cell_f; - if (TYPE (dflt) == TPAIR) - x = CAR (dflt); - if (TYPE (bucket) == TPAIR) + struct scm *buckets = struct_ref_ (table, 4); + struct scm *bucket = vector_ref_ (buckets, hash); + struct scm *x = cell_f; + if (dflt->type == TPAIR) + x = dflt->car; + if (bucket->type == TPAIR) x = assq (key, bucket); return x; } -SCM -hashq_ref (SCM table, SCM key, SCM dflt) +struct scm * +hashq_ref (struct scm *table, struct scm *key, struct scm *dflt) { - SCM x = hashq_get_handle (table, key, dflt); + struct scm *x = hashq_get_handle (table, key, dflt); if (x != cell_f) - x = CDR (x); + x = x->cdr; return x; } -SCM -hash_ref (SCM table, SCM key, SCM dflt) +struct scm * +hash_ref (struct scm *table, struct scm *key, struct scm *dflt) { - SCM s = struct_ref_ (table, 3); - long size = VALUE (s); + struct scm *s = struct_ref_ (table, 3); + long size = s->value; unsigned hash = hash_ (key, size); - SCM buckets = struct_ref_ (table, 4); - SCM bucket = vector_ref_ (buckets, hash); - SCM x = cell_f; - if (TYPE (dflt) == TPAIR) - x = CAR (dflt); - if (TYPE (bucket) == TPAIR) + struct scm *buckets = struct_ref_ (table, 4); + struct scm *bucket = vector_ref_ (buckets, hash); + struct scm *x = cell_f; + if (dflt->type == TPAIR) + x = dflt->car; + if (bucket->type == TPAIR) { x = assoc (key, bucket); if (x != cell_f) - x = CDR (x); + x = x->cdr; } return x; } -SCM -hash_set_x_ (SCM table, unsigned hash, SCM key, SCM value) +struct scm * +hash_set_x_ (struct scm *table, unsigned hash, struct scm *key, struct scm *value) { - SCM buckets = struct_ref_ (table, 4); - SCM bucket = vector_ref_ (buckets, hash); - if (TYPE (bucket) != TPAIR) + struct scm *buckets = struct_ref_ (table, 4); + struct scm *bucket = vector_ref_ (buckets, hash); + if (bucket->type != TPAIR) bucket = cell_nil; bucket = acons (key, value, bucket); vector_set_x_ (buckets, hash, bucket); return value; } -SCM -hashq_set_x (SCM table, SCM key, SCM value) +struct scm * +hashq_set_x (struct scm *table, struct scm *key, struct scm *value) { - SCM s = struct_ref_ (table, 3); - long size = VALUE (s); + struct scm *s = struct_ref_ (table, 3); + long size = s->value; unsigned hash = hashq_ (key, size); return hash_set_x_ (table, hash, key, value); } -SCM -hash_set_x (SCM table, SCM key, SCM value) +struct scm * +hash_set_x (struct scm *table, struct scm *key, struct scm *value) { - SCM s = struct_ref_ (table, 3); - long size = VALUE (s); + struct scm *s = struct_ref_ (table, 3); + long size = s->value; unsigned hash = hash_ (key, size); return hash_set_x_ (table, hash, key, value); } -SCM -hash_table_printer (SCM table) +struct scm * +hash_table_printer (struct scm *table) { fdputs ("#<", __stdout); display_ (struct_ref_ (table, 2)); @@ -153,20 +153,20 @@ hash_table_printer (SCM table) fdputs ("size: ", __stdout); display_ (struct_ref_ (table, 3)); fdputc (' ', __stdout); - SCM buckets = struct_ref_ (table, 4); + struct scm *buckets = struct_ref_ (table, 4); fdputs ("buckets: ", __stdout); int i; - for (i = 0; i < LENGTH (buckets); i = i + 1) + for (i = 0; i < buckets->length; i = i + 1) { - SCM e = vector_ref_ (buckets, i); + struct scm *e = vector_ref_ (buckets, i); if (e != cell_unspecified) { fdputc ('[', __stdout); - while (TYPE (e) == TPAIR) + while (e->type == TPAIR) { - write_ (CAAR (e)); - e = CDR (e); - if (TYPE (e) == TPAIR) + write_ (e->car->car); + e = e->cdr; + if (e->type == TPAIR) fdputc (' ', __stdout); } fdputs ("]\n ", __stdout); @@ -175,10 +175,10 @@ hash_table_printer (SCM table) fdputc ('>', __stdout); } -SCM +struct scm * make_hashq_type () /*:((internal)) */ { - SCM fields = cell_nil; + struct scm *fields = cell_nil; fields = cons (cell_symbol_buckets, fields); fields = cons (cell_symbol_size, fields); fields = cons (fields, cell_nil); @@ -186,15 +186,15 @@ make_hashq_type () /*:((internal)) */ return make_struct (cell_symbol_record_type, fields, cell_unspecified); } -SCM +struct scm * make_hash_table_ (long size) { if (size == 0) size = 100; - SCM hashq_type = make_hashq_type (); + struct scm *hashq_type = make_hashq_type (); - SCM buckets = make_vector_ (size, cell_unspecified); - SCM values = cell_nil; + struct scm *buckets = make_vector_ (size, cell_unspecified); + struct scm *values = cell_nil; values = cons (buckets, values); values = cons (make_number (size), values); values = cons (cell_symbol_hashq_table, values); @@ -203,14 +203,14 @@ make_hash_table_ (long size) return make_struct (hashq_type, values, cell_unspecified); } -SCM -make_hash_table (SCM x) +struct scm * +make_hash_table (struct scm *x) { long size = 0; - if (TYPE (x) == TPAIR) + if (x->type == TPAIR) { - assert_msg (TYPE (x) == TNUMBER, "TYPE (x) == TNUMBER"); - size = VALUE (x); + assert_msg (x->type == TNUMBER, "x->type == TNUMBER"); + size = x->value; } return make_hash_table_ (size); } diff --git a/src/lib.c b/src/lib.c index 6b16cf1f..2560e0db 100644 --- a/src/lib.c +++ b/src/lib.c @@ -29,54 +29,54 @@ #include -SCM -type_ (SCM x) +struct scm * +type_ (struct scm *x) { - return make_number (TYPE (x)); + return make_number (x->type); } -SCM -car_ (SCM x) +struct scm * +car_ (struct scm *x) { - SCM a = CAR (x); - if (TYPE (x) == TPAIR) + struct scm *a = x->car; + if (x->type == TPAIR) return a; return make_number (a); } -SCM -cdr_ (SCM x) +struct scm * +cdr_ (struct scm *x) { - SCM d = CDR (x); - if (TYPE (x) == TPAIR || TYPE (x) == TCLOSURE) + struct scm *d = x->cdr; + if (x->type == TPAIR || x->type == TCLOSURE) return d; return make_number (d); } -SCM -xassq (SCM x, SCM a) /* For speed in core. */ +struct scm * +xassq (struct scm *x, struct scm *a) /* For speed in core. */ { while (a != cell_nil) { - if (x == CDAR (a)) - return CAR (a); - a = CDR (a); + if (x == a->car->cdr) + return a->car; + a = a->cdr; } return cell_f; } -SCM -memq (SCM x, SCM a) +struct scm * +memq (struct scm *x, struct scm *a) { - int t = TYPE (x); + int t = x->type; if (t == TCHAR || t == TNUMBER) { - long v = VALUE (x); + long v = x->value; while (a != cell_nil) { - if (v == VALUE (CAR (a))) + if (v == a->car->value) return a; - a = CDR (a); + a = a->cdr; } return cell_f; } @@ -84,53 +84,53 @@ memq (SCM x, SCM a) { while (a != cell_nil) { - if (TYPE (CAR (a)) == TKEYWORD) - if (string_equal_p (x, CAR (a)) == cell_t) + if (a->car->type == TKEYWORD) + if (string_equal_p (x, a->car) == cell_t) return a; - a = CDR (a); + a = a->cdr; } return cell_f; } while (a != cell_nil) { - if (x == CAR (a)) + if (x == a->car) return a; - a = CDR (a); + a = a->cdr; } return cell_f; } -SCM -equal2_p (SCM a, SCM b) +struct scm * +equal2_p (struct scm *a, struct scm *b) { equal2: if (a == b) return cell_t; - if (TYPE (a) == TPAIR && TYPE (b) == TPAIR) + if (a->type == TPAIR && b->type == TPAIR) { - if (equal2_p (CAR (a), CAR (b)) == cell_t) + if (equal2_p (a->car, b->car) == cell_t) { - a = CDR (a); - b = CDR (b); + a = a->cdr; + b = b->cdr; goto equal2; } return cell_f; } - if (TYPE (a) == TSTRING && TYPE (b) == TSTRING) + if (a->type == TSTRING && b->type == TSTRING) return string_equal_p (a, b); - if (TYPE (a) == TVECTOR && TYPE (b) == TVECTOR) + if (a->type == TVECTOR && b->type == TVECTOR) { - if (LENGTH (a) != LENGTH (b)) + if (a->length != b->length) return cell_f; long i; - for (i = 0; i < LENGTH (a); i = i + 1) + for (i = 0; i < a->length; i = i + 1) { - SCM ai = cell_ref (VECTOR (a), i); - SCM bi = cell_ref (VECTOR (b), i); - if (TYPE (ai) == TREF) - ai = REF (ai); - if (TYPE (bi) == TREF) - bi = REF (bi); + struct scm *ai = cell_ref (a->vector, i); + struct scm *bi = cell_ref (b->vector, i); + if (ai->type == TREF) + ai = ai->ref; + if (bi->type == TREF) + bi = bi->ref; if (equal2_p (ai, bi) == cell_f) return cell_f; } @@ -139,34 +139,34 @@ equal2: return eq_p (a, b); } -SCM -last_pair (SCM x) +struct scm * +last_pair (struct scm *x) { while (x != cell_nil) { - if (CDR (x) == cell_nil) + if (x->cdr == cell_nil) return x; - x = CDR (x); + x = x->cdr; } return x; } -SCM -pair_p (SCM x) +struct scm * +pair_p (struct scm *x) { - if (TYPE (x) == TPAIR) + if (x->type == TPAIR) return cell_t; return cell_f; } -SCM -char_to_integer (SCM x) +struct scm * +char_to_integer (struct scm *x) { - return make_number (VALUE (x)); + return make_number (x->value); } -SCM -integer_to_char (SCM x) +struct scm * +integer_to_char (struct scm *x) { - return make_char (VALUE (x)); + return make_char (x->value); } diff --git a/src/m2.c b/src/m2.c index 006af805..93db9757 100644 --- a/src/m2.c +++ b/src/m2.c @@ -21,29 +21,29 @@ #include "mes/lib.h" #include "mes/mes.h" -SCM -apply_builtin0 (SCM fn) +struct scm * +apply_builtin0 (struct scm *fn) { FUNCTION fp = builtin_function (fn); return fp (); } -SCM -apply_builtin1 (SCM fn, SCM x) +struct scm * +apply_builtin1 (struct scm *fn, struct scm *x) { FUNCTION fp = builtin_function (fn); return fp (x); } -SCM -apply_builtin2 (SCM fn, SCM x, SCM y) +struct scm * +apply_builtin2 (struct scm *fn, struct scm *x, struct scm *y) { FUNCTION fp = builtin_function (fn); return fp (x, y); } -SCM -apply_builtin3 (SCM fn, SCM x, SCM y, SCM z) +struct scm * +apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z) { FUNCTION fp = builtin_function (fn); return fp (x, y, z); diff --git a/src/math.c b/src/math.c index 4ff117d3..befe60cc 100644 --- a/src/math.c +++ b/src/math.c @@ -28,28 +28,28 @@ #include void -assert_number (char const *name, SCM x) +assert_number (char const *name, struct scm *x) { - if (TYPE (x) != TNUMBER) + if (x->type != TNUMBER) { eputs (name); error (cell_symbol_not_a_number, x); } } -SCM -greater_p (SCM x) /*:((name . ">") (arity . n)) */ +struct scm * +greater_p (struct scm *x) /*:((name . ">") (arity . n)) */ { if (x == cell_nil) return cell_t; - assert_number ("greater_p", CAR (x)); - long n = VALUE (CAR (x)); - x = CDR (x); + assert_number ("greater_p", x->car); + long n = x->car->value; + x = x->cdr; while (x != cell_nil) { - assert_number ("greater_p", CAR (x)); - SCM i = car (x); - long v = VALUE (i); + assert_number ("greater_p", x->car); + struct scm *i = car (x); + long v = i->value; if (v >= n) return cell_f; n = v; @@ -58,19 +58,19 @@ greater_p (SCM x) /*:((name . ">") (arity . n)) */ return cell_t; } -SCM -less_p (SCM x) /*:((name . "<") (arity . n)) */ +struct scm * +less_p (struct scm *x) /*:((name . "<") (arity . n)) */ { if (x == cell_nil) return cell_t; - assert_number ("less_p", CAR (x)); - long n = VALUE (CAR (x)); - x = CDR (x); + assert_number ("less_p", x->car); + long n = x->car->value; + x = x->cdr; while (x != cell_nil) { - assert_number ("less_p", CAR (x)); - SCM i = car (x); - long v = VALUE (i); + assert_number ("less_p", x->car); + struct scm *i = car (x); + long v = i->value; if (v <= n) return cell_f; n = v; @@ -79,18 +79,18 @@ less_p (SCM x) /*:((name . "<") (arity . n)) */ return cell_t; } -SCM -is_p (SCM x) /*:((name . "=") (arity . n)) */ +struct scm * +is_p (struct scm *x) /*:((name . "=") (arity . n)) */ { if (x == cell_nil) return cell_t; - assert_number ("is_p", CAR (x)); - long n = VALUE (CAR (x)); + assert_number ("is_p", x->car); + long n = x->car->value; x = cdr (x); while (x != cell_nil) { - SCM i = car (x); - long v = VALUE (i); + struct scm *i = car (x); + long v = i->value; if (v != n) return cell_f; x = cdr (x); @@ -98,57 +98,57 @@ is_p (SCM x) /*:((name . "=") (arity . n)) */ return cell_t; } -SCM -minus (SCM x) /*:((name . "-") (arity . n)) */ +struct scm * +minus (struct scm *x) /*:((name . "-") (arity . n)) */ { - assert_number ("minus", CAR (x)); - long n = VALUE (CAR (x)); + assert_number ("minus", x->car); + long n = x->car->value; x = cdr (x); if (x == cell_nil) n = -n; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("minus", i); - long v = VALUE (i); + long v = i->value; n = n - v; x = cdr (x); } return make_number (n); } -SCM -plus (SCM x) /*:((name . "+") (arity . n)) */ +struct scm * +plus (struct scm *x) /*:((name . "+") (arity . n)) */ { long n = 0; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("plus", i); - long v = VALUE (i); + long v = i->value; n = n + v; x = cdr (x); } return make_number (n); } -SCM -divide (SCM x) /*:((name . "/") (arity . n)) */ +struct scm * +divide (struct scm *x) /*:((name . "/") (arity . n)) */ { long n = 1; if (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("divide", i); - long v = VALUE (i); + long v = i->value; n = v; x = cdr (x); } while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("divide", i); - long v = VALUE (i); + long v = i->value; if (v == 0) error (cstring_to_symbol ("divide-by-zero"), x); if (n == 0) @@ -159,13 +159,13 @@ divide (SCM x) /*:((name . "/") (arity . n)) */ return make_number (n); } -SCM -modulo (SCM a, SCM b) +struct scm * +modulo (struct scm *a, struct scm *b) { assert_number ("modulo", a); assert_number ("modulo", b); - long x = VALUE (a); - long y = VALUE (b); + long x = a->value; + long y = b->value; if (y == 0) error (cstring_to_symbol ("divide-by-zero"), a); while (x < 0) @@ -176,81 +176,81 @@ modulo (SCM a, SCM b) return make_number (x); } -SCM -multiply (SCM x) /*:((name . "*") (arity . n)) */ +struct scm * +multiply (struct scm *x) /*:((name . "*") (arity . n)) */ { long n = 1; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("multiply", i); - long v = VALUE (i); + long v = i->value; n = n * v; x = cdr (x); } return make_number (n); } -SCM -logand (SCM x) /*:((arity . n)) */ +struct scm * +logand (struct scm *x) /*:((arity . n)) */ { long n = -1; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("multiply", i); - long v = VALUE (i); + long v = i->value; n = n & v; x = cdr (x); } return make_number (n); } -SCM -logior (SCM x) /*:((arity . n)) */ +struct scm * +logior (struct scm *x) /*:((arity . n)) */ { long n = 0; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("logior", i); - long v = VALUE (i); + long v = i->value; n = n | v; x = cdr (x); } return make_number (n); } -SCM -lognot (SCM x) +struct scm * +lognot (struct scm *x) { assert_number ("lognot", x); - long n = ~VALUE (x); + long n = ~x->value; return make_number (n); } -SCM -logxor (SCM x) /*:((arity . n)) */ +struct scm * +logxor (struct scm *x) /*:((arity . n)) */ { long n = 0; while (x != cell_nil) { - SCM i = car (x); + struct scm *i = car (x); assert_number ("logxor", i); - long v = VALUE (i); + long v = i->value; n = n ^ v; x = cdr (x); } return make_number (n); } -SCM -ash (SCM n, SCM count) +struct scm * +ash (struct scm *n, struct scm *count) { assert_number ("ash", n); assert_number ("ash", count); - long cn = VALUE (n); - long ccount = VALUE (count); + long cn = n->value; + long ccount = count->value; long result; if (ccount < 0) result = cn >> -ccount; diff --git a/src/mes.c b/src/mes.c index 927b5eb1..53b11adf 100644 --- a/src/mes.c +++ b/src/mes.c @@ -28,10 +28,8 @@ #include #include -// char const *MES_PKGDATADIR = "mes"; - -SCM -mes_g_stack (SCM a) /*:((internal)) */ +struct scm * +mes_g_stack (struct scm *a) /*:((internal)) */ { g_stack = STACK_SIZE; R0 = a; @@ -41,10 +39,10 @@ mes_g_stack (SCM a) /*:((internal)) */ return R0; } -SCM +struct scm * mes_environment (int argc, char **argv) { - SCM a = init_symbols (); + struct scm *a = init_symbols (); char *compiler = "gnuc"; #if __MESC__ @@ -67,7 +65,7 @@ mes_environment (int argc, char **argv) a = acons (cell_symbol_arch, make_string0 (arch), a); #if !MES_MINI - SCM lst = cell_nil; + struct scm *lst = cell_nil; int i; for (i = argc - 1; i >= 0; i = i - 1) lst = cons (make_string0 (argv[i]), lst); @@ -150,7 +148,7 @@ open_boot () } } -SCM +struct scm * read_boot () /*:((internal)) */ { R2 = read_input_file_env (R0); @@ -187,7 +185,7 @@ main (int argc, char **argv, char **envp) { init (envp); - SCM a = mes_environment (argc, argv); + struct scm *a = mes_environment (argc, argv); a = mes_builtins (a); a = init_time (a); M0 = make_initial_module (a); @@ -196,7 +194,7 @@ main (int argc, char **argv, char **envp) if (g_debug > 5) module_printer (M0); - SCM program = read_boot (); + struct scm *program = read_boot (); R0 = acons (cell_symbol_program, program, R0); push_cc (R2, cell_unspecified, R0, cell_unspecified); diff --git a/src/module.c b/src/module.c index 1357d1aa..98c382f0 100644 --- a/src/module.c +++ b/src/module.c @@ -21,10 +21,10 @@ #include "mes/lib.h" #include "mes/mes.h" -SCM +struct scm * make_module_type () /*:(internal)) */ { - SCM fields = cell_nil; + struct scm *fields = cell_nil; fields = cons (cstring_to_symbol ("globals"), fields); fields = cons (cstring_to_symbol ("locals"), fields); fields = cons (cstring_to_symbol ("name"), fields); @@ -33,40 +33,40 @@ make_module_type () /*:(internal)) */ return make_struct (cell_symbol_record_type, fields, cell_unspecified); } -SCM -make_initial_module (SCM a) /*:((internal)) */ +struct scm * +make_initial_module (struct scm *a) /*:((internal)) */ { - SCM module_type = make_module_type (); + struct scm *module_type = make_module_type (); a = acons (cell_symbol_module, module_type, a); - SCM hashq_type = make_hashq_type (); + struct scm *hashq_type = make_hashq_type (); a = acons (cell_symbol_hashq_table, hashq_type, a); - SCM name = cons (cstring_to_symbol ("boot"), cell_nil); - SCM globals = make_hash_table_ (0); - SCM locals = cell_nil; + struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil); + struct scm *globals = make_hash_table_ (0); + struct scm *locals = cell_nil; - SCM values = cell_nil; + struct scm *values = cell_nil; values = cons (globals, values); values = cons (locals, values); values = cons (name, values); values = cons (cell_symbol_module, values); - SCM module = make_struct (module_type, values, cstring_to_symbol ("module-printer")); + struct scm *module = make_struct (module_type, values, cstring_to_symbol ("module-printer")); R0 = cell_nil; - R0 = cons (CADR (a), R0); - R0 = cons (CAR (a), R0); + R0 = cons (a->cdr->car, R0); + R0 = cons (a->car, R0); M0 = module; - while (TYPE (a) == TPAIR) + while (a->type == TPAIR) { - module_define_x (module, CAAR (a), CDAR (a)); - a = CDR (a); + module_define_x (module, a->car->car, a->car->cdr); + a = a->cdr; } return module; } -SCM -module_printer (SCM module) +struct scm * +module_printer (struct scm *module) { fdputs ("#<", __stdout); display_ (struct_ref_ (module, 2)); @@ -77,40 +77,40 @@ module_printer (SCM module) fdputs ("locals: ", __stdout); display_ (struct_ref_ (module, 4)); fdputc (' ', __stdout); - SCM table = struct_ref_ (module, 5); + struct scm *table = struct_ref_ (module, 5); fdputs ("globals:\n ", __stdout); display_ (table); fdputc ('>', __stdout); } -SCM -module_variable (SCM module, SCM name) +struct scm * +module_variable (struct scm *module, struct scm *name) { - /*SCM locals = struct_ref_ (module, 3);*/ - SCM locals = module; - SCM x = assq (name, locals); + /*struct scm *locals = struct_ref_ (module, 3);*/ + struct scm *locals = module; + struct scm *x = assq (name, locals); if (x == cell_f) { module = M0; - SCM globals = struct_ref_ (module, 5); + struct scm *globals = struct_ref_ (module, 5); x = hashq_get_handle (globals, name, cell_f); } return x; } -SCM -module_ref (SCM module, SCM name) +struct scm * +module_ref (struct scm *module, struct scm *name) { - SCM x = module_variable (module, name); + struct scm *x = module_variable (module, name); if (x == cell_f) return cell_undefined; - return CDR (x); + return x->cdr; } -SCM -module_define_x (SCM module, SCM name, SCM value) +struct scm * +module_define_x (struct scm *module, struct scm *name, struct scm *value) { module = M0; - SCM globals = struct_ref_ (module, 5); + struct scm *globals = struct_ref_ (module, 5); return hashq_set_x (globals, name, value); } diff --git a/src/posix.c b/src/posix.c index 0784d4bd..855440c0 100644 --- a/src/posix.c +++ b/src/posix.c @@ -33,11 +33,11 @@ #include #include -SCM -exit_ (SCM x) /*:((name . "exit")) */ +struct scm * +exit_ (struct scm *x) /*:((name . "exit")) */ { - assert_msg (TYPE (x) == TNUMBER, "TYPE (x) == TNUMBER"); - exit (VALUE (x)); + assert_msg (x->type == TNUMBER, "x->type == TNUMBER"); + exit (x->value); } int @@ -49,12 +49,12 @@ peekchar () unreadchar (c); return c; } - SCM port = current_input_port (); - SCM string = STRING (port); - size_t length = LENGTH (string); + struct scm *port = current_input_port (); + struct scm *string = port->string; + size_t length = string->length; if (length == 0) return -1; - char const *p = cell_bytes (STRING (string)); + char const *p = cell_bytes (string->string); return p[0]; } @@ -63,15 +63,15 @@ readchar () { if (__stdin >= 0) return fdgetc (__stdin); - SCM port = current_input_port (); - SCM string = STRING (port); - size_t length = LENGTH (string); + struct scm *port = current_input_port (); + struct scm *string = port->string; + size_t length = string->length; if (length == 0) return -1; - char const *p = cell_bytes (STRING (string)); + char const *p = cell_bytes (string->string); int c = p[0]; p = p + 1; - STRING (port) = make_string (p, length - 1); + port->string = make_string (p, length - 1); return c; } @@ -82,243 +82,243 @@ unreadchar (int c) return fdungetc (c, __stdin); if (c == EOF) /* can't unread EOF */ return c; - SCM port = current_input_port (); - SCM string = STRING (port); - size_t length = LENGTH (string); - char *p = cell_bytes (STRING (string)); + struct scm *port = current_input_port (); + struct scm *string = port->string; + size_t length = string->length; + char *p = cell_bytes (string->string); p = p - 1; string = make_string (p, length + 1); - p = cell_bytes (STRING (string)); + p = cell_bytes (string->string); p[0] = c; - STRING (port) = string; + port->string = string; return c; } -SCM +struct scm * peek_byte () { return make_number (peekchar ()); } -SCM +struct scm * read_byte () { return make_number (readchar ()); } -SCM -unread_byte (SCM i) +struct scm * +unread_byte (struct scm *i) { - unreadchar (VALUE (i)); + unreadchar (i->value); return i; } -SCM +struct scm * peek_char () { return make_char (peekchar ()); } -SCM -read_char (SCM port) /*:((arity . n)) */ +struct scm * +read_char (struct scm *port) /*:((arity . n)) */ { int fd = __stdin; - if (TYPE (port) == TPAIR) - if (TYPE (CAR (port)) == TNUMBER) - __stdin = VALUE (CAR (port)); - SCM c = make_char (readchar ()); + if (port->type == TPAIR) + if (port->car->type == TNUMBER) + __stdin = port->car->value; + struct scm *c = make_char (readchar ()); __stdin = fd; return c; } -SCM -unread_char (SCM i) +struct scm * +unread_char (struct scm *i) { - unreadchar (VALUE (i)); + unreadchar (i->value); return i; } -SCM -write_char (SCM i) /*:((arity . n)) */ +struct scm * +write_char (struct scm *i) /*:((arity . n)) */ { write_byte (i); return i; } -SCM -write_byte (SCM x) /*:((arity . n)) */ +struct scm * +write_byte (struct scm *x) /*:((arity . n)) */ { - SCM c = car (x); - SCM p = cdr (x); + struct scm *c = car (x); + struct scm *p = cdr (x); int fd = __stdout; - if (TYPE (p) == TPAIR) + if (p->type == TPAIR) { - SCM f = CAR (p); - if (TYPE (f) == TNUMBER) + struct scm *f = p->car; + if (f->type == TNUMBER) { - long v = VALUE (f); + long v = f->value; if (v != 1) fd = v; if (v == 2) fd = __stderr; } } - char cc = VALUE (c); + char cc = c->value; write (fd, &cc, 1); #if !__MESC__ - assert_msg (TYPE (c) == TNUMBER || TYPE (c) == TCHAR, "TYPE (c) == TNUMBER || TYPE (c) == TCHAR"); + assert_msg (c->type == TNUMBER || c->type == TCHAR, "c->type == TNUMBER || c->type == TCHAR"); #endif return c; } -SCM -getenv_ (SCM s) /*:((name . "getenv")) */ +struct scm * +getenv_ (struct scm *s) /*:((name . "getenv")) */ { char *p; - p = getenv (cell_bytes (STRING (s))); + p = getenv (cell_bytes (s->string)); if (p != 0) return make_string0 (p); return cell_f; } -SCM -setenv_ (SCM s, SCM v) /*:((name . "setenv")) */ +struct scm * +setenv_ (struct scm *s, struct scm *v) /*:((name . "setenv")) */ { char *buf = __setenv_buf; - strcpy (buf, cell_bytes (STRING (s))); - setenv (buf, cell_bytes (STRING (v)), 1); + strcpy (buf, cell_bytes (s->string)); + setenv (buf, cell_bytes (v->string), 1); return cell_unspecified; } -SCM -access_p (SCM file_name, SCM mode) +struct scm * +access_p (struct scm *file_name, struct scm *mode) { - int result = access (cell_bytes (STRING (file_name)), VALUE (mode)); + int result = access (cell_bytes (file_name->string), mode->value); if (result == 0) return cell_t; return cell_f; } -SCM +struct scm * current_input_port () { if (__stdin >= 0) return make_number (__stdin); - SCM x = g_ports; + struct scm *x = g_ports; while (x != 0) { - SCM a = CAR (x); - if (PORT (a) == __stdin) + struct scm *a = x->car; + if (a->port == __stdin) return a; - x = CDR (x); + x = x->cdr; } - return CAR (x); + return x->car; } -SCM -open_input_file (SCM file_name) +struct scm * +open_input_file (struct scm *file_name) { - int filedes = mes_open (cell_bytes (STRING (file_name)), O_RDONLY, 0); + int filedes = mes_open (cell_bytes (file_name->string), O_RDONLY, 0); if (filedes == -1) error (cell_symbol_system_error, cons (make_string0 ("No such file or directory"), file_name)); return make_number (filedes); } -SCM -open_input_string (SCM string) +struct scm * +open_input_string (struct scm *string) { - SCM port = make_string_port (string); + struct scm *port = make_string_port (string); g_ports = cons (port, g_ports); return port; } -SCM -set_current_input_port (SCM port) +struct scm * +set_current_input_port (struct scm *port) { - SCM prev = current_input_port (); - if (TYPE (port) == TNUMBER) + struct scm *prev = current_input_port (); + if (port->type == TNUMBER) { - int p = VALUE (port); + int p = port->value; if (p != 0) __stdin = p; else __stdin = STDIN; } - else if (TYPE (port) == TPORT) - __stdin = PORT (port); + else if (port->type == TPORT) + __stdin = port->port; return prev; } -SCM +struct scm * current_output_port () { return make_number (__stdout); } -SCM +struct scm * current_error_port () { return make_number (__stderr); } -SCM -open_output_file (SCM x) /*:((arity . n)) */ +struct scm * +open_output_file (struct scm *x) /*:((arity . n)) */ { - SCM file_name = car (x); + struct scm *file_name = car (x); x = cdr (x); int mode = S_IRUSR | S_IWUSR; - if (TYPE (x) == TPAIR) + if (x->type == TPAIR) { - SCM i = car (x); - if (TYPE (i) == TNUMBER) - mode = VALUE (i); + struct scm *i = car (x); + if (i->type == TNUMBER) + mode = i->value; } - return make_number (mes_open (cell_bytes (STRING (file_name)), O_WRONLY | O_CREAT | O_TRUNC, mode)); + return make_number (mes_open (cell_bytes (file_name->string), O_WRONLY | O_CREAT | O_TRUNC, mode)); } -SCM -set_current_output_port (SCM port) +struct scm * +set_current_output_port (struct scm *port) { - if (VALUE (port) != 0) - __stdout = VALUE (port); + if (port->value != 0) + __stdout = port->value; else __stdout = STDOUT; return current_output_port (); } -SCM -set_current_error_port (SCM port) +struct scm * +set_current_error_port (struct scm *port) { - if (VALUE (port) != 0) - __stderr = VALUE (port); + if (port->value != 0) + __stderr = port->value; else __stderr = STDERR; return current_error_port (); } -SCM -chmod_ (SCM file_name, SCM mode) /*:((name . "chmod")) */ +struct scm * +chmod_ (struct scm *file_name, struct scm *mode) /*:((name . "chmod")) */ { - chmod (cell_bytes (STRING (file_name)), VALUE (mode)); + chmod (cell_bytes (file_name->string), mode->value); return cell_unspecified; } -SCM -isatty_p (SCM port) +struct scm * +isatty_p (struct scm *port) { - if (isatty (VALUE (port)) != 0) + if (isatty (port->value) != 0) return cell_t; return cell_f; } -SCM +struct scm * primitive_fork () { return make_number (fork ()); } -SCM -execl_ (SCM file_name, SCM args) /*:((name . "execl")) */ +struct scm * +execl_ (struct scm *file_name, struct scm *args) /*:((name . "execl")) */ { char **c_argv = __execl_c_argv; int i = 0; @@ -326,15 +326,15 @@ execl_ (SCM file_name, SCM args) /*:((name . "execl")) */ if (length__ (args) > 1000) error (cell_symbol_system_error, cons (file_name, cons (make_string0 ("too many arguments"), cons (file_name, args)))); - c_argv[i] = cell_bytes (STRING (file_name)); + c_argv[i] = cell_bytes (file_name->string); i = i + 1; while (args != cell_nil) { - assert_msg (TYPE (CAR (args)) == TSTRING, "TYPE (CAR (args)) == TSTRING"); - SCM arg = CAR (args); - c_argv[i] = cell_bytes (STRING (arg)); + assert_msg (args->car->type == TSTRING, "args->car->type == TSTRING"); + struct scm *arg = args->car; + c_argv[i] = cell_bytes (arg->string); i = i + 1; - args = CDR (args); + args = args->cdr; if (g_debug > 2) { eputs ("arg["); @@ -348,11 +348,11 @@ execl_ (SCM file_name, SCM args) /*:((name . "execl")) */ return make_number (execv (c_argv[0], c_argv)); } -SCM -waitpid_ (SCM pid, SCM options) +struct scm * +waitpid_ (struct scm *pid, struct scm *options) { int status; - int child = waitpid (VALUE (pid), &status, VALUE (options)); + int child = waitpid (pid->value, &status, options->value); return cons (make_number (child), make_number (status)); } @@ -366,20 +366,20 @@ waitpid_ (SCM pid, SCM options) #define TIME_UNITS_PER_SECOND 1000 #endif -SCM -init_time (SCM a) /*:((internal)) */ +struct scm * +init_time (struct scm *a) /*:((internal)) */ { clock_gettime (CLOCK_PROCESS_CPUTIME_ID, g_start_time); a = acons (cell_symbol_internal_time_units_per_second, make_number (TIME_UNITS_PER_SECOND), a); } -SCM +struct scm * current_time () { return make_number (time (0)); } -SCM +struct scm * gettimeofday_ () /*:((name . "gettimeofday")) */ { struct timeval *time = __gettimeofday_time; @@ -393,7 +393,7 @@ seconds_and_nanoseconds_to_long (long s, long ns) return s * TIME_UNITS_PER_SECOND + ns / (1000000000 / TIME_UNITS_PER_SECOND); } -SCM +struct scm * get_internal_run_time () { struct timespec *ts = __get_internal_run_time_ts; @@ -403,29 +403,29 @@ get_internal_run_time () return make_number (time); } -SCM +struct scm * getcwd_ () /*:((name . "getcwd")) */ { char *buf = __getcwd_buf; return make_string0 (getcwd (buf, PATH_MAX)); } -SCM -dup_ (SCM port) /*:((name . "dup")) */ +struct scm * +dup_ (struct scm *port) /*:((name . "dup")) */ { - return make_number (dup (VALUE (port))); + return make_number (dup (port->value)); } -SCM -dup2_ (SCM old, SCM new) /*:((name . "dup2")) */ +struct scm * +dup2_ (struct scm *old, struct scm *new) /*:((name . "dup2")) */ { - dup2 (VALUE (old), VALUE (new)); + dup2 (old->value, new->value); return cell_unspecified; } -SCM -delete_file (SCM file_name) +struct scm * +delete_file (struct scm *file_name) { - unlink (cell_bytes (STRING (file_name))); + unlink (cell_bytes (file_name->string)); return cell_unspecified; } diff --git a/src/reader.c b/src/reader.c index da0a66e8..8fbb9436 100644 --- a/src/reader.c +++ b/src/reader.c @@ -26,16 +26,16 @@ #include #include -SCM -read_input_file_env_ (SCM e, SCM a) +struct scm * +read_input_file_env_ (struct scm *e, struct scm *a) { if (e == cell_nil) return e; return cons (e, read_input_file_env_ (read_env (a), a)); } -SCM -read_input_file_env (SCM a) +struct scm * +read_input_file_env (struct scm *a) { return read_input_file_env_ (read_env (cell_nil), cell_nil); } @@ -52,9 +52,9 @@ reader_read_line_comment (int c) error (cell_symbol_system_error, make_string0 ("reader_read_line_comment")); } -SCM reader_read_block_comment (int s, int c); -SCM reader_read_hash (int c, SCM a); -SCM reader_read_list (int c, SCM a); +struct scm *reader_read_block_comment (int s, int c); +struct scm *reader_read_hash (int c, struct scm *a); +struct scm *reader_read_list (int c, struct scm *a); int reader_identifier_p (int c) @@ -68,7 +68,7 @@ reader_end_of_word_p (int c) return (c == '"' || c == ';' || c == '(' || c == ')' || isspace (c) || c == EOF); } -SCM +struct scm * reader_read_identifier_or_number (int c) { int i = 0; @@ -110,8 +110,8 @@ reader_read_identifier_or_number (int c) return cstring_to_symbol (g_buf); } -SCM -reader_read_sexp_ (int c, SCM a) +struct scm * +reader_read_sexp_ (int c, struct scm *a) { reset_reader: if (c == EOF) @@ -173,30 +173,30 @@ reader_eat_whitespace (int c) return c; } -SCM -reader_read_list (int c, SCM a) +struct scm * +reader_read_list (int c, struct scm *a) { c = reader_eat_whitespace (c); if (c == ')') return cell_nil; if (c == EOF) error (cell_symbol_not_a_pair, make_string0 ("EOF in list")); - SCM s = reader_read_sexp_ (c, a); + struct scm *s = reader_read_sexp_ (c, a); if (s == cell_dot) { s = reader_read_list (readchar (), a); - return CAR (s); + return s->car; } return cons (s, reader_read_list (readchar (), a)); } -SCM -read_env (SCM a) +struct scm * +read_env (struct scm *a) { return reader_read_sexp_ (readchar (), a); } -SCM +struct scm * reader_read_block_comment (int s, int c) { if (c == s) @@ -205,8 +205,8 @@ reader_read_block_comment (int s, int c) return reader_read_block_comment (s, readchar ()); } -SCM -reader_read_hash (int c, SCM a) +struct scm * +reader_read_hash (int c, struct scm *a) { if (c == '!') { @@ -238,9 +238,9 @@ reader_read_hash (int c, SCM a) return cons (cell_symbol_quasisyntax, cons (reader_read_sexp_ (readchar (), a), cell_nil)); if (c == ':') { - SCM x = reader_read_identifier_or_number (readchar ()); - SCM msg = make_string0 ("keyword perifx ':' not followed by a symbol: "); - if (TYPE (x) == TNUMBER) + struct scm *x = reader_read_identifier_or_number (readchar ()); + struct scm *msg = make_string0 ("keyword perifx ':' not followed by a symbol: "); + if (x->type == TNUMBER) error (cell_symbol_system_error, cons (msg, x)); return symbol_to_keyword (x); } @@ -262,13 +262,13 @@ reader_read_hash (int c, SCM a) return reader_read_sexp_ (readchar (), a); } -SCM -reader_read_sexp (SCM c, SCM s, SCM a) +struct scm * +reader_read_sexp (struct scm *c, struct scm *s, struct scm *a) { - return reader_read_sexp_ (VALUE (c), a); + return reader_read_sexp_ (c->value, a); } -SCM +struct scm * reader_read_character () { int c = readchar (); @@ -286,8 +286,8 @@ reader_read_character () } else if (c == 'x' && ((p >= '0' && p <= '9') || (p >= 'a' && p <= 'f') || (p >= 'F' && p <= 'F'))) { - SCM n = reader_read_hex (); - c = VALUE (n); + struct scm *n = reader_read_hex (); + c = n->value; eputs ("reading hex c="); eputs (itoa (c)); eputs ("\n"); @@ -354,7 +354,7 @@ reader_read_character () return make_char (c); } -SCM +struct scm * reader_read_binary () { long n = 0; @@ -378,7 +378,7 @@ reader_read_binary () return make_number (n); } -SCM +struct scm * reader_read_octal () { long n = 0; @@ -402,7 +402,7 @@ reader_read_octal () return make_number (n); } -SCM +struct scm * reader_read_hex () { long n = 0; @@ -431,7 +431,7 @@ reader_read_hex () return make_number (n); } -SCM +struct scm * reader_read_string () { size_t i = 0; @@ -472,8 +472,8 @@ reader_read_string () c = 27; else if (c == 'x') { - SCM n = reader_read_hex (); - c = VALUE (n); + struct scm *n = reader_read_hex (); + c = n->value; } } g_buf[i] = c; diff --git a/src/stack.c b/src/stack.c index b7491c80..6e6a961e 100644 --- a/src/stack.c +++ b/src/stack.c @@ -24,8 +24,8 @@ #include -SCM -frame_printer (SCM frame) +struct scm * +frame_printer (struct scm *frame) { fdputs ("#<", __stdout); display_ (struct_ref_ (frame, 2)); @@ -35,22 +35,22 @@ frame_printer (SCM frame) fdputc ('>', __stdout); } -SCM +struct scm * make_frame_type () /*:((internal)) */ { - SCM fields = cell_nil; + struct scm *fields = cell_nil; fields = cons (cell_symbol_procedure, fields); fields = cons (fields, cell_nil); fields = cons (cell_symbol_frame, fields); return make_struct (cell_symbol_record_type, fields, cell_unspecified); } -SCM -make_frame (SCM stack, long index) +struct scm * +make_frame (struct scm *stack, long index) { - SCM frame_type = make_frame_type (); + struct scm *frame_type = make_frame_type (); long array_index = 0; - SCM procedure = 0; + struct scm *procedure = 0; if (index != 0) { array_index = (STACK_SIZE - (index * FRAME_SIZE)); @@ -58,50 +58,50 @@ make_frame (SCM stack, long index) } if (procedure == 0) procedure = cell_f; - SCM values = cell_nil; + struct scm *values = cell_nil; values = cons (procedure, values); values = cons (cell_symbol_frame, values); return make_struct (frame_type, values, cstring_to_symbol ("frame-printer")); } -SCM +struct scm * make_stack_type () /*:((internal)) */ { - SCM fields = cell_nil; + struct scm *fields = cell_nil; fields = cons (cstring_to_symbol ("frames"), fields); fields = cons (fields, cell_nil); fields = cons (cell_symbol_stack, fields); return make_struct (cell_symbol_record_type, fields, cell_unspecified); } -SCM -make_stack (SCM stack) /*:((arity . n)) */ +struct scm * +make_stack (struct scm *stack) /*:((arity . n)) */ { - SCM stack_type = make_stack_type (); + struct scm *stack_type = make_stack_type (); long size = (STACK_SIZE - g_stack) / FRAME_SIZE; - SCM frames = make_vector_ (size, cell_unspecified); + struct scm *frames = make_vector_ (size, cell_unspecified); long i; for (i = 0; i < size; i = i + 1) { - SCM frame = make_frame (stack, i); + struct scm *frame = make_frame (stack, i); vector_set_x_ (frames, i, frame); } - SCM values = cell_nil; + struct scm *values = cell_nil; values = cons (frames, values); values = cons (cell_symbol_stack, values); return make_struct (stack_type, values, cell_unspecified); } -SCM -stack_length (SCM stack) +struct scm * +stack_length (struct scm *stack) { - SCM frames = struct_ref_ (stack, 3); + struct scm *frames = struct_ref_ (stack, 3); return vector_length (frames); } -SCM -stack_ref (SCM stack, SCM index) +struct scm * +stack_ref (struct scm *stack, struct scm *index) { - SCM frames = struct_ref_ (stack, 3); + struct scm *frames = struct_ref_ (stack, 3); return vector_ref (frames, index); } diff --git a/src/string.c b/src/string.c index 7e7a1ae1..68a14b39 100644 --- a/src/string.c +++ b/src/string.c @@ -40,7 +40,7 @@ assert_max_string (size_t i, char const *msg, char *string) } char const * -list_to_cstring (SCM list, size_t *size) +list_to_cstring (struct scm *list, size_t *size) { size_t i = 0; char *p = g_buf; @@ -48,8 +48,8 @@ list_to_cstring (SCM list, size_t *size) { if (i > MAX_STRING) assert_max_string (i, "list_to_string", g_buf); - SCM x = car (list); - g_buf[i] = VALUE (x); + struct scm *x = car (list); + g_buf[i] = x->value; i = i + 1; list = cdr (list); } @@ -59,16 +59,16 @@ list_to_cstring (SCM list, size_t *size) return g_buf; } -SCM -string_equal_p (SCM a, SCM b) /*:((name . "string=?")) */ +struct scm * +string_equal_p (struct scm *a, struct scm *b) /*:((name . "string=?")) */ { - if (!((TYPE (a) == TSTRING && TYPE (b) == TSTRING) || (TYPE (a) == TKEYWORD || TYPE (b) == TKEYWORD))) + if (!((a->type == TSTRING && b->type == TSTRING) || (a->type == TKEYWORD || b->type == TKEYWORD))) { eputs ("type a: "); - eputs (itoa (TYPE (a))); + eputs (itoa (a->type)); eputs ("\n"); eputs ("type b: "); - eputs (itoa (TYPE (b))); + eputs (itoa (b->type)); eputs ("\n"); eputs ("a= "); write_error_ (a); @@ -76,60 +76,60 @@ string_equal_p (SCM a, SCM b) /*:((name . "string=?")) */ eputs ("b= "); write_error_ (b); eputs ("\n"); - assert_msg ((TYPE (a) == TSTRING && TYPE (b) == TSTRING) || (TYPE (a) == TKEYWORD || TYPE (b) == TKEYWORD), "(TYPE (a) == TSTRING && TYPE (b) == TSTRING) || (TYPE (a) == TKEYWORD || TYPE (b) == TKEYWORD)"); + assert_msg ((a->type == TSTRING && b->type == TSTRING) || (a->type == TKEYWORD || b->type == TKEYWORD), "(a->type == TSTRING && b->type == TSTRING) || (a->type == TKEYWORD || b->type == TKEYWORD)"); } if (a == b) return cell_t; - if (STRING (a) == STRING (b)) + if (a->string == b->string) return cell_t; - if (LENGTH (a) == 0 && LENGTH (b) == 0) + if (a->length == 0 && b->length == 0) return cell_t; - if (LENGTH (a) == LENGTH (b)) - if (memcmp (cell_bytes (STRING (a)), cell_bytes (STRING (b)), LENGTH (a)) == 0) + if (a->length == b->length) + if (memcmp (cell_bytes (a->string), cell_bytes (b->string), a->length) == 0) return cell_t; return cell_f; } -SCM -symbol_to_string (SCM symbol) +struct scm * +symbol_to_string (struct scm *symbol) { - return make_cell (TSTRING, CAR (symbol), CDR (symbol)); + return make_cell (TSTRING, symbol->car, symbol->cdr); } -SCM -symbol_to_keyword (SCM symbol) +struct scm * +symbol_to_keyword (struct scm *symbol) { - return make_cell (TKEYWORD, CAR (symbol), CDR (symbol)); + return make_cell (TKEYWORD, symbol->car, symbol->cdr); } -SCM -keyword_to_string (SCM keyword) +struct scm * +keyword_to_string (struct scm *keyword) { - return make_cell (TSTRING, CAR (keyword), CDR (keyword)); + return make_cell (TSTRING, keyword->car, keyword->cdr); } -SCM -string_to_symbol (SCM string) +struct scm * +string_to_symbol (struct scm *string) { - SCM x = hash_ref (g_symbols, string, cell_f); + struct scm *x = hash_ref (g_symbols, string, cell_f); if (x == cell_f) x = make_symbol (string); return x; } -SCM -make_symbol (SCM string) +struct scm * +make_symbol (struct scm *string) { - SCM x = make_cell (TSYMBOL, LENGTH (string), STRING (string)); + struct scm *x = make_cell (TSYMBOL, string->length, string->string); hash_set_x (g_symbols, string, x); return x; } -SCM +struct scm * bytes_to_list (char const *s, size_t i) { - SCM p = cell_nil; + struct scm *p = cell_nil; while (i != 0) { i = i - 1; @@ -139,42 +139,42 @@ bytes_to_list (char const *s, size_t i) return p; } -SCM +struct scm * cstring_to_list (char const *s) { return bytes_to_list (s, strlen (s)); } -SCM +struct scm * cstring_to_symbol (char const *s) { - SCM string = make_string0 (s); + struct scm *string = make_string0 (s); return string_to_symbol (string); } -SCM -string_to_list (SCM string) +struct scm * +string_to_list (struct scm *string) { - return bytes_to_list (cell_bytes (STRING (string)), LENGTH (string)); + return bytes_to_list (cell_bytes (string->string), string->length); } -SCM -list_to_string (SCM list) +struct scm * +list_to_string (struct scm *list) { size_t size; char const *s = list_to_cstring (list, &size); return make_string (s, size); } -SCM -read_string (SCM port) /*:((arity . n)) */ +struct scm * +read_string (struct scm *port) /*:((arity . n)) */ { int fd = __stdin; - if (TYPE (port) == TPAIR) + if (port->type == TPAIR) { - SCM p = car (port); - if (TYPE (p) == TNUMBER) - __stdin = VALUE (p); + struct scm *p = car (port); + if (p->type == TNUMBER) + __stdin = p->value; } int c = readchar (); size_t i = 0; @@ -191,42 +191,42 @@ read_string (SCM port) /*:((arity . n)) */ return make_string (g_buf, i); } -SCM -string_append (SCM x) /*:((arity . n)) */ +struct scm * +string_append (struct scm *x) /*:((arity . n)) */ { char *p = g_buf; g_buf[0] = 0; size_t size = 0; while (x != cell_nil) { - SCM string = CAR (x); - assert_msg (TYPE (string) == TSTRING, "TYPE (string) == TSTRING"); - memcpy (p, cell_bytes (STRING (string)), LENGTH (string) + 1); - p = p + LENGTH (string); - size = size + LENGTH (string); + struct scm *string = x->car; + assert_msg (string->type == TSTRING, "string->type == TSTRING"); + memcpy (p, cell_bytes (string->string), string->length + 1); + p = p + string->length; + size = size + string->length; if (size > MAX_STRING) assert_max_string (size, "string_append", g_buf); - x = CDR (x); + x = x->cdr; } return make_string (g_buf, size); } -SCM -string_length (SCM string) +struct scm * +string_length (struct scm *string) { - assert_msg (TYPE (string) == TSTRING, "TYPE (string) == TSTRING"); - return make_number (LENGTH (string)); + assert_msg (string->type == TSTRING, "string->type == TSTRING"); + return make_number (string->length); } -SCM -string_ref (SCM str, SCM k) +struct scm * +string_ref (struct scm *str, struct scm *k) { - assert_msg (TYPE (str) == TSTRING, "TYPE (str) == TSTRING"); - assert_msg (TYPE (k) == TNUMBER, "TYPE (k) == TNUMBER"); - size_t size = LENGTH (str); - size_t i = VALUE (k); + assert_msg (str->type == TSTRING, "str->type == TSTRING"); + assert_msg (k->type == TNUMBER, "k->type == TNUMBER"); + size_t size = str->length; + size_t i = k->value; if (i > size) error (cell_symbol_system_error, cons (make_string0 ("value out of range"), k)); - char const *p = cell_bytes (STRING (str)); + char const *p = cell_bytes (str->string); return make_char (p[i]); } diff --git a/src/struct.c b/src/struct.c index 1ef9eca5..1620ee22 100644 --- a/src/struct.c +++ b/src/struct.c @@ -21,70 +21,70 @@ #include "mes/lib.h" #include "mes/mes.h" -SCM -make_struct (SCM type, SCM fields, SCM printer) +struct scm * +make_struct (struct scm *type, struct scm *fields, struct scm *printer) { long size = 2 + length__ (fields); - SCM x = alloc (1); - SCM v = alloc (size); - TYPE (x) = TSTRUCT; - LENGTH (x) = size; - STRUCT (x) = v; + struct scm *x = alloc (1); + struct scm *v = alloc (size); + x->type = TSTRUCT; + x->length = size; + x->structure = v; copy_cell (v, vector_entry (type)); copy_cell (cell_ref (v, 1), vector_entry (printer)); long i; for (i = 2; i < size; i = i + 1) { - SCM e = cell_unspecified; + struct scm *e = cell_unspecified; if (fields != cell_nil) { - e = CAR (fields); - fields = CDR (fields); + e = fields->car; + fields = fields->cdr; } copy_cell (cell_ref (v, i), vector_entry (e)); } return x; } -SCM -struct_length (SCM x) +struct scm * +struct_length (struct scm *x) { - assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT"); - return make_number (LENGTH (x)); + assert_msg (x->type == TSTRUCT, "x->type == TSTRUCT"); + return make_number (x->length); } -SCM -struct_ref_ (SCM x, long i) +struct scm * +struct_ref_ (struct scm *x, long i) { - assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT"); - assert_msg (i < LENGTH (x), "i < LENGTH (x)"); - SCM e = cell_ref (STRUCT (x), i); - if (TYPE (e) == TREF) - e = REF (e); - if (TYPE (e) == TCHAR) - e = make_char (VALUE (e)); - if (TYPE (e) == TNUMBER) - e = make_number (VALUE (e)); + assert_msg (x->type == TSTRUCT, "x->type == TSTRUCT"); + assert_msg (i < x->length, "i < x->length"); + struct scm *e = cell_ref (x->structure, i); + if (e->type == TREF) + e = e->ref; + if (e->type == TCHAR) + e = make_char (e->value); + if (e->type == TNUMBER) + e = make_number (e->value); return e; } -SCM -struct_set_x_ (SCM x, long i, SCM e) +struct scm * +struct_set_x_ (struct scm *x, long i, struct scm *e) { - assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT"); - assert_msg (i < LENGTH (x), "i < LENGTH (x)"); - copy_cell (cell_ref (STRUCT (x), i), vector_entry (e)); + assert_msg (x->type == TSTRUCT, "x->type == TSTRUCT"); + assert_msg (i < x->length, "i < x->length"); + copy_cell (cell_ref (x->structure, i), vector_entry (e)); return cell_unspecified; } -SCM -struct_ref (SCM x, SCM i) +struct scm * +struct_ref (struct scm *x, struct scm *i) { - return struct_ref_ (x, VALUE (i)); + return struct_ref_ (x, i->value); } -SCM -struct_set_x (SCM x, SCM i, SCM e) +struct scm * +struct_set_x (struct scm *x, struct scm *i, struct scm *e) { - return struct_set_x_ (x, VALUE (i), e); + return struct_set_x_ (x, i->value, e); } diff --git a/src/symbol.c b/src/symbol.c index a0642466..c54ac424 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -33,20 +33,20 @@ // CONSTANT M2_CELL_SIZE 12 #endif -SCM g_symbol; +struct scm *g_symbol; -SCM -init_symbol (SCM x, long type, char const *name) +struct scm * +init_symbol (struct scm *x, long type, char const *name) { - TYPE (x) = type; + x->type = type; if (g_symbols == 0) g_free = g_free + M2_CELL_SIZE; else { int length = strlen (name); - SCM string = make_string (name, length); - CAR (x) = length; - CDR (x) = STRING (string); + struct scm *string = make_string (name, length); + x->car = length; + x->cdr = string->string; hash_set_x (g_symbols, string, x); } g_symbol = g_symbol + M2_CELL_SIZE; @@ -177,7 +177,7 @@ init_symbols_ () /*:((internal)) */ cell_symbol_test = init_symbol (g_symbol, TSYMBOL, "%%test"); } -SCM +struct scm * init_symbols () /*:((internal)) */ { g_free = g_cells + M2_CELL_SIZE; @@ -190,7 +190,7 @@ init_symbols () /*:((internal)) */ init_symbols_ (); g_ports = cell_nil; - SCM a = cell_nil; + struct scm *a = cell_nil; a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a); a = acons (cell_symbol_boot_module, cell_symbol_boot_module, a); a = acons (cell_symbol_current_module, cell_symbol_current_module, a); diff --git a/src/test/gc.c b/src/test/gc.c index 4b2a92b6..8d3c70cf 100644 --- a/src/test/gc.c +++ b/src/test/gc.c @@ -46,17 +46,17 @@ test_setup () M0 = cell_zero; memset (g_arena + sizeof (struct scm), 0, ARENA_SIZE * sizeof (struct scm)); - TYPE (cell_zero) = TCHAR; - VALUE (cell_zero) = 'c'; + cell_zero->type = TCHAR; + cell_zero->value = 'c'; g_free = cell_f; } void print_arena (long length) { - SCM v = cell_arena; - TYPE (v) = TVECTOR; - LENGTH (v) = length; + struct scm *v = cell_arena; + v->type = TVECTOR; + v->length = length; eputs ("arena["); eputs (ntoab (g_cells, 16, 0)); eputs ("]: "); write_ (v); eputs ("\n"); } @@ -72,19 +72,19 @@ test_gc (char const *name) eputs ("\n"); gc_ (); - VALUE (cell_zero) = 'd'; + cell_zero->value = 'd'; print_arena (gc_free () - 1); gc_stats_ ("2"); eputs ("\n"); gc_ (); - VALUE (cell_zero) = 'e'; + cell_zero->value = 'e'; print_arena (gc_free () - 1); gc_stats_ ("3"); eputs ("\n"); gc_ (); - VALUE (cell_zero) = 'f'; + cell_zero->value = 'f'; print_arena (gc_free () - 1); gc_stats_ ("3"); eputs ("\n"); @@ -113,8 +113,8 @@ void test_cons () { test_setup (); - SCM a = make_number (42); - SCM d = make_number (101); + struct scm *a = make_number (42); + struct scm *d = make_number (101); cons (a, d); g_free = g_symbol_max + M2_CELL_SIZE; @@ -125,9 +125,9 @@ void test_list () { test_setup (); - SCM a = make_number (42); - SCM d = make_number (101); - SCM lst = cons (d, cell_nil); + struct scm *a = make_number (42); + struct scm *d = make_number (101); + struct scm *lst = cons (d, cell_nil); cons (a, lst); g_free = g_symbol_max + M2_CELL_SIZE; @@ -138,7 +138,7 @@ void test_string () { test_setup (); - SCM s = make_string0 ("hello"); + struct scm *s = make_string0 ("hello"); g_free = g_symbol_max + M2_CELL_SIZE; test_gc ("string"); @@ -148,9 +148,9 @@ void test_vector () { test_setup (); - SCM v = make_vector_ (4, cell_zero); - SCM one = make_number (1); - SCM two = make_number (2); + struct scm *v = make_vector_ (4, cell_zero); + struct scm *one = make_number (1); + struct scm *two = make_number (2); vector_set_x_ (v, 1, one); vector_set_x_ (v, 2, two); @@ -162,9 +162,9 @@ void test_struct () { test_setup (); - SCM type = make_char ('t'); - SCM printer = make_char ('p'); - SCM fields = cons (make_char ('f'), cell_nil); + struct scm *type = make_char ('t'); + struct scm *printer = make_char ('p'); + struct scm *fields = cons (make_char ('f'), cell_nil); make_struct (type, fields, printer); g_free = g_symbol_max + M2_CELL_SIZE; diff --git a/src/vector.c b/src/vector.c index b6f990ad..f34220dc 100644 --- a/src/vector.c +++ b/src/vector.c @@ -29,14 +29,14 @@ // CONSTANT M2_CELL_SIZE 12 #endif -SCM -make_vector_ (long k, SCM e) +struct scm * +make_vector_ (long k, struct scm *e) { - SCM x = alloc (1); - SCM v = alloc (k); - TYPE (x) = TVECTOR; - LENGTH (x) = k; - VECTOR (x) = v; + struct scm *x = alloc (1); + struct scm *v = alloc (k); + x->type = TVECTOR; + x->length = k; + x->vector = v; long i; for (i = 0; i < k; i = i + 1) copy_cell (cell_ref (v, i), vector_entry (e)); @@ -44,75 +44,75 @@ make_vector_ (long k, SCM e) return x; } -SCM -make_vector (SCM x) /*:((arity . n)) */ +struct scm * +make_vector (struct scm *x) /*:((arity . n)) */ { - SCM k = CAR (x); + struct scm *k = x->car; assert_number ("make-vector", k); - long n = VALUE (k); - SCM e = cell_unspecified; - if (CDR (x) != cell_nil) - e = CADR (x); + long n = k->value; + struct scm *e = cell_unspecified; + if (x->cdr != cell_nil) + e = x->cdr->car; return make_vector_ (n, e); } -SCM -vector_length (SCM x) +struct scm * +vector_length (struct scm *x) { - assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR"); - return make_number (LENGTH (x)); + assert_msg (x->type == TVECTOR, "x->type == TVECTOR"); + return make_number (x->length); } -SCM -vector_ref_ (SCM x, long i) +struct scm * +vector_ref_ (struct scm *x, long i) { - assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR"); - assert_msg (i < LENGTH (x), "i < LENGTH (x)"); - SCM e = cell_ref (VECTOR (x), i); - if (TYPE (e) == TREF) - e = REF (e); - if (TYPE (e) == TCHAR) - e = make_char (VALUE (e)); - if (TYPE (e) == TNUMBER) - e = make_number (VALUE (e)); + assert_msg (x->type == TVECTOR, "x->type == TVECTOR"); + assert_msg (i < x->length, "i < x->length"); + struct scm *e = cell_ref (x->vector, i); + if (e->type == TREF) + e = e->ref; + if (e->type == TCHAR) + e = make_char (e->value); + if (e->type == TNUMBER) + e = make_number (e->value); return e; } -SCM -vector_ref (SCM x, SCM i) +struct scm * +vector_ref (struct scm *x, struct scm *i) { - return vector_ref_ (x, VALUE (i)); + return vector_ref_ (x, i->value); } -SCM -vector_entry (SCM x) +struct scm * +vector_entry (struct scm *x) { - if (TYPE (x) != TCHAR && TYPE (x) != TNUMBER) + if (x->type != TCHAR && x->type != TNUMBER) x = make_ref (x); return x; } -SCM -vector_set_x_ (SCM x, long i, SCM e) +struct scm * +vector_set_x_ (struct scm *x, long i, struct scm *e) { - assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR"); - assert_msg (i < LENGTH (x), "i < LENGTH (x)"); - copy_cell (cell_ref (VECTOR (x), i), vector_entry (e)); + assert_msg (x->type == TVECTOR, "x->type == TVECTOR"); + assert_msg (i < x->length, "i < x->length"); + copy_cell (cell_ref (x->vector, i), vector_entry (e)); return cell_unspecified; } -SCM -vector_set_x (SCM x, SCM i, SCM e) +struct scm * +vector_set_x (struct scm *x, struct scm *i, struct scm *e) { - return vector_set_x_ (x, VALUE (i), e); + return vector_set_x_ (x, i->value, e); } -SCM -list_to_vector (SCM x) +struct scm * +list_to_vector (struct scm *x) { - SCM v = make_vector_ (length__ (x), cell_unspecified); - SCM p = VECTOR (v); + struct scm *v = make_vector_ (length__ (x), cell_unspecified); + struct scm *p = v->vector; while (x != cell_nil) { copy_cell (p, vector_entry (car (x))); @@ -122,16 +122,16 @@ list_to_vector (SCM x) return v; } -SCM -vector_to_list (SCM v) +struct scm * +vector_to_list (struct scm *v) { - SCM x = cell_nil; + struct scm *x = cell_nil; long i; - for (i = LENGTH (v); i; i = i - 1) + for (i = v->length; i; i = i - 1) { - SCM e = cell_ref (VECTOR (v), i - 1); - if (TYPE (e) == TREF) - e = REF (e); + struct scm *e = cell_ref (v->vector, i - 1); + if (e->type == TREF) + e = e->ref; x = cons (e, x); } return x;