[bpt/guile.git] / libguile / scmhob.h

/* This was modified to try out compiling with Guile. */


/*   scmhob.h is a header file for scheme source compiled with hobbit4d
     Copyright (C) 1992, 1993, 1994, 1995 Tanel Tammet 

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 1, 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 program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/


#include <stdio.h>
#include <ctype.h>
#include "_scm.h"

\f

#define abrt 			scm_abort
#define absval 			scm_abs
#define angle			scm_angle
#define append			scm_append
#define assoc			scm_assoc
#define assq			scm_assq
#define assv			scm_assv
#define big2dbl			scm_big2dbl
#define close_port		scm_close_port
#define cons			scm_cons
#define cur_input_port		scm_current_input_port
#define cur_output_port		scm_current_output_port
#define difference		scm_difference
#define display			scm_display
#define divide			scm_divide
#define eof_objectp		scm_eof_object_p
#define eqp			scm_eq_p
#define equal			scm_equal_p
#define eqv			scm_eqv_p
#define evenp			scm_even_p
#define exactp			scm_exact_p
#define greaterp		scm_gr_p
#define greqp			scm_geq_p
#define imag_part		scm_imag_part
#define in2ex			scm_inexact_to_exact
#define inexactp		scm_inexact_p
#define input_portp		scm_input_port_p
#define intp			scm_int_p
#define length			scm_length
#define leqp			scm_leq_p
#define lessp			scm_less_p
#define lgcd			scm_gcd
#define list_ref		scm_list_ref
#define list_tail		scm_list_tail
#define listp			scm_list_p
#define llcm			scm_lcm
#define lmax			scm_max
#define lmin			scm_min
#define lquotient		scm_quotient
#define lread(X)		scm_read((X), SCM_UNDEFINED)
#define lremainder		scm_remainder
#define lwrite			scm_write
#define magnitude		scm_magnitude
#define makcclo			scm_makcclo
#define makdbl			scm_makdbl
#define make_string		scm_make_string
#define make_vector		scm_make_vector
#define makpolar		scm_make_polar
#define makrect			scm_make_rectangular
#define member			scm_member
#define memq			scm_memq
#define memv			scm_memv
#define modulo			scm_modulo
#define my_time			scm_get_internal_run_time
#define negativep		scm_negative_p
#define newline			scm_newline
#define number2string		scm_number_to_string
#define oddp			scm_odd_p
#define open_file		scm_open_file
#define output_portp		scm_output_port_p
#define peek_char		scm_peek_char
#define positivep		scm_positive_p
#define procedurep		scm_procedure_p
#define product			scm_product
#define quit			scm_quit
#define read_char		scm_read_char
#define real_part		scm_real_part
#define realp			scm_real_p
#define reverse			scm_reverse
#define set_inp			scm_set_current_input_port
#define set_outp		scm_set_current_output_port
#define st_append		scm_string_append
#define st_equal		scm_string_equal_p
#define st_leqp			scm_string_leq_p
#define st_lessp		scm_string_less_p
#define st_set			scm_string_set_x
#define stci_equal		scm_string_ci_equal_p
#define stci_leqp		scm_string_ci_leq_p
#define stci_lessp		scm_string_ci_less_p
#define string			scm_string
#define string2list		scm_string_to_list
#define string2number		scm_string_to_number
#define string2symbol		scm_string_to_symbol
#define string_copy		scm_string_copy
#define string_fill		scm_string_fill_x
#define substring		scm_substring
#define sum			scm_sum
#define symbol2string		scm_symbol_to_string
#define vector			scm_vector
#define vector2list		scm_vector_to_list
#define vector_ref		scm_vector_ref
#define vector_set		scm_vector_set_x
#define write_char		scm_write_char
#define zerop			scm_zero_p
			
\f

#define STBL_VECTOR_SET(v,k,o) (v[((long)SCM_INUM(k))] = o)
#define STBL_VECTOR_REF(v,k) (v[((long)SCM_INUM(k))])
#define CHAR_LESSP(x,y) ((SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_LEQP(x,y) ((SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHCI_EQ(x,y) ((upcase[SCM_ICHR(x)]==upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHCI_LESSP(x,y) ((upcase[SCM_ICHR(x)] < upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHCI_LEQP(x,y) ((upcase[SCM_ICHR(x)] <= upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_ALPHAP(chr) ((isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_SCM_NUMP(chr) ((isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_WHITEP(chr) ((isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_UPPERP(chr) ((isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR_LOWERP(chr) ((isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
#define CHAR2INT(chr) SCM_MAKINUM(SCM_ICHR(chr))
#define INT2CHAR(n) SCM_MAKICHR(SCM_INUM(n))
#define CHAR_UPCASE(chr) SCM_MAKICHR(upcase[SCM_ICHR(chr)])
#define CHAR_DOWNCASE(chr) SCM_MAKICHR(downcase[SCM_ICHR(chr)])
#define ST_SCM_LENGTH(str) SCM_MAKINUM(SCM_LENGTH(str))
#define ST_REF(str,k) SCM_MAKICHR(SCM_CHARS(str)[SCM_INUM(k)])
#define VECTOR_SCM_LENGTH(v)  SCM_MAKINUM(SCM_LENGTH(v))

#ifdef SCM_FLOATS
#include <math.h>
#endif
#ifdef SCM_BIGDIG
#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ? (double) SCM_INUM(x) : (SCM_REALP(x) ? (double) SCM_REALPART(x) : (double) big2dbl(x)))
#else
#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ?  (double) SCM_INUM(x) : (double) SCM_REALPART(x))
#endif

#define SIN_FUN(x) (makdbl( sin( PRE_TRANSC_FUN(x)), 0.0))
#define COS_FUN(x) (makdbl( cos( PRE_TRANSC_FUN(x)), 0.0))
#define TAN_FUN(x) (makdbl( tan( PRE_TRANSC_FUN(x)), 0.0))
#define ASIN_FUN(x) (makdbl( asin( PRE_TRANSC_FUN(x)), 0.0))
#define ACOS_FUN(x) (makdbl( acos( PRE_TRANSC_FUN(x)), 0.0))
#define ATAN_FUN(x) (makdbl( atan( PRE_TRANSC_FUN(x)), 0.0))
#define SINH_FUN(x) (makdbl( sinh( PRE_TRANSC_FUN(x)), 0.0))
#define COSH_FUN(x) (makdbl( cosh( PRE_TRANSC_FUN(x)), 0.0))
#define TANH_FUN(x) (makdbl( tanh( PRE_TRANSC_FUN(x)), 0.0))
#define ASINH_FUN(x) (makdbl( asinh( PRE_TRANSC_FUN(x)), 0.0))
#define ACOSH_FUN(x) (makdbl( acosh( PRE_TRANSC_FUN(x)), 0.0))
#define ATANH_FUN(x) (makdbl( atanh( PRE_TRANSC_FUN(x)), 0.0))
#define SQRT_FUN(x) (makdbl( sqrt( PRE_TRANSC_FUN(x)), 0.0))
#define EXPT_FUN(x,y) (makdbl( pow(( PRE_TRANSC_FUN(x)), ( PRE_TRANSC_FUN(y))), 0.0))
#define EXP_FUN(x) (makdbl( exp( PRE_TRANSC_FUN(x)), 0.0))
#define LOG_FUN(x) (makdbl( log( PRE_TRANSC_FUN(x)), 0.0))
#define ABS_FUN(x) (makdbl( fabs( PRE_TRANSC_FUN(x)), 0.0))
#define EX2IN_FUN(x) (makdbl( PRE_TRANSC_FUN(x), 0.0))
#define SCM_FLOOR_FUN(x) (makdbl( floor( PRE_TRANSC_FUN(x)), 0.0))
#define CEILING_FUN(x) (makdbl( ceil( PRE_TRANSC_FUN(x)), 0.0))
#define TRUNCATE_FUN(x) (makdbl( ltrunc( PRE_TRANSC_FUN(x)), 0.0))
#define ROUND_FUN(x) (makdbl(round( PRE_TRANSC_FUN(x)), 0.0))

/* the following defs come from the #ifdef HOBBIT part of scm.h */

