Import Upstream version 5e4upstream/5e4

1 files changed, 46 insertions, 45 deletions

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("#<GC-FORWARD->", 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("#<NEW-CELL . ", port);
-      iprin1(CDR(exp), port, writing);
+      scm_iprin1(CDR(exp), port, writing);
     }
     lputs(" @0x", port);
-    intprint((long)exp, -16, port);
+    scm_intprint((long)exp, -16, port);
   }
   lputc('>', 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 {