conservatory
/
stk
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
stk/Src/primitives.c

564 lines
24 KiB
C
Raw Blame History

/*
*
* p r i m i t i v e s . c -- List of STk subrs
*
* Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* Permission to use, copy, modify, distribute,and license this
* software and its documentation for any purpose is hereby granted,
* provided that existing copyright notices are retained in all
* copies and that this notice is included verbatim in any
* distributions. No written agreement, license, or royalty fee is
* required for any of the authorized uses.
* This software is provided ``AS IS'' without express or implied
* warranty.
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: ??????
* Last file update: 3-Sep-1999 20:22 (eg)
*/
#include "stk.h"
struct Primitive {
char *name;
char type;
PRIMITIVE (*fct)();
};
#ifdef USE_HASH
extern PRIMITIVE STk_init_hash(void);
#endif
#ifdef USE_SOCKET
extern PRIMITIVE STk_init_socket(void);
#endif
#ifdef USE_BLT
extern PRIMITIVE STk_init_blt(void);
#endif
#ifdef USE_REGEXP
extern PRIMITIVE STk_init_sregexp(void);
#endif
#ifdef USE_PROCESS
extern PRIMITIVE STk_init_process(void);
#endif
#ifdef USE_POSIX
extern PRIMITIVE STk_init_posix(void);
#endif
#ifdef USE_HTML
extern PRIMITIVE STk_init_html(void);
#endif
#ifdef USE_PIXMAP
extern PRIMITIVE STk_init_pixmap(void);
#endif
#ifdef USE_JPEG
extern PRIMITIVE STk_init_jpeg(void);
#endif
#ifdef USE_BASE64
extern PRIMITIVE STk_init_base64(void);
#endif
#ifdef USE_LOCALE
extern PRIMITIVE STk_init_locale(void);
#endif
#ifdef DEBUG_STK
static PRIMITIVE STk_test_proc(SCM l, int len)
{
/* This procedure is a placeholder to make tests from the Scheme prompt */
/* It does not appear in a non debug interpreter */
return UNDEFINED;
}
#endif
static struct Primitive Scheme_primitives[] = {
/**** Section 4.1 ****/
{"quote", tc_syntax, STk_syntax_quote},
{"lambda", tc_syntax, STk_syntax_lambda},
{"if", tc_syntax, STk_syntax_if},
{"set!", tc_syntax, STk_syntax_setq},
/**** Section 4.2 ****/
{"cond", tc_syntax, STk_syntax_cond},
{"and", tc_syntax, STk_syntax_and},
{"or", tc_syntax, STk_syntax_or},
{"let", tc_syntax, STk_syntax_let},
{"let*", tc_syntax, STk_syntax_letstar},
{"letrec", tc_syntax, STk_syntax_letrec},
{"begin", tc_syntax, STk_syntax_begin},
{"delay", tc_syntax, STk_syntax_delay},
{"quasiquote", tc_syntax, STk_syntax_quasiquote},
{"while", tc_fsubr, STk_while},
{"until", tc_fsubr, STk_until},
{"extend-environment", tc_syntax, STk_syntax_extend_env}, /* + */
/**** Section 5 ****/
{"define", tc_syntax, STk_syntax_define},
/**** Section 6.1 ****/
{"boolean?", tc_subr_1, STk_booleanp},
{"not", tc_subr_1, STk_not},
/**** Section 6.2 ****/
{"eq?", tc_subr_2, STk_eq},
{"eqv?", tc_subr_2, STk_eqv},
{"equal?", tc_subr_2, STk_equal},
/**** Section 6.3 ****/
{"pair?", tc_subr_1, STk_pairp},
{"cons", tc_subr_2, STk_cons},
{"car", tc_subr_1, STk_car},
{"cdr", tc_subr_1, STk_cdr},
{"set-car!", tc_subr_2, STk_setcar},
{"set-cdr!", tc_subr_2, STk_setcdr},
{"caar", tc_subr_1, STk_caar},
{"cdar", tc_subr_1, STk_cdar},
{"cadr", tc_subr_1, STk_cadr},
{"cddr", tc_subr_1, STk_cddr},
{"caaar", tc_subr_1, STk_caaar},
{"cdaar", tc_subr_1, STk_cdaar},
{"cadar", tc_subr_1, STk_cadar},
{"cddar", tc_subr_1, STk_cddar},
{"caadr", tc_subr_1, STk_caadr},
{"cdadr", tc_subr_1, STk_cdadr},
{"caddr", tc_subr_1, STk_caddr},
{"cdddr", tc_subr_1, STk_cdddr},
{"caaaar", tc_subr_1, STk_caaaar},
{"cdaaar", tc_subr_1, STk_cdaaar},
{"cadaar", tc_subr_1, STk_cadaar},
{"cddaar", tc_subr_1, STk_cddaar},
{"caadar", tc_subr_1, STk_caadar},
{"cdadar", tc_subr_1, STk_cdadar},
{"caddar", tc_subr_1, STk_caddar},
{"cdddar", tc_subr_1, STk_cdddar},
{"caaadr", tc_subr_1, STk_caaadr},
{"cdaadr", tc_subr_1, STk_cdaadr},
{"cadadr", tc_subr_1, STk_cadadr},
{"cddadr", tc_subr_1, STk_cddadr},
{"caaddr", tc_subr_1, STk_caaddr},
{"cdaddr", tc_subr_1, STk_cdaddr},
{"cadddr", tc_subr_1, STk_cadddr},
{"cddddr", tc_subr_1, STk_cddddr},
{"null?", tc_subr_1, STk_nullp},
{"list?", tc_subr_1, STk_listp},
{"list", tc_lsubr, STk_list},
{"length", tc_subr_1, STk_list_length},
{"append", tc_lsubr, STk_append},
{"reverse", tc_subr_1, STk_reverse},
{"list-tail", tc_subr_2, STk_list_tail},
{"list-ref", tc_subr_2, STk_list_ref},
{"memq", tc_subr_2, STk_memq},
{"memv", tc_subr_2, STk_memv},
{"member", tc_subr_2, STk_member},
{"assq", tc_subr_2, STk_assq},
{"assv", tc_subr_2, STk_assv},
{"assoc", tc_subr_2, STk_assoc},
{"list*", tc_lsubr, STk_liststar}, /* + */
{"copy-tree", tc_subr_1, STk_copy_tree}, /* + */
{"last-pair", tc_subr_1, STk_last_pair}, /* + */
{"remq", tc_subr_2, STk_remq}, /* + */
{"remv", tc_subr_2, STk_remv}, /* + */
{"remove", tc_subr_2, STk_remove}, /* + */
{"append!", tc_lsubr, STk_dappend}, /* + */
/**** Section 6.4 ****/
{"symbol?", tc_subr_1, STk_symbolp},
{"symbol->string", tc_subr_1, STk_symbol2string},
{"string->symbol", tc_subr_1, STk_string2symbol},
{"string->uninterned-symbol", /* + */
tc_subr_1, STk_string2usymbol},
/**** Section 6.5 ****/
{"number?", tc_subr_1, STk_numberp},
{"complex?", tc_subr_1, STk_numberp},
{"real?", tc_subr_1, STk_numberp},
{"rational?", tc_subr_1, STk_numberp},
{"integer?", tc_subr_1, STk_integerp},
{"exact?", tc_subr_1, STk_exactp},
{"inexact?", tc_subr_1, STk_inexactp},
{"=", tc_ssubr, STk_numequal},
{"<", tc_ssubr, STk_lessp},
{">", tc_ssubr, STk_greaterp},
{"<=", tc_ssubr, STk_lessep},
{">=", tc_ssubr, STk_greaterep},
{"zero?", tc_subr_1, STk_zerop},
{"negative?", tc_subr_1, STk_negativep},
{"positive?", tc_subr_1, STk_positivep},
{"odd?", tc_subr_1, STk_oddp},
{"even?", tc_subr_1, STk_evenp},
{"max", tc_ssubr, STk_max},
{"min", tc_ssubr, STk_min},
{"+", tc_ssubr, STk_plus},
{"-", tc_ssubr, STk_difference},
{"*", tc_ssubr, STk_times},
{"/", tc_ssubr, STk_division},
{"abs", tc_subr_1, STk_absolute},
{"quotient", tc_subr_2, STk_quotient},
{"remainder", tc_subr_2, STk_remainder},
{"modulo", tc_subr_2, STk_modulo},
{"gcd", tc_ssubr, STk_gcd},
{"lcm", tc_ssubr, STk_lcm},
{"floor", tc_subr_1, STk_floor},
{"ceiling", tc_subr_1, STk_ceiling},
{"truncate", tc_subr_1, STk_truncate},
{"round", tc_subr_1, STk_round},
{"exp", tc_subr_1, STk_exp},
{"log", tc_subr_1, STk_log},
{"sin", tc_subr_1, STk_sin},
{"cos", tc_subr_1, STk_cos},
{"tan", tc_subr_1, STk_tan},
{"asin", tc_subr_1, STk_asin},
{"acos", tc_subr_1, STk_acos},
{"atan", tc_subr_1_or_2, STk_atan},
{"sqrt", tc_subr_1, STk_sqrt},
{"expt", tc_subr_2, STk_expt},
{"exact->inexact", tc_subr_1, STk_exact2inexact},
{"inexact->exact", tc_subr_1, STk_inexact2exact},
{"string->number", tc_subr_1_or_2, STk_string2number},
{"number->string", tc_subr_1_or_2, STk_number2string},
{"bignum?", tc_subr_1, STk_bignump}, /* + */
/**** Section 6.6 ****/
{"char?", tc_subr_1, STk_charp},
{"char=?", tc_subr_2, STk_chareq},
{"char<?", tc_subr_2, STk_charless},
{"char>?", tc_subr_2, STk_chargt},
{"char<=?", tc_subr_2, STk_charlesse},
{"char>=?", tc_subr_2, STk_chargte},
{"char-ci=?", tc_subr_2, STk_chareqi},
{"char-ci<?", tc_subr_2, STk_charlessi},
{"char-ci>?", tc_subr_2, STk_chargti},
{"char-ci<=?", tc_subr_2, STk_charlessei},
{"char-ci>=?", tc_subr_2, STk_chargtei},
{"char-alphabetic?", tc_subr_1, STk_char_alphap},
{"char-numeric?", tc_subr_1, STk_char_numericp},
{"char-whitespace?", tc_subr_1, STk_char_whitep},
{"char-upper-case?", tc_subr_1, STk_char_upperp},
{"char-lower-case?", tc_subr_1, STk_char_lowerp},
{"integer->char", tc_subr_1, STk_integer2char},
{"char->integer", tc_subr_1, STk_char2integer},
{"char-upcase", tc_subr_1, STk_char_upper},
{"char-downcase", tc_subr_1, STk_char_lower},
/**** Section 6.7 ****/
{"string?", tc_subr_1, STk_stringp},
{"make-string", tc_subr_1_or_2, STk_make_string},
{"string", tc_lsubr, STk_lstring},
{"string-length", tc_subr_1, STk_string_length},
{"string-ref", tc_subr_2, STk_string_ref},
{"string-set!", tc_subr_3, STk_string_set},
{"string=?", tc_subr_2, STk_streq},
{"string<?", tc_subr_2, STk_strless},
{"string>?", tc_subr_2, STk_strgt},
{"string<=?", tc_subr_2, STk_strlesse},
{"string>=?", tc_subr_2, STk_strgte},
{"string-ci=?", tc_subr_2, STk_streqi},
{"string-ci<?", tc_subr_2, STk_strlessi},
{"string-ci>?", tc_subr_2, STk_strgti},
{"string-ci<=?", tc_subr_2, STk_strlessei},
{"string-ci>=?", tc_subr_2, STk_strgtei},
{"substring", tc_subr_3, STk_substring},
{"string-append", tc_lsubr, STk_string_append},
{"string->list", tc_subr_1, STk_string2list},
{"list->string", tc_subr_1, STk_list2string},
{"string-copy", tc_subr_1, STk_string_copy},
{"string-fill!", tc_subr_2, STk_string_fill},
{"string-find?", tc_subr_2, STk_string_findp}, /* + */
{"string-index", tc_subr_2, STk_string_index}, /* + */
{"string-lower", tc_subr_1, STk_string_lower}, /* + */
{"string-upper", tc_subr_1, STk_string_upper}, /* + */
{"split-string", tc_subr_1_or_2, STk_split_string}, /* + */
/**** Section 6.8 ****/
{"vector?", tc_subr_1, STk_vectorp},
{"make-vector", tc_subr_1_or_2, STk_make_vector},
{"vector", tc_lsubr, STk_vector},
{"vector-length", tc_subr_1, STk_vector_length},
{"vector-ref", tc_subr_2, STk_vector_ref},
{"vector-set!", tc_subr_3, STk_vector_set},
{"vector->list", tc_subr_1, STk_vector2list},
{"list->vector", tc_subr_1, STk_list2vector},
{"vector-fill!", tc_subr_2, STk_vector_fill},
{"vector-copy", tc_subr_1, STk_vector_copy}, /* + */
{"vector-resize", tc_subr_2, STk_vector_resize}, /* + */
/**** Section 6.9 ****/
{"procedure?", tc_subr_1, STk_procedurep},
{"apply", tc_apply, NULL},
{"map", tc_lsubr, STk_map},
{"for-each", tc_lsubr, STk_for_each},
{"force", tc_subr_1, STk_force},
{"call-with-current-continuation",
tc_call_cc, NULL},
{"values", tc_lsubr, STk_values},
{"call-with-values", tc_subr_2, STk_call_with_values},
{"promise?", tc_subr_1, STk_promisep}, /* + */
{"continuation?", tc_subr_1, STk_continuationp}, /* + */
{"dynamic-wind", tc_subr_3, STk_dynamic_wind}, /* + */
{"catch", tc_fsubr, STk_catch}, /* + */
{"procedure-body", tc_subr_1, STk_procedure_body}, /* + */
/**** Section 6.10 ****/
{"input-port?", tc_subr_1, STk_input_portp},
{"output-port?", tc_subr_1, STk_output_portp},
{"current-input-port", tc_subr_0, STk_current_input_port},
{"current-output-port", tc_subr_0, STk_current_output_port},
{"with-input-from-file", tc_subr_2, STk_with_input_from_file},
{"with-output-to-file", tc_subr_2, STk_with_output_to_file},
{"open-input-file", tc_subr_1, STk_open_input_file},
{"open-output-file", tc_subr_1, STk_open_output_file},
{"close-input-port", tc_subr_1, STk_close_input_port},
{"close-output-port", tc_subr_1, STk_close_output_port},
{"read", tc_subr_0_or_1, STk_read},
{"read-char", tc_subr_0_or_1, STk_read_char},
{"peek-char", tc_subr_0_or_1, STk_peek_char},
{"eof-object?", tc_subr_1, STk_eof_objectp},
{"char-ready?", tc_subr_0_or_1, STk_char_readyp},
{"write", tc_subr_1_or_2, STk_write},
{"display", tc_subr_1_or_2, STk_display},
{"newline", tc_subr_0_or_1, STk_newline},
{"write-char", tc_subr_1_or_2, STk_write_char},
{"load", tc_subr_1_or_2, STk_load},
{"input-file-port?", tc_subr_1, STk_input_file_portp}, /* + */
{"output-file-port?", tc_subr_1, STk_output_file_portp}, /* + */
{"with-input-from-port", tc_subr_2, STk_with_input_from_port}, /* + */
{"with-output-to-port", tc_subr_2, STk_with_output_to_port}, /* + */
{"with-error-to-port", tc_subr_2, STk_with_error_to_port}, /* + */
{"open-file", tc_subr_2, STk_open_file}, /* + */
{"close-port", tc_subr_1, STk_close_port}, /* + */
{"port-closed?", tc_subr_1, STk_port_closedp}, /* + */
{"read-line", tc_subr_0_or_1, STk_read_line}, /* + */
{"copy-port", tc_subr_2, STk_copy_port}, /* + */
{"flush", tc_subr_0_or_1, STk_flush}, /* + */
{"try-load", tc_subr_1_or_2, STk_try_load}, /* + */
{"autoload", tc_fsubr, STk_autoload}, /* + */
{"autoload?", tc_subr_1_or_2, STk_autoloadp}, /* + */
#if defined(USE_TK) && !defined(WIN32)
{"when-port-readable", tc_subr_1_or_2, STk_when_port_readable}, /* + */
{"when-port-writable", tc_subr_1_or_2, STk_when_port_writable}, /* + */
#endif
{"format", tc_lsubr, STk_format}, /* + */
{"error", tc_lsubr, STk_error}, /* + */
{"write*", tc_subr_1_or_2, STk_write_star}, /* + */
{"input-string-port?", tc_subr_1, STk_input_string_portp}, /* + */
{"output-string-port?", tc_subr_1, STk_output_string_portp}, /* + */
{"with-error-to-file", tc_subr_2, STk_with_error_to_file}, /* + */
{"current-error-port", tc_subr_0, STk_current_error_port}, /* + */
{"open-input-string", tc_subr_1, STk_open_input_string}, /* + */
{"open-output-string", tc_subr_0, STk_open_output_string}, /* + */
{"get-output-string", tc_subr_1, STk_get_output_string}, /* + */
{"with-input-from-string",tc_subr_2, STk_with_input_from_string},/* + */
{"with-output-to-string", tc_subr_1, STk_with_output_to_string}, /* + */
{"with-error-to-string", tc_subr_1, STk_with_error_to_string}, /* + */
{"read-from-string", tc_subr_1, STk_read_from_string}, /* + */
{"open-input-virtual", tc_lsubr, STk_open_input_virtual}, /* + */
{"open-output-virtual", tc_lsubr, STk_open_output_virtual}, /* + */
{"input-virtual-port?", tc_subr_1, STk_input_virtual_portp}, /* + */
{"output-virtual-port?", tc_subr_1, STk_output_virtual_portp}, /* + */
/**** Section 6.11 ****/
{"keyword?", tc_subr_1, STk_keywordp}, /* + */
{"make-keyword", tc_subr_1, STk_make_keyword}, /* + */
{"keyword->string", tc_subr_1, STk_keyword2string}, /* + */
{"get-keyword", tc_subr_2_or_3, STk_get_keyword}, /* + */
/**** Section 6.12 ****/
#ifdef USE_TK
{"widget->string", tc_subr_1, STk_widget2string}, /* + */
{"string->widget", tc_subr_1, STk_string2widget}, /* + */
{"tk-command?", tc_subr_1, STk_tk_commandp}, /* + */
{"widget-name", tc_subr_1, STk_widget_name}, /* + */
{"get-widget-data", tc_subr_1, STk_get_widget_data}, /* + */
{"set-widget-data!", tc_subr_2, STk_set_widget_data}, /* + */
#endif
/**** Section 6.13 ****/
{"environment?", tc_subr_1, STk_environmentp}, /* + */
{"the-environment", tc_fsubr, STk_the_environment}, /* + */
{"parent-environment", tc_subr_1, STk_parent_environment}, /* + */
{"global-environment", tc_subr_0, STk_global_environment}, /* + */
{"environment->list", tc_subr_1, STk_environment2list}, /* + */
{"procedure-environment", tc_subr_1, STk_procedure_environment}, /* + */
{"symbol-bound?", tc_subr_1_or_2, STk_symbol_boundp}, /* + */
{"eval", tc_subr_1_or_2, STk_user_eval}, /* + */
{"eval-hook", tc_subr_3, STk_eval_hook}, /* + */
{"define-module", tc_fsubr, STk_define_module}, /* + */
{"module?", tc_subr_1, STk_modulep}, /* + */
{"with-module", tc_fsubr, STk_with_module}, /* + */
{"import", tc_fsubr, STk_import}, /* + */
{"export-symbol", tc_subr_2, STk_export_symbol}, /* + */
{"export-all-symbols", tc_subr_0, STk_export_all_symbols}, /* + */
{"select-module", tc_fsubr, STk_select_module}, /* + */
{"current-module", tc_fsubr, STk_current_module}, /* + */
{"find-module", tc_subr_1_or_2, STk_find_module}, /* + */
{"module-name", tc_subr_1, STk_module_name}, /* + */
{"module-imports", tc_subr_1, STk_module_imports}, /* + */
{"module-exports", tc_subr_1, STk_module_exports}, /* + */
{"module-environment", tc_subr_1, STk_module_env}, /* + */
{"module-symbols", tc_subr_1, STk_module_symbols}, /* + */
{"all-modules", tc_subr_0, STk_all_modules}, /* + */
{"%get-module", tc_subr_1, STk_get_module}, /* Undoc */
/**** Section 6.14 ****/
{"macro", tc_fsubr, STk_macro}, /* + */
{"macro?", tc_subr_1, STk_macrop}, /* + */
{"macro-expand", tc_fsubr, STk_macro_expand}, /* + */
{"macro-expand-1", tc_fsubr, STk_macro_expand_1}, /* + */
{"macro-body", tc_subr_1, STk_macro_body}, /* + */
{"%macro-r5", tc_fsubr, STk_macro_R5}, /* Undoc */
/**** Section 6.15 ****/
{"address-of", tc_subr_1, STk_address_of}, /* + */
{"address?", tc_subr_1, STk_addressp}, /* + */
/**** Section 6.16 ****/
{"set-signal-handler!", tc_subr_2, STk_set_signal_handler}, /* + */
{"add-signal-handler!", tc_subr_2, STk_add_signal_handler}, /* + */
{"get-signal-handlers", tc_subr_0_or_1, STk_get_signal_handlers}, /* + */
{"send-signal", tc_subr_1, STk_send_signal}, /* + */
/**** Section 6.17 ****/
{"getcwd", tc_subr_0, STk_getcwd}, /* + */
{"chdir", tc_subr_1, STk_chdir}, /* + */
{"getpid", tc_subr_0, STk_getpid}, /* + */
{"expand-file-name", tc_subr_1, STk_expand_file_name}, /* + */
{"canonical-path", tc_subr_1, STk_canonical_path}, /* + */
{"system", tc_subr_1, STk_system}, /* + */
{"getenv", tc_subr_1, STk_getenv}, /* + */
{"setenv!", tc_subr_2, STk_setenv}, /* + */
{"file-is-directory?", tc_subr_1, STk_file_is_directoryp}, /* + */
{"file-is-regular?", tc_subr_1, STk_file_is_regularp}, /* + */
{"file-is-readable?", tc_subr_1, STk_file_is_readablep}, /* + */
{"file-is-writable?", tc_subr_1, STk_file_is_writablep}, /* + */
{"file-is-executable?", tc_subr_1, STk_file_is_executablep}, /* + */
{"file-exists?", tc_subr_1, STk_file_existp}, /* + */
{"glob", tc_lsubr, STk_file_glob}, /* + */
{"remove-file", tc_subr_1, STk_remove_file}, /* + */
{"rename-file", tc_subr_2, STk_rename_file}, /* + */
{"temporary-file-name", tc_subr_0, STk_temporary_file_name}, /* + */
/**** Section 6.23 (FFI) ****/
{"%call-external", tc_lsubr, STk_call_external}, /* Undoc */
{"%external-exists?", tc_subr_2, STk_external_existsp}, /* Undoc */
{"c-string->string", tc_subr_1, STk_cstring2string}, /* + */
/**** Section 6.24 (Misc) ****/
{"eval-string", tc_subr_1_or_2, STk_eval_string}, /* + */
{"gc", tc_subr_0, STk_gc}, /* + */
{"gc-stats", tc_subr_0, STk_gc_stats}, /* + */
{"expand-heap", tc_subr_1, STk_expand_heap}, /* + */
{"version", tc_subr_0, STk_version}, /* + */
{"machine-type", tc_subr_0, STk_machine_type}, /* + */
{"random", tc_subr_1, STk_random}, /* + */
{"set-random-seed!", tc_subr_1, STk_set_random_seed}, /* + */
{"sort", tc_subr_2, STk_sort}, /* + */
{"dump", tc_subr_1, STk_dump}, /* + */
{"get-internal-info", tc_subr_0, STk_get_internal_info}, /* + */
{"time", tc_fsubr, STk_time}, /* + */
{"uncode", tc_subr_1, STk_uncode}, /* + */
{"exit", tc_subr_0_or_1, STk_quit_interpreter}, /* + */
#ifdef USE_TK
{"trace-var", tc_subr_2, STk_trace_var}, /* + */
{"untrace-var", tc_subr_1, STk_untrace_var}, /* + */
#endif
/**** Undocumented primitives */
{"%get-eval-stack", tc_subr_0, STk_user_get_eval_stack}, /* Undoc */
{"%get-environment-stack",tc_subr_0, STk_get_env_stack}, /* Undoc */
{"%library-location", tc_subr_0, STk_library_location}, /* Undoc */
{"%procedure-arity", tc_subr_1, STk_procedure_arity}, /* Undoc */
{"%get-selected-module", tc_subr_0, STk_get_selected_module}, /* Undoc */
#ifdef USE_TK
{"%change-standard-ports",tc_subr_3, STk_change_standard_ports}, /* Undoc */
#endif
#ifdef DEBUG_STK
{"%find-cells", tc_subr_1, STk_find_cells}, /* for debug */
{"%get-environment", tc_subr_1, STk_get_environment},/* for debug */
{"%test-proc", tc_lsubr, STk_test_proc}, /* for debug */
#endif
#ifdef USE_STKLOS
{"%init-stklos", tc_subr_0, STk_init_STklos},
#endif
#ifdef USE_HASH
{"%init-hash", tc_subr_0, STk_init_hash},
#endif
#ifdef USE_SOCKET
{"%init-socket", tc_subr_0, STk_init_socket},
#endif
#ifdef USE_BLT
{"%init-blt", tc_subr_0, STk_init_blt},
#endif
#ifdef USE_REGEXP
{"%init-regexp", tc_subr_0, STk_init_sregexp},
#endif
#ifdef USE_PROCESS
{"%init-process", tc_subr_0, STk_init_process},
#endif
#ifdef USE_POSIX
{"%init-posix", tc_subr_0, STk_init_posix},
#endif
#ifdef USE_HTML
{"%init-html", tc_subr_0, STk_init_html},
#endif
#if defined(USE_TK) && defined(USE_PIXMAP)
{"%init-pixmap", tc_subr_0, STk_init_pixmap},
#endif
#if defined(USE_TK) && defined(USE_JPEG)
{"%init-jpeg", tc_subr_0, STk_init_jpeg},
#endif
#ifdef USE_BASE64
{"%init-base64", tc_subr_0, STk_init_base64},
#endif
#ifdef USE_locale
{"%init-locale", tc_subr_0, STk_init_locale},
#endif
{ "", 0, (SCM (*)()) NULL }
};
void STk_init_primitives(void)
{
register struct Primitive *p;
register SCM var, z;
for (p = Scheme_primitives; *p->name; p++) {
/* Create a subr cell and store it in both the STk and Scheme modules */
NEWCELL(z, p->type);
z->storage_as.subr.name = p->name;
z->storage_as.subr0.f = p->fct;
/* Normal calls should be
* STk_define_variable(p->name, z, STk_scheme_module);
* STk_define_variable(p->name, z, NIL);
* but it sucks; use low level access instead.
*/
var = Intern(p->name);
STk_define_public_var(STk_scheme_module, var, z);
VCELL(var) = z;
}
}
Reference in New Issue View Git Blame Copy Permalink