mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

* error.c, eval.c, load.c, stackchk.c: use scm_error not lgh_error.

Browse source 
* __scm.h (lgh_error): removed, lgh shouldn't be in libguile.

* stime.c, stime.h: use SCM_P method.
This commit is contained in:
Gary Houston 1996-10-12 21:59:40 +00:00
parent 9518bec3de
commit 01f61221f4
8 changed files with 30 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/ChangeLog
View file

@ -1,3 +1,11 @@
Sat Oct 12 21:49:29 1996 Gary Houston <ghouston@actrix.gen.nz>
* error.c, eval.c, load.c, stackchk.c: use scm_error not lgh_error.
* __scm.h (lgh_error): removed, lgh shouldn't be in libguile.
* stime.c, stime.h: use SCM_P method.
Fri Oct 11 03:58:25 1996 Jim Blandy <jimb@floss.cyclic.com>
* eval.c (scm_nconc2last): Revert last change; there seems to be

3
libguile/__scm.h
View file

@ -325,9 +325,6 @@ extern unsigned int scm_async_clock;
goto _label
#endif
#define lgh_error(_key, _subr, _message, _args, _rest) \
scm_error (_key, _subr, _message, _args, _rest)
#define SCM_ARGn 0
#define SCM_ARG1 1
#define SCM_ARG2 2

24
libguile/error.c
View file

