diff options
author | Thomas Bushnell <tb@debian.org> | 2006-04-26 23:01:39 -0700 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:32 -0800 |
commit | 20402610bf881f67b22eb1600340d8284556ae56 (patch) | |
tree | 6a19e5a1b2cc22dccd1003787a70b751f7da4763 /sys.c | |
parent | 5846f77421a975897a31d6fbf3f520aab385cea3 (diff) | |
parent | ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7 (diff) | |
download | scm-20402610bf881f67b22eb1600340d8284556ae56.tar.gz scm-20402610bf881f67b22eb1600340d8284556ae56.zip |
Import Debian changes 5e2-1debian/5e2-1
scm (5e2-1) unstable; urgency=low
* New upstream release.
* Change to continue.h from version 5e1-2 repeated here.
Diffstat (limited to 'sys.c')
-rw-r--r-- | sys.c | 150 |
1 files changed, 75 insertions, 75 deletions
@@ -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; |