|
|
1.1 root 1: static char apl_h_Sccsid[] = "apl.h @(#)apl.h 1.5 2/16/84 Berkeley ";
2: /*
3: * UNIX APL\11
4: *
5: *
6: * UNIX APL was originally written by Ken Thompson at Bell Labs.
7: * It spent some time at Yale and finally arrived at Purdue
8: * University. Since 1976 it has been modified by Jim Besemer
9: * and John Bruner at the School of Electrical Engineering, Purdue,
10: * under the direction of Dr. Anthony P. Reeves. It is currently
11: * being developed and supported at Purdue/EE by J. Bruner and
12: * A. Reeves on both PDP-11's and VAX-11/780's
13: */
14:
15: #include <sys/param.h>
16: /*
17: * New file system param.h defines MIN and MAX; we
18: * have to undefine them to avoid conflicts
19: */
20: #ifdef MIN
21: # undef MIN
22: #endif MIN
23: #ifdef MAX
24: # undef MAX
25: #endif MAX
26:
27: #include <sys/stat.h>
28: #include <sys/dir.h>
29: #include <sys/time.h>
30: #include <setjmp.h>
31:
32: /*
33: * Configuration information
34: *
35: * The C preprocessor will automatically supply "vax" if APL is compiled
36: * on a VAX-11/780.
37: *
38: * Other configuration parameters which may be specified are:
39: *
40: * PURDUE_EE enable special Purdue/EE code
41: * VMUNIX enable code for Berkeley virtual UNIX stuff
42: * VFORK use vfork() when possible (implied by VMUNIX)
43: * VLIMIT use 4.1bsd vlimit() (implied by VMUNIX)
44: * NDIR 4.2bsd directory format (implied by VMUNIX)
45: * APL2 generate single-precision version
46: */
47:
48: #ifdef VMUNIX
49: #define VLIMIT
50: #define VFORK
51: #endif
52:
53: #define NFDS 20 /* Number of available fd's */
54: #define MAXEOT 8 /* # of input EOT's before panic */
55:
56: /*
57: * Temp file names
58: */
59:
60: #define WSFILE ws_file /* work space file */
61:
62: /*
63: * Magic Numbers
64: */
65:
66: #define MRANK 8
67: #define CANBS 300
68: #define STKS 500
69: #define NLS 200
70: #define NAMS 40
71: #define OBJS 500
72: #define MAXLAB 30
73:
74: #ifndef vax
75: #ifdef APL2
76: #define MAGIC 0101555 /* PDP-11 single-precision format */
77: #else
78: #define MAGIC 0101554 /* PDP-11 double-precision format */
79: #endif
80: #else
81: #ifdef APL2
82: #define MAGIC 0101557 /* VAX single-precision format */
83: #else
84: #define MAGIC 0101556 /* VAX double-precision format */
85: #endif
86: #endif
87:
88: #ifdef APL2
89: #define data float
90: #else
91: #define data double
92: #endif
93:
94: /*
95: * derived constants
96: */
97:
98: #define SDAT sizeof(data)
99: #define SINT sizeof(int)
100:
101: /*
102: * Interpreter Op Codes
103: */
104:
105: #define EOF (-1)
106: #define EOL 0
107:
108: #define ADD 1
109: #define PLUS 2
110: #define SUB 3
111: #define MINUS 4
112: #define MUL 5
113: #define SGN 6
114: #define DIV 7
115: #define RECIP 8
116: #define MOD 9
117: #define ABS 10
118: #define MIN 11
119: #define FLOOR 12
120: #define MAX 13
121: #define CEIL 14
122: #define PWR 15
123: #define EXP 16
124: #define LOG 17
125: #define LOGE 18
126: #define CIR 19
127: #define PI 20
128: #define COMB 21
129: #define FAC 22
130:
131: #define DEAL 23
132: #define RAND 24
133: #define DRHO 25
134: #define MRHO 26
135: #define DIOT 27
136: #define MIOT 28
137: #define ROT0 29
138: #define REV0 30
139: #define DTRN 31
140: #define MTRN 32
141: #define DIBM 33
142: #define MIBM 34
143:
144: #define GDU 35
145: #define GDUK 36
146: #define GDD 37
147: #define GDDK 38
148: #define EXD 39
149: #define SCAN 40
150: #define EXDK 41
151: #define SCANK 42
152: #define IPROD 43
153: #define OPROD 44
154: #define QUAD 45
155: #define QQUAD 46
156: #define BRAN0 47
157: #define BRAN 48
158: #define DDOM 49
159: #define MDOM 50
160:
161: #define COM 51
162: #define RED 52
163: #define COMK 53
164: #define REDK 54
165: #define ROT 55
166: #define REV 56
167: #define ROTK 57
168: #define REVK 58
169: #define CAT 59
170: #define RAV 60
171: #define CATK 61
172: #define RAVK 62
173:
174: #define PRINT 63
175: #define QUOT 64
176: #define ELID 65
177: #define CQUAD 66
178: #define COMNT 67
179: #define INDEX 68
180: #define HPRINT 69
181:
182: #define LT 71
183: #define LE 72
184: #define GT 73
185: #define GE 74
186: #define EQ 75
187: #define NE 76
188: #define AND 77
189: #define OR 78
190: #define NAND 79
191: #define NOR 80
192: #define NOT 81
193: #define EPS 82
194: #define MEPS 83
195: #define REP 84
196: #define TAKE 85
197: #define DROP 86
198: #define ASGN 88
199: #define IMMED 89
200:
201:
202: #define NAME 90
203: #define CONST 91
204: #define FUN 92
205: #define ARG1 93
206: #define ARG2 94
207: #define AUTO 95
208: #define REST 96
209:
210: #define COM0 97
211: #define RED0 98
212: #define EXD0 99
213: #define SCAN0 100
214: #define BASE 101
215: #define MENC 102 /* monadic encode */
216: #define LABEL 103 /* statement label */
217: #define PSI 104 /* PSI input character */
218: #define PSI1 105 /* PSI monadic half */
219: #define PSI2 106 /* PSI dyadic half */
220: #define ISP 107 /* ISP input code */
221: #define ISP1 108 /* ISP monadic half */
222: #define ISP2 109 /* ISP dyadic half */
223: #define QWID 110 /* quad fn1 */
224: #define QFUZZ 111
225: #define QRUN 112
226: #define QFORK 113
227: #define QWAIT 114
228: #define QEXEC 115
229: #define FDEF 116
230: #define QEXIT 117
231: #define QPIPE 118
232: #define QCHDIR 119
233: #define QOPEN 120
234: #define QCLOSE 121
235: #define QREAD 122
236: #define QWRITE 123
237: #define QCREAT 124
238: #define QSEEK 125
239: #define QUNLNK 126
240: #define QRD 127
241: #define QDUP 128
242: #define QAP 129
243: #define QKILL 130
244: #define QCRP 131
245: #define DFMT 132
246: #define MFMT 133
247: #define QNC 134
248: #define NILRET 135
249: #define XQUAD 136
250: #define SICLR 137
251: #define SICLR0 138
252: #define RVAL 139
253: #define QSIGNL 140
254: #define QFLOAT 141 /* Float character string to data */
255: #define QNL 142 /* Produce namelist */
256:
257: /*
258: * Immediate sub-op codes
259: */
260:
261: #define CLEAR 1
262: #define DIGITS 2
263: #define EDIT 3
264: #define ERASE 4
265: #define FNS 5
266: #define FUZZ 6
267: #define READ 7
268: #define ORIGIN 8
269: #define VARS 9
270: #define WIDTH 10
271: #define DEBUG 11
272: #define OFF 12
273: #define LOAD 13
274: #define SAVE 14
275: #define COPY 15
276: #define CONTIN 16
277: #define LIB 17
278: #define DROPC 18
279: #define VSAVE 19
280: #define SCRIPT 20
281: #define EDITF 21
282: #define TRACE 22
283: #define UNTRACE 23
284: #define WRITE 24
285: #define RESET 25
286: #define SICOM 26
287: #define CODE 27
288: #define DEL 28
289: #define SHELL 29
290: #define LIST 30
291: #define PRWS 31
292:
293: struct chrstrct
294: {
295: char c[2]; /* Can't be 0 anymore (VAX) */
296: };
297:
298: union uci
299: {
300: char cv[sizeof(int)]; /* character array */
301: unsigned i; /* unsigned integer value */
302: };
303:
304: data zero;
305: data one;
306: data pi;
307: data maxexp; /* the largest value such that exp(maxexp) is defined */
308: data datum;
309: data getdat();
310: int funtrace; /* function trace enabled */
311: int labgen; /* label processing being done */
312: int apl_term; /* flag set if apl terminal mapping req'd */
313: jmp_buf gbl_env; /* Used for setexit/reset */
314:
315: /*
316: * Several unrelated values, which appear
317: * together in the header of an apl workspace file.
318: */
319: struct
320: {
321: double fuzz;
322: int iorg;
323: int digits;
324: int width;
325: int rl; /* Random Seed (Ph.A. S.B.B.) */
326: } thread;
327:
328: /*
329: * Data types
330: * Each new type should be accomodated for
331: * in dealloc [a0.c]
332: */
333:
334: #define DA 1
335: #define CH 2
336: #define LV 3
337: #define QD 4
338: #define QQ 5
339: #define IN 6
340: #define EL 7
341: #define NF 8
342: #define MF 9
343: #define DF 10
344: #define QC 11
345: #define QV 12 /* quad variables */
346: #define DU 13 /* dummy -- causes fetch error except on print */
347: #define QX 14 /* latent expr. quad "Llx" */
348: #define LBL 15 /* locked label value */
349: #define NTYPES 16 /* number of defined types */
350:
351: /*
352: * This is a descriptor for apl data, allocated by "newdat".
353: * The actual data starts at item.dim[item.rank], and thus
354: * &item.dim[item.rank] should always == item.datap.
355: * See the comment in "newdat" (a0.c) about "dim".
356: *
357: * A null item is a vector(!), and is rank==1, size==0.
358: *
359: * the stack is the operand stack, and sp is the pointer to the
360: * top of the stack.
361: */
362:
363: struct item
364: {
365: char rank;
366: char type;
367: int size;
368: int index;
369: data *datap;
370: int dim[MRANK];
371: } *stack[STKS], **sp;
372:
373: /*
374: * variable/fn (and file name) descriptor block.
375: * contains useful information about all LVals.
376: * Also kludged up to handle file names (only nlist.namep
377: * is then used.)
378: *
379: * For fns, nlist.itemp is an array of pointers to character
380: * strings which are the compiled code for a line of the fn.
381: * (Itemp == 0) means that the fn has not yet been compiled .
382: * nlist.itemp[0] == the number of lines in the fn, and
383: * nlist.itemp[1] == the function startup code, and
384: * nlist.itemp[max] == the close down shop code.
385: */
386:
387: struct nlist
388: {
389: char use;
390: char type; /* == LV */
391: struct item *itemp;
392: char *namep;
393: int label;
394: } nlist[NLS];
395:
396: /*
397: * This is the structure used to implement the
398: * APL state indicator.
399: *
400: * The structure is allocated dynamically in ex_fun (ai.c),
401: * but not explicitly. Ex_fun declares a single, local
402: * structure (allocated by C, itself), and links it to
403: * previous instances of the structure. SI is used for
404: * two basic things:
405: *
406: * 1) error traceback (Including ")SI" stuff).
407: * 2) Restoration of the global variable environment
408: * (or any other, pending environment).
409: *
410: * The global variable "gsip" is a pointer to the
411: * head of a chain of these structures, one for each
412: * instance of an activated function. (Gsip == 0) implies
413: * an empty list, (gsip->sip == 0) implies the end of the list,
414: * and (gsip->np == 0) implies a state indicator seperator.
415: * (A new function was evoked with an old one pending.)
416: *
417: * Note that "gsip->funlc" is the same as the old global
418: * variable "funlc", and
419: *
420: * (gsip && gsip->sip ? gsip->sip->funlc : 0)
421: *
422: * is the value of the old global, "ibeam36".
423: */
424:
425: struct si {
426: int suspended; /* fn is suspended <=1, pending <= 0 */
427: struct si *sip; /* previous fn activation */
428: struct nlist *np; /* current fn vital stats. */
429: int funlc; /* current fn current line number */
430: struct item **oldsp; /* top of operand stack upon fn entry */
431: char *oldpcp; /* execution string upon fn entry */
432: jmp_buf env; /* for restoration of local
433: * fn activation record */
434: } *gsip;
435:
436: /*
437: * exop[i] is the address of the i'th action routine.
438: * Because of a "symbol table overflow" problem with C,
439: * the table was moved from a1.c to its own at.c
440: */
441:
442: int (*exop[])();
443:
444: double floor();
445: double fabs();
446: double ceil();
447: double log();
448: double sin();
449: double cos();
450: double atan();
451: double atan2();
452: double sqrt();
453: double exp();
454: double gamma();
455: double ltod();
456: char *rline();
457: char *alloc();
458: char *compile();
459: struct nlist *nlook();
460: struct item *fetch(), *fetch1(), *fetch2(), *extend();
461: struct item *newdat(), *dupdat();
462:
463: int integ;
464: int signgam;
465: int column;
466: int intflg;
467: int echoflg;
468: int offexit; /* if != 0, require ")off" to exit */
469: int prwsflg;
470: int ifile;
471: int wfile;
472: int debug;
473: int ttystat[3];
474: long stime;
475: char *pcp; /* global copy of arg to exec */
476: int rowsz;
477: int mencflg;
478: int aftrace;
479: char *mencptr;
480: int oldlb[MAXLAB];
481: int pt;
482: int syze;
483: int pas1;
484: int ibeam36;
485: int protofile;
486: int lastop; /* last (current) operator exec'ed */
487: char *scr_file; /* scratch file name */
488: char *ws_file; /* apl workspace file */
489:
490:
491: struct
492: {
493: char rank;
494: char type;
495: int size;
496: int dimk;
497: int delk;
498: int dim[MRANK];
499: int del[MRANK];
500: int idx[MRANK];
501: } idx;
502:
503:
504: /* Following are definitions for buffered I/O.
505: * To generate a version of APL without buffered I/O,
506: * leave NBUF undefined.
507: */
508:
509: #define NBUF 4 /* Number of I/O buffers */
510:
511:
512: #ifdef NBUF
513:
514: #ifdef vax
515: #define BLEN 512 /* Buffered I/O buffer length */
516: #else
517: #define BLEN 256 /* Buffered I/O buffer length */
518: #endif
519:
520: struct iobuf { /* Buffered I/O buffer structure */
521: int b_len; /* Buffer length */
522: int b_next; /* Next available character */
523: int b_fd; /* Assigned file descriptor */
524: char b_buf[BLEN]; /* Actual buffer */
525: } *iobuf;
526:
527:
528: struct fds {
529: dev_t fd_dev; /* Device major/minor number */
530: ino_t fd_ind; /* File inode number */
531: int fd_pipe; /* (1=pipe, 0=not a pipe) */
532: int fd_buf; /* Number of assigned buffer */
533: char fd_lastop; /* Last operation (0=read, 1=write) */
534: char fd_uniq; /* Unique flag (1=unique, 0=not unique) */
535: char fd_dup; /* Principal fd for dups */
536: char fd_open; /* (0=closed, 1=open) */
537: } files[NFDS];
538:
539:
540: #define READF readf /* Buffered read routine */
541: #define WRITEF writef /* Buffered write routine */
542: #define SEEKF lseekf /* Buffered seek routine */
543: #define OPENF openf /* Buffered file open routine */
544: #define CREATF creatf /* Buffered file create routine */
545: #define DUPF dupf /* Buffered file dup routine */
546: #define CLOSEF closef /* Buffered file close routine */
547: #define FSTATF fstatf /* Buffered "fstat" call */
548: #ifndef VFORK
549: #define FORKF(x) (bflush(),fork())
550: #else
551: #define FORKF(x) (bflush(),(x) ? vfork() : fork())
552: #endif
553:
554: #endif
555:
556:
557: #ifndef NBUF
558:
559: #define READF read /* Normal read routine */
560: #define WRITEF write /* Normal write routine */
561: #define SEEKF lseek /* Normal seek routine */
562: #define OPENF open /* Normal file open routine */
563: #define CREATF creat /* Normal file create routine */
564: #define DUPF dup /* Normal file dup routine */
565: #define CLOSEF close /* Normal file close routine */
566: #define FSTATF fstat /* Normal "fstat" call */
567: #define FORKF(x) fork() /* Normal "fork" call */
568:
569: #endif
570:
571:
572: long SEEKF(); /* declare SEEKF properly */
573:
574: #define setexit() setjmp(gbl_env) /* "setexit" equivalent */
575: #define reset() longjmp(gbl_env) /* "reset" equivalent */
576: #define alloc(x) malloc(x)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.