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