ACME-6502/lib/TieMem.pm

#package Tie::Filter::Array;
package TieMem;

use 5.008;
use strict;
use warnings;

use Carp qw/confess cluck/;
use base qw/Tie::Array/;

use Data::Dump qw/dump/;

our $VERSION = '1.02';

=head1 NAME

Tie::Filter::Array - Tie a facade around an array

=head1 DESCRIPTION

Don't use this package directly. Instead, see L<Tie::Filter>.

=cut

sub _read {
        my ( $self, $index ) = @_;
        my $value = $$self{WRAP}[$index & 0xffff];
        cluck "read undef value from $index" unless defined($value);
#       printf "_read(%04x) = %2x %d\n", $index, $value, $value;
        $self->{mmu}->( $index, 'read', $value );
        return $value;
}

sub _write {
        my ( $self, $index, $value ) = @_;
        confess "write undef value to $index" unless defined($value);
#       printf "_write(%04x) = %2x %d\n", $index, $value, $value;
        $self->{mmu}->( $index, 'write', $value );
        $$self{WRAP}[$index] = $value;
}

my @ram = (0) x 65536;

=head2 ram

Access low-level ram without tracing through MMU routines

=cut

sub ram {
        return \@ram;
}

sub TIEARRAY {
        my %self;
        my ($class, $args) = @_;
        warn "tiemem",dump( $class, $args );
        $self{WRAP} = \@ram;
        foreach my $p ( qw/mmu/ ) {
                $self{$p} = $args->{$p} || die "no $p ?";
        }
        return bless \%self, $class;
}

sub FETCH {
        my ($self, $index) = @_;
        $self->_read($index);
}

sub STORE {
        my ($self, $index, $value) = @_;
        $self->_write( $index, $value );
}

sub FETCHSIZE {
        my $self = shift;
        scalar(@{$$self{WRAP}});
}

sub STORESIZE {
        my ($self, $count) = @_;
        $#{$$self{WRAP}} = $count - 1;
}

# TODO (?) Detect if the wrappee is tied and call it's EXTEND if it is,
# otherwise do nothing.
sub EXTEND { }

sub EXISTS {
        my ($self, $index) = @_;
        exists $$self{WRAP}[$index];
}

sub DELETE {
        my ($self, $index) = @_;
        delete $$self{WRAP}[$index];
}

sub CLEAR {
        my $self = shift;
        @{$$self{WRAP}} = ();
}

sub PUSH {
        my $self = shift;
        push @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
}

sub POP {
        my $self = shift;
        Tie::Filter::_filter($$self{FETCH}, pop @{$$self{WRAP}});
}

sub SHIFT {
        my $self = shift;
        Tie::Filter::_filter($$self{FETCH}, shift @{$$self{WRAP}});
}

sub UNSHIFT {
        my $self = shift;
        unshift @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
}

sub SPLICE {
        my $self = shift;
        my $offset = shift;
        my $length = shift;
        printf "## splice(%04x,%04x) %d,%d\n", ( $offset, $length ) x 2;
        splice(@{$$self{WRAP}}, $offset, $length, @_);
}

sub UNTIE { }

sub DESTROY { }

=head1 SEE ALSO

L<perltie>, L<Tie::Filter>

=head1 AUTHOR

  Andrew Sterling Hanenkamp, <sterling@hanenkamp.com>

=head1 LICENSE AND COPYRIGHT

Copyright 2003 Andrew Sterling Hanenkamp. All Rights Reserved. This library is
free software; you can redistribute it and/or modify it under the same terms as
Perl itself.

=cut

1

