|
996
|
1 /*****************************************************************************
|
|
|
2
|
|
|
3 NAME
|
|
|
4 unravel.c -- multithreading and backtracking support for C-INTERCAL
|
|
|
5
|
|
|
6 LICENSE TERMS
|
|
|
7 Copyright (C) 2006 Alex Smith
|
|
|
8
|
|
|
9 This program is free software; you can redistribute it and/or modify
|
|
|
10 it under the terms of the GNU General Public License as published by
|
|
|
11 the Free Software Foundation; either version 2 of the License, or
|
|
|
12 (at your option) any later version.
|
|
|
13
|
|
|
14 This program is distributed in the hope that it will be useful,
|
|
|
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 GNU General Public License for more details.
|
|
|
18
|
|
|
19 You should have received a copy of the GNU General Public License
|
|
|
20 along with this program; if not, write to the Free Software
|
|
|
21 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22
|
|
|
23 ***************************************************************************/
|
|
|
24
|
|
|
25 /* Notes about authorship. This entire file was written by Alex Smith (AIS),
|
|
|
26 but with reference to an earlier implementation of Threaded INTERCAL written
|
|
|
27 by Malcom Ryan. I have not reused any of his C code (two of his INTERCAL
|
|
|
28 programs are in the pit), but it was a useful source of inspiration, even
|
|
|
29 though I did it a completely different and less efficient way (I think we
|
|
|
30 handled mutiple COME FROM recognition in much the same way). This file only
|
|
|
31 contains functions necessary for multithreading; some of the code is stored
|
|
|
32 in feh2.c (stored in strings), or in perpet.c (again stored in strings).
|
|
|
33 The information about the required syntax is in parser.y and lexer.l.
|
|
|
34 A small amount of the multithread code is in ick-wrap.c, although as that
|
|
|
35 file is copied almost verbatim (although it's quite a big 'almost') into
|
|
|
36 all ick output, it's guarded there by #if...#endif. The whole multithread
|
|
|
37 idea started on alt.lang.intercal when it was noticed that multiple COME
|
|
|
38 FROMs aiming at the same line were hard to interpret, but I would like
|
|
|
39 to thank Malcom Ryan for drafting the Threaded Intercal standard and a
|
|
|
40 reference compiler, and for turning the idea into a concrete set of rules.
|
|
|
41 (The standard itself carries a note saying that a revision (use of AGAIN)
|
|
|
42 was inspired by Kyle Dean, so I'd like to mention that here too, and I also
|
|
|
43 revised it (so that ABSTAIN/REINSTATE were preserved through backtracking).)
|
|
|
44 In terms of the quality of the code, Malcom Ryan's code was clearly better
|
|
|
45 for multithread programs, but required rewriting most of the compiler. As
|
|
|
46 clearly it would be unfair to subject the INTERCAL community at large to
|
|
|
47 the risk of silent multithreading by default, I decided multithreading
|
|
|
48 should be off by default (but ONCE/AGAIN should be legal). So this code is
|
|
|
49 designed to interfere as little as possible with non-multithreaded output.
|
|
|
50 There are two versions of libick compiled by the Makefile in this
|
|
|
51 distribution: libick.a, the non-multithread version, and libickmt.a, the
|
|
|
52 multithread version. The only difference between them is this file,
|
|
|
53 unravel.c, which is multithread only, so it seemed a good place for this
|
|
|
54 comment. To see what the multithreading looks like in the object code,
|
|
|
55 see degenerated code or feh2.c. */
|
|
|
56
|
|
|
57 /* This file also implements Backtracking INTERCAL, which is turned on with
|
|
|
58 the same command-line option (-m). This implementation differs from
|
|
|
59 Malcom Ryan's standard in that abstention stati are not restored upon
|
|
|
60 GOING BACK. As far as I know, this is the only Backtracking INTERCAL
|
|
|
61 implementation currently available, although the code depends on the
|
|
|
62 multithreading code (which is why -m is neccesary). */
|
|
|
63
|
|
|
64 /* Note about control structures: Crazy INTERCAL control structures call for
|
|
|
65 crazy C control structures. setjmp/longjmp is probably C's weirdest
|
|
|
66 control structure (it's sort of like a time-reversed computed COME FROM).
|
|
|
67 I've used them to implement both multithreading and computed COME FROMming.
|
|
|
68
|
|
|
69 Worried that this code might actually be copied by a casual C programmer, I
|
|
|
70 have the following warning:
|
|
|
71
|
|
|
72 setjmp/longjmp is worse than goto in terms of spaghettification of code.
|
|
|
73 It is strictly to be used only when neccesary, or when writing INTERCAL
|
|
|
74 compilers. They also lead to weird portability problems when you don't obey
|
|
|
75 all the restrictions put on them by the C standard. For instance,
|
|
|
76 if(setjmp(ick_cjb)!=0) puts("Jumped"); is portable, but
|
|
|
77 if(setjmp(ick_cjb)) puts("Jumped"); is not, despite seeming to mean exactly the
|
|
|
78 same thing. Also, the address of setjmp can't be taken. Semantically,
|
|
|
79 setjmp/longjmp lets you do the same crazy things like goto, like jump into
|
|
|
80 the middle of a loop, except in this case the loop can be in a different
|
|
|
81 function, or even in a different file. unravel.c has no qualms about
|
|
|
82 jumping straight into the middle of an if statement in a degenerated C
|
|
|
83 program, even if said degenerated C program didn't exist when libickmt.a was
|
|
|
84 compiled. */
|
|
|
85
|
|
|
86 /* LINTLIBRARY */
|
|
|
87 #include "config.h"
|
|
|
88 #include <stdio.h>
|
|
|
89 #include <stdlib.h>
|
|
|
90 #include <string.h>
|
|
|
91 #include <setjmp.h>
|
|
|
92 #include <assert.h>
|
|
|
93
|
|
|
94 #define MULTITHREAD 1
|
|
|
95
|
|
|
96 #include "sizes.h"
|
|
|
97 #include "abcess.h"
|
|
|
98 #include "ick_lose.h"
|
|
|
99
|
|
|
100 int gonebackto; /* Is the choicepoint reached by GOING BACK? */
|
|
|
101 static int choicing = 0; /* Is a multithread function being used to do
|
|
|
102 backtracking processing? */
|
|
|
103 jmp_buf btjb; /* The backtracking jmp_buf */
|
|
|
104 /* About the annotation 'dependent': topchoice is really 'owned', but the owner keeps
|
|
|
105 on changing. So Splint gets less confused if we simply never tell it who the owner
|
|
|
106 is. */
|
|
|
107 /*@null@*/ /*@dependent@*/ static ickthread* topchoice; /* Top of the choicepoint stack */
|
|
|
108 extern int ick_lineno; /* Keep track of error-message lines */
|
|
|
109
|
|
|
110 extern int ick_printflow; /* from arrgghh.c; a debug option */
|
|
|
111
|
|
|
112 int weaving=0; /* Weave newly created threads? */
|
|
|
113
|
|
|
114 /* Printflow debugging output */
|
|
|
115 static void fluputs(const char* s)
|
|
|
116 {
|
|
|
117 fprintf(stderr,"%s",s);
|
|
|
118 (void) fflush(stderr);
|
|
|
119 }
|
|
|
120
|
|
|
121 /**********************************************************************
|
|
|
122 *
|
|
|
123 * This functions deal with choicepoints, which are implemented as
|
|
|
124 * ickthread objects. choicepoint creates a choicepoint or marks a
|
|
|
125 * choicepoint as stale; choiceahead eliminates a choicepoint;
|
|
|
126 * choiceback eliminates a stale choicepoint or returns to a fresh
|
|
|
127 * choicepoint.
|
|
|
128 *
|
|
|
129 *********************************************************************/
|
|
|
130
|
|
|
131 void choicepoint(void)
|
|
|
132 {
|
|
|
133 ickthread* oldprev, *oldtc;
|
|
|
134 int oldweave;
|
|
|
135 if(gonebackto)
|
|
|
136 { /* Create a stale choicepoint */
|
|
|
137 if(ick_printflow) fluputs("(back)");
|
|
|
138 oldtc = topchoice;
|
|
|
139 /* Suppress the onlytrans warning because we're allocating a member
|
|
|
140 of a linked list, which confuses Splint no matter what the list
|
|
|
141 is flagged as (because malloc returns 'only' data, but yet that
|
|
|
142 data has to be pointed to by other 'only' data in the same list). */
|
|
|
143 /*@-onlytrans@*/
|
|
|
144 topchoice = (ickthread*) malloc(sizeof(ickthread));
|
|
|
145 /*@=onlytrans@*/
|
|
|
146 if(!topchoice) ick_lose(IE991, ick_lineno, (const char*) NULL);
|
|
|
147 topchoice->choicepoint = oldtc;
|
|
|
148 topchoice->stale = 1;
|
|
|
149 topchoice->refcount = 1; /* At the moment, this is the only
|
|
|
150 thread looking at this choicepoint */
|
|
|
151 topchoice->dsi=topchoice;
|
|
|
152 topchoice->usesthis=0;
|
|
|
153 /* topchoice needn't be completely defined if it's stale */
|
|
|
154 /*@-compdef@*/
|
|
|
155 return;
|
|
|
156 /*@=compdef@*/
|
|
|
157 }
|
|
|
158 else
|
|
|
159 { /* Create a new choicepoint */
|
|
|
160 if(ick_printflow) fluputs("(maybe)");
|
|
|
161 oldprev = ickmt_prev;
|
|
|
162 choicing = 1;
|
|
|
163 oldweave = weaving;
|
|
|
164 weaving = 0;
|
|
|
165 (void) multicome1(ick_lineno,btjb); /* Duplicate data */
|
|
|
166 weaving = oldweave;
|
|
|
167 choicing = 0;
|
|
|
168 oldprev->ick_next = ickmt_cur;
|
|
|
169 ickmt_prev->choicepoint = topchoice;
|
|
|
170 topchoice = ickmt_prev;
|
|
|
171 ickmt_prev = oldprev;
|
|
|
172 topchoice->stale = 0;
|
|
|
173 topchoice->refcount = 1;
|
|
|
174 /* So in other words, we've duplicated the current execution
|
|
|
175 environment, except for the choicepoint stack, changed the
|
|
|
176 duplicate from a thread into a choicepoint, and pushed it
|
|
|
177 on top of the choicepoint stack. Its pc is the point in the
|
|
|
178 degenerated program where choicepoint was called. */
|
|
|
179 }
|
|
|
180 }
|
|
|
181
|
|
|
182 void choiceahead(void)
|
|
|
183 {
|
|
|
184 ickthread* tempthread;
|
|
|
185 jmp_buf fakepc;
|
|
|
186
|
|
|
187 if(!topchoice) ick_lose(IE404, ick_lineno, (const char*) NULL); /* That's what IE404's for */
|
|
|
188 /* GO AHEAD with multithreading requires care. The choicepoint should only
|
|
|
189 be removed from this thread. topchoice = topchoice->ick_next almost works, but
|
|
|
190 is a memory leak. So most of this is garbage-collection. */
|
|
|
191
|
|
|
192 /* If other threads are using the choicepoint, don't free it. */
|
|
|
193 if(topchoice->refcount > 1)
|
|
|
194 {
|
|
|
195 if(ick_printflow) fluputs("(refahead)");
|
|
|
196 topchoice->refcount--;
|
|
|
197 topchoice = topchoice->choicepoint;
|
|
|
198 return;
|
|
|
199 }
|
|
|
200
|
|
|
201 /* The top choicepoint is not being used by other threads; free it. */
|
|
|
202
|
|
|
203 /* Freeing a stale choicepoint (which contains no data) is easy. */
|
|
|
204 if(topchoice->stale)
|
|
|
205 {
|
|
|
206 if(ick_printflow) fluputs("(destale)");
|
|
|
207 tempthread = topchoice;
|
|
|
208 topchoice = topchoice->choicepoint;
|
|
|
209 /*@-dependenttrans@*/ /* because it's really owned, not dependent */
|
|
|
210 free(tempthread);
|
|
|
211 /*@=dependenttrans@*/
|
|
|
212 return;
|
|
|
213 }
|
|
|
214
|
|
|
215 if(ick_printflow) fluputs("(ahead)");
|
|
|
216
|
|
|
217 /* This code works by converting topchoice back to a thread and placing it
|
|
|
218 just before the current thread, and then killing it. First, the data from
|
|
|
219 this thread, apart from the choicepoint stack, must be saved. */
|
|
|
220 choicing = 1;
|
|
|
221 if(setjmp(fakepc) == 0)
|
|
|
222 {
|
|
|
223 memcpy((void*)ickmt_cur->pc,(const void*)fakepc,sizeof(jmp_buf));
|
|
|
224 nextthread(fakepc, -1, 5);
|
|
|
225 }
|
|
|
226 choicing = 0;
|
|
|
227 /* That's saved the current thread's data. Now to convert topchoice to a
|
|
|
228 thread. */
|
|
|
229 tempthread = topchoice->choicepoint;
|
|
|
230 ickmt_prev->ick_next = topchoice;
|
|
|
231 topchoice->ick_next = ickmt_cur;
|
|
|
232 ickmt_cur = topchoice;
|
|
|
233 topchoice = tempthread;
|
|
|
234 /* Let's load the backtracking data... */
|
|
|
235 choicing = 1;
|
|
|
236 if(setjmp(fakepc) == 0)
|
|
|
237 {
|
|
|
238 memcpy((void *)ickmt_cur->pc,(const void *)fakepc,sizeof(jmp_buf));
|
|
|
239 nextthread(fakepc, -1, 6);
|
|
|
240 }
|
|
|
241 /* only to destroy it! Mwahahahahah! */
|
|
|
242 if(setjmp(fakepc) == 0)
|
|
|
243 {
|
|
|
244 memcpy((void *)ickmt_cur->ick_next->pc,(const void *)fakepc,sizeof(jmp_buf));
|
|
|
245 killthread();
|
|
|
246 }
|
|
|
247 choicing = 0;
|
|
|
248 /* So we've reloaded the original current thread, the original previous
|
|
|
249 thread is still correct, topchoice has become topchoice->choicepoint,
|
|
|
250 and the original topchoice has disappeared. Mission accomplished. */
|
|
|
251 }
|
|
|
252
|
|
|
253 void choiceback(void)
|
|
|
254 {
|
|
|
255 if(!topchoice) ick_lose(IE404, ick_lineno, (const char *) NULL);
|
|
|
256 if(topchoice->stale)
|
|
|
257 {
|
|
|
258 if(ick_printflow) fluputs("(back=)");
|
|
|
259 choiceahead();
|
|
|
260 return;
|
|
|
261 }
|
|
|
262 /* That's two simple cases out of the way (at least once choiceahead's
|
|
|
263 been implemented). What we need to do to backtrack is to change
|
|
|
264 topchoice to a thread after the current thread (rather than before
|
|
|
265 as in the previous two functions), and then kill the current thread.
|
|
|
266 (It amuses me that destroying a choicepoint, as in choiceahead(),
|
|
|
267 is more complicated than either visiting a choicepoint or creating a
|
|
|
268 choicepoint. That's how much work it can take to avoid a memory leak.)
|
|
|
269 In this case, choiceback won't return in the normal fashion. */
|
|
|
270 if(topchoice->refcount > 1)
|
|
|
271 {
|
|
|
272 /* The Threaded INTERCAL standard states that if other threads are using
|
|
|
273 the choicepoint, a GO BACK should cause the thread it's in to be
|
|
|
274 killed. (Of course, if it's stale, it should just have been removed.)*/
|
|
|
275 if(ick_printflow) fluputs("(desplit)");
|
|
|
276 killthread();
|
|
|
277 return;
|
|
|
278 }
|
|
|
279 topchoice->ick_next = ickmt_cur->ick_next;
|
|
|
280 ickmt_cur->ick_next = topchoice;
|
|
|
281 topchoice = topchoice->choicepoint;
|
|
|
282 if(ickmt_cur==ickmt_prev) ickmt_prev = ickmt_cur->ick_next;
|
|
|
283 choicing = 2; /* Tells killthread to set it back to 0 */
|
|
|
284 killthread();
|
|
|
285 }
|
|
|
286
|
|
|
287 /**********************************************************************
|
|
|
288 *
|
|
|
289 * This function is called when two COME FROMs reference the same
|
|
|
290 * line at runtime. multicome1 is used in a multithread
|
|
|
291 * program; it forks the program. For ick_multicome0, see cesspool.c.
|
|
|
292 *
|
|
|
293 *********************************************************************/
|
|
|
294
|
|
|
295 int multicome1(int errlineno, jmp_buf pc)
|
|
|
296 {
|
|
|
297 /* Make a new thread just before the current one. Fake a PC in the
|
|
|
298 current thread within this function, change to the new thread, then
|
|
|
299 call nextthread. The upshot of all this is that all this thread's
|
|
|
300 data is stored in the new thread's state. Then, we have to copy
|
|
|
301 all this thread's current data to new locations. */
|
|
|
302 ickthread* newthread;
|
|
|
303 jmp_buf fakepc;
|
|
|
304 ick_stashbox *isb, *isb2, *isbprev;
|
|
|
305 void* tvp;
|
|
|
306 ick_array* a;
|
|
|
307 int prod, i, j;
|
|
|
308 newthread = malloc(sizeof(ickthread));
|
|
|
309 if(!newthread) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
310 ickmt_prev->ick_next = newthread;
|
|
|
311 newthread->ick_next = ickmt_cur;
|
|
|
312 ickmt_cur = newthread;
|
|
|
313 newthread->dsi=newthread;
|
|
|
314 newthread->usesthis=0;
|
|
|
315
|
|
|
316 if(ick_printflow && !choicing) fluputs("(fork)");
|
|
|
317
|
|
|
318 if(setjmp(fakepc) == 0)
|
|
|
319 {
|
|
|
320 memcpy((void *)newthread->ick_next->pc,(const void *)fakepc,sizeof(jmp_buf));
|
|
|
321 nextthread(pc, -1, 1);
|
|
|
322 }
|
|
|
323 /* So on the previous line: Save the value of pc as the program
|
|
|
324 counter of the new thread, and give a fake value for the
|
|
|
325 program value of the current thread (so it returns here,
|
|
|
326 not anywhere in the degenerated program). All that remains
|
|
|
327 is to duplicate all the data stored through pointers in the 'old'
|
|
|
328 thread (nextthread has changed ickmt_cur to point at the 'old'
|
|
|
329 thread). The original memory pointed to by these pointers is in
|
|
|
330 use storing the values in the 'new' thread, so the 'old' thread
|
|
|
331 needs new copies that it can modify independently. */
|
|
|
332
|
|
|
333 if(!weaving)
|
|
|
334 {
|
|
|
335 /* duplicate variables, forget indicators */
|
|
|
336 i = onespotcount;
|
|
|
337 tvp = ick_onespots;
|
|
|
338 ick_onespots = malloc(i * sizeof *ick_onespots);
|
|
|
339 if(!ick_onespots) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
340 memcpy(ick_onespots, tvp, i * sizeof *ick_onespots);
|
|
|
341 if(ick_oo_onespots)
|
|
|
342 {
|
|
|
343 tvp = ick_oo_onespots;
|
|
|
344 ick_oo_onespots = malloc(i * sizeof *ick_oo_onespots);
|
|
|
345 if(!ick_oo_onespots) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
346 memcpy(ick_oo_onespots, tvp, i * sizeof *ick_oo_onespots);
|
|
|
347 }
|
|
|
348 i = twospotcount;
|
|
|
349 tvp = ick_twospots;
|
|
|
350 ick_twospots = malloc(i * sizeof *ick_twospots);
|
|
|
351 if(!ick_twospots) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
352 memcpy(ick_twospots, tvp, i * sizeof *ick_twospots);
|
|
|
353 if(ick_oo_twospots)
|
|
|
354 {
|
|
|
355 tvp = ick_oo_twospots;
|
|
|
356 ick_oo_twospots = malloc(i * sizeof *ick_oo_twospots);
|
|
|
357 if(!ick_oo_twospots) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
358 memcpy(ick_oo_twospots, tvp, i * sizeof *ick_oo_twospots);
|
|
|
359 }
|
|
|
360 i = tailcount;
|
|
|
361 tvp = ick_tails;
|
|
|
362 ick_tails = malloc(i * sizeof *ick_tails);
|
|
|
363 if(!ick_tails) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
364 memcpy(ick_tails, tvp, i * sizeof *ick_tails);
|
|
|
365 i = hybridcount;
|
|
|
366 tvp = ick_hybrids;
|
|
|
367 ick_hybrids = malloc(i * sizeof *ick_hybrids);
|
|
|
368 if(!ick_hybrids) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
369 memcpy(ick_hybrids, tvp, i * sizeof *ick_hybrids);
|
|
|
370 i = onespotcount;
|
|
|
371 tvp = ick_oneforget;
|
|
|
372 ick_oneforget = malloc(i * sizeof *ick_oneforget);
|
|
|
373 if(!ick_oneforget) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
374 memcpy(ick_oneforget, tvp, i * sizeof *ick_oneforget);
|
|
|
375 i = twospotcount;
|
|
|
376 tvp = ick_twoforget;
|
|
|
377 ick_twoforget = malloc(i * sizeof *ick_twoforget);
|
|
|
378 if(!ick_twoforget) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
379 memcpy(ick_twoforget, tvp, i * sizeof *ick_twoforget);
|
|
|
380 i = tailcount;
|
|
|
381 tvp = ick_tailforget;
|
|
|
382 ick_tailforget = malloc(i * sizeof *ick_tailforget);
|
|
|
383 if(!ick_tailforget) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
384 memcpy(ick_tailforget, tvp, i * sizeof *ick_tailforget);
|
|
|
385 i = hybridcount;
|
|
|
386 tvp = ick_hyforget;
|
|
|
387 ick_hyforget = malloc(i * sizeof *ick_hyforget);
|
|
|
388 if(!ick_hyforget) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
389 memcpy(ick_hyforget, tvp, i * sizeof *ick_hyforget);
|
|
|
390
|
|
|
391 /* duplicate data stored in arrays */
|
|
|
392 j = tailcount;
|
|
|
393 tvp = NULL;
|
|
|
394 while(j--)
|
|
|
395 {
|
|
|
396 a = ick_tails+j; /* &(ick_tails[j]) */
|
|
|
397 if(!a->rank||!a->dims) continue; /* don't duplicate a deallocated ick_array */
|
|
|
398 tvp = a->dims;
|
|
|
399 /* Much of this code is paraphrased from the ick_stashbox-copying code below,
|
|
|
400 which was in turn paraphrased from a section in cesspool.c I didn't
|
|
|
401 write. So any errors in this code are probably mine, but the algorithm
|
|
|
402 isn't. */
|
|
|
403 a->dims = malloc(a->rank * sizeof *(a->dims));
|
|
|
404 if(a->dims == NULL) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
405 memcpy(a->dims, tvp, a->rank * sizeof *(a->dims));
|
|
|
406 prod = (int)!!a->rank;
|
|
|
407 i = (int)a->rank;
|
|
|
408 while(i--) prod *= a->dims[i];
|
|
|
409 /*@-mustfreeonly@*/ /* how on earth did a->dims become only? */
|
|
|
410 tvp = a->data.tail;
|
|
|
411 /*@=mustfreeonly@*/
|
|
|
412 a->data.tail = malloc(prod * sizeof(ick_type16));
|
|
|
413 if(!a->data.tail) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
414 memcpy(a->data.tail, tvp, prod * sizeof(ick_type16));
|
|
|
415 /*@-mustfreeonly@*/ /* likewise. This isn't only, honest! */
|
|
|
416 tvp = NULL;
|
|
|
417 /*@=mustfreeonly@*/
|
|
|
418 }
|
|
|
419 j = hybridcount;
|
|
|
420 while(j--)
|
|
|
421 {
|
|
|
422 a = ick_hybrids+j; /* &(ick_hybrids[j]) */
|
|
|
423 if(!a->rank||!a->dims) continue; /* don't duplicate a deallocated ick_array */
|
|
|
424 tvp = a->dims;
|
|
|
425 /* Much of this code is paraphrased from the ick_stashbox-copying code below,
|
|
|
426 which was in turn paraphrased from a section in cesspool.c I didn't
|
|
|
427 write. So any errors in this code are probably mine, but the algorithm
|
|
|
428 isn't. */
|
|
|
429 a->dims = malloc(a->rank * sizeof(*(a->dims)));
|
|
|
430 if(!a->dims) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
431 memcpy(a->dims, tvp, a->rank * sizeof(*(a->dims)));
|
|
|
432 prod = (int)!!a->rank;
|
|
|
433 i = (int)a->rank;
|
|
|
434 while(i--) prod *= a->dims[i];
|
|
|
435 /*@-mustfreeonly@*/
|
|
|
436 tvp = a->data.hybrid;
|
|
|
437 /*@=mustfreeonly@*/
|
|
|
438 a->data.hybrid = malloc(prod * sizeof(ick_type32));
|
|
|
439 if(!a->data.hybrid) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
440 memcpy(a->data.hybrid, tvp, prod * sizeof(ick_type32));
|
|
|
441 /*@-mustfreeonly@*/
|
|
|
442 tvp=NULL;
|
|
|
443 /*@=mustfreeonly@*/
|
|
|
444 }
|
|
|
445
|
|
|
446 /* duplicate ick_stashbox */
|
|
|
447 isb2 = ick_first;
|
|
|
448 isbprev = (ick_stashbox*)NULL;
|
|
|
449 while(isb2)
|
|
|
450 {
|
|
|
451 isb = (ick_stashbox*)malloc(sizeof(ick_stashbox));
|
|
|
452 if(!isb) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
453 memcpy(isb,isb2,sizeof(ick_stashbox));
|
|
|
454 if(isbprev) isbprev->ick_next = isb;
|
|
|
455 isbprev = isb;
|
|
|
456 if(isb2==ick_first) ick_first = isb; /* change ick_first only the ick_first time round */
|
|
|
457 if(isb->type == ick_ONESPOT || isb->type == ick_TWOSPOT)
|
|
|
458 { /* all copying already done */
|
|
|
459 isb2 = isb->ick_next;
|
|
|
460 continue;
|
|
|
461 }
|
|
|
462 /* Copy the stashed ick_array. Much of this code is paraphrased from some
|
|
|
463 code in cesspool.c. In fact, it's the same, with a few idioms added
|
|
|
464 and variable names changed. So, although it's in this file, I can't
|
|
|
465 take the credit for it. */
|
|
|
466 isb->save.a = (ick_array*)malloc(sizeof(ick_array));
|
|
|
467 if(!isb->save.a) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
468 assert(isb2 != NULL); /* we already said that in the while condition,
|
|
|
469 so it's surprising that Splint needs this hint */
|
|
|
470 isb->save.a->rank = isb2->save.a->rank;
|
|
|
471 isb->save.a->dims = malloc(isb2->save.a->rank *
|
|
|
472 sizeof(*(isb2->save.a->dims)));
|
|
|
473 if(!isb->save.a->dims) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
474 memcpy(isb->save.a->dims, isb2->save.a->dims,
|
|
|
475 isb2->save.a->rank * sizeof(*(isb2->save.a->dims)));
|
|
|
476 prod = (int)!!isb2->save.a->rank;
|
|
|
477 /* I use this idiom often enough in the code produced by my optimizer that I
|
|
|
478 may as well use it here. */
|
|
|
479 i = (int)isb2->save.a->rank;
|
|
|
480 while(i--) prod *= isb2->save.a->dims[i];
|
|
|
481 if(isb2->type == ick_TAIL)
|
|
|
482 {
|
|
|
483 isb->save.a->data.tail = (ick_type16*)malloc(prod * sizeof(ick_type16));
|
|
|
484 if(!isb->save.a->data.tail) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
485 memcpy(isb->save.a->data.tail, isb2->save.a->data.tail,
|
|
|
486 prod * sizeof(ick_type16));
|
|
|
487 }
|
|
|
488 else
|
|
|
489 {
|
|
|
490 isb->save.a->data.hybrid = (ick_type32*)malloc(prod * sizeof(ick_type32));
|
|
|
491 if(!isb->save.a->data.hybrid) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
492 memcpy(isb->save.a->data.hybrid, isb2->save.a->data.hybrid,
|
|
|
493 prod * sizeof(ick_type32));
|
|
|
494 }
|
|
|
495 isb2 = isb->ick_next;
|
|
|
496 }
|
|
|
497 }
|
|
|
498 else /* we are weaving, reference the old current thread */
|
|
|
499 {
|
|
|
500 ickthread* tempthread;
|
|
|
501 if(ick_printflow) fluputs("(weave)");
|
|
|
502 /* Sanity check to make sure that the threads are arranged correctly */
|
|
|
503 if(newthread->ick_next!=ickmt_cur) ick_lose(IE778, errlineno, (const char *) NULL);
|
|
|
504 tempthread=newthread->ick_next; /* the old current thread */
|
|
|
505 while(tempthread->usesthis) tempthread=tempthread->usesthis;
|
|
|
506 newthread->dsi=tempthread->dsi;
|
|
|
507 tempthread->usesthis=newthread;
|
|
|
508 }
|
|
|
509 /* duplicate NEXT stack */
|
|
|
510 tvp = ick_next;
|
|
|
511 ick_next = malloc(ick_MAXNEXT * sizeof *ick_next);
|
|
|
512 if(!ick_next) ick_lose(IE991, errlineno, (const char *) NULL);
|
|
|
513 memcpy(ick_next, tvp, ick_MAXNEXT * sizeof *ick_next);
|
|
|
514
|
|
|
515 /* allow for multithreading with choicepoints on the stack */
|
|
|
516 if(!choicing && topchoice != NULL)
|
|
|
517 {
|
|
|
518 ickthread* icktp = topchoice;
|
|
|
519 while(icktp)
|
|
|
520 {
|
|
|
521 icktp->refcount++;
|
|
|
522 icktp = icktp->choicepoint; /* ick_next choicepoint on the stack */
|
|
|
523 }
|
|
|
524 /* The old thread's and new thread's choicepoint stack share
|
|
|
525 memory. This is pretty much necessary to handle backtracking
|
|
|
526 past a fork correctly. */
|
|
|
527 }
|
|
|
528
|
|
|
529 /* The nullstate annotation is because Splint doesn't notice that all
|
|
|
530 the mallocs are guarded by lines that error out permanently if they
|
|
|
531 fail. The mustfreefresh annotation is because Splint doesn't realise
|
|
|
532 that I've stored newthread in a pointer buried in the linked list of
|
|
|
533 threads, and so Splint assumes that it's memory-leaking. */
|
|
|
534 /*@-nullstate@*/ /*@-mustfreefresh@*/
|
|
|
535 return 1; /* Tell the degenerated program to look for yet
|
|
|
536 another COME FROM */
|
|
|
537 /*@=nullstate@*/ /*@=mustfreefresh@*/
|
|
|
538 }
|
|
|
539
|
|
|
540 /**********************************************************************
|
|
|
541 *
|
|
|
542 * These functions do the multithreading, using setjmp and longjmp
|
|
|
543 * to save the program counter. ickmtinit sets up the ick_first
|
|
|
544 * thread, and nextthread changes to the ick_next thread in the
|
|
|
545 * sequence. (Note that nextthread rarely actually returns). The
|
|
|
546 * code makes each command atomic, so that ONCE and AGAIN appear
|
|
|
547 * to the user to be atomic operations.
|
|
|
548 *
|
|
|
549 *********************************************************************/
|
|
|
550
|
|
|
551 /*@partial@*/ /*@dependent@*/ ickthread* ickmt_cur; /* define ickmt_cur */
|
|
|
552 /*@partial@*/ /*@dependent@*/ ickthread* ickmt_prev; /* define ickmt_prev */
|
|
|
553
|
|
|
554 void ickmtinit(void)
|
|
|
555 {
|
|
|
556 /* Splint linked list problems again; the list is marked as 'dependent',
|
|
|
557 which is correct for everything except adding and removing items in the
|
|
|
558 list. (All annotations are incorrect in some respects.) */
|
|
|
559 /*@-onlytrans@*/
|
|
|
560 ickmt_cur = malloc(sizeof(ickthread));
|
|
|
561 /*@=onlytrans@*/
|
|
|
562 if(!ickmt_cur) ick_lose(IE991, 1, (const char *) NULL);
|
|
|
563 ickmt_prev = ickmt_cur;
|
|
|
564 ickmt_cur->ick_next = ickmt_cur;
|
|
|
565 topchoice = (ickthread*) NULL; /* No choicepoints */
|
|
|
566 ickmt_cur->dsi=ickmt_cur;
|
|
|
567 ickmt_cur->usesthis=0;
|
|
|
568 }
|
|
|
569
|
|
|
570 /* Destroys the current thread, and switches to the ick_next thread.
|
|
|
571 If there are no threads left, terminates the program using exit(0). */
|
|
|
572 void killthread(void)
|
|
|
573 {
|
|
|
574 static jmp_buf dummy;
|
|
|
575 ick_stashbox* isb, *isbi;
|
|
|
576 int i;
|
|
|
577
|
|
|
578 if(ick_printflow&&!choicing) fluputs("(kill)");
|
|
|
579
|
|
|
580 if(!choicing) while(topchoice) choiceahead();
|
|
|
581 /* The above line will mark each of the choicepoints as no longer being
|
|
|
582 used by this thread, and free them if neccesary. This has to be done
|
|
|
583 ick_first while this thread's pointers are still valid due to the way that
|
|
|
584 choiceahead works. */
|
|
|
585
|
|
|
586 /* If this thread uses another, let the other know about the change */
|
|
|
587 if(ickmt_cur->dsi!=ickmt_cur)
|
|
|
588 {
|
|
|
589 ickthread* temp=ickmt_cur->dsi;
|
|
|
590 if(ick_printflow) fluputs("(deweave)");
|
|
|
591 while(!temp||temp->usesthis!=ickmt_cur)
|
|
|
592 {
|
|
|
593 if(!temp) ick_lose(IE778, -1, (const char *) NULL);
|
|
|
594 temp=temp->usesthis;
|
|
|
595 }
|
|
|
596 temp->usesthis=ickmt_cur->usesthis;
|
|
|
597 }
|
|
|
598 /* If this thread is holding data for others, move it somewhere safe */
|
|
|
599 if(ickmt_cur->usesthis != NULL && ickmt_cur->usesthis->dsi==ickmt_cur)
|
|
|
600 {
|
|
|
601 ickthread* newuses=ickmt_cur->usesthis;
|
|
|
602 ickthread* temp=ickmt_cur->usesthis;
|
|
|
603 if(ick_printflow) fluputs("(shift)");
|
|
|
604 while(temp)
|
|
|
605 {
|
|
|
606 temp->dsi=newuses;
|
|
|
607 temp=temp->usesthis;
|
|
|
608 }
|
|
|
609 ickmt_cur->dsi=newuses; /* so the data will be transferred later */
|
|
|
610 }
|
|
|
611
|
|
|
612 if(ickmt_cur->dsi==ickmt_cur)
|
|
|
613 {
|
|
|
614 /* We aren't storing data for another thread, and we have data of our own,
|
|
|
615 or dsi would point somewhere else (either naturally or because it was
|
|
|
616 changed higher up). */
|
|
|
617 if(ick_printflow) fluputs("(free)");
|
|
|
618 /* Deallocate the current thread's data */
|
|
|
619 i=tailcount;
|
|
|
620 while(i--)
|
|
|
621 { /* free tail data */
|
|
|
622 if(!ick_tails[i].rank||!ick_tails[i].dims) continue; /* already free */
|
|
|
623 free(ick_tails[i].dims);
|
|
|
624 free(ick_tails[i].data.tail);
|
|
|
625 }
|
|
|
626 i=hybridcount;
|
|
|
627 while(i--)
|
|
|
628 { /* free hybrid data */
|
|
|
629 if(!ick_hybrids[i].rank||!ick_hybrids[i].dims) continue; /* already free */
|
|
|
630 free(ick_hybrids[i].dims);
|
|
|
631 free(ick_hybrids[i].data.hybrid);
|
|
|
632 }
|
|
|
633 /* unqualifiedtrans because although they aren't always only, they're only at the moment;
|
|
|
634 compdestroy because we have just deallocated tail and hybrid data */
|
|
|
635 /*@-unqualifiedtrans@*/ /*@-compdestroy@*/
|
|
|
636 free(ick_onespots); free(ick_twospots); free(ick_tails); free(ick_hybrids);
|
|
|
637 free(ick_oneforget); free(ick_twoforget); free(ick_tailforget); free(ick_hyforget);
|
|
|
638 if(ick_oo_onespots) free(ick_oo_onespots); if(ick_oo_twospots) free(ick_oo_twospots);
|
|
|
639 /*@=unqualifiedtrans@*/ /*@=compdestroy@*/
|
|
|
640
|
|
|
641 isbi = ick_first;
|
|
|
642 while(isbi) /* Free ick_stash */
|
|
|
643 {
|
|
|
644 isb=isbi->ick_next;
|
|
|
645 if(isbi->type == ick_TAIL || isbi->type == ick_HYBRID)
|
|
|
646 {
|
|
|
647 free(isbi->save.a->dims);
|
|
|
648 if(isbi->type == ick_TAIL)
|
|
|
649 free(isbi->save.a->data.tail);
|
|
|
650 else
|
|
|
651 free(isbi->save.a->data.hybrid);
|
|
|
652 }
|
|
|
653 free(isbi);
|
|
|
654 isbi=isb;
|
|
|
655 }
|
|
|
656 }
|
|
|
657 else
|
|
|
658 {
|
|
|
659 /* We still need to save our variables for the benefit of woven threads. */
|
|
|
660 /* save variables */
|
|
|
661 ickmt_cur->dsi->varforget[0] = ick_onespots;
|
|
|
662 ickmt_cur->dsi->varforget[1] = ick_twospots;
|
|
|
663 ickmt_cur->dsi->varforget[2] = ick_tails;
|
|
|
664 ickmt_cur->dsi->varforget[3] = ick_hybrids;
|
|
|
665 ickmt_cur->dsi->varforget[4] = ick_oneforget;
|
|
|
666 ickmt_cur->dsi->varforget[5] = ick_twoforget;
|
|
|
667 ickmt_cur->dsi->varforget[6] = ick_tailforget;
|
|
|
668 ickmt_cur->dsi->varforget[7] = ick_hyforget;
|
|
|
669 ickmt_cur->dsi->varforget[8] = ick_oo_onespots;
|
|
|
670 ickmt_cur->dsi->varforget[9] = ick_oo_twospots;
|
|
|
671
|
|
|
672 /* save ick_stashbox */
|
|
|
673 /*@-unqualifiedtrans@*/ /* the linked list problem again */
|
|
|
674 ickmt_cur->dsi->sb = ick_first;
|
|
|
675 /*@=unqualifiedtrans@*/
|
|
|
676 /*@-branchstate@*/ /* it's reference-counted */
|
|
|
677 }
|
|
|
678 /*@=branchstate@*/
|
|
|
679 /*@-unqualifiedtrans@*/ /* it is only at this point */
|
|
|
680 free(ick_next); /* Free NEXT stack */
|
|
|
681 /*@=unqualifiedtrans@*/
|
|
|
682
|
|
|
683 ickmt_prev->ick_next = ickmt_cur->ick_next;
|
|
|
684 if(ickmt_cur->ick_next == ickmt_cur)
|
|
|
685 {
|
|
|
686 /*@-dependenttrans@*/ /* because it isn't really dependent */
|
|
|
687 free(ickmt_cur);
|
|
|
688 /*@=dependenttrans@*/
|
|
|
689 exit(0);
|
|
|
690 }
|
|
|
691 else
|
|
|
692 {
|
|
|
693 /* We need to run about half of nextthread. So we pass in a 2 for
|
|
|
694 flags and tell it to skip the ick_first half. */
|
|
|
695 /*@-dependenttrans@*/ /* because it isn't really dependent */
|
|
|
696 free(ickmt_cur);
|
|
|
697 /*@=dependenttrans@*/
|
|
|
698 ickmt_cur = ickmt_prev;
|
|
|
699 nextthread(dummy, -1, 2); /* dummy is not used by nextthread */
|
|
|
700 ick_lose(IE778, -1, (const char *) NULL); /* nextthread does not return */
|
|
|
701 }
|
|
|
702 }
|
|
|
703
|
|
|
704 /* This function does not return in the normal fashion, but by a nonlocal
|
|
|
705 goto to a mysterious location, possibly in multicome1 but possibly in
|
|
|
706 the degenerated code. From the point of view of libickmt.a, we're going
|
|
|
707 to a piece of code that doesn't even exist yet! The general ugliness of
|
|
|
708 INTERCAL multithreading pulls out all the stops when it comes to using
|
|
|
709 unusual and confusing C control structures. It is important to remember
|
|
|
710 that longjmp clobbers all auto variables that have changed since the
|
|
|
711 corresponding setjmp. */
|
|
|
712
|
|
|
713 /* In this Threaded INTERCAL implementation, data is saved in a linked ring
|
|
|
714 of threads. A thread runs for a command, then all the data pointers are
|
|
|
715 changed, saving the old ones. This is an improvement on an earlier attempt
|
|
|
716 of mine in which the values themselves were copied, but is still less
|
|
|
717 efficient than Malcom Ryan's method (which didn't involve copying things
|
|
|
718 about except when forking). However, I justify this by saying that it leaves
|
|
|
719 as much existing code as possible untouched, which is helpful for single-
|
|
|
720 thread compatibility, modifying the code in feh.c without an understanding
|
|
|
721 of multithread issues, and because I'm lazy. It also makes the rest of the
|
|
|
722 program shorter. */
|
|
|
723 void nextthread(jmp_buf pc, int errlineno, int flags)
|
|
|
724 { /* flags | 1 means save this thread.
|
|
|
725 flags | 2 means load the ick_next thread.
|
|
|
726 flags | 4 means don't change thread. */
|
|
|
727 if(errlineno > -1 && ickmt_cur->ick_next == ickmt_cur && !choicing) longjmp(pc,1);
|
|
|
728 /* If we only have 1 thread, just continue with it. Otherwise: */
|
|
|
729
|
|
|
730 if(!(flags&1)) goto advancethread;
|
|
|
731 /* OK, so I've spaghettified this procedure slightly by using goto
|
|
|
732 instead of if. But I was so deep into figuring out setjmp/longjmp,
|
|
|
733 a goto seemed crystal-clear by comparison. */
|
|
|
734
|
|
|
735 /* save variables */
|
|
|
736 ickmt_cur->dsi->varforget[0] = ick_onespots;
|
|
|
737 ickmt_cur->dsi->varforget[1] = ick_twospots;
|
|
|
738 ickmt_cur->dsi->varforget[2] = ick_tails;
|
|
|
739 ickmt_cur->dsi->varforget[3] = ick_hybrids;
|
|
|
740 ickmt_cur->dsi->varforget[4] = ick_oneforget;
|
|
|
741 ickmt_cur->dsi->varforget[5] = ick_twoforget;
|
|
|
742 ickmt_cur->dsi->varforget[6] = ick_tailforget;
|
|
|
743 ickmt_cur->dsi->varforget[7] = ick_hyforget;
|
|
|
744 ickmt_cur->dsi->varforget[8] = ick_oo_onespots;
|
|
|
745 ickmt_cur->dsi->varforget[9] = ick_oo_twospots;
|
|
|
746
|
|
|
747 /* save NEXT stack */
|
|
|
748 /*@-unqualifiedtrans@*/ /* because nextstack isn't only really */
|
|
|
749 ickmt_cur->nextstack = ick_next;
|
|
|
750 /*@=unqualifiedtrans@*/
|
|
|
751 ickmt_cur->nextpointer = ick_nextindex;
|
|
|
752
|
|
|
753 /* save ick_stashbox */
|
|
|
754 /*@-unqualifiedtrans@*/ /* ditto */
|
|
|
755 ickmt_cur->dsi->sb = ick_first;
|
|
|
756 /*@=unqualifiedtrans@*/
|
|
|
757
|
|
|
758 /* save choicepoints */
|
|
|
759 if(!choicing) ickmt_cur->choicepoint = topchoice;
|
|
|
760
|
|
|
761 /* save comefrom information */
|
|
|
762 memcpy((void*)(ickmt_cur->ick_cjb), (const void*)ick_cjb, sizeof(jmp_buf));
|
|
|
763 ickmt_cur->ick_ccfc = ick_ccfc;
|
|
|
764 ickmt_cur->ick_skipto = ick_skipto;
|
|
|
765
|
|
|
766 /* save program counter */
|
|
|
767 memcpy((void*)(ickmt_cur->pc), (const void*)pc, sizeof(jmp_buf));
|
|
|
768 /* And another thing about setjmp/longjmp. A jmp_buf
|
|
|
769 acts like a structure that passes itself around by
|
|
|
770 reference. However, it cannot be assigned, although
|
|
|
771 just about everything else in C can be, although it
|
|
|
772 can be copied with memcpy (what I'm doing in the line
|
|
|
773 above - remember it passes itself around by reference).
|
|
|
774 Generally speaking, it's some sort of ick_array,
|
|
|
775 even though some implementors use a 1-element ick_array.
|
|
|
776 The exact representation of jmp_buf is one of the most
|
|
|
777 implementation-dependent things in C (I've seen both
|
|
|
778 a 1-element ick_array of structure and an int[12].) */
|
|
|
779
|
|
|
780 advancethread:
|
|
|
781 /* change thread */
|
|
|
782 if(!(flags&4))
|
|
|
783 {
|
|
|
784 ickmt_prev = ickmt_cur;
|
|
|
785 ickmt_cur = ickmt_cur->ick_next;
|
|
|
786 }
|
|
|
787
|
|
|
788 if(!(flags&2)) goto returnjmp;
|
|
|
789
|
|
|
790 /* load variables */
|
|
|
791 ick_onespots = ickmt_cur->dsi->varforget[0];
|
|
|
792 ick_twospots = ickmt_cur->dsi->varforget[1];
|
|
|
793 ick_tails = ickmt_cur->dsi->varforget[2];
|
|
|
794 ick_hybrids = ickmt_cur->dsi->varforget[3];
|
|
|
795 ick_oneforget = ickmt_cur->dsi->varforget[4];
|
|
|
796 ick_twoforget = ickmt_cur->dsi->varforget[5];
|
|
|
797 ick_tailforget = ickmt_cur->dsi->varforget[6];
|
|
|
798 ick_hyforget = ickmt_cur->dsi->varforget[7];
|
|
|
799 ick_oo_onespots = ickmt_cur->dsi->varforget[8];
|
|
|
800 ick_oo_twospots = ickmt_cur->dsi->varforget[9];
|
|
|
801
|
|
|
802 /* load NEXT stack */
|
|
|
803 /*@-onlytrans@*/ /* the nextstack shouldn't be only */
|
|
|
804 ick_next = ickmt_cur->nextstack;
|
|
|
805 /*@=onlytrans@*/
|
|
|
806 ick_nextindex = ickmt_cur->nextpointer;
|
|
|
807
|
|
|
808 /* load choicepoints */
|
|
|
809 if(!choicing) topchoice = ickmt_cur->choicepoint;
|
|
|
810
|
|
|
811 /* load ick_stashbox */
|
|
|
812 /*@-onlytrans@*/ /* ditto */
|
|
|
813 ick_first = ickmt_cur->dsi->sb;
|
|
|
814 /*@=onlytrans@*/
|
|
|
815
|
|
|
816 /* load comefrom information */
|
|
|
817 memcpy((void*)ick_cjb, (const void*)(ickmt_cur->ick_cjb), sizeof(jmp_buf));
|
|
|
818 ick_ccfc = ickmt_cur->ick_ccfc;
|
|
|
819 ick_skipto = ickmt_cur->ick_skipto;
|
|
|
820
|
|
|
821 returnjmp:
|
|
|
822 /* return to the new current thread's program counter */
|
|
|
823 if(choicing==2) choicing = 0;
|
|
|
824 longjmp(ickmt_cur->pc, 1);
|
|
|
825 }
|
