![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam7.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 lam7.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2:
3: lispval
4: Lfork() {
5: register lispval temp;
6: int pid;
7:
8: chkarg(0);
9: if ((pid=fork())) {
10: temp = newint();
11: temp->i = pid;
12: return(temp);
13: } else
14: return(nil);
15: }
16:
17: lispval
18: Lwait()
19: {
20: register lispval ret, temp;
21: int status = -1, pid;
22: snpand(2);
23:
24:
25: chkarg(0);
26: pid = wait(&status);
27: ret = newdot();
28: protect(ret);
29: temp = newint();
30: temp->i = pid;
31: ret->car = temp;
32: temp = newint();
33: temp->i = status;
34: ret->cdr = temp;
35: return(ret);
36: }
37:
38: lispval
39: Lpipe()
40: {
41: register lispval ret, temp;
42: int pipes[2];
43:
44: chkarg(0);
45: pipes[0] = -1;
46: pipes[1] = -1;
47: pipe(pipes);
48: ret = newdot();
49: protect(ret);
50: temp = newint();
51: temp->i = pipes[0];
52: ret->car = temp;
53: temp = newint();
54: temp->i = pipes[1];
55: ret->cdr = temp;
56: return(ret);
57: }
58:
59: lispval
60: Lfdopen()
61: {
62: register lispval fd, type;
63: FILE *ptr;
64:
65: chkarg(2);
66: type = (np-1)->val;
67: fd = lbot->val;
68: if( TYPE(fd)!=INT )
69: return(nil);
70: if ( (ptr=fdopen((int)fd->i, (char *)type->a.pname))==NULL)
71: return(nil);
72: return(P(ptr));
73: }
74:
75: lispval
76: Lexece()
77: {
78: lispval fname, arglist, envlist, temp;
79: char *args[100], *envs[100], estrs[1024];
80: char *p, *cp, **sp;
81: snpand(0);
82:
83: chkarg(3);
84: envlist = (--np)->val;
85: arglist = (--np)->val;
86: fname = (--np)->val;
87: if (TYPE(fname)!=ATOM)
88: return(nil);
89: if (TYPE(arglist)!=DTPR && arglist!=nil)
90: return(nil);
91: for (sp=args; arglist!=nil; arglist=arglist->d.cdr) {
92: temp = arglist->d.car;
93: if (TYPE(temp)!=ATOM)
94: return(nil);
95: *sp++ = temp->a.pname;
96: }
97: *sp = 0;
98: if (TYPE(envlist)!=DTPR && envlist!=nil)
99: return(nil);
100: for (sp=envs,cp=estrs; envlist!=nil; envlist=envlist->d.cdr) {
101: temp = envlist->d.car;
102: if (TYPE(temp)!=DTPR || TYPE(temp->d.car)!=ATOM
103: || TYPE(temp->d.cdr)!=ATOM)
104: return(nil);
105: *sp++ = cp;
106: for (p=temp->d.car->a.pname; (*cp++ = *p++);) ;
107: *(cp-1) = '=';
108: for (p=temp->d.cdr->a.pname; (*cp++ = *p++);) ;
109: }
110: *sp = 0;
111: execve(fname->a.pname, args, envs);
112: return(nil);
113: }
114:
115: lispval
116: Lgensym()
117: {
118: lispval arg;
119: char leader;
120: static int counter = 0;
121:
122: chkarg(1);
123: arg = lbot->val;
124: leader = 'g';
125: if (arg != nil && TYPE(arg)==ATOM)
126: leader = arg->a.pname[0];
127: sprintf(strbuf, "%c%05d", leader, counter++);
128: atmlen = 7;
129: return((lispval)newatom());
130: }
131: extern struct types {
132: char *next_free;
133: int space_left,
134: space,
135: type,
136: type_len; /* note type_len is in units of int */
137: lispval *items,
138: *pages,
139: *type_name;
140: struct heads
141: *first;
142: } atom_str ;
143:
144: lispval
145: Lremprop()
146: {
147: register struct argent *argp;
148: register lispval pptr, ind, opptr;
149: register struct argent *lbot, *np;
150: lispval atm;
151: int disemp = FALSE;
152:
153: chkarg(2);
154: argp = lbot;
155: ind = argp[1].val;
156: atm = argp->val;
157: switch (TYPE(atm)) {
158: case DTPR:
159: pptr = atm->cdr;
160: disemp = TRUE;
161: break;
162: case ATOM:
163: if((lispval)atm==nil)
164: pptr = nilplist;
165: else
166: pptr = atm->plist;
167: break;
168: default:
169: errorh(Vermisc, "remprop: Illegal first argument :",
170: nil, FALSE, 0, atm);
171: }
172: opptr = nil;
173: if (pptr==nil)
174: return(nil);
175: while(TRUE) {
176: if (TYPE(pptr->cdr)!=DTPR)
177: errorh(Vermisc, "remprop: Bad property list",
178: nil, FALSE, 0,atm);
179: if (pptr->car == ind) {
180: if( opptr != nil)
181: opptr->cdr = pptr->cdr->cdr;
182: else if(disemp)
183: atm->cdr = pptr->cdr->cdr;
184: else if(atm==nil)
185: nilplist = pptr->cdr->cdr;
186: else
187: atm->plist = pptr->cdr->cdr;
188: return(pptr->cdr);
189: }
190: if ((pptr->cdr)->cdr == nil) return(nil);
191: opptr = pptr->cdr;
192: pptr = (pptr->cdr)->cdr;
193: }
194: }
195:
196: lispval
197: Lbcdad()
198: {
199: lispval ret, temp;
200:
201: chkarg(1);
202: temp = lbot->val;
203: if (TYPE(temp)!=ATOM)
204: error("ONLY ATOMS HAVE FUNCTION BINDINGS", FALSE);
205: temp = temp->fnbnd;
206: if (TYPE(temp)!=BCD)
207: return(nil);
208: ret = newint();
209: ret->i = (int)temp;
210: return(ret);
211: }
212:
213: lispval
214: Lstringp()
215: {
216: chkarg(1);
217: if (TYPE(lbot->val)==STRNG)
218: return(tatom);
219: return(nil);
220: }
221:
222: lispval
223: Lsymbolp()
224: {
225: chkarg(1);
226: if (TYPE(lbot->val)==ATOM)
227: return(tatom);
228: return(nil);
229: }
230:
231: lispval
232: Lrematom()
233: {
234: register lispval temp;
235:
236: chkarg(1);
237: temp = lbot->val;
238: if (TYPE(temp)!=ATOM)
239: return(nil);
240: temp->a.fnbnd = nil;
241: temp->a.pname = (char *)CNIL;
242: temp->a.plist = nil;
243: (atom_items->i)--;
244: (atom_str.space_left)++;
245: temp->a.clb=(lispval)atom_str.next_free;
246: atom_str.next_free=(char *) temp;
247: return(tatom);
248: }
249:
250: #define QUTMASK 0200
251: #define VNUM 0000
252:
253: lispval
254: Lprname()
255: {
256: lispval a, ret;
257: register lispval work, prev;
258: char *front, *temp; int clean;
259: char ctemp[100];
260: extern char *ctable;
261: snpand(2);
262:
263: chkarg(1);
264: a = lbot->val;
265: switch (TYPE(a)) {
266: case INT:
267: sprintf(ctemp,"%d",a->i);
268: break;
269:
270: case DOUB:
271: sprintf(ctemp,"%f",a->r);
272: break;
273:
274: case ATOM:
275: temp = front = a->pname;
276: clean = *temp;
277: if (*temp == '-') temp++;
278: clean = clean && (ctable[*temp] != VNUM);
279: while (clean && *temp)
280: clean = (!(ctable[*temp++] & QUTMASK));
281: if (clean)
282: strcpyn(ctemp, front, 99);
283: else
284: sprintf(ctemp,"\"%s\"",front);
285: break;
286:
287: default:
288: error("prname does not support this type", FALSE);
289: }
290: temp = ctemp;
291: protect(ret = prev = newdot());
292: while (*temp) {
293: prev->cdr = work = newdot();
294: strbuf[0] = *temp++;
295: strbuf[1] = 0;
296: work->car = getatom();
297: work->cdr = nil;
298: prev = work;
299: }
300: return(ret->cdr);
301: }
302: Lexit()
303: {
304: register lispval handy;
305: if(np-lbot==0) exit(0);
306: handy = lbot->val;
307: if(TYPE(handy)==INT)
308: exit(handy->i);
309: exit(-1);
310: }
311: lispval
312: Iimplode(unintern)
313: {
314: register lispval handy, work;
315: register char *cp = strbuf;
316: extern int atmlen; /* used by newatom and getatom */
317:
318: chkarg(1);
319: for(handy = lbot->val; handy!=nil; handy = handy->cdr)
320: {
321: work = handy->car;
322: if(cp >= endstrb)
323: errorh(Vermisc,"maknam/impode argument exceeds buffer",nil,FALSE,43,lbot->val);
324: again:
325: switch(TYPE(work))
326: {
327: case ATOM:
328: *cp++ = work->pname[0];
329: break;
330: case SDOT:
331: case INT:
332: *cp++ = work->i;
333: break;
334: case STRNG:
335: *cp++ = * (char *) work;
336: break;
337: default:
338: work = errorh(Vermisc,"implode/maknam: Illegal type for this arg:",nil,FALSE,44,work);
339: goto again;
340: }
341: }
342: *cp = 0;
343: if(unintern) return((lispval)newatom());
344: else return((lispval) getatom());
345: }
346:
347: lispval
348: Lmaknam()
349: {
350: return(Iimplode(TRUE)); /* unintern result */
351: }
352:
353: lispval
354: Limplode()
355: {
356: return(Iimplode(FALSE)); /* intern result */
357: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.