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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
/*-----------------------------------------------------------------*-C-*---
* File: handc/runtime/stakcach.c
*
* Copyright (C)1997 Donovan Kolbly <d.kolbly@rscheme.org>
* as part of the RScheme project, licensed for free use.
* See <http://www.rscheme.org/> for the latest information.
*
* File version: 1.8
* File mod date: 1997.11.29 23:10:49
* System build: v0.7.2, 97.12.21
*
* Purpose: stack-cache stack implementation
*------------------------------------------------------------------------*/
#include <rscheme/vinsns.h>
#include <rscheme/scheme.h>
#ifdef STACK_CACHE
obj the_stack_cache[CACHE_SIZE];
obj *cache_iteration;
#ifndef INLINES
#include "stakcach.ci"
#endif /* INLINES */
void init_stack_cache( void )
{
}
/* FLUSH_STACK_CACHE() -- Does the obvious thing, which is flush the stack
cache. In effect, it guarantees that the current continuation
is a REAL object, flushing the cache sufficiently to ensure the
truth of this.
*/
void flush_stack_cache( void )
{
UINT_32 cr = VAL(continuation_reg);
#define x ((obj *)(cr-POINTER_TAG))
obj n, prev, next, first;
rs_bool more;
UINT_32 i, size_in_bytes;
if (!in_stack_cache(continuation_reg))
return; /* nothing to do... already a real object */
#ifdef STEP_DUMP
{
extern FILE *step_dump_file;
extern int do_step_dump;
extern void touch_step_dump_file( void );
if (do_step_dump && step_dump_file)
{
touch_step_dump_file();
fprintf( step_dump_file, "** Flushing stack cache **\n" );
}
}
#endif /* STEP_DUMP */
more = YES;
prev = ZERO;
first = ZERO; /* suppress warning */
do {
next = x[3];
if (in_stack_cache(next))
{
size_in_bytes = VAL(next) - cr;
}
else
{
size_in_bytes = cache_upper_limit - cr;
more = NO;
}
n = alloc( size_in_bytes, partcont_class );
if (EQ(prev,ZERO))
first = n;
else
{
/* it's not obvious, but this *is* an initializing write,
because we only fill in SLOT(3) of an allocated
<part-cont> here or outside of the loop
*/
gvec_write_init_ptr( prev, SLOT(3), n );
}
gvec_write_init( n, SLOT(0), x[0] ); /* saved envt_reg */
gvec_write_init( n, SLOT(1), x[1] ); /* saved literals_reg */
gvec_write_init( n, SLOT(2), x[2] ); /* saved jump_addr */
for (i=SLOT(4); i<size_in_bytes; i+=SLOT(1))
{
gvec_write_init( n, i, *(obj *)(i+(char *)x) );
}
prev = n;
cr = VAL(next);
} while (more);
gvec_write_init( n, SLOT(3), next );
continuation_reg = first;
#undef x
}
/*
Restores a dynamically-determined number of
argument-passing registers (ie, for use in the
extremely rare cases when it cannot be determined
statically -- nb, this only happens when compiling
to closure-threaded code) and the continuation
register itself
*/
unsigned restore_arb( void )
{
#define x ((obj *)(cr - POINTER_TAG))
UINT_32 cr = VAL(continuation_reg), size_in_bytes, next;
unsigned n;
if (cr < cache_upper_limit && cr >= cache_lower_limit)
{
next = VAL(x[3]);
if (next < cache_upper_limit && next >= cache_lower_limit)
{
size_in_bytes = next - cr;
}
else
{
size_in_bytes = cache_upper_limit - cr;
}
}
else
size_in_bytes = SIZEOF_PTR(continuation_reg);
n = (size_in_bytes / sizeof(obj)) - CONT_FIXED;
restore_cont( n );
return n;
#undef x
}
int process_stack_roots( process_root_fn *fn, void *info )
{
obj *p;
obj item, *stop;
UINT_32 cr = VAL(continuation_reg);
int rc;
p = (obj *)(cache_upper_limit - POINTER_TAG);
if (!in_stack_cache(continuation_reg))
return 0;
stop = (obj *)(cr - POINTER_TAG);
while (p > stop)
{
rc = fn( --p, info );
if (rc)
return rc;
}
return 0;
}
#endif /* STACK_CACHE */
|