#define SBOOL(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F)

#define BOOLEAN_P(x) ((x)==SCM_BOOL_T || (x)==SCM_BOOL_F)
#define CHAR_P SCM_ICHRP
#define SYMBOL_P(x) (SCM_ISYMP(x) || (!(SCM_IMP(x)) && SCM_SYMBOLP(x))) 
#define VECTOR_P(x) (!(SCM_IMP(x)) && SCM_VECTORP(x)) 
#define PAIR_P(x) (!(SCM_IMP(x)) && SCM_CONSP(x))     
#define NUMBER_P SCM_INUMP
#define INTEGER_P SCM_INUMP
#define STRING_P(x) (!(SCM_IMP(x)) && SCM_STRINGP(x))
#define NULL_P SCM_NULLP
#define ZERO_P(x) ((x)==SCM_INUM0)
#define POSITIVE_P(x) ((x) > SCM_INUM0)
#define NEGATIVE_P(x) ((x) < SCM_INUM0)

#define NOT(x) ((x)==SCM_BOOL_F ? SCM_BOOL_T : SCM_BOOL_F)
#define SET_CAR(x,y) (CAR(x) = (SCM)(y))
#define SET_CDR(x,y) (CDR(x) = (SCM)(y))
#define VECTOR_SET(v,k,o) (SCM_VELTS(v)[((long)SCM_INUM(k))] = o)
#define VECTOR_REF(v,k) (SCM_VELTS(v)[((long)SCM_INUM(k))])
#define CL_VECTOR_SET(v,k,o) (SCM_VELTS(v)[k] = o)
#define CL_VECTOR_REF(v,k) (SCM_VELTS(v)[k])
#define GLOBAL(x) (*(x))

