summaryrefslogtreecommitdiff
path: root/libguile/gscm.h
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/gscm.h')
-rw-r--r--libguile/gscm.h297
1 files changed, 297 insertions, 0 deletions
diff --git a/libguile/gscm.h b/libguile/gscm.h
new file mode 100644
index 000000000..c6ac44b5f
--- /dev/null
+++ b/libguile/gscm.h
@@ -0,0 +1,297 @@
+/* classes: h_files */
+
+#ifndef GSCMH
+#define GSCMH
+
+/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING. If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE. If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way. To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+
+#include "libguile.h"
+
+
+/* {Locking Out Async Execution (including async GC) and Non-Local Exits}
+ */
+
+#define GSCM_DEFER_INTS SCM_DEFER_INTS
+#define GSCM_ALLOW_INTS SCM_ALLOW_INTS
+
+
+/* {Common Constants}
+ */
+
+#define GSCM_EOL SCM_EOL
+#define GSCM_FALSE SCM_BOOL_F
+#define GSCM_TRUE SCM_BOOL_T
+
+#define GSCM_EOL_MARKER SCM_UNDEFINED
+#define GSCM_NOT_PASSED SCM_UNDEFINED
+#define GSCM_UNSPECIFIED SCM_UNSPECIFIED
+
+
+/* {Booleans}
+ */
+
+#define gscm_bool(CBOOL) ((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F)
+#define gscm_2_bool(BOOL) (((BOOL) == SCM_BOOL_F) ? 0 : 1)
+
+
+/* {Numbers}
+ */
+
+#define gscm_ulong scm_ulong2num
+#define gscm_long scm_long2num
+#define gscm_double(X) scm_makdbl ((X), 0.0)
+
+#define gscm_2_ulong(OBJ) scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong")
+#define gscm_2_long(OBJ) scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long")
+#define gscm_2_double(OBJ) scm_num2dbl((OBJ), "gscm_2_double")
+
+
+/* {Characters}
+ */
+
+#define gscm_char(C) SCM_MAKICHR(C)
+/* extern int gscm_2_char P((SCM)); */
+
+
+/* {Strings}
+ */
+
+#define gscm_str(SRC, LEN) scm_makfromstr (SRC, LEN, 0)
+#define gscm_str0 scm_makfrom0str
+
+
+
+/* {Pairs and Lists}
+ */
+
+#define gscm_cons scm_cons
+#define gscm_list scm_listify
+#define gscm_ilength scm_ilength
+
+
+#define gscm_set_car(OBJ, VAL) \
+ ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
+ ? (SCM_CAR(OBJ) = VAL) \
+ : scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!"))
+
+#define gscm_set_cdr(OBJ, VAL) \
+ ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
+ ? (SCM_CDR(OBJ) = VAL) \
+ : scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!"))
+
+
+#define GSCM_SAFE_CAR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \
+ ? SCM_CAR(X) \
+ : scm_wta ((X), (char *)SCM_ARG1, "car"))
+
+#define GSCM_SAFE_CDR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \
+ ? SCM_CDR(X) \
+ : scm_wta ((X), (char *)SCM_ARG1, "cdr"))
+
+#define gscm_car(OBJ) GSCM_SAFE_CAR (OBJ)
+#define gscm_cdr(OBJ) GSCM_SAFE_CDR (OBJ)
+
+#define gscm_caar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))
+#define gscm_cdar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))
+#define gscm_cadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))
+#define gscm_cddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))
+
+#define gscm_caaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cdaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_caadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_cdadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_caddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_cdddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
+
+#define gscm_caaaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdaaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cadaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cddaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdadar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caddar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caaadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cdaadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cadadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cddadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_caaddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cdaddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cadddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cddddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+
+
+/* {Symbols}
+ */
+
+#define gscm_symbol(STR, LEN) SCM_CAR(scm_intern (STR, LEN))
+#define gscm_tmp_symbol(STR, LEN) SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F))
+
+
+/* {Vectors}
+ */
+
+#define gscm_vector(N, FILL) scm_make_vector (SCM_MAKINUM(N), (FILL), SCM_UNDEFINED)
+#define gscm_vref(V, I) scm_vector_ref ((V), SCM_MAKINUM(I))
+#define gscm_vset(V, I, VAL) scm_vector_set_x ((V), SCM_MAKINUM(I), (VAL))
+
+
+/* {Procedures}
+ */
+
+/* extern SCM gscm_make_subr P((SCM (*fn)(), int req, int opt, int varp, char * doc)); */
+/* extern SCM gscm_curry P((SCM procedure, SCM first_arg)); */
+
+#define gscm_apply(PROC, ARGS) scm_apply ((PROC), (ARGS), SCM_EOL)
+
+
+
+/* {Non-local Exits}
+ */
+
+
+#define gscm_catch(T, TH, H) scm_catch ((T), (TH), (H))
+#define gscm_throw(T, V) scm_throw ((T), (V))
+#define gscm_dynamic_wind(E, T, L) scm_dynwind ((E), (T), (L))
+/* extern void gscm_error P((char * message, SCM args)); */
+
+
+/* {I/O}
+ */
+
+#define gscm_print_obj scm_iprin1
+#define gscm_putc scm_putc
+#define gscm_puts scm_puts
+#define gscm_fwrite scm_fwrite
+#define gscm_flush scm_flush
+
+extern char * gscm_last_attempted_init_file;
+
+/* {Equivalence}
+ */
+
+
+#define gscm_is_eq(OBJ) (SCM_BOOL_F != scm_eq (OBJ))
+#define gscm_is_eqv(OBJ) (SCM_BOOL_F != scm_eqv (OBJ))
+#define gscm_is_equal(OBJ) (SCM_BOOL_F != scm_equal_p (OBJ))
+
+
+/* {Procedure Properties}
+ */
+
+#define gscm_procedure_properties scm_procedure_properties
+#define gscm_set_procedure_properties_x scm_set_procedure_properties_x
+#define gscm_procedure_property scm_procedure_property
+#define gscm_set_procedure_property_x scm_set_procedure_property_x
+
+
+/* {Generic Length Procedure}
+ */
+
+#define gscm_obj_length scm_obj_length
+
+
+/* {Proc Declaration Macro}
+ */
+#ifndef GSCM_MAGIC_SNARFER
+#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \
+ static char RANAME[]=STR;
+#else
+#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \
+%%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "")
+#endif
+
+#define gscm_define_procedure(NAME, FN, REQ, OPT, VARP, DOC) scm_make_gsubr(name, req, opt, varp, fn)
+#define gscm_curry scm_curry
+#define gscm_define scm_sysintern
+
+
+typedef int GSCM_top_level;
+
+
+/* {Error Returns}
+ */
+
+typedef int GSCM_status;
+
+#define GSCM_OK 0
+#define GSCM_ERROR 1
+#define GSCM_ILLEGALLY_REENTERED 2
+#define GSCM_OUT_OF_MEM 3
+#define GSCM_ERROR_OPENING_FILE 4
+#define GSCM_ERROR_OPENING_INIT_FILE 5
+
+
+
+#ifdef __STDC__
+extern GSCM_status gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str);
+extern GSCM_status gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name);
+extern GSCM_status gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str);
+extern GSCM_status gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name);
+extern GSCM_status gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd);
+extern char * gscm_error_msg (int n);
+extern SCM gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc);
+extern int gscm_2_char (SCM c);
+extern void gscm_2_str (char ** out, int * len_out, SCM * objp);
+extern void gscm_error (char * message, SCM args);
+extern void scm_init_guile (void);
+
+#else /* STDC */
+extern GSCM_status gscm_seval_str ();
+extern void format_load_command ();
+extern GSCM_status gscm_seval_file ();
+extern GSCM_status gscm_eval_str ();
+extern GSCM_status gscm_eval_file ();
+extern char * gscm_error_msg ();
+extern SCM gscm_make_subr ();
+extern int gscm_2_char ();
+extern void gscm_2_str ();
+extern void gscm_error ();
+extern GSCM_status gscm_run_scm ();
+extern void scm_init_guile ();
+
+#endif /* STDC */
+#endif /* GSCMH */
+