![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fstranl.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 fstranl.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 root 1: /*
2: * File: fstranl.c
3: * Contents: any, bal, find, many, match, move, pos, tab, upto
4: */
5:
6: #include "../h/rt.h"
7:
8: /*
9: * any(c,s,i,j) - test if first character of s[i:j] is in c.
10: */
11:
12: FncDcl(any,4)
13: {
14: register word i, j;
15: long l1, l2;
16: int *cs, csbuf[CsetSize];
17: char sbuf[MaxCvtLen];
18:
19: /*
20: * c must be a cset. s defaults to &subject; i defaults to &pos if s
21: * defaulted, 1 otherwise. j defaults to 0.
22: */
23: if (cvcset(&Arg1, &cs, csbuf) == NULL)
24: runerr(104, &Arg1);
25: if (defstr(&Arg2, sbuf, &k_subject))
26: defint(&Arg3, &l1, k_pos);
27: else
28: defint(&Arg3, &l1, (word)1);
29: defint(&Arg4, &l2, (word)0);
30:
31: /*
32: * Convert i and j to positions in s. If i == j then the specified
33: * substring of s is empty and any fails. Otherwise make i the smaller of
34: * the two. (j is of no further use.)
35: */
36: i = cvpos(l1, StrLen(Arg2));
37: if (i == 0)
38: Fail;
39: j = cvpos(l2, StrLen(Arg2));
40: if (j == 0)
41: Fail;
42: if (i == j)
43: Fail;
44: if (i > j)
45: i = j;
46:
47: /*
48: * If s[i] is not in the cset c, fail.
49: */
50: if (!Testb(StrLoc(Arg2)[i-1], cs))
51: Fail;
52:
53: /*
54: * Return pos(s[i+1]).
55: */
56: Arg0.dword = D_Integer;
57: IntVal(Arg0) = i + 1;
58: Return;
59: }
60:
61:
62: /*
63: * bal(c1,c2,c3,s,i,j) - find end of a balanced substring of s[i:j].
64: * Generates successive positions.
65: */
66:
67: FncDcl(bal,6)
68: {
69: register word i, j;
70: register cnt, c;
71: word t;
72: long l1, l2;
73: int *cs1, *cs2, *cs3;
74: int csbuf1[CsetSize], csbuf2[CsetSize], csbuf3[CsetSize];
75: char sbuf[MaxCvtLen];
76: static int lpar[CsetSize] = /* '(' */
77: cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
78: static int rpar[CsetSize] = /* ')' */
79: cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
80:
81: /*
82: * c1 defaults to &cset; c2 defaults to '(' (lpar); c3 defaults to
83: * ')' (rpar); s to &subject; i to &pos if s defaulted, 1 otherwise;
84: * j defaults to 0.
85: */
86: defcset(&Arg1, &cs1, csbuf1, k_cset.bits);
87: defcset(&Arg2, &cs2, csbuf2, lpar);
88: defcset(&Arg3, &cs3, csbuf3, rpar);
89: if (defstr(&Arg4, sbuf, &k_subject))
90: defint(&Arg5, &l1, k_pos);
91: else
92: defint(&Arg5, &l1, (word)1);
93: defint(&Arg6, &l2, (word)0);
94:
95: /*
96: * Convert i and j to positions in s and order them.
97: */
98: i = cvpos(l1, StrLen(Arg4));
99: if (i == 0)
100: Fail;
101: j = cvpos(l2, StrLen(Arg4));
102: if (j == 0)
103: Fail;
104: if (i > j) {
105: t = i;
106: i = j;
107: j = t;
108: }
109:
110: /*
111: * Loop through characters in s[i:j]. When a character in cs2 is
112: * found, increment cnt; when a chracter in cs3 is found, decrement
113: * cnt. When cnt is 0 there have been an equal number of occurrences
114: * of characters in cs2 and cs3, i.e., the string to the left of
115: * i is balanced. If the string is balanced and the current character
116: * (s[i]) is in c1, suspend i. Note that if cnt drops below zero,
117: * bal fails.
118: */
119: cnt = 0;
120: Arg0.dword = D_Integer;
121: while (i < j) {
122: c = StrLoc(Arg4)[i-1];
123: if (cnt == 0 && Testb(c, cs1)) {
124: IntVal(Arg0) = i;
125: Suspend;
126: }
127: if (Testb(c, cs2))
128: cnt++;
129: else if (Testb(c, cs3))
130: cnt--;
131: if (cnt < 0)
132: Fail;
133: i++;
134: }
135: /*
136: * Eventually fail.
137: */
138: Fail;
139: }
140:
141:
142: /*
143: * find(s1,s2,i,j) - find string s1 in s2[i:j] and return position in
144: * s2 of beginning of s1.
145: * Generates successive positions.
146: */
147:
148: /* >find */
149: FncDcl(find,4)
150: {
151: register word l;
152: register char *s1, *s2;
153: word i, j, t;
154: long l1, l2;
155: char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
156:
157: /*
158: * Arg1 must be a string. Arg2 defaults to &subject; Arg3 defaults
159: * to &pos if Arg2 is defaulted, or to 1 otherwise; Arg4 defaults
160: * to 0.
161:
162: */
163: if (cvstr(&Arg1, sbuf1) == NULL)
164: runerr(103, &Arg1);
165: if (defstr(&Arg2, sbuf2, &k_subject))
166: defint(&Arg3, &l1, k_pos);
167: else
168: defint(&Arg3, &l1, (word)1);
169: defint(&Arg4, &l2, (word)0);
170:
171: /*
172: * Convert i and j to absolute positions in s2 and order them
173: * so that i <= j.
174: */
175: i = cvpos(l1, StrLen(Arg2));
176: if (i == 0)
177: Fail;
178: j = cvpos(l2, StrLen(Arg2));
179: if (j == 0)
180: Fail;
181: if (i > j) {
182: t = i;
183: i = j;
184: j = t;
185: }
186:
187: /*
188: * Loop through s2[i:j] trying to find s1 at each point, stopping
189: * when the remaining portion s2[i:j] is too short to contain s1.
190: */
191: Arg0.dword = D_Integer;
192: while (i <= j - StrLen(Arg1)) {
193: s1 = StrLoc(Arg1);
194: s2 = StrLoc(Arg2) + i - 1;
195: l = StrLen(Arg1);
196:
197: /*
198: * Compare strings on a byte-wise basis; if end is reached
199: * before inequality is found, suspend the position of the string.
200: */
201: do {
202: if (l-- <= 0) {
203: IntVal(Arg0) = i;
204: Suspend;
205: break;
206: }
207: } while (*s1++ == *s2++);
208: i++;
209: }
210:
211: Fail;
212: }
213: /* <find */
214:
215: /*
216: * many(c,s,i,j) - find longest prefix of s[i:j] of characters in c.
217: */
218:
219: FncDcl(many,4)
220: {
221: register word i, j, t;
222: int *cs, csbuf[CsetSize];
223: long l1, l2;
224: char sbuf[MaxCvtLen];
225:
226: /*
227: * c must be a cset. s defaults to &subject; i defaults to &pos if s
228: * defaulted, 1 otherwise; j defaults to 0.
229: */
230: if (cvcset(&Arg1, &cs, csbuf) == NULL)
231: runerr(104, &Arg1);
232: if (defstr(&Arg2, sbuf, &k_subject))
233: defint(&Arg3, &l1, k_pos);
234: else
235: defint(&Arg3, &l1, (word)1);
236: defint(&Arg4, &l2, (word)0);
237:
238: /*
239: * Convert i and j to absolute positions and order them. If i == j,
240: * then the specified substring of s is the empty string and many
241: * fails.
242: */
243: i = cvpos(l1, StrLen(Arg2));
244: if (i == 0)
245: Fail;
246: j = cvpos(l2, StrLen(Arg2));
247: if (j == 0)
248: Fail;
249: if (i == j)
250: Fail;
251: if (i > j) {
252: t = i;
253: i = j;
254: j = t;
255: }
256:
257: /*
258: * Fail if first character of s[i:j] isn't in c.
259: */
260: if (!Testb(StrLoc(Arg2)[i-1], cs))
261: Fail;
262:
263: /*
264: * Move i along s[i:j] until a character that is not in c is found or
265: * the end of the string is reached.
266: */
267: i++;
268: while (i < j && Testb(StrLoc(Arg2)[i-1], cs))
269: i++;
270:
271: /*
272: * Return the position of the first character not in c.
273: */
274: Arg0.dword = D_Integer;
275: IntVal(Arg0) = i;
276: Return;
277: }
278:
279:
280: /*
281: * match(s1,s2,i,j) - test if s1 is prefix of s2[i:j].
282: */
283: FncDcl(match,4)
284: {
285: register word i;
286: register char *s1, *s2;
287: word j, t;
288: long l1, l2;
289: char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
290:
291: /*
292: * s1 must be a string. s2 defaults to &subject; i defaults to &pos
293: * if s defaulted, 1 otherwise; j defaults to 0.
294: */
295: if (cvstr(&Arg1, sbuf1) == NULL)
296: runerr(103, &Arg1);
297: if (defstr(&Arg2, sbuf2, &k_subject))
298: defint(&Arg3, &l1, k_pos);
299: else
300: defint(&Arg3, &l1, (word)1);
301: defint(&Arg4, &l2, (word)0);
302:
303: /*
304: * Convert i and j to absolute positions and then make i the smaller
305: * of the two positions and make j the length of the substring.
306: */
307: i = cvpos(l1, StrLen(Arg2));
308: if (i == 0)
309: Fail;
310: j = cvpos(l2, StrLen(Arg2));
311: if (j == 0)
312: Fail;
313: if (i > j) {
314: t = i;
315: i = j;
316: j = t - j;
317: }
318: else
319: j = j - i;
320:
321: /*
322: * Can't match unless s1 is as long as s2[i:j].
323: */
324: if (j < StrLen(Arg1))
325: Fail;
326:
327: /*
328: * Compare s1 with s2[i:j] for *s1 characters; fail if an inequality
329: * if found.
330: */
331: s1 = StrLoc(Arg1);
332: s2 = StrLoc(Arg2) + i - 1;
333: for (j = StrLen(Arg1); j > 0; j--)
334: if (*s1++ != *s2++)
335: Fail;
336:
337: /*
338: * Return position of end of matched string in s2.
339: */
340: Arg0.dword = D_Integer;
341: IntVal(Arg0) = i + StrLen(Arg1);
342: Return;
343: }
344:
345:
346: /*
347: * move(i) - move &pos by i, return substring of &subject spanned.
348: * Reverses effects if resumed.
349: */
350: FncDcl(move,1)
351: {
352: register word i, j;
353: long l;
354: word oldpos;
355:
356: /*
357: * i must be a (non-long) integer.
358: */
359: switch (cvint(&Arg1, &l)) {
360:
361: case T_Integer:
362: j = (word)l;
363: break;
364:
365: case T_Longint:
366: Fail;
367:
368: default:
369: runerr(101, &Arg1);
370: }
371:
372: /*
373: * Save old &pos. Local variable i holds &pos before the move.
374: */
375: oldpos = i = k_pos;
376:
377: /*
378: * If attempted move is past either end of the string, fail.
379: */
380: if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
381: Fail;
382:
383: /*
384: * Set new &pos.
385: */
386: k_pos += j;
387:
388: /*
389: * Make sure j >= 0.
390: */
391: if (j < 0) {
392: i += j;
393: j = -j;
394: }
395:
396: /*
397: * Suspend substring of &subject that was moved over.
398: */
399: StrLen(Arg0) = j;
400: StrLoc(Arg0) = StrLoc(k_subject) + i - 1;
401: Suspend;
402:
403: /*
404: * If move is resumed, restore the old position and fail.
405: */
406: k_pos = oldpos;
407: if (k_pos > StrLen(k_subject) + 1)
408: runerr(205, &tvky_pos.kyval);
409: Fail;
410: }
411:
412:
413: /*
414: * pos(i) - test if &pos is at position i in &subject.
415: */
416: FncDcl(pos,1)
417: {
418: register word i;
419: long l;
420:
421: /*
422: * i must be an integer.
423: */
424: if (cvint(&Arg1, &l) == NULL)
425: runerr(101, &Arg1);
426:
427: /*
428: * Fail if &pos isn't equivalent to i, return i otherwise.
429: */
430: if ((i = cvpos(l, StrLen(k_subject))) != k_pos)
431: Fail;
432: Arg0.dword = D_Integer;
433: IntVal(Arg0) = i;
434: Return;
435: }
436:
437:
438: /*
439: * tab(i) - set &pos to i, return substring of &subject spanned.
440: * Reverses effects if resumed..
441: */
442:
443: /* >tab */
444: FncDcl(tab,1)
445: {
446: register word i, j;
447: word t, oldpos;
448: long l1;
449:
450: /*
451: * Arg1 must be an integer.
452: */
453: if (cvint(&Arg1, &l1) == NULL)
454: runerr(101, &Arg1);
455: /* <tab */
456:
457: /*
458: * Convert j to an absolute position.
459: */
460: j = cvpos(l1, StrLen(k_subject));
461: if (j == 0)
462: Fail;
463:
464: /*
465: * Save old &pos. Local variable i holds &pos before the tab.
466: */
467: oldpos = i = k_pos;
468:
469: /*
470: * Set new &pos.
471: */
472: k_pos = j;
473:
474: /*
475: * Make j the length of the substring &subject[i:j]
476: */
477: if (i > j) {
478: t = i;
479: i = j;
480: j = t - j;
481: }
482: else
483: j = j - i;
484:
485: /*
486: * Suspend the portion of &subject that was tabbed over.
487: */
488: StrLoc(Arg0) = StrLoc(k_subject) + i - 1;
489: StrLen(Arg0) = j;
490: Suspend;
491:
492: /*
493: * If tab is resumed, restore the old position and fail.
494: */
495: k_pos = oldpos;
496: if (k_pos > StrLen(k_subject) + 1)
497: runerr(205, &tvky_pos.kyval);
498: Fail;
499: }
500:
501:
502: /*
503: * upto(c,s,i,j) - find each occurrence in s[i:j] of a character in c.
504: * Generates successive positions.
505: */
506:
507: FncDcl(upto,4)
508: {
509: register word i, j;
510: word t;
511: long l1, l2;
512: int *cs, csbuf[CsetSize];
513: char sbuf[MaxCvtLen];
514:
515: /*
516: * c must be a cset. s defaults to &subject; i defaults to &pos if
517: * s defaulted, 1 otherwise; j defaults to 0.
518: */
519: if (cvcset(&Arg1, &cs, csbuf) == NULL)
520: runerr(104, &Arg1);
521: if (defstr(&Arg2, sbuf, &k_subject))
522: defint(&Arg3, &l1, k_pos);
523: else
524: defint(&Arg3, &l1, (word)1);
525: defint(&Arg4, &l2, (word)0);
526:
527: /*
528: * Convert i and j to positions in s and order them.
529: */
530: i = cvpos(l1, StrLen(Arg2));
531: if (i == 0)
532: Fail;
533: j = cvpos(l2, StrLen(Arg2));
534: if (j == 0)
535: Fail;
536: if (i > j) {
537: t = i;
538: i = j;
539: j = t;
540: }
541:
542: /*
543: * Look through s[i:j] and suspend position of each occurrence of
544: * of a character in c.
545: */
546: while (i < j) {
547: if (Testb(StrLoc(Arg2)[i-1], cs)) {
548: Arg0.dword = D_Integer;
549: IntVal(Arg0) = i;
550: Suspend;
551: }
552: i++;
553: }
554: /*
555: * Eventually fail.
556: */
557: Fail;
558: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.