|
|
1.1 root 1:
2: static char *sccsid = "@(#)bind.c 34.1 10/3/80";
3:
4: #include "global.h"
5: #include "a.out.h"
6: #define STRLIM 1024
7:
8: static lispval mkptr();
9: static struct exec header;
10: static struct nlist nlist;
11: static lispval *linkaddr;
12: static int *bindaddr;
13: static int fildes;
14: static lispval currtab;
15: static lispval curibase;
16: extern int fvirgin;
17: extern int initflag;
18: lispval
19: Lbind(){
20: register struct argent *mlbot = lbot;
21: register lispval work;
22: char *sbrk(), *tfile, cbuf[512], *mytemp(), *gstab();
23:
24: snpand(2);
25:
26: strcpy(cbuf, gstab());
27: printf("getting symbol table from %s\n",cbuf); fflush(stdout);
28: if((fildes = open(cbuf,0))<0)
29: return(nil);
30: /*
31: * Read a.out header to find out where symbol table is.
32: */
33: if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
34: close(fildes);
35: return(nil);
36: }
37:
38: lseek(fildes, header.a_text+header.a_data+header.a_trsize
39: +header.a_drsize, 1);
40:
41: currtab = Vreadtable->a.clb;
42: Vreadtable->a.clb = strtab;
43: curibase = ibase->a.clb;
44: ibase->a.clb = inewint(10);
45: while((sizeof nlist)==read(fildes,&nlist,sizeof nlist)) {
46: if( nlist.n_name[0]!='.' || nlist.n_name[1]!='.')
47: continue;
48:
49: linkaddr = (lispval *)*(int *)nlist.n_value;
50: bindaddr = (int *)*(int *)(nlist.n_value+sizeof(int));
51: do_linker();
52: do_binder();
53: }
54: ibase->a.clb = curibase;
55: Vreadtable->a.clb = currtab;
56: return(tatom);
57: }
58:
59: static do_linker()
60: {
61: register int *i, *end, temp;
62: char array[STRLIM];
63: extern lispval *bind_lists;
64:
65: /* first link this linkage table to the garbage
66: collector's list. We will try to be tricky
67: so that if the garbage collector is invoked
68: by mkptr we will not cause markdp() to go off
69: the deep end.
70: */
71: *(linkaddr-1) = (lispval) bind_lists;
72: bind_lists = linkaddr;
73: i = (int *)linkaddr;
74: initflag = TRUE;
75: for(; *i!=-1; i++) {
76: temp = *i;
77: *i = -1; /* clobber to short circuit gc */
78: findstr(temp, array);
79: *i = (int)mkptr(array);
80: }
81: initflag = FALSE;
82: }
83: static do_binder()
84: {
85: char array[STRLIM];
86: register lispval handy;
87: struct binder {lispval (*b_entry)();
88: int b_atmlnk;
89: int b_type;} bindage, *pos;
90:
91: pos = (struct binder *)bindaddr;
92: initflag = TRUE;
93: for(bindage= *pos++; bindage.b_atmlnk!=-1; bindage = *pos++) {
94: if( bindage.b_type == 99) {
95: struct argent *olbot;
96: /* we must evaluate this form for effect */
97:
98: findstr(bindage.b_atmlnk, array);
99: /* garbage collection appears to
100: cause problems at this point */
101: /* if(ISNIL(copval(gcload,CNIL)) && loading->a.clb != tatom)
102: gc(CNIL); /* do a gc if gc will be off */
103: handy = mkptr(array);
104: olbot = lbot;
105: lbot = np;
106: ibase->a.clb=curibase;
107: Vreadtable->a.clb = currtab;
108: (np++)->val = handy;
109: Leval();
110: Vreadtable->a.clb = strtab;
111: curibase = ibase->a.clb;
112: ibase->a.clb = inewint(10);
113: np = lbot;
114: lbot = olbot;
115: } else {
116: handy = newfunct();
117: handy->bcd.entry = bindage.b_entry;
118: handy->bcd.discipline = (bindage.b_type == 0 ? lambda :
119: bindage.b_type == 1 ? nlambda :
120: macro);
121:
122: findstr(bindage.b_atmlnk, array);
123: protect(handy);
124: mkptr(array)->a.fnbnd = handy;
125: }
126: }
127: initflag = FALSE;
128: }
129:
130: static
131: findstr(ptr,array)
132: int ptr;
133: char *array;
134: {
135: int cnt = 0;
136: char *cp;
137:
138: cp = ptr + (char *)bindaddr;
139: while(cnt<STRLIM && (array[cnt++] = *cp++));
140: }
141:
142: static
143: lispval
144: mkptr(str)
145: register char *str;
146: {
147: lispval work, Lread();
148: FILE *opiport = piport;
149: register FILE *p=stdin;
150: struct argent *olbot;
151: snpand(2);
152:
153: /* find free file descriptor */
154: for(;p->_flag&(_IOREAD|_IOWRT);p++)
155: if(p >= _iob + _NFILE)
156: error("Too many open files to do readlist",FALSE);
157: p->_flag = _IOREAD | _IOSTRG;
158: p->_base = p->_ptr = str;
159: p->_cnt = strlen(str) + 1;
160:
161: olbot = lbot;
162: lbot = np;
163: piport = p;
164: protect(P(p));
165: work = Lread();
166: piport = opiport;
167: lbot = olbot;
168: p->_cnt = 0;
169: p->_ptr = p->_base = 0;
170: p->_file = 0;
171: p->_flag=0;
172: return(work);
173: }
174:
175:
176:
177:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.