-
Notifications
You must be signed in to change notification settings - Fork 2
/
jtype.h
346 lines (286 loc) · 18.3 KB
/
jtype.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
/* License in license.txt. */
/* */
/* Type Definitions */
#define U unsigned
#if (SYS & SYS_UNIX)
#define _stdcall
#endif
#if SY_64
typedef long long A1;
typedef unsigned long long BT;
typedef long long I;
typedef long long SB;
typedef unsigned long long UI;
#else
typedef long A1;
typedef unsigned long BT;
typedef long I;
typedef long SB;
typedef unsigned long UI;
#endif
typedef char B;
typedef char C;
typedef char* Ptr;
typedef short S;
typedef short C2;
typedef unsigned char UC;
typedef unsigned short US;
typedef unsigned short U2;
typedef unsigned int UINT;
typedef int I4;
typedef double D;
typedef FILE* F;
typedef long double LD;
typedef struct {I k,flag,m,t,c,n,r,s[1];}* A;
typedef struct {A a,t;}TA;
typedef A (*AF)();
typedef UI (*UF)();
typedef void (*VF)();
typedef int (*CMP)(); /* comparison function in sort */
typedef A X;
typedef struct {X n,d;} Q;
typedef struct {D re,im;} Z;
typedef union {D d;UINT i[2];} DI;
#if (SYS & SYS_PC+SYS_MACINTOSH) /* for use by the session manager */
typedef S SI;
#else
typedef I SI;
#endif
/* Fields of type A */
#define AK(x) ((x)->k) /* offset of ravel wrt x */
#define AFLAG(x) ((x)->flag) /* flag */
#define AM(x) ((x)->m) /* Max # bytes in ravel */
#define AT(x) ((x)->t) /* Type; one of the #define below */
#define AC(x) ((x)->c) /* Reference count. */
#define AN(x) ((x)->n) /* # elements in ravel */
#define AR(x) ((x)->r) /* Rank */
#define AH 7L /* # non-shape header words in A */
#define AS(x) ((x)->s) /* Pointer to shape */
#if SY_64
#define AKX(x) (SZI*(AH+AR(x)))
#define WP(t,n,r) (AH+ r +(1&&t&LAST0)+((t&NAME?sizeof(NM):0)+(n)*bp(t)+SZI-1)/SZI)
#else
#define AKX(x) (SZI*(AH+AR(x)+!(1&AR(x))))
#define WP(t,n,r) (AH+(r+!(1&r))+(1&&t&LAST0)+((t&NAME?sizeof(NM):0)+(n)*bp(t)+SZI-1)/SZI)
#endif
/* make sure array values are double-word aligned */
#define AV(x) ( (I*)((C*)(x)+AK(x))) /* pointer to ravel */
#define BAV(x) ( (C*)(x)+AK(x) ) /* boolean */
#define CAV(x) ( (C*)(x)+AK(x) ) /* character */
#define USAV(x) ((US*)((C*)(x)+AK(x))) /* wchar */
#define UAV(x) ( (UC*)(x)+AK(x) ) /* unsigned character */
#define NAV(x) ((NM*)((C*)(x)+AK(x))) /* name */
#define IAV(x) AV(x) /* integer */
#define DAV(x) ( (D*)((C*)(x)+AK(x))) /* double */
#define ZAV(x) ( (Z*)((C*)(x)+AK(x))) /* complex */
#define XAV(x) ( (X*)((C*)(x)+AK(x))) /* extended */
#define QAV(x) ( (Q*)((C*)(x)+AK(x))) /* rational */
#define AAV(x) ( (A*)((C*)(x)+AK(x))) /* boxed */
#define A1AV(x) ((A1*)((C*)(x)+AK(x))) /* boxed relative address */
#define VAV(x) ( (V*)((C*)(x)+AK(x))) /* verb, adverb, conj */
#define PAV(x) ( (P*)((C*)(x)+AK(x))) /* sparse */
#define SBAV(x) ((SB*)((C*)(x)+AK(x))) /* symbol */
/* Types for AT(x) field of type A */
/* Note: BOOL name conflict with ???; SCHAR name conflict with sqltypes.h */
#define B01 (I)1L /* B boolean */
#define LIT (I)2L /* C literal (character) */
#define INT (I)4L /* I integer */
#define FL (I)8L /* D double (IEEE floating point) */
#define CMPX (I)16L /* Z complex */
#define BOX (I)32L /* A boxed */
#define XNUM (I)64L /* X extended precision integer */
#define RAT (I)128L /* Q rational number */
#define BIT (I)256L /* BT bit boolean */
#define SB01 (I)1024L /* P sparse boolean */
#define SLIT (I)2048L /* P sparse literal (character) */
#define SINT (I)4096L /* P sparse integer */
#define SFL (I)8192L /* P sparse floating point */
#define SCMPX (I)16384L /* P sparse complex */
#define SBOX (I)32768L /* P sparse boxed */
#define SBT (I)65536L /* SB symbol */
#define C2T (I)131072L /* C2 unicode (2-byte characters) */
#define VERB (I)262144L /* V verb */
#define ADV (I)524288L /* V adverb */
#define CONJ (I)1048576L /* V conjunction */
#define ASGN (I)2097152L /* I assignment */
#define MARK (I)4194304L /* I end-of-stack marker */
#define SYMB (I)8388608L /* I locale (symbol table) */
#define CONW (I)16777216L /* CW control word */
#define NAME (I)33554432L /* NM name */
#define LPAR (I)67108864L /* I left parenthesis */
#define RPAR (I)134217728L /* I right parenthesis */
#define XD (I)268435456L /* DX extended floating point */
#define XZ (I)536870912L /* ZX extended complex */
#define ANY -1L
#define SPARSE (SB01+SINT+SFL+SCMPX+SLIT+SBOX)
#define DENSE (NOUN&~SPARSE)
#define NUMERIC (B01+BIT+INT+FL+CMPX+XNUM+RAT+XD+XZ+SB01+SINT+SFL+SCMPX)
#define DIRECT (LIT+C2T+B01+BIT+INT+FL+CMPX+SBT)
#define JCHAR (LIT+C2T+SLIT)
#define NOUN (NUMERIC+JCHAR+BOX+SBOX+SBT)
#define FUNC (VERB+ADV+CONJ)
#define RHS (NOUN+FUNC)
#define IS1BYTE (B01+LIT)
#define LAST0 (B01+LIT+C2T+NAME)
#define HOMO(s,t) ((s)==(t) || (s)&NUMERIC&&(t)&NUMERIC || (s)&JCHAR&&(t)&JCHAR)
#define STYPE(t) ((t)& B01?SB01:(t)& INT?SINT:(t)& FL?SFL:(t)& CMPX?SCMPX:(t)&LIT?SLIT:(t)& BOX?SBOX:0L)
#define DTYPE(t) ((t)&SB01? B01:(t)&SINT? INT:(t)&SFL? FL:(t)&SCMPX? CMPX:(t)&SLIT?LIT:(t)&SBOX? BOX:0L)
/* Values for AFLAG(x) field of type A */
#define AFRO (I)1 /* read only; can't change data */
#define AFNJA (I)2 /* non-J alloc; i.e. mem mapped */
#define AFSMM (I)4 /* SMM managed */
#define AFREL (I)8 /* uses relative addressing */
#define AABS(rel,k) ((I)(rel)+(I)(k)) /* absolute address from relative address */
#define AREL(abs,k) ((I)(abs)-(I)(k)) /* relative address from absolute address */
#define ARELATIVE(w) (AT(w)&BOX&&AFLAG(w)&AFNJA+AFSMM+AFREL)
#define AADR(w,z) ((w)?(A)((I)(w)+(I)(z)):(z))
#define AVR(i) AADR(ad,av[i])
#define IVR(i) AADR(id,iv[i])
#define WVR(i) AADR(wd,wv[i])
#define YVR(i) AADR(yd,yv[i])
#define AAV0(w) (ARELATIVE(w)?(A)(*AV(w)+(I)(w)):*AAV(w))
#define RELOCATE(w,z) (ARELATIVE(w)?relocate((I)(w)-(I)(z),(z)):(z))
typedef struct {I i;US n,go,source;C type;} CW;
/* control word (always has corresponding token string) */
/* type - as specified in w.h */
/* go - line number to go to */
/* source - source line number */
/* i - beginning index of token string */
/* n - length of token string */
#define DCPARSE 1 /* sentence for parser */
#define DCSCRIPT 2 /* script -- line() */
#define DCCALL 3 /* verb/adv/conj call -- dbunquote() */
#define DCJUNK 4 /* stack entry is obsolete */
typedef struct DS{ /* 1 2 3 */
struct DS*dclnk; /* x x x link to next stack entry */
A dca; /* x fn/op name */
A dcf; /* x fn/op */
A dcx; /* x left argument */
A dcy; /* x x x tokens; text ; right argument */
A dcloc; /* x local symb table (0 if not explicit) */
A dcc; /* x control matrix (0 if not explicit) */
I dci; /* x x x index ; next index ; ptr to line # */
I dcj; /* x x ; prev index ; error # */
I dcn; /* x x ; line # ; ptr to symb entry */
I dcm; /* x x ; script index; # of non-locale part of name */
I dcstop; /* x the last stop in this function */
C dctype; /* x x x type of entry (see #define DC*) */
B dcsusp; /* x x 1 iff begins a debug suspension */
C dcss; /* x single step code */
} DST;
typedef DST* DC;
typedef struct {I e,p;X x;} DX;
/* for the p field in DX */
#define DXIPREC ((I)-1) /* infinite precision */
#define DXINF ((I)-2) /* _ infinity */
#define DXMINF ((I)-3) /* __ negative infinity */
/* extended floating point */
/* e - exponent */
/* p - precision & other codes */
/* +ve # of significant digits */
/* _1 infinite precision (with trailing 0s) */
/* _2 infinity _ */
/* _3 negative infinity __ */
/* x - mantissa */
/* least significant digit first */
/* decimal point after last digit */
typedef struct {A name,val;I flag,sn,next,prev;} L;
/* symbol pool entry LINFO entry */
/* name - name on LHS of assignment or locale name */
/* val - value or locale search path */
/* flag - various flags */
/* sn - script index */
/* next - index of successor in hash list or 0 */
/* prev - index of predecessor in hash list or address of hash entry */
#define LCH (I)1 /* changed since last exec of 4!:5 */
#define LHEAD (I)2 /* head pointer (no predecessor) */
#define LINFO (I)4 /* locale info */
typedef struct{A og,g;I ptr,flag;B sw0;} LS;
/* og: old value of global */
/* g: global at this level */
/* ptr: index in pv/nv if numbered locale */
/* pointer to stloc entry if named locale */
/* flag: 1 if named locale marked for destruction */
/* 2 if numbered locale marked for destruction */
/* sw0: old value of stswitched */
typedef struct{UI hash;I sn;L*e;UC m;C flag,s[1];} NM;
/* hash: hash for non-locale part of name */
/* m: length of non-locale part of name */
/* sn: symbol table number on last reference */
/* e: symbol pool entry on last reference */
/* s: points to string part of full name (1 to ?? characters) */
#define NMLOC 1 /* direct locale abc_lm_ */
#define NMILOC 2 /* indirect locale abc__de__fgh ... */
#define NMDOT 4 /* one of the names m. n. u. v. x. y. */
typedef struct {I a,e,i,x;} P;
/* value fields of sparse array types */
/* fields are offsets from beginning of the P struct */
/* a: sparse axes */
/* e: sparse element */
/* i: index matrix, columns correspond to a */
/* x: value cells corresponding to rows of i */
#define SPA(p,a) ((A)((p)->a+(C*)(p)))
#define SPB(p,a,x) {(p)->a=(C*)(x)-(C*)(p); RZ(p->a+(C*)(p));}
/* performance monitoring stuff */
typedef struct{
A name; /* verb/adverb/conjunction name */
A loc; /* locale name */
I lc; /* line number (-1 for entry; -2 for exit) */
I s; /* space */
I t[2]; /* time */
C val; /* valence: 1 or 2 */
C unused[3]; /* padding */
} PM;
#define PMCOL 6 /* # of fields in PM */
typedef struct{
I n; /* maximum number of records */
I i; /* index of next record to be written */
I s; /* initial bytesmax value */
B rec; /* what to record (0 entry & exit; 1 all) */
B trunc; /* what to do on overflow (0 wrap; 1 truncate) */
B wrapped; /* 1 iff wrapping has happened */
C unused[1]; /* padding */
} PM0;
/* each unique symbol has a row in jt->sbu */
/* a row is interpreted per SBU */
/* for best results make sizeof(SBU) a multiple of sizeof(I) */
typedef struct{
I i; /* index into sbs */
I n; /* length */
UI h; /* hash value */
I color; /* binary tree: color */
I parent; /* binary tree: index of parent */
I left; /* binary tree: index of left child */
I right; /* binary tree: index of right child */
I order; /* order number */
I down; /* predecessor in ordering */
I up; /* successor in ordering */
I flag; /* bit flags */
} SBU;
#define SBC2 1 /* 1 iff 2-byte character */
typedef struct {AF f1,f2;A f,g,h;I flag,mr,lr,rr,fdep;C id;} V;
#define ID(f) (f&&FUNC&AT(f)?VAV(f)->id:C0)
/* type V flag values */
/* < 256 see vcompsc.c */
#define VGERL (I)256 /* gerund left argument */
#define VGERR (I)512 /* gerund right argument */
#define VTAYFINITE (I)1024 /* t. finite polynomial */
#define VIRS1 (I)2048 /* monad has integral rank support */
#define VIRS2 (I)4096 /* dyad has integral rank support */
#define VFLR (I)8192 /* function is <.@g */
#define VCEIL (I)16384 /* function is >.@g */
#define VMOD (I)32768 /* function is m&|@g */
#define VLOCK (I)65536 /* function is locked */
#define VNAMED (I)131072 /* named explicit defn */
#define VFIX (I)262144 /* f. applied */
#define VXOPR (I)524288 /* : defn with u. and x. */
#define VXOP (I)1048576 /* : defn derived fn */
#define VXOPCALL (I)2097152 /* : defn derived fn call */
#define VTRY1 (I)4194304 /* monad contains try. */
#define VTRY2 (I)8388608 /* dyad contains try. */
#define VDDOP (I)16777216 /* derived from a derived operator */
typedef struct {DX re;DX im;} ZX;
/* extended complex */
/* re - real part */
/* im - imaginary part */