![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lmisc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx|
Return to lmisc.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 root 1: /*
2: * File: lmisc.c
3: * Contents: create, keywd, limit, llist
4: */
5:
6: #include "../h/rt.h"
7: #include "../h/keyword.h"
8: #include "../h/version.h"
9:
10: #ifndef VMS
11: #ifndef MSDOS
12: #include <sys/types.h>
13: #include <sys/times.h>
14: #include SysTime
15: #else MSDOS
16:
17: #ifdef LATTICE
18: #include <time.h>
19: #endif LATTICE
20: #ifdef MSoft
21: #include <sys/types.h>
22: #include <time.h>
23: #endif MSoft
24: #endif MSDOS
25:
26: #else VMS
27: #include <types.h>
28: #include <time.h>
29: struct tms {
30: time_t tms_utime; /* user time */
31: time_t tms_stime; /* system time */
32: time_t tms_cutime; /* user time, children */
33: time_t tms_cstime; /* system time, children */
34: };
35: #endif VMS
36:
37: /*
38: * create - return an entry block for a co-expression.
39: */
40:
41: OpBlock(create, 1, "create", 0)
42:
43: create(entryp, cargp)
44: word *entryp;
45: register struct descrip *cargp;
46: {
47: register struct b_coexpr *sblkp;
48: register struct b_refresh *rblkp;
49: register struct descrip *dp, *ndp, *dsp;
50: register word *newsp;
51: int na, nl, i;
52: struct b_proc *cproc;
53: extern struct b_coexpr *alcstk();
54: extern struct b_refresh *alceblk();
55:
56: /*
57: * Get a new co-expression stack and initialize.
58: */
59: sblkp = alcstk();
60: sblkp->activator = nulldesc;
61: sblkp->size = 0;
62: sblkp->nextstk = stklist;
63: stklist = sblkp;
64: /*
65: * Icon stack starts at word after co-expression stack block. C stack
66: * starts at end of stack region on machines with down-growing C stacks
67: * and somewhere in the middle of the region.
68: *
69: * The C stack is aligned on a doubleword boundary. For upgrowing
70: * stacks, the C stack starts in the middle of the stack portion
71: * of the static block. For downgrowing stacks, the C stack starts
72: * at the end of the static block.
73: */
74: newsp = (word *)((char *)sblkp + sizeof(struct b_coexpr));
75: #ifdef UpStack
76: sblkp->cstate[0] =
77: ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2)
78: &~(WordSize*2-1));
79: #else
80: sblkp->cstate[0] =
81: ((word)((char *)sblkp + stksize - WordSize)&~(WordSize*2-1));
82: #endif UpStack
83: sblkp->es_argp = (struct descrip *)newsp;
84: /*
85: * Calculate number of arguments and number of local variables.
86: * na is nargs + 1 to include Arg0.
87: */
88: na = pfp->pf_nargs + 1;
89: cproc = (struct b_proc *)BlkLoc(argp[0]);
90: nl = cproc->ndynam;
91:
92: /*
93: * Get a refresh block for the new co-expression.
94: */
95: blkreq((word)sizeof(struct b_refresh) + (na + nl) * sizeof(struct descrip));
96: rblkp = alceblk(entryp, na, nl);
97: sblkp->freshblk.dword = D_Refresh;
98: BlkLoc(sblkp->freshblk) = (union block *) rblkp;
99:
100: /*
101: * Copy current procedure frame marker into refresh block.
102: */
103: rblkp->pfmkr = *pfp;
104: rblkp->pfmkr.pf_pfp = 0;
105:
106: /*
107: * Copy arguments into refresh block and onto new stack.
108: */
109: dp = &argp[0];
110: ndp = &rblkp->elems[0];
111: dsp = (struct descrip *)newsp;
112: for (i = 1; i <= na; i++) {
113: *dsp++ = *dp;
114: *ndp++ = *dp++;
115: }
116:
117: /*
118: * Copy procedure frame to new stack and point dsp to word after frame.
119: */
120: *((struct pf_marker *)dsp) = *pfp;
121: sblkp->es_pfp = (struct pf_marker *)dsp;
122: sblkp->es_pfp->pf_pfp = 0;
123: dsp = (struct descrip *)((word *)dsp + Vwsizeof(*pfp));
124: sblkp->es_ipc = entryp;
125: sblkp->es_gfp = 0;
126: sblkp->es_efp = 0;
127: sblkp->es_ilevel = 0;
128: sblkp->tvalloc = NULL;
129:
130: /*
131: * Copy locals to new stack and refresh block.
132: */
133: dp = &(pfp->pf_locals)[0];
134: for (i = 1; i <= nl; i++) {
135: *dsp++ = *dp;
136: *ndp++ = *dp++;
137: }
138: /*
139: * Push two null descriptors on the stack.
140: */
141: *dsp++ = nulldesc;
142: *dsp++ = nulldesc;
143:
144: sblkp->es_sp = (word *)dsp - 1;
145:
146: /*
147: * Establish line and file values and clear location for transmitted value.
148: */
149: sblkp->es_line = line;
150:
151: /*
152: * Return the new co-expression.
153: */
154: Arg0.dword = D_Coexpr;
155: BlkLoc(Arg0) = (union block *) sblkp;
156: Return;
157: }
158:
159: static char *day[] = {
160: "Sunday", "Monday", "Tuesday", "Wednesday",
161: "Thursday", "Friday", "Saturday"
162: };
163:
164: static char *month[] = {
165: "January", "February", "March", "April", "May", "June",
166: "July", "August", "September", "October", "November", "December"
167: };
168:
169: /*
170: * keywd - process keyword.
171: */
172:
173: LibDcl(keywd,0,"&keywd")
174: {
175: register int hour;
176: register word i;
177: register char *merid;
178: char sbuf[MaxCvtLen];
179: struct tm *tbuf, *localtime();
180: #ifndef MSDOS
181: struct tms tp;
182: #endif MSDOS
183: long time();
184: long clock, runtim;
185: char *alcstr();
186:
187: /*
188: * This is just plug and chug code. For whatever keyword is desired,
189: * the appropriate value is dug out of the system and made into
190: * a suitable Icon value.
191: *
192: * A few special cases are worth noting:
193: * &pos, &random, &trace - built-in trapped variables are returned
194: */
195: switch (IntVal(Arg0)) {
196: case K_ASCII:
197: Arg0.dword = D_Cset;
198: BlkLoc(Arg0) = (union block *) &k_ascii;
199: break;
200: case K_CLOCK:
201: strreq((word)8);
202: time(&clock);
203: tbuf = localtime(&clock);
204: sprintf(sbuf,"%02d:%02d:%02d",tbuf->tm_hour,tbuf->tm_min,tbuf->tm_sec);
205: StrLen(Arg0) = 8;
206: StrLoc(Arg0) = alcstr(sbuf,(word)8);
207: break;
208: case K_CSET:
209: Arg0.dword = D_Cset;
210: BlkLoc(Arg0) = (union block *) &k_cset;
211: break;
212: case K_DATE:
213: strreq((word)10);
214: time(&clock);
215: tbuf = localtime(&clock);
216: sprintf(sbuf, "%04d/%02d/%02d",
217: (tbuf->tm_year)+1900,tbuf->tm_mon+1,tbuf->tm_mday);
218: StrLen(Arg0) = 10;
219: StrLoc(Arg0) = alcstr(sbuf,(word)10);
220: break;
221: case K_DATELINE:
222: time(&clock);
223: tbuf = localtime(&clock);
224: if ((hour = tbuf->tm_hour) >= 12) {
225: merid = "pm";
226: if (hour > 12)
227: hour -= 12;
228: }
229: else {
230: merid = "am";
231: if (hour < 1)
232: hour += 12;
233: }
234: sprintf(sbuf, "%s, %s %d, %d %d:%02d %s",
235: day[tbuf->tm_wday], month[tbuf->tm_mon], tbuf->tm_mday,
236: 1900 + tbuf->tm_year, hour, tbuf->tm_min, merid);
237: strreq(i = strlen(sbuf));
238: StrLen(Arg0) = i;
239: StrLoc(Arg0) = alcstr(sbuf, i);
240: break;
241: case K_ERROUT:
242: Arg0.dword = D_File;
243: BlkLoc(Arg0) = (union block *) &k_errout;
244: break;
245: case K_HOST:
246: iconhost(sbuf);
247: strreq(i = strlen(sbuf));
248: StrLen(Arg0) = i;
249: StrLoc(Arg0) = alcstr(sbuf, i);
250: break;
251: case K_INPUT:
252: Arg0.dword = D_File;
253: BlkLoc(Arg0) = (union block *) &k_input;
254: break;
255: case K_LCASE:
256: Arg0.dword = D_Cset;
257: BlkLoc(Arg0) = (union block *) &k_lcase;
258: break;
259: case K_LEVEL:
260: Arg0.dword = D_Integer;
261: IntVal(Arg0) = k_level;
262: break;
263: case K_MAIN:
264: Arg0 = k_main;
265: break;
266: case K_OUTPUT:
267: Arg0.dword = D_File;
268: BlkLoc(Arg0) = (union block *) &k_output;
269: break;
270: case K_POS:
271: Arg0.dword = D_Tvkywd;
272: BlkLoc(Arg0) = (union block *) &tvky_pos;
273: break;
274: case K_RANDOM:
275: Arg0.dword = D_Tvkywd;
276: BlkLoc(Arg0) = (union block *) &tvky_ran;
277: break;
278: case K_SOURCE:
279: Arg0 = BlkLoc(current)->coexpr.activator;
280: break;
281: case K_SUBJECT:
282: Arg0.dword = D_Tvkywd;
283: BlkLoc(Arg0) = (union block *) &tvky_sub;
284: break;
285: case K_TIME:
286: #ifndef MSDOS
287: times(&tp);
288: runtim =
289: 1000 * ((tp.tms_utime - starttime) / (double)Hz);
290: #else MSDOS
291: runtim = time() - starttime;
292: #endif MSDOS
293: Mkint(runtim, &Arg0);
294: break;
295: case K_TRACE:
296: Arg0.dword = D_Tvkywd;
297: BlkLoc(Arg0) = (union block *) &tvky_trc;
298: break;
299: case K_UCASE:
300: Arg0.dword = D_Cset;
301: BlkLoc(Arg0) = (union block *) &k_ucase;
302: break;
303: case K_VERSION:
304: strreq(i = strlen(VERSION));
305: StrLen(Arg0) = i;
306: StrLoc(Arg0) = VERSION;
307: break;
308: default:
309: syserr("keyword: unknown keyword type.");
310: }
311: Return;
312: }
313:
314:
315: /*
316: * limit - explicit limitation initialization.
317: */
318:
319: LibDcl(limit,0,"limit")
320: {
321: long l;
322:
323: /*
324: * The limit is both passed and returned in Arg0. The limit must
325: * be an integer. If the limit is 0, the expression being evaluated
326: * fails. If the limit is < 0, it is an error. Note that the
327: * result produced by limit is ultimately picked up by the lsusp
328: * function.
329: */
330: DeRef(Arg0);
331: switch (cvint(&Arg0, &l)) {
332:
333: case T_Integer:
334: Mkint(l, &Arg0);
335: break;
336:
337: case T_Longint:
338: runerr(205, &Arg0);
339:
340: default:
341: runerr(101, &Arg0);
342: }
343:
344: if (l < 0)
345: runerr(205, &Arg0);
346: if (l == 0)
347: Fail;
348: Return;
349: }
350:
351:
352: /*
353: * [ ... ] - create an explicitly specified list.
354: */
355:
356: LibDcl(llist,-1,"[...]")
357: {
358: register word i;
359: register struct b_list *hp;
360: register struct b_lelem *bp;
361: extern struct b_list *alclist();
362: extern struct b_lelem *alclstb();
363: word nelem;
364:
365: /*
366: * Round the number of elements in the list (as indicated by nargs)
367: * up to MinListSlots and ensure space for the list.
368: */
369: nelem = nargs;
370: if (nelem < MinListSlots)
371: nelem = MinListSlots;
372: blkreq((word)sizeof(struct b_list) + sizeof(struct b_lelem) +
373: nelem * sizeof(struct descrip));
374:
375: /*
376: * Allocate the list and a list block.
377: */
378: hp = alclist((word)nargs);
379: bp = alclstb(nelem, (word)0, (word)nargs);
380:
381: /*
382: * Make the list block just allocated into the first and last blocks
383: * for the list.
384: */
385: hp->listhead.dword = hp->listtail.dword = D_Lelem;
386: BlkLoc(hp->listhead) = BlkLoc(hp->listtail) = (union block *) bp;
387: /*
388: * Dereference each argument in turn and assign it to a list element.
389: */
390: for (i = 1; i <= nargs; i++) {
391: DeRef(Arg(i));
392: bp->lslots[i-1] = Arg(i);
393: }
394: /*
395: * Point Arg0 at the new list and return it.
396: */
397: ArgType(0) = D_List;
398: Arg(0).vword.bptr = (union block *)hp;
399: Return;
400: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.