htoolkit-cvs

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv20413/src/cbits/Win32

Modified Files:
	Util.c 
Log Message:
After this commit the osStart function will allow the lightweight Haskell threads to continue their execution during GUI main loop.


Index: Util.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Util.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Util.c	3 Mar 2003 00:21:51 -0000	1.4
--- Util.c	14 Mar 2003 15:23:35 -0000	1.5
***************
*** 1,4 ****
--- 1,8 ----
  #define _WIN32_IE 0x0400
  
+ #define IN_STG_CODE 0
+ #include "Stg.h"
+ #include "RtsAPI.h"
+ #include "SchedAPI.h"
  #include "Types.h"
  #include "Handlers_stub.h"
***************
*** 170,176 ****
--- 174,184 ----
  }
  
+ extern StgClosure GHCziConc_yield_closure;
+ 
  void osStart()
  {
  	MSG msg;
+ 	HaskellObj ret;
+ 	SchedulerStatus rc;
  
  	while (gActiveObjects > 0)
***************
*** 187,197 ****
  		};
  
  		if (gActiveObjects <= 0)
  			return;
  
! 		if (GetMessage(&msg, NULL, 0, 0) != 0)
  		{
! 			TranslateMessage(&msg);
! 			DispatchMessage(&msg);
  		}
  	}
--- 195,211 ----
  		};
  
+ 		rc=rts_evalIO(rts_apply((HaskellObj)runIO_closure,&GHCziConc_yield_closure) ,&ret);
+ 		rts_checkSchedStatus("yield",rc);
+ 
  		if (gActiveObjects <= 0)
  			return;
  
! 		if (howManyThreadsAvail() < 1)
  		{
! 			if (GetMessage(&msg, NULL, 0, 0) != 0)
! 			{
! 				TranslateMessage(&msg);
! 				DispatchMessage(&msg);
! 			}
  		}
  	}