add library to replace trbnet functions with registers accesses via UART

diff --git a/perllibs/TrbNetUart.pm b/perllibs/TrbNetUart.pm
new file mode 100644 (file)
index 0000000..0409b3f
--- /dev/null
+++ b/perllibs/TrbNetUart.pm
@@ -0,0 +1,114 @@
+# package TrbNetUart;
+# 
+# 
+# use warnings;
+# use strict;
+# no warnings "portable";
+
+
+#Usage:  
+#  require("TrbNetUart.pm");
+#  TNU_set_device("/dev/ttyUSB0");
+#  use trb_ functions as normal
+
+use Fcntl;
+
+our $TNU_device = '/dev/null';
+our $TNU_fh;
+
+
+sub TNU_set_device {
+  $TNU_device = $_[0];
+}
+
+sub TNU_set_fh {
+  $TNU_fh = $_[0];
+}
+
+sub trb_register_write_mem($$$$$) {
+  my ($fpga, $addr, $mode, $val, $length) = @_;
+  
+  if ($mode > 1) {die "mode $mode not implemented.";}
+  $mode = 1-$mode;
+
+  for my $i (0..$length) {
+    trb_register_write($fpga,$addr+$i*$mode,$val->[$i]);
+    }
+  }
+
+
+sub trb_register_read_mem {
+  die "read memory is not implemented.\n";
+}
+
+
+sub trb_register_write($$$) {
+  my ($fpga,$addr,$value) = @_;
+  my $cmd = sprintf("W%04X%08X",$addr,$value);
+  TNU_serial_rw($TNU_fh, $cmd);
+  }
+
+  
+sub trb_register_read { 
+  my ($fpga,$addr) = @_;
+  my $cmd = sprintf("R%04X",$addr);
+  my $res = TNU_serial_rw($TNU_fh, $cmd, 1);
+  $res = hex(substr($res,5,8));
+  my $h = {$fpga => $res};
+  return $h;
+}
+
+
+sub trb_register_setbit($$$) {
+   my ($fpga,$addr,$bits) = @_;
+   my $r = trb_register_read($fpga,$addr);
+   trb_register_write($fpga,$addr, $r->{$fpga} | $bits  );
+}
+
+sub trb_register_clearbit($$$) {
+   my ($fpga,$addr,$bits) = @_;
+   my $r = trb_register_read($fpga,$addr);
+   trb_register_write($fpga,$addr, $r->{$fpga} & ~$bits  );
+}
+
+
+sub trb_init_ports() {
+  print "Using TTY device $TNU_device.\n";
+  
+  my $command = "stty -F $TNU_device speed 115200 -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke";
+  my $res = qx($command);
+  sysopen($TNU_fh, $TNU_device, O_RDWR|O_NDELAY) or die $!;
+}
+
+sub trb_strerror() {
+  print "There are no errors. By definition. At least none that are handled properly.\n";
+}
+
+
+
+
+sub TNU_serial_rw {
+  my ($fh, $command, $read) = @_;
+  my $x = "";
+  
+  $command .= "\n";
+  
+  print $TNU_fh  "$command";
+
+  for my $i (0..500) {
+    $x .=  <$fh>;
+    if($x && ($x =~ /\n/ || $x =~ /\r/) ) {
+      chomp $x;
+      last;
+      }
+    usleep(1000);
+    }
+
+  return $x;  
+  }
+
+
+
+1;
+# 
+# __END__