From 710a97992705d67c3ded0d4b270c5978ce29b11f Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:37 -0800 Subject: Import Upstream version 5e4 --- sys.c | 91 ++++++++++++++++++++++++++++++++++--------------------------------- 1 file changed, 46 insertions(+), 45 deletions(-) (limited to 'sys.c') diff --git a/sys.c b/sys.c index d3243c4..8a24c1c 100644 --- a/sys.c +++ b/sys.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2002 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2002, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -51,7 +51,6 @@ #endif void igc P((const char *what, SCM basecont)); -void lfflush P((SCM port)); /* internal SCM call */ SCM *loc_open_file; /* for open-file callback */ SCM *loc_try_create_file; @@ -352,6 +351,7 @@ SCM del_fil(str) void prinport(exp, port, type) SCM exp; SCM port; char *type; { + int filn = fileno(STREAM(exp)); lputs("#<", port); if (CLOSEDP(exp)) lputs("closed-", port); else { @@ -366,8 +366,11 @@ void prinport(exp, port, type) # ifndef AMIGA # ifndef macintosh # ifndef PLAN9 - if (OPENP(exp) && tc16_fport==TYP16(exp) && isatty(fileno(STREAM(exp)))) - lputs(ttyname(fileno(STREAM(exp))), port); + if (OPENP(exp) && tc16_fport==TYP16(exp) && filn >= 0 && isatty(filn)) { + char *ttyn = ttyname(filn); + if (ttyn) lputs(ttyn, port); + else goto punt; + } else # endif # endif @@ -375,19 +378,20 @@ void prinport(exp, port, type) # endif # endif #endif + punt: { SCM s = PORTP(exp) ? SCM_PORTDATA(exp) : UNDEFINED; if (NIMP(s) && STRINGP(s)) - iprin1(s, port, 1); + scm_iprin1(s, port, 1); else if (OPFPORTP(exp)) - intprint((long)fileno(STREAM(exp)), 10, port); + scm_intprint((long)filn, 10, port); else - intprint(CDR(exp), -16, port); + scm_intprint(CDR(exp), -16, port); if (TRACKED & SCM_PORTFLAGS(exp)) { - lputs(" L", port); - intprint(scm_port_table[SCM_PORTNUM(exp)].line, 10, port); - lputs(" C", port); - intprint(scm_port_table[SCM_PORTNUM(exp)].col+0L, 10, port); + lputs(" L", port); + scm_intprint(scm_port_table[SCM_PORTNUM(exp)].line, 10, port); + lputs(" C", port); + scm_intprint(scm_port_table[SCM_PORTNUM(exp)].col+0L, 10, port); } } lputc('>', port); @@ -496,7 +500,7 @@ sizet pwrite(ptr, size, nitems, port) { sizet len = size * nitems; sizet i = 0; - for(;i < len;i++) putc(ptr[i], port); + for (;i < len;i++) putc(ptr[i], port); return len; } # define ffwrite pwrite @@ -521,6 +525,7 @@ static ptobfuns fptob = { fflush, fgetc, fclose}; + ptobfuns pipob = { 0, mark0, @@ -537,6 +542,7 @@ ptobfuns pipob = { #endif fflush, fgetc}; + static ptobfuns stptob = { s_string, markcdr, @@ -695,6 +701,7 @@ static int tc16_sysport; #define SYS_ERRP_SIZE 480 static char errbuf[SYS_ERRP_SIZE]; static sizet errbuf_end = 0; + static sizet syswrite(str, siz, num, p) sizet siz, num; char *str; FILE *p; @@ -709,11 +716,11 @@ static sizet syswrite(str, siz, num, p) errbuf_end = dst; } else { - if (NIMP(cur_outp)) lflush(cur_outp); + /* if (NIMP(cur_errp) && OPOUTPORTP(cur_errp)) lfflush(cur_errp); */ if (errbuf_end > 0) { if (errbuf_end > SYS_ERRP_SIZE) { scm_warn("output buffer", " overflowed", UNDEFINED); - intprint((long)errbuf_end, 10, cur_errp); + scm_intprint((long)errbuf_end, 10, cur_errp); lputs(" chars needed\n", cur_errp); errbuf_end = errbuf_end % SYS_ERRP_SIZE; lfwrite(&errbuf[errbuf_end], 1, @@ -723,7 +730,7 @@ static sizet syswrite(str, siz, num, p) errbuf_end = 0; } num = lfwrite(str, siz, num, cur_errp); - lflush(cur_errp); + /* if (NIMP(cur_errp) && OPOUTPORTP(cur_errp)) lfflush(cur_errp); */ } errno = 0; return num; @@ -741,12 +748,6 @@ static int sysputc(c, p) syswrite(&cc, 1, 1, p); return c; } -static int sysflush(p) - FILE *p; -{ - syswrite(0, 0, 0, p); - return 0; -} static ptobfuns sysptob = { 0, mark0, @@ -756,7 +757,7 @@ static ptobfuns sysptob = { sysputc, sysputs, syswrite, - sysflush, + noop0, noop0, noop0}; @@ -828,7 +829,7 @@ static int safeputc(c, p) static int safeflush(p) safeport *p; { - lflush(p->port); + if (p && NIMP(p->port) && OPOUTPORTP(p->port)) lfflush(p->port); return 0; } static SCM marksafep(ptr) @@ -860,7 +861,7 @@ static int freeprint(exp, port, writing) { if (tc_broken_heart==CAR(exp)) { lputs("#", port); - iprin1(CDR(exp), port, writing); + scm_iprin1(CDR(exp), port, writing); } else { if (NIMP(CDR(exp)) && tc7_smob==CAR(CDR(exp))) { @@ -868,10 +869,10 @@ static int freeprint(exp, port, writing) } else { lputs("#', port); return !0; @@ -1390,7 +1391,7 @@ SCM sym2vcell(sym) SCM lsym, z; sizet hash = strhash(UCHARS(sym), (sizet)LENGTH(sym), (unsigned long)symhash_dim); - for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { + for (lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { z = CAR(lsym); if (CAR(z)==sym) return z; } @@ -1408,12 +1409,12 @@ SCM intern(name, len) sizet hash = strhash(tmp, i, (unsigned long)symhash_dim); /* printf("intern %s len=%d\n",name,len); fflush(stdout); */ DEFER_INTS; - for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { + for (lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { z = CAR(lsym); z = CAR(z); tmp = UCHARS(z); if (LENGTH(z) != len) goto trynext; - for(i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext; + for (i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext; ALLOW_INTS; return CAR(lsym); trynext: ; @@ -1439,12 +1440,12 @@ SCM sysintern(name, val) register sizet i = len; register unsigned char *tmp = (unsigned char *)name; sizet hash = strhash(tmp, i, (unsigned long)symhash_dim); - for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { + for (lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) { z = CAR(lsym); z = CAR(z); tmp = UCHARS(z); if (LENGTH(z) != len) goto trynext; - for(i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext; + for (i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext; lsym = CAR(lsym); if (!UNBNDP(val)) CDR(lsym) = val; else if (UNBNDP(CDR(lsym)) && tc7_msymbol==TYP7(CAR(lsym))) @@ -1593,11 +1594,11 @@ void stack_report() { STACKITEM stack; lputs(";; stack: 0x", cur_errp); - intprint((long)CONT(rootcont)->stkbse, -16, cur_errp); + scm_intprint((long)CONT(rootcont)->stkbse, -16, cur_errp); lputs(" - 0x", cur_errp); - intprint((long)&stack, -16, cur_errp); + scm_intprint((long)&stack, -16, cur_errp); lputs("; ", cur_errp); - intprint(stack_size(CONT(rootcont)->stkbse)*sizeof(STACKITEM), 10, cur_errp); + scm_intprint(stack_size(CONT(rootcont)->stkbse)*sizeof(STACKITEM), 10, cur_errp); lputs(" bytes\n", cur_errp); } @@ -1813,13 +1814,13 @@ void heap_report() { long seg_cells = CELL_DN(hplims[i+1]) - CELL_UP(hplims[i]); lputs("\n; 0x", sys_errp); - intprint((long)hplims[i++], -16, sys_errp); + scm_intprint((long)hplims[i++], -16, sys_errp); lputs(" - 0x", sys_errp); - intprint((long)hplims[i++], -16, sys_errp); + scm_intprint((long)hplims[i++], -16, sys_errp); lputs("; ", sys_errp); - intprint(seg_cells, 10, sys_errp); + scm_intprint(seg_cells, 10, sys_errp); lputs(" cells; ", sys_errp); - intprint(seg_cells / (1024 / sizeof(CELLPTR)), 10, sys_errp); + scm_intprint(seg_cells / (1024 / sizeof(CELLPTR)), 10, sys_errp); lputs(".kiB", sys_errp); }} } @@ -1967,9 +1968,9 @@ void scm_free_gra(gra) void gra_report1(gra) scm_gra *gra; { - intprint((long)gra->len, -10, cur_errp); + scm_intprint((long)gra->len, -10, cur_errp); lputs(" (of ", cur_errp); - intprint((long)gra->alloclen, -10, cur_errp); + scm_intprint((long)gra->alloclen, -10, cur_errp); lputs(") ", cur_errp); lputs(gra->what, cur_errp); lputs("; ", cur_errp); @@ -2049,7 +2050,7 @@ SCM scm_open_ports() { SCM p, res = EOL; int k; - for(k = scm_port_table_len - 1; k > 0; k--) { + for (k = scm_port_table_len - 1; k > 0; k--) { p = scm_port_table[k].port; if (NIMP(p) && OPPORTP(p)) res = cons(p, res); @@ -2462,7 +2463,7 @@ void free_storage() gc_end(); ALLOW_INTS; /* A really bad idea, but printing does it anyway. */ exit_report(); - lflush(sys_errp); + lfflush(sys_errp); scm_free_gra(&ptobs_gra); lmallocated = mallocated = 0; /* Can't do gc_end() here because it uses ptobs which have been freed */ @@ -2655,7 +2656,7 @@ static void gc_sweep(contin_bad) while (i < hplim_ind) { ptr = CELL_UP(hplims[i++]); seg_cells = CELL_DN(hplims[i++]) - ptr; - for(j = seg_cells; j--; ++ptr) { + for (j = seg_cells; j--; ++ptr) { #ifdef POINTERS_MUNGED scmptr = PTR2SCM(ptr); #endif @@ -2814,7 +2815,7 @@ static void gc_sweep(contin_bad) /* must_free((char *)hplims[i-2], sizeof(cell) * (hplims[i-1] - hplims[i-2])); */ hplims[i-2] = 0; - for(j = i;j < hplim_ind;j++) hplims[j-2] = hplims[j]; + for (j = i;j < hplim_ind;j++) hplims[j-2] = hplims[j]; hplim_ind -= 2; i -= 2; /* need to scan segment just moved. */ nfreelist = freelist; @@ -2976,7 +2977,7 @@ static void sweep_port_table() { int k; /* tmp_errp gets entry 0, so we never clear its flags. */ - for(k = scm_port_table_len - 1; k > 0; k--) { + for (k = scm_port_table_len - 1; k > 0; k--) { if (scm_port_table[k].flags & 1) scm_port_table[k].flags &= (~1L); else { -- cgit v1.2.3