#define append2(lst1,lst2) (append(scm_cons2(lst1,lst2,SCM_EOL)))
#define procedure_pred_(x) (SCM_BOOL_T==procedurep(x))
Commit	Line	Data
0f2d19dd JB	1	/* This was modified to try out compiling with Guile. */
	2
	3
	4	/* scmhob.h is a header file for scheme source compiled with hobbit4d
	5	Copyright (C) 1992, 1993, 1994, 1995 Tanel Tammet
	6
	7	This program is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 1, or (at your option)
	10	any later version.
	11
	12	This program is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with this program; if not, write to the Free Software
	19	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	20	*/
	21
	22
	23	#include <stdio.h>
	24	#include <ctype.h>
	25	#include "_scm.h"
	26
	27	\f
	28
	29	#define abrt scm_abort
	30	#define absval scm_abs
	31	#define angle scm_angle
	32	#define append scm_append
	33	#define assoc scm_assoc
	34	#define assq scm_assq
	35	#define assv scm_assv
	36	#define big2dbl scm_big2dbl
	37	#define close_port scm_close_port
	38	#define cons scm_cons
	39	#define cur_input_port scm_current_input_port
	40	#define cur_output_port scm_current_output_port
	41	#define difference scm_difference
	42	#define display scm_display
	43	#define divide scm_divide
	44	#define eof_objectp scm_eof_object_p
	45	#define eqp scm_eq_p
	46	#define equal scm_equal_p
	47	#define eqv scm_eqv_p
	48	#define evenp scm_even_p
	49	#define exactp scm_exact_p
	50	#define greaterp scm_gr_p
	51	#define greqp scm_geq_p
	52	#define imag_part scm_imag_part
	53	#define in2ex scm_inexact_to_exact
	54	#define inexactp scm_inexact_p
	55	#define input_portp scm_input_port_p
	56	#define intp scm_int_p
	57	#define length scm_length
	58	#define leqp scm_leq_p
	59	#define lessp scm_less_p
	60	#define lgcd scm_gcd
	61	#define list_ref scm_list_ref
	62	#define list_tail scm_list_tail
	63	#define listp scm_list_p
	64	#define llcm scm_lcm
