1/* struct::stack - critcl - layer 1 definitions 2 * (c) Stack functions 3 */ 4 5#include <s.h> 6#include <util.h> 7 8/* .................................................. */ 9 10S* 11st_new (void) 12{ 13 S* s = ALLOC (S); 14 15 s->max = 0; 16 s->stack = Tcl_NewListObj (0,NULL); 17 Tcl_IncrRefCount (s->stack); 18 19 return s; 20} 21 22void 23st_delete (S* s) 24{ 25 /* Delete a stack in toto. 26 */ 27 28 Tcl_DecrRefCount (s->stack); 29 ckfree ((char*) s); 30} 31 32int 33st_peek (S* s, Tcl_Interp* interp, int n, int pop, int listall, int revers, int ret) 34{ 35 36 int listc = 0; 37 Tcl_Obj** listv; 38 Tcl_Obj* r; 39 int i, j; 40 41 Tcl_ListObjGetElements (interp, s->stack, &listc, &listv); 42 43 if (n > listc) { 44 Tcl_AppendResult (interp, 45 "insufficient items on stack to fill request", 46 NULL); 47 return TCL_ERROR; 48 } 49 50 if (ret) { 51 if ((n == 1) && !listall) { 52 r = listv [listc-1]; 53 } else { 54 /* Grab range at the top of the stack, and revert order */ 55 56 ASSERT_BOUNDS (listc-n,listc); 57 58 r = Tcl_NewListObj (n, listv + (listc - n)); 59 60 /* 61 * Note the double negation here. To get the normal order of the 62 * result, the list has to be reversed. To get the reverted order 63 * result, nothing is to be done. So we revers on !revers 64 */ 65 66 if ((n > 1) && !revers) { 67 Tcl_ListObjGetElements (interp, r, &listc, &listv); 68 for (i = 0, j = listc-1; 69 i < j; 70 i++, j--) { 71 Tcl_Obj* tmp; 72 73 ASSERT_BOUNDS (i,listc); 74 ASSERT_BOUNDS (j,listc); 75 76 tmp = listv[i]; 77 listv[i] = listv[j]; 78 listv[j] = tmp; 79 } 80 } 81 } 82 83 Tcl_SetObjResult (interp, r); 84 } 85 86 if (pop) { 87 Tcl_ListObjGetElements (interp, s->stack, &listc, &listv); 88 89 if (n == listc) { 90 /* Complete removal, like clear */ 91 92 Tcl_DecrRefCount (s->stack); 93 94 s->max = 0; 95 s->stack = Tcl_NewListObj (0,NULL); 96 Tcl_IncrRefCount (s->stack); 97 98 } else if ((listc-n) < (s->max/2)) { 99 /* Size dropped under threshold, shrink used memory. 100 */ 101 102 Tcl_Obj* r; 103 104 ASSERT_BOUNDS (listc-n,listc); 105 106 r = Tcl_NewListObj (listc-n, listv); 107 Tcl_DecrRefCount (s->stack); 108 s->stack = r; 109 Tcl_IncrRefCount (s->stack); 110 s->max = listc - n; 111 } else { 112 /* Keep current list, just reduce number of elements held. 113 */ 114 115 ASSERT_BOUNDS (listc-n,listc); 116 117 Tcl_ListObjReplace (interp, s->stack, listc-n, n, 0, NULL); 118 } 119 } 120 121 return TCL_OK; 122} 123 124 125/* .................................................. */ 126 127/* 128 * Local Variables: 129 * mode: c 130 * c-basic-offset: 4 131 * fill-column: 78 132 * End: 133 */ 134