2004-07-16 02:26:21 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
|
|
|
XT primitives[] = {
|
2004-08-04 22:43:58 -04:00
|
|
|
undefined,
|
2004-08-23 01:13:09 -04:00
|
|
|
docol,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_execute,
|
|
|
|
primitive_call,
|
|
|
|
primitive_ifte,
|
|
|
|
primitive_consp,
|
|
|
|
primitive_cons,
|
|
|
|
primitive_car,
|
|
|
|
primitive_cdr,
|
|
|
|
primitive_set_car,
|
|
|
|
primitive_set_cdr,
|
|
|
|
primitive_vectorp,
|
|
|
|
primitive_vector,
|
|
|
|
primitive_vector_length,
|
|
|
|
primitive_set_vector_length,
|
|
|
|
primitive_vector_nth,
|
|
|
|
primitive_set_vector_nth,
|
|
|
|
primitive_stringp,
|
|
|
|
primitive_string_length,
|
|
|
|
primitive_string_nth,
|
|
|
|
primitive_string_compare,
|
|
|
|
primitive_string_eq,
|
|
|
|
primitive_string_hashcode,
|
|
|
|
primitive_index_of,
|
|
|
|
primitive_substring,
|
2004-09-06 22:39:12 -04:00
|
|
|
primitive_string_reverse,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_sbufp,
|
|
|
|
primitive_sbuf,
|
|
|
|
primitive_sbuf_length,
|
|
|
|
primitive_set_sbuf_length,
|
|
|
|
primitive_sbuf_nth,
|
|
|
|
primitive_set_sbuf_nth,
|
|
|
|
primitive_sbuf_append,
|
|
|
|
primitive_sbuf_to_string,
|
2004-08-25 20:51:19 -04:00
|
|
|
primitive_sbuf_reverse,
|
|
|
|
primitive_sbuf_clone,
|
2004-08-12 01:07:22 -04:00
|
|
|
primitive_sbuf_eq,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_numberp,
|
|
|
|
primitive_to_fixnum,
|
|
|
|
primitive_to_bignum,
|
2004-08-05 17:33:02 -04:00
|
|
|
primitive_to_float,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_number_eq,
|
|
|
|
primitive_fixnump,
|
|
|
|
primitive_bignump,
|
|
|
|
primitive_ratiop,
|
|
|
|
primitive_numerator,
|
|
|
|
primitive_denominator,
|
2004-08-05 17:33:02 -04:00
|
|
|
primitive_floatp,
|
|
|
|
primitive_str_to_float,
|
|
|
|
primitive_float_to_str,
|
2004-08-06 02:51:32 -04:00
|
|
|
primitive_float_to_bits,
|
2004-08-05 20:29:52 -04:00
|
|
|
primitive_complexp,
|
|
|
|
primitive_real,
|
|
|
|
primitive_imaginary,
|
|
|
|
primitive_to_rect,
|
|
|
|
primitive_from_rect,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_add,
|
|
|
|
primitive_subtract,
|
|
|
|
primitive_multiply,
|
|
|
|
primitive_divint,
|
2004-08-05 17:33:02 -04:00
|
|
|
primitive_divfloat,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_divide,
|
|
|
|
primitive_mod,
|
|
|
|
primitive_divmod,
|
|
|
|
primitive_and,
|
|
|
|
primitive_or,
|
|
|
|
primitive_xor,
|
|
|
|
primitive_not,
|
2004-08-26 19:37:22 -04:00
|
|
|
primitive_shift,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_less,
|
|
|
|
primitive_lesseq,
|
|
|
|
primitive_greater,
|
|
|
|
primitive_greatereq,
|
2004-08-06 18:40:44 -04:00
|
|
|
primitive_facos,
|
|
|
|
primitive_fasin,
|
|
|
|
primitive_fatan,
|
|
|
|
primitive_fatan2,
|
|
|
|
primitive_fcos,
|
|
|
|
primitive_fexp,
|
|
|
|
primitive_fcosh,
|
|
|
|
primitive_flog,
|
|
|
|
primitive_fpow,
|
|
|
|
primitive_fsin,
|
|
|
|
primitive_fsinh,
|
|
|
|
primitive_fsqrt,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_wordp,
|
|
|
|
primitive_word,
|
2004-08-29 04:03:16 -04:00
|
|
|
primitive_word_hashcode,
|
2004-09-06 02:32:04 -04:00
|
|
|
primitive_word_xt,
|
|
|
|
primitive_set_word_xt,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_word_primitive,
|
|
|
|
primitive_set_word_primitive,
|
|
|
|
primitive_word_parameter,
|
|
|
|
primitive_set_word_parameter,
|
|
|
|
primitive_word_plist,
|
|
|
|
primitive_set_word_plist,
|
|
|
|
primitive_drop,
|
|
|
|
primitive_dup,
|
|
|
|
primitive_swap,
|
|
|
|
primitive_over,
|
|
|
|
primitive_pick,
|
|
|
|
primitive_nip,
|
|
|
|
primitive_tuck,
|
|
|
|
primitive_rot,
|
|
|
|
primitive_to_r,
|
|
|
|
primitive_from_r,
|
|
|
|
primitive_eq,
|
|
|
|
primitive_getenv,
|
|
|
|
primitive_setenv,
|
|
|
|
primitive_open_file,
|
2004-08-29 23:30:54 -04:00
|
|
|
primitive_stat,
|
2004-08-30 00:36:44 -04:00
|
|
|
primitive_read_dir,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_gc,
|
|
|
|
primitive_save_image,
|
|
|
|
primitive_datastack,
|
|
|
|
primitive_callstack,
|
|
|
|
primitive_set_datastack,
|
|
|
|
primitive_set_callstack,
|
2004-08-12 17:36:36 -04:00
|
|
|
primitive_portp,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_exit,
|
2004-08-18 15:23:42 -04:00
|
|
|
primitive_client_socket,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_server_socket,
|
2004-08-20 01:49:14 -04:00
|
|
|
primitive_close,
|
2004-08-15 22:45:08 -04:00
|
|
|
primitive_add_accept_io_task,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_accept_fd,
|
2004-08-15 21:50:44 -04:00
|
|
|
primitive_can_read_line,
|
|
|
|
primitive_add_read_line_io_task,
|
2004-08-20 01:49:14 -04:00
|
|
|
primitive_read_line_8,
|
|
|
|
primitive_can_read_count,
|
|
|
|
primitive_add_read_count_io_task,
|
|
|
|
primitive_read_count_8,
|
2004-08-15 21:50:44 -04:00
|
|
|
primitive_can_write,
|
|
|
|
primitive_add_write_io_task,
|
2004-08-20 01:49:14 -04:00
|
|
|
primitive_write_8,
|
2004-08-28 22:25:59 -04:00
|
|
|
primitive_add_copy_io_task,
|
2004-09-02 21:51:19 -04:00
|
|
|
primitive_pending_io_error,
|
2004-08-15 21:50:44 -04:00
|
|
|
primitive_next_io_task,
|
2004-08-04 22:43:58 -04:00
|
|
|
primitive_room,
|
|
|
|
primitive_os_env,
|
|
|
|
primitive_millis,
|
|
|
|
primitive_init_random,
|
2004-08-06 02:51:32 -04:00
|
|
|
primitive_random_int,
|
|
|
|
primitive_type_of,
|
2004-08-23 01:13:09 -04:00
|
|
|
primitive_size_of,
|
2004-08-29 03:20:19 -04:00
|
|
|
primitive_call_profiling,
|
2004-08-23 01:13:09 -04:00
|
|
|
primitive_word_call_count,
|
2004-08-24 23:46:55 -04:00
|
|
|
primitive_set_word_call_count,
|
2004-08-29 03:20:19 -04:00
|
|
|
primitive_allot_profiling,
|
|
|
|
primitive_word_allot_count,
|
|
|
|
primitive_set_word_allot_count,
|
2004-09-04 03:06:53 -04:00
|
|
|
primitive_dump,
|
|
|
|
primitive_cwd,
|
2004-09-06 02:32:04 -04:00
|
|
|
primitive_cd,
|
2004-09-06 22:39:12 -04:00
|
|
|
primitive_set_compiled_byte,
|
|
|
|
primitive_set_compiled_cell,
|
|
|
|
primitive_compiled_offset,
|
|
|
|
primitive_set_compiled_offset,
|
|
|
|
primitive_literal_top,
|
|
|
|
primitive_set_literal_top,
|
|
|
|
primitive_address_of
|
2004-07-16 02:26:21 -04:00
|
|
|
};
|
|
|
|
|
|
|
|
CELL primitive_to_xt(CELL primitive)
|
|
|
|
{
|
|
|
|
if(primitive < 0 || primitive >= PRIMITIVE_COUNT)
|
2004-08-29 01:04:42 -04:00
|
|
|
general_error(ERROR_BAD_PRIMITIVE,tag_fixnum(primitive));
|
2004-08-04 22:43:58 -04:00
|
|
|
|
2004-07-29 17:18:41 -04:00
|
|
|
return (CELL)primitives[primitive];
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|