Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.1 | \ posix threads |
| 2 : | |||
| 3 : | \ Copyright (C) 2012 Free Software Foundation, Inc. | ||
| 4 : | |||
| 5 : | \ This file is part of Gforth. | ||
| 6 : | |||
| 7 : | \ Gforth is free software; you can redistribute it and/or | ||
| 8 : | \ modify it under the terms of the GNU General Public License | ||
| 9 : | \ as published by the Free Software Foundation, either version 3 | ||
| 10 : | \ of the License, or (at your option) any later version. | ||
| 11 : | |||
| 12 : | \ This program is distributed in the hope that it will be useful, | ||
| 13 : | \ but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 : | \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 : | \ GNU General Public License for more details. | ||
| 16 : | |||
| 17 : | \ You should have received a copy of the GNU General Public License | ||
| 18 : | \ along with this program. If not, see http://www.gnu.org/licenses/. | ||
| 19 : | |||
| 20 : | c-library pthread | ||
| 21 : | \c #include <pthread.h> | ||
| 22 : | \c #include <limits.h> | ||
| 23 : | \c #include <sys/mman.h> | ||
| 24 : | \c #include <unistd.h> | ||
| 25 : | pazsan | 1.12 | \c #include <setjmp.h> |
| 26 : | \c #include <stdio.h> | ||
| 27 : | pazsan | 1.23 | \c #include <signal.h> |
| 28 : | pazsan | 1.2 | \c #define wholepage(n) (((n)+pagesize-1)&~(pagesize-1)) |
| 29 : | pazsan | 1.1 | \c typedef struct { |
| 30 : | pazsan | 1.8 | \c Cell next_task; |
| 31 : | \c Cell prev_task; | ||
| 32 : | \c Cell save_task; | ||
| 33 : | pazsan | 1.10 | \c Cell sp0, rp0, fp0, lp0; |
| 34 : | pazsan | 1.12 | \c Cell throw_entry; |
| 35 : | pazsan | 1.8 | \c } user_area; |
| 36 : | pazsan | 1.2 | \c int pagesize = 1; |
| 37 : | \c void page_noaccess(void *a) | ||
| 38 : | \c { | ||
| 39 : | \c /* try mprotect first; with munmap the page might be allocated later */ | ||
| 40 : | \c if (mprotect(a, pagesize, PROT_NONE)==0) { | ||
| 41 : | \c return; | ||
| 42 : | \c } | ||
| 43 : | \c if (munmap(a,pagesize)==0) { | ||
| 44 : | \c return; | ||
| 45 : | \c } | ||
| 46 : | \c } | ||
| 47 : | \c void * alloc_mmap(Cell size) | ||
| 48 : | \c { | ||
| 49 : | \c void *r; | ||
| 50 : | \c | ||
| 51 : | \c #if defined(MAP_ANON) | ||
| 52 : | \c r = mmap(NULL, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); | ||
| 53 : | \c #else /* !defined(MAP_ANON) */ | ||
| 54 : | \c /* Ultrix (at least) does not define MAP_FILE and MAP_PRIVATE (both are | ||
| 55 : | \c apparently defaults) */ | ||
| 56 : | \c static int dev_zero=-1; | ||
| 57 : | \c | ||
| 58 : | \c if (dev_zero == -1) | ||
| 59 : | \c dev_zero = open("/dev/zero", O_RDONLY); | ||
| 60 : | \c if (dev_zero == -1) { | ||
| 61 : | \c r = MAP_FAILED; | ||
| 62 : | \c } else { | ||
| 63 : | \c r=mmap(NULL, size, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_FILE|MAP_PRIVATE, dev_zero, 0); | ||
| 64 : | \c } | ||
| 65 : | \c #endif /* !defined(MAP_ANON) */ | ||
| 66 : | \c return r; | ||
| 67 : | \c } | ||
| 68 : | pazsan | 1.6 | \c |
| 69 : | pazsan | 1.8 | \c Cell gforth_create_thread(Cell dsize, Cell rsize, Cell fsize, Cell lsize) |
| 70 : | pazsan | 1.2 | \c { |
| 71 : | pazsan | 1.1 | \c #if HAVE_GETPAGESIZE |
| 72 : | pazsan | 1.2 | \c pagesize=getpagesize(); /* Linux/GNU libc offers this */ |
| 73 : | pazsan | 1.1 | \c #elif HAVE_SYSCONF && defined(_SC_PAGESIZE) |
| 74 : | pazsan | 1.2 | \c pagesize=sysconf(_SC_PAGESIZE); /* POSIX.4 */ |
| 75 : | pazsan | 1.1 | \c #elif PAGESIZE |
| 76 : | pazsan | 1.2 | \c pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */ |
| 77 : | pazsan | 1.1 | \c #endif |
| 78 : | pazsan | 1.23 | \c #ifdef SIGSTKSZ |
| 79 : | \c stack_t sigstack; | ||
| 80 : | \c int sas_retval=-1; | ||
| 81 : | \c #endif | ||
| 82 : | pazsan | 1.8 | \c size_t totalsize; |
| 83 : | \c Cell a; | ||
| 84 : | \c user_area * up0; | ||
| 85 : | pazsan | 1.19 | \c Cell dsizep = wholepage(dsize); |
| 86 : | \c Cell rsizep = wholepage(rsize); | ||
| 87 : | \c Cell fsizep = wholepage(fsize); | ||
| 88 : | \c Cell lsizep = wholepage(lsize); | ||
| 89 : | pazsan | 1.23 | \c totalsize = dsizep+fsizep+rsizep+lsizep+6*pagesize; |
| 90 : | \c #ifdef SIGSTKSZ | ||
| 91 : | \c totalsize += 2*SIGSTKSZ; | ||
| 92 : | \c #endif | ||
| 93 : | pazsan | 1.8 | \c a = (Cell)alloc_mmap(totalsize); |
| 94 : | pazsan | 1.2 | \c if (a != (Cell)MAP_FAILED) { |
| 95 : | pazsan | 1.12 | \c up0=(user_area*)a; a+=pagesize; |
| 96 : | pazsan | 1.19 | \c page_noaccess((void*)a); a+=pagesize; up0->sp0=a+dsize; a+=dsizep; |
| 97 : | \c page_noaccess((void*)a); a+=pagesize; up0->fp0=a+fsize; a+=fsizep; | ||
| 98 : | \c page_noaccess((void*)a); a+=pagesize; up0->rp0=a+rsize; a+=rsizep; | ||
| 99 : | \c page_noaccess((void*)a); a+=pagesize; up0->lp0=a+lsize; a+=lsizep; | ||
| 100 : | pazsan | 1.23 | \c page_noaccess((void*)a); a+=pagesize; |
| 101 : | \c #ifdef SIGSTKSZ | ||
| 102 : | \c sigstack.ss_sp=(void*)a+SIGSTKSZ; | ||
| 103 : | \c sigstack.ss_size=SIGSTKSZ; | ||
| 104 : | \c sas_retval=sigaltstack(&sigstack,(stack_t *)0); | ||
| 105 : | \c #endif | ||
| 106 : | pazsan | 1.8 | \c return (Cell)up0; |
| 107 : | pazsan | 1.6 | \c } |
| 108 : | \c return 0; | ||
| 109 : | \c } | ||
| 110 : | \c | ||
| 111 : | pazsan | 1.10 | \c void gforth_cleanup_thread(void * t) |
| 112 : | \c { | ||
| 113 : | pazsan | 1.12 | \c Cell size = wholepage((Cell)(((user_area*)t)->lp0)+pagesize-(Cell)t); |
| 114 : | pazsan | 1.23 | \c #ifdef SIGSTKSZ |
| 115 : | \c size += 2*SIGSTKSZ; | ||
| 116 : | \c #endif | ||
| 117 : | pazsan | 1.12 | \c munmap(t, size); |
| 118 : | pazsan | 1.10 | \c } |
| 119 : | \c | ||
| 120 : | pazsan | 1.18 | \c #ifndef HAS_BACKLINK |
| 121 : | \c static void *(*saved_gforth_pointers)(Cell); | ||
| 122 : | pazsan | 1.17 | \c #endif |
| 123 : | \c | ||
| 124 : | pazsan | 1.8 | \c void *gforth_thread(user_area * t) |
| 125 : | pazsan | 1.6 | \c { |
| 126 : | pazsan | 1.12 | \c void *x; |
| 127 : | \c int throw_code; | ||
| 128 : | pazsan | 1.21 | \c jmp_buf throw_jmp_buf; |
| 129 : | pazsan | 1.18 | \c #ifndef HAS_BACKLINK |
| 130 : | \c void *(*gforth_pointers)(Cell) = saved_gforth_pointers; | ||
| 131 : | \c #endif | ||
| 132 : | pazsan | 1.22 | \c Cell signal_data_stack[24]; |
| 133 : | \c Cell signal_return_stack[16]; | ||
| 134 : | \c Float signal_fp_stack[1]; | ||
| 135 : | \c void *ip0=(void*)(t->save_task); | ||
| 136 : | \c Cell *sp0=(Cell*)(t->sp0)-1; | ||
| 137 : | \c Cell *rp0=(Cell*)(t->rp0); | ||
| 138 : | \c Float *fp0=(Float*)(t->fp0); | ||
| 139 : | \c void *lp0=(void*)(t->lp0); | ||
| 140 : | \c | ||
| 141 : | pazsan | 1.10 | \c pthread_cleanup_push(&gforth_cleanup_thread, (void*)t); |
| 142 : | pazsan | 1.15 | \c |
| 143 : | pazsan | 1.21 | \c throw_jmp_handler = &throw_jmp_buf; |
| 144 : | pazsan | 1.22 | \c ((Cell*)(t->sp0))[-1]=(Cell)t; |
| 145 : | pazsan | 1.21 | \c |
| 146 : | pazsan | 1.22 | \c while((throw_code=setjmp(*throw_jmp_handler))) { |
| 147 : | pazsan | 1.12 | \c signal_data_stack[15]=throw_code; |
| 148 : | pazsan | 1.22 | \c ip0=(void*)(t->throw_entry); |
| 149 : | \c sp0=signal_data_stack+15; | ||
| 150 : | \c rp0=signal_return_stack+16; | ||
| 151 : | \c fp0=signal_fp_stack; | ||
| 152 : | pazsan | 1.12 | \c } |
| 153 : | pazsan | 1.22 | \c x=gforth_engine(ip0, sp0, rp0, fp0, lp0); |
| 154 : | pazsan | 1.10 | \c pthread_cleanup_pop(1); |
| 155 : | pazsan | 1.23 | \c pthread_exit(x); |
| 156 : | pazsan | 1.1 | \c } |
| 157 : | pazsan | 1.17 | \c #ifdef HAS_BACKLINK |
| 158 : | pazsan | 1.1 | \c void *gforth_thread_p() |
| 159 : | \c { | ||
| 160 : | \c return (void*)&gforth_thread; | ||
| 161 : | \c } | ||
| 162 : | pazsan | 1.17 | \c #else |
| 163 : | \c #define gforth_thread_p() gforth_thread_ptr(gforth_pointers) | ||
| 164 : | \c void *gforth_thread_ptr(GFORTH_ARGS) | ||
| 165 : | \c { | ||
| 166 : | pazsan | 1.18 | \c saved_gforth_pointers=gforth_pointers; |
| 167 : | pazsan | 1.17 | \c return (void*)&gforth_thread; |
| 168 : | \c } | ||
| 169 : | \c #endif | ||
| 170 : | pazsan | 1.1 | \c void *pthread_plus(void * thread) |
| 171 : | \c { | ||
| 172 : | \c return thread+sizeof(pthread_t); | ||
| 173 : | \c } | ||
| 174 : | \c Cell pthreads(Cell thread) | ||
| 175 : | \c { | ||
| 176 : | \c return thread*(int)sizeof(pthread_t); | ||
| 177 : | \c } | ||
| 178 : | pazsan | 1.6 | \c void *pthread_mutex_plus(void * thread) |
| 179 : | \c { | ||
| 180 : | \c return thread+sizeof(pthread_mutex_t); | ||
| 181 : | \c } | ||
| 182 : | \c Cell pthread_mutexes(Cell thread) | ||
| 183 : | \c { | ||
| 184 : | \c return thread*(int)sizeof(pthread_mutex_t); | ||
| 185 : | \c } | ||
| 186 : | pazsan | 1.23 | \c pthread_attr_t * pthread_detach_attr(void) |
| 187 : | \c { | ||
| 188 : | \c static pthread_attr_t attr; | ||
| 189 : | \c pthread_attr_init(&attr); | ||
| 190 : | \c pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); | ||
| 191 : | \c return &attr; | ||
| 192 : | \c } | ||
| 193 : | pazsan | 1.24 | \c void create_pipe(FILE ** addr) |
| 194 : | \c { | ||
| 195 : | \c int epipe[2]; | ||
| 196 : | \c pipe(epipe); | ||
| 197 : | \c addr[0]=fdopen(epipe[0], "r"); | ||
| 198 : | \c addr[1]=fdopen(epipe[1], "a"); | ||
| 199 : | \c setvbuf(addr[1], NULL, _IONBF, 0); | ||
| 200 : | \c } | ||
| 201 : | pazsan | 1.25 | \c #include <sys/ioctl.h> |
| 202 : | \c #include <errno.h> | ||
| 203 : | \c int check_read(FILE * fid) | ||
| 204 : | \c { | ||
| 205 : | \c int pipe = fileno(fid); | ||
| 206 : | \c int chars_avail; | ||
| 207 : | \c int result = ioctl(pipe, FIONREAD, &chars_avail); | ||
| 208 : | \c return (result==-1) ? -errno : chars_avail; | ||
| 209 : | \c } | ||
| 210 : | pazsan | 1.27 | \c #include <poll.h> |
| 211 : | \c int wait_read(FILE * fid, Cell timeout) | ||
| 212 : | \c { | ||
| 213 : | \c struct pollfd fds = { fileno(fid), POLLIN, 0 }; | ||
| 214 : | \c #ifdef linux | ||
| 215 : | \c struct timespec tout = { timeout/1000000000, timeout%1000000000 }; | ||
| 216 : | \c ppoll(&fds, 1, &tout, 0); | ||
| 217 : | \c #else | ||
| 218 : | \c poll(&fds, 1, timeout/1000000); | ||
| 219 : | \c #endif | ||
| 220 : | \c return check_read(fid); | ||
| 221 : | \c } | ||
| 222 : | pazsan | 1.1 | c-function pthread+ pthread_plus a -- a ( addr -- addr' ) |
| 223 : | c-function pthreads pthreads n -- n ( n -- n' ) | ||
| 224 : | c-function thread_start gforth_thread_p -- a ( -- addr ) | ||
| 225 : | pazsan | 1.8 | c-function gforth_create_thread gforth_create_thread n n n n -- a ( dsize rsize fsize lsize -- task ) |
| 226 : | pazsan | 1.1 | c-function pthread_create pthread_create a a a a -- n ( thread attr start arg ) |
| 227 : | pazsan | 1.6 | c-function pthread_exit pthread_exit a -- void ( retaddr -- ) |
| 228 : | c-function pthread_mutex_init pthread_mutex_init a a -- n ( mutex addr -- r ) | ||
| 229 : | c-function pthread_mutex_lock pthread_mutex_lock a -- n ( mutex -- r ) | ||
| 230 : | c-function pthread_mutex_unlock pthread_mutex_unlock a -- n ( mutex -- r ) | ||
| 231 : | c-function pthread-mutex+ pthread_mutex_plus a -- a ( mutex -- mutex' ) | ||
| 232 : | c-function pthread-mutexes pthread_mutexes n -- n ( n -- n' ) | ||
| 233 : | pazsan | 1.20 | c-function pause sched_yield -- void ( -- ) |
| 234 : | pazsan | 1.23 | c-function pthread_detatch_attr pthread_detach_attr -- a ( -- addr ) |
| 235 : | pazsan | 1.24 | c-function create_pipe create_pipe a -- void ( pipefd[2] -- ) |
| 236 : | pazsan | 1.25 | c-function check_read check_read a -- n ( pipefd -- n ) |
| 237 : | pazsan | 1.27 | c-function wait_read wait_read a n -- n ( pipefd timeout -- n ) |
| 238 : | pazsan | 1.1 | end-c-library |
| 239 : | pazsan | 1.2 | |
| 240 : | pazsan | 1.8 | User pthread-id -1 cells pthread+ uallot drop |
| 241 : | pazsan | 1.24 | User epiper |
| 242 : | User epipew | ||
| 243 : | pazsan | 1.8 | |
| 244 : | pazsan | 1.25 | epiper create_pipe \ create pipe for main task |
| 245 : | |||
| 246 : | pazsan | 1.9 | :noname ' >body @ ; |
| 247 : | :noname ' >body @ postpone literal ; | ||
| 248 : | interpret/compile: user' ( 'user' -- n ) | ||
| 249 : | \G USER' computes the task offset of a user variable | ||
| 250 : | |||
| 251 : | pazsan | 1.8 | : >task ( user task -- user' ) + next-task - ; |
| 252 : | pazsan | 1.2 | |
| 253 : | pazsan | 1.10 | : kill-task ( -- ) |
| 254 : | pazsan | 1.24 | epiper @ close-file drop epipew @ close-file drop 0 (bye) ; |
| 255 : | pazsan | 1.10 | |
| 256 : | pazsan | 1.16 | :noname ( -- ) |
| 257 : | pazsan | 1.12 | [ here throw-entry ! ] |
| 258 : | handler @ ?dup-0=-IF | ||
| 259 : | >stderr cr ." uncaught thread exception: " .error cr | ||
| 260 : | pazsan | 1.16 | kill-task |
| 261 : | pazsan | 1.12 | THEN |
| 262 : | pazsan | 1.16 | (throw1) ; drop |
| 263 : | pazsan | 1.12 | |
| 264 : | pazsan | 1.11 | : NewTask4 ( dsize rsize fsize lsize -- task ) |
| 265 : | gforth_create_thread >r | ||
| 266 : | pazsan | 1.12 | throw-entry r@ udp @ throw-entry next-task - /string move |
| 267 : | pazsan | 1.9 | word-pno-size chars dup allocate throw dup holdbufptr r@ >task ! |
| 268 : | + dup holdptr r@ >task ! holdend r@ >task ! | ||
| 269 : | pazsan | 1.24 | epiper r@ >task create_pipe |
| 270 : | pazsan | 1.10 | ['] kill-task >body rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! ! |
| 271 : | pazsan | 1.12 | handler r@ >task off |
| 272 : | pazsan | 1.2 | r> ; |
| 273 : | |||
| 274 : | pazsan | 1.11 | : NewTask ( stacksize -- task ) dup 2dup NewTask4 ; |
| 275 : | |||
| 276 : | pazsan | 1.15 | : (activate) ( task -- ) |
| 277 : | r> swap >r save-task r@ >task ! | ||
| 278 : | pazsan | 1.23 | pthread-id r@ >task pthread_detatch_attr thread_start r> pthread_create drop ; compile-only |
| 279 : | pazsan | 1.7 | |
| 280 : | pazsan | 1.19 | : activate ( task -- ) |
| 281 : | ]] (activate) up! [[ ; immediate compile-only | ||
| 282 : | pazsan | 1.15 | |
| 283 : | pazsan | 1.14 | : (pass) ( x1 .. xn n task -- ) |
| 284 : | pazsan | 1.15 | r> swap >r save-task r@ >task ! |
| 285 : | pazsan | 1.14 | 1+ dup cells negate sp0 r@ >task @ -rot sp0 r@ >task +! |
| 286 : | sp0 r@ >task @ swap 0 ?DO tuck ! cell+ LOOP drop | ||
| 287 : | pazsan | 1.16 | pthread-id r@ >task 0 thread_start r> pthread_create drop ; compile-only |
| 288 : | pazsan | 1.14 | |
| 289 : | pazsan | 1.19 | : pass ( x1 .. xn n task -- ) |
| 290 : | ]] (pass) up! sp0 ! [[ ; immediate compile-only | ||
| 291 : | pazsan | 1.14 | |
| 292 : | pazsan | 1.9 | : sema ( "name" -- ) \ gforth |
| 293 : | \G create a named semaphore | ||
| 294 : | pazsan | 1.6 | Create here 1 pthread-mutexes allot 0 pthread_mutex_init drop ; |
| 295 : | |||
| 296 : | : lock ( addr -- ) pthread_mutex_lock drop ; | ||
| 297 : | : unlock ( addr -- ) pthread_mutex_unlock drop ; | ||
| 298 : | |||
| 299 : | pazsan | 1.19 | : stacksize ( -- n ) forthstart 4 cells + @ |
| 300 : | sp0 @ $FFF and -$1000 or + ; | ||
| 301 : | pazsan | 1.11 | : stacksize4 ( -- dsize rsize fsize lsize ) |
| 302 : | pazsan | 1.19 | forthstart 4 cells + 4 cells bounds DO I @ cell +LOOP |
| 303 : | 2swap swap sp0 @ $FFF and -$1000 or + swap 2swap | ||
| 304 : | swap fp0 @ $FFF and -$1000 or + swap ; | ||
| 305 : | pazsan | 1.7 | |
| 306 : | pazsan | 1.25 | \ event handling |
| 307 : | |||
| 308 : | s" Undefined event" exception Constant !!event!! | ||
| 309 : | s" Event buffer full" exception Constant !!ebuffull!! | ||
| 310 : | |||
| 311 : | Variable event# 1 event# ! | ||
| 312 : | |||
| 313 : | User eventbuf# $100 uallot drop \ 256 bytes buffer for atomic event squences | ||
| 314 : | |||
| 315 : | : <event eventbuf# off ; | ||
| 316 : | : 'event ( -- addr ) eventbuf# dup @ + cell+ ; | ||
| 317 : | : event+ ( n -- addr ) | ||
| 318 : | dup eventbuf# @ + $100 u>= !!ebuffull!! and throw | ||
| 319 : | 'event swap eventbuf# +! ; | ||
| 320 : | : event> ( task -- ) >r eventbuf# cell+ eventbuf# @ | ||
| 321 : | epipew r> >task @ write-file throw ; | ||
| 322 : | |||
| 323 : | : event-crash !!event!! throw ; | ||
| 324 : | |||
| 325 : | Create event-table $100 0 [DO] ' event-crash , [LOOP] | ||
| 326 : | |||
| 327 : | : event-does ( -- ) DOES> @ 'event c! 1 eventbuf# +! ; | ||
| 328 : | : event: Create event# @ , event-does | ||
| 329 : | here 0 , >r noname : lastxt dup event# @ cells event-table + ! | ||
| 330 : | r> ! 1 event# +! ; | ||
| 331 : | pazsan | 1.26 | : stop ( -- ) epiper @ key-file cells event-table + perform ; |
| 332 : | pazsan | 1.27 | : stop-ns ( timeout -- ) epiper @ swap wait_read 0> IF stop THEN ; |
| 333 : | pazsan | 1.25 | : event? ( -- flag ) epiper @ check_read 0> ; |
| 334 : | pazsan | 1.26 | : ?events ( -- ) BEGIN event? WHILE stop REPEAT ; |
| 335 : | : event-loop ( -- ) BEGIN stop AGAIN ; | ||
| 336 : | pazsan | 1.25 | |
| 337 : | pazsan | 1.29 | event: ->lit 0 sp@ cell epiper @ read-file throw drop ; |
| 338 : | event: ->flit 0e fp@ float epiper @ read-file throw drop ; | ||
| 339 : | event: ->wake ; | ||
| 340 : | event: ->sleep stop ; | ||
| 341 : | |||
| 342 : | : wake ( task -- ) <event ->wake event> ; | ||
| 343 : | : sleep ( task -- ) <event ->sleep event> ; | ||
| 344 : | |||
| 345 : | : elit, ( x -- ) ->lit cell event+ [ cell 8 = ] [IF] x! [ELSE] l! [THEN] ; | ||
| 346 : | pazsan | 1.30 | : e$, ( addr u -- ) swap elit, elit, ; |
| 347 : | pazsan | 1.29 | : eflit, ( x -- ) ->flit fp@ float event+ float move fdrop ; |
| 348 : | pazsan | 1.25 | |
| 349 : | false [IF] \ event test | ||
| 350 : | <event 1234 elit, next-task event> ?event 1234 = [IF] ." event ok" cr [THEN] | ||
| 351 : | [THEN] | ||
| 352 : | |||
| 353 : | pazsan | 1.8 | false [IF] \ test |
| 354 : | pazsan | 1.6 | semaphore testsem |
| 355 : | |||
| 356 : | : test-thread1 | ||
| 357 : | pazsan | 1.25 | stacksize4 NewTask4 activate 0 hex |
| 358 : | pazsan | 1.6 | BEGIN |
| 359 : | testsem lock | ||
| 360 : | pazsan | 1.7 | ." Thread-Test1 " dup . cr 1000 ms |
| 361 : | testsem unlock 1+ | ||
| 362 : | pazsan | 1.6 | 100 0 DO pause LOOP |
| 363 : | AGAIN ; | ||
| 364 : | |||
| 365 : | : test-thread2 | ||
| 366 : | pazsan | 1.25 | stacksize4 NewTask4 activate 0 decimal |
| 367 : | pazsan | 1.6 | BEGIN |
| 368 : | testsem lock | ||
| 369 : | pazsan | 1.7 | ." Thread-Test2 " dup . cr 1000 ms |
| 370 : | testsem unlock 1+ | ||
| 371 : | pazsan | 1.6 | 100 0 DO pause LOOP |
| 372 : | AGAIN ; | ||
| 373 : | pazsan | 1.2 | |
| 374 : | pazsan | 1.7 | test-thread1 |
| 375 : | test-thread2 | ||
| 376 : | pazsan | 1.12 | [THEN] |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |