~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to h/notcomp.h

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
ImportĀ upstreamĀ versionĀ 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
2
#define CHAR_CODE_LIMIT 256     
 
3
#define READ_TABLE_SIZE CHAR_CODE_LIMIT
 
4
#define ARRAY_RANK_LIMIT 63
 
5
 
 
6
void enter_mark_origin() ;
 
7
 
 
8
EXTER int *cs_org;     
 
9
EXTER int GBC_enable;
 
10
 
 
11
#define CHAR_SIZE 8
 
12
EXTER object sSAnotify_gbcA;
 
13
 
 
14
/* symbols which are not needed in compiled lisp code */
 
15
EXTER int interrupt_flag,initflag,interrupt_enable;
 
16
void install_default_signals();
 
17
void sigint(),sigalrm();
 
18
void segmentation_catcher();
 
19
 
 
20
 
 
21
EXTER int gc_enabled, saving_system;
 
22
 
 
23
EXTER object lisp_package,user_package;
 
24
EXTER char *core_end;
 
25
EXTER int catch_fatal;
 
26
EXTER int real_maxpage;
 
27
char *getenv();
 
28
EXTER char *this_lisp;
 
29
 
 
30
#ifndef IN_MAIN
 
31
EXTER
 
32
char stdin_buf[], stdout_buf[];
 
33
#endif
 
34
 
 
35
EXTER object user_package;
 
36
 
 
37
#define TRUE 1
 
38
#define FALSE 0
 
39
 
 
40
 
 
41
 
 
42
#define GET_OPT_ARG(min,max) \
 
43
  va_list ap; \
 
44
  object  opt_arg[max - min]; object *__p= opt_arg ;\
 
45
  int _i=min, _nargs = VFUN_NARGS ; \
 
46
  va_start(ap); \
 
47
  if (_nargs < min || (_nargs > max)) FEerror("wrong number of args"); \
 
48
  while(_i++ <= max) { if (_i > _nargs) *__p++ = Cnil; \
 
49
                         else *__p++ = va_arg(ap,object);} \
 
50
  va_end(ap)
 
51
 
 
52
#undef endp
 
53
 
 
54
#define endp(obje)      ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \
 
55
                         FALSE : endp_temp == Cnil ? TRUE : \
 
56
                         endp1(endp_temp))
 
57
 
 
58
#ifndef NO_DEFUN
 
59
#undef DEFUN
 
60
#define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname
 
61
/* eg.
 
62
   A function taking from 2 to 8 args
 
63
   returning object the first args is object, the next 6 int, and last defaults to object.
 
64
   note the return type must also be put in the signature.
 
65
  DEFUN("AREF",object,fSaref,SI,2,8,NONE,oo,ii,ii,ii)
 
66
*/
 
67
 
 
68
/* for defining old style */
 
69
#define DEFUNO(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,old,doc) \
 
70
  ret fname (); \
 
71
old() \
 
72
{   Iinvoke_c_function_from_value_stack(fname,F_ARGD(min,max,flags,ARGTYPES(ret0a0,a12,a34,a56))); \
 
73
    return;} \
 
74
  ret fname
 
75
 
 
76
  /* these will come later */
 
77
#define DEFUNL DEFUN
 
78
  /* these are needed to be linked in to be called by incrementally
 
79
   loaded code */
 
80
#define DEFCOMP(type,fun) type fun
 
81
 
 
82
#define  DEFVAR(name,cname,pack,val,doc) object cname
 
83
#define  DEFCONST(name,cname,pack,val,doc) object cname
 
84
#define  DEF_ORDINARY(name,cname,pack,doc) object cname  
 
85
#define DO_INIT(x)   
 
86
#endif /* NO_DEFUN */
 
87
 
 
88
 
 
89
object  type_name();
 
90
object fSincorret_type();
 
91
 
 
92
 
 
93
#define TYPE_OF(x) type_of(x)
 
94
 
 
95
 
 
96
/* For a faster way of checking if t0 is in several types,
 
97
   is t0 a member of types t1 t2 t3 
 
98
TS_MEMBER(t0,TS(t1)|TS(t2)|TS(t3)...)
 
99
*/
 