65	#define lmax scm_max
66	#define lmin scm_min
67	#define lquotient scm_quotient
68	#define lread(X) scm_read((X), SCM_UNDEFINED)
69	#define lremainder scm_remainder
70	#define lwrite scm_write
71	#define magnitude scm_magnitude
72	#define makcclo scm_makcclo
73	#define makdbl scm_makdbl
74	#define make_string scm_make_string
75	#define make_vector scm_make_vector
76	#define makpolar scm_make_polar
77	#define makrect scm_make_rectangular
78	#define member scm_member
79	#define memq scm_memq
80	#define memv scm_memv
81	#define modulo scm_modulo
82	#define my_time scm_get_internal_run_time
83	#define negativep scm_negative_p
84	#define newline scm_newline
85	#define number2string scm_number_to_string
86	#define oddp scm_odd_p
87	#define open_file scm_open_file
88	#define output_portp scm_output_port_p
89	#define peek_char scm_peek_char
90	#define positivep scm_positive_p
91	#define procedurep scm_procedure_p
92	#define product scm_product
93	#define quit scm_quit
94	#define read_char scm_read_char
95	#define real_part scm_real_part
96	#define realp scm_real_p
97	#define reverse scm_reverse
98	#define set_inp scm_set_current_input_port
99	#define set_outp scm_set_current_output_port
100	#define st_append scm_string_append
101	#define st_equal scm_string_equal_p
102	#define st_leqp scm_string_leq_p
103	#define st_lessp scm_string_less_p
104	#define st_set scm_string_set_x
105	#define stci_equal scm_string_ci_equal_p
106	#define stci_leqp scm_string_ci_leq_p
107	#define stci_lessp scm_string_ci_less_p
108	#define string scm_string
109	#define string2list scm_string_to_list
110	#define string2number scm_string_to_number
111	#define string2symbol scm_string_to_symbol
112	#define string_copy scm_string_copy
113	#define string_fill scm_string_fill_x
114	#define substring scm_substring
115	#define sum scm_sum
116	#define symbol2string scm_symbol_to_string
117	#define vector scm_vector
118	#define vector2list scm_vector_to_list
119	#define vector_ref scm_vector_ref
120	#define vector_set scm_vector_set_x
121	#define write_char scm_write_char
122	#define zerop scm_zero_p
123
124	\f
125
126	#define STBL_VECTOR_SET(v,k,o) (v[((long)SCM_INUM(k))] = o)
127	#define STBL_VECTOR_REF(v,k) (v[((long)SCM_INUM(k))])
128	#define CHAR_LESSP(x,y) ((SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
129	#define CHAR_LEQP(x,y) ((SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
130	#define CHCI_EQ(x,y) ((upcase[SCM_ICHR(x)]==upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
131	#define CHCI_LESSP(x,y) ((upcase[SCM_ICHR(x)] < upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
132	#define CHCI_LEQP(x,y) ((upcase[SCM_ICHR(x)] <= upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
133	#define CHAR_ALPHAP(chr) ((isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
134	#define CHAR_SCM_NUMP(chr) ((isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
135	#define CHAR_WHITEP(chr) ((isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
136	#define CHAR_UPPERP(chr) ((isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
137	#define CHAR_LOWERP(chr) ((isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
138	#define CHAR2INT(chr) SCM_MAKINUM(SCM_ICHR(chr))
139	#define INT2CHAR(n) SCM_MAKICHR(SCM_INUM(n))
140	#define CHAR_UPCASE(chr) SCM_MAKICHR(upcase[SCM_ICHR(chr)])
141	#define CHAR_DOWNCASE(chr) SCM_MAKICHR(downcase[SCM_ICHR(chr)])
142	#define ST_SCM_LENGTH(str) SCM_MAKINUM(SCM_LENGTH(str))
143	#define ST_REF(str,k) SCM_MAKICHR(SCM_CHARS(str)[SCM_INUM(k)])
144	#define VECTOR_SCM_LENGTH(v) SCM_MAKINUM(SCM_LENGTH(v))
145
146	#ifdef SCM_FLOATS
147	#include <math.h>
148	#endif
149	#ifdef SCM_BIGDIG
150	#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ? (double) SCM_INUM(x) : (SCM_REALP(x) ? (double) SCM_REALPART(x) : (double) big2dbl(x)))
151	#else
152	#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ? (double) SCM_INUM(x) : (double) SCM_REALPART(x))
153	#endif
154
155	#define SIN_FUN(x) (makdbl( sin( PRE_TRANSC_FUN(x)), 0.0))
156	#define COS_FUN(x) (makdbl( cos( PRE_TRANSC_FUN(x)), 0.0))
157	#define TAN_FUN(x) (makdbl( tan( PRE_TRANSC_FUN(x)), 0.0))
158	#define ASIN_FUN(x) (makdbl( asin( PRE_TRANSC_FUN(x)), 0.0))
159	#define ACOS_FUN(x) (makdbl( acos( PRE_TRANSC_FUN(x)), 0.0))
160	#define ATAN_FUN(x) (makdbl( atan( PRE_TRANSC_FUN(x)), 0.0))
161	#define SINH_FUN(x) (makdbl( sinh( PRE_TRANSC_FUN(x)), 0.0))
162	#define COSH_FUN(x) (makdbl( cosh( PRE_TRANSC_FUN(x)), 0.0))
163	#define TANH_FUN(x) (makdbl( tanh( PRE_TRANSC_FUN(x)), 0.0))
164	#define ASINH_FUN(x) (makdbl( asinh( PRE_TRANSC_FUN(x)), 0.0))
165	#define ACOSH_FUN(x) (makdbl( acosh( PRE_TRANSC_FUN(x)), 0.0))
166	#define ATANH_FUN(x) (makdbl( atanh( PRE_TRANSC_FUN(x)), 0.0))
167	#define SQRT_FUN(x) (makdbl( sqrt( PRE_TRANSC_FUN(x)), 0.0))
168	#define EXPT_FUN(x,y) (makdbl( pow(( PRE_TRANSC_FUN(x)), ( PRE_TRANSC_FUN(y))), 0.0))
169	#define EXP_FUN(x) (makdbl( exp( PRE_TRANSC_FUN(x)), 0.0))
170	#define LOG_FUN(x) (makdbl( log( PRE_TRANSC_FUN(x)), 0.0))
171	#define ABS_FUN(x) (makdbl( fabs( PRE_TRANSC_FUN(x)), 0.0))
172	#define EX2IN_FUN(x) (makdbl( PRE_TRANSC_FUN(x), 0.0))
173	#define SCM_FLOOR_FUN(x) (makdbl( floor( PRE_TRANSC_FUN(x)), 0.0))
174	#define CEILING_FUN(x) (makdbl( ceil( PRE_TRANSC_FUN(x)), 0.0))
175	#define TRUNCATE_FUN(x) (makdbl( ltrunc( PRE_TRANSC_FUN(x)), 0.0))
176	#define ROUND_FUN(x) (makdbl(round( PRE_TRANSC_FUN(x)), 0.0))
177
178	/* the following defs come from the #ifdef HOBBIT part of scm.h */
179
180	#define SBOOL(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F)
181
182	#define BOOLEAN_P(x) ((x)==SCM_BOOL_T \|\| (x)==SCM_BOOL_F)
183	#define CHAR_P SCM_ICHRP
184	#define SYMBOL_P(x) (SCM_ISYMP(x) \|\| (!(SCM_IMP(x)) && SCM_SYMBOLP(x)))
185	#define VECTOR_P(x) (!(SCM_IMP(x)) && SCM_VECTORP(x))
186	#define PAIR_P(x) (!(SCM_IMP(x)) && SCM_CONSP(x))
187	#define NUMBER_P SCM_INUMP
188	#define INTEGER_P SCM_INUMP
189	#define STRING_P(x) (!(SCM_IMP(x)) && SCM_STRINGP(x))
190	#define NULL_P SCM_NULLP
191	#define ZERO_P(x) ((x)==SCM_INUM0)
192	#define POSITIVE_P(x) ((x) > SCM_INUM0)
193	#define NEGATIVE_P(x) ((x) < SCM_INUM0)
194
195	#define NOT(x) ((x)==SCM_BOOL_F ? SCM_BOOL_T : SCM_BOOL_F)
196	#define SET_CAR(x,y) (CAR(x) = (SCM)(y))
197	#define SET_CDR(x,y) (CDR(x) = (SCM)(y))
198	#define VECTOR_SET(v,k,o) (SCM_VELTS(v)[((long)SCM_INUM(k))] = o)
199	#define VECTOR_REF(v,k) (SCM_VELTS(v)[((long)SCM_INUM(k))])
200	#define CL_VECTOR_SET(v,k,o) (SCM_VELTS(v)[k] = o)
201	#define CL_VECTOR_REF(v,k) (SCM_VELTS(v)[k])
202	#define GLOBAL(x) (*(x))
203
204	#define append2(lst1,lst2) (append(scm_cons2(lst1,lst2,SCM_EOL)))
205	#define procedure_pred_(x) (SCM_BOOL_T==procedurep(x))