summaryrefslogtreecommitdiffstats
path: root/sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'sys.c')
-rw-r--r--sys.c91
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 {
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 02:05:50 +0000