BSD 3 development
[unix-history] / usr / src / cmd / lisp / ffasl.c
CommitLineData
8cd657f4
JF
1#include "global.h"
2#include <a.out.h>
3#define round(x,s) ((((x)-1) & ~((s)-1)) + (s))
4
5char *stabf = 0;
6int fvirgin = 1;
7
8lispval
9Lffasl(){
10 register struct argent *mlbot = lbot;
11 register lispval work;
12 int fildes, totsize, readsize;
13 lispval csegment();
14 char *sbrk(), *currend, *tfile, cbuf[512], *mytemp(), *gstab();
15 struct exec header;
16 snpand(2);
17
18 if(np - mlbot != 3 || TYPE(mlbot[1].val)!=ATOM)
19 mlbot[1].val = error("Incorrect .o file specification",TRUE);
20 if(np - mlbot != 3 || TYPE(mlbot[2].val)!=ATOM)
21 mlbot[2].val = error("Incorrect entry specification for fasl"
22 ,TRUE);
23 if(np - mlbot != 3 || TYPE(mlbot[3].val)!=ATOM || mlbot[3].val==nil)
24 mlbot[3].val = error( "Bad associated atom name for fasl",TRUE);
25
26 /*
27 * Invoke loader.
28 */
29 currend = sbrk(0);
30 tfile = mytemp();
31 sprintf(cbuf,
32 "nld -A %s -T %x -N %s -e %s -o %s",
33 gstab(),
34 currend,
35 mlbot[1].val->pname,
36 mlbot[2].val->pname,
37 tfile);
38 printf(cbuf); fflush(stdout);
39 if(system(cbuf)!=0) {
40 unlink(tfile);
41 return(nil);
42 }
43 if(fvirgin)
44 fvirgin = 0;
45 else
46 unlink(stabf);
47 stabf = tfile;
48 if((fildes = open(tfile,0))<0)
49 return(nil);
50 /*
51 * Read a.out header to find out how much room to
52 * allocate and attempt to do so.
53 */
54 if(read(fildes,(char *)&header,sizeof(header)) <= 0) {
55 close(fildes);
56 return(nil);
57 }
58 readsize = header.a_text + header.a_data;
59 totsize = readsize + header.a_bss;
60 totsize = round(totsize,512);
61 /*
62 * Fix up system indicators, typing info, etc.
63 */
64 currend = (char *)csegment(int_name,totsize/4);
65
66 if(readsize!=read(fildes,currend,readsize))
67 return(nil);
68 work = newfunct();
69 work->entry = (lispval (*)())header.a_entry;
70 work->discipline = lambda;
71 return(mlbot[3].val->fnbnd = work);
72}
73#include "types.h"
74#include <sys/stat.h>
75static char myname[100];
76char *
77gstab()
78{
79 register char *cp, *cp2; char *getenv();
80 struct stat stbuf;
81 extern char **Xargv;
82
83 if(stabf==0) {
84 cp = getenv("PATH");
85 if(cp==0)
86 cp=":/usr/ucb:/bin:/usr/bin";
87 if(*cp==':') {
88 cp++;
89 if(stat(Xargv[0],&stbuf)==0) {
90 strcpy(myname,Xargv[0]);
91 return(stabf = myname);
92 }
93 }
94 for(;*cp;) {
95
96 /* copy over current directory
97 and then append argv[0] */
98
99 for(cp2=myname;(*cp)!=0 && (*cp)!=':';)
100 *cp2++ = *cp++;
101 *cp2++ = '/';
102 strcpy(cp2,Xargv[0]);
103 if(*cp) cp++;
104 if(0!=stat(myname,&stbuf)) continue;
105 return(stabf = myname);
106 }
107 error("Could not find which file is being executed.",FALSE);
108 } else return (stabf);
109}