Import Upstream version 5e2upstream/5e2

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;