![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to run.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / runtime|
Return to run.c CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / runtime |
1.1 root 1: /* Copyright 1989 by AT&T Bell Laboratories */
2: #include <stdio.h>
3: #include <sys/types.h>
4: #include <sys/stat.h>
5: #include <sys/file.h>
6: #include <signal.h>
7: #include "tags.h"
8: #include "descriptor.h"
9: #include "prof.h"
10: extern double atof();
11:
12: extern int cstruct[];
13:
14: extern int profvec[];
15:
16: extern int saved_dataptr;
17:
18: extern struct datalist
19: {mlstring name;
20: char *data;
21: struct datalist *next;
22: } datalist;
23:
24: int openread(s) char *s;
25: {int fd= -1; char *p, *q; int i;
26: {struct datalist *d; mlstring ss=(mlstring)mak_str(s);
27: for(d= &datalist; (int)d!=1; d=d->next)
28: if (ml_eqstr(ss,d->name)) return (int)d->data-4;
29: }
30:
31: #ifdef V9
32: fd = open(s,0);
33: #endif
34: #ifdef BSD
35: fd = open(s,O_RDONLY,0666);
36: #endif
37: if (fd<0) quit("cannot open %s\n",s);
38: p=(char *)saved_dataptr;
39: saved_dataptr += sizeof(int);
40: while (i=read(fd,saved_dataptr,4096)) saved_dataptr+=i;
41: q=(char*)saved_dataptr;
42: while (saved_dataptr & 3) saved_dataptr++;
43: *(int*)p = mak_desc(q-p-sizeof(int),tag_string);
44: return (int)p;
45: }
46:
47: char *load();
48:
49: closure(x) int x;
50: {int *p = (int *)mak_obj(1,tag_record);
51: p[0] = x;
52: return (int)p;
53: }
54:
55: extern int new_size;
56: extern int resettimers();
57: #ifdef M68
58: extern int math_functor, mathvec;
59: #endif
60:
61: char *pervfunc = "mo/PervFunc.mo";
62: char *loadername = "mo/Loader.mo";
63: char *mathfunc = "mo/Math.mo";
64: int xflag=0;
65: extern int gcmessages0[], ratio0[], softmax0[], pstruct0[];
66: #define gcmessages (gcmessages0[1])
67: #define pstruct (pstruct0[1])
68: #define ratio (ratio0[1])
69: #define softmax (softmax0[1])
70: extern int cause;
71: char **global_argv;
72: main(argc,argv) int argc;
73: char *argv[];
74: {
75: int perv, core, math, loader, *argrec;
76: char *argname;
77: char **p = argv+1;
78:
79: global_argv=argv;
80: if (cause==CAUSE_EXPORT) restarter();
81: gcmessages = ML_INT(2);
82: ratio=11;
83: softmax=1024*1024*100*2 + 1;
84: while (*p && **p == '-')
85: switch (p[0][1])
86: {case 'h': if (p[1])
87: {new_size = 1024*atoi(p[1]); p+=2;}
88: else quit("no -h value");
89: break;
90: case 'r': if (p[1]) {ratio = atoi(p[1])*2+1; p+=2;
91: if (ratio<7) ratio=7;
92: }
93: else quit("no -r value");
94: break;
95: case 'm': if (p[1]) {softmax = 1024*atoi(p[1])*2+1; p+=2;}
96: else die("no -m value");
97: break;
98: case 'g': if (p[1])
99: {gcmessages0[1] = ML_INT(atoi(p[1])); p+=2;}
100: else quit("no -g value");
101: break;
102: case 'x': if (p[1])
103: {xflag=1; pervfunc = p[1]; p+=2;}
104: else quit("no -x value");
105: break;
106: case 'y': if (p[1])
107: {xflag=2; pervfunc = p[1]; p+=2;}
108: else quit("no -y value");
109: break;
110: case 'z': if (p[1])
111: {xflag=3; loadername = p[1]; p+=2;}
112: else quit("no -z value");
113: break;
114: case 't': if (p[1])
115: {mathfunc = p[1]; p+=2;}
116: else quit("no -t value");
117: break;
118: }
119:
120: if (*p) argname= *p;
121: else if (xflag==0) quit("no file to execute\n");
122:
123: setupsignals();
124: resettimers();
125: init_gc();
126:
127: #ifdef PROFILE
128: {int i;
129: for(i=0; i<PROFSIZE; i++) profvec[i] = ML_INT(0);
130: }
131: #endif
132:
133: perv = (int)load(mak_str("CoreFunc"));
134: enroll(mak_str("Core"),core=apply(perv,cstruct+1));
135: #ifdef M68
136: math = (int)&mathvec;
137: enroll(mak_str("Math"),math);
138: #else
139: math = (int)load(mak_str("Math"));
140: #endif
141: perv = pstruct = (int)load(mak_str("Initial"));
142: if (xflag==1) {chatting("Result is %d\n",(*(int*) perv)>>1); _exit(0);}
143:
144: loader = (int)load(mak_str("Loader"));
145: if (xflag==3) {chatting("Result is %d\n", (*(int*) loader)>>1); _exit(0);}
146: argrec = (int *)mak_obj(4,tag_record);
147: argrec[0] = core;
148: argrec[1] = perv;
149: argrec[2] = math;
150: argrec[3] = mak_str(argname);
151: apply(loader,argrec);
152: #ifdef PROFILE
153: print_profile_info();
154: #endif
155: #ifdef GCPROFILE
156: print_gcprof();
157: #endif
158: exit(0);
159: }
160:
161: struct exception {
162: mlstring val;
163: mlstring *name;
164: };
165:
166: uncaught(e) struct exception *e;
167: {int descr;
168: if ((int)e->val & 1)
169: chatting("Uncaught exception %.*s with %d\n",
170: (((int *)*e->name)[-1])>>width_tags,
171: e->name[0],
172: (int)e->val);
173: else if (((descr=((int*)e->val)[-1])&mask_tags) == tag_string
174: || (descr&mask_tags) == tag_embedded) /* possible bug on reals */
175: chatting("uncaught exception %.*s with \"%.*s\"\n",
176: (((int *)*e->name)[-1])>>width_tags,
177: e->name[0],
178: descr>>width_tags,
179: e->val);
180: else chatting("uncaught exception %.*s with <unknown>\n",
181: (((int *)*e->name)[-1])>>width_tags,
182: e->name[0]);
183: exit(1);
184: }
185:
186:
187: int quit(s, a, b, c, d, e, f)
188: char *s;
189: {char dbuf[1024];
190: sprintf(dbuf, s, a, b, c, d, e, f);
191: write(2, dbuf, strlen(dbuf));
192: exit (2);
193: }
194:
195: die(s, a, b, c, d, e, f)
196: char *s;
197: {char dbuf[1024];
198: sprintf(dbuf, s, a, b, c, d, e, f);
199: write(2, dbuf, strlen(dbuf));
200: /* abort(); */
201: exit(3);
202: }
203:
204: chatting(s, a, b, c, d, e, f, g)
205: char *s;
206: {char dbuf[1024];
207: sprintf(dbuf, s, a, b, c, d, e, f, g);
208: write(2, dbuf, strlen(dbuf));
209: }
210:
211:
212: mlstring names[10];
213: char * objs[10];
214: int objcount;
215:
216: enroll(name,obj) mlstring name; char *obj;
217: {
218: names[objcount]=name; objs[objcount]=obj;
219: objcount++;
220: }
221:
222: #define get_slen(x) ( ((int*)(x))[-1]>>width_tags )
223: char *lookup(name) mlstring name;
224: {int i;
225: for(i=0;i<objcount;i++)
226: {mlstring s = names[i];
227: if (get_slen(name)==get_slen(s) && !strncmp(name,s,get_slen(s)))
228: return objs[i];
229: }
230: return 0;
231: }
232:
233: struct list {mlstring name; struct list *next;};
234:
235: struct list *loadlist(names) struct list *names;
236: {struct list * g;
237: if ((int)names==1) return (struct list *)1;
238: g = (struct list *) mak_obj(2,tag_record);
239: g->name = (mlstring) load(names->name);
240: g->next = loadlist(names->next);
241: return g;
242: }
243:
244: char *load(name) mlstring name;
245: {mlstring p; char buf[50];
246: if (p=lookup(name)) return p;
247: strcpy(buf,"mo/");
248: strncpy(buf+3,name,get_slen(name));
249: strcpy(buf+3+get_slen(name),".mo");
250: chatting("[Loading %s]\n",buf);
251: p = (char *)closure(openread(buf)+12);
252: p = (char *)apply(p,ML_UNIT);
253: chatting("[Executing %s]\n",buf);
254: p = (char *)(((int*)(apply(((int*)p)[0], loadlist(((int*)p)[1]))))[0]);
255: /* p = (char *)apply(((int*)p)[0], loadlist(((int*)p)[1])); */
256: enroll(name,p);
257: return p;
258: }
259:
260:
261: /* profiling stuff */
262: extern int *current0[];
263:
264: handleprof()
265: {
266: current0[1][1] += 2;
267: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.