![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ffasl.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to ffasl.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1: static char *sccsid = "@(#)ffasl.c 34.3 10/23/80";
2:
3: #include "global.h"
4: #include <sys/types.h>
5: #include <pagsiz.h>
6: #include <sys/stat.h>
7: #include "naout.h"
8: #define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
9:
10: char *stabf = 0;
11: int fvirgin = 1;
12: static seed=0, mypid = 0;
13: lispval verify();
14:
15: /* dispget - get discipline of function
16: * this is used to handle the tricky defaulting of the discipline
17: * field of such functions as cfasl and getaddress.
18: * dispget is given the value supplied by the caller,
19: * the error message to print if something goes wrong,
20: * the default to use if nil was supplied.
21: * the discipline can be an atom or string. If an atom it is supplied
22: * it must be lambda, nlambda or macro. Otherwise the atoms pname
23: * is used.
24: */
25:
26: lispval
27: dispget(given,messg,defult)
28: lispval given,defult;
29: char *messg;
30: {
31: int typ;
32:
33: while(TRUE)
34: {
35: if(given == nil)
36: return(defult);
37: if((typ=TYPE(given)) == ATOM)
38: { if(given == lambda ||
39: given == nlambda ||
40: given == macro) return(given);
41: else return((lispval) given->a.pname);
42: } else if(typ == STRNG) return(given);
43:
44: given = errorh(Vermisc,messg,nil,TRUE,0,given);
45: }
46: }
47:
48: lispval
49: Lcfasl(){
50: register struct argent *mlbot = lbot;
51: register lispval work;
52: register int fildes, totsize;
53: int readsize;
54: register struct argent *lbot, *np;
55: lispval csegment();
56: char *sbrk(), *currend, *tfile, cbuf[6000], *mytemp(), *gstab();
57: char ostabf[128];
58: struct exec header;
59: char *largs;
60: snpand(4);
61:
62: switch(np-lbot) {
63: case 3: protect(nil); /* no discipline given */
64: case 4: protect(nil); /* no library given */
65: }
66: chkarg(5,"cfasl");
67: mlbot[0].val = verify(mlbot[0].val,"Incorrect .o file specification");
68: mlbot[1].val = verify(mlbot[1].val,"Incorrect entry specification for cfasl");
69: mlbot[3].val = dispget(mlbot[3].val,"Incorrect discipline specification for cfasl",Vsubrou->a.pname);
70: while(TYPE(mlbot[2].val)!= ATOM)
71: mlbot[2].val = errorh(Vermisc,"Bad associated atom name for fasl",
72: nil,TRUE,0,mlbot[2].val);
73: work = mlbot[4].val;
74: if(work==nil)
75: largs = 0;
76: else
77: largs = (char *) verify(work,"Bad loader flags");
78:
79: /*
80: * Invoke loader.
81: */
82: strcpy(ostabf,gstab());
83: currend = sbrk(0);
84: tfile = mytemp();
85: sprintf(cbuf,
86: "/usr/lib/lisp/nld -N -A %s -T %x %s -e %s -o %s %s -lc",
87: ostabf,
88: currend,
89: mlbot[0].val,
90: mlbot[1].val,
91: tfile,
92: largs);
93: printf(cbuf); fflush(stdout);
94: if(system(cbuf)!=0) {
95: unlink(tfile);
96: ungstab();
97: fprintf(stderr,"Ld returns error status\n");
98: return(nil);
99: }
100: putchar('\n'); fflush(stdout);
101: if(fvirgin)
102: fvirgin = 0;
103: else
104: unlink(ostabf);
105: stabf = tfile;
106: if((fildes = open(tfile,0))<0) {
107: fprintf(stderr,"Couldn't open temporary file: %s\n",tfile);
108: return(nil);
109: }
110: /*
111: * Read a.out header to find out how much room to
112: * allocate and attempt to do so.
113: */
114: if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
115: close(fildes);
116: return(nil);
117: }
118: readsize = round(header.a_text,4) + round(header.a_data,4);
119: totsize = readsize + header.a_bss;
120: totsize = round(totsize,512);
121: /*
122: * Fix up system indicators, typing info, etc.
123: */
124: currend = (char *)csegment(str_name,totsize,FALSE);
125:
126: if(readsize!=read(fildes,currend,readsize))
127: return(nil);
128: work = newfunct();
129: work->bcd.entry = (lispval (*)())header.a_entry;
130: work->bcd.discipline = mlbot[3].val;
131: return(mlbot[2].val->a.fnbnd = work);
132: }
133: static char myname[100];
134: char *
135: gstab()
136: {
137: register char *cp, *cp2; char *getenv();
138: struct stat stbuf;
139: extern char **Xargv;
140:
141: if(stabf==0) {
142: cp = getenv("PATH");
143: if(cp==0)
144: cp=":/usr/ucb:/bin:/usr/bin";
145: if(*cp==':'||*Xargv[0]=='/') {
146: cp++;
147: if(stat(Xargv[0],&stbuf)==0) {
148: strcpy(myname,Xargv[0]);
149: return(stabf = myname);
150: }
151: }
152: for(;*cp;) {
153:
154: /* copy over current directory
155: and then append argv[0] */
156:
157: for(cp2=myname;(*cp)!=0 && (*cp)!=':';)
158: *cp2++ = *cp++;
159: *cp2++ = '/';
160: strcpy(cp2,Xargv[0]);
161: if(*cp) cp++;
162: if(0!=stat(myname,&stbuf)) continue;
163: return(stabf = myname);
164: }
165: error("Could not find which file is being executed.",FALSE);
166: } else return (stabf);
167: }
168:
169: static char mybuff[40];
170: char *
171: mytemp()
172: {
173: if(mypid==0) mypid = getpid();
174: sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed++);
175: return(mybuff);
176: }
177: ungstab()
178: {
179: seed--;
180: sprintf(mybuff,"/tmp/Li%d.%d",mypid,seed-1);
181: if(seed==0) {
182: stabf = 0;
183: fvirgin = 1;
184: }
185: }
186: lispval
187: verify(in,error)
188: register lispval in;
189: char *error;
190: {
191: for(EVER) {
192: switch(TYPE(in)) {
193: case STRNG:
194: return(in);
195: case ATOM:
196: return((lispval)in->a.pname);
197: }
198: in = errorh(Vermisc,error,nil,TRUE,0,in);
199: }
200: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.