1	dpavlin	5	#package Tie::Filter::Array;
2			package TieMem;
3
4			use 5.008;
5			use strict;
6			use warnings;
7
8	dpavlin	7	use Carp qw/confess cluck/;
9	dpavlin	5	use base qw/Tie::Array/;
10
11			use Data::Dump qw/dump/;
12
13			our $VERSION = '1.02';
14
15			=head1 NAME
16
17			Tie::Filter::Array - Tie a facade around an array
18
19			=head1 DESCRIPTION
20
21			Don't use this package directly. Instead, see L<Tie::Filter>.
22
23			=cut
24
25			sub _read {
26			my ( $self, $index ) = @_;
27	dpavlin	7	my $value = $$self{WRAP}[$index & 0xffff];
28			cluck "read undef value from $index" unless defined($value);
29	dpavlin	5	# printf "_read(%04x) = %2x %d\n", $index, $value, $value;
30	dpavlin	19	$self->{mmu}->( $index, 'read', $value );
31	dpavlin	5	return $value;
32			}
33
34			sub _write {
35			my ( $self, $index, $value ) = @_;
36			confess "write undef value to $index" unless defined($value);
37			# printf "_write(%04x) = %2x %d\n", $index, $value, $value;
38	dpavlin	19	$self->{mmu}->( $index, 'write', $value );
39	dpavlin	5	$$self{WRAP}[$index] = $value;
40			}
41
42	dpavlin	7	my @ram = (0) x 65536;
43	dpavlin	5
44	dpavlin	21	=head2 ram
45
46			Access low-level ram without tracing through MMU routines
47
48			=cut
49
50			sub ram {
51			return \@ram;
52			}
53
54	dpavlin	5	sub TIEARRAY {
55			my %self;
56			my ($class, $args) = @_;
57			warn "tiemem",dump( $class, $args );
58			$self{WRAP} = \@ram;
59	dpavlin	19	foreach my $p ( qw/mmu/ ) {
60	dpavlin	5	$self{$p} = $args->{$p} \|\| die "no $p ?";
61			}
62			return bless \%self, $class;
63			}
64
65			sub FETCH {
66			my ($self, $index) = @_;
67			$self->_read($index);
68			}
69
70			sub STORE {
71			my ($self, $index, $value) = @_;
72			$self->_write( $index, $value );
73			}
74
75			sub FETCHSIZE {
76			my $self = shift;
77			scalar(@{$$self{WRAP}});
78			}
79
80			sub STORESIZE {
81			my ($self, $count) = @_;
82			$#{$$self{WRAP}} = $count - 1;
83			}
84
85			# TODO (?) Detect if the wrappee is tied and call it's EXTEND if it is,
86			# otherwise do nothing.
87			sub EXTEND { }
88
89			sub EXISTS {
90			my ($self, $index) = @_;
91			exists $$self{WRAP}[$index];
92			}
93
94			sub DELETE {
95			my ($self, $index) = @_;
96			delete $$self{WRAP}[$index];
97			}
98
99			sub CLEAR {
100			my $self = shift;
101			@{$$self{WRAP}} = ();
102			}
103
104			sub PUSH {
105			my $self = shift;
106			push @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
107			}
108
109			sub POP {
110			my $self = shift;
111			Tie::Filter::_filter($$self{FETCH}, pop @{$$self{WRAP}});
112			}
113
114			sub SHIFT {
115			my $self = shift;
116			Tie::Filter::_filter($$self{FETCH}, shift @{$$self{WRAP}});
117			}
118
119			sub UNSHIFT {
120			my $self = shift;
121			unshift @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
122			}
123
124			sub SPLICE {
125			my $self = shift;
126			my $offset = shift;
127			my $length = shift;
128			printf "## splice(%04x,%04x) %d,%d\n", ( $offset, $length ) x 2;
129			splice(@{$$self{WRAP}}, $offset, $length, @_);
130			}
131
132			sub UNTIE { }
133
134			sub DESTROY { }
135
136			=head1 SEE ALSO
137
138			L<perltie>, L<Tie::Filter>
139
140			=head1 AUTHOR
141
142			Andrew Sterling Hanenkamp, <sterling@hanenkamp.com>
143
144			=head1 LICENSE AND COPYRIGHT
145
146			Copyright 2003 Andrew Sterling Hanenkamp. All Rights Reserved. This library is
147			free software; you can redistribute it and/or modify it under the same terms as
148			Perl itself.
149
150			=cut
151
152			1
153