![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam6.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 lam6.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2: FILE *
3: mkstFI(base,count,flag)
4: char *base;
5: char flag;
6: {
7: register FILE *p = stderr;
8:
9: /* find free file descriptor */
10: for(;p->_flag&(_IOREAD|_IOWRT);p++)
11: if(p >= _iob + _NFILE)
12: error("Too many open files to do readlist",FALSE);
13: p->_flag = _IOSTRG | flag;
14: p->_cnt = count;
15: p->_base = base;
16: p->_ptr = base;
17: p->_file = -1;
18: return(p);
19: }
20: lispval
21: Lreadli()
22: {
23: register lispval work, handy;
24: register FILE *p;
25: register char *string;
26: register struct argent *lbot, *np;
27: struct argent *olbot;
28: FILE *opiport = piport;
29: lispval Lread();
30: int count;
31:
32: chkarg(1);
33: if(lbot->val==nil) { /*effectively, return(matom(""));*/
34: strbuf[0] = 0;
35: return(getatom());
36: }
37: count = 1;
38:
39: /* compute length of list */
40: for(work = lbot->val; TYPE(work)==DTPR; work=work->cdr)
41: count++;
42: string = (char *) alloca(count);
43: p = mkstFI(string, count - 1, _IOREAD);
44: for(work = lbot->val; TYPE(work)==DTPR; work=work->cdr) {
45: handy = work->car;
46: switch(TYPE(handy)) {
47: case SDOT:
48: case INT:
49: *string++=handy->i;
50: break;
51: case ATOM:
52: *string++ = *(handy->pname);
53: break;
54: default:
55: error("Non atom or int to readlist",FALSE);
56: }
57: }
58: *string = 0;
59: olbot = lbot;
60: lbot = np;
61: protect(P(p));
62: work = Lread();
63: lbot = olbot;
64: frstFI(p);
65: return(work);
66: }
67: frstFI(p)
68: register FILE *p;
69: {
70: p->_flag=0;
71: p->_base=0;
72: p->_cnt = 0;
73: p->_ptr = 0;
74: p->_file = 0;
75: }
76: lispval
77: Lgetenv()
78: {
79: register struct argent *mylbot=lbot;
80: snpand(1);
81: if((TYPE(mylbot->val))!=ATOM)
82: error("argument to getenv must be atom",FALSE);
83:
84: strcpy(strbuf,getenv(mylbot->val->pname));
85: return(getatom());
86: }
87: lispval
88: Lboundp()
89: {
90: register struct argent *mynp=lbot;
91: register lispval result, handy;
92: snpand(3);
93:
94: if((TYPE(mynp->val))!=ATOM)
95: error("argument to boundp must be atom",FALSE);
96: if( (handy = mynp->val)->clb==CNIL)
97: result = nil;
98: else
99: (result = newdot())->cdr = handy->clb;
100: return(result);
101: }
102: lispval
103: Lplist()
104: {
105: register lispval atm;
106: snpand(0);
107: /* get property list of an atom or disembodied property list */
108:
109: chkarg(1);
110: atm = lbot->val;
111: switch(TYPE(atm)) {
112: case ATOM:
113: case DTPR:
114: break;
115: default:
116: error("Only Atoms and disembodied property lists allowed for plist",FALSE);
117: }
118: if(atm==nil) return(nilplist);
119: return(atm->plist);
120: }
121: lispval
122: Lsetpli()
123: { /* set the property list of the given atom to the given list */
124: register lispval atm, vall;
125: register lispval dum1, dum2;
126: register struct argent *lbot, *np;
127: snpand(2);
128:
129: chkarg(2);
130: atm = lbot->val;
131: if (TYPE(atm) != ATOM) error("First argument must be an atom",FALSE);
132: vall = (np-1)->val;
133: if (TYPE(vall)!= DTPR && vall !=nil)
134: error("Second argument must be a list",FALSE);
135: if (atm==nil)
136: nilplist = vall;
137: else
138: atm->plist = vall;
139: return(vall);
140: }
141:
142: lispval
143: Lsignal()
144: {
145: register struct argent *mylbot = lbot;
146: extern lispval sigacts[16];
147: int i; register lispval handy, old;
148: chkarg(2);
149:
150: handy = mylbot[AD].val;
151: if(TYPE(handy)!=INT)
152: error("First arg to signal must be an int",FALSE);
153: i = handy->i & 15;
154: handy = mylbot[AD+1].val;
155: if(TYPE(handy)!=ATOM)
156: error("Second arg to signal must be an atom",FALSE);
157: old = sigacts[i];
158: if(old==0) old = nil;
159: if(handy==nil)
160: sigacts[i]=((lispval) 0);
161: else
162: sigacts[i]=handy;
163: return(old);
164: }
165: lispval
166: Lassq()
167: {
168: register lispval work, handy, dum1, dum2;
169: register struct argent *lbot, *np;
170: snpand(2);
171:
172: chkarg(2);
173: for(work = lbot[AD+1].val;
174: work->car->car!=lbot->val&& work!=nil;
175: work = work->cdr);
176: return(work->car);
177: }
178: lispval
179: Lkilcopy()
180: {
181: if(fork()==0) {
182: asm(".byte 0");
183: }
184: }
185: lispval
186: Larg()
187: {
188: register lispval handy; register offset, count;
189: snpand(3);
190:
191: handy = lexpr_atom->clb;
192: if(handy==CNIL || TYPE(handy)!=DTPR)
193: error("Arg: not in context of Lexpr.",FALSE);
194: count = ((long *)handy->cdr) - (long *)handy->car;
195: if(np==lbot || lbot->val==nil)
196: return(inewint(count));
197: if(TYPE(lbot->val)!=INT || (offset = lbot->val->i - 1) > count || offset < 0 )
198: error("Out of bonds: arg to \"Arg\"",FALSE);
199: return( ((struct argent *)handy->car)[offset].val);
200: }
201: lispval
202: Lptime(){
203: extern int GCtime;
204: int lgctime = GCtime;
205: static struct tbuf {
206: long mytime;
207: long allelse[3];
208: } current;
209: register lispval result, handy;
210:
211: snpand(2);
212: times(¤t);
213: result = newdot();
214: handy = result;
215: protect(result);
216: result->cdr = newdot();
217: result->car = inewint(current.mytime);
218: handy = result->cdr;
219: handy->car = inewint(lgctime);
220: handy->cdr = nil;
221: if(GCtime==0)
222: GCtime = 1;
223: return(result);
224: }
225:
226: /* (err [value] [flag])
227: where if value is present, it is the value to throw to the errset.
228: flag if present must evaluate to nil, as we always evaluate value
229: before unwinding stack
230: */
231:
232: lispval Lerr()
233: {
234: register lispval handy;
235: lispval errorh();
236: char *mesg = "call to err"; /* default message */
237:
238: chkarg(1);
239:
240: if ((np >= lbot + 2) && ((lbot+1)->val != nil))
241: error("Second arg to err must be nil",FALSE);
242: if ((lbot->val != nil) && (TYPE(lbot->val) == ATOM))
243: mesg = lbot->val->pname; /* new message if atom */
244:
245: return(errorh(Vererr,mesg,lbot->val,nil));
246: }
247: lispval
248: Ltyi()
249: {
250: register FILE *port;
251: register char val;
252:
253: chkarg(1);
254: port = okport(lbot->val,okport(Vpiport->clb,stdin));
255:
256:
257: fflush(stdout); /* flush any pending output characters */
258: val = getc(port);
259: return(inewint(val));
260: }
261: lispval
262: Ltyipeek()
263: {
264: register FILE *port;
265: register char val;
266:
267: chkarg(1);
268: port = okport(lbot->val,okport(Vpiport->clb,stdin));
269:
270: fflush(stdout); /* flush any pending output characters */
271: val = getc(port);
272: ungetc(val,port);
273: return(inewint(val));
274: }
275: lispval
276: Ltyo()
277: {
278: register FILE *port;
279: register lispval handy, where;
280: register char val;
281: register struct argent *lbot, *np;
282:
283: chkarg(2);
284: handy = lbot->val;
285: if(TYPE(handy)!=INT)
286: error("Tyo demands number for 1st arg",FALSE);
287: val = handy->i;
288:
289: where = lbot[1].val;
290: port = (FILE *) okport(where,okport(Vpoport->clb,stdout));
291: putc(val,port);
292: return(handy);
293: }
294: lispval
295: Imkrtab(current)
296: {
297: extern struct rtab {
298: char ctable[132];
299: } initread;
300: register lispval handy; extern lispval lastrtab;
301: static int cycle = 0;
302: static char *nextfree;
303: if((cycle++)%3==0) {
304: nextfree = (char *) csegment(int_name,128);
305: }
306: handy = newarray();
307: handy->data = nextfree;
308: if(current == 0)
309: *(struct rtab *)nextfree = initread;
310: else
311: *(struct rtab *)nextfree = *(struct rtab *)ctable;
312: handy->delta = inewint(4);
313: handy->length = inewint(sizeof(struct rtab)/sizeof(int));
314: handy->accfun = handy->aux = nil;
315: nextfree += sizeof(struct rtab);
316: return(handy);
317: }
318:
319: /* makereadtable - arg : t or nil
320: returns a readtable, t means return a copy of the initial readtable
321:
322: nil means return a copy of the current readtable
323: */
324: lispval
325: Lmakertbl()
326: {
327: if(lbot==np) error("makereadtable: wrong number of args",FALSE);
328:
329: if(TYPE(lbot->val) != ATOM)
330: error("makereadtable: arg must be atom",FALSE);
331:
332: if(lbot->val == nil) return(Imkrtab(1));
333: else return(Imkrtab(0));
334: }
335: lispval
336: Lcpy1()
337: {
338: register lispval handy = lbot->val, result = handy;
339:
340: top:
341: switch(TYPE(handy))
342: {
343: case INT:
344: result = inewint(handy->i);
345: break;
346: case VALUE:
347: (result = newval())->l = handy->l;
348: break;
349: case DOUB:
350: (result = newdoub())->r = handy->r;
351: break;
352: default:
353: lbot->val =
354: errorh(Vermisc,"Bad arg to cpy1",nil,TRUE,67,handy);
355: goto top;
356: }
357: return(result);
358: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.