|
|
1.1 root 1: /*
2: * File: fstruct.c
3: * Contents: delete, get, insert, member, pop, pull, push, put, sort
4: */
5:
6: #include "../h/rt.h"
7:
8: /*
9: * delete(S,x) - delete element x from set S if it is there
10: * (always succeeds and returns S).
11: */
12:
13: FncDcl(delete,2)
14: {
15: register struct descrip *pd;
16: int res ;
17: extern struct descrip *memb();
18:
19: Arg0 = Arg1;
20:
21: if (Arg1.dword != D_Set)
22: runerr(119,&Arg1);
23:
24: /*
25: * The technique and philosophy here are the same
26: * as used in insert - see comment there.
27: */
28: pd = memb((struct b_set *)BlkLoc(Arg1),&Arg2,hash(&Arg2),&res);
29: if (res == 1) {
30: /*
31: * The element is there so delete it.
32: */
33: *pd = BlkLoc(*pd)->selem.clink;
34: (BlkLoc(Arg1)->set.size)--;
35: }
36: Return;
37: }
38:
39:
40: /*
41: * get(x) - get an element from end of list x.
42: * Identical to pop(x).
43: */
44:
45: FncDcl(get,1)
46: {
47: register word i;
48: register struct b_list *hp;
49: register struct b_lelem *bp;
50: extern struct b_lelem *alclstb();
51:
52: /*
53: * x must be a list.
54: */
55: if (Arg1.dword != D_List)
56: runerr(108, &Arg1);
57:
58: /*
59: * Fail if the list is empty.
60: */
61: hp = (struct b_list *) BlkLoc(Arg1);
62: if (hp->size <= 0)
63: Fail;
64:
65: /*
66: * Point bp at the first list block. If the first block has no
67: * elements in use, point bp at the next list block.
68: */
69: bp = (struct b_lelem *) BlkLoc(hp->listhead);
70: if (bp->nused <= 0) {
71: bp = (struct b_lelem *) BlkLoc(bp->listnext);
72: BlkLoc(hp->listhead) = (union block *) bp;
73: bp->listprev = nulldesc;
74: }
75: /*
76: * Locate first element and assign it to Arg0 for return.
77: */
78: i = bp->first;
79: Arg0 = bp->lslots[i];
80: /*
81: * Set bp->first to new first element, or 0 if the block is now
82: * empty. Decrement the usage count for the block and the size
83: * of the list.
84: */
85: if (++i >= bp->nelem)
86: i = 0;
87: bp->first = i;
88: bp->nused--;
89: hp->size--;
90: Return;
91: }
92:
93:
94: /*
95: * insert(S,x) - insert element x into set S if not already there
96: * (always succeeds and returns S).
97: */
98:
99: FncDcl(insert,2)
100: {
101: register struct descrip *pd;
102: register word hn;
103: int res;
104: extern struct b_selem *alcselem();
105: extern struct descrip *memb();
106:
107: Arg0 = Arg1;
108:
109: if (Arg1.dword != D_Set)
110: runerr(119,&Arg1);
111:
112: /*
113: * We may need at most one new element.
114: */
115: blkreq((word)sizeof(struct b_selem));
116: hn = hash(&Arg2);
117: /*
118: * If Arg2 is a member of set Arg1 then res will have the
119: * value 1 and pd will have a pointer to the descriptor
120: * that points to that member.
121: * If Arg2 is not a member of the set then res will have
122: * the value 0 and pd will point to the descriptor
123: * which should point to the member - thus we know where
124: * to link in the new element without having to do any
125: * repetitive looking.
126: */
127: pd = memb((struct b_set *)BlkLoc(Arg1),&Arg2,hn,&res);
128: if (res == 0)
129: /*
130: * The element is not in the set - insert it.
131: */
132: addmem((struct b_set *)BlkLoc(Arg1),alcselem(&Arg2,hn),pd);
133: Return;
134: }
135:
136:
137: /*
138: * member(S,x) - returns x if x is a member of set S otherwise fails.
139: */
140:
141: FncDcl(member,2)
142: {
143: int res;
144: extern struct descrip *memb();
145:
146: if (Arg1.dword != D_Set)
147: runerr(119,&Arg1); /* S is not a set */
148:
149: /* If Arg2 is a member of set Arg1 then "res" will have the
150: * value 1 otherwise it will have the value 0.
151: */
152: memb((struct b_set *)BlkLoc(Arg1),&Arg2,hash(&Arg2),&res);
153: if (res == 1) { /* It is a member. */
154: Arg0 = Arg2; /* Return the member if it is in Arg1. */
155: Return;
156: }
157: Fail;
158: }
159:
160:
161: /*
162: * pop(x) - pop an element from beginning of list x.
163: */
164:
165: /* >pop */
166: FncDcl(pop,1)
167: {
168: register word i;
169: register struct b_list *hp;
170: register struct b_lelem *bp;
171: extern struct b_lelem *alclstb();
172:
173: /*
174: * Arg1 must be a list.
175: */
176: if (Arg1.dword != D_List)
177: runerr(108, &Arg1);
178:
179: /*
180: * Fail if the list is empty.
181: */
182: hp = (struct b_list *) BlkLoc(Arg1);
183: if (hp->size <= 0)
184: Fail;
185:
186: /*
187: * Point bp to the first list block. If the first block has no
188: * elements in use, point bp at the next list block.
189: */
190: bp = (struct b_lelem *) BlkLoc(hp->listhead);
191: if (bp->nused <= 0) {
192: bp = (struct b_lelem *) BlkLoc(bp->listnext);
193: BlkLoc(hp->listhead) = (union block *) bp;
194: bp->listprev = nulldesc;
195: }
196: /*
197: * Locate first element and assign it to Arg0 for return.
198: */
199: i = bp->first;
200: Arg0 = bp->lslots[i];
201:
202: /*
203: * Set bp->first to new first element, or 0 if the block is now
204: * empty. Decrement the usage count for the block and the size
205: * of the list.
206: */
207: if (++i >= bp->nelem)
208: i = 0;
209: bp->first = i;
210: bp->nused--;
211: hp->size--;
212: Return;
213: }
214: /* <pop */
215:
216:
217: /*
218: * pull(x) - pull an element from end of list x.
219: */
220:
221: FncDcl(pull,1)
222: {
223: register word i;
224: register struct b_list *hp;
225: register struct b_lelem *bp;
226: extern struct b_lelem *alclstb();
227:
228: /*
229: * x must be a list.
230: */
231: if (Arg1.dword != D_List)
232: runerr(108, &Arg1);
233:
234: /*
235: * Point at list header block and fail if the list is empty.
236: */
237: hp = (struct b_list *) BlkLoc(Arg1);
238: if (hp->size <= 0)
239: Fail;
240: /*
241: * Point bp at the last list element block. If the last block has no
242: * elements in use, point bp at the previous list element block.
243: */
244: bp = (struct b_lelem *) BlkLoc(hp->listtail);
245: if (bp->nused <= 0) {
246: bp = (struct b_lelem *) BlkLoc(bp->listprev);
247: BlkLoc(hp->listtail) = (union block *) bp;
248: bp->listnext = nulldesc;
249: }
250: /*
251: * Set i to position of last element and assign the element to
252: * Arg0 for return. Decrement the usage count for the block
253: * and the size of the list.
254: */
255: i = bp->first + bp->nused - 1;
256: if (i >= bp->nelem)
257: i -= bp->nelem;
258: Arg0 = bp->lslots[i];
259: bp->nused--;
260: hp->size--;
261: Return;
262: }
263:
264:
265: /*
266: * push(x,val) - push val onto beginning of list x.
267: */
268: FncDcl(push,2)
269: {
270: register word i;
271: register struct b_list *hp;
272: register struct b_lelem *bp;
273: extern struct b_lelem *alclstb();
274:
275: /*
276: * x must be a list.
277: */
278: if (Arg1.dword != D_List)
279: runerr(108, &Arg1);
280:
281: /*
282: * A new list element block might be needed, so ensure space for it.
283: */
284: blkreq((word)sizeof(struct b_lelem)+MinListSlots*sizeof(struct descrip));
285:
286: /*
287: * Point hp at the list header block and bp at the first
288: * list element block.
289: */
290: hp = (struct b_list *) BlkLoc(Arg1);
291: bp = (struct b_lelem *) BlkLoc(hp->listhead);
292: /*
293: * If the first list element block is full,
294: * allocate a new list element block, make it the first list
295: * element block and make it the previous block of the
296: * former first list element block.
297: */
298: if (bp->nused >= bp->nelem) {
299: bp = alclstb((word)MinListSlots, (word)0, (word)0);
300: BlkLoc(hp->listhead)->lelem.listprev.dword = D_Lelem;
301: BlkLoc(BlkLoc(hp->listhead)->lelem.listprev) = (union block *) bp;
302: bp->listnext = hp->listhead;
303: BlkLoc(hp->listhead) = (union block *) bp;
304: }
305: /*
306: * Set i to position of new first element and assign val (Arg2) to
307: * that element.
308: */
309: i = bp->first - 1;
310: if (i < 0)
311: i = bp->nelem - 1;
312: bp->lslots[i] = Arg2;
313: /*
314: * Adjust value of location of first element, block usage count,
315: * and current list size.
316: */
317: bp->first = i;
318: bp->nused++;
319: hp->size++;
320: /*
321: * Return the list.
322: */
323: Arg0 = Arg1;
324: Return;
325: }
326:
327:
328: /*
329: * put(x,val) - put val onto end of list x.
330: */
331:
332: FncDcl(put,2)
333: {
334: register word i;
335: register struct b_list *hp;
336: register struct b_lelem *bp;
337: extern struct b_lelem *alclstb();
338:
339: /*
340: * Arg1 must be a list.
341: */
342: if (Arg1.dword != D_List)
343: runerr(108, &Arg1);
344:
345: /*
346: * A new list element block might be needed, so ensure space for it.
347: */
348: blkreq((word)sizeof(struct b_lelem)+MinListSlots*sizeof(struct descrip));
349:
350: /* >put */
351: /*
352: * Point hp to the list header block and bp to the last
353: * list element block.
354: */
355: hp = (struct b_list *) BlkLoc(Arg1);
356: bp = (struct b_lelem *) BlkLoc(hp->listtail);
357:
358: /*
359: * If the last list element block is full, allocate a new
360: * list element block, make it the first list element block
361: * and it make it the next block of the former last list
362: * element block.
363: */
364: if (bp->nused >= bp->nelem) {
365: bp = alclstb((word)MinListSlots, (word)0, (word)0);
366: BlkLoc(hp->listtail)->lelem.listnext.dword = D_Lelem;
367: BlkLoc(BlkLoc(hp->listtail)->lelem.listnext) = (union block *) bp;
368: bp->listprev = hp->listtail;
369: BlkLoc(hp->listtail) = (union block *) bp;
370: }
371:
372: /*
373: * Set i to position of new last element and assign Arg2 to
374: * that element.
375: */
376: i = bp->first + bp->nused;
377: if (i >= bp->nelem)
378: i -= bp->nelem;
379: bp->lslots[i] = Arg2;
380:
381: /*
382: * Adjust block usage count and current list size.
383: */
384: bp->nused++;
385: hp->size++;
386:
387: /*
388: * Return the list.
389: */
390: Arg0 = Arg1;
391: Return;
392: }
393: /* <put */
394:
395:
396: struct dpair {
397: struct descrip dr;
398: struct descrip dv;
399: };
400:
401: /*
402: * sort(l) - sort list l.
403: * sort(S) - sort set S.
404: * sort(t,i) - sort table.
405: */
406:
407: FncDcl(sort,2)
408: {
409: register struct descrip *d1;
410: register word size;
411: register int i;
412: word nelem;
413: struct b_list *lp, *tp;
414: union block *bp, *ep;
415: extern struct b_list *alclist();
416: extern struct b_lelem *alclstb();
417: extern anycmp(), trefcmp(), tvalcmp(), trcmp3(), tvcmp4();
418:
419: if (Arg1.dword == D_List) {
420: /*
421: * Sort the list by copying it into a new list and then using
422: * qsort to sort the descriptors. (That was easy!)
423: */
424: size = BlkLoc(Arg1)->list.size;
425: cplist(&Arg1, &Arg0, (word)1, size + 1);
426: qsort(BlkLoc(BlkLoc(Arg0)->list.listhead)->lelem.lslots, size,
427: sizeof(struct descrip), anycmp);
428: }
429: else if (Arg1.dword == D_Set) {
430: /*
431: * Create a list the size of the set (or at least
432: * MinListSlots), copy each element into the list, and
433: * then sort the list using qsort as in list sorting
434: * and return the sorted list.
435: */
436: nelem = size = BlkLoc(Arg1)->set.size;
437: if(nelem < MinListSlots)
438: nelem = MinListSlots;
439: blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
440: nelem * sizeof(struct descrip));
441:
442: bp = BlkLoc(Arg1);
443: lp = alclist(size);
444: lp->listhead.dword = lp->listtail.dword = D_Lelem;
445: BlkLoc(lp->listtail) = (union block *) alclstb(nelem, (word)0, size);
446: BlkLoc(lp->listhead) = BlkLoc(lp->listtail);
447: if (size > 0) { /* only need to sort non-empty sets */
448: d1 = BlkLoc(lp->listhead)->lelem.lslots;
449: for(i = 0; i < SSlots; i++) {
450: ep = BlkLoc(bp->set.sbucks[i]);
451: while (ep != NULL) {
452: *d1 = ep->selem.setmem;
453: d1++;
454: ep = BlkLoc(ep->selem.clink);
455: }
456: }
457: qsort(BlkLoc(lp->listhead)->lelem.lslots,size,
458: sizeof(struct descrip),anycmp);
459: }
460: Arg0.dword = D_List;
461: BlkLoc(Arg0) = (union block *) lp;
462: }
463:
464: else if (Arg1.dword == D_Table) {
465: /*
466: * Default i (the type of sort) to 1.
467: */
468: defshort(&Arg2, 1);
469: switch (IntVal(Arg2)) {
470:
471: /*
472: * Cases 1 and 2 are as in standard Version 5.
473: */
474: case 1:
475: case 2:
476: {
477: /*
478: * The list resulting from the sort will have as many elements as
479: * the table has, so get that value and also make a valid list
480: * block size out of it.
481: */
482: nelem = size = BlkLoc(Arg1)->table.size;
483: if (nelem < MinListSlots)
484: nelem = MinListSlots;
485: /*
486: * Ensure space for: the list header block and a list element
487: * block for the list which is to be returned,
488: * a list header block and a list element block for each of the two
489: * element lists the sorted list is to contain. Note that the
490: * calculation might be better expressed as:
491: * list_header_size + list_block_size + nelem * descriptor_size +
492: * nelem * (list_header_size + list_block_size + 2*descriptor_size)
493: */
494: blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
495: nelem * (sizeof(struct b_list) + sizeof(struct b_lelem) +
496: 3 * sizeof(struct descrip)));
497: /*
498: * Point bp at the table header block of the table to be sorted
499: * and point lp at a newly allocated list
500: * that will hold the the result of sorting the table.
501: */
502: bp = BlkLoc(Arg1);
503: lp = alclist(size);
504: lp->listhead.dword = lp->listtail.dword = D_Lelem;
505: BlkLoc(lp->listtail) = (union block *) alclstb(nelem, (word)0, size);
506: BlkLoc(lp->listhead) = BlkLoc(lp->listtail);
507: /*
508: * If the table is empty, there is no need to sort anything.
509: */
510: if (size <= 0)
511: break;
512: /*
513: * Point d1 at the start of the list elements in the new list
514: * element block in preparation for use as an index into the list.
515: */
516: d1 = BlkLoc(lp->listhead)->lelem.lslots;
517: /*
518: * Traverse the element chain for each table bucket. For each
519: * element, allocate a two-element list and put the table
520: * entry value in the first element and the assigned value in
521: * the second element. The two-element list is assigned to
522: * the descriptor that d1 points at. When this is done, the
523: * list of two-element lists is complete, but unsorted.
524: */
525: for (i = 0; i < TSlots; i++) {
526: ep = BlkLoc(bp->table.buckets[i]);
527: while (ep != NULL) {
528: d1->dword = D_List;
529: tp = alclist((word)2);
530: BlkLoc(*d1) = (union block *) tp;
531: tp->listhead.dword = tp->listtail.dword = D_Lelem;
532: BlkLoc(tp->listtail) = (union block *) alclstb((word)2, (word)0,
533: (word)2);
534: BlkLoc(tp->listhead) = BlkLoc(tp->listtail);
535: BlkLoc(tp->listhead)->lelem.lslots[0] = ep->telem.tref;
536: BlkLoc(tp->listhead)->lelem.lslots[1] = ep->telem.tval;
537: d1++;
538: ep = BlkLoc(ep->telem.clink);
539: }
540: }
541: /*
542: * Sort the resulting two-element list using the sorting function
543: * determined by i.
544: */
545: if (IntVal(Arg2) == 1)
546: qsort(BlkLoc(lp->listhead)->lelem.lslots, size,
547: sizeof(struct descrip), trefcmp);
548: else
549: qsort(BlkLoc(lp->listhead)->lelem.lslots, size,
550: sizeof(struct descrip), tvalcmp);
551: break; /* from cases 1 and 2 */
552: }
553: /*
554: * Cases 3 and 4 were introduced in Version 5.10.
555: */
556: case 3 :
557: case 4 :
558: {
559: /*
560: * The list resulting from the sort will have twice as many elements as
561: * the table has, so get that value and also make a valid list
562: * block size out of it.
563: */
564: nelem = size = BlkLoc(Arg1)->table.size * 2;
565: if (nelem < MinListSlots)
566: nelem = MinListSlots;
567: /*
568: * Ensure space for: the list header block and a list element
569: * block for the list which is to be returned, and two descriptors for
570: * each table element.
571: */
572: blkreq(sizeof(struct b_list) + Vsizeof(struct b_lelem) +
573: (nelem * sizeof(struct descrip)));
574: /*
575: * Point bp at the table header block of the table to be sorted
576: * and point lp at a newly allocated list
577: * that will hold the the result of sorting the table.
578: */
579: bp = BlkLoc(Arg1);
580: lp = alclist(size);
581: lp->listhead.dword = lp->listtail.dword = D_Lelem;
582: BlkLoc(lp->listtail) = (union block *) alclstb(nelem, (word)0, size);
583: BlkLoc(lp->listhead) = BlkLoc(lp->listtail);
584: /*
585: * If the table is empty there's no need to sort anything.
586: */
587: if (size <= 0)
588: break;
589:
590: /*
591: * Point d1 at the start of the list elements in the new list
592: * element block in preparation for use as an index into the list.
593: */
594: d1 = BlkLoc(lp->listhead)->lelem.lslots;
595: /*
596: * Traverse the element chain for each table bucket. For each
597: * table element copy the the entry descriptor and the value
598: * descriptor into adjacent descriptors in the lslots array
599: * in the list element block.
600: * When this is done we now need to sort this list.
601: */
602: for (i = 0; i < TSlots; i++) {
603: ep = BlkLoc(bp->table.buckets[i]);
604: while (ep != NULL) {
605: *d1 = ep->telem.tref;
606: d1++;
607: *d1 = ep->telem.tval;
608: d1++;
609: ep = BlkLoc(ep->telem.clink);
610: }
611: }
612: /*
613: * Sort the resulting two-element list using the sorting function
614: * determined by i.
615: */
616: if (IntVal(Arg2) == 3)
617: qsort(BlkLoc(lp->listhead)->lelem.lslots, size / 2,
618: (2 * sizeof(struct descrip)), trcmp3);
619: else
620: qsort(BlkLoc(lp->listhead)->lelem.lslots, size / 2,
621: (2 * sizeof(struct descrip)), tvcmp4);
622: break; /* from case 3 or 4 */
623: }
624:
625: default : runerr(205,&Arg2);
626: } /* end of switch statement */
627: /*
628: * Make Arg0 point at the sorted list.
629: */
630: Arg0.dword = D_List;
631: BlkLoc(Arg0) = (union block *) lp;
632: }
633: else /* Tried to sort something that wasn't a list or a table. */
634: runerr(115, &Arg1);
635: Return;
636: }
637:
638: /*
639: * trefcmp(d1,d2) - compare two-element lists on first field.
640: */
641:
642: trefcmp(d1,d2)
643: struct descrip *d1, *d2;
644: {
645: extern anycmp();
646:
647: #ifdef Debug
648: if (d1->dword != D_List || d2->dword != D_List)
649: syserr("trefcmp: internal consistency check fails.");
650: #endif Debug
651: return (anycmp(&(BlkLoc(BlkLoc(*d1)->list.listhead)->lelem.lslots[0]),
652: &(BlkLoc(BlkLoc(*d2)->list.listhead)->lelem.lslots[0])));
653: }
654:
655: /*
656: * tvalcmp(d1,d2) - compare two-element lists on second field.
657: */
658:
659: tvalcmp(d1,d2)
660: struct descrip *d1, *d2;
661: {
662: extern anycmp();
663:
664: #ifdef Debug
665: if (d1->dword != D_List || d2->dword != D_List)
666: syserr("tvalcmp: internal consistency check fails.");
667: #endif Debug
668: return (anycmp(&(BlkLoc(BlkLoc(*d1)->list.listhead)->lelem.lslots[1]),
669: &(BlkLoc(BlkLoc(*d2)->list.listhead)->lelem.lslots[1])));
670: }
671:
672: /*
673: * The following two routines are used to compare descriptor pairs in the
674: * experimental table sort.
675: *
676: * trcmp3(dp1,dp2)
677: */
678:
679: trcmp3(dp1,dp2)
680: struct dpair *dp1,*dp2;
681: {
682: extern anycmp();
683:
684: return (anycmp(&((*dp1).dr),&((*dp2).dr)));
685: }
686: /*
687: * tvcmp4(dp1,dp2)
688: */
689:
690: tvcmp4(dp1,dp2)
691: struct dpair *dp1,*dp2;
692:
693: {
694: extern anycmp();
695:
696: return (anycmp(&((*dp1).dv),&((*dp2).dv)));
697: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.