|
|
1.1 root 1: /* Copyright 1989 by AT&T Bell Laboratories */
2: #include "tags.h"
3: #include "prof.h"
4: #include <sys/types.h>
5: #include <sys/stat.h>
6: #include <signal.h>
7:
8: #ifdef V9
9: #include <sys/filio.h>
10: #include <sys/ttyio.h>
11: #else
12: #include <sys/ioctl.h>
13: #endif
14:
15: extern int datalist[];
16:
17: struct {int tag; char s[4];} div_s = {mak_desc(3,tag_string), "Div\0"};
18:
19: int div_e0[]={mak_desc(2,tag_record),
20: 1,
21: (int) (div_e0+4),
22: mak_desc(1,tag_array),
23: (int) div_s.s};
24:
25: struct {int tag; char s[8];} overflow_s = {mak_desc(8,tag_string), "Overflow"};
26:
27: int overflow_e0[]={mak_desc(2,tag_record),
28: 1,
29: (int) (overflow_e0+4),
30: mak_desc(1,tag_array),
31: (int) overflow_s.s};
32:
33: struct {int tag; char s[12];} interrupt_s =
34: {mak_desc(9,tag_string), "Interrupt\0\0\0"};
35:
36: int interrupt_e0[]={mak_desc(2,tag_record),
37: 1,
38: (int) (interrupt_e0+4),
39: mak_desc(1,tag_array),
40: (int) interrupt_s.s};
41:
42: struct {int tag; char s[12];} systemcall_s =
43: {mak_desc(10,tag_string), "SystemCall\0\0"};
44:
45: int systemcall_e0[]={mak_desc(1,tag_array),
46: (int) systemcall_s.s};
47:
48: struct {int tag; char s[4];} real_s =
49: {mak_desc(4,tag_string), "Real"};
50:
51: struct {int tag; char s[12];} unboundTable_s =
52: {mak_desc(12,tag_string), "UnBoundTable"};
53: int unboundTable_e0[]={mak_desc(1,tag_array),
54: (int) unboundTable_s.s};
55:
56: int real_e0[]={mak_desc(1,tag_array),
57: (int) real_s.s};
58:
59: int array0_v[]={mak_desc(0,tag_array)};
60:
61: int bytearray0_v[]={mak_desc(0,tag_bytearray)};
62:
63: extern int collected0[];
64: extern int collectedfrom0[];
65: extern int current0[];
66: extern int gcmessages0[];
67: extern int majorcollections0[];
68: extern int minorcollections0[];
69: extern int pstruct0[];
70: extern int ratio0[];
71: extern int softmax0[];
72:
73: struct {int tag, calls, interrupts; char c[4];} gcprof =
74: {mak_desc(12,tag_bytearray), 1, 1, "(gc)"};
75:
76: #ifndef NS32
77: int fion(fd) int fd;
78: {static struct stat buf;
79: int count[2]; int pos; int r;
80: fd >>= 1;
81: r=ioctl(fd,FIONREAD,count);
82: if (r>=0) return (count[0]<<1)+1;
83: if (fstat(fd,&buf)<0) return -1;
84: pos = lseek(fd,0,1);
85: if (pos<0) pos=0;
86: return ((buf.st_size - pos)<<1) + 1;
87: }
88: #else
89: int fion(fd) int fd;
90: {static struct stat buf;
91: int count[2]; int pos; int r;
92: fd >>= 1;
93: r=fstat(fd,&buf);
94: if (r>=0) {
95: pos = lseek(fd,0,1);
96: if (pos>=0) {
97: r = (buf.st_size - pos);
98: if (r >= 0) return ((r<<1) + 1);
99: }
100: }
101: r=ioctl(fd,FIONREAD,count);
102: if (r>=0) return (count[0]<<1)+1;
103: return(-1);
104: }
105: #endif NS32
106:
107: int profvec(arg) struct {int index, newval;} *arg;
108: {extern int bottom[];
109: int k = bottom[arg->index>>1];
110: bottom[arg->index>>1] = arg->newval;
111: return k;
112: }
113:
114: int syst(s) char *s;
115: {
116: return (system(s)<<1)+1;
117: }
118:
119: char **environ, **global_argv;
120: char *argv(arg) int arg;
121: {char *s=global_argv[arg>>1];
122: return s?s:(char*)1;
123: }
124: char *envi(arg) int arg;
125: {char *s = environ[arg>>1];
126: return s?s:(char*)1;
127: }
128:
129: int time(arg) struct {int *g_usec, *g_sec, *t_usec, *t_sec;} *arg;
130: {extern g_usec, g_sec, t_usec, t_sec;
131: timer();
132: *(arg->g_usec) = g_usec;
133: *(arg->g_sec) = g_sec;
134: *(arg->t_usec) = t_usec;
135: *(arg->t_sec) = t_sec;
136: return 1;
137: }
138:
139: int blastfil;
140: blast_write(start,end,ptr) int start,end, ptr;
141: {int i = ptr-start;
142: bulletproofWrite(blastfil,&start,4);
143: bulletproofWrite(blastfil,&end,4);
144: bulletproofWrite(blastfil,&i,4);
145: bulletproofWrite(blastfil,start,end-start);
146: }
147:
148:
149: extern int cause;
150: int blas(arg) struct{int filid; int obj;} *arg;
151: {
152: cause = CAUSE_BLAST;
153: blastfil = arg->filid >> 1;
154: return arg->obj;
155: }
156:
157: int salb(arg) struct{int start, end, offset; int words[1];} *arg;
158: {
159: ((int*)arg)[-1] = mak_desc(4,tag_string);
160: relocate(arg->start,arg->end,arg->words);
161: return (int)(arg->words)+arg->offset;
162: }
163:
164: extern int exportFilid;
165: int expo(filid) int filid;
166: {exportFilid=filid;
167: cause=CAUSE_EXPORT;
168: return 1;
169: }
170:
171:
172: int exec(arg) struct {char *command; int *fdin, *fdout;} *arg;
173: {int p1[2], p2[2];
174: if (pipe(p1)<0) return -1;
175: if (pipe(p2)<0) return -1;
176: #ifdef V9
177: if (fork())
178: #else
179: if (vfork())
180: #endif
181: {close(p1[0]); close(p2[1]);
182: *(arg->fdin)= p2[0]*2+1; *(arg->fdout)=p1[1]*2+1;
183: }
184: else
185: {close(p1[1]); close(p2[0]);
186: dup2(p1[0],0); dup2(p2[1],1);
187: execl("/bin/sh","/bin/sh","-c",arg->command,0);
188: _exit(1);
189: }
190: return 1;
191: }
192:
193: int stor(arg) int arg;
194: {
195: cause = CAUSE_STOR;
196: return arg;
197: }
198:
199: int mtim(fd)
200: int fd; /* return (ML) ~1 on error. */
201: {
202: struct stat buf;
203: if (fstat(fd>>1, &buf)) /* Non-zero: failure. */
204: return(ML_INT(-1));
205: else if (buf.st_mtime & 0x80000000) /* Overflow in ML int? */
206: return(ML_INT(-1));
207: else
208: return(ML_INT(buf.st_mtime));
209: }
210:
211: extern int errno;
212:
213: int errn()
214: {
215: return errno+errno+1;
216: }
217:
218: int isat(fd) int fd;
219: {
220: return isatty(fd>>1)*2+1;
221: }
222:
223:
224:
225: /* name must be 4 characters exactly */
226: #define function(ff,nn,i) \
227: {mak_desc(3,tag_record), \
228: (int)ff, \
229: (int) externlist0[i].str , \
230: (int) &(externlist0[(i)+1].func), \
231: mak_desc(4,tag_string), \
232: nn},
233:
234: struct {int tag,func,name,next,stag; char str[4];} externlist0[]=
235: {function(fion,"fion",0)
236: function(exec,"exec",1)
237: function(profvec,"prof",2)
238: function(syst,"syst",3)
239: function(time,"time",4)
240: function(argv,"argv",5)
241: function(envi,"envi",6)
242: function(blas,"blas",7)
243: function(salb,"salb",8)
244: function(expo,"expo",9)
245: function(stor,"stor",10)
246: function(mtim,"mtim",11)
247: function(errn,"errn",12)
248: function(isat,"isat",13)
249: function(0,"xxxx",14)
250: };
251:
252: extern int runvec[];
253: extern int errstrings[];
254:
255: int *cstruct[]={
256: (int*)mak_desc(20,tag_record),
257: runvec,
258: div_e0+1,
259: interrupt_e0+1,
260: overflow_e0+1,
261: real_e0+1,
262: systemcall_e0+1,
263: unboundTable_e0+1,
264: array0_v+1,
265: bytearray0_v+1,
266: collected0+1,
267: collectedfrom0+1,
268: current0+1,
269: datalist,
270: errstrings+1,
271: &(externlist0[0].func),
272: gcmessages0+1,
273: &gcprof.calls,
274: majorcollections0+1,
275: minorcollections0+1,
276: #ifdef V9
277: (int*)7,
278: #else
279: #ifdef VAX
280: (int*)3,
281: #else
282: (int*)5,
283: #endif
284: #endif
285: pstruct0+1,
286: ratio0+1,
287: softmax0+1
288: };
289:
290:
291: struct {int tag; char s[8];} ovf_s = {mak_desc(8,tag_string), "overflow"};
292: int float_ovf [] = {mak_desc(2,tag_record), (int)ovf_s.s, (int)(real_e0+1)};
293:
294: struct {int tag; char s[12];} und_s = {mak_desc(9,tag_string), "underflow"};
295: int float_und [] = {mak_desc(2,tag_record), (int)und_s.s, (int)(real_e0+1)};
296:
297: struct {int tag; char s[16];} fdiv_s = {mak_desc(14,tag_string),
298: "divide by zero"};
299: int float_div [] = {mak_desc(2,tag_record), (int)fdiv_s.s, (int)(real_e0+1)};
300:
301: struct {int tag; char s[28];} strange_s = {mak_desc(28,tag_string),
302: "strange floating point error"};
303: int float_str [] = {mak_desc(2,tag_record), (int)strange_s.s, (int)(real_e0+1)};
304:
305: struct {int tag; char s[20];} emt_s = {mak_desc(19,tag_string),
306: "68881 not installed"};
307: int float_emt [] = {mak_desc(2,tag_record), (int)emt_s.s, (int)(real_e0+1)};
308:
309: int exnCode(signal,code) int signal,code;
310: {
311: if(signal==SIGFPE)
312: switch(code)
313: {
314: #ifdef FPE_TRAPV_TRAP
315: case FPE_TRAPV_TRAP:
316: #endif
317: #ifdef FPE_FLTOPERR_TRAP
318: case FPE_FLTOPERR_TRAP:
319: #endif
320: #ifdef FPE_OPERAND_TRAP
321: case FPE_OPERAND_TRAP:
322: #endif
323: #ifdef FPE_INTOVF_TRAP
324: case FPE_INTOVF_TRAP:
325: #endif
326: #ifdef FPE_INTOVF_FAULT
327: case FPE_INTOVF_FAULT:
328: #endif
329: #ifdef K_INTOVF
330: case K_INTOVF:
331: #endif
332: return (int)(overflow_e0+1);
333: #ifdef FPE_INTDIV_TRAP
334: case FPE_INTDIV_TRAP:
335: #endif
336: #ifdef FPE_INTDIV_FAULT
337: case FPE_INTDIV_FAULT:
338: #endif
339: #ifdef K_INTDIV
340: case K_INTDIV:
341: #endif
342: #ifdef FPE_ZERODIV_TRAP
343: case FPE_ZERODIV_TRAP:
344: #endif
345: return (int)(div_e0+1);
346: #ifdef FPE_FLTOVF_TRAP
347: case FPE_FLTOVF_TRAP:
348: #endif
349: #ifdef FPE_FLTOVF_FAULT
350: case FPE_FLTOVF_FAULT:
351: #endif
352: #ifdef K_FLTOVF
353: case K_FLTOVF:
354: #endif
355: #ifdef FPE_OVERFLOW_TRAP
356: case FPE_OVERFLOW_TRAP:
357: #endif
358: return (int)(float_ovf+1);
359: #ifdef FPE_FLTDIV_TRAP
360: case FPE_FLTDIV_TRAP:
361: #endif
362: #ifdef FPE_FLTDIV_FAULT
363: case FPE_FLTDIV_FAULT:
364: #endif
365: #ifdef K_FLTDIV
366: case K_FLTDIV:
367: #endif
368: #ifdef FPE_DIVZERO_TRAP
369: case FPE_DIVZERO_TRAP:
370: #endif
371: return (int)(float_div+1);
372: #ifdef FPE_FLTUND_TRAP
373: case FPE_FLTUND_TRAP:
374: #endif
375: #ifdef FPE_FLTUND_FAULT
376: case FPE_FLTUND_FAULT:
377: #endif
378: #ifdef FPE_UNDERFLOW_TRAP
379: case FPE_UNDERFLOW_TRAP:
380: #endif
381: #ifdef K_FLTUND
382: case K_FLTUND:
383: #endif
384: return (int)(float_und+1);
385: default:
386: return (int)(float_str+1);
387: }
388: else if (signal==SIGEMT)
389: return (int)(float_emt+1);
390: else if (signal==SIGINT)
391: return (int)(interrupt_e0+1);
392: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.