1 /*
2 * Part of Scheme 48 1.9. See file COPYING for notices and license.
3 *
4 * Authors: Richard Kelsey, Jonathan Rees, Mike Sperber, Marcus Crestani,
5 * David Frese, Timo Harter
6 */
7
8 #include <errno.h>
9 #include "io.h"
10 #include "scheme48arch.h"
11
12 #ifdef __GNUC__
13 // This requires the "labels as values" extension of GCC
14 #define USE_DIRECT_THREADING
15 #endif
16
17 #if SIZEOF_VOID_P == 4
18 #define BITS_PER_CELL 32
19 #elif SIZEOF_VOID_P == 8
20 #define BITS_PER_CELL 64
21 #else
22 #error "What size are your pointers, really?"
23 #endif
24
25 #define PS_READ_CHAR(PORT,RESULT,EOFP,STATUS) \
26 { \
27 FILE * TTport = PORT; \
28 int TTchar; \
29 if (EOF == (TTchar = getc(TTport))) \
30 RESULT = ps_read_char(TTport, &EOFP, &STATUS, 0==1);\
31 else { \
32 RESULT = TTchar; \
33 EOFP = 0; \
34 STATUS = 0; } \
35 }
36
37 #define PS_PEEK_CHAR(PORT,RESULT,EOFP,STATUS) \
38 { \
39 FILE * TTport = PORT; \
40 int TTchar; \
41 if (EOF == (TTchar = getc(TTport))) \
42 RESULT = ps_read_char(TTport, &EOFP, &STATUS, 0==0);\
43 else { \
44 RESULT = TTchar; \
45 ungetc(RESULT, TTport); \
46 EOFP = 0; \
47 STATUS = 0; } \
48 }
49
50 #define PS_READ_INTEGER(PORT,RESULT,EOFP,STATUS) \
51 RESULT = ps_read_integer(PORT,&EOFP,&STATUS);
52
53 #define PS_WRITE_CHAR(CHAR,PORT,STATUS) \
54 { \
55 FILE * TTport = PORT; \
56 char TTchar = CHAR; \
57 if (EOF == putc(TTchar,TTport)) \
58 STATUS = ps_write_char(TTchar,TTport); \
59 else { \
60 STATUS = 0; } \
61 }
62
63
64 /*
65 * C shifts may not work if the amount is greater than the machine word size.
66 * Also, undefined for negative values.
67 */
68
69 #define PS_SHIFT_LEFT_INLINE(X, Y) ((X)*(1L<<(Y)))
70
71 static long
PS_SHIFT_RIGHT_INLINE(long x,long y)72 PS_SHIFT_RIGHT_INLINE(long x, long y) {
73 if (x < 0 && y > 0)
74 return x >> y | ~(~0LU >> y);
75 else
76 return x >> y;
77 }
78
79 #define PS_SHIFT_RIGHT(X,Y,RESULT) \
80 { \
81 long TTx = X, TTy = Y; \
82 if ((TTx < 0) && (TTy > 0)) \
83 RESULT = (unsigned long)TTx >> TTy | ~(~0LU >> TTy); \
84 else \
85 RESULT = TTx >> TTy; \
86 }
87
88 #define PS_SHIFT_LEFT(X,Y,RESULT) \
89 { \
90 RESULT = ((X)*(1L<<(Y))); \
91 }
92
93 #define PS_SHIFT_RIGHT_LOGICAL(X,Y,RESULT) \
94 { \
95 RESULT = ((unsigned long) X) >> Y; \
96 }
97
98 #define PS_SHIFT_RIGHT_LOGICAL_INLINE(X,Y) ((long)(unsigned long)(((unsigned long) (X)) >> (Y)))
99
100 extern double ps_pos_infinity(void), ps_neg_infinity(void), ps_not_a_number(void);
101 #define PS_POS_INF ps_pos_infinity()
102 #define PS_NEG_INF ps_neg_infinity()
103 #define PS_NAN ps_not_a_number()
104
105 extern long s48_return_value, s48_run_machine();
106
107