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