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> Fri Oct 11 03:58:25 1996 Jim Blandy <jimb@floss.cyclic.com>
* eval.c (scm_nconc2last): Revert last change; there seems to be * 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 goto _label
#endif #endif
#define lgh_error(_key, _subr, _message, _args, _rest) \
scm_error (_key, _subr, _message, _args, _rest)
#define SCM_ARGn 0 #define SCM_ARGn 0
#define SCM_ARG1 1 #define SCM_ARG1 1
#define SCM_ARG2 2 #define SCM_ARG2 2

24
libguile/error.c
View file

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

6
libguile/eval.c
View file

@ -243,7 +243,7 @@ scm_lookupcar (vloc, genv)
var = SCM_CAR (var); var = SCM_CAR (var);
errout: errout:
/* scm_everr (vloc, genv,...) */ /* scm_everr (vloc, genv,...) */
lgh_error (scm_misc_error_key, scm_error (scm_misc_error_key,
NULL, NULL,
SCM_NULLP (env) SCM_NULLP (env)
? "Unbound variable: %S" ? "Unbound variable: %S"
@ -436,7 +436,7 @@ scm_m_vref (xorig, env)
if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x))) if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x)))
{ {
/* scm_everr (SCM_UNDEFINED, env,..., "global variable reference") */ /* scm_everr (SCM_UNDEFINED, env,..., "global variable reference") */
lgh_error (scm_misc_error_key, scm_error (scm_misc_error_key,
NULL, NULL,
"Bad variable: %S", "Bad variable: %S",
scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED), scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED),
@ -1858,7 +1858,7 @@ dispatch:
proc = x; proc = x;
badfun: badfun:
/* scm_everr (x, env,...) */ /* scm_everr (x, env,...) */
lgh_error (scm_misc_error_key, scm_error (scm_misc_error_key,
NULL, NULL,
"Wrong type to apply: %S", "Wrong type to apply: %S",
scm_listify (proc, SCM_UNDEFINED), 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); SCM full_filename = scm_sys_search_load_path (filename);
if (SCM_FALSEP (full_filename)) if (SCM_FALSEP (full_filename))
{ {
lgh_error (scm_misc_error_key, scm_error (scm_misc_error_key,
s_sys_try_load_path, s_sys_try_load_path,
"Unable to find file %S in %S", "Unable to find file %S in %S",
scm_listify (filename, *scm_loc_load_path, SCM_UNDEFINED), 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_report_stack_overflow ()
{ {
scm_stack_checking_enabled_p = 0; scm_stack_checking_enabled_p = 0;
lgh_error (scm_stack_overflow_key, scm_error (scm_stack_overflow_key,
NULL, NULL,
"Stack overflow", "Stack overflow",
SCM_BOOL_F, SCM_BOOL_F,

35
libguile/stime.c
View file

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

25
libguile/stime.h
View file

@ -47,25 +47,10 @@
#include "libguile/__scm.h" #include "libguile/__scm.h"
#ifdef __STDC__ extern SCM scm_get_internal_real_time SCM_P ((void));
extern SCM scm_get_internal_real_time(void); extern SCM scm_get_internal_run_time SCM_P ((void));
extern SCM scm_get_internal_run_time(void); extern SCM scm_current_time SCM_P ((void));
extern SCM scm_current_time(void); extern long scm_time_in_msec SCM_P ((long x));
extern long scm_time_in_msec(long x); extern void scm_init_stime SCM_P ((void));
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 */
#endif /* TIMEH */ #endif /* TIMEH */