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