100
#define TS(s) (1<<s)
 
101
#define TS_MEMBER(t1,ts) ((TS(t1)) & (ts))
 
102
 
 
103
#define ASSURE_TYPE(val,t) if(type_of(val)!=t) val= Icheck_one_type(val,t)
 
104
 
 
105
object IisArray();
 
106
 
 
107
void Wrong_type_error();
 
108
 
 
109
/* array to which X is has its body displaced */
 
110
#define DISPLACED_TO(x) Mcar(x->a.a_displaced)
 
111
 
 
112
/* List of arrays whose bodies are displaced to X */
 
113
 
 
114
#define DISPLACED_FROM(x) Mcdr(x->a.a_displaced)
 
115
 
 
116
#define FIX_CHECK(x) (Mfix(Iis_fixnum(x)))
 
117
 
 
118
#define INITIAL_TOKEN_LENGTH 512
 
119
 
 
120
/* externals not needed by cmp */
 
121
/* print.d */
 
122
EXTER bool PRINTpackage;
 
123
EXTER bool PRINTstructure;
 
124
 
 
125
/* from format.c */
 
126
EXTER VOL object fmt_stream;
 
127
EXTER VOL int ctl_origin;
 
128
EXTER VOL int ctl_index;
 
129
EXTER VOL int ctl_end;
 
130
EXTER  object * VOL fmt_base;
 
131
EXTER VOL int fmt_index;
 
132
EXTER VOL int fmt_end;
 
133
typedef jmp_buf *jmp_bufp;
 
134
EXTER jmp_bufp VOL fmt_jmp_bufp;
 
135
EXTER VOL int fmt_indents;
 
136
EXTER VOL object fmt_string;
 
137
EXTER object endp_temp;
 
138
 
 
139
/* eval */
 
140
EXTER int eval1 ;
 
141
/* list.d */
 
142
EXTER bool in_list_flag;
 
143
EXTER object test_function;
 
144
EXTER object item_compared;
 
145
bool (*tf)();
 
146
EXTER object key_function;
 
147
object (*kf)();
 
148
object (*car_or_cdr)();
 
149
 
 
150
 
 
151
/* string.d */
 
152
EXTER  bool left_trim;
 
153
EXTER bool right_trim;
 
154
int  (*casefun)();
 
155
 
 
156
#define Q_SIZE          128
 
157
#define IS_SIZE         256
 
158
 
 
159
struct printStruct {
 
160
 short p_queue[Q_SIZE];
 
161
 short p_indent_stack[IS_SIZE];
 
162
 int p_qh;
 
163
 int p_qt;
 
164
 int p_qc;
 
165
 int p_isp;
 
166
 int p_iisp;};
 
167
 
 
168
EXTER struct printStruct *printStructBufp;
 
169
 
 
170
#define SETUP_PRINT_DEFAULT(x) \
 
171
  struct printStruct printStructBuf; \
 
172
  struct printStruct * old_printStructBufp = printStructBufp; \
 
173
  printStructBufp = &printStructBuf; \
 
174
   setupPRINTdefault(x)
 
175
 
 
176
#define CLEANUP_PRINT_DEFAULT \
 
177
  cleanupPRINT(); \
 
178
  printStructBufp = old_printStructBufp
 
179
 
 
180
 
 
181
/* on most machines this will test in one instruction
 
182
   if the pointer is on the C stack or the 0 pointer
 
183
   but if the CSTACK_ADDRESS is not negative then we can't use this cheap
 
184
   test..
 
185
*/
 
186
#ifndef NULL_OR_ON_C_STACK
 
187
 
 
188
 
 
189
#if (CSTACK_ADDRESS > 0)
 
190
#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))
 
191
#else
 
192
#define NULL_OR_ON_C_STACK(x) ((int)x <= 0)     
 
193
#endif
 
194
 
 
195
#endif /* NULL_OR_ON_C_STACK */
 
196
 
 
197
/* more readable name */
 
198
#define siScomma sSY
 
199
EXTER object sSY;
 
200
 
 
201
#define inheap(pp)      ((char *)(pp) < heap_end)
 
202
 
 
203
char *lisp_copy_to_null_terminated();
 
204
 
 
205