diff --git a/doc/util/mkindex.c b/doc/util/mkindex.c index 4fd2730..8e18321 100644 --- a/doc/util/mkindex.c +++ b/doc/util/mkindex.c @@ -39,17 +39,17 @@ main(ac, av) char **av; { FILE *fp; if (ac < 2) { - fn = "stdin"; - doit(stdin); + fn = "stdin"; + doit(stdin); } else { - while (--ac > 0) { - fn = *++av; - if ((fp = fopen(fn, "r")) == 0) { - perror(fn); exit(1); - } - doit(fp); - fclose(fp); - } + while (--ac > 0) { + fn = *++av; + if ((fp = fopen(fn, "r")) == 0) { + perror(fn); exit(1); + } + doit(fp); + fclose(fp); + } } return 0; } @@ -61,81 +61,81 @@ doit(fp) FILE *fp; { line = 1; while (fgets(buf, 10000, fp) != NULL) { - if (p = index(buf, '\n')) - *p = 0; - p = buf; - while (*p) { - if (*p == '@' && p[1] == '[') { - start = p; - p += 2; - switch (*p) { - case '.': - macro = "Ix"; break; - case '!': - macro = "Id"; break; - case 0: - error("index truncated"); - default: - error("invalid index type"); - } - p++; - q = inx; - while (*p != ']') { - if (*p == 0) - error("missing ]"); - if (*p == '\\' && p[1] == ']') - p++; - *q++ = *p++; - } - if (q == inx) - error("empty index"); - *q = 0; - eatfont(inx, arg); - if (start > buf && start[-1] == '(') - printf("\\c"); - if (need_nl) - putchar('\n'); - printf(".%s ", macro); - p++; - if (arg[0] == '=') { - printf("\"%s\"", arg+1); - if (*p) { - putchar('\n'); - need_nl = 0; - if (*p == ' ') - p++; - } - } else if (q = index(arg, '|')) { - *q = 0; q++; - printf("\"%s, %s\"\n%s %s", q, arg, arg, q); - need_nl = 1; - } else { - printf("\"%s\"\n%s", arg, inx); - need_nl = 1; - } - } else { - putchar(*p); - need_nl = 1; - p++; - } - } - putchar('\n'); - need_nl = 0; - line++; + if (p = index(buf, '\n')) + *p = 0; + p = buf; + while (*p) { + if (*p == '@' && p[1] == '[') { + start = p; + p += 2; + switch (*p) { + case '.': + macro = "Ix"; break; + case '!': + macro = "Id"; break; + case 0: + error("index truncated"); + default: + error("invalid index type"); + } + p++; + q = inx; + while (*p != ']') { + if (*p == 0) + error("missing ]"); + if (*p == '\\' && p[1] == ']') + p++; + *q++ = *p++; + } + if (q == inx) + error("empty index"); + *q = 0; + eatfont(inx, arg); + if (start > buf && start[-1] == '(') + printf("\\c"); + if (need_nl) + putchar('\n'); + printf(".%s ", macro); + p++; + if (arg[0] == '=') { + printf("\"%s\"", arg+1); + if (*p) { + putchar('\n'); + need_nl = 0; + if (*p == ' ') + p++; + } + } else if (q = index(arg, '|')) { + *q = 0; q++; + printf("\"%s, %s\"\n%s %s", q, arg, arg, q); + need_nl = 1; + } else { + printf("\"%s\"\n%s", arg, inx); + need_nl = 1; + } + } else { + putchar(*p); + need_nl = 1; + p++; + } + } + putchar('\n'); + need_nl = 0; + line++; } } eatfont(from, to) char *from, *to; { while (*from) { - if (*from == '\\' && from[1] == 'f' && from[2]) { - from += 3; - } else if (*from == '\'' && from[1] == '\'') { - from += 2; - } else if (*from == '`' && from[1] == '`') { - from += 2; - } else if (*from == '\\' && from[1] == '%') { - from += 2; - } else *to++ = *from++; + if (*from == '\\' && from[1] == 'f' && from[2]) { + from += 3; + } else if (*from == '\'' && from[1] == '\'') { + from += 2; + } else if (*from == '`' && from[1] == '`') { + from += 2; + } else if (*from == '\\' && from[1] == '%') { + from += 2; + } else *to++ = *from++; } *to = 0; } diff --git a/examples/c++/class.cpp b/examples/c++/class.cpp index bf5907f..fd1ce83 100644 --- a/examples/c++/class.cpp +++ b/examples/c++/class.cpp @@ -83,7 +83,7 @@ int Foo_Equal(Object x, Object y) { extern "C" void elk_init_foo() { T_Foo = Define_Type(0, "foo", NOFUNC, sizeof(struct S_Foo), - Foo_Equal, Foo_Equal, Foo_Print, NOFUNC); + Foo_Equal, Foo_Equal, Foo_Print, NOFUNC); Define_Primitive((Object(*)(...))P_Make_Foo, "make-foo", 0, 0, EVAL); Define_Primitive((Object(*)(...))P_Read_Val, "read-val", 1, 1, EVAL); Define_Primitive((Object(*)(...))P_Write_Val, "write-val!", 2, 2, EVAL); diff --git a/include/cstring.h b/include/cstring.h index 448b115..32efb3b 100644 --- a/include/cstring.h +++ b/include/cstring.h @@ -43,9 +43,9 @@ #define Get_Strsym_Stack(_from,_to) {\ int _len;\ if (TYPE(_from) == T_Symbol)\ - (_from) = SYMBOL(_from)->name;\ + (_from) = SYMBOL(_from)->name;\ else if (TYPE(_from) != T_String)\ - Wrong_Type_Combination ((_from), "string or symbol");\ + Wrong_Type_Combination ((_from), "string or symbol");\ _len = STRING(_from)->size;\ Alloca ((_to), char*, _len+1);\ memcpy ((_to), STRING(_from)->data, _len);\ diff --git a/include/exception.h b/include/exception.h index 71b9d60..8a83c36 100644 --- a/include/exception.h +++ b/include/exception.h @@ -63,9 +63,9 @@ extern unsigned long Intr_Level; #else #ifdef POSIX_SIGNALS #define Force_Disable_Interrupts (void)sigprocmask (SIG_BLOCK, &Sigset_Block,\ - (sigset_t *)0) + (sigset_t *)0) #define Force_Enable_Interrupts (void)sigprocmask (SIG_SETMASK, &Sigset_Old,\ - (sigset_t *)0) + (sigset_t *)0) #else #define Force_Disable_Interrupts {\ if (!Intr_Was_Ignored) (void)signal (SIGINT, SIG_IGN);\ diff --git a/include/gc.h b/include/gc.h index e65e71f..2f97cbc 100644 --- a/include/gc.h +++ b/include/gc.h @@ -69,7 +69,7 @@ extern GCNODE *GC_List; #define GC_Link4_Tag_Primitive(args,fun,env,x4) {\ gc1.gclen = TAG_ARGS; gc1.gcobj = &args; gc1.next = GC_List;\ gc2.gclen = Tail_Call ? TAG_TCFUN : TAG_FUN;\ - gc2.gcobj = &fun; gc2.next = &gc1;\ + gc2.gcobj = &fun; gc2.next = &gc1;\ gc3.gclen = TAG_ENV; gc3.gcobj = &env; gc3.next = &gc2;\ gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3; GC_List = &gc4;\ } @@ -104,11 +104,11 @@ extern GCNODE *GC_List; /* see src/proc.c */ #define GC_Link7_Tag_Compound(args,fun,env,x4,x5,x6,x7) {\ gc1.gclen = TAG_ARGS;\ - gc1.gcobj = &args; gc1.next = GC_List;\ + gc1.gcobj = &args; gc1.next = GC_List;\ gc2.gclen = Tail_Call ? TAG_TCFUN : TAG_FUN;\ - gc2.gcobj = &fun; gc2.next = &gc1;\ + gc2.gcobj = &fun; gc2.next = &gc1;\ gc3.gclen = TAG_ENV;\ - gc3.gcobj = &env; gc3.next = &gc2;\ + gc3.gcobj = &env; gc3.next = &gc2;\ gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3;\ gc5.gclen = 0; gc5.gcobj = &x5; gc5.next = &gc4;\ gc6.gclen = 0; gc6.gcobj = &x6; gc6.next = &gc5;\ diff --git a/include/misc.h b/include/misc.h index 605dd6c..f9e89e9 100644 --- a/include/misc.h +++ b/include/misc.h @@ -45,9 +45,9 @@ # define NBITS(v) ((sizeof v) * 8) # define HIBIT(v,n) (NBITS(v) - (n)) # define ASR(n,s) ((n) >>= (s),\ - ((n) & (1 << (HIBIT((n),(s)) - 1)) ?\ - ((n) |= ~(((unsigned)1 << HIBIT((n),(s))) - 1)) :\ - (n))) + ((n) & (1 << (HIBIT((n),(s)) - 1)) ?\ + ((n) |= ~(((unsigned)1 << HIBIT((n),(s))) - 1)) :\ + (n))) #endif extern Object False2; diff --git a/include/object.h b/include/object.h index 70f19dc..b48df39 100644 --- a/include/object.h +++ b/include/object.h @@ -91,7 +91,7 @@ typedef struct { # define MAKEOBJ(o,t,p) (SET(o, t, p)) # define IS_ALIVE(obj) ((WAS_FORWARDED(obj)) || \ (STABLE(OBJ_TO_PAGE(obj))) || \ - (space[OBJ_TO_PAGE(obj)] == current_space)) + (space[OBJ_TO_PAGE(obj)] == current_space)) # define REVIVE_OBJ(obj) Visit (&obj); #else C_LINKAGE_BEGIN @@ -144,13 +144,13 @@ typedef struct { #define AUTOLOAD(x) ((struct S_Autoload *)POINTER(x)) #define MACRO(x) ((struct S_Macro *)POINTER(x)) -typedef unsigned short gran_t; /* Granularity of bignums */ +typedef unsigned short gran_t; /* Granularity of bignums */ struct S_Bignum { Object minusp; - unsigned int size; /* Number of ushorts allocated */ - unsigned int usize; /* Number of ushorts actually used */ - gran_t data[1]; /* Data, lsw first */ + unsigned int size; /* Number of ushorts allocated */ + unsigned int usize; /* Number of ushorts actually used */ + gran_t data[1]; /* Data, lsw first */ }; struct S_Flonum { diff --git a/include/stkmem.h b/include/stkmem.h index e60ef01..2756b3a 100644 --- a/include/stkmem.h +++ b/include/stkmem.h @@ -78,14 +78,14 @@ extern char *Mem_Alloc P_((unsigned)); #define Alloca_End {\ register MEM_NODE *_p, *_q;\ if (_mem_first != 0) {\ - _p = Mem_List;\ - do {\ - _q = _p;\ - _p = _p->next;\ - if (--_q->refcnt == 0)\ - free ((char *)_q);\ - } while (_q != _mem_first);\ - Mem_List = _p;\ + _p = Mem_List;\ + do {\ + _q = _p;\ + _p = _p->next;\ + if (--_q->refcnt == 0)\ + free ((char *)_q);\ + } while (_q != _mem_first);\ + Mem_List = _p;\ }\ } diff --git a/include/type.h b/include/type.h index 63cff37..52f8f5e 100644 --- a/include/type.h +++ b/include/type.h @@ -50,5 +50,5 @@ #define Check_Mutable(x) {\ if (ISCONST(x))\ - Primitive_Error ("attempt to modify constant");\ + Primitive_Error ("attempt to modify constant");\ } diff --git a/lib/misc/bitstring.c b/lib/misc/bitstring.c index 60d52e2..5372626 100644 --- a/lib/misc/bitstring.c +++ b/lib/misc/bitstring.c @@ -60,7 +60,7 @@ static int Bitstring_Equal(Object b1, Object b2) { struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2); if (a->len != b->len) - return 0; + return 0; return !bcmp(a->data, b->data, bits_to_bytes(a->len)); } @@ -73,7 +73,7 @@ static char *Digits(unsigned char c, int n) { int i = 0; for (; n > 0; n--) - buf[i++] = c & masks[n] ? '1' : '0'; + buf[i++] = c & masks[n] ? '1' : '0'; buf[i] = '\0'; return buf; } @@ -91,9 +91,9 @@ static int Bitstring_Print(Object x, Object port, int raw, int depth, i = bits_to_bytes(b->len) - 1; rem = b->len; if (rem % 8) - Printf(port, Digits(b->data[i--], rem)); + Printf(port, Digits(b->data[i--], rem)); for ( ; i >= 0; i--) - Printf(port, Digits(b->data[i], 8)); + Printf(port, Digits(b->data[i], 8)); GC_Unlink; return 0; } @@ -116,9 +116,9 @@ static void Fill_Bitstring(Object bs, int fill) { i = bits_to_bytes(b->len) - 1; if (val && (rem = b->len % 8)) - b->data[i--] |= masks2[rem]; + b->data[i--] |= masks2[rem]; for ( ; i >= 0; i--) - b->data[i] = val; + b->data[i] = val; } static Object P_Make_Bitstring(Object len, Object init) { @@ -126,12 +126,12 @@ static Object P_Make_Bitstring(Object len, Object init) { int n, fill; if ((n = Get_Integer(len)) < 0) - Range_Error(len); + Range_Error(len); Check_Type(init, T_Boolean); fill = Truep(init); ret = Make_Bitstring((unsigned)n); if (fill) - Fill_Bitstring(ret, 1); + Fill_Bitstring(ret, 1); return ret; } @@ -144,7 +144,7 @@ static int Ulong_Size(unsigned long ul) { int n; for (n = 0; ul; ul >>= 1, n++) - ; + ; return n; } @@ -157,17 +157,17 @@ static Object Ulong_To_Bitstring(unsigned long ul, unsigned int len) { ret = Make_Bitstring(len); b = BITSTRING(ret); if (siz > len) { - sprintf(buf, "length %u too small for integer %lu", len, ul); - Primitive_Error(buf); + sprintf(buf, "length %u too small for integer %lu", len, ul); + Primitive_Error(buf); } for (i = 0; ul; ul >>= 8, i++) - b->data[i] = ul & 0xFF; + b->data[i] = ul & 0xFF; return ret; } static unsigned int Bigbits(struct S_Bignum *b) { return b->usize ? (Ulong_Size((unsigned long)b->data[b->usize-1]) + - (b->usize-1) * sizeof(gran_t) * 8) : 0; + (b->usize-1) * sizeof(gran_t) * 8) : 0; } static Object Bignum_To_Bitstring(Object big, unsigned int len) { @@ -179,8 +179,8 @@ static Object Bignum_To_Bitstring(Object big, unsigned int len) { GC_Node; if (Bigbits(BIGNUM(big)) > len) { - sprintf(buf, "length %u too small for integer ~s", len); - Primitive_Error(buf, big); + sprintf(buf, "length %u too small for integer ~s", len); + Primitive_Error(buf, big); } GC_Link(big); ret = Make_Bitstring(len); @@ -189,9 +189,9 @@ static Object Bignum_To_Bitstring(Object big, unsigned int len) { bn = BIGNUM(big); n = bits_to_bytes(len); for (i = k = 0; k < bn->usize; k++, i++) { - b->data[i] = bn->data[k] & 0xFF; - if (i < n) - b->data[++i] = bn->data[k] >> 8 & 0xFF; + b->data[i] = bn->data[k] & 0xFF; + if (i < n) + b->data[++i] = bn->data[k] >> 8 & 0xFF; } return ret; } @@ -201,13 +201,13 @@ static Object P_Int_To_Bitstring(Object len, Object i) { int ilen; if ((ilen = Get_Integer(len)) < 0) - Range_Error(len); + Range_Error(len); Check_Integer(i); isneg = P_Negativep(i); if (Truep(isneg)) - Range_Error(i); + Range_Error(i); if (TYPE(i) == T_Fixnum) - return Ulong_To_Bitstring((unsigned long)FIXNUM(i), (unsigned)ilen); + return Ulong_To_Bitstring((unsigned long)FIXNUM(i), (unsigned)ilen); return Bignum_To_Bitstring(i, (unsigned)ilen); } @@ -224,10 +224,10 @@ static Object Bitstring_To_Bignum (Object bs) { GC_Unlink; b = BITSTRING(bs); for (i = k = 0; i < n; k++, i++) { - digit = b->data[i]; - if (!(i & 1)) - digit |= (unsigned)b->data[++i] << 8; - BIGNUM(big)->data[k] = digit; + digit = b->data[i]; + if (!(i & 1)) + digit |= (unsigned)b->data[++i] << 8; + BIGNUM(big)->data[k] = digit; } BIGNUM(big)->usize = k; Bignum_Normalize_In_Place (BIGNUM(big)); @@ -243,9 +243,9 @@ static Object P_Bitstring_To_Int(Object bs) { b = BITSTRING(bs); for (i = bits_to_bytes(b->len) - 1; i >= 0; i--) { - u = u << 8 | b->data[i]; - if (!UFIXNUM_FITS(u)) - return Bitstring_To_Bignum(bs); + u = u << 8 | b->data[i]; + if (!UFIXNUM_FITS(u)) + return Bitstring_To_Bignum(bs); } return Make_Integer(u); } @@ -258,7 +258,7 @@ static Object P_Bitstring_Ref(Object bs, Object inx) { b = BITSTRING(bs); i = Get_Integer(inx); if (i < 0 || i >= (int)b->len) - Range_Error(inx); + Range_Error(inx); return b->data[i/8] & 1 << i % 8 ? True : False; } @@ -271,14 +271,14 @@ static Object P_Bitstring_Set(Object bs, Object inx, Object val) { b = BITSTRING(bs); i = Get_Integer(inx); if (i < 0 || i >= (int)b->len) - Range_Error(inx); + Range_Error(inx); j = i/8; mask = 1 << i%8; old = b->data[j] & mask; if (Truep(val)) - b->data[j] |= mask; + b->data[j] |= mask; else - b->data[j] &= ~mask; + b->data[j] &= ~mask; return old ? True : False; } @@ -289,7 +289,7 @@ static Object P_Bitstring_Zerop(Object bs) { Check_Type(bs, T_Bitstring); b = BITSTRING(bs); for (i = bits_to_bytes(b->len); --i >= 0 && b->data[i] == 0 ;) - ; + ; return i < 0 ? True : False; } @@ -305,16 +305,16 @@ static Object P_Bitstring_Fill(Object bs, Object fill) { int i, rem;\ \ if (a->len != b->len) {\ - printf("bitstrings must be of same length\n"); exit(1);\ + printf("bitstrings must be of same length\n"); exit(1);\ }\ i = bits_to_bytes(a->len) - 1;\ rem = a->len % 8;\ if (rem % 8) {\ - a->data[i] op b->data[i];\ - a->data[i--] &= masks2[rem];\ + a->data[i] op b->data[i];\ + a->data[i--] &= masks2[rem];\ }\ for ( ; i >= 0; i--)\ - a->data[i] op b->data[i];\ + a->data[i] op b->data[i];\ } bitop(bmove, =) @@ -332,7 +332,7 @@ static Object Bit_Operation(Object b1, Object b2, void (*fun)()) { a = BITSTRING(b1); b = BITSTRING(b2); if (a->len != b->len) - Primitive_Error("bitstrings must have identical length"); + Primitive_Error("bitstrings must have identical length"); fun(a, b); return Void; } @@ -378,134 +378,134 @@ static Object P_Substring_Move(Object b1, Object from, Object to, end2 = start2 + len; if (start1 < 0 || start1 > end1) - Range_Error(from); + Range_Error(from); if (end1 > (int)a->len) - Range_Error(to); + Range_Error(to); if (start2 < 0 || end2 > (int)b->len) - Range_Error(dst); + Range_Error(dst); if (a == b && start2 < start1) { /* copy forward (LSB to MSB) */ - off1 = start1 % 8; - off2 = start2 % 8; - i = start1 / 8; - j = start2 / 8; - if (off1 == off2) { - if (off1) { - mask = 0xFF & ~masks2[off1]; - if (off1 + len < 8) - mask &= masks2[off1+len]; - b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); - len -= 8 - off1; i++; j++; - } - for (; len >= 8; len -= 8) - b->data[j++] = a->data[i++]; - if (len > 0) { - mask = masks2[len]; - b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); - } - } else { - unsigned char dmask; - int n, delta, shift; + off1 = start1 % 8; + off2 = start2 % 8; + i = start1 / 8; + j = start2 / 8; + if (off1 == off2) { + if (off1) { + mask = 0xFF & ~masks2[off1]; + if (off1 + len < 8) + mask &= masks2[off1+len]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + len -= 8 - off1; i++; j++; + } + for (; len >= 8; len -= 8) + b->data[j++] = a->data[i++]; + if (len > 0) { + mask = masks2[len]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + } + } else { + unsigned char dmask; + int n, delta, shift; - while (len > 0) { - shift = delta = off2 - off1; - if (shift < 0) - shift = -shift; - n = 8 - off1; - mask = 0xFF & ~masks2[off1]; - if (len < n) { - n = len; - mask &= masks2[off1+len]; - } - if (8 - off2 >= n) { /* rest of src byte fits into dst byte */ + while (len > 0) { + shift = delta = off2 - off1; + if (shift < 0) + shift = -shift; + n = 8 - off1; + mask = 0xFF & ~masks2[off1]; + if (len < n) { + n = len; + mask &= masks2[off1+len]; + } + if (8 - off2 >= n) { /* rest of src byte fits into dst byte */ - if (delta > 0) { - dmask = mask << shift; - b->data[j] = (b->data[j] & ~dmask) | - (a->data[i] & mask) << shift; - } else { - dmask = mask >> shift; - b->data[j] = (b->data[j] & ~dmask) | - (unsigned int)(a->data[i] & mask) >> shift; - } - } else { /* nope, copy as many bits as fit into dst bye */ + if (delta > 0) { + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } else { + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } + } else { /* nope, copy as many bits as fit into dst bye */ - n = 8 - off2; - mask &= masks2[off1+n]; - dmask = mask << shift; - b->data[j] = (b->data[j] & ~dmask) | - (a->data[i] & mask) << shift; - } + n = 8 - off2; + mask &= masks2[off1+n]; + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } - if (off1 + n >= 8) i++; - if (off2 + n >= 8) j++; - off1 = (off1 + n) % 8; - off2 = (off2 + n) % 8; - len -= n; - } - } + if (off1 + n >= 8) i++; + if (off2 + n >= 8) j++; + off1 = (off1 + n) % 8; + off2 = (off2 + n) % 8; + len -= n; + } + } } else { /* copy backwards (MSB to LSB) */ - if ((off1 = end1 % 8 - 1) < 0) off1 = 7; - if ((off2 = end2 % 8 - 1) < 0) off2 = 7; - i = (end1 - 1) / 8; - j = (end2 - 1) / 8; - if (off1 == off2) { - if (off1 < 7) { - if (len <= off1) - mask = masks2[len] << (off1-len+1); - else - mask = masks2[off1+1]; - b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); - len -= off1+1; i--; j--; - } - for (; len >= 8; len -= 8) - b->data[j--] = a->data[i--]; - if (len > 0) { - mask = masks2[len] << (8 - len); - b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); - } - } else { - unsigned char dmask; - int n, delta, shift; + if ((off1 = end1 % 8 - 1) < 0) off1 = 7; + if ((off2 = end2 % 8 - 1) < 0) off2 = 7; + i = (end1 - 1) / 8; + j = (end2 - 1) / 8; + if (off1 == off2) { + if (off1 < 7) { + if (len <= off1) + mask = masks2[len] << (off1-len+1); + else + mask = masks2[off1+1]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + len -= off1+1; i--; j--; + } + for (; len >= 8; len -= 8) + b->data[j--] = a->data[i--]; + if (len > 0) { + mask = masks2[len] << (8 - len); + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + } + } else { + unsigned char dmask; + int n, delta, shift; - while (len > 0) { - shift = delta = off2 - off1; - if (shift < 0) - shift = -shift; - n = off1 + 1; - mask = masks2[n]; - if (len < n) { - mask = masks2[len] << (n-len); - n = len; - } - if (off2 + 1 >= n) { /* rest of src byte fits into dst byte */ + while (len > 0) { + shift = delta = off2 - off1; + if (shift < 0) + shift = -shift; + n = off1 + 1; + mask = masks2[n]; + if (len < n) { + mask = masks2[len] << (n-len); + n = len; + } + if (off2 + 1 >= n) { /* rest of src byte fits into dst byte */ - if (delta > 0) { - dmask = mask << shift; - b->data[j] = (b->data[j] & ~dmask) | - (a->data[i] & mask) << shift; - } else { - dmask = mask >> shift; - b->data[j] = (b->data[j] & ~dmask) | - (unsigned int)(a->data[i] & mask) >> shift; - } - } else { /* nope, copy as many bits as fit into dst bye */ + if (delta > 0) { + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } else { + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } + } else { /* nope, copy as many bits as fit into dst bye */ - n = off2 + 1; - mask = masks2[n] << (off1-n+1); - dmask = mask >> shift; - b->data[j] = (b->data[j] & ~dmask) | - (unsigned int)(a->data[i] & mask) >> shift; - } + n = off2 + 1; + mask = masks2[n] << (off1-n+1); + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } - if (off1 - n < 0) i--; - if (off2 - n < 0) j--; - if ((off1 -= n) < 0) off1 += 8; - if ((off2 -= n) < 0) off2 += 8; - len -= n; - } - } + if (off1 - n < 0) i--; + if (off2 - n < 0) j--; + if ((off1 -= n) < 0) off1 += 8; + if ((off2 -= n) < 0) off2 += 8; + len -= n; + } + } } return Void; } @@ -520,22 +520,22 @@ static Object Bitstring_Read(Object port, int chr, int konst) { f = PORT(port)->file; str = PORT(port)->flags & P_STRING; while (1) { - Reader_Getc; - if (c == EOF) - Reader_Sharp_Eof; - if (Whitespace (c) || Delimiter (c)) - break; - if (p == buf+1024) - Reader_Error(port, "bitstring constant too long for reader"); - if (c != '0' && c != '1') - Reader_Error(port, "bad digit in bitstring constant"); - *p++ = c; + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + if (p == buf+1024) + Reader_Error(port, "bitstring constant too long for reader"); + if (c != '0' && c != '1') + Reader_Error(port, "bad digit in bitstring constant"); + *p++ = c; } Reader_Ungetc; ret = Make_Bitstring(p-buf); for (i = 0; p > buf; i++) - if (*--p == '1') - BITSTRING(ret)->data[i/8] |= 1 << i%8; + if (*--p == '1') + BITSTRING(ret)->data[i/8] |= 1 << i%8; return ret; } @@ -543,7 +543,7 @@ static Object Bitstring_Read(Object port, int chr, int konst) { void elk_init_lib_bitstring() { T_Bitstring = Define_Type(0, "bitstring", Bitstring_Size, 0, - Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC); + Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC); Define_Reader('*', Bitstring_Read); Def_Prim(P_Bitstringp, "bitstring?", 1, 1, EVAL); Def_Prim(P_Bitstring_Equalp, "bitstring=?", 2, 2, EVAL); diff --git a/lib/misc/elk-eval.c b/lib/misc/elk-eval.c index 5b2d3aa..bea635c 100644 --- a/lib/misc/elk-eval.c +++ b/lib/misc/elk-eval.c @@ -64,7 +64,7 @@ static char *String_Eval(char *expr) { str = P_Get_Output_String(out); p = Get_String(str); if (strlen(p) > sizeof buf - 1) - p = "too long"; + p = "too long"; strcpy(buf, p); GC_Unlink; return buf; @@ -74,11 +74,11 @@ char *Elk_Eval(char *expr) { char *s; s = String_Eval("\ - (call-with-current-continuation (lambda (c)\ - (set! error-handler (lambda a (print a) (c #f))) #t))\ + (call-with-current-continuation (lambda (c)\ + (set! error-handler (lambda a (print a) (c #f))) #t))\ "); if (strcmp(s, "#f") == 0) - return 0; + return 0; return String_Eval(expr); } diff --git a/lib/misc/gdbm.c b/lib/misc/gdbm.c index da38d2a..a7fe083 100644 --- a/lib/misc/gdbm.c +++ b/lib/misc/gdbm.c @@ -128,12 +128,12 @@ struct S_gdbm_fh{ int Gdbm_fh_Equal (Object a, Object b) { return !GDBM_FH(a)->free && !GDBM_FH(b)->free && - GDBM_FH(a)->fptr == GDBM_FH(b)->fptr; + GDBM_FH(a)->fptr == GDBM_FH(b)->fptr; } /*ARGSUSED*/ int Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port; - int /*Bool*/ raw; int depth, len; { + int /*Bool*/ raw; int depth, len; { Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr); return 0; } @@ -153,11 +153,11 @@ Object P_Gdbm_Open (int argc, Object *argv) { Disable_Interrupts; dbf = gdbm_open (Get_Strsym (argv[0]), Get_Integer (argv[1]), - Symbols_To_Bits (argv[2], 0, RW_Syms), - argc == 4 ? Get_Integer (argv[3]) : 0644, Fatal_Func); + Symbols_To_Bits (argv[2], 0, RW_Syms), + argc == 4 ? Get_Integer (argv[3]) : 0644, Fatal_Func); if (dbf == 0) { - Enable_Interrupts; - return False; + Enable_Interrupts; + return False; } Gdbm_fh = Alloc_Object (sizeof (struct S_gdbm_fh), T_Gdbm_fh, 0); GDBM_FH (Gdbm_fh)->tag = Null; @@ -170,7 +170,7 @@ Object P_Gdbm_Open (int argc, Object *argv) { void Check_Fh (Object fh) { Check_Type (fh, T_Gdbm_fh); if (GDBM_FH(fh)->free) - Primitive_Error ("invalid gdbm-file: ~s", fh); + Primitive_Error ("invalid gdbm-file: ~s", fh); } Object P_Gdbm_Close (Object fh) { @@ -183,7 +183,7 @@ Object P_Gdbm_Close (Object fh) { } Object P_Gdbm_Store (fh, key, content, flag) - Object fh, key, content, flag; { + Object fh, key, content, flag; { int res; datum k, c; @@ -196,7 +196,7 @@ Object P_Gdbm_Store (fh, key, content, flag) c.dsize = STRING(content)->size; Disable_Interrupts; res = gdbm_store (GDBM_FH(fh)->fptr, k, c, - Symbols_To_Bits (flag, 0, Flag_Syms)); + Symbols_To_Bits (flag, 0, Flag_Syms)); Enable_Interrupts; return Make_Integer (res); } @@ -213,7 +213,7 @@ static Object Gdbm_Get (Object fh, Object key, datum (*func)()) { c = (*func) (GDBM_FH(fh)->fptr, k); Enable_Interrupts; if (c.dptr == 0) - return False; + return False; res = Make_String (c.dptr, c.dsize); free (c.dptr); return res; @@ -250,7 +250,7 @@ Object P_Gdbm_Firstkey (Object fh) { k = gdbm_firstkey (GDBM_FH(fh)->fptr); Enable_Interrupts; if (k.dptr == 0) - return False; + return False; res = Make_String (k.dptr, k.dsize); free (k.dptr); return res; @@ -285,8 +285,8 @@ void elk_init_lib_gdbm () { Define_Primitive (P_Gdbm_Error, "gdbm-error", 0, 0, EVAL); Define_Primitive (P_Gdbm_Error_Text, "gdbm-error-text", 0, 0, EVAL); T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC, - sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal, - Gdbm_fh_Print, NOFUNC); + sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal, + Gdbm_fh_Print, NOFUNC); P_Provide (Intern ("gdbm.so")); P_Provide (Intern ("gdbm.o")); } diff --git a/lib/misc/hack.c b/lib/misc/hack.c index 94bc8b8..fad0b65 100644 --- a/lib/misc/hack.c +++ b/lib/misc/hack.c @@ -39,7 +39,7 @@ static Object P_Hack_Procedure_Environment (Object p, Object e) { void elk_init_lib_hack () { Define_Primitive (P_Hack_Procedure_Environment, - "hack-procedure-environment!", 2, 2, EVAL); + "hack-procedure-environment!", 2, 2, EVAL); P_Provide (Intern ("hack.so")); P_Provide (Intern ("hack.o")); } diff --git a/lib/misc/monitor.c b/lib/misc/monitor.c index e114b33..c005ea1 100644 --- a/lib/misc/monitor.c +++ b/lib/misc/monitor.c @@ -66,14 +66,14 @@ static Object P_Monitor (Object on) { Check_Type (on, T_Boolean); Disable_Interrupts; if (Truep (on)) { - if (!monitoring) { - brk = sbrk (0); - monstartup ((int (*)())MONSTART, (int (*)())brk); - monitoring = 1; - } + if (!monitoring) { + brk = sbrk (0); + monstartup ((int (*)())MONSTART, (int (*)())brk); + monitoring = 1; + } } else { - monitor (0); - monitoring = 0; + monitor (0); + monitoring = 0; } Enable_Interrupts; return Void; @@ -85,8 +85,8 @@ void elk_init_lib_monitor () { void elk_finit_lib_monitor () { if (monitoring) { - monitoring = 0; - printf ("[writing mon.out]\n"); - monitor (0); + monitoring = 0; + printf ("[writing mon.out]\n"); + monitor (0); } } diff --git a/lib/misc/record.c b/lib/misc/record.c index f016a46..a0b61a4 100644 --- a/lib/misc/record.c +++ b/lib/misc/record.c @@ -68,15 +68,15 @@ static Object P_Make_Record_Type (Object name, Object fields) { GC_Node2; if (TYPE(name) == T_Symbol) - name = SYMBOL(name)->name; + name = SYMBOL(name)->name; else if (TYPE(name) != T_String) - Wrong_Type_Combination (name, "string or symbol"); + Wrong_Type_Combination (name, "string or symbol"); Check_List (fields); for (s = fields; !Nullp (s); s = Cdr (s)) { - Check_Type (Car (s), T_Symbol); - ismem = P_Memq (Car (s), Cdr (s)); - if (Truep (ismem)) - Primitive_Error ("duplicate field name"); + Check_Type (Car (s), T_Symbol); + ismem = P_Memq (Car (s), Cdr (s)); + if (Truep (ismem)) + Primitive_Error ("duplicate field name"); } GC_Link2 (name, fields); s = Alloc_Object (sizeof (struct S_Rtd), T_Rtd, 0); @@ -103,7 +103,7 @@ static Object P_Make_Record (Object rtd, Object values) { Check_Type (rtd, T_Rtd); Check_Type (values, T_Vector); if (VECTOR(values)->size != Fast_Length (RTD(rtd)->fields)) - Primitive_Error ("wrong number of fields for record type"); + Primitive_Error ("wrong number of fields for record type"); GC_Link2 (rtd, values); s = Alloc_Object (sizeof (struct S_Record), T_Record, 0); RECORD(s)->rtd = rtd; @@ -119,12 +119,12 @@ static int Rtd_Eqv (Object a, Object b) { static int Rtd_Equal (Object a, Object b) { return EQ(RTD(a)->name, RTD(b)->name) && - Equal (RTD(a)->fields, RTD(b)->fields); + Equal (RTD(a)->fields, RTD(b)->fields); } static int Record_Equal (Object a, Object b) { return EQ(RECORD(a)->rtd, RECORD(b)->rtd) && - Equal (RECORD(a)->values, RECORD(b)->values); + Equal (RECORD(a)->values, RECORD(b)->values); } static int Rtd_Print (Object x, Object port, int raw, int depth, int length) { @@ -156,14 +156,14 @@ static int Record_Visit (register Object *sp, register int (*f)()) { void elk_init_lib_record () { T_Rtd = Define_Type (0, "record-type", NOFUNC, sizeof (struct S_Rtd), - Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit); + Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit); Def_Prim (P_Rtdp, "record-type?", 1, 1, EVAL); Def_Prim (P_Rtd_Name, "record-type-name", 1, 1, EVAL); Def_Prim (P_Rtd_Field_Names, "record-type-field-names", 1, 1, EVAL); Def_Prim (P_Make_Record_Type, "make-record-type", 2, 2, EVAL); T_Record = Define_Type (0, "record", NOFUNC, sizeof (struct S_Record), - Record_Eqv, Record_Equal, Record_Print, Record_Visit); + Record_Eqv, Record_Equal, Record_Print, Record_Visit); Def_Prim (P_Recordp, "record?", 1, 1, EVAL); Def_Prim (P_Record_Type, "record-type-descriptor", 1, 1, EVAL); Def_Prim (P_Record_Values, "record-values", 1, 1, EVAL); diff --git a/lib/misc/regexp.c b/lib/misc/regexp.c index d5c68b7..d815514 100644 --- a/lib/misc/regexp.c +++ b/lib/misc/regexp.c @@ -82,12 +82,12 @@ static Object P_Matchp(Object x) { static int Regexp_Eqv(Object a, Object b) { return EQ(REGEXP(a)->pattern, REGEXP(b)->pattern) - && REGEXP(a)->flags == REGEXP(b)->flags; + && REGEXP(a)->flags == REGEXP(b)->flags; } static int Regexp_Equal(Object a, Object b) { return Equal(REGEXP(a)->pattern, REGEXP(b)->pattern) - && REGEXP(a)->flags == REGEXP(b)->flags; + && REGEXP(a)->flags == REGEXP(b)->flags; } static int Match_Equal(Object a, Object b) { @@ -95,11 +95,11 @@ static int Match_Equal(Object a, Object b) { struct S_Match *ap = MATCH(a), *bp = MATCH(b); if (ap->num != bp->num) - return 0; + return 0; for (i = 0; i < ap->num; i++) { - if (ap->matches[i].rm_so != bp->matches[i].rm_so || - ap->matches[i].rm_eo != bp->matches[i].rm_eo) - return 0; + if (ap->matches[i].rm_so != bp->matches[i].rm_so || + ap->matches[i].rm_eo != bp->matches[i].rm_eo) + return 0; } return 1; } @@ -135,18 +135,18 @@ static Object P_Make_Regexp(int argc, Object *argv) { Check_Type(argv[0], T_String); if (argc == 2) - flags = Symbols_To_Bits(argv[1], 1, Compile_Syms); + flags = Symbols_To_Bits(argv[1], 1, Compile_Syms); r = Alloc_Object(sizeof(struct S_Regexp), T_Regexp, 0); REGEXP(r)->pattern = argv[0]; REGEXP(r)->flags = flags; ret = regcomp(®EXP(r)->r, Get_String(argv[0]), flags); if (ret != 0) { #ifdef REG_ENOSYS - if (ret == REG_ENOSYS) - Primitive_Error("function not supported by operating system"); + if (ret == REG_ENOSYS) + Primitive_Error("function not supported by operating system"); #endif - (void)regerror(ret, ®EXP(r)->r, msg, sizeof(msg)); - Primitive_Error("~a", Make_String(msg, strlen(msg))); + (void)regerror(ret, ®EXP(r)->r, msg, sizeof(msg)); + Primitive_Error("~a", Make_String(msg, strlen(msg))); } Register_Object(r, (GENERIC)0, Terminate_Regexp, 0); return r; @@ -175,28 +175,28 @@ static Object P_Regexp_Exec(int argc, Object *argv) { str = Get_String(argv[1]); from = Get_Unsigned(argv[2]); if (from > STRING(argv[1])->size) - Range_Error(argv[2]); + Range_Error(argv[2]); if (argc == 4) - flags = (int)Symbols_To_Bits(argv[3], 1, Exec_Syms); + flags = (int)Symbols_To_Bits(argv[3], 1, Exec_Syms); else - flags = 0; + flags = 0; if (REGEXP(r)->flags & REG_NOSUB) - num = 1; + num = 1; else - num = REGEXP(r)->r.re_nsub + 1; + num = REGEXP(r)->r.re_nsub + 1; GC_Link(r); m = Alloc_Object(sizeof(struct S_Match) + (num-1) * sizeof(regmatch_t), - T_Match, 0); + T_Match, 0); GC_Unlink; MATCH(m)->tag = Null; if (REGEXP(r)->flags & REG_NOSUB) - num = 0; + num = 0; MATCH(m)->num = num; ret = regexec(®EXP(r)->r, str+from, num, MATCH(m)->matches, flags); if (ret == 0) - return m; + return m; if (ret == REG_NOMATCH) - return False; + return False; (void)regerror(ret, ®EXP(r)->r, msg, sizeof(msg)); Primitive_Error("~a", Make_String(msg, strlen(msg))); /*NOTREACHED*/ @@ -213,7 +213,7 @@ static Object P_Match_Start(Object m, Object n) { Check_Type(m, T_Match); i = (size_t)Get_Unsigned_Long(n); if (i >= MATCH(m)->num) - Range_Error(n); + Range_Error(n); return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_so); } @@ -223,7 +223,7 @@ static Object P_Match_End(Object m, Object n) { Check_Type(m, T_Match); i = (size_t)Get_Unsigned_Long(n); if (i >= MATCH(m)->num) - Range_Error(n); + Range_Error(n); return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_eo); } @@ -235,9 +235,9 @@ static Object P_Match_End(Object m, Object n) { void elk_init_lib_regexp() { #ifdef HAVE_REGCOMP T_Regexp = Define_Type(0, "regexp", 0, sizeof(struct S_Regexp), - Regexp_Eqv, Regexp_Equal, Regexp_Print, Regexp_Visit); + Regexp_Eqv, Regexp_Equal, Regexp_Print, Regexp_Visit); T_Match = Define_Type(0, "regexp-match", Match_Size, 0, - Match_Equal, Match_Equal, Match_Print, 0); + Match_Equal, Match_Equal, Match_Print, 0); Def_Prim(P_Regexpp, "regexp?", 1, 1, EVAL); Def_Prim(P_Matchp, "regexp-match?", 1, 1, EVAL); Def_Prim(P_Make_Regexp, "make-regexp", 1, 2, VARARGS); diff --git a/lib/misc/struct.c b/lib/misc/struct.c index 182017f..717df34 100644 --- a/lib/misc/struct.c +++ b/lib/misc/struct.c @@ -65,8 +65,8 @@ static void Check_Structure_Type (Object x, Object t) { Check_Type (x, T_Struct); Check_Type (t, T_Symbol); if (!EQ(STRUCT(x)->name, t)) - Primitive_Error ("wrong structure type ~s (expected ~s)", - STRUCT(x)->name, t); + Primitive_Error ("wrong structure type ~s (expected ~s)", + STRUCT(x)->name, t); } static Object P_Structure_Ref (Object x, Object t, Object n) { @@ -98,8 +98,8 @@ static Object P_Make_Structure (Object name, Object slots) { STRUCT(s)->slots = vec; GC_Unlink; for (vp = VECTOR(vec)->data; n--; slots = Cdr (slots)) { - Check_Type (Car (slots), T_Symbol); - *vp++ = Car (slots); + Check_Type (Car (slots), T_Symbol); + *vp++ = Car (slots); } return s; } @@ -110,8 +110,8 @@ static int Structure_Eqv (Object a, Object b) { static int Structure_Equal (Object a, Object b) { return EQ(STRUCT(a)->name,STRUCT(b)->name) && - Equal (STRUCT(a)->slots, STRUCT(b)->slots) && - Equal (STRUCT(a)->values, STRUCT(b)->values); + Equal (STRUCT(a)->slots, STRUCT(b)->slots) && + Equal (STRUCT(a)->values, STRUCT(b)->values); } static int Structure_Print (Object x, Object port, @@ -130,7 +130,7 @@ static int Structure_Visit (register Object *sp, register int (*f)()) { void elk_init_lib_struct () { T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct), - Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit); + Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit); Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL); Define_Primitive (P_Structure_Name, "structure-name", 1, 1, EVAL); Define_Primitive (P_Structure_Slots, "structure-slots", 1, 1, EVAL); diff --git a/lib/unix/error.c b/lib/unix/error.c index 0da79b0..ccf456b 100644 --- a/lib/unix/error.c +++ b/lib/unix/error.c @@ -81,7 +81,7 @@ elk_init_unix_error() { Global_GC_Link(Unix_Errobj); Define_Variable(&V_Call_Errhandler, "unix-call-standard-error-handler?", - True); + True); Def_Prim(P_Errorp, "unix-error?", 1, 1, EVAL); Def_Prim(P_Errno, "unix-errno", 0, 0, EVAL); diff --git a/lib/unix/fdescr.c b/lib/unix/fdescr.c index 56498eb..07d2905 100644 --- a/lib/unix/fdescr.c +++ b/lib/unix/fdescr.c @@ -54,7 +54,7 @@ SYMDESCR Lseek_Syms[] = { */ static Object P_Close(fd) Object fd; { if (close(Get_Integer(fd)) == -1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Void; } @@ -63,11 +63,11 @@ static Object P_Close_On_Exec(argc, argv) int argc; Object *argv; { fd = Get_Integer(argv[0]); if ((flags = fcntl(fd, F_GETFD, 0)) == -1) - Raise_System_Error("fcntl(F_GETFD): ~E"); + Raise_System_Error("fcntl(F_GETFD): ~E"); if (argc == 2) { - Check_Type(argv[1], T_Boolean); - if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1) - Raise_System_Error("fcntl(F_SETFD): ~E"); + Check_Type(argv[1], T_Boolean); + if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1) + Raise_System_Error("fcntl(F_SETFD): ~E"); } return flags & 1 ? True : False; } @@ -76,7 +76,7 @@ static Object P_Dup(argc, argv) int argc; Object *argv; { int fd = Get_Integer(argv[0]), ret; if ((ret = (argc == 1 ? dup(fd) : dup2(fd, Get_Integer(argv[1])))) == -1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Make_Integer(ret); } @@ -85,10 +85,10 @@ static Object P_Filedescriptor_Flags(argc, argv) int argc; Object *argv; { fd = Get_Integer(argv[0]); if ((flags = fcntl(fd, F_GETFL, 0)) == -1) - Raise_System_Error("fcntl(F_GETFL): ~E"); + Raise_System_Error("fcntl(F_GETFL): ~E"); if (argc == 2) { - if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1) - Raise_System_Error("fcntl(F_SETFL): ~E"); + if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1) + Raise_System_Error("fcntl(F_SETFL): ~E"); } return Bits_To_Symbols((unsigned long)flags, 1, Fcntl_Flags); } @@ -102,19 +102,19 @@ static Object P_Fildescriptor_Port(fd, mode) Object fd, mode; { m = Get_String(mode); switch (m[0]) { case 'r': - flags = P_INPUT; break; + flags = P_INPUT; break; case 'w': case 'a': - flags = 0; break; + flags = 0; break; default: - Primitive_Error("invalid mode: ~s", mode); + Primitive_Error("invalid mode: ~s", mode); } if (m[1] == '+') - flags = P_BIDIR; + flags = P_BIDIR; Disable_Interrupts; if ((fp = fdopen(n = Get_Integer(fd), m)) == 0) { - Saved_Errno = errno; - Enable_Interrupts; - Raise_System_Error("~E"); + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error("~E"); } sprintf(buf, "unix-fildescriptor[%d]", n); ret = Make_Port(flags, fp, Make_String(buf, strlen(buf))); @@ -141,8 +141,8 @@ static Object P_Lseek(fd, off, whence) Object fd, off, whence; { off_t ret; if ((ret = lseek(Get_Integer(fd), (off_t)Get_Long(off), - (int)Symbols_To_Bits(whence, 0, Lseek_Syms))) == (off_t)-1) - Raise_System_Error("~E"); + (int)Symbols_To_Bits(whence, 0, Lseek_Syms))) == (off_t)-1) + Raise_System_Error("~E"); return Make_Unsigned_Long((unsigned long)ret); } @@ -155,8 +155,8 @@ int Num_Filedescriptors() { #elif defined(SC_OPEN_MAX_IN_UNISTD_H) static r; if (r == 0) { - if ((r = sysconf(_SC_OPEN_MAX)) == -1) - r = 256; + if ((r = sysconf(_SC_OPEN_MAX)) == -1) + r = 256; } ret = r; #elif defined(NOFILE) @@ -178,13 +178,13 @@ static Object P_Open(argc, argv) int argc; Object *argv; { fn = argv[0]; mode = (int)Symbols_To_Bits(argv[1], 1, Open_Syms); if (!(n = mode & 3)) - Primitive_Error("mode must include 'read or 'write"); + Primitive_Error("mode must include 'read or 'write"); mode &= ~3; mode |= n-1; if (mode & O_CREAT && argc == 2) - Primitive_Error("third argument required for 'create"); + Primitive_Error("third argument required for 'create"); if ((n = open(Get_Strsym(fn), mode, argc == 3 ? Get_Integer(argv[2]) : 0)) - == -1) - Raise_System_Error1("~s: ~E", fn); + == -1) + Raise_System_Error1("~s: ~E", fn); return Make_Integer(n); } @@ -192,14 +192,14 @@ static Object P_Pipe() { int fd[2]; if (pipe(fd) == -1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Integer_Pair(fd[0], fd[1]); } static Object P_Port_Filedescriptor(port) Object port; { Check_Type(port, T_Port); if ((PORT(port)->flags & (P_STRING|P_OPEN)) != P_OPEN) - Primitive_Error("~s: invalid port", port); + Primitive_Error("~s: invalid port", port); return Make_Integer(fileno(PORT(port)->file)); } @@ -211,15 +211,15 @@ static Object Read_Write(argc, argv, readflg) int argc; Object *argv; { Check_Type(argv[1], T_String); sp = STRING(argv[1]); if (argc == 3) { - if ((len = Get_Integer(argv[2])) < 0 || len > sp->size) - Range_Error(argv[2]); + if ((len = Get_Integer(argv[2])) < 0 || len > sp->size) + Range_Error(argv[2]); } else len = sp->size; if (readflg) - len = read(fd, sp->data, len); + len = read(fd, sp->data, len); else - len = write(fd, sp->data, len); + len = write(fd, sp->data, len); if (len == -1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Make_Integer(len); } @@ -251,7 +251,7 @@ void elk_init_unix_fdescr() { Def_Prim(P_Fildescriptor_Port, "unix-filedescriptor->port",2, 2, EVAL); Def_Prim(P_Isatty, "unix-isatty?", 1, 1, EVAL); Def_Prim(P_List_Filedescriptor_Flags, - "unix-list-filedescriptor-flags", 0, 0, EVAL); + "unix-list-filedescriptor-flags", 0, 0, EVAL); Def_Prim(P_List_Open_Modes, "unix-list-open-modes", 0, 0, EVAL); Def_Prim(P_Lseek, "unix-lseek", 3, 3, EVAL); Def_Prim(P_Num_Filedescriptors, "unix-num-filedescriptors", 0, 0, EVAL); diff --git a/lib/unix/file.c b/lib/unix/file.c index f8e6122..6f5e036 100644 --- a/lib/unix/file.c +++ b/lib/unix/file.c @@ -27,39 +27,39 @@ static SYMDESCR Access_Syms[] = { static Object P_Accessp(fn, mode) Object fn, mode; { if (access(Get_Strsym(fn), (int)Symbols_To_Bits(mode, 1, Access_Syms)) - == 0) - return True; + == 0) + return True; Saved_Errno = errno; return False; } static Object P_Chdir(fn) Object fn; { if (chdir(Get_Strsym(fn)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Chmod(fn, mode) Object fn, mode; { if (chmod(Get_Strsym(fn), Get_Integer(mode)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Chown(fn, uid, gid) Object fn, uid, gid; { if (chown(Get_Strsym(fn), Get_Integer(uid), Get_Integer(gid)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Link(fn1, fn2) Object fn1, fn2; { if (link(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) - Raise_System_Error2("(~s ~s): ~E", fn1, fn2); + Raise_System_Error2("(~s ~s): ~E", fn1, fn2); return Void; } static Object P_Mkdir(fn, mode) Object fn, mode; { if (mkdir(Get_Strsym(fn), Get_Integer(mode)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } @@ -77,15 +77,15 @@ static Object P_Read_Directory(fn) Object fn; { GC_Link(ret); Disable_Interrupts; if ((d = opendir(Get_Strsym(fn))) == NULL) { - Saved_Errno = errno; - Enable_Interrupts; - Raise_System_Error1("~s: cannot open", fn); + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error1("~s: cannot open", fn); } while ((dp = readdir(d)) != NULL) { - Object x; + Object x; - x = Make_String(dp->d_name, strlen(dp->d_name)); - ret = Cons(x, ret); + x = Make_String(dp->d_name, strlen(dp->d_name)); + ret = Cons(x, ret); } /* closedir() is void under 4.3BSD, should check result elsewhere. */ @@ -98,21 +98,21 @@ static Object P_Read_Directory(fn) Object fn; { static Object P_Rename(fromfn, tofn) Object fromfn, tofn; { #ifdef HAVE_RENAME if (rename(Get_Strsym(fromfn), Get_Strsym(tofn)) == -1) - Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); + Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); #else char *from = Get_Strsym(fromfn), *to = Get_Strsym(tofn); Disable_Interrupts; if (link(from, to) == -1) { - Saved_Errno = errno; - Enable_Interrupts; - Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); } if (unlink(from) == -1) { - Saved_Errno = errno; - (void)unlink(to); - Enable_Interrupts; - Raise_Error1("~s: ~E", fromfn); + Saved_Errno = errno; + (void)unlink(to); + Enable_Interrupts; + Raise_Error1("~s: ~E", fromfn); } Enable_Interrupts; #endif @@ -129,14 +129,14 @@ static Object General_Stat(obj, ret, l) Object obj, ret; int l; { Check_Result_Vector(ret, 11); if (l) { #ifdef SYMLINKS - result = lstat(Get_Strsym(obj), &st); + result = lstat(Get_Strsym(obj), &st); #endif } else { - Get_Filename_Or_Filedescr(obj, fd, fn); + Get_Filename_Or_Filedescr(obj, fd, fn); result = fn ? stat(fn, &st) : fstat(fd, &st); } if (result == -1) - Raise_System_Error1("~s: ~E", obj); + Raise_System_Error1("~s: ~E", obj); switch (st.st_mode & S_IFMT) { case S_IFDIR: s = "directory"; break; case S_IFCHR: s = "character-special"; break; @@ -200,8 +200,8 @@ static Object P_Readlink(fn) Object fn; { len = Path_Max(); Alloca(buf, char*, len); if ((len = readlink(Get_Strsym(fn), buf, len)) == -1) { - Alloca_End; - Raise_System_Error1("~s: ~E", fn); + Alloca_End; + Raise_System_Error1("~s: ~E", fn); } ret = Make_String(buf, len); Alloca_End; @@ -210,20 +210,20 @@ static Object P_Readlink(fn) Object fn; { static Object P_Rmdir(fn) Object fn; { if (rmdir(Get_Strsym(fn)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Symlink(fn1, fn2) Object fn1, fn2; { if (symlink(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) - Raise_System_Error2("(~s ~s): ~E", fn1, fn2); + Raise_System_Error2("(~s ~s): ~E", fn1, fn2); return Void; } #endif static Object P_Unlink(fn) Object fn; { if (unlink(Get_Strsym(fn)) == -1) - Raise_System_Error1("~s: ~E", fn); + Raise_System_Error1("~s: ~E", fn); return Void; } @@ -231,14 +231,14 @@ static Object P_Utime(argc, argv) int argc; Object *argv; { struct utimbuf ut; if (argc == 2) - Primitive_Error("wrong number of arguments"); + Primitive_Error("wrong number of arguments"); if (argc == 3) { - ut.actime = (time_t)Get_Unsigned_Long(argv[1]); - ut.modtime = (time_t)Get_Unsigned_Long(argv[2]); + ut.actime = (time_t)Get_Unsigned_Long(argv[1]); + ut.modtime = (time_t)Get_Unsigned_Long(argv[2]); } if (utime(Get_Strsym(argv[0]), argc == 1 ? (struct utimbuf *)0 : &ut) - == -1) - Raise_System_Error1("~s: ~E", argv[0]); + == -1) + Raise_System_Error1("~s: ~E", argv[0]); return Void; } diff --git a/lib/unix/lock.c b/lib/unix/lock.c index c19f01b..1fe11e1 100644 --- a/lib/unix/lock.c +++ b/lib/unix/lock.c @@ -14,7 +14,7 @@ #ifdef LOCKS static Object P_Internal_Lock_Operation(fd, lck, block, what, ret) - Object fd, lck, block, what, ret; { + Object fd, lck, block, what, ret; { #ifdef RECORD_LOCKS struct flock fl; #else @@ -27,7 +27,7 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret) Check_Type(what, T_Character); op = CHAR(what); if (op == 'q') - Check_Result_Vector(ret, 4); + Check_Result_Vector(ret, 4); #ifdef RECORD_LOCKS Check_Type(block, T_Boolean); @@ -38,39 +38,39 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret) fl.l_start = Get_Long(*++vp); fl.l_len = Get_Long(*++vp); if (fcntl(Get_Integer(fd), op == 'q' ? F_GETLK : - (Truep(block) ? F_SETLKW : F_SETLK), &fl) == -1) { - if (op == 's' && !Truep(block) && (errno == EAGAIN || errno == EACCES)) - return False; - Raise_System_Error("fcntl: ~E"); + (Truep(block) ? F_SETLKW : F_SETLK), &fl) == -1) { + if (op == 's' && !Truep(block) && (errno == EAGAIN || errno == EACCES)) + return False; + Raise_System_Error("fcntl: ~E"); } if (op == 'q') { - Object x; - GC_Node; + Object x; + GC_Node; - if (fl.l_type == F_UNLCK) - return False; - GC_Link(ret); - VECTOR(ret)->data[0] = fl.l_type == F_WRLCK ? True : False; - x = Bits_To_Symbols((unsigned long)fl.l_whence, 0, Lseek_Syms); - VECTOR(ret)->data[1] = x; - x = Make_Long(fl.l_start); VECTOR(ret)->data[2] = x; - x = Make_Long(fl.l_len); VECTOR(ret)->data[3] = x; - GC_Unlink; - return Make_Integer(fl.l_pid); + if (fl.l_type == F_UNLCK) + return False; + GC_Link(ret); + VECTOR(ret)->data[0] = fl.l_type == F_WRLCK ? True : False; + x = Bits_To_Symbols((unsigned long)fl.l_whence, 0, Lseek_Syms); + VECTOR(ret)->data[1] = x; + x = Make_Long(fl.l_start); VECTOR(ret)->data[2] = x; + x = Make_Long(fl.l_len); VECTOR(ret)->data[3] = x; + GC_Unlink; + return Make_Integer(fl.l_pid); } #else Check_Type(block, T_Boolean); if (op == 'q') - return False; + return False; vp = VECTOR(lck)->data; Check_Type(*vp, T_Boolean); mode = op == 'r' ? LOCK_UN : (Truep(*vp) ? LOCK_EX : LOCK_SH); if (op != 'r' && !Truep(block)) - mode |= LOCK_NB; + mode |= LOCK_NB; if (flock(Get_Integer(fd), mode) == -1) { - if (op == 's' && !Truep(block) && errno == EWOULDBLOCK) - return False; - Raise_System_Error("flock: ~E"); + if (op == 's' && !Truep(block) && errno == EWOULDBLOCK) + return False; + Raise_System_Error("flock: ~E"); } #endif return op == 's' ? True : Void; @@ -81,7 +81,7 @@ static Object P_Internal_Lock_Operation(fd, lck, block, what, ret) elk_init_unix_lock() { #ifdef LOCKS Def_Prim(P_Internal_Lock_Operation, "unix-internal-lock-operation", - 5, 5, EVAL); + 5, 5, EVAL); P_Provide(Intern("unix:file-locking")); #ifdef RECORD_LOCKS P_Provide(Intern("unix:record-locks")); diff --git a/lib/unix/misc.c b/lib/unix/misc.c index 2b34b5e..d5d35a9 100644 --- a/lib/unix/misc.c +++ b/lib/unix/misc.c @@ -8,7 +8,7 @@ static Object P_Getpass(prompt) Object prompt; { ret = getpass(Get_String(prompt)); Enable_Interrupts; if (ret == 0) - Raise_Error("cannot read password from /dev/tty"); + Raise_Error("cannot read password from /dev/tty"); return Make_String(ret, strlen(ret)); } diff --git a/lib/unix/passwd.c b/lib/unix/passwd.c index a490a5b..a95947d 100644 --- a/lib/unix/passwd.c +++ b/lib/unix/passwd.c @@ -10,26 +10,26 @@ static Object P_Get_Passwd(argc, argv) int argc; Object *argv; { Check_Result_Vector(argv[0], 7); Disable_Interrupts; if (argc == 1) { - if ((p = getpwent()) == 0) { - Enable_Interrupts; - Raise_Error("no more passwd entries"); - } + if ((p = getpwent()) == 0) { + Enable_Interrupts; + Raise_Error("no more passwd entries"); + } } else { - arg = argv[1]; - switch (TYPE(arg)) { - case T_Fixnum: case T_Bignum: - p = getpwuid(Get_Integer(arg)); - break; - case T_String: case T_Symbol: - p = getpwnam(Get_String(arg)); - break; - default: - Wrong_Type_Combination(arg, "integer, string, or symbol"); - } - if (p == 0) { - Enable_Interrupts; - Raise_Error1("no passwd entry for ~s", arg); - } + arg = argv[1]; + switch (TYPE(arg)) { + case T_Fixnum: case T_Bignum: + p = getpwuid(Get_Integer(arg)); + break; + case T_String: case T_Symbol: + p = getpwnam(Get_String(arg)); + break; + default: + Wrong_Type_Combination(arg, "integer, string, or symbol"); + } + if (p == 0) { + Enable_Interrupts; + Raise_Error1("no passwd entry for ~s", arg); + } } Enable_Interrupts; x = Make_String(p->pw_name, strlen(p->pw_name)); @@ -72,26 +72,26 @@ static Object P_Get_Group(argc, argv) int argc; Object *argv; { Check_Result_Vector(argv[0], 4); Disable_Interrupts; if (argc == 1) { - if ((p = getgrent()) == 0) { - Enable_Interrupts; - Raise_Error("no more group entries"); - } + if ((p = getgrent()) == 0) { + Enable_Interrupts; + Raise_Error("no more group entries"); + } } else { - arg = argv[1]; - switch (TYPE(arg)) { - case T_Fixnum: case T_Bignum: - p = getgrgid(Get_Integer(arg)); - break; - case T_String: case T_Symbol: - p = getgrnam(Get_String(arg)); - break; - default: - Wrong_Type_Combination(arg, "integer, string, or symbol"); - } - if (p == 0) { - Enable_Interrupts; - Raise_Error1("no group entry for ~s", arg); - } + arg = argv[1]; + switch (TYPE(arg)) { + case T_Fixnum: case T_Bignum: + p = getgrgid(Get_Integer(arg)); + break; + case T_String: case T_Symbol: + p = getgrnam(Get_String(arg)); + break; + default: + Wrong_Type_Combination(arg, "integer, string, or symbol"); + } + if (p == 0) { + Enable_Interrupts; + Raise_Error1("no group entry for ~s", arg); + } } Enable_Interrupts; x = Make_String(p->gr_name, strlen(p->gr_name)); @@ -103,8 +103,8 @@ static Object P_Get_Group(argc, argv) int argc; Object *argv; { x = Null; GC_Link(x); for (pp = p->gr_mem; *pp; pp++) { - member = Intern(*pp); - x = Cons(member, x); + member = Intern(*pp); + x = Cons(member, x); } x = P_Reverse(x); GC_Unlink; diff --git a/lib/unix/process.c b/lib/unix/process.c index cf0ec88..6d551f5 100644 --- a/lib/unix/process.c +++ b/lib/unix/process.c @@ -17,23 +17,23 @@ static Object P_Environ() { cell = ret = Null; GC_Link2(ret, cell); for (ep = environ; *ep; ep++) { - cell = Cons(Null, Null); - if (p = index(*ep, '=')) - *p++ = 0; - else p = c+1; - str = Make_String(p, strlen(p)); - Cdr(cell) = str; - str = Make_String(*ep, strlen(*ep)); - Car(cell) = str; - ret = Cons(cell, ret); - *--p = '='; + cell = Cons(Null, Null); + if (p = index(*ep, '=')) + *p++ = 0; + else p = c+1; + str = Make_String(p, strlen(p)); + Cdr(cell) = str; + str = Make_String(*ep, strlen(*ep)); + Car(cell) = str; + ret = Cons(cell, ret); + *--p = '='; } GC_Unlink; return P_Reverse(ret); } static Object General_Exec(argc, argv, path) int argc; Object *argv; - int path; { + int path; { Object fn, args, p, e; char *fnp, **argp, **envp; int i, len; @@ -45,42 +45,42 @@ static Object General_Exec(argc, argv, path) int argc; Object *argv; len = Fast_Length(args); Alloca(argp, char**, (len+1) * sizeof(char*)); for (i = 0, p = args; i < len; i++, p = Cdr(p)) { - e = Car(p); - Get_String_Stack(e, argp[i]); + e = Car(p); + Get_String_Stack(e, argp[i]); } argp[i] = 0; if (argc == 3) { - args = argv[2]; - Check_List(args); - len = Fast_Length(args); - Alloca(envp, char**, (len+1) * sizeof(char*)); - for (i = 0, p = args; i < len; i++, p = Cdr(p)) { - struct S_String *s1, *s2; + args = argv[2]; + Check_List(args); + len = Fast_Length(args); + Alloca(envp, char**, (len+1) * sizeof(char*)); + for (i = 0, p = args; i < len; i++, p = Cdr(p)) { + struct S_String *s1, *s2; - e = Car(p); - Check_Type(e, T_Pair); - Check_Type(Car(e), T_String); - Check_Type(Cdr(e), T_String); - s1 = STRING(Car(e)); - s2 = STRING(Cdr(e)); - Alloca(envp[i], char*, s1->size + 1 + s2->size + 1); - sprintf(envp[i], "%.*s=%.*s", s1->size, s1->data, - s2->size, s2->data); - } - envp[i] = 0; - Exit_Handler(); + e = Car(p); + Check_Type(e, T_Pair); + Check_Type(Car(e), T_String); + Check_Type(Cdr(e), T_String); + s1 = STRING(Car(e)); + s2 = STRING(Cdr(e)); + Alloca(envp[i], char*, s1->size + 1 + s2->size + 1); + sprintf(envp[i], "%.*s=%.*s", s1->size, s1->data, + s2->size, s2->data); + } + envp[i] = 0; + Exit_Handler(); #if 0 - if (path) - (void)execvpe(fnp, argp, envp); /* ... doesn't exist */ - else + if (path) + (void)execvpe(fnp, argp, envp); /* ... doesn't exist */ + else #endif - (void)execve(fnp, argp, envp); + (void)execve(fnp, argp, envp); } else { - Exit_Handler(); - if (path) - (void)execvp(fnp, argp); - else - (void)execv(fnp, argp); + Exit_Handler(); + if (path) + (void)execvp(fnp, argp); + else + (void)execv(fnp, argp); } Alloca_End; Raise_System_Error1("~s: ~E", fn); @@ -92,7 +92,7 @@ static Object P_Exec(argc, argv) int argc; Object *argv; { static Object P_Exec_Path(argc, argv) int argc; Object *argv; { if (argc == 3) /* There is no execvpe (yet?). */ - Primitive_Error("environment argument not supported"); + Primitive_Error("environment argument not supported"); return General_Exec(argc, argv, 1); } @@ -101,9 +101,9 @@ static Object P_Fork() { switch (pid = fork()) { case -1: - Raise_System_Error("~E"); + Raise_System_Error("~E"); case 0: - Call_Onfork(); + Call_Onfork(); } return Make_Integer(pid); } @@ -123,7 +123,7 @@ static Object P_Getlogin() { s = getlogin(); Enable_Interrupts; if (s == 0) - Raise_Error("cannot get login name"); + Raise_Error("cannot get login name"); return Make_String(s, strlen(s)); } @@ -146,19 +146,19 @@ static Object P_Getgroups() { */ if ((n = getgroups(0, (GETGROUPS_TYPE *)0)) == -1) #ifdef NGROUPS - n = NGROUPS; /* 4.3BSD */ + n = NGROUPS; /* 4.3BSD */ #else - Raise_System_Error("~E"); + Raise_System_Error("~E"); #endif Alloca(p, GETGROUPS_TYPE*, n*sizeof(GETGROUPS_TYPE)); (void)getgroups(n, p); next = ret = P_Make_List(Make_Integer(n), Null); GC_Link2(ret, next); for (i = 0; i < n; i++, next = Cdr(next)) { - Object x; + Object x; - x = Make_Unsigned((unsigned)p[i]); - Car(next) = x; + x = Make_Unsigned((unsigned)p[i]); + Car(next) = x; } GC_Unlink; Alloca_End; @@ -170,7 +170,7 @@ static Object P_Nice(incr) Object incr; { errno = 0; if ((ret = nice(Get_Integer(incr))) == -1 && errno != 0) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Make_Integer(ret); } @@ -181,8 +181,8 @@ static Object Open_Pipe(cmd, flags) Object cmd; int flags; { Disable_Interrupts; if ((fp = popen(Get_String(cmd), flags == P_INPUT ? "r" : "w")) == 0) { - Enable_Interrupts; - Raise_Error("cannot open pipe to process"); + Enable_Interrupts; + Raise_Error("cannot open pipe to process"); } ret = Make_Port(flags, fp, Make_String("pipe-port", 9)); PORT(ret)->closefun = pclose; @@ -207,15 +207,15 @@ static Object P_Process_Resources(ret1, ret2) Object ret1, ret2; { if (hzval == 0) { #ifdef HZ - hzval = HZ; + hzval = HZ; #else #ifdef CLK_TCK - hzval = CLK_TCK; + hzval = CLK_TCK; #else #ifdef _SC_CLK_TCK - hzval = (int)sysconf(_SC_CLK_TCK); + hzval = (int)sysconf(_SC_CLK_TCK); #else - hzval = 60; /* Fallback for 4.3BSD. I don't have a better idea. */ + hzval = 60; /* Fallback for 4.3BSD. I don't have a better idea. */ #endif #endif #endif @@ -251,24 +251,24 @@ static Object P_System(cmd) Object cmd; { switch (pid = fork()) { #endif case -1: - Raise_System_Error("fork: ~E"); + Raise_System_Error("fork: ~E"); case 0: - for (n = Num_Filedescriptors(); n >= 3; n--) - (void)close(n); - execl("/bin/sh", "sh", "-c", s, (char *)0); - _exit(127); + for (n = Num_Filedescriptors(); n >= 3; n--) + (void)close(n); + execl("/bin/sh", "sh", "-c", s, (char *)0); + _exit(127); default: - Disable_Interrupts; - while ((n = wait(&status)) != pid && n != -1) - ; - Enable_Interrupts; + Disable_Interrupts; + while ((n = wait(&status)) != pid && n != -1) + ; + Enable_Interrupts; } /* Can this happen? if (n == -1) - return False; + return False; */ if (n = (status & 0377)) - return Cons(Make_Integer(n), Null); + return Cons(Make_Integer(n), Null); return Make_Integer((status >> 8) & 0377); } @@ -290,27 +290,27 @@ static Object P_Working_Directory() { Disable_Interrupts; #ifdef HAVE_GETCWD if (getcwd(buf, max) == 0) { - Saved_Errno = errno; - Alloca_End; - Enable_Interrupts; - Raise_System_Error("~E"); + Saved_Errno = errno; + Alloca_End; + Enable_Interrupts; + Raise_System_Error("~E"); } #else #ifdef HAVE_GETWD if (getwd(buf) == 0) { - Alloca_End; - Enable_Interrupts; - Raise_Error(buf); + Alloca_End; + Enable_Interrupts; + Raise_Error(buf); } #else if ((fp = popen("pwd", "r")) == 0) { err: - Alloca_End; - Enable_Interrupts; - Raise_Error("cannot get output from pwd"); + Alloca_End; + Enable_Interrupts; + Raise_Error("cannot get output from pwd"); } if (fgets(buf, max, fp) == 0) - goto err; + goto err; if (p = index(buf, '\n')) *p = '\0'; (void)pclose(fp); #endif @@ -336,7 +336,7 @@ elk_init_unix_process() { Def_Prim(P_Open_Input_Pipe, "unix-open-input-pipe", 1, 1, EVAL); Def_Prim(P_Open_Output_Pipe, "unix-open-output-pipe", 1, 1, EVAL); Def_Prim(P_Process_Resources, "unix-process-resources-vector-fill!", - 2, 2, EVAL); + 2, 2, EVAL); Def_Prim(P_Sleep, "unix-sleep", 1, 1, EVAL); Def_Prim(P_System, "unix-system", 1, 1, EVAL); Def_Prim(P_Umask, "unix-umask", 1, 1, EVAL); diff --git a/lib/unix/signal.c b/lib/unix/signal.c index 3269244..58afa1a 100644 --- a/lib/unix/signal.c +++ b/lib/unix/signal.c @@ -152,13 +152,13 @@ static Object P_Kill(pid, sig) Object pid, sig; { int t, s; if ((t = TYPE(sig)) == T_Fixnum || t == T_Bignum) - s = Get_Integer(sig); + s = Get_Integer(sig); else if (t == T_Symbol) - s = Symbols_To_Bits(sig, 0, Signal_Syms); + s = Symbols_To_Bits(sig, 0, Signal_Syms); else - Wrong_Type_Combination(sig, "symbol or integer"); + Wrong_Type_Combination(sig, "symbol or integer"); if (kill(Get_Integer(pid), s) == -1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Void; } @@ -196,7 +196,7 @@ void General_Handler(sig) int sig; { args = Cons(args, Null); fun = VECTOR(Handlers)->data[sig]; if (TYPE(fun) != T_Compound) - Fatal_Error("no handler for signal %d", sig); + Fatal_Error("no handler for signal %d", sig); (void)Funcall(fun, args, 0); Format(Curr_Output_Port, "~%\7Signal!~%", 15, 0, (Object *)0); (void)P_Reset(); @@ -207,13 +207,13 @@ static Object Action_To_Sym(act) void (*act)(); { char *sym; if (act == Signal_Exit) - sym = "exit"; + sym = "exit"; else if (act == SIG_IGN) - sym = "ignore"; + sym = "ignore"; else if (act == SIG_DFL || act == (void (*)())-1) - sym = "default"; + sym = "default"; else - sym = "handler"; + sym = "handler"; return Intern(sym); } @@ -224,7 +224,7 @@ void Add_To_Mask(sig) int sig; { Sigmask_Block |= sigmask(sig); #endif if (Intr_Level > 0) /* make sure new signal gets blocked */ - Force_Disable_Interrupts; + Force_Disable_Interrupts; } void Remove_From_Mask(sig) int sig; { @@ -242,14 +242,14 @@ static Object P_Signal(argc, argv) int argc; Object *argv; { sig = Symbols_To_Bits(argv[0], 0, Signal_Syms); if (sig >= NSIG) - Fatal_Error("signal %d >= NSIG", sig); + Fatal_Error("signal %d >= NSIG", sig); if (argc == 1) { - handler = VECTOR(Handlers)->data[sig]; - if (Truep(handler)) - return handler; - if ((disp = signal(sig, SIG_DFL)) != SIG_DFL) - (void)signal(sig, disp); - return Action_To_Sym(disp); + handler = VECTOR(Handlers)->data[sig]; + if (Truep(handler)) + return handler; + if ((disp = signal(sig, SIG_DFL)) != SIG_DFL) + (void)signal(sig, disp); + return Action_To_Sym(disp); } switch (sig) { #ifdef SIGBUS @@ -263,30 +263,30 @@ static Object P_Signal(argc, argv) int argc; Object *argv; { #ifdef SIGABRT case SIGABRT: #endif - Primitive_Error("changing signal ~s not permitted", argv[0]); + Primitive_Error("changing signal ~s not permitted", argv[0]); } handler = argv[1]; if (EQ(handler, Sym_Exit)) { - disp = Signal_Exit; + disp = Signal_Exit; } else if (EQ(handler, Sym_Default)) { - disp = SIG_DFL; + disp = SIG_DFL; } else if (EQ(handler, Sym_Ignore)) { - disp = SIG_IGN; + disp = SIG_IGN; } else if (TYPE(handler) == T_Compound) { - if (COMPOUND(handler)->min_args > 1 || - COMPOUND(handler)->max_args == 0) - Primitive_Error("handler expects wrong number of args"); - disp = General_Handler; + if (COMPOUND(handler)->min_args > 1 || + COMPOUND(handler)->max_args == 0) + Primitive_Error("handler expects wrong number of args"); + disp = General_Handler; } else - Primitive_Error("invalid handler: ~s", handler); + Primitive_Error("invalid handler: ~s", handler); old = VECTOR(Handlers)->data[sig]; VECTOR(Handlers)->data[sig] = (disp == General_Handler) ? handler : False; if (disp == General_Handler) - Add_To_Mask(sig); + Add_To_Mask(sig); else - Remove_From_Mask(sig); + Remove_From_Mask(sig); if ((disp = signal(sig, disp)) == (void (*)())-1) - Raise_System_Error("~E"); + Raise_System_Error("~E"); return Truep(old) ? old : Action_To_Sym(disp); } #endif /* RELIABLE_SIGNALS */ diff --git a/lib/unix/system.c b/lib/unix/system.c index 7298f4c..9918cb5 100644 --- a/lib/unix/system.c +++ b/lib/unix/system.c @@ -27,68 +27,68 @@ static Object P_File_Limit(lim, f) Object lim, f; { switch (Symbols_To_Bits(lim, 0, Limit_Syms)) { case L_LINK_MAX: #ifdef LINK_MAX - return Make_Integer(LINK_MAX); + return Make_Integer(LINK_MAX); #else #ifdef _PC_LINK_MAX - op = _PC_LINK_MAX; + op = _PC_LINK_MAX; # define HAVEOP #else - return Make_Integer(sizeof(short) * 8); /* guess */ + return Make_Integer(sizeof(short) * 8); /* guess */ #endif #endif - break; + break; case L_NAME_MAX: #ifdef NAME_MAX - return Make_Integer(NAME_MAX); + return Make_Integer(NAME_MAX); #else #ifdef _PC_NAME_MAX - op = _PC_NAME_MAX; + op = _PC_NAME_MAX; # define HAVEOP #else - return Make_Integer(255); /* guess */ + return Make_Integer(255); /* guess */ #endif #endif - break; + break; case L_PATH_MAX: #ifdef MAX_PATH - return Make_Integer(MAX_PATH); + return Make_Integer(MAX_PATH); #else #ifdef _PC_PATH_MAX - op = _PC_PATH_MAX; + op = _PC_PATH_MAX; # define HAVEOP #else #ifdef MAXPATHLEN - return Make_Integer(MAXPATHLEN); + return Make_Integer(MAXPATHLEN); #else - return Make_Integer(1024); /* guess */ + return Make_Integer(1024); /* guess */ #endif #endif #endif - break; + break; case L_PIPE_BUF: #ifdef PIPE_BUF - return Make_Integer(PIPE_BUF); + return Make_Integer(PIPE_BUF); #else #ifdef _PC_PIPE_BUF - op = _PC_PIPE_BUF; + op = _PC_PIPE_BUF; # define HAVEOP #else - return Make_Integer(512); /* guess */ + return Make_Integer(512); /* guess */ #endif #endif - break; + break; case L_NO_TRUNC: #ifdef _PC_NO_TRUNC - op = _PC_NO_TRUNC; + op = _PC_NO_TRUNC; # define HAVEOP #else - return False; /* guess */ + return False; /* guess */ #endif - break; + break; } #ifdef HAVEOP /* If we get here, we have a _PC_XXX symbol in `op' and can invoke @@ -99,17 +99,17 @@ static Object P_File_Limit(lim, f) Object lim, f; { ret = fn ? pathconf(fn, op) : fpathconf(fd, op); if (ret == -1) { #ifdef _PC_NO_TRUNC - if (op == _PC_NO_TRUNC && errno == 0) - return False; + if (op == _PC_NO_TRUNC && errno == 0) + return False; #endif - Raise_System_Error1("~s: ~E", f); + Raise_System_Error1("~s: ~E", f); } #ifdef _PC_NO_TRUNC if (op == _PC_NO_TRUNC) - return ret ? True : False; + return ret ? True : False; else #endif - return Make_Long(ret); + return Make_Long(ret); #endif } @@ -161,7 +161,7 @@ static Object P_System_Info(ret) Object ret; { x = Make_String(p, strlen(p)); VECTOR(ret)->data[0] = x; strcpy(systype, SYSTEMTYPE); if ((p = index(systype, '-')) && (q = index(p+1, '-'))) { - *p++ = 0; *q = 0; + *p++ = 0; *q = 0; } else p = "?"; x = Make_String(systype, strlen(systype)); VECTOR(ret)->data[1] = x; x = Make_String(p, strlen(p)); VECTOR(ret)->data[2] = x; diff --git a/lib/unix/temp.c b/lib/unix/temp.c index d96f120..5f6e706 100644 --- a/lib/unix/temp.c +++ b/lib/unix/temp.c @@ -33,9 +33,9 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; { #endif if (argc > 0) - dir = Get_Strsym(argv[0]); + dir = Get_Strsym(argv[0]); if (argc > 1) - pref = Get_Strsym(argv[1]); + pref = Get_Strsym(argv[1]); #ifdef HAVE_TMPNAM name = tmpnam((char *)0); #else @@ -46,7 +46,7 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; { if (!dir) dir = "/tmp"; if (!pref) pref = "elk"; if (strlen(dir) + strlen(pref) > 1000) - Primitive_Error("directory/prefix argument too long"); + Primitive_Error("directory/prefix argument too long"); #ifdef HAVE_MKTEMP sprintf(buf, "%s/%sXXXXXX", dir, pref); name = mktemp(buf); @@ -55,29 +55,29 @@ static Object P_Tempname(argc, argv) int argc; Object *argv; { sprintf(buf, "%s/%sa%d", dir, pref, getpid()); p = buf+strlen(dir)+strlen(pref)+1; while (stat(buf, &st) == 0) { /* Simple ersatz mktemp */ - q = p; - while (1) { - if (*q == '\0') goto fail; - if (*q == 'z') { - *q++ = 'a'; - } else { - if (*q >= '0' && *q <= '9') - *q = 'a'; - else - *++q; - break; - } - } + q = p; + while (1) { + if (*q == '\0') goto fail; + if (*q == 'z') { + *q++ = 'a'; + } else { + if (*q >= '0' && *q <= '9') + *q = 'a'; + else + *++q; + break; + } + } } if (errno == ENOENT) - name = buf; + name = buf; fail: ; #endif #endif #endif if (name == 0 || name[0] == '\0') { - Enable_Interrupts; - Raise_Error("cannot create temp file name"); + Enable_Interrupts; + Raise_Error("cannot create temp file name"); } ret = Make_String(name, strlen(name)); #ifdef HAVE_TEMPNAM diff --git a/lib/unix/time.c b/lib/unix/time.c index 2e1b420..b1e74a4 100644 --- a/lib/unix/time.c +++ b/lib/unix/time.c @@ -89,20 +89,20 @@ static struct tm *Get_Tm(v) Object v; { int i, n; Object *op; static struct { int min, max; } bounds[] = { - { 0, 61 }, /* sec */ - { 0, 59 }, /* min */ - { 0, 23 }, /* hour */ - { 1, 31 }, /* mday */ - { 0, 11 }, /* mon */ - { 0, 65535 }, /* year */ - { 0, 7 }, /* wday */ - { 0, 365 } /* yday */ + { 0, 61 }, /* sec */ + { 0, 59 }, /* min */ + { 0, 23 }, /* hour */ + { 1, 31 }, /* mday */ + { 0, 11 }, /* mon */ + { 0, 65535 }, /* year */ + { 0, 7 }, /* wday */ + { 0, 365 } /* yday */ }; Check_Result_Vector(v, 9); for (op = VECTOR(v)->data, i = 0; i < 7; i++, op++) - if ((n = Get_Integer(*op)) < bounds[i].min || n > bounds[i].max) - Range_Error(*op); + if ((n = Get_Integer(*op)) < bounds[i].min || n > bounds[i].max) + Range_Error(*op); op = VECTOR(v)->data; tm.tm_sec = Get_Integer(*op++); tm.tm_min = Get_Integer(*op++); @@ -122,15 +122,15 @@ static Object P_Time_To_String(t) Object t; { switch (TYPE(t)) { case T_Fixnum: case T_Bignum: - tt = (time_t)Get_Unsigned_Long(t); - ret = ctime(&tt); - break; + tt = (time_t)Get_Unsigned_Long(t); + ret = ctime(&tt); + break; case T_Vector: - ret = asctime(Get_Tm(t)); - break; + ret = asctime(Get_Tm(t)); + break; default: - Wrong_Type_Combination(t, "integer or vector"); - /*NOTREACHED*/ + Wrong_Type_Combination(t, "integer or vector"); + /*NOTREACHED*/ } return Make_String(ret, strlen(ret)); } diff --git a/lib/unix/unix.c b/lib/unix/unix.c index 9d1cdd5..1751fd5 100644 --- a/lib/unix/unix.c +++ b/lib/unix/unix.c @@ -20,8 +20,8 @@ Object Syms_To_List(p) SYMDESCR *p; { ret = Null; GC_Link(ret); for ( ; p->name; p++) { - mode = Intern(p->name); - ret = Cons(mode, ret); + mode = Intern(p->name); + ret = Cons(mode, ret); } GC_Unlink; return P_Reverse(ret); @@ -30,7 +30,7 @@ Object Syms_To_List(p) SYMDESCR *p; { void Check_Result_Vector(x, len) Object x; { Check_Type(x, T_Vector); if (VECTOR(x)->size != len) - Primitive_Error("argument vector has the wrong length"); + Primitive_Error("argument vector has the wrong length"); } elk_init_unix_unix() { diff --git a/lib/unix/unix.h b/lib/unix/unix.h index 5f5faf9..5a1881b 100644 --- a/lib/unix/unix.h +++ b/lib/unix/unix.h @@ -24,11 +24,11 @@ Object Syms_To_List P_((SYMDESCR*)); #define Get_Filename_Or_Filedescr(obj,fd,fn) \ switch (TYPE(obj)) {\ case T_String: case T_Symbol:\ - (fn) = Get_Strsym(obj); break;\ + (fn) = Get_Strsym(obj); break;\ case T_Fixnum: case T_Bignum:\ - (fd) = Get_Integer(obj); break;\ + (fd) = Get_Integer(obj); break;\ default:\ - Wrong_Type_Combination(obj, "symbol, string, or integer");\ + Wrong_Type_Combination(obj, "symbol, string, or integer");\ } #define Raise_System_Error(msg) {\ @@ -38,7 +38,7 @@ Object Syms_To_List P_((SYMDESCR*)); #define Raise_Error(msg) {\ if (Var_Is_True(V_Call_Errhandler))\ - Primitive_Error(msg);\ + Primitive_Error(msg);\ return Unix_Errobj;\ } @@ -49,7 +49,7 @@ Object Syms_To_List P_((SYMDESCR*)); #define Raise_Error1(msg,a1) {\ if (Var_Is_True(V_Call_Errhandler))\ - Primitive_Error(msg,a1);\ + Primitive_Error(msg,a1);\ return Unix_Errobj;\ } @@ -60,7 +60,7 @@ Object Syms_To_List P_((SYMDESCR*)); #define Raise_Error2(msg,a1,a2) {\ if (Var_Is_True(V_Call_Errhandler))\ - Primitive_Error(msg,a1,a2);\ + Primitive_Error(msg,a1,a2);\ return Unix_Errobj;\ } diff --git a/lib/unix/wait.c b/lib/unix/wait.c index 82757d3..9d0de7e 100644 --- a/lib/unix/wait.c +++ b/lib/unix/wait.c @@ -44,7 +44,7 @@ static SYMDESCR Wait_Flags[] = { static Object General_Wait(ret, ruret, haspid, pid, options) - Object ret, ruret; int haspid, pid, options; { + Object ret, ruret; int haspid, pid, options; { int retpid, st, code; char *status; #ifdef WAIT_RUSAGE @@ -59,47 +59,47 @@ static Object General_Wait(ret, ruret, haspid, pid, options) Check_Result_Vector(ruret, 2); if (haspid) { #ifdef HAVE_WAIT4 - retpid = wait4(pid, &st, options, &ru); + retpid = wait4(pid, &st, options, &ru); #else #ifdef HAVE_WAITPID - retpid = waitpid(pid, &st, options); + retpid = waitpid(pid, &st, options); #endif #endif } else { #ifdef HAVE_WAIT3 - retpid = wait3(&st, options, &ru); + retpid = wait3(&st, options, &ru); #else - retpid = wait(&st); + retpid = wait(&st); #endif } if (retpid == -1 && errno != ECHILD) - Raise_System_Error("~E"); + Raise_System_Error("~E"); GC_Link3(ret, ruret, x); x = Make_Integer(retpid); VECTOR(ret)->data[0] = x; if (retpid == 0 || retpid == -1) { - status = "none"; - st = code = 0; + status = "none"; + st = code = 0; #ifdef WAIT_RUSAGE - bzero((char *)&ru, sizeof(ru)); + bzero((char *)&ru, sizeof(ru)); #endif } else if (WIFSTOPPED(st)) { - status = "stopped"; code = WSTOPSIG(st); + status = "stopped"; code = WSTOPSIG(st); } else if (WIFSIGNALED(st)) { - status = "signaled"; code = WTERMSIG(st); + status = "signaled"; code = WTERMSIG(st); } else { - status = "exited"; code = WEXITSTATUS(st); + status = "exited"; code = WEXITSTATUS(st); } x = Intern(status); VECTOR(ret)->data[1] = x; x = Make_Integer(code); VECTOR(ret)->data[2] = x; VECTOR(ret)->data[3] = st & 0200 ? True : False; #ifdef WAIT_RUSAGE x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_usec - * 1000)); + * 1000)); sec = Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_sec); Car(x) = sec; VECTOR(ruret)->data[0] = x; x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_usec - * 1000)); + * 1000)); sec = Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_sec); Car(x) = sec; VECTOR(ruret)->data[1] = x; @@ -113,9 +113,9 @@ static Object P_Wait(argc, argv) int argc; Object *argv; { if (argc == 3) #ifdef WAIT_OPTIONS - flags = (int)Symbols_To_Bits(argv[2], 1, Wait_Flags); + flags = (int)Symbols_To_Bits(argv[2], 1, Wait_Flags); #else - Primitive_Error("wait options not supported"); + Primitive_Error("wait options not supported"); #endif return General_Wait(argv[0], argv[1], 0, 0, flags); } @@ -126,7 +126,7 @@ static Object P_Wait(argc, argv) int argc; Object *argv; { */ static Object P_Wait_Process(argc, argv) int argc; Object *argv; { return General_Wait(argv[0], argv[1], 1, Get_Integer(argv[2]), - argc == 4 ? (int)Symbols_To_Bits(argv[3], 1, Wait_Flags) : 0); + argc == 4 ? (int)Symbols_To_Bits(argv[3], 1, Wait_Flags) : 0); } #endif diff --git a/lib/xlib/client.c b/lib/xlib/client.c index 0d58c57..d9ac760 100644 --- a/lib/xlib/client.c +++ b/lib/xlib/client.c @@ -5,16 +5,16 @@ static Object Sym_Wm_Hints, Sym_Size_Hints; static Object P_Iconify_Window (w, scr) Object w, scr; { Check_Type (w, T_Window); if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr))) - Primitive_Error ("cannot iconify window"); + Get_Screen_Number (WINDOW(w)->dpy, scr))) + Primitive_Error ("cannot iconify window"); return Void; } static Object P_Withdraw_Window (w, scr) Object w, scr; { Check_Type (w, T_Window); if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr))) - Primitive_Error ("cannot withdraw window"); + Get_Screen_Number (WINDOW(w)->dpy, scr))) + Primitive_Error ("cannot withdraw window"); return Void; } @@ -24,8 +24,8 @@ static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; { Check_Type (w, T_Window); mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec); if (!XReconfigureWMWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC)) - Primitive_Error ("cannot reconfigure window"); + Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC)) + Primitive_Error ("cannot reconfigure window"); return Void; } @@ -38,13 +38,13 @@ static Object P_Wm_Command (w) Object w; { Check_Type (w, T_Window); Disable_Interrupts; if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac)) - ac = 0; + ac = 0; Enable_Interrupts; ret = t = P_Make_List (Make_Integer (ac), Null); GC_Link2 (ret, t); for (i = 0; i < ac; i++, t = Cdr (t)) { - s = Make_String (av[i], strlen (av[i])); - Car (t) = s; + s = Make_String (av[i], strlen (av[i])); + Car (t) = s; } GC_Unlink; if (ac) XFreeStringList (av); @@ -61,11 +61,11 @@ static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; { n = Fast_Length (x); Alloca (s, char**, n * sizeof (char *)); for (i = 0; i < n; i++, x = Cdr (x)) { - t = Car (x); - Get_Strsym_Stack (t, s[i]); + t = Car (x); + Get_Strsym_Stack (t, s[i]); } if (!XStringListToTextProperty (s, n, ret)) - Primitive_Error ("cannot create text property"); + Primitive_Error ("cannot create text property"); Alloca_End; } @@ -77,12 +77,12 @@ static Object Text_Property_To_String_List (p) XTextProperty *p; { GC_Node2; if (!XTextPropertyToStringList (p, &s, &n)) - Primitive_Error ("cannot convert from text property"); + Primitive_Error ("cannot convert from text property"); ret = t = P_Make_List (Make_Integer (n), Null); GC_Link2 (ret, t); for (i = 0; i < n; i++, t = Cdr (t)) { - x = Make_String (s[i], strlen (s[i])); - Car (t) = x; + x = Make_String (s[i], strlen (s[i])); + Car (t) = x; } GC_Unlink; XFreeStringList (s); @@ -96,9 +96,9 @@ static Object P_Get_Text_Property (w, a) Object w, a; { Check_Type (a, T_Atom); Disable_Interrupts; if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret, - ATOM(a)->atom)) { - Enable_Interrupts; - return False; + ATOM(a)->atom)) { + Enable_Interrupts; + return False; } Enable_Interrupts; return Text_Property_To_String_List (&ret); @@ -124,15 +124,15 @@ static Object P_Wm_Protocols (w) Object w; { Check_Type (w, T_Window); Disable_Interrupts; if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) - Primitive_Error ("cannot get WM protocols"); + Primitive_Error ("cannot get WM protocols"); Enable_Interrupts; ret = Make_Vector (n, Null); GC_Link (ret); for (i = 0; i < n; i++) { - Object a; + Object a; - a = Make_Atom (p[i]); - VECTOR(ret)->data[i] = a; + a = Make_Atom (p[i]); + VECTOR(ret)->data[i] = a; } XFree ((char *)p); GC_Unlink; @@ -149,13 +149,13 @@ static Object P_Set_Wm_Protocols (w, v) Object w, v; { n = VECTOR(v)->size; Alloca (p, Atom*, n * sizeof (Atom)); for (i = 0; i < n; i++) { - Object a; - a = VECTOR(v)->data[i]; - Check_Type (a, T_Atom); - p[i] = ATOM(a)->atom; + Object a; + a = VECTOR(v)->data[i]; + Check_Type (a, T_Atom); + p[i] = ATOM(a)->atom; } if (!XSetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, p, n)) - Primitive_Error ("cannot set WM protocols"); + Primitive_Error ("cannot set WM protocols"); Alloca_End; return Void; } @@ -178,14 +178,14 @@ static Object P_Wm_Class (w) Object w; { ret = Cons (False, False); GC_Link (ret); if (c.res_name) { - x = Make_String (c.res_name, strlen (c.res_name)); - Car (ret) = x; - XFree (c.res_name); + x = Make_String (c.res_name, strlen (c.res_name)); + Car (ret) = x; + XFree (c.res_name); } if (c.res_class) { - x = Make_String (c.res_class, strlen (c.res_class)); - Cdr (ret) = x; - XFree (c.res_class); + x = Make_String (c.res_class, strlen (c.res_class)); + Cdr (ret) = x; + XFree (c.res_class); } GC_Unlink; return ret; @@ -212,8 +212,8 @@ static Object P_Set_Wm_Command (w, cmd) Object w, cmd; { n = Fast_Length (cmd); Alloca (argv, char**, n * sizeof (char *)); for (i = 0; i < n; i++, cmd = Cdr (cmd)) { - c = Car (cmd); - Get_Strsym_Stack (c, argv[i]); + c = Car (cmd); + Get_Strsym_Stack (c, argv[i]); } XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n); Alloca_End; @@ -228,13 +228,13 @@ static Object P_Wm_Hints (w) Object w; { p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win); Enable_Interrupts; if (p) { - WMH = *p; - XFree ((char *)p); + WMH = *p; + XFree ((char *)p); } else { - WMH.flags = 0; + WMH.flags = 0; } return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints, - WINDOW(w)->dpy, (unsigned long)WMH.flags); + WINDOW(w)->dpy, (unsigned long)WMH.flags); } static Object P_Set_Wm_Hints (w, h) Object w, h; { @@ -254,19 +254,19 @@ static Object P_Size_Hints (w, a) Object w, a; { Check_Type (a, T_Atom); Disable_Interrupts; if (!XGetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, &supplied, - ATOM(a)->atom)) - SZH.flags = 0; + ATOM(a)->atom)) + SZH.flags = 0; if (!(supplied & PBaseSize)) - SZH.flags &= ~PBaseSize; + SZH.flags &= ~PBaseSize; if (!(supplied & PWinGravity)) - SZH.flags &= ~PWinGravity; + SZH.flags &= ~PWinGravity; Enable_Interrupts; if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition)) - SZH.flags &= ~PPosition; + SZH.flags &= ~PPosition; if ((SZH.flags & (PSize|USSize)) == (PSize|USSize)) - SZH.flags &= ~PSize; + SZH.flags &= ~PSize; return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints, - WINDOW(w)->dpy, (unsigned long)SZH.flags); + WINDOW(w)->dpy, (unsigned long)SZH.flags); } static Object P_Set_Size_Hints (w, a, h) Object w, a, h; { @@ -276,11 +276,11 @@ static Object P_Set_Size_Hints (w, a, h) Object w, a, h; { Check_Type (a, T_Atom); bzero ((char *)&SZH, sizeof (SZH)); /* Not portable? */ mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints, - Size_Hints_Rec); + Size_Hints_Rec); if ((mask & (PPosition|USPosition)) == (PPosition|USPosition)) - mask &= ~PPosition; + mask &= ~PPosition; if ((mask & (PSize|USSize)) == (PSize|USSize)) - mask &= ~PSize; + mask &= ~PSize; SZH.flags = mask; XSetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom); return Void; @@ -295,26 +295,26 @@ static Object P_Icon_Sizes (w) Object w; { Check_Type (w, T_Window); Disable_Interrupts; if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) - n = 0; + n = 0; Enable_Interrupts; v = Make_Vector (n, Null); GC_Link (v); for (i = 0; i < n; i++) { - register XIconSize *q = &p[i]; - Object t; + register XIconSize *q = &p[i]; + Object t; - t = P_Make_List (Make_Integer (6), Null); - VECTOR(v)->data[i] = t; - Car (t) = Make_Integer (q->min_width); t = Cdr (t); - Car (t) = Make_Integer (q->min_height); t = Cdr (t); - Car (t) = Make_Integer (q->max_width); t = Cdr (t); - Car (t) = Make_Integer (q->max_height); t = Cdr (t); - Car (t) = Make_Integer (q->width_inc); t = Cdr (t); - Car (t) = Make_Integer (q->height_inc); + t = P_Make_List (Make_Integer (6), Null); + VECTOR(v)->data[i] = t; + Car (t) = Make_Integer (q->min_width); t = Cdr (t); + Car (t) = Make_Integer (q->min_height); t = Cdr (t); + Car (t) = Make_Integer (q->max_width); t = Cdr (t); + Car (t) = Make_Integer (q->max_height); t = Cdr (t); + Car (t) = Make_Integer (q->width_inc); t = Cdr (t); + Car (t) = Make_Integer (q->height_inc); } GC_Unlink; if (n > 0) - XFree ((char *)p); + XFree ((char *)p); return v; } @@ -328,19 +328,19 @@ static Object P_Set_Icon_Sizes (w, v) Object w, v; { n = VECTOR(v)->size; Alloca (p, XIconSize*, n * sizeof (XIconSize)); for (i = 0; i < n; i++) { - register XIconSize *q = &p[i]; - Object t; + register XIconSize *q = &p[i]; + Object t; - t = VECTOR(v)->data[i]; - Check_List (t); - if (Fast_Length (t) != 6) - Primitive_Error ("invalid argument: ~s", t); - q->min_width = Get_Integer (Car (t)); t = Cdr (t); - q->min_height = Get_Integer (Car (t)); t = Cdr (t); - q->max_width = Get_Integer (Car (t)); t = Cdr (t); - q->max_height = Get_Integer (Car (t)); t = Cdr (t); - q->width_inc = Get_Integer (Car (t)); t = Cdr (t); - q->height_inc = Get_Integer (Car (t)); + t = VECTOR(v)->data[i]; + Check_List (t); + if (Fast_Length (t) != 6) + Primitive_Error ("invalid argument: ~s", t); + q->min_width = Get_Integer (Car (t)); t = Cdr (t); + q->min_height = Get_Integer (Car (t)); t = Cdr (t); + q->max_width = Get_Integer (Car (t)); t = Cdr (t); + q->max_height = Get_Integer (Car (t)); t = Cdr (t); + q->width_inc = Get_Integer (Car (t)); t = Cdr (t); + q->height_inc = Get_Integer (Car (t)); } XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n); Alloca_End; @@ -352,7 +352,7 @@ static Object P_Transient_For (w) Object w; { Disable_Interrupts; if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win)) - win = None; + win = None; Enable_Interrupts; return Make_Window (0, WINDOW(w)->dpy, win); } @@ -369,7 +369,7 @@ elk_init_xlib_client () { Define_Primitive (P_Iconify_Window, "iconify-window", 2, 2, EVAL); Define_Primitive (P_Withdraw_Window, "withdraw-window", 2, 2, EVAL); Define_Primitive (P_Reconfigure_Wm_Window, - "xlib-reconfigure-wm-window", 3, 3, EVAL); + "xlib-reconfigure-wm-window", 3, 3, EVAL); Define_Primitive (P_Wm_Command, "wm-command", 1, 1, EVAL); Define_Primitive (P_Get_Text_Property,"get-text-property", 2, 2, EVAL); Define_Primitive (P_Set_Text_Property,"set-text-property!",3, 3, EVAL); @@ -382,7 +382,7 @@ elk_init_xlib_client () { Define_Primitive (P_Set_Wm_Hints, "xlib-set-wm-hints!",2, 2, EVAL); Define_Primitive (P_Size_Hints, "xlib-wm-size-hints",2, 2, EVAL); Define_Primitive (P_Set_Size_Hints, - "xlib-set-wm-size-hints!", 3, 3, EVAL); + "xlib-set-wm-size-hints!", 3, 3, EVAL); Define_Primitive (P_Icon_Sizes, "icon-sizes", 1, 1, EVAL); Define_Primitive (P_Set_Icon_Sizes, "set-icon-sizes!", 2, 2, EVAL); Define_Primitive (P_Transient_For, "transient-for", 1, 1, EVAL); diff --git a/lib/xlib/color.c b/lib/xlib/color.c index 3a81003..6f42508 100644 --- a/lib/xlib/color.c +++ b/lib/xlib/color.c @@ -14,12 +14,12 @@ Object Make_Color (r, g, b) unsigned int r, g, b; { c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b); if (Nullp (c)) { - c = Alloc_Object (sizeof (struct S_Color), T_Color, 0); - COLOR(c)->tag = Null; - COLOR(c)->c.red = r; - COLOR(c)->c.green = g; - COLOR(c)->c.blue = b; - Register_Object (c, (GENERIC)0, (PFO)0, 0); + c = Alloc_Object (sizeof (struct S_Color), T_Color, 0); + COLOR(c)->tag = Null; + COLOR(c)->c.red = r; + COLOR(c)->c.green = g; + COLOR(c)->c.blue = b; + Register_Object (c, (GENERIC)0, (PFO)0, 0); } return c; } @@ -34,7 +34,7 @@ static unsigned short Get_RGB_Value (x) Object x; { d = Get_Double (x); if (d < 0.0 || d > 1.0) - Primitive_Error ("bad RGB value: ~s", x); + Primitive_Error ("bad RGB value: ~s", x); return (unsigned short)(d * 65535); } @@ -83,17 +83,17 @@ static Object P_Query_Colors (cmap, v) Object cmap, v; { n = VECTOR(v)->size; Alloca (p, XColor*, n * sizeof (XColor)); for (i = 0; i < n; i++) - p[i].pixel = Get_Pixel (VECTOR(v)->data[i]); + p[i].pixel = Get_Pixel (VECTOR(v)->data[i]); Disable_Interrupts; XQueryColors (COLORMAP(cmap)->dpy, cm, p, n); Enable_Interrupts; ret = Make_Vector (n, Null); GC_Link (ret); for (i = 0; i < n; i++, p++) { - Object x; + Object x; - x = Make_Color (p->red, p->green, p->blue); - VECTOR(ret)->data[i] = x; + x = Make_Color (p->red, p->green, p->blue); + VECTOR(ret)->data[i] = x; } GC_Unlink; Alloca_End; @@ -107,8 +107,8 @@ static Object P_Lookup_Color (cmap, name) Object cmap, name; { GC_Node; if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), - &visual, &exact)) - Primitive_Error ("no such color: ~s", name); + &visual, &exact)) + Primitive_Error ("no such color: ~s", name); ret = Cons (Null, Null); GC_Link (ret); x = Make_Color (visual.red, visual.green, visual.blue); diff --git a/lib/xlib/colormap.c b/lib/xlib/colormap.c index d2bbd8d..4644579 100644 --- a/lib/xlib/colormap.c +++ b/lib/xlib/colormap.c @@ -12,16 +12,16 @@ Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; { Object cm; if (cmap == None) - return Sym_None; + return Sym_None; cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap); if (Nullp (cm)) { - cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0); - COLORMAP(cm)->tag = Null; - COLORMAP(cm)->cm = cmap; - COLORMAP(cm)->dpy = dpy; - COLORMAP(cm)->free = 0; - Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap : - (PFO)0, 0); + cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0); + COLORMAP(cm)->tag = Null; + COLORMAP(cm)->cm = cmap; + COLORMAP(cm)->dpy = dpy; + COLORMAP(cm)->free = 0; + Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap : + (PFO)0, 0); } return cm; } @@ -34,7 +34,7 @@ Colormap Get_Colormap (c) Object c; { Object P_Free_Colormap (c) Object c; { Check_Type (c, T_Colormap); if (!COLORMAP(c)->free) - XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); + XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); Deregister_Object (c); COLORMAP(c)->free = 1; return Void; @@ -50,7 +50,7 @@ static Object P_Alloc_Color (cmap, color) Object cmap, color; { r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c); Enable_Interrupts; if (!r) - return False; + return False; return Make_Pixel (c.pixel); } @@ -63,10 +63,10 @@ static Object P_Alloc_Named_Color (cmap, name) Object cmap, name; { Disable_Interrupts; r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), - &screen, &exact); + &screen, &exact); Enable_Interrupts; if (!r) - return False; + return False; t = ret = P_Make_List (Make_Integer (3), Null); GC_Link2 (t, ret); x = Make_Pixel (screen.pixel); diff --git a/lib/xlib/cursor.c b/lib/xlib/cursor.c index e5066a8..de8aa75 100644 --- a/lib/xlib/cursor.c +++ b/lib/xlib/cursor.c @@ -9,20 +9,20 @@ Generic_Print (Cursor, "#[cursor %lu]", CURSOR(x)->cursor) Generic_Get_Display (Cursor, CURSOR) static Object Internal_Make_Cursor (finalize, dpy, cursor) - Display *dpy; Cursor cursor; { + Display *dpy; Cursor cursor; { Object c; if (cursor == None) - return Sym_None; + return Sym_None; c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor); if (Nullp (c)) { - c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0); - CURSOR(c)->tag = Null; - CURSOR(c)->cursor = cursor; - CURSOR(c)->dpy = dpy; - CURSOR(c)->free = 0; - Register_Object (c, (GENERIC)dpy, - finalize ? P_Free_Cursor : (PFO)0, 0); + c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0); + CURSOR(c)->tag = Null; + CURSOR(c)->cursor = cursor; + CURSOR(c)->dpy = dpy; + CURSOR(c)->free = 0; + Register_Object (c, (GENERIC)dpy, + finalize ? P_Free_Cursor : (PFO)0, 0); } return c; } @@ -38,7 +38,7 @@ Object Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; { Cursor Get_Cursor (c) Object c; { if (EQ(c, Sym_None)) - return None; + return None; Check_Type (c, T_Cursor); return CURSOR(c)->cursor; } @@ -46,37 +46,37 @@ Cursor Get_Cursor (c) Object c; { Object P_Free_Cursor (c) Object c; { Check_Type (c, T_Cursor); if (!CURSOR(c)->free) - XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor); + XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor); Deregister_Object (c); CURSOR(c)->free = 1; return Void; } static Object P_Create_Cursor (srcp, maskp, x, y, f, b) - Object srcp, maskp, x, y, f, b; { + Object srcp, maskp, x, y, f, b; { Pixmap sp = Get_Pixmap (srcp), mp; Display *d = PIXMAP(srcp)->dpy; mp = EQ(maskp, Sym_None) ? None : Get_Pixmap (maskp); return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp, - Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y))); + Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y))); } static Object P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b) - Object srcf, srcc, maskf, maskc, f, b; { + Object srcf, srcc, maskf, maskc, f, b; { Font sf = Get_Font (srcf), mf; Display *d = FONT(srcf)->dpy; mf = EQ(maskf, Sym_None) ? None : Get_Font (maskf); return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf, - Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc), - Get_Color (f), Get_Color (b))); + Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc), + Get_Color (f), Get_Color (b))); } static Object P_Recolor_Cursor (c, f, b) Object c, f, b; { Check_Type (c, T_Cursor); XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f), - Get_Color (b)); + Get_Color (b)); return Void; } @@ -86,6 +86,6 @@ elk_init_xlib_cursor () { Define_Primitive (P_Free_Cursor, "free-cursor", 1, 1, EVAL); Define_Primitive (P_Create_Cursor, "create-cursor", 6, 6, EVAL); Define_Primitive (P_Create_Glyph_Cursor, "create-glyph-cursor", - 6, 6, EVAL); + 6, 6, EVAL); Define_Primitive (P_Recolor_Cursor, "recolor-cursor", 3, 3, EVAL); } diff --git a/lib/xlib/display.c b/lib/xlib/display.c index 6eb3530..7558e1a 100644 --- a/lib/xlib/display.c +++ b/lib/xlib/display.c @@ -10,7 +10,7 @@ Generic_Equal (Display, DISPLAY, dpy) static Display_Print (d, port, raw, depth, length) Object d, port; { Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy, - DisplayString (DISPLAY(d)->dpy)); + DisplayString (DISPLAY(d)->dpy)); } Object Make_Display (finalize, dpy) Display *dpy; { @@ -18,12 +18,12 @@ Object Make_Display (finalize, dpy) Display *dpy; { d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj); if (Nullp (d)) { - d = Alloc_Object (sizeof (struct S_Display), T_Display, 0); - DISPLAY(d)->dpy = dpy; - DISPLAY(d)->free = 0; - DISPLAY(d)->after = False; - Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display : - (PFO)0, 1); + d = Alloc_Object (sizeof (struct S_Display), T_Display, 0); + DISPLAY(d)->dpy = dpy; + DISPLAY(d)->free = 0; + DISPLAY(d)->after = False; + Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display : + (PFO)0, 1); } return d; } @@ -33,12 +33,12 @@ static Object P_Open_Display (argc, argv) Object *argv; { Display *dpy; if (argc == 1) { - if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0) - Primitive_Error ("cannot open display ~s", argv[0]); + if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0) + Primitive_Error ("cannot open display ~s", argv[0]); } else if ((dpy = XOpenDisplay ((char *)0)) == 0) { - s = XDisplayName ((char *)0); - Primitive_Error ("cannot open display ~s", - Make_String (s, strlen (s))); + s = XDisplayName ((char *)0); + Primitive_Error ("cannot open display ~s", + Make_String (s, strlen (s))); } return Make_Display (1, dpy); } @@ -49,8 +49,8 @@ Object P_Close_Display (d) Object d; { Check_Type (d, T_Display); p = DISPLAY(d); if (!p->free) { - Terminate_Group ((GENERIC)p->dpy); - XCloseDisplay (p->dpy); + Terminate_Group ((GENERIC)p->dpy); + XCloseDisplay (p->dpy); } Deregister_Object (d); p->free = 1; @@ -60,7 +60,7 @@ Object P_Close_Display (d) Object d; { static Object P_Display_Default_Root_Window (d) Object d; { Check_Type (d, T_Display); return Make_Window (0, DISPLAY(d)->dpy, - DefaultRootWindow (DISPLAY(d)->dpy)); + DefaultRootWindow (DISPLAY(d)->dpy)); } static Object P_Display_Default_Colormap (d) Object d; { @@ -96,20 +96,20 @@ int Get_Screen_Number (dpy, scr) Display *dpy; Object scr; { register s; if ((s = Get_Integer (scr)) < 0 || s > ScreenCount (dpy)-1) - Primitive_Error ("invalid screen number"); + Primitive_Error ("invalid screen number"); return s; } static Object P_Display_Cells (d, scr) Object d, scr; { Check_Type (d, T_Display); return Make_Integer (DisplayCells (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr))); + Get_Screen_Number (DISPLAY(d)->dpy, scr))); } static Object P_Display_Planes (d, scr) Object d, scr; { Check_Type (d, T_Display); return Make_Integer (DisplayPlanes (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr))); + Get_Screen_Number (DISPLAY(d)->dpy, scr))); } static Object P_Display_String (d) Object d; { @@ -138,7 +138,7 @@ static Object P_Display_Vendor (d) Object d; { static Object P_Display_Protocol_Version (d) Object d; { Check_Type (d, T_Display); return Cons (Make_Integer (ProtocolVersion (DISPLAY(d)->dpy)), - Make_Integer (ProtocolRevision (DISPLAY(d)->dpy))); + Make_Integer (ProtocolRevision (DISPLAY(d)->dpy))); } static Object P_Display_Screen_Count (d) Object d; { @@ -149,7 +149,7 @@ static Object P_Display_Screen_Count (d) Object d; { static Object P_Display_Image_Byte_Order (d) Object d; { Check_Type (d, T_Display); return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy), - 0, Byte_Order_Syms); + 0, Byte_Order_Syms); } static Object P_Display_Bitmap_Unit (d) Object d; { @@ -160,7 +160,7 @@ static Object P_Display_Bitmap_Unit (d) Object d; { static Object P_Display_Bitmap_Bit_Order (d) Object d; { Check_Type (d, T_Display); return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy), - 0, Byte_Order_Syms); + 0, Byte_Order_Syms); } static Object P_Display_Bitmap_Pad (d) Object d; { @@ -171,25 +171,25 @@ static Object P_Display_Bitmap_Pad (d) Object d; { static Object P_Display_Width (d) Object d; { Check_Type (d, T_Display); return Make_Integer (DisplayWidth (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } static Object P_Display_Height (d) Object d; { Check_Type (d, T_Display); return Make_Integer (DisplayHeight (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } static Object P_Display_Width_Mm (d) Object d; { Check_Type (d, T_Display); return Make_Integer (DisplayWidthMM (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } static Object P_Display_Height_Mm (d) Object d; { Check_Type (d, T_Display); return Make_Integer (DisplayHeightMM (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } static Object P_Display_Motion_Buffer_Size (d) Object d; { @@ -223,11 +223,11 @@ static Object P_List_Depths (d, scr) Object d, scr; { Check_Type (d, T_Display); if (!(p = XListDepths (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr), &num))) - return False; + Get_Screen_Number (DISPLAY(d)->dpy, scr), &num))) + return False; ret = Make_Vector (num, Null); for (i = 0; i < num; i++) - VECTOR(ret)->data[i] = Make_Integer (p[i]); + VECTOR(ret)->data[i] = Make_Integer (p[i]); XFree ((char *)p); return ret; } @@ -241,17 +241,17 @@ static Object P_List_Pixmap_Formats (d) Object d; { Check_Type (d, T_Display); if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num))) - return False; + return False; ret = Make_Vector (num, Null); GC_Link (ret); for (i = 0; i < num; i++) { - Object t; + Object t; - t = P_Make_List (Make_Integer (3), Null); - VECTOR(ret)->data[i] = t; - Car (t) = Make_Integer (p[i].depth); t = Cdr (t); - Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t); - Car (t) = Make_Integer (p[i].scanline_pad); + t = P_Make_List (Make_Integer (3), Null); + VECTOR(ret)->data[i] = t; + Car (t) = Make_Integer (p[i].depth); t = Cdr (t); + Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t); + Car (t) = Make_Integer (p[i].scanline_pad); } GC_Unlink; XFree ((char *)p); @@ -260,49 +260,49 @@ static Object P_List_Pixmap_Formats (d) Object d; { elk_init_xlib_display () { T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display), - Display_Equal, Display_Equal, Display_Print, Display_Visit); + Display_Equal, Display_Equal, Display_Print, Display_Visit); Define_Primitive (P_Displayp, "display?", 1, 1, EVAL); Define_Primitive (P_Open_Display, "open-display", 0, 1, VARARGS); Define_Primitive (P_Close_Display, "close-display", 1, 1, EVAL); Define_Primitive (P_Display_Default_Root_Window, - "display-default-root-window", 1, 1, EVAL); + "display-default-root-window", 1, 1, EVAL); Define_Primitive (P_Display_Default_Colormap, - "display-default-colormap", 1, 1, EVAL); + "display-default-colormap", 1, 1, EVAL); Define_Primitive (P_Display_Default_Gcontext, - "display-default-gcontext", 1, 1, EVAL); + "display-default-gcontext", 1, 1, EVAL); Define_Primitive (P_Display_Default_Depth, - "display-default-depth", 1, 1, EVAL); + "display-default-depth", 1, 1, EVAL); Define_Primitive (P_Display_Default_Screen_Number, - "display-default-screen-number", 1, 1, EVAL); + "display-default-screen-number", 1, 1, EVAL); Define_Primitive (P_Display_Cells, "display-cells", 2, 2, EVAL); Define_Primitive (P_Display_Planes, "display-planes", 2, 2, EVAL); Define_Primitive (P_Display_String, "display-string", 1, 1, EVAL); Define_Primitive (P_Display_Vendor, "display-vendor", 1, 1, EVAL); Define_Primitive (P_Display_Protocol_Version, - "display-protocol-version", 1, 1, EVAL); + "display-protocol-version", 1, 1, EVAL); Define_Primitive (P_Display_Screen_Count, - "display-screen-count", 1, 1, EVAL); + "display-screen-count", 1, 1, EVAL); Define_Primitive (P_Display_Image_Byte_Order, - "display-image-byte-order", 1, 1, EVAL); + "display-image-byte-order", 1, 1, EVAL); Define_Primitive (P_Display_Bitmap_Unit, - "display-bitmap-unit", 1, 1, EVAL); + "display-bitmap-unit", 1, 1, EVAL); Define_Primitive (P_Display_Bitmap_Bit_Order, - "display-bitmap-bit-order", 1, 1, EVAL); + "display-bitmap-bit-order", 1, 1, EVAL); Define_Primitive (P_Display_Bitmap_Pad, - "display-bitmap-pad", 1, 1, EVAL); + "display-bitmap-pad", 1, 1, EVAL); Define_Primitive (P_Display_Width, "display-width", 1, 1, EVAL); Define_Primitive (P_Display_Height, "display-height", 1, 1, EVAL); Define_Primitive (P_Display_Width_Mm,"display-width-mm", 1, 1, EVAL); Define_Primitive (P_Display_Height_Mm, - "display-height-mm", 1, 1, EVAL); + "display-height-mm", 1, 1, EVAL); Define_Primitive (P_Display_Motion_Buffer_Size, - "display-motion-buffer-size", 1, 1, EVAL); + "display-motion-buffer-size", 1, 1, EVAL); Define_Primitive (P_Display_Flush_Output, - "display-flush-output", 1, 1, EVAL); + "display-flush-output", 1, 1, EVAL); Define_Primitive (P_Display_Wait_Output, - "display-wait-output", 2, 2, EVAL); + "display-wait-output", 2, 2, EVAL); Define_Primitive (P_No_Op, "no-op", 1, 1, EVAL); Define_Primitive (P_List_Depths, "list-depths", 2, 2, EVAL); Define_Primitive (P_List_Pixmap_Formats, - "list-pixmap-formats", 1, 1, EVAL); + "list-pixmap-formats", 1, 1, EVAL); } diff --git a/lib/xlib/event.c b/lib/xlib/event.c index ddea621..6e65ab2 100644 --- a/lib/xlib/event.c +++ b/lib/xlib/event.c @@ -8,7 +8,7 @@ static struct event_desc { char *name; int argc; } Event_Table[] = { - { "event-0", 1 }, + { "event-0", 1 }, { "event-1", 1 }, { "key-press", 12 }, { "key-release", 12 }, @@ -54,9 +54,9 @@ struct predicate_arg { /*ARGSUSED*/ static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep; #ifdef XLIB_RELEASE_5_OR_LATER - XPointer ptr; { + XPointer ptr; { #else - char *ptr; { + char *ptr; { #endif struct predicate_arg *ap = (struct predicate_arg *)ptr; register i; @@ -64,11 +64,11 @@ static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep; GC_Node; if ((i = ep->type) < LASTEvent && !Nullp (ap->funcs[i])) { - args = Get_Event_Args (ep); - GC_Link (args); - *ap->ret = Funcall (ap->funcs[i], args, 0); - Destroy_Event_Args (args); - GC_Unlink; + args = Get_Event_Args (ep); + GC_Link (args); + *ap->ret = Funcall (ap->funcs[i], args, 0); + Destroy_Event_Args (args); + GC_Unlink; } return Truep (*ap->ret); } @@ -103,59 +103,59 @@ static Object P_Handle_Events (argl) Object argl; { Check_Type (next, T_Boolean); peek = Truep (next); for (i = 0; i < LASTEvent; i++) - funcs[i] = Null; + funcs[i] = Null; gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv; for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) { - clause = Car (argl); - Check_List (clause); - if (Fast_Length (clause) != 2) - Primitive_Error ("badly formed event clause"); - func = Eval (Car (Cdr (clause))); - Check_Procedure (func); - clause = Car (clause); - if (EQ(clause, Sym_Else)) { - for (i = 0; i < LASTEvent; i++) - if (Nullp (funcs[i])) funcs[i] = func; - } else { - if (TYPE(clause) == T_Pair) { - for (; !Nullp (clause); clause = Cdr (clause)) { - i = Encode_Event (Car (clause)); - if (!Nullp (funcs[i])) - Primitive_Error (errmsg); - funcs[i] = func; - } - } else { - i = Encode_Event (clause); - if (!Nullp (funcs[i])) - Primitive_Error (errmsg); - funcs[i] = func; - } - } + clause = Car (argl); + Check_List (clause); + if (Fast_Length (clause) != 2) + Primitive_Error ("badly formed event clause"); + func = Eval (Car (Cdr (clause))); + Check_Procedure (func); + clause = Car (clause); + if (EQ(clause, Sym_Else)) { + for (i = 0; i < LASTEvent; i++) + if (Nullp (funcs[i])) funcs[i] = func; + } else { + if (TYPE(clause) == T_Pair) { + for (; !Nullp (clause); clause = Cdr (clause)) { + i = Encode_Event (Car (clause)); + if (!Nullp (funcs[i])) + Primitive_Error (errmsg); + funcs[i] = func; + } + } else { + i = Encode_Event (clause); + if (!Nullp (funcs[i])) + Primitive_Error (errmsg); + funcs[i] = func; + } + } } ret = False; while (!Truep (ret)) { - XEvent e; - if (discard) { - (peek ? XPeekEvent : XNextEvent) (dpy, &e); - if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) { - args = Get_Event_Args (&e); - ret = Funcall (funcs[i], args, 0); - Destroy_Event_Args (args); - } else { - if (peek) - XNextEvent (dpy, &e); /* discard it */ - } - } else { - struct predicate_arg a; - a.funcs = funcs; - a.ret = &ret; - (peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate, + XEvent e; + if (discard) { + (peek ? XPeekEvent : XNextEvent) (dpy, &e); + if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) { + args = Get_Event_Args (&e); + ret = Funcall (funcs[i], args, 0); + Destroy_Event_Args (args); + } else { + if (peek) + XNextEvent (dpy, &e); /* discard it */ + } + } else { + struct predicate_arg a; + a.funcs = funcs; + a.ret = &ret; + (peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate, #ifdef XLIB_RELEASE_5_OR_LATER - (XPointer)&a); + (XPointer)&a); #else - (char *)&a); + (char *)&a); #endif - } + } } GC_Unlink; TC_Enable; @@ -178,7 +178,7 @@ Object Get_Event_Args (ep) XEvent *ep; { dummy = Null; a = tmpargs; for (i = 0; i < MAX_ARGS; i++) - a[i] = Null; + a[i] = Null; GC_Link (dummy); gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv; switch (e) { @@ -186,247 +186,247 @@ Object Get_Event_Args (ep) XEvent *ep; { case ButtonPress: case ButtonRelease: case MotionNotify: case EnterNotify: case LeaveNotify: { - register XKeyEvent *p = (XKeyEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Window (0, p->display, p->root); - a[3] = Make_Window (0, p->display, p->subwindow); - a[4] = Get_Time_Arg (p->time); - a[5] = Make_Integer (p->x); - a[6] = Make_Integer (p->y); - a[7] = Make_Integer (p->x_root); - a[8] = Make_Integer (p->y_root); - if (e == KeyPress || e == KeyRelease) { - a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms); - a[10] = Make_Integer (p->keycode); - a[11] = p->same_screen ? True : False; - } else if (e == ButtonPress || e == ButtonRelease) { - register XButtonEvent *q = (XButtonEvent *)ep; - a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); - a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms); - a[11] = q->same_screen ? True : False; - } else if (e == MotionNotify) { - register XMotionEvent *q = (XMotionEvent *)ep; - a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); - a[10] = q->is_hint ? True : False; - a[11] = q->same_screen ? True : False; - } else { - register XCrossingEvent *q = (XCrossingEvent *)ep; - a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms); - a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0, - Cross_Detail_Syms); - a[11] = q->same_screen ? True : False; - a[12] = q->focus ? True : False; - a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms); - } + register XKeyEvent *p = (XKeyEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Window (0, p->display, p->root); + a[3] = Make_Window (0, p->display, p->subwindow); + a[4] = Get_Time_Arg (p->time); + a[5] = Make_Integer (p->x); + a[6] = Make_Integer (p->y); + a[7] = Make_Integer (p->x_root); + a[8] = Make_Integer (p->y_root); + if (e == KeyPress || e == KeyRelease) { + a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms); + a[10] = Make_Integer (p->keycode); + a[11] = p->same_screen ? True : False; + } else if (e == ButtonPress || e == ButtonRelease) { + register XButtonEvent *q = (XButtonEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); + a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms); + a[11] = q->same_screen ? True : False; + } else if (e == MotionNotify) { + register XMotionEvent *q = (XMotionEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); + a[10] = q->is_hint ? True : False; + a[11] = q->same_screen ? True : False; + } else { + register XCrossingEvent *q = (XCrossingEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms); + a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0, + Cross_Detail_Syms); + a[11] = q->same_screen ? True : False; + a[12] = q->focus ? True : False; + a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms); + } } break; case FocusIn: case FocusOut: { - register XFocusChangeEvent *p = (XFocusChangeEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms); - a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms); + register XFocusChangeEvent *p = (XFocusChangeEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms); + a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms); } break; case KeymapNotify: { - register XKeymapEvent *p = (XKeymapEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_String (p->key_vector, 32); + register XKeymapEvent *p = (XKeymapEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_String (p->key_vector, 32); } break; case Expose: { - register XExposeEvent *p = (XExposeEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Integer (p->x); - a[3] = Make_Integer (p->y); - a[4] = Make_Integer (p->width); - a[5] = Make_Integer (p->height); - a[6] = Make_Integer (p->count); + register XExposeEvent *p = (XExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Integer (p->x); + a[3] = Make_Integer (p->y); + a[4] = Make_Integer (p->width); + a[5] = Make_Integer (p->height); + a[6] = Make_Integer (p->count); } break; case GraphicsExpose: { - register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep; - a[1] = Make_Window (0, p->display, p->drawable); - a[2] = Make_Integer (p->x); - a[3] = Make_Integer (p->y); - a[4] = Make_Integer (p->width); - a[5] = Make_Integer (p->height); - a[6] = Make_Integer (p->count); - a[7] = Make_Integer (p->major_code); - a[8] = Make_Integer (p->minor_code); + register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->drawable); + a[2] = Make_Integer (p->x); + a[3] = Make_Integer (p->y); + a[4] = Make_Integer (p->width); + a[5] = Make_Integer (p->height); + a[6] = Make_Integer (p->count); + a[7] = Make_Integer (p->major_code); + a[8] = Make_Integer (p->minor_code); } break; case NoExpose: { - register XNoExposeEvent *p = (XNoExposeEvent *)ep; - a[1] = Make_Window (0, p->display, p->drawable); - a[2] = Make_Integer (p->major_code); - a[3] = Make_Integer (p->minor_code); + register XNoExposeEvent *p = (XNoExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->drawable); + a[2] = Make_Integer (p->major_code); + a[3] = Make_Integer (p->minor_code); } break; case VisibilityNotify: { - register XVisibilityEvent *p = (XVisibilityEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms); + register XVisibilityEvent *p = (XVisibilityEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms); } break; case CreateNotify: { - register XCreateWindowEvent *p = (XCreateWindowEvent *)ep; - a[1] = Make_Window (0, p->display, p->parent); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Make_Integer (p->x); - a[4] = Make_Integer (p->y); - a[5] = Make_Integer (p->width); - a[6] = Make_Integer (p->height); - a[7] = Make_Integer (p->border_width); - a[8] = p->override_redirect ? True : False; + register XCreateWindowEvent *p = (XCreateWindowEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = p->override_redirect ? True : False; } break; case DestroyNotify: { - register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); + register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); } break; case UnmapNotify: { - register XUnmapEvent *p = (XUnmapEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = p->from_configure ? True : False; + register XUnmapEvent *p = (XUnmapEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = p->from_configure ? True : False; } break; case MapNotify: { - register XMapEvent *p = (XMapEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = p->override_redirect ? True : False; + register XMapEvent *p = (XMapEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = p->override_redirect ? True : False; } break; case MapRequest: { - register XMapRequestEvent *p = (XMapRequestEvent *)ep; - a[1] = Make_Window (0, p->display, p->parent); - a[2] = Make_Window (0, p->display, p->window); + register XMapRequestEvent *p = (XMapRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); } break; case ReparentNotify: { - register XReparentEvent *p = (XReparentEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Make_Window (0, p->display, p->parent); - a[4] = Make_Integer (p->x); - a[5] = Make_Integer (p->y); - a[6] = p->override_redirect ? True : False; + register XReparentEvent *p = (XReparentEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Window (0, p->display, p->parent); + a[4] = Make_Integer (p->x); + a[5] = Make_Integer (p->y); + a[6] = p->override_redirect ? True : False; } break; case ConfigureNotify: { - register XConfigureEvent *p = (XConfigureEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Make_Integer (p->x); - a[4] = Make_Integer (p->y); - a[5] = Make_Integer (p->width); - a[6] = Make_Integer (p->height); - a[7] = Make_Integer (p->border_width); - a[8] = Make_Window (0, p->display, p->above); - a[9] = p->override_redirect ? True : False; + register XConfigureEvent *p = (XConfigureEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = Make_Window (0, p->display, p->above); + a[9] = p->override_redirect ? True : False; } break; case ConfigureRequest: { - register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep; - a[1] = Make_Window (0, p->display, p->parent); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Make_Integer (p->x); - a[4] = Make_Integer (p->y); - a[5] = Make_Integer (p->width); - a[6] = Make_Integer (p->height); - a[7] = Make_Integer (p->border_width); - a[8] = Make_Window (0, p->display, p->above); - a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms); - a[10] = Make_Unsigned_Long (p->value_mask); + register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = Make_Window (0, p->display, p->above); + a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms); + a[10] = Make_Unsigned_Long (p->value_mask); } break; case GravityNotify: { - register XGravityEvent *p = (XGravityEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Make_Integer (p->x); - a[4] = Make_Integer (p->y); + register XGravityEvent *p = (XGravityEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); } break; case ResizeRequest: { - register XResizeRequestEvent *p = (XResizeRequestEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Integer (p->width); - a[3] = Make_Integer (p->height); + register XResizeRequestEvent *p = (XResizeRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Integer (p->width); + a[3] = Make_Integer (p->height); } break; case CirculateNotify: { - register XCirculateEvent *p = (XCirculateEvent *)ep; - a[1] = Make_Window (0, p->display, p->event); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); + register XCirculateEvent *p = (XCirculateEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); } break; case CirculateRequest: { - register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep; - a[1] = Make_Window (0, p->display, p->parent); - a[2] = Make_Window (0, p->display, p->window); - a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); + register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); } break; case PropertyNotify: { - register XPropertyEvent *p = (XPropertyEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Atom (p->atom); - a[3] = Get_Time_Arg (p->time); - a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms); + register XPropertyEvent *p = (XPropertyEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->atom); + a[3] = Get_Time_Arg (p->time); + a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms); } break; case SelectionClear: { - register XSelectionClearEvent *p = (XSelectionClearEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Atom (p->selection); - a[3] = Get_Time_Arg (p->time); + register XSelectionClearEvent *p = (XSelectionClearEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->selection); + a[3] = Get_Time_Arg (p->time); } break; case SelectionRequest: { - register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep; - a[1] = Make_Window (0, p->display, p->owner); - a[2] = Make_Window (0, p->display, p->requestor); - a[3] = Make_Atom (p->selection); - a[4] = Make_Atom (p->target); - a[5] = Make_Atom (p->property); - a[6] = Get_Time_Arg (p->time); + register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->owner); + a[2] = Make_Window (0, p->display, p->requestor); + a[3] = Make_Atom (p->selection); + a[4] = Make_Atom (p->target); + a[5] = Make_Atom (p->property); + a[6] = Get_Time_Arg (p->time); } break; case SelectionNotify: { - register XSelectionEvent *p = (XSelectionEvent *)ep; - a[1] = Make_Window (0, p->display, p->requestor); - a[2] = Make_Atom (p->selection); - a[3] = Make_Atom (p->target); - a[4] = Make_Atom (p->property); - a[5] = Get_Time_Arg (p->time); + register XSelectionEvent *p = (XSelectionEvent *)ep; + a[1] = Make_Window (0, p->display, p->requestor); + a[2] = Make_Atom (p->selection); + a[3] = Make_Atom (p->target); + a[4] = Make_Atom (p->property); + a[5] = Get_Time_Arg (p->time); } break; case ColormapNotify: { - register XColormapEvent *p = (XColormapEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Colormap (0, p->display, p->colormap); - a[3] = p->new ? True : False; - a[4] = p->state == ColormapInstalled ? True : False; + register XColormapEvent *p = (XColormapEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Colormap (0, p->display, p->colormap); + a[3] = p->new ? True : False; + a[4] = p->state == ColormapInstalled ? True : False; } break; case ClientMessage: { - register XClientMessageEvent *p = (XClientMessageEvent *)ep; - register i; + register XClientMessageEvent *p = (XClientMessageEvent *)ep; + register i; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Make_Atom (p->message_type); - switch (p->format) { - case 8: - a[3] = Make_String (p->data.b, 20); - break; - case 16: - a[3] = Make_Vector (10, Null); - for (i = 0; i < 10; i++) - VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]); - break; - case 32: - a[3] = Make_Vector (5, Null); - for (i = 0; i < 5; i++) - VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]); - break; - default: - a[3] = Make_Integer (p->format); /* ??? */ - } + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->message_type); + switch (p->format) { + case 8: + a[3] = Make_String (p->data.b, 20); + break; + case 16: + a[3] = Make_Vector (10, Null); + for (i = 0; i < 10; i++) + VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]); + break; + case 32: + a[3] = Make_Vector (5, Null); + for (i = 0; i < 5; i++) + VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]); + break; + default: + a[3] = Make_Integer (p->format); /* ??? */ + } } break; case MappingNotify: { - register XMappingEvent *p = (XMappingEvent *)ep; - a[1] = Make_Window (0, p->display, p->window); - a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms); - a[3] = Make_Integer (p->first_keycode); - a[4] = Make_Integer (p->count); + register XMappingEvent *p = (XMappingEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms); + a[3] = Make_Integer (p->first_keycode); + a[4] = Make_Integer (p->count); } break; } a[0] = Intern (Event_Table[e].name); for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) { - if (i) vp++; - Car (*vp) = a[i]; - Cdr (*vp) = vp[1]; + if (i) vp++; + Car (*vp) = a[i]; + Cdr (*vp) = vp[1]; } Cdr (*vp) = Null; GC_Unlink; @@ -437,7 +437,7 @@ void Destroy_Event_Args (args) Object args; { Object t; for (t = args; !Nullp (t); t = Cdr (t)) - Car (t) = Null; + Car (t) = Null; } Encode_Event (e) Object e; { @@ -451,9 +451,9 @@ Encode_Event (e) Object e; { p = STRING(s)->data; n = STRING(s)->size; for (ep = Event_Table; ep->name; ep++) - if (n && strncmp (ep->name, p, n) == 0) break; + if (n && strncmp (ep->name, p, n) == 0) break; if (ep->name == 0) - Primitive_Error ("no such event: ~s", e); + Primitive_Error ("no such event: ~s", e); return ep-Event_Table; } @@ -466,15 +466,15 @@ static Object P_Get_Motion_Events (w, from, to) Object w, from, to; { Check_Type (w, T_Window); p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from), - Get_Time (to), &n); + Get_Time (to), &n); e = ret = Make_Vector (n, Null); GC_Link2 (ret, e); for (i = 0; i < n; i++) { - e = P_Make_List (Make_Integer (3), Null); - VECTOR(ret)->data[i] = e; - Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e); - Car (e) = Make_Integer (p[i].x); e = Cdr (e); - Car (e) = Make_Integer (p[i].y); + e = P_Make_List (Make_Integer (3), Null); + VECTOR(ret)->data[i] = e; + Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e); + Car (e) = Make_Integer (p[i].x); e = Cdr (e); + Car (e) = Make_Integer (p[i].y); } GC_Unlink; XFree ((char *)p); @@ -491,8 +491,8 @@ static Object P_Event_Listen (d, wait_flag) Object d, wait_flag; { dpy = DISPLAY(d)->dpy; n = XPending (dpy); if (n == 0 && EQ(wait_flag, True)) { - XPeekEvent (dpy, &e); - n = XPending (dpy); + XPeekEvent (dpy, &e); + n = XPending (dpy); } return Make_Integer (n); } @@ -506,9 +506,9 @@ elk_init_xlib_event () { Argv = Make_Vector (MAX_ARGS, Null); Global_GC_Link (Argv); for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t)) - VECTOR(Argv)->data[i] = t; + VECTOR(Argv)->data[i] = t; Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL); Define_Primitive (P_Get_Motion_Events, - "get-motion-events", 3, 3, EVAL); + "get-motion-events", 3, 3, EVAL); Define_Primitive (P_Event_Listen, "event-listen", 2, 2, EVAL); } diff --git a/lib/xlib/extension.c b/lib/xlib/extension.c index da83bf1..3818f88 100644 --- a/lib/xlib/extension.c +++ b/lib/xlib/extension.c @@ -14,10 +14,10 @@ static Object P_List_Extensions (d) Object d; { ret = Make_Vector (n, Null); GC_Link (ret); for (i = 0; i < n; i++) { - Object e; + Object e; - e = Make_String (p[i], strlen (p[i])); - VECTOR(ret)->data[i] = e; + e = Make_String (p[i], strlen (p[i])); + VECTOR(ret)->data[i] = e; } GC_Unlink; XFreeExtensionList (p); @@ -31,8 +31,8 @@ static Object P_Query_Extension (d, name) Object d, name; { Check_Type (d, T_Display); if (!XQueryExtension (DISPLAY(d)->dpy, Get_Strsym (name), &opcode, - &event, &error)) - return False; + &event, &error)) + return False; t = ret = P_Make_List (Make_Integer (3), Null); GC_Link2 (ret, t); Car (t) = (opcode ? Make_Integer (opcode) : False); t = Cdr (t); diff --git a/lib/xlib/font.c b/lib/xlib/font.c index 4eee077..ee5ceee 100644 --- a/lib/xlib/font.c +++ b/lib/xlib/font.c @@ -8,9 +8,9 @@ Generic_Predicate (Font) static Font_Equal (x, y) Object x, y; { Font id1 = FONT(x)->id, id2 = FONT(y)->id; if (id1 && id2) - return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy; + return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy; else - return 0; + return 0; } Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id : POINTER(x)) @@ -22,7 +22,7 @@ static Font_Visit (fp, f) Object *fp; int (*f)(); { Generic_Get_Display (Font, FONT) static Object Internal_Make_Font (finalize, dpy, name, id, info) - Display *dpy; Object name; Font id; XFontStruct *info; { + Display *dpy; Object name; Font id; XFontStruct *info; { Object f; GC_Node; @@ -30,24 +30,24 @@ static Object Internal_Make_Font (finalize, dpy, name, id, info) f = Alloc_Object (sizeof (struct S_Font), T_Font, 0); FONT(f)->dpy = dpy; if (TYPE(name) == T_Symbol) - name = SYMBOL(name)->name; + name = SYMBOL(name)->name; FONT(f)->name = name; FONT(f)->id = id; FONT(f)->info = info; if (id) - Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0); + Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0); GC_Unlink; return f; } /* Backwards compatibility: */ Object Make_Font (dpy, name, id, info) - Display *dpy; Object name; Font id; XFontStruct *info; { + Display *dpy; Object name; Font id; XFontStruct *info; { return Internal_Make_Font (1, dpy, name, id, info); } Object Make_Font_Foreign (dpy, name, id, info) - Display *dpy; Object name; Font id; XFontStruct *info; { + Display *dpy; Object name; Font id; XFontStruct *info; { return Internal_Make_Font (0, dpy, name, id, info); } @@ -65,7 +65,7 @@ static XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; { Get_Strsym_Stack (name, s); Disable_Interrupts; if ((p = XLoadQueryFont (d, s)) == 0) - Primitive_Error ("cannot open font: ~s", name); + Primitive_Error ("cannot open font: ~s", name); Enable_Interrupts; Alloca_End; return p; @@ -85,19 +85,19 @@ void Open_Font_Maybe (f) Object f; { name = FONT(f)->name; if (!Truep (name)) - Primitive_Error ("invalid font"); + Primitive_Error ("invalid font"); if (FONT(f)->id == 0) { - p = Internal_Open_Font (FONT(f)->dpy, name); - FONT(f)->id = p->fid; - FONT(f)->info = p; - Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0); + p = Internal_Open_Font (FONT(f)->dpy, name); + FONT(f)->id = p->fid; + FONT(f)->info = p; + Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0); } } Object P_Close_Font (f) Object f; { Check_Type (f, T_Font); if (FONT(f)->id) - XUnloadFont (FONT(f)->dpy, FONT(f)->id); + XUnloadFont (FONT(f)->dpy, FONT(f)->id); FONT(f)->id = 0; Deregister_Object (f); return Void; @@ -133,24 +133,24 @@ static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; { dpy = DISPLAY(d)->dpy; Disable_Interrupts; if (with_info) - ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret); + ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret); else - ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n); + ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n); Enable_Interrupts; v = Make_Vector (n, Null); f = Null; GC_Link2 (f, v); for (i = 0; i < n; i++) { - f = Make_String (ret[i], strlen (ret[i])); - if (with_info) - f = Make_Font (dpy, f, (Font)0, &iret[i]); - VECTOR(v)->data[i] = f; + f = Make_String (ret[i], strlen (ret[i])); + if (with_info) + f = Make_Font (dpy, f, (Font)0, &iret[i]); + VECTOR(v)->data[i] = f; } GC_Unlink; if (with_info) - XFreeFontInfo (ret, (XFontStruct *)0, 0); + XFreeFontInfo (ret, (XFontStruct *)0, 0); else - XFreeFontNames (ret); + XFreeFontNames (ret); return v; } @@ -166,7 +166,7 @@ static Object P_Font_Info (f) Object f; { Check_Type (f, T_Font); FI = *FONT(f)->info; return Record_To_Vector (Font_Info_Rec, Font_Info_Size, - Sym_Font_Info, FONT(f)->dpy, ~0L); + Sym_Font_Info, FONT(f)->dpy, ~0L); } static Object P_Char_Info (f, index) Object f, index; { @@ -181,36 +181,36 @@ static Object P_Char_Info (f, index) Object f, index; { p = FONT(f)->info; cp = &p->max_bounds; if (t == T_Symbol) { - if (EQ(index, Sym_Min)) - cp = &p->min_bounds; - else if (!EQ(index, Sym_Max)) - Primitive_Error (msg); + if (EQ(index, Sym_Min)) + cp = &p->min_bounds; + else if (!EQ(index, Sym_Max)) + Primitive_Error (msg); } else { - if (t == T_Character) - i = CHAR(index); - else if (t == T_Fixnum || t == T_Bignum) - i = (unsigned)Get_Integer (index); - else - Primitive_Error (msg); - if (!p->min_byte1 && !p->max_byte1) { - if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2) - Range_Error (index); - i -= p->min_char_or_byte2; - } else { - register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff; - if (b1 < p->min_byte1 || b1 > p->max_byte1 || - b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2) - Range_Error (index); - b1 -= p->min_byte1; - b2 -= p->min_char_or_byte2; - i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2; - } - if (p->per_char) - cp = p->per_char + i; + if (t == T_Character) + i = CHAR(index); + else if (t == T_Fixnum || t == T_Bignum) + i = (unsigned)Get_Integer (index); + else + Primitive_Error (msg); + if (!p->min_byte1 && !p->max_byte1) { + if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2) + Range_Error (index); + i -= p->min_char_or_byte2; + } else { + register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff; + if (b1 < p->min_byte1 || b1 > p->max_byte1 || + b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2) + Range_Error (index); + b1 -= p->min_byte1; + b2 -= p->min_char_or_byte2; + i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2; + } + if (p->per_char) + cp = p->per_char + i; } CI = *cp; return Record_To_Vector (Char_Info_Rec, Char_Info_Size, - Sym_Char_Info, FONT(f)->dpy, ~0L); + Sym_Char_Info, FONT(f)->dpy, ~0L); } static Object P_Font_Properties (f) Object f; { @@ -224,11 +224,11 @@ static Object P_Font_Properties (f) Object f; { a = val = Null; GC_Link4 (v, a, val, f); for (i = 0; i < n; i++) { - register XFontProp *p = FONT(f)->info->properties+i; - a = Make_Atom (p->name); - val = Make_Unsigned_Long ((unsigned long)p->card32); - x = Cons (a, val); - VECTOR(v)->data[i] = x; + register XFontProp *p = FONT(f)->info->properties+i; + a = Make_Atom (p->name); + val = Make_Unsigned_Long ((unsigned long)p->card32); + x = Cons (a, val); + VECTOR(v)->data[i] = x; } GC_Unlink; return v; @@ -247,10 +247,10 @@ static Object P_Font_Path (d) Object d; { v = Make_Vector (n, Null); GC_Link (v); for (i = 0; i < n; i++) { - Object x; + Object x; - x = Make_String (ret[i], strlen (ret[i])); - VECTOR(v)->data[i] = x; + x = Make_String (ret[i], strlen (ret[i])); + VECTOR(v)->data[i] = x; } GC_Unlink; XFreeFontPath (ret); @@ -268,8 +268,8 @@ static Object P_Set_Font_Path (d, p) Object d, p; { n = Fast_Length (p); Alloca (path, char**, n * sizeof (char *)); for (i = 0; i < n; i++, p = Cdr (p)) { - c = Car (p); - Get_Strsym_Stack (c, path[i]); + c = Car (p); + Get_Strsym_Stack (c, path[i]); } XSetFontPath (DISPLAY(d)->dpy, path, n); Alloca_End; @@ -282,7 +282,7 @@ elk_init_xlib_font () { Define_Symbol (&Sym_Min, "min"); Define_Symbol (&Sym_Max, "max"); T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font), - Font_Equal, Font_Equal, Font_Print, Font_Visit); + Font_Equal, Font_Equal, Font_Print, Font_Visit); Define_Primitive (P_Fontp, "font?", 1, 1, EVAL); Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL); Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL); diff --git a/lib/xlib/gcontext.c b/lib/xlib/gcontext.c index 8642999..5e95566 100644 --- a/lib/xlib/gcontext.c +++ b/lib/xlib/gcontext.c @@ -14,16 +14,16 @@ Object Make_Gc (finalize, dpy, g) Display *dpy; GC g; { Object gc; if (g == None) - return Sym_None; + return Sym_None; gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g); if (Nullp (gc)) { - gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0); - GCONTEXT(gc)->tag = Null; - GCONTEXT(gc)->gc = g; - GCONTEXT(gc)->dpy = dpy; - GCONTEXT(gc)->free = 0; - Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc : - (PFO)0, 0); + gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0); + GCONTEXT(gc)->tag = Null; + GCONTEXT(gc)->gc = g; + GCONTEXT(gc)->dpy = dpy; + GCONTEXT(gc)->free = 0; + Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc : + (PFO)0, 0); } return gc; } @@ -62,7 +62,7 @@ static Object P_Change_Gc (gc, g) Object gc, g; { Object P_Free_Gc (g) Object g; { Check_Type (g, T_Gc); if (!GCONTEXT(g)->free) - XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc); + XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc); Deregister_Object (g); GCONTEXT(g)->free = 1; return Void; @@ -73,14 +73,14 @@ static Object P_Query_Best_Size (d, w, h, shape) Object d, w, h, shape; { Check_Type (d, T_Display); if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0, - Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy), - Get_Integer (w), Get_Integer (h), &rw, &rh)) - Primitive_Error ("cannot query best shape"); + Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy), + Get_Integer (w), Get_Integer (h), &rw, &rh)) + Primitive_Error ("cannot query best shape"); return Cons (Make_Integer (rw), Make_Integer (rh)); } static Object P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord) - Object gc, x, y, v, ord; { + Object gc, x, y, v, ord; { register XRectangle *p; register i, n; Alloca_Begin; @@ -90,19 +90,19 @@ static Object P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord) n = VECTOR(v)->size; Alloca (p, XRectangle*, n * sizeof (XRectangle)); for (i = 0; i < n; i++) { - Object rect; + Object rect; - rect = VECTOR(v)->data[i]; - Check_Type (rect, T_Pair); - if (Fast_Length (rect) != 4) - Primitive_Error ("invalid rectangle: ~s", rect); - p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].height = Get_Integer (Car (rect)); + rect = VECTOR(v)->data[i]; + Check_Type (rect, T_Pair); + if (Fast_Length (rect) != 4) + Primitive_Error ("invalid rectangle: ~s", rect); + p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].height = Get_Integer (Car (rect)); } XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (x), - Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms)); + Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms)); Alloca_End; return Void; } @@ -117,10 +117,10 @@ static Object P_Set_Gcontext_Dashlist (gc, off, v) Object gc, off, v; { n = VECTOR(v)->size; Alloca (p, char*, n); for (i = 0; i < n; i++) { - d = Get_Integer (VECTOR(v)->data[i]); - if (d < 0 || d > 255) - Range_Error (VECTOR(v)->data[i]); - p[i] = d; + d = Get_Integer (VECTOR(v)->data[i]); + if (d < 0 || d > 255) + Range_Error (VECTOR(v)->data[i]); + p[i] = d; } XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (off), p, n); Alloca_End; @@ -139,9 +139,9 @@ static Object P_Get_Gc_Values (gc) Object gc; { Check_Type (gc, T_Gc); if (!XGetGCValues (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV)) - Primitive_Error ("cannot get gcontext values"); + Primitive_Error ("cannot get gcontext values"); return Record_To_Vector (GC_Rec, GC_Size, Sym_Gc, GCONTEXT(gc)->dpy, - mask); + mask); } elk_init_xlib_gcontext () { @@ -154,9 +154,9 @@ elk_init_xlib_gcontext () { Define_Primitive (P_Free_Gc, "free-gcontext", 1, 1, EVAL); Define_Primitive (P_Query_Best_Size, "query-best-size", 4, 4, EVAL); Define_Primitive (P_Set_Gcontext_Clip_Rectangles, - "set-gcontext-clip-rectangles!", 5, 5, EVAL); + "set-gcontext-clip-rectangles!", 5, 5, EVAL); Define_Primitive (P_Set_Gcontext_Dashlist, - "set-gcontext-dashlist!", 3, 3, EVAL); + "set-gcontext-dashlist!", 3, 3, EVAL); Define_Primitive (P_Get_Gc_Values, - "xlib-get-gcontext-values", 1, 1, EVAL); + "xlib-get-gcontext-values", 1, 1, EVAL); } diff --git a/lib/xlib/grab.c b/lib/xlib/grab.c index a46d9ea..904bb72 100644 --- a/lib/xlib/grab.c +++ b/lib/xlib/grab.c @@ -4,7 +4,7 @@ static Object Sym_Any; Time Get_Time (time) Object time; { if (EQ(time, Sym_Now)) - return CurrentTime; + return CurrentTime; return (Time)Get_Long (time); } @@ -14,16 +14,16 @@ static Get_Mode (m) Object m; { } static Object P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to, - cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to, - cursor, time; { + cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to, + cursor, time; { Check_Type (win, T_Window); Check_Type (ownerp, T_Boolean); return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy, - WINDOW(win)->win, - EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), - Get_Mode (psyncp), Get_Mode (ksyncp), - Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)), - 0, Grabstatus_Syms); + WINDOW(win)->win, + EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), + Get_Mode (psyncp), Get_Mode (ksyncp), + Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)), + 0, Grabstatus_Syms); } static Object P_Ungrab_Pointer (d, time) Object d, time; { @@ -33,41 +33,41 @@ static Object P_Ungrab_Pointer (d, time) Object d, time; { } static Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp, - confine_to, cursor) Object win, button, mods, ownerp, events, - psyncp, ksyncp, confine_to, cursor; { + confine_to, cursor) Object win, button, mods, ownerp, events, + psyncp, ksyncp, confine_to, cursor; { Check_Type (win, T_Window); Check_Type (ownerp, T_Boolean); XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), - Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win, - EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), - Get_Mode (psyncp), Get_Mode (ksyncp), - Get_Window (confine_to), Get_Cursor (cursor)); + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win, + EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), + Get_Mode (psyncp), Get_Mode (ksyncp), + Get_Window (confine_to), Get_Cursor (cursor)); return Void; } static Object P_Ungrab_Button (win, button, mods) Object win, button, mods; { Check_Type (win, T_Window); XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), - Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); return Void; } static Object P_Change_Active_Pointer_Grab (d, events, cursor, time) - Object d, events, cursor, time; { + Object d, events, cursor, time; { Check_Type (d, T_Display); XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1, - Event_Syms), Get_Cursor (cursor), Get_Time (time)); + Event_Syms), Get_Cursor (cursor), Get_Time (time)); return Void; } static Object P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) Object win, - ownerp, psyncp, ksyncp, time; { + ownerp, psyncp, ksyncp, time; { Check_Type (win, T_Window); Check_Type (ownerp, T_Boolean); return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy, - WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), - Get_Mode (ksyncp), Get_Time (time)), - 0, Grabstatus_Syms); + WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), + Get_Mode (ksyncp), Get_Time (time)), + 0, Grabstatus_Syms); } static Object P_Ungrab_Keyboard (d, time) Object d, time; { @@ -77,16 +77,16 @@ static Object P_Ungrab_Keyboard (d, time) Object d, time; { } static Object P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) Object win, - key, mods, ownerp, psyncp, ksyncp; { + key, mods, ownerp, psyncp, ksyncp; { int keycode = AnyKey; Check_Type (win, T_Window); if (!EQ(key, Sym_Any)) - keycode = Get_Integer (key); + keycode = Get_Integer (key); Check_Type (ownerp, T_Boolean); XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms), - WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), - Get_Mode (ksyncp)); + WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), + Get_Mode (ksyncp)); return Void; } @@ -95,16 +95,16 @@ static Object P_Ungrab_Key (win, key, mods) Object win, key, mods; { Check_Type (win, T_Window); if (!EQ(key, Sym_Any)) - keycode = Get_Integer (key); + keycode = Get_Integer (key); XUngrabKey (WINDOW(win)->dpy, keycode, - Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); return Void; } static Object P_Allow_Events (d, mode, time) Object d, mode, time; { Check_Type (d, T_Display); XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0, - Allow_Events_Syms), Get_Time (time)); + Allow_Events_Syms), Get_Time (time)); return Void; } @@ -126,7 +126,7 @@ elk_init_xlib_grab () { Define_Primitive (P_Grab_Button, "grab-button", 9, 9, EVAL); Define_Primitive (P_Ungrab_Button, "ungrab-button", 3, 3, EVAL); Define_Primitive (P_Change_Active_Pointer_Grab, - "change-active-pointer-grab", 4, 4, EVAL); + "change-active-pointer-grab", 4, 4, EVAL); Define_Primitive (P_Grab_Keyboard, "grab-keyboard", 5, 5, EVAL); Define_Primitive (P_Ungrab_Keyboard, "ungrab-keyboard", 2, 2, EVAL); Define_Primitive (P_Grab_Key, "grab-key", 6, 6, EVAL); diff --git a/lib/xlib/graphics.c b/lib/xlib/graphics.c index f9aa3c6..4774057 100644 --- a/lib/xlib/graphics.c +++ b/lib/xlib/graphics.c @@ -8,24 +8,24 @@ static Object P_Clear_Area (win, x, y, w, h, e) Object win, x, y, w, h, e; { Check_Type (win, T_Window); Check_Type (e, T_Boolean); XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, Get_Integer (x), - Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True)); + Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True)); return Void; } static Object P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) Object src, gc, - sx, sy, w, h, dst, dx, dy; { + sx, sy, w, h, dst, dx, dy; { Display *dpy; Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy); Check_Type (gc, T_Gc); XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx), - Get_Integer (sy), Get_Integer (w), Get_Integer (h), - Get_Integer (dx), Get_Integer (dy)); + Get_Integer (sy), Get_Integer (w), Get_Integer (h), + Get_Integer (dx), Get_Integer (dy)); return Void; } static Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy) - Object src, gc, plane, sx, sy, w, h, dst, dx, dy; { + Object src, gc, plane, sx, sy, w, h, dst, dx, dy; { Display *dpy; Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy); register unsigned long p; @@ -33,10 +33,10 @@ static Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy) Check_Type (gc, T_Gc); p = (unsigned long)Get_Long (plane); if (p & (p-1)) - Primitive_Error ("invalid plane: ~s", plane); + Primitive_Error ("invalid plane: ~s", plane); XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx), - Get_Integer (sy), Get_Integer (w), Get_Integer (h), - Get_Integer (dx), Get_Integer (dy), p); + Get_Integer (sy), Get_Integer (w), Get_Integer (h), + Get_Integer (dx), Get_Integer (dy), p); return Void; } @@ -50,7 +50,7 @@ static Object P_Draw_Point (d, gc, x, y) Object d, gc, x, y; { } static Object Internal_Draw_Points (d, gc, v, relative, func, shape) - Object d, gc, v, relative, shape; int (*func)(); { + Object d, gc, v, relative, shape; int (*func)(); { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); register XPoint *p; @@ -62,21 +62,21 @@ static Object Internal_Draw_Points (d, gc, v, relative, func, shape) Check_Type (relative, T_Boolean); rel = EQ(relative, True) ? CoordModePrevious : CoordModeOrigin; if (func == XFillPolygon) - sh = Symbols_To_Bits (shape, 0, Polyshape_Syms); + sh = Symbols_To_Bits (shape, 0, Polyshape_Syms); n = VECTOR(v)->size; Alloca (p, XPoint*, n * sizeof (XPoint)); for (i = 0; i < n; i++) { - Object point; + Object point; - point = VECTOR(v)->data[i]; - Check_Type (point, T_Pair); - p[i].x = Get_Integer (Car (point)); - p[i].y = Get_Integer (Cdr (point)); + point = VECTOR(v)->data[i]; + Check_Type (point, T_Pair); + p[i].x = Get_Integer (Car (point)); + p[i].y = Get_Integer (Cdr (point)); } if (func == XFillPolygon) - XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel); + XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel); else - (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel); + (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel); Alloca_End; return Void; } @@ -86,13 +86,13 @@ static Object P_Draw_Points (d, gc, v, relative) Object d, gc, v, relative; { } static Object P_Draw_Line (d, gc, x1, y1, x2, y2) - Object d, gc, x1, y1, x2, y2; { + Object d, gc, x1, y1, x2, y2; { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); Check_Type (gc, T_Gc); XDrawLine (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x1), Get_Integer (y1), - Get_Integer (x2), Get_Integer (y2)); + Get_Integer (x2), Get_Integer (y2)); return Void; } @@ -111,16 +111,16 @@ static Object P_Draw_Segments (d, gc, v) Object d, gc, v; { n = VECTOR(v)->size; Alloca (p, XSegment*, n * sizeof (XSegment)); for (i = 0; i < n; i++) { - Object seg; + Object seg; - seg = VECTOR(v)->data[i]; - Check_Type (seg, T_Pair); - if (Fast_Length (seg) != 4) - Primitive_Error ("invalid segment: ~s", seg); - p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg); - p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg); - p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg); - p[i].y2 = Get_Integer (Car (seg)); + seg = VECTOR(v)->data[i]; + Check_Type (seg, T_Pair); + if (Fast_Length (seg) != 4) + Primitive_Error ("invalid segment: ~s", seg); + p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].y2 = Get_Integer (Car (seg)); } XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n); Alloca_End; @@ -128,13 +128,13 @@ static Object P_Draw_Segments (d, gc, v) Object d, gc, v; { } static Object Internal_Draw_Rectangle (d, gc, x, y, w, h, func) - Object d, gc, x, y, w, h; int (*func)(); { + Object d, gc, x, y, w, h; int (*func)(); { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); Check_Type (gc, T_Gc); (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), - Get_Integer (y), Get_Integer (w), Get_Integer (h)); + Get_Integer (y), Get_Integer (w), Get_Integer (h)); return Void; } @@ -147,7 +147,7 @@ static Object P_Fill_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; { } static Object Internal_Draw_Rectangles (d, gc, v, func) - Object d, gc, v; int (*func)(); { + Object d, gc, v; int (*func)(); { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); register XRectangle *p; @@ -158,16 +158,16 @@ static Object Internal_Draw_Rectangles (d, gc, v, func) n = VECTOR(v)->size; Alloca (p, XRectangle*, n * sizeof (XRectangle)); for (i = 0; i < n; i++) { - Object rect; + Object rect; - rect = VECTOR(v)->data[i]; - Check_Type (rect, T_Pair); - if (Fast_Length (rect) != 4) - Primitive_Error ("invalid rectangle: ~s", rect); - p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); - p[i].height = Get_Integer (Car (rect)); + rect = VECTOR(v)->data[i]; + Check_Type (rect, T_Pair); + if (Fast_Length (rect) != 4) + Primitive_Error ("invalid rectangle: ~s", rect); + p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].height = Get_Integer (Car (rect)); } (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n); Alloca_End; @@ -183,28 +183,28 @@ static Object P_Fill_Rectangles (d, gc, v) Object d, gc, v; { } static Object Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func) - Object d, gc, x, y, w, h, a1, a2; int (*func)(); { + Object d, gc, x, y, w, h, a1, a2; int (*func)(); { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); Check_Type (gc, T_Gc); (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y), - Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2)); + Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2)); return Void; } static Object P_Draw_Arc (d, gc, x, y, w, h, a1, a2) - Object d, gc, x, y, w, h, a1, a2; { + Object d, gc, x, y, w, h, a1, a2; { return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc); } static Object P_Fill_Arc (d, gc, x, y, w, h, a1, a2) - Object d, gc, x, y, w, h, a1, a2; { + Object d, gc, x, y, w, h, a1, a2; { return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XFillArc); } static Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v; - int (*func)(); { + int (*func)(); { Display *dpy; Drawable dr = Get_Drawable (d, &dpy); register XArc *p; @@ -215,18 +215,18 @@ static Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v; n = VECTOR(v)->size; Alloca (p, XArc*, n * sizeof (XArc)); for (i = 0; i < n; i++) { - Object arc; + Object arc; - arc = VECTOR(v)->data[i]; - Check_Type (arc, T_Pair); - if (Fast_Length (arc) != 6) - Primitive_Error ("invalid arc: ~s", arc); - p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc); - p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc); - p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc); - p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc); - p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc); - p[i].angle2 = Get_Integer (Car (arc)); + arc = VECTOR(v)->data[i]; + Check_Type (arc, T_Pair); + if (Fast_Length (arc) != 6) + Primitive_Error ("invalid arc: ~s", arc); + p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].angle2 = Get_Integer (Car (arc)); } (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n); Alloca_End; @@ -242,7 +242,7 @@ static Object P_Fill_Arcs (d, gc, v) Object d, gc, v; { } static Object P_Fill_Polygon (d, gc, v, relative, shape) - Object d, gc, v, relative, shape; { + Object d, gc, v, relative, shape; { return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape); } diff --git a/lib/xlib/key.c b/lib/xlib/key.c index cb6d45a..728a089 100644 --- a/lib/xlib/key.c +++ b/lib/xlib/key.c @@ -43,7 +43,7 @@ static Object P_Display_Keysyms_Per_Keycode (d) Object d; { Check_Type (d, T_Display); XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); ksyms = XGetKeyboardMapping(DISPLAY(d)->dpy, (KeyCode)mink, - maxk - mink + 1, &ksyms_per_kode); + maxk - mink + 1, &ksyms_per_kode); return Make_Integer (ksyms_per_kode); } @@ -78,7 +78,7 @@ static Object P_Keycode_To_Keysym (d, k, index) Object d, k, index; { Check_Type (d, T_Display); Disable_Interrupts; ret = Make_Unsigned_Long ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy, - Get_Integer (k), Get_Integer (index))); + Get_Integer (k), Get_Integer (index))); Enable_Interrupts; return ret; } @@ -89,7 +89,7 @@ static Object P_Keysym_To_Keycode (d, k) Object d, k; { Check_Type (d, T_Display); Disable_Interrupts; ret = Make_Unsigned (XKeysymToKeycode (DISPLAY(d)->dpy, - (KeySym)Get_Long (k))); + (KeySym)Get_Long (k))); Enable_Interrupts; return ret; } @@ -122,9 +122,9 @@ static Object P_Rebind_Keysym (d, k, mods, str) Object d, k, mods, str; { n = VECTOR(mods)->size; Alloca (p, KeySym*, n * sizeof (KeySym)); for (i = 0; i < n; i++) - p[i] = (KeySym)Get_Long (VECTOR(mods)->data[i]); + p[i] = (KeySym)Get_Long (VECTOR(mods)->data[i]); XRebindKeysym (DISPLAY(d)->dpy, (KeySym)Get_Long (k), p, n, - (unsigned char *)STRING(str)->data, STRING(str)->size); + (unsigned char *)STRING(str)->data, STRING(str)->size); Alloca_End; return Void; } @@ -143,11 +143,11 @@ static Object P_Refresh_Keyboard_Mapping (w, event) Object w, event; { elk_init_xlib_key () { Define_Primitive (P_Display_Min_Keycode, "display-min-keycode", - 1, 1, EVAL); + 1, 1, EVAL); Define_Primitive (P_Display_Max_Keycode, "display-max-keycode", - 1, 1, EVAL); + 1, 1, EVAL); Define_Primitive (P_Display_Keysyms_Per_Keycode, - "display-keysyms-per-keycode", 1, 1, EVAL); + "display-keysyms-per-keycode", 1, 1, EVAL); Define_Primitive (P_String_To_Keysym, "string->keysym", 1, 1, EVAL); Define_Primitive (P_Keysym_To_String, "keysym->string", 1, 1, EVAL); Define_Primitive (P_Keycode_To_Keysym, "keycode->keysym", 3, 3, EVAL); @@ -155,5 +155,5 @@ elk_init_xlib_key () { Define_Primitive (P_Lookup_String, "lookup-string", 3, 3, EVAL); Define_Primitive (P_Rebind_Keysym, "rebind-keysym", 4, 4, EVAL); Define_Primitive (P_Refresh_Keyboard_Mapping, - "refresh-keyboard-mapping", 2, 2, EVAL); + "refresh-keyboard-mapping", 2, 2, EVAL); } diff --git a/lib/xlib/pixel.c b/lib/xlib/pixel.c index f51b04f..e2e4c8e 100644 --- a/lib/xlib/pixel.c +++ b/lib/xlib/pixel.c @@ -11,10 +11,10 @@ Object Make_Pixel (val) unsigned long val; { pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val); if (Nullp (pix)) { - pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0); - PIXEL(pix)->tag = Null; - PIXEL(pix)->pix = val; - Register_Object (pix, (GENERIC)0, (PFO)0, 0); + pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0); + PIXEL(pix)->tag = Null; + PIXEL(pix)->pix = val; + Register_Object (pix, (GENERIC)0, (PFO)0, 0); } return pix; } @@ -31,13 +31,13 @@ static Object P_Pixel_Value (p) Object p; { static Object P_Black_Pixel (d) Object d; { Check_Type (d, T_Display); return Make_Pixel (BlackPixel (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } static Object P_White_Pixel (d) Object d; { Check_Type (d, T_Display); return Make_Pixel (WhitePixel (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); + DefaultScreen (DISPLAY(d)->dpy))); } elk_init_xlib_pixel () { diff --git a/lib/xlib/pixmap.c b/lib/xlib/pixmap.c index 4d1aaa0..94261df 100644 --- a/lib/xlib/pixmap.c +++ b/lib/xlib/pixmap.c @@ -9,20 +9,20 @@ Generic_Print (Pixmap, "#[pixmap %lu]", PIXMAP(x)->pm) Generic_Get_Display (Pixmap, PIXMAP) static Object Internal_Make_Pixmap (finalize, dpy, pix) - Display *dpy; Pixmap pix; { + Display *dpy; Pixmap pix; { Object pm; if (pix == None) - return Sym_None; + return Sym_None; pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix); if (Nullp (pm)) { - pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0); - PIXMAP(pm)->tag = Null; - PIXMAP(pm)->pm = pix; - PIXMAP(pm)->dpy = dpy; - PIXMAP(pm)->free = 0; - Register_Object (pm, (GENERIC)dpy, - finalize ? P_Free_Pixmap : (PFO)0, 0); + pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0); + PIXMAP(pm)->tag = Null; + PIXMAP(pm)->pm = pix; + PIXMAP(pm)->dpy = dpy; + PIXMAP(pm)->free = 0; + Register_Object (pm, (GENERIC)dpy, + finalize ? P_Free_Pixmap : (PFO)0, 0); } return pm; } @@ -44,7 +44,7 @@ Pixmap Get_Pixmap (p) Object p; { Object P_Free_Pixmap (p) Object p; { Check_Type (p, T_Pixmap); if (!PIXMAP(p)->free) - XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm); + XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm); Deregister_Object (p); PIXMAP(p)->free = 1; return Void; @@ -55,11 +55,11 @@ static Object P_Create_Pixmap (d, w, h, depth) Object d, w, h, depth; { Drawable dr = Get_Drawable (d, &dpy); return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w), - Get_Integer (h), Get_Integer (depth))); + Get_Integer (h), Get_Integer (depth))); } static Object P_Create_Bitmap_From_Data (win, data, pw, ph) - Object win, data, pw, ph; { + Object win, data, pw, ph; { register w, h; Check_Type (win, T_Window); @@ -67,14 +67,14 @@ static Object P_Create_Bitmap_From_Data (win, data, pw, ph) w = Get_Integer (pw); h = Get_Integer (ph); if (w * h > 8 * STRING(data)->size) - Primitive_Error ("bitmap too small"); + Primitive_Error ("bitmap too small"); return Make_Pixmap (WINDOW(win)->dpy, - XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win, - STRING(data)->data, w, h)); + XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win, + STRING(data)->data, w, h)); } static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg, - depth) Object win, data, pw, ph, fg, bg, depth; { + depth) Object win, data, pw, ph, fg, bg, depth; { register w, h; Check_Type (win, T_Window); @@ -82,11 +82,11 @@ static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg, w = Get_Integer (pw); h = Get_Integer (ph); if (w * h > 8 * STRING(data)->size) - Primitive_Error ("bitmap too small"); + Primitive_Error ("bitmap too small"); return Make_Pixmap (WINDOW(win)->dpy, - XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win, - STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg), - Get_Integer (depth))); + XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win, + STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg), + Get_Integer (depth))); } static Object P_Read_Bitmap_File (d, fn) Object d, fn; { @@ -100,10 +100,10 @@ static Object P_Read_Bitmap_File (d, fn) Object d, fn; { Disable_Interrupts; r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap, - &xhot, &yhot); + &xhot, &yhot); Enable_Interrupts; if (r != BitmapSuccess) - return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms); + return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms); t = ret = P_Make_List (Make_Integer (5), Null); GC_Link2 (ret, t); x = Make_Pixmap (dpy, bitmap); @@ -122,14 +122,14 @@ static Object P_Write_Bitmap_File (argc, argv) Object *argv; { pm = Get_Pixmap (argv[1]); if (argc == 5) - Primitive_Error ("both x-hot and y-hot must be specified"); + Primitive_Error ("both x-hot and y-hot must be specified"); if (argc == 6) { - xhot = Get_Integer (argv[4]); - yhot = Get_Integer (argv[5]); + xhot = Get_Integer (argv[4]); + yhot = Get_Integer (argv[5]); } Disable_Interrupts; ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm, - Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot); + Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot); Enable_Interrupts; return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms); } @@ -140,9 +140,9 @@ elk_init_xlib_pixmap () { Define_Primitive (P_Free_Pixmap, "free-pixmap", 1, 1, EVAL); Define_Primitive (P_Create_Pixmap, "create-pixmap", 4, 4, EVAL); Define_Primitive (P_Create_Bitmap_From_Data, - "create-bitmap-from-data", 4, 4, EVAL); + "create-bitmap-from-data", 4, 4, EVAL); Define_Primitive (P_Create_Pixmap_From_Bitmap_Data, - "create-pixmap-from-bitmap-data", 7, 7, EVAL); + "create-pixmap-from-bitmap-data", 7, 7, EVAL); Define_Primitive (P_Read_Bitmap_File, "read-bitmap-file", 2, 2, EVAL); Define_Primitive (P_Write_Bitmap_File, "write-bitmap-file", 4, 6, VARARGS); } diff --git a/lib/xlib/property.c b/lib/xlib/property.c index a1292b0..4fba43a 100644 --- a/lib/xlib/property.c +++ b/lib/xlib/property.c @@ -12,13 +12,13 @@ Object Make_Atom (a) Atom a; { Object atom; if (a == None) - return Sym_None; + return Sym_None; atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a); if (Nullp (atom)) { - atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0); - ATOM(atom)->tag = Null; - ATOM(atom)->atom = a; - Register_Object (atom, (GENERIC)0, (PFO)0, 0); + atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0); + ATOM(atom)->tag = Null; + ATOM(atom)->atom = a; + Register_Object (atom, (GENERIC)0, (PFO)0, 0); } return atom; } @@ -63,10 +63,10 @@ static Object P_List_Properties (w) Object w; { v = Make_Vector (n, Null); GC_Link (v); for (i = 0; i < n; i++) { - Object x; + Object x; - x = Make_Atom (ap[i]); - VECTOR(v)->data[i] = x; + x = Make_Atom (ap[i]); + VECTOR(v)->data[i] = x; } GC_Unlink; XFree ((char *)ap); @@ -74,7 +74,7 @@ static Object P_List_Properties (w) Object w; { } static Object P_Get_Property (w, prop, type, start, len, deletep) - Object w, prop, type, start, len, deletep; { + Object w, prop, type, start, len, deletep; { Atom req_type = AnyPropertyType, actual_type; int format; unsigned long nitems, bytes_left; @@ -86,16 +86,16 @@ static Object P_Get_Property (w, prop, type, start, len, deletep) Check_Type (w, T_Window); Check_Type (prop, T_Atom); if (!EQ(type, False)) { - Check_Type (type, T_Atom); - req_type = ATOM(type)->atom; + Check_Type (type, T_Atom); + req_type = ATOM(type)->atom; } Check_Type (deletep, T_Boolean); Disable_Interrupts; if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, - Get_Long (start), Get_Long (len), - EQ(deletep, True), req_type, &actual_type, &format, - &nitems, &bytes_left, &data) != Success) - Primitive_Error ("cannot get property"); + Get_Long (start), Get_Long (len), + EQ(deletep, True), req_type, &actual_type, &format, + &nitems, &bytes_left, &data) != Success) + Primitive_Error ("cannot get property"); Enable_Interrupts; ret = t = P_Make_List (Make_Integer (4), Null); GC_Link2 (ret, t); @@ -104,26 +104,26 @@ static Object P_Get_Property (w, prop, type, start, len, deletep) x = Make_Integer (format); Car (t) = x; t = Cdr (t); if (nitems) { - if (format == 8) { - Object s; - x = Make_String ((char *)0, (int)nitems); - s = Car (t) = x; - bcopy ((char *)data, STRING(s)->data, (int)nitems); - } else { - Object v; - GC_Node; - /* Assumes short is 16 bits and int is 32 bits. - */ - v = Make_Vector ((int)nitems, Null); - GC_Link (v); - for (i = 0; i < nitems; i++) { - x = Make_Unsigned (format == 16 ? - *((short *)data + i) : *((int *)data + i)); - VECTOR(v)->data[i] = x; - } - Car (t) = v; - GC_Unlink; - } + if (format == 8) { + Object s; + x = Make_String ((char *)0, (int)nitems); + s = Car (t) = x; + bcopy ((char *)data, STRING(s)->data, (int)nitems); + } else { + Object v; + GC_Node; + /* Assumes short is 16 bits and int is 32 bits. + */ + v = Make_Vector ((int)nitems, Null); + GC_Link (v); + for (i = 0; i < nitems; i++) { + x = Make_Unsigned (format == 16 ? + *((short *)data + i) : *((int *)data + i)); + VECTOR(v)->data[i] = x; + } + Car (t) = v; + GC_Unlink; + } } t = Cdr (t); x = Make_Unsigned_Long (bytes_left); @@ -133,7 +133,7 @@ static Object P_Get_Property (w, prop, type, start, len, deletep) } static Object P_Change_Property (w, prop, type, format, mode, data) - Object w, prop, type, format, mode, data; { + Object w, prop, type, format, mode, data; { register i, m, x, nitems, f; char *buf; Alloca_Begin; @@ -144,28 +144,28 @@ static Object P_Change_Property (w, prop, type, format, mode, data) m = Symbols_To_Bits (mode, 0, Propmode_Syms); switch (f = Get_Integer (format)) { case 8: - Check_Type (data, T_String); - buf = STRING(data)->data; - nitems = STRING(data)->size; - break; + Check_Type (data, T_String); + buf = STRING(data)->data; + nitems = STRING(data)->size; + break; case 16: case 32: - Check_Type (data, T_Vector); - nitems = VECTOR(data)->size; - Alloca (buf, char*, nitems * (f / sizeof (char))); - for (i = 0; i < nitems; i++) { - x = Get_Integer (VECTOR(data)->data[i]); - if (f == 16) { - if (x > 65535) - Primitive_Error ("format mismatch"); - *((short *)buf + i) = x; /* Assumes short is 16 bits */ - } else *((int *)buf + i) = x; /* and int is 32 bits. */ - } - break; + Check_Type (data, T_Vector); + nitems = VECTOR(data)->size; + Alloca (buf, char*, nitems * (f / sizeof (char))); + for (i = 0; i < nitems; i++) { + x = Get_Integer (VECTOR(data)->data[i]); + if (f == 16) { + if (x > 65535) + Primitive_Error ("format mismatch"); + *((short *)buf + i) = x; /* Assumes short is 16 bits */ + } else *((int *)buf + i) = x; /* and int is 32 bits. */ + } + break; default: - Primitive_Error ("invalid format: ~s", format); + Primitive_Error ("invalid format: ~s", format); } XChangeProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, - ATOM(type)->atom, f, m, (unsigned char *)buf, nitems); + ATOM(type)->atom, f, m, (unsigned char *)buf, nitems); Alloca_End; return Void; } @@ -187,24 +187,24 @@ static Object P_Rotate_Properties (w, v, delta) Object w, v, delta; { n = VECTOR(v)->size; Alloca (p, Atom*, n * sizeof (Atom)); for (i = 0; i < n; i++) { - Object a; + Object a; - a = VECTOR(v)->data[i]; - Check_Type (a, T_Atom); - p[i] = ATOM(a)->atom; + a = VECTOR(v)->data[i]; + Check_Type (a, T_Atom); + p[i] = ATOM(a)->atom; } XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n, - Get_Integer (delta)); + Get_Integer (delta)); Alloca_End; return Void; } static Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner, - time; { + time; { Check_Type (d, T_Display); Check_Type (s, T_Atom); XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner), - Get_Time (time)); + Get_Time (time)); return Void; } @@ -212,22 +212,22 @@ static Object P_Selection_Owner (d, s) Object d, s; { Check_Type (d, T_Display); Check_Type (s, T_Atom); return Make_Window (0, DISPLAY(d)->dpy, - XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom)); + XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom)); } static Object P_Convert_Selection (s, target, prop, w, time) - Object s, target, prop, w, time; { + Object s, target, prop, w, time; { Atom p = None; Check_Type (s, T_Atom); Check_Type (target, T_Atom); if (!EQ(prop, Sym_None)) { - Check_Type (prop, T_Atom); - p = ATOM(prop)->atom; + Check_Type (prop, T_Atom); + p = ATOM(prop)->atom; } Check_Type (w, T_Window); XConvertSelection (WINDOW(w)->dpy, ATOM(s)->atom, ATOM(target)->atom, - p, WINDOW(w)->win, Get_Time (time)); + p, WINDOW(w)->win, Get_Time (time)); return Void; } @@ -244,7 +244,7 @@ elk_init_xlib_property () { Define_Primitive (P_Delete_Property, "delete-property", 2, 2, EVAL); Define_Primitive (P_Rotate_Properties, "rotate-properties", 3, 3, EVAL); Define_Primitive (P_Set_Selection_Owner, "set-selection-owner!", - 4, 4, EVAL); + 4, 4, EVAL); Define_Primitive (P_Selection_Owner, "selection-owner", 2, 2, EVAL); Define_Primitive (P_Convert_Selection, "convert-selection", 5, 5, EVAL); } diff --git a/lib/xlib/text.c b/lib/xlib/text.c index cc3c2b9..8360879 100644 --- a/lib/xlib/text.c +++ b/lib/xlib/text.c @@ -6,9 +6,9 @@ static Object Sym_1byte, Sym_2byte; static Two_Byte (format) Object format; { Check_Type (format, T_Symbol); if (EQ(format, Sym_1byte)) - return 0; + return 0; else if (EQ(format, Sym_2byte)) - return 1; + return 1; Primitive_Error ("index format must be '1-byte or '2-byte"); /*NOTREACHED*/ } @@ -16,14 +16,14 @@ static Two_Byte (format) Object format; { static Get_1_Byte_Char (x) Object x; { register c = Get_Integer (x); if (c < 0 || c > 255) - Range_Error (x); + Range_Error (x); return c; } static Get_2_Byte_Char (x) Object x; { register c = Get_Integer (x); if (c < 0 || c > 65535) - Range_Error (x); + Range_Error (x); return c; } @@ -48,28 +48,28 @@ static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; { n = VECTOR(t)->size; data = VECTOR(t)->data; if (Two_Byte (f)) { - Alloca (s2, XChar2b*, n * sizeof (XChar2b)); - for (i = 0; i < n; i++) { - register c = Get_2_Byte_Char (data[i]); - s2[i].byte1 = (c >> 8) & 0xff; - s2[i].byte2 = c & 0xff; - } - if (width) - i = XTextWidth16 (info, s2, n); - else - XTextExtents16 (info, s2, n, &dir, &fasc, &fdesc, &CI); + Alloca (s2, XChar2b*, n * sizeof (XChar2b)); + for (i = 0; i < n; i++) { + register c = Get_2_Byte_Char (data[i]); + s2[i].byte1 = (c >> 8) & 0xff; + s2[i].byte2 = c & 0xff; + } + if (width) + i = XTextWidth16 (info, s2, n); + else + XTextExtents16 (info, s2, n, &dir, &fasc, &fdesc, &CI); } else { - Alloca (s, char*, n); - for (i = 0; i < n; i++) - s[i] = Get_1_Byte_Char (data[i]); - if (width) - i = XTextWidth (info, s, n); - else - XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI); + Alloca (s, char*, n); + for (i = 0; i < n; i++) + s[i] = Get_1_Byte_Char (data[i]); + if (width) + i = XTextWidth (info, s, n); + else + XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI); } Alloca_End; return width ? Make_Integer (i) : Record_To_Vector (Char_Info_Rec, - Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L); + Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L); } static Object P_Text_Width (font, t, f) Object font, t, f; { @@ -94,20 +94,20 @@ static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; { n = VECTOR(t)->size; data = VECTOR(t)->data; if (Two_Byte (f)) { - Alloca (s2, XChar2b*, n * sizeof (XChar2b)); - for (i = 0; i < n; i++) { - register c = Get_2_Byte_Char (data[i]); - s2[i].byte1 = (c >> 8) & 0xff; - s2[i].byte2 = c & 0xff; - } - XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), - Get_Integer (y), s2, n); + Alloca (s2, XChar2b*, n * sizeof (XChar2b)); + for (i = 0; i < n; i++) { + register c = Get_2_Byte_Char (data[i]); + s2[i].byte1 = (c >> 8) & 0xff; + s2[i].byte2 = c & 0xff; + } + XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), s2, n); } else { - Alloca (s, char*, n); - for (i = 0; i < n; i++) - s[i] = Get_1_Byte_Char (data[i]); - XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), - Get_Integer (y), s, n); + Alloca (s, char*, n); + for (i = 0; i < n; i++) + s[i] = Get_1_Byte_Char (data[i]); + XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), s, n); } Alloca_End; return Void; @@ -128,44 +128,44 @@ static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; { func = twobyte ? (int(*)())XDrawText16 : (int(*)())XDrawText; Check_Type (t, T_Vector); if ((n = VECTOR(t)->size) == 0) - return Void; + return Void; for (data = VECTOR(t)->data, i = 0, nitems = 1; i < n; i++) - if (TYPE(data[i]) == T_Font) nitems++; + if (TYPE(data[i]) == T_Font) nitems++; Alloca (items, XTextItem*, nitems * sizeof (XTextItem)); items[0].delta = 0; items[0].font = None; for (j = k = i = 0; i <= n; i++) { - if (i == n || TYPE(data[i]) == T_Font) { - items[j].nchars = i-k; - if (twobyte) { - register XChar2b *p; + if (i == n || TYPE(data[i]) == T_Font) { + items[j].nchars = i-k; + if (twobyte) { + register XChar2b *p; - Alloca (p, XChar2b*, (i-k) * sizeof (XChar2b)); - ((XTextItem16 *)items)[j].chars = p; - for ( ; k < i; k++, p++) { - register c = Get_2_Byte_Char (data[k]); - p->byte1 = (c >> 8) & 0xff; - p->byte2 = c & 0xff; - } - } else { - register char *p; + Alloca (p, XChar2b*, (i-k) * sizeof (XChar2b)); + ((XTextItem16 *)items)[j].chars = p; + for ( ; k < i; k++, p++) { + register c = Get_2_Byte_Char (data[k]); + p->byte1 = (c >> 8) & 0xff; + p->byte2 = c & 0xff; + } + } else { + register char *p; - Alloca (p, char*, i-k); - items[j].chars = p; - for ( ; k < i; k++) - *p++ = Get_1_Byte_Char (data[k]); - } - k++; - j++; - if (i < n) { - items[j].delta = 0; - Open_Font_Maybe (data[i]); - items[j].font = FONT(data[i])->id; - } - } + Alloca (p, char*, i-k); + items[j].chars = p; + for ( ; k < i; k++) + *p++ = Get_1_Byte_Char (data[k]); + } + k++; + j++; + if (i < n) { + items[j].delta = 0; + Open_Font_Maybe (data[i]); + items[j].font = FONT(data[i])->id; + } + } } (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y), - items, nitems); + items, nitems); Alloca_End; return Void; } diff --git a/lib/xlib/type.c b/lib/xlib/type.c index 9b915cf..968c8c5 100644 --- a/lib/xlib/type.c +++ b/lib/xlib/type.c @@ -15,35 +15,35 @@ static Object Sym_Parent_Relative, Sym_Copy_From_Parent; XSetWindowAttributes SWA; RECORD Set_Attr_Rec[] = { { (char *)&SWA.background_pixmap, "background-pixmap", T_BACKGROUND, - 0, CWBackPixmap }, + 0, CWBackPixmap }, { (char *)&SWA.background_pixel, "background-pixel", T_PIXEL, - 0, CWBackPixel }, + 0, CWBackPixel }, { (char *)&SWA.border_pixmap, "border-pixmap", T_BORDER, - 0, CWBorderPixmap }, + 0, CWBorderPixmap }, { (char *)&SWA.border_pixel, "border-pixel", T_PIXEL, - 0, CWBorderPixel }, + 0, CWBorderPixel }, { (char *)&SWA.bit_gravity, "bit-gravity", T_SYM, - Bit_Grav_Syms, CWBitGravity }, + Bit_Grav_Syms, CWBitGravity }, { (char *)&SWA.win_gravity, "gravity", T_SYM, - Grav_Syms, CWWinGravity }, + Grav_Syms, CWWinGravity }, { (char *)&SWA.backing_store, "backing-store", T_SYM, - Backing_Store_Syms, CWBackingStore }, + Backing_Store_Syms, CWBackingStore }, { (char *)&SWA.backing_planes, "backing-planes", T_PIXEL, - 0, CWBackingPlanes }, + 0, CWBackingPlanes }, { (char *)&SWA.backing_pixel, "backing-pixel", T_PIXEL, - 0, CWBackingPixel }, + 0, CWBackingPixel }, { (char *)&SWA.save_under, "save-under", T_BOOL, - 0, CWSaveUnder }, + 0, CWSaveUnder }, { (char *)&SWA.event_mask, "event-mask", T_MASK, - Event_Syms, CWEventMask }, + Event_Syms, CWEventMask }, { (char *)&SWA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK, - Event_Syms, CWDontPropagate }, + Event_Syms, CWDontPropagate }, { (char *)&SWA.override_redirect, "override-redirect", T_BOOL, - 0, CWOverrideRedirect }, + 0, CWOverrideRedirect }, { (char *)&SWA.colormap, "colormap", T_COLORMAP, - 0, CWColormap }, + 0, CWColormap }, { (char *)&SWA.cursor, "cursor", T_CURSOR, - 0, CWCursor }, + 0, CWCursor }, { 0, 0, T_NONE, 0, 0 } }; int Set_Attr_Size = sizeof Set_Attr_Rec / sizeof (RECORD); @@ -57,7 +57,7 @@ RECORD Conf_Rec[] = { { (char *)&WC.border_width, "border-width", T_INT, 0, CWBorderWidth }, { (char *)&WC.sibling, "sibling", T_WINDOW, 0, CWSibling }, { (char *)&WC.stack_mode, "stack-mode", T_SYM, Stack_Mode_Syms, - CWStackMode }, + CWStackMode }, { 0, 0, T_NONE, 0, 0 } }; int Conf_Size = sizeof Conf_Rec / sizeof (RECORD); @@ -65,51 +65,51 @@ int Conf_Size = sizeof Conf_Rec / sizeof (RECORD); XGCValues GCV; RECORD GC_Rec[] = { { (char *)&GCV.function, "function", T_SYM, - Func_Syms, GCFunction }, + Func_Syms, GCFunction }, { (char *)&GCV.plane_mask, "plane-mask", T_PIXEL, - 0, GCPlaneMask }, + 0, GCPlaneMask }, { (char *)&GCV.foreground, "foreground", T_PIXEL, - 0, GCForeground }, + 0, GCForeground }, { (char *)&GCV.background, "background", T_PIXEL, - 0, GCBackground }, + 0, GCBackground }, { (char *)&GCV.line_width, "line-width", T_INT, - 0, GCLineWidth }, + 0, GCLineWidth }, { (char *)&GCV.line_style, "line-style", T_SYM, - Line_Style_Syms, GCLineStyle }, + Line_Style_Syms, GCLineStyle }, { (char *)&GCV.cap_style, "cap-style", T_SYM, - Cap_Style_Syms, GCCapStyle }, + Cap_Style_Syms, GCCapStyle }, { (char *)&GCV.join_style, "join-style", T_SYM, - Join_Style_Syms, GCJoinStyle }, + Join_Style_Syms, GCJoinStyle }, { (char *)&GCV.fill_style, "fill-style", T_SYM, - Fill_Style_Syms, GCFillStyle }, + Fill_Style_Syms, GCFillStyle }, { (char *)&GCV.fill_rule, "fill-rule", T_SYM, - Fill_Rule_Syms, GCFillRule }, + Fill_Rule_Syms, GCFillRule }, { (char *)&GCV.arc_mode, "arc-mode", T_SYM, - Arc_Mode_Syms, GCArcMode }, + Arc_Mode_Syms, GCArcMode }, { (char *)&GCV.tile, "tile", T_PIXMAP, - 0, GCTile }, + 0, GCTile }, { (char *)&GCV.stipple, "stipple", T_PIXMAP, - 0, GCStipple }, + 0, GCStipple }, { (char *)&GCV.ts_x_origin, "ts-x", T_INT, - 0, GCTileStipXOrigin }, + 0, GCTileStipXOrigin }, { (char *)&GCV.ts_y_origin, "ts-y", T_INT, - 0, GCTileStipYOrigin }, + 0, GCTileStipYOrigin }, { (char *)&GCV.font, "font", T_FONT, - 0, GCFont }, + 0, GCFont }, { (char *)&GCV.subwindow_mode, "subwindow-mode", T_SYM, - Subwin_Mode_Syms, GCSubwindowMode }, + Subwin_Mode_Syms, GCSubwindowMode }, { (char *)&GCV.graphics_exposures, "exposures", T_BOOL, - 0, GCGraphicsExposures }, + 0, GCGraphicsExposures }, { (char *)&GCV.clip_x_origin, "clip-x", T_INT, - 0, GCClipXOrigin }, + 0, GCClipXOrigin }, { (char *)&GCV.clip_y_origin, "clip-y", T_INT, - 0, GCClipYOrigin }, + 0, GCClipYOrigin }, { (char *)&GCV.clip_mask, "clip-mask", T_PIXMAP, - 0, GCClipMask }, + 0, GCClipMask }, { (char *)&GCV.dash_offset, "dash-offset", T_INT, - 0, GCDashOffset }, + 0, GCDashOffset }, { (char *)&GCV.dashes, "dashes", T_CHAR, - 0, GCDashList }, + 0, GCDashList }, {0, 0, T_NONE, 0, 0 } }; int GC_Size = sizeof GC_Rec / sizeof (RECORD); @@ -130,55 +130,55 @@ int Geometry_Size = sizeof Geometry_Rec / sizeof (RECORD); XWindowAttributes WA; RECORD Win_Attr_Rec[] = { { (char *)&WA.x, "x", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.y, "y", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.width, "width", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.height, "height", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.border_width, "border-width", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.depth, "depth", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&WA.visual, "visual", T_NONE, - 0, 0 }, + 0, 0 }, { (char *)&WA.root, "root", T_WINDOW, - 0, 0 }, + 0, 0 }, #if defined(__cplusplus) || defined(c_plusplus) { (char *)&WA.c_class, "class", T_SYM, #else { (char *)&WA.class, "class", T_SYM, #endif - Class_Syms, 0 }, + Class_Syms, 0 }, { (char *)&WA.bit_gravity, "bit-gravity", T_SYM, - Bit_Grav_Syms, 0 }, + Bit_Grav_Syms, 0 }, { (char *)&WA.win_gravity, "gravity", T_SYM, - Grav_Syms, 0 }, + Grav_Syms, 0 }, { (char *)&WA.backing_store, "backing-store", T_SYM, - Backing_Store_Syms, 0 }, + Backing_Store_Syms, 0 }, { (char *)&WA.backing_planes, "backing-planes", T_PIXEL, - 0, 0 }, + 0, 0 }, { (char *)&WA.backing_pixel, "backing-pixel", T_PIXEL, - 0, 0 }, + 0, 0 }, { (char *)&WA.save_under, "save-under", T_BOOL, - 0, 0 }, + 0, 0 }, { (char *)&WA.colormap , "colormap", T_COLORMAP, - 0, 0 }, + 0, 0 }, { (char *)&WA.map_installed, "map-installed", T_BOOL, - 0, 0 }, + 0, 0 }, { (char *)&WA.map_state, "map-state", T_SYM, - Map_State_Syms, 0 }, + Map_State_Syms, 0 }, { (char *)&WA.all_event_masks, "all-event-masks", T_MASK, - Event_Syms, 0 }, + Event_Syms, 0 }, { (char *)&WA.your_event_mask, "your-event-mask", T_MASK, - Event_Syms, 0 }, + Event_Syms, 0 }, { (char *)&WA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK, - Event_Syms, 0 }, + Event_Syms, 0 }, { (char *)&WA.override_redirect, "override-redirect", T_BOOL, - 0, 0 }, + 0, 0 }, { (char *)&WA.screen, "screen", T_NONE, - 0, 0 }, + 0, 0 }, {0, 0, T_NONE, 0, 0 } }; int Win_Attr_Size = sizeof Win_Attr_Rec / sizeof (RECORD); @@ -186,23 +186,23 @@ int Win_Attr_Size = sizeof Win_Attr_Rec / sizeof (RECORD); XFontStruct FI; RECORD Font_Info_Rec[] = { { (char *)&FI.direction, "direction", T_SYM, - Direction_Syms, 0 }, + Direction_Syms, 0 }, { (char *)&FI.min_char_or_byte2, "min-byte2", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.max_char_or_byte2, "max-byte2", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.min_byte1, "min-byte1", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.max_byte1, "max-byte1", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.all_chars_exist, "all-chars-exist?", T_BOOL, - 0, 0 }, + 0, 0 }, { (char *)&FI.default_char, "default-char", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.ascent, "ascent", T_INT, - 0, 0 }, + 0, 0 }, { (char *)&FI.descent, "descent", T_INT, - 0, 0 }, + 0, 0 }, {0, 0, T_NONE, 0, 0 } }; int Font_Info_Size = sizeof Font_Info_Rec / sizeof (RECORD); @@ -222,21 +222,21 @@ int Char_Info_Size = sizeof Char_Info_Rec / sizeof (RECORD); XWMHints WMH; RECORD Wm_Hints_Rec[] = { { (char *)&WMH.input, "input?", T_BOOL, - 0, InputHint }, + 0, InputHint }, { (char *)&WMH.initial_state, "initial-state", T_SYM, - Initial_State_Syms, StateHint }, + Initial_State_Syms, StateHint }, { (char *)&WMH.icon_pixmap, "icon-pixmap", T_PIXMAP, - 0, IconPixmapHint }, + 0, IconPixmapHint }, { (char *)&WMH.icon_window, "icon-window", T_WINDOW, - 0, IconWindowHint }, + 0, IconWindowHint }, { (char *)&WMH.icon_x, "icon-x", T_INT, - 0, IconPositionHint }, + 0, IconPositionHint }, { (char *)&WMH.icon_y, "icon-y", T_INT, - 0, IconPositionHint }, + 0, IconPositionHint }, { (char *)&WMH.icon_mask, "icon-mask", T_PIXMAP, - 0, IconMaskHint }, + 0, IconMaskHint }, { (char *)&WMH.window_group, "window-group", T_WINDOW, - 0, WindowGroupHint }, + 0, WindowGroupHint }, {0, 0, T_NONE, 0, 0 } }; int Wm_Hints_Size = sizeof Wm_Hints_Rec / sizeof (RECORD); @@ -264,79 +264,79 @@ RECORD Size_Hints_Rec[] = { { (char *)&SZH.base_width, "base-width", T_INT, 0, PBaseSize }, { (char *)&SZH.base_height, "base-height", T_INT, 0, PBaseSize }, { (char *)&SZH.win_gravity, "gravity", T_SYM, Grav_Syms, - PWinGravity }, + PWinGravity }, {0, 0, T_NONE, 0, 0 } }; int Size_Hints_Size = sizeof Size_Hints_Rec / sizeof (RECORD); unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym; - register RECORD *rp; { + register RECORD *rp; { register Object *p; unsigned long mask = 0; Check_Type (v, T_Vector); p = VECTOR(v)->data; if (VECTOR(v)->size != len && !EQ(p[0], sym)) - Primitive_Error ("invalid argument"); + Primitive_Error ("invalid argument"); for ( ; rp->slot; rp++) { - ++p; - if (rp->type == T_NONE || Nullp (*p)) - continue; - switch (rp->type) { - case T_INT: - *(int *)rp->slot = Get_Integer (*p); break; - case T_SHORT: - *(short *)rp->slot = Get_Integer (*p); break; - case T_CHAR: - *(char *)rp->slot = Get_Integer (*p); break; - case T_PIXEL: - *(unsigned long *)rp->slot = Get_Pixel (*p); break; - case T_BACKGROUND: - if (EQ(*p, Sym_None)) - *(Pixmap *)rp->slot = None; - else if (EQ(*p, Sym_Parent_Relative)) - *(Pixmap *)rp->slot = ParentRelative; - else - *(Pixmap *)rp->slot = Get_Pixmap (*p); - break; - case T_BORDER: - if (EQ(*p, Sym_Copy_From_Parent)) { - *(Pixmap *)rp->slot = CopyFromParent; - break; - } - /* fall through */ - case T_PIXMAP: - *(Pixmap *)rp->slot = Get_Pixmap (*p); break; - case T_BOOL: - Check_Type (*p, T_Boolean); - *(Bool *)rp->slot = (Bool)(FIXNUM(*p)); - break; - case T_FONT: - *(Font *)rp->slot = Get_Font (*p); - break; - case T_COLORMAP: - *(Colormap *)rp->slot = Get_Colormap (*p); break; - case T_CURSOR: - *(Cursor *)rp->slot = Get_Cursor (*p); - break; - case T_WINDOW: - break; - case T_MASK: - *(long *)rp->slot = Symbols_To_Bits (*p, 1, rp->syms); - break; - case T_SYM: - *(int *)rp->slot = (int)Symbols_To_Bits (*p, 0, rp->syms); - break; - default: - Panic ("vector->record"); - } - mask |= rp->mask; + ++p; + if (rp->type == T_NONE || Nullp (*p)) + continue; + switch (rp->type) { + case T_INT: + *(int *)rp->slot = Get_Integer (*p); break; + case T_SHORT: + *(short *)rp->slot = Get_Integer (*p); break; + case T_CHAR: + *(char *)rp->slot = Get_Integer (*p); break; + case T_PIXEL: + *(unsigned long *)rp->slot = Get_Pixel (*p); break; + case T_BACKGROUND: + if (EQ(*p, Sym_None)) + *(Pixmap *)rp->slot = None; + else if (EQ(*p, Sym_Parent_Relative)) + *(Pixmap *)rp->slot = ParentRelative; + else + *(Pixmap *)rp->slot = Get_Pixmap (*p); + break; + case T_BORDER: + if (EQ(*p, Sym_Copy_From_Parent)) { + *(Pixmap *)rp->slot = CopyFromParent; + break; + } + /* fall through */ + case T_PIXMAP: + *(Pixmap *)rp->slot = Get_Pixmap (*p); break; + case T_BOOL: + Check_Type (*p, T_Boolean); + *(Bool *)rp->slot = (Bool)(FIXNUM(*p)); + break; + case T_FONT: + *(Font *)rp->slot = Get_Font (*p); + break; + case T_COLORMAP: + *(Colormap *)rp->slot = Get_Colormap (*p); break; + case T_CURSOR: + *(Cursor *)rp->slot = Get_Cursor (*p); + break; + case T_WINDOW: + break; + case T_MASK: + *(long *)rp->slot = Symbols_To_Bits (*p, 1, rp->syms); + break; + case T_SYM: + *(int *)rp->slot = (int)Symbols_To_Bits (*p, 0, rp->syms); + break; + default: + Panic ("vector->record"); + } + mask |= rp->mask; } return mask; } Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym; - register RECORD *rp; Display *dpy; unsigned long flags; { + register RECORD *rp; Display *dpy; unsigned long flags; { register i; Object v, x; GC_Node2; @@ -346,53 +346,53 @@ Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym; v = Make_Vector (len, Null); VECTOR(v)->data[0] = sym; for (i = 1; rp->slot; i++, rp++) { - if (rp->type == T_NONE) - continue; - if (rp->mask && !(flags & rp->mask)) - continue; - x = Null; - switch (rp->type) { - case T_INT: - x = Make_Integer (*(int *)rp->slot); break; - case T_SHORT: - x = Make_Integer (*(short *)rp->slot); break; - case T_CHAR: - x = Make_Integer (*(char *)rp->slot); break; - case T_PIXEL: - x = Make_Pixel (*(unsigned long *)rp->slot); break; - case T_PIXMAP: - if (*(unsigned long *)rp->slot == ~0L) - x = Sym_None; - else - x = Make_Pixmap_Foreign (dpy, *(Pixmap *)rp->slot); - break; - case T_FONT: - if (*(unsigned long *)rp->slot == ~0L) - x = Sym_None; - else { - register XFontStruct *info; - Disable_Interrupts; - info = XQueryFont (dpy, *(Font *)rp->slot); - Enable_Interrupts; - x = Make_Font_Foreign (dpy, False, *(Font *)rp->slot, info); - } - break; - case T_BOOL: - x = *(Bool *)rp->slot ? True : False; break; - case T_COLORMAP: - x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break; - case T_WINDOW: - x = Make_Window (0, dpy, *(Window *)rp->slot); break; - case T_MASK: - x = Bits_To_Symbols (*(long *)rp->slot, 1, rp->syms); - break; - case T_SYM: - x = Bits_To_Symbols ((unsigned long)*(int *)rp->slot, 0, rp->syms); - break; - default: - Panic ("record->vector"); - } - VECTOR(v)->data[i] = x; + if (rp->type == T_NONE) + continue; + if (rp->mask && !(flags & rp->mask)) + continue; + x = Null; + switch (rp->type) { + case T_INT: + x = Make_Integer (*(int *)rp->slot); break; + case T_SHORT: + x = Make_Integer (*(short *)rp->slot); break; + case T_CHAR: + x = Make_Integer (*(char *)rp->slot); break; + case T_PIXEL: + x = Make_Pixel (*(unsigned long *)rp->slot); break; + case T_PIXMAP: + if (*(unsigned long *)rp->slot == ~0L) + x = Sym_None; + else + x = Make_Pixmap_Foreign (dpy, *(Pixmap *)rp->slot); + break; + case T_FONT: + if (*(unsigned long *)rp->slot == ~0L) + x = Sym_None; + else { + register XFontStruct *info; + Disable_Interrupts; + info = XQueryFont (dpy, *(Font *)rp->slot); + Enable_Interrupts; + x = Make_Font_Foreign (dpy, False, *(Font *)rp->slot, info); + } + break; + case T_BOOL: + x = *(Bool *)rp->slot ? True : False; break; + case T_COLORMAP: + x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break; + case T_WINDOW: + x = Make_Window (0, dpy, *(Window *)rp->slot); break; + case T_MASK: + x = Bits_To_Symbols (*(long *)rp->slot, 1, rp->syms); + break; + case T_SYM: + x = Bits_To_Symbols ((unsigned long)*(int *)rp->slot, 0, rp->syms); + break; + default: + Panic ("record->vector"); + } + VECTOR(v)->data[i] = x; } GC_Unlink; return v; @@ -764,7 +764,7 @@ SYMDESCR Error_Syms[] = { }; static Init_Record (rec, size, name, var) RECORD *rec; char *name; - Object *var; { + Object *var; { Object list, tail, cell; register i; char buf[128]; @@ -772,13 +772,13 @@ static Init_Record (rec, size, name, var) RECORD *rec; char *name; GC_Link2 (list, tail); for (list = tail = Null, i = 1; i < size; tail = cell, i++, rec++) { - cell = Intern (rec->name); - cell = Cons (cell, Make_Integer (i)); - cell = Cons (cell, Null); - if (Nullp (list)) - list = cell; - else - P_Set_Cdr (tail, cell); + cell = Intern (rec->name); + cell = Cons (cell, Make_Integer (i)); + cell = Cons (cell, Null); + if (Nullp (list)) + list = cell; + else + P_Set_Cdr (tail, cell); } sprintf (buf, "%s-slots", name); Define_Variable (var, buf, list); @@ -787,17 +787,17 @@ static Init_Record (rec, size, name, var) RECORD *rec; char *name; elk_init_xlib_type () { Init_Record (Set_Attr_Rec, Set_Attr_Size, "set-window-attributes", - &Set_Attr_Slots); + &Set_Attr_Slots); Init_Record (Conf_Rec, Conf_Size, "window-configuration", &Conf_Slots); Init_Record (GC_Rec, GC_Size, "gcontext", &GC_Slots); Init_Record (Geometry_Rec, Geometry_Size, "geometry", &Geometry_Slots); Init_Record (Win_Attr_Rec, Win_Attr_Size, "get-window-attributes", - &Win_Attr_Slots); + &Win_Attr_Slots); Init_Record (Font_Info_Rec, Font_Info_Size, "font-info", &Font_Info_Slots); Init_Record (Char_Info_Rec, Char_Info_Size, "char-info", &Char_Info_Slots); Init_Record (Wm_Hints_Rec, Wm_Hints_Size, "wm-hints", &Wm_Hints_Slots); Init_Record (Size_Hints_Rec, Size_Hints_Size, "size-hints", - &Size_Hints_Slots); + &Size_Hints_Slots); Define_Symbol (&Sym_Parent_Relative, "parent-relative"); Define_Symbol (&Sym_Copy_From_Parent, "copy-from-parent"); } diff --git a/lib/xlib/util.c b/lib/xlib/util.c index 4107cad..cc81d02 100644 --- a/lib/xlib/util.c +++ b/lib/xlib/util.c @@ -5,8 +5,8 @@ static Object P_Get_Default (d, program, option) Object d, program, option; { Check_Type (d, T_Display); if (ret = XGetDefault (DISPLAY(d)->dpy, Get_Strsym (program), - Get_Strsym (option))) - return Make_String (ret, strlen (ret)); + Get_Strsym (option))) + return Make_String (ret, strlen (ret)); return False; } @@ -40,15 +40,15 @@ static Object P_Parse_Color (d, cmap, spec) Object d, cmap, spec; { Check_Type (d, T_Display); if (XParseColor (DISPLAY(d)->dpy, Get_Colormap (cmap), Get_Strsym (spec), - &ret)) - return Make_Color (ret.red, ret.green, ret.blue); + &ret)) + return Make_Color (ret.red, ret.green, ret.blue); return False; } elk_init_xlib_util () { Define_Primitive (P_Get_Default, "get-default", 3, 3, EVAL); Define_Primitive (P_Resource_Manager_String, - "resource-manager-string", 1, 1, EVAL); + "resource-manager-string", 1, 1, EVAL); Define_Primitive (P_Parse_Geometry, "parse-geometry", 1, 1, EVAL); Define_Primitive (P_Parse_Color, "parse-color", 3, 3, EVAL); } diff --git a/lib/xlib/window.c b/lib/xlib/window.c index 8c6d4be..4411208 100644 --- a/lib/xlib/window.c +++ b/lib/xlib/window.c @@ -15,54 +15,54 @@ Object Make_Window (finalize, dpy, win) Display *dpy; Window win; { Object w; if (win == None) - return Sym_None; + return Sym_None; if (win == PointerRoot) - return Intern ("pointer-root"); + return Intern ("pointer-root"); w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win); if (Nullp (w)) { - w = Alloc_Object (sizeof (struct S_Window), T_Window, 0); - WINDOW(w)->tag = Null; - WINDOW(w)->win = win; - WINDOW(w)->dpy = dpy; - WINDOW(w)->free = 0; - WINDOW(w)->finalize = finalize; - Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window : - (PFO)0, 0); + w = Alloc_Object (sizeof (struct S_Window), T_Window, 0); + WINDOW(w)->tag = Null; + WINDOW(w)->win = win; + WINDOW(w)->dpy = dpy; + WINDOW(w)->free = 0; + WINDOW(w)->finalize = finalize; + Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window : + (PFO)0, 0); } return w; } Window Get_Window (w) Object w; { if (EQ(w, Sym_None)) - return None; + return None; Check_Type (w, T_Window); return WINDOW(w)->win; } Drawable Get_Drawable (d, dpyp) Object d; Display **dpyp; { if (TYPE(d) == T_Window) { - *dpyp = WINDOW(d)->dpy; - return (Drawable)WINDOW(d)->win; + *dpyp = WINDOW(d)->dpy; + return (Drawable)WINDOW(d)->win; } else if (TYPE(d) == T_Pixmap) { - *dpyp = PIXMAP(d)->dpy; - return (Drawable)PIXMAP(d)->pm; + *dpyp = PIXMAP(d)->dpy; + return (Drawable)PIXMAP(d)->pm; } Wrong_Type_Combination (d, "drawable"); /*NOTREACHED*/ } static Object P_Create_Window (parent, x, y, width, height, border_width, attr) - Object parent, x, y, width, height, border_width, attr; { + Object parent, x, y, width, height, border_width, attr; { unsigned long mask; Window win; Check_Type (parent, T_Window); mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec); if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win, - Get_Integer (x), Get_Integer (y), Get_Integer (width), - Get_Integer (height), Get_Integer (border_width), - CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0) - Primitive_Error ("cannot create window"); + Get_Integer (x), Get_Integer (y), Get_Integer (width), + Get_Integer (height), Get_Integer (border_width), + CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0) + Primitive_Error ("cannot create window"); return Make_Window (1, WINDOW(parent)->dpy, win); } @@ -88,7 +88,7 @@ static Object P_Get_Window_Attributes (w) Object w; { Check_Type (w, T_Window); XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA); return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr, - WINDOW(w)->dpy, ~0L); + WINDOW(w)->dpy, ~0L); } static Object P_Get_Geometry (d) Object d; { @@ -98,8 +98,8 @@ static Object P_Get_Geometry (d) Object d; { /* GEO.width, GEO.height, etc. should really be unsigned, not int. */ XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width, - (unsigned *)&GEO.height, (unsigned *)&GEO.border_width, - (unsigned *)&GEO.depth); + (unsigned *)&GEO.height, (unsigned *)&GEO.border_width, + (unsigned *)&GEO.depth); return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L); } @@ -118,7 +118,7 @@ static Object P_Unmap_Window (w) Object w; { Object P_Destroy_Window (w) Object w; { Check_Type (w, T_Window); if (!WINDOW(w)->free) - XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win); + XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win); Deregister_Object (w); WINDOW(w)->free = 1; return Void; @@ -145,7 +145,7 @@ static Object P_Unmap_Subwindows (w) Object w; { static Object P_Circulate_Subwindows (w, dir) Object w, dir; { Check_Type (w, T_Window); XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win, - Symbols_To_Bits (dir, 0, Circulate_Syms)); + Symbols_To_Bits (dir, 0, Circulate_Syms)); return Void; } @@ -170,10 +170,10 @@ static Object P_Query_Tree (w) Object w; { ret = Cons (v, ret); v = Make_Vector (n, Null); for (i = 0; i < n; i++) { - Object x; + Object x; - x = Make_Window (0, dpy, children[i]); - VECTOR(v)->data[i] = x; + x = Make_Window (0, dpy, children[i]); + VECTOR(v)->data[i] = x; } ret = Cons (v, ret); GC_Unlink; @@ -189,9 +189,9 @@ static Object P_Translate_Coordinates (src, x, y, dst) Object src, x, y, dst; { Check_Type (src, T_Window); Check_Type (dst, T_Window); if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win, - WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry, - &child)) - return False; + WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry, + &child)) + return False; l = t = P_Make_List (Make_Integer (3), Null); GC_Link3 (l, t, dst); Car (t) = Make_Integer (rx); t = Cdr (t); @@ -212,7 +212,7 @@ static Object P_Query_Pointer (win) Object win; { Check_Type (win, T_Window); ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child, - &r_x, &r_y, &x, &y, &mask); + &r_x, &r_y, &x, &y, &mask); t = l = P_Make_List (Make_Integer (8), Null); GC_Link3 (l, t, win); Car (t) = Make_Integer (x); t = Cdr (t); @@ -238,25 +238,25 @@ elk_init_xlib_window () { Generic_Define (Window, "window", "window?"); Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL); Define_Primitive (P_Create_Window, - "xlib-create-window", 7, 7, EVAL); + "xlib-create-window", 7, 7, EVAL); Define_Primitive (P_Configure_Window, - "xlib-configure-window", 2, 2, EVAL); + "xlib-configure-window", 2, 2, EVAL); Define_Primitive (P_Change_Window_Attributes, - "xlib-change-window-attributes", 2, 2, EVAL); + "xlib-change-window-attributes", 2, 2, EVAL); Define_Primitive (P_Get_Window_Attributes, - "xlib-get-window-attributes", 1, 1, EVAL); + "xlib-get-window-attributes", 1, 1, EVAL); Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL); Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL); Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL); Define_Primitive (P_Circulate_Subwindows, - "circulate-subwindows", 2, 2, EVAL); + "circulate-subwindows", 2, 2, EVAL); Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL); Define_Primitive (P_Destroy_Subwindows, - "destroy-subwindows", 1, 1, EVAL); + "destroy-subwindows", 1, 1, EVAL); Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL); Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL); Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL); Define_Primitive (P_Translate_Coordinates, - "translate-coordinates", 4, 4, EVAL); + "translate-coordinates", 4, 4, EVAL); Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL); } diff --git a/lib/xlib/wm.c b/lib/xlib/wm.c index 26dff03..ac63b13 100644 --- a/lib/xlib/wm.c +++ b/lib/xlib/wm.c @@ -6,7 +6,7 @@ static Object P_Reparent_Window (w, parent, x, y) Object w, parent, x, y; { Check_Type (w, T_Window); Check_Type (parent, T_Window); XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win, - Get_Integer (x), Get_Integer (y)); + Get_Integer (x), Get_Integer (y)); return Void; } @@ -33,10 +33,10 @@ static Object P_List_Installed_Colormaps (w) Object w; { v = Make_Vector (n, Null); GC_Link (v); for (i = 0; i < n; i++) { - Object c; + Object c; - c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]); - VECTOR(v)->data[i] = c; + c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]); + VECTOR(v)->data[i] = c; } XFree ((char *)ret); GC_Unlink; @@ -49,9 +49,9 @@ static Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win, Check_Type (d, T_Display); if (!EQ(win, Sym_Pointer_Root)) - focus = Get_Window (win); + focus = Get_Window (win); XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0, - Revert_Syms), Get_Time (time)); + Revert_Syms), Get_Time (time)); return Void; } @@ -74,11 +74,11 @@ static Object P_Input_Focus (d) Object d; { } static Object P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy, - srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; { + srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; { Check_Type (dpy, T_Display); XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst), - Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw), - Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty)); + Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw), + Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty)); return Void; } @@ -87,9 +87,9 @@ static Object P_Bell (argc, argv) Object *argv; { Check_Type (argv[0], T_Display); if (argc == 2) { - percent = Get_Integer (argv[1]); - if (percent < -100 || percent > 100) - Range_Error (argv[1]); + percent = Get_Integer (argv[1]); + if (percent < -100 || percent > 100) + Range_Error (argv[1]); } XBell (DISPLAY(argv[0])->dpy, percent); return Void; @@ -105,14 +105,14 @@ static Object P_Set_Access_Control (dpy, on) Object dpy, on; { static Object P_Change_Save_Set (win, mode) Object win, mode; { Check_Type (win, T_Window); XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win, - Symbols_To_Bits (mode, 0, Saveset_Syms)); + Symbols_To_Bits (mode, 0, Saveset_Syms)); return Void; } static Object P_Set_Close_Down_Mode (dpy, mode) Object dpy, mode; { Check_Type (dpy, T_Display); XSetCloseDownMode (DISPLAY(dpy)->dpy, - Symbols_To_Bits (mode, 0, Closemode_Syms)); + Symbols_To_Bits (mode, 0, Closemode_Syms)); return Void; } @@ -125,7 +125,7 @@ static Object P_Get_Pointer_Mapping (dpy) Object dpy; { n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256); ret = Make_Vector (n, Null); for (i = 0; i < n; i++) - VECTOR(ret)->data[i] = Make_Integer (map[i]); + VECTOR(ret)->data[i] = Make_Integer (map[i]); return ret; } @@ -140,9 +140,9 @@ static Object P_Set_Pointer_Mapping (dpy, map) Object dpy, map; { n = VECTOR(map)->size; Alloca (p, unsigned char*, n); for (i = 0; i < n; i++) - p[i] = Get_Integer (VECTOR(map)->data[i]); + p[i] = Get_Integer (VECTOR(map)->data[i]); ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ? - True : False; + True : False; Alloca_End; return ret; } @@ -151,22 +151,22 @@ elk_init_xlib_wm () { Define_Primitive (P_Reparent_Window, "reparent-window", 4, 4, EVAL); Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL); Define_Primitive (P_Uninstall_Colormap, - "uninstall-colormap", 1, 1, EVAL); + "uninstall-colormap", 1, 1, EVAL); Define_Primitive (P_List_Installed_Colormaps, - "list-installed-colormaps", 1, 1, EVAL); + "list-installed-colormaps", 1, 1, EVAL); Define_Primitive (P_Set_Input_Focus, "set-input-focus", 4, 4, EVAL); Define_Primitive (P_Input_Focus, "input-focus", 1, 1, EVAL); Define_Primitive (P_General_Warp_Pointer, - "general-warp-pointer", 9, 9, EVAL); + "general-warp-pointer", 9, 9, EVAL); Define_Primitive (P_Bell, "bell", 1, 2, VARARGS); Define_Primitive (P_Set_Access_Control, - "set-access-control", 2, 2, EVAL); + "set-access-control", 2, 2, EVAL); Define_Primitive (P_Change_Save_Set, "change-save-set", 2, 2, EVAL); Define_Primitive (P_Set_Close_Down_Mode, - "set-close-down-mode", 2, 2, EVAL); + "set-close-down-mode", 2, 2, EVAL); Define_Primitive (P_Get_Pointer_Mapping, - "get-pointer-mapping", 1, 1, EVAL); + "get-pointer-mapping", 1, 1, EVAL); Define_Primitive (P_Set_Pointer_Mapping, - "set-pointer-mapping", 2, 2, EVAL); + "set-pointer-mapping", 2, 2, EVAL); Define_Symbol(&Sym_Pointer_Root, "pointer-root"); } diff --git a/lib/xlib/xerror.c b/lib/xlib/xerror.c index c445a31..ae2515a 100644 --- a/lib/xlib/xerror.c +++ b/lib/xlib/xerror.c @@ -17,7 +17,7 @@ static X_Fatal_Error (d) Display *d; { GC_Unlink; fun = Var_Get (V_X_Fatal_Error_Handler); if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); + (void)Funcall (fun, args, 0); _XDefaultIOError (d); exit (1); /* In case the default handler doesn't exit() */ /*NOTREACHED*/ @@ -37,7 +37,7 @@ static X_Error (d, ep) Display *d; XErrorEvent *ep; { args = Cons (a, args); a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms); if (Nullp (a)) - a = Make_Unsigned (ep->error_code); + a = Make_Unsigned (ep->error_code); args = Cons (a, args); a = Make_Unsigned_Long (ep->serial); args = Cons (a, args); @@ -46,9 +46,9 @@ static X_Error (d, ep) Display *d; XErrorEvent *ep; { GC_Unlink; fun = Var_Get (V_X_Error_Handler); if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); + (void)Funcall (fun, args, 0); else - _XDefaultError (d, ep); + _XDefaultError (d, ep); } static X_After_Function (d) Display *d; { @@ -67,10 +67,10 @@ static Object P_Set_After_Function (d, f) Object d, f; { Check_Type (d, T_Display); if (EQ(f, False)) { - (void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0); + (void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0); } else { - Check_Procedure (f); - (void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function); + Check_Procedure (f); + (void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function); } old = DISPLAY(d)->after; DISPLAY(d)->after = f; diff --git a/lib/xlib/xinit.c b/lib/xlib/xinit.c index bfe5896..c604b8b 100644 --- a/lib/xlib/xinit.c +++ b/lib/xlib/xinit.c @@ -22,11 +22,11 @@ static Object P_Xlib_Release_6_Or_Laterp () { elk_init_xlib_init () { Define_Primitive (P_Xlib_Release_4_Or_Laterp, - "xlib-release-4-or-later?", 0, 0, EVAL); + "xlib-release-4-or-later?", 0, 0, EVAL); Define_Primitive (P_Xlib_Release_5_Or_Laterp, - "xlib-release-5-or-later?", 0, 0, EVAL); + "xlib-release-5-or-later?", 0, 0, EVAL); Define_Primitive (P_Xlib_Release_6_Or_Laterp, - "xlib-release-6-or-later?", 0, 0, EVAL); + "xlib-release-6-or-later?", 0, 0, EVAL); P_Provide (Intern ("xlib.so")); P_Provide (Intern ("xlib.o")); } diff --git a/lib/xlib/xlib.h b/lib/xlib/xlib.h index 2ed67e7..a46ee56 100644 --- a/lib/xlib/xlib.h +++ b/lib/xlib/xlib.h @@ -230,25 +230,25 @@ static Object conc3(P_,type,p) (x) Object x; {\ * } */ #define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\ - Object x, y; {\ + Object x, y; {\ return cast(x)->field == cast(y)->field\ - && !cast(x)->free && !cast(y)->free;\ + && !cast(x)->free && !cast(y)->free;\ } /* Same as above, but doesn't check for ->free: */ #define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\ - Object x, y; {\ + Object x, y; {\ return cast(x)->field == cast(y)->field;\ } /* Same as above, but also checks ->dpy */ #define Generic_Equal_Dpy(type,cast,field) static conc(type,_Equal)\ - (x, y)\ - Object x, y; {\ + (x, y)\ + Object x, y; {\ return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\ - && !cast(x)->free && !cast(y)->free;\ + && !cast(x)->free && !cast(y)->free;\ } /* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates: @@ -258,7 +258,7 @@ static Object conc3(P_,type,p) (x) Object x; {\ * } */ #define Generic_Print(type,fmt,how) static conc(type,_Print)\ - (x, port, raw, depth, len) Object x, port; {\ + (x, port, raw, depth, len) Object x, port; {\ Printf (port, fmt, (unsigned)how);\ } @@ -270,7 +270,7 @@ static Object conc3(P_,type,p) (x) Object x; {\ */ #define Generic_Define(type,name,pred) conc(T_,type) =\ Define_Type (0, name, NOFUNC, sizeof (struct conc(S_,type)),\ - conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\ + conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\ Define_Primitive (conc3(P_,type,p), pred, 1, 1, EVAL); /* Generic_Get_Display (Pixmap, PIXMAP) generates: @@ -281,7 +281,7 @@ static Object conc3(P_,type,p) (x) Object x; {\ * } */ #define Generic_Get_Display(type,cast) static Object conc3(P_,type,_Display)\ - (x) Object x; {\ + (x) Object x; {\ Check_Type (x, conc(T_,type));\ return Make_Display (0, cast(x)->dpy);\ } diff --git a/lib/xlib/xobjects.c b/lib/xlib/xobjects.c index 87f53df..163f170 100644 --- a/lib/xlib/xobjects.c +++ b/lib/xlib/xobjects.c @@ -8,27 +8,27 @@ int Match_X_Obj (x, v) Object x; va_list v; { register type = TYPE(x); if (type == T_Display) { - return 1; + return 1; } else if (type == T_Gc) { - return va_arg (v, GC) == GCONTEXT(x)->gc; + return va_arg (v, GC) == GCONTEXT(x)->gc; } else if (type == T_Pixel) { - return va_arg (v, unsigned long) == PIXEL(x)->pix; + return va_arg (v, unsigned long) == PIXEL(x)->pix; } else if (type == T_Pixmap) { - return va_arg (v, Pixmap) == PIXMAP(x)->pm; + return va_arg (v, Pixmap) == PIXMAP(x)->pm; } else if (type == T_Window) { - return va_arg (v, Window) == WINDOW(x)->win; + return va_arg (v, Window) == WINDOW(x)->win; } else if (type == T_Font) { - return va_arg (v, Font) == FONT(x)->id; + return va_arg (v, Font) == FONT(x)->id; } else if (type == T_Colormap) { - return va_arg (v, Colormap) == COLORMAP(x)->cm; + return va_arg (v, Colormap) == COLORMAP(x)->cm; } else if (type == T_Color) { - return va_arg (v, unsigned int) == COLOR(x)->c.red - && va_arg (v, unsigned int) == COLOR(x)->c.green - && va_arg (v, unsigned int) == COLOR(x)->c.blue; + return va_arg (v, unsigned int) == COLOR(x)->c.red + && va_arg (v, unsigned int) == COLOR(x)->c.green + && va_arg (v, unsigned int) == COLOR(x)->c.blue; } else if (type == T_Cursor) { - return va_arg (v, Cursor) == CURSOR(x)->cursor; + return va_arg (v, Cursor) == CURSOR(x)->cursor; } else if (type == T_Atom) { - return va_arg (v, Atom) == ATOM(x)->atom; + return va_arg (v, Atom) == ATOM(x)->atom; } else Panic ("Match_X_Obj"); return 0; } diff --git a/lib/xt/accelerator.c b/lib/xt/accelerator.c index 750750c..ecbbc52 100644 --- a/lib/xt/accelerator.c +++ b/lib/xt/accelerator.c @@ -7,7 +7,7 @@ XtAccelerators Get_Accelerators (a) Object a; { Get_Strsym_Stack (a, s); if ((ret = XtParseAcceleratorTable (s)) == 0) - Primitive_Error ("bad accelerator table: ~s", a); + Primitive_Error ("bad accelerator table: ~s", a); Alloca_End; return ret; } @@ -29,7 +29,7 @@ static Object P_Install_All_Accelerators (dst, src) Object dst, src; { elk_init_xt_accelerator () { Define_Primitive (P_Install_Accelerators, - "install-accelerators", 2, 2, EVAL); + "install-accelerators", 2, 2, EVAL); Define_Primitive (P_Install_All_Accelerators, - "install-all-accelerators", 2, 2, EVAL); + "install-all-accelerators", 2, 2, EVAL); } diff --git a/lib/xt/action.c b/lib/xt/action.c index fe059c7..749a4a3 100644 --- a/lib/xt/action.c +++ b/lib/xt/action.c @@ -11,36 +11,36 @@ ACTION *actions; /*ARGSUSED*/ static void Dummy_Action (w, ep, argv, argc) Widget w; XEvent *ep; - String *argv; int *argc; { + String *argv; int *argc; { } void Action_Hook (w, client_data, name, ep, argv, argc) - Widget w; XtPointer client_data; char *name; XEvent *ep; - char **argv; int *argc; { + Widget w; XtPointer client_data; char *name; XEvent *ep; + char **argv; int *argc; { ACTION *ap; Object args, params, tail; register i; GC_Node3; for (ap = actions; ap; ap = ap->next) { - if (strcmp (ap->name, name)) - continue; - args = params = tail = Null; - GC_Link3 (args, params, tail); - params = P_Make_List (Make_Integer (*argc), Null); - for (i = 0, tail = params; i < *argc; tail = Cdr (tail), i++) { - Object tmp; + if (strcmp (ap->name, name)) + continue; + args = params = tail = Null; + GC_Link3 (args, params, tail); + params = P_Make_List (Make_Integer (*argc), Null); + for (i = 0, tail = params; i < *argc; tail = Cdr (tail), i++) { + Object tmp; - tmp = Make_String (argv[i], strlen (argv[i])); - Car (tail) = tmp; - } - args = Cons (params, Null); - params = Get_Event_Args (ep); - args = Cons (Copy_List (params), args); - Destroy_Event_Args (params); - args = Cons (Make_Widget_Foreign (w), args); - (void)Funcall (Get_Function (ap->num), args, 0); - GC_Unlink; + tmp = Make_String (argv[i], strlen (argv[i])); + Car (tail) = tmp; + } + args = Cons (params, Null); + params = Get_Event_Args (ep); + args = Cons (Copy_List (params), args); + Destroy_Event_Args (params); + args = Cons (Make_Widget_Foreign (w), args); + (void)Funcall (Get_Function (ap->num), args, 0); + GC_Unlink; } } @@ -66,12 +66,12 @@ void Free_Actions (con) XtAppContext con; { register ACTION *p, **pp; for (pp = &actions; p = *pp; ) { - if (p->con == con) { - Deregister_Function (p->num); - XtFree (p->name); - *pp = p->next; - XtFree ((char *)p); - } else pp = &p->next; + if (p->con == con) { + Deregister_Function (p->num); + XtFree (p->name); + *pp = p->next; + XtFree ((char *)p); + } else pp = &p->next; } } diff --git a/lib/xt/callback.c b/lib/xt/callback.c index 23d247d..fb66115 100644 --- a/lib/xt/callback.c +++ b/lib/xt/callback.c @@ -11,7 +11,7 @@ Object Get_Callbackfun (c) XtPointer c; { } static void Callback_Proc (w, client_data, call_data) Widget w; - XtPointer client_data, call_data; { + XtPointer client_data, call_data; { register CLIENT_DATA *cd = (CLIENT_DATA *)client_data; Object args; GC_Node; @@ -19,7 +19,7 @@ static void Callback_Proc (w, client_data, call_data) Widget w; args = Null; GC_Link (args); if (cd->converter) - args = Cons ((cd->converter)((XtArgVal)call_data), args); + args = Cons ((cd->converter)((XtArgVal)call_data), args); args = Cons (Make_Widget_Foreign (w), args); GC_Unlink; (void)Funcall (Get_Callbackfun (client_data), args, 0); @@ -27,12 +27,12 @@ static void Callback_Proc (w, client_data, call_data) Widget w; /*ARGSUSED*/ void Destroy_Callback_Proc (w, client_data, call_data) Widget w; - XtPointer client_data, call_data; { + XtPointer client_data, call_data; { Object x; x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); if (Nullp (x) || WIDGET(x)->free) - return; + return; WIDGET(x)->free = 1; Remove_All_Callbacks (w); Deregister_Object (x); @@ -49,7 +49,7 @@ void Destroy_Callback_Proc (w, client_data, call_data) Widget w; */ void Fiddle_Destroy_Callback (w) Widget w; { XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, - (XtPointer)0); + (XtPointer)0); XtAddCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (XtPointer)0); } @@ -58,7 +58,7 @@ void Check_Callback_List (x) Object x; { Check_List (x); for (tail = x; !Nullp (tail); tail = Cdr (tail)) - Check_Procedure (Car (tail)); + Check_Procedure (Car (tail)); } static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; { @@ -76,27 +76,27 @@ static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; { callbacks[n].callback = 0; callbacks[n].closure = 0; Fill_Callbacks (cbl, callbacks, n, - Find_Callback_Converter (XtClass (WIDGET(w)->widget), s, name)); + Find_Callback_Converter (XtClass (WIDGET(w)->widget), s, name)); XtAddCallbacks (WIDGET(w)->widget, s, callbacks); if (streq (s, XtNdestroyCallback)) - Fiddle_Destroy_Callback (WIDGET(w)->widget); + Fiddle_Destroy_Callback (WIDGET(w)->widget); Alloca_End; return Void; } void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst; - register n; PFX2S conv; { + register n; PFX2S conv; { register CLIENT_DATA *cd; register i, j; Object tail; for (i = 0, tail = src; i < n; i++, tail = Cdr (tail)) { - j = Register_Function (Car (tail)); - cd = (CLIENT_DATA *)XtMalloc (sizeof (CLIENT_DATA)); - cd->converter = conv; - cd->num = j; - dst[i].callback = (XtCallbackProc)Callback_Proc; - dst[i].closure = (XtPointer)cd; + j = Register_Function (Car (tail)); + cd = (CLIENT_DATA *)XtMalloc (sizeof (CLIENT_DATA)); + cd->converter = conv; + cd->num = j; + dst[i].callback = (XtCallbackProc)Callback_Proc; + dst[i].closure = (XtPointer)cd; } } @@ -109,17 +109,17 @@ Remove_All_Callbacks (w) Widget w; { Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc); for (j = 0; j < nr; j++) { - if (streq (r[j].resource_type, XtRCallback)) { - XtSetArg (a[0], r[j].resource_name, &c); - XtGetValues (w, a, 1); - for (i = 0; c[i].callback; i++) { - register CLIENT_DATA *cd = (CLIENT_DATA *)c[i].closure; - if (c[i].callback == (XtCallbackProc)Callback_Proc && cd) { - Deregister_Function (cd->num); - XtFree ((char *)cd); - } - } - } + if (streq (r[j].resource_type, XtRCallback)) { + XtSetArg (a[0], r[j].resource_name, &c); + XtGetValues (w, a, 1); + for (i = 0; c[i].callback; i++) { + register CLIENT_DATA *cd = (CLIENT_DATA *)c[i].closure; + if (c[i].callback == (XtCallbackProc)Callback_Proc && cd) { + Deregister_Function (cd->num); + XtFree ((char *)cd); + } + } + } } XtFree ((char *)r); } diff --git a/lib/xt/class.c b/lib/xt/class.c index a7dd4aa..3a7da20 100644 --- a/lib/xt/class.c +++ b/lib/xt/class.c @@ -1,6 +1,6 @@ #include "xt.h" -#define MAX_CLASS 128 +#define MAX_CLASS 128 #define MAX_CALLBACK_PER_CLASS 10 typedef struct { @@ -29,13 +29,13 @@ Object Make_Class (class, name) WidgetClass class; char *name; { c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class); if (Nullp (c)) { - c = Alloc_Object (sizeof (struct S_Class), T_Class, 0); - CLASS(c)->tag = Null; - CLASS(c)->wclass = class; - CLASS(c)->name = name; - Register_Object (c, (GENERIC)0, (PFO)0, 0); - /* See comment in Define_Class below */ - XtInitializeWidgetClass (class); + c = Alloc_Object (sizeof (struct S_Class), T_Class, 0); + CLASS(c)->tag = Null; + CLASS(c)->wclass = class; + CLASS(c)->name = name; + Register_Object (c, (GENERIC)0, (PFO)0, 0); + /* See comment in Define_Class below */ + XtInitializeWidgetClass (class); } return c; } @@ -44,8 +44,8 @@ Object Make_Widget_Class (class) WidgetClass class; { register CLASS_INFO *p; for (p = ctab; p < clast; p++) - if (p->class == class) - return Make_Class (class, p->name); + if (p->class == class) + return Make_Class (class, p->name); Primitive_Error ("undefined widget class ~s", Xt_Class_Name (class)); /*NOTREACHED*/ } @@ -55,8 +55,8 @@ static Object P_Find_Class (name) Object name; { register char *s = Get_Strsym (name); for (p = ctab; p < clast; p++) { - if (streq (p->name, s)) - return Make_Class (p->class, p->name); + if (streq (p->name, s)) + return Make_Class (p->class, p->name); } Primitive_Error ("no such widget class: ~s", name); /*NOTREACHED*/ @@ -67,8 +67,8 @@ static Object P_Class_Existsp (name) Object name; { register char *s = Get_Strsym (name); for (p = ctab; p < clast; p++) { - if (streq (p->name, s)) - return True; + if (streq (p->name, s)) + return True; } return False; } @@ -77,20 +77,20 @@ char *Class_Name (class) WidgetClass class; { register CLASS_INFO *p; for (p = ctab; p < clast && p->class != class; p++) - ; + ; if (p == clast) - return "unknown"; + return "unknown"; return p->name; } void Get_Sub_Resource_List (class, rp, np) WidgetClass class; - XtResourceList *rp; Cardinal *np; { + XtResourceList *rp; Cardinal *np; { register CLASS_INFO *p; for (p = ctab; p < clast && p->class != class; p++) - ; + ; if (p == clast) - Primitive_Error ("undefined widget class ~s", Xt_Class_Name (class)); + Primitive_Error ("undefined widget class ~s", Xt_Class_Name (class)); *np = p->num_resources; *rp = p->sub_resources; } @@ -111,10 +111,10 @@ static Object P_Class_Sub_Resources (c) Object c; { } void Define_Class (name, class, r, nr) char *name; WidgetClass class; - XtResourceList r; { + XtResourceList r; { Set_Error_Tag ("define-class"); if (clast == ctab+MAX_CLASS) - Primitive_Error ("too many widget classes"); + Primitive_Error ("too many widget classes"); /* * The next line should read: * XtInitializeWidgetClass (class); @@ -141,52 +141,52 @@ void Define_Callback (cl, s, has_arg) char *cl, *s; { Set_Error_Tag ("define-callback"); for (p = ctab; p < clast; p++) - if (streq (p->name, cl)) { - if (p->cblast == p->cb+MAX_CALLBACK_PER_CLASS) - Primitive_Error ("too many callbacks for this class"); - p->cblast->name = s; - p->cblast->has_arg = has_arg; - p->cblast++; - return; - } + if (streq (p->name, cl)) { + if (p->cblast == p->cb+MAX_CALLBACK_PER_CLASS) + Primitive_Error ("too many callbacks for this class"); + p->cblast->name = s; + p->cblast->has_arg = has_arg; + p->cblast++; + return; + } Primitive_Error ("undefined class"); } PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name; - Object sname; { + Object sname; { register CLASS_INFO *p; register CALLBACK_INFO *q; PFX2S conv; for (p = ctab; p < clast; p++) - if (p->class == c) { - for (q = p->cb; q < p->cblast; q++) - if (streq (q->name, name)) { - if (q->has_arg) { - char s1[128], s2[128], msg[256]; + if (p->class == c) { + for (q = p->cb; q < p->cblast; q++) + if (streq (q->name, name)) { + if (q->has_arg) { + char s1[128], s2[128], msg[256]; - /* First look for a class specific converter - * then for a general one. Callback converters - * have a prefix "callback:" to avoid name conflicts - * with converters for normal resources. - */ - sprintf (s1, "callback:%s-%s", p->name, name); - conv = Find_Converter_To_Scheme (s1); - if (conv == 0) { - sprintf(s2, "callback:%s", name); - conv = Find_Converter_To_Scheme (s2); - if (conv == 0) { - sprintf (msg, - "no callback converter for %s or %s", - s1, s2, name); - Primitive_Error (msg); - } - } - return conv; - } else return (PFX2S)0; - } - Primitive_Error ("no such callback: ~s", sname); - } + /* First look for a class specific converter + * then for a general one. Callback converters + * have a prefix "callback:" to avoid name conflicts + * with converters for normal resources. + */ + sprintf (s1, "callback:%s-%s", p->name, name); + conv = Find_Converter_To_Scheme (s1); + if (conv == 0) { + sprintf(s2, "callback:%s", name); + conv = Find_Converter_To_Scheme (s2); + if (conv == 0) { + sprintf (msg, + "no callback converter for %s or %s", + s1, s2, name); + Primitive_Error (msg); + } + } + return conv; + } else return (PFX2S)0; + } + Primitive_Error ("no such callback: ~s", sname); + } Primitive_Error ("undefined widget class ~s", Xt_Class_Name (c)); /*NOTREACHED*/ } @@ -198,7 +198,7 @@ elk_init_xt_class () { Define_Primitive (P_Class_Constraint_Resources, "class-constraint-resources", 1, 1, EVAL); Define_Primitive (P_Class_Sub_Resources, - "class-sub-resources", 1, 1, EVAL); + "class-sub-resources", 1, 1, EVAL); Define_Primitive (P_Class_Existsp, "class-exists?", 1, 1, EVAL); /* * Doesn't work with Motif-1.1.0: diff --git a/lib/xt/classname.c b/lib/xt/classname.c index a7f733d..8d1416a 100644 --- a/lib/xt/classname.c +++ b/lib/xt/classname.c @@ -5,5 +5,5 @@ Object Xt_Class_Name (class) WidgetClass class; { return Make_String (class->core_class.class_name, - strlen (class->core_class.class_name)); + strlen (class->core_class.class_name)); } diff --git a/lib/xt/context.c b/lib/xt/context.c index 0d4c537..8091725 100644 --- a/lib/xt/context.c +++ b/lib/xt/context.c @@ -27,15 +27,15 @@ static Object Internal_Make_Context (finalize, context) XtAppContext context; { c = Find_Object (T_Context, (GENERIC)0, Match_Xt_Obj, context); if (Nullp (c)) { - c = Alloc_Object (sizeof (struct S_Context), T_Context, 0); - CONTEXT(c)->tag = Null; - CONTEXT(c)->context = context; - CONTEXT(c)->free = 0; - Register_Object (c, (GENERIC)0, - finalize ? P_Destroy_Context : (PFO)0, 1); - XtAppSetWarningHandler (context, Xt_Warning); - XtAppAddActionHook (context, (XtActionHookProc)Action_Hook, - (XtPointer)0); + c = Alloc_Object (sizeof (struct S_Context), T_Context, 0); + CONTEXT(c)->tag = Null; + CONTEXT(c)->context = context; + CONTEXT(c)->free = 0; + Register_Object (c, (GENERIC)0, + finalize ? P_Destroy_Context : (PFO)0, 1); + XtAppSetWarningHandler (context, Xt_Warning); + XtAppAddActionHook (context, (XtActionHookProc)Action_Hook, + (XtPointer)0); } return c; } @@ -52,7 +52,7 @@ Object Make_Context_Foreign (context) XtAppContext context; { void Check_Context (c) Object c; { Check_Type (c, T_Context); if (CONTEXT(c)->free) - Primitive_Error ("invalid context: ~s", c); + Primitive_Error ("invalid context: ~s", c); } static Object P_Create_Context () { @@ -69,7 +69,7 @@ static Object P_Destroy_Context (c) Object c; { } static Object P_Initialize_Display (c, d, name, class) - Object c, d, name, class; { + Object c, d, name, class; { register char *sn = 0, *sc = "", *sd = 0; Display *dpy; extern char **Argv; @@ -79,25 +79,25 @@ static Object P_Initialize_Display (c, d, name, class) Argv[First_Arg-1] = "elk"; Check_Context (c); if (!EQ(name, False)) - sn = Get_Strsym (name); + sn = Get_Strsym (name); if (!EQ(class, False)) - sc = Get_Strsym (class); + sc = Get_Strsym (class); if (TYPE(d) == T_Display) { - XtDisplayInitialize (CONTEXT(c)->context, DISPLAY(d)->dpy, - sn, sc, (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); - Argc = First_Arg + argc; - return Void; + XtDisplayInitialize (CONTEXT(c)->context, DISPLAY(d)->dpy, + sn, sc, (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); + Argc = First_Arg + argc; + return Void; } if (!EQ(d, False)) - sd = Get_Strsym (d); + sd = Get_Strsym (d); dpy = XtOpenDisplay (CONTEXT(c)->context, sd, sn, sc, - (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); + (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); Argc = First_Arg + argc - 1; if (dpy == 0) - if (sd) - Primitive_Error ("cannot open display ~s", d); - else - Primitive_Error ("cannot open display"); + if (sd) + Primitive_Error ("cannot open display ~s", d); + else + Primitive_Error ("cannot open display"); return Make_Display (0, dpy); } @@ -107,7 +107,7 @@ static Object P_Initialize_Display (c, d, name, class) static Object P_Display_To_Context (d) Object d; { Check_Type (d, T_Display); return - Make_Context_Foreign (XtDisplayToApplicationContext (DISPLAY(d)->dpy)); + Make_Context_Foreign (XtDisplayToApplicationContext (DISPLAY(d)->dpy)); } static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; { @@ -119,16 +119,16 @@ static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; { con = argv[0]; Check_Context (con); if (argc > 1) { - argv++; argc--; - p = (char **)XtMalloc ((argc+1) * sizeof (char *)); - for (i = 0; i < argc; i++) { - Check_Type (argv[i], T_String); - sp = STRING(argv[i]); - p[i] = XtMalloc (sp->size + 1); - bcopy (sp->data, p[i], sp->size); - p[i][sp->size] = 0; - } - p[i] = 0; + argv++; argc--; + p = (char **)XtMalloc ((argc+1) * sizeof (char *)); + for (i = 0; i < argc; i++) { + Check_Type (argv[i], T_String); + sp = STRING(argv[i]); + p[i] = XtMalloc (sp->size + 1); + bcopy (sp->data, p[i], sp->size); + p[i][sp->size] = 0; + } + p[i] = 0; } XtAppSetFallbackResources (CONTEXT(con)->context, p); return Void; @@ -143,7 +143,7 @@ static Object P_Context_Main_Loop (c) Object c; { static Object P_Context_Pending (c) Object c; { Check_Context (c); return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context), - 1, XtIM_Syms); + 1, XtIM_Syms); } static Object P_Context_Process_Event (argc, argv) Object *argv; { @@ -151,7 +151,7 @@ static Object P_Context_Process_Event (argc, argv) Object *argv; { Check_Context (argv[0]); if (argc == 2) - mask = (XtInputMask)Symbols_To_Bits (argv[1], 1, XtIM_Syms); + mask = (XtInputMask)Symbols_To_Bits (argv[1], 1, XtIM_Syms); XtAppProcessEvent (CONTEXT(argv[0])->context, mask); return Void; } @@ -161,7 +161,7 @@ static Boolean Work_Proc (client_data) XtPointer client_data; { ret = Funcall (Get_Function ((int)client_data), Null, 0); if (Truep (ret)) - Deregister_Function ((int)client_data); + Deregister_Function ((int)client_data); return Truep (ret); } @@ -183,7 +183,7 @@ static Object P_Remove_Work_Proc (id) Object id; { } static void Timeout_Proc (client_data, id) - XtPointer client_data; XtIntervalId *id; { + XtPointer client_data; XtIntervalId *id; { Object proc, args; register i = (int)client_data; @@ -201,7 +201,7 @@ static Object P_Context_Add_Timeout (c, n, p) Object c, n, p; { Check_Procedure (p); i = Register_Function (p); id = XtAppAddTimeOut (CONTEXT(c)->context, (unsigned long)Get_Long (n), - Timeout_Proc, (XtPointer)i); + Timeout_Proc, (XtPointer)i); return Make_Id ('t', (XtPointer)id, i); } @@ -213,7 +213,7 @@ static Object P_Remove_Timeout (id) Object id; { /*ARGSUSED*/ static void Input_Proc (client_data, src, id) XtPointer client_data; int *src; - XtInputId *id; { + XtInputId *id; { Object p, args; GC_Node2; @@ -237,21 +237,21 @@ static Object P_Context_Add_Input (argc, argv) Object *argv; { Check_Procedure (p); Check_Type (src, T_Port); if (!(PORT(src)->flags & P_OPEN)) - Primitive_Error ("port has been closed: ~s", src); + Primitive_Error ("port has been closed: ~s", src); if (PORT(src)->flags & P_STRING) - Primitive_Error ("invalid port: ~s", src); + Primitive_Error ("invalid port: ~s", src); if (argc == 4) { - m = Symbols_To_Bits (argv[3], 1, XtInputMask_Syms); + m = Symbols_To_Bits (argv[3], 1, XtInputMask_Syms); } else { - switch (PORT(src)->flags & (P_INPUT|P_BIDIR)) { - case 0: m = XtInputWriteMask; break; - case P_INPUT: m = XtInputReadMask; break; - default: m = XtInputReadMask|XtInputWriteMask; break; - } + switch (PORT(src)->flags & (P_INPUT|P_BIDIR)) { + case 0: m = XtInputWriteMask; break; + case P_INPUT: m = XtInputReadMask; break; + default: m = XtInputReadMask|XtInputWriteMask; break; + } } i = Register_Function (Cons (src, p)); id = XtAppAddInput (CONTEXT(c)->context, fileno (PORT(src)->file), - (XtPointer)m, Input_Proc, (XtPointer)i); + (XtPointer)m, Input_Proc, (XtPointer)i); return Make_Id ('i', (XtPointer)id, i); } @@ -268,13 +268,13 @@ elk_init_xt_context () { Define_Primitive (P_Initialize_Display, "initialize-display", 4, 4, EVAL); Define_Primitive (P_Display_To_Context, "display->context", 1, 1, EVAL); Define_Primitive (P_Set_Context_Fallback_Resources, - "set-context-fallback-resources!", 1, MANY, VARARGS); + "set-context-fallback-resources!", 1, MANY, VARARGS); Define_Primitive (P_Context_Main_Loop, "context-main-loop", 1, 1, EVAL); Define_Primitive (P_Context_Pending, "context-pending", 1, 1, EVAL); Define_Primitive (P_Context_Process_Event, - "context-process-event", 1, 2, VARARGS); + "context-process-event", 1, 2, VARARGS); Define_Primitive (P_Context_Add_Work_Proc, - "context-add-work-proc", 2, 2, EVAL); + "context-add-work-proc", 2, 2, EVAL); Define_Primitive (P_Remove_Work_Proc, "remove-work-proc", 1, 1, EVAL); Define_Primitive (P_Context_Add_Timeout,"context-add-timeout",3, 3, EVAL); Define_Primitive (P_Remove_Timeout, "remove-timeout", 1, 1, EVAL); diff --git a/lib/xt/converter.c b/lib/xt/converter.c index 8ac35c9..24d333d 100644 --- a/lib/xt/converter.c +++ b/lib/xt/converter.c @@ -14,7 +14,7 @@ static CONVERTER ctab[MAX_CONVERTER], *clast = ctab; void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; { Set_Error_Tag ("c->scheme"); if (clast == ctab+MAX_CONVERTER) - Primitive_Error ("too many converters"); + Primitive_Error ("too many converters"); clast->name = name; clast->scheme_to_c = 0; clast->to_scheme = c; @@ -24,7 +24,7 @@ void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; { void Define_Converter_To_C (name, c) char *name; PFS2X c; { Set_Error_Tag ("scheme->c"); if (clast == ctab+MAX_CONVERTER) - Primitive_Error ("too many converters"); + Primitive_Error ("too many converters"); clast->name = name; clast->scheme_to_c = 1; clast->to_c = c; @@ -35,8 +35,8 @@ PFX2S Find_Converter_To_Scheme (name) char *name; { register CONVERTER *p; for (p = ctab; p < clast; p++) - if (!p->scheme_to_c && streq (p->name, name)) - return p->to_scheme; + if (!p->scheme_to_c && streq (p->name, name)) + return p->to_scheme; return 0; } @@ -44,7 +44,7 @@ PFS2X Find_Converter_To_C (name) char *name; { register CONVERTER *p; for (p = ctab; p < clast; p++) - if (p->scheme_to_c && streq (p->name, name)) - return p->to_c; + if (p->scheme_to_c && streq (p->name, name)) + return p->to_c; return 0; } diff --git a/lib/xt/function.c b/lib/xt/function.c index 5507049..134c655 100644 --- a/lib/xt/function.c +++ b/lib/xt/function.c @@ -9,15 +9,15 @@ int Register_Function (x) Object x; { GC_Node; for (i = 0; i < max_functions; i++) - if (Nullp (VECTOR(Functions)->data[i])) break; + if (Nullp (VECTOR(Functions)->data[i])) break; if (i == max_functions) { - max_functions *= 2; - GC_Link (x); - v = Make_Vector (max_functions, Null); - GC_Unlink; - bcopy ((char *)VECTOR(Functions)->data, (char *)VECTOR(v)->data, - i * sizeof (Object)); - Functions = v; + max_functions *= 2; + GC_Link (x); + v = Make_Vector (max_functions, Null); + GC_Unlink; + bcopy ((char *)VECTOR(Functions)->data, (char *)VECTOR(v)->data, + i * sizeof (Object)); + Functions = v; } VECTOR(Functions)->data[i] = x; return i; diff --git a/lib/xt/identifier.c b/lib/xt/identifier.c index 15ff42c..c4383f5 100644 --- a/lib/xt/identifier.c +++ b/lib/xt/identifier.c @@ -15,13 +15,13 @@ Object Make_Id (type, val, num) XtPointer val; { i = Find_Object (T_Identifier, (GENERIC)0, Match_Xt_Obj, type, val); if (Nullp (i)) { - i = Alloc_Object (sizeof (struct S_Identifier), T_Identifier, 0); - IDENTIFIER(i)->tag = Null; - IDENTIFIER(i)->type = type; - IDENTIFIER(i)->val = val; - IDENTIFIER(i)->num = num; - IDENTIFIER(i)->free = 0; - Register_Object (i, (GENERIC)0, (PFO)0, 0); + i = Alloc_Object (sizeof (struct S_Identifier), T_Identifier, 0); + IDENTIFIER(i)->tag = Null; + IDENTIFIER(i)->type = type; + IDENTIFIER(i)->val = val; + IDENTIFIER(i)->num = num; + IDENTIFIER(i)->free = 0; + Register_Object (i, (GENERIC)0, (PFO)0, 0); } return i; } @@ -29,7 +29,7 @@ Object Make_Id (type, val, num) XtPointer val; { XtPointer Use_Id (x, type) Object x; { Check_Type (x, T_Identifier); if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free) - Primitive_Error ("invalid identifier"); + Primitive_Error ("invalid identifier"); IDENTIFIER(x)->free = 1; Deregister_Object (x); return IDENTIFIER(x)->val; diff --git a/lib/xt/popup.c b/lib/xt/popup.c index ddd44bf..e133bfa 100644 --- a/lib/xt/popup.c +++ b/lib/xt/popup.c @@ -15,18 +15,18 @@ static Object P_Create_Popup_Shell (argc, argv) Object *argv; { x = argv[0]; if (TYPE(x) != T_Class) { - name = Get_Strsym (x); - argv++; argc--; + name = Get_Strsym (x); + argv++; argc--; } class = argv[0]; parent = argv[1]; Check_Type (class, T_Class); Check_Widget (parent); if (name == 0) - name = CLASS(class)->name; + name = CLASS(class)->name; Encode_Arglist (argc-2, argv+2, a, (Widget)0, CLASS(class)->wclass); ret = Make_Widget (XtCreatePopupShell (name, CLASS(class)->wclass, - WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); + WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); Alloca_End; return ret; } @@ -34,7 +34,7 @@ static Object P_Create_Popup_Shell (argc, argv) Object *argv; { static Object P_Popup (shell, grab_kind) Object shell, grab_kind; { Check_Widget (shell); XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0, - Grab_Kind_Syms)); + Grab_Kind_Syms)); return Void; } @@ -46,7 +46,7 @@ static Object P_Popdown (shell) Object shell; { elk_init_xt_popup () { Define_Primitive (P_Create_Popup_Shell, "create-popup-shell", - 2, MANY, VARARGS); + 2, MANY, VARARGS); Define_Primitive (P_Popup, "popup", 2, 2, EVAL); Define_Primitive (P_Popdown, "popdown", 1, 1, EVAL); } diff --git a/lib/xt/resource.c b/lib/xt/resource.c index 6e0e448..4ddaf06 100644 --- a/lib/xt/resource.c +++ b/lib/xt/resource.c @@ -20,84 +20,84 @@ static Resource_To_Scheme_Type (t) register char *t; { if (streq (XtRAcceleratorTable, t)) - return T_Accelerators; + return T_Accelerators; else if (streq (XtRBackingStore, t)) - return T_Backing_Store; + return T_Backing_Store; else if (streq (XtRBitmap, t)) - return T_Bitmap; + return T_Bitmap; else if (streq (XtRBoolean, t)) - return T_Boolean; + return T_Boolean; else if (streq (XtRCallback, t)) - return T_Callbacklist; + return T_Callbacklist; else if (streq (XtRCardinal, t)) - return T_Cardinal; + return T_Cardinal; else if (streq (XtRColormap, t)) - return T_Colormap; + return T_Colormap; else if (streq (XtRCursor, t)) - return T_Cursor; + return T_Cursor; else if (streq (XtRDimension, t)) - return T_Dimension; + return T_Dimension; else if (streq (XtRDisplay, t)) - return T_Display; + return T_Display; else if (streq (XtRFloat, t)) - return T_Float; + return T_Float; else if (streq (XtRFont, t)) - return T_Font; + return T_Font; else if (streq (XtRFontStruct, t)) - return T_Font; + return T_Font; else if (streq (XtRGC, t)) - return T_Gc; + return T_Gc; else if (streq (XtRInt, t)) - return T_Fixnum; + return T_Fixnum; else if (streq (XtRPixel, t)) - return T_Pixel; + return T_Pixel; else if (streq (XtRPixmap, t)) - return T_Pixmap; + return T_Pixmap; else if (streq (XtRPosition, t)) - return T_Position; + return T_Position; else if (streq (XtRShort, t)) - return T_Fixnum; + return T_Fixnum; else if (streq (XtRString, t)) - return T_String_Or_Symbol; + return T_String_Or_Symbol; else if (streq (XtRTranslationTable, t)) - return T_Translations; + return T_Translations; else if (streq (XtRUnsignedChar, t)) - return T_Character; + return T_Character; else if (streq (XtRChar, t)) - return T_Character; + return T_Character; else if (streq (XtRWidget, t)) - return T_Widget; + return T_Widget; else if (streq (XtRWindow, t)) - return T_Window; + return T_Window; return T_Unknown; } void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c; - XtResource **rp; int *np, *cp; { + XtResource **rp; int *np, *cp; { XtResource *r, *sr, *cr; int nr, snr = 0, cnr = 0; XtGetResourceList (c, &r, (Cardinal *)&nr); if (sub) - Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr); + Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr); if (w && XtParent (w)) - XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, - (Cardinal *)&cnr); + XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, + (Cardinal *)&cnr); *np = nr + snr + cnr; *cp = cnr; *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource)); bcopy ((char *)r, (char *)*rp, nr * sizeof (XtResource)); XtFree ((char *)r); if (snr) - bcopy ((char *)sr, (char *)(*rp + nr), snr * sizeof (XtResource)); + bcopy ((char *)sr, (char *)(*rp + nr), snr * sizeof (XtResource)); if (cnr) { - bcopy ((char *)cr, (char *)(*rp + nr+snr), cnr * sizeof (XtResource)); - XtFree ((char *)cr); + bcopy ((char *)cr, (char *)(*rp + nr+snr), cnr * sizeof (XtResource)); + XtFree ((char *)cr); } } void Convert_Args (ac, av, to, widget, class) Object *av; ArgList to; - Widget widget; WidgetClass class; { + Widget widget; WidgetClass class; { register char *name, *res; register i, j, k; Object arg, val; @@ -111,133 +111,133 @@ void Convert_Args (ac, av, to, widget, class) Object *av; ArgList to; Alloca_Begin; if (ac & 1) - Primitive_Error ("missing argument value"); + Primitive_Error ("missing argument value"); Get_All_Resources (1, widget, class, &r, &nr, &nc); /* Note: * `r' is not freed in case of error. */ for (i = k = 0; k < ac; i++, k++) { - arg = av[k]; - Get_Strsym_Stack (arg, name); - Make_Resource_Name (name); - for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) - ; - if (j == nr) - Primitive_Error ("no such resource: ~s", arg); - if (streq (r[j].resource_class, XtCReadOnly)) - Primitive_Error ("resource is read-only: ~s", arg); - res = r[j].resource_name; - val = av[++k]; - st = TYPE(val); - dt = Resource_To_Scheme_Type (r[j].resource_type); + arg = av[k]; + Get_Strsym_Stack (arg, name); + Make_Resource_Name (name); + for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) + ; + if (j == nr) + Primitive_Error ("no such resource: ~s", arg); + if (streq (r[j].resource_class, XtCReadOnly)) + Primitive_Error ("resource is read-only: ~s", arg); + res = r[j].resource_name; + val = av[++k]; + st = TYPE(val); + dt = Resource_To_Scheme_Type (r[j].resource_type); - /* First look for widget class specific converter for - * this resource, then look for a general converter - * (first try the name of the resource, then the type): - */ - if (widget && j >= nr-nc) - class = XtClass (XtParent (widget)); - sprintf (key, "%s-%s", Class_Name (class), name); - converter = Find_Converter_To_C (key); - if (converter || (converter = Find_Converter_To_C (res)) - || (converter = Find_Converter_To_C (r[j].resource_type))) { - XtArgVal ret = converter (val); - XtSetArg (to[i], res, ret); - } else if (dt == T_String_Or_Symbol) { - Get_Strsym_Stack (val, stmp); - XtSetArg (to[i], res, XtNewString (stmp)); /* Never freed! */ - } else if (dt == T_Callbacklist) { - int n; - XtCallbackList callbacks; + /* First look for widget class specific converter for + * this resource, then look for a general converter + * (first try the name of the resource, then the type): + */ + if (widget && j >= nr-nc) + class = XtClass (XtParent (widget)); + sprintf (key, "%s-%s", Class_Name (class), name); + converter = Find_Converter_To_C (key); + if (converter || (converter = Find_Converter_To_C (res)) + || (converter = Find_Converter_To_C (r[j].resource_type))) { + XtArgVal ret = converter (val); + XtSetArg (to[i], res, ret); + } else if (dt == T_String_Or_Symbol) { + Get_Strsym_Stack (val, stmp); + XtSetArg (to[i], res, XtNewString (stmp)); /* Never freed! */ + } else if (dt == T_Callbacklist) { + int n; + XtCallbackList callbacks; - Check_Callback_List (val); - n = Fast_Length (val); - callbacks = (XtCallbackRec *) /* Never freed! */ - XtMalloc ((n+1) * sizeof (XtCallbackRec)); - callbacks[n].callback = 0; - callbacks[n].closure = 0; - Fill_Callbacks (val, callbacks, n, - Find_Callback_Converter (class, name, arg)); - XtSetArg (to[i], res, callbacks); - } else if (dt == T_Float) { - float f = (float)Get_Double (val); - to[i].name = res; - bcopy ((char *)&f, (char *)&to[i].value, sizeof f); - } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal - || dt == T_Fixnum) { - XtSetArg (to[i], res, Get_Integer (val)); - } else if (dt == T_Backing_Store) { - XtSetArg (to[i], res, Symbols_To_Bits (val, 0, - Backing_Store_Syms)); - } else if (dt == T_Translations) { - XtSetArg (to[i], res, Get_Translations (val)); - } else if (dt == T_Accelerators) { - XtSetArg (to[i], res, Get_Accelerators (val)); - } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) { - XtSetArg (to[i], res, None); - } else if (dt == T_Bitmap) { - /* Should check depth here (must be 1), but how? */ - XtSetArg (to[i], res, Get_Pixmap (val)); - } else { - if (st != dt) { - char msg[128]; + Check_Callback_List (val); + n = Fast_Length (val); + callbacks = (XtCallbackRec *) /* Never freed! */ + XtMalloc ((n+1) * sizeof (XtCallbackRec)); + callbacks[n].callback = 0; + callbacks[n].closure = 0; + Fill_Callbacks (val, callbacks, n, + Find_Callback_Converter (class, name, arg)); + XtSetArg (to[i], res, callbacks); + } else if (dt == T_Float) { + float f = (float)Get_Double (val); + to[i].name = res; + bcopy ((char *)&f, (char *)&to[i].value, sizeof f); + } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal + || dt == T_Fixnum) { + XtSetArg (to[i], res, Get_Integer (val)); + } else if (dt == T_Backing_Store) { + XtSetArg (to[i], res, Symbols_To_Bits (val, 0, + Backing_Store_Syms)); + } else if (dt == T_Translations) { + XtSetArg (to[i], res, Get_Translations (val)); + } else if (dt == T_Accelerators) { + XtSetArg (to[i], res, Get_Accelerators (val)); + } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) { + XtSetArg (to[i], res, None); + } else if (dt == T_Bitmap) { + /* Should check depth here (must be 1), but how? */ + XtSetArg (to[i], res, Get_Pixmap (val)); + } else { + if (st != dt) { + char msg[128]; - /* Try to let XtConvert() do the conversion. - */ - if (widget && (st == T_String || st == T_Symbol)) { - Get_Strsym_Stack (val, stmp); - src.size = strlen (stmp); - src.addr = (caddr_t)stmp; - XtConvert (widget, (String)XtRString, &src, - r[j].resource_type, &dst); - if (dst.addr) { - if (dst.size == (sizeof (unsigned char))) { - XtSetArg (to[i], res, *(unsigned char *)dst.addr); - } else if (dst.size == sizeof (int)) { - XtSetArg (to[i], res, *(int *)dst.addr); - } else if (dst.size == sizeof (XtArgVal)) { - XtSetArg (to[i], res, *(XtArgVal *)dst.addr); - } else { - sprintf (msg, - "%s: converter for %s returned weird size %d", - name, r[j].resource_type, dst.size); - Primitive_Error (msg); - } - goto done; - } - } - sprintf (msg, "%s: can't convert %s ~s to %s", name, - Types[st].name, r[j].resource_type); - Primitive_Error (msg, val); - } - if (dt == T_Boolean) { - XtSetArg (to[i], res, EQ(val, True)); - } else if (dt == T_Colormap) { - XtSetArg (to[i], res, COLORMAP(val)->cm); - } else if (dt == T_Cursor) { - XtSetArg (to[i], res, CURSOR(val)->cursor); - } else if (dt == T_Display) { - XtSetArg (to[i], res, DISPLAY(val)->dpy); - } else if (dt == T_Font) { - Open_Font_Maybe (val); - if (streq (r[j].resource_type, XtRFontStruct)) - XtSetArg (to[i], res, FONT(val)->info); - else - XtSetArg (to[i], res, FONT(val)->id); - } else if (dt == T_Pixel) { - XtSetArg (to[i], res, PIXEL(val)->pix); - } else if (dt == T_Pixmap) { - XtSetArg (to[i], res, PIXMAP(val)->pm); - } else if (dt == T_Gc) { - XtSetArg (to[i], res, GCONTEXT(val)->gc); - } else if (dt == T_Character) { - XtSetArg (to[i], res, CHAR(val)); - } else if (dt == T_Widget) { - XtSetArg (to[i], res, WIDGET(val)->widget); - } else if (dt == T_Window) { - XtSetArg (to[i], res, WINDOW(val)->win); - } else Panic ("bad conversion type"); - } + /* Try to let XtConvert() do the conversion. + */ + if (widget && (st == T_String || st == T_Symbol)) { + Get_Strsym_Stack (val, stmp); + src.size = strlen (stmp); + src.addr = (caddr_t)stmp; + XtConvert (widget, (String)XtRString, &src, + r[j].resource_type, &dst); + if (dst.addr) { + if (dst.size == (sizeof (unsigned char))) { + XtSetArg (to[i], res, *(unsigned char *)dst.addr); + } else if (dst.size == sizeof (int)) { + XtSetArg (to[i], res, *(int *)dst.addr); + } else if (dst.size == sizeof (XtArgVal)) { + XtSetArg (to[i], res, *(XtArgVal *)dst.addr); + } else { + sprintf (msg, + "%s: converter for %s returned weird size %d", + name, r[j].resource_type, dst.size); + Primitive_Error (msg); + } + goto done; + } + } + sprintf (msg, "%s: can't convert %s ~s to %s", name, + Types[st].name, r[j].resource_type); + Primitive_Error (msg, val); + } + if (dt == T_Boolean) { + XtSetArg (to[i], res, EQ(val, True)); + } else if (dt == T_Colormap) { + XtSetArg (to[i], res, COLORMAP(val)->cm); + } else if (dt == T_Cursor) { + XtSetArg (to[i], res, CURSOR(val)->cursor); + } else if (dt == T_Display) { + XtSetArg (to[i], res, DISPLAY(val)->dpy); + } else if (dt == T_Font) { + Open_Font_Maybe (val); + if (streq (r[j].resource_type, XtRFontStruct)) + XtSetArg (to[i], res, FONT(val)->info); + else + XtSetArg (to[i], res, FONT(val)->id); + } else if (dt == T_Pixel) { + XtSetArg (to[i], res, PIXEL(val)->pix); + } else if (dt == T_Pixmap) { + XtSetArg (to[i], res, PIXMAP(val)->pm); + } else if (dt == T_Gc) { + XtSetArg (to[i], res, GCONTEXT(val)->gc); + } else if (dt == T_Character) { + XtSetArg (to[i], res, CHAR(val)); + } else if (dt == T_Widget) { + XtSetArg (to[i], res, WIDGET(val)->widget); + } else if (dt == T_Window) { + XtSetArg (to[i], res, WINDOW(val)->win); + } else Panic ("bad conversion type"); + } done: ; } Alloca_End; @@ -266,19 +266,19 @@ Object Get_Values (w, ac, av) Widget w; Object *av; { * `r' is not freed in case of error. */ for (i = 0; i < ac; i++) { - XtArgVal argval; + XtArgVal argval; - arg = av[i]; - Check_Type (arg, T_Symbol); - Get_Strsym_Stack (arg, name); - Make_Resource_Name (name); - for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) - ; - if (j == nr) - Primitive_Error ("no such resource: ~s", arg); - argl[i].name = name; - Alloca (argval, XtArgVal, r[j].resource_size); - argl[i].value = argval; + arg = av[i]; + Check_Type (arg, T_Symbol); + Get_Strsym_Stack (arg, name); + Make_Resource_Name (name); + for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) + ; + if (j == nr) + Primitive_Error ("no such resource: ~s", arg); + argl[i].name = name; + Alloca (argval, XtArgVal, r[j].resource_size); + argl[i].value = argval; } XtGetValues (w, argl, (Cardinal)ac); ret = tail = P_Make_List (Make_Integer (ac), Null); @@ -289,101 +289,101 @@ Object Get_Values (w, ac, av) Widget w; Object *av; { */ dpy = XtDisplayOfObject (w); for (i = 0; i < ac; i++, tail = Cdr (tail)) { - Object o; - XtArgVal val = argl[i].value; - for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++) - ; - t = Resource_To_Scheme_Type (r[j].resource_type); + Object o; + XtArgVal val = argl[i].value; + for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++) + ; + t = Resource_To_Scheme_Type (r[j].resource_type); - /* Look for a widget class specific converter, then for a - * general converter (first try the resource name, then the type): - */ - w2 = (j >= nr-nc) ? XtParent (w) : w; - sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name); - converter = Find_Converter_To_Scheme (key); + /* Look for a widget class specific converter, then for a + * general converter (first try the resource name, then the type): + */ + w2 = (j >= nr-nc) ? XtParent (w) : w; + sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name); + converter = Find_Converter_To_Scheme (key); - if (converter) { - o = converter (*(XtArgVal *)val); - } else if (converter = Find_Converter_To_Scheme (argl[i].name)) { - o = converter (*(XtArgVal *)val); - } else if (converter = Find_Converter_To_Scheme (r[j].resource_type)) { - o = converter (*(XtArgVal *)val); - } else if (t == T_String_Or_Symbol) { - char *s = *(char **)val; + if (converter) { + o = converter (*(XtArgVal *)val); + } else if (converter = Find_Converter_To_Scheme (argl[i].name)) { + o = converter (*(XtArgVal *)val); + } else if (converter = Find_Converter_To_Scheme (r[j].resource_type)) { + o = converter (*(XtArgVal *)val); + } else if (t == T_String_Or_Symbol) { + char *s = *(char **)val; - if (s == 0) s = ""; - o = Make_String (s, strlen (s)); - } else if (t == T_Callbacklist) { - register i, n; - Object ret, tail; - XtCallbackList callbacks = *(XtCallbackList *)val; - GC_Node; + if (s == 0) s = ""; + o = Make_String (s, strlen (s)); + } else if (t == T_Callbacklist) { + register i, n; + Object ret, tail; + XtCallbackList callbacks = *(XtCallbackList *)val; + GC_Node; - for (n = 0; callbacks[n].callback; n++) - ; - ret = tail = P_Make_List (Make_Integer (n), Null); - GC_Link2 (ret, tail); - for (i = 0; i < n; i++, tail = Cdr (tail)) - Car (tail) = Get_Callbackfun (callbacks[i].closure); - GC_Unlink; - o = ret; - } else if (t == T_Float) { - o = Make_Reduced_Flonum ((double)*(float *)val); - } else if (t == T_Backing_Store) { - o = Bits_To_Symbols ((unsigned long)*(int *)val, 0, - Backing_Store_Syms); - if (Nullp (o)) - Primitive_Error ("invalid backing-store (Xt bug)"); - } else if (t == T_Boolean) { - o = (Boolean)*(Boolean *)val ? True : False; - } else if (t == T_Colormap) { - o = Make_Colormap (0, dpy, *(Colormap *)val); - } else if (t == T_Cursor) { - o = Make_Cursor_Foreign (dpy, *(Cursor *)val); - } else if (t == T_Gc) { - o = Make_Gc (0, dpy, *(GC *)val); - } else if (t == T_Dimension) { - o = Make_Integer (*(Dimension *)val); - } else if (t == T_Position) { - o = Make_Integer (*(Position *)val); - } else if (t == T_Cardinal) { - o = Make_Unsigned (*(Cardinal *)val); - } else if (t == T_Fixnum) { - if (streq (r[j].resource_type, XtRInt)) - o = Make_Integer (*(int *)val); - else - o = Make_Integer (*(short *)val); - } else if (t == T_Display) { - o = Make_Display (0, dpy); - } else if (t == T_Font) { - if (streq (r[j].resource_type, XtRFontStruct)) { - o = Make_Font_Foreign (dpy, False, (Font)0, - *(XFontStruct **)val); - } else { - XFontStruct *info; - Disable_Interrupts; - info = XQueryFont (dpy, *(Font *)val); - Enable_Interrupts; - o = Make_Font_Foreign (dpy, False, *(Font *)val, info); - } - } else if (t == T_Pixel) { - o = Make_Pixel (*(unsigned long *)val); - } else if (t == T_Pixmap || t == T_Bitmap) { - o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val); - } else if (t == T_Character) { - o = Make_Char (*(unsigned char *)val); - } else if (t == T_Widget) { - o = Make_Widget_Foreign (*(Widget *)val); - } else if (t == T_Window) { - o = Make_Window (0, dpy, *(Window *)val); - } else { - char s[128]; + for (n = 0; callbacks[n].callback; n++) + ; + ret = tail = P_Make_List (Make_Integer (n), Null); + GC_Link2 (ret, tail); + for (i = 0; i < n; i++, tail = Cdr (tail)) + Car (tail) = Get_Callbackfun (callbacks[i].closure); + GC_Unlink; + o = ret; + } else if (t == T_Float) { + o = Make_Reduced_Flonum ((double)*(float *)val); + } else if (t == T_Backing_Store) { + o = Bits_To_Symbols ((unsigned long)*(int *)val, 0, + Backing_Store_Syms); + if (Nullp (o)) + Primitive_Error ("invalid backing-store (Xt bug)"); + } else if (t == T_Boolean) { + o = (Boolean)*(Boolean *)val ? True : False; + } else if (t == T_Colormap) { + o = Make_Colormap (0, dpy, *(Colormap *)val); + } else if (t == T_Cursor) { + o = Make_Cursor_Foreign (dpy, *(Cursor *)val); + } else if (t == T_Gc) { + o = Make_Gc (0, dpy, *(GC *)val); + } else if (t == T_Dimension) { + o = Make_Integer (*(Dimension *)val); + } else if (t == T_Position) { + o = Make_Integer (*(Position *)val); + } else if (t == T_Cardinal) { + o = Make_Unsigned (*(Cardinal *)val); + } else if (t == T_Fixnum) { + if (streq (r[j].resource_type, XtRInt)) + o = Make_Integer (*(int *)val); + else + o = Make_Integer (*(short *)val); + } else if (t == T_Display) { + o = Make_Display (0, dpy); + } else if (t == T_Font) { + if (streq (r[j].resource_type, XtRFontStruct)) { + o = Make_Font_Foreign (dpy, False, (Font)0, + *(XFontStruct **)val); + } else { + XFontStruct *info; + Disable_Interrupts; + info = XQueryFont (dpy, *(Font *)val); + Enable_Interrupts; + o = Make_Font_Foreign (dpy, False, *(Font *)val, info); + } + } else if (t == T_Pixel) { + o = Make_Pixel (*(unsigned long *)val); + } else if (t == T_Pixmap || t == T_Bitmap) { + o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val); + } else if (t == T_Character) { + o = Make_Char (*(unsigned char *)val); + } else if (t == T_Widget) { + o = Make_Widget_Foreign (*(Widget *)val); + } else if (t == T_Window) { + o = Make_Window (0, dpy, *(Window *)val); + } else { + char s[128]; - sprintf (s, "%s: no converter for %s", argl[i].name, - r[j].resource_type); - Primitive_Error (s); - } - Car (tail) = o; + sprintf (s, "%s: no converter for %s", argl[i].name, + r[j].resource_type); + Primitive_Error (s); + } + Car (tail) = o; } XtFree ((char *)r); GC_Unlink; @@ -396,13 +396,13 @@ void Make_Resource_Name (s) register char *s; { register char *p; for (p = s; *s; ) { - if (*s == '-') { - if (*++s) { - if (islower (*s)) - *s = toupper (*s); - *p++ = *s++; - } - } else *p++ = *s++; + if (*s == '-') { + if (*++s) { + if (islower (*s)) + *s = toupper (*s); + *p++ = *s++; + } + } else *p++ = *s++; } *p = '\0'; } @@ -421,14 +421,14 @@ Object Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); { ret = tail = tail2 = P_Make_List (Make_Integer (nr), Null); GC_Link3 (ret, tail, tail2); for (p = r; p < r+nr; p++, tail = Cdr (tail)) { - x = tail2 = P_Make_List (Make_Integer (3), Null); - Car (tail) = tail2 = x; - x = Intern (p->resource_name); - Car (tail2) = x; tail2 = Cdr (tail2); - x = Intern (p->resource_class); - Car (tail2) = x; tail2 = Cdr (tail2); - x = Intern (p->resource_type); - Car (tail2) = x; + x = tail2 = P_Make_List (Make_Integer (3), Null); + Car (tail) = tail2 = x; + x = Intern (p->resource_name); + Car (tail2) = x; tail2 = Cdr (tail2); + x = Intern (p->resource_class); + Car (tail2) = x; tail2 = Cdr (tail2); + x = Intern (p->resource_type); + Car (tail2) = x; } GC_Unlink; if (freeit) XtFree ((char *)r); diff --git a/lib/xt/translation.c b/lib/xt/translation.c index 52bbd95..4db9903 100644 --- a/lib/xt/translation.c +++ b/lib/xt/translation.c @@ -7,7 +7,7 @@ XtTranslations Get_Translations (t) Object t; { Get_Strsym_Stack (t, s); if ((ret = XtParseTranslationTable (s)) == 0) - Primitive_Error ("bad translation table: ~s", t); + Primitive_Error ("bad translation table: ~s", t); Alloca_End; return ret; } @@ -46,12 +46,12 @@ static Object P_Set_Multi_Click_Time (d, t) Object d, t; { elk_init_xt_translation () { Define_Primitive (P_Augment_Translations, - "augment-translations", 2, 2, EVAL); + "augment-translations", 2, 2, EVAL); Define_Primitive (P_Override_Translations, - "override-translations", 2, 2, EVAL); + "override-translations", 2, 2, EVAL); Define_Primitive (P_Uninstall_Translations, - "uninstall-translations", 1, 1, EVAL); + "uninstall-translations", 1, 1, EVAL); Define_Primitive (P_Multi_Click_Time, "multi-click-time", 1, 1, EVAL); Define_Primitive (P_Set_Multi_Click_Time, - "set-multi-click-time!", 2, 2, EVAL); + "set-multi-click-time!", 2, 2, EVAL); } diff --git a/lib/xt/widget.c b/lib/xt/widget.c index 7e1d561..d1ad986 100644 --- a/lib/xt/widget.c +++ b/lib/xt/widget.c @@ -14,17 +14,17 @@ static Object Internal_Make_Widget (finalize, widget) Widget widget; { Object w; if (widget == 0) - return Sym_None; + return Sym_None; w = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, widget); if (Nullp (w)) { - w = Alloc_Object (sizeof (struct S_Widget), T_Widget, 0); - WIDGET(w)->tag = Null; - WIDGET(w)->widget = widget; - WIDGET(w)->free = 0; - XtAddCallback (widget, XtNdestroyCallback, Destroy_Callback_Proc, - (XtPointer)0); - Register_Object (w, (GENERIC)0, - finalize ? P_Destroy_Widget : (PFO)0, 0); + w = Alloc_Object (sizeof (struct S_Widget), T_Widget, 0); + WIDGET(w)->tag = Null; + WIDGET(w)->widget = widget; + WIDGET(w)->free = 0; + XtAddCallback (widget, XtNdestroyCallback, Destroy_Callback_Proc, + (XtPointer)0); + Register_Object (w, (GENERIC)0, + finalize ? P_Destroy_Widget : (PFO)0, 0); } return w; } @@ -41,13 +41,13 @@ Object Make_Widget_Foreign (widget) Widget widget; { void Check_Widget (w) Object w; { Check_Type (w, T_Widget); if (WIDGET(w)->free) - Primitive_Error ("invalid widget: ~s", w); + Primitive_Error ("invalid widget: ~s", w); } void Check_Widget_Class (w, class) Object w; WidgetClass class; { Check_Widget (w); if (XtClass (WIDGET(w)->widget) != class) - Primitive_Error ("widget not of expected class: ~s", w); + Primitive_Error ("widget not of expected class: ~s", w); } static Object P_Destroy_Widget (w) Object w; { @@ -64,14 +64,14 @@ static Object P_Create_Shell (argc, argv) Object *argv; { name = argv[0], class = argv[1], w = argv[2], d = argv[3]; if (!EQ(name, False)) - sn = Get_Strsym (name); + sn = Get_Strsym (name); if (!EQ(class, False)) - sc = Get_Strsym (class); + sc = Get_Strsym (class); Check_Type (w, T_Class); Check_Type (d, T_Display); Encode_Arglist (argc-4, argv+4, a, (Widget)0, CLASS(w)->wclass); ret = Make_Widget (XtAppCreateShell (sn, sc, CLASS(w)->wclass, - DISPLAY(d)->dpy, a, (Cardinal)(argc-4)/2)); + DISPLAY(d)->dpy, a, (Cardinal)(argc-4)/2)); Alloca_End; return ret; } @@ -84,19 +84,19 @@ static Object P_Create_Widget (argc, argv) Object *argv; { x = argv[0]; if (TYPE(x) != T_Class) { - name = Get_Strsym (x); - argv++; argc--; + name = Get_Strsym (x); + argv++; argc--; } class = argv[0]; parent = argv[1]; Check_Type (class, T_Class); Check_Widget (parent); if (name == 0) - name = CLASS(class)->name; + name = CLASS(class)->name; Encode_Arglist (argc-2, argv+2, a, WIDGET(parent)->widget, - CLASS(class)->wclass); + CLASS(class)->wclass); ret = Make_Widget (XtCreateWidget ((String)name, CLASS(class)->wclass, - WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); + WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); Alloca_End; return ret; } @@ -139,7 +139,7 @@ static Object P_Widget_Name (w) Object w; { static Object P_Widget_To_Window (w) Object w; { Check_Widget (w); return Make_Window (0, XtDisplayOfObject (WIDGET(w)->widget), - XtWindow (WIDGET(w)->widget)); + XtWindow (WIDGET(w)->widget)); } static Object P_Widget_Compositep (w) Object w; { @@ -157,11 +157,11 @@ static Object Manage_Unmanage (children, f) Object children; void (*f)(); { n = Fast_Length (children); Alloca (buf, Widget*, n * sizeof (Widget)); for (i = 0, tail = children; i < n; i++, tail = Cdr (tail)) { - Object w; + Object w; - w = Car (tail); - Check_Widget (w); - buf[i] = WIDGET(w)->widget; + w = Car (tail); + Check_Widget (w); + buf[i] = WIDGET(w)->widget; } f (buf, n); Alloca_End; @@ -189,7 +189,7 @@ static Object P_Widget_Class (w) Object w; { static Object P_Widget_Superclass (w) Object w; { Check_Widget (w); if (XtClass (WIDGET(w)->widget) == widgetClass) - return Sym_None; + return Sym_None; return Make_Widget_Class (XtSuperclass (WIDGET(w)->widget)); } @@ -229,8 +229,8 @@ static Object P_Set_Values (argc, argv) Object *argv; { Encode_Arglist (argc-1, argv+1, a, w, XtClass (w)); XtSetValues (w, a, (Cardinal)n); for (i = 0; i < n; i++) - if (streq (a[i].name, XtNdestroyCallback)) - Fiddle_Destroy_Callback (w); + if (streq (a[i].name, XtNdestroyCallback)) + Fiddle_Destroy_Callback (w); Alloca_End; return Void; } @@ -246,7 +246,7 @@ static Object P_Get_Values (argc, argv) Object *argv; { static Object P_Widget_Context (w) Object w; { Check_Widget (w); return - Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget)); + Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget)); } static Object P_Set_Sensitive (w, s) Object w, s; { @@ -264,7 +264,7 @@ static Object P_Sensitivep (w) Object w; { static Object P_Window_To_Widget (w) Object w; { Check_Type (w, T_Window); return Make_Widget_Foreign (XtWindowToWidget (WINDOW(w)->dpy, - WINDOW(w)->win)); + WINDOW(w)->win)); } static Object P_Name_To_Widget (root, name) Object root, name; { @@ -272,7 +272,7 @@ static Object P_Name_To_Widget (root, name) Object root, name; { Check_Widget (root); return Make_Widget_Foreign (XtNameToWidget (WIDGET(root)->widget, - Get_Strsym (name))); + Get_Strsym (name))); } static Object P_Widget_Translate_Coordinates (w, x, y) Object w, x, y; { @@ -280,7 +280,7 @@ static Object P_Widget_Translate_Coordinates (w, x, y) Object w, x, y; { Check_Widget (w); XtTranslateCoords (WIDGET(w)->widget, Get_Integer (x), Get_Integer (y), - &root_x, &root_y); + &root_x, &root_y); return Cons (Make_Integer (root_x), Make_Integer (root_y)); } @@ -299,26 +299,26 @@ static Widget_Visit (root, func) Object *root; int (*func)(); { Widget w = WIDGET(*root)->widget; if (WIDGET(*root)->free == 0 && XtIsComposite (w)) { - int i; - CompositeRec *comp = (CompositeRec *)w; + int i; + CompositeRec *comp = (CompositeRec *)w; - for (i = 0; i < comp->composite.num_children; i++) { - obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, - comp->composite.children[i]); - if (TYPE(obj) == T_Widget) - func (&obj); - } - while (w = XtParent (w)) { - obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); - if (TYPE(obj) == T_Widget) - func (&obj); - } + for (i = 0; i < comp->composite.num_children; i++) { + obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, + comp->composite.children[i]); + if (TYPE(obj) == T_Widget) + func (&obj); + } + while (w = XtParent (w)) { + obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); + if (TYPE(obj) == T_Widget) + func (&obj); + } } } elk_init_xt_widget () { T_Widget = Define_Type (0, "widget", NOFUNC, sizeof (struct S_Widget), - Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit); + Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit); Define_Primitive (P_Widgetp, "widget?", 1, 1, EVAL); Define_Primitive (P_Destroy_Widget, "destroy-widget", 1, 1, EVAL); Define_Primitive (P_Create_Shell, "create-shell", 4, MANY, VARARGS); @@ -338,7 +338,7 @@ elk_init_xt_widget () { Define_Primitive (P_Widget_Superclass, "widget-superclass", 1, 1, EVAL); Define_Primitive (P_Widget_Subclassp, "widget-subclass?", 2, 2, EVAL); Define_Primitive (P_Set_Mapped_When_Managed, - "set-mapped-when-managed!", 2, 2, EVAL); + "set-mapped-when-managed!", 2, 2, EVAL); Define_Primitive (P_Map_Widget, "map-widget", 1, 1, EVAL); Define_Primitive (P_Unmap_Widget, "unmap-widget", 1, 1, EVAL); Define_Primitive (P_Set_Values, "set-values!", 1, MANY, VARARGS); @@ -349,5 +349,5 @@ elk_init_xt_widget () { Define_Primitive (P_Window_To_Widget, "window->widget", 1, 1, EVAL); Define_Primitive (P_Name_To_Widget, "name->widget", 2, 2, EVAL); Define_Primitive (P_Widget_Translate_Coordinates, - "widget-translate-coordinates", 3, 3, EVAL); + "widget-translate-coordinates", 3, 3, EVAL); } diff --git a/lib/xt/xt.h b/lib/xt/xt.h index 8d28a03..66f1bbe 100644 --- a/lib/xt/xt.h +++ b/lib/xt/xt.h @@ -26,9 +26,9 @@ extern int T_Class; extern int T_Widget; extern int T_Identifier; -#define CONTEXT(x) ((struct S_Context *)POINTER(x)) -#define CLASS(x) ((struct S_Class *)POINTER(x)) -#define WIDGET(x) ((struct S_Widget *)POINTER(x)) +#define CONTEXT(x) ((struct S_Context *)POINTER(x)) +#define CLASS(x) ((struct S_Class *)POINTER(x)) +#define WIDGET(x) ((struct S_Widget *)POINTER(x)) #define IDENTIFIER(x) ((struct S_Identifier *)POINTER(x)) struct S_Context { diff --git a/lib/xt/xterror.c b/lib/xt/xterror.c index 3c2626b..31225a9 100644 --- a/lib/xt/xterror.c +++ b/lib/xt/xterror.c @@ -8,7 +8,7 @@ void Xt_Warning (msg) char *msg; { args = Cons (Make_String (msg, strlen (msg)), Null); fun = Var_Get (V_Xt_Warning_Handler); if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); + (void)Funcall (fun, args, 0); Format (Curr_Output_Port, msg, strlen (msg), 0, (Object *)0); (void)P_Newline (0, (Object *)0); } diff --git a/lib/xt/xtinit.c b/lib/xt/xtinit.c index 7997294..2eb542b 100644 --- a/lib/xt/xtinit.c +++ b/lib/xt/xtinit.c @@ -37,11 +37,11 @@ elk_init_xt_init () { dummy(vendorShellWidgetClass); Define_Primitive (P_Xt_Release_4_Or_Laterp, "xt-release-4-or-later?", - 0, 0, EVAL); + 0, 0, EVAL); Define_Primitive (P_Xt_Release_5_Or_Laterp, "xt-release-5-or-later?", - 0, 0, EVAL); + 0, 0, EVAL); Define_Primitive (P_Xt_Release_6_Or_Laterp, "xt-release-6-or-later?", - 0, 0, EVAL); + 0, 0, EVAL); XtToolkitInitialize (); P_Provide (Intern ("xt.so")); P_Provide (Intern ("xt.o")); diff --git a/lib/xt/xtobjects.c b/lib/xt/xtobjects.c index 222cec3..3475074 100644 --- a/lib/xt/xtobjects.c +++ b/lib/xt/xtobjects.c @@ -6,14 +6,14 @@ Match_Xt_Obj (x, v) Object x; va_list v; { register type = TYPE(x); if (type == T_Context) { - return va_arg (v, XtAppContext) == CONTEXT(x)->context; + return va_arg (v, XtAppContext) == CONTEXT(x)->context; } else if (type == T_Class) { - return va_arg (v, WidgetClass) == CLASS(x)->wclass; + return va_arg (v, WidgetClass) == CLASS(x)->wclass; } else if (type == T_Widget) { - return va_arg (v, Widget) == WIDGET(x)->widget; + return va_arg (v, Widget) == WIDGET(x)->widget; } else if (type == T_Identifier) { - return va_arg (v, int) == IDENTIFIER(x)->type - && va_arg (v, XtPointer) == IDENTIFIER(x)->val; + return va_arg (v, int) == IDENTIFIER(x)->type + && va_arg (v, XtPointer) == IDENTIFIER(x)->val; } else Panic ("Match_Xt_Obj"); return 0; } diff --git a/src/autoload.c b/src/autoload.c index f499ab9..699711b 100644 --- a/src/autoload.c +++ b/src/autoload.c @@ -59,14 +59,14 @@ Object Do_Autoload (Object sym, Object al) { GC_Node; if (Var_Is_True (V_Autoload_Notifyp)) { - a[0] = AUTOLOAD(al)->files; - Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); + a[0] = AUTOLOAD(al)->files; + Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); } GC_Link (sym); (void)General_Load (AUTOLOAD(al)->files, AUTOLOAD(al)->env); GC_Unlink; val = SYMBOL(sym)->value; if (TYPE(val) == T_Autoload) - Primitive_Error ("autoloading failed to define ~s", sym); + Primitive_Error ("autoloading failed to define ~s", sym); return val; } diff --git a/src/bignum.c b/src/bignum.c index 512d0b9..df59d6e 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -42,7 +42,7 @@ Object Make_Uninitialized_Bignum (int size) { Object big; big = Alloc_Object ((sizeof (struct S_Bignum) - sizeof (gran_t)) + - (size * sizeof (gran_t)), T_Bignum, 0); + (size * sizeof (gran_t)), T_Bignum, 0); BIGNUM(big)->minusp = False; BIGNUM(big)->size = size; BIGNUM(big)->usize = 0; @@ -84,14 +84,14 @@ Object Make_Bignum (char const *buf, int neg, int radix) { BIGNUM(big)->minusp = neg ? True : False; p = buf; while ((c = *p++)) { - Bignum_Mult_In_Place (BIGNUM(big), radix); - if (radix == 16) { - if (isupper (c)) - c = tolower (c); - if (c >= 'a') - c = '9' + c - 'a' + 1; - } - Bignum_Add_In_Place (BIGNUM(big), c - '0'); + Bignum_Mult_In_Place (BIGNUM(big), radix); + if (radix == 16) { + if (isupper (c)) + c = tolower (c); + if (c >= 'a') + c = '9' + c - 'a' + 1; + } + Bignum_Add_In_Place (BIGNUM(big), c - '0'); } Bignum_Normalize_In_Place (BIGNUM(big)); /* to avoid -0 */ return big; @@ -103,17 +103,17 @@ Object Reduce_Bignum (Object x) { int digits = sizeof(int)/2; if (size > digits) - return x; + return x; for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned int)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned int)0 >> 1) + 1) - return x; - return Make_Integer (-ret); + if (ret > (~(unsigned int)0 >> 1) + 1) + return x; + return Make_Integer (-ret); } else { - if (ret > ~(unsigned int)0 >> 1) - return x; - return Make_Integer (ret); + if (ret > ~(unsigned int)0 >> 1) + return x; + return Make_Integer (ret); } } @@ -124,15 +124,15 @@ static void Bignum_Mult_In_Place (register struct S_Bignum *x, int n) { register unsigned int k = 0; for (j = 0; j < i; ++j) { - k += n * *p; + k += n * *p; *p++ = k; - k >>= 16; + k >>= 16; } if (k) { - if (i >= x->size) - Panic ("Bignum_Mult_In_Place"); - *p++ = k; - x->usize++; + if (i >= x->size) + Panic ("Bignum_Mult_In_Place"); + *p++ = k; + x->usize++; } } @@ -146,16 +146,16 @@ static void Bignum_Add_In_Place (register struct S_Bignum *x, int n) { k += *p; *p++ = k; while (k >>= 16) { - if (++j >= i) { + if (++j >= i) { extend: - if (i >= x->size) - Panic ("Bignum_Add_In_Place"); - *p++ = k; - x->usize++; - return; - } - k += *p; - *p++ = k; + if (i >= x->size) + Panic ("Bignum_Add_In_Place"); + *p++ = k; + x->usize++; + return; + } + k += *p; + *p++ = k; } } @@ -164,10 +164,10 @@ static int Bignum_Div_In_Place (register struct S_Bignum *x, int n) { register gran_t *p = x->data + i; register unsigned int k = 0; for ( ; i; --i) { - k <<= 16; - k += *--p; - *p = k / n; - k %= n; + k <<= 16; + k += *--p; + *p = k / n; + k %= n; } Bignum_Normalize_In_Place (x); return k; @@ -177,10 +177,10 @@ void Bignum_Normalize_In_Place (register struct S_Bignum *x) { register int i = x->usize; register gran_t *p = x->data + i; while (i && !*--p) - --i; + --i; x->usize = i; if (!i) - x->minusp = False; + x->minusp = False; } void Print_Bignum (Object port, Object x) { @@ -191,8 +191,8 @@ void Print_Bignum (Object port, Object x) { Alloca_Begin; if (Bignum_Zero (x)) { - Printf (port, "0"); - return; + Printf (port, "0"); + return; } size = BIGNUM(x)->usize * 5 + 3; @@ -201,25 +201,25 @@ void Print_Bignum (Object port, Object x) { *p = 0; size = (sizeof (struct S_Bignum) - sizeof (gran_t)) - + BIGNUM(x)->usize * sizeof (gran_t); + + BIGNUM(x)->usize * sizeof (gran_t); Alloca (big, struct S_Bignum*, size); memcpy (big, POINTER(x), size); big->size = BIGNUM(x)->usize; while (big->usize) { - register unsigned int bigdig = Bignum_Div_In_Place (big, 10000); - *--p = '0' + bigdig % 10; - bigdig /= 10; - *--p = '0' + bigdig % 10; - bigdig /= 10; - *--p = '0' + bigdig % 10; - bigdig /= 10; - *--p = '0' + bigdig; + register unsigned int bigdig = Bignum_Div_In_Place (big, 10000); + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig; } while (*p == '0') - ++p; + ++p; if (Truep (BIGNUM(x)->minusp)) - Printf (port, "-"); + Printf (port, "-"); Format (port, p, strlen (p), 0, (Object *)0); Alloca_End; } @@ -233,7 +233,7 @@ Object Bignum_To_String (Object x, int radix) { Alloca_Begin; if (Bignum_Zero (x)) - return Make_String ("0", 1); + return Make_String ("0", 1); size = BIGNUM(x)->usize * (radix == 2 ? 17 : 6) + 3; Alloca (buf, char*, size + 1); @@ -241,37 +241,37 @@ Object Bignum_To_String (Object x, int radix) { *p = 0; size = (sizeof (struct S_Bignum) - sizeof (gran_t)) - + BIGNUM(x)->usize * sizeof (gran_t); + + BIGNUM(x)->usize * sizeof (gran_t); Alloca (big, struct S_Bignum*, size); memcpy (big, POINTER(x), size); big->size = BIGNUM(x)->usize; switch (radix) { case 2: - div = 65536; ndig = 16; break; + div = 65536; ndig = 16; break; case 8: - div = 32768; ndig = 5; break; + div = 32768; ndig = 5; break; case 10: - div = 10000; ndig = 4; break; + div = 10000; ndig = 4; break; case 16: default: /* Just to avoid compiler warnings */ - div = 65536; ndig = 4; break; + div = 65536; ndig = 4; break; } while (big->usize) { - register unsigned int bigdig = Bignum_Div_In_Place (big, div); - register unsigned int i; - for (i = 0; i < ndig; i++) { - *--p = '0' + bigdig % radix; - if (*p > '9') - *p = 'A' + (*p - '9') - 1; - bigdig /= radix; - } + register unsigned int bigdig = Bignum_Div_In_Place (big, div); + register unsigned int i; + for (i = 0; i < ndig; i++) { + *--p = '0' + bigdig % radix; + if (*p > '9') + *p = 'A' + (*p - '9') - 1; + bigdig /= radix; + } } while (*p == '0') - ++p; + ++p; if (Truep (BIGNUM(x)->minusp)) - *--p = '-'; + *--p = '-'; ret = Make_String (p, strlen (p)); Alloca_End; return ret; @@ -284,17 +284,17 @@ int Bignum_To_Integer (Object x) { if (size > digits) err: - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned int)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned int)0 >> 1) + 1) - goto err; - return -ret; + if (ret > (~(unsigned int)0 >> 1) + 1) + goto err; + return -ret; } else { - if (ret > ~(unsigned int)0 >> 1) - goto err; - return ret; + if (ret > ~(unsigned int)0 >> 1) + goto err; + return ret; } } @@ -304,9 +304,9 @@ unsigned int Bignum_To_Unsigned (Object x) { int digits = sizeof(int)/2; if (size > digits || Truep (BIGNUM(x)->minusp)) - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned int)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; return ret; } @@ -317,17 +317,17 @@ long Bignum_To_Long (Object x) { if (size > digits) err: - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; + ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned long int)0 >> 1) + 1) - goto err; - return -ret; + if (ret > (~(unsigned long int)0 >> 1) + 1) + goto err; + return -ret; } else { - if (ret > ~(unsigned long int)0 >> 1) - goto err; - return ret; + if (ret > ~(unsigned long int)0 >> 1) + goto err; + return ret; } } @@ -337,9 +337,9 @@ unsigned long int Bignum_To_Unsigned_Long (Object x) { int digits = sizeof(long)/2; if (size > digits || Truep (BIGNUM(x)->minusp)) - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; + ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; return ret; } @@ -350,11 +350,11 @@ Object Integer_To_Bignum (int i) { big = Make_Uninitialized_Bignum (digits); if (i < 0) { - BIGNUM(big)->minusp = True; - n = -i; + BIGNUM(big)->minusp = True; + n = -i; } for (k = 0; k < digits; k++, n >>= 16) - BIGNUM(big)->data[k] = n & 0xffff; + BIGNUM(big)->data[k] = n & 0xffff; BIGNUM(big)->usize = k; Bignum_Normalize_In_Place (BIGNUM(big)); return big; @@ -366,7 +366,7 @@ Object Unsigned_To_Bignum (unsigned int i) { big = Make_Uninitialized_Bignum (digits); for (k = 0; k < digits; k++, i >>= 16) - BIGNUM(big)->data[k] = i & 0xffff; + BIGNUM(big)->data[k] = i & 0xffff; BIGNUM(big)->usize = k; Bignum_Normalize_In_Place (BIGNUM(big)); return big; @@ -379,11 +379,11 @@ Object Long_To_Bignum (long i) { big = Make_Uninitialized_Bignum (digits); if (i < 0) { - BIGNUM(big)->minusp = True; - n = -i; + BIGNUM(big)->minusp = True; + n = -i; } for (k = 0; k < digits; k++, n >>= 16) - BIGNUM(big)->data[k] = n & 0xffff; + BIGNUM(big)->data[k] = n & 0xffff; BIGNUM(big)->usize = k; Bignum_Normalize_In_Place (BIGNUM(big)); return big; @@ -395,7 +395,7 @@ Object Unsigned_Long_To_Bignum (unsigned long int i) { big = Make_Uninitialized_Bignum (digits); for (k = 0; k < digits; k++, i >>= 16) - BIGNUM(big)->data[k] = i & 0xffff; + BIGNUM(big)->data[k] = i & 0xffff; BIGNUM(big)->usize = k; Bignum_Normalize_In_Place (BIGNUM(big)); return big; @@ -408,25 +408,25 @@ Object Double_To_Bignum (double d) { /* Truncates the double */ register gran_t *p; if (expo <= 0 || mantissa == 0.0) - return Make_Uninitialized_Bignum (0); + return Make_Uninitialized_Bignum (0); size = (expo + (16-1)) / 16; big = Make_Uninitialized_Bignum (size); BIGNUM(big)->usize = size; if (mantissa < 0.0) { - BIGNUM(big)->minusp = True; - mantissa = -mantissa; + BIGNUM(big)->minusp = True; + mantissa = -mantissa; } p = BIGNUM(big)->data; memset (p, 0, size * sizeof (gran_t)); p += size; if (expo &= (16-1)) - mantissa = ldexp (mantissa, expo - 16); + mantissa = ldexp (mantissa, expo - 16); while (mantissa != 0.0) { - if (--size < 0) - break; /* inexact */ - mantissa *= 65536.0; - *--p = (int)mantissa; - mantissa -= *p; + if (--size < 0) + break; /* inexact */ + mantissa *= 65536.0; + *--p = (int)mantissa; + mantissa -= *p; } Bignum_Normalize_In_Place (BIGNUM(big)); /* Probably not needed */ return Reduce_Bignum (big); @@ -438,13 +438,13 @@ double Bignum_To_Double (Object x) { /* error if it ain't fit */ register gran_t *p = BIGNUM(x)->data + i; for (i = BIGNUM(x)->usize; --i >= 0; ) { - if (rx >= HUGE / 65536.0) - Primitive_Error ("cannot coerce to real: ~s", x); - rx *= 65536.0; - rx += *--p; + if (rx >= HUGE / 65536.0) + Primitive_Error ("cannot coerce to real: ~s", x); + rx *= 65536.0; + rx += *--p; } if (Truep (BIGNUM(x)->minusp)) - rx = -rx; + rx = -rx; return rx; } @@ -476,18 +476,18 @@ int Bignum_Mantissa_Cmp (register struct S_Bignum *x, register struct S_Bignum *y) { register unsigned int i = x->usize; if (i < y->usize) - return -1; + return -1; else if (i > y->usize) - return 1; + return 1; else { - register gran_t *xbuf = x->data + i; - register gran_t *ybuf = y->data + i; - for ( ; i; --i) { - register int n; - if ((n = (int)*--xbuf - (int)*--ybuf)) - return n; - } - return 0; + register gran_t *xbuf = x->data + i; + register gran_t *ybuf = y->data + i; + for ( ; i; --i) { + register int n; + if ((n = (int)*--xbuf - (int)*--ybuf)) + return n; + } + return 0; } } @@ -495,13 +495,13 @@ int Bignum_Cmp (register struct S_Bignum *x, register struct S_Bignum *y) { register int xm = Truep (x->minusp); register int ym = Truep (y->minusp); if (xm) { - if (ym) - return -Bignum_Mantissa_Cmp (x, y); - else return -1; + if (ym) + return -Bignum_Mantissa_Cmp (x, y); + else return -1; } else { - if (ym) - return 1; - else return Bignum_Mantissa_Cmp (x, y); + if (ym) + return 1; + else return Bignum_Mantissa_Cmp (x, y); } } @@ -536,55 +536,55 @@ Object General_Bignum_Plus_Minus (Object x, Object y, int neg) { xminusp = Truep (BIGNUM(x)->minusp); yminusp = Truep (BIGNUM(y)->minusp); if (neg) - yminusp = !yminusp; + yminusp = !yminusp; size = xsize > ysize ? xsize : ysize; if (xminusp == yminusp) - size++; + size++; big = Make_Uninitialized_Bignum (size); BIGNUM(big)->usize = size; GC_Unlink; if (xminusp == yminusp) { - /* Add x and y */ - register unsigned int k = 0; - register int i; - register gran_t *xbuf = BIGNUM(x)->data; - register gran_t *ybuf = BIGNUM(y)->data; - register gran_t *zbuf = BIGNUM(big)->data; - for (i = 0; i < size; ++i) { - if (i < xsize) - k += *xbuf++; - if (i < ysize) - k += *ybuf++; - *zbuf++ = k; - k >>= 16; - } + /* Add x and y */ + register unsigned int k = 0; + register int i; + register gran_t *xbuf = BIGNUM(x)->data; + register gran_t *ybuf = BIGNUM(y)->data; + register gran_t *zbuf = BIGNUM(big)->data; + for (i = 0; i < size; ++i) { + if (i < xsize) + k += *xbuf++; + if (i < ysize) + k += *ybuf++; + *zbuf++ = k; + k >>= 16; + } } else { - if (Bignum_Mantissa_Cmp (BIGNUM(x), BIGNUM(y)) < 0) { - Object temp; + if (Bignum_Mantissa_Cmp (BIGNUM(x), BIGNUM(y)) < 0) { + Object temp; - temp = x; x = y; y = temp; - xsize = ysize; - ysize = BIGNUM(y)->usize; - xminusp = yminusp; - } - /* Subtract y from x */ + temp = x; x = y; y = temp; + xsize = ysize; + ysize = BIGNUM(y)->usize; + xminusp = yminusp; + } + /* Subtract y from x */ { - register unsigned int k = 1; - register int i; - register gran_t *xbuf = BIGNUM(x)->data; - register gran_t *ybuf = BIGNUM(y)->data; - register gran_t *zbuf = BIGNUM(big)->data; - for (i = 0; i < size; ++i) { - if (i < xsize) - k += *xbuf++; - else Panic ("General_Bignum_Plus_Minus"); - if (i < ysize) - k += ~*ybuf++ & 0xFFFF; - else k += 0xFFFF; - *zbuf++ = k; - k >>= 16; - } + register unsigned int k = 1; + register int i; + register gran_t *xbuf = BIGNUM(x)->data; + register gran_t *ybuf = BIGNUM(y)->data; + register gran_t *zbuf = BIGNUM(big)->data; + for (i = 0; i < size; ++i) { + if (i < xsize) + k += *xbuf++; + else Panic ("General_Bignum_Plus_Minus"); + if (i < ysize) + k += ~*ybuf++ & 0xFFFF; + else k += 0xFFFF; + *zbuf++ = k; + k >>= 16; + } } } BIGNUM(big)->minusp = xminusp ? True : False; @@ -614,25 +614,25 @@ Object Bignum_Fixnum_Multiply (Object x, Object y) { /* bignum * fixnum */ big = Make_Uninitialized_Bignum (size); BIGNUM(big)->usize = size; if (Truep (BIGNUM(x)->minusp) != (fix < 0)) - BIGNUM(big)->minusp = True; + BIGNUM(big)->minusp = True; memset (BIGNUM(big)->data, 0, size * sizeof (gran_t)); xbuf = BIGNUM(x)->data; if (fix < 0) - fix = -fix; + fix = -fix; yl = fix & 0xFFFF; yh = fix >> 16; zbuf = BIGNUM(big)->data; for (i = 0; i < xsize; ++i) { - register unsigned int xf = xbuf[i]; - register unsigned int k = 0; - register gran_t *r = zbuf + i; - k += xf * yl + *r; - *r++ = k; - k >>= 16; - k += xf * yh + *r; - *r++ = k; - k >>= 16; - *r = k; + register unsigned int xf = xbuf[i]; + register unsigned int k = 0; + register gran_t *r = zbuf + i; + k += xf * yl + *r; + *r++ = k; + k >>= 16; + k += xf * yh + *r; + *r++ = k; + k >>= 16; + *r = k; } GC_Unlink; Bignum_Normalize_In_Place (BIGNUM(big)); @@ -652,22 +652,22 @@ Object Bignum_Multiply (Object x, Object y) { /* bignum * bignum */ big = Make_Uninitialized_Bignum (size); BIGNUM(big)->usize = size; if (!EQ(BIGNUM(x)->minusp, BIGNUM(y)->minusp)) - BIGNUM(big)->minusp = True; + BIGNUM(big)->minusp = True; memset (BIGNUM(big)->data, 0, size * sizeof (gran_t)); xbuf = BIGNUM(x)->data; ybuf = BIGNUM(y)->data; zbuf = BIGNUM(big)->data; for (i = 0; i < xsize; ++i) { - register unsigned int xf = xbuf[i]; - register unsigned int k = 0; - register gran_t *p = ybuf; - register gran_t *r = zbuf + i; - for (j = 0; j < ysize; ++j) { - k += xf * *p++ + *r; - *r++ = k; - k >>= 16; - } - *r = k; + register unsigned int xf = xbuf[i]; + register unsigned int k = 0; + register gran_t *p = ybuf; + register gran_t *r = zbuf + i; + for (j = 0; j < ysize; ++j) { + k += xf * *p++ + *r; + *r++ = k; + k >>= 16; + } + *r = k; } GC_Unlink; Bignum_Normalize_In_Place (BIGNUM(big)); @@ -687,33 +687,33 @@ Object Bignum_Fixnum_Divide (Object x, Object y) { /* bignum / fixnum */ GC_Link (x); if (fix < 0) { - fix = -fix; - yminusp = 1; + fix = -fix; + yminusp = 1; } if (fix > 0xFFFF) { - big = Integer_To_Bignum (FIXNUM(y)); - GC_Unlink; - return Bignum_Divide (x, big); + big = Integer_To_Bignum (FIXNUM(y)); + GC_Unlink; + return Bignum_Divide (x, big); } xsize = BIGNUM(x)->usize; big = Make_Uninitialized_Bignum (xsize); BIGNUM(big)->usize = xsize; xminusp = Truep (BIGNUM(x)->minusp); if (xminusp != yminusp) - BIGNUM(big)->minusp = True; + BIGNUM(big)->minusp = True; xbuf = BIGNUM(x)->data; zbuf = BIGNUM(big)->data; rem = 0; for (i = xsize; --i >= 0; ) { - rem <<= 16; - rem += xbuf[i]; - zbuf[i] = rem / fix; - rem %= fix; + rem <<= 16; + rem += xbuf[i]; + zbuf[i] = rem / fix; + rem %= fix; } GC_Unlink; Bignum_Normalize_In_Place (BIGNUM(big)); if (xminusp) - rem = -(int)rem; + rem = -(int)rem; return Cons (Reduce_Bignum (big), Make_Integer ((int)rem)); } @@ -729,26 +729,26 @@ Object Bignum_Divide (Object x, Object y) { /* bignum / bignum */ Alloca_Begin; if (BIGNUM(y)->usize < 2) - return Bignum_Fixnum_Divide (x, Make_Integer (Bignum_To_Integer (y))); + return Bignum_Fixnum_Divide (x, Make_Integer (Bignum_To_Integer (y))); GC_Link2 (x, y); quotsize = BIGNUM(x)->usize - BIGNUM(y)->usize + 1; if (quotsize < 0) - quotsize = 0; + quotsize = 0; quot = Make_Uninitialized_Bignum (quotsize); GC_Unlink; dendsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) - + (BIGNUM(x)->usize + 1) * sizeof (gran_t); + + (BIGNUM(x)->usize + 1) * sizeof (gran_t); Alloca (dend, struct S_Bignum*, dendsize); memcpy (dend, POINTER(x), dendsize); dend->size = BIGNUM(x)->usize + 1; if (quotsize == 0 || Bignum_Mantissa_Cmp (dend, BIGNUM(y)) < 0) - goto zero; + goto zero; dorsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) - + BIGNUM (y)->usize * sizeof (gran_t); + + BIGNUM (y)->usize * sizeof (gran_t); Alloca (dor, struct S_Bignum*, dorsize); memcpy (dor, POINTER(y), dorsize); dor->size = dorsize = BIGNUM(y)->usize; @@ -756,7 +756,7 @@ Object Bignum_Divide (Object x, Object y) { /* bignum / bignum */ scale = 65536 / (unsigned int)(dor->data[dor->usize - 1] + 1); Bignum_Mult_In_Place (dend, scale); if (dend->usize < dend->size) - dend->data[dend->usize++] = 0; + dend->data[dend->usize++] = 0; Bignum_Mult_In_Place (dor, scale); BIGNUM(quot)->usize = BIGNUM(quot)->size; @@ -766,61 +766,61 @@ Object Bignum_Divide (Object x, Object y) { /* bignum / bignum */ dor2 = dor->data[dor->usize - 2]; while (qp > BIGNUM(quot)->data) { - unsigned int msw, guess; - int k; - register gran_t *dep, *dop, *edop; + unsigned int msw, guess; + int k; + register gran_t *dep, *dop, *edop; - msw = dendp[-1] << 16 | dendp[-2]; - guess = msw / dor1; - if (guess >= 65536) /* [65535, 0, 0] / [65535, 65535] */ - guess = 65535; - for (;;) { - unsigned int d1, d2, d3; - d3 = dor2 * guess; - d2 = dor1 * guess + (d3 >> 16); - d3 &= 0xFFFF; - d1 = d2 >> 16; - d2 &= 0xFFFF; - if (d1 < dendp[-1] || (d1 == dendp[-1] && - (d2 < dendp[-2] || (d2 == dendp[-2] && - d3 <= dendp[-3])))) - break; - --guess; - } - --dendp; - k = 0; - dep = dendp - dorsize; - for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { - register unsigned int prod = *dop++ * guess; - k += *dep; - k -= prod & 0xFFFF; - *dep++ = k; - ASR(k, 16); - k -= prod >> 16; - } - k += *dep; - *dep = k; - if (k < 0) { - k = 0; - dep = dendp - dorsize; - for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { - k += *dep + *dop++; - *dep++ = k; - ASR(k, 16); - } - k += *dep; - *dep = k; - --guess; - } - *--qp = guess; + msw = dendp[-1] << 16 | dendp[-2]; + guess = msw / dor1; + if (guess >= 65536) /* [65535, 0, 0] / [65535, 65535] */ + guess = 65535; + for (;;) { + unsigned int d1, d2, d3; + d3 = dor2 * guess; + d2 = dor1 * guess + (d3 >> 16); + d3 &= 0xFFFF; + d1 = d2 >> 16; + d2 &= 0xFFFF; + if (d1 < dendp[-1] || (d1 == dendp[-1] && + (d2 < dendp[-2] || (d2 == dendp[-2] && + d3 <= dendp[-3])))) + break; + --guess; + } + --dendp; + k = 0; + dep = dendp - dorsize; + for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { + register unsigned int prod = *dop++ * guess; + k += *dep; + k -= prod & 0xFFFF; + *dep++ = k; + ASR(k, 16); + k -= prod >> 16; + } + k += *dep; + *dep = k; + if (k < 0) { + k = 0; + dep = dendp - dorsize; + for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { + k += *dep + *dop++; + *dep++ = k; + ASR(k, 16); + } + k += *dep; + *dep = k; + --guess; + } + *--qp = guess; } if (Bignum_Div_In_Place (dend, scale)) - Panic ("Bignum_Div scale"); + Panic ("Bignum_Div scale"); zero: dend->minusp = BIGNUM(x)->minusp; if (Truep (dend->minusp) != Truep (BIGNUM(y)->minusp)) - BIGNUM(quot)->minusp = True; + BIGNUM(quot)->minusp = True; Bignum_Normalize_In_Place (BIGNUM(quot)); Bignum_Normalize_In_Place (dend); GC_Link (quot); diff --git a/src/bool.c b/src/bool.c index d6d1362..cdeafee 100644 --- a/src/bool.c +++ b/src/bool.c @@ -57,26 +57,26 @@ Object P_Equal (Object x1, Object x2) { int Eqv (Object x1, Object x2) { register int t1, t2; if (EQ(x1, x2)) - return 1; + return 1; t1 = TYPE(x1); t2 = TYPE(x2); if (Numeric (t1) && Numeric (t2)) - return Generic_Equal (x1, x2); + return Generic_Equal (x1, x2); if (t1 != t2) - return 0; + return 0; switch (t1) { case T_String: return STRING(x1)->size == 0 && STRING(x2)->size == 0; case T_Vector: - return VECTOR(x1)->size == 0 && VECTOR(x2)->size == 0; + return VECTOR(x1)->size == 0 && VECTOR(x2)->size == 0; case T_Primitive: - return strcmp (PRIM(x1)->name, PRIM(x2)->name) == 0; + return strcmp (PRIM(x1)->name, PRIM(x2)->name) == 0; default: - if (t1 < 0 || t1 >= Num_Types) - Panic ("bad type in eqv"); - if (Types[t1].eqv == NOFUNC) - return 0; - return (Types[t1].eqv)(x1, x2); + if (t1 < 0 || t1 >= Num_Types) + Panic ("bad type in eqv"); + if (Types[t1].eqv == NOFUNC) + return 0; + return (Types[t1].eqv)(x1, x2); } /*NOTREACHED*/ } @@ -86,13 +86,13 @@ int Equal (Object x1, Object x2) { again: if (EQ(x1, x2)) - return 1; + return 1; t1 = TYPE(x1); t2 = TYPE(x2); if (Numeric (t1) && Numeric (t2)) - return Generic_Equal (x1, x2); + return Generic_Equal (x1, x2); if (t1 != t2) - return 0; + return 0; switch (t1) { case T_Boolean: case T_Character: @@ -101,39 +101,39 @@ again: case T_Promise: case T_Port: case T_Macro: - return 0; + return 0; case T_Primitive: case T_Environment: - return Eqv (x1, x2); + return Eqv (x1, x2); case T_Symbol: { - struct S_Symbol *p1 = SYMBOL(x1), *p2 = SYMBOL(x2); - return Equal (p1->name, p2->name) && Equal (p1->plist, p2->plist); + struct S_Symbol *p1 = SYMBOL(x1), *p2 = SYMBOL(x2); + return Equal (p1->name, p2->name) && Equal (p1->plist, p2->plist); } case T_Pair: - if (!Equal (Car (x1), Car (x2))) - return 0; - x1 = Cdr (x1); x2 = Cdr (x2); - goto again; + if (!Equal (Car (x1), Car (x2))) + return 0; + x1 = Cdr (x1); x2 = Cdr (x2); + goto again; case T_String: { - struct S_String *p1 = STRING(x1), *p2 = STRING(x2); - return p1->size == p2->size && - bcmp (p1->data, p2->data, p1->size) == 0; + struct S_String *p1 = STRING(x1), *p2 = STRING(x2); + return p1->size == p2->size && + bcmp (p1->data, p2->data, p1->size) == 0; } case T_Vector: { - struct S_Vector *p1 = VECTOR(x1), *p2 = VECTOR(x2); - if (p1->size != p2->size) - return 0; - for (i = 0; i < p1->size; i++) - if (!Equal (p1->data[i], p2->data[i])) - return 0; - return 1; + struct S_Vector *p1 = VECTOR(x1), *p2 = VECTOR(x2); + if (p1->size != p2->size) + return 0; + for (i = 0; i < p1->size; i++) + if (!Equal (p1->data[i], p2->data[i])) + return 0; + return 1; } default: - if (t1 < 0 || t1 >= Num_Types) - Panic ("bad type in equal"); - if (Types[t1].equal == NOFUNC) - return 0; - return (Types[t1].equal)(x1, x2); + if (t1 < 0 || t1 >= Num_Types) + Panic ("bad type in equal"); + if (Types[t1].equal == NOFUNC) + return 0; + return (Types[t1].equal)(x1, x2); } /*NOTREACHED*/ } @@ -141,8 +141,8 @@ again: Object P_Empty_List_Is_False (Object is_false) { Check_Type (is_false, T_Boolean); if (Truep (is_false)) - False2 = Null; + False2 = Null; else - False2 = False; + False2 = False; return Void; } diff --git a/src/char.c b/src/char.c index 4d475e7..6bddc6f 100644 --- a/src/char.c +++ b/src/char.c @@ -52,7 +52,7 @@ Object P_Integer_To_Char (Object n) { register int i; if ((i = Get_Exact_Integer (n)) < 0 || i > 255) - Range_Error (n); + Range_Error (n); return Make_Char (i); } @@ -98,7 +98,7 @@ int General_Chrcmp (Object c1, Object c2, register int ci) { Check_Type (c1, T_Character); Check_Type (c2, T_Character); if (ci) - return Char_Map[CHAR(c1)] - Char_Map[CHAR(c2)]; + return Char_Map[CHAR(c1)] - Char_Map[CHAR(c2)]; return CHAR(c1) - CHAR(c2); } diff --git a/src/cont.c b/src/cont.c index 6fd5c1b..7188dab 100644 --- a/src/cont.c +++ b/src/cont.c @@ -144,18 +144,18 @@ void Jump_Cont (struct S_Control *cp, Object val) { p = cp; Cont_Value = val; if (Stack_Grows_Down) { - if (stkbase - &foo < p->size) Grow_Stack (cp, val); - to = stkbase - p->size; + if (stkbase - &foo < p->size) Grow_Stack (cp, val); + to = stkbase - p->size; } else { - if (stkbase + p->size > &foo) Grow_Stack (cp, val); - to = stkbase; + if (stkbase + p->size > &foo) Grow_Stack (cp, val); + to = stkbase; } from = p->stack; #if defined(sparc) || defined(__sparc__) __asm__("t 0x3"); /* Flush register window */ #endif for (i = p->size; i > 0; i--) - *to++ = *from++; + *to++ = *from++; longjmp (p->j, 1); } @@ -175,7 +175,7 @@ Object P_Call_With_Current_Continuation (Object proc) { t = TYPE(proc); if (t != T_Primitive && t != T_Compound && t != T_Control_Point) - Wrong_Type_Combination (proc, "procedure"); + Wrong_Type_Combination (proc, "procedure"); return Internal_Call_CC (0, proc); } @@ -195,7 +195,7 @@ Object Internal_Call_CC (int from_dump, Object proc) { size = Stack_Size (); size = (size + 7) & ~7; control = Alloc_Object (size + sizeof (struct S_Control) - 1, - T_Control_Point, 0); + T_Control_Point, 0); cp = CONTROL(control); cp->env = The_Environment; cp->gclist = GC_List; @@ -224,23 +224,23 @@ Object Internal_Call_CC (int from_dump, Object proc) { #endif if (setjmp (CONTROL(control)->j) != 0) { #ifndef USE_ALLOCA - Restore_GC_Nodes (Cont_GCsave); + Restore_GC_Nodes (Cont_GCsave); #endif - if (Intr_Level == 0) { - Force_Enable_Interrupts; - } else { - Force_Disable_Interrupts; - } - return Cont_Value; + if (Intr_Level == 0) { + Force_Enable_Interrupts; + } else { + Force_Disable_Interrupts; + } + return Cont_Value; } if (from_dump) { #ifdef CAN_DUMP - Dump_Control_Point = control; + Dump_Control_Point = control; #endif - ret = False; + ret = False; } else { - control = Cons (control, Null); - ret = Funcall (proc, control, 0); + control = Cons (control, Null); + ret = Funcall (proc, control, 0); } GC_Unlink; return ret; @@ -254,33 +254,33 @@ void Funcall_Control_Point (Object control, Object argl, int eval) { GC_Node3; if (GC_In_Progress) - Fatal_Error ("jumping out of GC"); + Fatal_Error ("jumping out of GC"); val = Null; GC_Link3 (argl, control, val); len = P_Length (argl); if (FIXNUM(len) != 1) - Primitive_Error ("control point expects one argument"); + Primitive_Error ("control point expects one argument"); val = Car (argl); if (eval) - val = Eval (val); + val = Eval (val); delta = CONTROL(control)->delta; wp = First_Wind; cwp = CONTROL(control)->firstwind; while (wp && cwp) { - p = (WIND *)NORM(wp); - if (!EQ(wp->inout,p->inout)) break; - wp = wp->next; - cwp = p->next; + p = (WIND *)NORM(wp); + if (!EQ(wp->inout,p->inout)) break; + wp = wp->next; + cwp = p->next; } if (wp) { - for (w = Last_Wind; w != wp->prev; w = w->prev) - Do_Wind (Cdr (w->inout)); + for (w = Last_Wind; w != wp->prev; w = w->prev) + Do_Wind (Cdr (w->inout)); } while (cwp) { - delta = CONTROL(control)->delta; - p = (WIND *)NORM(cwp); - cwp = p->next; - Do_Wind (Car (p->inout)); + delta = CONTROL(control)->delta; + p = (WIND *)NORM(cwp); + cwp = p->next; + Do_Wind (Car (p->inout)); } GC_Unlink; Disable_Interrupts; @@ -302,19 +302,19 @@ void Do_Wind (Object w) { Object oldenv, b, tmp; if (TYPE(w) == T_Vector) { /* fluid-let */ - oldenv = The_Environment; - Switch_Environment (VECTOR(w)->data[1]); - b = Lookup_Symbol (VECTOR(w)->data[0], 0); - if (Nullp (b)) - Panic ("fluid-let"); - tmp = VECTOR(w)->data[2]; - VECTOR(w)->data[2] = Cdr (b); - Cdr (b) = tmp; - SYMBOL(Car (b))->value = tmp; - VECTOR(w)->data[1] = oldenv; - Switch_Environment (oldenv); + oldenv = The_Environment; + Switch_Environment (VECTOR(w)->data[1]); + b = Lookup_Symbol (VECTOR(w)->data[0], 0); + if (Nullp (b)) + Panic ("fluid-let"); + tmp = VECTOR(w)->data[2]; + VECTOR(w)->data[2] = Cdr (b); + Cdr (b) = tmp; + SYMBOL(Car (b))->value = tmp; + VECTOR(w)->data[1] = oldenv; + Switch_Environment (oldenv); } else { /* dynamic-wind */ - (void)Funcall (w, Null, 0); + (void)Funcall (w, Null, 0); } } @@ -327,9 +327,9 @@ void Add_Wind (register WIND *w, Object in, Object out) { w->inout = inout; w->next = 0; if (First_Wind == 0) - First_Wind = w; + First_Wind = w; else - Last_Wind->next = w; + Last_Wind->next = w; w->prev = Last_Wind; Last_Wind = w; GC_Unlink; @@ -350,7 +350,7 @@ Object P_Dynamic_Wind (Object in, Object body, Object out) { ret = Funcall (body, Null, 0); (void)Funcall (out, Null, 0); if ((Last_Wind = w.prev)) - Last_Wind->next = 0; + Last_Wind->next = 0; First_Wind = first; GC_Unlink; return ret; diff --git a/src/cstring.c b/src/cstring.c index 5f637c5..b53f896 100644 --- a/src/cstring.c +++ b/src/cstring.c @@ -48,7 +48,7 @@ void Init_Cstring() { /* Preallocate memory to avoid fragmentation */ int i; for (i = 0; i < NUMSTRBUFS; i++) - heapstr[i] = Safe_Malloc (heaplen[i] = 512); + heapstr[i] = Safe_Malloc (heaplen[i] = 512); } char *Get_String (Object str) { @@ -57,10 +57,10 @@ char *Get_String (Object str) { Check_Type (str, T_String); if ((len = STRING(str)->size+1) > heaplen[nextstr]) { - Disable_Interrupts; - *pp = Safe_Realloc (*pp, len); - heaplen[nextstr] = len; - Enable_Interrupts; + Disable_Interrupts; + *pp = Safe_Realloc (*pp, len); + heaplen[nextstr] = len; + Enable_Interrupts; } memcpy (*pp, STRING(str)->data, --len); (*pp)[len] = '\0'; @@ -70,8 +70,8 @@ char *Get_String (Object str) { char *Get_Strsym (Object str) { if (TYPE(str) == T_Symbol) - str = SYMBOL(str)->name; + str = SYMBOL(str)->name; else if (TYPE(str) != T_String) - Wrong_Type_Combination (str, "string or symbol"); + Wrong_Type_Combination (str, "string or symbol"); return Get_String (str); } diff --git a/src/debug.c b/src/debug.c index ab9b339..031b59d 100644 --- a/src/debug.c +++ b/src/debug.c @@ -37,32 +37,32 @@ Object P_Backtrace_List (int argc, Object *argv) { GC_Node3; if (argc > 0) { - cp = argv[0]; - Check_Type (cp, T_Control_Point); - delta = CONTROL(cp)->delta; - gp = CONTROL(cp)->gclist; + cp = argv[0]; + Check_Type (cp, T_Control_Point); + delta = CONTROL(cp)->delta; + gp = CONTROL(cp)->gclist; } vec = list = tail = Null; GC_Link3 (vec, list, tail); for ( ; gp; gp = p->next) { - p = (GCNODE *)NORM(gp); - switch (p->gclen) { - case TAG_ENV: - vec = Make_Vector (3, Null); - VECTOR(vec)->data[2] = *(Object *)NORM(p->gcobj); - break; - case TAG_FUN: case TAG_TCFUN: - VECTOR(vec)->data[0] = *(Object *)NORM(p->gcobj); - break; - case TAG_ARGS: - VECTOR(vec)->data[1] = *(Object *)NORM(p->gcobj); - cell = Cons (vec, Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); - tail = cell; - } + p = (GCNODE *)NORM(gp); + switch (p->gclen) { + case TAG_ENV: + vec = Make_Vector (3, Null); + VECTOR(vec)->data[2] = *(Object *)NORM(p->gcobj); + break; + case TAG_FUN: case TAG_TCFUN: + VECTOR(vec)->data[0] = *(Object *)NORM(p->gcobj); + break; + case TAG_ARGS: + VECTOR(vec)->data[1] = *(Object *)NORM(p->gcobj); + cell = Cons (vec, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + tail = cell; + } } GC_Unlink; return list; diff --git a/src/dump-ecoff.c b/src/dump-ecoff.c index f8c9126..34f3195 100644 --- a/src/dump-ecoff.c +++ b/src/dump-ecoff.c @@ -43,12 +43,12 @@ extern char *sbrk(); char err[100];\ int _i;\ for (_i = 0; _i < fhdr.f_nscns; _i++)\ - if (strncmp (sect[_i].s_name, (name), sizeof(sect[_i].s_name)) == 0)\ - break;\ + if (strncmp (sect[_i].s_name, (name), sizeof(sect[_i].s_name)) == 0)\ + break;\ if (_i == fhdr.f_nscns) {\ - Dump_Finalize;\ - sprintf (err, "running a.out doesn't have %s section", (name));\ - Primitive_Error (err);\ + Dump_Finalize;\ + sprintf (err, "running a.out doesn't have %s section", (name));\ + Primitive_Error (err);\ }\ (ptr) = sect+_i;\ } @@ -75,18 +75,18 @@ Object P_Dump (Object ofile) { * whether they haven't been modified. */ if (read (afd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr) || - read (afd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr)) { - Dump_Finalize; - Primitive_Error ("error reading a.out headers: ~E"); + read (afd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr)) { + Dump_Finalize; + Primitive_Error ("error reading a.out headers: ~E"); } if (fhdr.f_nscns > MAX_SECTS) { - Dump_Finalize; - Primitive_Error ("too many sections in a.out"); + Dump_Finalize; + Primitive_Error ("too many sections in a.out"); } if (read (afd, (char *)sect, fhdr.f_nscns * sizeof (sect[0])) != - fhdr.f_nscns * sizeof (sect[0])) { - Dump_Finalize; - Primitive_Error ("error reading section headers: ~E"); + fhdr.f_nscns * sizeof (sect[0])) { + Dump_Finalize; + Primitive_Error ("error reading section headers: ~E"); } FIND_SECTHDR (_DATA, datap); @@ -110,27 +110,27 @@ Object P_Dump (Object ofile) { * .comment). (XXX: Should s_lnnoptr be adjusted as well?) */ for (sp = datap+1; sp < sect+fhdr.f_nscns; sp++) { - switch (sp->s_flags & ~0xf) { - case STYP_BSS: - case STYP_SBSS: - case STYP_LIT4: - case STYP_LIT8: - case STYP_SDATA: + switch (sp->s_flags & ~0xf) { + case STYP_BSS: + case STYP_SBSS: + case STYP_LIT4: + case STYP_LIT8: + case STYP_SDATA: #ifdef DEBUG_DUMP - /* .comment is not null-terminated */ - printf ("nuking %.8s\n", sp->s_name); + /* .comment is not null-terminated */ + printf ("nuking %.8s\n", sp->s_name); #endif - sp->s_paddr = sp->s_vaddr = sp->s_scnptr = sp->s_lnnoptr = 0; - sp->s_size = 0; - break; - default: + sp->s_paddr = sp->s_vaddr = sp->s_scnptr = sp->s_lnnoptr = 0; + sp->s_size = 0; + break; + default: #ifdef DEBUG_DUMP - printf ("adjusting %.8s\n", sp->s_name); + printf ("adjusting %.8s\n", sp->s_name); #endif - sp->s_paddr += delta; - sp->s_vaddr += delta; - if (sp->s_scnptr) sp->s_scnptr += delta; - } + sp->s_paddr += delta; + sp->s_vaddr += delta; + if (sp->s_scnptr) sp->s_scnptr += delta; + } } delta = ahdr.tsize + ahdr.dsize - fhdr.f_symptr; fhdr.f_symptr += delta; @@ -139,10 +139,10 @@ Object P_Dump (Object ofile) { */ n = fhdr.f_nscns * sizeof (sect[0]); if (write (ofd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr) || - write (ofd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr) || - write (ofd, (char *)sect, n) != n) { - Dump_Finalize; - Primitive_Error ("error writing a.out/section headers: ~E"); + write (ofd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr) || + write (ofd, (char *)sect, n) != n) { + Dump_Finalize; + Primitive_Error ("error writing a.out/section headers: ~E"); } /* Write sections @@ -151,15 +151,15 @@ Object P_Dump (Object ofile) { n += sizeof (fhdr) + sizeof (ahdr); #ifdef DEBUG_DUMP printf ("writing text 0x%x bytes and data 0x%x bytes\n", - ahdr.tsize-n, ahdr.dsize); + ahdr.tsize-n, ahdr.dsize); #endif if (write (ofd, (char *)ahdr.text_start+n, ahdr.tsize-n) != ahdr.tsize-n) { - Dump_Finalize; - Primitive_Error ("error writing text section: ~E"); + Dump_Finalize; + Primitive_Error ("error writing text section: ~E"); } if (write (ofd, (char *)ahdr.data_start, ahdr.dsize) != ahdr.dsize) { - Dump_Finalize; - Primitive_Error ("error writing data sections: ~E"); + Dump_Finalize; + Primitive_Error ("error writing data sections: ~E"); } /* Copy the symbol table. If an object file has been loaded into @@ -169,29 +169,29 @@ Object P_Dump (Object ofile) { * (XXX: Are there any offsets to be adjusted in the table proper?) */ if (Loader_Input) { - close (afd); - if ((afd = open (Loader_Input, O_RDONLY)) == -1) { - Dump_Finalize; - Primitive_Error ("cannot open symbol table file: ~E"); - } - delta = fhdr.f_symptr; - if (read (afd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr)) { - Dump_Finalize; - Primitive_Error ("error reading a.out header: ~E"); - } - delta -= fhdr.f_symptr; - (void)lseek (afd, (off_t)fhdr.f_symptr, SEEK_SET); + close (afd); + if ((afd = open (Loader_Input, O_RDONLY)) == -1) { + Dump_Finalize; + Primitive_Error ("cannot open symbol table file: ~E"); + } + delta = fhdr.f_symptr; + if (read (afd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr)) { + Dump_Finalize; + Primitive_Error ("error reading a.out header: ~E"); + } + delta -= fhdr.f_symptr; + (void)lseek (afd, (off_t)fhdr.f_symptr, SEEK_SET); } else - (void)lseek (afd, (off_t)fhdr.f_symptr-delta, SEEK_SET); + (void)lseek (afd, (off_t)fhdr.f_symptr-delta, SEEK_SET); #ifdef DEBUG_DUMP printf ("copying symbols from %s\n", Loader_Input ? Loader_Input : - A_Out_Name); + A_Out_Name); #endif if (read (afd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr)) { symrerr: - Dump_Finalize; - Primitive_Error ("error reading symbol table: ~E"); + Dump_Finalize; + Primitive_Error ("error reading symbol table: ~E"); } #define ADJUST(what) if (shdr.what > 0) shdr.what += delta ADJUST (cbLineOffset); @@ -208,11 +208,11 @@ symrerr: if (write (ofd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr)) { symwerr: - Dump_Finalize; - Primitive_Error ("error writing symbol table: ~E"); + Dump_Finalize; + Primitive_Error ("error writing symbol table: ~E"); } while ((n = read (afd, buf, 4096)) > 0) - if (write (ofd, buf, n) != n) goto symwerr; + if (write (ofd, buf, n) != n) goto symwerr; if (n < 0) goto symrerr; Dump_Epilog; diff --git a/src/dump-elf.c b/src/dump-elf.c index ac3c095..58efbda 100644 --- a/src/dump-elf.c +++ b/src/dump-elf.c @@ -44,11 +44,11 @@ char err[100];\ unsigned int _i;\ for (_i = 0; _i < ohdr->e_shnum; _i++)\ - if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) break;\ + if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) break;\ if (_i == ohdr->e_shnum) {\ - Dump_Finalize;\ - sprintf (err, "running a.out doesn't have %s section", (name));\ - Primitive_Error (err);\ + Dump_Finalize;\ + sprintf (err, "running a.out doesn't have %s section", (name));\ + Primitive_Error (err);\ }\ (ndx) = _i;\ } @@ -59,10 +59,10 @@ #define FIND_SECTHDR_MAYBE(name,ndx) {\ int _i;\ for ((ndx) = -1, _i = 0; _i < ohdr->e_shnum; _i++)\ - if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) {\ - (ndx) = _i;\ - break;\ - }\ + if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) {\ + (ndx) = _i;\ + break;\ + }\ } /* If a new section was inserted, adjust section index if it points behind @@ -121,21 +121,21 @@ Object P_Dump (Object ofile) { * XXX: call munmap later. */ if (fstat (afd, &st) == -1) { - Dump_Finalize; - Primitive_Error ("cannot fstat running a.out: ~E"); + Dump_Finalize; + Primitive_Error ("cannot fstat running a.out: ~E"); } oaddr = (char *)mmap ((caddr_t)0, st.st_size, PROT_READ, MAP_SHARED, - afd, 0); + afd, 0); if (oaddr == (char *)-1) { - Dump_Finalize; - Primitive_Error ("cannot mmap running a.out: ~E"); + Dump_Finalize; + Primitive_Error ("cannot mmap running a.out: ~E"); } ohdr = (Elf32_Ehdr *)(oaddr); osecthdr = (Elf32_Shdr *)(oaddr + ohdr->e_shoff); oproghdr = (Elf32_Phdr *)(oaddr + ohdr->e_phoff); if (ohdr->e_shstrndx == SHN_UNDEF) { - Dump_Finalize; - Primitive_Error ("running a.out doesn't have section names"); + Dump_Finalize; + Primitive_Error ("running a.out doesn't have section names"); } sectstr = oaddr + osecthdr[ohdr->e_shstrndx].sh_offset; FIND_SECTHDR (".bss", obssndx); @@ -147,8 +147,8 @@ Object P_Dump (Object ofile) { * offset are that of the old .bss section */ if ((Brk_On_Dump = sbrk (0)) == (char *)-1) { - Dump_Finalize; - Primitive_Error ("sbrk(0) failed: ~E"); + Dump_Finalize; + Primitive_Error ("sbrk(0) failed: ~E"); } ndata = obssp->sh_addr; ndatasize = (Elf32_Addr)((ptrdiff_t)Brk_On_Dump - (ptrdiff_t)ndata); @@ -160,16 +160,16 @@ Object P_Dump (Object ofile) { */ st.st_size += ndatasize; if (!Was_Dumped) - st.st_size += sizeof (osecthdr[0]); + st.st_size += sizeof (osecthdr[0]); if (ftruncate (ofd, st.st_size) == -1) { - Dump_Finalize; - Primitive_Error ("cannot ftruncate new a.out: ~E"); + Dump_Finalize; + Primitive_Error ("cannot ftruncate new a.out: ~E"); } naddr = (char *)mmap ((caddr_t)0, st.st_size, PROT_READ|PROT_WRITE, - MAP_SHARED, ofd, 0); + MAP_SHARED, ofd, 0); if (naddr == (char *)-1) { - Dump_Finalize; - Primitive_Error ("cannot mmap new a.out: ~E"); + Dump_Finalize; + Primitive_Error ("cannot mmap new a.out: ~E"); } nhdr = (Elf32_Ehdr *)(naddr); nsecthdr = (Elf32_Shdr *)(naddr + ohdr->e_shoff + ndatasize); @@ -179,11 +179,11 @@ Object P_Dump (Object ofile) { */ *nhdr = *ohdr; if (!Was_Dumped) - nhdr->e_shnum++; + nhdr->e_shnum++; UPDATE_SHNDX (nhdr->e_shstrndx); nhdr->e_shoff += ndatasize; memcpy ((void *)nproghdr, (void *)oproghdr, - ohdr->e_phnum * sizeof (oproghdr[0])); + ohdr->e_phnum * sizeof (oproghdr[0])); /* Scan program header table and search for a loadable segment that * ends immediately below the .bss section. Extend this segment so @@ -192,18 +192,18 @@ Object P_Dump (Object ofile) { */ #define max(a,b) ((a) > (b) ? (a) : (b)) for (i = 0; i < nhdr->e_phnum; i++) { - Elf32_Phdr *pp = nproghdr+i; - unsigned int mask = max(pp->p_align, obssp->sh_addralign) - 1; - Elf32_Addr ends_at = (pp->p_vaddr + pp->p_filesz + mask) & ~mask; - Elf32_Addr bssend = (obssp->sh_addr + mask) & ~mask; + Elf32_Phdr *pp = nproghdr+i; + unsigned int mask = max(pp->p_align, obssp->sh_addralign) - 1; + Elf32_Addr ends_at = (pp->p_vaddr + pp->p_filesz + mask) & ~mask; + Elf32_Addr bssend = (obssp->sh_addr + mask) & ~mask; #ifndef __sgi - if (pp->p_vaddr + pp->p_filesz > obssp->sh_addr) { - Dump_Finalize; - Primitive_Error ("running a.out has segment above .bss"); - } + if (pp->p_vaddr + pp->p_filesz > obssp->sh_addr) { + Dump_Finalize; + Primitive_Error ("running a.out has segment above .bss"); + } #endif - if (pp->p_type == PT_LOAD && ends_at == bssend) - break; + if (pp->p_type == PT_LOAD && ends_at == bssend) + break; } nproghdr[i].p_filesz += ndatasize; @@ -211,48 +211,48 @@ Object P_Dump (Object ofile) { #ifdef __sgi for (i = 0; i < nhdr->e_phnum; i++) { - Elf32_Phdr *pp = nproghdr+i; + Elf32_Phdr *pp = nproghdr+i; - if (pp->p_vaddr >= ndata) - pp->p_vaddr += ndatasize - obssp->sh_size; - if (pp->p_offset >= ndataoff) - pp->p_offset += ndatasize; + if (pp->p_vaddr >= ndata) + pp->p_vaddr += ndatasize - obssp->sh_size; + if (pp->p_offset >= ndataoff) + pp->p_offset += ndatasize; } #endif if (Was_Dumped) { - /* No need to insert a new data section header. Just copy - * section header table. Data segment to be adjusted must - * be immediately before .bss - */ - memcpy ((void*)nsecthdr, (void *)osecthdr, - nhdr->e_shnum * sizeof (osecthdr[0])); - nbssp = nsecthdr + obssndx; - ndatap = nbssp - 1; - if (strcmp (sectstr+ndatap->sh_name, ".data")) { - Dump_Finalize; - Primitive_Error ("missing .data section in dumped a.out"); - } - ndatap->sh_size += ndatasize; + /* No need to insert a new data section header. Just copy + * section header table. Data segment to be adjusted must + * be immediately before .bss + */ + memcpy ((void*)nsecthdr, (void *)osecthdr, + nhdr->e_shnum * sizeof (osecthdr[0])); + nbssp = nsecthdr + obssndx; + ndatap = nbssp - 1; + if (strcmp (sectstr+ndatap->sh_name, ".data")) { + Dump_Finalize; + Primitive_Error ("missing .data section in dumped a.out"); + } + ndatap->sh_size += ndatasize; } else { - /* Copy section headers up to old .bss, then copy remaining section - * headers shifted by one position to make room for new .data - */ - memcpy ((void *)nsecthdr, (void *)osecthdr, - obssndx * sizeof (osecthdr[0])); - ndatap = nsecthdr + obssndx; - nbssp = ndatap + 1; - memcpy ((void *)nbssp, (void *)obssp, - (nhdr->e_shnum-obssndx) * sizeof (osecthdr[0])); + /* Copy section headers up to old .bss, then copy remaining section + * headers shifted by one position to make room for new .data + */ + memcpy ((void *)nsecthdr, (void *)osecthdr, + obssndx * sizeof (osecthdr[0])); + ndatap = nsecthdr + obssndx; + nbssp = ndatap + 1; + memcpy ((void *)nbssp, (void *)obssp, + (nhdr->e_shnum-obssndx) * sizeof (osecthdr[0])); - /* Initialize section header for new .data section with values - * from old .data section; set new address, size, and file offset - */ - FIND_SECTHDR (".data", i); - ndatap[0] = osecthdr[i]; - ndatap->sh_addr = ndata; - ndatap->sh_size = ndatasize; - ndatap->sh_offset = ndataoff; + /* Initialize section header for new .data section with values + * from old .data section; set new address, size, and file offset + */ + FIND_SECTHDR (".data", i); + ndatap[0] = osecthdr[i]; + ndatap->sh_addr = ndata; + ndatap->sh_size = ndatasize; + ndatap->sh_offset = ndataoff; } nbssp->sh_size = 0; nbssp->sh_addr += ndatasize; @@ -264,28 +264,28 @@ Object P_Dump (Object ofile) { */ Was_Dumped = 1; for (i = 1; i < nhdr->e_shnum; i++) { - void *from; - Elf32_Shdr *sp = nsecthdr+i; + void *from; + Elf32_Shdr *sp = nsecthdr+i; #ifdef DEBUG_DUMP - printf ("%s (from %s)", sectstr+sp->sh_name, (sp->sh_flags & - (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE) ? - "memory" : "file"); (void)fflush (stdout); + printf ("%s (from %s)", sectstr+sp->sh_name, (sp->sh_flags & + (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE) ? + "memory" : "file"); (void)fflush (stdout); #endif - if ((sp->sh_flags & (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE)) - from = (void *)(ptrdiff_t)sp->sh_addr; - else - from = (void *)(oaddr + sp->sh_offset); - if (sp != ndatap && sp->sh_offset >= ndataoff) - sp->sh_offset += ndatasize; - if (sp->sh_type != SHT_NULL && sp->sh_type != SHT_NOBITS) { + if ((sp->sh_flags & (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE)) + from = (void *)(ptrdiff_t)sp->sh_addr; + else + from = (void *)(oaddr + sp->sh_offset); + if (sp != ndatap && sp->sh_offset >= ndataoff) + sp->sh_offset += ndatasize; + if (sp->sh_type != SHT_NULL && sp->sh_type != SHT_NOBITS) { #ifdef DEBUG_DUMP - printf (" copy from %p to %p size %x", from, naddr+sp->sh_offset, - sp->sh_size); (void)fflush (stdout); + printf (" copy from %p to %p size %x", from, naddr+sp->sh_offset, + sp->sh_size); (void)fflush (stdout); #endif - memcpy ((void *)(naddr + sp->sh_offset), from, sp->sh_size); - } + memcpy ((void *)(naddr + sp->sh_offset), from, sp->sh_size); + } #ifdef DEBUG_DUMP - printf ("\n"); + printf ("\n"); #endif } @@ -294,22 +294,22 @@ Object P_Dump (Object ofile) { * symbol table entries */ for (i = 1; i < nhdr->e_shnum; i++) { - Elf32_Shdr *sp = nsecthdr+i; + Elf32_Shdr *sp = nsecthdr+i; - UPDATE_SHNDX (sp->sh_link); - if (sp->sh_type != SHT_DYNSYM && sp->sh_type != SHT_SYMTAB) - UPDATE_SHNDX (sp->sh_info); + UPDATE_SHNDX (sp->sh_link); + if (sp->sh_type != SHT_DYNSYM && sp->sh_type != SHT_SYMTAB) + UPDATE_SHNDX (sp->sh_info); - if (sp->sh_type == SHT_SYMTAB || sp->sh_type == SHT_DYNSYM) { - Elf32_Sym *p = (Elf32_Sym *)(naddr + sp->sh_offset), - *ep = p + sp->sh_size / sp->sh_entsize; - for ( ; p < ep; p++) switch (p->st_shndx) { - case SHN_UNDEF: case SHN_ABS: case SHN_COMMON: - break; - default: - UPDATE_SHNDX (p->st_shndx); - } - } + if (sp->sh_type == SHT_SYMTAB || sp->sh_type == SHT_DYNSYM) { + Elf32_Sym *p = (Elf32_Sym *)(naddr + sp->sh_offset), + *ep = p + sp->sh_size / sp->sh_entsize; + for ( ; p < ep; p++) switch (p->st_shndx) { + case SHN_UNDEF: case SHN_ABS: case SHN_COMMON: + break; + default: + UPDATE_SHNDX (p->st_shndx); + } + } } #ifdef __sgi @@ -317,31 +317,31 @@ Object P_Dump (Object ofile) { * update the offsets. */ if (mdebugndx >= obssndx) { - HDRR *mp; - mdebugndx++; - mp = (HDRR *)(naddr + nsecthdr[mdebugndx].sh_offset); - if (mp->cbLine > 0) - mp->cbLineOffset += ndatasize; - if (mp->idnMax > 0) - mp->cbDnOffset += ndatasize; - if (mp->ipdMax > 0) - mp->cbPdOffset += ndatasize; - if (mp->isymMax > 0) - mp->cbSymOffset += ndatasize; - if (mp->ioptMax > 0) - mp->cbOptOffset += ndatasize; - if (mp->iauxMax > 0) - mp->cbAuxOffset += ndatasize; - if (mp->issMax > 0) - mp->cbSsOffset += ndatasize; - if (mp->issExtMax > 0) - mp->cbSsExtOffset += ndatasize; - if (mp->ifdMax > 0) - mp->cbFdOffset += ndatasize; - if (mp->crfd > 0) - mp->cbRfdOffset += ndatasize; - if (mp->iextMax > 0) - mp->cbExtOffset += ndatasize; + HDRR *mp; + mdebugndx++; + mp = (HDRR *)(naddr + nsecthdr[mdebugndx].sh_offset); + if (mp->cbLine > 0) + mp->cbLineOffset += ndatasize; + if (mp->idnMax > 0) + mp->cbDnOffset += ndatasize; + if (mp->ipdMax > 0) + mp->cbPdOffset += ndatasize; + if (mp->isymMax > 0) + mp->cbSymOffset += ndatasize; + if (mp->ioptMax > 0) + mp->cbOptOffset += ndatasize; + if (mp->iauxMax > 0) + mp->cbAuxOffset += ndatasize; + if (mp->issMax > 0) + mp->cbSsOffset += ndatasize; + if (mp->issExtMax > 0) + mp->cbSsExtOffset += ndatasize; + if (mp->ifdMax > 0) + mp->cbFdOffset += ndatasize; + if (mp->crfd > 0) + mp->cbRfdOffset += ndatasize; + if (mp->iextMax > 0) + mp->cbExtOffset += ndatasize; } #endif diff --git a/src/dump-hp9k.c b/src/dump-hp9k.c index c88fe77..8bb099d 100644 --- a/src/dump-hp9k.c +++ b/src/dump-hp9k.c @@ -51,15 +51,15 @@ int len = (size), n;\ \ while (len > 0) {\ - if ((n = read (from, buf, 4096)) == -1) {\ - Dump_Finalize;\ - Primitive_Error ("error reading old a.out: ~E");\ - }\ - if (write (to, buf, n) == -1) {\ - Dump_Finalize;\ - Primitive_Error ("error writing new a.out: ~E");\ - }\ - len -= n;\ + if ((n = read (from, buf, 4096)) == -1) {\ + Dump_Finalize;\ + Primitive_Error ("error reading old a.out: ~E");\ + }\ + if (write (to, buf, n) == -1) {\ + Dump_Finalize;\ + Primitive_Error ("error writing new a.out: ~E");\ + }\ + len -= n;\ }\ } @@ -76,21 +76,21 @@ Object P_Dump (Object ofile) { /* Read a.out header and first aux header */ if (read (afd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr) || - lseek (afd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || - read (afd, (char *)&auxhdr, sizeof (auxhdr)) != sizeof (auxhdr)) { - Dump_Finalize; - Primitive_Error ("can't read a.out headers"); + lseek (afd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || + read (afd, (char *)&auxhdr, sizeof (auxhdr)) != sizeof (auxhdr)) { + Dump_Finalize; + Primitive_Error ("can't read a.out headers"); } if (hdr.a_magic != EXEC_MAGIC && hdr.a_magic != SHARE_MAGIC && - hdr.a_magic != DEMAND_MAGIC) { - Dump_Finalize; - Primitive_Error ("bad magic number ~s in a.out", - Make_Integer (hdr.a_magic)); + hdr.a_magic != DEMAND_MAGIC) { + Dump_Finalize; + Primitive_Error ("bad magic number ~s in a.out", + Make_Integer (hdr.a_magic)); } if (auxhdr.som_auxhdr.type != HPUX_AUX_ID) { - Dump_Finalize; - Primitive_Error ("bad aux header id ~s in a.out", - Make_Integer (auxhdr.som_auxhdr.type)); + Dump_Finalize; + Primitive_Error ("bad aux header id ~s in a.out", + Make_Integer (auxhdr.som_auxhdr.type)); } /* Copy old file up to beginning of data space @@ -110,8 +110,8 @@ Object P_Dump (Object ofile) { Brk_On_Dump = sbrk (0); data_size = Brk_On_Dump - (char *)auxhdr.exec_dmem; if (write (ofd, (char *)auxhdr.exec_dmem, data_size) != data_size) { - Dump_Finalize; - Primitive_Error ("error writing data space: ~E"); + Dump_Finalize; + Primitive_Error ("error writing data space: ~E"); } /* Check if data space was last space in a.out file. @@ -120,7 +120,7 @@ Object P_Dump (Object ofile) { */ (void)fstat (afd, &stat); if (lseek (afd, (off_t)auxhdr.exec_dsize, SEEK_CUR) != stat.st_size) - Primitive_Error ("$DATA$ not last space in a.out file"); + Primitive_Error ("$DATA$ not last space in a.out file"); /* Write new headers. * Do we have to recalculate the checksum? The manual doesn't @@ -132,10 +132,10 @@ Object P_Dump (Object ofile) { auxhdr.exec_bsize = 0; (void)lseek (ofd, (off_t)0, SEEK_SET); if (write (ofd, (char *)&hdr, sizeof (hdr)) == -1 || - lseek (ofd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || - write (ofd, (char *)&auxhdr, sizeof (auxhdr)) == -1) { - Dump_Finalize; - Primitive_Error ("error writing a.out headers: ~E"); + lseek (ofd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || + write (ofd, (char *)&auxhdr, sizeof (auxhdr)) == -1) { + Dump_Finalize; + Primitive_Error ("error writing a.out headers: ~E"); } Dump_Epilog; @@ -183,29 +183,29 @@ Save_Shared_Data () { */ for (i = 1; shl_get (i, &p) != -1 ; i++) { #ifdef DEBUG_DUMP - sprintf (Z, "Saving shared lib %s\n", p->filename); W; + sprintf (Z, "Saving shared lib %s\n", p->filename); W; #endif - for (sp = shared_data; sp != lsp && - strcmp (sp->desc.filename, p->filename) != 0; sp++) - ; - if (sp == lsp) { + for (sp = shared_data; sp != lsp && + strcmp (sp->desc.filename, p->filename) != 0; sp++) + ; + if (sp == lsp) { #ifdef DEBUG_DUMP - sprintf (Z, " (new library)\n"); W; + sprintf (Z, " (new library)\n"); W; #endif - if (sp == shared_data + MAX_SHARED) - Primitive_Error ("too many shared libraries"); - lsp++; - sp->desc = *p; - sp->saved = Safe_Malloc (p->dend - p->dstart); - sp->oldaddr = (char *)p->dstart; - } + if (sp == shared_data + MAX_SHARED) + Primitive_Error ("too many shared libraries"); + lsp++; + sp->desc = *p; + sp->saved = Safe_Malloc (p->dend - p->dstart); + sp->oldaddr = (char *)p->dstart; + } } for (sp = shared_data; sp != lsp; sp++) { #ifdef DEBUG_DUMP - sprintf (Z, " copy data seg from %x to %x len %d\n", - sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); W; + sprintf (Z, " copy data seg from %x to %x len %d\n", + sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); W; #endif - memcpy (sp->saved, sp->oldaddr, sp->desc.dend - sp->desc.dstart); + memcpy (sp->saved, sp->oldaddr, sp->desc.dend - sp->desc.dstart); } } @@ -215,55 +215,55 @@ Restore_Shared_Data () { shl_t tmp; for (sp = shared_data; sp != lsp; sp++) { - /* - * Assumption: libraries whose names start with /lib/ or - * with /usr/lib/ were present in the original a.out and - * need not be re-loaded - */ + /* + * Assumption: libraries whose names start with /lib/ or + * with /usr/lib/ were present in the original a.out and + * need not be re-loaded + */ #ifdef DEBUG_DUMP - sprintf (Z, "Restoring shared lib %s\n", sp->desc.filename); W; + sprintf (Z, "Restoring shared lib %s\n", sp->desc.filename); W; #endif - if (strncmp (sp->desc.filename, "/lib/", 5) != 0 && - strncmp (sp->desc.filename, "/usr/lib/", 8) != 0) { - /* - * Re-load the library and make sure memory locations - * at the old start of data segment are mapped - */ + if (strncmp (sp->desc.filename, "/lib/", 5) != 0 && + strncmp (sp->desc.filename, "/usr/lib/", 8) != 0) { + /* + * Re-load the library and make sure memory locations + * at the old start of data segment are mapped + */ #ifdef DEBUG_DUMP - sprintf (Z, " (re-loading)\n"); W; + sprintf (Z, " (re-loading)\n"); W; #endif - tmp = shl_load (sp->desc.filename, BIND_IMMEDIATE|BIND_VERBOSE, 0L); - if (tmp == 0) - exit (1); /* There's nothing we can do... */ - (void)shl_gethandle (tmp, &p); - sp->desc = *p; + tmp = shl_load (sp->desc.filename, BIND_IMMEDIATE|BIND_VERBOSE, 0L); + if (tmp == 0) + exit (1); /* There's nothing we can do... */ + (void)shl_gethandle (tmp, &p); + sp->desc = *p; - /* Try to mnumap the region in any case. If MAP_REPLACE is - * there, use it. - */ - (void)munmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart); + /* Try to mnumap the region in any case. If MAP_REPLACE is + * there, use it. + */ + (void)munmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart); #ifndef MAP_REPLACE # define MAP_REPLACE 0 #endif - if (mmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart, - PROT_READ|PROT_WRITE, - MAP_REPLACE|MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED, - -1, 0) == (char *)-1) { - sprintf (Z, "mmap failed[%d]\n", errno); W; - exit (1); - } - } + if (mmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart, + PROT_READ|PROT_WRITE, + MAP_REPLACE|MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED, + -1, 0) == (char *)-1) { + sprintf (Z, "mmap failed[%d]\n", errno); W; + exit (1); + } + } #ifdef DEBUG_DUMP - sprintf (Z, " copy data seg from %x to %x len %d\n", sp->saved, - sp->oldaddr, sp->desc.dend-sp->desc.dstart); W; + sprintf (Z, " copy data seg from %x to %x len %d\n", sp->saved, + sp->oldaddr, sp->desc.dend-sp->desc.dstart); W; #endif - memcpy (sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); - /* - * Initial break must be set as soon as data segment of - * C library is restored - */ - if (strcmp (sp->desc.filename, "/lib/libc.sl") == 0) - (void)brk (Brk_On_Dump); + memcpy (sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); + /* + * Initial break must be set as soon as data segment of + * C library is restored + */ + if (strcmp (sp->desc.filename, "/lib/libc.sl") == 0) + (void)brk (Brk_On_Dump); } } #endif /* HPSHLIB */ diff --git a/src/dump-vanilla.c b/src/dump-vanilla.c index 5838e4b..a31b477 100644 --- a/src/dump-vanilla.c +++ b/src/dump-vanilla.c @@ -70,38 +70,38 @@ Object P_Dump (Object ofile) { Dump_Prolog; if (read (afd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr) - || N_BADMAG(hdr)) { + || N_BADMAG(hdr)) { #ifdef COFF badaout: #endif - Dump_Finalize; - Primitive_Error ("corrupt a.out file"); + Dump_Finalize; + Primitive_Error ("corrupt a.out file"); } #ifdef COFF data_end = ((unsigned int)sbrk (0) + pagemask) & ~pagemask; syms_start = sizeof (hdr); if (hdr.f_opthdr > 0) { - if (read (afd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) - goto badaout; + if (read (afd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) + goto badaout; } for (n = 0; n < hdr.f_nscns; n++) { - if (read (afd, (char *)&scn, sizeof (scn)) != sizeof (scn)) - goto badaout; - if (scn.s_scnptr > 0 && syms_start < scn.s_scnptr + scn.s_size) - syms_start = scn.s_scnptr + scn.s_size; - if (strcmp (scn.s_name, ".text") == 0) - thdr = scn; - else if (strcmp (scn.s_name, ".data") == 0) - dhdr = scn; - else if (strcmp (scn.s_name, ".bss") == 0) - bhdr = scn; + if (read (afd, (char *)&scn, sizeof (scn)) != sizeof (scn)) + goto badaout; + if (scn.s_scnptr > 0 && syms_start < scn.s_scnptr + scn.s_size) + syms_start = scn.s_scnptr + scn.s_size; + if (strcmp (scn.s_name, ".text") == 0) + thdr = scn; + else if (strcmp (scn.s_name, ".data") == 0) + dhdr = scn; + else if (strcmp (scn.s_name, ".bss") == 0) + bhdr = scn; } hdr.f_flags |= (F_RELFLG|F_EXEC); ohdr.dsize = data_end - ohdr.data_start; ohdr.bsize = 0; thdr.s_size = ohdr.tsize; thdr.s_scnptr = sizeof (hdr) + sizeof (ohdr) - + hdr.f_nscns * sizeof (thdr); + + hdr.f_nscns * sizeof (thdr); lnno_start = thdr.s_lnnoptr; text_scn_start = thdr.s_scnptr; dhdr.s_paddr = dhdr.s_vaddr = ohdr.data_start; @@ -114,30 +114,30 @@ badaout: bias = dhdr.s_scnptr + dhdr.s_size - syms_start; if (hdr.f_symptr > 0) - hdr.f_symptr += bias; + hdr.f_symptr += bias; if (thdr.s_lnnoptr > 0) - thdr.s_lnnoptr += bias; + thdr.s_lnnoptr += bias; if (write (ofd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) { badwrite: - Dump_Finalize; - Primitive_Error ("error writing dump file: ~E"); + Dump_Finalize; + Primitive_Error ("error writing dump file: ~E"); } if (write (ofd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) - goto badwrite; + goto badwrite; if (write (ofd, (char *)&thdr, sizeof (thdr)) != sizeof (thdr)) - goto badwrite; + goto badwrite; if (write (ofd, (char *)&dhdr, sizeof (dhdr)) != sizeof (dhdr)) - goto badwrite; + goto badwrite; if (write (ofd, (char *)&bhdr, sizeof (bhdr)) != sizeof (bhdr)) - goto badwrite; + goto badwrite; lseek (ofd, (off_t)text_scn_start, 0); if (write (ofd, (char *)ohdr.text_start, ohdr.tsize) != ohdr.tsize) - goto badwrite; + goto badwrite; Was_Dumped = 1; lseek (ofd, (off_t)data_scn_start, 0); if (write (ofd, (char *)ohdr.data_start, ohdr.dsize) != ohdr.dsize) - goto badwrite; + goto badwrite; lseek (afd, lnno_start ? (off_t)lnno_start : (off_t)syms_start, 0); #else close (afd); @@ -160,15 +160,15 @@ badwrite: afn = Loader_Input; if (!afn) - afn = A_Out_Name; + afn = A_Out_Name; if ((afd = open (afn, O_RDONLY|O_BINARY)) == -1) { - Dump_Finalize; - Primitive_Error ("cannot open symbol table file: ~E"); + Dump_Finalize; + Primitive_Error ("cannot open symbol table file: ~E"); } if (read (afd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr) - || N_BADMAG(shdr)) { - Dump_Finalize; - Primitive_Error ("corrupt symbol table file"); + || N_BADMAG(shdr)) { + Dump_Finalize; + Primitive_Error ("corrupt symbol table file"); } #if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) hdr.a_lesyms = shdr.a_lesyms; @@ -180,8 +180,8 @@ badwrite: n = hdr.a_text - TEXT_LENGTH_ADJ; if (write (ofd, (char *)MEM_TEXT_START, n) != n) { badwrite: - Dump_Finalize; - Primitive_Error ("error writing dump file: ~E"); + Dump_Finalize; + Primitive_Error ("error writing dump file: ~E"); } Was_Dumped = 1; @@ -194,29 +194,29 @@ badwrite: #ifdef GENERATIONAL_GC n = data_end - data_start; if (write (ofd, (char *)data_start, n) != n) - goto badwrite; + goto badwrite; #else if (Heap_Start > Free_Start) { - n = (unsigned int)Free_Start - data_start; - if (write (ofd, (char *)data_start, n) != n) - goto badwrite; - (void)lseek (ofd, (off_t)(Free_End - Free_Start), 1); - n = Hp - Heap_Start; - if (write (ofd, Heap_Start, n) != n) - goto badwrite; - (void)lseek (ofd, (off_t)(Heap_End - Hp), 1); - n = data_end - (unsigned int)Heap_End; - if (write (ofd, Heap_End, n) != n) - goto badwrite; + n = (unsigned int)Free_Start - data_start; + if (write (ofd, (char *)data_start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Free_End - Free_Start), 1); + n = Hp - Heap_Start; + if (write (ofd, Heap_Start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Heap_End - Hp), 1); + n = data_end - (unsigned int)Heap_End; + if (write (ofd, Heap_End, n) != n) + goto badwrite; } else { - n = (unsigned int)Hp - data_start; - if (write (ofd, (char *)data_start, n) != n) - goto badwrite; - (void)lseek (ofd, (off_t)(Free_End - Hp), 1); - n = data_end - (unsigned int)Free_End; - if (write (ofd, Free_End, n) != n) - goto badwrite; + n = (unsigned int)Hp - data_start; + if (write (ofd, (char *)data_start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Free_End - Hp), 1); + n = data_end - (unsigned int)Free_End; + if (write (ofd, Free_End, n) != n) + goto badwrite; } #endif #if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) @@ -230,17 +230,17 @@ badwrite: #endif #endif /* !COFF */ while ((n = read (afd, buf, BUFSIZ)) > 0) { - if (write (ofd, buf, n) != n) - goto badwrite; + if (write (ofd, buf, n) != n) + goto badwrite; } if (n < 0) { - Dump_Finalize; - Primitive_Error ("error reading symbol table: ~E"); + Dump_Finalize; + Primitive_Error ("error reading symbol table: ~E"); } #if !defined(COFF) (void)lseek (ofd, (off_t)0L, 0); if (write (ofd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) - goto badwrite; + goto badwrite; #endif Dump_Epilog; diff --git a/src/dump.c b/src/dump.c index bccc88f..104db60 100644 --- a/src/dump.c +++ b/src/dump.c @@ -71,8 +71,8 @@ void Init_Dump () { \ Check_If_Dump_Works ();\ if (!EQ (Curr_Input_Port, Standard_Input_Port) ||\ - !EQ (Curr_Output_Port, Standard_Output_Port))\ - Primitive_Error ("cannot dump with current ports redirected");\ + !EQ (Curr_Output_Port, Standard_Output_Port))\ + Primitive_Error ("cannot dump with current ports redirected");\ Flush_Output (Curr_Output_Port);\ Close_All_Files ();\ GC_FINALIZE;\ @@ -80,20 +80,20 @@ void Init_Dump () { GC_Link (ofile);\ ret = Internal_Call_CC (1, Null);\ if (Truep (ret))\ - return ret;\ + return ret;\ GC_Unlink;\ \ Disable_Interrupts;\ \ ofn = Get_Strsym (ofile);\ if ((ofd = open (ofn, O_RDWR|O_CREAT|O_TRUNC|O_BINARY, 0666)) == -1) {\ - Saved_Errno = errno;\ - Primitive_Error ("cannot open ~s: ~E", ofile);\ + Saved_Errno = errno;\ + Primitive_Error ("cannot open ~s: ~E", ofile);\ }\ if ((afd = open (A_Out_Name, O_RDONLY|O_BINARY)) == -1) {\ - Saved_Errno = errno;\ - close (ofd);\ - Primitive_Error ("cannot open a.out file: ~E");\ + Saved_Errno = errno;\ + close (ofd);\ + Primitive_Error ("cannot open a.out file: ~E");\ } #define Dump_Finalize Saved_Errno = errno; close (afd); close (ofd) @@ -122,12 +122,12 @@ void Set_File_Executable (int fd, char *fn) { struct stat st; if (fstat (fd, &st) != -1) { - int omask = umask (0); - (void)umask (omask); + int omask = umask (0); + (void)umask (omask); #ifdef FCHMOD_BROKEN - (void)chmod (fn, (st.st_mode & 0777) | (0111 & ~omask)); + (void)chmod (fn, (st.st_mode & 0777) | (0111 & ~omask)); #else - (void)fchmod (fd, (st.st_mode & 0777) | (0111 & ~omask)); + (void)fchmod (fd, (st.st_mode & 0777) | (0111 & ~omask)); #endif } } diff --git a/src/env.c b/src/env.c index c9fb5ec..d9251ce 100644 --- a/src/env.c +++ b/src/env.c @@ -81,16 +81,16 @@ void Switch_Environment (Object to) { Object old, new, n; if (EQ(The_Environment,to)) - return; + return; Env_To_List (The_Environment, old); Env_To_List (to, new); for ( ; !Nullp (old); old = Cdr (old)) { - for (n = new; !Nullp (n) && !EQ(n,old); - n = Cdr (n)) - ; - if (EQ(n,old)) - break; - Forget_Frame (Car (old)); + for (n = new; !Nullp (n) && !EQ(n,old); + n = Cdr (n)) + ; + if (EQ(n,old)) + break; + Forget_Frame (Car (old)); } Memoize_Frames (new, n); The_Environment = to; @@ -98,7 +98,7 @@ void Switch_Environment (Object to) { void Memoize_Frames (Object this, Object last) { if (Nullp (this) || EQ(this,last)) - return; + return; Memoize_Frames (Cdr (this), last); Memoize_Frame (Car (this)); } @@ -107,14 +107,14 @@ void Memoize_Frame (Object frame) { Object binding; for (; !Nullp (frame); frame = Cdr (frame)) { - binding = Car (frame); - SYMBOL(Car (binding))->value = Cdr (binding); + binding = Car (frame); + SYMBOL(Car (binding))->value = Cdr (binding); } } void Forget_Frame (Object frame) { for (; !Nullp (frame); frame = Cdr (frame)) - SYMBOL(Car (Car (frame)))->value = Unbound; + SYMBOL(Car (Car (frame)))->value = Unbound; } Object Add_Binding (Object frame, Object sym, Object val) { @@ -132,14 +132,14 @@ Object Lookup_Symbol (Object sym, int err) { Env_To_List (The_Environment, p); for (; !Nullp (p); p = Cdr (p)) { - for (f = Car (p); !Nullp (f); f = Cdr (f)) { /* Inlined Assq() */ - b = Car (f); - if (EQ(Car (b), sym)) - return b; - } + for (f = Car (p); !Nullp (f); f = Cdr (f)) { /* Inlined Assq() */ + b = Car (f); + if (EQ(Car (b), sym)) + return b; + } } if (err) - Primitive_Error ("unbound variable: ~s", sym); + Primitive_Error ("unbound variable: ~s", sym); return Null; } @@ -169,30 +169,30 @@ Object General_Define (Object argl, Object sym) { var = Car (argl); val = Cdr (argl); if (TYPE(var) == T_Symbol) { - frame = Null; - GC_Link3 (var, val, frame); - if (Nullp (val)) { - val = Void; - } else { - TC_Disable; - val = Eval (Car (val)); - TC_Enable; - } - Set_Name (var, val); - frame = Car (The_Environment); - binding = Assq (var, frame); - if (EQ(binding, False)) { - frame = Add_Binding (frame, var, val); - Car (The_Environment) = frame; - } else - Cdr (binding) = val; - SYMBOL(var)->value = val; - GC_Unlink; - return var; + frame = Null; + GC_Link3 (var, val, frame); + if (Nullp (val)) { + val = Void; + } else { + TC_Disable; + val = Eval (Car (val)); + TC_Enable; + } + Set_Name (var, val); + frame = Car (The_Environment); + binding = Assq (var, frame); + if (EQ(binding, False)) { + frame = Add_Binding (frame, var, val); + Car (The_Environment) = frame; + } else + Cdr (binding) = val; + SYMBOL(var)->value = val; + GC_Unlink; + return var; } else if (TYPE(var) == T_Pair) { - if (Nullp (val)) - Primitive_Error ("no sub-forms in compound: ~s", var); - return Define_Procedure (var, val, sym); + if (Nullp (val)) + Primitive_Error ("no sub-forms in compound: ~s", var); + return Define_Procedure (var, val, sym); } else Wrong_Type_Combination (var, "symbol or pair"); /*NOTREACHED*/ } @@ -231,11 +231,11 @@ void Set_Name (Object var, Object val) { t = TYPE(val); if (t == T_Compound) { - if (Nullp (COMPOUND(val)->name)) - COMPOUND(val)->name = var; + if (Nullp (COMPOUND(val)->name)) + COMPOUND(val)->name = var; } else if (t == T_Macro) { - if (Nullp (MACRO(val)->name)) - MACRO(val)->name = var; + if (Nullp (MACRO(val)->name)) + MACRO(val)->name = var; } } diff --git a/src/error.c b/src/error.c index 49d8824..210e51e 100644 --- a/src/error.c +++ b/src/error.c @@ -55,7 +55,7 @@ void Init_Error () { Global_GC_Link (Arg_True); Define_Variable (&V_Error_Handler, "error-handler", Null); Define_Variable (&V_Top_Level_Control_Point, "top-level-control-point", - Null); + Null); } char const *Get_Error_Tag () { @@ -81,9 +81,9 @@ void Fatal_Error (const char *fmt, ...) { va_start (args, fmt); (void)fflush (stdout); if (appname) - fprintf (stderr, "\n%s: fatal error: ", appname); + fprintf (stderr, "\n%s: fatal error: ", appname); else - fprintf (stderr, "\nFatal error: "); + fprintf (stderr, "\nFatal error: "); vfprintf (stderr, fmt, args); fprintf (stderr, ".\n"); va_end (args); @@ -95,9 +95,9 @@ void Panic (char const *msg) { Disable_Interrupts; (void)fflush (stdout); if (appname) - fprintf (stderr, "\n%s: panic: ", appname); + fprintf (stderr, "\n%s: panic: ", appname); else - fprintf (stderr, "\nPanic: "); + fprintf (stderr, "\nPanic: "); fprintf (stderr, "%s (dumping core).\n", msg); abort (); } @@ -110,8 +110,8 @@ void Uncatchable_Error (char *errmsg) { * current output port back to the Standard_Output_Port: */ if (appname) { - printf ("%s: %c", appname, tolower (errmsg[0])); - errmsg++; + printf ("%s: %c", appname, tolower (errmsg[0])); + errmsg++; } printf("%s\n", errmsg); Reset (); @@ -130,13 +130,13 @@ void Primitive_Error (const char *fmt, ...) { va_start (args, fmt); for (n = 0, p = fmt; *p; p++) - if (*p == '~' && p[1] != '~' && p[1] != '%' - && p[1] != 'E' && p[1] != 'e') - n++; + if (*p == '~' && p[1] != '~' && p[1] != '%' + && p[1] != 'E' && p[1] != 'e') + n++; if (n > 10) - Panic ("Primitive_Error args"); + Panic ("Primitive_Error args"); for (i = 0; i < n; i++) - argv[i] = va_arg (args, Object); + argv[i] = va_arg (args, Object); sym = Null; GC_Link (sym); gcv.gclen = 1 + i; gcv.gcobj = argv; gcv.next = &gc1; GC_List = &gcv; @@ -165,11 +165,11 @@ void Err_Handler (Object sym, Object fmt, int argc, Object *argv) { args = Cons (sym, args); fun = Var_Get (V_Error_Handler); if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); + (void)Funcall (fun, args, 0); a[0] = sym; Format (Curr_Output_Port, "~s: ", 4, 1, a); Format (Curr_Output_Port, STRING(fmt)->data, STRING(fmt)->size, - argc, argv); + argc, argv); (void)P_Newline (0, (Object *)0); GC_Unlink; Reset (); @@ -181,7 +181,7 @@ void Reset () { cp = Var_Get (V_Top_Level_Control_Point); if (TYPE(cp) == T_Control_Point) - (void)Funcall_Control_Point (cp, Arg_True, 0); + (void)Funcall_Control_Point (cp, Arg_True, 0); (void)fflush (stdout); exit (1); } diff --git a/src/exception.c b/src/exception.c index ba14f65..c1da3c9 100644 --- a/src/exception.c +++ b/src/exception.c @@ -82,7 +82,7 @@ void Intr_Handler (int sig) { Reset_IO (1); fun = Var_Get (V_Interrupt_Handler); if (TYPE(fun) == T_Compound && COMPOUND(fun)->min_args == 0) - (void)Funcall (fun, Null, 0); + (void)Funcall (fun, Null, 0); Format (Curr_Output_Port, "~%\7Interrupt!~%", 15, 0, (Object *)0); Reset (); /*NOTREACHED*/ @@ -90,9 +90,9 @@ void Intr_Handler (int sig) { void Install_Intr_Handler () { if (signal (SIGINT, SIG_IGN) == SIG_IGN) - Intr_Was_Ignored = 1; + Intr_Was_Ignored = 1; else - (void)signal (SIGINT, Intr_Handler); + (void)signal (SIGINT, Intr_Handler); } Object P_Disable_Interrupts () { diff --git a/src/feature.c b/src/feature.c index 3f361f4..25db7ac 100644 --- a/src/feature.c +++ b/src/feature.c @@ -63,7 +63,7 @@ Object P_Provide (Object sym) { Check_Type (sym, T_Symbol); member = P_Memq (sym, Features); if (!Truep (member)) - Features = Cons (sym, Features); + Features = Cons (sym, Features); return Void; } @@ -75,7 +75,7 @@ static Object Feature_Filename (Object str) { GC_Node; for (p = sp->data+len-1; p >= sp->data && *p != '.'; p--) - ; + ; if (p >= sp->data) return str; GC_Link (str); @@ -94,15 +94,15 @@ Object P_Require (int argc, Object *argv) { GC_Link (sym); isfeature = P_Featurep (sym); if (!Truep (isfeature)) { - if (argc == 3) - Check_Type (argv[2], T_Environment); - a[0] = argc == 1 ? Feature_Filename (SYMBOL(sym)->name) : argv[1]; - if (Var_Is_True (V_Autoload_Notifyp)) - Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); - (void)General_Load (a[0], argc == 3 ? argv[2] : The_Environment); - isfeature = P_Featurep (sym); - if (!Truep (isfeature)) - Primitive_Error ("feature ~s was not provided", sym); + if (argc == 3) + Check_Type (argv[2], T_Environment); + a[0] = argc == 1 ? Feature_Filename (SYMBOL(sym)->name) : argv[1]; + if (Var_Is_True (V_Autoload_Notifyp)) + Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); + (void)General_Load (a[0], argc == 3 ? argv[2] : The_Environment); + isfeature = P_Featurep (sym); + if (!Truep (isfeature)) + Primitive_Error ("feature ~s was not provided", sym); } GC_Unlink; return Void; diff --git a/src/heap-gen.c b/src/heap-gen.c index 1c2995a..3fec8d2 100644 --- a/src/heap-gen.c +++ b/src/heap-gen.c @@ -60,25 +60,25 @@ */ int tuneable_forward_region = 5; /* fraction of heap pages that are tried - * to allocate as forward region when - * collecting. - */ + * to allocate as forward region when + * collecting. + */ int tuneable_force_total = 35; /* % newly allocated during collection - * to force total collection - */ + * to force total collection + */ int tuneable_newly_expand = 25; /* % of heap newly allocated during - * a total collection to force heap - * expansion. - */ + * a total collection to force heap + * expansion. + */ int tuneable_force_expand = 20; /* % stable to force heap expansion - */ + */ /* ------------------------------------------------------------------------ defined in object.h: -typedef int gcspace_t; // type used for space and type arrays -typedef unsigned int gcptr_t; // type used for pointers +typedef int gcspace_t; // type used for space and type arrays +typedef unsigned int gcptr_t; // type used for pointers ------------------------------------------------------------------------ */ @@ -110,12 +110,12 @@ static pageno_t protected_pages, allocated_pages; static addrarith_t bytes_per_pp, pp_shift; /* bytes per physical page */ static addrarith_t hp_per_pp; /* number of heap pages per physical page */ static addrarith_t pp_mask; /* ANDed with a virtual address gives - * base address of physical page - */ + * base address of physical page + */ static addrarith_t hp_per_pp_mask; /* ANDed with heap page number gives - * first page number in the physical - * page the heap page belongs to. - */ + * first page number in the physical + * page the heap page belongs to. + */ #define SAME_PHYSPAGE(a,b) (((a) & pp_mask) == ((b) & pp_mask)) gcspace_t current_space; /* has to be exported because IS_ALIVE depends on it */ @@ -128,11 +128,11 @@ static pageno_t last_forward_freepage; static Object *current_freep, *forward_freep; static int scanning = 0; /* set to true if scanning a - * physical page is in progress */ + * physical page is in progress */ static Object *scanpointer; static Object *scanfirst, *scanlast; #define IN_SCANREGION(addr) ((Object*)(addr) >= scanfirst \ - && (Object*)(addr) <= scanlast) + && (Object*)(addr) <= scanlast) #define IS_SCANNED(addr) ((Object *)(addr) < scanpointer) #define MAXRESCAN 10 static pageno_t rescan[MAXRESCAN]; @@ -140,7 +140,7 @@ static int rescanpages = 0; static int allscan = 0; static pageno_t stable_queue, stable_tail; /* head and tail of the queue - * of stable pages */ + * of stable pages */ #define DIRTYENTRIES 20 struct dirty_rec { @@ -170,9 +170,9 @@ static void TerminateGC (); # define NEEDED_PAGES(size) (((size) + PAGEWORDS - 1) / PAGEWORDS) #endif -#define MAKE_HEADER(obj,words,type) (SET(obj, type, words)) -#define HEADER_TO_TYPE(header) ((unsigned int)TYPE(header)) -#define HEADER_TO_WORDS(header) ((unsigned int)FIXNUM(header)) +#define MAKE_HEADER(obj,words,type) (SET(obj, type, words)) +#define HEADER_TO_TYPE(header) ((unsigned int)TYPE(header)) +#define HEADER_TO_WORDS(header) ((unsigned int)FIXNUM(header)) /* some conversion stuff. PHYSPAGE converts a logical page number into the * start address of the physical page the logical page lies on. @@ -197,11 +197,11 @@ static void TerminateGC (); #define HEAPPERCENT(x) PERCENT(x, logical_pages) #define IS_CLUSTER(a,b) (SAME_PHYSPAGE (PAGE_TO_ADDR ((a)), \ - PAGE_TO_ADDR ((b))) || \ - (space[(a)&hp_per_pp_mask] == \ - space[((b)&hp_per_pp_mask)+hp_per_pp] && \ - type[(a)&hp_per_pp_mask] == OBJECTPAGE && \ - type[((b)&hp_per_pp_mask)+hp_per_pp] == OBJECTPAGE)) + PAGE_TO_ADDR ((b))) || \ + (space[(a)&hp_per_pp_mask] == \ + space[((b)&hp_per_pp_mask)+hp_per_pp] && \ + type[(a)&hp_per_pp_mask] == OBJECTPAGE && \ + type[((b)&hp_per_pp_mask)+hp_per_pp] == OBJECTPAGE)) /* check whether the (physical) page starting at address addr is protected * or not. SET_PROTECT and SET_UNPROTECT are used to set or clear the flag @@ -224,7 +224,7 @@ static void TerminateGC (); # endif # define MPROTECT(addr,len,prot) { if (inc_collection) \ mprotect ((caddr_t)(addr), (len), \ - (prot)); } + (prot)); } #else # define PROT_RW # define PROT_NONE @@ -232,17 +232,17 @@ static void TerminateGC (); #endif #define PROTECT(addr) { if (!IS_PROTECTED (addr)) { \ - if (!scanning) { \ - SET_PROTECT (addr); \ - MPROTECT ((addr), bytes_per_pp, PROT_NONE); \ - } else \ + if (!scanning) { \ + SET_PROTECT (addr); \ + MPROTECT ((addr), bytes_per_pp, PROT_NONE); \ + } else \ AddDirty ((addr)); \ - } } + } } #define UNPROTECT(addr) { if (IS_PROTECTED (addr)) { \ - SET_UNPROTECT (addr); \ - MPROTECT ((addr), bytes_per_pp, PROT_RW); \ - } } + SET_UNPROTECT (addr); \ + MPROTECT ((addr), bytes_per_pp, PROT_RW); \ + } } /*****************************************************************************/ @@ -258,7 +258,7 @@ static void TerminateGC (); static void SetupDirtyList () { dirtylist = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); if (dirtylist == (struct dirty_rec *)0) - Fatal_Error ("SetupDirtyList: unable to allocate memory"); + Fatal_Error ("SetupDirtyList: unable to allocate memory"); memset (dirtylist->pages, 0, sizeof (dirtylist->pages)); dirtylist->next = (struct dirty_rec *)0; dirtyhead = dirtylist; @@ -269,19 +269,19 @@ static void AddDirty (pageno_t addr) { struct dirty_rec *p; if (dirtyentries != 0 && - dirtylist->pages[(dirtyentries-1) % DIRTYENTRIES] == addr) - return; + dirtylist->pages[(dirtyentries-1) % DIRTYENTRIES] == addr) + return; else - dirtylist->pages[dirtyentries++ % DIRTYENTRIES] = addr; + dirtylist->pages[dirtyentries++ % DIRTYENTRIES] = addr; if (dirtyentries % DIRTYENTRIES == 0) { - p = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); - if (p == (struct dirty_rec *)0) - Fatal_Error ("AddDirty: unable to allocate memory"); - memset (p->pages, 0, sizeof (p->pages)); - p->next = (struct dirty_rec *)0; - dirtylist->next = p; - dirtylist = p; + p = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); + if (p == (struct dirty_rec *)0) + Fatal_Error ("AddDirty: unable to allocate memory"); + memset (p->pages, 0, sizeof (p->pages)); + p->next = (struct dirty_rec *)0; + dirtylist->next = p; + dirtylist = p; } } @@ -290,9 +290,9 @@ static void ReprotectDirty () { dirtylist = dirtyhead; while (dirtylist) { - for (i = 0; i < DIRTYENTRIES && dirtyentries--; i++) - PROTECT (dirtylist->pages[i]); - dirtylist = dirtylist->next; + for (i = 0; i < DIRTYENTRIES && dirtyentries--; i++) + PROTECT (dirtylist->pages[i]); + dirtylist = dirtylist->next; } dirtyentries = 0; @@ -309,13 +309,13 @@ static void ReprotectDirty () { static void RegisterPage (pageno_t page) { if (allscan) - return; + return; if (IS_SCANNED (PAGE_TO_ADDR (page))) { - if (rescanpages < MAXRESCAN) - rescan[rescanpages++] = page; - else - allscan = 1; + if (rescanpages < MAXRESCAN) + rescan[rescanpages++] = page; + else + allscan = 1; } } @@ -331,16 +331,16 @@ static void DetermineCluster (gcptr_t *addr, int *len) { *len = 1; while (type[ADDR_TO_PAGE (*addr)] != OBJECTPAGE) { - *addr -= bytes_per_pp; - (*len)++; + *addr -= bytes_per_pp; + (*len)++; } addr1 = *addr + ((*len) << pp_shift); while (ADDR_TO_PAGE(addr1) <= lastpage && - space[ADDR_TO_PAGE(addr1)] > 0 && - type[ADDR_TO_PAGE(addr1)] != OBJECTPAGE) { - addr1 += bytes_per_pp; - (*len)++; + space[ADDR_TO_PAGE(addr1)] > 0 && + type[ADDR_TO_PAGE(addr1)] != OBJECTPAGE) { + addr1 += bytes_per_pp; + (*len)++; } } @@ -354,23 +354,23 @@ static void DetermineCluster (gcptr_t *addr, int *len) { static void ProtectCluster (gcptr_t addr, int len) { if (!len) DetermineCluster (&addr, &len); if (len > 1) { - while (len) { - if (!IS_PROTECTED (addr)) { - MPROTECT (addr, len << pp_shift, PROT_NONE); - break; - } - len--; - addr += bytes_per_pp; - } - while (len--) { - if (!IS_PROTECTED (addr)) SET_PROTECT (addr); - addr += bytes_per_pp; - } + while (len) { + if (!IS_PROTECTED (addr)) { + MPROTECT (addr, len << pp_shift, PROT_NONE); + break; + } + len--; + addr += bytes_per_pp; + } + while (len--) { + if (!IS_PROTECTED (addr)) SET_PROTECT (addr); + addr += bytes_per_pp; + } } else { - if (!IS_PROTECTED (addr)) { - MPROTECT (addr, bytes_per_pp, PROT_NONE); - SET_PROTECT (addr); - } + if (!IS_PROTECTED (addr)) { + MPROTECT (addr, bytes_per_pp, PROT_NONE); + SET_PROTECT (addr); + } } } @@ -379,8 +379,8 @@ static void UnprotectCluster (gcptr_t addr, int len) { if (!len) DetermineCluster (&addr, &len); MPROTECT (addr, len << pp_shift, PROT_RW); while (len--) { - if (IS_PROTECTED (addr)) SET_UNPROTECT (addr); - addr += bytes_per_pp; + if (IS_PROTECTED (addr)) SET_UNPROTECT (addr); + addr += bytes_per_pp; } } @@ -390,9 +390,9 @@ static void UnprotectCluster (gcptr_t addr, int len) { static void AddQueue (pageno_t page) { if (stable_queue != (pageno_t)-1) - link[stable_tail] = page; + link[stable_tail] = page; else - stable_queue = page; + stable_queue = page; link[page] = (pageno_t)-1; stable_tail = page; } @@ -409,17 +409,17 @@ static void PromoteStableQueue () { pageno_t start; while (stable_queue != (pageno_t)-1) { - p = PAGE_TO_OBJ (stable_queue); + p = PAGE_TO_OBJ (stable_queue); #ifdef ALIGN_8BYTE - p++; + p++; #endif - size = HEADER_TO_WORDS (*p); - pcount = NEEDED_PAGES (size); + size = HEADER_TO_WORDS (*p); + pcount = NEEDED_PAGES (size); - start = stable_queue; - while (pcount--) - space[start++] = current_space; - stable_queue = link[stable_queue]; + start = stable_queue; + while (pcount--) + space[start++] = current_space; + stable_queue = link[stable_queue]; } current_pages = allocated_pages; forwarded_pages = 0; @@ -463,7 +463,7 @@ static char *heapmalloc (int s) { char *ret = mmap (0, s, PROT_READ|PROT_WRITE, MAP_ANON, -1, 0); if (ret == (char*)-1) - ret = 0; + ret = 0; return ret; } @@ -498,7 +498,7 @@ void Make_Heap (int size) { #if defined(SC_PAGESIZE_IN_UNISTD_H) if ((bytes_per_pp = sysconf (_SC_PAGESIZE)) == -1) - Fatal_Error ("sysconf(_SC_PAGESIZE) failed; can't get pagesize"); + Fatal_Error ("sysconf(_SC_PAGESIZE) failed; can't get pagesize"); #elif defined(HAVE_GETPAGESIZE) bytes_per_pp = getpagesize (); #elif defined(MPROTECT_SIG) || defined(MPROTECT_MMAP) @@ -518,15 +518,15 @@ void Make_Heap (int size) { saved_heap_ptr = heap_ptr; if (heap_ptr == NULL) - Fatal_Error ("cannot allocate heap (%u KBytes)", size); + Fatal_Error ("cannot allocate heap (%u KBytes)", size); /* Align heap at a memory page boundary */ if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) - aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) - & ~(bytes_per_pp-1)); + aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) + & ~(bytes_per_pp-1)); else - aligned_heap_ptr = heap_ptr; + aligned_heap_ptr = heap_ptr; SET(heap_obj, 0, (ptrdiff_t)aligned_heap_ptr); @@ -541,12 +541,12 @@ void Make_Heap (int size) { pmap = (gcspace_t *)malloc (physical_pages*sizeof (gcspace_t)); link = (pageno_t *)malloc (logical_pages*sizeof (pageno_t)); if (!space || !type || !pmap || !link) { - free (heap_ptr); - if (space) free ((char*)space); - if (type) free ((char*)type); - if (pmap) free ((char*)pmap); - if (link) free ((char*)link); - Fatal_Error ("cannot allocate heap maps"); + free (heap_ptr); + if (space) free ((char*)space); + if (type) free ((char*)type); + if (pmap) free ((char*)pmap); + if (link) free ((char*)link); + Fatal_Error ("cannot allocate heap maps"); } memset (type, 0, (logical_pages + 1)*sizeof (gcspace_t)); @@ -561,7 +561,7 @@ void Make_Heap (int size) { #endif for (i = firstpage; i <= lastpage; i++) - space[i] = FREE_PAGE; + space[i] = FREE_PAGE; allocated_pages = 0; forwarded_pages = 0; @@ -602,23 +602,23 @@ static int ExpandHeap (char *reason) { heap_ptr = heapmalloc (heapinc+bytes_per_pp/*-1*/); if (heap_ptr == NULL) { - if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - char buf[243]; - sprintf(buf, "[Heap expansion failed (%s)]~%%", reason); - Format (Standard_Output_Port, buf, - strlen(buf), 0, (Object *)0); - (void)fflush (stdout); - } - return (0); + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + char buf[243]; + sprintf(buf, "[Heap expansion failed (%s)]~%%", reason); + Format (Standard_Output_Port, buf, + strlen(buf), 0, (Object *)0); + (void)fflush (stdout); + } + return (0); } /* Align heap at a memory page boundary */ if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) - aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) - & ~(bytes_per_pp-1)); + aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) + & ~(bytes_per_pp-1)); else - aligned_heap_ptr = heap_ptr; + aligned_heap_ptr = heap_ptr; SET(heap_obj, 0, (ptrdiff_t)aligned_heap_ptr); @@ -630,11 +630,11 @@ static int ExpandHeap (char *reason) { inc_first = 0; /* = OBJ_TO_PAGE (heap_obj) - new_pagebase */ new_firstpage = (pagebase > new_pagebase) - ? new_pagebase : pagebase; + ? new_pagebase : pagebase; new_lastpage = (pagebase > new_pagebase) - ? pagebase + lastpage - : new_pagebase + incpages - 1; + ? pagebase + lastpage + : new_pagebase + incpages - 1; offset = pagebase - new_firstpage; #else @@ -643,9 +643,9 @@ static int ExpandHeap (char *reason) { inc_last = inc_first+incpages-1; if (inc_last > lastpage) - new_last = inc_last; + new_last = inc_last; if (inc_first < firstpage) - new_first = inc_first; + new_first = inc_first; new_logpages = logical_pages+incpages; #ifdef ARRAY_BROKEN new_spanpages = new_lastpage-new_firstpage+1; @@ -660,17 +660,17 @@ static int ExpandHeap (char *reason) { new_pmap = (gcspace_t *)malloc (new_physpages*sizeof (gcspace_t)); new_link = (pageno_t *)malloc (new_spanpages*sizeof (pageno_t)); if (!new_space || !new_type || !new_pmap || !new_link) { - free (heap_ptr); - if (new_space) free ((char*)new_space); - if (new_type) free ((char*)new_type); - if (new_pmap) free ((char*)new_pmap); - if (new_link) free ((char*)new_link); - if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - Format (Standard_Output_Port, "[Heap expansion failed]~%", - 25, 0, (Object *)0); - (void)fflush (stdout); - } - return (0); + free (heap_ptr); + if (new_space) free ((char*)new_space); + if (new_type) free ((char*)new_type); + if (new_pmap) free ((char*)new_pmap); + if (new_link) free ((char*)new_link); + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + Format (Standard_Output_Port, "[Heap expansion failed]~%", + 25, 0, (Object *)0); + (void)fflush (stdout); + } + return (0); } @@ -690,13 +690,13 @@ static int ExpandHeap (char *reason) { /* FIXME: memmove! */ for (i = firstpage; i <= lastpage; i++) { - new_link[i + offset] = link[i] + offset; - new_type[i + offset] = type[i]; + new_link[i + offset] = link[i] + offset; + new_type[i + offset] = type[i]; } for (addr = PAGE_TO_ADDR (firstpage); addr <= PAGE_TO_ADDR (lastpage); - addr += bytes_per_pp) { - new_pmap[((addr - PAGE_TO_ADDR(0)) >> pp_shift) + offset] = - IS_PROTECTED (addr); + addr += bytes_per_pp) { + new_pmap[((addr - PAGE_TO_ADDR(0)) >> pp_shift) + offset] = + IS_PROTECTED (addr); } #ifdef ARRAY_BROKEN @@ -739,12 +739,12 @@ static int ExpandHeap (char *reason) { physical_pages = new_physpages; if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - int a = (logical_pages * PAGEBYTES) >> 10; - char buf[243]; + int a = (logical_pages * PAGEBYTES) >> 10; + char buf[243]; - sprintf(buf, "[Heap expanded to %dK (%s)]~%%", a, reason); - Format (Standard_Output_Port, buf, strlen(buf), 0, (Object *)0); - (void)fflush (stdout); + sprintf(buf, "[Heap expanded to %dK (%s)]~%%", a, reason); + Format (Standard_Output_Port, buf, strlen(buf), 0, (Object *)0); + (void)fflush (stdout); } return (1); } @@ -778,9 +778,9 @@ static int ProtectedInRegion (pageno_t start, pageno_t npages) { gcptr_t endpage = PHYSPAGE (start+npages-1); do { - if (IS_PROTECTED (beginpage)) - return (1); - beginpage += bytes_per_pp; + if (IS_PROTECTED (beginpage)) + return (1); + beginpage += bytes_per_pp; } while (beginpage <= endpage); return (0); @@ -792,17 +792,17 @@ static void AllocPage (pageno_t npg) { pageno_t n, p; if (current_space != forward_space) { - (void)Scanner ((pageno_t)1); - if (!protected_pages) - TerminateGC (); + (void)Scanner ((pageno_t)1); + if (!protected_pages) + TerminateGC (); } else { - if (inc_collection) { - if (allocated_pages+npg >= logical_pages/3) - P_Collect_Incremental (); - } else { - if (allocated_pages+npg >= logical_pages/2) - P_Collect (); - } + if (inc_collection) { + if (allocated_pages+npg >= logical_pages/3) + P_Collect_Incremental (); + } else { + if (allocated_pages+npg >= logical_pages/2) + P_Collect (); + } } /* now look for a cluster of npg free pages. cont_free counts the @@ -811,57 +811,57 @@ static void AllocPage (pageno_t npg) { */ for (p = spanning_pages, cont_free = 0; p; p--) { - if (space[current_freepage] < previous_space - && !STABLE (current_freepage)) { - if (cont_free == 0) { - /* This is our first free page, first check that we have a + if (space[current_freepage] < previous_space + && !STABLE (current_freepage)) { + if (cont_free == 0) { + /* This is our first free page, first check that we have a * continuous cluster of pages (we'll check later that they * are free). Otherwise, go to the next free page */ - if (current_freepage+npg-1 <= lastpage - && IS_CLUSTER (current_freepage, current_freepage+npg-1)) - first_freepage = current_freepage; - else { - current_freepage = next (current_freepage - - current_freepage % hp_per_pp + - hp_per_pp-1); - continue; - } - } + if (current_freepage+npg-1 <= lastpage + && IS_CLUSTER (current_freepage, current_freepage+npg-1)) + first_freepage = current_freepage; + else { + current_freepage = next (current_freepage - + current_freepage % hp_per_pp + + hp_per_pp-1); + continue; + } + } - cont_free++; + cont_free++; - if (cont_free == npg) { - space[first_freepage] = current_space; - type[first_freepage] = OBJECTPAGE; - for (n = 1; n < npg; n++) { - space[first_freepage+n] = current_space; - type[first_freepage+n] = CONTPAGE; - } - current_freep = PAGE_TO_OBJ (first_freepage); - current_free = npg*PAGEWORDS; - current_pages += npg; - allocated_pages += npg; - current_freepage = next (first_freepage+npg-1); - if (ProtectedInRegion (first_freepage, npg)) - (void)ScanCluster (PHYSPAGE (first_freepage)); - return; - } + if (cont_free == npg) { + space[first_freepage] = current_space; + type[first_freepage] = OBJECTPAGE; + for (n = 1; n < npg; n++) { + space[first_freepage+n] = current_space; + type[first_freepage+n] = CONTPAGE; + } + current_freep = PAGE_TO_OBJ (first_freepage); + current_free = npg*PAGEWORDS; + current_pages += npg; + allocated_pages += npg; + current_freepage = next (first_freepage+npg-1); + if (ProtectedInRegion (first_freepage, npg)) + (void)ScanCluster (PHYSPAGE (first_freepage)); + return; + } - /* check the next free page. If we warped, reset cont_free to 0. */ - current_freepage = next (current_freepage); - if (current_freepage == firstpage) cont_free = 0; + /* check the next free page. If we warped, reset cont_free to 0. */ + current_freepage = next (current_freepage); + if (current_freepage == firstpage) cont_free = 0; - } else { - current_freepage = next (current_freepage); - cont_free = 0; - } + } else { + current_freepage = next (current_freepage); + cont_free = 0; + } } /* no space available, try to expand heap */ if (ExpandHeap ("to allocate new object")) { - AllocPage (npg); - return; + AllocPage (npg); + return; } Fatal_Error ("unable to allocate %lu bytes in heap", npg*PAGEBYTES); @@ -878,14 +878,14 @@ static void AllocPage (pageno_t npg) { Object Alloc_Object (size, type, konst) { Object obj; register addrarith_t s = /* size in words */ - ((size + sizeof(Object) - 1) / sizeof(Object)) + 1; + ((size + sizeof(Object) - 1) / sizeof(Object)) + 1; int big = 0; if (GC_Debug) { - if (inc_collection) - P_Collect_Incremental (); - else - P_Collect (); + if (inc_collection) + P_Collect_Incremental (); + else + P_Collect (); } /* if there is not enough space left on the current page, discard @@ -894,32 +894,32 @@ Object Alloc_Object (size, type, konst) { */ if (s > current_free) { - if (current_free) { - MAKE_HEADER (*current_freep, current_free, T_Freespace); - current_free = 0; - } + if (current_free) { + MAKE_HEADER (*current_freep, current_free, T_Freespace); + current_free = 0; + } - /* If we are about to allocate an object bigger than one heap page, - * set a flag. The space behind big objects is discarded, see below. - */ + /* If we are about to allocate an object bigger than one heap page, + * set a flag. The space behind big objects is discarded, see below. + */ #ifdef ALIGN_8BYTE - if (s < PAGEWORDS-1) - AllocPage ((pageno_t)1); - else { - AllocPage ((pageno_t)(s+PAGEWORDS)/PAGEWORDS); - big = 1; - } - MAKE_HEADER (*current_freep, 1, T_Align_8Byte); - current_freep++; - current_free--; + if (s < PAGEWORDS-1) + AllocPage ((pageno_t)1); + else { + AllocPage ((pageno_t)(s+PAGEWORDS)/PAGEWORDS); + big = 1; + } + MAKE_HEADER (*current_freep, 1, T_Align_8Byte); + current_freep++; + current_free--; #else - if (s < PAGEWORDS) - AllocPage ((pageno_t)1); - else { - AllocPage ((pageno_t)(s+PAGEWORDS-1)/PAGEWORDS); - big = 1; - } + if (s < PAGEWORDS) + AllocPage ((pageno_t)1); + else { + AllocPage ((pageno_t)(s+PAGEWORDS-1)/PAGEWORDS); + big = 1; + } #endif } @@ -933,18 +933,18 @@ Object Alloc_Object (size, type, konst) { *current_freep = Null; SET (obj, type, (ptrdiff_t)current_freep); if (big) - current_freep = (Object*)0, current_free = 0; + current_freep = (Object*)0, current_free = 0; else - current_freep += (s-1), current_free -= s; + current_freep += (s-1), current_free -= s; #ifdef ALIGN_8BYTE if (!((gcptr_t)current_freep & 7) && current_free) { - MAKE_HEADER (*current_freep, 1, T_Align_8Byte); - current_freep++; - current_free--; + MAKE_HEADER (*current_freep, 1, T_Align_8Byte); + current_freep++; + current_free--; } #endif if (type == T_Control_Point) - CONTROL(obj)->reloc = 0; + CONTROL(obj)->reloc = 0; if (konst) SETCONST (obj); return (obj); @@ -962,36 +962,36 @@ static void AllocForwardPage (Object bad) { pageno_t tpage; while (whole_heap--) { - if (space[forward_freepage] < previous_space - && !STABLE (forward_freepage) - && !SAME_PHYSPAGE ((gcptr_t)badaddr, - PAGE_TO_ADDR (forward_freepage)) - && !IN_SCANREGION (PAGE_TO_ADDR (forward_freepage))) { + if (space[forward_freepage] < previous_space + && !STABLE (forward_freepage) + && !SAME_PHYSPAGE ((gcptr_t)badaddr, + PAGE_TO_ADDR (forward_freepage)) + && !IN_SCANREGION (PAGE_TO_ADDR (forward_freepage))) { - allocated_pages++; - forwarded_pages++; - space[forward_freepage] = forward_space; - type[forward_freepage] = OBJECTPAGE; - forward_freep = PAGE_TO_OBJ (forward_freepage); - forward_free = PAGEWORDS; - AddQueue (forward_freepage); + allocated_pages++; + forwarded_pages++; + space[forward_freepage] = forward_space; + type[forward_freepage] = OBJECTPAGE; + forward_freep = PAGE_TO_OBJ (forward_freepage); + forward_free = PAGEWORDS; + AddQueue (forward_freepage); - tpage = last_forward_freepage; - last_forward_freepage = next (forward_freepage); - forward_freepage = tpage; - return; - } else { - forward_freepage = next (forward_freepage); - } + tpage = last_forward_freepage; + last_forward_freepage = next (forward_freepage); + forward_freepage = tpage; + return; + } else { + forward_freepage = next (forward_freepage); + } } if (ExpandHeap ("to allocate forward page")) { - AllocForwardPage (bad); - return; + AllocForwardPage (bad); + return; } Fatal_Error ("unable to allocate forward page in %lu KBytes heap", - (logical_pages * PAGEBYTES) >> 10); + (logical_pages * PAGEBYTES) >> 10); /*NOTREACHED*/ } @@ -1016,32 +1016,32 @@ int Visit (register Object *cp) { */ if (current_space == forward_space) - return 0; + return 0; if (page < firstpage || page > lastpage || STABLE (page) - || space[page] == current_space || space[page] == UNALLOCATED_PAGE - || !Types[tag].haspointer) - return 0; + || space[page] == current_space || space[page] == UNALLOCATED_PAGE + || !Types[tag].haspointer) + return 0; if (space[page] != previous_space) { - char buf[100]; - sprintf (buf, "Visit: object not in prev space at %p ('%s') %d %d", - obj_ptr, Types[tag].name, space[page], previous_space); - Panic (buf); + char buf[100]; + sprintf (buf, "Visit: object not in prev space at %p ('%s') %d %d", + obj_ptr, Types[tag].name, space[page], previous_space); + Panic (buf); } if (!IN_SCANREGION (obj_ptr) && IS_PROTECTED ((gcptr_t)obj_ptr)) { - pageaddr = OBJ_TO_PPADDR (*cp); - UNPROTECT (pageaddr); + pageaddr = OBJ_TO_PPADDR (*cp); + UNPROTECT (pageaddr); } if (WAS_FORWARDED (*cp)) { - if (pageaddr != 0) - PROTECT (pageaddr); - MAKEOBJ (*cp, tag, (ptrdiff_t)POINTER(*obj_ptr)); - if (konst) - SETCONST (*cp); - return 0; + if (pageaddr != 0) + PROTECT (pageaddr); + MAKEOBJ (*cp, tag, (ptrdiff_t)POINTER(*obj_ptr)); + if (konst) + SETCONST (*cp); + return 0; } ffreep = PTR_TO_PPADDR (forward_freep); @@ -1049,63 +1049,63 @@ int Visit (register Object *cp) { objwords = HEADER_TO_WORDS (*(obj_ptr - 1)); if (objwords >= forward_free) { #ifdef ALIGN_8BYTE - if (objwords >= PAGEWORDS - 1) { - objpages = (objwords + PAGEWORDS) / PAGEWORDS; + if (objwords >= PAGEWORDS - 1) { + objpages = (objwords + PAGEWORDS) / PAGEWORDS; #else - if (objwords >= PAGEWORDS) { - objpages = (objwords + PAGEWORDS - 1) / PAGEWORDS; + if (objwords >= PAGEWORDS) { + objpages = (objwords + PAGEWORDS - 1) / PAGEWORDS; #endif - forwarded_pages += objpages; - for (pcount = 0; pcount < objpages; pcount++) - space[page + pcount] = forward_space; - AddQueue (page); - if (IN_SCANREGION (PAGE_TO_ADDR (page))) - RegisterPage (page); - else - ProtectCluster (PHYSPAGE (page), 0); + forwarded_pages += objpages; + for (pcount = 0; pcount < objpages; pcount++) + space[page + pcount] = forward_space; + AddQueue (page); + if (IN_SCANREGION (PAGE_TO_ADDR (page))) + RegisterPage (page); + else + ProtectCluster (PHYSPAGE (page), 0); - if (pageaddr != 0) - PROTECT (pageaddr); + if (pageaddr != 0) + PROTECT (pageaddr); - return 0; - } + return 0; + } - if (forward_free) { - if (outside && IS_PROTECTED (ffreep) - && !SAME_PHYSPAGE ((gcptr_t)obj_ptr, ffreep)) { + if (forward_free) { + if (outside && IS_PROTECTED (ffreep) + && !SAME_PHYSPAGE ((gcptr_t)obj_ptr, ffreep)) { - UNPROTECT (ffreep); - MAKE_HEADER (*forward_freep, forward_free, T_Freespace); - forward_free = 0; - PROTECT (ffreep); - } else { - MAKE_HEADER (*forward_freep, forward_free, T_Freespace); - forward_free = 0; - } - } + UNPROTECT (ffreep); + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; + PROTECT (ffreep); + } else { + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; + } + } - AllocForwardPage (*cp); - outside = !IN_SCANREGION (forward_freep); - ffreep = PTR_TO_PPADDR (forward_freep); /* re-set ffreep ! */ + AllocForwardPage (*cp); + outside = !IN_SCANREGION (forward_freep); + ffreep = PTR_TO_PPADDR (forward_freep); /* re-set ffreep ! */ #ifdef ALIGN_8BYTE - if (outside && IS_PROTECTED (ffreep)) - UNPROTECT (ffreep); - MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); - forward_freep++; - forward_free--; - goto do_forward; + if (outside && IS_PROTECTED (ffreep)) + UNPROTECT (ffreep); + MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); + forward_freep++; + forward_free--; + goto do_forward; #endif } if (outside && IS_PROTECTED (ffreep)) - UNPROTECT (ffreep); + UNPROTECT (ffreep); #ifdef ALIGN_8BYTE do_forward: #endif if (tag == T_Control_Point) { - CONTROL (*cp)->reloc = - (char*)(forward_freep + 1) - (char*)obj_ptr; + CONTROL (*cp)->reloc = + (char*)(forward_freep + 1) - (char*)obj_ptr; } MAKE_HEADER (*forward_freep, objwords, tag); @@ -1114,23 +1114,23 @@ do_forward: SET (*obj_ptr, T_Broken_Heart, (ptrdiff_t)forward_freep); MAKEOBJ (*cp, tag, (ptrdiff_t)forward_freep); if (konst) - SETCONST (*cp); + SETCONST (*cp); forward_freep += (objwords - 1); forward_free -= objwords; #ifdef ALIGN_8BYTE if (!((gcptr_t)forward_freep & 7) && forward_free) { - MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); - forward_freep++; - forward_free--; + MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); + forward_freep++; + forward_free--; } #endif if (outside) - PROTECT (ffreep); + PROTECT (ffreep); if (pageaddr != 0) - PROTECT (pageaddr); + PROTECT (pageaddr); return 0; } @@ -1146,80 +1146,80 @@ static void ScanPage (Object *currentp, Object *nextcp) { int t; while (cp < nextcp && (cp != forward_freep || forward_free == 0)) { - t = HEADER_TO_TYPE (*cp); - len = HEADER_TO_WORDS (*cp); - cp++; + t = HEADER_TO_TYPE (*cp); + len = HEADER_TO_WORDS (*cp); + cp++; - /* cp now points to the real Scheme object in the heap. t denotes - * the type of the object, len its length inclusive header in - * words. - */ + /* cp now points to the real Scheme object in the heap. t denotes + * the type of the object, len its length inclusive header in + * words. + */ - SET(obj, t, (ptrdiff_t)cp); + SET(obj, t, (ptrdiff_t)cp); - switch (t) { - case T_Symbol: - Visit (&SYMBOL(obj)->next); - Visit (&SYMBOL(obj)->name); - Visit (&SYMBOL(obj)->value); - Visit (&SYMBOL(obj)->plist); - break; + switch (t) { + case T_Symbol: + Visit (&SYMBOL(obj)->next); + Visit (&SYMBOL(obj)->name); + Visit (&SYMBOL(obj)->value); + Visit (&SYMBOL(obj)->plist); + break; - case T_Pair: - case T_Environment: - Visit (&PAIR(obj)->car); - Visit (&PAIR(obj)->cdr); - break; + case T_Pair: + case T_Environment: + Visit (&PAIR(obj)->car); + Visit (&PAIR(obj)->cdr); + break; - case T_Vector: - for (n = 0, m = VECTOR(obj)->size; n < m; n++ ) - Visit (&VECTOR(obj)->data[n]); - break; + case T_Vector: + for (n = 0, m = VECTOR(obj)->size; n < m; n++ ) + Visit (&VECTOR(obj)->data[n]); + break; - case T_Compound: - Visit (&COMPOUND(obj)->closure); - Visit (&COMPOUND(obj)->env); - Visit (&COMPOUND(obj)->name); - break; + case T_Compound: + Visit (&COMPOUND(obj)->closure); + Visit (&COMPOUND(obj)->env); + Visit (&COMPOUND(obj)->name); + break; - case T_Control_Point: - (CONTROL(obj)->delta) += CONTROL(obj)->reloc; + case T_Control_Point: + (CONTROL(obj)->delta) += CONTROL(obj)->reloc; #ifdef USE_ALLOCA - Visit_GC_List (CONTROL(obj)->gclist, CONTROL(obj)->delta); + Visit_GC_List (CONTROL(obj)->gclist, CONTROL(obj)->delta); #else - Visit (&CONTROL(obj)->gcsave); + Visit (&CONTROL(obj)->gcsave); #endif - Visit_Wind (CONTROL(obj)->firstwind, - (CONTROL(obj)->delta) ); + Visit_Wind (CONTROL(obj)->firstwind, + (CONTROL(obj)->delta) ); - Visit (&CONTROL(obj)->env); - break; + Visit (&CONTROL(obj)->env); + break; - case T_Promise: - Visit (&PROMISE(obj)->env); - Visit (&PROMISE(obj)->thunk); - break; + case T_Promise: + Visit (&PROMISE(obj)->env); + Visit (&PROMISE(obj)->thunk); + break; - case T_Port: - Visit (&PORT(obj)->name); - break; + case T_Port: + Visit (&PORT(obj)->name); + break; - case T_Autoload: - Visit (&AUTOLOAD(obj)->files); - Visit (&AUTOLOAD(obj)->env); - break; + case T_Autoload: + Visit (&AUTOLOAD(obj)->files); + Visit (&AUTOLOAD(obj)->env); + break; - case T_Macro: - Visit (&MACRO(obj)->body); - Visit (&MACRO(obj)->name); - break; + case T_Macro: + Visit (&MACRO(obj)->body); + Visit (&MACRO(obj)->name); + break; - default: - if (Types[t].visit) - (Types[t].visit) (&obj, Visit); - } - cp += (len - 1); + default: + if (Types[t].visit) + (Types[t].visit) (&obj, Visit); + } + cp += (len - 1); } } @@ -1233,11 +1233,11 @@ static void RescanPages () { rescanpages = 0; for (i = 0; i < pages; i++) { - cp = PAGE_TO_OBJ (rescan[i]); + cp = PAGE_TO_OBJ (rescan[i]); #ifdef ALIGN_8BYTE - ScanPage (cp + 1, cp + PAGEWORDS); + ScanPage (cp + 1, cp + PAGEWORDS); #else - ScanPage (cp, cp + PAGEWORDS); + ScanPage (cp, cp + PAGEWORDS); #endif } } @@ -1257,22 +1257,22 @@ static int ScanCluster (gcptr_t addr) { rescan_cluster: lastpage = ADDR_TO_PAGE ((gcptr_t)scanlast); for (page = ADDR_TO_PAGE ((gcptr_t)scanfirst); page <= lastpage; page++) { - if (STABLE (page) && type[page] == OBJECTPAGE) { - scanpointer = PAGE_TO_OBJ (page); + if (STABLE (page) && type[page] == OBJECTPAGE) { + scanpointer = PAGE_TO_OBJ (page); #ifdef ALIGN_8BYTE - ScanPage (scanpointer + 1, scanpointer + PAGEWORDS); + ScanPage (scanpointer + 1, scanpointer + PAGEWORDS); #else - ScanPage (scanpointer, scanpointer + PAGEWORDS); + ScanPage (scanpointer, scanpointer + PAGEWORDS); #endif - } + } } while (rescanpages) { - if (allscan) { - allscan = 0; - goto rescan_cluster; - } else - RescanPages (); + if (allscan) { + allscan = 0; + goto rescan_cluster; + } else + RescanPages (); } scanfirst = (Object *)0; @@ -1290,18 +1290,18 @@ static int Scanner (pageno_t npages) { pageno_t scanned = 0; while (npages > 0 && protected_pages) { - lastaddr = PAGE_TO_ADDR (lastpage); - for (addr = PAGE_TO_ADDR(firstpage); addr < lastaddr && npages > 0; - addr += bytes_per_pp) { + lastaddr = PAGE_TO_ADDR (lastpage); + for (addr = PAGE_TO_ADDR(firstpage); addr < lastaddr && npages > 0; + addr += bytes_per_pp) { - if (IS_PROTECTED (addr)) { - if (space[ADDR_TO_PAGE (addr)] == UNALLOCATED_PAGE) - Panic ("Scanner: found incorrect heap page"); - spages = ScanCluster (addr); - scanned += spages; - npages -= spages; - } - } + if (IS_PROTECTED (addr)) { + if (space[ADDR_TO_PAGE (addr)] == UNALLOCATED_PAGE) + Panic ("Scanner: found incorrect heap page"); + spages = ScanCluster (addr); + scanned += spages; + npages -= spages; + } + } } scanfirst = (Object *)0; @@ -1361,12 +1361,12 @@ static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { #ifdef SIGSEGV_AIX if ((char *)scp->sc_jmpbuf.jmp_context.except[0] != addr) - Panic ("except"); + Panic ("except"); #endif #ifdef SIGSEGV_SIGINFO if (sip == 0) - Fatal_Error ("SIGSEGV handler got called with zero siginfo_t"); + Fatal_Error ("SIGSEGV handler got called with zero siginfo_t"); addr = sip->si_addr; #endif @@ -1374,7 +1374,7 @@ static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { char *addr; if (scp == 0) - Fatal_Error ("SIGSEGV handler got called with zero sigcontext"); + Fatal_Error ("SIGSEGV handler got called with zero sigcontext"); addr = (char *)scp->sc_sl.sl_ss.ss_cr21; #endif @@ -1382,14 +1382,14 @@ static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { page = ADDR_TO_PAGE((gcptr_t)addr); if (!inc_collection) - errmsg = "SIGSEGV signal received"; + errmsg = "SIGSEGV signal received"; else if (current_space == forward_space) - errmsg = "SIGSEGV signal received while not garbage collecting"; + errmsg = "SIGSEGV signal received while not garbage collecting"; else if (page < firstpage || page > lastpage) - errmsg = "SIGSEV signal received; address outside of heap"; + errmsg = "SIGSEV signal received; address outside of heap"; if (errmsg) { - fprintf (stderr, "\n[%s]\n", errmsg); - abort (); + fprintf (stderr, "\n[%s]\n", errmsg); + abort (); } GC_In_Progress = 1; @@ -1411,7 +1411,7 @@ void InstallHandler () { sact.sa_mask = mask; sact.sa_flags = SA_SIGINFO; if (sigaction (SIGSEGV, &sact, 0) == -1) { - perror ("sigaction"); exit (1); + perror ("sigaction"); exit (1); } #else (void)signal (SIGSEGV, (void (*)())PagefaultHandler); @@ -1426,14 +1426,14 @@ static void TerminateGC () { previous_space = current_space; if (protected_pages) - Panic ("TerminateGC: protected pages after collection"); + Panic ("TerminateGC: protected pages after collection"); allocated_pages = current_pages + forwarded_pages; current_pages = 0; if (forward_free) { - MAKE_HEADER (*forward_freep, forward_free, T_Freespace); - forward_free = 0; + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; } forward_freep = (Object *)0; @@ -1442,33 +1442,33 @@ static void TerminateGC () { Enable_Interrupts; if (Var_Is_True (V_Garbage_Collect_Notifyp) && !GC_Debug) { - int foo = percent - HEAPPERCENT (allocated_pages); - Object bar; + int foo = percent - HEAPPERCENT (allocated_pages); + Object bar; - bar = Make_Integer (foo); - if (!incomplete_msg) - Format (Standard_Output_Port, "[", 1, 0, (Object *)0); + bar = Make_Integer (foo); + if (!incomplete_msg) + Format (Standard_Output_Port, "[", 1, 0, (Object *)0); - if (foo >= 0) - Format (Standard_Output_Port, "~s% reclaimed]~%", 16, 1, &bar); - else - Format (Standard_Output_Port, "finished]~%", 11, 0, (Object *)0); - (void)fflush (stdout); - incomplete_msg = 0; + if (foo >= 0) + Format (Standard_Output_Port, "~s% reclaimed]~%", 16, 1, &bar); + else + Format (Standard_Output_Port, "finished]~%", 11, 0, (Object *)0); + (void)fflush (stdout); + incomplete_msg = 0; } if (PERCENT (allocated_pages, old_logical_pages) >= tuneable_force_total) { - PromoteStableQueue (); - save_force_total = tuneable_force_total; - tuneable_force_total = 100; - if (inc_collection) - P_Collect_Incremental (); - else - P_Collect (); - tuneable_force_total = save_force_total; - if (HEAPPERCENT (allocated_pages) >= tuneable_newly_expand) - /* return value should not be ignore here: */ - (void)ExpandHeap ("after full collection"); + PromoteStableQueue (); + save_force_total = tuneable_force_total; + tuneable_force_total = 100; + if (inc_collection) + P_Collect_Incremental (); + else + P_Collect (); + tuneable_force_total = save_force_total; + if (HEAPPERCENT (allocated_pages) >= tuneable_newly_expand) + /* return value should not be ignore here: */ + (void)ExpandHeap ("after full collection"); } } @@ -1477,15 +1477,15 @@ static void Finish_Collection () { register gcptr_t addr; do { - for (addr = PAGE_TO_ADDR(firstpage); - addr < PAGE_TO_ADDR(lastpage); - addr += bytes_per_pp) { + for (addr = PAGE_TO_ADDR(firstpage); + addr < PAGE_TO_ADDR(lastpage); + addr += bytes_per_pp) { - if (IS_PROTECTED (addr)) { - (void)ScanCluster (addr); - if (protected_pages == 0) TerminateGC (); - } - } + if (IS_PROTECTED (addr)) { + (void)ScanCluster (addr); + if (protected_pages == 0) TerminateGC (); + } + } } while (protected_pages); return; @@ -1499,12 +1499,12 @@ static void General_Collect (int initiate) { Object obj; if (!Interpreter_Initialized) - Fatal_Error ("Out of heap space (increase heap size)"); + Fatal_Error ("Out of heap space (increase heap size)"); if (current_space != forward_space && !inc_collection) { - Format (Standard_Output_Port, "GC while GC in progress~%", - 25, 0, (Object*)0); - return; + Format (Standard_Output_Port, "GC while GC in progress~%", + 25, 0, (Object*)0); + return; } /* Call all user-registered functions to be executed just before GC. */ @@ -1516,20 +1516,20 @@ static void General_Collect (int initiate) { old_logical_pages = logical_pages; if (Var_Is_True (V_Garbage_Collect_Notifyp) && !GC_Debug) { - if (initiate) { - Format (Standard_Output_Port, "[Garbage collecting...]~%", - 25, 0, (Object *)0); - incomplete_msg = 0; - } else { - Format (Standard_Output_Port, "[Garbage collecting... ", - 23, 0, (Object *)0); - incomplete_msg = 1; - } + if (initiate) { + Format (Standard_Output_Port, "[Garbage collecting...]~%", + 25, 0, (Object *)0); + incomplete_msg = 0; + } else { + Format (Standard_Output_Port, "[Garbage collecting... ", + 23, 0, (Object *)0); + incomplete_msg = 1; + } (void)fflush (stdout); } if (GC_Debug) { - printf ("."); (void)fflush (stdout); + printf ("."); (void)fflush (stdout); } /* discard any remaining portion of the current heap page */ @@ -1556,7 +1556,7 @@ static void General_Collect (int initiate) { for (i = 0; free_fpages <= fregion_pages && i < spanning_pages; i++) { if (space[fpage] != current_space && !STABLE (fpage)) - free_fpages++; + free_fpages++; fpage = next (fpage); } current_freep = (Object *)PHYSPAGE (fpage); @@ -1587,10 +1587,10 @@ static void General_Collect (int initiate) { } if (!initiate) { - Finish_Collection (); + Finish_Collection (); } else - if (HEAPPERCENT (forwarded_pages) > tuneable_force_expand) - /* return value should not be ignored here: */ + if (HEAPPERCENT (forwarded_pages) > tuneable_force_expand) + /* return value should not be ignored here: */ (void)ExpandHeap ("large stable set"); GC_In_Progress = 0; @@ -1602,25 +1602,25 @@ Object P_Collect_Incremental () { /* if already collecting, scan a few pages and return */ if (!inc_collection) { - if (current_space == forward_space) - Primitive_Error ("incremental garbage collection not enabled"); - else { - inc_collection = 1; - Finish_Collection (); - inc_collection = 0; - return (True); - } + if (current_space == forward_space) + Primitive_Error ("incremental garbage collection not enabled"); + else { + inc_collection = 1; + Finish_Collection (); + inc_collection = 0; + return (True); + } } else { - if (current_space != forward_space) { - (void)Scanner ((pageno_t)1); - GC_In_Progress = 0; - if (protected_pages == 0) - TerminateGC (); - return (protected_pages ? False : True); - } else { - General_Collect (1); - return (False); - } + if (current_space != forward_space) { + (void)Scanner ((pageno_t)1); + GC_In_Progress = 0; + if (protected_pages == 0) + TerminateGC (); + return (protected_pages ? False : True); + } else { + General_Collect (1); + return (False); + } } /*NOTREACHED*/ } @@ -1632,24 +1632,24 @@ Object P_Collect () { */ if (!inc_collection && current_space != forward_space) { - inc_collection = 1; - Finish_Collection (); - inc_collection = 0; - return (Void); + inc_collection = 1; + Finish_Collection (); + inc_collection = 0; + return (Void); } if (current_space != forward_space) { - Finish_Collection (); - return (Void); + Finish_Collection (); + return (Void); } else { - General_Collect (0); - return (Void); + General_Collect (0); + return (Void); } } void Generational_GC_Finalize () { if (current_space != forward_space) - Finish_Collection (); + Finish_Collection (); } void Generational_GC_Reinitialize () { @@ -1671,21 +1671,21 @@ Object Internal_GC_Status (int strat, int flags) { switch (strat) { default: /* query or stop-and-copy */ #if defined(MPROTECT_SIG) || defined(MPROTECT_MMAP) - if (inc_collection) { - cell = Cons (Sym_Incremental_GC, Null); - (void)P_Set_Cdr (list, cell); - } + if (inc_collection) { + cell = Cons (Sym_Incremental_GC, Null); + (void)P_Set_Cdr (list, cell); + } #endif - break; + break; case GC_STRAT_GEN: - if (flags == GC_FLAGS_INCR) { + if (flags == GC_FLAGS_INCR) { #if defined(MPROTECT_SIG) || defined(MPROTECT_MMAP) - inc_collection = 1; - cell = Cons (Sym_Incremental_GC, Null); - (void)P_Set_Cdr (list, cell); + inc_collection = 1; + cell = Cons (Sym_Incremental_GC, Null); + (void)P_Set_Cdr (list, cell); #endif - } else inc_collection = 0; - break; + } else inc_collection = 0; + break; } GC_Unlink; return (list); diff --git a/src/heap-sc.c b/src/heap-sc.c index a92af46..981d5c9 100644 --- a/src/heap-sc.c +++ b/src/heap-sc.c @@ -37,7 +37,7 @@ extern void *sbrk(); #define Recursive_Visit(p) {\ register Object *pp = p;\ if (Stack_Size () > Max_Stack)\ - Fatal_Error("stack overflow during GC (increase stack limit)");\ + Fatal_Error("stack overflow during GC (increase stack limit)");\ if (Types[TYPE(*pp)].haspointer) Visit (pp);\ } @@ -54,7 +54,7 @@ void Make_Heap (int size) { register unsigned int s = 2 * k; if ((Hp = Heap_Start = (char *)sbrk (s)) == (char *)-1) - Fatal_Error ("cannot allocate heap (%u KBytes)", 2*size); + Fatal_Error ("cannot allocate heap (%u KBytes)", 2*size); Heap_End = Heap_Start + k; Free_Start = Heap_End; Free_End = Free_Start + k; @@ -69,22 +69,22 @@ Object Alloc_Object (int size, int type, int konst) { Object ret; if (GC_Debug) { - (void)P_Collect (); - p = Hp; + (void)P_Collect (); + p = Hp; } ALIGN(p); if (p + size > Heap_End) { - (void)P_Collect (); - p = Hp; - ALIGN(p); - if (p + size > Heap_End - HEAP_MARGIN) - Uncatchable_Error ("Out of heap space"); + (void)P_Collect (); + p = Hp; + ALIGN(p); + if (p + size > Heap_End - HEAP_MARGIN) + Uncatchable_Error ("Out of heap space"); } Hp = p + size; *(Object *)p = Null; SET(ret, type, p); if (konst) - SETCONST(ret); + SETCONST(ret); return ret; } @@ -94,19 +94,19 @@ Object P_Collect () { Object a[2]; if (!Interpreter_Initialized) - Fatal_Error ("heap too small (increase heap size)"); + Fatal_Error ("heap too small (increase heap size)"); if (GC_In_Progress) - Fatal_Error ("GC while GC in progress"); + Fatal_Error ("GC while GC in progress"); Disable_Interrupts; GC_In_Progress = 1; Call_Before_GC (); if (GC_Debug) { - printf ("."); (void)fflush (stdout); + printf ("."); (void)fflush (stdout); } else if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - msg++; - Format (Standard_Output_Port, "[Garbage collecting... ", 23, 0, - (Object *)0); - (void)fflush (stdout); + msg++; + Format (Standard_Output_Port, "[Garbage collecting... ", 23, 0, + (Object *)0); + (void)fflush (stdout); } To = Free_Start; Visit_GC_List (Global_GC_Obj, 0); @@ -116,11 +116,11 @@ Object P_Collect () { tmp = Heap_Start; Heap_Start = Free_Start; Free_Start = tmp; tmp = Heap_End; Heap_End = Free_End; Free_End = tmp; if (!GC_Debug) { - if (msg) { - a[0] = Make_Integer ((Hp-Heap_Start) / 1024); - a[1] = Make_Integer ((Heap_End-Heap_Start) / 1024); - Format (Standard_Output_Port, "~sK of ~sK]~%", 13, 2, a); - } + if (msg) { + a[0] = Make_Integer ((Hp-Heap_Start) / 1024); + a[1] = Make_Integer ((Heap_End-Heap_Start) / 1024); + Format (Standard_Output_Port, "~sK of ~sK]~%", 13, 2, a); + } } Call_After_GC (); GC_In_Progress = 0; @@ -135,140 +135,140 @@ int Visit (register Object *p) { again: t = TYPE(*p); if (!Types[t].haspointer) - return 0; + return 0; tag = (Object *)POINTER(*p); if ((char *)tag >= Free_Start && (char *)tag < Free_End) - return 0; + return 0; if (TYPE(*tag) == T_Broken_Heart) { - SETPOINTER(*p, POINTER(*tag)); - return 0; + SETPOINTER(*p, POINTER(*tag)); + return 0; } ALIGN(To); switch (t) { case T_Bignum: - size = sizeof (struct S_Bignum) - sizeof (gran_t) - + BIGNUM(*p)->size * sizeof (gran_t); - memcpy (To, tag, size); - break; + size = sizeof (struct S_Bignum) - sizeof (gran_t) + + BIGNUM(*p)->size * sizeof (gran_t); + memcpy (To, tag, size); + break; case T_Flonum: - size = sizeof (struct S_Flonum); - *(struct S_Flonum *)To = *(struct S_Flonum *)tag; - break; + size = sizeof (struct S_Flonum); + *(struct S_Flonum *)To = *(struct S_Flonum *)tag; + break; case T_Symbol: - size = sizeof (struct S_Symbol); - *(struct S_Symbol *)To = *(struct S_Symbol *)tag; - break; + size = sizeof (struct S_Symbol); + *(struct S_Symbol *)To = *(struct S_Symbol *)tag; + break; case T_Pair: case T_Environment: - size = sizeof (struct S_Pair); - *(struct S_Pair *)To = *(struct S_Pair *)tag; - break; + size = sizeof (struct S_Pair); + *(struct S_Pair *)To = *(struct S_Pair *)tag; + break; case T_String: - size = sizeof (struct S_String) + STRING(*p)->size - 1; - memcpy (To, tag, size); - break; + size = sizeof (struct S_String) + STRING(*p)->size - 1; + memcpy (To, tag, size); + break; case T_Vector: - size = sizeof (struct S_Vector) + (VECTOR(*p)->size - 1) * - sizeof (Object); - memcpy (To, tag, size); - break; + size = sizeof (struct S_Vector) + (VECTOR(*p)->size - 1) * + sizeof (Object); + memcpy (To, tag, size); + break; case T_Primitive: - size = sizeof (struct S_Primitive); - *(struct S_Primitive *)To = *(struct S_Primitive *)tag; - break; + size = sizeof (struct S_Primitive); + *(struct S_Primitive *)To = *(struct S_Primitive *)tag; + break; case T_Compound: - size = sizeof (struct S_Compound); - *(struct S_Compound *)To = *(struct S_Compound *)tag; - break; + size = sizeof (struct S_Compound); + *(struct S_Compound *)To = *(struct S_Compound *)tag; + break; case T_Control_Point: - size = sizeof (struct S_Control) + CONTROL(*p)->size - 1; - reloc = To - (char *)tag; - memcpy (To, tag, size); - break; + size = sizeof (struct S_Control) + CONTROL(*p)->size - 1; + reloc = To - (char *)tag; + memcpy (To, tag, size); + break; case T_Promise: - size = sizeof (struct S_Promise); - *(struct S_Promise *)To = *(struct S_Promise *)tag; - break; + size = sizeof (struct S_Promise); + *(struct S_Promise *)To = *(struct S_Promise *)tag; + break; case T_Port: - size = sizeof (struct S_Port); - *(struct S_Port *)To = *(struct S_Port *)tag; - break; + size = sizeof (struct S_Port); + *(struct S_Port *)To = *(struct S_Port *)tag; + break; case T_Autoload: - size = sizeof (struct S_Autoload); - *(struct S_Autoload *)To = *(struct S_Autoload *)tag; - break; + size = sizeof (struct S_Autoload); + *(struct S_Autoload *)To = *(struct S_Autoload *)tag; + break; case T_Macro: - size = sizeof (struct S_Macro); - *(struct S_Macro *)To = *(struct S_Macro *)tag; - break; + size = sizeof (struct S_Macro); + *(struct S_Macro *)To = *(struct S_Macro *)tag; + break; case T_Broken_Heart: - Panic ("broken heart in GC"); + Panic ("broken heart in GC"); default: - if (t < 0 || t >= Num_Types) - Panic ("bad type in GC"); - if (Types[t].size == NOFUNC) - size = Types[t].const_size; - else - size = (Types[t].size)(*p); - memcpy (To, tag, size); + if (t < 0 || t >= Num_Types) + Panic ("bad type in GC"); + if (Types[t].size == NOFUNC) + size = Types[t].const_size; + else + size = (Types[t].size)(*p); + memcpy (To, tag, size); } SETPOINTER(*p, To); SET(*tag, T_Broken_Heart, To); To += size; if (To > Free_End) - Panic ("free exhausted in GC"); + Panic ("free exhausted in GC"); switch (t) { case T_Symbol: - Recursive_Visit (&SYMBOL(*p)->next); - Recursive_Visit (&SYMBOL(*p)->name); - Recursive_Visit (&SYMBOL(*p)->value); - p = &SYMBOL(*p)->plist; - goto again; + Recursive_Visit (&SYMBOL(*p)->next); + Recursive_Visit (&SYMBOL(*p)->name); + Recursive_Visit (&SYMBOL(*p)->value); + p = &SYMBOL(*p)->plist; + goto again; case T_Pair: case T_Environment: - Recursive_Visit (&PAIR(*p)->car); - p = &PAIR(*p)->cdr; - goto again; + Recursive_Visit (&PAIR(*p)->car); + p = &PAIR(*p)->cdr; + goto again; case T_Vector: { - register int i, n; - for (i = 0, n = VECTOR(*p)->size; i < n; i++) - Recursive_Visit (&VECTOR(*p)->data[i]); - break; - } + register int i, n; + for (i = 0, n = VECTOR(*p)->size; i < n; i++) + Recursive_Visit (&VECTOR(*p)->data[i]); + break; + } case T_Compound: - Recursive_Visit (&COMPOUND(*p)->closure); - Recursive_Visit (&COMPOUND(*p)->env); - p = &COMPOUND(*p)->name; - goto again; + Recursive_Visit (&COMPOUND(*p)->closure); + Recursive_Visit (&COMPOUND(*p)->env); + p = &COMPOUND(*p)->name; + goto again; case T_Control_Point: - Recursive_Visit (&CONTROL(*p)->memsave); - CONTROL(*p)->delta += reloc; + Recursive_Visit (&CONTROL(*p)->memsave); + CONTROL(*p)->delta += reloc; #ifdef USE_ALLOCA - Visit_GC_List (CONTROL(*p)->gclist, CONTROL(*p)->delta); + Visit_GC_List (CONTROL(*p)->gclist, CONTROL(*p)->delta); #else - Recursive_Visit (&CONTROL(*p)->gcsave); + Recursive_Visit (&CONTROL(*p)->gcsave); #endif - Visit_Wind (CONTROL(*p)->firstwind, CONTROL(*p)->delta); - p = &CONTROL(*p)->env; - goto again; + Visit_Wind (CONTROL(*p)->firstwind, CONTROL(*p)->delta); + p = &CONTROL(*p)->env; + goto again; case T_Promise: - Recursive_Visit (&PROMISE(*p)->env); - p = &PROMISE(*p)->thunk; - goto again; + Recursive_Visit (&PROMISE(*p)->env); + p = &PROMISE(*p)->thunk; + goto again; case T_Port: - p = &PORT(*p)->name; - goto again; + p = &PORT(*p)->name; + goto again; case T_Autoload: - Recursive_Visit (&AUTOLOAD(*p)->files); - p = &AUTOLOAD(*p)->env; - goto again; + Recursive_Visit (&AUTOLOAD(*p)->files); + p = &AUTOLOAD(*p)->env; + goto again; case T_Macro: - Recursive_Visit (&MACRO(*p)->body); - p = &MACRO(*p)->name; - goto again; + Recursive_Visit (&MACRO(*p)->body); + p = &MACRO(*p)->name; + goto again; default: - if (Types[t].visit) - (Types[t].visit)(p, Visit); + if (Types[t].visit) + (Types[t].visit)(p, Visit); } return 0; diff --git a/src/heap.c b/src/heap.c index ec96482..a682f0c 100644 --- a/src/heap.c +++ b/src/heap.c @@ -43,7 +43,7 @@ static Object Sym_Stop_And_Copy_GC, Sym_Generational_GC, Sym_Incremental_GC; void Init_Heap () { Define_Variable (&V_Garbage_Collect_Notifyp, "garbage-collect-notify?", - False); + False); Define_Symbol (&Sym_Stop_And_Copy_GC, "stop-and-copy"); Define_Symbol (&Sym_Generational_GC, "generational"); @@ -63,7 +63,7 @@ void Call_Before_GC () { FUNCT *p; for (p = Before_GC_Funcs; p; p = p->next) - p->func(); + p->func(); } void Register_After_GC (void (*f)(void)) { @@ -79,7 +79,7 @@ void Call_After_GC () { FUNCT *p; for (p = After_GC_Funcs; p; p = p->next) - p->func(); + p->func(); } void Visit_GC_List (GCNODE *list, ptrdiff_t delta) { @@ -88,14 +88,14 @@ void Visit_GC_List (GCNODE *list, ptrdiff_t delta) { register Object *vec; for (gp = list; gp; gp = p->next) { - p = (GCNODE *)NORM(gp); - if (p->gclen <= 0) { - Visit ((Object *)NORM(p->gcobj)); - } else { - vec = (Object *)NORM(p->gcobj); - for (n = 0; n < p->gclen-1; n++) - Visit (&vec[n]); - } + p = (GCNODE *)NORM(gp); + if (p->gclen <= 0) { + Visit ((Object *)NORM(p->gcobj)); + } else { + vec = (Object *)NORM(p->gcobj); + for (n = 0; n < p->gclen-1; n++) + Visit (&vec[n]); + } } } @@ -103,8 +103,8 @@ void Visit_Wind (WIND *list, ptrdiff_t delta) { register WIND *wp, *p; for (wp = list; wp; wp = p->next) { - p = (WIND *)NORM(wp); - Visit (&p->inout); + p = (WIND *)NORM(wp); + Visit (&p->inout); } } @@ -129,18 +129,18 @@ Object P_Garbage_Collect_Status (int argc, Object* argv) { int strat = 0, flags = 0; if (argc > 0) { - Check_Type (argv[0], T_Symbol); + Check_Type (argv[0], T_Symbol); if (EQ (argv[0], Sym_Stop_And_Copy_GC)) - strat = GC_STRAT_SAC; + strat = GC_STRAT_SAC; else if (EQ (argv[0], Sym_Generational_GC)) - strat = GC_STRAT_GEN; - else Primitive_Error ("unknown GC strategy: ~s", argv[0]); - if (argc == 2) { - Check_Type (argv[1], T_Symbol); - if (EQ (argv[1], Sym_Incremental_GC)) - flags = GC_FLAGS_INCR; - else Primitive_Error ("unknown GC strategy: ~s", argv[1]); - } + strat = GC_STRAT_GEN; + else Primitive_Error ("unknown GC strategy: ~s", argv[0]); + if (argc == 2) { + Check_Type (argv[1], T_Symbol); + if (EQ (argv[1], Sym_Incremental_GC)) + flags = GC_FLAGS_INCR; + else Primitive_Error ("unknown GC strategy: ~s", argv[1]); + } } return Internal_GC_Status (strat, flags); } diff --git a/src/io.c b/src/io.c index 964ac91..d3aac94 100644 --- a/src/io.c +++ b/src/io.c @@ -64,9 +64,9 @@ void Init_Io () { void Reset_IO (int destructive) { Discard_Input (Curr_Input_Port); if (destructive) - Discard_Output (Curr_Output_Port); + Discard_Output (Curr_Output_Port); else - Flush_Output (Curr_Output_Port); + Flush_Output (Curr_Output_Port); Curr_Input_Port = Standard_Input_Port; Curr_Output_Port = Standard_Output_Port; } @@ -121,9 +121,9 @@ int Path_Max () { #elif defined(PC_PATH_MAX_IN_UNISTD_H) static int r; if (r == 0) { - if ((r = pathconf ("/", _PC_PATH_MAX)) == -1) - r = 1024; - r++; + if ((r = pathconf ("/", _PC_PATH_MAX)) == -1) + r = 1024; + r++; } return r; #else @@ -135,11 +135,11 @@ Object Get_File_Name (Object name) { register int len; if (TYPE(name) == T_Symbol) - name = SYMBOL(name)->name; + name = SYMBOL(name)->name; else if (TYPE(name) != T_String) - Wrong_Type_Combination (name, "string or symbol"); + Wrong_Type_Combination (name, "string or symbol"); if ((len = STRING(name)->size) > Path_Max () || len == 0) - Primitive_Error ("invalid file name"); + Primitive_Error ("invalid file name"); return name; } @@ -148,17 +148,17 @@ char *Internal_Tilde_Expand (register char *s, register char **dirp) { struct passwd *pw, *getpwnam(); if (*s++ != '~') - return 0; + return 0; for (p = s; *p && *p != '/'; p++) - ; + ; if (*p == '/') *p++ = 0; if (*s == '\0') { - if ((*dirp = getenv ("HOME")) == 0) - *dirp = ""; + if ((*dirp = getenv ("HOME")) == 0) + *dirp = ""; } else { - if ((pw = getpwnam (s)) == 0) - Primitive_Error ("unknown user: ~a", Make_String (s, strlen (s))); - *dirp = pw->pw_dir; + if ((pw = getpwnam (s)) == 0) + Primitive_Error ("unknown user: ~a", Make_String (s, strlen (s))); + *dirp = pw->pw_dir; } return p; } @@ -172,27 +172,27 @@ Object General_File_Operation (Object s, register int op) { Get_Strsym_Stack (fn, r); switch (op) { case 0: { - char *p, *dir; - if ((p = Internal_Tilde_Expand (r, &dir)) == 0) { - Alloca_End; - return s; - } - Alloca (r, char*, strlen (dir) + 1 + strlen (p) + 1); - sprintf (r, "%s/%s", dir, p); - ret = Make_String (r, strlen (r)); - Alloca_End; - return ret; + char *p, *dir; + if ((p = Internal_Tilde_Expand (r, &dir)) == 0) { + Alloca_End; + return s; + } + Alloca (r, char*, strlen (dir) + 1 + strlen (p) + 1); + sprintf (r, "%s/%s", dir, p); + ret = Make_String (r, strlen (r)); + Alloca_End; + return ret; } case 1: { - struct stat st; - /* Doesn't make much sense to check for errno != ENOENT here: - */ - ret = stat (r, &st) == 0 ? True : False; - Alloca_End; - return ret; + struct stat st; + /* Doesn't make much sense to check for errno != ENOENT here: + */ + ret = stat (r, &st) == 0 ? True : False; + Alloca_End; + return ret; } default: { - return Null; /* Just to avoid compiler warnings */ + return Null; /* Just to avoid compiler warnings */ }} /*NOTREACHED*/ } @@ -223,13 +223,13 @@ Object Open_File (char *name, int flags, int err) { Alloca_Begin; if ((p = Internal_Tilde_Expand (name, &dir))) { - Alloca (name, char*, strlen (dir) + 1 + strlen (p) + 1); - sprintf (name, "%s/%s", dir, p); + Alloca (name, char*, strlen (dir) + 1 + strlen (p) + 1); + sprintf (name, "%s/%s", dir, p); } if (!err && stat (name, &st) == -1 && - (errno == ENOENT || errno == ENOTDIR)) { - Alloca_End; - return Null; + (errno == ENOENT || errno == ENOTDIR)) { + Alloca_End; + return Null; } switch (flags & (P_INPUT|P_BIDIR)) { case 0: p = "w"; break; @@ -239,8 +239,8 @@ Object Open_File (char *name, int flags, int err) { fn = Make_String (name, strlen (name)); Disable_Interrupts; if ((f = fopen (name, p)) == NULL) { - Saved_Errno = errno; /* errno valid here? */ - Primitive_Error ("~s: ~E", fn); + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("~s: ~E", fn); } port = Make_Port (flags, f, fn); Register_Object (port, (GENERIC)0, Terminate_File, 0); @@ -260,37 +260,37 @@ Object General_Open_File (Object name, int flags, Object path) { len = STRING(name)->size; fn = STRING(name)->data; if (fn[0] != '/' && fn[0] != '~') { - for ( ; TYPE(path) == T_Pair; path = Cdr (path)) { - pref = Car (path); - if (TYPE(pref) == T_Symbol) - pref = SYMBOL(pref)->name; - if (TYPE(pref) != T_String) - continue; - gotpath = 1; - if ((plen = STRING(pref)->size) > Path_Max () || plen == 0) - continue; - if (len + plen + 2 > blen) { - blen = len + plen + 2; - Alloca (buf, char*, blen); - } - memcpy (buf, STRING(pref)->data, plen); - if (buf[plen-1] != '/') - buf[plen++] = '/'; - memcpy (buf+plen, fn, len); - buf[len+plen] = '\0'; - port = Open_File (buf, flags, 0); - /* No GC has been taken place in Open_File() if it returns Null. - */ - if (!Nullp (port)) { - Alloca_End; - return port; - } - } + for ( ; TYPE(path) == T_Pair; path = Cdr (path)) { + pref = Car (path); + if (TYPE(pref) == T_Symbol) + pref = SYMBOL(pref)->name; + if (TYPE(pref) != T_String) + continue; + gotpath = 1; + if ((plen = STRING(pref)->size) > Path_Max () || plen == 0) + continue; + if (len + plen + 2 > blen) { + blen = len + plen + 2; + Alloca (buf, char*, blen); + } + memcpy (buf, STRING(pref)->data, plen); + if (buf[plen-1] != '/') + buf[plen++] = '/'; + memcpy (buf+plen, fn, len); + buf[len+plen] = '\0'; + port = Open_File (buf, flags, 0); + /* No GC has been taken place in Open_File() if it returns Null. + */ + if (!Nullp (port)) { + Alloca_End; + return port; + } + } } if (gotpath) - Primitive_Error ("file ~s not found", name); + Primitive_Error ("file ~s not found", name); if (len + 1 > blen) - Alloca (buf, char*, len + 1); + Alloca (buf, char*, len + 1); memcpy (buf, fn, len); buf[len] = '\0'; port = Open_File (buf, flags, 1); @@ -317,18 +317,18 @@ Object General_Close_Port (Object port) { Check_Type (port, T_Port); flags = PORT(port)->flags; if (!(flags & P_OPEN) || (flags & P_STRING)) - return Void; + return Void; f = PORT(port)->file; if (f == stdin || f == stdout) - return Void; + return Void; if ((PORT(port)->closefun) (f) == EOF) { - Saved_Errno = errno; /* errno valid here? */ - err++; + Saved_Errno = errno; /* errno valid here? */ + err++; } PORT(port)->flags &= ~P_OPEN; Deregister_Object (port); if (err) - Primitive_Error ("write error on ~s: ~E", port); + Primitive_Error ("write error on ~s: ~E", port); return Void; } @@ -341,7 +341,7 @@ Object P_Close_Output_Port (Object port) { } #define General_With(prim,curr,flags) Object prim (name, thunk)\ - Object name, thunk; {\ + Object name, thunk; {\ Object old, ret;\ GC_Node2;\ \ diff --git a/src/libelk.c b/src/libelk.c index d7bec04..ac65603 100644 --- a/src/libelk.c +++ b/src/libelk.c @@ -187,7 +187,7 @@ int main (int ac, char **av) { memset (unused, 0, 1); /* see comment above */ #endif if (ac == 0) { - av[0] = "Elk"; ac = 1; + av[0] = "Elk"; ac = 1; } Get_Stack_Limit (); @@ -199,72 +199,72 @@ int main (int ac, char **av) { First_Arg = 1; #ifdef CAN_DUMP if (Was_Dumped) { - /* Check if beginning of stack has moved by a large amount. - * This is the case, for instance, on a Sun-4m when the - * interpreter was dumped on a Sun-4c and vice versa. - */ - if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) { - fprintf (stderr, + /* Check if beginning of stack has moved by a large amount. + * This is the case, for instance, on a Sun-4m when the + * interpreter was dumped on a Sun-4c and vice versa. + */ + if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) { + fprintf (stderr, "Can't restart dumped interpreter from a different machine architecture\n"); - fprintf (stderr, + fprintf (stderr, " (Stack delta = %lld bytes).\n", (long long int)(ptrdiff_t)(stkbase - &foo)); - exit (1); - } - /* Check if program break must be reset. - */ - if ((ptrdiff_t)Brk_On_Dump && (ptrdiff_t)brk (Brk_On_Dump) - == (ptrdiff_t)-1) { - perror ("brk"); exit (1); - } + exit (1); + } + /* Check if program break must be reset. + */ + if ((ptrdiff_t)Brk_On_Dump && (ptrdiff_t)brk (Brk_On_Dump) + == (ptrdiff_t)-1) { + perror ("brk"); exit (1); + } #if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB) - Restore_Shared_Data (); + Restore_Shared_Data (); #endif #ifdef GENERATIONAL_GC - Generational_GC_Reinitialize (); + Generational_GC_Reinitialize (); #endif - Loader_Input = 0; - Install_Intr_Handler (); - (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0); - /*NOTREACHED*/ + Loader_Input = 0; + Install_Intr_Handler (); + (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0); + /*NOTREACHED*/ } #endif for ( ; First_Arg < ac; First_Arg++) { - if (strcmp (av[First_Arg], "-g") == 0) { - debug = 1; - } else if (strcmp (av[First_Arg], "-i") == 0) { - Case_Insensitive = 1; - } else if (strcmp (av[First_Arg], "-v") == 0) { - if (++First_Arg == ac) - Usage (); - if (strcmp (av[First_Arg], "load") == 0) - Verb_Load = 1; - else if (strcmp (av[First_Arg], "init") == 0) - Verb_Init = 1; - else Usage (); - } else if (strcmp (av[First_Arg], "-h") == 0) { - if (++First_Arg == ac) - Usage (); - if ((heap = atoi (av[First_Arg])) <= 0) { - fprintf (stderr, "Heap size must be a positive number.\n"); - exit (1); - } - } else if (strcmp (av[First_Arg], "-l") == 0) { - if (++First_Arg == ac || loadfile) - Usage (); - loadfile = av[First_Arg]; - } else if (strcmp (av[First_Arg], "-p") == 0) { - if (++First_Arg == ac || loadpath) - Usage (); - loadpath = av[First_Arg]; - } else if (strcmp (av[First_Arg], "--") == 0) { - First_Arg++; - break; - } else if (av[First_Arg][0] == '-') { - Usage (); - } else { - break; - } + if (strcmp (av[First_Arg], "-g") == 0) { + debug = 1; + } else if (strcmp (av[First_Arg], "-i") == 0) { + Case_Insensitive = 1; + } else if (strcmp (av[First_Arg], "-v") == 0) { + if (++First_Arg == ac) + Usage (); + if (strcmp (av[First_Arg], "load") == 0) + Verb_Load = 1; + else if (strcmp (av[First_Arg], "init") == 0) + Verb_Init = 1; + else Usage (); + } else if (strcmp (av[First_Arg], "-h") == 0) { + if (++First_Arg == ac) + Usage (); + if ((heap = atoi (av[First_Arg])) <= 0) { + fprintf (stderr, "Heap size must be a positive number.\n"); + exit (1); + } + } else if (strcmp (av[First_Arg], "-l") == 0) { + if (++First_Arg == ac || loadfile) + Usage (); + loadfile = av[First_Arg]; + } else if (strcmp (av[First_Arg], "-p") == 0) { + if (++First_Arg == ac || loadpath) + Usage (); + loadpath = av[First_Arg]; + } else if (strcmp (av[First_Arg], "--") == 0) { + First_Arg++; + break; + } else if (av[First_Arg][0] == '-') { + Usage (); + } else { + break; + } } stkbase = &foo; @@ -274,14 +274,14 @@ int main (int ac, char **av) { Init_Everything (); #ifdef HAVE_ATEXIT if (atexit (Exit_Handler) != 0) - Fatal_Error ("atexit returned non-zero value"); + Fatal_Error ("atexit returned non-zero value"); #endif #ifdef INIT_OBJECTS #ifdef NOMAIN if (init_objects) { - Set_Error_Tag ("init-objects"); - The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); - Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); + Set_Error_Tag ("init-objects"); + The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); + Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); } #else Set_Error_Tag ("init-objects"); @@ -291,7 +291,7 @@ int main (int ac, char **av) { #endif #endif if (loadpath || (loadpath = getenv (LOADPATH_ENV))) - Init_Loadpath (loadpath); + Init_Loadpath (loadpath); /* The following code is sort of a hack. initscheme.scm should not * be resolved against load-path. However, the .scm-files may not @@ -304,9 +304,9 @@ int main (int ac, char **av) { initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE) + 1); sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); if (stat (initfile, &st) == -1 && errno == ENOENT) - file = Make_String (INITFILE, sizeof(INITFILE)-1); + file = Make_String (INITFILE, sizeof(INITFILE)-1); else - file = Make_String (initfile, strlen (initfile)); + file = Make_String (initfile, strlen (initfile)); free (initfile); (void)General_Load (file, The_Environment); @@ -315,23 +315,23 @@ int main (int ac, char **av) { Set_Error_Tag ("top-level"); #ifdef NOMAIN if (toplevel == 0) { - Interpreter_Initialized = 1; - GC_Debug = debug; - return; + Interpreter_Initialized = 1; + GC_Debug = debug; + return; } /* Special case: if toplevel is "", act as if run from main() */ if (loadfile == 0 && toplevel[0] != '\0') - loadfile = toplevel; + loadfile = toplevel; #endif if (loadfile == 0) - loadfile = "toplevel.scm"; + loadfile = "toplevel.scm"; file = Make_String (loadfile, strlen (loadfile)); Interpreter_Initialized = 1; GC_Debug = debug; if (loadfile[0] == '-' && loadfile[1] == '\0') - Load_Source_Port (Standard_Input_Port); + Load_Source_Port (Standard_Input_Port); else - (void)General_Load (file, The_Environment); + (void)General_Load (file, The_Environment); #ifndef NOMAIN return 0; #endif @@ -357,7 +357,7 @@ void Usage () { fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]); for (p = Usage_Msg; *p; p++) - fprintf (stderr, "%s\n", *p); + fprintf (stderr, "%s\n", *p); exit (1); } @@ -393,8 +393,8 @@ void Get_Stack_Limit () { struct rlimit rl; if (getrlimit (RLIMIT_STACK, &rl) == -1) { - perror ("getrlimit"); - exit (1); + perror ("getrlimit"); + exit (1); } Max_Stack = rl.rlim_cur; #endif @@ -406,7 +406,7 @@ int Executable (char *fn) { struct stat s; return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG - && access (fn, X_OK) != -1; + && access (fn, X_OK) != -1; } char *Find_Executable (char *fn) { @@ -415,30 +415,30 @@ char *Find_Executable (char *fn) { register char *p; for (p = fn; *p; p++) { - if (*p == '/') { - if (Executable (fn)) - return fn; - else - Fatal_Error ("%s is not executable", fn); - } + if (*p == '/') { + if (Executable (fn)) + return fn; + else + Fatal_Error ("%s is not executable", fn); + } } if ((path = getenv ("PATH")) == 0) - path = ":/usr/ucb:/bin:/usr/bin"; + path = ":/usr/ucb:/bin:/usr/bin"; dir = path; do { - p = buf; - while (*dir && *dir != ':') - *p++ = *dir++; - if (*dir) - ++dir; - if (p > buf) - *p++ = '/'; - strcpy (p, fn); - if (Executable (buf)) - return buf; + p = buf; + while (*dir && *dir != ':') + *p++ = *dir++; + if (*dir) + ++dir; + if (p > buf) + *p++ = '/'; + strcpy (p, fn); + if (Executable (buf)) + return buf; } while (*dir); if (dir > path && dir[-1] == ':' && Executable (fn)) - return fn; + return fn; Fatal_Error ("cannot find pathname of %s", fn); /*NOTREACHED*/ } @@ -452,10 +452,10 @@ Object P_Command_Line_Args () { ret = tail = P_Make_List (Make_Integer (Argc-First_Arg), Null); GC_Link2 (ret, tail); for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) { - Object a; + Object a; - a = Make_String (Argv[i], strlen (Argv[i])); - Car (tail) = a; + a = Make_String (Argv[i], strlen (Argv[i])); + Car (tail) = a; } GC_Unlink; return ret; diff --git a/src/list.c b/src/list.c index 5c7583d..e85fb54 100644 --- a/src/list.c +++ b/src/list.c @@ -58,12 +58,12 @@ Object P_Cons (Object car, Object cdr) { p = Hp; ALIGN(p); if (p + sizeof (struct S_Pair) <= Heap_End && !GC_Debug) { - Hp = p + sizeof (struct S_Pair); - SET(cell, T_Pair, (struct S_Pair *)p); + Hp = p + sizeof (struct S_Pair); + SET(cell, T_Pair, (struct S_Pair *)p); } else { - GC_Link2 (car, cdr); - cell = Alloc_Object (sizeof (struct S_Pair), T_Pair, 0); - GC_Unlink; + GC_Link2 (car, cdr); + cell = Alloc_Object (sizeof (struct S_Pair), T_Pair, 0); + GC_Unlink; } #endif Car (cell) = car; @@ -85,11 +85,11 @@ Object Cxr (Object x, register char *pat, register int len) { Object ret; for (ret = x, pat += len; len > 0; len--) - switch (*--pat) { - case 'a': ret = P_Car (ret); break; - case 'd': ret = P_Cdr (ret); break; - default: Primitive_Error ("invalid pattern"); - } + switch (*--pat) { + case 'a': ret = P_Car (ret); break; + case 'd': ret = P_Cdr (ret); break; + default: Primitive_Error ("invalid pattern"); + } return ret; } @@ -127,9 +127,9 @@ Object P_Cddddr (Object x) { return Cxr (x, "dddd", 4); } Object P_Cxr (Object x, Object pat) { Check_List (x); if (TYPE(pat) == T_Symbol) - pat = SYMBOL(pat)->name; + pat = SYMBOL(pat)->name; else if (TYPE(pat) != T_String) - Wrong_Type_Combination (pat, "string or symbol"); + Wrong_Type_Combination (pat, "string or symbol"); return Cxr (x, STRING(pat)->data, STRING(pat)->size); } @@ -146,12 +146,12 @@ Object P_Listp (Object x) { register int f; for (s = x, f = 0; !Nullp (x); f ^= 1) { - if (TYPE(x) != T_Pair) - return False; - x = Cdr (x); - if (EQ(x, s)) - return False; - if (f) s = Cdr (s); + if (TYPE(x) != T_Pair) + return False; + x = Cdr (x); + if (EQ(x, s)) + return False; + if (f) s = Cdr (s); } return True; } @@ -174,14 +174,14 @@ Object General_Member (Object key, Object list, register int comp) { register int r; for ( ; !Nullp (list); list = Cdr (list)) { - Check_List (list); - if (comp == 0) - r = EQ(Car (list), key); - else if (comp == 1) - r = Eqv (Car (list), key); - else - r = Equal (Car (list), key); - if (r) return list; + Check_List (list); + if (comp == 0) + r = EQ(Car (list), key); + else if (comp == 1) + r = Eqv (Car (list), key); + else + r = Equal (Car (list), key); + if (r) return list; } return False; } @@ -203,17 +203,17 @@ Object General_Assoc (Object key, Object alist, register int comp) { register int r; for ( ; !Nullp (alist); alist = Cdr (alist)) { - Check_List (alist); - elem = Car (alist); - if (TYPE(elem) != T_Pair) - continue; - if (comp == 0) - r = EQ(Car (elem), key); - else if (comp == 1) - r = Eqv (Car (elem), key); - else - r = Equal (Car (elem), key); - if (r) return elem; + Check_List (alist); + elem = Car (alist); + if (TYPE(elem) != T_Pair) + continue; + if (comp == 0) + r = EQ(Car (elem), key); + else if (comp == 1) + r = Eqv (Car (elem), key); + else + r = Equal (Car (elem), key); + if (r) return elem; } return False; } @@ -235,7 +235,7 @@ int Fast_Length (Object list) { register int i; for (i = 0, tail = list; TYPE(tail) == T_Pair; tail = Cdr (tail), i++) - ; + ; return i; } @@ -244,7 +244,7 @@ Object P_Length (Object list) { register int i; for (i = 0, tail = list; !Nullp (tail); tail = Cdr (tail), i++) - Check_List (tail); + Check_List (tail); return Make_Integer (i); } @@ -254,11 +254,11 @@ Object P_Make_List (Object n, Object init) { GC_Node; if ((len = Get_Exact_Integer (n)) < 0) - Range_Error (n); + Range_Error (n); list = Null; GC_Link (init); while (len-- > 0) - list = Cons (init, list); + list = Cons (init, list); GC_Unlink; return list; } @@ -269,11 +269,11 @@ Object P_List (int argc, Object *argv) { GC_Link2 (list, tail); for (list = tail = Null; argc-- > 0; tail = cell) { - cell = Cons (*argv++, Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); + cell = Cons (*argv++, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); } GC_Unlink; return list; @@ -293,21 +293,21 @@ Object P_Append (int argc, Object *argv) { list = last = Null; GC_Link3 (list, last, tail); for (i = 0; i < argc-1; i++) { - for (tail = argv[i]; !Nullp (tail); tail = Cdr (tail)) { - Check_List (tail); - cell = Cons (Car (tail), Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (last, cell); - last = cell; - } + for (tail = argv[i]; !Nullp (tail); tail = Cdr (tail)) { + Check_List (tail); + cell = Cons (Car (tail), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (last, cell); + last = cell; + } } if (argc) { - if (Nullp (list)) - list = argv[i]; - else - (void)P_Set_Cdr (last, argv[i]); + if (Nullp (list)) + list = argv[i]; + else + (void)P_Set_Cdr (last, argv[i]); } GC_Unlink; return list; @@ -317,12 +317,12 @@ Object P_Append_Set (int argc, Object *argv) { register int i, j; for (i = j = 0; i < argc; i++) - if (!Nullp (argv[i])) - argv[j++] = argv[i]; + if (!Nullp (argv[i])) + argv[j++] = argv[i]; if (j == 0) - return Null; + return Null; for (i = 0; i < j-1; i++) - (void)P_Set_Cdr (P_Last_Pair (argv[i]), argv[i+1]); + (void)P_Set_Cdr (P_Last_Pair (argv[i]), argv[i+1]); return *argv; } @@ -332,8 +332,8 @@ Object P_Reverse (Object x) { GC_Link (x); for (ret = Null; !Nullp (x); x = Cdr (x)) { - Check_List (x); - ret = Cons (Car (x), ret); + Check_List (x); + ret = Cons (Car (x), ret); } GC_Unlink; return ret; @@ -343,9 +343,9 @@ Object P_Reverse_Set (Object x) { Object prev, tail; for (prev = Null; !Nullp (x); prev = x, x = tail) { - Check_List (x); - tail = Cdr (x); - (void)P_Set_Cdr (x, prev); + Check_List (x); + tail = Cdr (x); + (void)P_Set_Cdr (x, prev); } return prev; } @@ -354,7 +354,7 @@ Object P_List_Tail (Object x, Object num) { register int n; for (n = Get_Exact_Integer (num); n > 0 && !Nullp (x); n--, x = P_Cdr (x)) - ; + ; return x; } @@ -367,14 +367,14 @@ Object Copy_List (Object x) { GC_Node3; if (TYPE(x) == T_Pair) { - if (Stack_Size () > Max_Stack) - Uncatchable_Error ("Out of stack space"); - car = cdr = Null; - GC_Link3 (x, car, cdr); - car = Copy_List (Car (x)); - cdr = Copy_List (Cdr (x)); - x = Cons (car, cdr); - GC_Unlink; + if (Stack_Size () > Max_Stack) + Uncatchable_Error ("Out of stack space"); + car = cdr = Null; + GC_Link3 (x, car, cdr); + car = Copy_List (Car (x)); + cdr = Copy_List (Cdr (x)); + x = Cons (car, cdr); + GC_Unlink; } return x; } diff --git a/src/load-dl.c b/src/load-dl.c index e86e3fe..3470b08 100644 --- a/src/load-dl.c +++ b/src/load-dl.c @@ -41,21 +41,21 @@ void Dlopen_File (char *fn) { SYM *sp; if (Verb_Load) - printf ("[dlopen %s]\n", fn); + printf ("[dlopen %s]\n", fn); if ((handle = dlopen (fn, RTLD_NOW|RTLD_GLOBAL)) == 0) { - char *errstr = dlerror (); - Primitive_Error ("dlopen failed:~%~s", - Make_String (errstr, strlen (errstr))); + char *errstr = dlerror (); + Primitive_Error ("dlopen failed:~%~s", + Make_String (errstr, strlen (errstr))); } if (The_Symbols) - Free_Symbols (The_Symbols); + Free_Symbols (The_Symbols); The_Symbols = Open_File_And_Snarf_Symbols (fn); /* * dlsym() may fail for symbols not exported by object file; * this can be safely ignored. */ for (sp = The_Symbols->first; sp; sp = sp->next) - sp->value = (unsigned long int)dlsym (handle, sp->name); + sp->value = (unsigned long int)dlsym (handle, sp->name); Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); Call_Initializers (The_Symbols, 0, PR_EXTENSION); } @@ -67,12 +67,12 @@ static int Seq_Num; char *Temp_Name (int seq) { if (!tempname) { - if (!(tmpdir = getenv ("TMPDIR"))) - tmpdir = "/tmp"; - tempname = Safe_Malloc (tmplen = strlen (tmpdir) + 20); - sprintf (tempname, "%s/ldXXXXXX", tmpdir); - (void)mktemp (tempname); - strcat (tempname, "."); + if (!(tmpdir = getenv ("TMPDIR"))) + tmpdir = "/tmp"; + tempname = Safe_Malloc (tmplen = strlen (tmpdir) + 20); + sprintf (tempname, "%s/ldXXXXXX", tmpdir); + (void)mktemp (tempname); + strcat (tempname, "."); } sprintf (strrchr (tempname, '.'), ".%d", seq); return tempname; @@ -83,15 +83,15 @@ void Fork_Load () { char *newtemp; if (!tempname) - return; + return; Disable_Interrupts; newtemp = Safe_Malloc (tmplen); sprintf (newtemp, "%s/ldXXXXXX", tmpdir); (void)mktemp (newtemp); strcat (newtemp, "."); for (i = 0; i < Seq_Num; i++) { - sprintf (strrchr (newtemp, '.'), ".%d", i); - (void)link (Temp_Name (i), newtemp); + sprintf (strrchr (newtemp, '.'), ".%d", i); + (void)link (Temp_Name (i), newtemp); } free (tempname); tempname = newtemp; @@ -108,20 +108,20 @@ void Load_Object (Object names) { port = tail = fullnames = Null; GC_Link3 (port, tail, fullnames); for (len = 0, tail = names; !Nullp (tail); tail = Cdr (tail)) { - port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); - fullnames = Cons (PORT(port)->name, fullnames); - len += STRING(Car (fullnames))->size + 1; - (void)P_Close_Input_Port (port); + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + len += STRING(Car (fullnames))->size + 1; + (void)P_Close_Input_Port (port); } GC_Unlink; libs = Var_Get (V_Load_Libraries); if (TYPE(libs) == T_String) { - liblen = STRING(libs)->size; - lp = STRING(libs)->data; + liblen = STRING(libs)->size; + lp = STRING(libs)->data; } else { - liblen = 0; - lp = ""; + liblen = 0; + lp = ""; } Disable_Interrupts; @@ -134,22 +134,22 @@ void Load_Object (Object names) { sprintf (buf, "%s %s -o %s ", LD_NAME, LDFLAGS_SHARED, outfile); for (tail = fullnames; !Nullp (tail); tail = Cdr (tail)) { - register struct S_String *str = STRING(Car (tail)); - strncat (buf, str->data, str->size); - strcat (buf, " "); + register struct S_String *str = STRING(Car (tail)); + strncat (buf, str->data, str->size); + strcat (buf, " "); } for (i = 0; i < Seq_Num-1; i++) { - strcat (buf, Temp_Name (i)); - strcat (buf, " "); + strcat (buf, Temp_Name (i)); + strcat (buf, " "); } strncat (buf, lp, liblen); if (Verb_Load) - printf ("[%s]\n", buf); + printf ("[%s]\n", buf); if (system (buf) != 0) { - Seq_Num--; - (void)unlink (outfile); - Primitive_Error ("system linker failed"); + Seq_Num--; + (void)unlink (outfile); + Primitive_Error ("system linker failed"); } Dlopen_File (outfile); Enable_Interrupts; @@ -160,7 +160,7 @@ void Load_Lib (Object libs) { Object port, name; if (Nullp (libs)) - return; + return; Load_Lib (Cdr (libs)); @@ -184,7 +184,7 @@ void Finit_Load () { int i; for (i = 0; i < Seq_Num; i++) - (void)unlink (Temp_Name (i)); + (void)unlink (Temp_Name (i)); /* * The linker in SGI Irix 5 produces this file: */ diff --git a/src/load-ld.c b/src/load-ld.c index bfc3505..270ca50 100644 --- a/src/load-ld.c +++ b/src/load-ld.c @@ -74,11 +74,11 @@ void Load_Object (Object names) { li = Loader_Input; if (!li) - li = A_Out_Name; + li = A_Out_Name; if (!Loader_Output) { - if (!(tmpdir = getenv ("TMPDIR"))) - tmpdir = "/tmp"; - Loader_Output = Safe_Malloc (strlen (tmpdir) + 20); + if (!(tmpdir = getenv ("TMPDIR"))) + tmpdir = "/tmp"; + Loader_Output = Safe_Malloc (strlen (tmpdir) + 20); } sprintf (Loader_Output, "%s/ldXXXXXX", tmpdir); (void)mktemp (Loader_Output); @@ -86,19 +86,19 @@ void Load_Object (Object names) { port = tail = fullnames = Null; GC_Link3 (port, tail, fullnames); for (len = 0, tail = names; !Nullp (tail); tail = Cdr (tail)) { - port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); - fullnames = Cons (PORT(port)->name, fullnames); - len += STRING(Car (fullnames))->size + 1; - (void)P_Close_Input_Port (port); + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + len += STRING(Car (fullnames))->size + 1; + (void)P_Close_Input_Port (port); } GC_Unlink; libs = Var_Get (V_Load_Libraries); if (TYPE(libs) == T_String) { liblen = STRING(libs)->size; - lp = STRING(libs)->data; + lp = STRING(libs)->data; } else { - liblen = 3; lp = "-lc"; + liblen = 3; lp = "-lc"; } Alloca (buf, char*, strlen (A_Out_Name) + len + liblen + 100); @@ -111,35 +111,35 @@ void Load_Object (Object names) { #else sprintf (buf, "%s -N %s -A %s -T %x -o %s ", #endif - LD_NAME, INC_LDFLAGS, li, (unsigned int)brk, Loader_Output); + LD_NAME, INC_LDFLAGS, li, (unsigned int)brk, Loader_Output); for (tail = fullnames; !Nullp (tail); tail = Cdr (tail)) { - register struct S_String *str = STRING(Car (tail)); - strncat (buf, str->data, str->size); - strcat (buf, " "); + register struct S_String *str = STRING(Car (tail)); + strncat (buf, str->data, str->size); + strcat (buf, " "); } strncat (buf, lp, liblen); if (Verb_Load) - printf ("[%s]\n", buf); + printf ("[%s]\n", buf); if (system (buf) != 0) { - (void)unlink (Loader_Output); - Primitive_Error ("system linker failed"); + (void)unlink (Loader_Output); + Primitive_Error ("system linker failed"); } Disable_Interrupts; /* To ensure that f gets closed */ if ((f = open (Loader_Output, O_RDONLY|O_BINARY)) == -1) { - (void)unlink (Loader_Output); - Primitive_Error ("cannot open tempfile"); + (void)unlink (Loader_Output); + Primitive_Error ("cannot open tempfile"); } if (Loader_Input) - (void)unlink (Loader_Input); + (void)unlink (Loader_Input); else - Loader_Input = Safe_Malloc (strlen (tmpdir) + 20); + Loader_Input = Safe_Malloc (strlen (tmpdir) + 20); strcpy (Loader_Input, Loader_Output); if (read (f, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) { err: - close (f); - Primitive_Error ("corrupt tempfile (`ld' is broken)"); + close (f); + Primitive_Error ("corrupt tempfile (`ld' is broken)"); } #ifdef ECOFF n = hdr.aout.tsize + hdr.aout.dsize + hdr.aout.bsize; @@ -147,8 +147,8 @@ err: n = hdr.a_text + hdr.a_data + hdr.a_bss; #endif if ((char *)sbrk (n + brk-obrk) == (char *)-1) { - close (f); - Primitive_Error ("not enough memory to load object file"); + close (f); + Primitive_Error ("not enough memory to load object file"); } memset (brk, 0, n); #ifdef ECOFF @@ -158,20 +158,20 @@ err: n -= hdr.a_bss; #endif if (read (f, brk, n) != n) - goto err; + goto err; if ((fp = fdopen (f, O_BINARY ? "rb" : "r")) == NULL) { - close (f); - Primitive_Error ("cannot fdopen object file"); + close (f); + Primitive_Error ("cannot fdopen object file"); } if (The_Symbols) - Free_Symbols (The_Symbols); + Free_Symbols (The_Symbols); The_Symbols = Snarf_Symbols (fp, &hdr); (void)fclose (fp); #if defined(ECOFF) && defined(CACHECTL_H) if (cacheflush (brk, n, BCACHE) == -1) { - extern int errno; - Saved_Errno = errno; - Primitive_Error ("cacheflush failed: ~E"); + extern int errno; + Saved_Errno = errno; + Primitive_Error ("cacheflush failed: ~E"); } #endif Call_Initializers (The_Symbols, brk, PR_CONSTRUCTOR); @@ -182,20 +182,20 @@ err: void Finit_Load () { if (Loader_Input) - (void)unlink (Loader_Input); + (void)unlink (Loader_Input); } void Fork_Load () { char *newlink; if (Loader_Input) { - Disable_Interrupts; - newlink = Safe_Malloc (strlen (tmpdir) + 20); - sprintf (newlink, "%s/ldXXXXXX", tmpdir); - (void)mktemp (newlink); - (void)link (Loader_Input, newlink); - free (Loader_Input); - Loader_Input = newlink; - Enable_Interrupts; + Disable_Interrupts; + newlink = Safe_Malloc (strlen (tmpdir) + 20); + sprintf (newlink, "%s/ldXXXXXX", tmpdir); + (void)mktemp (newlink); + (void)link (Loader_Input, newlink); + free (Loader_Input); + Loader_Input = newlink; + Enable_Interrupts; } } diff --git a/src/load-rld.c b/src/load-rld.c index 90d52b6..b115127 100644 --- a/src/load-rld.c +++ b/src/load-rld.c @@ -47,54 +47,54 @@ void Load_Object (Object names) { port = tail = fullnames = Null; GC_Link3 (port, tail, fullnames); for (n = 0, tail = names; !Nullp (tail); n++, tail = Cdr (tail)) { - port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); - fullnames = Cons (PORT(port)->name, fullnames); - (void)P_Close_Input_Port (port); + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + (void)P_Close_Input_Port (port); } GC_Unlink; libs = ""; tail = Var_Get (V_Load_Libraries); if (TYPE(tail) == T_String) - Get_Strsym_Stack (tail, libs); + Get_Strsym_Stack (tail, libs); Alloca (filenames, char**, (n+1 + strlen (libs)/2) * sizeof (char *)); for (i = 0; i < n; i++, fullnames = Cdr (fullnames)) { - Object s; + Object s; - s = Car (fullnames); - Get_Strsym_Stack (s, filenames[i]); + s = Car (fullnames); + Get_Strsym_Stack (s, filenames[i]); } /* Append the load-libraries to the end of the list of filenames * to be passed to rld_load: */ for ( ; (filenames[i] = strtok (libs, " \t")) != 0; i++, libs = 0) - ; + ; if (Verb_Load) { - printf ("[rld_load: "); - for (i = 0; filenames[i]; i++) printf ("%s ", filenames[i]); - printf ("]\n"); + printf ("[rld_load: "); + for (i = 0; filenames[i]; i++) printf ("%s ", filenames[i]); + printf ("]\n"); } Disable_Interrupts; /* Construct a stream for error logging: */ if ((err_stream = NXOpenFile (fileno (stderr), NX_WRITEONLY)) == 0) - Primitive_Error ("NXOpenFile failed"); + Primitive_Error ("NXOpenFile failed"); retval = rld_load (err_stream, /* report error messages here */ - &hdr, /* return header address here */ - filenames, /* load these */ - "/dev/null"); /* doesn't work if NULL?! */ + &hdr, /* return header address here */ + filenames, /* load these */ + "/dev/null"); /* doesn't work if NULL?! */ NXClose (err_stream); if (retval != 1) - Primitive_Error ("rld_load() failed"); + Primitive_Error ("rld_load() failed"); /* Grab the symbol table from the just-loaded file: */ if (The_Symbols) - Free_Symbols (The_Symbols); + Free_Symbols (The_Symbols); The_Symbols = Snarf_Symbols (hdr); Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); Call_Initializers (The_Symbols, 0, PR_EXTENSION); diff --git a/src/load-shl.c b/src/load-shl.c index 531c42d..e5792a6 100644 --- a/src/load-shl.c +++ b/src/load-shl.c @@ -41,40 +41,40 @@ static void Load_Them (Object names) { shl_t handle; SYM *sp; static struct obj_loaded { - struct obj_loaded *next; - char *name; + struct obj_loaded *next; + char *name; } *loaded, *lp; GC_Node; Alloca_Begin; GC_Link(names); for ( ; !Nullp (names); names = Cdr (names)) { - Get_Strsym_Stack (Car (names), fn); - for (lp = loaded; lp; lp = lp->next) - if (strcmp (lp->name, fn) == 0) break; - if (lp) continue; - lp = (struct obj_loaded *)Safe_Malloc (sizeof (*lp)); - lp->name = strdup (fn); - lp->next = loaded; - loaded = lp; - if (Verb_Load) - printf ("[shl_load %s]\n", fn); - if ((handle = shl_load (fn, BIND_IMMEDIATE|BIND_VERBOSE, 0L)) == 0) { - Saved_Errno = errno; - Primitive_Error ("shl_load of ~s failed: ~E", Car (names)); - } - if (The_Symbols) - Free_Symbols (The_Symbols); - The_Symbols = Open_File_And_Snarf_Symbols (fn); - for (sp = The_Symbols->first; sp; sp = sp->next) - if (shl_findsym (&handle, sp->name, TYPE_UNDEFINED, &sp->value)) { - Saved_Errno = errno; - Primitive_Error ("~s: shl_findsym on ~s failed: ~E", - Car (names), - Make_String (sp->name, strlen (sp->name))); - } - Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); - Call_Initializers (The_Symbols, 0, PR_EXTENSION); + Get_Strsym_Stack (Car (names), fn); + for (lp = loaded; lp; lp = lp->next) + if (strcmp (lp->name, fn) == 0) break; + if (lp) continue; + lp = (struct obj_loaded *)Safe_Malloc (sizeof (*lp)); + lp->name = strdup (fn); + lp->next = loaded; + loaded = lp; + if (Verb_Load) + printf ("[shl_load %s]\n", fn); + if ((handle = shl_load (fn, BIND_IMMEDIATE|BIND_VERBOSE, 0L)) == 0) { + Saved_Errno = errno; + Primitive_Error ("shl_load of ~s failed: ~E", Car (names)); + } + if (The_Symbols) + Free_Symbols (The_Symbols); + The_Symbols = Open_File_And_Snarf_Symbols (fn); + for (sp = The_Symbols->first; sp; sp = sp->next) + if (shl_findsym (&handle, sp->name, TYPE_UNDEFINED, &sp->value)) { + Saved_Errno = errno; + Primitive_Error ("~s: shl_findsym on ~s failed: ~E", + Car (names), + Make_String (sp->name, strlen (sp->name))); + } + Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, 0, PR_EXTENSION); } GC_Unlink; Alloca_End; @@ -89,17 +89,17 @@ void Load_Object (Object names) { port = tail = fullnames = Null; GC_Link3 (port, tail, fullnames); for (tail = names; !Nullp (tail); tail = Cdr (tail)) { - port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); - fullnames = Cons (PORT(port)->name, fullnames); - (void)P_Close_Input_Port (port); + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + (void)P_Close_Input_Port (port); } tail = Var_Get (V_Load_Libraries); if (TYPE(tail) == T_String) - Get_Strsym_Stack (tail, libs); + Get_Strsym_Stack (tail, libs); Disable_Interrupts; for (tail = Null; (p = strtok (libs, " \t")) != 0; libs = 0) { - str = Make_String (p, strlen (p)); - tail = Cons (str, tail); + str = Make_String (p, strlen (p)); + tail = Cons (str, tail); } Load_Them (tail); Load_Them (fullnames); diff --git a/src/load.c b/src/load.c index 2ab8f02..f54806d 100644 --- a/src/load.c +++ b/src/load.c @@ -59,12 +59,12 @@ void Load_Source (Object); void Init_Load () { Define_Variable (&V_Load_Path, "load-path", - Cons (Make_String (".", 1), - Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1), - Cons (Make_String (OBJ_DIR, sizeof (OBJ_DIR) - 1), Null)))); + Cons (Make_String (".", 1), + Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1), + Cons (Make_String (OBJ_DIR, sizeof (OBJ_DIR) - 1), Null)))); Define_Variable (&V_Load_Noisilyp, "load-noisily?", False); Define_Variable (&V_Load_Libraries, "load-libraries", - Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1)); + Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1)); #ifdef CAN_LOAD_OBJ Register_Onfork (Fork_Load); #endif @@ -76,14 +76,14 @@ void Init_Loadpath (char *s) { /* No GC possible here */ path = Null; if (s[0] == '\0') - return; + return; while (1) { - for (p = s; *p && *p != ':'; p++) - ; - path = Cons (Make_String (s, p-s), path); - if (*p == '\0') - break; - s = ++p; + for (p = s; *p && *p != ':'; p++) + ; + path = Cons (Make_String (s, p-s), path); + if (*p == '\0') + break; + s = ++p; } Var_Set (V_Load_Path, P_Reverse (path)); } @@ -94,7 +94,7 @@ int Has_Suffix (Object name, char const *suffix) { register struct S_String *str; if (TYPE(name) == T_Symbol) - name = SYMBOL(name)->name; + name = SYMBOL(name)->name; str = STRING(name); p = str->data + str->size - len; return len <= str->size && !strncasecmp(p, suffix, len); @@ -105,17 +105,17 @@ void Check_Loadarg (Object x) { register int t = TYPE(x); if (t == T_Symbol || t == T_String) - return; + return; if (t != T_Pair) - Wrong_Type_Combination (x, "string, symbol, or list"); + Wrong_Type_Combination (x, "string, symbol, or list"); for (tail = x; !Nullp (tail); tail = Cdr (tail)) { - Object f; + Object f; - f = Car (tail); - if (TYPE(f) != T_Symbol && TYPE(f) != T_String) - Wrong_Type_Combination (f, "string or symbol"); - if (!Has_Suffix (f, ".o") && !Has_Suffix (f, ".so")) - Primitive_Error ("~s: not an object file", f); + f = Car (tail); + if (TYPE(f) != T_Symbol && TYPE(f) != T_String) + Wrong_Type_Combination (f, "string or symbol"); + if (!Has_Suffix (f, ".o") && !Has_Suffix (f, ".so")) + Primitive_Error ("~s: not an object file", f); } } @@ -129,29 +129,29 @@ Object General_Load (Object what, Object env) { Switch_Environment (env); Check_Loadarg (what); if (TYPE(what) == T_Pair) { - if (Has_Suffix (Car (what), ".o")) + if (Has_Suffix (Car (what), ".o")) #ifdef CAN_LOAD_OBJ - Load_Object (what) + Load_Object (what) #endif - ; - else if (Has_Suffix (Car (what), ".so")) + ; + else if (Has_Suffix (Car (what), ".so")) #ifdef CAN_LOAD_LIB - Load_Library (what) + Load_Library (what) #endif - ; + ; } else if (Has_Suffix (what, ".o")) #ifdef CAN_LOAD_OBJ - Load_Object (Cons (what, Null)) + Load_Object (Cons (what, Null)) #endif - ; + ; else if (Has_Suffix (what, ".so")) #ifdef CAN_LOAD_LIB - Load_Library (Cons (what, Null)) + Load_Library (Cons (what, Null)) #endif - ; + ; else - Load_Source (what); + Load_Source (what); Switch_Environment (oldenv); GC_Unlink; return Void; @@ -168,16 +168,16 @@ void Load_Source_Port (Object port) { GC_Link (port); while (1) { - val = General_Read (port, 1); - if (TYPE(val) == T_End_Of_File) - break; - TC_Disable; - val = Eval (val); - TC_Enable; - if (Var_Is_True (V_Load_Noisilyp)) { - Print (val); - (void)P_Newline (0, (Object *)0); - } + val = General_Read (port, 1); + if (TYPE(val) == T_End_Of_File) + break; + TC_Disable; + val = Eval (val); + TC_Enable; + if (Var_Is_True (V_Load_Noisilyp)) { + Print (val); + (void)P_Newline (0, (Object *)0); + } } GC_Unlink; } diff --git a/src/malloc.c b/src/malloc.c index 8c0a55c..af740ec 100644 --- a/src/malloc.c +++ b/src/malloc.c @@ -37,11 +37,11 @@ char *Safe_Malloc (unsigned int size) { Disable_Interrupts; if ((ret = malloc (size)) == 0) { - if (Interpreter_Initialized) - Primitive_Error ("not enough memory to malloc ~s bytes", - Make_Integer (size)); - else - Fatal_Error ("not enough memory to malloc %u bytes", size); + if (Interpreter_Initialized) + Primitive_Error ("not enough memory to malloc ~s bytes", + Make_Integer (size)); + else + Fatal_Error ("not enough memory to malloc %u bytes", size); } Enable_Interrupts; return ret; @@ -52,11 +52,11 @@ char *Safe_Realloc (char *ptr, unsigned int size) { Disable_Interrupts; if ((ret = ptr ? realloc (ptr, size) : malloc (size)) == 0) { - if (Interpreter_Initialized) - Primitive_Error ("not enough memory to malloc ~s bytes", - Make_Integer (size)); - else - Fatal_Error ("not enough memory to malloc %u bytes", size); + if (Interpreter_Initialized) + Primitive_Error ("not enough memory to malloc ~s bytes", + Make_Integer (size)); + else + Fatal_Error ("not enough memory to malloc %u bytes", size); } Enable_Interrupts; return ret; diff --git a/src/math.c b/src/math.c index 1b0cc42..74e7c46 100644 --- a/src/math.c +++ b/src/math.c @@ -59,23 +59,23 @@ Object Make_Integer (register int n) { Object Make_Unsigned (register unsigned int n) { if (UFIXNUM_FITS(n)) - return Make_Integer (n); + return Make_Integer (n); else - return Unsigned_To_Bignum (n); + return Unsigned_To_Bignum (n); } Object Make_Long (register long int n) { if (n < 0 ? (n < (long)INT_MIN) : (n > (long)INT_MAX)) - return Long_To_Bignum (n); + return Long_To_Bignum (n); else - return Make_Integer ((int)n); + return Make_Integer ((int)n); } Object Make_Unsigned_Long (register unsigned long int n) { if ((n & ~((unsigned long int)SIGNBIT-1)) == 0) - return Make_Integer ((int)n); + return Make_Integer ((int)n); else - return Unsigned_Long_To_Bignum (n); + return Unsigned_Long_To_Bignum (n); } Object Fixnum_To_String (Object x, int radix) { @@ -84,21 +84,21 @@ Object Fixnum_To_String (Object x, int radix) { register int n = FIXNUM(x), neg = 0; if (n == 0) - return Make_String ("0", 1); + return Make_String ("0", 1); if (n < 0) { - neg++; - n = -n; + neg++; + n = -n; } p = buf+31; *p = '\0'; while (n > 0) { - *--p = '0' + n % radix; - if (*p > '9') - *p = 'A' + (*p - '9') - 1; - n /= radix; + *--p = '0' + n % radix; + if (*p > '9') + *p = 'A' + (*p - '9') - 1; + n /= radix; } if (neg) - *--p = '-'; + *--p = '-'; return Make_String (p, strlen (p)); } @@ -108,8 +108,8 @@ char *Flonum_To_String (Object x) { sprintf (buf, "%.15g", FLONUM(x)->val); for (p = buf; *p; p++) - if (*p == '.' || *p == 'e' || *p == 'N' || *p == 'i') - return buf; + if (*p == '.' || *p == 'e' || *p == 'N' || *p == 'i') + return buf; *p++ = '.', *p++ = '0', *p++ = '\0'; return buf; } @@ -121,27 +121,27 @@ Object P_Number_To_String (int argc, Object *argv) { x = argv[0]; if (argc == 2) { - radix = Get_Exact_Integer (argv[1]); - switch (radix) { - case 2: case 8: case 10: case 16: - break; - default: - Primitive_Error ("invalid radix: ~s", argv[1]); - } + radix = Get_Exact_Integer (argv[1]); + switch (radix) { + case 2: case 8: case 10: case 16: + break; + default: + Primitive_Error ("invalid radix: ~s", argv[1]); + } } Check_Number (x); switch (TYPE(x)) { case T_Fixnum: - return Fixnum_To_String (x, radix); + return Fixnum_To_String (x, radix); case T_Bignum: - return Bignum_To_String (x, radix); + return Bignum_To_String (x, radix); case T_Flonum: - if (radix != 10) - Primitive_Error ("radix for reals must be 10"); /* bleah! */ - s = Flonum_To_String (x); - return Make_String (s, strlen (s)); + if (radix != 10) + Primitive_Error ("radix for reals must be 10"); /* bleah! */ + s = Flonum_To_String (x); + return Make_String (s, strlen (s)); default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -152,19 +152,19 @@ int Get_Integer (Object x) { switch (TYPE(x)) { case T_Fixnum: - return FIXNUM(x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Integer (x); + return Bignum_To_Integer (x); case T_Flonum: - d = FLONUM(x)->val; - if (d != floor (d)) - Wrong_Type (x, T_Fixnum); - (void)frexp (d, &expo); - if (expo <= 8 * (int)sizeof(int) - 1) - return d; - Primitive_Error ("integer out of range: ~s", x); + d = FLONUM(x)->val; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * (int)sizeof(int) - 1) + return d; + Primitive_Error ("integer out of range: ~s", x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -175,24 +175,24 @@ unsigned int Get_Unsigned (Object x) { switch (TYPE(x)) { case T_Fixnum: - if (FIXNUM(x) < 0) - goto err; - return FIXNUM(x); + if (FIXNUM(x) < 0) + goto err; + return FIXNUM(x); case T_Bignum: - return Bignum_To_Unsigned (x); + return Bignum_To_Unsigned (x); case T_Flonum: - d = FLONUM(x)->val; - if (d < 0) - goto err; - if (d != floor (d)) - Wrong_Type (x, T_Fixnum); - (void)frexp (d, &expo); - if (expo <= 8 * (int)sizeof(int)) - return d; + d = FLONUM(x)->val; + if (d < 0) + goto err; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * (int)sizeof(int)) + return d; err: - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -203,19 +203,19 @@ long int Get_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: - return FIXNUM(x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Long (x); + return Bignum_To_Long (x); case T_Flonum: - d = FLONUM(x)->val; - if (d != floor (d)) - Wrong_Type (x, T_Fixnum); - (void)frexp (d, &expo); - if (expo <= 8 * (int)sizeof(long) - 1) - return d; - Primitive_Error ("integer out of range: ~s", x); + d = FLONUM(x)->val; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * (int)sizeof(long) - 1) + return d; + Primitive_Error ("integer out of range: ~s", x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -226,24 +226,24 @@ unsigned long int Get_Unsigned_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: - if (FIXNUM(x) < 0) - goto err; - return (unsigned long int)FIXNUM(x); + if (FIXNUM(x) < 0) + goto err; + return (unsigned long int)FIXNUM(x); case T_Bignum: - return Bignum_To_Unsigned_Long (x); + return Bignum_To_Unsigned_Long (x); case T_Flonum: - d = FLONUM(x)->val; - if (d < 0) - goto err; - if (d != floor (d)) - Wrong_Type (x, T_Fixnum); - (void)frexp (d, &expo); - if (expo <= 8 * (int)sizeof(long)) - return d; + d = FLONUM(x)->val; + if (d < 0) + goto err; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * (int)sizeof(long)) + return d; err: - Primitive_Error ("integer out of range: ~s", x); + Primitive_Error ("integer out of range: ~s", x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -251,11 +251,11 @@ err: int Get_Exact_Integer (Object x) { switch (TYPE(x)) { case T_Fixnum: - return FIXNUM(x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Integer (x); + return Bignum_To_Integer (x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -263,13 +263,13 @@ int Get_Exact_Integer (Object x) { unsigned int Get_Exact_Unsigned (Object x) { switch (TYPE(x)) { case T_Fixnum: - if (FIXNUM(x) < 0) - Primitive_Error ("integer out of range: ~s", x); - return FIXNUM(x); + if (FIXNUM(x) < 0) + Primitive_Error ("integer out of range: ~s", x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Unsigned (x); + return Bignum_To_Unsigned (x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -277,11 +277,11 @@ unsigned int Get_Exact_Unsigned (Object x) { long int Get_Exact_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: - return FIXNUM(x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Long (x); + return Bignum_To_Long (x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -289,13 +289,13 @@ long int Get_Exact_Long (Object x) { unsigned long int Get_Exact_Unsigned_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: - if (FIXNUM(x) < 0) - Primitive_Error ("integer out of range: ~s", x); - return FIXNUM(x); + if (FIXNUM(x) < 0) + Primitive_Error ("integer out of range: ~s", x); + return FIXNUM(x); case T_Bignum: - return Bignum_To_Unsigned_Long (x); + return Bignum_To_Unsigned_Long (x); default: - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); } /*NOTREACHED*/ } @@ -306,7 +306,7 @@ int Get_Index (Object n, Object obj) { i = Get_Exact_Integer (n); size = TYPE(obj) == T_Vector ? VECTOR(obj)->size : STRING(obj)->size; if (i < 0 || i >= size) - Range_Error (n); + Range_Error (n); return i; } @@ -324,11 +324,11 @@ Object Make_Reduced_Flonum (double d) { int expo; if (floor (d) == d) { - if (d == 0) - return Zero; - (void)frexp (d, &expo); - if (expo <= FIXBITS-1) - return Make_Integer ((int)d); + if (d == 0) + return Zero; + (void)frexp (d, &expo); + if (expo <= FIXBITS-1) + return Make_Integer ((int)d); } num = Alloc_Object (sizeof (struct S_Flonum), T_Flonum, 0); FLONUM(num)->tag = Null; @@ -341,9 +341,9 @@ int Fixnum_Add (int a, int b, int *fits) { *fits = 1; if (a > 0 && b > 0) { - if (ret < 0) *fits = 0; + if (ret < 0) *fits = 0; } else if (a < 0 && b < 0) { - if (ret > 0) *fits = 0; + if (ret > 0) *fits = 0; } return ret; } @@ -353,9 +353,9 @@ int Fixnum_Sub (int a, int b, int *fits) { *fits = 1; if (a < 0 && b > 0) { - if (ret > 0) *fits = 0; + if (ret > 0) *fits = 0; } else if (a > 0 && b < 0) { - if (ret < 0) *fits = 0; + if (ret < 0) *fits = 0; } return ret; } @@ -371,31 +371,31 @@ Object Fixnum_Multiply (int a, int b) { register unsigned int prod, prod2; register int sign = 1; if (a < 0) { - aa = -a; - sign = -1; + aa = -a; + sign = -1; } if (b < 0) { - ab = -b; - sign = -sign; + ab = -b; + sign = -sign; } prod = (aa & 0xFFFF) * (ab & 0xFFFF); if (aa & 0xFFFF0000) { - if (ab & 0xFFFF0000) - return Null; - prod2 = (aa >> 16) * ab; + if (ab & 0xFFFF0000) + return Null; + prod2 = (aa >> 16) * ab; } else { - prod2 = aa * (ab >> 16); + prod2 = aa * (ab >> 16); } prod2 += prod >> 16; prod &= 0xFFFF; if (prod2 > (1 << (FIXBITS - 1 - 16)) - 1) { - if (sign == 1 || prod2 != (1 << (FIXBITS - 1 - 16)) || prod != 0) - return Null; - return Make_Integer (-(unsigned int)SIGNBIT); + if (sign == 1 || prod2 != (1 << (FIXBITS - 1 - 16)) || prod != 0) + return Null; + return Make_Integer (-(unsigned int)SIGNBIT); } prod += prod2 << 16; if (sign == -1) - prod = - prod; + prod = - prod; return Make_Integer (prod); } @@ -404,10 +404,10 @@ Object P_Integerp (Object x) { switch (TYPE(x)) { case T_Fixnum: case T_Bignum: - return True; + return True; case T_Flonum: - d = FLONUM(x)->val; - return d == floor(d) ? True : False; + d = FLONUM(x)->val; + return d == floor(d) ? True : False; } return False; } @@ -443,13 +443,13 @@ Object P_Exact_To_Inexact (Object n) { Check_Number (n); switch (TYPE(n)) { case T_Fixnum: - return Make_Flonum ((double)FIXNUM(n)); + return Make_Flonum ((double)FIXNUM(n)); case T_Flonum: - return n; + return n; case T_Bignum: - return Make_Flonum (Bignum_To_Double (n)); + return Make_Flonum (Bignum_To_Double (n)); default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -462,13 +462,13 @@ Object P_Inexact_To_Exact (Object n) { switch (TYPE(n)) { case T_Fixnum: case T_Bignum: - return n; + return n; case T_Flonum: - d = floor (FLONUM(n)->val + 0.5); - (void)frexp (d, &i); - return (i <= FIXBITS-1) ? Make_Integer ((int)d) : Double_To_Bignum (d); + d = floor (FLONUM(n)->val + 0.5); + (void)frexp (d, &i); + return (i <= FIXBITS-1) ? Make_Integer ((int)d) : Double_To_Bignum (d); default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -478,13 +478,13 @@ Object P_Inexact_To_Exact (Object n) { Check_Number (x);\ switch (TYPE(x)) {\ case T_Flonum:\ - ret = FLONUM(x)->val op 0; break;\ + ret = FLONUM(x)->val op 0; break;\ case T_Fixnum:\ - ret = FIXNUM(x) op 0; break;\ + ret = FIXNUM(x) op 0; break;\ case T_Bignum:\ - ret = bigop (x); break;\ + ret = bigop (x); break;\ default: /* Just to avoid compiler warnings */\ - return False;\ + return False;\ }\ return ret ? True : False;\ } @@ -499,20 +499,20 @@ Object P_Evenp (Object x) { switch (TYPE(x)) { case T_Fixnum: - ret = !(FIXNUM(x) & 1); break; + ret = !(FIXNUM(x) & 1); break; case T_Bignum: - ret = Bignum_Even (x); break; + ret = Bignum_Even (x); break; case T_Flonum: - d = FLONUM(x)->val; - if (floor (d) == d) { - d /= 2; - ret = floor (d) == d; - break; - } - /*FALLTHROUGH*/ + d = FLONUM(x)->val; + if (floor (d) == d) { + d /= 2; + ret = floor (d) == d; + break; + } + /*FALLTHROUGH*/ default: - Wrong_Type (x, T_Fixnum); - /*NOTREACHED*/ + Wrong_Type (x, T_Fixnum); + /*NOTREACHED*/ } return ret ? True : False; } @@ -529,48 +529,48 @@ Object P_Oddp (Object x) { \ switch (TYPE(x)) {\ case T_Fixnum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - return FIXNUM(x) op FIXNUM(y);\ - case T_Flonum:\ - return FIXNUM(x) op FLONUM(y)->val;\ - case T_Bignum:\ - GC_Link (y);\ - b = Integer_To_Bignum (FIXNUM(x));\ - ret = bigop (b, y);\ - GC_Unlink;\ - return ret;\ - default: /* Just to avoid compiler warnings */\ - return 0;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return FIXNUM(x) op FIXNUM(y);\ + case T_Flonum:\ + return FIXNUM(x) op FLONUM(y)->val;\ + case T_Bignum:\ + GC_Link (y);\ + b = Integer_To_Bignum (FIXNUM(x));\ + ret = bigop (b, y);\ + GC_Unlink;\ + return ret;\ + default: /* Just to avoid compiler warnings */\ + return 0;\ + }\ case T_Flonum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - return FLONUM(x)->val op FIXNUM(y);\ - case T_Flonum:\ - return FLONUM(x)->val op FLONUM(y)->val;\ - case T_Bignum:\ - return FLONUM(x)->val op Bignum_To_Double (y);\ - default: /* Just to avoid compiler warnings */\ - return 0;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return FLONUM(x)->val op FIXNUM(y);\ + case T_Flonum:\ + return FLONUM(x)->val op FLONUM(y)->val;\ + case T_Bignum:\ + return FLONUM(x)->val op Bignum_To_Double (y);\ + default: /* Just to avoid compiler warnings */\ + return 0;\ + }\ case T_Bignum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - GC_Link (x);\ - b = Integer_To_Bignum (FIXNUM(y));\ - ret = bigop (x, b);\ - GC_Unlink;\ - return ret;\ - case T_Flonum:\ - return Bignum_To_Double (x) op FLONUM(y)->val;\ - case T_Bignum:\ - return bigop (x, y);\ - default: /* Just to avoid compiler warnings */\ - return 0;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + GC_Link (x);\ + b = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (x, b);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Bignum_To_Double (x) op FLONUM(y)->val;\ + case T_Bignum:\ + return bigop (x, y);\ + default: /* Just to avoid compiler warnings */\ + return 0;\ + }\ default: /* Just to avoid compiler warnings */\ - return 0;\ + return 0;\ }\ /*NOTREACHED*/ /* ...but lint never sees it */\ } @@ -586,9 +586,9 @@ Object General_Compare (int argc, Object *argv, register int (*op)()) { Check_Number (argv[0]); for (i = 1; i < argc; i++) { - Check_Number (argv[i]); - if (!(*op) (argv[i-1], argv[i])) - return False; + Check_Number (argv[i]); + if (!(*op) (argv[i-1], argv[i])) + return False; } return True; } @@ -614,64 +614,64 @@ Object P_Generic_Eq_Greater (int argc, Object *argv) { } #define General_Generic_Operator(name,op,fixop,bigop) Object name (Object x,\ - Object y) {\ + Object y) {\ Object b1, b2, ret; register int i;\ int fits;\ GC_Node2;\ \ switch (TYPE(x)) {\ case T_Fixnum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - i = fixop (FIXNUM(x), FIXNUM(y), &fits);\ - if (fits)\ - return Make_Integer (i);\ - b1 = b2 = Null;\ - GC_Link2 (b1, b2);\ - b1 = Integer_To_Bignum (FIXNUM(x));\ - b2 = Integer_To_Bignum (FIXNUM(y));\ - ret = bigop (b1, b2);\ - GC_Unlink;\ - return ret;\ - case T_Flonum:\ - return Make_Flonum (FIXNUM(x) op FLONUM(y)->val);\ - case T_Bignum:\ - GC_Link (y);\ - b1 = Integer_To_Bignum (FIXNUM(x));\ - ret = bigop (b1, y);\ - GC_Unlink;\ - return ret;\ - default: /* Just to avoid compiler warnings */\ - return False;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + i = fixop (FIXNUM(x), FIXNUM(y), &fits);\ + if (fits)\ + return Make_Integer (i);\ + b1 = b2 = Null;\ + GC_Link2 (b1, b2);\ + b1 = Integer_To_Bignum (FIXNUM(x));\ + b2 = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (b1, b2);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Make_Flonum (FIXNUM(x) op FLONUM(y)->val);\ + case T_Bignum:\ + GC_Link (y);\ + b1 = Integer_To_Bignum (FIXNUM(x));\ + ret = bigop (b1, y);\ + GC_Unlink;\ + return ret;\ + default: /* Just to avoid compiler warnings */\ + return False;\ + }\ case T_Flonum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - return Make_Flonum (FLONUM(x)->val op FIXNUM(y));\ - case T_Flonum:\ - return Make_Flonum (FLONUM(x)->val op FLONUM(y)->val);\ - case T_Bignum:\ - return Make_Flonum (FLONUM(x)->val op Bignum_To_Double (y));\ - default: /* Just to avoid compiler warnings */\ - return False;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return Make_Flonum (FLONUM(x)->val op FIXNUM(y));\ + case T_Flonum:\ + return Make_Flonum (FLONUM(x)->val op FLONUM(y)->val);\ + case T_Bignum:\ + return Make_Flonum (FLONUM(x)->val op Bignum_To_Double (y));\ + default: /* Just to avoid compiler warnings */\ + return False;\ + }\ case T_Bignum:\ - switch (TYPE(y)) {\ - case T_Fixnum:\ - GC_Link (x);\ - b1 = Integer_To_Bignum (FIXNUM(y));\ - ret = bigop (x, b1);\ - GC_Unlink;\ - return ret;\ - case T_Flonum:\ - return Make_Flonum (Bignum_To_Double (x) op FLONUM(y)->val);\ - case T_Bignum:\ - return bigop (x, y);\ - default: /* Just to avoid compiler warnings */\ - return False;\ - }\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + GC_Link (x);\ + b1 = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (x, b1);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Make_Flonum (Bignum_To_Double (x) op FLONUM(y)->val);\ + case T_Bignum:\ + return bigop (x, y);\ + default: /* Just to avoid compiler warnings */\ + return False;\ + }\ default: /* Just to avoid compiler warnings */\ - return False;\ + return False;\ }\ /*NOTREACHED*/ /* ...but lint never sees it */\ } @@ -690,23 +690,23 @@ Object P_Dec (Object x) { } Object General_Operator (int argc, Object *argv, Object start, - register Object (*op)()) { + register Object (*op)()) { register int i; Object accum; if (argc > 0) - Check_Number (argv[0]); + Check_Number (argv[0]); accum = start; switch (argc) { case 0: - break; + break; case 1: - accum = (*op) (accum, argv[0]); break; + accum = (*op) (accum, argv[0]); break; default: - for (accum = argv[0], i = 1; i < argc; i++) { - Check_Number (argv[i]); - accum = (*op) (accum, argv[i]); - } + for (accum = argv[0], i = 1; i < argc; i++) { + Check_Number (argv[i]); + accum = (*op) (accum, argv[i]); + } } return accum; } @@ -732,45 +732,45 @@ Object Generic_Multiply (Object x, Object y) { switch (TYPE(x)) { case T_Fixnum: - switch (TYPE(y)) { - case T_Fixnum: - ret = Fixnum_Multiply (FIXNUM(x), FIXNUM(y)); - if (Nullp (ret)) { - b = Integer_To_Bignum (FIXNUM(x)); - return Bignum_Fixnum_Multiply (b, y); - } - return ret; - case T_Flonum: - return Make_Flonum (FIXNUM(x) * FLONUM(y)->val); - case T_Bignum: - return Bignum_Fixnum_Multiply (y, x); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (TYPE(y)) { + case T_Fixnum: + ret = Fixnum_Multiply (FIXNUM(x), FIXNUM(y)); + if (Nullp (ret)) { + b = Integer_To_Bignum (FIXNUM(x)); + return Bignum_Fixnum_Multiply (b, y); + } + return ret; + case T_Flonum: + return Make_Flonum (FIXNUM(x) * FLONUM(y)->val); + case T_Bignum: + return Bignum_Fixnum_Multiply (y, x); + default: /* Just to avoid compiler warnings */ + return Null; + } case T_Flonum: - switch (TYPE(y)) { - case T_Fixnum: - return Make_Flonum (FLONUM(x)->val * FIXNUM(y)); - case T_Flonum: - return Make_Flonum (FLONUM(x)->val * FLONUM(y)->val); - case T_Bignum: - return Make_Flonum (FLONUM(x)->val * Bignum_To_Double (y)); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (TYPE(y)) { + case T_Fixnum: + return Make_Flonum (FLONUM(x)->val * FIXNUM(y)); + case T_Flonum: + return Make_Flonum (FLONUM(x)->val * FLONUM(y)->val); + case T_Bignum: + return Make_Flonum (FLONUM(x)->val * Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; + } case T_Bignum: - switch (TYPE(y)) { - case T_Fixnum: - return Bignum_Fixnum_Multiply (x, y); - case T_Flonum: - return Make_Flonum (Bignum_To_Double (x) * FLONUM(y)->val); - case T_Bignum: - return Bignum_Multiply (x, y); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (TYPE(y)) { + case T_Fixnum: + return Bignum_Fixnum_Multiply (x, y); + case T_Flonum: + return Make_Flonum (Bignum_To_Double (x) * FLONUM(y)->val); + case T_Bignum: + return Bignum_Multiply (x, y); + default: /* Just to avoid compiler warnings */ + return Null; + } default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -781,63 +781,63 @@ Object Generic_Divide (Object x, Object y) { GC_Node2; if (t == T_Fixnum ? FIXNUM(y) == 0 : - (t == T_Flonum ? FLONUM(y) == 0 : Bignum_Zero (y))) - Range_Error (y); + (t == T_Flonum ? FLONUM(y) == 0 : Bignum_Zero (y))) + Range_Error (y); switch (TYPE(x)) { case T_Fixnum: - switch (t) { - case T_Fixnum: - return Make_Reduced_Flonum ((double)FIXNUM(x) / (double)FIXNUM(y)); - case T_Flonum: - return Make_Flonum ((double)FIXNUM(x) / FLONUM(y)->val); - case T_Bignum: - GC_Link (y); - b = Integer_To_Bignum (FIXNUM(x)); - ret = Bignum_Divide (b, y); - GC_Unlink; - if (EQ(Cdr (ret),Zero)) - return Car (ret); - return Make_Reduced_Flonum ((double)FIXNUM(x) - / Bignum_To_Double (y)); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (t) { + case T_Fixnum: + return Make_Reduced_Flonum ((double)FIXNUM(x) / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum ((double)FIXNUM(x) / FLONUM(y)->val); + case T_Bignum: + GC_Link (y); + b = Integer_To_Bignum (FIXNUM(x)); + ret = Bignum_Divide (b, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum ((double)FIXNUM(x) + / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; + } case T_Flonum: - switch (t) { - case T_Fixnum: - return Make_Flonum (FLONUM(x)->val / (double)FIXNUM(y)); - case T_Flonum: - return Make_Flonum (FLONUM(x)->val / FLONUM(y)->val); - case T_Bignum: - return Make_Flonum (FLONUM(x)->val / Bignum_To_Double (y)); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (t) { + case T_Fixnum: + return Make_Flonum (FLONUM(x)->val / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum (FLONUM(x)->val / FLONUM(y)->val); + case T_Bignum: + return Make_Flonum (FLONUM(x)->val / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; + } case T_Bignum: - switch (t) { - case T_Fixnum: - GC_Link (x); - ret = Bignum_Fixnum_Divide (x, y); - GC_Unlink; - if (EQ(Cdr (ret),Zero)) - return Car (ret); - return Make_Reduced_Flonum (Bignum_To_Double (x) - / (double)FIXNUM(y)); - case T_Flonum: - return Make_Flonum (Bignum_To_Double (x) / FLONUM(y)->val); - case T_Bignum: - GC_Link2 (x, y); - ret = Bignum_Divide (x, y); - GC_Unlink; - if (EQ(Cdr (ret),Zero)) - return Car (ret); - return Make_Reduced_Flonum (Bignum_To_Double (x) - / Bignum_To_Double (y)); - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (t) { + case T_Fixnum: + GC_Link (x); + ret = Bignum_Fixnum_Divide (x, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum (Bignum_To_Double (x) + / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum (Bignum_To_Double (x) / FLONUM(y)->val); + case T_Bignum: + GC_Link2 (x, y); + ret = Bignum_Divide (x, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum (Bignum_To_Double (x) + / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; + } default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -848,14 +848,14 @@ Object P_Abs (Object x) { Check_Number (x); switch (TYPE(x)) { case T_Fixnum: - i = FIXNUM(x); - return i < 0 ? Make_Integer (-i) : x; + i = FIXNUM(x); + return i < 0 ? Make_Integer (-i) : x; case T_Flonum: - return Make_Flonum (fabs (FLONUM(x)->val)); + return Make_Flonum (fabs (FLONUM(x)->val)); case T_Bignum: - return Bignum_Abs (x); + return Bignum_Abs (x); default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -866,35 +866,35 @@ Object General_Integer_Divide (Object x, Object y, int rem) { GC_Node; if (TYPE(y) == T_Fixnum ? FIXNUM(y) == 0 : Bignum_Zero (y)) - Range_Error (y); + Range_Error (y); switch (TYPE(x)) { case T_Fixnum: - switch (TYPE(y)) { - case T_Fixnum: - return Make_Integer (rem ? (fx % fy) : (fx / fy)); - case T_Bignum: - GC_Link (y); - b = Integer_To_Bignum (fx); - GC_Unlink; - ret = Bignum_Divide (b, y); + switch (TYPE(y)) { + case T_Fixnum: + return Make_Integer (rem ? (fx % fy) : (fx / fy)); + case T_Bignum: + GC_Link (y); + b = Integer_To_Bignum (fx); + GC_Unlink; + ret = Bignum_Divide (b, y); done: - return rem ? Cdr (ret) : Car (ret); - default: /* Just to avoid compiler warnings */ - return Null; - } + return rem ? Cdr (ret) : Car (ret); + default: /* Just to avoid compiler warnings */ + return Null; + } case T_Bignum: - switch (TYPE(y)) { - case T_Fixnum: - ret = Bignum_Fixnum_Divide (x, y); - goto done; - case T_Bignum: - ret = Bignum_Divide (x, y); - goto done; - default: /* Just to avoid compiler warnings */ - return Null; - } + switch (TYPE(y)) { + case T_Fixnum: + ret = Bignum_Fixnum_Divide (x, y); + goto done; + case T_Bignum: + ret = Bignum_Divide (x, y); + goto done; + default: /* Just to avoid compiler warnings */ + return Null; + } default: /* Just to avoid compiler warnings */ - return Null; + return Null; } /*NOTREACHED*/ } @@ -914,10 +914,10 @@ Object Exact_Modulo (Object x, Object y) { GC_Link2 (x, y); rem = General_Integer_Divide (x, y, 1); if (!EQ(rem,Zero)) { - xneg = P_Negativep (x); - yneg = P_Negativep (y); - if (!EQ(xneg,yneg)) - rem = Generic_Plus (rem, y); + xneg = P_Negativep (x); + yneg = P_Negativep (y); + if (!EQ(xneg,yneg)) + rem = Generic_Plus (rem, y); } GC_Unlink; return rem; @@ -932,19 +932,19 @@ Object With_Exact_Ints (Object x, Object y, Object (*fun)()) { GC_Link3 (x, y, ret); i = P_Integerp (x); if (!EQ(i,True)) - Wrong_Type (x, T_Fixnum); + Wrong_Type (x, T_Fixnum); i = P_Integerp (y); if (!EQ(i,True)) - Wrong_Type (y, T_Fixnum); + Wrong_Type (y, T_Fixnum); if (TYPE(x) == T_Flonum) { - x = P_Inexact_To_Exact (x); inex++; + x = P_Inexact_To_Exact (x); inex++; } if (TYPE(y) == T_Flonum) { - y = P_Inexact_To_Exact (y); inex++; + y = P_Inexact_To_Exact (y); inex++; } ret = fun (x, y); if (inex) - ret = P_Exact_To_Inexact (ret); + ret = P_Exact_To_Inexact (ret); GC_Unlink; return ret; } @@ -967,19 +967,19 @@ Object Exact_Gcd (Object x, Object y) { GC_Link2 (x, y); while (1) { - z = P_Zerop (x); - if (EQ(z,True)) { - r = y; - break; - } - z = P_Zerop (y); - if (EQ(z,True)) { - r = x; - break; - } - r = General_Integer_Divide (x, y, 1); - x = y; - y = r; + z = P_Zerop (x); + if (EQ(z,True)) { + r = y; + break; + } + z = P_Zerop (y); + if (EQ(z,True)) { + r = x; + break; + } + r = General_Integer_Divide (x, y, 1); + x = y; + y = r; } GC_Unlink; return r; @@ -1002,8 +1002,8 @@ Object Exact_Lcm (Object x, Object y) { ret = Exact_Gcd (x, y); z = P_Zerop (ret); if (!EQ(z,True)) { - p = Generic_Multiply (x, y); - ret = General_Integer_Divide (p, ret, 0); + p = Generic_Multiply (x, y); + ret = General_Integer_Divide (p, ret, 0); } GC_Unlink; return ret; @@ -1022,7 +1022,7 @@ Object P_Lcm (int argc, Object *argv) { \ Check_Number (x);\ if (TYPE(x) != T_Flonum)\ - return x;\ + return x;\ d = FLONUM(x)->val;\ (void)modf (op (d), &i);\ return Make_Flonum (i);\ @@ -1040,15 +1040,15 @@ Object P_Round (Object x) { Check_Number (x); if (TYPE(x) != T_Flonum) - return x; + return x; d = FLONUM(x)->val; y = d + 0.5; f = floor (y); ret = Make_Flonum (f); if (y == f) { - isodd = P_Oddp (ret); - if (Truep (isodd)) - FLONUM(ret)->val--; + isodd = P_Oddp (ret); + if (Truep (isodd)) + FLONUM(ret)->val--; } return ret; } @@ -1057,13 +1057,13 @@ double Get_Double (Object x) { Check_Number (x); switch (TYPE(x)) { case T_Fixnum: - return (double)FIXNUM(x); + return (double)FIXNUM(x); case T_Flonum: - return FLONUM(x)->val; + return FLONUM(x)->val; case T_Bignum: - return Bignum_To_Double (x); + return Bignum_To_Double (x); default: /* Just to avoid compiler warnings */ - return 0.0; + return 0.0; } /*NOTREACHED*/ } @@ -1074,11 +1074,11 @@ Object General_Function (Object x, Object y, double (*fun)()) { d = Get_Double (x); errno = 0; if (Nullp (y)) - ret = (*fun) (d); + ret = (*fun) (d); else - ret = (*fun) (d, Get_Double (y)); + ret = (*fun) (d, Get_Double (y)); if (errno == ERANGE || errno == EDOM) - Range_Error (x); + Range_Error (x); return Make_Flonum (ret); } @@ -1101,7 +1101,7 @@ Object P_Acos (Object x) { return General_Function (x, Null, acos); } Object P_Atan (int argc, Object *argv) { register int a2 = argc == 2; return General_Function (argv[0], a2 ? argv[1] : Null, a2 ? - (double(*)())atan2 : (double(*)())atan); + (double(*)())atan2 : (double(*)())atan); } Object Min (Object x, Object y) { @@ -1109,7 +1109,7 @@ Object Min (Object x, Object y) { ret = Generic_Less (x, y) ? x : y; if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) - ret = P_Exact_To_Inexact (ret); + ret = P_Exact_To_Inexact (ret); return ret; } @@ -1118,7 +1118,7 @@ Object Max (Object x, Object y) { ret = Generic_Less (x, y) ? y : x; if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) - ret = P_Exact_To_Inexact (ret); + ret = P_Exact_To_Inexact (ret); return ret; } diff --git a/src/onfork.c b/src/onfork.c index 5bccf4a..d4eddd5 100644 --- a/src/onfork.c +++ b/src/onfork.c @@ -54,5 +54,5 @@ void Call_Onfork () { FUNCT *p; for (p = Onfork_Funcs; p; p = p->next) - p->func(); + p->func(); } diff --git a/src/prim.c b/src/prim.c index 234067c..dd159ac 100644 --- a/src/prim.c +++ b/src/prim.c @@ -51,7 +51,7 @@ struct Prim_Init { { P_Eqv, "eqv?", 2, 2, EVAL }, { P_Equal, "equal?", 2, 2, EVAL }, { P_Empty_List_Is_False, "empty-list-is-false-for-backward-compatibility", - 1, 1, EVAL }, + 1, 1, EVAL }, /* char.c: */ @@ -80,10 +80,10 @@ struct Prim_Init { */ { P_Control_Pointp, "control-point?", 1, 1, EVAL }, { P_Call_With_Current_Continuation, - "call-with-current-continuation", 1, 1, EVAL }, + "call-with-current-continuation", 1, 1, EVAL }, { P_Dynamic_Wind, "dynamic-wind", 3, 3, EVAL }, { P_Control_Point_Environment, - "control-point-environment", 1, 1, EVAL }, + "control-point-environment", 1, 1, EVAL }, /* debug.c: */ @@ -104,7 +104,7 @@ struct Prim_Init { { P_Define_Macro, "define-macro", 1, MANY, NOEVAL }, { P_Set, "set!", 2, 2, NOEVAL }, { P_Environment_To_List, - "environment->list", 1, 1, EVAL }, + "environment->list", 1, 1, EVAL }, { P_Boundp, "bound?", 1, 1, EVAL }, /* error.c: @@ -139,9 +139,9 @@ struct Prim_Init { { P_Port_Line_Number, "port-line-number", 1, 1, EVAL }, { P_Eof_Objectp, "eof-object?", 1, 1, EVAL }, { P_Current_Input_Port, - "current-input-port", 0, 0, EVAL }, + "current-input-port", 0, 0, EVAL }, { P_Current_Output_Port, - "current-output-port", 0, 0, EVAL }, + "current-output-port", 0, 0, EVAL }, { P_Input_Portp, "input-port?", 1, 1, EVAL }, { P_Output_Portp, "output-port?", 1, 1, EVAL }, { P_Open_Input_File, "open-input-file", 1, 1, EVAL }, @@ -304,7 +304,7 @@ struct Prim_Init { { P_Apply, "apply", 2, MANY, VARARGS }, { P_Lambda, "lambda", 2, MANY, NOEVAL }, { P_Procedure_Environment, - "procedure-environment", 1, 1, EVAL }, + "procedure-environment", 1, 1, EVAL }, { P_Procedure_Lambda, "procedure-lambda", 1, 1, EVAL }, { P_Map, "map", 2, MANY, VARARGS }, { P_For_Each, "for-each", 2, MANY, VARARGS }, @@ -318,7 +318,7 @@ struct Prim_Init { { P_Force, "force", 1, 1, EVAL }, { P_Promisep, "promise?", 1, 1, EVAL }, { P_Promise_Environment, - "promise-environment", 1, 1, EVAL }, + "promise-environment", 1, 1, EVAL }, /* read.c: */ @@ -373,7 +373,7 @@ struct Prim_Init { { P_String_CI_Greater, "string-ci>?", 2, 2, EVAL }, { P_String_CI_Eq_Less, "string-ci<=?", 2, 2, EVAL }, { P_String_CI_Eq_Greater, - "string-ci>=?", 2, 2, EVAL }, + "string-ci>=?", 2, 2, EVAL }, { P_Substringp, "substring?", 2, 2, EVAL }, { P_CI_Substringp, "substring-ci?", 2, 2, EVAL }, @@ -417,17 +417,17 @@ void Init_Prim () { Object frame, prim, sym; for (frame = Car (The_Environment), p = Primitives; p->fun; p++) { - prim = Make_Primitive (p->fun, p->name, p->minargs, p->maxargs, - p->disc); - sym = Intern (p->name); - frame = Add_Binding (frame, sym, prim); + prim = Make_Primitive (p->fun, p->name, p->minargs, p->maxargs, + p->disc); + sym = Intern (p->name); + frame = Add_Binding (frame, sym, prim); } Car (The_Environment) = frame; Memoize_Frame (frame); } void Define_Primitive (Object (*fun)(), char const *name, int min, int max, - enum discipline disc) { + enum discipline disc) { Object prim, sym, frame; GC_Node2; @@ -437,7 +437,7 @@ void Define_Primitive (Object (*fun)(), char const *name, int min, int max, GC_Link2 (prim, sym); sym = Intern (name); if (disc == EVAL && min != max) - Primitive_Error ("~s: number of arguments must be fixed", sym); + Primitive_Error ("~s: number of arguments must be fixed", sym); frame = Add_Binding (Car (The_Environment), sym, prim); SYMBOL(sym)->value = prim; Car (The_Environment) = frame; diff --git a/src/print.c b/src/print.c index 5da5d78..3e93ac7 100644 --- a/src/print.c +++ b/src/print.c @@ -62,9 +62,9 @@ static Object V_Print_Depth, V_Print_Length; void Init_Print () { Define_Variable (&V_Print_Depth, "print-depth", - Make_Integer (DEF_PRINT_DEPTH)); + Make_Integer (DEF_PRINT_DEPTH)); Define_Variable (&V_Print_Length, "print-length", - Make_Integer (DEF_PRINT_LEN)); + Make_Integer (DEF_PRINT_LEN)); } int Print_Length () { @@ -85,13 +85,13 @@ void Print_Char (Object port, register int c) { char buf[1]; if (PORT(port)->flags & P_STRING) { - buf[0] = c; - Print_String (port, buf, 1); + buf[0] = c; + Print_String (port, buf, 1); } else { - if (putc (c, PORT(port)->file) == EOF) { - Saved_Errno = errno; /* errno valid here? */ - Primitive_Error ("write error on ~s: ~E", port); - } + if (putc (c, PORT(port)->file) == EOF) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } } } @@ -104,15 +104,15 @@ void Print_String (Object port, register char *buf, register int len) { p = PORT(port); n = STRING(p->name)->size - p->ptr; if (n < len) { - GC_Link (port); - n = len - n; - if (n < STRING_GROW_SIZE) - n = STRING_GROW_SIZE; - new = Make_String ((char *)0, STRING(p->name)->size + n); - p = PORT(port); - GC_Unlink; - memcpy (STRING(new)->data, STRING(p->name)->data, p->ptr); - p->name = new; + GC_Link (port); + n = len - n; + if (n < STRING_GROW_SIZE) + n = STRING_GROW_SIZE; + new = Make_String ((char *)0, STRING(p->name)->size + n); + p = PORT(port); + GC_Unlink; + memcpy (STRING(new)->data, STRING(p->name)->data, p->ptr); + p->name = new; } memcpy (STRING(p->name)->data + p->ptr, buf, len); p->ptr += len; @@ -140,14 +140,14 @@ void Printf (Object port, const char *fmt, ...) { va_start (args, fmt); if (PORT(port)->flags & P_STRING) { - vsprintf (buf, fmt, args); - Print_String (port, buf, strlen (buf)); + vsprintf (buf, fmt, args); + Print_String (port, buf, strlen (buf)); } else { - vfprintf (PORT(port)->file, fmt, args); - if (ferror (PORT(port)->file)) { - Saved_Errno = errno; /* errno valid here? */ - Primitive_Error ("write error on ~s: ~E", port); - } + vfprintf (PORT(port)->file, fmt, args); + if (ferror (PORT(port)->file)) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } } va_end (args); } @@ -199,7 +199,7 @@ void Discard_Output (Object port) { Check_Output_Port (port); if (PORT(port)->flags & P_STRING) - return; + return; f = PORT(port)->file; #ifdef FLUSH_FPURGE (void)fpurge (f); @@ -226,10 +226,10 @@ Object P_Flush_Output_Port (int argc, Object *argv) { void Flush_Output (Object port) { Check_Output_Port (port); if (PORT(port)->flags & P_STRING) - return; + return; if (fflush (PORT(port)->file) == EOF) { - Saved_Errno = errno; /* errno valid here? */ - Primitive_Error ("write error on ~s: ~E", port); + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); } } @@ -251,9 +251,9 @@ Object P_Get_Output_String (Object port) { void Check_Output_Port (Object port) { Check_Type (port, T_Port); if (!(PORT(port)->flags & P_OPEN)) - Primitive_Error ("port has been closed: ~s", port); + Primitive_Error ("port has been closed: ~s", port); if (!IS_OUTPUT(port)) - Primitive_Error ("not an output port: ~s", port); + Primitive_Error ("not an output port: ~s", port); } void General_Print_Object (Object x, Object port, int raw) { @@ -262,7 +262,7 @@ void General_Print_Object (Object x, Object port, int raw) { } void Print_Object (Object x, Object port, register int raw, register int depth, - register int length) { + register int length) { register int t; GC_Node2; @@ -270,107 +270,107 @@ void Print_Object (Object x, Object port, register int raw, register int depth, t = TYPE(x); switch (t) { case T_Null: - Printf (port, "()"); - break; + Printf (port, "()"); + break; case T_Fixnum: - Printf (port, "%d", FIXNUM(x)); - break; + Printf (port, "%d", FIXNUM(x)); + break; case T_Bignum: - Print_Bignum (port, x); - break; + Print_Bignum (port, x); + break; case T_Flonum: - Printf (port, "%s", Flonum_To_String (x)); - break; + Printf (port, "%s", Flonum_To_String (x)); + break; case T_Boolean: - Printf (port, "#%c", FIXNUM(x) ? 't' : 'f'); - break; + Printf (port, "#%c", FIXNUM(x) ? 't' : 'f'); + break; case T_Unbound: - Printf (port, "#[unbound]"); - break; + Printf (port, "#[unbound]"); + break; case T_Special: - Printf (port, "#[special]"); - break; + Printf (port, "#[special]"); + break; case T_Character: { - int c = CHAR(x); - if (raw) - Print_Char (port, c); - else - Pr_Char (port, c); - break; + int c = CHAR(x); + if (raw) + Print_Char (port, c); + else + Pr_Char (port, c); + break; } case T_Symbol: - Pr_Symbol (port, x, raw); - break; + Pr_Symbol (port, x, raw); + break; case T_Pair: - Pr_List (port, x, raw, depth, length); - break; + Pr_List (port, x, raw, depth, length); + break; case T_Environment: - Printf (port, "#[environment %lu]", POINTER(x)); - break; + Printf (port, "#[environment %lu]", POINTER(x)); + break; case T_String: - Pr_String (port, x, raw); - break; + Pr_String (port, x, raw); + break; case T_Vector: - Pr_Vector (port, x, raw, depth, length); - break; + Pr_Vector (port, x, raw, depth, length); + break; case T_Primitive: - Printf (port, "#[primitive %s]", PRIM(x)->name); - break; + Printf (port, "#[primitive %s]", PRIM(x)->name); + break; case T_Compound: - if (Nullp (COMPOUND(x)->name)) { - Printf (port, "#[compound %lu]", POINTER(x)); - } else { - Printf (port, "#[compound "); - Print_Object (COMPOUND(x)->name, port, raw, depth, length); - Print_Char (port, ']'); - } - break; + if (Nullp (COMPOUND(x)->name)) { + Printf (port, "#[compound %lu]", POINTER(x)); + } else { + Printf (port, "#[compound "); + Print_Object (COMPOUND(x)->name, port, raw, depth, length); + Print_Char (port, ']'); + } + break; case T_Control_Point: - Printf (port, "#[control-point %lu]", POINTER(x)); - break; + Printf (port, "#[control-point %lu]", POINTER(x)); + break; case T_Promise: - Printf (port, "#[promise %lu]", POINTER(x)); - break; + Printf (port, "#[promise %lu]", POINTER(x)); + break; case T_Port: { - int str = PORT(x)->flags & P_STRING; - char *p; - switch (PORT(x)->flags & (P_INPUT|P_BIDIR)) { - case 0: p = "output"; break; - case P_INPUT: p = "input"; break; - default: p = "input-output"; break; - } - Printf (port, "#[%s-%s-port ", str ? "string" : "file", p); - if (str) - Printf (port, "%lu", POINTER(x)); - else - Pr_String (port, PORT(x)->name, 0); - Print_Char (port, ']'); - break; + int str = PORT(x)->flags & P_STRING; + char *p; + switch (PORT(x)->flags & (P_INPUT|P_BIDIR)) { + case 0: p = "output"; break; + case P_INPUT: p = "input"; break; + default: p = "input-output"; break; + } + Printf (port, "#[%s-%s-port ", str ? "string" : "file", p); + if (str) + Printf (port, "%lu", POINTER(x)); + else + Pr_String (port, PORT(x)->name, 0); + Print_Char (port, ']'); + break; } case T_End_Of_File: - Printf (port, "#[end-of-file]"); - break; + Printf (port, "#[end-of-file]"); + break; case T_Autoload: - Printf (port, "#[autoload "); - Print_Object (AUTOLOAD(x)->files, port, raw, depth, length); - Print_Char (port, ']'); - break; + Printf (port, "#[autoload "); + Print_Object (AUTOLOAD(x)->files, port, raw, depth, length); + Print_Char (port, ']'); + break; case T_Macro: - if (Nullp (MACRO(x)->name)) { - Printf (port, "#[macro %lu]", POINTER(x)); - } else { - Printf (port, "#[macro "); - Print_Object (MACRO(x)->name, port, raw, depth, length); - Print_Char (port, ']'); - } - break; + if (Nullp (MACRO(x)->name)) { + Printf (port, "#[macro %lu]", POINTER(x)); + } else { + Printf (port, "#[macro "); + Print_Object (MACRO(x)->name, port, raw, depth, length); + Print_Char (port, ']'); + } + break; case T_Broken_Heart: - Printf (port, "!!broken-heart!!"); - break; + Printf (port, "!!broken-heart!!"); + break; default: - if (t < 0 || t >= Num_Types) - Panic ("bad type in print"); - (Types[t].print)(x, port, raw, depth, length); + if (t < 0 || t >= Num_Types) + Panic ("bad type in print"); + (Types[t].print)(x, port, raw, depth, length); } GC_Unlink; } @@ -380,106 +380,106 @@ void Pr_Char (Object port, register int c) { switch (c) { case ' ': - p = "#\\space"; - break; + p = "#\\space"; + break; case '\t': - p = "#\\tab"; - break; + p = "#\\tab"; + break; case '\n': - p = "#\\newline"; - break; + p = "#\\newline"; + break; case '\r': - p = "#\\return"; - break; + p = "#\\return"; + break; case '\f': - p = "#\\formfeed"; - break; + p = "#\\formfeed"; + break; case '\b': - p = "#\\backspace"; - break; + p = "#\\backspace"; + break; default: - if (c > ' ' && c < '\177') - Printf (port, "#\\%c", c); - else - Printf (port, "#\\%03o", (unsigned char)c); + if (c > ' ' && c < '\177') + Printf (port, "#\\%c", c); + else + Printf (port, "#\\%03o", (unsigned char)c); } if (p) Printf (port, p); } void Pr_List (Object port, Object list, register int raw, register int depth, - register int length) { + register int length) { Object tail; register int len; register char *s = 0; GC_Node2; if (depth == 0) { - Printf (port, "&"); - return; + Printf (port, "&"); + return; } GC_Link2 (port, list); if (!Nullp (list) && ((tail = Cdr (list)), TYPE(tail) == T_Pair) - && ((tail = Cdr (tail)), Nullp (tail))) { - tail = Car (list); - if (EQ(tail, Sym_Quote)) - s = "'"; - else if (EQ(tail, Sym_Quasiquote)) - s = "`"; - else if (EQ(tail, Sym_Unquote)) - s = ","; - else if (EQ(tail, Sym_Unquote_Splicing)) - s = ",@"; - if (s) { - Printf (port, s); - Print_Object (Car (Cdr (list)), port, raw, - depth < 0 ? depth : depth-1, length); - GC_Unlink; - return; - } + && ((tail = Cdr (tail)), Nullp (tail))) { + tail = Car (list); + if (EQ(tail, Sym_Quote)) + s = "'"; + else if (EQ(tail, Sym_Quasiquote)) + s = "`"; + else if (EQ(tail, Sym_Unquote)) + s = ","; + else if (EQ(tail, Sym_Unquote_Splicing)) + s = ",@"; + if (s) { + Printf (port, s); + Print_Object (Car (Cdr (list)), port, raw, + depth < 0 ? depth : depth-1, length); + GC_Unlink; + return; + } } Print_Char (port, '('); for (len = 0; !Nullp (list); len++, list = tail) { - if (length >= 0 && len >= length) { - Printf (port, "..."); - break; - } - Print_Object (Car (list), port, raw, depth < 0 ? depth : depth-1, - length); - tail = Cdr (list); - if (!Nullp (tail)) { - if (TYPE(tail) == T_Pair) - Print_Char (port, ' '); - else { - Printf (port, " . "); - Print_Object (tail, port, raw, depth < 0 ? depth : depth-1, - length); - break; - } - } + if (length >= 0 && len >= length) { + Printf (port, "..."); + break; + } + Print_Object (Car (list), port, raw, depth < 0 ? depth : depth-1, + length); + tail = Cdr (list); + if (!Nullp (tail)) { + if (TYPE(tail) == T_Pair) + Print_Char (port, ' '); + else { + Printf (port, " . "); + Print_Object (tail, port, raw, depth < 0 ? depth : depth-1, + length); + break; + } + } } Print_Char (port, ')'); GC_Unlink; } void Pr_Vector (Object port, Object vec, register int raw, register int depth, - register int length) { + register int length) { register int i, j; GC_Node2; if (depth == 0) { - Printf (port, "&"); - return; + Printf (port, "&"); + return; } GC_Link2 (port, vec); Printf (port, "#("); for (i = 0, j = VECTOR(vec)->size; i < j; i++) { - if (i) Print_Char (port, ' '); - if (length >= 0 && i >= length) { - Printf (port, "..."); - break; - } - Print_Object (VECTOR(vec)->data[i], port, raw, - depth < 0 ? depth : depth-1, length); + if (i) Print_Char (port, ' '); + if (length >= 0 && i >= length) { + Printf (port, "..."); + break; + } + Print_Object (VECTOR(vec)->data[i], port, raw, + depth < 0 ? depth : depth-1, length); } Print_Char (port, ')'); GC_Unlink; @@ -492,25 +492,25 @@ void Pr_Symbol (Object port, Object sym, int raw) { str = SYMBOL(sym)->name; if (raw) { - Pr_String (port, str, raw); - return; + Pr_String (port, str, raw); + return; } GC_Link2 (port, str); for (i = 0; i < STRING(str)->size; i++) { - c = STRING(str)->data[i]; - switch (c) { - case '\\': case ';': case '#': case '(': case ')': - case '\'': case '`': case ',': case '"': case '.': - case '\t': case '\n': case ' ': - Print_Char (port, '\\'); - Print_Char (port, c); - break; - default: - if (c < ' ' || c >= '\177') - Print_Special (port, c); - else - Print_Char (port, c); - } + c = STRING(str)->data[i]; + switch (c) { + case '\\': case ';': case '#': case '(': case ')': + case '\'': case '`': case ',': case '"': case '.': + case '\t': case '\n': case ' ': + Print_Char (port, '\\'); + Print_Char (port, c); + break; + default: + if (c < ' ' || c >= '\177') + Print_Special (port, c); + else + Print_Char (port, c); + } } GC_Unlink; } @@ -522,26 +522,26 @@ void Pr_String (Object port, Object str, int raw) { GC_Node2; if (raw) { - if (PORT(port)->flags & P_STRING) { - Print_String (port, p, len); - } else { - if (fwrite (p, 1, len, PORT(port)->file) != len) { - Saved_Errno = errno; /* errno valid here? */ - Primitive_Error ("write error on ~s: ~E", port); - } - } - return; + if (PORT(port)->flags & P_STRING) { + Print_String (port, p, len); + } else { + if (fwrite (p, 1, len, PORT(port)->file) != len) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } + } + return; } GC_Link2 (port, str); Print_Char (port, '"'); for (i = 0; i < STRING(str)->size; i++) { - c = STRING(str)->data[i]; - if (c == '\\' || c == '"') - Print_Char (port, '\\'); - if (c < ' ' || c >= '\177') - Print_Special (port, c); - else - Print_Char (port, c); + c = STRING(str)->data[i]; + if (c == '\\' || c == '"') + Print_Char (port, '\\'); + if (c < ' ' || c >= '\177') + Print_Special (port, c); + else + Print_Char (port, c); } Print_Char (port, '"'); GC_Unlink; @@ -556,7 +556,7 @@ void Print_Special (Object port, register int c) { case '\r': c = 'r'; break; case '\n': c = 'n'; break; default: - fmt = "\\%03o"; + fmt = "\\%03o"; } Printf (port, fmt, (unsigned char)c); } @@ -568,14 +568,14 @@ Object P_Format (int argc, Object *argv) { port = argv[0]; if (TYPE(port) == T_Boolean) { - if (Truep (port)) { - port = Curr_Output_Port; - } else { - stringret++; - port = P_Open_Output_String (); - } + if (Truep (port)) { + port = Curr_Output_Port; + } else { + stringret++; + port = P_Open_Output_String (); + } } else if (TYPE(port) == T_Port) { - Check_Output_Port (port); + Check_Output_Port (port); } else Wrong_Type_Combination (port, "port or #t or #f"); str = argv[1]; Check_Type (str, T_String); @@ -597,34 +597,34 @@ void Format (Object port, char const *fmt, int len, int argc, Object *argv) { Alloca (p, char*, len); memcpy (p, fmt, len); for (ep = p + len; p < ep; p++) { - if (*p == '~') { - if (++p == ep) break; - if ((c = *p) == '~') { - Print_Char (port, c); - } else if (c == '%') { - Print_Char (port, '\n'); - } else if (c == 'e' || c == 'E') { - s = strerror(Saved_Errno); - sprintf (buf, "%c%s", isupper (*s) ? tolower (*s) : - *s, *s ? "" : s+1); - Print_Object (Make_String (buf, strlen (buf)), port, - c == 'E', 0, 0); - } else { - if (--argc < 0) - Primitive_Error ("too few arguments"); - if (c == 's' || c == 'a') { - Print_Object (*argv, port, c == 'a', Print_Depth (), - Print_Length ()); - argv++; - } else if (c == 'c') { - Check_Type (*argv, T_Character); - Print_Char (port, CHAR(*argv)); - argv++; - } else Print_Char (port, c); - } - } else { - Print_Char (port, *p); - } + if (*p == '~') { + if (++p == ep) break; + if ((c = *p) == '~') { + Print_Char (port, c); + } else if (c == '%') { + Print_Char (port, '\n'); + } else if (c == 'e' || c == 'E') { + s = strerror(Saved_Errno); + sprintf (buf, "%c%s", isupper (*s) ? tolower (*s) : + *s, *s ? "" : s+1); + Print_Object (Make_String (buf, strlen (buf)), port, + c == 'E', 0, 0); + } else { + if (--argc < 0) + Primitive_Error ("too few arguments"); + if (c == 's' || c == 'a') { + Print_Object (*argv, port, c == 'a', Print_Depth (), + Print_Length ()); + argv++; + } else if (c == 'c') { + Check_Type (*argv, T_Character); + Print_Char (port, CHAR(*argv)); + argv++; + } else Print_Char (port, c); + } + } else { + Print_Char (port, *p); + } } Alloca_End; GC_Unlink; diff --git a/src/proc.c b/src/proc.c index 5f1626a..a5f19c7 100644 --- a/src/proc.c +++ b/src/proc.c @@ -39,24 +39,24 @@ #define Get_Arglist_Length(_cnt, _lst, _x) \ for (_cnt = 0, _x = _lst; TYPE(_x) == T_Pair; _x = Cdr (_x), _cnt++) \ - ; \ + ; \ if (!Nullp(_x)) \ - Primitive_Error("improper argument list"); \ + Primitive_Error("improper argument list"); \ #define Funcall_Switch(t,func,args,eval) \ if (t == T_Primitive) {\ - return Funcall_Primitive (func, args, eval);\ + return Funcall_Primitive (func, args, eval);\ } else if (t == T_Compound) {\ - return Funcall_Compound (func, args, eval);\ + return Funcall_Compound (func, args, eval);\ } else if (t == T_Control_Point) {\ - Funcall_Control_Point (func, args, eval);\ + Funcall_Control_Point (func, args, eval);\ } else Primitive_Error ("application of non-procedure: ~s", func);\ extern void Switch_Environment (Object); extern unsigned int Stack_Size (); extern void Uncatchable_Error (char *); extern void Funcall_Control_Point (Object, Object, int) - __attribute__ ((__noreturn__)); + __attribute__ ((__noreturn__)); extern void Pop_Frame (); extern void Push_Frame (Object); @@ -83,15 +83,15 @@ void Check_Procedure (Object x) { register int t = TYPE(x); if (t != T_Primitive && t != T_Compound) - Wrong_Type_Combination (x, "procedure"); + Wrong_Type_Combination (x, "procedure"); if (t == T_Primitive && PRIM(x)->disc == NOEVAL) - Primitive_Error ("invalid procedure: ~s", x); + Primitive_Error ("invalid procedure: ~s", x); } Object P_Procedurep (Object x) { register int t = TYPE(x); return t == T_Primitive || t == T_Compound || t == T_Control_Point - ? True : False; + ? True : False; } Object P_Primitivep (Object x) { @@ -115,7 +115,7 @@ Object Make_Compound () { } Object Make_Primitive (Object (*fun)(), char const *name, int min, int max, - enum discipline disc) { + enum discipline disc) { Object prim; register struct S_Primitive *pr; @@ -141,44 +141,44 @@ Object Eval (Object form) { again: t = TYPE(form); if (t == T_Symbol) { - sym = SYMBOL(form); - if (TYPE(sym->value) == T_Unbound) { - binding = Lookup_Symbol (form, 1); - sym->value = Cdr (binding); - } - ret = sym->value; - if (TYPE(ret) == T_Autoload) - ret = Do_Autoload (form, ret); - return ret; + sym = SYMBOL(form); + if (TYPE(sym->value) == T_Unbound) { + binding = Lookup_Symbol (form, 1); + sym->value = Cdr (binding); + } + ret = sym->value; + if (TYPE(ret) == T_Autoload) + ret = Do_Autoload (form, ret); + return ret; } if (t != T_Pair) { - if (t == T_Null) - Primitive_Error ("no subexpression in procedure call"); - if (t == T_Vector) - Primitive_Error ("unevaluable object: ~s", form); - return form; + if (t == T_Null) + Primitive_Error ("no subexpression in procedure call"); + if (t == T_Vector) + Primitive_Error ("unevaluable object: ~s", form); + return form; } if ((tick++ & 7) == 0) - if (Stack_Size () > Max_Stack) - Uncatchable_Error ("Out of stack space"); + if (Stack_Size () > Max_Stack) + Uncatchable_Error ("Out of stack space"); /* * Avoid recursive Eval() for the most common case: */ fun = Car (form); if (TYPE(fun) != T_Symbol || - (fun = SYMBOL(fun)->value, TYPE(fun) == T_Unbound) || - TYPE(fun) == T_Autoload) { - GC_Link (form); - TC_Disable; - fun = Eval (Car (form)); - TC_Enable; - GC_Unlink; + (fun = SYMBOL(fun)->value, TYPE(fun) == T_Unbound) || + TYPE(fun) == T_Autoload) { + GC_Link (form); + TC_Disable; + fun = Eval (Car (form)); + TC_Enable; + GC_Unlink; } form = Cdr (form); t = TYPE(fun); if (t == T_Macro) { - form = Macro_Expand (fun, form); - goto again; + form = Macro_Expand (fun, form); + goto again; } Funcall_Switch (t, fun, form, 1); /*NOTREACHED*/ @@ -189,7 +189,7 @@ Object P_Eval (int argc, Object *argv) { GC_Node; if (argc == 1) - return Eval (argv[0]); + return Eval (argv[0]); Check_Type (argv[1], T_Environment); oldenv = The_Environment; GC_Link (oldenv); @@ -212,18 +212,18 @@ Object P_Apply (int argc, Object *argv) { list = tail = last = Null; GC_Link3 (list, tail, last); for (i = 1; i < argc-1; i++, tail = cell) { - cell = Cons (argv[i], Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); + cell = Cons (argv[i], Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); } for (last = argv[argc-1]; !Nullp (last); last = Cdr (last), tail = cell) { - cell = Cons (P_Car (last), Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); + cell = Cons (P_Car (last), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); } ret = Funcall (argv[0], list, 0); GC_Unlink; @@ -245,74 +245,74 @@ Object Funcall_Primitive (Object fun, Object argl, int eval) { Error_Tag = prim->name; Get_Arglist_Length (argc, argl, r); /* r is temporary variable */ if (argc < prim->minargs - || (prim->maxargs != MANY && argc > prim->maxargs)) - Primitive_Error ("wrong number of arguments"); + || (prim->maxargs != MANY && argc > prim->maxargs)) + Primitive_Error ("wrong number of arguments"); e = The_Environment; GC_Link4_Tag_Primitive (argl, fun, e, r); if (prim->disc == NOEVAL) { - r = (prim->fun)(argl); + r = (prim->fun)(argl); } else { - TC_Disable; - /* - * Skip the loop if argc==0 or argc==1 (special case below). - */ - if (prim->disc != EVAL || argc >= 2) { - if (argc <= MAX_ARGS_ON_STACK) - argv = abuf; - else - Alloca (argv, Object*, argc * sizeof (Object)); - gcv.gclen = 1; gcv.gcobj = argv; gcv.next = &gc4; GC_List = &gcv; - for (r = argl, i = 0; i < argc; i++, r = Cdr (r)) { - argv[i] = eval ? Eval (Car (r)) : Car (r); - gcv.gclen++; - } - TC_Enable; - prim = PRIM(fun); /* fun has possibly been moved during gc */ - } - if (prim->disc == VARARGS) { - r = (prim->fun)(argc, argv); - } else { - switch (argc) { - case 0: - r = (prim->fun)(); break; - case 1: - TC_Disable; - r = eval ? Eval (Car (argl)) : Car (argl); - TC_Enable; - r = (PRIM(fun)->fun)(r); - break; - case 2: - r = (prim->fun)(argv[0], argv[1]); break; - case 3: - r = (prim->fun)(argv[0], argv[1], argv[2]); break; - case 4: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3]); break; - case 5: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4]); - break; - case 6: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5]); break; - case 7: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6]); break; - case 8: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6], argv[7]); break; - case 9: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6], argv[7], argv[8]); break; - case 10: - r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6], argv[7], argv[8], argv[9]); - break; - default: - Panic ("too many args for primitive"); - } - } - Alloca_End; + TC_Disable; + /* + * Skip the loop if argc==0 or argc==1 (special case below). + */ + if (prim->disc != EVAL || argc >= 2) { + if (argc <= MAX_ARGS_ON_STACK) + argv = abuf; + else + Alloca (argv, Object*, argc * sizeof (Object)); + gcv.gclen = 1; gcv.gcobj = argv; gcv.next = &gc4; GC_List = &gcv; + for (r = argl, i = 0; i < argc; i++, r = Cdr (r)) { + argv[i] = eval ? Eval (Car (r)) : Car (r); + gcv.gclen++; + } + TC_Enable; + prim = PRIM(fun); /* fun has possibly been moved during gc */ + } + if (prim->disc == VARARGS) { + r = (prim->fun)(argc, argv); + } else { + switch (argc) { + case 0: + r = (prim->fun)(); break; + case 1: + TC_Disable; + r = eval ? Eval (Car (argl)) : Car (argl); + TC_Enable; + r = (PRIM(fun)->fun)(r); + break; + case 2: + r = (prim->fun)(argv[0], argv[1]); break; + case 3: + r = (prim->fun)(argv[0], argv[1], argv[2]); break; + case 4: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3]); break; + case 5: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4]); + break; + case 6: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5]); break; + case 7: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6]); break; + case 8: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7]); break; + case 9: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7], argv[8]); break; + case 10: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7], argv[8], argv[9]); + break; + default: + Panic ("too many args for primitive"); + } + } + Alloca_End; } GC_Unlink; Error_Tag = last_tag; @@ -328,28 +328,28 @@ Object Funcall_Primitive (Object fun, Object argl, int eval) { #define Lambda_Bind(var,val) {\ r = Cons (var, val);\ if (tail_calling)\ - newframe = Cons (r, newframe);\ + newframe = Cons (r, newframe);\ else\ - frame = Cons (r, frame);\ + frame = Cons (r, frame);\ } Object Funcall_Compound (Object fun, Object argl, int eval) { register int argc, min, max, i, tail_calling = 0; register Object *argv = NULL; Object abuf[MAX_ARGS_ON_STACK], rest, r, frame, tail, - tail_call_env, oldenv, newframe; + tail_call_env, oldenv, newframe; register GCNODE *p; GC_Node7; GCNODE gcv; Alloca_Begin; if (Tail_Call && eval) { - for (p = GC_List; p && p->gclen != TAG_FUN; p = p->next) { - if (p->gclen == TAG_TCFUN && EQ(*(p->gcobj), fun)) { - SET(r, T_Special, 0); - tc_fun = fun; tc_argl = argl; tc_env = The_Environment; - return r; - } - } + for (p = GC_List; p && p->gclen != TAG_FUN; p = p->next) { + if (p->gclen == TAG_TCFUN && EQ(*(p->gcobj), fun)) { + SET(r, T_Special, 0); + tc_fun = fun; tc_argl = argl; tc_env = The_Environment; + return r; + } + } } r = frame = tail = newframe = Null; oldenv = The_Environment; @@ -359,43 +359,43 @@ again: min = COMPOUND(fun)->min_args; max = COMPOUND(fun)->max_args; if (argc < min) - Primitive_Error ("too few arguments for ~s", fun); + Primitive_Error ("too few arguments for ~s", fun); if (max >= 0 && argc > max) - Primitive_Error ("too many arguments for ~s", fun); + Primitive_Error ("too many arguments for ~s", fun); if (tail_calling) { - tail = The_Environment; - Switch_Environment (tail_call_env); + tail = The_Environment; + Switch_Environment (tail_call_env); } else { - if (argc <= MAX_ARGS_ON_STACK) - argv = abuf; - else - Alloca (argv, Object*, argc * sizeof (Object)); + if (argc <= MAX_ARGS_ON_STACK) + argv = abuf; + else + Alloca (argv, Object*, argc * sizeof (Object)); } Tail_Call = 0; gcv.gclen = 1; gcv.gcobj = argv; gcv.next = &gc7; GC_List = &gcv; for (r = argl, i = 0; i < argc; i++, r = Cdr (r)) { - argv[i] = eval ? Eval (Car (r)) : Car (r); - gcv.gclen++; + argv[i] = eval ? Eval (Car (r)) : Car (r); + gcv.gclen++; } if (tail_calling) - Switch_Environment (tail); + Switch_Environment (tail); tail = Car (Cdr (COMPOUND(fun)->closure)); for (i = 0; i < min; i++, tail = Cdr (tail)) - Lambda_Bind (Car (tail), argv[i]); + Lambda_Bind (Car (tail), argv[i]); if (max == -1) { - rest = P_List (argc-i, argv+i); - Lambda_Bind (tail, rest); + rest = P_List (argc-i, argv+i); + Lambda_Bind (tail, rest); } if (tail_calling) { - Pop_Frame (); - Push_Frame (newframe); + Pop_Frame (); + Push_Frame (newframe); } else { - Switch_Environment (COMPOUND(fun)->env); + Switch_Environment (COMPOUND(fun)->env); Push_Frame (frame); } tail = Cdr (Cdr (COMPOUND(fun)->closure)); for (i = COMPOUND(fun)->numforms; i > 1; i--, tail = Cdr (tail)) - (void)Eval (Car (tail)); + (void)Eval (Car (tail)); Tail_Call = 1; r = Eval (Car (tail)); /* @@ -405,12 +405,12 @@ again: * and environment and jump to the beginning. */ if (TYPE(r) == T_Special && EQ(fun, tc_fun)) { - argl = tc_argl; - tail_call_env = tc_env; - tail_calling = 1; - eval = 1; - newframe = Null; - goto again; + argl = tc_argl; + tail_call_env = tc_env; + tail_calling = 1; + eval = 1; + newframe = Null; + goto again; } Tail_Call = 0; Pop_Frame (); @@ -432,18 +432,18 @@ void Check_Formals (Object x, int *min, int *max) { *min = *max = 0; for (t1 = Car (x); !Nullp (t1); t1 = Cdr (t1)) { s = TYPE(t1) == T_Pair ? Car (t1) : t1; - Check_Type (s, T_Symbol); - for (t2 = Car (x); !EQ(t2, t1); t2 = Cdr (t2)) - if (EQ(s, Car (t2))) - Primitive_Error ("~s: duplicate variable binding", s); - if (TYPE(t1) != T_Pair) - break; - (*min)++; (*max)++; + Check_Type (s, T_Symbol); + for (t2 = Car (x); !EQ(t2, t1); t2 = Cdr (t2)) + if (EQ(s, Car (t2))) + Primitive_Error ("~s: duplicate variable binding", s); + if (TYPE(t1) != T_Pair) + break; + (*min)++; (*max)++; } if (TYPE(t1) == T_Symbol) - *max = -1; + *max = -1; else if (!Nullp (t1)) - Wrong_Type_Combination (t1, "list or symbol"); + Wrong_Type_Combination (t1, "list or symbol"); } Object P_Lambda (Object argl) { @@ -458,7 +458,7 @@ Object P_Lambda (Object argl) { COMPOUND(proc)->env = The_Environment; COMPOUND(proc)->numforms = Fast_Length (Cdr (argl)); Check_Formals (argl, &COMPOUND(proc)->min_args, - &COMPOUND(proc)->max_args); + &COMPOUND(proc)->max_args); GC_Unlink; return proc; } @@ -487,29 +487,29 @@ Object General_Map (int argc, Object *argv, register int accum) { GC_Link2 (list, tail); gcv.gclen = argc; gcv.gcobj = args; gcv.next = &gc2; GC_List = &gcv; while (1) { - for (i = 1; i < argc; i++) { - head = argv[i]; - if (Nullp (head)) { - GC_Unlink; - Alloca_End; - return list; - } - Check_Type (head, T_Pair); - args[i-1] = Car (head); - argv[i] = Cdr (head); - } - arglist = P_List (argc-1, args); - TC_Disable; - val = Funcall (argv[0], arglist, 0); - TC_Enable; - if (!accum) - continue; - cell = Cons (val, Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); - tail = cell; + for (i = 1; i < argc; i++) { + head = argv[i]; + if (Nullp (head)) { + GC_Unlink; + Alloca_End; + return list; + } + Check_Type (head, T_Pair); + args[i-1] = Car (head); + argv[i] = Cdr (head); + } + arglist = P_List (argc-1, args); + TC_Disable; + val = Funcall (argv[0], arglist, 0); + TC_Enable; + if (!accum) + continue; + cell = Cons (val, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + tail = cell; } /*NOTREACHED*/ } @@ -561,14 +561,14 @@ Object Macro_Expand (Object mac, Object argl) { min = MACRO(mac)->min_args; max = MACRO(mac)->max_args; if (argc < min) - Primitive_Error ("too few arguments for ~s", mac); + Primitive_Error ("too few arguments for ~s", mac); if (max >= 0 && argc > max) - Primitive_Error ("too many arguments for ~s", mac); + Primitive_Error ("too many arguments for ~s", mac); tail = Car (Cdr (MACRO(mac)->body)); for (i = 0; i < min; i++, tail = Cdr (tail), argl = Cdr (argl)) - frame = Add_Binding (frame, Car (tail), Car (argl)); + frame = Add_Binding (frame, Car (tail), Car (argl)); if (max == -1) - frame = Add_Binding (frame, tail, argl); + frame = Add_Binding (frame, tail, argl); Push_Frame (frame); TC_Disable; r = Begin (Cdr (Cdr (MACRO(mac)->body))); @@ -586,9 +586,9 @@ Object P_Macro_Expand (Object form) { GC_Link (form); mac = Eval (Car (form)); if (TYPE(mac) != T_Macro) - ret = form; + ret = form; else - ret = Macro_Expand (mac, Cdr (form)); + ret = Macro_Expand (mac, Cdr (form)); GC_Unlink; return ret; } diff --git a/src/promise.c b/src/promise.c index 92870a2..72e9a8b 100644 --- a/src/promise.c +++ b/src/promise.c @@ -54,7 +54,7 @@ Object P_Force (Object d) { Check_Type (d, T_Promise); if (PROMISE(d)->done) - return PROMISE(d)->thunk; + return PROMISE(d)->thunk; GC_Link (d); a[0] = PROMISE(d)->thunk; a[1] = PROMISE(d)->env; TC_Disable; @@ -62,7 +62,7 @@ Object P_Force (Object d) { TC_Enable; GC_Unlink; if (PROMISE(d)->done) /* take care of recursive force calls */ - return PROMISE(d)->thunk; + return PROMISE(d)->thunk; PROMISE(d)->thunk = ret; PROMISE(d)->done = 1; return ret; diff --git a/src/read.c b/src/read.c index f1603ad..554183e 100644 --- a/src/read.c +++ b/src/read.c @@ -108,8 +108,8 @@ int String_Getc (Object port) { p = PORT(port); if (p->flags & P_UNREAD) { - p->flags &= ~P_UNREAD; - return p->unread; + p->flags &= ~P_UNREAD; + return p->unread; } s = STRING(p->name); return p->ptr >= s->size ? EOF : s->data[p->ptr++]; @@ -123,9 +123,9 @@ void String_Ungetc (Object port, register int c) { void Check_Input_Port (Object port) { Check_Type (port, T_Port); if (!(PORT(port)->flags & P_OPEN)) - Primitive_Error ("port has been closed: ~s", port); + Primitive_Error ("port has been closed: ~s", port); if (!IS_INPUT(port)) - Primitive_Error ("not an input port: ~s", port); + Primitive_Error ("not an input port: ~s", port); } Object P_Clear_Input_Port (int argc, Object *argv) { @@ -138,7 +138,7 @@ void Discard_Input (Object port) { Check_Input_Port (port); if (PORT(port)->flags & P_STRING) - return; + return; f = PORT(port)->file; #ifdef FLUSH_FPURGE (void)fpurge (f); @@ -167,12 +167,12 @@ Object P_Unread_Char (int argc, Object *argv) { Check_Input_Port (port); p = PORT(port); if (p->flags & P_STRING) { - if (p->flags & P_UNREAD) - Primitive_Error ("cannot push back more than one char"); - String_Ungetc (port, CHAR(ch)); + if (p->flags & P_UNREAD) + Primitive_Error ("cannot push back more than one char"); + String_Ungetc (port, CHAR(ch)); } else { - if (ungetc (CHAR(ch), p->file) == EOF) - Primitive_Error ("failed to push back char"); + if (ungetc (CHAR(ch), p->file) == EOF) + Primitive_Error ("failed to push back char"); } if (CHAR(ch) == '\n' && PORT(port)->lno > 1) PORT(port)->lno--; return ch; @@ -198,7 +198,7 @@ Object P_Peek_Char (int argc, Object *argv) { a[0] = P_Read_Char (argc, argv); if (argc == 1) - a[1] = argv[0]; + a[1] = argv[0]; return EQ(a[0], Eof) ? Eof : P_Unread_Char (argc+1, a); } @@ -212,13 +212,13 @@ Object P_Char_Readyp (int argc, Object *argv) { port = argc == 1 ? argv[0] : Curr_Input_Port; Check_Input_Port (port); if (PORT(port)->flags & P_STRING || feof (PORT(port)->file)) - return True; + return True; #ifdef FIONREAD { - long num = 0; - (void)ioctl (fileno (PORT(port)->file), FIONREAD, (char *)&num); - if (num != 0) - return True; + long num = 0; + (void)ioctl (fileno (PORT(port)->file), FIONREAD, (char *)&num); + if (num != 0) + return True; } #endif return False; @@ -235,10 +235,10 @@ Object P_Read_String (int argc, Object *argv) { str = PORT(port)->flags & P_STRING; Read_Reset (); while (1) { - Reader_Getc; - if (c == '\n' || c == EOF) - break; - Read_Store (c); + Reader_Getc; + if (c == '\n' || c == EOF) + break; + Read_Store (c); } Reader_Tweak_Stream; return c == EOF ? Eof : Make_String (Read_Buf, Read_Size); @@ -258,32 +258,32 @@ Object General_Read (Object port, int konst) { f = PORT(port)->file; str = PORT(port)->flags & P_STRING; while (1) { - Reader_Getc; - if (c == EOF) { - ret = Eof; - break; - } - if (Whitespace (c)) - continue; - if (c == ';') { + Reader_Getc; + if (c == EOF) { + ret = Eof; + break; + } + if (Whitespace (c)) + continue; + if (c == ';') { comment: - if (Skip_Comment (port) == EOF) { - ret = Eof; - break; - } - continue; - } - if (c == '(') { - ret = Read_Sequence (port, 0, konst); - } else if (c == '#') { - ret = Read_Sharp (port, konst); - if (TYPE(ret) == T_Special) /* it was a #! */ - goto comment; - } else { - Reader_Ungetc; - ret = Read_Atom (port, konst); - } - break; + if (Skip_Comment (port) == EOF) { + ret = Eof; + break; + } + continue; + } + if (c == '(') { + ret = Read_Sequence (port, 0, konst); + } else if (c == '#') { + ret = Read_Sharp (port, konst); + if (TYPE(ret) == T_Special) /* it was a #! */ + goto comment; + } else { + Reader_Ungetc; + ret = Read_Atom (port, konst); + } + break; } Reader_Tweak_Stream; return ret; @@ -296,7 +296,7 @@ int Skip_Comment (Object port) { f = PORT(port)->file; str = PORT(port)->flags & P_STRING; do { - Reader_Getc; + Reader_Getc; } while (c != '\n' && c != EOF); return c; } @@ -306,7 +306,7 @@ Object Read_Atom (Object port, int konst) { ret = Read_Special (port, konst); if (TYPE(ret) == T_Special) - Reader_Error (port, "syntax error"); + Reader_Error (port, "syntax error"); return ret; } @@ -318,7 +318,7 @@ Object Read_Special (Object port, int konst) { #define READ_QUOTE(sym) \ ( ret = Read_Atom (port, konst),\ konst ? (ret = Const_Cons (ret, Null), Const_Cons (sym, ret))\ - : (ret = Cons (ret, Null), Cons (sym, ret))) + : (ret = Cons (ret, Null), Cons (sym, ret))) f = PORT(port)->file; str = PORT(port)->flags & P_STRING; @@ -327,69 +327,69 @@ again: switch (c) { case EOF: eof: - Reader_Tweak_Stream; - Reader_Error (port, "premature end of file"); + Reader_Tweak_Stream; + Reader_Error (port, "premature end of file"); case ';': - if (Skip_Comment (port) == EOF) - goto eof; - goto again; + if (Skip_Comment (port) == EOF) + goto eof; + goto again; case ')': - SET(ret, T_Special, c); - return ret; + SET(ret, T_Special, c); + return ret; case '(': - return Read_Sequence (port, 0, konst); + return Read_Sequence (port, 0, konst); case '\'': - return READ_QUOTE(Sym_Quote); + return READ_QUOTE(Sym_Quote); case '`': - return READ_QUOTE(Sym_Quasiquote); + return READ_QUOTE(Sym_Quasiquote); case ',': - Reader_Getc; - if (c == EOF) - goto eof; - if (c == '@') { - return READ_QUOTE(Sym_Unquote_Splicing); - } else { - Reader_Ungetc; - return READ_QUOTE(Sym_Unquote); - } + Reader_Getc; + if (c == EOF) + goto eof; + if (c == '@') { + return READ_QUOTE(Sym_Unquote_Splicing); + } else { + Reader_Ungetc; + return READ_QUOTE(Sym_Unquote); + } case '"': - return Read_String (port, konst); + return Read_String (port, konst); case '#': - ret = Read_Sharp (port, konst); - if (TYPE(ret) == T_Special) - goto again; - return ret; + ret = Read_Sharp (port, konst); + if (TYPE(ret) == T_Special) + goto again; + return ret; default: - if (Whitespace (c)) - goto again; - Read_Reset (); - if (c == '.') { - Reader_Getc; - if (c == EOF) - goto eof; - if (Whitespace (c)) { - Reader_Ungetc; - SET(ret, T_Special, '.'); - return ret; - } - Read_Store ('.'); - } - while (!Whitespace (c) && !Delimiter (c) && c != EOF) { - if (c == '\\') { - Reader_Getc; - if (c == EOF) - break; - } - Read_Store (c); - Reader_Getc; - } - Read_Store ('\0'); - if (c != EOF) - Reader_Ungetc; - ret = Parse_Number (port, Read_Buf, 10); - if (Nullp (ret)) - ret = Intern (Read_Buf); - return ret; + if (Whitespace (c)) + goto again; + Read_Reset (); + if (c == '.') { + Reader_Getc; + if (c == EOF) + goto eof; + if (Whitespace (c)) { + Reader_Ungetc; + SET(ret, T_Special, '.'); + return ret; + } + Read_Store ('.'); + } + while (!Whitespace (c) && !Delimiter (c) && c != EOF) { + if (c == '\\') { + Reader_Getc; + if (c == EOF) + break; + } + Read_Store (c); + Reader_Getc; + } + Read_Store ('\0'); + if (c != EOF) + Reader_Ungetc; + ret = Parse_Number (port, Read_Buf, 10); + if (Nullp (ret)) + ret = Intern (Read_Buf); + return ret; } /*NOTREACHED*/ } @@ -401,42 +401,42 @@ Object Read_Sequence (Object port, int vec, int konst) { ret = tail = Null; GC_Link3 (ret, tail, port); while (1) { - e = Read_Special (port, konst); - if (TYPE(e) == T_Special) { - if (CHAR(e) == ')') { - GC_Unlink; - return ret; - } - if (vec) - Reader_Error (port, "wrong syntax in vector"); - if (CHAR(e) == '.') { - if (Nullp (tail)) { - ret = Read_Atom (port, konst); - } else { - e = Read_Atom (port, konst); - /* - * Possibly modifying pure cons. Must be fixed! - */ - Cdr (tail) = e; - } - e = Read_Special (port, konst); - if (TYPE(e) == T_Special && CHAR(e) == ')') { - GC_Unlink; - return ret; - } - Reader_Error (port, "dot in wrong context"); - } - Reader_Error (port, "syntax error"); - } - if (konst) t = Const_Cons (e, Null); else t = Cons (e, Null); - if (!Nullp (tail)) - /* - * Possibly modifying pure cons. Must be fixed! - */ - Cdr (tail) = t; - else - ret = t; - tail = t; + e = Read_Special (port, konst); + if (TYPE(e) == T_Special) { + if (CHAR(e) == ')') { + GC_Unlink; + return ret; + } + if (vec) + Reader_Error (port, "wrong syntax in vector"); + if (CHAR(e) == '.') { + if (Nullp (tail)) { + ret = Read_Atom (port, konst); + } else { + e = Read_Atom (port, konst); + /* + * Possibly modifying pure cons. Must be fixed! + */ + Cdr (tail) = e; + } + e = Read_Special (port, konst); + if (TYPE(e) == T_Special && CHAR(e) == ')') { + GC_Unlink; + return ret; + } + Reader_Error (port, "dot in wrong context"); + } + Reader_Error (port, "syntax error"); + } + if (konst) t = Const_Cons (e, Null); else t = Cons (e, Null); + if (!Nullp (tail)) + /* + * Possibly modifying pure cons. Must be fixed! + */ + Cdr (tail) = t; + else + ret = t; + tail = t; } /*NOTREACHED*/ } @@ -449,34 +449,34 @@ Object Read_String (Object port, int konst) { f = PORT(port)->file; str = PORT(port)->flags & P_STRING; while (1) { - Reader_Getc; - if (c == EOF) { + Reader_Getc; + if (c == EOF) { eof: - Reader_Tweak_Stream; - Reader_Error (port, "end of file in string"); - } - if (c == '\\') { - Reader_Getc; - switch (c) { - case EOF: goto eof; - case 'b': c = '\b'; break; - case 't': c = '\t'; break; - case 'r': c = '\r'; break; - case 'n': c = '\n'; break; - case '0': case '1': case '2': case '3': - case '4': case '5': case '6': case '7': - oc = n = 0; - do { - oc <<= 3; oc += c - '0'; - Reader_Getc; - if (c == EOF) goto eof; - } while (Octal (c) && ++n <= 2); - Reader_Ungetc; - c = oc; - } - } else if (c == '"') - break; - Read_Store (c); + Reader_Tweak_Stream; + Reader_Error (port, "end of file in string"); + } + if (c == '\\') { + Reader_Getc; + switch (c) { + case EOF: goto eof; + case 'b': c = '\b'; break; + case 't': c = '\t'; break; + case 'r': c = '\r'; break; + case 'n': c = '\n'; break; + case '0': case '1': case '2': case '3': + case '4': case '5': case '6': case '7': + oc = n = 0; + do { + oc <<= 3; oc += c - '0'; + Reader_Getc; + if (c == EOF) goto eof; + } while (Octal (c) && ++n <= 2); + Reader_Ungetc; + c = oc; + } + } else if (c == '"') + break; + Read_Store (c); } return General_Make_String (Read_Buf, Read_Size, konst); } @@ -490,10 +490,10 @@ Object Read_Sharp (Object port, int konst) { str = PORT(port)->flags & P_STRING; Reader_Getc; if (c == EOF) - Reader_Sharp_Eof; + Reader_Sharp_Eof; if (!Readers[c]) { - sprintf (buf, "no reader for syntax #%c", c); - Reader_Error (port, buf); + sprintf (buf, "no reader for syntax #%c", c); + Reader_Error (port, buf); } return Readers[c](port, c, konst); } @@ -537,18 +537,18 @@ Object Read_Radix (Object port, int chr, int konst) { str = PORT(port)->flags & P_STRING; Read_Store ('#'); Read_Store (chr); while (1) { - Reader_Getc; - if (c == EOF) - Reader_Sharp_Eof; - if (Whitespace (c) || Delimiter (c)) - break; - Read_Store (c); + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + Read_Store (c); } Reader_Ungetc; Read_Store ('\0'); ret = Parse_Number (port, Read_Buf, 10); if (Nullp (ret)) - Reader_Error (port, "radix not followed by a valid number"); + Reader_Error (port, "radix not followed by a valid number"); return ret; } @@ -562,50 +562,50 @@ Object Read_Char (Object port, int chr, int konst) { str = PORT(port)->flags & P_STRING; Reader_Getc; if (c == EOF) - Reader_Sharp_Eof; + Reader_Sharp_Eof; *p++ = c; while (1) { - Reader_Getc; - if (c == EOF) - Reader_Sharp_Eof; - if (Whitespace (c) || Delimiter (c)) - break; - if (p == buf+9) - Reader_Error (port, "syntax error in character constant"); - *p++ = c; + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + if (p == buf+9) + Reader_Error (port, "syntax error in character constant"); + *p++ = c; } Reader_Ungetc; if (p == buf+1) - return Make_Char (*buf); + return Make_Char (*buf); *p = '\0'; if (p == buf+3) { - for (c = 0, p = buf; p < buf+3 && Octal (*p); p++) - c = c << 3 | (*p - '0'); - if (p == buf+3) - return Make_Char (c); + for (c = 0, p = buf; p < buf+3 && Octal (*p); p++) + c = c << 3 | (*p - '0'); + if (p == buf+3) + return Make_Char (c); } for (p = buf; *p; p++) - if (isupper (*p)) - *p = tolower (*p); + if (isupper (*p)) + *p = tolower (*p); if (strcmp (buf, "space") == 0) - return Make_Char (' '); + return Make_Char (' '); if (strcmp (buf, "newline") == 0) - return Make_Char ('\n'); + return Make_Char ('\n'); if (strcmp (buf, "return") == 0) - return Make_Char ('\r'); + return Make_Char ('\r'); if (strcmp (buf, "tab") == 0) - return Make_Char ('\t'); + return Make_Char ('\t'); if (strcmp (buf, "formfeed") == 0) - return Make_Char ('\f'); + return Make_Char ('\f'); if (strcmp (buf, "backspace") == 0) - return Make_Char ('\b'); + return Make_Char ('\b'); Reader_Error (port, "syntax error in character constant"); /*NOTREACHED*/ } void Define_Reader (int c, READFUN fun) { if (Readers[c] && Readers[c] != fun) - Primitive_Error ("reader for `~a' already defined", Make_Char (c)); + Primitive_Error ("reader for `~a' already defined", Make_Char (c)); Readers[c] = fun; } @@ -619,89 +619,89 @@ Object Parse_Number (Object port, char const *buf, int radix) { Object ret; for ( ; *buf == '#'; buf++) { - switch (*++buf) { - case 'b': case 'B': - if (gotradix++) return Null; - radix = 2; - break; - case 'o': case 'O': - if (gotradix++) return Null; - radix = 8; - break; - case 'd': case 'D': - if (gotradix++) return Null; - radix = 10; - break; - case 'x': case 'X': - if (gotradix++) return Null; - radix = 16; - break; - case 'e': case 'E': - if (exact++ || inexact) return Null; - break; - case 'i': case 'I': - if (inexact++ || exact) return Null; - break; - default: - return Null; - } + switch (*++buf) { + case 'b': case 'B': + if (gotradix++) return Null; + radix = 2; + break; + case 'o': case 'O': + if (gotradix++) return Null; + radix = 8; + break; + case 'd': case 'D': + if (gotradix++) return Null; + radix = 10; + break; + case 'x': case 'X': + if (gotradix++) return Null; + radix = 16; + break; + case 'e': case 'E': + if (exact++ || inexact) return Null; + break; + case 'i': case 'I': + if (inexact++ || exact) return Null; + break; + default: + return Null; + } } p = buf; if (*p == '+' || (neg = *p == '-')) - p++; + p++; for ( ; (c = *p); p++) { - if (c == '.') { - if (expo || point++) - return Null; - } else if (radix != 16 && (c == 'e' || c == 'E')) { - if (expo++) - return Null; - if (p[1] == '+' || p[1] == '-') - p++; - } else if (radix == 16 && !index ("0123456789abcdefABCDEF", c)) { - return Null; - } else if (radix < 16 && (c < '0' || c > '0' + radix-1)) { - return Null; - } else { - if (expo) edigit++; else mdigit++; - } + if (c == '.') { + if (expo || point++) + return Null; + } else if (radix != 16 && (c == 'e' || c == 'E')) { + if (expo++) + return Null; + if (p[1] == '+' || p[1] == '-') + p++; + } else if (radix == 16 && !index ("0123456789abcdefABCDEF", c)) { + return Null; + } else if (radix < 16 && (c < '0' || c > '0' + radix-1)) { + return Null; + } else { + if (expo) edigit++; else mdigit++; + } } if (!mdigit || (expo && !edigit)) - return Null; + return Null; if (point || expo) { - if (radix != 10) { - if (Nullp (port)) - return Null; - Reader_Error (port, "reals must be given in decimal"); - } - /* Lacking ratnums, there's nothing we can do if #e has been - * specified-- just return the inexact number. - */ - return Make_Flonum (atof (buf)); + if (radix != 10) { + if (Nullp (port)) + return Null; + Reader_Error (port, "reals must be given in decimal"); + } + /* Lacking ratnums, there's nothing we can do if #e has been + * specified-- just return the inexact number. + */ + return Make_Flonum (atof (buf)); } max = (neg ? -(unsigned int)INT_MIN : INT_MAX); maxdig = max % radix; max /= radix; for (i = 0, p = buf; (c = *p); p++) { - if (c == '-' || c == '+') { - buf++; - continue; - } - if (radix == 16) { - if (isupper (c)) - c = tolower (c); - if (c >= 'a') - c = '9' + c - 'a' + 1; - } - c -= '0'; - if ((unsigned int)i > max || ((unsigned int)i == max && c > maxdig)) { - ret = Make_Bignum (buf, neg, radix); - return inexact ? Make_Flonum (Bignum_To_Double (ret)) : ret; - } - i *= radix; i += c; + if (c == '-' || c == '+') { + buf++; + continue; + } + if (radix == 16) { + if (isupper (c)) + c = tolower (c); + if (c >= 'a') + c = '9' + c - 'a' + 1; + } + c -= '0'; + if ((unsigned int)i > max || ((unsigned int)i == max && c > maxdig)) { + ret = Make_Bignum (buf, neg, radix); + return inexact ? Make_Flonum (Bignum_To_Double (ret)) : ret; + } + i *= radix; i += c; } if (neg) - i = -i; + i = -i; return inexact ? Make_Flonum ((double)i) : Make_Integer (i); } @@ -709,10 +709,10 @@ void Reader_Error (Object port, char *msg) { char buf[100]; if (PORT(port)->flags & P_STRING) { - sprintf (buf, "[string-port]: %u: %s", PORT(port)->lno, msg); - Primitive_Error (buf); + sprintf (buf, "[string-port]: %u: %s", PORT(port)->lno, msg); + Primitive_Error (buf); } else { - sprintf (buf, "~s: %u: %s", PORT(port)->lno, msg); - Primitive_Error (buf, PORT(port)->name); + sprintf (buf, "~s: %u: %s", PORT(port)->lno, msg); + Primitive_Error (buf, PORT(port)->name); } } diff --git a/src/special.c b/src/special.c index 9ca344d..e59b864 100644 --- a/src/special.c +++ b/src/special.c @@ -50,73 +50,73 @@ Object Quasiquote (Object x, int level) { TC_Prolog; if (TYPE(x) == T_Vector) { /* Inefficient, but works. */ - x = P_Vector_To_List (x); - x = Quasiquote (x, level); - return P_List_To_Vector (x); + x = P_Vector_To_List (x); + x = Quasiquote (x, level); + return P_List_To_Vector (x); } if (TYPE(x) != T_Pair) - return x; + return x; if (EQ(Car (x), Sym_Unquote)) { - x = Cdr (x); - if (TYPE(x) != T_Pair) - Primitive_Error ("bad unquote form: ~s", x); - if (level) { - ret = Cons (Car (x), Null); - ret = Quasiquote (ret, level-1); - ret = Cons (Sym_Unquote, ret); - } else { - TC_Disable; - ret = Eval (Car (x)); - TC_Enable; - } - return ret; + x = Cdr (x); + if (TYPE(x) != T_Pair) + Primitive_Error ("bad unquote form: ~s", x); + if (level) { + ret = Cons (Car (x), Null); + ret = Quasiquote (ret, level-1); + ret = Cons (Sym_Unquote, ret); + } else { + TC_Disable; + ret = Eval (Car (x)); + TC_Enable; + } + return ret; } else if (TYPE(Car (x)) == T_Pair - && EQ(Car (Car (x)), Sym_Unquote_Splicing)) { - GC_Node6; + && EQ(Car (Car (x)), Sym_Unquote_Splicing)) { + GC_Node6; - qcdr = Cdr (x); - form = list = tail = cell = Null; - x = Car (x); - if (TYPE(Cdr (x)) != T_Pair) - Primitive_Error ("bad unquote-splicing form: ~s", x); - if (level) { - GC_Link2 (list, qcdr); - list = Quasiquote (Cdr (x), level-1); - list = Cons (Sym_Unquote_Splicing, list); - qcdr = Quasiquote (qcdr, level); - list = Cons (list, qcdr); - GC_Unlink; - return list; - } - GC_Link6 (x, qcdr, form, list, tail, cell); - TC_Disable; - form = Eval (Car (Cdr (x))); - TC_Enable; - for ( ; TYPE(form) == T_Pair; tail = cell, form = Cdr (form)) { - cell = Cons (Car (form), Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); - } - qcdr = Quasiquote (qcdr, level); - GC_Unlink; - if (Nullp (list)) - return qcdr; - (void)P_Set_Cdr (tail, qcdr); - return list; + qcdr = Cdr (x); + form = list = tail = cell = Null; + x = Car (x); + if (TYPE(Cdr (x)) != T_Pair) + Primitive_Error ("bad unquote-splicing form: ~s", x); + if (level) { + GC_Link2 (list, qcdr); + list = Quasiquote (Cdr (x), level-1); + list = Cons (Sym_Unquote_Splicing, list); + qcdr = Quasiquote (qcdr, level); + list = Cons (list, qcdr); + GC_Unlink; + return list; + } + GC_Link6 (x, qcdr, form, list, tail, cell); + TC_Disable; + form = Eval (Car (Cdr (x))); + TC_Enable; + for ( ; TYPE(form) == T_Pair; tail = cell, form = Cdr (form)) { + cell = Cons (Car (form), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + qcdr = Quasiquote (qcdr, level); + GC_Unlink; + if (Nullp (list)) + return qcdr; + (void)P_Set_Cdr (tail, qcdr); + return list; } else { - GC_Node3; + GC_Node3; - qcar = qcdr = Null; - GC_Link3 (x, qcar, qcdr); - if (EQ(Car (x), Sym_Quasiquote)) /* hack! */ - ++level; - qcar = Quasiquote (Car (x), level); - qcdr = Quasiquote (Cdr (x), level); - list = Cons (qcar, qcdr); - GC_Unlink; - return list; + qcar = qcdr = Null; + GC_Link3 (x, qcar, qcdr); + if (EQ(Car (x), Sym_Quasiquote)) /* hack! */ + ++level; + qcar = Quasiquote (Car (x), level); + qcdr = Quasiquote (Cdr (x), level); + list = Cons (qcar, qcdr); + GC_Unlink; + return list; } } @@ -129,11 +129,11 @@ Object P_Begin (Object forms) { TC_Prolog; if (Nullp (forms)) - return Null; + return Null; GC_Link (forms); TC_Disable; for ( ; !Nullp (Cdr (forms)); forms = Cdr (forms)) - (void)Eval (Car (forms)); + (void)Eval (Car (forms)); GC_Unlink; TC_Enable; return Eval (Car (forms)); @@ -148,9 +148,9 @@ Object P_Begin1 (Object forms) { GC_Link (forms); TC_Disable; for (n = 1; !Nullp (Cdr (forms)); n = 0, forms = Cdr (forms)) { - r = Eval (Car (forms)); - if (n) - ret = r; + r = Eval (Car (forms)); + if (n) + ret = r; } GC_Unlink; TC_Enable; @@ -169,17 +169,17 @@ Object P_If (Object argl) { TC_Enable; argl = Cdr (argl); if (Truep (cond)) { - ret = Eval (Car (argl)); + ret = Eval (Car (argl)); } else { - /* Special case: avoid calling Begin() for zero/one-form else-part. - */ - argl = Cdr (argl); - if (Nullp (argl)) - ret = Null; - else if (Nullp (Cdr (argl))) - ret = Eval (Car (argl)); - else - ret = Begin (argl); + /* Special case: avoid calling Begin() for zero/one-form else-part. + */ + argl = Cdr (argl); + if (Nullp (argl)) + ret = Null; + else if (Nullp (Cdr (argl))) + ret = Eval (Car (argl)); + else + ret = Begin (argl); } GC_Unlink; return ret; @@ -195,26 +195,26 @@ Object P_Case (Object argl) { TC_Disable; key = Eval (Car (argl)); for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) { - clause = Car (argl); - Check_List (clause); - if (Nullp (clause)) - Primitive_Error ("empty clause"); - select = Car (clause); - if (EQ(select, Sym_Else)) { - if (!Nullp (Cdr (argl))) - Primitive_Error ("`else' not in last clause"); - if (Nullp (Cdr (clause))) - Primitive_Error ("no forms in `else' clause"); - } else if (TYPE(select) == T_Pair) { - select = P_Memv (key, select); - } else - select = P_Eqv (key, select); - if (Truep (select)) { - clause = Cdr (clause); - TC_Enable; - ret = Nullp (clause) ? True : Begin (clause); - break; - } + clause = Car (argl); + Check_List (clause); + if (Nullp (clause)) + Primitive_Error ("empty clause"); + select = Car (clause); + if (EQ(select, Sym_Else)) { + if (!Nullp (Cdr (argl))) + Primitive_Error ("`else' not in last clause"); + if (Nullp (Cdr (clause))) + Primitive_Error ("no forms in `else' clause"); + } else if (TYPE(select) == T_Pair) { + select = P_Memv (key, select); + } else + select = P_Eqv (key, select); + if (Truep (select)) { + clause = Cdr (clause); + TC_Enable; + ret = Nullp (clause) ? True : Begin (clause); + break; + } } TC_Enable; GC_Unlink; @@ -232,37 +232,37 @@ Object P_Cond (Object argl) { GC_Link3 (argl, clause, guard); TC_Disable; for ( ; !Nullp (argl); argl = Cdr (argl)) { - clause = Car (argl); - Check_List (clause); - if (Nullp (clause)) - Primitive_Error ("empty clause"); - guard = Car (clause); - if (EQ(guard, Sym_Else)) { - if (!Nullp (Cdr (argl))) - Primitive_Error ("`else' not in last clause"); - if (Nullp (Cdr (clause))) - Primitive_Error ("no forms in `else' clause"); - else_clause++; - } else - guard = Eval (Car (clause)); - if (Truep (guard)) { - clause = Cdr (clause); - if (!else_clause && !Nullp (clause) && - EQ(Car (clause), Intern ("=>"))) { - clause = Cdr (clause); - if (Nullp (clause) || !Nullp (Cdr (clause))) - Primitive_Error ("syntax error after =>"); - clause = Eval (Car (clause)); - Check_Procedure (clause); - guard = Cons (guard, Null); - TC_Enable; - ret = Funcall (clause, guard, 0); - } else { - TC_Enable; - ret = Nullp (clause) ? guard : Begin (clause); - } - break; - } + clause = Car (argl); + Check_List (clause); + if (Nullp (clause)) + Primitive_Error ("empty clause"); + guard = Car (clause); + if (EQ(guard, Sym_Else)) { + if (!Nullp (Cdr (argl))) + Primitive_Error ("`else' not in last clause"); + if (Nullp (Cdr (clause))) + Primitive_Error ("no forms in `else' clause"); + else_clause++; + } else + guard = Eval (Car (clause)); + if (Truep (guard)) { + clause = Cdr (clause); + if (!else_clause && !Nullp (clause) && + EQ(Car (clause), Intern ("=>"))) { + clause = Cdr (clause); + if (Nullp (clause) || !Nullp (Cdr (clause))) + Primitive_Error ("syntax error after =>"); + clause = Eval (Car (clause)); + Check_Procedure (clause); + guard = Cons (guard, Null); + TC_Enable; + ret = Funcall (clause, guard, 0); + } else { + TC_Enable; + ret = Nullp (clause) ? guard : Begin (clause); + } + break; + } } TC_Enable; GC_Unlink; @@ -276,17 +276,17 @@ Object General_Junction (Object argl, register int and) { ret = and ? True : False; if (Nullp (argl)) - return ret; + return ret; GC_Link (argl); TC_Disable; for ( ; !Nullp (Cdr (argl)); argl = Cdr (argl)) { - ret = Eval (Car (argl)); - if (and != Truep (ret)) - break; + ret = Eval (Car (argl)); + if (and != Truep (ret)) + break; } TC_Enable; if (Nullp (Cdr (argl))) - ret = Eval (Car (argl)); + ret = Eval (Car (argl)); GC_Unlink; return ret; } @@ -309,49 +309,49 @@ Object P_Do (Object argl) { GC_Link6 (argl, tail, b, test, frame, newframe); TC_Disable; for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { - Check_List (tail); - b = Car (tail); - if (Nullp (b)) - Primitive_Error ("bad initialization form"); - val = P_Cdr (b); - Check_List (val); - b = Car (b); - Check_Type (b, T_Symbol); - if (!Nullp (val)) - val = Eval (Car (val)); - test = Assq (b, frame); - if (!EQ(test, False)) - Primitive_Error ("~s: duplicate variable binding", b); - frame = Add_Binding (frame, b, val); + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad initialization form"); + val = P_Cdr (b); + Check_List (val); + b = Car (b); + Check_Type (b, T_Symbol); + if (!Nullp (val)) + val = Eval (Car (val)); + test = Assq (b, frame); + if (!EQ(test, False)) + Primitive_Error ("~s: duplicate variable binding", b); + frame = Add_Binding (frame, b, val); } if ((local_vars = !Nullp (frame))) - Push_Frame (frame); + Push_Frame (frame); test = Car (Cdr (argl)); Check_Type (test, T_Pair); while (1) { - b = Eval (Car (test)); - if (Truep (b)) - break; - (void)Begin (Cdr (Cdr (argl))); - if (!local_vars) - continue; - newframe = Null; - for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { - b = Car (tail); - val = Cdr (b); - len = P_Length (val); - val = FIXNUM(len) > 1 ? Car (Cdr (val)) : Car (b); - val = Eval (val); - newframe = Add_Binding (newframe, Car (b), val); - } - Pop_Frame (); - Push_Frame (newframe); + b = Eval (Car (test)); + if (Truep (b)) + break; + (void)Begin (Cdr (Cdr (argl))); + if (!local_vars) + continue; + newframe = Null; + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + b = Car (tail); + val = Cdr (b); + len = P_Length (val); + val = FIXNUM(len) > 1 ? Car (Cdr (val)) : Car (b); + val = Eval (val); + newframe = Add_Binding (newframe, Car (b), val); + } + Pop_Frame (); + Push_Frame (newframe); } Check_List (Cdr (test)); TC_Enable; ret = Begin (Cdr (test)); if (local_vars) - Pop_Frame (); + Pop_Frame (); GC_Unlink; return ret; } @@ -365,49 +365,49 @@ Object General_Let (Object argl, int disc) { GC_Link5 (argl, frame, b, val, tail); TC_Disable; for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { - Check_List (tail); - b = Car (tail); - if (Nullp (b)) - Primitive_Error ("bad binding form"); - val = P_Cdr (b); - Check_List (val); - if (!Nullp (val) && !Nullp (Cdr (val))) - Primitive_Error ("bad binding form"); - b = Car (b); - Check_Type (b, T_Symbol); - if (!Nullp (val)) - val = Car (val); - if (disc == 0) { - if (!Nullp (val)) - val = Eval (val); - } else if (disc == 1) { - Push_Frame (frame); - if (!Nullp (val)) - val = Eval (val); - Pop_Frame (); - } else if (disc == 2) - val = Null; - binding = Assq (b, frame); - if (disc != 1 && !EQ(binding, False)) - Primitive_Error ("~s: duplicate variable binding", b); - if (disc == 1 && !EQ(binding, False)) - Cdr (binding) = val; - else - frame = Add_Binding (frame, b, val); + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad binding form"); + val = P_Cdr (b); + Check_List (val); + if (!Nullp (val) && !Nullp (Cdr (val))) + Primitive_Error ("bad binding form"); + b = Car (b); + Check_Type (b, T_Symbol); + if (!Nullp (val)) + val = Car (val); + if (disc == 0) { + if (!Nullp (val)) + val = Eval (val); + } else if (disc == 1) { + Push_Frame (frame); + if (!Nullp (val)) + val = Eval (val); + Pop_Frame (); + } else if (disc == 2) + val = Null; + binding = Assq (b, frame); + if (disc != 1 && !EQ(binding, False)) + Primitive_Error ("~s: duplicate variable binding", b); + if (disc == 1 && !EQ(binding, False)) + Cdr (binding) = val; + else + frame = Add_Binding (frame, b, val); } Push_Frame (frame); if (disc == 2) { - for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { - b = Car (tail); - val = Cdr (b); - if (Nullp (val)) - continue; - val = Car (val); - b = Lookup_Symbol (Car (b), 1); - val = Eval (val); - Cdr (b) = val; - SYMBOL(Car (b))->value = val; - } + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + b = Car (tail); + val = Cdr (b); + if (Nullp (val)) + continue; + val = Car (val); + b = Lookup_Symbol (Car (b), 1); + val = Eval (val); + Cdr (b) = val; + SYMBOL(Car (b))->value = val; + } } TC_Enable; ret = Begin (Cdr (argl)); @@ -425,34 +425,34 @@ Object Named_Let (Object argl) { GC_Link6 (argl, tail, vlist, vtail, flist, ftail); TC_Disable; for (tail = Car (Cdr (argl)); !Nullp (tail); tail = Cdr (tail)) { - Check_List (tail); - b = Car (tail); - if (Nullp (b)) - Primitive_Error ("bad binding form"); - val = P_Cdr (b); - Check_List (val); - if (Nullp (val) || !Nullp (Cdr (val))) - Primitive_Error ("bad binding form"); - Check_Type (Car (b), T_Symbol); - if (!Nullp (val)) - val = Car (val); - cell = Cons (val, Null); - if (Nullp (flist)) - flist = cell; - else - (void)P_Set_Cdr (ftail, cell); - ftail = cell; - cell = Cons (Car (Car (tail)), Null); - if (Nullp (vlist)) - vlist = cell; - else - (void)P_Set_Cdr (vtail, cell); - vtail = cell; + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad binding form"); + val = P_Cdr (b); + Check_List (val); + if (Nullp (val) || !Nullp (Cdr (val))) + Primitive_Error ("bad binding form"); + Check_Type (Car (b), T_Symbol); + if (!Nullp (val)) + val = Car (val); + cell = Cons (val, Null); + if (Nullp (flist)) + flist = cell; + else + (void)P_Set_Cdr (ftail, cell); + ftail = cell; + cell = Cons (Car (Car (tail)), Null); + if (Nullp (vlist)) + vlist = cell; + else + (void)P_Set_Cdr (vtail, cell); + vtail = cell; } Push_Frame (Add_Binding (Null, Car (argl), Null)); tail = Cons (vlist, Cdr (Cdr (argl))); if (Nullp (Cdr (tail))) - Primitive_Error ("no subexpressions in named let"); + Primitive_Error ("no subexpressions in named let"); tail = P_Lambda (tail); COMPOUND(tail)->name = Car (argl); b = Lookup_Symbol (Car (argl), 1); @@ -467,9 +467,9 @@ Object Named_Let (Object argl) { Object P_Let (Object argl) { if (TYPE(Car (argl)) == T_Symbol) - return Named_Let (argl); + return Named_Let (argl); else - return General_Let (argl, 0); + return General_Let (argl, 0); } Object P_Letseq (Object argl) { @@ -486,21 +486,21 @@ Object Internal_Fluid_Let (Object bindings, Object argl) { GC_Node5; if (Nullp (bindings)) - return Begin (Cdr (argl)); + return Begin (Cdr (argl)); b = sym = val = Null; GC_Link5 (bindings, argl, b, sym, val); Check_List (bindings); b = Car (bindings); if (Nullp (b)) - Primitive_Error ("bad binding form"); + Primitive_Error ("bad binding form"); sym = Car (b); val = P_Cdr (b); Check_List (val); Check_Type (sym, T_Symbol); if (!Nullp (val)) - val = Car (val); + val = Car (val); if (!Nullp (val)) - val = Eval (val); + val = Eval (val); b = Lookup_Symbol (sym, 1); vec = Make_Vector (3, Null); VECTOR(vec)->data[0] = sym; @@ -523,7 +523,7 @@ Object P_Fluid_Let (Object argl) { TC_Disable; ret = Internal_Fluid_Let (Car (argl), argl); if ((Last_Wind = last)) - last->next = 0; + last->next = 0; First_Wind = first; TC_Enable; return ret; diff --git a/src/stab-bsd.c b/src/stab-bsd.c index 3b75a7c..af6175a 100644 --- a/src/stab-bsd.c +++ b/src/stab-bsd.c @@ -51,38 +51,38 @@ SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { nextp = &tab->first; (void)fseek (f, (long)N_SYMOFF(*ep), 0); for (nsyms = ep->a_syms / sizeof (nl); nsyms > 0; nsyms--) { - if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { - Free_Symbols (tab); - (void)fclose (f); - Primitive_Error ("corrupt symbol table in object file"); - } - if (nl.n_un.n_strx == 0 || nl.n_type & N_STAB) - continue; + if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } + if (nl.n_un.n_strx == 0 || nl.n_type & N_STAB) + continue; #ifndef ibm023 - if ((nl.n_type & N_TYPE) != N_TEXT) - continue; + if ((nl.n_type & N_TYPE) != N_TEXT) + continue; #endif - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = (char *)nl.n_un.n_strx; - sp->value = nl.n_value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = (char *)nl.n_un.n_strx; + sp->value = nl.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; } if (fread ((char *)&strsiz, sizeof (strsiz), 1, f) != 1) { strerr: - Free_Symbols (tab); - (void)fclose (f); - Primitive_Error ("corrupt string table in object file"); + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt string table in object file"); } if (strsiz <= 4) - goto strerr; + goto strerr; tab->strings = Safe_Malloc (strsiz); strsiz -= 4; if (fread (tab->strings+4, 1, strsiz, f) != strsiz) - goto strerr; + goto strerr; for (sp = tab->first; sp; sp = sp->next) - sp->name = tab->strings + (long)sp->name; + sp->name = tab->strings + (long)sp->name; return tab; } @@ -93,16 +93,16 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYMTAB *tab; if ((fd = open (name, O_RDONLY|O_BINARY)) == -1) { - Saved_Errno = errno; - Primitive_Error ("can't open a.out file: ~E"); + Saved_Errno = errno; + Primitive_Error ("can't open a.out file: ~E"); } if (read (fd, (char *)&hdr, sizeof hdr) != sizeof hdr) { - close (fd); - Primitive_Error ("can't read a.out header"); + close (fd); + Primitive_Error ("can't read a.out header"); } if ((fp = fdopen (fd, O_BINARY ? "rb" : "r")) == NULL) { - close (fd); - Primitive_Error ("can't fdopen a.out file"); + close (fd); + Primitive_Error ("can't fdopen a.out file"); } tab = Snarf_Symbols (fp, &hdr); (void)fclose (fp); diff --git a/src/stab-coff.c b/src/stab-coff.c index efcb5a5..af37968 100644 --- a/src/stab-coff.c +++ b/src/stab-coff.c @@ -42,29 +42,29 @@ SYMTAB *Snarf_Symbols (LDFILE *lf, int ep) { extern char *ldgetname(); if (ldtbseek (lf) == FAILURE) { - ldclose (lf); - Primitive_Error ("can't ldtbseek"); + ldclose (lf); + Primitive_Error ("can't ldtbseek"); } tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); tab->first = 0; tab->strings = 0; nextp = &tab->first; while (1) { - inx = ldtbindex (lf); - if (ldtbread (lf, inx, &sym) == FAILURE) - break; - if (sym.n_scnum == N_UNDEF || sym.n_scnum == N_DEBUG - || sym.n_scnum > HEADER(lf).f_nscns || sym.n_sclass != C_EXT) - continue; - if ((p = ldgetname (lf, &sym)) == NULL) - continue; - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = Safe_Malloc (strlen (p) + 1); - strcpy (sp->name, p); - sp->value = sym.n_value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; + inx = ldtbindex (lf); + if (ldtbread (lf, inx, &sym) == FAILURE) + break; + if (sym.n_scnum == N_UNDEF || sym.n_scnum == N_DEBUG + || sym.n_scnum > HEADER(lf).f_nscns || sym.n_sclass != C_EXT) + continue; + if ((p = ldgetname (lf, &sym)) == NULL) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (p) + 1); + strcpy (sp->name, p); + sp->value = sym.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; } return tab; } @@ -75,7 +75,7 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYMTAB *tab; if ((f = ldopen (name, NULL)) == FAILURE) - Primitive_Error ("can't ldopen a.out file"); + Primitive_Error ("can't ldopen a.out file"); tab = Snarf_Symbols (f); ldclose (f); return tab; diff --git a/src/stab-convex.c b/src/stab-convex.c index 814ab77..571d24a 100644 --- a/src/stab-convex.c +++ b/src/stab-convex.c @@ -49,13 +49,13 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYM *sp, **nextp; if ((f = open (name, O_RDONLY)) == -1) { - Saved_Errno = errno; - Primitive_Error ("can't open a.out file: ~E"); + Saved_Errno = errno; + Primitive_Error ("can't open a.out file: ~E"); } if ((base = mmap (0xc0000000, &len, PROT_READ, MAP_FILE, f, (off_t)0)) - == (char *)-1) { - Saved_Errno = errno; - Primitive_Error ("can't mmap a.out file: ~E"); + == (char *)-1) { + Saved_Errno = errno; + Primitive_Error ("can't mmap a.out file: ~E"); } close (f); fhp = (struct filehdr *)base; @@ -69,16 +69,16 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { ohp = (struct opthdr *)(base + sizeof *fhp); np = (struct nlist *)(base + ohp->o_symptr); for (n = 0; n < ohp->o_nsyms; n++, np++) { - if (np->n_un.n_strx == 0 || np->n_type & N_STAB) - continue; - if ((np->n_type & N_TYPE) != N_TEXT) - continue; - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = tab->strings + np->n_un.n_strx; - sp->value = np->n_value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; + if (np->n_un.n_strx == 0 || np->n_type & N_STAB) + continue; + if ((np->n_type & N_TYPE) != N_TEXT) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = tab->strings + np->n_un.n_strx; + sp->value = np->n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; } (void)munmap (base, len); return tab; diff --git a/src/stab-ecoff.c b/src/stab-ecoff.c index 21410ea..8c5a6e3 100644 --- a/src/stab-ecoff.c +++ b/src/stab-ecoff.c @@ -38,13 +38,13 @@ #include AOUT_H SYMTAB *Snarf_Symbols (FILE *fp) { - long fdi; /* a counter for the file desc table */ - FDR *file_desc; /* pointer to the filedesc table */ - struct filehdr file_hdr; /* pointer to the file header */ + long fdi; /* a counter for the file desc table */ + FDR *file_desc; /* pointer to the filedesc table */ + struct filehdr file_hdr; /* pointer to the file header */ char *strbase; - HDRR sym_hdr; /* pointer to symbolic header */ - long symi; /* a counter for the local symbol table */ - SYMR *symbol; /* pointer to symbol table */ + HDRR sym_hdr; /* pointer to symbolic header */ + long symi; /* a counter for the local symbol table */ + SYMR *symbol; /* pointer to symbol table */ SYMTAB *tab; char *p; @@ -56,13 +56,13 @@ SYMTAB *Snarf_Symbols (FILE *fp) { */ (void)rewind (fp); if (fread ((char *)&file_hdr, sizeof (file_hdr), 1, fp) == 0) { - fclose (fp); - Primitive_Error ("cannot read a.out file header"); + fclose (fp); + Primitive_Error ("cannot read a.out file header"); } (void)fseek (fp, file_hdr.f_symptr, SEEK_SET); if (fread ((char *)&sym_hdr, sizeof (sym_hdr), 1, fp) == 0) { - fclose (fp); - Primitive_Error ("cannot read a.out symbolic header"); + fclose (fp); + Primitive_Error ("cannot read a.out symbolic header"); } tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); @@ -76,9 +76,9 @@ SYMTAB *Snarf_Symbols (FILE *fp) { (void)fseek (fp, sym_hdr.cbSymOffset, SEEK_SET); if (fread ((char *)symbol, sizeof (SYMR), sym_hdr.isymMax, fp) == 0) { symerr: - fclose (fp); - Free_Symbols (tab); - Primitive_Error ("cannot read symbol/string/fd table"); + fclose (fp); + Free_Symbols (tab); + Primitive_Error ("cannot read symbol/string/fd table"); } /* Read string table @@ -86,37 +86,37 @@ symerr: tab->strings = Safe_Malloc (sym_hdr.issMax); (void)fseek (fp, sym_hdr.cbSsOffset, SEEK_SET); if (fread (tab->strings, sym_hdr.issMax, 1, fp) == 0) - goto symerr; + goto symerr; /* Read file descriptor table */ Alloca (file_desc, FDR*, sym_hdr.ifdMax * sizeof (FDR)); (void)fseek (fp, sym_hdr.cbFdOffset, SEEK_SET); if (fread ((char *)file_desc, sizeof (FDR), sym_hdr.ifdMax, fp) == 0) - goto symerr; + goto symerr; /* For each file in the file descriptor table do: */ for (fdi = 0; fdi < sym_hdr.ifdMax; fdi++) { - strbase = tab->strings + file_desc[fdi].issBase; - for (symi = file_desc[fdi].isymBase; - symi < file_desc[fdi].csym + file_desc[fdi].isymBase; - symi++) { - if (symbol[symi].st == stProc && symbol[symi].sc == scText) { - p = symbol[symi].iss + strbase; + strbase = tab->strings + file_desc[fdi].issBase; + for (symi = file_desc[fdi].isymBase; + symi < file_desc[fdi].csym + file_desc[fdi].isymBase; + symi++) { + if (symbol[symi].st == stProc && symbol[symi].sc == scText) { + p = symbol[symi].iss + strbase; - /* Allocate and initialize node in the symbol table list; - * link node into list - */ - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = Safe_Malloc (strlen (p) + 1); - strcpy (sp->name, p); - sp->value = symbol[symi].value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; - } - } + /* Allocate and initialize node in the symbol table list; + * link node into list + */ + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (p) + 1); + strcpy (sp->name, p); + sp->value = symbol[symi].value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + } } Alloca_End; return tab; @@ -127,7 +127,7 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYMTAB *tab; if ((fp = fopen (name, "r")) == NULL) - Primitive_Error ("can't open a.out file"); + Primitive_Error ("can't open a.out file"); tab = Snarf_Symbols (fp); (void)fclose (fp); return tab; diff --git a/src/stab-elf.c b/src/stab-elf.c index 5475695..17b0b0d 100644 --- a/src/stab-elf.c +++ b/src/stab-elf.c @@ -36,18 +36,18 @@ SYMTAB * Snarf_Symbols (lf) - int lf; + int lf; { - SYMTAB *tab = NULL; + SYMTAB *tab = NULL; register SYM *sp, **nextp; - Elf *elf_ptr; - Elf_Scn *elf_scn_ptr = NULL, *symtab_scn_ptr = NULL; - Elf_Data *elf_data_ptr = NULL; - Elf32_Ehdr *elf_ehdr_ptr = NULL; - Elf32_Shdr *elf_shdr_ptr = NULL, - *symtab_ptr = NULL; - size_t elf_str_index = 0, shstrndx; - char *section_name; + Elf *elf_ptr; + Elf_Scn *elf_scn_ptr = NULL, *symtab_scn_ptr = NULL; + Elf_Data *elf_data_ptr = NULL; + Elf32_Ehdr *elf_ehdr_ptr = NULL; + Elf32_Shdr *elf_shdr_ptr = NULL, + *symtab_ptr = NULL; + size_t elf_str_index = 0, shstrndx; + char *section_name; if (elf_version (EV_CURRENT) == EV_NONE) Primitive_Error ("a.out file Elf version out of date"); @@ -59,30 +59,30 @@ Snarf_Symbols (lf) * names. */ if ((elf_ehdr_ptr = elf32_getehdr (elf_ptr)) == NULL) { - Primitive_Error ("no elf header in a.out file"); + Primitive_Error ("no elf header in a.out file"); } shstrndx = elf_ehdr_ptr->e_shstrndx; /* look for the symbol and string tables */ while ((elf_scn_ptr = elf_nextscn (elf_ptr, elf_scn_ptr))) { - if ((elf_shdr_ptr = elf32_getshdr (elf_scn_ptr)) == NULL) - Primitive_Error ("can't get section header in a.out file"); - if (elf_shdr_ptr->sh_type == SHT_STRTAB) { - /* - * save the index to the string table for later use by - * elf_strptr(). - */ - section_name = elf_strptr (elf_ptr, shstrndx, - (size_t)elf_shdr_ptr->sh_name); - if (strcmp (section_name, ".strtab") == 0 || - strcmp (section_name, ".dynstr") == 0) { - elf_str_index = elf_ndxscn (elf_scn_ptr); - } - } - else if (elf_shdr_ptr->sh_type == SHT_SYMTAB || - elf_shdr_ptr->sh_type == SHT_DYNSYM) { - symtab_ptr = elf_shdr_ptr; - symtab_scn_ptr = elf_scn_ptr; - } + if ((elf_shdr_ptr = elf32_getshdr (elf_scn_ptr)) == NULL) + Primitive_Error ("can't get section header in a.out file"); + if (elf_shdr_ptr->sh_type == SHT_STRTAB) { + /* + * save the index to the string table for later use by + * elf_strptr(). + */ + section_name = elf_strptr (elf_ptr, shstrndx, + (size_t)elf_shdr_ptr->sh_name); + if (strcmp (section_name, ".strtab") == 0 || + strcmp (section_name, ".dynstr") == 0) { + elf_str_index = elf_ndxscn (elf_scn_ptr); + } + } + else if (elf_shdr_ptr->sh_type == SHT_SYMTAB || + elf_shdr_ptr->sh_type == SHT_DYNSYM) { + symtab_ptr = elf_shdr_ptr; + symtab_scn_ptr = elf_scn_ptr; + } } if (!symtab_ptr) Primitive_Error ("no symbol table in a.out file"); @@ -93,40 +93,40 @@ Snarf_Symbols (lf) * of the interesting symbols. */ while ((elf_data_ptr = elf_getdata (symtab_scn_ptr, elf_data_ptr))) { - char *name = NULL; - int symbol_count; - Elf32_Sym *symbol_ptr = elf_data_ptr->d_buf; - Elf32_Sym *current_symbol; + char *name = NULL; + int symbol_count; + Elf32_Sym *symbol_ptr = elf_data_ptr->d_buf; + Elf32_Sym *current_symbol; - tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); - tab->first = 0; - tab->strings = 0; - nextp = &tab->first; - for (symbol_count = 1; - /* < was <= in the version I received from the author, but - * the last entry is always undefined: - */ - symbol_count < symtab_ptr->sh_size / symtab_ptr->sh_entsize; - symbol_count++) { - current_symbol = symbol_ptr + symbol_count; - if (ELF32_ST_TYPE(current_symbol->st_info) != STT_FUNC || - ELF32_ST_BIND(current_symbol->st_info) != STB_GLOBAL) { - continue; - } - if ((name = elf_strptr (elf_ptr, elf_str_index, - (size_t)current_symbol->st_name)) == NULL) { - Free_Symbols (tab); - (void)close (lf); - Primitive_Error (elf_errmsg (elf_errno ())); - } - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = Safe_Malloc (strlen (name) + 1); - strcpy (sp->name, name); - sp->value = current_symbol->st_value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; - } + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + for (symbol_count = 1; + /* < was <= in the version I received from the author, but + * the last entry is always undefined: + */ + symbol_count < symtab_ptr->sh_size / symtab_ptr->sh_entsize; + symbol_count++) { + current_symbol = symbol_ptr + symbol_count; + if (ELF32_ST_TYPE(current_symbol->st_info) != STT_FUNC || + ELF32_ST_BIND(current_symbol->st_info) != STB_GLOBAL) { + continue; + } + if ((name = elf_strptr (elf_ptr, elf_str_index, + (size_t)current_symbol->st_name)) == NULL) { + Free_Symbols (tab); + (void)close (lf); + Primitive_Error (elf_errmsg (elf_errno ())); + } + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (name) + 1); + strcpy (sp->name, name); + sp->value = current_symbol->st_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } } return tab; } @@ -135,11 +135,11 @@ SYMTAB * Open_File_And_Snarf_Symbols (name) char *name; { - int f; - SYMTAB *tab; + int f; + SYMTAB *tab; if ((f = open (name, O_RDONLY)) == -1) - Primitive_Error ("can't open a.out file"); + Primitive_Error ("can't open a.out file"); tab = Snarf_Symbols (f); (void)close (f); return tab; diff --git a/src/stab-hp9k300.c b/src/stab-hp9k300.c index 446f760..df9c634 100644 --- a/src/stab-hp9k300.c +++ b/src/stab-hp9k300.c @@ -48,7 +48,7 @@ SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { register SYM *sp; register SYM **nextp; int strsiz = 0; /* running total length of names read, */ - /* each '\0' terminated */ + /* each '\0' terminated */ int nread = 0; /* running total of bytes read from symbol table */ int max = 0; /* current maximum size of name table */ char *names = 0; /* the name table */ @@ -62,15 +62,15 @@ SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { (void)fseek (f, (long)LESYM_OFFSET(*ep), 0); while (nread < ep->a_lesyms) { - if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { - Free_Symbols (tab); - (void)fclose (f); - Primitive_Error ("corrupt symbol table in object file"); - } + if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } nread += sizeof (nl); - if (nl.n_length == 0) { + if (nl.n_length == 0) { continue; } else if (nl.n_length + strsiz + 1 > max) { @@ -79,31 +79,31 @@ SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { } if (fread (names + strsiz, 1, nl.n_length, f) != nl.n_length) { - Free_Symbols (tab); - (void)fclose (f); - Primitive_Error ("corrupt symbol table in object file"); - } + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } else { nread += nl.n_length; names[ strsiz + nl.n_length ] = '\0'; } - if ((nl.n_type & N_TYPE) != N_TEXT) { - strsiz += nl.n_length +1; - continue; - } - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = (char *)strsiz; + if ((nl.n_type & N_TYPE) != N_TEXT) { + strsiz += nl.n_length +1; + continue; + } + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = (char *)strsiz; strsiz += (nl.n_length + 1); - sp->value = nl.n_value; - *nextp = sp; - nextp = &sp->next; - *nextp = 0; + sp->value = nl.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; } tab->strings = names; for (sp = tab->first; sp; sp = sp->next) - sp->name += (unsigned int)names; + sp->name += (unsigned int)names; return tab; } @@ -115,10 +115,10 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYMTAB *tab; if ((f = fopen (name, "r")) == NULL) - Primitive_Error ("can't open a.out file"); + Primitive_Error ("can't open a.out file"); if (fread ((char *)&hdr, sizeof hdr, 1, f) != 1) { - (void)fclose (f); - Primitive_Error ("can't read a.out header"); + (void)fclose (f); + Primitive_Error ("can't read a.out header"); } tab = Snarf_Symbols (f, &hdr); (void)fclose (f); diff --git a/src/stab-hp9k800.c b/src/stab-hp9k800.c index 30a2e98..bb75837 100644 --- a/src/stab-hp9k800.c +++ b/src/stab-hp9k800.c @@ -43,27 +43,27 @@ SYMTAB *Snarf_Symbols (FILE *f, struct header *hp) { tab->strings = Safe_Malloc (hp->symbol_strings_size); (void)fseek (f, (long)hp->symbol_strings_location, SEEK_SET); if (fread (tab->strings, hp->symbol_strings_size, 1, f) != 1) { - (void)fclose (f); - Free_Symbols (tab); - Primitive_Error ("corrupt string table in object file"); + (void)fclose (f); + Free_Symbols (tab); + Primitive_Error ("corrupt string table in object file"); } (void)fseek (f, (long)hp->symbol_location, SEEK_SET); for (n = hp->symbol_total; n > 0; n--) { - if (fread ((char *)&r, sizeof r, 1, f) != 1) { - (void)fclose (f); - Free_Symbols (tab); - Primitive_Error ("corrupt symbol table in object file"); - } - if (r.symbol_type != ST_CODE) - continue; - if (r.symbol_scope != SS_UNIVERSAL) - continue; - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = tab->strings + r.name.n_strx; - sp->value = r.symbol_value & ~3; /* mask out privilege level */ - *nextp = sp; - nextp = &sp->next; - *nextp = 0; + if (fread ((char *)&r, sizeof r, 1, f) != 1) { + (void)fclose (f); + Free_Symbols (tab); + Primitive_Error ("corrupt symbol table in object file"); + } + if (r.symbol_type != ST_CODE) + continue; + if (r.symbol_scope != SS_UNIVERSAL) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = tab->strings + r.name.n_strx; + sp->value = r.symbol_value & ~3; /* mask out privilege level */ + *nextp = sp; + nextp = &sp->next; + *nextp = 0; } return tab; } @@ -74,10 +74,10 @@ SYMTAB *Open_File_And_Snarf_Symbols (char *name) { SYMTAB *tab; if ((f = fopen (name, "r")) == NULL) - Primitive_Error ("can't open a.out file"); + Primitive_Error ("can't open a.out file"); if (fread ((char *)&hdr, sizeof hdr, 1, f) != 1) { - (void)fclose (f); - Primitive_Error ("can't read a.out header"); + (void)fclose (f); + Primitive_Error ("can't read a.out header"); } tab = Snarf_Symbols (f, &hdr); (void)fclose (f); diff --git a/src/stab-macho.c b/src/stab-macho.c index f8fdcce..d8be1d8 100644 --- a/src/stab-macho.c +++ b/src/stab-macho.c @@ -50,15 +50,15 @@ static SYMTAB *Grovel_Over_Nlist (symcmd, nl, strtab, text_sect) * have a section mumber equal to the number of the text section: */ for (i = 0; i < symcmd->nsyms; i++) { - if ((nl[i].n_type & (N_TYPE|N_EXT)) == (N_SECT|N_EXT) && - nl[i].n_sect == text_sect) { - sp = (SYM *)Safe_Malloc (sizeof (SYM)); - sp->name = strtab + nl[i].n_un.n_strx; - sp->value = nl[i].n_value; - sp->next = 0; - *nextp = sp; - nextp = &sp->next; - } + if ((nl[i].n_type & (N_TYPE|N_EXT)) == (N_SECT|N_EXT) && + nl[i].n_sect == text_sect) { + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = strtab + nl[i].n_un.n_strx; + sp->value = nl[i].n_value; + sp->next = 0; + *nextp = sp; + nextp = &sp->next; + } } return tab; } @@ -78,25 +78,25 @@ SYMTAB *Snarf_Symbols (struct mach_header *mhdr) { */ cmdptr = (char *)mhdr + sizeof (struct mach_header); for (i = 0; i < mhdr->ncmds; i++) { - ld_cmd = (struct load_command *)cmdptr; - if (ld_cmd->cmd == LC_SYMTAB && !symtab) { - sym_cmd = (struct symtab_command *)ld_cmd; - symtab = (struct nlist *)((char *)mhdr + sym_cmd->symoff); - strtab = (char *)mhdr + sym_cmd->stroff; - } else if (ld_cmd->cmd == LC_SEGMENT && !text_sect) { - seg_cmd = (struct segment_command *)ld_cmd; - sp = (struct section *) - ((char *)ld_cmd + sizeof (struct segment_command)); - for (j = 1; j <= seg_cmd->nsects && !text_sect; j++, sp++) - if (strcmp (sp->sectname, SECT_TEXT) == 0) - text_sect = j; - } - cmdptr += ld_cmd->cmdsize; + ld_cmd = (struct load_command *)cmdptr; + if (ld_cmd->cmd == LC_SYMTAB && !symtab) { + sym_cmd = (struct symtab_command *)ld_cmd; + symtab = (struct nlist *)((char *)mhdr + sym_cmd->symoff); + strtab = (char *)mhdr + sym_cmd->stroff; + } else if (ld_cmd->cmd == LC_SEGMENT && !text_sect) { + seg_cmd = (struct segment_command *)ld_cmd; + sp = (struct section *) + ((char *)ld_cmd + sizeof (struct segment_command)); + for (j = 1; j <= seg_cmd->nsects && !text_sect; j++, sp++) + if (strcmp (sp->sectname, SECT_TEXT) == 0) + text_sect = j; + } + cmdptr += ld_cmd->cmdsize; } if (!symtab) - Primitive_Error ("couldn't find symbol table in object file"); + Primitive_Error ("couldn't find symbol table in object file"); if (!text_sect) - Primitive_Error ("couldn't find text section in object file"); + Primitive_Error ("couldn't find text section in object file"); return Grovel_Over_Nlist (sym_cmd, symtab, strtab, text_sect); } diff --git a/src/stab.c b/src/stab.c index 42f795a..287b46d 100644 --- a/src/stab.c +++ b/src/stab.c @@ -101,43 +101,43 @@ void Call_Initializers (SYMTAB *tab, char *addr, int which) { * functions and C++ static destructors will be appended to this list: */ for (fpp = &Finalizers; *fpp; fpp = &(*fpp)->next) - ; + ; for (sp = tab->first; sp; sp = sp->next) { - if ((char *)sp->value < addr) - continue; - p = sp->name; + if ((char *)sp->value < addr) + continue; + p = sp->name; #ifdef SYMS_BEGIN_WITH - if (*p == SYMS_BEGIN_WITH) - p++; - else - continue; + if (*p == SYMS_BEGIN_WITH) + p++; + else + continue; #endif - for (pp = Ignore_Prefixes; pp->name; pp++) - if (strncmp (p, pp->name, strlen (pp->name)) == 0) - goto next; - for (pp = Init_Prefixes; pp->name; pp++) { - if (pp->type == which - && strncmp (p, pp->name, strlen (pp->name)) == 0) { - if (Verb_Init) - printf ("[calling %s]\n", p); - Call (sp->value); - } - } - /* Append to list of finalizers (to be invoked on exit): - */ - for (pp = Finit_Prefixes; pp->name; pp++) { - if (pp->type == which - && strncmp (p, pp->name, strlen (pp->name)) == 0) { - fp = (FUNCT *)Safe_Malloc (sizeof (FUNCT)); - fp->func = (void (*)())sp->value; - fp->name = Safe_Malloc (strlen (p) + 1); - strcpy (fp->name, p); - fp->next = 0; - *fpp = fp; - fpp = &fp->next; - } - } + for (pp = Ignore_Prefixes; pp->name; pp++) + if (strncmp (p, pp->name, strlen (pp->name)) == 0) + goto next; + for (pp = Init_Prefixes; pp->name; pp++) { + if (pp->type == which + && strncmp (p, pp->name, strlen (pp->name)) == 0) { + if (Verb_Init) + printf ("[calling %s]\n", p); + Call (sp->value); + } + } + /* Append to list of finalizers (to be invoked on exit): + */ + for (pp = Finit_Prefixes; pp->name; pp++) { + if (pp->type == which + && strncmp (p, pp->name, strlen (pp->name)) == 0) { + fp = (FUNCT *)Safe_Malloc (sizeof (FUNCT)); + fp->func = (void (*)())sp->value; + fp->name = Safe_Malloc (strlen (p) + 1); + strcpy (fp->name, p); + fp->next = 0; + *fpp = fp; + fpp = &fp->next; + } + } next: ; } } @@ -147,11 +147,11 @@ next: ; */ void Call_Finalizers () { while (Finalizers) { - FUNCT *fp = Finalizers; - Finalizers = fp->next; - if (Verb_Init) - printf ("[calling %s]\n", fp->name); - Call ((unsigned long int)fp->func); + FUNCT *fp = Finalizers; + Finalizers = fp->next; + if (Verb_Init) + printf ("[calling %s]\n", fp->name); + Call ((unsigned long int)fp->func); } } @@ -159,14 +159,14 @@ void Free_Symbols (SYMTAB *tab) { register SYM *sp, *nextp; for (sp = tab->first; sp; sp = nextp) { - nextp = sp->next; + nextp = sp->next; #if defined(COFF) || defined(ECOFF) - free (sp->name); + free (sp->name); #endif - free ((char *)sp); + free ((char *)sp); } if (tab->strings) - free (tab->strings); + free (tab->strings); free ((char *)tab); } #endif /* CAN_LOAD_OBJ || INIT_OBJECTS */ diff --git a/src/stkmem.c b/src/stkmem.c index 742b89a..aa0d8d8 100644 --- a/src/stkmem.c +++ b/src/stkmem.c @@ -41,7 +41,7 @@ char *Mem_Alloc (unsigned int size) { Disable_Interrupts; if ((ret = malloc (size)) == 0) - Fatal_Error ("not enough memory to malloc %u bytes", size); + Fatal_Error ("not enough memory to malloc %u bytes", size); Enable_Interrupts; return ret; } @@ -51,9 +51,9 @@ Free_Mem_Nodes (MEM_NODE *first) { Disable_Interrupts; while (p = first) { - first = first->next; - if (--p->refcnt == 0) - free ((char *)p); + first = first->next; + if (--p->refcnt == 0) + free ((char *)p); } Enable_Interrupts; } @@ -67,14 +67,14 @@ Save_Mem_Nodes (Object cont) { CONTROL(cont)->memlist = Mem_List; for (p = Mem_List; p; p = p->next) - sum += p->len; + sum += p->len; GC_Link (cont); str = Make_String ((char *)0, sum); CONTROL(cont)->memsave = str; GC_Unlink; for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { - memcpy (s, p+1, p->len); - p->refcnt++; + memcpy (s, p+1, p->len); + p->refcnt++; } } @@ -87,8 +87,8 @@ Restore_Mem_Nodes (Object cont) { Mem_List = CONTROL(cont)->memlist; str = CONTROL(cont)->memsave; for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { - p->refcnt++; - memcpy (p+1, s, p->len); + p->refcnt++; + memcpy (p+1, s, p->len); } } @@ -98,11 +98,11 @@ Object Save_GC_Nodes () { register GCNODE *p; for (p = GC_List; p; p = p->next) - sum += p->gclen <= 0 ? 1 : p->gclen-1; + sum += p->gclen <= 0 ? 1 : p->gclen-1; vec = Make_Vector (sum, Null); for (p = GC_List; p; p = p->next, i += n) { - n = p->gclen <= 0 ? 1 : p->gclen-1; - memcpy (&(VECTOR(vec)->data[i]), p->gcobj, n * sizeof (Object)); + n = p->gclen <= 0 ? 1 : p->gclen-1; + memcpy (&(VECTOR(vec)->data[i]), p->gcobj, n * sizeof (Object)); } return vec; } @@ -112,8 +112,8 @@ Restore_GC_Nodes (Object vec) { register GCNODE *p; for (p = GC_List; p; p = p->next, i += n) { - n = p->gclen <= 0 ? 1 : p->gclen-1; - memcpy (p->gcobj, &(VECTOR(vec)->data[i]), n * sizeof (Object)); + n = p->gclen <= 0 ? 1 : p->gclen-1; + memcpy (p->gcobj, &(VECTOR(vec)->data[i]), n * sizeof (Object)); } } diff --git a/src/string.c b/src/string.c index 4cb37ce..0e7c804 100644 --- a/src/string.c +++ b/src/string.c @@ -41,9 +41,9 @@ void Init_String () { register int i; for (i = 0; i < 256; i++) - Char_Map[i] = i; + Char_Map[i] = i; for (i = 'A'; i <= 'Z'; i++) - Char_Map[i] = tolower (i); + Char_Map[i] = tolower (i); } Object General_Make_String (char const *s, int len, int konst) { @@ -53,7 +53,7 @@ Object General_Make_String (char const *s, int len, int konst) { STRING(str)->tag = Null; STRING(str)->size = len; if (s) - memcpy (STRING(str)->data, s, len); + memcpy (STRING(str)->data, s, len); return str; } @@ -75,10 +75,10 @@ Object P_Make_String (int argc, Object *argv) { register char *p; if ((len = Get_Exact_Integer (argv[0])) < 0) - Range_Error (argv[0]); + Range_Error (argv[0]); if (argc == 2) { - Check_Type (argv[1], T_Character); - c = CHAR(argv[1]); + Check_Type (argv[1], T_Character); + c = CHAR(argv[1]); } str = Make_String ((char *)0, len); for (p = STRING(str)->data; len; len--) *p++ = c; @@ -91,8 +91,8 @@ Object P_String (int argc, Object *argv) { str = Make_String ((char *)0, argc); for (i = 0; i < argc; i++) { - Check_Type (argv[i], T_Character); - STRING(str)->data[i] = CHAR(argv[i]); + Check_Type (argv[i], T_Character); + STRING(str)->data[i] = CHAR(argv[i]); } return str; } @@ -106,13 +106,13 @@ Object P_String_To_Number (int argc, Object *argv) { Check_Type (argv[0], T_String); if (argc == 2) { - radix = Get_Exact_Integer (argv[1]); - switch (radix) { - case 2: case 8: case 10: case 16: - break; - default: - Primitive_Error ("invalid radix: ~s", argv[1]); - } + radix = Get_Exact_Integer (argv[1]); + switch (radix) { + case 2: case 8: case 10: case 16: + break; + default: + Primitive_Error ("invalid radix: ~s", argv[1]); + } } p = STRING(argv[0]); Alloca (b, char*, p->size+1); @@ -149,11 +149,11 @@ Object P_Substring (Object s, Object a, Object b) { Check_Type (s, T_String); if ((i = Get_Exact_Integer (a)) < 0 || i > STRING(s)->size) - Range_Error (a); + Range_Error (a); if ((j = Get_Exact_Integer (b)) < 0 || j > STRING(s)->size) - Range_Error (b); + Range_Error (b); if (i > j) - Primitive_Error ("`end' less than `start'"); + Primitive_Error ("`end' less than `start'"); return Make_String (&STRING(s)->data[i], j-i); } @@ -167,14 +167,14 @@ Object P_String_Append (int argc, Object *argv) { Object s, str; for (len = i = 0; i < argc; i++) { - Check_Type (argv[i], T_String); - len += STRING(argv[i])->size; + Check_Type (argv[i], T_String); + len += STRING(argv[i])->size; } str = Make_String ((char *)0, len); for (len = i = 0; i < argc; i++) { - s = argv[i]; - memcpy (&STRING(str)->data[len], STRING(s)->data, STRING(s)->size); - len += STRING(s)->size; + s = argv[i]; + memcpy (&STRING(str)->data[len], STRING(s)->data, STRING(s)->size); + len += STRING(s)->size; } return str; } @@ -188,8 +188,8 @@ Object P_List_To_String (Object list) { len = P_Length (list); str = Make_String ((char *)0, FIXNUM(len)); for (i = 0; i < FIXNUM(len); i++, list = Cdr (list)) { - Check_Type (Car (list), T_Character); - STRING(str)->data[i] = CHAR(Car (list)); + Check_Type (Car (list), T_Character); + STRING(str)->data[i] = CHAR(Car (list)); } GC_Unlink; return str; @@ -204,11 +204,11 @@ Object P_String_To_List (Object s) { list = tail = Null; GC_Link3 (s, list, tail); for (i = 0; i < STRING(s)->size; i++, tail = cell) { - cell = Cons (Make_Char (STRING(s)->data[i]), Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); + cell = Cons (Make_Char (STRING(s)->data[i]), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); } GC_Unlink; return list; @@ -222,11 +222,11 @@ Object P_Substring_Fill (Object s, Object a, Object b, Object c) { Check_Type (c, T_Character); i = Get_Index (a, s); if ((j = Get_Exact_Integer (b)) < 0 || j > STRING(s)->size) - Range_Error (b); + Range_Error (b); if (i > j) - Primitive_Error ("`end' less than `start'"); + Primitive_Error ("`end' less than `start'"); while (i < j) - STRING(s)->data[i++] = CHAR(c); + STRING(s)->data[i++] = CHAR(c); return s; } @@ -238,7 +238,7 @@ Object P_String_Fill (Object s, Object c) { Check_Mutable (s); GC_Link2 (s, c); ret = P_Substring_Fill (s, Make_Integer (0), - Make_Integer (STRING(s)->size), c); + Make_Integer (STRING(s)->size), c); GC_Unlink; return ret; } @@ -253,13 +253,13 @@ Object General_Substringp (Object s1, Object s2, register int ci) { l2 = STRING(s2)->size; map = Char_Map; for (p2 = STRING(s2)->data; l2 >= l1; p2++, l2--) { - for (p1 = STRING(s1)->data, p3 = p2, n = l1; n; n--, p1++, p3++) { - if (ci) { - if (map[(int)*p1] != map[(int)*p3]) goto fail; - } else - if (*p1 != *p3) goto fail; - } - return Make_Integer (STRING(s2)->size - l2); + for (p1 = STRING(s1)->data, p3 = p2, n = l1; n; n--, p1++, p3++) { + if (ci) { + if (map[(int)*p1] != map[(int)*p3]) goto fail; + } else + if (*p1 != *p3) goto fail; + } + return Make_Integer (STRING(s2)->size - l2); fail: ; } return False; @@ -283,13 +283,13 @@ int General_Strcmp (Object s1, Object s2, register int ci) { n = l1 > l2 ? l2 : l1; p1 = STRING(s1)->data; p2 = STRING(s2)->data; for (map = Char_Map; --n >= 0; p1++, p2++) { - if (ci) { - if (map[(int)*p1] != map[(int)*p2]) break; - } else - if (*p1 != *p2) break; + if (ci) { + if (map[(int)*p1] != map[(int)*p2]) break; + } else + if (*p1 != *p2) break; } if (n < 0) - return l1 - l2; + return l1 - l2; return ci ? map[(int)*p1] - map[(int)*p2] : *p1 - *p2; } diff --git a/src/symbol.c b/src/symbol.c index 46d14f3..6836f35 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -97,10 +97,10 @@ Object Obarray_Lookup (register char const *str, register int len) { h = Hash (str, len) % OBARRAY_SIZE; for (p = VECTOR(Obarray)->data[h]; !Nullp (p); p = sym->next) { - sym = SYMBOL(p); - s = STRING(sym->name); - if (s->size == len && bcmp (s->data, str, len) == 0) - return p; + sym = SYMBOL(p); + s = STRING(sym->name); + if (s->size == len && bcmp (s->data, str, len) == 0) + return p; } return Make_Integer (h); } @@ -115,17 +115,17 @@ Object CI_Intern (char const *str) { len = strlen (str); if (len > sizeof (buf)) { - Alloca (dst, char*, len); + Alloca (dst, char*, len); } else - dst = buf; + dst = buf; src = str; str = dst; for ( ; *src; src++, dst++) - *dst = isupper (*src) ? tolower (*src) : *src; + *dst = isupper (*src) ? tolower (*src) : *src; s = Obarray_Lookup (str, len); if (TYPE(s) != T_Fixnum) { - Alloca_End; - return s; + Alloca_End; + return s; } ostr = Make_Const_String (str, len); sym = Make_Symbol (ostr); @@ -141,11 +141,11 @@ Object Intern (char const *str) { register int len; if (Case_Insensitive) - return CI_Intern (str); + return CI_Intern (str); len = strlen (str); s = Obarray_Lookup (str, len); if (TYPE(s) != T_Fixnum) - return s; + return s; ostr = Make_Const_String (str, len); sym = Make_Symbol (ostr); p = &VECTOR(Obarray)->data[FIXNUM(s)]; @@ -160,7 +160,7 @@ Object P_String_To_Symbol (Object str) { Check_Type (str, T_String); s = Obarray_Lookup (STRING(str)->data, STRING(str)->size); if (TYPE(s) != T_Fixnum) - return s; + return s; str = Make_String (STRING(str)->data, STRING(str)->size); sym = Make_Symbol (str); p = &VECTOR(Obarray)->data[FIXNUM(s)]; @@ -177,11 +177,11 @@ Object P_Oblist () { p = list = Null; GC_Link2 (p, list); for (i = 0; i < OBARRAY_SIZE; i++) { - bucket = Null; - for (p = VECTOR(Obarray)->data[i]; !Nullp (p); p = SYMBOL(p)->next) - bucket = Cons (p, bucket); - if (!Nullp (bucket)) - list = Cons (bucket, list); + bucket = Null; + for (p = VECTOR(Obarray)->data[i]; !Nullp (p); p = SYMBOL(p)->next) + bucket = Cons (p, bucket); + if (!Nullp (bucket)) + list = Cons (bucket, list); } GC_Unlink; return list; @@ -197,27 +197,27 @@ Object P_Put (int argc, Object *argv) { Check_Type (key, T_Symbol); last = Null; for (tail = SYMBOL(sym)->plist; !Nullp (tail); tail = Cdr (tail)) { - prop = Car (tail); - if (EQ(Car (prop), key)) { - if (argc == 3) - Cdr (prop) = argv[2]; - else if (Nullp (last)) - SYMBOL(sym)->plist = Cdr (tail); - else - Cdr (last) = Cdr (tail); - return key; - } - last = tail; + prop = Car (tail); + if (EQ(Car (prop), key)) { + if (argc == 3) + Cdr (prop) = argv[2]; + else if (Nullp (last)) + SYMBOL(sym)->plist = Cdr (tail); + else + Cdr (last) = Cdr (tail); + return key; + } + last = tail; } if (argc == 2) - return False; + return False; GC_Link3 (sym, last, key); tail = Cons (key, argv[2]); tail = Cons (tail, Null); if (Nullp (last)) - SYMBOL(sym)->plist = tail; + SYMBOL(sym)->plist = tail; else - Cdr (last) = tail; + Cdr (last) = tail; GC_Unlink; return key; } @@ -229,12 +229,12 @@ Object P_Get (Object sym, Object key) { Check_Type (key, T_Symbol); prop = Assq (key, SYMBOL(sym)->plist); if (!Truep (prop)) - return False; - /* - * Do we want to signal an error or return #f? - * - * Primitive_Error ("~s has no such property: ~s", sym, key); - */ + return False; + /* + * Do we want to signal an error or return #f? + * + * Primitive_Error ("~s has no such property: ~s", sym, key); + */ return Cdr (prop); } @@ -249,9 +249,9 @@ int Hash (char const *str, int len) { h = 5 * len; if (len > 5) - len = 5; + len = 5; for (p = str, ep = p+len; p < ep; ++p) - h = (h << 2) ^ *p; + h = (h << 2) ^ *p; return h & 017777777777; } @@ -297,20 +297,20 @@ unsigned long int Symbols_To_Bits (Object x, int mflag, SYMDESCR *stab) { if (!mflag) Check_Type (x, T_Symbol); for (l = x; !Nullp (l); l = Cdr (l)) { - if (mflag) { - Check_Type (l, T_Pair); - x = Car (l); - } - Check_Type (x, T_Symbol); - s = SYMBOL(x)->name; - p = STRING(s)->data; - n = STRING(s)->size; - for (syms = stab; syms->name; syms++) - if (n && strncmp (syms->name, p, n) == 0) break; - if (syms->name == 0) - Primitive_Error ("invalid argument: ~s", x); - mask |= syms->val; - if (!mflag) break; + if (mflag) { + Check_Type (l, T_Pair); + x = Car (l); + } + Check_Type (x, T_Symbol); + s = SYMBOL(x)->name; + p = STRING(s)->data; + n = STRING(s)->size; + for (syms = stab; syms->name; syms++) + if (n && strncmp (syms->name, p, n) == 0) break; + if (syms->name == 0) + Primitive_Error ("invalid argument: ~s", x); + mask |= syms->val; + if (!mflag) break; } return mask; } @@ -321,24 +321,24 @@ Object Bits_To_Symbols (unsigned long int x, int mflag, SYMDESCR *stab) { GC_Node2; if (mflag) { - GC_Link2 (list, tail); - for (list = tail = Null, syms = stab; syms->name; syms++) - if ((x & syms->val) && syms->val != ~0) { - Object z; + GC_Link2 (list, tail); + for (list = tail = Null, syms = stab; syms->name; syms++) + if ((x & syms->val) && syms->val != ~0) { + Object z; - z = Intern (syms->name); - cell = Cons (z, Null); - if (Nullp (list)) - list = cell; - else - P_Set_Cdr (tail, cell); - tail = cell; - } - GC_Unlink; - return list; + z = Intern (syms->name); + cell = Cons (z, Null); + if (Nullp (list)) + list = cell; + else + P_Set_Cdr (tail, cell); + tail = cell; + } + GC_Unlink; + return list; } for (syms = stab; syms->name; syms++) - if (syms->val == x) - return Intern (syms->name); + if (syms->val == x) + return Intern (syms->name); return Null; } diff --git a/src/terminate.c b/src/terminate.c index dd100e7..45055cd 100644 --- a/src/terminate.c +++ b/src/terminate.c @@ -45,7 +45,7 @@ void Init_Terminate () { * object can be marked as LEADER. */ void Register_Object (obj, group, term, leader_flag) Object obj; GENERIC group; - PFO term; { + PFO term; { WEAK_NODE *p; p = (WEAK_NODE *)Safe_Malloc (sizeof (*p)); @@ -62,12 +62,12 @@ void Deregister_Object (Object obj) { Disable_Interrupts; for (pp = &first; (p = *pp); ) { - if (WAS_FORWARDED(p->obj)) - UPDATE_OBJ(p->obj); - if (EQ(p->obj, obj)) { - *pp = p->next; - free ((char *)p); - } else pp = &p->next; + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + if (EQ(p->obj, obj)) { + *pp = p->next; + free ((char *)p); + } else pp = &p->next; } Enable_Interrupts; } @@ -84,22 +84,22 @@ Object Find_Object (int type, GENERIC group, MATCHFUN match, ...) { va_start (args, match); for (p = first; p; p = p->next) { - if (TYPE(p->obj) != type || p->group != group) - continue; - /* - * I believe updating the object is wrong here, as Find_Object() may - * be called from within GC (see Widget_Visit() in lib/xt/widget.c). - * If an object is updated here, it will no longer be regarded as - * alive in the call to Call_Terminators() later. - * - if (WAS_FORWARDED(p->obj)) - UPDATE_OBJ(p->obj); - */ - if (match (p->obj, args)) { - va_end (args); - REVIVE_OBJ(p->obj); - return p->obj; - } + if (TYPE(p->obj) != type || p->group != group) + continue; + /* + * I believe updating the object is wrong here, as Find_Object() may + * be called from within GC (see Widget_Visit() in lib/xt/widget.c). + * If an object is updated here, it will no longer be regarded as + * alive in the call to Call_Terminators() later. + * + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + */ + if (match (p->obj, args)) { + va_end (args); + REVIVE_OBJ(p->obj); + return p->obj; + } } va_end (args); return Null; @@ -122,20 +122,20 @@ void Terminate_Group (GENERIC group) { Disable_Interrupts; for (pp = &first; (p = *pp); ) { - if (p->group == group && !(p->flags & WK_LEADER)) { - if (WAS_FORWARDED(p->obj)) - UPDATE_OBJ(p->obj); - *pp = p->next; /* move object to temporary list */ - p->next = q; - q = p; - } else pp = &p->next; + if (p->group == group && !(p->flags & WK_LEADER)) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + *pp = p->next; /* move object to temporary list */ + p->next = q; + q = p; + } else pp = &p->next; } while (q) { /* scan temporary list, call terminators and free objects */ - WEAK_NODE *tmp = q; - if (q->term) - (void)q->term (q->obj); - q = q->next; - free ((char *)tmp); + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); } Enable_Interrupts; } @@ -147,20 +147,20 @@ void Terminate_Type (int type) { Disable_Interrupts; for (pp = &first; (p = *pp); ) { - if (TYPE(p->obj) == type) { - if (WAS_FORWARDED(p->obj)) - UPDATE_OBJ(p->obj); - *pp = p->next; /* move object to temporary list */ - p->next = q; - q = p; - } else pp = &p->next; + if (TYPE(p->obj) == type) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + *pp = p->next; /* move object to temporary list */ + p->next = q; + q = p; + } else pp = &p->next; } while (q) { /* scan temporary list, call terminators and free objects */ - WEAK_NODE *tmp = q; - if (q->term) - (void)q->term (q->obj); - q = q->next; - free ((char *)tmp); + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); } Enable_Interrupts; } @@ -172,33 +172,33 @@ void Call_Terminators () { Disable_Interrupts; for (pp = &first; (p = *pp); ) { - if (IS_ALIVE(p->obj)) { - if (WAS_FORWARDED(p->obj)) - UPDATE_OBJ(p->obj); - pp = &p->next; - } else { - *pp = p->next; - if (p->flags & WK_LEADER) { - *qq = p; /* move leader to end of temporary list */ - qq = &p->next; - *qq = 0; - } else { - p->next = q; /* move non-leader to front of list */ - if (qq == &q) qq = &p->next; - q = p; - } - } + if (IS_ALIVE(p->obj)) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + pp = &p->next; + } else { + *pp = p->next; + if (p->flags & WK_LEADER) { + *qq = p; /* move leader to end of temporary list */ + qq = &p->next; + *qq = 0; + } else { + p->next = q; /* move non-leader to front of list */ + if (qq == &q) qq = &p->next; + q = p; + } + } } /* Scan the temporary list, call terminators and free objects. * As leaders have been appended to the list, they are now * scanned after all non-leaders have been taken care of. */ while (q) { - WEAK_NODE *tmp = q; - if (q->term) - (void)q->term (q->obj); - q = q->next; - free ((char *)tmp); + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); } Enable_Interrupts; } diff --git a/src/type.c b/src/type.c index ae948c1..213f1cb 100644 --- a/src/type.c +++ b/src/type.c @@ -58,9 +58,9 @@ void Wrong_Type_Combination (Object x, register char const *name) { char buf[100]; if (t < 0 || t >= Num_Types) - Panic ("bad type1"); + Panic ("bad type1"); sprintf (buf, "wrong argument type %s (expected %s)", - Types[t].name, name); + Types[t].name, name); Primitive_Error (buf); } @@ -68,22 +68,22 @@ Object P_Type (Object x) { register int t = TYPE(x); if (t < 0 || t >= Num_Types) - Panic ("bad type2"); + Panic ("bad type2"); return Intern (Types[t].name); } int Define_Type (register int t, char const *name, - int (*size)(), int const_size, int (*eqv)(), int (*equal)(), - int (*print)(), int (*visit)()) { + int (*size)(), int const_size, int (*eqv)(), int (*equal)(), + int (*print)(), int (*visit)()) { register TYPEDESCR *p; Set_Error_Tag ("define-type"); if (t != 0) - Fatal_Error("first arg of Define_Type() must be 0"); + Fatal_Error("first arg of Define_Type() must be 0"); if (Num_Types == Max_Type) { - Max_Type += TYPE_GROW; - Types = (TYPEDESCR *)Safe_Realloc((char *)Types, - Max_Type * sizeof(TYPEDESCR)); + Max_Type += TYPE_GROW; + Types = (TYPEDESCR *)Safe_Realloc((char *)Types, + Max_Type * sizeof(TYPEDESCR)); } Disable_Interrupts; p = &Types[Num_Types++]; @@ -109,7 +109,7 @@ void Init_Type() { Types = (TYPEDESCR *)Safe_Malloc(bytes); memset(Types, 0, bytes); for (i = 0; (p = builtin_types[i]); i++) { - Types[i].haspointer = *p != '0'; - Types[i].name = ++p; + Types[i].haspointer = *p != '0'; + Types[i].name = ++p; } } diff --git a/src/vector.c b/src/vector.c index c885404..2bd5745 100644 --- a/src/vector.c +++ b/src/vector.c @@ -41,11 +41,11 @@ Object General_Make_Vector (int len, Object fill, int konst) { GC_Link (fill); vec = Alloc_Object ((len-1) * sizeof (Object) + sizeof (struct S_Vector), - T_Vector, konst); + T_Vector, konst); VECTOR(vec)->tag = Null; VECTOR(vec)->size = len; for (op = VECTOR(vec)->data; len--; op++) - *op = fill; + *op = fill; GC_Unlink; return vec; } @@ -62,7 +62,7 @@ Object P_Make_Vector (int argc, Object *argv) { register int len; if ((len = Get_Exact_Integer (argv[0])) < 0) - Range_Error (argv[0]); + Range_Error (argv[0]); return Make_Vector (len, argc == 1 ? Null : argv[1]); } @@ -72,7 +72,7 @@ Object P_Vector (int argc, Object *argv) { vec = Make_Vector (argc, Null); for (i = 0; i < argc; i++) - VECTOR(vec)->data[i] = *argv++; + VECTOR(vec)->data[i] = *argv++; return vec; } @@ -113,11 +113,11 @@ Object P_Vector_To_List (Object vec) { list = tail = Null; GC_Link3 (vec, list, tail); for (i = 0; i < VECTOR(vec)->size; i++, tail = cell) { - cell = Cons (VECTOR(vec)->data[i], Null); - if (Nullp (list)) - list = cell; - else - (void)P_Set_Cdr (tail, cell); + cell = Cons (VECTOR(vec)->data[i], Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); } GC_Unlink; return list; @@ -131,11 +131,11 @@ Object List_To_Vector (Object list, int konst) { GC_Link (list); len = P_Length (list); if (konst) - vec = Make_Const_Vector (FIXNUM(len), Null); + vec = Make_Const_Vector (FIXNUM(len), Null); else - vec = Make_Vector (FIXNUM(len), Null); + vec = Make_Vector (FIXNUM(len), Null); for (i = 0; i < FIXNUM(len); i++, list = Cdr (list)) - VECTOR(vec)->data[i] = Car (list); + VECTOR(vec)->data[i] = Car (list); GC_Unlink; return vec; } @@ -150,7 +150,7 @@ Object P_Vector_Fill (Object vec, Object fill) { Check_Type (vec, T_Vector); Check_Mutable (vec); for (i = 0; i < VECTOR(vec)->size; i++) - VECTOR(vec)->data[i] = fill; + VECTOR(vec)->data[i] = fill; return vec; } @@ -162,7 +162,7 @@ Object P_Vector_Copy (Object vec) { GC_Link (vec); new = Make_Vector (VECTOR(vec)->size, Null); memcpy (POINTER(new), POINTER(vec), - (VECTOR(vec)->size-1) * sizeof (Object) + sizeof (struct S_Vector)); + (VECTOR(vec)->size-1) * sizeof (Object) + sizeof (struct S_Vector)); GC_Unlink; return new; }