diff options
| -rw-r--r-- | HISTORY.Snd | 3 | ||||
| -rw-r--r-- | NEWS | 15 | ||||
| -rw-r--r-- | clm.c | 14 | ||||
| -rw-r--r-- | clm2xen.c | 81 | ||||
| -rw-r--r-- | cload.scm | 4 | ||||
| -rwxr-xr-x | configure | 20 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | dsp.scm | 2 | ||||
| -rw-r--r-- | gl.c | 36 | ||||
| -rw-r--r-- | index.html | 696 | ||||
| -rw-r--r-- | libc.scm | 11 | ||||
| -rw-r--r-- | libgtk_s7.c | 82 | ||||
| -rw-r--r-- | lint.scm | 43 | ||||
| -rw-r--r-- | mockery.scm | 20 | ||||
| -rw-r--r-- | peak-phases.scm | 77 | ||||
| -rw-r--r-- | reactive.scm | 373 | ||||
| -rw-r--r-- | repl.scm | 2 | ||||
| -rw-r--r-- | s7.c | 18658 | ||||
| -rw-r--r-- | s7.h | 138 | ||||
| -rw-r--r-- | s7.html | 408 | ||||
| -rw-r--r-- | s7test.scm | 1241 | ||||
| -rw-r--r-- | singer.scm | 21 | ||||
| -rw-r--r-- | snd-chn.c | 192 | ||||
| -rw-r--r-- | snd-dac.c | 22 | ||||
| -rw-r--r-- | snd-draw.c | 78 | ||||
| -rw-r--r-- | snd-env.c | 26 | ||||
| -rw-r--r-- | snd-fft.c | 8 | ||||
| -rw-r--r-- | snd-file.c | 76 | ||||
| -rw-r--r-- | snd-gchn.c | 6 | ||||
| -rw-r--r-- | snd-gxcolormaps.c | 8 | ||||
| -rw-r--r-- | snd-help.c | 10 | ||||
| -rw-r--r-- | snd-lint.scm | 2 | ||||
| -rw-r--r-- | snd-listener.c | 12 | ||||
| -rw-r--r-- | snd-main.c | 114 | ||||
| -rw-r--r-- | snd-marks.c | 8 | ||||
| -rw-r--r-- | snd-mix.c | 18 | ||||
| -rw-r--r-- | snd-motif.c | 6 | ||||
| -rw-r--r-- | snd-print.c | 18 | ||||
| -rw-r--r-- | snd-region.c | 12 | ||||
| -rw-r--r-- | snd-sig.c | 11 | ||||
| -rw-r--r-- | snd-snd.c | 64 | ||||
| -rw-r--r-- | snd-test.scm | 18 | ||||
| -rw-r--r-- | snd-xref.c | 1391 | ||||
| -rw-r--r-- | snd.h | 6 | ||||
| -rw-r--r-- | snd15.scm | 2 | ||||
| -rw-r--r-- | sndlib2xen.c | 12 | ||||
| -rw-r--r-- | stuff.scm | 360 | ||||
| -rw-r--r-- | tools/auto-tester.scm | 8 | ||||
| -rwxr-xr-x | tools/compsnd | 106 | ||||
| -rw-r--r-- | tools/crossref.c | 7 | ||||
| -rw-r--r-- | tools/ffitest.c | 59 | ||||
| -rw-r--r-- | tools/gdbinit | 18 | ||||
| -rw-r--r-- | tools/t101.scm | 6 | ||||
| -rw-r--r-- | tools/tauto.scm | 6 | ||||
| -rw-r--r-- | tools/tbig.scm | 172 | ||||
| -rw-r--r-- | tools/tcopy.scm | 7 | ||||
| -rwxr-xr-x | tools/testsnd | 40 | ||||
| -rw-r--r-- | tools/tform.scm | 4 | ||||
| -rw-r--r-- | tools/tgen.scm | 6 | ||||
| -rw-r--r-- | tools/titer.scm | 19 | ||||
| -rw-r--r-- | tools/tpeak.scm | 117 | ||||
| -rw-r--r-- | tools/tread.scm | 6 | ||||
| -rw-r--r-- | tools/valcall.scm | 10 | ||||
| -rw-r--r-- | xg.c | 82 |
64 files changed, 13588 insertions, 11514 deletions
diff --git a/HISTORY.Snd b/HISTORY.Snd index fa6ed2b..7fa2428 100644 --- a/HISTORY.Snd +++ b/HISTORY.Snd @@ -1,5 +1,6 @@ Snd change log - + + 1-Aug: Snd 18.6. 2-Jul: Snd 18.5. 29-May: Snd 18.4. 24-Apr: Snd 18.3. @@ -1,7 +1,16 @@ -Snd 18.5: +Snd 18.6. -s7 to version 7 (many internal changes). +clm: Kjetil added a method to the granulate generator to set the jitter amount. -checked: sbcl 1.4.8|9, gtk 3.94.0 +s7: changed make-shared-vector to make-subvector (Matlab terminology) + added subvector?, subvector-position, subvector-vector + added make-weak-hash-table, weak-hash-table? + s7 is now thread-safe, I think. + symbol-setter has been folded into setter. + c-pointer-info|type|weak1|weak2 (the latter are "weak" values) + reactive.scm (the old stuff.scm code rewritten). + +checked: sbcl 1.4.10 Thanks!: Kjetil Matheussen + @@ -13821,6 +13821,14 @@ static mus_long_t grn_location(mus_any *ptr) {return((mus_long_t)(((grn_info *)p static mus_long_t grn_set_location(mus_any *ptr, mus_long_t val) {((grn_info *)ptr)->randx = (unsigned long)val; return(val);} static mus_float_t grn_jitter(mus_any *ptr) {return(((grn_info *)ptr)->jitter);} +static mus_float_t grn_set_jitter(mus_any *ptr, mus_float_t val) /* K Matheussen 15-Jul-18 */ +{ + grn_info *gen = (grn_info *)ptr; + gen->jitter = val; + gen->s20 = 2 * (int)(val * gen->output_hop); + gen->s50 = (int)(val * gen->output_hop * 0.4); + return(val); +} static mus_float_t run_granulate(mus_any *ptr, mus_float_t unused1, mus_float_t unused2) {return(mus_granulate(ptr, NULL));} @@ -13865,7 +13873,8 @@ static mus_any_class GRANULATE_CLASS = { MUS_NOT_SPECIAL, &grn_closure, 0, - &grn_jitter, 0, 0, 0, 0, 0, + &grn_jitter, &grn_set_jitter, + 0, 0, 0, 0, &grn_hop, &grn_set_hop, &grn_ramp, &grn_set_ramp, 0, 0, 0, 0, @@ -13917,7 +13926,8 @@ mus_any *mus_make_granulate(mus_float_t (*input)(void *arg, int direction), spd->s50 = (int)(jitter * sampling_rate * hop * 0.4); spd->out_data_len = outlen; spd->out_data = (mus_float_t *)calloc(spd->out_data_len, sizeof(mus_float_t)); - spd->in_data_len = outlen + spd->s20 + 1; + /* spd->in_data_len = outlen + spd->s20 + 1; */ + spd->in_data_len = outlen + (2 * sampling_rate * hop) + 1; spd->in_data = (mus_float_t *)malloc(spd->in_data_len * sizeof(mus_float_t)); spd->rd = input; spd->block_rd = NULL; @@ -2313,7 +2313,6 @@ static Xen g_mus_set_ycoeff(Xen gen, Xen index, Xen val) return(val); } - Xen g_mus_channels(Xen gen) { #define H_mus_channels "(" S_mus_channels " gen): gen's " S_mus_channels " field, if any" @@ -2327,7 +2326,7 @@ Xen g_mus_channels(Xen gen) if (mus_is_vct(gen)) { if (Xen_vector_rank(gen) > 1) - return(C_int_to_Xen_integer(s7_vector_dimensions(gen)[0])); + return(C_int_to_Xen_integer(s7_vector_dimension(gen, 0))); else return(C_int_to_Xen_integer(1)); } #else @@ -2431,7 +2430,7 @@ D_METHOD(feedforward) D_METHOD(feedback) #define I_METHOD(Func) \ - static s7_int mus_ ## Func ## _ip(s7_pointer o) \ + static s7_int mus_ ## Func ## _ip(s7_scheme *sc, s7_pointer o) \ { \ return(mus_ ## Func(Xen_to_mus_any(o))); \ } @@ -7980,12 +7979,18 @@ static mus_float_t in_any_3(const char *caller, mus_long_t pos, int in_chan, Xen if (pos < s7_vector_length(inp)) { s7_double *els; + s7_int rank; els = s7_float_vector_elements(inp); - if (s7_vector_rank(inp) > 1) + rank = s7_vector_rank(inp); + if (rank > 1) { s7_int *offsets; - offsets = s7_vector_offsets(inp); - return(els[in_chan * offsets[0] + pos]); + s7_double x; + offsets = (s7_int *)malloc(rank * sizeof(s7_int)); + s7_vector_offsets(inp, offsets, rank); + x = els[in_chan * offsets[0] + pos]; + free(offsets); + return(x); } return(els[pos]); } @@ -8083,10 +8088,14 @@ static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn else { s7_int *offsets; - offsets = s7_vector_offsets(outp); + s7_int rank; + rank = s7_vector_rank(outp); + offsets = (s7_int *)malloc(rank * sizeof(s7_int)); + s7_vector_offsets(outp, offsets, rank); pos += (chn * offsets[0]); if (pos < mus_vct_length(v)) vdata[pos] += inv; + free(offsets); } #endif return(xen_float_zero); @@ -8145,11 +8154,11 @@ static Xen out_any_2_to_vct(mus_long_t pos, mus_float_t inv, int chn, const char else { s7_int chans; - chans = s7_vector_dimensions(clm_output_vct)[0]; + chans = s7_vector_dimension(clm_output_vct, 0); if (chn < chans) { s7_int chan_len; - chan_len = s7_vector_dimensions(clm_output_vct)[1]; + chan_len = s7_vector_dimension(clm_output_vct, 1); if (pos < chan_len) vdata[chn * chan_len + pos] += inv; } @@ -8917,7 +8926,7 @@ static void mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any * else { s7_int chan_len; - chan_len = s7_vector_dimensions(output)[1]; /* '(4 20) so each chan len is [1] */ + chan_len = s7_vector_dimension(output, 1); if (pos < chan_len) { int i; @@ -8954,7 +8963,7 @@ static void mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any * else { s7_int chan_len; - chan_len = s7_vector_dimensions(reverb)[1]; + chan_len = s7_vector_dimension(reverb, 1); if (pos < chan_len) { int i; @@ -9068,7 +9077,7 @@ static s7_pointer g_make_locsig(s7_scheme *sc, s7_pointer args) if (s7_is_float_vector(ov)) { if (s7_vector_rank(ov) > 1) - out_chans = s7_vector_dimensions(ov)[0]; + out_chans = s7_vector_dimension(ov, 0); else out_chans = 1; } else @@ -9093,7 +9102,7 @@ static s7_pointer g_make_locsig(s7_scheme *sc, s7_pointer args) if (s7_is_float_vector(rv)) { if (s7_vector_rank(rv) > 1) - rev_chans = s7_vector_dimensions(rv)[0]; + rev_chans = s7_vector_dimension(rv, 0); else rev_chans = 1; } else @@ -9239,7 +9248,7 @@ static Xen g_make_locsig(Xen arglist) if ((out_chans < 0) && (s7_is_vector(ov)) && (s7_vector_rank(ov) > 1)) - out_chans = s7_vector_dimensions(ov)[0]; + out_chans = s7_vector_dimension(ov, 0); #endif } @@ -9258,7 +9267,7 @@ static Xen g_make_locsig(Xen arglist) rev_chans = 1; #if HAVE_SCHEME if (Xen_vector_rank(rv) > 1) - rev_chans = s7_vector_dimensions(rv)[0]; + rev_chans = s7_vector_dimension(rv, 0); #endif } else Xen_check_type(Xen_is_keyword(keys[4]) || Xen_is_false(keys[4]), keys[4], orig_arg[4], S_make_locsig, "a reverb output generator"); @@ -11675,7 +11684,7 @@ GEN_2(tap, mus_tap_unmodulated, mus_tap) * need a simple version of the generator). */ -static s7_double file_to_sample_dpi(s7_pointer p, s7_int index) +static s7_double file_to_sample_d7pi(s7_scheme *sc, s7_pointer p, s7_int index) { mus_any *g = NULL; mus_xen *gn; @@ -11786,7 +11795,7 @@ static s7_double mus_set_formant_radius_and_frequency_dvdd(void *o, s7_double x1 } -static s7_double out_bank_d_pid(s7_pointer gens, s7_int loc, s7_double x) +static s7_double out_bank_d_7pid(s7_scheme *sc, s7_pointer gens, s7_int loc, s7_double x) { int i, len; s7_pointer *els; @@ -12077,7 +12086,7 @@ static void init_choosers(s7_scheme *sc) s7_set_d_ip_function(s7_name_to_value(sc, S_ina), ina_dip); s7_set_d_ip_function(s7_name_to_value(sc, S_inb), inb_dip); - s7_set_d_pi_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_dpi); + s7_set_d_7pi_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_d7pi); s7_set_d_p_function(s7_name_to_value(sc, S_pink_noise), mus_pink_noise); s7_set_d_pd_function(s7_name_to_value(sc, S_piano_noise), piano_noise_d_pd); @@ -12087,7 +12096,7 @@ static void init_choosers(s7_scheme *sc) s7_set_d_vid_function(s7_name_to_value(sc, S_locsig), locsig_d_vid); s7_set_d_vid_function(s7_name_to_value(sc, S_locsig_set), locsig_set_d_vid); - s7_set_d_pid_function(s7_name_to_value(sc, S_out_bank), out_bank_d_pid); + s7_set_d_7pid_function(s7_name_to_value(sc, S_out_bank), out_bank_d_7pid); s7_set_b_p_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_b); s7_set_b_p_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_b); @@ -12148,13 +12157,13 @@ static void init_choosers(s7_scheme *sc) s7_set_d_p_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_dp); s7_set_d_p_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_dp); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_length), mus_length_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_order), mus_order_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_location), mus_location_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_channel), mus_channel_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_channels), mus_channels_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_ip); - s7_set_i_p_function(s7_name_to_value(sc, S_mus_hop), mus_hop_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_length), mus_length_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_order), mus_order_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_location), mus_location_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_channel), mus_channel_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_channels), mus_channels_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_ip); + s7_set_i_7p_function(s7_name_to_value(sc, S_mus_hop), mus_hop_ip); #endif /* gmp */ } @@ -13017,22 +13026,22 @@ static void mus_xen_init(void) #if HAVE_SCHEME clm_srate_symbol = s7_define_variable(s7, "*clm-srate*", s7_make_real(s7, MUS_DEFAULT_SAMPLING_RATE)); - s7_symbol_set_setter(s7, clm_srate_symbol, s7_make_function(s7, "[acc-clm-srate]", acc_clm_srate, 2, 0, false, "accessor")); + s7_set_setter(s7, clm_srate_symbol, s7_make_function(s7, "[acc-clm-srate]", acc_clm_srate, 2, 0, false, "accessor")); clm_table_size_symbol = s7_define_variable(s7, "*" S_clm_table_size "*", s7_make_integer(s7, MUS_CLM_DEFAULT_TABLE_SIZE)); - s7_symbol_set_documentation(s7, clm_table_size_symbol, "*clm-table-size*: the default table size for most generators (512)"); - s7_symbol_set_setter(s7, clm_table_size_symbol, s7_make_function(s7, "[acc-clm-table-size]", acc_clm_table_size, 2, 0, false, "accessor")); + s7_set_documentation(s7, clm_table_size_symbol, "*clm-table-size*: the default table size for most generators (512)"); + s7_set_setter(s7, clm_table_size_symbol, s7_make_function(s7, "[acc-clm-table-size]", acc_clm_table_size, 2, 0, false, "accessor")); mus_file_buffer_size_symbol = s7_define_variable(s7, "*clm-file-buffer-size*", s7_make_integer(s7, MUS_DEFAULT_FILE_BUFFER_SIZE)); - s7_symbol_set_setter(s7, mus_file_buffer_size_symbol, s7_make_function(s7, "[acc-mus-file-buffer-size]", acc_mus_file_buffer_size, 2, 0, false, "accessor")); + s7_set_setter(s7, mus_file_buffer_size_symbol, s7_make_function(s7, "[acc-mus-file-buffer-size]", acc_mus_file_buffer_size, 2, 0, false, "accessor")); mus_float_equal_fudge_factor_symbol = s7_define_variable(s7, "*" S_mus_float_equal_fudge_factor "*", s7_make_real(s7, 0.0000001)); /* clm.c */ - s7_symbol_set_documentation(s7, mus_float_equal_fudge_factor_symbol, "*mus-float-equal-fudge-factor*: floating point equality fudge factor"); - s7_symbol_set_setter(s7, mus_float_equal_fudge_factor_symbol, s7_make_function(s7, "[acc-mus-float-equal-fudge-factor]", acc_mus_float_equal_fudge_factor, 2, 0, false, "accessor")); + s7_set_documentation(s7, mus_float_equal_fudge_factor_symbol, "*mus-float-equal-fudge-factor*: floating point equality fudge factor"); + s7_set_setter(s7, mus_float_equal_fudge_factor_symbol, s7_make_function(s7, "[acc-mus-float-equal-fudge-factor]", acc_mus_float_equal_fudge_factor, 2, 0, false, "accessor")); mus_array_print_length_symbol = s7_define_variable(s7, "*" S_mus_array_print_length "*", s7_make_integer(s7, MUS_DEFAULT_ARRAY_PRINT_LENGTH)); - s7_symbol_set_documentation(s7, mus_array_print_length_symbol, "*mus-array-print-length*: current clm array print length (default is 8)."); - s7_symbol_set_setter(s7, mus_array_print_length_symbol, s7_make_function(s7, "[acc-mus-array-print-length]", acc_mus_array_print_length, 2, 0, false, "accessor")); + s7_set_documentation(s7, mus_array_print_length_symbol, "*mus-array-print-length*: current clm array print length (default is 8)."); + s7_set_setter(s7, mus_array_print_length_symbol, s7_make_function(s7, "[acc-mus-array-print-length]", acc_mus_array_print_length, 2, 0, false, "accessor")); g_clm_let = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), s7_make_function(s7, "generator->let", generator_to_let, 2, 0, false, "clm generator object->let method")))); @@ -13479,10 +13488,10 @@ static void mus_xen_init(void) out_any_2 = out_any_2_to_mus_xen; /* these can't be safe functions */ clm_output_accessor = s7_make_function(s7, "(set " S_output ")", g_clm_output_set, 2, 0, false, "called if " S_output " is set"); - s7_symbol_set_setter(s7, s7_make_symbol(s7, S_output), clm_output_accessor); + s7_set_setter(s7, s7_make_symbol(s7, S_output), clm_output_accessor); clm_reverb_accessor = s7_make_function(s7, "(set " S_reverb ")", g_clm_reverb_set, 2, 0, false, "called if " S_reverb " is set"); - s7_symbol_set_setter(s7, s7_make_symbol(s7, S_reverb), clm_reverb_accessor); + s7_set_setter(s7, s7_make_symbol(s7, S_reverb), clm_reverb_accessor); } #endif @@ -415,8 +415,8 @@ (set! local-name "_i") (format p "static s7_int ~A~A(void) {return(~A());}~%" func-name local-name func-name)) ((double) - (set! local-name "_i_d") - (format p "static s7_int ~A~A(s7_double x) {return(~A(x));}~%" func-name local-name func-name)) + (set! local-name "_i_7d") + (format p "static s7_int ~A~A(s7_scheme *sc, s7_double x) {return(~A(x));}~%" func-name local-name func-name)) ((int) (if (= num-args 1) (begin @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for snd 18.5. +# Generated by GNU Autoconf 2.69 for snd 18.6. # # Report bugs to <bil@ccrma.stanford.edu>. # @@ -580,8 +580,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='snd' PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-18.tar.gz' -PACKAGE_VERSION='18.5' -PACKAGE_STRING='snd 18.5' +PACKAGE_VERSION='18.6' +PACKAGE_STRING='snd 18.6' PACKAGE_BUGREPORT='bil@ccrma.stanford.edu' PACKAGE_URL='' @@ -1324,7 +1324,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures snd 18.5 to adapt to many kinds of systems. +\`configure' configures snd 18.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1395,7 +1395,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of snd 18.5:";; + short | recursive ) echo "Configuration of snd 18.6:";; esac cat <<\_ACEOF @@ -1514,7 +1514,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -snd configure 18.5 +snd configure 18.6 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1975,7 +1975,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by snd $as_me 18.5, which was +It was created by snd $as_me 18.6, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3322,7 +3322,7 @@ LOCAL_LANGUAGE="None" GRAPHICS_TOOLKIT="None" PACKAGE=Snd -VERSION=18.5 +VERSION=18.6 #-------------------------------------------------------------------------------- # configuration options @@ -6888,7 +6888,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by snd $as_me 18.5, which was +This file was extended by snd $as_me 18.6, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6950,7 +6950,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -snd config.status 18.5 +snd config.status 18.6 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index c8d1110..f93d60a 100644 --- a/configure.ac +++ b/configure.ac @@ -5,7 +5,7 @@ # gmp, mpfr, and mpc deliberately have none! -AC_INIT(snd, 18.5, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-18.tar.gz) +AC_INIT(snd, 18.6, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-18.tar.gz) AC_CONFIG_SRCDIR(snd.c) AC_CANONICAL_HOST # needed by case $host below @@ -24,7 +24,7 @@ LOCAL_LANGUAGE="None" GRAPHICS_TOOLKIT="None" PACKAGE=Snd -VERSION=18.5 +VERSION=18.6 #-------------------------------------------------------------------------------- # configuration options @@ -339,7 +339,7 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do (data1 (make-float-vector (+ len 1)))) (copy data data1 1) (float-vector-abs! (float-vector-multiply! data1 data)) - (float-vector-multiply! data (make-shared-vector data1 (list len) 1)) + (float-vector-multiply! data (subvector data1 (list len) 1)) (let ((amp1 (/ amp (float-vector-peak data)))) (float-vector->channel (float-vector-scale! data amp1) 0 len snd chn current-edit-position "spike"))))))) @@ -4455,7 +4455,7 @@ static void define_functions(void) { #if HAVE_SCHEME static s7_pointer s_boolean, s_integer, s_real, s_any; -static s7_pointer pl_i, pl_prrrt, pl_prrrrtttrrt, pl_iiiiiit, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_bi, pl_bit, pl_t, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiiiiit, pl_ti, pl_tir, pl_tit, pl_tiit, pl_tiir, pl_tiib, pl_tiiit, pl_tiiib, pl_tiiiit, pl_tirrir, pl_tibiit, pl_tirriit, pl_tiiiiit, pl_tb, pl_bt, pl_tr, pl_trrrrt, pl_pit, pl_ttr, pl_ttb, pl_tti, pl_ttri, pl_ttit, pl_ttir, pl_piit, pl_piiit, pl_ttiti, pl_ttrri, pl_ttrrri, pl_ttrriir, pl_ttititi, pl_ttititiiti; +static s7_pointer pl_pit, pl_piit, pl_piiit, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiiiiit, pl_ti, pl_tir, pl_tit, pl_tiit, pl_tiir, pl_tiib, pl_tiiit, pl_tiiib, pl_tiiiit, pl_tirrir, pl_tibiit, pl_tirriit, pl_tiiiiit, pl_tb, pl_bt, pl_prrrt, pl_prrrrtttrrt, pl_t, pl_tr, pl_trrrrt, pl_iiiiiit, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_bi, pl_bit, pl_i, pl_ttr, pl_ttb, pl_tti, pl_ttri, pl_ttit, pl_ttir, pl_ttiti, pl_ttrri, pl_ttrrri, pl_ttrriir, pl_ttititi, pl_ttititiiti; #if USE_MOTIF static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb; #endif @@ -4465,19 +4465,9 @@ static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb; s_real = s7_make_symbol(s7, "real?"); s_any = s7_t(s7); - pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); - pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any); - pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any); - pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer); - pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any); - pl_t = s7_make_circular_signature(s7, 0, 1, s_any); + pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any); + pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any); + pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any); pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any); pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); @@ -4500,17 +4490,27 @@ static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb; pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean); pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any); + pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any); + pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any); + pl_t = s7_make_circular_signature(s7, 0, 1, s_any); pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real); pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any); - pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any); + pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer); + pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any); + pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); pl_ttr = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_real); pl_ttb = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_boolean); pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer); pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer); pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any); pl_ttir = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_real); - pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any); - pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any); pl_ttiti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_integer, s_any, s_integer); pl_ttrri = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_real, s_real, s_integer); pl_ttrrri = s7_make_circular_signature(s7, 5, 6, s_any, s_any, s_real, s_real, s_real, s_integer); @@ -5736,7 +5736,7 @@ void Init_libgl(void) define_integers(); define_functions(); Xen_provide_feature("gl"); - Xen_define("gl-version", C_string_to_Xen_string("30-Jun-18")); + Xen_define("gl-version", C_string_to_Xen_string("27-Jul-18")); gl_already_inited = true; } } @@ -37,356 +37,354 @@ </head> <body class="body"> <div class="topheader">Index</div> -<!-- created 16-Jun-18 07:51 PDT --> +<!-- created 29-Jul-18 16:43 PDT --> <table> - <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td></tr> - <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenweight">even-weight</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsrc">expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#setter">setter</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr> - <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr> - <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr> - <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="s7.html#signature">signature</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttolet">object->let</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr> - <tr><td class="green"><div class="centered">B</div></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nkssb">make-nkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#flattenpartials">flatten-partials</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fv">float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtolist">float-vector->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtostring">float-vector->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmultiply">float-vector-multiply!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fvpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvref">float-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvreverse">float-vector-reverse!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bytevectortostring">byte-vector->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvscale">float-vector-scale!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bytevectorref">byte-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bytevectorset">byte-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#fvp">float-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr> - <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="extsnd.html#Floatvectors"><b>Float-vectors</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k!cos">make-r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td><em class=tab><a href="s7.html#pairfilename">pair-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab><a href="s7.html#pairlinenumber">pair-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixfv">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointertolist">c-pointer->list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channeltofv">channel->float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#charposition">char-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stdinprompt">stdin-prompt</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="s7.html#stringtobytevector">string->byte-vector</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolsetter">symbol-setter</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr> - <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr> - <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td class="green"><div class="centered">R</div></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr> - <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtofv">mix->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableset">hash-table-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtofv">transform->float-vector</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#fvcopy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="s7.html#readerrorhook">*read-error-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfv">mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#curlet">curlet</a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="s7.html#treecount">tree-count</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="s7.html#treecyclic">tree-cyclic?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontofv">region->float-vector</a></em></td><td></td><td><em class=tab><a href="s7.html#treeleaves">tree-leaves</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab><a href="s7.html#treememq">tree-memq</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="s7.html#immutableb">immutable!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#treesetmemq">tree-set-memq</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="s7.html#immutablep">immutable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr> - <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="s7.html#typeof">type-of</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr> - <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#replacewithselection">replace-with-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorref">int-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr> - <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr> - <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb">rkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr> - <tr><td><em class=tab><a href="s7.html#documentation">documentation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-copy">mus-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#dolph">dolph</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="s7.html#withbaffle">with-baffle</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr> - <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr> - <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampletype">sample-type</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="s7.html#lettemporarily">let-temporarily</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr> - <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr> - <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr> - <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr> - <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr> - <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab> </em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframples">mus-sound-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr> - <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td> -</tr> - <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td> -</tr> - <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td> -</tr> - <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td> + <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td></tr> + <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenweight">even-weight</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsrc">expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="s7.html#setter">setter</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr> + <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr> + <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr> + <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="s7.html#signature">signature</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr> + <tr><td class="green"><div class="centered">B</div></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttolet">object->let</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nkssb">make-nkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="sndscm.html#flattenpartials">flatten-partials</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fv">float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtolist">float-vector->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtostring">float-vector->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmultiply">float-vector-multiply!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fvpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytevectortostring">byte-vector->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvref">float-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytevectorref">byte-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvreverse">float-vector-reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytevectorset">byte-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvscale">float-vector-scale!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr> + <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#fvp">float-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Floatvectors"><b>Float-vectors</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k!cos">make-r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td><em class=tab><a href="s7.html#pairfilename">pair-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab><a href="s7.html#pairlinenumber">pair-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointertolist">c-pointer->list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixfv">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointinfo">c-pointer-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointtype">c-pointer-type</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointweak1">c-pointer-weak1</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channeltofv">channel->float-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#charposition">char-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#stdinprompt">stdin-prompt</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="s7.html#makeweakhashtable">make-weak-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="s7.html#stringtobytevector">string->byte-vector</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#subvector">subvector</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorposition">subvector-position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorvector">subvector-vector</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="s7.html#subvectorp">subvector?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr> + <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab> </em></td><td></td><td class="green"><div class="centered">T</div></td></tr> + <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td class="green"><div class="centered">R</div></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr> + <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtofv">mix->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableset">hash-table-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="s7.html#readerrorhook">*read-error-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtofv">transform->float-vector</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#fvcopy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfv">mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#curlet">curlet</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontofv">region->float-vector</a></em></td><td></td><td><em class=tab><a href="s7.html#treecount">tree-count</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab><a href="s7.html#treecyclic">tree-cyclic?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#treeleaves">tree-leaves</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="s7.html#immutableb">immutable!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="s7.html#treememq">tree-memq</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="s7.html#immutablep">immutable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="s7.html#treesetmemq">tree-set-memq</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr> + <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="s7.html#typeof">type-of</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr> + <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#replacewithselection">replace-with-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorref">int-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr> + <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr> + <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb">rkssb</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#weakhashtablep">weak-hash-table?</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-copy">mus-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr> + <tr><td><em class=tab><a href="s7.html#documentation">documentation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#dolph">dolph</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="s7.html#withbaffle">with-baffle</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr> + <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr> + <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampletype">sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="s7.html#lettemporarily">let-temporarily</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr> + <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr> + <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr> + <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr> + <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr> + <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframples">mus-sound-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr> + <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab> </em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr> + <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td> </tr> </table> @@ -219,6 +219,16 @@ (int strcasecmp (char* char*)) (int strncasecmp (char* char* size_t)) + (reader-cond + ((provided? 'linux) + ;; -------- semaphore.h -------- + (int sem_init (sem_t* int int)) + (int sem_destroy (sem_t*)) + (sem_t* sem_open (char* int int int)) + (int sem_close (sem_t*)) + (int sem_unlink (char*)) + (int sem_wait (sem_t*)) + (int sem_post (sem_t*)))) ;; -------- stdio.h -------- (C-macro (int (_IOFBF _IOLBF _IONBF BUFSIZ EOF L_tmpnam TMP_MAX FILENAME_MAX L_ctermid L_cuserid FOPEN_MAX IOV_MAX))) @@ -1727,6 +1737,7 @@ "fenv.h" "stdio.h" "sys/utsname.h" "unistd.h" "dirent.h" "ftw.h" "sys/stat.h" "time.h" "sys/time.h" "utime.h" "termios.h" "grp.h" "pwd.h" "fnmatch.h" "glob.h" "signal.h" "sys/wait.h" "netdb.h" "sys/resource.h" + (reader-cond ((provided? 'linux) "semaphore.h")) (reader-cond ((not (provided? 'openbsd)) "wordexp.h")) (reader-cond ((provided? 'freebsd) "sys/socket.h" "netinet/in.h")) ) diff --git a/libgtk_s7.c b/libgtk_s7.c index 51545ae..991e276 100644 --- a/libgtk_s7.c +++ b/libgtk_s7.c @@ -48557,13 +48557,13 @@ static void define_structs(s7_scheme *sc) static void define_functions(s7_scheme *sc) { s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false; - s7_pointer pl_gi, pl_igi, pl_du, pl_pr, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_iit, pl_iiit, pl_t, pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_iu, pl_pi, pl_iur, pl_tts, pl_tti, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_bi, pl_big, pl_sg, pl_gs, pl_pu, pl_pur, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_si, pl_is, pl_isi, pl_sig, pl_isgt, pl_isigutttiiu, pl_g, pl_buuusuug, pl_bu, pl_pb, pl_bur, pl_bug, pl_bus, pl_bui, pl_bub, pl_buui, pl_buus, pl_busu, pl_buub, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_i, pl_su, pl_ps, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_psgbiiiit, pl_psiiuusu, pl_tg, pl_ti, pl_it, pl_tiu, pl_itsub, pl_itiiub, pl_itstttg, pl_itgiiut, pl_bsu, pl_bsigb, pl_p, pl_ssi, pl_ssig, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_b, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_s, pl_bt, pl_tb, pl_bti, pl_btiib, pl_ts, pl_tsi, pl_tsig, pl_tsiu, pl_tsiuui, pl_tsiiuui, pl_bpt; + s7_pointer pl_iu, pl_pi, pl_iur, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_t, pl_bi, pl_big, pl_gi, pl_igi, pl_pu, pl_pur, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_si, pl_is, pl_isi, pl_tts, pl_tti, pl_sig, pl_isgt, pl_isigutttiiu, pl_buuusuug, pl_bu, pl_pb, pl_bur, pl_bug, pl_bus, pl_bui, pl_bub, pl_buui, pl_buus, pl_busu, pl_buub, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_su, pl_ps, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_psgbiiiit, pl_psiiuusu, pl_i, pl_bsu, pl_bsigb, pl_sg, pl_gs, pl_ti, pl_it, pl_tiu, pl_itsub, pl_itiiub, pl_itstttg, pl_itgiiut, pl_ssi, pl_ssig, pl_p, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_b, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_g, pl_s, pl_bt, pl_tb, pl_bti, pl_btiib, pl_du, pl_pr, pl_tg, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_iit, pl_iiit, pl_ts, pl_tsi, pl_tsig, pl_tsiu, pl_tsiuui, pl_tsiiuui, pl_bpt; #if GTK_CHECK_VERSION(3, 0, 0) - s7_pointer pl_pgr, pl_gug, pl_puuig, pl_puiiui, pl_buigu, pl_tuuugi, pl_tuuuub; + s7_pointer pl_puuig, pl_puiiui, pl_buigu, pl_pgr, pl_gug, pl_tuuugi, pl_tuuuub; #endif #if GTK_CHECK_VERSION(3, 4, 0) - s7_pointer pl_prrru, pl_suiig, pl_tsu; + s7_pointer pl_suiig, pl_prrru, pl_tsu; #endif #if GTK_CHECK_VERSION(3, 6, 0) @@ -48587,7 +48587,7 @@ static void define_functions(s7_scheme *sc) #endif #if GTK_CHECK_VERSION(3, 99, 0) - s7_pointer pl_guugbuut, pl_iuugs, pl_piigui, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_but, pl_busi, pl_buib, pl_bugu, pl_pst, pl_tist, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru, pl_tsit; + s7_pointer pl_iuugs, pl_piigui, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_but, pl_busi, pl_buib, pl_bugu, pl_guugbuut, pl_pst, pl_tist, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru, pl_tsit; #endif @@ -48601,33 +48601,9 @@ static void define_functions(s7_scheme *sc) s_gtk_enum_t = s7_make_symbol(sc, "gtk_enum_t?"); s_any = s7_t(sc); - pl_gi = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_integer); - pl_igi = s7_make_circular_signature(sc, 2, 3, s_integer, s_gtk_enum_t, s_integer); - pl_du = s7_make_circular_signature(sc, 1, 2, s_float, s_pair_false); - pl_pr = s7_make_circular_signature(sc, 1, 2, s_pair, s_real); - pl_dui = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_integer); - pl_dus = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_string); - pl_dusi = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_integer); - pl_dusr = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_real); - pl_iit = s7_make_circular_signature(sc, 2, 3, s_integer, s_integer, s_any); - pl_iiit = s7_make_circular_signature(sc, 3, 4, s_integer, s_integer, s_integer, s_any); - pl_t = s7_make_circular_signature(sc, 0, 1, s_any); - pl_gu = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_pair_false); - pl_pg = s7_make_circular_signature(sc, 1, 2, s_pair, s_gtk_enum_t); - pl_gus = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_string); - pl_pgi = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_integer); - pl_pgu = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); - pl_gui = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); - pl_guut = s7_make_circular_signature(sc, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); - pl_pgbi = s7_make_circular_signature(sc, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); - pl_guuut = s7_make_circular_signature(sc, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); - pl_gurrsiu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); - pl_gussitu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); pl_iu = s7_make_circular_signature(sc, 1, 2, s_integer, s_pair_false); pl_pi = s7_make_circular_signature(sc, 1, 2, s_pair, s_integer); pl_iur = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_real); - pl_tts = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_string); - pl_tti = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_integer); pl_iug = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_gtk_enum_t); pl_iui = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_integer); pl_ius = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_string); @@ -48640,10 +48616,11 @@ static void define_functions(s7_scheme *sc) pl_iuisi = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer); pl_iuuuui = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer); pl_iuisut = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any); + pl_t = s7_make_circular_signature(sc, 0, 1, s_any); pl_bi = s7_make_circular_signature(sc, 1, 2, s_boolean, s_integer); pl_big = s7_make_circular_signature(sc, 2, 3, s_boolean, s_integer, s_gtk_enum_t); - pl_sg = s7_make_circular_signature(sc, 1, 2, s_string, s_gtk_enum_t); - pl_gs = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_string); + pl_gi = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_integer); + pl_igi = s7_make_circular_signature(sc, 2, 3, s_integer, s_gtk_enum_t, s_integer); pl_pu = s7_make_circular_signature(sc, 1, 2, s_pair, s_pair_false); pl_pur = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_real); pl_pub = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_boolean); @@ -48680,10 +48657,11 @@ static void define_functions(s7_scheme *sc) pl_si = s7_make_circular_signature(sc, 1, 2, s_string, s_integer); pl_is = s7_make_circular_signature(sc, 1, 2, s_integer, s_string); pl_isi = s7_make_circular_signature(sc, 2, 3, s_integer, s_string, s_integer); + pl_tts = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_string); + pl_tti = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_integer); pl_sig = s7_make_circular_signature(sc, 2, 3, s_string, s_integer, s_gtk_enum_t); pl_isgt = s7_make_circular_signature(sc, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any); pl_isigutttiiu = s7_make_circular_signature(sc, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false); - pl_g = s7_make_circular_signature(sc, 0, 1, s_gtk_enum_t); pl_buuusuug = s7_make_circular_signature(sc, 7, 8, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t); pl_bu = s7_make_circular_signature(sc, 1, 2, s_boolean, s_pair_false); pl_pb = s7_make_circular_signature(sc, 1, 2, s_pair, s_boolean); @@ -48707,7 +48685,17 @@ static void define_functions(s7_scheme *sc) pl_buusib = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_string, s_integer, s_boolean); pl_buuuub = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); pl_buurbr = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_real, s_boolean, s_real); - pl_i = s7_make_circular_signature(sc, 0, 1, s_integer); + pl_gu = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_pair_false); + pl_pg = s7_make_circular_signature(sc, 1, 2, s_pair, s_gtk_enum_t); + pl_gus = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_string); + pl_pgi = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_integer); + pl_pgu = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); + pl_gui = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); + pl_guut = s7_make_circular_signature(sc, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); + pl_pgbi = s7_make_circular_signature(sc, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); + pl_guuut = s7_make_circular_signature(sc, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); + pl_gurrsiu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); + pl_gussitu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); pl_su = s7_make_circular_signature(sc, 1, 2, s_string, s_pair_false); pl_ps = s7_make_circular_signature(sc, 1, 2, s_pair, s_string); pl_sui = s7_make_circular_signature(sc, 2, 3, s_string, s_pair_false, s_integer); @@ -48726,7 +48714,11 @@ static void define_functions(s7_scheme *sc) pl_psrrrb = s7_make_circular_signature(sc, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean); pl_psgbiiiit = s7_make_circular_signature(sc, 8, 9, s_pair, s_string, s_gtk_enum_t, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any); pl_psiiuusu = s7_make_circular_signature(sc, 7, 8, s_pair, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false); - pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t); + pl_i = s7_make_circular_signature(sc, 0, 1, s_integer); + pl_bsu = s7_make_circular_signature(sc, 2, 3, s_boolean, s_string, s_pair_false); + pl_bsigb = s7_make_circular_signature(sc, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); + pl_sg = s7_make_circular_signature(sc, 1, 2, s_string, s_gtk_enum_t); + pl_gs = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_string); pl_ti = s7_make_circular_signature(sc, 1, 2, s_any, s_integer); pl_it = s7_make_circular_signature(sc, 1, 2, s_integer, s_any); pl_tiu = s7_make_circular_signature(sc, 2, 3, s_any, s_integer, s_pair_false); @@ -48734,11 +48726,9 @@ static void define_functions(s7_scheme *sc) pl_itiiub = s7_make_circular_signature(sc, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean); pl_itstttg = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t); pl_itgiiut = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any); - pl_bsu = s7_make_circular_signature(sc, 2, 3, s_boolean, s_string, s_pair_false); - pl_bsigb = s7_make_circular_signature(sc, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); - pl_p = s7_make_circular_signature(sc, 0, 1, s_pair); pl_ssi = s7_make_circular_signature(sc, 2, 3, s_string, s_string, s_integer); pl_ssig = s7_make_circular_signature(sc, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t); + pl_p = s7_make_circular_signature(sc, 0, 1, s_pair); pl_tusiuiui = s7_make_circular_signature(sc, 7, 8, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false, s_integer); pl_tuiiiiui = s7_make_circular_signature(sc, 7, 8, s_any, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_pair_false, s_integer); pl_tuuiiiirrrrg = s7_make_circular_signature(sc, 11, 12, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_gtk_enum_t); @@ -48801,11 +48791,21 @@ static void define_functions(s7_scheme *sc) pl_tuuubr = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_real); pl_tuuiuui = s7_make_circular_signature(sc, 6, 7, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false, s_pair_false, s_integer); pl_tubiiiu = s7_make_circular_signature(sc, 6, 7, s_any, s_pair_false, s_boolean, s_integer, s_integer, s_integer, s_pair_false); + pl_g = s7_make_circular_signature(sc, 0, 1, s_gtk_enum_t); pl_s = s7_make_circular_signature(sc, 0, 1, s_string); pl_bt = s7_make_circular_signature(sc, 1, 2, s_boolean, s_any); pl_tb = s7_make_circular_signature(sc, 1, 2, s_any, s_boolean); pl_bti = s7_make_circular_signature(sc, 2, 3, s_boolean, s_any, s_integer); pl_btiib = s7_make_circular_signature(sc, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean); + pl_du = s7_make_circular_signature(sc, 1, 2, s_float, s_pair_false); + pl_pr = s7_make_circular_signature(sc, 1, 2, s_pair, s_real); + pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t); + pl_dui = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_integer); + pl_dus = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_string); + pl_dusi = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_integer); + pl_dusr = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_real); + pl_iit = s7_make_circular_signature(sc, 2, 3, s_integer, s_integer, s_any); + pl_iiit = s7_make_circular_signature(sc, 3, 4, s_integer, s_integer, s_integer, s_any); pl_ts = s7_make_circular_signature(sc, 1, 2, s_any, s_string); pl_tsi = s7_make_circular_signature(sc, 2, 3, s_any, s_string, s_integer); pl_tsig = s7_make_circular_signature(sc, 3, 4, s_any, s_string, s_integer, s_gtk_enum_t); @@ -48814,18 +48814,18 @@ static void define_functions(s7_scheme *sc) pl_tsiiuui = s7_make_circular_signature(sc, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer); pl_bpt = s7_make_signature(sc, 2, s_pair_false, s_any); #if GTK_CHECK_VERSION(3, 0, 0) - pl_pgr = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_real); - pl_gug = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t); pl_puuig = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); pl_puiiui = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer); pl_buigu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false); + pl_pgr = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_real); + pl_gug = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t); pl_tuuugi = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); pl_tuuuub = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); #endif #if GTK_CHECK_VERSION(3, 4, 0) - pl_prrru = s7_make_circular_signature(sc, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false); pl_suiig = s7_make_circular_signature(sc, 4, 5, s_string, s_pair_false, s_integer, s_integer, s_gtk_enum_t); + pl_prrru = s7_make_circular_signature(sc, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false); pl_tsu = s7_make_circular_signature(sc, 2, 3, s_any, s_string, s_pair_false); #endif @@ -48859,7 +48859,6 @@ static void define_functions(s7_scheme *sc) #endif #if GTK_CHECK_VERSION(3, 99, 0) - pl_guugbuut = s7_make_circular_signature(sc, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); pl_iuugs = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_pair_false, s_gtk_enum_t, s_string); pl_piigui = s7_make_circular_signature(sc, 5, 6, s_pair, s_integer, s_integer, s_gtk_enum_t, s_pair_false, s_integer); pl_puuugi = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); @@ -48869,6 +48868,7 @@ static void define_functions(s7_scheme *sc) pl_busi = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_string, s_integer); pl_buib = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_integer, s_boolean); pl_bugu = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_gtk_enum_t, s_pair_false); + pl_guugbuut = s7_make_circular_signature(sc, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); pl_pst = s7_make_circular_signature(sc, 2, 3, s_pair, s_string, s_any); pl_tist = s7_make_circular_signature(sc, 3, 4, s_any, s_integer, s_string, s_any); pl_turs = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_real, s_string); @@ -56095,7 +56095,7 @@ void libgtk_s7_init(s7_scheme *sc) define_functions(sc); s7_define_function(sc, "g_signal_connect", lg_g_signal_connect, 3, 1, 0, H_g_signal_connect); s7_set_shadow_rootlet(sc, old_shadow); - s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "30-Jun-18")); + s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "27-Jul-18")); } /* gcc -c libgtk_s7.c -o libgtk_s7.o -I. -fPIC `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl */ /* gcc libgtk_s7.o -shared -o libgtk_s7.so */ @@ -117,7 +117,7 @@ lambda lambda* lcm let->list length let let* let-ref let? letrec letrec* list list->string list->vector list-ref list-tail list? log logand logbit? logior lognot logxor macro? magnitude make-byte-vector make-float-vector make-int-vector make-hash-table make-hook make-iterator make-list make-polar - make-rectangular make-shared-vector make-string make-vector map max member memq memv min modulo morally-equal? + make-rectangular subvector make-string make-vector map max member memq memv min modulo morally-equal? nan? negative? not null? number->string number? numerator object->let object->string odd? openlet? or outlet output-port? owlet pair-line-number pair-filename pair? port-closed? port-filename port-line-number positive? documentation @@ -127,7 +127,8 @@ sequence? sin sinh square sqrt stacktrace string string->list string->number string->symbol string->keyword string-append string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase string-length string-position string-ref string-upcase string<=? string<? string=? string>=? string>? string? - sublet substring symbol symbol->dynamic-value symbol->keyword symbol->string symbol->value symbol? syntax? + sublet substring subvector? subvector-position subvector-vector + symbol symbol->dynamic-value symbol->keyword symbol->string symbol->value symbol? syntax? tan tanh tree-leaves tree-memq tree-set-memq tree-count tree-cyclic? truncate type-of unless unspecified? undefined? values vector vector-append vector->list vector-dimensions vector-length vector-ref vector? @@ -142,11 +143,11 @@ (for-each (lambda (op) (set! (ht op) #t)) - '(symbol? gensym? keyword? let? openlet? iterator? macro? c-pointer? c-object? constant? + '(symbol? gensym? keyword? let? openlet? iterator? macro? c-pointer? c-object? constant? subvector? input-port? output-port? eof-object? integer? number? real? complex? rational? random-state? char? string? list? pair? vector? float-vector? int-vector? byte-vector? hash-table? continuation? procedure? dilambda? boolean? float? proper-list? sequence? null? gensym - symbol->string string->symbol symbol symbol->value symbol->dynamic-value symbol-setter + symbol->string string->symbol symbol symbol->value symbol->dynamic-value string->keyword symbol->keyword keyword->symbol outlet rootlet curlet unlet sublet varlet cutlet inlet owlet coverlet openlet let-ref let-set! make-iterator iterate iterator-sequence iterator-at-end? provided? provide defined? c-pointer port-line-number port-filename @@ -173,7 +174,7 @@ cdadar cddaar cdaddr cddddr cddadr cdddar assoc member list list-ref list-set! list-tail make-list length copy fill! reverse reverse! sort! append assq assv memq memv vector-append list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimensions - make-vector make-shared-vector vector float-vector make-float-vector float-vector-set! + make-vector subvector vector float-vector make-float-vector float-vector-set! float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector byte-vector make-byte-vector hash-table hash-table* make-hash-table hash-table-ref hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation @@ -183,7 +184,8 @@ exit dilambda make-hook hook-functions stacktrace tree-leaves tree-memq object->let getenv directory? file-exists? type-of immutable! immutable? byte-vector-set! syntax? list-values apply-values unquote set-current-output-port unspecified? undefined? byte-vector-ref - set-current-input-port set-current-error-port directory->list system tree-count tree-set-memq tree-cyclic?)) + set-current-input-port set-current-error-port directory->list system subvector-position subvector-offset + tree-count tree-set-memq tree-cyclic?)) ht)) (makers (let ((h (make-hash-table))) @@ -193,7 +195,7 @@ '(gensym sublet inlet make-iterator let->list random-state random-state->list number->string object->let make-string string string-copy copy list->string string->list string-append substring object->string format cons list make-list reverse append vector-append list->vector vector->list make-vector - make-shared-vector vector make-float-vector float-vector make-int-vector int-vector byte-vector + subvector vector make-float-vector float-vector make-int-vector int-vector byte-vector hash-table hash-table* make-hash-table make-hook list-values append gentemp)) ; gentemp for other schemes h)) @@ -234,7 +236,7 @@ '(symbol? integer? rational? real? number? complex? float? keyword? gensym? byte-vector? string? list? sequence? char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? null? pair? proper-list? output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer? - unspecified? immutable? constant? syntax? undefined? tree-cyclic? iterator-at-end? openlet?)) + unspecified? immutable? constant? syntax? undefined? tree-cyclic? iterator-at-end? openlet? subvector?)) h)) (booleans (let ((h (make-hash-table))) @@ -246,7 +248,7 @@ output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer? unspecified? exact? inexact? defined? provided? even? odd? char-whitespace? char-numeric? char-alphabetic? negative? positive? zero? syntax? undefined? tree-cyclic? not openlet? ; immutable? constant? - infinite? nan? char-upper-case? char-lower-case? directory? file-exists? iterator-at-end?)) + infinite? nan? char-upper-case? char-lower-case? directory? file-exists? iterator-at-end? subvector?)) h)) (notables (let ((h (make-hash-table))) @@ -681,7 +683,7 @@ (let ((+documentation+ "(copy-tree lst) returns a full copy of lst")) (lambda (lis) (if (pair? lis) - (copy lis :readable) + (copy lis) ;:readable) lis)))) (define (proper-tree? tree) @@ -969,7 +971,7 @@ (if fd (and (symbol? (var-ftype fd)) (var-signature fd)) - (signature fnc))))) + (signature (symbol->value fnc)))))) (define (arg-arity fnc env) (and (symbol? fnc) @@ -2113,7 +2115,7 @@ (and (not (null? f)) (side-effect-with-vars? f env vars))) (cdr form)) - (let ((sig (signature (car form)))) ; sig has func arg and it is not known safe + (let ((sig (signature (symbol->value (car form))))) ; sig has func arg and it is not known safe (and (pair? sig) (memq 'procedure? (cdr sig)) (call-with-exit @@ -2175,7 +2177,7 @@ vars)) (initialize-bad-var-names *report-bad-variable-names*) - (set! (symbol-setter '*report-bad-variable-names*) ; update these local variables if the global variable changes + (set! (setter '*report-bad-variable-names*) ; update these local variables if the global variable changes (lambda (sym val) (when (just-symbols? val) (initialize-bad-var-names val)) @@ -2406,7 +2408,7 @@ (and (proper-list? form) ;(not (infinite? (length form))) but when would a dotted list work? (catch #t (lambda () - (eval (copy form :readable))) + (eval (copy form))); :readable))) (lambda args :checked-eval-error)))) @@ -6207,7 +6209,7 @@ (if (just-code-constants? (cdr form)) (catch #t (lambda () - (let ((val (eval (copy form :readable)))) + (let ((val (eval (copy form)))); :readable)))) (lint-format "perhaps ~A" caller (lists->string form val)))) ; (eq? #(0) #(0)) -> #f (lambda args #t)))) @@ -9344,13 +9346,13 @@ (pair? (cddr arg1)))) (len>1? (cadr arg1)) (memq (caadr arg1) '(string->list vector->list))) - (let ((string-case (eq? (caadr arg1) 'string->list)) ; (cdr (vector->list v)) -> (make-shared-vector v (- (length v) 1) 1) + (let ((string-case (eq? (caadr arg1) 'string->list)) ; (cdr (vector->list v)) -> (subvector v (- (length v) 1) 1) (len-diff (case (car arg1) ((list-tail) (caddr arg1)) (else => cdr-count)))) (lint-format "~A accepts ~A arguments, so perhaps ~A" caller head (if string-case 'string 'vector) (lists->string arg1 (if string-case (list 'substring (cadadr arg1) len-diff) - `(make-shared-vector ,(cadadr arg1) (- (length ,(cadadr arg1)) ,len-diff) ,len-diff))))))) + `(subvector ,(cadadr arg1) (- (length ,(cadadr arg1)) ,len-diff) ,len-diff))))))) (when (and (eq? head 'for-each) (len>1? (cadr form)) ; (for-each (lambda (x) (+ (abs x) 1)) lst) (eq? (caadr form) 'lambda) @@ -10000,6 +10002,7 @@ (current-environment . curlet) (make-procedure-with-setter . dilambda) (procedure-with-setter? . dilambda?) + (symbol-setter . setter) (make-keyword . string->keyword) (make-random-state . random-state)))) @@ -14759,12 +14762,12 @@ ((let-ref) 'let-set!)) (append (cdadr form) (cddr form)))))) - ((and (eq? target 'symbol-setter) + ((and (eq? target 'setter) (len>1? setval) (eq? (car setval) 'lambda) (list? (cadr setval)) (not (= (length (cadr setval)) 2))) - (lint-format "symbol-setter function should take 2 arguments: ~A" caller (truncated-list->string form))) + (lint-format "setter function should take 2 arguments: ~A" caller (truncated-list->string form))) ((or (string? target) (vector? target)) @@ -21470,7 +21473,7 @@ ;; -------- walk head=symbol -------- (denote walk-symbol - (letrec ((unsafe-makers '(sublet inlet copy cons list append make-shared-vector vector hash-table hash-table* + (letrec ((unsafe-makers '(sublet inlet copy cons list append subvector vector hash-table hash-table* make-hash-table make-hook list-values append gentemp or and not)) (equal-ignoring-constants? diff --git a/mockery.scm b/mockery.scm index b92f066..2461ca0 100644 --- a/mockery.scm +++ b/mockery.scm @@ -84,10 +84,10 @@ (map values (obj 'value)) (error 'wrong-type-arg "vector->list ~S ~S" obj args))) - 'make-shared-vector (lambda* (obj dim (off 0)) + 'subvector (lambda* (obj dim (off 0)) (if (mock-vector? obj) - (#_make-shared-vector (obj 'value) dim off) - (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dim off))) + (#_subvector (obj 'value) dim off) + (error 'wrong-type-arg "subvector ~S ~S ~S" obj dim off))) 'vector-fill! (lambda (obj . args) (if (mock-vector? obj) @@ -667,11 +667,11 @@ (#_vector-set! vec (ind 'value) val) (error 'wrong-type-arg "vector-set! ~S ~S ~S" vec ind val))) - 'make-shared-vector (lambda (obj dims offset) + 'subvector (lambda (obj dims offset) (if (and (vector? obj) (pair? dims)) - (#_make-shared-vector obj dims (offset 'value)) - (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dims offset))) + (#_subvector obj dims (offset 'value)) + (error 'wrong-type-arg "subvector ~S ~S ~S" obj dims offset))) 'read-string (lambda* (k (port (current-input-port))) (#_read-string (k 'value) port)) @@ -900,10 +900,10 @@ (apply #_copy (obj 'value) args) (error 'wrong-type-arg "copy ~S ~S" obj args))) - 'make-shared-vector (lambda (obj dims . args) + 'subvector (lambda (obj dims . args) (if (mock-pair? dims) - (apply #_make-shared-vector obj (dims 'value) args) - (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dims args))) + (apply #_subvector obj (dims 'value) args) + (error 'wrong-type-arg "subvector ~S ~S ~S" obj dims args))) 'make-vector (lambda (dims . args) (if (mock-pair? dims) (apply #_make-vector (dims 'value) args) @@ -987,7 +987,7 @@ 'symbol->string (lambda (obj) (#_symbol->string (obj 'value))) 'symbol->value (lambda (obj . args) (apply #_symbol->value (obj 'value) args)) 'symbol->dynamic-value (lambda (obj) (#_symbol->dynamic-value (obj 'value))) - 'symbol-setter (lambda (obj . args) (apply #_symbol-setter (obj 'value) args)) + 'setter (lambda (obj . args) (apply #_setter (obj 'value) args)) 'provided? (lambda (obj) (#_provided? (obj 'value))) 'provide (lambda (obj) (#_provide (obj 'value))) 'defined? (lambda (obj) (#_defined? (obj 'value))) diff --git a/peak-phases.scm b/peak-phases.scm index 3a7e324..b153132 100644 --- a/peak-phases.scm +++ b/peak-phases.scm @@ -2871,7 +2871,7 @@ ;; 59+1 9.567932 #r(0.000000 0.987181 1.155730 0.332214 0.959672 0.422609 0.139164 1.858170 1.971933 -0.085625 1.367690 0.092445 1.162248 1.070252 0.880093 0.923540 1.286688 -0.075166 1.802993 1.583654 -0.058064 1.544851 0.459865 -0.017801 0.622918 1.081434 0.420245 1.717169 1.954432 0.771937 1.209324 0.923890 0.475411 1.176878 1.472899 -0.165713 0.114758 1.012016 1.333064 1.459949 0.672973 0.014198 1.279333 1.152000 0.797283 1.103957 1.630723 0.491103 0.146670 1.964833 1.081703 0.052456 0.483259 1.761154 0.245675 0.138222 0.019396 0.460673 0.907223 -0.053470) - 9.553826 #r(0.000000 0.977768 1.156404 0.333539 0.973022 0.434117 0.118856 1.864748 1.968753 -0.116380 1.349604 0.104711 1.138993 1.072576 0.846646 0.953530 1.273318 -0.071026 1.823388 1.615064 -0.055451 1.534985 0.441123 -0.034574 0.610913 1.069693 0.423236 1.715331 1.976408 0.751266 1.245024 0.919253 0.467036 1.191689 1.510752 -0.182603 0.117730 1.006304 1.322474 1.446650 0.686694 0.030536 1.290197 1.158679 0.754397 1.103178 1.614495 0.493071 0.146441 1.946628 1.083890 0.057744 0.432549 1.787582 0.240284 0.130401 -0.011836 0.445800 0.919763 -0.096490) + 9.529131 #r(0.000000 0.993590 1.164157 0.290844 1.042801 0.369324 0.080143 1.893493 1.949205 -0.095560 1.325881 0.157042 1.109339 1.086368 0.905155 0.977024 1.260686 -0.016062 1.828182 1.614075 -0.014518 1.545044 0.439925 -0.081486 0.578895 1.179965 0.427010 1.706349 0.024219 0.749847 1.267270 0.839364 0.455231 1.246595 1.494210 -0.158936 0.112811 1.066790 1.292394 1.447816 0.800830 0.073649 1.261763 1.207061 0.771891 1.108173 1.623292 0.487925 0.232144 1.880207 1.080714 0.089063 0.391169 1.784626 0.272458 0.159146 -0.056599 0.452568 0.943658 -0.111770) ) ;;; 61 prime -------------------------------------------------------------------------------- @@ -2879,7 +2879,7 @@ ;; 60+1 9.674304 #r(0.000000 0.942988 1.185184 0.401228 0.922656 0.384439 0.124613 1.797598 1.871679 -0.085568 1.287716 0.127521 1.211990 1.110404 1.018269 0.906936 1.241998 -0.006224 1.802916 1.625042 -0.136580 1.655334 0.507522 0.019978 0.578715 1.045428 0.440588 1.674467 1.983824 0.788229 1.261730 0.967897 0.387538 1.232060 1.526658 -0.187478 0.170755 1.104323 1.383734 1.532583 0.668063 0.082609 1.255511 1.174792 0.795177 1.135630 1.640793 0.324749 0.311806 1.930005 1.005470 -0.027359 0.440238 1.824355 0.182093 -0.005304 0.026835 0.470199 0.945827 0.102044 -0.110982) - 9.666853 #r(0.000000 0.938161 1.192849 0.393059 0.927091 0.388614 0.119083 1.783182 1.874912 -0.090927 1.285936 0.122019 1.224766 1.106323 1.014667 0.894985 1.223842 -0.007747 1.809023 1.632254 -0.140269 1.662792 0.513134 -0.001472 0.576729 1.049463 0.460689 1.655284 1.971506 0.786447 1.288282 0.950772 0.380963 1.229888 1.537771 -0.188732 0.176420 1.123833 1.397493 1.540782 0.665265 0.083000 1.258028 1.171130 0.791319 1.134867 1.634192 0.310303 0.338602 1.920386 1.011549 -0.022337 0.411580 1.842905 0.190091 0.005394 0.025438 0.476057 0.942422 0.103141 -0.106382) + 9.597113 #r(0.000000 0.971231 1.304763 0.348110 1.067056 0.387911 0.081123 1.853366 1.983392 -0.039753 1.223396 0.179283 1.164777 1.154984 0.937227 0.823520 1.227844 0.034480 1.818337 1.655061 -0.098774 1.660591 0.459686 -0.048010 0.694006 1.048441 0.467529 1.454975 0.016059 0.770137 1.418302 0.858801 0.431966 1.226715 1.621523 -0.240963 0.187668 1.281591 1.385352 1.562607 0.731351 0.081273 1.114425 1.175335 0.798504 1.208038 1.525646 0.402825 0.416766 1.868720 1.058943 -0.114172 0.285787 1.878637 0.307505 0.055166 0.065670 0.529996 1.046895 0.078416 0.000029) ) ;;; 62 prime -------------------------------------------------------------------------------- @@ -2894,14 +2894,14 @@ (vector 63 11.975765228271 #r(0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0) 9.712956 #r(0.000000 -0.211512 0.128156 0.205336 1.631792 0.223993 1.120077 0.677974 1.189520 0.635587 0.786994 -0.140042 0.270508 0.031528 -0.026718 1.271754 0.161836 1.519308 0.919403 0.725190 1.656604 1.430895 1.216006 1.507263 1.740613 0.380045 0.740422 0.860394 0.644699 1.785241 -0.063336 1.757196 0.670969 0.631113 1.432730 0.929994 0.449373 1.355893 1.665671 0.697673 0.900343 0.706516 0.261640 0.022846 0.779166 0.410962 1.451999 0.372853 -0.213671 0.428231 0.418722 1.770544 0.502738 1.423557 0.029160 1.322724 0.247556 0.608992 0.392989 0.101597 0.240746 1.015503 0.321046) - 9.693747 #r(0.000000 -0.214267 0.131312 0.202542 1.639066 0.220880 1.110299 0.697386 1.207343 0.664514 0.745628 -0.123967 0.272546 -0.017989 -0.047982 1.269964 0.138908 1.510349 0.884748 0.721780 1.649665 1.431789 1.208219 1.495746 1.757542 0.408332 0.750115 0.894096 0.645022 1.806348 -0.086356 1.773856 0.680221 0.602168 1.428381 0.942742 0.440895 1.332017 1.671171 0.695507 0.866270 0.710111 0.279049 0.033619 0.787797 0.389274 1.451950 0.351821 -0.216039 0.435557 0.412446 1.778026 0.495467 1.413748 0.047934 1.325498 0.238792 0.626514 0.380150 0.090375 0.244259 1.009096 0.325894) + 9.693247 #r(0.000000 -0.214108 0.131421 0.202301 1.638942 0.220854 1.110715 0.697059 1.206875 0.663993 0.745920 -0.122836 0.272685 -0.017037 -0.046871 1.270138 0.138706 1.510472 0.884803 0.722898 1.649368 1.432030 1.208395 1.495491 1.756739 0.407459 0.750264 0.893441 0.644649 1.806450 -0.086753 1.774024 0.679919 0.602645 1.428125 0.942638 0.441081 1.332580 1.671327 0.694821 0.867415 0.710167 0.279926 0.033959 0.788479 0.389797 1.452066 0.352545 -0.215836 0.435427 0.411560 1.777773 0.495583 1.413317 0.048036 1.325135 0.239570 0.625882 0.381467 0.091137 0.245018 1.010220 0.326741) ) ;;; 64 prime -------------------------------------------------------------------------------- (vector 64 11.932915769505 #r(0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1) 9.911897 #r(0.000000 -0.176519 0.277243 1.457679 0.409823 0.492128 1.258703 0.953828 0.451970 -0.035755 1.413815 0.576790 1.007663 1.557197 0.406393 0.901721 0.935399 0.344434 0.058666 -0.004874 0.033568 0.266354 0.964058 1.260921 0.110946 0.586184 1.551133 0.560107 1.655832 1.431146 0.094791 0.726936 0.404173 1.258539 0.363860 0.287498 0.704556 1.358694 0.848351 1.352219 1.358382 1.634548 0.646434 0.536511 1.151363 1.507902 0.370229 -0.111562 0.018845 1.351430 0.613337 0.524145 0.030867 1.602701 0.958191 0.774983 0.900142 1.319974 1.665985 0.954409 0.571244 0.683517 0.257283 0.560359) - 9.907362 #r(0.000000 -0.169782 0.281883 1.451965 0.419107 0.492842 1.254699 0.976545 0.462824 -0.052637 1.417424 0.589923 0.973364 1.567887 0.399358 0.884342 0.924580 0.329693 0.067938 -0.007528 0.035073 0.282359 0.958955 1.240186 0.128754 0.603640 1.556908 0.553925 1.653011 1.418723 0.108496 0.707456 0.383888 1.286717 0.361930 0.314304 0.704121 1.356644 0.837188 1.350675 1.362252 1.661176 0.650180 0.540641 1.161939 1.511583 0.353586 -0.129192 0.020028 1.371538 0.632804 0.534720 0.056612 1.624133 0.955126 0.801421 0.910107 1.330996 1.669437 0.949651 0.568288 0.685754 0.244542 0.535038) + 9.904870 #r(0.000000 -0.164225 0.273975 1.461444 0.422513 0.492395 1.248622 0.971394 0.458132 -0.046445 1.414427 0.584229 0.967141 1.558509 0.394722 0.903497 0.940076 0.324113 0.053268 -0.024522 0.041062 0.281887 0.962890 1.227975 0.135414 0.598845 1.556506 0.526124 1.661213 1.420935 0.090290 0.679152 0.391769 1.289421 0.343796 0.304279 0.680212 1.322656 0.808370 1.338618 1.350277 1.651671 0.649112 0.545474 1.151919 1.505597 0.322896 -0.128068 -0.000209 1.363363 0.627954 0.514237 0.047970 1.605733 0.945254 0.790625 0.898519 1.323254 1.650334 0.927509 0.574149 0.657507 0.234406 0.524987) ) ;;; 65 prime -------------------------------------------------------------------------------- @@ -2909,14 +2909,14 @@ ;; 64+1 10.041913 #r(0.000000 -0.231597 0.347996 1.329229 0.210946 0.358775 1.318136 0.940959 0.423445 -0.059602 1.487652 0.528102 0.959962 1.627507 0.242008 0.890416 1.013953 0.381481 0.048421 0.000955 0.073351 0.222260 0.956448 1.250606 0.032874 0.581396 1.552144 0.533024 1.803356 1.588620 0.155988 0.709145 0.416103 1.098822 0.371144 0.488313 0.641224 1.409761 0.769076 1.378012 1.338517 1.672969 0.693576 0.622573 1.111879 1.498797 0.384021 -0.285902 0.098531 1.294593 0.540682 0.514444 0.031708 1.544980 0.882941 0.833995 0.886145 1.471130 1.590019 0.959450 0.407950 0.787696 0.104075 0.545846 0.096608) - 10.038128 #r(0.000000 -0.239678 0.344800 1.313567 0.209906 0.356986 1.326563 0.960102 0.417161 -0.053759 1.509230 0.517156 0.965155 1.621807 0.231473 0.887879 1.020528 0.387996 0.052036 0.004735 0.095782 0.216042 0.972464 1.259099 0.034417 0.588863 1.549170 0.532963 1.791831 1.588427 0.154406 0.719833 0.418166 1.097183 0.363922 0.487983 0.627993 1.410288 0.771296 1.398338 1.336236 1.679922 0.699378 0.632542 1.096617 1.488246 0.401414 -0.285060 0.116988 1.291043 0.532564 0.534024 0.031167 1.552510 0.884288 0.827867 0.898339 1.469470 1.596605 0.946533 0.402851 0.794397 0.110647 0.538096 0.094462) + 10.031321 #r(0.000000 -0.272551 0.376749 1.333244 0.218725 0.345977 1.314485 0.982213 0.427625 -0.065599 1.515427 0.508158 0.913799 1.657763 0.172645 0.893548 1.045679 0.355730 0.027581 0.041761 0.082561 0.209873 0.920555 1.285192 0.041833 0.572322 1.559879 0.525050 1.767677 1.615275 0.160499 0.644324 0.441443 1.110153 0.327368 0.527348 0.566684 1.364227 0.733403 1.384463 1.363114 1.623118 0.669559 0.652798 1.037660 1.423834 0.345719 -0.269580 0.049255 1.244435 0.520436 0.525551 0.012583 1.505200 0.886496 0.816798 0.876113 1.467201 1.600992 0.961581 0.410364 0.759664 0.138406 0.484445 0.049688) ) ;;; 66 prime -------------------------------------------------------------------------------- (vector 66 12.090668678284 #r(0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0) 10.065843 #r(0.000000 -0.332278 0.420111 1.296912 0.003400 0.570050 1.383101 1.228319 0.329402 0.002928 0.332461 0.786693 1.331535 0.237292 1.020996 0.126259 1.613105 1.241426 -0.367526 0.057745 0.063068 1.144890 0.058649 0.546763 0.792290 0.527577 1.597907 0.336733 0.558202 0.349266 0.412838 -0.066236 0.132007 1.032081 0.645360 0.084627 0.218015 0.961024 1.464682 1.216442 1.186753 0.039444 1.139907 1.145545 1.026317 1.617341 0.492061 1.804706 -0.218027 0.872723 0.567401 1.745335 1.259266 0.682677 1.100993 1.200392 1.089304 0.237539 0.552581 0.047166 0.743492 0.228597 1.363708 0.915715 -0.032741 0.312099) - 10.058501 #r(0.000000 -0.335855 0.429621 1.291057 0.003881 0.564713 1.383019 1.220661 0.335512 0.002311 0.329698 0.785419 1.326198 0.243897 1.027050 0.132000 1.603360 1.238987 -0.365598 0.049570 0.073148 1.141269 0.065589 0.533605 0.802142 0.519660 1.597722 0.325429 0.553723 0.356848 0.403336 -0.070766 0.135136 1.033446 0.654576 0.086303 0.193695 0.959131 1.449607 1.214258 1.181376 0.022258 1.141314 1.131750 1.019134 1.611315 0.480932 1.797306 -0.229968 0.860729 0.550313 1.740259 1.247286 0.675268 1.087746 1.205627 1.082817 0.235688 0.546891 0.050543 0.741962 0.222719 1.350475 0.924174 -0.047677 0.309695) + 10.040611 #r(0.000000 -0.405880 0.403815 1.296291 -0.023571 0.665033 1.385081 1.219553 0.309245 0.020606 0.300153 0.822670 1.338967 0.273696 1.044177 0.099862 1.487075 1.221027 -0.344403 -0.045799 0.094066 1.108269 0.044014 0.617491 0.852992 0.558738 1.622399 0.310181 0.588841 0.323443 0.414056 -0.129711 0.220239 1.055039 0.615124 0.167536 0.224686 1.003767 1.449721 1.185187 1.215242 0.034353 1.113707 1.123233 1.095536 1.625500 0.489513 1.839019 -0.309733 0.833070 0.569096 1.721184 1.298143 0.637885 1.087460 1.191842 1.159182 0.195251 0.633434 0.099181 0.758141 0.218475 1.417590 0.992859 -0.046035 0.285532) ) ;;; 67 prime -------------------------------------------------------------------------------- @@ -2924,7 +2924,7 @@ ;; 66+1 10.270103 #r(0.000000 -0.339086 0.529826 1.196633 0.017211 0.503338 1.254976 1.117868 0.397424 -0.207937 0.422035 0.795324 1.396533 0.167749 1.073809 0.015795 1.618310 1.175144 -0.342555 0.080333 0.003741 1.084430 -0.010093 0.560025 0.867130 0.369945 1.456200 0.444129 0.652644 0.167650 0.320656 -0.145242 0.307342 1.062944 0.883767 0.299612 0.277397 1.030332 1.417097 1.462867 1.323580 0.189769 1.089141 0.993348 0.915509 1.413244 0.654039 1.674522 -0.169566 0.974872 0.769627 1.866694 1.124536 0.783559 1.039716 1.307670 1.055658 0.169272 0.711344 0.060085 0.731555 0.347823 1.529167 0.605251 0.021941 0.493045 -0.306702) - 10.266566 #r(0.000000 -0.337863 0.529784 1.198085 0.014902 0.502669 1.267355 1.126060 0.406489 -0.210776 0.421575 0.778252 1.390642 0.160201 1.079680 0.016307 1.622244 1.172860 -0.348083 0.071880 0.004342 1.086353 0.003370 0.558546 0.862475 0.364984 1.459956 0.448039 0.649810 0.162370 0.321930 -0.149205 0.291193 1.063455 0.881136 0.304138 0.273301 1.023597 1.415336 1.463332 1.319323 0.172230 1.076472 0.982903 0.903571 1.408685 0.652304 1.677568 -0.164917 0.974976 0.775935 1.859611 1.115821 0.769121 1.033987 1.303635 1.055583 0.167249 0.689677 0.052984 0.718414 0.347341 1.531507 0.600503 0.031380 0.496365 -0.320349) + 10.265959 #r(0.000000 -0.317437 0.528596 1.208530 0.019668 0.509206 1.284064 1.148532 0.419242 -0.198735 0.425155 0.767445 1.408450 0.160053 1.092975 0.032386 1.619472 1.183809 -0.361482 0.071106 0.009871 1.093315 0.027109 0.560654 0.879407 0.374417 1.487442 0.453563 0.647125 0.176974 0.322367 -0.143328 0.282015 1.077805 0.896816 0.316444 0.296705 1.010969 1.434391 1.469703 1.337586 0.187007 1.082850 1.009796 0.918602 1.416386 0.666312 1.700486 -0.149081 0.977019 0.786356 1.876858 1.104648 0.776752 1.040755 1.317706 1.081692 0.200422 0.704910 0.071311 0.744990 0.367563 1.551133 0.626292 0.053508 0.492611 -0.327592) ) ;;; 68 prime -------------------------------------------------------------------------------- @@ -2932,140 +2932,139 @@ ;; 69-1: 10.294332 #r(0.000000 1.774482 1.200978 1.227268 1.382220 0.282793 1.553903 1.732456 0.753211 0.760153 1.851640 1.366776 1.204200 0.843725 0.253043 0.277483 0.103836 -0.065448 1.410455 0.651921 1.994318 0.062621 0.954681 0.275021 0.597686 1.119852 0.016268 -0.163905 1.984242 1.567894 0.922417 -0.007109 1.063508 1.828059 0.334844 1.052665 1.253633 1.262611 1.579598 0.998618 1.505098 1.876188 0.866523 -0.096826 0.810066 0.678537 0.661302 -0.487197 0.199269 0.661440 1.362169 1.024823 0.238200 0.872311 1.253153 1.455210 0.266625 1.222868 1.015892 1.101616 1.115849 0.596998 1.881890 -0.207678 1.082090 0.165311 1.300155 1.153433) - 10.268427 #r(0.000000 1.775850 1.185483 1.233623 1.368391 0.281075 1.525702 1.743790 0.737621 0.775297 1.841427 1.347971 1.221336 0.827971 0.259295 0.284172 0.109986 -0.058656 1.382615 0.648805 0.025737 0.063300 0.939033 0.260052 0.601151 1.118247 0.031672 -0.161498 1.978684 1.549336 0.899002 -0.006612 1.072429 1.860358 0.324268 1.053703 1.230883 1.270305 1.549131 0.980167 1.499018 1.871006 0.876813 -0.108980 0.828624 0.671024 0.643289 -0.500810 0.184741 0.662244 1.356401 1.015530 0.251520 0.880072 1.250755 1.448839 0.287057 1.205273 1.006866 1.106257 1.112865 0.579648 1.885406 -0.209408 1.090186 0.154476 1.282098 1.154863) + 10.261600 #r(0.000000 1.771081 1.184318 1.217409 1.329949 0.267230 1.509883 1.778448 0.681595 0.738174 1.861103 1.336495 1.215872 0.818117 0.255500 0.299960 0.113725 -0.077146 1.405250 0.666595 0.037892 0.067257 0.915472 0.235386 0.607945 1.117038 0.060775 -0.156333 1.956471 1.527902 0.871638 -0.006865 1.033595 1.874143 0.354606 1.054570 1.217089 1.263859 1.531522 0.948658 1.506335 1.858536 0.864867 -0.107940 0.824426 0.664413 0.614081 -0.522301 0.170031 0.618192 1.363753 1.018532 0.255610 0.918599 1.224294 1.455436 0.286646 1.200372 1.019211 1.039060 1.103305 0.582967 1.867745 -0.265217 1.084430 0.130212 1.269409 1.132275) ) ;;; 69 prime -------------------------------------------------------------------------------- (vector 69 12.29846572876 #r(0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0) 10.373386 #r(0.000000 1.755739 1.344798 1.270777 1.245975 0.212147 1.637341 1.674637 0.780881 0.678256 0.020823 1.453992 1.251154 0.906274 0.263210 0.219658 0.201277 -0.006107 1.482279 0.690309 1.943780 0.107940 0.891912 0.210217 0.501788 1.062586 1.748465 -0.256216 1.793890 1.653062 0.760504 1.930618 1.125386 1.733012 0.392253 1.017032 1.329369 1.438951 1.614342 0.946373 1.511397 1.735151 0.924137 -0.243047 0.908372 0.619579 0.722525 -0.263766 0.070586 0.505534 1.390127 1.112173 0.360123 0.888486 1.115007 1.574719 0.192671 1.168644 1.072297 1.024494 1.027776 0.495929 1.728234 0.030466 1.010825 0.303774 1.356890 1.301979 0.677665) - 10.365976 #r(0.000000 1.757922 1.346977 1.278321 1.254882 0.206624 1.640429 1.670862 0.778866 0.672514 0.020541 1.460882 1.251776 0.898703 0.260564 0.210822 0.196695 -0.005784 1.477842 0.687813 1.950765 0.105419 0.888749 0.205481 0.510212 1.066362 1.751431 -0.257234 1.787183 1.661967 0.759990 1.933121 1.125577 1.729660 0.396426 1.015659 1.324600 1.446743 1.615191 0.939852 1.517456 1.727642 0.929260 -0.246256 0.915345 0.616382 0.718289 -0.258373 0.067249 0.499351 1.393047 1.118244 0.359134 0.888544 1.119747 1.570563 0.195311 1.171049 1.074079 1.027757 1.027731 0.493643 1.728381 0.032963 1.011920 0.307462 1.350074 1.305110 0.680341) + 10.358295 #r(0.000000 1.762304 1.329967 1.274727 1.243024 0.209299 1.634178 1.655523 0.780487 0.675373 0.009379 1.466876 1.260691 0.892375 0.253485 0.204944 0.184632 -0.020054 1.479361 0.680774 1.947746 0.085018 0.887454 0.202001 0.508666 1.061812 1.760817 -0.258898 1.789067 1.670818 0.746822 1.923843 1.147917 1.717791 0.387724 1.021038 1.318304 1.434180 1.603007 0.933831 1.516314 1.736887 0.932240 -0.250999 0.908525 0.598332 0.699524 -0.251071 0.060976 0.494007 1.385962 1.112068 0.358110 0.879637 1.108400 1.579544 0.192858 1.157165 1.062829 1.022502 1.013651 0.487217 1.715356 0.029780 1.002970 0.289498 1.337863 1.300987 0.690487) ) ;;; 70 prime -------------------------------------------------------------------------------- (vector 70 12.665026664734 #r(0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0) 10.403198 #r(0.000000 0.659269 0.149246 -0.229331 0.464031 1.037303 0.297808 1.605092 1.041553 1.638786 0.968456 1.081487 0.986031 0.766531 0.645236 0.176746 0.062926 0.650627 0.887571 0.432390 0.968052 1.660369 1.053082 0.034606 1.910731 1.746043 1.683430 0.821251 1.040772 1.932221 1.382437 0.501614 -0.111054 0.532350 0.190557 0.045053 1.319570 -0.066664 0.486188 1.777508 1.395223 0.491473 0.176001 0.623855 1.347864 1.207736 1.451417 1.558733 1.414717 1.920228 0.418857 1.530616 0.099510 0.214659 0.967449 -0.145006 1.519241 0.691963 1.366826 0.718889 0.337519 0.685633 1.635424 0.816319 0.060380 1.097292 0.149441 0.900329 0.876399 0.145344) + 10.362146 #r(0.000000 0.645075 0.144761 -0.255891 0.476895 1.023278 0.226232 1.569382 1.010047 1.598756 1.002276 1.069510 0.991228 0.875395 0.620600 0.146676 0.001456 0.640256 0.920988 0.405395 0.929569 1.637203 1.048641 -0.005834 1.951040 1.773501 1.763294 0.813650 1.073299 1.971995 1.378517 0.509283 -0.138231 0.486487 0.186594 0.024921 1.361733 -0.054931 0.452684 1.768706 1.403207 0.493486 0.160262 0.623486 1.333422 1.171179 1.417368 1.493662 1.431973 1.962729 0.473768 1.578443 0.146983 0.257457 0.922711 -0.127966 1.530877 0.689093 1.402346 0.698388 0.371420 0.673779 1.623279 0.869055 0.060960 1.114977 0.136968 0.887721 0.930015 0.191902) ) ;;; 71 prime -------------------------------------------------------------------------------- (vector 71 12.609085083008 #r(0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 0) 10.523064 #r(0.000000 0.688011 0.968837 0.940634 1.605222 0.888784 0.799658 0.986589 0.551066 0.615309 0.653186 0.893971 1.635005 0.515944 0.737309 0.499869 0.965484 1.166543 1.233403 1.277963 0.357632 0.184373 0.829321 0.533549 0.654127 1.345320 0.132782 0.366320 0.049851 1.315507 0.714178 1.332359 1.090257 0.069099 0.561445 1.760121 1.667327 0.986854 0.112329 0.614048 1.104774 0.212197 1.392955 0.553988 0.863015 1.668891 1.231650 0.232935 1.786061 0.865166 0.966113 0.257005 0.993747 -0.000704 1.235807 0.060112 1.258818 1.073792 0.276968 0.278092 1.838200 0.920318 1.799026 1.603861 0.357301 0.246709 0.264914 0.955910 0.731514 1.325161 1.347000) + 10.407485 #r(0.000000 0.658867 0.945182 1.008506 1.648242 0.849410 0.789076 0.860371 0.625610 0.678091 0.677156 0.952896 1.661882 0.468446 0.648245 0.553746 1.164588 1.217555 1.304818 1.253766 0.415819 0.177362 0.870813 0.537584 0.684099 1.231697 0.205944 0.313681 0.033795 1.304229 0.634137 1.288505 1.050312 0.068587 0.578801 1.748737 1.670966 0.963745 0.157496 0.747319 1.117879 0.224088 1.431805 0.565143 0.847971 1.619314 1.299282 0.286944 1.729721 0.792086 0.957060 0.103543 1.002065 0.024409 1.327043 0.059946 1.189105 1.073824 0.296154 0.377112 1.822909 0.902196 1.929038 1.562848 0.385236 0.148366 0.174788 0.969726 0.746509 1.400690 1.282292) ) ;;; 72 prime -------------------------------------------------------------------------------- (vector 72 12.708446502686 #r(0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1) 10.579571 #r(0.000000 1.526666 1.114036 -0.188699 1.569783 1.061483 1.461941 0.746029 1.509803 1.264040 0.039120 0.005480 1.670375 0.087176 1.602839 1.411297 1.630968 0.248800 0.070549 1.021733 -0.228089 1.869979 1.152734 0.098898 0.604652 0.265485 1.435929 0.170559 0.737250 0.104974 0.731428 1.774793 1.550528 -0.147974 1.870001 1.248377 1.256893 0.177185 1.205217 1.218210 1.654506 -0.048160 1.262662 0.659765 1.099483 0.193101 1.327235 0.693549 1.139270 0.170053 0.767850 1.284172 -0.044820 1.663616 1.015434 0.890883 1.694823 0.554893 0.622406 0.662793 0.328828 0.995738 1.236624 0.150517 1.587539 1.302619 0.103369 0.398303 0.131685 0.921928 1.168883 0.112924) + 10.496982 #r(0.000000 1.577140 1.146293 -0.139228 1.523478 1.074777 1.483287 0.662248 1.518460 1.358355 0.041669 -0.050825 1.633955 0.197302 1.628681 1.406765 1.599699 0.116714 0.102433 1.063359 -0.147037 1.816452 1.121083 0.122390 0.742457 0.181771 1.441622 0.172190 0.732537 0.047111 0.764854 1.749139 1.387157 -0.078027 1.839767 1.313819 1.301810 0.133381 1.152104 1.136084 1.760093 -0.040936 1.318430 0.739766 1.052638 0.175449 1.273552 0.687602 1.060057 0.117723 0.884432 1.344726 -0.002641 1.640974 1.031637 0.883501 1.787709 0.532454 0.578078 0.643118 0.404748 0.878255 1.298175 0.117038 1.624847 1.295336 0.039560 0.420808 -0.013827 0.878965 1.254788 0.161686) ) ;;; 73 prime -------------------------------------------------------------------------------- (vector 73 12.877750118249 #r(0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0) - 10.737656 #r(0.000000 0.602102 0.352641 0.632006 1.552371 0.296077 1.082110 0.013914 1.761810 0.456416 0.737747 0.295270 1.253093 0.753406 0.547256 0.051955 1.746228 0.377469 0.418110 0.901371 0.231886 1.499847 1.247926 1.681473 1.281726 0.414399 -0.025093 0.354821 1.545561 1.180195 1.073840 1.640054 1.311359 1.388818 1.571352 1.435069 -0.082478 0.162069 0.705649 -0.084633 0.587089 0.167800 -0.063043 0.159333 0.913473 1.004072 1.669680 0.741708 1.378872 1.360081 0.270841 1.349751 1.013148 0.450718 0.226120 0.098676 0.779207 1.870363 0.442457 1.048600 1.409639 0.334422 1.713108 0.607567 1.451973 0.551597 1.404406 0.821452 1.414792 0.265647 0.470100 0.101296 1.610504) - ;; 72+1 10.689130 #r(0.000000 1.525750 1.157802 -0.130495 1.566135 1.068083 1.436324 0.699061 1.496431 1.345845 -0.045471 -0.032146 1.656974 0.163846 1.519166 1.394757 1.503557 0.183007 0.248242 1.068642 -0.134987 1.855031 1.116717 -0.022218 0.511499 0.347386 1.347662 0.149072 0.778251 0.082394 0.706357 1.835299 1.598933 -0.137332 1.800937 1.334976 1.258225 0.107942 1.165982 1.097698 1.720927 -0.060245 1.266550 0.522159 1.151393 0.179388 1.306382 0.759803 1.190783 0.160999 0.709993 1.280967 -0.169862 1.562918 1.019413 0.839429 1.731380 0.566096 0.647229 0.704371 0.329975 1.072857 1.320759 0.275029 1.479112 1.297543 0.103782 0.366305 0.194503 1.011614 1.086013 0.243622 -0.036669) + 10.424692 #r(0.000000 1.554014 1.052186 -0.086200 1.476351 1.224926 1.580661 0.637756 1.422927 1.516582 -0.013111 -0.069153 1.566827 0.301765 1.594981 1.454270 1.439078 0.053331 0.299149 1.030104 -0.048066 1.777424 0.985794 0.000633 0.702766 0.173634 1.368758 0.222346 0.786334 0.080834 0.716179 1.776274 1.616019 -0.113541 1.676208 1.494328 1.439541 0.055619 0.983919 1.123924 1.848565 -0.036510 1.436326 0.574953 1.019118 0.214244 1.115597 0.860645 1.198449 0.197190 0.778351 1.383645 -0.195100 1.543792 1.148480 0.893946 1.917170 0.612713 0.688674 0.645993 0.415091 1.119089 1.442261 0.184218 1.468700 1.212357 0.199763 0.454337 0.103961 1.020748 1.089579 0.296783 -0.106516) ) ;;; 74 prime -------------------------------------------------------------------------------- (vector 74 13.115156173706 #r(0 1 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1) 10.649887 #r(0.000000 0.311188 1.290942 0.614169 0.538966 0.384100 0.109850 0.021551 0.798332 1.375278 0.593955 1.270048 0.158912 1.156782 1.030374 0.821590 0.254106 0.736652 -0.160646 1.527962 0.008622 1.070061 1.131441 1.654723 1.927687 1.286729 -0.139272 1.540344 0.234722 1.262327 0.958913 0.415825 0.099669 0.142462 -0.047631 -0.219606 0.497897 0.164613 1.298918 -0.030959 0.077929 0.023069 -0.048674 1.490524 1.421741 1.027040 1.916604 1.756080 0.253777 0.507377 0.665062 0.691819 1.450238 1.738862 1.010067 1.810972 1.515691 0.044783 0.082536 1.267984 0.419709 0.481882 1.832483 1.839130 0.674123 0.733681 1.236692 0.099256 1.206529 1.152388 -0.150515 0.755739 -0.177039 0.279539) + 10.645980 #r(0.000000 0.311650 1.280848 0.611958 0.562391 0.394077 0.103205 0.008568 0.817187 1.367252 0.596140 1.287960 0.175350 1.148539 1.041198 0.821079 0.245783 0.725100 -0.171308 1.536345 0.020047 1.082763 1.136937 1.647863 1.919963 1.278757 -0.129192 1.538754 0.220953 1.263827 0.945051 0.419785 0.111579 0.140279 -0.056385 -0.214011 0.504195 0.169718 1.297017 -0.039788 0.085951 0.026379 -0.042190 1.504313 1.415242 1.036770 1.935911 1.763171 0.268139 0.498510 0.658810 0.698991 1.452795 1.747788 0.995160 1.796367 1.535056 0.043981 0.090892 1.265806 0.402298 0.496068 1.847177 1.828232 0.685895 0.730616 1.243411 0.093164 1.207951 1.153047 -0.163119 0.756812 -0.182692 0.296379) ) ;;; 75 prime -------------------------------------------------------------------------------- (vector 75 13.254356384277 #r(0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1) - 11.022299 #r(0.000000 0.351470 1.008124 1.291533 1.352523 1.219130 1.555492 -0.093523 0.793123 1.710126 0.845582 1.377487 0.007190 1.144398 0.030789 1.388046 0.801302 1.006307 1.228947 1.174967 0.712656 1.235684 0.437185 1.685920 1.628311 0.432535 1.406407 0.211487 1.631733 1.309990 0.088839 1.823347 0.645147 0.984102 0.938592 0.791055 1.200055 1.653923 1.369127 1.660169 1.684809 1.277014 1.423374 1.618705 1.761213 0.185242 0.737016 0.819843 1.700256 1.790111 1.582839 0.397943 0.430644 0.413691 1.861593 0.597392 0.781277 0.169222 1.035252 0.907321 0.225899 -0.109171 1.673244 0.994007 0.840763 0.321135 1.684359 1.522767 0.808080 0.918598 -0.016940 0.115899 0.890010 0.043957 1.335248) - ;; 74+1 10.845278 #r(0.000000 0.303549 1.218741 0.552551 0.569127 0.472240 0.245073 0.036162 0.777257 1.317108 0.637687 1.223165 0.113140 1.175025 0.935816 0.812633 0.204261 0.775370 -0.063348 1.606612 -0.062866 1.039670 1.212702 1.714844 1.899468 1.335566 -0.020119 1.590425 0.290190 1.193213 1.001576 0.516379 0.026311 0.170930 -0.096650 -0.315084 0.554428 0.144183 1.271300 0.005031 0.147859 0.041442 -0.048782 1.533805 1.480719 1.134329 1.851707 1.704199 0.286268 0.581546 0.690124 0.731502 1.497188 1.734408 1.013517 -0.010349 1.506433 0.024492 0.040181 1.200857 0.486442 0.422051 1.858040 1.837071 0.586958 0.629092 1.226159 0.139529 1.240473 1.272372 -0.245955 0.719958 -0.223615 0.281302 0.252047) + 10.728934 #r(0.000000 0.319906 1.183822 0.470461 0.553071 0.558322 0.240393 0.036866 0.834403 1.306075 0.639501 1.156931 0.131640 1.232771 0.859368 0.705663 0.237380 0.745032 -0.025724 1.667265 -0.112461 1.089983 1.220375 1.725435 1.917328 1.264565 0.041607 1.662792 0.234857 1.186979 1.051440 0.530773 -0.049988 0.142301 -0.159714 -0.311512 0.553213 0.109766 1.263045 0.012668 0.132405 0.025382 -0.046342 1.549557 1.414619 1.136704 1.834421 1.703381 0.363733 0.499672 0.660724 0.818632 1.487689 1.724136 0.974920 0.033975 1.567287 0.122631 0.037040 1.212978 0.445691 0.550630 1.935380 1.805163 0.633422 0.566599 1.268418 0.116152 1.266782 1.256257 -0.199735 0.730751 -0.178681 0.296223 0.384273) ) ;;; 76 prime -------------------------------------------------------------------------------- (vector 76 13.288178191792 #r(0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1) - 11.052689 #r(0.000000 1.173531 0.914653 0.927606 1.833325 0.572990 1.228121 1.340974 0.777818 0.101179 0.922381 0.727758 0.848668 1.622591 0.600587 1.207357 0.483679 -0.135739 0.789693 0.557916 0.529588 0.315324 1.810649 0.126643 0.909249 1.640326 1.342327 -0.052236 0.755820 1.799623 0.462177 -0.288032 0.651075 1.169254 1.824988 0.704237 0.880995 1.859829 0.036089 0.149448 0.542052 0.160045 1.646079 0.860838 1.752249 1.025660 0.604221 0.046575 0.711402 1.553525 1.214111 0.036075 0.479955 0.029596 1.070090 1.208893 1.207610 0.470868 0.758081 1.507527 0.678107 0.675805 1.580182 1.324295 0.061587 0.955350 1.218409 1.880195 0.596793 0.165057 0.646006 0.454851 -0.080576 1.833376 0.764382 0.602862) - ;; 75+1 10.919127 #r(0.000000 0.249051 1.283752 0.578538 0.465889 0.328282 0.397520 0.048700 0.732044 1.506763 0.870470 1.024466 0.125905 1.199969 1.200490 0.828996 0.327349 0.743916 -0.083081 1.581866 -0.022026 1.010771 1.314126 1.641110 1.977207 1.418126 -0.002727 1.553515 0.292061 1.103162 1.068475 0.567360 0.089633 0.183619 -0.243814 -0.246117 0.459882 0.118225 1.182209 0.017390 0.042772 0.114593 -0.081235 1.493721 1.405420 1.147867 1.909741 1.653034 0.237976 0.515913 0.601555 0.768092 1.451311 1.697940 1.055226 -0.095470 1.438708 0.052821 -0.122724 1.275935 0.441115 0.338376 1.822506 1.852761 0.555244 0.752898 1.362553 0.167682 1.066534 1.298923 -0.414288 0.895495 -0.078589 0.121695 0.415788 -0.032714) + 10.774647 #r(0.000000 0.216248 1.443252 0.633654 0.475763 0.204567 0.477014 -0.047516 0.655698 1.585178 1.078717 0.923793 -0.018652 1.190999 1.335896 0.759800 0.344771 0.711304 -0.119179 1.551025 0.001632 1.053793 1.399249 1.746077 -0.024445 1.481778 0.010525 1.467449 0.173899 1.180624 1.014557 0.485255 0.050731 0.231986 -0.092298 -0.159729 0.303818 0.198792 1.126535 0.050847 0.057643 0.119277 -0.114330 1.261207 1.352637 1.245934 -0.073036 1.541475 0.200534 0.560072 0.579037 0.719169 1.391557 1.646913 1.124127 -0.101439 1.336575 -0.028855 -0.075985 1.137652 0.483162 0.222066 1.661863 1.748433 0.375742 0.867221 1.241041 0.020205 0.912530 1.387909 -0.361198 0.982284 -0.117450 0.138757 0.523988 -0.152425) ) ;;; 77 prime -------------------------------------------------------------------------------- (vector 77 13.158900260925 #r(0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1) 10.802937 #r(0.000000 1.170348 0.872365 1.938370 0.176318 1.425001 1.816351 0.600885 0.838206 0.617008 0.862854 1.459906 1.685266 -0.294339 0.340282 0.188975 1.272363 0.222263 0.754500 0.303643 1.420294 0.520239 1.223316 1.153660 0.209190 1.335123 1.331714 0.719154 0.909245 -0.009852 0.827474 -0.139034 0.531790 0.623898 0.587466 0.935238 0.452213 -0.149439 0.923750 0.885640 -0.429219 0.037445 0.354080 0.150061 0.302072 1.423031 0.130250 -0.009435 0.571653 0.410660 0.194501 1.802956 0.455392 0.509514 1.619972 1.373513 1.082720 1.024058 0.798330 0.005055 0.529388 0.193199 0.652877 0.658529 1.505933 1.232728 0.171053 1.366924 1.004855 0.355582 1.506276 0.574068 1.502183 1.005869 -0.239104 1.730993 -0.006156) + 10.787093 #r(0.000000 1.149443 0.839971 1.956305 0.168601 1.427588 1.800892 0.609682 0.814947 0.631205 0.873403 1.488539 1.665370 -0.309318 0.332414 0.201227 1.240570 0.267709 0.720021 0.301507 1.431244 0.535840 1.193228 1.164152 0.191654 1.320111 1.339133 0.720237 0.902284 -0.025313 0.876522 -0.150998 0.539439 0.632152 0.598019 0.925249 0.453321 -0.170091 0.923681 0.879763 -0.459931 0.014839 0.344599 0.118045 0.294786 1.397001 0.097630 -0.060819 0.573635 0.376236 0.149790 1.819557 0.472911 0.520765 1.611957 1.363729 1.059191 1.015359 0.784191 0.007017 0.526385 0.177402 0.653955 0.630819 1.506190 1.214284 0.142017 1.368482 0.988751 0.343026 1.474912 0.576723 1.482195 0.984766 -0.259805 1.708315 0.031304) ) ;;; 78 prime -------------------------------------------------------------------------------- (vector 78 13.498236182018 #r(0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1) - 11.128810 #r(0.000000 1.556151 1.350766 1.079560 1.627456 1.824396 0.970239 1.719188 0.076491 0.356551 0.956437 1.450393 1.649467 1.028644 0.913293 0.244507 0.114759 1.070289 1.644113 1.454817 0.980418 0.918084 0.619510 1.767585 1.807117 0.656270 1.762010 0.672983 0.042023 -0.071247 0.983492 -0.081135 0.135693 0.114828 1.357805 -0.252941 1.850579 1.671928 0.257832 0.920719 0.631282 0.706947 1.321680 1.346893 -0.182371 -0.272451 0.054087 1.657623 0.055118 0.350677 1.314600 0.063294 0.902678 0.105522 1.670846 0.405032 -0.075578 -0.012369 -0.068016 1.298918 0.818077 -0.266776 0.759067 0.508057 -0.040066 1.459059 0.532881 1.133191 1.019843 -0.486096 1.086169 0.894532 1.300427 1.601490 0.616399 1.768752 1.000095 1.636458) - ;; 77+1 11.104393 #r(0.000000 1.124037 0.854979 1.945811 0.208140 1.468398 1.815990 0.611918 0.912844 0.730140 0.961369 1.376309 1.803559 -0.243021 0.398976 0.193476 1.338837 0.340346 0.793855 0.341671 1.410779 0.565778 1.176931 1.048390 0.277106 1.445162 1.185150 0.642492 0.933385 0.019030 0.859542 -0.113411 0.532157 0.598476 0.550518 0.931780 0.311264 -0.108835 0.867767 0.932278 -0.351004 0.021213 0.390636 0.076987 0.338139 1.457487 0.082705 1.889708 0.513158 0.413795 0.138548 1.809057 0.494899 0.552125 1.690745 1.358244 1.250637 0.989495 0.775385 1.847135 0.528873 0.242941 0.558866 0.669472 1.484739 1.334473 0.249966 1.409992 1.022049 0.346238 1.534652 0.641930 1.394789 0.932978 -0.210333 1.769933 -0.083609 -0.106856) + 11.025762 #r(0.000000 1.114044 0.851141 1.946454 0.233745 1.447629 1.798779 0.603048 0.869887 0.698029 0.942089 1.379303 1.674388 -0.319953 0.363570 0.189411 1.288121 0.369062 0.824473 0.361488 1.394087 0.639016 1.195471 1.019450 0.213182 1.517284 1.193919 0.580387 0.874783 0.014115 0.886126 -0.081450 0.531991 0.671662 0.564106 0.940285 0.396793 -0.099738 0.799977 0.885230 -0.367901 0.030125 0.357048 0.092244 0.329686 1.529846 0.124149 1.854045 0.550527 0.436538 0.107608 1.828424 0.505757 0.596611 1.675868 1.348890 1.194119 1.023020 0.785280 1.901532 0.561564 0.228444 0.537796 0.717196 1.499952 1.350945 0.229596 1.469958 1.000247 0.388369 1.567941 0.678556 1.430994 0.904593 -0.186806 1.803953 -0.082963 -0.149268) ) ;;; 79 prime -------------------------------------------------------------------------------- (vector 79 13.178678233398 #r(0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1) 11.177833 #r(0.000000 1.310798 1.470398 1.323367 0.553981 1.135824 0.783258 1.090444 0.524280 1.788975 1.639185 0.764585 0.676397 1.561727 -0.046007 0.428923 1.763449 0.011640 0.636361 1.341212 0.004579 1.608860 0.575061 0.243266 0.907181 0.977184 1.726699 0.431482 0.140827 0.464141 1.057140 1.400168 0.289408 0.838151 1.631807 1.530460 1.501458 0.566438 1.487014 0.015110 1.680036 1.296993 1.364424 0.039821 1.528230 0.589464 0.715462 0.552663 -0.017058 1.149326 1.516482 -0.030051 0.582733 -0.149911 0.234725 0.517539 1.013720 0.964483 -0.295150 -0.068887 -0.069035 1.472439 0.368231 1.600803 0.316013 0.723864 0.014324 0.524613 1.419685 1.673198 -0.043005 -0.029455 1.487321 1.686189 1.173017 1.833259 1.763911 1.426155 0.892867) + 11.147975 #r(0.000000 1.347380 1.479332 1.335898 0.555994 1.153320 0.796376 1.081153 0.500536 1.806900 1.613450 0.748898 0.659851 1.599731 -0.004893 0.471990 1.722358 0.024049 0.618689 1.373652 0.023732 1.598008 0.564981 0.258317 0.879064 0.965104 1.752406 0.457369 0.147894 0.451817 1.055184 1.371366 0.321140 0.824459 1.647562 1.527904 1.464992 0.549135 1.464511 0.047514 1.714873 1.271744 1.351679 0.091804 1.518935 0.655840 0.723131 0.564133 -0.053787 1.141454 1.505991 -0.002931 0.596650 -0.173027 0.253307 0.540877 0.989989 1.018297 -0.311821 -0.097848 -0.058708 1.461581 0.369948 1.656444 0.370482 0.756078 -0.010886 0.501559 1.405676 1.682499 -0.046054 -0.015682 1.507275 1.700738 1.187739 1.853757 1.756679 1.458133 0.892344) ) ;;; 80 prime -------------------------------------------------------------------------------- (vector 80 13.547472953796 #r(0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1) - 11.451369 #r(0.000000 -0.011188 0.391305 0.222144 0.025668 0.977359 0.513223 0.531901 0.360643 0.616841 1.341911 0.888846 1.600347 1.373974 0.123418 0.279769 -0.016126 0.463887 1.222914 1.957299 0.569052 1.699668 0.580517 1.202146 1.407428 1.172831 0.507495 0.800333 0.267556 -0.108002 1.745992 0.435164 1.044228 1.843822 0.030677 1.871048 0.542929 1.649600 0.514183 1.864352 0.330625 0.131744 0.409433 0.986423 1.602974 0.780283 0.138004 1.178452 0.747173 1.116954 0.917346 0.796903 0.356061 1.164738 0.640385 1.216938 0.366648 0.258624 0.900284 0.041536 1.817962 1.403113 1.192348 0.700576 1.370480 0.286847 0.603480 0.172807 1.255252 0.148259 1.272121 0.592895 1.744785 0.951797 1.489669 1.384870 1.365248 1.727217 1.576364 1.630892) - ;; 79+1 11.248369 #r(0.000000 1.320660 1.562587 1.230907 0.791500 1.111831 0.776332 1.212269 0.471199 1.929248 1.797736 0.814341 0.620835 1.395121 -0.166860 0.291055 1.737100 0.070444 0.531137 1.293083 0.075352 1.711864 0.539841 0.274514 0.922582 0.992421 1.608388 0.391268 0.216699 0.537576 0.886521 1.411196 0.301396 0.827503 1.619143 1.601542 1.558307 0.639158 1.445488 -0.167072 1.736837 1.279584 1.414784 0.077225 1.537483 0.689000 0.730293 0.519349 -0.104713 1.140696 1.722734 -0.057361 0.493518 -0.183111 0.352303 0.572659 0.917617 1.016232 -0.317574 -0.040058 -0.065357 1.491653 0.416263 1.654521 0.241001 0.536870 0.065165 0.568896 1.612372 1.840754 0.054958 0.057425 1.377368 1.668931 1.097005 1.763836 1.887359 1.244817 0.894926 -0.107373) + 11.241319 #r(0.000000 1.330796 1.578980 1.229087 0.799089 1.111139 0.773946 1.214327 0.459672 1.931489 1.808459 0.825480 0.625101 1.393391 -0.168175 0.270893 1.732601 0.075259 0.513698 1.295778 0.082502 1.705844 0.532200 0.268097 0.929407 0.994015 1.611557 0.401886 0.215264 0.534423 0.884297 1.407235 0.298195 0.830573 1.629411 1.613596 1.556504 0.627050 1.442897 -0.161773 1.749118 1.290427 1.416967 0.085164 1.534541 0.683670 0.735638 0.518192 -0.106247 1.129901 1.728544 -0.048229 0.496972 -0.186240 0.365481 0.601685 0.922744 1.018503 -0.320247 -0.036837 -0.063463 1.491886 0.423675 1.652805 0.241523 0.546232 0.057962 0.571974 1.604450 1.843338 0.064573 0.043691 1.383503 1.677169 1.099158 1.765244 1.893073 1.243539 0.911091 -0.100881) ) ;;; 81 prime -------------------------------------------------------------------------------- (vector 81 13.652944564819 #r(0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1) - 11.500874 #r(0.000000 0.060156 1.198187 0.010810 -0.059627 1.336892 0.174682 0.177182 0.303039 0.507728 0.174616 0.162104 0.767672 0.283268 0.740356 1.244073 0.411651 0.771082 0.597722 1.646364 0.130092 1.399674 1.196320 1.542256 1.814795 0.969378 1.368552 0.008802 1.647015 1.538679 0.957584 0.562757 0.185463 0.612441 1.264483 1.129777 -0.291833 0.231345 1.808426 -0.095607 1.827790 0.807634 0.929515 0.025793 1.640598 1.271614 1.470525 0.036943 0.657753 0.872430 1.519719 0.128077 0.109048 0.492656 -0.089269 0.591629 -0.109776 0.882829 0.675418 0.557752 1.879709 0.050861 1.363712 1.313213 0.120759 0.673965 0.894225 1.390640 -0.198915 1.435867 0.650146 0.682721 0.919339 1.509191 0.176654 0.428794 0.550059 1.279511 0.067206 1.270072 0.509792) - ;; 80+1 11.318789 #r(0.000000 1.312875 1.595991 1.250300 0.860994 1.125394 0.798611 1.212371 0.450471 1.878426 1.854513 0.914795 0.516574 1.401974 -0.113348 0.191503 1.535380 0.090102 0.579969 1.358286 0.094046 1.749820 0.409421 0.342346 0.891748 1.034938 1.701846 0.411592 0.161183 0.550475 0.945261 1.433769 0.390250 0.782945 1.725670 1.526810 1.626189 0.651868 1.370885 -0.153655 1.876481 1.236862 1.409437 0.102929 1.494796 0.718278 0.752798 0.534726 -0.125235 1.053652 1.624242 -0.009527 0.513674 -0.193412 0.274147 0.590252 0.888478 1.001277 -0.294725 -0.017970 0.022617 1.502755 0.474472 1.669991 0.292823 0.423633 -0.068585 0.472411 1.717891 1.789153 0.120369 -0.013158 1.253256 1.671744 1.049132 1.799303 1.831390 1.289936 0.966946 -0.056458 0.096803) + 11.312304 #r(0.000000 1.311005 1.596283 1.246347 0.860649 1.125536 0.804887 1.215858 0.452152 1.875575 1.849461 0.914627 0.521529 1.405265 -0.109476 0.189006 1.536765 0.089192 0.581123 1.359054 0.094099 1.747992 0.409894 0.340340 0.895234 1.030430 1.697347 0.407358 0.159908 0.546443 0.947601 1.431409 0.391789 0.789951 1.726306 1.527039 1.626295 0.655216 1.370556 -0.152890 1.878678 1.238319 1.415708 0.099895 1.496028 0.717090 0.749257 0.538280 -0.125459 1.054061 1.624202 -0.016526 0.514542 -0.199562 0.267676 0.590682 0.888195 1.000874 -0.294059 -0.023982 0.018521 1.501245 0.473203 1.675537 0.290660 0.417951 -0.072318 0.470963 1.712501 1.788586 0.115121 -0.020471 1.248084 1.670783 1.055068 1.795949 1.825171 1.291047 0.974158 -0.060094 0.102352) ) ;;; 82 prime -------------------------------------------------------------------------------- (vector 82 14.126787045134 #r(0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0) 11.462533 #r(0.000000 1.174537 -0.036810 1.449073 0.002634 1.412064 0.527823 1.690777 0.901678 -0.091711 1.027422 0.397477 1.526657 0.088004 0.143741 1.426347 1.215238 1.051627 0.132305 0.242096 1.932884 0.204037 1.515523 0.068047 0.117753 1.158626 0.459284 1.081363 0.079849 0.326802 0.035989 0.012387 0.861938 0.605551 1.407324 0.411725 0.979703 0.090881 0.271335 0.152506 0.410872 1.149930 0.566324 1.611304 1.416641 0.010695 1.743925 0.323768 0.693725 0.691039 0.186118 0.191067 0.629603 -0.034867 0.109309 0.522152 1.478755 1.337464 1.245454 -0.020762 0.796712 1.449381 1.763960 0.000713 0.577015 1.247460 1.754051 1.376869 0.724941 0.407841 1.068454 1.226119 0.726352 1.657000 0.543820 1.177669 0.881363 0.120220 0.019239 0.418519 0.727327 0.208388) - - ;; 81+1 - 11.476728 #r(0.000000 1.354025 1.769404 1.190492 0.845403 1.129164 0.681502 1.298591 0.526568 1.843796 1.839481 0.929391 0.545970 1.407502 -0.189236 0.155330 1.457831 0.110325 0.689064 1.222186 0.140271 1.863572 0.397423 0.425505 0.924253 1.034491 1.746896 0.221413 0.062871 0.570198 0.961166 1.514028 0.333971 0.850400 1.784003 1.484569 1.642647 0.680600 1.387654 -0.169385 1.868168 1.192895 1.317483 0.057642 1.550333 0.713537 0.826588 0.568782 -0.116091 1.031193 1.647713 0.076692 0.476679 -0.258739 0.325137 0.519423 0.928625 1.015174 -0.230419 -0.032172 0.037533 1.492936 0.495027 1.663321 0.378454 0.435791 -0.107582 0.529403 1.716992 1.827784 0.057964 -0.044990 1.256674 1.627386 1.007381 1.757651 1.738780 1.265746 1.051412 0.004277 0.076991 0.034105) - - ;; 83-1 - 11.480416 #r(0.000000 0.454164 1.374754 0.722227 0.986349 1.377355 1.172894 0.123589 1.410636 1.726879 1.302862 1.602018 1.474058 1.472070 0.412168 1.770446 1.982011 1.625710 0.940561 0.534669 0.102735 0.053883 0.631657 1.350304 0.393669 0.521507 -0.049446 0.629634 1.041110 1.379158 -0.156331 1.690517 0.010013 1.800842 0.947691 1.681261 1.009361 1.763476 0.941228 1.218725 1.847726 0.614247 1.223796 0.150627 0.820237 0.298534 1.321472 0.537094 1.742045 0.701084 0.211813 0.587227 0.340134 0.598492 1.566318 1.525148 0.920822 1.421639 1.608617 0.590851 0.062396 0.476310 0.647458 0.340763 1.923701 0.385843 0.256835 1.446458 1.741785 0.470072 1.939455 0.907485 0.836540 0.652790 1.796743 1.327810 0.106788 1.646107 1.364400 0.210392 0.634295 1.443213) + 11.446676 #r(0.000000 1.188354 -0.032728 1.455422 -0.014429 1.396995 0.528908 1.681168 0.902943 -0.111204 1.016710 0.398469 1.507930 0.087346 0.160123 1.444485 1.217593 1.058066 0.133906 0.241669 1.922324 0.191043 1.529885 0.043056 0.108117 1.157853 0.465532 1.100812 0.074740 0.319607 0.057062 0.015495 0.872856 0.609818 1.406720 0.434855 0.990533 0.086099 0.284789 0.148755 0.391240 1.148682 0.561432 1.626242 1.410370 0.006216 1.736363 0.299135 0.670173 0.711283 0.203300 0.187888 0.633206 -0.086285 0.114068 0.528420 1.480774 1.323216 1.252500 -0.012045 0.781642 1.445363 1.737229 0.002451 0.568056 1.260749 1.742031 1.390281 0.722079 0.403898 1.076779 1.221515 0.733693 1.656762 0.555312 1.176486 0.895152 0.133277 -0.003807 0.398014 0.728530 0.202153) ) ;;; 83 prime -------------------------------------------------------------------------------- (vector 83 14.019070339131 #r(0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1) 11.495305 #r(0.000000 0.489724 1.459665 0.744876 0.880930 1.487259 1.179525 0.143969 1.398705 1.711637 1.229644 1.599300 1.480153 1.405136 0.390934 1.640936 1.928348 1.588509 0.860260 0.449815 0.093357 1.993956 0.692831 1.455573 0.371844 0.551569 -0.014841 0.652289 1.000821 1.372208 -0.157122 1.697110 0.020676 1.736939 1.000046 1.712927 0.862704 1.740081 0.913067 1.344458 1.894797 0.629049 1.175321 0.159464 0.992773 0.367516 1.362985 0.576721 1.753109 0.776625 0.227603 0.452205 0.315264 0.636900 1.541376 1.554828 0.983967 1.431020 1.527430 0.561443 -0.018728 0.579720 0.634527 0.252657 1.931947 0.472631 0.403447 1.506115 1.700022 0.443875 1.857223 0.863365 0.830784 0.658374 1.791596 1.216322 0.200510 1.645886 1.544611 0.129139 0.651447 1.366065 0.329410) + 11.491388 #r(0.000000 0.491410 1.463995 0.744118 0.880553 1.487423 1.180312 0.141716 1.394128 1.707368 1.227339 1.596892 1.481439 1.404101 0.393121 1.640574 1.929561 1.591831 0.858487 0.448320 0.092630 1.993856 0.694251 1.457261 0.376554 0.548823 -0.016141 0.651696 1.002544 1.369748 -0.155559 1.693297 0.018105 1.736748 0.998588 1.711053 0.859526 1.739830 0.912453 1.342918 1.900628 0.629035 1.173159 0.161863 0.992196 0.367923 1.361157 0.572452 1.750272 0.779643 0.224717 0.454467 0.314264 0.632595 1.545164 1.551264 0.986678 1.435044 1.526805 0.557653 -0.016940 0.576125 0.635628 0.250716 1.934919 0.468848 0.402633 1.504556 1.704007 0.442792 1.852229 0.869693 0.828579 0.657974 1.787429 1.215505 0.199699 1.643958 1.543025 0.133633 0.652834 1.364046 0.326025) ) ;;; 84 prime -------------------------------------------------------------------------------- (vector 84 14.024940956301 #r(0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0) 11.536851 #r(0.000000 1.288171 1.222912 1.421316 0.994256 1.309106 0.862461 -0.365885 -0.460542 0.530989 0.804830 1.140139 0.788715 0.769440 0.941320 -0.061500 1.897753 1.285116 0.647118 0.948482 1.478812 1.645309 -0.360540 1.475165 0.480180 0.398442 1.131834 0.453887 0.828958 0.223971 1.033478 0.103677 1.715711 0.595485 0.422094 0.246530 1.081093 0.706350 0.534924 0.737096 0.520740 1.348231 0.027898 1.430351 0.071366 0.456025 1.024992 0.563780 1.148663 1.244878 0.023430 1.078768 -0.035007 1.108834 0.481954 -0.628990 0.715248 0.675907 1.709977 0.563135 1.037605 0.888801 0.556599 0.958729 0.571715 1.126122 -0.072129 1.378438 0.187340 0.783805 0.989989 0.112073 -0.183972 1.388719 1.544777 0.651714 0.568338 1.234814 0.056527 0.901152 1.674263 0.800528 0.192396 0.655541) + 11.531636 #r(0.000000 1.297755 1.223523 1.420374 0.992204 1.311337 0.861591 -0.372637 -0.465443 0.526794 0.801624 1.138463 0.789613 0.773445 0.943589 -0.064374 1.904027 1.279846 0.649179 0.946895 1.478036 1.644528 -0.362575 1.477764 0.483160 0.401573 1.126386 0.452932 0.831595 0.223937 1.036848 0.103100 1.709932 0.601659 0.417861 0.246891 1.077922 0.708546 0.534074 0.737808 0.518676 1.343455 0.029441 1.433347 0.077906 0.458558 1.025112 0.560332 1.148872 1.247025 0.020247 1.081938 -0.034051 1.109673 0.481651 -0.625024 0.721823 0.677346 1.709275 0.562480 1.034818 0.888309 0.560867 0.968250 0.569348 1.127341 -0.070912 1.384791 0.185864 0.788352 1.001147 0.119094 -0.179139 1.391031 1.550304 0.659899 0.569574 1.236108 0.061295 0.904889 1.683412 0.806003 0.192715 0.657454) ) ;;; 85 prime -------------------------------------------------------------------------------- (vector 85 14.253310943921 #r(0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1) 11.588928 #r(0.000000 0.051144 0.232251 1.722677 0.580164 1.682133 1.175152 1.551429 1.040385 1.746433 0.629958 1.774843 0.701195 0.931344 1.300787 -0.092863 1.300643 1.259885 1.530011 1.258206 1.393028 0.930782 0.485840 1.244517 -0.032618 0.062247 0.154622 1.065009 0.904299 1.262092 0.852812 0.408235 0.633914 1.770716 1.085864 1.265219 1.003699 1.255985 1.195701 1.382932 0.704891 0.246143 0.639193 1.457010 0.146909 1.982729 0.165366 1.294717 0.624758 1.669440 0.868773 0.953753 0.230896 0.915079 -0.212743 0.773612 0.218470 1.122339 1.601419 1.730078 1.474786 -0.488722 1.796889 1.514239 1.703114 -0.437786 0.743917 1.859124 1.287147 1.160254 0.159597 0.817545 1.148746 -0.204270 1.716652 0.382598 -0.057580 0.598631 0.343212 0.230053 1.103741 1.603024 0.720362 -0.247891 -0.077598) + 11.583074 #r(0.000000 0.051373 0.230252 1.720705 0.577769 1.682180 1.172121 1.553676 1.039937 1.746234 0.633671 1.773606 0.701545 0.930153 1.307498 -0.093594 1.294138 1.261269 1.529897 1.259168 1.393107 0.930729 0.487497 1.243217 -0.036268 0.063349 0.153816 1.070706 0.906031 1.258309 0.848149 0.407339 0.629458 1.771514 1.091493 1.263595 1.003196 1.251972 1.199803 1.383388 0.703635 0.244783 0.637969 1.457354 0.150617 1.981217 0.165316 1.299109 0.627238 1.667527 0.865546 0.956919 0.229122 0.913622 -0.213827 0.770145 0.224277 1.123332 1.601272 1.726063 1.476423 -0.482883 1.792414 1.515045 1.702831 -0.438097 0.747762 1.856866 1.281055 1.156238 0.155485 0.813241 1.147392 -0.202557 1.717918 0.377151 -0.057256 0.602981 0.342435 0.229059 1.106161 1.604859 0.725381 -0.247104 -0.077615) ) ;;; 86 prime -------------------------------------------------------------------------------- (vector 86 14.017106967247 #r(0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1) 11.517897 #r(0.000000 1.259153 0.753054 1.764686 1.049517 1.125067 1.190973 0.991011 1.742456 0.708907 0.178161 0.559310 1.128716 0.240782 0.729992 0.303371 0.569838 1.273658 0.861674 0.290602 0.694623 0.362989 0.243116 1.696103 0.326714 1.481176 0.105867 1.763155 0.389638 1.096089 1.860461 0.384795 1.595111 0.327309 0.224303 1.457357 0.863276 1.221159 0.474861 0.148710 1.484645 1.778010 1.802629 1.714822 1.122256 0.709074 0.540633 -0.317254 0.997156 1.115917 0.123376 1.869025 1.339712 0.876345 1.682733 0.893530 0.998209 1.642978 1.224902 0.836368 1.948885 0.464451 1.058190 1.080864 1.538683 1.521142 0.009248 0.654339 -0.126350 0.282369 0.636445 1.771914 0.323435 1.302976 0.483884 1.466774 1.898584 0.571020 1.479654 0.824385 0.735539 0.638514 1.340179 1.302713 1.869702 1.497079) + 11.509357 #r(0.000000 1.258611 0.757057 1.762300 1.051397 1.125650 1.189467 0.990877 1.740341 0.705207 0.177831 0.560340 1.125728 0.242507 0.726531 0.303853 0.569773 1.274998 0.860802 0.291032 0.696139 0.359261 0.239121 1.699618 0.323552 1.478919 0.099799 1.760342 0.391714 1.095952 1.862031 0.385173 1.595217 0.328437 0.225887 1.458742 0.861196 1.218770 0.476690 0.144434 1.485261 1.771923 1.807340 1.715004 1.122693 0.712654 0.541174 -0.317470 0.998819 1.118480 0.119617 1.865403 1.339446 0.873963 1.688548 0.891741 0.998579 1.643497 1.225502 0.831435 1.952913 0.466250 1.055282 1.081874 1.537777 1.521370 0.009261 0.654315 -0.132195 0.279540 0.640654 1.774687 0.321573 1.303210 0.484806 1.464335 1.899679 0.571761 1.476273 0.823331 0.735747 0.641113 1.337918 1.302182 1.863502 1.494521) ) ;;; 87 prime -------------------------------------------------------------------------------- @@ -4825,20 +4824,18 @@ ;; (18) ;; 1-Jan 4149.99 - ; all 0.4860 (20) to 0.4986 (125), dist: 0.0000, 15.0910 ; odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 9.0892 ; even 0.5085 (115) to 0.5242 (22), dist: 57.6613, 0.0000 ; prime 0.5444 (24) to 0.5540 (67), dist: 232.5920, 0.0000 #| -24-Jun-18: -sum: 4147.412622384121, sqrts: 122 122 0 0 (0.0000) - +20-Jul-18: +sum: 4146.508608384121, sqrts: 122 122 0 0 (0.0000) all 0.4860 (20) to 0.4986 (125), dist: 0.0000, 15.0910 odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 9.0892 even 0.5067 (120) to 0.5242 (22), dist: 55.3350, 0.0000 - prime 0.5444 (24) to 0.5540 (67), dist: 232.3361, 0.0000 + prime 0.5444 (24) to 0.5539 (67), dist: 231.4321, 0.0000 |# ;(test-all-phases #f) in test-phases.scm @@ -4851,19 +4848,19 @@ sum: 4147.412622384121, sqrts: 122 122 0 0 (0.0000) ;;; 19-Jul-14: 22 ;;; 9-Jul-15: 18 ;;; 9-Nov-16: 22 -;;; 20-Jul-17: 6 (370) -;;; 24-Jun-18: 6 (348) +;;; 20-Jul-17: 6 +;;; 24-Jun-18: 6 -<1> (test-all-phases #f) -;all peaks... Sun 24-Jun-2018 17:47 +;all peaks... Fri 20-Jul-2018 16:41 (0.00149573739942177 101) -;odd peaks... Sun 24-Jun-2018 17:49 +;odd peaks... Fri 20-Jul-2018 16:43 (0.001687315629254726 125) -;even peaks... Sun 24-Jun-2018 17:50 +;even peaks... Fri 20-Jul-2018 16:44 (0.001467169674692848 4) -;prime peaks... Sun 24-Jun-2018 17:51 +;prime peaks... Fri 20-Jul-2018 16:45 (0.001975582609148319 2048) -;all done! Sun 24-Jun-2018 17:54 +;all done! Fri 20-Jul-2018 16:47 +390.831u 0.007s 6:30.85 99.9% 0+0k 0+0io 0pf+0w |# diff --git a/reactive.scm b/reactive.scm new file mode 100644 index 0000000..054cbec --- /dev/null +++ b/reactive.scm @@ -0,0 +1,373 @@ +;;; reactive.scm +;;; +;;; reimplementation of code formerly in stuff.scm + +(define setter-print #f) + + +(define (gather-symbols expr ce lst ignore) + ;; collect settable variables in expr + (cond ((symbol? expr) + (if (or (memq expr lst) + (memq expr ignore) + (procedure? (symbol->value expr ce)) + (eq? (let symbol->let ((sym expr) + (ce ce)) + (if (defined? sym ce #t) + ce + (and (not (eq? ce (rootlet))) + (symbol->let sym (outlet ce))))) + (rootlet))) + lst + (cons expr lst))) + + ((not (pair? expr)) lst) + + ((not (and (pair? (cdr expr)) (pair? (cddr expr)))) + (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)) + + ((pair? (cadr expr)) + (gather-symbols (case (car expr) + ((let let* letrec letrec* do) + (values (cddr expr) ce lst (append ignore (map car (cadr expr))))) + ((lambda) + (values (cddr expr) ce lst (append ignore (cadr expr)))) + ((lambda*) + (values (cddr expr) ce lst (append ignore (map (lambda (a) (if (pair? a) (car a) a)) (cadr expr))))) + (else + (values (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))))) + + ((and (eq? (car expr) 'lambda) + (symbol? (cadr expr))) + (gather-symbols (cddr expr) ce lst (append ignore (list (cadr expr))))) + + (else + (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)))) + + +;;; c-pointer used to hold symbol+let info so that the lets can be a "weak references" +(define slot-symbol c-pointer-type) +(define slot-expr c-pointer-info) +(define slot-env c-pointer-weak1) +(define slot-expr-env c-pointer-weak2) +(define (slot symbol expr env expr-env) (c-pointer 0 symbol expr env expr-env)) + + +(define (symbol->let symbol env) + ;; return let in which symbol lives (not necessarily curlet) + (if (not (let? env)) + #<undefined> + (if (defined? symbol env) + env + (symbol->let symbol (outlet env))))) + + +(define (setter-update cp) ; cp: (slot var expr env expr-env) + ;; when var set, all other vars dependent on it need to be set also, watching out for GC'd followers + (if setter-print (format *stderr* " -------- setter-update ~S~%" cp)) + (let ((var (slot-symbol cp)) + (env (slot-env cp)) + (expr (slot-expr cp))) + (when (and (let? (slot-env cp)) ; when slot-env is GC'd, the c-pointer field is set to #f (by the GC) + (let? (slot-expr-env cp))) + (let ((new-val (eval expr (slot-expr-env cp)))) + (when (let? (slot-env cp)) + (if setter-print (format *stderr* " -------- let-set ~S ~S~%" var new-val)) + (let-set! env var new-val)))))) + + +(define (slot-equal? cp1 cp2) + (and (eq? (slot-symbol cp1) (slot-symbol cp2)) + (eq? (slot-env cp1) (slot-env cp2)))) + +(define (setter-remove cp lst) + ;; if reactive-set! called again on a variable, its old setters need to remove the now obsolete set of that variable + (if (null? lst) + () + (if (slot-equal? cp (car lst)) + (cdr lst) + (cons (car lst) + (setter-remove cp (cdr lst)))))) + + +(define* (make-setter var env (followers ()) (setters ()) (expr ()) expr-env) + ;; return a new setter with closure containing the followers and setters of var, and the c-pointer holding its name, environment, and expression + (if setter-print (format *stderr* " -------- make-setter ~S ~S ~S ~S ~S~%" var env followers setters expr)) + (let ((followers followers) + (setters setters) + (cp (slot var expr env expr-env))) + (lambda (sym val) + (if setter-print (format *stderr* " -------- setter ~S ~S ~S~%" sym val (*s7* 'stack-top))) + ;(if (> (*s7* 'stack-top) 30) (abort)) + (let-temporarily (((setter (slot-symbol cp) (slot-env cp)) #f)) + (if setter-print (format *stderr* " -------- let-set ~S ~S: ~S in ~S~%" sym val (setter sym) (slot-env cp))) + (let-set! (slot-env cp) (slot-symbol cp) val) ; set new value without retriggering the setter + (for-each setter-update followers) ; set any variables dependent on var + val)))) + + +(define-bacro (reactive-set! place value) ; or maybe macro* with traling arg: (e (outlet (curlet)))?? + (with-let (inlet 'place place ; with-let here gives us control over the names + 'value value + 'e (outlet (curlet))) ; the run-time (calling) environment + `(let ((old-followers ()) + (old-setter (setter ',place)) + (lt (symbol->let ',place ,e))) + + ;; if previous set expr, remove it from setters' followers lists + (when (and old-setter + (defined? 'followers (funclet old-setter)) + (defined? 'setters (funclet old-setter))) + (set! old-followers ((funclet old-setter) 'followers)) + (for-each (lambda (s) + (when (and (setter s) + (defined? 'followers (funclet (setter s)))) + (let ((setter-followers (let-ref (funclet (setter s)) 'followers))) + (let-set! (funclet (setter s)) + 'followers + (setter-remove (slot ',place 0 lt ,e) setter-followers))))) + (let-ref (funclet old-setter) 'setters))) + + ;; set up new setter + (let ((setters (gather-symbols ',value ,e () ()))) + (when (pair? setters) + (let ((expr (if (pair? ',value) (copy ',value :readable) ',value))) + (let ((cp (slot ',place expr lt ,e))) + (set! (setter ',place lt) + (make-setter ',place lt old-followers setters expr ,e)) + + ;; add the slot to the followers setter list of each variable in expr + (for-each (lambda (s) + (unless (and (setter s) + (defined? 'followers (funclet (setter s)))) + (set! (setter s) (make-setter s (symbol->let s ,e)))) + (let ((setter-followers (let-ref (funclet (setter s)) 'followers))) + (unless (member cp setter-followers slot-equal?) + (let-set! (funclet (setter s)) + 'followers + (cons cp setter-followers))))) + setters))))) + (set! ,place ,value)))) + + +;; -------------------------------------------------------------------------------- +#| +(let () +(define a 2) +(define b 1) +(define x 0) +(if setter-print (format *stderr* " -------- reactive-set...~%")) +(reactive-set! x (+ a b)) + +(set! a 3) +(format *stderr* "x: ~A~%" x) +(set! b 4) +(format *stderr* "x: ~A~%" x) + +(format *stderr* "x setter: ~S ~S~%" (setter 'x) (funclet (setter 'x))) +(format *stderr* "a setter: ~S ~S~%" (setter 'a) (funclet (setter 'a))) +;; x setter: #<lambda (sym val)> (inlet 'followers () 'setters (b a) 'cp #<x (nil)>) +;; a setter: #<lambda (sym val)> (inlet 'followers (#<x (nil)>) 'setters () 'cp #<a (nil)>) + +(reactive-set! a (* b 2)) +(set! b 5) +(format *stderr* "x: ~A, a: ~A, b: ~A~%" x a b) +;; x: 15, a: 10, b: 5 +) + +(let ((x 0)) + (do ((i 0 (+ i 1))) + ((= i 100)) + (let ((a 1)) + (reactive-set! x (* 2 a))) + (let ((a 3)) + (set! a 2)) + (if (zero? (modulo i 10)) + (gc)))) + +(define-macro (test a b) + ;(display a) (newline) + `(if (not (equal? ,a ,b)) + (format *stderr* "~S -> ~S?~%" ',a ,b))) + + +(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9) +(test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14) +(test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6) +(test (let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a) 6) +(test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6) +(test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6) +(test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6) +(test (let ((outer 0)) (let ((nv 21) (sym 1)) (let ((inner 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv))) 6) +(test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5)) +(test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19)) + +(test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14) +(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3)) +(test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3)) + +(test (let ((a 1) (x 0)) (reactive-set! x (* a 2)) (reactive-set! a (* x 2)) (set! x 2) a) 4) +(test (let ((a 1)) (let ((b 0) (c 0)) (reactive-set! b (* a 2)) (reactive-set! c (* a 3)) (let ((x 0)) (reactive-set! x (+ a b c)) (set! a 2) x))) 12) +(test (let ((x 0)) (let ((a 1)) (reactive-set! x (* 2 a)) (set! a 2)) x) 4) + +(test (let ((x 0) (a 1)) (reactive-set! x (+ a 1)) (reactive-set! a (+ x 2)) (set! a 3) (set! x 4) (list x a)) (list 4 6)) +(test (let ((x 0) (a 1) (b 0)) (reactive-set! x (+ a 2)) (let ((x 2)) (reactive-set! x (+ a 1)) (set! a 4) (set! b x)) (list x a b)) (list 6 4 5)) +(test (let ((x 0)) (reactive-set! x (* 3 2)) x) 6) +(test (let ((x 0)) (reactive-set! x (* pi 2)) x) (* pi 2)) +(test (let ((x 0)) (let ((a 1)) (reactive-set! x a) (set! a 2)) x) 2) + +;;; (define-macro (with-setters vars . body) `(let-temporarily (,(map (lambda (var) `((setter ',var) #f)) vars)) ,@body)) + +(let ((x 0)) + (do ((i 0 (+ i 1))) + ((= i 100)) + (let ((a 1)) + (reactive-set! a (* 2 x)) + (set! x 2) + (if (zero? (modulo i 10)) + (gc))))) + +(let ((x 0)) + (do ((i 0 (+ i 1))) + ((= i 100)) + (let ((a 1)) + (reactive-set! x (* 2 a)) + (set! a 2)))) + +(test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 6) ; old setter ignored +(test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6) + +;; also place as generalized set: (reactive-set! (v 0) (* a 2)) -- does v get the setter? +|# +;;; -------------------------------------------------------------------------------- + +(define-bacro (reactive-let vars/inits . body) + (with-let (inlet 'vars/inits vars/inits + 'body body + 'e (outlet (curlet))) + (let ((vars (map car vars/inits)) + (inits (map cadr vars/inits))) + (let ((reacts (map (lambda (var init) + `(let ((setters (gather-symbols ',init ,e () ()))) + (when (pair? setters) + (let ((expr (if (pair? ',init) (copy ',init :readable) ',init)) + (lt (curlet))) + (let ((cp (slot ',var expr lt ,e))) + (set! (setter ',var lt) + (make-setter ',var lt () setters expr ,e)) + (for-each (lambda (s) + (unless (and (setter s) + (defined? 'followers (funclet (setter s)))) + (set! (setter s) (make-setter s lt))) + (let ((setter-followers (let-ref (funclet (setter s)) 'followers))) + (unless (member cp setter-followers slot-equal?) + (let-set! (funclet (setter s)) + 'followers + (cons cp setter-followers))))) + setters)))))) + vars inits))) + `(let ,vars/inits + ,@reacts + ,@body))))) + +;;; -------------------------------------------------------------------------------- +#| + (test (reactive-let () 3) 3) + (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2) + (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7) + (test (let ((a 1)) (+ (reactive-let ((b (+ a 1)) (a 0)) (set! a 3) b) a)) 3) + (test (let ((a 1)) (reactive-let ((a 2) (b (* a 3))) (set! a 3) b)) 3) + (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! a 3) b)) 3) + (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! b 3) a)) 4) + (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2))) (set! b 3) a)) 6) + (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4) + (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10) + (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11) + (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (setter 'a)) #f) + (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11) + (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13) ;c=4 because it watches the outer b + (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10) + (test (let ((a 1)) (reactive-let ((b (* a 2))) (let ((d (reactive-let ((c (* a 3))) c))) (set! a 2) (+ b d)))) 7) + (test (let ((a 1)) (reactive-let ((b (* a 2))) (+ (reactive-let ((c (* a 3))) c) (set! a 2) b))) 9) ; a=2 is added to b=4 and c=3 + (test (let ((a 1)) (reactive-let ((b (+ a 1))) (reactive-let ((c (* b 2))) (begin (set! a 3) (+ c b))))) 12) + (test (reactive-let ((a (lambda (b) b))) (a 1)) 1) + (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3) + (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86) + (test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0)) + (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3)) + (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9)) + (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6)) + (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8)) + (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15) +|# +;;; -------------------------------------------------------------------------------- + +(define-macro (reactive-let* vars . body) + (let add-let ((v vars)) + (if (pair? v) + `(reactive-let ((,(caar v) ,(cadar v))) + ,(add-let (cdr v))) + (cons 'begin body)))) + + +;;; -------------------------------------------------------------------------------- +#| + (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9)) + (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6)) + (test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0)) +|# +;;; -------------------------------------------------------------------------------- + +#| +(let () + (define xyzzy (let ((x 0)) + (dilambda + (lambda () + x) + (lambda (val) + (set! x val))))) + (let ((a 1)) + (reactive-set! (xyzzy) (+ a 1)) + (set! a 2) + (xyzzy)) + + (let ((a 1)) + (reactive-set! a (+ (xyzzy) 1)) + (set! (xyzzy) 2) + a) + + (reactive-let ((a (+ (xyzzy) 1))) + (set! (xyzzy) 2) + a)) + +;;; not different?: + +(let ((v (vector 1 2 3))) + (let ((a 1)) + (reactive-set! (v 0) (+ a 1)) + (set! a 2) + (v 0))) + +;;; but where to place the setter in either case -- on 'a and save the location, but then how to erase if reset? +;;; and how to ignore if xyzzy arg not the same? +;;; insist that (f) f be a thunk/dilambda, and in the (set! (f)...) case, put the setter on the setter? (set! (setter (setter f)) ...) + + +<p>Here's the standard example of following the mouse (assuming you're using Snd and glistener): +</p> +<pre class="indented"> +(let ((*mouse-x* 0) (*mouse-y* 0) + (x 0) (y 0)) + + (reactive-set! x (let ((val (round *mouse-x*))) + (format *stderr* "mouse: ~A ~A~%" x y) + val)) + (reactive-set! y (round *mouse-y*)) + + (g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event" + (lambda (w e d) + (let ((mxy (cdr (gdk_event_get_coords (GDK_EVENT e))))) + (set! *mouse-x* (car mxy)) + (set! *mouse-y* (cadr mxy)))))) +</pre> +|# @@ -1505,7 +1505,7 @@ ;;; to display a variable's value as s7 runs using the repl help window: ;;; (define xyz 1) ; some variable... -;;; (set! (symbol-setter 'xyz) (lambda (sym val) (set! (*repl* 'helpers) (list (lambda (c) (format #f "xyz: ~S" val)))) val)) +;;; (set! (setter 'xyz) (lambda (sym val) (set! (*repl* 'helpers) (list (lambda (c) (format #f "xyz: ~S" val)))) val)) ;;; -------------------------------------------------------------------------------- @@ -299,6 +299,11 @@ #define OP_NAMES 0 #endif +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +/* for qsort_r, grumble... */ +#endif + #ifndef _MSC_VER #include <unistd.h> #include <sys/param.h> @@ -340,9 +345,9 @@ #include <inttypes.h> #include <setjmp.h> -#if WITH_MULTITHREAD_CHECKS - #include <pthread.h> -#endif +/* #if WITH_MULTITHREAD_CHECKS */ +#include <pthread.h> +/* #endif */ #if __cplusplus #include <cmath> @@ -374,8 +379,6 @@ #include "s7.h" -#define CDR 1 /* S7_DEBUGGING *//* work in progress */ - #ifndef M_PI #define M_PI 3.1415926535897932384626433832795029L #endif @@ -481,19 +484,6 @@ typedef long double long_double; /* T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, and T_COUNTER are internal */ -typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE, TOKEN_BACK_QUOTE, - TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST, TOKEN_VECTOR, TOKEN_BYTE_VECTOR, TOKEN_INT_VECTOR, TOKEN_FLOAT_VECTOR} token_t; - -typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t; - - -/* -------------------------------- */ -/* local allocator; currently used for strings, hash-tables, ports, vectors, continuations, local c_functions */ - -#ifndef TRACK_BLOCKS -#define TRACK_BLOCKS S7_DEBUGGING -#endif - typedef struct block_t { union { void *data; @@ -501,7 +491,10 @@ typedef struct block_t { s7_int *i_ptr; } dx; int32_t index; - bool filler; + union { + bool filler; + int32_t len; + } ln; s7_int size; union { struct block_t *next; @@ -515,15 +508,21 @@ typedef struct block_t { } nx; union { s7_pointer ex_ptr; - /* char *ex_str; */ void *ex_info; struct { uint32_t i3; int32_t i4; } jx; } ex; +#if S7_DEBUGGING + int allocs, frees; +#endif } block_t; +#define NUM_BLOCK_LISTS 18 +#define TOP_BLOCK_LIST 17 +#define BLOCK_LIST 0 + #define block_data(p) p->dx.data #define block_index(p) p->index #define block_set_index(p, Index) p->index = Index @@ -532,6 +531,11 @@ typedef struct block_t { #define block_next(p) p->nx.next #define block_info(p) p->ex.ex_info +#if S7_DEBUGGING +#define block_allocs(p) p->allocs +#define block_frees(p) p->frees +#endif + typedef block_t hash_entry_t; #define hash_entry_key(p) p->dx.d_ptr #define hash_entry_value(p) p->ex.ex_ptr @@ -547,250 +551,16 @@ typedef block_t optfix_t; typedef block_t vdims_t; #define vdims_ndims(p) p->size -#define vector_elements_should_be_freed(p) p->filler +#define vector_elements_should_be_freed(p) p->ln.filler #define vdims_dims(p) p->dx.i_ptr #define vdims_offsets(p) p->nx.ix_ptr #define vdims_original(p) p->ex.ex_ptr -#define NUM_BLOCK_LISTS 18 -#define TOP_BLOCK_LIST 17 -#define BLOCK_LIST 0 -static block_t *block_lists[NUM_BLOCK_LISTS]; - -static const int32_t bits[256] = - {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}; - -#if TRACK_BLOCKS -static block_t **all_blocks = NULL; -static s7_int all_blocks_size = 0, all_blocks_top = 0; -static void record_block(block_t *b) -{ - if (all_blocks_size == all_blocks_top) - { - if (!all_blocks) - { - all_blocks_size = 2048; - all_blocks = (block_t **)malloc(all_blocks_size * sizeof(block_t *)); - } - else - { - all_blocks_size *= 2; - all_blocks = (block_t **)realloc(all_blocks, all_blocks_size * sizeof(block_t *)); - } - } - all_blocks[all_blocks_top++] = b; -} -#endif - -static void init_block_lists(void) -{ - int32_t i; - for (i = 0; i < NUM_BLOCK_LISTS; i++) - block_lists[i] = NULL; -} - -/* clear_block_lists (in (gc)?) can free the data blocks and put all blocks on block_list[BLOCK_LIST], - * but the blocks themselves can't be freed (they're allocated by malloc in arbitrary batches, and - * the malloc pointer block is not currently recognizable). - */ - -static inline void liberate(block_t *p) -{ - if (block_index(p) != TOP_BLOCK_LIST) - { - block_next(p) = (struct block_t *)block_lists[block_index(p)]; - block_lists[block_index(p)] = p; - } - else - { - if (block_data(p)) {free(block_data(p)); block_data(p) = NULL;} - block_set_index(p, BLOCK_LIST); - block_next(p) = (struct block_t *)block_lists[block_index(p)]; - block_lists[block_index(p)] = p; - } -} - -static inline void liberate_block(block_t *p) -{ - block_next(p) = (struct block_t *)block_lists[BLOCK_LIST]; - block_lists[BLOCK_LIST] = p; -} - -static void fill_block_list(void) -{ - int32_t i; - block_t *b; - #define BLOCK_MALLOC_SIZE 256 - b = (block_t *)malloc(BLOCK_MALLOC_SIZE * sizeof(block_t)); /* batch alloc means blocks in this batch can't be freed, only returned to the list */ - block_lists[BLOCK_LIST] = b; - for (i = 0; i < BLOCK_MALLOC_SIZE - 1; i++) - { -#if TRACK_BLOCKS - record_block(b); -#endif - block_next(b) = (block_t *)(b + 1); - block_set_index(b, BLOCK_LIST); - b++; - } -#if TRACK_BLOCKS - record_block(b); -#endif - block_next(b) = NULL; - block_set_index(b, BLOCK_LIST); -} - -static inline block_t *mallocate_block(void) -{ - block_t *p; - if (!block_lists[BLOCK_LIST]) - fill_block_list(); /* this is much faster than allocating blocks as needed */ - p = block_lists[BLOCK_LIST]; - block_lists[BLOCK_LIST] = (block_t *)(block_next(p)); - block_next(p) = NULL; - block_index(p) = BLOCK_LIST; - return(p); -} - -static char *alloc_permanent_string(size_t len) -{ - #define ALLOC_STRING_SIZE 32768 - #define ALLOC_MAX_STRING 256 - static size_t alloc_string_k = ALLOC_STRING_SIZE; - static char *alloc_string_cells = NULL; - char *result; - size_t next_k; - - len = (len + 7) & (~7); /* 8-byte aligned -- more than half the time, len is already 8-byte aligned */ - next_k = alloc_string_k + len; - if (next_k >= ALLOC_STRING_SIZE) - { - if (len >= ALLOC_MAX_STRING) - return((char *)malloc(len)); - alloc_string_cells = (char *)malloc(ALLOC_STRING_SIZE); - alloc_string_k = 0; - next_k = len; - } - result = &alloc_string_cells[alloc_string_k]; - alloc_string_k = next_k; - return(result); -} - -static block_t *mallocate(size_t bytes) -{ - block_t *p; - if (bytes > 0) - { - int32_t index; - if (bytes <= 8) - index = 3; - else - { - if (bytes <= 256) - index = bits[bytes - 1]; - else - { - if (bytes <= 65536) - index = 8 + bits[(bytes - 1) >> 8]; - else index = TOP_BLOCK_LIST; /* expansion to (1 << 17) made no difference */ - } - } - p = block_lists[index]; - if (p) - { - block_lists[index] = (block_t *)block_next(p); - block_next(p) = NULL; - } - else - { - p = mallocate_block(); - block_data(p) = (void *)alloc_permanent_string((index < TOP_BLOCK_LIST) ? (size_t)(1 << index) : bytes); - block_set_index(p, index); - } - } - else p = mallocate_block(); - block_set_size(p, bytes); - return(p); -} - -static void memclr(void *s, size_t n) -{ - uint8_t *s2; -#if S7_ALIGNED - s2 = (uint8_t *)s; -#else -#if (defined(__x86_64__) || defined(__i386__)) - if (n >= 8) - { - int64_t *s1 = (int64_t *)s; - size_t n8 = n >> 3; - do {*s1++ = 0;} while (--n8 > 0); - n &= 7; - s2 = (uint8_t *)s1; - } - else s2 = (uint8_t *)s; -#else - s2 = (uint8_t *)s; -#endif -#endif - while (n > 0) - { - *s2++ = 0; - n--; - } -} - -#define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0) - -#if POINTER_32 -#define memclr64 memclr -#else -#if WITH_VECTORIZE -static void memclr64(void *p, size_t bytes) __attribute__((optimize("tree-vectorize"))); -#endif - -static void memclr64(void *p, size_t bytes) -{ - size_t i, n; - int64_t *vals; - vals = (int64_t *)p; - n = bytes >> 3; - for (i = 0; i < n; ) - LOOP_8(vals[i++] = 0); -} -#endif - -static block_t *callocate(size_t bytes) -{ - block_t *p; - p = mallocate(bytes); - if ((block_data(p)) && (block_index(p) != BLOCK_LIST)) - { - if (block_index(p) >= 6) - memclr64((void *)block_data(p), bytes); - else memclr((void *)(block_data(p)), bytes); - } - return(p); -} - -static block_t *reallocate(block_t *op, size_t bytes) -{ - block_t *np; - np = mallocate(bytes); - if (block_data(op)) /* presumably block_data(np) is not null */ - memcpy((uint8_t *)(block_data(np)), (uint8_t *)(block_data(op)), block_size(op)); - liberate(op); - return(np); -} +typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE, TOKEN_BACK_QUOTE, + TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST, TOKEN_VECTOR, TOKEN_BYTE_VECTOR, TOKEN_INT_VECTOR, TOKEN_FLOAT_VECTOR} token_t; -/* -------------------------------- */ +typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t; typedef struct { bool needs_free, needs_unprotect, is_closed; @@ -862,24 +632,33 @@ typedef s7_int (*hash_map_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); typedef hash_entry_t *(*hash_check_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); /* hash-table object equality function */ static hash_map_t default_hash_map[NUM_TYPES]; -typedef s7_int (*s7_i_pi_t)(s7_pointer p, s7_int i1); -typedef s7_int (*s7_i_pii_t)(s7_pointer p, s7_int i1, s7_int i2); + +/* -------------------------------- */ +typedef s7_int (*s7_i_7pi_t)(s7_scheme *sc, s7_pointer p, s7_int i1); +typedef s7_int (*s7_i_7pii_t)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2); typedef s7_int (*s7_i_iii_t)(s7_int i1, s7_int i2, s7_int i3); -typedef s7_pointer (*s7_p_p_t)(s7_pointer p); -typedef s7_pointer (*s7_p_t)(void); +typedef s7_int (*s7_i_7i_t)(s7_scheme *sc, s7_int i1); +typedef s7_int (*s7_i_7ii_t)(s7_scheme *sc, s7_int i1, s7_int i2); typedef bool (*s7_b_pp_t)(s7_pointer p1, s7_pointer p2); -typedef bool (*s7_b_pi_t)(s7_pointer p1, s7_int i2); +typedef bool (*s7_b_7pp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2); +typedef bool (*s7_b_7p_t)(s7_scheme *sc, s7_pointer p1); +typedef bool (*s7_b_pi_t)(s7_scheme *sc, s7_pointer p1, s7_int i2); typedef bool (*s7_b_d_t)(s7_double p1); typedef bool (*s7_b_i_t)(s7_int p1); typedef bool (*s7_b_ii_t)(s7_int p1, s7_int p2); typedef bool (*s7_b_dd_t)(s7_double p1, s7_double p2); -typedef s7_pointer (*s7_p_pp_t)(s7_pointer p1, s7_pointer p2); -typedef s7_pointer (*s7_p_ppi_t)(s7_pointer p1, s7_pointer p2, s7_int i1); -typedef s7_pointer (*s7_p_ppp_t)(s7_pointer p1, s7_pointer p2, s7_pointer p3); -typedef s7_pointer (*s7_p_pi_t)(s7_pointer p1, s7_int i1); -typedef s7_pointer (*s7_p_pip_t)(s7_pointer p1, s7_int i1, s7_pointer p2); -typedef s7_pointer (*s7_p_ii_t)(s7_int i1, s7_int i2); -typedef s7_pointer (*s7_p_dd_t)(s7_double x1, s7_double x2); +typedef s7_pointer (*s7_p_p_t)(s7_scheme *sc, s7_pointer p); +typedef s7_pointer (*s7_p_t)(s7_scheme *sc); +typedef s7_pointer (*s7_p_pp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2); +typedef s7_pointer (*s7_p_ppi_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1); +typedef s7_pointer (*s7_p_ppp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3); +typedef s7_pointer (*s7_p_pi_t)(s7_scheme *sc, s7_pointer p1, s7_int i1); +typedef s7_pointer (*s7_p_pip_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2); +typedef s7_pointer (*s7_p_ii_t)(s7_scheme *sc, s7_int i1, s7_int i2); +typedef s7_pointer (*s7_p_dd_t)(s7_scheme *sc, s7_double x1, s7_double x2); +typedef s7_double (*s7_d_7d_t)(s7_scheme *sc, s7_double p1); +typedef s7_double (*s7_d_7dd_t)(s7_scheme *sc, s7_double p1, s7_double p2); +typedef s7_double (*s7_d_7p_t)(s7_scheme *sc, s7_pointer p1); typedef union { s7_int i; @@ -889,7 +668,9 @@ typedef union { s7_function cf; s7_double (*d_f)(void); s7_double (*d_d_f)(s7_double x); + s7_double (*d_7d_f)(s7_scheme *sc, s7_double x); s7_double (*d_dd_f)(s7_double x1, s7_double x2); + s7_double (*d_7dd_f)(s7_scheme *sc, s7_double x1, s7_double x2); s7_double (*d_ddd_f)(s7_double x1, s7_double x2, s7_double x3); s7_double (*d_dddd_f)(s7_double x1, s7_double x2, s7_double x3, s7_double x4); s7_double (*d_v_f)(void *obj); @@ -897,52 +678,65 @@ typedef union { s7_double (*d_vdd_f)(void *obj, s7_double x1, s7_double x2); s7_double (*d_vid_f)(void *obj, s7_int i, s7_double fm); s7_double (*d_id_f)(s7_int i, s7_double fm); - s7_double (*d_pi_f)(s7_pointer obj, s7_int i1); + s7_double (*d_7pi_f)(s7_scheme *sc, s7_pointer obj, s7_int i1); s7_double (*d_ip_f)(s7_int i1, s7_pointer p); s7_double (*d_pd_f)(s7_pointer obj, s7_double x); - s7_double (*d_pid_f)(s7_pointer obj, s7_int i1, s7_double x); + s7_double (*d_7pid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_double x); s7_double (*d_p_f)(s7_pointer p); - s7_int (*i_d_f)(s7_double i1); + s7_double (*d_7p_f)(s7_scheme *sc, s7_pointer p); + s7_int (*i_7d_f)(s7_scheme *sc, s7_double i1); + s7_int (*i_7p_f)(s7_scheme *sc, s7_pointer i1); s7_int (*i_i_f)(s7_int i1); + s7_int (*i_7i_f)(s7_scheme *sc, s7_int i1); s7_int (*i_ii_f)(s7_int i1, s7_int i2); + s7_int (*i_7ii_f)(s7_scheme *sc, s7_int i1, s7_int i2); s7_int (*i_iii_f)(s7_int i1, s7_int i2, s7_int i3); - s7_int (*i_p_f)(s7_pointer p); - s7_int (*i_pi_f)(s7_pointer p, s7_int i1); - s7_int (*i_pii_f)(s7_pointer p, s7_int i1, s7_int i2); + s7_int (*i_7pi_f)(s7_scheme *sc, s7_pointer p, s7_int i1); + s7_int (*i_7pii_f)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2); bool (*b_i_f)(s7_int p); bool (*b_d_f)(s7_double p); bool (*b_p_f)(s7_pointer p); bool (*b_pp_f)(s7_pointer p1, s7_pointer p2); - bool (*b_pi_f)(s7_pointer p1, s7_int i2); + bool (*b_7pp_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2); + bool (*b_7p_f)(s7_scheme *sc, s7_pointer p1); + bool (*b_pi_f)(s7_scheme *sc, s7_pointer p1, s7_int i2); bool (*b_ii_f)(s7_int i1, s7_int i2); bool (*b_dd_f)(s7_double x1, s7_double x2); - s7_pointer (*p_f)(void); - s7_pointer (*p_p_f)(s7_pointer p); - s7_pointer (*p_pp_f)(s7_pointer p1, s7_pointer p2); - s7_pointer (*p_ppp_f)(s7_pointer p, s7_pointer p2, s7_pointer p3); - s7_pointer (*p_pi_f)(s7_pointer p1, s7_int i1); - s7_pointer (*p_ppi_f)(s7_pointer p1, s7_pointer p2, s7_int i1); - s7_pointer (*p_pip_f)(s7_pointer p1, s7_int i1, s7_pointer p2); - s7_pointer (*p_ii_f)(s7_int x1, s7_int x2); - s7_pointer (*p_dd_f)(s7_double x1, s7_double x2); - s7_pointer (*all_f)(s7_scheme *sc, s7_pointer expr); + s7_pointer (*p_f)(s7_scheme *sc); + s7_pointer (*p_p_f)(s7_scheme *sc, s7_pointer p); + s7_pointer (*p_pp_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2); + s7_pointer (*p_ppp_f)(s7_scheme *sc, s7_pointer p, s7_pointer p2, s7_pointer p3); + s7_pointer (*p_pi_f)(s7_scheme *sc, s7_pointer p1, s7_int i1); + s7_pointer (*p_ppi_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1); + s7_pointer (*p_pip_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2); + s7_pointer (*p_ii_f)(s7_scheme *sc, s7_int x1, s7_int x2); + s7_pointer (*p_dd_f)(s7_scheme *sc, s7_double x1, s7_double x2); s7_double (*fd)(void *o); s7_int (*fi)(void *o); bool (*fb)(void *o); s7_pointer (*fp)(void *o); } vunion; +#define NUM_VUNIONS 16 typedef struct { - vunion v1, v2, v3, v4, v5, v6, v7, v8, v9; + union { + int64_t vtype; + uint8_t vt[8]; + } typ; + s7_scheme *sc; + vunion v[NUM_VUNIONS]; #if S7_DEBUGGING - s7_pointer expr; + s7_pointer vexpr; + const char *func; + int32_t line; #endif } opt_info; -#define symbol_tag_t uint32_t /* syms_tag may need 64-bits -- seems ok at 32 bits so far (16 bits was too few) */ - /* -------------------------------- cell structure -------------------------------- */ + +#define symbol_tag_t uint32_t /* syms_tag may need 64-bits -- seems ok at 32 bits so far (16 bits was too few) */ + typedef struct s7_cell { union { uint64_t flag; /* type info */ @@ -976,10 +770,6 @@ typedef struct s7_cell { s7_double im; } complex_value; -#if (!DISABLE_DEPRECATED) - unsigned long ul_value; /* these two are not used by s7 in any way -- "unsigned long" for backwards compatibility */ - uint64_t ull_value; -#endif #if WITH_GMP mpz_t big_integer; /* bignums */ mpq_t big_ratio; @@ -1009,11 +799,7 @@ typedef struct s7_cell { struct { /* c-pointers */ void *c_pointer; - s7_pointer c_type, info; - /* if a gc_free function were included, the pointer could be freed (etc) via the GC-cache (sweep function), but then - * every possible explicit free function would need to warn the GC not to try to free the pointer. - * How to recognize an unfreed pointer at sweep time? - */ + s7_pointer c_type, info, weak1, weak2; } cptr; s7_int baffle_key; /* baffles */ @@ -1082,11 +868,7 @@ typedef struct s7_cell { } sym_cons; struct { /* scheme functions */ - s7_pointer args, body, env; /* args can be a symbol, as well as a list */ - union { - s7_pointer setter; - block_t *block; /* currently unused */ - } sb; + s7_pointer args, body, env, setter; /* args can be a symbol, as well as a list */ int32_t arity; } func; @@ -1234,10 +1016,6 @@ typedef struct { } gc_list; -static s7_pointer *chars; -static s7_pointer real_zero, real_NaN, real_pi, real_one, arity_not_set, max_arity, real_infinity, real_minus_infinity, minus_one, minus_two; - - struct s7_scheme { s7_pointer code; s7_pointer envir; /* curlet, layout of first 4 entries should match stack frame layout */ @@ -1277,7 +1055,6 @@ struct s7_scheme { s7_pointer nil; /* empty list */ s7_pointer T; /* #t */ s7_pointer F; /* #f */ - s7_pointer eof_object; /* #<eof> */ s7_pointer undefined; /* #<undefined> */ s7_pointer unspecified; /* #<unspecified> */ s7_pointer no_value; /* the (values) value */ @@ -1301,14 +1078,12 @@ struct s7_scheme { s7_pointer unbound_variable_hook; /* *unbound-variable-hook* hook object */ s7_pointer missing_close_paren_hook, rootlet_redefinition_hook; s7_pointer error_hook, read_error_hook; /* *error-hook* hook object, and *read-error-hook* */ - bool gc_off; /* gc_off: if true, the GC won't run */ - uint32_t gc_stats; - uint32_t gensym_counter, f_class, add_class, multiply_class, subtract_class, equal_class; + uint32_t gc_stats, gensym_counter, f_class, add_class, multiply_class, subtract_class, equal_class; int32_t format_column; uint64_t capture_let_counter; bool short_print, is_autoloading, in_with_let, object_out_locked; - int64_t let_number; + int64_t let_number, not_heap; s7_double default_rationalize_error, morally_equal_float_epsilon, hash_table_float_epsilon; s7_int default_hash_table_length, initial_string_port_length, print_length, objstr_max_len, history_size, true_history_size; s7_int max_vector_length, max_string_length, max_list_length, max_vector_dimensions, max_format_length; @@ -1317,8 +1092,7 @@ struct s7_scheme { vdims_t *wrap_only; char *typnam; - int32_t typnam_len; - int32_t print_width; + int32_t typnam_len, print_width; s7_pointer *singletons; block_t *unentry; /* hash-table lookup failure indicator */ @@ -1334,7 +1108,7 @@ struct s7_scheme { s7_int read_line_buf_size; s7_pointer v, w, x, y, z; /* evaluator local vars */ - s7_pointer temp1, temp2, temp3, temp4, temp6, temp7, temp8, temp9, temp10; + s7_pointer temp1, temp2, temp3, temp4, temp6, temp7, temp8, temp9, temp10, temp11; s7_pointer temp_cell, temp_cell_1, temp_cell_2, u1_1; s7_pointer t1_1, t2_1, t2_2, t3_1, t3_2, t3_3, z2_1, z2_2; s7_pointer a1_1, a2_1, a2_2, a3_1, a3_2, a3_3, a4_1, a4_2, a4_3, a4_4; @@ -1347,32 +1121,55 @@ struct s7_scheme { int32_t setjmp_loc; void (*begin_hook)(s7_scheme *sc, bool *val); + opcode_t begin_op; s7_int current_line, s7_call_line, safety; const char *current_file, *s7_call_file, *s7_call_name; shared_info *circle_info; format_data **fdats; - int32_t num_fdats; - s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_3, qlist_2; - gc_list *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables, *gensyms, *unknowns, *lambdas, *multivectors; + int32_t num_fdats, last_error_line; + s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_2_2, plist_3, qlist_2, clist_1; + gc_list *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables, *gensyms, *unknowns, *lambdas, *multivectors, *optlists, *weak_refs; s7_pointer *setters; s7_int setters_size, setters_loc; + s7_pointer *tree_pointers; + int32_t tree_pointers_size, tree_pointers_top, permanent_cells, string_wrapper_pos, num_to_str_size; + s7_pointer format_ports; + uint32_t alloc_pointer_k, alloc_function_k, alloc_symbol_k; + s7_cell *alloc_pointer_cells; + c_proc_t *alloc_function_cells; + s7_pointer *string_wrappers; + uint8_t *alloc_symbol_cells; + char *num_to_str; + + block_t *block_lists[NUM_BLOCK_LISTS]; + size_t alloc_string_k; + char *alloc_string_cells; c_object_t **c_object_types; - int32_t c_object_types_size; - int32_t num_c_object_types; + int32_t c_object_types_size, num_c_object_types; + s7_pointer type_to_typers[NUM_TYPES]; symbol_tag_t syms_tag; int32_t bignum_precision; s7_int baffle_ctr; s7_pointer default_rng; + s7_function sort_func; + s7_pointer sort_args, sort_begin, sort_v1, sort_v2; + opcode_t sort_op; + s7_int sort_body_len; + + #define INT_TO_STR_SIZE 32 + char int_to_str1[INT_TO_STR_SIZE], int_to_str2[INT_TO_STR_SIZE], int_to_str3[INT_TO_STR_SIZE], int_to_str4[INT_TO_STR_SIZE], int_to_str5[INT_TO_STR_SIZE]; + s7_pointer abs_symbol, acos_symbol, acosh_symbol, add_symbol, angle_symbol, append_symbol, apply_symbol, apply_values_symbol, arity_symbol, ash_symbol, asin_symbol, asinh_symbol, assoc_symbol, assq_symbol, assv_symbol, atan_symbol, atanh_symbol, autoload_symbol, autoloader_symbol, byte_vector_symbol, byte_vector_ref_symbol, byte_vector_set_symbol, byte_vector_to_string_symbol, - c_pointer_symbol, c_pointer_to_list_symbol, caaaar_symbol, caaadr_symbol, caaar_symbol, caadar_symbol, caaddr_symbol, caadr_symbol, + c_pointer_symbol, c_pointer_info_symbol, c_pointer_to_list_symbol, c_pointer_type_symbol, c_pointer_weak1_symbol, c_pointer_weak2_symbol, + caaaar_symbol, caaadr_symbol, caaar_symbol, caadar_symbol, caaddr_symbol, caadr_symbol, caar_symbol, cadaar_symbol, cadadr_symbol, cadar_symbol, caddar_symbol, cadddr_symbol, caddr_symbol, cadr_symbol, call_cc_symbol, call_with_current_continuation_symbol, call_with_exit_symbol, call_with_input_file_symbol, call_with_input_string_symbol, call_with_output_file_symbol, call_with_output_string_symbol, car_symbol, @@ -1398,15 +1195,16 @@ struct s7_scheme { is_keyword_symbol, is_let_symbol, is_list_symbol, is_macro_symbol, is_morally_equal_symbol, is_nan_symbol, is_negative_symbol, is_null_symbol, is_number_symbol, is_odd_symbol, is_openlet_symbol, is_output_port_symbol, is_pair_symbol, is_port_closed_symbol, is_positive_symbol, is_procedure_symbol, is_proper_list_symbol, is_provided_symbol, - is_random_state_symbol, is_rational_symbol, is_real_symbol, is_sequence_symbol, is_string_symbol, is_symbol_symbol, is_syntax_symbol, - is_vector_symbol, is_zero_symbol, iterate_symbol, iterator_is_at_end_symbol, iterator_sequence_symbol, + is_random_state_symbol, is_rational_symbol, is_real_symbol, is_sequence_symbol, is_string_symbol, is_subvector_symbol, + is_symbol_symbol, is_syntax_symbol, is_vector_symbol, is_weak_hash_table_symbol, is_zero_symbol, + iterate_symbol, iterator_is_at_end_symbol, iterator_sequence_symbol, is_float_symbol, is_integer_or_real_at_end_symbol, is_integer_or_any_at_end_symbol, is_unspecified_symbol, is_undefined_symbol, keyword_to_symbol_symbol, lcm_symbol, length_symbol, leq_symbol, let_ref_fallback_symbol, let_ref_symbol, let_set_fallback_symbol, let_set_symbol, let_temporarily_symbol, list_ref_symbol, list_set_symbol, list_symbol, list_tail_symbol, list_values_symbol, load_path_symbol, load_symbol, log_symbol, logand_symbol, logbit_symbol, logior_symbol, lognot_symbol, logxor_symbol, lt_symbol, - magnitude_symbol, make_byte_vector_symbol, make_float_vector_symbol, make_hash_table_symbol, make_int_vector_symbol, - make_iterator_symbol, string_to_keyword_symbol, make_list_symbol, make_shared_vector_symbol, make_string_symbol, + magnitude_symbol, make_byte_vector_symbol, make_float_vector_symbol, make_hash_table_symbol, make_weak_hash_table_symbol, + make_int_vector_symbol, make_iterator_symbol, string_to_keyword_symbol, make_list_symbol, make_string_symbol, make_vector_symbol, map_symbol, max_symbol, member_symbol, memq_symbol, memv_symbol, min_symbol, modulo_symbol, multiply_symbol, newline_symbol, not_symbol, number_to_string_symbol, numerator_symbol, object_to_string_symbol, object_to_let_symbol, open_input_file_symbol, open_input_string_symbol, open_output_file_symbol, @@ -1423,7 +1221,8 @@ struct s7_scheme { stacktrace_symbol, string_append_symbol, string_downcase_symbol, string_eq_symbol, string_fill_symbol, string_geq_symbol, string_gt_symbol, string_leq_symbol, string_lt_symbol, string_position_symbol, string_ref_symbol, string_set_symbol, string_symbol, string_to_number_symbol, string_to_symbol_symbol, string_upcase_symbol, - sublet_symbol, substring_symbol, subtract_symbol, symbol_setter_symbol, symbol_symbol, symbol_to_dynamic_value_symbol, + sublet_symbol, substring_symbol, subtract_symbol, subvector_symbol, subvector_position_symbol, subvector_vector_symbol, + symbol_symbol, symbol_to_dynamic_value_symbol, symbol_to_keyword_symbol, symbol_to_string_symbol, symbol_to_value_symbol, s7_version_symbol, tan_symbol, tanh_symbol, throw_symbol, string_to_byte_vector_symbol, tree_count_symbol, tree_leaves_symbol, tree_memq_symbol, tree_set_memq_symbol, tree_is_cyclic_symbol, truncate_symbol, type_of_symbol, @@ -1465,11 +1264,40 @@ struct s7_scheme { s7_pointer string_signature, vector_signature, float_vector_signature, int_vector_signature, byte_vector_signature, c_object_signature, let_signature, hash_table_signature, pair_signature, iterator_signature; + s7_pointer pcl_bc, pcl_bs, pcl_bt, pcl_c, pcl_e, pcl_f, pcl_i, pcl_n, pcl_r, pcl_s, pcl_v, pl_bc, pl_bn, pl_bt, pl_p, pl_sf, pl_tl; + + /* optimizer s7_functions */ + s7_pointer add_2, add_1s, add_s1, add_cs1, add_si, add_sf, add_fs, add_f_sf, subtract_1, subtract_2, subtract_s1, + subtract_cs1, subtract_csn, subtract_sf, subtract_2f, subtract_fs, simple_char_eq, char_equal_s_ic, + char_equal_2, char_greater_2, char_less_2, char_position_csi, string_equal_2, substring_to_temp, + string_greater_2, string_less_2, symbol_to_string_uncopied, vector_ref_ic, vector_ref_ic_0, vector_ref_ic_1, + vector_ref_ic_2, vector_ref_ic_3, vector_ref_2, vector_ref_2_direct, vector_set_ic, vector_set_3, fv_ref, + fv_ref_3, fv_set, fv_set_unchecked, iv_ref, iv_set, list_set_ic, hash_table_ref_2, hash_table_ref_ss, + hash_table_ref_car, format_allg, format_allg_no_column, format_just_control_string, format_as_objstr, + not_is_pair_s, not_is_null_s, not_is_symbol_s, not_is_number_s, not_is_eq_ss, not_is_eq_sq, not_is_pair_car_s, + not_c_c, is_pair_car_s, is_pair_cdr_s, is_pair_cddr_s, is_pair_cadr_s, is_null_cdr, is_null_cddr_s, + is_null_cadr_s, is_symbol_cadr_s, is_eq_car, is_eq_car_q, is_eq_caar_q, member_ss, member_sq, memq_2, + memq_3, memq_4, memq_any, memq_car, memq_car_2, tree_set_memq_syms, read_line_uncopied, simple_inlet, + lint_let_ref, lint_let_set, or_n, or_2, or_3, and_n, and_2, and_3, and_sc, if_x1, if_x2, if_not_x1, + if_not_x2, if_x_qq, if_x_qa, or_s_direct, and_s_direct, geq_2, or_s_direct_2, and_s_direct_2, or_s_type_2; +#if (!WITH_GMP) + s7_pointer multiply_2, multiply_is, multiply_si, multiply_fs, multiply_sf, sqr_ss, invert_1, divide_1r, mod_si, equal_s_ic, + equal_length_ic, equal_2, equal_2i, less_s_ic, less_s0, less_2, less_length_ic, greater_s_ic, greater_s_fc, greater_2, + leq_s_ic, leq_2, geq_s_ic, geq_s_fc, random_ic, random_rc; +#endif #if WITH_GMP s7_pointer bignum_symbol, is_bignum_symbol; gc_list *bigints, *bigratios, *bigreals, *bignumbers; #endif + /* object->let symbols */ +#if (!WITH_GMP) + s7_pointer seed_symbol, carry_symbol; +#endif + s7_pointer active_symbol, goto_symbol, data_symbol, weak_symbol, dimensions_symbol, info_symbol, c_type_symbol, source_symbol, c_object_ref_symbol, + at_end_symbol, sequence_symbol, position_symbol, entries_symbol, locked_symbol, function_symbol, open_symbol, alias_symbol,port_type_symbol, + file_symbol, line_symbol, c_object_type_symbol, c_object_let_symbol, class_symbol, c_object_length_symbol, c_object_set_symbol, + c_object_copy_symbol, c_object_fill_symbol, c_object_reverse_symbol, c_object_to_list_symbol, c_object_to_string_symbol, closed_symbol; #if WITH_SYSTEM_EXTRAS s7_pointer is_directory_symbol, file_exists_symbol, delete_file_symbol, getenv_symbol, system_symbol, directory_to_list_symbol, file_mtime_symbol; @@ -1480,7 +1308,9 @@ struct s7_scheme { apply_values_function, apply_function, vector_function, last_function, byte_vector_set_function; s7_pointer wrong_type_arg_info, out_of_range_info, simple_wrong_type_arg_info, simple_out_of_range_info; - s7_pointer too_many_arguments_string, not_enough_arguments_string, division_by_zero_error_string, missing_method_string; + s7_pointer integer_wrapper1, integer_wrapper2, integer_wrapper3; + s7_pointer real_wrapper1, real_wrapper2, real_wrapper3, real_wrapper4; + #define NUM_SAFE_LISTS 64 s7_pointer safe_lists[NUM_SAFE_LISTS]; int32_t current_safe_list; @@ -1497,10 +1327,247 @@ struct s7_scheme { jmp_buf opt_exit; int32_t pc; - #define OPTS_SIZE 256 /* 128 overflows twice in s7test, 64 overflows 4 times in s7test, once in tall, pqw-vox needs 173 */ - opt_info *opts[OPTS_SIZE+1]; /* this form is a lot faster than opt_info**! */ + bool opt_has_local_let; + #define OPTS_SIZE 256 /* 128 overflows twice in s7test, 64 overflows 4 times in s7test, once in tall, pqw-vox needs 173 */ + opt_info *opts[OPTS_SIZE + 1]; /* this form is a lot faster than opt_info**! */ + opt_info *base_opts; }; + +/* -------------------------------- mallocate -------------------------------- */ + +static const int32_t bits[256] = + {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}; + +static void memclr(void *s, size_t n) +{ + uint8_t *s2; +#if S7_ALIGNED + s2 = (uint8_t *)s; +#else +#if (defined(__x86_64__) || defined(__i386__)) + if (n >= 8) + { + int64_t *s1 = (int64_t *)s; + size_t n8 = n >> 3; + do {*s1++ = 0;} while (--n8 > 0); + n &= 7; + s2 = (uint8_t *)s1; + } + else s2 = (uint8_t *)s; +#else + s2 = (uint8_t *)s; +#endif +#endif + while (n > 0) + { + *s2++ = 0; + n--; + } +} + +#define LOOP_4(Code) do {Code; Code; Code; Code;} while (0) +#define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0) + +#if POINTER_32 +#define memclr64 memclr +#else +#if WITH_VECTORIZE +static void memclr64(void *p, size_t bytes) __attribute__((optimize("tree-vectorize"))); +#endif + +static void memclr64(void *p, size_t bytes) +{ + size_t i, n; + int64_t *vals; + vals = (int64_t *)p; + n = bytes >> 3; + for (i = 0; i < n; ) + LOOP_8(vals[i++] = 0); +} +#endif + +static void init_block_lists(s7_scheme *sc) +{ + int32_t i; + for (i = 0; i < NUM_BLOCK_LISTS; i++) + sc->block_lists[i] = NULL; +} + +/* clear_block_lists (in (gc)?) can free the data blocks and put all blocks on block_list[BLOCK_LIST], + * but the blocks themselves can't be freed (they're allocated by malloc in arbitrary batches, and + * the malloc pointer block is not currently recognizable). + */ + +static inline void liberate(s7_scheme *sc, block_t *p) +{ +#if S7_DEBUGGING + block_frees(p)++; + if (block_allocs(p) != block_frees(p)) + fprintf(stderr, "%s: allocs: %d, frees: %d\n", __func__, block_allocs(p), block_frees(p)); +#endif + if (block_index(p) != TOP_BLOCK_LIST) + { + block_next(p) = (struct block_t *)sc->block_lists[block_index(p)]; + sc->block_lists[block_index(p)] = p; + } + else + { + if (block_data(p)) {free(block_data(p)); block_data(p) = NULL;} + block_set_index(p, BLOCK_LIST); + block_next(p) = (struct block_t *)sc->block_lists[block_index(p)]; + sc->block_lists[block_index(p)] = p; + } +} + +static inline void liberate_block(s7_scheme *sc, block_t *p) +{ +#if S7_DEBUGGING + block_frees(p)++; + if (block_allocs(p) != block_frees(p)) + fprintf(stderr, "%s: allocs: %d, frees: %d\n", __func__, block_allocs(p), block_frees(p)); +#endif + block_next(p) = (struct block_t *)sc->block_lists[BLOCK_LIST]; + sc->block_lists[BLOCK_LIST] = p; +} + +static void fill_block_list(s7_scheme *sc) +{ + int32_t i; + block_t *b; + #define BLOCK_MALLOC_SIZE 256 + b = (block_t *)malloc(BLOCK_MALLOC_SIZE * sizeof(block_t)); /* batch alloc means blocks in this batch can't be freed, only returned to the list */ + sc->block_lists[BLOCK_LIST] = b; + for (i = 0; i < BLOCK_MALLOC_SIZE - 1; i++) + { + block_next(b) = (block_t *)(b + 1); + block_set_index(b, BLOCK_LIST); +#if S7_DEBUGGING + block_frees(b) = 0; + block_allocs(b) = 0; +#endif + b++; + } + block_next(b) = NULL; + block_set_index(b, BLOCK_LIST); +#if S7_DEBUGGING + block_frees(b) = 0; + block_allocs(b) = 0; +#endif +} + +static inline block_t *mallocate_block(s7_scheme *sc) +{ + block_t *p; + if (!sc->block_lists[BLOCK_LIST]) + fill_block_list(sc); /* this is much faster than allocating blocks as needed */ + p = sc->block_lists[BLOCK_LIST]; + sc->block_lists[BLOCK_LIST] = (block_t *)(block_next(p)); + block_next(p) = NULL; + block_index(p) = BLOCK_LIST; +#if S7_DEBUGGING + if (block_allocs(p) != block_frees(p)) + fprintf(stderr, "%s: allocs: %d, frees: %d\n", __func__, block_allocs(p), block_frees(p)); + block_allocs(p)++; +#endif + return(p); +} + +static inline char *alloc_permanent_string(s7_scheme *sc, size_t len) +{ + #define ALLOC_STRING_SIZE 32768 + #define ALLOC_MAX_STRING 256 + char *result; + size_t next_k; + + len = (len + 7) & (~7); /* 8-byte aligned -- more than half the time, len is already 8-byte aligned */ + next_k = sc->alloc_string_k + len; + if (next_k >= ALLOC_STRING_SIZE) + { + if (len >= ALLOC_MAX_STRING) + return((char *)malloc(len)); + sc->alloc_string_cells = (char *)malloc(ALLOC_STRING_SIZE); + sc->alloc_string_k = 0; + next_k = len; + } + result = &(sc->alloc_string_cells[sc->alloc_string_k]); + sc->alloc_string_k = next_k; + return(result); +} + +static inline block_t *mallocate(s7_scheme *sc, size_t bytes) +{ + block_t *p; + if (bytes > 0) + { + int32_t index; + if (bytes <= 8) + index = 3; + else + { + if (bytes <= 256) + index = bits[bytes - 1]; + else + { + if (bytes <= 65536) + index = 8 + bits[(bytes - 1) >> 8]; + else index = TOP_BLOCK_LIST; /* expansion to (1 << 17) made no difference */ + } + } + p = sc->block_lists[index]; + if (p) + { + sc->block_lists[index] = (block_t *)block_next(p); + block_next(p) = NULL; +#if S7_DEBUGGING + if (block_allocs(p) != block_frees(p)) + fprintf(stderr, "%s: allocs: %d, frees: %d\n", __func__, block_allocs(p), block_frees(p)); + block_allocs(p)++; +#endif + } + else + { + p = mallocate_block(sc); + block_data(p) = (void *)alloc_permanent_string(sc, (index < TOP_BLOCK_LIST) ? (size_t)(1 << index) : bytes); + block_set_index(p, index); + } + } + else p = mallocate_block(sc); + block_set_size(p, bytes); + return(p); +} + +static block_t *callocate(s7_scheme *sc, size_t bytes) +{ + block_t *p; + p = mallocate(sc, bytes); + if ((block_data(p)) && (block_index(p) != BLOCK_LIST)) + { + if (block_index(p) >= 6) + memclr64((void *)block_data(p), bytes); + else memclr((void *)(block_data(p)), bytes); + } + return(p); +} + +static block_t *reallocate(s7_scheme *sc, block_t *op, size_t bytes) +{ + block_t *np; + np = mallocate(sc, bytes); + if (block_data(op)) /* presumably block_data(np) is not null */ + memcpy((uint8_t *)(block_data(np)), (uint8_t *)(block_data(op)), block_size(op)); + liberate(sc, op); + return(np); +} +/* -------------------------------------------------------------------------------- */ + /* (*s7* 'safety) settings */ #define NO_SAFETY 0 #define IMMUTABLE_VECTOR_SAFETY 1 @@ -1511,6 +1578,19 @@ typedef enum {P_DISPLAY, P_WRITE, P_READABLE, P_KEY} use_write_t; static s7_pointer prepackaged_type_names[NUM_TYPES]; +static s7_pointer too_many_arguments_string, not_enough_arguments_string, missing_method_string, + a_boolean_string, a_byte_vector_string, a_format_port_string, a_let_string, a_list_string, a_non_constant_symbol_string, + a_non_negative_integer_string, a_normal_procedure_string, a_normal_real_string, a_number_string, a_procedure_string, + a_proper_list_string, a_random_state_object_string, a_rational_string, a_sequence_string, a_symbol_string, a_thunk_string, + a_valid_radix_string, an_association_list_string, an_eq_func_string, an_input_file_port_string, an_input_port_string, + an_input_string_port_string, an_open_port_string, an_output_file_port_string, an_output_port_string, an_output_string_port_string, + an_unsigned_byte_string, caaar_a_list_string, caadr_a_list_string, caar_a_list_string, cadar_a_list_string, caddr_a_list_string, + cadr_a_list_string, car_a_list_string, cdaar_a_list_string, cdadr_a_list_string, cdar_a_list_string, cddar_a_list_string, + cdddr_a_list_string, cddr_a_list_string, cdr_a_list_string, immutable_error_string, its_infinite_string, its_nan_string, + its_negative_string, its_too_large_string, its_too_small_string, parameter_set_twice_string, result_is_too_large_string, + something_applicable_string, too_many_indices_string, value_is_missing_string, + format_string_1, format_string_2, format_string_3, format_string_4; + static bool t_number_p[NUM_TYPES], t_real_p[NUM_TYPES], t_rational_p[NUM_TYPES], t_big_number_p[NUM_TYPES]; static bool t_simple_p[NUM_TYPES], t_structure_p[NUM_TYPES]; static bool t_any_macro_p[NUM_TYPES], t_any_closure_p[NUM_TYPES], t_has_closure_let[NUM_TYPES]; @@ -1702,8 +1782,6 @@ static void init_types(void) #define typeflag(p) ((p)->tf.flag) #define typesflag(p) ((p)->tf.sflag) -static s7_scheme *cur_sc = NULL; - #if S7_DEBUGGING static const char *check_name(int32_t typ); static s7_pointer check_ref(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2); @@ -1723,8 +1801,8 @@ static s7_scheme *cur_sc = NULL; static s7_pointer opt1_1(s7_pointer p, uint32_t role, const char *func, int32_t line); static s7_pointer set_opt1_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line); - static s7_pointer opt2_1(s7_pointer p, uint32_t role, const char *func, int32_t line); - static void set_opt2_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line); + static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, uint32_t role, const char *func, int32_t line); + static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line); static s7_pointer opt3_1(s7_pointer p, uint32_t role, const char *func, int32_t line); static void set_opt3_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line); @@ -1734,7 +1812,7 @@ static s7_scheme *cur_sc = NULL; static void set_s_name_1(s7_pointer p, const char *str, const char *func, int32_t line); static uint32_t s_line_1(s7_pointer p, const char *func, int32_t line); static void set_s_line_1(s7_pointer p, uint32_t x, const char *func, int32_t line); - static void set_s_file_1(s7_pointer p, uint32_t x, const char *func, int32_t line); + static void set_s_file_1(s7_scheme *sc, s7_pointer p, uint32_t x, const char *func, int32_t line); static uint32_t s_len_1(s7_pointer p, const char *func, int32_t line); static void set_s_len_1(s7_pointer p, uint32_t x, const char *func, int32_t line); #define unchecked_type(p) ((p)->tf.type_field) @@ -1911,12 +1989,6 @@ static s7_scheme *cur_sc = NULL; /* the layout of these bits does matter in several cases -- don't shadow SYNTACTIC_PAIR and OPTIMIZED_PAIR */ #define TYPE_BITS 8 -#define T_KEYWORD (1 << (TYPE_BITS + 0)) -#define is_keyword(p) ((typesflag(T_Pos(p)) & T_KEYWORD) != 0) -/* this bit distinguishes a symbol from a symbol that is also a keyword - * this should be ok in the second byte because keywords are constants in s7 (never syntax) - */ - #define T_SYNTACTIC (1 << (TYPE_BITS + 1)) #define is_syntactic(p) ((typesflag(T_Pos(p)) & T_SYNTACTIC) != 0) #define is_syntactic_symbol(p) (typesflag(T_Pos(p)) == (uint16_t)(T_SYMBOL | T_SYNTACTIC)) @@ -1925,9 +1997,9 @@ static s7_scheme *cur_sc = NULL; #define T_SIMPLE_ARG_DEFAULTS (1 << (TYPE_BITS + 2)) -#define has_simple_arg_defaults(p) ((typeflag(T_Pair(p)) & T_SIMPLE_ARG_DEFAULTS) != 0) -#define set_simple_arg_defaults(p) typeflag(T_Pair(p)) |= T_SIMPLE_ARG_DEFAULTS -/* are all lambda* default values simple? */ +#define lambda_has_simple_defaults(p) ((typeflag(T_Pair(p)) & T_SIMPLE_ARG_DEFAULTS) != 0) +#define lambda_set_simple_defaults(p) typeflag(T_Pair(p)) |= T_SIMPLE_ARG_DEFAULTS +/* are all lambda* default values simple? This is set on closure_body, so it doesn't mess up closure_is_ok_1 */ #define T_LIST_IN_USE T_SIMPLE_ARG_DEFAULTS #define list_is_in_use(p) ((typeflag(T_Pair(p)) & T_LIST_IN_USE) != 0) @@ -1935,6 +2007,12 @@ static s7_scheme *cur_sc = NULL; #define clear_list_in_use(p) typeflag(T_Pair(p)) &= (~T_LIST_IN_USE) /* these could all be one permanent list, indexed from inside, and this bit is never actually protecting anything across a call */ +#define T_ONE_FORM T_SIMPLE_ARG_DEFAULTS +#define set_closure_has_one_form(p) typeflag(T_Clo(p)) |= T_ONE_FORM +#define T_MULTIFORM (1 << (TYPE_BITS + 0)) +#define set_closure_has_multiform(p) typeflag(T_Clo(p)) |= T_MULTIFORM +#define set_closure_has_all_x(p) typeflag(T_Clo(p)) |= (T_ONE_FORM | T_MULTIFORM) +/* temporary extra bit (simplify development...) */ #define T_OPTIMIZED (1 << (TYPE_BITS + 3)) #define set_optimized(p) typesflag(T_Pair(p)) |= T_OPTIMIZED @@ -1954,7 +2032,7 @@ static s7_scheme *cur_sc = NULL; #define clear_safe_closure(p) typesflag(p) &= (~T_SAFE_CLOSURE) /* optimizer flag for a closure body that is completely simple (every expression is safe) * set_safe_closure happens only in optimize_lambda, clear only in procedure_source, bits only here - * this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte. + * this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte (closure_is_ok_1 checks typesflag). * It can be set on either the body (a pair) or the closure itself. * define -> optimize_lambda sets safe -> define_funchecked -> make_funclet for the frame * similarly, named let -> optimize_lambda, then let creates the frame if safe @@ -2050,9 +2128,9 @@ static s7_scheme *cur_sc = NULL; /* marks a let that is the argument to with-let */ #define T_SIMPLE_DEFAULTS T_LINE_NUMBER -#define has_simple_defaults(p) ((typeflag(T_Fnc(p)) & T_SIMPLE_DEFAULTS) != 0) -#define set_simple_defaults(p) typeflag(T_Fnc(p)) |= T_SIMPLE_DEFAULTS -#define clear_simple_defaults(p) typeflag(T_Fnc(p)) &= (~T_SIMPLE_DEFAULTS) +#define c_func_has_simple_defaults(p) ((typeflag(T_Fnc(p)) & T_SIMPLE_DEFAULTS) != 0) +#define c_func_set_simple_defaults(p) typeflag(T_Fnc(p)) |= T_SIMPLE_DEFAULTS +#define c_func_clear_simple_defaults(p) typeflag(T_Fnc(p)) &= (~T_SIMPLE_DEFAULTS) /* flag c_func_star arg defaults that need GC protection */ #define T_NO_SETTER T_LINE_NUMBER @@ -2196,6 +2274,9 @@ static s7_scheme *cur_sc = NULL; #define set_has_let_set_fallback(p) typeflag(T_Let(p)) |= T_HAS_LET_SET_FALLBACK #define set_all_methods(p, e) typeflag(T_Let(p)) |= (typeflag(e) & (T_HAS_METHODS | T_HAS_LET_REF_FALLBACK | T_HAS_LET_SET_FALLBACK)) +#define T_WEAK_HASH T_SAFE_STEPPER +#define set_weak_hash_table(p) typeflag(T_Hsh(p)) |= T_WEAK_HASH +#define is_weak_hash_table(p) ((typeflag(T_Hsh(p)) & T_WEAK_HASH) != 0) #define T_COPY_ARGS (1 << (TYPE_BITS + 20)) #define needs_copied_args(p) ((typeflag(T_Pos(p)) & T_COPY_ARGS) != 0) @@ -2225,6 +2306,9 @@ static s7_scheme *cur_sc = NULL; #define pair_set_dotted(p) typeflag(T_Pair(p)) |= T_DOTTED_PAIR /* reader indication that a list it just read was dotted */ +#define T_SUBVECTOR T_GENSYM +#define is_subvector(p) ((typeflag(T_Vec(p)) & T_SUBVECTOR) != 0) + #define T_HAS_METHODS (1 << (TYPE_BITS + 22)) #define has_methods(p) ((typeflag(T_Pos(p)) & T_HAS_METHODS) != 0) #define set_has_methods(p) typeflag(T_Met(p)) |= T_HAS_METHODS @@ -2254,12 +2338,21 @@ static s7_scheme *cur_sc = NULL; #define set_has_let_file(p) typeflag(T_Let(p)) |= T_HAS_LET_FILE #define clear_has_let_file(p) typeflag(T_Let(p)) &= (~T_HAS_LET_FILE) +#define T_HAS_OPTLIST T_S7_LET_FIELD +#define has_optlist(p) ((typeflag(T_Pair(p)) & T_HAS_OPTLIST) != 0) +#define set_has_optlist(p) typeflag(T_Pair(p)) |= T_HAS_OPTLIST + #define T_DEFINER (1LL << (TYPE_BITS + BIT_ROOM + 26)) #define is_definer(p) ((typeflag(T_Pos(p)) & T_DEFINER) != 0) #define T_RECUR (1LL << (TYPE_BITS + BIT_ROOM + 27)) -#define is_recur(p) ((typeflag(T_Slt(p)) & T_RECUR) != 0) -#define set_recur(p) typeflag(T_Slt(p)) |= T_RECUR +#define is_recur(p) (((typeflag(T_Slt(p)) & T_RECUR) != 0) && (optimize_op(slot) == symbol_ctr(slot_symbol(slot)))) +#define set_recur(slot, symbol) do {typeflag(T_Slt(slot)) |= T_RECUR; set_optimize_op(slot, symbol_ctr(symbol) & 0xff);} while (0) + +#define T_TREE_COLLECTED T_RECUR +#define is_tree_collected_or_shared(p) ((typeflag(T_Pair(p)) & (T_TREE_COLLECTED | T_SHARED)) != 0) +#define set_tree_collected(p) typeflag(T_Pair(p)) |= T_TREE_COLLECTED +#define clear_tree_bits(p) typeflag(T_Pair(p)) &= (~(T_TREE_COLLECTED | T_SHARED)) #define T_VERY_SAFE_CLOSURE (1LL << (TYPE_BITS + BIT_ROOM + 28)) #define is_very_safe_closure(p) ((typeflag(T_Pos(p)) & T_VERY_SAFE_CLOSURE) != 0) @@ -2275,12 +2368,12 @@ static s7_scheme *cur_sc = NULL; #define set_cyclic_set(p) typeflag(T_Pos(p)) |= T_CYCLIC_SET #define clear_cyclic_bits(p) typeflag(p) &= (~(T_COLLECTED | T_SHARED | T_CYCLIC | T_CYCLIC_SET)) -#define T_TREE_COLLECTED T_RECUR -#define is_tree_collected_or_shared(p) ((typeflag(T_Pair(p)) & (T_TREE_COLLECTED | T_SHARED)) != 0) -#define set_tree_collected(p) typeflag(T_Pair(p)) |= T_TREE_COLLECTED -#define clear_tree_bits(p) typeflag(T_Pair(p)) &= (~(T_TREE_COLLECTED | T_SHARED)) +#define T_KEYWORD (1LL << (TYPE_BITS + BIT_ROOM + 31)) +#define is_keyword(p) ((typeflag(T_Pos(p)) & T_KEYWORD) != 0) +/* this bit distinguishes a symbol from a symbol that is also a keyword */ -#define UNUSED_BITS 0x7f80000000000000 + +#define UNUSED_BITS 0x7f00000000000000 /* 39 lower bits, sign bit as gc-mark, 16 for opt info */ #define T_GC_MARK 0x8000000000000000 @@ -2289,13 +2382,14 @@ static s7_scheme *cur_sc = NULL; #define clear_mark(p) typeflag(p) &= (~T_GC_MARK) /* using the sign bit, bit 23 (or 55) == 31 (or 63) for this makes a big difference in the GC */ -static int64_t not_heap = -1; #define heap_location(p) (p)->hloc #define not_in_heap(p) ((T_Pos(p))->hloc < 0) #define in_heap(p) ((T_Pos(p))->hloc >= 0) -#define unheap(p) (p)->hloc = not_heap-- +#define global_unheap(p) (p)->hloc = global_not_heap-- +#define unheap(sc, p) (p)->hloc = sc->not_heap-- +static int64_t global_not_heap = -1; -#define is_eof(p) ((T_Pos(p)) == sc->eof_object) +#define is_eof(p) ((T_Pos(p)) == eof_object) #define is_undefined(p) (type(p) == T_UNDEFINED) #define is_true(Sc, p) ((T_Pos(p)) != Sc->F) #define is_false(Sc, p) ((T_Pos(p)) == Sc->F) @@ -2378,15 +2472,14 @@ static int64_t not_heap = -1; #define F_CON (1 << 22) /* constant as above */ #define F_CALL (1 << 23) /* c-func */ #define F_LAMBDA (1 << 24) /* lambda form */ -#define F_ID 0x80000000 /* (1 << 31) */ /* symbol id */ -#define F_MASK (F_KEY | F_SLOW | F_SYM | F_PAIR | F_CON | F_CALL | F_LAMBDA | F_ID | S_NAME) +#define F_MASK (F_KEY | F_SLOW | F_SYM | F_PAIR | F_CON | F_CALL | F_LAMBDA | S_NAME) #define opt2_is_set(p) (((p)->debugger_bits & F_SET) != 0) #define set_opt2_is_set(p) (p)->debugger_bits |= F_SET #define opt2_role_matches(p, Role) (((p)->debugger_bits & F_MASK) == Role) #define set_opt2_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~F_MASK)) -#define opt2(p, Role) opt2_1(T_Pair(p), Role, __func__, __LINE__) -#define set_opt2(p, x, Role) set_opt2_1(T_Pair(p), (s7_pointer)x, Role, __func__, __LINE__) +#define opt2(p, Role) opt2_1(sc, T_Pair(p), Role, __func__, __LINE__) +#define set_opt2(p, x, Role) set_opt2_1(sc, T_Pair(p), (s7_pointer)x, Role, __func__, __LINE__) /* opt3 collides with optimization and line number stuff (T_LINE_NUMBER, T_OPTIMIZED) */ #define G_SET (1 << 2) @@ -2410,7 +2503,7 @@ static int64_t not_heap = -1; #define pair_line(p) s_line_1(T_Pair(p), __func__, __LINE__) #define pair_set_line(p, X) set_s_line_1(T_Pair(p), X, __func__, __LINE__) #define pair_file(p) (p)->object.sym_cons.file -#define pair_set_file(p, X) set_s_file_1(T_Pair(p), X, __func__, __LINE__) +#define pair_set_file(p, X) set_s_file_1(sc, T_Pair(p), X, __func__, __LINE__) #define pair_raw_hash(p) s_hash_1(T_Pair(p), __func__, __LINE__) #define pair_set_raw_hash(p, X) set_s_hash_1(T_Pair(p), X, __func__, __LINE__) #define pair_raw_len(p) s_len_1(T_Pair(p), __func__, __LINE__) @@ -2420,51 +2513,43 @@ static int64_t not_heap = -1; #endif -#define opt_fast(P) T_Lst(opt1(P, E_FAST)) -#define set_opt_fast(P, X) set_opt1(P, T_Pair(X), E_FAST) -#define opt_cfunc(P) T_Pos(opt1(P, E_CFUNC)) -#define set_opt_cfunc(P, X) set_opt1(P, T_Pos(X), E_CFUNC) -#define opt_lambda_unchecked(P) opt1(P, E_LAMBDA) /* can be free/null? from s7_call? */ -#define opt_lambda(P) T_Clo(opt1(P, E_LAMBDA)) -#define set_opt_lambda(P, X) set_opt1(P, T_Pos(X), E_LAMBDA) -#define opt_goto(P) T_Pos(opt1(P, E_GOTO)) /* used when checking for non-goto unknown in eval, so can't be T_Got */ -#define set_opt_goto(P, X) set_opt1(P, T_Pos(X), E_GOTO) -#define opt_clause(P) T_Pos(opt1(P, E_CLAUSE)) -#define set_opt_clause(P, X) set_opt1(P, T_Pos(X), E_CLAUSE) -#define opt_sym1(P) T_Sym(opt1(P, E_SYM)) -#define set_opt_sym1(P, X) set_opt1(P, T_Sym(X), E_SYM) -#define opt_pair1(P) T_Lst(opt1(P, E_PAIR)) -#define set_opt_pair1(P, X) set_opt1(P, T_Lst(X), E_PAIR) -#define opt_con1(P) T_Pos(opt1(P, E_CON)) -#define set_opt_con1(P, X) set_opt1(P, T_Pos(X), E_CON) -#define opt_any1(P) opt1(P, E_ANY) /* can be free in closure_is_ok */ -#define opt_slot1(P) T_Slt(opt1(P, E_SLOT)) -#define set_opt_slot1(P, X) set_opt1(P, T_Slt(X), E_SLOT) - -#define opt_any2(P) T_Pos(opt2(P, F_KEY)) -#define set_opt_any2(P, X) set_opt2(P, T_Pos(X), F_KEY) -#define opt_slow(P) T_Lst(opt2(P, F_SLOW)) -#define set_opt_slow(P, X) set_opt2(P, T_Pair(X), F_SLOW) -#define opt_sym2(P) T_Sym(opt2(P, F_SYM)) -#define set_opt_sym2(P, X) set_opt2(P, T_Sym(X), F_SYM) -#define opt_pair2(P) T_Lst(opt2(P, F_PAIR)) -#define set_opt_pair2(P, X) set_opt2(P, T_Lst(X), F_PAIR) -#define opt_con2(P) T_Pos(opt2(P, F_CON)) -#define set_opt_con2(P, X) set_opt2(P, T_Pos(X), F_CON) -#define opt_lambda2(P) T_Pair(opt2(P, F_LAMBDA)) -#define set_opt_lambda2(P, X) set_opt2(P, T_Pair(X), F_LAMBDA) -#define opt_direct_x_call(P) opt2(P, F_LAMBDA) +#define opt_fast(P) T_Lst(opt1(P, E_FAST)) +#define set_opt_fast(P, X) set_opt1(P, T_Pair(X), E_FAST) +#define opt_cfunc(P) T_Pos(opt1(P, E_CFUNC)) +#define set_opt_cfunc(P, X) set_opt1(P, T_Pos(X), E_CFUNC) +#define opt_lambda_unchecked(P) opt1(P, E_LAMBDA) /* can be free/null? from s7_call? */ +#define opt_lambda(P) T_Clo(opt1(P, E_LAMBDA)) +#define set_opt_lambda(P, X) set_opt1(P, T_Pos(X), E_LAMBDA) +#define opt_goto(P) T_Pos(opt1(P, E_GOTO)) /* used when checking for non-goto unknown in eval, so can't be T_Got */ +#define set_opt_goto(P, X) set_opt1(P, T_Pos(X), E_GOTO) +#define opt_clause(P) T_Pos(opt1(P, E_CLAUSE)) +#define set_opt_clause(P, X) set_opt1(P, T_Pos(X), E_CLAUSE) +#define opt_sym1(P) T_Sym(opt1(P, E_SYM)) +#define set_opt_sym1(P, X) set_opt1(P, T_Sym(X), E_SYM) +#define opt_pair1(P) T_Lst(opt1(P, E_PAIR)) +#define set_opt_pair1(P, X) set_opt1(P, T_Lst(X), E_PAIR) +#define opt_con1(P) T_Pos(opt1(P, E_CON)) +#define set_opt_con1(P, X) set_opt1(P, T_Pos(X), E_CON) +#define opt_any1(P) opt1(P, E_ANY) /* can be free in closure_is_ok */ +#define opt_slot1(P) T_Slt(opt1(P, E_SLOT)) +#define set_opt_slot1(P, X) set_opt1(P, T_Slt(X), E_SLOT) + +#define opt_any2_unchecked(P) P->object.cons.opt2 +#define set_opt_any2_unchecked(P, X) P->object.cons.opt2 = X +#define opt_any2(P) opt2(P, F_KEY) +#define set_opt_any2(P, X) set_opt2(P, X, F_KEY) +#define opt_slow(P) T_Lst(opt2(P, F_SLOW)) +#define set_opt_slow(P, X) set_opt2(P, T_Pair(X), F_SLOW) +#define opt_sym2(P) T_Sym(opt2(P, F_SYM)) +#define set_opt_sym2(P, X) set_opt2(P, T_Sym(X), F_SYM) +#define opt_pair2(P) T_Lst(opt2(P, F_PAIR)) +#define set_opt_pair2(P, X) set_opt2(P, T_Lst(X), F_PAIR) +#define opt_con2(P) T_Pos(opt2(P, F_CON)) +#define set_opt_con2(P, X) set_opt2(P, T_Pos(X), F_CON) +#define opt_lambda2(P) T_Pair(opt2(P, F_LAMBDA)) +#define set_opt_lambda2(P, X) set_opt2(P, T_Pair(X), F_LAMBDA) +#define opt_direct_x_call(P) opt2(P, F_LAMBDA) #define set_opt_direct_x_call(P, X) set_opt2(P, (s7_pointer)(X), F_LAMBDA) -#if POINTER_32 -/* I don't think this can work -- in a long run, we'll be truncating the symbol_id etc - * but I only noticed this late in the day... I'll make a better fix in 18.2 - */ -#define opt_id2(P) (intptr_t)(opt2(P, F_ID)) -#define set_opt_id2(P, X) set_opt2(P, (s7_pointer)((uint32_t)(X)), F_ID) -#else -#define opt_id2(P) (int64_t)(opt2(P, F_ID)) -#define set_opt_id2(P, X) set_opt2(P, (s7_pointer)(X), F_ID) -#endif #define arglist_length(P) T_Int(opt3(cdr(P), G_ARGLEN)) #define set_arglist_length(P, X) set_opt3(cdr(P), T_Int(X), G_ARGLEN) @@ -2472,8 +2557,8 @@ static int64_t not_heap = -1; #define set_opt_sym3(P, X) set_opt3(P, T_Sym(X), G_SYM) #define opt_pair3(P) T_Pair(opt3(P, G_AND)) #define set_opt_pair3(P, X) set_opt3(P, T_Pair(X), G_AND) -#define opt_any3(P) T_Pos(opt3(P, G_AND)) -#define set_opt_any3(P, X) set_opt3(P, T_Pos(X), G_AND) +#define opt_any3(P) opt3(P, G_AND) +#define set_opt_any3(P, X) set_opt3(P, X, G_AND) #define opt_direct_x(P) opt3(P, G_DIRECT) #define set_opt_direct_x(P, X) set_opt3(P, (s7_pointer)(X), G_DIRECT) @@ -2720,10 +2805,12 @@ static void symbol_set_id(s7_pointer p, s7_int id) #define vector_dimensions(p) vdims_dims(vector_dimension_info(p)) #define vector_offset(p, i) vdims_offsets(vector_dimension_info(p))[i] #define vector_offsets(p) vdims_offsets(vector_dimension_info(p)) -#define shared_vector(p) vdims_original(vector_dimension_info(p)) #define vector_rank(p) ((vector_dimension_info(p)) ? vector_ndims(p) : 1) #define vector_has_dimensional_info(p) (vector_dimension_info(p)) +#define subvector_vector(p) ((vector_dimension_info(p)) ? vdims_original(vector_dimension_info(p)) : (T_Vec(p))->object.vector.block->nx.ksym) +#define subvector_set_vector(p, vect) (T_Vec(p))->object.vector.block->nx.ksym = vect + #define rootlet_element(p, i) unchecked_vector_element(p, i) #define rootlet_elements(p) unchecked_vector_elements(p) #define rootlet_block(p) unchecked_vector_block(p) @@ -2748,7 +2835,7 @@ static void symbol_set_id(s7_pointer p, s7_int id) #define hash_table_procedures_mapper(p) cdr(hash_table_procedures(p)) #if S7_DEBUGGING -#define T_Itr_Pos(p) titr_pos(T_Itr(p), __func__, __LINE__) +#define T_Itr_Pos(p) titr_pos(sc, T_Itr(p), __func__, __LINE__) #define T_Itr_Len(p) titr_len(T_Itr(p), __func__, __LINE__) #define T_Itr_Hash(p) titr_hash(T_Itr(p), __func__, __LINE__) #define T_Itr_Let(p) titr_let(T_Itr(p), __func__, __LINE__) @@ -2893,8 +2980,8 @@ static void symbol_set_id(s7_pointer p, s7_int id) #define closure_let(p) T_Lid((T_Clo(p))->object.func.env) #define closure_set_let(p, L) (T_Clo(p))->object.func.env = T_Lid(L) #define closure_arity(p) (T_Clo(p))->object.func.arity -#define closure_setter(p) (T_Clo(p))->object.func.sb.setter -#define closure_set_setter(p, Val) (T_Clo(p))->object.func.sb.setter = T_Pos(Val) +#define closure_setter(p) (T_Clo(p))->object.func.setter +#define closure_set_setter(p, Val) (T_Clo(p))->object.func.setter = T_Pos(Val) #define CLOSURE_ARITY_NOT_SET 0x40000000 #define MAX_ARITY 0x20000000 @@ -2942,9 +3029,13 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH}; #define c_object_to_string(Sc, p) c_object_info(Sc, p)->to_string #define c_object_scheme_name(Sc, p) T_Str(c_object_info(Sc, p)->scheme_name) -#define raw_pointer(p) (T_Ptr(p))->object.cptr.c_pointer -#define raw_pointer_type(p) (T_Ptr(p))->object.cptr.c_type -#define raw_pointer_info(p) (T_Ptr(p))->object.cptr.info +#define c_pointer(p) (T_Ptr(p))->object.cptr.c_pointer +#define c_pointer_type(p) (T_Ptr(p))->object.cptr.c_type +#define c_pointer_info(p) (T_Ptr(p))->object.cptr.info +#define c_pointer_weak1(p) (T_Ptr(p))->object.cptr.weak1 +#define c_pointer_weak2(p) (T_Ptr(p))->object.cptr.weak2 +#define c_pointer_set_weak1(p, q) (T_Ptr(p))->object.cptr.weak1 = q +#define c_pointer_set_weak2(p, q) (T_Ptr(p))->object.cptr.weak2 = q #define is_c_pointer(p) (type(p) == T_C_POINTER) #define is_counter(p) (type(p) == T_COUNTER) @@ -2970,6 +3061,7 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH}; #endif #define integer(p) (T_Int(p))->object.number.integer_value +#define set_integer(p, x) integer(p) = x #define real(p) (T_Rel(p))->object.number.real_value #define set_real(p, x) real(p) = x #define numerator(p) (T_Frc(p))->object.number.fraction_value.numerator @@ -2991,11 +3083,6 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH}; #define big_complex(p) ((T_Bgz(p))->object.number.big_complex) #endif -#define NUM_SMALL_INTS 2048 -static s7_pointer small_ints[NUM_SMALL_INTS + 1]; -#define small_int(Val) small_ints[Val] -#define is_small(n) ((n & ~(NUM_SMALL_INTS - 1)) == 0) - #define print_name(p) (char *)((T_Num(p))->object.number.pval.name + 1) #define print_name_length(p) (T_Num(p))->object.number.pval.name[0] @@ -3010,6 +3097,121 @@ static void set_print_name(s7_pointer p, const char *name, int32_t len) } } +static s7_int s7_int_max = 0, s7_int_min = 0; +static int32_t s7_int32_max = 0, s7_int32_min = 0, s7_int_bits = 0, s7_int_digits = 0; +static int32_t s7_int_digits_by_radix[17]; + +#define S7_LLONG_MAX 9223372036854775807LL +#define S7_LLONG_MIN (-S7_LLONG_MAX - 1LL) + +#define S7_LONG_MAX 2147483647LL +#define S7_LONG_MIN (-S7_LONG_MAX - 1LL) + +#define S7_SHORT_MAX 32767 +#define S7_SHORT_MIN -32768 + +static void init_int_limits(void) +{ + int32_t i, top; +#if WITH_GMP +#define S7_LOG_LLONG_MAX 36.736800 +#define S7_LOG_LONG_MAX 16.6355322 +#else + /* actually not safe = (log (- (expt 2 63) 1)) and (log (- (expt 2 31) 1)) (using 63 and 31 bits) */ +#define S7_LOG_LLONG_MAX 43.668274 +#define S7_LOG_LONG_MAX 21.487562 +#endif + + top = sizeof(s7_int); + s7_int32_max = (top == 8) ? S7_LONG_MAX : S7_SHORT_MAX; + s7_int32_min = (top == 8) ? S7_LONG_MIN : S7_SHORT_MIN; + s7_int_bits = (top == 8) ? 63 : 31; + s7_int_digits = (top == 8) ? 18 : 8; + + s7_int_max = (top == 8) ? S7_LLONG_MAX : S7_LONG_MAX; + s7_int_min = (top == 8) ? S7_LLONG_MIN : S7_LONG_MIN; + + s7_int_digits_by_radix[0] = 0; + s7_int_digits_by_radix[1] = 0; + + for (i = 2; i < 17; i++) + s7_int_digits_by_radix[i] = (int32_t)(floor(((top == 8) ? S7_LOG_LLONG_MAX : S7_LOG_LONG_MAX) / log((double)i))); +} + +static s7_pointer make_permanent_integer_unchecked(s7_int i) +{ + s7_pointer p; + p = (s7_pointer)calloc(1, sizeof(s7_cell)); + typeflag(p) = T_IMMUTABLE | T_INTEGER; + global_unheap(p); /* SC?? */ + integer(p) = i; + return(p); +} + +#define NUM_SMALL_INTS 2048 +static s7_pointer small_ints[NUM_SMALL_INTS + 1]; +#define small_int(Val) small_ints[Val] +#define is_small(n) ((n & ~(NUM_SMALL_INTS - 1)) == 0) + +static s7_pointer real_zero, real_NaN, real_pi, real_one, arity_not_set, max_arity, real_infinity, real_minus_infinity, minus_one, minus_two, mostfix, leastfix; + +static void init_small_ints(void) +{ + const char *ones[10] = {"0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}; + s7_cell *cells; + int32_t i; + cells = (s7_cell *)calloc((NUM_SMALL_INTS + 1), sizeof(s7_cell)); + for (i = 0; i <= NUM_SMALL_INTS; i++) + { + s7_pointer p; + small_ints[i] = &cells[i]; + p = small_ints[i]; + typeflag(p) = T_IMMUTABLE | T_INTEGER; + global_unheap(p); + integer(p) = i; + } + for (i = 0; i < 10; i++) + set_print_name(small_ints[i], ones[i], 1); + + /* setup a few other numbers while we're here */ + #define EXTRA_NUMBERS 10 + cells = (s7_cell *)calloc(EXTRA_NUMBERS, sizeof(s7_cell)); + + #define init_real(Ptr, Num, Name, Name_Len) \ + do {set_type(Ptr, T_REAL | T_IMMUTABLE); global_unheap(Ptr); set_real(Ptr, Num); if (Name) set_print_name(Ptr, Name, Name_Len);} while (0) + + real_zero = &cells[0]; init_real(real_zero, 0.0, "0.0", 3); + real_one = &cells[1]; init_real(real_one, 1.0, "1.0", 3); + real_NaN = &cells[2]; init_real(real_NaN, NAN, "+nan.0", 6); + real_infinity = &cells[3]; init_real(real_infinity, INFINITY, "+inf.0", 6); + real_minus_infinity = &cells[4]; init_real(real_minus_infinity, -INFINITY, "-inf.0", 6); + real_pi = &cells[5]; init_real(real_pi, 3.1415926535897932384626433832795029L, NULL, 0); /* M_PI is not good enough for s7_double = long double */ + + #define init_integer(Ptr, Num, Name, Name_Len) \ + do {set_type(Ptr, T_INTEGER | T_IMMUTABLE); global_unheap(Ptr); set_integer(Ptr, Num); if (Name) set_print_name(Ptr, Name, Name_Len);} while (0) + + arity_not_set = &cells[6]; init_integer(arity_not_set, CLOSURE_ARITY_NOT_SET, NULL, 0); + max_arity = &cells[7]; init_integer(max_arity, MAX_ARITY, NULL, 0); + minus_one = &cells[8]; init_integer(minus_one, -1, "-1", 2); + minus_two = &cells[9]; init_integer(minus_two, -2, "-2", 2); + + mostfix = make_permanent_integer_unchecked(s7_int_max); + leastfix = make_permanent_integer_unchecked(s7_int_min); + if (s7_int_bits == 63) + { + set_print_name(mostfix, "9223372036854775807", 19); + set_print_name(leastfix, "-9223372036854775808", 20); + } + else + { + set_print_name(mostfix, "2147483647", 10); + set_print_name(leastfix, "-2147483648", 11); + } + /* prebuilt null string is tricky mainly because it overlaps #u8() */ +} + + +/* -------------------------------------------------------------------------------- */ #define GC_TRIGGER_SIZE 64 /* new_cell has to include the new cell's type. In the free list, it is 0 (T_FREE). If we remove it here, @@ -3030,18 +3232,9 @@ static void set_print_name(s7_pointer p, const char *name, int32_t len) * to check it repeatedly after the first such check. */ #else -static int32_t last_gc_line = 0; -static const char *last_gc_func = NULL; static void clear_cell(s7_pointer p, const char *func, int line) { -#if 0 - p->object.cons.car = NULL; - p->object.cons.cdr = NULL; - p->object.cons.opt1 = NULL; - p->object.cons.opt2 = NULL; - p->object.cons.opt3 = NULL; -#endif p->alloc_line = line; p->alloc_func = func; p->debugger_bits = 0; @@ -3049,7 +3242,7 @@ static void clear_cell(s7_pointer p, const char *func, int line) #define new_cell(Sc, Obj, Type) \ do { \ - if (Sc->free_heap_top <= Sc->free_heap_trigger) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \ + if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc); \ Obj = (*(--(Sc->free_heap_top))); \ clear_cell(Obj, __func__, __LINE__); \ set_type(Obj, Type); \ @@ -3083,25 +3276,14 @@ static void clear_cell(s7_pointer p, const char *func, int line) #define rational_to_double(Sc, X) s7_number_to_real(Sc, X) #endif -static s7_cell real_wrapper1, real_wrapper2, real_wrapper3, real_wrapper4, integer_wrapper, integer_wrapper2; -static s7_pointer wrap_real(s7_double x) {real_wrapper1.object.number.real_value = x; return(&real_wrapper1);} -static s7_pointer wrap_integer(s7_int x) {integer_wrapper.object.number.integer_value = x; return(&integer_wrapper);} -static s7_pointer wrap_integer2(s7_int x) {integer_wrapper2.object.number.integer_value = x; return(&integer_wrapper2);} +static inline s7_pointer wrap_real(s7_scheme *sc, s7_double x) {real(sc->real_wrapper1) = x; return(sc->real_wrapper1);} +static inline s7_pointer wrap_integer1(s7_scheme *sc, s7_int x) {integer(sc->integer_wrapper1) = x; return(sc->integer_wrapper1);} +static inline s7_pointer wrap_integer2(s7_scheme *sc, s7_int x) {integer(sc->integer_wrapper2) = x; return(sc->integer_wrapper2);} +static inline s7_pointer wrap_integer3(s7_scheme *sc, s7_int x) {integer(sc->integer_wrapper3) = x; return(sc->integer_wrapper3);} #if (!WITH_GMP) -static s7_pointer wrap_real2(s7_double x) {real_wrapper2.object.number.real_value = x; return(&real_wrapper2);} +static inline s7_pointer wrap_real2(s7_scheme *sc, s7_double x) {real(sc->real_wrapper2) = x; return(sc->real_wrapper2);} #endif -#define S7_LLONG_MAX 9223372036854775807LL -#define S7_LLONG_MIN (-S7_LLONG_MAX - 1LL) - -#define S7_LONG_MAX 2147483647LL -#define S7_LONG_MIN (-S7_LONG_MAX - 1LL) - -#define S7_SHORT_MAX 32767 -#define S7_SHORT_MIN -32768 - -static s7_int s7_int_max = 0, s7_int_min = 0; - /* 9007199254740991LL is where a truncated double starts to skip integers (expt 2 53) = ca 1e16 * :(ceiling (+ 1e16 1)) * 10000000000000000 @@ -3278,13 +3460,11 @@ static size_t catstrs_direct(char *dst, const char *s1, ...) /* NULL-terminated return(d - dst); } -static char *pos_int_to_str(s7_int num, s7_int *len, char endc) +static char *pos_int_to_str(s7_scheme *sc, s7_int num, s7_int *len, char endc) { - #define INT_TO_STR_SIZE 32 - static char itos[INT_TO_STR_SIZE]; char *p, *op; - p = (char *)(itos + INT_TO_STR_SIZE - 1); + p = (char *)(sc->int_to_str3 + INT_TO_STR_SIZE - 1); op = p; *p-- = '\0'; if (endc != '\0') *p-- = endc; @@ -3293,21 +3473,19 @@ static char *pos_int_to_str(s7_int num, s7_int *len, char endc) return((char *)(p + 1)); } -static char *pos_int_to_str_direct(s7_int num) +static char *pos_int_to_str_direct(s7_scheme *sc, s7_int num) { - static char itosd[INT_TO_STR_SIZE]; char *p; - p = (char *)(itosd + INT_TO_STR_SIZE - 1); + p = (char *)(sc->int_to_str4 + INT_TO_STR_SIZE - 1); *p-- = '\0'; do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num); return((char *)(p + 1)); } -static char *pos_int_to_str_direct_1(s7_int num) +static char *pos_int_to_str_direct_1(s7_scheme *sc, s7_int num) { - static char itosd1[INT_TO_STR_SIZE]; char *p; - p = (char *)(itosd1 + INT_TO_STR_SIZE - 1); + p = (char *)(sc->int_to_str5 + INT_TO_STR_SIZE - 1); *p-- = '\0'; do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num); return((char *)(p + 1)); @@ -3325,7 +3503,7 @@ static void s7_warn(s7_scheme *sc, s7_int len, const char *ctrl, ...); static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list); static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b); static s7_pointer cons_unchecked_with_type(s7_scheme *sc, s7_pointer p, s7_pointer a, s7_pointer b); -static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint64_t type); +static s7_pointer permanent_cons(s7_scheme *sc, s7_pointer a, s7_pointer b, uint64_t type); static s7_pointer make_atom(s7_scheme *sc, char *q, s7_int radix, bool want_symbol, bool with_error); static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args); static int32_t remember_file_name(s7_scheme *sc, const char *file); @@ -3340,7 +3518,7 @@ static token_t token(s7_scheme *sc); static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices); static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym); static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym); -static void free_hash_table(s7_pointer table); +static void free_hash_table(s7_scheme *sc, s7_pointer table); void s7_show_let(s7_scheme *sc); static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args); static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst); @@ -3414,18 +3592,6 @@ static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointe out_of_range_error_prepackaged(Sc, symbol_name_cell(Caller), Arg_Num, Arg, Description) -static s7_pointer car_a_list_string, cdr_a_list_string, caar_a_list_string, cadr_a_list_string, cdar_a_list_string, - cddr_a_list_string, caaar_a_list_string, caadr_a_list_string, cadar_a_list_string, caddr_a_list_string, - cdaar_a_list_string, cdadr_a_list_string, cddar_a_list_string, cdddr_a_list_string, a_list_string, - an_association_list_string, an_output_port_string, an_input_port_string, an_open_port_string, a_byte_vector_string, - a_normal_real_string, a_rational_string, a_boolean_string, a_number_string, a_let_string, immutable_error_string, - a_procedure_string, a_proper_list_string, a_thunk_string, something_applicable_string, a_symbol_string, - a_non_negative_integer_string, a_format_port_string, an_unsigned_byte_string, value_is_missing_string, - a_non_constant_symbol_string, an_eq_func_string, a_sequence_string, its_too_small_string, parameter_set_twice_string, - a_normal_procedure_string, its_too_large_string, its_negative_string, result_is_too_large_string, - its_nan_string, its_infinite_string, too_many_indices_string, a_valid_radix_string, an_input_string_port_string, - an_input_file_port_string, an_output_string_port_string, an_output_file_port_string, a_random_state_object_string; - #if (!HAVE_COMPLEX_NUMBERS) static s7_pointer no_complex_numbers_string; #endif @@ -3483,42 +3649,41 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_SAFE_C_S_opAq, HOP_SAFE_C_S_opAq, OP_SAFE_C_opAq_S, HOP_SAFE_C_opAq_S, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq, OP_SAFE_C_S_opAAAq, HOP_SAFE_C_S_opAAAq, OP_SAFE_IFA_SS_A, HOP_SAFE_IFA_SS_A, - OP_SAFE_C_STAR_A, HOP_SAFE_C_STAR_A, OP_SAFE_C_STAR_AA, HOP_SAFE_C_STAR_AA, OP_SAFE_C_STAR_ALL_X, HOP_SAFE_C_STAR_ALL_X, + OP_SAFE_C_STAR, HOP_SAFE_C_STAR, OP_SAFE_C_STAR_A, HOP_SAFE_C_STAR_A, OP_SAFE_C_STAR_AA, HOP_SAFE_C_STAR_AA, OP_SAFE_C_STAR_ALL_X, HOP_SAFE_C_STAR_ALL_X, - OP_SAFE_QUOTE, HOP_SAFE_QUOTE, OP_SAFE_C_P, HOP_SAFE_C_P, + OP_SAFE_QUOTE, HOP_SAFE_QUOTE, OP_SAFE_C_P, HOP_SAFE_C_P, OP_SAFE_C_ZZZ, HOP_SAFE_C_ZZZ, - OP_SAFE_C_Z, HOP_SAFE_C_Z, OP_SAFE_C_ZZ, HOP_SAFE_C_ZZ, OP_SAFE_C_SZ, HOP_SAFE_C_SZ, OP_SAFE_C_ZS, HOP_SAFE_C_ZS, - OP_SAFE_C_CZ, HOP_SAFE_C_CZ, OP_SAFE_C_ZC, HOP_SAFE_C_ZC, OP_SAFE_C_ZQ, HOP_SAFE_C_ZQ, - OP_SAFE_C_opCq_Z, HOP_SAFE_C_opCq_Z, OP_SAFE_C_S_opSZq, HOP_SAFE_C_S_opSZq, - OP_SAFE_C_AZ, HOP_SAFE_C_AZ, OP_SAFE_C_ZA, HOP_SAFE_C_ZA, - OP_SAFE_C_ZAA, HOP_SAFE_C_ZAA, OP_SAFE_C_AZA, HOP_SAFE_C_AZA, OP_SAFE_C_AAZ, HOP_SAFE_C_AAZ, - OP_SAFE_C_ZZA, HOP_SAFE_C_ZZA, OP_SAFE_C_ZAZ, HOP_SAFE_C_ZAZ, OP_SAFE_C_AZZ, HOP_SAFE_C_AZZ, - OP_SAFE_C_ZZZ, HOP_SAFE_C_ZZZ, + OP_THUNK, HOP_THUNK, OP_THUNK_P, HOP_THUNK_P, + OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P, OP_SAFE_THUNK_A, HOP_SAFE_THUNK_A, - OP_THUNK, HOP_THUNK, - OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_C, HOP_CLOSURE_C, OP_CLOSURE_P, HOP_CLOSURE_P, OP_CLOSURE_S_1, HOP_CLOSURE_S_1, - OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SS_P, HOP_CLOSURE_SS_P, - OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_CS, HOP_CLOSURE_CS, - OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_AA, HOP_CLOSURE_AA, OP_CLOSURE_A_P, HOP_CLOSURE_A_P, OP_CLOSURE_AA_P, HOP_CLOSURE_AA_P, - OP_CLOSURE_ALL_X, HOP_CLOSURE_ALL_X, OP_CLOSURE_ALL_S, HOP_CLOSURE_ALL_S, OP_CLOSURE_ALL_S_P, HOP_CLOSURE_ALL_S_P, - OP_CLOSURE_FA, HOP_CLOSURE_FA, - OP_CLOSURE_AP, HOP_CLOSURE_AP, OP_CLOSURE_PA, HOP_CLOSURE_PA, - OP_CLOSURE_ANY_ALL_X, HOP_CLOSURE_ANY_ALL_X, + OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_S_P, HOP_CLOSURE_S_P, + OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_CLOSURE_S_P, HOP_SAFE_CLOSURE_S_P, OP_SAFE_CLOSURE_S_A, HOP_SAFE_CLOSURE_S_A, + OP_CLOSURE_C, HOP_CLOSURE_C, OP_CLOSURE_C_P, HOP_CLOSURE_C_P, + OP_SAFE_CLOSURE_C, HOP_SAFE_CLOSURE_C, OP_SAFE_CLOSURE_C_P, HOP_SAFE_CLOSURE_C_P, OP_SAFE_CLOSURE_C_A, HOP_SAFE_CLOSURE_C_A, - OP_CLOSURE_STAR_A, HOP_CLOSURE_STAR_A, OP_CLOSURE_STAR_ALL_X, HOP_CLOSURE_STAR_ALL_X, + OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_A_P, HOP_CLOSURE_A_P, + OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_CLOSURE_A_P, HOP_SAFE_CLOSURE_A_P, OP_SAFE_CLOSURE_A_A, HOP_SAFE_CLOSURE_A_A, - OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P, - - OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_CLOSURE_S_P, HOP_SAFE_CLOSURE_S_P, - OP_SAFE_CLOSURE_S_C, HOP_SAFE_CLOSURE_S_C, OP_SAFE_CLOSURE_S_L, HOP_SAFE_CLOSURE_S_L, - OP_SAFE_CLOSURE_C, HOP_SAFE_CLOSURE_C, OP_SAFE_CLOSURE_P, HOP_SAFE_CLOSURE_P, - OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_LCLOSURE_A, HOP_SAFE_LCLOSURE_A, OP_SAFE_CLOSURE_A_C, HOP_SAFE_CLOSURE_A_C, - OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SS_B, HOP_SAFE_CLOSURE_SS_B, - OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_CS, HOP_SAFE_CLOSURE_CS, - OP_SAFE_CLOSURE_SA, HOP_SAFE_CLOSURE_SA, - OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA, - OP_SAFE_CLOSURE_ALL_X, HOP_SAFE_CLOSURE_ALL_X, OP_SAFE_CLOSURE_AA, HOP_SAFE_CLOSURE_AA, OP_SAFE_CLOSURE_AA_P, HOP_SAFE_CLOSURE_AA_P, + OP_CLOSURE_P, HOP_CLOSURE_P, OP_SAFE_CLOSURE_P, HOP_SAFE_CLOSURE_P, + + OP_CLOSURE_AP, HOP_CLOSURE_AP, OP_CLOSURE_PA, HOP_CLOSURE_PA, OP_SAFE_CLOSURE_AP, HOP_SAFE_CLOSURE_AP, OP_SAFE_CLOSURE_PA, HOP_SAFE_CLOSURE_PA, + OP_CLOSURE_FA, HOP_CLOSURE_FA, + + OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SS_P, HOP_CLOSURE_SS_P, + OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SS_P, HOP_SAFE_CLOSURE_SS_P, OP_SAFE_CLOSURE_SS_A, HOP_SAFE_CLOSURE_SS_A, + OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_SC_P, HOP_CLOSURE_SC_P, + OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_SC_P, HOP_SAFE_CLOSURE_SC_P, + OP_CLOSURE_CS, HOP_CLOSURE_CS, OP_CLOSURE_CS_P, HOP_CLOSURE_CS_P, + OP_SAFE_CLOSURE_CS, HOP_SAFE_CLOSURE_CS, OP_SAFE_CLOSURE_CS_P, HOP_SAFE_CLOSURE_CS_P, + + OP_CLOSURE_AA, HOP_CLOSURE_AA, OP_CLOSURE_AA_P, HOP_CLOSURE_AA_P, + OP_SAFE_CLOSURE_AA, HOP_SAFE_CLOSURE_AA, OP_SAFE_CLOSURE_AA_P, HOP_SAFE_CLOSURE_AA_P, OP_SAFE_CLOSURE_AA_A, HOP_SAFE_CLOSURE_AA_A, + + OP_CLOSURE_ALL_X, HOP_CLOSURE_ALL_X, OP_CLOSURE_ALL_S, HOP_CLOSURE_ALL_S, OP_CLOSURE_ANY_ALL_X, HOP_CLOSURE_ANY_ALL_X, + OP_SAFE_CLOSURE_SA, HOP_SAFE_CLOSURE_SA, OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA, OP_SAFE_CLOSURE_ALL_X, HOP_SAFE_CLOSURE_ALL_X, + + OP_CLOSURE_STAR_A, HOP_CLOSURE_STAR_A, OP_CLOSURE_STAR_ALL_X, HOP_CLOSURE_STAR_ALL_X, OP_SAFE_CLOSURE_STAR_A, HOP_SAFE_CLOSURE_STAR_A, OP_SAFE_CLOSURE_STAR_AA, HOP_SAFE_CLOSURE_STAR_AA, OP_SAFE_CLOSURE_STAR_ALL_X, HOP_SAFE_CLOSURE_STAR_ALL_X, @@ -3526,41 +3691,36 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, /* these can't be embedded, and have to be the last thing called */ OP_APPLY_SS, HOP_APPLY_SS, OP_C_ALL_X, HOP_C_ALL_X, OP_CALL_WITH_EXIT, HOP_CALL_WITH_EXIT, OP_CALL_WITH_EXIT_P, HOP_CALL_WITH_EXIT_P, - OP_C_CATCH, HOP_C_CATCH, OP_C_CATCH_ALL, HOP_C_CATCH_ALL, OP_C_CATCH_ALL_Z, HOP_C_CATCH_ALL_Z, + OP_C_CATCH, HOP_C_CATCH, OP_C_CATCH_ALL, HOP_C_CATCH_ALL, OP_C_CATCH_ALL_P, HOP_C_CATCH_ALL_P, OP_C_S_opSq, HOP_C_S_opSq, OP_C_S_opCq, HOP_C_S_opCq, OP_C_SS, HOP_C_SS, - OP_C_S, HOP_C_S, OP_READ_S, HOP_READ_S, OP_C_P, HOP_C_P, OP_C_Z, HOP_C_Z, OP_C_AP, HOP_C_AP, OP_NOT_P, HOP_NOT_P, + OP_C_S, HOP_C_S, OP_READ_S, HOP_READ_S, OP_C_P, HOP_C_P, OP_C_AP, HOP_C_AP, OP_NOT_P, HOP_NOT_P, OP_C_A, HOP_C_A, OP_C_SCS, HOP_C_SCS, OP_C_FA, HOP_C_FA, OP_C_AA, HOP_C_AA, OP_C_FA_1, HOP_C_FA_1, OP_GOTO, HOP_GOTO, OP_GOTO_C, HOP_GOTO_C, OP_GOTO_S, HOP_GOTO_S, OP_GOTO_A, HOP_GOTO_A, - OP_ITERATE, HOP_ITERATE, - OP_CONTINUATION_A, HOP_CONTINUATION_A, - OP_VECTOR_A, HOP_VECTOR_A, - OP_STRING_A, HOP_STRING_A, - OP_C_OBJECT_A, HOP_C_OBJECT_A, OP_PAIR_A, HOP_PAIR_A, OP_HASH_TABLE_A, HOP_HASH_TABLE_A, - OP_ENVIRONMENT_Q, HOP_ENVIRONMENT_Q, OP_ENVIRONMENT_A, HOP_ENVIRONMENT_A, - - OP_UNKNOWN, HOP_UNKNOWN, OP_UNKNOWN_ALL_S, HOP_UNKNOWN_ALL_S, OP_UNKNOWN_ALL_X, HOP_UNKNOWN_ALL_X, - OP_UNKNOWN_G, HOP_UNKNOWN_G, OP_UNKNOWN_GG, HOP_UNKNOWN_GG, OP_UNKNOWN_A, HOP_UNKNOWN_A, OP_UNKNOWN_AA, HOP_UNKNOWN_AA, OP_SAFE_C_PP, HOP_SAFE_C_PP, OP_SAFE_C_opSq_P, HOP_SAFE_C_opSq_P, - OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_QP, HOP_SAFE_C_QP, OP_SAFE_C_AP, HOP_SAFE_C_AP, + OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_QP, HOP_SAFE_C_QP, + OP_SAFE_C_AP, HOP_SAFE_C_AP, OP_SAFE_C_PA, HOP_SAFE_C_PA, OP_SAFE_C_PS, HOP_SAFE_C_PS, OP_SAFE_C_PC, HOP_SAFE_C_PC, OP_SAFE_C_PQ, HOP_SAFE_C_PQ, OP_SAFE_C_AAP, HOP_SAFE_C_AAP, - OP_S, HOP_S, OP_S_S, HOP_S_S, OP_S_C, HOP_S_C, OP_S_A, HOP_S_A, + OP_S, OP_S_S, OP_S_C, OP_S_A, + OP_ITERATE, OP_CONTINUATION_A, OP_VECTOR_A, OP_STRING_A, OP_C_OBJECT_A, OP_PAIR_A, OP_HASH_TABLE_A, OP_ENVIRONMENT_Q, OP_ENVIRONMENT_A, + OP_UNKNOWN, OP_UNKNOWN_ALL_S, OP_UNKNOWN_ALL_X, OP_UNKNOWN_G, OP_UNKNOWN_GG, OP_UNKNOWN_A, OP_UNKNOWN_AA, + OP_SAFE_THUNK_LP, OP_SAFE_CLOSURE_A_LP, OP_SAFE_CLOSURE_AA_LP, OP_SAFE_CLOSURE_S_LP, OP_SAFE_CLOSURE_SS_LP, OP_NO_OP, OP_GC_PROTECT, OP_READ_INTERNAL, OP_EVAL, OP_EVAL_ARGS, OP_EVAL_ARGS1, OP_EVAL_ARGS2, OP_EVAL_ARGS3, OP_EVAL_ARGS4, OP_EVAL_ARGS5, OP_APPLY, OP_EVAL_MACRO, OP_LAMBDA, OP_QUOTE, OP_MACROEXPAND, - OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN1, OP_BEGIN2, + OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN0, OP_BEGIN1, OP_BEGIN_UNCHECKED, OP_IF, OP_IF1, OP_WHEN, OP_WHEN1, OP_UNLESS, OP_UNLESS1, OP_SET, OP_SET1, OP_SET2, OP_LET, OP_LET1, OP_LET_STAR, OP_LET_STAR1, OP_LET_STAR2, OP_LETREC, OP_LETREC1, OP_LETREC_STAR, OP_LETREC_STAR1, OP_LET_TEMPORARILY, OP_LET_TEMP_UNCHECKED, OP_LET_TEMP_INIT1, OP_LET_TEMP_INIT2, OP_LET_TEMP_DONE, OP_LET_TEMP_DONE1, - OP_COND, OP_COND1, OP_COND1_1, OP_COND_SIMPLE, OP_COND1_SIMPLE, OP_COND_UNCHECKED_Z, + OP_COND, OP_COND1, OP_COND1_1, OP_COND_SIMPLE, OP_COND1_SIMPLE, OP_COND_SIMPLE_P, OP_COND1_SIMPLE_P, OP_AND, OP_AND1, OP_OR, OP_OR1, OP_DEFINE_MACRO, OP_DEFINE_MACRO_STAR, OP_DEFINE_EXPANSION, OP_CASE, @@ -3585,10 +3745,11 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_MEMBER_IF, OP_ASSOC_IF, OP_MEMBER_IF1, OP_ASSOC_IF1, OP_QUOTE_UNCHECKED, OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, OP_CASE_UNCHECKED, OP_WHEN_UNCHECKED, OP_UNLESS_UNCHECKED, + OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, - OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_S, OP_SET_SYMBOL_Q, OP_SET_SYMBOL_P, OP_SET_SYMBOL_Z, OP_SET_SYMBOL_A, + OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_S, OP_SET_SYMBOL_Q, OP_SET_SYMBOL_P, OP_SET_SYMBOL_A, OP_SET_SYMBOL_opSq, OP_SET_SYMBOL_opCq, OP_SET_SYMBOL_opSSq, OP_SET_SYMBOL_opSSSq, - OP_SET_NORMAL, OP_SET_PAIR, OP_SET_DILAMBDA, OP_SET_DILAMBDA_Z, OP_SET_DILAMBDA_Z_1, OP_SET_PAIR_Z, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA, + OP_SET_NORMAL, OP_SET_PAIR, OP_SET_DILAMBDA, OP_SET_DILAMBDA_Z, OP_SET_DILAMBDA_Z_1, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA, OP_SET_PAIR_P_1, OP_SET_WITH_SETTER, OP_SET_PWS, OP_SET_LET_S, OP_SET_LET_ALL_X, OP_SET_SAFE, OP_INCREMENT_1, OP_DECREMENT_1, OP_SET_CONS, @@ -3599,16 +3760,17 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_DEFINE_WITH_SETTER, OP_DEFINE_MACRO_WITH_SETTER, OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR, - OP_LET_C, OP_LET_S, OP_LET_S_Z, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_ALL_X, + OP_LET_C, OP_LET_S, OP_LET_S_P, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_ALL_X, OP_LET_STAR_ALL_X, OP_LET_STAR_A2, OP_LET_STAR_A, OP_LET_opCq, OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq_E, - OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_CAR, OP_LET_ONE, OP_LET_ONE_1, OP_LET_Z, OP_LET_Z_1, OP_LET_A, OP_LET_A_P, + OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_CAR, OP_LET_ONE, OP_LET_ONE_1, OP_LET_ONE_P, OP_LET_ONE_P_1, + OP_LET_Z, OP_LET_Z_1, OP_LET_A, OP_LET_A_P, OP_CASE_A_E_S, OP_CASE_A_I_S, OP_CASE_A_G_S, OP_CASE_A_E_G, OP_CASE_A_G_G, OP_CASE_S_E_S, OP_CASE_S_I_S, OP_CASE_S_G_S, OP_CASE_S_E_G, OP_CASE_S_G_G, OP_CASE_P_E_S, OP_CASE_P_I_S, OP_CASE_P_G_S, OP_CASE_P_E_G, OP_CASE_P_G_G, OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G, - OP_IF_UNCHECKED, OP_AND_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_AZ, OP_AND_SAFE_P, OP_AND_SAFE_AA, + OP_IF_UNCHECKED, OP_AND_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_SAFE_P, OP_AND_SAFE_AA, OP_OR_UNCHECKED, OP_OR_P, OP_OR_P1, OP_OR_AP, OP_OR_SAFE_P, OP_OR_SAFE_AA, OP_COND_FEED, OP_COND_FEED_1, OP_WHEN_S, OP_WHEN_A, OP_WHEN_P, OP_UNLESS_S, OP_UNLESS_A, @@ -3625,34 +3787,32 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_IF_A_P, OP_IF_A_P_P, OP_IF_A_R, OP_IF_A_N, OP_IF_A_N_N, OP_IF_AND2_P, OP_IF_AND2_P_P, OP_IF_AND2_R, OP_IF_AND2_N, OP_IF_AND2_N_N, OP_IF_AND3_P, OP_IF_AND3_P_P, OP_IF_AND3_R, OP_IF_AND3_N, OP_IF_AND3_N_N, - OP_IF_Z_P, OP_IF_Z_P_P, OP_IF_Z_R, OP_IF_Z_N, OP_IF_Z_N_N, OP_IF_P_P, OP_IF_P_P_P, OP_IF_P_R, OP_IF_P_N, OP_IF_P_N_N, OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ANDP_R, OP_IF_ANDP_N, OP_IF_ANDP_N_N, OP_IF_ORP_P, OP_IF_ORP_P_P, OP_IF_ORP_R, OP_IF_ORP_N, OP_IF_ORP_N_N, OP_IF_OR2_P, OP_IF_OR2_P_P, OP_IF_OR2_R, OP_IF_OR2_N, OP_IF_OR2_N_N, OP_IF_PPP, OP_IF_PP, OP_IF_PR, OP_IF_PRR, - OP_WHEN_PP, + OP_WHEN_PP, - OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, OP_COND_ALL_X, OP_COND_ALL_X_2, OP_COND_ALL_X_Z, + OP_COND_ALL_X, OP_COND_ALL_X_2, OP_COND_ALL_X_P, OP_SIMPLE_DO, OP_SIMPLE_DO_STEP, OP_SAFE_DOTIMES, OP_SAFE_DOTIMES_STEP, OP_SAFE_DOTIMES_STEP_P, OP_SAFE_DOTIMES_STEP_O, OP_SAFE_DO, OP_SAFE_DO_STEP, OP_DOX, OP_DOX_STEP, OP_DOX_STEP_P, OP_DOTIMES_P, OP_DOTIMES_STEP_P, OP_DO_NO_VARS, OP_DO_NO_VARS_NO_OPT, OP_DO_NO_VARS_NO_OPT_1, - OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_3, OP_SAFE_C_PP_5, OP_SAFE_C_PP_6, - OP_EVAL_ARGS_P_2, OP_EVAL_ARGS_P_2_MV, OP_EVAL_ARGS_P_3, OP_EVAL_ARGS_P_4, OP_EVAL_ARGS_P_3_MV, OP_EVAL_ARGS_P_4_MV, - OP_EVAL_ARGS_AAP_1, OP_EVAL_ARGS_AAP_MV, OP_EVAL_MACRO_MV, OP_MACROEXPAND_1, OP_APPLY_LAMBDA, + OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_3_MV, OP_SAFE_C_PP_5, OP_SAFE_C_PP_6_MV, + OP_SAFE_C_SP_1, OP_SAFE_C_SP_MV, OP_SAFE_C_PS_1, OP_SAFE_C_PC_1, OP_SAFE_C_PS_MV, OP_SAFE_C_PC_MV, + OP_SAFE_C_AAP_1, OP_SAFE_C_AAP_MV, OP_EVAL_MACRO_MV, OP_MACROEXPAND_1, OP_APPLY_LAMBDA, OP_SAFE_CLOSURE_P_1, OP_CLOSURE_P_1, OP_SAFE_CLOSURE_AP_1, OP_SAFE_CLOSURE_PA_1, - OP_SAFE_C_ZZ_1, OP_SAFE_C_ZA_1, OP_INCREMENT_SZ_1, OP_SAFE_C_SZ_SZ, - OP_SAFE_C_ZAA_1, OP_SAFE_C_AZA_1, OP_SAFE_C_AAZ_1, - OP_SAFE_C_ZZA_1, OP_SAFE_C_ZZA_2, OP_SAFE_C_ZAZ_1, OP_SAFE_C_AZZ_1, OP_SAFE_C_AZZ_2, - OP_SAFE_C_ZZZ_1, OP_SAFE_C_ZZZ_2, - OP_C_P_1, OP_C_P_2, OP_C_AP_1, OP_NOT_P_1, + OP_INCREMENT_SZ_1, + OP_SAFE_C_ZZZ_1, OP_SAFE_C_ZZZ_2, OP_SAFE_C_ZZZ_3, + OP_C_P_1, OP_C_P_MV, OP_C_AP_1, OP_NOT_P_1, OP_CLOSURE_AP_1, OP_CLOSURE_PA_1, OP_CLOSURE_P_MV, OP_CLOSURE_AP_MV, OP_CLOSURE_PA_MV, + OP_SAFE_C_PA_1, OP_SAFE_C_PA_MV, - OP_SET_WITH_LET_1, OP_SET_WITH_LET_2, + OP_SET_WITH_LET_1, OP_SET_WITH_LET_2, OP_S7_LET, OP_MAX_DEFINED_1}; #define OP_MAX_DEFINED (OP_MAX_DEFINED_1 + 1) @@ -3712,82 +3872,76 @@ static const char* op_names[OP_MAX_DEFINED_1] = "safe_c_s_opaq", "h_safe_c_s_opaq", "safe_c_opaq_s", "h_safe_c_opaq_s", "safe_c_s_opaaq", "h_safe_c_s_opaaq", "safe_c_s_opaaaq", "h_safe_c_s_opaaaq", "safe_ifa_ss_a", "h_safe_ifa_ss_a", - "safe_c*_a", "h_safe_c*_a", "safe_c*_aa", "h_safe_c*_aa", "safe_c*_all_x", "h_safe_c*_all_x", + "safe_c*", "h_safe_c*", "safe_c*_a", "h_safe_c*_a", "safe_c*_aa", "h_safe_c*_aa", "safe_c*_all_x", "h_safe_c*_all_x", - "safe_quote", "h_safe_quote", "safe_c_p", "h_safe_c_p", + "safe_quote", "h_safe_quote", "safe_c_p", "h_safe_c_p", "safe_c_zzz", "h_safe_c_zzz", - "safe_c_z", "h_safe_c_z", "safe_c_zz", "h_safe_c_zz", "safe_c_sz", "h_safe_c_sz", "safe_c_zs", "h_safe_c_zs", - "safe_c_cz", "h_safe_c_cz", "safe_c_zc", "h_safe_c_zc", "safe_c_zq", "h_safe_c_zq", - "safe_c_opcq_z", "h_safe_c_opcq_z", "safe_c_s_opszq", "h_safe_c_s_opszq", - "safe_c_az", "h_safe_c_az", "safe_c_za", "h_safe_c_za", - "safe_c_zaa", "h_safe_c_zaa", "safe_c_aza", "h_safe_c_aza", "safe_c_aaz", "h_safe_c_aaz", - "safe_c_zza", "h_safe_c_zza", "safe_c_zaz", "h_safe_c_zaz", "safe_c_azz", "h_safe_c_azz", - "safe_c_zzz", "h_safe_c_zzz", + "thunk", "h_thunk", "thunk_p", "h_thunk_p", + "safe_thunk", "h_safe_thunk", "safe_thunk_p", "h_safe_thunk_p", "safe_thunk_a", "h_safe_thunk_a", - "thunk", "h_thunk", - "closure_s", "h_closure_s", "closure_c", "h_closure_c", "closure_p", "h_closure_p", "closure_s_1", "h_closure_s_1", - "closure_ss", "h_closure_ss", "closure_ss_p", "h_closure_ss_p", - "closure_sc", "h_closure_sc", "closure_cs", "h_closure_cs", - "closure_a", "h_closure_a", "closure_aa", "h_closure_aa", "closure_a_p", "h_closure_a_p", "closure_aa_p", "h_closure_aa_p", - "closure_all_x", "h_closure_all_x", "closure_all_s", "h_closure_all_s", "closure_all_s_p", "h_closure_all_s_p", - "closure_fa", "h_closure_fa", - "closure_ap", "h_closure_ap", "closure_pa", "h_closure_pa", - "closure_any_all_x", "h_closure_any_all_x", + "closure_s", "h_closure_s", "closure_s_p", "h_closure_s_p", + "safe_closure_s", "h_safe_closure_s", "safe_closure_s_p", "h_safe_closure_s_p", "safe_closure_s_a", "h_safe_closure_s_a", + "closure_c", "h_closure_c", "closure_c_p", "h_closure_c_p", + "safe_closure_c", "h_safe_closure_c", "safe_closure_c_p", "h_safe_closure_c_p", "safe_closure_c_a", "h_safe_closure_c_a", - "closure*_a", "h_closure*_a", "closure*_all_x", "h_closure*_all_x", + "closure_a", "h_closure_a", "closure_a_p", "h_closure_a_p", + "safe_closure_a", "h_safe_closure_a", "safe_closure_a_p", "h_safe_closure_a_p", "safe_closure_a_a", "h_safe_closure_a_a", - "safe_thunk", "h_safe_thunk", "safe_thunk_p", "h_safe_thunk_p", - "safe_closure_s", "h_safe_closure_s", "safe_closure_s_p", "h_safe_closure_s_p", - "safe_closure_s_c", "h_safe_closure_s_c", "safe_closure_s_l", "h_safe_closure_s_l", - "safe_closure_c", "h_safe_closure_c", "safe_closure_p", "h_safe_closure_p", - "safe_closure_a", "h_safe_closure_a", "safe_lclosure_a", "h_safe_lclosure_a", "safe_closure_a_c", "h_safe_closure_a_c", - "safe_closure_ss", "h_safe_closure_ss", "safe_closure_ss_b", "h_safe_closure_ss_b", - "safe_closure_sc", "h_safe_closure_sc", "safe_closure_cs", "h_safe_closure_cs", - "safe_closure_sa", "h_safe_closure_sa", - "safe_closure_saa", "h_safe_closure_saa", - "safe_closure_all_x", "h_safe_closure_all_x", "safe_closure_aa", "h_safe_closure_aa", "safe_closure_aa_p", "h_safe_closure_aa_p", + "closure_p", "h_closure_p", "safe_closure_p", "h_safe_closure_p", + "closure_ap", "h_closure_ap", "closure_pa", "h_closure_pa", "safe_closure_ap", "h_safe_closure_ap", "safe_closure_pa", "h_safe_closure_pa", + "closure_fa", "h_closure_fa", + + "closure_ss", "h_closure_ss", "closure_ss_p", "h_closure_ss_p", + "safe_closure_ss", "h_safe_closure_ss", "safe_closure_ss_p", "h_safe_closure_ss_p", "safe_closure_ss_a", "h_safe_closure_ss_a", + "closure_sc", "h_closure_sc", "closure_sc_p", "h_closure_sc_p", + "safe_closure_sc", "h_safe_closure_sc", "safe_closure_sc_p", "h_safe_closure_sc_p", + "closure_cs", "h_closure_cs", "closure_cs_p", "h_closure_cs_p", + "safe_closure_cs", "h_safe_closure_cs", "safe_closure_cs_p", "h_safe_closure_cs_p", + + "closure_aa", "h_closure_aa", "closure_aa_p", "h_closure_aa_p", + "safe_closure_aa", "h_safe_closure_aa", "safe_closure_aa_p", "h_safe_closure_aa_p", "safe_closure_aa_a", "h_safe_closure_aa_a", + + "closure_all_x", "h_closure_all_x", "closure_all_s", "h_closure_all_s", "closure_any_all_x", "h_closure_any_all_x", + + "safe_closure_sa", "h_safe_closure_sa", "safe_closure_saa", "h_safe_closure_saa", "safe_closure_all_x", "h_safe_closure_all_x", + "closure*_a", "h_closure*_a", "closure*_all_x", "h_closure*_all_x", "safe_closure*_a", "h_safe_closure*_a", "safe_closure*_aa", "h_safe_closure*_aa", "safe_closure*_all_x", "h_safe_closure*_all_x", "apply_ss", "h_apply_ss", "c_all_x", "h_c_all_x", "call_with_exit", "h_call_with_exit", "call_with_exit_p", "h_call_with_exit_p", - "c_catch", "h_c_catch", "c_catch_all", "h_c_catch_all", "c_catch_all_z", "h_c_catch_all_z", + "c_catch", "h_c_catch", "c_catch_all", "h_c_catch_all", "c_catch_all_p", "h_c_catch_all_p", "c_s_opsq", "h_c_s_opsq", "c_s_opcq", "h_c_s_opcq", "c_ss", "h_c_ss", - "c_s", "h_c_s", "read_s", "h_read_s", "c_p", "h_c_p", "c_z", "h_c_z", "c_ap", "h_c_ap", "c_not", "h_c_not", + "c_s", "h_c_s", "read_s", "h_read_s", "c_p", "h_c_p", "c_ap", "h_c_ap", "c_not", "h_c_not", "c_a", "h_c_a", "c_scs", "h_c_scs", "c_fa", "h_c_fa", "c_aa", "h_c_aa", "c_fa_1", "h_c_fa_1", "goto", "h_goto", "goto_c", "h_goto_c", "goto_s", "h_goto_s", "goto_a", "h_goto_a", - "iterate", "h_iterate", - "continuation_a", "h_continuation_a", - "vector_a", "h_vector_a", - "string_a", "h_string_a", - "c_object_a", "h_c_object_a", "pair_a", "h_pair_a", "hash_table_a", "h_hash_table_a", - "environment_q", "h_environment_q", "environment_a", "h_environment_a", - - "unknown", "h_unknown", "unknown_all_s", "h_unknown_all_s", "unknown_all_x", "h_unknown_all_x", - "unknown_g", "h_unknown_g", "unknown_gg", "h_unknown_gg", "unknown_a", "h_unknown_a", "unknown_aa", "h_unknown_aa", "safe_c_pp", "h_safe_c_pp", "safe_c_opsq_p", "h_safe_c_opsq_p", - "safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", "safe_c_qp", "h_safe_c_qp", "safe_c_ap", "h_safe_c_ap", + "safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", "safe_c_qp", "h_safe_c_qp", + "safe_c_ap", "h_safe_c_ap", "safe_c_pa", "h_safe_c_pa", "safe_c_ps", "h_safe_c_ps", "safe_c_pc", "h_safe_c_pc", "safe_c_pq", "h_safe_c_pq", "safe_c_aap", "h_safe_c_aap", - "s", "h_s", "s_s", "h_s_s", "s_c", "h_s_c", "s_a", "h_s_a", + "s", "s_s", "s_c", "s_a", + "iterate", "continuation_a", "vector_a", "string_a", "c_object_a", "pair_a", "hash_table_a", "environment_q", "environment_a", + "unknown", "unknown_all_s", "unknown_all_x", "unknown_g", "unknown_gg", "unknown_a", "unknown_aa", + "safe_thunk_lp", "safe_closure_a_lp", "safe_closure_aa_lp", "safe_closure_s_lp", "safe_closure_ss_lp", "no_op", "gc_protect", "read_internal", "eval", "eval_args", "eval_args1", "eval_args2", "eval_args3", "eval_args4", "eval_args5", "apply", "eval_macro", "lambda", "quote", "macroexpand", - "define", "define1", "begin", "begin1", "begin2", + "define", "define1", "begin", "begin0", "begin1", "begin_unchecked", "if", "if1", "when", "when1", "unless", "unless1", "set", "set1", "set2", "let", "let1", "let*", "let*1", "let*2", "letrec", "letrec1", "letrec*", "letrec*1", "let_temporarily", "let_temp_unchecked", "let_temp_init1", "let_temp_init2", "let_temp_done", "let_temp_done1", - "cond", "cond1", "cond1_1", "cond_simple", "cond1_simple", "cond_unchecked_z", + "cond", "cond1", "cond1_1", "cond_simple", "cond1_simple", "cond_simple_p", "cond1_simple_p", "and", "and1", "or", "or1", "define_macro", "define_macro*", "define_expansion", "case", "read_list", "read_next", "read_dot", "read_quote", @@ -3811,11 +3965,12 @@ static const char* op_names[OP_MAX_DEFINED_1] = "member_if", "assoc_if", "member_if1", "assoc_if1", "quote_unchecked", "lambda_unchecked", "let_unchecked", "case_unchecked", "when_unchecked", "unless_unchecked", + "catch_1", "catch_2", "catch_all", - "set_unchecked", "set_symbol_c", "set_symbol_s", "set_symbol_q", "set_symbol_p", "set_symbol_z", "set_symbol_a", + "set_unchecked", "set_symbol_c", "set_symbol_s", "set_symbol_q", "set_symbol_p", "set_symbol_a", "set_symbol_opsq", "set_symbol_opcq", "set_symbol_opssq", "set_symbol_opsssq", "set_normal", "set_pair", "set_dilambda", "set_dilambda_z", "set_dilambda_z_1", - "set_pair_z", "set_pair_a", "set_pair_p", "set_pair_za", + "set_pair_a", "set_pair_p", "set_pair_za", "set_pair_p_1", "set_with_setter", "set_pws", "set_let_s", "set_let_all_x", "set_safe", "increment_1", "decrement_1", "set_cons", @@ -3826,16 +3981,17 @@ static const char* op_names[OP_MAX_DEFINED_1] = "define_with_setter", "define_macro_with_setter", "let_no_vars", "named_let", "named_let_no_vars", "named_let*", - "let_c", "let_s", "let_s_z", "let_all_c", "let_all_s", "let_all_x", + "let_c", "let_s", "let_s_p", "let_all_c", "let_all_s", "let_all_x", "let*_all_x", "let*_a2", "let*_a", "let_opcq", "let_opssq", "let_opssq_e", "let_opassq_e", - "let_opsq", "let_all_opsq", "let_opsq_p", "let_car", "let_one", "let_one_1", "let_z", "let_z_1", "let_a", "let_a_p", + "let_opsq", "let_all_opsq", "let_opsq_p", "let_car", "let_one", "let_one_1", "let_one_p", "let_one_p_1", + "let_z", "let_z_1", "let_a", "let_a_p", "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g", "case_s_e_s", "case_s_i_s", "case_s_g_s", "case_s_e_g", "case_s_g_g", "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g", "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g", - "if_unchecked", "and_unchecked", "and_p", "and_p1", "and_ap", "and_az", "and_safe_p", "and_safe_aa", + "if_unchecked", "and_unchecked", "and_p", "and_p1", "and_ap", "and_safe_p", "and_safe_aa", "or_unchecked", "or_p", "or_p1", "or_ap", "or_safe_p", "or_safe_aa", "cond_feed", "cond_feed_1", "when_s", "when_a", "when_p", "unless_s", "unless_a", @@ -3852,45 +4008,43 @@ static const char* op_names[OP_MAX_DEFINED_1] = "if_a_p", "if_a_p_p", "if_a_r", "if_a_n", "if_a_n_n", "if_and2_p", "if_and2_p_p", "if_and2_r","if_and2_n", "if_and2_n_n", "if_and3_p", "if_and3_p_p", "if_and3_r","if_and3_n", "if_and3_n_n", - "if_z_p", "if_z_p_p", "if_z_r", "if_z_n", "if_z_n_n", "if_p_p", "if_p_p_p", "if_p_r", "if_p_n", "if_p_n_n", "if_andp_p", "if_andp_p_p", "if_andp_r", "if_andp_n", "if_andp_n_n", "if_orp_p", "if_orp_p_p", "if_orp_r","if_orp_n", "if_orp_n_n", "if_or2_p", "if_or2_p_p", "if_or2_r","if_or2_n", "if_or2_n_n", "if_ppp", "if_pp", "if_pr", "if_prr", - "when_pp", + "when_pp", - "catch_1", "catch_2", "catch_all", "cond_all_x", "cond_all_x_2", "cond_all_x_z", + "cond_all_x", "cond_all_x_2", "cond_all_x_p", "simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_p", "safe_dotimes_step_o", "safe_do", "safe_do_step", "dox", "dox_step", "dox_step_p", "dotimes_p", "dotimes_step_p", "do_no_vars", "do_no_vars_no_opt", "do_no_vars_no_opt_1", - "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_3", "safe_c_pp_5", "safe_c_pp_6", - "eval_args_p_2", "eval_args_p_2_mv", "eval_args_p_3", "eval_args_p_4", "eval_args_p_3_mv", "eval_args_p_4_mv", - "eval_args_aap_1", "eval_args_aap_mv", "eval_macro_mv", "macroexpand_1", "apply_lambda", + "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_3_mv", "safe_c_pp_5", "safe_c_pp_6_mv", + "safe_c_sp_1", "safe_c_sp_mv", "safe_c_ps_1", "safe_c_pc_1", "safe_c_ps_mv", "safe_c_pc_mv", + "safe_c_aap_1", "safe_c_aap_mv", "eval_macro_mv", "macroexpand_1", "apply_lambda", "safe_closure_p_1", "closure_p_1", "safe_closure_ap_1", "safe_closure_pa_1", - "safe_c_zz_1", "safe_c_za_1", "increment_sz_1", "safe_c_sz_sz", - "safe_c_zaa_1", "safe_c_aza_1", "safe_c_aaz_1", - "safe_c_zza_1", "safe_c_zza_2", "safe_c_zaz_1", "safe_c_azz_1", "safe_c_azz_2", - "safe_c_zzz_1", "safe_c_zzz_2", - "c_p_1", "c_p_2", "c_ap_1", "not_1", + "increment_sz_1", + "safe_c_zzz_1", "safe_c_zzz_2", "safe_c_zzz_3", + "c_p_1", "c_p_mv", "c_ap_1", "not_1", "closure_ap_1", "closure_pa_1", "closure_p_mv", "closure_ap_mv", "closure_pa_mv", + "safe_c_pa_1", "safe_c_pa_mv", - "set_with_let_1", "set_with_let_2", + "set_with_let_1", "set_with_let_2", "*s7*", }; #endif -#define opt_names op_names +#define op_names op_names #define OPT_MAX_DEFINED OP_NO_OP #define in_reader(Sc) ((sc->cur_op >= OP_READ_LIST) && (sc->cur_op <= OP_READ_DONE) && (is_input_port(Sc->input_port))) #define is_safe_c_op(op) ((op >= OP_SAFE_C_C) && (op < OP_THUNK)) -#define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op < OP_SAFE_C_PP)) -#define is_callable_c_op(op) ((is_safe_c_op(op)) || (op > OP_UNKNOWN_AA)) /* used only in check_set */ +#define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op <= OP_UNKNOWN_AA)) +#define is_callable_c_op(op) ((is_safe_c_op(op)) || (op >= OP_SAFE_C_PP)) /* used only in check_set */ static bool is_h_optimized(s7_pointer p) { @@ -3980,7 +4134,7 @@ static s7_pointer set_plist_1(s7_scheme *sc, s7_pointer x1) static s7_pointer set_plist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2) { set_car(sc->plist_2, x1); - set_cadr(sc->plist_2, x2); + set_car(sc->plist_2_2, x2); return(sc->plist_2); } @@ -3991,6 +4145,12 @@ static s7_pointer set_qlist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2) return(sc->qlist_2); } +static s7_pointer set_clist_1(s7_scheme *sc, s7_pointer x1) +{ + set_car(sc->clist_1, x1); + return(sc->clist_1); +} + static s7_pointer set_plist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3) { return(set_wlist_3(sc->plist_3, x1, x2, x3)); @@ -4147,56 +4307,55 @@ static s7_pointer method_or_bust_with_type_one_arg(s7_scheme *sc, s7_pointer obj /* -------------------------------- constants -------------------------------- */ -/* #f and #t */ s7_pointer s7_f(s7_scheme *sc) {return(sc->F);} s7_pointer s7_t(s7_scheme *sc) {return(sc->T);} -/* () */ -s7_pointer s7_nil(s7_scheme *sc) {return(sc->nil);} +s7_pointer s7_nil(s7_scheme *sc) {return(sc->nil);} bool s7_is_null(s7_scheme *sc, s7_pointer p) {return(is_null(p));} -static bool is_null_b(s7_pointer p) {return(type(p) == T_NIL);} +static bool is_null_b(s7_pointer p) {return(type(p) == T_NIL);} -/* #<undefined> and #<unspecified> */ -s7_pointer s7_undefined(s7_scheme *sc) {return(sc->undefined);} -s7_pointer s7_unspecified(s7_scheme *sc) {return(sc->unspecified);} +s7_pointer s7_undefined(s7_scheme *sc) {return(sc->undefined);} +s7_pointer s7_unspecified(s7_scheme *sc) {return(sc->unspecified);} bool s7_is_unspecified(s7_scheme *sc, s7_pointer val) {return(is_unspecified(val));} static s7_pointer g_is_undefined(s7_scheme *sc, s7_pointer args) { #define H_is_undefined "(undefined? val) returns #t if val is #<undefined> or its reader equivalent" - #define Q_is_undefined pl_bt + #define Q_is_undefined sc->pl_bt check_boolean_method(sc, is_undefined, sc->is_undefined_symbol, args); } static s7_pointer g_is_unspecified(s7_scheme *sc, s7_pointer args) { #define H_is_unspecified "(unspecified? val) returns #t if val is #<unspecified>" - #define Q_is_unspecified pl_bt + #define Q_is_unspecified sc->pl_bt check_boolean_method(sc, is_unspecified, sc->is_unspecified_symbol, args); } /* #<eof> */ -s7_pointer s7_eof_object(s7_scheme *sc) {return(sc->eof_object);} +s7_pointer eof_object = NULL; + +s7_pointer s7_eof_object(s7_scheme *sc) {return(eof_object);} static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args) { #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object" - #define Q_is_eof_object pl_bt + #define Q_is_eof_object sc->pl_bt check_boolean_method(sc, is_eof, sc->is_eof_object_symbol, args); } -static bool s7_is_eof_object(s7_pointer p) {return(p == cur_sc->eof_object);} +static bool s7_is_eof_object(s7_pointer p) {return(p == eof_object);} static s7_pointer g_not(s7_scheme *sc, s7_pointer args) { #define H_not "(not obj) returns #t if obj is #f, otherwise #t: (not ()) -> #f" - #define Q_not pl_bt + #define Q_not sc->pl_bt return(make_boolean(sc, is_false(sc, car(args)))); } -static bool not_b(s7_pointer p) {return(p == cur_sc->F);} +static bool not_b_7p(s7_scheme *sc, s7_pointer p) {return(p == sc->F);} bool s7_boolean(s7_scheme *sc, s7_pointer x) { @@ -4216,7 +4375,7 @@ s7_pointer s7_make_boolean(s7_scheme *sc, bool x) static s7_pointer g_is_boolean(s7_scheme *sc, s7_pointer args) { #define H_is_boolean "(boolean? obj) returns #t if obj is #f or #t: (boolean? ()) -> #f" - #define Q_is_boolean pl_bt + #define Q_is_boolean sc->pl_bt check_boolean_method(sc, s7_is_boolean, sc->is_boolean_symbol, args); } @@ -4239,7 +4398,7 @@ static bool is_constant_symbol(s7_scheme *sc, s7_pointer sym) static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args) { #define H_is_constant "(constant? obj) returns #t if obj either evaluates to itself, or is a symbol whose binding is constant" - #define Q_is_constant pl_bt + #define Q_is_constant sc->pl_bt return(make_boolean(sc, is_constant(sc, car(args)))); } @@ -4256,7 +4415,7 @@ s7_pointer s7_immutable(s7_pointer p) static s7_pointer g_immutable(s7_scheme *sc, s7_pointer args) { - #define H_immutable "(immutable! sequence) declares that the sequence's entries can't be changed. The sequence is returned. (This function is work-in-progress)" + #define H_immutable "(immutable! sequence) declares that the sequence's entries can't be changed. The sequence is returned." #define Q_immutable s7_make_signature(sc, 2, sc->T, sc->T) s7_pointer p; p = car(args); @@ -4276,7 +4435,7 @@ static s7_pointer g_immutable(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_immutable(s7_scheme *sc, s7_pointer args) { #define H_is_immutable "(immutable? sequence) returns #t if the sequence is immutable. (This function is work-in-progress)" - #define Q_is_immutable pl_bt + #define Q_is_immutable sc->pl_bt return((is_immutable(car(args))) ? sc->T : sc->F); } @@ -4313,7 +4472,7 @@ static void resize_gc_protect(s7_scheme *sc) size = sc->protected_objects_size; new_size = 2 * size; ob = vector_block(sc->protected_objects); - nb = reallocate(ob, new_size * sizeof(s7_pointer)); + nb = reallocate(sc, ob, new_size * sizeof(s7_pointer)); block_info(nb) = NULL; vector_block(sc->protected_objects) = nb; vector_elements(sc->protected_objects) = (s7_pointer *)block_data(nb); @@ -4409,9 +4568,7 @@ static void mark_symbol(s7_pointer p) static void mark_noop(s7_pointer p) {} static void close_output_port(s7_scheme *sc, s7_pointer p); -#if S7_DEBUGGING -static void check_string_wrappers(void); -#endif +static void clear_weak_hash_table(s7_scheme *sc, s7_pointer table); static void sweep(s7_scheme *sc) { @@ -4420,9 +4577,6 @@ static void sweep(s7_scheme *sc) gc_list *gp; gp = sc->strings; -#if S7_DEBUGGING - check_string_wrappers(); -#endif if (gp->loc > 0) { /* unrolling this loop (even via LOOP_8) is not an improvement */ @@ -4430,7 +4584,7 @@ static void sweep(s7_scheme *sc) { s1 = gp->list[i]; if (is_free_and_clear(s1)) - liberate(string_or_byte_vector_block(s1)); + liberate(sc, string_or_byte_vector_block(s1)); else gp->list[j++] = s1; } gp->loc = j; @@ -4445,7 +4599,7 @@ static void sweep(s7_scheme *sc) if (is_free_and_clear(s1)) { remove_gensym_from_symbol_table(sc, s1); /* this uses symbol_name_cell data */ - liberate(gensym_block(s1)); + liberate(sc, gensym_block(s1)); } else gp->list[j++] = s1; } @@ -4486,7 +4640,7 @@ static void sweep(s7_scheme *sc) { s1 = gp->list[i]; if (is_free_and_clear(s1)) - liberate(c_function_block(s1)); + liberate(sc, c_function_block(s1)); else gp->list[j++] = s1; } gp->loc = j; @@ -4500,7 +4654,7 @@ static void sweep(s7_scheme *sc) s1 = gp->list[i]; if (is_free_and_clear(s1)) - liberate(vector_block(s1)); + liberate(sc, vector_block(s1)); else gp->list[j++] = s1; } gp->loc = j; @@ -4524,10 +4678,10 @@ static void sweep(s7_scheme *sc) free(vector_elements(s1)); vector_elements_should_be_freed(info) = false; } - liberate(info); + liberate(sc, info); vector_set_dimension_info(s1, NULL); } - liberate(vector_block(s1)); + liberate(sc, vector_block(s1)); } else gp->list[j++] = s1; } @@ -4541,8 +4695,13 @@ static void sweep(s7_scheme *sc) { s1 = gp->list[i]; if (is_free_and_clear(s1)) - free_hash_table(s1); - else gp->list[j++] = s1; + free_hash_table(sc, s1); + else + { + if (is_weak_hash_table(s1)) + clear_weak_hash_table(sc, s1); + gp->list[j++] = s1; + } } gp->loc = j; } @@ -4579,7 +4738,7 @@ static void sweep(s7_scheme *sc) { if (port_data(s1)) { - liberate(port_data_block(s1)); + liberate(sc, port_data_block(s1)); port_data_block(s1) = NULL; port_data(s1) = NULL; port_data_size(s1) = 0; @@ -4588,10 +4747,10 @@ static void sweep(s7_scheme *sc) } if (port_filename(s1)) { - liberate(port_filename_block(s1)); + liberate(sc, port_filename_block(s1)); port_filename(s1) = NULL; } - liberate(port_block(s1)); + liberate(sc, port_block(s1)); } else gp->list[j++] = s1; } @@ -4607,12 +4766,12 @@ static void sweep(s7_scheme *sc) if (is_free_and_clear(s1)) { close_output_port(sc, s1); /* needed for free filename, etc */ - liberate(port_block(s1)); + liberate(sc, port_block(s1)); if (port_needs_free(s1)) { if (port_data_block(s1)) { - liberate(port_data_block(s1)); + liberate(sc, port_data_block(s1)); port_data_block(s1) = NULL; } port_needs_free(s1) = false; @@ -4636,13 +4795,50 @@ static void sweep(s7_scheme *sc) free(continuation_op_stack(s1)); continuation_op_stack(s1) = NULL; } - liberate_block(continuation_block(s1)); + liberate_block(sc, continuation_block(s1)); } else gp->list[j++] = s1; } gp->loc = j; } + gp = sc->optlists; + if (gp->loc > 0) + { + for (i = 0, j = 0; i < gp->loc; i++) + { + s1 = gp->list[i]; + if ((is_free_and_clear(s1)) && + (opt_any2_unchecked(s1))) + { + liberate(sc, (block_t *)opt_any2_unchecked(s1)); + set_opt_any2_unchecked(s1, NULL); + } + else gp->list[j++] = s1; + } + gp->loc = j; + } + + gp = sc->weak_refs; + if (gp->loc > 0) + { + for (i = 0, j = 0; i < gp->loc; i++) + { + s1 = gp->list[i]; + if (!is_free_and_clear(s1)) + { + if (is_free_and_clear(c_pointer_weak1(s1))) + c_pointer_weak1(s1) = sc->F; + if (is_free_and_clear(c_pointer_weak2(s1))) + c_pointer_weak2(s1) = sc->F; + if ((c_pointer_weak1(s1) != sc->F) || + (c_pointer_weak2(s1) != sc->F)) + gp->list[j++] = s1; + } + } + gp->loc = j; + } + #if WITH_GMP gp = sc->bigints; if (gp->loc > 0) @@ -4730,23 +4926,25 @@ static void add_gensym(s7_scheme *sc, s7_pointer p) } -#define add_c_object(sc, p) add_to_gc_list(sc->c_objects, p) -#define add_hash_table(sc, p) add_to_gc_list(sc->hash_tables, p) -#define add_string(sc, p) add_to_gc_list(sc->strings, p) -#define add_byte_vector(sc, p) add_to_gc_list(sc->strings, p) -#define add_input_port(sc, p) add_to_gc_list(sc->input_ports, p) -#define add_output_port(sc, p) add_to_gc_list(sc->output_ports, p) -#define add_continuation(sc, p) add_to_gc_list(sc->continuations, p) -#define add_unknown(sc, p) add_to_gc_list(sc->unknowns, p) -#define add_vector(sc, p) add_to_gc_list(sc->vectors, p) -#define add_multivector(sc, p) add_to_gc_list(sc->multivectors, p) -#define add_lambda(sc, p) add_to_gc_list(sc->lambdas, p) +#define add_c_object(sc, p) add_to_gc_list(sc->c_objects, p) +#define add_hash_table(sc, p) add_to_gc_list(sc->hash_tables, p) +#define add_string(sc, p) add_to_gc_list(sc->strings, p) +#define add_byte_vector(sc, p) add_to_gc_list(sc->strings, p) +#define add_input_port(sc, p) add_to_gc_list(sc->input_ports, p) +#define add_output_port(sc, p) add_to_gc_list(sc->output_ports, p) +#define add_continuation(sc, p) add_to_gc_list(sc->continuations, p) +#define add_unknown(sc, p) add_to_gc_list(sc->unknowns, p) +#define add_vector(sc, p) add_to_gc_list(sc->vectors, p) +#define add_multivector(sc, p) add_to_gc_list(sc->multivectors, p) +#define add_lambda(sc, p) add_to_gc_list(sc->lambdas, p) +#define add_optlist(sc, p) add_to_gc_list(sc->optlists, p) +#define add_weak_ref(sc, p) add_to_gc_list(sc->weak_refs, p) #if WITH_GMP -#define add_bigint(sc, p) add_to_gc_list(sc->bigints, p) -#define add_bigratio(sc, p) add_to_gc_list(sc->bigratios, p) -#define add_bigreal(sc, p) add_to_gc_list(sc->bigreals, p) -#define add_bignumber(sc, p) add_to_gc_list(sc->bignumbers, p) +#define add_bigint(sc, p) add_to_gc_list(sc->bigints, p) +#define add_bigratio(sc, p) add_to_gc_list(sc->bigratios, p) +#define add_bigreal(sc, p) add_to_gc_list(sc->bigreals, p) +#define add_bignumber(sc, p) add_to_gc_list(sc->bignumbers, p) #endif static void init_gc_caches(s7_scheme *sc) @@ -4762,6 +4960,8 @@ static void init_gc_caches(s7_scheme *sc) sc->continuations = make_gc_list(); sc->c_objects = make_gc_list(); sc->lambdas = make_gc_list(); + sc->optlists = make_gc_list(); + sc->weak_refs = make_gc_list(); #if WITH_GMP sc->bigints = make_gc_list(); sc->bigratios = make_gc_list(); @@ -4797,7 +4997,7 @@ static void add_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter) sc->setters_size *= 2; sc->setters = (s7_pointer *)realloc(sc->setters, sc->setters_size * sizeof(s7_pointer)); } - sc->setters[sc->setters_loc++] = permanent_cons(p, setter, T_PAIR | T_IMMUTABLE); + sc->setters[sc->setters_loc++] = permanent_cons(sc, p, setter, T_PAIR | T_IMMUTABLE); } static void mark_vector_1(s7_pointer p, s7_int top) @@ -4858,14 +5058,14 @@ static void just_mark(s7_pointer p) static void mark_c_pointer(s7_pointer p) { set_mark(p); - gc_mark(raw_pointer_type(p)); - gc_mark(raw_pointer_info(p)); + gc_mark(c_pointer_type(p)); + gc_mark(c_pointer_info(p)); } static void mark_c_proc_star(s7_pointer p) { set_mark(p); - if (!has_simple_defaults(p)) + if (!c_func_has_simple_defaults(p)) { s7_pointer arg; for (arg = c_function_call_args(p); is_pair(arg); arg = cdr(arg)) @@ -4952,21 +5152,21 @@ static void mark_vector_possibly_shared(s7_pointer p) { /* If a subvector (an inner dimension) of a vector is the only remaining reference * to the main vector, we want to make sure the main vector is not GC'd until - * the subvector is also GC-able. The shared_vector field either points to the + * the subvector is also GC-able. The subvector field either points to the * parent vector, or it is sc->F, so we need to check for a vector parent if * the current is multidimensional (this will include 1-dim slices). We need * to keep the parent case separate (i.e. sc->F means the current is the original) * so that we only free once (or remove_from_heap once). * - * If we have a shared-vector of a shared-vector, and the middle and original are not otherwise + * If we have a subvector of a subvector, and the middle and original are not otherwise * in use, we mark the middle one, but (since it itself is not in use anywhere else) * we don't mark the original! So we need to follow the share-vector chain marking every one. */ - if ((vector_has_dimensional_info(p)) && - (s7_is_vector(shared_vector(p)))) - mark_vector_possibly_shared(shared_vector(p)); + if ((is_subvector(p)) && + (s7_is_vector(subvector_vector(p)))) + mark_vector_possibly_shared(subvector_vector(p)); - /* mark_vector_1 does not check the marked bit, so if shared_vector below is in a cycle involving + /* mark_vector_1 does not check the marked bit, so if subvector below is in a cycle involving * the calling vector, we get infinite recursion unless we check the mark bit here. */ if (!is_marked(p)) @@ -4981,8 +5181,8 @@ static void mark_int_or_float_vector(s7_pointer p) static void mark_int_or_float_vector_possibly_shared(s7_pointer p) { if ((vector_has_dimensional_info(p)) && - (s7_is_vector(shared_vector(p)))) - mark_int_or_float_vector_possibly_shared(shared_vector(p)); + (s7_is_vector(subvector_vector(p)))) + mark_int_or_float_vector_possibly_shared(subvector_vector(p)); set_mark(p); } @@ -5021,18 +5221,32 @@ static void mark_hash_table(s7_pointer p) len = hash_table_mask(p) + 1; last = (hash_entry_t **)(entries + len); - while (entries < last) /* counting entries here was slightly faster */ + if (is_weak_hash_table(p)) { - hash_entry_t *xp; - for (xp = *entries++; xp; xp = hash_entry_next(xp)) + while (entries < last) { - gc_mark(hash_entry_key(xp)); - gc_mark(hash_entry_value(xp)); + hash_entry_t *xp; + for (xp = *entries++; xp; xp = hash_entry_next(xp)) + gc_mark(hash_entry_value(xp)); + for (xp = *entries++; xp; xp = hash_entry_next(xp)) + gc_mark(hash_entry_value(xp)); } - for (xp = *entries++; xp; xp = hash_entry_next(xp)) + } + else + { + while (entries < last) /* counting entries here was slightly faster */ { - gc_mark(hash_entry_key(xp)); - gc_mark(hash_entry_value(xp)); + hash_entry_t *xp; + for (xp = *entries++; xp; xp = hash_entry_next(xp)) + { + gc_mark(hash_entry_key(xp)); + gc_mark(hash_entry_value(xp)); + } + for (xp = *entries++; xp; xp = hash_entry_next(xp)) + { + gc_mark(hash_entry_key(xp)); + gc_mark(hash_entry_value(xp)); + } } } } @@ -5091,7 +5305,7 @@ static void init_mark_functions(void) mark_function[T_CLOSURE_STAR] = mark_closure; mark_function[T_CONTINUATION] = mark_continuation; mark_function[T_INPUT_PORT] = mark_input_port; - mark_function[T_VECTOR] = mark_vector; /* this changes if shared vector created (similarly below) */ + mark_function[T_VECTOR] = mark_vector; /* this changes if subvector created (similarly below) */ mark_function[T_INT_VECTOR] = mark_int_or_float_vector; mark_function[T_FLOAT_VECTOR] = mark_int_or_float_vector; mark_function[T_MACRO] = mark_closure; @@ -5158,11 +5372,8 @@ static void unmark_permanent_objects(s7_scheme *sc) #if (!MS_WINDOWS) #include <time.h> #include <sys/time.h> - static struct timeval start_time; - static struct timezone z0; #endif - #if S7_DEBUGGING static char *describe_type_bits(s7_scheme *sc, s7_pointer obj); static bool has_odd_bits(s7_pointer obj); @@ -5179,14 +5390,16 @@ static bool has_odd_bits(s7_pointer obj); static int64_t gc(s7_scheme *sc) { s7_cell **old_free_heap_top; +#if (!MS_WINDOWS) + struct timeval start_time; + struct timezone z0; +#endif + /* mark all live objects (the symbol table is in permanent memory, not the heap) */ if (show_gc_stats(sc)) { fprintf(stdout, "gc "); -#if S7_DEBUGGING - fprintf(stdout, "%s[%d] ", last_gc_func, last_gc_line); -#endif #if (!MS_WINDOWS) /* this is apparently deprecated in favor of clock_gettime -- what compile-time switch to use here? * _POSIX_TIMERS, or perhaps use CLOCK_REALTIME, but clock_gettime requires -lrt -- no thanks. @@ -5238,6 +5451,7 @@ static int64_t gc(s7_scheme *sc) gc_mark(sc->temp8); gc_mark(sc->temp9); gc_mark(sc->temp10); + gc_mark(sc->temp11); { int32_t i; for (i = 0; i < T_TEMPS_SIZE; i++) {gc_mark(sc->t_temps[i]);} @@ -5258,6 +5472,7 @@ static int64_t gc(s7_scheme *sc) gc_mark(car(sc->t3_1)); gc_mark(car(sc->t3_2)); gc_mark(car(sc->t3_3)); gc_mark(car(sc->a4_1)); gc_mark(car(sc->a4_2)); gc_mark(car(sc->a4_3)); gc_mark(car(sc->a4_4)); gc_mark(car(sc->plist_1)); + gc_mark(car(sc->clist_1)); gc_mark(car(sc->plist_2)); gc_mark(cadr(sc->plist_2)); gc_mark(car(sc->qlist_2)); gc_mark(cadr(sc->qlist_2)); gc_mark(sc->u1_1); @@ -5342,7 +5557,7 @@ static int64_t gc(s7_scheme *sc) { \ if (!is_free_and_clear(p)) \ { \ - p->debugger_bits = 0; p->gc_line = last_gc_line; p->gc_func = last_gc_func; \ + p->debugger_bits = 0; \ if (has_odd_bits(p)) \ fprintf(stderr, "odd bits: %s\n", describe_type_bits(sc, p)); \ clear_type(p); \ @@ -5381,8 +5596,8 @@ static int64_t gc(s7_scheme *sc) #endif } - /* if (sc->begin_hook) call_begin_hook(sc); */ sc->previous_free_heap_top = sc->free_heap_top; + return(sc->gc_freed); /* needed by cell allocator to decide when to increase heap size */ } @@ -5495,6 +5710,7 @@ Evaluation produces a surprising amount of garbage, so don't leave the GC off fo set_plist_1(sc, sc->nil); set_elist_2(sc, sc->nil, sc->nil); set_plist_2(sc, sc->nil, sc->nil); + set_clist_1(sc, sc->nil); set_qlist_2(sc, sc->nil, sc->nil); set_elist_3(sc, sc->nil, sc->nil, sc->nil); set_plist_3(sc, sc->nil, sc->nil, sc->nil); @@ -5509,15 +5725,10 @@ Evaluation produces a surprising amount of garbage, so don't leave the GC off fo if (sc->gc_off) return(sc->F); } -#if S7_DEBUGGING - last_gc_line = __LINE__; - last_gc_func = __func__; -#endif gc(sc); return(sc->unspecified); } - s7_pointer s7_gc_on(s7_scheme *sc, bool on) { sc->gc_off = !on; @@ -5525,21 +5736,16 @@ s7_pointer s7_gc_on(s7_scheme *sc, bool on) } -static int32_t permanent_cells = 0; - -static s7_cell *alloc_pointer(void) +#define ALLOC_POINTER_SIZE 256 +static s7_cell *alloc_pointer(s7_scheme *sc) { - #define ALLOC_SIZE 256 - static uint32_t alloc_k = ALLOC_SIZE; - static s7_cell *alloc_cells = NULL; - - if (alloc_k == ALLOC_SIZE) /* if either no current block or the block is used up */ - { /* make a new block */ - permanent_cells += ALLOC_SIZE; - alloc_cells = (s7_cell *)calloc(ALLOC_SIZE, sizeof(s7_cell)); - alloc_k = 0; + if (sc->alloc_pointer_k == ALLOC_POINTER_SIZE) /* if either no current block or the block is used up, make a new block */ + { + sc->permanent_cells += ALLOC_POINTER_SIZE; + sc->alloc_pointer_cells = (s7_cell *)calloc(ALLOC_POINTER_SIZE, sizeof(s7_cell)); + sc->alloc_pointer_k = 0; } - return(&alloc_cells[alloc_k++]); + return(&(sc->alloc_pointer_cells[sc->alloc_pointer_k++])); } static void add_permanent_object(s7_scheme *sc, s7_pointer obj) @@ -5589,11 +5795,11 @@ static void free_vlist(s7_scheme *sc, s7_pointer lst) static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x, int64_t loc) { s7_pointer p; - p = alloc_pointer(); + p = alloc_pointer(sc); sc->heap[loc] = p; heap_location(p) = loc; free_cell(sc, p); - unheap(x); + unheap(sc, x); return(x); } @@ -5656,7 +5862,7 @@ static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x) s7_int i; gc_list *gp; /* fprintf(stderr, "remove %s from heap\n", string_value(symbol_name_cell(x))); */ - sc->heap[loc] = alloc_pointer(); + sc->heap[loc] = alloc_pointer(sc); free_cell(sc, sc->heap[loc]); heap_location(sc->heap[loc]) = loc; @@ -5913,7 +6119,7 @@ static void resize_stack(s7_scheme *sc) s7_error(sc, s7_make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "stack has grown past (*s7* 'max-stack-size)", 43))); ob = stack_block(sc->stack); - nb = reallocate(ob, new_size * sizeof(s7_pointer)); + nb = reallocate(sc, ob, new_size * sizeof(s7_pointer)); block_info(nb) = NULL; stack_block(sc->stack) = nb; stack_elements(sc->stack) = (s7_pointer *)block_data(nb); @@ -5941,12 +6147,7 @@ static void resize_stack(s7_scheme *sc) } } -#define check_stack_size(Sc) \ - if (Sc->stack_end >= Sc->stack_resize_trigger) \ - { \ - if ((Sc->begin_hook) && (call_begin_hook(Sc))) return(Sc->F); \ - resize_stack(Sc); \ - } +#define check_stack_size(Sc) do {if (Sc->stack_end >= Sc->stack_resize_trigger) resize_stack(Sc);} while (0) s7_pointer s7_gc_protect_via_stack(s7_scheme *sc, s7_pointer x) { @@ -5977,26 +6178,24 @@ static inline uint64_t raw_string_hash(const uint8_t *key, s7_int len) return(x); } -static uint8_t *alloc_symbol(void) +static uint8_t *alloc_symbol(s7_scheme *sc) { #define SYMBOL_SIZE (3 * sizeof(s7_cell) + sizeof(block_t)) #define ALLOC_SYMBOL_SIZE (64 * SYMBOL_SIZE) - static uint32_t alloc_symbol_k = ALLOC_SYMBOL_SIZE; - static uint8_t *alloc_symbol_cells = NULL; uint8_t *result; - if (alloc_symbol_k == ALLOC_SYMBOL_SIZE) + if (sc->alloc_symbol_k == ALLOC_SYMBOL_SIZE) { - alloc_symbol_cells = (uint8_t *)malloc(ALLOC_SYMBOL_SIZE); - alloc_symbol_k = 0; + sc->alloc_symbol_cells = (uint8_t *)malloc(ALLOC_SYMBOL_SIZE); + sc->alloc_symbol_k = 0; } - result = &alloc_symbol_cells[alloc_symbol_k]; - alloc_symbol_k += SYMBOL_SIZE; + result = &(sc->alloc_symbol_cells[sc->alloc_symbol_k]); + sc->alloc_symbol_k += SYMBOL_SIZE; return(result); } static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, s7_int len); -static s7_pointer permanent_slot(s7_pointer symbol, s7_pointer value); +static s7_pointer permanent_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer value); static s7_pointer new_symbol(s7_scheme *sc, const char *name, s7_int len, uint64_t hash, uint32_t location) { @@ -6004,21 +6203,21 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, s7_int len, uint64 s7_pointer x, str, p; uint8_t *base, *val; - base = alloc_symbol(); + base = alloc_symbol(sc); x = (s7_pointer)base; str = (s7_pointer)(base + sizeof(s7_cell)); p = (s7_pointer)(base + 2 * sizeof(s7_cell)); - val = (uint8_t *)alloc_permanent_string(len + 1); + val = (uint8_t *)alloc_permanent_string(sc, len + 1); memcpy((void *)val, (void *)name, len); val[len] = '\0'; - unheap(str); + unheap(sc, str); typeflag(str) = T_STRING | T_IMMUTABLE; /* avoid debugging confusion involving set_type (also below) */ string_length(str) = len; string_value(str) = (char *)val; string_hash(str) = hash; - unheap(x); + unheap(sc, x); typeflag(x) = T_SYMBOL; symbol_set_name_cell(x, str); set_global_slot(x, sc->undefined); /* was sc->nil */ @@ -6037,12 +6236,12 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, s7_int len, uint64 typeflag(x) |= (T_IMMUTABLE | T_KEYWORD | T_GLOBAL); keyword_set_symbol(x, make_symbol_with_length(sc, (name[0] == ':') ? (char *)(name + 1) : name, len - 1)); set_has_keyword(keyword_symbol(x)); - slot = permanent_slot(x, x); + slot = permanent_slot(sc, x, x); set_global_slot(x, slot); set_local_slot(x, slot); } } - unheap(p); + unheap(sc, p); typeflag(p) = T_PAIR | T_IMMUTABLE; set_car(p, x); set_cdr(p, vector_element(sc->symbol_table, location)); @@ -6234,15 +6433,15 @@ s7_pointer s7_gensym(s7_scheme *sc, const char *prefix) s7_pointer x; len = safe_strlen(prefix) + 32; - b = mallocate(len); + b = mallocate(sc, len); name = (char *)block_data(b); /* there's no point in heroic efforts here to avoid name collisions -- the user can screw up no matter what we do */ name[0] = '\0'; - len = catstrs(name, len, "{", (prefix) ? prefix : "", "}-", pos_int_to_str_direct(sc->gensym_counter++), NULL); + len = catstrs(name, len, "{", (prefix) ? prefix : "", "}-", pos_int_to_str_direct(sc, sc->gensym_counter++), NULL); hash = raw_string_hash((const uint8_t *)name, len); location = hash % SYMBOL_TABLE_SIZE; x = new_symbol(sc, name, len, hash, location); /* not T_GENSYM -- might be called from outside */ - liberate(b); + liberate(sc, b); return(x); } @@ -6252,7 +6451,7 @@ static bool s7_is_gensym(s7_pointer g) {return((is_symbol(g)) && (is_gensym(g))) static s7_pointer g_is_gensym(s7_scheme *sc, s7_pointer args) { #define H_is_gensym "(gensym? sym) returns #t if sym is a gensym" - #define Q_is_gensym pl_bt + #define Q_is_gensym sc->pl_bt check_boolean_method(sc, s7_is_gensym, sc->is_gensym_symbol, args); } @@ -6284,7 +6483,7 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args) plen = safe_strlen(prefix); len = plen + 32; - b = mallocate(len + 2 * sizeof(s7_cell)); + b = mallocate(sc, len + 2 * sizeof(s7_cell)); base = (char *)block_data(b); str = (s7_cell *)base; stc = (s7_cell *)(base + sizeof(s7_cell)); @@ -6295,7 +6494,7 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args) name[plen + 1] = '}'; name[plen + 2] = '-'; /* {gensym}-nnn */ - p = pos_int_to_str(sc->gensym_counter++, &len, '\0'); + p = pos_int_to_str(sc, sc->gensym_counter++, &len, '\0'); memcpy((void *)(name + plen + 3), (void *)p, len); nlen = len + plen + 2; @@ -6303,7 +6502,7 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args) location = hash % SYMBOL_TABLE_SIZE; /* make-string for symbol name */ - unheap(str); + unheap(sc, str); #if S7_DEBUGGING typeflag(str) = 0; #endif @@ -6326,7 +6525,7 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args) #if S7_DEBUGGING typeflag(stc) = 0; #endif - unheap(stc); + unheap(sc, stc); set_type(stc, T_PAIR | T_IMMUTABLE); set_car(stc, x); set_cdr(stc, vector_element(sc->symbol_table, location)); @@ -6354,7 +6553,7 @@ bool s7_is_syntax(s7_pointer p) static s7_pointer g_is_syntax(s7_scheme *sc, s7_pointer args) { #define H_is_syntax "(syntax? obj) returns #t if obj is a syntactic value (e.g. lambda)" - #define Q_is_syntax pl_bt + #define Q_is_syntax sc->pl_bt check_boolean_method(sc, is_syntax, sc->is_syntax_symbol, args); } @@ -6368,7 +6567,7 @@ bool s7_is_symbol(s7_pointer p) static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args) { #define H_is_symbol "(symbol? obj) returns #t if obj is a symbol" - #define Q_is_symbol pl_bt + #define Q_is_symbol sc->pl_bt check_boolean_method(sc, is_symbol, sc->is_symbol_symbol, args); } @@ -6393,7 +6592,6 @@ static s7_pointer g_symbol_to_string(s7_scheme *sc, s7_pointer args) return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); /* return a copy */ } -static s7_pointer symbol_to_string_uncopied; static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args) { s7_pointer sym; @@ -6406,19 +6604,19 @@ static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args) return(symbol_name_cell(sym)); } -static s7_pointer symbol_to_string_p(s7_pointer sym) +static s7_pointer symbol_to_string_p(s7_scheme *sc, s7_pointer sym) { if (!is_symbol(sym)) - simple_wrong_type_argument(cur_sc, cur_sc->symbol_to_string_symbol, sym, T_SYMBOL); - return(s7_make_string_with_length(cur_sc, symbol_name(sym), symbol_name_length(sym))); + simple_wrong_type_argument(sc, sc->symbol_to_string_symbol, sym, T_SYMBOL); + return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); } -static s7_pointer symbol_to_string_uncopied_p(s7_pointer sym) +static s7_pointer symbol_to_string_uncopied_p(s7_scheme *sc, s7_pointer sym) { if (!is_symbol(sym)) - simple_wrong_type_argument(cur_sc, cur_sc->symbol_to_string_symbol, sym, T_SYMBOL); + simple_wrong_type_argument(sc, sc->symbol_to_string_symbol, sym, T_SYMBOL); if (is_gensym(sym)) - return(s7_make_string_with_length(cur_sc, symbol_name(sym), symbol_name_length(sym))); + return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); return(symbol_name_cell(sym)); } @@ -6442,14 +6640,14 @@ static s7_pointer g_string_to_symbol(s7_scheme *sc, s7_pointer args) return(g_string_to_symbol_1(sc, car(args), sc->string_to_symbol_symbol)); } -static s7_pointer string_to_symbol_p_p(s7_pointer p) +static s7_pointer string_to_symbol_p_p(s7_scheme *sc, s7_pointer p) { if (!is_string(p)) - simple_wrong_type_argument(cur_sc, cur_sc->string_to_symbol_symbol, p, T_STRING); + simple_wrong_type_argument(sc, sc->string_to_symbol_symbol, p, T_STRING); if (string_length(p) == 0) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->string_to_symbol_symbol, p, - wrap_string(cur_sc, "a non-null string", 17)); - return(make_symbol_with_length(cur_sc, string_value(p), string_length(p))); + simple_wrong_type_argument_with_type(sc, sc->string_to_symbol_symbol, p, + wrap_string(sc, "a non-null string", 17)); + return(make_symbol_with_length(sc, string_value(p), string_length(p))); } static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args); @@ -6652,11 +6850,11 @@ static s7_pointer old_frame_with_three_slots(s7_scheme *sc, s7_pointer env, s7_p return(env); } -static s7_pointer permanent_slot(s7_pointer symbol, s7_pointer value) +static s7_pointer permanent_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer value) { s7_pointer x; - x = alloc_pointer(); - unheap(x); + x = alloc_pointer(sc); + unheap(sc, x); set_type(x, T_SLOT); slot_set_symbol(x, symbol); slot_set_value(x, value); @@ -6677,9 +6875,9 @@ static s7_pointer find_let(s7_scheme *sc, s7_pointer obj) return(c_object_let(obj)); case T_C_POINTER: - if ((is_let(raw_pointer_info(obj))) && - (raw_pointer_info(obj) != sc->rootlet)) - return(raw_pointer_info(obj)); + if ((is_let(c_pointer_info(obj))) && + (c_pointer_info(obj) != sc->rootlet)) + return(c_pointer_info(obj)); } return(sc->nil); } @@ -6799,8 +6997,8 @@ static s7_pointer make_slot_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key); static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator); - static void remove_function_from_heap(s7_scheme *sc, s7_pointer value); + static void remove_let_from_heap(s7_scheme *sc, s7_pointer lt) { s7_pointer p; @@ -6886,7 +7084,7 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi } ge = sc->rootlet; - slot = permanent_slot(symbol, value); + slot = permanent_slot(sc, symbol, value); rootlet_element(ge, sc->rootlet_entries++) = slot; if (sc->rootlet_entries >= vector_length(ge)) { @@ -6895,7 +7093,7 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi vector_length(ge) *= 2; len = vector_length(ge); ob = rootlet_block(ge); - nb = reallocate(ob, len * sizeof(s7_pointer)); + nb = reallocate(sc, ob, len * sizeof(s7_pointer)); block_info(nb) = NULL; rootlet_block(ge) = nb; rootlet_elements(ge) = (s7_pointer *)block_data(nb); @@ -6909,7 +7107,7 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi if (symbol_info(symbol)) /* if a gensym, symbol_info is null */ { if (initial_slot(symbol) == sc->undefined) - set_initial_slot(symbol, permanent_slot(symbol, value)); + set_initial_slot(symbol, permanent_slot(sc, symbol, value)); } set_local_slot(symbol, slot); symbol_increment_ctr(symbol); @@ -6947,7 +7145,7 @@ bool s7_is_let(s7_pointer e) static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args) { #define H_is_let "(let? obj) returns #t if obj is a let (an environment)." - #define Q_is_let pl_bt + #define Q_is_let sc->pl_bt check_boolean_method(sc, is_let, sc->is_let_symbol, args); } @@ -6966,7 +7164,7 @@ static void save_unlet(s7_scheme *sc) sc->unlet = (s7_pointer)calloc(1, sizeof(s7_cell)); set_type(sc->unlet, T_VECTOR); vector_length(sc->unlet) = UNLET_ENTRIES; - block = mallocate(UNLET_ENTRIES * sizeof(s7_pointer)); + block = mallocate(sc, UNLET_ENTRIES * sizeof(s7_pointer)); vector_block(sc->unlet) = block; vector_elements(sc->unlet) = (s7_pointer *)block_data(block); vector_set_dimension_info(sc->unlet, NULL); @@ -6974,7 +7172,7 @@ static void save_unlet(s7_scheme *sc) vector_setter(sc->unlet) = default_vector_setter; inits = vector_elements(sc->unlet); s7_vector_fill(sc, sc->unlet, sc->nil); - unheap(sc->unlet); + unheap(sc, sc->unlet); for (i = 0; i < SYMBOL_TABLE_SIZE; i++) for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x)) @@ -7067,7 +7265,7 @@ bool s7_is_openlet(s7_pointer e) static s7_pointer g_is_openlet(s7_scheme *sc, s7_pointer args) { #define H_is_openlet "(openlet? obj) returns #t is 'obj' has methods." - #define Q_is_openlet pl_bt + #define Q_is_openlet sc->pl_bt s7_pointer e; e = car(args); @@ -7087,7 +7285,7 @@ s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e) static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args) { #define H_openlet "(openlet e) tells the built-in generic functions that the let 'e might have an over-riding method." - #define Q_openlet pcl_e + #define Q_openlet sc->pcl_e s7_pointer e, elet, func; e = car(args); @@ -7112,7 +7310,7 @@ static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args) { s7_pointer e; #define H_coverlet "(coverlet e) undoes an earlier openlet." - #define Q_coverlet pcl_e + #define Q_coverlet sc->pcl_e e = car(args); sc->temp3 = e; @@ -7124,7 +7322,7 @@ static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args) if ((is_let(e)) || (has_closure_let(e)) || ((is_c_object(e)) && (c_object_let(e) != sc->nil)) || - ((is_c_pointer(e)) && (is_let(raw_pointer_info(e))))) + ((is_c_pointer(e)) && (is_let(c_pointer_info(e))))) { clear_has_methods(e); return(e); @@ -7459,7 +7657,6 @@ new environment. (inlet :a 1 :b 2) or (inlet '(a . 1) '(b . 2))" #define g_inlet s7_inlet -static s7_pointer simple_inlet; static s7_pointer g_simple_inlet(s7_scheme *sc, s7_pointer args) { /* here all args are paired with normal symbol/value, no fallbacks, no immutable symbols etc */ @@ -7549,7 +7746,7 @@ static s7_pointer inlet_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po (sym == sc->let_set_fallback_symbol)) return(f); } - return(simple_inlet); + return(sc->simple_inlet); } return(f); } @@ -7628,7 +7825,7 @@ static s7_pointer g_let_to_list(s7_scheme *sc, s7_pointer args) else { if (is_c_pointer(env)) - env = raw_pointer_info(env); + env = c_pointer_info(env); } if (!is_let(env)) return(simple_wrong_type_argument_with_type(sc, sc->let_to_list_symbol, env, a_let_string)); @@ -7732,10 +7929,9 @@ static s7_pointer lint_let_ref_1(s7_scheme *sc, s7_pointer lt, s7_pointer sym) return(sc->undefined); } -static s7_pointer let_ref_p_pp(s7_pointer p1, s7_pointer p2) {return(s7_let_ref(cur_sc, p1, p2));} +static s7_pointer let_ref_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(s7_let_ref(sc, p1, p2));} -static s7_pointer lint_let_ref; -static s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args) +static inline s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args) { s7_pointer lt; lt = symbol_to_value_unchecked(sc, opt_sym2(args)); /* cadar */ @@ -7759,7 +7955,7 @@ static s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args) static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if ((!ops) || (!is_global(sc->let_ref_symbol))) return(f); - if ((is_h_safe_c_c(expr)) && (raw_opt1(expr) == lint_let_ref)) + if ((is_h_safe_c_c(expr)) && (raw_opt1(expr) == sc->lint_let_ref)) return(raw_opt1(expr)); if (optimize_op(expr) == HOP_SAFE_C_opSq_Q) @@ -7774,7 +7970,7 @@ static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym2(cdr(expr), cadr(arg1)); set_opt_sym3(cdr(expr), cadr(arg2)); - return(lint_let_ref); + return(sc->lint_let_ref); } } return(f); @@ -7782,54 +7978,7 @@ static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ /* -------------------------------- let-set! -------------------------------- */ -static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value) -{ - s7_pointer func, new_value; - - /* new_value = sc->error_symbol; */ - func = slot_setter(slot); - - if (is_procedure_or_macro(func)) - { - if (has_let_arg(func)) - { - if (is_c_function(func)) - { - set_car(sc->t3_1, slot_symbol(slot)); - set_car(sc->t3_2, old_value); - set_car(sc->t3_3, sc->envir); - new_value = c_function_call(func)(sc, sc->t3_1); - } - else - { - bool old_off; - old_off = sc->gc_off; - sc->gc_off = true; - new_value = s7_apply_function(sc, func, list_3(sc, slot_symbol(slot), old_value, sc->envir)); - sc->gc_off = old_off; - } - } - else - { - if (is_c_function(func)) - { - set_car(sc->t2_1, slot_symbol(slot)); - set_car(sc->t2_2, old_value); - new_value = c_function_call(func)(sc, sc->t2_1); - } - else - { - bool old_off; - old_off = sc->gc_off; - sc->gc_off = true; - new_value = s7_apply_function(sc, func, list_2(sc, slot_symbol(slot), old_value)); - sc->gc_off = old_off; - } - } - } - else return(old_value); - return(new_value); -} +static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value); static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value) { @@ -7913,27 +8062,27 @@ static s7_pointer g_let_set(s7_scheme *sc, s7_pointer args) /* (let ((a 1)) (set! ((curlet) 'a) 32) a) */ #define H_let_set "(let-set! env sym val) sets the symbol sym's value in the environment env to val" #define Q_let_set s7_make_signature(sc, 4, sc->T, sc->is_let_symbol, sc->is_symbol_symbol, sc->T) + return(s7_let_set(sc, car(args), cadr(args), caddr(args))); } -static s7_pointer let_set_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer let_set_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { - return(s7_let_set(cur_sc, p1, p2, p3)); + return(s7_let_set(sc, p1, p2, p3)); } -static s7_pointer let_set_p_ppp_1(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer let_set_p_ppp_1(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { - return(let_set_1(cur_sc, p1, p2, p3)); + return(let_set_1(sc, p1, p2, p3)); } -static s7_pointer let_set_p_ppp_2(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer let_set_p_ppp_2(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { if (!is_symbol(p2)) - return(wrong_type_argument_with_type(cur_sc, cur_sc->let_set_symbol, 2, p2, a_symbol_string)); - return(let_set_1(cur_sc, p1, p2, p3)); + return(wrong_type_argument_with_type(sc, sc->let_set_symbol, 2, p2, a_symbol_string)); + return(let_set_1(sc, p1, p2, p3)); } -static s7_pointer lint_let_set; static s7_pointer g_lint_let_set_1(s7_scheme *sc, s7_pointer lt1, s7_pointer sym, s7_pointer val) { s7_pointer lt, x, y; @@ -7994,7 +8143,7 @@ static s7_pointer g_lint_let_set(s7_scheme *sc, s7_pointer args) static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if ((!ops) || (!is_global(sc->let_set_symbol))) return(f); - if ((is_h_safe_c_c(expr)) && (raw_opt1(expr) == lint_let_set)) + if ((is_h_safe_c_c(expr)) && (raw_opt1(expr) == sc->lint_let_set)) return(raw_opt1(expr)); if (optimize_op(expr) == HOP_SAFE_C_opSq_QS) @@ -8012,7 +8161,7 @@ static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym2(cdr(expr), cadr(arg1)); set_opt_sym3(cdr(expr), cadr(arg2)); - return(lint_let_set); + return(sc->lint_let_set); } } return(f); @@ -8703,9 +8852,6 @@ static s7_pointer copy_tree(s7_scheme *sc, s7_pointer tree) } -static s7_pointer *tree_pointers = NULL; -static int32_t tree_pointers_size = 0, tree_pointers_top = 0; - static inline bool tree_is_cyclic_1(s7_scheme *sc, s7_pointer tree) { s7_pointer p; @@ -8716,20 +8862,20 @@ static inline bool tree_is_cyclic_1(s7_scheme *sc, s7_pointer tree) return(!is_shared(p)); set_tree_collected(p); - if (tree_pointers_top == tree_pointers_size) + if (sc->tree_pointers_top == sc->tree_pointers_size) { - if (tree_pointers_size == 0) + if (sc->tree_pointers_size == 0) { - tree_pointers_size = 8; - tree_pointers = (s7_pointer *)malloc(tree_pointers_size * sizeof(s7_pointer)); + sc->tree_pointers_size = 8; + sc->tree_pointers = (s7_pointer *)malloc(sc->tree_pointers_size * sizeof(s7_pointer)); } else { - tree_pointers_size *= 2; - tree_pointers = (s7_pointer *)realloc(tree_pointers, tree_pointers_size * sizeof(s7_pointer)); + sc->tree_pointers_size *= 2; + sc->tree_pointers = (s7_pointer *)realloc(sc->tree_pointers, sc->tree_pointers_size * sizeof(s7_pointer)); } } - tree_pointers[tree_pointers_top++] = p; + sc->tree_pointers[sc->tree_pointers_top++] = p; if ((is_pair(car(p))) && (tree_is_cyclic_1(sc, car(p)))) @@ -8746,9 +8892,9 @@ static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree) bool result; int32_t i; result = tree_is_cyclic_1(sc, tree); - for (i = 0; i < tree_pointers_top; i++) - clear_tree_bits(tree_pointers[i]); - tree_pointers_top = 0; + for (i = 0; i < sc->tree_pointers_top; i++) + clear_tree_bits(sc->tree_pointers[i]); + sc->tree_pointers_top = 0; return(result); } return(false); @@ -8757,7 +8903,7 @@ static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree) static s7_pointer g_tree_is_cyclic(s7_scheme *sc, s7_pointer args) { #define H_tree_is_cyclic "(tree-cyclic? tree) returns #t if the tree has a cycle." - #define Q_tree_is_cyclic pl_bt + #define Q_tree_is_cyclic sc->pl_bt return(make_boolean(sc, tree_is_cyclic(sc, car(args)))); } @@ -8869,14 +9015,14 @@ bool s7_is_defined(s7_scheme *sc, const char *name) return(false); } -static bool is_defined_b_p(s7_pointer p) +static bool is_defined_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_symbol(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_defined_symbol, p, T_SYMBOL); - return(is_slot(symbol_to_slot(cur_sc, p))); + simple_wrong_type_argument(sc, sc->is_defined_symbol, p, T_SYMBOL); + return(is_slot(symbol_to_slot(sc, p))); } -static bool is_defined_b_pp(s7_pointer p, s7_pointer e) {return(g_is_defined(cur_sc, set_plist_2(cur_sc, p, e)) != cur_sc->F);} +static bool is_defined_b_7pp(s7_scheme *sc, s7_pointer p, s7_pointer e) {return(g_is_defined(sc, set_plist_2(sc, p, e)) != sc->F);} void s7_define(s7_scheme *sc, s7_pointer envir, s7_pointer symbol, s7_pointer value) @@ -8945,28 +9091,6 @@ s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name } -char *s7_symbol_documentation(s7_scheme *sc, s7_pointer sym) -{ - if (is_keyword(sym)) return(NULL); - if ((is_symbol(sym)) && - (symbol_has_help(sym))) - return(symbol_help(sym)); - return(NULL); -} - -char *s7_symbol_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc) -{ - if (is_keyword(sym)) return(NULL); - if ((is_symbol(sym)) && - (symbol_has_help(sym)) && - (symbol_help(sym))) - free(symbol_help(sym)); - symbol_set_has_help(sym); - symbol_set_help(sym, copy_string(new_doc)); - return(symbol_help(sym)); -} - - /* -------------------------------- keyword? -------------------------------- */ bool s7_is_keyword(s7_pointer obj) @@ -8977,7 +9101,7 @@ bool s7_is_keyword(s7_pointer obj) static s7_pointer g_is_keyword(s7_scheme *sc, s7_pointer args) { #define H_is_keyword "(keyword? obj) returns #t if obj is a keyword, (keyword? :rest) -> #t" - #define Q_is_keyword pl_bt + #define Q_is_keyword sc->pl_bt check_boolean_method(sc, is_keyword, sc->is_keyword_symbol, args); } @@ -8988,15 +9112,15 @@ s7_pointer s7_make_keyword(s7_scheme *sc, const char *key) s7_pointer sym; block_t *b; char *name; - s7_int slen; - slen = safe_strlen(key); - b = mallocate(slen + 2); + size_t slen; + slen = (size_t)safe_strlen(key); + b = mallocate(sc, slen + 2); name = (char *)block_data(b); name[0] = ':'; /* prepend ":" */ name[1] = '\0'; - memcpy((void *)(name + 1), (void *)key, slen); + memcpy((void *)(name + 1), (void *)key, slen); /* gcc 8.1 error here is incorrect */ sym = make_symbol_with_length(sc, name, slen + 1); /* keyword slot etc taken care of here (in new_symbol actually) */ - liberate(b); + liberate(sc, b); return(sym); } @@ -9060,7 +9184,7 @@ bool s7_is_c_pointer(s7_pointer arg) bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type) { - return((is_c_pointer(arg)) && (raw_pointer_type(arg) == type)); + return((is_c_pointer(arg)) && (c_pointer_type(arg) == type)); } void *s7_c_pointer(s7_pointer p) @@ -9072,23 +9196,23 @@ void *s7_c_pointer(s7_pointer p) if (!is_c_pointer(p)) return(NULL); - return(raw_pointer(p)); + return(c_pointer(p)); } s7_pointer s7_c_pointer_type(s7_pointer p) { if (!is_c_pointer(p)) return(NULL); /* as above */ - return(raw_pointer_type(p)); + return(c_pointer_type(p)); } s7_pointer s7_make_c_pointer_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info) { s7_pointer x; new_cell(sc, x, T_C_POINTER); - raw_pointer(x) = ptr; - raw_pointer_type(x) = type; - raw_pointer_info(x) = info; + c_pointer(x) = ptr; + c_pointer_type(x) = type; + c_pointer_info(x) = info; return(x); } @@ -9107,30 +9231,98 @@ static s7_pointer g_is_c_pointer(s7_scheme *sc, s7_pointer args) return(apply_boolean_method(sc, p, sc->is_c_pointer_symbol)); } if (is_pair(cdr(args))) - return(make_boolean(sc, raw_pointer_type(p) == cadr(args))); + return(make_boolean(sc, c_pointer_type(p) == cadr(args))); return(sc->T); } +static s7_pointer g_c_pointer_info(s7_scheme *sc, s7_pointer args) +{ + #define H_c_pointer_info "(c-pointer-info obj) returns the c-pointer info field" + #define Q_c_pointer_info s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol) + + s7_pointer p; + p = car(args); + if (!is_c_pointer(p)) + return(method_or_bust(sc, p, sc->c_pointer_info_symbol, args, T_C_POINTER, 1)); + + return(c_pointer_info(p)); +} + +static s7_pointer g_c_pointer_type(s7_scheme *sc, s7_pointer args) +{ + #define H_c_pointer_type "(c-pointer-type obj) returns the c-pointer type field" + #define Q_c_pointer_type s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol) + + s7_pointer p; + p = car(args); + if (!is_c_pointer(p)) + return(method_or_bust(sc, p, sc->c_pointer_type_symbol, args, T_C_POINTER, 1)); + + return(c_pointer_type(p)); +} + +static s7_pointer g_c_pointer_weak1(s7_scheme *sc, s7_pointer args) +{ + #define H_c_pointer_weak1 "(c-pointer-weak1 obj) returns the c-pointer weak1 field" + #define Q_c_pointer_weak1 s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol) + s7_pointer p; + p = car(args); + if (!is_c_pointer(p)) + return(sc->F); + return(c_pointer_weak1(p)); +} + +static s7_pointer g_c_pointer_weak2(s7_scheme *sc, s7_pointer args) +{ + #define H_c_pointer_weak2 "(c-pointer-weak2 obj) returns the c-pointer weak2 field" + #define Q_c_pointer_weak2 s7_make_signature(sc, 2, sc->T, sc->is_c_pointer_symbol) + s7_pointer p; + p = car(args); + if (!is_c_pointer(p)) + return(sc->F); + return(c_pointer_weak2(p)); +} + static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args) { - #define H_c_pointer "(c-pointer int type info) returns a c-pointer object. The type and info args are optional, defaulting to #f." - #define Q_c_pointer s7_make_signature(sc, 4, sc->is_c_pointer_symbol, sc->is_integer_symbol, sc->T, sc->T) + #define H_c_pointer "(c-pointer int type info unmarked) returns a c-pointer object. The type and info args are optional, defaulting to #f." + #define Q_c_pointer s7_make_circular_signature(sc, 2, 3, sc->is_c_pointer_symbol, sc->is_integer_symbol, sc->T) - s7_pointer arg, type, info; + s7_pointer arg, type, info, weak1, weak2, cp; intptr_t p; type = sc->F; info = sc->F; + weak1 = sc->F; + weak2 = sc->F; arg = car(args); if (!s7_is_integer(arg)) return(method_or_bust(sc, arg, sc->c_pointer_symbol, args, T_INTEGER, 1)); p = (intptr_t)s7_integer(arg); /* (c-pointer (bignum "1234")) */ - if (is_pair(cdr(args))) + args = cdr(args); + if (is_pair(args)) { - type = cadr(args); - if (is_pair(cddr(args))) info = caddr(args); + type = car(args); + args = cdr(args); + if (is_pair(args)) + { + info = car(args); + args = cdr(args); + if (is_pair(args)) + { + weak1 = car(args); + args = cdr(args); + if (is_pair(args)) + weak2 = car(args); + } + } } - return(s7_make_c_pointer_with_type(sc, (void *)p, type, info)); + cp = s7_make_c_pointer_with_type(sc, (void *)p, type, info); + c_pointer_set_weak1(cp, weak1); + c_pointer_set_weak2(cp, weak2); + if ((weak1 != sc->F) || (weak2 != sc->F)) + add_weak_ref(sc, cp); + return(cp); } static s7_pointer g_c_pointer_to_list(s7_scheme *sc, s7_pointer args) @@ -9142,7 +9334,7 @@ static s7_pointer g_c_pointer_to_list(s7_scheme *sc, s7_pointer args) p = car(args); if (!is_c_pointer(p)) return(method_or_bust(sc, p, sc->c_pointer_to_list_symbol, args, T_C_POINTER, 1)); - return(s7_list(sc, 3, s7_make_integer(sc, (s7_int)((intptr_t)raw_pointer(p))), raw_pointer_type(p), raw_pointer_info(p))); + return(s7_list(sc, 3, s7_make_integer(sc, (s7_int)((intptr_t)c_pointer(p))), c_pointer_type(p), c_pointer_info(p))); } @@ -9154,7 +9346,7 @@ enum {NO_SET_JUMP, READ_SET_JUMP, LOAD_SET_JUMP, DYNAMIC_WIND_SET_JUMP, S7_CALL_ static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args) { #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation" - #define Q_is_continuation pl_bt + #define Q_is_continuation sc->pl_bt check_boolean_method(sc, is_continuation, sc->is_continuation_symbol, args); /* is this the right thing? It returns #f for call-with-exit ("goto") because @@ -9282,8 +9474,8 @@ static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int64_t top) p = ov[i]; /* args */ if (is_pair(p)) /* args need not be a list (it can be a port or #f, etc) */ { - nv[i] = protected_list_copy(sc, p); /* args (copy is needed -- see s7test.scm) */ - set_type(nv[i], typeflag(p)); /* carry over T_IMMUTABLE etc */ + nv[i] = protected_list_copy(sc, p); /* args (copy is needed -- see s7test.scm) */ + set_type(nv[i], (typeflag(p) & (~T_HAS_OPTLIST))); /* carry over T_IMMUTABLE, but not T_HAS_OPTLIST since opt2 is not copied in protected_list_copy */ } /* lst can be dotted or circular here. The circular list only happens in a case like: * (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f)) @@ -9389,7 +9581,7 @@ s7_pointer s7_make_continuation(s7_scheme *sc) sc->temp8 = stack; new_cell(sc, x, T_CONTINUATION); - block = mallocate_block(); + block = mallocate_block(sc); continuation_block(x) = block; continuation_set_stack(x, stack); continuation_stack_size(x) = vector_length(continuation_stack(x)); /* copy_stack can return a smaller stack than the current one */ @@ -10212,16 +10404,6 @@ static s7_pointer make_mutable_integer(s7_scheme *sc, s7_int n) return(x); } -static s7_pointer make_permanent_integer_unchecked(s7_int i) -{ - s7_pointer p; - p = (s7_pointer)calloc(1, sizeof(s7_cell)); - typeflag(p) = T_IMMUTABLE | T_INTEGER; - unheap(p); - integer(p) = i; - return(p); -} - static s7_pointer make_permanent_integer(s7_int i) { if (is_small(i)) return(small_int(i)); @@ -10235,7 +10417,6 @@ static s7_pointer make_permanent_integer(s7_int i) return(make_permanent_integer_unchecked(i)); } - s7_pointer s7_make_real(s7_scheme *sc, s7_double n) { s7_pointer x; @@ -10252,17 +10433,6 @@ s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n) return(x); } -static s7_pointer make_permanent_real(s7_double n) -{ - s7_pointer x; - x = (s7_pointer)calloc(1, sizeof(s7_cell)); - set_type(x, T_IMMUTABLE | T_REAL); - unheap(x); - set_real(x, n); - return(x); -} - - s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b) { s7_pointer x; @@ -10287,7 +10457,7 @@ s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b) s7_int divisor; if (b == 0) - return(division_by_zero_error(sc, wrap_string(sc, "make-ratio", 10), set_elist_2(sc, wrap_integer(a), small_int(0)))); + return(division_by_zero_error(sc, wrap_string(sc, "make-ratio", 10), set_elist_2(sc, wrap_integer1(sc, a), small_int(0)))); if (a == 0) return(small_int(0)); if (b == 1) @@ -10546,10 +10716,6 @@ static s7_pointer s7_from_c_complex(s7_scheme *sc, s7_complex z) #endif -static int32_t s7_int32_max = 0, s7_int32_min = 0, s7_int_bits = 0, s7_int_digits = 0; /* initialized later */ -static int32_t s7_int_digits_by_radix[17]; - - #if (!WITH_GMP) static s7_pointer s7_negate(s7_scheme *sc, s7_pointer p) /* can't use "negate" because it confuses C++! */ { @@ -10704,9 +10870,10 @@ static double ipow(int32_t x, int32_t y) /* -------------------------------- number->string -------------------------------- */ +static const char dignum[] = "0123456789abcdef"; + static size_t integer_to_string_any_base(char *p, s7_int n, s7_int radix) /* called by number_to_string_with_radix */ { - static const char dignum[] = "0123456789abcdef"; s7_int i, len, end; bool sign; s7_int pown; @@ -10758,18 +10925,17 @@ static size_t integer_to_string_any_base(char *p, s7_int n, s7_int radix) /* ca return(len + 1); } -static char *integer_to_string(s7_int num, s7_int *nlen) /* do not free the returned string */ +static char *integer_to_string(s7_scheme *sc, s7_int num, s7_int *nlen) /* do not free the returned string */ { char *p, *op; bool sign; - static char int_to_str[INT_TO_STR_SIZE]; if (num == s7_int_min) { (*nlen) = 20; return((char *)"-9223372036854775808"); } - p = (char *)(int_to_str + INT_TO_STR_SIZE - 1); + p = (char *)(sc->int_to_str1 + INT_TO_STR_SIZE - 1); op = p; *p-- = '\0'; @@ -10787,15 +10953,14 @@ static char *integer_to_string(s7_int num, s7_int *nlen) /* do not free the retu return(++p); } -static char *integer_to_string_no_length(s7_int num) /* do not free the returned string */ +static char *integer_to_string_no_length(s7_scheme *sc, s7_int num) /* do not free the returned string */ { char *p; bool sign; - static char its[INT_TO_STR_SIZE]; if (num == s7_int_min) return((char *)"-9223372036854775808"); - p = (char *)(its + INT_TO_STR_SIZE - 1); + p = (char *)(sc->int_to_str2 + INT_TO_STR_SIZE - 1); *p-- = '\0'; sign = (num < 0); if (sign) num = -num; @@ -10826,24 +10991,21 @@ static char *floatify(char *str, s7_int *nlen) return(str); } -static s7_int num_to_str_size = -1; -static char *num_to_str = NULL; - -static void insert_spaces(char *src, s7_int width, s7_int len) +static void insert_spaces(s7_scheme *sc, char *src, s7_int width, s7_int len) { s7_int spaces; - if (width >= num_to_str_size) + if (width >= sc->num_to_str_size) { - num_to_str_size = width + 1; - num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char)); + sc->num_to_str_size = width + 1; + sc->num_to_str = (char *)realloc(sc->num_to_str, sc->num_to_str_size * sizeof(char)); } spaces = width - len; - num_to_str[width] = '\0'; - memmove((void *)(num_to_str + spaces), (void *)src, len); - memset((void *)num_to_str, (int)' ', spaces); + sc->num_to_str[width] = '\0'; + memmove((void *)(sc->num_to_str + spaces), (void *)src, len); + memset((void *)(sc->num_to_str), (int)' ', spaces); } -static char *number_to_string_base_10(s7_pointer obj, s7_int width, s7_int precision, char float_choice, s7_int *nlen, use_write_t choice) /* don't free result */ +static char *number_to_string_base_10(s7_scheme *sc, s7_pointer obj, s7_int width, s7_int precision, char float_choice, s7_int *nlen, use_write_t choice) /* don't free result */ { /* called by number_to_string_with_radix g_number_to_string, number_to_string_p_p number_to_port format_number */ /* the rest of s7 assumes nlen is set to the correct length @@ -10856,12 +11018,12 @@ static char *number_to_string_base_10(s7_pointer obj, s7_int width, s7_int preci len = 512 + 2 * (width + precision); else len = 1024; - if (len > num_to_str_size) + if (len > sc->num_to_str_size) { - if (!num_to_str) - num_to_str = (char *)malloc(len * sizeof(char)); - else num_to_str = (char *)realloc(num_to_str, len * sizeof(char)); - num_to_str_size = len; + if (!sc->num_to_str) + sc->num_to_str = (char *)malloc(len * sizeof(char)); + else sc->num_to_str = (char *)realloc(sc->num_to_str, len * sizeof(char)); + sc->num_to_str_size = len; } /* bignums can't happen here */ @@ -10875,42 +11037,42 @@ static char *number_to_string_base_10(s7_pointer obj, s7_int width, s7_int preci (*nlen) = print_name_length(obj); return((char *)print_name(obj)); } - return(integer_to_string(integer(obj), nlen)); + return(integer_to_string(sc, integer(obj), nlen)); } { char *p; - p = integer_to_string(integer(obj), &len); + p = integer_to_string(sc, integer(obj), &len); if (width > len) { - insert_spaces(p, width, len); + insert_spaces(sc, p, width, len); (*nlen) = width; - return(num_to_str); + return(sc->num_to_str); } (*nlen) = len; return(p); } case T_RATIO: - len = catstrs_direct(num_to_str, integer_to_string_no_length(numerator(obj)), "/", pos_int_to_str_direct(denominator(obj)), NULL); + len = catstrs_direct(sc->num_to_str, integer_to_string_no_length(sc, numerator(obj)), "/", pos_int_to_str_direct(sc, denominator(obj)), NULL); if (width > len) { - insert_spaces(num_to_str, width, len); + insert_spaces(sc, sc->num_to_str, width, len); (*nlen) = width; } else (*nlen) = len; - return(num_to_str); + return(sc->num_to_str); case T_REAL: if (width == 0) - len = snprintf(num_to_str, num_to_str_size - 4, + len = snprintf(sc->num_to_str, sc->num_to_str_size - 4, (float_choice == 'g') ? "%.*g" : ((float_choice == 'f') ? "%.*f" : "%.*e"), (int32_t)precision, real(obj)); /* -4 for floatify */ - else len = snprintf(num_to_str, num_to_str_size - 4, + else len = snprintf(sc->num_to_str, sc->num_to_str_size - 4, (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e"), (int32_t)width, (int32_t)precision, real(obj)); /* -4 for floatify */ (*nlen) = len; - floatify(num_to_str, nlen); - return(num_to_str); + floatify(sc->num_to_str, nlen); + return(sc->num_to_str); default: { @@ -10951,30 +11113,30 @@ static char *number_to_string_base_10(s7_pointer obj, s7_int width, s7_int preci ip = ibuf; } } - num_to_str[0] = '\0'; - len = catstrs(num_to_str, num_to_str_size, "(complex ", rp, " ", ip, ")", NULL); + sc->num_to_str[0] = '\0'; + len = catstrs(sc->num_to_str, sc->num_to_str_size, "(complex ", rp, " ", ip, ")", NULL); } else { if (imag_part(obj) >= 0.0) - len = snprintf(num_to_str, num_to_str_size, + len = snprintf(sc->num_to_str, sc->num_to_str_size, (float_choice == 'g') ? "%.*g+%.*gi" : ((float_choice == 'f') ? "%.*f+%.*fi" : "%.*e+%.*ei"), (int32_t)precision, (double)real_part(obj), (int32_t)precision, (double)imag_part(obj)); - else len = snprintf(num_to_str, num_to_str_size, + else len = snprintf(sc->num_to_str, sc->num_to_str_size, (float_choice == 'g') ? "%.*g%.*gi" : ((float_choice == 'f') ? "%.*f%.*fi" :"%.*e%.*ei"), /* minus sign comes with the imag_part */ (int32_t)precision, (double)real_part(obj), (int32_t)precision, (double)imag_part(obj)); } if (width > len) /* (format #f "~20g" 1+i) */ { - insert_spaces(num_to_str, width, len); + insert_spaces(sc, sc->num_to_str, width, len); (*nlen) = width; } else (*nlen) = len; } break; } - return(num_to_str); + return(sc->num_to_str); } static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, s7_int radix, s7_int width, s7_int precision, char float_choice, s7_int *nlen) @@ -10996,7 +11158,7 @@ static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, s7_int r if (radix == 10) { - p = number_to_string_base_10(obj, width, precision, float_choice, nlen, P_WRITE); + p = number_to_string_base_10(sc, obj, width, precision, float_choice, nlen, P_WRITE); return(copy_string_with_length(p, *nlen)); } @@ -11063,11 +11225,11 @@ static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, s7_int r char *p1; len = 0; ep = (int32_t)floor(log(x) / log((double)radix)); - real_wrapper3.object.number.real_value = x / pow((double)radix, (double)ep); /* divide it down to one digit, then the fractional part */ - p1 = number_to_string_with_radix(sc, &real_wrapper3, radix, width, precision, float_choice, &len); + real(sc->real_wrapper3) = x / pow((double)radix, (double)ep); /* divide it down to one digit, then the fractional part */ + p1 = number_to_string_with_radix(sc, sc->real_wrapper3, radix, width, precision, float_choice, &len); p = (char *)malloc((len + 8) * sizeof(char)); p[0] = '\0'; - (*nlen) = catstrs(p, len + 8, (sign) ? "-" : "", p1, "e", integer_to_string_no_length(ep), NULL); + (*nlen) = catstrs(p, len + 8, (sign) ? "-" : "", p1, "e", integer_to_string_no_length(sc, ep), NULL); free(p1); return(p); } @@ -11104,10 +11266,10 @@ static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, s7_int r { char *n, *d; p = (char *)malloc(512 * sizeof(char)); - real_wrapper3.object.number.real_value = real_part(obj); - n = number_to_string_with_radix(sc, &real_wrapper3, radix, 0, precision, float_choice, &len); - real_wrapper4.object.number.real_value = imag_part(obj); - d = number_to_string_with_radix(sc, &real_wrapper4, radix, 0, precision, float_choice, &len); + real(sc->real_wrapper3) = real_part(obj); + n = number_to_string_with_radix(sc, sc->real_wrapper3, radix, 0, precision, float_choice, &len); + real(sc->real_wrapper4) = imag_part(obj); + d = number_to_string_with_radix(sc, sc->real_wrapper4, radix, 0, precision, float_choice, &len); p[0] = '\0'; len = catstrs(p, 512, n, (imag_part(obj) < 0.0) ? "" : "+", d, "i", NULL); str_len = 512; @@ -11184,7 +11346,7 @@ static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args) /* weird -- this is much slower due to malloc? */ block_t *b; res = number_to_string_with_radix(sc, x, radix, 0, sc->float_format_precision, 'g', &nlen); - b = mallocate_block(); + b = mallocate_block(sc); block_data(b) = (void *)res; block_set_index(b, TOP_BLOCK_LIST); return(block_to_string(sc, b, nlen)); @@ -11196,34 +11358,34 @@ static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args) return(p); #endif } - res = number_to_string_base_10(x, 0, sc->float_format_precision, 'g', &nlen, P_WRITE); + res = number_to_string_base_10(sc, x, 0, sc->float_format_precision, 'g', &nlen, P_WRITE); return(s7_make_string_with_length(sc, res, nlen)); } -static s7_pointer number_to_string_p_p(s7_pointer p) +static s7_pointer number_to_string_p_p(s7_scheme *sc, s7_pointer p) { s7_int nlen = 0; char *res; if (!is_number(p)) - return(wrong_type_argument_with_type(cur_sc, cur_sc->number_to_string_symbol, 1, p, a_number_string)); - res = number_to_string_base_10(p, 0, cur_sc->float_format_precision, 'g', &nlen, P_WRITE); - return(s7_make_string_with_length(cur_sc, res, nlen)); + return(wrong_type_argument_with_type(sc, sc->number_to_string_symbol, 1, p, a_number_string)); + res = number_to_string_base_10(sc, p, 0, sc->float_format_precision, 'g', &nlen, P_WRITE); + return(s7_make_string_with_length(sc, res, nlen)); } -static s7_pointer number_to_string_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer number_to_string_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { s7_int nlen = 0, radix; char *res; s7_pointer p; if (!is_number(p1)) - return(wrong_type_argument_with_type(cur_sc, cur_sc->number_to_string_symbol, 1, p1, a_number_string)); + return(wrong_type_argument_with_type(sc, sc->number_to_string_symbol, 1, p1, a_number_string)); if (!is_integer(p2)) - return(wrong_type_argument(cur_sc, cur_sc->number_to_string_symbol, 2, p2, T_INTEGER)); + return(wrong_type_argument(sc, sc->number_to_string_symbol, 2, p2, T_INTEGER)); radix = s7_integer(p2); if ((radix < 2) || (radix > 16)) - return(out_of_range(cur_sc, cur_sc->number_to_string_symbol, small_int(2), p2, a_valid_radix_string)); - res = number_to_string_with_radix(cur_sc, p1, radix, 0, cur_sc->float_format_precision, 'g', &nlen); - p = s7_make_string_with_length(cur_sc, res, nlen); + return(out_of_range(sc, sc->number_to_string_symbol, small_int(2), p2, a_valid_radix_string)); + res = number_to_string_with_radix(sc, p1, radix, 0, sc->float_format_precision, 'g', &nlen); + p = s7_make_string_with_length(sc, res, nlen); free(res); return(p); } @@ -11460,6 +11622,7 @@ static s7_pointer unknown_sharp_constant(s7_scheme *sc, char *name) #define SYMBOL_OK true #define NO_SYMBOLS false +static s7_pointer *chars; static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool with_error) { @@ -11495,7 +11658,7 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool with_error return(sc->undefined); if (strings_are_equal(name, "<eof>")) - return(sc->eof_object); + return(eof_object); return(unknown_sharp_constant(sc, name)); @@ -11659,7 +11822,7 @@ static s7_int string_to_integer(const char *str, s7_int radix, bool *overflow) { dig = digits[(uint8_t)(*tmp++)]; if (dig >= radix) break; -#if HAVE_OVERFLOW_CHECKS +#if HAVE_OVERFLOW_CHECKS && (!WITH_GMP) { s7_int oval = 0; if (multiply_overflow(lval, (s7_int)radix, &oval)) @@ -11690,7 +11853,7 @@ static s7_int string_to_integer(const char *str, s7_int radix, bool *overflow) } #if WITH_GMP - (*overflow) = ((lval > s7_int32_max) || + (*overflow) = ((lval > s7_int32_max) || ((tmp - tmp1) > s7_int_digits_by_radix[radix])); /* this tells the string->number readers to create a bignum. We need to be very * conservative here to catch contexts such as (/ 1/524288 19073486328125) @@ -12684,7 +12847,10 @@ static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args) } } -static s7_double magnitude_d_p(s7_pointer p) {return(s7_number_to_real_with_caller(cur_sc, g_magnitude(cur_sc, set_plist_1(cur_sc, p)), "magnitude"));} +static s7_double magnitude_d_7p(s7_scheme *sc, s7_pointer p) +{ + return(s7_number_to_real_with_caller(sc, g_magnitude(sc, set_plist_1(sc, p)), "magnitude")); +} /* -------------------------------- rationalize -------------------------------- */ @@ -12804,7 +12970,7 @@ static s7_pointer g_angle(s7_scheme *sc, s7_pointer args) } } -static s7_double angle_d_p(s7_pointer x) +static s7_double angle_d_7p(s7_scheme *sc, s7_pointer x) { switch (type(x)) { @@ -12812,7 +12978,7 @@ static s7_double angle_d_p(s7_pointer x) case T_RATIO: if (numerator(x) < 0) return(M_PI); return(0.0); case T_REAL: if (is_NaN(real(x))) return(NAN); if (real(x) < 0.0) return(M_PI); return(0.0); case T_COMPLEX: return(atan2(imag_part(x), real_part(x))); - default: simple_wrong_type_argument_with_type(cur_sc, cur_sc->angle_symbol, x, a_number_string); break; + default: simple_wrong_type_argument_with_type(sc, sc->angle_symbol, x, a_number_string); break; } return(0.0); } @@ -13007,11 +13173,11 @@ static s7_pointer g_complex(s7_scheme *sc, s7_pointer args) } } -static s7_pointer complex_p_ii(s7_int x, s7_int y) +static s7_pointer complex_p_ii(s7_scheme *sc, s7_int x, s7_int y) { if (y == 0) - return(make_real(cur_sc, (s7_double)x)); - return(c_complex(cur_sc, (s7_double)x, (s7_double)y)); + return(make_real(sc, (s7_double)x)); + return(c_complex(sc, (s7_double)x, (s7_double)y)); } @@ -13019,7 +13185,7 @@ static s7_pointer complex_p_ii(s7_int x, s7_int y) static s7_pointer g_exp(s7_scheme *sc, s7_pointer args) { #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459" - #define Q_exp pcl_n + #define Q_exp sc->pcl_n s7_pointer x; @@ -13065,7 +13231,7 @@ static s7_double exp_d_d(s7_double x) {return(exp(x));} static s7_pointer g_log(s7_scheme *sc, s7_pointer args) { #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3" - #define Q_log pcl_n + #define Q_log sc->pcl_n s7_pointer x; x = car(args); @@ -13166,7 +13332,7 @@ static s7_pointer g_log(s7_scheme *sc, s7_pointer args) static s7_pointer g_sin(s7_scheme *sc, s7_pointer args) { #define H_sin "(sin z) returns sin(z)" - #define Q_sin pcl_n + #define Q_sin sc->pcl_n s7_pointer x; x = car(args); @@ -13212,7 +13378,7 @@ static s7_double sin_d_d(s7_double x) {return(sin(x));} static s7_pointer g_cos(s7_scheme *sc, s7_pointer args) { #define H_cos "(cos z) returns cos(z)" - #define Q_cos pcl_n + #define Q_cos sc->pcl_n s7_pointer x; x = car(args); @@ -13247,7 +13413,7 @@ static s7_double cos_d_d(s7_double x) {return(cos(x));} static s7_pointer g_tan(s7_scheme *sc, s7_pointer args) { #define H_tan "(tan z) returns tan(z)" - #define Q_tan pcl_n + #define Q_tan sc->pcl_n s7_pointer x; x = car(args); @@ -13304,7 +13470,7 @@ static s7_pointer c_asin(s7_scheme *sc, s7_double x) static s7_pointer g_asin(s7_scheme *sc, s7_pointer args) { #define H_asin "(asin z) returns asin(z); (sin (asin x)) = x" - #define Q_asin pcl_n + #define Q_asin sc->pcl_n s7_pointer n; n = car(args); @@ -13368,7 +13534,7 @@ static s7_pointer c_acos(s7_scheme *sc, s7_double x) static s7_pointer g_acos(s7_scheme *sc, s7_pointer args) { #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1" - #define Q_acos pcl_n + #define Q_acos sc->pcl_n s7_pointer n; n = car(args); @@ -13466,7 +13632,7 @@ static s7_double atan_d_dd(s7_double x, s7_double y) {return(atan2(x, y));} static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args) { #define H_sinh "(sinh z) returns sinh(z)" - #define Q_sinh pcl_n + #define Q_sinh sc->pcl_n s7_pointer x; x = car(args); @@ -13498,7 +13664,7 @@ static s7_double sinh_d_d(s7_double x) {return(sinh(x));} static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args) { #define H_cosh "(cosh z) returns cosh(z)" - #define Q_cosh pcl_n + #define Q_cosh sc->pcl_n s7_pointer x; x = car(args); @@ -13538,7 +13704,7 @@ static s7_double cosh_d_d(s7_double x) {return(cosh(x));} static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args) { #define H_tanh "(tanh z) returns tanh(z)" - #define Q_tanh pcl_n + #define Q_tanh sc->pcl_n s7_pointer x; x = car(args); @@ -13575,7 +13741,7 @@ static s7_double tanh_d_d(s7_double x) {return(tanh(x));} static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args) { #define H_asinh "(asinh z) returns asinh(z)" - #define Q_asinh pcl_n + #define Q_asinh sc->pcl_n s7_pointer x; x = car(args); switch (type(x)) @@ -13612,7 +13778,7 @@ static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args) static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args) { #define H_acosh "(acosh z) returns acosh(z)" - #define Q_acosh pcl_n + #define Q_acosh sc->pcl_n s7_pointer x; x = car(args); switch (type(x)) @@ -13652,7 +13818,7 @@ static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args) static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args) { #define H_atanh "(atanh z) returns atanh(z)" - #define Q_atanh pcl_n + #define Q_atanh sc->pcl_n s7_pointer x; x = car(args); switch (type(x)) @@ -13694,7 +13860,7 @@ static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args) static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args) { #define H_sqrt "(sqrt z) returns the square root of z" - #define Q_sqrt pcl_n + #define Q_sqrt sc->pcl_n s7_pointer n; s7_double sqx; @@ -13808,7 +13974,7 @@ static bool int_pow_ok(s7_int x, s7_int y) static s7_pointer g_expt(s7_scheme *sc, s7_pointer args) { #define H_expt "(expt z1 z2) returns z1^z2" - #define Q_expt pcl_n + #define Q_expt sc->pcl_n s7_pointer n, pw; n = car(args); @@ -14024,7 +14190,7 @@ static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args) { /* (/ (* m n) (gcd m n)), (lcm a b c) -> (lcm a (lcm b c)) */ #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments" - #define Q_lcm pcl_f + #define Q_lcm sc->pcl_f s7_int n = 1, d = 0; s7_pointer p; @@ -14077,7 +14243,8 @@ static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args) break; default: - return(method_or_bust_with_type(sc, x, sc->lcm_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args))); + return(method_or_bust_with_type(sc, x, sc->lcm_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), + a_rational_string, position_of(p, args))); } if (n < 0) return(simple_out_of_range(sc, sc->lcm_symbol, args, result_is_too_large_string)); if (n == 0) @@ -14099,7 +14266,7 @@ static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args) static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args) { #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments" - #define Q_gcd pcl_f + #define Q_gcd sc->pcl_f s7_int n = 0, d = 1; s7_pointer p; @@ -14133,7 +14300,8 @@ static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args) break; default: - return(method_or_bust_with_type(sc, x, sc->gcd_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args))); + return(method_or_bust_with_type(sc, x, sc->gcd_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), + a_rational_string, position_of(p, args))); } if (n < 0) return(simple_out_of_range(sc, sc->gcd_symbol, args, result_is_too_large_string)); } @@ -14148,7 +14316,7 @@ static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf) { if ((xf > s7_int_max) || (xf < s7_int_min)) - return(simple_out_of_range(sc, caller, wrap_real(xf), its_too_large_string)); + return(simple_out_of_range(sc, caller, wrap_real(sc, xf), its_too_large_string)); if (xf > 0.0) return(make_integer(sc, (s7_int)floor(xf))); @@ -14158,9 +14326,9 @@ static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf) static inline s7_int c_quo_int(s7_scheme *sc, s7_int x, s7_int y) { if (y == 0) - division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, wrap_integer(x), wrap_integer2(y))); + division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, wrap_integer1(sc, x), wrap_integer2(sc, y))); if ((y == -1) && (x == s7_int_min)) /* (quotient most-negative-fixnum -1) */ - simple_out_of_range(sc, sc->quotient_symbol, set_elist_2(sc, wrap_integer(x), wrap_integer2(y)), its_too_large_string); + simple_out_of_range(sc, sc->quotient_symbol, set_elist_2(sc, wrap_integer1(sc, x), wrap_integer2(sc, y)), its_too_large_string); return(x / y); } @@ -14169,34 +14337,34 @@ static s7_double c_quo_dbl(s7_scheme *sc, s7_double x, s7_double y) s7_double xf; if (y == 0.0) - division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, wrap_real(x), wrap_real2(y))); + division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, wrap_real(sc, x), wrap_real2(sc, y))); if ((is_inf(y)) || (is_NaN(y))) - wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, wrap_real(y), a_normal_real_string); + wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, wrap_real(sc, y), a_normal_real_string); xf = x / y; if ((xf > s7_int_max) || (xf < s7_int_min)) - simple_out_of_range(sc, sc->quotient_symbol, wrap_real(xf), its_too_large_string); + simple_out_of_range(sc, sc->quotient_symbol, wrap_real(sc, xf), its_too_large_string); if (xf > 0.0) return(floor(xf)); return(ceil(xf)); } -static s7_int quotient_i_ii(s7_int i1, s7_int i2) {return(c_quo_int(cur_sc, i1, i2));} +static s7_int quotient_i_7ii(s7_scheme *sc, s7_int i1, s7_int i2) {return(c_quo_int(sc, i1, i2));} static s7_int quotient_i_ii_direct(s7_int i1, s7_int i2) {return(i1 / i2);} /* i2 > 0 */ -static s7_double quotient_d_dd(s7_double x1, s7_double x2) +static s7_double quotient_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2) { if ((is_inf(x1)) || (is_NaN(x1))) - wrong_type_argument_with_type(cur_sc, cur_sc->quotient_symbol, 1, wrap_real(x1), a_normal_real_string); - return(c_quo_dbl(cur_sc, x1, x2)); + wrong_type_argument_with_type(sc, sc->quotient_symbol, 1, wrap_real(sc, x1), a_normal_real_string); + return(c_quo_dbl(sc, x1, x2)); } static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args) { #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1" - #define Q_quotient pcl_r + #define Q_quotient sc->pcl_r /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib */ s7_pointer x, y; @@ -14316,7 +14484,7 @@ static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args) static inline s7_int c_rem_int(s7_scheme *sc, s7_int x, s7_int y) { if (y == 0) - division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, wrap_integer(x), wrap_integer2(y))); + division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, wrap_integer1(sc, x), wrap_integer2(sc, y))); if ((y == 1) || (y == -1)) /* (remainder most-negative-fixnum -1) will segfault with arithmetic exception */ return(0); return(x % y); @@ -14327,33 +14495,33 @@ static s7_double c_rem_dbl(s7_scheme *sc, s7_double x, s7_double y) s7_int quo; s7_double pre_quo; if (y == 0.0) - division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, wrap_real(x), wrap_real2(y))); + division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, wrap_real(sc, x), wrap_real2(sc, y))); if ((is_inf(y)) || (is_NaN(y))) - wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, set_elist_1(sc, wrap_real(y)), a_normal_real_string); + wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, set_elist_1(sc, wrap_real(sc, y)), a_normal_real_string); pre_quo = x / y; if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min)) - simple_out_of_range(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), wrap_real(y)), its_too_large_string); + simple_out_of_range(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), wrap_real(sc, y)), its_too_large_string); if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo); return(x - (y * quo)); } -static s7_int remainder_i_ii(s7_int i1, s7_int i2) {return(c_rem_int(cur_sc, i1, i2));} +static s7_int remainder_i_7ii(s7_scheme *sc, s7_int i1, s7_int i2) {return(c_rem_int(sc, i1, i2));} static s7_int remainder_i_ii_direct(s7_int i1, s7_int i2) {return(i1 % i2);} /* i2 > 1 */ -static s7_double remainder_d_dd(s7_double x1, s7_double x2) +static s7_double remainder_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2) { if ((is_inf(x1)) || (is_NaN(x1))) - wrong_type_argument_with_type(cur_sc, cur_sc->remainder_symbol, 1, set_elist_1(cur_sc, wrap_real(x1)), a_normal_real_string); - return(c_rem_dbl(cur_sc, x1, x2)); + wrong_type_argument_with_type(sc, sc->remainder_symbol, 1, set_elist_1(sc, wrap_real(sc, x1)), a_normal_real_string); + return(c_rem_dbl(sc, x1, x2)); } static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args) { #define H_remainder "(remainder x1 x2) returns the remainder of x1/x2; (remainder 10 3) = 1" - #define Q_remainder pcl_r + #define Q_remainder sc->pcl_r /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib, if x2 is an integer (- x1 (truncate x1 x2)), fractional part: (remainder x 1) */ s7_pointer x, y; @@ -14584,30 +14752,23 @@ static s7_pointer g_floor(s7_scheme *sc, s7_pointer args) } static s7_int floor_i_i(s7_int i) {return(i);} -static s7_int floor_i_d(s7_double x) -{ - if (is_NaN(x)) - simple_out_of_range(cur_sc, cur_sc->floor_symbol, wrap_real(x), its_nan_string); - if (fabs(x) > REAL_TO_INT_LIMIT) - simple_out_of_range(cur_sc, cur_sc->floor_symbol, wrap_real(x), its_too_large_string); - return((s7_int)floor(x)); -} -static s7_double floor_d_d(s7_double x) +static s7_int floor_i_7d(s7_scheme *sc, s7_double x) { + if (is_NaN(x)) - simple_out_of_range(cur_sc, cur_sc->floor_symbol, wrap_real(x), its_nan_string); + simple_out_of_range(sc, sc->floor_symbol, wrap_real(sc, x), its_nan_string); if (fabs(x) > REAL_TO_INT_LIMIT) - simple_out_of_range(cur_sc, cur_sc->floor_symbol, wrap_real(x), its_too_large_string); - return(floor(x)); + simple_out_of_range(sc, sc->floor_symbol, wrap_real(sc, x), its_too_large_string); + return((s7_int)floor(x)); } -static s7_int floor_i_p(s7_pointer p) +static s7_int floor_i_7p(s7_scheme *sc, s7_pointer p) { if (is_t_integer(p)) return(s7_integer(p)); - if (is_t_real(p)) return(floor_i_d(real(p))); + if (is_t_real(p)) return(floor_i_7d(sc, real(p))); if (is_t_ratio(p)) return((s7_int)(floor(fraction(p)))); - s7_wrong_type_arg_error(cur_sc, "floor", 0, p, "a real number"); + s7_wrong_type_arg_error(sc, "floor", 0, p, "a real number"); return(0); } @@ -14655,34 +14816,24 @@ static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args) } static s7_int ceiling_i_i(s7_int i) {return(i);} -static s7_int ceiling_i_d(s7_double x) -{ - if (is_NaN(x)) - simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, wrap_real(x), its_nan_string); - if ((is_inf(x)) || - (x > REAL_TO_INT_LIMIT) || - (x < -REAL_TO_INT_LIMIT)) - simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, wrap_real(x), its_too_large_string); - return((s7_int)ceil(x)); -} -static s7_double ceiling_d_d(s7_double x) +static s7_int ceiling_i_7d(s7_scheme *sc, s7_double x) { if (is_NaN(x)) - simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, wrap_real(x), its_nan_string); + simple_out_of_range(sc, sc->ceiling_symbol, wrap_real(sc, x), its_nan_string); if ((is_inf(x)) || (x > REAL_TO_INT_LIMIT) || (x < -REAL_TO_INT_LIMIT)) - simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, wrap_real(x), its_too_large_string); - return(ceil(x)); + simple_out_of_range(sc, sc->ceiling_symbol, wrap_real(sc, x), its_too_large_string); + return((s7_int)ceil(x)); } -static s7_int ceiling_i_p(s7_pointer p) +static s7_int ceiling_i_7p(s7_scheme *sc, s7_pointer p) { if (is_t_integer(p)) return(s7_integer(p)); - if (is_t_real(p)) return(ceiling_i_d(real(p))); + if (is_t_real(p)) return(ceiling_i_7d(sc, real(p))); if (is_t_ratio(p)) return((s7_int)(ceil(fraction(p)))); - s7_wrong_type_arg_error(cur_sc, "ceiling", 0, p, "a real number"); + s7_wrong_type_arg_error(sc, "ceiling", 0, p, "a real number"); return(0); } @@ -14722,25 +14873,23 @@ static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args) static s7_int truncate_i_i(s7_int i) {return(i);} -static s7_double truncate_d_d(s7_double x) +static s7_int truncate_i_7d(s7_scheme *sc, s7_double x) { if (is_NaN(x)) - simple_out_of_range(cur_sc, cur_sc->truncate_symbol, wrap_real(x), its_nan_string); + simple_out_of_range(sc, sc->truncate_symbol, wrap_real(sc, x), its_nan_string); if (is_inf(x)) - simple_out_of_range(cur_sc, cur_sc->truncate_symbol, wrap_real(x), its_infinite_string); + simple_out_of_range(sc, sc->truncate_symbol, wrap_real(sc, x), its_infinite_string); if (x > 0.0) { if (x > s7_int_max) - simple_out_of_range(cur_sc, cur_sc->truncate_symbol, wrap_real(x), its_too_large_string); - return(floor(x)); + simple_out_of_range(sc, sc->truncate_symbol, wrap_real(sc, x), its_too_large_string); + return((s7_int)floor(x)); } if (x < s7_int_min) - simple_out_of_range(cur_sc, cur_sc->truncate_symbol, wrap_real(x), its_too_large_string); - return(ceil(x)); + simple_out_of_range(sc, sc->truncate_symbol, wrap_real(sc, x), its_too_large_string); + return((s7_int)ceil(x)); } -static s7_int truncate_i_d(s7_double x) {return((s7_int)truncate_d_d(x));} - /* -------------------------------- round -------------------------------- */ static s7_double round_per_R5RS(s7_double x) @@ -14810,26 +14959,17 @@ static s7_pointer g_round(s7_scheme *sc, s7_pointer args) } static s7_int round_i_i(s7_int i) {return(i);} -static s7_int round_i_d(s7_double z) -{ - if (is_NaN(z)) - simple_out_of_range(cur_sc, cur_sc->round_symbol, wrap_real(z), its_nan_string); - if ((is_inf(z)) || - (z > REAL_TO_INT_LIMIT) || - (z < -REAL_TO_INT_LIMIT)) - simple_out_of_range(cur_sc, cur_sc->round_symbol, wrap_real(z), its_too_large_string); - return((s7_int)round_per_R5RS(z)); -} -static s7_double round_d_d(s7_double z) +static s7_int round_i_7d(s7_scheme *sc, s7_double z) + { if (is_NaN(z)) - simple_out_of_range(cur_sc, cur_sc->round_symbol, wrap_real(z), its_nan_string); + simple_out_of_range(sc, sc->round_symbol, wrap_real(sc, z), its_nan_string); if ((is_inf(z)) || (z > REAL_TO_INT_LIMIT) || (z < -REAL_TO_INT_LIMIT)) - simple_out_of_range(cur_sc, cur_sc->round_symbol, wrap_real(z), its_too_large_string); - return(round_per_R5RS(z)); + simple_out_of_range(sc, sc->round_symbol, wrap_real(sc, z), its_too_large_string); + return((s7_int)round_per_R5RS(z)); } @@ -14861,7 +15001,7 @@ static s7_double modulo_d_dd(s7_double x1, s7_double x2) {return(x1 - x2 * (s7_i static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args) { #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers." - #define Q_modulo pcl_r + #define Q_modulo sc->pcl_r /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) from slib * (mod x 0) = x according to "Concrete Mathematics" */ @@ -15047,7 +15187,6 @@ static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args) } } -static s7_pointer mod_si; static s7_pointer g_mod_si(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -15142,7 +15281,7 @@ static int32_t reduce_fraction(s7_int *numer, s7_int *denom) static s7_pointer g_add(s7_scheme *sc, s7_pointer args) { #define H_add "(+ ...) adds its arguments" - #define Q_add pcl_n + #define Q_add sc->pcl_n s7_pointer x, p; s7_int num_a, den_a, dn; s7_double rl_a, im_a; @@ -15444,8 +15583,6 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args) } -static s7_pointer add_2, add_1s, add_s1, add_cs1, add_si, add_sf, add_fs; - static s7_pointer add_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y) { s7_int d1, d2, n1, n2; @@ -15704,7 +15841,6 @@ static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer add_f_sf; static s7_pointer g_add_f_sf(s7_scheme *sc, s7_pointer args) { /* (+ x (* s y)) */ @@ -15746,10 +15882,10 @@ static s7_int add_i_ii(s7_int i1, s7_int i2) {return(i1 + i2);} static s7_int add_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 + i2 + i3);} #if (!WITH_GMP) -static s7_pointer add_p_dd(s7_double x1, s7_double x2) {return(make_real(cur_sc, x1 + x2));} +static s7_pointer add_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 + x2));} /* add_p_ii and add_d_id unhittable apparently */ #endif -static s7_pointer add_p_pp(s7_pointer p1, s7_pointer p2) {return(g_add_2(cur_sc, set_plist_2(cur_sc, p1, p2)));} +static s7_pointer add_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(g_add_2(sc, set_plist_2(sc, p1, p2)));} /* ---------------------------------------- subtract ---------------------------------------- */ @@ -15757,7 +15893,7 @@ static s7_pointer add_p_pp(s7_pointer p1, s7_pointer p2) {return(g_add_2(cur_sc, static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args) { #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one it is given" - #define Q_subtract pcl_n + #define Q_subtract sc->pcl_n s7_pointer x, p; s7_int num_a, den_a; @@ -16038,7 +16174,6 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args) } -static s7_pointer subtract_1, subtract_s1, subtract_cs1, subtract_2, subtract_csn; static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -16193,28 +16328,7 @@ static s7_pointer g_subtract_cs1(s7_scheme *sc, s7_pointer args) static s7_pointer g_subtract_s1(s7_scheme *sc, s7_pointer args) { - s7_pointer x; - x = car(args); /* this one seems to hit reals as often as integers */ - switch (type(x)) - { -#if HAVE_OVERFLOW_CHECKS - case T_INTEGER: - { - s7_int val; - if (subtract_overflow(integer(x), 1, &val)) - return(make_real(sc, (double)integer(x) - 1.0)); - return(make_integer(sc, val)); - } -#else - case T_INTEGER: return(make_integer(sc, integer(x) - 1)); -#endif - case T_RATIO: return(subtract_ratios(sc, x, small_int(1))); - case T_REAL: return(make_real(sc, real(x) - 1.0)); - case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x))); - default: - return(method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1)); - } - return(x); + return(minus_c1(sc, car(args))); } static s7_pointer g_subtract_csn(s7_scheme *sc, s7_pointer args) @@ -16249,7 +16363,6 @@ static s7_pointer g_subtract_csn(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer subtract_sf; static s7_pointer g_subtract_sf(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -16269,7 +16382,6 @@ static s7_pointer g_subtract_sf(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer subtract_2f; static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -16289,7 +16401,6 @@ static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer subtract_fs; static s7_pointer g_subtract_fs(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -16319,9 +16430,9 @@ static s7_double subtract_d_ddd(s7_double x1, s7_double x2, s7_double x3) {retur static s7_double subtract_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 - x2 - x3 - x4);} #if (!WITH_GMP) -static s7_pointer sub_p_dd(s7_double x1, s7_double x2) {return(make_real(cur_sc, x1 - x2));} +static s7_pointer sub_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 - x2));} #endif -static s7_pointer subtract_p_pp(s7_pointer p1, s7_pointer p2) {return(g_subtract_2(cur_sc, set_plist_2(cur_sc, p1, p2)));} +static s7_pointer subtract_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(g_subtract_2(sc, set_plist_2(sc, p1, p2)));} /* ---------------------------------------- multiply ---------------------------------------- */ @@ -16329,7 +16440,7 @@ static s7_pointer subtract_p_pp(s7_pointer p1, s7_pointer p2) {return(g_subtract static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args) { #define H_multiply "(* ...) multiplies its arguments" - #define Q_multiply pcl_n + #define Q_multiply sc->pcl_n s7_pointer x, p; s7_int num_a, den_a; @@ -16620,8 +16731,6 @@ static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args) } #if (!WITH_GMP) -static s7_pointer multiply_2, multiply_fs, multiply_sf, multiply_is, multiply_si; - static s7_pointer g_multiply_2(s7_scheme *sc, s7_pointer args) { s7_pointer x, y; @@ -16855,7 +16964,6 @@ static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer sqr_ss; static s7_pointer g_sqr_ss(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -16924,9 +17032,9 @@ static s7_double multiply_d_dd(s7_double x1, s7_double x2) {return(x1 * x2);} static s7_double multiply_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 * x2 * x3);} static s7_double multiply_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 * x2 * x3 * x4);} #if (!WITH_GMP) -static s7_pointer mul_p_dd(s7_double x1, s7_double x2) {return(make_real(cur_sc, x1 * x2));} +static s7_pointer mul_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_real(sc, x1 * x2));} -static s7_pointer multiply_p_pp(s7_pointer x1, s7_pointer x2) {return(g_multiply_2(cur_sc, set_plist_2(cur_sc, x1, x2)));} +static s7_pointer multiply_p_pp(s7_scheme *sc, s7_pointer x1, s7_pointer x2) {return(g_multiply_2(sc, set_plist_2(sc, x1, x2)));} #endif @@ -16949,7 +17057,7 @@ static bool is_number_via_method(s7_scheme *sc, s7_pointer p) static s7_pointer g_divide(s7_scheme *sc, s7_pointer args) { #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument" - #define Q_divide pcl_n + #define Q_divide sc->pcl_n s7_pointer x, y, p; @@ -17185,8 +17293,6 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args) } #if (!WITH_GMP) -static s7_pointer invert_1; - static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -17220,8 +17326,6 @@ static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args) } } - -static s7_pointer divide_1r; static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args) { if (s7_is_real(cadr(args))) @@ -17237,35 +17341,19 @@ static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args) #endif -static s7_double divide_d_d(s7_double x) +static s7_double divide_d_7d(s7_scheme *sc, s7_double x) { - if (x == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero)); + if (x == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_1(sc, real_zero)); return(1.0 / x); } -static s7_double divide_d_dd(s7_double x1, s7_double x2) +static s7_double divide_d_7dd(s7_scheme *sc, s7_double x1, s7_double x2) { - if (x2 == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero)); + if (x2 == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_1(sc, real_zero)); return(x1 / x2); } -static s7_double divide_d_ddd(s7_double x1, s7_double x2, s7_double x3) -{ - s7_double d; - d = x2 * x3; - if (d == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero)); - return(x1 / d); -} - -static s7_double divide_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) -{ - s7_double d; - d = x2 * x3 * x4; - if (d == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero)); - return(x1 / d); -} - -static s7_pointer divide_p_ii(s7_int x, s7_int y) {return(s7_make_ratio(cur_sc, x, y));} /* make-ratio checks for y==0 */ +static s7_pointer divide_p_ii(s7_scheme *sc, s7_int x, s7_int y) {return(s7_make_ratio(sc, x, y));} /* make-ratio checks for y==0 */ /* ---------------------------------------- max/min ---------------------------------------- */ @@ -17285,7 +17373,7 @@ static bool is_real_via_method_1(s7_scheme *sc, s7_pointer p) static s7_pointer g_max(s7_scheme *sc, s7_pointer args) { #define H_max "(max ...) returns the maximum of its arguments" - #define Q_max pcl_r + #define Q_max sc->pcl_r s7_pointer x, y, p; s7_int num_a, num_b, den_a, den_b; @@ -17499,7 +17587,7 @@ static s7_double max_d_dd(s7_double x1, s7_double x2) {if (is_NaN(x1)) return(x1 static s7_pointer g_min(s7_scheme *sc, s7_pointer args) { #define H_min "(min ...) returns the minimum of its arguments" - #define Q_min pcl_r + #define Q_min sc->pcl_r s7_pointer x, y, p; s7_int num_a, num_b, den_a, den_b; @@ -17839,7 +17927,6 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args) static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj); #if (!WITH_GMP) -static s7_pointer equal_s_ic; static s7_pointer g_equal_s_ic(s7_scheme *sc, s7_pointer args) { s7_int y; @@ -17862,7 +17949,6 @@ static s7_pointer g_equal_s_ic(s7_scheme *sc, s7_pointer args) return(sc->T); } -static s7_pointer equal_length_ic; static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args) { /* avoid make_integer (and telescope opts), we get here with car=length expr, cadr=int */ @@ -17912,7 +17998,7 @@ static bool equal_b_pi(s7_scheme *sc, s7_pointer x, s7_int y) case T_REAL: return(real(x) == y); case T_COMPLEX: return(false); default: - simple_wrong_type_argument_with_type(cur_sc, sc->eq_symbol, x, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->eq_symbol, x, a_number_string); } return(false); } @@ -18013,30 +18099,28 @@ static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y) } #if (!WITH_GMP) -static s7_pointer equal_p_pp(s7_pointer p1, s7_pointer p2) {return(c_equal_2(cur_sc, p1, p2));} -static s7_pointer equal_p_pi(s7_pointer p1, s7_int p2) +static s7_pointer equal_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(c_equal_2(sc, p1, p2));} +static s7_pointer equal_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) { if (is_integer(p1)) - return((integer(p1) == p2) ? cur_sc->T : cur_sc->F); + return((integer(p1) == p2) ? sc->T : sc->F); if (is_t_real(p1)) - return((real(p1) == p2) ? cur_sc->T : cur_sc->F); + return((real(p1) == p2) ? sc->T : sc->F); if (is_number(p1)) - return(cur_sc->F); - return(wrong_type_argument_with_type(cur_sc, cur_sc->eq_symbol, 1, p1, a_number_string)); + return(sc->F); + return(wrong_type_argument_with_type(sc, sc->eq_symbol, 1, p1, a_number_string)); } -static s7_pointer equal_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 == x2));} -static s7_pointer gt_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 > x2));} -static s7_pointer geq_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 >= x2));} -static s7_pointer lt_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 < x2));} -static s7_pointer leq_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 <= x2));} -static s7_pointer equal_p_ii(s7_int x1, s7_int x2) {return(make_boolean(cur_sc, x1 == x2));} -static s7_pointer gt_p_ii(s7_int x1, s7_int x2) {return(make_boolean(cur_sc, x1 > x2));} -static s7_pointer geq_p_ii(s7_int x1, s7_int x2) {return(make_boolean(cur_sc, x1 >= x2));} -static s7_pointer lt_p_ii(s7_int x1, s7_int x2) {return(make_boolean(cur_sc, x1 < x2));} -static s7_pointer leq_p_ii(s7_int x1, s7_int x2) {return(make_boolean(cur_sc, x1 <= x2));} - -static s7_pointer equal_2, equal_2i; +static s7_pointer equal_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 == x2));} +static s7_pointer gt_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 > x2));} +static s7_pointer geq_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 >= x2));} +static s7_pointer lt_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 < x2));} +static s7_pointer leq_p_dd(s7_scheme *sc, s7_double x1, s7_double x2) {return(make_boolean(sc, x1 <= x2));} +static s7_pointer equal_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 == x2));} +static s7_pointer gt_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 > x2));} +static s7_pointer geq_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 >= x2));} +static s7_pointer lt_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 < x2));} +static s7_pointer leq_p_ii(s7_scheme *sc, s7_int x1, s7_int x2) {return(make_boolean(sc, x1 <= x2));} #endif static s7_pointer g_equal_2(s7_scheme *sc, s7_pointer args) @@ -18761,7 +18845,6 @@ static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args) } -static s7_pointer less_s_ic, less_s0; static s7_pointer g_less_s0(s7_scheme *sc, s7_pointer args) { s7_pointer x; @@ -18801,7 +18884,6 @@ static s7_pointer g_less_s_ic(s7_scheme *sc, s7_pointer args) return(method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1)); } -static s7_pointer less_length_ic; static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args) { s7_int ilen; @@ -18850,7 +18932,7 @@ static s7_pointer lt_out_y(s7_scheme *sc, s7_pointer x, s7_pointer y) return(wrong_type_argument(sc, sc->lt_symbol, 2, y, T_REAL)); } -static s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y) +static inline s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -18914,9 +18996,8 @@ static s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y) return(sc->T); } -static s7_pointer lt_p_pp(s7_pointer p1, s7_pointer p2) {return(c_less_2(cur_sc, p1, p2));} +static s7_pointer lt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(c_less_2(sc, p1, p2));} -static s7_pointer less_2; static s7_pointer g_less_2(s7_scheme *sc, s7_pointer args) {return(c_less_2(sc, car(args), cadr(args)));} static bool ratio_leq_pi(s7_pointer x, s7_int y) @@ -18930,7 +19011,6 @@ static bool ratio_leq_pi(s7_pointer x, s7_int y) return(fraction(x) <= y); } -static s7_pointer leq_s_ic; static s7_pointer g_leq_s_ic(s7_scheme *sc, s7_pointer args) { s7_int y; @@ -19014,12 +19094,10 @@ static s7_pointer c_leq_2(s7_scheme *sc, s7_pointer x, s7_pointer y) return(sc->T); } -static s7_pointer leq_p_pp(s7_pointer p1, s7_pointer p2) {return(c_leq_2(cur_sc, p1, p2));} +static s7_pointer leq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(c_leq_2(sc, p1, p2));} -static s7_pointer leq_2; static s7_pointer g_leq_2(s7_scheme *sc, s7_pointer args) {return(c_leq_2(sc, car(args), cadr(args)));} -static s7_pointer greater_s_ic, greater_s_fc; static s7_pointer g_greater_s_ic(s7_scheme *sc, s7_pointer args) { s7_int y; @@ -19146,9 +19224,8 @@ static s7_pointer c_greater_2(s7_scheme *sc, s7_pointer x, s7_pointer y) return(sc->T); } -static s7_pointer gt_p_pp(s7_pointer p1, s7_pointer p2) {return(c_greater_2(cur_sc, p1, p2));} +static s7_pointer gt_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(c_greater_2(sc, p1, p2));} -static s7_pointer greater_2; static s7_pointer g_greater_2(s7_scheme *sc, s7_pointer args) {return(c_greater_2(sc, car(args), cadr(args)));} static s7_pointer geq_out_x(s7_scheme *sc, s7_pointer x, s7_pointer y) @@ -19228,16 +19305,13 @@ static s7_pointer c_geq_2(s7_scheme *sc, s7_pointer x, s7_pointer y) } return(sc->T); } -static s7_pointer geq_p_pp(s7_pointer p1, s7_pointer p2) {return(c_geq_2(cur_sc, p1, p2));} +static s7_pointer geq_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(c_geq_2(sc, p1, p2));} #endif -static s7_pointer geq_2 = NULL; - #if (!WITH_GMP) static s7_pointer g_geq_2(s7_scheme *sc, s7_pointer args) {return(c_geq_2(sc, car(args), cadr(args)));} -static s7_pointer geq_s_fc; static s7_pointer g_geq_s_fc(s7_scheme *sc, s7_pointer args) { s7_double y; @@ -19251,7 +19325,6 @@ static s7_pointer g_geq_s_fc(s7_scheme *sc, s7_pointer args) return(g_geq_2(sc, args)); } -static s7_pointer geq_s_ic; static s7_pointer g_geq_s_ic(s7_scheme *sc, s7_pointer args) { s7_int y; @@ -19269,7 +19342,7 @@ static s7_pointer g_geq_s_ic(s7_scheme *sc, s7_pointer args) return(method_or_bust(sc, x, sc->geq_symbol, args, T_REAL, 1)); } -static bool lt_b_pp(s7_pointer x, s7_pointer y) +static bool lt_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -19282,10 +19355,10 @@ static bool lt_b_pp(s7_pointer x, s7_pointer y) return(fraction(x) < fraction(y)); } #endif - return(c_less_2(cur_sc, x, y) != cur_sc->F); + return(c_less_2(sc, x, y) != sc->F); } -static bool leq_b_pp(s7_pointer x, s7_pointer y) +static bool leq_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -19298,10 +19371,10 @@ static bool leq_b_pp(s7_pointer x, s7_pointer y) return(fraction(x) <= fraction(y)); } #endif - return(c_leq_2(cur_sc, x, y) != cur_sc->F); + return(c_leq_2(sc, x, y) != sc->F); } -static bool gt_b_pp(s7_pointer x, s7_pointer y) +static bool gt_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -19314,10 +19387,10 @@ static bool gt_b_pp(s7_pointer x, s7_pointer y) return(fraction(x) > fraction(y)); } #endif - return(c_greater_2(cur_sc, x, y) != cur_sc->F); + return(c_greater_2(sc, x, y) != sc->F); } -static bool geq_b_pp(s7_pointer x, s7_pointer y) +static bool geq_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -19330,10 +19403,10 @@ static bool geq_b_pp(s7_pointer x, s7_pointer y) return(fraction(x) >= fraction(y)); } #endif - return(c_geq_2(cur_sc, x, y) != cur_sc->F); + return(c_geq_2(sc, x, y) != sc->F); } -static bool req_b_pp(s7_pointer x, s7_pointer y) +static bool req_b_7pp(s7_scheme *sc, s7_pointer x, s7_pointer y) { #if (!MS_WINDOWS) if (type(x) == type(y)) @@ -19346,54 +19419,54 @@ static bool req_b_pp(s7_pointer x, s7_pointer y) return(fraction(x) == fraction(y)); } #endif - return(c_equal_2(cur_sc, x, y) != cur_sc->F); + return(c_equal_2(sc, x, y) != sc->F); } -static bool req_b_pi(s7_pointer i1, s7_int i2) {return(equal_b_pi(cur_sc, i1, i2));} +static bool req_b_pi(s7_scheme *sc, s7_pointer i1, s7_int i2) {return(equal_b_pi(sc, i1, i2));} -static bool lt_b_pi(s7_pointer p1, s7_int p2) +static bool lt_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) { if (is_integer(p1)) return(integer(p1) < p2); if (is_t_real(p1)) return(real(p1) < p2); if (is_t_ratio(p1)) return(ratio_lt_pi(p1, p2)); - simple_wrong_type_argument(cur_sc, cur_sc->lt_symbol, p1, T_REAL); + simple_wrong_type_argument(sc, sc->lt_symbol, p1, T_REAL); return(false); } -static s7_pointer lt_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, lt_b_pi(p1, p2)));} +static s7_pointer lt_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, lt_b_pi(sc, p1, p2)));} -static bool leq_b_pi(s7_pointer p1, s7_int p2) +static bool leq_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) { if (is_integer(p1)) return(integer(p1) <= p2); if (is_t_real(p1)) return(real(p1) <= p2); if (is_t_ratio(p1)) return(ratio_leq_pi(p1, p2)); - simple_wrong_type_argument(cur_sc, cur_sc->leq_symbol, p1, T_REAL); + simple_wrong_type_argument(sc, sc->leq_symbol, p1, T_REAL); return(false); } -static s7_pointer leq_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, leq_b_pi(p1, p2)));} +static s7_pointer leq_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, leq_b_pi(sc, p1, p2)));} -static bool gt_b_pi(s7_pointer p1, s7_int p2) +static bool gt_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) { if (is_integer(p1)) return(integer(p1) > p2); if (is_t_real(p1)) return(real(p1) > p2); if (is_t_ratio(p1)) return(!ratio_leq_pi(p1, p2)); - simple_wrong_type_argument(cur_sc, cur_sc->gt_symbol, p1, T_REAL); + simple_wrong_type_argument(sc, sc->gt_symbol, p1, T_REAL); return(false); } -static s7_pointer gt_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, gt_b_pi(p1, p2)));} +static s7_pointer gt_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, gt_b_pi(sc, p1, p2)));} -static bool geq_b_pi(s7_pointer p1, s7_int p2) +static bool geq_b_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) { if (is_integer(p1)) return(integer(p1) >= p2); if (is_t_real(p1)) return(real(p1) >= p2); if (is_t_ratio(p1)) return(!ratio_lt_pi(p1, p2)); - simple_wrong_type_argument(cur_sc, cur_sc->geq_symbol, p1, T_REAL); + simple_wrong_type_argument(sc, sc->geq_symbol, p1, T_REAL); return(false); } -static s7_pointer geq_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, geq_b_pi(p1, p2)));} +static s7_pointer geq_p_pi(s7_scheme *sc, s7_pointer p1, s7_int p2) {return(make_boolean(sc, geq_b_pi(sc, p1, p2)));} #endif /* end (!WITH_GMP) */ @@ -19530,17 +19603,17 @@ static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args) } #if (!WITH_GMP) -static s7_double real_part_d_p(s7_pointer p) +static s7_double real_part_d_7p(s7_scheme *sc, s7_pointer p) { if (!is_number(p)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->real_part_symbol, p, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->real_part_symbol, p, a_number_string); return(s7_real_part(p)); } -static s7_double imag_part_d_p(s7_pointer p) +static s7_double imag_part_d_7p(s7_scheme *sc, s7_pointer p) { if (!is_number(p)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->imag_part_symbol, p, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->imag_part_symbol, p, a_number_string); return(s7_imag_part(p)); } #endif @@ -19567,10 +19640,10 @@ static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args) } } -static s7_int numerator_i(s7_pointer p) +static s7_int numerator_i_7p(s7_scheme *sc, s7_pointer p) { if (!is_rational(p)) - simple_wrong_type_argument(cur_sc, cur_sc->numerator_symbol, p, T_RATIO); + simple_wrong_type_argument(sc, sc->numerator_symbol, p, T_RATIO); return(numerator(p)); } @@ -19594,10 +19667,10 @@ static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args) } } -static s7_int denominator_i(s7_pointer p) +static s7_int denominator_i_7p(s7_scheme *sc, s7_pointer p) { if (!is_rational(p)) - simple_wrong_type_argument(cur_sc, cur_sc->denominator_symbol, p, T_RATIO); + simple_wrong_type_argument(sc, sc->denominator_symbol, p, T_RATIO); if (is_integer(p)) return(1); return(denominator(p)); @@ -19609,7 +19682,7 @@ static s7_int denominator_i(s7_pointer p) static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args) { #define H_is_nan "(nan? obj) returns #t if obj is a NaN" - #define Q_is_nan pl_bn + #define Q_is_nan sc->pl_bn s7_pointer x; x = car(args); @@ -19642,13 +19715,13 @@ static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args) } } -static bool is_nan_b(s7_pointer p) {return(g_is_nan(cur_sc, set_plist_1(cur_sc, p)) != cur_sc->F);} +static bool is_nan_b_7p(s7_scheme *sc, s7_pointer p) {return(g_is_nan(sc, set_plist_1(sc, p)) != sc->F);} static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args) { #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real" - #define Q_is_infinite pl_bn + #define Q_is_infinite sc->pl_bn s7_pointer x; x = car(args); @@ -19683,7 +19756,7 @@ static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args) } } -static bool is_infinite_b(s7_pointer p) {return(g_is_infinite(cur_sc, set_plist_1(cur_sc, p)) != cur_sc->F);} +static bool is_infinite_b_7p(s7_scheme *sc, s7_pointer p) {return(g_is_infinite(sc, set_plist_1(sc, p)) != sc->F);} /* ---------------------------------------- number? complex? integer? rational? real? ---------------------------------------- */ @@ -19691,7 +19764,7 @@ static bool is_infinite_b(s7_pointer p) {return(g_is_infinite(cur_sc, set_plist_ static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args) { #define H_is_number "(number? obj) returns #t if obj is a number" - #define Q_is_number pl_bt + #define Q_is_number sc->pl_bt check_boolean_method(sc, s7_is_number, sc->is_number_symbol, args); /* we need the s7_* versions here for the GMP case */ } @@ -19699,7 +19772,7 @@ static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args) { #define H_is_integer "(integer? obj) returns #t if obj is an integer" - #define Q_is_integer pl_bt + #define Q_is_integer sc->pl_bt check_boolean_method(sc, s7_is_integer, sc->is_integer_symbol, args); } @@ -19707,7 +19780,7 @@ static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args) { #define H_is_real "(real? obj) returns #t if obj is a real number" - #define Q_is_real pl_bt + #define Q_is_real sc->pl_bt check_boolean_method(sc, s7_is_real, sc->is_real_symbol, args); } @@ -19715,7 +19788,7 @@ static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args) { #define H_is_complex "(complex? obj) returns #t if obj is a number" - #define Q_is_complex pl_bt + #define Q_is_complex sc->pl_bt check_boolean_method(sc, s7_is_number, sc->is_complex_symbol, args); } @@ -19723,7 +19796,7 @@ static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args) { #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)" - #define Q_is_rational pl_bt + #define Q_is_rational sc->pl_bt check_boolean_method(sc, s7_is_rational, sc->is_rational_symbol, args); /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t * and similarly for exact? etc. @@ -19750,10 +19823,10 @@ static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args) } } -static bool is_even_b(s7_pointer p) +static bool is_even_b_7p(s7_scheme *sc, s7_pointer p) { if (!s7_is_integer(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_even_symbol, p, T_INTEGER); + simple_wrong_type_argument(sc, sc->is_even_symbol, p, T_INTEGER); return((integer(p) & 1) == 0); } @@ -19776,10 +19849,10 @@ static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args) } } -static bool is_odd_b(s7_pointer p) +static bool is_odd_b_7p(s7_scheme *sc, s7_pointer p) { if (!s7_is_integer(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_odd_symbol, p, T_INTEGER); + simple_wrong_type_argument(sc, sc->is_odd_symbol, p, T_INTEGER); return((integer(p) & 1) == 1); } @@ -19791,7 +19864,7 @@ static bool is_odd_i(s7_int i1) {return((i1 & 1) == 1);} static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args) { #define H_is_zero "(zero? num) returns #t if the number num is zero" - #define Q_is_zero pl_bn + #define Q_is_zero sc->pl_bn s7_pointer x; x = car(args); switch (type(x)) @@ -19811,10 +19884,10 @@ static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args) } } -static bool is_zero_b(s7_pointer p) +static bool is_zero_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_number(p)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_zero_symbol, p, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->is_zero_symbol, p, a_number_string); if (is_t_integer(p)) return(integer(p) == 0); if (is_t_real(p)) @@ -19849,10 +19922,10 @@ static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args) } } -static bool is_positive_b(s7_pointer p) +static bool is_positive_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_real(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_positive_symbol, p, T_REAL); + simple_wrong_type_argument(sc, sc->is_positive_symbol, p, T_REAL); if (is_t_integer(p)) return(integer(p) > 0); if (is_t_real(p)) @@ -19887,10 +19960,10 @@ static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args) } } -static bool is_negative_b(s7_pointer p) +static bool is_negative_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_real(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_negative_symbol, p, T_REAL); + simple_wrong_type_argument(sc, sc->is_negative_symbol, p, T_REAL); if (is_t_integer(p)) return(integer(p) < 0); if (is_t_real(p)) @@ -19901,30 +19974,6 @@ static bool is_negative_b(s7_pointer p) static bool is_negative_i(s7_int p) {return(p < 0);} static bool is_negative_d(s7_double p) {return(p < 0.0);} -#if (!DISABLE_DEPRECATED) -bool s7_is_ulong(s7_pointer arg) {return(is_integer(arg));} -unsigned long s7_ulong(s7_pointer p) {return((T_Pos(p))->object.number.ul_value);} - -s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n) -{ - s7_pointer x; - new_cell(sc, x, T_INTEGER); - x->object.number.ul_value = n; - return(x); -} - -bool s7_is_ulong_long(s7_pointer arg) {return(is_integer(arg));} -uint64_t s7_ulong_long(s7_pointer p) {return((T_Pos(p))->object.number.ull_value);} - -s7_pointer s7_make_ulong_long(s7_scheme *sc, uint64_t n) -{ - s7_pointer x; - new_cell(sc, x, T_INTEGER); - x->object.number.ull_value = n; - return(x); -} -#endif - #if (!WITH_PURE_S7) #if (!WITH_GMP) @@ -19951,7 +20000,7 @@ static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args) { #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)" - #define Q_is_exact pl_bn + #define Q_is_exact sc->pl_bn s7_pointer x; x = car(args); @@ -19972,10 +20021,10 @@ static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args) } } -static bool is_exact_b(s7_pointer p) +static bool is_exact_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_number(p)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_exact_symbol, p, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->is_exact_symbol, p, a_number_string); return(is_rational(p)); } @@ -19983,7 +20032,7 @@ static bool is_exact_b(s7_pointer p) static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args) { #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)" - #define Q_is_inexact pl_bn + #define Q_is_inexact sc->pl_bn s7_pointer x; x = car(args); @@ -20004,10 +20053,10 @@ static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args) } } -static bool is_inexact_b(s7_pointer p) +static bool is_inexact_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_number(p)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_inexact_symbol, p, a_number_string); + simple_wrong_type_argument_with_type(sc, sc->is_inexact_symbol, p, a_number_string); return(!is_rational(p)); } @@ -20044,7 +20093,7 @@ static int32_t integer_length(s7_int a) static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args) { #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': (ceiling (log (abs arg) 2))" - #define Q_integer_length pcl_i + #define Q_integer_length sc->pcl_i s7_int x; s7_pointer p; @@ -20118,7 +20167,7 @@ sign of 'x' (1 = positive, -1 = negative). (integer-decode-float 0.0): (0 0 1)" static s7_pointer g_logior(s7_scheme *sc, s7_pointer args) { #define H_logior "(logior int32_t ...) returns the OR of its integer arguments (the bits that are on in any of the arguments)" - #define Q_logior pcl_i + #define Q_logior sc->pcl_i s7_int result = 0; s7_pointer x; @@ -20138,7 +20187,7 @@ static s7_int logior_i_ii(s7_int i1, s7_int i2) {return(i1 | i2);} static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args) { #define H_logxor "(logxor int32_t ...) returns the XOR of its integer arguments (the bits that are on in an odd number of the arguments)" - #define Q_logxor pcl_i + #define Q_logxor sc->pcl_i s7_int result = 0; s7_pointer x; @@ -20158,7 +20207,7 @@ static s7_int logxor_i_ii(s7_int i1, s7_int i2) {return(i1 ^ i2);} static s7_pointer g_logand(s7_scheme *sc, s7_pointer args) { #define H_logand "(logand int32_t ...) returns the AND of its integer arguments (the bits that are on in every argument)" - #define Q_logand pcl_i + #define Q_logand sc->pcl_i s7_int result = -1; s7_pointer x; @@ -20179,7 +20228,7 @@ static s7_int logand_i_ii(s7_int i1, s7_int i2) {return(i1 & i2);} static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args) { #define H_lognot "(lognot num) returns the negation of num (its complement, the bits that are not on): (lognot 0) -> -1" - #define Q_lognot pcl_i + #define Q_lognot sc->pcl_i if (!s7_is_integer(car(args))) return(method_or_bust_one_arg(sc, car(args), sc->lognot_symbol, args, T_INTEGER)); return(make_integer(sc, ~s7_integer(car(args)))); @@ -20234,22 +20283,22 @@ order here follows gmp, and is the opposite of the CL convention. (logbit? int3 static bool logbit_b_ii(s7_int i1, s7_int i2) { if (i2 < 0) - simple_out_of_range(cur_sc, cur_sc->logbit_symbol, wrap_integer(i2), its_negative_string); + return(false); if (i2 >= s7_int_bits) return(i1 < 0); return((((int64_t)(1LL << (int64_t)i2)) & (int64_t)i1) != 0); } #if (!WITH_GMP) -static bool logbit_b_pp(s7_pointer p1, s7_pointer p2) +static bool logbit_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { if (is_integer(p1)) { if (is_integer(p2)) return(logbit_b_ii(integer(p1), integer(p2))); - simple_wrong_type_argument(cur_sc, cur_sc->logbit_symbol, p2, T_INTEGER); + simple_wrong_type_argument(sc, sc->logbit_symbol, p2, T_INTEGER); } - simple_wrong_type_argument(cur_sc, cur_sc->logbit_symbol, p1, T_INTEGER); + simple_wrong_type_argument(sc, sc->logbit_symbol, p1, T_INTEGER); return(false); } #endif @@ -20261,7 +20310,7 @@ static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2) if (arg1 == 0) return(0); if (arg2 >= s7_int_bits) - out_of_range(sc, sc->ash_symbol, small_int(2), wrap_integer(arg2), its_too_large_string); + out_of_range(sc, sc->ash_symbol, small_int(2), wrap_integer1(sc, arg2), its_too_large_string); if (arg2 < -s7_int_bits) { @@ -20287,7 +20336,7 @@ static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2) static s7_pointer g_ash(s7_scheme *sc, s7_pointer args) { #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1" - #define Q_ash pcl_i + #define Q_ash sc->pcl_i s7_pointer x, y; x = car(args); @@ -20301,7 +20350,7 @@ static s7_pointer g_ash(s7_scheme *sc, s7_pointer args) return(make_integer(sc, c_ash(sc, s7_integer(x), s7_integer(y)))); } -static s7_int ash_i_ii(s7_int i1, s7_int i2) {return(c_ash(cur_sc, i1, i2));} +static s7_int ash_i_7ii(s7_scheme *sc, s7_int i1, s7_int i2) {return(c_ash(sc, i1, i2));} #if (!WITH_GMP) static s7_int rsh_i_ii_direct(s7_int i1, s7_int i2) {return(i1 >> (-i2));} static s7_int lsh_i_ii_direct(s7_int i1, s7_int i2) {return(i1 << i2);} @@ -20386,7 +20435,7 @@ static s7_pointer rng_copy(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args) { #define H_is_random_state "(random-state? obj) returns #t if obj is a random-state object (from random-state)." - #define Q_is_random_state pl_bt + #define Q_is_random_state sc->pl_bt check_boolean_method(sc, is_random_state, sc->is_random_state_symbol, args); } @@ -20548,23 +20597,21 @@ static s7_pointer g_random(s7_scheme *sc, s7_pointer args) return(sc->F); } -static s7_double random_d_d(s7_double x) +static s7_double random_d_7d(s7_scheme *sc, s7_double x) { - return(x * next_random(cur_sc->default_rng)); + return(x * next_random(sc->default_rng)); } -static s7_int random_i_i(s7_int i) +static s7_int random_i_7i(s7_scheme *sc, s7_int i) { - return((s7_int)(i * next_random(cur_sc->default_rng))); + return((s7_int)(i * next_random(sc->default_rng))); } -static s7_pointer random_p_p(s7_pointer p) +static s7_pointer random_p_p(s7_scheme *sc, s7_pointer p) { - return(g_random(cur_sc, set_plist_1(cur_sc, p))); + return(g_random(sc, set_plist_1(sc, p))); } -static s7_pointer random_ic, random_rc; - static s7_pointer g_random_ic(s7_scheme *sc, s7_pointer args) { return(make_integer(sc, (s7_int)(integer(car(args)) * next_random(sc->default_rng)))); @@ -20585,12 +20632,12 @@ static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p if (s7_is_integer(arg1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(random_ic); + return(sc->random_ic); } if (is_float(arg1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(random_rc); + return(sc->random_rc); } } return(f); @@ -20612,10 +20659,10 @@ static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args) return(small_int(character(car(args)))); } -static s7_int char_to_integer_i(s7_pointer p) +static s7_int char_to_integer_i_7p(s7_scheme *sc, s7_pointer p) { if (!s7_is_character(p)) - simple_wrong_type_argument(cur_sc, cur_sc->char_to_integer_symbol, p, T_CHARACTER); + simple_wrong_type_argument(sc, sc->char_to_integer_symbol, p, T_CHARACTER); return(character(p)); } @@ -20638,16 +20685,16 @@ static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args) return(s7_make_character(sc, (uint8_t)ind)); } -static s7_pointer integer_to_char_p_p(s7_pointer x) +static s7_pointer integer_to_char_p_p(s7_scheme *sc, s7_pointer x) { s7_int ind; if (!s7_is_integer(x)) - simple_wrong_type_argument(cur_sc, cur_sc->integer_to_char_symbol, x, T_INTEGER); + simple_wrong_type_argument(sc, sc->integer_to_char_symbol, x, T_INTEGER); ind = s7_integer(x); if ((ind < 0) || (ind >= NUM_CHARS)) - return(simple_wrong_type_argument_with_type(cur_sc, cur_sc->integer_to_char_symbol, x, - wrap_string(cur_sc, "an integer that can represent a character", 41))); - return(s7_make_character(cur_sc, (uint8_t)ind)); + return(simple_wrong_type_argument_with_type(sc, sc->integer_to_char_symbol, x, + wrap_string(sc, "an integer that can represent a character", 41))); + return(s7_make_character(sc, (uint8_t)ind)); } @@ -20662,10 +20709,71 @@ static void init_uppers(void) } } +static void init_chars(void) +{ + s7_cell *cells; + int32_t i; + + chars = (s7_pointer *)malloc((NUM_CHARS + 1) * sizeof(s7_pointer)); /* chars is declared far above */ + cells = (s7_cell *)calloc(NUM_CHARS + 1, sizeof(s7_cell)); + + chars[0] = &cells[0]; + eof_object = chars[0]; + set_type(eof_object, T_EOF_OBJECT | T_IMMUTABLE); + unique_name_length(eof_object) = 6; + unique_name(eof_object) = "#<eof>"; + global_unheap(eof_object); + chars++; /* now chars[EOF] == chars[-1] == eof_object */ + cells++; + + for (i = 0; i < NUM_CHARS; i++) + { + s7_pointer cp; + uint8_t c; + + c = (uint8_t)i; + cp = &cells[i]; + typeflag(cp) = T_IMMUTABLE | T_CHARACTER; + global_unheap(cp); + character(cp) = c; + upper_character(cp) = (uint8_t)toupper(i); + is_char_alphabetic(cp) = (bool)isalpha(i); + is_char_numeric(cp) = (bool)isdigit(i); + is_char_whitespace(cp) = white_space[i]; + is_char_uppercase(cp) = (((bool)isupper(i)) || ((i >= 192) && (i < 208))); + is_char_lowercase(cp) = (bool)islower(i); + chars[i] = cp; + + #define make_character_name(S) memcpy((void *)(&(character_name(cp))), (const void *)(S), character_name_length(cp) = strlen(S)) + switch (c) + { + case ' ': make_character_name("#\\space"); break; + case '\n': make_character_name("#\\newline"); break; + case '\r': make_character_name("#\\return"); break; + case '\t': make_character_name("#\\tab"); break; + case '\0': make_character_name("#\\null"); break; + case (char)0x1b: make_character_name("#\\escape"); break; + case (char)0x7f: make_character_name("#\\delete"); break; + case (char)7: make_character_name("#\\alarm"); break; + case (char)8: make_character_name("#\\backspace"); break; + default: + { + #define P_SIZE 12 + int32_t len; + if ((c < 32) || (c >= 127)) + len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\x%x", c); + else len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\%c", c); + character_name_length(cp) = len; + break; + } + } + } +} + static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args) { #define H_char_upcase "(char-upcase c) converts the character c to upper case" - #define Q_char_upcase pcl_c + #define Q_char_upcase sc->pcl_c if (!s7_is_character(car(args))) return(method_or_bust_one_arg(sc, car(args), sc->char_upcase_symbol, args, T_CHARACTER)); return(s7_make_character(sc, upper_character(car(args)))); @@ -20674,7 +20782,7 @@ static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args) static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args) { #define H_char_downcase "(char-downcase c) converts the character c to lower case" - #define Q_char_downcase pcl_c + #define Q_char_downcase sc->pcl_c if (!s7_is_character(car(args))) return(method_or_bust_one_arg(sc, car(args), sc->char_downcase_symbol, args, T_CHARACTER)); return(s7_make_character(sc, lowers[character(car(args))])); @@ -20683,7 +20791,7 @@ static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args) { #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic" - #define Q_is_char_alphabetic pl_bc + #define Q_is_char_alphabetic sc->pl_bc if (!s7_is_character(car(args))) return(method_or_bust_one_arg(sc, car(args), sc->is_char_alphabetic_symbol, args, T_CHARACTER)); return(make_boolean(sc, is_char_alphabetic(car(args)))); @@ -20691,10 +20799,10 @@ static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args) /* isalpha returns #t for (integer->char 226) and others in that range */ } -static bool is_char_alphabetic_b(s7_pointer c) +static bool is_char_alphabetic_b_7p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->is_char_alphabetic_symbol, c, T_CHARACTER); + simple_wrong_type_argument(sc, sc->is_char_alphabetic_symbol, c, T_CHARACTER); return(is_char_alphabetic(c)); } static bool is_char_alphabetic_c(s7_pointer c) {return(is_char_alphabetic(c));} @@ -20704,7 +20812,7 @@ static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args) { s7_pointer arg; #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit" - #define Q_is_char_numeric pl_bc + #define Q_is_char_numeric sc->pl_bc arg = car(args); if (!s7_is_character(arg)) @@ -20712,10 +20820,10 @@ static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, is_char_numeric(arg))); } -static bool is_char_numeric_b(s7_pointer c) +static bool is_char_numeric_b_7p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->is_char_numeric_symbol, c, T_CHARACTER); + simple_wrong_type_argument(sc, sc->is_char_numeric_symbol, c, T_CHARACTER); return(is_char_numeric(c)); } static bool is_char_numeric_c(s7_pointer c) {return(is_char_numeric(c));} @@ -20725,7 +20833,7 @@ static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args) { s7_pointer arg; #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character" - #define Q_is_char_whitespace pl_bc + #define Q_is_char_whitespace sc->pl_bc arg = car(args); if (!s7_is_character(arg)) @@ -20733,10 +20841,10 @@ static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, is_char_whitespace(arg))); } -static bool is_char_whitespace_b(s7_pointer c) +static bool is_char_whitespace_b_7p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->is_char_whitespace_symbol, c, T_CHARACTER); + simple_wrong_type_argument(sc, sc->is_char_whitespace_symbol, c, T_CHARACTER); return(is_char_whitespace(c)); } static bool is_char_whitespace_c(s7_pointer c) {return(is_char_whitespace(c));} @@ -20746,7 +20854,7 @@ static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args) { s7_pointer arg; #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case" - #define Q_is_char_upper_case pl_bc + #define Q_is_char_upper_case sc->pl_bc arg = car(args); if (!s7_is_character(arg)) @@ -20754,10 +20862,10 @@ static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, is_char_uppercase(arg))); } -static bool is_char_upper_case_b(s7_pointer c) +static bool is_char_upper_case_b_7p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->is_char_upper_case_symbol, c, T_CHARACTER); + simple_wrong_type_argument(sc, sc->is_char_upper_case_symbol, c, T_CHARACTER); return(is_char_uppercase(c)); } @@ -20767,7 +20875,7 @@ static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args) { s7_pointer arg; #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case" - #define Q_is_char_lower_case pl_bc + #define Q_is_char_lower_case sc->pl_bc arg = car(args); if (!s7_is_character(arg)) @@ -20775,10 +20883,10 @@ static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, is_char_lowercase(arg))); } -static bool is_char_lower_case_b(s7_pointer c) +static bool is_char_lower_case_b_7p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->is_char_lower_case_symbol, c, T_CHARACTER); + simple_wrong_type_argument(sc, sc->is_char_lower_case_symbol, c, T_CHARACTER); return(is_char_lowercase(c)); } @@ -20787,7 +20895,7 @@ static bool is_char_lower_case_c(s7_pointer c) {return(is_char_lowercase(c));} static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args) { #define H_is_char "(char? obj) returns #t if obj is a character" - #define Q_is_char pl_bt + #define Q_is_char sc->pl_bt check_boolean_method(sc, s7_is_character, sc->is_char_symbol, args); } @@ -20848,7 +20956,7 @@ static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int32_t val, s7_poi if (charcmp(character(y), character(car(x))) != val) { - for (y = cdr(x); is_pair(y); y = cdr(y)) + for (y = cdr(x); is_pair(y); y = cdr(y)) /* before returning #f, check for bad trailing arguments */ if (!is_character_via_method(sc, car(y))) return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER)); return(sc->F); @@ -20888,7 +20996,7 @@ static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7 static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args) { #define H_chars_are_equal "(char=? char ...) returns #t if all the character arguments are equal" - #define Q_chars_are_equal pcl_bc + #define Q_chars_are_equal sc->pcl_bc s7_pointer x, y; @@ -20916,7 +21024,7 @@ static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args) { #define H_chars_are_less "(char<? char ...) returns #t if all the character arguments are increasing" - #define Q_chars_are_less pcl_bc + #define Q_chars_are_less sc->pcl_bc return(g_char_cmp(sc, args, -1, sc->char_lt_symbol)); } @@ -20925,7 +21033,7 @@ static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args) { #define H_chars_are_greater "(char>? char ...) returns #t if all the character arguments are decreasing" - #define Q_chars_are_greater pcl_bc + #define Q_chars_are_greater sc->pcl_bc return(g_char_cmp(sc, args, 1, sc->char_gt_symbol)); } @@ -20934,7 +21042,7 @@ static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args) { #define H_chars_are_geq "(char>=? char ...) returns #t if all the character arguments are equal or decreasing" - #define Q_chars_are_geq pcl_bc + #define Q_chars_are_geq sc->pcl_bc return(g_char_cmp_not(sc, args, -1, sc->char_geq_symbol)); } @@ -20943,19 +21051,18 @@ static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args) { #define H_chars_are_leq "(char<=? char ...) returns #t if all the character arguments are equal or increasing" - #define Q_chars_are_leq pcl_bc + #define Q_chars_are_leq sc->pcl_bc return(g_char_cmp_not(sc, args, 1, sc->char_leq_symbol)); } -static s7_pointer simple_char_eq; static s7_pointer g_simple_char_eq(s7_scheme *sc, s7_pointer args) { return(make_boolean(sc, character(car(args)) == character(cadr(args)))); } -static void check_char2_args(s7_scheme *sc, s7_pointer caller, s7_pointer p1, s7_pointer p2) +static inline void check_char2_args(s7_scheme *sc, s7_pointer caller, s7_pointer p1, s7_pointer p2) { if (!s7_is_character(p1)) simple_wrong_type_argument(sc, caller, p1, T_CHARACTER); @@ -20964,42 +21071,41 @@ static void check_char2_args(s7_scheme *sc, s7_pointer caller, s7_pointer p1, s7 } static bool char_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) < character(p2));} -static bool char_lt_b(s7_pointer p1, s7_pointer p2) +static bool char_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_lt_symbol, p1, p2); + check_char2_args(sc, sc->char_lt_symbol, p1, p2); return(character(p1) < character(p2)); } static bool char_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) <= character(p2));} -static bool char_leq_b(s7_pointer p1, s7_pointer p2) +static bool char_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_leq_symbol, p1, p2); + check_char2_args(sc, sc->char_leq_symbol, p1, p2); return(character(p1) <= character(p2)); } static bool char_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) > character(p2));} -static bool char_gt_b(s7_pointer p1, s7_pointer p2) +static bool char_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_gt_symbol, p1, p2); + check_char2_args(sc, sc->char_gt_symbol, p1, p2); return(character(p1) > character(p2)); } static bool char_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) >= character(p2));} -static bool char_geq_b(s7_pointer p1, s7_pointer p2) +static bool char_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_geq_symbol, p1, p2); + check_char2_args(sc, sc->char_geq_symbol, p1, p2); return(character(p1) >= character(p2)); } static bool char_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) == character(p2));} -static bool char_eq_b(s7_pointer p1, s7_pointer p2) +static bool char_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_eq_symbol, p1, p2); + check_char2_args(sc, sc->char_eq_symbol, p1, p2); return(character(p1) == character(p2)); } -static s7_pointer char_equal_s_ic, char_equal_2; static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args) { s7_pointer c; @@ -21022,7 +21128,6 @@ static s7_pointer g_char_equal_2(s7_scheme *sc, s7_pointer args) return(sc->F); } -static s7_pointer char_less_2; static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args) { if (!s7_is_character(car(args))) @@ -21033,7 +21138,6 @@ static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args) } -static s7_pointer char_greater_2; static s7_pointer g_char_greater_2(s7_scheme *sc, s7_pointer args) { if (!s7_is_character(car(args))) @@ -21095,7 +21199,7 @@ static s7_pointer g_char_cmp_ci_not(s7_scheme *sc, s7_pointer args, int32_t val, static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args) { #define H_chars_are_ci_equal "(char-ci=? char ...) returns #t if all the character arguments are equal, ignoring case" - #define Q_chars_are_ci_equal pcl_bc + #define Q_chars_are_ci_equal sc->pcl_bc return(g_char_cmp_ci(sc, args, 0, sc->char_ci_eq_symbol)); } @@ -21103,7 +21207,7 @@ static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args) { #define H_chars_are_ci_less "(char-ci<? char ...) returns #t if all the character arguments are increasing, ignoring case" - #define Q_chars_are_ci_less pcl_bc + #define Q_chars_are_ci_less sc->pcl_bc return(g_char_cmp_ci(sc, args, -1, sc->char_ci_lt_symbol)); } @@ -21111,7 +21215,7 @@ static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args) { #define H_chars_are_ci_greater "(char-ci>? char ...) returns #t if all the character arguments are decreasing, ignoring case" - #define Q_chars_are_ci_greater pcl_bc + #define Q_chars_are_ci_greater sc->pcl_bc return(g_char_cmp_ci(sc, args, 1, sc->char_ci_gt_symbol)); } @@ -21119,7 +21223,7 @@ static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args) { #define H_chars_are_ci_geq "(char-ci>=? char ...) returns #t if all the character arguments are equal or decreasing, ignoring case" - #define Q_chars_are_ci_geq pcl_bc + #define Q_chars_are_ci_geq sc->pcl_bc return(g_char_cmp_ci_not(sc, args, -1, sc->char_ci_geq_symbol)); } @@ -21127,44 +21231,44 @@ static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args) static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args) { #define H_chars_are_ci_leq "(char-ci<=? char ...) returns #t if all the character arguments are equal or increasing, ignoring case" - #define Q_chars_are_ci_leq pcl_bc + #define Q_chars_are_ci_leq sc->pcl_bc return(g_char_cmp_ci_not(sc, args, 1, sc->char_ci_leq_symbol)); } static bool char_ci_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) < upper_character(p2));} -static bool char_ci_lt_b(s7_pointer p1, s7_pointer p2) +static bool char_ci_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_ci_lt_symbol, p1, p2); + check_char2_args(sc, sc->char_ci_lt_symbol, p1, p2); return(upper_character(p1) < upper_character(p2)); } static bool char_ci_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) <= upper_character(p2));} -static bool char_ci_leq_b(s7_pointer p1, s7_pointer p2) +static bool char_ci_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_ci_leq_symbol, p1, p2); + check_char2_args(sc, sc->char_ci_leq_symbol, p1, p2); return(upper_character(p1) <= upper_character(p2)); } static bool char_ci_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) > upper_character(p2));} -static bool char_ci_gt_b(s7_pointer p1, s7_pointer p2) +static bool char_ci_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_ci_gt_symbol, p1, p2); + check_char2_args(sc, sc->char_ci_gt_symbol, p1, p2); return(upper_character(p1) > upper_character(p2)); } static bool char_ci_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) >= upper_character(p2));} -static bool char_ci_geq_b(s7_pointer p1, s7_pointer p2) +static bool char_ci_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_ci_geq_symbol, p1, p2); + check_char2_args(sc, sc->char_ci_geq_symbol, p1, p2); return(upper_character(p1) >= upper_character(p2)); } static bool char_ci_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) == upper_character(p2));} -static bool char_ci_eq_b(s7_pointer p1, s7_pointer p2) +static bool char_ci_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_char2_args(cur_sc, cur_sc->char_ci_eq_symbol, p1, p2); + check_char2_args(sc, sc->char_ci_eq_symbol, p1, p2); return(upper_character(p1) == upper_character(p2)); } @@ -21235,30 +21339,29 @@ static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args) return(sc->F); } -static s7_pointer char_position_p_ppi(s7_pointer p1, s7_pointer p2, s7_int start) +static s7_pointer char_position_p_ppi(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int start) { /* p1 is char, p2 is string, p3 is int32_t */ char c; c = character(p1); if (!is_string(p2)) - simple_wrong_type_argument(cur_sc, cur_sc->char_position_symbol, p2, T_STRING); + simple_wrong_type_argument(sc, sc->char_position_symbol, p2, T_STRING); if (start < 0) - wrong_type_argument_with_type(cur_sc, cur_sc->char_position_symbol, 3, s7_make_integer(cur_sc, start), a_non_negative_integer_string); + wrong_type_argument_with_type(sc, sc->char_position_symbol, 3, s7_make_integer(sc, start), a_non_negative_integer_string); else { const char *porig, *p; s7_int len; len = string_length(p2); porig = string_value(p2); - if (start >= len) return(cur_sc->F); + if (start >= len) return(sc->F); p = strchr((const char *)(porig + start), (int)c); - if (p) return(make_integer(cur_sc, p - porig)); + if (p) return(make_integer(sc, p - porig)); } - return(cur_sc->F); + return(sc->F); } -static s7_pointer char_position_csi; static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args) { /* assume char arg1, no end */ @@ -21350,7 +21453,7 @@ s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len { s7_pointer x; new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE); - string_block(x) = mallocate(len + 2); + string_block(x) = mallocate(sc, len + 2); string_value(x) = (char *)block_data(string_block(x)); if (len > 0) memcpy((void *)string_value(x), (void *)str, len); /* memcpy can segfault if string_value(x) is NULL */ @@ -21363,38 +21466,12 @@ s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len } #define NUM_STRING_WRAPPERS 8 /* should be a power of 2 */ -static s7_cell string_wrappers[NUM_STRING_WRAPPERS]; -static int32_t string_wrapper_pos = 0; -static void init_string_wrappers(void) -{ - int32_t i; - s7_pointer p; - for (p = string_wrappers, i = 0; i < NUM_STRING_WRAPPERS; p++, i++) - { - typeflag(p) = T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE; - string_block(p) = NULL; - string_value(p) = NULL; - string_length(p) = 0; - string_hash(p) = 0; - } -} - -#if S7_DEBUGGING -static void check_string_wrappers(void) -{ - int32_t i; - s7_pointer p; - for (p = string_wrappers, i = 0; i < NUM_STRING_WRAPPERS; p++, i++) - if ((typeflag(p) & (~T_GC_MARK)) != (T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE)) - fprintf(stderr, "%s\n", describe_type_bits(cur_sc, p)); -} -#endif static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len) { s7_pointer x; - x = &string_wrappers[string_wrapper_pos]; - string_wrapper_pos = (string_wrapper_pos + 1) & (NUM_STRING_WRAPPERS - 1); + x = sc->string_wrappers[sc->string_wrapper_pos]; + sc->string_wrapper_pos = (sc->string_wrapper_pos + 1) & (NUM_STRING_WRAPPERS - 1); string_value(x) = (char *)str; string_length(x) = len; return(x); @@ -21423,7 +21500,7 @@ static s7_pointer make_empty_string(s7_scheme *sc, s7_int len, char fill) s7_pointer x; block_t *b; new_cell(sc, x, T_STRING); - b = mallocate(len + 2); /* terminated_string_read_white_space needs the second #\null (is this still the case?) */ + b = mallocate(sc, len + 2); /* terminated_string_read_white_space needs the second #\null (is this still the case?) */ string_block(x) = b; string_value(x) = (char *)block_data(b); if ((fill != 0) && (len > 0)) @@ -21443,23 +21520,23 @@ s7_pointer s7_make_string(s7_scheme *sc, const char *str) return(make_empty_string(sc, 0, 0)); } -static char *make_permanent_c_string(const char *str) +static char *make_permanent_c_string(s7_scheme *sc, const char *str) { char *x; s7_int len; len = safe_strlen(str); - x = (char *)alloc_permanent_string((len + 1) * sizeof(char)); + x = (char *)alloc_permanent_string(sc, (len + 1) * sizeof(char)); memcpy((void *)x, (void *)str, len); x[len] = 0; return(x); } -s7_pointer s7_make_permanent_string(const char *str) +s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str) { /* for the symbol table which is never GC'd */ s7_pointer x; - x = alloc_pointer(); - unheap(x); + x = alloc_pointer(sc); + unheap(sc, x); set_type(x, T_STRING | T_IMMUTABLE); if (str) { @@ -21468,7 +21545,7 @@ s7_pointer s7_make_permanent_string(const char *str) string_length(x) = len; /* string_block(x) = mallocate_block(); */ string_block(x) = NULL; - string_value(x) = (char *)alloc_permanent_string((len + 1) * sizeof(char)); + string_value(x) = (char *)alloc_permanent_string(sc, (len + 1) * sizeof(char)); memcpy((void *)string_value(x), (void *)str, len); string_value(x)[len] = 0; } @@ -21496,11 +21573,100 @@ const char *s7_string(s7_pointer p) static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args) { #define H_is_string "(string? obj) returns #t if obj is a string" - #define Q_is_string pl_bt + #define Q_is_string sc->pl_bt check_boolean_method(sc, is_string, sc->is_string_symbol, args); } +static s7_pointer make_permanent_string(const char *str) +{ + s7_pointer x; + s7_int len; + + x = (s7_pointer)calloc(1, sizeof(s7_cell)); + global_unheap(x); + set_type(x, T_STRING | T_IMMUTABLE); + + len = safe_strlen(str); + string_length(x) = len; + string_block(x) = NULL; + string_value(x) = (char *)str; + string_hash(x) = 0; + return(x); +} + +static void init_strings(void) +{ + car_a_list_string = make_permanent_string("a list whose car is also a list"); + cdr_a_list_string = make_permanent_string("a list whose cdr is also a list"); + + caar_a_list_string = make_permanent_string("a list whose caar is also a list"); + cadr_a_list_string = make_permanent_string("a list whose cadr is also a list"); + cdar_a_list_string = make_permanent_string("a list whose cdar is also a list"); + cddr_a_list_string = make_permanent_string("a list whose cddr is also a list"); + + caaar_a_list_string = make_permanent_string("a list whose caaar is also a list"); + caadr_a_list_string = make_permanent_string("a list whose caadr is also a list"); + cadar_a_list_string = make_permanent_string("a list whose cadar is also a list"); + caddr_a_list_string = make_permanent_string("a list whose caddr is also a list"); + cdaar_a_list_string = make_permanent_string("a list whose cdaar is also a list"); + cdadr_a_list_string = make_permanent_string("a list whose cdadr is also a list"); + cddar_a_list_string = make_permanent_string("a list whose cddar is also a list"); + cdddr_a_list_string = make_permanent_string("a list whose cdddr is also a list"); + + a_list_string = make_permanent_string("a list"); + an_eq_func_string = make_permanent_string("a procedure that can take 2 arguments"); + an_association_list_string = make_permanent_string("an association list"); + a_normal_real_string = make_permanent_string("a normal real"); + a_rational_string = make_permanent_string("an integer or a ratio"); + a_number_string = make_permanent_string("a number"); + a_procedure_string = make_permanent_string("a procedure"); + a_normal_procedure_string = make_permanent_string("a normal procedure (not a continuation)"); + a_let_string = make_permanent_string("a let (environment)"); + a_proper_list_string = make_permanent_string("a proper list"); + a_boolean_string = make_permanent_string("a boolean"); + a_byte_vector_string = make_permanent_string("a byte-vector"); + an_input_port_string = make_permanent_string("an input port"); + an_open_port_string = make_permanent_string("an open port"); + an_output_port_string = make_permanent_string("an output port"); + an_input_string_port_string = make_permanent_string("an input string port"); + an_input_file_port_string = make_permanent_string("an input file port"); + an_output_string_port_string = make_permanent_string("an output string port"); + an_output_file_port_string = make_permanent_string("an output file port"); + a_thunk_string = make_permanent_string("a thunk"); + a_symbol_string = make_permanent_string("a symbol"); + a_non_negative_integer_string = make_permanent_string("a non-negative integer"); + an_unsigned_byte_string = make_permanent_string("an unsigned byte"); + something_applicable_string = make_permanent_string("a procedure or something applicable"); + a_random_state_object_string = make_permanent_string("a random-state object"); + a_format_port_string = make_permanent_string("#f, #t, (), or an open output port"); + a_non_constant_symbol_string = make_permanent_string("a non-constant symbol"); + a_sequence_string = make_permanent_string("a sequence"); + a_valid_radix_string = make_permanent_string("should be between 2 and 16"); + result_is_too_large_string = make_permanent_string("result is too large"); + its_too_large_string = make_permanent_string("it is too large"); + its_too_small_string = make_permanent_string("it is less than the start position"); + its_negative_string = make_permanent_string("it is negative"); + its_nan_string = make_permanent_string("NaN usually indicates a numerical error"); + its_infinite_string = make_permanent_string("it is infinite"); + too_many_indices_string = make_permanent_string("too many indices"); + value_is_missing_string = make_permanent_string("~A argument '~A's value is missing"); + parameter_set_twice_string = make_permanent_string("parameter set twice, ~S in ~S"); + immutable_error_string = make_permanent_string("can't ~S ~S (it is immutable)"); +#if (!HAVE_COMPLEX_NUMBERS) + no_complex_numbers_string = make_permanent_string("this version of s7 does not support complex numbers"); +#endif + + format_string_1 = make_permanent_string("format: ~S ~{~S~^ ~}: ~A"); + format_string_2 = make_permanent_string("format: ~S: ~A"); + format_string_3 = make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A"); + format_string_4 = make_permanent_string("format: ~S~&~NT^: ~A"); + + too_many_arguments_string = make_permanent_string("~A: too many arguments: ~A"); + not_enough_arguments_string = make_permanent_string("~A: not enough arguments: ~A"); + missing_method_string = make_permanent_string("missing ~S method in ~S"); +} + /* -------------------------------- make-string -------------------------------- */ static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args) @@ -21520,6 +21686,10 @@ static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args) } len = s7_integer(n); +#if WITH_GMP + if ((len == 0) && (!s7_is_zero(n))) + return(s7_out_of_range_error(sc, "make-string", 1, n, "big integer is too big for s7_int")); +#endif if ((len < 0) || (len > sc->max_string_length)) return(out_of_range(sc, sc->make_string_symbol, small_int(1), n, (len < 0) ? its_negative_string : its_too_large_string)); @@ -21548,10 +21718,10 @@ static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args) return(make_integer(sc, string_length(p))); } -static s7_int string_length_i(s7_pointer p) +static s7_int string_length_i_7p(s7_scheme *sc, s7_pointer p) { if (!is_string(p)) - simple_wrong_type_argument(cur_sc, cur_sc->string_length_symbol, p, T_STRING); + simple_wrong_type_argument(sc, sc->string_length_symbol, p, T_STRING); return(string_length(p)); } #endif @@ -21561,7 +21731,7 @@ static s7_int string_length_i(s7_pointer p) static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args) { #define H_string_downcase "(string-downcase str) returns the lower case version of str." - #define Q_string_downcase pcl_s + #define Q_string_downcase sc->pcl_s s7_pointer p, newstr; s7_int i, len; @@ -21595,7 +21765,7 @@ static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args) static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args) { #define H_string_upcase "(string-upcase str) returns the upper case version of str." - #define Q_string_upcase pcl_s + #define Q_string_upcase sc->pcl_s s7_pointer p, newstr; s7_int i, len; @@ -21660,50 +21830,30 @@ static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args) #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str" #define Q_string_ref s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol) - s7_pointer strng, index; - char *str; - s7_int ind; - + s7_pointer strng; strng = car(args); if (!is_string(strng)) return(method_or_bust(sc, strng, sc->string_ref_symbol, args, T_STRING, 1)); - - index = cadr(args); - if (!s7_is_integer(index)) - { - s7_pointer p; - p = check_value_slot(sc, index); - if (!s7_is_integer(p)) - return(wrong_type_argument(sc, sc->string_ref_symbol, 2, index, T_INTEGER)); - ind = s7_integer(p); - } - else ind = s7_integer(index); - if (ind < 0) - return(wrong_type_argument_with_type(sc, sc->string_ref_symbol, 2, index, a_non_negative_integer_string)); - if (ind >= string_length(strng)) - return(out_of_range(sc, sc->string_ref_symbol, small_int(2), index, its_too_large_string)); - - str = string_value(strng); - return(s7_make_character(sc, ((uint8_t *)str)[ind])); + return(string_ref_1(sc, strng, cadr(args))); } -static s7_pointer string_ref_p_pi(s7_pointer p1, s7_int i1) +static s7_pointer string_ref_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1) { if (!is_string(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->string_ref_symbol, p1, T_STRING); + simple_wrong_type_argument(sc, sc->string_ref_symbol, p1, T_STRING); if ((i1 < 0) || (i1 >= string_length(p1))) - out_of_range(cur_sc, cur_sc->string_ref_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->string_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); return(chars[((uint8_t *)string_value(p1))[i1]]); } -static s7_pointer string_ref_p_pi_direct(s7_pointer p1, s7_int i1) +static s7_pointer string_ref_p_pi_direct(s7_scheme *sc, s7_pointer p1, s7_int i1) { if ((i1 < 0) || (i1 >= string_length(p1))) - out_of_range(cur_sc, cur_sc->string_ref_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->string_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); return(chars[((uint8_t *)string_value(p1))[i1]]); } -static s7_pointer string_ref_unchecked(s7_pointer p1, s7_int i1) {return(chars[((uint8_t *)string_value(p1))[i1]]);} +static s7_pointer string_ref_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(chars[((uint8_t *)string_value(p1))[i1]]);} /* -------------------------------- string-set! -------------------------------- */ @@ -21744,34 +21894,34 @@ static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args) return(c); } -static s7_pointer string_set_p_pip(s7_pointer p1, s7_int i1, s7_pointer p2) +static s7_pointer string_set_p_pip(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) { if (!is_string(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->string_set_symbol, p1, T_STRING); + simple_wrong_type_argument(sc, sc->string_set_symbol, p1, T_STRING); if (!s7_is_character(p2)) - simple_wrong_type_argument(cur_sc, cur_sc->string_set_symbol, p2, T_CHARACTER); + simple_wrong_type_argument(sc, sc->string_set_symbol, p2, T_CHARACTER); if ((i1 < 0) || (i1 >= string_length(p1))) - out_of_range(cur_sc, cur_sc->string_set_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->string_set_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); string_value(p1)[i1] = s7_character(p2); return(p2); } -static s7_pointer string_set_p_pip_direct(s7_pointer p1, s7_int i1, s7_pointer p2) +static s7_pointer string_set_p_pip_direct(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) { if ((i1 < 0) || (i1 >= string_length(p1))) - out_of_range(cur_sc, cur_sc->string_set_symbol, small_int(2),make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->string_set_symbol, small_int(2),make_integer(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); string_value(p1)[i1] = s7_character(p2); return(p2); } -static s7_pointer string_set_unchecked(s7_pointer p1, s7_int i1, s7_pointer p2) {string_value(p1)[i1] = s7_character(p2); return(p2);} +static s7_pointer string_set_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) {string_value(p1)[i1] = s7_character(p2); return(p2);} /* -------------------------------- string-append -------------------------------- */ static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args) { #define H_string_append "(string-append str1 ...) appends all its string arguments into one string" - #define Q_string_append pcl_s + #define Q_string_append sc->pcl_s s7_int len = 0; s7_pointer x, newstr; @@ -21798,8 +21948,8 @@ static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args) if (len == 0) return(s7_apply_function(sc, func, x)); /* not args (string-append "" "" ...) */ newstr = make_empty_string(sc, len, 0); - for (pos = string_value(newstr), y = args; y != x; pos += string_length(car(y)), y = cdr(y)) - memcpy(pos, string_value(car(y)), string_length(car(y))); + for (pos = string_or_byte_vector_value(newstr), y = args; y != x; pos += string_or_byte_vector_length(car(y)), y = cdr(y)) + memcpy(pos, string_or_byte_vector_value(car(y)), string_or_byte_vector_length(car(y))); return(s7_apply_function(sc, func, cons(sc, newstr, x))); } } @@ -21813,8 +21963,8 @@ static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args) if (len > sc->max_string_length) return(s7_error(sc, sc->out_of_range_symbol, set_elist_3(sc, wrap_string(sc, "string-append new string length, ~D, is larger than (*s7* 'max-string-length): ~D", 81), - wrap_integer(len), - wrap_integer2(sc->max_string_length)))); + wrap_integer1(sc, len), + wrap_integer2(sc, sc->max_string_length)))); newstr = make_empty_string(sc, len, 0); @@ -21913,7 +22063,6 @@ end: (substring \"01234\" 1 2) -> \"1\"" } -static s7_pointer substring_to_temp; static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args) { s7_pointer str; @@ -22064,7 +22213,7 @@ static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y) static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args) { #define H_strings_are_equal "(string=? str ...) returns #t if all the string arguments are equal" - #define Q_strings_are_equal pcl_bs + #define Q_strings_are_equal sc->pcl_bs /* C-based check stops at null, but we can have embedded nulls. * (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) @@ -22097,7 +22246,7 @@ static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args) { #define H_strings_are_less "(string<? str ...) returns #t if all the string arguments are increasing" - #define Q_strings_are_less pcl_bs + #define Q_strings_are_less sc->pcl_bs return(g_string_cmp(sc, args, -1, sc->string_lt_symbol)); } @@ -22106,7 +22255,7 @@ static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args) { #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing" - #define Q_strings_are_greater pcl_bs + #define Q_strings_are_greater sc->pcl_bs return(g_string_cmp(sc, args, 1, sc->string_gt_symbol)); } @@ -22115,7 +22264,7 @@ static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing" - #define Q_strings_are_geq pcl_bs + #define Q_strings_are_geq sc->pcl_bs return(g_string_cmp_not(sc, args, -1, sc->string_geq_symbol)); } @@ -22124,12 +22273,11 @@ static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing" - #define Q_strings_are_leq pcl_bs + #define Q_strings_are_leq sc->pcl_bs return(g_string_cmp_not(sc, args, 1, sc->string_leq_symbol)); } -static s7_pointer string_equal_2; static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args) { if (!is_string(car(args))) @@ -22140,7 +22288,6 @@ static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args) } -static s7_pointer string_less_2; static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args) { if (!is_string(car(args))) @@ -22151,7 +22298,6 @@ static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args) } -static s7_pointer string_greater_2; static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args) { if (!is_string(car(args))) @@ -22170,37 +22316,37 @@ static inline void check_string2_args(s7_scheme *sc, s7_pointer caller, s7_point } static bool string_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == -1);} -static bool string_lt_b(s7_pointer p1, s7_pointer p2) +static bool string_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_lt_symbol, p1, p2); + check_string2_args(sc, sc->string_lt_symbol, p1, p2); return(scheme_strcmp(p1, p2) == -1); } static bool string_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != 1);} -static bool string_leq_b(s7_pointer p1, s7_pointer p2) +static bool string_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_leq_symbol, p1, p2); + check_string2_args(sc, sc->string_leq_symbol, p1, p2); return(scheme_strcmp(p1, p2) != 1); } static bool string_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == 1);} -static bool string_gt_b(s7_pointer p1, s7_pointer p2) +static bool string_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_gt_symbol, p1, p2); + check_string2_args(sc, sc->string_gt_symbol, p1, p2); return(scheme_strcmp(p1, p2) == 1); } static bool string_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != -1);} -static bool string_geq_b(s7_pointer p1, s7_pointer p2) +static bool string_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_geq_symbol, p1, p2); + check_string2_args(sc, sc->string_geq_symbol, p1, p2); return(scheme_strcmp(p1, p2) != -1); } static bool string_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strings_are_equal(p1, p2));} -static bool string_eq_b(s7_pointer p1, s7_pointer p2) +static bool string_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_eq_symbol, p1, p2); + check_string2_args(sc, sc->string_eq_symbol, p1, p2); return(scheme_strings_are_equal(p1, p2)); } @@ -22327,7 +22473,7 @@ static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int32_t va static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case" - #define Q_strings_are_ci_equal pcl_bs + #define Q_strings_are_ci_equal sc->pcl_bs return(g_string_ci_cmp(sc, args, 0, sc->string_ci_eq_symbol)); } @@ -22335,7 +22481,7 @@ static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_less "(string-ci<? str ...) returns #t if all the string arguments are increasing, ignoring case" - #define Q_strings_are_ci_less pcl_bs + #define Q_strings_are_ci_less sc->pcl_bs return(g_string_ci_cmp(sc, args, -1, sc->string_ci_lt_symbol)); } @@ -22343,7 +22489,7 @@ static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case" - #define Q_strings_are_ci_greater pcl_bs + #define Q_strings_are_ci_greater sc->pcl_bs return(g_string_ci_cmp(sc, args, 1, sc->string_ci_gt_symbol)); } @@ -22351,7 +22497,7 @@ static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case" - #define Q_strings_are_ci_geq pcl_bs + #define Q_strings_are_ci_geq sc->pcl_bs return(g_string_ci_cmp_not(sc, args, -1, sc->string_ci_geq_symbol)); } @@ -22359,43 +22505,43 @@ static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args) static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case" - #define Q_strings_are_ci_leq pcl_bs + #define Q_strings_are_ci_leq sc->pcl_bs return(g_string_ci_cmp_not(sc, args, 1, sc->string_ci_leq_symbol)); } static bool string_ci_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == -1);} -static bool string_ci_lt_b(s7_pointer p1, s7_pointer p2) +static bool string_ci_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_ci_lt_symbol, p1, p2); + check_string2_args(sc, sc->string_ci_lt_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) == -1); } static bool string_ci_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != 1);} -static bool string_ci_leq_b(s7_pointer p1, s7_pointer p2) +static bool string_ci_leq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_ci_leq_symbol, p1, p2); + check_string2_args(sc, sc->string_ci_leq_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) != 1); } static bool string_ci_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 1);} -static bool string_ci_gt_b(s7_pointer p1, s7_pointer p2) +static bool string_ci_gt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_ci_gt_symbol, p1, p2); + check_string2_args(sc, sc->string_ci_gt_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) == 1); } static bool string_ci_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != -1);} -static bool string_ci_geq_b(s7_pointer p1, s7_pointer p2) +static bool string_ci_geq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_ci_geq_symbol, p1, p2); + check_string2_args(sc, sc->string_ci_geq_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) != -1); } static bool string_ci_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 0);} -static bool string_ci_eq_b(s7_pointer p1, s7_pointer p2) +static bool string_ci_eq_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - check_string2_args(cur_sc, cur_sc->string_ci_eq_symbol, p1, p2); + check_string2_args(sc, sc->string_ci_eq_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) == 0); } @@ -22588,7 +22734,7 @@ static s7_pointer make_empty_byte_vector(s7_scheme *sc, s7_int len) s7_pointer x; block_t *b; new_cell(sc, x, T_BYTE_VECTOR | T_SAFE_PROCEDURE); - b = mallocate(len + 1); /* 1 for null termination in case byte-vector->string called */ + b = mallocate(sc, len + 1); /* 1 for null termination in case byte-vector->string called */ byte_vector_block(x) = b; byte_vector_bytes(x) = (uint8_t *)block_data(b); byte_vector_bytes(x)[len] = 0; @@ -22702,17 +22848,17 @@ static s7_pointer g_byte_vector_ref(s7_scheme *sc, s7_pointer args) return(small_int(bytes[ind])); } -static s7_int byte_vector_ref_i(s7_pointer p1, s7_int i1) +static s7_int byte_vector_ref_i_7pi(s7_scheme *sc, s7_pointer p1, s7_int i1) { if (!is_byte_vector(p1)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_ref_symbol, p1, a_byte_vector_string); + simple_wrong_type_argument_with_type(sc, sc->byte_vector_ref_symbol, p1, a_byte_vector_string); if ((i1 < 0) || (i1 >= byte_vector_length(p1))) - out_of_range(cur_sc, cur_sc->byte_vector_ref_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->byte_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); return((s7_int)((byte_vector_bytes(p1))[i1])); } -static s7_pointer byte_vector_ref_unchecked(s7_pointer p1, s7_int i1) {return(small_int((byte_vector_bytes(p1))[i1]));} +static s7_pointer byte_vector_ref_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(small_int((byte_vector_bytes(p1))[i1]));} /* -------------------------------- byte-vector-set -------------------------------- */ @@ -22761,19 +22907,19 @@ static s7_pointer g_byte_vector_set(s7_scheme *sc, s7_pointer args) return(c); } -static s7_int byte_vector_set_i(s7_pointer p1, s7_int i1, s7_int i2) +static s7_int byte_vector_set_i_7pii(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2) { if (!is_byte_vector(p1)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_set_symbol, p1, a_byte_vector_string); + simple_wrong_type_argument_with_type(sc, sc->byte_vector_set_symbol, p1, a_byte_vector_string); if ((i2 < 0) || (i2 > 255)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_set_symbol, wrap_integer(i2), an_unsigned_byte_string); + simple_wrong_type_argument_with_type(sc, sc->byte_vector_set_symbol, wrap_integer1(sc, i2), an_unsigned_byte_string); if ((i1 < 0) || (i1 >= byte_vector_length(p1))) - simple_out_of_range(cur_sc, cur_sc->byte_vector_set_symbol, wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + simple_out_of_range(sc, sc->byte_vector_set_symbol, wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); byte_vector_bytes(p1)[i1] = (uint8_t)i2; return(i2); } -static s7_pointer byte_vector_set_unchecked(s7_pointer p1, s7_int i1, s7_pointer p2) {byte_vector_bytes(p1)[i1] = (uint8_t)s7_integer(p2); return(p2);} +static s7_pointer byte_vector_set_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) {byte_vector_bytes(p1)[i1] = (uint8_t)s7_integer(p2); return(p2);} /* -------------------------------- byte-vector? -------------------------------- */ @@ -22782,7 +22928,7 @@ static bool s7_is_byte_vector(s7_pointer b) {return(is_byte_vector(b));} static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args) { #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector" - #define Q_is_byte_vector pl_bt + #define Q_is_byte_vector sc->pl_bt check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args); } @@ -22931,13 +23077,13 @@ static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args) return(method_or_bust_with_type_one_arg(sc, x, sc->is_port_closed_symbol, args, wrap_string(sc, "a port", 6))); } -static bool is_port_closed_b(s7_pointer x) +static bool is_port_closed_b_7p(s7_scheme *sc, s7_pointer x) { if ((is_input_port(x)) || (is_output_port(x))) return(port_is_closed(x)); - if ((x == cur_sc->output_port) && (x == cur_sc->F)) + if ((x == sc->output_port) && (x == sc->F)) return(false); - simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_port_closed_symbol, x, wrap_string(cur_sc, "a port", 6)); + simple_wrong_type_argument_with_type(sc, sc->is_port_closed_symbol, x, wrap_string(sc, "a port", 6)); return(false); } @@ -22957,16 +23103,16 @@ static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args) return(c_port_line_number(sc, (is_null(args)) ? sc->input_port : car(args))); } -s7_int s7_port_line_number(s7_pointer p) +s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p) { if (!(is_input_port(p))) - simple_wrong_type_argument(cur_sc, cur_sc->port_line_number_symbol, p, T_INPUT_PORT); + simple_wrong_type_argument(sc, sc->port_line_number_symbol, p, T_INPUT_PORT); return(port_line_number(p)); } -static s7_int port_line_number_i_p(s7_pointer p) +static s7_int port_line_number_i_7p(s7_scheme *sc, s7_pointer p) { - return(s7_port_line_number(p)); + return(s7_port_line_number(sc, p)); } static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args) @@ -22991,7 +23137,7 @@ static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args) } -const char *s7_port_filename(s7_pointer x) +const char *s7_port_filename(s7_scheme *sc, s7_pointer x) { if (((is_input_port(x)) || (is_output_port(x))) && @@ -23028,7 +23174,7 @@ static bool is_input_port_b(s7_pointer p) {return(is_input_port(p));} static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args) { #define H_is_input_port "(input-port? p) returns #t if p is an input port" - #define Q_is_input_port pl_bt + #define Q_is_input_port sc->pl_bt check_boolean_method(sc, is_input_port, sc->is_input_port_symbol, args); } @@ -23039,7 +23185,7 @@ static bool is_output_port_b(s7_pointer p) {return(is_output_port(p));} static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args) { #define H_is_output_port "(output-port? p) returns #t if p is an output port" - #define Q_is_output_port pl_bt + #define Q_is_output_port sc->pl_bt check_boolean_method(sc, is_output_port, sc->is_output_port_symbol, args); } @@ -23200,7 +23346,7 @@ void s7_close_input_port(s7_scheme *sc, s7_pointer p) if (port_filename(p)) { /* for string ports, this is the original input file name */ - liberate(port_filename_block(p)); + liberate(sc, port_filename_block(p)); port_filename(p) = NULL; } @@ -23227,7 +23373,7 @@ void s7_close_input_port(s7_scheme *sc, s7_pointer p) { if (port_data(p)) { - liberate(port_data_block(p)); + liberate(sc, port_data_block(p)); port_data_block(p) = NULL; port_data(p) = NULL; port_data_size(p) = 0; @@ -23306,7 +23452,7 @@ static void close_output_port(s7_scheme *sc, s7_pointer p) { if (port_filename(p)) /* only a file output port has a filename(?) */ { - liberate(port_filename_block(p)); + liberate(sc, port_filename_block(p)); port_filename(p) = NULL; port_filename_length(p) = 0; } @@ -23460,7 +23606,7 @@ static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, p = fgets(buf, read_size, port_file(port)); if (!p) - return(sc->eof_object); + return(eof_object); rtn = strchr(buf, (int)'\n'); if (rtn) @@ -23481,7 +23627,7 @@ static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, previous_size -= 1; buf = (char *)(sc->read_line_buf + previous_size); } - return(sc->eof_object); + return(eof_object); } @@ -23507,7 +23653,7 @@ static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol i = port_data_size(port); port_position(port) = i; if (i <= port_start) /* the < part can happen -- if not caught we try to create a string of length -1 -> segfault */ - return(sc->eof_object); + return(eof_object); if (copied) return(s7_make_string_with_length(sc, (const char *)start, i - port_start)); @@ -23517,7 +23663,7 @@ static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol /* -------- write character functions -------- */ -static void resize_port_data(s7_pointer pt, s7_int new_size) +static void resize_port_data(s7_scheme *sc, s7_pointer pt, s7_int new_size) { s7_int loc; block_t *nb; @@ -23525,7 +23671,7 @@ static void resize_port_data(s7_pointer pt, s7_int new_size) loc = port_data_size(pt); if (new_size < loc) return; - nb = reallocate(port_data_block(pt), new_size); + nb = reallocate(sc, port_data_block(pt), new_size); port_data_block(pt) = nb; port_data(pt) = (uint8_t *)(block_data(nb)); port_data_size(pt) = new_size; @@ -23534,7 +23680,7 @@ static void resize_port_data(s7_pointer pt, s7_int new_size) static void string_write_char_resized(s7_scheme *sc, uint8_t c, s7_pointer pt) { /* this division looks repetitive, but it is much faster */ - resize_port_data(pt, port_data_size(pt) * 2); + resize_port_data(sc, pt, port_data_size(pt) * 2); port_data(pt)[port_position(pt)++] = c; } @@ -23639,7 +23785,7 @@ static void string_write_string_resized(s7_scheme *sc, const char *str, s7_int l { s7_int new_len; /* len is known to be non-zero, str may not be 0-terminated */ new_len = port_position(pt) + len; - resize_port_data(pt, new_len * 2); + resize_port_data(sc, pt, new_len * 2); memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len); port_position(pt) = new_len; } @@ -24027,30 +24173,33 @@ static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt) return(result); } -static inline void port_set_filename(s7_pointer p, const char *name, size_t len) +static inline void port_set_filename(s7_scheme *sc, s7_pointer p, const char *name, size_t len) { block_t *b; - b = mallocate(len + 1); + b = mallocate(sc, len + 1); port_filename_block(p) = b; port_filename(p) = (char *)block_data(b); memcpy((void *)block_data(b), (void *)name, len); port_filename(p)[len] = '\0'; } -static block_t *mallocate_port(void) +static block_t *mallocate_port(s7_scheme *sc) { #define PORT_LIST 8 /* sizeof(port_t): 160 */ block_t *p; - p = block_lists[PORT_LIST]; + p = sc->block_lists[PORT_LIST]; if (p) { - block_lists[PORT_LIST] = (block_t *)block_next(p); + sc->block_lists[PORT_LIST] = (block_t *)block_next(p); block_next(p) = NULL; +#if S7_DEBUGGING + block_allocs(p)++; +#endif } else { - p = mallocate_block(); - block_data(p) = (void *)alloc_permanent_string((size_t)(1 << PORT_LIST)); + p = mallocate_block(sc); + block_data(p) = (void *)alloc_permanent_string(sc, (size_t)(1 << PORT_LIST)); block_set_index(p, PORT_LIST); } block_set_size(p, sizeof(port_t)); @@ -24068,7 +24217,7 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, s7_int ma new_cell(sc, port, T_INPUT_PORT); port_loc = s7_gc_protect_1(sc, port); - b = mallocate_port(); + b = mallocate_port(sc); port_block(port) = b; port_port(port) = (port_t *)block_data(b); port_set_closed(port, false); @@ -24080,7 +24229,7 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, s7_int ma * memory, we gradually core-up. */ port_filename_length(port) = safe_strlen(name); - port_set_filename(port, name, port_filename_length(port)); + port_set_filename(sc, port, name, port_filename_length(port)); port_line_number(port) = 1; /* first line is numbered 1 */ port_file_number(port) = 0; add_input_port(sc, port); @@ -24100,7 +24249,7 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, s7_int ma block_t *block; uint8_t *content; - block = mallocate(size + 2); + block = mallocate(sc, size + 2); content = (uint8_t *)(block_data(block)); bytes = fread(content, sizeof(uint8_t), size, fp); if (bytes != (size_t)size) @@ -24228,12 +24377,12 @@ static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char char *filename; s7_int len; len = safe_strlen(name) + safe_strlen(home) + 1; - b = mallocate(len); + b = mallocate(sc, len); filename = (char *)block_data(b); filename[0] = '\0'; catstrs(filename, len, home, (char *)(name + 1), NULL); fp = fopen(filename, "r"); - liberate(b); + liberate(sc, b); if (fp) return(make_input_file(sc, name, fp)); } @@ -24281,8 +24430,8 @@ static void make_standard_ports(s7_scheme *sc) s7_pointer x; /* standard output */ - x = alloc_pointer(); - unheap(x); + x = alloc_pointer(sc); + unheap(sc, x); set_type(x, T_OUTPUT_PORT | T_IMMUTABLE); port_port(x) = (port_t *)calloc(1, sizeof(port_t)); port_type(x) = FILE_PORT; @@ -24290,7 +24439,7 @@ static void make_standard_ports(s7_scheme *sc) port_data_block(x) = NULL; port_set_closed(x, false); port_filename_length(x) = 8; - port_set_filename(x, "*stdout*", 8); + port_set_filename(sc, x, "*stdout*", 8); port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (__FUNC__ data) */ port_line_number(x) = 0; port_file(x) = stdout; @@ -24303,8 +24452,8 @@ static void make_standard_ports(s7_scheme *sc) sc->standard_output = x; /* standard error */ - x = alloc_pointer(); - unheap(x); + x = alloc_pointer(sc); + unheap(sc, x); set_type(x, T_OUTPUT_PORT | T_IMMUTABLE); port_port(x) = (port_t *)calloc(1, sizeof(port_t)); port_type(x) = FILE_PORT; @@ -24312,7 +24461,7 @@ static void make_standard_ports(s7_scheme *sc) port_data_block(x) = NULL; port_set_closed(x, false); port_filename_length(x) = 8; - port_set_filename(x, "*stderr*", 8); + port_set_filename(sc, x, "*stderr*", 8); port_file_number(x) = remember_file_name(sc, port_filename(x)); port_line_number(x) = 0; port_file(x) = stderr; @@ -24325,15 +24474,15 @@ static void make_standard_ports(s7_scheme *sc) sc->standard_error = x; /* standard input */ - x = alloc_pointer(); - unheap(x); + x = alloc_pointer(sc); + unheap(sc, x); set_type(x, T_INPUT_PORT | T_IMMUTABLE); port_port(x) = (port_t *)calloc(1, sizeof(port_t)); port_type(x) = FILE_PORT; port_set_closed(x, false); port_original_input_string(x) = sc->nil; port_filename_length(x) = 7; - port_set_filename(x, "*stdin*", 7); + port_set_filename(sc, x, "*stdin*", 7); port_file_number(x) = remember_file_name(sc, port_filename(x)); port_line_number(x) = 0; port_file(x) = stdin; @@ -24381,13 +24530,13 @@ s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode } new_cell(sc, x, T_OUTPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = FILE_PORT; port_set_closed(x, false); port_filename_length(x) = safe_strlen(name); - port_set_filename(x, name, port_filename_length(x)); + port_set_filename(sc, x, name, port_filename_length(x)); port_line_number(x) = 1; port_file_number(x) = 0; port_file(x) = fp; @@ -24399,7 +24548,7 @@ s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode port_write_string(x) = file_write_string; port_position(x) = 0; port_data_size(x) = PORT_DATA_SIZE; - block = mallocate(PORT_DATA_SIZE); + block = mallocate(sc, PORT_DATA_SIZE); port_data_block(x) = block; port_data(x) = (uint8_t *)(block_data(block)); add_output_port(sc, x); @@ -24431,7 +24580,7 @@ static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, s7_ s7_pointer x; block_t *b; new_cell(sc, x, T_INPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = STRING_PORT; @@ -24506,13 +24655,13 @@ static s7_pointer open_output_string(s7_scheme *sc, s7_int len) s7_pointer x; block_t *block, *b; new_cell(sc, x, T_OUTPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = STRING_PORT; port_set_closed(x, false); port_data_size(x) = len; - block = mallocate(len); + block = mallocate(sc, len); port_data_block(x) = block; port_data(x) = (uint8_t *)(block_data(block)); port_data(x)[0] = '\0'; /* in case s7_get_output_string before any output */ @@ -24532,7 +24681,7 @@ static s7_pointer open_output_string(s7_scheme *sc, s7_int len) s7_pointer s7_open_output_string(s7_scheme *sc) {return(open_output_string(sc, sc->initial_string_port_length));} -static s7_pointer open_output_string_p(void) {return(s7_open_output_string(cur_sc));} +static s7_pointer open_output_string_p(s7_scheme *sc) {return(s7_open_output_string(sc));} static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args) { @@ -24587,7 +24736,7 @@ If the optional 'clear-port' is #t, the current string is flushed." s7_pointer result; result = block_to_string(sc, port_data_block(p), port_position(p)); port_data_size(p) = 64; - block = mallocate(64); + block = mallocate(sc, 64); port_data_block(p) = block; port_data(p) = (uint8_t *)(block_data(block)); port_position(p) = 0; @@ -24602,7 +24751,7 @@ s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_schem s7_pointer x; block_t *b; new_cell(sc, x, T_INPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = FUNCTION_PORT; @@ -24631,7 +24780,7 @@ s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc s7_pointer x; block_t *b; new_cell(sc, x, T_OUTPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = FUNCTION_PORT; @@ -24713,7 +24862,7 @@ s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port) { int32_t c; c = port_read_character(port)(sc, port); - if (c == EOF) return(sc->eof_object); + if (c == EOF) return(eof_object); return(chars[c]); } @@ -24728,7 +24877,7 @@ s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port) return(chars[(uint8_t)port_data(port)[port_position(port)]]); } c = port_read_character(port)(sc, port); - if (c == EOF) return(sc->eof_object); + if (c == EOF) return(eof_object); backchar(c, port); return(chars[c]); } @@ -24771,7 +24920,7 @@ static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args) else { port = input_port_if_not_loading(sc); - if (!port) return(sc->eof_object); + if (!port) return(eof_object); } if (!is_input_port(port)) return(method_or_bust_with_type_one_arg(sc, port, sc->read_char_symbol, args, an_input_port_string)); @@ -24800,23 +24949,23 @@ static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args) return(chr); } -static s7_pointer write_char_p_p(s7_pointer c) +static s7_pointer write_char_p_p(s7_scheme *sc, s7_pointer c) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->write_char_symbol, c, T_CHARACTER); - if (cur_sc->output_port == cur_sc->F) return(c); - port_write_character(cur_sc->output_port)(cur_sc, s7_character(c), cur_sc->output_port); + simple_wrong_type_argument(sc, sc->write_char_symbol, c, T_CHARACTER); + if (sc->output_port == sc->F) return(c); + port_write_character(sc->output_port)(sc, s7_character(c), sc->output_port); return(c); } -static s7_pointer write_char_p_pp(s7_pointer c, s7_pointer port) +static s7_pointer write_char_p_pp(s7_scheme *sc, s7_pointer c, s7_pointer port) { if (!s7_is_character(c)) - simple_wrong_type_argument(cur_sc, cur_sc->write_char_symbol, c, T_CHARACTER); - if (port == cur_sc->F) return(c); + simple_wrong_type_argument(sc, sc->write_char_symbol, c, T_CHARACTER); + if (port == sc->F) return(c); if (!is_output_port(port)) - simple_wrong_type_argument_with_type(cur_sc, cur_sc->write_char_symbol, port, an_output_port_string); - port_write_character(port)(cur_sc, s7_character(c), port); + simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_output_port_string); + port_write_character(port)(sc, s7_character(c), port); return(c); } @@ -24860,14 +25009,14 @@ static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args) else { port = input_port_if_not_loading(sc); - if (!port) return(sc->eof_object); + if (!port) return(eof_object); } if (!is_input_port(port)) return(method_or_bust_with_type_one_arg(sc, port, sc->read_byte_symbol, args, an_input_port_string)); c = port_read_character(port)(sc, port); if (c == EOF) - return(sc->eof_object); + return(eof_object); return(small_int(c)); } @@ -24923,12 +25072,11 @@ If 'with-eol' is not #f, read-line includes the trailing end-of-line character." else { port = input_port_if_not_loading(sc); - if (!port) return(sc->eof_object); + if (!port) return(eof_object); } return(port_read_line(port)(sc, port, with_eol, true)); } -static s7_pointer read_line_uncopied; static s7_pointer g_read_line_uncopied(s7_scheme *sc, s7_pointer args) { s7_pointer port; @@ -24964,11 +25112,11 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) else port = input_port_if_not_loading(sc); if (chars < 0) - return(wrong_type_argument_with_type(sc, sc->read_string_symbol, 1, wrap_integer(chars), a_non_negative_integer_string)); + return(wrong_type_argument_with_type(sc, sc->read_string_symbol, 1, wrap_integer1(sc, chars), a_non_negative_integer_string)); if (chars > sc->max_string_length) - return(out_of_range(sc, sc->read_string_symbol, small_int(1), wrap_integer(chars), its_too_large_string)); + return(out_of_range(sc, sc->read_string_symbol, small_int(1), wrap_integer1(sc, chars), its_too_large_string)); - if (!port) return(sc->eof_object); + if (!port) return(eof_object); if (!is_input_port(port)) return(method_or_bust_with_type(sc, port, sc->read_string_symbol, list_2(sc, make_integer(sc, chars), port), an_input_port_string, 2)); @@ -24984,7 +25132,7 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) end = port_data_size(port); len = end - pos; if (len > chars) len = chars; - if (len <= 0) return(sc->eof_object); + if (len <= 0) return(eof_object); memcpy((void *)str, (void *)(port_data(port) + pos), len); string_length(s) = len; str[len] = '\0'; @@ -24998,7 +25146,7 @@ static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args) if (c == EOF) { if (i == 0) - return(sc->eof_object); + return(eof_object); string_length(s) = i; return(s); } @@ -25061,7 +25209,7 @@ s7_pointer s7_read(s7_scheme *sc, s7_pointer port) eval(sc, OP_READ_INTERNAL); if (sc->tok == TOKEN_EOF) - sc->value = sc->eof_object; + sc->value = eof_object; if ((sc->cur_op == OP_EVAL_DONE) && (stack_op(sc->stack, s7_stack_top(sc) - 1) == OP_BARRIER)) @@ -25096,7 +25244,7 @@ static s7_pointer g_read(s7_scheme *sc, s7_pointer args) else { port = input_port_if_not_loading(sc); - if (!port) return(sc->eof_object); + if (!port) return(eof_object); } if (!is_input_port(port)) @@ -25107,7 +25255,7 @@ static s7_pointer g_read(s7_scheme *sc, s7_pointer args) if ((is_string_port(port)) && (port_data_size(port) <= port_position(port))) - return(sc->eof_object); + return(eof_object); push_input_port(sc, port); push_stack_op_let(sc, OP_READ_DONE); /* this stops the internal read process so we only get one form */ @@ -25167,7 +25315,7 @@ static block_t *search_load_path(s7_scheme *sc, const char *name) block_t *b; s7_int i; char *filename; - b = mallocate(1024); + b = mallocate(sc, 1024); filename = (char *)block_data(b); for (i = 0; i < len; i++) @@ -25187,7 +25335,7 @@ static block_t *search_load_path(s7_scheme *sc, const char *name) } } } - liberate(b); + liberate(sc, b); } return(NULL); } @@ -25209,7 +25357,7 @@ s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_poin { new_filename = copy_string((const char *)block_data(b)); /* (require libc.scm) for example needs the directory for cload in some cases */ fp = (FILE *)block_info(b); - liberate(b); + liberate(sc, b); } } if (!fp) @@ -25260,14 +25408,14 @@ s7_pointer s7_load(s7_scheme *sc, const char *filename) #if WITH_C_LOADER #include <dlfcn.h> -static block_t *full_filename(const char *filename) +static block_t *full_filename(s7_scheme *sc, const char *filename) { s7_int len; char *pwd, *rtn; block_t *block; pwd = getcwd(NULL, 0); /* docs say this means it will return a new string of the right size */ len = safe_strlen(pwd) + safe_strlen(filename) + 8; - block = mallocate(len * sizeof(char)); + block = mallocate(sc, len * sizeof(char)); rtn = (char *)block_data(block); if (pwd) { @@ -25341,7 +25489,7 @@ defaults to the rootlet. To load into the current environment instead, pass (cu if (fname[0] != '/') { - pname = full_filename(fname); /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */ + pname = full_filename(sc, fname); /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */ pwd_name = (char *)block_data(pname); } library = dlopen((pname) ? pwd_name : fname, RTLD_NOW); @@ -25356,7 +25504,7 @@ defaults to the rootlet. To load into the current environment instead, pass (cu { typedef void *(*dl_func)(s7_scheme *sc); ((dl_func)init_func)(sc); - if (pname) liberate(pname); + if (pname) liberate(sc, pname); return(sc->T); } else @@ -25366,7 +25514,7 @@ defaults to the rootlet. To load into the current environment instead, pass (cu } } else s7_warn(sc, 512, "load %s failed: %s\n", (pname) ? pwd_name : fname, dlerror()); - if (pname) liberate(pname); + if (pname) liberate(sc, pname); } else s7_warn(sc, 512, "can't load %s: no init function\n", fname); return(sc->F); @@ -25391,12 +25539,12 @@ defaults to the rootlet. To load into the current environment instead, pass (cu char *filename; s7_int len; len = safe_strlen(fname) + safe_strlen(home) + 1; - b = mallocate(len); + b = mallocate(sc, len); filename = (char *)block_data(b); filename[0] = '\0'; catstrs(filename, len, home, (char *)(fname + 1), NULL); fp = fopen(filename, "r"); - liberate(b); + liberate(sc, b); } } } @@ -25409,7 +25557,7 @@ defaults to the rootlet. To load into the current environment instead, pass (cu if (!b) return(file_error(sc, "load", "can't open", fname)); fp = (FILE *)block_info(b); - liberate(b); + liberate(sc, b); } port = read_file(sc, fp, fname, -1, "load"); @@ -25740,11 +25888,11 @@ bool s7_is_provided(s7_scheme *sc, const char *feature) return(is_memq(s7_make_symbol(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */ } -bool is_provided_b(s7_pointer sym) +bool is_provided_b_7p(s7_scheme *sc, s7_pointer sym) { if (!is_symbol(sym)) - simple_wrong_type_argument(cur_sc, cur_sc->is_provided_symbol, sym, T_SYMBOL); - return(is_memq(sym, s7_symbol_value(cur_sc, cur_sc->features_symbol))); + simple_wrong_type_argument(sc, sc->is_provided_symbol, sym, T_SYMBOL); + return(is_memq(sym, s7_symbol_value(sc, sc->features_symbol))); } @@ -25800,7 +25948,7 @@ void s7_provide(s7_scheme *sc, const char *feature) {c_provide(sc, s7_make_symbo static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args) { - /* symbol_setter for set/let of *features* which can only be changed via provide */ + /* setter for set/let of *features* which can only be changed via provide */ if (s7_is_list(sc, cadr(args))) return(cadr(args)); return(s7_error(sc, sc->error_symbol, set_elist_2(sc, wrap_string(sc, "can't set *features* to ~S", 26), cadr(args)))); @@ -25879,7 +26027,7 @@ static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args) { s7_pointer str, proc; #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it" - #define Q_call_with_input_string pl_sf + #define Q_call_with_input_string sc->pl_sf /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45 */ str = car(args); @@ -25906,7 +26054,7 @@ static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args) static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args) { #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument" - #define Q_call_with_input_file pl_sf + #define Q_call_with_input_file sc->pl_sf s7_pointer str, proc; str = car(args); @@ -25941,7 +26089,7 @@ static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args) static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args) { #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk" - #define Q_with_input_from_string pl_sf + #define Q_with_input_from_string sc->pl_sf s7_pointer str; str = car(args); @@ -25966,7 +26114,7 @@ static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args) static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args) { #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk" - #define Q_with_input_from_file pl_sf + #define Q_with_input_from_file sc->pl_sf if (!is_string(car(args))) return(method_or_bust(sc, car(args), sc->with_input_from_file_symbol, args, T_STRING, 1)); @@ -26022,10 +26170,10 @@ static s7_pointer titr_len(s7_pointer p, const char *func, int32_t line) return(p); } -static s7_pointer titr_pos(s7_pointer p, const char *func, int32_t line) +static s7_pointer titr_pos(s7_scheme *sc, s7_pointer p, const char *func, int32_t line) { if (((is_let(iterator_sequence(p))) && - (iterator_sequence(p) != cur_sc->rootlet)) || + (iterator_sequence(p) != sc->rootlet)) || (is_pair(iterator_sequence(p)))) { fprintf(stderr, "%s%s[%d]: iterator position sequence is %s%s\n", BOLD_TEXT, func, line, check_name(unchecked_type(iterator_sequence(p))), UNBOLD_TEXT); @@ -26038,7 +26186,7 @@ static s7_pointer titr_pos(s7_pointer p, const char *func, int32_t line) static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args) { #define H_is_iterator "(iterator? obj) returns #t if obj is an iterator." - #define Q_is_iterator pl_bt + #define Q_is_iterator sc->pl_bt s7_pointer x; x = car(args); @@ -26062,7 +26210,7 @@ static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p) static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator) { - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator) @@ -26084,7 +26232,7 @@ static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator) } iterator_next(iterator) = iterator_finished; clear_iter_ok(iterator); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator) @@ -26103,7 +26251,7 @@ static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator) } iterator_next(iterator) = iterator_finished; clear_iter_ok(iterator); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator) @@ -26153,7 +26301,7 @@ static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator) } iterator_next(iterator) = iterator_finished; clear_iter_ok(iterator); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj) @@ -26162,7 +26310,7 @@ static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj) return(s7_make_character(sc, (uint8_t)(string_value(iterator_sequence(obj))[iterator_position(obj)++]))); iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj) @@ -26171,7 +26319,7 @@ static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj) return(small_int(byte_vector_bytes(iterator_sequence(obj))[iterator_position(obj)++])); iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj) @@ -26180,7 +26328,7 @@ static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj) return(make_real(sc, float_vector_element(iterator_sequence(obj), iterator_position(obj)++))); iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj) @@ -26189,7 +26337,7 @@ static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj) return(make_integer(sc, int_vector_element(iterator_sequence(obj), iterator_position(obj)++))); iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj) @@ -26198,14 +26346,14 @@ static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj) return(vector_element(iterator_sequence(obj), iterator_position(obj)++)); iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj) { s7_pointer result; result = s7_apply_function(sc, iterator_sequence(obj), sc->nil); - if (result == sc->ITERATOR_END) + if (result == ITERATOR_END) { iterator_next(obj) = iterator_finished; clear_iter_ok(obj); @@ -26228,7 +26376,7 @@ static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj) sc->x = car(sc->z2_1); sc->z = car(sc->z2_2); iterator_position(obj)++; - if (result == sc->ITERATOR_END) + if (result == ITERATOR_END) { iterator_next(obj) = iterator_finished; clear_iter_ok(obj); @@ -26237,7 +26385,7 @@ static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj) } iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } @@ -26256,7 +26404,7 @@ static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj) } iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj) @@ -26274,7 +26422,7 @@ static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj) } iterator_next(obj) = iterator_finished; clear_iter_ok(obj); - return(sc->ITERATOR_END); + return(ITERATOR_END); } static s7_pointer iterator_method(s7_scheme *sc, s7_pointer e) @@ -26472,7 +26620,7 @@ bool s7_is_iterator(s7_pointer obj) return(is_iterator(obj)); } -static bool is_iterator_b(s7_pointer obj) {return(g_is_iterator(cur_sc, set_plist_1(cur_sc, obj)) != cur_sc->F);} +static bool is_iterator_b_7p(s7_scheme *sc, s7_pointer obj) {return(g_is_iterator(sc, set_plist_1(sc, obj)) != sc->F);} bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj) { @@ -26483,12 +26631,12 @@ bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj) return(true); } -bool iterator_is_at_end_b(s7_pointer obj) +bool iterator_is_at_end_b_7p(s7_scheme *sc, s7_pointer obj) { if (iter_ok(obj)) return(false); if (!is_iterator(obj)) - simple_wrong_type_argument(cur_sc, cur_sc->iterator_is_at_end_symbol, obj, T_ITERATOR); + simple_wrong_type_argument(sc, sc->iterator_is_at_end_symbol, obj, T_ITERATOR); return(true); } @@ -26812,18 +26960,18 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, break; case T_C_POINTER: - if ((has_structure(raw_pointer_type(top))) && - (collect_shared_info(sc, ci, raw_pointer_type(top), stop_at_print_length))) + if ((has_structure(c_pointer_type(top))) && + (collect_shared_info(sc, ci, c_pointer_type(top), stop_at_print_length))) { - if (peek_shared_ref(ci, raw_pointer_type(top)) == 0) - check_collected(raw_pointer_type(top), ci); + if (peek_shared_ref(ci, c_pointer_type(top)) == 0) + check_collected(c_pointer_type(top), ci); top_cyclic = true; } - if ((has_structure(raw_pointer_info(top))) && - (collect_shared_info(sc, ci, raw_pointer_info(top), stop_at_print_length))) + if ((has_structure(c_pointer_info(top))) && + (collect_shared_info(sc, ci, c_pointer_info(top), stop_at_print_length))) { - if (peek_shared_ref(ci, raw_pointer_info(top)) == 0) - check_collected(raw_pointer_info(top), ci); + if (peek_shared_ref(ci, c_pointer_info(top)) == 0) + check_collected(c_pointer_info(top), ci); top_cyclic = true; } break; @@ -27137,7 +27285,6 @@ static void slashify_string_to_port(s7_scheme *sc, s7_pointer port, const char * default: { s7_int n; - static char dignum[] = "0123456789abcdef"; port_write_character(port)(sc, 'x', port); n = (s7_int)(*pcur); if (n < 16) @@ -27243,7 +27390,7 @@ static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, u if (data_len > 100) { const char *filename; - filename = (const char *)s7_port_filename(obj); + filename = (const char *)s7_port_filename(sc, obj); if (filename) { #define DO_STR_LEN 1024 @@ -27256,7 +27403,7 @@ static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, u port_write_string(port)(sc, do_str, len, port); do_str[0] = '\0'; len = catstrs(do_str, DO_STR_LEN, " (do ((i 0 (+ i 1)) (c (read-char port) (read-char port))) ((= i ", - pos_int_to_str_direct(port_position(obj) - 1), + pos_int_to_str_direct(sc, port_position(obj) - 1), ") port)))", NULL); } else len = catstrs(do_str, DO_STR_LEN, "(open-input-file \"", filename, "\")", NULL); @@ -27338,7 +27485,7 @@ static inline void symbol_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port s7_int new_len; new_len = port_position(port) + symbol_name_length(obj); if (new_len >= port_data_size(port)) - resize_port_data(port, new_len * 2); + resize_port_data(sc, port, new_len * 2); memcpy((void *)(port_data(port) + port_position(port)), (void *)symbol_name(obj), symbol_name_length(obj)); port_position(port) = new_len; } @@ -27354,7 +27501,7 @@ static char *multivector_indices_to_string(s7_scheme *sc, s7_int index, s7_point ind = index % size; if (cur_dim > 0) multivector_indices_to_string(sc, (index - ind) / size, vect, str, cur_dim - 1); - catstrs(str, 128, " ", pos_int_to_str_direct(ind), NULL); + catstrs(str, 128, " ", pos_int_to_str_direct(sc, ind), NULL); return(str); } @@ -27431,7 +27578,7 @@ static void make_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port) vlen = vector_length(vect); if (vector_rank(vect) == 1) { - plen = catstrs_direct(buf, "(make-", vtyp, "vector ", integer_to_string_no_length(vlen), " ", NULL); + plen = catstrs_direct(buf, "(make-", vtyp, "vector ", integer_to_string_no_length(sc, vlen), " ", NULL); port_write_string(port)(sc, buf, plen, port); } else @@ -27441,12 +27588,26 @@ static void make_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port) port_write_string(port)(sc, buf, plen, port); for (dim = 0; dim < vector_ndims(vect) - 1; dim++) { - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), " ", NULL); + plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), " ", NULL); port_write_string(port)(sc, buf, plen, port); } - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), ") ", NULL); + plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), ") ", NULL); + port_write_string(port)(sc, buf, plen, port); + } +} + +static void write_vector_dimensions(s7_scheme *sc, s7_pointer vect, s7_pointer port) +{ + char buf[128]; + s7_int dim, plen; + port_write_string(port)(sc, " '(", 3, port); + for (dim = 0; dim < vector_ndims(vect) - 1; dim++) + { + plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), " ", NULL); port_write_string(port)(sc, buf, plen, port); } + plen = catstrs_direct(buf, integer_to_string_no_length(sc, vector_dimension(vect, dim)), "))", NULL); + port_write_string(port)(sc, buf, plen, port); } static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info *ci) @@ -27460,7 +27621,7 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ { if (vector_rank(vect) > 1) { - plen = catstrs_direct(buf, "#", pos_int_to_str_direct(vector_ndims(vect)), "d()", NULL); + plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d()", NULL); port_write_string(port)(sc, buf, plen, port); } else port_write_string(port)(sc, "#()", 3, port); @@ -27473,7 +27634,7 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ { if (vector_rank(vect) > 1) { - plen = catstrs_direct(buf, "#", pos_int_to_str_direct(vector_ndims(vect)), "d(...)", NULL); + plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d(...)", NULL); port_write_string(port)(sc, buf, plen, port); } else port_write_string(port)(sc, "#(...)", 6, port); @@ -27521,13 +27682,13 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ if ((ci->defined[vref]) || (port == ci->cycle_port)) { - plen = catstrs_direct(buf, "<", pos_int_to_str_direct(vref), ">", NULL); + plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, vref), ">", NULL); port_write_string(port)(sc, buf, plen, port); return; } if (vector_rank(vect) > 1) - port_write_string(port)(sc, "(make-shared-vector ", 20, port); + port_write_string(port)(sc, "(subvector ", 11, port); port_write_string(port)(sc, "(vector", 7, port); /* top level let */ for (i = 0; i < len; i++) @@ -27548,19 +27709,19 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ s7_int dimension; block_t *b; dimension = vector_rank(vect) - 1; - b = callocate(128); + b = callocate(sc, 128); indices = (char *)block_data(b); - plen = catstrs_direct(buf, "(set! (<", pos_int_to_str_direct(vref), ">", + plen = catstrs_direct(buf, "(set! (<", pos_int_to_str_direct(sc, vref), ">", multivector_indices_to_string(sc, i, vect, indices, dimension), - ") <", pos_int_to_str_direct_1(eref), ">)\n ", NULL); + ") <", pos_int_to_str_direct_1(sc, eref), ">)\n ", NULL); port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port); - liberate(b); + liberate(sc, b); } else { - len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(vref), "> ", - integer_to_string(i, &plen), ") <", - pos_int_to_str_direct_1(eref), ">)\n", NULL); + len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(sc, vref), "> ", + integer_to_string(sc, i, &plen), ") <", + pos_int_to_str_direct_1(sc, eref), ">)\n", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); } @@ -27572,17 +27733,17 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ s7_int dimension; block_t *b; dimension = vector_rank(vect) - 1; - b = callocate(128); + b = callocate(sc, 128); indices = (char *)block_data(b); buf[0] = '\0'; multivector_indices_to_string(sc, i, vect, indices, dimension); /* writes to indices */ - plen = catstrs(buf, 128, "(set! (<", pos_int_to_str_direct(vref), ">", indices, ") ", NULL); + plen = catstrs(buf, 128, "(set! (<", pos_int_to_str_direct(sc, vref), ">", indices, ") ", NULL); port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port); - liberate(b); + liberate(sc, b); } else { - len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(vref), "> ", integer_to_string_no_length(i), ") ", NULL); + len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(sc, vref), "> ", integer_to_string_no_length(sc, i), ") ", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); } @@ -27597,25 +27758,13 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ } } port_write_character(port)(sc, ')', port); - if (vector_rank(vect) > 1) - { - s7_int dim; - port_write_string(port)(sc, " '(", 3, port); - for (dim = 0; dim < vector_ndims(vect) - 1; dim++) - { - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), " ", NULL); - port_write_string(port)(sc, buf, plen, port); - } - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), "))", NULL); - port_write_string(port)(sc, buf, plen, port); - /* port_write_string(port)(sc, "))", 2, port); */ - } + write_vector_dimensions(sc, vect, port); } else { if (vector_rank(vect) > 1) - port_write_string(port)(sc, "(make-shared-vector ", 20, port); + port_write_string(port)(sc, "(subvector ", 11, port); if (is_immutable(vect)) port_write_string(port)(sc, "(immutable! ", 12, port); @@ -27631,18 +27780,7 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ port_write_character(port)(sc, ')', port); if (vector_rank(vect) > 1) - { - s7_int dim; - port_write_string(port)(sc, " '(", 3, port); - for (dim = 0; dim < vector_ndims(vect) - 1; dim++) - { - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), " ", NULL); - port_write_string(port)(sc, buf, plen, port); - } - plen = catstrs_direct(buf, integer_to_string_no_length(vector_dimension(vect, dim)), "))", NULL); - port_write_string(port)(sc, buf, plen, port); - /* port_write_string(port)(sc, "))", 2, port); */ - } + write_vector_dimensions(sc, vect, port); } } else /* not readable write */ @@ -27652,7 +27790,7 @@ static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_ bool last = false; if (vector_ndims(vect) > 1) { - plen = catstrs_direct(buf, "#", pos_int_to_str_direct(vector_ndims(vect)), "d", NULL); + plen = catstrs_direct(buf, "#", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", NULL); port_write_string(port)(sc, buf, plen, port); } else port_write_character(port)(sc, '#', port); @@ -27684,7 +27822,7 @@ static int32_t print_vector_length(s7_scheme *sc, s7_pointer vect, s7_pointer po if (len == 0) { if (vector_rank(vect) > 1) - plen = catstrs_direct(buf, "#", (is_int_vector(vect)) ? "i" : "r", pos_int_to_str_direct(vector_ndims(vect)), "d()", NULL); + plen = catstrs_direct(buf, "#", (is_int_vector(vect)) ? "i" : "r", pos_int_to_str_direct(sc, vector_ndims(vect)), "d()", NULL); else plen = catstrs_direct(buf, "#", (is_int_vector(vect)) ? "i" : "r", "()", NULL); port_write_string(port)(sc, buf, plen, port); return(-1); @@ -27697,7 +27835,7 @@ static int32_t print_vector_length(s7_scheme *sc, s7_pointer vect, s7_pointer po { if (vector_rank(vect) > 1) { - plen = catstrs_direct(buf, "#", (is_int_vector(vect)) ? "i" : "r", pos_int_to_str_direct(vector_ndims(vect)), "d(...)", NULL); + plen = catstrs_direct(buf, "#", (is_int_vector(vect)) ? "i" : "r", pos_int_to_str_direct(sc, vector_ndims(vect)), "d(...)", NULL); port_write_string(port)(sc, buf, plen, port); } else @@ -27743,7 +27881,7 @@ static void int_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, if (i == vlen) { make_vector_to_port(sc, vect, port); - p = integer_to_string(int_vector_element(vect, 0), &plen); + p = integer_to_string(sc, int_vector_element(vect, 0), &plen); port_write_string(port)(sc, p, plen, port); port_write_character(port)(sc, ')', port); return; @@ -27755,11 +27893,11 @@ static void int_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, port_write_string(port)(sc, "#i(", 3, port); if (!is_string_port(port)) { - p = integer_to_string(int_vector_element(vect, 0), &plen); + p = integer_to_string(sc, int_vector_element(vect, 0), &plen); port_write_string(port)(sc, p, plen, port); for (i = 1; i < len; i++) { - plen = catstrs_direct(buf, " ", integer_to_string_no_length(int_vector_element(vect, i)), NULL); + plen = catstrs_direct(buf, " ", integer_to_string_no_length(sc, int_vector_element(vect, i)), NULL); port_write_string(port)(sc, buf, plen, port); } } @@ -27774,22 +27912,22 @@ static void int_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, if (new_len >= next_len) { - resize_port_data(port, port_data_size(port) * 2); + resize_port_data(sc, port, port_data_size(port) * 2); next_len = port_data_size(port) - 128; dbuf = port_data(port); } - p = integer_to_string(int_vector_element(vect, 0), &plen); + p = integer_to_string(sc, int_vector_element(vect, 0), &plen); memcpy((void *)(dbuf + new_len), (void *)p, plen); new_len += plen; for (i = 1; i < len; i++) { if (new_len >= next_len) { - resize_port_data(port, port_data_size(port) * 2); + resize_port_data(sc, port, port_data_size(port) * 2); next_len = port_data_size(port) - 128; dbuf = port_data(port); } - plen = catstrs_direct(buf, " ", integer_to_string_no_length(int_vector_element(vect, i)), NULL); + plen = catstrs_direct(buf, " ", integer_to_string_no_length(sc, int_vector_element(vect, i)), NULL); memcpy((void *)(dbuf + new_len), (void *)buf, plen); new_len += plen; } @@ -27805,7 +27943,7 @@ static void int_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, /* multidimensional case */ { bool last = false; - plen = catstrs_direct(buf, "#i", pos_int_to_str_direct(vector_ndims(vect)), "d", NULL); + plen = catstrs_direct(buf, "#i", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", NULL); port_write_string(port)(sc, buf, plen, port); multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, P_DISPLAY, NULL); } @@ -27870,7 +28008,7 @@ static void float_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port /* multidimensional case */ { bool last = false; - plen = catstrs_direct(buf, "#r", pos_int_to_str_direct(vector_ndims(vect)), "d", NULL); + plen = catstrs_direct(buf, "#r", pos_int_to_str_direct(sc, vector_ndims(vect)), "d", NULL); port_write_string(port)(sc, buf, plen, port); multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, P_DISPLAY, NULL); } @@ -27925,7 +28063,7 @@ static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, if (i == vlen) { char buf[128]; - plen = catstrs_direct(buf, "(make-byte-vector ", pos_int_to_str_direct(vlen), " ", pos_int_to_str_direct_1(c), ")", NULL); + plen = catstrs_direct(buf, "(make-byte-vector ", pos_int_to_str_direct(sc, vlen), " ", pos_int_to_str_direct_1(sc, c), ")", NULL); port_write_string(port)(sc, buf, plen, port); return; } @@ -27934,10 +28072,10 @@ static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, port_write_string(port)(sc, "#u8(", 4, port); for (i = 0; i < len - 1; i++) { - p = pos_int_to_str((int32_t)(byte_vector_bytes(vect)[i]), &nlen, ' '); + p = pos_int_to_str(sc, (int32_t)(byte_vector_bytes(vect)[i]), &nlen, ' '); port_write_string(port)(sc, p, nlen - 1, port); } - p = pos_int_to_str((int32_t)(byte_vector_bytes(vect)[i]), &nlen, (too_long) ? '\0' : ')'); + p = pos_int_to_str(sc, (int32_t)(byte_vector_bytes(vect)[i]), &nlen, (too_long) ? '\0' : ')'); port_write_string(port)(sc, p, nlen - 1, port); if (too_long) @@ -27970,7 +28108,7 @@ static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_w int32_t nlen; s7_pointer c; c = chars[(int32_t)((uint8_t)(buf[0]))]; - nlen = catstrs_direct(buf, "(make-string ", pos_int_to_str_direct(string_length(obj)), " ", NULL); + nlen = catstrs_direct(buf, "(make-string ", pos_int_to_str_direct(sc, string_length(obj)), " ", NULL); port_write_string(port)(sc, buf, nlen, port); port_write_string(port)(sc, character_name(c), character_name_length(c), port); /* (string-ref (eval-string (object->string (make-string 14766 (integer->char 255)) :readable)) 0) */ @@ -28066,7 +28204,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri { char buf[128]; int32_t plen; - plen = catstrs_direct(buf, "<", pos_int_to_str_direct(href), ">", NULL); + plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", NULL); port_write_string(port)(sc, buf, plen, port); return; } @@ -28147,7 +28285,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri else { if (lst_ref < 0) lst_ref = -lst_ref; - catstrs_direct(lst_name, "<", pos_int_to_str_direct(lst_ref), ">", NULL); + catstrs_direct(lst_name, "<", pos_int_to_str_direct(sc, lst_ref), ">", NULL); port_write_string(port)(sc, "list", 4, port); /* '(' above */ } @@ -28179,7 +28317,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri int32_t lref; if (i == 0) plen = catstrs_direct(buf, " (set-car! ", lst_name, " ", NULL); - else plen = catstrs_direct(buf, " (set! (", lst_name, " ", pos_int_to_str_direct(i), ") ", NULL); + else plen = catstrs_direct(buf, " (set! (", lst_name, " ", pos_int_to_str_direct(sc, i), ") ", NULL); port_write_string(local_port)(sc, buf, plen, local_port); lref = peek_shared_ref(ci, car(x)); if (lref == 0) @@ -28187,7 +28325,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri else { if (lref < 0) lref = -lref; - plen = catstrs_direct(buf, "<", pos_int_to_str_direct(lref), ">", NULL); + plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, lref), ">", NULL); port_write_string(local_port)(sc, buf, plen, local_port); } port_write_string(local_port)(sc, ")\n", 2, local_port); @@ -28199,14 +28337,14 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri ref = peek_shared_ref(ci, cdr(x)); if (ref < 0) ref = -ref; if (i == 0) - plen = catstrs_direct(buf, (lst_local) ? " " : " ", "(set-cdr! ", lst_name, " <", pos_int_to_str_direct(ref), ">)\n", NULL); + plen = catstrs_direct(buf, (lst_local) ? " " : " ", "(set-cdr! ", lst_name, " <", pos_int_to_str_direct(sc, ref), ">)\n", NULL); else { if (i == 1) - plen = catstrs_direct(buf, (lst_local) ? " " : " ", "(set-cdr! (cdr ", lst_name, ") <", pos_int_to_str_direct(ref), ">)\n", NULL); + plen = catstrs_direct(buf, (lst_local) ? " " : " ", "(set-cdr! (cdr ", lst_name, ") <", pos_int_to_str_direct(sc, ref), ">)\n", NULL); else plen = catstrs_direct(buf, (lst_local) ? " " : " ", - "(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct_1(i), - ") <", pos_int_to_str_direct(ref), ">)\n", NULL); + "(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct_1(sc, i), + ") <", pos_int_to_str_direct(sc, ref), ">)\n", NULL); } port_write_string(local_port)(sc, buf, plen, local_port); break; @@ -28220,7 +28358,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri { if (true_len == -2) plen = catstrs_direct(buf, (lst_local) ? " " : " ", "(set-cdr! (cdr ", lst_name, ") ", NULL); - else plen = catstrs_direct(buf, "(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct(len - 2), ") ", NULL); + else plen = catstrs_direct(buf, "(set-cdr! (list-tail ", lst_name, " ", pos_int_to_str_direct(sc, len - 2), ") ", NULL); } port_write_string(local_port)(sc, buf, plen, local_port); object_to_port_with_circle_check(sc, x, local_port, use_write, ci); @@ -28277,7 +28415,7 @@ static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_wri if (port_position(port) >= sc->objstr_max_len) return; if (port_position(port) >= port_data_size(port)) - resize_port_data(port, port_data_size(port) * 2); + resize_port_data(sc, port, port_data_size(port) * 2); port_data(port)[port_position(port)++] = (uint8_t)' '; } } @@ -28319,11 +28457,14 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, * (let ((ht (hash-table '(a . 1)))) (hash-table-set! ht 'b ht)) * * since equal? does not care about the hash-table lengths, we can ignore that complication in the :readable case + * there's no way to make a truly :readable version of a weak hash-table (or a normal hash-table that uses eq? with pairs, for example) */ len = hash_table_entries(hash); if (len == 0) { - port_write_string(port)(sc, "(hash-table)", 12, port); + if ((is_weak_hash_table(hash)) && (use_write == P_READABLE)) + port_write_string(port)(sc, "(make-weak-hash-table)", 22, port); + else port_write_string(port)(sc, "(hash-table)", 12, port); return; } @@ -28354,7 +28495,7 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, { char buf[128]; int32_t plen; - plen = catstrs_direct(buf, "<", pos_int_to_str_direct(href), ">", NULL); + plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", NULL); port_write_string(port)(sc, buf, plen, port); return; } @@ -28379,6 +28520,7 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, /* (let ((<1> (make-hash-table <default-size> morally-equal?))) * and then fill all fields in cycle_port * hash_table_checker_locked? + * also weak hash (let ((h (make-weak-hash-table))) then (set! (h key) val)? */ int32_t href; @@ -28400,13 +28542,13 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, int32_t eref, kref, plen; eref = peek_shared_ref(ci, val); kref = peek_shared_ref(ci, key); - plen = catstrs_direct(buf, "(set! (<", pos_int_to_str_direct(href), "> ", NULL); + plen = catstrs_direct(buf, "(set! (<", pos_int_to_str_direct(sc, href), "> ", NULL); port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port); if (kref != 0) { if (kref < 0) kref = -kref; - plen = catstrs_direct(buf, "<", pos_int_to_str_direct(kref), ">", NULL); + plen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, kref), ">", NULL); port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port); } else object_to_port(sc, key, ci->cycle_port, P_READABLE, ci); @@ -28414,7 +28556,7 @@ static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, if (eref != 0) { if (eref < 0) eref = -eref; - plen = catstrs_direct(buf, ") <", pos_int_to_str_direct(eref), ">)\n", NULL); + plen = catstrs_direct(buf, ") <", pos_int_to_str_direct(sc, eref), ">)\n", NULL); port_write_string(ci->cycle_port)(sc, buf, plen, ci->cycle_port); } else @@ -28512,7 +28654,7 @@ static void slot_list_to_port_with_cycle(s7_scheme *sc, s7_pointer obj, s7_point int32_t symref, len; port_write_string(port)(sc, " #f", 3, port); - len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(-peek_shared_ref(ci, obj)), "> ", NULL); + len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(sc, -peek_shared_ref(ci, obj)), "> ", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); symbol_to_port(sc, sym, ci->cycle_port, P_KEY, ci); @@ -28520,7 +28662,7 @@ static void slot_list_to_port_with_cycle(s7_scheme *sc, s7_pointer obj, s7_point if (symref != 0) { if (symref < 0) symref = -symref; - len = catstrs_direct(buf, ") <", pos_int_to_str_direct(symref), ">)\n", NULL); + len = catstrs_direct(buf, ") <", pos_int_to_str_direct(sc, symref), ">)\n", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); } else @@ -28594,7 +28736,7 @@ static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ { char buf[128]; int32_t len; - len = catstrs_direct(buf, "<", pos_int_to_str_direct(lref), ">", NULL); + len = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, lref), ">", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); return; } @@ -28604,7 +28746,7 @@ static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ { char buf[128]; int32_t len; - len = catstrs_direct(buf, " (set! (outlet <", pos_int_to_str_direct(-peek_shared_ref(ci, obj)), ">) ", NULL); + len = catstrs_direct(buf, " (set! (outlet <", pos_int_to_str_direct(sc, -peek_shared_ref(ci, obj)), ">) ", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); let_to_port(sc, outlet(obj), ci->cycle_port, use_write, ci); port_write_string(ci->cycle_port)(sc, ")\n", 2, ci->cycle_port); @@ -28625,7 +28767,7 @@ static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ { char buf[128]; int32_t len; - len = catstrs_direct(buf, "<", pos_int_to_str_direct(-peek_shared_ref(ci, outlet(obj))), ">", NULL); + len = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, -peek_shared_ref(ci, outlet(obj))), ">", NULL); port_write_string(port)(sc, buf, len, port); } else let_to_port(sc, outlet(obj), port, use_write, ci); @@ -29022,9 +29164,9 @@ bool s7_is_valid(s7_scheme *sc, s7_pointer arg) #endif result = ((unchecked_type(arg) > T_FREE) && (unchecked_type(arg) < NUM_TYPES) && - (arg->hloc >= not_heap) && - ((arg->hloc < 0) || - ((arg->hloc < sc->heap_size) && (sc->heap[arg->hloc] == arg)))); + (heap_location(arg) >= sc->not_heap) && + ((heap_location(arg) < 0) || + ((heap_location(arg) < sc->heap_size) && (sc->heap[heap_location(arg)] == arg)))); #if TRAP_SEGFAULT signal(SIGSEGV, old_segv); @@ -29049,18 +29191,19 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S full_typ = typeflag(obj); /* if debugging all of these bits are being watched, so we need to access them directly */ - snprintf(buf, 512, "type: %d (%s), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", + snprintf(buf, 512, "type: %d (%s), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", typ, type_name(sc, obj, NO_ARTICLE), optimize_op(obj), full_typ, /* bit 0 (the first 8 bits are easy...) */ - ((full_typ & T_KEYWORD) != 0) ? ((is_symbol(obj)) ? " keyword" : " ?0?") : "", + ((full_typ & T_MULTIFORM) != 0) ? ((is_any_closure(obj)) ? " multiform" : " ?0?") : "", /* bit 1 */ ((full_typ & T_SYNTACTIC) != 0) ? (((is_pair(obj)) || (is_syntax(obj)) || (is_symbol(obj))) ? " syntactic" : " ?1?") : "", /* bit 2 */ - ((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) ? ((is_pair(obj)) ? " simple-args|in-use" : " ?2?") : "", - + ((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) ? ((is_pair(obj)) ? " simple-args|in-use" : + ((is_any_closure(obj)) ? " one-form" : + " ?2?")) : "", /* bit 3 */ ((full_typ & T_OPTIMIZED) != 0) ? ((is_c_function(obj)) ? " scope-safe" : ((is_pair(obj)) ? " optimized" : @@ -29101,7 +29244,7 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S /* bit 15 */ ((full_typ & T_UNSAFE) != 0) ? ((is_symbol(obj)) ? " clean-symbol" : ((is_slot(obj)) ? " has-stepper" : - ((is_pair(obj)) ? " unsafe|no-float-opt" : + ((is_pair(obj)) ? " unsafely-opt|no-float-opt" : " ?15?"))) : "", /* bit 16 */ ((full_typ & T_IMMUTABLE) != 0) ? " immutable" : "", @@ -29125,7 +29268,8 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S ((is_c_function(obj)) ? " maybe-safe" : ((is_number(obj)) ? " print-name" : ((is_pair(obj)) ? " direct_x_opt" : - " ?19?"))))) : "", + ((is_hash_table(obj)) ? " weak-hash" : + " ?19?")))))) : "", /* bit 20, for c_function case see sc->apply */ ((full_typ & T_COPY_ARGS) != 0) ? (((is_any_macro(obj)) || (is_any_closure(obj)) || (is_c_function(obj))) ? " copy-args" : " ?20?") : "", @@ -29135,32 +29279,35 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj) /* used outside S ((is_string(obj)) ? " documented-symbol" : ((is_hash_table(obj)) ? " hash-chosen" : ((is_pair(obj)) ? " dotted" : - " ?21?"))))) : "", + ((s7_is_vector(obj)) ? " subvector" : + " ?21?")))))) : "", /* bit 22 */ ((full_typ & T_HAS_METHODS) != 0) ? " has-methods" : "", /* bit 23 */ ((full_typ & T_ITER_OK) != 0) ? ((is_iterator(obj)) ? " iter-ok" : " ?23?") : "", - /* bit 24 */ + /* bit 24+16 */ ((full_typ & T_SYMCONS) != 0) ? ((is_symbol(obj)) ? " possibly-constant" : ((is_procedure(obj)) ? " has-let-arg" : " ?24?")) : "", - /* bit 25 */ + /* bit 25+16 */ ((full_typ & T_S7_LET_FIELD) != 0) ? ((is_symbol(obj)) ? " s7-let-field" : ((is_let(obj)) ? " has-let-file" : - " ?25?")) : "", - /* bit 26 */ + ((is_pair(obj)) ? " has-oplist" : + " ?25?"))) : "", + /* bit 26+16 */ ((full_typ & T_DEFINER) != 0) ? ((is_symbol(obj)) ? " definer" : " ?26?") : "", - /* bit 27 */ + /* bit 27+16 */ ((full_typ & T_RECUR) != 0) ? ((is_slot(obj)) ? " recur" : ((is_pair(obj)) ? " tree-collected" : " ?27?")) : "", - /* bit 28 */ + /* bit 28+16 */ ((full_typ & T_VERY_SAFE_CLOSURE) != 0) ? " very-safe-closure" : "", - /* bit 29 */ + /* bit 29+16 */ ((full_typ & T_CYCLIC) != 0) ? " cyclic" : "", - /* bit 30 */ + /* bit 30+16 */ ((full_typ & T_CYCLIC_SET) != 0) ? " cyclic-set" : "", - + /* bit 31+16 */ + ((full_typ & T_KEYWORD) != 0) ? ((is_symbol(obj)) ? " keyword" : " ?31?") : "", ((full_typ & UNUSED_BITS) != 0) ? " unused bits set?" : "", /* bit 55 */ @@ -29175,17 +29322,18 @@ static bool has_odd_bits(s7_pointer obj) full_typ = typeflag(obj); if ((full_typ & UNUSED_BITS) != 0) return(true); + if (((full_typ & T_MULTIFORM) != 0) && (!is_any_closure(obj))) return(true); if (((full_typ & T_KEYWORD) != 0) && (!is_symbol(obj))) return(true); if (((full_typ & T_RECUR) != 0) && ((!is_slot(obj)) && (!is_pair(obj)))) return(true); if (((full_typ & T_SYNTACTIC) != 0) && (!is_syntax(obj)) && (!is_pair(obj)) && (!is_symbol(obj))) return(true); - if (((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) && (!is_pair(obj))) return(true); + if (((full_typ & T_SIMPLE_ARG_DEFAULTS) != 0) && (!is_pair(obj)) && (!is_any_closure(obj))) return(true); if (((full_typ & T_OPTIMIZED) != 0) && (!is_c_function(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_SAFE_CLOSURE) != 0) && (!is_any_closure(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_EXPANSION) != 0) && (!is_symbol(obj)) && (!is_macro(obj))) return(true); if (((full_typ & T_MULTIPLE_VALUE) != 0) && (!is_symbol(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_GLOBAL) != 0) && (!is_pair(obj)) && (!is_symbol(obj)) && (!is_syntax(obj))) return(true); if (((full_typ & T_ITER_OK) != 0) && (!is_iterator(obj))) return(true); - if (((full_typ & T_S7_LET_FIELD) != 0) && (!is_symbol(obj)) && (!is_let(obj))) return(true); + if (((full_typ & T_S7_LET_FIELD) != 0) && (!is_symbol(obj)) && (!is_let(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_DEFINER) != 0) && (!is_symbol(obj))) return(true); if (((full_typ & T_SYMCONS) != 0) && (!is_symbol(obj)) && (!is_procedure(obj))) return(true); if (((full_typ & T_LOCAL) != 0) && (!is_symbol(obj))) return(true); @@ -29193,7 +29341,7 @@ static bool has_odd_bits(s7_pointer obj) if (((full_typ & T_UNSAFE) != 0) && (!is_symbol(obj)) && (!is_slot(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_VERY_SAFE_CLOSURE) != 0) && (!is_pair(obj)) && (!is_any_closure(obj))) return(true); if (((full_typ & T_SAFE_STEPPER) != 0) && - (!is_let(obj)) && (!is_slot(obj)) && (!is_c_function(obj)) && (!is_number(obj)) && (!is_pair(obj))) + (!is_let(obj)) && (!is_slot(obj)) && (!is_c_function(obj)) && (!is_number(obj)) && (!is_pair(obj)) && (!is_hash_table(obj))) return(true); if (((full_typ & T_SETTER) != 0) && (!is_symbol(obj)) && (!is_pair(obj)) && (!is_closure(obj)) && (!is_hash_table(obj)) && (!is_let(obj))) @@ -29206,7 +29354,7 @@ static bool has_odd_bits(s7_pointer obj) (!is_slot(obj)) && (!is_let(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_GENSYM) != 0) && - (!is_let(obj)) && (!is_symbol(obj)) && (!is_string(obj)) && (!is_hash_table(obj)) && (!is_pair(obj))) + (!is_let(obj)) && (!is_symbol(obj)) && (!is_string(obj)) && (!is_hash_table(obj)) && (!is_pair(obj)) && (!s7_is_vector(obj))) return(true); return(false); } @@ -29257,10 +29405,8 @@ static char *safe_object_to_string(s7_pointer p) uint8_t typ; char *buf; typ = unchecked_type(p); - if ((typ > T_FREE) && (typ < NUM_TYPES)) - return(string_value(s7_object_to_string(cur_sc, p, false))); buf = (char *)malloc(128 * sizeof(char)); - catstrs_direct(buf, "type=", pos_int_to_str_direct(typ), NULL); + snprintf(buf, 128, "type: %d", typ); return(buf); } @@ -29529,7 +29675,6 @@ static const char *opt2_role_name(uint32_t role) if (role == F_PAIR) return("opt_pair2"); if (role == F_CON) return("opt_con2"); if (role == F_LAMBDA) return("opt_lambda2"); - if (role == F_ID) return("opt_id2"); return("unknown"); } @@ -29549,7 +29694,7 @@ static char* show_debugger_bits(uint32_t bits) { char *bits_str; bits_str = (char *)malloc(512 * sizeof(char)); - snprintf(bits_str, 512, " %s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", + snprintf(bits_str, 512, " %s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", ((bits & E_SET) != 0) ? " e-set" : "", ((bits & E_FAST) != 0) ? " opt_fast" : "", ((bits & E_CFUNC) != 0) ? " opt_cfunc" : "", @@ -29569,7 +29714,6 @@ static char* show_debugger_bits(uint32_t bits) ((bits & F_CON) != 0) ? " opt_con2" : "", ((bits & F_CALL) != 0) ? " c_call(ee)" : "", ((bits & F_LAMBDA) != 0) ? " opt_lambda2" : "", - ((bits & F_ID) != 0) ? " opt_id2" : "", ((bits & G_SET) != 0) ? " g-set" : "", ((bits & G_ARGLEN) != 0) ? " arglist_length" : "", ((bits & G_SYM) != 0) ? " opt_sym3" : "", @@ -29637,7 +29781,7 @@ static void show_opt2_bits(s7_pointer p, const char *func, int32_t line, uint32_ { char *bits; bits = show_debugger_bits(p->debugger_bits); - fprintf(stderr, "%s%s[%d]: opt2: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x%s%s%s%s%s%s%s%s%s%s%s\n", + fprintf(stderr, "%s%s[%d]: opt2: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x%s%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line, p, p->object.cons.opt2, opt2_role_name(role), @@ -29650,43 +29794,32 @@ static void show_opt2_bits(s7_pointer p, const char *func, int32_t line, uint32_ ((role & F_CON) != 0) ? " con" : "", ((role & F_CALL) != 0) ? " call" : "", ((role & F_LAMBDA) != 0) ? " lambda" : "", - ((role & F_ID) != 0) ? " id" : "", ((role & S_NAME) != 0) ? " raw-name" : "", UNBOLD_TEXT); free(bits); } -static s7_pointer opt2_1(s7_pointer p, uint32_t role, const char *func, int32_t line) +static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, uint32_t role, const char *func, int32_t line) { if ((!opt2_is_set(p)) || (!opt2_role_matches(p, role))) { show_opt2_bits(p, func, line, role); - fprintf(stderr, "p: %s\n", string_value(s7_object_to_string(cur_sc, p, false))); + fprintf(stderr, "p: %s\n", string_value(s7_object_to_string(sc, p, false))); if (stop_at_error) abort(); } return(p->object.cons.opt2); } -static void set_opt2_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) +static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) { if ((role == F_CALL) && (x == NULL)) /* this happens apparently innocuously in check_and|or */ { if ((safe_strcmp(func, "check_and") != 0) && (safe_strcmp(func, "check_or") != 0)) - fprintf(stderr, "%s[%d]: set c_call for %s to null\n", func, line, string_value(object_to_truncated_string(cur_sc, p, 80))); + fprintf(stderr, "%s[%d]: set c_call for %s to null\n", func, line, string_value(object_to_truncated_string(sc, p, 80))); } -#if 0 - if ((opt2_is_set(p)) && - (opt2_role_matches(p, F_CALL))) - { - if ((role == F_CALL) && - (x == p->object.cons.opt2)) - fprintf(stderr, "%s[%d]: rewrite opt2 c_call: %s\n", func, line, string_value(object_to_truncated_string(cur_sc, p, 80))); - else fprintf(stderr, "%s[%d]: clobber opt2 c_call: %s\n", func, line, string_value(object_to_truncated_string(cur_sc, p, 80))); - } -#endif p->object.cons.opt2 = x; p->opt2_func1 = p->opt2_func2; p->opt2_line1 = p->opt2_line2; @@ -29764,10 +29897,10 @@ static void set_s_line_1(s7_pointer p, uint32_t x, const char *func, int32_t lin set_opt3_is_set(p); } -static void set_s_file_1(s7_pointer p, uint32_t x, const char *func, int32_t line) +static void set_s_file_1(s7_scheme *sc, s7_pointer p, uint32_t x, const char *func, int32_t line) { p->object.sym_cons.file = x; - if ((int32_t)x > cur_sc->file_names_top) + if ((int32_t)x > sc->file_names_top) { fprintf(stderr, "%s[%d]: pair_set_file_name to %u?\n", func, line, x); if (stop_at_error) abort(); @@ -29820,7 +29953,7 @@ static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port safe_strlen(current_bits) + safe_strlen(allocated_bits) + safe_strlen(previous_bits) + safe_strlen(obj->previous_alloc_func) + safe_strlen(obj->current_alloc_func) + 512; - b = mallocate(len); + b = mallocate(sc, len); str = (char *)block_data(b); nlen = snprintf(str, len, "\n<%s %s,\n current: %s[%d] %s,\n previous: %s[%d] %s\n hloc: %" print_s7_int " (%d uses), free: %s[%d], alloc: %s[%d]>", @@ -29833,7 +29966,7 @@ static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port if (is_null(port)) fprintf(stderr, "%p: %s\n", obj, str); else port_write_string(port)(sc, str, nlen, port); - liberate(b); + liberate(sc, b); } static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int32_t line, const char *func) @@ -29913,7 +30046,7 @@ static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use ci->init_loc = s7_gc_protect(sc, ci->init_port); } port_write_string(port)(sc, "#f", 2, port); - nlen = catstrs_direct(buf, " (set! <", pos_int_to_str_direct(iter_ref), "> (make-iterator ", NULL); + nlen = catstrs_direct(buf, " (set! <", pos_int_to_str_direct(sc, iter_ref), "> (make-iterator ", NULL); port_write_string(ci->init_port)(sc, buf, nlen, ci->init_port); flip_ref(ci, seq); @@ -29978,7 +30111,7 @@ static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use int32_t nlen; char str[128]; nlen = catstrs_direct(str, "))) (do ((i 0 (+ i 1))) ((= i ", - pos_int_to_str_direct(iterator_position(obj)), + pos_int_to_str_direct(sc, iterator_position(obj)), ") iter) (iter)))", NULL); port_write_string(port)(sc, str, nlen, port); } @@ -30003,7 +30136,7 @@ static void baffle_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_w { int32_t nlen; char buf[64]; - nlen = catstrs_direct(buf, "#<baffle: ", pos_int_to_str_direct(baffle_key(obj)), NULL); + nlen = catstrs_direct(buf, "#<baffle: ", pos_int_to_str_direct(sc, baffle_key(obj)), NULL); port_write_string(port)(sc, buf, nlen, port); } @@ -30028,24 +30161,24 @@ static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, us ci->init_port = s7_open_output_string(sc); ci->init_loc = s7_gc_protect(sc, ci->init_port); } - nlen = snprintf(buf, 128, " (set! <%d> (c-pointer %" print_pointer, -peek_shared_ref(ci, obj), (intptr_t)raw_pointer(obj)); + nlen = snprintf(buf, 128, " (set! <%d> (c-pointer %" print_pointer, -peek_shared_ref(ci, obj), (intptr_t)c_pointer(obj)); port_write_string(ci->init_port)(sc, buf, nlen, ci->init_port); - if ((raw_pointer_type(obj) != sc->F) || - (raw_pointer_info(obj) != sc->F)) + if ((c_pointer_type(obj) != sc->F) || + (c_pointer_info(obj) != sc->F)) { - flip_ref(ci, raw_pointer_type(obj)); + flip_ref(ci, c_pointer_type(obj)); port_write_character(ci->init_port)(sc, ' ', ci->init_port); - object_to_port_with_circle_check(sc, raw_pointer_type(obj), ci->init_port, use_write, ci); + object_to_port_with_circle_check(sc, c_pointer_type(obj), ci->init_port, use_write, ci); - flip_ref(ci, raw_pointer_type(obj)); - flip_ref(ci, raw_pointer_info(obj)); + flip_ref(ci, c_pointer_type(obj)); + flip_ref(ci, c_pointer_info(obj)); port_write_character(ci->init_port)(sc, ' ', ci->init_port); - object_to_port_with_circle_check(sc, raw_pointer_info(obj), ci->init_port, use_write, ci); + object_to_port_with_circle_check(sc, c_pointer_info(obj), ci->init_port, use_write, ci); - flip_ref(ci, raw_pointer_info(obj)); + flip_ref(ci, c_pointer_info(obj)); } port_write_string(ci->init_port)(sc, "))\n", 3, ci->init_port); set_cyclic_set(obj); @@ -30053,24 +30186,24 @@ static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, us } else { - nlen = snprintf(buf, 128, "(c-pointer %" print_pointer, (intptr_t)raw_pointer(obj)); + nlen = snprintf(buf, 128, "(c-pointer %" print_pointer, (intptr_t)c_pointer(obj)); port_write_string(port)(sc, buf, nlen, port); - if ((raw_pointer_type(obj) != sc->F) || - (raw_pointer_info(obj) != sc->F)) + if ((c_pointer_type(obj) != sc->F) || + (c_pointer_info(obj) != sc->F)) { port_write_character(port)(sc, ' ', port); - object_to_port_with_circle_check(sc, raw_pointer_type(obj), port, use_write, ci); + object_to_port_with_circle_check(sc, c_pointer_type(obj), port, use_write, ci); port_write_character(port)(sc, ' ', port); - object_to_port_with_circle_check(sc, raw_pointer_info(obj), port, use_write, ci); + object_to_port_with_circle_check(sc, c_pointer_info(obj), port, use_write, ci); } port_write_character(port)(sc, ')', port); } } else { - if (is_symbol(raw_pointer_type(obj))) - nlen = snprintf(buf, 128, "#<%s %p>", symbol_name(raw_pointer_type(obj)), raw_pointer(obj)); - else nlen = snprintf(buf, 128, "#<c_pointer %p>", raw_pointer(obj)); + if (is_symbol(c_pointer_type(obj))) + nlen = snprintf(buf, 128, "#<%s %p>", symbol_name(c_pointer_type(obj)), c_pointer(obj)); + else nlen = snprintf(buf, 128, "#<c_pointer %p>", c_pointer(obj)); port_write_string(port)(sc, buf, nlen, port); } } @@ -30102,13 +30235,13 @@ static void display_any(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_writ s7_int nlen, len; tmp = describe_type_bits(sc, obj); len = 32 + safe_strlen(tmp); - b = mallocate(len); + b = mallocate(sc, len); str = (char *)block_data(b); if (is_free(obj)) nlen = catstrs_direct(str, "<free cell! ", tmp, ">", NULL); else nlen = catstrs_direct(str, "<unknown object! ", tmp, ">", NULL); port_write_string(port)(sc, str, nlen, port); - liberate(b); + liberate(sc, b); } #endif } @@ -30171,7 +30304,7 @@ static void integer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_ { s7_int nlen; char *str; - str = integer_to_string(integer(obj), &nlen); + str = integer_to_string(sc, integer(obj), &nlen); set_print_name(obj, str, nlen); port_write_string(port)(sc, str, nlen, port); } @@ -30186,7 +30319,7 @@ static void number_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_w s7_int nlen; char *str; nlen = 0; - str = number_to_string_base_10(obj, 0, sc->float_format_precision, 'g', &nlen, use_write); /* was 14 */ + str = number_to_string_base_10(sc, obj, 0, sc->float_format_precision, 'g', &nlen, use_write); /* was 14 */ if ((nlen < PRINT_NAME_SIZE) && (str[0] != 'n') && (str[0] != 'i') && ((!(is_t_complex(obj))) || @@ -30344,7 +30477,7 @@ static void c_object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use { int32_t nlen; char buf[128]; - nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(href), ">", NULL); + nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, href), ">", NULL); port_write_string(port)(sc, buf, nlen, port); return; } @@ -30361,14 +30494,14 @@ static void c_object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use int32_t symref, len; port_write_string(port)(sc, " #f", 3, port); - len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(href), "> ", pos_int_to_str_direct_1(i), ") ", NULL); + len = catstrs_direct(buf, " (set! (<", pos_int_to_str_direct(sc, href), "> ", pos_int_to_str_direct_1(sc, i), ") ", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); symref = peek_shared_ref(ci, val); if (symref != 0) { if (symref < 0) symref = -symref; - len = catstrs_direct(buf, "<", pos_int_to_str_direct(symref), ">)\n", NULL); + len = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, symref), ">)\n", NULL); port_write_string(ci->cycle_port)(sc, buf, len, ci->cycle_port); } else @@ -30499,7 +30632,7 @@ static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_ if (ci->defined[ref]) { flip_ref(ci, vr); - nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(ref), ">", NULL); + nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, ref), ">", NULL); port_write_string(port)(sc, buf, nlen, port); return; } @@ -30508,7 +30641,7 @@ static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_ else { /* "normal" printout involving #n= and #n# */ - p = pos_int_to_str((s7_int)ref, &len, '='); + p = pos_int_to_str(sc, (s7_int)ref, &len, '='); *--p = '#'; port_write_string(port)(sc, p, len, port); object_to_port(sc, vr, port, NOT_P_DISPLAY(use_write), ci); @@ -30519,12 +30652,12 @@ static void object_to_port_with_circle_check_1(s7_scheme *sc, s7_pointer vr, s7_ if (use_write == P_READABLE) { /* if ((!ci->defined[-ref]) && (port != ci->cycle_port)) fprintf(stderr, "%s[%d]: not yet defined\n", __func__, __LINE__); */ - nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(-ref), ">", NULL); + nlen = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, -ref), ">", NULL); port_write_string(port)(sc, buf, nlen, port); } else { - p = pos_int_to_str((s7_int)(-ref), &len, '#'); + p = pos_int_to_str(sc, (s7_int)(-ref), &len, '#'); *--p = '#'; port_write_string(port)(sc, p, len, port); } @@ -30546,7 +30679,7 @@ static s7_pointer cyclic_out(s7_scheme *sc, s7_pointer obj, s7_pointer port, sha { ref = peek_shared_ref(ci, ci->objs[i]); /* refs may be in any order */ if (ref < 0) {ref = -ref; flip_ref(ci, ci->objs[i]);} - len = catstrs_direct(buf, (i == 0) ? "(<" : "\n (<", pos_int_to_str_direct(ref), "> ", NULL); + len = catstrs_direct(buf, (i == 0) ? "(<" : "\n (<", pos_int_to_str_direct(sc, ref), "> ", NULL); port_write_string(port)(sc, buf, len, port); ci->defined[ref] = false; object_to_port_with_circle_check(sc, ci->objs[i], port, P_READABLE, ci); @@ -30578,7 +30711,7 @@ static s7_pointer cyclic_out(s7_scheme *sc, s7_pointer obj, s7_pointer port, sha object_to_port_with_circle_check(sc, obj, port, P_READABLE, ci); else { - len = catstrs_direct(buf, "<", pos_int_to_str_direct((ref < 0) ? -ref : ref), ">", NULL); + len = catstrs_direct(buf, "<", pos_int_to_str_direct(sc, (ref < 0) ? -ref : ref), ">", NULL); port_write_string(port)(sc, buf, len, port); } @@ -30624,35 +30757,32 @@ static inline s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer st return(obj); } - -static s7_pointer format_ports = NULL; - -static s7_pointer open_format_port(void) +static s7_pointer open_format_port(s7_scheme *sc) { s7_pointer x; s7_int len; block_t *block, *b; - if (format_ports) + if (sc->format_ports) { - x = format_ports; - format_ports = (s7_pointer)(port_next(x)); + x = sc->format_ports; + sc->format_ports = (s7_pointer)(port_next(x)); port_position(x) = 0; port_data(x)[0] = '\0'; return(x); } len = FORMAT_PORT_LENGTH; - x = alloc_pointer(); + x = alloc_pointer(sc); set_type(x, T_OUTPUT_PORT); - b = mallocate_port(); + b = mallocate_port(sc); port_block(x) = b; port_port(x) = (port_t *)block_data(b); port_type(x) = STRING_PORT; port_set_closed(x, false); port_data_size(x) = len; port_next(x) = NULL; - block = mallocate(len); + block = mallocate(sc, len); port_data(x) = (uint8_t *)(block_data(block)); port_data_block(x) = block; port_data(x)[0] = '\0'; @@ -30666,10 +30796,10 @@ static s7_pointer open_format_port(void) return(x); } -static void close_format_port(s7_pointer port) +static void close_format_port(s7_scheme *sc, s7_pointer port) { - port_next(port) = (struct block_t *)format_ports; - format_ports = port; + port_next(port) = (struct block_t *)(sc->format_ports); + sc->format_ports = port; } @@ -30684,43 +30814,46 @@ char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj) (!s7_is_valid(sc, obj))) fprintf(stderr, "bad arg to %s: %p\n", __func__, obj); - strport = open_format_port(); + strport = open_format_port(sc); object_out(sc, obj, strport, P_WRITE); len = port_position(strport); if (len == 0) return(NULL); str = (char *)malloc((len + 1) * sizeof(char)); memcpy((void *)str, (void *)port_data(strport), len); str[len] = '\0'; - close_format_port(strport); + close_format_port(sc, strport); return(str); } +static inline void restore_format_port(s7_scheme *sc, s7_pointer strport) +{ + block_t *block; + block = mallocate(sc, FORMAT_PORT_LENGTH); + port_data(strport) = (uint8_t *)(block_data(block)); + port_data_block(strport) = block; + port_data(strport)[0] = '\0'; + port_position(strport) = 0; + port_data_size(strport) = FORMAT_PORT_LENGTH; + port_needs_free(strport) = false; + close_format_port(sc, strport); +} + s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write) /* unavoidable backwards compatibility rigidity here */ { s7_pointer strport, res; - block_t *block; if ((sc->safety > NO_SAFETY) && (!s7_is_valid(sc, obj))) fprintf(stderr, "bad arg to %s: %p\n", __func__, obj); - strport = open_format_port(); + strport = open_format_port(sc); object_out(sc, obj, strport, (use_write) ? P_WRITE : P_DISPLAY); if (port_position(strport) >= port_data_size(strport)) - res = block_to_string(sc, reallocate(port_data_block(strport), port_position(strport) + 1), port_position(strport)); + res = block_to_string(sc, reallocate(sc, port_data_block(strport), port_position(strport) + 1), port_position(strport)); else res = block_to_string(sc, port_data_block(strport), port_position(strport)); - - block = mallocate(FORMAT_PORT_LENGTH); - port_data(strport) = (uint8_t *)(block_data(block)); - port_data_block(strport) = block; - port_data(strport)[0] = '\0'; - port_position(strport) = 0; - port_data_size(strport) = FORMAT_PORT_LENGTH; - port_needs_free(strport) = false; - - close_format_port(strport); + restore_format_port(sc, strport); return(res); } @@ -30734,7 +30867,6 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) use_write_t choice; s7_pointer obj, strport, res; s7_int out_len; - block_t *block; sc->objstr_max_len = s7_int_max; if (is_not_null(cdr(args))) @@ -30765,7 +30897,7 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) obj = car(args); check_method(sc, obj, sc->object_to_string_symbol, args); - strport = open_format_port(); + strport = open_format_port(sc); object_out(sc, obj, strport, choice); out_len = port_position(strport); @@ -30776,7 +30908,7 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) out_len = sc->objstr_max_len; if (out_len < 3) { - close_format_port(strport); + close_format_port(sc, strport); return(s7_make_string_with_length(sc, "...", 3)); } for (i = out_len - 3; i < out_len; i++) @@ -30785,18 +30917,9 @@ static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args) sc->objstr_max_len = s7_int_max; if (out_len >= port_data_size(strport)) - res = block_to_string(sc, reallocate(port_data_block(strport), out_len + 1), out_len); + res = block_to_string(sc, reallocate(sc, port_data_block(strport), out_len + 1), out_len); else res = block_to_string(sc, port_data_block(strport), out_len); - - block = mallocate(FORMAT_PORT_LENGTH); - port_data(strport) = (uint8_t *)(block_data(block)); - port_data_block(strport) = block; - port_data(strport)[0] = '\0'; - port_position(strport) = 0; - port_data_size(strport) = FORMAT_PORT_LENGTH; - port_needs_free(strport) = false; - - close_format_port(strport); + restore_format_port(sc, strport); return(res); } @@ -30831,20 +30954,20 @@ static s7_pointer g_newline(s7_scheme *sc, s7_pointer args) /* return(sc->unspecified) until 28-Sep-17, but for example (display c) returns c */ } -static s7_pointer newline_p(void) +static s7_pointer newline_p(s7_scheme *sc) { - s7_newline(cur_sc, cur_sc->output_port); + s7_newline(sc, sc->output_port); return(newline_char); } -static s7_pointer newline_p_p(s7_pointer port) +static s7_pointer newline_p_p(s7_scheme *sc, s7_pointer port) { if (!is_output_port(port)) { - if (port == cur_sc->F) return(newline_char); - s7_wrong_type_arg_error(cur_sc, "newline", 1, port, "an open output port"); + if (port == sc->F) return(newline_char); + s7_wrong_type_arg_error(sc, "newline", 1, port, "an open output port"); } - s7_newline(cur_sc, port); + s7_newline(sc, port); return(newline_char); } @@ -30881,20 +31004,20 @@ static s7_pointer g_write(s7_scheme *sc, s7_pointer args) return(object_out(sc, car(args), port, P_WRITE)); } -static s7_pointer write_p_p(s7_pointer x) +static s7_pointer write_p_p(s7_scheme *sc, s7_pointer x) { - if (cur_sc->output_port == cur_sc->F) return(x); - return(object_out(cur_sc, x, cur_sc->output_port, P_WRITE)); + if (sc->output_port == sc->F) return(x); + return(object_out(sc, x, sc->output_port, P_WRITE)); } -static s7_pointer write_p_pp(s7_pointer x, s7_pointer port) +static s7_pointer write_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer port) { - if (port == cur_sc->F) + if (port == sc->F) return(x); if ((!is_output_port(port)) || (port_is_closed(port))) - s7_wrong_type_arg_error(cur_sc, "write", 2, port, "an open output port"); - if (port == cur_sc->F) return(x); - return(object_out(cur_sc, x, port, P_WRITE)); + s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port"); + if (port == sc->F) return(x); + return(object_out(sc, x, port, P_WRITE)); } @@ -30930,20 +31053,20 @@ static s7_pointer g_display(s7_scheme *sc, s7_pointer args) return(object_out(sc, car(args), port, P_DISPLAY)); } -static s7_pointer display_p_p(s7_pointer x) +static s7_pointer display_p_p(s7_scheme *sc, s7_pointer x) { - if (cur_sc->output_port == cur_sc->F) return(x); - return(object_out(cur_sc, x, cur_sc->output_port, P_DISPLAY)); + if (sc->output_port == sc->F) return(x); + return(object_out(sc, x, sc->output_port, P_DISPLAY)); } -static s7_pointer display_p_pp(s7_pointer x, s7_pointer port) +static s7_pointer display_p_pp(s7_scheme *sc, s7_pointer x, s7_pointer port) { - if (port == cur_sc->F) + if (port == sc->F) return(x); if ((!is_output_port(port)) || (port_is_closed(port))) - s7_wrong_type_arg_error(cur_sc, "display", 2, port, "an open output port"); - if (port == cur_sc->F) return(x); - return(object_out(cur_sc, x, port, P_DISPLAY)); + s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port"); + if (port == sc->F) return(x); + return(object_out(sc, x, port, P_DISPLAY)); } @@ -30975,7 +31098,7 @@ static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args) static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args) { #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument" - #define Q_call_with_output_file pl_sf + #define Q_call_with_output_file sc->pl_sf s7_pointer port, file, proc; file = car(args); @@ -31028,7 +31151,7 @@ static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args) static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args) { #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk" - #define Q_with_output_to_file pl_sf + #define Q_with_output_to_file sc->pl_sf s7_pointer old_output_port, file, proc; file = car(args); @@ -31056,15 +31179,6 @@ static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args) static s7_pointer format_error_1(s7_scheme *sc, s7_pointer msg, const char *str, s7_pointer args, format_data *fdat) { s7_pointer x = NULL, ctrl_str; - static s7_pointer format_string_1 = NULL, format_string_2, format_string_3, format_string_4; - - if (!format_string_1) - { - format_string_1 = s7_make_permanent_string("format: ~S ~{~S~^ ~}: ~A"); - format_string_2 = s7_make_permanent_string("format: ~S: ~A"); - format_string_3 = s7_make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A"); - format_string_4 = s7_make_permanent_string("format: ~S~&~NT^: ~A"); - } if (fdat->orig_str) ctrl_str = fdat->orig_str; @@ -31079,12 +31193,12 @@ static s7_pointer format_error_1(s7_scheme *sc, s7_pointer msg, const char *str, else { if (is_pair(args)) - x = set_elist_5(sc, format_string_3, ctrl_str, args, wrap_integer(fdat->loc + 20), msg); - else x = set_elist_4(sc, format_string_4, ctrl_str, wrap_integer(fdat->loc + 20), msg); + x = set_elist_5(sc, format_string_3, ctrl_str, args, wrap_integer1(sc, fdat->loc + 20), msg); + else x = set_elist_4(sc, format_string_4, ctrl_str, wrap_integer1(sc, fdat->loc + 20), msg); } if (fdat->port) { - close_format_port(fdat->port); + close_format_port(sc, fdat->port); fdat->port = NULL; } return(s7_error(sc, sc->format_error_symbol, x)); @@ -31136,7 +31250,7 @@ static void format_append_chars(s7_scheme *sc, format_data *fdat, char pad, s7_i { s7_int new_len; new_len = port_position(port) + chars; - resize_port_data(port, new_len * 2); + resize_port_data(sc, port, new_len * 2); local_memset((char *)port_data(port) + port_position(port), pad, chars); port_position(port) = new_len; } @@ -31147,12 +31261,12 @@ static void format_append_chars(s7_scheme *sc, format_data *fdat, char pad, s7_i { block_t *b; char *str; - b = mallocate(chars + 1); + b = mallocate(sc, chars + 1); str = (char *)block_data(b); local_memset((void *)str, pad, chars); str[chars] = '\0'; format_append_string(sc, fdat, str, chars, port); - liberate(b); + liberate(sc, b); } } @@ -31216,7 +31330,7 @@ static void format_number(s7_scheme *sc, format_data *fdat, s7_int radix, s7_int char *padtmp; #if (!WITH_GMP) if (radix == 10) - tmp = number_to_string_base_10(car(fdat->args), width, precision, float_choice, &nlen, P_WRITE); + tmp = number_to_string_base_10(sc, car(fdat->args), width, precision, float_choice, &nlen, P_WRITE); else #endif tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen); @@ -31229,7 +31343,7 @@ static void format_number(s7_scheme *sc, format_data *fdat, s7_int radix, s7_int { #if (!WITH_GMP) if (radix == 10) - tmp = number_to_string_base_10(car(fdat->args), width, precision, float_choice, &nlen, P_WRITE); + tmp = number_to_string_base_10(sc, car(fdat->args), width, precision, float_choice, &nlen, P_WRITE); else #endif tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen); @@ -31387,9 +31501,9 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s else { if (fdat->port) - close_format_port(fdat->port); + close_format_port(sc, fdat->port); if (fdat->strport) - close_format_port(fdat->strport); + close_format_port(sc, fdat->strport); } fdat->port = NULL; fdat->strport = NULL; @@ -31408,7 +31522,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s if (with_result) { deferred_port = port; - port = open_format_port(); + port = open_format_port(sc); fdat->port = port; } else deferred_port = sc->F; @@ -31616,7 +31730,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s /* for the column check, we need to know the length of the object->string output */ if (columnized) { - strport = open_format_port(); + strport = open_format_port(sc); fdat->strport = strport; } else strport = port; @@ -31624,12 +31738,12 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s if (columnized) { if (port_position(strport) >= port_data_size(strport)) - resize_port_data(strport, port_data_size(strport) * 2); + resize_port_data(sc, strport, port_data_size(strport) * 2); port_data(strport)[port_position(strport)] = '\0'; if (port_position(strport) > 0) format_append_string(sc, fdat, (const char *)port_data(strport), port_position(strport), port); - close_format_port(strport); + close_format_port(sc, strport); fdat->strport = NULL; } @@ -31912,14 +32026,14 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s block_t *block; result = block_to_string(sc, port_data_block(port), port_position(port)); port_data_size(port) = FORMAT_PORT_LENGTH; - block = mallocate(FORMAT_PORT_LENGTH); + block = mallocate(sc, FORMAT_PORT_LENGTH); port_data_block(port) = block; port_data(port) = (uint8_t *)(block_data(block)); port_data(port)[0] = '\0'; port_position(port) = 0; } else result = s7_make_string_with_length(sc, (char *)port_data(port), port_position(port)); - close_format_port(port); + close_format_port(sc, port); fdat->port = NULL; return(result); } @@ -32053,10 +32167,10 @@ static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args) return(s7_make_boolean(sc, is_directory(string_value(name)))); } -static bool is_directory_b(s7_pointer p) +static bool is_directory_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_string(p)) - simple_wrong_type_argument(cur_sc, cur_sc->is_directory_symbol, p, T_STRING); + simple_wrong_type_argument(sc, sc->is_directory_symbol, p, T_STRING); return(is_directory(string_value(p))); } @@ -32088,10 +32202,10 @@ static s7_pointer g_file_exists(s7_scheme *sc, s7_pointer args) return(s7_make_boolean(sc, file_probe(string_value(name)))); } -static bool file_exists_b(s7_pointer p) +static bool file_exists_b_7p(s7_scheme *sc, s7_pointer p) { if (!is_string(p)) - simple_wrong_type_argument(cur_sc, cur_sc->file_exists_symbol, p, T_STRING); + simple_wrong_type_argument(sc, sc->file_exists_symbol, p, T_STRING); return(file_probe(string_value(p))); } @@ -32113,7 +32227,7 @@ static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args) static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) { #define H_getenv "(getenv var) returns the value of an environment variable." - #define Q_getenv pcl_s + #define Q_getenv sc->pcl_s s7_pointer name; name = car(args); @@ -32165,7 +32279,7 @@ system captures the output as a string and returns it." if (str) { block_t *b; - b = mallocate_block(); + b = mallocate_block(sc); block_data(b) = (void *)str; block_set_index(b, TOP_BLOCK_LIST); return(block_to_string(sc, b, cur_len)); @@ -32270,13 +32384,12 @@ static s7_pointer cons_unchecked_with_type(s7_scheme *sc, s7_pointer p, s7_point } -static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint64_t type) +static s7_pointer permanent_cons(s7_scheme *sc, s7_pointer a, s7_pointer b, uint64_t type) { - /* for the symbol table which is never GC'd (and its contents aren't marked) */ s7_pointer x; - x = alloc_pointer(); + x = alloc_pointer(sc); set_type(x, type); - unheap(x); + unheap(sc, x); set_car(x, a); set_cdr(x, b); return(x); @@ -32288,11 +32401,10 @@ static s7_pointer permanent_list(s7_scheme *sc, s7_int len) s7_pointer p; p = sc->nil; for (j = 0; j < len; j++) - p = permanent_cons(sc->nil, p, T_PAIR | T_IMMUTABLE); + p = permanent_cons(sc, sc->nil, p, T_PAIR | T_IMMUTABLE); return(p); } - static void check_sig_entry(s7_scheme *sc, s7_pointer p, s7_pointer res, bool circle) { if ((!is_symbol(car(p))) && @@ -32351,7 +32463,7 @@ s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int bool s7_is_pair(s7_pointer p) {return(is_pair(p));} -static s7_pointer is_pair_p_p(s7_pointer p) {return((is_pair(p)) ? cur_sc->T : cur_sc->F);} +static s7_pointer is_pair_p_p(s7_scheme *sc, s7_pointer p) {return((is_pair(p)) ? sc->T : sc->F);} s7_pointer s7_car(s7_pointer p) {return(car(p));} @@ -32793,12 +32905,12 @@ static s7_int tree_len(s7_scheme *sc, s7_pointer p) return(tree_len_1(sc, p)); } -static s7_int tree_leaves_i(s7_pointer p) +static s7_int tree_leaves_i_7p(s7_scheme *sc, s7_pointer p) { - if ((cur_sc->safety > NO_SAFETY) && - (tree_is_cyclic(cur_sc, p))) - s7_error(cur_sc, cur_sc->wrong_type_arg_symbol, wrap_string(cur_sc, "tree-leaves: tree is cyclic", 27)); - return(tree_len(cur_sc, p)); + if ((sc->safety > NO_SAFETY) && + (tree_is_cyclic(sc, p))) + s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "tree-leaves: tree is cyclic", 27)); + return(tree_len(sc, p)); } static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args) @@ -32879,7 +32991,7 @@ static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, s7_tree_memq(sc, car(args), tree))); } -static bool tree_memq_b_pp(s7_pointer sym, s7_pointer tree) {return(g_tree_memq(cur_sc, set_plist_2(cur_sc, sym, tree)) != cur_sc->F);} +static bool tree_memq_b_7pp(s7_scheme *sc, s7_pointer sym, s7_pointer tree) {return(g_tree_memq(sc, set_plist_2(sc, sym, tree)) != sc->F);} /* ---------------- tree-set-memq ---------------- */ static inline bool pair_set_memq(s7_scheme *sc, s7_pointer tree) @@ -32936,9 +33048,8 @@ static s7_pointer g_tree_set_memq(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, tree_set_memq(sc, tree))); } -static bool tree_set_memq_b_pp(s7_pointer syms, s7_pointer tree) {return(g_tree_set_memq(cur_sc, set_plist_2(cur_sc, syms, tree)) != cur_sc->F);} +static bool tree_set_memq_b_7pp(s7_scheme *sc, s7_pointer syms, s7_pointer tree) {return(g_tree_set_memq(sc, set_plist_2(sc, syms, tree)) != sc->F);} -static s7_pointer tree_set_memq_syms; static s7_pointer g_tree_set_memq_1(s7_scheme *sc, s7_pointer args) { s7_pointer p, tree; @@ -32961,7 +33072,7 @@ static s7_pointer tree_set_memq_chooser(s7_scheme *sc, s7_pointer f, int32_t arg for (p = cadadr(expr); is_pair(p); p = cdr(p)) if (!is_symbol(car(p))) return(f); - return(tree_set_memq_syms); + return(sc->tree_set_memq_syms); } return(f); } @@ -33290,7 +33401,7 @@ s7_int s7_list_length(s7_scheme *sc, s7_pointer a) static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args) { #define H_is_null "(null? obj) returns #t if obj is the empty list" - #define Q_is_null pl_bt + #define Q_is_null sc->pl_bt check_boolean_method(sc, is_null, sc->is_null_symbol, args); /* as a generic this could be: has_structure and length == 0 */ } @@ -33298,7 +33409,7 @@ static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args) { #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)" - #define Q_is_pair pl_bt + #define Q_is_pair sc->pl_bt check_boolean_method(sc, is_pair, sc->is_pair_symbol, args); } @@ -33323,16 +33434,7 @@ bool s7_is_proper_list(s7_scheme *sc, s7_pointer lst) { if (!is_pair(fast)) return(is_null(fast)); /* else it's an improper list */ - - fast = cdr(fast); - if (!is_pair(fast)) return(is_null(fast)); - - fast = cdr(fast); - if (!is_pair(fast)) return(is_null(fast)); - - fast = cdr(fast); - if (!is_pair(fast)) return(is_null(fast)); - + LOOP_4(fast = cdr(fast); if (!is_pair(fast)) return(is_null(fast))); fast = cdr(fast); slow = cdr(slow); if (fast == slow) return(false); @@ -33343,7 +33445,7 @@ bool s7_is_proper_list(s7_scheme *sc, s7_pointer lst) static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args) { #define H_is_list "(list? obj) returns #t if obj is a pair or null" - #define Q_is_list pl_bt + #define Q_is_list sc->pl_bt #define is_a_list(p) s7_is_list(sc, p) check_boolean_method(sc, is_a_list, sc->is_list_symbol, args); } @@ -33392,18 +33494,21 @@ static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args) #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'." #define Q_make_list s7_make_signature(sc, 3, sc->is_proper_list_symbol, sc->is_integer_symbol, sc->T) - s7_pointer init; + s7_pointer init, n; s7_int len; - if (!s7_is_integer(car(args))) - return(method_or_bust(sc, car(args), sc->make_list_symbol, args, T_INTEGER, 1)); + n = car(args); + if (!s7_is_integer(n)) + return(method_or_bust(sc, n, sc->make_list_symbol, args, T_INTEGER, 1)); - len = s7_integer(car(args)); /* needs to be s7_int here so that (make-list most-negative-fixnum) is handled correctly */ - if (len < 0) - return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_negative_string)); + len = s7_integer(n); +#if WITH_GMP + if ((len == 0) && (!s7_is_zero(n))) + return(s7_out_of_range_error(sc, "make-list", 1, n, "big integer is too big for s7_int")); +#endif + if ((len < 0) || (len > sc->max_list_length)) + return(out_of_range(sc, sc->make_list_symbol, small_int(1), n, (len < 0) ? its_negative_string : its_too_large_string)); if (len == 0) return(sc->nil); /* what about (make-list 0 123)? */ - if (len > sc->max_list_length) - return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_too_large_string)); if (is_pair(cdr(args))) init = cadr(args); @@ -33466,8 +33571,8 @@ static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args) if (is_null(cdr(inds))) return(lst); inds = cdr(inds); - if (!is_pair(lst)) /* trying to avoid a cons here at the cost of one extra type check */ - return(implicit_index(sc, lst, inds)); + if (!is_pair(lst)) + return(wrong_type_argument_with_type(sc, sc->list_ref_symbol, 1, lst, a_proper_list_string)); /* changed from implicit_index 8-Jul-18 */ } } @@ -33523,54 +33628,53 @@ static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args) return(g_list_set_1(sc, car(args), cdr(args), 2)); } -static s7_pointer list_ref_p_pi_direct(s7_pointer p1, s7_int i1) +static s7_pointer list_ref_p_pi_direct(s7_scheme *sc, s7_pointer p1, s7_int i1) { s7_pointer p; s7_int i; - if ((i1 < 0) || (i1 > cur_sc->max_list_length)) - out_of_range(cur_sc, cur_sc->list_ref_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + if ((i1 < 0) || (i1 > sc->max_list_length)) + out_of_range(sc, sc->list_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); for (i = 0, p = p1; ((is_pair(p)) && (i < i1)); i++, p = cdr(p)); if (!is_pair(p)) { if (type(p) == T_NIL) - out_of_range(cur_sc, cur_sc->list_ref_symbol, small_int(2), wrap_integer(i1), its_too_large_string); - else simple_wrong_type_argument_with_type(cur_sc, cur_sc->list_ref_symbol, p1, a_proper_list_string); + out_of_range(sc, sc->list_ref_symbol, small_int(2), wrap_integer1(sc, i1), its_too_large_string); + else simple_wrong_type_argument_with_type(sc, sc->list_ref_symbol, p1, a_proper_list_string); } return(car(p)); } -static s7_pointer list_ref_p_pi(s7_pointer p1, s7_int i1) +static s7_pointer list_ref_p_pi(s7_scheme *sc, s7_pointer p1, s7_int i1) { if (!is_pair(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->list_ref_symbol, p1, T_PAIR); - return(list_ref_p_pi_direct(p1, i1)); + simple_wrong_type_argument(sc, sc->list_ref_symbol, p1, T_PAIR); + return(list_ref_p_pi_direct(sc, p1, i1)); } -static s7_pointer list_set_p_pip_direct(s7_pointer p1, s7_int i1, s7_pointer p2) +static s7_pointer list_set_p_pip_direct(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) { s7_pointer p; s7_int i; - if ((i1 < 0) || (i1 > cur_sc->max_list_length)) - out_of_range(cur_sc, cur_sc->list_set_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + if ((i1 < 0) || (i1 > sc->max_list_length)) + out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); for (i = 0, p = p1; ((is_pair(p)) && (i < i1)); i++, p = cdr(p)); if (!is_pair(p)) { if (type(p) == T_NIL) - out_of_range(cur_sc, cur_sc->list_set_symbol, small_int(2), wrap_integer(i1), its_too_large_string); - else simple_wrong_type_argument_with_type(cur_sc, cur_sc->list_set_symbol, p1, a_proper_list_string); + out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer1(sc, i1), its_too_large_string); + else simple_wrong_type_argument_with_type(sc, sc->list_set_symbol, p1, a_proper_list_string); } set_car(p, p2); return(p2); } -static s7_pointer list_set_p_pip(s7_pointer p1, s7_int i1, s7_pointer p2) +static s7_pointer list_set_p_pip(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) { if (!is_pair(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->list_set_symbol, p1, T_PAIR); - return(list_set_p_pip_direct(p1, i1, p2)); + simple_wrong_type_argument(sc, sc->list_set_symbol, p1, T_PAIR); + return(list_set_p_pip_direct(sc, p1, i1, p2)); } -static s7_pointer list_set_ic; static s7_pointer g_list_set_ic(s7_scheme *sc, s7_pointer args) { s7_pointer p, lst, val; @@ -33581,13 +33685,13 @@ static s7_pointer g_list_set_ic(s7_scheme *sc, s7_pointer args) index = s7_integer(cadr(args)); if ((index < 0) || (index > sc->max_list_length)) - return(out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer(index), (index < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer1(sc, index), (index < 0) ? its_negative_string : its_too_large_string)); for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {} if (!is_pair(p)) { if (is_null(p)) - return(out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer(index), its_too_large_string)); + return(out_of_range(sc, sc->list_set_symbol, small_int(2), wrap_integer1(sc, index), its_too_large_string)); return(wrong_type_argument_with_type(sc, sc->list_set_symbol, 1, lst, a_proper_list_string)); } @@ -33623,11 +33727,11 @@ static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args) return(method_or_bust_with_type(sc, lst, sc->list_tail_symbol, list_2(sc, lst, make_integer(sc, index)), a_list_string, 1)); if ((index < 0) || (index > sc->max_list_length)) - return(out_of_range(sc, sc->list_tail_symbol, small_int(2), wrap_integer(index), (index < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->list_tail_symbol, small_int(2), wrap_integer1(sc, index), (index < 0) ? its_negative_string : its_too_large_string)); for (i = 0, p = lst; (i < index) && (is_pair(p)); i++, p = cdr(p)) {} if (i < index) - return(out_of_range(sc, sc->list_tail_symbol, small_int(2), wrap_integer(index), its_too_large_string)); + return(out_of_range(sc, sc->list_tail_symbol, small_int(2), wrap_integer1(sc, index), its_too_large_string)); return(p); } @@ -33653,86 +33757,22 @@ static s7_pointer g_cons(s7_scheme *sc, s7_pointer args) return(x); } -static s7_pointer cons_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer cons_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { s7_pointer x; - new_cell(cur_sc, x, T_PAIR | T_SAFE_PROCEDURE); + new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE); set_car(x, p1); set_cdr(x, p2); return(x); } -static void init_car_a_list(void) -{ - car_a_list_string = s7_make_permanent_string("a list whose car is also a list"); - cdr_a_list_string = s7_make_permanent_string("a list whose cdr is also a list"); - - caar_a_list_string = s7_make_permanent_string("a list whose caar is also a list"); - cadr_a_list_string = s7_make_permanent_string("a list whose cadr is also a list"); - cdar_a_list_string = s7_make_permanent_string("a list whose cdar is also a list"); - cddr_a_list_string = s7_make_permanent_string("a list whose cddr is also a list"); - - caaar_a_list_string = s7_make_permanent_string("a list whose caaar is also a list"); - caadr_a_list_string = s7_make_permanent_string("a list whose caadr is also a list"); - cadar_a_list_string = s7_make_permanent_string("a list whose cadar is also a list"); - caddr_a_list_string = s7_make_permanent_string("a list whose caddr is also a list"); - cdaar_a_list_string = s7_make_permanent_string("a list whose cdaar is also a list"); - cdadr_a_list_string = s7_make_permanent_string("a list whose cdadr is also a list"); - cddar_a_list_string = s7_make_permanent_string("a list whose cddar is also a list"); - cdddr_a_list_string = s7_make_permanent_string("a list whose cdddr is also a list"); - - a_list_string = s7_make_permanent_string("a list"); - an_eq_func_string = s7_make_permanent_string("a procedure that can take 2 arguments"); - an_association_list_string = s7_make_permanent_string("an association list"); - a_normal_real_string = s7_make_permanent_string("a normal real"); - a_rational_string = s7_make_permanent_string("an integer or a ratio"); - a_number_string = s7_make_permanent_string("a number"); - a_procedure_string = s7_make_permanent_string("a procedure"); - a_normal_procedure_string = s7_make_permanent_string("a normal procedure (not a continuation)"); - a_let_string = s7_make_permanent_string("a let (environment)"); - a_proper_list_string = s7_make_permanent_string("a proper list"); - a_boolean_string = s7_make_permanent_string("a boolean"); - a_byte_vector_string = s7_make_permanent_string("a byte-vector"); - an_input_port_string = s7_make_permanent_string("an input port"); - an_open_port_string = s7_make_permanent_string("an open port"); - an_output_port_string = s7_make_permanent_string("an output port"); - an_input_string_port_string = s7_make_permanent_string("an input string port"); - an_input_file_port_string = s7_make_permanent_string("an input file port"); - an_output_string_port_string = s7_make_permanent_string("an output string port"); - an_output_file_port_string = s7_make_permanent_string("an output file port"); - a_thunk_string = s7_make_permanent_string("a thunk"); - a_symbol_string = s7_make_permanent_string("a symbol"); - a_non_negative_integer_string = s7_make_permanent_string("a non-negative integer"); - an_unsigned_byte_string = s7_make_permanent_string("an unsigned byte"); - something_applicable_string = s7_make_permanent_string("a procedure or something applicable"); - a_random_state_object_string = s7_make_permanent_string("a random-state object"); - a_format_port_string = s7_make_permanent_string("#f, #t, (), or an open output port"); - a_non_constant_symbol_string = s7_make_permanent_string("a non-constant symbol"); - a_sequence_string = s7_make_permanent_string("a sequence"); - a_valid_radix_string = s7_make_permanent_string("should be between 2 and 16"); - result_is_too_large_string = s7_make_permanent_string("result is too large"); - its_too_large_string = s7_make_permanent_string("it is too large"); - its_too_small_string = s7_make_permanent_string("it is less than the start position"); - its_negative_string = s7_make_permanent_string("it is negative"); - its_nan_string = s7_make_permanent_string("NaN usually indicates a numerical error"); - its_infinite_string = s7_make_permanent_string("it is infinite"); - too_many_indices_string = s7_make_permanent_string("too many indices"); - value_is_missing_string = s7_make_permanent_string("~A argument '~A's value is missing"); - parameter_set_twice_string = s7_make_permanent_string("parameter set twice, ~S in ~S"); - immutable_error_string = s7_make_permanent_string("can't ~S ~S (it is immutable)"); -#if (!HAVE_COMPLEX_NUMBERS) - no_complex_numbers_string = s7_make_permanent_string("this version of s7 does not support complex numbers"); -#endif -} - - /* -------- car -------- */ static s7_pointer g_car(s7_scheme *sc, s7_pointer args) { #define H_car "(car pair) returns the first element of the pair" - #define Q_car pl_p + #define Q_car sc->pl_p s7_pointer lst; lst = car(args); @@ -33741,11 +33781,11 @@ static s7_pointer g_car(s7_scheme *sc, s7_pointer args) return(method_or_bust_one_arg(sc, lst, sc->car_symbol, args, T_PAIR)); } -static s7_pointer car_p_p(s7_pointer p) +static s7_pointer car_p_p(s7_scheme *sc, s7_pointer p) { if (is_pair(p)) return(car(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->car_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->car_symbol, p, T_PAIR)); } @@ -33762,10 +33802,10 @@ static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args) return(car(p)); } -static s7_pointer set_car_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer set_car_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { if (!is_mutable_pair(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->set_car_symbol, p1, T_PAIR); + simple_wrong_type_argument(sc, sc->set_car_symbol, p1, T_PAIR); set_car(p1, p2); return(p2); } @@ -33775,7 +33815,7 @@ static s7_pointer set_car_p_pp(s7_pointer p1, s7_pointer p2) static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args) { #define H_cdr "(cdr pair) returns the second element of the pair" - #define Q_cdr pl_p + #define Q_cdr sc->pl_p s7_pointer lst; lst = car(args); @@ -33784,11 +33824,11 @@ static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args) return(method_or_bust_one_arg(sc, lst, sc->cdr_symbol, args, T_PAIR)); } -static s7_pointer cdr_p_p(s7_pointer p) +static s7_pointer cdr_p_p(s7_scheme *sc, s7_pointer p) { if (is_pair(p)) return(cdr(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->cdr_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->cdr_symbol, p, T_PAIR)); } @@ -33806,10 +33846,10 @@ static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args) return(cdr(p)); } -static s7_pointer set_cdr_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer set_cdr_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { if (!is_mutable_pair(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->set_cdr_symbol, p1, T_PAIR); + simple_wrong_type_argument(sc, sc->set_cdr_symbol, p1, T_PAIR); set_cdr(p1, p2); return(p2); } @@ -33819,7 +33859,7 @@ static s7_pointer set_cdr_p_pp(s7_pointer p1, s7_pointer p2) static s7_pointer g_caar(s7_scheme *sc, s7_pointer args) { #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1" - #define Q_caar pl_p + #define Q_caar sc->pl_p s7_pointer lst; lst = car(args); @@ -33829,12 +33869,12 @@ static s7_pointer g_caar(s7_scheme *sc, s7_pointer args) return(caar(lst)); } -static s7_pointer caar_p_p(s7_pointer p) +static s7_pointer caar_p_p(s7_scheme *sc, s7_pointer p) { if ((is_pair(p)) && (is_pair(car(p)))) return(caar(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->caar_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->caar_symbol, p, T_PAIR)); } @@ -33842,7 +33882,7 @@ static s7_pointer caar_p_p(s7_pointer p) static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args) { #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2" - #define Q_cadr pl_p + #define Q_cadr sc->pl_p s7_pointer lst; lst = car(args); @@ -33851,12 +33891,12 @@ static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args) return(cadr(lst)); } -static s7_pointer cadr_p_p(s7_pointer p) +static s7_pointer cadr_p_p(s7_scheme *sc, s7_pointer p) { if ((is_pair(p)) && (is_pair(cdr(p)))) return(cadr(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->cadr_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->cadr_symbol, p, T_PAIR)); } @@ -33864,7 +33904,7 @@ static s7_pointer cadr_p_p(s7_pointer p) static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args) { #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)" - #define Q_cdar pl_p + #define Q_cdar sc->pl_p s7_pointer lst; lst = car(args); @@ -33873,12 +33913,12 @@ static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args) return(cdar(lst)); } -static s7_pointer cdar_p_p(s7_pointer p) +static s7_pointer cdar_p_p(s7_scheme *sc, s7_pointer p) { if ((is_pair(p)) && (is_pair(car(p)))) return(cdar(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->cdar_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->cdar_symbol, p, T_PAIR)); } @@ -33886,7 +33926,7 @@ static s7_pointer cdar_p_p(s7_pointer p) static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args) { #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)" - #define Q_cddr pl_p + #define Q_cddr sc->pl_p s7_pointer lst; lst = car(args); @@ -33895,21 +33935,20 @@ static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args) return(cddr(lst)); } -static s7_pointer cddr_p_p(s7_pointer p) +static s7_pointer cddr_p_p(s7_scheme *sc, s7_pointer p) { if ((is_pair(p)) && (is_pair(cdr(p)))) return(cddr(p)); - return(simple_wrong_type_argument(cur_sc, cur_sc->cddr_symbol, p, T_PAIR)); + return(simple_wrong_type_argument(sc, sc->cddr_symbol, p, T_PAIR)); } - /* -------- caaar -------- */ static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1" - #define Q_caaar pl_p + #define Q_caaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33918,13 +33957,12 @@ static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args) return(caaar(lst)); } - /* -------- caadr -------- */ static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2" - #define Q_caadr pl_p + #define Q_caadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33933,13 +33971,12 @@ static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args) return(caadr(lst)); } - /* -------- cadar -------- */ static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2" - #define Q_cadar pl_p + #define Q_cadar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cadar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33948,13 +33985,12 @@ static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args) return(cadar(lst)); } - /* -------- cdaar -------- */ static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)" - #define Q_cdaar pl_p + #define Q_cdaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33963,13 +33999,12 @@ static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args) return(cdaar(lst)); } - /* -------- caddr -------- */ static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3" - #define Q_caddr pl_p + #define Q_caddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33978,13 +34013,12 @@ static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args) return(caddr(lst)); } - /* -------- cdddr -------- */ static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)" - #define Q_cdddr pl_p + #define Q_cdddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -33993,13 +34027,12 @@ static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args) return(cdddr(lst)); } - /* -------- cdadr -------- */ static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)" - #define Q_cdadr pl_p + #define Q_cdadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34008,13 +34041,12 @@ static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args) return(cdadr(lst)); } - /* -------- cddar -------- */ static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)" - #define Q_cddar pl_p + #define Q_cddar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cddar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34023,13 +34055,12 @@ static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args) return(cddar(lst)); } - /* -------- caaaar -------- */ static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1" - #define Q_caaaar pl_p + #define Q_caaaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caaaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34039,13 +34070,12 @@ static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args) return(caaaar(lst)); } - /* -------- caaadr -------- */ static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2" - #define Q_caaadr pl_p + #define Q_caaadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caaadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34055,13 +34085,12 @@ static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args) return(caaadr(lst)); } - /* -------- caadar -------- */ static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2" - #define Q_caadar pl_p + #define Q_caadar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caadar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34071,13 +34100,12 @@ static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args) return(caadar(lst)); } - /* -------- cadaar -------- */ static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2" - #define Q_cadaar pl_p + #define Q_cadaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cadaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34087,13 +34115,12 @@ static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args) return(cadaar(lst)); } - /* -------- caaddr -------- */ static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3" - #define Q_caaddr pl_p + #define Q_caaddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caaddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34103,13 +34130,12 @@ static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args) return(caaddr(lst)); } - /* -------- cadddr -------- */ static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4" - #define Q_cadddr pl_p + #define Q_cadddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cadddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34119,13 +34145,12 @@ static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args) return(cadddr(lst)); } - /* -------- cadadr -------- */ static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3" - #define Q_cadadr pl_p + #define Q_cadadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cadadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34135,13 +34160,12 @@ static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args) return(cadadr(lst)); } - /* -------- caddar -------- */ static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3" - #define Q_caddar pl_p + #define Q_caddar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->caddar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34151,13 +34175,12 @@ static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args) return(caddar(lst)); } - /* -------- cdaaar -------- */ static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)" - #define Q_cdaaar pl_p + #define Q_cdaaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdaaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34167,13 +34190,12 @@ static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args) return(cdaaar(lst)); } - /* -------- cdaadr -------- */ static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)" - #define Q_cdaadr pl_p + #define Q_cdaadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdaadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34183,13 +34205,12 @@ static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args) return(cdaadr(lst)); } - /* -------- cdadar -------- */ static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)" - #define Q_cdadar pl_p + #define Q_cdadar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdadar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34199,13 +34220,12 @@ static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args) return(cdadar(lst)); } - /* -------- cddaar -------- */ static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)" - #define Q_cddaar pl_p + #define Q_cddaar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cddaar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34215,13 +34235,12 @@ static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args) return(cddaar(lst)); } - /* -------- cdaddr -------- */ static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)" - #define Q_cdaddr pl_p + #define Q_cdaddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdaddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34231,13 +34250,12 @@ static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args) return(cdaddr(lst)); } - /* -------- cddddr -------- */ static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)" - #define Q_cddddr pl_p + #define Q_cddddr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cddddr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34247,13 +34265,12 @@ static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args) return(cddddr(lst)); } - /* -------- cddadr -------- */ static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)" - #define Q_cddadr pl_p + #define Q_cddadr sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cddadr_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34263,13 +34280,12 @@ static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args) return(cddadr(lst)); } - /* -------- cdddar -------- */ static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args) { s7_pointer lst; #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)" - #define Q_cdddar pl_p + #define Q_cdddar sc->pl_p lst = car(args); if (!is_pair(lst)) return(method_or_bust_one_arg(sc, lst, sc->cdddar_symbol, set_plist_1(sc, lst), T_PAIR)); @@ -34288,34 +34304,11 @@ s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x) { /* we can blithely take the car of anything, since we're not treating it as an object, * then if we get a bogus match, the following check that caar made sense ought to catch it. - * * if car(#<unspecified>) = #<unspecified> (initialization time), then cdr(nil)->unspec * and subsequent caar(unspc)->unspec so we could forgo half the is_pair checks below. * This breaks if "x" is a dotted list -- the last cdr is not nil, so we lose. */ - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); - x = cdr(x); - if (!is_pair(x)) return(sc->F); + LOOP_8(if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x)); x = cdr(x); if (!is_pair(x)) return(sc->F)); y = cdr(y); if (x == y) return(sc->F); @@ -34473,7 +34466,7 @@ If 'func' is a function of 2 arguments, it is used for the comparison instead of { slot_set_value(b, caar(x)); sc->pc = 0; - if (o->v7.fb(o)) + if (o->v[0].fb(o)) return(car(x)); } return(sc->F); @@ -34556,7 +34549,7 @@ If 'func' is a function of 2 arguments, it is used for the comparison instead of return(sc->F); /* not reached */ } -static s7_pointer assoc_p_pp(s7_pointer p1, s7_pointer p2) {return(g_assoc(cur_sc, set_plist_2(cur_sc, p1, p2)));} +static s7_pointer assoc_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(g_assoc(sc, set_plist_2(sc, p1, p2)));} /* ---------------- member, memv, memq ---------------- */ @@ -34567,22 +34560,7 @@ s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x) y = x; while (true) { - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - + LOOP_4(if (obj == car(x)) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F)); y = cdr(y); if (x == y) return(sc->F); } @@ -34593,7 +34571,7 @@ static s7_pointer g_memq(s7_scheme *sc, s7_pointer args) { s7_pointer x, y; #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?" - #define Q_memq pl_tl + #define Q_memq sc->pl_tl x = car(args); y = cadr(args); @@ -34611,8 +34589,6 @@ static s7_pointer g_memq(s7_scheme *sc, s7_pointer args) /* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is * a proper list, and what its length is. */ -static s7_pointer memq_2, memq_3, memq_4, memq_any; - static s7_pointer g_memq_2(s7_scheme *sc, s7_pointer args) { s7_pointer x, obj; @@ -34648,14 +34624,7 @@ static s7_pointer g_memq_4(s7_scheme *sc, s7_pointer args) obj = car(args); while (true) { - if (obj == car(x)) return(x); - x = cdr(x); - if (obj == car(x)) return(x); - x = cdr(x); - if (obj == car(x)) return(x); - x = cdr(x); - if (obj == car(x)) return(x); - x = cdr(x); + LOOP_4(if (obj == car(x)) return(x); x = cdr(x)); if (!is_pair(x)) return(sc->F); } return(sc->F); @@ -34669,27 +34638,11 @@ static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args) obj = car(args); while (true) { - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); /* every other pair check could be omitted */ - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (obj == car(x)) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); + LOOP_4(if (obj == car(x)) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F)); } return(sc->F); } - -static s7_pointer memq_car, memq_car_2; static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args) { s7_pointer x, obj; @@ -34742,19 +34695,19 @@ static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poi set_opt_sym2(cdr(expr), cadadr(expr)); set_opt_pair3(cdr(expr), cadr(caddr(expr))); if (len == 2) - return(memq_car_2); - return(memq_car); + return(sc->memq_car_2); + return(sc->memq_car); } if (len > 0) { if (len == 2) - return(memq_2); + return(sc->memq_2); if ((len % 4) == 0) - return(memq_4); + return(sc->memq_4); if ((len % 3) == 0) - return(memq_3); - return(memq_any); + return(sc->memq_3); + return(sc->memq_any); } } return(f); @@ -34767,18 +34720,7 @@ static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x) y = x; while (true) { - if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); + LOOP_4(if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F)); y = cdr(y); if (x == y) return(sc->F); } @@ -34789,7 +34731,7 @@ static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x) static s7_pointer g_memv(s7_scheme *sc, s7_pointer args) { #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?" - #define Q_memv pl_tl + #define Q_memv sc->pl_tl s7_pointer x, y, z; x = car(args); @@ -34852,22 +34794,7 @@ static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x) while (true) { - if (s7_is_equal(sc, obj, car(x))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (s7_is_equal(sc, obj, car(x))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (s7_is_equal(sc, obj, car(x))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - - if (s7_is_equal(sc, obj, car(x))) return(x); - x = cdr(x); - if (!is_pair(x)) return(sc->F); - + LOOP_4(if (s7_is_equal(sc, obj, car(x))) return(x); x = cdr(x); if (!is_pair(x)) return(sc->F)); y = cdr(y); if (x == y) return(sc->F); } @@ -34968,7 +34895,7 @@ member uses equal? If 'func' is a function of 2 arguments, it is used for the c { slot_set_value(b, car(x)); sc->pc = 0; - if (o->v7.fb(o)) return(x); + if (o->v[0].fb(o)) return(x); if (!is_pair(cdr(x))) return(sc->F); x = cdr(x); @@ -34976,7 +34903,7 @@ member uses equal? If 'func' is a function of 2 arguments, it is used for the c slot_set_value(b, car(x)); sc->pc = 0; - if (o->v7.fb(o)) return(x); + if (o->v[0].fb(o)) return(x); } return(sc->F); } @@ -35011,7 +34938,6 @@ member uses equal? If 'func' is a function of 2 arguments, it is used for the c return(member(sc, obj, x)); } -static s7_pointer member_sq; static s7_pointer g_member_sq(s7_scheme *sc, s7_pointer args) { s7_pointer obj, lst; @@ -35027,7 +34953,6 @@ static s7_pointer g_member_sq(s7_scheme *sc, s7_pointer args) return(member(sc, obj, lst)); } -static s7_pointer member_ss; static s7_pointer g_member_ss(s7_scheme *sc, s7_pointer args) { s7_pointer obj, x; @@ -35049,7 +34974,7 @@ static s7_pointer g_member_ss(s7_scheme *sc, s7_pointer args) return(member(sc, obj, x)); } -static s7_pointer member_p_pp(s7_pointer p1, s7_pointer p2) {return(g_member(cur_sc, set_plist_2(cur_sc, p1, p2)));} +static s7_pointer member_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) {return(g_member(sc, set_plist_2(sc, p1, p2)));} static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { @@ -35063,7 +34988,7 @@ static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p (is_symbol(cadr(expr))))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(member_ss); /* (member obj lst) */ + return(sc->member_ss); /* (member obj lst) */ } } else @@ -35075,7 +35000,7 @@ static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p (is_pair(cadr(caddr(expr))))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(member_sq); /* (member q '(quote lambda case)) */ + return(sc->member_sq); /* (member q '(quote lambda case)) */ } } } @@ -35320,12 +35245,12 @@ static s7_pointer float_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc) return(make_real(sc, float_vector_element(vec, loc))); } -static inline block_t *mallocate_vector(s7_int len) +static inline block_t *mallocate_vector(s7_scheme *sc, s7_int len) { block_t *b; if (len > 0) - return(mallocate(len)); - b = mallocate_block(); + return(mallocate(sc, len)); + b = mallocate_block(sc); block_data(b) = NULL; block_info(b) = NULL; return(b); @@ -35337,7 +35262,7 @@ static s7_pointer make_simple_vector(s7_scheme *sc, s7_int len) /* len >= 0 and block_t *b; new_cell(sc, x, T_VECTOR | T_SAFE_PROCEDURE); vector_length(x) = len; - b = mallocate_vector(len * sizeof(s7_pointer)); + b = mallocate_vector(sc, len * sizeof(s7_pointer)); vector_block(x) = b; vector_elements(x) = (s7_pointer *)block_data(b); vector_set_dimension_info(x, NULL); @@ -35353,7 +35278,7 @@ static s7_pointer make_simple_float_vector(s7_scheme *sc, s7_int len) /* len >= block_t *b; new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE); vector_length(x) = len; - b = mallocate_vector(len * sizeof(s7_double)); + b = mallocate_vector(sc, len * sizeof(s7_double)); vector_block(x) = b; float_vector_elements(x) = (s7_double *)block_data(b); vector_set_dimension_info(x, NULL); @@ -35368,9 +35293,9 @@ static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t s7_pointer x; if (len < 0) - return(wrong_type_argument_with_type(sc, sc->make_vector_symbol, 1, wrap_integer(len), a_non_negative_integer_string)); + return(wrong_type_argument_with_type(sc, sc->make_vector_symbol, 1, wrap_integer1(sc, len), a_non_negative_integer_string)); if (len > sc->max_vector_length) - return(out_of_range(sc, sc->make_vector_symbol, small_int(1), wrap_integer(len), its_too_large_string)); + return(out_of_range(sc, sc->make_vector_symbol, small_int(1), wrap_integer1(sc, len), its_too_large_string)); /* this has to follow the error checks! (else garbage in free_heap temps portion confuses GC when "vector" is finalized) */ new_cell(sc, x, typ | T_SAFE_PROCEDURE); /* (v 0) as vector-ref is safe */ @@ -35378,7 +35303,7 @@ static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t if (len == 0) { vector_length(x) = 0; - vector_block(x) = mallocate_vector(0); + vector_block(x) = mallocate_vector(sc, 0); vector_elements(x) = NULL; } else @@ -35387,7 +35312,7 @@ static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t vector_length(x) = len; if (typ == T_VECTOR) { - b = mallocate_vector(len * sizeof(s7_pointer)); + b = mallocate_vector(sc, len * sizeof(s7_pointer)); vector_block(x) = b; vector_elements(x) = (s7_pointer *)block_data(b); if (!vector_elements(x)) @@ -35402,7 +35327,7 @@ static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t { if (typ == T_FLOAT_VECTOR) { - b = mallocate_vector(len * sizeof(s7_double)); + b = mallocate_vector(sc, len * sizeof(s7_double)); vector_block(x) = b; float_vector_elements(x) = (s7_double *)block_data(b); if (!float_vector_elements(x)) @@ -35419,7 +35344,7 @@ static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t } else { - b = mallocate_vector(len * sizeof(s7_int)); + b = mallocate_vector(sc, len * sizeof(s7_int)); vector_block(x) = b; int_vector_elements(x) = (s7_int *)block_data(b); if (!int_vector_elements(x)) @@ -35453,7 +35378,7 @@ s7_pointer s7_make_vector(s7_scheme *sc, s7_int len) static vdims_t *make_wrap_only(s7_scheme *sc) /* this makes sc->wrap_only */ { vdims_t *v; - v = (vdims_t *)mallocate_block(); + v = (vdims_t *)mallocate_block(sc); vdims_original(v) = sc->F; vector_elements_should_be_freed(v) = false; vdims_ndims(v) = 1; @@ -35472,7 +35397,7 @@ static vdims_t *make_vdims(s7_scheme *sc, bool elements_should_be_freed, s7_int if (dims > 1) { s7_int i, offset = 1; - v = (vdims_t *)mallocate(dims * 2 * sizeof(s7_int)); + v = (vdims_t *)mallocate(sc, dims * 2 * sizeof(s7_int)); vdims_original(v) = sc->F; vector_elements_should_be_freed(v) = elements_should_be_freed; vdims_ndims(v) = dims; @@ -35488,7 +35413,7 @@ static vdims_t *make_vdims(s7_scheme *sc, bool elements_should_be_freed, s7_int } else { - v = (vdims_t *)mallocate_block(); + v = (vdims_t *)mallocate_block(sc); vdims_original(v) = sc->F; vector_elements_should_be_freed(v) = elements_should_be_freed; vdims_ndims(v) = 1; @@ -35532,7 +35457,7 @@ s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *da block_t *b; new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE); - b = mallocate_vector(0); + b = mallocate_vector(sc, 0); vector_block(x) = b; /* block_data(b) = data; */ float_vector_elements(x) = data; @@ -35752,7 +35677,7 @@ static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args) s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index) { if (index >= vector_length(vec)) - return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), wrap_integer(index), its_too_large_string)); + return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), wrap_integer1(sc, index), its_too_large_string)); return(vector_getter(vec)(sc, vec, index)); } @@ -35760,7 +35685,7 @@ s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index) s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a) { if (index >= vector_length(vec)) - return(out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer(index), its_too_large_string)); + return(out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer1(sc, index), its_too_large_string)); vector_setter(vec)(sc, vec, index, T_Pos(a)); return(a); @@ -35771,24 +35696,45 @@ s7_pointer *s7_vector_elements(s7_pointer vec) {return(vector_elements(vec) s7_int *s7_int_vector_elements(s7_pointer vec) {return(int_vector_elements(vec));} s7_double *s7_float_vector_elements(s7_pointer vec) {return(float_vector_elements(vec));} -s7_int *s7_vector_dimensions(s7_pointer vec) +s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size) { - static s7_int *dims = NULL; + if (dims_size <= 0) return(0); if (vector_dimension_info(vec)) - return(vector_dimensions(vec)); - if (!dims) dims = (s7_int *)malloc(sizeof(s7_int)); + { + s7_int i, lim; + lim = vector_ndims(vec); + if (lim > dims_size) lim = dims_size; + for (i = 0; i < lim; i++) + dims[i] = vector_dimension(vec, i); + return(lim); + } dims[0] = vector_length(vec); - return(dims); + return(1); } -s7_int *s7_vector_offsets(s7_pointer vec) +s7_int s7_vector_dimension(s7_pointer vec, s7_int dim) { - static s7_int *offs = NULL; if (vector_dimension_info(vec)) - return(vector_offsets(vec)); - if (!offs) offs = (s7_int *)malloc(sizeof(s7_int)); + return(vector_dimension(vec, dim)); + if (dim == 0) + return(vector_length(vec)); + return(-1); +} + +s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size) +{ + if (offs_size <= 0) return(0); + if (vector_dimension_info(vec)) + { + s7_int i, lim; + lim = vector_ndims(vec); + if (lim > offs_size) lim = offs_size; + for (i = 0; i < lim; i++) + offs[i] = vector_offset(vec, i); + return(lim); + } offs[0] = 1; - return(offs); + return(1); } @@ -35802,7 +35748,7 @@ static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args) * which is too much trouble. */ #define H_vector_append "(vector-append . vectors) returns a new (1-dimensional) vector containing the elements of its vector arguments." - #define Q_vector_append pcl_v + #define Q_vector_append sc->pcl_v s7_pointer p; int32_t i; @@ -35849,21 +35795,21 @@ static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args) return(vector_append(sc, args, type(car(args)))); } -static s7_pointer vector_append_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer vector_append_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { s7_pointer val; - cur_sc->temp7 = list_2(cur_sc, p1, p2); - val = g_vector_append(cur_sc, cur_sc->temp7); - cur_sc->temp7 = cur_sc->nil; + sc->temp7 = list_2(sc, p1, p2); + val = g_vector_append(sc, sc->temp7); + sc->temp7 = sc->nil; return(val); } -static s7_pointer vector_append_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer vector_append_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { s7_pointer val; - cur_sc->temp7 = list_3(cur_sc, p1, p2, p3); - val = g_vector_append(cur_sc, cur_sc->temp7); - cur_sc->temp7 = cur_sc->nil; + sc->temp7 = list_3(sc, p1, p2, p3); + val = g_vector_append(sc, sc->temp7); + sc->temp7 = sc->nil; return(val); } #endif @@ -35890,9 +35836,8 @@ s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ... { s7_int i; s7_int *offsets, *dimensions; - - dimensions = s7_vector_dimensions(vector); - offsets = s7_vector_offsets(vector); + dimensions = vector_dimensions(vector); + offsets = vector_offsets(vector); for (i = 0; i < indices; i++) { @@ -35902,7 +35847,7 @@ s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ... (ind >= dimensions[i])) { va_end(ap); - return(out_of_range(sc, sc->vector_ref_symbol, small_int(i), wrap_integer(ind), (ind < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->vector_ref_symbol, small_int(i), wrap_integer1(sc, ind), (ind < 0) ? its_negative_string : its_too_large_string)); } index += (ind * offsets[i]); } @@ -35935,9 +35880,8 @@ s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s { s7_int i; s7_int *offsets, *dimensions; - - dimensions = s7_vector_dimensions(vector); - offsets = s7_vector_offsets(vector); + dimensions = vector_dimensions(vector); + offsets = vector_offsets(vector); for (i = 0; i < indices; i++) { @@ -36016,12 +35960,12 @@ static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args) return(p); } -static s7_pointer vector_to_list_p_p(s7_pointer p) +static s7_pointer vector_to_list_p_p(s7_scheme *sc, s7_pointer p) { s7_pointer val; - cur_sc->temp7 = list_1(cur_sc, p); - val = g_vector_to_list(cur_sc, cur_sc->temp7); - cur_sc->temp7 = cur_sc->nil; + sc->temp7 = list_1(sc, p); + val = g_vector_to_list(sc, sc->temp7); + sc->temp7 = sc->nil; return(val); } #endif @@ -36060,7 +36004,7 @@ static s7_pointer g_vector(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args) { #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogeneous float vector" - #define Q_is_float_vector pl_bt + #define Q_is_float_vector sc->pl_bt check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args); } @@ -36093,7 +36037,7 @@ static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args) { #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogeneous s7_int vector" - #define Q_is_int_vector pl_bt + #define Q_is_int_vector sc->pl_bt check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args); } @@ -36157,48 +36101,88 @@ static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args) return(make_integer(sc, vector_length(vec))); } -static s7_int vector_length_i(s7_pointer p) +static s7_int vector_length_i_7p(s7_scheme *sc, s7_pointer p) { if (!s7_is_vector(p)) - simple_wrong_type_argument(cur_sc, cur_sc->vector_length_symbol, p, T_VECTOR); + simple_wrong_type_argument(sc, sc->vector_length_symbol, p, T_VECTOR); return(vector_length(p)); } #endif -/* -------------------------------- make-shared-vector -------------------------------- */ -static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, s7_int skip_dims, s7_int index) +/* -------------------------------- subvector -------------------------------- */ + +static bool s7_is_subvector(s7_pointer g) {return((s7_is_vector(g)) && (is_subvector(g)));} + +static s7_pointer g_is_subvector(s7_scheme *sc, s7_pointer args) { - s7_pointer x; - vdims_t *v; + #define H_is_subvector "(subvector? obj) returns #t if obj is a subvector" + #define Q_is_subvector sc->pl_bt - /* (let ((v #2d((1 2) (3 4)))) (v 1)) - * (let ((v (make-vector '(2 3 4) 0))) (v 1 2)) - * (let ((v #3d(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23))))) (v 0 1)) - */ + check_boolean_method(sc, s7_is_subvector, sc->is_subvector_symbol, args); +} + +static s7_pointer g_subvector_position(s7_scheme *sc, s7_pointer args) +{ + #define H_subvector_position "(subvector-position obj) returns obj's offset" + #define Q_subvector_position s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_subvector_symbol) + + s7_pointer sv; + sv = car(args); + if (s7_is_subvector(sv)) + return(make_integer(sc, (s7_int)(vector_elements(sv) - vector_elements(subvector_vector(sv))))); + + return(method_or_bust_one_arg(sc, sv, sc->subvector_position_symbol, args, T_VECTOR)); +} + +static s7_pointer g_subvector_vector(s7_scheme *sc, s7_pointer args) +{ + #define H_subvector_vector "(subvector-vector obj) returns the vector underlying the subvector obj" + #define Q_subvector_vector s7_make_signature(sc, 2, sc->is_vector_symbol, sc->is_subvector_symbol) + + if (s7_is_subvector(car(args))) + return(subvector_vector(car(args))); + return(method_or_bust_one_arg(sc, car(args), sc->subvector_vector_symbol, args, T_VECTOR)); +} - new_cell(sc, x, typeflag(vect) | T_SAFE_PROCEDURE); /* typeflag(vect) picks up T_IMMUTABLE */ +static s7_pointer subvector(s7_scheme *sc, s7_pointer vect, s7_int skip_dims, s7_int index) +{ + s7_pointer x; + s7_int dims; + + new_cell(sc, x, typeflag(vect) | T_SUBVECTOR | T_SAFE_PROCEDURE); /* typeflag(vect) picks up T_IMMUTABLE */ vector_length(x) = 0; - vector_block(x) = mallocate_vector(0); + vector_block(x) = mallocate_vector(sc, 0); vector_elements(x) = NULL; vector_getter(x) = vector_getter(vect); vector_setter(x) = vector_setter(vect); - v = (vdims_t *)mallocate_block(); - vdims_ndims(v) = vector_ndims(vect) - skip_dims; - vdims_dims(v) = (s7_int *)(vector_dimensions(vect) + skip_dims); - vdims_offsets(v) = (s7_int *)(vector_offsets(vect) + skip_dims); - vdims_original(v) = vect; /* shared_vector */ + dims = vector_ndims(vect) - skip_dims; + if (dims > 1) + { + vdims_t *v; + v = (vdims_t *)mallocate_block(sc); + vdims_ndims(v) = dims; + vdims_dims(v) = (s7_int *)(vector_dimensions(vect) + skip_dims); + vdims_offsets(v) = (s7_int *)(vector_offsets(vect) + skip_dims); + vdims_original(v) = vect; + vector_elements_should_be_freed(v) = false; + vector_set_dimension_info(x, v); + } + else + { + vector_set_dimension_info(x, NULL); + subvector_set_vector(x, vect); + } + if (is_normal_vector(vect)) mark_function[T_VECTOR] = mark_vector_possibly_shared; else mark_function[type(vect)] = mark_int_or_float_vector_possibly_shared; - vector_elements_should_be_freed(v) = false; - vector_set_dimension_info(x, v); if (skip_dims > 0) vector_length(x) = vector_offset(vect, skip_dims - 1); else vector_length(x) = vector_length(vect); - + if (is_int_vector(vect)) int_vector_elements(x) = (s7_int *)(int_vector_elements(vect) + index); else @@ -36211,7 +36195,6 @@ static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, s7_int skip return(x); } - static vdims_t *list_to_dims(s7_scheme *sc, s7_pointer x) { s7_int i, offset, len; @@ -36220,7 +36203,7 @@ static vdims_t *list_to_dims(s7_scheme *sc, s7_pointer x) s7_int *ds, *os; len = safe_list_length(x); - v = (vdims_t *)mallocate(len * 2 * sizeof(s7_int)); + v = (vdims_t *)mallocate(sc, len * 2 * sizeof(s7_int)); vdims_ndims(v) = len; vdims_offsets(v) = (s7_int *)(vdims_dims(v) + len); vector_elements_should_be_freed(v) = false; @@ -36238,23 +36221,22 @@ static vdims_t *list_to_dims(s7_scheme *sc, s7_pointer x) return(v); } -static s7_pointer g_make_shared_vector(s7_scheme *sc, s7_pointer args) +static s7_pointer g_subvector(s7_scheme *sc, s7_pointer args) { - #define H_make_shared_vector "(make-shared-vector original-vector new-dimensions (offset 0)) returns \ + #define H_subvector "(subvector original-vector new-dimensions (offset 0)) returns \ a vector that points to the same elements as the original-vector but with different dimensional info." - #define Q_make_shared_vector s7_make_signature(sc, 4, sc->is_vector_symbol, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_integer_symbol), sc->is_integer_symbol) + #define Q_subvector s7_make_signature(sc, 4, sc->is_subvector_symbol, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_integer_symbol), sc->is_integer_symbol) - /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) -> #(1 2 3 4 5 6) - * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6)) - * this is most useful in generic functions -- they can still use (v n) as the accessor. + /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (subvector v1 '(6)))) v2)) -> #(1 2 3 4 5 6) + * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (subvector v1 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6)) */ s7_pointer orig, dims, x; vdims_t *v; - s7_int i, new_len, orig_len, offset = 0; + s7_int new_len, orig_len, offset = 0; orig = car(args); if (!s7_is_vector(orig)) - return(method_or_bust(sc, orig, sc->make_shared_vector_symbol, args, T_VECTOR, 1)); + return(method_or_bust(sc, orig, sc->subvector_symbol, args, T_VECTOR, 1)); orig_len = vector_length(orig); @@ -36267,55 +36249,58 @@ a vector that points to the same elements as the original-vector but with differ offset = s7_integer(off); if ((offset < 0) || (offset >= orig_len)) /* we need this if, for example, offset == 9223372036854775807 */ - return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(3), off, (offset < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->subvector_symbol, small_int(3), off, (offset < 0) ? its_negative_string : its_too_large_string)); } - else return(method_or_bust(sc, off, sc->make_shared_vector_symbol, args, T_INTEGER, 3)); + else return(method_or_bust(sc, off, sc->subvector_symbol, args, T_INTEGER, 3)); } dims = cadr(args); if (is_integer(dims)) { - if ((s7_integer(dims) < 0) || - (s7_integer(dims) >= orig_len)) - return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, (s7_integer(dims) < 0) ? its_negative_string : its_too_large_string)); - dims = list_1(sc, dims); + new_len = s7_integer(dims); + if ((new_len < 0) || + ((new_len + offset) > orig_len)) + return(out_of_range(sc, sc->subvector_symbol, small_int(2), dims, (new_len < 0) ? its_negative_string : its_too_large_string)); + v = NULL; } else { s7_pointer y; + s7_int i; if ((is_null(dims)) || (!s7_is_proper_list(sc, dims))) - return(method_or_bust(sc, dims, sc->make_shared_vector_symbol, args, T_PAIR, 2)); + return(method_or_bust(sc, dims, sc->subvector_symbol, args, T_PAIR, 2)); for (y = dims; is_pair(y); y = cdr(y)) - if ((!s7_is_integer(car(y))) || /* (make-shared-vector v '((1 2) (3 4))) */ + if ((!s7_is_integer(car(y))) || /* (subvector v '((1 2) (3 4))) */ (s7_integer(car(y)) > orig_len) || (s7_integer(car(y)) < 0)) return(s7_error(sc, sc->wrong_type_arg_symbol, - set_elist_1(sc, wrap_string(sc, "make-shared-vector: new dimensions should be a list of integers that fits the original vector", 93)))); - } + set_elist_1(sc, wrap_string(sc, "subvector: new dimensions should be a list of integers that fits the original vector", 93)))); - v = list_to_dims(sc, dims); + v = list_to_dims(sc, dims); - new_len = vdims_dims(v)[0]; - for (i = 1; i < vdims_ndims(v); i++) - new_len *= vdims_dims(v)[i]; - if ((new_len < 0) || - ((new_len + offset) > vector_length(orig))) - { - liberate(v); - return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, - wrap_string(sc, "a shared vector has to fit in the original vector", 49))); + new_len = vdims_dims(v)[0]; + for (i = 1; i < vdims_ndims(v); i++) + new_len *= vdims_dims(v)[i]; + if ((new_len < 0) || + ((new_len + offset) > vector_length(orig))) + { + liberate(sc, v); + return(out_of_range(sc, sc->subvector_symbol, small_int(2), dims, + wrap_string(sc, "a subvector has to fit in the original vector", 45))); + } + vdims_original(v) = orig; } - vdims_original(v) = orig; /* shared_vector */ if (is_normal_vector(orig)) mark_function[T_VECTOR] = mark_vector_possibly_shared; else mark_function[type(orig)] = mark_int_or_float_vector_possibly_shared; - new_cell(sc, x, typeflag(orig) | T_SAFE_PROCEDURE); - vector_block(x) = mallocate_vector(0); + new_cell(sc, x, typeflag(orig) | T_SUBVECTOR | T_SAFE_PROCEDURE); + vector_block(x) = mallocate_vector(sc, 0); vector_set_dimension_info(x, v); + if (!v) subvector_set_vector(x, orig); vector_length(x) = new_len; /* might be less than original length */ vector_getter(x) = vector_getter(orig); vector_setter(x) = vector_setter(orig); @@ -36335,7 +36320,7 @@ a vector that points to the same elements as the original-vector but with differ /* -------------------------------- vector-ref -------------------------------- */ -static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices) +static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices, bool implicit_ok) { s7_int index = 0; if (vector_length(vect) == 0) @@ -36361,20 +36346,26 @@ static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indice else n = s7_integer(p); if ((n < 0) || (n >= vector_dimension(vect, i))) - return(out_of_range(sc, sc->vector_ref_symbol, wrap_integer(i + 2), p, (n < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->vector_ref_symbol, wrap_integer1(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string)); index += n * vector_offset(vect, i); } if (is_not_null(x)) { + s7_pointer nv; if (!is_normal_vector(vect)) return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string)); - return(implicit_index(sc, vector_element(vect, index), x)); + nv = vector_element(vect, index); + if (s7_is_vector(nv)) + return(vector_ref_1(sc, nv, x, implicit_ok)); + if (implicit_ok) + return(implicit_index(sc, nv, x)); + return(wrong_type_argument(sc, sc->vector_ref_symbol, i + 1, nv, T_VECTOR)); } - /* if not enough indices, return a shared vector covering whatever is left */ + /* if not enough indices, return a subvector covering whatever is left */ if (i < vector_ndims(vect)) - return(make_shared_vector(sc, vect, i, index)); + return(subvector(sc, vect, i, index)); } else { @@ -36397,9 +36388,15 @@ static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indice if (is_not_null(cdr(indices))) /* (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */ { + s7_pointer nv; if (!is_normal_vector(vect)) return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string)); - return(implicit_index(sc, vector_element(vect, index), cdr(indices))); + nv = vector_element(vect, index); + if (s7_is_vector(nv)) + return(vector_ref_1(sc, nv, cdr(indices), implicit_ok)); + if (implicit_ok) + return(implicit_index(sc, nv, cdr(indices))); + return(wrong_type_argument(sc, sc->vector_ref_symbol, 1, nv, T_VECTOR)); } } return((vector_getter(vect))(sc, vect, index)); @@ -36416,7 +36413,7 @@ static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args) vec = car(args); if (!s7_is_vector(vec)) return(method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1)); - return(vector_ref_1(sc, vec, cdr(args))); + return(vector_ref_1(sc, vec, cdr(args), false)); } static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index) @@ -36432,42 +36429,36 @@ static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index { if (index >= vector_dimension(vec, 0)) return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), cadr(args), its_too_large_string)); - return(make_shared_vector(sc, vec, 1, index * vector_offset(vec, 0))); + return(subvector(sc, vec, 1, index * vector_offset(vec, 0))); } return(vector_getter(vec)(sc, vec, index)); } -static s7_pointer vector_ref_p_pi(s7_pointer v, s7_int i) +static s7_pointer vector_ref_p_pi(s7_scheme *sc, s7_pointer v, s7_int i) { if ((!s7_is_vector(v)) || (vector_rank(v) > 1) || (i < 0) || (i >= vector_length(v))) - return(g_vector_ref(cur_sc, set_plist_2(cur_sc, v, make_integer(cur_sc, i)))); - return(vector_getter(v)(cur_sc, v, i)); + return(g_vector_ref(sc, set_plist_2(sc, v, make_integer(sc, i)))); + return(vector_getter(v)(sc, v, i)); } -static s7_pointer vector_ref_p_pi_direct(s7_pointer v, s7_int i) +static s7_pointer vector_ref_p_pi_direct(s7_scheme *sc, s7_pointer v, s7_int i) { if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->vector_ref_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); - return(vector_getter(v)(cur_sc, v, i)); + out_of_range(sc, sc->vector_ref_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); + return(vector_getter(v)(sc, v, i)); } -static s7_pointer vector_ref_unchecked(s7_pointer v, s7_int i) {return(vector_getter(v)(cur_sc, v, i));} +static s7_pointer vector_ref_unchecked(s7_scheme *sc, s7_pointer v, s7_int i) {return(vector_getter(v)(sc, v, i));} -static s7_pointer vector_ref_ic; static s7_pointer g_vector_ref_ic(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, s7_integer(cadr(args))));} -static s7_pointer vector_ref_ic_0; static s7_pointer g_vector_ref_ic_0(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 0));} -static s7_pointer vector_ref_ic_1; static s7_pointer g_vector_ref_ic_1(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 1));} -static s7_pointer vector_ref_ic_2; static s7_pointer g_vector_ref_ic_2(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 2));} -static s7_pointer vector_ref_ic_3; static s7_pointer g_vector_ref_ic_3(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 3));} -static s7_pointer vector_ref_2; static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args) { s7_pointer vec, ind; @@ -36491,7 +36482,6 @@ static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args) return(vector_getter(vec)(sc, vec, index)); } -static s7_pointer vector_ref_2_direct; static s7_pointer g_vector_ref_2_direct(s7_scheme *sc, s7_pointer args) { s7_pointer vec, ind; @@ -36546,7 +36536,7 @@ static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args) else n = s7_integer(p); if ((n < 0) || (n >= vector_dimension(vec, i))) - return(out_of_range(sc, sc->vector_set_symbol, wrap_integer(i + 2), p, (n < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->vector_set_symbol, wrap_integer1(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string)); index += n * vector_offset(vec, i); } @@ -36590,32 +36580,31 @@ static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args) return(val); } -static s7_pointer vector_set_p_pip(s7_pointer v, s7_int i, s7_pointer p) +static s7_pointer vector_set_p_pip(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { if ((!s7_is_vector(v)) || (vector_rank(v) > 1) || (i < 0) || (i >= vector_length(v))) - return(g_vector_set(cur_sc, set_plist_3(cur_sc, v, make_integer(cur_sc, i), p))); - vector_setter(v)(cur_sc, v, i, p); + return(g_vector_set(sc, set_plist_3(sc, v, make_integer(sc, i), p))); + vector_setter(v)(sc, v, i, p); return(p); } -static s7_pointer vector_set_p_pip_direct(s7_pointer v, s7_int i, s7_pointer p) +static s7_pointer vector_set_p_pip_direct(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->vector_set_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); vector_element(v, i) = p; return(p); } -static s7_pointer vector_set_unchecked(s7_pointer v, s7_int i, s7_pointer p) +static s7_pointer vector_set_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { vector_element(v, i) = p; return(p); } -static s7_pointer vector_set_ic; static s7_pointer g_vector_set_ic(s7_scheme *sc, s7_pointer args) { /* (vector-set! vec 0 x) */ @@ -36642,7 +36631,6 @@ static s7_pointer g_vector_set_ic(s7_scheme *sc, s7_pointer args) } -static s7_pointer vector_set_3; static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args) { s7_pointer ind, vec, val; @@ -36668,7 +36656,7 @@ static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args) else index = s7_integer(ind); if ((index < 0) || (index >= vector_length(vec))) - return(out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer(index), (index < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer1(sc, index), (index < 0) ? its_negative_string : its_too_large_string)); val = caddr(args); vector_setter(vec)(sc, vec, index, val); @@ -36803,10 +36791,10 @@ static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args) return(method_or_bust(sc, init, sc->make_float_vector_symbol, args, T_REAL, 2)); #if WITH_GMP if (s7_is_bignum(init)) - return(g_make_vector_1(sc, set_plist_3(sc, p, wrap_real(s7_real(init)), sc->T), sc->make_float_vector_symbol)); + return(g_make_vector_1(sc, set_plist_3(sc, p, wrap_real(sc, s7_real(init)), sc->T), sc->make_float_vector_symbol)); #endif if (is_rational(init)) - return(g_make_vector_1(sc, set_plist_3(sc, p, wrap_real(rational_to_double(sc, init)), sc->T), sc->make_float_vector_symbol)); + return(g_make_vector_1(sc, set_plist_3(sc, p, wrap_real(sc, rational_to_double(sc, init)), sc->T), sc->make_float_vector_symbol)); } else init = real_zero; return(g_make_vector_1(sc, set_plist_3(sc, p, init, sc->T), sc->make_float_vector_symbol)); @@ -36818,7 +36806,7 @@ static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args) if (len > sc->max_vector_length) return(out_of_range(sc, sc->make_float_vector_symbol, small_int(1), p, its_too_large_string)); - arr = mallocate_vector(len * sizeof(s7_double)); + arr = mallocate_vector(sc, len * sizeof(s7_double)); new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE); vector_length(x) = len; vector_block(x) = arr; @@ -36869,7 +36857,7 @@ static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args) if (len > sc->max_vector_length) return(out_of_range(sc, sc->make_int_vector_symbol, small_int(1), p, its_too_large_string)); - arr = mallocate_vector(len * sizeof(s7_int)); + arr = mallocate_vector(sc, len * sizeof(s7_int)); new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE); vector_length(x) = len; vector_block(x) = arr; @@ -36893,7 +36881,7 @@ static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args) { #define H_is_vector "(vector? obj) returns #t if obj is a vector" - #define Q_is_vector pl_bt + #define Q_is_vector sc->pl_bt check_boolean_method(sc, s7_is_vector, sc->is_vector_symbol, args); } @@ -36992,9 +36980,9 @@ static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data) */ if (dims <= 0) /* #0d(...) #2147483649D() [if dims is int32_t this is negative] */ - return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, wrap_integer(dims), "must be 1 or more")); + return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, wrap_integer1(sc, dims), "must be 1 or more")); if (dims > sc->max_vector_dimensions) - return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, wrap_integer(dims), "must be < 512")); /* sc->max_vector_dimensions=512 currently */ + return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, wrap_integer1(sc, dims), "must be < 512")); /* sc->max_vector_dimensions=512 currently */ sc->w = sc->nil; if (is_null(data)) /* dims are already 0 (calloc above) */ @@ -37173,16 +37161,16 @@ static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, bool flt) else n = s7_integer(car(x)); if ((n < 0) || (n >= vector_dimension(v, i))) - return(out_of_range(sc, caller, wrap_integer(i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, caller, wrap_integer1(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string)); ind += n * vector_offset(v, i); } if (is_not_null(x)) return(out_of_range(sc, caller, small_int(2), cdr(args), too_many_indices_string)); - /* if not enough indices, return a shared vector covering whatever is left */ + /* if not enough indices, return a subvector covering whatever is left */ if (i < vector_ndims(v)) - return(make_shared_vector(sc, v, i, ind)); + return(subvector(sc, v, i, ind)); } if (flt) return(make_real(sc, float_vector_element(v, ind))); @@ -37224,7 +37212,7 @@ static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, bool flt) else n = s7_integer(car(x)); if ((n < 0) || (n >= vector_dimension(vec, i))) - return(out_of_range(sc, caller, wrap_integer(i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string)); + return(out_of_range(sc, caller, wrap_integer1(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string)); index += n * vector_offset(vec, i); } @@ -37281,7 +37269,6 @@ static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args) return(univect_ref(sc, args, true)); } -static s7_pointer fv_ref; static s7_pointer g_fv_ref(s7_scheme *sc, s7_pointer args) { s7_pointer fv, index; @@ -37300,7 +37287,6 @@ static s7_pointer g_fv_ref(s7_scheme *sc, s7_pointer args) return(make_real(sc, float_vector_element(fv, ind))); } -static s7_pointer fv_ref_3; static s7_pointer g_fv_ref_3(s7_scheme *sc, s7_pointer args) { s7_pointer fv, index; @@ -37326,23 +37312,23 @@ static s7_pointer g_fv_ref_3(s7_scheme *sc, s7_pointer args) return(make_real(sc, float_vector_element(fv, ind1))); } -static s7_double float_vector_ref_unchecked(s7_pointer v, s7_int i) {return(float_vector_element(v, i));} -static s7_int ref_check_index(s7_pointer v, s7_int i) +static s7_double float_vector_ref_unchecked(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector_element(v, i));} +static s7_int ref_check_index(s7_scheme *sc, s7_pointer v, s7_int i) { /* according to valgrind, it is faster to split out the bounds check */ if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->float_vector_ref_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); return(i); } -static s7_double float_vector_ref_d(s7_pointer v, s7_int i) {return(float_vector_element(v, ref_check_index(v, i)));} -static s7_pointer float_vector_ref_unchecked_p(s7_pointer v, s7_int i) {return(float_vector_getter(cur_sc, v, i));} +static s7_double float_vector_ref_d_7pi(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector_element(v, ref_check_index(sc, v, i)));} +static s7_pointer float_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector_getter(sc, v, i));} static s7_pointer float_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(fv_ref); + return(sc->fv_ref); if (args == 3) - return(fv_ref_3); + return(sc->fv_ref_3); return(f); } @@ -37354,7 +37340,6 @@ static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args) return(univect_set(sc, args, true)); } -static s7_pointer fv_set; static s7_pointer g_fv_set(s7_scheme *sc, s7_pointer args) { s7_pointer fv, index, value; @@ -37379,22 +37364,77 @@ static s7_pointer g_fv_set(s7_scheme *sc, s7_pointer args) return(value); } +static s7_pointer g_fv_set_unchecked(s7_scheme *sc, s7_pointer args) +{ + s7_pointer fv, value; + s7_int ind; + value = caddr(args); + if (!s7_is_real(value)) + return(wrong_type_argument(sc, sc->float_vector_set_symbol, 3, value, T_REAL)); + fv = car(args); + if (is_immutable(fv)) + return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->float_vector_set_symbol, fv))); + ind = s7_integer(cadr(args)); + float_vector_element(fv, ind) = s7_real(value); + return(value); +} + +static bool find_matching_ref(s7_scheme *sc, s7_pointer getter, s7_pointer expr) +{ + /* expr: (*set! v i val), val exists (i.e. args=3, so cddddr is null) */ + s7_pointer v, ind; + v = cadr(expr); + ind = caddr(expr); + if ((is_symbol(v)) && (!is_pair(ind))) + { + s7_pointer val; + val = cadddr(expr); + if (is_optimized(val)) /* includes is_pair */ + { + s7_pointer p; + for (p = val; is_pair(p); p = cdr(p)) + if (is_pair(car(p))) + { + s7_pointer ref; + ref = car(p); + if ((car(ref) == getter) && + (is_pair(cdr(ref))) && + (cadr(ref) == v) && + (is_pair(cddr(ref))) && + (caddr(ref) == ind) && + (is_null(cdddr(ref)))) + return(true); + if ((car(ref) == v) && + (is_pair(cdr(ref))) && + (cadr(ref) == ind) && + (is_null(cddr(ref)))) + return(true); + } + } + } + return(false); +} + static s7_pointer float_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 3) - return(fv_set); + { + if (find_matching_ref(sc, sc->float_vector_ref_symbol, expr)) + return(sc->fv_set_unchecked); + return(sc->fv_set); + } return(f); } -static s7_double float_vector_set_unchecked(s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, i) = x; return(x);} -static s7_int set_check_index(s7_pointer v, s7_int i) +static s7_double float_vector_set_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, i) = x; return(x);} +static s7_int set_check_index(s7_scheme *sc, s7_pointer v, s7_int i) { if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->float_vector_set_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->float_vector_set_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); return(i); } -static s7_double float_vector_set_d(s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, (set_check_index(v, i))) = x; return(x);} -static s7_pointer float_vector_set_unchecked_p(s7_pointer v, s7_int i, s7_pointer p) {return(float_vector_setter(cur_sc, v, i, p));} +static s7_double float_vector_set_d_7pid(s7_scheme *sc, s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, (set_check_index(sc, v, i))) = x; return(x);} +static s7_pointer float_vector_set_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) {return(float_vector_setter(sc, v, i, p));} /* -------------------------------- int-vector-ref -------------------------------- */ @@ -37406,16 +37446,15 @@ static s7_pointer g_int_vector_ref(s7_scheme *sc, s7_pointer args) return(univect_ref(sc, args, false)); } -static s7_int int_vector_ref_unchecked(s7_pointer v, s7_int i) {return(int_vector_element(v, i));} -static s7_int int_vector_ref_i(s7_pointer v, s7_int i) +static s7_int int_vector_ref_unchecked(s7_scheme *sc, s7_pointer v, s7_int i) {return(int_vector_element(v, i));} +static s7_int int_vector_ref_i_7pi(s7_scheme *sc, s7_pointer v, s7_int i) { if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->int_vector_ref_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->int_vector_ref_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); return(int_vector_element(v, i)); } -static s7_pointer int_vector_ref_unchecked_p(s7_pointer v, s7_int i) {return(int_vector_getter(cur_sc, v, i));} +static s7_pointer int_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i) {return(int_vector_getter(sc, v, i));} -static s7_pointer iv_ref; static s7_pointer g_iv_ref(s7_scheme *sc, s7_pointer args) { s7_pointer v, index; @@ -37437,7 +37476,7 @@ static s7_pointer g_iv_ref(s7_scheme *sc, s7_pointer args) static s7_pointer int_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(iv_ref); + return(sc->iv_ref); return(f); } @@ -37450,17 +37489,16 @@ static s7_pointer g_int_vector_set(s7_scheme *sc, s7_pointer args) return(univect_set(sc, args, false)); } -static s7_int int_vector_set_unchecked(s7_pointer v, s7_int i, s7_int x) {int_vector_element(v, i) = x; return(x);} -static s7_int int_vector_set_i(s7_pointer v, s7_int i, s7_int x) +static s7_int int_vector_set_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_int x) {int_vector_element(v, i) = x; return(x);} +static s7_int int_vector_set_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i, s7_int x) { if ((i < 0) || (i >= vector_length(v))) - out_of_range(cur_sc, cur_sc->int_vector_set_symbol, small_int(2), wrap_integer(i), (i < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->int_vector_set_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); int_vector_element(v, i) = x; return(x); } -static s7_pointer int_vector_set_unchecked_p(s7_pointer v, s7_int i, s7_pointer p) {return(int_vector_setter(cur_sc, v, i, p));} +static s7_pointer int_vector_set_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) {return(int_vector_setter(sc, v, i, p));} -static s7_pointer iv_set; static s7_pointer g_iv_set(s7_scheme *sc, s7_pointer args) { s7_pointer v, index, value; @@ -37488,7 +37526,7 @@ static s7_pointer g_iv_set(s7_scheme *sc, s7_pointer args) static s7_pointer int_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 3) - return(iv_set); + return(sc->iv_set); return(f); } @@ -37602,108 +37640,193 @@ static int32_t chr_less_2(const void *f1, const void *f2) static int32_t chr_greater_2(const void *f1, const void *f2) {return(-chr_less_2(f1, f2));} #endif -static s7_scheme *compare_sc; -static s7_function compare_func; -static s7_pointer compare_args, compare_begin, compare_v1, compare_v2; -static opcode_t compare_op; -static s7_int compare_body_len = 0; +#if MS_WINDOWS || defined(__APPLE__) || defined(__FreeBSD__) +/* from stackoverflow */ +struct sort_r_data +{ + void *arg; + int (*compar)(const void *a1, const void *a2, void *aarg); +}; + +int sort_r_arg_swap(void *s, const void *aa, const void *bb) +{ + struct sort_r_data *ss = (struct sort_r_data*)s; + return (ss->compar)(aa, bb, ss->arg); +} +#endif + +/* qsort_r in Linux requires _GNU_SOURCE and is different from q_sort_r in FreeBSD, neither matches qsort_s in Windows + * this code tested only in Linux and the mac -- my virtualbox freebsd died, netbsd and openbsd run using fallback code. + */ +void local_qsort_r(void *base, size_t nmemb, size_t size, int (*compar)(const void *, const void *, void *), void *arg) +{ +#if defined(__linux__) + qsort_r(base, nmemb, size, compar, arg); +#else +#if defined(__APPLE__) || defined(__FreeBSD__) /* not in OpenBSD or NetBSD as far as I can tell */ + struct sort_r_data tmp = {arg, compar}; + qsort_r(base, nmemb, size, &tmp, &sort_r_arg_swap); +#else +#if MS_WINDOWS + struct sort_r_data tmp = {arg, compar}; + qsort_s(*base, nmemb, size, &sort_r_arg_swap, &tmp); +#else + /* from the Net somewhere, by "Pete", about 25 times slower than libc's qsort_r in this context */ + if (nmemb > 1) + { + uint8_t *array, *i, *j, *k; + size_t h, t; + uint8_t *after; + array = base; + after = nmemb * size + array; + nmemb /= 4; + h = nmemb + 1; + for (t = 1; nmemb != 0; nmemb /= 4) + t *= 2; + do { + size_t bytes; + bytes = h * size; + i = bytes + array; + do { + j = i - bytes; + if (compar(j, i, arg) > 0) + { + k = i; + do { + uint8_t *end, *p1, *p2; + p1 = j; + p2 = k; + end = p2 + size; + do { + uint8_t swap; + swap = *p1; + *p1++ = *p2; + *p2++ = swap; + } while (p2 != end); + if (bytes + array > j) + break; + k = j; + j -= bytes; + } while (compar(j, k, arg) > 0); + } + i += size; + } while (i != after); + t /= 2; + h = t * t - t * 3 / 2 + 1; + } while (t != 0); + } +#endif +#endif +#endif +} + static bool p_to_b(void *p); -static int32_t vector_compare(const void *v1, const void *v2) + +static int32_t vector_sort(const void *v1, const void *v2, void *arg) { - set_car(compare_args, (*(s7_pointer *)v1)); - set_cadr(compare_args, (*(s7_pointer *)v2)); - return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1); + s7_scheme *sc = (s7_scheme *)arg; + set_car(sc->sort_args, (*(s7_pointer *)v1)); + set_cadr(sc->sort_args, (*(s7_pointer *)v2)); + return(((*(sc->sort_func))(sc, sc->sort_args) != sc->F) ? -1 : 1); } -static int32_t vector_car_compare(const void *v1, const void *v2) +static int32_t vector_car_sort(const void *v1, const void *v2, void *arg) { + s7_scheme *sc = (s7_scheme *)arg; s7_pointer a, b; a = (*(s7_pointer *)v1); b = (*(s7_pointer *)v2); - set_car(compare_args, (is_pair(a)) ? car(a) : g_car(compare_sc, set_plist_1(compare_sc, a))); - set_cadr(compare_args, (is_pair(b)) ? car(b) : g_car(compare_sc, set_plist_1(compare_sc, b))); - return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1); + set_car(sc->sort_args, (is_pair(a)) ? car(a) : g_car(sc, set_plist_1(sc, a))); + set_cadr(sc->sort_args, (is_pair(b)) ? car(b) : g_car(sc, set_plist_1(sc, b))); + return(((*(sc->sort_func))(sc, sc->sort_args) != sc->F) ? -1 : 1); } -static int32_t vector_cdr_compare(const void *v1, const void *v2) +static int32_t vector_cdr_sort(const void *v1, const void *v2, void *arg) { + s7_scheme *sc = (s7_scheme *)arg; s7_pointer a, b; a = (*(s7_pointer *)v1); b = (*(s7_pointer *)v2); - set_car(compare_args, (is_pair(a)) ? cdr(a) : g_cdr(compare_sc, set_plist_1(compare_sc, a))); - set_cadr(compare_args, (is_pair(b)) ? cdr(b) : g_cdr(compare_sc, set_plist_1(compare_sc, b))); - return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1); + set_car(sc->sort_args, (is_pair(a)) ? cdr(a) : g_cdr(sc, set_plist_1(sc, a))); + set_cadr(sc->sort_args, (is_pair(b)) ? cdr(b) : g_cdr(sc, set_plist_1(sc, b))); + return(((*(sc->sort_func))(sc, sc->sort_args) != sc->F) ? -1 : 1); } -static int32_t opt_bool_compare(const void *v1, const void *v2) +static int32_t opt_bool_sort(const void *v1, const void *v2, void *arg) { - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - compare_sc->pc = 0; /* always opt_bool_call here, so insert it */ - return((compare_sc->opts[0]->v7.fb(compare_sc->opts[0])) ? -1 : 1); + s7_scheme *sc = (s7_scheme *)arg; + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + sc->pc = 0; /* always opt_bool_call here, so insert it */ + return((sc->opts[0]->v[0].fb(sc->opts[0])) ? -1 : 1); } -static int32_t opt_bool_compare_p(const void *v1, const void *v2) +static int32_t opt_bool_sort_p(const void *v1, const void *v2, void *arg) { - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - compare_sc->pc = 0; - return((compare_sc->opts[0]->v8.fp(compare_sc->opts[0]) == compare_sc->F) ? 1 : -1); + s7_scheme *sc = (s7_scheme *)arg; + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + sc->pc = 0; + return((sc->opts[0]->v[7].fp(sc->opts[0]) == sc->F) ? 1 : -1); } -static int32_t opt_begin_bool_compare_b(const void *v1, const void *v2) +static int32_t opt_begin_bool_sort_b(const void *v1, const void *v2, void *arg) { + s7_scheme *sc = (s7_scheme *)arg; s7_int i; opt_info *o; - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - compare_sc->pc = -1; - for (i = 0; i < compare_body_len - 1; i++) + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + sc->pc = -1; + for (i = 0; i < sc->sort_body_len - 1; i++) { - o = compare_sc->opts[++compare_sc->pc]; - o->v7.fp(o); + o = sc->opts[++sc->pc]; + o->v[0].fp(o); } - o = compare_sc->opts[++compare_sc->pc]; - return((o->v7.fb(o)) ? -1 : 1); + o = sc->opts[++sc->pc]; + return((o->v[0].fb(o)) ? -1 : 1); } -static int32_t opt_begin_bool_compare_p(const void *v1, const void *v2) +static int32_t opt_begin_bool_sort_p(const void *v1, const void *v2, void *arg) { + s7_scheme *sc = (s7_scheme *)arg; s7_int i; opt_info *o; s7_pointer val; - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - compare_sc->pc = -1; - for (i = 0; i < compare_body_len - 1; i++) + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + sc->pc = -1; + for (i = 0; i < sc->sort_body_len - 1; i++) { - o = compare_sc->opts[++compare_sc->pc]; - o->v7.fp(o); + o = sc->opts[++sc->pc]; + o->v[0].fp(o); } - o = compare_sc->opts[++compare_sc->pc]; - val = o->v7.fp(o); - return((val != compare_sc->F) ? -1 : 1); + o = sc->opts[++sc->pc]; + val = o->v[0].fp(o); + return((val != sc->F) ? -1 : 1); } -static int32_t closure_compare(const void *v1, const void *v2) +static int32_t closure_sort(const void *v1, const void *v2, void *arg) { - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code); - compare_sc->code = compare_args; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */ - eval(compare_sc, compare_op); - return((compare_sc->value != compare_sc->F) ? -1 : 1); + s7_scheme *sc = (s7_scheme *)arg; + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + push_stack(sc, OP_EVAL_DONE, sc->sort_args, sc->code); + sc->code = sc->sort_args; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */ + eval(sc, sc->sort_op); + return((sc->value != sc->F) ? -1 : 1); } -static int32_t closure_compare_begin(const void *v1, const void *v2) +static int32_t closure_sort_begin(const void *v1, const void *v2, void *arg) { - slot_set_value(compare_v1, (*(s7_pointer *)v1)); - slot_set_value(compare_v2, (*(s7_pointer *)v2)); - push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code); - push_stack_no_args(compare_sc, OP_BEGIN1, compare_begin); - compare_sc->code = compare_args; - eval(compare_sc, compare_op); - return((compare_sc->value != compare_sc->F) ? -1 : 1); + s7_scheme *sc = (s7_scheme *)arg; + slot_set_value(sc->sort_v1, (*(s7_pointer *)v1)); + slot_set_value(sc->sort_v2, (*(s7_pointer *)v2)); + push_stack(sc, OP_EVAL_DONE, sc->sort_args, sc->code); + push_stack_no_args(sc, OP_BEGIN1, sc->sort_begin); + sc->code = sc->sort_args; + eval(sc, sc->sort_op); + return((sc->value != sc->F) ? -1 : 1); } static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) @@ -37713,7 +37836,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) s7_pointer data, lessp, lx; s7_int len = 0, n, k; - int32_t (*sort_func)(const void *v1, const void *v2); + int32_t (*sort_func)(const void *v1, const void *v2, void *arg); s7_pointer *elements; /* both the intermediate vector (if any) and the current args pointer need GC protection, @@ -37743,10 +37866,9 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) if (!s7_is_aritable(sc, lessp, 2)) return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, an_eq_func_string)); - sort_func = vector_compare; - compare_func = NULL; - compare_args = sc->t2_1; - compare_sc = sc; + sort_func = vector_sort; + sc->sort_func = NULL; + sc->sort_args = sc->t2_1; if ((is_safe_procedure(lessp)) && /* (sort! a <) */ (is_c_function(lessp))) @@ -37758,7 +37880,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) (car(sig) != sc->is_boolean_symbol)) return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, wrap_string(sc, "sort! function should return a boolean", 38))); - compare_func = c_function_call(lessp); + sc->sort_func = c_function_call(lessp); } else { @@ -37790,7 +37912,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) (cadr(largs) == caddr(expr))) { lessp = symbol_to_value_unchecked(sc, car(expr)); - compare_func = c_function_call(lessp); + sc->sort_func = c_function_call(lessp); } else { @@ -37801,15 +37923,15 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) (cadr(largs) == cadr(caddr(expr)))) { lessp = symbol_to_value_unchecked(sc, car(expr)); - compare_func = c_function_call(lessp); - sort_func = ((caadr(expr) == sc->car_symbol) ? vector_car_compare : vector_cdr_compare); + sc->sort_func = c_function_call(lessp); + sort_func = ((caadr(expr) == sc->car_symbol) ? vector_car_sort : vector_cdr_sort); } } set_optimize_op(expr, orig_data); } } - if (!compare_func) + if (!sc->sort_func) { s7_pointer init_val, old_e; if (is_float_vector(data)) @@ -37822,21 +37944,21 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) } old_e = sc->envir; new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), init_val, cadr(largs), init_val); - compare_args = expr; - compare_v1 = let_slots(sc->envir); - compare_v2 = next_slot(let_slots(sc->envir)); + sc->sort_args = expr; + sc->sort_v1 = let_slots(sc->envir); + sc->sort_v2 = next_slot(let_slots(sc->envir)); if (is_null(cdr(closure_body(lessp)))) { - compare_func = s7_bool_optimize(sc, closure_body(lessp)); - if (compare_func) + sc->sort_func = s7_bool_optimize(sc, closure_body(lessp)); + if (sc->sort_func) { - if (compare_func == opt_bool_any) + if (sc->sort_func == opt_bool_any) { - if (sc->opts[0]->v7.fb == p_to_b) - sort_func = opt_bool_compare_p; - else sort_func = opt_bool_compare; + if (sc->opts[0]->v[0].fb == p_to_b) + sort_func = opt_bool_sort_p; + else sort_func = opt_bool_sort; } - else compare_func = NULL; + else sc->sort_func = NULL; } } else @@ -37844,7 +37966,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) if (setjmp(sc->opt_exit) == 0) { s7_pointer p; - compare_body_len = s7_list_length(sc, closure_body(lessp)); + sc->sort_body_len = s7_list_length(sc, closure_body(lessp)); sc->pc = 0; for (p = closure_body(lessp); is_pair(cdr(p)); p = cdr(p)) if (!cell_optimize(sc, p)) @@ -37855,69 +37977,69 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) start = sc->pc; if (bool_optimize_nw(sc, p)) { - compare_func = opt_bool_any; - sort_func = opt_begin_bool_compare_b; + sc->sort_func = opt_bool_any; + sort_func = opt_begin_bool_sort_b; } else { pc_fallback(sc, start); if (cell_optimize(sc, p)) { - compare_func = opt_bool_any; - sort_func = opt_begin_bool_compare_p; + sc->sort_func = opt_bool_any; + sort_func = opt_begin_bool_sort_p; } } } } } - if (!compare_func) + if (!sc->sort_func) sc->envir = old_e; } - if ((!compare_func) && + if ((!sc->sort_func) && (is_safe_closure(lessp))) /* no embedded sort! or call/cc, etc */ { new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F); - compare_func = (s7_function)lessp; /* not used -- just a flag */ - compare_args = car(closure_body(lessp)); - compare_begin = cdr(closure_body(lessp)); - if (is_null(compare_begin)) - sort_func = closure_compare; - else sort_func = closure_compare_begin; - if (is_syntactic_pair(compare_args)) - compare_op = (opcode_t)optimize_op(compare_args); - else compare_op = OP_EVAL; - compare_v1 = let_slots(sc->envir); - compare_v2 = next_slot(let_slots(sc->envir)); + sc->sort_func = (s7_function)lessp; /* not used -- just a flag */ + sc->sort_args = car(closure_body(lessp)); + sc->sort_begin = cdr(closure_body(lessp)); + if (is_null(sc->sort_begin)) + sort_func = closure_sort; + else sort_func = closure_sort_begin; + if (is_syntactic_pair(sc->sort_args)) + sc->sort_op = (opcode_t)optimize_op(sc->sort_args); + else sc->sort_op = OP_EVAL; + sc->sort_v1 = let_slots(sc->envir); + sc->sort_v2 = next_slot(let_slots(sc->envir)); } } } } - if (compare_func == g_strings_are_less) - compare_func = g_string_less_2; + if (sc->sort_func == g_strings_are_less) + sc->sort_func = g_string_less_2; else { - if (compare_func == g_strings_are_greater) - compare_func = g_string_greater_2; + if (sc->sort_func == g_strings_are_greater) + sc->sort_func = g_string_greater_2; else { - if (compare_func == g_chars_are_less) - compare_func = g_char_less_2; + if (sc->sort_func == g_chars_are_less) + sc->sort_func = g_char_less_2; else { - if (compare_func == g_chars_are_greater) - compare_func = g_char_greater_2; + if (sc->sort_func == g_chars_are_greater) + sc->sort_func = g_char_greater_2; } } } #if (!WITH_GMP) - if (compare_func == g_less) - compare_func = g_less_2; + if (sc->sort_func == g_less) + sc->sort_func = g_less_2; else { - if (compare_func == g_greater) - compare_func = g_greater_2; + if (sc->sort_func == g_greater) + sc->sort_func = g_greater_2; } #endif @@ -37930,7 +38052,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) set_elist_2(sc, wrap_string(sc, "sort! argument 1 should be a proper list: ~S", 44), data))); if (len < 2) return(data); - if (compare_func) + if (sc->sort_func) { s7_int i; s7_pointer vec, p; @@ -37940,7 +38062,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) elements = s7_vector_elements(vec); sc->v = vec; - qsort((void *)elements, len, sizeof(s7_pointer), sort_func); + local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc); for (p = data, i = 0; i < len; i++, p = cdr(p)) set_car(p, elements[i]); @@ -37966,14 +38088,14 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) #if (!WITH_GMP) if (is_c_function(lessp)) { - if (((is_string(data)) && (compare_func == g_char_less_2)) || - ((is_byte_vector(data)) && (compare_func == g_less_2))) + if (((is_string(data)) && (sc->sort_func == g_char_less_2)) || + ((is_byte_vector(data)) && (sc->sort_func == g_less_2))) { qsort((void *)string_or_byte_vector_value(data), len, sizeof(uint8_t), byte_less); return(data); } - if (((is_string(data)) && (compare_func == g_char_greater_2)) || - ((is_byte_vector(data)) && (compare_func == g_greater_2))) + if (((is_string(data)) && (sc->sort_func == g_char_greater_2)) || + ((is_byte_vector(data)) && (sc->sort_func == g_greater_2))) { qsort((void *)string_or_byte_vector_value(data), len, sizeof(uint8_t), byte_greater); return(data); @@ -37998,10 +38120,10 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) elements[i] = chars[chrs[i]]; } - if (compare_func) + if (sc->sort_func) { sc->v = vec; - qsort((void *)elements, len, sizeof(s7_pointer), sort_func); + local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc); if (is_byte_vector(data)) { @@ -38035,14 +38157,14 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) #if (!WITH_GMP) if (is_c_function(lessp)) { - if (compare_func == g_less_2) + if (sc->sort_func == g_less_2) { if (is_float_vector(data)) qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_less); else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_less); return(data); } - if (compare_func == g_greater_2) + if (sc->sort_func == g_greater_2) { if (is_float_vector(data)) qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_greater); @@ -38052,7 +38174,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) } #endif - /* currently we have to make the ordinary vector here even if not compare_func + /* currently we have to make the ordinary vector here even if not sc->sort_func * because the sorter uses vector_element to access sort args (see SORT_DATA in eval). * This is probably better than passing down getter/setter (fewer allocations). * get/set macro in eval is SORT_DATA(k) then s7_vector_to_list if pair at start (sort_*_end) @@ -38069,10 +38191,10 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) for (i = 0; i < len; i++) elements[i] = vector_getter(data)(sc, data, i); - if (compare_func) + if (sc->sort_func) { sc->v = vec; - qsort((void *)elements, len, sizeof(s7_pointer), sort_func); + local_qsort_r((void *)elements, len, sizeof(s7_pointer), sort_func, (void *)sc); for (i = 0; i < len; i++) vector_setter(data)(sc, data, i, elements[i]); @@ -38090,15 +38212,15 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) len = vector_length(data); if (len < 2) return(data); - if (compare_func) + if (sc->sort_func) { - /* here if, for example, compare_func == string<?, we could precheck for strings, + /* here if, for example, sc->sort_func == string<?, we could precheck for strings, * then qsort without the type checks. Also common is (lambda (a b) (f (car a) (car b))). */ #if (!WITH_GMP) - if ((compare_func == g_less_2) || (compare_func == g_greater_2) || - (compare_func == g_string_less_2) || (compare_func == g_string_greater_2) || - (compare_func == g_char_less_2) || (compare_func == g_char_greater_2)) + if ((sc->sort_func == g_less_2) || (sc->sort_func == g_greater_2) || + (sc->sort_func == g_string_less_2) || (sc->sort_func == g_string_greater_2) || + (sc->sort_func == g_char_less_2) || (sc->sort_func == g_char_greater_2)) { int32_t typ; s7_pointer *els; @@ -38114,34 +38236,34 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args) break; } } - if ((compare_func == g_less_2) || (compare_func == g_greater_2)) + if ((sc->sort_func == g_less_2) || (sc->sort_func == g_greater_2)) { if (typ == T_INTEGER) { - qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? int_less_2 : int_greater_2)); + qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_func == g_less_2) ? int_less_2 : int_greater_2)); return(data); } if (typ == T_REAL) { - qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? dbl_less_2 : dbl_greater_2)); + qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_func == g_less_2) ? dbl_less_2 : dbl_greater_2)); return(data); } } if ((typ == T_STRING) && - ((compare_func == g_string_less_2) || (compare_func == g_string_greater_2))) + ((sc->sort_func == g_string_less_2) || (sc->sort_func == g_string_greater_2))) { - qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_string_less_2) ? str_less_2 : str_greater_2)); + qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_func == g_string_less_2) ? str_less_2 : str_greater_2)); return(data); } if ((typ == T_CHARACTER) && - ((compare_func == g_char_less_2) || (compare_func == g_char_greater_2))) + ((sc->sort_func == g_char_less_2) || (sc->sort_func == g_char_greater_2))) { - qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_char_less_2) ? chr_less_2 : chr_greater_2)); + qsort((void *)els, len, sizeof(s7_pointer), ((sc->sort_func == g_char_less_2) ? chr_less_2 : chr_greater_2)); return(data); } } #endif - qsort((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func); + local_qsort_r((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func, (void *)sc); return(data); } break; @@ -38243,7 +38365,7 @@ static s7_pointer vector_into_string(s7_pointer vect, s7_pointer dest) /* -------- hash tables -------- */ -static void free_hash_table(s7_pointer table) +static void free_hash_table(s7_scheme *sc, s7_pointer table) { hash_entry_t **entries; entries = hash_table_elements(table); @@ -38252,28 +38374,29 @@ static void free_hash_table(s7_pointer table) { s7_int i, len; len = hash_table_mask(table) + 1; + for (i = 0; i < len; i++) { hash_entry_t *p, *n; for (p = entries[i++]; p; p = n) { n = hash_entry_next(p); - liberate_block(p); + liberate_block(sc, p); } for (p = entries[i]; p; p = n) { n = hash_entry_next(p); - liberate_block(p); + liberate_block(sc, p); } } } - liberate(hash_table_block(table)); + liberate(sc, hash_table_block(table)); } -static hash_entry_t *make_hash_entry(s7_pointer key, s7_pointer value, s7_int raw_hash) +static hash_entry_t *make_hash_entry(s7_scheme *sc, s7_pointer key, s7_pointer value, s7_int raw_hash) { hash_entry_t *p; - p = (hash_entry_t *)mallocate_block(); + p = (hash_entry_t *)mallocate_block(sc); hash_entry_key(p) = key; hash_entry_set_value(p, value); hash_entry_set_raw_hash(p, raw_hash); @@ -38290,7 +38413,7 @@ bool s7_is_hash_table(s7_pointer p) static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args) { #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table" - #define Q_is_hash_table pl_bt + #define Q_is_hash_table sc->pl_bt check_boolean_method(sc, is_hash_table, sc->is_hash_table_symbol, args); } @@ -38306,10 +38429,10 @@ static s7_pointer g_hash_table_entries(s7_scheme *sc, s7_pointer args) return(make_integer(sc, hash_table_entries(car(args)))); } -static s7_int hash_table_entries_i(s7_pointer p) +static s7_int hash_table_entries_i_7p(s7_scheme *sc, s7_pointer p) { if (!is_hash_table(p)) - simple_wrong_type_argument(cur_sc, cur_sc->hash_table_entries_symbol, p, T_HASH_TABLE); + simple_wrong_type_argument(sc, sc->hash_table_entries_symbol, p, T_HASH_TABLE); return(hash_table_entries(p)); } @@ -38460,7 +38583,7 @@ static s7_int hash_map_vector(s7_scheme *sc, s7_pointer table, s7_pointer key) static s7_int hash_map_eq(s7_scheme *sc, s7_pointer table, s7_pointer key) { - return(heap_location(key)); + return(heap_location(key)); /* weird -- this can be negative and not unique */ } static s7_int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key) @@ -38474,7 +38597,7 @@ static s7_int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key) new_frame_with_slot(sc, closure_let(f), sc->envir, (is_symbol(car(args))) ? car(args) : caar(args), key); push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); if (is_pair(cdr(body))) - push_stack_no_args(sc, OP_BEGIN1, cdr(body)); + push_stack_no_args(sc, sc->begin_op, cdr(body)); sc->code = car(body); eval(sc, OP_EVAL); sc->envir = old_e; @@ -38940,7 +39063,7 @@ static hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer ke slot_set_value(next_slot(let_slots(sc->envir)), hash_entry_key(x)); push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); if (is_pair(cdr(body))) - push_stack_no_args(sc, OP_BEGIN1, cdr(body)); + push_stack_no_args(sc, sc->begin_op, cdr(body)); sc->code = car(body); eval(sc, OP_EVAL); if (is_true(sc, sc->value)) @@ -38983,7 +39106,7 @@ s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size) } } - els = (block_t *)callocate(size * sizeof(hash_entry_t *)); + els = (block_t *)callocate(sc, size * sizeof(hash_entry_t *)); if (!els) return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, wrap_string(sc, "make-hash-table allocation failed!", 34)))); @@ -39162,6 +39285,24 @@ static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args) return(s7_make_hash_table(sc, size)); } +static s7_pointer g_make_weak_hash_table(s7_scheme *sc, s7_pointer args) +{ + #define H_make_weak_hash_table "(make-weak-hash-table (size 8) eq-func) returns a new weak hash table" + #define Q_make_weak_hash_table s7_make_signature(sc, 3, sc->is_weak_hash_table_symbol, sc->is_integer_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_pair_symbol)) + s7_pointer table; + table = g_make_hash_table(sc, args); + set_weak_hash_table(table); + return(table); +} + +static s7_pointer g_is_weak_hash_table(s7_scheme *sc, s7_pointer args) +{ + #define H_is_weak_hash_table "(weak-hash-table? obj) returns #t if obj is a weak hash-table" + #define Q_is_weak_hash_table sc->pl_bt + #define is_weak_hash(p) ((is_hash_table(p)) && (is_weak_hash_table(p))) + check_boolean_method(sc, is_weak_hash, sc->is_weak_hash_table_symbol, args); +} + void init_hash_maps(void) { @@ -39254,7 +39395,7 @@ void init_hash_maps(void) } -static void resize_hash_table(s7_pointer table) +static void resize_hash_table(s7_scheme *sc, s7_pointer table) { /* resize the table */ s7_int hash_len, loc, i, old_size, new_size; @@ -39268,7 +39409,7 @@ static void resize_hash_table(s7_pointer table) old_size = hash_table_mask(table) + 1; new_size = old_size * 4; hash_len = new_size - 1; - np = (block_t *)callocate(new_size * sizeof(hash_entry_t *)); + np = (block_t *)callocate(sc, new_size * sizeof(hash_entry_t *)); new_els = (hash_entry_t **)(block_data(np)); old_els = hash_table_elements(table); @@ -39283,7 +39424,7 @@ static void resize_hash_table(s7_pointer table) new_els[loc] = x; } } - liberate(hash_table_block(table)); + liberate(sc, hash_table_block(table)); hash_table_set_block(table, np); hash_table_elements(table) = new_els; hash_table_mask(table) = new_size - 1; @@ -39307,23 +39448,23 @@ static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args) #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key in the hash table" #define Q_hash_table_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T) - s7_pointer table; + s7_pointer table, nt; table = car(args); if (!is_hash_table(table)) return(method_or_bust(sc, table, sc->hash_table_ref_symbol, args, T_HASH_TABLE, 1)); - /* - (define (href H . args) - (if (null? (cdr args)) - (hash-table-ref H (car args)) - (apply href (hash-table-ref H (car args)) (cdr args)))) - */ + nt = s7_hash_table_ref(sc, table, cadr(args)); if (is_null(cddr(args))) - return(s7_hash_table_ref(sc, table, cadr(args))); - return(implicit_index(sc, s7_hash_table_ref(sc, table, cadr(args)), cddr(args))); + return(nt); + if (is_hash_table(nt)) + { + set_car(sc->u1_1, nt); + set_cdr(sc->u1_1, cddr(args)); + return(g_hash_table_ref(sc, sc->u1_1)); + } + return(simple_wrong_type_argument(sc, sc->hash_table_ref_symbol, nt, T_HASH_TABLE)); } -static s7_pointer hash_table_ref_2; static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args) { s7_pointer table; @@ -39337,7 +39478,6 @@ static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args) return(hash_entry_value(x)); } -static s7_pointer hash_table_ref_ss; static s7_pointer g_hash_table_ref_ss(s7_scheme *sc, s7_pointer args) { s7_pointer table, key; @@ -39352,7 +39492,6 @@ static s7_pointer g_hash_table_ref_ss(s7_scheme *sc, s7_pointer args) return(hash_entry_value(x)); } -static s7_pointer hash_table_ref_car; static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args) { s7_pointer y, table; @@ -39370,16 +39509,16 @@ static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args) return(hash_entry_value(x)); } -static s7_pointer hash_table_ref_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer hash_table_ref_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { if (!is_hash_table(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->hash_table_ref_symbol, p1, T_HASH_TABLE); - return(s7_hash_table_ref(cur_sc, p1, p2)); + simple_wrong_type_argument(sc, sc->hash_table_ref_symbol, p1, T_HASH_TABLE); + return(s7_hash_table_ref(sc, p1, p2)); } -static s7_pointer hash_table_ref_p_pp_direct(s7_pointer p1, s7_pointer p2) +static s7_pointer hash_table_ref_p_pp_direct(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { - return(s7_hash_table_ref(cur_sc, p1, p2)); + return(s7_hash_table_ref(sc, p1, p2)); } @@ -39416,10 +39555,53 @@ static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_poi hash_table_checker(table) = hash_empty; hash_clear_chosen(table); } - liberate_block(x); + liberate_block(sc, x); return(sc->F); } +static void clear_weak_hash_table(s7_scheme *sc, s7_pointer table) +{ + if (hash_table_entries(table) > 0) + { + s7_int i, len; + hash_entry_t **entries; + + entries = hash_table_elements(table); + len = hash_table_mask(table) + 1; + + for (i = 0; i < len; i++) + { + hash_entry_t *xp, *nxp, *lxp; + lxp = entries[i]; + for (xp = entries[i]; xp; xp = nxp) + { + nxp = hash_entry_next(xp); + if (is_free_and_clear(hash_entry_key(xp))) + { + if (xp == entries[i]) + { + entries[i] = nxp; + lxp = nxp; + } + else hash_entry_next(lxp) = nxp; + liberate_block(sc, xp); + hash_table_entries(table)--; + if (hash_table_entries(table) == 0) + { + if (!hash_table_checker_locked(table)) + { + hash_table_checker(table) = hash_empty; + hash_clear_chosen(table); + } + return; + } + } + else lxp = xp; + } + } + } +} + static void hash_table_set_checker(s7_pointer table, uint8_t typ) { if (hash_table_checker(table) != default_hash_checks[typ]) @@ -39455,7 +39637,7 @@ s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7 if (!hash_chosen(table)) hash_table_set_checker(table, type(key)); /* raw_hash value (hash_loc(sc, table, key)) does not change via hash_table_set_checker etc */ - p = mallocate_block(); + p = mallocate_block(sc); hash_entry_key(p) = key; hash_entry_set_value(p, T_Pos(value)); hash_entry_set_raw_hash(p, hash_loc(sc, table, key)); @@ -39466,7 +39648,7 @@ s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7 hash_table_entries(table)++; if (hash_table_entries(table) > hash_len) - resize_hash_table(table); + resize_hash_table(sc, table); return(value); } @@ -39483,16 +39665,16 @@ static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args) return(s7_hash_table_set(sc, table, cadr(args), caddr(args))); } -static s7_pointer hash_table_set_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer hash_table_set_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { if (!is_hash_table(p1)) - simple_wrong_type_argument(cur_sc, cur_sc->hash_table_set_symbol, p1, T_HASH_TABLE); - return(s7_hash_table_set(cur_sc, p1, p2, p3)); + simple_wrong_type_argument(sc, sc->hash_table_set_symbol, p1, T_HASH_TABLE); + return(s7_hash_table_set(sc, p1, p2, p3)); } -static s7_pointer hash_table_set_p_ppp_direct(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer hash_table_set_p_ppp_direct(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { - return(s7_hash_table_set(cur_sc, p1, p2, p3)); + return(s7_hash_table_set(sc, p1, p2, p3)); } @@ -39515,7 +39697,7 @@ static inline s7_pointer hash_table_add(s7_scheme *sc, s7_pointer table, s7_poin (s7_is_equal(sc, hash_entry_key(x), key))) return(value); - p = mallocate_block(); + p = mallocate_block(sc); hash_entry_key(p) = key; hash_entry_set_value(p, T_Pos(value)); hash_entry_set_raw_hash(p, hash); @@ -39524,7 +39706,7 @@ static inline s7_pointer hash_table_add(s7_scheme *sc, s7_pointer table, s7_poin hash_table_entries(table)++; if (hash_table_entries(table) > hash_len) - resize_hash_table(table); + resize_hash_table(sc, table); return(value); } @@ -39613,7 +39795,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer { s7_int loc; loc = hash_entry_raw_hash(x) & new_len; - p = make_hash_entry(hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); + p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; } @@ -39632,7 +39814,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer { s7_int loc; loc = hash_entry_raw_hash(x) & new_len; - p = make_hash_entry(hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); + p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; } @@ -39658,7 +39840,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer { s7_int loc; loc = hash_entry_raw_hash(x) & new_len; - p = make_hash_entry(hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); + p = make_hash_entry(sc, hash_entry_key(x), hash_entry_value(x), hash_entry_raw_hash(x)); hash_entry_next(p) = new_lists[loc]; new_lists[loc] = p; hash_table_entries(new_hash)++; @@ -39695,17 +39877,27 @@ static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args) if (*hp) { p = *hp; +#if S7_DEBUGGING + while (hash_entry_next(p)) {block_frees(p)++; p = hash_entry_next(p);} + block_frees(p)++; +#else while (hash_entry_next(p)) p = hash_entry_next(p); - hash_entry_next(p) = block_lists[BLOCK_LIST]; - block_lists[BLOCK_LIST] = *hp; +#endif + hash_entry_next(p) = sc->block_lists[BLOCK_LIST]; + sc->block_lists[BLOCK_LIST] = *hp; } hp++; if (*hp) { p = *hp; +#if S7_DEBUGGING + while (hash_entry_next(p)) {block_frees(p)++; p = hash_entry_next(p);} + block_frees(p)++; +#else while (hash_entry_next(p)) p = hash_entry_next(p); - hash_entry_next(p) = block_lists[BLOCK_LIST]; - block_lists[BLOCK_LIST] = *hp; +#endif + hash_entry_next(p) = sc->block_lists[BLOCK_LIST]; + sc->block_lists[BLOCK_LIST] = *hp; } } if (len >= 8) @@ -39803,7 +39995,7 @@ static s7_pointer make_function(s7_scheme *sc, const char *name, s7_function f, c_function_name(x) = name; /* (procedure-name proc) => (format #f "~A" proc) */ c_function_name_length(x) = safe_strlen(name); if (doc) - c_function_documentation(x) = make_permanent_c_string(doc); + c_function_documentation(x) = make_permanent_c_string(sc, doc); else c_function_documentation(x) = NULL; c_function_signature(x) = sc->F; @@ -39826,34 +40018,31 @@ static s7_pointer s7_lambda(s7_scheme *sc, s7_function f, s7_int required_args, s7_pointer fnc; block_t *block; new_cell(sc, fnc, T_PAIR); /* just a place-holder */ - block = mallocate(sizeof(c_proc_t)); + block = mallocate(sc, sizeof(c_proc_t)); fnc = make_function(sc, NULL, f, required_args, optional_args, rest_arg, NULL, fnc, (c_proc_t *)block_data(block)); c_function_block(fnc) = block; add_lambda(sc, fnc); return(fnc); } -static c_proc_t *alloc_permanent_function(void) +static c_proc_t *alloc_permanent_function(s7_scheme *sc) { - #define ALLOC_FUNCS 128 - #define ALLOC_FUNCS_SIZE (ALLOC_FUNCS * sizeof(c_proc_t)) - static c_proc_t *alloc_func_cells = NULL; - static int alloc_k = ALLOC_FUNCS; + #define ALLOC_FUNCTION_SIZE 128 - if (alloc_k == ALLOC_FUNCS) + if (sc->alloc_function_k == ALLOC_FUNCTION_SIZE) { - alloc_func_cells = (c_proc_t *)malloc(ALLOC_FUNCS_SIZE); - alloc_k = 0; + sc->alloc_function_cells = (c_proc_t *)malloc(ALLOC_FUNCTION_SIZE * sizeof(c_proc_t)); + sc->alloc_function_k = 0; } - return(&alloc_func_cells[alloc_k++]); + return(&(sc->alloc_function_cells[sc->alloc_function_k++])); } s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc) { s7_pointer x; - x = alloc_pointer(); - unheap(x); - return(make_function(sc, name, f, required_args, optional_args, rest_arg, doc, x, alloc_permanent_function())); + x = alloc_pointer(sc); + unheap(sc, x); + return(make_function(sc, name, f, required_args, optional_args, rest_arg, doc, x, alloc_permanent_function(sc))); } s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f, @@ -39886,7 +40075,7 @@ bool s7_is_procedure(s7_pointer x) static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args) { #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure" - #define Q_is_procedure pl_bt + #define Q_is_procedure sc->pl_bt return(make_boolean(sc, is_procedure(car(args)))); } @@ -40072,7 +40261,7 @@ static bool is_macro_b(s7_pointer x) {return(is_any_macro(x));} static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args) { #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro or a bacro" - #define Q_is_macro pl_bt + #define Q_is_macro sc->pl_bt check_boolean_method(sc, is_any_macro, sc->is_macro_symbol, args); } @@ -40098,12 +40287,12 @@ s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fn block_t *b; len = safe_strlen(arglist) + 8; - b = mallocate(len); + b = mallocate(sc, len); internal_arglist = (char *)block_data(b); catstrs_direct(internal_arglist, "'(", arglist, ")", NULL); local_args = s7_eval_c_string(sc, internal_arglist); gc_loc = s7_gc_protect_1(sc, local_args); - liberate(b); + liberate(sc, b); n_args = safe_list_length(local_args); /* currently rest arg not supported, and we don't notice :allow-other-keys etc */ func = s7_make_function(sc, name, fnc, 0, n_args, false, doc); @@ -40114,21 +40303,21 @@ s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fn c_function_arg_names(func) = names; defaults = (s7_pointer *)malloc(n_args * sizeof(s7_pointer)); c_function_arg_defaults(func) = defaults; - set_simple_defaults(func); + c_func_set_simple_defaults(func); for (p = local_args, i = 0; i < n_args; p = cdr(p), i++) { s7_pointer arg; arg = car(p); - if (is_pair(arg)) + if (is_pair(arg)) /* there is a default */ { names[i] = symbol_to_keyword(sc, car(arg)); defaults[i] = cadr(arg); s7_remove_from_heap(sc, cadr(arg)); - if ((is_symbol(defaults[i])) || - (is_pair(defaults[i]))) + if ((is_pair(defaults[i])) || + ((is_symbol(defaults[i])) && (!is_keyword(defaults[i])))) { - clear_simple_defaults(func); + c_func_clear_simple_defaults(func); mark_function[T_C_FUNCTION_STAR] = mark_c_proc_star; } } @@ -40146,7 +40335,7 @@ s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_functi { s7_pointer func; func = s7_make_function_star(sc, name, fnc, arglist, doc); - set_type(func, T_C_FUNCTION_STAR | T_SAFE_PROCEDURE); + set_type(func, typeflag(func) | T_SAFE_PROCEDURE); /* don't step on the c_func_has_simple_defaults flag */ c_function_call_args(func) = make_list(sc, c_function_optional_args(func), sc->F); s7_remove_from_heap(sc, c_function_call_args(func)); return(func); @@ -40191,8 +40380,8 @@ const char *s7_documentation(s7_scheme *sc, s7_pointer x) s7_pointer val; if (is_symbol(x)) { - if ((symbol_has_help(x)) && - (is_global(x))) + if (is_keyword(x)) return(NULL); + if (symbol_has_help(x)) return(symbol_help(x)); x = s7_symbol_value(sc, x); /* this is needed by Snd */ } @@ -40248,6 +40437,17 @@ static s7_pointer g_documentation(s7_scheme *sc, s7_pointer args) return(s7_make_string(sc, s7_documentation(sc, p))); } +const char *s7_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc) +{ + if (is_keyword(sym)) return(NULL); + if (is_symbol(sym)) + { + symbol_set_has_help(sym); + symbol_set_help(sym, copy_string(new_doc)); + } + return(new_doc); +} + /* -------------------------------- help -------------------------------- */ const char *s7_help(s7_scheme *sc, s7_pointer obj) @@ -40258,8 +40458,8 @@ const char *s7_help(s7_scheme *sc, s7_pointer obj) if (is_symbol(obj)) { /* here look for name */ - if (s7_symbol_documentation(sc, obj)) - return(s7_symbol_documentation(sc, obj)); + if (s7_documentation(sc, obj)) + return(s7_documentation(sc, obj)); obj = s7_symbol_value(sc, obj); } @@ -40349,7 +40549,7 @@ static s7_pointer g_signature(s7_scheme *sc, s7_pointer args) case T_SYMBOL: p = s7_symbol_value(sc, p); if (!is_symbol(p)) - return(g_signature(sc, set_plist_1(sc, p))); /* lint depends on this currently */ + return(g_signature(sc, set_plist_1(sc, p))); break; default: @@ -40430,7 +40630,7 @@ s7_int s7_make_c_type(s7_scheme *sc, const char *name) } sc->c_object_types[tag] = (c_object_t *)calloc(1, sizeof(c_object_t)); sc->c_object_types[tag]->type = tag; - sc->c_object_types[tag]->scheme_name = s7_make_permanent_string(name); + sc->c_object_types[tag]->scheme_name = s7_make_permanent_string(sc, name); sc->c_object_types[tag]->free = fallback_free; #if (!DISABLE_DEPRECATED) @@ -40451,13 +40651,6 @@ s7_int s7_make_c_type(s7_scheme *sc, const char *name) return(tag); } -#if (!DISABLE_DEPRECATED) -void s7_c_type_set_print(s7_scheme *sc, s7_int tag, char *(*print)(s7_scheme *sc, void *value)) -{ - sc->c_object_types[tag]->print = print; -} -#endif - void s7_c_type_set_free(s7_scheme *sc, s7_int tag, void (*gc_free)(void *value)) { sc->c_object_types[tag]->free = gc_free; @@ -40516,20 +40709,22 @@ void s7_c_type_set_to_string(s7_scheme *sc, s7_int tag, s7_pointer (*to_string)( } #if (!DISABLE_DEPRECATED) -s7_int s7_new_type(const char *name, - char *(*print)(s7_scheme *sc, void *value), - void (*gc_free)(void *value), - bool (*equal)(void *val1, void *val2), - void (*mark)(void *val), - s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args), /* ignored */ - s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args)) /* ignored */ +/* for CM */ +s7_int s7_new_type_1(s7_scheme *sc, + const char *name, + char *(*print)(s7_scheme *sc, void *value), + void (*gc_free)(void *value), + bool (*equal)(void *val1, void *val2), + void (*mark)(void *val), + s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args), /* ignored */ + s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args)) /* ignored */ { s7_int tag; - tag = s7_make_c_type(cur_sc, name); - if (gc_free) cur_sc->c_object_types[tag]->free = gc_free; - if (print) cur_sc->c_object_types[tag]->print = print; - if (equal) cur_sc->c_object_types[tag]->equal = equal; - if (mark) cur_sc->c_object_types[tag]->mark = mark; + tag = s7_make_c_type(sc, name); + if (gc_free) sc->c_object_types[tag]->free = gc_free; + if (print) sc->c_object_types[tag]->print = print; + if (equal) sc->c_object_types[tag]->equal = equal; + if (mark) sc->c_object_types[tag]->mark = mark; return(tag); } #endif @@ -40592,7 +40787,7 @@ s7_pointer s7_c_object_set_let(s7_pointer obj, s7_pointer e) static s7_pointer c_object_length(s7_scheme *sc, s7_pointer obj) { if (c_object_len(sc, obj)) - return((*(c_object_len(sc, obj)))(sc, set_plist_1(sc, obj))); + return((*(c_object_len(sc, obj)))(sc, set_clist_1(sc, obj))); eval_error(sc, "attempt to get length of ~S?", 28, obj); } @@ -40601,7 +40796,7 @@ static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj) if (c_object_len(sc, obj)) { s7_pointer res; - res = (*(c_object_len(sc, obj)))(sc, set_plist_1(sc, obj)); + res = (*(c_object_len(sc, obj)))(sc, set_clist_1(sc, obj)); if (s7_is_integer(res)) return(s7_integer(res)); } @@ -40701,43 +40896,10 @@ bool s7_is_dilambda(s7_pointer obj) static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args) { #define H_is_dilambda "(dilambda? obj) returns #t if obj is a procedure with setter." - #define Q_is_dilambda pl_bt + #define Q_is_dilambda sc->pl_bt check_boolean_method(sc, s7_is_dilambda, sc->is_dilambda_symbol, args); } -s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter) -{ - switch (type(p)) - { - case T_MACRO: case T_MACRO_STAR: - case T_BACRO: case T_BACRO_STAR: - case T_CLOSURE: case T_CLOSURE_STAR: - closure_set_setter(p, setter); - if (setter == sc->F) - closure_set_no_setter(p); - break; - - case T_C_FUNCTION: - case T_C_ANY_ARGS_FUNCTION: - case T_C_OPT_ARGS_FUNCTION: - case T_C_RST_ARGS_FUNCTION: - case T_C_FUNCTION_STAR: - c_function_set_setter(p, setter); - if ((is_any_closure(setter)) || - (is_any_macro(setter))) - add_setter(sc, p, setter); - break; - - case T_C_MACRO: - c_macro_set_setter(p, setter); - if ((is_any_closure(setter)) || - (is_any_macro(setter))) - add_setter(sc, p, setter); - break; - } - return(setter); -} - static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args) { #define H_dilambda "(dilambda getter setter) sets getter's setter to be setter." @@ -40757,153 +40919,6 @@ static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args) } -s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj) -{ - if (is_c_function(obj)) - return(c_function_setter(obj)); - - return(closure_setter(obj)); -} - -static s7_pointer g_setter(s7_scheme *sc, s7_pointer args) -{ - #define H_setter "(setter obj) returns the setter associated with obj, or #f" - #define Q_setter s7_make_signature(sc, 2, sc->T, sc->is_procedure_symbol) - s7_pointer p; - - p = car(args); - switch (type(p)) - { - case T_MACRO: case T_MACRO_STAR: - case T_BACRO: case T_BACRO_STAR: - case T_CLOSURE: case T_CLOSURE_STAR: - if (is_any_procedure(closure_setter(p))) /* setter already known */ - return(closure_setter(p)); - if (!closure_no_setter(p)) - { - s7_pointer f; - f = funclet_entry(sc, p, sc->local_setter_symbol); /* look for +setter+, save value as closure_setter(p) */ - if (f) - { - if (f == sc->F) - { - closure_set_no_setter(p); - return(sc->F); - } - if (!is_any_procedure(f)) - return(s7_wrong_type_arg_error(sc, "setter", 0, p, "a procedure or a reasonable facsimile thereof")); - closure_set_setter(p, f); - return(f); - } - f = funclet_entry(sc, p, sc->setter_symbol); /* look for setter */ - if (f) - return(s7_apply_function(sc, f, args)); - closure_set_no_setter(p); - } - return(sc->F); - - case T_C_FUNCTION: - case T_C_FUNCTION_STAR: - case T_C_ANY_ARGS_FUNCTION: - case T_C_OPT_ARGS_FUNCTION: - case T_C_RST_ARGS_FUNCTION: - return(c_function_setter(p)); - - case T_C_MACRO: - return(c_macro_setter(p)); - - case T_GOTO: - case T_CONTINUATION: - return(sc->F); - - case T_C_OBJECT: - check_method(sc, p, sc->setter_symbol, args); - if (c_object_set(sc, p) != fallback_set) - return(sc->c_object_set_function); /* for example ((setter obj) obj 0 1.0) if s7test block */ - /* this could wrap the setter as an s7_function giving p's class-name etc */ - return(sc->F); - - case T_LET: - check_method(sc, p, sc->setter_symbol, args); - return(slot_value(global_slot(sc->let_set_symbol))); - - case T_ITERATOR: - if (is_any_closure(iterator_sequence(p))) - return(closure_setter(iterator_sequence(p))); - return(sc->F); /* (set! (iter) val) doesn't fit the other setters */ - - case T_PAIR: - return(slot_value(global_slot(sc->list_set_symbol))); - - case T_HASH_TABLE: - return(slot_value(global_slot(sc->hash_table_set_symbol))); - - case T_STRING: - return(slot_value(global_slot(sc->string_set_symbol))); - - case T_BYTE_VECTOR: - return(slot_value(global_slot(sc->byte_vector_set_symbol))); - - case T_VECTOR: - return(slot_value(global_slot(sc->vector_set_symbol))); - - case T_INT_VECTOR: - return(slot_value(global_slot(sc->int_vector_set_symbol))); - - case T_FLOAT_VECTOR: - return(slot_value(global_slot(sc->float_vector_set_symbol))); - - case T_SYMBOL: /* (symbol-setter obj) -- the env arg is not passable here */ - if (is_keyword(p)) return(sc->F); - p = symbol_to_slot(sc, p); - if (!is_slot(p)) return(sc->F); - if (slot_has_setter(p)) return(slot_setter(p)); - return(sc->F); - } - return(s7_wrong_type_arg_error(sc, "setter", 0, p, "a procedure or a reasonable facsimile thereof")); -} - -static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args) -{ - s7_pointer p, setter; - - p = car(args); - if (!is_any_procedure(p)) - return(s7_wrong_type_arg_error(sc, "set! setter procedure", 1, p, "a procedure")); - - setter = cadr(args); - if ((setter != sc->F) && - (!is_any_procedure(setter))) - return(s7_wrong_type_arg_error(sc, "set! setter setter", 2, setter, "a procedure or #f")); - - /* should we check that p != setter? - * :(set! (setter <) <) - * < - * :(set! (< 3 2) 3) - * #f - * :(set! (< 1) 2) - * #t - * can this make sense? - */ - return(s7_set_setter(sc, p, setter)); -} - -/* setter for hash-table could give cow-obj: - * (define (cowtable . fields) (let ((ht (apply hash-table* fields))) (set! (setter ht) (let ((old-setter (setter ht))) - * (lambda (table key value) (let ((new-table (copy table))) (old-setter new-table key value) new-table)))) ht)) - * but if the underlyng setter changes due to a new key, the saved setter won't work. - * there's room for vector-setter but not string-setter, so perhaps this extension is - * not doable. So set symbol-setter -> set setter is also out for the time being. - */ - -#if (!DISABLE_DEPRECATED) -void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, s7_int req_args, s7_int opt_args, const char *doc) -{ - s7_dilambda(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc); -} -#endif - - /* -------------------------------- arity -------------------------------- */ static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args) @@ -41191,25 +41206,179 @@ static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, s7_is_aritable(sc, car(args), num))); } -static bool is_aritable_b_pp(s7_pointer f, s7_pointer i) {return(g_is_aritable(cur_sc, set_plist_2(cur_sc, f, i)) != cur_sc->F);} +static bool is_aritable_b_7pp(s7_scheme *sc, s7_pointer f, s7_pointer i) {return(g_is_aritable(sc, set_plist_2(sc, f, i)) != sc->F);} /* -------------------------------- sequence? -------------------------------- */ static s7_pointer g_is_sequence(s7_scheme *sc, s7_pointer args) { #define H_is_sequence "(sequence? obj) returns #t if obj is a sequence (vector, string, pair, etc)" - #define Q_is_sequence pl_bt + #define Q_is_sequence sc->pl_bt check_boolean_method(sc, is_simple_sequence, sc->is_sequence_symbol, args); } static bool is_sequence_b(s7_pointer p) {return(is_simple_sequence(p));} -/* -------------------------------- symbol-setter ------------------------------------------------ */ +/* -------------------------------- setter ------------------------------------------------ */ + +#define SETTER_PRINT 0 + +static s7_pointer g_setter(s7_scheme *sc, s7_pointer args) +{ + #define H_setter "(setter obj env) returns the setter associated with obj, or #f" + #define Q_setter s7_make_circular_signature(sc, 1, 2, s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_procedure_symbol), sc->T) + s7_pointer p, e; + + p = car(args); + if (is_pair(cdr(args))) + { + e = cadr(args); + if (!((is_let(e)) || (e == sc->rootlet) || (e == sc->nil))) + return(wrong_type_argument(sc, sc->setter_symbol, 2, e, T_LET)); + } + else e = sc->envir; + + switch (type(p)) + { + case T_MACRO: case T_MACRO_STAR: + case T_BACRO: case T_BACRO_STAR: + case T_CLOSURE: case T_CLOSURE_STAR: + if (is_any_procedure(closure_setter(p))) /* setter already known */ + return(closure_setter(p)); + if (!closure_no_setter(p)) + { + s7_pointer f; + f = funclet_entry(sc, p, sc->local_setter_symbol); /* look for +setter+, save value as closure_setter(p) */ + if (f) + { + if (f == sc->F) + { + closure_set_no_setter(p); + return(sc->F); + } + if (!is_any_procedure(f)) + return(s7_wrong_type_arg_error(sc, "setter", 0, p, "a procedure or a reasonable facsimile thereof")); + closure_set_setter(p, f); + return(f); + } + f = funclet_entry(sc, p, sc->setter_symbol); /* look for setter */ + if (f) + return(s7_apply_function(sc, f, args)); + closure_set_no_setter(p); + } + return(sc->F); + case T_C_FUNCTION: + case T_C_FUNCTION_STAR: + case T_C_ANY_ARGS_FUNCTION: + case T_C_OPT_ARGS_FUNCTION: + case T_C_RST_ARGS_FUNCTION: + return(c_function_setter(p)); + + case T_C_MACRO: + return(c_macro_setter(p)); + + case T_GOTO: + case T_CONTINUATION: + return(sc->F); + + case T_C_OBJECT: + check_method(sc, p, sc->setter_symbol, args); + if (c_object_set(sc, p) != fallback_set) + return(sc->c_object_set_function); /* for example ((setter obj) obj 0 1.0) if s7test block */ + /* this could wrap the setter as an s7_function giving p's class-name etc */ + return(sc->F); + + case T_LET: + check_method(sc, p, sc->setter_symbol, args); + return(slot_value(global_slot(sc->let_set_symbol))); + + case T_ITERATOR: + if (is_any_closure(iterator_sequence(p))) + return(closure_setter(iterator_sequence(p))); + return(sc->F); /* (set! (iter) val) doesn't fit the other setters */ + + case T_PAIR: + return(slot_value(global_slot(sc->list_set_symbol))); + + case T_HASH_TABLE: + return(slot_value(global_slot(sc->hash_table_set_symbol))); + + case T_STRING: + return(slot_value(global_slot(sc->string_set_symbol))); + + case T_BYTE_VECTOR: + return(slot_value(global_slot(sc->byte_vector_set_symbol))); + + case T_VECTOR: + return(slot_value(global_slot(sc->vector_set_symbol))); + + case T_INT_VECTOR: + return(slot_value(global_slot(sc->int_vector_set_symbol))); + + case T_FLOAT_VECTOR: + return(slot_value(global_slot(sc->float_vector_set_symbol))); + + case T_SLOT: + if (slot_has_setter(p)) + return(slot_setter(p)); + return(sc->F); + + case T_SYMBOL: /* (setter symbol env) */ + { + s7_pointer sym, slot; + sym = car(args); + +#if SETTER_PRINT + fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sym)); +#endif + if (is_keyword(sym)) + return(sc->F); + + if ((e == sc->rootlet) || (e == sc->nil)) + slot = global_slot(sym); + else + { + s7_pointer old_e; + old_e = sc->envir; + sc->envir = e; + slot = symbol_to_slot(sc, sym); + sc->envir = old_e; + } + +#if SETTER_PRINT + fprintf(stderr, "%s %s %p\n", DISPLAY(sym), DISPLAY(slot), slot); +#endif + if (!is_slot(slot)) + return(sc->F); + + if (slot_has_setter(slot)) + { +#if SETTER_PRINT + fprintf(stderr, "symbol(%s)-setter: %s %p\n", DISPLAY(sym), DISPLAY(slot_setter(slot)), slot); +#endif + return(slot_setter(slot)); + } + return(sc->F); + } + } + return(s7_wrong_type_arg_error(sc, "setter", 0, p, "something that might have a setter")); +} + +s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj) +{ + return(g_setter(sc, set_plist_1(sc, obj))); +} + + +/* -------------------------------- set-setter -------------------------------- */ static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer acc) { s7_int loc; +#if SETTER_PRINT + fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sym)); +#endif if (sc->protected_setters_size == sc->protected_setters_loc) { s7_int i, new_size, size; @@ -41219,14 +41388,14 @@ static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer acc) new_size = 2 * size; ob = vector_block(sc->protected_setters); - nb = reallocate(ob, new_size * sizeof(s7_pointer)); + nb = reallocate(sc, ob, new_size * sizeof(s7_pointer)); block_info(nb) = NULL; vector_block(sc->protected_setters) = nb; vector_elements(sc->protected_setters) = (s7_pointer *)block_data(nb); vector_length(sc->protected_setters) = new_size; ob = vector_block(sc->protected_setter_symbols); - nb = reallocate(ob, new_size * sizeof(s7_pointer)); + nb = reallocate(sc, ob, new_size * sizeof(s7_pointer)); vector_block(sc->protected_setter_symbols) = nb; vector_elements(sc->protected_setter_symbols) = (s7_pointer *)block_data(nb); vector_length(sc->protected_setter_symbols) = new_size; @@ -41243,166 +41412,231 @@ static void protect_setter(s7_scheme *sc, s7_pointer sym, s7_pointer acc) vector_element(sc->protected_setter_symbols, loc) = sym; } -s7_pointer s7_symbol_setter(s7_scheme *sc, s7_pointer sym) +static s7_pointer g_set_setter(s7_scheme *sc, s7_pointer args) { - /* these refer to the rootlet */ - if ((is_slot(global_slot(sym))) && - (slot_has_setter(global_slot(sym)))) - return(slot_setter(global_slot(sym))); - return(sc->F); -} + s7_pointer p, setter; -s7_pointer s7_symbol_set_setter(s7_scheme *sc, s7_pointer symbol, s7_pointer func) -{ - if (slot_has_setter(global_slot(symbol))) - { - s7_int index; - for (index = 0; index < sc->protected_setters_loc; index++) - if (vector_element(sc->protected_setter_symbols, index) == symbol) - { - if (is_immutable(vector_element(sc->protected_setters, index))) /* a function */ - return(func); - vector_element(sc->protected_setters, index) = func; - slot_set_setter(global_slot(symbol), func); - if ((func != sc->F) && (s7_is_aritable(sc, func, 3))) - set_has_let_arg(func); - return(func); - } - } - if (func != sc->F) + p = car(args); + /* should we check that p != setter? + * :(set! (setter <) <) + * < + * :(set! (< 3 2) 3) + * #f + * :(set! (< 1) 2) + * #t + * can this make sense? + */ + + if (is_symbol(p)) { - slot_set_has_setter(global_slot(symbol)); - symbol_set_has_setter(symbol); - protect_setter(sc, symbol, func); - slot_set_setter(global_slot(symbol), func); - if (s7_is_aritable(sc, func, 3)) - set_has_let_arg(func); - return(func); - } - slot_set_setter(global_slot(symbol), func); - return(func); -} + s7_pointer sym, func, slot; + sym = p; +#if SETTER_PRINT + fprintf(stderr, "%s: %s ", __func__, DISPLAY(sym)); +#endif + if (is_keyword(sym)) + return(s7_wrong_type_arg_error(sc, "set! setter", 1, sym, "a normal symbol (a keyword can't be set)")); -/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (symbol-setter 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix)) - * so set symbol-setter before use! - */ + if (is_pair(cddr(args))) + { + s7_pointer e, old_e; + e = cadr(args); + func = caddr(args); + if ((e == sc->rootlet) || (e == sc->nil)) + slot = global_slot(sym); + else + { + if (!is_let(e)) + return(s7_wrong_type_arg_error(sc, "set! symbol-setter", 2, e, "a let")); + old_e = sc->envir; + sc->envir = e; + slot = symbol_to_slot(sc, sym); + sc->envir = old_e; + } + } + else + { + slot = symbol_to_slot(sc, sym); + func = cadr(args); + } +#if SETTER_PRINT + fprintf(stderr, "%s\n", DISPLAY_80(func)); +#endif -static s7_pointer g_symbol_setter(s7_scheme *sc, s7_pointer args) -{ - #define H_symbol_setter "(symbol-setter sym (env (curlet))) is the function called when the symbol is set!." - #define Q_symbol_setter s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_procedure_symbol), sc->is_symbol_symbol, sc->is_let_symbol) - s7_pointer sym, p; + if ((!is_procedure_or_macro(func)) && + (func != sc->F)) + return(s7_wrong_type_arg_error(sc, "set! setter", 3, func, "a function or #f")); - sym = car(args); - if (!is_symbol(sym)) - return(method_or_bust_one_arg(sc, sym, sc->symbol_setter_symbol, args, T_SYMBOL)); + if (!is_slot(slot)) + { +#if SETTER_PRINT + fprintf(stderr, " not a slot: %s\n", DISPLAY(slot)); +#endif + return(sc->F); + } - if (is_keyword(sym)) - { - if (is_pair(cdr(args))) + if (slot == global_slot(sym)) { - s7_pointer e; - e = cadr(args); - if (!((is_let(e)) || (e == sc->rootlet) || (e == sc->nil))) - return(wrong_type_argument(sc, sc->symbol_setter_symbol, 2, e, T_LET)); +#if SETTER_PRINT + fprintf(stderr, " setting global\n"); +#endif + s7_set_setter(sc, sym, func); /* special GC protection for global vars */ + return(func); } - return(sc->F); - } - if (is_pair(cdr(args))) - { - s7_pointer e, old_e; - e = cadr(args); - if ((e == sc->rootlet) || (e == sc->nil)) - p = global_slot(sym); - else + slot_set_setter(slot, func); + if (func != sc->F) { - if (!is_let(e)) - return(wrong_type_argument(sc, sc->symbol_setter_symbol, 2, e, T_LET)); - old_e = sc->envir; - sc->envir = e; - p = symbol_to_slot(sc, sym); - sc->envir = old_e; + slot_set_has_setter(slot); + if (s7_is_aritable(sc, func, 3)) + set_has_let_arg(func); + symbol_set_has_setter(sym); } + return(func); } - else p = symbol_to_slot(sc, sym); - if (!is_slot(p)) - return(sc->F); + setter = cadr(args); + if ((setter != sc->F) && + (!is_any_procedure(setter))) + return(s7_wrong_type_arg_error(sc, "set! setter", 2, setter, "a procedure or #f")); - if (slot_has_setter(p)) - return(slot_setter(p)); + switch (type(p)) + { + case T_MACRO: case T_MACRO_STAR: + case T_BACRO: case T_BACRO_STAR: + case T_CLOSURE: case T_CLOSURE_STAR: + closure_set_setter(p, setter); + if (setter == sc->F) + closure_set_no_setter(p); + break; - return(sc->F); -} + case T_C_FUNCTION: + case T_C_ANY_ARGS_FUNCTION: + case T_C_OPT_ARGS_FUNCTION: + case T_C_RST_ARGS_FUNCTION: + case T_C_FUNCTION_STAR: + c_function_set_setter(p, setter); + if ((is_any_closure(setter)) || + (is_any_macro(setter))) + add_setter(sc, p, setter); + break; -static s7_pointer g_symbol_set_setter(s7_scheme *sc, s7_pointer args) -{ - s7_pointer sym, func, p; + case T_C_MACRO: + c_macro_set_setter(p, setter); + if ((is_any_closure(setter)) || + (is_any_macro(setter))) + add_setter(sc, p, setter); + break; - sym = car(args); - if (!is_symbol(sym)) /* no check method because no method name? */ - return(s7_wrong_type_arg_error(sc, "set! symbol-setter", 1, sym, "a symbol")); - if (is_keyword(sym)) - return(s7_wrong_type_arg_error(sc, "set! symbol-setter", 1, sym, "a normal symbol (a keyword can't be set)")); + case T_SLOT: + slot_setter(p) = setter; + slot_set_has_setter(p); + break; + } + return(setter); +} - /* (set! (symbol-setter sym) f) or (set! (symbol-setter sym env) f) */ - if (is_pair(cddr(args))) +s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter) +{ + if (is_symbol(p)) { - s7_pointer e, old_e; - e = cadr(args); - func = caddr(args); - if ((e == sc->rootlet) || (e == sc->nil)) - p = global_slot(sym); - else + if (slot_has_setter(global_slot(p))) { - if (!is_let(e)) - return(s7_wrong_type_arg_error(sc, "set! symbol-setter", 2, e, "a let")); - old_e = sc->envir; - sc->envir = e; - p = symbol_to_slot(sc, sym); - sc->envir = old_e; + s7_int index; + for (index = 0; index < sc->protected_setters_loc; index++) + if (vector_element(sc->protected_setter_symbols, index) == p) + { + s7_pointer old_func; + old_func = vector_element(sc->protected_setters, index); + if ((is_procedure_or_macro(old_func)) && /* i.e. not #f! */ + (is_immutable(old_func))) + return(setter); + vector_element(sc->protected_setters, index) = setter; + slot_set_setter(global_slot(p), setter); + if ((setter != sc->F) && (s7_is_aritable(sc, setter, 3))) + set_has_let_arg(setter); + return(setter); + } } + if (setter != sc->F) + { + slot_set_has_setter(global_slot(p)); + symbol_set_has_setter(p); + slot_set_has_setter(global_slot(p)); + protect_setter(sc, p, setter); + slot_set_setter(global_slot(p), setter); + if (s7_is_aritable(sc, setter, 3)) + set_has_let_arg(setter); + return(setter); + } + slot_set_setter(global_slot(p), setter); + return(setter); } - else - { - p = symbol_to_slot(sc, sym); - func = cadr(args); - } - - if ((!is_procedure_or_macro(func)) && - (func != sc->F)) - return(s7_wrong_type_arg_error(sc, "set! symbol-setter", 3, func, "a function or #f")); + return(g_set_setter(sc, set_plist_2(sc, p, setter))); +} - if (!is_slot(p)) - return(sc->F); +/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (symbol-setter 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix)) + * so set symbol-setter before use! + */ - if (p == global_slot(sym)) - { - s7_symbol_set_setter(sc, sym, func); /* special GC protection for global vars */ - return(func); - } +static s7_pointer call_setter(s7_scheme *sc, s7_pointer slot, s7_pointer old_value) +{ + s7_pointer func, new_value; +#if SETTER_PRINT + fprintf(stderr, "%s: %s\n", __func__, DISPLAY(slot_symbol(slot))); +#endif + /* new_value = sc->error_symbol; */ + func = slot_setter(slot); - slot_set_setter(p, func); - if (func != sc->F) + if (is_procedure_or_macro(func)) { - slot_set_has_setter(p); - if (s7_is_aritable(sc, func, 3)) - set_has_let_arg(func); - symbol_set_has_setter(sym); + if (has_let_arg(func)) + { + if (is_c_function(func)) + { + set_car(sc->t3_1, slot_symbol(slot)); + set_car(sc->t3_2, old_value); + set_car(sc->t3_3, sc->envir); + new_value = c_function_call(func)(sc, sc->t3_1); + } + else + { + bool old_off; + old_off = sc->gc_off; + sc->gc_off = true; + new_value = s7_apply_function(sc, func, list_3(sc, slot_symbol(slot), old_value, sc->envir)); + sc->gc_off = old_off; + } + } + else + { + if (is_c_function(func)) + { + set_car(sc->t2_1, slot_symbol(slot)); + set_car(sc->t2_2, old_value); + new_value = c_function_call(func)(sc, sc->t2_1); + } + else + { + bool old_off; + old_off = sc->gc_off; + sc->gc_off = true; + new_value = s7_apply_function(sc, func, list_2(sc, slot_symbol(slot), old_value)); + sc->gc_off = old_off; + } + } } - return(func); + else return(old_value); + return(new_value); } - static s7_pointer bind_symbol_with_setter(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value) { - /* this refers to (define (sym ...)) and friends -- define cases - * see call_setter for the set! cases - */ s7_pointer func; - - func = g_symbol_setter(sc, set_plist_2(sc, symbol, sc->envir)); +#if SETTER_PRINT + fprintf(stderr, "%s: %s\n", __func__, DISPLAY(symbol)); +#endif + func = g_setter(sc, set_plist_2(sc, symbol, sc->envir)); if (is_procedure_or_macro(func)) { if (is_c_function(func)) @@ -41450,7 +41684,7 @@ bool s7_is_eq(s7_pointer obj1, s7_pointer obj2) static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args) { #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2" - #define Q_is_eq pcl_bt + #define Q_is_eq sc->pcl_bt return(make_boolean(sc, ((car(args) == cadr(args)) || ((is_unspecified(car(args))) && (is_unspecified(cadr(args))))))); /* (eq? (apply apply apply values '(())) #<unspecified>) should return #t */ @@ -41483,7 +41717,7 @@ bool s7_is_eqv(s7_pointer a, s7_pointer b) static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args) { #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2" - #define Q_is_eqv pcl_bt + #define Q_is_eqv sc->pcl_bt return(make_boolean(sc, s7_is_eqv(car(args), cadr(args)))); } @@ -41539,17 +41773,17 @@ static bool c_pointer_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, s shared_info *nci = ci; if (x == y) return(true); if (!s7_is_c_pointer(y)) return(false); - if (raw_pointer(x) != raw_pointer(y)) return(false); - if (raw_pointer_type(x) != raw_pointer_type(y)) + if (c_pointer(x) != c_pointer(y)) return(false); + if (c_pointer_type(x) != c_pointer_type(y)) { if (!nci) nci = new_shared_info(sc); - if (!s7_is_morally_equal_1(sc, raw_pointer_type(x), raw_pointer_type(y), nci)) + if (!s7_is_morally_equal_1(sc, c_pointer_type(x), c_pointer_type(y), nci)) return(false); } - if (raw_pointer_info(x) != raw_pointer_info(y)) + if (c_pointer_info(x) != c_pointer_info(y)) { if (!nci) nci = new_shared_info(sc); - if (!s7_is_morally_equal_1(sc, raw_pointer_info(x), raw_pointer_info(y), nci)) + if (!s7_is_morally_equal_1(sc, c_pointer_info(x), c_pointer_info(y), nci)) return(false); } return(true); @@ -41560,17 +41794,17 @@ static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_in shared_info *nci = ci; if (x == y) return(true); if (!s7_is_c_pointer(y)) return(false); - if (raw_pointer(x) != raw_pointer(y)) return(false); - if (raw_pointer_type(x) != raw_pointer_type(y)) + if (c_pointer(x) != c_pointer(y)) return(false); + if (c_pointer_type(x) != c_pointer_type(y)) { if (!nci) nci = new_shared_info(sc); - if (!s7_is_equal_1(sc, raw_pointer_type(x), raw_pointer_type(y), nci)) + if (!s7_is_equal_1(sc, c_pointer_type(x), c_pointer_type(y), nci)) return(false); } - if (raw_pointer_info(x) != raw_pointer_info(y)) + if (c_pointer_info(x) != c_pointer_info(y)) { if (!nci) nci = new_shared_info(sc); - if (!s7_is_equal_1(sc, raw_pointer_info(x), raw_pointer_info(y), nci)) + if (!s7_is_equal_1(sc, c_pointer_info(x), c_pointer_info(y), nci)) return(false); } return(true); @@ -42016,25 +42250,23 @@ static bool pair_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y) { - s7_int x_dims, y_dims; + s7_int x_dims; + s7_int j; if (vector_has_dimensional_info(x)) x_dims = vector_ndims(x); - else x_dims = 1; - if (vector_has_dimensional_info(y)) - y_dims = vector_ndims(y); - else y_dims = 1; + else return((!vector_has_dimensional_info(y)) || (vector_ndims(y) == 1)); + if (x_dims == 1) + return((!vector_has_dimensional_info(y)) || (vector_ndims(y) == 1)); - if (x_dims != y_dims) + if ((!vector_has_dimensional_info(y)) || + (x_dims != vector_ndims(y))) return(false); - if (x_dims > 1) - { - s7_int j; - for (j = 0; j < x_dims; j++) - if (vector_dimension(x, j) != vector_dimension(y, j)) - return(false); - } + for (j = 0; j < x_dims; j++) + if (vector_dimension(x, j) != vector_dimension(y, j)) + return(false); + return(true); } @@ -42045,17 +42277,14 @@ static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info if (x == y) return(true); - if (!s7_is_vector(y)) return(false); len = vector_length(x); - if (len != vector_length(y)) return(false); if (len == 0) - return(vector_rank_match(sc, x, y)); + return((s7_is_vector(y)) && (vector_length(y) == 0) && (vector_rank_match(sc, x, y))); - if (type(x) != type(y)) - return(false); - if (!vector_rank_match(sc, x, y)) - return(false); + if ((type(x) != type(y)) || + (len != vector_length(y)) || + (!vector_rank_match(sc, x, y))) return(false); if (is_float_vector(x)) { @@ -42577,23 +42806,23 @@ bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args) { #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2" - #define Q_is_equal pcl_bt + #define Q_is_equal sc->pcl_bt return(make_boolean(sc, s7_is_equal(sc, car(args), cadr(args)))); } static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args) { #define H_is_morally_equal "(morally-equal? obj1 obj2) returns #t if obj1 is close enough to obj2." - #define Q_is_morally_equal pcl_bt + #define Q_is_morally_equal sc->pcl_bt return(make_boolean(sc, s7_is_morally_equal(sc, car(args), cadr(args)))); } -static bool is_equal_b_pp(s7_pointer a, s7_pointer b) {return(s7_is_equal(cur_sc, a, b));} -static bool is_morally_equal_b_pp(s7_pointer a, s7_pointer b) {return(s7_is_morally_equal(cur_sc, a, b));} +static bool is_equal_b_7pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return(s7_is_equal(sc, a, b));} +static bool is_morally_equal_b_7pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return(s7_is_morally_equal(sc, a, b));} -static s7_pointer is_equal_p_pp(s7_pointer a, s7_pointer b) {return((s7_is_equal(cur_sc, a, b)) ? cur_sc->T : cur_sc->F);} -static s7_pointer is_morally_equal_p_pp(s7_pointer a, s7_pointer b) {return((s7_is_morally_equal(cur_sc, a, b)) ? cur_sc->T : cur_sc->F);} +static s7_pointer is_equal_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return((s7_is_equal(sc, a, b)) ? sc->T : sc->F);} +static s7_pointer is_morally_equal_p_pp(s7_scheme *sc, s7_pointer a, s7_pointer b) {return((s7_is_morally_equal(sc, a, b)) ? sc->T : sc->F);} /* ---------------------------------------- length, copy, fill ---------------------------------------- */ @@ -42606,16 +42835,11 @@ static s7_pointer pair_length(s7_scheme *sc, s7_pointer a) s7_int i; s7_pointer slow, fast; slow = a; - fast = cdr(a); /* we know a is a pair */ - i = 1; + fast = a; /* we know a is a pair, don't start with fast = cdr(a)! if a len = 3, we never match */ + i = 0; while (true) { - if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i)); - fast = cdr(fast); - i++; - if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i)); - fast = cdr(fast); - i++; + LOOP_4(fast = cdr(fast); i++; if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i))); slow = cdr(slow); if (fast == slow) return(real_infinity); } @@ -42887,7 +43111,7 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) #endif case T_C_POINTER: - return(s7_make_c_pointer_with_type(sc, raw_pointer(source), raw_pointer_type(source), raw_pointer_info(source))); + return(s7_make_c_pointer_with_type(sc, c_pointer(source), c_pointer_type(source), c_pointer_info(source))); } return(source); } @@ -42896,6 +43120,9 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) have_indices = (is_pair(cddr(args))); if ((source == dest) && (!have_indices)) return(dest); + + if ((is_immutable(dest)) && (dest != sc->key_readable_symbol) && (dest != sc->nil)) /* error_hook copies with cadr(args) :readable, so it's currently NULL */ + return(s7_wrong_type_arg_error(sc, "copy", 2, dest, "a mutable object")); /* so this segfaults if not checking for :readable */ switch (type(source)) { @@ -42952,6 +43179,13 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) check_method(sc, source, sc->copy_symbol, args); if (source == sc->rootlet) return(wrong_type_argument_with_type(sc, caller, 1, source, wrap_string(sc, "a sequence other than the rootlet", 33))); + if ((!have_indices) && (is_let(dest))) + { + s7_pointer slot; + for (slot = let_slots(source); is_slot(slot); slot = next_slot(slot)) + make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot)); + return(dest); + } end = let_length(sc, source); break; @@ -42981,9 +43215,6 @@ static s7_pointer s7_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args) return(dest); } - if ((is_immutable(dest)) && (dest != sc->nil)) - return(s7_wrong_type_arg_error(sc, "copy", 2, dest, "a mutable object")); - switch (type(dest)) { case T_PAIR: @@ -44048,6 +44279,7 @@ static s7_pointer g_append(s7_scheme *sc, s7_pointer args) /* it's possible to see brand-new lists at optimization time and set them to be uncopied here, * but the various overheads swamp the gain. */ + if (is_null(args)) return(sc->nil); /* (append) -> () */ a1 = car(args); /* first arg determines result type unless all args but last are empty (sigh) */ if (is_null(cdr(args))) return(a1); /* (append <anything>) -> <anything> */ @@ -44079,22 +44311,22 @@ static s7_pointer g_append(s7_scheme *sc, s7_pointer args) return(wrong_type_argument_with_type(sc, sc->append_symbol, 1, a1, a_sequence_string)); /* (append 1 0) */ } -static s7_pointer append_p_pp(s7_pointer p1, s7_pointer p2) +static s7_pointer append_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { /* plist in use above */ s7_pointer val; - cur_sc->temp7 = list_2(cur_sc, p1, p2); - val = g_append(cur_sc, cur_sc->temp7); - cur_sc->temp7 = cur_sc->nil; + sc->temp7 = list_2(sc, p1, p2); + val = g_append(sc, sc->temp7); + sc->temp7 = sc->nil; return(val); } -static s7_pointer append_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3) +static s7_pointer append_p_ppp(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3) { s7_pointer val; - cur_sc->temp7 = list_3(cur_sc, p1, p2, p3); - val = g_append(cur_sc, cur_sc->temp7); - cur_sc->temp7 = cur_sc->nil; + sc->temp7 = list_3(sc, p1, p2, p3); + val = g_append(sc, sc->temp7); + sc->temp7 = sc->nil; return(val); } @@ -44149,7 +44381,7 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj) { s7_pointer val; val = s7_iterate(sc, obj); - if ((val == sc->ITERATOR_END) && + if ((val == ITERATOR_END) && (iterator_is_at_end(obj))) { sc->temp8 = sc->nil; @@ -44251,18 +44483,6 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) #define H_object_to_let "(object->let obj) returns a let (namespace) describing obj." #define Q_object_to_let s7_make_signature(sc, 2, sc->is_let_symbol, sc->T) -#if (!WITH_GMP) - static s7_pointer seed_symbol = NULL, carry_symbol = NULL; -#endif - static s7_pointer active_symbol = NULL, goto_symbol = NULL, data_symbol = NULL; - static s7_pointer dimensions_symbol = NULL, shared_symbol = NULL, info_symbol = NULL, c_type_symbol = NULL; - static s7_pointer at_end_symbol = NULL, sequence_symbol = NULL, position_symbol = NULL, entries_symbol = NULL; - static s7_pointer locked_symbol = NULL, function_symbol = NULL, open_symbol = NULL, alias_symbol = NULL, source_symbol = NULL; - static s7_pointer file_symbol = NULL, line_symbol = NULL, c_object_type_symbol = NULL, c_object_let_symbol = NULL; - static s7_pointer class_symbol = NULL, c_object_length_symbol = NULL, c_object_set_symbol = NULL, c_object_ref_symbol = NULL; - static s7_pointer c_object_copy_symbol = NULL, c_object_fill_symbol = NULL, c_object_reverse_symbol = NULL; - static s7_pointer c_object_to_list_symbol = NULL, c_object_to_string_symbol = NULL, closed_symbol = NULL, port_type_symbol = NULL; - s7_pointer obj; obj = car(args); @@ -44307,8 +44527,8 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_SYMBOL: return(g_local_inlet(sc, 6, sc->value_symbol, obj, - sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : sc->is_symbol_symbol, - sc->setter_symbol, (is_keyword(obj)) ? sc->F : g_symbol_setter(sc, args))); + sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : ((is_gensym(obj)) ? sc->is_gensym_symbol : sc->is_symbol_symbol), + sc->setter_symbol, (is_keyword(obj)) ? sc->F : g_setter(sc, args))); case T_STRING: return(g_local_inlet(sc, 6, sc->value_symbol, obj, @@ -44329,54 +44549,60 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) #if WITH_GMP return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)); #else - if (!seed_symbol) + if (!sc->seed_symbol) { - seed_symbol = s7_make_symbol(sc, "seed"); - carry_symbol = s7_make_symbol(sc, "carry"); + sc->seed_symbol = s7_make_symbol(sc, "seed"); + sc->carry_symbol = s7_make_symbol(sc, "carry"); } return(g_local_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol, - seed_symbol, s7_make_integer(sc, random_seed(obj)), - carry_symbol, s7_make_integer(sc, random_carry(obj)))); + sc->seed_symbol, s7_make_integer(sc, random_seed(obj)), + sc->carry_symbol, s7_make_integer(sc, random_carry(obj)))); #endif case T_GOTO: - if (!active_symbol) + if (!sc->active_symbol) { - active_symbol = s7_make_symbol(sc, "active"); - goto_symbol = s7_make_symbol(sc, "goto?"); + sc->active_symbol = s7_make_symbol(sc, "active"); + sc->goto_symbol = s7_make_symbol(sc, "goto?"); } return(g_local_inlet(sc, 6, sc->value_symbol, obj, - sc->type_symbol, goto_symbol, - active_symbol, s7_make_boolean(sc, call_exit_active(obj)))); + sc->type_symbol, sc->goto_symbol, + sc->active_symbol, s7_make_boolean(sc, call_exit_active(obj)))); case T_INT_VECTOR: case T_FLOAT_VECTOR: case T_VECTOR: - if (!dimensions_symbol) - { - dimensions_symbol = s7_make_symbol(sc, "dimensions"); - shared_symbol = s7_make_symbol(sc, "shared"); - } - return(g_local_inlet(sc, 10, sc->value_symbol, obj, - sc->type_symbol, - (is_int_vector(obj)) ? sc->is_int_vector_symbol : ((is_float_vector(obj)) ? sc->is_float_vector_symbol : sc->is_vector_symbol), - sc->length_symbol, s7_length(sc, obj), - dimensions_symbol, g_vector_dimensions(sc, set_plist_1(sc, obj)), - shared_symbol, ((vector_has_dimensional_info(obj)) && (is_normal_vector(shared_vector(obj)))) ? shared_vector(obj) : sc->F)); - + { + s7_pointer let; + if (!sc->dimensions_symbol) + sc->dimensions_symbol = s7_make_symbol(sc, "dimensions"); + if (!sc->position_symbol) + sc->position_symbol = s7_make_symbol(sc, "position"); + let = g_local_inlet(sc, 8, sc->value_symbol, obj, + sc->type_symbol, (is_subvector(obj)) ? cons(sc, sc->is_subvector_symbol, s7_type_of(sc, subvector_vector(obj))) : s7_type_of(sc, obj), + sc->length_symbol, s7_length(sc, obj), + sc->dimensions_symbol, g_vector_dimensions(sc, set_plist_1(sc, obj))); + if (is_subvector(obj)) + { + s7_varlet(sc, let, sc->position_symbol, make_integer(sc, (s7_int)(vector_elements(obj) - vector_elements(subvector_vector(obj))))); + s7_varlet(sc, let, sc->vector_symbol, subvector_vector(obj)); + } + return(let); + } + case T_C_POINTER: - /* raw_pointer_info can be a let and might have an object->let method (see c_object below) */ - if (!c_type_symbol) + /* c_pointer_info can be a let and might have an object->let method (see c_object below) */ + if (!sc->c_type_symbol) { - c_type_symbol = s7_make_symbol(sc, "c-type"); - info_symbol = s7_make_symbol(sc, "info"); + sc->c_type_symbol = s7_make_symbol(sc, "c-type"); + sc->info_symbol = s7_make_symbol(sc, "info"); } return(g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, sc->is_c_pointer_symbol, - sc->c_pointer_symbol, s7_make_integer(sc, (s7_int)((intptr_t)raw_pointer(obj))), - c_type_symbol, raw_pointer_type(obj), - info_symbol, raw_pointer_info(obj))); + sc->c_pointer_symbol, s7_make_integer(sc, (s7_int)((intptr_t)c_pointer(obj))), + sc->c_type_symbol, c_pointer_type(obj), + sc->info_symbol, c_pointer_info(obj))); case T_CONTINUATION: return(g_local_inlet(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol)); @@ -44384,16 +44610,16 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_ITERATOR: { s7_pointer let, seq; - if (!at_end_symbol) + if (!sc->at_end_symbol) { - at_end_symbol = s7_make_symbol(sc, "at-end"); - sequence_symbol = s7_make_symbol(sc, "sequence"); + sc->at_end_symbol = s7_make_symbol(sc, "at-end"); + sc->sequence_symbol = s7_make_symbol(sc, "sequence"); } seq = iterator_sequence(obj); let = g_local_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, sc->is_iterator_symbol, - at_end_symbol, s7_make_boolean(sc, iterator_is_at_end(obj)), - sequence_symbol, iterator_sequence(obj)); + sc->at_end_symbol, s7_make_boolean(sc, iterator_is_at_end(obj)), + sc->sequence_symbol, iterator_sequence(obj)); if (is_pair(seq)) s7_varlet(sc, let, sc->length_symbol, s7_length(sc, seq)); else @@ -44421,38 +44647,41 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_HASH_TABLE: { s7_pointer let; - if (!entries_symbol) + if (!sc->entries_symbol) { - entries_symbol = s7_make_symbol(sc, "entries"); - locked_symbol = s7_make_symbol(sc, "locked"); + sc->entries_symbol = s7_make_symbol(sc, "entries"); + sc->locked_symbol = s7_make_symbol(sc, "locked"); + sc->weak_symbol = s7_make_symbol(sc, "weak"); } - if (!function_symbol) - function_symbol = s7_make_symbol(sc, "function"); + if (!sc->function_symbol) + sc->function_symbol = s7_make_symbol(sc, "function"); let = g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, sc->is_hash_table_symbol, sc->length_symbol, s7_length(sc, obj), - entries_symbol, s7_make_integer(sc, hash_table_entries(obj)), - locked_symbol, s7_make_boolean(sc, hash_table_checker_locked(obj))); + sc->entries_symbol, s7_make_integer(sc, hash_table_entries(obj)), + sc->locked_symbol, s7_make_boolean(sc, hash_table_checker_locked(obj))); + if (is_weak_hash_table(obj)) + s7_varlet(sc, let, sc->weak_symbol, sc->T); if ((hash_table_checker(obj) == hash_eq) || (hash_table_checker(obj) == hash_c_function) || (hash_table_checker(obj) == hash_closure) || (hash_table_checker(obj) == hash_equal_eq) || (hash_table_checker(obj) == hash_equal_syntax) || (hash_table_checker(obj) == hash_symbol)) - s7_varlet(sc, let, function_symbol, sc->is_eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->is_eq_symbol); else { if (hash_table_checker(obj) == hash_eqv) - s7_varlet(sc, let, function_symbol, sc->is_eqv_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->is_eqv_symbol); else { if ((hash_table_checker(obj) == hash_equal) || (hash_table_checker(obj) == hash_empty)) - s7_varlet(sc, let, function_symbol, sc->is_equal_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->is_equal_symbol); else { if (hash_table_checker(obj) == hash_morally_equal) - s7_varlet(sc, let, function_symbol, sc->is_morally_equal_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->is_morally_equal_symbol); else { if ((hash_table_checker(obj) == hash_number) || @@ -44460,24 +44689,24 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) (hash_table_checker(obj) == hash_float) || (hash_table_checker(obj) == hash_equal_real) || (hash_table_checker(obj) == hash_equal_complex)) - s7_varlet(sc, let, function_symbol, sc->eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->eq_symbol); else { if (hash_table_checker(obj) == hash_string_or_byte_vector) - s7_varlet(sc, let, function_symbol, sc->string_eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->string_eq_symbol); else { if (hash_table_checker(obj) == hash_char) - s7_varlet(sc, let, function_symbol, sc->char_eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->char_eq_symbol); #if (!WITH_PURE_S7) else { if (hash_table_checker(obj) == hash_ci_char) - s7_varlet(sc, let, function_symbol, sc->char_ci_eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->char_ci_eq_symbol); else { if (hash_table_checker(obj) == hash_ci_string) - s7_varlet(sc, let, function_symbol, sc->string_ci_eq_symbol); + s7_varlet(sc, let, sc->function_symbol, sc->string_ci_eq_symbol); }} #endif }}}}}} @@ -44487,42 +44716,42 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_LET: { s7_pointer let; - if (!open_symbol) + if (!sc->open_symbol) { - open_symbol = s7_make_symbol(sc, "open"); - alias_symbol = s7_make_symbol(sc, "alias"); + sc->open_symbol = s7_make_symbol(sc, "open"); + sc->alias_symbol = s7_make_symbol(sc, "alias"); } - if (!function_symbol) - function_symbol = s7_make_symbol(sc, "function"); - if (!file_symbol) + if (!sc->function_symbol) + sc->function_symbol = s7_make_symbol(sc, "function"); + if (!sc->file_symbol) { - file_symbol = s7_make_symbol(sc, "file"); - line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = s7_make_symbol(sc, "file"); + sc->line_symbol = s7_make_symbol(sc, "line"); } let = g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, sc->is_let_symbol, sc->length_symbol, s7_length(sc, obj), - open_symbol, s7_make_boolean(sc, has_methods(obj)), + sc->open_symbol, s7_make_boolean(sc, has_methods(obj)), sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj)); if (obj == sc->rootlet) - s7_varlet(sc, let, alias_symbol, sc->rootlet_symbol); + s7_varlet(sc, let, sc->alias_symbol, sc->rootlet_symbol); else { if (obj == sc->owlet) /* this can't happen, I think -- owlet is always copied first */ - s7_varlet(sc, let, alias_symbol, sc->owlet_symbol); + s7_varlet(sc, let, sc->alias_symbol, sc->owlet_symbol); else { if (is_funclet(obj)) { - s7_varlet(sc, let, function_symbol, funclet_function(obj)); + s7_varlet(sc, let, sc->function_symbol, funclet_function(obj)); if ((has_let_file(obj)) && (let_file(obj) > 0) && (let_file(obj) < (s7_int)sc->file_names_top) && (let_line(obj) > 0) && (let_line(obj) < 100000)) { - s7_varlet(sc, let, file_symbol, sc->file_names[let_file(obj)]); - s7_varlet(sc, let, line_symbol, make_integer(sc, let_line(obj))); + s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(obj)]); + s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(obj))); } } } @@ -44545,44 +44774,44 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_C_OBJECT: { s7_pointer let, clet; - if (!class_symbol) + if (!sc->class_symbol) { - class_symbol = s7_make_symbol(sc, "class"); - c_object_type_symbol = s7_make_symbol(sc, "c-object-type"); - c_object_length_symbol = s7_make_symbol(sc, "c-object-length"); - c_object_ref_symbol = s7_make_symbol(sc, "c-object-ref"); - c_object_let_symbol = s7_make_symbol(sc, "c-object-let"); - c_object_set_symbol = s7_make_symbol(sc, "c-object-set!"); - c_object_copy_symbol = s7_make_symbol(sc, "c-object-copy"); - c_object_fill_symbol = s7_make_symbol(sc, "c-object-fill!"); - c_object_reverse_symbol = s7_make_symbol(sc, "c-object-reverse"); - c_object_to_list_symbol = s7_make_symbol(sc, "c-object->list"); - c_object_to_string_symbol = s7_make_symbol(sc, "c-object->string"); + sc->class_symbol = s7_make_symbol(sc, "class"); + sc->c_object_type_symbol = s7_make_symbol(sc, "c-object-type"); + sc->c_object_length_symbol = s7_make_symbol(sc, "c-object-length"); + sc->c_object_ref_symbol = s7_make_symbol(sc, "c-object-ref"); + sc->c_object_let_symbol = s7_make_symbol(sc, "c-object-let"); + sc->c_object_set_symbol = s7_make_symbol(sc, "c-object-set!"); + sc->c_object_copy_symbol = s7_make_symbol(sc, "c-object-copy"); + sc->c_object_fill_symbol = s7_make_symbol(sc, "c-object-fill!"); + sc->c_object_reverse_symbol = s7_make_symbol(sc, "c-object-reverse"); + sc->c_object_to_list_symbol = s7_make_symbol(sc, "c-object->list"); + sc->c_object_to_string_symbol = s7_make_symbol(sc, "c-object->string"); } clet = c_object_let(obj); let = g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, sc->is_c_object_symbol, - c_object_type_symbol, s7_make_integer(sc, c_object_type(obj)), - c_object_let_symbol, clet, - class_symbol, c_object_type_to_let(sc, obj)); + sc->c_object_type_symbol, s7_make_integer(sc, c_object_type(obj)), + sc->c_object_let_symbol, clet, + sc->class_symbol, c_object_type_to_let(sc, obj)); /* not sure these are useful */ if (c_object_len(sc, obj)) /* c_object_length is the object length, not the procedure */ - s7_varlet(sc, let, c_object_length_symbol, s7_lambda(sc, c_object_len(sc, obj), 1, 0, false)); + s7_varlet(sc, let, sc->c_object_length_symbol, s7_lambda(sc, c_object_len(sc, obj), 1, 0, false)); if (c_object_ref(sc, obj)) - s7_varlet(sc, let, c_object_ref_symbol, s7_lambda(sc, c_object_ref(sc, obj), 1, 0, true)); + s7_varlet(sc, let, sc->c_object_ref_symbol, s7_lambda(sc, c_object_ref(sc, obj), 1, 0, true)); if (c_object_set(sc, obj)) - s7_varlet(sc, let, c_object_set_symbol, s7_lambda(sc, c_object_set(sc, obj), 2, 0, true)); + s7_varlet(sc, let, sc->c_object_set_symbol, s7_lambda(sc, c_object_set(sc, obj), 2, 0, true)); if (c_object_copy(sc, obj)) - s7_varlet(sc, let, c_object_copy_symbol, s7_lambda(sc, c_object_copy(sc, obj), 1, 0, true)); + s7_varlet(sc, let, sc->c_object_copy_symbol, s7_lambda(sc, c_object_copy(sc, obj), 1, 0, true)); if (c_object_fill(sc, obj)) - s7_varlet(sc, let, c_object_fill_symbol, s7_lambda(sc, c_object_fill(sc, obj), 1, 0, true)); + s7_varlet(sc, let, sc->c_object_fill_symbol, s7_lambda(sc, c_object_fill(sc, obj), 1, 0, true)); if (c_object_reverse(sc, obj)) - s7_varlet(sc, let, c_object_reverse_symbol, s7_lambda(sc, c_object_reverse(sc, obj), 1, 0, true)); + s7_varlet(sc, let, sc->c_object_reverse_symbol, s7_lambda(sc, c_object_reverse(sc, obj), 1, 0, true)); if (c_object_to_list(sc, obj)) - s7_varlet(sc, let, c_object_to_list_symbol, s7_lambda(sc, c_object_to_list(sc, obj), 1, 0, true)); + s7_varlet(sc, let, sc->c_object_to_list_symbol, s7_lambda(sc, c_object_to_list(sc, obj), 1, 0, true)); if (c_object_to_string(sc, obj)) - s7_varlet(sc, let, c_object_to_string_symbol, s7_lambda(sc, c_object_to_string(sc, obj), 1, 1, false)); + s7_varlet(sc, let, sc->c_object_to_string_symbol, s7_lambda(sc, c_object_to_string(sc, obj), 1, 1, false)); if ((is_let(clet)) && ((has_methods(clet)) || (has_methods(obj)))) @@ -44604,42 +44833,42 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) case T_OUTPUT_PORT: { s7_pointer let; - if (!function_symbol) - function_symbol = s7_make_symbol(sc, "function"); - if (!file_symbol) + if (!sc->function_symbol) + sc->function_symbol = s7_make_symbol(sc, "function"); + if (!sc->file_symbol) { - file_symbol = s7_make_symbol(sc, "file"); - line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = s7_make_symbol(sc, "file"); + sc->line_symbol = s7_make_symbol(sc, "line"); } - if (!data_symbol) + if (!sc->data_symbol) { - data_symbol = s7_make_symbol(sc, "data"); - port_type_symbol = s7_make_symbol(sc, "port-type"); - closed_symbol = s7_make_symbol(sc, "closed"); - position_symbol = s7_make_symbol(sc, "position"); + sc->data_symbol = s7_make_symbol(sc, "data"); + sc->port_type_symbol = s7_make_symbol(sc, "port-type"); + sc->closed_symbol = s7_make_symbol(sc, "closed"); + if (!sc->position_symbol) sc->position_symbol = s7_make_symbol(sc, "position"); } let = g_local_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol, - port_type_symbol, (is_string_port(obj)) ? sc->string_symbol : ((is_file_port(obj)) ? file_symbol : function_symbol), - closed_symbol, s7_make_boolean(sc, port_is_closed(obj))); + sc->port_type_symbol, (is_string_port(obj)) ? sc->string_symbol : ((is_file_port(obj)) ? sc->file_symbol : sc->function_symbol), + sc->closed_symbol, s7_make_boolean(sc, port_is_closed(obj))); push_stack_no_let_no_code(sc, OP_GC_PROTECT, let); if (is_file_port(obj)) { - s7_varlet(sc, let, file_symbol, g_port_filename(sc, set_plist_1(sc, obj))); + s7_varlet(sc, let, sc->file_symbol, g_port_filename(sc, set_plist_1(sc, obj))); if (is_input_port(obj)) - s7_varlet(sc, let, line_symbol, g_port_line_number(sc, set_plist_1(sc, obj))); + s7_varlet(sc, let, sc->line_symbol, g_port_line_number(sc, set_plist_1(sc, obj))); } if ((is_string_port(obj)) && /* file port might not have a data buffer */ (port_data(obj)) && (port_data_size(obj) > 0)) { s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj))); - s7_varlet(sc, let, position_symbol, s7_make_integer(sc, port_position(obj))); + s7_varlet(sc, let, sc->position_symbol, s7_make_integer(sc, port_position(obj))); /* I think port_data need not be null-terminated, but s7_make_string assumes it is: * both valgrind and lib*san complain about the uninitialized data during strlen. */ if (port_position(obj) < sc->max_string_length) - s7_varlet(sc, let, data_symbol, s7_make_string_with_length(sc, (const char *)port_data(obj), port_position(obj))); + s7_varlet(sc, let, sc->data_symbol, s7_make_string_with_length(sc, (const char *)port_data(obj), port_position(obj))); } sc->stack_end -= 4; return(let); @@ -44655,13 +44884,13 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) s7_pointer let, sig; const char* doc; s7_int gc_loc; - if (!file_symbol) + if (!sc->file_symbol) { - file_symbol = s7_make_symbol(sc, "file"); - line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = s7_make_symbol(sc, "file"); + sc->line_symbol = s7_make_symbol(sc, "line"); } - if (!source_symbol) - source_symbol = s7_make_symbol(sc, "source"); + if (!sc->source_symbol) + sc->source_symbol = s7_make_symbol(sc, "source"); let = g_local_inlet(sc, 6, sc->value_symbol, obj, sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, sc->arity_symbol, s7_arity(sc, obj)); @@ -44684,15 +44913,15 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args) (let_file(flet) < (s7_int)sc->file_names_top) && (let_line(flet) > 0)) { - s7_varlet(sc, let, file_symbol, sc->file_names[let_file(flet)]); - s7_varlet(sc, let, line_symbol, make_integer(sc, let_line(flet))); + s7_varlet(sc, let, sc->file_symbol, sc->file_names[let_file(flet)]); + s7_varlet(sc, let, sc->line_symbol, make_integer(sc, let_line(flet))); } } if (closure_setter(obj) != sc->F) s7_varlet(sc, let, sc->local_setter_symbol, closure_setter(obj)); - s7_varlet(sc, let, source_symbol, + s7_varlet(sc, let, sc->source_symbol, append_in_place(sc, list_2(sc, (is_closure_star(obj)) ? sc->lambda_star_symbol : sc->lambda_symbol, closure_args(obj)), closure_body(obj))); @@ -44890,7 +45119,8 @@ static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e, cha } return(notes); } - if (is_pair(code)) + if ((is_pair(code)) && + (s7_list_length(sc, code) > 0)) { notes = stacktrace_walker(sc, car(code), e, notes, code_cols, total_cols, notes_start_col, as_comment); return(stacktrace_walker(sc, cdr(code), e, notes, code_cols, total_cols, notes_start_col, as_comment)); @@ -44898,7 +45128,7 @@ static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e, cha return(notes); } -static block_t *stacktrace_add_func(s7_pointer f, s7_pointer code, char *errstr, char *notes, s7_int code_max, bool as_comment) +static block_t *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, char *errstr, char *notes, s7_int code_max, bool as_comment) { s7_int newlen, errlen; char *newstr, *str; @@ -44909,7 +45139,7 @@ static block_t *stacktrace_add_func(s7_pointer f, s7_pointer code, char *errstr, (f != car(code))) { newlen = symbol_name_length(f) + errlen + 10; - newp = mallocate(newlen); + newp = mallocate(sc, newlen); newstr = (char *)block_data(newp); /* newstr[0] = '\0'; */ errlen = catstrs_direct(newstr, symbol_name(f), ": ", errstr, NULL); @@ -44917,7 +45147,7 @@ static block_t *stacktrace_add_func(s7_pointer f, s7_pointer code, char *errstr, else { newlen = errlen + 8; - newp = mallocate(newlen); + newp = mallocate(sc, newlen); newstr = (char *)block_data(newp); /* newstr[0] = '\0'; */ if ((errlen > 2) && (errstr[2] == '(')) @@ -44930,7 +45160,7 @@ static block_t *stacktrace_add_func(s7_pointer f, s7_pointer code, char *errstr, } newlen = code_max + 8 + ((notes) ? strlen(notes) : 0); - b = mallocate(newlen * sizeof(char)); + b = mallocate(sc, newlen * sizeof(char)); str = (char *)block_data(b); /* str[0] = '\0'; */ @@ -44956,7 +45186,7 @@ static block_t *stacktrace_add_func(s7_pointer f, s7_pointer code, char *errstr, catstrs(str, newlen, notes, "\n", NULL); } } - liberate(newp); + liberate(sc, newp); return(b); } @@ -44985,7 +45215,7 @@ static s7_pointer stacktrace_1(s7_scheme *sc, s7_int frames_max, s7_int code_col if ((is_let(cur_env)) && (cur_env != sc->rootlet)) notes = stacktrace_walker(sc, err_code, cur_env, NULL, code_cols, total_cols, notes_start_col, as_comment); - strp = stacktrace_add_func(f, err_code, string_value(errstr), notes, code_cols, as_comment); + strp = stacktrace_add_func(sc, f, err_code, string_value(errstr), notes, code_cols, as_comment); str = (char *)block_data(strp); } @@ -45032,18 +45262,18 @@ static s7_pointer stacktrace_1(s7_scheme *sc, s7_int frames_max, s7_int code_col if ((is_let(e)) && (e != sc->rootlet)) notes = stacktrace_walker(sc, code, e, NULL, code_cols, total_cols, notes_start_col, as_comment); - newp = stacktrace_add_func(f, code, codestr, notes, code_cols, as_comment); + newp = stacktrace_add_func(sc, f, code, codestr, notes, code_cols, as_comment); newstr = (char *)block_data(newp); if ((notes) && (notes != newstr) && (is_let(e)) && (e != sc->rootlet)) free(notes); newlen = strlen(newstr) + 1 + ((str) ? strlen(str) : 0); - catp = mallocate(newlen * sizeof(char)); + catp = mallocate(sc, newlen * sizeof(char)); catstr = (char *)block_data(catp); catstrs_direct(catstr, (str) ? str : "", newstr, NULL); - liberate(newp); - if (strp) liberate(strp); + liberate(sc, newp); + if (strp) liberate(sc, strp); strp = catp; str = (char *)block_data(strp); } @@ -45375,7 +45605,7 @@ s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg /* info list is '(format_string caller arg_n arg type_name descr) */ if (arg_n < 0) arg_n = 0; if (arg_n > 0) - return(wrong_type_arg_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer(arg_n), + return(wrong_type_arg_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer1(sc, arg_n), arg, type_name_string(sc, arg), wrap_string(sc, descr, safe_strlen(descr)))); return(simple_wrong_type_arg_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), arg, type_name_string(sc, arg), wrap_string(sc, descr, safe_strlen(descr)))); @@ -45403,7 +45633,7 @@ s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n if (arg_n < 0) arg_n = 0; if (arg_n > 0) - return(out_of_range_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer(arg_n), arg, + return(out_of_range_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), wrap_integer1(sc, arg_n), arg, wrap_string(sc, descr, safe_strlen(descr)))); return(simple_out_of_range_error_prepackaged(sc, wrap_string(sc, caller, safe_strlen(caller)), arg, wrap_string(sc, descr, safe_strlen(descr)))); @@ -45418,7 +45648,7 @@ s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_p static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg) { - return(s7_error(sc, sc->division_by_zero_symbol, set_elist_3(sc, sc->division_by_zero_error_string, caller, arg))); + return(s7_error(sc, sc->division_by_zero_symbol, set_elist_3(sc, wrap_string(sc, "~A: division by zero, ~S", 24), caller, arg))); } @@ -45433,7 +45663,7 @@ static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *desc static s7_pointer missing_method_error(s7_scheme *sc, s7_pointer method, s7_pointer obj) { - return(s7_error(sc, sc->missing_method_symbol, set_elist_3(sc, sc->missing_method_string, method, obj))); + return(s7_error(sc, sc->missing_method_symbol, set_elist_3(sc, missing_method_string, method, obj))); } @@ -45599,7 +45829,7 @@ static s7_pointer g_catch(s7_scheme *sc, s7_pointer args) if (is_symbol(closure_args(proc))) new_frame_with_slot(sc, closure_let(proc), sc->envir, closure_args(proc), sc->nil); else new_frame(sc, closure_let(proc), sc->envir); - push_stack_no_args(sc, OP_BEGIN1, T_Pair(sc->code)); + push_stack_no_args(sc, sc->begin_op, T_Pair(sc->code)); } else push_stack(sc, OP_APPLY, sc->nil, proc); @@ -45635,7 +45865,7 @@ static int32_t remember_file_name(s7_scheme *sc, const char *file) for (i = old_size; i < sc->file_names_size; i++) sc->file_names[i] = sc->F; } - sc->file_names[sc->file_names_top] = s7_make_permanent_string(file); + sc->file_names[sc->file_names_top] = s7_make_permanent_string(sc, file); return(sc->file_names_top); } @@ -45872,10 +46102,6 @@ static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int64_t top) /* catch handlers */ - -typedef bool (*catch_function)(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointer info, bool *reset_hook); -static catch_function catchers[OP_MAX_DEFINED + 1]; - /* here and below, don't free the catcher */ static bool catch_all_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointer info, bool *reset_hook) @@ -46137,6 +46363,10 @@ static bool catch_barrier_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_ static bool catch_hook_function(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointer info, bool *reset_hook) { sc->error_hook = stack_code(sc->stack, i); +#if S7_DEBUGGING + if (!s7_is_valid(sc, sc->error_hook)) + fprintf(stderr, "%s[%d]: error_hook bad\n", __func__, __LINE__); +#endif /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */ (*reset_hook) = true; /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */ @@ -46155,24 +46385,27 @@ static bool catch_let_temporarily_function(s7_scheme *sc, s7_int i, s7_pointer t return(false); } +typedef bool (*catch_function)(s7_scheme *sc, s7_int i, s7_pointer type, s7_pointer info, bool *reset_hook); +static catch_function catchers[OP_MAX_DEFINED + 1]; + static void init_catchers(void) { int32_t i; for (i = 0; i <= OP_MAX_DEFINED; i++) catchers[i] = NULL; - catchers[OP_CATCH_ALL] = catch_all_function; - catchers[OP_CATCH_2] = catch_2_function; - catchers[OP_CATCH_1] = catch_1_function; - catchers[OP_CATCH] = catch_1_function; - catchers[OP_DYNAMIC_WIND] = catch_dw_function; - catchers[OP_GET_OUTPUT_STRING] = catch_out_function; - catchers[OP_UNWIND_OUTPUT] = catch_out_function; - catchers[OP_UNWIND_INPUT] = catch_in_function; - catchers[OP_READ_DONE] = catch_read_function; /* perhaps an error during (read) */ - catchers[OP_EVAL_STRING] = catch_eval_function; - catchers[OP_BARRIER] = catch_barrier_function; - catchers[OP_DEACTIVATE_GOTO] = catch_goto_function; - catchers[OP_LET_TEMP_DONE] = catch_let_temporarily_function; - catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function; + catchers[OP_CATCH_ALL] = catch_all_function; + catchers[OP_CATCH_2] = catch_2_function; + catchers[OP_CATCH_1] = catch_1_function; + catchers[OP_CATCH] = catch_1_function; + catchers[OP_DYNAMIC_WIND] = catch_dw_function; + catchers[OP_GET_OUTPUT_STRING] = catch_out_function; + catchers[OP_UNWIND_OUTPUT] = catch_out_function; + catchers[OP_UNWIND_INPUT] = catch_in_function; + catchers[OP_READ_DONE] = catch_read_function; /* perhaps an error during (read) */ + catchers[OP_EVAL_STRING] = catch_eval_function; + catchers[OP_BARRIER] = catch_barrier_function; + catchers[OP_DEACTIVATE_GOTO] = catch_goto_function; + catchers[OP_LET_TEMP_DONE] = catch_let_temporarily_function; + catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function; } static s7_pointer g_throw(s7_scheme *sc, s7_pointer args) @@ -46268,13 +46501,12 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) if ((is_pair(cur_code)) && /* can be () if unexpected close paren read error */ (has_line_number(cur_code))) { - static int32_t last_line = -1; int32_t line; - line = (int32_t)pair_line(cur_code); /* cast to int32_t (from uint32_t) for last_line */ - if (line != last_line) + line = (int32_t)pair_line(cur_code); /* cast to int32_t (from uint32_t) for sc->last_error_line */ + if (line != sc->last_error_line) { int32_t file; - last_line = line; + sc->last_error_line = line; file = (int32_t)pair_file(cur_code); #if S7_DEBUGGING if (file > sc->file_names_top) @@ -46285,14 +46517,14 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) #endif if (line > 0) { - slot_set_value(sc->error_line, wrap_integer(line)); + slot_set_value(sc->error_line, wrap_integer3(sc, line)); slot_set_value(sc->error_file, sc->file_names[file]); } else { if (in_reader(sc)) { - slot_set_value(sc->error_line, wrap_integer(port_line_number(sc->input_port))); + slot_set_value(sc->error_line, wrap_integer3(sc, port_line_number(sc->input_port))); slot_set_value(sc->error_file, wrap_string(sc, port_filename(sc->input_port), port_filename_length(sc->input_port))); } else @@ -46307,7 +46539,7 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) { if (in_reader(sc)) { - slot_set_value(sc->error_line, wrap_integer(port_line_number(sc->input_port))); + slot_set_value(sc->error_line, wrap_integer3(sc, port_line_number(sc->input_port))); slot_set_value(sc->error_file, wrap_string(sc, port_filename(sc->input_port), port_filename_length(sc->input_port))); } else @@ -46385,11 +46617,11 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) block_t *b; s7_int len, str_len; len = string_length(car(info)) + 8; - b = mallocate(len); + b = mallocate(sc, len); errstr = (char *)block_data(b); str_len = catstrs_direct(errstr, "\n;", string_value(car(info)), NULL); format_to_port(sc, sc->error_port, errstr, cdr(info), NULL, false, str_len); - liberate(b); + liberate(sc, b); } else format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7); } @@ -46410,12 +46642,12 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) if (filename) format_to_port(sc, sc->error_port, "\n; ~A[~D]", set_plist_2(sc, wrap_string(sc, filename, port_filename_length(sc->input_port)), - wrap_integer(line)), NULL, false, 10); + wrap_integer3(sc, line)), NULL, false, 10); else { if ((line > 0) && (slot_value(sc->error_line) != sc->F)) - format_to_port(sc, sc->error_port, "\n; line ~D", set_plist_1(sc, wrap_integer(line)), NULL, false, 11); + format_to_port(sc, sc->error_port, "\n; line ~D", set_plist_1(sc, wrap_integer3(sc, line)), NULL, false, 11); else { if (is_pair(sc->input_port_stack)) @@ -46431,7 +46663,7 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info) if (filename) format_to_port(sc, sc->error_port, "\n; ~A[~D]", set_plist_2(sc, wrap_string(sc, filename, port_filename_length(sc->input_port)), - wrap_integer(line)), NULL, false, 10); + wrap_integer3(sc, line)), NULL, false, 10); } } } @@ -46778,7 +47010,7 @@ static s7_pointer missing_close_paren_error(s7_scheme *sc) if ((port_line_number(pt) > 0) && (port_filename(pt))) { - slot_set_value(sc->error_line, wrap_integer(port_line_number(pt))); + slot_set_value(sc->error_line, wrap_integer3(sc, port_line_number(pt))); slot_set_value(sc->error_file, wrap_string(sc, port_filename(pt), port_filename_length(pt))); } result = s7_call(sc, sc->missing_close_paren_hook, sc->nil); @@ -46885,6 +47117,7 @@ void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val) void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val)) { sc->begin_hook = hook; + sc->begin_op = (hook) ? OP_BEGIN0 : OP_BEGIN1; } static bool call_begin_hook(s7_scheme *sc) @@ -47050,20 +47283,31 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic * * this applies to non-homogeneous cases, so float|int-vectors don't get here */ + /* fprintf(stderr, "obj: %s %s\n", type_name_from_type(type(obj), 0), DISPLAY_80(obj)); */ switch (type(obj)) { case T_VECTOR: /* (#(#(1 2) #(3 4)) 1 1) -> 4 */ - return(vector_ref_1(sc, obj, indices)); + return(vector_ref_1(sc, obj, indices, true)); + + case T_FLOAT_VECTOR: + set_car(sc->u1_1, obj); + set_cdr(sc->u1_1, indices); + return(univect_ref(sc, sc->u1_1, true)); + + case T_INT_VECTOR: + set_car(sc->u1_1, obj); + set_cdr(sc->u1_1, indices); + return(univect_ref(sc, sc->u1_1, false)); case T_STRING: /* (#("12" "34") 0 1) -> #\2 */ if (is_null(cdr(indices))) { if (!is_integer(car(indices))) return(wrong_type_argument(sc, sc->string_ref_symbol, 2, car(indices), T_INTEGER)); - return(string_ref_p_pi_direct(obj, integer(car(indices)))); + return(string_ref_p_pi_direct(sc, obj, integer(car(indices)))); } - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices))); case T_BYTE_VECTOR: if (is_null(cdr(indices))) @@ -47074,10 +47318,10 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic i1 = integer(car(indices)); if ((i1 < 0) || (i1 >= byte_vector_length(obj))) - out_of_range(sc, sc->byte_vector_ref_symbol, small_int(2), wrap_integer(i1), (i1 < 0) ? its_negative_string : its_too_large_string); + out_of_range(sc, sc->byte_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); return(make_integer(sc, (byte_vector_bytes(obj))[i1])); } - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices))); case T_PAIR: /* (#((1 2) (3 4)) 1 0) -> 3, (#((1 (2 3))) 0 1 0) -> 2 */ obj = list_ref_1(sc, obj, car(indices)); @@ -47093,8 +47337,8 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic case T_C_OBJECT: /* return((*(c_object_ref(sc, obj)))(sc, cons(sc, obj, indices))); */ - car(sc->u1_1) = obj; - cdr(sc->u1_1) = indices; + set_car(sc->u1_1, obj); + set_cdr(sc->u1_1, indices); return((*(c_object_ref(sc, obj)))(sc, sc->u1_1)); case T_LET: @@ -47103,10 +47347,13 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic return(implicit_index(sc, obj, cdr(indices))); return(obj); + case T_ITERATOR: /* indices is not nil, so this is an error */ + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices))); + default: /* (#(a b c) 0 1) -> error, but ((list (lambda (x) x)) 0 "hi") -> "hi" */ if (is_applicable(obj)) return(g_apply(sc, list_2(sc, obj, indices))); - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, obj, indices))); } } @@ -47145,7 +47392,9 @@ static s7_pointer set_c_function_star_args(s7_scheme *sc) { s7_pointer kpar, karg; int32_t ki; - /* oops -- there are keywords, change scanners (much duplicated code...) */ + /* oops -- there are keywords, change scanners (much duplicated code...) + * setting checked on the call_args here rather than parsing the parameters to use add_symbol_to_list + */ for (kpar = call_args; kpar != par; kpar = cdr(kpar)) set_checked(kpar); for (; is_pair(kpar); kpar = cdr(kpar)) @@ -47179,11 +47428,11 @@ static s7_pointer set_c_function_star_args(s7_scheme *sc) } } if (!is_null(karg)) - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, func, sc->args))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, func, sc->args))); if (ki < n_args) { df = c_function_arg_defaults(func); - if (has_simple_defaults(func)) + if (c_func_has_simple_defaults(func)) { for (ki = i, kpar = par; ki < n_args; ki++, kpar = cdr(kpar)) if (!is_checked(kpar)) @@ -47211,11 +47460,11 @@ static s7_pointer set_c_function_star_args(s7_scheme *sc) } } if (!is_null(arg)) - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, func, sc->args))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, func, sc->args))); if (i < n_args) { df = c_function_arg_defaults(func); - if (has_simple_defaults(func)) + if (c_func_has_simple_defaults(func)) { for (; i < n_args; i++, par = cdr(par)) set_car(par, df[i]); @@ -47240,7 +47489,59 @@ static s7_pointer set_c_function_star_args(s7_scheme *sc) return(call_args); } +static s7_pointer set_c_function_star_defaults(s7_scheme *sc, int32_t num) +{ + s7_pointer *df; + s7_pointer call_args, func, par; + int32_t i, n_args; + + func = sc->code; + n_args = c_function_all_args(func); + df = c_function_arg_defaults(func); + + if (is_safe_procedure(func)) + call_args = c_function_call_args(func); + else + { + int32_t tx; + tx = next_tx(sc); + call_args = make_list(sc, n_args, sc->F); + sc->t_temps[tx] = call_args; + } + + par = call_args; + if (num == 1) + { + set_car(par, car(sc->args)); + par = cdr(par); + } + + if (c_func_has_simple_defaults(func)) + { + for (i = num; i < n_args; i++, par = cdr(par)) + set_car(par, df[i]); + } + else + { + for (i = num; i < n_args; i++, par = cdr(par)) + { + s7_pointer defval; + defval = df[i]; + if (is_symbol(defval)) + set_car(par, symbol_to_value_checked(sc, defval)); + else + { + if (is_pair(defval)) + set_car(par, s7_eval(sc, defval, sc->nil)); + else set_car(par, defval); + } + } + } + return(call_args); +} + #define apply_c_function_star(Sc) Sc->value = c_function_call(Sc->code)(Sc, set_c_function_star_args(Sc)) +#define apply_c_function_star_fill_defaults(Sc, Num) Sc->value = c_function_call(Sc->code)(Sc, set_c_function_star_defaults(Sc, Num)) s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args) { @@ -47414,82 +47715,76 @@ s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args /* -------------------------------- type-of -------------------------------- */ -static s7_pointer type_to_typers[NUM_TYPES]; - static inline bool gen_type_match(s7_scheme *sc, s7_pointer val, uint8_t typ) /* opt_con3 = uint8_t */ { return((type(val) == typ) || ((has_methods(val)) && - (apply_boolean_method(sc, val, type_to_typers[typ]) != sc->F))); + (apply_boolean_method(sc, val, sc->type_to_typers[typ]) != sc->F))); } static void init_typers(s7_scheme *sc) { - type_to_typers[T_FREE] = sc->F; - type_to_typers[T_PAIR] = sc->is_pair_symbol; - type_to_typers[T_NIL] = sc->is_null_symbol; - type_to_typers[T_EOF_OBJECT] = sc->is_eof_object_symbol; - type_to_typers[T_UNDEFINED] = sc->is_undefined_symbol; - type_to_typers[T_UNSPECIFIED] = sc->is_unspecified_symbol; - type_to_typers[T_BOOLEAN] = sc->is_boolean_symbol; - type_to_typers[T_CHARACTER] = sc->is_char_symbol; - type_to_typers[T_SYMBOL] = sc->is_symbol_symbol; /* and keyword? */ - type_to_typers[T_SYNTAX] = sc->is_syntax_symbol; - type_to_typers[T_INTEGER] = sc->is_integer_symbol; - type_to_typers[T_RATIO] = sc->is_rational_symbol; - type_to_typers[T_REAL] = sc->is_float_symbol; - type_to_typers[T_COMPLEX] = sc->is_complex_symbol; - type_to_typers[T_BIG_INTEGER] = sc->is_integer_symbol; - type_to_typers[T_BIG_RATIO] = sc->is_rational_symbol; - type_to_typers[T_BIG_REAL] = sc->is_float_symbol; - type_to_typers[T_BIG_COMPLEX] = sc->is_complex_symbol; - type_to_typers[T_STRING] = sc->is_string_symbol; - type_to_typers[T_BYTE_VECTOR] = sc->is_byte_vector_symbol; - type_to_typers[T_C_OBJECT] = sc->is_c_object_symbol; - type_to_typers[T_VECTOR] = sc->is_vector_symbol; - type_to_typers[T_INT_VECTOR] = sc->is_int_vector_symbol; - type_to_typers[T_FLOAT_VECTOR] = sc->is_float_vector_symbol; - type_to_typers[T_CATCH] = sc->F; - type_to_typers[T_DYNAMIC_WIND] = sc->F; - type_to_typers[T_HASH_TABLE] = sc->is_hash_table_symbol; - type_to_typers[T_LET] = sc->is_let_symbol; - type_to_typers[T_ITERATOR] = sc->is_iterator_symbol; - type_to_typers[T_STACK] = sc->F; - type_to_typers[T_COUNTER] = sc->F; - type_to_typers[T_SLOT] = sc->F; - type_to_typers[T_C_POINTER] = sc->is_c_pointer_symbol; - type_to_typers[T_OUTPUT_PORT] = sc->is_output_port_symbol; - type_to_typers[T_INPUT_PORT] = sc->is_input_port_symbol; - type_to_typers[T_BAFFLE] = sc->F; - type_to_typers[T_RANDOM_STATE] = sc->is_random_state_symbol; - type_to_typers[T_GOTO] = sc->F; /* (continuation? goto) -> #f -- we need a type indicator for this */ - type_to_typers[T_CONTINUATION] = sc->is_continuation_symbol; - type_to_typers[T_CLOSURE] = sc->is_procedure_symbol; - type_to_typers[T_CLOSURE_STAR] = sc->is_procedure_symbol; - type_to_typers[T_C_MACRO] = sc->is_macro_symbol; - type_to_typers[T_MACRO] = sc->is_macro_symbol; - type_to_typers[T_MACRO_STAR] = sc->is_macro_symbol; - type_to_typers[T_BACRO] = sc->is_macro_symbol; - type_to_typers[T_BACRO_STAR] = sc->is_macro_symbol; - type_to_typers[T_C_FUNCTION] = sc->is_procedure_symbol; - type_to_typers[T_C_FUNCTION_STAR] = sc->is_procedure_symbol; - type_to_typers[T_C_ANY_ARGS_FUNCTION] = sc->is_procedure_symbol; - type_to_typers[T_C_OPT_ARGS_FUNCTION] = sc->is_procedure_symbol; - type_to_typers[T_C_RST_ARGS_FUNCTION] = sc->is_procedure_symbol; -} - -s7_pointer s7_type_of(s7_pointer arg) {return(type_to_typers[type(arg)]);} + sc->type_to_typers[T_FREE] = sc->F; + sc->type_to_typers[T_PAIR] = sc->is_pair_symbol; + sc->type_to_typers[T_NIL] = sc->is_null_symbol; + sc->type_to_typers[T_EOF_OBJECT] = sc->is_eof_object_symbol; + sc->type_to_typers[T_UNDEFINED] = sc->is_undefined_symbol; + sc->type_to_typers[T_UNSPECIFIED] = sc->is_unspecified_symbol; + sc->type_to_typers[T_BOOLEAN] = sc->is_boolean_symbol; + sc->type_to_typers[T_CHARACTER] = sc->is_char_symbol; + sc->type_to_typers[T_SYMBOL] = sc->is_symbol_symbol; /* and keyword? */ + sc->type_to_typers[T_SYNTAX] = sc->is_syntax_symbol; + sc->type_to_typers[T_INTEGER] = sc->is_integer_symbol; + sc->type_to_typers[T_RATIO] = sc->is_rational_symbol; + sc->type_to_typers[T_REAL] = sc->is_float_symbol; + sc->type_to_typers[T_COMPLEX] = sc->is_complex_symbol; + sc->type_to_typers[T_BIG_INTEGER] = sc->is_integer_symbol; + sc->type_to_typers[T_BIG_RATIO] = sc->is_rational_symbol; + sc->type_to_typers[T_BIG_REAL] = sc->is_float_symbol; + sc->type_to_typers[T_BIG_COMPLEX] = sc->is_complex_symbol; + sc->type_to_typers[T_STRING] = sc->is_string_symbol; + sc->type_to_typers[T_BYTE_VECTOR] = sc->is_byte_vector_symbol; + sc->type_to_typers[T_C_OBJECT] = sc->is_c_object_symbol; + sc->type_to_typers[T_VECTOR] = sc->is_vector_symbol; + sc->type_to_typers[T_INT_VECTOR] = sc->is_int_vector_symbol; + sc->type_to_typers[T_FLOAT_VECTOR] = sc->is_float_vector_symbol; + sc->type_to_typers[T_CATCH] = sc->F; + sc->type_to_typers[T_DYNAMIC_WIND] = sc->F; + sc->type_to_typers[T_HASH_TABLE] = sc->is_hash_table_symbol; + sc->type_to_typers[T_LET] = sc->is_let_symbol; + sc->type_to_typers[T_ITERATOR] = sc->is_iterator_symbol; + sc->type_to_typers[T_STACK] = sc->F; + sc->type_to_typers[T_COUNTER] = sc->F; + sc->type_to_typers[T_SLOT] = sc->F; + sc->type_to_typers[T_C_POINTER] = sc->is_c_pointer_symbol; + sc->type_to_typers[T_OUTPUT_PORT] = sc->is_output_port_symbol; + sc->type_to_typers[T_INPUT_PORT] = sc->is_input_port_symbol; + sc->type_to_typers[T_BAFFLE] = sc->F; + sc->type_to_typers[T_RANDOM_STATE] = sc->is_random_state_symbol; + sc->type_to_typers[T_GOTO] = sc->F; /* (continuation? goto) -> #f -- we need a type indicator for this */ + sc->type_to_typers[T_CONTINUATION] = sc->is_continuation_symbol; + sc->type_to_typers[T_CLOSURE] = sc->is_procedure_symbol; + sc->type_to_typers[T_CLOSURE_STAR] = sc->is_procedure_symbol; + sc->type_to_typers[T_C_MACRO] = sc->is_macro_symbol; + sc->type_to_typers[T_MACRO] = sc->is_macro_symbol; + sc->type_to_typers[T_MACRO_STAR] = sc->is_macro_symbol; + sc->type_to_typers[T_BACRO] = sc->is_macro_symbol; + sc->type_to_typers[T_BACRO_STAR] = sc->is_macro_symbol; + sc->type_to_typers[T_C_FUNCTION] = sc->is_procedure_symbol; + sc->type_to_typers[T_C_FUNCTION_STAR] = sc->is_procedure_symbol; + sc->type_to_typers[T_C_ANY_ARGS_FUNCTION] = sc->is_procedure_symbol; + sc->type_to_typers[T_C_OPT_ARGS_FUNCTION] = sc->is_procedure_symbol; + sc->type_to_typers[T_C_RST_ARGS_FUNCTION] = sc->is_procedure_symbol; +} + +s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg) {return(sc->type_to_typers[type(arg)]);} static s7_pointer g_type_of(s7_scheme *sc, s7_pointer args) { #define H_type_of "(type-of obj) returns a symbol describing obj's type" #define Q_type_of s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_boolean_symbol), sc->T) - int32_t tp; - tp = type(car(args)); - if ((tp >= 0) && (tp < NUM_TYPES)) - return(type_to_typers[type(car(args))]); - return(s7_make_symbol(sc, "unknown!")); + return(sc->type_to_typers[type(car(args))]); } @@ -47498,7 +47793,8 @@ static s7_pointer g_type_of(s7_scheme *sc, s7_pointer args) static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args) { #define H_s7_version "(s7-version) returns some string describing the current s7" - #define Q_s7_version pcl_s + #define Q_s7_version sc->pcl_s + #if WITH_COUNTERS sc->print_length = 1000; /* fprintf(stderr, "%s\n", DISPLAY(counters)); */ @@ -47522,7 +47818,7 @@ static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args) return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE)); } -static s7_pointer s7_version_p(void) {return(s7_make_string(cur_sc, "s7 " S7_VERSION ", " S7_DATE));} +static s7_pointer s7_version_p(s7_scheme *sc) {return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));} void s7_quit(s7_scheme *sc) @@ -47753,19 +48049,19 @@ static s7_pointer all_x_is_symbol_s(s7_scheme *sc, s7_pointer arg) return((is_symbol(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); } -static s7_pointer all_x_is_pair_s(s7_scheme *sc, s7_pointer arg) +static s7_pointer all_x_is_type_s(s7_scheme *sc, s7_pointer arg) { - return((is_pair(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return(make_boolean(sc, (uint8_t)(opt_con3(cdr(arg))) == type(symbol_to_value_unchecked(sc, cadr(arg))))); } -static s7_pointer all_x_is_keyword_s(s7_scheme *sc, s7_pointer arg) +static s7_pointer all_x_is_integer_s(s7_scheme *sc, s7_pointer arg) { - return((is_keyword(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_integer(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); } -static s7_pointer all_x_is_integer_s(s7_scheme *sc, s7_pointer arg) +static s7_pointer all_x_is_string_s(s7_scheme *sc, s7_pointer arg) { - return((is_integer(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_string(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer all_x_is_procedure_s(s7_scheme *sc, s7_pointer arg) @@ -47773,9 +48069,14 @@ static s7_pointer all_x_is_procedure_s(s7_scheme *sc, s7_pointer arg) return((is_procedure(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); } -static s7_pointer all_x_is_string_s(s7_scheme *sc, s7_pointer arg) +static s7_pointer all_x_is_pair_s(s7_scheme *sc, s7_pointer arg) { - return((is_string(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_pair(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); +} + +static s7_pointer all_x_is_keyword_s(s7_scheme *sc, s7_pointer arg) +{ + return((is_keyword(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer all_x_is_vector_s(s7_scheme *sc, s7_pointer arg) @@ -47850,6 +48151,11 @@ static s7_pointer all_x_c_hash_table_ref_car(s7_scheme *sc, s7_pointer arg) return(hash_entry_value(x)); } +static s7_pointer all_x_c_lint_let_ref(s7_scheme *sc, s7_pointer arg) +{ + return(g_lint_let_ref(sc, cdr(arg))); +} + static s7_pointer all_x_c_qs(s7_scheme *sc, s7_pointer arg) { set_car(sc->t2_1, cadadr(arg)); @@ -48009,6 +48315,14 @@ static s7_pointer all_x_c_cdr_s(s7_scheme *sc, s7_pointer arg) return(c_call(arg)(sc, sc->t1_1)); } +static s7_pointer all_x_c_is_type_opsq(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer val; + val = symbol_to_value_unchecked(sc, opt_sym2(cdr(arg))); + set_car(sc->t1_1, val); + return(make_boolean(sc, (uint8_t)(opt_con3(cdr(arg))) == type(c_call(cadr(arg))(sc, sc->t1_1)))); +} + static s7_pointer all_x_c_not_opsq(s7_scheme *sc, s7_pointer arg) { s7_pointer largs; @@ -48224,7 +48538,7 @@ static s7_pointer direct_x_c_c_opssq(s7_scheme *sc, s7_pointer arg) largs = caddr(arg); x2 = ((s7_d_pd_t)opt_direct_x(cddr(arg)))(symbol_to_value_unchecked(sc, cadr(largs)), real_to_double(sc, symbol_to_value_unchecked(sc, caddr(largs)), "number_to_double")); - return(((s7_p_dd_t)opt_direct_x_call(cdr(arg)))(real_to_double(sc, cadr(arg), "*"), x2)); + return(((s7_p_dd_t)opt_direct_x_call(cdr(arg)))(sc, real_to_double(sc, cadr(arg), "*"), x2)); } @@ -48286,10 +48600,9 @@ static s7_pointer all_x_c_c_opsq(s7_scheme *sc, s7_pointer arg) static s7_pointer direct_x_c_opsq_opsq(s7_scheme *sc, s7_pointer arg) { s7_double x1, x2; - cur_sc = sc; x1 = ((s7_d_p_t)opt_direct_x(cdr(arg)))(symbol_to_value_unchecked(sc, cadr(cadr(arg)))); x2 = ((s7_d_p_t)opt_direct_x(cddr(arg)))(symbol_to_value_unchecked(sc, cadr(caddr(arg)))); - return(((s7_p_dd_t)opt_direct_x_call(cdr(arg)))(x1, x2)); + return(((s7_p_dd_t)opt_direct_x_call(cdr(arg)))(sc, x1, x2)); } @@ -48674,14 +48987,24 @@ static s7_pointer all_x_or2(s7_scheme *sc, s7_pointer arg) return(c_call(p)(sc, car(p))); } -static s7_pointer all_x_closure_s(s7_scheme *sc, s7_pointer code) +static s7_pointer all_x_closure_s_a(s7_scheme *sc, s7_pointer code) { - /* no gain from all_x for the body rather than safe_c_c */ s7_pointer result, old_e; old_e = sc->envir; sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), symbol_to_value_unchecked(sc, opt_sym2(code))); - code = car(closure_body(opt_lambda(code))); - result = c_call(code)(sc, cdr(code)); + code = closure_body(opt_lambda(code)); + result = c_call(code)(sc, car(code)); + sc->envir = old_e; + return(result); +} + +static s7_pointer all_x_closure_s_c(s7_scheme *sc, s7_pointer code) +{ + s7_pointer result, old_e; + old_e = sc->envir; + sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), symbol_to_value_unchecked(sc, opt_sym2(code))); + code = closure_body(opt_lambda(code)); + result = c_call(car(code))(sc, cdar(code)); sc->envir = old_e; return(result); } @@ -48692,23 +49015,34 @@ static s7_pointer all_x_and_2_closure_s(s7_scheme *sc, s7_pointer code) old_e = sc->envir; sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), symbol_to_value_unchecked(sc, opt_sym2(code))); - code = cdar(closure_body(opt_lambda(code))); result = c_call(code)(sc, car(code)); if (result != sc->F) result = c_call(cdr(code))(sc, cadr(code)); - sc->envir = old_e; return(result); } -static s7_pointer all_x_closure_a(s7_scheme *sc, s7_pointer code) +static s7_pointer all_x_closure_a_a(s7_scheme *sc, s7_pointer code) { s7_pointer result, old_e; old_e = sc->envir; sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code))); - code = car(closure_body(opt_lambda(code))); - result = c_call(code)(sc, cdr(code)); + code = closure_body(opt_lambda(code)); + result = c_call(code)(sc, car(code)); + sc->envir = old_e; + return(result); +} + +static s7_pointer all_x_closure_ss_a(s7_scheme *sc, s7_pointer code) +{ + s7_pointer result, old_e; + old_e = sc->envir; + sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), + symbol_to_value_unchecked(sc, cadr(code)), + symbol_to_value_unchecked(sc, opt_sym2(code))); + code = closure_body(opt_lambda(code)); + result = c_call(code)(sc, car(code)); sc->envir = old_e; return(result); } @@ -48796,14 +49130,14 @@ static void all_x_function_init(void) all_x_function[HOP_SAFE_C_CSS] = all_x_c_css; all_x_function[HOP_SAFE_C_CSC] = all_x_c_csc; all_x_function[HOP_SAFE_C_CCS] = all_x_c_ccs; - all_x_function[HOP_SAFE_CLOSURE_S_C] = all_x_closure_s; - all_x_function[HOP_SAFE_CLOSURE_S_L] = all_x_closure_s; - all_x_function[HOP_SAFE_CLOSURE_A_C] = all_x_closure_a; all_x_function[HOP_SAFE_C_ALL_S] = all_x_c_all_s; all_x_function[HOP_SAFE_C_opAq] = all_x_c_opaq; all_x_function[HOP_SAFE_C_opAq_S] = all_x_c_opaq_s; all_x_function[HOP_SAFE_C_S_opAq] = all_x_c_s_opaq; all_x_function[HOP_SAFE_QUOTE] = all_x_q; + all_x_function[HOP_SAFE_CLOSURE_S_A] = all_x_closure_s_a; + all_x_function[HOP_SAFE_CLOSURE_A_A] = all_x_closure_a_a; + all_x_function[HOP_SAFE_CLOSURE_SS_A] = all_x_closure_ss_a; } static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args); @@ -48897,24 +49231,33 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa return(all_x_c_hash_table_ref_ss); if (c_call(arg) == g_hash_table_ref_car) return(all_x_c_hash_table_ref_car); + if (c_call(arg) == g_lint_let_ref) + return(all_x_c_lint_let_ref); return(all_x_c_c); case HOP_SAFE_C_S: if (car(arg) == sc->cdr_symbol) return(all_x_cdr_s); if (car(arg) == sc->car_symbol) return(all_x_car_s); if (car(arg) == sc->cadr_symbol) return(all_x_cadr_s); - if (is_global(car(arg))) + if (is_global(car(arg))) /* guard against (op arg) where arg is a let with an op method */ { + uint8_t typ; if (car(arg) == sc->is_null_symbol) return(all_x_is_null_s); if (car(arg) == sc->is_pair_symbol) return(all_x_is_pair_s); if (car(arg) == sc->is_symbol_symbol) return(all_x_is_symbol_s); - if (car(arg) == sc->is_keyword_symbol) return(all_x_is_keyword_s); if (car(arg) == sc->is_integer_symbol) return(all_x_is_integer_s); - if (car(arg) == sc->is_procedure_symbol) return(all_x_is_procedure_s); if (car(arg) == sc->is_string_symbol) return(all_x_is_string_s); - if (car(arg) == sc->is_vector_symbol) return(all_x_is_vector_s); - if (car(arg) == sc->is_proper_list_symbol) return(all_x_is_proper_list_s); if (car(arg) == sc->not_symbol) return(all_x_not_s); + if (car(arg) == sc->is_proper_list_symbol) return(all_x_is_proper_list_s); + if (car(arg) == sc->is_vector_symbol) return(all_x_is_vector_s); + if (car(arg) == sc->is_keyword_symbol) return(all_x_is_keyword_s); + if (car(arg) == sc->is_procedure_symbol) return(all_x_is_procedure_s); + typ = symbol_type(car(arg)); + if (typ > 0) + { + set_opt_any3(cdr(arg), (s7_pointer)((intptr_t)typ)); + return(all_x_is_type_s); + } } return(all_x_c_s); @@ -48930,6 +49273,17 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa set_opt_sym2(cdr(arg), cadadr(arg)); return(all_x_c_cdr_s); } + if (is_global(car(arg))) /* (? (op arg)) where (op arg) might return a let with a ? method etc */ + { /* other possibility: all_x_c_a */ + uint8_t typ; + typ = symbol_type(car(arg)); + if (typ > 0) /* h_safe_c here so the type checker isn't shadowed */ + { + set_opt_sym2(cdr(arg), cadadr(arg)); + set_opt_any3(cdr(arg), (s7_pointer)((intptr_t)typ)); + return(all_x_c_is_type_opsq); + } + } return(all_x_c_opsq); case HOP_SAFE_C_SQ: @@ -48969,14 +49323,20 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa } return(NULL); - case HOP_SAFE_CLOSURE_S_C: - if (c_call(car(closure_body(opt_lambda(arg)))) == g_and_2) - return(all_x_and_2_closure_s); - case HOP_SAFE_CLOSURE_S_L: - return(all_x_closure_s); - + case HOP_SAFE_CLOSURE_S_A: + { + s7_pointer body; + body = car(closure_body(opt_lambda(arg))); + if ((is_pair(body)) && + (is_h_safe_c_c(body))) + { + if (c_call(body) == g_and_2) + return(all_x_and_2_closure_s); + return(all_x_closure_s_c); + } + } default: - /* if ((!all_x_function[optimize_op(arg)]) && (is_h_optimized(arg))) fprintf(stderr, "all_x_eval %s %s\n", DISPLAY(arg), opt_names[optimize_op(arg)]); */ + /* if ((!all_x_function[optimize_op(arg)]) && (is_h_optimized(arg))) fprintf(stderr, "all_x_eval %s %s\n", DISPLAY(arg), op_names[optimize_op(arg)]); */ return(all_x_function[optimize_op(arg)]); } } /* is_optimized */ @@ -49003,10 +49363,10 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa /* -------------------------------------------------------------------------------- */ -enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_pi, o_d_ip, o_d_pd, o_d_pid, o_d, o_d_d, o_d_dd, o_d_ddd, o_d_dddd, - o_i_d, o_i_i, o_i_ii, o_i_iii, o_i_p, o_i_pi, o_i_pii, o_d_p, - o_b_p, o_b_p_direct, o_b_pp, o_b_pp_direct, o_b_pi, o_b_ii, o_b_dd, - o_p, o_p_p, o_p_ii, o_p_dd, +enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_ip, o_d_pd, o_d_7pid, o_d, o_d_d, o_d_dd, o_d_7dd, o_d_ddd, o_d_dddd, + o_i_i, o_i_7i, o_i_ii, o_i_7ii, o_i_iii, o_i_7pi, o_i_7pii, o_d_p, + o_b_p, o_b_p_direct, o_b_7p, o_b_pp, o_b_7pp, o_b_pp_direct, o_b_pi, o_b_ii, o_b_dd, + o_p, o_p_p, o_p_ii, o_p_dd, o_i_7d, o_i_7p, o_d_7d, o_d_7p, o_p_pp, o_p_pp_direct, o_p_ppp, o_p_ppp_direct, o_p_pi, o_p_pi_direct, o_p_ppi, o_p_pip, o_p_pip_direct, o_b_i, o_b_d}; static void add_opt_func(s7_pointer f, int32_t typ, void *func) @@ -49059,8 +49419,8 @@ s7_d_vid_t s7_d_vid_function(s7_pointer f) {return((s7_d_vid_t)opt_func(f, o_d_v void s7_set_d_id_function(s7_pointer f, s7_d_id_t df) {add_opt_func(f, o_d_id, (void *)df);} s7_d_id_t s7_d_id_function(s7_pointer f) {return((s7_d_id_t)opt_func(f, o_d_id));} -void s7_set_d_pid_function(s7_pointer f, s7_d_pid_t df) {add_opt_func(f, o_d_pid, (void *)df);} -s7_d_pid_t s7_d_pid_function(s7_pointer f) {return((s7_d_pid_t)opt_func(f, o_d_pid));} +void s7_set_d_7pid_function(s7_pointer f, s7_d_7pid_t df) {add_opt_func(f, o_d_7pid, (void *)df);} +s7_d_7pid_t s7_d_7pid_function(s7_pointer f) {return((s7_d_7pid_t)opt_func(f, o_d_7pid));} void s7_set_d_ip_function(s7_pointer f, s7_d_ip_t df) {add_opt_func(f, o_d_ip, (void *)df);} s7_d_ip_t s7_d_ip_function(s7_pointer f) {return((s7_d_ip_t)opt_func(f, o_d_ip));} @@ -49068,17 +49428,17 @@ s7_d_ip_t s7_d_ip_function(s7_pointer f) {return((s7_d_ip_t)opt_func(f, o_d_ip)) void s7_set_d_pd_function(s7_pointer f, s7_d_pd_t df) {add_opt_func(f, o_d_pd, (void *)df);} s7_d_pd_t s7_d_pd_function(s7_pointer f) {return((s7_d_pd_t)opt_func(f, o_d_pd));} -void s7_set_i_p_function(s7_pointer f, s7_i_p_t df) {add_opt_func(f, o_i_p, (void *)df);} -s7_i_p_t s7_i_p_function(s7_pointer f) {return((s7_i_p_t)opt_func(f, o_i_p));} - void s7_set_d_p_function(s7_pointer f, s7_d_p_t df) {add_opt_func(f, o_d_p, (void *)df);} s7_d_p_t s7_d_p_function(s7_pointer f) {return((s7_d_p_t)opt_func(f, o_d_p));} void s7_set_b_p_function(s7_pointer f, s7_b_p_t df) {add_opt_func(f, o_b_p, (void *)df);} s7_b_p_t s7_b_p_function(s7_pointer f) {return((s7_b_p_t)opt_func(f, o_b_p));} -void s7_set_d_pi_function(s7_pointer f, s7_d_pi_t df) {add_opt_func(f, o_d_pi, (void *)df);} -s7_d_pi_t s7_d_pi_function(s7_pointer f) {return((s7_d_pi_t)opt_func(f, o_d_pi));} +void s7_set_d_7pi_function(s7_pointer f, s7_d_7pi_t df) {add_opt_func(f, o_d_7pi, (void *)df);} +s7_d_7pi_t s7_d_7pi_function(s7_pointer f) {return((s7_d_7pi_t)opt_func(f, o_d_7pi));} + +void s7_set_i_7p_function(s7_pointer f, s7_i_7p_t df) {add_opt_func(f, o_i_7p, (void *)df);} +s7_i_7p_t s7_i_7p_function(s7_pointer f) {return((s7_i_7p_t)opt_func(f, o_i_7p));} /* cload.scm */ void s7_set_d_ddd_function(s7_pointer f, s7_d_ddd_t df) {add_opt_func(f, o_d_ddd, (void *)df);} @@ -49093,8 +49453,18 @@ s7_i_i_t s7_i_i_function(s7_pointer f) {return((s7_i_i_t)opt_func(f, o_i_i));} void s7_set_i_ii_function(s7_pointer f, s7_i_ii_t df) {add_opt_func(f, o_i_ii, (void *)df);} s7_i_ii_t s7_i_ii_function(s7_pointer f) {return((s7_i_ii_t)opt_func(f, o_i_ii));} -void s7_set_i_d_function(s7_pointer f, s7_i_d_t df) {add_opt_func(f, o_i_d, (void *)df);} -s7_i_d_t s7_i_d_function(s7_pointer f) {return((s7_i_d_t)opt_func(f, o_i_d));} +void s7_set_i_7d_function(s7_pointer f, s7_i_7d_t df) {add_opt_func(f, o_i_7d, (void *)df);} +s7_i_7d_t s7_i_7d_function(s7_pointer f) {return((s7_i_7d_t)opt_func(f, o_i_7d));} + + +static void s7_set_d_7dd_function(s7_pointer f, s7_d_7dd_t df) {add_opt_func(f, o_d_7dd, (void *)df);} +static s7_d_7dd_t s7_d_7dd_function(s7_pointer f) {return((s7_d_7dd_t)opt_func(f, o_d_7dd));} + +static void s7_set_i_7i_function(s7_pointer f, s7_i_7i_t df) {add_opt_func(f, o_i_7i, (void *)df);} +static s7_i_7i_t s7_i_7i_function(s7_pointer f) {return((s7_i_7i_t)opt_func(f, o_i_7i));} + +static void s7_set_i_7ii_function(s7_pointer f, s7_i_7ii_t df) {add_opt_func(f, o_i_7ii, (void *)df);} +static s7_i_7ii_t s7_i_7ii_function(s7_pointer f) {return((s7_i_7ii_t)opt_func(f, o_i_7ii));} static void s7_set_i_iii_function(s7_pointer f, s7_i_iii_t df) {add_opt_func(f, o_i_iii, (void *)df);} s7_i_iii_t s7_i_iii_function(s7_pointer f) {return((s7_i_iii_t)opt_func(f, o_i_iii));} @@ -49105,11 +49475,11 @@ static s7_p_pi_t s7_p_pi_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o static void s7_set_p_ppi_function(s7_pointer f, s7_p_ppi_t df) {add_opt_func(f, o_p_ppi, (void *)df);} static s7_p_ppi_t s7_p_ppi_function(s7_pointer f) {return((s7_p_ppi_t)opt_func(f, o_p_ppi));} -static void s7_set_i_pi_function(s7_pointer f, s7_i_pi_t df) {add_opt_func(f, o_i_pi, (void *)df);} -static s7_i_pi_t s7_i_pi_function(s7_pointer f) {return((s7_i_pi_t)opt_func(f, o_i_pi));} +static void s7_set_i_7pi_function(s7_pointer f, s7_i_7pi_t df) {add_opt_func(f, o_i_7pi, (void *)df);} +static s7_i_7pi_t s7_i_7pi_function(s7_pointer f) {return((s7_i_7pi_t)opt_func(f, o_i_7pi));} -static void s7_set_i_pii_function(s7_pointer f, s7_i_pii_t df) {add_opt_func(f, o_i_pii, (void *)df);} -static s7_i_pii_t s7_i_pii_function(s7_pointer f) {return((s7_i_pii_t)opt_func(f, o_i_pii));} +static void s7_set_i_7pii_function(s7_pointer f, s7_i_7pii_t df) {add_opt_func(f, o_i_7pii, (void *)df);} +static s7_i_7pii_t s7_i_7pii_function(s7_pointer f) {return((s7_i_7pii_t)opt_func(f, o_i_7pii));} static void s7_set_b_d_function(s7_pointer f, s7_b_d_t df) {add_opt_func(f, o_b_d, (void *)df);} static s7_b_d_t s7_b_d_function(s7_pointer f) {return((s7_b_d_t)opt_func(f, o_b_d));} @@ -49120,9 +49490,21 @@ static s7_b_i_t s7_b_i_function(s7_pointer f) {return((s7_b_i_t)opt_func(f, o_b_ static void s7_set_b_p_direct_function(s7_pointer f, s7_b_p_t df) {add_opt_func(f, o_b_p_direct, (void *)df);} static s7_b_p_t s7_b_p_direct_function(s7_pointer f) {return((s7_b_p_t)opt_func(f, o_b_p_direct));} +void s7_set_b_7p_function(s7_pointer f, s7_b_7p_t df) {add_opt_func(f, o_b_7p, (void *)df);} +s7_b_7p_t s7_b_7p_function(s7_pointer f) {return((s7_b_7p_t)opt_func(f, o_b_7p));} + static void s7_set_b_pp_function(s7_pointer f, s7_b_pp_t df) {add_opt_func(f, o_b_pp, (void *)df);} static s7_b_pp_t s7_b_pp_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp));} +static void s7_set_b_7pp_function(s7_pointer f, s7_b_7pp_t df) {add_opt_func(f, o_b_7pp, (void *)df);} +static s7_b_7pp_t s7_b_7pp_function(s7_pointer f) {return((s7_b_7pp_t)opt_func(f, o_b_7pp));} + +static void s7_set_d_7d_function(s7_pointer f, s7_d_7d_t df) {add_opt_func(f, o_d_7d, (void *)df);} +static s7_d_7d_t s7_d_7d_function(s7_pointer f) {return((s7_d_7d_t)opt_func(f, o_d_7d));} + +static void s7_set_d_7p_function(s7_pointer f, s7_d_7p_t df) {add_opt_func(f, o_d_7p, (void *)df);} +static s7_d_7p_t s7_d_7p_function(s7_pointer f) {return((s7_d_7p_t)opt_func(f, o_d_7p));} + #if (!WITH_GMP) static void s7_set_b_pi_function(s7_pointer f, s7_b_pi_t df) {add_opt_func(f, o_b_pi, (void *)df);} #endif @@ -49172,10 +49554,447 @@ static void s7_set_p_dd_function(s7_pointer f, s7_p_dd_t df) {add_opt_func(f, o_ #endif static s7_p_dd_t s7_p_dd_function(s7_pointer f) {return((s7_p_dd_t)opt_func(f, o_p_dd));} +#define oo_slots(p) p->typ.vt[0] +#define oo_size(p) p->typ.vt[1] +#define oo_slot_offset 2 +#define oo_type_offset 6 + +#define OO_P 0 +#define OO_I 1 +#define OO_D 2 +#define OO_V 3 +#define OO_IV 4 +#define OO_FV 5 +#define OO_PV 6 +#define OO_R 7 +#define OO_H 8 +#define OO_S 9 +#define OO_BV 10 +#define OO_L 11 +#define OO_E 12 +#define OO_AV 13 -#define DEBUGGING_ALLOC_OPO 0 +#if 0 +static const char *oo_types[14] = {"OO_P", "OO_I", "OO_D", "OO_V", "OO_IV", "OO_FV", "OO_PV", "OO_R", "OO_H", "OO_S", "OO_BV", "OO_L", "OO_E", "OO_AV"}; +#endif + +static const s7_int oo_to_s7[14] = {-1, 1LL << T_INTEGER, 1LL << T_REAL, 1LL << T_C_OBJECT, 1LL << T_INT_VECTOR, + 1LL << T_FLOAT_VECTOR, 1LL << T_VECTOR, (1LL << T_REAL) + (1LL << T_RATIO) + (1LL << T_INTEGER), + 1LL << T_HASH_TABLE, 1LL << T_STRING, 1LL << T_BYTE_VECTOR, 1LL << T_PAIR, 1LL << T_LET, + (1LL << T_VECTOR) + (1LL << T_INT_VECTOR) + (1LL << T_FLOAT_VECTOR)}; #if S7_DEBUGGING -static opt_info *alloc_opo(s7_scheme *sc, s7_pointer expr) +#define oo_func(p) p->func +#define oo_line(p) p->line +#endif + +#define oo_symbol_base (NUM_VUNIONS - 4) + +static bool check_slot_type(s7_scheme *sc, s7_pointer slot, opt_info *o, int32_t i, const char *func, int line) +{ + s7_pointer val; + uint8_t recorded_val_type; + + recorded_val_type = o->typ.vt[(i >> 1) + oo_type_offset]; + recorded_val_type = ((i & 1) == 0) ? (recorded_val_type & 0xf) : ((recorded_val_type >> 4) & 0xf); + if (recorded_val_type == OO_P) return(true); + + val = slot_value(slot); +#if S7_DEBUGGING + if (!s7_is_valid(sc, val)) + return(false); + if ((oo_to_s7[recorded_val_type] & (1 << type(val))) == 0) + { +#if OPT_DEBUGGING + fprintf(stderr, "%s[%d] -> %s[%d]: %s wants %s but got %s\n", + oo_func(o), oo_line(o), func, line, + symbol_name(slot_symbol(slot)), oo_to_type_name[recorded_val_type], + DISPLAY(g_type_of(sc, set_plist_1(sc, val)))); +#endif + return(false); + } + return(true); +#else + return((oo_to_s7[recorded_val_type] & (1 << type(val))) != 0); +#endif +} + +#if S7_DEBUGGING +#define oo_check(Sc, O) oo_check_1(Sc, O, __func__, __LINE__) +static void oo_check_1(s7_scheme *sc, opt_info *o, const char *func, int32_t line) +{ + int32_t i, slots, size; + size = oo_size(o); + if ((size <= 0) || (size > NUM_VUNIONS)) + fprintf(stderr, "%s[%d]: oo_size: %d (%s[%d]\n", func, line, size, oo_func(o), oo_line(o)); + slots = oo_slots(o); + if ((slots < 0) || (slots >= size)) + fprintf(stderr, "%s[%d]: oo_slots: %d, size: %d\n", func, line, slots, size); + if ((size + slots) >= NUM_VUNIONS) + fprintf(stderr, "%s[%d]: oo_size + oo_slots: %d, top_size: %d\n", func, line, size + slots, NUM_VUNIONS); + for (i = 0; i < slots; i++) + { + s7_pointer slot = NULL; + int32_t p_addr, obj_addr; + p_addr = o->typ.vt[i + oo_slot_offset] & 0xf; + obj_addr = (o->typ.vt[i + oo_slot_offset] >> 4) & 0xf; + if (p_addr >= size) + fprintf(stderr, "%s[%d]: v[%d].p but size = %d\n", func, line, p_addr, size); + else + { + slot = o->v[p_addr].p; + if (!slot) + fprintf(stderr, "%s[%d]: v[%d].p is null\n", func, line, p_addr); + else + { + if (!s7_is_valid(sc, slot)) + fprintf(stderr, "%s[%d]: v[%d].p is not valid\n", func, line, p_addr); + else + { + if (!is_slot(slot)) + fprintf(stderr, "%s[%d]: v[%d].p is not a slot\n", func, line, p_addr); + else + { + if (slot_symbol(slot) != o->v[oo_symbol_base + i].p) + { + fprintf(stderr, "%s[%d]: symbol mismatch %p (%s) at %d != %p (%s) at %d, from %s[%d]\n", + func, line, + slot_symbol(slot), DISPLAY(slot_symbol(slot)), p_addr, + o->v[oo_symbol_base + i].p, + (s7_is_valid(sc, o->v[oo_symbol_base + i].p)) ? DISPLAY(o->v[oo_symbol_base + i].p) : "unknown", oo_symbol_base + i, + oo_func(o), oo_line(o)); + abort(); + } + check_slot_type(sc, slot, o, i, func, line); + } + } + } + } + if ((slot) && (obj_addr > 0)) + { + if (obj_addr >= size) + fprintf(stderr, "%s[%d]: v[%d].obj but size = %d\n", func, line, obj_addr, size); + else + { + s7_pointer obj, value; + obj = slot_value(slot); + value = o->v[obj_addr].obj; + if (!obj) + fprintf(stderr, "%s[%d]: v[%d].obj is null\n", func, line, obj_addr); + else + { + if (!s7_is_valid(sc, obj)) + fprintf(stderr, "%s[%d]: v[%d].obj is not valid\n", func, line, obj_addr); + else + { + if (!is_c_object(obj)) + fprintf(stderr, "%s[%d]: v[%d].obj is not a c_object\n", func, line, obj_addr); + else + { + if (value != s7_c_object_value(obj)) + fprintf(stderr, "%s[%d]: c_object value does not match\n", func, line); + } + } + } + } + } + } +} + +#define oo_rcheck(Sc, O, Size, Slots) oo_rcheck_1(Sc, O, Size, Slots, __func__, __LINE__) +static void oo_rcheck_1(s7_scheme *sc, opt_info *o, int size, int slots, const char *func, int32_t line) +{ + int32_t i; + if (oo_size(o) < size) + fprintf(stderr, "%s[%d]: o[%s[%d]] size: %d, desired: %d\n", func, line, oo_func(o), oo_line(o), oo_size(o), size); + if (oo_slots(o) < slots) + fprintf(stderr, "%s[%d]: o[%s[%d]] slots: %d, desired: %d\n", func, line, oo_func(o), oo_line(o), oo_slots(o), slots); + if ((oo_size(o) + oo_slots(o)) >= NUM_VUNIONS) + fprintf(stderr, "%s[%d]: o[%s[%d]] size+slots: %d (rcheck: %d)\n", func, line, oo_func(o), oo_line(o), oo_size(o) + oo_slots(o), size + slots); + for (i = 0; i < slots; i++) + { + int32_t p_addr; + s7_pointer slot; + p_addr = o->typ.vt[i + oo_slot_offset] & 0xf; + slot = o->v[p_addr].p; + if (!slot) + fprintf(stderr, "%s[%d]: o[%s[%d]] slot[%d] is null\n", func, line, oo_func(o), oo_line(o), i); + if (!(o->v[oo_symbol_base + i].p)) + fprintf(stderr, "%s[%d]: o[%s[%d]] symbol[%d at %d] is null\n", func, line, oo_func(o), oo_line(o), i, oo_symbol_base + i); + if ((is_slot(slot)) && + (is_symbol(o->v[oo_symbol_base + i].p))) + { + if (slot_symbol(slot) != o->v[oo_symbol_base + i].p) + fprintf(stderr, "%s[%d]: %s at %d != %s at %d (size: %d)\n", + func, line, + symbol_name(slot_symbol(slot)), p_addr, + symbol_name(o->v[oo_symbol_base + i].p), oo_symbol_base + i, + oo_size(o)); + check_slot_type(sc, slot, o, i, func, line); + } + else fprintf(stderr, "%s[%d]: slot/symbol: <%s> %s\n", func, line, DISPLAY(slot), DISPLAY(o->v[oo_symbol_base + i].p)); + } +} + +static void oo_clear(opt_info *o) +{ + int32_t i; + for (i = oo_size(o); i < NUM_VUNIONS; i++) + o->v[i].p = NULL; +} + +#else +#define oo_check(sc, p) +#define oo_rcheck(sc, p, size, slots) +#define oo_clear(p) +#define oo_func(p) +#define oo_line(p) +#endif + +#define oo_set_type_0(P, Size) oo_set_type_0_1(P, Size, __func__, __LINE__) +static opt_info *oo_set_type_0_1(opt_info *p, int size, const char *func, int line) +{ + p->typ.vtype = 0; + oo_slots(p) = 0; + oo_size(p) = size; +#if S7_DEBUGGING + oo_func(p) = func; + oo_line(p) = line; +#endif + return(p); +} + +/* slot value types stored from type_offset: type1 + (type2 << 4) | type3 + (type4 << 4) (leftmost=low index) */ + +#define oo_set_type_1(P, Size, Slot1, Type1) oo_set_type_1_1(P, Size, Slot1, Type1, __func__, __LINE__) +static opt_info *oo_set_type_1_1(opt_info *p, int size, int slot1, int type1, const char *func, int line) +{ +#if S7_DEBUGGING + if ((type1 < 0) || (type1 > OO_AV)) fprintf(stderr, "%s[%d]: type1: %d\n", func, line, type1); + if ((type1 == OO_V) && ((slot1 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr1?\n", func, line); + /* fprintf(stderr, "%s[%d]: type_1 (%d %s)\n",func, line, slot1, oo_types[type1]); */ +#endif + p->typ.vtype = 0; + oo_slots(p) = 1; + oo_size(p) = size; + p->typ.vt[0 + oo_slot_offset] = (uint8_t)slot1; + p->typ.vt[0 + oo_type_offset] = type1; + p->v[oo_symbol_base].p = slot_symbol(p->v[slot1 & 0xf].p); +#if S7_DEBUGGING + oo_func(p) = func; + oo_line(p) = line; +#endif + return(p); +} + +#define oo_set_type_2(P, Size, Slot1, Slot2, Type1, Type2) oo_set_type_2_1(P, Size, Slot1, Slot2, Type1, Type2, __func__, __LINE__) +static opt_info *oo_set_type_2_1(opt_info *p, int size, int slot1, int slot2, int type1, int type2, const char *func, int line) +{ +#if S7_DEBUGGING + if ((type1 < 0) || (type1 > OO_AV)) fprintf(stderr, "%s[%d]: type1: %d\n", func, line, type1); + if ((type1 == OO_V) && ((slot1 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr1?\n", func, line); + if ((type2 < 0) || (type2 > OO_AV)) fprintf(stderr, "%s[%d]: type2: %d\n", func, line, type2); + if ((type2 == OO_V) && ((slot2 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr2?\n", func, line); + /* fprintf(stderr, "%s[%d]: type_2 (%d %s) (%d %s)\n",func, line, slot1, oo_types[type1], slot2, oo_types[type2]); */ +#endif + p->typ.vtype = 0; + oo_slots(p) = 2; + oo_size(p) = size; + p->typ.vt[0 + oo_slot_offset] = (uint8_t)slot1; + p->typ.vt[1 + oo_slot_offset] = (uint8_t)slot2; + p->typ.vt[0 + oo_type_offset] = type1 + (type2 << 4); + p->v[oo_symbol_base].p = slot_symbol(p->v[slot1 & 0xf].p); + p->v[oo_symbol_base + 1].p = slot_symbol(p->v[slot2 & 0xf].p); +#if S7_DEBUGGING + oo_func(p) = func; + oo_line(p) = line; +#endif + return(p); +} + +#define oo_set_type_3(P, Size, Slot1, Slot2, Slot3, Type1, Type2, Type3) oo_set_type_3_1(P, Size, Slot1, Slot2, Slot3, Type1, Type2, Type3, __func__, __LINE__) +static opt_info *oo_set_type_3_1(opt_info *p, int size, int slot1, int slot2, int slot3, int type1, int type2, int type3, const char *func, int line) +{ +#if S7_DEBUGGING + if ((type1 < 0) || (type1 > OO_AV)) fprintf(stderr, "%s[%d]: type1: %d\n", func, line, type1); + if ((type1 == OO_V) && ((slot1 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr1?\n", func, line); + if ((type2 < 0) || (type2 > OO_AV)) fprintf(stderr, "%s[%d]: type2: %d\n", func, line, type2); + if ((type2 == OO_V) && ((slot2 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr2?\n", func, line); + if ((type3 < 0) || (type3 > OO_AV)) fprintf(stderr, "%s[%d]: type3: %d\n", func, line, type3); + if ((type3 == OO_V) && ((slot3 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr3?\n", func, line); + /* fprintf(stderr, "%s[%d]: type_3 (%d %s) (%d %s) (%d %s)\n", func, line, slot1, oo_types[type1], slot2, oo_types[type2], slot3, oo_types[type3]); */ +#endif + p->typ.vtype = 0; + oo_slots(p) = 3; + oo_size(p) = size; + p->typ.vt[0 + oo_slot_offset] = (uint8_t)slot1; + p->typ.vt[1 + oo_slot_offset] = (uint8_t)slot2; + p->typ.vt[2 + oo_slot_offset] = (uint8_t)slot3; + p->typ.vt[0 + oo_type_offset] = type1 + (type2 << 4); + p->typ.vt[1 + oo_type_offset] = type3; + p->v[oo_symbol_base].p = slot_symbol(p->v[slot1 & 0xf].p); + p->v[oo_symbol_base + 1].p = slot_symbol(p->v[slot2 & 0xf].p); + p->v[oo_symbol_base + 2].p = slot_symbol(p->v[slot3 & 0xf].p); +#if S7_DEBUGGING + oo_func(p) = func; + oo_line(p) = line; +#endif + return(p); +} + +#define oo_set_type_4(P, Size, Slot1, Slot2, Slot3, Slot4, Type1, Type2, Type3, Type4) \ + oo_set_type_4_1(P, Size, Slot1, Slot2, Slot3, Slot4, Type1, Type2, Type3, Type4, __func__, __LINE__) +static opt_info *oo_set_type_4_1(opt_info *p, int size, int slot1, int slot2, int slot3, int slot4, int type1, int type2, int type3, int type4, const char *func, int line) +{ +#if S7_DEBUGGING + if ((type1 < 0) || (type1 > OO_AV)) fprintf(stderr, "%s[%d]: type1: %d\n", func, line, type1); + if ((type1 == OO_V) && ((slot1 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr1?\n", func, line); + if ((type2 < 0) || (type2 > OO_AV)) fprintf(stderr, "%s[%d]: type2: %d\n", func, line, type2); + if ((type2 == OO_V) && ((slot2 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr2?\n", func, line); + if ((type3 < 0) || (type3 > OO_AV)) fprintf(stderr, "%s[%d]: type3: %d\n", func, line, type3); + if ((type3 == OO_V) && ((slot3 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr3?\n", func, line); + if ((type4 < 0) || (type4 > OO_AV)) fprintf(stderr, "%s[%d]: type4: %d\n", func, line, type4); + if ((type4 == OO_V) && ((slot4 >> 4) == 0)) fprintf(stderr, "%s[%d]: missing obj addr4?\n", func, line); + /* fprintf(stderr, "%s[%d]: type_4 (%d %s) (%d %s) (%d %s) (%d %s)\n", func, line, slot1, + oo_types[type1], slot2, oo_types[type2], slot3, oo_types[type3], slot4, oo_types[type4]); + */ +#endif + p->typ.vtype = 0; + oo_slots(p) = 4; + oo_size(p) = size; + p->typ.vt[0 + oo_slot_offset] = (uint8_t)slot1; + p->typ.vt[1 + oo_slot_offset] = (uint8_t)slot2; + p->typ.vt[2 + oo_slot_offset] = (uint8_t)slot3; + p->typ.vt[3 + oo_slot_offset] = (uint8_t)slot4; + p->typ.vt[0 + oo_type_offset] = type1 + (type2 << 4); + p->typ.vt[1 + oo_type_offset] = type3 + (type4 << 4); + p->v[oo_symbol_base].p = slot_symbol(p->v[slot1].p); + p->v[oo_symbol_base + 1].p = slot_symbol(p->v[slot2 & 0xf].p); + p->v[oo_symbol_base + 2].p = slot_symbol(p->v[slot3 & 0xf].p); + p->v[oo_symbol_base + 3].p = slot_symbol(p->v[slot4 & 0xf].p); +#if S7_DEBUGGING + oo_func(p) = func; + oo_line(p) = line; +#endif + return(p); +} + +static void oo_resize(opt_info *o, int32_t new_size) +{ +#if 0 + int32_t i, j, k, old_size, slots; + old_size = oo_size(o); + slots = oo_slots(o); + oo_size(o) = new_size; + for (i = 0, j = old_size, k = new_size; i < slots; i++, j++, k++) + o->v[k].p = o->v[j].p; +#else + oo_size(o) = new_size; +#endif +} + +#define oo_fixup_slots(sc, o) oo_fixup_slots_1(sc, o, __func__, __LINE__) +static bool oo_fixup_slots_1(s7_scheme *sc, opt_info *o, const char *func, int line) +{ + /* TODO: local lets + * we need a way to recognize a local let and an end-of-body index, and the loop needs to call fixup_slots once the + * local let is in place (how to tell we're restoring rather than creating?) + * + * but opt_do_2 for example has the let built-in as o->v[2].p + * save the old sc->envir, attach the new and move to it, and go on, but when to pop out? o->sc->pc = o->v[5].i? + * where to store the stack of end-points? Or perhaps use recursion here: pass to fixup_slots_upto(...) + * none of the do-opts has outer vars to fixup, + * + * opc->v[0].fp is opt_do_2 (all do's are size=8, slots=0) + * oo_fixup_slots handles one opt_info struct, fixup_slots below handles all + * + * set oo_slots to 255? + */ + int32_t i; + for (i = 0; i < oo_slots(o); i++) + { + int32_t vun, vobj; + s7_pointer slot; + vun = o->typ.vt[i + oo_slot_offset] & 0xf; + vobj = (o->typ.vt[i + oo_slot_offset] >> 4) & 0xf; + slot = symbol_to_slot(sc, o->v[oo_symbol_base + i].p); + if (!is_slot(slot)) + { +#if OPT_DEBUGGING + fprintf(stderr, "fixup can't find %s\n", symbol_name(o->v[oo_symbol_base + i].p)); +#endif + return(false); + } + if (!check_slot_type(sc, slot, o, i, func, line)) + { +#if OPT_DEBUGGING + fprintf(stderr, "fixup %s's type is wrong\n", symbol_name(o->v[oo_symbol_base + i].p)); +#endif + return(false); + } + o->v[vun].p = slot; + if (vobj > 0) + { + if (!is_c_object(slot_value(slot))) + { +#if OPT_DEBUGGING + fprintf(stderr, "fixup %s value is not a c_object\n", symbol_name(o->v[oo_symbol_base + i].p)); +#endif + return(false); + } + o->v[vobj].obj = (void *)s7_c_object_value(slot_value(slot)); + } + } + return(true); +} + +static void make_base_optlist(s7_scheme *sc) +{ + opt_info *os; + int32_t i; + os = (opt_info *)calloc(OPTS_SIZE, sizeof(opt_info)); + sc->base_opts = os; + for (i = 0; i < OPTS_SIZE; i++) + { + opt_info *o; + o = &os[i]; + sc->opts[i] = o; + o->sc = sc; + } +} + +#define opl_size(opl) opl->ln.len +#define opl_opts(opl) ((opt_info *)block_data(opl)) +typedef block_t optlist_t; + +static optlist_t *copy_optlist(s7_scheme *sc) +{ + int32_t bytes; + optlist_t *opl; + bytes = sc->pc * sizeof(opt_info); + opl = (optlist_t *)mallocate(sc, bytes); + opl_size(opl) = sc->pc; + memcpy((void *)(opl_opts(opl)), (void *)(sc->base_opts), bytes); + return(opl); +} + +static void restore_optlist(s7_scheme *sc, optlist_t *opl) +{ + memcpy((void *)(sc->base_opts), (void *)(opl_opts(opl)), sizeof(opt_info) * opl_size(opl)); +} + +static bool fixup_slots(s7_scheme *sc, optlist_t *opl) +{ + int32_t i; + for (i = 0; i < opl_size(opl); i++) + if (!oo_fixup_slots(sc, (opt_info *)(&(opl_opts(opl)[i])))) + return(false); + return(true); +} + + +#if S7_DEBUGGING +#define alloc_opo(Sc, Expr) alloc_opo_2(Sc, Expr, __func__, __LINE__) +static opt_info *alloc_opo_2(s7_scheme *sc, s7_pointer expr, const char *func, int line) #else #define alloc_opo(Sc, Expr) alloc_opo_1(Sc) static opt_info *alloc_opo_1(s7_scheme *sc) @@ -49195,28 +50014,20 @@ static opt_info *alloc_opo_1(s7_scheme *sc) fprintf(stderr, "sc->pc: %d\n", sc->pc); abort(); } -#if DEBUGGING_ALLOC_OPO - fprintf(stderr, "alloc_opo: %p %d for %s\n", sc->opts[sc->pc], sc->pc, DISPLAY(expr)); -#endif #endif o = sc->opts[sc->pc++]; - o->v8.fd = NULL; + oo_clear(o); + o->v[7].fd = NULL; #if S7_DEBUGGING - o->expr = expr; + o->vexpr = expr; + o->func = func; + o->line = line; #endif + o->typ.vtype = 0; return(o); } -#if DEBUGGING_ALLOC_OPO -static void backup_pc_1(s7_scheme *sc, const char *func, int32_t line) -{ - sc->pc--; - fprintf(stderr, "%s[%d]: backup pc to %d\n", func, line, sc->pc); -} -#define backup_pc(sc) backup_pc_1(sc, __func__, __LINE__) -#else #define backup_pc(sc) sc->pc-- -#endif #define OPT_PRINT 0 @@ -49234,87 +50045,66 @@ static bool return_false(s7_scheme *sc, s7_pointer expr, const char *func, int32 #define is_opt_real(p) is_real(p) -/* all_x fallback for all optimizers */ -static s7_function all_x_optimize(s7_scheme *sc, s7_pointer expr) -{ - if ((is_optimized(car(expr))) && - (is_all_x_safe(sc, car(expr)))) - return(all_x_eval(sc, expr, sc->envir, let_symbol_is_safe)); - return(NULL); -} - static s7_double opt_float_any(s7_scheme *sc, s7_pointer expr) { /* caller for s7_float_optimize */ - cur_sc = sc; sc->pc = 0; - return(sc->opts[0]->v7.fd(sc->opts[0])); + return(sc->opts[0]->v[0].fd(sc->opts[0])); } static s7_pointer opt_bool_any(s7_scheme *sc, s7_pointer expr) { /* caller for s7_bool_optimize */ - cur_sc = sc; sc->pc = 0; - return((sc->opts[0]->v7.fb(sc->opts[0])) ? sc->T : sc->F); + return((sc->opts[0]->v[0].fb(sc->opts[0])) ? sc->T : sc->F); } static s7_pointer opt_float_any_nr(s7_scheme *sc, s7_pointer expr) { - cur_sc = sc; sc->pc = 0; - sc->opts[0]->v7.fd(sc->opts[0]); + sc->opts[0]->v[0].fd(sc->opts[0]); return(NULL); } static s7_pointer opt_int_any_nr(s7_scheme *sc, s7_pointer expr) { - cur_sc = sc; sc->pc = 0; - sc->opts[0]->v7.fi(sc->opts[0]); + sc->opts[0]->v[0].fi(sc->opts[0]); return(NULL); } static s7_pointer opt_cell_any_nr(s7_scheme *sc, s7_pointer expr) { - cur_sc = sc; sc->pc = 0; - return(sc->opts[0]->v7.fp(sc->opts[0])); /* faster than returning NULL */ + return(sc->opts[0]->v[0].fp(sc->opts[0])); /* faster than returning NULL */ } static s7_pointer opt_bool_any_nr(s7_scheme *sc, s7_pointer expr) { - cur_sc = sc; sc->pc = 0; - sc->opts[0]->v7.fb(sc->opts[0]); + sc->opts[0]->v[0].fb(sc->opts[0]); return(NULL); } /* callers for s7_optimize */ -static s7_pointer opt_wrap_float(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(make_real(sc, sc->opts[0]->v7.fd(sc->opts[0])));} -static s7_pointer opt_wrap_int(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(make_integer(sc, sc->opts[0]->v7.fi(sc->opts[0])));} -static s7_pointer opt_wrap_cell(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(sc->opts[0]->v7.fp(sc->opts[0]));} -static s7_pointer opt_wrap_bool(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return((sc->opts[0]->v7.fb(sc->opts[0])) ? sc->T : sc->F);} +static s7_pointer opt_wrap_float(s7_scheme *sc, s7_pointer expr) {sc->pc = 0; return(make_real(sc, sc->opts[0]->v[0].fd(sc->opts[0])));} +static s7_pointer opt_wrap_int(s7_scheme *sc, s7_pointer expr) {sc->pc = 0; return(make_integer(sc, sc->opts[0]->v[0].fi(sc->opts[0])));} +static s7_pointer opt_wrap_cell(s7_scheme *sc, s7_pointer expr) {sc->pc = 0; return( sc->opts[0]->v[0].fp(sc->opts[0]));} +static s7_pointer opt_wrap_bool(s7_scheme *sc, s7_pointer expr) {sc->pc = 0; return(( sc->opts[0]->v[0].fb(sc->opts[0])) ? sc->T : sc->F);} -static s7_pointer b_to_p(void *p) {opt_info *o = (opt_info *)p; return((o->v8.fb(o)) ? cur_sc->T : cur_sc->F);} -static bool p_to_b(void *p) {opt_info *o = (opt_info *)p; return(o->v8.fp(o) != cur_sc->F);} -static s7_pointer d_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_real(cur_sc, o->v8.fd(o)));} -static s7_pointer d_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v8.fd(o); return(NULL);} -static s7_pointer i_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_integer(cur_sc, o->v8.fi(o)));} -static s7_pointer i_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v8.fi(o); return(NULL);} +static s7_pointer b_to_p(void *p) {opt_info *o = (opt_info *)p; return((o->v[7].fb(o)) ? o->sc->T : o->sc->F);} +static bool p_to_b(void *p) {opt_info *o = (opt_info *)p; return(o->v[7].fp(o) != o->sc->F);} +static s7_pointer d_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_real(o->sc, o->v[7].fd(o)));} +static s7_pointer d_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v[7].fd(o); return(NULL);} +static s7_pointer i_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_integer(o->sc, o->v[7].fi(o)));} +static s7_pointer i_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v[7].fi(o); return(NULL);} /* -------------------------------- int opts -------------------------------- */ -static s7_int opt_unwrap_int(void *p) -{ - opt_info *o = (opt_info *)p; - return(integer(o->v2.all_f(cur_sc, car(o->v1.p)))); -} - -static s7_int opt_i_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.i);} -static s7_int opt_i_s(void *p) {opt_info *o = (opt_info *)p; return(integer(slot_value(o->v1.p)));} +static s7_int opt_i_c(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, p, 2, 0); return(o->v[1].i);} +static s7_int opt_i_s(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, p, 2, 1); return(integer(slot_value(o->v[1].p)));} static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x) { @@ -49322,8 +50112,10 @@ static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x) if (is_opt_int(car_x)) { opc = alloc_opo(sc, car_x); - opc->v1.i = integer(car_x); - opc->v7.fi = opt_i_c; + opc->v[1].i = integer(car_x); + opc->v[0].fi = opt_i_c; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } if (is_symbol(car_x)) @@ -49334,89 +50126,133 @@ static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x) (is_opt_int(slot_value(p)))) { opc = alloc_opo(sc, car_x); - opc->v1.p = p; - opc->v7.fi = opt_i_s; + opc->v[1].p = p; + opc->v[0].fi = opt_i_s; + oo_set_type_1(opc, 2, 1, OO_I); + oo_check(sc, opc); return(true); } } return(return_false(sc, car_x, __func__, __LINE__)); } -/* -------- i_idp -------- */ +/* -------- i_i|d|p -------- */ static s7_int opt_i_i_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.i_i_f(o->v1.i)); + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_i_f(o->v[1].i)); } static s7_int opt_i_i_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.i_i_f(integer(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].i_i_f(integer(slot_value(o->v[1].p)))); } static s7_int opt_i_i_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.i_i_f(o1->v7.fi(o1))); + o1 = o->sc->opts[++(o->sc->pc)]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_i_f(o1->v[0].fi(o1))); +} + +static s7_int opt_i_7i_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_7i_f(o->sc, o->v[1].i)); } +static s7_int opt_i_7i_s(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].i_7i_f(o->sc, integer(slot_value(o->v[1].p)))); +} + +static s7_int opt_i_7i_f(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++(o->sc->pc)]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_7i_f(o->sc, o1->v[0].fi(o1))); +} static s7_int opt_i_d_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.i_d_f(o->v1.x)); + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_7d_f(o->sc, o->v[1].x)); } static s7_int opt_i_d_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.i_d_f(real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].i_7d_f(o->sc, real(slot_value(o->v[1].p)))); } -static s7_int opt_i_d_f(void *p) +static s7_int opt_i_7d_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.i_d_f(o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_7d_f(o->sc, o1->v[0].fd(o1))); } -static s7_int opt_i_p_f(void *p) +static s7_int opt_i_7p_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.i_p_f(o1->v7.fp(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].i_7p_f(o->sc, o1->v[0].fp(o1))); } static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_i_i_t func; - s7_i_d_t idf; - s7_i_p_t ipf; + s7_i_7i_t func7 = NULL; + s7_i_7d_t idf; + s7_i_7p_t ipf; int32_t start; start = sc->pc; func = s7_i_i_function(s_func); - if (func) + if (!func) + func7 = s7_i_7i_function(s_func); + if ((func) || (func7)) { - opc->v2.i_i_f = func; + if (func) + opc->v[2].i_i_f = func; + else opc->v[2].i_7i_f = func7; if (is_opt_int(cadr(car_x))) { - opc->v1.i = integer(cadr(car_x)); - opc->v7.fi = opt_i_i_c; + opc->v[1].i = integer(cadr(car_x)); + if (func) + opc->v[0].fi = opt_i_i_c; + else opc->v[0].fi = opt_i_7i_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (is_integer(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (is_integer(slot_value(opc->v[1].p)))) { - opc->v7.fi = opt_i_i_s; + if (func) + opc->v[0].fi = opt_i_i_s; + else opc->v[0].fi = opt_i_7i_s; + oo_set_type_1(opc, 3, 1, OO_I); + oo_check(sc, opc); return(true); } /* return(return_false(sc, car_x, __func__, __LINE__)); */ @@ -49425,35 +50261,45 @@ static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (int_optimize(sc, cdr(car_x))) { - opc->v7.fi = opt_i_i_f; + if (func) + opc->v[0].fi = opt_i_i_f; + else opc->v[0].fi = opt_i_7i_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); } } - idf = s7_i_d_function(s_func); + idf = s7_i_7d_function(s_func); if (idf) { - opc->v2.i_d_f = idf; + opc->v[2].i_7d_f = idf; if (is_real(cadr(car_x))) { - opc->v1.x = s7_number_to_real(sc, cadr(car_x)); - opc->v7.fi = opt_i_d_c; + opc->v[1].x = s7_number_to_real(sc, cadr(car_x)); + opc->v[0].fi = opt_i_d_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if (is_slot(opc->v[1].p)) { - if (is_float(slot_value(opc->v1.p))) + if (is_float(slot_value(opc->v[1].p))) { - opc->v7.fi = opt_i_d_s; + opc->v[0].fi = opt_i_d_s; + oo_set_type_1(opc, 3, 1, OO_D); + oo_check(sc, opc); return(true); } if (float_optimize(sc, cdr(car_x))) { - opc->v7.fi = opt_i_d_f; + opc->v[0].fi = opt_i_7d_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49463,19 +50309,23 @@ static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (float_optimize(sc, cdr(car_x))) { - opc->v7.fi = opt_i_d_f; + opc->v[0].fi = opt_i_7d_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); } } - ipf = s7_i_p_function(s_func); + ipf = s7_i_7p_function(s_func); if (ipf) { - opc->v2.i_p_f = ipf; + opc->v[2].i_7p_f = ipf; if (cell_optimize(sc, cdr(car_x))) { - opc->v7.fi = opt_i_p_f; + opc->v[0].fi = opt_i_7p_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49486,24 +50336,26 @@ static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer /* -------- i_pi -------- */ -static s7_int opt_i_pi_ss(void *p) +static s7_int opt_i_7pi_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)))); } -static s7_int opt_i_pi_sf(void *p) +static s7_int opt_i_7pi_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_pi_f(slot_value(o->v1.p), o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_7pi_f(o->sc, slot_value(o->v[1].p), o1->v[0].fi(o1))); } -static bool i_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) +static bool i_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { - s7_i_pi_t pfunc; - pfunc = s7_i_pi_function(s_func); + s7_i_7pi_t pfunc; + pfunc = s7_i_7pi_function(s_func); if (pfunc) { s7_pointer sig; @@ -49524,32 +50376,36 @@ static bool i_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer obj = s7_symbol_value(sc, arg1); if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) { - opc->v1.p = symbol_to_slot(sc, arg1); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, arg1); + if (is_slot(opc->v[1].p)) { if ((car(car_x) == sc->int_vector_ref_symbol) && - ((!is_int_vector(slot_value(opc->v1.p))) || - (vector_rank(slot_value(opc->v1.p)) > 1))) + ((!is_int_vector(slot_value(opc->v[1].p))) || + (vector_rank(slot_value(opc->v[1].p)) > 1))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v3.i_pi_f = pfunc; + opc->v[3].i_7pi_f = pfunc; if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_opt_int(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_opt_int(slot_value(opc->v[2].p)))) { - opc->v7.fi = opt_i_pi_ss; + opc->v[0].fi = opt_i_7pi_ss; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); if ((car(car_x) == sc->int_vector_ref_symbol) && - (is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p)))) - opc->v3.i_pi_f = int_vector_ref_unchecked; + (is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) + opc->v[3].i_7pi_f = int_vector_ref_unchecked; + oo_check(sc, opc); return(true); } } if (int_optimize(sc, cddr(car_x))) { - opc->v7.fi = opt_i_pi_sf; + opc->v[0].fi = opt_i_7pi_sf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49566,41 +50422,47 @@ static bool i_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_int opt_i_ii_cc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_ii_f(o->v1.i, o->v2.i)); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_ii_f(o->v[1].i, o->v[2].i)); } static s7_int opt_i_ii_cs(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_ii_f(o->v1.i, integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_ii_f(o->v[1].i, integer(slot_value(o->v[2].p)))); } static s7_int opt_i_ii_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), o->v2.i)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), o->v[2].i)); } static s7_int opt_i_ii_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p)))); } static s7_int opt_i_ii_cf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_ii_f(o->v1.i, o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4,0); + return(o->v[3].i_ii_f(o->v[1].i, o1->v[0].fi(o1))); } static s7_int opt_i_ii_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), o1->v[0].fi(o1))); } static s7_int opt_i_ii_ff(void *p) @@ -49608,10 +50470,11 @@ static s7_int opt_i_ii_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_int i1; - o1 = cur_sc->opts[++cur_sc->pc]; - i1 = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_ii_f(i1, o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_ii_f(i1, o1->v[0].fi(o1))); } #if (!WITH_GMP) @@ -49619,30 +50482,52 @@ static s7_int opt_i_ii_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_ii_f(o1->v7.fi(o1), o->v2.i)); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_ii_f(o1->v[0].fi(o1), o->v[2].i)); +} + +static s7_int opt_i_7ii_fc(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_7ii_f(o->sc, o1->v[0].fi(o1), o->v[2].i)); } static s7_int opt_i_ii_fco(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.i_ii_f(o->v4.i_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))), o->v5.i)); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_ii_f(o->v[4].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))), o->v[5].i)); } -static bool i_ii_fc_combinable(s7_scheme *sc, opt_info *opc) +static s7_int opt_i_7ii_fco(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_7ii_f(o->sc, o->v[4].i_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p))), o->v[5].i)); +} + +static bool i_ii_fc_combinable(s7_scheme *sc, opt_info *opc, s7_i_ii_t func) { if ((sc->pc > 1) && (opc == sc->opts[sc->pc - 2])) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fi == opt_i_pi_ss) - { - opc->v5.i = opc->v2.i; /* move v2.i ("c" in fc = arg2) out of the symbols' way */ - opc->v4.i_pi_f = o1->v3.i_pi_f; - opc->v1.p = o1->v1.p; - opc->v2.p = o1->v2.p; - opc->v7.fi = opt_i_ii_fco; + if (o1->v[0].fi == opt_i_7pi_ss) + { + opc->v[5].i = opc->v[2].i; /* move v2.i ("c" in fc = arg2) out of the symbols' way */ + opc->v[4].i_7pi_f = o1->v[3].i_7pi_f; + opc->v[1].p = o1->v[1].p; + opc->v[2].p = o1->v[2].p; + if (func) + opc->v[0].fi = opt_i_ii_fco; + else opc->v[0].fi = opt_i_7ii_fco; + oo_set_type_2(opc, 6, 1, 2, OO_P, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -49651,11 +50536,71 @@ static bool i_ii_fc_combinable(s7_scheme *sc, opt_info *opc) } #endif +static s7_int opt_i_7ii_cc(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_7ii_f(o->sc, o->v[1].i, o->v[2].i)); +} + +static s7_int opt_i_7ii_cs(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_7ii_f(o->sc, o->v[1].i, integer(slot_value(o->v[2].p)))); +} + +static s7_int opt_i_7ii_sc(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), o->v[2].i)); +} + +static s7_int opt_i_7ii_ss(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p)))); +} + +static s7_int opt_i_7ii_cf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4,0); + return(o->v[3].i_7ii_f(o->sc, o->v[1].i, o1->v[0].fi(o1))); +} + +static s7_int opt_i_7ii_sf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_7ii_f(o->sc, integer(slot_value(o->v[1].p)), o1->v[0].fi(o1))); +} + +static s7_int opt_i_7ii_ff(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + s7_int i1; + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_7ii_f(o->sc, i1, o1->v[0].fi(o1))); +} + static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_i_ii_t ifunc; + s7_i_7ii_t ifunc7 = NULL; ifunc = s7_i_ii_function(s_func); - if (ifunc) + if (!ifunc) ifunc7 = s7_i_7ii_function(s_func); + if ((ifunc) || (ifunc7)) { s7_pointer sig; sig = c_function_signature(s_func); @@ -49667,24 +50612,36 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer arg1 = cadr(car_x); arg2 = caddr(car_x); - opc->v3.i_ii_f = ifunc; + if (ifunc) + opc->v[3].i_ii_f = ifunc; + else opc->v[3].i_7ii_f = ifunc7; + oo_set_type_0(opc, 4); + if (is_opt_int(arg1)) { - opc->v1.i = integer(arg1); + opc->v[1].i = integer(arg1); if (is_opt_int(arg2)) { - opc->v2.i = integer(arg2); - opc->v7.fi = opt_i_ii_cc; + opc->v[2].i = integer(arg2); + if (ifunc) + opc->v[0].fi = opt_i_ii_cc; + else opc->v[0].fi = opt_i_7ii_cc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if (is_slot(opc->v2.p)) + opc->v[2].p = symbol_to_slot(sc, arg2); + if (is_slot(opc->v[2].p)) { - if (is_integer(slot_value(opc->v2.p))) + if (is_integer(slot_value(opc->v[2].p))) { - opc->v7.fi = opt_i_ii_cs; + if (ifunc) + opc->v[0].fi = opt_i_ii_cs; + else opc->v[0].fi = opt_i_7ii_cs; + oo_set_type_1(opc, 4, 2, OO_I); + oo_check(sc, opc); return(true); } } @@ -49693,7 +50650,11 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (int_optimize(sc, cddr(car_x))) { - opc->v7.fi = opt_i_ii_cf; + if (ifunc) + opc->v[0].fi = opt_i_ii_cf; + else opc->v[0].fi = opt_i_7ii_cf; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49703,62 +50664,80 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_symbol(arg1)) { - opc->v1.p = symbol_to_slot(sc, arg1); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, arg1); + if (is_slot(opc->v[1].p)) { - if (is_opt_int(slot_value(opc->v1.p))) + oo_set_type_1(opc, 4, 1, OO_I); + if (is_opt_int(slot_value(opc->v[1].p))) { if (is_opt_int(arg2)) { - opc->v2.i = integer(arg2); - opc->v7.fi = opt_i_ii_sc; + opc->v[2].i = integer(arg2); + if (ifunc) + opc->v[0].fi = opt_i_ii_sc; + else opc->v[0].fi = opt_i_7ii_sc; #if (!WITH_GMP) if ((car(car_x) == sc->modulo_symbol) && (integer(arg2) > 1)) - opc->v3.i_ii_f = modulo_i_ii_direct; + opc->v[3].i_ii_f = modulo_i_ii_direct; else { if (car(car_x) == sc->ash_symbol) { - if (opc->v2.i < 0) + if (opc->v[2].i < 0) { - if (opc->v2.i == -1) - opc->v3.i_ii_f = rsh_i_i2_direct; - else opc->v3.i_ii_f = rsh_i_ii_direct; + if (opc->v[2].i == -1) + opc->v[3].i_ii_f = rsh_i_i2_direct; + else opc->v[3].i_ii_f = rsh_i_ii_direct; + opc->v[0].fi = opt_i_ii_sc; } else { - if (opc->v2.i < s7_int_bits) - opc->v3.i_ii_f = lsh_i_ii_direct; + if (opc->v[2].i < s7_int_bits) + { + opc->v[3].i_ii_f = lsh_i_ii_direct; + opc->v[0].fi = opt_i_ii_sc; + } } } else { - if (opc->v2.i > 0) + if (opc->v[2].i > 0) { - if (opc->v3.i_ii_f == quotient_i_ii) - opc->v3.i_ii_f = quotient_i_ii_direct; + if (opc->v[3].i_7ii_f == quotient_i_7ii) + { + opc->v[3].i_ii_f = quotient_i_ii_direct; + opc->v[0].fi = opt_i_ii_sc; + } else { - if (opc->v2.i > 1) + if (opc->v[2].i > 1) { - if (opc->v3.i_ii_f == remainder_i_ii) - opc->v3.i_ii_f = remainder_i_ii_direct; + if (opc->v[3].i_7ii_f == remainder_i_7ii) + { + opc->v[3].i_ii_f = remainder_i_ii_direct; + opc->v[0].fi = opt_i_ii_sc; + } } } } } } #endif + oo_check(sc, opc); return(true); } if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_opt_int(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_opt_int(slot_value(opc->v[2].p)))) { - opc->v7.fi = opt_i_ii_ss; + if (ifunc) + opc->v[0].fi = opt_i_ii_ss; + else opc->v[0].fi = opt_i_7ii_ss; + oo_set_type_2(opc, 4, 1, 2, OO_I, OO_I); + oo_check(sc, opc); return(true); } } @@ -49766,7 +50745,10 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (int_optimize(sc, cddr(car_x))) { - opc->v7.fi = opt_i_ii_sf; + if (ifunc) + opc->v[0].fi = opt_i_ii_sf; + else opc->v[0].fi = opt_i_7ii_sf; + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49779,26 +50761,35 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer #if (!WITH_GMP) if (is_opt_int(arg2)) { - opc->v2.i = integer(arg2); + opc->v[2].i = integer(arg2); if (int_optimize(sc, cdr(car_x))) { - if (!i_ii_fc_combinable(sc, opc)) + if (!i_ii_fc_combinable(sc, opc, ifunc)) { - if (opc->v2.i > 0) + if (ifunc) + opc->v[0].fi = opt_i_ii_fc; + else opc->v[0].fi = opt_i_7ii_fc; + if (opc->v[2].i > 0) { - if (opc->v3.i_ii_f == quotient_i_ii) - opc->v3.i_ii_f = quotient_i_ii_direct; + if (opc->v[3].i_7ii_f == quotient_i_7ii) + { + opc->v[3].i_ii_f = quotient_i_ii_direct; + opc->v[0].fi = opt_i_ii_fc; + } else { - if (opc->v2.i > 1) + if (opc->v[2].i > 1) { - if (opc->v3.i_ii_f == remainder_i_ii) - opc->v3.i_ii_f = remainder_i_ii_direct; + if (opc->v[3].i_7ii_f == remainder_i_7ii) + { + opc->v[3].i_ii_f = remainder_i_ii_direct; + opc->v[0].fi = opt_i_ii_fc; + } } } } - opc->v7.fi = opt_i_ii_fc; } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49809,7 +50800,10 @@ static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((int_optimize(sc, cdr(car_x))) && (int_optimize(sc, cddr(car_x)))) { - opc->v7.fi = opt_i_ii_ff; + if (ifunc) + opc->v[0].fi = opt_i_ii_ff; + else opc->v[0].fi = opt_i_7ii_ff; + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49827,12 +50821,13 @@ static s7_int opt_i_iii_fff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_int i1, i2; - o1 = cur_sc->opts[++cur_sc->pc]; - i1 = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - i2 = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_iii_f(i1, i2, o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + i2 = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].i_iii_f(i1, i2, o1->v[0].fi(o1))); } static bool i_iii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -49847,8 +50842,10 @@ static bool i_iii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (int_optimize(sc, cddr(car_x))) && (int_optimize(sc, cdddr(car_x)))) { - opc->v3.i_iii_f = ifunc; - opc->v7.fi = opt_i_iii_fff; + opc->v[3].i_iii_f = ifunc; + opc->v[0].fi = opt_i_iii_fff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -49857,24 +50854,26 @@ static bool i_iii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer return(false); } -/* -------- i_pii -------- */ -static s7_int opt_i_pii_ssf(void *p) +/* -------- i_7pii -------- */ +static s7_int opt_i_7pii_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_pii_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fi(o1))); } -static s7_int opt_i_pii_sff(void *p) +static s7_int opt_i_7pii_sff(void *p) { opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_int i1; - o1 = cur_sc->opts[++cur_sc->pc]; - i1 = o1->v7.fi(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.i_pii_f(slot_value(o->v1.p), i1, o2->v7.fi(o2))); + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o2 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].i_7pii_f(o->sc, slot_value(o->v[1].p), i1, o2->v[0].fi(o2))); } static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_pointer indexp, s7_pointer valp) @@ -49884,11 +50883,11 @@ static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_po if ((is_slot(settee)) && (!is_immutable(slot_value(settee)))) { - opc->v1.p = settee; + opc->v[1].p = settee; if ((is_int_vector(slot_value(settee))) && (vector_rank(slot_value(settee)) == 1)) { - opc->v3.i_pii_f = int_vector_set_i; + opc->v[3].i_7pii_f = int_vector_set_i_7pii; if (is_symbol(car(indexp))) { s7_pointer slot; @@ -49897,11 +50896,13 @@ static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_po (is_integer(slot_value(slot))) && (int_optimize(sc, valp))) { - opc->v7.fi = opt_i_pii_ssf; - opc->v2.p = slot; - if ((is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(settee)))) - opc->v3.i_pii_f = int_vector_set_unchecked; + opc->v[0].fi = opt_i_7pii_ssf; + opc->v[2].p = slot; + if ((is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(settee)))) + opc->v[3].i_7pii_f = int_vector_set_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); + oo_check(sc, opc); return(true); } } @@ -49910,7 +50911,9 @@ static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_po if ((int_optimize(sc, indexp)) && (int_optimize(sc, valp))) { - opc->v7.fi = opt_i_pii_sff; + oo_set_type_1(opc, 4, 1, OO_IV); /* can this be a byte-vector? */ + opc->v[0].fi = opt_i_7pii_sff; + oo_check(sc, opc); return(true); } } @@ -49919,10 +50922,10 @@ static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_po return(return_false(sc, v, __func__, __LINE__)); } -static bool i_pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) +static bool i_7pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { - s7_i_pii_t pfunc; - pfunc = s7_i_pii_function(s_func); + s7_i_7pii_t pfunc; + pfunc = s7_i_7pii_function(s_func); if (pfunc) { s7_pointer sig; @@ -49945,20 +50948,22 @@ static bool i_pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { int32_t start; start = sc->pc; - opc->v3.i_pii_f = pfunc; - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if (is_slot(opc->v1.p)) + opc->v[3].i_7pii_f = pfunc; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if (is_slot(opc->v[1].p)) { s7_pointer arg2; arg2 = caddr(car_x); if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_opt_int(slot_value(opc->v2.p))) && + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_opt_int(slot_value(opc->v[2].p))) && (int_optimize(sc, cdddr(car_x)))) { - opc->v7.fi = opt_i_pii_ssf; + opc->v[0].fi = opt_i_7pii_ssf; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); + oo_check(sc, opc); return(true); } } @@ -49967,7 +50972,9 @@ static bool i_pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((int_optimize(sc, cddr(car_x))) && (int_optimize(sc, cdddr(car_x)))) { - opc->v7.fi = opt_i_pii_sff; + opc->v[0].fi = opt_i_7pii_sff; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -49986,85 +50993,92 @@ static s7_int opt_i_add_any_f(void *p) opt_info *o = (opt_info *)p; s7_int sum = 0; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 2, 0); + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum += o1->v7.fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum += o1->v[0].fi(o1); } return(sum); } static s7_int opt_i_add2(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum + o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum + o1->v[0].fi(o1)); } static s7_int opt_i_mul2(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum * o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum * o1->v[0].fi(o1)); } static s7_int opt_i_add3(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum += o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum + o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum += o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum + o1->v[0].fi(o1)); } static s7_int opt_i_mul3(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum *= o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum * o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum *= o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum * o1->v[0].fi(o1)); } static s7_int opt_i_add4(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum += o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum += o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum + o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum += o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum += o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum + o1->v[0].fi(o1)); } static s7_int opt_i_mul4(void *p) { + opt_info *o = (opt_info *)p; s7_int sum; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum *= o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - sum *= o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(sum * o1->v7.fi(o1)); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum *= o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum *= o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(sum * o1->v[0].fi(o1)); } static s7_int opt_i_multiply_any_f(void *p) @@ -50072,11 +51086,11 @@ static s7_int opt_i_multiply_any_f(void *p) opt_info *o = (opt_info *)p; s7_int sum = 1; int32_t i; - for (i = 0; i < o->v1.i; i++) + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum *= o1->v7.fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum *= o1->v[0].fi(o1); } return(sum); } @@ -50092,47 +51106,28 @@ static bool i_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x) break; if (is_null(p)) { - opc->v1.i = cur_len; + opc->v[1].i = cur_len; if (cur_len == 2) - opc->v7.fi = (head == sc->add_symbol) ? opt_i_add2 : opt_i_mul2; + opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add2 : opt_i_mul2; else { if (cur_len == 3) - opc->v7.fi = (head == sc->add_symbol) ? opt_i_add3 : opt_i_mul3; + opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add3 : opt_i_mul3; else { if (cur_len == 4) - opc->v7.fi = (head == sc->add_symbol) ? opt_i_add4 : opt_i_mul4; - else opc->v7.fi = (head == sc->add_symbol) ? opt_i_add_any_f : opt_i_multiply_any_f; + opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add4 : opt_i_mul4; + else opc->v[0].fi = (head == sc->add_symbol) ? opt_i_add_any_f : opt_i_multiply_any_f; } } + oo_set_type_0(opc, 2); /* all v[1].i = cur_len */ + oo_check(sc, opc); return(true); } pc_fallback(sc, start); return(false); } -/* -------- int_all_x -------- */ -static bool int_all_x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer expr) -{ - s7_pointer sig; - s7_function opt; - sig = c_function_signature(s_func); - if ((is_pair(sig)) && - (car(sig) == sc->is_integer_symbol)) - { - /* fallback on the more general case (all_x_eval, but still guaranteed to be an integer) */ - opt = all_x_optimize(sc, expr); - if (opt) - { - opc->v2.all_f = opt; - opc->v7.fi = opt_unwrap_int; - opc->v1.p = expr; - return(true); - } - } - return(false); -} /* -------- set_i_i -------- */ static s7_int opt_set_i_i_f(void *p) @@ -50140,11 +51135,12 @@ static s7_int opt_set_i_i_f(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_int x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = o1->v7.fi(o1); - if (is_mutable(slot_value(o->v1.p))) - integer(slot_value(o->v1.p)) = x; - else slot_set_value(o->v1.p, make_integer(cur_sc, x)); + oo_rcheck(o->sc, o, 2, 1); + o1 = o->sc->opts[++o->sc->pc]; + x = o1->v[0].fi(o1); + if (is_mutable(slot_value(o->v[1].p))) + integer(slot_value(o->v[1].p)) = x; + else slot_set_value(o->v[1].p, make_integer(o->sc, x)); return(x); } @@ -50152,10 +51148,11 @@ static s7_int opt_set_i_i_fo(void *p) { opt_info *o = (opt_info *)p; s7_int x; - x = o->v4.i_ii_f(integer(slot_value(o->v3.p)), o->v2.i); - if (is_mutable(slot_value(o->v1.p))) - integer(slot_value(o->v1.p)) = x; - else slot_set_value(o->v1.p, make_integer(cur_sc, x)); + oo_rcheck(o->sc, o, 5, 2); + x = o->v[4].i_ii_f(integer(slot_value(o->v[3].p)), o->v[2].i); + if (is_mutable(slot_value(o->v[1].p))) + integer(slot_value(o->v[1].p)) = x; + else slot_set_value(o->v[1].p, make_integer(o->sc, x)); return(x); } @@ -50166,12 +51163,14 @@ static bool set_i_i_f_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fi == opt_i_ii_sc) - { - opc->v4.i_ii_f = o1->v3.i_ii_f; - opc->v3.p = o1->v1.p; - opc->v2.i = o1->v2.i; - opc->v7.fi = opt_set_i_i_fo; + if (o1->v[0].fi == opt_i_ii_sc) + { + opc->v[4].i_ii_f = o1->v[3].i_ii_f; + opc->v[3].p = o1->v[1].p; + opc->v[2].i = o1->v[2].i; + opc->v[0].fi = opt_set_i_i_fo; + oo_set_type_2(opc, 5, 1, 3, OO_I, OO_I); /* ii_sc v[1].p is a slot */ + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -50196,12 +51195,14 @@ static bool i_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((is_slot(settee)) && (!is_immutable(settee))) { - opc->v1.p = settee; + opc->v[1].p = settee; + oo_set_type_1(opc, 2, 1, OO_P); /* or OO_I? */ if ((is_integer(slot_value(settee))) && (int_optimize(sc, cddr(car_x)))) { if (!set_i_i_f_combinable(sc, opc)) - opc->v7.fi = opt_set_i_i_f; + opc->v[0].fi = opt_set_i_i_f; + oo_check(sc, opc); return(true); } } @@ -50231,7 +51232,8 @@ static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) /* implicit int-vector-ref */ opt_info *opc; opc = alloc_opo(sc, car_x); - opc->v1.p = s_slot; + opc->v[1].p = s_slot; + oo_set_type_1(opc, 4, 1, OO_IV); if (is_symbol(cadr(car_x))) { s7_pointer slot; @@ -50239,12 +51241,14 @@ static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((is_slot(slot)) && (is_integer(slot_value(slot)))) { - opc->v7.fi = opt_i_pi_ss; - opc->v3.i_pi_f = int_vector_ref_i; - opc->v2.p = slot; - if ((is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p)))) - opc->v3.i_pi_f = int_vector_ref_unchecked; + opc->v[0].fi = opt_i_7pi_ss; + opc->v[3].i_7pi_f = int_vector_ref_i_7pi; + opc->v[2].p = slot; + oo_set_type_2(opc, 4, 1, 2, OO_IV, OO_I); + if ((is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) + opc->v[3].i_7pi_f = int_vector_ref_unchecked; + oo_check(sc, opc); return(true); } } @@ -50252,8 +51256,9 @@ static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) { if (int_optimize(sc, cdr(car_x))) { - opc->v7.fi = opt_i_pi_sf; - opc->v3.i_pi_f = int_vector_ref_i; + opc->v[0].fi = opt_i_7pi_sf; + opc->v[3].i_7pi_f = int_vector_ref_i_7pi; + oo_check(sc, opc); return(true); } } @@ -50264,9 +51269,9 @@ static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) /* ------------------------------------- float opts ------------------------------------------- */ -static s7_double opt_d_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.x);} -static s7_double opt_D_s(void *p) {opt_info *o = (opt_info *)p; return(s7_number_to_real(cur_sc, slot_value(o->v1.p)));} -static s7_double opt_d_s(void *p) {opt_info *o = (opt_info *)p; return(real(slot_value(o->v1.p)));} +static s7_double opt_d_c(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 0); return(o->v[1].x);} +static s7_double opt_D_s(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 1); return(s7_number_to_real(o->sc, slot_value(o->v[1].p)));} +static s7_double opt_d_s(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 1); return(real(slot_value(o->v[1].p)));} static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x) { @@ -50277,8 +51282,10 @@ static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x) (!is_opt_real(car_x))) return(return_false(sc, car_x, __func__, __LINE__)); opc = alloc_opo(sc, car_x); - opc->v1.x = s7_number_to_real(sc, car_x); - opc->v7.fd = opt_d_c; + opc->v[1].x = s7_number_to_real(sc, car_x); + opc->v[0].fd = opt_d_c; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } if (is_symbol(car_x)) @@ -50291,8 +51298,10 @@ static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x) if (s7_is_ratio(slot_value(p))) return(return_false(sc, car_x, __func__, __LINE__)); opc = alloc_opo(sc, car_x); - opc->v1.p = p; - opc->v7.fd = (is_float(slot_value(p))) ? opt_d_s : opt_D_s; + opc->v[1].p = p; + opc->v[0].fd = (is_float(slot_value(p))) ? opt_d_s : opt_D_s; + oo_set_type_1(opc, 2, 1, OO_R); + oo_check(sc, opc); return(true); } } @@ -50300,7 +51309,7 @@ static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x) } /* -------- d -------- */ -static s7_double opt_d_f(void *p) {opt_info *o = (opt_info *)p; return(o->v1.d_f());} +static s7_double opt_d_f(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 1); return(o->v[1].d_f());} static bool d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func) { @@ -50308,8 +51317,9 @@ static bool d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func) func = s7_d_function(s_func); if (func) { - opc->v7.fd = opt_d_f; - opc->v1.d_f = func; + opc->v[0].fd = opt_d_f; + opc->v[1].d_f = func; + oo_check(sc, opc); return(true); } return(false); @@ -50319,56 +51329,100 @@ static bool d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func) static s7_double opt_d_d_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_d_f(o->v1.x)); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_d_f(o->v[1].x)); } static s7_double opt_d_d_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_d_f(real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_d_f(real(slot_value(o->v[1].p)))); } static s7_double opt_d_d_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_d_f(o1->v7.fd(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_d_f(o1->v[0].fd(o1))); +} + +static s7_double opt_d_7d_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_7d_f(o->sc, o->v[1].x)); +} + +static s7_double opt_d_7d_s(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7d_f(o->sc, real(slot_value(o->v[1].p)))); +} + +static s7_double opt_d_7d_f(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7d_f(o->sc, o1->v[0].fd(o1))); } static bool d_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_d_d_t func; + s7_d_7d_t func7 = NULL; int32_t start; start = sc->pc; func = s7_d_d_function(s_func); - if (func) + if (!func) func7 = s7_d_7d_function(s_func); + if ((func) || (func7)) { - opc->v3.d_d_f = func; + if (func) + opc->v[3].d_d_f = func; + else opc->v[3].d_7d_f = func7; + oo_set_type_0(opc, 4); if (is_real(cadr(car_x))) { if ((!is_float(cadr(car_x))) && /* (random 1) != (random 1.0) */ (car(car_x) == sc->random_symbol)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.x = s7_number_to_real(sc, cadr(car_x)); - opc->v7.fd = opt_d_d_c; + opc->v[1].x = s7_number_to_real(sc, cadr(car_x)); + if (func) + opc->v[0].fd = opt_d_d_c; + else opc->v[0].fd = opt_d_7d_c; + oo_check(sc, opc); return(true); } if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - if (is_float(slot_value(opc->v1.p))) - opc->v7.fd = opt_d_d_s; + if (is_float(slot_value(opc->v[1].p))) + { + oo_set_type_1(opc, 4, 1, OO_D); + if (func) + opc->v[0].fd = opt_d_d_s; + else opc->v[0].fd = opt_d_7d_s; + } else { if (float_optimize(sc, cdr(car_x))) - opc->v7.fd = opt_d_d_f; + { + if (func) + opc->v[0].fd = opt_d_d_f; + else opc->v[0].fd = opt_d_7d_f; + } else return(return_false(sc, car_x, __func__, __LINE__)); } + oo_check(sc, opc); return(true); } } @@ -50376,7 +51430,10 @@ static bool d_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c { if (float_optimize(sc, cdr(car_x))) { - opc->v7.fd = opt_d_d_f; + if (func) + opc->v[0].fd = opt_d_d_f; + else opc->v[0].fd = opt_d_7d_f; + oo_check(sc, opc); return(true); } } @@ -50389,7 +51446,8 @@ static bool d_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c static s7_double opt_d_v(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_v_f(o->v5.obj)); + oo_rcheck(o->sc, o, 6, 0); + return(o->v[3].d_v_f(o->v[5].obj)); } static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -50406,14 +51464,19 @@ static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c s7_pointer slot, obj, checker; checker = s7_symbol_value(sc, cadr(sig)); slot = symbol_to_slot(sc, cadr(car_x)); - obj = slot_value(slot); - if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) + if (is_slot(slot)) { - opc->v1.p = slot; - opc->v5.obj = (void *)s7_c_object_value(obj); - opc->v3.d_v_f = flt_func; - opc->v7.fd = opt_d_v; - return(true); + obj = slot_value(slot); + if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) + { + opc->v[1].p = slot; + opc->v[5].obj = (void *)s7_c_object_value(obj); + opc->v[3].d_v_f = flt_func; + opc->v[0].fd = opt_d_v; + oo_set_type_1(opc, 6, 1 + (5 << 4), OO_V); + oo_check(sc, opc); + return(true); + } } } } @@ -50424,40 +51487,70 @@ static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c static s7_double opt_d_p_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_p_f(slot_value(o->v1.p))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_p_f(slot_value(o->v[1].p))); } static s7_double opt_d_p_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_p_f(o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_p_f(o1->v[0].fp(o1))); +} + +static s7_double opt_d_7p_s(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7p_f(o->sc, slot_value(o->v[1].p))); +} + +static s7_double opt_d_7p_f(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7p_f(o->sc, o1->v[0].fp(o1))); } static bool d_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_d_p_t dpf; + s7_d_7p_t dpf7 = NULL; int32_t start; start = sc->pc; dpf = s7_d_p_function(s_func); - if (dpf) + if (!dpf) dpf7 = s7_d_7p_function(s_func); + if ((dpf) || (dpf7)) { - opc->v3.d_p_f = dpf; + if (dpf) + opc->v[3].d_p_f = dpf; + else opc->v[3].d_7p_f = dpf7; + oo_set_type_0(opc, 4); if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - opc->v7.fd = opt_d_p_s; + oo_set_type_1(opc, 4, 1, OO_P); + if (dpf) + opc->v[0].fd = opt_d_p_s; + else opc->v[0].fd = opt_d_7p_s; + oo_check(sc, opc); return(true); } else return(return_false(sc, car_x, __func__, __LINE__)); } if (cell_optimize(sc, cdr(car_x))) { - opc->v7.fd = opt_d_p_f; + if (dpf) + opc->v[0].fd = opt_d_p_f; + else opc->v[0].fd = opt_d_7p_f; + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -50465,67 +51558,77 @@ static bool d_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c return(false); } -/* -------- d_pi -------- */ +/* -------- d_7pi -------- */ -static s7_double opt_d_pi_sc(void *p) +static s7_double opt_d_7pi_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_pi_f(slot_value(o->v1.p), o->v2.i)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), o->v[2].i)); } -static s7_double opt_d_pi_ss(void *p) +static s7_double opt_d_7pi_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)))); } -static s7_double opt_d_pi_sf(void *p) +static s7_double opt_d_7pi_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_pi_f(slot_value(o->v1.p), o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7pi_f(o->sc, slot_value(o->v[1].p), o1->v[0].fi(o1))); } -static bool d_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) +static bool d_7pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { if (is_symbol(cadr(car_x))) { - s7_d_pi_t ifunc; - ifunc = s7_d_pi_function(s_func); + s7_d_7pi_t ifunc; + ifunc = s7_d_7pi_function(s_func); if (ifunc) { s7_pointer arg2; int32_t start; start = sc->pc; - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if (!is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if (!is_slot(opc->v[1].p)) return(return_false(sc, car_x, __func__, __LINE__)); if ((car(car_x) == sc->float_vector_ref_symbol) && - ((!is_float_vector(slot_value(opc->v1.p))) || - (vector_rank(slot_value(opc->v1.p)) > 1))) + ((!is_float_vector(slot_value(opc->v[1].p))) || + (vector_rank(slot_value(opc->v[1].p)) > 1))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v3.d_pi_f = ifunc; + opc->v[3].d_7pi_f = ifunc; arg2 = caddr(car_x); + oo_set_type_1(opc, 4, 1, OO_P); if (!is_pair(arg2)) { if (is_opt_int(arg2)) { - opc->v2.i = integer(arg2); - opc->v7.fd = opt_d_pi_sc; + opc->v[2].i = integer(arg2); + opc->v[0].fd = opt_d_7pi_sc; + oo_check(sc, opc); return(true); } if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_integer(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_integer(slot_value(opc->v[2].p)))) { - opc->v7.fd = opt_d_pi_ss; + opc->v[0].fd = opt_d_7pi_ss; if ((car(car_x) == sc->float_vector_ref_symbol) && - (is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p)))) - opc->v3.d_pi_f = float_vector_ref_unchecked; + (is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) + { + opc->v[3].d_7pi_f = float_vector_ref_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_FV, OO_I); + } + else oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); + oo_check(sc, opc); return(true); } } @@ -50534,7 +51637,8 @@ static bool d_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (int_optimize(sc, cddr(car_x))) { - opc->v7.fd = opt_d_pi_sf; + opc->v[0].fd = opt_d_7pi_sf; + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -50548,7 +51652,8 @@ static bool d_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_double opt_d_ip_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_ip_f(integer(slot_value(o->v1.p)), slot_value(o->v2.p))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].d_ip_f(integer(slot_value(o->v[1].p)), slot_value(o->v[2].p))); } static bool d_ip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -50560,15 +51665,17 @@ static bool d_ip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer pfunc = s7_d_ip_function(s_func); if (pfunc) { - opc->v3.d_ip_f = pfunc; - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - opc->v2.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v1.p)) && - (is_integer(slot_value(opc->v1.p))) && - (is_slot(opc->v2.p))) + opc->v[3].d_ip_f = pfunc; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + opc->v[2].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[1].p)) && + (is_integer(slot_value(opc->v[1].p))) && + (is_slot(opc->v[2].p))) { /* (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .4 :reverb-amount .5)) */ - opc->v7.fd = opt_d_ip_ss; + opc->v[0].fd = opt_d_ip_ss; + oo_set_type_2(opc, 4, 1, 2, OO_I, OO_P); + oo_check(sc, opc); return(true); } } @@ -50581,14 +51688,16 @@ static s7_double opt_d_pd_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_pd_f(slot_value(o->v1.p), o1->v7.fd(o1))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_pd_f(slot_value(o->v[1].p), o1->v[0].fd(o1))); } static s7_double opt_d_pd_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_pd_f(slot_value(o->v1.p), real(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].d_pd_f(slot_value(o->v[1].p), real(slot_value(o->v[2].p)))); } static bool d_pd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -50603,23 +51712,27 @@ static bool d_pd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer int32_t start; start = sc->pc; arg2 = caddr(car_x); - opc->v3.d_pd_f = func; - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if (!is_slot(opc->v1.p)) + opc->v[3].d_pd_f = func; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if (!is_slot(opc->v[1].p)) return(return_false(sc, car_x, __func__, __LINE__)); if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_float(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_float(slot_value(opc->v[2].p)))) { - opc->v7.fd = opt_d_pd_ss; + opc->v[0].fd = opt_d_pd_ss; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_D); + oo_check(sc, opc); return(true); } } if (float_optimize(sc, cddr(car_x))) { - opc->v7.fd = opt_d_pd_sf; + opc->v[0].fd = opt_d_pd_sf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -50632,57 +51745,65 @@ static bool d_pd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_double opt_d_vd_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_vd_f(o->v5.obj, o->v2.x)); + oo_rcheck(o->sc, o, 6, 0); + return(o->v[3].d_vd_f(o->v[5].obj, o->v[2].x)); } static s7_double opt_d_vd_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_vd_f(o->v5.obj, real(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 6, 1); + return(o->v[3].d_vd_f(o->v[5].obj, real(slot_value(o->v[2].p)))); } static s7_double opt_d_vd_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_vd_f(o->v5.obj, o1->v7.fd(o1))); + oo_rcheck(o->sc, o, 6, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_vd_f(o->v[5].obj, o1->v[0].fd(o1))); } static s7_double opt_d_vd_o(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_vd_f(o->v5.obj, o->v4.d_v_f(o->v6.obj))); + oo_rcheck(o->sc, o, 6, 0); + return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_v_f(o->v[6].obj))); } static s7_double opt_d_vd_o1(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o->v3.d_vd_f(o->v5.obj, o->v4.d_dd_f(real(slot_value(o->v2.p)), o1->v7.fd(o1)))); + oo_rcheck(o->sc, o, 6, 1); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_dd_f(real(slot_value(o->v[2].p)), o1->v[0].fd(o1)))); } static s7_double opt_d_vd_o2(void *p) { - opt_info *o = (opt_info *)p; /* v1.p = v6 obj slot */ - return(o->v4.d_vd_f(o->v6.obj, o->v5.d_vd_f(o->v2.obj, real(slot_value(o->v3.p))))); + opt_info *o = (opt_info *)p; /* v[1].p = v6 obj slot */ + oo_rcheck(o->sc, o, 7, 1); + return(o->v[4].d_vd_f(o->v[6].obj, o->v[5].d_vd_f(o->v[2].obj, real(slot_value(o->v[3].p))))); } static s7_double opt_d_vd_o3(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_vd_f(o->v5.obj, o->v4.d_dd_f(o->v6.x, real(slot_value(o->v2.p))))); + oo_rcheck(o->sc, o, 7, 1); + return(o->v[3].d_vd_f(o->v[5].obj, o->v[4].d_dd_f(o->v[6].x, real(slot_value(o->v[2].p))))); } static s7_double opt_d_vd_ff(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o->v3.d_vd_f(o->v5.obj, o->v2.d_vd_f(o->v4.obj, o1->v7.fd(o1)))); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + oo_rcheck(o->sc, o, 6, 0); + return(o->v[3].d_vd_f(o->v[5].obj, o->v[2].d_vd_f(o->v[4].obj, o1->v[0].fd(o1)))); } static s7_double opt_d_dd_cs(void *p); @@ -50693,47 +51814,59 @@ static bool d_vd_f_combinable(s7_scheme *sc, int32_t start) opt_info *opc, *o1; opc = sc->opts[start - 1]; o1 = sc->opts[start]; - if (o1->v7.fd == opt_d_v) + if (o1->v[0].fd == opt_d_v) { - opc->v2.p = o1->v1.p; - opc->v6.obj = o1->v5.obj; - opc->v4.d_v_f = o1->v3.d_v_f; - opc->v7.fd = opt_d_vd_o; + opc->v[2].p = o1->v[1].p; + opc->v[6].obj = o1->v[5].obj; + opc->v[4].d_v_f = o1->v[3].d_v_f; + opc->v[0].fd = opt_d_vd_o; + oo_set_type_2(opc, 7, 1 + (5 << 4), 2 + (6 << 4), OO_V, OO_V); backup_pc(sc); + oo_check(sc, opc); return(true); } - if (o1->v7.fd == opt_d_vd_s) - { - opc->v6.obj = opc->v5.obj; - opc->v4.d_vd_f = opc->v3.d_vd_f; /* room for symbols */ - opc->v2.obj = o1->v5.obj; - opc->v5.d_vd_f = o1->v3.d_vd_f; - opc->v3.p = o1->v2.p; - opc->v7.fd = opt_d_vd_o2; + if (o1->v[0].fd == opt_d_vd_s) + { + opc->v[6].obj = opc->v[5].obj; + opc->v[4].d_vd_f = opc->v[3].d_vd_f; /* room for symbols */ + opc->v[2].obj = o1->v[5].obj; + opc->v[5].d_vd_f = o1->v[3].d_vd_f; + opc->v[3].p = o1->v[2].p; + opc->v[7].p = o1->v[1].p; + opc->v[0].fd = opt_d_vd_o2; + oo_set_type_3(opc, 8, 1 + (6 << 4), 3, 7 + (2 << 4), OO_V, OO_D, OO_V); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fd == opt_d_dd_cs) + if (o1->v[0].fd == opt_d_dd_cs) { - opc->v4.d_dd_f = o1->v3.d_dd_f; - opc->v6.x = o1->v2.x; - opc->v2.p = o1->v1.p; - opc->v7.fd = opt_d_vd_o3; + opc->v[4].d_dd_f = o1->v[3].d_dd_f; + opc->v[6].x = o1->v[2].x; + opc->v[2].p = o1->v[1].p; + opc->v[0].fd = opt_d_vd_o3; + oo_set_type_2(opc, 7, 1 + (5 << 4), 2, OO_V, OO_D); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fd == opt_d_dd_sf) + if (o1->v[0].fd == opt_d_dd_sf) { - opc->v2.p = o1->v1.p; - opc->v4.d_dd_f = o1->v3.d_dd_f; - opc->v7.fd = opt_d_vd_o1; + opc->v[2].p = o1->v[1].p; + opc->v[4].d_dd_f = o1->v[3].d_dd_f; + opc->v[0].fd = opt_d_vd_o1; + oo_set_type_2(opc, 6, 1 + (5 << 4), 2, OO_V, OO_D); + oo_check(sc, opc); return(true); } - if (o1->v7.fd == opt_d_vd_f) + if (o1->v[0].fd == opt_d_vd_f) { - opc->v2.d_vd_f = o1->v3.d_vd_f; - opc->v4.obj = o1->v5.obj; - opc->v7.fd = opt_d_vd_ff; + opc->v[2].d_vd_f = o1->v[3].d_vd_f; + opc->v[4].obj = o1->v[5].obj; + opc->v[6].p = o1->v[1].p; + opc->v[0].fd = opt_d_vd_ff; + oo_set_type_2(opc, 7, 1 + (5 << 4), 6 + ((4 << 4)), OO_V, OO_V); + oo_check(sc, opc); return(true); } return(false); @@ -50763,31 +51896,38 @@ static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer int32_t start; start = sc->pc; arg2 = caddr(car_x); - opc->v3.d_vd_f = vfunc; + opc->v[3].d_vd_f = vfunc; if (!is_pair(arg2)) { - opc->v1.p = slot; - opc->v5.obj = (void *)s7_c_object_value(obj); + opc->v[1].p = slot; + opc->v[5].obj = (void *)s7_c_object_value(obj); if (is_real(arg2)) { - opc->v2.x = s7_number_to_real(sc, arg2); - opc->v7.fd = opt_d_vd_c; + opc->v[2].x = s7_number_to_real(sc, arg2); + opc->v[0].fd = opt_d_vd_c; + oo_set_type_1(opc, 6, 1 + (5 << 4), OO_V); + oo_check(sc, opc); return(true); } - opc->v2.p = symbol_to_slot(sc, arg2); - if (is_slot(opc->v2.p)) + opc->v[2].p = symbol_to_slot(sc, arg2); + if (is_slot(opc->v[2].p)) { - if (is_float(slot_value(opc->v2.p))) - opc->v7.fd = opt_d_vd_s; + oo_set_type_2(opc, 6, 1 + (5 << 4), 2, OO_V, OO_P); + if (is_float(slot_value(opc->v[2].p))) + { + opc->v[0].fd = opt_d_vd_s; + oo_set_type_2(opc, 6, 1 + (5 << 4), 2, OO_V, OO_D); + } else { if (float_optimize(sc, cddr(car_x))) { if (!d_vd_f_combinable(sc, start)) - opc->v7.fd = opt_d_vd_f; + opc->v[0].fd = opt_d_vd_f; } else return(return_false(sc, car_x, __func__, __LINE__)); } + oo_check(sc, opc); return(true); } } @@ -50795,10 +51935,12 @@ static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (float_optimize(sc, cddr(car_x))) { - opc->v1.p = slot; - opc->v5.obj = (void *)s7_c_object_value(obj); + opc->v[1].p = slot; + opc->v[5].obj = (void *)s7_c_object_value(obj); + oo_set_type_1(opc, 6, 1 + (5 << 4), OO_V); if (!d_vd_f_combinable(sc, start)) - opc->v7.fd = opt_d_vd_f; + opc->v[0].fd = opt_d_vd_f; + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -50815,26 +51957,30 @@ static s7_double opt_d_id_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_id_f(integer(slot_value(o->v1.p)), o1->v7.fd(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o1->v[0].fd(o1))); } static s7_double opt_d_id_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_id_f(integer(slot_value(o->v1.p)), o->v2.x)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o->v[2].x)); } static s7_double opt_d_id_sfo(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_id_f(integer(slot_value(o->v1.p)), o->v5.d_vd_f(o->v6.obj, real(slot_value(o->v3.p))))); + oo_rcheck(o->sc, o, 7, 2); + return(o->v[4].d_id_f(integer(slot_value(o->v[1].p)), o->v[5].d_vd_f(o->v[6].obj, real(slot_value(o->v[3].p))))); } static s7_double opt_d_id_sfo1(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_id_f(integer(slot_value(o->v1.p)), o->v5.d_v_f(o->v2.obj))); + oo_rcheck(o->sc, o, 6, 1); + return(o->v[3].d_id_f(integer(slot_value(o->v[1].p)), o->v[5].d_v_f(o->v[2].obj))); } static bool d_id_sf_combinable(s7_scheme *sc, opt_info *opc) @@ -50844,23 +51990,27 @@ static bool d_id_sf_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fd == opt_d_vd_s) - { - opc->v4.d_id_f = opc->v3.d_id_f; - opc->v2.p = o1->v1.p; - opc->v6.obj = o1->v5.obj; - opc->v5.d_vd_f = o1->v3.d_vd_f; - opc->v3.p = o1->v2.p; - opc->v7.fd = opt_d_id_sfo; + if (o1->v[0].fd == opt_d_vd_s) + { + opc->v[4].d_id_f = opc->v[3].d_id_f; + opc->v[2].p = o1->v[1].p; + opc->v[6].obj = o1->v[5].obj; + opc->v[5].d_vd_f = o1->v[3].d_vd_f; + opc->v[3].p = o1->v[2].p; + opc->v[0].fd = opt_d_id_sfo; + oo_set_type_3(opc, 7, 1, 2 + (6 << 4), 3, OO_I, OO_V, OO_D); backup_pc(sc); + oo_check(sc, opc); return(true); } - if (o1->v7.fd == opt_d_v) + if (o1->v[0].fd == opt_d_v) { - opc->v6.p = o1->v1.p; - opc->v2.obj = o1->v5.obj; - opc->v5.d_v_f = o1->v3.d_v_f; - opc->v7.fd = opt_d_id_sfo1; + opc->v[6].p = o1->v[1].p; + opc->v[2].obj = o1->v[5].obj; + opc->v[5].d_v_f = o1->v[3].d_v_f; + opc->v[0].fd = opt_d_id_sfo1; + oo_set_type_2(opc, 7, 1, 6 + (2 << 4), OO_I, OO_V); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -50878,21 +52028,24 @@ static bool d_id_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { int32_t start; start = sc->pc; - opc->v3.d_id_f = flt_func; - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (is_integer(slot_value(opc->v1.p)))) + opc->v[3].d_id_f = flt_func; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (is_integer(slot_value(opc->v[1].p)))) { + oo_set_type_1(opc, 4, 1, OO_I); if (is_t_real(caddr(car_x))) { - opc->v7.fd = opt_d_id_sc; - opc->v2.x = real(caddr(car_x)); + opc->v[0].fd = opt_d_id_sc; + opc->v[2].x = real(caddr(car_x)); + oo_check(sc, opc); return(true); } if (float_optimize(sc, cddr(car_x))) { if (!d_id_sf_combinable(sc, opc)) - opc->v7.fd = opt_d_id_sf; + opc->v[0].fd = opt_d_id_sf; + oo_check(sc, opc); return(true); } } @@ -50907,55 +52060,120 @@ static bool d_id_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_double opt_d_dd_cc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(o->v1.x, o->v2.x)); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_dd_f(o->v[1].x, o->v[2].x)); } static s7_double opt_d_dd_cs(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(o->v2.x, real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_dd_f(o->v[2].x, real(slot_value(o->v[1].p)))); } static s7_double opt_d_dd_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(real(slot_value(o->v1.p)), o->v2.x)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), o->v[2].x)); } static s7_double opt_d_dd_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)))); } static s7_double opt_d_dd_cf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_dd_f(o->v1.x, o1->v7.fd(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_dd_f(o->v[1].x, o1->v[0].fd(o1))); } static s7_double opt_d_dd_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_dd_f(o1->v7.fd(o1), o->v2.x)); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_dd_f(o1->v[0].fd(o1), o->v[2].x)); } static s7_double opt_d_dd_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_dd_f(real(slot_value(o->v1.p)), o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_dd_f(real(slot_value(o->v[1].p)), o1->v[0].fd(o1))); } + +static s7_double opt_d_7dd_cc(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_7dd_f(o->sc, o->v[1].x, o->v[2].x)); +} + +static s7_double opt_d_7dd_cs(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7dd_f(o->sc, o->v[2].x, real(slot_value(o->v[1].p)))); +} + +static s7_double opt_d_7dd_sc(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), o->v[2].x)); +} + +static s7_double opt_d_7dd_ss(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)))); +} + +static s7_double opt_d_7dd_cf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7dd_f(o->sc, o->v[1].x, o1->v[0].fd(o1))); +} + +static s7_double opt_d_7dd_fc(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7dd_f(o->sc, o1->v[0].fd(o1), o->v[2].x)); +} + +static s7_double opt_d_7dd_sf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_7dd_f(o->sc, real(slot_value(o->v[1].p)), o1->v[0].fd(o1))); +} + + static s7_double opt_d_dd_sfo(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_dd_f(real(slot_value(o->v1.p)), o->v5.d_pi_f(slot_value(o->v2.p), integer(slot_value(o->v3.p))))); + oo_rcheck(o->sc, o, 6, 3); + return(o->v[4].d_dd_f(real(slot_value(o->v[1].p)), o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p))))); } static bool d_dd_sf_combinable(s7_scheme *sc, opt_info *opc) @@ -50965,13 +52183,15 @@ static bool d_dd_sf_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fd == opt_d_pi_ss) - { - opc->v4.d_dd_f = opc->v3.d_dd_f; /* need room for 3 symbols */ - opc->v2.p = o1->v1.p; - opc->v3.p = o1->v2.p; - opc->v5.d_pi_f = o1->v3.d_pi_f; - opc->v7.fd = opt_d_dd_sfo; + if (o1->v[0].fd == opt_d_7pi_ss) + { + opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* need room for 3 symbols */ + opc->v[2].p = o1->v[1].p; + opc->v[3].p = o1->v[2].p; + opc->v[5].d_7pi_f = o1->v[3].d_7pi_f; + opc->v[0].fd = opt_d_dd_sfo; + oo_set_type_3(opc, 6, 1, 2, 3, OO_D, OO_P, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -50983,14 +52203,25 @@ static s7_double opt_d_dd_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_dd_f(o1->v7.fd(o1), real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_dd_f(o1->v[0].fd(o1), real(slot_value(o->v[1].p)))); +} + +static s7_double opt_d_7dd_fs(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7dd_f(o->sc, o1->v[0].fd(o1), real(slot_value(o->v[1].p)))); } static s7_double opt_d_dd_fso(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_dd_f(o->v5.d_pi_f(slot_value(o->v2.p), integer(slot_value(o->v3.p))), real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 5, 3); + return(o->v[4].d_dd_f(o->v[5].d_7pi_f(o->sc, slot_value(o->v[2].p), integer(slot_value(o->v[3].p))), real(slot_value(o->v[1].p)))); } static bool d_dd_fs_combinable(s7_scheme *sc, opt_info *opc) @@ -51000,13 +52231,15 @@ static bool d_dd_fs_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fd == opt_d_pi_ss) - { - opc->v4.d_dd_f = opc->v3.d_dd_f; /* need room for 3 symbols */ - opc->v2.p = o1->v1.p; - opc->v3.p = o1->v2.p; - opc->v5.d_pi_f = o1->v3.d_pi_f; - opc->v7.fd = opt_d_dd_fso; + if (o1->v[0].fd == opt_d_7pi_ss) + { + opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* need room for 3 symbols */ + opc->v[2].p = o1->v[1].p; + opc->v[3].p = o1->v[2].p; + opc->v[5].d_7pi_f = o1->v[3].d_7pi_f; + opc->v[0].fd = opt_d_dd_fso; + oo_set_type_3(opc, 6, 1, 2, 3, OO_D, OO_P, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -51019,10 +52252,23 @@ static s7_double opt_d_dd_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_double x1; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.d_dd_f(x1, o2->v7.fd(o2))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o2 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_dd_f(x1, o2->v[0].fd(o2))); +} + +static s7_double opt_d_7dd_ff(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1, *o2; + s7_double x1; + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o2 = o->sc->opts[++o->sc->pc]; + return(o->v[3].d_7dd_f(o->sc, x1, o2->v[0].fd(o2))); } static s7_double opt_d_dd_ff_o1(void *p) @@ -51030,25 +52276,28 @@ static s7_double opt_d_dd_ff_o1(void *p) opt_info *o = (opt_info *)p; opt_info *o2; s7_double x1; - x1 = o->v2.d_v_f(o->v1.obj); - o2 = cur_sc->opts[cur_sc->pc += 2]; - return(o->v3.d_dd_f(x1, o2->v7.fd(o2))); + x1 = o->v[2].d_v_f(o->v[1].obj); + o2 = o->sc->opts[o->sc->pc += 2]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].d_dd_f(x1, o2->v[0].fd(o2))); } static s7_double opt_d_dd_ff_o2(void *p) { opt_info *o = (opt_info *)p; s7_double x1; - x1 = o->v4.d_v_f(o->v1.obj); - return(o->v3.d_dd_f(x1, o->v5.d_v_f(o->v2.obj))); + oo_rcheck(o->sc, o, 6, 2); + x1 = o->v[4].d_v_f(o->v[1].obj); + return(o->v[3].d_dd_f(x1, o->v[5].d_v_f(o->v[2].obj))); } static s7_double opt_d_dd_ff_o3(void *p) { opt_info *o = (opt_info *)p; s7_double x1; - x1 = o->v5.d_v_f(o->v1.obj); - return(o->v4.d_dd_f(x1, o->v6.d_vd_f(o->v2.obj, real(slot_value(o->v3.p))))); + oo_rcheck(o->sc, o, 7, 3); + x1 = o->v[5].d_v_f(o->v[1].obj); + return(o->v[4].d_dd_f(x1, o->v[6].d_vd_f(o->v[2].obj, real(slot_value(o->v[3].p))))); } static s7_double opt_d_dd_fff(void *p) @@ -51056,11 +52305,25 @@ static s7_double opt_d_dd_fff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_double x1, x2; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v4.d_dd_f(o1->v5.d_pi_f(slot_value(o1->v2.p), integer(slot_value(o1->v3.p))), real(slot_value(o1->v1.p))); /* dd_fso */ - o2 = cur_sc->opts[++cur_sc->pc]; - x2 = o2->v4.d_dd_f(o2->v5.d_pi_f(slot_value(o2->v2.p), integer(slot_value(o2->v3.p))), real(slot_value(o2->v1.p))); /* dd_fso */ - return(o->v3.d_dd_f(x1, x2)); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[4].d_dd_f(o1->v[5].d_7pi_f(o->sc, slot_value(o1->v[2].p), integer(slot_value(o1->v[3].p))), real(slot_value(o1->v[1].p))); /* dd_fso */ + o2 = o->sc->opts[++o->sc->pc]; + x2 = o2->v[4].d_dd_f(o2->v[5].d_7pi_f(o->sc, slot_value(o2->v[2].p), integer(slot_value(o2->v[3].p))), real(slot_value(o2->v[1].p))); /* dd_fso */ + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_dd_f(x1, x2)); +} + +static s7_double opt_d_mm_fff(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1, *o2; + s7_double x1, x2; + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[5].d_7pi_f(o->sc, slot_value(o1->v[2].p), integer(slot_value(o1->v[3].p))) * real(slot_value(o1->v[1].p)); + o2 = o->sc->opts[++o->sc->pc]; + x2 = o2->v[5].d_7pi_f(o->sc, slot_value(o2->v[2].p), integer(slot_value(o2->v[3].p))) * real(slot_value(o2->v[1].p)); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_dd_f(x1, x2)); } static s7_double opt_d_dd_fff_rev(void *p) @@ -51068,19 +52331,21 @@ static s7_double opt_d_dd_fff_rev(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_double x1, x2; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v4.d_dd_f(real(slot_value(o1->v1.p)), o1->v5.d_pi_f(slot_value(o1->v2.p), integer(slot_value(o1->v3.p)))); - o2 = cur_sc->opts[++cur_sc->pc]; - x2 = o2->v4.d_dd_f(real(slot_value(o2->v1.p)), o2->v5.d_pi_f(slot_value(o2->v2.p), integer(slot_value(o2->v3.p)))); - return(o->v3.d_dd_f(x1, x2)); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[4].d_dd_f(real(slot_value(o1->v[1].p)), o1->v[5].d_7pi_f(o->sc, slot_value(o1->v[2].p), integer(slot_value(o1->v[3].p)))); + o2 = o->sc->opts[++o->sc->pc]; + x2 = o2->v[4].d_dd_f(real(slot_value(o2->v[1].p)), o2->v[5].d_7pi_f(o->sc, slot_value(o2->v[2].p), integer(slot_value(o2->v[3].p)))); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].d_dd_f(x1, x2)); } static s7_double opt_d_dd_ff_o4(void *p) { opt_info *o = (opt_info *)p; s7_double x1; - x1 = o->v2.d_v_f(o->v1.obj); - return(o->v3.d_dd_f(x1, o->v8.d_vd_f(o->v5.obj, o->v4.d_v_f(o->v6.obj)))); + x1 = o->v[2].d_v_f(o->v[1].obj); + oo_rcheck(o->sc, o, 8, 3); + return(o->v[3].d_dd_f(x1, o->v[7].d_vd_f(o->v[5].obj, o->v[4].d_v_f(o->v[6].obj)))); } static bool d_dd_ff_combinable(s7_scheme *sc, int32_t start) @@ -51088,75 +52353,99 @@ static bool d_dd_ff_combinable(s7_scheme *sc, int32_t start) opt_info *opc, *o1; opc = sc->opts[start - 1]; o1 = sc->opts[start]; - if (o1->v7.fd == opt_d_v) + if (o1->v[0].fd == opt_d_v) { opt_info *o2; + /* opc->v[3] is in use */ o2 = sc->opts[start + 1]; - if ((o2->v7.fd == opt_d_v) && + if ((o2->v[0].fd == opt_d_v) && (sc->pc == start + 2)) { - opc->v1.obj = o1->v5.obj; - opc->v4.d_v_f = o1->v3.d_v_f; - opc->v2.obj = o2->v5.obj; - opc->v5.d_v_f = o2->v3.d_v_f; - opc->v7.fd = opt_d_dd_ff_o2; + opc->v[1].obj = o1->v[5].obj; + opc->v[6].p = o1->v[1].p; + opc->v[4].d_v_f = o1->v[3].d_v_f; + opc->v[2].obj = o2->v[5].obj; + opc->v[7].p = o2->v[1].p; + opc->v[5].d_v_f = o2->v[3].d_v_f; + opc->v[0].fd = opt_d_dd_ff_o2; + oo_set_type_2(opc, 8, 6 + (1 << 4), 7 + (2 << 4), OO_V, OO_V); + oo_check(sc, opc); sc->pc -= 2; } else { - if ((o2->v7.fd == opt_d_vd_s) && + if ((o2->v[0].fd == opt_d_vd_s) && (sc->pc == start + 2)) { - opc->v4.d_dd_f = opc->v3.d_dd_f; /* make room for symbols */ - opc->v1.obj = o1->v5.obj; - opc->v5.d_v_f = o1->v3.d_v_f; - opc->v2.obj = o2->v5.obj; - opc->v6.d_vd_f = o2->v3.d_vd_f; - opc->v3.p = o2->v2.p; - opc->v7.fd = opt_d_dd_ff_o3; + opc->v[4].d_dd_f = opc->v[3].d_dd_f; /* make room for symbols */ + opc->v[1].obj = o1->v[5].obj; + opc->v[7].p = o1->v[1].p; + opc->v[5].d_v_f = o1->v[3].d_v_f; + opc->v[2].obj = o2->v[5].obj; + opc->v[8].p = o2->v[1].p; + opc->v[6].d_vd_f = o2->v[3].d_vd_f; + opc->v[3].p = o2->v[2].p; + opc->v[0].fd = opt_d_dd_ff_o3; + oo_set_type_3(opc, 9, 3, 7 + (1 << 4), 8 + (2 << 4), OO_D, OO_V, OO_V); + oo_check(sc, opc); sc->pc -= 2; } else { - if ((o2->v7.fd == opt_d_vd_o) && + if ((o2->v[0].fd == opt_d_vd_o) && (sc->pc == start + 2)) { - opc->v1.obj = o1->v5.obj; - opc->v2.d_v_f = o1->v3.d_v_f; - opc->v8.d_vd_f = o2->v3.d_vd_f; - opc->v4.d_v_f = o2->v4.d_v_f; - opc->v5.obj = o2->v5.obj; - opc->v6.obj = o2->v6.obj; - opc->v7.fd = opt_d_dd_ff_o4; + opc->v[1].obj = o1->v[5].obj; + opc->v[8].p = o1->v[1].p; + opc->v[2].d_v_f = o1->v[3].d_v_f; + opc->v[7].d_vd_f = o2->v[3].d_vd_f; + opc->v[4].d_v_f = o2->v[4].d_v_f; + opc->v[5].obj = o2->v[5].obj; + opc->v[9].p = o2->v[1].p; + opc->v[6].obj = o2->v[6].obj; + opc->v[10].p = o2->v[2].p; + opc->v[0].fd = opt_d_dd_ff_o4; + oo_set_type_3(opc, 11, 8 + (1 << 4), 9 + (5 << 4), 10 + (6 << 4), OO_V, OO_V, OO_V); + oo_check(sc, opc); sc->pc -= 2; } else { - opc->v1.obj = o1->v5.obj; - opc->v2.d_v_f = o1->v3.d_v_f; - opc->v7.fd = opt_d_dd_ff_o1; + opc->v[1].obj = o1->v[5].obj; + opc->v[4].p = o1->v[1].p; + opc->v[2].d_v_f = o1->v[3].d_v_f; + opc->v[0].fd = opt_d_dd_ff_o1; + oo_set_type_1(opc, 5, 4 + (1 << 4), OO_V); + oo_check(sc, opc); } } } return(true); } - if (o1->v7.fd == opt_d_dd_fso) + if (o1->v[0].fd == opt_d_dd_fso) { opt_info *o2; o2 = sc->opts[start + 1]; - if (o2->v7.fd == opt_d_dd_fso) - { - opc->v7.fd = opt_d_dd_fff; + if (o2->v[0].fd == opt_d_dd_fso) + { + if ((o1->v[4].d_dd_f == multiply_d_dd) && + (o2->v[4].d_dd_f == multiply_d_dd)) + opc->v[0].fd = opt_d_mm_fff; + else opc->v[0].fd = opt_d_dd_fff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } - if (o1->v7.fd == opt_d_dd_sfo) + if (o1->v[0].fd == opt_d_dd_sfo) { opt_info *o2; o2 = sc->opts[start + 1]; - if (o2->v7.fd == opt_d_dd_sfo) + if (o2->v[0].fd == opt_d_dd_sfo) { - opc->v7.fd = opt_d_dd_fff_rev; + opc->v[0].fd = opt_d_dd_fff_rev; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -51166,13 +52455,15 @@ static bool d_dd_ff_combinable(s7_scheme *sc, int32_t start) static s7_double opt_d_dd_cfo(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(o->v2.x, o->v4.d_v_f(o->v1.obj))); + oo_rcheck(o->sc, o, 5, 0); + return(o->v[3].d_dd_f(o->v[2].x, o->v[4].d_v_f(o->v[1].obj))); } static s7_double opt_d_dd_cfo1(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.d_dd_f(o->v4.x, o->v5.d_vd_f(o->v6.obj, real(slot_value(o->v2.p))))); + oo_rcheck(o->sc, o, 7, 2); + return(o->v[3].d_dd_f(o->v[4].x, o->v[5].d_vd_f(o->v[6].obj, real(slot_value(o->v[2].p))))); } static bool d_dd_cf_combinable(s7_scheme *sc, opt_info *opc) @@ -51182,24 +52473,28 @@ static bool d_dd_cf_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fd == opt_d_v) - { - opc->v2.x = opc->v1.x; - opc->v6.p = o1->v1.p; - opc->v1.obj = o1->v5.obj; - opc->v4.d_v_f = o1->v3.d_v_f; - opc->v7.fd = opt_d_dd_cfo; + if (o1->v[0].fd == opt_d_v) + { + opc->v[2].x = opc->v[1].x; + opc->v[6].p = o1->v[1].p; + opc->v[1].obj = o1->v[5].obj; + opc->v[4].d_v_f = o1->v[3].d_v_f; + opc->v[0].fd = opt_d_dd_cfo; + oo_set_type_1(opc, 7, 6 + (1 << 4), OO_V); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fd == opt_d_vd_s) + if (o1->v[0].fd == opt_d_vd_s) { - opc->v4.x = opc->v1.x; - opc->v1.p = o1->v1.p; - opc->v6.obj = o1->v5.obj; - opc->v2.p = o1->v2.p; - opc->v5.d_vd_f = o1->v3.d_vd_f; - opc->v7.fd = opt_d_dd_cfo1; + opc->v[4].x = opc->v[1].x; + opc->v[1].p = o1->v[1].p; + opc->v[6].obj = o1->v[5].obj; + opc->v[2].p = o1->v[2].p; + opc->v[5].d_vd_f = o1->v[3].d_vd_f; + opc->v[0].fd = opt_d_dd_cfo1; + oo_set_type_2(opc, 7, 1 + (6 << 4), 2, OO_V, OO_D); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -51210,46 +52505,63 @@ static bool d_dd_cf_combinable(s7_scheme *sc, opt_info *opc) static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { s7_d_dd_t func; + s7_d_7dd_t func7 = NULL; func = s7_d_dd_function(s_func); - if (func) + if (!func) func7 = s7_d_7dd_function(s_func); + if ((func) || (func7)) { s7_pointer arg1, arg2; int32_t start; start = sc->pc; arg1 = cadr(car_x); arg2 = caddr(car_x); - opc->v3.d_dd_f = func; + if (func) + opc->v[3].d_dd_f = func; + else opc->v[3].d_7dd_f = func7; if (is_real(arg1)) { if (is_real(arg2)) { if ((!is_t_real(arg1)) && (!is_t_real(arg2))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.x = s7_number_to_real(sc, arg1); - opc->v2.x = s7_number_to_real(sc, arg2); - opc->v7.fd = opt_d_dd_cc; + opc->v[1].x = s7_number_to_real(sc, arg1); + opc->v[2].x = s7_number_to_real(sc, arg2); + if (func) + opc->v[0].fd = opt_d_dd_cc; + else opc->v[0].fd = opt_d_7dd_cc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (is_symbol(arg2)) { - opc->v1.p = symbol_to_slot(sc, arg2); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, arg2); + if (is_slot(opc->v[1].p)) { - if (is_float(slot_value(opc->v1.p))) + if (is_float(slot_value(opc->v[1].p))) { - opc->v2.x = s7_number_to_real(sc, arg1); - opc->v7.fd = opt_d_dd_cs; + opc->v[2].x = s7_number_to_real(sc, arg1); + if (func) + opc->v[0].fd = opt_d_dd_cs; + else opc->v[0].fd = opt_d_7dd_cs; + oo_set_type_1(opc, 4, 1, OO_D); } else { - opc->v1.x = s7_number_to_real(sc, arg1); /* cf combine v1.x = arg1 */ + opc->v[1].x = s7_number_to_real(sc, arg1); /* cf combine v[1].x = arg1 */ + oo_set_type_0(opc, 4); if (float_optimize(sc, cddr(car_x))) { if (!d_dd_cf_combinable(sc, opc)) - opc->v7.fd = opt_d_dd_cf; + { + if (func) + opc->v[0].fd = opt_d_dd_cf; + else opc->v[0].fd = opt_d_7dd_cf; + } } else return(return_false(sc, car_x, __func__, __LINE__)); } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51258,9 +52570,15 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (float_optimize(sc, cddr(car_x))) { - opc->v1.x = s7_number_to_real(sc, arg1); + opc->v[1].x = s7_number_to_real(sc, arg1); if (!d_dd_cf_combinable(sc, opc)) - opc->v7.fd = opt_d_dd_cf; + { + if (func) + opc->v[0].fd = opt_d_dd_cf; + else opc->v[0].fd = opt_d_7dd_cf; + oo_set_type_0(opc, 4); + } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51270,31 +52588,45 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_symbol(arg1)) { - opc->v1.p = symbol_to_slot(sc, arg1); - if ((is_slot(opc->v1.p)) && - (is_real(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, arg1); + if ((is_slot(opc->v[1].p)) && + (is_real(slot_value(opc->v[1].p)))) { - if (is_float(slot_value(opc->v1.p))) + if (is_float(slot_value(opc->v[1].p))) { if (is_real(arg2)) { - opc->v2.x = s7_number_to_real(sc, arg2); - opc->v7.fd = opt_d_dd_sc; + opc->v[2].x = s7_number_to_real(sc, arg2); + if (func) + opc->v[0].fd = opt_d_dd_sc; + else opc->v[0].fd = opt_d_7dd_sc; + oo_set_type_1(opc, 4, 1, OO_D); return(true); } if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - if (is_slot(opc->v2.p)) + opc->v[2].p = symbol_to_slot(sc, arg2); + if (is_slot(opc->v[2].p)) { - if (is_float(slot_value(opc->v2.p))) - opc->v7.fd = opt_d_dd_ss; + if (is_float(slot_value(opc->v[2].p))) + { + if (func) + opc->v[0].fd = opt_d_dd_ss; + else opc->v[0].fd = opt_d_7dd_ss; + oo_set_type_2(opc, 4, 1, 2, OO_R, OO_D); + } else { + oo_set_type_1(opc, 4, 1, OO_D); if (float_optimize(sc, cddr(car_x))) - opc->v7.fd = opt_d_dd_sf; + { + if (func) + opc->v[0].fd = opt_d_dd_sf; + else opc->v[0].fd = opt_d_7dd_sf; + } else return(return_false(sc, car_x, __func__, __LINE__)); } + oo_check(sc, opc); return(true); } } @@ -51303,7 +52635,13 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (float_optimize(sc, cddr(car_x))) { if (!d_dd_sf_combinable(sc, opc)) - opc->v7.fd = opt_d_dd_sf; + { + if (func) + opc->v[0].fd = opt_d_dd_sf; + else opc->v[0].fd = opt_d_7dd_sf; + oo_set_type_1(opc, 4, 1, OO_D); + } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51315,7 +52653,13 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (float_optimize(sc, cddr(car_x)))) { if (!d_dd_ff_combinable(sc, start)) - opc->v7.fd = opt_d_dd_ff; + { + if (func) + opc->v[0].fd = opt_d_dd_ff; + else opc->v[0].fd = opt_d_7dd_ff; + oo_set_type_0(opc, 4); + } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51329,29 +52673,44 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_real(arg2)) { - opc->v2.x = s7_number_to_real(sc, arg2); - opc->v7.fd = opt_d_dd_fc; + opc->v[2].x = s7_number_to_real(sc, arg2); + if (func) + opc->v[0].fd = opt_d_dd_fc; + else opc->v[0].fd = opt_d_7dd_fc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (is_symbol(arg2)) { - opc->v1.p = symbol_to_slot(sc, arg2); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, arg2); + if (is_slot(opc->v[1].p)) { - if (is_float(slot_value(opc->v1.p))) + if (is_float(slot_value(opc->v[1].p))) { if (!d_dd_fs_combinable(sc, opc)) - opc->v7.fd = opt_d_dd_fs; + { + if (func) + opc->v[0].fd = opt_d_dd_fs; + else opc->v[0].fd = opt_d_7dd_fs; + oo_set_type_1(opc, 4, 1, OO_D); + } } else { + oo_set_type_0(opc, 4); if (float_optimize(sc, cddr(car_x))) { if (!d_dd_ff_combinable(sc, start)) - opc->v7.fd = opt_d_dd_ff; + { + if (func) + opc->v[0].fd = opt_d_dd_ff; + else opc->v[0].fd = opt_d_7dd_ff; + } } else return(return_false(sc, car_x, __func__, __LINE__)); } + oo_check(sc, opc); return(true); } } @@ -51360,7 +52719,13 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (float_optimize(sc, cddr(car_x))) { if (!d_dd_ff_combinable(sc, start)) - opc->v7.fd = opt_d_dd_ff; + { + if (func) + opc->v[0].fd = opt_d_dd_ff; + else opc->v[0].fd = opt_d_7dd_ff; + oo_set_type_0(opc, 4); + } + oo_check(sc, opc); return(true); } } @@ -51376,15 +52741,17 @@ static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_double opt_d_ddd_sss(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_ddd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p)), real(slot_value(o->v3.p)))); + oo_rcheck(o->sc, o, 5, 3); + return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)), real(slot_value(o->v[3].p)))); } static s7_double opt_d_ddd_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_ddd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p)), o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 2); + return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)), o1->v[0].fd(o1))); } static s7_double opt_d_ddd_sff(void *p) @@ -51392,10 +52759,11 @@ static s7_double opt_d_ddd_sff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_double x1; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_ddd_f(real(slot_value(o->v1.p)), x1, o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 1); + return(o->v[4].d_ddd_f(real(slot_value(o->v[1].p)), x1, o1->v[0].fd(o1))); } static s7_double opt_d_ddd_fff(void *p) @@ -51403,22 +52771,24 @@ static s7_double opt_d_ddd_fff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2, *o3; s7_double x1, x2; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); /* this could involve nested funcs, incrementing pc internally */ - o2 = cur_sc->opts[++cur_sc->pc]; - x2 = o2->v7.fd(o2); - o3 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_ddd_f(x1, x2, o3->v7.fd(o3))); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); /* this could involve nested funcs, incrementing pc internally */ + o2 = o->sc->opts[++o->sc->pc]; + x2 = o2->v[0].fd(o2); + o3 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 0); + return(o->v[4].d_ddd_f(x1, x2, o3->v[0].fd(o3))); } static s7_double opt_d_ddd_fff1(void *p) { opt_info *o = (opt_info *)p; s7_double x1, x2, x3; - x1 = o->v1.d_v_f(o->v2.obj); - x2 = o->v3.d_v_f(o->v4.obj); - x3 = o->v5.d_v_f(o->v6.obj); - return(o->v8.d_ddd_f(x1, x2, x3)); + x1 = o->v[1].d_v_f(o->v[2].obj); + x2 = o->v[3].d_v_f(o->v[4].obj); + x3 = o->v[5].d_v_f(o->v[6].obj); + oo_rcheck(o->sc, o, 8, 3); + return(o->v[7].d_ddd_f(x1, x2, x3)); } static s7_double opt_d_ddd_fff2(void *p) @@ -51426,37 +52796,45 @@ static s7_double opt_d_ddd_fff2(void *p) opt_info *o = (opt_info *)p; opt_info *o2, *o3; s7_double x1, x2; - x1 = o->v1.d_v_f(o->v2.obj); - cur_sc->pc += 2; - o2 = cur_sc->opts[cur_sc->pc]; - x2 = o2->v7.fd(o2); - o3 = cur_sc->opts[++cur_sc->pc]; - return(o->v8.d_ddd_f(x1, x2, o3->v7.fd(o3))); + x1 = o->v[1].d_v_f(o->v[2].obj); + o->sc->pc += 2; + o2 = o->sc->opts[o->sc->pc]; + x2 = o2->v[0].fd(o2); + o3 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 8, 1); + return(o->v[7].d_ddd_f(x1, x2, o3->v[0].fd(o3))); } static bool d_ddd_fff_combinable(s7_scheme *sc, opt_info *opc, int32_t start) { - if (sc->opts[start]->v7.fd == opt_d_v) + if (sc->opts[start]->v[0].fd == opt_d_v) { opt_info *o1; - opc->v8.d_ddd_f = opc->v4.d_ddd_f; + opc->v[7].d_ddd_f = opc->v[4].d_ddd_f; o1 = sc->opts[start]; - opc->v1.d_v_f = o1->v3.d_v_f; - opc->v2.obj = o1->v5.obj; - if ((sc->opts[start + 1]->v7.fd == opt_d_v) && - (sc->opts[start + 2]->v7.fd == opt_d_v)) + opc->v[1].d_v_f = o1->v[3].d_v_f; + opc->v[2].obj = o1->v[5].obj; + opc->v[8].p = o1->v[1].p; + if ((sc->opts[start + 1]->v[0].fd == opt_d_v) && + (sc->opts[start + 2]->v[0].fd == opt_d_v)) { - opc->v7.fd = opt_d_ddd_fff1; + opc->v[0].fd = opt_d_ddd_fff1; o1 = sc->opts[start + 1]; - opc->v3.d_v_f = o1->v3.d_v_f; - opc->v4.obj = o1->v5.obj; + opc->v[3].d_v_f = o1->v[3].d_v_f; + opc->v[4].obj = o1->v[5].obj; + opc->v[9].p = o1->v[1].p; o1 = sc->opts[start + 2]; - opc->v5.d_v_f = o1->v3.d_v_f; - opc->v6.obj = o1->v5.obj; + opc->v[5].d_v_f = o1->v[3].d_v_f; + opc->v[6].obj = o1->v[5].obj; + opc->v[10].p = o1->v[1].p; sc->pc -= 3; + oo_set_type_3(opc, 11, 8 + (2 << 4), 9 + (4 << 4), 10 + (6 << 4), OO_V, OO_V, OO_V); + oo_check(sc, opc); return(true); } - opc->v7.fd = opt_d_ddd_fff2; + opc->v[0].fd = opt_d_ddd_fff2; + oo_set_type_1(opc, 9, 8 + (2 << 4), OO_V); + oo_check(sc, opc); return(true); } return(false); @@ -51474,12 +52852,12 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer arg1 = cadr(car_x); arg2 = caddr(car_x); start = sc->pc; - opc->v4.d_ddd_f = f; + opc->v[4].d_ddd_f = f; if (is_symbol(arg1)) { s7_pointer slot1; slot1 = symbol_to_slot(sc, arg1); - opc->v1.p = slot1; + opc->v[1].p = slot1; if ((is_slot(slot1)) && (is_float(slot_value(slot1)))) { @@ -51487,7 +52865,7 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { s7_pointer slot2; slot2 = symbol_to_slot(sc, arg2); - opc->v2.p = slot2; + opc->v[2].p = slot2; if ((is_slot(slot2)) && (is_float(slot_value(slot2)))) { @@ -51497,17 +52875,21 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { s7_pointer slot3; slot3 = symbol_to_slot(sc, arg3); - opc->v3.p = slot3; + opc->v[3].p = slot3; if ((is_slot(slot3)) && (is_float(slot_value(slot3)))) { - opc->v7.fd = opt_d_ddd_sss; + opc->v[0].fd = opt_d_ddd_sss; + oo_set_type_3(opc, 5, 1, 2, 3, OO_D, OO_D, OO_D); + oo_check(sc, opc); return(true); } } if (float_optimize(sc, cdddr(car_x))) { - opc->v7.fd = opt_d_ddd_ssf; + oo_set_type_2(opc, 5, 1, 2, OO_D, OO_D); + oo_check(sc, opc); + opc->v[0].fd = opt_d_ddd_ssf; return(true); } pc_fallback(sc, start); @@ -51516,7 +52898,9 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((float_optimize(sc, cddr(car_x))) && (float_optimize(sc, cdddr(car_x)))) { - opc->v7.fd = opt_d_ddd_sff; + oo_set_type_1(opc, 5, 1, OO_D); + oo_check(sc, opc); + opc->v[0].fd = opt_d_ddd_sff; return(true); } } @@ -51528,12 +52912,14 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (!d_ddd_fff_combinable(sc, opc, start)) { - opc->v7.fd = opt_d_ddd_fff; - /* (* (env pulsef) (blackman pulse2) (polywave gen (rand-interp rnd))) - * (* (env e)...) is common = opt_d_v: v3 v5 -> opc - * (+ k (* 2 alpha) -2.0) (* scl ang ang) (- n k 1) - */ + opc->v[0].fd = opt_d_ddd_fff; + /* (* (env pulsef) (blackman pulse2) (polywave gen (rand-interp rnd))) + * (* (env e)...) is common = opt_d_v: v3 v5 -> opc + * (+ k (* 2 alpha) -2.0) (* scl ang ang) (- n k 1) + */ + oo_set_type_0(opc, 5); } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51541,127 +52927,144 @@ static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer return(false); } -/* -------- d_pid -------- */ -static s7_double opt_d_pid_ssf(void *p) +/* -------- d_7pid -------- */ +static s7_double opt_d_7pid_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 2); + return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fd(o1))); } -static s7_pointer opt_d_pid_ssf_nr(void *p) +static s7_pointer opt_d_7pid_ssf_nr(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fd(o1)); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 2); + o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fd(o1)); return(NULL); } -static s7_double opt_d_pid_sss(void *p) +static s7_double opt_d_7pid_sss(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), real(slot_value(o->v3.p)))); + oo_rcheck(o->sc, o, 5, 3); + return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), real(slot_value(o->v[3].p)))); } -static s7_double opt_d_pid_sff(void *p) +static s7_double opt_d_7pid_sff(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; s7_int pos; - o1 = cur_sc->opts[++cur_sc->pc]; - pos = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_pid_f(slot_value(o->v1.p), pos, o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + pos = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 5, 1); + return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), pos, o1->v[0].fd(o1))); } -static s7_double opt_d_pid_sso(void *p) +static s7_double opt_d_7pid_sso(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v5.d_v_f(o->v3.obj))); + oo_rcheck(o->sc, o, 6, 3); + return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].d_v_f(o->v[3].obj))); } -static s7_double opt_d_pid_ss_ss(void *p) +static s7_double opt_d_7pid_ss_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.d_pid_f(slot_value(o->v1.p), - integer(slot_value(o->v2.p)), - o->v3.d_pi_f(slot_value(o->v5.p), - integer(slot_value(o->v6.p))))); + oo_rcheck(o->sc, o, 7, 4); + return(o->v[4].d_7pid_f(o->sc, slot_value(o->v[1].p), + integer(slot_value(o->v[2].p)), + o->v[3].d_7pi_f(o->sc, slot_value(o->v[5].p), + integer(slot_value(o->v[6].p))))); } -static s7_double opt_d_pid_ssfo(void *p) +static s7_double opt_d_7pid_ssfo(void *p) { opt_info *o = (opt_info *)p; s7_pointer fv; - fv = slot_value(o->v1.p); - return(o->v4.d_pid_f(fv, integer(slot_value(o->v2.p)), - o->v6.d_dd_f(o->v5.d_pi_f(fv, integer(slot_value(o->v3.p))), real(slot_value(o->v9.p))))); + fv = slot_value(o->v[1].p); + oo_rcheck(o->sc, o, 9, 4); + return(o->v[4].d_7pid_f(o->sc, fv, integer(slot_value(o->v[2].p)), + o->v[6].d_dd_f(o->v[5].d_7pi_f(o->sc, fv, integer(slot_value(o->v[3].p))), real(slot_value(o->v[8].p))))); } -static s7_double opt_d_pid_ssfo_fv(void *p) +static s7_double opt_d_7pid_ssfo_fv(void *p) { opt_info *o = (opt_info *)p; s7_double val; s7_double *els; - els = float_vector_elements(slot_value(o->v1.p)); - val = o->v6.d_dd_f(els[integer(slot_value(o->v3.p))], real(slot_value(o->v9.p))); - els[integer(slot_value(o->v2.p))] = val; + els = float_vector_elements(slot_value(o->v[1].p)); + val = o->v[6].d_dd_f(els[integer(slot_value(o->v[3].p))], real(slot_value(o->v[8].p))); + els[integer(slot_value(o->v[2].p))] = val; + oo_rcheck(o->sc, o, 7, 4); return(val); } -static s7_pointer opt_d_pid_ssfo_fv_nr(void *p) +static s7_pointer opt_d_7pid_ssfo_fv_nr(void *p) { opt_info *o = (opt_info *)p; s7_double *els; - els = float_vector_elements(slot_value(o->v1.p)); - els[integer(slot_value(o->v2.p))] = o->v6.d_dd_f(els[integer(slot_value(o->v3.p))], real(slot_value(o->v9.p))); + els = float_vector_elements(slot_value(o->v[1].p)); + els[integer(slot_value(o->v[2].p))] = o->v[6].d_dd_f(els[integer(slot_value(o->v[3].p))], real(slot_value(o->v[8].p))); + oo_rcheck(o->sc, o, 9, 4); return(NULL); } -static bool d_pid_ssf_combinable(s7_scheme *sc, opt_info *opc) +static bool d_7pid_ssf_combinable(s7_scheme *sc, opt_info *opc) { if ((sc->pc > 1) && (opc == sc->opts[sc->pc - 2])) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fd == opt_d_v) - { - opc->v6.p = o1->v1.p; - opc->v3.obj = o1->v5.obj; - opc->v5.d_v_f = o1->v3.d_v_f; - opc->v7.fd = opt_d_pid_sso; + if (o1->v[0].fd == opt_d_v) + { + opc->v[6].p = o1->v[1].p; + opc->v[3].obj = o1->v[5].obj; + opc->v[5].d_v_f = o1->v[3].d_v_f; + opc->v[0].fd = opt_d_7pid_sso; + oo_set_type_3(opc, 7, 1, 2, 6 + (3 << 4), OO_P, OO_I, OO_V); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fd == opt_d_pi_ss) + if (o1->v[0].fd == opt_d_7pi_ss) { - opc->v3.d_pi_f = o1->v3.d_pi_f; - opc->v5.p = o1->v1.p; - opc->v6.p = o1->v2.p; - opc->v7.fd = opt_d_pid_ss_ss; + opc->v[3].d_7pi_f = o1->v[3].d_7pi_f; + opc->v[5].p = o1->v[1].p; + opc->v[6].p = o1->v[2].p; + opc->v[0].fd = opt_d_7pid_ss_ss; + oo_set_type_4(opc, 7, 1, 2, 5, 6, OO_P, OO_I, OO_P, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } - if ((o1->v7.fd == opt_d_dd_fso) && - (opc->v1.p == o1->v2.p)) + if ((o1->v[0].fd == opt_d_dd_fso) && + (opc->v[1].p == o1->v[2].p)) { - /* opc: pid_ssf: o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fd(o1)) - * o1: d_dd_fso: o->v4.d_dd_f(o->v5.d_pi_f(slot_value(o->v2.p), integer(slot_value(o->v3.p))), real(slot_value(o->v1.p)))) + /* opc: pid_ssf: o->v[4].d_7pid_f(slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fd(o1)) + * o1: d_dd_fso: o->v[4].d_dd_f(o->v[5].d_7pi_f(slot_value(o->v[2].p), integer(slot_value(o->v[3].p))), real(slot_value(o->v[1].p)))) */ - opc->v6.d_dd_f = o1->v4.d_dd_f; - opc->v5.d_pi_f = o1->v5.d_pi_f; - opc->v3.p = o1->v3.p; - opc->v9.p = o1->v1.p; /* can't use v8 since d_to_p commandeers it */ - opc->v7.fd = opt_d_pid_ssfo; - if (((opc->v5.d_pi_f == float_vector_ref_unchecked) || - (opc->v5.d_pi_f == float_vector_ref_d)) && - ((opc->v4.d_pid_f == float_vector_set_unchecked) || - (opc->v4.d_pid_f == float_vector_set_d))) - opc->v7.fd = opt_d_pid_ssfo_fv; - /* actually if either is *_d, we need to check the indices */ + opc->v[6].d_dd_f = o1->v[4].d_dd_f; + opc->v[5].d_7pi_f = o1->v[5].d_7pi_f; + opc->v[3].p = o1->v[3].p; + opc->v[8].p = o1->v[1].p; /* can't use v8 since d_to_p commandeers it */ + opc->v[0].fd = opt_d_7pid_ssfo; + if (((opc->v[5].d_7pi_f == float_vector_ref_unchecked) || + (opc->v[5].d_7pi_f == float_vector_ref_d_7pi)) && + ((opc->v[4].d_7pid_f == float_vector_set_unchecked) || + (opc->v[4].d_7pid_f == float_vector_set_d_7pid))) + { + opc->v[0].fd = opt_d_7pid_ssfo_fv; /* actually if either is *_d, we need to check the indices */ + oo_set_type_4(opc, 9, 1, 2, 3, 8, OO_FV, OO_I, OO_I, OO_D); + } + else oo_set_type_4(opc, 9, 1, 2, 3, 8, OO_P, OO_I, OO_I, OO_D); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -51676,11 +53079,11 @@ static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_ if ((is_slot(settee)) && (!is_immutable(slot_value(settee)))) { - opc->v1.p = settee; + opc->v[1].p = settee; if ((is_float_vector(slot_value(settee))) && (vector_rank(slot_value(settee)) == 1)) { - opc->v4.d_pid_f = float_vector_set_d; + opc->v[4].d_7pid_f = float_vector_set_d_7pid; if (is_symbol(car(indexp))) { s7_pointer slot; @@ -51688,10 +53091,10 @@ static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_ if ((is_slot(slot)) && (is_integer(slot_value(slot)))) { - opc->v2.p = slot; - if ((is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(settee)))) - opc->v4.d_pid_f = float_vector_set_unchecked; + opc->v[2].p = slot; + if ((is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(settee)))) + opc->v[4].d_7pid_f = float_vector_set_unchecked; if (is_symbol(car(valp))) { s7_pointer val_slot; @@ -51699,15 +53102,21 @@ static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_ if ((is_slot(val_slot)) && (is_float(slot_value(val_slot)))) { - opc->v3.p = val_slot; - opc->v7.fd = opt_d_pid_sss; + opc->v[3].p = val_slot; + opc->v[0].fd = opt_d_7pid_sss; + oo_set_type_3(opc, 5, 1, 2, 3, OO_FV, OO_I, OO_D); + oo_check(sc, opc); return(true); } } if (float_optimize(sc, valp)) { - if (!d_pid_ssf_combinable(sc, opc)) - opc->v7.fd = opt_d_pid_ssf; + if (!d_7pid_ssf_combinable(sc, opc)) + { + opc->v[0].fd = opt_d_7pid_ssf; + oo_set_type_2(opc, 5, 1, 2, OO_FV, OO_I); + } + oo_check(sc, opc); return(true); } } @@ -51717,7 +53126,9 @@ static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_ if ((int_optimize(sc, indexp)) && (float_optimize(sc, valp))) { - opc->v7.fd = opt_d_pid_sff; + opc->v[0].fd = opt_d_7pid_sff; + oo_set_type_1(opc, 5, 1, OO_FV); + oo_check(sc, opc); return(true); } } @@ -51726,10 +53137,10 @@ static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_ return(false); } -static bool d_pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) +static bool d_7pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { - s7_d_pid_t f; - f = s7_d_pid_function(s_func); + s7_d_7pid_t f; + f = s7_d_7pid_function(s_func); if ((f) && (is_symbol(cadr(car_x)))) { @@ -51738,19 +53149,19 @@ static bool d_pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer start = sc->pc; head = car(car_x); - opc->v4.d_pid_f = f; + opc->v[4].d_7pid_f = f; if (head == sc->float_vector_set_symbol) return(opt_float_vector_set(sc, opc, cadr(car_x), cddr(car_x), cdddr(car_x))); - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if (is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if (is_slot(opc->v[1].p)) { if (is_symbol(caddr(car_x))) { - opc->v2.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v2.p)) && - (is_integer(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[2].p)) && + (is_integer(slot_value(opc->v[2].p)))) { if (is_symbol(cadddr(car_x))) { @@ -51759,15 +53170,21 @@ static bool d_pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(val_slot)) && (is_float(slot_value(val_slot)))) { - opc->v3.p = val_slot; - opc->v7.fd = opt_d_pid_sss; + opc->v[3].p = val_slot; + opc->v[0].fd = opt_d_7pid_sss; + oo_set_type_3(opc, 5, 1, 2, 3, OO_P, OO_I, OO_D); + oo_check(sc, opc); return(true); } } if (float_optimize(sc, cdddr(car_x))) { - if (!d_pid_ssf_combinable(sc, opc)) - opc->v7.fd = opt_d_pid_ssf; + if (!d_7pid_ssf_combinable(sc, opc)) + { + opc->v[0].fd = opt_d_7pid_ssf; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_I); + } + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51778,7 +53195,9 @@ static bool d_pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((int_optimize(sc, cddr(car_x))) && (float_optimize(sc, cdddr(car_x)))) { - opc->v7.fd = opt_d_pid_sff; + opc->v[0].fd = opt_d_7pid_sff; + oo_set_type_1(opc, 5, 1, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51793,8 +53212,9 @@ static s7_double opt_d_vid_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_vid_f(o->v5.obj, integer(slot_value(o->v2.p)), o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 6, 2); + return(o->v[4].d_vid_f(o->v[5].obj, integer(slot_value(o->v[2].p)), o1->v[0].fd(o1))); } static inline s7_double opt_fmv(void *p) @@ -51804,20 +53224,18 @@ static inline s7_double opt_fmv(void *p) opt_info *o1, *o2, *o3; s7_double amp_env, index_env, vib; - o1 = cur_sc->opts[cur_sc->pc + 1]; - o2 = cur_sc->opts[cur_sc->pc + 3]; - o3 = cur_sc->opts[cur_sc->pc += 5]; - amp_env = o1->v2.d_v_f(o1->v1.obj); - vib = real(slot_value(o2->v2.p)); - index_env = o3->v5.d_v_f(o3->v1.obj); + o1 = o->sc->opts[o->sc->pc + 1]; + o2 = o->sc->opts[o->sc->pc + 3]; + o3 = o->sc->opts[o->sc->pc += 5]; + amp_env = o1->v[2].d_v_f(o1->v[1].obj); + vib = real(slot_value(o2->v[2].p)); + index_env = o3->v[5].d_v_f(o3->v[1].obj); - return(o->v4.d_vid_f(o->v5.obj, - integer(slot_value(o->v2.p)), - o1->v3.d_dd_f(amp_env, - o2->v3.d_vd_f(o2->v5.obj, - o2->v4.d_dd_f(vib, - o3->v4.d_dd_f(index_env, - o3->v6.d_vd_f(o3->v2.obj, vib))))))); + oo_rcheck(o->sc, o, 6, 2); + return(o->v[4].d_vid_f(o->v[5].obj, + integer(slot_value(o->v[2].p)), + amp_env * o2->v[3].d_vd_f(o2->v[5].obj, + vib + (index_env * o3->v[6].d_vd_f(o3->v[2].obj, vib))))); } static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -51830,7 +53248,7 @@ static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (flt) { s7_pointer sig; - opc->v4.d_vid_f = flt; + opc->v[4].d_vid_f = flt; sig = c_function_signature(s_func); if (is_pair(sig)) { @@ -51842,26 +53260,33 @@ static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer obj = slot_value(slot); if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) { - opc->v7.fd = opt_d_vid_ssf; - opc->v1.p = slot; - opc->v5.obj = (void *)s7_c_object_value(obj); - opc->v2.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v2.p)) && - (is_integer(slot_value(opc->v2.p))) && + opc->v[0].fd = opt_d_vid_ssf; + opc->v[1].p = slot; + opc->v[5].obj = (void *)s7_c_object_value(obj); + opc->v[2].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[2].p)) && + (is_integer(slot_value(opc->v[2].p))) && (float_optimize(sc, cdddr(car_x)))) { - opt_info *o1; - o1 = sc->opts[start]; - if (o1->v7.fd == opt_d_dd_ff_o1) + opt_info *o2; + o2 = sc->opts[start]; + if (o2->v[0].fd == opt_d_dd_ff_o1) { - o1 = sc->opts[start + 2]; - if (o1->v7.fd == opt_d_vd_o1) + opt_info *o3; + o3 = sc->opts[start + 2]; + if (o3->v[0].fd == opt_d_vd_o1) { + opt_info *o1; o1 = sc->opts[start + 4]; - if (o1->v7.fd == opt_d_dd_ff_o3) - opc->v7.fd = opt_fmv; + if ((o1->v[0].fd == opt_d_dd_ff_o3) && + (o1->v[4].d_dd_f == multiply_d_dd) && + (o2->v[3].d_dd_f == multiply_d_dd) && + (o3->v[4].d_dd_f == add_d_dd)) + opc->v[0].fd = opt_fmv; } } + oo_set_type_2(opc, 6, 1 + (5 << 4), 2, OO_V, OO_I); + oo_check(sc, opc); return(true); } } @@ -51878,10 +53303,11 @@ static s7_double opt_d_vdd_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_double x1; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - return(o->v4.d_vdd_f(o->v5.obj, x1, o2->v7.fd(o2))); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o2 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 6, 1); + return(o->v[4].d_vdd_f(o->v[5].obj, x1, o2->v[0].fd(o2))); } static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -51891,7 +53317,7 @@ static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if (flt) { s7_pointer sig; - opc->v4.d_vdd_f = flt; + opc->v[4].d_vdd_f = flt; sig = c_function_signature(s_func); if (is_pair(sig)) { @@ -51906,9 +53332,11 @@ static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((float_optimize(sc, cddr(car_x))) && (float_optimize(sc, cdddr(car_x)))) { - opc->v1.p = slot; - opc->v5.obj = (void *)s7_c_object_value(obj); - opc->v7.fd = opt_d_vdd_ff; + opc->v[1].p = slot; + opc->v[5].obj = (void *)s7_c_object_value(obj); + opc->v[0].fd = opt_d_vdd_ff; + oo_set_type_1(opc, 6, 1 + (5 << 4), OO_V); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -51925,14 +53353,15 @@ static s7_double opt_d_dddd_ffff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2, *o3, *o4; s7_double x1, x2, x3; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - x2 = o2->v7.fd(o2); - o3 = cur_sc->opts[++cur_sc->pc]; - x3 = o3->v7.fd(o3); - o4 = cur_sc->opts[++cur_sc->pc]; - return(o->v1.d_dddd_f(x1, x2, x3, o4->v7.fd(o4))); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o2 = o->sc->opts[++o->sc->pc]; + x2 = o2->v[0].fd(o2); + o3 = o->sc->opts[++o->sc->pc]; + x3 = o3->v[0].fd(o3); + o4 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 1, 0); + return(o->v[1].d_dddd_f(x1, x2, x3, o4->v[0].fd(o4))); } static bool d_dddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -51946,8 +53375,10 @@ static bool d_dddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointe (float_optimize(sc, cdddr(car_x))) && (float_optimize(sc, cddddr(car_x)))) { - opc->v1.d_dddd_f = f; - opc->v7.fd = opt_d_dddd_ffff; + opc->v[1].d_dddd_f = f; + opc->v[0].fd = opt_d_dddd_ffff; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } } @@ -51960,11 +53391,12 @@ static s7_double opt_d_add_any_f(void *p) opt_info *o = (opt_info *)p; s7_double sum = 0.0; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 2, 0); + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum += o1->v7.fd(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum += o1->v[0].fd(o1); } return(sum); } @@ -51975,12 +53407,13 @@ static s7_double opt_d_subtract_any_f(void *p) opt_info *o1; s7_double sum; int32_t i; - o1 = cur_sc->opts[++cur_sc->pc]; - sum = o1->v7.fd(o1); - for (i = 1; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + sum = o1->v[0].fd(o1); + for (i = 1; i < o->v[1].i; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - sum -= o1->v7.fd(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum -= o1->v[0].fd(o1); } return(sum); } @@ -51990,11 +53423,12 @@ static s7_double opt_d_multiply_any_f(void *p) opt_info *o = (opt_info *)p; s7_double sum = 1.0; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 2, 0); + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - sum *= o1->v7.fd(o1); + o1 = o->sc->opts[++o->sc->pc]; + sum *= o1->v[0].fd(o1); } return(sum); } @@ -52016,8 +53450,10 @@ static bool d_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x, int32_t if (is_null(p)) { /* since 2|3|4-arg case is split out above, can cur_len ever be 2? */ - opc->v1.i = cur_len; - opc->v7.fd = (head == sc->add_symbol) ? opt_d_add_any_f : opt_d_multiply_any_f; + opc->v[1].i = cur_len; + opc->v[0].fd = (head == sc->add_symbol) ? opt_d_add_any_f : opt_d_multiply_any_f; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } } @@ -52026,13 +53462,15 @@ static bool d_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x, int32_t if (head == sc->subtract_symbol) { s7_pointer p; - opc->v1.i = (len - 1); + opc->v[1].i = (len - 1); for (p = cdr(car_x); is_pair(p); p = cdr(p)) if (!float_optimize(sc, p)) break; if (is_null(p)) { - opc->v7.fd = opt_d_subtract_any_f; + opc->v[0].fd = opt_d_subtract_any_f; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } } @@ -52041,34 +53479,6 @@ static bool d_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x, int32_t return(false); } -/* -------- float_all_x -------- */ -static s7_double opt_unwrap_float(void *p) -{ - opt_info *o = (opt_info *)p; - return(s7_number_to_real(cur_sc, o->v2.all_f(cur_sc, car(o->v1.p)))); -} - -static bool float_all_x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer expr) -{ - s7_pointer sig; - s7_function opt; - sig = c_function_signature(s_func); - if ((is_pair(sig)) && - ((car(sig) == sc->is_float_symbol) || - (car(sig) == sc->is_real_symbol))) - { - /* fallback on the more general case (all_x_eval, but still guaranteed to be a number) */ - opt = all_x_optimize(sc, expr); - if (opt) - { - opc->v2.all_f = opt; - opc->v7.fd = opt_unwrap_float; - opc->v1.p = expr; - return(true); - } - } - return(false); -} /* -------- d_syntax -------- */ static s7_double opt_set_d_d_f(void *p) @@ -52076,9 +53486,10 @@ static s7_double opt_set_d_d_f(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_double x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = o1->v7.fd(o1); - slot_set_value(o->v1.p, make_real(cur_sc, x)); + o1 = o->sc->opts[++o->sc->pc]; + x = o1->v[0].fd(o1); + oo_rcheck(o->sc, o, 2, 1); + slot_set_value(o->v[1].p, make_real(o->sc, x)); return(x); } @@ -52087,9 +53498,10 @@ static s7_double opt_set_d_d_fm(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_double x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = o1->v7.fd(o1); - real(slot_value(o->v1.p)) = x; + o1 = o->sc->opts[++o->sc->pc]; + x = o1->v[0].fd(o1); + oo_rcheck(o->sc, o, 2, 1); + real(slot_value(o->v[1].p)) = x; return(x); } @@ -52110,13 +53522,15 @@ static bool d_syntax_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((is_slot(settee)) && (!is_immutable(settee))) { - opc->v1.p = settee; + opc->v[1].p = settee; if ((is_t_real(slot_value(settee))) && (float_optimize(sc, cddr(car_x)))) { - if (is_mutable(slot_value(opc->v1.p))) - opc->v7.fd = opt_set_d_d_fm; - else opc->v7.fd = opt_set_d_d_f; + if (is_mutable(slot_value(opc->v[1].p))) + opc->v[0].fd = opt_set_d_d_fm; + else opc->v[0].fd = opt_set_d_d_f; + oo_set_type_1(opc, 2, 1, OO_R); + oo_check(sc, opc); return(true); } } @@ -52146,7 +53560,7 @@ static bool d_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) /* implicit float-vector-ref */ opt_info *opc; opc = alloc_opo(sc, car_x); - opc->v1.p = s_slot; + opc->v[1].p = s_slot; if (is_symbol(cadr(car_x))) { s7_pointer slot; @@ -52154,12 +53568,14 @@ static bool d_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((is_slot(slot)) && (is_integer(slot_value(slot)))) { - opc->v7.fd = opt_d_pi_ss; - opc->v3.d_pi_f = float_vector_ref_d; - opc->v2.p = slot; - if ((is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p)))) - opc->v3.d_pi_f = float_vector_ref_unchecked; + opc->v[0].fd = opt_d_7pi_ss; + opc->v[3].d_7pi_f = float_vector_ref_d_7pi; + opc->v[2].p = slot; + if ((is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) + opc->v[3].d_7pi_f = float_vector_ref_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_FV, OO_I); + oo_check(sc, opc); return(true); } } @@ -52167,8 +53583,11 @@ static bool d_implicit_ok(s7_scheme *sc, s7_pointer car_x, int32_t len) { if (int_optimize(sc, cdr(car_x))) { - opc->v7.fd = opt_d_pi_sf; - opc->v3.d_pi_f = float_vector_ref_d; + opc->v[0].fd = opt_d_7pi_sf; + opc->v[3].d_7pi_f = float_vector_ref_d_7pi; + oo_set_type_1(opc, 4, 1, OO_FV); + oo_check(sc, opc); + return(true); } } } @@ -52190,7 +53609,8 @@ static bool opt_b_f(void *p) static bool opt_b_s(void *p) { opt_info *o = (opt_info *)p; - return(slot_value(o->v1.p) != cur_sc->F); + oo_rcheck(o->sc, o, 2, 1); + return(slot_value(o->v[1].p) != o->sc->F); } static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x) @@ -52202,7 +53622,9 @@ static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x) if (!s7_is_boolean(car_x)) return(return_false(sc, car_x, __func__, __LINE__)); /* i.e. use cell_optimize */ opc = alloc_opo(sc, car_x); - opc->v7.fb = ((car_x == sc->F) ? opt_b_f : opt_b_t); + opc->v[0].fb = ((car_x == sc->F) ? opt_b_f : opt_b_t); + oo_set_type_0(opc, 1); + oo_check(sc, opc); return(true); } p = symbol_to_slot(sc, car_x); @@ -52212,8 +53634,10 @@ static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x) (!s7_is_boolean(slot_value(p)))) return(return_false(sc, car_x, __func__, __LINE__)); opc = alloc_opo(sc, car_x); - opc->v1.p = p; - opc->v7.fb = opt_b_s; + opc->v[1].p = p; + opc->v[0].fb = opt_b_s; + oo_set_type_1(opc, 2, 1, OO_P); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -52223,43 +53647,65 @@ static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x) static bool opt_b_i_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.b_i_f(integer(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].b_i_f(integer(slot_value(o->v[1].p)))); } static bool opt_b_i_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.b_i_f(o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].b_i_f(o1->v[0].fi(o1))); } static bool opt_b_d_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.b_d_f(real(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].b_d_f(real(slot_value(o->v[1].p)))); } static bool opt_b_d_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.b_d_f(o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].b_d_f(o1->v[0].fd(o1))); } static bool opt_b_p_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.b_p_f(slot_value(o->v1.p))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].b_p_f(slot_value(o->v[1].p))); } static bool opt_b_p_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.b_p_f(o1->v7.fp(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].b_p_f(o1->v[0].fp(o1))); +} + +static bool opt_b_7p_s(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].b_7p_f(o->sc, slot_value(o->v[1].p))); +} + +static bool opt_b_7p_f(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].b_7p_f(o->sc, o1->v[0].fp(o1))); } #if (!WITH_GMP) @@ -52267,8 +53713,9 @@ static bool opt_zero_mod(void *p) { opt_info *o = (opt_info *)p; s7_int x; - x = integer(slot_value(o->v1.p)); - return((x % o->v2.i) == 0); + x = integer(slot_value(o->v[1].p)); + oo_rcheck(o->sc, o, 3, 1); + return((x % o->v[2].i) == 0); } #endif @@ -52276,7 +53723,8 @@ static bool opt_zero_mod(void *p) static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg_type) { int32_t cur_index; - s7_b_p_t bpf; + s7_b_p_t bpf = NULL; + s7_b_7p_t bpf7 = NULL; opt_info *opc; opc = alloc_opo(sc, car_x); @@ -52288,11 +53736,13 @@ static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_poin bif = s7_b_i_function(s_func); if (bif) { - opc->v2.b_i_f = bif; + opc->v[2].b_i_f = bif; if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - opc->v7.fb = opt_b_i_s; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + opc->v[0].fb = opt_b_i_s; + oo_set_type_1(opc, 3, 1, OO_I); + oo_check(sc, opc); return(true); } if (int_optimize(sc, cdr(car_x))) @@ -52300,17 +53750,22 @@ static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_poin #if (!WITH_GMP) opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if ((o1->v7.fi == opt_i_ii_sc) && - (o1->v3.i_ii_f == modulo_i_ii_direct)) + if ((o1->v[0].fi == opt_i_ii_sc) && + (o1->v[3].i_ii_f == modulo_i_ii_direct)) { - opc->v7.fb = opt_zero_mod; - opc->v1.p = o1->v1.p; - opc->v2.i = o1->v2.i; + opc->v[0].fb = opt_zero_mod; + opc->v[1].p = o1->v[1].p; + opc->v[2].i = o1->v[2].i; + oo_set_type_1(opc, 3, 1, OO_I); backup_pc(sc); } else #endif - opc->v7.fb = opt_b_i_f; + { + opc->v[0].fb = opt_b_i_f; + oo_set_type_0(opc, 3); + } + oo_check(sc, opc); return(true); } } @@ -52323,16 +53778,20 @@ static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_poin bdf = s7_b_d_function(s_func); if (bdf) { - opc->v2.b_d_f = bdf; + opc->v[2].b_d_f = bdf; if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - opc->v7.fb = opt_b_d_s; + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + opc->v[0].fb = opt_b_d_s; + oo_set_type_1(opc, 3, 1, OO_D); + oo_check(sc, opc); return(true); } if (float_optimize(sc, cdr(car_x))) { - opc->v7.fb = opt_b_d_f; + opc->v[0].fb = opt_b_d_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -52341,9 +53800,12 @@ static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_poin pc_fallback(sc, cur_index); bpf = s7_b_p_function(s_func); - if (bpf) + if (!bpf) bpf7 = s7_b_7p_function(s_func); + if ((bpf) || (bpf7)) { - opc->v2.b_p_f = bpf; + if (bpf) + opc->v[2].b_p_f = bpf; + else opc->v[2].b_7p_f = bpf7; if (is_symbol(cadr(car_x))) { s7_pointer p; @@ -52351,23 +53813,35 @@ static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_poin if ((!is_slot(p)) || (has_methods(slot_value(p)))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.p = p; - opc->v7.fb = opt_b_p_s; + opc->v[1].p = p; + opc->v[0].fb = (bpf) ? opt_b_p_s : opt_b_7p_s; if (s7_is_character(slot_value(p))) { bpf = s7_b_p_direct_function(s_func); - if (bpf) opc->v2.b_p_f = bpf; + if (bpf) + { + opc->v[2].b_p_f = bpf; + opc->v[0].fb = opt_b_p_s; + } } + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cdr(car_x))) { - opc->v7.fb = opt_b_p_f; + opc->v[0].fb = (bpf) ? opt_b_p_f : opt_b_7p_f; if (arg_type == sc->is_char_symbol) { bpf = s7_b_p_direct_function(s_func); - if (bpf) opc->v2.b_p_f = bpf; + if (bpf) + { + opc->v[2].b_p_f = bpf; + opc->v[0].fb = opt_b_p_f; + } } + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -52441,9 +53915,9 @@ static s7_pointer opt_arg_type(s7_scheme *sc, s7_pointer argp) if ((!is_slot(slot)) || (has_methods(slot_value(slot)))) return(sc->T); - return(s7_type_of(slot_value(slot))); + return(s7_type_of(sc, slot_value(slot))); } - return(s7_type_of(arg)); + return(s7_type_of(sc, arg)); } static bool opt_b_pp_ff(void *p) @@ -52451,60 +53925,119 @@ static bool opt_b_pp_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer p1; - o1 = cur_sc->opts[++cur_sc->pc]; - p1 = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_pp_f(p1, o1->v7.fp(o1))); + o1 = o->sc->opts[++o->sc->pc]; + p1 = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_pp_f(p1, o1->v[0].fp(o1))); } static bool opt_b_pp_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_pp_f(slot_value(o->v1.p), o1->v7.fp(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_pp_f(slot_value(o->v[1].p), o1->v[0].fp(o1))); } static bool opt_b_pp_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_pp_f(o1->v7.fp(o1), slot_value(o->v1.p))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_pp_f(o1->v[0].fp(o1), slot_value(o->v[1].p))); } static bool opt_b_pp_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_pp_f(slot_value(o->v1.p), slot_value(o->v2.p))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].b_pp_f(slot_value(o->v[1].p), slot_value(o->v[2].p))); } static bool opt_b_pp_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_pp_f(slot_value(o->v1.p), o->v2.p)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_pp_f(slot_value(o->v[1].p), o->v[2].p)); } static bool opt_b_pp_sfo(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_pp_f(slot_value(o->v1.p), o->v4.p_p_f(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 5, 2); + return(o->v[3].b_pp_f(slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p)))); +} + +static bool opt_b_7pp_ff(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + s7_pointer p1; + o1 = o->sc->opts[++o->sc->pc]; + p1 = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_7pp_f(o->sc, p1, o1->v[0].fp(o1))); +} + +static bool opt_b_7pp_sf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o1->v[0].fp(o1))); +} + +static bool opt_b_7pp_fs(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_7pp_f(o->sc, o1->v[0].fp(o1), slot_value(o->v[1].p))); +} + +static bool opt_b_7pp_ss(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p))); +} + +static bool opt_b_7pp_sc(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o->v[2].p)); +} + +static bool opt_b_7pp_sfo(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 5, 2); + return(o->v[3].b_7pp_f(o->sc, slot_value(o->v[1].p), o->v[4].p_p_f(o->sc, slot_value(o->v[2].p)))); } static s7_pointer opt_p_p_s(void *p); -static bool b_pp_sf_combinable(s7_scheme *sc, opt_info *opc) +static bool b_pp_sf_combinable(s7_scheme *sc, opt_info *opc, bool bpf_case) { if ((sc->pc > 1) && (opc == sc->opts[sc->pc - 2])) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fp == opt_p_p_s) + if (o1->v[0].fp == opt_p_p_s) { - opc->v2.p = o1->v1.p; - opc->v4.p_p_f = o1->v2.p_p_f; - opc->v7.fb = opt_b_pp_sfo; + opc->v[2].p = o1->v[1].p; + opc->v[4].p_p_f = o1->v[2].p_p_f; + opc->v[0].fb = (bpf_case) ? opt_b_pp_sfo : opt_b_7pp_sfo; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_P); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -52516,11 +54049,21 @@ static bool opt_b_pp_ffo(void *p) { opt_info *o = (opt_info *)p; s7_pointer b1; - b1 = o->v4.p_p_f(slot_value(o->v1.p)); - return(o->v3.b_pp_f(b1, o->v5.p_p_f(slot_value(o->v2.p)))); + b1 = o->v[4].p_p_f(o->sc, slot_value(o->v[1].p)); + oo_rcheck(o->sc, o, 6, 2); + return(o->v[3].b_pp_f(b1, o->v[5].p_p_f(o->sc, slot_value(o->v[2].p)))); } -static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc) +static bool opt_b_7pp_ffo(void *p) +{ + opt_info *o = (opt_info *)p; + s7_pointer b1; + b1 = o->v[4].p_p_f(o->sc, slot_value(o->v[1].p)); + oo_rcheck(o->sc, o, 6, 2); + return(o->v[3].b_7pp_f(o->sc, b1, o->v[5].p_p_f(o->sc, slot_value(o->v[2].p)))); +} + +static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc, bool bpf_case) { if ((sc->pc > 2) && (opc == sc->opts[sc->pc - 3])) @@ -52528,14 +54071,16 @@ static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc) opt_info *o1, *o2; o1 = sc->opts[sc->pc - 2]; o2 = sc->opts[sc->pc - 1]; - if ((o1->v7.fp == opt_p_p_s) && - (o2->v7.fp == opt_p_p_s)) - { - opc->v1.p = o1->v1.p; - opc->v4.p_p_f = o1->v2.p_p_f; - opc->v2.p = o2->v1.p; - opc->v5.p_p_f = o2->v2.p_p_f; - opc->v7.fb = opt_b_pp_ffo; + if ((o1->v[0].fp == opt_p_p_s) && + (o2->v[0].fp == opt_p_p_s)) + { + opc->v[1].p = o1->v[1].p; + opc->v[4].p_p_f = o1->v[2].p_p_f; + opc->v[2].p = o2->v[1].p; + opc->v[5].p_p_f = o2->v[2].p_p_f; + opc->v[0].fb = (bpf_case) ? opt_b_pp_ffo : opt_b_7pp_ffo; + oo_set_type_2(opc, 6, 1, 2, OO_P, OO_P); + oo_check(sc, opc); sc->pc -= 2; return(true); } @@ -52543,46 +54088,54 @@ static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc) return(false); } -static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2) +static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2, bool bpf_case) { int32_t cur_index; cur_index = sc->pc; - + /* v[3] is set when we get here */ + /* fprintf(stderr, "b_pp_ok: %s\n", DISPLAY(car_x)); */ if ((is_symbol(arg1)) && (is_symbol(arg2))) { - opc->v1.p = symbol_to_slot(sc, arg1); - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p))) && - (is_slot(opc->v2.p)) && - (!has_methods(slot_value(opc->v2.p)))) + opc->v[1].p = symbol_to_slot(sc, arg1); + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p))) && + (is_slot(opc->v[2].p)) && + (!has_methods(slot_value(opc->v[2].p)))) { - opc->v7.fb = opt_b_pp_ss; + opc->v[0].fb = (bpf_case) ? opt_b_pp_ss : opt_b_7pp_ss; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } } if (is_symbol(arg1)) { - opc->v1.p = symbol_to_slot(sc, arg1); - if ((!is_slot(opc->v1.p)) || - (has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, arg1); + if ((!is_slot(opc->v[1].p)) || + (has_methods(slot_value(opc->v[1].p)))) return(return_false(sc, car_x, __func__, __LINE__)); if ((!is_symbol(arg2)) && (!is_pair(arg2))) { - opc->v2.p = arg2; - opc->v7.fb = opt_b_pp_sc; + opc->v[2].p = arg2; + opc->v[0].fb = (bpf_case) ? opt_b_pp_sc : opt_b_7pp_sc; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cddr(car_x))) { - if (!b_pp_sf_combinable(sc, opc)) - opc->v7.fb = opt_b_pp_sf; + if (!b_pp_sf_combinable(sc, opc, bpf_case)) + { + opc->v[0].fb = (bpf_case) ? opt_b_pp_sf : opt_b_7pp_sf; + oo_set_type_1(opc, 4, 1, OO_P); + } + oo_check(sc, opc); return(true); } - /* return(return_false(sc, car_x, __func__, __LINE__)); */ pc_fallback(sc, cur_index); } else @@ -52592,11 +54145,13 @@ static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (cell_optimize(sc, cdr(car_x))) { - opc->v1.p = symbol_to_slot(sc, arg2); - if ((!is_slot(opc->v1.p)) || - (has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, arg2); + if ((!is_slot(opc->v[1].p)) || + (has_methods(slot_value(opc->v[1].p)))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v7.fb = opt_b_pp_fs; + opc->v[0].fb = (bpf_case) ? opt_b_pp_fs : opt_b_7pp_fs; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } /* return(return_false(sc, car_x, __func__, __LINE__)); */ @@ -52606,8 +54161,9 @@ static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((cell_optimize(sc, cdr(car_x))) && (cell_optimize(sc, cddr(car_x)))) { - if (!b_pp_ff_combinable(sc, opc)) - opc->v7.fb = opt_b_pp_ff; + oo_set_type_0(opc, 4); + if (!b_pp_ff_combinable(sc, opc, bpf_case)) + opc->v[0].fb = (bpf_case) ? opt_b_pp_ff : opt_b_7pp_ff; if (s7_b_pp_direct_function(s_func)) { s7_pointer call_sig, arg1_type, arg2_type; @@ -52617,10 +54173,14 @@ static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((cadr(call_sig) == arg1_type) && /* not car(arg1_type) here: (string>? (string) (read-line)) */ (caddr(call_sig) == arg2_type)) { - opc->v3.b_pp_f = s7_b_pp_direct_function(s_func); + opc->v[0].fb = opt_b_pp_ff; + opc->v[3].b_pp_f = s7_b_pp_direct_function(s_func); + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } + oo_check(sc, opc); return(true); } return(false); @@ -52632,8 +54192,9 @@ static bool opt_b_pi_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.b_pi_f(o1->v7.fp(o1), integer(slot_value(o->v1.p)))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].b_pi_f(o->sc, o1->v[0].fp(o1), integer(slot_value(o->v[1].p)))); } static bool b_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg2) @@ -52642,11 +54203,13 @@ static bool b_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer bpif = s7_b_pi_function(s_func); if (bpif) { - opc->v1.p = symbol_to_slot(sc, arg2); /* slot checked in opt_arg_type */ + opc->v[1].p = symbol_to_slot(sc, arg2); /* slot checked in opt_arg_type */ if (cell_optimize(sc, cdr(car_x))) { - opc->v2.b_pi_f = bpif; - opc->v7.fb = opt_b_pi_fs; + opc->v[2].b_pi_f = bpif; + opc->v[0].fb = opt_b_pi_fs; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -52658,37 +54221,42 @@ static bool b_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static bool opt_b_dd_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_dd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), real(slot_value(o->v[2].p)))); } static bool opt_b_dd_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_dd_f(real(slot_value(o->v1.p)), o->v2.x)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), o->v[2].x)); } static bool opt_b_dd_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_dd_f(real(slot_value(o->v1.p)), o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_dd_f(real(slot_value(o->v[1].p)), o1->v[0].fd(o1))); } static bool opt_b_dd_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_dd_f(o1->v7.fd(o1), real(slot_value(o->v1.p)))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_dd_f(o1->v[0].fd(o1), real(slot_value(o->v[1].p)))); } static bool opt_b_dd_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_dd_f(o1->v7.fd(o1), o->v1.x)); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_dd_f(o1->v[0].fd(o1), o->v[1].x)); } static bool opt_b_dd_ff(void *p) @@ -52696,10 +54264,11 @@ static bool opt_b_dd_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_double x1; - o1 = cur_sc->opts[++cur_sc->pc]; - x1 = o1->v7.fd(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_dd_f(x1, o1->v7.fd(o1))); + o1 = o->sc->opts[++o->sc->pc]; + x1 = o1->v[0].fd(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_dd_f(x1, o1->v[0].fd(o1))); } static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2) @@ -52710,26 +54279,32 @@ static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer bif = s7_b_dd_function(s_func); if (bif) { - opc->v3.b_dd_f = bif; + opc->v[3].b_dd_f = bif; if (is_symbol(arg1)) { - opc->v1.p = symbol_to_slot(sc, arg1); + opc->v[1].p = symbol_to_slot(sc, arg1); if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - opc->v7.fb = opt_b_dd_ss; + opc->v[2].p = symbol_to_slot(sc, arg2); + opc->v[0].fb = opt_b_dd_ss; + oo_set_type_2(opc, 4, 1, 2, OO_D, OO_D); + oo_check(sc, opc); return(true); } if (is_real(arg2)) { - opc->v2.x = s7_number_to_real(cur_sc, arg2); - opc->v7.fb = opt_b_dd_sc; + opc->v[2].x = s7_number_to_real(sc, arg2); + opc->v[0].fb = opt_b_dd_sc; + oo_set_type_1(opc, 4, 1, OO_D); + oo_check(sc, opc); return(true); } if (float_optimize(sc, cddr(car_x))) { - opc->v7.fb = opt_b_dd_sf; + opc->v[0].fb = opt_b_dd_sf; + oo_set_type_1(opc, 4, 1, OO_D); + oo_check(sc, opc); return(true); } } @@ -52738,19 +54313,25 @@ static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_symbol(arg2)) { - opc->v1.p = symbol_to_slot(sc, arg2); - opc->v7.fb = opt_b_dd_fs; + opc->v[1].p = symbol_to_slot(sc, arg2); + opc->v[0].fb = opt_b_dd_fs; + oo_set_type_1(opc, 4, 1, OO_D); + oo_check(sc, opc); return(true); } if (is_real(arg2)) { - opc->v1.x = s7_number_to_real(cur_sc, arg2); - opc->v7.fb = opt_b_dd_fc; + opc->v[1].x = s7_number_to_real(sc, arg2); + opc->v[0].fb = opt_b_dd_fc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (float_optimize(sc, cddr(car_x))) { - opc->v7.fb = opt_b_dd_ff; + opc->v[0].fb = opt_b_dd_ff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -52764,13 +54345,15 @@ static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static bool opt_b_ii_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p)))); } static bool opt_b_ii_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), o->v2.i)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), o->v[2].i)); } static bool opt_b_ii_ff(void *p) @@ -52778,34 +54361,38 @@ static bool opt_b_ii_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_int i1; - o1 = cur_sc->opts[++cur_sc->pc]; - i1 = o1->v7.fi(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_ii_f(i1, o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_ii_f(i1, o1->v[0].fi(o1))); } static bool opt_b_ii_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_ii_f(o1->v7.fi(o1), integer(slot_value(o->v2.p)))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_ii_f(o1->v[0].fi(o1), integer(slot_value(o->v[2].p)))); } static bool opt_b_ii_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_ii_f(o1->v7.fi(o1), o->v2.i)); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].b_ii_f(o1->v[0].fi(o1), o->v[2].i)); } static bool opt_b_ii_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), o1->v7.fi(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].b_ii_f(integer(slot_value(o->v[1].p)), o1->v[0].fi(o1))); } static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2) @@ -52814,25 +54401,31 @@ static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer bif = s7_b_ii_function(s_func); if (bif) { - opc->v3.b_ii_f = bif; + opc->v[3].b_ii_f = bif; if (is_symbol(arg1)) { - opc->v1.p = symbol_to_slot(sc, arg1); + opc->v[1].p = symbol_to_slot(sc, arg1); if (is_symbol(arg2)) { - opc->v2.p = symbol_to_slot(sc, arg2); - opc->v7.fb = opt_b_ii_ss; + opc->v[2].p = symbol_to_slot(sc, arg2); + opc->v[0].fb = opt_b_ii_ss; + oo_set_type_2(opc, 4, 1, 2, OO_I, OO_I); + oo_check(sc, opc); return(true); } if (is_opt_int(arg2)) { - opc->v2.i = integer(arg2); - opc->v7.fb = opt_b_ii_sc; + opc->v[2].i = integer(arg2); + opc->v[0].fb = opt_b_ii_sc; + oo_set_type_1(opc, 4, 1, OO_I); + oo_check(sc, opc); return(true); } if (int_optimize(sc, cddr(car_x))) { - opc->v7.fb = opt_b_ii_sf; + opc->v[0].fb = opt_b_ii_sf; + oo_set_type_1(opc, 4, 1, OO_I); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -52841,8 +54434,10 @@ static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (int_optimize(sc, cdr(car_x))) { - opc->v2.p = symbol_to_slot(sc, arg2); - opc->v7.fb = opt_b_ii_fs; + opc->v[2].p = symbol_to_slot(sc, arg2); + opc->v[0].fb = opt_b_ii_fs; + oo_set_type_1(opc, 4, 2, OO_I); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -52850,8 +54445,10 @@ static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_opt_int(arg2)) && (int_optimize(sc, cdr(car_x)))) { - opc->v2.i = integer(arg2); - opc->v7.fb = opt_b_ii_fc; + opc->v[2].i = integer(arg2); + opc->v[0].fb = opt_b_ii_fc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } else @@ -52859,7 +54456,9 @@ static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((int_optimize(sc, cdr(car_x))) && (int_optimize(sc, cddr(car_x)))) { - opc->v7.fb = opt_b_ii_ff; + opc->v[0].fb = opt_b_ii_ff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -52872,27 +54471,29 @@ static bool opt_and_bb(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fb(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fb(o1)); } - cur_sc->pc = o->v1.i; + o->sc->pc = o->v[1].i; return(false); } static bool opt_and_bb1(void *p) { opt_info *o = (opt_info *)p; - if (o->v8.fb(o)) + oo_rcheck(o->sc, o, 8, 0); + if (o->v[7].fb(o)) { opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o1->v7.fb(o1)); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fb(o1)); } - cur_sc->pc = o->v4.i; + o->sc->pc = o->v[4].i; return(false); } @@ -52900,13 +54501,14 @@ static bool opt_and_any_b(void *p) { opt_info *o = (opt_info *)p; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 3, 0); + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (!o1->v7.fb(o1)) + o1 = o->sc->opts[++o->sc->pc]; + if (!o1->v[0].fb(o1)) { - cur_sc->pc = o->v2.i; + o->sc->pc = o->v[2].i; return(false); } } @@ -52917,41 +54519,44 @@ static bool opt_or_bb(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { - cur_sc->pc = o->v1.i; + o->sc->pc = o->v[1].i; return(true); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fb(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fb(o1)); } static bool opt_or_bb1(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - if (o->v8.fb(o)) + oo_rcheck(o->sc, o, 8, 0); + if (o->v[7].fb(o)) { - cur_sc->pc = o->v4.i; + o->sc->pc = o->v[4].i; return(true); } - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o1->v7.fb(o1)); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fb(o1)); } static bool opt_or_any_b(void *p) { opt_info *o = (opt_info *)p; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 3, 0); + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { - cur_sc->pc = o->v2.i; + o->sc->pc = o->v[2].i; return(true); } } @@ -52969,20 +54574,25 @@ static bool opt_b_or_and(s7_scheme *sc, s7_pointer car_x, int32_t len, int32_t i if ((bool_optimize_nw(sc, cdr(car_x))) && (bool_optimize_nw(sc, cddr(car_x)))) { - if ((o1->v7.fb == opt_b_dd_ss) || - (o1->v7.fb == opt_b_ii_ss) || - (o1->v7.fb == opt_b_pp_ss)) - { - opc->v4.i = sc->pc - 1; - opc->v8.fb = o1->v7.fb; - opc->v7.fb = (is_and) ? opt_and_bb1 : opt_or_bb1; - opc->v1.p = o1->v1.p; - opc->v2.p = o1->v2.p; - opc->v3.p = o1->v3.p; + if ((o1->v[0].fb == opt_b_dd_ss) || + (o1->v[0].fb == opt_b_ii_ss) || + (o1->v[0].fb == opt_b_pp_ss) || + (o1->v[0].fb == opt_b_7pp_ss)) + { + opc->v[4].i = sc->pc - 1; + opc->v[7].fb = o1->v[0].fb; + opc->v[0].fb = (is_and) ? opt_and_bb1 : opt_or_bb1; + opc->v[1].p = o1->v[1].p; + opc->v[2].p = o1->v[2].p; + opc->v[3].p = o1->v[3].p; + oo_set_type_2(opc, 8, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } - opc->v7.fb = (is_and) ? opt_and_bb : opt_or_bb; - opc->v1.i = sc->pc - 1; + opc->v[0].fb = (is_and) ? opt_and_bb : opt_or_bb; + opc->v[1].i = sc->pc - 1; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -52990,14 +54600,16 @@ static bool opt_b_or_and(s7_scheme *sc, s7_pointer car_x, int32_t len, int32_t i else { s7_pointer p; - opc->v1.i = (len - 1); + opc->v[1].i = (len - 1); for (p = cdr(car_x); is_pair(p); p = cdr(p)) if (!bool_optimize_nw(sc, p)) break; if (is_null(p)) { - opc->v7.fb = (is_and) ? opt_and_any_b : opt_or_any_b; - opc->v2.i = sc->pc - 1; + opc->v[0].fb = (is_and) ? opt_and_any_b : opt_or_any_b; + opc->v[2].i = sc->pc - 1; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -53010,8 +54622,8 @@ static bool opt_b_or(s7_scheme *sc, s7_pointer car_x, int32_t len) {return(opt_ /* ---------------------------------------- cell opts ---------------------------------------- */ -static s7_pointer opt_p_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.p);} -static s7_pointer opt_p_s(void *p) {opt_info *o = (opt_info *)p; return(slot_value(o->v1.p));} +static s7_pointer opt_p_c(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 0); return(o->v[1].p);} +static s7_pointer opt_p_s(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 0); return(slot_value(o->v[1].p));} static bool opt_cell_not_pair(s7_scheme *sc, s7_pointer car_x) { @@ -53020,8 +54632,10 @@ static bool opt_cell_not_pair(s7_scheme *sc, s7_pointer car_x) if (!is_symbol(car_x)) { opc = alloc_opo(sc, car_x); - opc->v1.p = car_x; - opc->v7.fp = opt_p_c; + opc->v[1].p = car_x; + opc->v[0].fp = opt_p_c; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } p = symbol_to_slot(sc, car_x); @@ -53030,21 +54644,23 @@ static bool opt_cell_not_pair(s7_scheme *sc, s7_pointer car_x) if (has_methods(slot_value(p))) return(return_false(sc, car_x, __func__, __LINE__)); opc = alloc_opo(sc, car_x); - opc->v1.p = p; - opc->v7.fp = opt_p_s; + opc->v[1].p = p; + opc->v[0].fp = opt_p_s; + oo_set_type_1(opc, 2, 1, OO_P); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); } /* -------- p -------- */ -#define is_opt_safe(P) ((optimize_op(P) >= OP_SAFE_C_S) && ((optimize_op(P) < OP_UNKNOWN) || (optimize_op(P) > OP_UNKNOWN_AA))) +#define is_opt_safe(P) ((optimize_op(P) >= OP_SAFE_C_S) && (!is_unknown_op(optimize_op(P)))) #define cf_call(Sc, Car_x, S_func, Num) \ (((is_optimized(Car_x)) && (is_opt_safe(Car_x))) ? c_call(Car_x) : c_function_call(c_function_chooser(S_func)(Sc, S_func, Num, Car_x, false))) -static s7_pointer opt_p_f(void *p) {opt_info *o = (opt_info *)p; return(o->v1.p_f());} -static s7_pointer opt_p_cf(void *p) {opt_info *o = (opt_info *)p; return(o->v1.cf(cur_sc, cur_sc->nil));} +static s7_pointer opt_p_f(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 0); return(o->v[1].p_f(o->sc));} +static s7_pointer opt_p_cf(void *p) {opt_info *o = (opt_info *)p; oo_rcheck(o->sc, o, 2, 0); return(o->v[1].cf(o->sc, o->sc->nil));} static bool p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) { @@ -53052,15 +54668,19 @@ static bool p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car func = s7_p_function(s_func); if (func) { - opc->v1.p_f = func; - opc->v7.fp = opt_p_f; + opc->v[1].p_f = func; + opc->v[0].fp = opt_p_f; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } if ((is_safe_procedure(s_func)) && (c_function_required_args(s_func) == 0)) { - opc->v1.cf = cf_call(sc, car_x, s_func, 0); - opc->v7.fp = opt_p_cf; + opc->v[1].cf = cf_call(sc, car_x, s_func, 0); + opc->v[0].fp = opt_p_cf; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } return(false); @@ -53070,27 +54690,59 @@ static bool p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car static s7_pointer opt_p_p_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.p_p_f(o->v1.p)); + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].p_p_f(o->sc, o->v[1].p)); +} + +static s7_pointer opt_p_i_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 0); + return(make_integer(o->sc, o->v[2].i_i_f(o->v[1].i))); +} + +static s7_pointer opt_p_7i_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 0); + return(make_integer(o->sc, o->v[2].i_7i_f(o->sc, o->v[1].i))); +} + +static s7_pointer opt_p_d_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 0); + return(make_real(o->sc, o->v[2].d_d_f(o->v[1].x))); +} + +static s7_pointer opt_p_7d_c(void *p) +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 3, 0); + return(make_real(o->sc, o->v[2].d_7d_f(o->sc, o->v[1].x))); } static s7_pointer opt_p_p_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.p_p_f(slot_value(o->v1.p))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].p_p_f(o->sc, slot_value(o->v[1].p))); } static s7_pointer opt_p_p_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.p_p_f(o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 3, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[2].p_p_f(o->sc, o1->v[0].fp(o1))); } static s7_pointer opt_p_p_f1(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.p_p_f(o->v3.p_p_f(slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[2].p_p_f(o->sc, o->v[3].p_p_f(o->sc, slot_value(o->v[1].p)))); } static bool p_p_f_combinable(s7_scheme *sc, opt_info *opc) @@ -53100,11 +54752,13 @@ static bool p_p_f_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fp == opt_p_p_s) + if (o1->v[0].fp == opt_p_p_s) { - opc->v3.p_p_f = o1->v2.p_p_f; - opc->v1.p = o1->v1.p; - opc->v7.fp = opt_p_p_f1; + opc->v[3].p_p_f = o1->v[2].p_p_f; + opc->v[1].p = o1->v[1].p; + opc->v[0].fp = opt_p_p_f1; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -53116,20 +54770,23 @@ static s7_pointer opt_p_cf_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v2.cf(cur_sc, set_plist_1(cur_sc, o1->v7.fp(o1)))); + oo_rcheck(o->sc, o, 3, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[2].cf(o->sc, set_plist_1(o->sc, o1->v[0].fp(o1)))); } static s7_pointer opt_p_cf_s(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.cf(cur_sc, set_plist_1(cur_sc, slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 3, 1); + return(o->v[2].cf(o->sc, set_plist_1(o->sc, slot_value(o->v[1].p)))); } static s7_pointer opt_p_cf_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v2.cf(cur_sc, set_plist_1(cur_sc, o->v1.p))); + oo_rcheck(o->sc, o, 3, 0); + return(o->v[2].cf(o->sc, set_plist_1(o->sc, o->v[1].p))); } static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -53137,34 +54794,90 @@ static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c s7_p_p_t ppf; int32_t start; start = sc->pc; + if (is_integer(cadr(car_x))) + { + s7_i_i_t iif; + s7_i_7i_t i7if; + opc->v[1].i = integer(cadr(car_x)); + iif = s7_i_i_function(s_func); + if (iif) + { + opc->v[2].i_i_f = iif; + opc->v[0].fp = opt_p_i_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); + return(true); + } + i7if = s7_i_7i_function(s_func); + if (i7if) + { + opc->v[2].i_7i_f = i7if; + opc->v[0].fp = opt_p_7i_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); + return(true); + } + } + if (is_float(cadr(car_x))) + { + s7_d_d_t ddf; + s7_d_7d_t d7df; + opc->v[1].x = real(cadr(car_x)); + ddf = s7_d_d_function(s_func); + if (ddf) + { + opc->v[2].d_d_f = ddf; + opc->v[0].fp = opt_p_d_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); + return(true); + } + d7df = s7_d_7d_function(s_func); + if (d7df) + { + opc->v[2].d_7d_f = d7df; + opc->v[0].fp = opt_p_7d_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); + return(true); + } + } ppf = s7_p_p_function(s_func); if (ppf) { - opc->v2.p_p_f = ppf; + opc->v[2].p_p_f = ppf; if ((ppf == symbol_to_string_p) && (is_optimized(car_x)) && (c_call(car_x) == g_symbol_to_string_uncopied)) - opc->v2.p_p_f = symbol_to_string_uncopied_p; + opc->v[2].p_p_f = symbol_to_string_uncopied_p; if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((!is_slot(opc->v1.p)) || - (has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((!is_slot(opc->v[1].p)) || + (has_methods(slot_value(opc->v[1].p)))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v7.fp = opt_p_p_s; + opc->v[0].fp = opt_p_p_s; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } if (!is_pair(cadr(car_x))) { - opc->v1.p = cadr(car_x); - opc->v7.fp = opt_p_p_c; + opc->v[1].p = cadr(car_x); + opc->v[0].fp = opt_p_p_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cdr(car_x))) { if (!p_p_f_combinable(sc, opc)) - opc->v7.fp = opt_p_p_f; + { + opc->v[0].fp = opt_p_p_f; + oo_set_type_0(opc, 3); + } + oo_check(sc, opc); return(true); } } @@ -53173,14 +54886,16 @@ static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c (c_function_required_args(s_func) <= 1) && (c_function_all_args(s_func) >= 1)) { - opc->v2.cf = cf_call(sc, car_x, s_func, 1); + opc->v[2].cf = cf_call(sc, car_x, s_func, 1); if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - opc->v7.fp = opt_p_cf_s; + opc->v[0].fp = opt_p_cf_s; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -53188,13 +54903,17 @@ static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c { if (!is_pair(cadr(car_x))) { - opc->v1.p = cadr(car_x); - opc->v7.fp = opt_p_cf_c; + opc->v[1].p = cadr(car_x); + opc->v[0].fp = opt_p_cf_c; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cdr(car_x))) { - opc->v7.fp = opt_p_cf_f; + opc->v[0].fp = opt_p_cf_f; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -53206,15 +54925,17 @@ static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c static s7_pointer opt_p_ii_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].p_ii_f(o->sc, integer(slot_value(o->v[1].p)), integer(slot_value(o->v[2].p)))); } static s7_pointer opt_p_ii_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ii_f(o1->v7.fi(o1), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ii_f(o->sc, o1->v[0].fi(o1), integer(slot_value(o->v[2].p)))); } static bool p_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart) @@ -53229,27 +54950,31 @@ static bool p_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_symbol(arg1)) && (is_symbol(arg2))) { - opc->v1.p = symbol_to_slot(sc, arg1); - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v1.p)) && - (is_opt_int(slot_value(opc->v1.p))) && - (is_slot(opc->v2.p)) && - (is_opt_int(slot_value(opc->v2.p)))) - { - opc->v3.p_ii_f = ifunc; - opc->v7.fp = opt_p_ii_ss; + opc->v[1].p = symbol_to_slot(sc, arg1); + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[1].p)) && + (is_opt_int(slot_value(opc->v[1].p))) && + (is_slot(opc->v[2].p)) && + (is_opt_int(slot_value(opc->v[2].p)))) + { + opc->v[3].p_ii_f = ifunc; + opc->v[0].fp = opt_p_ii_ss; + oo_set_type_2(opc, 4, 1, 2, OO_I, OO_I); + oo_check(sc, opc); return(true); } } if ((int_optimize(sc, cdr(car_x))) && (is_symbol(arg2))) { - opc->v2.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v2.p)) && - (is_opt_int(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[2].p)) && + (is_opt_int(slot_value(opc->v[2].p)))) { - opc->v3.p_ii_f = ifunc; - opc->v7.fp = opt_p_ii_fs; + opc->v[3].p_ii_f = ifunc; + opc->v[0].fp = opt_p_ii_fs; + oo_set_type_1(opc, 4, 2, OO_I); + oo_check(sc, opc); return(true); } } @@ -53262,13 +54987,15 @@ static bool p_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_pointer opt_p_dd_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_dd_f(real_to_double(cur_sc, slot_value(o->v1.p), "p_dd"), o->v2.x)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_dd_f(o->sc, real_to_double(o->sc, slot_value(o->v[1].p), "p_dd"), o->v[2].x)); } static s7_pointer opt_p_dd_cs(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_dd_f(o->v2.x, real_to_double(cur_sc, slot_value(o->v1.p), "p_dd"))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_dd_f(o->sc, o->v[2].x, real_to_double(o->sc, slot_value(o->v[1].p), "p_dd"))); } static bool p_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart) @@ -53283,26 +55010,30 @@ static bool p_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_symbol(arg1)) && (is_t_real(arg2))) { - opc->v2.x = real(arg2); - opc->v1.p = symbol_to_slot(sc, arg1); - if ((is_slot(opc->v1.p)) && - (is_opt_real(slot_value(opc->v1.p)))) + opc->v[2].x = real(arg2); + opc->v[1].p = symbol_to_slot(sc, arg1); + if ((is_slot(opc->v[1].p)) && + (is_opt_real(slot_value(opc->v[1].p)))) { - opc->v3.p_dd_f = ifunc; - opc->v7.fp = opt_p_dd_sc; + opc->v[3].p_dd_f = ifunc; + opc->v[0].fp = opt_p_dd_sc; + oo_set_type_1(opc, 4, 1, OO_R); + oo_check(sc, opc); return(true); } } if ((is_symbol(arg2)) && (is_t_real(arg1))) { - opc->v2.x = real(arg1); - opc->v1.p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v1.p)) && - (is_opt_real(slot_value(opc->v1.p)))) + opc->v[2].x = real(arg1); + opc->v[1].p = symbol_to_slot(sc, arg2); + if ((is_slot(opc->v[1].p)) && + (is_opt_real(slot_value(opc->v[1].p)))) { - opc->v3.p_dd_f = ifunc; - opc->v7.fp = opt_p_dd_cs; + opc->v[3].p_dd_f = ifunc; + opc->v[0].fp = opt_p_dd_cs; + oo_set_type_1(opc, 4, 1, OO_R); + oo_check(sc, opc); return(true); } } @@ -53315,29 +55046,33 @@ static bool p_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_pointer opt_p_pi_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)))); } static s7_pointer opt_p_pi_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pi_f(slot_value(o->v1.p), o->v2.i)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), o->v[2].i)); } static s7_pointer opt_p_pi_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pi_f(slot_value(o->v1.p), o1->v7.fi(o1))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pi_f(o->sc, slot_value(o->v[1].p), o1->v[0].fi(o1))); } static s7_pointer opt_p_pi_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pi_f(o1->v7.fp(o1), o->v2.i)); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pi_f(o->sc, o1->v[0].fp(o1), o->v[2].i)); } static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -53363,13 +55098,13 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (vector_rank(slot_value(slot1)) > 1)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v3.p_pi_f = func; - opc->v1.p = slot1; + opc->v[3].p_pi_f = func; + opc->v[1].p = slot1; if ((s7_p_pi_direct_function(s_func)) && (checker)) { - obj = slot_value(opc->v1.p); + obj = slot_value(opc->v[1].p); if ((is_string(obj)) || (is_pair(obj)) || (s7_is_vector(obj))) @@ -53378,7 +55113,7 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer ((s7_is_vector(obj)) && (checker == sc->is_vector_symbol)) || ((is_pair(obj)) && (checker == sc->is_pair_symbol)) || ((is_byte_vector(obj)) && (checker == sc->is_byte_vector_symbol))) - opc->v3.p_pi_f = s7_p_pi_direct_function(s_func); + opc->v[3].p_pi_f = s7_p_pi_direct_function(s_func); } } if (is_symbol(caddr(car_x))) @@ -53388,33 +55123,40 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(slot2)) && (is_opt_int(slot_value(slot2)))) { - opc->v7.fp = opt_p_pi_ss; - opc->v2.p = slot2; + opc->v[0].fp = opt_p_pi_ss; + opc->v[2].p = slot2; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); if ((obj) && (is_step_end(slot2))) switch (type(obj)) { case T_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pi_f = vector_ref_unchecked; + opc->v[3].p_pi_f = vector_ref_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_PV, OO_I); break; case T_INT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pi_f = int_vector_ref_unchecked_p; + opc->v[3].p_pi_f = int_vector_ref_unchecked_p; + oo_set_type_2(opc, 4, 1, 2, OO_IV, OO_I); break; case T_FLOAT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pi_f = float_vector_ref_unchecked_p; + opc->v[3].p_pi_f = float_vector_ref_unchecked_p; + oo_set_type_2(opc, 4, 1, 2, OO_FV, OO_I); break; case T_STRING: if (denominator(slot_value(slot2)) <= string_length(obj)) - opc->v3.p_pi_f = string_ref_unchecked; + opc->v[3].p_pi_f = string_ref_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_S, OO_I); break; case T_BYTE_VECTOR: if (denominator(slot_value(slot2)) <= string_length(obj)) - opc->v3.p_pi_f = byte_vector_ref_unchecked; + opc->v[3].p_pi_f = byte_vector_ref_unchecked; + oo_set_type_2(opc, 4, 1, 2, OO_BV, OO_I); break; } + oo_check(sc, opc); return(true); } } @@ -53422,13 +55164,17 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_integer(caddr(car_x))) { - opc->v2.i = integer(caddr(car_x)); - opc->v7.fp = opt_p_pi_sc; + opc->v[2].i = integer(caddr(car_x)); + opc->v[0].fp = opt_p_pi_sc; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } if (int_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_pi_sf; + opc->v[0].fp = opt_p_pi_sf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -53439,7 +55185,8 @@ static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer static s7_pointer opt_p_pi_fco(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pi_f(o->v4.p_p_f(slot_value(o->v1.p)), o->v2.i)); + oo_rcheck(o->sc, o, 5, 1); + return(o->v[3].p_pi_f(o->sc, o->v[4].p_p_f(o->sc, slot_value(o->v[1].p)), o->v[2].i)); } static bool p_pi_fc_combinable(s7_scheme *sc, opt_info *opc) @@ -53449,11 +55196,13 @@ static bool p_pi_fc_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fp == opt_p_p_s) + if (o1->v[0].fp == opt_p_p_s) { - opc->v4.p_p_f = o1->v2.p_p_f; - opc->v1.p = o1->v1.p; - opc->v7.fp = opt_p_pi_fco; + opc->v[4].p_p_f = o1->v[2].p_p_f; + opc->v[1].p = o1->v[1].p; + opc->v[0].fp = opt_p_pi_fco; + oo_set_type_1(opc, 5, 1, OO_P); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -53465,49 +55214,56 @@ static bool p_pi_fc_combinable(s7_scheme *sc, opt_info *opc) static s7_pointer opt_p_pp_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pp_f(slot_value(o->v1.p), slot_value(o->v2.p))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p))); } static s7_pointer opt_p_pp_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pp_f(slot_value(o->v1.p), o->v2.p)); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), o->v[2].p)); } static s7_pointer opt_p_pp_cs(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pp_f(o->v2.p, slot_value(o->v1.p))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_pp_f(o->sc, o->v[2].p, slot_value(o->v[1].p))); } static s7_pointer opt_p_pp_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pp_f(slot_value(o->v1.p), o1->v7.fp(o1))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].p_pp_f(o->sc, slot_value(o->v[1].p), o1->v[0].fp(o1))); } static s7_pointer opt_p_pp_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pp_f(o1->v7.fp(o1), slot_value(o->v1.p))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pp_f(o->sc, o1->v[0].fp(o1), slot_value(o->v[1].p))); } static s7_pointer opt_p_pp_fc(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pp_f(o1->v7.fp(o1), o->v2.p)); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pp_f(o->sc, o1->v[0].fp(o1), o->v[2].p)); } static s7_pointer opt_p_pp_cc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pp_f(o->v1.p, o->v2.p)); + oo_rcheck(o->sc, o, 4, 0); + return(o->v[3].p_pp_f(o->sc, o->v[1].p, o->v[2].p)); } static s7_pointer opt_p_pp_ff(void *p) @@ -53515,10 +55271,11 @@ static s7_pointer opt_p_pp_ff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer p1; - o1 = cur_sc->opts[++cur_sc->pc]; - p1 = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pp_f(p1, o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + p1 = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pp_f(o->sc, p1, o1->v[0].fp(o1))); } static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart) @@ -53536,6 +55293,7 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (is_symbol(cadr(sig)))) checker = cadr(sig); + opc->v[3].p_pp_f = func; if (is_symbol(cadr(car_x))) { slot = symbol_to_slot(sc, cadr(car_x)); @@ -53551,26 +55309,24 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer pc_fallback(sc, pstart); return(return_false(sc, car_x, __func__, __LINE__)); } - opc->v1.p = slot; - } - - opc->v3.p_pp_f = func; - if (is_symbol(cadr(car_x))) - { + opc->v[1].p = slot; + if ((s7_p_pp_direct_function(s_func)) && (checker)) { checker = s7_symbol_value(sc, checker); - if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(opc->v1.p))) == sc->T) - opc->v3.p_pp_f = s7_p_pp_direct_function(s_func); + if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(slot))) == sc->T) + opc->v[3].p_pp_f = s7_p_pp_direct_function(s_func); } if (is_symbol(caddr(car_x))) { - opc->v2.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v2.p)) && - (!has_methods(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[2].p)) && + (!has_methods(slot_value(opc->v[2].p)))) { - opc->v7.fp = opt_p_pp_ss; + opc->v[0].fp = opt_p_pp_ss; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, pstart); @@ -53579,13 +55335,17 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((!is_pair(caddr(car_x))) || (is_proper_quote(sc, caddr(car_x)))) { - opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); - opc->v7.fp = opt_p_pp_sc; + opc->v[2].p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); + opc->v[0].fp = opt_p_pp_sc; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_pp_sf; + opc->v[0].fp = opt_p_pp_sf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -53594,23 +55354,27 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((!is_pair(cadr(car_x))) || (is_proper_quote(sc, cadr(car_x)))) { - opc->v1.p = (!is_pair(cadr(car_x))) ? cadr(car_x) : cadadr(car_x); + opc->v[1].p = (!is_pair(cadr(car_x))) ? cadr(car_x) : cadadr(car_x); if ((!is_symbol(caddr(car_x))) && ((!is_pair(caddr(car_x))) || (is_proper_quote(sc, caddr(car_x))))) { - opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); - opc->v7.fp = opt_p_pp_cc; + opc->v[2].p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); + opc->v[0].fp = opt_p_pp_cc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (is_symbol(caddr(car_x))) { - opc->v2.p = opc->v1.p; - opc->v1.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[2].p = opc->v[1].p; + opc->v[1].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - opc->v7.fp = opt_p_pp_cs; + opc->v[0].fp = opt_p_pp_cs; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, pstart); @@ -53621,11 +55385,13 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { if (is_symbol(caddr(car_x))) { - opc->v1.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - opc->v7.fp = opt_p_pp_fs; + opc->v[0].fp = opt_p_pp_fs; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, pstart); @@ -53640,20 +55406,28 @@ static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer ifunc = s7_p_pi_function(s_func); if (ifunc) { - opc->v2.i = integer(caddr(car_x)); - opc->v3.p_pi_f = ifunc; + opc->v[2].i = integer(caddr(car_x)); + opc->v[3].p_pi_f = ifunc; if (!p_pi_fc_combinable(sc, opc)) - opc->v7.fp = opt_p_pi_fc; + { + opc->v[0].fp = opt_p_pi_fc; + oo_set_type_0(opc, 4); + } + oo_check(sc, opc); return(true); } } - opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); - opc->v7.fp = opt_p_pp_fc; + opc->v[2].p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x)); + opc->v[0].fp = opt_p_pp_fc; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_pp_ff; + opc->v[0].fp = opt_p_pp_ff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -53670,12 +55444,13 @@ static s7_pointer opt_p_cf_ff(void *p) opt_info *o1; int32_t tx; s7_pointer po2; - o1 = cur_sc->opts[++cur_sc->pc]; - tx = next_tx(cur_sc); - cur_sc->t_temps[tx] = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - po2 = o1->v7.fp(o1); - return(o->v3.cf(cur_sc, set_plist_2(cur_sc, cur_sc->t_temps[tx], po2))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + tx = next_tx(o->sc); + o->sc->t_temps[tx] = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + po2 = o1->v[0].fp(o1); + return(o->v[3].cf(o->sc, set_plist_2(o->sc, o->sc->t_temps[tx], po2))); } static s7_pointer opt_p_cf_fs(void *p) @@ -53683,9 +55458,10 @@ static s7_pointer opt_p_cf_fs(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer po1; - o1 = cur_sc->opts[++cur_sc->pc]; - po1 = o1->v7.fp(o1); - return(o->v3.cf(cur_sc, set_plist_2(cur_sc, po1, slot_value(o->v1.p)))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + po1 = o1->v[0].fp(o1); + return(o->v[3].cf(o->sc, set_plist_2(o->sc, po1, slot_value(o->v[1].p)))); } static s7_pointer opt_p_cf_sf(void *p) @@ -53693,21 +55469,24 @@ static s7_pointer opt_p_cf_sf(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer po1; - o1 = cur_sc->opts[++cur_sc->pc]; - po1 = o1->v7.fp(o1); - return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), po1))); + o1 = o->sc->opts[++o->sc->pc]; + po1 = o1->v[0].fp(o1); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].cf(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), po1))); } static s7_pointer opt_p_cf_sc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), o->v2.p))); + oo_rcheck(o->sc, o, 4, 1); + return(o->v[3].cf(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), o->v[2].p))); } static s7_pointer opt_p_cf_ss(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), slot_value(o->v2.p)))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].cf(o->sc, set_plist_2(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p)))); } static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t pstart) @@ -53719,20 +55498,22 @@ static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_point /* if optimized, we want to use the current c_call (to take advantage of fixups like substring_temp), * but those same fixups are incorrect for this context if op_safe_c_c related. */ - opc->v3.cf = cf_call(sc, car_x, s_func, 2); + opc->v[3].cf = cf_call(sc, car_x, s_func, 2); if (is_symbol(cadr(car_x))) { - opc->v1.p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { if (is_symbol(caddr(car_x))) { - opc->v2.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v2.p)) && - (!has_methods(slot_value(opc->v2.p)))) + opc->v[2].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[2].p)) && + (!has_methods(slot_value(opc->v[2].p)))) { - opc->v7.fp = opt_p_cf_ss; + opc->v[0].fp = opt_p_cf_ss; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } else @@ -53743,13 +55524,17 @@ static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_point } if (!is_pair(caddr(car_x))) { - opc->v2.p = caddr(car_x); - opc->v7.fp = opt_p_cf_sc; + opc->v[2].p = caddr(car_x); + opc->v[0].fp = opt_p_cf_sc; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_cf_sf; + opc->v[0].fp = opt_p_cf_sf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -53763,11 +55548,13 @@ static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_point { if (is_symbol(caddr(car_x))) { - opc->v1.p = symbol_to_slot(sc, caddr(car_x)); - if ((is_slot(opc->v1.p)) && - (!has_methods(slot_value(opc->v1.p)))) + opc->v[1].p = symbol_to_slot(sc, caddr(car_x)); + if ((is_slot(opc->v[1].p)) && + (!has_methods(slot_value(opc->v[1].p)))) { - opc->v7.fp = opt_p_cf_fs; + opc->v[0].fp = opt_p_cf_fs; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } else @@ -53778,7 +55565,9 @@ static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_point } if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_cf_ff; + opc->v[0].fp = opt_p_cf_ff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -53794,26 +55583,30 @@ static s7_pointer opt_p_pip_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 4, 2); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o1->v[0].fp(o1))); } static s7_pointer opt_p_pip_sss(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), slot_value(o->v3.p))); + oo_rcheck(o->sc, o, 5, 3); + return(o->v[4].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), slot_value(o->v[3].p))); } static s7_pointer opt_p_pip_ssc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v4.p)); + oo_rcheck(o->sc, o, 5, 2); + return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[4].p)); } static s7_pointer opt_p_pip_c(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v5.p_p_f(o->v4.p))); + oo_rcheck(o->sc, o, 6, 2); + return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[5].p_p_f(o->sc, o->v[4].p))); } static s7_pointer opt_p_pip_sff(void *p) @@ -53821,27 +55614,30 @@ static s7_pointer opt_p_pip_sff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_int i1; - o1 = cur_sc->opts[++cur_sc->pc]; - i1 = o1->v7.fi(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_pip_f(slot_value(o->v1.p), i1, o2->v7.fp(o2))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + i1 = o1->v[0].fi(o1); + o2 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), i1, o2->v[0].fp(o2))); } static s7_pointer opt_p_pip_sso(void *p) { opt_info *o = (opt_info *)p; - return(o->v5.p_pip_f(slot_value(o->v1.p), - integer(slot_value(o->v2.p)), - o->v6.p_pi_f(slot_value(o->v3.p), - integer(slot_value(o->v4.p))))); + oo_rcheck(o->sc, o, 7, 4); + return(o->v[5].p_pip_f(o->sc, slot_value(o->v[1].p), + integer(slot_value(o->v[2].p)), + o->v[6].p_pi_f(o->sc, slot_value(o->v[3].p), + integer(slot_value(o->v[4].p))))); } static s7_pointer opt_p_pip_ssf1(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[cur_sc->pc += 2]; - return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v4.p_p_f(o1->v7.fp(o1)))); + oo_rcheck(o->sc, o, 5, 2); + o1 = o->sc->opts[o->sc->pc += 2]; + return(o->v[3].p_pip_f(o->sc, slot_value(o->v[1].p), integer(slot_value(o->v[2].p)), o->v[4].p_p_f(o->sc, o1->v[0].fp(o1)))); } static bool p_pip_ssf_combinable(s7_scheme *sc, opt_info *opc, int32_t start) @@ -53851,31 +55647,40 @@ static bool p_pip_ssf_combinable(s7_scheme *sc, opt_info *opc, int32_t start) (opc == sc->opts[sc->pc - 2])) { o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fp == opt_p_pi_ss) - { - opc->v5.p_pip_f = opc->v3.p_pip_f; - opc->v6.p_pi_f = o1->v3.p_pi_f; - opc->v3.p = o1->v1.p; - opc->v4.p = o1->v2.p; - opc->v7.fp = opt_p_pip_sso; + if (o1->v[0].fp == opt_p_pi_ss) /* ref for set! as in (set! (var ind) ...) for example */ + { + int32_t ref_type, set_type; + ref_type = o1->typ.vt[0 + oo_type_offset] & 0xf; + set_type = opc->typ.vt[0 + oo_type_offset] & 0xf; + opc->v[5].p_pip_f = opc->v[3].p_pip_f; + opc->v[6].p_pi_f = o1->v[3].p_pi_f; + opc->v[3].p = o1->v[1].p; + opc->v[4].p = o1->v[2].p; + opc->v[0].fp = opt_p_pip_sso; + oo_set_type_4(opc, 7, 1, 2, 3, 4, set_type, OO_I, ref_type, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fp == opt_p_p_c) + if (o1->v[0].fp == opt_p_p_c) { - opc->v5.p_p_f = o1->v2.p_p_f; - opc->v4.p = o1->v1.p; + opc->v[5].p_p_f = o1->v[2].p_p_f; + opc->v[4].p = o1->v[1].p; backup_pc(sc); - opc->v7.fp = opt_p_pip_c; + opc->v[0].fp = opt_p_pip_c; + oo_set_type_2(opc, 6, 1, 2, OO_P, OO_I); + oo_check(sc, opc); return(true); } } o1 = sc->opts[start]; - if (o1->v7.fp == opt_p_p_f) + if (o1->v[0].fp == opt_p_p_f) { - opc->v4.p_p_f = o1->v2.p_p_f; - opc->v7.fp = opt_p_pip_ssf1; + opc->v[4].p_p_f = o1->v[2].p_p_f; + opc->v[0].fp = opt_p_pip_ssf1; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_I); + oo_check(sc, opc); return(true); } return(false); @@ -53904,16 +55709,16 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((s7_is_vector(slot_value(slot1))) && (vector_rank(slot_value(slot1)) > 1)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.p = slot1; + opc->v[1].p = slot1; - opc->v3.p_pip_f = func; + opc->v[3].p_pip_f = func; if ((s7_p_pip_direct_function(s_func)) && (checker)) { - obj = slot_value(opc->v1.p); + obj = slot_value(opc->v[1].p); if (((is_normal_vector(obj)) && (checker == sc->is_vector_symbol)) || /* watch out for (vector-set! float-vect i x) etc */ ((is_pair(obj)) && (checker == sc->is_pair_symbol))) - opc->v3.p_pip_f = s7_p_pip_direct_function(s_func); + opc->v[3].p_pip_f = s7_p_pip_direct_function(s_func); else { s7_pointer val_type; @@ -53924,7 +55729,7 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer ((is_float_vector(obj)) && (checker == sc->is_float_vector_symbol)) || ((is_int_vector(obj)) && (checker == sc->is_int_vector_symbol)) || ((is_byte_vector(obj)) && (checker == sc->is_byte_vector_symbol))) - opc->v3.p_pip_f = s7_p_pip_direct_function(s_func); + opc->v[3].p_pip_f = s7_p_pip_direct_function(s_func); } } } @@ -53938,34 +55743,50 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(slot2)) && (is_opt_int(slot_value(slot2)))) { - opc->v2.p = slot2; + int32_t op2 = OO_P; + opc->v[2].p = slot2; if ((obj) && (is_step_end(slot2))) switch (type(obj)) { case T_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pip_f = vector_set_unchecked; + { + opc->v[3].p_pip_f = vector_set_unchecked; + op2 = OO_PV; + } break; case T_INT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pip_f = int_vector_set_unchecked_p; + { + opc->v[3].p_pip_f = int_vector_set_unchecked_p; + op2 = OO_IV; + } break; case T_FLOAT_VECTOR: if (denominator(slot_value(slot2)) <= vector_length(obj)) - opc->v3.p_pip_f = float_vector_set_unchecked_p; + { + opc->v[3].p_pip_f = float_vector_set_unchecked_p; + op2 = OO_FV; + } break; case T_STRING: if (denominator(slot_value(slot2)) <= string_length(obj)) - opc->v3.p_pip_f = string_set_unchecked; + { + opc->v[3].p_pip_f = string_set_unchecked; + op2 = OO_S; + } break; case T_BYTE_VECTOR: if (denominator(slot_value(slot2)) <= string_length(obj)) - opc->v3.p_pip_f = byte_vector_set_unchecked; + { + opc->v[3].p_pip_f = byte_vector_set_unchecked; + op2 = OO_BV; + } break; } @@ -53976,9 +55797,11 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(val_slot)) && (!has_methods(val_slot))) { - opc->v4.p_pip_f = opc->v3.p_pip_f; - opc->v3.p = val_slot; - opc->v7.fp = opt_p_pip_sss; + opc->v[4].p_pip_f = opc->v[3].p_pip_f; + opc->v[3].p = val_slot; + opc->v[0].fp = opt_p_pip_sss; + oo_set_type_3(opc, 5, 1, 2, 3, op2, OO_I, OO_P); + oo_check(sc, opc); return(true); } } @@ -53988,16 +55811,23 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (is_proper_quote(sc, cadddr(car_x)))) { if (!is_pair(cadddr(car_x))) - opc->v4.p = cadddr(car_x); - else opc->v4.p = cadr(cadddr(car_x)); - opc->v7.fp = opt_p_pip_ssc; + opc->v[4].p = cadddr(car_x); + else opc->v[4].p = cadr(cadddr(car_x)); + opc->v[0].fp = opt_p_pip_ssc; + oo_set_type_2(opc, 5, 1, 2, op2, OO_I); + oo_check(sc, opc); return(true); } } if (cell_optimize(sc, cdddr(car_x))) { + oo_set_type_2(opc, 4, 1, 2, op2, OO_I); if (!p_pip_ssf_combinable(sc, opc, start)) - opc->v7.fp = opt_p_pip_ssf; + { + opc->v[0].fp = opt_p_pip_ssf; + oo_set_type_2(opc, 4, 1, 2, op2, OO_I); + } + oo_check(sc, opc); return(true); } } @@ -54007,7 +55837,9 @@ static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((int_optimize(sc, cddr(car_x))) && (cell_optimize(sc, cdddr(car_x)))) { - opc->v7.fp = opt_p_pip_sff; + opc->v[0].fp = opt_p_pip_sff; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -54020,8 +55852,9 @@ static s7_pointer opt_p_ppi_psf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ppi_f(o->v2.p, slot_value(o->v1.p), o1->v7.fi(o1))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ppi_f(o->sc, o->v[2].p, slot_value(o->v[1].p), o1->v[0].fi(o1))); } static bool p_ppi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -54032,7 +55865,7 @@ static bool p_ppi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer { int32_t start; start = sc->pc; - opc->v3.p_ppi_f = ifunc; + opc->v[3].p_ppi_f = ifunc; if ((s7_is_character(cadr(car_x))) && (is_symbol(caddr(car_x))) && (int_optimize(sc, cdddr(car_x)))) @@ -54042,9 +55875,11 @@ static bool p_ppi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(slot)) && (!has_methods(slot_value(slot)))) { - opc->v2.p = cadr(car_x); - opc->v1.p = slot; - opc->v7.fp = opt_p_ppi_psf; + opc->v[2].p = cadr(car_x); + opc->v[1].p = slot; + opc->v[0].fp = opt_p_ppi_psf; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -54058,22 +55893,25 @@ static s7_pointer opt_p_ppp_ssf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 4, 2); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o1->v[0].fp(o1))); } static s7_pointer opt_p_ppp_sfs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ppp_f(slot_value(o->v1.p), o1->v7.fp(o1), slot_value(o->v2.p))); + oo_rcheck(o->sc, o, 4, 2); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), o1->v[0].fp(o1), slot_value(o->v[2].p))); } static s7_pointer opt_p_ppp_scs(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_ppp_f(slot_value(o->v1.p), o->v4.p, slot_value(o->v2.p))); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), o->v[4].p, slot_value(o->v[2].p))); } static s7_pointer opt_p_ppp_sff(void *p) @@ -54081,22 +55919,25 @@ static s7_pointer opt_p_ppp_sff(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_pointer po1; - o1 = cur_sc->opts[++cur_sc->pc]; - po1 = o1->v7.fp(o1); - o2 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ppp_f(slot_value(o->v1.p), po1, o2->v7.fp(o2))); + oo_rcheck(o->sc, o, 4, 1); + o1 = o->sc->opts[++o->sc->pc]; + po1 = o1->v[0].fp(o1); + o2 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), po1, o2->v[0].fp(o2))); } static s7_pointer opt_p_ppp_sss(void *p) { opt_info *o = (opt_info *)p; - return(o->v4.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), slot_value(o->v3.p))); + oo_rcheck(o->sc, o, 5, 3); + return(o->v[4].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p))); } static s7_pointer opt_p_ppp_ssc(void *p) { opt_info *o = (opt_info *)p; - return(o->v3.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), o->v4.p)); + oo_rcheck(o->sc, o, 4, 2); + return(o->v[3].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), o->v[4].p)); } static s7_pointer opt_p_ppp_fff(void *p) @@ -54104,12 +55945,13 @@ static s7_pointer opt_p_ppp_fff(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer po1, po2; - o1 = cur_sc->opts[++cur_sc->pc]; - po1 = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - po2 = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o->v3.p_ppp_f(po1, po2, o1->v7.fp(o1))); + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + po1 = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + po2 = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(o->v[3].p_ppp_f(o->sc, po1, po2, o1->v[0].fp(o1))); } static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -54129,7 +55971,7 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer checker = cadr(sig); start = sc->pc; - opc->v3.p_ppp_f = func; + opc->v[3].p_ppp_f = func; arg1 = cadr(car_x); arg2 = caddr(car_x); arg3 = cadddr(car_x); @@ -54155,14 +55997,14 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (car(car_x) == sc->let_set_symbol))) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.p = slot; + opc->v[1].p = slot; if ((s7_p_ppp_direct_function(s_func)) && (checker)) { checker = s7_symbol_value(sc, checker); - if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(opc->v1.p))) == sc->T) - opc->v3.p_ppp_f = s7_p_ppp_direct_function(s_func); + if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(opc->v[1].p))) == sc->T) + opc->v[3].p_ppp_f = s7_p_ppp_direct_function(s_func); } if (is_symbol(arg2)) { @@ -54170,16 +56012,18 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(slot)) && (!has_methods(slot_value(slot)))) { - opc->v2.p = slot; + opc->v[2].p = slot; if (is_symbol(arg3)) { slot = symbol_to_slot(sc, arg3); if ((is_slot(slot)) && (!has_methods(slot_value(slot)))) { - opc->v4.p_ppp_f = opc->v3.p_ppp_f; - opc->v3.p = slot; - opc->v7.fp = opt_p_ppp_sss; + opc->v[4].p_ppp_f = opc->v[3].p_ppp_f; + opc->v[3].p = slot; + opc->v[0].fp = opt_p_ppp_sss; + oo_set_type_3(opc, 5, 1, 2, 3, OO_P, OO_P, OO_P); + oo_check(sc, opc); return(true); } } @@ -54190,15 +56034,19 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (is_pair(cdr(arg3))))) /* (quote) as arg3 */ { if (!is_pair(arg3)) - opc->v4.p = arg3; - else opc->v4.p = cadr(arg3); - opc->v7.fp = opt_p_ppp_ssc; + opc->v[4].p = arg3; + else opc->v[4].p = cadr(arg3); + opc->v[0].fp = opt_p_ppp_ssc; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } } if (cell_optimize(sc, cdddr(car_x))) { - opc->v7.fp = opt_p_ppp_ssf; + opc->v[0].fp = opt_p_ppp_ssf; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -54212,13 +56060,15 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(val_slot)) && (!has_methods(val_slot))) { - opc->v4.p = cadr(arg2); - opc->v2.p = val_slot; - opc->v7.fp = opt_p_ppp_scs; - if ((opc->v3.p_ppp_f == let_set_p_ppp) && + opc->v[4].p = cadr(arg2); + opc->v[2].p = val_slot; + opc->v[0].fp = opt_p_ppp_scs; + if ((opc->v[3].p_ppp_f == let_set_p_ppp) && (is_let(slot_value(slot))) && /* checked has_methods and is_immutable above */ (is_symbol(cadr(arg2)))) - opc->v3.p_ppp_f = let_set_p_ppp_1; + opc->v[3].p_ppp_f = let_set_p_ppp_1; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } } @@ -54231,14 +56081,18 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer if ((is_slot(val_slot)) && (!has_methods(val_slot))) { - opc->v2.p = val_slot; - opc->v7.fp = opt_p_ppp_sfs; + opc->v[2].p = val_slot; + opc->v[0].fp = opt_p_ppp_sfs; + oo_set_type_2(opc, 4, 1, 2, OO_P, OO_P); + oo_check(sc, opc); return(true); } } if (cell_optimize(sc, cdddr(car_x))) { - opc->v7.fp = opt_p_ppp_sff; + opc->v[0].fp = opt_p_ppp_sff; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } } @@ -54249,7 +56103,9 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer (cell_optimize(sc, cddr(car_x))) && (cell_optimize(sc, cdddr(car_x)))) { - opc->v7.fp = opt_p_ppp_fff; + opc->v[0].fp = opt_p_ppp_fff; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -54265,16 +56121,16 @@ static s7_pointer opt_p_cf_ppp(void *p) opt_info *o1; int32_t tx1, tx2; s7_pointer po3; - o1 = cur_sc->opts[++cur_sc->pc]; - - tx1 = next_tx(cur_sc); - cur_sc->t_temps[tx1] = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - tx2 = next_tx(cur_sc); - cur_sc->t_temps[tx2] = o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - po3 = o1->v7.fp(o1); - return(o->v2.cf(cur_sc, set_plist_3(cur_sc, cur_sc->t_temps[tx1], cur_sc->t_temps[tx2], po3))); + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 3, 0); + tx1 = next_tx(o->sc); + o->sc->t_temps[tx1] = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + tx2 = next_tx(o->sc); + o->sc->t_temps[tx2] = o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + po3 = o1->v[0].fp(o1); + return(o->v[2].cf(o->sc, set_plist_3(o->sc, o->sc->t_temps[tx1], o->sc->t_temps[tx2], po3))); } static bool p_cf_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x) @@ -54288,8 +56144,10 @@ static bool p_cf_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_poin (cell_optimize(sc, cddr(car_x))) && (cell_optimize(sc, cdddr(car_x)))) { - opc->v2.cf = cf_call(sc, car_x, s_func, 3); - opc->v7.fp = opt_p_cf_ppp; + opc->v[2].cf = cf_call(sc, car_x, s_func, 3); + opc->v[0].fp = opt_p_cf_ppp; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } pc_fallback(sc, start); @@ -54303,17 +56161,18 @@ static s7_pointer opt_p_cf_any(void *p) opt_info *o = (opt_info *)p; s7_pointer arg; int32_t i, tx; - tx = next_tx(cur_sc); - cur_sc->t_temps[tx] = safe_list_if_possible(cur_sc, o->v1.i); - for (i = 0, arg = cur_sc->t_temps[tx]; i < o->v1.i; i++, arg = cdr(arg)) + tx = next_tx(o->sc); + oo_rcheck(o->sc, o, 3, 0); + o->sc->t_temps[tx] = safe_list_if_possible(o->sc, o->v[1].i); + for (i = 0, arg = o->sc->t_temps[tx]; i < o->v[1].i; i++, arg = cdr(arg)) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - car(arg) = o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + car(arg) = o1->v[0].fp(o1); } - arg = o->v2.cf(cur_sc, cur_sc->t_temps[tx]); - clear_list_in_use(cur_sc->t_temps[tx]); - cur_sc->current_safe_list = 0; + arg = o->v[2].cf(o->sc, o->sc->t_temps[tx]); + clear_list_in_use(o->sc->t_temps[tx]); + o->sc->current_safe_list = 0; return(arg); } @@ -54324,45 +56183,22 @@ static bool p_cf_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_poin (c_function_all_args(s_func) >= (len - 1))) { s7_pointer p; - opc->v1.i = (len - 1); + opc->v[1].i = (len - 1); for (p = cdr(car_x); is_pair(p); p = cdr(p)) if (!cell_optimize(sc, p)) break; if (is_null(p)) { - opc->v7.fp = opt_p_cf_any; - opc->v2.cf = cf_call(sc, car_x, s_func, len - 1); + opc->v[0].fp = opt_p_cf_any; + opc->v[2].cf = cf_call(sc, car_x, s_func, len - 1); + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } return(false); } -/* -------- cell_all_x -------- */ - -static s7_pointer opt_unwrap_cell(void *p) -{ - opt_info *o = (opt_info *)p; - return(o->v2.all_f(cur_sc, car(o->v1.p))); -} - -static bool cell_all_x_ok(s7_scheme *sc, s7_pointer expr, int32_t start) -{ - s7_function opt; - opt = all_x_optimize(sc, expr); - if (opt) - { - opt_info *opc; - pc_fallback(sc, start + 1); - opc = sc->opts[start]; - opc->v2.all_f = opt; - opc->v7.fp = opt_unwrap_cell; - opc->v1.p = expr; - return(true); - } - return(false); -} - /* -------- p_implicit -------- */ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -54379,15 +56215,16 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) { opt_info *opc; opc = alloc_opo(sc, car_x); - opc->v1.p = s_slot; + opc->v[1].p = s_slot; if (len == 2) { + int32_t op2 = OO_P; switch (type(obj)) { - case T_PAIR: opc->v3.p_pi_f = list_ref_p_pi_direct; break; - case T_HASH_TABLE: opc->v3.p_pp_f = hash_table_ref_p_pp_direct; break; - case T_LET: opc->v3.p_pp_f = let_ref_p_pp; break; - case T_STRING: opc->v3.p_pi_f = string_ref_p_pi_direct; break; + case T_PAIR: opc->v[3].p_pi_f = list_ref_p_pi_direct; op2 = OO_L; break; + case T_HASH_TABLE: opc->v[3].p_pp_f = hash_table_ref_p_pp_direct; op2 = OO_H; break; + case T_LET: opc->v[3].p_pp_f = let_ref_p_pp; op2 = OO_E; break; + case T_STRING: opc->v[3].p_pi_f = string_ref_p_pi_direct; op2 = OO_S; break; case T_BYTE_VECTOR: return(return_false(sc, car_x, __func__, __LINE__)); @@ -54397,7 +56234,8 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) case T_FLOAT_VECTOR: if (vector_rank(obj) != 1) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v3.p_pi_f = vector_ref_p_pi_direct; + opc->v[3].p_pi_f = vector_ref_p_pi_direct; + op2 = OO_AV; break; case T_C_OBJECT: @@ -54414,29 +56252,52 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) slot = symbol_to_slot(sc, cadr(car_x)); if (is_slot(slot)) { - opc->v2.p = slot; + opc->v[2].p = slot; if ((!is_hash_table(obj)) && (!is_let(obj))) { if (is_opt_int(slot_value(slot))) { - opc->v7.fp = opt_p_pi_ss; - if ((is_string(obj)) && - (is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= string_length(obj))) - opc->v3.p_pi_f = (is_byte_vector(obj)) ? byte_vector_ref_unchecked : string_ref_unchecked; - else + opc->v[0].fp = opt_p_pi_ss; + if (is_step_end(opc->v[2].p)) { - if ((s7_is_vector(obj)) && - (is_step_end(opc->v2.p)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(obj))) - opc->v3.p_pi_f = vector_ref_unchecked; + switch (type(obj)) + { + case T_STRING: + if (denominator(slot_value(opc->v[2].p)) <= string_length(obj)) + { + opc->v[3].p_pi_f = string_ref_unchecked; + op2 = OO_S; + } + break; + case T_BYTE_VECTOR: + if (denominator(slot_value(opc->v[2].p)) <= byte_vector_length(obj)) + { + opc->v[3].p_pi_f = byte_vector_ref_unchecked; + op2 = OO_BV; + } + break; + + case T_VECTOR: + case T_FLOAT_VECTOR: + case T_INT_VECTOR: + if (denominator(slot_value(opc->v[2].p)) <= vector_length(obj)) + { + opc->v[3].p_pi_f = vector_ref_unchecked; /* p as return */ + op2 = OO_AV; + } + break; + } } + oo_set_type_2(opc, 4, 1, 2, op2, OO_I); + oo_check(sc, opc); return(true); } - else return(return_false(sc, car_x, __func__, __LINE__)); + else return(return_false(sc, car_x, __func__, __LINE__)); /* I think this reflects that a non-int index is an error for list-ref et al */ } - opc->v7.fp = opt_p_pp_ss; + opc->v[0].fp = opt_p_pp_ss; + oo_set_type_2(opc, 4, 1, 2, op2, OO_P); + oo_check(sc, opc); return(true); } } @@ -54447,20 +56308,26 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) { if (is_integer(cadr(car_x))) { - opc->v2.i = integer(cadr(car_x)); - opc->v7.fp = opt_p_pi_sc; + opc->v[2].i = integer(cadr(car_x)); + opc->v[0].fp = opt_p_pi_sc; + oo_set_type_1(opc, 4, 1, op2); + oo_check(sc, opc); return(true); } if (int_optimize(sc, cdr(car_x))) { - opc->v7.fp = opt_p_pi_sf; + opc->v[0].fp = opt_p_pi_sf; + oo_set_type_1(opc, 4, 1, op2); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); } if (cell_optimize(sc, cdr(car_x))) { - opc->v7.fp = opt_p_pp_sf; + opc->v[0].fp = opt_p_pp_sf; + oo_set_type_1(opc, 4, 1, op2); + oo_check(sc, opc); return(true); } } @@ -54470,23 +56337,25 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) if (len > 2) { s7_pointer p; - opc->v1.i = len; + opc->v[1].i = len; for (p = car_x; is_pair(p); p = cdr(p)) if (!cell_optimize(sc, p)) break; if (is_null(p)) { - opc->v7.fp = opt_p_cf_any; + opc->v[0].fp = opt_p_cf_any; switch (type(obj)) /* string can't happen here (no multidimensional strings) */ { - case T_PAIR: opc->v2.cf = g_list_ref; break; - case T_HASH_TABLE: opc->v2.cf = g_hash_table_ref; break; - /* case T_LET: opc->v2.cf = g_let_ref; break; */ /* this doesn't handle implicit indices via g_let_ref! apply_let */ - case T_VECTOR: opc->v2.cf = g_vector_ref; break; - case T_INT_VECTOR: opc->v2.cf = g_int_vector_ref; break; - case T_FLOAT_VECTOR: opc->v2.cf = g_float_vector_ref; break; + case T_PAIR: opc->v[2].cf = g_list_ref; break; + case T_HASH_TABLE: opc->v[2].cf = g_hash_table_ref; break; + /* case T_LET: opc->v[2].cf = g_let_ref; break; */ /* this doesn't handle implicit indices via g_let_ref! apply_let */ + case T_VECTOR: opc->v[2].cf = g_vector_ref; break; + case T_INT_VECTOR: opc->v[2].cf = g_int_vector_ref; break; + case T_FLOAT_VECTOR: opc->v[2].cf = g_float_vector_ref; break; default: return(return_false(sc, car_x, __func__, __LINE__)); } + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -54496,7 +56365,6 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len) return(return_false(sc, car_x, __func__, __LINE__)); } -/* -------- p_syntax -------- */ /* -------- cell_quote -------- */ static bool opt_cell_quote(s7_scheme *sc, s7_pointer car_x) { @@ -54504,8 +56372,10 @@ static bool opt_cell_quote(s7_scheme *sc, s7_pointer car_x) if (!is_null(cddr(car_x))) return(return_false(sc, car_x, __func__, __LINE__)); opc = alloc_opo(sc, car_x); - opc->v1.p = cadr(car_x); - opc->v7.fp = opt_p_c; + opc->v[1].p = cadr(car_x); + opc->v[0].fp = opt_p_c; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } @@ -54515,9 +56385,10 @@ static s7_pointer opt_set_p_p_f(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = o1->v7.fp(o1); - slot_set_value(o->v1.p, x); + oo_rcheck(o->sc, o, 2, 1); + o1 = o->sc->opts[++o->sc->pc]; + x = o1->v[0].fp(o1); + slot_set_value(o->v[1].p, x); return(x); } @@ -54525,10 +56396,11 @@ static s7_pointer opt_set_p_i_s(void *p) { opt_info *o = (opt_info *)p; s7_pointer val; - val = slot_value(o->v2.p); + oo_rcheck(o->sc, o, 3, 2); + val = slot_value(o->v[2].p); if (is_mutable(val)) - val = make_integer(cur_sc, integer(val)); - slot_set_value(o->v1.p, val); + val = make_integer(o->sc, integer(val)); + slot_set_value(o->v[1].p, val); return(val); } @@ -54537,9 +56409,10 @@ static s7_pointer opt_set_p_i_f(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = make_integer(cur_sc, o1->v7.fi(o1)); - slot_set_value(o->v1.p, x); + oo_rcheck(o->sc, o, 2, 1); + o1 = o->sc->opts[++o->sc->pc]; + x = make_integer(o->sc, o1->v[0].fi(o1)); + slot_set_value(o->v[1].p, x); return(x); } @@ -54547,10 +56420,11 @@ static s7_pointer opt_set_p_d_s(void *p) { opt_info *o = (opt_info *)p; s7_pointer val; - val = slot_value(o->v2.p); + oo_rcheck(o->sc, o, 3, 2); + val = slot_value(o->v[2].p); if (is_mutable(val)) - val = make_real(cur_sc, real(val)); - slot_set_value(o->v1.p, val); + val = make_real(o->sc, real(val)); + slot_set_value(o->v[1].p, val); return(val); } @@ -54559,25 +56433,30 @@ static s7_pointer opt_set_p_d_f(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer x; - o1 = cur_sc->opts[++cur_sc->pc]; - x = make_real(cur_sc, o1->v7.fd(o1)); - slot_set_value(o->v1.p, x); + oo_rcheck(o->sc, o, 2, 1); + o1 = o->sc->opts[++o->sc->pc]; + x = make_real(o->sc, o1->v[0].fd(o1)); + slot_set_value(o->v[1].p, x); return(x); } static s7_pointer opt_set_p_c(void *p) { opt_info *o = (opt_info *)p; - slot_set_value(o->v1.p, o->v2.p); - return(o->v2.p); + oo_rcheck(o->sc, o, 3, 1); + slot_set_value(o->v[1].p, o->v[2].p); + return(o->v[2].p); } static s7_pointer opt_set_p_i_fo(void *p) { opt_info *o = (opt_info *)p; s7_pointer x; - x = make_integer(cur_sc, o->v4.i_ii_f(integer(slot_value(o->v2.p)), integer(slot_value(o->v3.p)))); - slot_set_value(o->v1.p, x); + s7_int i; + oo_rcheck(o->sc, o, 4, 3); + i = o->v[4].i_ii_f(integer(slot_value(o->v[2].p)), integer(slot_value(o->v[3].p))); + x = make_integer(o->sc, i); + slot_set_value(o->v[1].p, x); return(x); } @@ -54586,9 +56465,10 @@ static s7_pointer opt_set_p_i_fo1(void *p) opt_info *o = (opt_info *)p; s7_pointer x; s7_int i; - i = o->v4.i_ii_f(integer(slot_value(o->v2.p)), o->v3.i); - x = make_integer(cur_sc, i); - slot_set_value(o->v1.p, x); + oo_rcheck(o->sc, o, 4, 2); + i = o->v[4].i_ii_f(integer(slot_value(o->v[2].p)), o->v[3].i); + x = make_integer(o->sc, i); + slot_set_value(o->v[1].p, x); return(x); } @@ -54599,21 +56479,25 @@ static bool set_p_i_f_combinable(s7_scheme *sc, opt_info *opc) { opt_info *o1; o1 = sc->opts[sc->pc - 1]; - if (o1->v7.fi == opt_i_ii_ss) - { - opc->v4.i_ii_f = o1->v3.i_ii_f; - opc->v2.p = o1->v1.p; - opc->v3.p = o1->v2.p; - opc->v7.fp = opt_set_p_i_fo; + if (o1->v[0].fi == opt_i_ii_ss) + { + opc->v[4].i_ii_f = o1->v[3].i_ii_f; + opc->v[2].p = o1->v[1].p; + opc->v[3].p = o1->v[2].p; + opc->v[0].fp = opt_set_p_i_fo; + oo_set_type_3(opc, 5, 1, 2, 3, OO_I, OO_I, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } - if (o1->v7.fi == opt_i_ii_sc) + if (o1->v[0].fi == opt_i_ii_sc) { - opc->v4.i_ii_f = o1->v3.i_ii_f; - opc->v2.p = o1->v1.p; - opc->v3.i = o1->v2.i; - opc->v7.fp = opt_set_p_i_fo1; + opc->v[4].i_ii_f = o1->v[3].i_ii_f; + opc->v[2].p = o1->v[1].p; + opc->v[3].i = o1->v[2].i; + opc->v[0].fp = opt_set_p_i_fo1; + oo_set_type_2(opc, 5, 1, 2, OO_I, OO_I); + oo_check(sc, opc); backup_pc(sc); return(true); } @@ -54650,8 +56534,8 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) /* type changes here can confuse the rest of the optimizer */ s7_pointer atype, stype; - opc->v1.p = settee; - stype = s7_type_of(slot_value(settee)); + opc->v[1].p = settee; + stype = s7_type_of(sc, slot_value(settee)); if (stype == sc->is_integer_symbol) { if (is_symbol(caddr(car_x))) @@ -54661,8 +56545,10 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((is_slot(val_slot)) && (is_opt_int(slot_value(val_slot)))) { - opc->v2.p = val_slot; - opc->v7.fp = opt_set_p_i_s; + opc->v[2].p = val_slot; + opc->v[0].fp = opt_set_p_i_s; + oo_set_type_2(opc, 3, 1, 2, OO_I, OO_I); + oo_check(sc, opc); return(true); } } @@ -54671,7 +56557,11 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if (int_optimize(sc, cddr(car_x))) { if (!set_p_i_f_combinable(sc, opc)) - opc->v7.fp = opt_set_p_i_f; + { + opc->v[0].fp = opt_set_p_i_f; + oo_set_type_1(opc, 3, 1, OO_P); + } + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -54681,8 +56571,10 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) { if (is_t_real(caddr(car_x))) { - opc->v2.p = caddr(car_x); - opc->v7.fp = opt_set_p_c; + opc->v[2].p = caddr(car_x); + opc->v[0].fp = opt_set_p_c; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } if (is_symbol(caddr(car_x))) @@ -54692,8 +56584,10 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((is_slot(val_slot)) && (is_t_real(slot_value(val_slot)))) { - opc->v2.p = val_slot; - opc->v7.fp = opt_set_p_d_s; + opc->v[2].p = val_slot; + opc->v[0].fp = opt_set_p_d_s; + oo_set_type_2(opc, 3, 1, 2, OO_D, OO_R); + oo_check(sc, opc); return(true); } } @@ -54701,7 +56595,9 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) { if (float_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_set_p_d_f; + opc->v[0].fp = opt_set_p_d_f; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -54714,7 +56610,9 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_set_p_p_f; + oo_set_type_1(opc, 3, 1, OO_P); + oo_check(sc, opc); + opc->v[0].fp = opt_set_p_p_f; return(true); } } @@ -54731,11 +56629,12 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if (is_slot(s_slot)) { s7_pointer obj; - opc->v1.p = s_slot; + opc->v[1].p = s_slot; obj = slot_value(s_slot); if ((!has_methods(obj)) && (is_mutable_sequence(obj))) { + int32_t op2 = OO_P; s7_pointer index; switch (type(obj)) { @@ -54744,7 +56643,10 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) s7_pointer val_type; val_type = opt_arg_type(sc, cddr(car_x)); if (val_type == sc->is_char_symbol) - opc->v3.p_pip_f = string_set_p_pip_direct; + { + opc->v[3].p_pip_f = string_set_p_pip_direct; + op2 = OO_S; + } else return(return_false(sc, car_x, __func__, __LINE__)); } break; @@ -54753,14 +56655,17 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) return(return_false(sc, car_x, __func__, __LINE__)); case T_VECTOR: - opc->v3.p_pip_f = vector_set_p_pip_direct; + op2 = OO_PV; + opc->v[3].p_pip_f = vector_set_p_pip_direct; break; case T_FLOAT_VECTOR: if (opt_float_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x))) { - opc->v8.fd = opc->v7.fd; - opc->v7.fp = d_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fd = opc->v[0].fd; + opc->v[0].fp = d_to_p; + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -54768,28 +56673,33 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) case T_INT_VECTOR: if (opt_int_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x))) { - opc->v8.fi = opc->v7.fi; - opc->v7.fp = i_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fi = opc->v[0].fi; + opc->v[0].fp = i_to_p; + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); case T_PAIR: - opc->v3.p_pip_f = list_set_p_pip_direct; /* mut if list_set_p_pip has check */ + op2 = OO_L; + opc->v[3].p_pip_f = list_set_p_pip_direct; break; case T_HASH_TABLE: - opc->v3.p_ppp_f = hash_table_set_p_ppp_direct; + op2 = OO_H; + opc->v[3].p_ppp_f = hash_table_set_p_ppp_direct; break; case T_LET: /* here we know the let is a covered mutable let */ + op2 = OO_E; if ((is_keyword(cadr(cadr(car_x)))) || ((is_pair(cadr(cadr(car_x)))) && (caadr(cadr(car_x)) == sc->quote_symbol) && (is_symbol(cadadr(cadr(car_x)))))) - opc->v3.p_ppp_f = let_set_p_ppp_1; - else opc->v3.p_ppp_f = let_set_p_ppp_2; + opc->v[3].p_ppp_f = let_set_p_ppp_1; + else opc->v[3].p_ppp_f = let_set_p_ppp_2; break; default: @@ -54805,20 +56715,39 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((is_slot(slot)) && (!has_methods(slot_value(slot)))) { - opc->v2.p = slot; + opc->v[2].p = slot; if ((is_opt_int(slot_value(slot))) && - (is_step_end(opc->v2.p))) + (is_step_end(opc->v[2].p))) { - if ((is_string(obj)) && - (denominator(slot_value(opc->v2.p)) <= string_length(obj))) - opc->v3.p_pip_f = (is_byte_vector(obj)) ? byte_vector_set_unchecked : string_set_unchecked; + if (is_string(obj)) + { + if (denominator(slot_value(opc->v[2].p)) <= string_length(obj)) + { + opc->v[3].p_pip_f = string_set_unchecked; + op2 = OO_S; + } + } else { - if (s7_is_vector(obj)) /* true for all 3 vectors */ + if (is_byte_vector(obj)) + { + if (denominator(slot_value(opc->v[2].p)) <= byte_vector_length(obj)) + { + opc->v[3].p_pip_f = byte_vector_set_unchecked; + op2 = OO_BV; + } + } + else { - if ((s7_is_vector(obj)) && - (denominator(slot_value(opc->v2.p)) <= vector_length(obj))) - opc->v3.p_pip_f = vector_set_unchecked; + if (s7_is_vector(obj)) /* true for all 3 vectors */ + { + if ((s7_is_vector(obj)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(obj))) + { + opc->v[3].p_pip_f = vector_set_unchecked; + op2 = OO_AV; + } + } } } } @@ -54833,15 +56762,19 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) (s7_is_vector(obj)) || (is_pair(obj))) { - opc->v4.p_pip_f = opc->v3.p_pip_f; - opc->v3.p = val_slot; - opc->v7.fp = opt_p_pip_sss; + opc->v[4].p_pip_f = opc->v[3].p_pip_f; + opc->v[3].p = val_slot; + opc->v[0].fp = opt_p_pip_sss; + oo_set_type_3(opc, 5, 1, 2, 3, op2, OO_I, OO_P); + oo_check(sc, opc); } else { - opc->v4.p_ppp_f = opc->v3.p_ppp_f; - opc->v3.p = val_slot; - opc->v7.fp = opt_p_ppp_sss; + opc->v[4].p_ppp_f = opc->v[3].p_ppp_f; + opc->v[3].p = val_slot; + opc->v[0].fp = opt_p_ppp_sss; + oo_set_type_3(opc, 5, 1, 2, 3, OO_P, OO_P, OO_P); + oo_check(sc, opc); } return(true); } @@ -54852,13 +56785,21 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) (is_proper_quote(sc, caddr(car_x)))) { if (!is_pair(caddr(car_x))) - opc->v4.p = caddr(car_x); - else opc->v4.p = cadr(caddr(car_x)); + opc->v[4].p = caddr(car_x); + else opc->v[4].p = cadr(caddr(car_x)); if ((is_string(obj)) || (s7_is_vector(obj)) || (is_pair(obj))) - opc->v7.fp = opt_p_pip_ssc; - else opc->v7.fp = opt_p_ppp_ssc; + { + opc->v[0].fp = opt_p_pip_ssc; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_I); + } + else + { + opc->v[0].fp = opt_p_ppp_ssc; + oo_set_type_2(opc, 5, 1, 2, OO_P, OO_P); + } + oo_check(sc, opc); return(true); } } @@ -54868,10 +56809,18 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) (s7_is_vector(obj)) || (is_pair(obj))) { + oo_set_type_2(opc, 5, 1, 2, op2, OO_I); if (!p_pip_ssf_combinable(sc, opc, start)) - opc->v7.fp = opt_p_pip_ssf; + { + opc->v[0].fp = opt_p_pip_ssf; + oo_set_type_2(opc, 5, 1, 2, op2, OO_I); + } + oo_check(sc, opc); + return(true); } - else opc->v7.fp = opt_p_ppp_ssf; + opc->v[0].fp = opt_p_ppp_ssf; + oo_set_type_2(opc, 5, 1, 2, op2, OO_P); + oo_check(sc, opc); return(true); } } @@ -54885,7 +56834,9 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((int_optimize(sc, cdadr(car_x))) && (cell_optimize(sc, cddr(car_x)))) { - opc->v7.fp = opt_p_pip_sff; + opc->v[0].fp = opt_p_pip_sff; + oo_set_type_1(opc, 4, 1, OO_P); + oo_check(sc, opc); return(true); } return(return_false(sc, car_x, __func__, __LINE__)); @@ -54898,9 +56849,11 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((is_slot(val_slot)) && (!has_methods(val_slot))) { - opc->v4.p = cadr(cadadr(car_x)); - opc->v2.p = val_slot; - opc->v7.fp = opt_p_ppp_scs; + opc->v[4].p = cadr(cadadr(car_x)); + opc->v[2].p = val_slot; + opc->v[0].fp = opt_p_ppp_scs; + oo_set_type_2(opc, 5, 1, 2, op2, OO_P); + oo_check(sc, opc); return(true); } } @@ -54913,14 +56866,18 @@ static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x) if ((is_slot(val_slot)) && (!has_methods(val_slot))) { - opc->v2.p = val_slot; - opc->v7.fp = opt_p_ppp_sfs; + opc->v[2].p = val_slot; + opc->v[0].fp = opt_p_ppp_sfs; + oo_set_type_2(opc, 4, 1, 2, op2, OO_P); + oo_check(sc, opc); return(true); } } if (cell_optimize(sc, cddr(car_x))) { - opc->v7.fp = opt_p_ppp_sff; + opc->v[0].fp = opt_p_ppp_sff; + oo_set_type_1(opc, 4, 1, op2); + oo_check(sc, opc); return(true); } } @@ -54938,23 +56895,26 @@ static s7_pointer opt_begin_p(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_int i, len; - len = o->v1.i - 1; + oo_rcheck(o->sc, o, 2, 0); + len = o->v[1].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static s7_pointer opt_begin_p_1(void *p) { + opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + oo_rcheck(o->sc, o, 0, 0); /* ?? */ + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static bool opt_cell_begin(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -54965,8 +56925,10 @@ static bool opt_cell_begin(s7_scheme *sc, s7_pointer car_x, int32_t len) for (p = cdr(car_x); is_pair(p); p = cdr(p)) if (!cell_optimize(sc, p)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.i = len - 1; - opc->v7.fp = (len == 3) ? opt_begin_p_1 : opt_begin_p; + opc->v[1].i = len - 1; + opc->v[0].fp = (len == 3) ? opt_begin_p_1 : opt_begin_p; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } @@ -54975,21 +56937,22 @@ static s7_pointer opt_when_p(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { int32_t i, len; - len = o->v1.i - 1; + len = o->v[1].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v3.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[3].i; + return(o->sc->unspecified); } static s7_pointer opt_unless_p(void *p) @@ -54997,20 +56960,21 @@ static s7_pointer opt_unless_p(void *p) opt_info *o = (opt_info *)p; opt_info *o1; int32_t i, len; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { - cur_sc->pc = o->v3.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[3].i; + return(o->sc->unspecified); } - len = o->v1.i - 1; + len = o->v[1].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static bool opt_cell_when(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -55023,9 +56987,11 @@ static bool opt_cell_when(s7_scheme *sc, s7_pointer car_x, int32_t len) for (p = cddr(car_x); is_pair(p); p = cdr(p)) if (!cell_optimize(sc, p)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v1.i = len - 2; - opc->v3.i = sc->pc - 1; - opc->v7.fp = ((car(car_x) == sc->when_symbol) ? opt_when_p : opt_unless_p); + opc->v[1].i = len - 2; + opc->v[3].i = sc->pc - 1; + opc->v[0].fp = ((car(car_x) == sc->when_symbol) ? opt_when_p : opt_unless_p); + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } @@ -55033,40 +56999,41 @@ static bool opt_cell_when(s7_scheme *sc, s7_pointer car_x, int32_t len) static s7_pointer opt_cond(void *p) { opt_info *o = (opt_info *)p; - o->v2.p = cur_sc->unspecified; - while (cur_sc->pc < o->v1.i) + oo_rcheck(o->sc, o, 3, 0); + o->v[2].p = o->sc->unspecified; + while (o->sc->pc < o->v[1].i) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - return(o->v2.p); + return(o->v[2].p); } static s7_pointer opt_cond_clause(void *p) { - /* top->p1 gets result, top->i1 is end index, o->v3.i is end of current clause, o->v1.i = body len */ + /* top->p1 gets result, top->i1 is end index, o->v[3].i is end of current clause, o->v[1].i = body len */ opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { opt_info *top; int32_t i, len; - top = (opt_info *)(o->v5.obj); - len = o->v1.i - 1; + top = (opt_info *)(o->v[5].obj); + len = o->v[1].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - top->v2.p = o1->v7.fp(o1); - cur_sc->pc = top->v1.i; - return(top->v2.p); + o1 = o->sc->opts[++o->sc->pc]; + top->v[2].p = o1->v[0].fp(o1); + o->sc->pc = top->v[1].i; + return(top->v[2].p); } - cur_sc->pc = o->v3.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[3].i; + return(o->sc->unspecified); } static s7_pointer opt_cond_2(void *p) @@ -55075,20 +57042,21 @@ static s7_pointer opt_cond_2(void *p) opt_info *o = (opt_info *)p; opt_info *o1, *o2; s7_pointer res; - cur_sc->pc += 2; - o2 = cur_sc->opts[cur_sc->pc]; /* this is the boolean expr of the first clause */ - if (!o2->v7.fb(o2)) - cur_sc->pc = o->v3.i; /* jump over first clause and #t */ - o1 = cur_sc->opts[++cur_sc->pc]; - res = o1->v7.fp(o1); - cur_sc->pc = o->v1.i; /* end of cond index */ + oo_rcheck(o->sc, o, 2, 0); + o->sc->pc += 2; + o2 = o->sc->opts[o->sc->pc]; /* this is the boolean expr of the first clause */ + if (!o2->v[0].fb(o2)) + o->sc->pc = o->v[3].i; /* jump over first clause and #t */ + o1 = o->sc->opts[++o->sc->pc]; + res = o1->v[0].fp(o1); + o->sc->pc = o->v[1].i; /* end of cond index */ return(res); } static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x) { - /* top->v2.p gets result, top->v1.i is end index, clause->v3.i is end of current clause, - * clause->v1.i = clause result len, clause->v5.obj = top + /* top->v[2].p gets result, top->v[1].i is end index, clause->v[3].i is end of current clause, + * clause->v[1].i = clause result len, clause->v[5].obj = top */ s7_pointer p, last_clause = NULL; opt_info *top; @@ -55108,12 +57076,14 @@ static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x) last_clause = clause; opc = alloc_opo(sc, car_x); + oo_set_type_0(opc, 6); if ((car(clause) == sc->else_symbol) || (car(clause) == sc->T)) { opt_info *opb; opb = alloc_opo(sc, clause); - opb->v7.fb = opt_b_t; + opb->v[0].fb = opt_b_t; + oo_set_type_0(opb, 1); } else { @@ -55125,14 +57095,14 @@ static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x) return(return_false(sc, cp, __func__, __LINE__)); if (!is_null(cp)) return(return_false(sc, cp, __func__, __LINE__)); - opc->v1.i = blen; + opc->v[1].i = blen; if (max_blen < blen) max_blen = blen; - opc->v3.i = sc->pc - 1; - opc->v5.obj = (void *)top; - opc->v7.fp = opt_cond_clause; + opc->v[3].i = sc->pc - 1; + opc->v[5].obj = (void *)top; + opc->v[0].fp = opt_cond_clause; } - top->v1.i = sc->pc - 1; - top->v7.fp = opt_cond; + top->v[1].i = sc->pc - 1; + top->v[0].fp = opt_cond; if (branches == 2) { if ((max_blen == 1) && @@ -55141,10 +57111,12 @@ static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x) { opt_info *o1; o1 = sc->opts[start_pc]; - top->v3.i = o1->v3.i + 2; - top->v7.fp = opt_cond_2; + top->v[3].i = o1->v[3].i + 2; + top->v[0].fp = opt_cond_2; } } + oo_set_type_0(top, 6); + oo_check(sc, top); return(true); } @@ -55153,14 +57125,15 @@ static s7_pointer opt_and_pp(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fp(o1) == cur_sc->F) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fp(o1) == o->sc->F) { - cur_sc->pc = o->v1.i; - return(cur_sc->F); + o->sc->pc = o->v[1].i; + return(o->sc->F); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static s7_pointer opt_and_any_p(void *p) @@ -55168,16 +57141,17 @@ static s7_pointer opt_and_any_p(void *p) opt_info *o = (opt_info *)p; int32_t i; s7_pointer val; - val = cur_sc->T; /* (and) -> #t */ - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 3, 0); + val = o->sc->T; /* (and) -> #t */ + for (i = 0; i < o->v[1].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - val = o1->v7.fp(o1); - if (val == cur_sc->F) + o1 = o->sc->opts[++o->sc->pc]; + val = o1->v[0].fp(o1); + if (val == o->sc->F) { - cur_sc->pc = o->v2.i; - return(cur_sc->F); + o->sc->pc = o->v[2].i; + return(o->sc->F); } } return(val); @@ -55188,34 +57162,36 @@ static s7_pointer opt_or_pp(void *p) opt_info *o = (opt_info *)p; opt_info *o1; s7_pointer val; - o1 = cur_sc->opts[++cur_sc->pc]; - val = o1->v7.fp(o1); - if (val != cur_sc->F) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + val = o1->v[0].fp(o1); + if (val != o->sc->F) { - cur_sc->pc = o->v1.i; + o->sc->pc = o->v[1].i; return(val); } - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static s7_pointer opt_or_any_p(void *p) { opt_info *o = (opt_info *)p; int32_t i; - for (i = 0; i < o->v1.i; i++) + oo_rcheck(o->sc, o, 3, 0); + for (i = 0; i < o->v[1].i; i++) { s7_pointer val; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - val = o1->v7.fp(o1); - if (val != cur_sc->F) + o1 = o->sc->opts[++o->sc->pc]; + val = o1->v[0].fp(o1); + if (val != o->sc->F) { - cur_sc->pc = o->v2.i; + o->sc->pc = o->v[2].i; return(val); } } - return(cur_sc->F); + return(o->sc->F); } static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -55226,7 +57202,7 @@ static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len) { opt_info *wrapper; int32_t start; - opc->v7.fp = ((car(car_x) == sc->or_symbol) ? opt_or_pp : opt_and_pp); + opc->v[0].fp = ((car(car_x) == sc->or_symbol) ? opt_or_pp : opt_and_pp); wrapper = sc->opts[sc->pc]; start = sc->pc; if (!cell_optimize(sc, cdr(car_x))) @@ -55234,20 +57210,23 @@ static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len) pc_fallback(sc, start); if (!bool_optimize_nw(sc, cdr(car_x))) return(return_false(sc, car_x, __func__, __LINE__)); - wrapper->v8.fb = wrapper->v7.fb; - wrapper->v7.fp = b_to_p; + if (oo_size(wrapper) < 8) oo_resize(wrapper, 8); + wrapper->v[7].fb = wrapper->v[0].fb; + wrapper->v[0].fp = b_to_p; } - wrapper = sc->opts[sc->pc]; start = sc->pc; if (!cell_optimize(sc, cddr(car_x))) { pc_fallback(sc, start); if (!bool_optimize_nw(sc, cddr(car_x))) return(return_false(sc, car_x, __func__, __LINE__)); - wrapper->v8.fb = wrapper->v7.fb; - wrapper->v7.fp = b_to_p; + if (oo_size(wrapper) < 8) oo_resize(wrapper, 8); + wrapper->v[7].fb = wrapper->v[0].fb; + wrapper->v[0].fp = b_to_p; } - opc->v1.i = sc->pc - 1; + opc->v[1].i = sc->pc - 1; + oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } else @@ -55255,8 +57234,8 @@ static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len) if (len > 0) { s7_pointer p; - opc->v1.i = (len - 1); - opc->v7.fp = ((car(car_x) == sc->or_symbol) ? opt_or_any_p : opt_and_any_p); + opc->v[1].i = (len - 1); + opc->v[0].fp = ((car(car_x) == sc->or_symbol) ? opt_or_any_p : opt_and_any_p); for (p = cdr(car_x); is_pair(p); p = cdr(p)) { opt_info *wrapper; @@ -55268,11 +57247,14 @@ static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int32_t len) pc_fallback(sc, start); if (!bool_optimize_nw(sc, p)) return(return_false(sc, car_x, __func__, __LINE__)); - wrapper->v8.fb = wrapper->v7.fb; - wrapper->v7.fp = b_to_p; + if (oo_size(wrapper) < 8) oo_resize(wrapper, 8); + wrapper->v[7].fb = wrapper->v[0].fb; + wrapper->v[0].fp = b_to_p; } } - opc->v2.i = sc->pc - 1; + opc->v[2].i = sc->pc - 1; + oo_set_type_0(opc, 3); + oo_check(sc, opc); return(true); } } @@ -55284,43 +57266,46 @@ static s7_pointer opt_if_bp(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_bp_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - if (o->v2.b_p_f(o1->v7.fp(o1))) + oo_rcheck(o->sc, o, 3, 0); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + if (o->v[2].b_p_f(o1->v[0].fp(o1))) { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (!o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 2, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (!o1->v[0].fb(o1)) { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } /* also b_ii_sf (mac) */ @@ -55328,105 +57313,143 @@ static s7_pointer opt_if_nbp_f(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - if (!(o->v2.b_p_f(o1->v7.fp(o1)))) + oo_rcheck(o->sc, o, 3, 0); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + if (!(o->v[2].b_p_f(o1->v[0].fp(o1)))) { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp_s(void *p) { opt_info *o = (opt_info *)p; - if (!(o->v2.b_p_f(slot_value(o->v3.p)))) + oo_rcheck(o->sc, o, 4, 1); + if (!(o->v[2].b_p_f(slot_value(o->v[3].p)))) { opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o1->v7.fp(o1)); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp_sc(void *p) /* b_pp_sc */ { opt_info *o = (opt_info *)p; - if (!(o->v3.b_pp_f(slot_value(o->v2.p), o->v4.p))) + oo_rcheck(o->sc, o, 4, 1); + if (!(o->v[3].b_pp_f(slot_value(o->v[2].p), o->v[4].p))) { opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o1->v7.fp(o1)); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); +} + +static s7_pointer opt_if_nbp_7sc(void *p) /* b_7pp_sc */ +{ + opt_info *o = (opt_info *)p; + oo_rcheck(o->sc, o, 4, 1); + if (!(o->v[3].b_7pp_f(o->sc, slot_value(o->v[2].p), o->v[4].p))) + { + opt_info *o1; + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fp(o1)); + } + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp_ss(void *p) /* b_ii_ss */ { opt_info *o = (opt_info *)p; - if (!(o->v3.b_ii_f(integer(slot_value(o->v2.p)), integer(slot_value(o->v4.p))))) + oo_rcheck(o->sc, o, 4, 2); + if (!(o->v[3].b_ii_f(integer(slot_value(o->v[2].p)), integer(slot_value(o->v[4].p))))) { opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - return(o1->v7.fp(o1)); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp_fs(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - if (!(o->v2.b_pi_f(o1->v7.fp(o1), integer(slot_value(o->v3.p))))) /* b_pi_fs */ + oo_rcheck(o->sc, o, 4, 1); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + if (!(o->v[2].b_pi_f(o->sc, o1->v[0].fp(o1), integer(slot_value(o->v[3].p))))) /* b_pi_fs */ { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_nbp_sf(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - cur_sc->pc += 2; - o1 = cur_sc->opts[cur_sc->pc]; - if (!(o->v2.b_pp_f(slot_value(o->v3.p), o1->v7.fp(o1)))) /* b_pp_sf */ + oo_rcheck(o->sc, o, 4, 1); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + if (!(o->v[2].b_pp_f(slot_value(o->v[3].p), o1->v[0].fp(o1)))) /* b_pp_sf */ + { + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); + } + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); +} + +static s7_pointer opt_if_nbp_7sf(void *p) +{ + opt_info *o = (opt_info *)p; + opt_info *o1; + oo_rcheck(o->sc, o, 4, 1); + o->sc->pc += 2; + o1 = o->sc->opts[o->sc->pc]; + if (!(o->v[2].b_7pp_f(o->sc, slot_value(o->v[3].p), o1->v[0].fp(o1)))) /* b_7pp_sf */ { - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } - cur_sc->pc = o->v1.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[1].i; + return(o->sc->unspecified); } static s7_pointer opt_if_bpp(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - if (o1->v7.fb(o1)) + oo_rcheck(o->sc, o, 4, 0); + o1 = o->sc->opts[++o->sc->pc]; + if (o1->v[0].fb(o1)) { s7_pointer val; - o1 = cur_sc->opts[++cur_sc->pc]; - val = o1->v7.fp(o1); - cur_sc->pc = o->v3.i; + o1 = o->sc->opts[++o->sc->pc]; + val = o1->v[0].fp(o1); + o->sc->pc = o->v[3].i; return(val); } - cur_sc->pc = o->v1.i; - o1 = cur_sc->opts[++cur_sc->pc]; - return(o1->v7.fp(o1)); + o->sc->pc = o->v[1].i; + o1 = o->sc->opts[++o->sc->pc]; + return(o1->v[0].fp(o1)); } static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -55445,45 +57468,71 @@ static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((bool_optimize(sc, cdadr(car_x))) && (cell_optimize(sc, cddr(car_x)))) { - opc->v7.fp = opt_if_nbp; - opc->v1.i = sc->pc - 1; - if (next->v7.fb == opt_b_p_f) + opc->v[0].fp = opt_if_nbp; + opc->v[1].i = sc->pc - 1; + oo_set_type_0(opc, 2); + if (next->v[0].fb == opt_b_p_f) { - opc->v2.b_p_f = next->v2.b_p_f; - opc->v7.fp = opt_if_nbp_f; + opc->v[2].b_p_f = next->v[2].b_p_f; + opc->v[0].fp = opt_if_nbp_f; + oo_set_type_0(opc, 3); } - if (next->v7.fb == opt_b_p_s) + if (next->v[0].fb == opt_b_p_s) { - opc->v2.b_p_f = next->v2.b_p_f; - opc->v3.p = next->v1.p; - opc->v7.fp = opt_if_nbp_s; + opc->v[2].b_p_f = next->v[2].b_p_f; + opc->v[3].p = next->v[1].p; + opc->v[0].fp = opt_if_nbp_s; + oo_set_type_1(opc, 4, 3, OO_P); } - if (next->v7.fb == opt_b_pi_fs) + if (next->v[0].fb == opt_b_pi_fs) { - opc->v2.b_pi_f = next->v2.b_pi_f; - opc->v3.p = next->v1.p; - opc->v7.fp = opt_if_nbp_fs; + opc->v[2].b_pi_f = next->v[2].b_pi_f; + opc->v[3].p = next->v[1].p; + opc->v[0].fp = opt_if_nbp_fs; + oo_set_type_1(opc, 4, 3, OO_P); } - if (next->v7.fb == opt_b_pp_sf) + if ((next->v[0].fb == opt_b_pp_sf) || + (next->v[0].fb == opt_b_7pp_sf)) { - opc->v2.b_pp_f = next->v3.b_pp_f; - opc->v3.p = next->v1.p; - opc->v7.fp = opt_if_nbp_sf; + if (next->v[0].fb == opt_b_pp_sf) + { + opc->v[2].b_pp_f = next->v[3].b_pp_f; + opc->v[0].fp = opt_if_nbp_sf; + } + else + { + opc->v[2].b_7pp_f = next->v[3].b_7pp_f; + opc->v[0].fp = opt_if_nbp_7sf; + } + opc->v[3].p = next->v[1].p; + oo_set_type_1(opc, 4, 3, OO_P); } - if (next->v7.fb == opt_b_pp_sc) + if ((next->v[0].fb == opt_b_pp_sc) || + (next->v[0].fb == opt_b_7pp_sc)) { - opc->v3.b_pp_f = next->v3.b_pp_f; - opc->v2.p = next->v1.p; - opc->v4.p = next->v2.p; - opc->v7.fp = opt_if_nbp_sc; + if (next->v[0].fb == opt_b_pp_sc) + { + opc->v[3].b_pp_f = next->v[3].b_pp_f; + opc->v[0].fp = opt_if_nbp_sc; + } + else + { + opc->v[3].b_7pp_f = next->v[3].b_7pp_f; + opc->v[0].fp = opt_if_nbp_7sc; + } + opc->v[2].p = next->v[1].p; + opc->v[4].p = next->v[2].p; + oo_set_type_1(opc, 5, 2, OO_P); } - if (next->v7.fb == opt_b_ii_ss) + if (next->v[0].fb == opt_b_ii_ss) { - opc->v3.b_ii_f = next->v3.b_ii_f; - opc->v2.p = next->v1.p; - opc->v4.p = next->v2.p; - opc->v7.fp = opt_if_nbp_ss; + opc->v[3].b_ii_f = next->v[3].b_ii_f; + opc->v[2].p = next->v[1].p; + opc->v[4].p = next->v[2].p; + opc->v[0].fp = opt_if_nbp_ss; + oo_set_type_2(opc, 5, 2, 4, OO_I, OO_I); } + oo_check(sc, opc); return(true); } } @@ -55492,13 +57541,16 @@ static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((bool_optimize(sc, cdr(car_x))) && (cell_optimize(sc, cddr(car_x)))) { - opc->v7.fp = opt_if_bp; - opc->v1.i = sc->pc - 1; - if (next->v7.fb == opt_b_p_f) + opc->v[0].fp = opt_if_bp; + opc->v[1].i = sc->pc - 1; + if (next->v[0].fb == opt_b_p_f) { - opc->v2.b_p_f = next->v2.b_p_f; - opc->v7.fp = opt_if_bp_f; + opc->v[2].b_p_f = next->v[2].b_p_f; + opc->v[0].fp = opt_if_bp_f; + oo_set_type_0(opc, 3); } + else oo_set_type_0(opc, 2); + oo_check(sc, opc); return(true); } } @@ -55511,11 +57563,13 @@ static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int32_t len) if ((bool_optimize(sc, cdr(car_x))) && (cell_optimize(sc, cddr(car_x)))) { - opc->v7.fp = opt_if_bpp; - opc->v1.i = sc->pc - 1; + opc->v[0].fp = opt_if_bpp; + opc->v[1].i = sc->pc - 1; if (cell_optimize(sc, cdddr(car_x))) { - opc->v3.i = sc->pc - 1; + opc->v[3].i = sc->pc - 1; + oo_set_type_0(opc, 4); + oo_check(sc, opc); return(true); } } @@ -55544,47 +57598,49 @@ static s7_pointer opt_case(void *p) { opt_info *o = (opt_info *)p; opt_info *o1; - o->v2.p = cur_sc->unspecified; - o1 = cur_sc->opts[++cur_sc->pc]; - o->v4.p = o1->v7.fp(o1); - while (cur_sc->pc < o->v1.i) + oo_rcheck(o->sc, o, 5, 0); + o->v[2].p = o->sc->unspecified; + o1 = o->sc->opts[++o->sc->pc]; + o->v[4].p = o1->v[0].fp(o1); + while (o->sc->pc < o->v[1].i) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - return(o->v2.p); + return(o->v[2].p); } static s7_pointer opt_case_clause(void *p) { - /* top->v2.p gets result, top->i1 is end index, top->v4.p is selector, o->v3.i is end of current clause, o->v1.i = body len */ + /* top->v[2].p gets result, top->i1 is end index, top->v[4].p is selector, o->v[3].i is end of current clause, o->v[1].i = body len */ opt_info *o = (opt_info *)p; opt_info *top; - top = (opt_info *)(o->v5.obj); - if ((o->v2.p == cur_sc->else_symbol) || - (case_memv(cur_sc, top->v4.p, o->v2.p))) + oo_rcheck(o->sc, o, 6, 0); + top = (opt_info *)(o->v[5].obj); + if ((o->v[2].p == o->sc->else_symbol) || + (case_memv(o->sc, top->v[4].p, o->v[2].p))) { opt_info *o1; int32_t i, len; - len = o->v1.i - 1; + len = o->v[1].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - top->v2.p = o1->v7.fp(o1); - cur_sc->pc = top->v1.i; - return(top->v2.p); + o1 = o->sc->opts[++o->sc->pc]; + top->v[2].p = o1->v[0].fp(o1); + o->sc->pc = top->v[1].i; + return(top->v[2].p); } - cur_sc->pc = o->v3.i; - return(cur_sc->unspecified); + o->sc->pc = o->v[3].i; + return(o->sc->unspecified); } static bool opt_cell_case(s7_scheme *sc, s7_pointer car_x) { - /* top->v2.p gets result, top->v1.i is end index, clause->v3.i is end of current clause, - * clause->v1.i = clause result len, clause->v5.obj = top + /* top->v[2].p gets result, top->v[1].i is end index, clause->v[3].i is end of current clause, + * clause->v[1].i = clause result len, clause->v[5].obj = top */ opt_info *top; top = alloc_opo(sc, car_x); @@ -55608,13 +57664,13 @@ static bool opt_cell_case(s7_scheme *sc, s7_pointer car_x) { if (!is_null(cdr(p))) return(return_false(sc, clause, __func__, __LINE__)); - opc->v2.p = sc->else_symbol; + opc->v[2].p = sc->else_symbol; } else { if (!s7_is_proper_list(sc, car(clause))) return(return_false(sc, clause, __func__, __LINE__)); - opc->v2.p = car(clause); + opc->v[2].p = car(clause); } for (blen = 0, cp = cdr(clause); is_pair(cp); blen++, cp = cdr(cp)) @@ -55622,15 +57678,19 @@ static bool opt_cell_case(s7_scheme *sc, s7_pointer car_x) return(return_false(sc, cp, __func__, __LINE__)); if (!is_null(cp)) return(return_false(sc, cp, __func__, __LINE__)); - opc->v1.i = blen; - opc->v3.i = sc->pc - 1; - opc->v5.obj = (void *)top; - opc->v7.fp = opt_case_clause; + opc->v[1].i = blen; + opc->v[3].i = sc->pc - 1; + opc->v[5].obj = (void *)top; + opc->v[0].fp = opt_case_clause; + oo_set_type_0(opc, 6); + oo_check(sc, opc); } if (!is_null(p)) return(return_false(sc, p, __func__, __LINE__)); - top->v1.i = sc->pc - 1; - top->v7.fp = opt_case; + top->v[1].i = sc->pc - 1; + top->v[0].fp = opt_case; + oo_set_type_0(top, 5); + oo_check(sc, top); return(true); } return(false); @@ -55644,25 +57704,26 @@ static s7_pointer opt_let_temporarily(void *p) int32_t tx, i, len; s7_pointer result; - tx = next_tx(cur_sc); - o1 = cur_sc->opts[++cur_sc->pc]; + oo_rcheck(o->sc, o, 5, 1); + tx = next_tx(o->sc); + o1 = o->sc->opts[++o->sc->pc]; - o->v4.p = slot_value(o->v1.p); /* save and protect old value */ - cur_sc->t_temps[tx] = o->v4.p; - if (is_immutable_slot(o->v1.p)) - immutable_object_error(cur_sc, set_elist_3(cur_sc, immutable_error_string, cur_sc->let_temporarily_symbol, slot_symbol(o->v1.p))); - slot_set_value(o->v1.p, o1->v7.fp(o1)); /* set new value */ + o->v[4].p = slot_value(o->v[1].p); /* save and protect old value */ + o->sc->t_temps[tx] = o->v[4].p; + if (is_immutable_slot(o->v[1].p)) + immutable_object_error(o->sc, set_elist_3(o->sc, immutable_error_string, o->sc->let_temporarily_symbol, slot_symbol(o->v[1].p))); + slot_set_value(o->v[1].p, o1->v[0].fp(o1)); /* set new value */ - len = o->v2.i - 1; + len = o->v[2].i - 1; for (i = 0; i < len; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - result = o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + result = o1->v[0].fp(o1); - slot_set_value(o->v1.p, o->v4.p); /* restore old */ + slot_set_value(o->v[1].p, o->v[4].p); /* restore old */ return(result); } @@ -55685,8 +57746,8 @@ static bool opt_cell_let_temporarily(s7_scheme *sc, s7_pointer car_x, int32_t le s7_pointer p; opt_info *opc; opc = alloc_opo(sc, car_x); - opc->v1.p = symbol_to_slot(sc, caar(cadr(car_x))); - if (!is_slot(opc->v1.p)) + opc->v[1].p = symbol_to_slot(sc, caar(cadr(car_x))); + if (!is_slot(opc->v[1].p)) return(return_false(sc, car_x, __func__, __LINE__)); if (!cell_optimize(sc, cdar(cadr(car_x)))) @@ -55695,216 +57756,160 @@ static bool opt_cell_let_temporarily(s7_scheme *sc, s7_pointer car_x, int32_t le if (!cell_optimize(sc, p)) return(return_false(sc, car_x, __func__, __LINE__)); - opc->v2.i = len - 2; - opc->v7.fp = opt_let_temporarily; + opc->v[2].i = len - 2; + opc->v[0].fp = opt_let_temporarily; + oo_set_type_1(opc, 5, 1, OO_P); return(true); } return(false); } /* -------- cell_do -------- */ -static s7_pointer opt_do_any(void *p) -{ - opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i(=return length, o->v5.i=end index */ - opt_info *o1, *ostart; - int32_t loop, i; - s7_pointer vp, old_e, result; - - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; - - /* init */ - for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp)) - { - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_value(vp, o1->v7.fp(o1)); - } - - loop = ++cur_sc->pc; - ostart = cur_sc->opts[loop]; - while (true) - { - /* end */ - if (ostart->v7.fb(ostart)) - break; - - /* body */ - for (i = 0; i < o->v3.i; i++) - { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); - } - - /* step (let not let*) */ - for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp)) - if (has_stepper(vp)) - { - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_pending_value(vp, o1->v7.fp(o1)); - } - for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp)) - if (has_stepper(vp)) - slot_set_value(vp, slot_pending_value(vp)); - - cur_sc->pc = loop; - } - cur_sc->pc = o->v1.i; - - /* result */ - result = cur_sc->T; - for (i = 0; i < o->v4.i; i++) - { - o1 = cur_sc->opts[++cur_sc->pc]; - result = o1->v7.fp(o1); - } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(result); -} - static s7_pointer opt_do_no_vars(void *p) { /* no vars, no return */ - opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index */ + opt_info *o = (opt_info *)p; /* o->v[2].p=frame, o->v[1].i=body end index, o->v[3].i=body length, o->v[4].i=return length, o->v[5].i=end index */ opt_info *ostart; int32_t loop, i; s7_pointer old_e; - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; + oo_rcheck(o->sc, o, 6, 0); + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; - loop = ++cur_sc->pc; - ostart = cur_sc->opts[loop]; + loop = ++o->sc->pc; + ostart = o->sc->opts[loop]; while (true) { - if (ostart->v7.fb(ostart)) + if (ostart->v[0].fb(ostart)) break; - for (i = 0; i < o->v3.i; i++) + for (i = 0; i < o->v[3].i; i++) { opt_info *o1; - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - cur_sc->pc = loop; + o->sc->pc = loop; } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_do_2(void *p) { /* 1 var, no return */ - opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index */ + opt_info *o = (opt_info *)p; /* o->v[2].p=frame, o->v[1].i=body end index, o->v[3].i=body length, o->v[4].i=return length, o->v[5].i=end index */ opt_info *o1, *ostart; int32_t i, loop; s7_pointer vp, old_e; - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; + oo_rcheck(o->sc, o, 6, 0); + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; - vp = let_slots(o->v2.p); - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_value(vp, o1->v7.fp(o1)); + vp = let_slots(o->v[2].p); + o1 = o->sc->opts[++o->sc->pc]; + slot_set_value(vp, o1->v[0].fp(o1)); - loop = ++cur_sc->pc; - ostart = cur_sc->opts[loop]; + loop = ++o->sc->pc; + ostart = o->sc->opts[loop]; while (true) { - if (ostart->v7.fb(ostart)) + if (ostart->v[0].fb(ostart)) break; - for (i = 0; i < o->v3.i; i++) + for (i = 0; i < o->v[3].i; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_value(vp, o1->v7.fp(o1)); - cur_sc->pc = loop; + o1 = o->sc->opts[++o->sc->pc]; + slot_set_value(vp, o1->v[0].fp(o1)); + o->sc->pc = loop; } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_dotimes_2(void *p) { /* 1 var, no return */ - opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index, v6.i=end if int32_t */ + opt_info *o = (opt_info *)p; /* o->v[2].p=frame, o->v[1].i=body end index, o->v[3].i=body length, o->v[4].i=return length, o->v[5].i=end index, v6.i=end if int32_t */ opt_info *o1; int32_t i, loop; s7_int end; s7_pointer vp, old_e; - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; + oo_rcheck(o->sc, o, 6, 0); + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; - vp = slot_value(dox_slot1(o->v2.p)); - if (is_slot(dox_slot2_unchecked(o->v2.p))) - end = integer(slot_value(dox_slot2(o->v2.p))); - else end = o->v6.i; + vp = slot_value(dox_slot1(o->v[2].p)); + if (is_slot(dox_slot2_unchecked(o->v[2].p))) + end = integer(slot_value(dox_slot2(o->v[2].p))); + else end = o->v[6].i; - o1 = cur_sc->opts[++cur_sc->pc]; - integer(vp) = integer(o1->v7.fp(o1)); + o1 = o->sc->opts[++o->sc->pc]; + integer(vp) = integer(o1->v[0].fp(o1)); - loop = o->v4.i - 1; + loop = o->v[4].i - 1; while (integer(vp) < end) { - cur_sc->pc = loop; - for (i = 0; i < o->v3.i; i++) + o->sc->pc = loop; + for (i = 0; i < o->v[3].i; i++) { - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); } integer(vp)++; } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_do_simple(void *p) { /* 1 var step by 1, 1 expr, no return */ - opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v5.i=end index */ + opt_info *o = (opt_info *)p; /* o->v[2].p=frame, o->v[5].i=end index */ opt_info *o1, *ostart; int32_t loop; s7_pointer vp, old_e; - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; + oo_rcheck(o->sc, o, 6, 0); + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; - vp = let_slots(o->v2.p); - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_value(vp, o1->v7.fp(o1)); + vp = let_slots(o->v[2].p); + o1 = o->sc->opts[++o->sc->pc]; + slot_set_value(vp, o1->v[0].fp(o1)); - loop = ++cur_sc->pc; - ostart = cur_sc->opts[loop]; + loop = ++o->sc->pc; + ostart = o->sc->opts[loop]; while (true) { - if (ostart->v7.fb(ostart)) + if (ostart->v[0].fb(ostart)) break; - o1 = cur_sc->opts[++cur_sc->pc]; - o1->v7.fp(o1); + o1 = o->sc->opts[++o->sc->pc]; + o1->v[0].fp(o1); - o1 = cur_sc->opts[++cur_sc->pc]; - slot_set_value(vp, o1->v7.fp(o1)); - cur_sc->pc = loop; + o1 = o->sc->opts[++o->sc->pc]; + slot_set_value(vp, o1->v[0].fp(o1)); + o->sc->pc = loop; } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_do_very_simple(void *p) @@ -55916,31 +57921,32 @@ static s7_pointer opt_do_very_simple(void *p) s7_pointer vp, old_e; s7_pointer (*f)(void *p); - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; - - vp = slot_value(dox_slot1(o->v2.p)); - if (is_slot(dox_slot2_unchecked(o->v2.p))) - end = integer(slot_value(dox_slot2(o->v2.p))); - else end = o->v3.i; - o1 = cur_sc->opts[++cur_sc->pc]; - integer(vp) = integer(o1->v7.fp(o1)); - - loop = o->v4.i; - cur_sc->pc = loop; - o1 = cur_sc->opts[loop]; /* the body */ - f = o1->v7.fp; + oo_rcheck(o->sc, o, 6, 0); /* v[2].p is a let */ + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; + + vp = slot_value(dox_slot1(o->v[2].p)); + if (is_slot(dox_slot2_unchecked(o->v[2].p))) + end = integer(slot_value(dox_slot2(o->v[2].p))); + else end = o->v[3].i; + o1 = o->sc->opts[++o->sc->pc]; + integer(vp) = integer(o1->v[0].fp(o1)); + + loop = o->v[4].i; + o->sc->pc = loop; + o1 = o->sc->opts[loop]; /* the body */ + f = o1->v[0].fp; while (integer(vp) < end) { f(o1); - cur_sc->pc = loop; + o->sc->pc = loop; integer(vp)++; } - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_do_prepackaged(void *p) @@ -55950,25 +57956,26 @@ static s7_pointer opt_do_prepackaged(void *p) s7_int end; s7_pointer vp, old_e; - old_e = cur_sc->envir; - push_stack(cur_sc, OP_GC_PROTECT, old_e, cur_sc->nil); - cur_sc->envir = o->v2.p; - - vp = slot_value(dox_slot1(o->v2.p)); - if (is_slot(dox_slot2_unchecked(o->v2.p))) - end = integer(slot_value(dox_slot2(o->v2.p))); - else end = o->v3.i; - o1 = cur_sc->opts[++cur_sc->pc]; - integer(vp) = integer(o1->v7.fp(o1)); + oo_rcheck(o->sc, o, 6, 0); + old_e = o->sc->envir; + push_stack(o->sc, OP_GC_PROTECT, old_e, o->sc->nil); + o->sc->envir = o->v[2].p; + + vp = slot_value(dox_slot1(o->v[2].p)); + if (is_slot(dox_slot2_unchecked(o->v[2].p))) + end = integer(slot_value(dox_slot2(o->v[2].p))); + else end = o->v[3].i; + o1 = o->sc->opts[++o->sc->pc]; + integer(vp) = integer(o1->v[0].fp(o1)); - o->v6.p = vp; - o->v1.i = end; - o->v8.fp(o); + o->v[6].p = vp; + o->v[1].i = end; + o->v[7].fp(o); - cur_sc->pc = o->v5.i; - cur_sc->stack_end -= 4; - cur_sc->envir = old_e; - return(cur_sc->T); + o->sc->pc = o->v[5].i; + o->sc->stack_end -= 4; + o->sc->envir = old_e; + return(o->sc->T); } static s7_pointer opt_do_dpnr(void *p) @@ -55980,14 +57987,15 @@ static s7_pointer opt_do_dpnr(void *p) s7_int end; s7_double (*f)(void *p); - end = o->v1.i; - vp = o->v6.p; - loop = o->v4.i; - o1 = cur_sc->opts[loop]; /* the body */ - f = o1->v8.fd; + oo_rcheck(o->sc, o, 7, 0); + end = o->v[1].i; + vp = o->v[6].p; + loop = o->v[4].i; + o1 = o->sc->opts[loop]; /* the body */ + f = o1->v[7].fd; while (integer(vp) < end) { - cur_sc->pc = loop; + o->sc->pc = loop; f(o1); integer(vp)++; } @@ -56003,14 +58011,15 @@ static s7_pointer opt_do_ipnr(void *p) s7_int end; s7_int (*f)(void *p); - end = o->v1.i; - vp = o->v6.p; - loop = o->v4.i; - o1 = cur_sc->opts[loop]; /* the body */ - f = o1->v8.fi; + oo_rcheck(o->sc, o, 7, 0); + end = o->v[1].i; + vp = o->v[6].p; + loop = o->v[4].i; + o1 = o->sc->opts[loop]; /* the body */ + f = o1->v[7].fi; while (integer(vp) < end) { - cur_sc->pc = loop; + o->sc->pc = loop; f(o1); integer(vp)++; } @@ -56026,19 +58035,20 @@ static s7_pointer opt_do_ifbp(void *p) s7_int end; bool (*f)(void *p); - end = o->v1.i; - vp = o->v6.p; - loop = o->v4.i + 1; - o1 = cur_sc->opts[loop]; - f = o1->v7.fb; + oo_rcheck(o->sc, o, 7, 0); + end = o->v[1].i; + vp = o->v[6].p; + loop = o->v[4].i + 1; + o1 = o->sc->opts[loop]; + f = o1->v[0].fb; while (integer(vp) < end) { - cur_sc->pc = loop; + o->sc->pc = loop; if (f(o1)) { opt_info *o2; - o2 = cur_sc->opts[++cur_sc->pc]; - o2->v7.fp(o2); + o2 = o->sc->opts[++o->sc->pc]; + o2->v[0].fp(o2); } integer(vp)++; } @@ -56053,16 +58063,17 @@ static s7_pointer opt_do_setpif(void *p) s7_pointer vp, val; s7_int end; - end = o->v1.i; - vp = o->v6.p; - loop = o->v4.i; - o1 = cur_sc->opts[loop]; + oo_rcheck(o->sc, o, 5, 2); + end = o->v[1].i; + vp = o->v[6].p; + loop = o->v[4].i; + o1 = o->sc->opts[loop]; - val = make_mutable_integer(cur_sc, integer(slot_value(o1->v1.p))); - slot_set_value(o1->v1.p, val); + val = make_mutable_integer(o->sc, integer(slot_value(o1->v[1].p))); + slot_set_value(o1->v[1].p, val); while (integer(vp) < end) { - integer(val) = o1->v4.i_ii_f(integer(slot_value(o1->v2.p)), o1->v3.i); + integer(val) = o1->v[4].i_ii_f(integer(slot_value(o1->v[2].p)), o1->v[3].i); integer(vp)++; } return(NULL); @@ -56090,12 +58101,11 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len) * need to pass in the end point for unchecked use: var an int, (+ var 1), end of form (= var x) where we can find x -- set stepper and denominator * this is a kludge -- find a better way! * and no feed-to - * see OP_LET above -- get rid of local envir+slots! (longjmp if opts_size overflow also can't work with sc->envir change) - * or trap somehow? */ opt_info *opc; - s7_pointer p, end, frame = NULL, old_e, slot; - int32_t var_len, body_len, step_len; + s7_pointer p, end, frame = NULL, old_e, slot, stop, ind, ind_step, var; + int32_t i, var_len, body_len, body_index, step_len, rtn_len; + bool has_set = false; if (len < 3) return(false); @@ -56113,7 +58123,7 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len) opc = alloc_opo(sc, car_x); new_frame(sc, sc->envir, frame); - push_stack(cur_sc, OP_GC_PROTECT, old_e, frame); + push_stack(sc, OP_GC_PROTECT, old_e, frame); /* the vars have to be added to the frame before evaluating the inits * else symbol_id can be > let_id (see "(test (do ((i (do ((i (do ((i 0 (+ i 1)))...") @@ -56215,239 +58225,250 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len) } } - if (bool_optimize_nw(sc, end)) - { - int32_t i, body_index; - s7_pointer p, stop; - stop = car(end); - if ((is_pair(stop)) && - ((car(stop) == sc->eq_symbol) || (car(stop) == sc->geq_symbol) || (car(stop) == sc->gt_symbol)) && - (is_pair(cdr(stop))) && - (is_symbol(cadr(stop))) && - (is_pair(cddr(stop))) && - (is_null(cdddr(stop))) && - ((is_opt_int(caddr(stop))) || (is_symbol(caddr(stop))))) - { - s7_pointer stop_slot; - if (is_symbol(caddr(stop))) - { - stop_slot = symbol_to_slot(sc, caddr(stop)); - if ((!is_slot(stop_slot)) || - (!is_opt_int(slot_value(stop_slot)))) - stop_slot = NULL; - } - else stop_slot = sc->nil; - if (stop_slot) - { - s7_int lim; - bool set_stop = false; - s7_pointer slot; - - if (is_slot(stop_slot)) - lim = integer(slot_value(stop_slot)); - else lim = integer(caddr(stop)); - if (car(stop) == sc->gt_symbol) lim++; - - for (p = cadr(car_x), slot = let_slots(frame); is_pair(p); p = cdr(p), slot = next_slot(slot)) - { - /* this could be put off until it is needed (ref/set), but this code is not called much - * another choice: go from init downto 0: init is lim - */ - if (slot_symbol(slot) == cadr(stop)) - set_stop = true; /* don't overrule this decision below */ - if (has_stepper(slot)) - { - s7_pointer var, step; - var = car(p); - step = caddr(var); - if ((is_opt_int(slot_value(slot))) && - (is_pair(step)) && - (is_pair(cdr(step))) && - (car(var) == cadr(stop)) && - (car(var) == cadr(step)) && - ((car(stop) != sc->eq_symbol) || /* else > protects at least the top */ - ((caddr(step) == small_int(1)) && (car(step) == sc->add_symbol)))) - { - set_step_end(slot); - denominator(slot_value(slot)) = lim; - } - } - } - - if (!set_stop) + if (!bool_optimize_nw(sc, end)) + { + sc->stack_end -= 4; /* not pop_stack! */ + sc->envir = old_e; + return(false); + } + + stop = car(end); + if ((is_pair(stop)) && + ((car(stop) == sc->eq_symbol) || (car(stop) == sc->geq_symbol) || (car(stop) == sc->gt_symbol)) && + (is_pair(cdr(stop))) && + (is_symbol(cadr(stop))) && + (is_pair(cddr(stop))) && + (is_null(cdddr(stop))) && + ((is_opt_int(caddr(stop))) || (is_symbol(caddr(stop))))) + { + s7_pointer stop_slot; + if (is_symbol(caddr(stop))) + { + stop_slot = symbol_to_slot(sc, caddr(stop)); + if ((!is_slot(stop_slot)) || + (!is_opt_int(slot_value(stop_slot)))) + stop_slot = NULL; + } + else stop_slot = sc->nil; + if (stop_slot) + { + s7_int lim; + bool set_stop = false; + s7_pointer slot; + + if (is_slot(stop_slot)) + lim = integer(slot_value(stop_slot)); + else lim = integer(caddr(stop)); + if (car(stop) == sc->gt_symbol) lim++; + + for (p = cadr(car_x), slot = let_slots(frame); is_pair(p); p = cdr(p), slot = next_slot(slot)) + { + /* this could be put off until it is needed (ref/set), but this code is not called much + * another choice: go from init downto 0: init is lim + */ + if (slot_symbol(slot) == cadr(stop)) + set_stop = true; /* don't overrule this decision below */ + if (has_stepper(slot)) { - s7_pointer slot; - slot = symbol_to_slot(sc, cadr(stop)); - if ((is_slot(slot)) && - (is_opt_int(slot_value(slot))) && - (stop_is_safe(sc, cadr(stop), cddr(car_x)))) + s7_pointer var, step; + var = car(p); + step = caddr(var); + if ((is_opt_int(slot_value(slot))) && + (is_pair(step)) && + (is_pair(cdr(step))) && + (car(var) == cadr(stop)) && + (car(var) == cadr(step)) && + ((car(stop) != sc->eq_symbol) || /* else > protects at least the top */ + ((caddr(step) == small_int(1)) && (car(step) == sc->add_symbol)))) { set_step_end(slot); denominator(slot_value(slot)) = lim; } } } - } - - body_index = sc->pc; - for (i = 3, p = cdddr(car_x); i < len; i++, p = cdr(p)) - { - opt_info *start; - start = sc->opts[sc->pc]; - if (!cell_optimize(sc, p)) - break; - if (start->v7.fp == d_to_p) + + if (!set_stop) { - start->v7.fp = d_to_p_nr; - if (start->v8.fd == opt_d_pid_ssf) - start->v7.fp = opt_d_pid_ssf_nr; - else + s7_pointer slot; + slot = symbol_to_slot(sc, cadr(stop)); + if ((is_slot(slot)) && + (is_opt_int(slot_value(slot))) && + (stop_is_safe(sc, cadr(stop), cddr(car_x)))) { - if (start->v8.fd == opt_d_pid_ssfo_fv) - start->v7.fp = opt_d_pid_ssfo_fv_nr; + set_step_end(slot); + denominator(slot_value(slot)) = lim; } } + } + } + + body_index = sc->pc; + for (i = 3, p = cdddr(car_x); i < len; i++, p = cdr(p)) + { + opt_info *start; + start = sc->opts[sc->pc]; + if (!cell_optimize(sc, p)) + break; + if (start->v[0].fp == d_to_p) + { + start->v[0].fp = d_to_p_nr; + if (start->v[7].fd == opt_d_7pid_ssf) + start->v[0].fp = opt_d_7pid_ssf_nr; else { - if (start->v7.fp == i_to_p) - start->v7.fp = i_to_p_nr; + if (start->v[7].fd == opt_d_7pid_ssfo_fv) + start->v[0].fp = opt_d_7pid_ssfo_fv_nr; } } - - if (!is_null(p)) - { - sc->stack_end -= 4; - sc->envir = old_e; - return(return_false(sc, car_x, __func__, __LINE__)); - } - - for (p = cadr(car_x); is_pair(p); p = cdr(p)) + else { - s7_pointer var; - var = car(p); - if ((is_pair(cddr(var))) && - (!cell_optimize(sc, cddr(var)))) - break; + if (start->v[0].fp == i_to_p) + start->v[0].fp = i_to_p_nr; } - if (is_null(p)) + } + + if (!is_null(p)) + { + sc->stack_end -= 4; + sc->envir = old_e; + return(return_false(sc, car_x, __func__, __LINE__)); + } + + for (p = cadr(car_x); is_pair(p); p = cdr(p)) + { + s7_pointer var; + var = car(p); + if ((is_pair(cddr(var))) && + (!cell_optimize(sc, cddr(var)))) + break; + } + + if (!is_null(p)) + { + sc->stack_end -= 4; + sc->envir = old_e; + return(return_false(sc, car_x, __func__, __LINE__)); + } + + rtn_len = 0; + opc->v[1].i = sc->pc - 1; + if (!is_list(cdr(end))) + { + sc->stack_end -= 4; + sc->envir = old_e; + return(return_false(sc, car_x, __func__, __LINE__)); + } + for (p = cdr(end); is_pair(p); p = cdr(p), rtn_len++) + if (!cell_optimize(sc, p)) + break; + if (!is_null(p)) + { + sc->stack_end -= 4; + sc->envir = old_e; + return(return_false(sc, car_x, __func__, __LINE__)); + } + opc->v[2].p = frame; + opc->v[3].i = len - 3; /* body_len */ + opc->v[4].i = rtn_len; + opc->v[5].i = sc->pc - 1; + sc->envir = old_e; + + if ((var_len == 0) && (rtn_len == 0)) + { + opc->v[0].fp = opt_do_no_vars; + oo_set_type_0(opc, 6); + oo_check(sc, opc); + return(true); + } + + if ((var_len != 1) || (step_len != 1) || (rtn_len != 0)) + { + /* two steppers by 1, or -1/cdr or non-stepper(s)+step1 or step1+float-step */ + /* fprintf(stderr, "opt_do_any: %s\n", DISPLAY_80(car_x)); */ + sc->stack_end -= 4; + sc->envir = old_e; + return(return_false(sc, car_x, __func__, __LINE__)); + } + + opc->v[0].fp = (body_len == 1) ? opt_do_simple : opt_do_2; + /* just a first stab at this + * set|let-set? if not caddr, hash-table|vector|list-set if not cadddr: old code checks !has_set for dotimes + * implicit set similar + * also (+ 1 ind) and (= end ind) and >= and body_len=any but still safe_stepper(s) + */ + var = caadr(car_x); + ind = car(var); + ind_step = caddr(var); + end = caaddr(car_x); + slot = let_slots(frame); + + if ((is_pair(end)) && /* (= i len|100) */ + (car(end) == sc->eq_symbol) && + (cadr(end) == ind) && + ((is_symbol(caddr(end))) || (is_t_integer(caddr(end)))) && + (is_null(cdddr(end))) && + (is_pair(ind_step)) && /* (+ i 1) */ + (car(ind_step) == sc->add_symbol) && + (cadr(ind_step) == ind) && + (caddr(ind_step) == small_int(1)) && + (is_null(cdddr(ind_step))) && + (do_is_safe(sc, cdddr(car_x), sc->w = list_1(sc, ind), sc->nil, &has_set))) + { + dox_set_slot1(frame, slot); + dox_set_slot2_unchecked(frame, (is_symbol(caddr(end))) ? symbol_to_slot(sc, caddr(end)) : sc->undefined); + slot_set_value(slot, make_mutable_integer(sc, integer(slot_value(slot)))); + opc->v[4].i = body_index; + if (body_len == 1) { - int32_t rtn_len = 0; - opc->v1.i = sc->pc - 1; - if (!is_list(cdr(end))) - { - sc->stack_end -= 4; - sc->envir = old_e; - return(return_false(sc, car_x, __func__, __LINE__)); - } - for (p = cdr(end); is_pair(p); p = cdr(p), rtn_len++) - if (!cell_optimize(sc, p)) - break; - if (!is_null(p)) - { - sc->stack_end -= 4; - sc->envir = old_e; - return(return_false(sc, car_x, __func__, __LINE__)); - } - opc->v2.p = frame; - opc->v3.i = len - 3; /* body_len */ - opc->v4.i = rtn_len; - opc->v5.i = sc->pc - 1; - sc->envir = old_e; + opt_info *o1; + opc->v[0].fp = opt_do_very_simple; + if (is_t_integer(caddr(end))) + opc->v[3].i = integer(caddr(end)); - if ((var_len == 0) && (rtn_len == 0)) + o1 = sc->opts[body_index]; + /* v2, v3, v4, v5 are in use */ + if (o1->v[0].fp == d_to_p_nr) { - opc->v7.fp = opt_do_no_vars; - return(true); + /* snd-test: (do ((k 0 (+ k 1))) ((= k N)) (float-vector-set! rl k (read-sample rd))) */ + opc->v[0].fp = opt_do_prepackaged; + opc->v[7].fp = opt_do_dpnr; } - - if ((var_len == 1) && (step_len == 1) && (rtn_len == 0)) + else { - s7_pointer ind, ind_step, end, slot, var; - bool has_set = false; - - opc->v7.fp = (body_len == 1) ? opt_do_simple : opt_do_2; - /* just a first stab at this - * set|let-set? if not caddr, hash-table|vector|list-set if not cadddr: old code checks !has_set for dotimes - * implicit set similar - * also (+ 1 ind) and (= end ind) and >= and body_len=any but still safe_stepper(s) - */ - var = caadr(car_x); - ind = car(var); - ind_step = caddr(var); - end = caaddr(car_x); - slot = let_slots(frame); - - if ((is_pair(end)) && /* (= i len|100) */ - (car(end) == sc->eq_symbol) && - (cadr(end) == ind) && - ((is_symbol(caddr(end))) || (is_t_integer(caddr(end)))) && - (is_null(cdddr(end))) && - (is_pair(ind_step)) && /* (+ i 1) */ - (car(ind_step) == sc->add_symbol) && - (cadr(ind_step) == ind) && - (caddr(ind_step) == small_int(1)) && - (is_null(cdddr(ind_step))) && - (do_is_safe(sc, cdddr(car_x), sc->w = list_1(sc, ind), sc->nil, &has_set))) + if (o1->v[0].fp == i_to_p_nr) { - dox_set_slot1(frame, slot); - dox_set_slot2_unchecked(frame, (is_symbol(caddr(end))) ? symbol_to_slot(sc, caddr(end)) : sc->undefined); - slot_set_value(slot, make_mutable_integer(sc, integer(slot_value(slot)))); - opc->v4.i = body_index; - if (body_len == 1) + opc->v[0].fp = opt_do_prepackaged; + opc->v[7].fp = opt_do_ipnr; + } + else + { + if (o1->v[0].fp == opt_if_bp) { - opt_info *o1; - opc->v7.fp = opt_do_very_simple; - if (is_t_integer(caddr(end))) - opc->v3.i = integer(caddr(end)); - - o1 = sc->opts[body_index]; - /* v2, v3, v4, v5 are in use */ - if (o1->v7.fp == d_to_p_nr) - { - /* snd-test: (do ((k 0 (+ k 1))) ((= k N)) (float-vector-set! rl k (read-sample rd))) */ - opc->v7.fp = opt_do_prepackaged; - opc->v8.fp = opt_do_dpnr; - } - else - { - if (o1->v7.fp == i_to_p_nr) - { - opc->v7.fp = opt_do_prepackaged; - opc->v8.fp = opt_do_ipnr; - } - else - { - if (o1->v7.fp == opt_if_bp) - { - opc->v7.fp = opt_do_prepackaged; - opc->v8.fp = opt_do_ifbp; - } - else - { - if (o1->v7.fp == opt_set_p_i_fo1) - { - opc->v7.fp = opt_do_prepackaged; - opc->v8.fp = opt_do_setpif; - } - } - } - } + opc->v[0].fp = opt_do_prepackaged; + opc->v[7].fp = opt_do_ifbp; } else { - opc->v7.fp = opt_dotimes_2; - if (is_t_integer(caddr(end))) - opc->v6.i = integer(caddr(end)); + if (o1->v[0].fp == opt_set_p_i_fo1) + { + opc->v[0].fp = opt_do_prepackaged; + opc->v[7].fp = opt_do_setpif; + } } } } - else opc->v7.fp = opt_do_any; - return(true); + } + else + { + opc->v[0].fp = opt_dotimes_2; + if (is_t_integer(caddr(end))) + opc->v[6].i = integer(caddr(end)); } } - sc->stack_end -= 4; /* not pop_stack! */ - sc->envir = old_e; - return(false); + oo_set_type_0(opc, 8); + oo_check(sc, opc); + sc->opt_has_local_let = true; + return(true); } static bool p_syntax(s7_scheme *sc, s7_pointer car_x, int32_t len) @@ -56516,19 +58537,10 @@ static void start_opts(s7_scheme *sc) sc->pc = 0; } -#if DEBUGGING_ALLOC_OPO -static void pc_fallback_1(s7_scheme *sc, int32_t new_pc, const char *func, int32_t line) -{ - sc->pc = new_pc; - fprintf(stderr, "%s[%d]: set pc to %d\n", func, line, sc->pc); -} -#define pc_fallback(sc, new_pc) pc_fallback_1(sc, new_pc, __func__, __LINE__) -#else static void pc_fallback(s7_scheme *sc, int32_t new_pc) { sc->pc = new_pc; } -#endif static bool float_optimize(s7_scheme *sc, s7_pointer expr) { @@ -56585,13 +58597,13 @@ static bool float_optimize(s7_scheme *sc, s7_pointer expr) (d_id_ok(sc, opc, s_func, car_x)) || (d_pd_ok(sc, opc, s_func, car_x)) || (d_ip_ok(sc, opc, s_func, car_x)) || - (d_pi_ok(sc, opc, s_func, car_x))) + (d_7pi_ok(sc, opc, s_func, car_x))) return(true); break; case 4: if ((d_ddd_ok(sc, opc, s_func, car_x)) || - (d_pid_ok(sc, opc, s_func, car_x)) || + (d_7pid_ok(sc, opc, s_func, car_x)) || (d_vid_ok(sc, opc, s_func, car_x)) || (d_vdd_ok(sc, opc, s_func, car_x))) return(true); @@ -56607,9 +58619,6 @@ static bool float_optimize(s7_scheme *sc, s7_pointer expr) return(true); break; } - - if (float_all_x_ok(sc, opc, s_func, expr)) - return(true); } else { @@ -56664,13 +58673,13 @@ static bool int_optimize(s7_scheme *sc, s7_pointer expr) case 3: if ((i_ii_ok(sc, opc, s_func, car_x)) || - (i_pi_ok(sc, opc, s_func, car_x))) + (i_7pi_ok(sc, opc, s_func, car_x))) return(true); break; case 4: if ((i_iii_ok(sc, opc, s_func, car_x)) || - (i_pii_ok(sc, opc, s_func, car_x))) + (i_7pii_ok(sc, opc, s_func, car_x))) return(true); break; @@ -56681,9 +58690,6 @@ static bool int_optimize(s7_scheme *sc, s7_pointer expr) return(true); break; } - - if (int_all_x_ok(sc, opc, s_func, expr)) - return(true); } else { @@ -56728,12 +58734,10 @@ static bool cell_optimize(s7_scheme *sc, s7_pointer expr) { opt_info *opc; s7_pointer sig; - int32_t start; - start = sc->pc; sig = c_function_signature(s_func); opc = alloc_opo(sc, car_x); - + switch (len) { case 1: @@ -56766,15 +58770,16 @@ static bool cell_optimize(s7_scheme *sc, s7_pointer expr) if ((car(sig) == sc->is_float_symbol) || (car(sig) == sc->is_real_symbol)) { - s7_d_pi_t f; - f = s7_d_pi_function(s_func); + s7_d_7pi_t f; + f = s7_d_7pi_function(s_func); if (f) { sc->pc = pstart - 1; if (float_optimize(sc, expr)) { - opc->v8.fd = opc->v7.fd; - opc->v7.fp = d_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fd = opc->v[0].fd; + opc->v[0].fp = d_to_p; return(true); } } @@ -56789,8 +58794,9 @@ static bool cell_optimize(s7_scheme *sc, s7_pointer expr) if ((ifunc) && (int_optimize(sc, expr))) { - opc->v8.fi = opc->v7.fi; - opc->v7.fp = i_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fi = opc->v[0].fi; + opc->v[0].fp = i_to_p; return(true); } pc_fallback(sc, pstart); @@ -56819,22 +58825,24 @@ static bool cell_optimize(s7_scheme *sc, s7_pointer expr) { if (((car(sig) == sc->is_float_symbol) || (car(sig) == sc->is_real_symbol)) && - (s7_d_pid_function(s_func)) && - (d_pid_ok(sc, opc, s_func, car_x))) + (s7_d_7pid_function(s_func)) && + (d_7pid_ok(sc, opc, s_func, car_x))) { - opc->v8.fd = opc->v7.fd; - opc->v7.fp = d_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fd = opc->v[0].fd; + opc->v[0].fp = d_to_p; return(true); } else { sc->pc = pstart - 1; if ((car(sig) == sc->is_integer_symbol) && - (s7_i_pii_function(s_func)) && - (i_pii_ok(sc, alloc_opo(sc, expr), s_func, car_x))) + (s7_i_7pii_function(s_func)) && + (i_7pii_ok(sc, alloc_opo(sc, expr), s_func, car_x))) { - opc->v8.fi = opc->v7.fi; - opc->v7.fp = i_to_p; + if (oo_size(opc) < 8) oo_resize(opc, 8); + opc->v[7].fi = opc->v[0].fi; + opc->v[0].fp = i_to_p; return(true); } } @@ -56854,14 +58862,20 @@ static bool cell_optimize(s7_scheme *sc, s7_pointer expr) return(true); break; } - - if (cell_all_x_ok(sc, expr, start)) - return(true); } else { if (is_macro(s_func)) return(return_false(sc, car_x, __func__, __LINE__)); /* macroexpand+cell_optimize here restarts the optimize process */ +#if 0 + else + { + /* s_func here assumes global_slot? */ + if ((is_closure(s_func)) && + (is_very_safe_closure(s_func)) && + (is_recur(slot))) + } +#endif } } return(return_false(sc, car_x, __func__, __LINE__)); @@ -56910,8 +58924,10 @@ static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr) case 3: { s7_b_pp_t bpf; + s7_b_7pp_t bpf7 = NULL; bpf = s7_b_pp_function(s_func); - if (bpf) + if (!bpf) bpf7 = s7_b_7pp_function(s_func); + if ((bpf) || (bpf7)) { opt_info *opc; s7_pointer sig1, sig2, arg1, arg2; @@ -56942,9 +58958,11 @@ static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr) (sig2 == sc->is_float_symbol) && (b_dd_ok(sc, opc, s_func, car_x, arg1, arg2))) return(true); - - opc->v3.b_pp_f = bpf; - return(b_pp_ok(sc, opc, s_func, car_x, arg1, arg2)); + + if (bpf) + opc->v[3].b_pp_f = bpf; + else opc->v[3].b_7pp_f = bpf7; + return(b_pp_ok(sc, opc, s_func, car_x, arg1, arg2, bpf != NULL)); } } break; @@ -56973,10 +58991,11 @@ static bool bool_optimize(s7_scheme *sc, s7_pointer expr) wrapper = sc->opts[start]; if (cell_optimize(sc, expr)) { - if (wrapper->v8.fp) /* (when (+ i 1) ...) */ + if (wrapper->v[7].fp) /* (when (+ i 1) ...) */ return(false); - wrapper->v8.fp = wrapper->v7.fp; - wrapper->v7.fb = p_to_b; + if (oo_size(wrapper) < 8) oo_resize(wrapper, 8); + wrapper->v[7].fp = wrapper->v[0].fp; + wrapper->v[0].fb = p_to_b; return(true); } return(false); @@ -56995,7 +59014,6 @@ static s7_function s7_bool_optimize(s7_scheme *sc, s7_pointer expr) start_opts(sc); if (bool_optimize(sc, expr)) return(opt_bool_any); - return(all_x_optimize(sc, expr)); } return(NULL); } @@ -57017,6 +59035,42 @@ s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr) return(NULL); } +s7_function s7_optimize_nr(s7_scheme *sc, s7_pointer expr); + +static s7_function new_s7_optimize(s7_scheme *sc, s7_pointer code, s7_pointer scc) +{ + s7_function func = NULL; + optlist_t *opl; + + if (!has_optlist(code)) + { + sc->opt_has_local_let = false; + func = s7_optimize_nr(sc, code); + if (!func) + { + set_pair_no_opt(code); + return(NULL); + } + if (!sc->opt_has_local_let) + { + set_opt_any2(code, (s7_pointer)copy_optlist(sc)); + set_has_optlist(code); + set_opt_any3(scc, (s7_pointer)func); /* opt2 here fset? */ + add_optlist(sc, code); + } + return(func); + } + + /* restore optlist, fixup all symbols, if fixup unhappy, fallback on s7_optimize */ + opl = (optlist_t *)opt_any2(code); + if (fixup_slots(sc, opl)) + { + restore_optlist(sc, opl); + return((s7_function)opt_any3(scc)); + } + return(s7_optimize_nr(sc, code)); +} + static s7_function s7_optimize_1(s7_scheme *sc, s7_pointer expr, bool nr) { #if WITH_GMP @@ -57030,7 +59084,6 @@ static s7_function s7_optimize_1(s7_scheme *sc, s7_pointer expr, bool nr) if (setjmp(sc->opt_exit) == 0) { - s7_function f; start_opts(sc); if (!no_int_opt(expr)) { @@ -57055,18 +59108,18 @@ static s7_function s7_optimize_1(s7_scheme *sc, s7_pointer expr, bool nr) } if (cell_optimize(sc, expr)) return((nr) ? opt_cell_any_nr : opt_wrap_cell); - - pc_fallback(sc, 0); - f = all_x_optimize(sc, expr); - if (!f) - set_pair_no_opt(expr); - return(f); + set_pair_no_opt(expr); } return(NULL); } s7_function s7_optimize(s7_scheme *sc, s7_pointer expr) {return(s7_optimize_1(sc, expr, false));} -s7_function s7_optimize_nr(s7_scheme *sc, s7_pointer expr) {return(s7_optimize_1(sc, expr, true));} +s7_function s7_optimize_nr(s7_scheme *sc, s7_pointer expr) +{ + s7_function f; + f = s7_optimize_1(sc, expr, true); + return(f); +} static s7_pointer g_optimize(s7_scheme *sc, s7_pointer args) { @@ -57087,9 +59140,8 @@ static s7_function s7_cell_optimize(s7_scheme *sc, s7_pointer expr, bool nr) if (setjmp(sc->opt_exit) == 0) { start_opts(sc); - if (!cell_optimize(sc, expr)) - return(all_x_optimize(sc, expr)); - return((nr) ? opt_cell_any_nr : opt_wrap_cell); + if (cell_optimize(sc, expr)) + return((nr) ? opt_cell_any_nr : opt_wrap_cell); } return(NULL); } @@ -57110,7 +59162,7 @@ static void clear_optimizer_fixups(s7_scheme *sc) for (p = sc->optimizer_fixups; p; p = n) { n = optfix_next(p); - liberate_block(p); + liberate_block(sc, p); } sc->optimizer_fixups = NULL; } @@ -57119,9 +59171,9 @@ static void add_optimizer_fixup(s7_scheme *sc, s7_pointer expr, uint32_t op) { optfix_t *p; #if S7_DEBUGGING - if (((op & 1) != 0) && (!all_x_function[op])) fprintf(stderr, "no all_x fixup for %s\n", opt_names[op]); + if (((op & 1) != 0) && (!all_x_function[op])) fprintf(stderr, "no all_x fixup for %s\n", op_names[op]); #endif - p = (optfix_t *)mallocate_block(); + p = (optfix_t *)mallocate_block(sc); optfix_expr(p) = expr; optfix_op(p) = op; optfix_next(p) = sc->optimizer_fixups; @@ -57436,6 +59488,7 @@ Each object can be a list, string, vector, hash-table, or any other sequence." } } + set_current_code(sc, sc->code); /* if closure call is straightforward, use OP_FOR_EACH_1 */ if ((len == 1) && (is_closure(f)) && /* not lambda* that might get confused about arg names */ @@ -57687,6 +59740,7 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table break; } + set_current_code(sc, sc->code); sc->z = make_iterators(sc, args); push_stack(sc, OP_MAP, make_counter(sc, sc->z), f); sc->z = sc->nil; @@ -57727,27 +59781,31 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) /* in the next set, the main evaluator branches blithely assume no multiple-values, * and if it happens anyway, we go to a different branch here */ - case OP_EVAL_ARGS_AAP_1: - stack_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_AAP_MV; + case OP_SAFE_C_AAP_1: + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_AAP_MV; return(args); case OP_C_AP_1: - case OP_EVAL_ARGS_P_2: - stack_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_2_MV; + case OP_SAFE_C_SP_1: + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_SP_MV; return(args); - case OP_EVAL_ARGS_P_3: - stack_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_3_MV; + case OP_SAFE_C_PS_1: + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PS_MV; return(args); - case OP_EVAL_ARGS_P_4: - stack_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_4_MV; + case OP_SAFE_C_PC_1: + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PC_MV; + return(args); + + case OP_SAFE_C_PA_1: + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PA_MV; return(args); case OP_C_P_1: case OP_SAFE_C_P_1: case OP_NOT_P_1: - stack_element(sc->stack, top) = (s7_pointer)OP_C_P_2; + stack_element(sc->stack, top) = (s7_pointer)OP_C_P_MV; return(args); case OP_SAFE_CLOSURE_P_1: @@ -57766,11 +59824,11 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) return(args); case OP_SAFE_C_PP_1: - stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_3; + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_3_MV; return(args); case OP_SAFE_C_PP_5: - stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_6; + stack_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_6_MV; return(args); case OP_EVAL_ARGS5: @@ -57815,6 +59873,7 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) } case OP_LET_ONE_1: /* sc->args = symbol */ + case OP_LET_ONE_P_1: case OP_LET_Z_1: eval_error_with_caller2(sc, "~A: can't bind '~A to ~S", 24, sc->let_symbol, stack_args(sc->stack, top), cons(sc, sc->values_symbol, args)); @@ -57872,6 +59931,7 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args) sc->stack_end -= 4; return(splice_in_values(sc, args)); + case OP_BEGIN0: case OP_BEGIN1: /* here we have a values call with nothing to splice into. So flush it... * otherwise the multiple-values bit gets set in some innocent list and never unset: @@ -57935,8 +59995,8 @@ s7_pointer s7_values(s7_scheme *sc, s7_pointer args) #define g_values s7_values -static s7_pointer values_p(void) {return(cur_sc->no_value);} -static s7_pointer values_p_p(s7_pointer p) {return(p);} +static s7_pointer values_p(s7_scheme *sc) {return(sc->no_value);} +static s7_pointer values_p_p(s7_scheme *sc, s7_pointer p) {return(p);} /* -------------------------------- quasiquote -------------------------------- */ @@ -57949,7 +60009,7 @@ static s7_pointer g_list_values(s7_scheme *sc, s7_pointer args) s7_pointer x, y, px; for (x = args; is_pair(x); x = cdr(x)) - if (car(x) == sc->no_value) + if (car(x) == sc->no_value) /* unchecked_car|cdr unrolled here is not faster */ break; if (is_null(x)) @@ -58226,7 +60286,7 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt) if ((dims <= 0) || (dims > S7_SHORT_MAX)) s7_error(sc, sc->read_error_symbol, - set_elist_2(sc, wrap_string(sc, "overflow while reading #nD: ~A", 30), wrap_integer(dims))); + set_elist_2(sc, wrap_string(sc, "overflow while reading #nD: ~A", 30), wrap_integer1(sc, dims))); sc->strbuf[loc++] = d; } sc->strbuf[loc++] = d; @@ -58687,7 +60747,7 @@ static s7_pointer read_expression(s7_scheme *sc) switch (sc->tok) { case TOKEN_EOF: - return(sc->eof_object); + return(eof_object); case TOKEN_BYTE_VECTOR: push_stack_no_let_no_code(sc, OP_READ_BYTE_VECTOR, sc->nil); /* assume 1-dim for now */ @@ -59002,8 +61062,8 @@ static s7_pointer assign_syntax(s7_scheme *sc, const char *name, opcode_t op, s7 loc = hash % SYMBOL_TABLE_SIZE; x = new_symbol(sc, name, safe_strlen(name), hash, loc); - syn = alloc_pointer(); - unheap(syn); + syn = alloc_pointer(sc); + unheap(sc, syn); set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS | T_GLOBAL); syntax_opcode(syn) = op; syntax_set_symbol(syn, x); @@ -59011,8 +61071,8 @@ static s7_pointer assign_syntax(s7_scheme *sc, const char *name, opcode_t op, s7 syntax_max_args(syn) = ((max_args == max_arity) ? -1 : integer(max_args)); syntax_documentation(syn) = doc; - set_global_slot(x, permanent_slot(x, syn)); - set_initial_slot(x, permanent_slot(x, syn)); + set_global_slot(x, permanent_slot(sc, x, syn)); + set_initial_slot(x, permanent_slot(sc, x, syn)); /* set_local_slot(x, global_slot(x)); */ typeflag(x) = T_SYMBOL | T_SYNTACTIC | T_GLOBAL; symbol_set_local_unchecked(x, 0LL, sc->nil); @@ -59062,7 +61122,6 @@ static s7_pointer g_pair_filename(s7_scheme *sc, s7_pointer args) } -static s7_pointer is_pair_car_s, is_pair_cdr_s, is_pair_cddr_s, is_pair_cadr_s, is_null_cadr_s, is_null_cddr_s, is_symbol_cadr_s; static s7_pointer g_is_pair_car_s(s7_scheme *sc, s7_pointer args) { s7_pointer val; @@ -59137,28 +61196,27 @@ static s7_pointer is_pair_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ if (g == g_car) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_pair_car_s); + return(sc->is_pair_car_s); } if (g == g_cdr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_pair_cdr_s); + return(sc->is_pair_cdr_s); } if (g == g_cddr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_pair_cddr_s); + return(sc->is_pair_cddr_s); } if (g == g_cadr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_pair_cadr_s); + return(sc->is_pair_cadr_s); } } return(f); } -static s7_pointer is_null_cdr; static s7_pointer g_is_null_cdr(s7_scheme *sc, s7_pointer args) { s7_pointer val; @@ -59178,17 +61236,17 @@ static s7_pointer is_null_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ if (g == g_cdr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_null_cdr); + return(sc->is_null_cdr); } if (g == g_cddr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_null_cddr_s); + return(sc->is_null_cddr_s); } if (g == g_cadr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_null_cadr_s); + return(sc->is_null_cadr_s); } } return(f); @@ -59204,13 +61262,12 @@ static s7_pointer is_symbol_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s if (g == g_cadr) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_symbol_cadr_s); + return(sc->is_symbol_cadr_s); } } return(f); } -static s7_pointer format_allg, format_allg_no_column, format_just_control_string, format_as_objstr; static s7_pointer g_format_allg(s7_scheme *sc, s7_pointer args) { return(g_format_1(sc, args)); @@ -59308,7 +61365,7 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p { if (s7_is_boolean(port)) set_optimize_op(expr, HOP_SAFE_C_C); - return(format_just_control_string); + return(sc->format_just_control_string); } return(f); } @@ -59324,7 +61381,7 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p string_length(str_arg) = len - 1; if (s7_is_boolean(port)) set_optimize_op(expr, HOP_SAFE_C_C); - return(format_just_control_string); + return(sc->format_just_control_string); } if ((args == 3) && @@ -59332,19 +61389,18 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p (port == sc->F) && (orig[0] == '~') && ((orig[1] == 'A') || (orig[1] == 'a'))) - return(format_as_objstr); + return(sc->format_as_objstr); } /* this used to worry about optimized expr and particular cases -- why? I can't find a broken case */ if (!is_columnizing(string_value(str_arg))) - return(format_allg_no_column); - return(format_allg); + return(sc->format_allg_no_column); + return(sc->format_allg); } } return(f); } -static s7_pointer is_eq_car, is_eq_car_q, is_eq_caar_q; static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args) { s7_pointer lst, val; @@ -59385,7 +61441,7 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po (c_callee(cadr(expr)) == g_car)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(is_eq_car); + return(sc->is_eq_car); } if (is_proper_quote(sc, caddr(expr))) { @@ -59395,14 +61451,14 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym2(cdr(expr), cadr(cadr(expr))); /* cadr(expr) is hop_safe_c_s */ set_opt_any3(cdr(expr), cadr(caddr(expr))); /* but cadr(caddr(expr)) might not be a symbol */ - return(is_eq_car_q); + return(sc->is_eq_car_q); } if (c_callee(cadr(expr)) == g_caar) { set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym2(cdr(expr), cadr(cadr(expr))); set_opt_any3(cdr(expr), cadr(caddr(expr))); - return(is_eq_caar_q); + return(sc->is_eq_caar_q); } } } @@ -59410,8 +61466,6 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po } -static s7_pointer not_is_pair_s, not_is_symbol_s, not_is_null_s, not_is_number_s, not_is_eq_sq, not_is_eq_ss; - static s7_pointer g_not_is_pair_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->is_pair_symbol, args);} static s7_pointer g_not_is_null_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_null, sc->is_null_symbol, args);} static s7_pointer g_not_is_symbol_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_symbol, sc->is_symbol_symbol, args);} @@ -59429,7 +61483,6 @@ static s7_pointer g_not_is_eq_ss(s7_scheme *sc, s7_pointer args) } /* here the method finder is in either car or cdr */ -static s7_pointer not_is_pair_car_s; static s7_pointer g_not_is_pair_car_s(s7_scheme *sc, s7_pointer args) { s7_pointer val; @@ -59439,7 +61492,6 @@ static s7_pointer g_not_is_pair_car_s(s7_scheme *sc, s7_pointer args) return(make_boolean(sc, !is_pair(car(val)))); } -static s7_pointer not_c_c; static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args) { /* args: ( (null? l) ) */ @@ -59459,17 +61511,17 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin if (f == g_is_pair) { set_optimize_op(expr, HOP_SAFE_C_C); - return(not_is_pair_s); + return(sc->not_is_pair_s); } if (f == g_is_null) { set_optimize_op(expr, HOP_SAFE_C_C); - return(not_is_null_s); + return(sc->not_is_null_s); } if (f == g_is_symbol) { set_optimize_op(expr, HOP_SAFE_C_C); - return(not_is_symbol_s); + return(sc->not_is_symbol_s); } /* g_is_number is c_function_call(slot_value(global_slot(sc->is_number_symbol))) @@ -59479,7 +61531,7 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin if ((f == g_is_number) || (f == g_is_complex)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(not_is_number_s); + return(sc->not_is_number_s); } } if ((optimize_op(cadr(expr)) == HOP_SAFE_C_SQ) && @@ -59487,7 +61539,7 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin { set_optimize_op(expr, HOP_SAFE_C_C); set_opt_con2(cdr(expr), cadr(caddr(cadr(expr)))); - return(not_is_eq_sq); + return(sc->not_is_eq_sq); } if (optimize_op(cadr(expr)) == HOP_SAFE_C_SS) { @@ -59495,15 +61547,15 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin { set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym3(cdr(expr), caddr(cadr(expr))); - return(not_is_eq_ss); + return(sc->not_is_eq_ss); } } if (is_h_safe_c_c(cadr(expr))) { set_optimize_op(expr, HOP_SAFE_C_C); if (c_callee(cadr(expr)) == g_is_pair_car_s) - return(not_is_pair_car_s); - return(not_c_c); + return(sc->not_is_pair_car_s); + return(sc->not_c_c); } } return(g); @@ -59529,11 +61581,11 @@ static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, set_optimize_op(expr, HOP_SAFE_C_C); switch (s7_integer(arg2)) /* (might be big int) */ { - case 0: return(vector_ref_ic_0); - case 1: return(vector_ref_ic_1); - case 2: return(vector_ref_ic_2); - case 3: return(vector_ref_ic_3); - default: return(vector_ref_ic); + case 0: return(sc->vector_ref_ic_0); + case 1: return(sc->vector_ref_ic_1); + case 2: return(sc->vector_ref_ic_2); + case 3: return(sc->vector_ref_ic_3); + default: return(sc->vector_ref_ic); } } if ((is_possibly_constant(arg1)) && @@ -59543,12 +61595,12 @@ static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, v = slot_value(local_slot(arg1)); if ((is_normal_vector(v)) && (vector_rank(v) == 1)) - return(vector_ref_2_direct); + return(sc->vector_ref_2_direct); } } } /* vector_ref_sub1 was not worth the code, and few other easily optimized expressions happen here */ - return(vector_ref_2); + return(sc->vector_ref_2); } return(f); } @@ -59574,10 +61626,10 @@ static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, (s7_integer(arg2) >= 0)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(vector_set_ic); + return(sc->vector_set_ic); } } - return(vector_set_3); + return(sc->vector_set_3); } return(f); } @@ -59589,7 +61641,7 @@ static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 (s7_is_integer(caddr(expr))) && (s7_integer(caddr(expr)) >= 0) && (s7_integer(caddr(expr)) < sc->max_list_length)) - return(list_set_ic); + return(sc->list_set_ic); return(f); } @@ -59613,7 +61665,7 @@ static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t ar (is_symbol(caddr(expr))))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(hash_table_ref_ss); + return(sc->hash_table_ref_ss); } if (((optimize_op(expr) == HOP_SAFE_C_S_opSq) || ((is_h_safe_c_c(expr)) && (is_symbol(cadr(expr))))) && @@ -59622,10 +61674,10 @@ static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t ar { set_optimize_op(expr, HOP_SAFE_C_C); set_opt_sym3(cdr(expr), cadr(caddr(expr))); - return(hash_table_ref_car); + return(sc->hash_table_ref_car); } } - return(hash_table_ref_2); + return(sc->hash_table_ref_2); } return(f); } @@ -59642,7 +61694,7 @@ static s7_pointer modulo_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p (integer(caddr(expr)) > 1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(mod_si); + return(sc->mod_si); } return(f); } @@ -59667,12 +61719,12 @@ static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(add_cs1); + return(sc->add_cs1); } - return(add_s1); + return(sc->add_s1); } if (arg1 == small_int(1)) - return(add_1s); + return(sc->add_1s); if (s7_is_integer(arg2)) { @@ -59680,7 +61732,7 @@ static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(add_si); + return(sc->add_si); } } @@ -59689,7 +61741,7 @@ static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(add_sf); + return(sc->add_sf); } if (is_t_real(arg1)) @@ -59698,17 +61750,17 @@ static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin ((is_h_safe_c_c(expr)) && (is_symbol(arg2)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(add_fs); + return(sc->add_fs); } if ((is_h_safe_c_c(arg2)) && (c_callee(arg2) == g_multiply_sf)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(add_f_sf); + return(sc->add_f_sf); } } } - return(add_2); + return(sc->add_2); } #endif return(f); @@ -59734,19 +61786,19 @@ static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 if (s7_is_integer(arg2)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(multiply_si); + return(sc->multiply_si); } if (is_t_real(arg2)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(multiply_sf); + return(sc->multiply_sf); } } if ((arg1 == arg2) && ((optimize_op(expr) == HOP_SAFE_C_SS) || (is_h_safe_c_c(expr)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(sqr_ss); + return(sc->sqr_ss); } } @@ -59758,17 +61810,17 @@ static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 if (s7_is_integer(arg1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(multiply_is); + return(sc->multiply_is); } if (is_t_real(arg1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(multiply_fs); + return(sc->multiply_fs); } } } } - return(multiply_2); + return(sc->multiply_2); } #endif return(f); @@ -59779,7 +61831,7 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 { #if (!WITH_GMP) if (args == 1) - return(subtract_1); + return(sc->subtract_1); if (args == 2) { @@ -59795,9 +61847,9 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(subtract_cs1); + return(sc->subtract_cs1); } - return(subtract_s1); + return(sc->subtract_s1); } if (is_t_real(arg2)) @@ -59806,7 +61858,7 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(subtract_sf); + return(sc->subtract_sf); } } @@ -59816,7 +61868,7 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 ((is_h_safe_c_c(expr)) && (is_symbol(arg2)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(subtract_fs); + return(sc->subtract_fs); } } @@ -59826,14 +61878,14 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7 ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(subtract_csn); + return(sc->subtract_csn); } } if (is_t_real(arg2)) - return(subtract_2f); + return(sc->subtract_2f); } - return(subtract_2); + return(sc->subtract_2); } #endif return(f); @@ -59844,7 +61896,7 @@ static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p { #if (!WITH_GMP) if (args == 1) - return(invert_1); + return(sc->invert_1); if (ops) { if (args == 2) @@ -59853,7 +61905,7 @@ static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_p arg1 = cadr(expr); if ((is_t_real(arg1)) && (real(arg1) == 1.0)) - return(divide_1r); + return(sc->divide_1r); } } #endif @@ -59882,7 +61934,7 @@ static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int32_t args, s7 if (is_h_safe_c_s(arg1)) { set_optimize_op(expr, HOP_SAFE_C_C); - return(equal_length_ic); + return(sc->equal_length_ic); } } } @@ -59890,12 +61942,12 @@ static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int32_t args, s7 ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(equal_s_ic); + return(sc->equal_s_ic); } - return(equal_2i); + return(sc->equal_2i); } } - return(equal_2); + return(sc->equal_2); } return(ur_f); } @@ -59917,18 +61969,18 @@ static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poi if (fc == g_length) { set_optimize_op(expr, HOP_SAFE_C_C); - return(less_length_ic); + return(sc->less_length_ic); } } if (integer(arg2) == 0) - return(less_s0); + return(sc->less_s0); if ((integer(arg2) < s7_int32_max) && (integer(arg2) > s7_int32_min)) - return(less_s_ic); + return(sc->less_s_ic); } } - return(less_2); + return(sc->less_2); } return(f); } @@ -59945,9 +61997,9 @@ static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin if ((is_integer(arg2)) && (integer(arg2) < s7_int32_max) && (integer(arg2) > s7_int32_min)) - return(leq_s_ic); + return(sc->leq_s_ic); } - return(leq_2); + return(sc->leq_2); } return(f); } @@ -59965,14 +62017,14 @@ static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_ if ((is_integer(arg2)) && (integer(arg2) < s7_int32_max) && (integer(arg2) > s7_int32_min)) - return(greater_s_ic); + return(sc->greater_s_ic); if ((is_t_real(arg2)) && (real(arg2) < s7_int32_max) && (real(arg2) > s7_int32_min)) - return(greater_s_fc); + return(sc->greater_s_fc); } - return(greater_2); + return(sc->greater_2); } return(f); } @@ -59989,13 +62041,13 @@ static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_poin if ((is_integer(arg2)) && (integer(arg2) < s7_int32_max) && (integer(arg2) > s7_int32_min)) - return(geq_s_ic); + return(sc->geq_s_ic); if ((is_t_real(arg2)) && (real(arg2) < s7_int32_max) && (real(arg2) > s7_int32_min)) - return(geq_s_fc); + return(sc->geq_s_fc); } - return(geq_2); + return(sc->geq_2); } return(f); } @@ -60029,17 +62081,17 @@ static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int32_t args, arg1 = cadr(expr); arg2 = caddr(expr); if ((returns_char(sc, arg1)) && (returns_char(sc, arg2))) - return(simple_char_eq); + return(sc->simple_char_eq); if (((optimize_op(expr) == HOP_SAFE_C_SC) || ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) && (s7_is_character(arg2))) { set_optimize_op(expr, HOP_SAFE_C_C); - return(char_equal_s_ic); + return(sc->char_equal_s_ic); } } - return(char_equal_2); + return(sc->char_equal_2); } return(f); } @@ -60047,21 +62099,22 @@ static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int32_t args, static s7_pointer char_less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(char_less_2); + return(sc->char_less_2); return(f); } static s7_pointer char_greater_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(char_greater_2); + return(sc->char_greater_2); return(f); } static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr) { - s7_pointer p, np = NULL, arg; - int32_t pairs = 0; + s7_pointer nps[NUM_STRING_WRAPPERS]; + s7_pointer p, arg; + int32_t pairs = 0, substrs = 0; /* a bit tricky -- accept temp only if there's just one inner expression and it calls substring * and don't use this for arg if arg is returned: (reverse! (write-string (symbol->string x))) */ @@ -60075,19 +62128,27 @@ static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr) (is_safely_optimized(arg))) { if (c_callee(arg) == g_substring) - np = arg; + { + if (substrs < NUM_STRING_WRAPPERS) + nps[substrs++] = arg; + } else { if (c_callee(arg) == g_symbol_to_string) - set_c_function(arg, symbol_to_string_uncopied); + set_c_function(arg, sc->symbol_to_string_uncopied); else { if ((c_callee(arg) == g_read_line) && (is_pair(cdr(arg)))) - set_c_function(arg, read_line_uncopied); + set_c_function(arg, sc->read_line_uncopied); }}}}} - if ((pairs == 1) && (np)) - set_c_function(np, substring_to_temp); + if ((pairs > 0) && + (pairs == substrs)) + { + int32_t i; + for (i = 0; i < substrs; i++) + set_c_function(nps[i], sc->substring_to_temp); + } } static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) @@ -60095,7 +62156,7 @@ static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int32_t arg if (!ops) return(f); if (((args == 2) || (args == 3)) && (s7_is_character(cadr(expr)))) - return(char_position_csi); + return(sc->char_position_csi); return(f); } @@ -60103,7 +62164,7 @@ static s7_pointer string_equal_chooser(s7_scheme *sc, s7_pointer f, int32_t args { check_for_substring_temp(sc, expr); if (args == 2) - return(string_equal_2); + return(sc->string_equal_2); return(f); } @@ -60111,7 +62172,7 @@ static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int32_t args, { check_for_substring_temp(sc, expr); if (args == 2) - return(string_less_2); + return(sc->string_less_2); return(f); } @@ -60119,30 +62180,18 @@ static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int32_t ar { check_for_substring_temp(sc, expr); if (args == 2) - return(string_greater_2); - return(f); -} - -static s7_pointer string_to_symbol_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) -{ - check_for_substring_temp(sc, expr); + return(sc->string_greater_2); return(f); } - -static s7_pointer string_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) +static s7_pointer string_substring_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { + /* used by several string functions */ check_for_substring_temp(sc, expr); return(f); } -static s7_pointer string_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) -{ - return(f); -} - -static s7_pointer or_n, or_2, or_3; static s7_pointer g_or_n(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60177,7 +62226,6 @@ static s7_pointer g_or_3(s7_scheme *sc, s7_pointer args) return(c_call(p)(sc, car(p))); } -static s7_pointer and_n, and_2, and_sc, and_3; static s7_pointer g_and_n(s7_scheme *sc, s7_pointer args) { s7_pointer p, x; @@ -60221,7 +62269,6 @@ static s7_pointer g_and_sc(s7_scheme *sc, s7_pointer args) return(c_call(p)(sc, cdr(p))); } -static s7_pointer if_x1; static s7_pointer g_if_x1(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60231,7 +62278,6 @@ static s7_pointer g_if_x1(s7_scheme *sc, s7_pointer args) return(c_call(p)(sc, car(p))); } -static s7_pointer if_x2; static s7_pointer g_if_x2(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60242,7 +62288,6 @@ static s7_pointer g_if_x2(s7_scheme *sc, s7_pointer args) } -static s7_pointer if_not_x1; static s7_pointer g_if_not_x1(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60252,7 +62297,6 @@ static s7_pointer g_if_not_x1(s7_scheme *sc, s7_pointer args) return(c_call(p)(sc, car(p))); } -static s7_pointer if_not_x2; static s7_pointer g_if_not_x2(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60262,7 +62306,6 @@ static s7_pointer g_if_not_x2(s7_scheme *sc, s7_pointer args) return(c_call(p)(sc, car(p))); } -static s7_pointer if_x_qq; static s7_pointer g_if_x_qq(s7_scheme *sc, s7_pointer args) { if (is_true(sc, c_call(args)(sc, car(args)))) @@ -60270,14 +62313,13 @@ static s7_pointer g_if_x_qq(s7_scheme *sc, s7_pointer args) return(cadr(caddr(args))); } -static s7_pointer if_x_qa; static s7_pointer g_if_x_qa(s7_scheme *sc, s7_pointer args) { if (is_true(sc, c_call(args)(sc, car(args)))) return(cadadr(args)); return(c_call(cddr(args))(sc, caddr(args))); } -static s7_pointer or_s_direct; + static s7_pointer g_or_s_direct(s7_scheme *sc, s7_pointer args) { s7_pointer p; @@ -60292,8 +62334,22 @@ static s7_pointer g_or_s_direct(s7_scheme *sc, s7_pointer args) return(sc->F); } +static s7_pointer g_or_s_direct_2(s7_scheme *sc, s7_pointer args) +{ + s7_pointer x; + set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadar(args))); + x = c_call(car(args))(sc, sc->t1_1); + if (is_true(sc, x)) return(x); + return(c_call(cadr(args))(sc, sc->t1_1)); +} + +static s7_pointer g_or_s_type_2(s7_scheme *sc, s7_pointer args) +{ + s7_pointer x; + x = symbol_to_value_unchecked(sc, cadar(args)); + return(make_boolean(sc, (type(x) == symbol_type(caar(args))) || (type(x) == symbol_type(caadr(args))))); +} -static s7_pointer and_s_direct; static s7_pointer g_and_s_direct(s7_scheme *sc, s7_pointer args) { s7_pointer p, x = sc->T; @@ -60307,6 +62363,15 @@ static s7_pointer g_and_s_direct(s7_scheme *sc, s7_pointer args) return(x); } +static s7_pointer g_and_s_direct_2(s7_scheme *sc, s7_pointer args) +{ + s7_pointer x; + set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadar(args))); + x = c_call(car(args))(sc, sc->t1_1); + if (is_false(sc, x)) return(x); + return(c_call(cadr(args))(sc, sc->t1_1)); +} + static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc) @@ -60338,278 +62403,281 @@ static void init_choosers(s7_scheme *sc) f = set_function_chooser(sc, sc->add_symbol, add_chooser); sc->add_class = c_function_class(f); - add_2 = make_function_with_class(sc, f, "+", g_add_2, 2, 0, false, "+ opt"); - add_1s = make_function_with_class(sc, f, "+", g_add_1s, 2, 0, false, "+ opt"); - add_s1 = make_function_with_class(sc, f, "+", g_add_s1, 2, 0, false, "+ opt"); - add_cs1 = make_function_with_class(sc, f, "+", g_add_cs1, 2, 0, false, "+ opt"); - add_si = make_function_with_class(sc, f, "+", g_add_si, 2, 0, false, "+ opt"); - add_sf = make_function_with_class(sc, f, "+", g_add_sf, 2, 0, false, "+ opt"); - add_fs = make_function_with_class(sc, f, "+", g_add_fs, 2, 0, false, "+ opt"); - add_f_sf = make_function_with_class(sc, f, "+", g_add_f_sf, 2, 0, false, "+ opt"); + sc->add_2 = make_function_with_class(sc, f, "+", g_add_2, 2, 0, false, "+ opt"); + sc->add_1s = make_function_with_class(sc, f, "+", g_add_1s, 2, 0, false, "+ opt"); + sc->add_s1 = make_function_with_class(sc, f, "+", g_add_s1, 2, 0, false, "+ opt"); + sc->add_cs1 = make_function_with_class(sc, f, "+", g_add_cs1, 2, 0, false, "+ opt"); + sc->add_si = make_function_with_class(sc, f, "+", g_add_si, 2, 0, false, "+ opt"); + sc->add_sf = make_function_with_class(sc, f, "+", g_add_sf, 2, 0, false, "+ opt"); + sc->add_fs = make_function_with_class(sc, f, "+", g_add_fs, 2, 0, false, "+ opt"); + sc->add_f_sf = make_function_with_class(sc, f, "+", g_add_f_sf, 2, 0, false, "+ opt"); /* - */ f = set_function_chooser(sc, sc->subtract_symbol, subtract_chooser); sc->subtract_class = c_function_class(f); - subtract_1 = make_function_with_class(sc, f, "-", g_subtract_1, 1, 0, false, "- opt"); - subtract_2 = make_function_with_class(sc, f, "-", g_subtract_2, 2, 0, false, "- opt"); - subtract_s1 = make_function_with_class(sc, f, "-", g_subtract_s1, 2, 0, false, "- opt"); - subtract_cs1 = make_function_with_class(sc, f, "-", g_subtract_cs1, 2, 0, false, "- opt"); - subtract_csn = make_function_with_class(sc, f, "-", g_subtract_csn, 2, 0, false, "- opt"); - subtract_sf = make_function_with_class(sc, f, "-", g_subtract_sf, 2, 0, false, "- opt"); - subtract_2f = make_function_with_class(sc, f, "-", g_subtract_2f, 2, 0, false, "- opt"); - subtract_fs = make_function_with_class(sc, f, "-", g_subtract_fs, 2, 0, false, "- opt"); + sc->subtract_1 = make_function_with_class(sc, f, "-", g_subtract_1, 1, 0, false, "- opt"); + sc->subtract_2 = make_function_with_class(sc, f, "-", g_subtract_2, 2, 0, false, "- opt"); + sc->subtract_s1 = make_function_with_class(sc, f, "-", g_subtract_s1, 2, 0, false, "- opt"); + sc->subtract_cs1 = make_function_with_class(sc, f, "-", g_subtract_cs1, 2, 0, false, "- opt"); + sc->subtract_csn = make_function_with_class(sc, f, "-", g_subtract_csn, 2, 0, false, "- opt"); + sc->subtract_sf = make_function_with_class(sc, f, "-", g_subtract_sf, 2, 0, false, "- opt"); + sc->subtract_2f = make_function_with_class(sc, f, "-", g_subtract_2f, 2, 0, false, "- opt"); + sc->subtract_fs = make_function_with_class(sc, f, "-", g_subtract_fs, 2, 0, false, "- opt"); /* * */ f = set_function_chooser(sc, sc->multiply_symbol, multiply_chooser); sc->multiply_class = c_function_class(f); #if (!WITH_GMP) - multiply_2 = make_function_with_class(sc, f, "*", g_multiply_2, 2, 0, false, "* opt"); - multiply_is = make_function_with_class(sc, f, "*", g_multiply_is, 2, 0, false, "* opt"); - multiply_si = make_function_with_class(sc, f, "*", g_multiply_si, 2, 0, false, "* opt"); - multiply_fs = make_function_with_class(sc, f, "*", g_multiply_fs, 2, 0, false, "* opt"); - multiply_sf = make_function_with_class(sc, f, "*", g_multiply_sf, 2, 0, false, "* opt"); + sc->multiply_2 = make_function_with_class(sc, f, "*", g_multiply_2, 2, 0, false, "* opt"); + sc->multiply_is = make_function_with_class(sc, f, "*", g_multiply_is, 2, 0, false, "* opt"); + sc->multiply_si = make_function_with_class(sc, f, "*", g_multiply_si, 2, 0, false, "* opt"); + sc->multiply_fs = make_function_with_class(sc, f, "*", g_multiply_fs, 2, 0, false, "* opt"); + sc->multiply_sf = make_function_with_class(sc, f, "*", g_multiply_sf, 2, 0, false, "* opt"); - sqr_ss = make_function_with_class(sc, f, "*", g_sqr_ss, 2, 0, false, "* opt"); + sc->sqr_ss = make_function_with_class(sc, f, "*", g_sqr_ss, 2, 0, false, "* opt"); #endif /* / */ f = set_function_chooser(sc, sc->divide_symbol, divide_chooser); #if (!WITH_GMP) - invert_1 = make_function_with_class(sc, f, "/", g_invert_1, 1, 0, false, "/ opt"); - divide_1r = make_function_with_class(sc, f, "/", g_divide_1r, 2, 0, false, "/ opt"); + sc->invert_1 = make_function_with_class(sc, f, "/", g_invert_1, 1, 0, false, "/ opt"); + sc->divide_1r = make_function_with_class(sc, f, "/", g_divide_1r, 2, 0, false, "/ opt"); /* modulo */ f = set_function_chooser(sc, sc->modulo_symbol, modulo_chooser); - mod_si = make_function_with_class(sc, f, "modulo", g_mod_si, 2, 0, false, "modulo opt"); + sc->mod_si = make_function_with_class(sc, f, "modulo", g_mod_si, 2, 0, false, "modulo opt"); /* = */ f = set_function_chooser(sc, sc->eq_symbol, equal_chooser); sc->equal_class = c_function_class(f); - equal_s_ic = make_function_with_class(sc, f, "=", g_equal_s_ic, 2, 0, false, "= opt"); - equal_length_ic = make_function_with_class(sc, f, "=", g_equal_length_ic, 2, 0, false, "= opt"); - equal_2 = make_function_with_class(sc, f, "=", g_equal_2, 2, 0, false, "= opt"); - equal_2i = make_function_with_class(sc, f, "=", g_equal_2i, 2, 0, false, "= opt"); + sc->equal_s_ic = make_function_with_class(sc, f, "=", g_equal_s_ic, 2, 0, false, "= opt"); + sc->equal_length_ic = make_function_with_class(sc, f, "=", g_equal_length_ic, 2, 0, false, "= opt"); + sc->equal_2 = make_function_with_class(sc, f, "=", g_equal_2, 2, 0, false, "= opt"); + sc->equal_2i = make_function_with_class(sc, f, "=", g_equal_2i, 2, 0, false, "= opt"); /* < */ f = set_function_chooser(sc, sc->lt_symbol, less_chooser); - less_s_ic = make_function_with_class(sc, f, "<", g_less_s_ic, 2, 0, false, "< opt"); - less_s0 = make_function_with_class(sc, f, "<", g_less_s0, 2, 0, false, "< opt"); - less_2 = make_function_with_class(sc, f, "<", g_less_2, 2, 0, false, "< opt"); - less_length_ic = make_function_with_class(sc, f, "<", g_less_length_ic, 2, 0, false, "< opt"); + sc->less_s_ic = make_function_with_class(sc, f, "<", g_less_s_ic, 2, 0, false, "< opt"); + sc->less_s0 = make_function_with_class(sc, f, "<", g_less_s0, 2, 0, false, "< opt"); + sc->less_2 = make_function_with_class(sc, f, "<", g_less_2, 2, 0, false, "< opt"); + sc->less_length_ic = make_function_with_class(sc, f, "<", g_less_length_ic, 2, 0, false, "< opt"); /* > */ f = set_function_chooser(sc, sc->gt_symbol, greater_chooser); - greater_s_ic = make_function_with_class(sc, f, ">", g_greater_s_ic, 2, 0, false, "> opt"); - greater_s_fc = make_function_with_class(sc, f, ">", g_greater_s_fc, 2, 0, false, "> opt"); - greater_2 = make_function_with_class(sc, f, ">", g_greater_2, 2, 0, false, "> opt"); + sc->greater_s_ic = make_function_with_class(sc, f, ">", g_greater_s_ic, 2, 0, false, "> opt"); + sc->greater_s_fc = make_function_with_class(sc, f, ">", g_greater_s_fc, 2, 0, false, "> opt"); + sc->greater_2 = make_function_with_class(sc, f, ">", g_greater_2, 2, 0, false, "> opt"); /* <= */ f = set_function_chooser(sc, sc->leq_symbol, leq_chooser); - leq_s_ic = make_function_with_class(sc, f, "<=", g_leq_s_ic, 2, 0, false, "<= opt"); - leq_2 = make_function_with_class(sc, f, "<=", g_leq_2, 2, 0, false, "<= opt"); + sc->leq_s_ic = make_function_with_class(sc, f, "<=", g_leq_s_ic, 2, 0, false, "<= opt"); + sc->leq_2 = make_function_with_class(sc, f, "<=", g_leq_2, 2, 0, false, "<= opt"); /* >= */ f = set_function_chooser(sc, sc->geq_symbol, geq_chooser); - geq_s_ic = make_function_with_class(sc, f, ">=", g_geq_s_ic, 2, 0, false, ">= opt"); - geq_s_fc = make_function_with_class(sc, f, ">=", g_geq_s_fc, 2, 0, false, ">= opt"); - geq_2 = make_function_with_class(sc, f, ">=", g_geq_2, 2, 0, false, ">= opt"); + sc->geq_s_ic = make_function_with_class(sc, f, ">=", g_geq_s_ic, 2, 0, false, ">= opt"); + sc->geq_s_fc = make_function_with_class(sc, f, ">=", g_geq_s_fc, 2, 0, false, ">= opt"); + sc->geq_2 = make_function_with_class(sc, f, ">=", g_geq_2, 2, 0, false, ">= opt"); /* random */ f = set_function_chooser(sc, sc->random_symbol, random_chooser); - random_ic = make_function_with_class(sc, f, "random", g_random_ic, 1, 0, false, "random opt"); - random_rc = make_function_with_class(sc, f, "random", g_random_rc, 1, 0, false, "random opt"); + sc->random_ic = make_function_with_class(sc, f, "random", g_random_ic, 1, 0, false, "random opt"); + sc->random_rc = make_function_with_class(sc, f, "random", g_random_rc, 1, 0, false, "random opt"); #endif /* char=? */ f = set_function_chooser(sc, sc->char_eq_symbol, char_equal_chooser); - simple_char_eq = make_function_with_class(sc, f, "char=?", g_simple_char_eq, 2, 0, false, "char=? opt"); - char_equal_s_ic = make_function_with_class(sc, f, "char=?", g_char_equal_s_ic, 2, 0, false, "char=? opt"); - char_equal_2 = make_function_with_class(sc, f, "char=?", g_char_equal_2, 2, 0, false, "char=? opt"); + sc->simple_char_eq = make_function_with_class(sc, f, "char=?", g_simple_char_eq, 2, 0, false, "char=? opt"); + sc->char_equal_s_ic = make_function_with_class(sc, f, "char=?", g_char_equal_s_ic, 2, 0, false, "char=? opt"); + sc->char_equal_2 = make_function_with_class(sc, f, "char=?", g_char_equal_2, 2, 0, false, "char=? opt"); /* char>? */ f = set_function_chooser(sc, sc->char_gt_symbol, char_greater_chooser); - char_greater_2 = make_function_with_class(sc, f, "char>?", g_char_greater_2, 2, 0, false, "char>? opt"); + sc->char_greater_2 = make_function_with_class(sc, f, "char>?", g_char_greater_2, 2, 0, false, "char>? opt"); /* char<? */ f = set_function_chooser(sc, sc->char_lt_symbol, char_less_chooser); - char_less_2 = make_function_with_class(sc, f, "char<?", g_char_less_2, 2, 0, false, "char<? opt"); + sc->char_less_2 = make_function_with_class(sc, f, "char<?", g_char_less_2, 2, 0, false, "char<? opt"); /* char-position */ f = set_function_chooser(sc, sc->char_position_symbol, char_position_chooser); - char_position_csi = make_function_with_class(sc, f, "char-position", g_char_position_csi, 2, 1, false, "char-position opt"); - - /* string->symbol */ - set_function_chooser(sc, sc->string_to_symbol_symbol, string_to_symbol_chooser); + sc->char_position_csi = make_function_with_class(sc, f, "char-position", g_char_position_csi, 2, 1, false, "char-position opt"); /* string=? */ f = set_function_chooser(sc, sc->string_eq_symbol, string_equal_chooser); - string_equal_2 = make_function_with_class(sc, f, "string=?", g_string_equal_2, 2, 0, false, "string=? opt"); + sc->string_equal_2 = make_function_with_class(sc, f, "string=?", g_string_equal_2, 2, 0, false, "string=? opt"); /* substring */ - substring_to_temp = s7_make_function(sc, "substring", g_substring_to_temp, 2, 1, false, "substring opt"); - s7_function_set_class(substring_to_temp, slot_value(global_slot(sc->substring_symbol))); + sc->substring_to_temp = s7_make_function(sc, "substring", g_substring_to_temp, 2, 1, false, "substring opt"); + s7_function_set_class(sc->substring_to_temp, slot_value(global_slot(sc->substring_symbol))); /* string>? */ f = set_function_chooser(sc, sc->string_gt_symbol, string_greater_chooser); - string_greater_2 = make_function_with_class(sc, f, "string>?", g_string_greater_2, 2, 0, false, "string>? opt"); + sc->string_greater_2 = make_function_with_class(sc, f, "string>?", g_string_greater_2, 2, 0, false, "string>? opt"); /* string<? */ f = set_function_chooser(sc, sc->string_lt_symbol, string_less_chooser); - string_less_2 = make_function_with_class(sc, f, "string<?", g_string_less_2, 2, 0, false, "string<? opt"); + sc->string_less_2 = make_function_with_class(sc, f, "string<?", g_string_less_2, 2, 0, false, "string<? opt"); - /* string-ref */ - set_function_chooser(sc, sc->string_ref_symbol, string_ref_chooser); - - /* string-set! */ - set_function_chooser(sc, sc->string_set_symbol, string_set_chooser); + /* string-ref et al */ + set_function_chooser(sc, sc->string_ref_symbol, string_substring_chooser); + set_function_chooser(sc, sc->string_append_symbol, string_substring_chooser); + set_function_chooser(sc, sc->string_to_symbol_symbol, string_substring_chooser); +#if (!WITH_PURE_S7) + set_function_chooser(sc, sc->string_length_symbol, string_substring_chooser); + set_function_chooser(sc, sc->string_copy_symbol, string_substring_chooser); +#endif /* symbol->string */ f = slot_value(global_slot(sc->symbol_to_string_symbol)); - symbol_to_string_uncopied = s7_make_function(sc, "symbol->string", g_symbol_to_string_uncopied, 1, 0, false, "symbol->string opt"); - s7_function_set_class(symbol_to_string_uncopied, f); + sc->symbol_to_string_uncopied = s7_make_function(sc, "symbol->string", g_symbol_to_string_uncopied, 1, 0, false, "symbol->string opt"); + s7_function_set_class(sc->symbol_to_string_uncopied, f); /* vector-ref */ f = set_function_chooser(sc, sc->vector_ref_symbol, vector_ref_chooser); - vector_ref_ic = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic, 2, 0, false, "vector-ref opt"); - vector_ref_ic_0 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_0, 1, 0, false, "vector-ref opt"); - vector_ref_ic_1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_1, 1, 0, false, "vector-ref opt"); - vector_ref_ic_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_2, 1, 0, false, "vector-ref opt"); - vector_ref_ic_3 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_3, 1, 0, false, "vector-ref opt"); - vector_ref_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2, 2, 0, false, "vector-ref opt"); - vector_ref_2_direct = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2_direct, 2, 0, false, "vector-ref opt"); + sc->vector_ref_ic = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic, 2, 0, false, "vector-ref opt"); + sc->vector_ref_ic_0 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_0, 1, 0, false, "vector-ref opt"); + sc->vector_ref_ic_1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_1, 1, 0, false, "vector-ref opt"); + sc->vector_ref_ic_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_2, 1, 0, false, "vector-ref opt"); + sc->vector_ref_ic_3 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_3, 1, 0, false, "vector-ref opt"); + sc->vector_ref_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2, 2, 0, false, "vector-ref opt"); + sc->vector_ref_2_direct = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2_direct, 2, 0, false, "vector-ref opt"); /* vector-set! */ f = set_function_chooser(sc, sc->vector_set_symbol, vector_set_chooser); - vector_set_ic = make_function_with_class(sc, f, "vector-set!", g_vector_set_ic, 3, 0, false, "vector-set! opt"); - vector_set_3 = make_function_with_class(sc, f, "vector-set!", g_vector_set_3, 3, 0, false, "vector-set! opt"); + sc->vector_set_ic = make_function_with_class(sc, f, "vector-set!", g_vector_set_ic, 3, 0, false, "vector-set! opt"); + sc->vector_set_3 = make_function_with_class(sc, f, "vector-set!", g_vector_set_3, 3, 0, false, "vector-set! opt"); /* float-vector-ref */ f = set_function_chooser(sc, sc->float_vector_ref_symbol, float_vector_ref_chooser); - fv_ref = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref, 2, 0, false, "float-vector-ref opt"); - fv_ref_3 = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref_3, 3, 0, false, "float-vector-ref opt"); + sc->fv_ref = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref, 2, 0, false, "float-vector-ref opt"); + sc->fv_ref_3 = make_function_with_class(sc, f, "float-vector-ref", g_fv_ref_3, 3, 0, false, "float-vector-ref opt"); /* float-vector-set */ f = set_function_chooser(sc, sc->float_vector_set_symbol, float_vector_set_chooser); - fv_set = make_function_with_class(sc, f, "float-vector-set!", g_fv_set, 3, 0, false, "float-vector-set! opt"); + sc->fv_set = make_function_with_class(sc, f, "float-vector-set!", g_fv_set, 3, 0, false, "float-vector-set! opt"); + sc->fv_set_unchecked = make_function_with_class(sc, f, "float-vector-set!", g_fv_set_unchecked, 3, 0, false, "float-vector-set! opt"); /* int-vector-ref */ f = set_function_chooser(sc, sc->int_vector_ref_symbol, int_vector_ref_chooser); - iv_ref = make_function_with_class(sc, f, "int-vector-ref", g_iv_ref, 2, 0, false, "int-vector-ref opt"); + sc->iv_ref = make_function_with_class(sc, f, "int-vector-ref", g_iv_ref, 2, 0, false, "int-vector-ref opt"); /* int-vector-set */ f = set_function_chooser(sc, sc->int_vector_set_symbol, int_vector_set_chooser); - iv_set = make_function_with_class(sc, f, "int-vector-set!", g_iv_set, 3, 0, false, "int-vector-set! opt"); + sc->iv_set = make_function_with_class(sc, f, "int-vector-set!", g_iv_set, 3, 0, false, "int-vector-set! opt"); /* list-set! */ f = set_function_chooser(sc, sc->list_set_symbol, list_set_chooser); - list_set_ic = make_function_with_class(sc, f, "list-set!", g_list_set_ic, 3, 0, false, "list-set! opt"); + sc->list_set_ic = make_function_with_class(sc, f, "list-set!", g_list_set_ic, 3, 0, false, "list-set! opt"); /* hash-table-ref */ f = set_function_chooser(sc, sc->hash_table_ref_symbol, hash_table_ref_chooser); - hash_table_ref_2 = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_2, 2, 0, false, "hash-table-ref opt"); - hash_table_ref_ss = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_ss, 2, 0, false, "hash-table-ref opt"); - hash_table_ref_car = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_car, 2, 0, false, "hash-table-ref opt"); + sc->hash_table_ref_2 = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_2, 2, 0, false, "hash-table-ref opt"); + sc->hash_table_ref_ss = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_ss, 2, 0, false, "hash-table-ref opt"); + sc->hash_table_ref_car = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_car, 2, 0, false, "hash-table-ref opt"); /* format */ f = set_function_chooser(sc, sc->format_symbol, format_chooser); - format_allg = make_function_with_class(sc, f, "format", g_format_allg, 1, 0, true, "format opt"); - format_allg_no_column = make_function_with_class(sc, f, "format", g_format_allg_no_column, 1, 0, true, "format opt"); - format_just_control_string = make_function_with_class(sc, f, "format", g_format_just_control_string, 2, 0, false, "format opt"); - format_as_objstr = make_function_with_class(sc, f, "format", g_format_as_objstr, 3, 0, true, "format opt"); + sc->format_allg = make_function_with_class(sc, f, "format", g_format_allg, 1, 0, true, "format opt"); + sc->format_allg_no_column = make_function_with_class(sc, f, "format", g_format_allg_no_column, 1, 0, true, "format opt"); + sc->format_just_control_string = make_function_with_class(sc, f, "format", g_format_just_control_string, 2, 0, false, "format opt"); + sc->format_as_objstr = make_function_with_class(sc, f, "format", g_format_as_objstr, 3, 0, true, "format opt"); /* not */ f = set_function_chooser(sc, sc->not_symbol, not_chooser); - not_is_pair_s = make_function_with_class(sc, f, "not", g_not_is_pair_s, 1, 0, false, "not opt"); - not_is_null_s = make_function_with_class(sc, f, "not", g_not_is_null_s, 1, 0, false, "not opt"); - not_is_symbol_s = make_function_with_class(sc, f, "not", g_not_is_symbol_s, 1, 0, false, "not opt"); - not_is_number_s = make_function_with_class(sc, f, "not", g_not_is_number_s, 1, 0, false, "not opt"); - not_is_eq_ss = make_function_with_class(sc, f, "not", g_not_is_eq_ss, 1, 0, false, "not opt"); - not_is_eq_sq = make_function_with_class(sc, f, "not", g_not_is_eq_sq, 1, 0, false, "not opt"); - not_is_pair_car_s = make_function_with_class(sc, f, "not", g_not_is_pair_car_s, 1, 0, false, "not opt"); - not_c_c = make_function_with_class(sc, f, "not", g_not_c_c, 1, 0, false, "not opt"); + sc->not_is_pair_s = make_function_with_class(sc, f, "not", g_not_is_pair_s, 1, 0, false, "not opt"); + sc->not_is_null_s = make_function_with_class(sc, f, "not", g_not_is_null_s, 1, 0, false, "not opt"); + sc->not_is_symbol_s = make_function_with_class(sc, f, "not", g_not_is_symbol_s, 1, 0, false, "not opt"); + sc->not_is_number_s = make_function_with_class(sc, f, "not", g_not_is_number_s, 1, 0, false, "not opt"); + sc->not_is_eq_ss = make_function_with_class(sc, f, "not", g_not_is_eq_ss, 1, 0, false, "not opt"); + sc->not_is_eq_sq = make_function_with_class(sc, f, "not", g_not_is_eq_sq, 1, 0, false, "not opt"); + sc->not_is_pair_car_s = make_function_with_class(sc, f, "not", g_not_is_pair_car_s, 1, 0, false, "not opt"); + sc->not_c_c = make_function_with_class(sc, f, "not", g_not_c_c, 1, 0, false, "not opt"); /* pair? */ f = set_function_chooser(sc, sc->is_pair_symbol, is_pair_chooser); - is_pair_car_s = make_function_with_class(sc, f, "pair?", g_is_pair_car_s, 1, 0, false, "pair? opt"); - is_pair_cdr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cdr_s, 1, 0, false, "pair? opt"); - is_pair_cddr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cddr_s, 1, 0, false, "pair? opt"); - is_pair_cadr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cadr_s, 1, 0, false, "pair? opt"); + sc->is_pair_car_s = make_function_with_class(sc, f, "pair?", g_is_pair_car_s, 1, 0, false, "pair? opt"); + sc->is_pair_cdr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cdr_s, 1, 0, false, "pair? opt"); + sc->is_pair_cddr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cddr_s, 1, 0, false, "pair? opt"); + sc->is_pair_cadr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cadr_s, 1, 0, false, "pair? opt"); /* null? */ f = set_function_chooser(sc, sc->is_null_symbol, is_null_chooser); - is_null_cdr = make_function_with_class(sc, f, "null?", g_is_null_cdr, 1, 0, false, "null? opt"); - is_null_cddr_s = make_function_with_class(sc, f, "null?", g_is_null_cddr_s, 1, 0, false, "null? opt"); - is_null_cadr_s = make_function_with_class(sc, f, "null?", g_is_null_cadr_s, 1, 0, false, "null? opt"); + sc->is_null_cdr = make_function_with_class(sc, f, "null?", g_is_null_cdr, 1, 0, false, "null? opt"); + sc->is_null_cddr_s = make_function_with_class(sc, f, "null?", g_is_null_cddr_s, 1, 0, false, "null? opt"); + sc->is_null_cadr_s = make_function_with_class(sc, f, "null?", g_is_null_cadr_s, 1, 0, false, "null? opt"); /* symbol? */ f = set_function_chooser(sc, sc->is_symbol_symbol, is_symbol_chooser); - is_symbol_cadr_s = make_function_with_class(sc, f, "symbol?", g_is_symbol_cadr_s, 1, 0, false, "symbol? opt"); + sc->is_symbol_cadr_s = make_function_with_class(sc, f, "symbol?", g_is_symbol_cadr_s, 1, 0, false, "symbol? opt"); /* eq? */ f = set_function_chooser(sc, sc->is_eq_symbol, is_eq_chooser); - is_eq_car = make_function_with_class(sc, f, "eq?", g_is_eq_car, 2, 0, false, "eq? opt"); - is_eq_car_q = make_function_with_class(sc, f, "eq?", g_is_eq_car_q, 2, 0, false, "eq? opt"); - is_eq_caar_q = make_function_with_class(sc, f, "eq?", g_is_eq_caar_q, 2, 0, false, "eq? opt"); + sc->is_eq_car = make_function_with_class(sc, f, "eq?", g_is_eq_car, 2, 0, false, "eq? opt"); + sc->is_eq_car_q = make_function_with_class(sc, f, "eq?", g_is_eq_car_q, 2, 0, false, "eq? opt"); + sc->is_eq_caar_q = make_function_with_class(sc, f, "eq?", g_is_eq_caar_q, 2, 0, false, "eq? opt"); /* member */ f = set_function_chooser(sc, sc->member_symbol, member_chooser); - member_ss = make_function_with_class(sc, f, "member", g_member_ss, 2, 0, false, "member opt"); - member_sq = make_function_with_class(sc, f, "member", g_member_sq, 2, 0, false, "member opt"); + sc->member_ss = make_function_with_class(sc, f, "member", g_member_ss, 2, 0, false, "member opt"); + sc->member_sq = make_function_with_class(sc, f, "member", g_member_sq, 2, 0, false, "member opt"); /* memq */ f = set_function_chooser(sc, sc->memq_symbol, memq_chooser); /* is pure-s7, use member here */ - memq_2 = make_function_with_class(sc, f, "memq", g_memq_2, 2, 0, false, "memq opt"); - memq_3 = make_function_with_class(sc, f, "memq", g_memq_3, 2, 0, false, "memq opt"); - memq_4 = make_function_with_class(sc, f, "memq", g_memq_4, 2, 0, false, "memq opt"); - memq_any = make_function_with_class(sc, f, "memq", g_memq_any, 2, 0, false, "memq opt"); - memq_car = make_function_with_class(sc, f, "memq", g_memq_car, 2, 0, false, "memq opt"); - memq_car_2 = make_function_with_class(sc, f, "memq", g_memq_car_2, 2, 0, false, "memq opt"); + sc->memq_2 = make_function_with_class(sc, f, "memq", g_memq_2, 2, 0, false, "memq opt"); + sc->memq_3 = make_function_with_class(sc, f, "memq", g_memq_3, 2, 0, false, "memq opt"); + sc->memq_4 = make_function_with_class(sc, f, "memq", g_memq_4, 2, 0, false, "memq opt"); + sc->memq_any = make_function_with_class(sc, f, "memq", g_memq_any, 2, 0, false, "memq opt"); + sc->memq_car = make_function_with_class(sc, f, "memq", g_memq_car, 2, 0, false, "memq opt"); + sc->memq_car_2 = make_function_with_class(sc, f, "memq", g_memq_car_2, 2, 0, false, "memq opt"); /* tree-set-memq */ f = set_function_chooser(sc, sc->tree_set_memq_symbol, tree_set_memq_chooser); - tree_set_memq_syms = make_function_with_class(sc, f, "tree-set-memq", g_tree_set_memq_1, 2, 0, false, "tree-set-memq opt"); + sc->tree_set_memq_syms = make_function_with_class(sc, f, "tree-set-memq", g_tree_set_memq_1, 2, 0, false, "tree-set-memq opt"); /* read-line */ - read_line_uncopied = s7_make_function(sc, "read-line", g_read_line_uncopied, 1, 1, false, "read-line opt"); - s7_function_set_class(read_line_uncopied, slot_value(global_slot(sc->read_line_symbol))); + sc->read_line_uncopied = s7_make_function(sc, "read-line", g_read_line_uncopied, 1, 1, false, "read-line opt"); + s7_function_set_class(sc->read_line_uncopied, slot_value(global_slot(sc->read_line_symbol))); /* eval-string */ set_function_chooser(sc, sc->eval_string_symbol, eval_string_chooser); /* inlet */ f = set_function_chooser(sc, sc->inlet_symbol, inlet_chooser); - simple_inlet = make_function_with_class(sc, f, "inlet", g_simple_inlet, 0, 0, true, "inlet opt"); + sc->simple_inlet = make_function_with_class(sc, f, "inlet", g_simple_inlet, 0, 0, true, "inlet opt"); /* let-ref */ f = set_function_chooser(sc, sc->let_ref_symbol, let_ref_chooser); - lint_let_ref = make_function_with_class(sc, f, "let-ref", g_lint_let_ref, 2, 0, false, "let-ref opt"); + sc->lint_let_ref = make_function_with_class(sc, f, "let-ref", g_lint_let_ref, 2, 0, false, "let-ref opt"); /* let-set */ f = set_function_chooser(sc, sc->let_set_symbol, let_set_chooser); - lint_let_set = make_function_with_class(sc, f, "let-set!", g_lint_let_set, 3, 0, false, "let-set! opt"); - - or_n = s7_make_function(sc, "or", g_or_n, 0, 0, true, "or opt"); - or_2 = s7_make_function(sc, "or", g_or_2, 2, 0, false, "or opt"); - or_3 = s7_make_function(sc, "or", g_or_3, 3, 0, false, "or opt"); - and_n = s7_make_function(sc, "and", g_and_n, 0, 0, true, "and opt"); - and_2 = s7_make_function(sc, "and", g_and_2, 2, 0, false, "and opt"); - and_3 = s7_make_function(sc, "and", g_and_3, 3, 0, false, "and opt"); - and_sc = s7_make_function(sc, "and", g_and_sc, 2, 0, false, "and opt"); - if_x1 = s7_make_function(sc, "if", g_if_x1, 2, 0, false, "if opt"); - if_x2 = s7_make_function(sc, "if", g_if_x2, 3, 0, false, "if opt"); - if_not_x1 = s7_make_function(sc, "if", g_if_not_x1, 2, 0, false, "if opt"); - if_not_x2 = s7_make_function(sc, "if", g_if_not_x2, 3, 0, false, "if opt"); - if_x_qq = s7_make_function(sc, "if", g_if_x_qq, 3, 0, false, "if opt"); - if_x_qa = s7_make_function(sc, "if", g_if_x_qa, 3, 0, false, "if opt"); - - or_s_direct = s7_make_function(sc, "or", g_or_s_direct, 0, 0, true, "or opt"); - and_s_direct = s7_make_function(sc, "and", g_and_s_direct, 0, 0, true, "and opt"); + sc->lint_let_set = make_function_with_class(sc, f, "let-set!", g_lint_let_set, 3, 0, false, "let-set! opt"); + + sc->or_n = s7_make_function(sc, "or", g_or_n, 0, 0, true, "or opt"); + sc->or_2 = s7_make_function(sc, "or", g_or_2, 2, 0, false, "or opt"); + sc->or_3 = s7_make_function(sc, "or", g_or_3, 3, 0, false, "or opt"); + sc->and_n = s7_make_function(sc, "and", g_and_n, 0, 0, true, "and opt"); + sc->and_2 = s7_make_function(sc, "and", g_and_2, 2, 0, false, "and opt"); + sc->and_3 = s7_make_function(sc, "and", g_and_3, 3, 0, false, "and opt"); + sc->and_sc = s7_make_function(sc, "and", g_and_sc, 2, 0, false, "and opt"); + sc->if_x1 = s7_make_function(sc, "if", g_if_x1, 2, 0, false, "if opt"); + sc->if_x2 = s7_make_function(sc, "if", g_if_x2, 3, 0, false, "if opt"); + sc->if_not_x1 = s7_make_function(sc, "if", g_if_not_x1, 2, 0, false, "if opt"); + sc->if_not_x2 = s7_make_function(sc, "if", g_if_not_x2, 3, 0, false, "if opt"); + sc->if_x_qq = s7_make_function(sc, "if", g_if_x_qq, 3, 0, false, "if opt"); + sc->if_x_qa = s7_make_function(sc, "if", g_if_x_qa, 3, 0, false, "if opt"); + + sc->or_s_direct = s7_make_function(sc, "or", g_or_s_direct, 0, 0, true, "or opt"); + sc->and_s_direct = s7_make_function(sc, "and", g_and_s_direct, 0, 0, true, "and opt"); + sc->or_s_direct_2 = s7_make_function(sc, "or", g_or_s_direct_2, 0, 0, true, "or opt"); + sc->and_s_direct_2 = s7_make_function(sc, "and", g_and_s_direct_2, 0, 0, true, "and opt"); + sc->or_s_type_2 = s7_make_function(sc, "or", g_or_s_type_2, 0, 0, true, "or opt"); } - #define choose_c_function(Sc, Expr, Func, Args) set_c_function(Expr, c_function_chooser(Func)(Sc, Func, Args, Expr, true)) -static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop) +static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, s7_pointer e) { /* fprintf(stderr, "opt 0: %s %d\n", DISPLAY(expr), hop); */ if (is_constant_symbol(sc, car(expr))) @@ -60619,31 +62687,32 @@ static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int { if (is_null(closure_args(func))) /* no rest arg funny business */ { - if (is_safe_closure(func)) + s7_pointer body; + body = closure_body(func); + if (is_null(cdr(body))) { - s7_pointer body; - body = closure_body(func); - set_unsafe_optimize_op(expr, hop + OP_SAFE_THUNK); - if (is_null(cdr(body))) + if ((is_safe_closure(func)) && + (is_all_x_safe(sc, car(body)))) { - if (is_optimized(car(body))) - set_unsafe_optimize_op(expr, hop + OP_SAFE_THUNK_P); /* thunk_c is very rare */ - else - { - if ((is_pair(car(body))) && - (is_syntactic(caar(body)))) - { - set_optimize_op(expr, hop + OP_SAFE_THUNK_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); - } - } + /* all_x stuff is not set yet */ + annotate_arg(sc, body, e); + set_optimize_op(expr, OP_SAFE_THUNK_A); + set_closure_has_all_x(func); + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_THUNK_P : OP_THUNK_P)); } } - else set_unsafe_optimize_op(expr, hop + OP_THUNK); + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_THUNK : OP_THUNK)); + } set_opt_lambda(expr, func); } - return(OPT_F); /* false (OPT_F) because currently the C_PP stuff assumes safe procedure calls */ + return(OPT_F); } if (is_c_function(func)) @@ -60661,6 +62730,15 @@ static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int } return(OPT_F); } + + if (is_c_function_star(func)) + { + set_optimized(expr); + set_optimize_op(expr, hop + OP_SAFE_C_STAR); + set_c_function(expr, func); + return(OPT_T); + } + return(OPT_F); } @@ -60679,7 +62757,7 @@ static opt_t optimize_func_dotted_args(s7_scheme *sc, s7_pointer expr, s7_pointe return(OPT_F); } -static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s7_pointer e1, s7_pointer e2) +static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, combine_op_t cop, s7_pointer e1, s7_pointer e2) /* sc needed for debugger stuff */ { int32_t arg_op; s7_pointer arg; @@ -60706,7 +62784,7 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s case OP_SAFE_C_AA: return(OP_SAFE_C_opAAq); case OP_SAFE_C_AAA: return(OP_SAFE_C_opAAAq); } - return(OP_SAFE_C_Z); /* this splits out to A in optimize_func_one_arg */ + return(OP_SAFE_C_P); /* this splits out to A in optimize_func_one_arg */ case E_C_SP: arg = e2; @@ -60742,14 +62820,13 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s case OP_SAFE_C_S_opSSq: return(OP_SAFE_C_S_op_S_opSSqq); case OP_SAFE_C_S_opSq: return(OP_SAFE_C_S_op_S_opSqq); case OP_SAFE_C_opSSq_opSSq: return(OP_SAFE_C_S_op_opSSq_opSSqq); - case OP_SAFE_C_SZ: return(OP_SAFE_C_S_opSZq); case OP_SAFE_C_A: return(OP_SAFE_C_S_opAq); case OP_SAFE_C_AA: return(OP_SAFE_C_S_opAAq); case OP_SAFE_C_CAC: case OP_SAFE_C_CSA: case OP_SAFE_C_SCA: case OP_SAFE_C_SAS: case OP_SAFE_C_SSA: case OP_SAFE_C_AAA: return(OP_SAFE_C_S_opAAAq); } - return(OP_SAFE_C_SZ); + return(OP_SAFE_C_SP); case E_C_PS: arg = e1; @@ -60767,7 +62844,7 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_S); case OP_SAFE_C_A: return(OP_SAFE_C_opAq_S); } - return(OP_SAFE_C_ZS); + return(OP_SAFE_C_PS); case E_C_PC: arg = e1; @@ -60784,7 +62861,7 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_C); case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_C); } - return(OP_SAFE_C_ZC); + return(OP_SAFE_C_PC); case E_C_CP: arg= e2; @@ -60832,7 +62909,7 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s case OP_SAFE_C_S_opCq: return(OP_SAFE_C_C_op_S_opCqq); } - return(OP_SAFE_C_CZ); + return(OP_SAFE_C_CP); case E_C_PP: arg = e2; @@ -60887,7 +62964,7 @@ static int32_t combine_ops(s7_pointer func, s7_pointer expr, combine_op_t cop, s return(OP_SAFE_C_opSq_opSSq); break; } - return(OP_SAFE_C_ZZ); + return(OP_SAFE_C_PP); default: break; @@ -60974,13 +63051,29 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu if ((is_closure(func)) && (!arglist_has_rest(sc, closure_args(func)))) { + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(func); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(func); set_unsafely_optimized(expr); - set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)); set_opt_lambda(expr, func); + + if (one_form) + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_A_P : OP_CLOSURE_A_P)); + } + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)); + } return(OPT_F); } if ((is_closure_star(func)) && - (has_simple_arg_defaults(closure_body(func))) && + (lambda_has_simple_defaults(closure_body(func))) && (closure_star_arity_to_int(sc, func) >= 1) && (!arglist_has_rest(sc, closure_args(func)))) { @@ -61054,19 +63147,17 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu if (func_is_safe) { int32_t op; - op = combine_ops(func, expr, E_C_P, arg1, NULL); + op = combine_ops(sc, func, expr, E_C_P, arg1, NULL); set_safe_optimize_op(expr, hop + op); /* fallback is Z */ if (!hop) - { - clear_hop(arg1); - } + clear_hop(arg1); else { - if ((op == OP_SAFE_C_Z) && + if ((op == OP_SAFE_C_P) && (is_all_x_op(optimize_op(arg1)))) { - /* this is confusing! this is much faster than safe_c_z, but + /* this is confusing! this is much faster than safe_c_p, but * the parallel let_z|a case seems to claim that z is faster. */ set_optimize_op(expr, hop + OP_SAFE_C_A); @@ -61127,7 +63218,7 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu return(OPT_F); } } - set_unsafe_optimize_op(expr, hop + ((is_safely_optimized(arg1)) ? OP_C_Z : OP_C_P)); + set_unsafe_optimize_op(expr, hop + OP_C_P); choose_c_function(sc, expr, func, 1); return(OPT_F); } @@ -61142,17 +63233,15 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu } if (func_is_safe) - set_unsafe_optimize_op(expr, hop + ((is_safely_optimized(arg1)) ? OP_SAFE_C_Z : ((car(expr) == sc->not_symbol) ? OP_NOT_P : OP_SAFE_C_P))); - else set_unsafe_optimize_op(expr, hop + ((is_safely_optimized(arg1)) ? OP_C_Z : OP_C_P)); + set_unsafe_optimize_op(expr, hop + ((is_safely_optimized(arg1)) ? OP_SAFE_C_P : ((car(expr) == sc->not_symbol) ? OP_NOT_P : OP_SAFE_C_P))); + else set_unsafe_optimize_op(expr, hop + OP_C_P); choose_c_function(sc, expr, func, 1); return(OPT_F); - - return((is_optimized(expr)) ? OPT_T : OPT_F); } if (is_closure(func)) { - bool safe_case; + bool one_form, safe_case; s7_pointer body; int32_t arit; arit = closure_arity_to_int(sc, func); @@ -61166,100 +63255,89 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu safe_case = is_safe_closure(func); body = closure_body(func); + one_form = is_null(cdr(body)); if (is_immutable(func)) hop = 1; if (pairs == 0) { - if (symbols == 1) + bool sym; + sym = (symbols == 1); + if (one_form) { if (safe_case) { - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S); - if (is_null(cdr(body))) + if (is_all_x_safe(sc, car(body))) { - s7_pointer bexpr; - bexpr = car(body); - if (is_h_safe_c_c(bexpr)) - { - if (c_callee(bexpr) == g_lint_let_ref) - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_L); - else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_C); - } - else - { - if ((!is_optimized(bexpr)) && - (is_pair(bexpr)) && - (is_syntactic(car(bexpr)))) - { - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_P); - if (!is_syntactic_pair(bexpr)) - pair_set_syntax_op(bexpr, symbol_syntax_op_checked(bexpr)); - } - } + annotate_arg(sc, body, e); + set_optimize_op(expr, hop + ((sym) ? OP_SAFE_CLOSURE_S_A : OP_SAFE_CLOSURE_C_A)); + set_closure_has_all_x(func); + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((sym) ? OP_SAFE_CLOSURE_S_P : OP_SAFE_CLOSURE_C_P)); } } else { - if (is_null(cdr(body))) - set_unsafe_optimize_op(expr, hop + OP_CLOSURE_S_1); - else set_optimize_op(expr, hop + OP_CLOSURE_S); + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((sym) ? OP_CLOSURE_S_P : OP_CLOSURE_C_P)); } - set_opt_sym2(expr, arg1); } else { - set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_C : OP_CLOSURE_C)); - set_opt_con2(expr, arg1); + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((sym) ? ((safe_case) ? OP_SAFE_CLOSURE_S : OP_CLOSURE_S) : ((safe_case) ? OP_SAFE_CLOSURE_C : OP_CLOSURE_C))); } + if (sym) + set_opt_sym2(expr, arg1); + else set_opt_con2(expr, arg1); set_opt_lambda(expr, func); set_unsafely_optimized(expr); return(OPT_F); } - else /* pairs == 1 */ + + if (all_x_count(sc, expr) == 1) { - if (bad_pairs == quotes) + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(func); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(func); + set_unsafely_optimized(expr); + set_opt_lambda(expr, func); + + if (one_form) { - if ((is_optimized(arg1)) && - (is_all_x_op(optimize_op(arg1)))) + if (safe_case) { - set_unsafely_optimized(expr); - annotate_arg(sc, cdr(expr), e); - set_arglist_length(expr, small_int(1)); - if (safe_case) + if (is_all_x_safe(sc, car(body))) { - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A); - if ((is_null(cdr(body))) && - (is_h_safe_c_c(car(body)))) - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_C); + annotate_arg(sc, body, e); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_A); + set_closure_has_all_x(func); } - else + else { - set_optimize_op(expr, hop + OP_CLOSURE_A); - if ((is_null(cdr(body))) && - (is_pair(car(body))) && - (is_syntactic(caar(body)))) - { - set_optimize_op(expr, hop + OP_CLOSURE_A_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); - } + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_P); } - set_opt_lambda(expr, func); - return(OPT_F); + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_CLOSURE_A_P); } } - } - - if (all_x_count(sc, expr) == 1) - { - set_unsafely_optimized(expr); - if ((safe_case) && - (is_h_safe_c_c(car(body)))) - set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_C); - else set_unsafe_optimize_op(expr, hop + ((safe_case ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A))); + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)); + } annotate_arg(sc, cdr(expr), e); - set_opt_lambda(expr, func); set_arglist_length(expr, small_int(1)); + set_unsafely_optimized(expr); return(OPT_F); } @@ -61272,39 +63350,39 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu if (is_closure_star(func)) { bool safe_case; - if ((!has_simple_arg_defaults(closure_body(func))) || + if ((!lambda_has_simple_defaults(closure_body(func))) || (is_null(closure_args(func)))) return(OPT_F); safe_case = is_safe_closure(func); if (symbols == 1) { - set_unsafely_optimized(expr); annotate_arg(sc, cdr(expr), e); set_arglist_length(expr, small_int(1)); set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)); set_opt_lambda(expr, func); - /* set_opt_sym2(expr, arg1); */ + set_unsafely_optimized(expr); return(OPT_F); } if ((!arglist_has_rest(sc, closure_args(func))) && (all_x_count(sc, expr) == 1)) { - set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)); annotate_arg(sc, cdr(expr), e); set_opt_lambda(expr, func); set_arglist_length(expr, small_int(1)); + set_unsafely_optimized(expr); return(OPT_F); } - return((is_optimized(expr)) ? OPT_T : OPT_F); + return(OPT_F); } - if ((is_c_function_star(func)) && + if ((is_c_function_star(func)) && /* we checked above for c_function_all_args == 1 */ (all_x_count(sc, expr) == 1)) { set_optimized(expr); - set_optimize_op(expr, hop + OP_SAFE_C_STAR_A); + set_optimize_op(expr, hop + OP_SAFE_C_STAR_A); /* if one arg passed, it's obviously not a keyword-as-parameter-name */ annotate_arg(sc, cdr(expr), e); set_arglist_length(expr, small_int(1)); set_c_function(expr, func); @@ -61314,11 +63392,20 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu if ((s7_is_vector(func)) && (is_all_x_safe(sc, arg1))) { - set_unsafe_optimize_op(expr, hop + OP_VECTOR_A); + set_unsafe_optimize_op(expr, OP_VECTOR_A); annotate_arg(sc, cdr(expr), e); set_arglist_length(expr, small_int(1)); return(OPT_T); } + + if ((func == sc->s7_let) && + (((quotes == 1) && (is_symbol(cadr(arg1)))) || + (is_keyword(arg1)))) + { + /* (*s7* ...) */ + set_optimize_op(expr, OP_S7_LET); + return(OPT_F); + } /* unknown_* is set later */ return((is_optimized(expr)) ? OPT_T : OPT_F); @@ -61429,15 +63516,29 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((is_closure(func)) && (!arglist_has_rest(sc, closure_args(func)))) { + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(func); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(func); set_unsafely_optimized(expr); - if (is_pair(cdr(closure_body(func)))) - set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA)); - else set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_AA_P : OP_CLOSURE_AA_P)); set_opt_lambda(expr, func); + + if (one_form) + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_AA_P : OP_CLOSURE_AA_P)); + } + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA)); + } return(OPT_F); } if ((is_closure_star(func)) && - (has_simple_arg_defaults(closure_body(func))) && + (lambda_has_simple_defaults(closure_body(func))) && (!arglist_has_rest(sc, closure_args(func)))) { set_unsafely_optimized(expr); @@ -61456,7 +63557,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f (c_function_all_args(func) >= 2)) || ((is_c_function_star(func)) && (c_function_all_args(func) == 2) && - (!is_keyword(arg1)))) + (!is_pair(arg1)) && (!is_symbol(arg1)))) /* trying to protect against arg1 evaluating to a keywordb */ { /* this is a mess */ bool func_is_safe; @@ -61529,9 +63630,8 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((func_is_safe) || (is_maybe_safe(func))) { int32_t op; - op = combine_ops(func, expr, E_C_PP, arg1, arg2); + op = combine_ops(sc, func, expr, E_C_PP, arg1, arg2); set_safe_optimize_op(expr, hop + op); - /* fallback here is ZZ */ if (!hop) { clear_hop(arg1); @@ -61539,7 +63639,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f } else { - if (op == OP_SAFE_C_ZZ) + if (op == OP_SAFE_C_PP) { if (is_all_x_safe(sc, arg1)) { @@ -61551,21 +63651,16 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f } else { - if (optimize_op(arg1) == HOP_SAFE_C_C) - set_optimize_op(expr, hop + OP_SAFE_C_opCq_Z); - else - { - set_optimize_op(expr, hop + OP_SAFE_C_AZ); - annotate_arg(sc, cdr(expr), e); - set_arglist_length(expr, small_int(2)); - } + set_optimize_op(expr, hop + OP_SAFE_C_AP); + annotate_arg(sc, cdr(expr), e); + set_arglist_length(expr, small_int(2)); } } else { if (is_all_x_safe(sc, arg2)) { - set_optimize_op(expr, hop + OP_SAFE_C_ZA); + set_optimize_op(expr, hop + OP_SAFE_C_PA); annotate_arg(sc, cddr(expr), e); set_arglist_length(expr, small_int(2)); } @@ -61590,7 +63685,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if (is_symbol(arg2)) orig_op = E_C_PS; else orig_op = E_C_PC; - op = combine_ops(func, expr, orig_op, arg1, arg2); + op = combine_ops(sc, func, expr, orig_op, arg1, arg2); if (!hop) clear_hop(arg1); } else @@ -61598,12 +63693,12 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if (is_symbol(arg1)) orig_op = E_C_SP; else orig_op = E_C_CP; - op = combine_ops(func, expr, orig_op, arg1, arg2); + op = combine_ops(sc, func, expr, orig_op, arg1, arg2); if (!hop) clear_hop(arg2); } - if ((((op == OP_SAFE_C_SZ) || (op == OP_SAFE_C_CZ)) && + if ((((op == OP_SAFE_C_SP) || (op == OP_SAFE_C_CP)) && (is_all_x_op(optimize_op(arg2)))) || - (((op == OP_SAFE_C_ZS) || (op == OP_SAFE_C_ZC)) && + (((op == OP_SAFE_C_PS) || (op == OP_SAFE_C_PC)) && (is_all_x_op(optimize_op(arg1))))) { set_safe_optimize_op(expr, hop + OP_SAFE_C_AA); @@ -61704,36 +63799,20 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_optimized(expr); if (is_symbol(arg1)) { - if ((bad_pairs == 0) || (is_safely_optimized(arg2))) /* bad_pair && h_optimized happens a lot */ - { - set_optimize_op(expr, hop + OP_SAFE_C_SZ); - choose_c_function(sc, expr, func, 2); - /* if hop is on, is it the case that opt1 is unused? where besides c_function_is_ok is it referenced? - * some like add_ss_1ss use opt1(cdr(...)) which is safe here I think because cadr is a symbol - * it's used in the choosers to detect e.g. temp funcs - */ - return(OPT_T); - } - set_unsafe(expr); set_optimize_op(expr, hop + OP_SAFE_C_SP); choose_c_function(sc, expr, func, 2); + if (bad_pairs == 0) + return(OPT_T); + set_unsafe(expr); return(OPT_F); } /* arg2 is a symbol */ - if ((bad_pairs == 0) || (is_safely_optimized(arg1))) - { - set_optimize_op(expr, hop + OP_SAFE_C_ZS); - choose_c_function(sc, expr, func, 2); - return(OPT_T); - } - /* unknowns get here: (* amp (amps 0)) - * also list: (make-polywave pitch (list 1 0.93 2 0.07)) - * and (* vol (granulate gen)) - */ - set_unsafe(expr); set_optimize_op(expr, hop + OP_SAFE_C_PS); choose_c_function(sc, expr, func, 2); + if (bad_pairs == 0) + return(OPT_T); + set_unsafe(expr); return(OPT_F); } if (symbols == 0) @@ -61741,35 +63820,21 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_optimized(expr); if (is_pair(arg1)) { - if ((bad_pairs == 0) || (is_safely_optimized(arg2))) - { - set_optimize_op(expr, hop + OP_SAFE_C_ZC); - choose_c_function(sc, expr, func, 2); - return(OPT_T); - } - else - { - set_unsafe(expr); - set_optimize_op(expr, hop + OP_SAFE_C_PC); - choose_c_function(sc, expr, func, 2); - return(OPT_F); - } + set_optimize_op(expr, hop + OP_SAFE_C_PC); + choose_c_function(sc, expr, func, 2); + if (bad_pairs == 0) + return(OPT_T); + set_unsafe(expr); + return(OPT_F); } else { - if ((bad_pairs == 0) || (is_safely_optimized(arg1))) - { - set_optimize_op(expr, hop + OP_SAFE_C_CZ); - choose_c_function(sc, expr, func, 2); - return(OPT_T); - } - else - { - set_unsafe(expr); - set_optimize_op(expr, hop + OP_SAFE_C_CP); - choose_c_function(sc, expr, func, 2); - return(OPT_F); - } + set_optimize_op(expr, hop + OP_SAFE_C_CP); + choose_c_function(sc, expr, func, 2); + if (bad_pairs == 0) + return(OPT_T); + set_unsafe(expr); + return(OPT_F); } } } @@ -61804,10 +63869,18 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_unsafely_optimized(expr); if (is_all_x_safe(sc, arg1)) { - set_optimize_op(expr, hop + ((is_safely_optimized(arg2)) ? OP_SAFE_C_AZ : OP_SAFE_C_AP)); + set_optimize_op(expr, hop + OP_SAFE_C_AP); annotate_arg(sc, cdr(expr), e); } - else set_optimize_op(expr, hop + OP_SAFE_C_PP); + else + { + if (is_all_x_safe(sc, arg2)) + { + set_optimize_op(expr, hop + OP_SAFE_C_PA); + annotate_arg(sc, cddr(expr), e); + } + else set_optimize_op(expr, hop + OP_SAFE_C_PP); + } choose_c_function(sc, expr, func, 2); return(OPT_F); } @@ -61819,7 +63892,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_optimize_op(expr, hop + OP_SAFE_C_QP); else { - set_optimize_op(expr, hop + ((is_safely_optimized(arg1)) ? OP_SAFE_C_ZQ : OP_SAFE_C_PQ)); + set_optimize_op(expr, hop + OP_SAFE_C_PQ); set_opt_con2(cdr(expr), cadr(caddr(expr))); } set_unsafely_optimized(expr); @@ -61902,6 +63975,9 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if (is_closure(func)) { int32_t arit; + bool one_form, safe_case; + s7_pointer body; + arit = closure_arity_to_int(sc, func); if (arit != 2) { @@ -61912,7 +63988,9 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f } if (is_immutable(func)) hop = 1; - /* safe_closures with 1-expr c_c h-optimized body with hop=1 happen only in tgen (and not enough there to warrant any effort) */ + body = closure_body(func); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(func); if ((pairs == 0) && (symbols >= 1)) @@ -61920,43 +63998,63 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f set_unsafely_optimized(expr); if (symbols == 2) { - if (is_safe_closure(func)) - set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SS_B)); - else + if (one_form) { - s7_pointer body; - body = closure_body(func); - set_optimize_op(expr, hop + OP_CLOSURE_SS); - if (is_null(cdr(body))) + if (safe_case) { - if (is_optimized(car(body))) /* possibly body is just a scheme function call (side-effect? in lint.scm) */ - set_unsafe_optimize_op(expr, hop + OP_CLOSURE_SS_P); + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, e); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SS_A); + set_closure_has_all_x(func); + } else { - if ((is_pair(car(body))) && - (is_syntactic(caar(body)))) - { - set_optimize_op(expr, hop + OP_CLOSURE_SS_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); - } + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SS_P); } } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_CLOSURE_SS_P); + } + } + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS)); } set_opt_sym2(expr, arg2); + + set_opt_lambda(expr, func); + return(OPT_F); } else { - if (is_symbol(arg1)) + bool s1; + s1 = is_symbol(arg1); + if (one_form) { - set_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_SC : OP_CLOSURE_SC))); - set_opt_con2(expr, arg2); + if (safe_case) + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((s1) ? OP_SAFE_CLOSURE_SC_P : OP_SAFE_CLOSURE_CS_P)); + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + ((s1) ? OP_CLOSURE_SC_P : OP_CLOSURE_CS_P)); + } } else { - set_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS))); - set_opt_sym2(expr, arg2); + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((s1) ? ((safe_case) ? OP_SAFE_CLOSURE_SC : OP_CLOSURE_SC) : ((safe_case) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS))); } + if (s1) + set_opt_con2(expr, arg2); + else set_opt_sym2(expr, arg2); } set_opt_lambda(expr, func); return(OPT_F); @@ -61965,14 +64063,38 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if ((!arglist_has_rest(sc, closure_args(func))) && (all_x_count(sc, expr) == 2)) { - set_unsafely_optimized(expr); - if (is_safe_closure(func)) + if (one_form) { - if (is_symbol(arg1)) + if (safe_case) + { + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, e); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_AA_A); + set_closure_has_all_x(func); + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_SAFE_CLOSURE_AA_P); + } + } + else + { + set_closure_has_one_form(func); + set_optimize_op(expr, hop + OP_CLOSURE_AA_P); + } + } + else + { + if ((safe_case) && (is_symbol(arg1))) set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SA); - else set_optimize_op(expr, hop + ((is_pair(cdr(closure_body(func)))) ? OP_SAFE_CLOSURE_AA : OP_SAFE_CLOSURE_AA_P)); + else + { + set_closure_has_multiform(func); + set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA)); + } } - else set_optimize_op(expr, hop + ((is_pair(cdr(closure_body(func)))) ? OP_CLOSURE_AA : OP_CLOSURE_AA_P)); annotate_args(sc, cdr(expr), e); set_opt_lambda(expr, func); set_arglist_length(expr, small_int(2)); @@ -62021,7 +64143,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f if (is_closure_star(func)) { - if (!has_simple_arg_defaults(closure_body(func))) + if (!lambda_has_simple_defaults(closure_body(func))) return(OPT_F); if ((!arglist_has_rest(sc, closure_args(func))) && @@ -62096,7 +64218,7 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer return(OPT_F); } if ((is_closure_star(func)) && - (has_simple_arg_defaults(closure_body(func))) && + (lambda_has_simple_defaults(closure_body(func))) && (closure_star_arity_to_int(sc, func) >= 3) && (!arglist_has_rest(sc, closure_args(func)))) { @@ -62118,8 +64240,8 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer (c_function_all_args(func) >= 3)) || ((is_c_function_star(func)) && (c_function_all_args(func) == 3) && - (!is_keyword(arg1)) && - (!is_keyword(arg2)))) + (!is_pair(arg1)) && (!is_symbol(arg1)) && + (!is_pair(arg2)) && (!is_symbol(arg2)))) { if ((is_safe_procedure(func)) || ((is_maybe_safe(func)) && @@ -62245,7 +64367,15 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer else { if ((symbols == 2) && (is_symbol(arg1))) - set_optimize_op(expr, hop + ((is_symbol(arg2)) ? OP_SAFE_C_SSA : OP_SAFE_C_SAS)); + { + if (is_symbol(arg2)) + { + set_optimize_op(expr, hop + OP_SAFE_C_SSA); + /* an experiment */ + + } + else set_optimize_op(expr, hop + OP_SAFE_C_SAS); + } } } } @@ -62255,72 +64385,22 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer if (bad_pairs == 0) { - if ((symbols == 2) && - (is_symbol(arg1)) && - (is_symbol(arg2))) + set_optimized(expr); + choose_c_function(sc, expr, func, 3); + set_arglist_length(expr, small_int(3)); + if (((!is_pair(arg1)) || + (is_all_x_op(optimize_op(arg1)))) && + ((!is_pair(arg2)) || + (is_all_x_op(optimize_op(arg2))))) { + set_optimize_op(expr, hop + OP_SAFE_C_AAP); /* here last can't be A because we checked for that above */ annotate_arg(sc, cdr(expr), e); annotate_arg(sc, cddr(expr), e); - set_optimize_op(expr, hop + OP_SAFE_C_AAZ); - } - else - { - /* use either X or Z in all 8 choices */ - if ((!is_pair(arg1)) || - (is_all_x_op(optimize_op(arg1)))) - { - annotate_arg(sc, cdr(expr), e); - if ((!is_pair(arg2)) || - (is_all_x_op(optimize_op(arg2)))) - { - set_optimize_op(expr, hop + OP_SAFE_C_AAZ); /* here last can't be A because we checked for that above */ - annotate_arg(sc, cddr(expr), e); - } - else - { - if ((!is_pair(arg3)) || - (is_all_x_op(optimize_op(arg3)))) - { - set_optimize_op(expr, hop + OP_SAFE_C_AZA); - annotate_arg(sc, cdddr(expr), e); - } - else set_optimize_op(expr, hop + OP_SAFE_C_AZZ); - } - } - else - { - if ((!is_pair(arg2)) || - (is_all_x_op(optimize_op(arg2)))) - { - annotate_arg(sc, cddr(expr), e); - if ((!is_pair(arg3)) || - (is_all_x_op(optimize_op(arg3)))) - { - set_optimize_op(expr, hop + OP_SAFE_C_ZAA); - annotate_arg(sc, cdddr(expr), e); - } - else set_optimize_op(expr, hop + OP_SAFE_C_ZAZ); - } - else - { - if ((!is_pair(arg3)) || - (is_all_x_op(optimize_op(arg3)))) - { - set_optimize_op(expr, hop + OP_SAFE_C_ZZA); - annotate_arg(sc, cdddr(expr), e); - } - else - { - set_opt_pair2(cdr(expr), arg2); - set_opt_pair1(cdr(expr), arg3); - set_optimize_op(expr, hop + OP_SAFE_C_ZZZ); - } - } - } + return(OPT_T); } - set_optimized(expr); - choose_c_function(sc, expr, func, 3); - set_arglist_length(expr, small_int(3)); + set_opt_con2(cdr(expr), arg2); + set_opt_con1(cdr(expr), arg3); + set_optimize_op(expr, hop + OP_SAFE_C_ZZZ); return(OPT_T); } @@ -62401,9 +64481,8 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer set_c_function(expr, func); set_opt_con2(expr, error_result); set_opt_pair1(cdr(expr), cddr(body_lambda)); - if ((is_null(cdddr(body_lambda))) && - (is_optimized(caddr(body_lambda)))) - set_optimize_op(expr, hop + OP_C_CATCH_ALL_Z); + if (is_null(cdddr(body_lambda))) + set_optimize_op(expr, hop + OP_C_CATCH_ALL_P); } else @@ -62440,7 +64519,7 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer set_unsafely_optimized(expr); set_opt_lambda(expr, func); set_arglist_length(expr, small_int(3)); - set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_ALL_S_P : OP_CLOSURE_ALL_S)); + set_optimize_op(expr, hop + OP_CLOSURE_ALL_S); return(OPT_F); } @@ -62463,7 +64542,7 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer if (is_closure_star(func)) { - if ((!has_simple_arg_defaults(closure_body(func))) || + if ((!lambda_has_simple_defaults(closure_body(func))) || (closure_star_arity_to_int(sc, func) < 3) || (arglist_has_rest(sc, closure_args(func)))) return(OPT_F); @@ -62617,13 +64696,13 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer if ((!safe_case) && (symbols == args) && (symbols_are_safe(sc, cdr(expr), e))) - set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_ALL_S_P : OP_CLOSURE_ALL_S)); + set_optimize_op(expr, hop + OP_CLOSURE_ALL_S); return(OPT_F); } } if ((is_closure_star(func)) && - ((!has_simple_arg_defaults(closure_body(func))) || + ((!lambda_has_simple_defaults(closure_body(func))) || (closure_star_arity_to_int(sc, func) < args))) return(OPT_F); @@ -62658,6 +64737,7 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer return((is_optimized(expr)) ? OPT_T : OPT_F); } + static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7_pointer e, bool export_ok); static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, s7_pointer e, bool export_ok) @@ -62679,6 +64759,8 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in case OP_LET: case OP_LETREC: + case OP_LET_STAR: + case OP_LETREC_STAR: if (is_symbol(cadr(expr))) { if (!is_pair(cddr(expr))) /* (let name . x) */ @@ -62700,68 +64782,44 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in } } if (!is_pair(body)) return(OPT_OOPS); - for (p = vars; is_pair(p); p = cdr(p)) + if ((op == OP_LET) || (op == OP_LETREC)) { - s7_pointer var; - var = car(p); - if ((!is_pair(var)) || - (!is_symbol(car(var))) || - (!is_pair(cdr(var)))) - return(OPT_OOPS); - var = cadr(var); - if ((is_pair(var)) && - (!is_checked(var)) && - (optimize_expression(sc, var, hop, e, false) == OPT_OOPS)) - return(OPT_OOPS); - } - e = collect_variables(sc, vars, e); - if (is_symbol(cadr(expr))) - { - e = cons(sc, add_symbol_to_list(sc, cadr(expr)), e); - sc->w = e; - } - break; - - case OP_LET_STAR: - case OP_LETREC_STAR: - if (is_symbol(cadr(expr))) - { - if (!is_pair(cddr(expr))) /* (let name . x) */ - return(OPT_F); - vars = caddr(expr); - if (!is_list(vars)) return(OPT_OOPS); - body = cdddr(expr); + for (p = vars; is_pair(p); p = cdr(p)) + { + s7_pointer var; + var = car(p); + if ((!is_pair(var)) || + (!is_symbol(car(var))) || + (!is_pair(cdr(var)))) + return(OPT_OOPS); + var = cadr(var); + if ((is_pair(var)) && + (!is_checked(var)) && + (optimize_expression(sc, var, hop, e, false) == OPT_OOPS)) + return(OPT_OOPS); + } + e = collect_variables(sc, vars, e); } else { - vars = cadr(expr); - body = cddr(expr); - if (is_null(vars)) - e = cons(sc, sc->nil, e); - else + for (p = vars; is_pair(p); p = cdr(p)) { - if (!is_pair(vars)) + s7_pointer var; + var = car(p); + if ((!is_pair(var)) || + (!is_symbol(car(var))) || + (!is_pair(cdr(var)))) + return(OPT_OOPS); + + if ((is_pair(cadr(var))) && + (!is_checked(cadr(var))) && + (optimize_expression(sc, cadr(var), hop, e, false) == OPT_OOPS)) return(OPT_OOPS); + + e = cons(sc, add_symbol_to_list(sc, car(var)), e); + sc->w = e; } } - if (!is_pair(body)) return(OPT_OOPS); - for (p = vars; is_pair(p); p = cdr(p)) - { - s7_pointer var; - var = car(p); - if ((!is_pair(var)) || - (!is_symbol(car(var))) || - (!is_pair(cdr(var)))) - return(OPT_OOPS); - - if ((is_pair(cadr(var))) && - (!is_checked(cadr(var))) && - (optimize_expression(sc, cadr(var), hop, e, false) == OPT_OOPS)) - return(OPT_OOPS); - - e = cons(sc, add_symbol_to_list(sc, car(var)), e); - sc->w = e; - } if (is_symbol(cadr(expr))) { e = cons(sc, add_symbol_to_list(sc, cadr(expr)), e); @@ -63058,14 +65116,21 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in if (op == OP_OR) { set_safe_optimize_op(expr, hop + OP_SAFE_C_C); - set_c_function(expr, or_s_direct); + if (args == 2) + { + if ((symbol_type(caadr(expr)) > 0) && (is_global(caadr(expr))) && + ((symbol_type(caaddr(expr)) > 0) && (is_global(caaddr(expr))))) + set_c_function(expr, sc->or_s_type_2); + else set_c_function(expr, sc->or_s_direct_2); + } + else set_c_function(expr, sc->or_s_direct); } else { if (op == OP_AND) { set_safe_optimize_op(expr, hop + OP_SAFE_C_C); - set_c_function(expr, and_s_direct); + set_c_function(expr, (args == 2) ? sc->and_s_direct_2 : sc->and_s_direct); } } return(OPT_F); @@ -63080,14 +65145,14 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in { if (s7_list_length(sc, cdr(expr)) == 2) { - set_c_function(expr, or_2); + set_c_function(expr, sc->or_2); add_optimizer_fixup(sc, expr, hop + OP_SAFE_C_OR2); } else { if (s7_list_length(sc, cdr(expr)) == 3) - set_c_function(expr, or_3); - else set_c_function(expr, or_n); + set_c_function(expr, sc->or_3); + else set_c_function(expr, sc->or_n); } } else @@ -63098,18 +65163,18 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in { if ((c_call(cdr(expr)) == all_x_c_s) && (c_call(cddr(expr)) == all_x_c_c)) - set_c_function(expr, and_sc); + set_c_function(expr, sc->and_sc); else { - set_c_function(expr, and_2); + set_c_function(expr, sc->and_2); add_optimizer_fixup(sc, expr, hop + OP_SAFE_C_AND2); } } else { if (s7_list_length(sc, cdr(expr)) == 3) - set_c_function(expr, and_3); - else set_c_function(expr, and_n); + set_c_function(expr, sc->and_3); + else set_c_function(expr, sc->and_n); } } else @@ -63122,8 +65187,8 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in (is_pair(b2))) { if (c_call(b2) == all_x_q) - set_c_function(expr, if_x_qq); - else set_c_function(expr, if_x_qa); + set_c_function(expr, sc->if_x_qq); + else set_c_function(expr, sc->if_x_qa); } else { @@ -63133,14 +65198,14 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in { set_x_call(test, all_x_eval(sc, cdar(test), e, pair_symbol_is_safe)); if (is_null(b2)) - set_c_function(expr, if_not_x1); - else set_c_function(expr, if_not_x2); + set_c_function(expr, sc->if_not_x1); + else set_c_function(expr, sc->if_not_x2); } else { if (is_null(b2)) - set_c_function(expr, if_x1); - else set_c_function(expr, if_x2); + set_c_function(expr, sc->if_x1); + else set_c_function(expr, sc->if_x2); } } } @@ -63281,7 +65346,7 @@ static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7 { switch (args) { - case 0: return(optimize_thunk(sc, expr, func, hop)); + case 0: return(optimize_thunk(sc, expr, func, hop, e)); case 1: return(optimize_func_one_arg(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e)); case 2: return(optimize_func_two_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e)); case 3: return(optimize_func_three_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e)); @@ -64121,13 +66186,16 @@ static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool return(result); } -static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body) +static void optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body) { s7_int len; len = s7_list_length(sc, body); if (len < 0) /* (define (hi) 1 . 2) */ - eval_error_with_caller(sc, "~A: function body messed up, ~A", 31, (unstarred_lambda) ? sc->lambda_symbol : sc->lambda_star_symbol, sc->code); + s7_error(sc, sc->syntax_error_symbol, + set_elist_3(sc, wrap_string(sc, "~A: function body messed up, ~A", 31), + (unstarred_lambda) ? sc->lambda_symbol : sc->lambda_star_symbol, + sc->code)); if (len > 0) /* i.e. not circular */ { @@ -64167,7 +66235,7 @@ static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_point } } if (happy) - set_simple_arg_defaults(body); + lambda_set_simple_defaults(body); } if (result != UNSAFE_BODY) { @@ -64198,7 +66266,6 @@ static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_point clear_all_optimizations(sc, body); } } - return(NULL); } static void check_lambda(s7_scheme *sc) @@ -64468,11 +66535,12 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s { s7_pointer binding; - pair_set_syntax_op(form, OP_LET_ONE); binding = car(start); /* all-x-able body happens a few times, but to avoid the new frame we'd need to ensure it was safe etc */ if (is_pair(cadr(binding))) { + /* this is not a named let */ + pair_set_syntax_op(form, ((is_pair(cddr(form))) && (is_null(cdddr(form)))) ? OP_LET_ONE_P : OP_LET_ONE); if (is_h_optimized(cadr(binding))) { if (is_null(cddr(sc->code))) /* one statement body */ @@ -64516,16 +66584,17 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s { pair_set_syntax_op(form, OP_LET_A); annotate_arg(sc, cdr(binding), sc->envir); - if (is_optimized(cadr(sc->code))) + + if ((is_optimized(cadr(sc->code))) || + (is_syntactic_pair(cadr(sc->code)))) pair_set_syntax_op(form, OP_LET_A_P); else { if ((is_pair(cadr(sc->code))) && - (is_syntactic_symbol(caadr(sc->code)))) + (is_syntactic(caadr(sc->code)))) { pair_set_syntax_op(form, OP_LET_A_P); - if (!is_syntactic_pair(cadr(sc->code))) - pair_set_syntax_op(cadr(sc->code), symbol_syntax_op_checked(cadr(sc->code))); + set_optimize_op(cadr(sc->code), syntax_opcode(slot_value(global_slot(caadr(sc->code))))); } } return(sc->code); @@ -64563,7 +66632,7 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer form, s7_pointer s if (is_symbol(p)) { set_opt_sym2(sc->code, p); - pair_set_syntax_op(form, ((is_null(cddr(sc->code))) && (is_optimized(cadr(sc->code)))) ? OP_LET_S_Z : OP_LET_S); + pair_set_syntax_op(form, (is_null(cddr(sc->code))) ? OP_LET_S_P : OP_LET_S); } else { @@ -64687,7 +66756,15 @@ static s7_pointer check_let(s7_scheme *sc) sc->args = safe_list_if_possible(sc, vars); for (ex = start, exp = sc->args; is_pair(ex); ex = cdr(ex), exp = cdr(exp)) car(exp) = caar(ex); - optimize_lambda(sc, true, car(sc->code), sc->args, cddr(sc->code)); + + /* fprintf(stderr, "%s\n", DISPLAY(sc->code)); */ /* tlet -> safe_closure_a_lp */ + optimize_lambda(sc, true, car(sc->code), sc->args, cddr(sc->code)); /* car(sc->code) is the name */ + /* cddr(sc->code) == body in optimize_lambda, will had very_safe_closure bit */ + /* at runtime is_recur is true of func slot */ + /* if opt, while (sc->pc == 0)..., need frame (via funclet(func)?) */ + /* but how to tell check_let caller to run the loop? OP_OPT_NAMED_LET? */ + /* or put it off until unchecked_let+no no_opt_pair? -- see op_let_unchecked */ + clear_list_in_use(sc->args); sc->current_safe_list = 0; } @@ -64756,9 +66833,6 @@ static s7_pointer check_let(s7_scheme *sc) for (p = start; is_pair(p); p = cdr(p)) /* optimizing the value form here: car(p)=var+val, cdar(p)=val */ set_x_call(cdar(p), all_x_eval(sc, cdar(p), sc->envir, let_symbol_is_safe)); /* all-x-able body does not happen much */ -#if S7_DEBUGGING - return(sc->code); -#endif } } else pair_set_syntax_op(form, OP_LET_UNCHECKED); @@ -65061,7 +67135,7 @@ static s7_pointer check_and(s7_scheme *sc) if (all_pairs) { - bool any_nils = false, any_ps = false; + bool any_nils = false; for (p = sc->code; is_pair(p); p = cdr(p)) { s7_function callee; @@ -65069,13 +67143,11 @@ static s7_pointer check_and(s7_scheme *sc) if (!callee) any_nils = true; set_x_call_checked(p, callee); - if (!is_optimized(car(p))) - any_ps = true; } if ((c_callee(sc->code)) && (is_pair(cdr(sc->code))) && (is_null(cddr(sc->code)))) - pair_set_syntax_op(form, (any_nils) ? ((any_ps) ? OP_AND_AP : OP_AND_AZ) : OP_AND_SAFE_AA); + pair_set_syntax_op(form, (any_nils) ? OP_AND_AP : OP_AND_SAFE_AA); else pair_set_syntax_op(form, (any_nils) ? OP_AND_P : OP_AND_SAFE_P); } else pair_set_syntax_op(form, OP_AND_UNCHECKED); @@ -65240,10 +67312,7 @@ static void set_if_opts(s7_scheme *sc, s7_pointer form, bool one_branch, bool re set_x_call(cdar(sc->code), all_x_eval(sc, cdar(sc->code), sc->envir, let_symbol_is_safe)); else set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe)); } - else - { - pair_set_syntax_op(form, choose_if_optc(IF_Z, one_branch, reversed, not_case)); - } + else pair_set_syntax_op(form, choose_if_optc(IF_P, one_branch, reversed, not_case)); } else { @@ -65261,7 +67330,7 @@ static void set_if_opts(s7_scheme *sc, s7_pointer form, bool one_branch, bool re if (symbol_syntax_op(car(test)) == OP_AND) check_and(sc); else check_or(sc); new_op = symbol_syntax_op_checked(test); sc->code = old_code; - if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_AZ) || + if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_SAFE_P) || (new_op == OP_AND_SAFE_AA)) pair_set_syntax_op(form, choose_if_optc(IF_ANDP, one_branch, reversed, not_case)); else @@ -65817,7 +67886,7 @@ static s7_pointer check_cond(s7_scheme *sc) if (has_feed_to) { - pair_set_syntax_op(form, (is_optimized(caar(sc->code))) ? OP_COND_UNCHECKED_Z : OP_COND_UNCHECKED); + pair_set_syntax_op(form, OP_COND_UNCHECKED); if (is_null(cdr(sc->code))) { s7_pointer expr, f; @@ -65862,10 +67931,18 @@ static s7_pointer check_cond(s7_scheme *sc) pair_set_syntax_op(form, OP_COND_ALL_X_2); for (p = sc->code; eopt && (is_pair(p)); p = cdr(p)) - eopt = ((!is_pair(cdar(p))) || ((!is_pair(cddar(p))) && ((!is_pair(cadar(p))) || (is_optimized(cadar(p)))))); + eopt = ((!is_pair(cdar(p))) || (!is_pair(cddar(p)))); /* TODO: this ^ forgets else/#t and lets constants through */ if (eopt) - pair_set_syntax_op(form, OP_COND_ALL_X_Z); + pair_set_syntax_op(form, OP_COND_ALL_X_P); + } + else + { + bool eopt = true; + for (p = sc->code; eopt && (is_pair(p)); p = cdr(p)) + eopt = ((is_pair(cdar(p))) && (!is_pair(cddar(p)))); + if (eopt) + pair_set_syntax_op(form, OP_COND_SIMPLE_P); } } return(sc->code); @@ -66009,11 +68086,9 @@ static s7_pointer check_set(s7_scheme *sc) } else { - pair_set_syntax_op(form, OP_SET_PAIR_P); - /* splice_in_values protects us here from values */ + pair_set_syntax_op(form, OP_SET_PAIR_P); /* splice_in_values protects us here from values */ if (is_optimized(value)) { - pair_set_syntax_op(form, OP_SET_PAIR_Z); if (is_all_x_safe(sc, value)) { s7_pointer obj; @@ -66100,11 +68175,9 @@ static s7_pointer check_set(s7_scheme *sc) { if (is_optimized(value)) { - pair_set_syntax_op(form, OP_SET_SYMBOL_Z); if (is_h_safe_c_c(value)) { pair_set_syntax_op(form, OP_SET_SYMBOL_opCq); - /* opt1 here points back? */ set_opt_pair2(sc->code, cdr(value)); } else @@ -66184,13 +68257,13 @@ static s7_pointer check_set(s7_scheme *sc) if ((caddr(value) == small_int(1)) && (cadr(value) == settee)) { - if ((opt_cfunc(value) == add_s1) || - (opt_cfunc(value) == add_cs1)) + if ((opt_cfunc(value) == sc->add_s1) || + (opt_cfunc(value) == sc->add_cs1)) pair_set_syntax_op(form, OP_INCREMENT_1); else { - if ((opt_cfunc(value) == subtract_s1) || - (opt_cfunc(value) == subtract_cs1)) + if ((opt_cfunc(value) == sc->subtract_s1) || + (opt_cfunc(value) == sc->subtract_cs1)) pair_set_syntax_op(form, OP_DECREMENT_1); } } @@ -66198,7 +68271,7 @@ static s7_pointer check_set(s7_scheme *sc) { if ((cadr(value) == small_int(1)) && (caddr(value) == settee) && - (opt_cfunc(value) == add_1s)) + (opt_cfunc(value) == sc->add_1s)) pair_set_syntax_op(form, OP_INCREMENT_1); else { @@ -67319,7 +69392,7 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p ((is_symbol(cadddr(expr))) && (direct_memq(cadddr(expr), steppers))) || ((is_pair(cadddr(expr))) && - (tree_set_memq_b_pp(steppers, cadddr(expr))))) + (tree_set_memq_b_7pp(sc, steppers, cadddr(expr))))) (*has_set) = true; } if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set)) @@ -67367,6 +69440,39 @@ static inline bool tree_has_definers(s7_scheme *sc, s7_pointer tree) (is_definer(tree))); } +static s7_pointer simple_stepper(s7_scheme *sc, s7_pointer v) +{ + if ((safe_list_length(v) == 3) && + ((!is_pair(cadr(v))) || + (is_h_safe_c_c(cadr(v))))) + { + s7_pointer step_expr; + step_expr = caddr(v); + if ((is_optimized(step_expr)) && + (((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(v) == cadr(step_expr))) || + ((is_h_safe_c_c(step_expr)) && + (is_pair(cdr(step_expr))) && /* ((v 0 (+))) */ + (car(v) == cadr(step_expr)) && + ((opt_cfunc(step_expr) == sc->add_cs1) || (opt_cfunc(step_expr) == sc->subtract_cs1))) || + ((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(v) == caddr(step_expr))))) + return(step_expr); + } + return(NULL); +} + +static bool is_simple_end(s7_scheme *sc, s7_pointer end) +{ + return((is_optimized(end)) && + (is_pair(cddr(end))) && /* end: (zero? n) */ + (cadr(end) != caddr(end)) && +#if (!WITH_GMP) + ((opt_any1(end) == sc->equal_s_ic) || + (optimize_op(end) == HOP_SAFE_C_SS) || (optimize_op(end) == HOP_SAFE_C_SC))); +#else + ((optimize_op(end) == HOP_SAFE_C_SS) || (optimize_op(end) == HOP_SAFE_C_SC))); +#endif +} + static s7_pointer check_do(s7_scheme *sc) { s7_pointer x, form, code; @@ -67493,111 +69599,78 @@ static s7_pointer check_do(s7_scheme *sc) if ((is_pair(end)) && (is_pair(car(end))) && (is_pair(vars)) && (is_null(cdr(vars))) && - (is_pair(body))) + (is_pair(body)) && (is_pair(car(body))) && (is_symbol(caar(body)))) { /* loop has one step variable, and normal-looking end test */ - s7_pointer v; + s7_pointer v, step_expr; v = car(vars); - if ((is_pair(car(body))) && - (is_symbol(caar(body))) && - (safe_list_length(v) == 3) && - ((!is_pair(cadr(v))) || - (is_h_safe_c_c(cadr(v))))) + step_expr = simple_stepper(sc, v); + if (step_expr) { - s7_pointer step_expr; - step_expr = caddr(v); - - if ((is_optimized(step_expr)) && - (((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(v) == cadr(step_expr))) || - ((is_h_safe_c_c(step_expr)) && - (is_pair(cdr(step_expr))) && /* ((v 0 (+))) */ - (car(v) == cadr(step_expr)) && - ((opt_cfunc(step_expr) == add_cs1) || (opt_cfunc(step_expr) == subtract_cs1))) || - ((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(v) == caddr(step_expr))))) + /* step var is (var const|symbol (op var const)|(op const var)) */ + end = car(end); + if ((is_simple_end(sc, end)) && + (car(v) == cadr(end))) { - /* step var is (var const|symbol (op var const)|(op const var)) */ - end = car(end); + /* end var is (op var const|symbol) using same var as step so at least we can use SIMPLE_DO */ + bool has_set = false, one_line; + one_line = ((is_null(cdr(body))) && (is_pair(car(body)))); - if ((is_optimized(end)) && - (car(v) == cadr(end)) && - (is_pair(cddr(end))) && /* end: (zero? n) */ - (cadr(end) != caddr(end)) && + if (opt_cfunc(step_expr) == sc->add_cs1) + { + set_c_function(step_expr, sc->add_s1); + set_optimize_op(step_expr, HOP_SAFE_C_SC); + } + if (opt_cfunc(step_expr) == sc->subtract_cs1) + { + set_c_function(step_expr, sc->subtract_s1); + set_optimize_op(step_expr, HOP_SAFE_C_SC); + } #if (!WITH_GMP) - ((opt_any1(end) == equal_s_ic) || - (optimize_op(end) == HOP_SAFE_C_SS) || - (optimize_op(end) == HOP_SAFE_C_SC)) -#else - ((optimize_op(end) == HOP_SAFE_C_SS) || - (optimize_op(end) == HOP_SAFE_C_SC)) + if (opt_cfunc(end) == sc->equal_s_ic) + { + set_c_function(end, sc->equal_2); + set_optimize_op(end, HOP_SAFE_C_SC); + } #endif - ) + pair_set_syntax_op(form, OP_SIMPLE_DO); /* simple_do: 1 var easy step/end */ + + if ((one_line) && + ((!is_optimized(car(body))) || (op_no_hop(car(body)) != OP_SAFE_C_C)) && + (is_syntactic_symbol(caar(body))) && + (s7_is_integer(caddr(step_expr))) && + (s7_integer(caddr(step_expr)) == 1) && + (c_function_class(opt_cfunc(step_expr)) == sc->add_class) && + /* we check above that (car(v) == cadr(step_expr)) and (car(v) == cadr(end)) */ + ((c_function_class(opt_cfunc(end)) == sc->equal_class) || + (opt_cfunc(end) == sc->geq_2))) { - /* end var is (op var const|symbol) using same var as step - * so at least we can use SIMPLE_DO - */ - bool has_set = false, one_line; - one_line = ((is_null(cdr(body))) && (is_pair(car(body)))); - - if (opt_cfunc(step_expr) == add_cs1) - { - set_c_function(step_expr, add_s1); - set_optimize_op(step_expr, HOP_SAFE_C_SC); - } - if (opt_cfunc(step_expr) == subtract_cs1) - { - set_c_function(step_expr, subtract_s1); - set_optimize_op(step_expr, HOP_SAFE_C_SC); - } -#if (!WITH_GMP) - if (opt_cfunc(end) == equal_s_ic) + pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); + set_opt_pair2(code, caddr(caar(code))); + pair_set_syntax_op(form, OP_DOTIMES_P); /* dotimes_p: simple + syntax body + 1 expr */ + } + + /* now look for the very common dotimes case */ + if ((((s7_is_integer(caddr(step_expr))) && + (s7_integer(caddr(step_expr)) == 1)) || + ((s7_is_integer(cadr(step_expr))) && + (s7_integer(cadr(step_expr)) == 1))) && + (c_function_class(opt_cfunc(step_expr)) == sc->add_class) && + ((c_function_class(opt_cfunc(end)) == sc->equal_class) || + (opt_cfunc(end) == sc->geq_2))) + { + if (do_is_safe(sc, body, sc->w = list_1(sc, car(v)), sc->nil, &has_set)) { - set_c_function(end, equal_2); - set_optimize_op(end, HOP_SAFE_C_SC); - } -#endif - - pair_set_syntax_op(form, OP_SIMPLE_DO); /* simple_do: 1 var easy step/end */ - - if ((one_line) && - ((!is_optimized(car(body))) || (op_no_hop(car(body)) != OP_SAFE_C_C)) && - (is_syntactic_symbol(caar(body))) && - (s7_is_integer(caddr(step_expr))) && - (s7_integer(caddr(step_expr)) == 1) && - (c_function_class(opt_cfunc(step_expr)) == sc->add_class) && - /* we check above that (car(v) == cadr(step_expr)) - * and that (car(v) == cadr(end)) + /* we're stepping by +1 and going to = + * the final integer check has to wait until run time (symbol value dependent) */ - ((c_function_class(opt_cfunc(end)) == sc->equal_class) || - (opt_cfunc(end) == geq_2))) - { - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); - set_opt_pair2(code, caddr(caar(code))); - pair_set_syntax_op(form, OP_DOTIMES_P); /* dotimes_p: simple + syntax body + 1 expr */ - /* 5 bench, -60 gen, 653 all, 1423 snd-test */ - } - - /* now look for the very common dotimes case */ - if ((((s7_is_integer(caddr(step_expr))) && - (s7_integer(caddr(step_expr)) == 1)) || - ((s7_is_integer(cadr(step_expr))) && - (s7_integer(cadr(step_expr)) == 1))) && - (c_function_class(opt_cfunc(step_expr)) == sc->add_class) && - ((c_function_class(opt_cfunc(end)) == sc->equal_class) || - (opt_cfunc(end) == geq_2))) - { - if (do_is_safe(sc, body, sc->w = list_1(sc, car(v)), sc->nil, &has_set)) - { - /* we're stepping by +1 and going to = - * the final integer check has to wait until run time (symbol value dependent) - */ - pair_set_syntax_op(form, OP_SAFE_DO); /* safe_do: body is safe, step by 1 */ - if ((!has_set) && - (c_function_class(opt_cfunc(end)) == sc->equal_class)) - pair_set_syntax_op(form, OP_SAFE_DOTIMES); /* safe_dotimes: end is = */ - } + pair_set_syntax_op(form, OP_SAFE_DO); /* safe_do: body is safe, step by 1 */ + if ((!has_set) && + (c_function_class(opt_cfunc(end)) == sc->equal_class)) + pair_set_syntax_op(form, OP_SAFE_DOTIMES); /* safe_dotimes: end is = */ } - return(sc->nil); } + return(sc->nil); } } } @@ -67747,23 +69820,7 @@ static int32_t dox_ex(s7_scheme *sc) s7_pointer frame, vars, slot, code, end, endp; s7_function endf; -#if 0 - /* teq tmac index tref tlet tcopy tauto tform tmap titer(much changed) tsort toss-up, - * lt(1) tall tgen(1.5) thash(much slower -- reader? yes--the let(*) -- set has type[char-position?] trouble), call(1) - * fft faster(1.5) - */ - if (!pair_no_opt(sc->code)) - { - endf = s7_optimize(sc, cons_unchecked(sc, cons(sc, sc->do_symbol, sc->code), sc->nil)); - if (endf) - { - sc->value = endf(sc, sc->code); - sc->code = sc->nil; - return(goto_SAFE_DO_END_CLAUSES); - } - set_pair_no_opt(sc->code); - } -#endif + /* fprintf(stderr, "dox: %s\n", DISPLAY(sc->code)); */ new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */ sc->temp10 = frame; @@ -67794,17 +69851,17 @@ static int32_t dox_ex(s7_scheme *sc) sc->envir = frame; sc->temp10 = sc->nil; id = let_id(frame); + /* the c_calls above could have redefined a previous stepper, so that its symbol_id is > frame let_id when we get here, + * so we use symbol_set_local_unchecked below to sidestep the debugger (see zauto.scm: i is a stepper, but then mock-vector-ref uses i as its index) + */ for (slot = let_slots(frame); is_slot(slot); slot = next_slot(slot)) - symbol_set_local(slot_symbol(slot), id, slot); + symbol_set_local_unchecked(slot_symbol(slot), id, slot); end = cadr(sc->code); endp = car(end); endf = c_callee(end); if (is_true(sc, sc->value = endf(sc, endp))) { - /* if no end result exprs, we return nil, but others probably #<unspecified> - * (let ((x (do ((i 0 (+ i 1))) (#t)))) x) -> () - */ sc->code = cdr(end); return(goto_DO_END_CLAUSES); } @@ -67825,7 +69882,7 @@ static int32_t dox_ex(s7_scheme *sc) s7_function f; s7_pointer a; - f = c_callee(slot_expression(slots)); + f = c_callee(slot_expression(slots)); /* e.g. all_x_c_add1 */ a = car(slot_expression(slots)); if (f == all_x_c_c) { @@ -67833,7 +69890,7 @@ static int32_t dox_ex(s7_scheme *sc) a = cdr(a); } - while (true) /* thash titer */ + while (true) { slot_set_value(slots, f(sc, a)); if (is_true(sc, sc->value = endf(sc, endp))) @@ -67861,125 +69918,124 @@ static int32_t dox_ex(s7_scheme *sc) } else /* there is a body */ { - if (!is_unsafe_do(sc->code)) + s7_pointer slots; + slots = let_slots(sc->envir); + /* is let activated? also multiexpr body and other all_x? */ + + if ((is_null(cdr(code))) && + (is_pair(car(code)))) { - s7_pointer slots; - slots = let_slots(sc->envir); - /* is let activated? also multiexpr body and other all_x? */ - - if ((is_null(cdr(code))) && - (is_pair(car(code)))) + s7_pointer lcode; + s7_function body = NULL; + lcode = car(code); + + if ((!pair_no_opt(code)) && + ((has_optlist(code)) || (has_safe_steppers(sc, sc->envir)))) + body = new_s7_optimize(sc, code, sc->code); + + if (!body) { - s7_pointer lcode; - s7_function body = NULL; - lcode = car(code); - - if ((!pair_no_opt(code)) && - (has_safe_steppers(sc, sc->envir))) - { - body = s7_optimize_nr(sc, code); - if (!body) - set_pair_no_opt(code); - } - if (!body) - { - if (is_all_x_safe(sc, lcode)) - body = all_x_eval(sc, code, sc->envir, let_symbol_is_safe); - } - if (body) - { - while (true) - { - s7_pointer slot1; - body(sc, lcode); - for (slot1 = slots; is_slot(slot1); slot1 = next_slot(slot1)) - if (is_pair(slot_expression(slot1))) - slot_set_value(slot1, c_call(slot_expression(slot1))(sc, car(slot_expression(slot1)))); - if (is_true(sc, sc->value = endf(sc, endp))) - { - sc->code = cdr(end); - return(goto_DO_END_CLAUSES); - } - } - } + if (is_all_x_safe(sc, lcode)) + body = all_x_eval(sc, code, sc->envir, let_symbol_is_safe); } - else /* more than one expr */ + if (body) { - s7_pointer p; - bool use_opts = false; - int32_t body_len = 0; - p = code; - - if ((!pair_no_opt(code)) && - (has_safe_steppers(sc, sc->envir))) + while (true) { - if (setjmp(sc->opt_exit) == 0) + s7_pointer slot1; + body(sc, lcode); + for (slot1 = slots; is_slot(slot1); slot1 = next_slot(slot1)) + if (is_pair(slot_expression(slot1))) + slot_set_value(slot1, c_call(slot_expression(slot1))(sc, car(slot_expression(slot1)))); + if (is_true(sc, sc->value = endf(sc, endp))) { - start_opts(sc); - for (; is_pair(p); p = cdr(p), body_len++) - if (!cell_optimize(sc, p)) - { - set_pair_no_opt(code); - p = code; - break; - } - use_opts = is_null(p); + sc->code = cdr(end); + return(goto_DO_END_CLAUSES); } } - - if (p == code) + } + } + else /* more than one expr */ + { + s7_pointer p; + bool use_opts = false; + int32_t body_len = 0; + p = code; + + if ((!pair_no_opt(code)) && + (has_safe_steppers(sc, sc->envir))) + { + if (setjmp(sc->opt_exit) == 0) { - for (; is_pair(p); p = cdr(p)) - if (!is_all_x_safe(sc, car(p))) - break; + start_opts(sc); + for (; is_pair(p); p = cdr(p), body_len++) + if (!cell_optimize(sc, p)) + { + set_pair_no_opt(code); + p = code; + break; + } + use_opts = is_null(p); } - - if (is_null(p)) + } + + if (p == code) + { + for (; is_pair(p); p = cdr(p)) + if (!is_all_x_safe(sc, car(p))) + break; + } + + if (is_null(p)) + { + int32_t i; + if (!use_opts) + annotate_args(sc, code, sc->envir); + + while (true) { - int32_t i; - if (!use_opts) - annotate_args(sc, code, sc->envir); - - while (true) + s7_pointer slot; + if (use_opts) { - s7_pointer slot; - if (use_opts) - { - sc->pc = 0; - for (i = 0; i < body_len; i++) - { - opt_info *o; - o = sc->opts[sc->pc]; - o->v7.fp(o); - sc->pc++; - } - } - else - { - for (p = code; is_pair(p); p = cdr(p)) - c_call(p)(sc, car(p)); - } - - for (slot = slots; is_slot(slot); slot = next_slot(slot)) - if (is_pair(slot_expression(slot))) - slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot)))); - if (is_true(sc, sc->value = endf(sc, endp))) + sc->pc = 0; + for (i = 0; i < body_len; i++) { - sc->code = cdr(end); - return(goto_DO_END_CLAUSES); + opt_info *o; + o = sc->opts[sc->pc]; + o->v[0].fp(o); + sc->pc++; } } + else + { + for (p = code; is_pair(p); p = cdr(p)) + c_call(p)(sc, car(p)); + } + + for (slot = slots; is_slot(slot); slot = next_slot(slot)) + if (is_pair(slot_expression(slot))) + slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot)))); + if (is_true(sc, sc->value = endf(sc, endp))) + { + sc->code = cdr(end); + return(goto_DO_END_CLAUSES); + } } } - set_unsafe_do(sc->code); } } +#if 0 + fprintf(stderr, "%s\n", DISPLAY(sc->code)); + /* (set! (v i) ..) + * ((set! x y) (set! y (vector-ref vc i))) -- tsort -- these seem allxable: slower with begin?? + */ +#endif if ((is_null(cdr(code))) && /* one expr */ (is_pair(car(code)))) { code = car(code); - + if ((is_syntactic_pair(code)) || (is_syntactic_symbol(car(code)))) { @@ -68006,24 +70062,18 @@ static int32_t simple_do_ex(s7_scheme *sc, s7_pointer code) s7_function stepf, endf; s7_function func; - body = car(opt_pair2(code)); + code = cdr(code); + body = caddr(code); + /* fprintf(stderr, "code: %s, body: %s\n", DISPLAY_80(code), DISPLAY_80(body)); */ -#if S7_DEBUGGING - if (!is_symbol(car(body))) - { - fprintf(stderr, "simple_do_ex car(body) not symbol: %s\n", DISPLAY_80(code)); - return(fall_through); - } -#endif - - if (!pair_no_opt(opt_pair2(code))) + if (!pair_no_opt(cddr(code))) { - func = s7_optimize_nr(sc, opt_pair2(code)); - if (!func) + func = new_s7_optimize(sc, cddr(code), code); + if (!func) /* thash hits this */ { - set_pair_no_opt(opt_pair2(code)); - return(fall_through); - } + set_pair_no_opt(cddr(code)); + return(fall_through); + } } else return(fall_through); @@ -68058,14 +70108,24 @@ static int32_t simple_do_ex(s7_scheme *sc, s7_pointer code) { opt_info *o; s7_pointer (*fp)(void *o); - cur_sc = sc; o = sc->opts[0]; - fp = o->v7.fp; - for (i = start; i < stop; i++) + fp = o->v[0].fp; + if (fp == opt_p_ppp_sss) { - slot_set_value(ctr, make_integer(sc, i)); - sc->pc = 0; - fp(o); + for (i = start; i < stop; i++) + { + slot_set_value(ctr, make_integer(sc, i)); + o->v[4].p_ppp_f(o->sc, slot_value(o->v[1].p), slot_value(o->v[2].p), slot_value(o->v[3].p)); + } + } + else + { + for (i = start; i < stop; i++) + { + slot_set_value(ctr, make_integer(sc, i)); + sc->pc = 0; + fp(o); + } } } else @@ -68104,26 +70164,21 @@ static int32_t simple_do_ex(s7_scheme *sc, s7_pointer code) static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool safe_step) { - s7_int body_len, end; + s7_int end; if (safe_step) set_safe_stepper(sc->args); else set_safe_stepper(dox_slot1(sc->envir)); - body_len = s7_list_length(sc, code); /* I think safe_step means the stepper is completely unproblematic */ - if (body_len == 1) /* && (safe_step)) */ + if (is_null(cdr(code))) { s7_function func; if (pair_no_opt(code)) return(false); - func = s7_optimize_nr(sc, code); - if (!func) - { - set_pair_no_opt(code); - return(false); - } - + func = new_s7_optimize(sc, code, scc); + if (!func) + return(false); end = denominator(slot_value(sc->args)); if (safe_step) { @@ -68133,22 +70188,21 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf (func == opt_cell_any_nr)) { opt_info *o; - cur_sc = sc; o = sc->opts[0]; if (func == opt_float_any_nr) { s7_double (*fd)(void *o); - fd = o->v7.fd; + fd = o->v[0].fd; if ((fd == opt_d_id_sf) && /* by far the most common case in clm: (outa i ...) etc */ - (is_slot(o->v1.p)) && - (stepper == slot_value(o->v1.p))) + (is_slot(o->v[1].p)) && + (stepper == slot_value(o->v[1].p))) { opt_info *o1; s7_int end8; s7_d_id_t f0; - f0 = o->v3.d_id_f; + f0 = o->v[3].d_id_f; o1 = sc->opts[1]; - fd = o1->v7.fd; + fd = o1->v[0].fd; end8 = end - 8; while (integer(stepper) < end8) LOOP_8(sc->pc = 1; f0(integer(stepper), fd(o1)); integer(stepper)++); @@ -68171,15 +70225,15 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf else { s7_pointer (*fp)(void *o); - fp = o->v7.fp; + fp = o->v[0].fp; /* an experiment */ if ((fp == opt_p_pip_ssc) && /* or any opt without f? */ - (stepper == slot_value(o->v2.p)) && /* i.e. index by do counter */ - (o->v3.p_pip_f == string_set_unchecked)) /* or any similar setter? */ + (stepper == slot_value(o->v[2].p)) && /* i.e. index by do counter */ + (o->v[3].p_pip_f == string_set_unchecked)) /* or any similar setter? */ { char *str; - str = (char *)(string_value(slot_value(o->v1.p) + integer(stepper))); - local_memset((void *)str, character(o->v4.p), end - integer(stepper)); + str = (char *)(string_value(slot_value(o->v[1].p) + integer(stepper))); + local_memset((void *)str, character(o->v[4].p), end - integer(stepper)); integer(stepper) = end; /* altogether 100 times as fast!? see callgrind data below */ } @@ -68199,15 +70253,14 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf { s7_int (*fi)(void *o); opt_info *o; - cur_sc = sc; o = sc->opts[0]; - fi = o->v7.fi; + fi = o->v[0].fi; for (; integer(stepper) < end; integer(stepper)++) { sc->pc = 0; fi(o); - /* if fi = opt_i_i_s for example, -> o->v2.i_i_f(integer(slot_value(o->v1.p))) - * and o->v2.i_i_f can be pulled out leaving a loop of sc->pc = 0; ov2(integer(slot_value(o->v1.p))); + /* if fi = opt_i_i_s for example, -> o->v[2].i_i_f(integer(slot_value(o->v[1].p))) + * and o->v[2].i_i_f can be pulled out leaving a loop of sc->pc = 0; ov2(integer(slot_value(o->v[1].p))); */ } } @@ -68229,9 +70282,8 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf { opt_info *o; s7_pointer (*fp)(void *o); - cur_sc = sc; o = sc->opts[0]; - fp = o->v7.fp; + fp = o->v[0].fp; while (true) { sc->pc = 0; @@ -68268,6 +70320,9 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf if (setjmp(sc->opt_exit) == 0) { s7_pointer p; + s7_int body_len; + + body_len = s7_list_length(sc, code); start_opts(sc); if (!no_float_opt(code)) @@ -68293,7 +70348,7 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf sc->pc = 0; for (i = 0; i < body_len; i++) { - sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]); + sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); sc->pc++; } } @@ -68309,7 +70364,7 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf sc->pc = 0; for (i = 0; i < body_len; i++) { - sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]); + sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); sc->pc++; } @@ -68331,8 +70386,8 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf start = sc->opts[sc->pc]; if (!cell_optimize(sc, p)) break; - if (start->v7.fp == d_to_p) - start->v7.fp = d_to_p_nr; + if (start->v[0].fp == d_to_p) + start->v[0].fp = d_to_p_nr; } if (is_null(p)) @@ -68350,7 +70405,7 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf { opt_info *o; o = sc->opts[sc->pc]; - o->v7.fp(o); + o->v[0].fp(o); sc->pc++; } } @@ -68368,7 +70423,7 @@ static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool saf { opt_info *o; o = sc->opts[sc->pc]; - o->v7.fp(o); + o->v[0].fp(o); sc->pc++; } @@ -68438,7 +70493,7 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool return(fall_through); } } - + if (is_null(p)) { s7_int k, end; @@ -68456,24 +70511,23 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool xp = slot_value(let_slots(sc->envir)); ip = slot_value(step_slot); first = sc->opts[0]; - f1 = first->v7.fd; + f1 = first->v[0].fd; integer(ip) = numerator(stepper); sc->pc = 0; set_real(xp, f1(first)); pc2 = ++sc->pc; second = sc->opts[pc2]; - f2 = second->v7.fd; + f2 = second->v[0].fd; f2(second); if ((f2 == opt_fmv) && - (f1 == opt_d_dd_ff_o2)) + (f1 == opt_d_dd_ff_o2) && + (first->v[3].d_dd_f == add_d_dd)) { for (k = numerator(stepper) + 1; k < end; k++) { - s7_double x1; integer(ip) = k; sc->pc = 0; - x1 = first->v4.d_v_f(first->v1.obj); - set_real(xp, first->v3.d_dd_f(x1, first->v5.d_v_f(first->v2.obj))); + set_real(xp, first->v[4].d_v_f(first->v[1].obj) + first->v[5].d_v_f(first->v[2].obj)); sc->pc = pc2; opt_fmv(second); } @@ -68499,12 +70553,12 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool sc->pc = 0; for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p)) { - set_real(slot_value(p), sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc])); + set_real(slot_value(p), sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc])); sc->pc++; } for (i = 0; i < body_len; i++) { - sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]); + sc->opts[sc->pc]->v[0].fd(sc->opts[sc->pc]); sc->pc++; } } @@ -68674,7 +70728,7 @@ static int32_t safe_do_ex(s7_scheme *sc) if ((s7_integer(init_val) == s7_integer(end_val)) || ((s7_integer(init_val) > s7_integer(end_val)) && - (opt_cfunc(caadr(code)) == geq_2))) + (opt_cfunc(caadr(code)) == sc->geq_2))) { sc->value = sc->T; sc->code = cdadr(code); @@ -68688,7 +70742,7 @@ static int32_t safe_do_ex(s7_scheme *sc) if ((!is_unsafe_do(sc->code)) && ((!is_optimized(caadr(code))) || - (opt_cfunc(caadr(code)) != geq_2))) + (opt_cfunc(caadr(code)) != sc->geq_2))) { if (opt_dotimes(sc, cddr(sc->code), sc->code, false)) return(goto_SAFE_DO_END_CLAUSES); @@ -68756,7 +70810,7 @@ static int32_t dotimes_p_ex(s7_scheme *sc) } if ((!is_unsafe_do(code)) && - (opt_cfunc(caadr(code)) != geq_2)) + (opt_cfunc(caadr(code)) != sc->geq_2)) { s7_pointer old_args, old_init; @@ -68872,7 +70926,7 @@ static bool closure_star_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type, val = symbol_to_value_unexamined(sc, car(code)); if ((val == opt_lambda_unchecked(code)) || ((val) && - (typesflag(val) == (uint16_t)type) && + (typesflag(val) == type) && ((closure_arity(val) >= args) || (closure_star_arity_to_int(sc, val) >= args)) && (set_opt_lambda(code, val)))) @@ -68882,38 +70936,39 @@ static bool closure_star_is_ok_1(s7_scheme *sc, s7_pointer code, uint16_t type, } /* it is almost never the case that we already have the value and can see it in the current environment directly, - * but once found, the value usually matches the current (opt_lambda(code)) + * but once found, the value usually matches the current (opt_lambda(code)), but it might not: + * symbol_ctr is almost useless. We only care if it is 1. If we save symbol_ctr in opt2(code), + * they can be equal, local_slot can be ok, its value can equal opt_lambda(code), typesflag(opt_lambda(code)) + * can match the target type, and yet opt_lambda is wrong! (recursion backs up, local_slot is actually + * out-of-date, symbol has not been redefined). So, we can't be very smart here. */ - #define closure_is_ok(Sc, Code, Type, Args) \ (((symbol_ctr(car(Code)) == 1) && \ (unchecked_type(local_slot(car(Code))) == T_SLOT) && \ (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \ (closure_is_ok_1(Sc, Code, Type, Args))) -#define closure_is_equal(Sc, Code) \ - (((symbol_ctr(car(Code)) == 1) && \ - (unchecked_type(local_slot(car(Code))) == T_SLOT) && \ - (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \ - ((sc->last_function = symbol_to_value_unexamined(Sc, car(Code))) == opt_lambda_unchecked(Code))) - #define closure_star_is_ok(Sc, Code, Type, Args) \ (((symbol_ctr(car(Code)) == 1) && \ (unchecked_type(local_slot(car(Code))) == T_SLOT) && \ (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \ (closure_star_is_ok_1(Sc, Code, Type, Args))) -#define MATCH_UNSAFE_CLOSURE (T_CLOSURE) -#define MATCH_SAFE_CLOSURE (T_CLOSURE | T_SAFE_CLOSURE) -#define MATCH_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR) -#define MATCH_SAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_SAFE_CLOSURE) +#define MATCH_UNSAFE_CLOSURE (T_CLOSURE) +#define MATCH_SAFE_CLOSURE (T_CLOSURE | T_SAFE_CLOSURE) +#define MATCH_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR) +#define MATCH_SAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_SAFE_CLOSURE) +#define MATCH_UNSAFE_CLOSURE_P (T_CLOSURE | T_ONE_FORM) +#define MATCH_SAFE_CLOSURE_P (T_CLOSURE | T_SAFE_CLOSURE | T_ONE_FORM) +#define MATCH_UNSAFE_CLOSURE_M (T_CLOSURE | T_MULTIFORM) +#define MATCH_SAFE_CLOSURE_M (T_CLOSURE | T_SAFE_CLOSURE | T_MULTIFORM) +#define MATCH_SAFE_CLOSURE_A (T_CLOSURE | T_SAFE_CLOSURE | T_ONE_FORM | T_MULTIFORM) /* since T_HAS_METHODS is on if there might be methods, this can protect us from that case */ - /* unknown ops */ -static int32_t fixup_unknown_op(s7_pointer code, s7_pointer func, int32_t op) +static int32_t fixup_unknown_op(s7_pointer code, s7_pointer func, opcode_t op) { /* sc arg used if debugging */ set_optimize_op(code, op); @@ -68932,30 +70987,44 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f) if ((!has_methods(f)) && (is_null(closure_args(f)))) { - if (is_safe_closure(f)) + s7_pointer body; + body = closure_body(f); + if (is_null(cdr(body))) { - s7_pointer body; - body = closure_body(f); - set_optimize_op(code, OP_SAFE_THUNK); - if (is_null(cdr(body))) + if (is_safe_closure(f)) { - if (is_optimized(car(body))) - set_optimize_op(code, OP_SAFE_THUNK_P); + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, sc->envir); + set_optimize_op(code, OP_SAFE_THUNK_A); + set_closure_has_all_x(f); + } else { - if ((is_pair(car(body))) && - (is_syntactic_symbol(caar(body)))) + set_optimize_op(code, OP_SAFE_THUNK_P); + if (is_very_safe_closure(f)) { - set_optimize_op(code, OP_SAFE_THUNK_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); + s7_pointer slot; + slot = symbol_to_slot(sc, car(code)); + if (is_recur(slot)) + set_optimize_op(code, OP_SAFE_THUNK_LP); } + set_closure_has_one_form(f); } } - set_opt_lambda(code, f); - return(goto_EVAL); + else + { + set_closure_has_one_form(f); + set_optimize_op(code, OP_THUNK_P); + } } - return(fixup_unknown_op(code, f, OP_THUNK)); + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_THUNK : OP_THUNK); + } + set_opt_lambda(code, f); + return(goto_EVAL); } /* we can't ignore the recheck here (i.e. set the hop bit) because the closure, even if a global can be set later: * (begin (define *x* #f) (define (test) (display (*x*))) (define (setx n) (set! *x* (lambda () n))) (setx 1) (test) (setx 2) (test)) @@ -68971,7 +71040,8 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f) (!is_slot(symbol_to_slot(sc, car(code))))) eval_error_no_return(sc, sc->unbound_variable_symbol, "~A: unbound variable", 20, car(code)); } - return(fall_through); + return(fixup_unknown_op(code, f, OP_S)); + /* return(fall_through); */ } static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) @@ -69018,30 +71088,53 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) if ((!has_methods(f)) && (closure_arity_to_int(sc, f) == 1)) { + s7_pointer body; + body = closure_body(f); if (sym_case) + set_opt_sym2(code, cadr(code)); + else set_opt_con2(code, cadr(code)); + if (is_safe_closure(f)) { - set_opt_sym2(code, cadr(code)); - if (is_safe_closure(f)) + if (is_null(cdr(body))) { - s7_pointer body; - set_optimize_op(code, OP_SAFE_CLOSURE_S); - body = closure_body(f); - if ((is_null(cdr(body))) && - (!is_optimized(car(body))) && /* might be h_safe_c_c->if_x2 or whatever */ - (is_pair(car(body))) && - (is_syntactic_symbol(caar(body)))) + set_closure_has_one_form(f); + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, sc->envir); + set_optimize_op(code, (sym_case) ? OP_SAFE_CLOSURE_S_A : OP_SAFE_CLOSURE_C_A); + set_closure_has_all_x(f); + } + else { - set_optimize_op(code, OP_SAFE_CLOSURE_S_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); + set_optimize_op(code, (sym_case) ? OP_SAFE_CLOSURE_S_P : OP_SAFE_CLOSURE_C_P); + if ((sym_case) && + (is_very_safe_closure(f))) + { + s7_pointer slot; + slot = symbol_to_slot(sc, car(code)); + if (is_recur(slot)) + set_optimize_op(code, OP_SAFE_CLOSURE_S_LP); + } } } - else set_optimize_op(code, OP_CLOSURE_S); + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (sym_case) ? OP_SAFE_CLOSURE_S : OP_SAFE_CLOSURE_C); + } } else { - set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_C : OP_CLOSURE_C); - set_opt_con2(code, cadr(code)); + if (is_null(cdr(body))) + { + set_closure_has_one_form(f); + set_optimize_op(code, (sym_case) ? OP_CLOSURE_S_P : OP_CLOSURE_C_P); + } + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (sym_case) ? OP_CLOSURE_S : OP_CLOSURE_C); + } } set_opt_lambda(code, f); return(goto_EVAL); @@ -69050,7 +71143,7 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) case T_CLOSURE_STAR: if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f))) && + (lambda_has_simple_defaults(closure_body(f))) && (closure_star_arity_to_int(sc, f) >= 1)) { annotate_arg(sc, cdr(code), sc->envir); @@ -69110,6 +71203,106 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f) return(fixup_unknown_op(code, f, (sym_case) ? OP_S_S : OP_S_C)); } +static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) +{ + s7_pointer code; + code = sc->code; + /* fprintf(stderr, "%s: %s %d\n", __func__, DISPLAY_80(code), type(f)); */ +#if S7_DEBUGGING + if (!has_all_x(cdr(code))) + fprintf(stderr, "unknown_a_ex missing _a support? %s\n", DISPLAY_80(code)); +#endif + + switch (type(f)) + { + case T_C_FUNCTION: + case T_C_RST_ARGS_FUNCTION: + if ((c_function_required_args(f) > 1) || + (c_function_all_args(f) == 0)) + break; + + case T_C_OPT_ARGS_FUNCTION: + case T_C_ANY_ARGS_FUNCTION: + set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_A : OP_C_A); + set_c_function(code, f); + return(goto_EVAL); + + case T_CLOSURE: + if ((!has_methods(f)) && + (closure_arity_to_int(sc, f) == 1)) + { + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(f); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(f); + + if (one_form) + { + set_closure_has_one_form(f); + if (safe_case) + { + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, sc->envir); + set_optimize_op(code, OP_SAFE_CLOSURE_A_A); + set_closure_has_all_x(f); + } + else + { + set_optimize_op(code, OP_SAFE_CLOSURE_A_P); + if (is_very_safe_closure(f)) + { + s7_pointer slot; + slot = symbol_to_slot(sc, car(code)); + if (is_recur(slot)) + set_optimize_op(code, OP_SAFE_CLOSURE_A_LP); + } + } + } + else set_optimize_op(code, OP_CLOSURE_A_P); + } + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (safe_case) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A); + } + set_opt_lambda(code, f); + return(goto_EVAL); + } + break; + + case T_CLOSURE_STAR: + if ((!has_methods(f)) && + (lambda_has_simple_defaults(closure_body(f))) && + (closure_star_arity_to_int(sc, f) >= 1)) + return(fixup_unknown_op(code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)); + break; + + case T_INT_VECTOR: + case T_FLOAT_VECTOR: + case T_VECTOR: + return(fixup_unknown_op(code, f, OP_VECTOR_A)); + + case T_STRING: return(fixup_unknown_op(code, f, OP_STRING_A)); + case T_PAIR: return(fixup_unknown_op(code, f, OP_PAIR_A)); + case T_C_OBJECT: return(fixup_unknown_op(code, f, OP_C_OBJECT_A)); + case T_LET: return(fixup_unknown_op(code, f, ((is_pair(cadr(code))) && (caadr(code) == sc->quote_symbol)) ? OP_ENVIRONMENT_Q : OP_ENVIRONMENT_A)); + case T_HASH_TABLE: return(fixup_unknown_op(code, f, OP_HASH_TABLE_A)); + case T_GOTO: return(fixup_unknown_op(code, f, OP_GOTO_A)); + + default: + /* macro, continuation */ + break; + } + if ((is_symbol(car(code))) && + (!is_slot(symbol_to_slot(sc, car(code))))) + eval_error_no_return(sc, sc->unbound_variable_symbol, "~A: unbound variable", 20, car(code)); + return(fixup_unknown_op(code, f, OP_S_A)); /* closure with methods etc */ + /* return(fall_through); */ +} + static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f) { bool s1, s2; @@ -69156,38 +71349,67 @@ static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f) case T_CLOSURE: if (has_methods(f)) break; - if (closure_arity_to_int(sc, f) == 2) + if (((s1) || (s2)) && + (closure_arity_to_int(sc, f) == 2)) { - if (s1) + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(f); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(f); + + if ((s1) && (s2)) { - if (is_safe_closure(f)) - set_optimize_op(code, (s2) ? ((is_null(cdr(closure_body(f)))) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SS_B) : OP_SAFE_CLOSURE_SC); - else + if (one_form) { - if (!s2) - set_optimize_op(code, OP_CLOSURE_SC); - else + set_closure_has_one_form(f); + if (safe_case) { - s7_pointer body; - body = closure_body(f); - if ((is_null(cdr(body))) && - (is_pair(car(body))) && - (is_syntactic(caar(body)))) + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, sc->envir); + set_optimize_op(code, OP_SAFE_CLOSURE_SS_A); + set_closure_has_all_x(f); + } + else { - set_optimize_op(code, OP_CLOSURE_SS_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); + set_optimize_op(code, OP_SAFE_CLOSURE_SS_P); + if (is_very_safe_closure(f)) + { + s7_pointer slot; + slot = symbol_to_slot(sc, car(code)); + if (is_recur(slot)) + set_optimize_op(code, OP_SAFE_CLOSURE_SS_LP); + } } - else set_optimize_op(code, OP_CLOSURE_SS); } + else set_optimize_op(code, OP_CLOSURE_SS_P); + } + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (safe_case) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS); } } else { - if (!s2) break; - set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS); + if (one_form) + { + set_closure_has_one_form(f); + if (safe_case) + set_optimize_op(code, (s1) ? OP_SAFE_CLOSURE_SC_P : OP_SAFE_CLOSURE_CS_P); + else set_optimize_op(code, (s1) ? OP_CLOSURE_SC_P : OP_CLOSURE_CS_P); + } + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (safe_case) ? ((s1) ? OP_SAFE_CLOSURE_SC : OP_SAFE_CLOSURE_CS) : ((s1) ? OP_CLOSURE_SC : OP_CLOSURE_CS)); + } } - if (s2) set_opt_sym2(code, caddr(code)); else set_opt_con2(code, caddr(code)); + if (s2) + set_opt_sym2(code, caddr(code)); + else set_opt_con2(code, caddr(code)); set_opt_lambda(code, f); return(goto_EVAL); } @@ -69195,7 +71417,7 @@ static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f) case T_CLOSURE_STAR: if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f))) && + (lambda_has_simple_defaults(closure_body(f))) && (closure_star_arity_to_int(sc, f) >= 2)) { annotate_args(sc, cdr(code), sc->envir); @@ -69259,14 +71481,13 @@ static int32_t unknown_all_s_ex(s7_scheme *sc, s7_pointer f) (closure_arity_to_int(sc, f) == num_args)) { annotate_args(sc, cdr(code), sc->envir); - return(fixup_unknown_op(code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_ALL_X : - ((is_null(cdr(closure_body(f)))) ? OP_CLOSURE_ALL_S_P : OP_CLOSURE_ALL_S))); + return(fixup_unknown_op(code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_S)); } break; case T_CLOSURE_STAR: if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f))) && + (lambda_has_simple_defaults(closure_body(f))) && (closure_star_arity_to_int(sc, f) >= num_args)) { annotate_args(sc, cdr(code), sc->envir); @@ -69283,100 +71504,6 @@ static int32_t unknown_all_s_ex(s7_scheme *sc, s7_pointer f) return(fall_through); } -static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f) -{ - s7_pointer code; - code = sc->code; - -#if S7_DEBUGGING - if (!has_all_x(cdr(code))) - fprintf(stderr, "unknown_a_ex missing _a support? %s\n", DISPLAY_80(code)); -#endif - - switch (type(f)) - { - case T_C_FUNCTION: - case T_C_RST_ARGS_FUNCTION: - if ((c_function_required_args(f) > 1) || - (c_function_all_args(f) == 0)) - break; - - case T_C_OPT_ARGS_FUNCTION: - case T_C_ANY_ARGS_FUNCTION: - set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_A : OP_C_A); - set_c_function(code, f); - return(goto_EVAL); - - case T_CLOSURE: - if ((!has_methods(f)) && - (closure_arity_to_int(sc, f) == 1)) - { - if (is_safe_closure(f)) - { - s7_pointer slot; - slot = symbol_to_slot(sc, car(code)); - if ((is_very_safe_closure(f)) && - (is_recur(slot))) - { -#if S7_DEBUGGING - if (slot != local_slot(car(code))) - fprintf(stderr, "%s[%d]: local slot %p != slot %p\n", __func__, __LINE__, local_slot(car(code)), slot); -#endif - set_optimize_op(code, OP_SAFE_LCLOSURE_A); - } - else set_optimize_op(code, OP_SAFE_CLOSURE_A); - } - else - { - set_optimize_op(code, OP_CLOSURE_A); - if (!is_global(car(code))) - { - s7_pointer body; - body = closure_body(f); - if ((is_null(cdr(body))) && - (is_pair(car(body))) && - (is_syntactic_symbol(caar(body)))) - { - set_optimize_op(code, OP_CLOSURE_A_P); - if (!is_syntactic_pair(car(body))) - pair_set_syntax_op(car(body), symbol_syntax_op_checked(car(body))); - } - } - } - set_opt_lambda(code, f); - return(goto_EVAL); - } - break; - - case T_CLOSURE_STAR: - if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f))) && - (closure_star_arity_to_int(sc, f) >= 1)) - return(fixup_unknown_op(code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)); - break; - - case T_INT_VECTOR: - case T_FLOAT_VECTOR: - case T_VECTOR: - return(fixup_unknown_op(code, f, OP_VECTOR_A)); - - case T_STRING: return(fixup_unknown_op(code, f, OP_STRING_A)); - case T_PAIR: return(fixup_unknown_op(code, f, OP_PAIR_A)); - case T_C_OBJECT: return(fixup_unknown_op(code, f, OP_C_OBJECT_A)); - case T_LET: return(fixup_unknown_op(code, f, ((is_pair(cadr(code))) && (caadr(code) == sc->quote_symbol)) ? OP_ENVIRONMENT_Q : OP_ENVIRONMENT_A)); - case T_HASH_TABLE: return(fixup_unknown_op(code, f, OP_HASH_TABLE_A)); - case T_GOTO: return(fixup_unknown_op(code, f, OP_GOTO_A)); - - default: - /* macro, continuation */ - break; - } - if ((is_symbol(car(code))) && - (!is_slot(symbol_to_slot(sc, car(code))))) - eval_error_no_return(sc, sc->unbound_variable_symbol, "~A: unbound variable", 20, car(code)); - return(fixup_unknown_op(code, f, OP_S_A)); /* closure with methods etc */ - /* return(fall_through); */ -} static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) { @@ -69403,7 +71530,44 @@ static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) if ((!has_methods(f)) && (closure_arity_to_int(sc, f) == 2)) { - set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA); + s7_pointer body; + bool one_form, safe_case; + + body = closure_body(f); + one_form = is_null(cdr(body)); + safe_case = is_safe_closure(f); + + if (one_form) + { + set_closure_has_one_form(f); + if (safe_case) + { + if (is_all_x_safe(sc, car(body))) + { + annotate_arg(sc, body, sc->envir); + set_optimize_op(code, OP_SAFE_CLOSURE_AA_A); + set_closure_has_all_x(f); + } + else + { + set_optimize_op(code, OP_SAFE_CLOSURE_AA_P); + if (is_very_safe_closure(f)) + { + s7_pointer slot; + slot = symbol_to_slot(sc, car(code)); + if (is_recur(slot)) + set_optimize_op(code, OP_SAFE_CLOSURE_AA_LP); + } + } + } + else set_optimize_op(code, OP_CLOSURE_AA_P); + } + else + { + set_closure_has_multiform(f); + set_optimize_op(code, (safe_case) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA); + } + set_opt_lambda(code, f); return(goto_EVAL); } @@ -69411,7 +71575,7 @@ static int32_t unknown_aa_ex(s7_scheme *sc, s7_pointer f) case T_CLOSURE_STAR: if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f)))) + (lambda_has_simple_defaults(closure_body(f)))) { set_arglist_length(code, small_int(2)); if (closure_star_arity_to_int(sc, f) == 2) @@ -69464,6 +71628,7 @@ static int32_t unknown_all_x_ex(s7_scheme *sc, s7_pointer f) (num_args == 3)) set_optimize_op(code, OP_SAFE_CLOSURE_SAA); else set_optimize_op(code, OP_SAFE_CLOSURE_ALL_X); + /* recur doesn't happen much here */ } else set_optimize_op(code, OP_CLOSURE_ALL_X); set_opt_lambda(code, f); @@ -69473,7 +71638,7 @@ static int32_t unknown_all_x_ex(s7_scheme *sc, s7_pointer f) case T_CLOSURE_STAR: if ((!has_methods(f)) && - (has_simple_arg_defaults(closure_body(f))) && + (lambda_has_simple_defaults(closure_body(f))) && (closure_star_arity_to_int(sc, f) >= num_args)) { set_arglist_length(code, small_int(num_args)); @@ -69584,7 +71749,7 @@ static int32_t read_s_ex(s7_scheme *sc) { if ((is_string_port(port)) && (port_data_size(port) <= port_position(port))) - sc->value = sc->eof_object; + sc->value = eof_object; else { push_input_port(sc, port); @@ -69663,7 +71828,7 @@ static int32_t vector_a_ex(s7_scheme *sc) } } } - sc->value = vector_ref_1(sc, v, set_plist_1(sc, x)); + sc->value = vector_ref_1(sc, v, set_plist_1(sc, x), true); return(goto_START); } @@ -69779,9 +71944,9 @@ static void apply_c_function(s7_scheme *sc) /* -------- C-b s7_int len; len = safe_list_length(sc->args); if (len < c_function_required_args(sc->code)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); if (c_function_all_args(sc->code) < len) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); sc->value = c_function_call(sc->code)(sc, sc->args); } @@ -69790,7 +71955,7 @@ static void apply_c_opt_args_function(s7_scheme *sc) /* -------- s7_int len; len = safe_list_length(sc->args); if (c_function_all_args(sc->code) < len) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); sc->value = c_function_call(sc->code)(sc, sc->args); } @@ -69799,7 +71964,7 @@ static void apply_c_rst_args_function(s7_scheme *sc) /* -------- s7_int len; len = safe_list_length(sc->args); if (len < c_function_required_args(sc->code)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); sc->value = c_function_call(sc->code)(sc, sc->args); /* sc->code here need not match sc->code before the function call (map for example) */ } @@ -69815,10 +71980,10 @@ static void apply_c_macro(s7_scheme *sc) /* -------- C-bas len = safe_list_length(sc->args); if (len < c_macro_required_args(sc->code)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); if (c_macro_all_args(sc->code) < len) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); sc->code = c_macro_call(sc->code)(sc, sc->args); if (is_multiple_value(sc->code)) /* can this happen? s7_values splices before returning, and `(values ...) is handled later */ @@ -69851,15 +72016,15 @@ static void apply_syntax(s7_scheme *sc) /* -------- s else len = 0; if (len < syntax_min_args(sc->code)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); if ((syntax_max_args(sc->code) < len) && (syntax_max_args(sc->code) != -1)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); sc->cur_op = (opcode_t)syntax_opcode(sc->code); /* (apply begin '((define x 3) (+ x 2))) */ /* I used to have elaborate checks here for embedded circular lists, but now i think that is the caller's problem */ -/* CDR! */ sc->code = cons(sc, sc->code, sc->args); + sc->code = cons(sc, sc->code, sc->args); pair_set_syntax_op(sc->code, sc->cur_op); } @@ -69881,7 +72046,7 @@ static void apply_vector(s7_scheme *sc) /* -------- v sc->value = vector_getter(sc->code)(sc, sc->code, index); else out_of_range(sc, sc->vector_ref_symbol, small_int(2), car(sc->args), (index < 0) ? its_negative_string : its_too_large_string); } - else sc->value = vector_ref_1(sc, sc->code, sc->args); + else sc->value = vector_ref_1(sc, sc->code, sc->args, true); } static void apply_string(s7_scheme *sc) /* -------- string as applicable object -------- */ @@ -69904,7 +72069,7 @@ static void apply_string(s7_scheme *sc) /* -------- s return; } s7_error(sc, sc->wrong_number_of_args_symbol, - set_elist_3(sc, (is_null(sc->args)) ? sc->not_enough_arguments_string : sc->too_many_arguments_string, sc->code, sc->args)); + set_elist_3(sc, (is_null(sc->args)) ? not_enough_arguments_string : too_many_arguments_string, sc->code, sc->args)); } static void apply_byte_vector(s7_scheme *sc) /* -------- byte-vector as applicable object -------- */ @@ -69929,7 +72094,7 @@ static void apply_byte_vector(s7_scheme *sc) /* -------- by return; } s7_error(sc, sc->wrong_number_of_args_symbol, - set_elist_3(sc, (is_null(sc->args)) ? sc->not_enough_arguments_string : sc->too_many_arguments_string, sc->code, sc->args)); + set_elist_3(sc, (is_null(sc->args)) ? not_enough_arguments_string : too_many_arguments_string, sc->code, sc->args)); } static int32_t apply_pair(s7_scheme *sc) /* -------- list as applicable object -------- */ @@ -69998,7 +72163,7 @@ static void apply_lambda(s7_scheme *sc) /* -------- n s7_pointer name, ccode; name = closure_name(sc, sc->code); ccode = current_code(sc); - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, (name == ccode) ? sc->code : name, ccode)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, (name == ccode) ? sc->code : name, ccode)); } /* now that args are being reused as slots, the error message can't use sc->args, * so fallback on current_code(sc) in this section. @@ -70021,7 +72186,7 @@ static void apply_lambda(s7_scheme *sc) /* -------- n s7_pointer name, ccode; name = closure_name(sc, sc->code); ccode = current_code(sc); - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, (name == ccode) ? sc->code : name, ccode)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, (name == ccode) ? sc->code : name, ccode)); } } else @@ -70171,7 +72336,7 @@ static s7_pointer lambda_star_set_args(s7_scheme *sc) else { if (!allow_other_keys) /* ((lambda* (a) a) :a 1 2) */ - return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, closure_name(sc, code), args))); + return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, closure_name(sc, code), args))); else { /* check trailing args for repeated keys or keys with no values or values with no keys */ @@ -70488,8 +72653,8 @@ static inline void apply_continuation(s7_scheme *sc) /* -------- c static void apply_c_object(s7_scheme *sc) /* -------- applicable (new-type) object -------- */ { /* sc->value = (*(c_object_ref(sc, sc->code)))(sc, cons(sc, sc->code, sc->args)); */ - car(sc->u1_1) = sc->code; - cdr(sc->u1_1) = sc->args; + set_car(sc->u1_1, sc->code); + set_cdr(sc->u1_1, sc->args); sc->value = (*(c_object_ref(sc, sc->code)))(sc, sc->u1_1); } @@ -70601,7 +72766,12 @@ static void define2_ex(s7_scheme *sc) set_next_slot(slot, let_slots(sc->envir)); let_set_slots(sc->envir, slot); } - else add_slot(sc->envir, sc->code, new_func); + else + { + add_slot(sc->envir, sc->code, new_func); + if (let_slots(sc->envir) == local_slot(sc->code)) + set_recur(local_slot(sc->code), sc->code); + } set_local(sc->code); } else s7_make_slot(sc, sc->envir, sc->code, new_func); @@ -70721,14 +72891,47 @@ static s7_pointer check_for_cyclic_code(s7_scheme *sc, s7_pointer code) static s7_pointer profile_at_start = NULL; #endif +#if S7_DEBUGGING +#define closure_push_and_goto_eval(sc) \ + do { \ + if (is_null(cdr(closure_body(sc->code)))) fprintf(stderr, "%s %d: %s\n", op_names[sc->cur_op], __LINE__, DISPLAY(closure_body(sc->code))); \ + sc->code = T_Pair(closure_body(sc->code)); \ + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); \ + sc->code = car(sc->code); \ + goto EVAL; \ + } while (0) +#define closure_goto_eval(sc) \ + do { \ + if (is_pair(cdr(closure_body(sc->code)))) fprintf(stderr, "%s %d: %s\n", op_names[sc->cur_op], __LINE__, DISPLAY(closure_body(sc->code))); \ + sc->code = car(closure_body(sc->code)); \ + goto EVAL; \ + } while (0) +#else +#define closure_push_and_goto_eval(sc) \ + do { \ + sc->code = T_Pair(closure_body(sc->code)); \ + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); \ + sc->code = car(sc->code); \ + goto EVAL; \ + } while (0) +#define closure_goto_eval(sc) \ + do { \ + sc->code = car(closure_body(sc->code)); \ + goto EVAL; \ + } while (0) +#endif + static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { #if SHOW_EVAL_OPS fprintf(stderr, "top of eval, %s %s %s\n", op_names[first_op], DISPLAY(sc->code), DISPLAY(sc->args)); #endif - sc->cur_op = first_op; + + /* all these top-of-the-loop labels can be removed, moving the associated code down to the individual jumps. + * callgrind says that way is a bit faster (say .2%). + */ goto START_NO_POP; while (true) @@ -70739,7 +72942,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) BEGIN: if (is_pair(cdr(T_Pair(sc->code)))) - push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code)); + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); sc->code = car(sc->code); set_current_code(sc, sc->code); @@ -70760,7 +72963,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) * callgrind numbers 4808 to 4669; another good case was tread.scm: 2410 to 2386. Most timings were a draw. computed-gotos-s7.c has the code, * macroized so it will work if such gotos aren't available. I think I'll stick with a switch statement. */ - switch (sc->cur_op) { case OP_NO_OP: @@ -70813,7 +73015,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) pop_input_port(sc); if (sc->tok == TOKEN_EOF) - sc->value = sc->eof_object; + sc->value = eof_object; sc->current_file = NULL; /* this is for error handling */ goto START; @@ -71391,7 +73593,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { do_all_x_end(end); sc->pc = 0; - sc->opts[0]->v7.fp(sc->opts[0]); + sc->opts[0]->v[0].fp(sc->opts[0]); } } else @@ -71415,7 +73617,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { opt_info *o; o = sc->opts[++sc->pc]; - o->v7.fp(o); + o->v[0].fp(o); } } } @@ -71430,6 +73632,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_DO_NO_VARS_NO_OPT: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); sc->envir = new_frame_in_env(sc, sc->envir); @@ -71449,14 +73652,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) form = sc->code; set_current_code(sc, form); sc->code = cdr(sc->code); - choice = safe_dotimes_ex(sc); /* CDR! -- use form */ + choice = safe_dotimes_ex(sc); if (choice == goto_SAFE_DO_END_CLAUSES) goto SAFE_DO_END_CLAUSES; if (choice == goto_BEGIN1) goto BEGIN; if (choice == goto_EVAL) goto EVAL; if (choice == goto_START_NO_POP) goto START_NO_POP; pair_set_syntax_op(form, OP_SIMPLE_DO); - sc->code = form; goto SIMPLE_DO; } @@ -71508,7 +73710,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) arg = opt_pair2(sc->code); /* here we know the body has more than one form */ - push_stack_no_args(sc, OP_BEGIN1, cdr(arg)); + push_stack_no_args(sc, sc->begin_op, cdr(arg)); sc->code = car(arg); goto EVAL; } @@ -71537,7 +73739,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if ((step == end) || ((step > end) && - (opt_cfunc(caadr(code)) == geq_2))) + (opt_cfunc(caadr(code)) == sc->geq_2))) { sc->value = sc->T; sc->code = cdadr(code); @@ -71552,15 +73754,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) SIMPLE_DO: /* check_do safe_dotimes */ { /* body might not be safe in this case, but the step and end exprs are easy - * "not safe" merely means we hit something that the optimizer can't specialize * simple_do: set up local env, check end (c_c?), goto simple_do_ex * if latter gets s7_optimize, run locally, else goto simple_do_step. - * but is not 1 expr body, etc -- just goto simple_do_step, */ - s7_pointer init, end, code; + s7_pointer init, end, code, body; set_current_code(sc, sc->code); - sc->code = cdr(sc->code); - code = sc->code; + code = cdr(sc->code); sc->envir = new_frame_in_env(sc, sc->envir); init = cadaar(code); if (is_symbol(init)) @@ -71586,20 +73785,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto DO_END_CLAUSES; } - set_opt_pair2(code, cddr(code)); - if ((is_null(cdr(opt_pair2(code)))) && /* one expr in body */ - (is_pair(car(opt_pair2(code)))) && /* and it is a pair */ + body = cddr(code); + if ((is_null(cdr(body))) && /* one expr in body */ + (is_pair(car(body))) && /* and it is a pair */ (is_symbol(cadr(caddr(caar(code))))) && /* caar=(i 0 (+ i 1)), caddr=(+ i 1), so this is apparently checking that the stepf is reasonable? */ (is_t_integer(caddr(caddr(caar(code)))))) { int32_t choice; - choice = simple_do_ex(sc, code); + choice = simple_do_ex(sc, sc->code); if (choice == goto_START) goto START; if (choice == goto_BEGIN1) goto BEGIN; if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES; } + /* fprintf(stderr, " use op_simple_do_step\n"); */ push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code); - sc->code = T_Pair(opt_pair2(code)); + sc->code = body; goto BEGIN; } @@ -71632,7 +73832,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto DO_END_CLAUSES; } push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code); - sc->code = T_Pair(opt_pair2(code)); + sc->code = T_Pair(cddr(code)); goto BEGIN; } @@ -71664,7 +73864,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { if ((integer(now) == integer(end)) || ((integer(now) > integer(end)) && - (opt_cfunc(end_test) == geq_2))) + (opt_cfunc(end_test) == sc->geq_2))) { sc->value = sc->T; sc->code = cdadr(code); @@ -71708,6 +73908,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) int32_t choice; set_current_code(sc, sc->code); sc->code = cdr(sc->code); + choice = dox_ex(sc); if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES; if (choice == goto_SAFE_DO_END_CLAUSES) goto SAFE_DO_END_CLAUSES; @@ -71939,7 +74140,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (res == goto_APPLY) goto APPLY; goto EVAL; } - push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code)); + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); sc->code = car(sc->code); goto EVAL; } @@ -71970,7 +74171,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (res == goto_APPLY) goto APPLY; goto EVAL; } - push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code)); + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); sc->code = car(sc->code); goto EVAL; } @@ -71984,7 +74185,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) /* -------------------------------- begin -------------------------------- */ - case OP_BEGIN2: + case OP_BEGIN_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); goto BEGIN; @@ -71992,6 +74194,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { s7_pointer form; form = sc->code; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); if (!s7_is_proper_list(sc, sc->code)) /* proper list includes () */ eval_error(sc, "unexpected dot? ~A", 18, form); @@ -72000,10 +74203,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = sc->nil; goto START; } - pair_set_syntax_op(form, OP_BEGIN2); + pair_set_syntax_op(form, OP_BEGIN_UNCHECKED); } - case OP_BEGIN1: + + case OP_BEGIN0: if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F); + case OP_BEGIN1: goto BEGIN; case OP_EVAL: @@ -72232,78 +74437,42 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto START; } - case OP_SAFE_C_Z: - if (!c_function_is_ok(sc, sc->code)) break; - /* I think c_function_is_ok of cadr here and below is redundant -- they'll be checked when Z is - * because we cleared the hop bit after combine_ops. - */ - case HOP_SAFE_C_Z: - check_stack_size(sc); - push_stack_no_args(sc, OP_SAFE_C_P_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_SAFE_C_P: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_P: + check_stack_size(sc); push_stack_no_args(sc, OP_SAFE_C_P_1, sc->code); sc->code = T_Pair(cadr(sc->code)); goto EVAL; + case OP_SAFE_C_P_1: + set_car(sc->t1_1, sc->value); + sc->value = c_call(sc->code)(sc, sc->t1_1); + goto START; + + case OP_NOT_P: if (!c_function_is_ok(sc, sc->code)) break; case HOP_NOT_P: push_stack_no_args(sc, OP_NOT_P_1, sc->code); sc->code = T_Pair(cadr(sc->code)); goto EVAL; - - case OP_SAFE_C_CZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_CZ: - check_stack_size(sc); - /* it's possible in a case like this to overflow the stack -- s7test has a deeply - * nested expression involving (+ c (+ c (+ ... ))) all opt'd as safe_c_cz -- if we're close - * to the stack end at the start, it runs off the end. Normally the stack increase in - * the reader protects us, but a call/cc can replace the original stack with a much smaller one. - * How to minimize the cost of this check? - */ - push_stack(sc, OP_EVAL_ARGS_P_2, cadr(sc->code), sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - - case OP_SAFE_C_ZC: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZC: - check_stack_size(sc); - push_stack(sc, OP_EVAL_ARGS_P_4, caddr(sc->code), sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - - case OP_SAFE_C_SZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_SZ: - check_stack_size(sc); - push_stack(sc, OP_EVAL_ARGS_P_2, symbol_to_value_unchecked(sc, cadr(sc->code)), sc->code); - sc->code = T_Pair(caddr(sc->code)); /* splitting out the all_x cases here and elsewhere saves nothing */ - goto EVAL; - - case OP_SAFE_C_ZS: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZS: - check_stack_size(sc); - push_stack_no_args(sc, OP_EVAL_ARGS_P_3, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; + + case OP_NOT_P_1: + sc->value = ((sc->value == sc->F) ? sc->T : sc->F); + goto START; + case OP_SAFE_C_opAq: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_opAq: { - s7_pointer arg; - arg = cadr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cadr(code); set_car(sc->a1_1, c_call(cdr(arg))(sc, cadr(arg))); set_car(sc->t1_1, c_call(arg)(sc, sc->a1_1)); - sc->value = c_call(sc->code)(sc, sc->t1_1); + sc->value = c_call(code)(sc, sc->t1_1); goto START; } @@ -72311,13 +74480,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_opAAq: { - s7_pointer arg, val; - arg = cadr(sc->code); + s7_pointer arg, val, code; + code = sc->code; + arg = cadr(code); val = c_call(cdr(arg))(sc, cadr(arg)); set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))); set_car(sc->a2_1, val); set_car(sc->t1_1, c_call(arg)(sc, sc->a2_1)); - sc->value = c_call(sc->code)(sc, sc->t1_1); + sc->value = c_call(code)(sc, sc->t1_1); goto START; } @@ -72325,15 +74495,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_opAAAq: { - s7_pointer arg, val1, val2; - arg = cadr(sc->code); + s7_pointer arg, val1, val2, code; + code = sc->code; /* not redundant */ + arg = cadr(code); val1 = c_call(cdr(arg))(sc, cadr(arg)); val2 = c_call(cddr(arg))(sc, caddr(arg)); set_car(sc->a3_3, c_call(cdddr(arg))(sc, cadddr(arg))); set_car(sc->a3_1, val1); set_car(sc->a3_2, val2); set_car(sc->t1_1, c_call(arg)(sc, sc->a3_1)); - sc->value = c_call(sc->code)(sc, sc->t1_1); + sc->value = c_call(code)(sc, sc->t1_1); goto START; } @@ -72341,12 +74512,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_S_opAq: { - s7_pointer arg; - arg = caddr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = caddr(code); set_car(sc->a1_1, c_call(cdr(arg))(sc, cadr(arg))); set_car(sc->t2_2, c_call(arg)(sc, sc->a1_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->t2_1); + set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + sc->value = c_call(code)(sc, sc->t2_1); goto START; } @@ -72354,12 +74526,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_opAq_S: { - s7_pointer arg; - arg = cadr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cadr(code); set_car(sc->a1_1, c_call(cdr(arg))(sc, cadr(arg))); set_car(sc->t2_1, c_call(arg)(sc, sc->a1_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->t2_1); + set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(code))); + sc->value = c_call(code)(sc, sc->t2_1); goto START; } @@ -72367,14 +74540,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_S_opAAq: { - s7_pointer arg, val1; - arg = caddr(sc->code); + s7_pointer arg, val1, code; + code = sc->code; + arg = caddr(code); val1 = c_call(cdr(arg))(sc, cadr(arg)); set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))); set_car(sc->a2_1, val1); set_car(sc->t2_2, c_call(arg)(sc, sc->a2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->t2_1); + set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + sc->value = c_call(code)(sc, sc->t2_1); goto START; } @@ -72382,8 +74556,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_S_opAAAq: { - s7_pointer arg, p, val1, val2; - p = caddr(sc->code); + s7_pointer arg, p, val1, val2, code; + code = sc->code; + p = caddr(code); arg = cdr(p); val1 = c_call(arg)(sc, car(arg)); arg = cdr(arg); @@ -72393,126 +74568,38 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) set_car(sc->a3_1, val1); set_car(sc->a3_2, val2); set_car(sc->t2_2, c_call(p)(sc, sc->a3_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->t2_1); + set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + sc->value = c_call(code)(sc, sc->t2_1); goto START; } - case OP_SAFE_C_S_opSZq: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_S_opSZq: - push_stack(sc, OP_SAFE_C_SZ_SZ, symbol_to_value_unchecked(sc, cadr(caddr(sc->code))), sc->code); - sc->code = T_Pair(caddr(caddr(sc->code))); - goto EVAL; - - case OP_SAFE_C_AZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_AZ: - { - s7_pointer val; - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - push_stack(sc, OP_EVAL_ARGS_P_2, val, sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_ZA: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZA: - /* here we can't use ZS order because we sometimes assume left->right arg evaluation (binary-io.scm for example) */ - push_stack_no_args(sc, OP_SAFE_C_ZA_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_SAFE_C_ZZ: + case OP_SAFE_C_ZZZ: if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZZ: - /* most of the component Z's here are very complex: - * 264600: (+ (* even-amp (oscil (vector-ref evens k) (+ even-freq val))) (* odd-amp... - */ - push_stack_no_args(sc, OP_SAFE_C_ZZ_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); + case HOP_SAFE_C_ZZZ: + push_stack_no_args(sc, OP_SAFE_C_ZZZ_1, sc->code); + sc->code = cadr(sc->code); goto EVAL; - case OP_SAFE_C_opCq_Z: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_opCq_Z: - { - s7_pointer val; - val = c_call(cadr(sc->code))(sc, cdadr(sc->code)); - push_stack(sc, OP_EVAL_ARGS_P_2, val, sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_ZAA: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZAA: - { - s7_pointer val; - val = c_call(cddr(sc->code))(sc, caddr(sc->code)); - push_stack(sc, OP_SAFE_C_ZAA_1, val, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_AZA: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_AZA: - { - s7_pointer val; - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - push_stack(sc, OP_SAFE_C_AZA_1, val, sc->code); - sc->code = T_Pair(caddr(sc->code)); - /* mostly stuff like h_safe_c_aaa */ - goto EVAL; - } - - case OP_SAFE_C_AAZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_AAZ: - { - s7_pointer val, op_val; - op_val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - val = c_call(cddr(sc->code))(sc, caddr(sc->code)); - push_op_stack(sc, op_val); - push_stack(sc, OP_SAFE_C_AAZ_1, val, sc->code); - sc->code = T_Pair(cadddr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_ZZA: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZZA: - push_stack_no_args(sc, OP_SAFE_C_ZZA_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); + case OP_SAFE_C_ZZZ_1: + push_stack(sc, OP_SAFE_C_ZZZ_2, sc->value, sc->code); + sc->code = opt_con2(cdr(sc->code)); goto EVAL; - case OP_SAFE_C_ZAZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZAZ: - push_stack_no_args(sc, OP_SAFE_C_ZAZ_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); + case OP_SAFE_C_ZZZ_2: + push_op_stack(sc, sc->value); + push_stack(sc, OP_SAFE_C_ZZZ_3, sc->args, sc->code); + sc->code = opt_con1(cdr(sc->code)); goto EVAL; - case OP_SAFE_C_AZZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_AZZ: - { - s7_pointer val; - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - push_stack(sc, OP_SAFE_C_AZZ_1, val, sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_ZZZ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZZZ: - push_stack_no_args(sc, OP_SAFE_C_ZZZ_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; + case OP_SAFE_C_ZZZ_3: + set_car(sc->t3_1, sc->args); + set_car(sc->t3_2, pop_op_stack(sc)); + set_car(sc->t3_3, sc->value); + sc->value = c_call(sc->code)(sc, sc->t3_1); + goto START; + case OP_SAFE_C_A: if (!c_function_is_ok(sc, sc->code)) { @@ -72529,20 +74616,25 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; } case HOP_SAFE_C_A: - set_car(sc->a1_1, c_call(cdr(sc->code))(sc, cadr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->a1_1); - goto START; + { + s7_pointer code; + code = sc->code; + set_car(sc->a1_1, c_call(cdr(code))(sc, cadr(code))); + sc->value = c_call(code)(sc, sc->a1_1); + goto START; + } case OP_SAFE_C_AA: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_AA: { - s7_pointer val; - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); + s7_pointer val, code; + code = sc->code; + val = c_call(cdr(code))(sc, cadr(code)); sc->temp4 = val; - set_car(sc->a2_2, c_call(cddr(sc->code))(sc, caddr(sc->code))); + set_car(sc->a2_2, c_call(cddr(code))(sc, caddr(code))); set_car(sc->a2_1, val); - sc->value = c_call(sc->code)(sc, sc->a2_1); + sc->value = c_call(code)(sc, sc->a2_1); sc->temp4 = sc->nil; goto START; } @@ -72551,8 +74643,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_AAA: { - s7_pointer arg, val1, val2; - arg = cdr(sc->code); + s7_pointer arg, val1, val2, code; + code = sc->code; + arg = cdr(code); val1 = c_call(arg)(sc, car(arg)); sc->temp4 = val1; arg = cdr(arg); @@ -72562,7 +74655,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) set_car(sc->t3_3, c_call(arg)(sc, car(arg))); set_car(sc->t3_1, val1); set_car(sc->t3_2, val2); - sc->value = c_call(sc->code)(sc, sc->t3_1); + sc->value = c_call(code)(sc, sc->t3_1); sc->temp4 = sc->nil; sc->temp10 = sc->nil; goto START; @@ -72572,8 +74665,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_SSA: { - s7_pointer arg, val1, val2; - arg = cdr(sc->code); + s7_pointer arg, val1, val2, code; + code = sc->code; + arg = cdr(code); val1 = symbol_to_value_unchecked(sc, car(arg)); arg = cdr(arg); val2 = symbol_to_value_unchecked(sc, car(arg)); @@ -72581,7 +74675,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) set_car(sc->a3_3, c_call(arg)(sc, car(arg))); set_car(sc->a3_1, val1); set_car(sc->a3_2, val2); - sc->value = c_call(sc->code)(sc, sc->a3_1); + sc->value = c_call(code)(sc, sc->a3_1); goto START; } @@ -72589,13 +74683,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_SAS: { - s7_pointer arg; - arg = cdr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cdr(code); set_car(sc->a3_1, symbol_to_value_unchecked(sc, car(arg))); arg = cdr(arg); set_car(sc->a3_2, c_call(arg)(sc, car(arg))); set_car(sc->a3_3, symbol_to_value_unchecked(sc, cadr(arg))); - sc->value = c_call(sc->code)(sc, sc->a3_1); + sc->value = c_call(code)(sc, sc->a3_1); goto START; } @@ -72603,13 +74698,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_CAC: { - s7_pointer arg; - arg = cdr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cdr(code); set_car(sc->a3_1, car(arg)); arg = cdr(arg); set_car(sc->a3_2, c_call(arg)(sc, car(arg))); set_car(sc->a3_3, cadr(arg)); - sc->value = c_call(sc->code)(sc, sc->a3_1); + sc->value = c_call(code)(sc, sc->a3_1); goto START; } @@ -72617,14 +74713,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_CSA: { - s7_pointer arg; - arg = cdr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cdr(code); set_car(sc->a3_1, car(arg)); arg = cdr(arg); set_car(sc->a3_2, symbol_to_value_unchecked(sc, car(arg))); arg = cdr(arg); set_car(sc->a3_3, c_call(arg)(sc, car(arg))); - sc->value = c_call(sc->code)(sc, sc->a3_1); + sc->value = c_call(code)(sc, sc->a3_1); goto START; } @@ -72632,14 +74729,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_SCA: { - s7_pointer arg; - arg = cdr(sc->code); + s7_pointer arg, code; + code = sc->code; + arg = cdr(code); set_car(sc->a3_1, symbol_to_value_unchecked(sc, car(arg))); arg = cdr(arg); set_car(sc->a3_2, car(arg)); arg = cdr(arg); set_car(sc->a3_3, c_call(arg)(sc, car(arg))); - sc->value = c_call(sc->code)(sc, sc->a3_1); + sc->value = c_call(code)(sc, sc->a3_1); goto START; } @@ -72647,10 +74745,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_AAAA: { - s7_pointer arg, val1, val2, val3; + s7_pointer arg, val1, val2, val3, code; int32_t tx; + code = sc->code; tx = next_tx(sc); - arg = cdr(sc->code); + arg = cdr(code); val1 = c_call(arg)(sc, car(arg)); sc->temp4 = val1; arg = cdr(arg); @@ -72664,7 +74763,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) set_car(sc->a4_1, val1); set_car(sc->a4_2, val2); set_car(sc->a4_3, val3); - sc->value = c_call(sc->code)(sc, sc->a4_1); + sc->value = c_call(code)(sc, sc->a4_1); sc->temp4 = sc->nil; sc->t_temps[tx] = sc->nil; sc->temp10 = sc->nil; @@ -72675,13 +74774,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_ALL_X: { - s7_pointer args, p; - sc->args = safe_list_if_possible(sc, integer(arglist_length(sc->code))); - for (args = cdr(sc->code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p)) + s7_pointer args, p, code; + code = sc->code; + sc->args = safe_list_if_possible(sc, integer(arglist_length(code))); + for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p)) set_car(p, c_call(args)(sc, car(args))); clear_list_in_use(sc->args); sc->current_safe_list = 0; - sc->value = c_call(sc->code)(sc, sc->args); + sc->value = c_call(code)(sc, sc->args); /* we can't release a temp here: * (define (hi) (vector 14800 14020 (oscil os) (* 1/3 14800) 14800 (* 1/2 14800))) (hi) where os returns non-zero: * #(14800 14020 <output-string-port> 14800/3 14800 7400) @@ -72693,9 +74793,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_ALL_QA: { - s7_pointer args, p; - sc->args = safe_list_if_possible(sc, integer(arglist_length(sc->code))); - for (args = cdr(sc->code), p = sc->args; is_pair(args); args = cdr(args), p = cddr(p)) + s7_pointer args, p, code; + code = sc->code; + sc->args = safe_list_if_possible(sc, integer(arglist_length(code))); + for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cddr(p)) { set_car(p, cadar(args)); args = cdr(args); @@ -72703,7 +74804,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } clear_list_in_use(sc->args); sc->current_safe_list = 0; - sc->value = c_call(sc->code)(sc, sc->args); + sc->value = c_call(code)(sc, sc->args); goto START; } @@ -72884,56 +74985,125 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_SAFE_C_PS: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_PS: - push_stack_no_args(sc, OP_EVAL_ARGS_P_3, sc->code); /* gotta wait in this case */ + push_stack_no_args(sc, OP_SAFE_C_PS_1, sc->code); /* gotta wait in this case */ sc->code = cadr(sc->code); goto EVAL; + + case OP_SAFE_C_PS_1: + set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(sc->code))); + /* we have to wait because we say the evaluation order is left to right (in lambda*) + * and the first arg's evaluation might change the value of the second arg. + */ + set_car(sc->t2_1, sc->value); + sc->value = c_call(sc->code)(sc, sc->t2_1); + goto START; + + case OP_SAFE_C_PS_MV: /* (define (hi a) (+ (values 1 2) a)) */ + sc->args = s7_append(sc, sc->value, set_plist_1(sc, symbol_to_value_unchecked(sc, caddr(sc->code)))); + sc->code = c_function_base(opt_cfunc(sc->code)); + goto APPLY; + case OP_SAFE_C_PC: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_PC: - push_stack(sc, OP_EVAL_ARGS_P_4, caddr(sc->code), sc->code); + check_stack_size(sc); + push_stack(sc, OP_SAFE_C_PC_1, caddr(sc->code), sc->code); sc->code = cadr(sc->code); goto EVAL; case OP_SAFE_C_PQ: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_PQ: - push_stack(sc, OP_EVAL_ARGS_P_4, opt_con2(cdr(sc->code)), sc->code); /* was P_5, but that's the same as P_4 */ + push_stack(sc, OP_SAFE_C_PC_1, opt_con2(cdr(sc->code)), sc->code); sc->code = cadr(sc->code); goto EVAL; - case OP_SAFE_C_ZQ: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_SAFE_C_ZQ: - push_stack(sc, OP_EVAL_ARGS_P_4, opt_con2(cdr(sc->code)), sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; + case OP_SAFE_C_PC_1: + set_car(sc->t2_1, sc->value); + set_car(sc->t2_2, sc->args); + sc->value = c_call(sc->code)(sc, sc->t2_1); + goto START; + case OP_SAFE_C_PC_MV: + sc->args = s7_append(sc, sc->value, set_plist_1(sc, sc->args)); + sc->code = c_function_base(opt_cfunc(sc->code)); + goto APPLY; + + case OP_SAFE_C_SP: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_SP: check_stack_size(sc); - push_stack(sc, OP_EVAL_ARGS_P_2, symbol_to_value_unchecked(sc, cadr(sc->code)), sc->code); + push_stack(sc, OP_SAFE_C_SP_1, symbol_to_value_unchecked(sc, cadr(sc->code)), sc->code); sc->code = caddr(sc->code); goto EVAL; + + case OP_SAFE_C_SP_1: /* we get here from many places (op_safe_c_sp for example), but all are safe */ + set_car(sc->t2_1, sc->args); + set_car(sc->t2_2, sc->value); + sc->value = c_call(sc->code)(sc, sc->t2_1); + goto START; + + case OP_SAFE_C_SP_MV: + sc->args = cons(sc, sc->args, sc->value); /* don't use u2_1 or some permanent list here: immutable=copied later */ + sc->code = c_function_base(opt_cfunc(sc->code)); + goto APPLY; + case OP_SAFE_C_AP: if ((!c_function_is_ok(sc, sc->code)) || (!c_function_is_ok(sc, cadr(sc->code)))) break; case HOP_SAFE_C_AP: { - s7_pointer val; + s7_pointer val, code; + code = sc->code; check_stack_size(sc); - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - push_stack(sc, OP_EVAL_ARGS_P_2, val, sc->code); - sc->code = caddr(sc->code); + val = c_call(cdr(sc->code))(sc, cadr(code)); + push_stack(sc, OP_SAFE_C_SP_1, val, code); + sc->code = caddr(code); goto EVAL; } + case OP_SAFE_C_PA: + if ((!c_function_is_ok(sc, sc->code)) || (!c_function_is_ok(sc, caddr(sc->code)))) break; + case HOP_SAFE_C_PA: + check_stack_size(sc); + push_stack(sc, OP_SAFE_C_PA_1, sc->nil, sc->code); + sc->code = cadr(sc->code); + goto EVAL; + + case OP_SAFE_C_PA_1: + { + s7_pointer val, code; + code = sc->code; + val = sc->value; + set_car(sc->t2_2, c_call(cddr(code))(sc, caddr(code))); + set_car(sc->t2_1, val); + sc->value = c_call(code)(sc, sc->t2_1); + goto START; + } + + case OP_SAFE_C_PA_MV: + { + s7_pointer val, code; + code = sc->code; + val = sc->value; /* this is necessary since the c_call below can clobber sc->value */ + sc->args = s7_append(sc, val, set_plist_1(sc, c_call(cddr(code))(sc, caddr(code)))); + sc->code = c_function_base(opt_cfunc(code)); + goto APPLY; + } + case OP_SAFE_C_CP: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_CP: + /* it's possible in a case like this to overflow the stack -- s7test has a deeply + * nested expression involving (+ c (+ c (+ ... ))) all opt'd as safe_c_cz -- if we're close + * to the stack end at the start, it runs off the end. Normally the stack increase in + * the reader protects us, but a call/cc can replace the original stack with a much smaller one. + * How to minimize the cost of this check? + */ check_stack_size(sc); - push_stack(sc, OP_EVAL_ARGS_P_2, cadr(sc->code), sc->code); + push_stack(sc, OP_SAFE_C_SP_1, cadr(sc->code), sc->code); sc->code = caddr(sc->code); goto EVAL; @@ -72941,7 +75111,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_QP: check_stack_size(sc); - push_stack(sc, OP_EVAL_ARGS_P_2, cadadr(sc->code), sc->code); + push_stack(sc, OP_SAFE_C_SP_1, cadadr(sc->code), sc->code); sc->code = caddr(sc->code); goto EVAL; @@ -72952,19 +75122,91 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) push_stack_no_args(sc, OP_SAFE_C_PP_1, sc->code); sc->code = cadr(sc->code); goto EVAL; + + case OP_SAFE_C_PP_1: + /* unless multiple values from last call (first arg), sc->args == sc->nil because we pushed that. + * we get here only from OP_SAFE_C_PP. + * + * currently splice_in_values changes the operator so if we get here, sc->value is the result of the first arg + * + * safe_c_pp -> 1, but if mv, -> 3 + * 1: -> 2, if mv -> 4 + * 2: done (both normal) + * 3: -> 5, but if mv, -> 6 + * 4: done (1 normal, 2 mv) + * 5: done (1 mv, 2 normal) + * 6: done (both mv) + * + * I think safe_c_ppp would require 18 branches (or maybe just collect the args and concatenate at the end?) + */ + push_stack(sc, OP_SAFE_C_SP_1, sc->value, sc->code); /* mv -> 3 */ + sc->code = caddr(sc->code); + goto EVAL; + + case OP_SAFE_C_PP_3_MV: /* we get here if the first arg returned multiple values */ + push_stack(sc, OP_SAFE_C_PP_5, sc->value, sc->code); + sc->code = caddr(sc->code); + goto EVAL; + + case OP_SAFE_C_PP_5: + /* 1 mv, 2, normal */ + sc->args = s7_append(sc, sc->args, list_1(sc, sc->value)); + sc->code = c_function_base(opt_cfunc(sc->code)); + goto APPLY; + + case OP_SAFE_C_PP_6_MV: /* both mv */ + sc->args = s7_append(sc, sc->args, sc->value); + /* + * c_call(sc->code) here is g_add_2, but we have any number of args from a values call + * the original (unoptimized) function is (hopefully) c_function_base(opt_cfunc(sc->code))? + * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) -> 7 + * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) -> 10 + * (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) -> 10 + * (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) -> 10 + */ + sc->code = c_function_base(opt_cfunc(sc->code)); + goto APPLY; + case OP_SAFE_C_AAP: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_AAP: { - s7_pointer val; + s7_pointer val, code; + code = sc->code; check_stack_size(sc); - val = c_call(cdr(sc->code))(sc, cadr(sc->code)); - push_stack(sc, OP_EVAL_ARGS_AAP_1, val, sc->code); - sc->code = cadddr(sc->code); + val = c_call(cdr(code))(sc, cadr(code)); + push_stack(sc, OP_SAFE_C_AAP_1, val, code); + sc->code = cadddr(code); goto EVAL; } + case OP_SAFE_C_AAP_1: + { + s7_pointer val1, val3, code; + code = sc->code; + val1 = sc->args; + val3 = sc->value; + set_car(sc->t3_2, c_call(cddr(code))(sc, caddr(code))); + set_car(sc->t3_1, val1); + set_car(sc->t3_3, val3); + sc->value = c_call(code)(sc, sc->t3_1); + goto START; + } + + case OP_SAFE_C_AAP_MV: + { + s7_pointer val1, val2, val3, code; + code = sc->code; + val1 = sc->args; + val3 = sc->value; + val2 = c_call(cddr(code))(sc, caddr(code)); + sc->args = cons(sc, val1, cons(sc, val2, val3)); + sc->code = c_function_base(opt_cfunc(code)); + goto APPLY; + } + + case OP_SAFE_C_opSSq: if (!c_function_is_ok_cadr(sc, sc->code)) break; case HOP_SAFE_C_opSSq: @@ -73451,7 +75693,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) check_stack_size(sc); set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(args))); val = c_call(args)(sc, sc->t1_1); - push_stack(sc, OP_EVAL_ARGS_P_2, val, sc->code); + push_stack(sc, OP_SAFE_C_SP_1, val, sc->code); sc->code = caddr(sc->code); goto EVAL; } @@ -73761,13 +76003,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->value = c_call(sc->code)(sc, sc->args); goto START; - case OP_C_Z: - if (!c_function_is_ok(sc, sc->code)) break; - case HOP_C_Z: - push_stack_no_args(sc, OP_C_P_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_C_P: if (!c_function_is_ok(sc, sc->code)) break; case HOP_C_P: @@ -73775,6 +76010,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = T_Pair(cadr(sc->code)); goto EVAL; + case OP_C_P_1: + sc->value = c_call(sc->code)(sc, list_1(sc, sc->value)); + goto START; + + case OP_C_P_MV: + /* op_c_p_1 -> mv case: (define (hi) (format (values #f "~A ~D" 1 2))) */ + sc->code = c_function_base(opt_cfunc(sc->code)); /* see comment above */ + sc->args = copy_list(sc, sc->value); + goto APPLY; + + case OP_C_SS: if (!c_function_is_ok(sc, sc->code)) break; case HOP_C_SS: @@ -73793,6 +76039,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; } + case OP_C_AP_1: /* goes to c_sp_mv if multiple values */ + sc->value = c_call(sc->code)(sc, list_2(sc, sc->args, sc->value)); + goto START; + + case OP_C_FA: /* op_c_fs was not faster if all_x_s below */ if (!c_function_is_ok(sc, sc->code)) break; case HOP_C_FA: @@ -73988,21 +76239,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = T_Pair(opt_pair1(cdr(sc->code))); /* the body of the first lambda */ goto BEGIN; - case OP_C_CATCH_ALL_Z: + case OP_C_CATCH_ALL_P: if (!c_function_is_ok(sc, sc->code)) break; - case HOP_C_CATCH_ALL_Z: + case HOP_C_CATCH_ALL_P: new_frame(sc, sc->envir, sc->envir); catch_all_set_goto_loc(sc->envir, s7_stack_top(sc)); catch_all_set_op_loc(sc->envir, sc->op_stack_now - sc->op_stack); push_stack(sc, OP_CATCH_ALL, opt_con2(sc->code), sc->code); - sc->code = T_Pair(car(opt_pair1(cdr(sc->code)))); + sc->code = car(opt_pair1(cdr(sc->code))); goto EVAL; /* -------------------------------------------------------------------------------- */ /* unknown* fallback on these */ case OP_S: - case HOP_S: sc->code = symbol_to_value_unchecked(sc, car(sc->code)); if (!is_applicable(sc->code)) apply_error(sc, sc->code, sc->nil); @@ -74010,7 +76260,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto APPLY; case OP_S_C: - case HOP_S_C: { s7_pointer code; code = sc->code; @@ -74030,7 +76279,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_S_S: - case HOP_S_S: { s7_pointer code; code = sc->code; @@ -74050,7 +76298,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_S_A: - case HOP_S_A: { s7_pointer code; code = sc->code; @@ -74069,13 +76316,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto APPLY; } + case OP_SAFE_C_STAR: + if (!c_function_is_ok(sc, sc->code)) break; + case HOP_SAFE_C_STAR: + sc->code = opt_cfunc(sc->code); + apply_c_function_star_fill_defaults(sc, 0); + goto START; + case OP_SAFE_C_STAR_A: if (!c_function_is_ok(sc, sc->code)) break; case HOP_SAFE_C_STAR_A: set_car(sc->a1_1, c_call(cdr(sc->code))(sc, cadr(sc->code))); sc->args = sc->a1_1; sc->code = opt_cfunc(sc->code); - apply_c_function_star(sc); + /* one arg, so it's not a keyword; all we need to do is fill in defaults */ + apply_c_function_star_fill_defaults(sc, 1); goto START; case OP_SAFE_C_STAR_AA: @@ -74106,165 +76361,308 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) /* -------------------------------------------------------------------------------- */ case OP_THUNK: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_THUNK: check_stack_size(sc); /* this recursion check is consistent with the other unsafe closure calls, but we're probably in big trouble: * (letrec ((a (lambda () (cons 1 (b)))) (b (lambda () (a)))) (b)) - * unfortunately the alternative is a segfault when we wander off the end of the stack. - * - * It seems that we could use the hop bit here (since it is always off) to choose between BEGIN1 and OPT_EVAL or EVAL, - * but the EVAL choice gains nothing in time, and the OPT_EVAL choice is too tricky -- it is a two-level optimization, - * so if the inner (car(closure_body)) gets unopt'd for some reason, the outer HOP_THUNK never finds - * out, and peculiar things start to happen. (Also, is_h_optimized would need to be smarter). */ sc->code = opt_lambda(sc->code); new_frame(sc, closure_let(sc->code), sc->envir); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - + closure_push_and_goto_eval(sc); + + case OP_THUNK_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_THUNK_P: + sc->code = opt_lambda(sc->code); + new_frame(sc, closure_let(sc->code), sc->envir); + closure_goto_eval(sc); + case OP_SAFE_THUNK: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_THUNK: /* no frame needed */ - /* (let ((x 1)) (let () (define (f) x) (let ((x 0)) (define (g) (set! x 32) (f)) (g)))) */ sc->code = opt_lambda(sc->code); sc->envir = closure_let(sc->code); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - + closure_push_and_goto_eval(sc); + case OP_SAFE_THUNK_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_THUNK_P: sc->code = opt_lambda(sc->code); - set_current_code(sc, sc->code); sc->envir = closure_let(sc->code); - sc->code = car(closure_body(sc->code)); - goto EVAL; + closure_goto_eval(sc); + + case OP_SAFE_THUNK_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 0)) {if (unknown_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_THUNK_A: + sc->code = opt_lambda(sc->code); + sc->envir = closure_let(sc->code); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + + case OP_SAFE_THUNK_LP: + sc->code = slot_value(local_slot(car(sc->code))); + sc->envir = closure_let(sc->code); + closure_goto_eval(sc); + /* -------------------------------- */ - case OP_SAFE_CLOSURE_S: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_S: - /* since a tail call is safe, we can't change the current env's let_id until - * after we do the lookup -- it might be the current func's arg, and we're - * about to call the same func. - */ - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_slot(sc, closure_let(f), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } + case OP_CLOSURE_S: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_S: + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_push_and_goto_eval(sc); - case OP_SAFE_CLOSURE_S_C: - /* here and below the closure has to be the original -- matches are no good */ - if (!closure_is_equal(sc, sc->code)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_S_C: - { - s7_pointer f; - f = opt_lambda(sc->code); - set_current_code(sc, f); - sc->envir = old_frame_with_slot(sc, closure_let(f), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = car(closure_body(f)); - sc->value = c_call(sc->code)(sc, cdr(sc->code)); - goto START; - } + case OP_CLOSURE_S_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_S_P: + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_goto_eval(sc); - case OP_SAFE_CLOSURE_S_L: - if (!closure_is_equal(sc, sc->code)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_S_L: - { - s7_pointer lt; - lt = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); - if (is_pair(lt)) - { - lt = cdr(lt); - if (is_let(lt)) - { - s7_pointer y, sym; - sym = opt_sym3(cdar(closure_body(opt_lambda(sc->code)))); - for (y = let_slots(lt); is_slot(y); y = next_slot(y)) - if (slot_symbol(y) == sym) - { - sc->value = slot_value(y); - goto START; - } - sc->value = lint_let_ref_1(sc, outlet(lt), sym); - goto START; - } - wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string); - } - simple_wrong_type_argument(sc, sc->cdr_symbol, lt, T_PAIR); - } + case OP_SAFE_CLOSURE_S: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_S: + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_push_and_goto_eval(sc); case OP_SAFE_CLOSURE_S_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_S_P: - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_slot(sc, closure_let(f), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = car(closure_body(f)); - goto EVAL; - } + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_goto_eval(sc); + + case OP_SAFE_CLOSURE_S_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_S_A: + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + + case OP_SAFE_CLOSURE_S_LP: + sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->code = slot_value(local_slot(car(sc->code))); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_goto_eval(sc); + /* -------------------------------- */ + + case OP_CLOSURE_C: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_C: + check_stack_size(sc); + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_push_and_goto_eval(sc); + + case OP_CLOSURE_C_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_C_P: + sc->value = cadr(sc->code); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_goto_eval(sc); case OP_SAFE_CLOSURE_C: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_C: - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_slot(sc, closure_let(f), cadr(sc->code)); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_push_and_goto_eval(sc); + + case OP_SAFE_CLOSURE_C_P: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_C_P: + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_goto_eval(sc); + + case OP_SAFE_CLOSURE_C_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_C_A: + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + /* -------------------------------- */ + + case OP_CLOSURE_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_P: + push_stack(sc, OP_CLOSURE_P_1, sc->args, sc->code); + sc->code = cadr(sc->code); + goto EVAL; + + case OP_CLOSURE_P_1: + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + sc->code = T_Pair(closure_body(sc->code)); + goto BEGIN; + case OP_CLOSURE_P_MV: + sc->code = opt_lambda(sc->code); + sc->args = copy_list(sc, sc->value); + goto APPLY; + case OP_SAFE_CLOSURE_P: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 1)) - { - if ((has_all_x(cdr(sc->code))) && - (unknown_a_ex(sc, sc->last_function) == goto_EVAL)) - goto EVAL; - break; - } + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 1)) break; case HOP_SAFE_CLOSURE_P: push_stack(sc, OP_SAFE_CLOSURE_P_1, sc->args, sc->code); sc->code = cadr(sc->code); goto EVAL; + case OP_SAFE_CLOSURE_P_1: + sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(sc->code)), sc->value); + sc->code = T_Pair(closure_body(opt_lambda(sc->code))); + goto BEGIN; + /* -------------------------------- */ + + case OP_CLOSURE_A: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_A: + { + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_push_and_goto_eval(sc); + } + + case OP_CLOSURE_A_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_A_P: + { + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); + closure_goto_eval(sc); + } + case OP_SAFE_CLOSURE_A: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_A: { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_slot(sc, closure_let(f), c_call(cdr(sc->code))(sc, cadr(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_push_and_goto_eval(sc); + } + + case OP_SAFE_CLOSURE_A_P: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_A_P: + { + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_goto_eval(sc); + } + + case OP_SAFE_CLOSURE_A_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_A_A: + { + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(code); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + } + + case OP_SAFE_CLOSURE_A_LP: + { + s7_pointer code; + code = sc->code; + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = slot_value(local_slot(car(code))); + sc->envir = old_frame_with_slot(sc, closure_let(sc->code), sc->value); + closure_goto_eval(sc); } + /* -------------------------------- */ - case OP_SAFE_LCLOSURE_A: - case HOP_SAFE_LCLOSURE_A: + case OP_CLOSURE_AP: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; + case HOP_CLOSURE_AP: { - s7_pointer f; - f = slot_value(local_slot(car(sc->code))); - sc->envir = old_frame_with_slot(sc, closure_let(f), c_call(cdr(sc->code))(sc, cadr(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; + s7_pointer val, code; + code = sc->code; + val = c_call(cdr(code))(sc, cadr(code)); + /* (hook-push (undo-hook ind 0) (lambda (hook) (set! u0 #t))) -> #<gc-nil> + * g_undo_hook calls s7_eval_c_string so it obviously should be declared unsafe! + */ + push_stack(sc, OP_CLOSURE_AP_1, val, code); + sc->code = caddr(code); + goto EVAL; } - case OP_SAFE_CLOSURE_A_C: - if (!closure_is_equal(sc, sc->code)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_A_C: + case OP_CLOSURE_AP_1: + /* sc->value is presumably the "P" argument value, "A" is sc->args */ + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, + car(closure_args(sc->code)), sc->args, + cadr(closure_args(sc->code)), sc->value); + sc->code = T_Pair(closure_body(sc->code)); + goto BEGIN; + + case OP_CLOSURE_AP_MV: + sc->code = opt_lambda(sc->code); + sc->args = cons(sc, sc->args, copy_list(sc, sc->value)); + goto APPLY; + + + case OP_CLOSURE_PA: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; + case HOP_CLOSURE_PA: { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_slot(sc, closure_let(f), c_call(cdr(sc->code))(sc, cadr(sc->code))); - sc->code = car(closure_body(f)); - sc->value = c_call(sc->code)(sc, cdr(sc->code)); - goto START; + s7_pointer val, code; + code = sc->code; + val = c_call(cddr(code))(sc, caddr(code)); + push_stack(sc, OP_CLOSURE_PA_1, val, code); + sc->code = cadr(code); + goto EVAL; } + case OP_CLOSURE_PA_1: + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, + car(closure_args(sc->code)), sc->value, + cadr(closure_args(sc->code)), sc->args); + sc->code = T_Pair(closure_body(sc->code)); + goto BEGIN; + + case OP_CLOSURE_PA_MV: + sc->code = opt_lambda(sc->code); + sc->args = s7_append(sc, copy_list(sc, sc->value), cons(sc, sc->args, sc->nil)); + goto APPLY; + case OP_SAFE_CLOSURE_AP: if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) break; case HOP_SAFE_CLOSURE_AP: @@ -74276,6 +76674,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; } + case OP_SAFE_CLOSURE_AP_1: + sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->args, sc->value); + sc->code = T_Pair(closure_body(opt_lambda(sc->code))); + goto BEGIN; + + case OP_SAFE_CLOSURE_PA: if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) break; case HOP_SAFE_CLOSURE_PA: @@ -74287,56 +76691,163 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; } - case OP_SAFE_CLOSURE_SS: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_SS: + case OP_SAFE_CLOSURE_PA_1: + sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->value, sc->args); + sc->code = T_Pair(closure_body(opt_lambda(sc->code))); + goto BEGIN; + /* -------------------------------- */ + + case OP_CLOSURE_FA: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; + case HOP_CLOSURE_FA: { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), - symbol_to_value_unchecked(sc, cadr(sc->code)), - symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = car(closure_body(f)); + s7_pointer farg, larg, aarg, func, func_args, code; + code = sc->code; + farg = cdadr(code); + aarg = c_call(cddr(code))(sc, caddr(code)); + make_closure_with_let(sc, larg, car(farg), cdr(farg), sc->envir, CLOSURE_ARITY_NOT_SET); + check_stack_size(sc); + func = opt_lambda(code); /* outer func */ + func_args = closure_args(func); + new_frame_with_two_slots(sc, closure_let(func), sc->envir, car(func_args), larg, cadr(func_args), aarg); + sc->code = car(closure_body(func)); goto EVAL; } + /* -------------------------------- */ + case OP_CLOSURE_SS: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_SS: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_push_and_goto_eval(sc); - case OP_SAFE_CLOSURE_SS_B: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_SAFE_CLOSURE_SS_B: - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), - symbol_to_value_unchecked(sc, cadr(sc->code)), - symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = closure_body(f); - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cdr(sc->code))); - sc->code = car(sc->code); - goto EVAL; - } + case OP_CLOSURE_SS_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_SS_P: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_goto_eval(sc); + + case OP_SAFE_CLOSURE_SS: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_SS: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_push_and_goto_eval(sc); + + case OP_SAFE_CLOSURE_SS_P: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_SS_P: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + + case OP_SAFE_CLOSURE_SS_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_SS_A: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + + case OP_SAFE_CLOSURE_SS_LP: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = slot_value(local_slot(car(sc->code))); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + /* -------------------------------- */ + + case OP_CLOSURE_SC: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_SC: + sc->temp11 = opt_con2(sc->code); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_push_and_goto_eval(sc); + + case OP_CLOSURE_SC_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_SC_P: + sc->temp11 = opt_con2(sc->code); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_goto_eval(sc); case OP_SAFE_CLOSURE_SC: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_SC: - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), symbol_to_value_unchecked(sc, cadr(sc->code)), opt_con2(sc->code)); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } + sc->temp11 = opt_con2(sc->code); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_push_and_goto_eval(sc); + + case OP_SAFE_CLOSURE_SC_P: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_SC_P: + sc->temp11 = opt_con2(sc->code); + sc->value = symbol_to_value_unchecked(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + /* -------------------------------- */ + + case OP_CLOSURE_CS: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_CS: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = cadr(sc->code); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_push_and_goto_eval(sc); + + case OP_CLOSURE_CS_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_CS_P: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = cadr(sc->code); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_goto_eval(sc); case OP_SAFE_CLOSURE_CS: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_CS: - { - s7_pointer f; - f = opt_lambda(sc->code); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), cadr(sc->code), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_push_and_goto_eval(sc); + case OP_SAFE_CLOSURE_CS_P: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_CS_P: + sc->temp11 = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); + sc->value = cadr(sc->code); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + /* -------------------------------- */ + case OP_SAFE_CLOSURE_SA: if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_SA: @@ -74349,41 +76860,64 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = T_Pair(closure_body(f)); goto BEGIN; } + /* -------------------------------- */ + + case OP_CLOSURE_AA: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_M, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_AA: + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_push_and_goto_eval(sc); + + case OP_CLOSURE_AA_P: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE_P, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_CLOSURE_AA_P: + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + check_stack_size(sc); + sc->code = opt_lambda(sc->code); + new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->temp11); + closure_goto_eval(sc); case OP_SAFE_CLOSURE_AA: - if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_M, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_AA: - { - s7_pointer args, z, f; - int32_t tx; - f = opt_lambda(sc->code); - tx = next_tx(sc); - args = cdr(sc->code); - sc->t_temps[tx] = c_call(args)(sc, car(args)); - args = cdr(args); - z = c_call(args)(sc, car(args)); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), sc->t_temps[tx], z); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_push_and_goto_eval(sc); case OP_SAFE_CLOSURE_AA_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_P, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} case HOP_SAFE_CLOSURE_AA_P: - { - s7_pointer args, z, f; - int32_t tx; - f = opt_lambda(sc->code); - tx = next_tx(sc); - args = cdr(sc->code); - sc->t_temps[tx] = c_call(args)(sc, car(args)); - args = cdr(args); - z = c_call(args)(sc, car(args)); - sc->envir = old_frame_with_two_slots(sc, closure_let(f), sc->t_temps[tx], z); - sc->code = car(closure_body(f)); - goto EVAL; - } - + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + + case OP_SAFE_CLOSURE_AA_A: + if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_A, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} + case HOP_SAFE_CLOSURE_AA_A: + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = opt_lambda(sc->code); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + sc->value = c_call(closure_body(sc->code))(sc, car(closure_body(sc->code))); + goto START; + + case OP_SAFE_CLOSURE_AA_LP: + sc->temp11 = c_call(cddr(sc->code))(sc, caddr(sc->code)); + sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code)); + sc->code = slot_value(local_slot(car(sc->code))); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), sc->value, sc->temp11); + closure_goto_eval(sc); + /* -------------------------------- */ + /* safe_closure_sss was not a win: all_x_s overhead -5, three_slot overhead +2 */ case OP_SAFE_CLOSURE_SAA: if (!closure_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE, 3)) break; @@ -74428,14 +76962,84 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } sc->envir = env; sc->code = closure_body(sc->code); - if (is_pair(cdr(sc->code))) - push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code)); + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); sc->code = car(sc->code); goto EVAL; } + case OP_CLOSURE_ALL_S: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(sc->code)))) + { + if (unknown_all_s_ex(sc, sc->last_function) == goto_EVAL) + goto EVAL; + break; + } + case HOP_CLOSURE_ALL_S: + { + s7_pointer args, p, e; + /* in this case, we have just lambda (not lambda*), and no dotted arglist, + * and no accessed symbols in the arglist, and we know the arglist matches the parameter list. + */ + check_stack_size(sc); + args = cdr(sc->code); + sc->code = opt_lambda(sc->code); + new_frame(sc, closure_let(sc->code), e); + sc->z = e; + for (p = closure_args(sc->code); is_pair(p); p = cdr(p), args = cdr(args)) + add_slot(e, car(p), symbol_to_value_unchecked(sc, car(args))); + sc->envir = e; + sc->z = sc->nil; + sc->code = T_Pair(closure_body(sc->code)); + if (is_pair(cdr(sc->code))) + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); + sc->code = car(sc->code); + goto EVAL; + } + case OP_CLOSURE_ALL_X: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(sc->code)))) + { + if (unknown_all_x_ex(sc, sc->last_function) == goto_EVAL) + goto EVAL; + break; + } + case HOP_CLOSURE_ALL_X: + { + s7_pointer args, p, e; + check_stack_size(sc); + args = cdr(sc->code); + sc->code = opt_lambda(sc->code); + new_frame(sc, closure_let(sc->code), e); + sc->z = e; + for (p = closure_args(sc->code); is_pair(p); p = cdr(p), args = cdr(args)) + add_slot(e, car(p), c_call(args)(sc, car(args))); + sc->envir = e; + sc->z = sc->nil; + sc->code = T_Pair(closure_body(sc->code)); + if (is_pair(cdr(sc->code))) + push_stack_no_args(sc, sc->begin_op, cdr(sc->code)); + sc->code = car(sc->code); + goto EVAL; + } + + case OP_CLOSURE_ANY_ALL_X: + if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, -1)) break; + case HOP_CLOSURE_ANY_ALL_X: + { + s7_pointer p, old_args; + check_stack_size(sc); + sc->w = cdr(sc->code); /* args aren't evaluated yet */ + sc->args = make_list(sc, integer(arglist_length(sc->code)), sc->F); + for (p = sc->args, old_args = sc->w; is_pair(p); p = cdr(p), old_args = cdr(old_args)) + set_car(p, c_call(old_args)(sc, car(old_args))); + sc->w = sc->nil; + sc->code = opt_lambda(sc->code); + new_frame_with_slot(sc, closure_let(sc->code), sc->envir, closure_args(sc->code), sc->args); + sc->code = T_Pair(closure_body(sc->code)); + goto BEGIN; + } + /* -------------------------------------------------------------------------------- */ case OP_SAFE_CLOSURE_STAR_A: if (!closure_star_is_ok(sc, sc->code, MATCH_SAFE_CLOSURE_STAR, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} @@ -74498,298 +77102,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = T_Got(opt_goto(sc->code)); call_with_exit(sc); goto START; - /* for T_CONTINUATION, set sc->args to list_1(sc, ...) as in goto (and code?), then call_with_current_continuation */ - - - case OP_CLOSURE_ANY_ALL_X: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, -1)) break; - case HOP_CLOSURE_ANY_ALL_X: - { - s7_pointer p, old_args; - check_stack_size(sc); - sc->w = cdr(sc->code); /* args aren't evaluated yet */ - sc->args = make_list(sc, integer(arglist_length(sc->code)), sc->F); - for (p = sc->args, old_args = sc->w; is_pair(p); p = cdr(p), old_args = cdr(old_args)) - set_car(p, c_call(old_args)(sc, car(old_args))); - sc->w = sc->nil; - sc->code = opt_lambda(sc->code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, closure_args(sc->code), sc->args); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - } - - - case OP_CLOSURE_C: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_C: - { - s7_pointer code; - code = sc->code; - check_stack_size(sc); - code = opt_lambda(code); - new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), cadr(sc->code)); - sc->code = T_Pair(closure_body(code)); - goto BEGIN; - } - - case OP_CLOSURE_P: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_P: - push_stack(sc, OP_CLOSURE_P_1, sc->args, sc->code); - sc->code = cadr(sc->code); - goto EVAL; - - case OP_CLOSURE_A: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_A: - { - s7_pointer code; - code = sc->code; - sc->value = c_call(cdr(code))(sc, cadr(code)); - check_stack_size(sc); - sc->code = opt_lambda(code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - } - - case OP_CLOSURE_A_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_A_P: - { - s7_pointer code; - code = sc->code; - sc->value = c_call(cdr(code))(sc, cadr(code)); - check_stack_size(sc); - sc->code = opt_lambda(code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); - sc->code = car(closure_body(sc->code)); - goto EVAL; - } - - case OP_CLOSURE_S: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_S: - sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); - check_stack_size(sc); - sc->code = opt_lambda(sc->code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - - case OP_CLOSURE_S_1: - if (!closure_is_equal(sc, sc->code)) {if (unknown_g_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_S_1: - sc->value = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); - sc->code = opt_lambda(sc->code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); - sc->code = car(T_Pair(closure_body(sc->code))); - goto EVAL; - - case OP_CLOSURE_SS: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_SS: - { - s7_pointer f, args; - check_stack_size(sc); - f = opt_lambda(sc->code); - args = closure_args(f); - new_frame_with_two_slots(sc, closure_let(f), sc->envir, - car(args), symbol_to_value_unchecked(sc, cadr(sc->code)), - cadr(args), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } - - case OP_CLOSURE_SS_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_SS_P: - { - s7_pointer func, args; - check_stack_size(sc); - func = opt_lambda(sc->code); - args = closure_args(func); - new_frame_with_two_slots(sc, closure_let(func), sc->envir, - car(args), symbol_to_value_unchecked(sc, cadr(sc->code)), - cadr(args), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = car(closure_body(func)); - goto EVAL; - } - - case OP_CLOSURE_SC: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_SC: - { - s7_pointer f, args; - check_stack_size(sc); - f = opt_lambda(sc->code); - args = closure_args(f); - new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), symbol_to_value_unchecked(sc, cadr(sc->code)), cadr(args), opt_con2(sc->code)); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } - - case OP_CLOSURE_CS: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_CS: - { - s7_pointer f, args; - check_stack_size(sc); - f = opt_lambda(sc->code); - args = closure_args(f); - new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), cadr(sc->code), cadr(args), symbol_to_value_unchecked(sc, opt_sym2(sc->code))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } - - case OP_CLOSURE_AA: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_AA: - { - s7_pointer f, args, a_args, code; - int32_t tx; - code = sc->code; - check_stack_size(sc); - tx = next_tx(sc); - a_args = cdr(code); - sc->t_temps[tx] = c_call(a_args)(sc, car(a_args)); - f = opt_lambda(code); - args = closure_args(f); - new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), sc->t_temps[tx], cadr(args), c_call(cdr(a_args))(sc, cadr(a_args))); - sc->code = T_Pair(closure_body(f)); - goto BEGIN; - } - - case OP_CLOSURE_AA_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_aa_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_AA_P: - { - s7_pointer f, args, a_args, code; - int32_t tx; - code = sc->code; - check_stack_size(sc); - tx = next_tx(sc); - a_args = cdr(code); - sc->t_temps[tx] = c_call(a_args)(sc, car(a_args)); - f = opt_lambda(code); - args = closure_args(f); - new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), sc->t_temps[tx], cadr(args), c_call(cdr(a_args))(sc, cadr(a_args))); - sc->code = car(closure_body(f)); - goto EVAL; - } - - case OP_CLOSURE_AP: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; - case HOP_CLOSURE_AP: - { - s7_pointer val, code; - code = sc->code; - val = c_call(cdr(code))(sc, cadr(code)); - /* (hook-push (undo-hook ind 0) (lambda (hook) (set! u0 #t))) -> #<gc-nil> - * g_undo_hook calls s7_eval_c_string so it obviously should be declared unsafe! - */ - push_stack(sc, OP_CLOSURE_AP_1, val, code); - sc->code = caddr(code); - goto EVAL; - } - - case OP_CLOSURE_PA: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; - case HOP_CLOSURE_PA: - { - s7_pointer val, code; - code = sc->code; - val = c_call(cddr(code))(sc, caddr(code)); - push_stack(sc, OP_CLOSURE_PA_1, val, code); - sc->code = cadr(code); - goto EVAL; - } - - case OP_CLOSURE_FA: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, 2)) break; - case HOP_CLOSURE_FA: - { - s7_pointer farg, larg, aarg, func, func_args, code; - code = sc->code; - farg = cdadr(code); - aarg = c_call(cddr(code))(sc, caddr(code)); - make_closure_with_let(sc, larg, car(farg), cdr(farg), sc->envir, CLOSURE_ARITY_NOT_SET); - check_stack_size(sc); - func = opt_lambda(code); /* outer func */ - func_args = closure_args(func); - new_frame_with_two_slots(sc, closure_let(func), sc->envir, car(func_args), larg, cadr(func_args), aarg); - sc->code = car(closure_body(func)); - goto EVAL; - } - - case OP_CLOSURE_ALL_S: - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(sc->code)))) - { - if (unknown_all_s_ex(sc, sc->last_function) == goto_EVAL) - goto EVAL; - break; - } - case HOP_CLOSURE_ALL_S: - { - s7_pointer args, p, func, e; - /* in this case, we have just lambda (not lambda*), and no dotted arglist, - * and no accessed symbols in the arglist, and we know the arglist matches the parameter list. - */ - check_stack_size(sc); - func = opt_lambda(sc->code); - /* we need to get the slot names from the current function, but the values from the calling environment */ - new_frame(sc, closure_let(func), e); - sc->z = e; - for (p = closure_args(func), args = cdr(sc->code); is_pair(p); p = cdr(p), args = cdr(args)) - add_slot(e, car(p), symbol_to_value_unchecked(sc, car(args))); - sc->envir = e; - sc->z = sc->nil; - sc->code = T_Pair(closure_body(func)); - goto BEGIN; - } - - case OP_CLOSURE_ALL_S_P: - if (!closure_is_equal(sc, sc->code)) {if (unknown_all_s_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break;} - case HOP_CLOSURE_ALL_S_P: - { - s7_pointer args, p, func, e; - check_stack_size(sc); - func = opt_lambda(sc->code); - new_frame(sc, closure_let(func), e); - sc->z = e; - for (p = closure_args(func), args = cdr(sc->code); is_pair(p); p = cdr(p), args = cdr(args)) - add_slot(e, car(p), symbol_to_value_unchecked(sc, car(args))); - sc->envir = e; - sc->z = sc->nil; - sc->code = car(closure_body(func)); - goto EVAL; - } - - case OP_CLOSURE_ALL_X: - check_stack_size(sc); - if (!closure_is_ok(sc, sc->code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(sc->code)))) - { - if (unknown_all_x_ex(sc, sc->last_function) == goto_EVAL) - goto EVAL; - break; - } - case HOP_CLOSURE_ALL_X: - { - s7_pointer args, p, func, e; - func = opt_lambda(sc->code); - new_frame(sc, closure_let(func), e); - sc->z = e; - - if (integer(arglist_length(sc->code)) >= (sc->free_heap_top - sc->free_heap)) - try_to_call_gc(sc); - for (p = closure_args(func), args = cdr(sc->code); is_pair(p); p = cdr(p), args = cdr(args)) - add_slot(e, car(p), c_call(args)(sc, car(args))); - - sc->envir = e; - sc->z = sc->nil; - sc->code = T_Pair(closure_body(func)); - goto BEGIN; - } + /* for T_CONTINUATION, set sc->args to list_1(sc, ...) as in goto (and code?), then call_with_current_continuation */ /* -------------------------------------------------------------------------------- */ case OP_CLOSURE_STAR_A: @@ -74814,43 +77127,36 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) /* -------------------------------------------------------------------------------- */ case OP_UNKNOWN: - case HOP_UNKNOWN: if (unknown_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_G: - case HOP_UNKNOWN_G: if (unknown_g_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_GG: - case HOP_UNKNOWN_GG: if (unknown_gg_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_ALL_S: - case HOP_UNKNOWN_ALL_S: if (unknown_all_s_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_A: - case HOP_UNKNOWN_A: if (unknown_a_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_AA: - case HOP_UNKNOWN_AA: if (unknown_aa_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; case OP_UNKNOWN_ALL_X: - case HOP_UNKNOWN_ALL_X: if (unknown_all_x_ex(sc, symbol_to_value_checked(sc, car(sc->code))) == goto_EVAL) goto EVAL; break; @@ -74858,19 +77164,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_VECTOR_A: - case HOP_VECTOR_A: if (vector_a_ex(sc) == goto_START) goto START; if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break; case OP_STRING_A: - case HOP_STRING_A: if (string_a_ex(sc) == goto_START) goto START; if (unknown_a_ex(sc, sc->last_function) == goto_EVAL) goto EVAL; break; case OP_HASH_TABLE_A: - case HOP_HASH_TABLE_A: { s7_pointer s; s = symbol_to_value_unchecked(sc, car(sc->code)); @@ -74884,7 +77187,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_CONTINUATION_A: - case HOP_CONTINUATION_A: { s7_pointer s, code; code = sc->code; @@ -74901,7 +77203,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_ITERATE: - case HOP_ITERATE: { s7_pointer s; s = symbol_to_value_unchecked(sc, car(sc->code)); @@ -74914,8 +77215,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto START; } + case OP_S7_LET: + sc->value = g_s7_let_ref_fallback(sc, set_plist_2(sc, sc->s7_let, (is_keyword(cadr(sc->code))) ? keyword_symbol(cadr(sc->code)) : cadadr(sc->code))); + goto START; + case OP_ENVIRONMENT_Q: - case HOP_ENVIRONMENT_Q: { s7_pointer s; s = symbol_to_value_unchecked(sc, car(sc->code)); @@ -74932,7 +77236,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_ENVIRONMENT_A: - case HOP_ENVIRONMENT_A: { s7_pointer s; s = symbol_to_value_unchecked(sc, car(sc->code)); @@ -74946,7 +77249,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_PAIR_A: - case HOP_PAIR_A: { s7_pointer s, x; s = symbol_to_value_unchecked(sc, car(sc->code)); @@ -74961,7 +77263,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_C_OBJECT_A: - case HOP_C_OBJECT_A: { s7_pointer c; c = symbol_to_value_unchecked(sc, car(sc->code)); @@ -75081,169 +77382,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto APPLY; } - /* tricky cases involve multiple values */ - case OP_EVAL_ARGS_P_2: /* we get here from many places (op_safe_c_sp for example) */ - set_car(sc->t2_1, sc->args); - set_car(sc->t2_2, sc->value); - sc->value = c_call(sc->code)(sc, sc->t2_1); - goto START; - - case OP_EVAL_ARGS_P_2_MV: - sc->args = cons(sc, sc->args, sc->value); - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - - case OP_EVAL_ARGS_P_3: - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(sc->code))); - /* we have to wait because we say the evaluation order is left to right (in lambda*) - * and the first arg's evaluation might change the value of the second arg. - */ - set_car(sc->t2_1, sc->value); - sc->value = c_call(sc->code)(sc, sc->t2_1); - goto START; - - case OP_EVAL_ARGS_P_3_MV: /* (define (hi a) (+ (values 1 2) a)) */ - sc->args = s7_append(sc, sc->value, list_1(sc, symbol_to_value_unchecked(sc, caddr(sc->code)))); - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - - case OP_EVAL_ARGS_P_4_MV: - sc->args = s7_append(sc, sc->value, list_1(sc, sc->args)); - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - - case OP_EVAL_ARGS_P_4: - set_car(sc->t2_1, sc->value); - set_car(sc->t2_2, sc->args); - sc->value = c_call(sc->code)(sc, sc->t2_1); - goto START; - - case OP_EVAL_ARGS_AAP_1: /* from OP_SAFE_C_AAP */ - { - s7_pointer val1, val3; - val1 = sc->args; - val3 = sc->value; - set_car(sc->t3_2, c_call(cddr(sc->code))(sc, caddr(sc->code))); - set_car(sc->t3_1, val1); - set_car(sc->t3_3, val3); - sc->value = c_call(sc->code)(sc, sc->t3_1); - goto START; - } - - case OP_EVAL_ARGS_AAP_MV: - { - s7_pointer val1, val2, val3; - val1 = sc->args; - val3 = sc->value; - val2 = c_call(cddr(sc->code))(sc, caddr(sc->code)); - sc->args = cons(sc, val1, cons(sc, val2, val3)); - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - } - - case OP_SAFE_C_SZ_SZ: - /* S_opSZq actually, in (nominal second, only actual) SZ, S=args, Z=value, - * SZ from the SP combiner for SZ - */ - set_car(sc->t2_1, sc->args); - set_car(sc->t2_2, sc->value); - set_car(sc->t2_2, c_call(caddr(sc->code))(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->t2_1); - goto START; - - case OP_SAFE_C_ZA_1: - { - s7_pointer val1; - val1 = sc->value; - set_car(sc->t2_2, c_call(cddr(sc->code))(sc, caddr(sc->code))); /* possible method call here, so sc->value needs to be saved first */ - set_car(sc->t2_1, val1); - sc->value = c_call(sc->code)(sc, sc->t2_1); - goto START; - } - - case OP_SAFE_C_ZZ_1: - push_stack(sc, OP_EVAL_ARGS_P_2, sc->value, sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - - case OP_SAFE_C_ZAA_1: - { - s7_pointer val1, val2; - val1 = sc->value; - val2 = sc->args; - set_car(sc->a3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code))); - set_car(sc->a3_1, val1); - set_car(sc->a3_2, val2); - sc->value = c_call(sc->code)(sc, sc->a3_1); - goto START; - } - - case OP_SAFE_C_AZA_1: - { - s7_pointer val1; - val1 = sc->value; - set_car(sc->t3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code))); - set_car(sc->t3_2, val1); - set_car(sc->t3_1, sc->args); - sc->value = c_call(sc->code)(sc, sc->t3_1); - goto START; - } - - case OP_SAFE_C_AAZ_1: - set_car(sc->t3_1, pop_op_stack(sc)); - set_car(sc->t3_2, sc->args); - set_car(sc->t3_3, sc->value); - sc->value = c_call(sc->code)(sc, sc->t3_1); - goto START; - - case OP_SAFE_C_ZZA_1: - push_op_stack(sc, sc->value); - push_stack_no_args(sc, OP_SAFE_C_ZZA_2, sc->code); - sc->code = T_Pair(caddr(sc->code)); - goto EVAL; - - case OP_SAFE_C_ZZA_2: - set_car(sc->a3_1, pop_op_stack(sc)); - set_car(sc->a3_2, sc->value); - set_car(sc->a3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code))); - sc->value = c_call(sc->code)(sc, sc->a3_1); - goto START; - - case OP_SAFE_C_ZAZ_1: - { - s7_pointer val; - push_op_stack(sc, sc->value); - val = c_call(cddr(sc->code))(sc, caddr(sc->code)); - push_stack(sc, OP_SAFE_C_AAZ_1, val, sc->code); - sc->code = T_Pair(cadddr(sc->code)); - goto EVAL; - } - - case OP_SAFE_C_AZZ_1: - push_op_stack(sc, sc->value); - push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code); - sc->code = T_Pair(cadddr(sc->code)); - goto EVAL; - - case OP_SAFE_C_AZZ_2: - set_car(sc->t3_1, sc->args); - set_car(sc->t3_2, pop_op_stack(sc)); - set_car(sc->t3_3, sc->value); - sc->value = c_call(sc->code)(sc, sc->t3_1); - goto START; - - case OP_SAFE_C_ZZZ_1: - push_stack(sc, OP_SAFE_C_ZZZ_2, sc->value, sc->code); - sc->code = T_Pair(opt_pair2(cdr(sc->code))); - goto EVAL; - - case OP_SAFE_C_ZZZ_2: - push_op_stack(sc, sc->value); - push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code); - sc->code = T_Pair(opt_pair1(cdr(sc->code))); - goto EVAL; - case OP_EVAL_ARGS3: /* sc->value is the next-to-last arg, and we know the last arg is not a list (so values can't mess us up!) */ { s7_pointer x, y, val; @@ -75261,12 +77399,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto APPLY; } - case OP_EVAL_ARGS4: - /* sc->code is a pair, and either cdr(sc->code) is not null or car(sc->code) is a pair - * - * (#f #f) (env #f) etc. args is very often nil here, so we're looking at 3 simple args - * or even just 2 in some cases: (+ req opt) with value 2 and args () - */ + case OP_EVAL_ARGS4: /* sc->code is a pair, and either cdr(sc->code) is not null or car(sc->code) is a pair */ { s7_pointer x; new_cell(sc, x, T_PAIR); @@ -75285,8 +77418,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->args = x; } - EVAL_ARGS: - /* first time, value = op, args = nil, code is args */ + EVAL_ARGS: /* first time, value = op, args = nil, code is args */ if (is_pair(sc->code)) /* evaluate current arg -- must check for pair here, not sc->nil (improper list as args) */ { s7_pointer car_code; @@ -75509,6 +77641,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto MACROEXPAND; case OP_MACROEXPAND: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); /* mimic APPLY above, but don't push OP_EVAL_MACRO or OP_EXPANSION * (define-macro (mac a) `(+ ,a 1)) (macroexpand (mac 3)), sc->code: ((mac 3)) @@ -75562,9 +77695,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) s7_int len; len = safe_list_length(sc->args); if (len < c_macro_required_args(sc->code)) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, not_enough_arguments_string, sc->code, sc->args)); if (c_macro_all_args(sc->code) < len) - s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args)); + s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, too_many_arguments_string, sc->code, sc->args)); sc->value = c_macro_call(sc->code)(sc, sc->args); goto START; } @@ -75646,7 +77779,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_EVAL_STRING: - while (s7_peek_char(sc, sc->input_port) != sc->eof_object) /* (eval-string "(+ 1 2) this is a mistake") */ + while (s7_peek_char(sc, sc->input_port) != eof_object) /* (eval-string "(+ 1 2) this is a mistake") */ { int32_t tk; tk = token(sc); /* (eval-string "(+ 1 2) ; a comment (not a mistake)") */ @@ -75684,12 +77817,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cadr(sc->code); goto EVAL; - case OP_SET_PAIR_Z: - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_SET_PAIR_P_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_SET_PAIR_A: { s7_pointer obj, val; @@ -75745,47 +77872,19 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_SET_DILAMBDA_Z: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_SET_DILAMBDA_Z_1, sc->code); - sc->code = T_Pair(cadr(sc->code)); + sc->code = cadr(sc->code); goto EVAL; - case OP_SET_DILAMBDA_Z_1: - { - s7_pointer obj, func, arg, value; - value = sc->value; - - arg = cadar(sc->code); - if (is_symbol(arg)) - arg = symbol_to_value_checked(sc, arg); - else - { - if (is_pair(arg)) - arg = cadr(arg); /* can only be (quote ...) in this case */ - } - obj = symbol_to_slot(sc, caar(sc->code)); - func = slot_value(obj); - if ((is_closure(func)) && - (is_safe_closure(closure_setter(func)))) - { - sc->code = closure_setter(func); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), arg, value); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - } - /* fallback on set-pair */ - if (set_pair_p_3(sc, obj, arg, value)) - goto APPLY; - } - goto START; + case OP_SET_DILAMBDA: /* ([set!] (dilambda-setter g) s) */ + sc->code = cdr(sc->code); + sc->value = cadr(sc->code); + if (is_symbol(sc->value)) + sc->value = symbol_to_value_checked(sc, sc->value); + /* fall through */ - case OP_SET_DILAMBDA: + case OP_SET_DILAMBDA_Z_1: { - /* ([set!] (dilambda-setter g) s) */ - s7_pointer obj, func, arg, value; - sc->code = cdr(sc->code); - value = cadr(sc->code); - if (is_symbol(value)) - value = symbol_to_value_checked(sc, value); - + s7_pointer obj, func, arg; arg = cadar(sc->code); if (is_symbol(arg)) arg = symbol_to_value_checked(sc, arg); @@ -75800,12 +77899,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) (is_safe_closure(closure_setter(func)))) { sc->code = closure_setter(func); - sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), arg, value); + sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), arg, sc->value); sc->code = T_Pair(closure_body(sc->code)); goto BEGIN; } - /* fallback on set-pair */ - if (set_pair_p_3(sc, obj, arg, value)) + if (set_pair_p_3(sc, obj, arg, sc->value)) goto APPLY; } goto START; @@ -75949,12 +78047,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cadr(sc->code); goto EVAL; - case OP_SET_SYMBOL_Z: /* ([set!] sum (+ sum n)) */ - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_SET_SAFE, car(sc->code)); - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_INCREMENT_SZ: { s7_pointer sym; @@ -76328,13 +78420,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_IF_P_R: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = car(sc->code); goto EVAL; case OP_IF_P_P_P: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = car(sc->code); goto EVAL; case OP_IF_P_N_N: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = cadar(sc->code); goto EVAL; - - case OP_IF_Z_P: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = T_Pair(car(sc->code)); goto EVAL; - case OP_IF_Z_N: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = T_Pair(cadar(sc->code)); goto EVAL; - case OP_IF_Z_R: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = T_Pair(car(sc->code)); goto EVAL; - case OP_IF_Z_P_P: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = T_Pair(car(sc->code)); goto EVAL; - case OP_IF_Z_N_N: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = T_Pair(cadar(sc->code)); goto EVAL; - + case OP_IF_ANDP_P: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = cdar(sc->code); goto AND_P; case OP_IF_ANDP_N: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdadar(sc->code); goto AND_P; case OP_IF_ANDP_R: sc->code = cdr(sc->code); push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdar(sc->code); goto AND_P; @@ -76371,18 +78457,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) else sc->code = cadr(sc->code); goto EVAL; - case OP_WHEN_PP: - if (is_true(sc, sc->value)) - { - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cdr(sc->code))); - sc->code = car(sc->code); - goto EVAL; - } - sc->value = sc->unspecified; - goto START; - case OP_COND_FEED: /* (cond (expr => p)) where p is (lambda (s) ...) -- see check_cond */ + set_current_code(sc, sc->code); sc->code = cdr(sc->code); push_stack_no_args(sc, OP_COND_FEED_1, sc->code); sc->code = caar(sc->code); @@ -76428,7 +78505,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cdr(sc->code); if (is_true(sc, symbol_to_value_unchecked(sc, car(sc->code)))) { - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } @@ -76440,7 +78517,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cdr(sc->code); if (is_true(sc, c_call(sc->code)(sc, car(sc->code)))) { - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } @@ -76454,6 +78531,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = car(sc->code); goto EVAL; + case OP_WHEN_PP: + if (is_true(sc, sc->value)) + { + push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code))); + sc->code = car(sc->code); + goto EVAL; + } + sc->value = sc->unspecified; + goto START; + case OP_UNLESS: set_current_code(sc, sc->code); check_unless(sc); @@ -76479,7 +78566,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cdr(sc->code); if (is_false(sc, symbol_to_value_unchecked(sc, car(sc->code)))) { - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } @@ -76491,140 +78578,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cdr(sc->code); if (is_false(sc, c_call(sc->code)(sc, car(sc->code)))) { - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } sc->value = sc->unspecified; goto START; - case OP_SAFE_C_P_1: - set_car(sc->t1_1, sc->value); - sc->value = c_call(sc->code)(sc, sc->t1_1); - goto START; - - case OP_NOT_P_1: - sc->value = ((sc->value == sc->F) ? sc->T : sc->F); - goto START; - - case OP_SAFE_CLOSURE_P_1: - sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(sc->code)), sc->value); - sc->code = T_Pair(closure_body(opt_lambda(sc->code))); - goto BEGIN; - - case OP_SAFE_CLOSURE_AP_1: - sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->args, sc->value); - sc->code = T_Pair(closure_body(opt_lambda(sc->code))); - goto BEGIN; - - case OP_SAFE_CLOSURE_PA_1: - sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->value, sc->args); - sc->code = T_Pair(closure_body(opt_lambda(sc->code))); - goto BEGIN; - - case OP_CLOSURE_P_1: - check_stack_size(sc); - sc->code = opt_lambda(sc->code); - new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - - case OP_SAFE_C_PP_1: - /* unless multiple values from last call (first arg), sc->args == sc->nil because we pushed that. - * we get here only from OP_SAFE_C_PP. - * - * currently splice_in_values changes the operator so if we get here, sc->value is the result of the first arg - * - * safe_c_pp -> 1, but if mv, -> 3 - * 1: -> 2, if mv -> 4 - * 2: done (both normal) - * 3: -> 5, but if mv, -> 6 - * 4: done (1 normal, 2 mv) - * 5: done (1 mv, 2 normal) - * 6: done (both mv) - * - * I think safe_c_ppp would require 18 branches (or maybe just collect the args and concatenate at the end?) - */ - push_stack(sc, OP_EVAL_ARGS_P_2, sc->value, sc->code); /* mv -> 3 */ - sc->code = caddr(sc->code); - goto EVAL; - - case OP_SAFE_C_PP_3: - /* we get here if the first arg returned multiple values */ - push_stack(sc, OP_SAFE_C_PP_5, sc->value, sc->code); - sc->code = caddr(sc->code); - goto EVAL; - - case OP_SAFE_C_PP_5: - /* 1 mv, 2, normal */ - sc->args = s7_append(sc, sc->args, list_1(sc, sc->value)); - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - - case OP_SAFE_C_PP_6: - /* both mv */ - sc->args = s7_append(sc, sc->args, sc->value); - /* - * c_call(sc->code) here is g_add_2, but we have any number of args from a values call - * the original (unoptimized) function is (hopefully) c_function_base(opt_cfunc(sc->code))? - * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) -> 7 - * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) -> 10 - * (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) -> 10 - * (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) -> 10 - */ - sc->code = c_function_base(opt_cfunc(sc->code)); - goto APPLY; - - case OP_C_P_1: - sc->value = c_call(sc->code)(sc, list_1(sc, sc->value)); - goto START; - - case OP_C_P_2: - /* op_c_p_1 -> mv case: (define (hi) (format (values #f "~A ~D" 1 2))) */ - sc->code = c_function_base(opt_cfunc(sc->code)); /* see comment above */ - sc->args = copy_list(sc, sc->value); - goto APPLY; - - case OP_CLOSURE_AP_1: - /* sc->value is presumably the "P" argument value, "A" is sc->args */ - check_stack_size(sc); - sc->code = opt_lambda(sc->code); - new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, - car(closure_args(sc->code)), sc->args, - cadr(closure_args(sc->code)), sc->value); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - - case OP_CLOSURE_AP_MV: /* here we got multiple values */ - sc->code = opt_lambda(sc->code); - sc->args = cons(sc, sc->args, copy_list(sc, sc->value)); - goto APPLY; - - case OP_CLOSURE_PA_1: - check_stack_size(sc); - sc->code = opt_lambda(sc->code); - new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir, - car(closure_args(sc->code)), sc->value, - cadr(closure_args(sc->code)), sc->args); - sc->code = T_Pair(closure_body(sc->code)); - goto BEGIN; - - case OP_CLOSURE_PA_MV: - sc->code = opt_lambda(sc->code); - sc->args = s7_append(sc, copy_list(sc, sc->value), cons(sc, sc->args, sc->nil)); - goto APPLY; - - case OP_CLOSURE_P_MV: - sc->code = opt_lambda(sc->code); - sc->args = copy_list(sc, sc->value); - goto APPLY; - - case OP_C_AP_1: - sc->value = c_call(sc->code)(sc, list_2(sc, sc->args, sc->value)); - goto START; /* -------------------------------- let -------------------------------- */ case OP_LET_NO_VARS: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); new_frame(sc, sc->envir, sc->envir); sc->code = T_Pair(cdr(sc->code)); /* ignore the () */ @@ -76633,13 +78597,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_NAMED_LET_NO_VARS: { s7_pointer body, slot; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); new_frame(sc, sc->envir, sc->envir); body = cddr(sc->code); sc->args = make_closure(sc, sc->nil, body, T_CLOSURE | T_COPY_ARGS | safe_closure_bits(body), 0); /* sc->args is a temp here */ slot = make_slot_1(sc, sc->envir, car(sc->code), sc->args); - if (slot == local_slot(car(sc->code))) set_recur(slot); + if (slot == local_slot(car(sc->code))) set_recur(slot, car(sc->code)); sc->code = T_Pair(body); goto BEGIN; } @@ -76651,6 +78616,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) * opt_sym3 can be clobbered by a subsequent opt_back apparently?? */ s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), cadr(binding)); @@ -76662,6 +78628,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { /* one var, init is symbol, incoming sc->code is '(((var sym))...) */ s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); sc->value = symbol_to_value_checked(sc, cadr(binding)); @@ -76670,26 +78637,28 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto BEGIN; } - case OP_LET_S_Z: + case OP_LET_S_P: { s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); sc->value = symbol_to_value_checked(sc, cadr(binding)); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value); - sc->code = T_Pair(cadr(sc->code)); + sc->code = cadr(sc->code); /* might not be a pair */ goto EVAL; } case OP_LET_opSq: { s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); set_car(sc->t1_1, symbol_to_value_unchecked(sc, opt_sym2(sc->code))); sc->value = c_call(cadr(binding))(sc, sc->t1_1); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value); - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } @@ -76697,12 +78666,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_CAR: { s7_pointer binding, val; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); val = symbol_to_value_unchecked(sc, opt_sym2(sc->code)); sc->value = (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value); - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cddr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cddr(sc->code))); sc->code = cadr(sc->code); goto EVAL; } @@ -76710,6 +78680,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_opSq_P: { s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = T_Pair(caar(sc->code)); set_car(sc->t1_1, symbol_to_value_unchecked(sc, opt_sym2(sc->code))); @@ -76720,6 +78691,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_LET_opCq: /* one var, init is safe_c_c */ + set_current_code(sc, sc->code); sc->code = cdr(sc->code); sc->value = c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code))); new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), sc->value); @@ -76729,6 +78701,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_opSSq: /* one var, init is safe_c_ss */ { s7_pointer largs, in_val; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); largs = T_Pair(opt_pair2(sc->code)); /* cadr(caar(sc->code)); */ in_val = symbol_to_value_unchecked(sc, cadr(largs)); @@ -76743,6 +78716,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_opSSq_E: { s7_pointer largs, in_val; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); largs = T_Pair(opt_pair2(sc->code)); /* cadr(caar(sc->code)); */ in_val = symbol_to_value_unchecked(sc, cadr(largs)); @@ -76757,6 +78731,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_opaSSq_E: { s7_pointer in_val, lst; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); in_val = symbol_to_value_unchecked(sc, cadr(opt_pair2(sc->code))); lst = symbol_to_value_unchecked(sc, opt_sym3(sc->code)); @@ -76774,6 +78749,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_LET_Z: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); push_stack(sc, OP_LET_Z_1, opt_sym2(cdr(sc->code)), cadr(sc->code)); sc->code = T_Pair(opt_pair2(sc->code)); @@ -76786,6 +78762,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_A: { s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = caar(sc->code); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), c_call(cdr(binding))(sc, cadr(binding))); @@ -76796,6 +78773,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_A_P: { s7_pointer binding; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); binding = caar(sc->code); new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), c_call(cdr(binding))(sc, cadr(binding))); @@ -76803,32 +78781,41 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; } - case OP_LET_ONE: /* one var */ + + case OP_LET_ONE: /* one var, pair as value */ { s7_pointer p; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); p = caar(sc->code); - sc->value = cadr(p); - if (is_pair(sc->value)) - { - push_stack(sc, OP_LET_ONE_1, car(p), cdr(sc->code)); /* args code */ - sc->code = sc->value; - goto EVAL; - } - if (is_symbol(sc->value)) - sc->value = symbol_to_value_checked(sc, sc->value); - sc->code = T_Pair(cdr(sc->code)); - sc->args = car(p); - /* drop through */ + push_stack(sc, OP_LET_ONE_1, car(p), cdr(sc->code)); /* args code */ + sc->code = cadr(p); + goto EVAL; } case OP_LET_ONE_1: new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value); goto BEGIN; + case OP_LET_ONE_P: /* one var, pair as value, one form in body */ + { + s7_pointer p; + set_current_code(sc, sc->code); + sc->code = cdr(sc->code); + p = caar(sc->code); + push_stack(sc, OP_LET_ONE_P_1, car(p), cadr(sc->code)); /* args code */ + sc->code = cadr(p); + goto EVAL; + } + + case OP_LET_ONE_P_1: + new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value); + goto EVAL; + case OP_LET_ALL_C: { s7_pointer p; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); new_frame(sc, sc->envir, sc->envir); for (p = car(sc->code); is_pair(p); p = cdr(p)) @@ -76843,6 +78830,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) */ { s7_pointer p, frame; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); frame = make_simple_let(sc); sc->args = frame; @@ -76857,6 +78845,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_ALL_opSq: { s7_pointer p, frame; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); frame = make_simple_let(sc); sc->args = frame; @@ -76883,6 +78872,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { s7_pointer p, frame; /* fprintf(stderr, "let allx %s\n", DISPLAY(sc->code)); */ + set_current_code(sc, sc->code); sc->code = cdr(sc->code); frame = make_simple_let(sc); sc->args = frame; @@ -76890,8 +78880,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) { s7_pointer arg; arg = cdar(p); - arg = c_call(arg)(sc, car(arg)); - add_slot(frame, caar(p), arg); + sc->value = c_call(arg)(sc, car(arg)); + add_slot(frame, caar(p), sc->value); } sc->let_number++; sc->envir = frame; @@ -76900,6 +78890,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_NAMED_LET: + set_current_code(sc, sc->code); sc->args = sc->nil; sc->code = cdr(sc->code); sc->value = sc->code; @@ -76909,6 +78900,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_UNCHECKED: /* not named, but has vars */ { s7_pointer x; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); new_cell(sc, x, T_PAIR); set_car(x, sc->code); @@ -76944,9 +78936,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) set_funclet(closure_let(sc->x)); funclet_set_function(closure_let(sc->x), car(sc->code)); slot = make_slot_1(sc, sc->envir, car(sc->code), sc->x); - if (slot == local_slot(car(sc->code))) set_recur(slot); + if (slot == local_slot(car(sc->code))) set_recur(slot, car(sc->code)); sc->code = T_Pair(body); sc->x = sc->nil; + + /* if is_very_safe_closure and has recur (func's slot?), try new_s7_optimize */ + /* but that requires recur support in optimize which requires the let name be known(?) */ } else sc->code = T_Pair(cdr(sc->code)); goto BEGIN; @@ -77026,7 +79021,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } else sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), body, T_CLOSURE | T_COPY_ARGS, n); slot = make_slot_1(sc, sc->envir, let_name, sc->x); - if (slot == local_slot(car(sc->code))) set_recur(slot); + if (slot == local_slot(car(sc->code))) set_recur(slot, car(sc->code)); sc->envir = new_frame_in_env(sc, sc->envir); for (x = cadr(sc->code); is_not_null(y); x = cdr(x)) @@ -77082,6 +79077,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_LET_STAR_ALL_X: { s7_pointer p, e = NULL; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); for (p = car(sc->code); is_pair(p); p = cdr(p)) { @@ -77102,6 +79098,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_LET_STAR_A2: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); push_stack(sc, OP_LET_STAR_A, sc->code, car(sc->code)); sc->code = opt_con2(sc->code); @@ -77124,12 +79121,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_NAMED_LET_STAR: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); push_stack(sc, OP_LET_STAR1, sc->code, cadr(sc->code)); sc->code = opt_con2(sc->code); goto EVAL; case OP_LET_STAR2: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); push_stack(sc, OP_LET_STAR1, sc->code, car(sc->code)); sc->code = opt_con2(sc->code); @@ -77141,6 +79140,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto LET4; case OP_LET_STAR_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); LET4: if (is_symbol(car(sc->code))) @@ -77233,6 +79233,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto LETREC1; case OP_LETREC_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); LETREC1: /* get all local vars and set to #<undefined> @@ -77293,6 +79294,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto LETREC_STAR1; case OP_LETREC_STAR_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); LETREC_STAR1: /* get all local vars and set to #<undefined> @@ -77352,6 +79354,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto LET_TEMP1; case OP_LET_TEMP_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); LET_TEMP1: push_stack(sc, OP_GC_PROTECT, sc->args = list_4(sc, car(sc->code), sc->nil, sc->nil, sc->nil), sc->code); @@ -77459,18 +79462,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto COND4; case OP_COND_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); COND4: push_stack_no_args(sc, OP_COND1, sc->code); sc->code = caar(sc->code); goto EVAL; - case OP_COND_UNCHECKED_Z: - sc->code = cdr(sc->code); - push_stack_no_args(sc, OP_COND1, sc->code); - sc->code = T_Pair(caar(sc->code)); - goto EVAL; - case OP_COND1: if (is_true(sc, sc->value)) { @@ -77493,7 +79491,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (res == goto_APPLY) goto APPLY; goto EVAL; } - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cdr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code))); sc->code = car(sc->code); goto EVAL; } @@ -77529,6 +79527,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto APPLY; case OP_COND_SIMPLE: /* no => */ + set_current_code(sc, sc->code); sc->code = cdr(sc->code); COND_SIMPLE: sc->value = caar(sc->code); @@ -77562,6 +79561,35 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } goto COND_SIMPLE; + case OP_COND_SIMPLE_P: /* no =>, no null or multiform consequent */ + set_current_code(sc, sc->code); + sc->code = cdr(sc->code); + COND_SIMPLE_P: + sc->value = caar(sc->code); + if (is_pair(sc->value)) + { + push_stack_no_args(sc, OP_COND1_SIMPLE_P, sc->code); + sc->code = sc->value; + goto EVAL; + } + if ((is_symbol(sc->value)) && + ((sc->value != sc->else_symbol) || (symbol_id(sc->else_symbol) != 0))) + sc->value = symbol_to_value_checked(sc, sc->value); + + case OP_COND1_SIMPLE_P: + if (is_true(sc, sc->value)) + { + sc->code = cadar(sc->code); + goto EVAL; + } + sc->code = cdr(sc->code); + if (is_null(sc->code)) + { + sc->value = sc->unspecified; + goto START; + } + goto COND_SIMPLE_P; + case OP_COND_ALL_X: { s7_pointer p; @@ -77601,9 +79629,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto BEGIN; } - case OP_COND_ALL_X_Z: + case OP_COND_ALL_X_P: { s7_pointer p; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); for (p = sc->code; is_pair(p); p = cdr(p)) { @@ -77618,7 +79647,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto EVAL; if (is_symbol(sc->code)) sc->value = symbol_to_value_checked(sc, sc->code); - else sc->value = sc->code; /* "Z" here includes constants! */ + else sc->value = sc->code; goto START; } } @@ -77716,16 +79745,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = cadr(sc->code); goto EVAL; - case OP_AND_AZ: - sc->code = cdr(sc->code); - if (is_false(sc, c_call(sc->code)(sc, car(sc->code)))) - { - sc->value = sc->F; - goto START; - } - sc->code = T_Pair(cadr(sc->code)); - goto EVAL; - case OP_AND_SAFE_AA: /* we know both c_callee's are set */ sc->code = cdr(sc->code); @@ -78026,7 +80045,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = car(sc->code); goto EVAL; } - /* check for => */ if ((car(sc->code) == sc->feed_to_symbol) && (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined)) { @@ -78035,8 +80053,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (res == goto_START) goto START; if (res == goto_APPLY) goto APPLY; goto EVAL; - - /* sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value)); */ } goto BEGIN; } @@ -78249,7 +80265,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) sc->code = car(sc->code); goto EVAL; } - /* check for => */ if ((car(sc->code) == sc->feed_to_symbol) && (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined)) { @@ -78258,9 +80273,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) if (res == goto_START) goto START; if (res == goto_APPLY) goto APPLY; goto EVAL; - /* sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value)); */ } - push_stack_no_args(sc, OP_BEGIN1, T_Pair(cdr(sc->code))); + push_stack_no_args(sc, sc->begin_op, T_Pair(cdr(sc->code))); sc->code = car(sc->code); goto EVAL; } @@ -78315,7 +80329,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) simple_wrong_type_argument_with_type(sc, sc->with_output_to_string_symbol, port, wrap_string(sc, "an open string output port", 26)); if (port_position(port) >= port_data_size(port)) - sc->value = block_to_string(sc, reallocate(port_data_block(port), port_position(port) + 1), port_position(port)); + sc->value = block_to_string(sc, reallocate(sc, port_data_block(port), port_position(port) + 1), port_position(port)); else sc->value = block_to_string(sc, port_data_block(port), port_position(port)); port_data(port) = NULL; port_data_size(port) = 0; @@ -78347,6 +80361,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_WITH_LET_S: { s7_pointer e; + set_current_code(sc, sc->code); sc->code = cdr(sc->code); e = symbol_to_value_checked(sc, car(sc->code)); if (e == sc->rootlet) @@ -78383,6 +80398,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) goto WITH_LET4; case OP_WITH_LET_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); WITH_LET4: sc->value = car(sc->code); @@ -78408,6 +80424,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) case OP_WITH_BAFFLE: { s7_pointer form; + set_current_code(sc, sc->code); form = sc->code; sc->code = cdr(sc->code); if (!s7_is_proper_list(sc, sc->code)) @@ -78427,6 +80444,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } case OP_WITH_BAFFLE_UNCHECKED: + set_current_code(sc, sc->code); sc->code = cdr(sc->code); if (is_null(sc->code)) { @@ -78794,7 +80812,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) return(sc->F); } #if S7_DEBUGGING - if (sc->cur_op >= OP_NO_OP) + if (sc->cur_op >= OPT_MAX_DEFINED) fprintf(stderr, "trailers: %s\n", op_names[sc->cur_op]); #endif /* else cancel all the optimization info -- someone stepped on our symbol */ @@ -78899,10 +80917,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op) } -/* needed in s7_gmp_init and s7_init, initialized in s7_init before we get to gmp */ -static s7_pointer pl_bt, pl_p, pl_bc, pcl_bc, pcl_bs, pl_bn, pl_sf, pcl_bt, pcl_e, pcl_i, pcl_r, pcl_n, pcl_s, pcl_v, pcl_f, pcl_c, pl_tl; - - /* -------------------------------- multiprecision arithmetic -------------------------------- */ #if WITH_GMP @@ -79457,15 +81471,6 @@ static s7_int big_integer_to_s7_int(mpz_t n) if (mpz_fits_slong_p(n)) return(mpz_get_si(n)); - if ((cur_sc->safety > NO_SAFETY) && - (sizeof(s7_int) == sizeof(long int))) - { - char *str; - str = mpz_get_str(NULL, 10, n); - s7_warn(cur_sc, 256, "can't convert %s to s7_int\n", str); - free(str); - } - mpz_init_set(x, n); if (mpz_cmp_ui(x, 0) < 0) { @@ -79478,6 +81483,10 @@ static s7_int big_integer_to_s7_int(mpz_t n) mpz_fdiv_q_2exp(x, x, 32); high = mpz_get_ui(x); + + if (high > (1LL << 31)) /* most callers of this function do not take sc as an argument and are in s7.h (s7_integer for example) */ + return(0); + mpz_clear(x); if (need_sign) return(-(low + (high << 32))); @@ -80036,7 +82045,7 @@ bool s7_is_bignum(s7_pointer obj) static s7_pointer big_is_bignum(s7_scheme *sc, s7_pointer args) { #define H_is_bignum "(bignum? obj) returns #t if obj is a multiprecision number." - #define Q_is_bignum pl_bt + #define Q_is_bignum sc->pl_bt return(s7_make_boolean(sc, is_big_number(car(args)))); } @@ -80766,7 +82775,7 @@ static s7_pointer big_make_polar(s7_scheme *sc, s7_pointer args) static s7_pointer big_log(s7_scheme *sc, s7_pointer args) { #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3" - #define Q_log pcl_n + #define Q_log sc->pcl_n /* either arg can be big, second is optional */ s7_pointer p0, p1 = NULL, p; @@ -80890,7 +82899,7 @@ static s7_pointer big_sqrt(s7_scheme *sc, s7_pointer args) { /* real >= 0 -> real, else complex */ #define H_sqrt "(sqrt z) returns the square root of z" - #define Q_sqrt pcl_n + #define Q_sqrt sc->pcl_n s7_pointer p; @@ -81080,7 +83089,7 @@ static s7_pointer big_trig(s7_scheme *sc, s7_pointer args, static s7_pointer big_sin(s7_scheme *sc, s7_pointer args) { #define H_sin "(sin z) returns sin(z)" - #define Q_sin pcl_n + #define Q_sin sc->pcl_n return(big_trig(sc, args, mpfr_sin, mpc_sin, TRIG_NO_CHECK, sc->sin_symbol)); } @@ -81088,7 +83097,7 @@ static s7_pointer big_sin(s7_scheme *sc, s7_pointer args) static s7_pointer big_cos(s7_scheme *sc, s7_pointer args) { #define H_cos "(cos z) returns cos(z)" - #define Q_cos pcl_n + #define Q_cos sc->pcl_n return(big_trig(sc, args, mpfr_cos, mpc_cos, TRIG_NO_CHECK, sc->cos_symbol)); } @@ -81101,7 +83110,7 @@ s7_pointer s7_cos(s7_scheme *sc, s7_pointer x) static s7_pointer big_tan(s7_scheme *sc, s7_pointer args) { #define H_tan "(tan z) returns tan(z)" - #define Q_tan pcl_n + #define Q_tan sc->pcl_n return(big_trig(sc, args, mpfr_tan, mpc_tan, TRIG_TAN_CHECK, sc->tan_symbol)); } @@ -81109,7 +83118,7 @@ static s7_pointer big_tan(s7_scheme *sc, s7_pointer args) static s7_pointer big_sinh(s7_scheme *sc, s7_pointer args) { #define H_sinh "(sinh z) returns sinh(z)" - #define Q_sinh pcl_n + #define Q_sinh sc->pcl_n /* currently (sinh 0+0/0i) -> 0.0? */ return(big_trig(sc, args, mpfr_sinh, mpc_sinh, TRIG_NO_CHECK, sc->sinh_symbol)); @@ -81118,7 +83127,7 @@ static s7_pointer big_sinh(s7_scheme *sc, s7_pointer args) static s7_pointer big_cosh(s7_scheme *sc, s7_pointer args) { #define H_cosh "(cosh z) returns cosh(z)" - #define Q_cosh pcl_n + #define Q_cosh sc->pcl_n return(big_trig(sc, args, mpfr_cosh, mpc_cosh, TRIG_NO_CHECK, sc->cosh_symbol)); } @@ -81126,7 +83135,7 @@ static s7_pointer big_cosh(s7_scheme *sc, s7_pointer args) static s7_pointer big_tanh(s7_scheme *sc, s7_pointer args) { #define H_tanh "(tanh z) returns tanh(z)" - #define Q_tanh pcl_n + #define Q_tanh sc->pcl_n return(big_trig(sc, args, mpfr_tanh, mpc_tanh, TRIG_TANH_CHECK, sc->tanh_symbol)); } @@ -81134,7 +83143,7 @@ static s7_pointer big_tanh(s7_scheme *sc, s7_pointer args) static s7_pointer big_exp(s7_scheme *sc, s7_pointer args) { #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459" - #define Q_exp pcl_n + #define Q_exp sc->pcl_n return(big_trig(sc, args, mpfr_exp, mpc_exp, TRIG_NO_CHECK, sc->exp_symbol)); } @@ -81142,7 +83151,7 @@ static s7_pointer big_exp(s7_scheme *sc, s7_pointer args) static s7_pointer big_expt(s7_scheme *sc, s7_pointer args) { #define H_expt "(expt z1 z2) returns z1^z2" - #define Q_expt pcl_n + #define Q_expt sc->pcl_n s7_pointer x, y, p; @@ -81397,7 +83406,7 @@ static s7_pointer big_expt(s7_scheme *sc, s7_pointer args) static s7_pointer big_asinh(s7_scheme *sc, s7_pointer args) { #define H_asinh "(asinh z) returns asinh(z)" - #define Q_asinh pcl_n + #define Q_asinh sc->pcl_n s7_pointer p; @@ -81432,7 +83441,7 @@ static s7_pointer big_asinh(s7_scheme *sc, s7_pointer args) static s7_pointer big_acosh(s7_scheme *sc, s7_pointer args) { #define H_acosh "(acosh z) returns acosh(z)" - #define Q_acosh pcl_n + #define Q_acosh sc->pcl_n s7_pointer p; double x; @@ -81459,7 +83468,7 @@ static s7_pointer big_acosh(s7_scheme *sc, s7_pointer args) static s7_pointer big_atanh(s7_scheme *sc, s7_pointer args) { #define H_atanh "(atanh z) returns atanh(z)" - #define Q_atanh pcl_n + #define Q_atanh sc->pcl_n s7_pointer p; @@ -81550,7 +83559,7 @@ static s7_pointer big_atan(s7_scheme *sc, s7_pointer args) static s7_pointer big_acos(s7_scheme *sc, s7_pointer args) { #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1" - #define Q_acos pcl_n + #define Q_acos sc->pcl_n s7_pointer p; @@ -81593,7 +83602,7 @@ static s7_pointer big_acos(s7_scheme *sc, s7_pointer args) static s7_pointer big_asin(s7_scheme *sc, s7_pointer args) { #define H_asin "(asin z) returns asin(z); (sin (asin 1)) = 1" - #define Q_asin pcl_n + #define Q_asin sc->pcl_n s7_pointer p; @@ -82272,7 +84281,7 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args) static s7_pointer big_quotient(s7_scheme *sc, s7_pointer args) { #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1" - #define Q_quotient pcl_r + #define Q_quotient sc->pcl_r s7_pointer x, y, p; x = car(args); @@ -82308,7 +84317,7 @@ static s7_pointer big_quotient(s7_scheme *sc, s7_pointer args) static s7_pointer big_remainder(s7_scheme *sc, s7_pointer args) { #define H_remainder "(remainder x1 x2) returns the integer remainder of x1 and x2; (remainder 10 3) = 1" - #define Q_remainder pcl_r + #define Q_remainder sc->pcl_r s7_pointer x, y, p; x = car(args); @@ -82348,7 +84357,7 @@ static s7_pointer big_remainder(s7_scheme *sc, s7_pointer args) static s7_pointer big_modulo(s7_scheme *sc, s7_pointer args) { #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers." - #define Q_modulo pcl_r + #define Q_modulo sc->pcl_r s7_pointer a, b, p; @@ -82418,6 +84427,15 @@ static int32_t big_real_scan_args(s7_scheme *sc, s7_pointer args) return(result_type); } +static s7_pointer bigrat_to_bigint(s7_scheme *sc, s7_pointer result) +{ + mpz_t n; + s7_pointer p; + mpz_init_set(n, mpq_numref(big_ratio(result))); + p = mpz_to_big_integer(sc, n); + mpz_clear(n); + return(p); +} static s7_pointer big_max(s7_scheme *sc, s7_pointer args) { @@ -82449,18 +84467,9 @@ static s7_pointer big_max(s7_scheme *sc, s7_pointer args) case T_BIG_REAL: if (mpfr_cmp(big_real(result), big_real(arg)) < 0) result = arg; break; } } - if (result_type == T_BIG_RATIO) /* maybe actual result was an int32_t */ - { - if (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0) - { - mpz_t n; - s7_pointer p; - mpz_init_set(n, mpq_numref(big_ratio(result))); - p = mpz_to_big_integer(sc, n); - mpz_clear(n); - return(p); - } - } + if ((result_type == T_BIG_RATIO) && /* maybe actual result was an int32_t */ + (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0)) + return(bigrat_to_bigint(sc, result)); return(result); } @@ -82495,18 +84504,9 @@ static s7_pointer big_min(s7_scheme *sc, s7_pointer args) case T_BIG_REAL: if (mpfr_cmp(big_real(result), big_real(arg)) > 0) result = arg; break; } } - if (result_type == T_BIG_RATIO) /* maybe actual result was an int32_t */ - { - if (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0) - { - mpz_t n; - s7_pointer p; - mpz_init_set(n, mpq_numref(big_ratio(result))); - p = mpz_to_big_integer(sc, n); - mpz_clear(n); - return(p); - } - } + if ((result_type == T_BIG_RATIO) && + (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0)) + return(bigrat_to_bigint(sc, result)); return(result); } @@ -82728,10 +84728,33 @@ static s7_pointer big_equal(s7_scheme *sc, s7_pointer args) } +static s7_pointer bigrat(s7_scheme *sc, mpz_t n, mpz_t d) +{ + s7_pointer x, rat; + mpq_t q; + if (mpz_cmp_ui(d, 1) == 0) + { + rat = mpz_to_big_integer(sc, n); + mpz_clear(n); + mpz_clear(d); + return(rat); + } + + mpq_init(q); + mpq_set_num(q, n); + mpq_set_den(q, d); + mpz_clear(n); + mpz_clear(d); + + x = mpq_to_big_ratio(sc, q); + mpq_clear(q); + return(x); +} + static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args) { #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments" - #define Q_gcd pcl_f + #define Q_gcd sc->pcl_f bool rats = false; s7_pointer x, lst; @@ -82801,23 +84824,7 @@ static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args) mpz_gcd(n, n, mpq_numref(big_ratio(rat))); mpz_lcm(d, d, mpq_denref(big_ratio(rat))); } - if (mpz_cmp_ui(d, 1) == 0) - { - rat = mpz_to_big_integer(sc, n); - mpz_clear(n); - mpz_clear(d); - return(rat); - } - - mpq_init(q); - mpq_set_num(q, n); - mpq_set_den(q, d); - mpz_clear(n); - mpz_clear(d); - - x = mpq_to_big_ratio(sc, q); - mpq_clear(q); - return(x); + return(bigrat(sc, n, d)); } } @@ -82825,7 +84832,7 @@ static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args) static s7_pointer big_lcm(s7_scheme *sc, s7_pointer args) { #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments" - #define Q_lcm pcl_f + #define Q_lcm sc->pcl_f s7_pointer x, lst; bool rats = false; @@ -82909,23 +84916,7 @@ static s7_pointer big_lcm(s7_scheme *sc, s7_pointer args) } mpz_gcd(d, d, mpq_denref(big_ratio(rat))); } - - if (mpz_cmp_ui(d, 1) == 0) - { - rat = mpz_to_big_integer(sc, n); - mpz_clear(n); - mpz_clear(d); - return(rat); - } - - mpq_init(q); - mpq_set_num(q, n); - mpq_set_den(q, d); - mpz_clear(n); - mpz_clear(d); - x = mpq_to_big_ratio(sc, q); - mpq_clear(q); - return(x); + return(bigrat(sc, n, d)); } } @@ -82934,7 +84925,7 @@ static s7_pointer set_bignum_precision(s7_scheme *sc, int32_t precision) { mp_prec_t bits; if (precision <= 1) /* (set! (*s7* 'bignum-precision) 1) causes mpfr to segfault! (also 0 and -1) */ - return(s7_out_of_range_error(sc, "set! (*s7* 'bignum-precision)", 0, wrap_integer(precision), "has to be greater than 1")); + return(s7_out_of_range_error(sc, "set! (*s7* 'bignum-precision)", 0, wrap_integer1(sc, precision), "has to be greater than 1")); bits = (mp_prec_t)precision; mpfr_set_default_prec(bits); @@ -83254,7 +85245,7 @@ static s7_pointer memory_usage(s7_scheme *sc) make_slot_1(sc, mu_let, s7_make_symbol(sc, "types"), sc->w); sc->w = sc->nil; - make_slot_1(sc, mu_let, s7_make_symbol(sc, "permanent-cells"), make_integer(sc, permanent_cells)); + make_slot_1(sc, mu_let, s7_make_symbol(sc, "permanent-cells"), make_integer(sc, sc->permanent_cells)); make_slot_1(sc, mu_let, s7_make_symbol(sc, "gc-protected-objects"), cons(sc, make_integer(sc, sc->protected_objects_size - sc->gpofl_loc), make_integer(sc, sc->protected_objects_size))); make_slot_1(sc, mu_let, s7_make_symbol(sc, "setters"), make_integer(sc, sc->protected_setters_loc)); @@ -83348,61 +85339,7 @@ static s7_pointer memory_usage(s7_scheme *sc) make_slot_1(sc, mu_let, s7_make_symbol(sc, "continuations"), cons(sc, make_integer(sc, sc->continuations->loc), make_integer(sc, cc_stacks))); } make_slot_1(sc, mu_let, s7_make_symbol(sc, "c-objects"), make_integer(sc, sc->c_objects->loc)); - - { - s7_int free_blocks = 0 /* , free_total = 0 */; - s7_int *frees; - s7_pointer free_counts; - block_t *p; - - free_counts = s7_make_int_vector(sc, NUM_BLOCK_LISTS, 1, NULL); - frees = int_vector_elements(free_counts); - - for (i = 0; i < NUM_BLOCK_LISTS; i++) frees[i] = 0; - for (i = 3; i < TOP_BLOCK_LIST; i++) - { - for (k = 0, p = block_lists[i]; p; p = block_next(p), k++); - frees[i] = k; - free_blocks += k; - /* free_total += (k * (1 << i)); */ - } - /* for (i = 0, p = block_lists[TOP_BLOCK_LIST]; p; p = block_next(p), i++) free_total += block_size(p); */ - frees[TOP_BLOCK_LIST] = i; - free_blocks += i; - for (i = 0, p = block_lists[BLOCK_LIST]; p; p = block_next(p), i++); - frees[BLOCK_LIST] = i; - free_blocks += i; - /* free_total += (free_blocks * sizeof(block_t)); */ - - make_slot_1(sc, mu_let, s7_make_symbol(sc, "free-blocks"), make_integer(sc, free_blocks)); - make_slot_1(sc, mu_let, s7_make_symbol(sc, "free-counts"), free_counts); - } -#if (TRACK_BLOCKS) - { - s7_pointer alloc_counts; - s7_int *allocs; - s7_int total = 0, t17 = 0; - - alloc_counts = s7_make_int_vector(sc, NUM_BLOCK_LISTS, 1, NULL); - allocs = int_vector_elements(alloc_counts); - for (i = 0; i < NUM_BLOCK_LISTS; i++) allocs[i] = 0; - for (i = 0; i < all_blocks_top; i++) - { - int32_t index; - index = block_index(all_blocks[i]); - allocs[index]++; - if (index == TOP_BLOCK_LIST) - t17 += block_size(all_blocks[i]); - else - { - if (index != BLOCK_LIST) - total += (1 << index); - } - } - make_slot_1(sc, mu_let, s7_make_symbol(sc, "alloc-blocks"), cons(sc, make_integer(sc, all_blocks_top), make_integer(sc, total + t17))); - make_slot_1(sc, mu_let, s7_make_symbol(sc, "alloc-counts"), alloc_counts); - } -#endif + /* c-funcs? autoload info? */ s7_gc_unprotect_at(sc, gc_loc); @@ -83787,7 +85724,7 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args) static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args) { #define H_is_float "(float? x) returns #t is x is real and not rational." - #define Q_is_float pl_bt + #define Q_is_float sc->pl_bt s7_pointer p; p = car(args); return(make_boolean(sc, is_float(p))); @@ -83799,13 +85736,13 @@ static bool is_float_b(s7_pointer p) {return(is_float(p));} static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args) { #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is neither circular nor dotted." - #define Q_is_proper_list pl_bt + #define Q_is_proper_list sc->pl_bt s7_pointer p; p = car(args); return(make_boolean(sc, s7_is_proper_list(sc, p))); } -static bool is_proper_list_b(s7_pointer p) {return(s7_is_proper_list(cur_sc, p));} +static bool is_proper_list_b_7p(s7_scheme *sc, s7_pointer p) {return(s7_is_proper_list(sc, p));} s7_int s7_print_length(s7_scheme *sc) {return(sc->print_length);} s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len) @@ -83830,7 +85767,7 @@ static const char *decoded_name(s7_scheme *sc, s7_pointer p) if (p == sc->nil) return("nil"); if (p == sc->T) return("T"); if (p == sc->F) return("F"); - if (p == sc->eof_object) return("eof_object"); + if (p == eof_object) return("eof_object"); if (p == sc->undefined) return("undefined"); if (p == sc->unspecified) return("unspecified"); if (p == sc->no_value) return("no_value"); @@ -83901,14 +85838,14 @@ static const char *decoded_name(s7_scheme *sc, s7_pointer p) if (p == sc->plist_2) return("plist_2"); if (p == sc->plist_3) return("plist_3"); if (p == sc->qlist_2) return("qlist_2"); + if (p == sc->clist_1) return("clist_1"); if (p == sc->wrong_type_arg_info) return("wrong_type_arg_info"); if (p == sc->out_of_range_info) return("out_of_range_info"); if (p == sc->simple_wrong_type_arg_info) return("simple_wrong_type_arg_info"); if (p == sc->simple_out_of_range_info) return("simple_out_of_range_info"); - if (p == sc->too_many_arguments_string) return("too_many_arguments_string"); - if (p == sc->not_enough_arguments_string) return("not_enough_arguments_string"); - if (p == sc->division_by_zero_error_string) return("division_by_zero_error_string"); - if (p == sc->missing_method_string) return("missing_method_string"); + if (p == too_many_arguments_string) return("too_many_arguments_string"); + if (p == not_enough_arguments_string) return("not_enough_arguments_string"); + if (p == missing_method_string) return("missing_method_string"); if (p == sc->stack) return("stack"); { @@ -83954,7 +85891,7 @@ static bool is_decodable(s7_scheme *sc, s7_pointer p) return(false); } -char *s7_decode_bt(void) +char *s7_decode_bt(s7_scheme *sc) { FILE *fp; fp = fopen("gdb.txt", "r"); @@ -83965,20 +85902,18 @@ char *s7_decode_bt(void) bool in_quotes = false; uint8_t *bt; block_t *bt_block; - s7_scheme *sc; - sc = cur_sc; fseek(fp, 0, SEEK_END); size = ftell(fp); rewind(fp); - bt_block = mallocate((size + 1) * sizeof(uint8_t)); + bt_block = mallocate(sc, (size + 1) * sizeof(uint8_t)); bt = (uint8_t *)block_data(bt_block); bytes = fread(bt, sizeof(uint8_t), size, fp); if (bytes != (size_t)size) { fclose(fp); - liberate(bt_block); + liberate(sc, bt_block); return((char *)" oops "); } bt[size] = '\0'; @@ -84047,7 +85982,7 @@ char *s7_decode_bt(void) } /* #<stack> etc */ }}}}}}}}} - liberate(bt_block); + liberate(sc, bt_block); } return((char *)""); } @@ -84056,17 +85991,65 @@ char *s7_decode_bt(void) /* -------------------------------- initialization -------------------------------- */ -static s7_pointer make_unique(const char* name, uint64_t typ) +static s7_pointer make_real_wrapper(void) +{ + s7_pointer p; + p = (s7_pointer)calloc(1, sizeof(s7_cell)); + typeflag(p) = T_REAL; + global_unheap(p); + return(p); +} + +static s7_pointer make_integer_wrapper(void) { s7_pointer p; - p = alloc_pointer(); + p = (s7_pointer)calloc(1, sizeof(s7_cell)); + typeflag(p) = T_INTEGER; + global_unheap(p); + return(p); +} + +static void init_wrappers(s7_scheme *sc) +{ + int32_t i; + sc->integer_wrapper1 = make_integer_wrapper(); + sc->integer_wrapper2 = make_integer_wrapper(); + sc->integer_wrapper3 = make_integer_wrapper(); + sc->real_wrapper1 = make_real_wrapper(); + sc->real_wrapper2 = make_real_wrapper(); + sc->real_wrapper3 = make_real_wrapper(); + sc->real_wrapper4 = make_real_wrapper(); + + sc->string_wrappers = (s7_pointer *)malloc(NUM_STRING_WRAPPERS * sizeof(s7_pointer)); + sc->string_wrapper_pos = 0; + for (i = 0; i < NUM_STRING_WRAPPERS; i++) + { + s7_pointer p; + p = (s7_pointer)calloc(1, sizeof(s7_cell)); + sc->string_wrappers[i] = p; + typeflag(p) = T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE; + string_block(p) = NULL; + string_value(p) = NULL; + string_length(p) = 0; + string_hash(p) = 0; + } +} + +static s7_pointer make_unique(s7_scheme *sc, const char* name, uint64_t typ) +{ + s7_pointer p; + p = alloc_pointer(sc); set_type(p, typ | T_IMMUTABLE); unique_name_length(p) = safe_strlen(name); unique_name(p) = copy_string_with_length(name, unique_name_length(p)); - unheap(p); + unheap(sc, p); return(p); } +static s7_scheme *cur_sc = NULL; /* intended for gdb (see gdbinit) */ + +static pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER; + s7_scheme *s7_init(void) { int32_t i; @@ -84078,8 +86061,12 @@ s7_scheme *s7_init(void) setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */ #endif + pthread_mutex_lock(&init_lock); if (!already_inited) { + if (sizeof(void *) > sizeof(s7_int)) + fprintf(stderr, "s7_int is too small: it has %d bytes, but void* has %d\n", (int)sizeof(s7_int), (int)sizeof(void *)); + init_types(); init_ctables(); init_mark_functions(); @@ -84088,27 +86075,38 @@ s7_scheme *s7_init(void) init_equals(); init_hash_maps(); init_pows(); + init_int_limits(); + init_small_ints(); init_uppers(); + init_chars(); + init_strings(); all_x_function_init(); init_catchers(); - init_block_lists(); - init_string_wrappers(); - real_wrapper1.tf.flag = T_REAL; - real_wrapper2.tf.flag = T_REAL; - real_wrapper3.tf.flag = T_REAL; - real_wrapper4.tf.flag = T_REAL; - integer_wrapper.tf.flag = T_INTEGER; - integer_wrapper2.tf.flag = T_INTEGER; + already_inited = true; } + pthread_mutex_unlock(&init_lock); sc = (s7_scheme *)calloc(1, sizeof(s7_scheme)); /* malloc is not recommended here */ cur_sc = sc; /* for gdb/debugging and clm optimizer */ sc->gc_off = true; /* sc->args and so on are not set yet, so a gc during init -> segfault */ sc->gc_stats = 0; init_gc_caches(sc); + sc->permanent_cells = 0; + sc->alloc_pointer_k = ALLOC_POINTER_SIZE; + sc->alloc_pointer_cells = NULL; + sc->alloc_function_k = ALLOC_FUNCTION_SIZE; + sc->alloc_function_cells = NULL; + sc->alloc_symbol_k = ALLOC_SYMBOL_SIZE; + sc->alloc_symbol_cells = NULL; + sc->num_to_str_size = -1; + sc->num_to_str = NULL; + init_block_lists(sc); + sc->alloc_string_k = ALLOC_STRING_SIZE; + sc->alloc_string_cells = NULL; sc->longjmp_ok = false; sc->setjmp_loc = NO_SET_JUMP; + sc->not_heap = global_not_heap; if (sizeof(s7_int) == 4) sc->max_vector_length = (1 << 24); @@ -84130,18 +86128,18 @@ s7_scheme *s7_init(void) sc->singletons = (s7_pointer *)calloc(256, sizeof(s7_pointer)); sc->read_line_buf = NULL; sc->read_line_buf_size = 0; - - sc->nil = make_unique("()", T_NIL); - sc->gc_nil = make_unique("#<gc-nil>", T_NIL); /* ?? perhaps a unique type for this? */ - sc->T = make_unique("#t", T_BOOLEAN); - sc->F = make_unique("#f", T_BOOLEAN); - sc->eof_object = make_unique("#<eof>", T_EOF_OBJECT); - sc->undefined = make_unique("#<undefined>", T_UNDEFINED); - sc->unspecified = make_unique("#<unspecified>", T_UNSPECIFIED); + sc->last_error_line = -1; + + sc->nil = make_unique(sc, "()", T_NIL); + sc->gc_nil = make_unique(sc, "#<gc-nil>", T_NIL); /* ?? perhaps a unique type for this? */ + sc->T = make_unique(sc, "#t", T_BOOLEAN); + sc->F = make_unique(sc, "#f", T_BOOLEAN); + sc->undefined = make_unique(sc, "#<undefined>", T_UNDEFINED); + sc->unspecified = make_unique(sc, "#<unspecified>", T_UNSPECIFIED); #if S7_DEBUGGING - sc->no_value = make_unique("#<no-value>", T_UNSPECIFIED); + sc->no_value = make_unique(sc, "#<no-value>", T_UNSPECIFIED); #else - sc->no_value = make_unique("#<unspecified>", T_UNSPECIFIED); + sc->no_value = make_unique(sc, "#<unspecified>", T_UNSPECIFIED); #endif unique_car(sc->nil) = sc->unspecified; @@ -84157,31 +86155,31 @@ s7_scheme *s7_init(void) unique_cdr(sc->undefined) = sc->undefined; /* this way find_symbol of an undefined symbol returns #<undefined> not #<unspecified> */ - sc->temp_cell_1 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->temp_cell = permanent_cons(sc->temp_cell_1, sc->nil, T_PAIR | T_IMMUTABLE); - sc->temp_cell_2 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->temp_cell_1 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->temp_cell = permanent_cons(sc, sc->temp_cell_1, sc->nil, T_PAIR | T_IMMUTABLE); + sc->temp_cell_2 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->t1_1 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->t1_1 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->t2_2 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->t2_1 = permanent_cons(sc->nil, sc->t2_2, T_PAIR | T_IMMUTABLE); - sc->z2_2 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->z2_1 = permanent_cons(sc->nil, sc->z2_2, T_PAIR | T_IMMUTABLE); + sc->t2_2 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->t2_1 = permanent_cons(sc, sc->nil, sc->t2_2, T_PAIR | T_IMMUTABLE); + sc->z2_2 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->z2_1 = permanent_cons(sc, sc->nil, sc->z2_2, T_PAIR | T_IMMUTABLE); - sc->t3_3 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->t3_2 = permanent_cons(sc->nil, sc->t3_3, T_PAIR | T_IMMUTABLE); - sc->t3_1 = permanent_cons(sc->nil, sc->t3_2, T_PAIR | T_IMMUTABLE); + sc->t3_3 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->t3_2 = permanent_cons(sc, sc->nil, sc->t3_3, T_PAIR | T_IMMUTABLE); + sc->t3_1 = permanent_cons(sc, sc->nil, sc->t3_2, T_PAIR | T_IMMUTABLE); - sc->a4_4 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); - sc->a4_3 = permanent_cons(sc->nil, sc->a4_4, T_PAIR | T_IMMUTABLE); - sc->a4_2 = permanent_cons(sc->nil, sc->a4_3, T_PAIR | T_IMMUTABLE); - sc->a4_1 = permanent_cons(sc->nil, sc->a4_2, T_PAIR | T_IMMUTABLE); + sc->a4_4 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->a4_3 = permanent_cons(sc, sc->nil, sc->a4_4, T_PAIR | T_IMMUTABLE); + sc->a4_2 = permanent_cons(sc, sc->nil, sc->a4_3, T_PAIR | T_IMMUTABLE); + sc->a4_1 = permanent_cons(sc, sc->nil, sc->a4_2, T_PAIR | T_IMMUTABLE); sc->a1_1 = sc->a4_4; sc->a2_1 = sc->a4_3; sc->a2_2 = sc->a4_4; sc->a3_1 = sc->a4_2; sc->a3_2 = sc->a4_3; sc->a3_3 = sc->a4_4; - sc->u1_1 = permanent_cons(sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); + sc->u1_1 = permanent_cons(sc, sc->nil, sc->nil, T_PAIR | T_IMMUTABLE); for (i = 1; i < NUM_SAFE_LISTS; i++) sc->safe_lists[i] = sc->nil; @@ -84221,6 +86219,7 @@ s7_scheme *s7_init(void) sc->temp8 = sc->nil; sc->temp9 = sc->nil; sc->temp10 = sc->nil; + sc->temp11 = sc->nil; for (i = 0; i < T_TEMPS_SIZE; i++) sc->t_temps[i] = sc->nil; sc->t_temp_ctr = 0; @@ -84232,18 +86231,14 @@ s7_scheme *s7_init(void) sc->autoload_names_loc = 0; sc->is_autoloading = true; - sc->permanent_objects = NULL; - sc->heap_size = INITIAL_HEAP_SIZE; if ((sc->heap_size % 32) != 0) sc->heap_size = 32 * (int64_t)ceil((double)(sc->heap_size) / 32.0); sc->heap = (s7_pointer *)malloc(sc->heap_size * sizeof(s7_pointer)); - sc->free_heap = (s7_cell **)malloc(sc->heap_size * sizeof(s7_cell *)); sc->free_heap_top = (s7_cell **)(sc->free_heap + INITIAL_HEAP_SIZE); sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TRIGGER_SIZE); sc->previous_free_heap_top = sc->free_heap_top; - { s7_cell *cells; cells = (s7_cell *)calloc(INITIAL_HEAP_SIZE, sizeof(s7_cell)); /* malloc here is not faster according to callgrind */ @@ -84261,16 +86256,15 @@ s7_scheme *s7_init(void) sc->max_heap_size = (1LL << 62); /* this has to precede s7_make_* allocations */ - sc->protected_objects_size = INITIAL_PROTECTED_OBJECTS_SIZE; - sc->gpofl = (s7_int *)malloc(INITIAL_PROTECTED_OBJECTS_SIZE * sizeof(s7_int)); - sc->gpofl_loc = INITIAL_PROTECTED_OBJECTS_SIZE - 1; - sc->protected_objects = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); - sc->protected_setters_size = INITIAL_PROTECTED_OBJECTS_SIZE; sc->protected_setters_loc = 0; sc->protected_setters = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); sc->protected_setter_symbols = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); + sc->protected_objects_size = INITIAL_PROTECTED_OBJECTS_SIZE; + sc->gpofl = (s7_int *)malloc(INITIAL_PROTECTED_OBJECTS_SIZE * sizeof(s7_int)); + sc->gpofl_loc = INITIAL_PROTECTED_OBJECTS_SIZE - 1; + sc->protected_objects = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); for (i = 0; i < INITIAL_PROTECTED_OBJECTS_SIZE; i++) { vector_element(sc->protected_objects, i) = sc->gc_nil; @@ -84286,7 +86280,6 @@ s7_scheme *s7_init(void) sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2); set_type(sc->stack, T_STACK); sc->max_stack_size = (1 << 30); - initialize_op_stack(sc); /* keep the symbol table out of the heap */ @@ -84297,15 +86290,9 @@ s7_scheme *s7_init(void) vector_getter(sc->symbol_table) = default_vector_getter; vector_setter(sc->symbol_table) = default_vector_setter; s7_vector_fill(sc, sc->symbol_table, sc->nil); - unheap(sc->symbol_table); + unheap(sc, sc->symbol_table); + make_base_optlist(sc); - { - opt_info *os; - os = (opt_info *)calloc(OPTS_SIZE, sizeof(opt_info)); - for (i = 0; i < OPTS_SIZE; i++) - sc->opts[i] = &os[i]; - } - #if WITH_MULTITHREAD_CHECKS sc->lock_count = 0; { @@ -84315,13 +86302,13 @@ s7_scheme *s7_init(void) pthread_mutex_init(&sc->lock, &attr); } #endif + sc->c_object_types = NULL; sc->c_object_types_size = 0; sc->num_c_object_types = 0; - sc->typnam = NULL; sc->typnam_len = 0; - sc->default_rationalize_error = 1.0e-12; + sc->default_rationalize_error = (s7_int_bits == 63) ? 1.0e-12 : 1.0e-6; sc->hash_table_float_epsilon = 1.0e-12; sc->morally_equal_float_epsilon = 1.0e-15; sc->float_format_precision = WRITE_REAL_PRECISION; @@ -84333,6 +86320,7 @@ s7_scheme *s7_init(void) sc->equal_class = 0; sc->let_number = 0; sc->format_column = 0; + sc->format_ports = NULL; sc->file_names = NULL; sc->file_names_size = 0; sc->file_names_top = -1; @@ -84352,8 +86340,10 @@ s7_scheme *s7_init(void) sc->num_fdats = 8; sc->plist_1 = permanent_list(sc, 1); sc->plist_2 = permanent_list(sc, 2); + sc->plist_2_2 = cdr(sc->plist_2); sc->plist_3 = permanent_list(sc, 3); sc->qlist_2 = permanent_list(sc, 2); + sc->clist_1 = permanent_list(sc, 1); sc->elist_1 = permanent_list(sc, 1); sc->elist_2 = permanent_list(sc, 2); sc->elist_3 = permanent_list(sc, 3); @@ -84364,6 +86354,46 @@ s7_scheme *s7_init(void) sc->dox_slot_symbol = s7_make_symbol(sc, "(dox_slot)"); sc->unentry = (hash_entry_t *)malloc(sizeof(hash_entry_t)); hash_entry_set_value(sc->unentry, sc->F); + sc->begin_op = OP_BEGIN1; + sc->geq_2 = NULL; +#if (!WITH_GMP) + sc->seed_symbol = NULL; + sc->carry_symbol = NULL; +#endif + sc->active_symbol = NULL; + sc->goto_symbol = NULL; + sc->data_symbol = NULL; + sc->weak_symbol = NULL; + sc->dimensions_symbol = NULL; + sc->info_symbol = NULL; + sc->c_type_symbol = NULL; + sc->at_end_symbol = NULL; + sc->sequence_symbol = NULL; + sc->position_symbol = NULL; + sc->entries_symbol = NULL; + sc->locked_symbol = NULL; + sc->function_symbol = NULL; + sc->open_symbol = NULL; + sc->alias_symbol = NULL; + sc->source_symbol = NULL; + sc->file_symbol = NULL; + sc->line_symbol = NULL; + sc->c_object_type_symbol = NULL; + sc->c_object_let_symbol = NULL; + sc->class_symbol = NULL; + sc->c_object_length_symbol = NULL; + sc->c_object_set_symbol = NULL; + sc->c_object_ref_symbol = NULL; + sc->c_object_copy_symbol = NULL; + sc->c_object_fill_symbol = NULL; + sc->c_object_reverse_symbol = NULL; + sc->c_object_to_list_symbol = NULL; + sc->c_object_to_string_symbol = NULL; + sc->closed_symbol = NULL; + sc->port_type_symbol = NULL; + sc->tree_pointers = NULL; + sc->tree_pointers_size = 0; + sc->tree_pointers_top = 0; sc->rootlet = s7_make_vector(sc, ROOTLET_SIZE); set_type(sc->rootlet, T_LET | T_SAFE_PROCEDURE); @@ -84373,95 +86403,7 @@ s7_scheme *s7_init(void) sc->envir = sc->nil; sc->shadow_rootlet = sc->nil; - if (!already_inited) - { - /* keep the small_ints out of the heap */ - { - s7_cell *cells; - cells = (s7_cell *)calloc((NUM_SMALL_INTS + 1), sizeof(s7_cell)); - for (i = 0; i <= NUM_SMALL_INTS; i++) - { - s7_pointer p; - small_ints[i] = &cells[i]; - p = small_ints[i]; - typeflag(p) = T_IMMUTABLE | T_INTEGER; - unheap(p); - integer(p) = i; - } - } - - real_zero = make_permanent_real(0.0); - set_print_name(real_zero, "0.0", 3); - real_one = make_permanent_real(1.0); - set_print_name(real_one, "1.0", 3); - real_NaN = make_permanent_real(NAN); /* in Guile, -nan.0 prints as +nan.0, (eq? +nan.0 -nan.0) is #t */ - set_print_name(real_NaN, "+nan.0", 6); - real_infinity = make_permanent_real(INFINITY); - set_print_name(real_infinity, "+inf.0", 6); - real_minus_infinity = make_permanent_real(-INFINITY); - set_print_name(real_minus_infinity, "-inf.0", 6); - real_pi = make_permanent_real(3.1415926535897932384626433832795029L); /* M_PI is not good enough for s7_double = long double */ - /* set_print_name(real_pi, "pi", 2); */ - arity_not_set = make_permanent_integer_unchecked(CLOSURE_ARITY_NOT_SET); - max_arity = make_permanent_integer_unchecked(MAX_ARITY); - minus_one = make_permanent_integer_unchecked(-1); - set_print_name(minus_one, "-1", 2); - minus_two = make_permanent_integer_unchecked(-2); - set_print_name(minus_two, "-2", 2); - /* prebuilt null string is tricky mainly because it overlaps #u8() */ - - /* keep the characters out of the heap */ - chars = (s7_pointer *)malloc((NUM_CHARS + 1) * sizeof(s7_pointer)); - chars[0] = sc->eof_object; - chars++; /* now chars[EOF] == chars[-1] == sc->eof_object */ - { - s7_cell *cells; - cells = (s7_cell *)calloc(NUM_CHARS, sizeof(s7_cell)); - for (i = 0; i < NUM_CHARS; i++) - { - s7_pointer cp; - uint8_t c; - - c = (uint8_t)i; - cp = &cells[i]; - typeflag(cp) = T_IMMUTABLE | T_CHARACTER; - unheap(cp); - character(cp) = c; - upper_character(cp) = (uint8_t)toupper(i); - is_char_alphabetic(cp) = (bool)isalpha(i); - is_char_numeric(cp) = (bool)isdigit(i); - is_char_whitespace(cp) = white_space[i]; - is_char_uppercase(cp) = (((bool)isupper(i)) || ((i >= 192) && (i < 208))); - is_char_lowercase(cp) = (bool)islower(i); - chars[i] = cp; - - #define make_character_name(S) memcpy((void *)(&(character_name(cp))), (const void *)(S), character_name_length(cp) = strlen(S)) - switch (c) - { - case ' ': make_character_name("#\\space"); break; - case '\n': make_character_name("#\\newline"); break; - case '\r': make_character_name("#\\return"); break; - case '\t': make_character_name("#\\tab"); break; - case '\0': make_character_name("#\\null"); break; - case (char)0x1b: make_character_name("#\\escape"); break; - case (char)0x7f: make_character_name("#\\delete"); break; - case (char)7: make_character_name("#\\alarm"); break; - case (char)8: make_character_name("#\\backspace"); break; - default: - { - #define P_SIZE 12 - int32_t len; - if ((c < 32) || (c >= 127)) - len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\x%x", c); - else len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\%c", c); - character_name_length(cp) = len; - break; - } - } - } - } - } - + init_wrappers(sc); make_standard_ports(sc); #define quote_help "(quote obj) returns obj unevaluated. 'obj is an abbreviation for (quote obj)." @@ -84536,7 +86478,6 @@ s7_scheme *s7_init(void) sc->with_let_symbol = assign_syntax(sc, "with-let", OP_WITH_LET, small_int(1), max_arity, with_let_help); set_local_slot(sc->with_let_symbol, global_slot(sc->with_let_symbol)); /* for set_locals */ set_immutable(sc->with_let_symbol); - sc->setter_symbol = make_symbol(sc, "setter"); #if WITH_IMMUTABLE_UNQUOTE @@ -84582,28 +86523,21 @@ s7_scheme *s7_init(void) sc->owlet = init_owlet(sc); sc->wrong_type_arg_info = permanent_list(sc, 6); - set_car(sc->wrong_type_arg_info, s7_make_permanent_string("~A argument ~D, ~S, is ~A but should be ~A")); + set_car(sc->wrong_type_arg_info, s7_make_permanent_string(sc, "~A argument ~D, ~S, is ~A but should be ~A")); sc->simple_wrong_type_arg_info = permanent_list(sc, 5); - set_car(sc->simple_wrong_type_arg_info, s7_make_permanent_string("~A argument, ~S, is ~A but should be ~A")); + set_car(sc->simple_wrong_type_arg_info, s7_make_permanent_string(sc, "~A argument, ~S, is ~A but should be ~A")); sc->out_of_range_info = permanent_list(sc, 5); - set_car(sc->out_of_range_info, s7_make_permanent_string("~A argument ~D, ~S, is out of range (~A)")); + set_car(sc->out_of_range_info, s7_make_permanent_string(sc, "~A argument ~D, ~S, is out of range (~A)")); sc->simple_out_of_range_info = permanent_list(sc, 4); - set_car(sc->simple_out_of_range_info, s7_make_permanent_string("~A argument, ~S, is out of range (~A)")); + set_car(sc->simple_out_of_range_info, s7_make_permanent_string(sc, "~A argument, ~S, is out of range (~A)")); - sc->too_many_arguments_string = s7_make_permanent_string("~A: too many arguments: ~A"); - sc->not_enough_arguments_string = s7_make_permanent_string("~A: not enough arguments: ~A"); - sc->division_by_zero_error_string = s7_make_permanent_string("~A: division by zero, ~S"); sc->division_by_zero_symbol = make_symbol(sc, "division-by-zero"); - sc->missing_method_string = s7_make_permanent_string("missing ~S method in ~S"); - - if (!already_inited) - init_car_a_list(); for (i = 0; i < NUM_TYPES; i++) - prepackaged_type_names[i] = s7_make_permanent_string((const char *)type_name_from_type(i, INDEFINITE_ARTICLE)); + prepackaged_type_names[i] = s7_make_permanent_string(sc, (const char *)type_name_from_type(i, INDEFINITE_ARTICLE)); sc->gc_off = false; @@ -84612,7 +86546,7 @@ s7_scheme *s7_init(void) /* we need the sc->is_* symbols first for the procedure signature lists */ sc->is_boolean_symbol = make_symbol(sc, "boolean?"); - pl_bt = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->T); + sc->pl_bt = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->T); sc->is_symbol_symbol = defun("symbol?", is_symbol, 1, 0, false); symbol_set_type(sc->is_symbol_symbol, T_SYMBOL); sc->is_syntax_symbol = defun("syntax?", is_syntax, 1, 0, false); symbol_set_type(sc->is_syntax_symbol, T_SYNTAX); @@ -84652,28 +86586,30 @@ s7_scheme *s7_init(void) sc->is_undefined_symbol = defun("undefined?", is_undefined, 1, 0, false); symbol_set_type(sc->is_undefined_symbol, T_UNDEFINED); sc->is_unspecified_symbol = defun("unspecified?", is_unspecified, 1, 0, false); symbol_set_type(sc->is_unspecified_symbol, T_UNSPECIFIED); sc->is_c_object_symbol = defun("c-object?", is_c_object, 1, 0, false); + sc->is_subvector_symbol = defun("subvector?", is_subvector, 1, 0, false); + sc->is_weak_hash_table_symbol = defun("weak-hash-table?", is_weak_hash_table, 1, 0, false); /* these are for signatures */ sc->is_integer_or_real_at_end_symbol = s7_make_symbol(sc, "integer:real?"); sc->is_integer_or_any_at_end_symbol = s7_make_symbol(sc, "integer:any?"); - pl_p = s7_make_signature(sc, 2, sc->T, sc->is_pair_symbol); - pl_tl = s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol); /* memq and memv signature */ - pl_bc = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_char_symbol); - pl_bn = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_number_symbol); - pl_sf = s7_make_signature(sc, 3, sc->T, sc->is_string_symbol, sc->is_procedure_symbol); - pcl_bt = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->T); - pcl_bc = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_char_symbol); - pcl_bs = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_string_symbol); - - pcl_i = s7_make_circular_signature(sc, 0, 1, sc->is_integer_symbol); - pcl_r = s7_make_circular_signature(sc, 0, 1, sc->is_real_symbol); - pcl_f = s7_make_circular_signature(sc, 0, 1, sc->is_rational_symbol); - pcl_n = s7_make_circular_signature(sc, 0, 1, sc->is_number_symbol); - pcl_s = s7_make_circular_signature(sc, 0, 1, sc->is_string_symbol); - pcl_v = s7_make_circular_signature(sc, 0, 1, sc->is_vector_symbol); - pcl_c = s7_make_circular_signature(sc, 0, 1, sc->is_char_symbol); - pcl_e = s7_make_circular_signature(sc, 0, 1, s7_make_signature(sc, 4, sc->is_let_symbol, sc->is_procedure_symbol, sc->is_macro_symbol, sc->is_c_object_symbol)); + sc->pl_p = s7_make_signature(sc, 2, sc->T, sc->is_pair_symbol); + sc->pl_tl = s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol); /* memq and memv signature */ + sc->pl_bc = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_char_symbol); + sc->pl_bn = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_number_symbol); + sc->pl_sf = s7_make_signature(sc, 3, sc->T, sc->is_string_symbol, sc->is_procedure_symbol); + sc->pcl_bt = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->T); + sc->pcl_bc = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_char_symbol); + sc->pcl_bs = s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_string_symbol); + + sc->pcl_i = s7_make_circular_signature(sc, 0, 1, sc->is_integer_symbol); + sc->pcl_r = s7_make_circular_signature(sc, 0, 1, sc->is_real_symbol); + sc->pcl_f = s7_make_circular_signature(sc, 0, 1, sc->is_rational_symbol); + sc->pcl_n = s7_make_circular_signature(sc, 0, 1, sc->is_number_symbol); + sc->pcl_s = s7_make_circular_signature(sc, 0, 1, sc->is_string_symbol); + sc->pcl_v = s7_make_circular_signature(sc, 0, 1, sc->is_vector_symbol); + sc->pcl_c = s7_make_circular_signature(sc, 0, 1, sc->is_char_symbol); + sc->pcl_e = s7_make_circular_signature(sc, 0, 1, s7_make_signature(sc, 4, sc->is_let_symbol, sc->is_procedure_symbol, sc->is_macro_symbol, sc->is_c_object_symbol)); sc->values_symbol = make_symbol(sc, "values"); @@ -84684,8 +86620,6 @@ s7_scheme *s7_init(void) sc->symbol_symbol = defun("symbol", symbol, 1, 0, true); sc->symbol_to_value_symbol = defun("symbol->value", symbol_to_value, 1, 1, false); sc->symbol_to_dynamic_value_symbol = defun("symbol->dynamic-value", symbol_to_dynamic_value, 1, 0, false); - s7_typed_dilambda(sc, "symbol-setter", g_symbol_setter, 1, 1, g_symbol_set_setter, 2, 1, H_symbol_setter, Q_symbol_setter, NULL); - sc->symbol_setter_symbol = make_symbol(sc, "symbol-setter"); sc->immutable_symbol = unsafe_defun("immutable!", immutable, 1, 0, false); sc->is_immutable_symbol = defun("immutable?", is_immutable, 1, 0, false); sc->is_constant_symbol = defun("constant?", is_constant, 1, 0, false); @@ -84725,7 +86659,11 @@ s7_scheme *s7_init(void) typeflag(sc->provide_symbol) |= T_DEFINER; sc->is_defined_symbol = defun("defined?", is_defined, 1, 2, false); - sc->c_pointer_symbol = defun("c-pointer", c_pointer, 1, 2, false); + sc->c_pointer_symbol = defun("c-pointer", c_pointer, 1, 4, false); + sc->c_pointer_info_symbol = defun("c-pointer-info", c_pointer_info, 1, 0, false); + sc->c_pointer_type_symbol = defun("c-pointer-type", c_pointer_type, 1, 0, false); + sc->c_pointer_weak1_symbol = defun("c-pointer-weak1", c_pointer_weak1, 1, 0, false); + sc->c_pointer_weak2_symbol = defun("c-pointer-weak2", c_pointer_weak2, 1, 0, false); sc->c_pointer_to_list_symbol = defun("c-pointer->list", c_pointer_to_list, 1, 0, false); sc->port_line_number_symbol = defun("port-line-number", port_line_number, 0, 1, false); @@ -85010,11 +86948,14 @@ s7_scheme *s7_init(void) sc->vector_set_symbol = defun("vector-set!", vector_set, 3, 0, true); sc->vector_dimensions_symbol = defun("vector-dimensions", vector_dimensions, 1, 0, false); sc->make_vector_symbol = defun("make-vector", make_vector, 1, 1, false); - sc->make_shared_vector_symbol = defun("make-shared-vector", make_shared_vector, 2, 1, false); sc->vector_symbol = defun("vector", vector, 0, 0, true); set_setter(sc->vector_symbol); /* like cons, I guess */ sc->vector_function = slot_value(global_slot(sc->vector_symbol)); + sc->subvector_symbol = defun("subvector", subvector, 2, 1, false); + sc->subvector_position_symbol = defun("subvector-position", subvector_position, 1, 0, false); + sc->subvector_vector_symbol = defun("subvector-vector", subvector_vector, 1, 0, false); + sc->float_vector_symbol = defun("float-vector", float_vector, 0, 0, true); sc->make_float_vector_symbol = defun("make-float-vector", make_float_vector, 1, 1, false); sc->float_vector_set_symbol = defun("float-vector-set!", float_vector_set, 3, 0, true); @@ -85035,6 +86976,7 @@ s7_scheme *s7_init(void) sc->hash_table_symbol = defun("hash-table", hash_table, 0, 0, true); sc->hash_table_star_symbol = defun("hash-table*", hash_table_star, 0, 0, true); sc->make_hash_table_symbol = defun("make-hash-table", make_hash_table, 0, 2, false); + sc->make_weak_hash_table_symbol = defun("make-weak-hash-table", make_weak_hash_table,0, 2, false); sc->hash_table_ref_symbol = defun("hash-table-ref", hash_table_ref, 2, 0, true); sc->hash_table_set_symbol = defun("hash-table-set!", hash_table_set, 3, 0, false); sc->hash_table_entries_symbol = defun("hash-table-entries", hash_table_entries, 1, 0, false); @@ -85076,7 +87018,7 @@ s7_scheme *s7_init(void) sc->procedure_source_symbol = defun("procedure-source", procedure_source, 1, 0, false); sc->funclet_symbol = defun("funclet", funclet, 1, 0, false); sc->dilambda_symbol = defun("dilambda", dilambda, 2, 0, false); - s7_typed_dilambda(sc, "setter", g_setter, 1, 0, g_set_setter, 2, 0, H_setter, Q_setter, NULL); + s7_typed_dilambda(sc, "setter", g_setter, 1, 1, g_set_setter, 2, 1, H_setter, Q_setter, NULL); sc->arity_symbol = defun("arity", arity, 1, 0, false); sc->is_aritable_symbol = defun("aritable?", is_aritable, 2, 0, false); @@ -85138,12 +87080,12 @@ s7_scheme *s7_init(void) /* -------- *features* -------- */ sc->features_symbol = s7_define_variable(sc, "*features*", sc->nil); - s7_symbol_set_setter(sc, sc->features_symbol, s7_make_function(sc, "(set *features*)", g_features_set, 2, 0, false, "*features* setter")); + s7_set_setter(sc, sc->features_symbol, s7_make_function(sc, "(set *features*)", g_features_set, 2, 0, false, "*features* setter")); /* -------- *load-path* -------- */ sc->load_path_symbol = s7_define_variable_with_documentation(sc, "*load-path*", sc->nil, "*load-path* is a list of directories (strings) that the load function searches if it is passed an incomplete file name"); - s7_symbol_set_setter(sc, sc->load_path_symbol, s7_make_function(sc, "(set *load-path*)", g_load_path_set, 2, 0, false, "*load-path* setter")); + s7_set_setter(sc, sc->load_path_symbol, s7_make_function(sc, "(set *load-path*)", g_load_path_set, 2, 0, false, "*load-path* setter")); #ifdef CLOAD_DIR sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", s7_make_string(sc, (char *)CLOAD_DIR)); @@ -85151,7 +87093,7 @@ s7_scheme *s7_init(void) #else sc->cload_directory_symbol = s7_define_variable(sc, "*cload-directory*", make_empty_string(sc, 0, 0)); #endif - s7_symbol_set_setter(sc, sc->cload_directory_symbol, s7_make_function(sc, "(set! *cload-directory*)", g_cload_directory_set, 2, 0, false, "*cload-directory* setter")); + s7_set_setter(sc, sc->cload_directory_symbol, s7_make_function(sc, "(set! *cload-directory*)", g_cload_directory_set, 2, 0, false, "*cload-directory* setter")); /* -------- *autoload* -------- * this pretends to be a hash-table or environment, but it's actually a function @@ -85162,20 +87104,20 @@ s7_scheme *s7_init(void) sym = s7_define_variable(sc, "*libraries*", sc->nil); sc->libraries = global_slot(sym); - s7_autoload(sc, make_symbol(sc, "cload.scm"), s7_make_permanent_string("cload.scm")); - s7_autoload(sc, make_symbol(sc, "lint.scm"), s7_make_permanent_string("lint.scm")); - s7_autoload(sc, make_symbol(sc, "stuff.scm"), s7_make_permanent_string("stuff.scm")); - s7_autoload(sc, make_symbol(sc, "mockery.scm"), s7_make_permanent_string("mockery.scm")); - s7_autoload(sc, make_symbol(sc, "write.scm"), s7_make_permanent_string("write.scm")); - s7_autoload(sc, make_symbol(sc, "repl.scm"), s7_make_permanent_string("repl.scm")); - s7_autoload(sc, make_symbol(sc, "r7rs.scm"), s7_make_permanent_string("r7rs.scm")); - - s7_autoload(sc, make_symbol(sc, "libc.scm"), s7_make_permanent_string("libc.scm")); - s7_autoload(sc, make_symbol(sc, "libm.scm"), s7_make_permanent_string("libm.scm")); - s7_autoload(sc, make_symbol(sc, "libdl.scm"), s7_make_permanent_string("libdl.scm")); - s7_autoload(sc, make_symbol(sc, "libgsl.scm"), s7_make_permanent_string("libgsl.scm")); - s7_autoload(sc, make_symbol(sc, "libgdbm.scm"), s7_make_permanent_string("libgdbm.scm")); - s7_autoload(sc, make_symbol(sc, "libutf8proc.scm"), s7_make_permanent_string("libutf8proc.scm")); + s7_autoload(sc, make_symbol(sc, "cload.scm"), s7_make_permanent_string(sc, "cload.scm")); + s7_autoload(sc, make_symbol(sc, "lint.scm"), s7_make_permanent_string(sc, "lint.scm")); + s7_autoload(sc, make_symbol(sc, "stuff.scm"), s7_make_permanent_string(sc, "stuff.scm")); + s7_autoload(sc, make_symbol(sc, "mockery.scm"), s7_make_permanent_string(sc, "mockery.scm")); + s7_autoload(sc, make_symbol(sc, "write.scm"), s7_make_permanent_string(sc, "write.scm")); + s7_autoload(sc, make_symbol(sc, "repl.scm"), s7_make_permanent_string(sc, "repl.scm")); + s7_autoload(sc, make_symbol(sc, "r7rs.scm"), s7_make_permanent_string(sc, "r7rs.scm")); + + s7_autoload(sc, make_symbol(sc, "libc.scm"), s7_make_permanent_string(sc, "libc.scm")); + s7_autoload(sc, make_symbol(sc, "libm.scm"), s7_make_permanent_string(sc, "libm.scm")); + s7_autoload(sc, make_symbol(sc, "libdl.scm"), s7_make_permanent_string(sc, "libdl.scm")); + s7_autoload(sc, make_symbol(sc, "libgsl.scm"), s7_make_permanent_string(sc, "libgsl.scm")); + s7_autoload(sc, make_symbol(sc, "libgdbm.scm"), s7_make_permanent_string(sc, "libgdbm.scm")); + s7_autoload(sc, make_symbol(sc, "libutf8proc.scm"), s7_make_permanent_string(sc, "libutf8proc.scm")); sc->require_symbol = s7_define_macro(sc, "require", g_require, 1, 0, true, H_require); sc->stacktrace_defaults = s7_list(sc, 5, small_int(3), small_int(45), small_int(80), small_int(45), sc->T); @@ -85183,7 +87125,7 @@ s7_scheme *s7_init(void) /* -------- *#readers* -------- */ sym = s7_define_variable(sc, "*#readers*", sc->nil); sc->sharp_readers = global_slot(sym); - s7_symbol_set_setter(sc, sym, s7_make_function(sc, "(set! *#readers*)", g_sharp_readers_set, 2, 0, false, "*#readers* setter")); + s7_set_setter(sc, sym, s7_make_function(sc, "(set! *#readers*)", g_sharp_readers_set, 2, 0, false, "*#readers* setter")); /* *features* */ s7_provide(sc, "s7"); @@ -85331,73 +87273,28 @@ s7_scheme *s7_init(void) c_function_set_setter(slot_value(global_slot(sc->port_line_number_symbol)), s7_make_function(sc, "(set! port-line-number)", g_set_port_line_number, 1, 1, false, "port line setter")); + s7_define_constant(sc, "most-positive-fixnum", mostfix); + s7_define_constant(sc, "most-negative-fixnum", leastfix); + sc->pi_symbol = s7_define_constant(sc, "pi", real_pi); + sc->objstr_max_len = s7_int_max; + { - int32_t top; + s7_pointer p; + new_cell(sc, p, T_RANDOM_STATE); #if WITH_GMP - #define S7_LOG_LLONG_MAX 36.736800 - #define S7_LOG_LONG_MAX 16.6355322 -#else - /* actually not safe = (log (- (expt 2 63) 1)) and (log (- (expt 2 31) 1)) - * (using 63 and 31 bits) - */ - #define S7_LOG_LLONG_MAX 43.668274 - #define S7_LOG_LONG_MAX 21.487562 - sc->bignum_precision = DEFAULT_BIGNUM_PRECISION; -#endif - - top = sizeof(s7_int); - s7_int32_max = (top == 8) ? S7_LONG_MAX : S7_SHORT_MAX; - s7_int32_min = (top == 8) ? S7_LONG_MIN : S7_SHORT_MIN; - s7_int_bits = (top == 8) ? 63 : 31; - s7_int_digits = (top == 8) ? 18 : 8; - - s7_int_max = (top == 8) ? S7_LLONG_MAX : S7_LONG_MAX; - s7_int_min = (top == 8) ? S7_LLONG_MIN : S7_LONG_MIN; - - s7_int_digits_by_radix[0] = 0; - s7_int_digits_by_radix[1] = 0; - - for (i = 2; i < 17; i++) - s7_int_digits_by_radix[i] = (int32_t)(floor(((top == 8) ? S7_LOG_LLONG_MAX : S7_LOG_LONG_MAX) / log((double)i))); - { - s7_pointer pos, neg; - pos = make_permanent_integer_unchecked(s7_int_max); - neg = make_permanent_integer_unchecked(s7_int_min); - if (top == 8) - { - set_print_name(pos, "9223372036854775807", 19); - set_print_name(neg, "-9223372036854775808", 20); - } - else - { - set_print_name(pos, "2147483647", 10); - set_print_name(neg, "-2147483648", 11); - } - s7_define_constant(sc, "most-positive-fixnum", pos); - s7_define_constant(sc, "most-negative-fixnum", neg); + mpz_t seed; + mpz_init_set_ui(seed, (uint32_t)time(NULL)); + gmp_randinit_default(random_gmp_state(p)); + gmp_randseed(random_gmp_state(p), seed); + mpz_clear(seed); } - if (top == 4) sc->default_rationalize_error = 1.0e-6; - sc->pi_symbol = s7_define_constant(sc, "pi", real_pi); - - sc->objstr_max_len = s7_int_max; - { - s7_pointer p; - new_cell(sc, p, T_RANDOM_STATE); -#if WITH_GMP - { - mpz_t seed; - mpz_init_set_ui(seed, (uint32_t)time(NULL)); - gmp_randinit_default(random_gmp_state(p)); - gmp_randseed(random_gmp_state(p), seed); - mpz_clear(seed); - } #else - random_seed(p) = (uint64_t)time(NULL); - random_carry(p) = 1675393560; + sc->bignum_precision = DEFAULT_BIGNUM_PRECISION; + random_seed(p) = (uint64_t)time(NULL); + random_carry(p) = 1675393560; #endif - sc->default_rng = p; - } + sc->default_rng = p; for (i = 0; i < 10; i++) sc->singletons[(uint8_t)'0' + i] = small_int(i); sc->singletons[(uint8_t)'+'] = sc->add_symbol; @@ -85417,13 +87314,13 @@ s7_scheme *s7_init(void) init_typers(sc); /* -------------------------------------------------------------------------------- */ - s7_set_d_pi_function(slot_value(global_slot(sc->float_vector_ref_symbol)), float_vector_ref_d); - s7_set_d_pid_function(slot_value(global_slot(sc->float_vector_set_symbol)), float_vector_set_d); + s7_set_d_7pi_function(slot_value(global_slot(sc->float_vector_ref_symbol)), float_vector_ref_d_7pi); + s7_set_d_7pid_function(slot_value(global_slot(sc->float_vector_set_symbol)), float_vector_set_d_7pid); - s7_set_i_pi_function(slot_value(global_slot(sc->int_vector_ref_symbol)), int_vector_ref_i); - s7_set_i_pii_function(slot_value(global_slot(sc->int_vector_set_symbol)), int_vector_set_i); - s7_set_i_pi_function(slot_value(global_slot(sc->byte_vector_ref_symbol)), byte_vector_ref_i); - s7_set_i_pii_function(slot_value(global_slot(sc->byte_vector_set_symbol)), byte_vector_set_i); + s7_set_i_7pi_function(slot_value(global_slot(sc->int_vector_ref_symbol)), int_vector_ref_i_7pi); + s7_set_i_7pii_function(slot_value(global_slot(sc->int_vector_set_symbol)), int_vector_set_i_7pii); + s7_set_i_7pi_function(slot_value(global_slot(sc->byte_vector_ref_symbol)), byte_vector_ref_i_7pi); + s7_set_i_7pii_function(slot_value(global_slot(sc->byte_vector_set_symbol)), byte_vector_set_i_7pii); s7_set_p_pi_function(slot_value(global_slot(sc->vector_ref_symbol)), vector_ref_p_pi); s7_set_p_pip_function(slot_value(global_slot(sc->vector_set_symbol)), vector_set_p_pip); @@ -85472,7 +87369,7 @@ s7_scheme *s7_init(void) s7_set_p_pp_function(slot_value(global_slot(sc->write_symbol)), write_p_pp); s7_set_p_p_function(slot_value(global_slot(sc->write_char_symbol)), write_char_p_p); s7_set_p_pp_function(slot_value(global_slot(sc->write_char_symbol)), write_char_p_pp); - s7_set_i_p_function(slot_value(global_slot(sc->port_line_number_symbol)), port_line_number_i_p); + s7_set_i_7p_function(slot_value(global_slot(sc->port_line_number_symbol)), port_line_number_i_7p); s7_set_p_p_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_p_p); s7_set_p_pp_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_p_pp); s7_set_p_pp_function(slot_value(global_slot(sc->cons_symbol)), cons_p_pp); @@ -85496,42 +87393,36 @@ s7_scheme *s7_init(void) s7_set_d_d_function(slot_value(global_slot(sc->sinh_symbol)), sinh_d_d); s7_set_d_d_function(slot_value(global_slot(sc->cosh_symbol)), cosh_d_d); s7_set_d_d_function(slot_value(global_slot(sc->tanh_symbol)), tanh_d_d); - s7_set_d_d_function(slot_value(global_slot(sc->random_symbol)), random_d_d); - s7_set_d_d_function(slot_value(global_slot(sc->round_symbol)), round_d_d); + s7_set_d_7d_function(slot_value(global_slot(sc->random_symbol)), random_d_7d); s7_set_i_i_function(slot_value(global_slot(sc->round_symbol)), round_i_i); - s7_set_d_d_function(slot_value(global_slot(sc->floor_symbol)), floor_d_d); s7_set_i_i_function(slot_value(global_slot(sc->floor_symbol)), floor_i_i); - s7_set_d_d_function(slot_value(global_slot(sc->truncate_symbol)), truncate_d_d); s7_set_i_i_function(slot_value(global_slot(sc->truncate_symbol)), truncate_i_i); - s7_set_d_d_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_d_d); s7_set_i_i_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_i); #endif s7_set_d_d_function(slot_value(global_slot(sc->add_symbol)), add_d_d); s7_set_d_d_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_d); s7_set_d_d_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_d); - s7_set_d_d_function(slot_value(global_slot(sc->divide_symbol)), divide_d_d); + s7_set_d_7d_function(slot_value(global_slot(sc->divide_symbol)), divide_d_7d); s7_set_d_dd_function(slot_value(global_slot(sc->add_symbol)), add_d_dd); s7_set_d_dd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_dd); s7_set_d_dd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_dd); - s7_set_d_dd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_dd); + s7_set_d_7dd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_7dd); #if (!WITH_GMP) s7_set_d_dd_function(slot_value(global_slot(sc->atan_symbol)), atan_d_dd); - s7_set_d_dd_function(slot_value(global_slot(sc->quotient_symbol)), quotient_d_dd); - s7_set_d_dd_function(slot_value(global_slot(sc->remainder_symbol)), remainder_d_dd); + s7_set_d_7dd_function(slot_value(global_slot(sc->quotient_symbol)), quotient_d_7dd); + s7_set_d_7dd_function(slot_value(global_slot(sc->remainder_symbol)), remainder_d_7dd); s7_set_d_dd_function(slot_value(global_slot(sc->modulo_symbol)), modulo_d_dd); #endif s7_set_d_ddd_function(slot_value(global_slot(sc->add_symbol)), add_d_ddd); s7_set_d_ddd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_ddd); s7_set_d_ddd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_ddd); - s7_set_d_ddd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_ddd); s7_set_d_dddd_function(slot_value(global_slot(sc->add_symbol)), add_d_dddd); s7_set_d_dddd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_dddd); s7_set_d_dddd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_dddd); - s7_set_d_dddd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_dddd); s7_set_p_ii_function(slot_value(global_slot(sc->divide_symbol)), divide_p_ii); s7_set_p_pp_function(slot_value(global_slot(sc->add_symbol)), add_p_pp); @@ -85541,23 +87432,23 @@ s7_scheme *s7_init(void) s7_set_i_ii_function(slot_value(global_slot(sc->max_symbol)), max_i_ii); s7_set_i_ii_function(slot_value(global_slot(sc->min_symbol)), min_i_ii); #if (!WITH_GMP) - s7_set_d_p_function(slot_value(global_slot(sc->real_part_symbol)), real_part_d_p); - s7_set_d_p_function(slot_value(global_slot(sc->imag_part_symbol)), imag_part_d_p); - s7_set_d_p_function(slot_value(global_slot(sc->magnitude_symbol)), magnitude_d_p); + s7_set_d_7p_function(slot_value(global_slot(sc->real_part_symbol)), real_part_d_7p); + s7_set_d_7p_function(slot_value(global_slot(sc->imag_part_symbol)), imag_part_d_7p); + s7_set_d_7p_function(slot_value(global_slot(sc->magnitude_symbol)), magnitude_d_7p); s7_set_p_pp_function(slot_value(global_slot(sc->multiply_symbol)), multiply_p_pp); s7_set_p_dd_function(slot_value(global_slot(sc->multiply_symbol)), mul_p_dd); s7_set_p_dd_function(slot_value(global_slot(sc->add_symbol)), add_p_dd); s7_set_p_dd_function(slot_value(global_slot(sc->subtract_symbol)), sub_p_dd); - s7_set_d_p_function(slot_value(global_slot(sc->angle_symbol)), angle_d_p); - s7_set_i_d_function(slot_value(global_slot(sc->round_symbol)), round_i_d); - s7_set_i_d_function(slot_value(global_slot(sc->floor_symbol)), floor_i_d); - s7_set_i_p_function(slot_value(global_slot(sc->floor_symbol)), floor_i_p); - s7_set_i_p_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_p); - s7_set_i_d_function(slot_value(global_slot(sc->truncate_symbol)), truncate_i_d); - s7_set_i_d_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_d); - s7_set_i_i_function(slot_value(global_slot(sc->random_symbol)), random_i_i); - s7_set_i_ii_function(slot_value(global_slot(sc->quotient_symbol)), quotient_i_ii); - s7_set_i_ii_function(slot_value(global_slot(sc->remainder_symbol)), remainder_i_ii); + s7_set_d_7p_function(slot_value(global_slot(sc->angle_symbol)), angle_d_7p); + s7_set_i_7d_function(slot_value(global_slot(sc->round_symbol)), round_i_7d); + s7_set_i_7d_function(slot_value(global_slot(sc->floor_symbol)), floor_i_7d); + s7_set_i_7p_function(slot_value(global_slot(sc->floor_symbol)), floor_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_7p); + s7_set_i_7d_function(slot_value(global_slot(sc->truncate_symbol)), truncate_i_7d); + s7_set_i_7d_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_7d); + s7_set_i_7i_function(slot_value(global_slot(sc->random_symbol)), random_i_7i); + s7_set_i_7ii_function(slot_value(global_slot(sc->quotient_symbol)), quotient_i_7ii); + s7_set_i_7ii_function(slot_value(global_slot(sc->remainder_symbol)), remainder_i_7ii); s7_set_i_ii_function(slot_value(global_slot(sc->modulo_symbol)), modulo_i_ii); #endif s7_set_i_i_function(slot_value(global_slot(sc->subtract_symbol)), subtract_i_i); @@ -85569,7 +87460,7 @@ s7_scheme *s7_init(void) s7_set_i_iii_function(slot_value(global_slot(sc->subtract_symbol)), subtract_i_iii); s7_set_i_ii_function(slot_value(global_slot(sc->multiply_symbol)), multiply_i_ii); s7_set_i_iii_function(slot_value(global_slot(sc->multiply_symbol)), multiply_i_iii); - s7_set_i_ii_function(slot_value(global_slot(sc->ash_symbol)), ash_i_ii); + s7_set_i_7ii_function(slot_value(global_slot(sc->ash_symbol)), ash_i_7ii); s7_set_i_ii_function(slot_value(global_slot(sc->logior_symbol)), logior_i_ii); s7_set_i_ii_function(slot_value(global_slot(sc->logxor_symbol)), logxor_i_ii); s7_set_i_ii_function(slot_value(global_slot(sc->logand_symbol)), logand_i_ii); @@ -85578,18 +87469,18 @@ s7_scheme *s7_init(void) s7_set_p_pp_function(slot_value(global_slot(sc->vector_append_symbol)), vector_append_p_pp); s7_set_p_ppp_function(slot_value(global_slot(sc->vector_append_symbol)), vector_append_p_ppp); s7_set_i_i_function(slot_value(global_slot(sc->integer_length_symbol)), integer_length_i_i); - s7_set_i_p_function(slot_value(global_slot(sc->string_length_symbol)), string_length_i); - s7_set_i_p_function(slot_value(global_slot(sc->vector_length_symbol)), vector_length_i); + s7_set_i_7p_function(slot_value(global_slot(sc->string_length_symbol)), string_length_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->vector_length_symbol)), vector_length_i_7p); s7_set_p_p_function(slot_value(global_slot(sc->vector_to_list_symbol)), vector_to_list_p_p); - s7_set_b_p_function(slot_value(global_slot(sc->is_exact_symbol)), s7_is_rational); - s7_set_b_p_function(slot_value(global_slot(sc->is_exact_symbol)), is_exact_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_inexact_symbol)), is_inexact_b); + /* s7_set_b_p_function(slot_value(global_slot(sc->is_exact_symbol)), s7_is_rational); */ + s7_set_b_7p_function(slot_value(global_slot(sc->is_exact_symbol)), is_exact_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_inexact_symbol)), is_inexact_b_7p); #endif - s7_set_i_p_function(slot_value(global_slot(sc->numerator_symbol)), numerator_i); - s7_set_i_p_function(slot_value(global_slot(sc->denominator_symbol)), denominator_i); - s7_set_i_p_function(slot_value(global_slot(sc->char_to_integer_symbol)), char_to_integer_i); - s7_set_i_p_function(slot_value(global_slot(sc->hash_table_entries_symbol)), hash_table_entries_i); - s7_set_i_p_function(slot_value(global_slot(sc->tree_leaves_symbol)), tree_leaves_i); + s7_set_i_7p_function(slot_value(global_slot(sc->numerator_symbol)), numerator_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->denominator_symbol)), denominator_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->char_to_integer_symbol)), char_to_integer_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->hash_table_entries_symbol)), hash_table_entries_i_7p); + s7_set_i_7p_function(slot_value(global_slot(sc->tree_leaves_symbol)), tree_leaves_i_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_boolean_symbol)), s7_is_boolean); s7_set_b_p_function(slot_value(global_slot(sc->is_byte_vector_symbol)), s7_is_byte_vector); @@ -85600,12 +87491,12 @@ s7_scheme *s7_init(void) s7_set_b_p_function(slot_value(global_slot(sc->is_c_pointer_symbol)), s7_is_c_pointer); s7_set_b_p_function(slot_value(global_slot(sc->is_dilambda_symbol)), s7_is_dilambda); s7_set_b_p_function(slot_value(global_slot(sc->is_eof_object_symbol)), s7_is_eof_object); - s7_set_b_p_function(slot_value(global_slot(sc->is_even_symbol)), is_even_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_even_symbol)), is_even_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_float_symbol)), is_float_b); s7_set_b_p_function(slot_value(global_slot(sc->is_float_vector_symbol)), s7_is_float_vector); s7_set_b_p_function(slot_value(global_slot(sc->is_gensym_symbol)), s7_is_gensym); s7_set_b_p_function(slot_value(global_slot(sc->is_hash_table_symbol)), s7_is_hash_table); - s7_set_b_p_function(slot_value(global_slot(sc->is_infinite_symbol)), is_infinite_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_infinite_symbol)), is_infinite_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_input_port_symbol)), is_input_port_b); s7_set_b_p_function(slot_value(global_slot(sc->is_integer_symbol)), s7_is_integer); s7_set_b_p_function(slot_value(global_slot(sc->is_int_vector_symbol)), s7_is_int_vector); @@ -85613,15 +87504,15 @@ s7_scheme *s7_init(void) s7_set_b_p_function(slot_value(global_slot(sc->is_let_symbol)), s7_is_let); s7_set_b_p_function(slot_value(global_slot(sc->is_list_symbol)), is_list_b); s7_set_b_p_function(slot_value(global_slot(sc->is_macro_symbol)), is_macro_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_nan_symbol)), is_nan_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_nan_symbol)), is_nan_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_null_symbol)), is_null_b); s7_set_b_p_function(slot_value(global_slot(sc->is_number_symbol)), s7_is_number); - s7_set_b_p_function(slot_value(global_slot(sc->is_odd_symbol)), is_odd_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_odd_symbol)), is_odd_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_output_port_symbol)), is_output_port_b); s7_set_b_p_function(slot_value(global_slot(sc->is_pair_symbol)), s7_is_pair); - s7_set_b_p_function(slot_value(global_slot(sc->is_port_closed_symbol)), is_port_closed_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_port_closed_symbol)), is_port_closed_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_procedure_symbol)), s7_is_procedure); - s7_set_b_p_function(slot_value(global_slot(sc->is_proper_list_symbol)), is_proper_list_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_proper_list_symbol)), is_proper_list_b_7p); s7_set_b_p_function(slot_value(global_slot(sc->is_random_state_symbol)), is_random_state_b); s7_set_b_p_function(slot_value(global_slot(sc->is_rational_symbol)), s7_is_rational); s7_set_b_p_function(slot_value(global_slot(sc->is_real_symbol)), s7_is_real); @@ -85630,13 +87521,13 @@ s7_scheme *s7_init(void) s7_set_b_p_function(slot_value(global_slot(sc->is_symbol_symbol)), s7_is_symbol); s7_set_b_p_function(slot_value(global_slot(sc->is_syntax_symbol)), s7_is_syntax); s7_set_b_p_function(slot_value(global_slot(sc->is_vector_symbol)), s7_is_vector); - s7_set_b_p_function(slot_value(global_slot(sc->is_iterator_symbol)), is_iterator_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_iterator_symbol)), is_iterator_b_7p); - s7_set_b_p_function(slot_value(global_slot(sc->is_char_alphabetic_symbol)), is_char_alphabetic_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_char_lower_case_symbol)), is_char_lower_case_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_char_numeric_symbol)), is_char_numeric_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_char_upper_case_symbol)), is_char_upper_case_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_char_whitespace_symbol)), is_char_whitespace_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_char_alphabetic_symbol)), is_char_alphabetic_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_char_lower_case_symbol)), is_char_lower_case_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_char_numeric_symbol)), is_char_numeric_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_char_upper_case_symbol)), is_char_upper_case_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_char_whitespace_symbol)), is_char_whitespace_b_7p); s7_set_b_p_direct_function(slot_value(global_slot(sc->is_char_alphabetic_symbol)), is_char_alphabetic_c); s7_set_b_p_direct_function(slot_value(global_slot(sc->is_char_lower_case_symbol)), is_char_lower_case_c); s7_set_b_p_direct_function(slot_value(global_slot(sc->is_char_numeric_symbol)), is_char_numeric_c); @@ -85644,24 +87535,26 @@ s7_scheme *s7_init(void) s7_set_b_p_direct_function(slot_value(global_slot(sc->is_char_whitespace_symbol)), is_char_whitespace_c); s7_set_b_p_function(slot_value(global_slot(sc->is_openlet_symbol)), s7_is_openlet); - s7_set_b_p_function(slot_value(global_slot(sc->iterator_is_at_end_symbol)), iterator_is_at_end_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_b); - s7_set_b_p_function(slot_value(global_slot(sc->not_symbol)), not_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_provided_symbol)), is_provided_b); - s7_set_b_p_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_p); - s7_set_b_pp_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->tree_memq_symbol)), tree_memq_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->tree_set_memq_symbol)), tree_set_memq_b_pp); + s7_set_b_7p_function(slot_value(global_slot(sc->iterator_is_at_end_symbol)), iterator_is_at_end_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->not_symbol)), not_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_provided_symbol)), is_provided_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_7p); + s7_set_b_7pp_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->tree_memq_symbol)), tree_memq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->tree_set_memq_symbol)), tree_set_memq_b_7pp); s7_set_b_p_function(slot_value(global_slot(sc->is_immutable_symbol)), s7_is_immutable); s7_set_p_p_function(slot_value(global_slot(sc->is_pair_symbol)), is_pair_p_p); + s7_set_p_p_function(slot_value(global_slot(sc->type_of_symbol)), s7_type_of); + /* s7_set_p_p_function(slot_value(global_slot(sc->openlet_symbol)), s7_openlet); -- needs error check */ s7_set_p_p_function(slot_value(global_slot(sc->integer_to_char_symbol)), integer_to_char_p_p); #if WITH_SYSTEM_EXTRAS - s7_set_b_p_function(slot_value(global_slot(sc->is_directory_symbol)), is_directory_b); - s7_set_b_p_function(slot_value(global_slot(sc->file_exists_symbol)), file_exists_b); + s7_set_b_7p_function(slot_value(global_slot(sc->is_directory_symbol)), is_directory_b_7p); + s7_set_b_7p_function(slot_value(global_slot(sc->file_exists_symbol)), file_exists_b_7p); #endif s7_set_b_i_function(slot_value(global_slot(sc->is_even_symbol)), is_even_i); @@ -85686,7 +87579,7 @@ s7_scheme *s7_init(void) s7_set_b_dd_function(slot_value(global_slot(sc->geq_symbol)), geq_b_dd); #if (!WITH_GMP) - s7_set_b_pp_function(slot_value(global_slot(sc->logbit_symbol)), logbit_b_pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->logbit_symbol)), logbit_b_7pp); s7_set_p_pi_function(slot_value(global_slot(sc->eq_symbol)), equal_p_pi); s7_set_p_pp_function(slot_value(global_slot(sc->eq_symbol)), equal_p_pp); s7_set_p_ii_function(slot_value(global_slot(sc->eq_symbol)), equal_p_ii); @@ -85712,11 +87605,11 @@ s7_scheme *s7_init(void) s7_set_p_ii_function(slot_value(global_slot(sc->geq_symbol)), geq_p_ii); s7_set_p_dd_function(slot_value(global_slot(sc->geq_symbol)), geq_p_dd); - s7_set_b_pp_function(slot_value(global_slot(sc->eq_symbol)), req_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->lt_symbol)), lt_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->leq_symbol)), leq_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->gt_symbol)), gt_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->geq_symbol)), geq_b_pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->eq_symbol)), req_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->lt_symbol)), lt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->leq_symbol)), leq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->gt_symbol)), gt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->geq_symbol)), geq_b_7pp); s7_set_b_pi_function(slot_value(global_slot(sc->eq_symbol)), req_b_pi); s7_set_b_pi_function(slot_value(global_slot(sc->lt_symbol)), lt_b_pi); @@ -85727,20 +87620,20 @@ s7_scheme *s7_init(void) s7_set_b_pp_function(slot_value(global_slot(sc->is_eq_symbol)), s7_is_eq); s7_set_b_pp_function(slot_value(global_slot(sc->is_eqv_symbol)), s7_is_eqv); - s7_set_b_pp_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_b_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_b_pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_b_7pp); s7_set_p_pp_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_p_pp); s7_set_p_pp_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_p_pp); - s7_set_b_pp_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_gt_symbol)), char_gt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_geq_symbol)), char_geq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_eq_symbol)), char_eq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_lt_symbol)), string_lt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_leq_symbol)), string_leq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_gt_symbol)), string_gt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_b); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_gt_symbol)), char_gt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_geq_symbol)), char_geq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_eq_symbol)), char_eq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_lt_symbol)), string_lt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_leq_symbol)), string_leq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_gt_symbol)), string_gt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_b_7pp); s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_b_direct); s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_b_direct); @@ -85753,18 +87646,18 @@ s7_scheme *s7_init(void) s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_b_direct); s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_b_direct); - s7_set_b_pp_function(slot_value(global_slot(sc->is_aritable_symbol)), is_aritable_b_pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->is_aritable_symbol)), is_aritable_b_7pp); #if (!WITH_PURE_S7) - s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_gt_symbol)), char_ci_gt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_geq_symbol)), char_ci_geq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_eq_symbol)), char_ci_eq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_lt_symbol)), string_ci_lt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_leq_symbol)), string_ci_leq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_gt_symbol)), string_ci_gt_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_geq_symbol)), string_ci_geq_b); - s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_b); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_ci_gt_symbol)), char_ci_gt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_ci_geq_symbol)), char_ci_geq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->char_ci_eq_symbol)), char_ci_eq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_ci_lt_symbol)), string_ci_lt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_ci_leq_symbol)), string_ci_leq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_ci_gt_symbol)), string_ci_gt_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_ci_geq_symbol)), string_ci_geq_b_7pp); + s7_set_b_7pp_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_b_7pp); s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_b_direct); s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_b_direct); @@ -85778,7 +87671,6 @@ s7_scheme *s7_init(void) s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_b_direct); #endif - /* -------------------------------------------------------------------------------- */ s7_define_macro(sc, "quasiquote", g_quasiquote, 1, 0, false, H_quasiquote); @@ -85894,7 +87786,9 @@ s7_scheme *s7_init(void) (define make-keyword string->keyword) \n\ (define procedure-setter setter) \n\ (define procedure-signature signature) \n\ - (define procedure-documentation documentation))"); + (define procedure-documentation documentation) \n\ + (define symbol-setter setter) \n\ + (define make-shared-vector subvector))"); #if (!WITH_PURE_S7) s7_eval_c_string(sc, "(define-macro (defmacro name args . body) (cons 'define-macro (cons (cons name args) body)))"); s7_eval_c_string(sc, "(define-macro (defmacro* name args . body) (cons 'define-macro* (cons (cons name args) body)))"); @@ -85902,22 +87796,16 @@ s7_scheme *s7_init(void) #endif #if S7_DEBUGGING - if (strcmp(opt_names[HOP_SAFE_C_AAP], "h_safe_c_aap") != 0) - fprintf(stderr, "opt_name: %s\n", opt_names[HOP_SAFE_C_AAP]); - if (strcmp(op_names[OP_SET_WITH_LET_2], "set_with_let_2") != 0) - fprintf(stderr, "op_name: %s\n", op_names[OP_SET_WITH_LET_2]); + if (strcmp(op_names[HOP_SAFE_C_AAP], "h_safe_c_aap") != 0) fprintf(stderr, "op_name: %s\n", op_names[HOP_SAFE_C_AAP]); + if (strcmp(op_names[OP_SET_WITH_LET_2], "set_with_let_2") != 0) fprintf(stderr, "op_name: %s\n", op_names[OP_SET_WITH_LET_2]); + if (strcmp(op_names[OP_SAFE_CLOSURE_A_A], "safe_closure_a_a") != 0) fprintf(stderr, "op_name: %s\n", op_names[OP_SAFE_CLOSURE_A_A]); #endif - - /* fprintf(stderr, "size: cell: %d, block: %d, proc: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), (int)sizeof(block_t), (int)sizeof(c_proc_t), OP_MAX_DEFINED, OPT_MAX_DEFINED); */ - /* 64 bit machine: cell size: 56 [size 80 if gmp, 136 if debugging], block size: 40, proc_t: 96, op: 408, opt: 450, 48 if 32 (let_id/typeflag etc is 64 bit) */ - - if (sizeof(void *) > sizeof(s7_int)) - fprintf(stderr, "s7_int is too small: it has %d bytes, but void* has %d\n", (int)sizeof(s7_int), (int)sizeof(void *)); + /* fprintf(stderr, "size: cell: %d, block: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), (int)sizeof(block_t), OP_MAX_DEFINED, OPT_MAX_DEFINED); */ + /* 64 bit machine: cell size: 56 [size 80 if gmp, 136 if debugging], block size: 40, max op: 823, opt: 424, 48 if 32 (let_id/typeflag etc is 64 bit) */ save_unlet(sc); init_s7_let(sc); /* set up *s7* */ init_signatures(sc); /* depends on procedure symbols */ - already_inited = true; return(sc); } @@ -85979,6 +87867,7 @@ int main(int argc, char **argv) * * new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive, /usr/ccrma/web/html/software/snd/index.html * + * -------- to do -------- * print readably closure that refers to vector that contains closure -- need to scan structs for closures * [add shared_info collection of closure args/body for print/morally-equal] * cyclic closure eschew opt if safety>0, otherwise leave a bit trail during opt @@ -85991,90 +87880,65 @@ int main(int argc, char **argv) * (concatenate lambda `((x)) (let ((<1> (hash-table*))) (set! (<1> 'a) <1>) <1>)) * map/apply case (for example) hits the same loops * see t752.scm for more examples - * - * need a timing test for macros (extend tmac) -- can expander precalc more? - * stuff has Display, typed-let, incf/decf, progv, value->symbol, destructuring-bind, let*-temporarily, do*, string-case, define-class et al - * also one for ffi/opt: libc/gsl? fft-window code from clm? - * save print-names in number->string? - * safe_closure_x as tc can forgo old_frame and jump back to self if only tc call - * if expr involves d_dd_f et al, they can be combined -- how to signal this and provide the translation? - * try g_add_2 -> add_d_dd for example: op_safe_c_oo etc - * top-like displays from *s7* 'memory-usage - * object->let *s7*: create a permanent (immutable) let holding slots and values (all outside gc, preset etc) - * each call fills the fields directly, memory-usage as an enclosed let - * check float n->s snp: 1/3 faster than snp but 'g' match is not perfect (does it need to be?) -- need rounding in low bits etc - * - * *_P|*_E|*_Z (all combinations) can be used throughout, closure_aa_p could include _e (etc), also and_ap|e (tpm.c) - * set_currect_code to more closure bodies, more syn blocks - * test-phases opt - * remove packing from profile info - * opt set_c_function_star_args: big overhead, why so few simple defaults? sym=constant - * why two flags for func* args have simple defaults? - * use symbol-list for duplicate check, not the checked bit - * if constant, preset? - * error funcs could be inline - * is_pair_or_symbol? - * redundancy involving pair_set_syntax_op (set syn_pair + opt_op) - * tr.scm repetitions (list_to_dims > vector-equal? -- why list of dims at all?) - * - * glistener curlet|owlet->rootlet display (tree-view?) where each can expand via object->let - * or the same using the status area - * - * new optlists: expand safe closure in place, if tc, set env and jump back to expansion start - * need opt_closure? - * simple_do_ex opt: is something like opt_p_pip_ssc, this can't call anything, so it is completely unwrappable: - * if fp is opt_p_pip_ssc, o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v4.p) - * where all o->x can be preset, and pc is not used (so sc->pc = 0 is unnecessary) - * if stepper=slot_value o->v2.p that also can be used - * if o->v3.p.pip_f is string_set_unchecked, string_set_unchecked(slot_value(s1), integer(stepper), c) - * which becomes string_value(slot_value(s1))[integer(stepper]] = character(c) - * but the stepper is unneeded and string_value can be pulled out, and c is constant so - * str[i]=char, but that is memset(str, char, end - integer(stepper)) which is 30-100 times as fast (see opt_dotimes) - * so a chooser for opts? - * also a way to classify opt_* in this way + * does equal? work here? * * for gtk 4: * gtk gl: I can't see how to switch gl in and out as in the motif version -- I guess I need both gl_area and drawing_area * test other func cases in libgtk_s7, several more special funcs * make|free-cairo: xm-enved.fs * how to force access to a drawing_area widget's cairo_t? gtk_widget_queue_draw after everything comes up? - * object->let for gtk widgets? * * snd+gtk+script->eps fails?? Also why not make a graph in the no-gui case? t415.scm. * remove as many edpos args as possible, and num+bool->num * snd namespaces: dac, edits, fft, gxcolormaps, mix, region, snd. for snd-mix, tie-ins are in place * why doesn't the GL spectrogram work for stereo files? snd-chn.c 3195 - * why does set-samples inf crash? * - * t725: auto-test - * t772: lint or|and tests - * t776: cycle tests + * need a timing test for macros (extend tmac) -- can expander precalc more? + * stuff has Display, typed-let, incf/decf, progv, value->symbol, destructuring-bind, let*-temporarily, do*, string-case, define-class et al + * also one for ffi/opt: libc/gsl? fft-window code from clm? + * profiling via begin_op? (profile's file_and_line could be stored in opt2) + * + * need new_s7_opt to handle multiple exprs + * syms are now 12..15 -- need to fix this eventually + * float-stepper do and 2+1 stepper do, cdr stepper (seem now to go to dox?) + * add resize to all combinables [does this matter?] + * perhaps in do/let/dox try opt after frame? save that via new_s7_opt (for-loop of cell_optimize currently, would be a multistatement s7_opt --or begin?) + * tfft is cell/float case, tmap is bool, call/all float, gen for all + * all p/c args can be expanded + * other s7.h and related p_* funcs 87384 -- there's redundancy now (s7_list_ref vs list_ref_p_pi for example) [but error checks are different -- openlet] + * optimize_lambda -> optimize: try new_s7_opt? op_closure_opt, with is_recur=set slots and reset sc->pc. + * t834(fm100) is float_opt in do_let but opt time is insignificant, tfft has better example + * new optlists: expand safe closure in place, if tc, set env and jump back to expansion start + * + * glistener curlet|owlet->rootlet display (tree-view?) where each can expand via object->let + * or the same using the status area * - * ---------------------------------------------------------------------------------- - * 12 | 13 | 14 | 15 || 16 || 17 | 18.0 18.3 18.4 18.5 18.6 - * ---------------------------------------------------------------------------------- - * tmac | | | || 9052 || 264 | 264 280 279 279 - * tpeak | | | || 391 || 377 | 376 - * tref | | | 2372 || 2125 || 1036 | 1036 1037 1040 1028 - * index 44.3 | 3291 | 1725 | 1276 || 1255 || 1168 | 1165 1158 1131 1090 - * tauto 265 | 89 | 9 | 8.4 || 2993 || 1457 | 1475 1485 1456 1304 - * teq | | | 6612 || 2777 || 1931 | 1913 1888 1705 1693 - * s7test 1721 | 1358 | 995 | 1194 || 2926 || 2110 | 2129 2113 2051 1952 - * lint | | | || 4041 || 2702 | 2696 2573 2488 2351 - * tcopy | | | 13.6 || 3183 || 2974 | 2965 3069 2462 2377 - * tread | | | || || | 3009 2639 2398 - * tform | | | 6816 || 3714 || 2762 | 2751 2768 2664 2522 - * tlet 5318 | 3701 | 3712 | 3700 || 4006 || 2467 | 2467 2536 2556 2864 - * tfft | | 15.5 | 16.4 || 17.3 || 3966 | 3966 3987 3904 3207 - * tmap | | | 9.3 || 5279 || 3445 | 3445 3451 3453 3439 - * tsort | | | || 8584 || 4111 | 4111 4192 4151 4076 - * titer | | | || 5971 || 4646 | 4646 5236 4997 4784 - * thash | | | 50.7 || 8778 || 7697 | 7694 7824 6874 6389 - * tgen | 71 | 70.6 | 38.0 || 12.6 || 11.9 | 12.1 11.9 11.4 11.0 - * tall 90 | 43 | 14.5 | 12.7 || 17.9 || 18.8 | 18.9 18.9 18.2 17.9 - * calls 359 | 275 | 54 | 34.7 || 43.7 || 40.4 | 42.0 42.1 41.3 40.4 - * | | | || 139 || 85.9 | 86.5 87.1 81.4 80.1 - * lg | | | || 211 || 133 | 133.4 130.9 125.7 118.3 - * tbig | | | || || | (185.8) 178.2 - * ---------------------------------------------------------------------------------- + * ------------------------------------------------------------------------------------------ + * 12 | 13 | 14 | 15 || 16 || 17 | 18.0 18.3 18.4 18.5 18.6 18.7 + * ------------------------------------------------------------------------------------------ + * tpeak | | | || 391 || 377 | 376 280 + * tmac | | | || 9052 || 264 | 264 280 279 279 283 + * dup | | | || || 1030 | 609 435 + * tref | | | 2372 || 2125 || 1036 | 1036 1037 1040 1028 1057 + * index 44.3 | 3291 | 1725 | 1276 || 1255 || 1168 | 1165 1158 1131 1090 1088 + * tauto 265.0 | 89.0 | 9.0 | 8.4 || 2993 || 1457 | 1475 1485 1456 1304 1313 + * teq | | | 6612 || 2777 || 1931 | 1913 1888 1705 1693 1662 + * s7test 1721 | 1358 | 995 | 1194 || 2926 || 2110 | 2129 2113 2051 1952 1929 + * lint | | | || 4041 || 2702 | 2696 2573 2488 2351 2344 + * tread | | | || || | 3009 2639 2398 2357 + * tcopy | | | 13.6 || 3183 || 2974 | 2965 3069 2462 2377 2373 + * tform | | | 6816 || 3714 || 2762 | 2751 2768 2664 2522 2390 + * tlet 5318 | 3701 | 3712 | 3700 || 4006 || 2467 | 2467 2536 2556 2864 2774 + * tfft | | 15.5 | 16.4 || 17.3 || 3966 | 3966 3987 3904 3207 3113 + * tmap | | | 9.3 || 5279 || 3445 | 3445 3451 3453 3439 3288 + * titer | | | || 5971 || 4646 | 4646 5236 4997 4784 4047 + * tsort | | | || 8584 || 4111 | 4111 4192 4151 4076 4119 + * thash | | | 50.7 || 8778 || 7697 | 7694 7824 6874 6389 6342 + * tgen | 71.0 | 70.6 | 38.0 || 12.6 || 11.9 | 12.1 11.9 11.4 11.0 8.7 + * tall 90.0 | 43.0 | 14.5 | 12.7 || 17.9 || 18.8 | 18.9 18.9 18.2 17.9 17.5 + * calls 359.0 |275.0 | 54.0 | 34.7 || 43.7 || 40.4 | 42.0 42.1 41.3 40.4 39.9 + * sg | | | ||139.0 || 85.9 | 86.5 87.1 81.4 80.1 79.6 + * lg | | | ||211.0 ||133.0 |133.4 130.9 125.7 118.3 117.9 + * tbig | | | || || | 255.4 + * ------------------------------------------------------------------------------------------ */ @@ -1,8 +1,8 @@ #ifndef S7_H #define S7_H -#define S7_VERSION "7.0" -#define S7_DATE "25-Jun-18" +#define S7_VERSION "7.3" +#define S7_DATE "29-Jul-18" #include <stdint.h> /* for int64_t */ @@ -226,7 +226,7 @@ const char *s7_string(s7_pointer p); /* s7_pointer s7_make_string(s7_scheme *sc, const char *str); /* C string -> Scheme string (str is copied) */ s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len); /* same as s7_make_string, but provides strlen */ s7_pointer s7_make_string_wrapper(s7_scheme *sc, const char *str); -s7_pointer s7_make_permanent_string(const char *str); /* make a string that will never be GC'd */ +s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str); /* make a string that will never be GC'd */ s7_int s7_string_length(s7_pointer str); /* (string-length str) */ @@ -269,8 +269,7 @@ char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, s7_int radix); /* ( bool s7_is_vector(s7_pointer p); /* (vector? p) */ s7_int s7_vector_length(s7_pointer vec); /* (vector-length vec) */ s7_int s7_vector_rank(s7_pointer vect); /* number of dimensions in vect */ -s7_int *s7_vector_dimensions(s7_pointer vec); /* dimensions (don't free the pointer) */ -s7_int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing (don't free) */ +s7_int s7_vector_dimension(s7_pointer vec, s7_int dim); s7_pointer *s7_vector_elements(s7_pointer vec); /* a pointer to the array of s7_pointers */ s7_int *s7_int_vector_elements(s7_pointer vec); s7_double *s7_float_vector_elements(s7_pointer vec); @@ -281,6 +280,8 @@ s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index); s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a); /* (vector-set! vec index a) */ s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ...); /* multidimensional vector-ref */ s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s7_int indices, ...); /* multidimensional vector-set! */ +s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size); /* vector dimensions */ +s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size); s7_pointer s7_make_vector(s7_scheme *sc, s7_int len); /* (make-vector len) */ s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info); @@ -319,8 +320,8 @@ s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer func bool s7_is_input_port(s7_scheme *sc, s7_pointer p); /* (input-port? p) */ bool s7_is_output_port(s7_scheme *sc, s7_pointer p); /* (output-port? p) */ -const char *s7_port_filename(s7_pointer x); /* (port-filename p) */ -s7_int s7_port_line_number(s7_pointer p); /* (port-line-number p) */ +const char *s7_port_filename(s7_scheme *sc, s7_pointer x); /* (port-filename p) */ +s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p); /* (port-line-number p) */ s7_pointer s7_current_input_port(s7_scheme *sc); /* (current-input-port) */ s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer p); /* (set-current-input-port) */ @@ -366,9 +367,6 @@ bool s7_is_keyword(s7_pointer obj); /* ( s7_pointer s7_make_keyword(s7_scheme *sc, const char *key); /* (string->keyword key) */ s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key); /* (keyword->symbol key) */ -s7_pointer s7_symbol_setter(s7_scheme *sc, s7_pointer sym); -s7_pointer s7_symbol_set_setter(s7_scheme *sc, s7_pointer symbol, s7_pointer func); - s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol); s7_pointer s7_slot_value(s7_pointer slot); s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value); @@ -396,8 +394,6 @@ s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name); s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym); s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val); s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env); -char *s7_symbol_documentation(s7_scheme *sc, s7_pointer sym); -char *s7_symbol_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc); bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data); bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, s7_pointer value, void *data), void *data); @@ -454,6 +450,7 @@ const char *s7_help(s7_scheme *sc, s7_pointer obj); /* ( s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */ const char *s7_documentation(s7_scheme *sc, s7_pointer p); /* (documentation x) if any (don't free the string) */ +const char *s7_set_documentation(s7_scheme *sc, s7_pointer p, const char *new_doc); s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj); /* (setter obj) */ s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter); /* (set! (setter p) setter) */ s7_pointer s7_signature(s7_scheme *sc, s7_pointer func); /* (signature obj) */ @@ -577,7 +574,7 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size); s7_pointer s7_copy(s7_scheme *sc, s7_pointer args); /* (copy ...) */ s7_pointer s7_fill(s7_scheme *sc, s7_pointer args); /* (fill! ...) */ -s7_pointer s7_type_of(s7_pointer arg); /* (type-of arg) */ +s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg); /* (type-of arg) */ @@ -614,10 +611,6 @@ void s7_c_type_set_to_string(s7_scheme *sc, s7_int tag, s7_pointer (*to_string)( * For the copy function, either the first or second argument can be a c-object of the given type. */ -#if (!DISABLE_DEPRECATED) - void s7_c_type_set_print (s7_scheme *sc, s7_int tag, char *(*print)(s7_scheme *sc, void *value)); -#endif - /* These functions create a new Scheme object type. There is a simple example in s7.html. * * s7_make_c_type creates a new C-based type for Scheme: @@ -636,7 +629,7 @@ void s7_c_type_set_to_string(s7_scheme *sc, s7_int tag, s7_pointer (*to_string)( * reverse: similarly... * to_string: object->string for an object of this type * - * s7_is_c_object returns true if 'p' holds a value of a type created by s7_new_type. + * s7_is_c_object returns true if 'p' is a c_object * s7_c_object_type returns the c_object's type * s7_c_object_value returns the value bound to that c_object (the void *value of s7_make_c_object) * s7_make_c_object creates a new Scheme entity of the given type with the given (uninterpreted) value @@ -710,9 +703,9 @@ typedef s7_double (*s7_d_pd_t)(s7_pointer v, s7_double x); void s7_set_d_pd_function(s7_pointer f, s7_d_pd_t df); s7_d_pd_t s7_d_pd_function(s7_pointer f); -typedef s7_double (*s7_d_pid_t)(s7_pointer v, s7_int i, s7_double d); -void s7_set_d_pid_function(s7_pointer f, s7_d_pid_t df); -s7_d_pid_t s7_d_pid_function(s7_pointer f); +typedef s7_double (*s7_d_7pid_t)(s7_scheme *sc, s7_pointer v, s7_int i, s7_double d); +void s7_set_d_7pid_function(s7_pointer f, s7_d_7pid_t df); +s7_d_7pid_t s7_d_7pid_function(s7_pointer f); typedef s7_double (*s7_d_id_t)(s7_int i, s7_double d); void s7_set_d_id_function(s7_pointer f, s7_d_id_t df); @@ -722,9 +715,9 @@ typedef s7_int (*s7_i_i_t)(s7_int x); void s7_set_i_i_function(s7_pointer f, s7_i_i_t df); s7_i_i_t s7_i_i_function(s7_pointer f); -typedef s7_int (*s7_i_d_t)(s7_double x); -void s7_set_i_d_function(s7_pointer f, s7_i_d_t df); -s7_i_d_t s7_i_d_function(s7_pointer f); +typedef s7_int (*s7_i_7d_t)(s7_scheme *sc, s7_double x); +void s7_set_i_7d_function(s7_pointer f, s7_i_7d_t df); +s7_i_7d_t s7_i_7d_function(s7_pointer f); typedef s7_int (*s7_i_ii_t)(s7_int i1, s7_int i2); void s7_set_i_ii_function(s7_pointer f, s7_i_ii_t df); @@ -734,17 +727,17 @@ typedef s7_double (*s7_d_ip_t)(s7_int i, s7_pointer p); void s7_set_d_ip_function(s7_pointer f, s7_d_ip_t df); s7_d_ip_t s7_d_ip_function(s7_pointer f); -typedef s7_int (*s7_i_p_t)(s7_pointer p); -void s7_set_i_p_function(s7_pointer f, s7_i_p_t df); -s7_i_p_t s7_i_p_function(s7_pointer f); +typedef s7_int (*s7_i_7p_t)(s7_scheme *sc, s7_pointer p); +void s7_set_i_7p_function(s7_pointer f, s7_i_7p_t df); +s7_i_7p_t s7_i_7p_function(s7_pointer f); typedef bool (*s7_b_p_t)(s7_pointer p); void s7_set_b_p_function(s7_pointer f, s7_b_p_t df); s7_b_p_t s7_b_p_function(s7_pointer f); -typedef s7_double (*s7_d_pi_t)(s7_pointer v, s7_int i); -void s7_set_d_pi_function(s7_pointer f, s7_d_pi_t df); -s7_d_pi_t s7_d_pi_function(s7_pointer f); +typedef s7_double (*s7_d_7pi_t)(s7_scheme *sc, s7_pointer v, s7_int i); +void s7_set_d_7pi_function(s7_pointer f, s7_d_7pi_t df); +s7_d_7pi_t s7_d_7pi_function(s7_pointer f); /* Here is an example of using these functions; more extensive examples are in clm2xen.c in sndlib, and in s7.c. * (This example comes from a HackerNews discussion): @@ -830,69 +823,47 @@ s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args, /* -------------------------------------------------------------------------------- */ -#if DISABLE_DEPRECATED +#if (!DISABLE_DEPRECATED) #define s7_is_ulong(arg) s7_is_integer(arg) #define s7_ulong(p) (uint64_t)s7_integer(p) #define s7_make_ulong(sc, n) s7_make_integer(sc, (s7_int)n) - #define s7_is_ulong_long(arg) s7_is_c_pointer((void *)arg) #define s7_ulong_long(p) (uint64_t)s7_c_pointer(arg) #define s7_make_ulong_long(sc, n) s7_make_c_pointer(sc, (void *)n) +#define s7_is_constant(Obj) ((!s7_is_symbol(Obj)) || (s7_is_immutable(Obj))) -#else -bool s7_is_ulong(s7_pointer arg); -unsigned long s7_ulong(s7_pointer p); -s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n); -bool s7_is_ulong_long(s7_pointer arg); -uint64_t s7_ulong_long(s7_pointer p); -s7_pointer s7_make_ulong_long(s7_scheme *sc, uint64_t n); - -/* old forms... */ typedef s7_int s7_Int; typedef s7_double s7_Double; -/* cm uses this: */ +#define s7_define_function_with_setter(sc, name, get_fnc, set_fnc, req_args, opt_args, doc) \ + s7_dilambda(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc) + +#define s7_is_procedure_with_setter s7_is_dilambda +#define s7_make_procedure_with_setter s7_dilambda +#define s7_make_random_state s7_random_state +#define s7_is_object s7_is_c_object +#define s7_object_type s7_c_object_type +#define s7_object_value s7_c_object_value +#define s7_object_value_checked s7_c_object_value_checked +#define s7_make_object s7_make_c_object +#define s7_make_object_with_let s7_make_c_object_with_let +#define s7_mark_object s7_mark +#define s7_mark_c_object s7_mark +#define s7_object_let s7_c_object_let +#define s7_object_set_let s7_c_object_set_let +#define s7_set_object_print_readably s7_c_type_set_print_readably +#define s7_procedure_setter s7_setter +#define s7_procedure_documentation s7_documentation +#define s7_procedure_signature s7_signature +#define s7_symbol_documentation s7_documentation +#define s7_symbol_set_documentation s7_set_documentation +#define s7_symbol_setter s7_setter +#define s7_symbol_set_setter s7_set_setter + +/* CM uses these */ #define s7_UNSPECIFIED(Sc) s7_unspecified(Sc) #define s7_NIL(Sc) s7_nil(Sc) -#define s7_is_procedure_with_setter s7_is_dilambda -#define s7_make_procedure_with_setter s7_dilambda - -#define s7_define_integer_function s7_define_safe_function -#define s7_make_random_state s7_random_state -#define s7_eval_form s7_eval - -#define s7_is_constant(Obj) ((!s7_is_symbol(Obj)) || (s7_is_immutable(Obj))) - -s7_int s7_new_type(const char *name, - char *(*print)(s7_scheme *sc, void *value), - void (*free)(void *value), - bool (*equal)(void *val1, void *val2), - void (*mark)(void *val), - s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args), /* these two args are ignored */ - s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args)); - -#define s7_is_object s7_is_c_object -#define s7_object_type s7_c_object_type -#define s7_object_value s7_c_object_value -#define s7_object_value_checked s7_c_object_value_checked -#define s7_make_object s7_make_c_object -#define s7_make_object_with_let s7_make_c_object_with_let -#define s7_mark_object s7_mark -#define s7_mark_c_object s7_mark -#define s7_object_let s7_c_object_let -#define s7_object_set_let s7_c_object_set_let -#define s7_set_object_print_readably s7_c_type_set_print_readably - -#define s7_symbol_access s7_symbol_setter -#define s7_symbol_set_access s7_symbol_set_setter - -void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, - s7_function set_fnc, s7_int req_args, s7_int opt_args, const char *doc); - /* this is now the same as s7_dilambda (different args) */ - -#define s7_procedure_setter s7_setter -#define s7_procedure_documentation s7_documentation -#define s7_procedure_signature s7_signature +#define s7_new_type(Name, Print, GC_Free, Equal, Mark, Ref, Set) s7_new_type_1(s7, Name, Print, GC_Free, Equal, Mark, Ref, Set) #endif @@ -900,6 +871,10 @@ void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function * * s7 changes * + * 29-Jul: symbol-setter deprecated (use setter). s7_symbol_documentation (and setter) folded into s7_documentation. + * 12-Jul: changed s7_vector_dimensions|offsets. + * Added s7_scheme* arg to make_permanent_string and several of the optimizer functions. + * 3-Jul: changed make-shared-vector to subvector. * 20-May: s7_keyword_to_symbol. * 6-May: s7_mark_c_object -> s7_mark. * 26-Apr: s7_c_type_set_to_list|string, s7_c_type_set_apply -> s7_c_type_set_ref, removed s7_c_type_set_set|apply_direct @@ -1124,7 +1099,6 @@ void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function * 27-Aug: vector and hash-table sizes are now s7_ints, rather than ints. * 20-Aug: s7_remove_from_heap. * 17-Aug: *error-info*. - * 14-Aug: define-expansion. * 7-Aug: s7_define_function_with_setter. * s7_quit and example of signal handling. * 6-Aug: encapsulation. s7_define_set_function. s7_new_type_x. @@ -220,7 +220,7 @@ indented and on a sort of brownish background. <li><a href="#IO">IO and other OS functions</a> <li><a href="#errors">errors</a> <li><a href="#autoload">autoload</a> - <li><a href="#constants">define-constant, symbol-setter</a> + <li><a href="#constants">define-constant</a> <li><a href="#miscellanea">marvels and curiousities:</a> <ul> @@ -245,7 +245,6 @@ indented and on a sort of brownish background. <li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a> <li><a href="#definegeneric">define a generic function in C</a> <li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a> - <li><a href="#vector">direct multidimensional vector element access</a> <li><a href="#notify">notification in C that a Scheme variable has been set!</a> <li><a href="#namespace">Load C defined stuff into a separate namespace</a> <li><a href="#Cerrors">Error handling in C</a> @@ -1989,7 +1988,7 @@ vector-dimensions returns a list of the dimensions. <pre class="indented"> (define (make-array dims . inits) - (make-shared-vector (apply vector (flatten inits)) dims)) + (subvector (apply vector (flatten inits)) dims)) > (make-array '(3 3) '(1 1 1) '(2 2 2) '(3 3 3)) <em class="gray">#2d((1 1 1) (2 2 2) (3 3 3))</em> @@ -2017,25 +2016,36 @@ s7_ints or s7_doubles: (<em class=def id="makebytevector">make-byte-vector</em> len (init 0)) (<em class=def id="bytevectorref">byte-vector-ref</em> vect index) (<em class=def id="bytevectorset">byte-vector-set!</em> vect index byte) -(<em class=def id="stringtobytevector">string->byte-vector</em> str) -(<em class=def id="bytevectortostring">byte-vector->string</em> str) +(<em class=def id="stringtobytevector">string->byte-vector</em> str) ; in-place +(<em class=def id="bytevectortostring">byte-vector->string</em> str) ; in-place + +(<em class=def id="subvector">subvector</em> vector dimensions position) ; does not apply to byte-vectors yet +(<em class=def id="subvectorp">subvector?</em> obj) +(<em class=def id="subvectorvector">subvector-vector</em> obj) +(<em class=def id="subvectorposition">subvector-position</em> obj) </pre> <p>To access a vector's elements with different dimensions than the original had, use -<code>(make-shared-vector original-vector new-dimensions (offset 0))</code>: +<code>(subvector original-vector new-dimensions (position 0))</code>: </p> <pre class="indented"> > (let ((v1 #2d((1 2 3) (4 5 6)))) - (let ((v2 (make-shared-vector v1 '(6)))) ; flatten the original + (let ((v2 (subvector v1 '(6)))) ; flatten the original v2)) <em class="gray">#(1 2 3 4 5 6)</em> > (let ((v1 #(1 2 3 4 5 6))) - (let ((v2 (make-shared-vector v1 '(3 2)))) + (let ((v2 (subvector v1 '(3 2)))) v2)) <em class="gray">#2d((1 2) (3 4) (5 6))</em> </pre> +<p>A subvector is a window onto some other vector's data. The data is not copied, just accessed differently. +The <code>new-dimensions</code> parameter can be either an integer or a list. In the integer case, it sets +the length of the subvector, otherwise the dimensions of the subvector. <code>subvector-vector</code> returns +the underlying vector, and <code>subvector-position</code> returns the starting point of the subvector +in the underlying data. +</p> <blockquote> <div class="indented"> @@ -2242,18 +2252,18 @@ This also affects format and sort!: <em class="gray">#2d((4 3) (2 1))</em> </pre> -<p>Perhaps make-shared-vector can help: +<p>Perhaps subvector can help: </p> <pre class="indented"> ->(make-shared-vector (list->vector '(1 2 3 4)) '(2 2)) +>(subvector (list->vector '(1 2 3 4)) '(2 2)) <em class="gray">#2d((1 2) (3 4))</em> > (let ((a #2d((1 2) (3 4))) (b #2d((5 6) (7 8)))) - (list (make-shared-vector (append a b) '(2 4)) - (make-shared-vector (append a b) '(4 2)) - (make-shared-vector (append (a 0) (b 0) (a 1) (b 1)) '(2 4)) - (make-shared-vector (append (a 0) (b 0) (a 1) (b 1)) '(4 2)))) + (list (subvector (append a b) '(2 4)) + (subvector (append a b) '(4 2)) + (subvector (append (a 0) (b 0) (a 1) (b 1)) '(2 4)) + (subvector (append (a 0) (b 0) (a 1) (b 1)) '(4 2)))) <em class="gray">(#2d((1 2 3 4) (5 6 7 8)) #2d((1 2) (3 4) (5 6) (7 8)) #2d((1 2 5 6) (3 4 7 8)) @@ -2290,12 +2300,17 @@ as: <p>Add optional and rest arguments, and you can't tell who is supposed to take which arguments. Currently, you can mix types with implicit indices, -but a function grabs all remaining indices. Trickier than I expected! +but a function grabs all remaining indices. +To insist that all objects are of the same type, use an explicit getter: </p> <pre class="indented"> -> (vector-ref (vector abs log) 0 -1) -<em class="gray">1</em> ; hmm... +> (list-ref (list 1 (list 2 3)) 1 0) ; same as ((list 1 (list 2 3)) 1 0) +<em class="gray">2</em> +> ((list 1 (vector 2 3)) 1 0) +<em class="gray">2</em> +> (list-ref (list 1 (vector 2 3)) 1 0) +<em class="red">error</em><em class="gray">: list-ref argument 1, #(2 3), is a vector but should be a proper list</em> </pre> </div> @@ -2303,17 +2318,16 @@ but a function grabs all remaining indices. Trickier than I expected! - - - <div class="header" id="hashtables"><h4>hash-tables</h4></div> <ul> <li>(<em class=def id="makehashtable">make-hash-table</em> (size 8) eq-func) +<li>(<em class=def id="makeweakhashtable">make-weak-hash-table</em> (size 8) eq-func) <li>(<em class=def id="hashtable">hash-table</em> ...) <li>(<em class=def id="hashtablestar">hash-table*</em> ...) <li>(<em class=def id="hashtablep">hash-table?</em> obj) +<li>(<em class=def id="weakhashtablep">weak-hash-table?</em> obj) <li>(<em class=def id="hashtableref">hash-table-ref</em> ht key) <li>(<em class=def id="hashtableset">hash-table-set!</em> ht key value) <li>(<em class=def id="hashtableentries">hash-table-entries</em> ht) @@ -4980,7 +4994,7 @@ via <code>(varlet (curlet) *libgsl*)</code>. </p> -<div class="header" id="constants"><h4>define-constant and symbol-setter</h4></div> +<div class="header" id="constants"><h4>define-constant</h4></div> <p><b><em class=def id="defineconstant">define-constant</em></b> defines a symbol whose value is always the same (within the current lexical scope), <b><em class=def id="constantp">constant?</em></b> returns #t if its argument is a constant, @@ -5044,10 +5058,10 @@ variable trace (informative function upon set or keeping a history of past value variable's values or doing automatic conversions upon set), and notification upon set (either in Scheme or in C; I wanted this many years ago in Snd). The notification function is especially useful if you have a Scheme variable and want to reflect any change in its value immediately in C (see <a href="#notify">below</a>). -In s7, <em class=def id="symbolsetter">symbol-setter</em> sets this function. +In s7, setter sets this function. </p> -<p>Each environment is a set of symbols and their associated values. symbol-setter places a function (or macro) between a symbol +<p>Each environment is a set of symbols and their associated values. setter places a function (or macro) between a symbol and its value in a given environment. The setter function takes two arguments, the symbol and the new value, and returns the value that is actually set. If the setter function accepts a third argument, the current (symbol-relative) environment is also passed (the weird argument order is an historical artifact). @@ -5059,9 +5073,9 @@ is also passed (the weird argument order is an historical artifact). (y 3) ; will always keep its initial value (z 3)) ; will report set! - (set! (symbol-setter 'x) (lambda (s v) (if (integer? v) v x))) - (set! (symbol-setter 'y) (lambda (s v) y)) - (set! (symbol-setter 'z) (lambda (s v) (format *stderr* "z ~A -> ~A~%" z v) v)) + (set! (setter 'x) (lambda (s v) (if (integer? v) v x))) + (set! (setter 'y) (lambda (s v) y)) + (set! (setter 'z) (lambda (s v) (format *stderr* "z ~A -> ~A~%" z v) v)) (set! x 3.3) ; x does not change because 3.3 is not an integer (set! y 3.3) ; y does not change @@ -5077,7 +5091,7 @@ is also passed (the weird argument order is an historical artifact). > (define-macro (reflective-let vars . body) `(let ,vars ,@(map (lambda (vr) - `(set! (symbol-setter ',(car vr)) + `(set! (setter ',(car vr)) (lambda (s v) (format *stderr* "~S -> ~S~%" s v) v))) @@ -5087,7 +5101,7 @@ is also passed (the weird argument order is an historical artifact). > (reflective-let ((a 1)) (set! a 2)) <em class="gray">2</em> ; prints "a -> 2" >(let ((a 0)) - (set! (symbol-setter 'a) + (set! (setter 'a) (let ((history (make-vector 3 0)) (position 0)) (lambda (s v) @@ -5097,13 +5111,13 @@ is also passed (the weird argument order is an historical artifact). v))) (set! a 1) (set! a 2) - ((funclet (symbol-setter 'a)) 'history)) + ((funclet (setter 'a)) 'history)) <em class="gray">#(1 2 0)</em> </pre> <p>See also typed-let in stuff.scm. -define-constant is more restrictive than a symbol-setter that raises an error: the latter -does not block nested (possibly non-constant) bindings of the symbol. The symbol-setters +define-constant is more restrictive than a setter that raises an error: the latter +does not block nested (possibly non-constant) bindings of the symbol. The setters are kind of ugly. Here's a macro that lets you put the let variable's setter after the initial value: </p> @@ -5120,14 +5134,14 @@ the initial value: ,@(map (lambda (binding) (list (car binding) (cadr binding))) vars)) - ,@(do ((setter setters (cdr setter)) + ,@(do ((s setters (cdr s)) (var vars (cdr var)) (i 0 (+ i 1)) (result ())) - ((null? setter) + ((null? s) (reverse result)) - (if (car setter) - (set! result (cons `(set! (symbol-setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result)))) + (if (car s) + (set! result (cons `(set! (setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result)))) ,@body))) (let ((a 3)) @@ -5139,126 +5153,6 @@ the initial value: (display (list a b)) (newline))) </pre> -<p>Reactive programming: -</p> -<pre class="indented"> -(let ((a 1) - (b 2) - (c 3)) - (set! (symbol-setter 'b) (lambda (s v) (set! a (+ v c)) v)) - (set! (symbol-setter 'c) (lambda (s v) (set! a (+ b v)) v)) - (set! a (+ b c)) ; a will be updated if b or c is set - (set! b 4) - (set! c 5) - a) ; a is 9 = (+ 4 5) -</pre> - -<details> -<summary class="indented">reactive-let</summary> -<div class="indented"> - -<p>stuff.scm has reactive-set!, reactive-vector, reactive-let, reactive-let*, and reactive-lambda*: -</p> -<pre class="indented"> -> (let ((-a- 1) - (b 2)) - (<em class=red>reactive-set!</em> -a- (* b 2)) - (set! b 3) - -a-) -<em class="gray">6</em> -> (let ((a 1)) - (let ((v (<em class=red>reactive-vector</em> a (+ a 1) 2))) - (set! a 4) - v)) -<em class="gray">#(4 5 2)</em> -> (let ((a 1)) - (<em class=red>reactive-let</em> ((-b- (+ a 1))) ; if 'a changes, '-b- does too - (set! a 3) ; so '-b- is now 4 - -b-)) -<em class="gray">4</em> -> (let ((a 1)) - (<em class=red>reactive-lambda*</em> (s v) - (format *stderr* "~S -> ~S~%" s v)) - (set! a 3)) -<em class="gray">"a -> 3"</em> -</pre> - -<p>In the reactive-let example, the macro notices that '-b- depends on 'a, so it sets up a symbol-setter on 'a -so that <code>(set! a 3)</code> triggers <code>(set! -b- (+ a 1))</code>. I'm using -name- to distinguish -the variables that can change value at any time; in the Lisp community, +name+ is often used to mark a constant, -so this seems like a natural convention. -</p> - -<p>Here's the standard example of following the mouse (assuming you're using Snd and glistener): -</p> -<pre class="indented"> -(let ((*mouse-x* 0) (*mouse-y* 0) - (x 0) (y 0)) - - (reactive-set! x (let ((val (round *mouse-x*))) - (format *stderr* "mouse: ~A ~A~%" x y) - val)) - (reactive-set! y (round *mouse-y*)) - - (g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event" - (lambda (w e d) - (let ((mxy (cdr (gdk_event_get_coords (GDK_EVENT e))))) - (set! *mouse-x* (car mxy)) - (set! *mouse-y* (cadr mxy)))))) -</pre> - -<!-- -(let ((*mouse-x* 0) (*mouse-y* 0)) - - (g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event" - (lambda (w e d) - (let ((mxy (gdk_event_get_coords (GDK_EVENT e)))) - (set! *mouse-x* (cadr mxy)) - (set! *mouse-y* (caddr mxy))))) - - (with-accessors (*mouse-x* *mouse-y*) - (let ((x 0) (y 0)) - (reactive-set! x (let ((val (round *mouse-x*))) - (format *stderr* "mouse: ~A ~A~%" x y) - val)) - (reactive-set! y (round *mouse-y*)) - (gtk_main)))) ---> - -<p>reactive-lambda* is aimed at library consistency. Say we have the following library -that wants A to always be half B: -</p> - -<pre class="indented"> -(define (make-library) - (let ((A 1.0) - (B 2.0)) - (reactive-lambda* (s v) - (case s - ((A) (set! B (* 2 v))) - ((B) (set! A (/ v 2))))) - (define (f1 x) - (+ A (* B x))) - (curlet))) - -(with-let (make-library) - (format *stderr* "(f1 3): ~A~%" (f1 3)) - (set! A 3.0) - (format *stderr* "A: ~A, B: ~A, (f1 3): ~A~%" A B (f1 3)) - (set! B 4.0) - (format *stderr* "A: ~A, B: ~A, (f1 3): ~A~%" A B (f1 3))) -</pre> - -<p>reactive-lambda* sets up accessors on the library's top-level variables -that call the lambda body if one of the variables is set. -</p> - -<p>None of these macros does the right thing yet; I'm sort of following my nose. -</p> - -</div> -</details> - <div class="header" id="miscellanea"><h4>marvels and curiousities</h4></div> @@ -6027,7 +5921,10 @@ The defaults are '(3 45 80 45 #t). <pre class="indented"> (<em class=def id="cobject">c-object?</em> obj) (<em class=def id="cpointer">c-pointer?</em> obj) -(<em class=def id="cpoint">c-pointer</em> int type info) +(<em class=def id="cpoint">c-pointer</em> int type info weak1 weak2) +(<em class=def id="cpointtype">c-pointer-type</em> obj) +(<em class=def id="cpointinfo">c-pointer-info</em> obj) +(<em class=def id="cpointweak1">c-pointer-weak1</em> obj) ; also weak2 (<em class=def id="cpointertolist">c-pointer->list</em> obj) </pre> @@ -6035,6 +5932,9 @@ The defaults are '(3 45 80 45 #t). c-object? returns the object's type tag (otherwise #f of course). This tag is also the position of the object's type in the (*s7* 'c-types) list. (*s7* 'c-types) returns a list of the types created by s7_make_c_type. +The "weak1" and "weak2" fields are intended for custom "weak" references. The weak +fields values are not marked during the GC sweep, much like a key in a weak-hash-table. +If either value is GC'd, that field is set to #f by the GC. </p> <p> You can wrap up raw C pointers and @@ -6075,6 +5975,69 @@ the generic functions mechanism, much like a c-object: <div class="separator"></div> +<p>s7 originally had Scheme-level multithreading support, but I removed it in August, 2011. +It turned out to be less useful than I hoped, +mainly because s7 threads shared the heap and therefore had to coordinate +all cell allocations. It was faster and simpler to use multiple +processes each running a separate s7 interpreter, rather than one s7 +running multiple s7 threads. In CLM, there was also contention for access +to the output stream. In GUI-related situations, +threads were not useful mainly because the GUI toolkits are not thread safe. +Last but not least, the effort to make the non-threaded +s7 faster messed up parts of the threaded version. Rather than +waste a lot of time fixing this, I chose to flush multithreading. +s7 is thread-safe: +</p> + +<blockquote> +<div class="indented"> +<pre> +#include <stdio.h> +#include <stdlib.h> +#include <pthread.h> +#include "s7.h" + +#define NUM_THREADS 16 +static pthread_t threads[NUM_THREADS]; +static pthread_mutex_t lock = PTHREAD_MUTEX_INITIALIZER; + +static void *run_thread(void *obj) +{ + s7_scheme *sc = (s7_scheme *)obj; + const char *str; + str = s7_object_to_c_string(sc, s7_make_integer(sc, 123)); + s7_eval_c_string(sc, "(let () \ + (define (f) \ + (do ((i 0 (+ i 1))) ((= i 10)) \ + (do ((k 0 (+ k 1))) ((= k 1000000))) \ + (format *stderr* \"~D \" i))) \ + (f))"); + pthread_mutex_lock(&lock); + fprintf(stderr, "%s\n", str); + pthread_mutex_unlock(&lock); +} + +int main(int argc, char **argv) +{ + int32_t i; + for (i = 0; i < NUM_THREADS; i++) + pthread_create(&threads[i], NULL, run_thread, (void *)s7_init()); + for (i = 0; i < NUM_THREADS; i++) + pthread_join(threads[i], NULL); + exit(0); +} + +/* linux: gcc -o threads threads.c s7.o -Wl,-export-dynamic -pthread -lm -I. -ldl + * mac: clang -o threads threads.c s7.o -pthread -lm -I. -ldl + */ +</pre> +</div> +</blockquote> + + + +<div class="separator"></div> + <blockquote> <div class="indented"> @@ -6091,7 +6054,7 @@ the generic functions mechanism, much like a c-object: <li>for-each and map accept different length arguments; the operation stops when any argument reaches its end. <li>for-each and map accept any applicable object as the first argument, and any sequence or iterator as a trailing argument. <li>letrec*, but without conviction. -<li>set! and *-set! return the new value (modulo symbol-setter), not #<unspecified>. +<li>set! and *-set! return the new value (modulo setter), not #<unspecified>. <li>define and its friends return the new value. <li>port-closed? <li>list? means "pair or null", proper-list? is r5rs list?, float? means "real and not rational", sequence? = length. @@ -6304,7 +6267,7 @@ to keep it from being evaluated, but <p>These examples bring up another odd corner of scheme: else. In <code>(cond (else 1))</code> the 'else is evaluated (like any cond test), so its value might be #f; in <code>(case 0 (else 1))</code> it is not evaluated (like any case key), so it's just a symbol. -Since symbol setters are local in s7, +Since setters are local in s7, someone can <code>(let ((else #f)) (cond (else 1)))</code> even if we protect the rootlet 'else. Of course, in scheme this kind of trouble is pervasive, so rather than make 'else a constant I think the best path is to use unlet: @@ -6347,17 +6310,6 @@ it is GC'd. Here is an example: few times. You can turn off the optimization in question by setting the variable <code>(*s7* 'safety)</code> to 3. <code>(*s7* 'safety)</code> defaults to 0. </p> - -<p>A similar problem arises when you want to walk a function's source or reuse a piece of -code directly. When the function is evaluated, the optimizer changes the program source -to speed up subsequent evaluation. This annotation process means that nothing in that -source is what it appears to be, so a tree walker will be confused, and if you copy that -source and try to insert it into some other program source, the existing annotations -will not fit the new context. In both cases, you can get a clean version of the code -by copying it with :readable as the second argument to copy. There is an example -in lint.scm, and in the snd file tools/tgen.scm. -</p> - </div> </details> @@ -6659,7 +6611,7 @@ These symbols are not just an optimization of string comparison: (do ((i 0 (+ i 1))) ((= i 10) (reverse L)) (set! L (cons ,form L)))))) - (define function (apply lambda () (list (copy body :readable)))) + (define function (apply lambda () (list (copy body)))) (function))) (let () @@ -6849,26 +6801,6 @@ r7rs are handled in s7 via generic functions, records are classes, and so on. </div> - -<details> -<summary class="indented">threads</summary> -<div class="indented"> - -<p>s7 originally had multithreading support, but I removed it in August, 2011. -It turned out to be less useful than I hoped, -mainly because s7 threads shared the heap and therefore had to coordinate -all cell allocations. It was faster and simpler to use multiple -processes each running a separate s7 interpreter, rather than one s7 -running multiple s7 threads. In CLM, there was also contention for access -to the output stream. In GUI-related situations, -threads were not useful mainly because the GUI toolkits are not thread safe. -Last but not least, the effort to make the non-threaded -s7 faster messed up parts of the threaded version. Rather than -waste a lot of time fixing this, I chose to flush multithreading. -</p> -</div> -</details> - <div class="indented"> <p>"Life", a poem. @@ -6932,7 +6864,6 @@ The examples that follow show: <li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a> <li><a href="#definegeneric">define a generic function in C</a> <li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a> -<li><a href="#vector">direct multidimensional vector element access</a> <li><a href="#notify">notification in C that a Scheme variable has been set!</a> <li><a href="#namespace">Load C defined stuff into a separate namespace</a> <li><a href="#Cerrors">Error handling in C</a> @@ -8228,100 +8159,6 @@ int main(int argc, char **argv) - - -<div class="header" id="vector"><h4>Multidimensional vector element access</h4></div> - - -<div class="indented"> -<pre> -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <stdarg.h> - -#include "s7.h" - -static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, ...) -{ - /* multivector_ref returns an element of a multidimensional vector */ - int ndims; - ndims = <em class=red>s7_vector_rank</em>(vector); - - if (ndims == indices) - { - va_list ap; - s7_int index = 0; - va_start(ap, indices); - - if (ndims == 1) - { - index = va_arg(ap, s7_int); - va_end(ap); - return(s7_vector_ref(sc, vector, index)); - } - else - { - int i; - s7_pointer *elements; - s7_int *offsets, *dimensions; - - elements = <em class=red>s7_vector_elements</em>(vector); - dimensions = <em class=red>s7_vector_dimensions</em>(vector); - offsets = <em class=red>s7_vector_offsets</em>(vector); - - for (i = 0; i < indices; i++) - { - int ind; - ind = va_arg(ap, int); - if ((ind < 0) || - (ind >= dimensions[i])) - { - va_end(ap); - return(s7_out_of_range_error(sc, - "multivector_ref", i, - s7_make_integer(sc, ind), - "index should be between 0 and the dimension size")); - } - index += (ind * offsets[i]); - } - va_end(ap); - return(elements[index]); - } - } - return(s7_wrong_number_of_args_error(sc, - "multivector_ref: wrong number of indices: ~A", - s7_make_integer(sc, indices))); -} - -int main(int argc, char **argv) -{ - char buffer[512]; - char response[1024]; - s7_scheme *s7; - - s7 = s7_init(); - s7_eval_c_string(s7, "(define vect (make-vector '(2 3 4) 0))"); - s7_eval_c_string(s7, "(set! (vect 1 1 1) 32)"); - - fprintf(stdout, "vect[0,0,0]: %s, vect[1,1,1]: %s\n", - s7_object_to_c_string(s7, <em class=red>multivector_ref</em>(s7, s7_name_to_value(s7, "vect"), 3, 0, 0, 0)), - s7_object_to_c_string(s7, <em class=red>multivector_ref</em>(s7, s7_name_to_value(s7, "vect"), 3, 1, 1, 1))); -} - -/* vect[0,0,0]: 0, vect[1,1,1]: 32 - */ -</pre> -</div> - -<p>Much later... I decided to add s7_vector_ref_n and s7_vector_set_n to s7. -</p> - - - - - - <div class="header" id="notify"><h4>Notification from Scheme that a given Scheme variable has been set</h4></div> @@ -9266,6 +9103,7 @@ mockery.scm has mock data libraries, cload.scm is a wrapper for the FFI stuff described above, and stuff.scm is just some arbitrary stuff. gdbinit has some gdb commands for s7. +reactive.scm implements some reactive programming macros (set!, let). repl.scm is a repl. profile.scm provides access to profiling data, if it's enabled. </p> @@ -30,6 +30,7 @@ (if (not (defined? 's7test-exits)) (define s7test-exits #t)) (define asan-flags "") ;" -fsanitize=address -fsanitize=bounds ") + ;;; ---------------- pure-s7 ---------------- (define pure-s7 (provided? 'pure-s7)) (when pure-s7 @@ -101,7 +102,7 @@ (let ((stop (or end (length vect)))) (if (= start stop) () - (map values (make-shared-vector vect (list (- stop start)) start)))) + (map values (subvector vect (list (- stop start)) start)))) (map values vect)) (error 'wrong-type-arg "vector->list argument should be a vector: ~A" vect))) @@ -473,7 +474,7 @@ (recompose-1 n)) -(if (symbol-setter 'val) (set! (symbol-setter 'val) #f)) ; might get here from snd-test +(if (setter 'val) (set! (setter 'val) #f)) ; might get here from snd-test (define _ht_ (make-hash-table)) (define _undef_ (car (with-input-from-string "(#_asdf 1 2)" read))) @@ -1227,6 +1228,7 @@ void block_init(s7_scheme *sc) s7_define_safe_function(sc, \"block-reverse!\", g_block_reverse_in_place, 1, 0, false, g_block_reverse_in_place_help); s7_define_safe_function(sc, \"block?\", g_is_block, 1, 0, false, g_is_block_help); s7_define_safe_function_star(sc, \"blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\"); + s7_define_function_star(sc, \"unsafe-blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\"); s7_define_safe_function(sc, \"blocks-are-morally-equal\", g_blocks_are_morally_equal, 2, 0, false, g_blocks_are_morally_equal_help); g_block_methods = s7_eval_c_string(sc, \"(openlet (immutable! (inlet 'float-vector? (lambda (p) #t) \ 'vector-dimensions (lambda (p) (list (length p))) \ @@ -1649,9 +1651,15 @@ void block_init(s7_scheme *sc) (test (reverse b 1) 'error) (test (reverse! b) (block 3 2 1)) (test (reverse! b 1) 'error) - (test b (block 3 2 1))) + (test b (block 3 2 1)) + (test (b 'a) #<undefined>) ; hmmm -- it's thinking of methods + (test ((block) 'a) #<undefined>)) + (test (blocks) (list 4 1)) (test (blocks :frequency 2) (list 2 1)) + (let ((freq :frequency)) (test (blocks freq 2) (list 2 1))) + (let ((freq :scaler)) (test (blocks freq 2) (list 4 2))) + (let ((c #f)) (test (blocks (if c 100 :frequency) 10) (list 10 1))) (test (blocks :scaler 3 :frequency 2) (list 2 3)) (test (blocks :scaler 3 :phase 1) 'error) (test (map blocks '(1 2 3)) '((1 1) (2 1) (3 1))) @@ -1659,8 +1667,22 @@ void block_init(s7_scheme *sc) (test (documentation blocks) "test for function*") (test (apply blocks '(:frequency 5 :scaler 4)) '(5 4)) (test (let () (define (b1) (blocks 100)) (b1)) '(100 1)) + (test (let () (define (b1) (blocks 10 2)) (b1)) '(10 2)) (test (procedure? blocks) #t) - (test (s7-optimize '((block-append (make-block 2) (block)))) (block 0 0)) ; segfault due to plist overuse + (unless with-bignums (test (s7-optimize '((block-append (make-block 2) (block)))) (block 0 0))) ; segfault due to plist overuse + + (test (unsafe-blocks) (list 4 1)) + (test (unsafe-blocks :frequency 2) (list 2 1)) + (test (unsafe-blocks :scaler 3 :frequency 2) (list 2 3)) + (test (unsafe-blocks :scaler 3 :phase 1) 'error) + (test (map unsafe-blocks '(1 2 3)) '((1 1) (2 1) (3 1))) + (test (map unsafe-blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6))) + (test (documentation unsafe-blocks) "test for function*") + (test (apply unsafe-blocks '(:frequency 5 :scaler 4)) '(5 4)) + (test (let () (define (b1) (unsafe-blocks 100)) (b1)) '(100 1)) + (test (let () (define (b1) (unsafe-blocks 10 2)) (b1)) '(10 2)) + (test (procedure? unsafe-blocks) #t) + (test (call/cc (setter (block))) 'error) (test (call-with-exit (setter (block))) 'error) (test (call-with-input-string "123" (setter (block))) 'error) @@ -1824,6 +1846,8 @@ void block_init(s7_scheme *sc) ;;; c-pointer ;;; c-pointer? ;;; c-pointer->list +;;; c-pointer-info +;;; c-pointer-type (test (c-pointer? 0) #f) (test (c-pointer? _null_) #t) @@ -1845,7 +1869,7 @@ void block_init(s7_scheme *sc) (test (c-object?) 'error) (test (c-pointer? _c_obj_ 2 3) 'error) (test (c-object? _c_obj_ 2) 'error) -(test (c-pointer 1 2 3 4) 'error) +(test (c-pointer 1 2 3 4 5 6) 'error) (test (c-pointer? (openlet (inlet 'c-pointer? (lambda (p) #t)))) #t) (test (c-pointer? (c-pointer 2 'integer?) 'integer?) #t) (test (c-pointer? (c-pointer 2 'integer?) 'symbol?) #f) @@ -1875,6 +1899,20 @@ void block_init(s7_scheme *sc) (test (object->string (c-pointer 1 (vector)) :readable) "(c-pointer 1 #() #f)") (test (object->string (c-pointer 1 (vector))) "#<c_pointer 0x1>") ; ?? +(test (c-pointer-info) 'error) +(test (c-pointer-info #f) 'error) +(test (c-pointer-info (c-pointer 0)) #f) +(test (c-pointer-info (c-pointer 0) #f) 'error) +(test (c-pointer-info (c-pointer 0)) #f) +(test (c-pointer-info (c-pointer 0 1 2)) 2) + +(test (c-pointer-type) 'error) +(test (c-pointer-type #f) 'error) +(test (c-pointer-type (c-pointer 0)) #f) +(test (c-pointer-type (c-pointer 0) #f) 'error) +(test (c-pointer-type (c-pointer 0)) #f) +(test (c-pointer-type (c-pointer 0 1 2)) 1) + (when with-bignums (test (c-pointer? (c-pointer (bignum "12341234"))) #t) (test (c-pointer (bignum "1.4")) 'error)) @@ -3476,7 +3514,7 @@ void block_init(s7_scheme *sc) (let ((dfn (vector ""))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (number->string i 8)))) (test (fc) (vector (number->string 0 8)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (magnitude i)))) (test (fc) (float-vector (magnitude 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (angle i)))) (test (fc) (float-vector (angle 0.0)))) -(let ((dfn (vector 0.0))) (define (fc) (do ((i 0 (+ i 1))) ((>= i 1) dfn) (vector-set! dfn 0 (complex i i)))) (test (fc) (vector 0.0))) +(let ((dfn (vector 0.0))) (define (fc) (do ((i 0 (+ i 1))) ((>= i 1) dfn) (vector-set! dfn 0 (complex i i)))) (test (fc) (vector (if with-bignums 0 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (sin i)))) (test (fc) (float-vector (sin 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (cos i)))) (test (fc) (float-vector (cos 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (tan i)))) (test (fc) (float-vector (tan 0.0)))) @@ -3581,7 +3619,7 @@ void block_init(s7_scheme *sc) (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i)))) (test (fc) 1.0)) ;divide_d_dd (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i)))) (test (fc) 0.5)) ;divide_d_ddd (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i i)))) (test (fc) 0.25)) ;divide_d_dddd -(let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (fc) 1.0)) ;divide_p_ii +(let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (fc) (if with-bignums 1 1.0))) ;divide_p_ii (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= i (sqrt count))))) (test (fc) #t)) ;leq_p_pp (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= (sqrt count) 1)))) (test (fc) #t)) ;leq_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (< (sqrt count) 1)))) (test (fc) #t)) ;lt_p_pi @@ -3615,7 +3653,7 @@ void block_init(s7_scheme *sc) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (integer-length i)))) (test (fc) 0)) ;integer_length_i_i (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (random i)))) (test (fc) 0)) ;random_i_i (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) count) (set! count (random i)))) (test (fc) 0.0)) ;random_d_d -(let () (define (fc) (do ((count (complex 1 1)) (i 0 (+ i 1))) ((= i 1) count) (set! count (random (complex i i))))) (test (fc) 0.0)) ;random_p_p +(let () (define (fc) (do ((count (complex 1 1)) (i 0 (+ i 1))) ((= i 1) count) (set! count (random (complex i i))))) (test (fc) (if with-bignums 0 0.0))) ;random_p_p (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (random-state? i) (set! dfn #t)))) (test (fc) #f)) ;is_random_state_b (let ((str "123qasde")) (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (char-position #\a str 0))) (test (fc) #t)) ;char_position_p_ppi (let ((str "123qasde")) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (string-length str)))) (test (fc) 8)) ;string_length_i @@ -3697,7 +3735,7 @@ void block_init(s7_scheme *sc) (copy v (make-string (+ j 1))) (if (byte-vector? seq) (copy v (make-byte-vector (+ j 1))) - (make-shared-vector v (+ j 1))))) + (subvector v (+ j 1))))) (if (not (equal? obj (seq i))) (set! (v (set! j (+ j 1))) (seq i))))))) @@ -7742,7 +7780,7 @@ i" (lambda (p) (eval (read p)))) pi) (test (reverse '(1 2 . 3)) '(3 2 1)) (test (reverse) 'error) (test (reverse '(1 2 3) '(3 2 1)) 'error) -(test (reverse (make-shared-vector (make-int-vector '(2 3) 0) '(6))) (make-int-vector 6 0)) +(test (reverse (subvector (make-int-vector '(2 3) 0) '(6))) (make-int-vector 6 0)) (test (reverse (make-float-vector 6 0.0)) (make-float-vector 6 0.0)) (for-each @@ -8109,13 +8147,13 @@ i" (lambda (p) (eval (read p)))) pi) (list 12 4 3 6 6)) )) -(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3))) (reverse! sv) v)) #(3 2 1 4)) -(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (reverse! sv) v)) #(1 4 3 2)) -(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (fill! sv 5) v)) #(1 5 5 5)) -(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (reverse sv) v)) #(1 2 3 4)) -(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (sort! sv >) v)) #(1 4 3 2)) -(test (let ((v (make-int-vector '(3 3) 1))) (let ((sv (v 1))) (fill! sv 2) v)) (make-shared-vector (int-vector 1 1 1 2 2 2 1 1 1) '(3 3))) -(test (immutable? (make-shared-vector (immutable! (vector 1 2 3 4)) '(2 2))) #t) +(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 3))) (reverse! sv) v)) #(3 2 1 4)) +(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 3 1))) (reverse! sv) v)) #(1 4 3 2)) +(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 3 1))) (fill! sv 5) v)) #(1 5 5 5)) +(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 3 1))) (reverse sv) v)) #(1 2 3 4)) +(test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 3 1))) (sort! sv >) v)) #(1 4 3 2)) +(test (let ((v (make-int-vector '(3 3) 1))) (let ((sv (v 1))) (fill! sv 2) v)) (subvector (int-vector 1 1 1 2 2 2 1 1 1) '(3 3))) +(test (immutable? (subvector (immutable! (vector 1 2 3 4)) '(2 2))) #t) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) @@ -8126,7 +8164,7 @@ i" (lambda (p) (eval (read p)))) pi) (let ((sv (v 1))) (fill! sv 2) v)) - (make-shared-vector (int-vector 0 1 2 2 2 2 6 7 8) '(3 3))) + (subvector (int-vector 0 1 2 2 2 2 6 7 8) '(3 3))) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) @@ -8137,7 +8175,7 @@ i" (lambda (p) (eval (read p)))) pi) (let ((sv (v 1))) (sort! sv >) v)) - (make-shared-vector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3))) + (subvector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3))) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) @@ -8148,7 +8186,7 @@ i" (lambda (p) (eval (read p)))) pi) (let ((sv (v 1))) (reverse! sv) v)) - (make-shared-vector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3))) + (subvector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3))) (test (catch #t (lambda () @@ -9942,19 +9980,19 @@ i" (lambda (p) (eval (read p)))) pi) ;;; make a shared ref -- we'll check it later after enough has happened that an intervening GC is likely -(define check-shared-vector-after-gc #f) +(define check-subvector-after-gc #f) (let ((avect (make-vector '(6 6) 32))) (do ((i 0 (+ i 1))) ((= i 6)) (do ((j 0 (+ j 1))) ((= j 6)) (set! (avect i j) (cons i j)))) - (set! check-shared-vector-after-gc (avect 3))) + (set! check-subvector-after-gc (avect 3))) (if (not with-bignums) (test (vector? (make-float-vector 3 pi)) #t)) (test (vector? (make-vector 3 pi)) #t) -(test (vector? (make-shared-vector (make-int-vector '(2 3)) '(3 2))) #t) +(test (vector? (subvector (make-int-vector '(2 3)) '(3 2))) #t) (test (vector? #r(+nan.0)) #t) (test (vector? #r(+inf.0)) #t) (test (vector? #(-nan.0 -inf.0)) #t) @@ -10020,83 +10058,134 @@ i" (lambda (p) (eval (read p)))) pi) (test (eval-string "#922D()") 'error) -;;; make-shared-vector -(test (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) #(1 2 3 4 5 6)) -(test (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) #2d((1 2) (3 4) (5 6))) -(test (make-shared-vector #2d() '(0)) #()) -(test (make-shared-vector '(1) '(1)) 'error) -(test (make-shared-vector #(1) '(2)) 'error) -(test (make-shared-vector #(1) '(1 2)) 'error) -(test (make-shared-vector #(1 2 3 4) ()) 'error) -(test (make-shared-vector #(1 2 3 4) most-positive-fixnum) 'error) -(test (make-shared-vector #(1 2 3 4) most-negative-fixnum) 'error) -(test (make-shared-vector #(1 2 3 4) -1) 'error) -(test (make-shared-vector #(1 2 3 4) 5) 'error) -(test (make-shared-vector #(1 2 3 4) 0) #()) -(test (make-shared-vector #(1 2 3 4) '(2)) #(1 2)) -(test (make-shared-vector #(1 2 3 4) '(2 1)) #2d((1) (2))) -(test (make-shared-vector #(1 2 3 4) '(0)) #()) +;;; subvector +(test (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (subvector v1 '(6)))) v2)) #(1 2 3 4 5 6)) +(test (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (subvector v1 '(3 2)))) v2)) #2d((1 2) (3 4) (5 6))) +(test (subvector #2d() '(0)) #()) +(test (subvector '(1) '(1)) 'error) +(test (subvector #(1) '(2)) 'error) +(test (subvector #(1) '(1 2)) 'error) +(test (subvector #(1 2 3 4) ()) 'error) +(test (subvector #(1 2 3 4) most-positive-fixnum) 'error) +(test (subvector #(1 2 3 4) most-negative-fixnum) 'error) +(test (subvector #(1 2 3 4) -1) 'error) +(test (subvector #(1 2 3 4) 5) 'error) +(test (subvector #(1 2 3 4) 0) #()) +(test (subvector #(1 2 3 4) '(2)) #(1 2)) +(test (subvector #(1 2 3 4) '(2 1)) #2d((1) (2))) +(test (subvector #(1 2 3 4) '(0)) #()) +(test (subvector #() 1) 'error) +(test (subvector #() 0) #()) +(test (subvector #(1) 0) #()) +(let ((v #(1))) (test (subvector-vector (subvector v 0)) v)) +(test (subvector #(1) 1 1) 'error) + (for-each (lambda (arg) - (test (make-shared-vector arg) 'error) - (test (make-shared-vector #(1 2 3) arg) 'error)) + (test (subvector arg) 'error) + (test (subvector #(1 2 3) arg) 'error)) (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (let ((v #2d((1 2) (3 4)))) - (test (make-shared-vector v '((1 2) (3 4))) 'error) - (test (make-shared-vector v ()) 'error) - (test (make-shared-vector v '(1.4)) 'error) - (test (make-shared-vector v '(14 15)) 'error) - (test (make-shared-vector v (list most-positive-fixnum)) 'error) - (test (make-shared-vector v '(-1 0)) 'error) - (test (make-shared-vector v '(1) most-positive-fixnum) 'error)) + (test (subvector v '((1 2) (3 4))) 'error) + (test (subvector v ()) 'error) + (test (subvector v '(1.4)) 'error) + (test (subvector v '(14 15)) 'error) + (test (subvector v (list most-positive-fixnum)) 'error) + (test (subvector v '(-1 0)) 'error) + (test (subvector v '(1) most-positive-fixnum) 'error)) (let ((v (float-vector 0.0 1.0 2.0))) - (let ((v1 (make-shared-vector v (list 1 3)))) + (let ((v1 (subvector v (list 1 3)))) (test (float-vector? v1) #t) (test (morally-equal? (v 0) (v1 0 0)) #t))) (let ((v (int-vector 0 1 2))) - (let ((v1 (make-shared-vector v (list 1 3)))) + (let ((v1 (subvector v (list 1 3)))) (test (int-vector? v1) #t) (test (morally-equal? (v 0) (v1 0 0)) #t))) (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) - (let ((v1 (make-shared-vector v (list 1 3)))) + (let ((v1 (subvector v (list 1 3)))) (test (float-vector? v1) #f) (test (int-vector? v1) #t) (test (integer? (v1 0 2)) #t) (test (= (v 2) (v1 0 2)) #t))) (let ((v (vector 0 1 2 3 4 5 6 7 8))) - (test (make-shared-vector v (list 3 2) 1) #2d((1 2) (3 4) (5 6))) - (test (make-shared-vector v (list 3 2) 2) #2d((2 3) (4 5) (6 7))) - (test (make-shared-vector v (list 3) 2) #(2 3 4)) - (test (make-shared-vector v (list 3) 0) (make-shared-vector v (list 3))) - (test (make-shared-vector v (list 3) -1) 'error) - (test (make-shared-vector v (list 3) 10) 'error) - (test (make-shared-vector v (list 3) 3.2) 'error) - (test (make-shared-vector v (list 3) "0") 'error) + (test (subvector v (list 3 2) 1) #2d((1 2) (3 4) (5 6))) + (test (subvector v (list 3 2) 2) #2d((2 3) (4 5) (6 7))) + (test (subvector v (list 3) 2) #(2 3 4)) + (test (subvector v (list 3) 0) (subvector v (list 3))) + (test (subvector v (list 3) -1) 'error) + (test (subvector v (list 3) 10) 'error) + (test (subvector v (list 3) 3.2) 'error) + (test (subvector v (list 3) "0") 'error) ) +(test (subvector #() 1) 'error) +(test (subvector #() 0 1) 'error) +(test (subvector #(1) 1 1) 'error) +(test (subvector #(1) 1 0) #(1)) + (let ((a (vector 1 2 3)) (b (vector 4 5 6))) - (test (make-shared-vector (append a b) '(2 3)) #2d((1 2 3) (4 5 6)))) + (test (subvector (append a b) '(2 3)) #2d((1 2 3) (4 5 6)))) (let ((a #2d((1 2) (3 4))) (b #2d((5 6) (7 8)))) - (test (make-shared-vector (append a b) '(2 4)) #2d((1 2 3 4) (5 6 7 8))) - (test (make-shared-vector (append a b) '(4 2)) #2d((1 2) (3 4) (5 6) (7 8))) - (test (make-shared-vector (append (a 0) (b 0) (a 1) (b 1)) '(2 4)) #2d((1 2 5 6) (3 4 7 8))) - (test (make-shared-vector (append (a 0) (b 0) (a 1) (b 1)) '(4 2)) #2d((1 2) (5 6) (3 4) (7 8)))) + (test (subvector (append a b) '(2 4)) #2d((1 2 3 4) (5 6 7 8))) + (test (subvector (append a b) '(4 2)) #2d((1 2) (3 4) (5 6) (7 8))) + (test (subvector (append (a 0) (b 0) (a 1) (b 1)) '(2 4)) #2d((1 2 5 6) (3 4 7 8))) + (test (subvector (append (a 0) (b 0) (a 1) (b 1)) '(4 2)) #2d((1 2) (5 6) (3 4) (7 8)))) + +(test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(0)) #()) +(test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(1)) (float-vector 1.0)) +(test ((subvector (subvector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(4 1)) 2 0) 3.0) + +(let ((v (subvector (float-vector 1 2 3) 3))) + (test (copy v) (subvector (float-vector 1 2 3) 3)) + (test (length v) 3) + (test (reverse v) (float-vector 3 2 1)) + (test v #r(1 2 3)) + (set! v (reverse! v)) + (test v #r(3 2 1))) + +;;; subvector? +(let ((v (vector 0 1 2 3 4 5 6 7 8))) + (test (subvector? (subvector v 3 1)) #t) + (test (subvector? v) #f)) +(for-each + (lambda (arg) + (test (subvector? arg) #f) + (test (subvector-position arg) 'error) + (test (subvector-vector arg) 'error)) + (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) + 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) +(test (subvector?) 'error) +(test (subvector? (subvector-vector (subvector #(1) 1))) #f) +(test (vector? (subvector-vector (subvector #(1) 1))) #t) -(test (make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(0)) #()) -(test (make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(1)) (float-vector 1.0)) -(test ((make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(4 1)) 2 0) 3.0) +;;; subvector-position +(let ((v (vector 0 1 2 3 4 5 6 7 8))) + (test (subvector-position (subvector v 3 1)) 1) + (test (subvector-position (subvector v 1)) 0) + (test (subvector-position (subvector v '(2 2) 1)) 1)) +(test (subvector-position v) 'error) +(test (subvector-position) 'error) +(test (subvector-position (subvector #(1 2 3) 2 1)) 1) + +;;; subvector-vector +(let ((v (vector 0 1 2 3 4 5 6 7 8))) + (test (subvector-vector (subvector v 2)) v) + (test (subvector-vector v) 'error) +) + +;;; -------- (let-temporarily (((*s7* 'print-length) 123123123)) (test (object->string (make-vector 2048 #f)) "(make-vector 2048 #f)") (test (object->string (make-vector '(12 2048) #<unspecified>)) "(make-vector '(12 2048) #<unspecified>)") @@ -10613,7 +10702,7 @@ i" (lambda (p) (eval (read p)))) pi) (test (let ((v (make-int-vector 3))) (vector-ref v 1)) 0) (test (let ((v (make-vector 3 0))) (vector-ref v 1)) 0) (test (let ((v (make-float-vector 3 1.0))) (vector-ref v 1)) 1.0) -(test (let ((v (make-int-vector 6 0))) (vector-set! v 3 32) (let ((v1 (make-shared-vector v '(2 3)))) (vector-ref v1 1 0))) 32) +(test (let ((v (make-int-vector 6 0))) (vector-set! v 3 32) (let ((v1 (subvector v '(2 3)))) (vector-ref v1 1 0))) 32) (test (vector-ref) 'error) (test (vector-ref #(1)) 'error) @@ -11339,7 +11428,7 @@ i" (lambda (p) (eval (read p)))) pi) (vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (vect4 #3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))) (vect1t (make-int-vector '(2 2 3) 0))) - (let ((v (make-shared-vector vect1t '(12)))) + (let ((v (subvector vect1t '(12)))) (set! (v 0) 1) (set! (v 1) 2) (set! (v 2) 3) (set! (v 3) 3) (set! (v 4) 4) (set! (v 5) 5) (set! (v 6) 5) (set! (v 7) 6) (set! (v 8) 1) (set! (v 9) 7) (set! (v 10) 8) (set! (v 11) 2)) (do ((i 1 (+ i 1))) @@ -11832,16 +11921,16 @@ i" (lambda (p) (eval (read p)))) pi) (test (object->string (make-vector '(16 1 1 1 1 1 1 1 1 1 1 1 1 1) 0)) "#14d((((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))))") ;;; now see if our shared vector has survived... - (test (and (vector? check-shared-vector-after-gc) - (= (length check-shared-vector-after-gc) 6) + (test (and (vector? check-subvector-after-gc) + (= (length check-subvector-after-gc) 6) (do ((i 0 (+ i 1)) (happy #t)) ((= i 6) happy) - (if (or (not (pair? (check-shared-vector-after-gc i))) - (not (equal? (check-shared-vector-after-gc i) (cons 3 i)))) + (if (or (not (pair? (check-subvector-after-gc i))) + (not (equal? (check-subvector-after-gc i) (cons 3 i)))) (set! happy #f)))) #t) - (set! check-shared-vector-after-gc #f)) + (set! check-subvector-after-gc #f)) @@ -12168,7 +12257,7 @@ i" (lambda (p) (eval (read p)))) pi) <1>)") ; #1=#(#1# 2) (test-wi (let ((v (make-vector '(2 2) 0))) (set! (v 1 1) v) (object->string v :readable)) ; #1=#2d((0 0) (0 #1#)) - "(let ((<1> (make-shared-vector (vector 0 0 0 #f) '(2 2)))) + "(let ((<1> (subvector (vector 0 0 0 #f) '(2 2)))) (set! (<1> 1 1) <1>) <1>)") ; #1=#2d((0 0) (0 #1#)) @@ -13535,6 +13624,7 @@ i" (lambda (p) (eval (read p)))) pi) ;;; hash-table ;;; hash-table* ;;; hash-table? +;;; weak-hash-table? ;;; hash-table-entries ;;; hash-table-ref ;;; hash-table-set! @@ -14319,6 +14409,39 @@ i" (lambda (p) (eval (read p)))) pi) ;(test (ht ht) 10) ) +;;; weak-hash-table? +(for-each + (lambda (arg) + (test (weak-hash-table? arg) #f)) + (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) + +(test (weak-hash-table? (hash-table)) #f) +(test (weak-hash-table? (make-weak-hash-table)) #t) + +(when full-test + (do ((z 0 (+ z 1))) + ((= z 10)) + (let ((keys (make-vector 100)) + (wht (make-weak-hash-table))) + (do ((i 0 (+ i 1))) + ((= i 100)) + (set! (keys i) (list (random 100) (random 100))) + (set! (wht (keys i)) i)) + (do ((i 0 (+ i 1))) + ((= i 10000)) + (let ((key (random 100))) + (set! (keys key) (list (random 100) (random 100))) + (if (> (random 100) 50) + (set! (wht (keys key)) i) + (if (> (random 100) 90) + (do ((k 0 (+ k 1))) + ((= k 100)) + (set! (wht (keys k)) k))))) + (when (zero? (hash-table-entries wht)) + (do ((k 0 (+ k 1))) + ((= k 100)) + (set! (wht (keys k)) k))))))) + (test (let ((h1 (hash-table '(a . 1) '(b . 2))) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (morally-equal? h1 h2)) #t) (test (let ((h1 (hash-table '(a . 1) '(b . 2))) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (morally-equal? (list h1) (list h2))) #t) @@ -15186,6 +15309,39 @@ i" (lambda (p) (eval (read p)))) pi) (set! (ov 1 0 0 1) 5) (test (ov 1 0 0 1) 5)) +(test (let () (define (func) (abs ((list #f #r(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1.0) +(test (let () (define (func) (abs ((list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) +(test (let () (define (func) (abs ((list #f #(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) +(test (let () (define (func) (abs ((list #f #u8(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) +(test (let () (define (func) (char->integer ((list #f "123") 1 0))) (define (hi) (func)) (hi)) (char->integer #\1)) +(test (let () (define (func) (abs ((list #f (lambda (x) (+ x 10))) 1 0))) (define (hi) (func)) (hi)) 10) +(test (let () (define (func) (abs ((list #f ceiling) 1 1.1))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f quasiquote) 1 2))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (define-macro (_m_ x) `(+ ,x 1))) 1 2))) (define (hi) (func)) (hi)) 3) +(test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (hash-table* :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f (hash-table* 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((list #f begin) 1 3))) (define (hi) (func)) (hi)) 3) +(test (let () (define (func) (abs ((list #f when) 1 #t 4))) (define (hi) (func)) (hi)) 4) +(test (let () (define (func) (abs (list-ref (list #f (list #i(1 2 3))) 1 0 0))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (abs (list-ref (list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (abs (vector-ref (vector #f '(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (abs ((inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((inlet 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs (hash-table-ref (hash-table* 'a (hash-table* 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((hash-table* 'a (hash-table* 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) +(test (let () (define (func) (abs ((hash-table* 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) + +;;; (hash-table* 'a 1) is different from (hash-table* :a 1): +(test (let () (define (func) (abs ((list #f (hash-table* 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (abs ((list #f (hash-table* :a -2)) 1 'a))) (define (hi) (func)) (hi)) 'error) + +(test (let () (define (func) (abs (let-ref (inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (abs (hash-table-ref (hash-table* 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 'error) + ;;; -------------------------------------------------------------------------------- @@ -19947,6 +20103,11 @@ c" (list 8 2 1))) (test (object->string (vector 1 2 3) :readable) "(vector 1 2 3)") +(let ((v (make-vector '(2 3) #f))) + (set! (v 1 0) (v 0)) + (test (object->string v) "#2d((#f #f #f) (#(#f #f #f) #f #f))") + (set! (v 0 1) 3) + (test (object->string v) "#2d((#f 3 #f) (#(#f 3 #f) #f #f))")) ;; :readable lists (circular, dotted) (for-each @@ -20132,7 +20293,7 @@ c" (test (object->string (inlet 'a (vector "hi" #\a 'b)) :readable) "(inlet :a (vector \"hi\" #\\a 'b))") (test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet :a #r(1.0 2.0 3.0))") (test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet :a #i(1 2 3))") -(test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet :a (make-shared-vector (vector 1 2 3 4 5 6) '(2 3)))") +(test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet :a (subvector (vector 1 2 3 4 5 6) '(2 3)))") (test (object->string (inlet 'a abs) :readable) "(inlet :a #_abs)") (test (object->string (inlet 'a (lambda (b) (+ b 1))) :readable) "(inlet :a (lambda (b) (+ b 1)))") (test (object->string (inlet 'a (lambda b (list b 1))) :readable) "(inlet :a (lambda b (list b 1)))") @@ -20349,15 +20510,15 @@ c" (test (object->string (values) :readable) "#<unspecified>") -(test (object->string pi :readable) "3.141592653589793") +(test (object->string pi :readable) (if with-bignums "3.141592653589793238462643383279502884195E0" "3.141592653589793")) (test (object->string +inf.0 :readable) "+inf.0") (test (object->string -inf.0 :readable) "-inf.0") (test (object->string +nan.0 :readable) "+nan.0") (if with-block (test (object->string (block pi) :readable) "(block 3.141592653589793)")) (test (object->string (log 0) :readable) "(complex -inf.0 3.141592653589793)") (test (object->string 1/0 :readable) "+nan.0") -(test (object->string 1+1/0i :readable) "(complex 1 +nan.0)") -(test (object->string -1/0-1/0i :readable) "(complex +nan.0 +nan.0)") +(test (object->string 1+1/0i :readable) (if with-bignums "(complex 1 +inf.0)" "(complex 1 +nan.0)")) +(test (object->string -1/0-1/0i :readable) (if with-bignums "(complex -inf.0 -inf.0)" "(complex +nan.0 +nan.0)")) (test (object->string 0+0/0i :readable) "(complex 0 +nan.0)") (test (object->string (* (log 0) (log 0)) :readable) "(complex +inf.0 -inf.0)") (test (object->string (complex 1/0 (- (real-part (log 0)))) :readable) "(complex +nan.0 +inf.0)") @@ -20555,7 +20716,7 @@ c" (test-wi (let ((v (make-vector '(2 3) 1))) (set! (v 0 1) v) (object->string v :readable)) - "(let ((<1> (make-shared-vector (vector 1 #f 1 1 1 1) '(2 3)))) + "(let ((<1> (subvector (vector 1 #f 1 1 1 1) '(2 3)))) (set! (<1> 0 1) <1>) <1>)") @@ -23408,7 +23569,7 @@ in s7: (if (< col (car (vector-dimensions v))) (let ((c col)) (set! col (+ col 1)) - (make-shared-vector v (cadr (vector-dimensions v)) (* c (cadr (vector-dimensions v))))) + (subvector v (cadr (vector-dimensions v)) (* c (cadr (vector-dimensions v))))) #<eof>))))) (let ((v #2d((0 1 2) (4 5 6)))) @@ -23974,7 +24135,7 @@ in s7: (test (let ((__do_step_var_check__ 2)) 1) 'error) (test (let () (set! __do_step_var_check__ 2)) 'error) (test (let ((__a_var__ 123)) - (set! (symbol-setter '__a_var__) (lambda (val sym) 0)) + (set! (setter '__a_var__) (lambda (val sym) 0)) (set! __a_var__ -1123)) 0) (test (do ((hi #3d(((1 2) (3 4)) ((5 6) (7 8))) (hi 1))) ((equal? hi 8) hi)) 8) @@ -27342,6 +27503,23 @@ in s7: (test (+ (values (* 3 2) (abs (values -1)))) 7) (test (+ (let ((x 1)) (values x (+ x 1))) (if #f #f (values 2 3))) 8) +;;; the test macro here causes the multiple values to evaporate, ruining the test +(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_) (append))) (define (hi) (func)) (hi)))) + (s2 (object->string (let () (define (func) (vector #f (values 1 2 3) (append))) (define (hi) (func)) (hi))))) + (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) + +(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (_vals_) (append))) (define (hi) (func)) (hi)))) + (s2 (object->string (let () (define (func) (vector (values 1 2 3) (append))) (define (hi) (func)) (hi))))) + (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) + +(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_))) (define (hi) (func)) (hi)))) + (s2 (object->string (let () (define (func) (vector #f (values 1 2 3))) (define (hi) (func)) (hi))))) + (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) + +(let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (append) (_vals_) #f)) (define (hi) (func)) (hi)))) + (s2 (object->string (let () (define (func) (vector (append) (values 1 2 3) #f)) (define (hi) (func)) (hi))))) + (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) + (test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n m p))) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) sum) 45) (test (map (lambda (n m p) (+ n m p)) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) '(12 15 18)) (test (string-append (values "123" "4" "5") "6" (values "78" "90")) "1234567890") @@ -30250,7 +30428,7 @@ who says the continuation has to restart the map from the top? (test (call-with-exit (let ((x 3)) (define (return y) (y x)) return)) 3) (test (call-with-exit (lambda (return) (with-input-from-string "hi" return))) ()) ; because thunk? -- does it close the port? (test (call-with-exit (lambda (return) (call-with-input-string "hi" return))) 'error) -(test (call-with-exit (lambda (return) (set! (setter return) abs))) 'error) +(test (call-with-exit (lambda (return) (set! (setter return) abs))) abs) (test (call-with-exit (lambda (return) (dynamic-wind return (lambda () 1) (lambda () (error 'test-error "oops"))))) ()) (test (call-with-exit (lambda (return) (map return '(1 2 3)))) 1) (test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) return))) ()) ; ?? is this a bug? @@ -32174,13 +32352,13 @@ who says the continuation has to restart the map from the top? (when with-bignums (let-temporarily (((*s7* 'print-length) (bignum "0"))) (test (format #f "~A" #()) "#()") - (test (format #f "~A" #(1 2 3 4)) "#(1 ...)") + (test (format #f "~A" #(1 2 3 4)) "#(...)") (set! (*s7* 'print-length) (bignum "1")) (test (format #f "~A" #()) "#()") (test (format #f "~A" #(1)) "#(1)") (test (format #f "~A" #(1 2 3 4)) "#(1 ...)") (set! (*s7* 'print-length) (bignum "2")) - (test (format #f "~A" #(1 2 3 4)) "#(1 ...)"))) + (test (format #f "~A" #(1 2 3 4)) "#(1 2 ...)"))) (test (set! (*s7* 'safety) -1) 'error) (test (set! (*s7* 'safety) 5) 'error) @@ -34516,19 +34694,19 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let () (define (hi (a 1)) a) (hi 1)) 'error) (test (let ((_?_0 #f)) - (set! (symbol-setter '_?_0) (lambda args #f)) + (set! (setter '_?_0) (lambda args #f)) (define-macro (_?_0 a) `(+ ,a 1)) (_?_0 2)) 'error) (test (let ((_?_1 #f)) - (set! (symbol-setter '_?_1) (lambda args 'error)) + (set! (setter '_?_1) (lambda args 'error)) (define-macro (_?_1 a) `(+ ,a 1)) (_?_1 2)) 'error) (test (let ((_?_2 #f)) - (set! (symbol-setter '_?_2) (lambda (s v) v)) + (set! (setter '_?_2) (lambda (s v) v)) (define-macro (_?_2 a) `(+ ,a 1)) (_?_2 2)) 3) @@ -34948,7 +35126,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity object->string) '(1 . 3)) (test (arity string) (cons 0 *max-arity*)) (test (arity dynamic-wind) '(3 . 3)) -(test (arity symbol-setter) '(1 . 2)) +(test (arity setter) '(1 . 2)) (test (arity sublet) (cons 1 *max-arity*)) (test (arity vector-length) '(1 . 1)) (test (arity char-ready?) '(0 . 1)) @@ -34964,8 +35142,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity call-with-exit) '(1 . 1)) (test (arity gensym) '(0 . 1)) (test (arity make-hash-table) '(0 . 2)) +(test (arity make-weak-hash-table) '(0 . 2)) (test (arity multiple-value-bind) (cons 2 *max-arity*)) -(test (arity setter) '(1 . 1)) +(test (arity setter) '(1 . 2)) (test (arity define-bacro) (cons 2 *max-arity*)) (test (arity string-append) (cons 0 *max-arity*)) (test (arity port-line-number) '(0 . 1)) @@ -35086,7 +35265,11 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity hash-table) (cons 0 *max-arity*)) (test (arity close-output-port) '(1 . 1)) (test (arity type-of) '(1 . 1)) -(test (arity c-pointer) '(1 . 3)) +(test (arity c-pointer) '(1 . 5)) +(test (arity c-pointer-info) '(1 . 1)) +(test (arity c-pointer-type) '(1 . 1)) +(test (arity c-pointer-weak1) '(1 . 1)) +(test (arity c-pointer-weak2) '(1 . 1)) (test (arity c-pointer?) '(1 . 2)) (test (arity require) (cons 1 *max-arity*)) (test (arity provide) '(1 . 1)) @@ -35095,6 +35278,10 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (arity tree-memq) '(2 . 2)) (test (arity tree-set-memq) '(2 . 2)) (test (arity tree-cyclic?) '(1 . 1)) +(test (arity subvector) '(2 . 3)) +(test (arity subvector?) '(1 . 1)) +(test (arity subvector-position) '(1 . 1)) +(test (arity subvector-vector) '(1 . 1)) (test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3)) (test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*)) @@ -35296,9 +35483,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (lambda (arg) (test (setter arg) 'error)) (list -1 #\a #f 1 3.14 3/4 1.0+1.0i ())) -(test (setter :hi) #f) ; setter -> symbol-setter here +(test (setter :hi) #f) ; setter -> setter here (test (setter 'hi) #f) -(let ((sym 3)) (set! (symbol-setter 'sym) (lambda (x) x)) (test (procedure? (setter 'sym)) #t)) +(let ((sym 3)) (set! (setter 'sym) (lambda (x) x)) (test (procedure? (setter 'sym)) #t)) (for-each (lambda (arg) @@ -35441,6 +35628,212 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (set! (fset3 3) 4) 7) ) +;;; (symbol-setter) + +(let ((p (open-output-string))) + (define e ; save environment for use below + (let ((x 3) ; always an integer + (y 3) ; always 3 + (z 3)) ; report set! + (set! (setter 'x) (lambda (s v) (if (integer? v) v x))) + (set! (setter 'y) (lambda (s v) y)) + (set! (setter 'z) (lambda (s v) (format p "z ~A -> ~A~%" z v) v)) + (set! x 3.3) + (set! y 3.3) + (set! z 3.3) + (curlet))) + (test (and (equal? (e 'x) 3) (equal? (e 'y) 3) (equal? (e 'z) 3.3) + (string=? (get-output-string p) "z 3 -> 3.3\n")) + #t) + (close-output-port p)) + +(for-each + (lambda (arg) + (test (setter arg) 'error) + (test (set! (setter _int_) arg) 'error) + (let ((x 1)) + (if (not (null? arg)) + (test (set! (setter 'x arg) (lambda (s v) 1)) 'error))) + (let ((_x_ 1)) + (set! (setter '_x_) (lambda (s v) v)) + (set! _x_ arg) + (test _x_ arg))) + (list -1 #\a 1 3.14 3/4 1.0+1.0i ())) + +(let ((_x_ 1)) + (set! (setter '_x_) (lambda (s v) v)) + (define _x_ 32) + (test _x_ 32) + (define (_x_) 32) + (test (_x_) 32) + (let ((_x_ 3)) + (test _x_ 3)) + (define (hi _x_) _x_) + (test (hi 4) 4) + (test (do ((_x_ 0 (+ _x_ 1))) ((= _x_ 2) _x_)) 2) + (test ((inlet '_x_ -1) '_x_) -1) + (set! _x_ 32) + (test _x_ 32)) + +(let ((_x_ 1)) + (set! (setter '_x_) (lambda (s v) #f)) + (define _x_ 32) (test _x_ #f) + (test (set! _x_ 32) #f)) + +(test (setter) 'error) +(let ((xyzzy 1) + (_int_ 'xyzzy)) + (test (setter 'xyzzy) #f) + (test (set! (setter _int_) ()) 'error) + (test (set! (setter _int_) '(#f)) 'error)) + +(let ((_x1_ #f)) + (set! (setter '_x1_) (lambda (x y) 'error)) + (test (set! _x1_ 32) 'error)) + +(let ((x 1)) + (set! (setter 'x) (lambda (s v) x)) + (let ((x 2)) + (set! x 3) + (test x 3) + (set! (setter 'x (curlet)) (lambda (s v) 32)) + (set! x 1) + (test x 32)) + (test x 1) + (set! x 2) + (test x 1)) + +(let () + (define (f1 x) + (let ((a x) + (b 2) + (c 3)) + (set! (setter 'b) (lambda (s v) (set! a (+ v c)) v)) + (set! (setter 'c) (lambda (s v) (set! a (+ b v)) v)) + (set! a (+ b c)) + (set! b (+ b 1)) + (set! c 5) + a)) + (f1 0) + (test (f1 0) 8)) + +(test (setter :rest) #f) +(test (set! (setter :allow-other-keys) #f) 'error) + +(let () + (define v_a_r 32) + (let ((x #(1 2 3))) + (set! (setter 'v_a_r) + (lambda (sym val) + (set! (x 1) val) + (+ val 2)))) + (do ((i 0 (+ i 1))) + ((= i 5)) + (set! v_a_r (+ i 33)) + (test v_a_r (+ i 33 2)) + (gc))) + +(define v_a_r 32) +(let ((x #(1 2 3))) + (set! (setter 'v_a_r) + (lambda (sym val) + (set! (x 1) val) + (+ val 1)))) +(do ((i 0 (+ i 1))) + ((= i 5)) + (set! v_a_r (+ i 33)) + (test v_a_r (+ i 33 1)) + (gc)) + +(let ((x (vector 1 2 3))) + (let ((y (list 4 5 6))) + (set! (setter 'v_a_r) + (lambda (sym val) + (+ (x val) (y val))))) + (set! v_a_r 1) + (test v_a_r 7)) +(set! v_a_r 0) +(test v_a_r 5) +(gc) (gc) +(set! v_a_r 2) +(test v_a_r 9) +(gc) (gc) +(let ((err #f)) + (catch #t (lambda () (set! v_a_r 3)) (lambda args (set! err #t))) + (test v_a_r 9) + (if (not err) (format *stderr* "no error in symbol accessor!"))) + +(define v_a_r_1 0) +(let ((v_a_r_1 43) + (x #(1 2 3))) + (set! (setter 'v_a_r_1) (lambda (sym val) (x val))) + (set! v_a_r_1 0) + (test v_a_r_1 1)) +(catch #t (lambda () (set! v_a_r_1 2)) (lambda args (apply format *stderr* (cadr args)))) +(test v_a_r_1 2) + +(let ((x (vector 1 2 3))) + (let ((y 32)) + (let ((e1 (curlet)) + (y 31)) + (let ((e2 (curlet))) + (set! (setter 'y e1) + (lambda (sym val) + (+ val (x 1))))) + (set! y 3) + (test y 3)) + (set! y 2) + (test y 4))) + +(let () + (define (symbol-documentation sym e) + (cond ((setter sym e) => documentation) + (else #f))) + + (define (symbol-signature sym e) + (cond ((setter sym e) => signature) + (else #f))) ; or car? + + (define (set sym val e) + (if (integer? val) + val + (symbol->value sym e))) + + (let ((x 3)) + (set! (setter 'x) set) + (set! x 4) + (test x 4)) + + (let ((x 5)) + (define set + (let ((+signature+ '(integer? #t)) + (+documentation+ "x is an integer")) + (lambda (s v e) + (if (integer? v) + v + (symbol->value s e))))) + (let ((x 6)) + (set! (setter 'x) set) + (set! x 7) + (test x 7) + (test (symbol-documentation 'x (curlet)) "x is an integer") + (test (symbol-signature 'x (curlet)) '(integer? #t))) + (test x 5))) + +(let ((x (inlet :a 1 :b 2)) + (set1 #f) + (set2 #f)) + (set! (setter 'a x) + (lambda (s v e) + (set! set1 v) + (+ v 1))) + (set! (setter 'b x) + (lambda (s v e) + (set! set2 v) + (* v 2))) + (set! (x 'a) 32) + (set! (x 'b) (+ (x 'a) 1)) + (test x (inlet :a 33 :b 68))) ;;; -------------------------------------------------------------------------------- @@ -35666,8 +36059,12 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature byte-vector?) '(boolean? #t)) (test (signature byte-vector->string) '(string? byte-vector?)) (test (signature c-object?) '((integer? boolean?) #t)) -(test (signature c-pointer) '(c-pointer? integer? #t #t)) +(test (signature c-pointer) (let ((L (list 'c-pointer? 'integer? #t))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature c-pointer?) '(boolean? #t #t)) +(test (signature c-pointer-info) '(#t c-pointer?)) +(test (signature c-pointer-type) '(#t c-pointer?)) +(test (signature c-pointer-weak1) '(#t c-pointer?)) +(test (signature c-pointer-weak2) '(#t c-pointer?)) (test (signature caaaar) '(#t pair?)) (test (signature caaadr) '(#t pair?)) (test (signature caaar) '(#t pair?)) @@ -35824,11 +36221,15 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature make-byte-vector) (let ((L (list 'byte-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature make-float-vector) '(float-vector? (integer? pair?) real?)) (test (signature make-hash-table) '(hash-table? integer? (procedure? pair?))) +(test (signature make-weak-hash-table) '(weak-hash-table? integer? (procedure? pair?))) (test (signature make-int-vector) '(int-vector? (integer? pair?) integer?)) (test (signature make-iterator) '(iterator? sequence? pair?)) (test (signature make-list) '(proper-list? integer? #t)) (test (signature make-rectangular) '(number? real? real?)) -(test (signature make-shared-vector) '(vector? vector? (pair? integer?) integer?)) +(test (signature subvector) '(subvector? vector? (pair? integer?) integer?)) +(test (signature subvector?) '(boolean? #t)) +(test (signature subvector-position) '(integer? subvector?)) +(test (signature subvector-vector) '(vector? subvector?)) (test (signature make-string) '(string? integer? char?)) (test (signature make-vector) '(vector? (integer? pair?) #t)) (test (signature map) (let ((L (list 'list? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L)) @@ -35867,7 +36268,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature port-line-number) '(integer? input-port?)) (test (signature positive?) '(boolean? real?)) (test (signature documentation) '(string? procedure?)) -(test (signature setter) '(#t procedure?)) +(test (signature setter) (let ((L (list (list 'boolean? 'procedure?) #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature procedure-source) '(list? procedure?)) (test (signature procedure?) '(boolean? #t)) (test (signature proper-list?) '(boolean? #t)) @@ -35927,7 +36328,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (signature symbol->keyword) '(keyword? symbol?)) (test (signature symbol->string) '(string? symbol?)) (test (signature symbol->value) '(#t symbol? let?)) -(test (signature symbol-setter) '((boolean? procedure?) symbol? let?)) +;(test (signature setter) '((boolean? procedure?) symbol? let?)) (test (signature symbol-table) '(vector?)) (test (signature symbol?) '(boolean? #t)) (test (signature system) '((integer? string?) string? boolean?)) @@ -37973,216 +38374,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta -;;; -------------------------------------------------------------------------------- -;;; symbol-setter - -(let ((p (open-output-string))) - (define e ; save environment for use below - (let ((x 3) ; always an integer - (y 3) ; always 3 - (z 3)) ; report set! - (set! (symbol-setter 'x) (lambda (s v) (if (integer? v) v x))) - (set! (symbol-setter 'y) (lambda (s v) y)) - (set! (symbol-setter 'z) (lambda (s v) (format p "z ~A -> ~A~%" z v) v)) - (set! x 3.3) - (set! y 3.3) - (set! z 3.3) - (curlet))) - (test (and (equal? (e 'x) 3) (equal? (e 'y) 3) (equal? (e 'z) 3.3) - (string=? (get-output-string p) "z 3 -> 3.3\n")) - #t) - (close-output-port p)) - -(for-each - (lambda (arg) - (test (symbol-setter arg) 'error) - (test (set! (symbol-setter _int_) arg) 'error) - (let ((x 1)) - (if (not (null? arg)) - (test (set! (symbol-setter 'x arg) (lambda (s v) 1)) 'error))) - (let ((_x_ 1)) - (set! (symbol-setter '_x_) (lambda (s v) v)) - (set! _x_ arg) - (test _x_ arg))) - (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #(()) (list 1 2 3) '(1 . 2) "hi")) - -(let ((_x_ 1)) - (set! (symbol-setter '_x_) (lambda (s v) v)) - (define _x_ 32) - (test _x_ 32) - (define (_x_) 32) - (test (_x_) 32) - (let ((_x_ 3)) - (test _x_ 3)) - (define (hi _x_) _x_) - (test (hi 4) 4) - (test (do ((_x_ 0 (+ _x_ 1))) ((= _x_ 2) _x_)) 2) - (test ((inlet '_x_ -1) '_x_) -1) - (set! _x_ 32) - (test _x_ 32)) - -(let ((_x_ 1)) - (set! (symbol-setter '_x_) (lambda (s v) #f)) - (define _x_ 32) (test _x_ #f) - (test (set! _x_ 32) #f)) - -(test (symbol-setter) 'error) -(let ((xyzzy 1) - (_int_ 'xyzzy)) - (test (symbol-setter 'xyzzy) #f) - (test (set! (symbol-setter _int_) ()) 'error) - (test (set! (symbol-setter _int_) '(#f)) 'error)) - -(let ((_x1_ #f)) - (set! (symbol-setter '_x1_) (lambda (x y) 'error)) - (test (set! _x1_ 32) 'error)) - -(let ((x 1)) - (set! (symbol-setter 'x) (lambda (s v) x)) - (let ((x 2)) - (set! x 3) - (test x 3) - (set! (symbol-setter 'x (curlet)) (lambda (s v) 32)) - (set! x 1) - (test x 32)) - (test x 1) - (set! x 2) - (test x 1)) - -(let () - (define (f1 x) - (let ((a x) - (b 2) - (c 3)) - (set! (symbol-setter 'b) (lambda (s v) (set! a (+ v c)) v)) - (set! (symbol-setter 'c) (lambda (s v) (set! a (+ b v)) v)) - (set! a (+ b c)) - (set! b (+ b 1)) - (set! c 5) - a)) - (f1 0) - (test (f1 0) 8)) - -(test (symbol-setter :rest) #f) -(test (set! (symbol-setter :allow-other-keys) #f) 'error) - -(let () - (define v_a_r 32) - (let ((x #(1 2 3))) - (set! (symbol-setter 'v_a_r) - (lambda (sym val) - (set! (x 1) val) - (+ val 2)))) - (do ((i 0 (+ i 1))) - ((= i 5)) - (set! v_a_r (+ i 33)) - (test v_a_r (+ i 33 2)) - (gc))) - -(define v_a_r 32) -(let ((x #(1 2 3))) - (set! (symbol-setter 'v_a_r) - (lambda (sym val) - (set! (x 1) val) - (+ val 1)))) -(do ((i 0 (+ i 1))) - ((= i 5)) - (set! v_a_r (+ i 33)) - (test v_a_r (+ i 33 1)) - (gc)) - -(let ((x (vector 1 2 3))) - (let ((y (list 4 5 6))) - (set! (symbol-setter 'v_a_r) - (lambda (sym val) - (+ (x val) (y val))))) - (set! v_a_r 1) - (test v_a_r 7)) -(set! v_a_r 0) -(test v_a_r 5) -(gc) (gc) -(set! v_a_r 2) -(test v_a_r 9) -(gc) (gc) -(let ((err #f)) - (catch #t (lambda () (set! v_a_r 3)) (lambda args (set! err #t))) - (test v_a_r 9) - (if (not err) (format *stderr* "no error in symbol accessor!"))) - -(define v_a_r_1 0) -(let ((v_a_r_1 43) - (x #(1 2 3))) - (set! (symbol-setter 'v_a_r_1) (lambda (sym val) (x val))) - (set! v_a_r_1 0) - (test v_a_r_1 1)) -(catch #t (lambda () (set! v_a_r_1 2)) (lambda args (apply format *stderr* (cadr args)))) -(test v_a_r_1 2) - -(let ((x (vector 1 2 3))) - (let ((y 32)) - (let ((e1 (curlet)) - (y 31)) - (let ((e2 (curlet))) - (set! (symbol-setter 'y e1) - (lambda (sym val) - (+ val (x 1))))) - (set! y 3) - (test y 3)) - (set! y 2) - (test y 4))) - -(let () - (define (symbol-documentation sym e) - (cond ((symbol-setter sym e) => documentation) - (else #f))) - - (define (symbol-signature sym e) - (cond ((symbol-setter sym e) => signature) - (else #f))) ; or car? - - (define (setter sym val e) - (if (integer? val) - val - (symbol->value sym e))) - - (let ((x 3)) - (set! (symbol-setter 'x) setter) - (set! x 4) - (test x 4)) - - (let ((x 5)) - (define setter - (let ((+signature+ '(integer? #t)) - (+documentation+ "x is an integer")) - (lambda (s v e) - (if (integer? v) - v - (symbol->value s e))))) - (let ((x 6)) - (set! (symbol-setter 'x) setter) - (set! x 7) - (test x 7) - (test (symbol-documentation 'x (curlet)) "x is an integer") - (test (symbol-signature 'x (curlet)) '(integer? #t))) - (test x 5))) - -(let ((x (inlet :a 1 :b 2)) - (set1 #f) - (set2 #f)) - (set! (symbol-setter 'a x) - (lambda (s v e) - (set! set1 v) - (+ v 1))) - (set! (symbol-setter 'b x) - (lambda (s v e) - (set! set2 v) - (* v 2))) - (set! (x 'a) 32) - (set! (x 'b) (+ (x 'a) 1)) - (test x (inlet :a 33 :b 68))) - - - ;;; ---------------------------------------- #| ;;; these tests are problematic -- they might not fail as hoped, or they might generate unwanted troubles @@ -38766,8 +38957,8 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (int-vector-set! (car str) 1 2)) str) (f (list (immutable! (int-vector 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (byte-vector-set! (car str) 1 2)) str) (f (list (immutable! (byte-vector 0 1 2))))) 'error) -(test (immutable? (make-shared-vector (immutable! (vector 1 2 3 4)) 1)) #t) -(let ((lst (make-shared-vector (immutable! (vector 1 2 3 4)) 1))) +(test (immutable? (subvector (immutable! (vector 1 2 3 4)) 1)) #t) +(let ((lst (subvector (immutable! (vector 1 2 3 4)) 1))) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (vector-set! lst 1 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "vector-set! immutable ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (fill! lst 32)) (lambda args 'error))) (define (h) (f)) (h)))) @@ -40765,7 +40956,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta ;;; let field writer (let () (define lt (let ((a 1)) - (set! (symbol-setter 'a) + (set! (setter 'a) (lambda (s v) (if (integer? v) v @@ -40793,7 +40984,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (let ((val (catch #t (lambda () (/ 1 0.0)) (lambda args args)))) (with-let (owlet) (test error-type 'division-by-zero) - (test (equal? error-code '(/ 1 0.0)) #t) + (test (or (equal? error-code '(/ 1 0.0)) (equal? error-code '(lambda args args))) #t) (test (list? error-data) #t) (test (string? error-file) #t) (test (integer? error-line) #t) @@ -40817,7 +41008,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (object->let 'abc) (inlet :value 'abc :type 'symbol? :setter #f)) (test (object->let :abc) (inlet :value :abc :type 'keyword? :setter #f)) (test (object->let #\space) (inlet :value #\space :type 'char?)) -(let ((_sym_ 3)) (set! (symbol-setter '_sym_) abs) (test (object->let '_sym_) (inlet :value '_sym_ :type 'symbol? :setter abs))) +(let ((_sym_ 3)) (set! (setter '_sym_) abs) (test (object->let '_sym_) (inlet :value '_sym_ :type 'symbol? :setter abs))) (test (object->let 123) (inlet :value 123 :type 'integer?)) (test (object->let 1/2) (inlet :value 1/2 :type 'rational?)) @@ -40848,13 +41039,13 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (let ((r (random-state 1234))) (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560)))) -(test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :length 3 :dimensions '(3) :shared #f)) -(test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :length 3 :dimensions '(3) :shared #f)) -(test (object->let (float-vector 1 2 3)) (inlet :value (float-vector 1 2 3) :type 'float-vector? :length 3 :dimensions '(3) :shared #f)) -(let ((v (make-shared-vector (vector 1 2 3) 2 1))) - (test (object->let v) (inlet :value (vector 2 3) :type 'vector? :length 2 :dimensions '(2) :shared #(1 2 3)))) +(test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :length 3 :dimensions '(3))) +(test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :length 3 :dimensions '(3))) +(test (object->let (float-vector 1 2 3)) (inlet :value (float-vector 1 2 3) :type 'float-vector? :length 3 :dimensions '(3))) +(let ((v (subvector (vector 1 2 3) 2 1))) + (test (object->let v) (inlet :value (vector 2 3) :type '(subvector? . vector?) :length 2 :dimensions '(2) :position 1 :vector #(1 2 3)))) (test (object->let (make-vector '(2 3 4) #f)) - (inlet :value (make-vector '(2 3 4) #f) :type 'vector? :length 24 :dimensions '(2 3 4) :shared #f)) + (inlet :value (make-vector '(2 3 4) #f) :type 'vector? :length 24 :dimensions '(2 3 4))) (let ((iter (make-iterator '(1 2 3)))) (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence '(1 2 3) :length 3 :position '(1 2 3)))) @@ -40874,6 +41065,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (let ((h (hash-table* :a 1 :b 2))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 2 :locked #f :function 'eq?))) (let ((h (hash-table* 1 1 2 2))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 2 :locked #f :function '=))) (let ((h (make-hash-table 8 string=?))) (test (object->let h) (inlet :value h :type 'hash-table? :length 8 :entries 0 :locked #t :function 'string=?))) +(test ((object->let (make-weak-hash-table)) 'weak) #t) (let ((e (inlet 'a 1 'b 2))) (test (object->let e) (inlet :value e :type 'let? :length 2 :open #f :outlet ()))) (test (object->let (rootlet)) (inlet :value (rootlet) :type 'let? :length (length (rootlet)) :open #f :outlet () :alias 'rootlet)) @@ -41172,6 +41364,23 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta (test (let ((x 1)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (let-temporarily ((x 1234)) (+ x 1)))) (immutable! 'x) (f)) 'error) (test (let () (define (g) (cadr ())) (let ((x #f) (y 0)) (let-temporarily ((x 1234) (y 1/2)) (g)))) 'error) +(let ((__x__ 0) + (f (lambda (sym val) val))) + (set! (setter '__x__) f) + (test (eq? (setter '__x__) f) #t) + (let-temporarily (((setter '__x__) #f)) + (test (setter '__x__) #f)) + (test (eq? (setter '__x__) f) #t)) + +;;; need global symbol test of this also +(define ___x___ 0) +(let ((f (lambda (sym val) val))) + (set! (setter '___x___) f) + (test (eq? (setter '___x___) f) #t) + (let-temporarily (((setter '___x___) #f)) + (test (setter '___x___) #f)) + (test (eq? (setter '___x___) f) #t)) + ;;; -------------------------------------------------------------------------------- @@ -46980,15 +47189,10 @@ hi6: (string-app... (define* (notevery predicate . sequences) (not (apply every predicate sequences))) - (define* (cl-fill sequence item (start 0) end) ; actuall "fill" doesn't collide, but it's confusing + (define* (cl-fill sequence item (start 0) end) ; actually "fill" doesn't collide, but it's confusing (let ((nd (or (and (not (null? end)) end) (length sequence)))) - (if (and (= start 0) - (= nd (length sequence))) - (fill! sequence item) - (do ((i start (+ i 1))) - ((= i nd)) - (set! (sequence i) item))) + (fill! sequence item start nd) sequence)) ;; many of the sequence functions return a different length sequence, but @@ -56302,14 +56506,14 @@ hi6: (string-app... (test (let ((x 1) (y 321)) (<=> x y) (list x y)) (list 321 1)) ) - -;; these added 28-Jan-18 but maybe they're a bad idea -(num-test #xffffffffffffffff -1) -(num-test #x7fffffffffffffff most-positive-fixnum) -(num-test #x7ffffffffffffffe (- most-positive-fixnum 1)) -(num-test #x8000000000000000 most-negative-fixnum) -(num-test #x8000000000000001 (+ most-negative-fixnum 1)) -(num-test #xfffffffffffffffe -2) +(unless with-bignums + ;; these added 28-Jan-18 but maybe they're a bad idea + (num-test #xffffffffffffffff -1) + (num-test #x7fffffffffffffff most-positive-fixnum) + (num-test #x7ffffffffffffffe (- most-positive-fixnum 1)) + (num-test #x8000000000000000 most-negative-fixnum) + (num-test #x8000000000000001 (+ most-negative-fixnum 1)) + (num-test #xfffffffffffffffe -2)) (define (bit-reverse int) ;; from "Hacker's Delight" Henry Warren p101, but 64 bit @@ -56330,8 +56534,8 @@ hi6: (string-app... (let ((x (ash (bit-reverse #x01234566) -32))) (num-test x 1721943168)) - -(test (let () (define (func) ((lambda* ((x 1)) (do ((i 0 (+ i 1))) ((= i 1) 1) (ash x 1234))))) (define (hi) (func)) (hi)) 'error) +(unless with-bignums + (test (let () (define (func) ((lambda* ((x 1)) (do ((i 0 (+ i 1))) ((= i 1) 1) (ash x 1234))))) (define (hi) (func)) (hi)) 'error)) ;; from CL spec (test (let ((str "")) @@ -56811,7 +57015,10 @@ hi6: (string-app... #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (ceiling (atanh (logand))))) (define (hi) (func)) (hi)) 'error) - +(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (ceiling 1.0))) (vector-ref v 0))) (f))) #t) +(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (floor 1.0))) (vector-ref v 0))) (f))) #t) +(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (round 1.0))) (vector-ref v 0))) (f))) #t) +(test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (truncate 1.0))) (vector-ref v 0))) (f))) #t) ;;; -------------------------------------------------------------------------------- @@ -58411,10 +58618,11 @@ hi6: (string-app... ;(if with-bignums (test (= (quotient 2.0 (* 131836323/93222358 131836323/93222358)) ; this should be 1 I think ; (quotient (* 318281039/225058681 318281039/225058681) 2.0)) #f)) (test (= (quotient 131836323/93222358 318281039/225058681) (floor (/ 131836323/93222358 318281039/225058681))) #t) -(if with-bignums (test (= (quotient (* 318281039/225058681 318281039/225058681) 2) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2)) #t)) -(if with-bignums (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f)) -(test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t) -(if with-bignums (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f)) +(when with-bignums + (test (= (quotient (* 318281039/225058681 318281039/225058681) 2) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2)) #t) + (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #t) + (test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t) + (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f)) (if (provided? 'overflow-checks) (test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t)) (test (= (quotient 1855077842/1311738121 4478554083/3166815962) (floor (/ 1855077842/1311738121 4478554083/3166815962))) #t) @@ -58924,12 +59132,13 @@ hi6: (string-app... (test (= (remainder (* 3880899/2744210 3880899/2744210) 2) (remainder (* 9369319/6625109 9369319/6625109) 2)) #f) (test (= (remainder 2.0 (* 3880899/2744210 3880899/2744210)) (remainder (* 9369319/6625109 9369319/6625109) 2.0)) #f) (test (= (remainder 3880899/2744210 9369319/6625109) (floor (/ 3880899/2744210 9369319/6625109))) #f) -(test (= (remainder (* 54608393/38613965 54608393/38613965) 2) (remainder (* 131836323/93222358 131836323/93222358) 2)) #f) -(test (= (remainder 2.0 (* 54608393/38613965 54608393/38613965)) (remainder (* 131836323/93222358 131836323/93222358) 2.0)) #f) -(test (= (remainder 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #f) -(if with-bignums (test (= (remainder (* 318281039/225058681 318281039/225058681) 2) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2)) #f)) -(if with-bignums (test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f)) -(if with-bignums (test (= (remainder 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #f)) +(when with-bignums + (test (= (remainder 2.0 (* 54608393/38613965 54608393/38613965)) (remainder (* 131836323/93222358 131836323/93222358) 2.0)) #t) + (test (= (remainder 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #f) + (test (= (remainder (* 318281039/225058681 318281039/225058681) 2) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2)) #f) + (test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #t) + (test (= (remainder 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #f) + (test (= (remainder (* 54608393/38613965 54608393/38613965) 2) (remainder (* 131836323/93222358 131836323/93222358) 2)) #f)) (num-test (+ (remainder 23/3 3/2) (* 3/2 (quotient 23/3 3/2))) 23/3) (num-test (+ (remainder 29/8 17/12) (* 17/12 (quotient 29/8 17/12))) 29/8) @@ -58976,13 +59185,13 @@ hi6: (string-app... (test (= (remainder (* 4478554083/3166815962 4478554083/3166815962) 2) (remainder (* 10812186007/7645370045 10812186007/7645370045) 2)) #f) (test (= (remainder 2.0 (* 4478554083/3166815962 4478554083/3166815962)) - (remainder (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #f) + (remainder (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #t) (test (= (remainder 367296043199/259717522849 886731088897/627013566048) (floor (/ 367296043199/259717522849 886731088897/627013566048))) #f) (test (= (remainder (* 5168247530883/3654502875938 5168247530883/3654502875938) 2) (remainder (* 12477253282759/8822750406821 12477253282759/8822750406821) 2)) #f) (test (= (remainder 2.0 (* 423859315570607/299713796309065 423859315570607/299713796309065)) - (remainder (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2.0)) #f) + (remainder (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2.0)) #t) (test (= (remainder 2.0 (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268)) (remainder (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118) 2.0)) #f) (test (= (remainder 34761632124320657/24580185800219268 202605639573839043/143263821649299118) @@ -61383,7 +61592,7 @@ hi6: (string-app... (let-temporarily (((*s7* 'default-rationalize-error) 1e-11)) (test (rationalize 1.000000056443638e-12) 0) (set! (*s7* 'default-rationalize-error) 1e-12) - (test (rationalize 1.000000056443638e-12) 0)) + (test (rationalize 1.000000056443638e-12) (if with-bignums 1/499999985890 0))) ;;; Bill Gosper's farint: @@ -63644,8 +63853,9 @@ hi6: (string-app... (test (= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f) (test (= -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f) -(test (= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f) -(test (= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f) +(when with-bignums + (test (= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #t) + (test (= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #t)) (test (= 9223372036854775807 -9223372036854775808) #f) (test (= 9223372036854775807 9223372036854775807) #t) (test (= (* most-negative-fixnum 1) (- (* -1 most-positive-fixnum) 1)) #t) @@ -63670,18 +63880,19 @@ hi6: (string-app... (test (= most-positive-fixnum most-positive-fixnum) #t) ;; these are a mess -- they depend on optimizer choices, etc -(test (= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f) -(test (= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f) -(test (= 1 1.0 9223372036854775806/9223372036854775807) #f) -(test (= 9223372036854775806/9223372036854775807 1.0 1) #f) -(test (= 9223372036854775806/9223372036854775807 1.0) #f) -(test (= 1.0 9223372036854775806/9223372036854775807) #f) -(test (= 1 1.0 9223372036854775807/9223372036854775806) #f) -(test (= 9223372036854775807/9223372036854775806 1.0 1) #f) -(test (= 9223372036854775807/9223372036854775806 1.0) #f) -(test (= 1.0 9223372036854775807/9223372036854775806) #f) -;(test (= 1.0 9223372036854775807/9223372036854775806) (= 9223372036854775807/9223372036854775806 1.0)) -;(test (= (* 397573379/630138897 1.0) 4201378396/6659027209) (= 4201378396/6659027209 (* 397573379/630138897 1.0))) +(when with-bignums + (test (= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #t) + (test (= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #t) + (test (= 1 1.0 9223372036854775806/9223372036854775807) #t) + (test (= 9223372036854775806/9223372036854775807 1.0 1) #t) + (test (= 9223372036854775806/9223372036854775807 1.0) #t) + (test (= 1.0 9223372036854775806/9223372036854775807) #t) + (test (= 1 1.0 9223372036854775807/9223372036854775806) #t) + (test (= 9223372036854775807/9223372036854775806 1.0 1) #t) + (test (= 9223372036854775807/9223372036854775806 1.0) #t) + (test (= 1.0 9223372036854775807/9223372036854775806) #t) + (test (= 1.0 9223372036854775807/9223372036854775806) (= 9223372036854775807/9223372036854775806 1.0)) + (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) (= 4201378396/6659027209 (* 397573379/630138897 1.0)))) (test (= (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f) (test (= (* 10400200/16483927 1.0) 10781274/17087915) #f) @@ -63703,10 +63914,11 @@ hi6: (string-app... (test (= (* 2/3 1.0) 5/8) #f) (test (= (* 253/401 1.0) (* 665/1054 1.0)) #f) (test (= (* 253/401 1.0) 665/1054) #f) -(if with-bignums (test (= (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #f)) -(test (= (* 397573379/630138897 1.0) 4201378396/6659027209) #f) -(if with-bignums (test (= (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f)) -(test (= (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f) +(when with-bignums + (test (= (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #t) + (test (= (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #t) + (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) #t) + (test (= (* 4201378396/6659027209 1.0) 6189245291/9809721694) #t)) (test (= (* 5/8 1.0) (* 12/19 1.0)) #f) (test (= (* 5/8 1.0) 12/19) #f) (test (= (* 53/84 1.0) (* 253/401 1.0)) #f) @@ -63738,10 +63950,9 @@ hi6: (string-app... (test (= 665/1054 12941/20511) #f) (test (= 7161071/11350029 10400200/16483927) #f) (test (= 79335/125743 190537/301994) #f) -(test (= 10.000000000 10.000000000000001) #f) +(unless with-bignums (test (= 10.000000000 10.000000000000001) #f)) (when with-bignums - (test (= 10.000000000 10.0000000000000001) #f) (test (= 8388608.9999999995 8388609) #f) (test (= (* 1.0 16743730547042864/1996007985) 8388609) #f) (test (= (* 1.0 13981015002796202/1666666667) 8388609) #f) @@ -76950,8 +77161,9 @@ hi6: (string-app... (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)) -(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error) -(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 2) (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error) +(unless with-bignums + (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error) + (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 2) (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error)) @@ -78057,22 +78269,13 @@ hi6: (string-app... (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp))) - 6)) ; (6 - 1/(1+(6/5)^k)) - 0.00001) + 100.0)) + .00001) #t)) ;; in floats this heads for 100: ;; (do ((x0 (exact->inexact 11/2)) (x1 (exact->inexact 61/11)) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp))) -#| -in gmp case we get: -:(+ 8388608 .00000001) -8388608.0 -but it's the printout that is at fault: -:(- (+ 8388608 .000000001) 8388608) -1.862645149231e-09 -|# - (when with-bignums (num-test (+ 0.999999995 8388608) 8388608.999999995) (num-test (+ (+ 1.0e-30 1.0e30) -1.0e30) (+ 1.0e-30 (+ 1.0e30 -1.0e30))) @@ -84047,7 +84250,7 @@ etc (test (intersection list '(1 2 3) #()) ()) (test (intersection list '(1 2 3) #(4 5 1 9)) '(1)) ; pair: unbound variable (num-test ((intersection float-vector '(1 2 3) #(4 5 1 9 3)) 0) 1.0) - (test (intersection (lambda x (make-shared-vector (apply vector x) '(2 2))) '(1 2 3 4 5) #(4 5 1 9 3)) #2d((1 3) (4 5))) + (test (intersection (lambda x (subvector (apply vector x) '(2 2))) '(1 2 3 4 5) #(4 5 1 9 3)) #2d((1 3) (4 5))) (when with-block (test (block? (intersection block '(1.0 2.0) #(1.0))) #t) (test (block? (intersection block (block 1.0 2.0) #(2.0))) #t)) @@ -84311,7 +84514,7 @@ etc ((null? setter) (reverse result)) (if (car setter) - (set! result (cons `(set! (symbol-setter (quote ,(caar var)) ,glet) (list-ref ,gsetters ,i)) result)))) + (set! result (cons `(set! (setter (quote ,(caar var)) ,glet) (list-ref ,gsetters ,i)) result)))) ,glet))) (let ((lt (inlet/setter (a 1) (b 2 (lambda (s v) (+ v 1)))))) @@ -84375,6 +84578,7 @@ etc (test (n-choose-k 4 1) 4) (test (n-choose-k 4 0) 1) + (load "reactive.scm") (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9) (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14) (test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6) @@ -84382,25 +84586,26 @@ etc (test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6) (test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6) (test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6) - (test (let ((nv 21) (sym 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv) 6) + (test (let ((outer 0)) (let ((nv 21) (sym 1)) (let ((inner 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv))) 6) (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5)) (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19)) - (test (let ((a 21) (b 1)) (set! (symbol-setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 12) - (test (let ((a 21) (b 1)) (set! (symbol-setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6) + (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14) (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3)) (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3)) - (test (let ((a 1) (v (vector 1 2 3))) (reactive-set! (v 1) (* a 3)) (set! a 4) v) #(1 12 3)) - - (test (let ((a 1)) (let ((v (reactive-vector a (+ a 1) 2))) (set! a 4) v)) #(4 5 2)) - (test (let* ((a 1) (v (reactive-vector a (+ a 1) 2))) (set! a 4) v) #(4 5 2)) - (test (let* ((a 1) (v (reactive-vector a (+ a 1) (* 2 (_ 0))))) (set! a 4) (v 'value)) #(4 5 8)) - (test (let ((v (let ((a 1)) (reactive-vector a (+ a 1) (* 2 (_ 0)))))) (set! (v 0) 3) (v 'value)) #(3 2 6)) - - ;; unfortunately, reactive-set! does not clear out dead symbol-setters: - ;; (let ((a 1) (b 2)) (let ((c 3)) (reactive-set! b (* a c))) (let ((c 4)) (reactive-set! b (+ a 1)) (set! a 5)) (list a b)) - ;; complains about unbound curlet gensym because the let it is defined in has been exited but the function still sits on the accessor - + + (test (let ((a 1) (x 0)) (reactive-set! x (* a 2)) (reactive-set! a (* x 2)) (set! x 2) a) 4) + (test (let ((a 1)) (let ((b 0) (c 0)) (reactive-set! b (* a 2)) (reactive-set! c (* a 3)) (let ((x 0)) (reactive-set! x (+ a b c)) (set! a 2) x))) 12) + (test (let ((x 0)) (let ((a 1)) (reactive-set! x (* 2 a)) (set! a 2)) x) 4) + + (test (let ((x 0) (a 1)) (reactive-set! x (+ a 1)) (reactive-set! a (+ x 2)) (set! a 3) (set! x 4) (list x a)) (list 4 6)) + (test (let ((x 0) (a 1) (b 0)) (reactive-set! x (+ a 2)) (let ((x 2)) (reactive-set! x (+ a 1)) (set! a 4) (set! b x)) (list x a b)) (list 6 4 5)) + (test (let ((x 0)) (reactive-set! x (* 3 2)) x) 6) + (test (let ((x 0)) (reactive-set! x (* pi 2)) x) (* pi 2)) + (test (let ((x 0)) (let ((a 1)) (reactive-set! x a) (set! a 2)) x) 2) + (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 6) ; old setter ignored + (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6) + (test (reactive-let () 3) 3) (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2) (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7) @@ -84412,7 +84617,7 @@ etc (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4) (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10) (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11) - (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (symbol-setter 'a)) #f) + ;(test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (setter 'a)) #f) (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11) (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13) ;c=4 because it watches the outer b (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10) @@ -84423,48 +84628,17 @@ etc (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3) (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86) (num-test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0)) - (num-test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0)) - (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6)) (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3)) - (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9)) (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9)) (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6)) (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8)) (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15) - ;; (let ((a 1)) (define (set-a x) (set! a x)) (reactive-let ((b (* a 2))) (set-a 3) b)) -> b is still 2 - ;; we can't see the outer set! without changing the outer accessor - ;; even: (rlet ((a 1)) (define (set-a x) (set! a x)) (rlet ((b (* a 2))) (set-a 3) b)) -> 2 - ;; (let ((a 1)) (define (set-a x e) (set! (e 'a) x)) (rlet ((b (* a 2))) (set-a 3 (curlet)) b)) -> 6 - ;; (let ((a 1)) (define-macro (set-a x) `(set! a ,x)) (rlet ((b (* a 2))) (set-a 3) b)) -> 6 - - ;; reactive-set! places an accessor but never removes it -- dangling refs eventually - - (let ((max-stack 0)) - (define (tc-1 a c) - (reactive-let ((b (+ a 1))) - (if (> (-s7-stack-top-) max-stack) - (set! max-stack (-s7-stack-top-))) - (if (< b c) - (tc-1 b c)))) - (tc-1 0 32) - (if (> max-stack 12) (format *stderr* ";reactive-let tc max: ~D~%" max-stack))) - - (test (let ((a 1)) (reactive-let* ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ c b))) 12) - (test (let ((a 1)) (reactive-let* ((b (+ a 1))) (set! a 3) b)) 4) - (test (reactive-let* ((a 1) (b (* a 2))) (set! a 3) b) 6) - - (let ((max-stack 0)) - (define (tc-2 a c) - (reactive-let* ((b (+ a 1))) - (if (> (-s7-stack-top-) max-stack) - (set! max-stack (-s7-stack-top-))) - (if (< b c) - (tc-2 b c)))) - (tc-2 0 32) - (if (> max-stack 12) (format *stderr* ";reactive-let* tc max: ~D~%" max-stack))) - + (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9)) + (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6)) + (num-test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0)) +#| (let ((e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet)))) ; constant let (test (set! (e 'a) 32) 1) (set! (e 'b) 12) @@ -84490,7 +84664,7 @@ etc (num-test (f1 3.0) 21.0) (set! B 4.0) (num-test (f1 3.0) 14.0))) - +|# (let ((lst ())) (call-with-input-vector (vector 1 2 3 4) @@ -84555,7 +84729,7 @@ etc ;; sandbox (test (sandbox '(+ 1 2)) 3) - (test (sandbox '(let ((x (floor pi))) (+ x 1))) 4) +; (test (sandbox '(let ((x (floor pi))) (+ x 1))) 4) (test (sandbox '(+ 1 x)) "error: x: unbound variable") ; (test (sandbox '(let ((p (open-output-string))) (display (+ 2 3) p) (get-output-string p))) "5") (test (sandbox '(begin (define-macro (_mx_ x) `(+ ,x 1)) (_mx_ 2))) 3) @@ -85674,6 +85848,16 @@ etc (define-expansion (__exp1__) (values 1 2 3)) +(test + (begin + (reader-cond + ((> pi 3) + (reader-cond + ((= pi 3) #f) + ((not (= pi 3)) 32))) + (else #f))) + 32) + #| (let () (test (abs (+ 2 -3)) (+ 1)) @@ -86094,7 +86278,7 @@ etc (test (assv 1 (openlet (inlet 'c '((1 2)) 'assv (baser-method assv)))) '(1 2)) (test (assq 1 (openlet (inlet 'c '((1 2)) 'assq (baser-method assq)))) '(1 2)) (test (rationalize 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'rationalize (baser-method rationalize)))) 0) - (test (make-shared-vector #(1 2) (openlet (inlet 'c '(1) 'make-shared-vector (baser-method make-shared-vector)))) #(1)) + (test (subvector #(1 2) (openlet (inlet 'c '(1) 'subvector (baser-method subvector)))) #(1)) ;(test (string>=? #u8(52 53 104 105 53) (openlet (inlet 'c #u8(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t) ;(test (string<=? #u8(52 53 104 105 53) (openlet (inlet 'c #u8(52 53 104 105 53) 'string<=? (baser-method string<=?)))) #t) ;(test (fill! #u8(97 97 97 97 97) (openlet (inlet 'c 120 'fill! (baser-method fill!)))) 120) @@ -86199,7 +86383,7 @@ etc (set! (v i) i)) (test (v 'value) #(0 1 2 3 4 5 6 7 8 9)) (for-each (lambda (x) (test (integer? x) #t)) v) - (let ((v1 (make-shared-vector v '(3) 2))) + (let ((v1 (subvector v '(3) 2))) (test v1 #(2 3 4))) (sort! v >) (test (v 'value) #(9 8 7 6 5 4 3 2 1 0)) @@ -86672,7 +86856,7 @@ etc (test (gcd i 0 x) 'error) (test (gcd 9 0 r) 3/2) - (test (<= nan.0 (mock-number 1)) #f) + (unless with-bignums (test (<= nan.0 (mock-number 1)) #f)) (test (<= 1 (mock-number 1)) #t) (test (<= 1 (mock-number 1+i)) 'error) (test (vector-ref #(0 1) (mock-number 0)) 0) @@ -86692,7 +86876,7 @@ etc (test (s index) #\2) (test (p index) 2) (test (v index) 2) - (test (make-shared-vector #(0 1 2 3) '(3) (mock-number 1)) #(1 2 3)) + (test (subvector #(0 1 2 3) '(3) (mock-number 1)) #(1 2 3)) (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2)) (test (list-tail p index) '(2 3 4)) (test (substring "01234" index) "234") @@ -86852,7 +87036,7 @@ etc (test (lst 0) 4) (test (list-tail lst 0) '(4 2 3)) (for-each (lambda (x) (if (not (integer? x)) (format *stderr* ";for-each mock-pair: ~A~%" x))) (mock-pair 1 2 3)) - (test (make-shared-vector #(0 1 2 3) (mock-pair 2)) #(0 1)) + (test (subvector #(0 1 2 3) (mock-pair 2)) #(0 1)) (test (caar (apply mock-pair '((a) b c d e f g))) 'a) (test (cadr (apply mock-pair '(a b c d e f g))) 'b) (test (cdar (apply mock-pair '((a b) c d e f g))) '(b)) @@ -86958,8 +87142,7 @@ etc (test (symbol->dynamic-value sym) 32) (test (defined? sym) #t) (test (symbol->keyword sym) :a) - (test (provided? sym) #f) - (test (symbol-setter sym) #f))) + (test (provided? sym) #f))) (let ((sym (mock-symbol :a))) (test (keyword? sym) #t) (test (keyword->symbol sym) 'a)) @@ -87287,7 +87470,7 @@ etc (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) ''abs f1)) - (list 'symbol->dynamic-value 'symbol->keyword 'symbol->string 'symbol->value 'symbol-setter 'symbol?)) + (list 'symbol->dynamic-value 'symbol->keyword 'symbol->string 'symbol->value 'symbol?)) (for-each (lambda (f1) @@ -87424,7 +87607,7 @@ etc 'close-output-port (lambda (p) p) 'flush-output-port (lambda (p) p) 'write-string (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))))) - (make-shared-vector v (list i)))) + (subvector v (list i)))) (let ((lst ())) (call-with-input-vector (vector 1 2 3 4 5) @@ -87570,9 +87753,12 @@ etc (test (eqv? goto goto) #t) (test (object->string goto :readable) "goto")) ; an error perhaps?? -(let ((dyn (caar (dynamic-wind (lambda () #f) (lambda () (*s7* 'stack)) (lambda () #f))))) - (test (object->string dyn :readable) "#<dynamic-wind>") - (test (eq? dyn dyn) #t)) +(catch #t + (lambda () + (let ((dyn (caar (dynamic-wind (lambda () #f) (lambda () (*s7* 'stack)) (lambda () #f))))) + (test (object->string dyn :readable) "#<dynamic-wind>") + (test (eq? dyn dyn) #t))) + (lambda args #f)) (let-temporarily (((*s7* 'default-hash-table-length) 31) ((*s7* 'hash-table-float-epsilon) 1e-4) @@ -87720,7 +87906,6 @@ etc ;(test (let () (define (hi) (let ((cond 3)) (set! cond 4) cond)) (hi)) 4) ;(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6) - (let () (define (freef) (local-func 0)) (test (freef) 'error) @@ -87742,6 +87927,53 @@ etc (test (freeg) 2) (test (freeh) 2)) +(let () ; new_s7_optimize + (define (f1) + (do ((i 0 (+ i 1))) + ((= i 10)) + (if (< i 0) (format *stderr* "oops~%")))) + + (f1) ; opt_dotimes create/store + (f1) ; opt_dotimes restore + + (define (f2 seq item start end) + (do ((i start (+ i 1))) + ((= i end)) + (set! (seq i) item))) + + (f2 (list 1 2 3) 4 0 3) ; opt_dotimes create/store + (f2 (vector 1 2 3) 4 0 3) ; opt_dotimes fallback + + (define (f3) + (do ((i 0 (+ i 1)) + (j 0 (+ j 1))) + ((= i 10)) + (if (not (= i j)) (format *stderr* "oops~%")))) + + (f3) ; dox_ex create/store + (f3) ; dox_ex restore + + (define (f4) + (let ((v (make-vector 10))) + (do ((i 0 (+ i 1))) + ((= i 10)) + (vector-set! v i i)))) + + (f4) ; simple_do_ex create/store + (f4) ; simple_do_ex restore + + (define (f5 x) + (let ((y 0)) + (do ((i 0 (+ i 1)) + (j 0 (+ j 1))) + ((= i 10)) + (set! y (+ i x))))) + + (f5 0) + (f5 2) + (f5 1/2) ; dox_ex fallback + (f5 pi)) + ;;; bizarre optimizer checks (test (let () (define (func x) (if (pair? (cdr /)) 3)) (define (hi) (func (integer->char 255))) (catch #t (lambda () (hi) (func (integer->char 255))) (lambda arg #f))) #f) (test (catch #t (lambda () (define (func x) (cond (case `((1)) (if x y) =>))) (define (hi) (func ())) (hi)) (lambda args 'error)) 'error) @@ -87819,7 +88051,8 @@ etc (test (let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))) )) 3))) (define (hi) (func #f)) (hi)) 6) ;! (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(immutable? )))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (hi)) 'error) -(test (vector-ref (vector abs log) 0 -1) 1) ; weird... +(test ((vector abs log) 0 -1) 1) ; weird... +(test (vector-ref (vector abs log) 0 -1) 'error) (test (let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format `((x)) (list 1) cons else (read (string-append /))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (hi)) 'error) @@ -88154,6 +88387,13 @@ etc (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) (round pi) (round pi) (round pi))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (_do1_ (char-position #\delete ims -123))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (do () ((not false) (tree-memq (values #\c 3 1.2) (vector-dimensions (block)))))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count ((lambda (a) (values a (+ a 1))) 2) (vector-dimensions (block)))))) (define (hi) (func)) (hi)) 'error) +(test (let () (define (func x i) (float-vector-set! x i (catch #t (lambda () (float-vector-ref x i)) (lambda args 'error)))) (define (hi) (func #r(1 2 3) 3)) (hi)) 'error) +(test (let () (define (func) (append (values "" (block)) (list :go))) (define (hi) (func)) (hi)) 'error) ; plist clobbered + +(test (let () (define (func) (undefined? (list-ref (list #f (make-iterator (list #f))) 1 ()))) (define (hi) (func)) (hi)) 'error) ; safe_c_opaaaq sc->code != code bug + (let () ; (copy func) after func use -- clearing all opts is a problem, here OP_IF -> OP_IF_IS_TYPE needs to be reset (define h->a (let ((+documentation+ "(h->a table) returns the contents of table as an association list:\n\ @@ -92329,7 +92569,7 @@ etc (lint-test "(for-each (lambda (x) (+ (abs x) 1)) lst)" " for-each: pointless for-each: (for-each (lambda (x) (+ (abs x) 1)) lst)") (lint-test "(for-each x #\\a)" " for-each: in (for-each x #\\a), for-each's argument 2 should be a sequence, but #\\a is a char?") (lint-test "(map f (cdr (vector->list v)))" - " map: map accepts vector arguments, so perhaps (cdr (vector->list v)) -> (make-shared-vector v (- (length v) 1) 1)") + " map: map accepts vector arguments, so perhaps (cdr (vector->list v)) -> (subvector v (- (length v) 1) 1)") (lint-test "(for-each f (list-tail (string->list str) x))" " for-each: for-each accepts string arguments, so perhaps (list-tail (string->list str) x) -> (substring str x)") (lint-test "(map char-downcase (string->list str))" @@ -96078,7 +96318,6 @@ etc " cond: (number? x) makes (integer? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1)) cond: (list? x) makes (pair? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1)) (r5rs list? is proper-list? in s7)") - (lint-test "(set! (symbol-setter 'x) (lambda () 21))" " set!: symbol-setter function should take 2 arguments: (set! (symbol-setter 'x) (lambda () 21))") (lint-test "(cond-expand (s7 (define (f x) (* x 23))) (else))" "") (lint-test "(cond-expand (s7))" " cond-expand: pointless cond-expand: (cond-expand (s7))") (lint-test "(cond-expand ((or s7 guile)))" " cond-expand: pointless cond-expand: (cond-expand ((or s7 guile)))") @@ -96223,17 +96462,19 @@ etc " func: unexpected dot: (or . 1nani) func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure? hi: func's parameter 1 is not used, but a value is passed: (make-hook '(0 0 #f))") - (lint-test "(define (func x) (case x ((else) (char>? 11/(symbol-setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))" - " func: in (char>? 11/ (symbol-setter)), - char>?'s argument 2 should be a char, but (symbol-setter) is a boolean or a procedure? - func: symbol-setter needs at least 1 argument: (symbol-setter) - func: load has too many arguments: (load - -1 3/4) - func: in (load - -1 3/4), load's argument 1 should be a string, but - is a procedure? - func: in (load - -1 3/4), load's argument 2 should be a let, but -1 is an integer? - func: perhaps (- -1 3/4) -> -7/4 - func: in (positive? (format 0 (inlet (make-list)))), - positive?'s argument should be real, but (format 0 (inlet (make-list))) is a string or a boolean? - func: make-list needs at least 1 argument: (make-list)") + (lint-test "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))" + " func (line 0): in (char>? 11/ (setter)), + char>?'s argument 2 should be a char, but (setter) is a boolean or a procedure? + func (line 0): setter needs at least 1 argument: (setter) + func (line 0): load has too many arguments: (load - -1 3/4) + func (line 0): in (load - -1 3/4), + load's argument 1 should be a string, but - is a procedure? + func (line 0): in (load - -1 3/4), + load's argument 2 should be a let, but -1 is an integer? + func (line 0): perhaps (- -1 3/4) -> -7/4 + func (line 0): in (positive? (format 0 (inlet (make-list)))), + positive?'s argument should be real, but (format 0 (inlet (make-list))) is a string or a boolean? + func (line 0): make-list needs at least 1 argument: (make-list)") (lint-test "(zero? (system str))" "") (lint-test "(define (func x) (if (- 2(+)) (lambda 1.)))" " func: if test is never false: (if (- 2 (+)) (lambda 1.0)) @@ -96378,7 +96619,7 @@ etc (glint "(define (func x) (lambda* (lambda args args) . -1))") (glint "(define (func x) (if (or . set!) (sublet 2)))") (glint "(define (func x) (if (or . 1+0/0i) (caaddr (caaadr /)))) (define (hi) (func (make-hook '(0 0 #f))))") - (glint "(define (func x) (case x ((else) (char>? 11/(symbol-setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))") + (glint "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))") (glint "(define (func x) (if (- 2(+)) (lambda 1.)))") (glint "(define (func x) (when 0 1+0/0i `((+ x 1)) => . with-let))") (glint "(define (func x) (if (string-ci>=?) (dilambda? (char-numeric? 20+)) (* 1 enver quasiquote 0+0/0i /0/01(/))))") @@ -96561,7 +96802,7 @@ etc (glint "(gc i/(case 1 (integer->char 255) (else ())))") (glint "(list->string +(flush-output-port (case //2- (list 1) (else ()))))") (glint "(cond (((+ x 1))) (else ()) (flush-output-port))") - (glint "(even? /(make-shared-vector 0-(list->string 1(cond ((i 0 (+ i 1))) ((x . 1) . 2) (#t ())))))") + (glint "(even? /(subvector 0-(list->string 1(cond ((i 0 (+ i 1))) ((x . 1) . 2) (#t ())))))") (glint "(cond ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))") (glint "(cons +1.(list 02/ (pi 0) `(+ ,a ,@b) ((null? i) i) 2201))") (glint "(let* / ((1)) (unless (unless '((())) x y z 1+0/0i most-negative-fixnum /)))") @@ -96643,74 +96884,6 @@ etc (error 'wrong-type-arg "~A: ~A is not an integer" f321 int))))) (lint-test "(string-ref (f321 3) 2)" " string-ref: in (string-ref (f321 3) 2), string-ref's argument 1 should be a string, but (f321 3) is a float?") - (when full-test - ;; boolean reductions partly tested above, +nan.0 confuses zero? et al - - (define args (list - "#f" "#t" "#u8(0)" "(c-pointer 0)" "#\\a" "#\\newline" - "#\\A" "#\\1" "#\\space" - "1+i" ":constant" "(call/cc (lambda (cc) cc))" "'abs" "(dilambda (lambda () 0) (lambda (val) val))" "\"/home/bil/zap/tmp\"" - "#<eof>" "2" - "\"/home/bil/cl/s7test.scm\"" "#r(0)" "#i(0)" "pi" "(gensym)" "(hash-table)" - "+inf.0" "+nan.0" "*stdin*" "*stdout*" "0" "(make-iterator ())" - "(curlet)" "(list 1 2)" "quasiquote" - "()" "-1" "(openlet (inlet 'a 1))" - "(call-with-input-string \"\" (lambda (p) p))" "abs" "'dlopen" - "(random-state 1234)" "1/2" "\"string\"" - "lambda" "(let ((L (list 1))) (set-cdr! L L) L)" "#<undefined>" "#<unspecified>" "#(0)")) - - (define blint-test - (lambda (str1) - (let ((result (call-with-output-string - (lambda (op) - (call-with-input-string str1 - (lambda (ip) - (lint ip op))))))) - ;; so str1 and result applied to any two types should give the same answer - (when (and (string? result) - (positive? (length result))) - (let ((pos (string-position " -> " result))) - (when (integer? pos) - (call-with-exit - (lambda (quit) - (for-each - (lambda (a) - (catch #t - (lambda () - (let ((v1 (eval-string (string-append "(let ((x " a ")) " str1 ")"))) - (v2 (eval-string (string-append "(let ((x " a ")) " (substring result (+ pos 4)) ")")))) - (unless (or (eq? v1 v2) - (and (eq? v1 #t) (pair? v2) (equal? x (car v2)))) - (format *stderr* "x: ~A~% ~A -> ~S~% ~A -> ~S~%" a str1 v1 (substring result (+ pos 4) (- (length result) 1)) v2) - (quit)))) - (lambda () #f))) - args))))))))) - - (define bools '(boolean? byte-vector? c-pointer? char-alphabetic? - char-lower-case? char-numeric? char-ready? char-upper-case? char-whitespace? - complex? constant? continuation? defined? dilambda? directory? eof-object? even? exact? - file-exists? float-vector? float? gensym? hash-table? - immutable? inexact? infinite? input-port? int-vector? integer? iterator-at-end? iterator? - keyword? let? list? macro? - nan? negative? not null? number? odd? openlet? output-port? - pair? port-closed? positive? procedure? proper-list? provided? - random-state? rational? real? sequence? - string? symbol? syntax? tree-cyclic? undefined? unspecified? vector? zero?)) - - (for-each - (lambda (t1) - (for-each - (lambda (t2) - (blint-test (format #f "(and (~A x) (~A x))" t1 t2)) - (blint-test (format #f "(and (~A x) (not (~A x)))" t1 t2)) - (blint-test (format #f "(and (not (~A x)) (~A x))" t1 t2)) - - (blint-test (format #f "(or (~A x) (~A x))" t1 t2)) - (blint-test (format #f "(or (~A x) (not (~A x)))" t1 t2)) - (blint-test (format #f "(or (not (~A x)) (~A x))" t1 t2))) - bools)) - bools)) - (set! reader-cond #f)) ;;; end lint @@ -97379,7 +97552,7 @@ in non-gmp, #| (for-each (lambda (s) - (if (and (symbol-setter s) + (if (and (setter s) (not (char=? #\* ((symbol->string s) 0)))) (format *stderr* "~A " s))) (symbol-table)) @@ -330,16 +330,17 @@ ;; (* (float-vector-ref target-radii j) (float-vector-ref radii-pole-gains j))))) )) ;; set tract shape - (do ((tj 1.0) - (tk 0.0) - (k 0 (+ k 1)) - (j 1 (+ j 1))) - ((= j tractlength)) - (set! tk tj) - (set! tj (if (zero? (float-vector-ref radii j)) - 1e-10 - (* (float-vector-ref radii k) (float-vector-ref radii k)))) - (float-vector-set! coeffs j (/ (- tk tj) (+ tk tj)))) + (let ((tj 1.0) + (tk 0.0)) + (do ((k 0 (+ k 1)) + (j 1 (+ j 1))) + ((= j tractlength)) + (begin + (set! tk tj) + (if (zero? (float-vector-ref radii j)) + (set! tj 1e-10) + (set! tj (* (float-vector-ref radii k) (float-vector-ref radii k)))) + (float-vector-set! coeffs j (/ (- tk tj) (+ tk tj)))))) (set! glot-refl-gain (radii tractlength-1)) (set! lip-refl-gain (radii tractlength)) @@ -4145,7 +4145,7 @@ static void display_channel_data_with_size(chan_info *cp, * surface = cairo_get_target(ss->cr); * fprintf(stderr, "status: %d ", cairo_surface_status(surface)); * } - * if prints 0 (success), and then dies! I can't trace it in gdb because the goddamn gtk idle + * if prints 0 (success), and then dies! I can't trace it in gdb because the gtk idle * mechanism gets confused. I can't ask cairo if the surface is finished. valgrind is happy. * cairo-trace shows nothing unusual. cairo 1.8.0 is happy. * I am stuck. @@ -10312,101 +10312,101 @@ If it returns " PROC_TRUE ", the key press is not passed to the main handler. 's mix_click_hook = Xen_define_hook(S_mix_click_hook, "(make-hook 'id)", 1, H_mix_click_hook); #if HAVE_SCHEME - s7_symbol_set_documentation(s7, ss->show_transform_peaks_symbol, "*" S_show_transform_peaks "* determines whether fft displays include a peak list"); - s7_symbol_set_documentation(s7, ss->show_y_zero_symbol, "*show-y-zero*: #t if Snd should include a line at y = 0.0"); - s7_symbol_set_documentation(s7, ss->show_marks_symbol, "*show-marks*: #t if Snd should show marks"); - s7_symbol_set_documentation(s7, ss->show_grid_symbol, "*show-grid*: #t if Snd should display a background grid in the graphs"); - s7_symbol_set_documentation(s7, ss->fft_log_frequency_symbol, "*fft-log-frequency*: #t if fft displays use log on the frequency axis"); - s7_symbol_set_documentation(s7, ss->fft_log_magnitude_symbol, "*fft-log-magnitude*: #t if fft displays use dB"); - s7_symbol_set_documentation(s7, ss->fft_with_phases_symbol, "*fft-with-phases*: #t if fft displays include phase info"); - s7_symbol_set_documentation(s7, ss->sync_style_symbol, "*sync-style*: determines how channels are grouped when a sound is opened."); - s7_symbol_set_documentation(s7, ss->show_axes_symbol, "*show-axes*: If show-all-axes, display x and y axes; if show-x-axis, just one axis (the x axis) is displayed. The other choices are show-no-axes, show-all-axes-unlabelled, show-x-axis-unlabelled, and show-bare-x-axis."); - s7_symbol_set_documentation(s7, ss->with_verbose_cursor_symbol, "*with-verbose-cursor*: #t if the cursor's position and so on is displayed in the status area"); - s7_symbol_set_documentation(s7, ss->spectro_x_scale_symbol, "*spectro-x-scale*: scaler (stretch) along the spectrogram x axis (1.0)"); - s7_symbol_set_documentation(s7, ss->spectro_y_scale_symbol, "*spectro-y-scale*: scaler (stretch) along the spectrogram y axis (1.0)"); - s7_symbol_set_documentation(s7, ss->spectro_z_scale_symbol, "*spectro-z-scale*: scaler (stretch) along the spectrogram z axis (0.1)"); - s7_symbol_set_documentation(s7, ss->spectro_z_angle_symbol, "*spectro-z-angle*: spectrogram z-axis viewing angle (-2.0)"); - s7_symbol_set_documentation(s7, ss->spectro_x_angle_symbol, "*spectro-x-angle*: spectrogram x-axis viewing angle (90.0)"); - s7_symbol_set_documentation(s7, ss->spectro_y_angle_symbol, "*spectro-y-angle*: spectrogram y-axis viewing angle (0.0)"); - s7_symbol_set_documentation(s7, ss->spectrum_end_symbol, "*spectrum-end*: max frequency shown in spectra (1.0 = srate/2)"); - s7_symbol_set_documentation(s7, ss->spectrum_start_symbol, "*spectrum-start*: lower bound of frequency in spectral displays (0.0)"); - s7_symbol_set_documentation(s7, ss->spectro_hop_symbol, "*spectro-hop*: hop amount (pixels) in spectral displays"); - s7_symbol_set_documentation(s7, ss->wavelet_type_symbol, "*wavelet-type*: wavelet used in wavelet-transform (0)"); - s7_symbol_set_documentation(s7, ss->dot_size_symbol, "*dot-size*: size in pixels of dots when graphing with dots (1)"); - s7_symbol_set_documentation(s7, ss->zero_pad_symbol, "*zero-pad*: zero padding used in fft as a multiple of fft size (0)"); - s7_symbol_set_documentation(s7, ss->wavo_hop_symbol, "*wavo-hop*: wavogram spacing between successive traces"); - s7_symbol_set_documentation(s7, ss->wavo_trace_symbol, "*wavo-trace*: length (samples) of each trace in the wavogram (64)"); - s7_symbol_set_documentation(s7, ss->transform_size_symbol, "*transform-size*: current fft size (512)"); - s7_symbol_set_documentation(s7, ss->fft_window_symbol, "*fft-window*: fft data window choice (blackman2-window etc)"); - s7_symbol_set_documentation(s7, ss->transform_graph_type_symbol, "*transform-graph-type* can be graph-once, graph-as-sonogram, or graph-as-spectrogram."); - s7_symbol_set_documentation(s7, ss->time_graph_type_symbol, "*time-graph-type*: graph-once or graph-as-wavogram"); - s7_symbol_set_documentation(s7, ss->fft_window_alpha_symbol, "*fft-window-alpha*: fft window alpha parameter value"); - s7_symbol_set_documentation(s7, ss->fft_window_beta_symbol, "*fft-window-beta*: fft window beta parameter value"); - s7_symbol_set_documentation(s7, ss->grid_density_symbol, "*grid-density*: sets how closely axis ticks are spaced, default=1.0"); - s7_symbol_set_documentation(s7, ss->beats_per_minute_symbol, "*beats-per-minute*: beats per minute if x-axis-style is x-axis-in-beats"); - s7_symbol_set_documentation(s7, ss->show_mix_waveforms_symbol, "*show-mix-waveforms*: #t if Snd should display mix waveforms (above the main waveform)"); - s7_symbol_set_documentation(s7, ss->beats_per_measure_symbol, "*beats-per-measure*: beats per measure if x-axis-style is x-axis-in-measures"); - s7_symbol_set_documentation(s7, ss->transform_normalization_symbol, "*transform-normalization*: dont-normalize, normalize-by-channel, normalize-by-sound, or normalize-globally."); - s7_symbol_set_documentation(s7, ss->x_axis_style_symbol, "*x-axis-style*: The x axis labelling of the time domain waveform (x-axis-in-seconds etc)"); - s7_symbol_set_documentation(s7, ss->zoom_focus_style_symbol, "*zoom-focus-style*: determines what zooming centers on (zoom-focus-active etc)."); - s7_symbol_set_documentation(s7, ss->graph_style_symbol, "*graph-style*: graph style (graph-lines etc)"); - s7_symbol_set_documentation(s7, ss->max_transform_peaks_symbol, "*max-transform-peaks*: max number of fft peaks reported in fft display"); - s7_symbol_set_documentation(s7, ss->graphs_horizontal_symbol, "*graphs-horizontal*: #t if the time domain, fft, and lisp graphs are layed out horizontally"); - s7_symbol_set_documentation(s7, ss->cursor_size_symbol, "*cursor-size*: current cursor size"); - s7_symbol_set_documentation(s7, ss->cursor_style_symbol, "*cursor-style*: current cursor shape (cursor-cross etc)"); - s7_symbol_set_documentation(s7, ss->tracking_cursor_style_symbol, "*tracking-cursor-style*: current tracking cursor shape (cursor-cross, cursor-line)"); - s7_symbol_set_documentation(s7, ss->show_sonogram_cursor_symbol, "*show-sonogram-cursor*: #t if Snd should display a cursor in the sonogram"); - s7_symbol_set_documentation(s7, ss->min_db_symbol, "*min-dB*: min dB value displayed in fft graphs using dB scales (-60)"); - s7_symbol_set_documentation(s7, ss->transform_type_symbol, "*transform-type*: transform type (fourier-transform etc)"); - s7_symbol_set_documentation(s7, ss->with_gl_symbol, "*with-gl*: #t if Snd should use GL graphics"); - - s7_symbol_set_setter(s7, ss->transform_type_symbol, s7_make_function(s7, "[acc-" S_transform_type "]", acc_transform_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_show_transform_peaks "]", acc_show_transform_peaks, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_y_zero_symbol, s7_make_function(s7, "[acc-" S_show_y_zero "]", acc_show_y_zero, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_marks_symbol, s7_make_function(s7, "[acc-" S_show_marks "]", acc_show_marks, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_grid_symbol, s7_make_function(s7, "[acc-" S_show_grid "]", acc_show_grid, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_log_frequency_symbol, s7_make_function(s7, "[acc-" S_fft_log_frequency "]", acc_fft_log_frequency, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_log_magnitude_symbol, s7_make_function(s7, "[acc-" S_fft_log_magnitude "]", acc_fft_log_magnitude, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_with_phases_symbol, s7_make_function(s7, "[acc-" S_fft_with_phases "]", acc_fft_with_phases, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->sync_style_symbol, s7_make_function(s7, "[acc-" S_sync_style "]", acc_sync_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_axes_symbol, s7_make_function(s7, "[acc-" S_show_axes "]", acc_show_axes, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_verbose_cursor_symbol, s7_make_function(s7, "[acc-" S_with_verbose_cursor "]", acc_with_verbose_cursor, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_x_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_x_scale "]", acc_spectro_x_scale, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_y_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_y_scale "]", acc_spectro_y_scale, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_z_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_z_scale "]", acc_spectro_z_scale, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_z_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_z_angle "]", acc_spectro_z_angle, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_x_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_x_angle "]", acc_spectro_x_angle, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_y_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_y_angle "]", acc_spectro_y_angle, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectrum_end_symbol, s7_make_function(s7, "[acc-" S_spectrum_end "]", acc_spectrum_end, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectrum_start_symbol, s7_make_function(s7, "[acc-" S_spectrum_start "]", acc_spectrum_start, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->spectro_hop_symbol, s7_make_function(s7, "[acc-" S_spectro_hop "]", acc_spectro_hop, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->wavelet_type_symbol, s7_make_function(s7, "[acc-" S_wavelet_type "]", acc_wavelet_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->dot_size_symbol, s7_make_function(s7, "[acc-" S_dot_size "]", acc_dot_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->zero_pad_symbol, s7_make_function(s7, "[acc-" S_zero_pad "]", acc_zero_pad, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->wavo_hop_symbol, s7_make_function(s7, "[acc-" S_wavo_hop "]", acc_wavo_hop, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->wavo_trace_symbol, s7_make_function(s7, "[acc-" S_wavo_trace "]", acc_wavo_trace, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->transform_size_symbol, s7_make_function(s7, "[acc-" S_transform_size "]", acc_transform_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_window_symbol, s7_make_function(s7, "[acc-" S_fft_window "]", acc_fft_window, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->transform_graph_type_symbol, s7_make_function(s7, "[acc-" S_transform_graph_type "]", acc_transform_graph_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->time_graph_type_symbol, s7_make_function(s7, "[acc-" S_time_graph_type "]", acc_time_graph_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_window_alpha_symbol, s7_make_function(s7, "[acc-" S_fft_window_alpha "]", acc_fft_window_alpha, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->fft_window_beta_symbol, s7_make_function(s7, "[acc-" S_fft_window_beta "]", acc_fft_window_beta, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->grid_density_symbol, s7_make_function(s7, "[acc-" S_grid_density "]", acc_grid_density, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->beats_per_minute_symbol, s7_make_function(s7, "[acc-" S_beats_per_minute "]", acc_beats_per_minute, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_mix_waveforms_symbol, s7_make_function(s7, "[acc-" S_show_mix_waveforms "]", acc_show_mix_waveforms, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->beats_per_measure_symbol, s7_make_function(s7, "[acc-" S_beats_per_measure "]", acc_beats_per_measure, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->transform_normalization_symbol, s7_make_function(s7, "[acc-" S_transform_normalization "]", acc_transform_normalization, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->x_axis_style_symbol, s7_make_function(s7, "[acc-" S_x_axis_style "]", acc_x_axis_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->zoom_focus_style_symbol, s7_make_function(s7, "[acc-" S_zoom_focus_style "]", acc_zoom_focus_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->graph_style_symbol, s7_make_function(s7, "[acc-" S_graph_style "]", acc_graph_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->max_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_max_transform_peaks "]", acc_max_transform_peaks, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->graphs_horizontal_symbol, s7_make_function(s7, "[acc-" S_graphs_horizontal "]", acc_graphs_horizontal, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->cursor_size_symbol, s7_make_function(s7, "[acc-" S_cursor_size "]", acc_cursor_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->cursor_style_symbol, s7_make_function(s7, "[acc-" S_cursor_style "]", acc_cursor_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->tracking_cursor_style_symbol, s7_make_function(s7, "[acc-" S_tracking_cursor_style "]", acc_tracking_cursor_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_sonogram_cursor_symbol, s7_make_function(s7, "[acc-" S_show_sonogram_cursor "]", acc_show_sonogram_cursor, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->min_db_symbol, s7_make_function(s7, "[acc-" S_min_dB "]", acc_min_dB, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_gl_symbol, s7_make_function(s7, "[acc-" S_with_gl "]", acc_with_gl, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->show_transform_peaks_symbol, "*" S_show_transform_peaks "* determines whether fft displays include a peak list"); + s7_set_documentation(s7, ss->show_y_zero_symbol, "*show-y-zero*: #t if Snd should include a line at y = 0.0"); + s7_set_documentation(s7, ss->show_marks_symbol, "*show-marks*: #t if Snd should show marks"); + s7_set_documentation(s7, ss->show_grid_symbol, "*show-grid*: #t if Snd should display a background grid in the graphs"); + s7_set_documentation(s7, ss->fft_log_frequency_symbol, "*fft-log-frequency*: #t if fft displays use log on the frequency axis"); + s7_set_documentation(s7, ss->fft_log_magnitude_symbol, "*fft-log-magnitude*: #t if fft displays use dB"); + s7_set_documentation(s7, ss->fft_with_phases_symbol, "*fft-with-phases*: #t if fft displays include phase info"); + s7_set_documentation(s7, ss->sync_style_symbol, "*sync-style*: determines how channels are grouped when a sound is opened."); + s7_set_documentation(s7, ss->show_axes_symbol, "*show-axes*: If show-all-axes, display x and y axes; if show-x-axis, just one axis (the x axis) is displayed. The other choices are show-no-axes, show-all-axes-unlabelled, show-x-axis-unlabelled, and show-bare-x-axis."); + s7_set_documentation(s7, ss->with_verbose_cursor_symbol, "*with-verbose-cursor*: #t if the cursor's position and so on is displayed in the status area"); + s7_set_documentation(s7, ss->spectro_x_scale_symbol, "*spectro-x-scale*: scaler (stretch) along the spectrogram x axis (1.0)"); + s7_set_documentation(s7, ss->spectro_y_scale_symbol, "*spectro-y-scale*: scaler (stretch) along the spectrogram y axis (1.0)"); + s7_set_documentation(s7, ss->spectro_z_scale_symbol, "*spectro-z-scale*: scaler (stretch) along the spectrogram z axis (0.1)"); + s7_set_documentation(s7, ss->spectro_z_angle_symbol, "*spectro-z-angle*: spectrogram z-axis viewing angle (-2.0)"); + s7_set_documentation(s7, ss->spectro_x_angle_symbol, "*spectro-x-angle*: spectrogram x-axis viewing angle (90.0)"); + s7_set_documentation(s7, ss->spectro_y_angle_symbol, "*spectro-y-angle*: spectrogram y-axis viewing angle (0.0)"); + s7_set_documentation(s7, ss->spectrum_end_symbol, "*spectrum-end*: max frequency shown in spectra (1.0 = srate/2)"); + s7_set_documentation(s7, ss->spectrum_start_symbol, "*spectrum-start*: lower bound of frequency in spectral displays (0.0)"); + s7_set_documentation(s7, ss->spectro_hop_symbol, "*spectro-hop*: hop amount (pixels) in spectral displays"); + s7_set_documentation(s7, ss->wavelet_type_symbol, "*wavelet-type*: wavelet used in wavelet-transform (0)"); + s7_set_documentation(s7, ss->dot_size_symbol, "*dot-size*: size in pixels of dots when graphing with dots (1)"); + s7_set_documentation(s7, ss->zero_pad_symbol, "*zero-pad*: zero padding used in fft as a multiple of fft size (0)"); + s7_set_documentation(s7, ss->wavo_hop_symbol, "*wavo-hop*: wavogram spacing between successive traces"); + s7_set_documentation(s7, ss->wavo_trace_symbol, "*wavo-trace*: length (samples) of each trace in the wavogram (64)"); + s7_set_documentation(s7, ss->transform_size_symbol, "*transform-size*: current fft size (512)"); + s7_set_documentation(s7, ss->fft_window_symbol, "*fft-window*: fft data window choice (blackman2-window etc)"); + s7_set_documentation(s7, ss->transform_graph_type_symbol, "*transform-graph-type* can be graph-once, graph-as-sonogram, or graph-as-spectrogram."); + s7_set_documentation(s7, ss->time_graph_type_symbol, "*time-graph-type*: graph-once or graph-as-wavogram"); + s7_set_documentation(s7, ss->fft_window_alpha_symbol, "*fft-window-alpha*: fft window alpha parameter value"); + s7_set_documentation(s7, ss->fft_window_beta_symbol, "*fft-window-beta*: fft window beta parameter value"); + s7_set_documentation(s7, ss->grid_density_symbol, "*grid-density*: sets how closely axis ticks are spaced, default=1.0"); + s7_set_documentation(s7, ss->beats_per_minute_symbol, "*beats-per-minute*: beats per minute if x-axis-style is x-axis-in-beats"); + s7_set_documentation(s7, ss->show_mix_waveforms_symbol, "*show-mix-waveforms*: #t if Snd should display mix waveforms (above the main waveform)"); + s7_set_documentation(s7, ss->beats_per_measure_symbol, "*beats-per-measure*: beats per measure if x-axis-style is x-axis-in-measures"); + s7_set_documentation(s7, ss->transform_normalization_symbol, "*transform-normalization*: dont-normalize, normalize-by-channel, normalize-by-sound, or normalize-globally."); + s7_set_documentation(s7, ss->x_axis_style_symbol, "*x-axis-style*: The x axis labelling of the time domain waveform (x-axis-in-seconds etc)"); + s7_set_documentation(s7, ss->zoom_focus_style_symbol, "*zoom-focus-style*: determines what zooming centers on (zoom-focus-active etc)."); + s7_set_documentation(s7, ss->graph_style_symbol, "*graph-style*: graph style (graph-lines etc)"); + s7_set_documentation(s7, ss->max_transform_peaks_symbol, "*max-transform-peaks*: max number of fft peaks reported in fft display"); + s7_set_documentation(s7, ss->graphs_horizontal_symbol, "*graphs-horizontal*: #t if the time domain, fft, and lisp graphs are layed out horizontally"); + s7_set_documentation(s7, ss->cursor_size_symbol, "*cursor-size*: current cursor size"); + s7_set_documentation(s7, ss->cursor_style_symbol, "*cursor-style*: current cursor shape (cursor-cross etc)"); + s7_set_documentation(s7, ss->tracking_cursor_style_symbol, "*tracking-cursor-style*: current tracking cursor shape (cursor-cross, cursor-line)"); + s7_set_documentation(s7, ss->show_sonogram_cursor_symbol, "*show-sonogram-cursor*: #t if Snd should display a cursor in the sonogram"); + s7_set_documentation(s7, ss->min_db_symbol, "*min-dB*: min dB value displayed in fft graphs using dB scales (-60)"); + s7_set_documentation(s7, ss->transform_type_symbol, "*transform-type*: transform type (fourier-transform etc)"); + s7_set_documentation(s7, ss->with_gl_symbol, "*with-gl*: #t if Snd should use GL graphics"); + + s7_set_setter(s7, ss->transform_type_symbol, s7_make_function(s7, "[acc-" S_transform_type "]", acc_transform_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_show_transform_peaks "]", acc_show_transform_peaks, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_y_zero_symbol, s7_make_function(s7, "[acc-" S_show_y_zero "]", acc_show_y_zero, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_marks_symbol, s7_make_function(s7, "[acc-" S_show_marks "]", acc_show_marks, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_grid_symbol, s7_make_function(s7, "[acc-" S_show_grid "]", acc_show_grid, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_log_frequency_symbol, s7_make_function(s7, "[acc-" S_fft_log_frequency "]", acc_fft_log_frequency, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_log_magnitude_symbol, s7_make_function(s7, "[acc-" S_fft_log_magnitude "]", acc_fft_log_magnitude, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_with_phases_symbol, s7_make_function(s7, "[acc-" S_fft_with_phases "]", acc_fft_with_phases, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->sync_style_symbol, s7_make_function(s7, "[acc-" S_sync_style "]", acc_sync_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_axes_symbol, s7_make_function(s7, "[acc-" S_show_axes "]", acc_show_axes, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_verbose_cursor_symbol, s7_make_function(s7, "[acc-" S_with_verbose_cursor "]", acc_with_verbose_cursor, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_x_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_x_scale "]", acc_spectro_x_scale, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_y_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_y_scale "]", acc_spectro_y_scale, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_z_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_z_scale "]", acc_spectro_z_scale, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_z_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_z_angle "]", acc_spectro_z_angle, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_x_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_x_angle "]", acc_spectro_x_angle, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_y_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_y_angle "]", acc_spectro_y_angle, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectrum_end_symbol, s7_make_function(s7, "[acc-" S_spectrum_end "]", acc_spectrum_end, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectrum_start_symbol, s7_make_function(s7, "[acc-" S_spectrum_start "]", acc_spectrum_start, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->spectro_hop_symbol, s7_make_function(s7, "[acc-" S_spectro_hop "]", acc_spectro_hop, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->wavelet_type_symbol, s7_make_function(s7, "[acc-" S_wavelet_type "]", acc_wavelet_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->dot_size_symbol, s7_make_function(s7, "[acc-" S_dot_size "]", acc_dot_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->zero_pad_symbol, s7_make_function(s7, "[acc-" S_zero_pad "]", acc_zero_pad, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->wavo_hop_symbol, s7_make_function(s7, "[acc-" S_wavo_hop "]", acc_wavo_hop, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->wavo_trace_symbol, s7_make_function(s7, "[acc-" S_wavo_trace "]", acc_wavo_trace, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->transform_size_symbol, s7_make_function(s7, "[acc-" S_transform_size "]", acc_transform_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_window_symbol, s7_make_function(s7, "[acc-" S_fft_window "]", acc_fft_window, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->transform_graph_type_symbol, s7_make_function(s7, "[acc-" S_transform_graph_type "]", acc_transform_graph_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->time_graph_type_symbol, s7_make_function(s7, "[acc-" S_time_graph_type "]", acc_time_graph_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_window_alpha_symbol, s7_make_function(s7, "[acc-" S_fft_window_alpha "]", acc_fft_window_alpha, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->fft_window_beta_symbol, s7_make_function(s7, "[acc-" S_fft_window_beta "]", acc_fft_window_beta, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->grid_density_symbol, s7_make_function(s7, "[acc-" S_grid_density "]", acc_grid_density, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->beats_per_minute_symbol, s7_make_function(s7, "[acc-" S_beats_per_minute "]", acc_beats_per_minute, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_mix_waveforms_symbol, s7_make_function(s7, "[acc-" S_show_mix_waveforms "]", acc_show_mix_waveforms, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->beats_per_measure_symbol, s7_make_function(s7, "[acc-" S_beats_per_measure "]", acc_beats_per_measure, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->transform_normalization_symbol, s7_make_function(s7, "[acc-" S_transform_normalization "]", acc_transform_normalization, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->x_axis_style_symbol, s7_make_function(s7, "[acc-" S_x_axis_style "]", acc_x_axis_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->zoom_focus_style_symbol, s7_make_function(s7, "[acc-" S_zoom_focus_style "]", acc_zoom_focus_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->graph_style_symbol, s7_make_function(s7, "[acc-" S_graph_style "]", acc_graph_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->max_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_max_transform_peaks "]", acc_max_transform_peaks, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->graphs_horizontal_symbol, s7_make_function(s7, "[acc-" S_graphs_horizontal "]", acc_graphs_horizontal, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->cursor_size_symbol, s7_make_function(s7, "[acc-" S_cursor_size "]", acc_cursor_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->cursor_style_symbol, s7_make_function(s7, "[acc-" S_cursor_style "]", acc_cursor_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->tracking_cursor_style_symbol, s7_make_function(s7, "[acc-" S_tracking_cursor_style "]", acc_tracking_cursor_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_sonogram_cursor_symbol, s7_make_function(s7, "[acc-" S_show_sonogram_cursor "]", acc_show_sonogram_cursor, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->min_db_symbol, s7_make_function(s7, "[acc-" S_min_dB "]", acc_min_dB, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_gl_symbol, s7_make_function(s7, "[acc-" S_with_gl "]", acc_with_gl, 2, 0, false, "accessor")); s7_eval_c_string(s7, "(set! *transform-type* fourier-transform)"); #endif @@ -3668,17 +3668,17 @@ If it returns " PROC_TRUE ", the sound is not played." start_playing_selection_hook = Xen_define_hook(S_start_playing_selection_hook, "(make-hook)", 0, H_start_playing_selection_hook); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->cursor_location_offset_symbol, s7_make_function(s7, "[acc-" S_cursor_location_offset "]", acc_cursor_location_offset, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->cursor_update_interval_symbol, s7_make_function(s7, "[acc-" S_cursor_update_interval "]", acc_cursor_update_interval, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->dac_combines_channels_symbol, s7_make_function(s7, "[acc-" S_dac_combines_channels "]", acc_dac_combines_channels, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->dac_size_symbol, s7_make_function(s7, "[acc-" S_dac_size "]", acc_dac_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_tracking_cursor_symbol, s7_make_function(s7, "[acc-" S_with_tracking_cursor "]", acc_with_tracking_cursor, 2, 0, false, "accessor")); - - s7_symbol_set_documentation(s7, ss->cursor_location_offset_symbol, "*cursor-location-offset*: samples added to cursor location if cursor displayed during play."); - s7_symbol_set_documentation(s7, ss->cursor_update_interval_symbol, "*cursor-update-interval*: time (seconds) between cursor updates if with-tracking-cursor."); - s7_symbol_set_documentation(s7, ss->dac_combines_channels_symbol, "*dac-combines-channels*: #t if extra channels are to be mixed into available ones during playing."); - s7_symbol_set_documentation(s7, ss->dac_size_symbol, "*dac-size*: the current DAC buffer size in framples (256)"); - s7_symbol_set_documentation(s7, ss->with_tracking_cursor_symbol, "*with-tracking-cursor*: #t if cursor always moves along in waveform display as sound is played"); + s7_set_setter(s7, ss->cursor_location_offset_symbol, s7_make_function(s7, "[acc-" S_cursor_location_offset "]", acc_cursor_location_offset, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->cursor_update_interval_symbol, s7_make_function(s7, "[acc-" S_cursor_update_interval "]", acc_cursor_update_interval, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->dac_combines_channels_symbol, s7_make_function(s7, "[acc-" S_dac_combines_channels "]", acc_dac_combines_channels, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->dac_size_symbol, s7_make_function(s7, "[acc-" S_dac_size "]", acc_dac_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_tracking_cursor_symbol, s7_make_function(s7, "[acc-" S_with_tracking_cursor "]", acc_with_tracking_cursor, 2, 0, false, "accessor")); + + s7_set_documentation(s7, ss->cursor_location_offset_symbol, "*cursor-location-offset*: samples added to cursor location if cursor displayed during play."); + s7_set_documentation(s7, ss->cursor_update_interval_symbol, "*cursor-update-interval*: time (seconds) between cursor updates if with-tracking-cursor."); + s7_set_documentation(s7, ss->dac_combines_channels_symbol, "*dac-combines-channels*: #t if extra channels are to be mixed into available ones during playing."); + s7_set_documentation(s7, ss->dac_size_symbol, "*dac-size*: the current DAC buffer size in framples (256)"); + s7_set_documentation(s7, ss->with_tracking_cursor_symbol, "*with-tracking-cursor*: #t if cursor always moves along in waveform display as sound is played"); #endif } @@ -2115,45 +2115,45 @@ a new set of channel or sound widgets is created." new_widget_hook = Xen_define_hook(S_new_widget_hook, "(make-hook 'widget)", 1, H_new_widget_hook); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->data_color_symbol, s7_make_function(s7, "[acc-" S_data_color "]", acc_data_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->highlight_color_symbol, s7_make_function(s7, "[acc-" S_highlight_color "]", acc_highlight_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->axis_color_symbol, s7_make_function(s7, "[acc-" S_axis_color "]", acc_axis_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->sash_color_symbol, s7_make_function(s7, "[acc-" S_sash_color "]", acc_sash_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->filter_control_waveform_color_symbol, s7_make_function(s7, "[acc-" S_filter_control_waveform_color "]", acc_filter_control_waveform_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->mix_color_symbol, s7_make_function(s7, "[acc-" S_mix_color "]", acc_mix_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->selected_data_color_symbol, s7_make_function(s7, "[acc-" S_selected_data_color "]", acc_selected_data_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->mark_color_symbol, s7_make_function(s7, "[acc-" S_mark_color "]", acc_mark_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->graph_color_symbol, s7_make_function(s7, "[acc-" S_graph_color "]", acc_graph_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->selected_graph_color_symbol, s7_make_function(s7, "[acc-" S_selected_graph_color "]", acc_selected_graph_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->listener_color_symbol, s7_make_function(s7, "[acc-" S_listener_color "]", acc_listener_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->listener_text_color_symbol, s7_make_function(s7, "[acc-" S_listener_text_color "]", acc_listener_text_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->basic_color_symbol, s7_make_function(s7, "[acc-" S_basic_color "]", acc_basic_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->selection_color_symbol, s7_make_function(s7, "[acc-" S_selection_color "]", acc_selection_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->zoom_color_symbol, s7_make_function(s7, "[acc-" S_zoom_color "]", acc_zoom_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->position_color_symbol, s7_make_function(s7, "[acc-" S_position_color "]", acc_position_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_waveform_color_symbol, s7_make_function(s7, "[acc-" S_enved_waveform_color "]", acc_enved_waveform_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->cursor_color_symbol, s7_make_function(s7, "[acc-" S_cursor_color "]", acc_cursor_color, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->text_focus_color_symbol, s7_make_function(s7, "[acc-" S_text_focus_color "]", acc_text_focus_color, 2, 0, false, "accessor")); - - s7_symbol_set_documentation(s7, ss->axis_color_symbol, "*axis-color*: color of axis (defaults to current data color)"); - s7_symbol_set_documentation(s7, ss->basic_color_symbol, "*basic-color*: Snd's basic color"); - s7_symbol_set_documentation(s7, ss->cursor_color_symbol, "*cursor-color*: cursor color"); - s7_symbol_set_documentation(s7, ss->data_color_symbol, "*data-color*: color used to draw unselected data"); - s7_symbol_set_documentation(s7, ss->enved_waveform_color_symbol, "*enved-waveform-color*: color of the envelope editor wave display"); - s7_symbol_set_documentation(s7, ss->filter_control_waveform_color_symbol, "*filter-control-waveform-color*: color of the filter waveform"); - s7_symbol_set_documentation(s7, ss->graph_color_symbol, "*graph-color*: background color used for unselected data"); - s7_symbol_set_documentation(s7, ss->highlight_color_symbol, "*highlight-color*: color of highlighted text or buttons"); - s7_symbol_set_documentation(s7, ss->listener_color_symbol, "*listener-color*: background color of the lisp listener"); - s7_symbol_set_documentation(s7, ss->listener_text_color_symbol, "*listener-text-color*: text color in the lisp listener"); - s7_symbol_set_documentation(s7, ss->mark_color_symbol, "*mark-color*: mark color"); - s7_symbol_set_documentation(s7, ss->mix_color_symbol, "*mix-color*: color of mix tags"); - s7_symbol_set_documentation(s7, ss->position_color_symbol, "*position-color*: color of position sliders"); - s7_symbol_set_documentation(s7, ss->sash_color_symbol, "*sash-color*: color used to draw paned window sashes"); - s7_symbol_set_documentation(s7, ss->selected_data_color_symbol, "*selected-data-color*: color used for selected data"); - s7_symbol_set_documentation(s7, ss->selected_graph_color_symbol, "*selected-graph-color*: background color of selected data"); - s7_symbol_set_documentation(s7, ss->selection_color_symbol, "*selection-color*: selection color"); - s7_symbol_set_documentation(s7, ss->text_focus_color_symbol, "*text-focus-color*: color used to show a text field has focus"); - s7_symbol_set_documentation(s7, ss->zoom_color_symbol, "*zoom-color*: color of zoom sliders"); + s7_set_setter(s7, ss->data_color_symbol, s7_make_function(s7, "[acc-" S_data_color "]", acc_data_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->highlight_color_symbol, s7_make_function(s7, "[acc-" S_highlight_color "]", acc_highlight_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->axis_color_symbol, s7_make_function(s7, "[acc-" S_axis_color "]", acc_axis_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->sash_color_symbol, s7_make_function(s7, "[acc-" S_sash_color "]", acc_sash_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->filter_control_waveform_color_symbol, s7_make_function(s7, "[acc-" S_filter_control_waveform_color "]", acc_filter_control_waveform_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mix_color_symbol, s7_make_function(s7, "[acc-" S_mix_color "]", acc_mix_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->selected_data_color_symbol, s7_make_function(s7, "[acc-" S_selected_data_color "]", acc_selected_data_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mark_color_symbol, s7_make_function(s7, "[acc-" S_mark_color "]", acc_mark_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->graph_color_symbol, s7_make_function(s7, "[acc-" S_graph_color "]", acc_graph_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->selected_graph_color_symbol, s7_make_function(s7, "[acc-" S_selected_graph_color "]", acc_selected_graph_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->listener_color_symbol, s7_make_function(s7, "[acc-" S_listener_color "]", acc_listener_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->listener_text_color_symbol, s7_make_function(s7, "[acc-" S_listener_text_color "]", acc_listener_text_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->basic_color_symbol, s7_make_function(s7, "[acc-" S_basic_color "]", acc_basic_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->selection_color_symbol, s7_make_function(s7, "[acc-" S_selection_color "]", acc_selection_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->zoom_color_symbol, s7_make_function(s7, "[acc-" S_zoom_color "]", acc_zoom_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->position_color_symbol, s7_make_function(s7, "[acc-" S_position_color "]", acc_position_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_waveform_color_symbol, s7_make_function(s7, "[acc-" S_enved_waveform_color "]", acc_enved_waveform_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->cursor_color_symbol, s7_make_function(s7, "[acc-" S_cursor_color "]", acc_cursor_color, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->text_focus_color_symbol, s7_make_function(s7, "[acc-" S_text_focus_color "]", acc_text_focus_color, 2, 0, false, "accessor")); + + s7_set_documentation(s7, ss->axis_color_symbol, "*axis-color*: color of axis (defaults to current data color)"); + s7_set_documentation(s7, ss->basic_color_symbol, "*basic-color*: Snd's basic color"); + s7_set_documentation(s7, ss->cursor_color_symbol, "*cursor-color*: cursor color"); + s7_set_documentation(s7, ss->data_color_symbol, "*data-color*: color used to draw unselected data"); + s7_set_documentation(s7, ss->enved_waveform_color_symbol, "*enved-waveform-color*: color of the envelope editor wave display"); + s7_set_documentation(s7, ss->filter_control_waveform_color_symbol, "*filter-control-waveform-color*: color of the filter waveform"); + s7_set_documentation(s7, ss->graph_color_symbol, "*graph-color*: background color used for unselected data"); + s7_set_documentation(s7, ss->highlight_color_symbol, "*highlight-color*: color of highlighted text or buttons"); + s7_set_documentation(s7, ss->listener_color_symbol, "*listener-color*: background color of the lisp listener"); + s7_set_documentation(s7, ss->listener_text_color_symbol, "*listener-text-color*: text color in the lisp listener"); + s7_set_documentation(s7, ss->mark_color_symbol, "*mark-color*: mark color"); + s7_set_documentation(s7, ss->mix_color_symbol, "*mix-color*: color of mix tags"); + s7_set_documentation(s7, ss->position_color_symbol, "*position-color*: color of position sliders"); + s7_set_documentation(s7, ss->sash_color_symbol, "*sash-color*: color used to draw paned window sashes"); + s7_set_documentation(s7, ss->selected_data_color_symbol, "*selected-data-color*: color used for selected data"); + s7_set_documentation(s7, ss->selected_graph_color_symbol, "*selected-graph-color*: background color of selected data"); + s7_set_documentation(s7, ss->selection_color_symbol, "*selection-color*: selection color"); + s7_set_documentation(s7, ss->text_focus_color_symbol, "*text-focus-color*: color used to show a text field has focus"); + s7_set_documentation(s7, ss->zoom_color_symbol, "*zoom-color*: color of zoom sliders"); #endif } @@ -1933,18 +1933,18 @@ stretch-envelope from env.fth: \n\ ss->enved->clipping = DEFAULT_ENVED_CLIPPING; #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->enved_base_symbol, s7_make_function(s7, "[acc-" S_enved_base "]", acc_enved_base, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_filter_order_symbol, s7_make_function(s7, "[acc-" S_enved_filter_order "]", acc_enved_filter_order, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_power_symbol, s7_make_function(s7, "[acc-" S_enved_power "]", acc_enved_power, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_style_symbol, s7_make_function(s7, "[acc-" S_enved_style "]", acc_enved_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_target_symbol, s7_make_function(s7, "[acc-" S_enved_target "]", acc_enved_target, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->enved_with_wave_symbol, s7_make_function(s7, "[acc-" S_enved_with_wave "]", acc_enved_with_wave, 2, 0, false, "accessor")); - - s7_symbol_set_documentation(s7, ss->enved_base_symbol, "*enved-base*: envelope editor exponential base value (1.0)"); - s7_symbol_set_documentation(s7, ss->enved_filter_order_symbol, "*enved-filter-order*: envelope editor's FIR filter order (40)"); - s7_symbol_set_documentation(s7, ss->enved_power_symbol, "*enved-power*: envelope editor base scale range (9.0^power)"); - s7_symbol_set_documentation(s7, ss->enved_style_symbol, "*enved-style*: envelope editor breakpoint connection choice: envelope-linear or envelope-exponential"); - s7_symbol_set_documentation(s7, ss->enved_target_symbol, "*enved-target*: determines how the envelope edit envelope is applied; enved-amplitude etc"); - s7_symbol_set_documentation(s7, ss->enved_with_wave_symbol, "*enved-wave?*: #t if the envelope editor is displaying the waveform to be edited"); + s7_set_setter(s7, ss->enved_base_symbol, s7_make_function(s7, "[acc-" S_enved_base "]", acc_enved_base, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_filter_order_symbol, s7_make_function(s7, "[acc-" S_enved_filter_order "]", acc_enved_filter_order, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_power_symbol, s7_make_function(s7, "[acc-" S_enved_power "]", acc_enved_power, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_style_symbol, s7_make_function(s7, "[acc-" S_enved_style "]", acc_enved_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_target_symbol, s7_make_function(s7, "[acc-" S_enved_target "]", acc_enved_target, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->enved_with_wave_symbol, s7_make_function(s7, "[acc-" S_enved_with_wave "]", acc_enved_with_wave, 2, 0, false, "accessor")); + + s7_set_documentation(s7, ss->enved_base_symbol, "*enved-base*: envelope editor exponential base value (1.0)"); + s7_set_documentation(s7, ss->enved_filter_order_symbol, "*enved-filter-order*: envelope editor's FIR filter order (40)"); + s7_set_documentation(s7, ss->enved_power_symbol, "*enved-power*: envelope editor base scale range (9.0^power)"); + s7_set_documentation(s7, ss->enved_style_symbol, "*enved-style*: envelope editor breakpoint connection choice: envelope-linear or envelope-exponential"); + s7_set_documentation(s7, ss->enved_target_symbol, "*enved-target*: determines how the envelope edit envelope is applied; enved-amplitude etc"); + s7_set_documentation(s7, ss->enved_with_wave_symbol, "*enved-wave?*: #t if the envelope editor is displaying the waveform to be edited"); #endif } @@ -2553,11 +2553,11 @@ of a moving mark:\n\ Xen_define_typed_procedure(S_transform_to_integer, g_transform_to_integer_w, 1, 0, 0, H_transform_to_integer, s7_make_signature(s7, 2, i, tr)); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->log_freq_start_symbol, s7_make_function(s7, "[acc-" S_log_freq_start "]", acc_log_freq_start, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_selection_transform_symbol, s7_make_function(s7, "[acc-" S_show_selection_transform "]", acc_show_selection_transform, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->log_freq_start_symbol, s7_make_function(s7, "[acc-" S_log_freq_start "]", acc_log_freq_start, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_selection_transform_symbol, s7_make_function(s7, "[acc-" S_show_selection_transform "]", acc_show_selection_transform, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->log_freq_start_symbol, "*log-freq-start*: log freq base (25.0)"); - s7_symbol_set_documentation(s7, ss->show_selection_transform_symbol, "*show-selection-transform*: #t if transform display reflects selection, not time-domain window"); + s7_set_documentation(s7, ss->log_freq_start_symbol, "*log-freq-start*: log freq base (25.0)"); + s7_set_documentation(s7, ss->show_selection_transform_symbol, "*show-selection-transform*: #t if transform display reflects selection, not time-domain window"); #endif } @@ -3962,46 +3962,46 @@ the newly updated sound may have a different index." Xen_GC_protect(ss->file_filters); #if HAVE_SCHEME - s7_symbol_set_documentation(s7, ss->default_output_header_type_symbol, "*default-output-header-type*: header type when a new file is created (mus-next etc)"); - s7_symbol_set_documentation(s7, ss->default_output_sample_type_symbol, "*default-output-sample-type*: sample type when a new file is created (mus-ldouble etc)"); - s7_symbol_set_documentation(s7, ss->default_output_chans_symbol, "*default-output-chans*: number of channels when a new file is created (1)"); - s7_symbol_set_documentation(s7, ss->default_output_srate_symbol, "*default-output-srate*: sampling rate when a new file is created (44100)"); - s7_symbol_set_documentation(s7, ss->ask_before_overwrite_symbol, "*ask-before-overwrite*: #t if you want Snd to ask before overwriting a file."); - s7_symbol_set_documentation(s7, ss->ask_about_unsaved_edits_symbol, "*ask-about-unsaved-edits*: #t if you want Snd to ask whether to save unsaved edits when a sound is closed."); - s7_symbol_set_documentation(s7, ss->show_full_duration_symbol, "*show-full-duration*: #t if you want the entire sound displayed whn it is opened."); - s7_symbol_set_documentation(s7, ss->show_full_range_symbol, "*show-full-range*: #t if you want the graph y-bounds to accommodate the sound's max and min when it is opened."); - s7_symbol_set_documentation(s7, ss->remember_sound_state_symbol, "*remember-sound-state*: #t if you want a Snd to remember the current state of each sound when it is closed, restoring that state when it is opened again later."); - s7_symbol_set_documentation(s7, ss->save_as_dialog_src_symbol, "*save-as-dialog-src*: #t if you want the 'src' button set by default in the various Save-as dialogs"); - s7_symbol_set_documentation(s7, ss->save_as_dialog_auto_comment_symbol, "*save-as-dialog-auto-comment*: #t if you want the 'auto' button set by default in the various Save-as dialogs"); - s7_symbol_set_documentation(s7, ss->with_toolbar_symbol, "*with-toolbar*: #t if you want a toolbar"); - s7_symbol_set_documentation(s7, ss->with_tooltips_symbol, "*with-tooltips*: #t if you want tooltips"); - s7_symbol_set_documentation(s7, ss->with_menu_icons_symbol, "*with-menu-icons*: #t if you want icons in the menus (gtk only)"); - s7_symbol_set_documentation(s7, ss->initial_beg_symbol, "*initial-beg*: the begin point (in seconds) for the initial graph of a sound."); - s7_symbol_set_documentation(s7, ss->initial_dur_symbol, "*initial-dur*: the duration (in seconds) for the initial graph of a sound."); - s7_symbol_set_documentation(s7, ss->auto_update_symbol, "*auto-update*: #t if Snd should automatically update a file if it changes unexpectedly"); - s7_symbol_set_documentation(s7, ss->auto_update_interval_symbol, "*auto-update-interval*: time (seconds) between background checks for changed file on disk (60)"); - s7_symbol_set_documentation(s7, ss->clipping_symbol, "*clipping*: #t if Snd should clip output values"); + s7_set_documentation(s7, ss->default_output_header_type_symbol, "*default-output-header-type*: header type when a new file is created (mus-next etc)"); + s7_set_documentation(s7, ss->default_output_sample_type_symbol, "*default-output-sample-type*: sample type when a new file is created (mus-ldouble etc)"); + s7_set_documentation(s7, ss->default_output_chans_symbol, "*default-output-chans*: number of channels when a new file is created (1)"); + s7_set_documentation(s7, ss->default_output_srate_symbol, "*default-output-srate*: sampling rate when a new file is created (44100)"); + s7_set_documentation(s7, ss->ask_before_overwrite_symbol, "*ask-before-overwrite*: #t if you want Snd to ask before overwriting a file."); + s7_set_documentation(s7, ss->ask_about_unsaved_edits_symbol, "*ask-about-unsaved-edits*: #t if you want Snd to ask whether to save unsaved edits when a sound is closed."); + s7_set_documentation(s7, ss->show_full_duration_symbol, "*show-full-duration*: #t if you want the entire sound displayed whn it is opened."); + s7_set_documentation(s7, ss->show_full_range_symbol, "*show-full-range*: #t if you want the graph y-bounds to accommodate the sound's max and min when it is opened."); + s7_set_documentation(s7, ss->remember_sound_state_symbol, "*remember-sound-state*: #t if you want a Snd to remember the current state of each sound when it is closed, restoring that state when it is opened again later."); + s7_set_documentation(s7, ss->save_as_dialog_src_symbol, "*save-as-dialog-src*: #t if you want the 'src' button set by default in the various Save-as dialogs"); + s7_set_documentation(s7, ss->save_as_dialog_auto_comment_symbol, "*save-as-dialog-auto-comment*: #t if you want the 'auto' button set by default in the various Save-as dialogs"); + s7_set_documentation(s7, ss->with_toolbar_symbol, "*with-toolbar*: #t if you want a toolbar"); + s7_set_documentation(s7, ss->with_tooltips_symbol, "*with-tooltips*: #t if you want tooltips"); + s7_set_documentation(s7, ss->with_menu_icons_symbol, "*with-menu-icons*: #t if you want icons in the menus (gtk only)"); + s7_set_documentation(s7, ss->initial_beg_symbol, "*initial-beg*: the begin point (in seconds) for the initial graph of a sound."); + s7_set_documentation(s7, ss->initial_dur_symbol, "*initial-dur*: the duration (in seconds) for the initial graph of a sound."); + s7_set_documentation(s7, ss->auto_update_symbol, "*auto-update*: #t if Snd should automatically update a file if it changes unexpectedly"); + s7_set_documentation(s7, ss->auto_update_interval_symbol, "*auto-update-interval*: time (seconds) between background checks for changed file on disk (60)"); + s7_set_documentation(s7, ss->clipping_symbol, "*clipping*: #t if Snd should clip output values"); - s7_symbol_set_setter(s7, ss->default_output_header_type_symbol, s7_make_function(s7, "[acc-" S_default_output_header_type "]", acc_default_output_header_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->default_output_sample_type_symbol, s7_make_function(s7, "[acc-" S_default_output_sample_type "]", acc_default_output_sample_type, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->default_output_chans_symbol, s7_make_function(s7, "[acc-" S_default_output_chans "]", acc_default_output_chans, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->default_output_srate_symbol, s7_make_function(s7, "[acc-" S_default_output_srate "]", acc_default_output_srate, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->ask_before_overwrite_symbol, s7_make_function(s7, "[acc-" S_ask_before_overwrite "]", acc_ask_before_overwrite, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->ask_about_unsaved_edits_symbol, s7_make_function(s7, "[acc-" S_ask_about_unsaved_edits "]", acc_ask_about_unsaved_edits, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_full_duration_symbol, s7_make_function(s7, "[acc-" S_show_full_duration "]", acc_show_full_duration, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_full_range_symbol, s7_make_function(s7, "[acc-" S_show_full_range "]", acc_show_full_range, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->remember_sound_state_symbol, s7_make_function(s7, "[acc-" S_remember_sound_state "]", acc_remember_sound_state, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->save_as_dialog_src_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_src "]", acc_save_as_dialog_src, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->save_as_dialog_auto_comment_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_auto_comment "]", acc_save_as_dialog_auto_comment, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_toolbar_symbol, s7_make_function(s7, "[acc-" S_with_toolbar "]", acc_with_toolbar, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_tooltips_symbol, s7_make_function(s7, "[acc-" S_with_tooltips "]", acc_with_tooltips, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_menu_icons_symbol, s7_make_function(s7, "[acc-" S_with_menu_icons "]", acc_with_menu_icons, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->initial_beg_symbol, s7_make_function(s7, "[acc-" S_initial_beg "]", acc_initial_beg, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->initial_dur_symbol, s7_make_function(s7, "[acc-" S_initial_dur "]", acc_initial_dur, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->auto_update_symbol, s7_make_function(s7, "[acc-" S_auto_update "]", acc_auto_update, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->auto_update_interval_symbol, s7_make_function(s7, "[acc-" S_auto_update_interval "]", acc_auto_update_interval, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->clipping_symbol, s7_make_function(s7, "[acc-" S_clipping "]", acc_clipping, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->default_output_header_type_symbol, s7_make_function(s7, "[acc-" S_default_output_header_type "]", acc_default_output_header_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->default_output_sample_type_symbol, s7_make_function(s7, "[acc-" S_default_output_sample_type "]", acc_default_output_sample_type, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->default_output_chans_symbol, s7_make_function(s7, "[acc-" S_default_output_chans "]", acc_default_output_chans, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->default_output_srate_symbol, s7_make_function(s7, "[acc-" S_default_output_srate "]", acc_default_output_srate, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->ask_before_overwrite_symbol, s7_make_function(s7, "[acc-" S_ask_before_overwrite "]", acc_ask_before_overwrite, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->ask_about_unsaved_edits_symbol, s7_make_function(s7, "[acc-" S_ask_about_unsaved_edits "]", acc_ask_about_unsaved_edits, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_full_duration_symbol, s7_make_function(s7, "[acc-" S_show_full_duration "]", acc_show_full_duration, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_full_range_symbol, s7_make_function(s7, "[acc-" S_show_full_range "]", acc_show_full_range, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->remember_sound_state_symbol, s7_make_function(s7, "[acc-" S_remember_sound_state "]", acc_remember_sound_state, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->save_as_dialog_src_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_src "]", acc_save_as_dialog_src, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->save_as_dialog_auto_comment_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_auto_comment "]", acc_save_as_dialog_auto_comment, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_toolbar_symbol, s7_make_function(s7, "[acc-" S_with_toolbar "]", acc_with_toolbar, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_tooltips_symbol, s7_make_function(s7, "[acc-" S_with_tooltips "]", acc_with_tooltips, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_menu_icons_symbol, s7_make_function(s7, "[acc-" S_with_menu_icons "]", acc_with_menu_icons, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->initial_beg_symbol, s7_make_function(s7, "[acc-" S_initial_beg "]", acc_initial_beg, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->initial_dur_symbol, s7_make_function(s7, "[acc-" S_initial_dur "]", acc_initial_dur, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->auto_update_symbol, s7_make_function(s7, "[acc-" S_auto_update "]", acc_auto_update, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->auto_update_interval_symbol, s7_make_function(s7, "[acc-" S_auto_update_interval "]", acc_auto_update_interval, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->clipping_symbol, s7_make_function(s7, "[acc-" S_clipping "]", acc_clipping, 2, 0, false, "accessor")); #endif } @@ -549,7 +549,7 @@ static void remake_edit_history(chan_info *cp) lst = EDIT_HISTORY_LIST(cp); if (!lst) return; - /* if you try to update something in a closed pane, goddamn gtk grinds to a halt */ + /* if you try to update something in a closed pane, gtk grinds to a halt */ if (gtk_paned_get_position(GTK_PANED(cp->widgets[W_main_window])) < 10) return; slist_clear(lst); @@ -1540,8 +1540,8 @@ leaves the drawing area (graph pane) of the given channel." mouse_leave_graph_hook = Xen_define_hook(S_mouse_leave_graph_hook, "(make-hook 'snd 'chn)", 2, H_mouse_leave_graph_hook); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape"); + s7_set_setter(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape"); #endif } diff --git a/snd-gxcolormaps.c b/snd-gxcolormaps.c index 77f422e..cfd051f 100644 --- a/snd-gxcolormaps.c +++ b/snd-gxcolormaps.c @@ -1323,10 +1323,10 @@ void g_init_gxcolormaps(void) s7_make_signature(s7, 1, i), s7_make_signature(s7, 2, i, i)); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->color_map_size_symbol, s7_make_function(s7, "[acc-" S_colormap_size "]", acc_colormap_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->color_map_symbol, s7_make_function(s7, "[acc-" S_colormap "]", acc_colormap, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->color_map_size_symbol, s7_make_function(s7, "[acc-" S_colormap_size "]", acc_colormap_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->color_map_symbol, s7_make_function(s7, "[acc-" S_colormap "]", acc_colormap, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->color_map_size_symbol, "*colormap-size*: current colormap size; default is 512."); - s7_symbol_set_documentation(s7, ss->color_map_symbol, "*colormap*: current colormap choice."); + s7_set_documentation(s7, ss->color_map_size_symbol, "*colormap-size*: current colormap size; default is 512."); + s7_set_documentation(s7, ss->color_map_symbol, "*colormap*: current colormap choice."); #endif } @@ -3627,7 +3627,7 @@ and its value is returned." } else { - str = s7_symbol_documentation(s7, s7_make_symbol(s7, subject)); + str = (char *)s7_documentation(s7, s7_make_symbol(s7, subject)); } } } @@ -3906,10 +3906,10 @@ If more than one hook function, each function gets the previous function's outpu #if HAVE_SCHEME autoload_info(s7); /* snd-xref.c included above */ - s7_symbol_set_setter(s7, ss->html_dir_symbol, s7_make_function(s7, "[acc-" S_html_dir "]", acc_html_dir, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->html_program_symbol, s7_make_function(s7, "[acc-" S_html_program "]", acc_html_program, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->html_dir_symbol, s7_make_function(s7, "[acc-" S_html_dir "]", acc_html_dir, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->html_program_symbol, s7_make_function(s7, "[acc-" S_html_program "]", acc_html_program, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->html_dir_symbol, "*html-dir*: location of Snd documentation"); - s7_symbol_set_documentation(s7, ss->html_program_symbol, "*html-program*: name of documentation reader (firefox)"); + s7_set_documentation(s7, ss->html_dir_symbol, "*html-dir*: location of Snd documentation"); + s7_set_documentation(s7, ss->html_program_symbol, "*html-program*: name of documentation reader (firefox)"); #endif } diff --git a/snd-lint.scm b/snd-lint.scm index dd1b21f..05f492d 100644 --- a/snd-lint.scm +++ b/snd-lint.scm @@ -240,7 +240,7 @@ (null? (cdr body)) (pair? (car body)) (eq? (caar body) 'float-vector-set!) - ;(eqv? 0 (cadar vars)) -- we'll use shared-vector if not 0 + ;(eqv? 0 (cadar vars)) -- we'll use subvector if not 0 (pair? (cddar vars)) (eqv? (length (caddar vars)) 3)) (let ((stepper (caddar vars)) diff --git a/snd-listener.c b/snd-listener.c index c5658ec..2947e7d 100644 --- a/snd-listener.c +++ b/snd-listener.c @@ -314,12 +314,12 @@ If it returns true, Snd assumes you've dealt the text yourself, and does not try #if HAVE_SCHEME #if USE_GTK - s7_symbol_set_documentation(s7, ss->listener_colorized_symbol, "*listener-colorized*: number of vector elements to print in the listener (default: 12)"); - s7_symbol_set_setter(s7, ss->listener_colorized_symbol, s7_make_function(s7, "[acc-" S_listener_colorized "]", acc_listener_colorized, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->listener_colorized_symbol, "*listener-colorized*: number of vector elements to print in the listener (default: 12)"); + s7_set_setter(s7, ss->listener_colorized_symbol, s7_make_function(s7, "[acc-" S_listener_colorized "]", acc_listener_colorized, 2, 0, false, "accessor")); #endif - s7_symbol_set_documentation(s7, ss->listener_prompt_symbol, "*listener-prompt*: the current lisp listener prompt string (\">\") "); - s7_symbol_set_setter(s7, ss->listener_prompt_symbol, s7_make_function(s7, "[acc-" S_listener_prompt "]", acc_listener_prompt, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->stdin_prompt_symbol, "*stdin-prompt*: the current stdin prompt string"); - s7_symbol_set_setter(s7, ss->stdin_prompt_symbol, s7_make_function(s7, "[acc-" S_stdin_prompt "]", acc_stdin_prompt, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->listener_prompt_symbol, "*listener-prompt*: the current lisp listener prompt string (\">\") "); + s7_set_setter(s7, ss->listener_prompt_symbol, s7_make_function(s7, "[acc-" S_listener_prompt "]", acc_listener_prompt, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->stdin_prompt_symbol, "*stdin-prompt*: the current stdin prompt string"); + s7_set_setter(s7, ss->stdin_prompt_symbol, s7_make_function(s7, "[acc-" S_stdin_prompt "]", acc_stdin_prompt, 2, 0, false, "accessor")); #endif } @@ -2460,62 +2460,62 @@ the hook functions return " PROC_TRUE ", the save state process opens the file ' #endif #if HAVE_SCHEME - s7_symbol_set_documentation(s7, ss->temp_dir_symbol, "*temp-dir*: name of directory for temp files (or #f=null)"); - s7_symbol_set_documentation(s7, ss->save_dir_symbol, "*save-dir*: name of directory for saved state data (or #f=null)"); - s7_symbol_set_documentation(s7, ss->ladspa_dir_symbol, "*ladspa-dir*: name of directory for ladspa plugin libraries"); - s7_symbol_set_documentation(s7, ss->peak_env_dir_symbol, "*peak-env-dir*: name of directory for peak env files (or #f=null)"); - s7_symbol_set_documentation(s7, ss->listener_font_symbol, "*listener-font*: font used by the lisp listener"); - s7_symbol_set_documentation(s7, ss->axis_label_font_symbol, "*axis-label-font*: font used for axis labels"); - s7_symbol_set_documentation(s7, ss->axis_numbers_font_symbol, "*axis-numbers-font*: font used for axis numbers"); - s7_symbol_set_documentation(s7, ss->tiny_font_symbol, "*tiny-font*: font use for some info in the graphs"); - s7_symbol_set_documentation(s7, ss->peaks_font_symbol, "*peaks-font*: normal font used by fft peak display"); - s7_symbol_set_documentation(s7, ss->bold_peaks_font_symbol, "*bold-peaks-font*: bold font used by fft peak display"); - s7_symbol_set_documentation(s7, ss->with_inset_graph_symbol, "*with-inset-graph*: if #t, display the inset graph in the time domain section."); - s7_symbol_set_documentation(s7, ss->with_pointer_focus_symbol, "*with-pointer-focus*: if #t, activate the text or graph widget beneath the mouse."); - s7_symbol_set_documentation(s7, ss->with_smpte_label_symbol, "*with-smpte-label*: if #t, display the SMPTE data in the time domain section."); - s7_symbol_set_documentation(s7, ss->with_interrupts_symbol, "*with-interrupts*: if #t, check for GUI events during computations."); - s7_symbol_set_documentation(s7, ss->color_scale_symbol, "*color-scale*: darkness setting for colormaps (0.5)"); - s7_symbol_set_documentation(s7, ss->color_cutoff_symbol, "*color-cutoff*: color map cutoff point (default .003)."); - s7_symbol_set_documentation(s7, ss->color_inverted_symbol, "*color-inverted*: whether the colormap in operation should be inverted"); - s7_symbol_set_documentation(s7, ss->auto_resize_symbol, "*auto-resize*: #t if Snd can change its main window size as it pleases"); - s7_symbol_set_documentation(s7, ss->print_length_symbol, "*print-length*: number of vector elements to print in the listener (12)"); - s7_symbol_set_documentation(s7, ss->selection_creates_region_symbol, "*selection-creates-region*: #t if a region should be created each time a selection is made."); - s7_symbol_set_documentation(s7, ss->save_state_file_symbol, "*save-state-file*: the name of the saved state file (\"saved-snd.scm\")"); - s7_symbol_set_documentation(s7, ss->with_background_processes_symbol, "*with-background-processes*: #t if Snd should use background (idle time) processing"); - s7_symbol_set_documentation(s7, ss->with_file_monitor_symbol, "*with-file-monitor*: #t if the file alteration monitor is active"); - s7_symbol_set_documentation(s7, ss->show_indices_symbol, "*show-indices*: #t if sound name should be preceded by its index in the sound display."); - s7_symbol_set_documentation(s7, ss->just_sounds_symbol, "*just-sounds*: the 'just sounds' choice in the file chooser dialog"); - s7_symbol_set_documentation(s7, ss->play_arrow_size_symbol, "*play-arrow-size*: the size of the play triangles"); - s7_symbol_set_documentation(s7, ss->with_relative_panes_symbol, "*with-relative-panes*: #t if multichannel sounds should try to maintain relative pane sizes"); - s7_symbol_set_documentation(s7, ss->open_file_dialog_directory_symbol, "*open-file-dialog-directory*: name of directory for initial open file dialog search"); - - s7_symbol_set_setter(s7, ss->temp_dir_symbol, s7_make_function(s7, "[acc-" S_temp_dir "]", acc_temp_dir, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->save_dir_symbol, s7_make_function(s7, "[acc-" S_save_dir "]", acc_save_dir, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->ladspa_dir_symbol, s7_make_function(s7, "[acc-" S_ladspa_dir "]", acc_ladspa_dir, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->peak_env_dir_symbol, s7_make_function(s7, "[acc-" S_peak_env_dir "]", acc_peak_env_dir, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->listener_font_symbol, s7_make_function(s7, "[acc-" S_listener_font "]", acc_listener_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->axis_label_font_symbol, s7_make_function(s7, "[acc-" S_axis_label_font "]", acc_axis_label_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->axis_numbers_font_symbol, s7_make_function(s7, "[acc-" S_axis_numbers_font "]", acc_axis_numbers_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->tiny_font_symbol, s7_make_function(s7, "[acc-" S_tiny_font "]", acc_tiny_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->peaks_font_symbol, s7_make_function(s7, "[acc-" S_peaks_font "]", acc_peaks_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->bold_peaks_font_symbol, s7_make_function(s7, "[acc-" S_bold_peaks_font "]", acc_bold_peaks_font, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_inset_graph_symbol, s7_make_function(s7, "[acc-" S_with_inset_graph "]", acc_with_inset_graph, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_pointer_focus_symbol, s7_make_function(s7, "[acc-" S_with_pointer_focus "]", acc_with_pointer_focus, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_smpte_label_symbol, s7_make_function(s7, "[acc-" S_with_smpte_label "]", acc_with_smpte_label, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_interrupts_symbol, s7_make_function(s7, "[acc-" S_with_interrupts "]", acc_with_interrupts, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->color_scale_symbol, s7_make_function(s7, "[acc-" S_color_scale "]", acc_color_scale, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->color_cutoff_symbol, s7_make_function(s7, "[acc-" S_color_cutoff "]", acc_color_cutoff, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->color_inverted_symbol, s7_make_function(s7, "[acc-" S_color_inverted "]", acc_color_inverted, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->auto_resize_symbol, s7_make_function(s7, "[acc-" S_auto_resize "]", acc_auto_resize, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->print_length_symbol, s7_make_function(s7, "[acc-" S_print_length "]", acc_print_length, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->selection_creates_region_symbol, s7_make_function(s7, "[acc-" S_selection_creates_region "]", acc_selection_creates_region, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->save_state_file_symbol, s7_make_function(s7, "[acc-" S_save_state_file "]", acc_save_state_file, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_background_processes_symbol, s7_make_function(s7, "[acc-" S_with_background_processes "]", acc_with_background_processes, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_file_monitor_symbol, s7_make_function(s7, "[acc-" S_with_file_monitor "]", acc_with_file_monitor, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_indices_symbol, s7_make_function(s7, "[acc-" S_show_indices "]", acc_show_indices, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->just_sounds_symbol, s7_make_function(s7, "[acc-" S_just_sounds "]", acc_just_sounds, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->play_arrow_size_symbol, s7_make_function(s7, "[acc-" S_play_arrow_size "]", acc_play_arrow_size, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_relative_panes_symbol, s7_make_function(s7, "[acc-" S_with_relative_panes "]", acc_with_relative_panes, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->open_file_dialog_directory_symbol, s7_make_function(s7, "[acc-" S_open_file_dialog_directory "]", acc_open_file_dialog_directory, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->temp_dir_symbol, "*temp-dir*: name of directory for temp files (or #f=null)"); + s7_set_documentation(s7, ss->save_dir_symbol, "*save-dir*: name of directory for saved state data (or #f=null)"); + s7_set_documentation(s7, ss->ladspa_dir_symbol, "*ladspa-dir*: name of directory for ladspa plugin libraries"); + s7_set_documentation(s7, ss->peak_env_dir_symbol, "*peak-env-dir*: name of directory for peak env files (or #f=null)"); + s7_set_documentation(s7, ss->listener_font_symbol, "*listener-font*: font used by the lisp listener"); + s7_set_documentation(s7, ss->axis_label_font_symbol, "*axis-label-font*: font used for axis labels"); + s7_set_documentation(s7, ss->axis_numbers_font_symbol, "*axis-numbers-font*: font used for axis numbers"); + s7_set_documentation(s7, ss->tiny_font_symbol, "*tiny-font*: font use for some info in the graphs"); + s7_set_documentation(s7, ss->peaks_font_symbol, "*peaks-font*: normal font used by fft peak display"); + s7_set_documentation(s7, ss->bold_peaks_font_symbol, "*bold-peaks-font*: bold font used by fft peak display"); + s7_set_documentation(s7, ss->with_inset_graph_symbol, "*with-inset-graph*: if #t, display the inset graph in the time domain section."); + s7_set_documentation(s7, ss->with_pointer_focus_symbol, "*with-pointer-focus*: if #t, activate the text or graph widget beneath the mouse."); + s7_set_documentation(s7, ss->with_smpte_label_symbol, "*with-smpte-label*: if #t, display the SMPTE data in the time domain section."); + s7_set_documentation(s7, ss->with_interrupts_symbol, "*with-interrupts*: if #t, check for GUI events during computations."); + s7_set_documentation(s7, ss->color_scale_symbol, "*color-scale*: darkness setting for colormaps (0.5)"); + s7_set_documentation(s7, ss->color_cutoff_symbol, "*color-cutoff*: color map cutoff point (default .003)."); + s7_set_documentation(s7, ss->color_inverted_symbol, "*color-inverted*: whether the colormap in operation should be inverted"); + s7_set_documentation(s7, ss->auto_resize_symbol, "*auto-resize*: #t if Snd can change its main window size as it pleases"); + s7_set_documentation(s7, ss->print_length_symbol, "*print-length*: number of vector elements to print in the listener (12)"); + s7_set_documentation(s7, ss->selection_creates_region_symbol, "*selection-creates-region*: #t if a region should be created each time a selection is made."); + s7_set_documentation(s7, ss->save_state_file_symbol, "*save-state-file*: the name of the saved state file (\"saved-snd.scm\")"); + s7_set_documentation(s7, ss->with_background_processes_symbol, "*with-background-processes*: #t if Snd should use background (idle time) processing"); + s7_set_documentation(s7, ss->with_file_monitor_symbol, "*with-file-monitor*: #t if the file alteration monitor is active"); + s7_set_documentation(s7, ss->show_indices_symbol, "*show-indices*: #t if sound name should be preceded by its index in the sound display."); + s7_set_documentation(s7, ss->just_sounds_symbol, "*just-sounds*: the 'just sounds' choice in the file chooser dialog"); + s7_set_documentation(s7, ss->play_arrow_size_symbol, "*play-arrow-size*: the size of the play triangles"); + s7_set_documentation(s7, ss->with_relative_panes_symbol, "*with-relative-panes*: #t if multichannel sounds should try to maintain relative pane sizes"); + s7_set_documentation(s7, ss->open_file_dialog_directory_symbol, "*open-file-dialog-directory*: name of directory for initial open file dialog search"); + + s7_set_setter(s7, ss->temp_dir_symbol, s7_make_function(s7, "[acc-" S_temp_dir "]", acc_temp_dir, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->save_dir_symbol, s7_make_function(s7, "[acc-" S_save_dir "]", acc_save_dir, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->ladspa_dir_symbol, s7_make_function(s7, "[acc-" S_ladspa_dir "]", acc_ladspa_dir, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->peak_env_dir_symbol, s7_make_function(s7, "[acc-" S_peak_env_dir "]", acc_peak_env_dir, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->listener_font_symbol, s7_make_function(s7, "[acc-" S_listener_font "]", acc_listener_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->axis_label_font_symbol, s7_make_function(s7, "[acc-" S_axis_label_font "]", acc_axis_label_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->axis_numbers_font_symbol, s7_make_function(s7, "[acc-" S_axis_numbers_font "]", acc_axis_numbers_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->tiny_font_symbol, s7_make_function(s7, "[acc-" S_tiny_font "]", acc_tiny_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->peaks_font_symbol, s7_make_function(s7, "[acc-" S_peaks_font "]", acc_peaks_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->bold_peaks_font_symbol, s7_make_function(s7, "[acc-" S_bold_peaks_font "]", acc_bold_peaks_font, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_inset_graph_symbol, s7_make_function(s7, "[acc-" S_with_inset_graph "]", acc_with_inset_graph, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_pointer_focus_symbol, s7_make_function(s7, "[acc-" S_with_pointer_focus "]", acc_with_pointer_focus, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_smpte_label_symbol, s7_make_function(s7, "[acc-" S_with_smpte_label "]", acc_with_smpte_label, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_interrupts_symbol, s7_make_function(s7, "[acc-" S_with_interrupts "]", acc_with_interrupts, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->color_scale_symbol, s7_make_function(s7, "[acc-" S_color_scale "]", acc_color_scale, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->color_cutoff_symbol, s7_make_function(s7, "[acc-" S_color_cutoff "]", acc_color_cutoff, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->color_inverted_symbol, s7_make_function(s7, "[acc-" S_color_inverted "]", acc_color_inverted, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->auto_resize_symbol, s7_make_function(s7, "[acc-" S_auto_resize "]", acc_auto_resize, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->print_length_symbol, s7_make_function(s7, "[acc-" S_print_length "]", acc_print_length, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->selection_creates_region_symbol, s7_make_function(s7, "[acc-" S_selection_creates_region "]", acc_selection_creates_region, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->save_state_file_symbol, s7_make_function(s7, "[acc-" S_save_state_file "]", acc_save_state_file, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_background_processes_symbol, s7_make_function(s7, "[acc-" S_with_background_processes "]", acc_with_background_processes, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_file_monitor_symbol, s7_make_function(s7, "[acc-" S_with_file_monitor "]", acc_with_file_monitor, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_indices_symbol, s7_make_function(s7, "[acc-" S_show_indices "]", acc_show_indices, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->just_sounds_symbol, s7_make_function(s7, "[acc-" S_just_sounds "]", acc_just_sounds, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->play_arrow_size_symbol, s7_make_function(s7, "[acc-" S_play_arrow_size "]", acc_play_arrow_size, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_relative_panes_symbol, s7_make_function(s7, "[acc-" S_with_relative_panes "]", acc_with_relative_panes, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->open_file_dialog_directory_symbol, s7_make_function(s7, "[acc-" S_open_file_dialog_directory "]", acc_open_file_dialog_directory, 2, 0, false, "accessor")); #endif } diff --git a/snd-marks.c b/snd-marks.c index 710ba67..7e01e1b 100644 --- a/snd-marks.c +++ b/snd-marks.c @@ -3037,11 +3037,11 @@ If the hook returns " PROC_TRUE ", the mark is not drawn." draw_mark_hook = Xen_define_hook(S_draw_mark_hook, "(make-hook 'id)", 1, H_draw_mark_hook); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->mark_tag_height_symbol, s7_make_function(s7, "[acc-" S_mark_tag_height "]", acc_mark_tag_height, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->mark_tag_width_symbol, s7_make_function(s7, "[acc-" S_mark_tag_width "]", acc_mark_tag_width, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mark_tag_height_symbol, s7_make_function(s7, "[acc-" S_mark_tag_height "]", acc_mark_tag_height, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mark_tag_width_symbol, s7_make_function(s7, "[acc-" S_mark_tag_width "]", acc_mark_tag_width, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->mark_tag_height_symbol, "*mark-tag-height*: height (pixels) of mark tags (4)"); - s7_symbol_set_documentation(s7, ss->mark_tag_width_symbol, "*mark-tag-width*: width (pixels) of mark tags (10)"); + s7_set_documentation(s7, ss->mark_tag_height_symbol, "*mark-tag-height*: height (pixels) of mark tags (4)"); + s7_set_documentation(s7, ss->mark_tag_width_symbol, "*mark-tag-width*: width (pixels) of mark tags (10)"); #endif } @@ -4352,15 +4352,15 @@ void g_init_mix(void) draw_mix_hook = Xen_define_hook(S_draw_mix_hook, "(make-hook 'id 'old-x 'old-y 'x 'y)", 5, H_draw_mix_hook); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->mix_tag_height_symbol, s7_make_function(s7, "[acc-" S_mix_tag_height "]", acc_mix_tag_height, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->mix_tag_width_symbol, s7_make_function(s7, "[acc-" S_mix_tag_width "]", acc_mix_tag_width, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->mix_waveform_height_symbol, s7_make_function(s7, "[acc-" S_mix_waveform_height "]", acc_mix_waveform_height, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->with_mix_tags_symbol, s7_make_function(s7, "[acc-" S_with_mix_tags "]", acc_with_mix_tags, 2, 0, false, "accessor")); - - s7_symbol_set_documentation(s7, ss->mix_tag_height_symbol, "*mix-tag-height*: height (pixels) of mix tags (14)"); - s7_symbol_set_documentation(s7, ss->mix_tag_width_symbol, "*mix-tag-width*: width (pixels) of mix tags (6)"); - s7_symbol_set_documentation(s7, ss->mix_waveform_height_symbol, "*mix-waveform-height*: max height (pixels) of mix waveforms (20)"); - s7_symbol_set_documentation(s7, ss->with_mix_tags_symbol, "*with-mix-tags*: #t if Snd should try to use virtual (tagged) mixing"); + s7_set_setter(s7, ss->mix_tag_height_symbol, s7_make_function(s7, "[acc-" S_mix_tag_height "]", acc_mix_tag_height, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mix_tag_width_symbol, s7_make_function(s7, "[acc-" S_mix_tag_width "]", acc_mix_tag_width, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->mix_waveform_height_symbol, s7_make_function(s7, "[acc-" S_mix_waveform_height "]", acc_mix_waveform_height, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->with_mix_tags_symbol, s7_make_function(s7, "[acc-" S_with_mix_tags "]", acc_with_mix_tags, 2, 0, false, "accessor")); + + s7_set_documentation(s7, ss->mix_tag_height_symbol, "*mix-tag-height*: height (pixels) of mix tags (14)"); + s7_set_documentation(s7, ss->mix_tag_width_symbol, "*mix-tag-width*: width (pixels) of mix tags (6)"); + s7_set_documentation(s7, ss->mix_waveform_height_symbol, "*mix-waveform-height*: max height (pixels) of mix waveforms (20)"); + s7_set_documentation(s7, ss->with_mix_tags_symbol, "*with-mix-tags*: #t if Snd should try to use virtual (tagged) mixing"); #endif } diff --git a/snd-motif.c b/snd-motif.c index f861a66..32de45d 100644 --- a/snd-motif.c +++ b/snd-motif.c @@ -31085,12 +31085,12 @@ void g_init_motif(void) #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->view_files_sort_symbol, s7_make_function(s7, "[acc-" S_view_files_sort "]", acc_view_files_sort, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->view_files_sort_symbol, s7_make_function(s7, "[acc-" S_view_files_sort "]", acc_view_files_sort, 2, 0, false, "accessor")); top_level_let = s7_nil(s7); s7_define_variable(s7, "top-level-let", s7_dilambda(s7, "top-level-let", g_top_level_let, 0, 0, g_set_top_level_let, 1, 0, "listener environment")); - s7_symbol_set_setter(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape"); + s7_set_setter(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape"); #endif preload_best_completions(); diff --git a/snd-print.c b/snd-print.c index 7858d0c..a0aaa1f 100644 --- a/snd-print.c +++ b/snd-print.c @@ -813,14 +813,14 @@ void g_init_print(void) #endif #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->eps_bottom_margin_symbol, s7_make_function(s7, "[acc-" S_eps_bottom_margin "]", acc_eps_bottom_margin, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->eps_file_symbol, s7_make_function(s7, "[acc-" S_eps_file "]", acc_eps_file, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->eps_left_margin_symbol, s7_make_function(s7, "[acc-" S_eps_left_margin "]", acc_eps_left_margin, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->eps_size_symbol, s7_make_function(s7, "[acc-" S_eps_size "]", acc_eps_size, 2, 0, false, "accessor")); - - s7_symbol_set_documentation(s7, ss->eps_bottom_margin_symbol, "*eps-bottom-margin*: File:Print and graph->ps bottom margin"); - s7_symbol_set_documentation(s7, ss->eps_file_symbol, "*eps-file*: File:Print and graph->ps file name (snd.eps)"); - s7_symbol_set_documentation(s7, ss->eps_left_margin_symbol, "*eps-left-margin*: File:Print and graph->ps left margin"); - s7_symbol_set_documentation(s7, ss->eps_size_symbol, "*eps-size*: File:Print and graph->ps output size scaler (1.0)"); + s7_set_setter(s7, ss->eps_bottom_margin_symbol, s7_make_function(s7, "[acc-" S_eps_bottom_margin "]", acc_eps_bottom_margin, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->eps_file_symbol, s7_make_function(s7, "[acc-" S_eps_file "]", acc_eps_file, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->eps_left_margin_symbol, s7_make_function(s7, "[acc-" S_eps_left_margin "]", acc_eps_left_margin, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->eps_size_symbol, s7_make_function(s7, "[acc-" S_eps_size "]", acc_eps_size, 2, 0, false, "accessor")); + + s7_set_documentation(s7, ss->eps_bottom_margin_symbol, "*eps-bottom-margin*: File:Print and graph->ps bottom margin"); + s7_set_documentation(s7, ss->eps_file_symbol, "*eps-file*: File:Print and graph->ps file name (snd.eps)"); + s7_set_documentation(s7, ss->eps_left_margin_symbol, "*eps-left-margin*: File:Print and graph->ps left margin"); + s7_set_documentation(s7, ss->eps_size_symbol, "*eps-size*: File:Print and graph->ps output size scaler (1.0)"); #endif } diff --git a/snd-region.c b/snd-region.c index 11130d4..2493f7b 100644 --- a/snd-region.c +++ b/snd-region.c @@ -513,8 +513,8 @@ void for_each_region_chan_with_refint(void (*func)(chan_info *ncp, int *val), in region_state *region_report(void) { region_state *rs; - int i, len; - size_t size; + int i, len, size; + rs = (region_state *)calloc(1, sizeof(region_state)); len = regions_size; for (i = 0; i < regions_size; i++) @@ -2335,11 +2335,11 @@ void g_init_regions(void) s7_make_signature(s7, 1, i), s7_make_signature(s7, 2, i, i)); #if HAVE_SCHEME - s7_symbol_set_setter(s7, ss->max_regions_symbol, s7_make_function(s7, "[acc-" S_max_regions "]", acc_max_regions, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->region_graph_style_symbol, s7_make_function(s7, "[acc-" S_region_graph_style "]", acc_region_graph_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->max_regions_symbol, s7_make_function(s7, "[acc-" S_max_regions "]", acc_max_regions, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->region_graph_style_symbol, s7_make_function(s7, "[acc-" S_region_graph_style "]", acc_region_graph_style, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->max_regions_symbol, "*max-regions*: max number of regions saved on the region list"); - s7_symbol_set_documentation(s7, ss->region_graph_style_symbol, "*region-graph-style*: graph style of the region dialog graph (graph-lines etc)"); + s7_set_documentation(s7, ss->max_regions_symbol, "*max-regions*: max number of regions saved on the region list"); + s7_set_documentation(s7, ss->region_graph_style_symbol, "*region-graph-style*: graph style of the region dialog graph (graph-lines etc)"); s7_define_safe_function_star(s7, S_save_region, g_save_region, "region file sample-type header-type comment", H_save_region); #else @@ -3162,7 +3162,7 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f mus_long_t k, new_dur = 0, dur = 0; mus_float_t **data; file_info *hdr = NULL; - int j, ofd = 0, datumb = 0, err = 0, srate = 0; + int j, ofd = 0, datumb = 0, err = 0, srate = 0, olen; io_error_t io_err = IO_NO_ERROR; mus_float_t sum; mus_any *e = NULL; @@ -3198,8 +3198,9 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f snd_open_strerror())); } - fds = (snd_fd ***)calloc((size_t)len, sizeof(snd_fd **)); - sps = (snd_info **)calloc((size_t)len, sizeof(snd_info *)); + olen = len * sizeof(snd_fd **); /* try to turn off gcc's alloc-size-larger-than error message */ + fds = (snd_fd ***)calloc(olen, 1); + sps = (snd_info **)calloc(olen, 1); for (i = 0; i < len; i++) { fds[i] = (snd_fd **)calloc(max_chans, sizeof(snd_fd *)); @@ -6590,8 +6591,8 @@ void g_init_sig(void) #if HAVE_SCHEME Xen_define_typed_procedure("phases-get-peak", g_phases_get_peak, 3, 0, 0, "", pcl_t); - s7_symbol_set_setter(s7, ss->sinc_width_symbol, s7_make_function(s7, "[acc-" S_sinc_width "]", acc_sinc_width, 2, 0, false, "accessor")); - s7_symbol_set_documentation(s7, ss->sinc_width_symbol, "*sinc-width*: sampling rate conversion sinc width (10)."); + s7_set_setter(s7, ss->sinc_width_symbol, s7_make_function(s7, "[acc-" S_sinc_width "]", acc_sinc_width, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->sinc_width_symbol, "*sinc-width*: sampling rate conversion sinc width (10)."); gc_vect = s7_make_vector(s7, 4); s7_gc_protect(s7, gc_vect); @@ -3726,7 +3726,7 @@ static Xen g_file_name(Xen snd) #if HAVE_SCHEME if ((s7_is_input_port(s7, snd)) || (s7_is_output_port(s7, snd))) - return(C_string_to_Xen_string(s7_port_filename(snd))); + return(C_string_to_Xen_string(s7_port_filename(s7, snd))); #endif if (Xen_is_string(snd)) @@ -6368,36 +6368,36 @@ If it returns " PROC_TRUE ", the usual informative status babbling is squelched. Xen_define_typed_procedure(S_sound_to_integer, g_sound_to_integer_w, 1, 0, 0, H_sound_to_integer, pl_io); #if HAVE_SCHEME - s7_symbol_set_documentation(s7, ss->channel_style_symbol, "*channel-style*: how multichannel sounds lay out the channels: channels-combined, channels-separate or channels-superimposed."); - s7_symbol_set_documentation(s7, ss->filter_control_in_db_symbol, "*filter-control-in-dB*: #t if snd's filter envelope is displayed in dB in control panel"); - s7_symbol_set_documentation(s7, ss->filter_control_in_hz_symbol, "*filter-control-in-hz*: #t if snd's filter envelope x axis should be in hz (control panel filter)"); - s7_symbol_set_documentation(s7, ss->speed_control_tones_symbol, "*speed-control-tones*: the speed-control octave divisions (12)"); - s7_symbol_set_documentation(s7, ss->speed_control_style_symbol, "*speed-control-style*: speed control choice (speed-control-as-float etc)"); - s7_symbol_set_documentation(s7, ss->expand_control_length_symbol, "*expand-control-length*: current expansion segment length in seconds (.15)"); - s7_symbol_set_documentation(s7, ss->expand_control_ramp_symbol, "*expand-control-ramp*: current expansion ramp time (.4)"); - s7_symbol_set_documentation(s7, ss->expand_control_hop_symbol, "*expand-control-hop*: current expansion output grain spacing in seconds (0.05)"); - s7_symbol_set_documentation(s7, ss->expand_control_jitter_symbol, "*expand-control-jitter*: current expansion output grain spacing jitter (0.1)"); - s7_symbol_set_documentation(s7, ss->contrast_control_amp_symbol, "*contrast-control-amp*: contrast amp"); - s7_symbol_set_documentation(s7, ss->reverb_control_feedback_symbol, "*reverb-control-feedback*: control-panel reverb feedback scaler"); - s7_symbol_set_documentation(s7, ss->reverb_control_lowpass_symbol, "*reverb-control-lowpass*: control-panel reverb lowpass filter coefficient"); - s7_symbol_set_documentation(s7, ss->reverb_control_decay_symbol, "*reverb-control-decay*: control-panel reverb decay time (1.0 seconds)"); - s7_symbol_set_documentation(s7, ss->filter_control_order_symbol, "*filter-control-order*: control-panel filter order"); - s7_symbol_set_documentation(s7, ss->show_controls_symbol, "*show-controls*: #t if snd's control panel is known to be open"); - - s7_symbol_set_setter(s7, ss->channel_style_symbol, s7_make_function(s7, "[acc-" S_channel_style "]", acc_channel_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->filter_control_in_db_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_dB "]", acc_filter_control_in_dB, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->filter_control_in_hz_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_hz "]", acc_filter_control_in_hz, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->speed_control_tones_symbol, s7_make_function(s7, "[acc-" S_speed_control_tones "]", acc_speed_control_tones, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->speed_control_style_symbol, s7_make_function(s7, "[acc-" S_speed_control_style "]", acc_speed_control_style, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->expand_control_length_symbol, s7_make_function(s7, "[acc-" S_expand_control_length "]", acc_expand_control_length, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->expand_control_ramp_symbol, s7_make_function(s7, "[acc-" S_expand_control_ramp "]", acc_expand_control_ramp, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->expand_control_hop_symbol, s7_make_function(s7, "[acc-" S_expand_control_hop "]", acc_expand_control_hop, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->expand_control_jitter_symbol, s7_make_function(s7, "[acc-" S_expand_control_jitter "]", acc_expand_control_jitter, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->contrast_control_amp_symbol, s7_make_function(s7, "[acc-" S_contrast_control_amp "]", acc_contrast_control_amp, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->reverb_control_feedback_symbol, s7_make_function(s7, "[acc-" S_reverb_control_feedback "]", acc_reverb_control_feedback, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->reverb_control_lowpass_symbol, s7_make_function(s7, "[acc-" S_reverb_control_lowpass "]", acc_reverb_control_lowpass, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->reverb_control_decay_symbol, s7_make_function(s7, "[acc-" S_reverb_control_decay "]", acc_reverb_control_decay, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->filter_control_order_symbol, s7_make_function(s7, "[acc-" S_filter_control_order "]", acc_filter_control_order, 2, 0, false, "accessor")); - s7_symbol_set_setter(s7, ss->show_controls_symbol, s7_make_function(s7, "[acc-" S_show_controls "]", acc_show_controls, 2, 0, false, "accessor")); + s7_set_documentation(s7, ss->channel_style_symbol, "*channel-style*: how multichannel sounds lay out the channels: channels-combined, channels-separate or channels-superimposed."); + s7_set_documentation(s7, ss->filter_control_in_db_symbol, "*filter-control-in-dB*: #t if snd's filter envelope is displayed in dB in control panel"); + s7_set_documentation(s7, ss->filter_control_in_hz_symbol, "*filter-control-in-hz*: #t if snd's filter envelope x axis should be in hz (control panel filter)"); + s7_set_documentation(s7, ss->speed_control_tones_symbol, "*speed-control-tones*: the speed-control octave divisions (12)"); + s7_set_documentation(s7, ss->speed_control_style_symbol, "*speed-control-style*: speed control choice (speed-control-as-float etc)"); + s7_set_documentation(s7, ss->expand_control_length_symbol, "*expand-control-length*: current expansion segment length in seconds (.15)"); + s7_set_documentation(s7, ss->expand_control_ramp_symbol, "*expand-control-ramp*: current expansion ramp time (.4)"); + s7_set_documentation(s7, ss->expand_control_hop_symbol, "*expand-control-hop*: current expansion output grain spacing in seconds (0.05)"); + s7_set_documentation(s7, ss->expand_control_jitter_symbol, "*expand-control-jitter*: current expansion output grain spacing jitter (0.1)"); + s7_set_documentation(s7, ss->contrast_control_amp_symbol, "*contrast-control-amp*: contrast amp"); + s7_set_documentation(s7, ss->reverb_control_feedback_symbol, "*reverb-control-feedback*: control-panel reverb feedback scaler"); + s7_set_documentation(s7, ss->reverb_control_lowpass_symbol, "*reverb-control-lowpass*: control-panel reverb lowpass filter coefficient"); + s7_set_documentation(s7, ss->reverb_control_decay_symbol, "*reverb-control-decay*: control-panel reverb decay time (1.0 seconds)"); + s7_set_documentation(s7, ss->filter_control_order_symbol, "*filter-control-order*: control-panel filter order"); + s7_set_documentation(s7, ss->show_controls_symbol, "*show-controls*: #t if snd's control panel is known to be open"); + + s7_set_setter(s7, ss->channel_style_symbol, s7_make_function(s7, "[acc-" S_channel_style "]", acc_channel_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->filter_control_in_db_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_dB "]", acc_filter_control_in_dB, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->filter_control_in_hz_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_hz "]", acc_filter_control_in_hz, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->speed_control_tones_symbol, s7_make_function(s7, "[acc-" S_speed_control_tones "]", acc_speed_control_tones, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->speed_control_style_symbol, s7_make_function(s7, "[acc-" S_speed_control_style "]", acc_speed_control_style, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->expand_control_length_symbol, s7_make_function(s7, "[acc-" S_expand_control_length "]", acc_expand_control_length, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->expand_control_ramp_symbol, s7_make_function(s7, "[acc-" S_expand_control_ramp "]", acc_expand_control_ramp, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->expand_control_hop_symbol, s7_make_function(s7, "[acc-" S_expand_control_hop "]", acc_expand_control_hop, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->expand_control_jitter_symbol, s7_make_function(s7, "[acc-" S_expand_control_jitter "]", acc_expand_control_jitter, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->contrast_control_amp_symbol, s7_make_function(s7, "[acc-" S_contrast_control_amp "]", acc_contrast_control_amp, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->reverb_control_feedback_symbol, s7_make_function(s7, "[acc-" S_reverb_control_feedback "]", acc_reverb_control_feedback, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->reverb_control_lowpass_symbol, s7_make_function(s7, "[acc-" S_reverb_control_lowpass "]", acc_reverb_control_lowpass, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->reverb_control_decay_symbol, s7_make_function(s7, "[acc-" S_reverb_control_decay "]", acc_reverb_control_decay, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->filter_control_order_symbol, s7_make_function(s7, "[acc-" S_filter_control_order "]", acc_filter_control_order, 2, 0, false, "accessor")); + s7_set_setter(s7, ss->show_controls_symbol, s7_make_function(s7, "[acc-" S_show_controls "]", acc_show_controls, 2, 0, false, "accessor")); #endif } diff --git a/snd-test.scm b/snd-test.scm index 8ad8642..8e45102 100644 --- a/snd-test.scm +++ b/snd-test.scm @@ -8644,12 +8644,12 @@ EDITS: 2 (if (not (mus-arrays-equal? (float-vector-abs! v) #r(0.0 1.0 2.0 3.0))) (snd-display "float-vector-abs! ~A" v))) - ;; float-vector-add! + shared-vector: + ;; float-vector-add! + subvector: (let* ((fv #r(1 2 3 4 5)) - (sv (make-shared-vector fv '(4) 1))) + (sv (subvector fv '(4) 1))) (float-vector-add! sv fv) (if (not (mus-arrays-equal? fv #r(1.0 3.0 6.0 10.0 15.0))) - (snd-display "float-vector+shared-vector: ~A" fv))) + (snd-display "float-vector+subvector: ~A" fv))) (do ((i 0 (+ i 1))) ((= i 10)) @@ -9739,7 +9739,7 @@ EDITS: 2 (data (channel->float-vector))) (do ((i 0 (+ i 1))) ((= i bins)) - (float-vector-set! resp i (float-vector-peak (make-shared-vector data (list size) (* i size))))) + (float-vector-set! resp i (float-vector-peak (subvector data (list size) (* i size))))) (close-sound ind) (list mx resp))))) @@ -18335,7 +18335,7 @@ EDITS: 2 (f2 (lambda (g) (if forward ; no change to data (set! forward #f) - (let ((grain (make-shared-vector (mus-data g) (list (mus-length g))))) + (let ((grain (subvector (mus-data g) (list (mus-length g))))) (set! forward #t) (reverse! grain))) ; should get ramps going up then down across overall rising ramp (mus-length g)))) @@ -18396,7 +18396,7 @@ EDITS: 2 :edit (lambda (g) (if forward (set! forward #f) - (let ((grain (make-shared-vector (mus-data g) (list (mus-length g))))) + (let ((grain (subvector (mus-data g) (list (mus-length g))))) (set! forward #t) (reverse! grain))) (mus-length g))))) @@ -25991,7 +25991,7 @@ EDITS: 2 ((= i len) v) (let ((bin (round (* 16.0 (abs (next-sample fd)))))) (if (< bin steps) - (float-vector-offset! (make-shared-vector v (list steps) bin) step)))))))) + (float-vector-offset! (subvector v (list steps) bin) step)))))))) (set! (x-bounds) '(.1 .2)) (set! *transform-type* fourier-transform) (set! (x-bounds) '(.1 .2)) @@ -36120,7 +36120,7 @@ EDITS: 1 (list 'scale-selection (lambda () (select-all) (scale-selection-by 2.0))) (list 'mix (lambda () (save-sound-as "temp.snd") (mix "temp.snd" 0) (delete-file "temp.snd"))) (list 'vector2 (lambda () - (let ((sd (make-shared-vector (channel->float-vector) (list 1 (framples))))) + (let ((sd (subvector (channel->float-vector) (list 1 (framples))))) (float-vector-scale! (sd 0) 2.0) (float-vector->channel (sd 0))))) (list 'convolve (lambda () @@ -41757,7 +41757,7 @@ EDITS: 1 (set! vector-0 (make-vector 1)) (set! car-main (make-moving-average 3)) (set! cadr-main (make-oscil 440)) - (set! a-hook (make-shared-vector #r(0.1 0.2 0.1 0.2) (list 2 2))))) + (set! a-hook (subvector #r(0.1 0.2 0.1 0.2) (list 2 2))))) (for-each (lambda (n) (let ((tag @@ -1,5 +1,5 @@ /* Snd help index (generated by make-index.scm) */ -#define HELP_NAMES_SIZE 1585 +#define HELP_NAMES_SIZE 1593 #if HAVE_SCHEME || HAVE_FORTH static const char *help_names[HELP_NAMES_SIZE] = { "*#readers*", "abcos", "abcos?", "abort", "absin", "absin?", @@ -20,253 +20,254 @@ static const char *help_names[HELP_NAMES_SIZE] = { "binary files", "bind-key", "bird", "blackman", "blackman4-env-channel", "blackman?", "bold-peaks-font", "break", "brown-noise", "brown-noise?", "butterworth filters", "byte-vector", "byte-vector->string", "byte-vector-ref", "byte-vector-set!", "byte-vector?", "c-define", "c-g?", - "c-object?", "c-pointer", "c-pointer->list", "c-pointer?", "call-with-exit", "canter", - "cascade->canonical", "catch", "cellon", "chain-dsps", "channel->float-vector", "channel-amp-envs", - "channel-data", "channel-envelope", "channel-polynomial", "channel-properties", "channel-property", "channel-rms", - "channel-style", "channel-sync", "channel-widgets", "channels", "channels-equal?", "channels=?", - "chans", "char-position", "cheby-hka", "chebyshev filters", "check-mix-tags", "chordalize", - "chorus", "clean-channel", "clean-sound", "clear-listener", "clip-hook", "clipping", - "clm-channel", "clm-expsrc", "close-hook", "close-sound", "color->list", "color-cutoff", - "color-hook", "color-inverted", "color-mixes", "color-orientation-dialog", "color-scale", "color?", - "colormap", "colormap->integer", "colormap-name", "colormap-ref", "colormap-size", "colormap?", - "comb", "comb-bank", "comb-bank?", "comb?", "combined-data-color", "comment", - "complexify", "concatenate-envelopes", "constant?", "continuation?", "continue-frample->file", "continue-sample->file", - "contrast-channel", "contrast-control", "contrast-control-amp", "contrast-control-bounds", "contrast-control?", "contrast-enhancement", - "contrast-sound", "controls->channel", "convolution", "convolution reverb", "convolve", "convolve-files", - "convolve-selection-with", "convolve-with", "convolve?", "copy", "copy", "copy-context", - "copy-sampler", "correlate", "coverlet", "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis", - "curlet", "current-font", "cursor", "cursor-color", "cursor-context", "cursor-location-offset", - "cursor-position", "cursor-size", "cursor-style", "cursor-update-interval", "cutlet", "cyclic-sequences", - "dac-combines-channels", "dac-size", "data-color", "data-location", "data-size", "db->linear", - "default-output-chans", "default-output-header-type", "default-output-sample-type", "default-output-srate", "defgenerator", "define*", - "define-constant", "define-envelope", "define-expansion", "define-macro", "define-macro*", "define-selection-via-marks", - "defined?", "degrees->radians", "delay", "delay-channel-mixes", "delay-tick", "delay?", - "delete-colormap", "delete-file-filter", "delete-file-sorter", "delete-mark", "delete-marks", "delete-sample", - "delete-samples", "delete-samples-and-smooth", "delete-selection", "delete-selection-and-smooth", "delete-transform", "describe-hook", - "describe-mark", "dht", "dialog-widgets", "dilambda", "disable-control-panel", "display-bark-fft", - "display-correlation", "display-db", "display-edits", "display-energy", "dissolve-fade", "dither-channel", - "dither-sound", "documentation", "dolph", "dot-product", "dot-size", "down-oct", - "draw-axes", "draw-dot", "draw-dots", "draw-line", "draw-lines", "draw-mark-hook", - "draw-mix-hook", "draw-string", "drone", "drop sites", "drop-hook", "during-open-hook", - "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function", "edit-position", "edit-properties", - "edit-property", "edit-tree", "edits", "edot-product", "effects-hook", "elliptic filters", - "env", "env-any", "env-channel", "env-channel-with-base", "env-expt-channel", "env-interp", - "env-mixes", "env-selection", "env-sound", "env-sound-interp", "env-squared-channel", "env?", - "enved-base", "enved-clip?", "enved-dialog", "enved-envelope", "enved-filter", "enved-filter-order", - "enved-hook", "enved-in-dB", "enved-power", "enved-style", "enved-target", "enved-wave?", - "enved-waveform-color", "envelope-interp", "enveloped-mix", "eoddcos", "eoddcos?", "eps-bottom-margin", - "eps-file", "eps-left-margin", "eps-size", "ercos", "ercos?", "*error-hook*", - "erssb", "erssb?", "even-multiple", "even-weight", "every-sample?", "exit", - "exit-hook", "expand-control", "expand-control-bounds", "expand-control-hop", "expand-control-jitter", "expand-control-length", - "expand-control-ramp", "expand-control?", "explode-sf2", "exponentially-weighted-moving-average", "expsnd", "expsrc", - "*features*", "feedback fm", "fft", "fft-cancel", "fft-edit", "fft-env-edit", - "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", "fft-smoother", "fft-squelch", "fft-window", - "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database", "file->array", "file->frample", - "file->frample?", "file->sample", "file->sample?", "file-name", "fill!", "fill-polygon", - "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs", "filter-control-envelope", "filter-control-in-dB", - "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?", "filter-fft", "filter-selection", - "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb", "filtered-comb-bank", "filtered-comb-bank?", - "filtered-comb?", "find-dialog", "find-mark", "find-mix", "find-sound", "finfo", - "finish-progress-report", "fir-filter", "fir-filter?", "firmant", "firmant?", "fit-selection-between-marks", - "flatten-partials", "float-vector", "float-vector*", "float-vector+", "float-vector->channel", "float-vector->list", - "float-vector->string", "float-vector-abs!", "float-vector-add!", "float-vector-equal?", "float-vector-fill!", "float-vector-length", - "float-vector-max", "float-vector-min", "float-vector-move!", "float-vector-multiply!", "float-vector-offset!", "float-vector-peak", - "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!", "float-vector-scale!", "float-vector-set!", "float-vector-subseq", - "float-vector-subtract!", "float-vector?", "flocsig", "flocsig?", "flute model", "fm-bell", - "fm-drum", "fm-noise", "fm-parallel-component", "fm-talker", "fm-trumpet", "fm-violin", - "fm-voice", "fmssb", "fmssb?", "focus-widget", "FOF synthesis", "fofins", - "for-each-child", "for-each-sound-file", "Forbidden Planet", "foreground-color", "forget-region", "formant", - "formant-bank", "formant-bank?", "formant?", "format", "fp", "fractional-fourier-transform", - "frample->file", "frample->file?", "frample->frample", "framples", "free-player", "free-sampler", - "freeverb", "fullmix", "funclet", "gaussian-distribution", "gc-off", "gc-on", - "gensym", "gensym?", "gl-graph->ps", "glSpectrogram", "goertzel", "goto-listener-end", - "grani", "granulate", "granulate?", "granulated-sound-interp", "graph", "graph->ps", - "graph-color", "graph-cursor", "graph-data", "graph-hook", "graph-style", "graphic equalizer", - "graphs-horizontal", "green-noise", "green-noise-interp", "green-noise-interp?", "green-noise?", "grid-density", - "harmonicizer", "Hartley transform", "hash-table", "hash-table*", "hash-table-entries", "hash-table-ref", - "hash-table-set!", "hash-table?", "header-type", "hello-dentist", "help-dialog", "help-hook", - "hide-widget", "highlight-color", "hilbert-transform", "hook-functions", "hook-member", "html", - "html-dir", "html-program", "hz->radians", "iir-filter", "iir-filter?", "immutable!", - "immutable?", "in", "in-any", "ina", "inb", "info-dialog", - "init-ladspa", "initial-beg", "initial-dur", "initial-graph-hook", "inlet", "insert-channel", - "insert-file-dialog", "insert-region", "insert-sample", "insert-samples", "insert-selection", "insert-silence", - "insert-sound", "int-vector", "int-vector-ref", "int-vector-set!", "int-vector?", "integer->colormap", - "integer->mark", "integer->mix", "integer->region", "integer->sound", "integer->transform", "integrate-envelope", - "invert-filter", "iterate", "iterator-at-end?", "iterator-sequence", "iterator?", "izcos", - "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos", - "j2cos?", "jc-reverb", "jjcos", "jjcos?", "jncos", "jncos?", - "jpcos", "jpcos?", "just-sounds", "jycos", "jycos?", "k2cos", - "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin", - "k3sin?", "kalman-filter-channel", "key", "key-binding", "key-press-hook", "krksin", - "krksin?", "ladspa-descriptor", "ladspa-dir", "lambda*", "lbj-piano", "left-sample", - "let->list", "let-ref", "let-set!", "let-temporarily", "let?", "linear->db", - "linear-src-channel", "lint for scheme", "lisp-graph-hook", "lisp-graph-style", "lisp-graph?", "list->float-vector", - "list-ladspa", "listener-click-hook", "listener-color", "listener-colorized", "listener-font", "listener-prompt", - "listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*", "locate-zero", - "locsig", "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!", "locsig-type", - "locsig?", "log-freq-start", "lpc-coeffs", "lpc-predict", "macro?", "macroexpand", - "main-menu", "main-widgets", "make-abcos", "make-absin", "make-adjustable-sawtooth-wave", "make-adjustable-square-wave", - "make-adjustable-triangle-wave", "make-all-pass", "make-all-pass-bank", "make-asyfm", "make-asymmetric-fm", "make-bandpass", - "make-bandstop", "make-bess", "make-biquad", "make-birds", "make-blackman", "make-brown-noise", - "make-byte-vector", "make-channel-drop-site", "make-color", "make-comb", "make-comb-bank", "make-convolve", - "make-delay", "make-differentiator", "make-env", "make-eoddcos", "make-ercos", "make-erssb", - "make-fft-window", "make-file->frample", "make-file->sample", "make-filter", "make-filtered-comb", "make-filtered-comb-bank", - "make-fir-coeffs", "make-fir-filter", "make-firmant", "make-float-vector", "make-flocsig", "make-fmssb", - "make-formant", "make-formant-bank", "make-frample->file", "make-granulate", "make-graph-data", "make-green-noise", - "make-green-noise-interp", "make-hash-table", "make-highpass", "make-hilbert-transform", "make-hook", "make-iir-filter", - "make-int-vector", "make-iterator", "make-izcos", "make-j0evencos", "make-j0j1cos", "make-j2cos", - "make-jjcos", "make-jncos", "make-jpcos", "make-jycos", "make-k2cos", "make-k2sin", - "make-k2ssb", "make-k3sin", "make-krksin", "make-locsig", "make-lowpass", "make-mix-sampler", - "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-max", "make-moving-norm", - "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum", "make-n1cos", "make-nchoosekcos", "make-ncos", - "make-nkssb", "make-noddcos", "make-noddsin", "make-noddssb", "make-noid", "make-notch", - "make-nrcos", "make-nrsin", "make-nrssb", "make-nrxycos", "make-nrxysin", "make-nsin", - "make-nsincos", "make-nssb", "make-nxy1cos", "make-nxy1sin", "make-nxycos", "make-nxysin", - "make-one-pole", "make-one-pole-all-pass", "make-one-zero", "make-oscil", "make-oscil-bank", "make-phase-vocoder", - "make-pink-noise", "make-pixmap", "make-player", "make-polyoid", "make-polyshape", "make-polywave", - "make-pulse-train", "make-pulsed-env", "make-r2k!cos", "make-r2k2cos", "make-ramp", "make-rand", - "make-rand-interp", "make-rcos", "make-readin", "make-region", "make-region-sampler", "make-rk!cos", - "make-rk!ssb", "make-rkcos", "make-rkoddssb", "make-rksin", "make-rkssb", "make-round-interp", - "make-rssb", "make-rxycos", "make-rxyk!cos", "make-rxyk!sin", "make-rxysin", "make-sample->file", - "make-sampler", "make-sawtooth-wave", "make-selection", "make-sinc-train", "make-snd->sample", "make-sound-box", - "make-spencer-filter", "make-square-wave", "make-src", "make-ssb-am", "make-table-lookup", "make-table-lookup-with-env", - "make-tanhsin", "make-triangle-wave", "make-two-pole", "make-two-zero", "make-variable-display", "make-variable-graph", - "make-wave-train", "make-wave-train-with-env", "map-channel", "map-sound-files", "maracas", "mark->integer", - "mark-click-hook", "mark-click-info", "mark-color", "mark-context", "mark-drag-hook", "mark-explode", - "mark-home", "mark-hook", "mark-loops", "mark-name", "mark-name->id", "mark-properties", - "mark-property", "mark-sample", "mark-sync", "mark-sync-color", "mark-sync-max", "mark-tag-height", - "mark-tag-width", "mark?", "marks", "match-sound-files", "max-envelope", "max-regions", - "max-transform-peaks", "maxamp", "maxamp-position", "menu-widgets", "menus, optional", "min-dB", - "mix", "mix->float-vector", "mix->integer", "mix-amp", "mix-amp-env", "mix-channel", - "mix-click-hook", "mix-click-info", "mix-click-sets-amp", "mix-color", "mix-dialog-mix", "mix-drag-hook", - "mix-file-dialog", "mix-float-vector", "mix-home", "mix-length", "mix-maxamp", "mix-name", - "mix-name->id", "mix-position", "mix-properties", "mix-property", "mix-region", "mix-release-hook", - "mix-sampler?", "mix-selection", "mix-sound", "mix-speed", "mix-sync", "mix-sync-max", - "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-waveform-height", "mix?", "mixes", - "mono->stereo", "moog-filter", "morally-equal?", "mouse-click-hook", "mouse-drag-hook", "mouse-enter-graph-hook", - "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook", "mouse-leave-graph-hook", "mouse-leave-label-hook", "mouse-leave-listener-hook", - "mouse-leave-text-hook", "mouse-press-hook", "move-locsig", "move-mixes", "move-sound", "move-sound?", - "move-syncd-marks", "moving-autocorrelation", "moving-autocorrelation?", "moving-average", "moving-average?", "moving-fft", - "moving-fft?", "moving-length", "moving-max", "moving-max?", "moving-norm", "moving-norm?", - "moving-pitch", "moving-pitch?", "moving-rms", "moving-scentroid", "moving-scentroid?", "moving-spectrum", - "moving-spectrum?", "moving-sum", "mpg", "mus-alsa-buffer-size", "mus-alsa-buffers", "mus-alsa-capture-device", - "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length", "mus-bytes-per-sample", "mus-channel", - "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping", "mus-close", "mus-copy", "mus-data", - "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename", "mus-feedback", "mus-feedforward", - "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-mix", "mus-file-name", "mus-float-equal-fudge-factor", - "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string", "mus-header-type-name", "mus-hop", - "mus-increment", "mus-input?", "mus-interp-type", "mus-interpolate", "mus-length", "mus-location", - "mus-max-malloc", "mus-max-table-size", "mus-name", "mus-offset", "mus-order", "mus-oss-set-buffers", - "mus-output?", "mus-phase", "mus-ramp", "mus-rand-seed", "mus-random", "mus-reset", - "mus-run", "mus-sample-type->string", "mus-sample-type-name", "mus-scaler", "mus-sound-chans", "mus-sound-comment", - "mus-sound-data-location", "mus-sound-datum-size", "mus-sound-duration", "mus-sound-forget", "mus-sound-framples", "mus-sound-header-type", - "mus-sound-length", "mus-sound-loop-info", "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-path", - "mus-sound-preload", "mus-sound-prune", "mus-sound-report-cache", "mus-sound-sample-type", "mus-sound-samples", "mus-sound-srate", - "mus-sound-type-specifier", "mus-sound-write-date", "mus-srate", "mus-width", "mus-xcoeff", "mus-xcoeffs", - "mus-ycoeff", "mus-ycoeffs", "n1cos", "n1cos?", "name-click-hook", "nchoosekcos", - "nchoosekcos?", "ncos", "ncos2?", "ncos4?", "ncos?", "new-sound", - "new-sound-dialog", "new-sound-hook", "new-widget-hook", "next-sample", "nkssb", "nkssb-interp", - "nkssb?", "noddcos", "noddcos?", "noddsin", "noddsin?", "noddssb", - "noddssb?", "noid", "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound", - "normalized-mix", "notch", "notch-channel", "notch-selection", "notch-sound", "notch?", - "npcos?", "nrcos", "nrcos?", "nrev", "nrsin", "nrsin?", - "nrssb", "nrssb-interp", "nrssb?", "nrxycos", "nrxycos?", "nrxysin", - "nrxysin?", "nsin", "nsin?", "nsincos", "nsincos?", "nssb", - "nssb?", "nxy1cos", "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", - "nxycos?", "nxysin", "nxysin?", "object->let", "object->string", "odd-multiple", - "odd-weight", "offset-channel", "offset-sound", "one-pole", "one-pole-all-pass", "one-pole-all-pass?", - "one-pole?", "one-zero", "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook", - "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook", "open-sound", "openlet", "openlet?", - "orientation-hook", "oscil", "oscil-bank", "oscil-bank?", "oscil?", "out-any", - "out-bank", "outa", "outlet", "*output*", "output-comment-hook", "overlay-rms-env", - "owlet", "pad-channel", "pad-marks", "pad-sound", "pair-filename", "pair-line-number", - "pan-mix", "pan-mix-float-vector", "partials->polynomial", "partials->wave", "pausing", "peak-env-dir", - "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder", "phase-vocoder?", "piano model", - "pink-noise", "pink-noise?", "pins", "place-sound", "play", "play-arrow-size", - "play-between-marks", "play-hook", "play-mixes", "play-often", "play-region-forever", "play-sine", - "play-sines", "play-syncd-marks", "play-until-c-g", "play-with-envs", "player-home", "player?", - "players", "playing", "pluck", "polar->rectangular", "polynomial", "polynomial operations", - "polyoid", "polyoid-env", "polyoid?", "polyshape", "polyshape?", "polywave", - "polywave?", "port-filename", "port-line-number", "position->x", "position->y", "position-color", - "power-env", "pqw", "pqw-vox", "preferences-dialog", "previous-sample", "print-dialog", - "print-length", "procedure-source", "progress-report", "pulse-train", "pulse-train?", "pulsed-env", - "pulsed-env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians->degrees", - "radians->hz", "ramp-channel", "rand", "rand-interp", "rand-interp?", "rand?", - "random", "random-state", "random-state?", "rcos", "rcos?", "*read-error-hook*", - "read-hook", "read-mix-sample", "read-only", "read-region-sample", "read-sample", "read-sample-with-direction", - "reader-cond", "readin", "readin?", "rectangular->magnitudes", "rectangular->polar", "redo", - "region->float-vector", "region->integer", "region-chans", "region-framples", "region-graph-style", "region-home", - "region-maxamp", "region-maxamp-position", "region-play-list", "region-position", "region-rms", "region-sample", - "region-sampler?", "region-srate", "region?", "regions", "remember-sound-state", "remove-clicks", - "remove-from-menu", "replace-with-selection", "report-mark-names", "require", "reset-all-hooks", "reset-controls", - "reset-listener-cursor", "reson", "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback", - "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?", - "reverse!", "reverse-by-blocks", "reverse-channel", "reverse-envelope", "reverse-selection", "reverse-sound", - "revert-sound", "right-sample", "ring-modulate", "rk!cos", "rk!cos?", "rk!ssb", - "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin", - "rksin?", "rkssb", "rkssb?", "rms", "rms, gain, balance gens", "rms-envelope", - "rootlet", "*rootlet-redefinition-hook*", "round-interp", "round-interp?", "rssb", "rssb-interp", - "rssb?", "rubber-sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", - "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample->file", - "sample->file?", "sample-type", "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", - "samples", "samples->seconds", "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src", "save-controls", - "save-dir", "save-edit-history", "save-envelopes", "save-hook", "save-listener", "save-mark-properties", - "save-marks", "save-mix", "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", - "save-sound", "save-sound-as", "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", - "savitzky-golay-filter", "sawtooth-wave", "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", - "scale-mixes", "scale-selection-by", "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", - "scan-channel", "scanned synthesis", "scentroid", "scratch", "script-arg", "script-args", - "search-for-click", "search-procedure", "seconds->samples", "select-all", "select-channel", "select-channel-hook", - "select-sound", "select-sound-hook", "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound", - "selection", "selection->mix", "selection-chans", "selection-color", "selection-context", "selection-creates-region", - "selection-framples", "selection-maxamp", "selection-maxamp-position", "selection-member?", "selection-members", "selection-position", - "selection-rms", "selection-srate", "selection?", "set-samples", "setter", "short-file-name", - "show-axes", "show-controls", "show-disk-space", "show-full-duration", "show-full-range", "show-grid", - "show-indices", "show-listener", "show-marks", "show-mix-waveforms", "show-selection", "show-selection-transform", - "show-sonogram-cursor", "show-transform-peaks", "show-widget", "show-y-zero", "signature", "silence-all-mixes", - "silence-mixes", "sinc-train", "sinc-train?", "sinc-width", "sine-env-channel", "sine-ramp", - "singer", "smooth-channel", "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat", - "snap-marks", "snap-mix-to-beat", "snd->sample", "snd->sample?", "snd-color", "snd-error", - "snd-error-hook", "snd-font", "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*", - "snd-print", "snd-spectrum", "snd-tempnam", "snd-url", "snd-urls", "snd-version", - "snd-warning", "snd-warning-hook", "sndwarp", "sort!", "sound->amp-env", "sound->integer", - "sound-file-extensions", "sound-file?", "sound-files-in-directory", "sound-interp", "sound-loop-info", "sound-properties", - "sound-property", "sound-widgets", "sound?", "soundfont-info", "sounds", "sounds->segment-data", - "spectra", "spectral interpolation", "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale", - "spectro-y-angle", "spectro-y-scale", "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs", - "spectrum-end", "spectrum-start", "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones", - "spot-freq", "square-wave", "square-wave?", "squelch-update", "squelch-vowels", "srate", - "src", "src-channel", "src-duration", "src-fit-envelope", "src-mixes", "src-selection", - "src-sound", "src?", "ssb-am", "ssb-am?", "ssb-bank", "ssb-bank-env", - "ssb-fm", "start-dac", "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report", - "status-report", "stdin-prompt", "stereo->mono", "stereo-flute", "stop-player", "stop-playing", - "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope", "stretch-sound-via-dft", "string->byte-vector", "string-position", - "sublet", "superimpose-ffts", "swap-channels", "swap-selection-channels", "symbol->dynamic-value", "symbol->value", - "symbol-setter", "symbol-table", "sync", "sync-everything", "sync-max", "sync-style", - "syncd-marks", "syncd-mixes", "syncup", "table-lookup", "table-lookup?", "tanhsin", - "tanhsin?", "tap", "tap?", "telephone", "temp-dir", "text-focus-color", - "time-graph-style", "time-graph-type", "time-graph?", "times->samples", "tiny-font", "touch-tone", - "trace", "tracking-cursor-style", "transform->float-vector", "transform->integer", "transform-dialog", "transform-framples", - "transform-graph-style", "transform-graph-type", "transform-graph?", "transform-normalization", "transform-sample", "transform-size", - "transform-type", "transform?", "transpose-mixes", "tree-count", "tree-cyclic?", "tree-leaves", - "tree-memq", "tree-set-memq", "triangle-wave", "triangle-wave?", "tubebell", "tubular bell", - "two-pole", "two-pole?", "two-tab", "two-zero", "two-zero?", "type-of", - "unbind-key", "*unbound-variable-hook*", "unclip-channel", "undo", "undo-hook", "unlet", - "unselect-all", "update-graphs", "update-hook", "update-lisp-graph", "update-sound", "update-time-graph", - "update-transform-graph", "upon-save-yourself", "user interface extensions", "variable-display", "variable-graph?", "varlet", - "vibrating-uniform-circular-string", "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook", - "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog", - "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter", "vox", "wave-train", - "wave-train?", "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average", - "widget-position", "widget-size", "widget-text", "window-height", "window-samples", "window-width", - "window-x", "window-y", "with-background-processes", "with-baffle", "with-file-monitor", "with-gl", - "with-inset-graph", "with-interrupts", "with-let", "with-local-hook", "with-menu-icons", "with-mix-tags", - "with-pointer-focus", "with-relative-panes", "with-smpte-label", "with-sound", "with-temporary-selection", "with-toolbar", - "with-tooltips", "with-tracking-cursor", "with-verbose-cursor", "x->position", "x-axis-label", "x-axis-style", - "x-bounds", "x-position-slider", "x-zoom-slider", "xb-open", "xramp-channel", "y->position", - "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider", "z-transform", "zecho", - "zero+", "zero-pad", "zero-phase", "zip-sound", "zipper", "zoom-color", - "zoom-focus-style"}; + "c-object?", "c-pointer", "c-pointer->list", "c-pointer-info", "c-pointer-type", "c-pointer-weak1", + "c-pointer?", "call-with-exit", "canter", "cascade->canonical", "catch", "cellon", + "chain-dsps", "channel->float-vector", "channel-amp-envs", "channel-data", "channel-envelope", "channel-polynomial", + "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync", "channel-widgets", + "channels", "channels-equal?", "channels=?", "chans", "char-position", "cheby-hka", + "chebyshev filters", "check-mix-tags", "chordalize", "chorus", "clean-channel", "clean-sound", + "clear-listener", "clip-hook", "clipping", "clm-channel", "clm-expsrc", "close-hook", + "close-sound", "color->list", "color-cutoff", "color-hook", "color-inverted", "color-mixes", + "color-orientation-dialog", "color-scale", "color?", "colormap", "colormap->integer", "colormap-name", + "colormap-ref", "colormap-size", "colormap?", "comb", "comb-bank", "comb-bank?", + "comb?", "combined-data-color", "comment", "complexify", "concatenate-envelopes", "constant?", + "continuation?", "continue-frample->file", "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp", + "contrast-control-bounds", "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel", "convolution", + "convolution reverb", "convolve", "convolve-files", "convolve-selection-with", "convolve-with", "convolve?", + "copy", "copy", "copy-context", "copy-sampler", "correlate", "coverlet", + "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis", "curlet", "current-font", "cursor", + "cursor-color", "cursor-context", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style", + "cursor-update-interval", "cutlet", "cyclic-sequences", "dac-combines-channels", "dac-size", "data-color", + "data-location", "data-size", "db->linear", "default-output-chans", "default-output-header-type", "default-output-sample-type", + "default-output-srate", "defgenerator", "define*", "define-constant", "define-envelope", "define-expansion", + "define-macro", "define-macro*", "define-selection-via-marks", "defined?", "degrees->radians", "delay", + "delay-channel-mixes", "delay-tick", "delay?", "delete-colormap", "delete-file-filter", "delete-file-sorter", + "delete-mark", "delete-marks", "delete-sample", "delete-samples", "delete-samples-and-smooth", "delete-selection", + "delete-selection-and-smooth", "delete-transform", "describe-hook", "describe-mark", "dht", "dialog-widgets", + "dilambda", "disable-control-panel", "display-bark-fft", "display-correlation", "display-db", "display-edits", + "display-energy", "dissolve-fade", "dither-channel", "dither-sound", "documentation", "dolph", + "dot-product", "dot-size", "down-oct", "draw-axes", "draw-dot", "draw-dots", + "draw-line", "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string", "drone", + "drop sites", "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook", + "edit-list->function", "edit-position", "edit-properties", "edit-property", "edit-tree", "edits", + "edot-product", "effects-hook", "elliptic filters", "env", "env-any", "env-channel", + "env-channel-with-base", "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound", + "env-sound-interp", "env-squared-channel", "env?", "enved-base", "enved-clip?", "enved-dialog", + "enved-envelope", "enved-filter", "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power", + "enved-style", "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", + "eoddcos", "eoddcos?", "eps-bottom-margin", "eps-file", "eps-left-margin", "eps-size", + "ercos", "ercos?", "*error-hook*", "erssb", "erssb?", "even-multiple", + "even-weight", "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds", + "expand-control-hop", "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2", + "exponentially-weighted-moving-average", "expsnd", "expsrc", "*features*", "feedback fm", "fft", + "fft-cancel", "fft-edit", "fft-env-edit", "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", + "fft-smoother", "fft-squelch", "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", + "file database", "file->array", "file->frample", "file->frample?", "file->sample", "file->sample?", + "file-name", "fill!", "fill-polygon", "fill-rectangle", "filter", "filter-channel", + "filter-control-coeffs", "filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", + "filter-control?", "filter-fft", "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", + "filtered-comb", "filtered-comb-bank", "filtered-comb-bank?", "filtered-comb?", "find-dialog", "find-mark", + "find-mix", "find-sound", "finfo", "finish-progress-report", "fir-filter", "fir-filter?", + "firmant", "firmant?", "fit-selection-between-marks", "flatten-partials", "float-vector", "float-vector*", + "float-vector+", "float-vector->channel", "float-vector->list", "float-vector->string", "float-vector-abs!", "float-vector-add!", + "float-vector-equal?", "float-vector-fill!", "float-vector-length", "float-vector-max", "float-vector-min", "float-vector-move!", + "float-vector-multiply!", "float-vector-offset!", "float-vector-peak", "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!", + "float-vector-scale!", "float-vector-set!", "float-vector-subseq", "float-vector-subtract!", "float-vector?", "flocsig", + "flocsig?", "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-parallel-component", + "fm-talker", "fm-trumpet", "fm-violin", "fm-voice", "fmssb", "fmssb?", + "focus-widget", "FOF synthesis", "fofins", "for-each-child", "for-each-sound-file", "Forbidden Planet", + "foreground-color", "forget-region", "formant", "formant-bank", "formant-bank?", "formant?", + "format", "fp", "fractional-fourier-transform", "frample->file", "frample->file?", "frample->frample", + "framples", "free-player", "free-sampler", "freeverb", "fullmix", "funclet", + "gaussian-distribution", "gc-off", "gc-on", "gensym", "gensym?", "gl-graph->ps", + "glSpectrogram", "goertzel", "goto-listener-end", "grani", "granulate", "granulate?", + "granulated-sound-interp", "graph", "graph->ps", "graph-color", "graph-cursor", "graph-data", + "graph-hook", "graph-style", "graphic equalizer", "graphs-horizontal", "green-noise", "green-noise-interp", + "green-noise-interp?", "green-noise?", "grid-density", "harmonicizer", "Hartley transform", "hash-table", + "hash-table*", "hash-table-entries", "hash-table-ref", "hash-table-set!", "hash-table?", "header-type", + "hello-dentist", "help-dialog", "help-hook", "hide-widget", "highlight-color", "hilbert-transform", + "hook-functions", "hook-member", "html", "html-dir", "html-program", "hz->radians", + "iir-filter", "iir-filter?", "immutable!", "immutable?", "in", "in-any", + "ina", "inb", "info-dialog", "init-ladspa", "initial-beg", "initial-dur", + "initial-graph-hook", "inlet", "insert-channel", "insert-file-dialog", "insert-region", "insert-sample", + "insert-samples", "insert-selection", "insert-silence", "insert-sound", "int-vector", "int-vector-ref", + "int-vector-set!", "int-vector?", "integer->colormap", "integer->mark", "integer->mix", "integer->region", + "integer->sound", "integer->transform", "integrate-envelope", "invert-filter", "iterate", "iterator-at-end?", + "iterator-sequence", "iterator?", "izcos", "izcos?", "j0evencos", "j0evencos?", + "j0j1cos", "j0j1cos?", "j2cos", "j2cos?", "jc-reverb", "jjcos", + "jjcos?", "jncos", "jncos?", "jpcos", "jpcos?", "just-sounds", + "jycos", "jycos?", "k2cos", "k2cos?", "k2sin", "k2sin?", + "k2ssb", "k2ssb?", "k3sin", "k3sin?", "kalman-filter-channel", "key", + "key-binding", "key-press-hook", "krksin", "krksin?", "ladspa-descriptor", "ladspa-dir", + "lambda*", "lbj-piano", "left-sample", "let->list", "let-ref", "let-set!", + "let-temporarily", "let?", "linear->db", "linear-src-channel", "lint for scheme", "lisp-graph-hook", + "lisp-graph-style", "lisp-graph?", "list->float-vector", "list-ladspa", "listener-click-hook", "listener-color", + "listener-colorized", "listener-font", "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", + "*load-hook*", "*load-path*", "locate-zero", "locsig", "locsig-ref", "locsig-reverb-ref", + "locsig-reverb-set!", "locsig-set!", "locsig-type", "locsig?", "log-freq-start", "lpc-coeffs", + "lpc-predict", "macro?", "macroexpand", "main-menu", "main-widgets", "make-abcos", + "make-absin", "make-adjustable-sawtooth-wave", "make-adjustable-square-wave", "make-adjustable-triangle-wave", "make-all-pass", "make-all-pass-bank", + "make-asyfm", "make-asymmetric-fm", "make-bandpass", "make-bandstop", "make-bess", "make-biquad", + "make-birds", "make-blackman", "make-brown-noise", "make-byte-vector", "make-channel-drop-site", "make-color", + "make-comb", "make-comb-bank", "make-convolve", "make-delay", "make-differentiator", "make-env", + "make-eoddcos", "make-ercos", "make-erssb", "make-fft-window", "make-file->frample", "make-file->sample", + "make-filter", "make-filtered-comb", "make-filtered-comb-bank", "make-fir-coeffs", "make-fir-filter", "make-firmant", + "make-float-vector", "make-flocsig", "make-fmssb", "make-formant", "make-formant-bank", "make-frample->file", + "make-granulate", "make-graph-data", "make-green-noise", "make-green-noise-interp", "make-hash-table", "make-highpass", + "make-hilbert-transform", "make-hook", "make-iir-filter", "make-int-vector", "make-iterator", "make-izcos", + "make-j0evencos", "make-j0j1cos", "make-j2cos", "make-jjcos", "make-jncos", "make-jpcos", + "make-jycos", "make-k2cos", "make-k2sin", "make-k2ssb", "make-k3sin", "make-krksin", + "make-locsig", "make-lowpass", "make-mix-sampler", "make-move-sound", "make-moving-autocorrelation", "make-moving-average", + "make-moving-fft", "make-moving-max", "make-moving-norm", "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum", + "make-n1cos", "make-nchoosekcos", "make-ncos", "make-nkssb", "make-noddcos", "make-noddsin", + "make-noddssb", "make-noid", "make-notch", "make-nrcos", "make-nrsin", "make-nrssb", + "make-nrxycos", "make-nrxysin", "make-nsin", "make-nsincos", "make-nssb", "make-nxy1cos", + "make-nxy1sin", "make-nxycos", "make-nxysin", "make-one-pole", "make-one-pole-all-pass", "make-one-zero", + "make-oscil", "make-oscil-bank", "make-phase-vocoder", "make-pink-noise", "make-pixmap", "make-player", + "make-polyoid", "make-polyshape", "make-polywave", "make-pulse-train", "make-pulsed-env", "make-r2k!cos", + "make-r2k2cos", "make-ramp", "make-rand", "make-rand-interp", "make-rcos", "make-readin", + "make-region", "make-region-sampler", "make-rk!cos", "make-rk!ssb", "make-rkcos", "make-rkoddssb", + "make-rksin", "make-rkssb", "make-round-interp", "make-rssb", "make-rxycos", "make-rxyk!cos", + "make-rxyk!sin", "make-rxysin", "make-sample->file", "make-sampler", "make-sawtooth-wave", "make-selection", + "make-sinc-train", "make-snd->sample", "make-sound-box", "make-spencer-filter", "make-square-wave", "make-src", + "make-ssb-am", "make-table-lookup", "make-table-lookup-with-env", "make-tanhsin", "make-triangle-wave", "make-two-pole", + "make-two-zero", "make-variable-display", "make-variable-graph", "make-wave-train", "make-wave-train-with-env", "make-weak-hash-table", + "map-channel", "map-sound-files", "maracas", "mark->integer", "mark-click-hook", "mark-click-info", + "mark-color", "mark-context", "mark-drag-hook", "mark-explode", "mark-home", "mark-hook", + "mark-loops", "mark-name", "mark-name->id", "mark-properties", "mark-property", "mark-sample", + "mark-sync", "mark-sync-color", "mark-sync-max", "mark-tag-height", "mark-tag-width", "mark?", + "marks", "match-sound-files", "max-envelope", "max-regions", "max-transform-peaks", "maxamp", + "maxamp-position", "menu-widgets", "menus, optional", "min-dB", "mix", "mix->float-vector", + "mix->integer", "mix-amp", "mix-amp-env", "mix-channel", "mix-click-hook", "mix-click-info", + "mix-click-sets-amp", "mix-color", "mix-dialog-mix", "mix-drag-hook", "mix-file-dialog", "mix-float-vector", + "mix-home", "mix-length", "mix-maxamp", "mix-name", "mix-name->id", "mix-position", + "mix-properties", "mix-property", "mix-region", "mix-release-hook", "mix-sampler?", "mix-selection", + "mix-sound", "mix-speed", "mix-sync", "mix-sync-max", "mix-tag-height", "mix-tag-width", + "mix-tag-y", "mix-waveform-height", "mix?", "mixes", "mono->stereo", "moog-filter", + "morally-equal?", "mouse-click-hook", "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", + "mouse-enter-text-hook", "mouse-leave-graph-hook", "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", + "move-locsig", "move-mixes", "move-sound", "move-sound?", "move-syncd-marks", "moving-autocorrelation", + "moving-autocorrelation?", "moving-average", "moving-average?", "moving-fft", "moving-fft?", "moving-length", + "moving-max", "moving-max?", "moving-norm", "moving-norm?", "moving-pitch", "moving-pitch?", + "moving-rms", "moving-scentroid", "moving-scentroid?", "moving-spectrum", "moving-spectrum?", "moving-sum", + "mpg", "mus-alsa-buffer-size", "mus-alsa-buffers", "mus-alsa-capture-device", "mus-alsa-device", "mus-alsa-playback-device", + "mus-alsa-squelch-warning", "mus-array-print-length", "mus-bytes-per-sample", "mus-channel", "mus-channels", "mus-chebyshev-tu-sum", + "mus-clipping", "mus-close", "mus-copy", "mus-data", "mus-describe", "mus-error-hook", + "mus-error-type->string", "mus-expand-filename", "mus-feedback", "mus-feedforward", "mus-fft", "mus-file-buffer-size", + "mus-file-clipping", "mus-file-mix", "mus-file-name", "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", + "mus-header-raw-defaults", "mus-header-type->string", "mus-header-type-name", "mus-hop", "mus-increment", "mus-input?", + "mus-interp-type", "mus-interpolate", "mus-length", "mus-location", "mus-max-malloc", "mus-max-table-size", + "mus-name", "mus-offset", "mus-order", "mus-oss-set-buffers", "mus-output?", "mus-phase", + "mus-ramp", "mus-rand-seed", "mus-random", "mus-reset", "mus-run", "mus-sample-type->string", + "mus-sample-type-name", "mus-scaler", "mus-sound-chans", "mus-sound-comment", "mus-sound-data-location", "mus-sound-datum-size", + "mus-sound-duration", "mus-sound-forget", "mus-sound-framples", "mus-sound-header-type", "mus-sound-length", "mus-sound-loop-info", + "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-path", "mus-sound-preload", "mus-sound-prune", + "mus-sound-report-cache", "mus-sound-sample-type", "mus-sound-samples", "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write-date", + "mus-srate", "mus-width", "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs", + "n1cos", "n1cos?", "name-click-hook", "nchoosekcos", "nchoosekcos?", "ncos", + "ncos2?", "ncos4?", "ncos?", "new-sound", "new-sound-dialog", "new-sound-hook", + "new-widget-hook", "next-sample", "nkssb", "nkssb-interp", "nkssb?", "noddcos", + "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?", "noid", + "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound", "normalized-mix", "notch", + "notch-channel", "notch-selection", "notch-sound", "notch?", "npcos?", "nrcos", + "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb", "nrssb-interp", + "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", + "nsin?", "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", + "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", + "nxysin?", "object->let", "object->string", "odd-multiple", "odd-weight", "offset-channel", + "offset-sound", "one-pole", "one-pole-all-pass", "one-pole-all-pass?", "one-pole?", "one-zero", + "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound", + "open-raw-sound-hook", "open-sound", "openlet", "openlet?", "orientation-hook", "oscil", + "oscil-bank", "oscil-bank?", "oscil?", "out-any", "out-bank", "outa", + "outlet", "*output*", "output-comment-hook", "overlay-rms-env", "owlet", "pad-channel", + "pad-marks", "pad-sound", "pair-filename", "pair-line-number", "pan-mix", "pan-mix-float-vector", + "partials->polynomial", "partials->wave", "pausing", "peak-env-dir", "peaks", "peaks-font", + "phase-partials->wave", "phase-vocoder", "phase-vocoder?", "piano model", "pink-noise", "pink-noise?", + "pins", "place-sound", "play", "play-arrow-size", "play-between-marks", "play-hook", + "play-mixes", "play-often", "play-region-forever", "play-sine", "play-sines", "play-syncd-marks", + "play-until-c-g", "play-with-envs", "player-home", "player?", "players", "playing", + "pluck", "polar->rectangular", "polynomial", "polynomial operations", "polyoid", "polyoid-env", + "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?", "port-filename", + "port-line-number", "position->x", "position->y", "position-color", "power-env", "pqw", + "pqw-vox", "preferences-dialog", "previous-sample", "print-dialog", "print-length", "procedure-source", + "progress-report", "pulse-train", "pulse-train?", "pulsed-env", "pulsed-env?", "r2k!cos", + "r2k!cos?", "r2k2cos", "r2k2cos?", "radians->degrees", "radians->hz", "ramp-channel", + "rand", "rand-interp", "rand-interp?", "rand?", "random", "random-state", + "random-state?", "rcos", "rcos?", "*read-error-hook*", "read-hook", "read-mix-sample", + "read-only", "read-region-sample", "read-sample", "read-sample-with-direction", "reader-cond", "readin", + "readin?", "rectangular->magnitudes", "rectangular->polar", "redo", "region->float-vector", "region->integer", + "region-chans", "region-framples", "region-graph-style", "region-home", "region-maxamp", "region-maxamp-position", + "region-play-list", "region-position", "region-rms", "region-sample", "region-sampler?", "region-srate", + "region?", "regions", "remember-sound-state", "remove-clicks", "remove-from-menu", "replace-with-selection", + "report-mark-names", "require", "reset-all-hooks", "reset-controls", "reset-listener-cursor", "reson", + "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback", "reverb-control-length", "reverb-control-length-bounds", + "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?", "reverse!", "reverse-by-blocks", + "reverse-channel", "reverse-envelope", "reverse-selection", "reverse-sound", "revert-sound", "right-sample", + "ring-modulate", "rk!cos", "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", + "rkcos?", "rkoddssb", "rkoddssb?", "rksin", "rksin?", "rkssb", + "rkssb?", "rms", "rms, gain, balance gens", "rms-envelope", "rootlet", "*rootlet-redefinition-hook*", + "round-interp", "round-interp?", "rssb", "rssb-interp", "rssb?", "rubber-sound", + "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?", + "rxysin", "rxysin?", "sample", "sample->file", "sample->file?", "sample-type", + "sampler-at-end?", "sampler-home", "sampler-position", "sampler?", "samples", "samples->seconds", + "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src", "save-controls", "save-dir", "save-edit-history", + "save-envelopes", "save-hook", "save-listener", "save-mark-properties", "save-marks", "save-mix", + "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound", "save-sound-as", + "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter", "sawtooth-wave", + "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes", "scale-selection-by", + "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel", "scanned synthesis", + "scentroid", "scratch", "script-arg", "script-args", "search-for-click", "search-procedure", + "seconds->samples", "select-all", "select-channel", "select-channel-hook", "select-sound", "select-sound-hook", + "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound", "selection", "selection->mix", + "selection-chans", "selection-color", "selection-context", "selection-creates-region", "selection-framples", "selection-maxamp", + "selection-maxamp-position", "selection-member?", "selection-members", "selection-position", "selection-rms", "selection-srate", + "selection?", "set-samples", "setter", "short-file-name", "show-axes", "show-controls", + "show-disk-space", "show-full-duration", "show-full-range", "show-grid", "show-indices", "show-listener", + "show-marks", "show-mix-waveforms", "show-selection", "show-selection-transform", "show-sonogram-cursor", "show-transform-peaks", + "show-widget", "show-y-zero", "signature", "silence-all-mixes", "silence-mixes", "sinc-train", + "sinc-train?", "sinc-width", "sine-env-channel", "sine-ramp", "singer", "smooth-channel", + "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat", "snap-marks", "snap-mix-to-beat", + "snd->sample", "snd->sample?", "snd-color", "snd-error", "snd-error-hook", "snd-font", + "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*", "snd-print", "snd-spectrum", + "snd-tempnam", "snd-url", "snd-urls", "snd-version", "snd-warning", "snd-warning-hook", + "sndwarp", "sort!", "sound->amp-env", "sound->integer", "sound-file-extensions", "sound-file?", + "sound-files-in-directory", "sound-interp", "sound-loop-info", "sound-properties", "sound-property", "sound-widgets", + "sound?", "soundfont-info", "sounds", "sounds->segment-data", "spectra", "spectral interpolation", + "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale", + "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start", + "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones", "spot-freq", "square-wave", + "square-wave?", "squelch-update", "squelch-vowels", "srate", "src", "src-channel", + "src-duration", "src-fit-envelope", "src-mixes", "src-selection", "src-sound", "src?", + "ssb-am", "ssb-am?", "ssb-bank", "ssb-bank-env", "ssb-fm", "start-dac", + "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report", "status-report", "stdin-prompt", + "stereo->mono", "stereo-flute", "stop-player", "stop-playing", "stop-playing-hook", "stop-playing-selection-hook", + "stretch-envelope", "stretch-sound-via-dft", "string->byte-vector", "string-position", "sublet", "subvector", + "subvector-position", "subvector-vector", "subvector?", "superimpose-ffts", "swap-channels", "swap-selection-channels", + "symbol->dynamic-value", "symbol->value", "symbol-table", "sync", "sync-everything", "sync-max", + "sync-style", "syncd-marks", "syncd-mixes", "syncup", "table-lookup", "table-lookup?", + "tanhsin", "tanhsin?", "tap", "tap?", "telephone", "temp-dir", + "text-focus-color", "time-graph-style", "time-graph-type", "time-graph?", "times->samples", "tiny-font", + "touch-tone", "trace", "tracking-cursor-style", "transform->float-vector", "transform->integer", "transform-dialog", + "transform-framples", "transform-graph-style", "transform-graph-type", "transform-graph?", "transform-normalization", "transform-sample", + "transform-size", "transform-type", "transform?", "transpose-mixes", "tree-count", "tree-cyclic?", + "tree-leaves", "tree-memq", "tree-set-memq", "triangle-wave", "triangle-wave?", "tubebell", + "tubular bell", "two-pole", "two-pole?", "two-tab", "two-zero", "two-zero?", + "type-of", "unbind-key", "*unbound-variable-hook*", "unclip-channel", "undo", "undo-hook", + "unlet", "unselect-all", "update-graphs", "update-hook", "update-lisp-graph", "update-sound", + "update-time-graph", "update-transform-graph", "upon-save-yourself", "user interface extensions", "variable-display", "variable-graph?", + "varlet", "vibrating-uniform-circular-string", "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", + "view-files-select-hook", "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", + "view-regions-dialog", "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter", "vox", + "wave-train", "wave-train?", "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", + "weak-hash-table?", "weighted-moving-average", "widget-position", "widget-size", "widget-text", "window-height", + "window-samples", "window-width", "window-x", "window-y", "with-background-processes", "with-baffle", + "with-file-monitor", "with-gl", "with-inset-graph", "with-interrupts", "with-let", "with-local-hook", + "with-menu-icons", "with-mix-tags", "with-pointer-focus", "with-relative-panes", "with-smpte-label", "with-sound", + "with-temporary-selection", "with-toolbar", "with-tooltips", "with-tracking-cursor", "with-verbose-cursor", "x->position", + "x-axis-label", "x-axis-style", "x-bounds", "x-position-slider", "x-zoom-slider", "xb-open", + "xramp-channel", "y->position", "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider", + "z-transform", "zecho", "zero+", "zero-pad", "zero-phase", "zip-sound", + "zipper", "zoom-color", "zoom-focus-style"}; #endif #if HAVE_RUBY static const char *help_names[HELP_NAMES_SIZE] = { @@ -288,253 +289,254 @@ static const char *help_names[HELP_NAMES_SIZE] = { "binary_files", "bind_key", "bird", "blackman", "blackman4_env_channel", "blackman?", "bold_peaks_font", "break", "brown_noise", "brown_noise?", "butterworth_filters", "byte_vector", "byte_vector2string", "byte_vector_ref", "byte_vector_set!", "byte_vector?", "c_define", "c_g?", - "c_object?", "c_pointer", "c_pointer2list", "c_pointer?", "call_with_exit", "canter", - "cascade2canonical", "catch", "cellon", "chain_dsps", "channel2float_vector", "channel_amp_envs", - "channel_data", "channel_envelope", "channel_polynomial", "channel_properties", "channel_property", "channel_rms", - "channel_style", "channel_sync", "channel_widgets", "channels", "channels_equal?", "channels_?", - "chans", "char_position", "cheby_hka", "chebyshev_filters", "check_mix_tags", "chordalize", - "chorus", "clean_channel", "clean_sound", "clear_listener", "clip_hook", "clipping", - "clm_channel", "clm_expsrc", "close_hook", "close_sound", "color2list", "color_cutoff", - "color_hook", "color_inverted", "color_mixes", "color_orientation_dialog", "color_scale", "color?", - "colormap", "colormap2integer", "colormap_name", "colormap_ref", "colormap_size", "colormap?", - "comb", "comb_bank", "comb_bank?", "comb?", "combined_data_color", "comment", - "complexify", "concatenate_envelopes", "constant?", "continuation?", "continue_frample2file", "continue_sample2file", - "contrast_channel", "contrast_control", "contrast_control_amp", "contrast_control_bounds", "contrast_control?", "contrast_enhancement", - "contrast_sound", "controls2channel", "convolution", "convolution_reverb", "convolve", "convolve_files", - "convolve_selection_with", "convolve_with", "convolve?", "copy", "copy", "Copy_context", - "copy_sampler", "correlate", "coverlet", "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis", - "curlet", "current_font", "cursor", "cursor_color", "Cursor_context", "cursor_location_offset", - "cursor_position", "cursor_size", "cursor_style", "cursor_update_interval", "cutlet", "cyclic_sequences", - "dac_combines_channels", "dac_size", "data_color", "data_location", "data_size", "db2linear", - "default_output_chans", "default_output_header_type", "default_output_sample_type", "default_output_srate", "defgenerator", "define_", - "define_constant", "define_envelope", "define_expansion", "define_macro", "define_macro_", "define_selection_via_marks", - "defined?", "degrees2radians", "delay", "delay_channel_mixes", "delay_tick", "delay?", - "delete_colormap", "delete_file_filter", "delete_file_sorter", "delete_mark", "delete_marks", "delete_sample", - "delete_samples", "delete_samples_and_smooth", "delete_selection", "delete_selection_and_smooth", "delete_transform", "describe_hook", - "describe_mark", "dht", "dialog_widgets", "dilambda", "disable_control_panel", "display_bark_fft", - "display_correlation", "display_db", "display_edits", "display_energy", "dissolve_fade", "dither_channel", - "dither_sound", "documentation", "dolph", "dot_product", "dot_size", "down_oct", - "draw_axes", "draw_dot", "draw_dots", "draw_line", "draw_lines", "draw_mark_hook", - "draw_mix_hook", "draw_string", "drone", "drop_sites", "drop_hook", "during_open_hook", - "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function", "edit_position", "edit_properties", - "edit_property", "edit_tree", "edits", "edot_product", "effects_hook", "elliptic_filters", - "env", "env_any", "env_channel", "env_channel_with_base", "env_expt_channel", "env_interp", - "env_mixes", "env_selection", "env_sound", "env_sound_interp", "env_squared_channel", "env?", - "enved_base", "enved_clip?", "enved_dialog", "enved_envelope", "enved_filter", "enved_filter_order", - "enved_hook", "enved_in_dB", "enved_power", "enved_style", "enved_target", "enved_wave?", - "enved_waveform_color", "envelope_interp", "enveloped_mix", "eoddcos", "eoddcos?", "eps_bottom_margin", - "eps_file", "eps_left_margin", "eps_size", "ercos", "ercos?", "_error_hook_", - "erssb", "erssb?", "even_multiple", "even_weight", "every_sample?", "exit", - "exit_hook", "expand_control", "expand_control_bounds", "expand_control_hop", "expand_control_jitter", "expand_control_length", - "expand_control_ramp", "expand_control?", "explode_sf2", "exponentially_weighted_moving_average", "expsnd", "expsrc", - "_features_", "feedback_fm", "fft", "fft_cancel", "fft_edit", "fft_env_edit", - "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", "fft_smoother", "fft_squelch", "fft_window", - "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database", "file2array", "file2frample", - "file2frample?", "file2sample", "file2sample?", "file_name", "fill!", "fill_polygon", - "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs", "filter_control_envelope", "filter_control_in_dB", - "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?", "filter_fft", "filter_selection", - "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb", "filtered_comb_bank", "filtered_comb_bank?", - "filtered_comb?", "find_dialog", "find_mark", "find_mix", "find_sound", "finfo", - "finish_progress_report", "fir_filter", "fir_filter?", "firmant", "firmant?", "fit_selection_between_marks", - "flatten_partials", "float_vector", "float-vector_multiply", "float-vector_add", "float_vector2channel", "float_vector2list", - "float_vector2string", "float_vector_abs!", "float_vector_add!", "float_vector_equal?", "float_vector_fill!", "float_vector_length", - "float_vector_max", "float_vector_min", "float_vector_move!", "float_vector_multiply!", "float_vector_offset!", "float_vector_peak", - "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!", "float_vector_scale!", "float_vector_set!", "float_vector_subseq", - "float_vector_subtract!", "float_vector?", "flocsig", "flocsig?", "flute_model", "fm_bell", - "fm_drum", "fm_noise", "fm_parallel_component", "fm_talker", "fm_trumpet", "fm_violin", - "fm_voice", "fmssb", "fmssb?", "focus_widget", "FOF_synthesis", "fofins", - "for_each_child", "for_each_sound_file", "Forbidden_Planet", "foreground_color", "forget_region", "formant", - "formant_bank", "formant_bank?", "formant?", "format", "fp", "fractional_fourier_transform", - "frample2file", "frample2file?", "frample2frample", "framples", "free_player", "free_sampler", - "freeverb", "fullmix", "funclet", "gaussian_distribution", "gc_off", "gc_on", - "gensym", "gensym?", "gl_graph2ps", "glSpectrogram", "goertzel", "goto_listener_end", - "grani", "granulate", "granulate?", "granulated_sound_interp", "graph", "graph2ps", - "graph_color", "graph_cursor", "graph_data", "graph_hook", "graph_style", "graphic_equalizer", - "graphs_horizontal", "green_noise", "green_noise_interp", "green_noise_interp?", "green_noise?", "grid_density", - "harmonicizer", "Hartley_transform", "hash_table", "hash_table_", "hash_table_entries", "hash_table_ref", - "hash_table_set!", "hash_table?", "header_type", "hello_dentist", "help_dialog", "help_hook", - "hide_widget", "highlight_color", "hilbert_transform", "hook_functions", "hook_member", "html", - "html_dir", "html_program", "hz2radians", "iir_filter", "iir_filter?", "immutable!", - "immutable?", "call_in", "in_any", "ina", "inb", "info_dialog", - "init_ladspa", "initial_beg", "initial_dur", "initial_graph_hook", "inlet", "insert_channel", - "insert_file_dialog", "insert_region", "insert_sample", "insert_samples", "insert_selection", "insert_silence", - "insert_sound", "int_vector", "int_vector_ref", "int_vector_set!", "int_vector?", "integer2colormap", - "integer2mark", "integer2mix", "integer2region", "integer2sound", "integer2transform", "integrate_envelope", - "invert_filter", "iterate", "iterator_at_end?", "iterator_sequence", "iterator?", "izcos", - "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?", "j2cos", - "j2cos?", "jc_reverb", "jjcos", "jjcos?", "jncos", "jncos?", - "jpcos", "jpcos?", "just_sounds", "jycos", "jycos?", "k2cos", - "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?", "k3sin", - "k3sin?", "kalman_filter_channel", "key", "key_binding", "key_press_hook", "krksin", - "krksin?", "ladspa_descriptor", "ladspa_dir", "lambda_", "lbj_piano", "left_sample", - "let2list", "let_ref", "let_set!", "let_temporarily", "let?", "linear2db", - "linear_src_channel", "lint_for_scheme", "lisp_graph_hook", "lisp_graph_style", "lisp_graph?", "list2float_vector", - "list_ladspa", "listener_click_hook", "listener_color", "listener_colorized", "listener_font", "listener_prompt", - "listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_", "locate_zero", - "locsig", "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!", "locsig_type", - "locsig?", "log_freq_start", "lpc_coeffs", "lpc_predict", "macro?", "macroexpand", - "main_menu", "main_widgets", "make_abcos", "make_absin", "make_adjustable_sawtooth_wave", "make_adjustable_square_wave", - "make_adjustable_triangle_wave", "make_all_pass", "make_all_pass_bank", "make_asyfm", "make_asymmetric_fm", "make_bandpass", - "make_bandstop", "make_bess", "make_biquad", "make_birds", "make_blackman", "make_brown_noise", - "make_byte_vector", "make_channel_drop_site", "make_color", "make_comb", "make_comb_bank", "make_convolve", - "make_delay", "make_differentiator", "make_env", "make_eoddcos", "make_ercos", "make_erssb", - "make_fft_window", "make_file2frample", "make_file2sample", "make_filter", "make_filtered_comb", "make_filtered_comb_bank", - "make_fir_coeffs", "make_fir_filter", "make_firmant", "make_float_vector", "make_flocsig", "make_fmssb", - "make_formant", "make_formant_bank", "make_frample2file", "make_granulate", "make_graph_data", "make_green_noise", - "make_green_noise_interp", "make_hash_table", "make_highpass", "make_hilbert_transform", "make_hook", "make_iir_filter", - "make_int_vector", "make_iterator", "make_izcos", "make_j0evencos", "make_j0j1cos", "make_j2cos", - "make_jjcos", "make_jncos", "make_jpcos", "make_jycos", "make_k2cos", "make_k2sin", - "make_k2ssb", "make_k3sin", "make_krksin", "make_locsig", "make_lowpass", "make_mix_sampler", - "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_max", "make_moving_norm", - "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum", "make_n1cos", "make_nchoosekcos", "make_ncos", - "make_nkssb", "make_noddcos", "make_noddsin", "make_noddssb", "make_noid", "make_notch", - "make_nrcos", "make_nrsin", "make_nrssb", "make_nrxycos", "make_nrxysin", "make_nsin", - "make_nsincos", "make_nssb", "make_nxy1cos", "make_nxy1sin", "make_nxycos", "make_nxysin", - "make_one_pole", "make_one_pole_all_pass", "make_one_zero", "make_oscil", "make_oscil_bank", "make_phase_vocoder", - "make_pink_noise", "make_pixmap", "make_player", "make_polyoid", "make_polyshape", "make_polywave", - "make_pulse_train", "make_pulsed_env", "make_r2k!cos", "make_r2k2cos", "make_ramp", "make_rand", - "make_rand_interp", "make_rcos", "make_readin", "make_region", "make_region_sampler", "make_rk!cos", - "make_rk!ssb", "make_rkcos", "make_rkoddssb", "make_rksin", "make_rkssb", "make_round_interp", - "make_rssb", "make_rxycos", "make_rxyk!cos", "make_rxyk!sin", "make_rxysin", "make_sample2file", - "make_sampler", "make_sawtooth_wave", "make_selection", "make_sinc_train", "make_snd2sample", "make_sound_box", - "make_spencer_filter", "make_square_wave", "make_src", "make_ssb_am", "make_table_lookup", "make_table_lookup_with_env", - "make_tanhsin", "make_triangle_wave", "make_two_pole", "make_two_zero", "make_variable_display", "make_variable_graph", - "make_wave_train", "make_wave_train_with_env", "map_channel", "map_sound_files", "maracas", "mark2integer", - "mark_click_hook", "mark_click_info", "mark_color", "Mark_context", "mark_drag_hook", "mark_explode", - "mark_home", "mark_hook", "mark_loops", "mark_name", "mark_name2id", "mark_properties", - "mark_property", "mark_sample", "mark_sync", "mark_sync_color", "mark_sync_max", "mark_tag_height", - "mark_tag_width", "mark?", "marks", "match_sound_files", "max_envelope", "max_regions", - "max_transform_peaks", "maxamp", "maxamp_position", "menu_widgets", "menus__optional", "min_dB", - "mix", "mix2float_vector", "mix2integer", "mix_amp", "mix_amp_env", "mix_channel", - "mix_click_hook", "mix_click_info", "mix_click_sets_amp", "mix_color", "mix_dialog_mix", "mix_drag_hook", - "mix_file_dialog", "mix_float_vector", "mix_home", "mix_length", "mix_maxamp", "mix_name", - "mix_name2id", "mix_position", "mix_properties", "mix_property", "mix_region", "mix_release_hook", - "mix_sampler?", "mix_selection", "mix_sound", "mix_speed", "mix_sync", "mix_sync_max", - "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_waveform_height", "mix?", "mixes", - "mono2stereo", "moog_filter", "morally_equal?", "mouse_click_hook", "mouse_drag_hook", "mouse_enter_graph_hook", - "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook", "mouse_leave_graph_hook", "mouse_leave_label_hook", "mouse_leave_listener_hook", - "mouse_leave_text_hook", "mouse_press_hook", "move_locsig", "move_mixes", "move_sound", "move_sound?", - "move_syncd_marks", "moving_autocorrelation", "moving_autocorrelation?", "moving_average", "moving_average?", "moving_fft", - "moving_fft?", "moving_length", "moving_max", "moving_max?", "moving_norm", "moving_norm?", - "moving_pitch", "moving_pitch?", "moving_rms", "moving_scentroid", "moving_scentroid?", "moving_spectrum", - "moving_spectrum?", "moving_sum", "mpg", "mus_alsa_buffer_size", "mus_alsa_buffers", "mus_alsa_capture_device", - "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length", "mus_bytes_per_sample", "mus_channel", - "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping", "mus_close", "mus_copy", "mus_data", - "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename", "mus_feedback", "mus_feedforward", - "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_mix", "mus_file_name", "mus_float_equal_fudge_factor", - "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string", "mus_header_type_name", "mus_hop", - "mus_increment", "mus_input?", "mus_interp_type", "mus_interpolate", "mus_length", "mus_location", - "mus_max_malloc", "mus_max_table_size", "mus_name", "mus_offset", "mus_order", "mus_oss_set_buffers", - "mus_output?", "mus_phase", "mus_ramp", "mus_rand_seed", "mus_random", "mus_reset", - "mus_run", "mus_sample_type2string", "mus_sample_type_name", "mus_scaler", "mus_sound_chans", "mus_sound_comment", - "mus_sound_data_location", "mus_sound_datum_size", "mus_sound_duration", "mus_sound_forget", "mus_sound_framples", "mus_sound_header_type", - "mus_sound_length", "mus_sound_loop_info", "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_path", - "mus_sound_preload", "mus_sound_prune", "mus_sound_report_cache", "mus_sound_sample_type", "mus_sound_samples", "mus_sound_srate", - "mus_sound_type_specifier", "mus_sound_write_date", "mus_srate", "mus_width", "mus_xcoeff", "mus_xcoeffs", - "mus_ycoeff", "mus_ycoeffs", "n1cos", "n1cos?", "name_click_hook", "nchoosekcos", - "nchoosekcos?", "ncos", "ncos2?", "ncos4?", "ncos?", "new_sound", - "new_sound_dialog", "new_sound_hook", "new_widget_hook", "next_sample", "nkssb", "nkssb_interp", - "nkssb?", "noddcos", "noddcos?", "noddsin", "noddsin?", "noddssb", - "noddssb?", "noid", "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound", - "normalized_mix", "notch", "notch_channel", "notch_selection", "notch_sound", "notch?", - "npcos?", "nrcos", "nrcos?", "nrev", "nrsin", "nrsin?", - "nrssb", "nrssb_interp", "nrssb?", "nrxycos", "nrxycos?", "nrxysin", - "nrxysin?", "nsin", "nsin?", "nsincos", "nsincos?", "nssb", - "nssb?", "nxy1cos", "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", - "nxycos?", "nxysin", "nxysin?", "object2let", "object2string", "odd_multiple", - "odd_weight", "offset_channel", "offset_sound", "one_pole", "one_pole_all_pass", "one_pole_all_pass?", - "one_pole?", "one_zero", "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook", - "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook", "open_sound", "openlet", "openlet?", - "orientation_hook", "oscil", "oscil_bank", "oscil_bank?", "oscil?", "out_any", - "out_bank", "outa", "outlet", "_output_", "output_comment_hook", "overlay_rms_env", - "owlet", "pad_channel", "pad_marks", "pad_sound", "pair_filename", "pair_line_number", - "pan_mix", "pan_mix_float_vector", "partials2polynomial", "partials2wave", "pausing", "peak_env_dir", - "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder", "phase_vocoder?", "piano_model", - "pink_noise", "pink_noise?", "pins", "place_sound", "play", "play_arrow_size", - "play_between_marks", "play_hook", "play_mixes", "play_often", "play_region_forever", "play_sine", - "play_sines", "play_syncd_marks", "play_until_c_g", "play_with_envs", "player_home", "player?", - "players", "playing", "pluck", "polar2rectangular", "polynomial", "polynomial_operations", - "polyoid", "polyoid_env", "polyoid?", "polyshape", "polyshape?", "polywave", - "polywave?", "port_filename", "port_line_number", "position2x", "position2y", "position_color", - "power_env", "pqw", "pqw_vox", "preferences_dialog", "previous_sample", "print_dialog", - "print_length", "procedure_source", "progress_report", "pulse_train", "pulse_train?", "pulsed_env", - "pulsed_env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians2degrees", - "radians2hz", "ramp_channel", "rand", "rand_interp", "rand_interp?", "rand?", - "random", "random_state", "random_state?", "rcos", "rcos?", "_read_error_hook_", - "read_hook", "read_mix_sample", "read_only", "read_region_sample", "read_sample", "read_sample_with_direction", - "reader_cond", "readin", "readin?", "rectangular2magnitudes", "rectangular2polar", "redo_edit", - "region2float_vector", "region2integer", "region_chans", "region_framples", "region_graph_style", "region_home", - "region_maxamp", "region_maxamp_position", "region_play_list", "region_position", "region_rms", "region_sample", - "region_sampler?", "region_srate", "region?", "regions", "remember_sound_state", "remove_clicks", - "remove_from_menu", "replace_with_selection", "report_mark_names", "require", "reset_all_hooks", "reset_controls", - "reset_listener_cursor", "reson", "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback", - "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?", - "reverse!", "reverse_by_blocks", "reverse_channel", "reverse_envelope", "reverse_selection", "reverse_sound", - "revert_sound", "right_sample", "ring_modulate", "rk!cos", "rk!cos?", "rk!ssb", - "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin", - "rksin?", "rkssb", "rkssb?", "rms", "rms__gain__balance_gens", "rms_envelope", - "rootlet", "_rootlet_redefinition_hook_", "round_interp", "round_interp?", "rssb", "rssb_interp", - "rssb?", "rubber_sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", - "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample2file", - "sample2file?", "sample_type", "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", - "samples", "samples2seconds", "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src", "save_controls", - "save_dir", "save_edit_history", "save_envelopes", "save_hook", "save_listener", "save_mark_properties", - "save_marks", "save_mix", "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", - "save_sound", "save_sound_as", "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", - "savitzky_golay_filter", "sawtooth_wave", "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", - "scale_mixes", "scale_selection_by", "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", - "scan_channel", "scanned_synthesis", "scentroid", "scratch", "script_arg", "script_args", - "search_for_click", "search_procedure", "seconds2samples", "select_all", "select_channel", "select_channel_hook", - "select_sound", "select_sound_hook", "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound", - "selection", "selection2mix", "selection_chans", "selection_color", "Selection_context", "selection_creates_region", - "selection_framples", "selection_maxamp", "selection_maxamp_position", "selection_member?", "selection_members", "selection_position", - "selection_rms", "selection_srate", "selection?", "set_samples", "setter", "short_file_name", - "show_axes", "show_controls", "show_disk_space", "show_full_duration", "show_full_range", "show_grid", - "show_indices", "show_listener", "show_marks", "show_mix_waveforms", "show_selection", "show_selection_transform", - "show_sonogram_cursor", "show_transform_peaks", "show_widget", "show_y_zero", "signature", "silence_all_mixes", - "silence_mixes", "sinc_train", "sinc_train?", "sinc_width", "sine_env_channel", "sine_ramp", - "singer", "smooth_channel", "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", - "snap_marks", "snap_mix_to_beat", "snd2sample", "snd2sample?", "snd_color", "snd_error", - "snd_error_hook", "snd_font", "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_", - "snd_print", "snd_spectrum", "snd_tempnam", "snd_url", "snd_urls", "snd_version", - "snd_warning", "snd_warning_hook", "sndwarp", "sort!", "sound2amp_env", "sound2integer", - "sound_file_extensions", "sound_file?", "sound_files_in_directory", "sound_interp", "sound_loop_info", "sound_properties", - "sound_property", "sound_widgets", "sound?", "soundfont_info", "sounds", "sounds2segment_data", - "spectra", "spectral_interpolation", "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale", - "spectro_y_angle", "spectro_y_scale", "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs", - "spectrum_end", "spectrum_start", "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones", - "spot_freq", "square_wave", "square_wave?", "squelch_update", "squelch_vowels", "srate", - "src", "src_channel", "src_duration", "src_fit_envelope", "src_mixes", "src_selection", - "src_sound", "src?", "ssb_am", "ssb_am?", "ssb_bank", "ssb_bank_env", - "ssb_fm", "start_dac", "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report", - "status_report", "stdin_prompt", "stereo2mono", "stereo_flute", "stop_player", "stop_playing", - "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope", "stretch_sound_via_dft", "string2byte_vector", "string_position", - "sublet", "superimpose_ffts", "swap_channels", "swap_selection_channels", "symbol2dynamic_value", "symbol2value", - "symbol_setter", "symbol_table", "sync", "sync_everything", "sync_max", "sync_style", - "syncd_marks", "syncd_mixes", "syncup", "table_lookup", "table_lookup?", "tanhsin", - "tanhsin?", "tap", "tap?", "telephone", "temp_dir", "text_focus_color", - "time_graph_style", "time_graph_type", "time_graph?", "times2samples", "tiny_font", "touch_tone", - "trace", "tracking_cursor_style", "transform2float_vector", "transform2integer", "transform_dialog", "transform_framples", - "transform_graph_style", "transform_graph_type", "transform_graph?", "transform_normalization", "transform_sample", "transform_size", - "transform_type", "transform?", "transpose_mixes", "tree_count", "tree_cyclic?", "tree_leaves", - "tree_memq", "tree_set_memq", "triangle_wave", "triangle_wave?", "tubebell", "tubular_bell", - "two_pole", "two_pole?", "two_tab", "two_zero", "two_zero?", "type_of", - "unbind_key", "_unbound_variable_hook_", "unclip_channel", "undo", "undo_hook", "unlet", - "unselect_all", "update_graphs", "update_hook", "update_lisp_graph", "update_sound", "update_time_graph", - "update_transform_graph", "upon_save_yourself", "user_interface_extensions", "variable_display", "variable_graph?", "varlet", - "vibrating_uniform_circular_string", "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook", - "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog", - "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter", "vox", "wave_train", - "wave_train?", "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average", - "widget_position", "widget_size", "widget_text", "window_height", "window_samples", "window_width", - "window_x", "window_y", "with_background_processes", "with_baffle", "with_file_monitor", "with_gl", - "with_inset_graph", "with_interrupts", "with_let", "with_local_hook", "with_menu_icons", "with_mix_tags", - "with_pointer_focus", "with_relative_panes", "with_smpte_label", "with_sound", "with_temporary_selection", "with_toolbar", - "with_tooltips", "with_tracking_cursor", "with_verbose_cursor", "x2position", "x_axis_label", "x_axis_style", - "x_bounds", "x_position_slider", "x_zoom_slider", "xb_open", "xramp_channel", "y2position", - "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider", "z_transform", "zecho", - "zero_", "zero_pad", "zero_phase", "zip_sound", "zipper", "zoom_color", - "zoom_focus_style"}; + "c_object?", "c_pointer", "c_pointer2list", "c_pointer_info", "c_pointer_type", "c_pointer_weak1", + "c_pointer?", "call_with_exit", "canter", "cascade2canonical", "catch", "cellon", + "chain_dsps", "channel2float_vector", "channel_amp_envs", "channel_data", "channel_envelope", "channel_polynomial", + "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync", "channel_widgets", + "channels", "channels_equal?", "channels_?", "chans", "char_position", "cheby_hka", + "chebyshev_filters", "check_mix_tags", "chordalize", "chorus", "clean_channel", "clean_sound", + "clear_listener", "clip_hook", "clipping", "clm_channel", "clm_expsrc", "close_hook", + "close_sound", "color2list", "color_cutoff", "color_hook", "color_inverted", "color_mixes", + "color_orientation_dialog", "color_scale", "color?", "colormap", "colormap2integer", "colormap_name", + "colormap_ref", "colormap_size", "colormap?", "comb", "comb_bank", "comb_bank?", + "comb?", "combined_data_color", "comment", "complexify", "concatenate_envelopes", "constant?", + "continuation?", "continue_frample2file", "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp", + "contrast_control_bounds", "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel", "convolution", + "convolution_reverb", "convolve", "convolve_files", "convolve_selection_with", "convolve_with", "convolve?", + "copy", "copy", "Copy_context", "copy_sampler", "correlate", "coverlet", + "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis", "curlet", "current_font", "cursor", + "cursor_color", "Cursor_context", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style", + "cursor_update_interval", "cutlet", "cyclic_sequences", "dac_combines_channels", "dac_size", "data_color", + "data_location", "data_size", "db2linear", "default_output_chans", "default_output_header_type", "default_output_sample_type", + "default_output_srate", "defgenerator", "define_", "define_constant", "define_envelope", "define_expansion", + "define_macro", "define_macro_", "define_selection_via_marks", "defined?", "degrees2radians", "delay", + "delay_channel_mixes", "delay_tick", "delay?", "delete_colormap", "delete_file_filter", "delete_file_sorter", + "delete_mark", "delete_marks", "delete_sample", "delete_samples", "delete_samples_and_smooth", "delete_selection", + "delete_selection_and_smooth", "delete_transform", "describe_hook", "describe_mark", "dht", "dialog_widgets", + "dilambda", "disable_control_panel", "display_bark_fft", "display_correlation", "display_db", "display_edits", + "display_energy", "dissolve_fade", "dither_channel", "dither_sound", "documentation", "dolph", + "dot_product", "dot_size", "down_oct", "draw_axes", "draw_dot", "draw_dots", + "draw_line", "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string", "drone", + "drop_sites", "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook", + "edit_list2function", "edit_position", "edit_properties", "edit_property", "edit_tree", "edits", + "edot_product", "effects_hook", "elliptic_filters", "env", "env_any", "env_channel", + "env_channel_with_base", "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound", + "env_sound_interp", "env_squared_channel", "env?", "enved_base", "enved_clip?", "enved_dialog", + "enved_envelope", "enved_filter", "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power", + "enved_style", "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", + "eoddcos", "eoddcos?", "eps_bottom_margin", "eps_file", "eps_left_margin", "eps_size", + "ercos", "ercos?", "_error_hook_", "erssb", "erssb?", "even_multiple", + "even_weight", "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds", + "expand_control_hop", "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2", + "exponentially_weighted_moving_average", "expsnd", "expsrc", "_features_", "feedback_fm", "fft", + "fft_cancel", "fft_edit", "fft_env_edit", "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", + "fft_smoother", "fft_squelch", "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", + "file_database", "file2array", "file2frample", "file2frample?", "file2sample", "file2sample?", + "file_name", "fill!", "fill_polygon", "fill_rectangle", "filter", "filter_channel", + "filter_control_coeffs", "filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", + "filter_control?", "filter_fft", "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", + "filtered_comb", "filtered_comb_bank", "filtered_comb_bank?", "filtered_comb?", "find_dialog", "find_mark", + "find_mix", "find_sound", "finfo", "finish_progress_report", "fir_filter", "fir_filter?", + "firmant", "firmant?", "fit_selection_between_marks", "flatten_partials", "float_vector", "float-vector_multiply", + "float-vector_add", "float_vector2channel", "float_vector2list", "float_vector2string", "float_vector_abs!", "float_vector_add!", + "float_vector_equal?", "float_vector_fill!", "float_vector_length", "float_vector_max", "float_vector_min", "float_vector_move!", + "float_vector_multiply!", "float_vector_offset!", "float_vector_peak", "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!", + "float_vector_scale!", "float_vector_set!", "float_vector_subseq", "float_vector_subtract!", "float_vector?", "flocsig", + "flocsig?", "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_parallel_component", + "fm_talker", "fm_trumpet", "fm_violin", "fm_voice", "fmssb", "fmssb?", + "focus_widget", "FOF_synthesis", "fofins", "for_each_child", "for_each_sound_file", "Forbidden_Planet", + "foreground_color", "forget_region", "formant", "formant_bank", "formant_bank?", "formant?", + "format", "fp", "fractional_fourier_transform", "frample2file", "frample2file?", "frample2frample", + "framples", "free_player", "free_sampler", "freeverb", "fullmix", "funclet", + "gaussian_distribution", "gc_off", "gc_on", "gensym", "gensym?", "gl_graph2ps", + "glSpectrogram", "goertzel", "goto_listener_end", "grani", "granulate", "granulate?", + "granulated_sound_interp", "graph", "graph2ps", "graph_color", "graph_cursor", "graph_data", + "graph_hook", "graph_style", "graphic_equalizer", "graphs_horizontal", "green_noise", "green_noise_interp", + "green_noise_interp?", "green_noise?", "grid_density", "harmonicizer", "Hartley_transform", "hash_table", + "hash_table_", "hash_table_entries", "hash_table_ref", "hash_table_set!", "hash_table?", "header_type", + "hello_dentist", "help_dialog", "help_hook", "hide_widget", "highlight_color", "hilbert_transform", + "hook_functions", "hook_member", "html", "html_dir", "html_program", "hz2radians", + "iir_filter", "iir_filter?", "immutable!", "immutable?", "call_in", "in_any", + "ina", "inb", "info_dialog", "init_ladspa", "initial_beg", "initial_dur", + "initial_graph_hook", "inlet", "insert_channel", "insert_file_dialog", "insert_region", "insert_sample", + "insert_samples", "insert_selection", "insert_silence", "insert_sound", "int_vector", "int_vector_ref", + "int_vector_set!", "int_vector?", "integer2colormap", "integer2mark", "integer2mix", "integer2region", + "integer2sound", "integer2transform", "integrate_envelope", "invert_filter", "iterate", "iterator_at_end?", + "iterator_sequence", "iterator?", "izcos", "izcos?", "j0evencos", "j0evencos?", + "j0j1cos", "j0j1cos?", "j2cos", "j2cos?", "jc_reverb", "jjcos", + "jjcos?", "jncos", "jncos?", "jpcos", "jpcos?", "just_sounds", + "jycos", "jycos?", "k2cos", "k2cos?", "k2sin", "k2sin?", + "k2ssb", "k2ssb?", "k3sin", "k3sin?", "kalman_filter_channel", "key", + "key_binding", "key_press_hook", "krksin", "krksin?", "ladspa_descriptor", "ladspa_dir", + "lambda_", "lbj_piano", "left_sample", "let2list", "let_ref", "let_set!", + "let_temporarily", "let?", "linear2db", "linear_src_channel", "lint_for_scheme", "lisp_graph_hook", + "lisp_graph_style", "lisp_graph?", "list2float_vector", "list_ladspa", "listener_click_hook", "listener_color", + "listener_colorized", "listener_font", "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", + "_load_hook_", "_load_path_", "locate_zero", "locsig", "locsig_ref", "locsig_reverb_ref", + "locsig_reverb_set!", "locsig_set!", "locsig_type", "locsig?", "log_freq_start", "lpc_coeffs", + "lpc_predict", "macro?", "macroexpand", "main_menu", "main_widgets", "make_abcos", + "make_absin", "make_adjustable_sawtooth_wave", "make_adjustable_square_wave", "make_adjustable_triangle_wave", "make_all_pass", "make_all_pass_bank", + "make_asyfm", "make_asymmetric_fm", "make_bandpass", "make_bandstop", "make_bess", "make_biquad", + "make_birds", "make_blackman", "make_brown_noise", "make_byte_vector", "make_channel_drop_site", "make_color", + "make_comb", "make_comb_bank", "make_convolve", "make_delay", "make_differentiator", "make_env", + "make_eoddcos", "make_ercos", "make_erssb", "make_fft_window", "make_file2frample", "make_file2sample", + "make_filter", "make_filtered_comb", "make_filtered_comb_bank", "make_fir_coeffs", "make_fir_filter", "make_firmant", + "make_float_vector", "make_flocsig", "make_fmssb", "make_formant", "make_formant_bank", "make_frample2file", + "make_granulate", "make_graph_data", "make_green_noise", "make_green_noise_interp", "make_hash_table", "make_highpass", + "make_hilbert_transform", "make_hook", "make_iir_filter", "make_int_vector", "make_iterator", "make_izcos", + "make_j0evencos", "make_j0j1cos", "make_j2cos", "make_jjcos", "make_jncos", "make_jpcos", + "make_jycos", "make_k2cos", "make_k2sin", "make_k2ssb", "make_k3sin", "make_krksin", + "make_locsig", "make_lowpass", "make_mix_sampler", "make_move_sound", "make_moving_autocorrelation", "make_moving_average", + "make_moving_fft", "make_moving_max", "make_moving_norm", "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum", + "make_n1cos", "make_nchoosekcos", "make_ncos", "make_nkssb", "make_noddcos", "make_noddsin", + "make_noddssb", "make_noid", "make_notch", "make_nrcos", "make_nrsin", "make_nrssb", + "make_nrxycos", "make_nrxysin", "make_nsin", "make_nsincos", "make_nssb", "make_nxy1cos", + "make_nxy1sin", "make_nxycos", "make_nxysin", "make_one_pole", "make_one_pole_all_pass", "make_one_zero", + "make_oscil", "make_oscil_bank", "make_phase_vocoder", "make_pink_noise", "make_pixmap", "make_player", + "make_polyoid", "make_polyshape", "make_polywave", "make_pulse_train", "make_pulsed_env", "make_r2k!cos", + "make_r2k2cos", "make_ramp", "make_rand", "make_rand_interp", "make_rcos", "make_readin", + "make_region", "make_region_sampler", "make_rk!cos", "make_rk!ssb", "make_rkcos", "make_rkoddssb", + "make_rksin", "make_rkssb", "make_round_interp", "make_rssb", "make_rxycos", "make_rxyk!cos", + "make_rxyk!sin", "make_rxysin", "make_sample2file", "make_sampler", "make_sawtooth_wave", "make_selection", + "make_sinc_train", "make_snd2sample", "make_sound_box", "make_spencer_filter", "make_square_wave", "make_src", + "make_ssb_am", "make_table_lookup", "make_table_lookup_with_env", "make_tanhsin", "make_triangle_wave", "make_two_pole", + "make_two_zero", "make_variable_display", "make_variable_graph", "make_wave_train", "make_wave_train_with_env", "make_weak_hash_table", + "map_channel", "map_sound_files", "maracas", "mark2integer", "mark_click_hook", "mark_click_info", + "mark_color", "Mark_context", "mark_drag_hook", "mark_explode", "mark_home", "mark_hook", + "mark_loops", "mark_name", "mark_name2id", "mark_properties", "mark_property", "mark_sample", + "mark_sync", "mark_sync_color", "mark_sync_max", "mark_tag_height", "mark_tag_width", "mark?", + "marks", "match_sound_files", "max_envelope", "max_regions", "max_transform_peaks", "maxamp", + "maxamp_position", "menu_widgets", "menus__optional", "min_dB", "mix", "mix2float_vector", + "mix2integer", "mix_amp", "mix_amp_env", "mix_channel", "mix_click_hook", "mix_click_info", + "mix_click_sets_amp", "mix_color", "mix_dialog_mix", "mix_drag_hook", "mix_file_dialog", "mix_float_vector", + "mix_home", "mix_length", "mix_maxamp", "mix_name", "mix_name2id", "mix_position", + "mix_properties", "mix_property", "mix_region", "mix_release_hook", "mix_sampler?", "mix_selection", + "mix_sound", "mix_speed", "mix_sync", "mix_sync_max", "mix_tag_height", "mix_tag_width", + "mix_tag_y", "mix_waveform_height", "mix?", "mixes", "mono2stereo", "moog_filter", + "morally_equal?", "mouse_click_hook", "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", + "mouse_enter_text_hook", "mouse_leave_graph_hook", "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", + "move_locsig", "move_mixes", "move_sound", "move_sound?", "move_syncd_marks", "moving_autocorrelation", + "moving_autocorrelation?", "moving_average", "moving_average?", "moving_fft", "moving_fft?", "moving_length", + "moving_max", "moving_max?", "moving_norm", "moving_norm?", "moving_pitch", "moving_pitch?", + "moving_rms", "moving_scentroid", "moving_scentroid?", "moving_spectrum", "moving_spectrum?", "moving_sum", + "mpg", "mus_alsa_buffer_size", "mus_alsa_buffers", "mus_alsa_capture_device", "mus_alsa_device", "mus_alsa_playback_device", + "mus_alsa_squelch_warning", "mus_array_print_length", "mus_bytes_per_sample", "mus_channel", "mus_channels", "mus_chebyshev_tu_sum", + "mus_clipping", "mus_close", "mus_copy", "mus_data", "mus_describe", "mus_error_hook", + "mus_error_type2string", "mus_expand_filename", "mus_feedback", "mus_feedforward", "mus_fft", "mus_file_buffer_size", + "mus_file_clipping", "mus_file_mix", "mus_file_name", "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", + "mus_header_raw_defaults", "mus_header_type2string", "mus_header_type_name", "mus_hop", "mus_increment", "mus_input?", + "mus_interp_type", "mus_interpolate", "mus_length", "mus_location", "mus_max_malloc", "mus_max_table_size", + "mus_name", "mus_offset", "mus_order", "mus_oss_set_buffers", "mus_output?", "mus_phase", + "mus_ramp", "mus_rand_seed", "mus_random", "mus_reset", "mus_run", "mus_sample_type2string", + "mus_sample_type_name", "mus_scaler", "mus_sound_chans", "mus_sound_comment", "mus_sound_data_location", "mus_sound_datum_size", + "mus_sound_duration", "mus_sound_forget", "mus_sound_framples", "mus_sound_header_type", "mus_sound_length", "mus_sound_loop_info", + "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_path", "mus_sound_preload", "mus_sound_prune", + "mus_sound_report_cache", "mus_sound_sample_type", "mus_sound_samples", "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write_date", + "mus_srate", "mus_width", "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs", + "n1cos", "n1cos?", "name_click_hook", "nchoosekcos", "nchoosekcos?", "ncos", + "ncos2?", "ncos4?", "ncos?", "new_sound", "new_sound_dialog", "new_sound_hook", + "new_widget_hook", "next_sample", "nkssb", "nkssb_interp", "nkssb?", "noddcos", + "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?", "noid", + "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound", "normalized_mix", "notch", + "notch_channel", "notch_selection", "notch_sound", "notch?", "npcos?", "nrcos", + "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb", "nrssb_interp", + "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", + "nsin?", "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", + "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", + "nxysin?", "object2let", "object2string", "odd_multiple", "odd_weight", "offset_channel", + "offset_sound", "one_pole", "one_pole_all_pass", "one_pole_all_pass?", "one_pole?", "one_zero", + "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound", + "open_raw_sound_hook", "open_sound", "openlet", "openlet?", "orientation_hook", "oscil", + "oscil_bank", "oscil_bank?", "oscil?", "out_any", "out_bank", "outa", + "outlet", "_output_", "output_comment_hook", "overlay_rms_env", "owlet", "pad_channel", + "pad_marks", "pad_sound", "pair_filename", "pair_line_number", "pan_mix", "pan_mix_float_vector", + "partials2polynomial", "partials2wave", "pausing", "peak_env_dir", "peaks", "peaks_font", + "phase_partials2wave", "phase_vocoder", "phase_vocoder?", "piano_model", "pink_noise", "pink_noise?", + "pins", "place_sound", "play", "play_arrow_size", "play_between_marks", "play_hook", + "play_mixes", "play_often", "play_region_forever", "play_sine", "play_sines", "play_syncd_marks", + "play_until_c_g", "play_with_envs", "player_home", "player?", "players", "playing", + "pluck", "polar2rectangular", "polynomial", "polynomial_operations", "polyoid", "polyoid_env", + "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?", "port_filename", + "port_line_number", "position2x", "position2y", "position_color", "power_env", "pqw", + "pqw_vox", "preferences_dialog", "previous_sample", "print_dialog", "print_length", "procedure_source", + "progress_report", "pulse_train", "pulse_train?", "pulsed_env", "pulsed_env?", "r2k!cos", + "r2k!cos?", "r2k2cos", "r2k2cos?", "radians2degrees", "radians2hz", "ramp_channel", + "rand", "rand_interp", "rand_interp?", "rand?", "random", "random_state", + "random_state?", "rcos", "rcos?", "_read_error_hook_", "read_hook", "read_mix_sample", + "read_only", "read_region_sample", "read_sample", "read_sample_with_direction", "reader_cond", "readin", + "readin?", "rectangular2magnitudes", "rectangular2polar", "redo_edit", "region2float_vector", "region2integer", + "region_chans", "region_framples", "region_graph_style", "region_home", "region_maxamp", "region_maxamp_position", + "region_play_list", "region_position", "region_rms", "region_sample", "region_sampler?", "region_srate", + "region?", "regions", "remember_sound_state", "remove_clicks", "remove_from_menu", "replace_with_selection", + "report_mark_names", "require", "reset_all_hooks", "reset_controls", "reset_listener_cursor", "reson", + "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback", "reverb_control_length", "reverb_control_length_bounds", + "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?", "reverse!", "reverse_by_blocks", + "reverse_channel", "reverse_envelope", "reverse_selection", "reverse_sound", "revert_sound", "right_sample", + "ring_modulate", "rk!cos", "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", + "rkcos?", "rkoddssb", "rkoddssb?", "rksin", "rksin?", "rkssb", + "rkssb?", "rms", "rms__gain__balance_gens", "rms_envelope", "rootlet", "_rootlet_redefinition_hook_", + "round_interp", "round_interp?", "rssb", "rssb_interp", "rssb?", "rubber_sound", + "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?", + "rxysin", "rxysin?", "sample", "sample2file", "sample2file?", "sample_type", + "sampler_at_end?", "sampler_home", "sampler_position", "sampler?", "samples", "samples2seconds", + "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src", "save_controls", "save_dir", "save_edit_history", + "save_envelopes", "save_hook", "save_listener", "save_mark_properties", "save_marks", "save_mix", + "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound", "save_sound_as", + "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter", "sawtooth_wave", + "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes", "scale_selection_by", + "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel", "scanned_synthesis", + "scentroid", "scratch", "script_arg", "script_args", "search_for_click", "search_procedure", + "seconds2samples", "select_all", "select_channel", "select_channel_hook", "select_sound", "select_sound_hook", + "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound", "selection", "selection2mix", + "selection_chans", "selection_color", "Selection_context", "selection_creates_region", "selection_framples", "selection_maxamp", + "selection_maxamp_position", "selection_member?", "selection_members", "selection_position", "selection_rms", "selection_srate", + "selection?", "set_samples", "setter", "short_file_name", "show_axes", "show_controls", + "show_disk_space", "show_full_duration", "show_full_range", "show_grid", "show_indices", "show_listener", + "show_marks", "show_mix_waveforms", "show_selection", "show_selection_transform", "show_sonogram_cursor", "show_transform_peaks", + "show_widget", "show_y_zero", "signature", "silence_all_mixes", "silence_mixes", "sinc_train", + "sinc_train?", "sinc_width", "sine_env_channel", "sine_ramp", "singer", "smooth_channel", + "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", "snap_marks", "snap_mix_to_beat", + "snd2sample", "snd2sample?", "snd_color", "snd_error", "snd_error_hook", "snd_font", + "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_", "snd_print", "snd_spectrum", + "snd_tempnam", "snd_url", "snd_urls", "snd_version", "snd_warning", "snd_warning_hook", + "sndwarp", "sort!", "sound2amp_env", "sound2integer", "sound_file_extensions", "sound_file?", + "sound_files_in_directory", "sound_interp", "sound_loop_info", "sound_properties", "sound_property", "sound_widgets", + "sound?", "soundfont_info", "sounds", "sounds2segment_data", "spectra", "spectral_interpolation", + "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale", + "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start", + "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones", "spot_freq", "square_wave", + "square_wave?", "squelch_update", "squelch_vowels", "srate", "src", "src_channel", + "src_duration", "src_fit_envelope", "src_mixes", "src_selection", "src_sound", "src?", + "ssb_am", "ssb_am?", "ssb_bank", "ssb_bank_env", "ssb_fm", "start_dac", + "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report", "status_report", "stdin_prompt", + "stereo2mono", "stereo_flute", "stop_player", "stop_playing", "stop_playing_hook", "stop_playing_selection_hook", + "stretch_envelope", "stretch_sound_via_dft", "string2byte_vector", "string_position", "sublet", "subvector", + "subvector_position", "subvector_vector", "subvector?", "superimpose_ffts", "swap_channels", "swap_selection_channels", + "symbol2dynamic_value", "symbol2value", "symbol_table", "sync", "sync_everything", "sync_max", + "sync_style", "syncd_marks", "syncd_mixes", "syncup", "table_lookup", "table_lookup?", + "tanhsin", "tanhsin?", "tap", "tap?", "telephone", "temp_dir", + "text_focus_color", "time_graph_style", "time_graph_type", "time_graph?", "times2samples", "tiny_font", + "touch_tone", "trace", "tracking_cursor_style", "transform2float_vector", "transform2integer", "transform_dialog", + "transform_framples", "transform_graph_style", "transform_graph_type", "transform_graph?", "transform_normalization", "transform_sample", + "transform_size", "transform_type", "transform?", "transpose_mixes", "tree_count", "tree_cyclic?", + "tree_leaves", "tree_memq", "tree_set_memq", "triangle_wave", "triangle_wave?", "tubebell", + "tubular_bell", "two_pole", "two_pole?", "two_tab", "two_zero", "two_zero?", + "type_of", "unbind_key", "_unbound_variable_hook_", "unclip_channel", "undo", "undo_hook", + "unlet", "unselect_all", "update_graphs", "update_hook", "update_lisp_graph", "update_sound", + "update_time_graph", "update_transform_graph", "upon_save_yourself", "user_interface_extensions", "variable_display", "variable_graph?", + "varlet", "vibrating_uniform_circular_string", "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", + "view_files_select_hook", "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", + "view_regions_dialog", "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter", "vox", + "wave_train", "wave_train?", "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", + "weak_hash_table?", "weighted_moving_average", "widget_position", "widget_size", "widget_text", "window_height", + "window_samples", "window_width", "window_x", "window_y", "with_background_processes", "with_baffle", + "with_file_monitor", "with_gl", "with_inset_graph", "with_interrupts", "with_let", "with_local_hook", + "with_menu_icons", "with_mix_tags", "with_pointer_focus", "with_relative_panes", "with_smpte_label", "with_sound", + "with_temporary_selection", "with_toolbar", "with_tooltips", "with_tracking_cursor", "with_verbose_cursor", "x2position", + "x_axis_label", "x_axis_style", "x_bounds", "x_position_slider", "x_zoom_slider", "xb_open", + "xramp_channel", "y2position", "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider", + "z_transform", "zecho", "zero_", "zero_pad", "zero_phase", "zip_sound", + "zipper", "zoom_color", "zoom_focus_style"}; #endif #if (!HAVE_EXTENSION_LANGUAGE) static const char **help_names = NULL; @@ -567,173 +569,174 @@ static const char *help_urls[HELP_NAMES_SIZE] = { "extsnd.html#boldpeaksfont", "extsnd.html#break", "sndclm.html#brown-noise", "sndclm.html#brown-noise?", "sndscm.html#analogfilterdoc", "s7.html#bytevector", "s7.html#bytevectortostring", "s7.html#bytevectorref", "s7.html#bytevectorset", "s7.html#bytevectorp", "s7.html#definecfunction", "extsnd.html#cgp", - "s7.html#cobject", "s7.html#cpoint", "s7.html#cpointertolist", "s7.html#cpointer", - "s7.html#callwithexit", "sndscm.html#bagpipe", "sndscm.html#cascadetocanonical", "s7.html#catch", - "sndscm.html#cellon", "sndscm.html#chaindsps", "extsnd.html#channeltofv", "extsnd.html#channelampenvs", - "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial", "extsnd.html#channelproperties", - "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle", "sndscm.html#channelsync", - "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal", "sndscm.html#channelseq", - "extsnd.html#chans", "s7.html#charposition", "sndscm.html#chebyhka", "sndscm.html#analogfilterdoc", - "sndscm.html#checkmixtags", "sndscm.html#chordalize", "sndscm.html#chorus", "sndscm.html#cleanchannel", - "sndscm.html#cleansound", "extsnd.html#clearlistener", "extsnd.html#cliphook", "extsnd.html#clipping", - "extsnd.html#clmchannel", "sndscm.html#clmexpsrc", "extsnd.html#closehook", "extsnd.html#closesound", - "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook", "extsnd.html#colorinverted", - "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale", "extsnd.html#colorp", - "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname", "extsnd.html#colormapref", - "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb", "sndclm.html#combbank", - "sndclm.html#combbankp", "sndclm.html#comb?", "extsnd.html#combineddatacolor", "extsnd.html#comment", - "sndscm.html#complexify", "sndscm.html#concatenateenvelopes", "s7.html#constantp", "s7.html#continuationp", - "sndclm.html#continue-frampletofile", "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel", "extsnd.html#contrastcontrol", - "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement", - "sndscm.html#contrastsound", "extsnd.html#controlstochannel", "sndclm.html#convolution", "extsnd.html#convolvewith", - "sndclm.html#convolve", "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", - "sndclm.html#convolve?", "extsnd.html#fvcopy", "s7.html#s7copy", "extsnd.html#copycontext", - "extsnd.html#copysampler", "sndclm.html#correlate", "s7.html#coverlet", "sndscm.html#mixdoc", - "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "s7.html#curlet", "extsnd.html#currentfont", - "extsnd.html#cursor", "extsnd.html#cursorcolor", "extsnd.html#cursorcontext", "extsnd.html#cursorlocationoffset", - "extsnd.html#cursorposition", "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", - "s7.html#cutlet", "s7.html#cyclicsequences", "extsnd.html#dacfolding", "extsnd.html#dacsize", - "extsnd.html#datacolor", "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear", - "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype", "extsnd.html#defaultoutputsrate", - "sndclm.html#defgenerator", "s7.html#definestar", "s7.html#defineconstant", "extsnd.html#defineenvelope", - "s7.html#expansion", "s7.html#definemacro", "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks", - "s7.html#definedp", "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes", - "sndclm.html#delaytick", "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", - "extsnd.html#deletefilesorter", "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample", - "extsnd.html#deletesamples", "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth", - "extsnd.html#deletetransform", "sndscm.html#describehook", "sndscm.html#describemark", "sndscm.html#dht", - "extsnd.html#dialogwidgets", "s7.html#dilambda", "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft", - "sndscm.html#displaycorrelation", "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayenergy", - "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound", "s7.html#documentation", - "sndscm.html#dolph", "sndclm.html#dot-product", "extsnd.html#dotsize", "sndscm.html#downoct", - "extsnd.html#drawaxes", "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline", - "extsnd.html#drawlines", "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring", - "sndscm.html#drone", "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook", - "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction", - "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree", - "extsnd.html#edits", "sndclm.html#edot-product", "extsnd.html#effectshook", "sndscm.html#analogfilterdoc", - "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase", - "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection", - "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel", "sndclm.html#env?", - "extsnd.html#envedbase", "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope", - "extsnd.html#filterenv", "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB", - "extsnd.html#envedpower", "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving", - "extsnd.html#envedwaveformcolor", "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix", "sndclm.html#eoddcos", - "sndclm.html#eoddcos?", "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin", - "extsnd.html#epssize", "sndclm.html#ercos", "sndclm.html#ercos?", "s7.html#errorhook", - "sndclm.html#erssb", "sndclm.html#erssb?", "sndclm.html#evenmultiple", "sndclm.html#evenweight", - "sndscm.html#everysample", "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol", - "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength", - "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average", - "sndscm.html#expsnd", "sndscm.html#expsrc", "s7.html#featureslist", "sndscm.html#cellon", - "extsnd.html#fft", "sndscm.html#fftcancel", "sndscm.html#fftedit", "sndscm.html#fftenvedit", - "sndscm.html#fftenvinterp", "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", - "sndscm.html#fftsquelch", "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta", - "extsnd.html#fftwithphases", "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframple", - "sndclm.html#filetoframple?", "sndclm.html#filetosample", "sndclm.html#filetosample?", "extsnd.html#filename", - "s7.html#fillb", "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter", - "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", - "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", - "sndscm.html#filterfft", "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", - "sndclm.html#filter?", "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp", - "sndclm.html#filtered-comb?", "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix", - "extsnd.html#findsound", "sndscm.html#finfo", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter", - "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks", - "sndscm.html#flattenpartials", "extsnd.html#fv", "extsnd.html#fvtimes", "extsnd.html#fvplus", - "extsnd.html#fvtochannel", "extsnd.html#fvtolist", "extsnd.html#fvtostring", "extsnd.html#fvabs", - "extsnd.html#fvadd", "extsnd.html#fvequal", "extsnd.html#fvfill", "extsnd.html#fvlength", - "extsnd.html#fvmax", "extsnd.html#fvmin", "extsnd.html#fvmove", "extsnd.html#fvmultiply", - "extsnd.html#fvoffset", "extsnd.html#fvpeak", "sndscm.html#fvpolynomial", "extsnd.html#fvref", - "extsnd.html#fvreverse", "extsnd.html#fvscale", "extsnd.html#fvset", "extsnd.html#fvsubseq", - "extsnd.html#fvsubtract", "extsnd.html#fvp", "sndclm.html#flocsig", "sndclm.html#flocsig?", - "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum", "sndscm.html#fmnoise", - "sndscm.html#fmparallelcomponent", "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc", - "sndscm.html#fmvoice", "sndclm.html#fmssb", "sndclm.html#fmssb?", "extsnd.html#focuswidget", - "sndscm.html#fofins", "sndscm.html#fofins", "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile", - "sndscm.html#fp", "extsnd.html#foregroundcolor", "extsnd.html#forgetregion", "sndclm.html#formant", - "sndclm.html#formantbank", "sndclm.html#formantbankp", "sndclm.html#formant?", "s7.html#format", - "sndscm.html#fp", "sndscm.html#fractionalfouriertransform", "sndclm.html#frampletofile", "sndclm.html#frampletofile?", - "sndclm.html#frampletoframple", "extsnd.html#framples", "extsnd.html#freeplayer", "extsnd.html#freesampler", - "sndscm.html#freeverb", "sndscm.html#fullmix", "s7.html#funclet", "sndscm.html#gaussiandistribution", - "extsnd.html#gcoff", "extsnd.html#gcon", "s7.html#gensym", "s7.html#gensym?", - "extsnd.html#glgraphtops", "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend", - "sndscm.html#grani", "sndclm.html#granulate", "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp", - "extsnd.html#graph", "extsnd.html#graphtops", "extsnd.html#graphcolor", "extsnd.html#graphcursor", - "extsnd.html#graphdata", "extsnd.html#graphhook", "extsnd.html#graphstyle", "sndscm.html#grapheq", - "extsnd.html#graphshorizontal", "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "sndclm.html#green-noise-interp?", - "sndclm.html#green-noise?", "extsnd.html#griddensity", "sndscm.html#harmonicizer", "sndscm.html#dht", - "s7.html#hashtable", "s7.html#hashtablestar", "s7.html#hashtableentries", "s7.html#hashtableref", - "s7.html#hashtableset", "s7.html#hashtablep", "extsnd.html#headertype", "sndscm.html#hellodentist", - "extsnd.html#helpdialog", "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor", - "sndscm.html#hilberttransform", "s7.html#hookfunctions", "sndscm.html#hookmember", "sndscm.html#html", - "extsnd.html#htmldir", "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter", - "sndclm.html#iir-filter?", "s7.html#immutableb", "s7.html#immutablep", "extsnd.html#gin", - "sndclm.html#in-any", "sndclm.html#ina", "sndclm.html#inb", "extsnd.html#infodialog", - "grfsnd.html#initladspa", "extsnd.html#initialbeg", "extsnd.html#initialdur", "extsnd.html#initialgraphhook", - "s7.html#inlet", "sndscm.html#insertchannel", "extsnd.html#insertfiledialog", "extsnd.html#insertregion", - "extsnd.html#insertsample", "extsnd.html#insertsamples", "extsnd.html#insertselection", "extsnd.html#insertsilence", - "extsnd.html#insertsound", "s7.html#intvector", "s7.html#intvectorref", "s7.html#intvectorset", - "s7.html#intvectorp", "extsnd.html#integertocolormap", "extsnd.html#integertomark", "extsnd.html#integertomix", - "extsnd.html#integertoregion", "extsnd.html#integertosound", "extsnd.html#integertotransform", "sndscm.html#integrateenvelope", - "sndscm.html#invertfilter", "s7.html#iterate", "s7.html#iteratoratend", "s7.html#iteratorsequence", - "s7.html#iteratorp", "sndclm.html#izcos", "sndclm.html#izcos?", "sndclm.html#j0evencos", - "sndclm.html#j0evencos?", "sndclm.html#j0j1cos", "sndclm.html#j0j1cos?", "sndclm.html#j2cos", - "sndclm.html#j2cos?", "sndscm.html#jcreverb", "sndclm.html#jjcos", "sndclm.html#jjcos?", - "sndclm.html#jncos", "sndclm.html#jncos?", "sndclm.html#jpcos", "sndclm.html#jpcos?", - "extsnd.html#justsounds", "sndclm.html#jycos", "sndclm.html#jycos?", "sndclm.html#k2cos", - "sndclm.html#k2cos?", "sndclm.html#k2sin", "sndclm.html#k2sin?", "sndclm.html#k2ssb", - "sndclm.html#k2ssb?", "sndclm.html#k3sin", "sndclm.html#k3sin?", "sndscm.html#kalmanfilterchannel", - "extsnd.html#key", "extsnd.html#keybinding", "extsnd.html#keypresshook", "sndclm.html#krksin", - "sndclm.html#krksin?", "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir", "s7.html#lambdastar", - "sndscm.html#lbjpiano", "extsnd.html#leftsample", "s7.html#lettolist", "s7.html#letref", - "s7.html#letset", "s7.html#lettemporarily", "s7.html#letp", "sndclm.html#lineartodb", - "sndscm.html#linearsrcchannel", "sndscm.html#lintdoc", "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle", - "extsnd.html#lispgraphp", "extsnd.html#listtofv", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook", - "extsnd.html#listenercolor", "extsnd.html#listenercolorized", "extsnd.html#listenerfont", "extsnd.html#listenerprompt", - "extsnd.html#listenerselection", "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook", - "s7.html#loadpath", "sndscm.html#locatezero", "sndclm.html#locsig", "sndclm.html#locsig-ref", - "sndclm.html#locsig-reverb-ref", "sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type", - "sndclm.html#locsig?", "extsnd.html#logfreqstart", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict", - "s7.html#macrop", "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets", - "sndclm.html#make-abcos", "sndclm.html#make-absin", "sndclm.html#make-adjustable-sawtooth-wave", "sndclm.html#make-adjustable-square-wave", - "sndclm.html#make-adjustable-triangle-wave", "sndclm.html#make-all-pass", "sndclm.html#makeallpassbank", "sndclm.html#make-asyfm", - "sndclm.html#make-asymmetric-fm", "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndclm.html#make-bess", - "sndscm.html#makebiquad", "sndscm.html#makebirds", "sndclm.html#make-blackman", "sndclm.html#make-brown-noise", - "s7.html#makebytevector", "sndscm.html#makedropsite", "extsnd.html#makecolor", "sndclm.html#make-comb", - "sndclm.html#makecombbank", "sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator", - "sndclm.html#make-env", "sndclm.html#make-eoddcos", "sndclm.html#make-ercos", "sndclm.html#make-erssb", - "sndclm.html#make-fft-window", "sndclm.html#make-filetoframple", "sndclm.html#make-filetosample", "sndclm.html#make-filter", - "sndclm.html#make-filtered-comb", "sndclm.html#makefilteredcombbank", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter", - "sndclm.html#make-firmant", "extsnd.html#makefv", "sndclm.html#make-flocsig", "sndclm.html#make-fmssb", - "sndclm.html#make-formant", "sndclm.html#makeformantbank", "sndclm.html#make-frampletofile", "sndclm.html#make-granulate", - "extsnd.html#makegraphdata", "sndclm.html#make-green-noise", "sndclm.html#make-green-noise-interp", "s7.html#makehashtable", - "sndscm.html#makehighpass", "sndscm.html#makehilberttransform", "s7.html#makehook", "sndclm.html#make-iir-filter", - "s7.html#makeintvector", "s7.html#makeiterator", "sndclm.html#make-izcos", "sndclm.html#make-j0evencos", - "sndclm.html#make-j0j1cos", "sndclm.html#make-j2cos", "sndclm.html#make-jjcos", "sndclm.html#make-jncos", - "sndclm.html#make-jpcos", "sndclm.html#make-jycos", "sndclm.html#make-k2cos", "sndclm.html#make-k2sin", - "sndclm.html#make-k2ssb", "sndclm.html#make-k3sin", "sndclm.html#make-krksin", "sndclm.html#make-locsig", - "sndscm.html#makelowpass", "extsnd.html#makemixsampler", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation", - "sndclm.html#make-moving-average", "sndclm.html#make-moving-fft", "sndclm.html#make-moving-max", "sndclm.html#make-moving-norm", - "sndclm.html#make-moving-pitch", "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-n1cos", - "sndclm.html#make-nchoosekcos", "sndclm.html#make-ncos", "sndclm.html#make-nkssb", "sndclm.html#make-noddcos", - "sndclm.html#make-noddsin", "sndclm.html#make-noddssb", "sndclm.html#make-noid", "sndclm.html#make-notch", - "sndclm.html#make-nrcos", "sndclm.html#make-nrsin", "sndclm.html#make-nrssb", "sndclm.html#make-nrxycos", - "sndclm.html#make-nrxysin", "sndclm.html#make-nsin", "sndclm.html#make-nsincos", "sndclm.html#make-nssb", - "sndclm.html#make-nxy1cos", "sndclm.html#make-nxy1sin", "sndclm.html#make-nxycos", "sndclm.html#make-nxysin", - "sndclm.html#make-one-pole", "sndclm.html#make-one-pole-all-pass", "sndclm.html#make-one-zero", "sndclm.html#make-oscil", - "sndclm.html#make-oscil-bank", "sndclm.html#make-phase-vocoder", "sndclm.html#make-pink-noise", "sndscm.html#makepixmap", - "extsnd.html#makeplayer", "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave", - "sndclm.html#make-pulse-train", "sndclm.html#make-pulsed-env", "sndclm.html#make-r2k!cos", "sndclm.html#make-r2k2cos", - "sndscm.html#makeramp", "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-rcos", - "sndclm.html#make-readin", "extsnd.html#makeregion", "extsnd.html#makeregionsampler", "sndclm.html#make-rk!cos", - "sndclm.html#make-rk!ssb", "sndclm.html#make-rkcos", "sndclm.html#make-rkoddssb", "sndclm.html#make-rksin", - "sndclm.html#make-rkssb", "sndclm.html#make-round-interp", "sndclm.html#make-rssb", "sndclm.html#make-rxycos", - "sndclm.html#make-rxyk!cos", "sndclm.html#make-rxyk!sin", "sndclm.html#make-rxysin", "sndclm.html#make-sampletofile", - "extsnd.html#makesampler", "sndclm.html#make-sawtooth-wave", "sndscm.html#makeselection", "sndclm.html#make-sinc-train", - "extsnd.html#makesndtosample", "sndscm.html#makesoundbox", "sndscm.html#makespencerfilter", "sndclm.html#make-square-wave", - "sndclm.html#make-src", "sndclm.html#make-ssb-am", "sndclm.html#make-table-lookup", "sndclm.html#make-table-lookup-with-env", - "sndclm.html#make-tanhsin", "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero", - "sndscm.html#makevariabledisplay", "extsnd.html#makevariablegraph", "sndclm.html#make-wave-train", "sndclm.html#make-wave-train-with-env", + "s7.html#cobject", "s7.html#cpoint", "s7.html#cpointertolist", "s7.html#cpointinfo", + "s7.html#cpointtype", "s7.html#cpointweak1", "s7.html#cpointer", "s7.html#callwithexit", + "sndscm.html#bagpipe", "sndscm.html#cascadetocanonical", "s7.html#catch", "sndscm.html#cellon", + "sndscm.html#chaindsps", "extsnd.html#channeltofv", "extsnd.html#channelampenvs", "extsnd.html#channeldata", + "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial", "extsnd.html#channelproperties", "extsnd.html#channelproperty", + "sndscm.html#channelrms", "extsnd.html#channelstyle", "sndscm.html#channelsync", "extsnd.html#channelwidgets", + "extsnd.html#channels", "sndscm.html#channelsequal", "sndscm.html#channelseq", "extsnd.html#chans", + "s7.html#charposition", "sndscm.html#chebyhka", "sndscm.html#analogfilterdoc", "sndscm.html#checkmixtags", + "sndscm.html#chordalize", "sndscm.html#chorus", "sndscm.html#cleanchannel", "sndscm.html#cleansound", + "extsnd.html#clearlistener", "extsnd.html#cliphook", "extsnd.html#clipping", "extsnd.html#clmchannel", + "sndscm.html#clmexpsrc", "extsnd.html#closehook", "extsnd.html#closesound", "extsnd.html#colortolist", + "extsnd.html#colorcutoff", "extsnd.html#colorhook", "extsnd.html#colorinverted", "sndscm.html#colormixes", + "extsnd.html#colororientationdialog", "extsnd.html#colorscale", "extsnd.html#colorp", "extsnd.html#colormap", + "extsnd.html#colormaptointeger", "extsnd.html#colormapname", "extsnd.html#colormapref", "extsnd.html#colormapsize", + "extsnd.html#colormapp", "sndclm.html#comb", "sndclm.html#combbank", "sndclm.html#combbankp", + "sndclm.html#comb?", "extsnd.html#combineddatacolor", "extsnd.html#comment", "sndscm.html#complexify", + "sndscm.html#concatenateenvelopes", "s7.html#constantp", "s7.html#continuationp", "sndclm.html#continue-frampletofile", + "sndclm.html#continue-sampletofile", "sndscm.html#contrastchannel", "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp", + "extsnd.html#contrastcontrolbounds", "extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound", + "extsnd.html#controlstochannel", "sndclm.html#convolution", "extsnd.html#convolvewith", "sndclm.html#convolve", + "sndclm.html#convolvefiles", "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?", + "extsnd.html#fvcopy", "s7.html#s7copy", "extsnd.html#copycontext", "extsnd.html#copysampler", + "sndclm.html#correlate", "s7.html#coverlet", "sndscm.html#mixdoc", "sndscm.html#fadedoc", + "sndscm.html#crosssynthesis", "s7.html#curlet", "extsnd.html#currentfont", "extsnd.html#cursor", + "extsnd.html#cursorcolor", "extsnd.html#cursorcontext", "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition", + "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", "s7.html#cutlet", + "s7.html#cyclicsequences", "extsnd.html#dacfolding", "extsnd.html#dacsize", "extsnd.html#datacolor", + "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans", + "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype", "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator", + "s7.html#definestar", "s7.html#defineconstant", "extsnd.html#defineenvelope", "s7.html#expansion", + "s7.html#definemacro", "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks", "s7.html#definedp", + "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes", "sndclm.html#delaytick", + "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter", + "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample", "extsnd.html#deletesamples", + "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform", + "sndscm.html#describehook", "sndscm.html#describemark", "sndscm.html#dht", "extsnd.html#dialogwidgets", + "s7.html#dilambda", "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft", "sndscm.html#displaycorrelation", + "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayenergy", "sndscm.html#dissolvefade", + "sndscm.html#ditherchannel", "sndscm.html#dithersound", "s7.html#documentation", "sndscm.html#dolph", + "sndclm.html#dot-product", "extsnd.html#dotsize", "sndscm.html#downoct", "extsnd.html#drawaxes", + "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline", "extsnd.html#drawlines", + "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring", "sndscm.html#drone", + "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook", "extsnd.html#editfragment", + "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction", "extsnd.html#editposition", + "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree", "extsnd.html#edits", + "sndclm.html#edot-product", "extsnd.html#effectshook", "sndscm.html#analogfilterdoc", "sndclm.html#env", + "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel", + "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection", "extsnd.html#envsound", + "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel", "sndclm.html#env?", "extsnd.html#envedbase", + "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope", "extsnd.html#filterenv", + "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB", "extsnd.html#envedpower", + "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving", "extsnd.html#envedwaveformcolor", + "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix", "sndclm.html#eoddcos", "sndclm.html#eoddcos?", + "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin", "extsnd.html#epssize", + "sndclm.html#ercos", "sndclm.html#ercos?", "s7.html#errorhook", "sndclm.html#erssb", + "sndclm.html#erssb?", "sndclm.html#evenmultiple", "sndclm.html#evenweight", "sndscm.html#everysample", + "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds", + "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp", + "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average", "sndscm.html#expsnd", + "sndscm.html#expsrc", "s7.html#featureslist", "sndscm.html#cellon", "extsnd.html#fft", + "sndscm.html#fftcancel", "sndscm.html#fftedit", "sndscm.html#fftenvedit", "sndscm.html#fftenvinterp", + "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother", "sndscm.html#fftsquelch", + "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta", "extsnd.html#fftwithphases", + "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframple", "sndclm.html#filetoframple?", + "sndclm.html#filetosample", "sndclm.html#filetosample?", "extsnd.html#filename", "s7.html#fillb", + "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter", "extsnd.html#filterchannel", + "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz", + "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", "sndscm.html#filterfft", + "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound", "sndclm.html#filter?", + "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp", "sndclm.html#filtered-comb?", + "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix", "extsnd.html#findsound", + "sndscm.html#finfo", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter", "sndclm.html#fir-filter?", + "sndclm.html#firmant", "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks", "sndscm.html#flattenpartials", + "extsnd.html#fv", "extsnd.html#fvtimes", "extsnd.html#fvplus", "extsnd.html#fvtochannel", + "extsnd.html#fvtolist", "extsnd.html#fvtostring", "extsnd.html#fvabs", "extsnd.html#fvadd", + "extsnd.html#fvequal", "extsnd.html#fvfill", "extsnd.html#fvlength", "extsnd.html#fvmax", + "extsnd.html#fvmin", "extsnd.html#fvmove", "extsnd.html#fvmultiply", "extsnd.html#fvoffset", + "extsnd.html#fvpeak", "sndscm.html#fvpolynomial", "extsnd.html#fvref", "extsnd.html#fvreverse", + "extsnd.html#fvscale", "extsnd.html#fvset", "extsnd.html#fvsubseq", "extsnd.html#fvsubtract", + "extsnd.html#fvp", "sndclm.html#flocsig", "sndclm.html#flocsig?", "sndscm.html#stereoflute", + "sndscm.html#fmbell", "sndscm.html#fmdrum", "sndscm.html#fmnoise", "sndscm.html#fmparallelcomponent", + "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc", "sndscm.html#fmvoice", + "sndclm.html#fmssb", "sndclm.html#fmssb?", "extsnd.html#focuswidget", "sndscm.html#fofins", + "sndscm.html#fofins", "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile", "sndscm.html#fp", + "extsnd.html#foregroundcolor", "extsnd.html#forgetregion", "sndclm.html#formant", "sndclm.html#formantbank", + "sndclm.html#formantbankp", "sndclm.html#formant?", "s7.html#format", "sndscm.html#fp", + "sndscm.html#fractionalfouriertransform", "sndclm.html#frampletofile", "sndclm.html#frampletofile?", "sndclm.html#frampletoframple", + "extsnd.html#framples", "extsnd.html#freeplayer", "extsnd.html#freesampler", "sndscm.html#freeverb", + "sndscm.html#fullmix", "s7.html#funclet", "sndscm.html#gaussiandistribution", "extsnd.html#gcoff", + "extsnd.html#gcon", "s7.html#gensym", "s7.html#gensym?", "extsnd.html#glgraphtops", + "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend", "sndscm.html#grani", + "sndclm.html#granulate", "sndclm.html#granulate?", "sndscm.html#granulatedsoundinterp", "extsnd.html#graph", + "extsnd.html#graphtops", "extsnd.html#graphcolor", "extsnd.html#graphcursor", "extsnd.html#graphdata", + "extsnd.html#graphhook", "extsnd.html#graphstyle", "sndscm.html#grapheq", "extsnd.html#graphshorizontal", + "sndclm.html#green-noise", "sndclm.html#green-noise-interp", "sndclm.html#green-noise-interp?", "sndclm.html#green-noise?", + "extsnd.html#griddensity", "sndscm.html#harmonicizer", "sndscm.html#dht", "s7.html#hashtable", + "s7.html#hashtablestar", "s7.html#hashtableentries", "s7.html#hashtableref", "s7.html#hashtableset", + "s7.html#hashtablep", "extsnd.html#headertype", "sndscm.html#hellodentist", "extsnd.html#helpdialog", + "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor", "sndscm.html#hilberttransform", + "s7.html#hookfunctions", "sndscm.html#hookmember", "sndscm.html#html", "extsnd.html#htmldir", + "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter", "sndclm.html#iir-filter?", + "s7.html#immutableb", "s7.html#immutablep", "extsnd.html#gin", "sndclm.html#in-any", + "sndclm.html#ina", "sndclm.html#inb", "extsnd.html#infodialog", "grfsnd.html#initladspa", + "extsnd.html#initialbeg", "extsnd.html#initialdur", "extsnd.html#initialgraphhook", "s7.html#inlet", + "sndscm.html#insertchannel", "extsnd.html#insertfiledialog", "extsnd.html#insertregion", "extsnd.html#insertsample", + "extsnd.html#insertsamples", "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound", + "s7.html#intvector", "s7.html#intvectorref", "s7.html#intvectorset", "s7.html#intvectorp", + "extsnd.html#integertocolormap", "extsnd.html#integertomark", "extsnd.html#integertomix", "extsnd.html#integertoregion", + "extsnd.html#integertosound", "extsnd.html#integertotransform", "sndscm.html#integrateenvelope", "sndscm.html#invertfilter", + "s7.html#iterate", "s7.html#iteratoratend", "s7.html#iteratorsequence", "s7.html#iteratorp", + "sndclm.html#izcos", "sndclm.html#izcos?", "sndclm.html#j0evencos", "sndclm.html#j0evencos?", + "sndclm.html#j0j1cos", "sndclm.html#j0j1cos?", "sndclm.html#j2cos", "sndclm.html#j2cos?", + "sndscm.html#jcreverb", "sndclm.html#jjcos", "sndclm.html#jjcos?", "sndclm.html#jncos", + "sndclm.html#jncos?", "sndclm.html#jpcos", "sndclm.html#jpcos?", "extsnd.html#justsounds", + "sndclm.html#jycos", "sndclm.html#jycos?", "sndclm.html#k2cos", "sndclm.html#k2cos?", + "sndclm.html#k2sin", "sndclm.html#k2sin?", "sndclm.html#k2ssb", "sndclm.html#k2ssb?", + "sndclm.html#k3sin", "sndclm.html#k3sin?", "sndscm.html#kalmanfilterchannel", "extsnd.html#key", + "extsnd.html#keybinding", "extsnd.html#keypresshook", "sndclm.html#krksin", "sndclm.html#krksin?", + "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir", "s7.html#lambdastar", "sndscm.html#lbjpiano", + "extsnd.html#leftsample", "s7.html#lettolist", "s7.html#letref", "s7.html#letset", + "s7.html#lettemporarily", "s7.html#letp", "sndclm.html#lineartodb", "sndscm.html#linearsrcchannel", + "sndscm.html#lintdoc", "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp", + "extsnd.html#listtofv", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook", "extsnd.html#listenercolor", + "extsnd.html#listenercolorized", "extsnd.html#listenerfont", "extsnd.html#listenerprompt", "extsnd.html#listenerselection", + "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook", "s7.html#loadpath", + "sndscm.html#locatezero", "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref", + "sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type", "sndclm.html#locsig?", + "extsnd.html#logfreqstart", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict", "s7.html#macrop", + "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets", "sndclm.html#make-abcos", + "sndclm.html#make-absin", "sndclm.html#make-adjustable-sawtooth-wave", "sndclm.html#make-adjustable-square-wave", "sndclm.html#make-adjustable-triangle-wave", + "sndclm.html#make-all-pass", "sndclm.html#makeallpassbank", "sndclm.html#make-asyfm", "sndclm.html#make-asymmetric-fm", + "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndclm.html#make-bess", "sndscm.html#makebiquad", + "sndscm.html#makebirds", "sndclm.html#make-blackman", "sndclm.html#make-brown-noise", "s7.html#makebytevector", + "sndscm.html#makedropsite", "extsnd.html#makecolor", "sndclm.html#make-comb", "sndclm.html#makecombbank", + "sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator", "sndclm.html#make-env", + "sndclm.html#make-eoddcos", "sndclm.html#make-ercos", "sndclm.html#make-erssb", "sndclm.html#make-fft-window", + "sndclm.html#make-filetoframple", "sndclm.html#make-filetosample", "sndclm.html#make-filter", "sndclm.html#make-filtered-comb", + "sndclm.html#makefilteredcombbank", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter", "sndclm.html#make-firmant", + "extsnd.html#makefv", "sndclm.html#make-flocsig", "sndclm.html#make-fmssb", "sndclm.html#make-formant", + "sndclm.html#makeformantbank", "sndclm.html#make-frampletofile", "sndclm.html#make-granulate", "extsnd.html#makegraphdata", + "sndclm.html#make-green-noise", "sndclm.html#make-green-noise-interp", "s7.html#makehashtable", "sndscm.html#makehighpass", + "sndscm.html#makehilberttransform", "s7.html#makehook", "sndclm.html#make-iir-filter", "s7.html#makeintvector", + "s7.html#makeiterator", "sndclm.html#make-izcos", "sndclm.html#make-j0evencos", "sndclm.html#make-j0j1cos", + "sndclm.html#make-j2cos", "sndclm.html#make-jjcos", "sndclm.html#make-jncos", "sndclm.html#make-jpcos", + "sndclm.html#make-jycos", "sndclm.html#make-k2cos", "sndclm.html#make-k2sin", "sndclm.html#make-k2ssb", + "sndclm.html#make-k3sin", "sndclm.html#make-krksin", "sndclm.html#make-locsig", "sndscm.html#makelowpass", + "extsnd.html#makemixsampler", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation", "sndclm.html#make-moving-average", + "sndclm.html#make-moving-fft", "sndclm.html#make-moving-max", "sndclm.html#make-moving-norm", "sndclm.html#make-moving-pitch", + "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-n1cos", "sndclm.html#make-nchoosekcos", + "sndclm.html#make-ncos", "sndclm.html#make-nkssb", "sndclm.html#make-noddcos", "sndclm.html#make-noddsin", + "sndclm.html#make-noddssb", "sndclm.html#make-noid", "sndclm.html#make-notch", "sndclm.html#make-nrcos", + "sndclm.html#make-nrsin", "sndclm.html#make-nrssb", "sndclm.html#make-nrxycos", "sndclm.html#make-nrxysin", + "sndclm.html#make-nsin", "sndclm.html#make-nsincos", "sndclm.html#make-nssb", "sndclm.html#make-nxy1cos", + "sndclm.html#make-nxy1sin", "sndclm.html#make-nxycos", "sndclm.html#make-nxysin", "sndclm.html#make-one-pole", + "sndclm.html#make-one-pole-all-pass", "sndclm.html#make-one-zero", "sndclm.html#make-oscil", "sndclm.html#make-oscil-bank", + "sndclm.html#make-phase-vocoder", "sndclm.html#make-pink-noise", "sndscm.html#makepixmap", "extsnd.html#makeplayer", + "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave", "sndclm.html#make-pulse-train", + "sndclm.html#make-pulsed-env", "sndclm.html#make-r2k!cos", "sndclm.html#make-r2k2cos", "sndscm.html#makeramp", + "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-rcos", "sndclm.html#make-readin", + "extsnd.html#makeregion", "extsnd.html#makeregionsampler", "sndclm.html#make-rk!cos", "sndclm.html#make-rk!ssb", + "sndclm.html#make-rkcos", "sndclm.html#make-rkoddssb", "sndclm.html#make-rksin", "sndclm.html#make-rkssb", + "sndclm.html#make-round-interp", "sndclm.html#make-rssb", "sndclm.html#make-rxycos", "sndclm.html#make-rxyk!cos", + "sndclm.html#make-rxyk!sin", "sndclm.html#make-rxysin", "sndclm.html#make-sampletofile", "extsnd.html#makesampler", + "sndclm.html#make-sawtooth-wave", "sndscm.html#makeselection", "sndclm.html#make-sinc-train", "extsnd.html#makesndtosample", + "sndscm.html#makesoundbox", "sndscm.html#makespencerfilter", "sndclm.html#make-square-wave", "sndclm.html#make-src", + "sndclm.html#make-ssb-am", "sndclm.html#make-table-lookup", "sndclm.html#make-table-lookup-with-env", "sndclm.html#make-tanhsin", + "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero", "sndscm.html#makevariabledisplay", + "extsnd.html#makevariablegraph", "sndclm.html#make-wave-train", "sndclm.html#make-wave-train-with-env", "s7.html#makeweakhashtable", "extsnd.html#mapchannel", "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc", "extsnd.html#marktointeger", "extsnd.html#markclickhook", "sndscm.html#markclickinfo", "extsnd.html#markcolor", "extsnd.html#markcontext", "extsnd.html#markdraghook", "sndscm.html#markexplode", "extsnd.html#markhome", "extsnd.html#markhook", @@ -898,32 +901,33 @@ static const char *help_urls[HELP_NAMES_SIZE] = { "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport", "extsnd.html#statusreport", "extsnd.html#stdinprompt", "sndscm.html#stereotomono", "sndscm.html#stereoflute", "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft", - "s7.html#stringtobytevector", "s7.html#stringposition", "s7.html#sublet", "sndscm.html#superimposeffts", + "s7.html#stringtobytevector", "s7.html#stringposition", "s7.html#sublet", "s7.html#subvector", + "s7.html#subvectorposition", "s7.html#subvectorvector", "s7.html#subvectorp", "sndscm.html#superimposeffts", "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue", "s7.html#symboltovalue", - "s7.html#symbolsetter", "s7.html#symboltable", "extsnd.html#sync", "sndscm.html#sync-everything", - "extsnd.html#syncmax", "extsnd.html#syncstyle", "extsnd.html#syncdmarks", "sndscm.html#syncdmixes", - "sndscm.html#syncup", "sndclm.html#table-lookup", "sndclm.html#table-lookup?", "sndclm.html#tanhsin", - "sndclm.html#tanhsin?", "sndclm.html#tap", "sndclm.html#tap?", "sndscm.html#telephone", - "extsnd.html#tempdir", "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", - "extsnd.html#timegraphp", "sndclm.html#timestosamples", "extsnd.html#tinyfont", "sndscm.html#telephone", - "s7.html#trace", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtofv", "extsnd.html#transformtointeger", - "extsnd.html#transformdialog", "extsnd.html#transformframples", "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype", - "extsnd.html#transformgraphp", "extsnd.html#normalizefft", "extsnd.html#transformsample", "extsnd.html#transformsize", - "extsnd.html#transformtype", "extsnd.html#transformp", "sndscm.html#transposemixes", "s7.html#treecount", - "s7.html#treecyclic", "s7.html#treeleaves", "s7.html#treememq", "s7.html#treesetmemq", - "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndscm.html#tubebell", - "sndclm.html#two-pole", "sndclm.html#two-pole?", "sndscm.html#twotab", "sndclm.html#two-zero", - "sndclm.html#two-zero?", "s7.html#typeof", "extsnd.html#unbindkey", "s7.html#unboundvariablehook", - "sndscm.html#unclipchannel", "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet", - "extsnd.html#unselectall", "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph", - "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself", - "sndscm.html#sndmotifdoc", "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet", - "sndscm.html#vibratinguniformcircularstring", "extsnd.html#viewfilesamp", "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog", - "extsnd.html#viewfilesfiles", "extsnd.html#viewfilesselecthook", "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort", - "extsnd.html#viewfilesspeed", "extsnd.html#viewfilesspeedstyle", "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog", - "extsnd.html#viewsound", "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter", - "sndscm.html#fmvox", "sndclm.html#wave-train", "sndclm.html#wave-train?", "extsnd.html#wavelettype", - "sndscm.html#pqwvox", "extsnd.html#wavohop", "extsnd.html#wavotrace", "sndclm.html#weighted-moving-average", + "s7.html#symboltable", "extsnd.html#sync", "sndscm.html#sync-everything", "extsnd.html#syncmax", + "extsnd.html#syncstyle", "extsnd.html#syncdmarks", "sndscm.html#syncdmixes", "sndscm.html#syncup", + "sndclm.html#table-lookup", "sndclm.html#table-lookup?", "sndclm.html#tanhsin", "sndclm.html#tanhsin?", + "sndclm.html#tap", "sndclm.html#tap?", "sndscm.html#telephone", "extsnd.html#tempdir", + "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp", + "sndclm.html#timestosamples", "extsnd.html#tinyfont", "sndscm.html#telephone", "s7.html#trace", + "extsnd.html#trackingcursorstyle", "extsnd.html#transformtofv", "extsnd.html#transformtointeger", "extsnd.html#transformdialog", + "extsnd.html#transformframples", "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp", + "extsnd.html#normalizefft", "extsnd.html#transformsample", "extsnd.html#transformsize", "extsnd.html#transformtype", + "extsnd.html#transformp", "sndscm.html#transposemixes", "s7.html#treecount", "s7.html#treecyclic", + "s7.html#treeleaves", "s7.html#treememq", "s7.html#treesetmemq", "sndclm.html#triangle-wave", + "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndscm.html#tubebell", "sndclm.html#two-pole", + "sndclm.html#two-pole?", "sndscm.html#twotab", "sndclm.html#two-zero", "sndclm.html#two-zero?", + "s7.html#typeof", "extsnd.html#unbindkey", "s7.html#unboundvariablehook", "sndscm.html#unclipchannel", + "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet", "extsnd.html#unselectall", + "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph", "extsnd.html#updatesound", + "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself", "sndscm.html#sndmotifdoc", + "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet", "sndscm.html#vibratinguniformcircularstring", + "extsnd.html#viewfilesamp", "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog", "extsnd.html#viewfilesfiles", + "extsnd.html#viewfilesselecthook", "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort", "extsnd.html#viewfilesspeed", + "extsnd.html#viewfilesspeedstyle", "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog", "extsnd.html#viewsound", + "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter", "sndscm.html#fmvox", + "sndclm.html#wave-train", "sndclm.html#wave-train?", "extsnd.html#wavelettype", "sndscm.html#pqwvox", + "extsnd.html#wavohop", "extsnd.html#wavotrace", "s7.html#weakhashtablep", "sndclm.html#weighted-moving-average", "extsnd.html#widgetposition", "extsnd.html#widgetsize", "extsnd.html#widgettext", "extsnd.html#windowheight", "sndscm.html#windowsamples", "extsnd.html#windowwidth", "extsnd.html#windowx", "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", "s7.html#withbaffle", "extsnd.html#withfilemonitor", "extsnd.html#withgl", @@ -1751,7 +1755,7 @@ static const char *Reverb_urls[] = { #if HAVE_SCHEME -static const char *snd_names[11718] = { +static const char *snd_names[11728] = { "*clm-array-print-length*", "ws.scm", "*clm-channels*", "ws.scm", "*clm-clipped*", "ws.scm", @@ -4268,7 +4272,6 @@ static const char *snd_names[11718] = { "gain", "clm-ins.scm", "gain-avg", "clm-ins.scm", "gambels-quail", "animals.scm", - "gather-symbols", "stuff.scm", "gaussian-distribution", "dsp.scm", "gaussian-envelope", "dsp.scm", "gdbm_close", "libgdbm.scm", @@ -7109,6 +7112,13 @@ static const char *snd_names[11718] = { "secs->samples", "spokenword.scm", "selection-members", "selection.scm", "selection-rms", "examp.scm", + "sem_close", "libc.scm", + "sem_destroy", "libc.scm", + "sem_init", "libc.scm", + "sem_open", "libc.scm", + "sem_post", "libc.scm", + "sem_unlink", "libc.scm", + "sem_wait", "libc.scm", "semitones-envelope", "grani.scm", "send", "libc.scm", "sendmsg", "libc.scm", @@ -7496,7 +7506,6 @@ static const char *snd_names[11718] = { "undo-channel", "extensions.scm", "ungetc", "libc.scm", "union", "stuff.scm", - "unique-reactive-let-name", "stuff.scm", "unlink", "libc.scm", "unsetenv", "libc.scm", "update-graphs", "examp.scm", @@ -7615,7 +7624,7 @@ static const char *snd_names[11718] = { static void autoload_info(s7_scheme *sc) { - s7_autoload_set_names(sc, snd_names, 5859); + s7_autoload_set_names(sc, snd_names, 5864); } #endif @@ -55,11 +55,11 @@ #include "snd-strings.h" -#define SND_DATE "1-July-18" +#define SND_DATE "1-Aug-18" #ifndef SND_VERSION -#define SND_VERSION "18.5" +#define SND_VERSION "18.6" #endif #define SND_MAJOR_VERSION "18" -#define SND_MINOR_VERSION "5" +#define SND_MINOR_VERSION "6" #endif @@ -29,7 +29,7 @@ (define vct-fill! fill!) (define vct float-vector) (define vct-length length) -(define vct-reverse! reverse!) ; slight difference: no optional length arg (use make-shared-vector) +(define vct-reverse! reverse!) ; slight difference: no optional length arg (use subvector) (define vct->list vector->list) (define (list->vct x) (apply float-vector x)) (define make-vct make-float-vector) diff --git a/sndlib2xen.c b/sndlib2xen.c index 07128d3..26d5980 100644 --- a/sndlib2xen.c +++ b/sndlib2xen.c @@ -1259,16 +1259,16 @@ void mus_sndlib_xen_initialize(void) #if HAVE_SCHEME mus_max_table_size_symbol = s7_define_variable(s7, "*" S_mus_max_table_size "*", s7_make_integer(s7, MUS_MAX_TABLE_SIZE_DEFAULT)); - s7_symbol_set_documentation(s7, mus_max_table_size_symbol, "*mus-max-table-size*: maximum table size."); - s7_symbol_set_setter(s7, mus_max_table_size_symbol, s7_make_function(s7, "[acc-mus-max-table-size]" "]", acc_mus_max_table_size, 2, 0, false, "accessor")); + s7_set_documentation(s7, mus_max_table_size_symbol, "*mus-max-table-size*: maximum table size."); + s7_set_setter(s7, mus_max_table_size_symbol, s7_make_function(s7, "[acc-mus-max-table-size]" "]", acc_mus_max_table_size, 2, 0, false, "accessor")); mus_max_malloc_symbol = s7_define_variable(s7, "*" S_mus_max_malloc "*", s7_make_integer(s7, MUS_MAX_MALLOC_DEFAULT)); - s7_symbol_set_documentation(s7, mus_max_malloc_symbol, "*mus-max-malloc*: maximum number of bytes we will try to malloc."); - s7_symbol_set_setter(s7, mus_max_malloc_symbol, s7_make_function(s7, "[acc-mus-max-malloc]" "]", acc_mus_max_malloc, 2, 0, false, "accessor")); + s7_set_documentation(s7, mus_max_malloc_symbol, "*mus-max-malloc*: maximum number of bytes we will try to malloc."); + s7_set_setter(s7, mus_max_malloc_symbol, s7_make_function(s7, "[acc-mus-max-malloc]" "]", acc_mus_max_malloc, 2, 0, false, "accessor")); mus_sound_path_symbol = s7_define_variable(s7, "*" S_mus_sound_path "*", s7_nil(s7)); - s7_symbol_set_documentation(s7, mus_sound_path_symbol, "*" S_mus_sound_path "* is a list of directories to search for sound files"); - s7_symbol_set_setter(s7, mus_sound_path_symbol, s7_make_function(s7, "[acc-mus-sound-path]" "]", acc_mus_sound_path, 2, 0, false, "accessor")); + s7_set_documentation(s7, mus_sound_path_symbol, "*" S_mus_sound_path "* is a list of directories to search for sound files"); + s7_set_setter(s7, mus_sound_path_symbol, s7_make_function(s7, "[acc-mus-sound-path]" "]", acc_mus_sound_path, 2, 0, false, "accessor")); #endif #if __APPLE__ @@ -108,7 +108,7 @@ vals) ,@(map (lambda (val) (if (pair? (cddr val)) - `(set! (symbol-setter ',(car val)) + `(set! (setter ',(car val)) (lambda (s v) (if (not (,(caddr val) v)) (error 'wrong-type-arg "(set! ~S ~S) but ~S is not ~A" s v v ',(caddr val))) @@ -367,14 +367,14 @@ ,@(map (lambda (binding) (list (car binding) (cadr binding))) vars)) - ,@(do ((setter setters (cdr setter)) + ,@(do ((s setters (cdr s)) (var vars (cdr var)) (i 0 (+ i 1)) (result ())) - ((null? setter) + ((null? s) (reverse result)) - (if (car setter) - (set! result (cons `(set! (symbol-setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result)))) + (if (car s) + (set! result (cons `(set! (setter (quote ,(caar var))) (list-ref ,gsetters ,i)) result)))) ,@body))) (define-macro (while test . body) ; while loop with predefined break and continue @@ -1202,7 +1202,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (if (not (let? p)) (apply format p args) (write (apply format #f args) p)))))) - (make-shared-vector v (list i)))) ; ignore extra trailing elements + (subvector v (list i)))) ; ignore extra trailing elements @@ -1232,7 +1232,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (define-macro (reflective-let vars . body) `(let ,vars ,@(map (lambda (vr) - `(set! (symbol-setter ',(car vr)) + `(set! (setter ',(car vr)) (lambda (s v) (format *stderr* "~S -> ~S~%" s v) v))) @@ -1267,336 +1267,8 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") ;;; ---------------- - -(define (gather-symbols expr ce lst ignore) - (cond ((symbol? expr) - (if (or (memq expr lst) - (memq expr ignore) - (procedure? (symbol->value expr ce)) - (eq? (let symbol->let ((sym expr) - (ce ce)) - (if (defined? sym ce #t) - ce - (and (not (eq? ce (rootlet))) - (symbol->let sym (outlet ce))))) - (rootlet))) - lst - (cons expr lst))) - - ((not (pair? expr)) lst) - - ((not (and (pair? (cdr expr)) (pair? (cddr expr)))) - (if (eq? (car expr) '_) - (cons expr lst) - (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))) - - ((pair? (cadr expr)) - (gather-symbols (case (car expr) - ((let let* letrec letrec* do) - (values (cddr expr) ce lst (append ignore (map car (cadr expr))))) - ((lambda) - (values (cddr expr) ce lst (append ignore (cadr expr)))) - ((lambda*) - (values (cddr expr) ce lst (append ignore (map (lambda (a) (if (pair? a) (car a) a)) (cadr expr))))) - (else - (values (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))))) - - ((and (eq? (car expr) 'lambda) - (symbol? (cadr expr))) - (gather-symbols (cddr expr) ce lst (append ignore (list (cadr expr))))) - - (else - (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)))) - - -(define-bacro (reactive-set! place value) - (with-let (inlet 'place place ; with-let here gives us control over the names - 'value value - 'e (outlet (curlet))) ; the run-time (calling) environment - (let ((nv (gensym)) - (ne (gensym))) - `(begin - (define ,ne ,e) - ,@(map (lambda (sym) - (if (symbol? sym) - `(set! (symbol-setter ',sym) - (lambda (s v) - (let ((,nv ,(if (not (with-let (sublet e 'sym sym) - (symbol-setter sym))) - 'v - `(begin (,(procedure-source (with-let (sublet e 'sym sym) - (symbol-setter sym))) - s v))))) - (with-let (sublet ,ne ',sym ,nv) - (set! ,place ,value)) - ,nv))) - (if (not (and (eq? (car sym) '_) - (pair? (cdr sym)) - (integer? (cadr sym)) - (null? (cddr sym)))) - (error 'wrong-type-arg "reactive-vector can't handle: ~S~%" sym) - (let ((index (cadr sym))) - `(set! (_ 'local-set!) - (apply lambda '(obj i val) - (append (cddr (procedure-source (_ 'local-set!))) - `((if (= i ,,index) (set! ,',place ,',value)))))))))) - (gather-symbols value e () ())) - (set! ,place ,value))))) - -#| -(let ((a 1) - (b 2) - (c 3)) - (reactive-set! b (+ c 4)) ; order matters! - (reactive-set! a (+ b c)) - (set! c 5) - a) - -(let ((a 1) (v (vector 1 2 3))) (reactive-set! (v 1) (* a 3)) (set! a 4) v) -|# - -;; just a first stab at this: - -(define reactive-vector - (let () - (require mockery.scm) - (define make-mock-vector (*mock-vector* 'make-mock-vector)) - - (define (reactive-vector-1 e . args) - ;; set up accessors for any element that has an expression as its initial value - ;; if any element depends on some other element, return a mock-vector with setter fixed up - - (let ((code `(let ((_ (,(if (any? (lambda (a) - (tree-member '_ a)) - args) - '((funclet reactive-vector) 'make-mock-vector) - 'make-vector) - ,(length args))))))) - (let ((ctr 0)) - (for-each - (lambda (arg) - (set! code (append code `((reactive-set! (_ ,ctr) ,arg)))) - (set! ctr (+ ctr 1))) - args)) - (append code `(_)))) - - (define-bacro (reactive-vector . args) - (apply ((funclet reactive-vector) 'reactive-vector-1) (outlet (curlet)) args)))) - - -#| -(let ((a 1)) (let ((v (reactive-vector a (+ a 1) 2))) (set! a 4) v)) -> #(4 5 2) -(let* ((a 1) (v (reactive-vector a (+ a 1) 2))) (set! a 4) v) -> #(4 5 2) -(let* ((a 1) (v (reactive-vector a (+ a 1) (* 2 (_ 0))))) (set! a 4) v) -> #(4 5 8) -;;; mock-vector could also be used for constant or reflective vectors, etc -- just like symbol-setter but element-wise -|# - -;; another experiment: - -(define-bacro (reactive-format port ctrl . args) - (with-let (inlet 'e (outlet (curlet)) - 'args args - 'port port - 'ctrl ctrl) - (let* ((syms (gather-symbols args e () ())) - (sa's (map symbol-setter syms))) - `(begin - ,@(map (lambda (sym sa) - `(set! (symbol-setter ',sym) - (lambda (s v) - (let ((result (if ,sa (apply ,sa s v ()) v))) - (with-let (sublet ,e ',sym result) - (format ,port ,ctrl ,@args)) ; is this equivalent to an exported closure in the GC? - result)))) - syms sa's) - (format ,port ,ctrl ,@args))))) - - -;;; this is not pretty -;;; part of the complexity comes from the hope to be tail-callable, but even a version -;;; using dynamic-wind is complicated because of shadowing -;;; what I think we want here is a globally accessible way to see set! that does not -;;; require non-local state (not a hook with its list of functions, or symbol-setter) -;;; and that doesn't bring s7 to a halt. Perhaps a symbol-setter function that -;;; traverses the let-chain (like *features*) looking for something?? But the relevant -;;; chain is on the stack (is it?), so it won't be quick. And weak refs are asking for trouble. -;;; (let ((a 1)) (define (set-a x) (set! a x)) (let ((b 2)) (reactive-set! b (+ a 1)) (set-a 3) b)) -;;; Perhaps a way to share the original's slot? No slow down, transparent, local setter can -;;; run its own accessor, set -> shared slot so all sharers see the new value, -;;; but how to trigger all accessors? -;;; (set! (symbol-slot 'a e1) (symbol-slot 'a e2)) -;;; this isn't currently doable -- object.slt.val is a pointer, not a pointer to a pointer -;;; there is the symbol's extra slot, but it is global. I wonder how much slower s7 would be -;;; with a pointer to a pointer here -- are there any other places this would be useful? -;;; even with this, the entire accessor chain is not triggered. -;;; so, use with-accessors and reactive-set! for complex cases - -(define unique-reactive-let-name ; the alternative is (apply define-bacro ...) with a top-level gensym - (let ((name #f)) - (lambda () - (if (gensym? name) - name - (set! name (gensym "v")))))) - -(define-bacro (reactive-let vars . body) - (with-let (inlet 'vars vars 'body body 'e (outlet (curlet))) - (let ((bindings ()) - (accessors ()) - (setters ()) - (gs (gensym)) - (v (unique-reactive-let-name))) - - (define (rlet-symbol sym) - (symbol "{" (symbol->string sym) "}-rlet")) - - (for-each - (lambda (bd) - (let ((syms (gather-symbols (cadr bd) e () ()))) - (for-each - (lambda (sym) - (let ((fname (gensym (symbol->string sym)))) - (set! bindings (cons `(,fname (lambda (,sym) ,(copy (cadr bd)))) bindings)) - (if (not (memq sym setters)) - (set! setters (cons sym setters))) - (let ((prev (assq sym accessors))) - (if prev - (set-cdr! prev (cons (list 'set! (car bd) (list fname v)) (cdr prev))) - (set! accessors (cons (list sym (list 'set! (car bd) (list fname v))) accessors)))))) - ;; (append `((set! ,(car bd) (,fname ,v))) (cdr prev))) - ;; (set! accessors (cons (cons sym `((set! ,(car bd) (,fname ,v)))) accessors)))))) - syms) - (set! bindings (cons bd bindings)))) - vars) - - (let ((bsyms (gather-symbols body e () ())) - (nsyms ())) - (for-each (lambda (s) - (if (and (with-let (sublet e (quote gs) s) - (symbol-setter gs)) - (not (assq s bindings))) - (if (not (memq s setters)) - (begin - (set! setters (cons s setters)) - (set! nsyms (cons (cons s (cdr (procedure-source (with-let (sublet e (quote gs) s) - (symbol-setter gs))))) - nsyms))) - (let ((prev (assq s accessors))) - (if prev ; merge the two functions - (set-cdr! prev (append (cdddr (procedure-source (with-let (sublet e (quote gs) s) - (symbol-setter gs)))) - (cdr prev)))))))) - bsyms) - - `(let ,(map (lambda (sym) - (values - `(,(rlet-symbol sym) (lambda (,v) (set! ,sym ,v))) - `(,sym ,sym))) - setters) - (let ,(reverse bindings) - ,@(map (lambda (sa) - (if (assq (car sa) bindings) - (values) - `(set! (symbol-setter ',(car sa)) - (lambda (,(gensym) ,v) - (,(rlet-symbol (car sa)) ,v) - ,@(cdr sa) - ,v)))) - accessors) - ,@(map (lambda (ns) - `(set! (symbol-setter ',(car ns)) - (apply lambda ',(cdr ns)))) - nsyms) - ,@body)))))) - - -(define-macro (reactive-let* vars . body) - (let add-let ((v vars)) - (if (pair? v) - `(reactive-let ((,(caar v) ,(cadar v))) - ,(add-let (cdr v))) - (cons 'begin body)))) - -;; reactive-letrec is not useful: lambdas already react and anything else is an error (use of #<undefined>) - -(define-macro (reactive-lambda* args . body) - `(let ((f (lambda* ,args ,@body)) - (e (curlet))) - (unless (eq? e (rootlet)) - - (define (one-access s1 v) - (let* ((syms (map car e)) - (sa's (map (lambda (s) (symbol-setter s e)) syms))) - (dynamic-wind - (lambda () (for-each (lambda (s) (if (not (eq? s s1)) (set! (symbol-setter s e) #f))) syms)) - (lambda () (f s1 v)) - (lambda () (for-each (lambda (s a) (set! (symbol-setter s e) a)) syms sa's))))) - - (for-each (lambda (s) (set! (symbol-setter s e) one-access)) (map car e))) - f)) - - -(define-macro (with-accessors vars . body) - `(let ((accessors ())) - (dynamic-wind - (lambda () - (set! accessors (map symbol-setter ',vars))) - (lambda () - ,@body) - (lambda () - (for-each - (lambda (var accessor) - (set! (symbol-setter var) accessor)) - ',vars accessors))))) - -;; (let ((a 1) (b 2)) (with-accessors (a b) (let ((c 3)) (reactive-set! c (+ (* 2 a) (* 3 b))) (set! a 4) c))) - -#| -(let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) -- so "lifting" comes for free? - -(map (lambda (s) (symbol-setter (car s) e)) e) - -(let ((a 1)) - (reactive-let ((b (+ a 1)) - (c (* a 2))) - (set! a 3) - (+ c b))) - -(let ((a 1) - (d 2)) - (reactive-let ((b (+ a d)) - (c (* a d)) - (d 0)) - (set! a 3) - (+ b c))) - -(let ((a 1)) - (reactive-let* ((b (+ a 1)) - (c (* b 2))) - (set! a 3) - (+ c b))) - -(let ((a 1)) - (reactive-let* ((b (+ a 1))) - (set! a 3) - b)) - -(define rl (let ((a 1) - (b 2) - (c 3)) - (reactive-lambda* (s v) - (format *stderr* "~S changed: ~S~%" s v)))) - -;; constant env: -;; (define e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet))) -|# - -;;; what about (reactive-vector (v 0)) -- can we watch some other vector's contents? -;;; if v were a mock-vector, we could use the same vector-set! stuff as now but with any name (how to distinguish?) -;;; we can distinguish because this is happening at run-time where (v 0) has an ascertainable meaning -;;; how would reactive-hash-table work? (hash 'a (+ b 1)) and update 'a's value whenever b changes? -;;; reactive-string? (reactive-string #\a c (integer->char a) (str 0) (_ 0)) -;;; reactive-eval reactive-if(expr changes)--reactive-assert for example - +;;; 28-Jul-18 I've started to rewrite the reactive* code: reactive.scm. +;;; ---------------- #| ;; this tests a bacro for independence of any runtime names @@ -1664,8 +1336,6 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (subset args () 0))))))) |# - - ;;; ---------------- (define-macro (catch* clauses . error) @@ -1682,7 +1352,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (error 'out-of-range "end: ~A should be greater than start: ~A" end start)) (cond ((vector? obj) - (make-shared-vector obj (list new-len) start)) + (subvector obj (list new-len) start)) ((string? obj) (if (integer? end) @@ -1774,10 +1444,10 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (vlp (gensym))) ;; local symbol access -- this does not affect any other uses of these symbols - (set! (symbol-setter '*display-spacing* (curlet)) + (set! (setter '*display-spacing* (curlet)) (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-spacing*))) - (set! (symbol-setter '*display-print-length* (curlet)) + (set! (setter '*display-print-length* (curlet)) (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-print-length*))) ;; export *display* -- just a convenience @@ -2226,7 +1896,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") cdadar cddaar cdaddr cddddr cddadr cdddar assoc member list list-ref list-set! list-tail make-list length copy fill! reverse reverse! sort! append assq assv memq memv vector-append list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimensions - make-vector make-shared-vector vector float-vector make-float-vector float-vector-set! + make-vector subvector vector float-vector make-float-vector float-vector-set! float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector byte-vector make-byte-vector hash-table hash-table* make-hash-table hash-table-ref hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation @@ -2244,7 +1914,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") ht)) (baddies (list #_eval #_eval-string #_load #_autoload #_define-constant #_define-expansion #_require #_string->symbol #_symbol->value #_symbol->dynamic-value #_symbol-table #_symbol #_keyword->symbol - #_defined? #_symbol-setter + #_defined? #_call/cc #_gc #_read #_immutable! #_open-output-file #_call-with-output-file #_with-output-to-file #_open-input-file #_call-with-input-file #_with-input-from-file @@ -2265,7 +1935,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.") (cond ((symbol? tree) (let ((val (symbol->value tree))) ;; don't accept any symbol with an accessor - (if (or (symbol-setter tree) + (if (or (setter tree) (memq tree '(*s7* unquote abort)) (let? val)) ; not sure about this (quit #f)) diff --git a/tools/auto-tester.scm b/tools/auto-tester.scm index 281f714..fca1646 100644 --- a/tools/auto-tester.scm +++ b/tools/auto-tester.scm @@ -92,7 +92,7 @@ (define-constant _1234_ 1234) (define _dilambda_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) (define __var2__ 3) -(set! (symbol-setter '__var2__) (lambda (s v) (if (integer? v) v 3))) +(set! (setter '__var2__) (lambda (s v) (if (integer? v) v 3))) (define (free1) (set! x (- (+ x 1) 1))) (define (free2) (x i)) @@ -366,7 +366,7 @@ 'provide 'call-with-output-string 'checked-hash-table 'checked-hash-table* 'with-output-to-string - 'symbol-setter + ;'symbol-setter 's7-version 'dilambda? 'hook-functions @@ -452,7 +452,7 @@ 'arity 'logbit? 'random-state? 'throw 'float-vector-set! 'make-iterator 'complex 'let-ref 'int-vector 'aritable? 'gensym? 'syntax? 'iterator-at-end? 'let? - 'make-shared-vector 'float-vector 'iterator-sequence 'getenv 'float-vector-ref + 'subvector 'float-vector 'iterator-sequence 'getenv 'float-vector-ref 'cyclic-sequences 'let->list 'setter 'int-vector? @@ -609,7 +609,7 @@ "(mock-hash-table* 'b 2)" ;;" #| a comment |# " - "(make-shared-vector (vector 0 1 2 3 4) 3)" "(substring \"0123\" 2)" + "(subvector (vector 0 1 2 3 4) 3)" "(substring \"0123\" 2)" "(vector-dimensions (block))" "(append (block) (block))" "(let-temporarily ((x 1234)) (+ x 1))" diff --git a/tools/compsnd b/tools/compsnd index ed93653..05ddcba 100755 --- a/tools/compsnd +++ b/tools/compsnd @@ -40,33 +40,33 @@ echo ' ------------------------------------------------------------------------- echo ' ---- basic configure test ----- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-motif CFLAGS="-O3 -Wall -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet --with-motif CFLAGS="-O3 -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make echo ' ' echo ' ' ./snd --version ./snd -noinit --features "'clm 'snd-s7 'snd-motif 'sndlib" -./snd -e '(begin (load "cload.scm") (set! *cload-cflags* "-Wall -Wno-parentheses"))' libm.scm libc.scm libgdbm.scm libdl.scm libgsl.scm -e '(exit)' +./snd -e '(begin (load "cload.scm") (set! *cload-cflags* "-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses"))' libm.scm libc.scm libgdbm.scm libdl.scm libgsl.scm -e '(exit)' echo ' -------------------------------------------------------------------------------- ' echo ' ---- ffitest ----- ' echo ' -------------------------------------------------------------------------------- ' cp tools/ffitest.c . -gcc -o ffitest ffitest.c -g3 -Wall -Wno-parentheses s7.o -lm -I. -ldl +gcc -o ffitest ffitest.c -g3 -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses s7.o -lm -I. -ldl ffitest -gcc s7.c -o repl -Wall -Wno-parentheses -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g3 -Wl,-export-dynamic -ldl -lm +gcc s7.c -o repl -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g3 -Wl,-export-dynamic -ldl -lm echo '#define WITH_SYSTEM_EXTRAS 0' >mus-config.h -gcc -c s7.c -o s7.o -Wall -Wno-parentheses +gcc -c s7.c -o s7.o -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses rm s7.o echo '#define WITH_C_LOADER 0' >mus-config.h -gcc -c s7.c -o s7.o -Wall -Wno-parentheses +gcc -c s7.c -o s7.o -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses rm s7.o echo '#define WITH_EXTRA_EXPONENT_MARKERS 1' >mus-config.h -gcc -c s7.c -o s7.o -Wall -Wno-parentheses +gcc -c s7.c -o s7.o -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses rm s7.o make clmclean @@ -74,7 +74,7 @@ make sndinfo make sndplay make allclean -./configure --quiet --with-motif CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -Wdeclaration-after-statement" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet --with-motif CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -Wdeclaration-after-statement" LDFLAGS="-L/usr/X11R6/lib" make allclean make echo ' ' @@ -90,7 +90,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=g++ CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make ./snd --version ./snd -noinit --features "'clm" @@ -104,7 +104,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- clang ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=clang CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make ./snd --version ./snd -noinit --features "'clm" @@ -113,7 +113,7 @@ make allclean rm -f snd rm -f config.cache -./configure --quiet CC=clang CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make make allclean rm -f snd @@ -125,7 +125,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-gui ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --without-gui +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --without-gui make echo ' ' echo ' ' @@ -141,7 +141,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-gui --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DWITH_MAIN" --without-gui +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DWITH_MAIN" --without-gui make echo ' ' echo ' ' @@ -157,7 +157,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-audio ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --without-audio +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --without-audio make echo ' ' echo ' ' @@ -173,7 +173,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-audio C++ ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --without-audio CC=g++ +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --without-audio CC=g++ make echo ' ' echo ' ' @@ -189,7 +189,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-gui --with-oss ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --without-gui --with-oss +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --without-gui --with-oss make echo ' ' echo ' ' @@ -203,7 +203,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ----- --without-gui --with-gmp ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --without-gui --with-gmp --with-ladspa CFLAGS="-Wall -Wno-parentheses -I/usr/local/include" +./configure --quiet --without-gui --with-gmp --with-ladspa CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include" make echo ' ' echo ' ' @@ -219,7 +219,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- -without-gui --with-ladspa ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -I/usr/local/include" --without-gui --with-ladspa +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -I/usr/local/include" --without-gui --with-ladspa make echo ' ' echo ' ' @@ -235,7 +235,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-gtk ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-O3 -Wall -Wno-parentheses -I/usr/X11R6/include" --with-gtk +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-O3 -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-gtk make echo ' ' echo ' ' @@ -252,7 +252,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --with-gtk --disable-deprecated ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-gtk --disable-deprecated +./configure --quiet CC=g++ CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-gtk --disable-deprecated make allclean make ./snd --version @@ -264,7 +264,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- g++ --with-gtk --std=c++11 --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ --with-gtk CFLAGS="-std=c++11 -Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet CC=g++ --with-gtk CFLAGS="-std=c++11 -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'snd-gtk" @@ -275,7 +275,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- g++ --with-gtk --with-gsl --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ --with-gtk --with-gsl CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet CC=g++ --with-gtk --with-gsl CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'snd-gtk 'gsl" @@ -286,7 +286,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-forth ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --quiet --with-motif --with-forth +./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --quiet --with-motif --with-forth make ./snd --version ./snd -noinit --features "'clm 'snd-forth 'snd-motif" @@ -301,7 +301,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-forth --with-motif --with-gl ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-forth --with-motif --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet --with-forth --with-motif --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'snd-forth 'xm 'gl" @@ -312,7 +312,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-forth --with-gtk --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-forth --with-gtk LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet --with-forth --with-gtk LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'snd-gtk 'xg 'gl" @@ -323,7 +323,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-forth --without-gui --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-forth --without-gui LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet --with-forth --without-gui LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'snd-forth 'snd-nogui" @@ -380,7 +380,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-gtk ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-gtk +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-gtk make echo ' ' echo ' ' @@ -393,7 +393,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ----- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-gtk ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --disable-deprecated CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-gtk +./configure --quiet --disable-deprecated CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-gtk make echo ' ' echo ' ' @@ -408,7 +408,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-gsl ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-motif --with-gsl +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-motif --with-gsl make echo ' ' echo ' ' @@ -419,7 +419,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-gmp ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-gmp +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-gmp make echo ' ' echo ' ' @@ -430,7 +430,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- WITH_PURE_S7 --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DWITH_PURE_S7=1" +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DWITH_PURE_S7=1" make echo ' ' echo ' ' @@ -441,7 +441,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ----- editres ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-motif --with-editres --disable-deprecated +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-motif --with-editres --disable-deprecated make make allclean @@ -450,7 +450,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- g++ ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --with-motif LDFLAGS="-L/usr/X11R6/lib" --quiet CC=g++ CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --with-motif LDFLAGS="-L/usr/X11R6/lib" --quiet CC=g++ CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make make allclean @@ -460,7 +460,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-gtk --with-gmp ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-gtk --with-gmp CFLAGS="-Wall -Wno-parentheses" +./configure --quiet --with-gtk --with-gmp CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" make echo ' ' echo ' ' @@ -476,7 +476,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-ruby ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-ruby --with-motif +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-ruby --with-motif make echo ' ' echo ' ' @@ -491,7 +491,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --with-ruby ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-ruby +./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-ruby make ./snd --version ./snd -noinit --features ":clm, :snd_ruby" @@ -500,7 +500,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-ruby --with-gl --with-alsa ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --with-motif --with-gl --with-alsa +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --with-motif --with-gl --with-alsa make echo ' ' echo ' ' @@ -514,7 +514,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-ruby --with-gtk ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-ruby --with-gtk +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-ruby --with-gtk make echo ' ' echo ' ' @@ -536,7 +536,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-ruby --with-gtk --without-gsl ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --with-gtk --without-gsl +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --with-gtk --without-gsl make echo ' ' echo ' ' @@ -547,7 +547,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-ruby --with-gtk ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --disable-deprecated LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-ruby --with-gtk +./configure --quiet --disable-deprecated LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-ruby --with-gtk make echo ' ' echo ' ' @@ -561,7 +561,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- --with-ruby --without-gui --without-fftw --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-ruby --without-gui --without-fftw +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-ruby --without-gui --without-fftw make echo ' ' echo ' ' @@ -572,7 +572,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-ruby --without-gui ----- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --without-gui +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --without-gui make echo ' ' echo ' ' @@ -583,7 +583,7 @@ make allclean echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --with-ruby --without-gui ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --without-gui +./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -DS7_DEBUGGING" --with-ruby --without-gui make echo ' ' echo ' ' @@ -597,7 +597,7 @@ rm -f config.cache echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-motif --with-ladspa CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include -I/usr/local/include" +./configure --quiet --with-motif --with-ladspa CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include -I/usr/local/include" make ./snd --version ./snd -noinit --features "'clm 'snd-s7 'snd-motif 'snd-ladspa 'sndlib" @@ -611,7 +611,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --with-gtk ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CC=g++ --with-gtk CFLAGS="-Wall -Wno-parentheses" +./configure --quiet CC=g++ --with-gtk CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" make ./snd --version ./snd -noinit --features "'clm 'snd-gtk" @@ -622,7 +622,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- g++ --without-gui ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --quiet CC=g++ --without-gui +./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --quiet CC=g++ --without-gui make ./snd --version ./snd -noinit --features "'clm 'snd-nogui 'snd-s7" @@ -641,7 +641,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- g++ --without-gsl --with-alsa ' echo ' -------------------------------------------------------------------------------- ' -./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --quiet CC=g++ --without-gsl --with-alsa +./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --quiet CC=g++ --without-gsl --with-alsa make ./snd --version ./snd -noinit --features "'clm 'alsa 'xm" @@ -657,7 +657,7 @@ rm -f sndinfo echo ' -------------------------------------------------------------------------------- ' echo ' ----- sndlib ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make sndinfo sndinfo oboe.snd sndinfo test.snd @@ -668,7 +668,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ---- --without-gui ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --without-gui +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --without-gui make echo ' ' echo ' ' @@ -686,7 +686,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- -DXM_DISABLE_DEPRECATED ----- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -DXM_DISABLE_DEPRECATED -Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -DXM_DISABLE_DEPRECATED -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features "'clm 'xm" @@ -697,7 +697,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-ruby -DXM_DISABLE_DEPRECATED ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet --with-ruby LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -DXM_DISABLE_DEPRECATED -Wall -Wno-parentheses -I/usr/X11R6/include" +./configure --quiet --with-ruby LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -DXM_DISABLE_DEPRECATED -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" make ./snd --version ./snd -noinit --features ":clm, :snd_ruby" @@ -728,7 +728,7 @@ echo ' ' echo ' -------------------------------------------------------------------------------- ' echo ' ----- --with-gl --with-gl2ps ------ ' echo ' -------------------------------------------------------------------------------- ' -./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-parentheses -I/usr/X11R6/include" --with-motif --with-gl --quiet --with-gl2ps --without-gsl +./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" --with-motif --with-gl --quiet --with-gl2ps --without-gsl make ./snd --version ./snd -noinit --features "'clm 'xm 'gl2ps" @@ -783,7 +783,7 @@ cp ~/sndlib/* . echo ' -------------------------------------------------------------------------------- ' echo ' ----- sndlib tests ---- ' echo ' -------------------------------------------------------------------------------- ' -./configure --quiet CFLAGS="-Wall -Wno-parentheses" +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" make cp tools/exs7.c . diff --git a/tools/crossref.c b/tools/crossref.c index 126372b..e8e73c3 100644 --- a/tools/crossref.c +++ b/tools/crossref.c @@ -339,6 +339,13 @@ int main(int argc, char **argv) add_file("xm.c"); add_file("gl.c"); add_file("xg.c"); + + add_file("libc_s7.c"); + add_file("libgdbm_s7.c"); + add_file("libgsl_s7.c"); + add_file("libgtk_s7.c"); + add_file("libm_s7.c"); + add_file("utf8proc_s7.c"); add_file("xen.h"); diff --git a/tools/ffitest.c b/tools/ffitest.c index 7a42ebf..142a0de 100644 --- a/tools/ffitest.c +++ b/tools/ffitest.c @@ -231,8 +231,11 @@ static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, s7_int *offsets, *dimensions; elements = s7_vector_elements(vector); - dimensions = s7_vector_dimensions(vector); - offsets = s7_vector_offsets(vector); + + dimensions = (s7_int *)malloc(ndims * sizeof(s7_int)); + offsets = (s7_int *)malloc(ndims * sizeof(s7_int)); + s7_vector_dimensions(vector, dimensions, ndims); + s7_vector_offsets(vector, offsets, ndims); for (i = 0; i < indices; i++) { @@ -242,6 +245,8 @@ static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, (ind >= dimensions[i])) { va_end(ap); + free(dimensions); + free(offsets); return(s7_out_of_range_error(sc, "multivector_ref", i, s7_make_integer(sc, ind), @@ -250,6 +255,8 @@ static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, index += (ind * offsets[i]); } va_end(ap); + free(dimensions); + free(offsets); return(elements[index]); } } @@ -815,7 +822,7 @@ int main(int argc, char **argv) if (!s7_is_vector(p)) {fprintf(stderr, "%d: %s is not a vector?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - if (s7_type_of(p) != s7_make_symbol(sc, "vector?")) + if (s7_type_of(sc, p) != s7_make_symbol(sc, "vector?")) fprintf(stderr, "type-of(vector) confused?\n"); if (s7_vector_rank(p) != 1) @@ -1044,36 +1051,9 @@ int main(int argc, char **argv) p = s7_eval(sc, c1234, s7_sublet(sc, s7_rootlet(sc), s7_nil(sc))); if (s7_integer(p) != 9) {fprintf(stderr, "%d: (eval '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - p = s7_eval_form(sc, c1234, s7_sublet(sc, s7_rootlet(sc), s7_nil(sc))); - if (s7_integer(p) != 9) - {fprintf(stderr, "%d: (eval(form) '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - s7_gc_on(sc, true); } -#if 0 - p = s7_make_ulong(sc, 123); - gc_loc = s7_gc_protect(sc, p); - - if (!s7_is_ulong(p)) - {fprintf(stderr, "%d: %s is not a ulong?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - - if (s7_ulong(p) != (unsigned long)123) - {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - s7_gc_unprotect_at(sc, gc_loc); - - - p = s7_make_ulong_long(sc, 123); - gc_loc = s7_gc_protect(sc, p); - - if (!s7_is_ulong_long(p)) - {fprintf(stderr, "%d: %s is not a ulong_long?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - - if (s7_ulong_long(p) != (unsigned long long)123) - {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - s7_gc_unprotect_at(sc, gc_loc); -#endif - s7_for_each_symbol_name(sc, symbol_func, NULL); s7_for_each_symbol(sc, symbol_func_1, NULL); s7_symbol_name(s7_make_symbol(sc, "a_symbol")); @@ -1095,7 +1075,7 @@ int main(int argc, char **argv) p = s7_current_input_port(sc); if (!s7_is_input_port(sc, p)) {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(p)); free(s1);} - s7_port_line_number(p); + s7_port_line_number(sc, p); s7_add_to_history(sc, s7_nil(sc)); s7_history(sc); @@ -1247,7 +1227,7 @@ int main(int argc, char **argv) p1 = s7_apply_function(sc, s7_name_to_value(sc, "mac-plus"), s7_list(sc, 2, s7_make_integer(sc, 3), s7_make_integer(sc, 4))); - p = s7_eval_form(sc, p1, s7_rootlet(sc)); + p = s7_eval(sc, p1, s7_rootlet(sc)); if ((!s7_is_integer(p)) || (s7_integer(p) != 7)) {char *s2; fprintf(stderr, "%d: %s -> %s is not 7?\n", __LINE__, s1 = TO_STR(p1), s2 = TO_STR(p)); free(s1); free(s2);} @@ -1300,9 +1280,15 @@ int main(int argc, char **argv) { s7_int *dims, *offs; s7_pointer *els; - dims = s7_vector_dimensions(p1); - offs = s7_vector_offsets(p1); + s7_int ndims; + + ndims = s7_vector_rank(p1); + dims = (s7_int *)malloc(ndims * sizeof(s7_int)); + offs = (s7_int *)malloc(ndims * sizeof(s7_int)); + s7_vector_dimensions(p1, dims, ndims); + s7_vector_offsets(p1, offs, ndims); els = s7_vector_elements(p1); + if (dims[0] != 2) fprintf(stderr, "%d: dims[0]: %" print_s7_int "?\n", __LINE__, dims[0]); if (dims[1] != 3) fprintf(stderr, "%d: dims[1]: %" print_s7_int "?\n", __LINE__, dims[1]); if (dims[2] != 4) fprintf(stderr, "%d: dims[2]: %" print_s7_int "?\n", __LINE__, dims[2]); @@ -1310,6 +1296,9 @@ int main(int argc, char **argv) if (offs[1] != 4) fprintf(stderr, "%d: offs[1]: %" print_s7_int "?\n", __LINE__, offs[1]); if (s7_integer(p = els[12 + 4 + 1]) != 32) {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);} + + free(dims); + free(offs); } s7_vector_fill(sc, p1, s7_t(sc)); @@ -1825,7 +1814,7 @@ int main(int argc, char **argv) s7_define_function(sc, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!"); s7_define_variable(sc, "notified-var", s7_make_integer(sc, 0)); - s7_symbol_set_setter(sc, s7_make_symbol(sc, "notified-var"), s7_name_to_value(sc, "notify-C")); + s7_set_setter(sc, s7_make_symbol(sc, "notified-var"), s7_name_to_value(sc, "notify-C")); s7_eval_c_string(sc, "(set! notified-var 32)"); p = s7_name_to_value(sc, "notified-var"); if (s7_integer(p) != 32) diff --git a/tools/gdbinit b/tools/gdbinit index b4e81ca..ebfc5b9 100644 --- a/tools/gdbinit +++ b/tools/gdbinit @@ -49,10 +49,15 @@ define s7bt set logging overwrite on set logging redirect on set logging on -bt +if $argc == 1 + bt $arg0 +end +if $argc == 0) + bt +end set logging off # now gdb.txt has the backtrace -print s7_decode_bt() +print s7_decode_bt(cur_sc) end document s7bt print a C backtrace with s7 objects decoded as much as possible @@ -62,9 +67,14 @@ define s7btfull set logging overwrite on set logging redirect on set logging on -bt full +if $argc == 1 + bt full $arg0 +end +if $argc == 0) + bt full +end set logging off -print s7_decode_bt() +print s7_decode_bt(cur_sc) end document s7btfull print a full C backtrace with s7 objects decoded as much as possible diff --git a/tools/t101.scm b/tools/t101.scm index c075994..1091662 100644 --- a/tools/t101.scm +++ b/tools/t101.scm @@ -77,9 +77,15 @@ (format *stderr* "~%~NC local s7test ~NC~%" 20 #\- 20 #\-) (system "./snd -e '(let () (catch #t (lambda () (load \"s7test.scm\" (curlet))) (lambda args #f)) (exit))'") +(format *stderr* "~NC s7test ~NC~%" 20 #\- 20 #\-) +(system "./snd s7test.scm") + (format *stderr* "~NC tpeak ~NC~%" 20 #\- 20 #\-) (system "./snd tpeak.scm") +(format *stderr* "~NC lt ~NC~%" 20 #\- 20 #\-) +(system "./snd lt.scm") + (format *stderr* "~NC tcopy ~NC~%" 20 #\- 20 #\-) (system "./repl tcopy.scm") diff --git a/tools/tauto.scm b/tools/tauto.scm index 242c030..0bf7155 100644 --- a/tools/tauto.scm +++ b/tools/tauto.scm @@ -47,8 +47,8 @@ (with-baffle (call/cc (lambda (cc) cc))) (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3) #<undefined> #<unspecified> (make-int-vector 3) (make-float-vector 3 -1.4) - (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (make-shared-vector (make-int-vector '(2 3) 1) '(6)) - (make-shared-vector (make-shared-vector (make-float-vector '(2 3) 1.0) '(6)) '(2 2)) + (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1) '(6)) + (subvector (subvector (make-float-vector '(2 3) 1.0) '(6)) '(2 2)) (vector-ref #2d((#i(1 2 3)) (#i(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1)) (c-pointer 0) (c-pointer -1) :readable :else (define-bacro* (m (a 1)) `(+ ,a 1)) (byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator #((a . 2))) @@ -176,7 +176,7 @@ all delete-file system set-cdr! stacktrace test-sym cutlet varlet gc cond-expand reader-cond openlet coverlet eval vector list cons hash-table* hash-table values - symbol-table load local-symbol? + symbol-table load global-environment current-environment make-procedure-with-setter procedure-with-setter? make-rectangular copy fill! hash-table-set! vector-set! let-set! list-values apply-values immutable! diff --git a/tools/tbig.scm b/tools/tbig.scm index 2109479..4a9bb25 100644 --- a/tools/tbig.scm +++ b/tools/tbig.scm @@ -2,8 +2,8 @@ (require libc.scm) -(set! (*s7* 'max-vector-length) (ash 1 33)) -(set! (*s7* 'max-string-length) (ash 1 33)) +(set! (*s7* 'max-vector-length) (ash 1 36)) +(set! (*s7* 'max-string-length) (ash 1 36)) (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init))) @@ -198,7 +198,7 @@ ;; -------------------------------------------------------------------------------- (format () "strings...~%") -(when (> total-memory (* 2 big-size)) +(when (> total-memory (* 4 big-size)) (clear-and-gc) (let ((bigstr (make-string big-size #\space))) (define (big-string-filler) @@ -397,16 +397,18 @@ (test (morally-equal? big1 bigfv) #t) (set! (big1 (- big-size 1)) 0.25) (test (morally-equal? big1 bigfv) #f) - (let ((big2 (make-shared-vector big1 (list 20) (- (ash 1 31) 10)))) + (let ((big2 (subvector big1 (list 20) (- (ash 1 31) 10)))) (test big2 (make-float-vector 20 0.5)) (test (length big2) 20) (let ((big3 (make-float-vector 20 0.0))) (copy bigfv big3 (- (ash 1 31) 10) (+ (ash 1 31) 10)) (test (morally-equal? big2 big3) #t))))) + (define (big-float-vector-filler) (do ((i 0 (+ i 1))) ((= i big-size)) (float-vector-set! bigfv i 1.0))) + (big-float-vector-filler) (test (bigfv 1) 1.0))) @@ -465,9 +467,27 @@ (test (float-vector-ref bigfv1 0 (- (/ big-size 2) 1)) 1.0) (test (float-vector-ref bigfv2 1 (- (/ big-size 2) 1)) 2.0) (let ((bigfv3 (append bigfv1 bigfv2))) - (test (length bigfv3) big-size) - (test (float-vector-ref bigfv3 (- (/ big-size 2) 1)) 1.0) - (test (float-vector-ref bigfv3 (+ (/ big-size 2) 1)) 2.0)))) + (test (length bigfv3) (* 2 big-size)) + (test (float-vector-ref bigfv3 (- big-size 1)) 1.0) + (test (float-vector-ref bigfv3 (+ big-size 1)) 2.0)))) + +(when (> total-memory (* 32 big-size)) + (format () "test 3b~%") + (clear-and-gc) + (let ((bigfv1 (make-float-vector (* big-size 2) 1.0)) + (bigfv2 (make-float-vector (* big-size 2) 2.0))) + (test (float-vector-ref bigfv1 (- (/ big-size 2) 1)) 1.0) + (test (float-vector-ref bigfv2 (- (/ big-size 2) 1)) 2.0) + (define (f-loop) + (do ((i (- (ash 1 32) 10) (+ i 1)) + (j 0 (+ j 1))) + ((= i (+ (ash 1 32) 10))) + (set! (bigfv1 i) j) + (set! (bigfv2 i) (* (bigfv1 i) 2)))) + (f-loop) + (test (subvector bigfv1 (list 20) (- (ash 1 32) 10)) (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)) + (test (subvector bigfv2 (list 20) (- (ash 1 32) 10)) (float-vector 0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38)) + (test (subvector bigfv1 (list 5) (+ (ash 1 32) 5)) (float-vector 15 16 17 18 19)))) (when (> total-memory (* 9 big-size)) (format () "test 4~%") @@ -682,8 +702,8 @@ (set! mx (max mx (abs (float-vector-ref fvr 0 i)) (abs (float-vector-ref fvr 1 i))))) (format () "noise: ~A~%" mx)))) -(define (float-2d-test) - (let ((fvr (make-float-vector (list 2 fft-size) 0.0))) +(define (float-2d-test skip) + (let ((fvr (make-float-vector (list skip fft-size) 0.0))) (do ((i 0 (+ i 1)) (x 0.0 (+ x (/ (* 8 pi) fft-size)))) ((= i fft-size)) @@ -693,9 +713,24 @@ (float-2d-fft #f fft-size 1) (float-2d-checker #f))) -(float-2d-test) +(float-2d-test 2) +(clear-and-gc) +(let-temporarily ((fft-size 32)) + (float-2d-test 2)) + +;; now try a big float-vector, but same size fft +(when (> total-memory (* 9 (ash 1 31))) + (float-2d-test (ash 1 14))) ; fft-size (ash 1 17) -> (* 8 (ash 1 31)) +(let-temporarily ((fft-size 32)) + (float-2d-test 2)) (clear-and-gc) +(when (> total-memory (* 9 (ash 1 33))) + (float-2d-test (ash 1 16))) ; fft-size (ash 1 17) -> (* 8 (ash 1 33)) +(let-temporarily ((fft-size 32)) + (float-2d-test 2)) +(clear-and-gc) + ;; -------------------------------------------------------------------------------- (format () "~%int-vectors...~%") @@ -709,7 +744,7 @@ (test (morally-equal? big1 bigfv) #t) (set! (big1 (- big-size 1)) 25) (test (morally-equal? big1 bigfv) #f) - (let ((big2 (make-shared-vector big1 (list 20) (- (ash 1 31) 10)))) + (let ((big2 (subvector big1 (list 20) (- (ash 1 31) 10)))) (test big2 (make-int-vector 20 5)) (test (length big2) 20) (let ((big3 (make-int-vector 20 0))) @@ -914,16 +949,17 @@ )) (clear-and-gc) -(when (> total-memory (* 68 big-size)) - (let ((v (make-vector big-size))) - (do ((i 0 (+ i 1))) - ((= i big-size)) - (vector-set! v i (* 2.0 i))) - (test (vector-ref v 100000000000) (* 2 100000000000)) - (test (vector-ref v (- big-size 10000000)) (* 2 (- big-size 10000000))))) +(define (v-loop-test) + (when (> total-memory (* 20 big-size)) + (let ((v (make-vector big-size))) + (do ((i 0 (+ i 1000))) + ((= i big-size)) + (vector-set! v i (* 2 i))) + (test (vector-ref v 100000000) (* 2 100000000)) + (test (vector-ref v (- big-size 10000000)) (* 2 (- big-size 10000000)))))) +(v-loop-test) (clear-and-gc) - (define (vector-fft rl im n dir) (when rl (let ((tempr 0.0) @@ -1116,8 +1152,8 @@ (set! mx (max mx (abs (vector-ref fvr 0 i)) (abs (vector-ref fvr 1 i))))) (format () "noise: ~A~%" mx)))) -(define (vector-2d-test) - (let ((fvr (make-vector (list 2 fft-size) 0.0))) +(define (vector-2d-test skip) + (let ((fvr (make-vector (list skip fft-size) 0.0))) (do ((i 0 (+ i 1)) (x 0.0 (+ x (/ (* 8 pi) fft-size)))) ((= i fft-size)) @@ -1127,14 +1163,14 @@ (vector-2d-fft #f fft-size 1) (vector-2d-checker #f))) -(vector-2d-test) +(vector-2d-test 2) (clear-and-gc) ;; -------------------------------------------------------------------------------- (format () "~%blocks...~%") -(when (> total-memory (* 5 big-size)) +(when (> total-memory (* 10 big-size)) (clear-and-gc) (let ((bigv (make-block big-size))) (test (length bigv) big-size) @@ -1147,6 +1183,12 @@ )) (clear-and-gc) +(when (> total-memory (* (ash 1 33) 8)) + (let ((b (make-block (ash 1 33)))) + (set! (b (+ (ash 1 32) 10)) 1.0) + (test (b (+ (ash 1 32) 10)) 1.0)) + (clear-and-gc)) + (define (block-fft rl im n dir) (when rl (do ((i 0 (+ i 1)) @@ -1334,7 +1376,7 @@ (format () "~%hash-tables...~%") -(when (> total-memory (* 9 2147483648)) +(when (> total-memory (* 9 (ash 1 31))) (clear-and-gc) (set! big-size 2000000000) @@ -1351,7 +1393,7 @@ (clear-and-gc) ) -(when (> total-memory (* 9 4294967296)) ; add some slack +(when (> total-memory (* 9 (ash 1 32))) ; add some slack (set! big-size 2500000000) (let ((bigv (make-hash-table big-size))) (test (length bigv) 4294967296) @@ -1622,8 +1664,7 @@ (clear-and-gc) (format () "~%sundries...~%") -;; TODO: move to string section -(set! fft-size (ash 1 15)) +;(set! fft-size (ash 1 15)) (define (string-fft rl im n dir) (when rl @@ -1945,7 +1986,7 @@ `(make-vector (make-list (+ 1 (random 4)) (+ 1 (random 4))) ,val)) (define-expansion (old-value ref) - `((make-shared-vector ,ref (list 1)) 0)) + `((subvector ,ref '(1)) 0)) (define (complex-2d-fft data n dir) (when data @@ -2198,6 +2239,81 @@ (iterator-vector-test) (clear-and-gc) +(define (complex-closure-fft data n dir) + (when data + (do ((i 0 (+ i 1)) + (j 0)) + ((= i n)) + (if (> j i) + (let ((temp (vector-ref data j))) + (vector-set! data j (vector-ref data i)) + (vector-set! data i temp))) + (let ((m (/ n 2))) + (do () + ((not (<= 2 m j))) + (set! j (- j m)) + (set! m (/ m 2))) + (set! j (+ j m)))) + (let ((ipow (floor (log n 2))) + (prev 1)) + (do ((lg 0 (+ lg 1)) + (mmax 2 (* mmax 2)) + (pow (/ n 2) (/ pow 2)) + (theta (complex 0.0 (* pi dir)) (* theta 0.5))) + ((= lg ipow)) + (let ((wpc (exp theta)) + (wc 1.0)) + (do ((ii 0 (+ ii 1))) + ((= ii prev)) + (do ((jj 0 (+ jj 1)) + (i ii (+ i mmax)) + (j (+ ii prev) (+ j mmax))) + ((>= jj pow)) + (let ((tc (* wc ((vector-ref data j))))) + (vector-set! data j (let ((z (- ((vector-ref data i)) tc))) (lambda () z))) + (vector-set! data i (let ((z (+ ((vector-ref data i)) tc))) (lambda () z))))) + (set! wc (* wc wpc))) + (set! prev mmax)))) + data)) + +(define (complex-closure-checker fvr) + (when fvr + (let ((pk 0.0) + (mx 0.0) + (mxloc 0)) + (do ((i 0 (+ i 1))) + ((= i fft-size)) + (set! pk (magnitude ((vector-ref fvr i)))) + (when (> pk mx) + (set! mx pk) + (set! mxloc i))) + (format () "~A ~A~%" mxloc (/ (* 2 (sqrt mx)) fft-size)) + (format () "~A ~A~%" + (magnitude ((vector-ref fvr 4))) + (magnitude ((vector-ref fvr (- fft-size 4)))))) + (vector-set! fvr 4 (let ((z 0.0)) (lambda () z))) + (vector-set! fvr (- fft-size 4) (let ((z 0.0)) (lambda () z))) + (let ((mx 0.0)) + (do ((i 0 (+ i 1))) + ((= i fft-size)) + (set! mx (max mx (magnitude ((vector-ref fvr i)))))) + (format () "noise: ~A~%" mx)))) + +(define (complex-closure-test) + (let ((fvr (make-vector fft-size))) + (do ((i 0 (+ i 1)) + (x 0.0 (+ x (/ (* 8 pi) fft-size)))) + ((= i fft-size)) + (vector-set! fvr i (let ((z (sin x))) (lambda () z)))) + (complex-closure-fft fvr fft-size 1) + (complex-closure-checker fvr) + (complex-closure-fft #f fft-size 1) + (complex-closure-checker #f))) +(complex-closure-test) + +(clear-and-gc) + + (s7-version) ;(*s7* 'memory-usage) diff --git a/tools/tcopy.scm b/tools/tcopy.scm index 4ac8e3e..3a5d9f6 100644 --- a/tools/tcopy.scm +++ b/tools/tcopy.scm @@ -83,6 +83,7 @@ (copy old-ivect new-pair) (copy old-let new-pair) (copy old-block new-pair) + (set! new-pair #f) (copy old-vector new-vector) (copy old-pair new-vector) @@ -92,6 +93,7 @@ (copy old-hash new-vector) (copy old-let new-vector) (copy old-block new-vector) + (set! new-vector #f) (copy old-fvect new-fvect) (copy old-ivect new-fvect) @@ -140,6 +142,7 @@ (copy old-ivect new-pair start (+ start nsize)) (copy old-let new-pair start (+ start nsize)) (copy old-block new-pair start (+ start nsize)) + (set! new-pair #f) (copy old-vector new-vector start (+ start nsize)) (copy old-pair new-vector start (+ start nsize)) @@ -149,6 +152,7 @@ (copy old-hash new-vector start (+ start nsize)) (copy old-let new-vector start (+ start nsize)) (copy old-block new-vector start (+ start nsize)) + (set! new-vector #f) (copy old-fvect new-fvect start (+ start nsize)) (copy old-ivect new-fvect start (+ start nsize)) @@ -238,6 +242,7 @@ (test (length bvec) (* size size)) ))) + (define (t) (do ((i 0 (+ i 1))) ((= i 10000)) @@ -250,7 +255,7 @@ #| (format *stderr* "copy~%") -(test-copy 100000) +(test-copy 1000000) ;100000 : .1 ;1000000 : 4.6 ;10000000 : 356 = about 120 million objects = about 6Gbytes, mark_pair/gc diff --git a/tools/testsnd b/tools/testsnd index 63abb33..f8946fc 100755 --- a/tools/testsnd +++ b/tools/testsnd @@ -5,7 +5,7 @@ cp tools/ffitest.c . echo ' -------------------------------- without-gui -------------------------------- ' rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -I/usr/local/include" --without-gui +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include" --without-gui make echo ' ' echo ' ' @@ -40,7 +40,7 @@ echo ' ' echo ' -------------------------------- without-gui sanitized -------------------------------- ' rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-g3 -Wall -I/usr/local/include -Wbool-compare -Wsign-compare -fsanitize=bounds -fsanitize=address -fsanitize=undefined" --without-gui +./configure --quiet CFLAGS="-g3 -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include -Wbool-compare -Wsign-compare -fsanitize=bounds -fsanitize=address -fsanitize=undefined" --without-gui make echo ' ' echo ' ' @@ -57,7 +57,7 @@ echo ' -------------------------------- without-gui S7_DEBUGGING=1 ------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -I/usr/local/include -DS7_DEBUGGING" --without-gui --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include -DS7_DEBUGGING" --without-gui --disable-deprecated make echo ' ' echo ' ' @@ -80,7 +80,7 @@ echo ' -------------------------------- pure-s7 -------------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITH_PURE_S7=1" --without-gui --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include -DWITH_PURE_S7=1" --without-gui --disable-deprecated make echo ' ' echo ' ' @@ -96,7 +96,7 @@ echo ' -------------------------------- no choosers ---------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITHOUT_CHOOSERS=1" --without-gui --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include -DWITHOUT_CHOOSERS=1" --without-gui --disable-deprecated make echo ' ' echo ' ' @@ -112,7 +112,7 @@ echo ' -------------------------------- no vectorize --------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITH_VECTORIZE=0 -DHAVE_OVERFLOW_CHECKS=0" --without-gui --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/local/include -DWITH_VECTORIZE=0 -DHAVE_OVERFLOW_CHECKS=0" --without-gui --disable-deprecated make echo ' ' echo ' ' @@ -128,7 +128,7 @@ echo ' -------------------------------- without-gui CC=g++ --disable-deprecated make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -DWITH_EXTRA_EXPONENT_MARKERS=1" --without-gui --disable-deprecated CC=g++ +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -DWITH_EXTRA_EXPONENT_MARKERS=1" --without-gui --disable-deprecated CC=g++ make echo ' ' echo ' ' @@ -151,7 +151,7 @@ echo ' -------------------------------- without-gui --with-gmp ----------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --without-gui --with-gmp --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --without-gui --with-gmp --disable-deprecated make echo ' ' echo ' ' @@ -178,7 +178,7 @@ echo ' -------------------------------- without-gui --with-gmp debugging ------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall -DS7_DEBUGGING=1" --without-gui --with-gmp --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -DS7_DEBUGGING=1" --without-gui --with-gmp --disable-deprecated make echo ' ' echo ' ' @@ -195,7 +195,7 @@ echo ' -------------------------------- motif -------------------------------- ' make allclean rm -f snd rm -f config.cache -./configure --quiet --with-motif CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet --with-motif CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make echo ' ' echo ' ' @@ -224,7 +224,7 @@ echo ' -------------------------------- motif + gl ----------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet --with-gl --with-motif CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet --with-gl --with-motif CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make echo ' ' echo ' ' @@ -248,7 +248,7 @@ echo ' -------------------------------- motif + gl + debug --------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet --with-gl --with-motif CFLAGS="-DS7_DEBUGGING -Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" +./configure --quiet --with-gl --with-motif CFLAGS="-DS7_DEBUGGING -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib" make echo ' ' echo ' ' @@ -264,7 +264,7 @@ echo ' ' make allclean rm -f snd rm -f config.cache -./configure --without-gui --quiet CC=clang CFLAGS="-Wall" LDFLAGS="-Wl,-export-dynamic" +./configure --without-gui --quiet CC=clang CFLAGS="-Wall -Wno-array-bounds -Wno-parentheses" LDFLAGS="-Wl,-export-dynamic" make ./snd --version ./snd -l snd-test @@ -279,7 +279,7 @@ echo ' -------------------------------- with-gtk ------------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --with-gtk --disable-deprecated +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --with-gtk --disable-deprecated make echo ' ' echo ' ' @@ -304,7 +304,7 @@ echo ' -------------------------------- with-gtk + debug ----------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-DS7_DEBUGGING -Wall" --with-gtk --disable-deprecated +./configure --quiet CFLAGS="-DS7_DEBUGGING -Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --with-gtk --disable-deprecated make echo ' ' echo ' ' @@ -325,7 +325,7 @@ echo ' -------------------------------- without-gui ---------------------------- make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --without-gui +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --without-gui make echo ' ' echo ' ' @@ -393,7 +393,7 @@ echo ' ' make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" CC=g++ +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" CC=g++ make echo ' ' echo ' ' @@ -408,7 +408,7 @@ echo ' ' make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --with-gtk --with-ladspa --without-audio +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --with-gtk --with-ladspa --without-audio make echo ' ' echo ' ' @@ -423,7 +423,7 @@ echo ' ' make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --with-gmp --without-gui +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --with-gmp --without-gui make echo ' ' echo ' ' @@ -442,7 +442,7 @@ mv tmp snd-test.scm make allclean rm -f snd rm -f config.cache -./configure --quiet CFLAGS="-Wall" --without-gui +./configure --quiet CFLAGS="-Wall -Wno-restrict -Wno-array-bounds -Wno-stringop-overflow -Wno-parentheses" --without-gui make echo ' ' echo ' ' diff --git a/tools/tform.scm b/tools/tform.scm index 41782d1..68e29d1 100644 --- a/tools/tform.scm +++ b/tools/tform.scm @@ -38,8 +38,8 @@ (with-baffle (call/cc (lambda (cc) cc))) (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3) #<undefined> #<unspecified> (make-int-vector 3 0) (make-float-vector 3 -1.4) - (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (make-shared-vector (make-int-vector '(2 3) 1) '(6)) - (make-shared-vector (make-shared-vector (make-float-vector '(2 3) 1.0) '(6)) '(2 2)) + (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (subvector (make-int-vector '(2 3) 1) '(6)) + (subvector (subvector (make-float-vector '(2 3) 1.0) '(6)) '(2 2)) (vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1)) (c-pointer 0) (c-pointer -1) :readable *s7* else (define-bacro* (m (a 1)) `(+ ,a 1)) (byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator (vector '(a . 2))) diff --git a/tools/tgen.scm b/tools/tgen.scm index e22feb2..7cb360b 100644 --- a/tools/tgen.scm +++ b/tools/tgen.scm @@ -183,7 +183,7 @@ (checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12)) ))) - (define the-body (apply lambda () (list (copy body :readable)))) + (define the-body (apply lambda () (list body))) (the-body))) (define (try2 form gen make-gen) @@ -274,7 +274,7 @@ (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12)) ))) - (define the-body (apply lambda () (list (copy body :readable)))) + (define the-body (apply lambda () (list body))) (the-body))) #| (define (try34 form gen make-gen args) @@ -367,7 +367,7 @@ (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12)) )))) - (define the-body (apply lambda () (list (copy body :readable)))) + (define the-body (apply lambda () (list body))) (the-body))) |# diff --git a/tools/titer.scm b/tools/titer.scm index aa35345..d3eea3f 100644 --- a/tools/titer.scm +++ b/tools/titer.scm @@ -4,15 +4,18 @@ ;;; do/let/rec/tc/iter +(let () + (define with-blocks #f) (when with-blocks (let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible (load "s7test-block.so" new-env))) (define-constant (find-if-a iter) - (or (string? (iterate iter)) - (and (not (iterator-at-end? iter)) - (find-if-a iter)))) + (case (type-of (iterate iter)) + ((string?) #t) + ((eof-object?) #f) + (else (find-if-a iter)))) (define-constant (find-if-b iter) (call-with-exit @@ -24,9 +27,10 @@ (define-constant (find-if-c iter) (let loop () - (or (string? (iterate iter)) - (and (not (iterator-at-end? iter)) - (loop))))) + (case (type-of (iterate iter)) + ((string?) #t) + ((eof-object?) #f) + (else (loop))))) (define-constant (find-if-d iter) (do ((i 0 (+ i 1))) @@ -34,7 +38,7 @@ (not (iterator-at-end? iter))) (do () ((or (string? (iterate iter)) (iterator-at-end? iter)))))) - + (define (test) (for-each @@ -103,3 +107,4 @@ (s7-version) (exit) +) diff --git a/tools/tpeak.scm b/tools/tpeak.scm index dfcfe6b..0c30454 100644 --- a/tools/tpeak.scm +++ b/tools/tpeak.scm @@ -1,35 +1,27 @@ (if (not (provided? 'snd-peak-phases.scm)) (load "peak-phases.scm")) (load "primes.scm") -(define (vector-find-if func vect) - (let ((len (length vect)) - (result #f)) - (do ((i 0 (+ i 1))) - ((or (= i len) - result) - result) - (set! result (func (vector-ref vect i)))))) - (define (get-best choice n) - (vector-find-if (lambda (val) - (and (vector? val) - (= (vector-ref val 0) n) - (let ((a-val (vector-ref val 1)) - (a-len (length val)) - (a-data (vector-ref val 2))) - (do ((k 3 (+ 1 k))) - ((= k a-len)) - (if (and (real? (vector-ref val k)) - (< (vector-ref val k) a-val)) - (begin - (set! a-val (vector-ref val k)) - (set! a-data (vector-ref val (+ k 1)))))) - (list a-val a-data)))) - (case choice - ((:all) noid-min-peak-phases) - ((:odd) nodd-min-peak-phases) - ((:even) neven-min-peak-phases) - (else primoid-min-peak-phases)))) + (let ((val (vector-ref (case choice + ((:all) noid-min-peak-phases) + ((:odd) nodd-min-peak-phases) + ((:even) neven-min-peak-phases) + (else primoid-min-peak-phases)) + (cond ((<= n 128) (- n 1)) + ((= n 256) 128) + ((= n 512) 129) + ((= n 1024) 130) + (else 131))))) + (let ((a-val (vector-ref val 1)) + (a-len (length val)) + (a-data (vector-ref val 2))) + (do ((k 3 (+ 1 k))) + ((= k a-len) + (list a-val a-data)) + (when (and (real? (vector-ref val k)) + (< (vector-ref val k) a-val)) + (set! a-val (vector-ref val k)) + (set! a-data (vector-ref val (+ k 1)))))))) (define (write-best-cases) (let ((file (open-output-file "best.data" "w"))) @@ -72,41 +64,42 @@ (close-output-port file))) - (define (min-peak choice n) - (vector-find-if (lambda (val) - (and (vector? val) - (= (vector-ref val 0) n) - (let ((a-val (vector-ref val 1)) - (a-len (length val))) - (do ((k 2 (+ k 1))) - ((>= k a-len)) - (if (and (vector? (vector-ref val k)) - (not (= n (length (vector-ref val k))))) - (let-temporarily ((*s7* 'print-length) 4) - (format () "~A ~D[~D]: vector length = ~D (~A ~A)~%" - choice n k - (length (vector-ref val k)) - (vector-ref val (- k 1)) - (vector-ref val k)))) - (if (not (or (number? (vector-ref val k)) - (vector? (vector-ref val k)))) - (format () "~A ~D[~D]: bad entry: ~A (a-len: ~A)~%" choice n k (vector-ref val k) a-len)) - (if (vector? (vector-ref val k)) - (let ((v (vector-ref val k))) - (do ((i 0 (+ i 1))) - ((= i (length v))) - (if (> (abs (vector-ref v i)) 2.0) - (format () "~A ~D[~D][~D]: needs mod: ~A~%" choice n k i (vector-ref v i)))))) - (if (and (real? (vector-ref val k)) - (< (vector-ref val k) a-val)) - (set! a-val (vector-ref val k)))) - a-val))) - (case choice - ((:all) noid-min-peak-phases) - ((:odd) nodd-min-peak-phases) - ((:even) neven-min-peak-phases) - (else primoid-min-peak-phases)))) + (let ((val (vector-ref (case choice + ((:all) noid-min-peak-phases) + ((:odd) nodd-min-peak-phases) + ((:even) neven-min-peak-phases) + (else primoid-min-peak-phases)) + (cond ((<= n 128) (- n 1)) + ((= n 256) 128) + ((= n 512) 129) + ((= n 1024) 130) + (else 131))))) + (let ((a-val (vector-ref val 1)) + (a-len (length val))) + (do ((k 2 (+ k 1))) + ((>= k a-len)) + (if (and (vector? (vector-ref val k)) + (not (= n (length (vector-ref val k))))) + (let-temporarily ((*s7* 'print-length) 4) + (format () "~A ~D[~D]: vector length = ~D (~A ~A)~%" + choice n k + (length (vector-ref val k)) + (vector-ref val (- k 1)) + (vector-ref val k)))) + (if (not (or (number? (vector-ref val k)) + (vector? (vector-ref val k)))) + (format () "~A ~D[~D]: bad entry: ~A (a-len: ~A)~%" choice n k (vector-ref val k) a-len)) + (if (vector? (vector-ref val k)) + (let ((v (vector-ref val k))) + (do ((i 0 (+ i 1))) + ((= i (length v))) + (if (> (abs (vector-ref v i)) 2.0) + (format () "~A ~D[~D][~D]: needs mod: ~A~%" choice n k i (vector-ref v i)))))) + (if (and (real? (vector-ref val k)) + (< (vector-ref val k) a-val)) + (set! a-val (vector-ref val k)))) + a-val))) (define (get-worst-overall choice choices) (let ((diffs (make-vector 116)) diff --git a/tools/tread.scm b/tools/tread.scm index 6caf231..9f5fea8 100644 --- a/tools/tread.scm +++ b/tools/tread.scm @@ -2,6 +2,7 @@ (load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init))) (set! (*s7* 'print-length) 8) ; :readable should ignore this +(set! (*s7* 'default-hash-table-length) 4) (define (tester) (do ((baddies 0) @@ -69,10 +70,10 @@ (for-each (lambda (x) (let ((str (object->string x :readable))) - (unless (morally-equal? x (eval-string str)) + (unless (equal? x (eval-string str)) (set! baddies (+ baddies 1)) (format *stderr* "x: ~S~%" x) - (format *stderr* "ex: ~S~%" (catch #t (lambda () (eval-string str)) (lambda (type info) (apply format #f info)))) + (format *stderr* "ex: ~S~%" (eval-string str)) (format *stderr* "sets: ~S~%" (reverse sets)) (format *stderr* "str: ~S~%" str) (pretty-print (with-input-from-string str read) *stderr* 0) @@ -107,7 +108,6 @@ sets) (format *stderr* " ~A)~%" (#(p v cy h e it cp) bi))) (set! bi (+ bi 1)))) - bases))))))) (tester) diff --git a/tools/valcall.scm b/tools/valcall.scm index 38c1cd8..41cf74e 100644 --- a/tools/valcall.scm +++ b/tools/valcall.scm @@ -19,6 +19,7 @@ ("tgen.scm" . "v-gen") ("tall.scm" . "v-all") ("snd-test.scm" . "v-call") + ("dup.scm" . "v-dup") )) (define (last-callg) @@ -56,22 +57,23 @@ ;; my $space = ' ' x max($CC_col_widths->[$i] - length($count), 0); (format *stderr* "~NC ~A~D -> ~A~D: ~NC~%" 8 #\space outfile (- next 1) outfile next 8 #\space) (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next))))) - (list (list "repl" "tmac.scm") - (list "snd -noinit" "tpeak.scm") + (list (list "snd -noinit" "tpeak.scm") + (list "repl" "tmac.scm") + (list "repl" "dup.scm") (list "repl" "tref.scm") (list "snd -noinit" "make-index.scm") (list "repl" "tauto.scm") (list "repl" "teq.scm") (list "repl" "s7test.scm") (list "repl" "lt.scm") - (list "repl" "tcopy.scm") (list "repl" "tread.scm") + (list "repl" "tcopy.scm") (list "repl" "tform.scm") (list "repl" "tlet.scm") (list "repl" "tfft.scm") (list "repl" "tmap.scm") - (list "repl" "tsort.scm") (list "repl" "titer.scm") + (list "repl" "tsort.scm") ;(list "repl" "lg.scm") (list "repl" "thash.scm") (list "snd -noinit" "tgen.scm") ; repl here + cload sndlib was slower @@ -39975,13 +39975,13 @@ static void define_functions(void) { #if HAVE_SCHEME s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false; - s7_pointer pl_gi, pl_igi, pl_du, pl_pr, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_iit, pl_iiit, pl_t, pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_iu, pl_pi, pl_iur, pl_tts, pl_tti, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_bi, pl_big, pl_sg, pl_gs, pl_pu, pl_pur, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_si, pl_is, pl_isi, pl_sig, pl_isgt, pl_isigutttiiu, pl_g, pl_buuusuug, pl_bu, pl_pb, pl_bur, pl_bug, pl_bus, pl_bui, pl_bub, pl_buui, pl_buus, pl_busu, pl_buub, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_i, pl_su, pl_ps, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_psgbiiiit, pl_psiiuusu, pl_tg, pl_ti, pl_it, pl_tiu, pl_itsub, pl_itiiub, pl_itstttg, pl_itgiiut, pl_bsu, pl_bsigb, pl_p, pl_ssi, pl_ssig, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_b, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_s, pl_bt, pl_tb, pl_bti, pl_btiib, pl_ts, pl_tsi, pl_tsig, pl_tsiu, pl_tsiuui, pl_tsiiuui, pl_bpt; + s7_pointer pl_iu, pl_pi, pl_iur, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_t, pl_bi, pl_big, pl_gi, pl_igi, pl_pu, pl_pur, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_si, pl_is, pl_isi, pl_tts, pl_tti, pl_sig, pl_isgt, pl_isigutttiiu, pl_buuusuug, pl_bu, pl_pb, pl_bur, pl_bug, pl_bus, pl_bui, pl_bub, pl_buui, pl_buus, pl_busu, pl_buub, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_su, pl_ps, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_psgbiiiit, pl_psiiuusu, pl_i, pl_bsu, pl_bsigb, pl_sg, pl_gs, pl_ti, pl_it, pl_tiu, pl_itsub, pl_itiiub, pl_itstttg, pl_itgiiut, pl_ssi, pl_ssig, pl_p, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_b, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_g, pl_s, pl_bt, pl_tb, pl_bti, pl_btiib, pl_du, pl_pr, pl_tg, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_iit, pl_iiit, pl_ts, pl_tsi, pl_tsig, pl_tsiu, pl_tsiuui, pl_tsiiuui, pl_bpt; #if GTK_CHECK_VERSION(3, 0, 0) - s7_pointer pl_pgr, pl_gug, pl_puuig, pl_puiiui, pl_buigu, pl_tuuugi, pl_tuuuub; + s7_pointer pl_puuig, pl_puiiui, pl_buigu, pl_pgr, pl_gug, pl_tuuugi, pl_tuuuub; #endif #if GTK_CHECK_VERSION(3, 4, 0) - s7_pointer pl_prrru, pl_suiig, pl_tsu; + s7_pointer pl_suiig, pl_prrru, pl_tsu; #endif #if GTK_CHECK_VERSION(3, 6, 0) @@ -40005,7 +40005,7 @@ static void define_functions(void) #endif #if GTK_CHECK_VERSION(3, 99, 0) - s7_pointer pl_guugbuut, pl_iuugs, pl_piigui, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_but, pl_busi, pl_buib, pl_bugu, pl_pst, pl_tist, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru, pl_tsit; + s7_pointer pl_iuugs, pl_piigui, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_but, pl_busi, pl_buib, pl_bugu, pl_guugbuut, pl_pst, pl_tist, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru, pl_tsit; #endif #endif @@ -40027,33 +40027,9 @@ static void define_functions(void) s_gtk_enum_t = s7_make_symbol(s7, "gtk_enum_t?"); s_any = s7_t(s7); - pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer); - pl_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer); - pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false); - pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real); - pl_dui = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_integer); - pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string); - pl_dusi = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_integer); - pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real); - pl_iit = s7_make_circular_signature(s7, 2, 3, s_integer, s_integer, s_any); - pl_iiit = s7_make_circular_signature(s7, 3, 4, s_integer, s_integer, s_integer, s_any); - pl_t = s7_make_circular_signature(s7, 0, 1, s_any); - pl_gu = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_pair_false); - pl_pg = s7_make_circular_signature(s7, 1, 2, s_pair, s_gtk_enum_t); - pl_gus = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_string); - pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer); - pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); - pl_gui = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); - pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); - pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); - pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); - pl_gurrsiu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); - pl_gussitu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); pl_iu = s7_make_circular_signature(s7, 1, 2, s_integer, s_pair_false); pl_pi = s7_make_circular_signature(s7, 1, 2, s_pair, s_integer); pl_iur = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_real); - pl_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string); - pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer); pl_iug = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_gtk_enum_t); pl_iui = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_integer); pl_ius = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_string); @@ -40066,10 +40042,11 @@ static void define_functions(void) pl_iuisi = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer); pl_iuuuui = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer); pl_iuisut = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any); + pl_t = s7_make_circular_signature(s7, 0, 1, s_any); pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer); pl_big = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_gtk_enum_t); - pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t); - pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string); + pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer); + pl_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer); pl_pu = s7_make_circular_signature(s7, 1, 2, s_pair, s_pair_false); pl_pur = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_real); pl_pub = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_boolean); @@ -40106,10 +40083,11 @@ static void define_functions(void) pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer); pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string); pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer); + pl_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string); + pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer); pl_sig = s7_make_circular_signature(s7, 2, 3, s_string, s_integer, s_gtk_enum_t); pl_isgt = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any); pl_isigutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false); - pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t); pl_buuusuug = s7_make_circular_signature(s7, 7, 8, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t); pl_bu = s7_make_circular_signature(s7, 1, 2, s_boolean, s_pair_false); pl_pb = s7_make_circular_signature(s7, 1, 2, s_pair, s_boolean); @@ -40133,7 +40111,17 @@ static void define_functions(void) pl_buusib = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_string, s_integer, s_boolean); pl_buuuub = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); pl_buurbr = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_real, s_boolean, s_real); - pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); + pl_gu = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_pair_false); + pl_pg = s7_make_circular_signature(s7, 1, 2, s_pair, s_gtk_enum_t); + pl_gus = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_string); + pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer); + pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); + pl_gui = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); + pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); + pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); + pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); + pl_gurrsiu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); + pl_gussitu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); pl_su = s7_make_circular_signature(s7, 1, 2, s_string, s_pair_false); pl_ps = s7_make_circular_signature(s7, 1, 2, s_pair, s_string); pl_sui = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_integer); @@ -40152,7 +40140,11 @@ static void define_functions(void) pl_psrrrb = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean); pl_psgbiiiit = s7_make_circular_signature(s7, 8, 9, s_pair, s_string, s_gtk_enum_t, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any); pl_psiiuusu = s7_make_circular_signature(s7, 7, 8, s_pair, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false); - pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t); + pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); + pl_bsu = s7_make_circular_signature(s7, 2, 3, s_boolean, s_string, s_pair_false); + pl_bsigb = s7_make_circular_signature(s7, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); + pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t); + pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string); pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer); pl_it = s7_make_circular_signature(s7, 1, 2, s_integer, s_any); pl_tiu = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_pair_false); @@ -40160,11 +40152,9 @@ static void define_functions(void) pl_itiiub = s7_make_circular_signature(s7, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean); pl_itstttg = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t); pl_itgiiut = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any); - pl_bsu = s7_make_circular_signature(s7, 2, 3, s_boolean, s_string, s_pair_false); - pl_bsigb = s7_make_circular_signature(s7, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); - pl_p = s7_make_circular_signature(s7, 0, 1, s_pair); pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer); pl_ssig = s7_make_circular_signature(s7, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t); + pl_p = s7_make_circular_signature(s7, 0, 1, s_pair); pl_tusiuiui = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false, s_integer); pl_tuiiiiui = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_pair_false, s_integer); pl_tuuiiiirrrrg = s7_make_circular_signature(s7, 11, 12, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_gtk_enum_t); @@ -40227,11 +40217,21 @@ static void define_functions(void) pl_tuuubr = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_real); pl_tuuiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false, s_pair_false, s_integer); pl_tubiiiu = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_boolean, s_integer, s_integer, s_integer, s_pair_false); + pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t); pl_s = s7_make_circular_signature(s7, 0, 1, s_string); pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any); pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean); pl_bti = s7_make_circular_signature(s7, 2, 3, s_boolean, s_any, s_integer); pl_btiib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean); + pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false); + pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real); + pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t); + pl_dui = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_integer); + pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string); + pl_dusi = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_integer); + pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real); + pl_iit = s7_make_circular_signature(s7, 2, 3, s_integer, s_integer, s_any); + pl_iiit = s7_make_circular_signature(s7, 3, 4, s_integer, s_integer, s_integer, s_any); pl_ts = s7_make_circular_signature(s7, 1, 2, s_any, s_string); pl_tsi = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_integer); pl_tsig = s7_make_circular_signature(s7, 3, 4, s_any, s_string, s_integer, s_gtk_enum_t); @@ -40240,18 +40240,18 @@ static void define_functions(void) pl_tsiiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer); pl_bpt = s7_make_signature(s7, 2, s_pair_false, s_any); #if GTK_CHECK_VERSION(3, 0, 0) - pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real); - pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t); pl_puuig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); pl_puiiui = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer); pl_buigu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false); + pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real); + pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t); pl_tuuugi = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); pl_tuuuub = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); #endif #if GTK_CHECK_VERSION(3, 4, 0) - pl_prrru = s7_make_circular_signature(s7, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false); pl_suiig = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_integer, s_integer, s_gtk_enum_t); + pl_prrru = s7_make_circular_signature(s7, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false); pl_tsu = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_pair_false); #endif @@ -40285,7 +40285,6 @@ static void define_functions(void) #endif #if GTK_CHECK_VERSION(3, 99, 0) - pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); pl_iuugs = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_gtk_enum_t, s_string); pl_piigui = s7_make_circular_signature(s7, 5, 6, s_pair, s_integer, s_integer, s_gtk_enum_t, s_pair_false, s_integer); pl_puuugi = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); @@ -40295,6 +40294,7 @@ static void define_functions(void) pl_busi = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_string, s_integer); pl_buib = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_integer, s_boolean); pl_bugu = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_gtk_enum_t, s_pair_false); + pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); pl_pst = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_any); pl_tist = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_string, s_any); pl_turs = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_real, s_string); @@ -47730,7 +47730,7 @@ void Init_libxg(void) Xen_provide_feature("gtk2"); #endif #endif - Xen_define("xg-version", C_string_to_Xen_string("30-Jun-18")); + Xen_define("xg-version", C_string_to_Xen_string("27-Jul-18")); xg_already_inited = true; #if HAVE_SCHEME #if USE_SND |