@ -123,7 +123,7 @@ scm_perror (arg)
void (*scm_error_callback) () = 0;
/* all errors thrown from C should pass through here. */
/* also known as lgh_error. */
/* also known as scm_error. */
void
scm_error (key, subr, message, args, rest)
SCM key;
@ -164,7 +164,7 @@ void
scm_syserror (subr)
char *subr;
{
lgh_error (scm_system_error_key,
scm_error (scm_system_error_key,
subr,
"%s",
scm_listify (scm_makfrom0str (strerror (errno)),
@ -178,7 +178,7 @@ scm_syserror_msg (subr, message, args)
char *message;
SCM args;
{
lgh_error (scm_system_error_key,
scm_error (scm_system_error_key,
subr,
message,
args,
@ -190,13 +190,13 @@ scm_sysmissing (subr)
char *subr;
{
#ifdef ENOSYS
lgh_error (scm_system_error_key,
scm_error (scm_system_error_key,
subr,
"%s",
scm_listify (scm_makfrom0str (strerror (ENOSYS)), SCM_UNDEFINED),
scm_listify (SCM_MAKINUM (ENOSYS), SCM_UNDEFINED));
#else
lgh_error (scm_system_error_key,
scm_error (scm_system_error_key,
subr,
"Missing function",
SCM_BOOL_F,
@ -208,7 +208,7 @@ void
scm_num_overflow (subr)
char *subr;
{
lgh_error (scm_num_overflow_key,
scm_error (scm_num_overflow_key,
subr,
"Numerical overflow",
SCM_BOOL_F,
@ -220,7 +220,7 @@ scm_out_of_range (subr, bad_value)
char *subr;
SCM bad_value;
{
lgh_error (scm_out_of_range_key,
scm_error (scm_out_of_range_key,
subr,
"Argument out of range: %S",
scm_listify (bad_value, SCM_UNDEFINED),
@ -231,7 +231,7 @@ void
scm_wrong_num_args (proc)
SCM proc;
{
lgh_error (scm_args_number_key,
scm_error (scm_args_number_key,
NULL,
"Wrong number of arguments to %s",
scm_listify (proc, SCM_UNDEFINED),
@ -244,7 +244,7 @@ scm_wrong_type_arg (subr, pos, bad_value)
int pos;
SCM bad_value;
{
lgh_error (scm_arg_type_key,
scm_error (scm_arg_type_key,
subr,
(pos == 0) ? "Wrong type argument: %S"
: "Wrong type argument in position %s: %S",
@ -257,7 +257,7 @@ void
scm_memory_error (subr)
char *subr;
{
lgh_error (scm_memory_alloc_key,
scm_error (scm_memory_alloc_key,
subr,
"Memory allocation error",
SCM_BOOL_F,
@ -276,7 +276,7 @@ scm_wta (arg, pos, s_subr)
if ((~0x1fL) & (long) pos)
{
/* error string supplied. */
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
s_subr,
pos,
SCM_BOOL_F,
@ -309,7 +309,7 @@ scm_wta (arg, pos, s_subr)
scm_memory_error (s_subr);
default:
/* this shouldn't happen. */
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
s_subr,
"Unknown error",
SCM_BOOL_F,

6
libguile/eval.c
View file

@ -243,7 +243,7 @@ scm_lookupcar (vloc, genv)
var = SCM_CAR (var);
errout:
/* scm_everr (vloc, genv,...) */
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
NULL,
SCM_NULLP (env)
? "Unbound variable: %S"
@ -436,7 +436,7 @@ scm_m_vref (xorig, env)
if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x)))
{
/* scm_everr (SCM_UNDEFINED, env,..., "global variable reference") */
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
NULL,
"Bad variable: %S",
scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED),
@ -1858,7 +1858,7 @@ dispatch:
proc = x;
badfun:
/* scm_everr (x, env,...) */
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
NULL,
"Wrong type to apply: %S",
scm_listify (proc, SCM_UNDEFINED),

2
libguile/load.c
View file

@ -207,7 +207,7 @@ scm_sys_try_load_path (filename, case_insensitive_p, sharp)
SCM full_filename = scm_sys_search_load_path (filename);
if (SCM_FALSEP (full_filename))
{
lgh_error (scm_misc_error_key,
scm_error (scm_misc_error_key,
s_sys_try_load_path,
"Unable to find file %S in %S",
scm_listify (filename, *scm_loc_load_path, SCM_UNDEFINED),

2
libguile/stackchk.c
View file

@ -57,7 +57,7 @@ void
scm_report_stack_overflow ()
{
scm_stack_checking_enabled_p = 0;
lgh_error (scm_stack_overflow_key,
scm_error (scm_stack_overflow_key,
NULL,
"Stack overflow",
SCM_BOOL_F,

35
libguile/stime.c
View file

@ -109,13 +109,8 @@
#endif
#ifdef HAVE_TIMES
#ifdef __STDC__
static
long mytime(void)
#else
static
long mytime()
#endif
{
struct tms time_buffer;
times(&time_buffer);
@ -137,13 +132,8 @@ extern int ftime (struct timeb *);
struct timeb scm_your_base = {0};
SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
#ifdef __STDC__
SCM
scm_get_internal_real_time(void)
#else
SCM
scm_get_internal_real_time()
#endif
{
struct timeb time_buffer;
long tmp;
@ -160,13 +150,8 @@ scm_get_internal_real_time()
timet scm_your_base = 0;
SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
#ifdef __STDC__
SCM
scm_get_internal_real_time(void)
#else
SCM
scm_get_internal_real_time()
#endif
{
return SCM_MAKINUM((time((timet*)0) - scm_your_base) * (int)CLKTCK);
}
@ -177,25 +162,15 @@ scm_get_internal_real_time()
static long scm_my_base = 0;
SCM_PROC(s_get_internal_run_time, "get-internal-run-time", 0, 0, 0, scm_get_internal_run_time);
#ifdef __STDC__
SCM
scm_get_internal_run_time(void)
#else
SCM
scm_get_internal_run_time()
#endif
{
return SCM_MAKINUM(mytime()-scm_my_base);
}
SCM_PROC(s_current_time, "current-time", 0, 0, 0, scm_current_time);
#ifdef __STDC__
SCM
scm_current_time(void)
#else
SCM
scm_current_time()
#endif
{
timet timv = time((timet*)0);
SCM ans;
@ -203,27 +178,17 @@ scm_current_time()
return SCM_BOOL_F==ans ? SCM_MAKINUM(timv) : ans;
}
#ifdef __STDC__
long
scm_time_in_msec(long x)
#else
long
scm_time_in_msec(x)
long x;
#endif
{
if (CLKTCK==60) return (x*50)/3;
else
return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK);
}
#ifdef __STDC__
void
scm_init_stime(void)
#else
void
scm_init_stime()
#endif
{
scm_sysintern("internal-time-units-per-second",
SCM_MAKINUM((long)CLKTCK));

25
libguile/stime.h
View file

@ -47,25 +47,10 @@
#include "libguile/__scm.h"
#ifdef __STDC__
extern SCM scm_get_internal_real_time(void);
extern SCM scm_get_internal_run_time(void);
extern SCM scm_current_time(void);
extern long scm_time_in_msec(long x);
extern void scm_init_stime(void);
#else /* STDC */
extern SCM scm_get_internal_real_time();
extern SCM scm_get_internal_run_time();
extern SCM scm_current_time();
extern long scm_time_in_msec();
extern void scm_init_stime();
#endif /* STDC */
extern SCM scm_get_internal_real_time SCM_P ((void));
extern SCM scm_get_internal_run_time SCM_P ((void));
extern SCM scm_current_time SCM_P ((void));
extern long scm_time_in_msec SCM_P ((long x));
extern void scm_init_stime SCM_P ((void));
#endif /* TIMEH */