RE: Native Threads in the RTS

2002-11-18 Thread Simon Peyton-Jones

| I propose adding something like
| 
| forkNativeThread :: IO () -> IO ()

I haven't talked to Simon about this, but it sounds possible.  Three
thoughts.

First, before doing anything like this I'd like to ask you or someone
else, or a group, to write a clear exposition of what the problem is and
what the solution is, to add to the GHC user manual.  (If there are
implementation related questions, they can go into the Commentary.)  As
you say, this is a topic that we have visited regularly, and it's a
slippery one, so I'd like to capture it.

Second, there's the question of what it really means.  In particular,
what if that thread forks further (Haskell, green) threads?  Are they
too bound to the native thread?  A library you call might in principle
fork threads to get its job done...

Third

| If a callback is entered and the current OS thread corresponds to a
| native haskell thread, the callback should be executed in the current
| OS thread.
| Other haskell threads continue to run in the worker thread or in their
| own dedicated OS thread.

I'm not sure what this means.  What is the "current" OS thread?  Perhaps
an example? 

Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Silly question about IORefs and MVars

2002-11-18 Thread Simon Marlow

> I have a silly question about IORefs and MVars.
> 
> When do we have to use MVars if a var is accessed by multiple 
> threads. 
> In fact, I wonder why IORefs updates aren't safe :
> it seems that preemptive scheduling takes place during memory 
> allocation 
> and I can't see where there could be an allocation (and so a 
> switch) in 
> a read or a write of an IORef.

The problem is how to read the IORef, modify its contents, and write the
new value back without being preempted.  You can do this easily with an
MVar, but not an IORef.

> Related question : how less performant is a MVar comparated to simple 
> ref.

reading/writing an MVar is an out-of-line call, whereas the IORef
operations are all inline.  I don't know the figures though.

Recently we added atomicModifyIORef which should allow IORefs to be used
in some cases where MVars were required before.  We haven't settled on
the exact interface yet, though.

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Native Threads in the RTS

2002-11-18 Thread Simon Marlow
> I'm still unconvinced that the  current optional
> RTS support for mixed green/native threads is the right way 
> to go. It looks to
> me like a workaround for poor OS support for really 
> lightweight threads.

It is a workaround for the lack of truly lightweight threads at the OS
level.  But I don't expect that situation to change, even with the
recent improvements on the Linux front.  The new RedHat Linux threads
folk claim to be able to create 10^5 threads in a couple of seconds,
whereas we can create 10^6 threads in about that time (on an old 500MHz
machine, too).

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Native Threads in the RTS

2002-11-18 Thread Simon Marlow
> We can't currently allow several Haskell threads to really run 
> simultaneosly [e.g. on two separate processors, or preemtively 
> scheduled on a single processor], because they always mutate the same 
> global heap. Currently, GHC switches its green threads only at times 
> when the heap is in a defined state [not truly preemptively]. There 
> seems to be some SMP support in the RTS, I don't know if it ever 
> worked. If anyone wants to fix/finish it, that would be 
> great, but it's not what I'm proposing here.

The SMP support is an experiment that was never finished.  There are
serious issues to be solved regarding reducing the locking overhead on a
shared-memory heap.

> My proposal is only a minimum solution intended to resolve 
> the inherent 
> incompatibility between the "threaded RTS" and libraries like OpenGL, 
> which require thread-local-state.

I think I'm happy with that, although I don't have the whole context
swapped in.  That seems to be the conclusion we came to at the last
discussion, though:

http://www.haskell.org/pipermail/glasgow-haskell-users/2002-June/003592.
html

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: first stab at -ffunction-sections

2002-11-18 Thread Simon Marlow
> This could be an artifact of the -j64 (BTW, has anyone else 
> noticed the
> makefiles can only keep 5 or 6 cpus busy at a time much of the time,
> and often less?).

There are probably still bugs in our build system w.r.t. make -jN.  I
occasionally use it to build the compiler, but rarely any other parts of
the system.

