Implemented unless, when and dotimes using built-in macros.
[bpt/guile.git] / qt / stp.c
1 #include "copyright.h"
2 #include "qt.h"
3 #include "stp.h"
4
5 #ifndef NULL
6 #define NULL 0
7 #endif
8
9 #define STP_STKSIZE (0x1000)
10
11 /* `alignment' must be a power of 2. */
12 #define STP_STKALIGN(sp, alignment) \
13 ((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))
14
15
16 /* The notion of a thread is merged with the notion of a queue.
17 Thread stuff: thread status (sp) and stuff to use during
18 (re)initialization. Queue stuff: next thread in the queue
19 (next). */
20
21 struct stp_t {
22 qt_t *sp; /* QuickThreads handle. */
23 void *sto; /* `malloc'-allocated stack. */
24 struct stp_t *next; /* Next thread in the queue. */
25 };
26
27
28 /* A queue is a circular list of threads. The queue head is a
29 designated list element. If this is a uniprocessor-only
30 implementation we can store the `main' thread in this, but in a
31 multiprocessor there are several `heavy' threads but only one run
32 queue. A fancier implementation might have private run queues,
33 which would lead to a simpler (trivial) implementation */
34
35 typedef struct stp_q_t {
36 stp_t t;
37 stp_t *tail;
38 } stp_q_t;
39
40
41 \f/* Helper functions. */
42
43 extern void *malloc (unsigned size);
44 extern void perror (char const *msg);
45 extern void free (void *sto);
46
47 void *
48 xmalloc (unsigned size)
49 {
50 void *sto;
51
52 sto = malloc (size);
53 if (!sto) {
54 perror ("malloc");
55 exit (1);
56 }
57 return (sto);
58 }
59
60 \f/* Queue access functions. */
61
62 static void
63 stp_qinit (stp_q_t *q)
64 {
65 q->t.next = q->tail = &q->t;
66 }
67
68
69 static stp_t *
70 stp_qget (stp_q_t *q)
71 {
72 stp_t *t;
73
74 t = q->t.next;
75 q->t.next = t->next;
76 if (t->next == &q->t) {
77 if (t == &q->t) { /* If it was already empty .. */
78 return (NULL); /* .. say so. */
79 }
80 q->tail = &q->t; /* Else now it is empty. */
81 }
82 return (t);
83 }
84
85
86 static void
87 stp_qput (stp_q_t *q, stp_t *t)
88 {
89 q->tail->next = t;
90 t->next = &q->t;
91 q->tail = t;
92 }
93
94
95 \f/* Thread routines. */
96
97 static stp_q_t stp_global_runq; /* A queue of runable threads. */
98 static stp_t stp_global_main; /* Thread for the process. */
99 static stp_t *stp_global_curr; /* Currently-executing thread. */
100
101 static void *stp_starthelp (qt_t *old, void *ignore0, void *ignore1);
102 static void stp_only (void *pu, void *pt, qt_userf_t *f);
103 static void *stp_aborthelp (qt_t *sp, void *old, void *null);
104 static void *stp_yieldhelp (qt_t *sp, void *old, void *blockq);
105
106
107 void
108 stp_init()
109 {
110 stp_qinit (&stp_global_runq);
111 }
112
113
114 void
115 stp_start()
116 {
117 stp_t *next;
118
119 while ((next = stp_qget (&stp_global_runq)) != NULL) {
120 stp_global_curr = next;
121 QT_BLOCK (stp_starthelp, 0, 0, next->sp);
122 }
123 }
124
125
126 static void *
127 stp_starthelp (qt_t *old, void *ignore0, void *ignore1)
128 {
129 stp_global_main.sp = old;
130 stp_qput (&stp_global_runq, &stp_global_main);
131 /* return (garbage); */
132 }
133
134
135 void
136 stp_create (stp_userf_t *f, void *pu)
137 {
138 stp_t *t;
139 void *sto;
140
141 t = xmalloc (sizeof(stp_t));
142 t->sto = xmalloc (STP_STKSIZE);
143 sto = STP_STKALIGN (t->sto, QT_STKALIGN);
144 t->sp = QT_SP (sto, STP_STKSIZE - QT_STKALIGN);
145 t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, stp_only);
146 stp_qput (&stp_global_runq, t);
147 }
148
149
150 static void
151 stp_only (void *pu, void *pt, qt_userf_t *f)
152 {
153 stp_global_curr = (stp_t *)pt;
154 (*(stp_userf_t *)f)(pu);
155 stp_abort();
156 /* NOTREACHED */
157 }
158
159
160 void
161 stp_abort (void)
162 {
163 stp_t *old, *newthread;
164
165 newthread = stp_qget (&stp_global_runq);
166 old = stp_global_curr;
167 stp_global_curr = newthread;
168 QT_ABORT (stp_aborthelp, old, (void *)NULL, newthread->sp);
169 }
170
171
172 static void *
173 stp_aborthelp (qt_t *sp, void *old, void *null)
174 {
175 free (((stp_t *)old)->sto);
176 free (old);
177 /* return (garbage); */
178 }
179
180
181 void
182 stp_yield()
183 {
184 stp_t *old, *newthread;
185
186 newthread = stp_qget (&stp_global_runq);
187 old = stp_global_curr;
188 stp_global_curr = newthread;
189 QT_BLOCK (stp_yieldhelp, old, &stp_global_runq, newthread->sp);
190 }
191
192
193 static void *
194 stp_yieldhelp (qt_t *sp, void *old, void *blockq)
195 {
196 ((stp_t *)old)->sp = sp;
197 stp_qput ((stp_q_t *)blockq, (stp_t *)old);
198 /* return (garbage); */
199 }