14 # that caused the interrupt. The file descriptor(s) should in turn |
14 # that caused the interrupt. The file descriptor(s) should in turn |
15 # point us the the proper me8100 object ... |
15 # point us the the proper me8100 object ... |
16 # |
16 # |
17 $SIG{IO} = sub { |
17 $SIG{IO} = sub { |
18 my $val; |
18 my $val; |
19 warn "Got Signal $_[0]\n"; |
19 warn "Got signal $_[0]\n"; |
|
20 return; |
20 |
21 |
21 my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects); |
22 my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects); |
22 my @ready = $select->can_read(0); |
23 my @ready = $select->can_read(0); |
23 |
24 |
24 foreach my $fd (@ready) { |
25 foreach my $fd (@ready) { |
25 my $current = $Objects{$fd}; |
26 my $current = $Objects{$fd}; |
26 my $idx = $current->{idx}; |
27 my $idx = $current->{idx}; |
27 my $object = $current->{object}; |
28 my $object = $current->{object}; |
28 |
29 |
|
30 warn "read ", $fd->fileno(), "\n"; |
|
31 |
29 my $val; |
32 my $val; |
30 $fd->sysread($val, 2) or carp("sysread(): $!\n"); |
33 $fd->sysread($val, 2) or carp("sysread(): $!\n"); |
31 $object->{inputs}->[$idx] = $val; |
34 $object->{inputs}->[$idx] = $val; |
|
35 $object->{changed} = 1; |
32 } |
36 } |
|
37 |
|
38 warn "done signal\n"; |
33 |
39 |
34 }; |
40 }; |
35 |
41 |
36 |
42 |
37 # Create a new object. Open all the named devices (read only) |
43 # Create a new object. Open all the named devices (read only) |
65 ++$idx; |
71 ++$idx; |
66 } |
72 } |
67 |
73 |
68 $self->{fds} = [@fds]; |
74 $self->{fds} = [@fds]; |
69 $self->{inputs} = [@inputs]; |
75 $self->{inputs} = [@inputs]; |
|
76 $self->{select} = new IO::Select(@fds); |
|
77 $self->{changed} = 1; |
70 |
78 |
71 return $self; |
79 return $self; |
72 } |
80 } |
73 |
81 |
74 sub read { |
82 sub read { |
75 my $self = shift; |
83 my $self = shift; |
|
84 my $timeout = shift; |
|
85 |
|
86 if (!$self->{irq_seen}) { |
|
87 # This might be a race with the signal handler above, |
|
88 # thus we'll have to really read if select returns, as |
|
89 # we can't know for sure if the signal handler did it already. |
|
90 warn "select() w/ timeout " |
|
91 . (defined($timeout) ? $timeout : " undef") . "\n"; |
|
92 my @fds = $self->{select}->can_read($timeout); |
|
93 warn "done select()\n"; |
|
94 foreach my $fd (@fds) { |
|
95 my $val; |
|
96 $fd->sysread($val, 2) |
|
97 or croak("sysread(): $!\n"); |
|
98 $self->{inputs}->[$Objects{$fd}->{idx}] = $val; |
|
99 } |
|
100 } else { |
|
101 $self->{irq_seen} = 0; |
|
102 } |
76 return split //, unpack("b*", join("", @{$self->{inputs}})); |
103 return split //, unpack("b*", join("", @{$self->{inputs}})); |
|
104 } |
|
105 |
|
106 sub changed { |
|
107 my $self; |
|
108 return $self->{changed}; |
77 } |
109 } |
78 |
110 |
79 sub DESTROY |
111 sub DESTROY |
80 { |
112 { |
81 my $self = shift; |
113 my $self = shift; |