What exactly are you trying to use -ffunction-sections for?  I'm pretty
sure it won't work as things stand currently, unless you can guarantee
to be able to find a text/data boundary symbol for the garbage collector
(currently it has to be able to distinguish text from data, we're in the
process of lifting the restriction but it's a lot of work).

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Class/Implicit Param/Module Interface bug

2002-11-18 Thread Simon Peyton-Jones
These bugs are now fixed in the HEAD.  I hope the fixes will make it
into 5.04.2 as well.

Thanks for identifying them.  It was all horribly bogus before.

Simon

| -Original Message-
| From: Ashley Yakeley [mailto:[EMAIL PROTECTED]]
| Sent: 13 November 2002 13:46
| To: Simon Peyton-Jones
| Cc: GHC List
| Subject: Re: Class/Implicit Param/Module Interface bug
| 
| Actually it's worse than that. This crashes:
| 
| module Main where
|   {
|   import A;
| 
|   main = let {?p="test"} in putStrLn f;   -- BUG: this crashes
| --main = let {?p="test"} in putStrLn g;   -- this works
|   }
| 
| 
| --
| Ashley Yakeley, Seattle WA
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: -Werror Request

2002-11-18 Thread Simon Marlow
> If it's not too much work, I'd like to request a "-Werror" 
> option for GHC 
> that would turn warnings into errors. Sometimes warnings one 
> would like to catch get lost in a long make process.

We agree, it's on the TODO list.

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: first stab at -ffunction-sections

2002-11-18 Thread William Lee Irwin III
On Mon, Nov 18, 2002 at 11:55:27AM -, Simon Marlow wrote:
> What exactly are you trying to use -ffunction-sections for?  I'm pretty
> sure it won't work as things stand currently, unless you can guarantee
> to be able to find a text/data boundary symbol for the garbage collector
> (currently it has to be able to distinguish text from data, we're in the
> process of lifting the restriction but it's a lot of work).

Trying to garbage-collect unused functions to reduce the size of the
.text section.


Bill
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Bug? [was: Implicit params]

2002-11-18 Thread Simon Peyton-Jones
Now fixed in the HEAD, and will be in 5.04.2

Thanks for pointing it out.

Simon

| -Original Message-
| From: Jorge Adriano [mailto:[EMAIL PROTECTED]]
| Sent: 14 November 2002 21:10
| To: Iavor S. Diatchki
| Cc: Haskell Cafe; [EMAIL PROTECTED]
| Subject: Bug? [was: Implicit params]
| 
| On Thursday 14 November 2002 18:47, Iavor S. Diatchki wrote:
| > hello,
| >
| > > Well, actually you must be right since the pure field defines a
pure
| > > (projection) function... Hmmm, ok, can someone explain this to me,
| > >
| > > data E s = E{
| > >   refi :: STRef s Int,
| > >   refc :: STRef s Char,
| > >   m:: Int
| > > }
| > >
| > > -- this is fine, obviously...
| > > pure   :: E s -> Int
| > > pure e = m e
| > >
| > > -- but this is not...
| > > pure2 :: (?e :: E s) => Int
| > > pure2 = m (?e)
| > >
| > > Why exactly isn't this allowed? What is the workaround?
| > > Error msg:
| > >

| > > Ambiguous constraint `?e :: E s'
| > > At least one of the forall'd type variables mentioned by
the
| > > constraint
| > > must be reachable from the type after the '=>'
| > > In the type: forall s. (?e :: E s) => Int
| > > While checking the type signature for `pure2'
| > > Failed, modules loaded: none.
| > >

-
| > >-
| >
| > this seems like a bug in GHC.   Hugs is happy with it.  The "s" in
the
| > pure2 signature is not ambiguous because it is determined when you
give
| > the value of the implicit parameter.  in fact the way i think about
| > implicit parameters is simply as a nice notation for computations in
the
| > environment monad, so in my mind the above two definitions are
pretty
| > much the same.
| 
| Thanks Iavor!
| GHC people, can you confirm this, Is it a bug? I'm using Ghc 5.0.4
SuSE rpms.
| Is there a workaround?
| 
| Thanks,
| J.A.
| 
| 
| 
| ___
| Glasgow-haskell-users mailing list
| [EMAIL PROTECTED]
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Bug? [was: Implicit params]

2002-11-18 Thread Jorge Adriano

> Now fixed in the HEAD, and will be in 5.04.2
>
> Thanks for pointing it out.
>
> Simon

Thanks :)
J.A.
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: first stab at -ffunction-sections

2002-11-18 Thread Simon Marlow

> On Mon, Nov 18, 2002 at 11:55:27AM -, Simon Marlow wrote:
> > What exactly are you trying to use -ffunction-sections for? 
>  I'm pretty
> > sure it won't work as things stand currently, unless you 
> can guarantee
> > to be able to find a text/data boundary symbol for the 
> garbage collector
> > (currently it has to be able to distinguish text from data, 
> we're in the
> > process of lifting the restriction but it's a lot of work).
> 
> Trying to garbage-collect unused functions to reduce the size of the
> .text section.

You should be aware that -split-objs (the trick we use to build our
libraries in lots of little bits) gets most of the benefit that you'd
get from using -ffunction-sections.  You might get slightly more
fine-grained discarding of code with -ffunction-sections, but the effect
won't be dramatic (I'm guessing).  Also there's the issues of telling
the garbage collector and the mangler about it.

However, it would be nice to be able to use
-ffunction-sections/--gc-sections instead of -split-objs.  It's been at
the back of my mind to have a go at this someday...

Cheers,
Simon
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



unsafePerformIO and IORefs

2002-11-18 Thread Nicolas Oury
I want to write something like

type State a = IORef a

newState :: a -> State a
newState v = unsafePerformIO (newIORef  v)


But I don't want the compileer to inline this nor to inline any 
application of this.

{#NOINLINE newState#}

But how can I stop this function to be inlined when applied for example :

let x = newState 0 in
{... code where x is used twice ...}

How to be sure that x isn't inlined and that all occurences of x are 
pointing to the same memory place ?

Best regards,
Nicolas Oury

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: unsafePerformIO and IORefs

2002-11-18 Thread Hal Daume III
You can't.  CSE (common subexpression elimination) will replace any
occurances of 'newState 0' in a function body with the same value.

In short: don't use upIO :)

If I'm wrong, someone will correct me.  But expect a few "what are you
trying to do" email messages or people suggesting implicit paremeters or
monad wrappers (in fact, count this as the first of said emails).

 - Hal

--
Hal Daume III

 "Computer science is no more about computers| [EMAIL PROTECTED]
  than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume

On Mon, 18 Nov 2002, Nicolas Oury wrote:

> I want to write something like
> 
> type State a = IORef a
> 
> newState :: a -> State a
> newState v = unsafePerformIO (newIORef  v)
> 
> 
> But I don't want the compileer to inline this nor to inline any 
> application of this.
> 
> {#NOINLINE newState#}
> 
> But how can I stop this function to be inlined when applied for example :
> 
> let x = newState 0 in
> {... code where x is used twice ...}
> 
> How to be sure that x isn't inlined and that all occurences of x are 
> pointing to the same memory place ?
> 
> Best regards,
> Nicolas Oury
> 
> ___
> Glasgow-haskell-users mailing list
> [EMAIL PROTECTED]
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
> 

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePerformIO and IORefs

2002-11-18 Thread Sven Panne
Hal Daume III wrote:
> You can't. [...]

Well, you can, but only for CAFs. This idiom/hack is used
quite happily throughout GHC, HOpenGL, H/Direct, ...

Slightly modified stuff from GHC's sources:


-- global variables in Haskell :-)


global :: a -> IORef a
global a = unsafePerformIO (newIORef a)

#define GLOBAL_VAR(name,value,ty) \
name :: IORef (ty) ; \
name = global (value) ; \
{-# NOINLINE name #-}


-- examples


GLOBAL_VAR(counter, 0, Int)
GLOBAL_VAR(flag, False, Bool)



Cheers,
   S.

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePerformIO and IORefs

2002-11-18 Thread Michael Weber
On Mon, Nov 18, 2002 at 10:36:05AM -0800, Hal Daume III wrote:
> You can't.  CSE (common subexpression elimination) will replace any
> occurances of 'newState 0' in a function body with the same value.
> 
> In short: don't use upIO :)

Sorry, cannot resist to pour a little salt onto the wound :)

[232]% grep global ghc/compiler/utils/Util.lhs 
, global
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
[233]%

ghc/compiler/HsVersions.h:
[...]
#ifdef __GLASGOW_HASKELL__
#define GLOBAL_VAR(name,value,ty)  \
name = Util.global (value) :: IORef (ty); \
{-# NOINLINE name #-}
#endif


[237]% grep -r GLOBAL_VAR ghc/compiler | wc -l  
 90


Muahahah... ;-P


Cheers,
Michael
___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePerformIO and IORefs

2002-11-18 Thread Ashley Yakeley
At 2002-11-18 11:05, Sven Panne wrote:

>global :: a -> IORef a
>global a = unsafePerformIO (newIORef a)

This is useful, you can do this with it:

  ref = global Nothing

  convert :: a -> IO b
  convert a = do
writeIORef ref (Just a)
Just b <- readIORef ref
return b


-- 
Ashley Yakeley, Seattle WA

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Native Threads in the RTS

2002-11-18 Thread Nicolas Oury
I don't know if what I say is pertinent, but there was another problem 
that was discussed in the thread about threaded RTS.
One may want to use a finalizer in a particular thread.
For example, a finalizer that put make a rotating cube on screen must be 
ran in the same thread as the Opengl/GLUT things...

Best regards,
Nicolas Oury

Le vendredi 15 novembre 2002, à 06:02 , Wolfgang Thaller a écrit :




I propose adding something like

forkNativeThread :: IO () -> IO ()

which forks a new Haskell thread that has its own OS thread to execute 
in. Note that the fact that only one Haskell thread may execute at a 
time remains unchanged.
Whenever the scheduler determines that a "native" haskell thread is 
next, it sends the OS worker thread to sleep and wakes up the OS thread 
corresponding to the "native" haskell thread. When the "native" haskell 
thread yields again, so does the corresponding OS thread.

Foreign calls from "normal" (non-native) haskell threads should be 
handled in exactly the same way as they are currently.

If a callback is entered and the current OS thread corresponds to a 
native haskell thread, the callback should be executed in the current 
OS thread.
Other haskell threads continue to run in the worker thread or in their 
own dedicated OS thread.

Programs that don't use forkNativeThread won't be affected by the 
change. Thread switching to and from native threads will be slower, but 
not painfully slow.

Wrapping an entire HOpenGL program in forkNativeThread should solve the 
OpenGL/GLUT thread-local-state problem, for example, and who knows what 
else it is good for.

Any comments? Opinions?


Wolfgang

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePerformIO and IORefs

2002-11-18 Thread Lennart Augustsson
Yes, there are several reasons for having UNSAFE in the name. :-)

   -- Lennart

Ashley Yakeley wrote:


At 2002-11-18 11:05, Sven Panne wrote:

 

global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
   


This is useful, you can do this with it:

 ref = global Nothing

 convert :: a -> IO b
 convert a = do
   writeIORef ref (Just a)
   Just b <- readIORef ref
   return b


 




___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Native Threads in the RTS

2002-11-18 Thread Nicolas Oury
I don't know if it is planned but I think it could be great to be able 
to have, in the new OS thread for OpenGL, an "expressivity only"
concurrence system. I mean that to be able to fork user threads that are 
executed in the new OS thread. These new threads  would be  blocked on 
other threads in that kernel thread blocked, but can all access to this 
library, and will make programming easier.

Best regards,
Nicolas Oury
Le vendredi 15 novembre 2002, à 06:02 , Wolfgang Thaller a écrit :

Hello All,

A while ago there was a discussion on the shortcomings of the threaded 
RTS (in short, it doesn't work with foreign APIs that use thread-local 
state, and that breaks HOpenGL). Back then, it was decided to just keep 
the threaded RTS off by default and to do something about it some time 
after 5.04.
I believe it's time to think about it again, so I'll take the liberty 
of proposing an extension to the RTS that might solve the problem.

I propose adding something like

forkNativeThread :: IO () -> IO ()

which forks a new Haskell thread that has its own OS thread to execute 
in. Note that the fact that only one Haskell thread may execute at a 
time remains unchanged.
Whenever the scheduler determines that a "native" haskell thread is 
next, it sends the OS worker thread to sleep and wakes up the OS thread 
corresponding to the "native" haskell thread. When the "native" haskell 
thread yields again, so does the corresponding OS thread.

Foreign calls from "normal" (non-native) haskell threads should be 
handled in exactly the same way as they are currently.

If a callback is entered and the current OS thread corresponds to a 
native haskell thread, the callback should be executed in the current 
OS thread.
Other haskell threads continue to run in the worker thread or in their 
own dedicated OS thread.

Programs that don't use forkNativeThread won't be affected by the 
change. Thread switching to and from native threads will be slower, but 
not painfully slow.

Wrapping an entire HOpenGL program in forkNativeThread should solve the 
OpenGL/GLUT thread-local-state problem, for example, and who knows what 
else it is good for.

Any comments? Opinions?


Wolfgang

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: first stab at -ffunction-sections

2002-11-18 Thread William Lee Irwin III
On Mon, Nov 18, 2002 at 04:57:50PM -, Simon Marlow wrote:
> You should be aware that -split-objs (the trick we use to build our
> libraries in lots of little bits) gets most of the benefit that you'd
> get from using -ffunction-sections.  You might get slightly more
> fine-grained discarding of code with -ffunction-sections, but the effect
> won't be dramatic (I'm guessing).  Also there's the issues of telling
> the garbage collector and the mangler about it.
> However, it would be nice to be able to use
> -ffunction-sections/--gc-sections instead of -split-objs.  It's been at
> the back of my mind to have a go at this someday...


I noticed a lot of not-obviously-used stuff brought in from various
libraries and wanted to nuke some of the unneeded things. Step 1 was
trying to compile the libraries with the option, which didn't quite
fly... it looks like ghc-asm is the primary sufferer, and I'm not sure
the compiler option is needed...

$T_DOT_WORD = '\.(long|value|byte|zero)';
$T_DOT_GLOBAL   = '\.globl';
$T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11
)
$T_HDR_misc = "\.text\n\t\.align 4\n";
$T_HDR_data = "\.data\n\t\.align 4\n"; # ToDo: change align??
$T_HDR_consist  = "\.text\n";
$T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
$T_HDR_srt  = "\.text\n\t\.align 4\n"; # ToDo: change align?
$T_HDR_info = "\.text\n\t\.align 4\n"; # NB: requires padding
$T_HDR_entry= "\.text\n"; # no .align so we're right next to _info (argu
ably wrong...?)
$T_HDR_fast = "\.text\n\t\.align 4\n";
$T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
$T_HDR_direct   = "\.text\n\t\.align 4\n";
$T_create_word  = "\t.word";

