aboutsummaryrefslogtreecommitdiffstats
path: root/sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'sys.c')
-rw-r--r--sys.c150
1 files changed, 75 insertions, 75 deletions
diff --git a/sys.c b/sys.c
index 8308fba..04b442e 100644
--- a/sys.c
+++ b/sys.c
@@ -50,7 +50,7 @@
# include <io.h>
#endif
-void igc P((char *what, STACKITEM *stackbase));
+void igc P((const char *what, STACKITEM *stackbase));
void lfflush P((SCM port)); /* internal SCM call */
SCM *loc_open_file; /* for open-file callback */
SCM *loc_try_create_file;
@@ -218,7 +218,7 @@ SCM close_port(port)
sizet i;
SCM ret = UNSPECIFIED;
ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_close_port);
- if CLOSEDP(port) return UNSPECIFIED;
+ if (CLOSEDP(port)) return UNSPECIFIED;
i = PTOBNUM(port);
DEFER_INTS;
if (ptobs[i].fclose) {
@@ -240,20 +240,20 @@ SCM close_port(port)
SCM input_portp(x)
SCM x;
{
- if IMP(x) return BOOL_F;
+ if (IMP(x)) return BOOL_F;
return INPORTP(x) ? BOOL_T : BOOL_F;
}
SCM output_portp(x)
SCM x;
{
- if IMP(x) return BOOL_F;
+ if (IMP(x)) return BOOL_F;
return OUTPORTP(x) ? BOOL_T : BOOL_F;
}
SCM port_closedp(port)
SCM port;
{
ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_closedp);
- if CLOSEDP(port) return BOOL_T;
+ if (CLOSEDP(port)) return BOOL_T;
return BOOL_F;
}
SCM scm_port_type(port)
@@ -353,7 +353,7 @@ void prinport(exp, port, type)
SCM exp; SCM port; char *type;
{
lputs("#<", port);
- if CLOSEDP(exp) lputs("closed-", port);
+ if (CLOSEDP(exp)) lputs("closed-", port);
else {
if (RDNG & CAR(exp)) lputs("input-", port);
if (WRTNG & CAR(exp)) lputs("output-", port);
@@ -709,7 +709,7 @@ static sizet syswrite(str, siz, num, p)
errbuf_end = dst;
}
else {
- if NIMP(cur_outp) lflush(cur_outp);
+ if (NIMP(cur_outp)) lflush(cur_outp);
if (errbuf_end > 0) {
if (errbuf_end > SYS_ERRP_SIZE) {
scm_warn("output buffer", " overflowed", UNDEFINED);
@@ -772,7 +772,7 @@ SCM mksafeport(maxlen, port)
SCM port;
{
SCM z;
- if UNBNDP(port) port = cur_errp;
+ if (UNBNDP(port)) port = cur_errp;
ASRTER(NIMP(port) && OPPORTP(port), port, ARG2, s_msp);
z = must_malloc_cell(sizeof(safeport)+0L,
tc16_safeport | OPN | WRTNG,
@@ -787,7 +787,7 @@ int reset_safeport(sfp, maxlen, port)
{
if (NIMP(sfp) && tc16_safeport==TYP16(sfp)) {
((safeport *)STREAM(sfp))->ccnt = maxlen;
- if NIMP(port)
+ if (NIMP(port))
((safeport *)STREAM(sfp))->port = port;
return !0;
}
@@ -996,10 +996,10 @@ static SCM make_stk_seg(size, contents)
}
estk_pool = SCM_ESTK_PARENT(estk_pool);
}
- if IMP(seg) seg = must_malloc_cell((long)size*sizeof(SCM),
+ if (IMP(seg)) seg = must_malloc_cell((long)size*sizeof(SCM),
MAKE_LENGTH(size, tc7_vector), s_estk);
dst = VELTS(seg);
- if NIMP(contents) {
+ if (NIMP(contents)) {
src = VELTS(contents);
for (i = size; i--;) dst[i] = src[i];
}
@@ -1055,7 +1055,7 @@ void scm_estk_shrink()
sizet i;
parent = SCM_ESTK_PARENT(scm_estk);
i = INUM(SCM_ESTK_PARENT_INDEX(scm_estk));
- if IMP(parent) wta(UNDEFINED, "underflow", s_estk);
+ if (IMP(parent)) wta(UNDEFINED, "underflow", s_estk);
if (BOOL_F==SCM_ESTK_PARENT_WRITABLEP(scm_estk)) {
parent = make_stk_seg((sizet)LENGTH(parent), parent);
SCM_ESTK_PARENT_WRITABLEP(parent) = BOOL_F;
@@ -1257,7 +1257,7 @@ static char *igc_for_alloc(where, olen, size, what)
char *where;
long olen;
sizet size;
- char *what;
+ const char *what;
{
char *ptr;
long nm;
@@ -1283,7 +1283,7 @@ static char *igc_for_alloc(where, olen, size, what)
}
char *must_malloc(len, what)
long len;
- char *what;
+ const char *what;
{
char *ptr;
sizet size = len;
@@ -1302,7 +1302,7 @@ char *must_malloc(len, what)
SCM must_malloc_cell(len, c, what)
long len;
SCM c;
- char *what;
+ const char *what;
{
SCM z;
char *ptr;
@@ -1325,7 +1325,7 @@ SCM must_malloc_cell(len, c, what)
char *must_realloc(where, olen, len, what)
char *where;
long olen, len;
- char *what;
+ const char *what;
{
char *ptr;
sizet size = len;
@@ -1346,7 +1346,7 @@ char *must_realloc(where, olen, len, what)
void must_realloc_cell(z, olen, len, what)
SCM z;
long olen, len;
- char *what;
+ const char *what;
{
char *ptr, *where = CHARS(z);
sizet size = len;
@@ -1753,8 +1753,8 @@ SCM obunhash(obj)
ASRTER(INUMP(obj), obj, ARG1, s_obunhash);
obj = SRS(obj, 1) & ~1L;
comm:
- if IMP(obj) return obj;
- if NCELLP(obj) return BOOL_F;
+ if (IMP(obj)) return obj;
+ if (NCELLP(obj)) return BOOL_F;
{
/* This code is adapted from mark_locations() in "sys.c" and
scm_cell_p() in "rope.c", which means that changes to these
@@ -1762,12 +1762,12 @@ comm:
register CELLPTR ptr = (CELLPTR)SCM2PTR(obj);
register sizet i = 0, j = hplim_ind;
do {
- if PTR_GT(hplims[i++], ptr) break;
- if PTR_LE(hplims[--j], ptr) break;
+ if (PTR_GT(hplims[i++], ptr)) break;
+ if (PTR_LE(hplims[--j], ptr)) break;
if ((i != j)
&& PTR_LE(hplims[i++], ptr)
&& PTR_GT(hplims[--j], ptr)) continue;
- if NFREEP(obj) return obj;
+ if (NFREEP(obj)) return obj;
break;
} while(i<j);
}
@@ -1898,7 +1898,7 @@ badhplims:
void scm_init_gra(gra, eltsize, len, maxlen, what)
scm_gra *gra;
sizet eltsize, len, maxlen;
- char *what;
+ const char *what;
{
char *nelts;
/* DEFER_INTS; */
@@ -2296,7 +2296,7 @@ SCM gc(arg)
SCM arg;
{
DEFER_INTS;
- if UNBNDP(arg)
+ if (UNBNDP(arg))
igc("call", CONT(rootcont)->stkbse);
else
scm_egc();
@@ -2321,13 +2321,13 @@ void scm_run_finalizers(exiting)
}
while (!0) {
DEFER_INTS;
- if NIMP(gc_finalizers_pending) {
+ if (NIMP(gc_finalizers_pending)) {
f = CAR(gc_finalizers_pending);
gc_finalizers_pending = CDR(gc_finalizers_pending);
}
else f = BOOL_F;
ALLOW_INTS;
- if IMP(f) break;
+ if (IMP(f)) break;
apply(f, EOL, EOL);
}
}
@@ -2347,7 +2347,7 @@ void scm_gc_hook ()
}
void igc(what, stackbase)
- char *what;
+ const char *what;
STACKITEM *stackbase;
{
int j = num_protects;
@@ -2485,7 +2485,7 @@ void gc_mark(p)
register SCM ptr = p;
CHECK_STACK;
gc_mark_loop:
- if IMP(ptr) return;
+ if (IMP(ptr)) return;
gc_mark_nimp:
if (NCELLP(ptr)
/* #ifndef RECKLESS */
@@ -2495,9 +2495,9 @@ void gc_mark(p)
) wta(ptr, "rogue pointer in ", s_heap);
switch TYP7(ptr) {
case tcs_cons_nimcar:
- if GCMARKP(ptr) break;
+ if (GCMARKP(ptr)) break;
SETGCMARK(ptr);
- if IMP(CDR(ptr)) { /* IMP works even with a GC mark */
+ if (IMP(CDR(ptr))) { /* IMP works even with a GC mark */
ptr = CAR(ptr);
goto gc_mark_nimp;
}
@@ -2506,14 +2506,14 @@ void gc_mark(p)
goto gc_mark_nimp;
case tcs_cons_imcar:
case tcs_cons_gloc:
- if GCMARKP(ptr) break;
+ if (GCMARKP(ptr)) break;
SETGCMARK(ptr);
ptr = GCCDR(ptr);
goto gc_mark_loop;
case tcs_closures:
- if GCMARKP(ptr) break;
+ if (GCMARKP(ptr)) break;
SETGCMARK(ptr);
- if IMP(GCENV(ptr)) {
+ if (IMP(GCENV(ptr))) {
ptr = CODE(ptr);
goto gc_mark_nimp;
}
@@ -2521,13 +2521,13 @@ void gc_mark(p)
ptr = GCENV(ptr);
goto gc_mark_nimp;
case tc7_specfun:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
SETGC8MARK(ptr);
#ifdef CCLO
if (tc16_cclo==GCTYP16(ptr)) {
i = CCLO_LENGTH(ptr);
if (i==0) break;
- while(--i>0) if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]);
+ while(--i>0) if (NIMP(VELTS(ptr)[i])) gc_mark(VELTS(ptr)[i]);
ptr = VELTS(ptr)[0];
}
else
@@ -2535,15 +2535,15 @@ void gc_mark(p)
ptr = CDR(ptr);
goto gc_mark_loop;
case tc7_vector:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
SETGC8MARK(ptr);
i = LENGTH(ptr);
if (i==0) break;
- while(--i>0) if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]);
+ while(--i>0) if (NIMP(VELTS(ptr)[i])) gc_mark(VELTS(ptr)[i]);
ptr = VELTS(ptr)[0];
goto gc_mark_loop;
case tc7_contin:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
SETGC8MARK(ptr);
mark_locations((STACKITEM *)VELTS(ptr),
(sizet)(LENGTH(ptr) +
@@ -2552,7 +2552,7 @@ void gc_mark(p)
break;
case tc7_string:
case tc7_msymbol:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)),
s_wrong_length, s_gc);
case tc7_ssymbol:
@@ -2567,7 +2567,7 @@ void gc_mark(p)
case tcs_subrs:
break;
case tc7_port:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
SETGC8MARK(ptr);
i = PTOBNUM(ptr);
if (!(i < numptob)) goto def;
@@ -2576,7 +2576,7 @@ void gc_mark(p)
ptr = (ptobs[i].mark)(ptr);
goto gc_mark_loop;
case tc7_smob:
- if GC8MARKP(ptr) break;
+ if (GC8MARKP(ptr)) break;
SETGC8MARK(ptr);
switch TYP16(ptr) { /* should be faster than going through smobs */
case tc_free_cell:
@@ -2618,17 +2618,17 @@ void mark_locations(x, n)
register long m = n;
register int i, j;
register CELLPTR ptr;
- while(0 <= --m) if CELLP(*(SCM **)&x[m]) {
+ while(0 <= --m) if (CELLP(*(SCM **)&x[m])) {
ptr = (CELLPTR)SCM2PTR((SCM)(*(SCM **)&x[m]));
i = 0;
j = hplim_ind;
do {
- if PTR_GT(hplims[i++], ptr) break;
- if PTR_LE(hplims[--j], ptr) break;
+ if (PTR_GT(hplims[i++], ptr)) break;
+ if (PTR_LE(hplims[--j], ptr)) break;
if ((i != j)
&& PTR_LE(hplims[i++], ptr)
&& PTR_GT(hplims[--j], ptr)) continue;
- /* if NFREEP(*(SCM **)&x[m]) */ gc_mark(*(SCM *)&x[m]);
+ /* if (NFREEP(*(SCM **)&x[m])) */ gc_mark(*(SCM *)&x[m]);
break;
} while(i<j);
}
@@ -2661,10 +2661,10 @@ static void gc_sweep(contin_bad)
case tcs_cons_nimcar:
case tcs_cons_gloc:
case tcs_closures:
- if GCMARKP(scmptr) goto cmrkcontinue;
+ if (GCMARKP(scmptr)) goto cmrkcontinue;
break;
case tc7_specfun:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
#ifdef CCLO
if (tc16_cclo==GCTYP16(scmptr)) {
minc = (CCLO_LENGTH(scmptr)*sizeof(SCM));
@@ -2673,47 +2673,47 @@ static void gc_sweep(contin_bad)
#endif
break;
case tc7_vector:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = (LENGTH(scmptr)*sizeof(SCM));
freechars:
must_free(CHARS(scmptr), minc);
/* SETCHARS(scmptr, 0);*/
break;
case tc7_bvect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = sizeof(long)*((HUGE_LENGTH(scmptr)+LONG_BIT-1)/LONG_BIT);
goto freechars;
case tc7_ivect:
case tc7_uvect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)*sizeof(long);
goto freechars;
case tc7_svect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)*sizeof(short);
goto freechars;
case tc7_fvect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)*sizeof(float);
goto freechars;
case tc7_dvect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)*sizeof(double);
goto freechars;
case tc7_cvect:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)*2*sizeof(double);
goto freechars;
case tc7_string:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = HUGE_LENGTH(scmptr)+1;
goto freechars;
case tc7_msymbol:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = LENGTH(scmptr)+1;
goto freechars;
case tc7_contin:
- if GC8MARKP(scmptr) {
+ if (GC8MARKP(scmptr)) {
if (contin_bad && CONT(scmptr)->length)
scm_warn("uncollected ", "", scmptr);
goto c8mrkcontinue;
@@ -2722,15 +2722,15 @@ static void gc_sweep(contin_bad)
mallocated = mallocated - minc;
free_continuation(CONT(scmptr)); break; /* goto freechars; */
case tc7_ssymbol:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
/* Do not free storage because tc7_ssymbol means scmptr's
storage was not created by a call to malloc(). */
break;
case tcs_subrs:
continue;
case tc7_port:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
- if OPENP(scmptr) {
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
+ if (OPENP(scmptr)) {
int k = PTOBNUM(scmptr);
if (!(k < numptob)) goto sweeperr;
/* Yes, I really do mean ptobs[k].free */
@@ -2745,17 +2745,17 @@ static void gc_sweep(contin_bad)
case tc7_smob:
switch GCTYP16(scmptr) {
case tc_free_cell:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
break;
#ifdef BIGDIG
case tcs_bignums:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
minc = (NUMDIGS(scmptr)*sizeof(BIGDIG));
goto freechars;
#endif /* def BIGDIG */
#ifdef FLOATS
case tc16_flo:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
switch ((int)(CAR(scmptr)>>16)) {
case (IMAG_PART | REAL_PART)>>16:
minc = 2*sizeof(double);
@@ -2772,7 +2772,7 @@ static void gc_sweep(contin_bad)
break;
#endif /* def FLOATS */
default:
- if GC8MARKP(scmptr) goto c8mrkcontinue;
+ if (GC8MARKP(scmptr)) goto c8mrkcontinue;
{
int k = SMOBNUM(scmptr);
if (!(k < numsmob)) goto sweeperr;
@@ -2862,7 +2862,7 @@ static void mark_sym_values(v)
while (k--)
for (al = VELTS(v)[k]; NIMP(al); al = GCCDR(al)) {
x = GCCDR(CAR(al));
- if IMP(x) continue;
+ if (IMP(x)) continue;
gc_mark(x);
}
}
@@ -2877,7 +2877,7 @@ static void sweep_symhash(v)
lloc = &(VELTS(v)[k]);
while NIMP(al = (*lloc & ~1L)) {
x = CAR(al);
- if GC8MARKP(CAR(x)) {
+ if (GC8MARKP(CAR(x))) {
lloc = &(CDR(al));
SETGCMARK(x);
}
@@ -2983,13 +2983,13 @@ static void egc_mark()
int i;
gc_mark(scm_env);
gc_mark(scm_env_tmp);
- if IMP(scm_estk) return; /* Can happen when moving estk. */
- if GC8MARKP(scm_estk) return;
+ if (IMP(scm_estk)) return; /* Can happen when moving estk. */
+ if (GC8MARKP(scm_estk)) return;
v = VELTS(scm_estk);
SETGC8MARK(scm_estk);
i = scm_estk_ptr - v + SCM_ESTK_FRLEN;
while(--i >= 0)
- if NIMP(v[i])
+ if (NIMP(v[i]))
gc_mark(v[i]);
}
static void egc_sweep()
@@ -2998,7 +2998,7 @@ static void egc_sweep()
int i;
for (i = scm_ecache_index; i < scm_ecache_len; i++) {
z = PTR2SCM(&(scm_ecache[i]));
- if CONSP(z) {
+ if (CONSP(z)) {
CLRGCMARK(z);
}
else {
@@ -3025,7 +3025,7 @@ static void egc_copy(px)
*px = CDR(x);
return;
}
- if IMP(freelist) wta(freelist, "empty freelist", "ecache gc");
+ if (IMP(freelist)) wta(freelist, "empty freelist", "ecache gc");
z = freelist;
freelist = CDR(freelist);
++cells_allocated;
@@ -3065,7 +3065,7 @@ static void egc_copy_stack(stk, len)
egc_copy_locations(VELTS(stk), len);
len = INUM(SCM_ESTK_PARENT_INDEX(stk)) + SCM_ESTK_FRLEN;
stk =SCM_ESTK_PARENT(stk);
- if IMP(stk) return;
+ if (IMP(stk)) return;
/* len = LENGTH(stk); */
}
}
@@ -3079,7 +3079,7 @@ static void egc_copy_roots()
wta(MAKINUM(scm_egc_root_index), "egc-root-index", "corrupted");
while (len--) {
x = roots[len];
- if IMP(x) continue;
+ if (IMP(x)) continue;
switch TYP3(x) {
clo:
case tc3_closure:
@@ -3095,7 +3095,7 @@ static void egc_copy_roots()
LETREC. This is only a problem if a
non-cache cell was made to point into the
cache. */
- if ECACHEP(x) break;
+ if (ECACHEP(x)) break;
e = CAR(x);
if (NIMP(e) && ECACHEP(e))
egc_copy(&(CAR(x)));
@@ -3133,7 +3133,7 @@ static int egc_need_gc()
/* Interrupting a NEWCELL could leave cells_allocated inconsistent with
freelist, see handle_it() in repl.c */
for (n = 4; n; n--) {
- if IMP(fl) return 1;
+ if (IMP(fl)) return 1;
fl = CDR(fl);
}
return 0;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 18:33:25 +0000