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	#package Tie::Filter::Array;
2	package TieMem;
3
4	use 5.008;
5	use strict;
6	use warnings;
7
8	use Carp qw/confess cluck/;
9	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	my $value = $$self{WRAP}[$index & 0xffff];
28	cluck "read undef value from $index" unless defined($value);
29	# printf "_read(%04x) = %2x %d\n", $index, $value, $value;
30	$self->{mmu}->( $index, 'read', $value );
31	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	$self->{mmu}->( $index, 'write', $value );
39	$$self{WRAP}[$index] = $value;
40	}
41
42	my @ram = (0) x 65536;
43
44	=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	sub TIEARRAY {
55	my %self;
56	my ($class, $args) = @_;
57	warn "tiemem",dump( $class, $args );
58	$self{WRAP} = \@ram;
59	foreach my $p ( qw/mmu/ ) {
60	$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