![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fasl.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / lisp|
Return to fasl.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2: #include "lfuncs.h"
3: #include "chkrtab.h"
4: #include <a.out.h>
5: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
6: #define STRLIM 2048
7:
8: /* this is the original fasl, which used nld to do relocation.
9: * On nov 4, it was replaced by rfasl
10: */
11:
12: static lispval mkptr();
13: static char stabbuf[32]="";
14: static struct exec header;
15: static lispval *linkaddr;
16: static int fildes;
17: static char *currend;
18: extern char *stabf;
19: extern int fvirgin;
20: static lispval currtab;
21: static lispval curibase;
22: lispval
23: Loldfasl(){
24: register struct argent *mlbot = lbot;
25: register lispval work;
26: int totsize, readsize;
27: lispval csegment(), errorh();
28: char *sbrk(), *tfile, cbuf[512], *mytemp(), *gstab();
29: struct nament *obnp = bnp;
30:
31: snpand(2);
32: if(np - mlbot != 1 || TYPE(mlbot[0].val)!=ATOM)
33: mlbot[0].val = errorh(Vermisc,
34: "fasl: Incorrect .o file specification:",
35: nil,
36: TRUE,
37: 0,
38: mlbot[0].val);
39:
40: /*
41: * Invoke loader.
42: */
43: currend = sbrk(0);
44: tfile = mytemp();
45: sprintf(cbuf,
46: "/usr/lib/lisp/nld -A %s -T %x -N %s -o %s",
47: gstab(),
48: currend,
49: mlbot[0].val->pname,
50: tfile);
51: /* printf(cbuf); fflush(stdout); debugging */
52: printf("[fasl: %s]",mlbot[0].val->pname);
53: fflush(stdout);
54: if(system(cbuf)!=0) {
55: unlink(tfile);
56: return(nil);
57: }
58: putchar('\n'); /* signal end of nld */
59: fflush(stdout);
60: if((fildes = open(tfile,0))<0)
61: return(nil);
62: if(fvirgin)
63: fvirgin = 0;
64: else
65: unlink(stabf);
66: strcpyn(stabbuf,tfile,31);
67: stabf = stabbuf;
68: /*
69: * Read a.out header to find out how much room to
70: * allocate and attempt to do so.
71: */
72: if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
73: close(fildes);
74: return(nil);
75: }
76: readsize = header.a_text;
77: totsize = readsize;
78: totsize = round(totsize,PAGSIZ);
79: /*
80: * Fix up system indicators, typing info, etc.
81: */
82: currend = (char *)csegment(int_name,totsize/(sizeof(int)));
83:
84: if(readsize!=read(fildes,currend,readsize))
85: return(nil);
86: linkaddr = (lispval *)*(int *)currend;
87: currtab = Vreadtable->clb;
88: Vreadtable->clb = strtab;
89: curibase = ibase->clb;
90: ibase->clb = inewint(10);
91: do_linker();
92: do_binder();
93: ibase->clb=curibase;
94: Vreadtable->clb = currtab;
95: chkrtab(currtab); /* added by jkf, shouldnt be needed */
96: return(tatom);
97: }
98: static char mybuff[40];
99: char *
100: mytemp()
101: {
102: static seed=0, mypid = 0;
103: if(mypid==0) mypid = getpid();
104: sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed++);
105: return(mybuff);
106: }
107:
108: static
109: do_linker()
110: {
111: register int *i, *end, temp;
112: char array[STRLIM];
113: extern lispval *bind_lists;
114:
115: /* first link this linkage table to the garbage
116: collector's list. We will try to be tricky
117: so that if the garbage collector is invoked
118: by mkptr we will not cause markdp() to go off
119: the deep end.
120: */
121: *(linkaddr-1) = (lispval) bind_lists;
122: bind_lists = linkaddr;
123: i = (int *)linkaddr;
124: end = (int *)(currend + header.a_text - 7);
125: for(; i<end; i++) {
126: temp = *i;
127: *i = -1; /* clobber to short circuit gc */
128: findstr(temp, array);
129: *i = (int)mkptr(array);
130: }
131: }
132: static
133: do_binder()
134: {
135: char array[STRLIM];
136: struct argent *onp = np;
137: int pos;
138: register lispval handy;
139: struct {lispval (*b_entry)();
140: int b_atmlnk;
141: int b_type;} bindage;
142:
143: snpand(0);
144: pos = lseek(fildes, (sizeof header)+header.a_text, 0);
145: while(read(fildes, &bindage, sizeof bindage)==sizeof bindage
146: && bindage.b_atmlnk != -1) {
147: np = onp;
148: if( bindage.b_type == 99) {
149: /* we must evaluate this form for effect */
150: /* and must take care that setsyntax works
151: on the proper read table */
152:
153: findstr(bindage.b_atmlnk, array);
154: if(ISNIL(copval(gcload,CNIL)) && loading->clb != tatom)
155: gc(CNIL); /* do a gc if gc will be off */
156: handy = (mkptr(array));
157: ibase->clb=curibase;
158: Vreadtable->clb = currtab;
159: eval(handy);
160: Vreadtable->clb = strtab;
161: curibase = ibase->clb;
162: ibase->clb = inewint(10);
163: goto out;
164: }
165: handy = newfunct();
166: protect(handy);
167: handy->entry = bindage.b_entry;
168: handy->discipline = (bindage.b_type == 0 ? lambda :
169: bindage.b_type == 1 ? nlambda :
170: macro);
171:
172: findstr(bindage.b_atmlnk, array);
173: if(*array != '(')
174: mkptr(array)->fnbnd = handy;
175: else {
176: char *i,*j,*index();
177: lispval prop, atom;
178:
179: i = index(array, ':');
180: j = index(array, ')');
181: *i = 0;
182: *j = 0;
183: protect(prop = mkptr(array+1));
184: atom = mkptr(i+1);
185: Iputprop(atom,handy,prop);
186: }
187: out:
188: pos = lseek(fildes, pos + sizeof bindage, 0);
189: }
190: }
191:
192: static
193: findstr(ptr,array)
194: int ptr;
195: char *array;
196: {
197: int cnt = 0;
198:
199: lseek(fildes, sizeof header + header.a_text + ptr, 0);
200: while(cnt<STRLIM && read(fildes,&array[cnt],1)==1
201: && array[cnt]!=0) cnt++;
202: if(cnt >= STRLIM) error("fasl string table overflow",FALSE);
203: }
204:
205: static lispval
206: mkptr(str)
207: register char *str;
208: {
209: lispval work;
210: register FILE *p=stdin;
211: snpand(2);
212:
213: /* find free file descriptor */
214: for(;p->_flag&(_IOREAD|_IOWRT);p++)
215: if(p >= _iob + _NFILE)
216: error("Too many open files to do readlist",FALSE);
217: p->_flag = _IOREAD | _IOSTRG;
218: p->_base = p->_ptr = str;
219: p->_cnt = strlen(str) + 1;
220:
221: lbot = np;
222: protect(P(p));
223: work = Lread();
224: p->_cnt = 0;
225: p->_ptr = p->_base = 0;
226: p->_file = 0;
227: p->_flag=0;
228: return(work);
229: }
230:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.