So basically it's tagging various items directly with the section they
go to as it is, so a compiler option may very well be superfluous; just
hack ghc-asm. Adding some extra goo in mangle_asm() to get the section
name to be related to the symbol doesn't look too bad.

-split-objs I didn't really realize was there. I see (tracing through ghc5,
whatever debian's latest shipping version is):

ghc/compiler/main/DriverFlags.hs:250
  ,  ( "split-objs" , NoArg (if can_split
then do writeIORef v_Split_object_files True
add v_Opt_C "-fglobalise-toplev-name
s"
else hPutStrLn stderr
"warning: don't know how to  split \
\object files on this architecture"
) )

ghc/compiler/main/DriverFlags.hs:250
opt_EnsureSplittableC   = lookUp  FSLIT("-fglobalise-toplev-names")


./ghc/compiler/codeGen/CgConTbls.lhs:109
genConInfo comp_info data_con
  = -- Order of things is to reduce forward references
mkAbstractCs [if opt_EnsureSplittableC then CSplitMarker else AbsCNop,
  closure_code,
  static_code]


./ghc/compiler/codeGen/CodeGen.lhs:260
maybeExternaliseId id
  | opt_EnsureSplittableC,  -- Externalise the name for -split-objs
isInternalName name
  = moduleName   `thenFC` \ mod ->
