feat: 9.5.9
This commit is contained in:
tmtt
parent
cb1753732b
commit
35f43a7909
1084 changed files with 558985 additions and 0 deletions
247
c/itest.c
Normal file
247
c/itest.c
Normal file
|
|
@ -0,0 +1,247 @@
|
|||
/* itest.c
|
||||
* Copyright 1984-2017 Cisco Systems, Inc.
|
||||
*
|
||||
* Licensed under the Apache License, Version 2.0 (the "License");
|
||||
* you may not use this file except in compliance with the License.
|
||||
* You may obtain a copy of the License at
|
||||
*
|
||||
* http://www.apache.org/licenses/LICENSE-2.0
|
||||
*
|
||||
* Unless required by applicable law or agreed to in writing, software
|
||||
* distributed under the License is distributed on an "AS IS" BASIS,
|
||||
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
* See the License for the specific language governing permissions and
|
||||
* limitations under the License.
|
||||
*/
|
||||
|
||||
#define r_EOF 0
|
||||
#define r_LPAREN 1
|
||||
#define r_RPAREN 2
|
||||
#define r_CONST 3
|
||||
|
||||
static INT digit_value(ICHAR c, INT r) {
|
||||
switch (r) {
|
||||
case 2:
|
||||
if ('0' <= c && c <= '1') return c - '0';
|
||||
break;
|
||||
case 8:
|
||||
if ('0' <= c && c <= '8') return c - '0';
|
||||
break;
|
||||
case 10:
|
||||
if ('0' <= c && c <= '9') return c - '0';
|
||||
break;
|
||||
case 16:
|
||||
if ('0' <= c && c <= '9') return c - '0';
|
||||
if ('a' <= c && c <= 'f') return c - 'a';
|
||||
if ('A' <= c && c <= 'F') return c - 'A';
|
||||
default:
|
||||
break;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static INT read_int(ptr *v, ptr n, INT r, IBOOL sign) {
|
||||
INT i, c;
|
||||
|
||||
for (;;) {
|
||||
if ((i = digit_value((c = getchar()), r)) == -1) {
|
||||
ungetc(c, stdin);
|
||||
break;
|
||||
}
|
||||
n = S_add(S_mul(n, FIX(r)), FIX(i));
|
||||
}
|
||||
*v = sign ? S_sub(FIX(0), n) : n;
|
||||
return r_CONST;
|
||||
}
|
||||
|
||||
static INT read_token(ptr *v) {
|
||||
ICHAR c = getchar();
|
||||
switch (c) {
|
||||
case SEOF: return r_EOF;
|
||||
case '\n':
|
||||
case ' ': return read_token(v);
|
||||
case ';':
|
||||
for (;;) {
|
||||
switch (getchar()) {
|
||||
case SEOF:
|
||||
return r_EOF;
|
||||
case '\n':
|
||||
return read_token(v);
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
case '(': return r_LPAREN;
|
||||
case ')': return r_RPAREN;
|
||||
case '#': {
|
||||
ICHAR c = getchar();
|
||||
INT r = 10;
|
||||
switch (c) {
|
||||
case 'x':
|
||||
r = 16;
|
||||
case 'o':
|
||||
if (r == 0) r = 8;
|
||||
case 'b':
|
||||
if (r == 10) r = 2;
|
||||
case 'd': {
|
||||
INT i;
|
||||
IBOOL sign = 0;
|
||||
c = getchar();
|
||||
if (c == '+')
|
||||
c = getchar();
|
||||
else if (c == '-') {
|
||||
sign = 1;
|
||||
c = getchar();
|
||||
}
|
||||
|
||||
if ((i = digit_value(c, r)) != -1)
|
||||
return read_int(v, FIX(i), r, sign);
|
||||
}
|
||||
default:
|
||||
printf("malformed hash prefix ignored\n");
|
||||
return read_token(v);
|
||||
}
|
||||
}
|
||||
case '+':
|
||||
case '-': {
|
||||
INT i, c2;
|
||||
if ((i = digit_value((c2 = getchar()), 10)) == -1) {
|
||||
ungetc(c2, stdin);
|
||||
} else {
|
||||
return read_int(v, FIX(i), 10, c == '-');
|
||||
}
|
||||
}
|
||||
case '*':
|
||||
case '/':
|
||||
case 'q':
|
||||
case 'r':
|
||||
case 'g':
|
||||
case '=':
|
||||
case '<':
|
||||
case 'f':
|
||||
case 'c':
|
||||
case 'd':
|
||||
*v = Schar(c);
|
||||
return r_CONST;
|
||||
default: {
|
||||
INT i;
|
||||
if ((i = digit_value(c, 10)) != -1)
|
||||
return read_int(v, FIX(i), 10, 0);
|
||||
}
|
||||
break;
|
||||
}
|
||||
printf("invalid character %d ignored\n", c);
|
||||
return read_token(v);
|
||||
}
|
||||
|
||||
static ptr readx(INT t, ptr v);
|
||||
|
||||
static ptr read_list(void) {
|
||||
INT t; ptr v, x;
|
||||
|
||||
t = read_token(&v);
|
||||
if (t == r_RPAREN) return Snil;
|
||||
x = readx(t, v);
|
||||
return Scons(x, read_list());
|
||||
}
|
||||
|
||||
static ptr readx(INT t, ptr v) {
|
||||
|
||||
switch (t) {
|
||||
case r_EOF:
|
||||
printf("unexpected EOF\n");
|
||||
exit(1);
|
||||
case r_LPAREN: return read_list();
|
||||
case r_RPAREN:
|
||||
printf("unexpected right paren ignored\n");
|
||||
t = read_token(&v);
|
||||
return readx(t, v);
|
||||
case r_CONST: return v;
|
||||
default:
|
||||
printf("invalid token %d\n", t);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
static ptr read_top(void) {
|
||||
INT t; ptr v;
|
||||
|
||||
t = read_token(&v);
|
||||
switch (t) {
|
||||
case r_EOF: return Seof_object;
|
||||
case r_RPAREN: return read_top();
|
||||
default: return readx(t, v);
|
||||
}
|
||||
}
|
||||
|
||||
static ptr eval(ptr x);
|
||||
|
||||
#define First(x) eval(Scar(Scdr(x)))
|
||||
#define Second(x) eval(Scar(Scdr(Scdr(x))))
|
||||
|
||||
static ptr eval(ptr x) {
|
||||
if (Spairp(x)) {
|
||||
switch (Schar_value(Scar(x))) {
|
||||
case '+': return S_add(First(x), Second(x));
|
||||
case '-': return S_sub(First(x), Second(x));
|
||||
case '*': return S_mul(First(x), Second(x));
|
||||
case '/': return S_div(First(x), Second(x));
|
||||
case 'q': return S_trunc(First(x), Second(x));
|
||||
case 'r': return S_rem(First(x), Second(x));
|
||||
case 'g': return S_gcd(First(x), Second(x));
|
||||
case '=': {
|
||||
ptr x1 = First(x), x2 = Second(x);
|
||||
if (Sfixnump(x1) && Sfixnump(x2))
|
||||
return Sboolean(x1 == x2);
|
||||
else if (Sbignump(x1) && Sbignump(x2))
|
||||
return Sboolean(S_big_eq(x1, x2));
|
||||
else return Sfalse;
|
||||
}
|
||||
case '<': {
|
||||
ptr x1 = First(x), x2 = Second(x);
|
||||
if (Sfixnump(x1))
|
||||
if (Sfixnump(x2))
|
||||
return Sboolean(x1 < x2);
|
||||
else
|
||||
return Sboolean(!BIGSIGN(x2));
|
||||
else
|
||||
if (Sfixnump(x2))
|
||||
return Sboolean(BIGSIGN(x1));
|
||||
else
|
||||
return Sboolean(S_big_lt(x1, x2));
|
||||
}
|
||||
case 'f': return Sflonum(S_floatify(First(x)));
|
||||
case 'c':
|
||||
S_gc(get_thread_context(), UNFIX(First(x)),UNFIX(Second(x)));
|
||||
return Svoid;
|
||||
case 'd': return S_decode_float(Sflonum_value(First(x)));
|
||||
default:
|
||||
S_prin1(x);
|
||||
putchar('\n');
|
||||
printf("unrecognized operator, returning zero\n");
|
||||
return FIX(0);
|
||||
}
|
||||
} else
|
||||
return x;
|
||||
}
|
||||
|
||||
#undef PROMPT
|
||||
#undef NOISY
|
||||
static void bignum_test(void) {
|
||||
ptr x;
|
||||
for (;;) {
|
||||
#ifdef PROMPT
|
||||
putchar('*');
|
||||
putchar(' ');
|
||||
#endif
|
||||
x = read_top();
|
||||
if (x == Seof_object) { putchar('\n'); exit(0); }
|
||||
#ifdef NOISY
|
||||
S_prin1(x);
|
||||
putchar('\n');
|
||||
#endif
|
||||
x = eval(x);
|
||||
S_prin1(x);
|
||||
putchar('\n');
|
||||
}
|
||||
}
|
||||
Reference in a new issue