returnFC (setIdName id (mkExternalName uniq mod new_occ (nameSrcLoc name)))


./ghc/compiler/codeGen/CodeGen.lhs:276
maybeSplitCode
  | opt_EnsureSplittableC = CSplitMarker
  | otherwise = AbsCNop


./ghc/compiler/nativeGen/AbsCStixGen.lhs:272
 gencode CSplitMarker
   | opt_EnsureSplittableC = returnUs (\xs -> StLabel mkSplitMarkerLabel : xs)
   | otherwise = returnUs id


./ghc/compiler/absCSyn/CLabel.lhs:245
mkSplitMarkerLabel  = RtsLabel (Rts_Code "__stg_split_marker")


Then in ghc/driver/split/ghc-split.lprl:287 (there's actually one per arch):

# strip the marker

$str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\
n/$1/;
$str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;  

   ...

So to me it looks feasible to figure out who's fooling with these
things, though it's probably not necessary to do any of this within the
compiler except for whatever might circumvent ghc-asm, if anything.

At any rate, I am finding the amount of unused code/data linked into
the generated executables significant... for instance, in a non-
concurrent program:

080a1c64 D MVar_modifyMVarzu_closure
0805aeb8 T MVar_modifyMVarzu_entry
0805aece T MVar_modifyMVarzu_fast3
0805aeb8 T MVar_modifyMVarzu_info

... and as it's a 9-line script to mangle patches, it's certainly not
using this:

0805b140 T __stginit_PosixDB

The idea with -ffunction-sections or brewing up an equivalent is to
build the libraries with it so when the final executable is linked, it
imports only the code and statically-allocated data it uses from them.


Thanks,
Bill
___
Glasgow-haskell-users mailing list
[E

Re: Native Threads in the RTS

2002-11-18 Thread Wolfgang Thaller
Nicolas Oury wrote:


I don't know if what I say is pertinent, but there was another problem 
that was discussed in the thread about threaded RTS.
One may want to use a finalizer in a particular thread.
For example, a finalizer that put make a rotating cube on screen must 
be ran in the same thread as the Opengl/GLUT things...

Good point. That feature won't be covered by my first proposal (As I 
said, I'll write up a proper document about that ASAP, that is, as soon 
as I find an entire hour of free time). It sounds useful at first, but 
I'm not that sure about it: after all, we can't rely on when the 
finalizer will be executed: the thread might no longer be around, and 
the GLUT window might be long closed. We should definitely think about 
it a little more, though.

I don't know if it is planned but I think it could be great to be able 
to have, in the new OS thread for OpenGL, an "expressivity only"
concurrence system. I mean that to be able to fork user threads that 
are executed in the new OS thread. These new threads  would be  
blocked on other threads in that kernel thread blocked, but can all 
access to this library, and will make programming easier.

This sounds a lot like the "thread group" idea that somebody had when 
we last discussed this. I think it gives us added flexibility at the 
cost of more difficult implementation and the danger of accidentally 
blocking OS threads [it might be just yet another source of bugs].

I'll first write up something in order to explain/accurately define the 
simple solution I proposed. After that, we can still design a more 
complex solution that addresses these two issues.

Cheers,

Wolfgang Thaller

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users