Subversion Repositories w11

#!/usr/bin/perl -w
# $Id: pi_rri 314 2010-07-09 17:38:41Z mueller $
#
# Copyright 2007-2010 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
#
# This program is free software; you may redistribute and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation, either version 2, or at your option any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for complete details.
#
#  Revision History:
# Date         Rev Version  Comment
# 2010-06-27   310   1.6.2  fix autoflush for fh_log; duplicate exec err to log
# 2010-06-18   306   1.6.1  PDPCP_ADDR_IBRB now 020, PDPCP_ADDR_IBR now 0200;
#                           ibrbase now just drops the 6 lsb's; pdpcp mode:
#                           rename librb -> wibrb; finished cp/rri overhaul
# 2010-06-13   305   1.6    change PDPCP_ADDR_ assignments, add PDPCP_FUNC_
#                           constants; adapt pdpcp mode to changed rri addr and
#                           stim file format; emulate old 'sta' behaviour with
#                           new 'stapc' command; rename lal,lah -> wal,wah and
#                           implement locally; adapt serv11 mode to new rri
# 2010-06-11   303   1.5.1  add cmd_inter; flush{"line"} after interactive cmd
#                           added readline support.
# 2010-06-07   302   1.5    use sop/eop framing instead of soc+chaining
# 2010-06-06   301   1.4.18 rename .rpmon->.rbmon; NCOMM=4 (new eop,nak commas)
# 2010-06-03   299   1.4.17 adapt .reset to new rbus init decode
# 2010-05-05   288   1.4.16 first preliminary implementation of eval based
#                           perl macro's via @@pmac; add ^C signal handler;
#                           added optional min/max check for cget_gdat() and
#                           cget_tagval_gdat().
# 2010-05-02   287   1.4.15 enable hardware flow control in termios
# 2010-05-01   286   1.4.14 add .sinit command for rri and pdpcp modes;
#                           add 500k,1M,2M,3M baudrates, check value now
# 2010-04-26   284   1.4.13 add error check for GetOptions
# 2010-04-25   283   1.4.12 raw_rcv9_to: handle undef as return value correctly
# 2009-10-11   244   1.4.11 support > 115kbaud speed; new stat output in log;
#                           use nxbuf_max=8 as default;
# 2009-09-27   242   1.4.10 add "ERR  --" messages in log file; fix usage of
#                           uninitialized vars in serv11_exec_probe();
# 2009-09-25   241   1.4.9  BUGFIX: serv11_server_attn_get() now or's attn bits
# 2009-09-20   240   1.4.8  serv11_rri_uset cache under $ctl, not in unittbl
# 2009-09-13   238   1.4.7  add ctlname for DL11 log entries; only TTA output
#                           written to stdout when no terminal attached.
# 2009-07-26   236   1.4.6  fix cpraw mode and .mode error handling;
# 2009-07-12   233   1.4.5  add attach/detach support for term; telnet support;
# 2009-07-05   232   1.4.4  add cchk_number(), cget_regrange(); rename _atdt_ to
#                           _attdet_; serv11: add exa/dep command; removed
#                           rr[0-7], wr[0-7], rmem, and wmem commands; new probe
#                           handling, use {probe_[ir]val} and {probemask};
#                           serv11: command parser supports abbeviations;
#                           serv11: add set/sho command, reorganize ls* cmds;
#                           serv11: add {trace} parameter; rri_sideband() flush;
# 2009-07-04   231   1.4.3  first reglist definitions; add CPU in _ctltbl;
#                           add serv11_probe_cpu();
# 2009-06-28   230   1.4.2  use serv11_atdt_pc11(), remove atdt via ucb hack;
#                           add serv11_rri_uset(); pc11 now fully supported;
#                           attn log message now gives device; use -e as file
#                           test; add ptape boot mode support; lsconf output
#                           sorted by ibus address;
# 2009-06-21   228   1.4.1  BUGFIX: correct typo in RK6 ucb; reorganize init
#                           handling, introduce usethdl; reorganize attach;
#                           add atdthdl at ctl or ucb level; add det command;
# 2009-06-20   227   1.4    nxbuf_min,max,inc now a ctl property;
# 2009-06-14   226   1.3.31 add very preliminary lp11 device handling
# 2009-06-11   225   1.3.30 quick hack to add dl11 log files.
# 2009-05-30   220   1.3.29 add papertape boot code;
# 2009-05-24   219   1.3.28 add papertape hook as dev "PC" units "PTR" and "PTP"
# 2009-05-21   217   1.3.27 rk11: now error message when init not done
# 2009-05-17   216   1.3.26 BUGFIX:rk11: fix read/write logic for short sectors;
#                           BUGFIX:rk11: re-work the seek complete handling
#                           add read/write check support; add PGE error support;
# 2009-05-13   215   1.3.25 dl11: drop parity bit in transmit path;
#                           rk11: add read/write format; set SOK at init time;
# 2009-05-10   214   1.3.24 BUGFIX: in serv11_attn_rk11() RKER was written
#                           instead of RKMR for RKCS_DRESET, _WLOCK, _SEEK
# 2009-04-11   206   1.3.23 add --int to force interactive mode
#                           fix handling of odd length records in lsabs
# 2008-12-14   177   1.3.22 correct DL11_BASE_B to 176500 (was RL address)
# 2008-11-28   173   1.3.21 serv11_rri_lalh(): allow now mode =0,1,2 and 3;
#                           serv11_rdma_rk11(): use mode=3 in rri_lalh, thus
#                           enable 22bit and ubmap simultaneously.
#                           add proper MEX update for RKCS in rdma_rk11.
#                           add proper DRSEL propagation for RKDA in rdma_rk11.
# 2008-05-30   151   1.3.20 BUGFIX: corrected @que_rcv logic in serv11 input
#                           loop, TT0 output will not longer hang sometimes;
#                           disable the attn+ioto(16 or 63 ms) hack;
# 2008-05-23   150   1.3.19 tio[89b] messages: to $fh_log now, add delta-time;
#                           fixes in disk extend logic and messages; add the
#                           (^c form of ( command; add adaptive read vector
#                           in serv11_attn_dl11;
# 2008-05-22   149   1.3.18 add term_tios_print, fixes for --term under cygwin;
# 2008-05-22   148   1.3.17 add (,< short-cut commands
# 2008-05-18   147   1.3.16 ATTN comma drop now warning, -W (was -I);
# 2008-05-12   145   1.3.15 rename ldpta -> ldabs
# 2008-05-09   144   1.3.14 disable call in attn_dispatch(1) (needs busy logic)
# 2008-05-01   142   1.3.13 serv11: add stop,cont,reset; add $force for attn
#                           handlers; use attn+ioto(16ms) to avoid TTO hangs
# 2008-05-01   141   1.3.12 write TTO char-by-char now to STDOUT
# 2008-04-25   138   1.3.11 show ccc/scc for code 000257/000277 in disassembler
# 2008-04-19   137   1.3.10 minor fix disassembler: use f reg prefix for f4,f5
# 2008-04-18   136   1.3.9  hack in a poor man's output to console...
# 2008-04-13   135   1.3.8  substitute environment variables in cmd file names
# 2008-04-11   134   1.3.7  allow line comments starting with ";" (for simh)
# 2008-04-06   133   1.3.6  fix file check in serv11_cexec_ldpta; fix wrong
#                           opcode for mfps; fixed bug in disassembling mode=77
#                           add -a for lsmem;
# 2008-04-04   132   1.3.5  add in disassembler non-11/70 and fpp codes;
#                           add (>|>>)file option for lsmem (redirect to file)
# 2008-03-39   131   1.3.4  lsmem -m: use now wide (3 word) symbolic dump format
#                           add ldpta command (load paper tape abs format)
#                           add start and step command
# 2008-03-24   129   1.3.3  allow comments when in serv11 server mode.
#                           check attach file size; zero-fill after partial
#                           block write; reorganize dsk file and rdma handling
#                           leading blanks now ignored in commands
# 2008-03-22   128   1.3.2  fully functional server mode (todo: TT <-> telnet)
# 2008-03-19   127   1.3.1  very preliminary server mode now working
# 2008-03-09   124   1.3    add serv11 mode; add PDP11 disamssebler
# 2008-03-02   121   1.2.5  the default .sdef now checks for hard errors.
#                           the _open handlers for rri and pdpcp setup default
#                           Add .cerr, .merr as ignored directives for pdpcp
# 2008-02-24   119   1.2.4  added lah,rps,wps command in .pdpcp mode
# 2008-02-16   116   1.2.3  add librb,[rw]ibr,and wtlam to pdpcp command set
# 2007-12-25   105   1.2.2  for rri mode add .dbas[io] (set base for data vals)
#                           add ${par}, ${par:=val}, ${par:-val} substitution
#                           allow parameter definition via par=val lines
#                           add $[..perl code..] escape to embed perl code
#                           allow @file(arg1,arg2,arg3,...); print .wtlam wait
# 2007-11-24    98   1.2.1  adapt to new rri internal init handling
# 2007-11-18    96   1.2    add 'read before write' logic to avoid deadlocks
#                           under cygwin broken fifo (size=1 !) implementation
# 2007-10-12    88   1.1.4  fix some -w issues
# 2007-09-23    84   1.1.3  .reset command in pdpcp mode; keep-alive in --fifo
# 2007-09-16    83   1.1.2  add --cmax; full --term implemented
# 2007-09-09    80   1.1.1  add --run; modularize I/O handling; initial --term
#                           proper return code / retry loop for sysread/write
# 2007-09-09    80   1.1    new non-blocking/blocking handling; ignore IDLE's 
#                           and unexpected ATTN commas; add <mode>_flush; add
#                           data check handling, command chaining, 'pdpcp' mode.
# 2007-09-02    79   1.0.1  implement 'rri' mode
# 2007-09-01    78   1.0    Initial version

use 5.005;                                  # require Perl 5.005 or higher
use strict;                                 # require strict checking

use FileHandle;
use POSIX qw(mkfifo isatty :termios_h);
use Fcntl qw(O_WRONLY O_RDONLY O_NOCTTY);
use Errno qw(EINTR);
use Time::HiRes qw(gettimeofday);
use Socket;
use Term::ReadLine;

use constant CPREF  => 0x80;
use constant NCOMM  => 4;
use constant CESC   => CPREF|0x0f ;
use constant CEN1   => (~CPREF)&0xf0;
use constant D9IDLE => 0x100;
use constant D9SOP  => 0x101;
use constant D9EOP  => 0x102;
use constant D9NAK  => 0x103;
use constant D9ATTN => 0x104;

use constant PDPCP_ADDR_CONF =>  000;
use constant PDPCP_ADDR_CNTL =>  001;
use constant PDPCP_ADDR_STAT =>  002;
use constant PDPCP_ADDR_PSW  =>  003;
use constant PDPCP_ADDR_AL   =>  004;
use constant PDPCP_ADDR_AH   =>  005;
use constant PDPCP_ADDR_MEM  =>  006;
use constant PDPCP_ADDR_MEMI =>  007;
use constant PDPCP_ADDR_R0   =>  010;
use constant PDPCP_ADDR_PC   =>  017;
use constant PDPCP_ADDR_IBRB =>  020;
use constant PDPCP_ADDR_IBR  => 0200;

use constant PDPCP_FUNC_NOOP => 000;
use constant PDPCP_FUNC_STA  => 001;
use constant PDPCP_FUNC_STO  => 002;
use constant PDPCP_FUNC_CONT => 003;
use constant PDPCP_FUNC_STEP => 004;
use constant PDPCP_FUNC_RST  => 017;

use constant LINUX_B57600    => 0010001;   # B57600  not part of POSIX package !
use constant LINUX_B115200   => 0010002;   #   in linux these values are in
use constant LINUX_B230400   => 0010003;   #   termios.h, specifically in
use constant LINUX_B460800   => 0010004;   #     /usr/include/bits/termios.h
use constant LINUX_B500000   => 0010005;
use constant LINUX_B576000   => 0010006;
use constant LINUX_B921600   => 0010007;
use constant LINUX_B1000000  => 0010010;
use constant LINUX_B2000000  => 0010013;
use constant LINUX_B3000000  => 0010015;

use constant LINUX_CRTSCTS   => 020000000000; # ! Not part of POSIX !!

use Getopt::Long;

my %opts = ();

GetOptions(\%opts, "help", "int", "trace",
                   "tio8", "tio9", "tiob",
                   "dserv", "tserv", "log:s",
                   "fifo:s", "term:s",
                   "timeout=f", "cmax=i",
                   "run=s",
                   )
  or die "bad options";

sub init_regtbl;                            # initialize regtbl from reglist
sub get_command;
sub do_command;
sub read_command;
sub setpar_command;
sub nomode_open;
sub nomode_flush;
sub nomode_close;
sub nomode_cexec;
sub cpraw_open;
sub cpraw_flush;
sub cpraw_close;
sub cpraw_cexec;
sub do_cprx;
sub do_cptx;
sub cpraw_tx_match_now;
sub cpraw_tx_match;
sub rri_open;
sub rri_flush;
sub rri_close;
sub rri_cexec;
sub rri_cget_stat;
sub rri_cget_addr;
sub rri_cget_nblk;
sub rri_sideband;
sub rri_cmdlist_do;
sub rri_cmdlist_dump;
sub rri_cmdlist_exec;
sub rri_cmdlist_check_stat;
sub rri_cmdlist_get_rval;
sub rri_cmdlist_conv_rval;
sub rri_ref_check;                          # check reference data (1=err)
sub pdpcp_open;
sub pdpcp_flush;
sub pdpcp_close;
sub pdpcp_cexec;
sub pdpcp_cmd_rreg;
sub pdpcp_cmd_wreg;
sub serv11_open;
sub serv11_flush;
sub serv11_close;
sub serv11_cexec;
sub serv11_cexec_shoreg;
sub serv11_cexec_shommu_ssrx;
sub serv11_cexec_shommu_sadr;
sub serv11_cexec_ldabs;
sub serv11_cexec_shoconf;
sub serv11_cexec_shoatt;
sub serv11_cexec_attdet;
sub serv11_cexec_boot;
sub serv11_cexec_exa;
sub serv11_cexec_dep;
sub serv11_config;
sub serv11_init_dispatch;
sub serv11_server;
sub serv11_server_attn_get;
sub serv11_server_attn_dispatch;
sub serv11_probe_gen;                       # generic probe handler
sub serv11_init_gen;                        # generic controller init handler
sub serv11_detach_gen;                      # generic detach handler
sub serv11_attdet_disk;                     # generic disk att/det handler
sub serv11_attdet_ronly;                    # generic in  only att/det handler
sub serv11_attdet_wonly;                    # generic out only att/det handler
sub serv11_attdet_term;                     # generic term att/det handler
sub serv11_probe_cpu;                       # cpu: probe handler
sub serv11_attn_cpu;                        # cpu: attention handler
sub serv11_exadep_cpu;                      # cpu: exa/dep handler
sub serv11_ichr_dl11;
sub serv11_attn_dl11;
sub serv11_uset_lp11;
sub serv11_attn_lp11;
sub serv11_uset_pc11;
sub serv11_attdet_pc11;
sub serv11_attn_pc11;
sub serv11_uset_rk11;
sub serv11_attn_rk11;
sub serv11_attn_rk11_logerr;
sub serv11_rdma_rk11;
sub serv11_icb_disk_read;                   # read  one dsk file block
sub serv11_icb_disk_write;                  # write one dsk file block
sub serv11_rri_init;                        # issue rri init command
sub serv11_rri_attn;                        # issue rri attn command
sub serv11_rri_stat;                        # issue rri stat command
sub serv11_rri_rreg;                        # issue rri rreg command
sub serv11_rri_wreg;                        # issue rri wreg command
sub serv11_rri_rblk;                        # issue rri rblk command
sub serv11_rri_wblk;                        # issue rri wblk command
sub serv11_rri_lalh;                        # issue pdpcp lal and lah commands
sub serv11_rri_ibrb;                        # issue rbus set base address
sub serv11_rri_ribr;                        # issue rbus read
sub serv11_rri_wibr;                        # issue rbus write
sub serv11_rri_clear;
sub serv11_rri_exec;
sub serv11_rri_uset;                        # issue rbus uset writes
sub serv11_exec_rblk;
sub serv11_exec_wblk;
sub serv11_exec_probe;
sub next_nxbuf;                             # calculate next nxbuf value
sub telnet_readhdl;                         # telnet: socket read handler
sub telnet_writehdl;                        # telnet: write handler
sub pdp11_disassemble;                      # simple PDP11 disassembler
sub pdp11_disassemble_regmod;               #   helper
sub file_seek;                              # fseek wrapper
sub file_read;                              # fread wrapper
sub file_seek_read;                         # fseek+fread wrapper
sub file_write;                             # fwrite wrapper
sub file_seek_write;                        # fseek+fwrite wrapper
sub raw_get9_crc_16bit;                     # read 16 bit value
sub raw_get9_crc_8bit;                      # read 8bit value
sub raw_get9_crc_check;                     # get 9bit, block, crc, ref value
sub raw_get9_check;                         # get 9bit, block, expect ref value
sub raw_get9_checksop;                      # get 9bit, block, expect 'sop'
sub raw_get9_checkeop;                      # get 9bit, block, expect 'eop'
sub raw_get9_crc;                           # get 9bit, block, update crc
sub raw_get9;                               # get 9bit, block
sub raw_snd9_crc;                           # put 9bit to RX, update crc
sub raw_snd9;                               # put 9bit to RX
sub raw_snd8;                               # put 8bit to RX
sub raw_rcv9;                               # get 9bit from TX, non-blocking
sub raw_rcv8;                               # get 8bit from TX, non-blocking
sub raw_rcv9_to;                            # get 9bit from TX, expl. time-out
sub raw_rcv8_to;                            # get 8bit from TX, expl. time-out
sub wait_sel_filercv;                       # poll/wait for RCV to be ready
sub fifo_open;                              # chan fifo: open handler
sub fifo_close;                             # chan fifo: close handler
sub term_open;                              # chan term: open handler
sub term_close;                             # chan term: close handler
sub term_tios_print;                        # chan term: print termios state
sub genio_read;                             # generic io: read handler
sub genio_write;                            # generic io: write handler
sub cget_chkblank;                          # check for unused chars in cmd line
sub cget_tagval2_gdat;                      # get tag=v1[,v2], generic base
sub cget_tagval_gdat;                       # get tag=val, generic base
sub cget_gdat;                              # get generic base value
sub cget_name;                              # get name \w+
sub cget_bool;                              # get boolean [01]
sub cget_file;                              # get filename [\w\/.]+
sub cget_ucb;                               # get ucb (read name, return ucb)
sub cget_opt;                               # get option
sub cget_optset;                            # get option set
sub cget_regrange;                          # get register/memory range
sub cchk_number;                            # check for number. any gdat value
sub sget_bdat;                              # convert 01 string -> binary value
sub conv_etime;                             # generate timestamp string
sub conv_dat9;
sub conv_dat8;
sub conv_str2bytes;                         # string to bytelist; handle \n
sub conv_buf2wlist;                         # string buffer -> word list
sub conv_wlist2buf;                         # word list -> string buffer
sub conv_byte2ascii2;                       # byte -> 2 charcter ASCII display
sub gconv_dat16;
sub hdl_sigint;                             # SIGINT handler
sub get_time;
sub get_timestamp;
sub filename_expand;                        # expand $nnn in name
sub print_fatal;
sub print_help;

my %stat_tab = ( obyte => 0.,
               oesc  => 0.,
               osop  => 0.,
               ibyte => 0.,
               iesc  => 0.,
               att   => 0.,
               xreg  => 0.,
               xblk  => 0.,
               rdisk => 0.,
               wdisk => 0.);
my %stat_tab_last = %stat_tab;

my %mode_tab = (nomode => {open  => \&nomode_open,
                           flush => \&nomode_flush,
                           close => \&nomode_close,
                           cmd   => \&nomode_cexec},
                cpraw  => {open  => \&cpraw_open,
                           flush => \&cpraw_flush,
                           close => \&cpraw_close,
                           cmd   => \&cpraw_cexec},
                rri    => {open  => \&rri_open,
                           flush => \&rri_flush,
                           close => \&rri_close,
                           cmd   => \&rri_cexec},
                pdpcp  => {open  => \&pdpcp_open,
                           flush => \&pdpcp_flush,
                           close => \&pdpcp_close,
                           cmd   => \&pdpcp_cexec},
                serv11 => {open  => \&serv11_open,
                           flush => \&serv11_flush,
                           close => \&serv11_close,
                           cmd   => \&serv11_cexec}
                );

my %chan_tab = (fifo => {open  => \&fifo_open,
                         close => \&fifo_close,
                         read  => \&genio_read,
                         write => \&genio_write},
                term => {open  => \&term_open,
                         close => \&term_close,
                         read  => \&genio_read,
                         write => \&genio_write}
                );

my $curmode = "nomode";
my $curcmd = \&nomode_cexec;
my $curchan = undef;
my @cmdfh;
my @cmdfn;
my @cmdargs;
my $time0 = -1;
my $tlast_tio8 = 0;
my $tlast_tio9 = 0;
my $tlast_tiob = 0;

my @que_rcv;
my @que_snd;

my @cpraw_tx_read;
my @cpraw_tx_expt;

my $fh_log = *STDOUT;
my $fh_snd;
my $fh_rcv;
my $fdset_filercv;
my $fifo_keep;
my $term_oldtios;
my $raw_rcv_esc = 0;
my $raw_timeout = 1.;
my $cmax = 16;

my $cmd_line;
my $cmd_rest;
my $cmd_bad;
my $cmd_inter;                              # interactive cmd flag

my $term;
if (-t STDIN) {
  $term = new Term::ReadLine 'pi_rri';
}

my %par;                                # params for command line substitution
my $sigint_count = 0;                       # SIGINT counter

use constant TELNET_CODE_NULL =>   0;
use constant TELNET_CODE_LF   =>  10;
use constant TELNET_CODE_CR   =>  13;
use constant TELNET_CODE_ESC  =>  27;
use constant TELNET_CODE_SE   => 240;
use constant TELNET_CODE_NOP  => 241;
use constant TELNET_CODE_IP   => 244;
use constant TELNET_CODE_GA   => 249;
use constant TELNET_CODE_SB   => 250;
use constant TELNET_CODE_WILL => 251;
use constant TELNET_CODE_WONT => 252;
use constant TELNET_CODE_DO   => 253;
use constant TELNET_CODE_DONT => 254;
use constant TELNET_CODE_IAC  => 255;

use constant TELNET_OPT_BIN   =>  0;
use constant TELNET_OPT_ECHO  =>  1;
use constant TELNET_OPT_SGA   =>  3;
use constant TELNET_OPT_TTYP  => 24;
use constant TELNET_OPT_LINE  => 34;

use constant TELNET_STATE_LISTEN => -1;
use constant TELNET_STATE_STREAM =>  0;
use constant TELNET_STATE_IAC    =>  1;
use constant TELNET_STATE_CMD    =>  2;
use constant TELNET_STATE_SUBNEG =>  3;
use constant TELNET_STATE_SUBIAC =>  4;

#
# %telnettbl->{snum} --> telnet session table, hash of hashes, key'ed by port
#   -> {port}        port number (int)
#   -> {state}       state: (_LISTEN|_STREAM|_IAC|_CMD|_SUBNEG|_SUBIAC)
#   -> {fh_port}     file handle of port socket (for listen)
#   -> {fh_data}     file handle of data socket
#   -> {ucb}         ucb the port is attached to
#

my %telnettbl;

my $rri_ref_sdef = 0x00;         # by default check for 'hard' errors
my $rri_msk_sdef = 0xf0;         # ignore the status bits + attn flag
my %rri_amtbl;
my @rri_cmdlist;
my $rri_rvalcnt = 0;
my $rri_ncmdmax = undef;
my $rri_dbasi   = 2;             # default input base
my $rri_dbaso   = 8;             # default output base
my $rri_nodfill = " " x 5;       # filler string for "d=-" stanzas

my %rri_cname2cmd = (rreg => 0,  # c_rri_cmd_rreg : slv3 := "000";
                     rblk => 1,  # c_rri_cmd_rblk : slv3 := "001";
                     wreg => 2,  # c_rri_cmd_wreg : slv3 := "010";
                     wblk => 3,  # c_rri_cmd_wblk : slv3 := "011";
                     stat => 4,  # c_rri_cmd_stat : slv3 := "100";
                     attn => 5,  # c_rri_cmd_attn : slv3 := "101";
                     init => 6); # c_rri_cmd_init : slv3 := "110";

my @crc8_tbl = (   0,  29,  58,  39, 116, 105,  78,  83, # from gen_crc8_tbl
                 232, 245, 210, 207, 156, 129, 166, 187,
                 205, 208, 247, 234, 185, 164, 131, 158,
                  37,  56,  31,   2,  81,  76, 107, 118,
                 135, 154, 189, 160, 243, 238, 201, 212,
                 111, 114,  85,  72,  27,   6,  33,  60,
                  74,  87, 112, 109,  62,  35,   4,  25,
                 162, 191, 152, 133, 214, 203, 236, 241,
                  19,  14,  41,  52, 103, 122,  93,  64,
                 251, 230, 193, 220, 143, 146, 181, 168,
                 222, 195, 228, 249, 170, 183, 144, 141,
                  54,  43,  12,  17,  66,  95, 120, 101,
                 148, 137, 174, 179, 224, 253, 218, 199,
                 124,  97,  70,  91,   8,  21,  50,  47,
                  89,  68,  99, 126,  45,  48,  23,  10,
                 177, 172, 139, 150, 197, 216, 255, 226,
                  38,  59,  28,   1,  82,  79, 104, 117,
                 206, 211, 244, 233, 186, 167, 128, 157,
                 235, 246, 209, 204, 159, 130, 165, 184,
                   3,  30,  57,  36, 119, 106,  77,  80,
                 161, 188, 155, 134, 213, 200, 239, 242,
                  73,  84, 115, 110,  61,  32,   7,  26,
                 108, 113,  86,  75,  24,   5,  34,  63,
                 132, 153, 190, 163, 240, 237, 202, 215,
                  53,  40,  15,  18,  65,  92, 123, 102,
                 221, 192, 231, 250, 169, 180, 147, 142,
                 248, 229, 194, 223, 140, 145, 182, 171,
                  16,  13,  42,  55, 100, 121,  94,  67,
                 178, 175, 136, 149, 198, 219, 252, 225,
                  90,  71,  96, 125,  46,  51,  20,   9,
                 127,  98,  69,  88,  11,  22,  49,  44,
                 151, 138, 173, 176, 227, 254, 217, 196);

my $ocrc = 0;
my $icrc = 0;
my $kpid = -1;

my @pdp11_opcode_tbl = (
    {code=>0000000, mask=>0000000, name=>"halt", type=>"0arg"},
    {code=>0000001, mask=>0000000, name=>"wait", type=>"0arg"},
    {code=>0000002, mask=>0000000, name=>"rti ", type=>"0arg"},
    {code=>0000003, mask=>0000000, name=>"bpt ", type=>"0arg"},
    {code=>0000004, mask=>0000000, name=>"iot ", type=>"0arg"},
    {code=>0000005, mask=>0000000, name=>"reset",type=>"0arg"},
    {code=>0000006, mask=>0000000, name=>"rtt ", type=>"0arg"},
    {code=>0000007, mask=>0000000, name=>"!!mfpt", type=>"0arg"},
    {code=>0000100, mask=>0000077, name=>"jmp ", type=>"1arg"},
    {code=>0000200, mask=>0000007, name=>"rts ", type=>"1reg"},
    {code=>0000230, mask=>0000007, name=>"spl ", type=>"spl"},
    {code=>0000240, mask=>0000017, name=>"cl",   type=>"ccop"},
    {code=>0000260, mask=>0000017, name=>"se",   type=>"ccop"},
    {code=>0000300, mask=>0000077, name=>"swap", type=>"1arg"},
    {code=>0000400, mask=>0000377, name=>"br  ", type=>"br"},
    {code=>0001000, mask=>0000377, name=>"bne ", type=>"br"},
    {code=>0001400, mask=>0000377, name=>"beq ", type=>"br"},
    {code=>0002000, mask=>0000377, name=>"bge ", type=>"br"},
    {code=>0002400, mask=>0000377, name=>"blt ", type=>"br"},
    {code=>0003000, mask=>0000377, name=>"bgt ", type=>"br"},
    {code=>0003400, mask=>0000377, name=>"ble ", type=>"br"},
    {code=>0004000, mask=>0000777, name=>"jsr ", type=>"jsr"},
    {code=>0005000, mask=>0000077, name=>"clr ", type=>"1arg"},
    {code=>0005100, mask=>0000077, name=>"com ", type=>"1arg"},
    {code=>0005200, mask=>0000077, name=>"inc ", type=>"1arg"},
    {code=>0005300, mask=>0000077, name=>"dec ", type=>"1arg"},
    {code=>0005400, mask=>0000077, name=>"neg ", type=>"1arg"},
    {code=>0005500, mask=>0000077, name=>"adc ", type=>"1arg"},
    {code=>0005600, mask=>0000077, name=>"sbc ", type=>"1arg"},
    {code=>0005700, mask=>0000077, name=>"tst ", type=>"1arg"},
    {code=>0006000, mask=>0000077, name=>"ror ", type=>"1arg"},
    {code=>0006100, mask=>0000077, name=>"rol ", type=>"1arg"},
    {code=>0006200, mask=>0000077, name=>"asr ", type=>"1arg"},
    {code=>0006300, mask=>0000077, name=>"asl ", type=>"1arg"},
    {code=>0006400, mask=>0000077, name=>"mark", type=>"mark"},
    {code=>0006500, mask=>0000077, name=>"mfpi", type=>"1arg"},
    {code=>0006600, mask=>0000077, name=>"mtpi", type=>"1arg"},
    {code=>0006700, mask=>0000077, name=>"sxt ", type=>"1arg"},
    {code=>0007000, mask=>0000077, name=>"!!csm",  type=>"1arg"},
    {code=>0007200, mask=>0000077, name=>"!!tstset",type=>"1arg"},
    {code=>0007300, mask=>0000077, name=>"!!wrtlck",type=>"1arg"},
    {code=>0010000, mask=>0007777, name=>"mov ", type=>"2arg"},
    {code=>0020000, mask=>0007777, name=>"cmp ", type=>"2arg"},
    {code=>0030000, mask=>0007777, name=>"bit ", type=>"2arg"},
    {code=>0040000, mask=>0007777, name=>"bic ", type=>"2arg"},
    {code=>0050000, mask=>0007777, name=>"bis ", type=>"2arg"},
    {code=>0060000, mask=>0007777, name=>"add ", type=>"2arg"},
    {code=>0070000, mask=>0000777, name=>"mul ", type=>"rdst"},
    {code=>0071000, mask=>0000777, name=>"div ", type=>"rdst"},
    {code=>0072000, mask=>0000777, name=>"ash ", type=>"rdst"},
    {code=>0073000, mask=>0000777, name=>"ashc", type=>"rdst"},
    {code=>0074000, mask=>0000777, name=>"xor ", type=>"rdst"},
    {code=>0077000, mask=>0000777, name=>"sob ", type=>"sob"},
    {code=>0100000, mask=>0000377, name=>"bpl ", type=>"br"},
    {code=>0100400, mask=>0000377, name=>"bmi ", type=>"br"},
    {code=>0101000, mask=>0000377, name=>"bhi ", type=>"br"},
    {code=>0101400, mask=>0000377, name=>"blos", type=>"br"},
    {code=>0102000, mask=>0000377, name=>"bvc ", type=>"br"},
    {code=>0102400, mask=>0000377, name=>"bvs ", type=>"br"},
    {code=>0103000, mask=>0000377, name=>"bcc ", type=>"br"},
    {code=>0103400, mask=>0000377, name=>"bcs ", type=>"br"},
    {code=>0104000, mask=>0000377, name=>"emt ", type=>"trap"},
    {code=>0104400, mask=>0000377, name=>"trap", type=>"trap"},
    {code=>0105000, mask=>0000077, name=>"clrb", type=>"1arg"},
    {code=>0105100, mask=>0000077, name=>"comb", type=>"1arg"},
    {code=>0105200, mask=>0000077, name=>"incb", type=>"1arg"},
    {code=>0105300, mask=>0000077, name=>"decb", type=>"1arg"},
    {code=>0105400, mask=>0000077, name=>"negb", type=>"1arg"},
    {code=>0105500, mask=>0000077, name=>"adcb", type=>"1arg"},
    {code=>0105600, mask=>0000077, name=>"sbcb", type=>"1arg"},
    {code=>0105700, mask=>0000077, name=>"tstb", type=>"1arg"},
    {code=>0106000, mask=>0000077, name=>"rorb", type=>"1arg"},
    {code=>0106100, mask=>0000077, name=>"rolb", type=>"1arg"},
    {code=>0106200, mask=>0000077, name=>"asrb", type=>"1arg"},
    {code=>0106300, mask=>0000077, name=>"aslb", type=>"1arg"},
    {code=>0106400, mask=>0000077, name=>"!!mtps", type=>"1arg"},
    {code=>0106500, mask=>0000077, name=>"mfpd", type=>"1arg"},
    {code=>0106600, mask=>0000077, name=>"mtpd", type=>"1arg"},
    {code=>0106700, mask=>0000077, name=>"!!mfps", type=>"1arg"},
    {code=>0110000, mask=>0007777, name=>"movb", type=>"2arg"},
    {code=>0120000, mask=>0007777, name=>"cmpb", type=>"2arg"},
    {code=>0130000, mask=>0007777, name=>"bitb", type=>"2arg"},
    {code=>0140000, mask=>0007777, name=>"bicb", type=>"2arg"},
    {code=>0150000, mask=>0007777, name=>"bisb", type=>"2arg"},
    {code=>0160000, mask=>0007777, name=>"sub ", type=>"2arg"},
    {code=>0170000, mask=>0000000, name=>"!!cfcc", type=>"0arg"},
    {code=>0170001, mask=>0000000, name=>"!!setf", type=>"0arg"},
    {code=>0170011, mask=>0000000, name=>"!!setd", type=>"0arg"},
    {code=>0170002, mask=>0000000, name=>"!!seti", type=>"0arg"},
    {code=>0170012, mask=>0000000, name=>"!!setl", type=>"0arg"},
    {code=>0170100, mask=>0000077, name=>"!!ldfps",type=>"1fpp"},
    {code=>0170200, mask=>0000077, name=>"!!stfps",type=>"1fpp"},
    {code=>0170300, mask=>0000077, name=>"!!stst", type=>"1fpp"},
    {code=>0170400, mask=>0000077, name=>"!!clrf", type=>"1fpp"},
    {code=>0170500, mask=>0000077, name=>"!!tstf", type=>"1fpp"},
    {code=>0170600, mask=>0000077, name=>"!!absf", type=>"1fpp"},
    {code=>0170700, mask=>0000077, name=>"!!negf", type=>"1fpp"},
    {code=>0171000, mask=>0000377, name=>"!!mulf", type=>"rfpp"},
    {code=>0171400, mask=>0000377, name=>"!!modf", type=>"rfpp"},
    {code=>0172000, mask=>0000377, name=>"!!addf", type=>"rfpp"},
    {code=>0172400, mask=>0000377, name=>"!!ldf",  type=>"rfpp"},
    {code=>0173000, mask=>0000377, name=>"!!subf", type=>"rfpp"},
    {code=>0173400, mask=>0000377, name=>"!!cmpf", type=>"rfpp"},
    {code=>0174000, mask=>0000377, name=>"!!stf",  type=>"rfpp"},
    {code=>0174400, mask=>0000377, name=>"!!divf", type=>"rfpp"},
    {code=>0175000, mask=>0000377, name=>"!!stexp",type=>"rfpp"},
    {code=>0175400, mask=>0000377, name=>"!!stcif",type=>"rfpp"},
    {code=>0176000, mask=>0000377, name=>"!!stcfd",type=>"rfpp"},
    {code=>0176400, mask=>0000377, name=>"!!ldexp",type=>"rfpp"},
    {code=>0177000, mask=>0000377, name=>"!!ldcif",type=>"rfpp"},
    {code=>0177400, mask=>0000377, name=>"!!ldcdf",type=>"rfpp"}
  );

use constant BIT00 => 0000001;
use constant BIT01 => 0000002;
use constant BIT02 => 0000004;
use constant BIT03 => 0000010;
use constant BIT04 => 0000020;
use constant BIT05 => 0000040;
use constant BIT06 => 0000100;
use constant BIT07 => 0000200;
use constant BIT08 => 0000400;
use constant BIT09 => 0001000;
use constant BIT10 => 0002000;
use constant BIT11 => 0004000;
use constant BIT12 => 0010000;
use constant BIT13 => 0020000;
use constant BIT14 => 0040000;
use constant BIT15 => 0100000;

use constant REGATTR_RBMBOX => 0000001;     # rbus is mailbox, skip on exa loop
use constant REGATTR_RBRD   => 0000002;     # by default  read on rbus
use constant REGATTR_RBWR   => 0000004;     # by default write on rbus
use constant REGATTR_IBMBOX => 0000010;     # ibus is mailbox, skip on exa loop

# some common defs

my @partbl_nxbuf = ( nxbuf_min => { type => "hval:d" },
                     nxbuf_inc => { type => "hval:d" },
                     nxbuf_max => { type => "hval:d" },
                     nxbuf     => { type => "hval:d" } );

# CPU general defs

use constant CPU_MMR3   => 0172516;
use constant CPU_SDREG  => 0177570;
use constant CPU_MMR0   => 0177572;
use constant CPU_MMR1   => 0177574;
use constant CPU_MMR2   => 0177576;
use constant CPU_LOSIZE => 0177760;
use constant CPU_HISIZE => 0177762;
use constant CPU_SYSID  => 0177764;
use constant CPU_CPUERR => 0177766;
use constant CPU_MBRK   => 0177770;
use constant CPU_PIRQ   => 0177772;
use constant CPU_STKLIM => 0177774;
use constant CPU_PSW    => 0177776;

# DL11 general defs
use constant DL11_BASE_A  => 0177560;
use constant DL11_BASE_B  => 0176500;

# DL11 address offsets
use constant DL11_RCSR  => 00;
use constant DL11_RBUF  => 02;
use constant DL11_XCSR  => 04;
use constant DL11_XBUF  => 06;

# DL11 register defs
use constant DL11_RCSR_M_RDONE  => BIT07;
use constant DL11_XCSR_M_XRDY   => BIT07;
use constant DL11_XBUF_M_RRDY   => BIT09;
use constant DL11_XBUF_M_XVAL   => BIT08;
use constant DL11_XBUF_M_XBUF   => 0377;

my @reglist_dl11 = ({name   => "rcsr",
                     offset => DL11_RCSR},
                    {name   => "rbuf",
                     offset => DL11_RBUF,
                     attr   => REGATTR_IBMBOX},
                    {name   => "xcsr",
                     offset => DL11_XCSR},
                    {name   => "xbuf",
                     offset => DL11_XBUF,
                     attr   => REGATTR_RBMBOX});

my %partbl_dl11  = ( trace => { type => "hval:b" },
                   @partbl_nxbuf );

# LP11 general defs
use constant LP11_BASE  => 0177514;

# LP11 address offsets
use constant LP11_CSR   => 00;
use constant LP11_BUF   => 02;

# LP11 register defs
use constant LP11_CSR_M_ERR  => BIT15;
use constant LP11_BUF_M_VAL  => BIT08;
use constant LP11_BUF_M_BUF  => 0177;

my @reglist_lp11 = ({name   => "csr",
                     offset => LP11_CSR},
                    {name   => "buf",
                     offset => LP11_BUF,
                     attr   => REGATTR_RBMBOX});
my %partbl_lp11  = ( trace => { type => "hval:b" },
                   @partbl_nxbuf );

# PC11 address offsets
use constant PC11_RCSR  => 00;
use constant PC11_RBUF  => 02;
use constant PC11_PCSR  => 04;
use constant PC11_PBUF  => 06;

# PC11 register defs
use constant PC11_RCSR_M_ERR    => BIT15;
use constant PC11_PCSR_M_ERR    => BIT15;
use constant PC11_PBUF_M_RBUSY  => BIT09;
use constant PC11_PBUF_M_PVAL   => BIT08;
use constant PC11_PBUF_M_PBUF   => 0377;

my @reglist_pc11 = ({name   => "rcsr",
                     offset => PC11_RCSR},
                    {name   => "rbuf",
                     offset => PC11_RBUF,
                     attr   => REGATTR_IBMBOX},
                    {name   => "pcsr",
                     offset => PC11_PCSR},
                    {name   => "pbuf",
                     offset => PC11_PBUF,
                     attr   => REGATTR_RBMBOX});
my %partbl_pc11  = ( trace => { type => "hval:b" },
                   @partbl_nxbuf );

# RK11 general defs
use constant RK11_BASE    => 0177400;
use constant RK11_NUMSE   =>  12;         # number of sectors
use constant RK11_NUMHD   =>   2;         # number of heads
use constant RK11_NUMCY   => 203;         # number of cylinders
use constant RK11_NUMDR   =>   8;         # number of drives
use constant RK11_NUMBL   => RK11_NUMSE * RK11_NUMHD * RK11_NUMCY;
use constant RK11_BLKSIZE => 512;                       # disk block size
use constant RK11_VOLSIZE => RK11_BLKSIZE * RK11_NUMBL; # disk volume size

# RK11 address offsets
use constant RK11_RKDS  => 00;
use constant RK11_RKER  => 02;
use constant RK11_RKCS  => 04;
use constant RK11_RKWC  => 06;
use constant RK11_RKBA  => 010;
use constant RK11_RKDA  => 012;
use constant RK11_RKMR  => 014;

# RK11 register defs

use constant RKDS_M_ID     => 0160000;  # ID: drive number
use constant RKDS_V_ID     => 13;
use constant RKDS_B_ID     => 0007;
use constant RKDS_M_HDEN   => BIT11;    # HDEN: high density drive (rk05)
use constant RKDS_M_DRU    => BIT10;    # DRU: drive unsafe
use constant RKDS_M_SIN    => BIT09;    # SIN: seek incomplete
use constant RKDS_M_SOK    => BIT08;    # SOK: sector counter OK
use constant RKDS_M_DRY    => BIT07;    # DRY: drive ready
use constant RKDS_M_ADRY   => BIT06;    # ADRY: access ready
use constant RKDS_M_WPS    => BIT05;    # WPS: write protect
use constant RKDS_B_SC     => 0017;     # SC: sector counter

use constant RKER_M_DRE    => BIT15;    # DRE: drive error
use constant RKER_M_OVR    => BIT14;    # OVR: overrun
use constant RKER_M_WLO    => BIT13;    # WLO: write lock violation
use constant RKER_M_PGE    => BIT11;    # PGE: programming error
use constant RKER_M_NXM    => BIT10;    # NXM: non existent memory
use constant RKER_M_NXD    => BIT07;    # NXD: non existent drive
use constant RKER_M_NXC    => BIT06;    # NXC: non existent cylinder
use constant RKER_M_NXS    => BIT05;    # NXS: non existent sector
use constant RKER_M_CSE    => BIT01;    # CSE: check sum error
use constant RKER_M_WCE    => BIT00;    # WCE: write check error

use constant RKCS_M_MAINT  => BIT12;    # MAINT: maintenance mode
use constant RKCS_M_IBA    => BIT11;    # IBA: inhibit increment RKBA
use constant RKCS_M_FMT    => BIT10;    # FMT: format
use constant RKCS_M_RWA    => BIT09;    # RWA: read-write all
use constant RKCS_M_SSE    => BIT08;    # SSE: stop on soft errors
use constant RKCS_M_MEX    => 0000060;  # MEX: memory extension
use constant RKCS_V_MEX    =>  4;
use constant RKCS_B_MEX    => 0003;
use constant RKCS_V_FUNC   =>  1;       # FUNC: function
use constant RKCS_B_FUNC   => 0007;
use constant   RKCS_CRESET =>  0;
use constant   RKCS_WRITE  =>  1;
use constant   RKCS_READ   =>  2;
use constant   RKCS_WCHK   =>  3;
use constant   RKCS_SEEK   =>  4;
use constant   RKCS_RCHK   =>  5;
use constant   RKCS_DRESET =>  6;
use constant   RKCS_WLOCK  =>  7;
use constant RKCS_M_GO     => BIT00;    # GO: go bit

use constant RKDA_M_DRSEL  => 0160000;  # DRSEL: drive number
use constant RKDA_V_DRSEL  => 13;
use constant RKDA_B_DRSEL  => 0007;
use constant RKDA_M_CYL    => 0017740;  # CYL: cyclinder address
use constant RKDA_V_CYL    =>  5;
use constant RKDA_B_CYL    => 0377;
use constant RKDA_M_SUR    => 0000020;  # SUR: surface
use constant RKDA_V_SUR    =>  4;
use constant RKDA_B_SUR    => 0001;
use constant RKDA_B_SC     => 0017;     # SC: sector address

use constant RKMR_M_RID    => 0160000;  # RID: drive id for RKDS RB read
use constant RKMR_V_RID    => 13;
use constant RKMR_V_CRDONE => 11;       # CRDONE: control reset done
use constant RKMR_V_SBCLR  => 10;       # SBCLR: clear SBUSY's with SDONE
use constant RKMR_V_CRESET =>  9;       # CRESET: initiate control reset
use constant RKMR_V_FDONE  =>  8;       # FDONE: initiate function done

my @reglist_rk11 = ({name   => "rkds",
                     offset => RK11_RKDS},
                    {name   => "rker",
                     offset => RK11_RKER},
                    {name   => "rkcs",
                     offset => RK11_RKCS},
                    {name   => "rkwc",
                     offset => RK11_RKWC},
                    {name   => "rkba",
                     offset => RK11_RKBA},
                    {name   => "rkda",
                     offset => RK11_RKDA},
                    {name   => "rkmr",
                     offset => RK11_RKMR});

my %partbl_rk11  = ( trace => { type => "hval:b" } );

# KWP general defs

my @reglist_kwp = ({name   => "csr",
                    offset => 0},
                   {name   => "csb",
                    offset => 2},
                   {name   => "ctr",
                    offset => 4});

# KWL general defs

my @reglist_kwl = ({name   => "csr",
                    offset => 0});

# IIST general defs

my @reglist_iist = ({name   => "acr",
                     offset => 0},
                    {name   => "adr",
                     offset => 2});

use constant BOOT_START  => 02000;

my $serv11_fds_update   =   1;
my $serv11_config_done  =   0;
my $serv11_init_pending =   1;
my $serv11_rdma_chunk   = 256;

my $serv11_init_anena  = 0x8000;       # enable attn
#my $serv11_init_anena   = 0xC03f;       # enable attn+ioto(63ms)

#
# %serv11_ctltbl->{dev} --> controller table; is hash of hashes
#   -> {ctlname}     controller name
#   -> {ctltype}     controller type (e.g. DL11)
#   -> {devname}     device name
#   -> {type}        device type: term, lpr, ptap, disk, tape, eth
#   -> {units}       array of unit names
#   -> {base}        controller base address
#   -> {ibrb}        controller base mapping for remote ib access
#   -> {csroff}      csr offset from base (for probing)
#   -> {lam}         lam number used by controller
#   -> {nxbuf_min}   nxbuf: minimal vector size
#   -> {nxbuf_inc}   nxbuf: vector size increment
#   -> {nxbuf_max}   nxbuf: maximal vector size
#   -> {probehdl}    address of probe handler
#   -> {probemask}   sides to be tested (set to "ir" if missing)
#   -> {ichrhdl}     address of input character handler
#   -> {inithdl}     address of controler init handler
#   -> {usethdl}     address of unit setup handler
#   -> {attdethdl}   address of attach/detach handler
#   -> {attnhdl}     address og attention handler
#   -> {reglist}     register list (array of regdsc's)
#   -> {regtbl}      register table (by name, created by ...)
#   -> {partbl}      parameter table (array of pardsc's)
#   -> {blksize}     block size (in bytes)                            {for disk}
#   -> {volsize}     volume size (in bytes)                           {for disk}
#   -> {boot_mode}   boot mode: "ptape" undef
#   -> {boot_base}   base address for boot code if not BOOT_START     {for ptap}
#   -> {boot_mode}   boot mode: "ptape" undef
#   -> {boot_entry}  boot code entry point, relative to BOOT_START
#   -> {boot_unit}   offset from BOOT_START where unit number is stored
#   -> {boot_code}   array with boot loader code
#
#   -> {memsize}     memory size                                      {for cpu}
#
#   -> {nxbuf}       nxbuf: current value
#   -> {probe_ival}  defined if cpu side probing ok
#   -> {probe_rval}  defined if rem side probing ok
#   -> {probe_ok}    true if required sides available (see probe_mask)
#   -> {probe_text}  text for "sho conf" generated during probe

my %serv11_ctltbl = (
  CPU =>
    { ctlname   => "CPU",
      ctltype   => "W11A",
      type      => "cpu",
      base      => CPU_PSW,                 # use psw to get it to top of list
      lam       => 0,
      probehdl  => \&serv11_probe_cpu,
      probemask => "i",
      attnhdl   => \&serv11_attn_cpu,
      reglist   => [ ],
      partbl    => { }
    },

  TTA =>
    { ctlname   => "TTA",
      ctltype   => "DL11",
      devname   => "TT",
      type      => "term",
      units     => ["TT0"],
      base      => DL11_BASE_A,
      ibrb      => DL11_BASE_A & ~(077),
      csroff    => 0,
      lam       => 1,
      nxbuf_min => 2,                   # to disable nxbuf mechanism use
      nxbuf_inc => 2,                   #   min=1, inc=0, max=1
      nxbuf_max => 8,                   # otherwise: min=2,inc=2,max=8
      trace     => 1,
      probehdl  => \&serv11_probe_gen,
      ichrhdl   => \&serv11_ichr_dl11,
      attdethdl => \&serv11_attdet_term,
      attnhdl   => \&serv11_attn_dl11,
      reglist   => [ @reglist_dl11 ],
      partbl    => { %partbl_dl11 }
    },

  TTB =>
    { ctlname   => "TTB",
      ctltype   => "DL11",
      devname   => "TT",
      type      => "term",
      units     => ["TT1"],
      base      => DL11_BASE_B,
      ibrb      => DL11_BASE_B & ~(077),
      csroff    => 0,
      lam       => 2,
      nxbuf_min => 2,
      nxbuf_inc => 2,
      nxbuf_max => 8,
      trace     => 1,
      probehdl  => \&serv11_probe_gen,
      ichrhdl   => \&serv11_ichr_dl11,
      attdethdl => \&serv11_attdet_term,
      attnhdl   => \&serv11_attn_dl11,
      reglist   => [ @reglist_dl11 ],
      partbl    => { %partbl_dl11 }
    },

  DZ =>
    { ctlname   => "DZ",
      ctltype   => "DZ11",
      devname   => "DZ",
      type      => "term",
      units     => ["DZ0","DZ1","DZ2","DZ3","DZ4","DZ5","DZ6","DZ7"],
      base      => 0160100,
      ibrb      => 0160100 & ~(077),
      csroff    => 0,
      lam       => 3,
      probehdl  => \&serv11_probe_gen
    },

  LP =>
    { ctlname   => "LP",
      ctltype   => "LP11",
      devname   => "LP",
      type      => "lpr",
      units     => ["LP0"],
      base      => 0177514,
      ibrb      => 0177514 & ~(077),
      csroff    => 0,
      lam       => 8,
      nxbuf_min => 2,                   # to disable nxbuf mechanism use
      nxbuf_inc => 2,                   #   min=1, inc=0, max=1
      nxbuf_max => 8,                   # otherwise: min=2,inc=2,max=8
      trace     => 1,
      probehdl  => \&serv11_probe_gen,
      inithdl   => \&serv11_init_gen,
      usethdl   => \&serv11_uset_lp11,
      attdethdl => \&serv11_attdet_wonly,
      attnhdl   => \&serv11_attn_lp11,
      reglist   => [ @reglist_lp11 ],
      partbl    => { %partbl_lp11 }
    },

  PC =>
    { ctlname   => "PC",
      ctltype   => "PC11",
      devname   => "PC",
      type      => "ptap",
      units     => ["PTR","PTP"],
      base      => 0177550,
      ibrb      => 0177550 & ~(077),
      csroff    => 0,
      lam       => 10,
      nxbuf_min => 2,
      nxbuf_inc => 2,
      nxbuf_max => 8,
      trace     => 1,
      probehdl  => \&serv11_probe_gen,
      usethdl   => \&serv11_uset_pc11,
      attdethdl => \&serv11_attdet_pc11,
      attnhdl   => \&serv11_attn_pc11,
      reglist   => [ @reglist_pc11 ],
      partbl    => { %partbl_pc11 },
      boot_mode => "ptape",
      boot_base => 0017476,
      boot_entry=> 0017500,
      boot_code => [    # papertape lda loader, from dec-11-l2pc-po
        0000000,                    # C000:   halt
        0010706,                    # astart: mov     pc,sp
        0024646,                    #         cmp     -(sp),-(sp)
        0010705,                    #         mov     pc,r5
        0062705, 0000112,           #         add     #000112,r5
        0005001,                    #         clr     r1
        0013716, 0177570,           # B000:   mov     @#cp.dsr,(sp)
        0006016,                    #         ror     (sp)
        0103402,                    #         bcs     B001
        0005016,                    #         clr     (sp)
        0000403,                    #         br      B002
        0006316,                    # B001:   asl     (sp)
        0001001,                    #         bne     B002
        0010116,                    #         mov     r1,(sp)
        0005000,                    # B002:   clr     r0
        0004715,                    #         jsr     pc,(r5)
        0105303,                    #         decb    r3
        0001374,                    #         bne     B002
        0004715,                    #         jsr     pc,(r5)
        0004767, 0000074,           #         jsr     pc,R000
        0010402,                    #         mov     r4,r2
        0162702, 0000004,           #         sub     #000004,r2
        0022702, 0000002,           #         cmp     #000002,r2
        0001441,                    #         beq     B007
        0004767, 0000054,           #         jsr     pc,R000
        0061604,                    #         add     (sp),r4
        0010401,                    #         mov     r4,r1
        0004715,                    # B003:   jsr     pc,(r5)
        0002004,                    #         bge     B005
        0105700,                    #         tstb    r0
        0001753,                    #         beq     B002
        0000000,                    # B004:   halt
        0000751,                    #         br      B002
        0110321,                    # B005:   movb    r3,(r1)+
        0000770,                    #         br      B003
        0016703, 0000152,           # ldchr:  mov     p.prcs,r3
        0105213,                    #         incb    (r3)
        0105713,                    # B006:   tstb    (r3)
        0100376,                    #         bpl     B006
        0116303, 0000002,           #         movb    000002(r3),r3
        0060300,                    #         add     r3,r0
        0042703, 0177400,           #         bic     #177400,r3
        0005302,                    #         dec     r2
        0000207,                    #         rts     pc
        0012667, 0000046,           # R000:   mov     (sp)+,D000
        0004715,                    #         jsr     pc,(r5)
        0010304,                    #         mov     r3,r4
        0004715,                    #         jsr     pc,(r5)
        0000303,                    #         swap    r3
        0050304,                    #         bis     r3,r4
        0016707, 0000030,           #         mov     D000,pc
        0004767, 0177752,           # B007:   jsr     pc,R000
        0004715,                    #         jsr     pc,(r5)
        0105700,                    #         tstb    r0
        0001342,                    #         bne     B004
        0006204,                    #         asr     r4
        0103002,                    #         bcc     B008
        0000000,                    #         halt
        0000700,                    #         br      B000
        0006304,                    # B008:   asl     r4
        0061604,                    #         add     (sp),r4
        0000114,                    #         jmp     (r4)
        0000000,                    # D000:   .word   000000
        0012767, 0000352, 0000020,  # L000:   mov     #000352,B009+2
        0012767, 0000765, 0000034,  #         mov     #000765,D001
        0000167, 0177532,           #         jmp     C000
        0016701, 0000026,           # bstart: mov     p.prcs,r1
        0012702, 0000352,           # B009:   mov     #000352,r2
        0005211,                    #         inc     (r1)
        0105711,                    # B010:   tstb    (r1)
        0100376,                    #         bpl     B010
        0116162, 0000002, 0157400,  #         movb    000002(r1),157400(r2)
        0005267, 0177756,           #         inc     B009+2
        0000765,                    # D001:   br      B009
        0177550                     # p.prcs: .word   177550
        ]
    },

  RK =>
    { ctlname   => "RK",
      ctltype   => "RK11/RK05",
      devname   => "RK",
      type      => "disk",
      units     => ["RK0","RK1","RK2","RK3","RK4","RK5","RK6","RK7"],
      base      => RK11_BASE,
      ibrb      => RK11_BASE & ~(077),
      csroff    => 4,
      lam       => 4,
      trace     => 1,
      probehdl  => \&serv11_probe_gen,
      inithdl   => \&serv11_init_gen,
      usethdl   => \&serv11_uset_rk11,
      attdethdl => \&serv11_attdet_disk,
      attnhdl   => \&serv11_attn_rk11,
      reglist   => [ @reglist_rk11 ],
      partbl    => { %partbl_rk11 },
      blksize   => RK11_BLKSIZE,
      volsize   => RK11_VOLSIZE,
      boot_entry=> BOOT_START + 002,
      boot_unit => BOOT_START + 010,
      boot_code => [    # rk05 boot loader - from simh pdp11_rk.c
        0042113,                    #  "KD"
        0012706, BOOT_START,        #  MOV #boot_start, SP
        0012700, 0000000,           #  MOV #unit, R0        ; unit number
        0010003,                    #  MOV R0, R3
        0000303,                    #  SWAB R3
        0006303,                    #  ASL R3
        0006303,                    #  ASL R3
        0006303,                    #  ASL R3
        0006303,                    #  ASL R3
        0006303,                    #  ASL R3
        0012701, 0177412,           #  MOV #RKDA, R1        ; rkda
        0010311,                    #  MOV R3, (R1)         ; load da
        0005041,                    #  CLR -(R1)            ; clear ba
        0012741, 0177000,           #  MOV #-256.*2, -(R1)  ; load wc
        0012741, 0000005,           #  MOV #READ+GO, -(R1)  ; read & go
        0005002,                    #  CLR R2
        0005003,                    #  CLR R3
        0012704, BOOT_START+020,    #  MOV #START+20, R4
        0005005,                    #  CLR R5
        0105711,                    #  TSTB (R1)
        0100376,                    #  BPL .-2
        0105011,                    #  CLRB (R1)
        0005007                     #  CLR PC     (5007)
        ]
    },

  RL =>
    { ctlname   => "RL",
      ctltype   => "RL11/RL02",
      devname   => "RL",
      type      => "disk",
      units     => ["RL0","RL1","RL2","RL3"],
      base      => 0174400,
      ibrb      => 0174400 & ~(077),
      csroff    => 0,               # ???CHECK-ME???
      lam       => 5,
      probehdl  => \&serv11_probe_gen,
      boot_entry=> BOOT_START + 002,
      boot_unit => BOOT_START + 010,
      boot_code => [    # rl02 boot loader - from simh pdp11_rl.c
        0042114,                    #  "LD"
        0012706, BOOT_START,        #  MOV #boot_start, SP
        0012700, 0000000,           #  MOV #unit, R0
        0010003,                    #  MOV R0, R3
        0000303,                    #  SWAB R3
        0012701, 0174400,           #  MOV #RLCS, R1        ; csr
        0012761, 0000013, 0000004,  #  MOV #13, 4(R1)       ; clr err
        0052703, 0000004,           #  BIS #4, R3           ; unit+gstat
        0010311,                    #  MOV R3, (R1)         ; issue cmd
        0105711,                    #  TSTB (R1)            ; wait
        0100376,                    #  BPL .-2
        0105003,                    #  CLRB R3
        0052703, 0000010,           #  BIS #10, R3          ; unit+rdhdr
        0010311,                    #  MOV R3, (R1)         ; issue cmd
        0105711,                    #  TSTB (R1)            ; wait
        0100376,                    #  BPL .-2
        0016102, 0000006,           #  MOV 6(R1), R2        ; get hdr
        0042702, 0000077,           #  BIC #77, R2          ; clr sector
        0005202,                    #  INC R2               ; magic bit
        0010261, 0000004,           #  MOV R2, 4(R1)        ; seek to 0
        0105003,                    #  CLRB R3
        0052703, 0000006,           #  BIS #6, R3           ; unit+seek
        0010311,                    #  MOV R3, (R1)         ; issue cmd
        0105711,                    #  TSTB (R1)            ; wait
        0100376,                    #  BPL .-2
        0005061, 0000002,           #  CLR 2(R1)            ; clr ba
        0005061, 0000004,           #  CLR 4(R1)            ; clr da
        0012761, 0177000, 0000006,  #  MOV #-512., 6(R1)    ; set wc
        0105003,                    #  CLRB R3
        0052703, 0000014,           #  BIS #14, R3          ; unit+read
        0010311,                    #  MOV R3, (R1)         ; issue cmd
        0105711,                    #  TSTB (R1)            ; wait
        0100376,                    #  BPL .-2
        0042711, 0000377,           #  BIC #377, (R1)
        0005002,                    #  CLR R2
        0005003,                    #  CLR R3
        0012704, BOOT_START+020,    #  MOV #START+20, R4
        0005005,                    #  CLR R5
        0005007                     #  CLR PC
        ]
    },


  RP =>
    { ctlname   => "RP",
      ctltype   => "RH70/RP06",
      devname   => "RP",
      type      => "disk",
      units     => ["RP0","RP1","RP2","RP3"],
      base      => 0176700,
      ibrb      => 0176700 & ~(077),
      csroff    => 0,               # ???CHECK-ME???
      lam       => 6,
      probehdl  => \&serv11_probe_gen,
      boot_entry=> BOOT_START + 002,
      boot_unit => BOOT_START + 010,
      boot_code => [    # rp/rm boot loader - from simh pdp11_rp.c
        0042102,                        #  "BD"
        0012706, BOOT_START,            #  mov #boot_start, sp
        0012700, 0000000,               #  mov #unit, r0
        0012701, 0176700,               #  mov #RPCS1, r1
        0012761, 0000040, 0000010,      #  mov #CS2_CLR, 10(r1) ; reset
        0010061, 0000010,               #  mov r0, 10(r1)       ; set unit
        0012711, 0000021,               #  mov #RIP+GO, (r1)    ; pack ack
        0012761, 0010000, 0000032,      #  mov #FMT16B, 32(r1)  ; 16b mode
        0012761, 0177000, 0000002,      #  mov #-512., 2(r1)    ; set wc
        0005061, 0000004,               #  clr 4(r1)            ; clr ba
        0005061, 0000006,               #  clr 6(r1)            ; clr da
        0005061, 0000034,               #  clr 34(r1)           ; clr cyl
        0012711, 0000071,               #  mov #READ+GO, (r1)   ; read
        0105711,                        #  tstb (r1)            ; wait
        0100376,                        #  bpl .-2
        0005002,                        #  clr R2
        0005003,                        #  clr R3
        0012704, BOOT_START+020,        #  mov #start+020, r4
        0005005,                        #  clr R5
        0105011,                        #  clrb (r1)
        0005007                         #  clr PC
        ]
    },

  TM =>
    { ctlname   => "TM",
      ctltype   => "TM11",
      devname   => "TM",
      type      => "tape",
      units     => ["TM0","TM1","TM2","TM3","TM4","TM5","TM6","TM7"],
      base      => 0172520,
      ibrb      => 0172520 & ~(077),
      csroff    => 2,
      lam       => 7,
      probehdl  => \&serv11_probe_gen,
      boot_entry=> BOOT_START + 002,
      boot_unit => BOOT_START + 010,
      boot_code => [    # tm11 boot2 (skip 1st record) - from simh pdp11_tm.c
        0046524,                    # boot_start: "TM"
        0012706, BOOT_START,        # mov #boot_start, sp
        0012700, 0000000,           # mov #unit_num, r0
        0012701, 0172526,           # mov #172526, r1      ; mtcma
        0005011,                    # clr (r1)
        0012741, 0177777,           # mov #-1, -(r1)       ; mtbrc
        0010002,                    # mov r0,r2
        0000302,                    # swab r2
        0062702, 0060011,           # add #60011, r2
        0010241,                    # mov r2, -(r1)        ; space + go
        0105711,                    # tstb (r1)            ; mtc
        0100376,                    # bpl .-2
        0010002,                    # mov r0,r2
        0000302,                    # swab r2
        0062702, 0060003,           # add #60003, r2
        0010211,                    # mov r2, (r1)         ; read + go
        0105711,                    # tstb (r1)            ; mtc
        0100376,                    # bpl .-2
        0005002,                    # clr r2
        0005003,                    # clr r3
        0012704, BOOT_START+020,    # mov #boot_start+20, r4
        0005005,                    # clr r5
        0005007                     # clr r7
        ]
    },

  XU =>
    { ctlname   => "XU",
      ctltype   => "DENUA",
      devname   => "XU",
      type      => "eth",
      units     => ["XU0"],
      base      => 0174510,
      ibrb      => 0174510 & ~(077),
      csroff    => 0,
      lam       => 9,
      probehdl  => \&serv11_probe_gen
    },

  KWP =>
    { ctlname   => "KWP",
      ctltype   => "KW11-P",
      devname   => "--",
      type      => "misc",
      base      => 0172540,
      probehdl  => \&serv11_probe_gen,
      probemask => "i",
      reglist   => [ @reglist_kwp ]
    },

  KWL =>
    { ctlname   => "KWL",
      ctltype   => "KW11-L",
      devname   => "--",
      type      => "misc",
      base      => 0177546,
      probehdl  => \&serv11_probe_gen,
      probemask => "i",
      reglist   => [ @reglist_kwl ]
    },

  IIS =>
    { ctlname   => "IIS",
      ctltype   => "IIST",
      devname   => "--",
      type      => "misc",
      base      => 0177500,
      probehdl  => \&serv11_probe_gen,
      probemask => "i",
      reglist   => [ @reglist_iist ]
    }

  );

#
# %serv11_unittbl->{unit} --> unit table; is hash of hashes
#   -> {unitname}    unit name
#   -> {ctlname}     controller name
#   -> {ctlunit}     unit number of controller {ctlname}
#   -> {devunit}     device number for device $ucb->{ctlname}->{devname}
#   -> {rcvque}      receive queue                                    {for term}
#   -> {sndque}      send queue                                       {for term}
#   -> {rcv7bit}     use only 7 bits in receive                       {for term}
#   -> {logfile}     name of logfile
#   -> {logfh}       file handle for logfile
#

my %serv11_unittbl = (
  TT0  => { unitname  => "TT0",
            ctlname   => "TTA",
            ctlunit   => 0,
            devunit   => 0,
            rcvque    => [],
            sndque    => [],
            rcv7bit   => 1,
            logfile   => "pi_tt0.log",
            logfh     => undef
          },
  TT1  => { unitname  => "TT1",
            ctlname   => "TTB",
            ctlunit   => 0,
            devunit   => 1,
            rcvque    => [],
            sndque    => [],
            rcv7bit   => 1,
            logfile   => "pi_tt1.log",
            logfh     => undef
          },

  DZ0  => { unitname  => "DZ0",
            ctlname   => "DZ",
            ctlunit   => 0,
            devunit   => 0,
            rcvque    => [],
            sndque    => []
          },
  DZ1  => { unitname  => "DZ1",
            ctlname   => "DZ",
            ctlunit   => 1,
            devunit   => 1,
            rcvque    => [],
            sndque    => []
          },
  DZ2  => { unitname  => "DZ2",
            ctlname   => "DZ",
            ctlunit   => 2,
            devunit   => 2,
            rcvque    => [],
            sndque    => []
          },
  DZ3  => { unitname  => "DZ3",
            ctlname   => "DZ",
            ctlunit   => 3,
            devunit   => 3,
            rcvque    => [],
            sndque    => []
          },
  DZ4  => { unitname  => "DZ4",
            ctlname   => "DZ",
            ctlunit   => 4,
            devunit   => 4,
            rcvque    => [],
            sndque    => []
          },
  DZ5  => { unitname  => "DZ5",
            ctlname   => "DZ",
            ctlunit   => 5,
            devunit   => 5,
            rcvque    => [],
            sndque    => []
          },
  DZ6  => { unitname  => "DZ6",
            ctlname   => "DZ",
            ctlunit   => 6,
            devunit   => 6,
            rcvque    => [],
            sndque    => []
          },
  DZ7  => { unitname  => "DZ7",
            ctlname   => "DZ",
            ctlunit   => 7,
            devunit   => 7,
            rcvque    => [],
            sndque    => []
          },

  LP0  => { unitname  => "LP0",
            ctlname   => "LP",
            ctlunit   => 0,
            devunit   => 0,
            logfile   => "pi_lp0.log",
            logfh     => undef
          },

  PTR  => { unitname  => "PTR",
            ctlname   => "PC",
            ctlunit   => 0,
            devunit   => 0
          },

  PTP  => { unitname  => "PTP",
            ctlname   => "PC",
            ctlunit   => 1,
            devunit   => 1
          },

  RK0  => { unitname  => "RK0",
            ctlname   => "RK",
            ctlunit   => 0,
            devunit   => 0
          },
  RK1  => { unitname  => "RK1",
            ctlname   => "RK",
            ctlunit   => 1,
            devunit   => 1
          },
  RK2  => { unitname  => "RK2",
            ctlname   => "RK",
            ctlunit   => 2,
            devunit   => 2
          },
  RK3  => { unitname  => "RK3",
            ctlname   => "RK",
            ctlunit   => 3,
            devunit   => 3
          },
  RK4  => { unitname  => "RK4",
            ctlname   => "RK",
            ctlunit   => 4,
            devunit   => 4
          },
  RK5  => { unitname  => "RK5",
            ctlname   => "RK",
            ctlunit   => 5,
            devunit   => 5
          },
  RK6  => { unitname  => "RK6",
            ctlname   => "RK",
            ctlunit   => 6,
            devunit   => 6
          },
  RK7  => { unitname  => "RK7",
            ctlname   => "RK",
            ctlunit   => 7,
            devunit   => 7
          },

  RL0  => { unitname  => "RL0",
            ctlname   => "RL",
            ctlunit   => 0,
            devunit   => 0
          },
  RL1  => { unitname  => "RL1",
            ctlname   => "RL",
            ctlunit   => 1,
            devunit   => 1
          },
  RL2  => { unitname  => "RL2",
            ctlname   => "RL",
            ctlunit   => 2,
            devunit   => 2
          },
  RL3  => { unitname  => "RL3",
            ctlname   => "RL",
            ctlunit   => 3,
            devunit   => 3
          },

  RP0  => { unitname  => "RP0",
            ctlname   => "RP",
            ctlunit   => 0,
            devunit   => 0
          },
  RP1  => { unitname  => "RP1",
            ctlname   => "RP",
            ctlunit   => 1,
            devunit   => 1
          },
  RP2  => { unitname  => "RP2",
            ctlname   => "RP",
            ctlunit   => 2,
            devunit   => 2
          },
  RP3  => { unitname  => "RP3",
            ctlname   => "RP",
            ctlunit   => 3,
            devunit   => 3
          },

  TM0  => { unitname  => "TM0",
            ctlname   => "TM",
            ctlunit   => 0,
            devunit   => 0
          },
  TM1  => { unitname  => "TM1",
            ctlname   => "TM",
            ctlunit   => 1,
            devunit   => 1
          },
  TM2  => { unitname  => "TM2",
            ctlname   => "TM",
            ctlunit   => 2,
            devunit   => 2
          },
  TM3  => { unitname  => "TM3",
            ctlname   => "TM",
            ctlunit   => 3,
            devunit   => 3
          },
  TM4  => { unitname  => "TM4",
            ctlname   => "TM",
            ctlunit   => 4,
            devunit   => 4
          },
  TM5  => { unitname  => "TM5",
            ctlname   => "TM",
            ctlunit   => 5,
            devunit   => 5
          },
  TM6  => { unitname  => "TM6",
            ctlname   => "TM",
            ctlunit   => 6,
            devunit   => 6
          },
  TM7  => { unitname  => "TM7",
            ctlname   => "TM",
            ctlunit   => 7,
            devunit   => 7
          },

  XU0  => { unitname  => "XU0",
            ctlname   => "XU",
            ctlunit   => 0,
            devunit   => 0
          }

  );

my @serv11_attntbl;

my $serv11_active = 0;
my $serv11_attn_mask = 0;
my $serv11_attn_seen = 0;

my @serv11_icbque = ();

my $only_argv = 0;
$only_argv = 1 if scalar(@ARGV) > 0;
$only_argv = 0 if exists $opts{int};

#
# -- Main program starts here ------------------------------------------------
#

autoflush STDOUT 1 if (-p STDOUT);          # autoflush if output into pipe
autoflush STDOUT 1 if (-t STDOUT);          # autoflush if output into term

if (exists $opts{help}) {
  print_help();
  exit 0;
}

$SIG{INT} = 'hdl_sigint';                   # install ^C (SIGINT) handler

if (exists $opts{log} && $opts{log} ne "") {
  my $fh = new FileHandle;
  my $filename = $opts{log};
  $fh->open(">$filename") or die "couldn't open log file";
  $fh_log = $fh;
  autoflush $fh_log if (-t $fh);
  printf $fh_log "==== opened log file on %s\n", get_timestamp();
}

$raw_timeout = $opts{timeout} if exists $opts{timeout};
$cmax = $opts{cmax} if exists $opts{cmax};

if (exists $opts{run}) {
  if (not defined ($kpid=fork())) {
    die "cannot fork: $!";
  } elsif ($kpid == 0) {                    # in child
    exec "/bin/sh", "-c", $opts{run};
    die "failed to exec /bin/sh -c $opts{run}: $!";
  } else {                                  # in parent
  }
}

fifo_open($opts{fifo}) if (exists $opts{fifo});
$time0 = get_time();            # do T0 after fifo open
term_open($opts{term}) if (exists $opts{term});

while(1) {
  my $cmd = get_command();
  if (defined $cmd) {
    do_command($cmd);
  } else {
    do_command(".mode nomode");
    last;
  }
}

if ($curchan) {
  &{$chan_tab{$curchan}{write}}();          # flush write queue before close
  &{$chan_tab{$curchan}{close}}();
}

if (exists $opts{run}) {
  waitpid($kpid, 0);
  print "pi_rri($curmode)-I: exit status: $?\n" if $?;
}
0;

#-------------------------------------------------------------------------------

sub init_regtbl {                           # initialize regtbl from reglist
  foreach my $ctlname (sort keys %serv11_ctltbl) {
    my $ctl = $serv11_ctltbl{$ctlname};
    next unless defined $ctl->{reglist};

    $ctl->{regtbl} = {};
    my $nregs = scalar (@{$ctl->{reglist}});

    for (my $i = 0; $i<$nregs; $i++) {
      my $name = $ctl->{reglist}->[$i]->{name};
      $ctl->{regtbl}->{$name} = $i;
      $ctl->{reglist}->[$i]->{rank} = $i;
      ##print "+++ 1a $ctl->{ctlname} $name $i\n";
    }
  }
}

#-------------------------------------------------------------------------------

sub get_command {
  my $cmd;
  while (1) {

    $cmd = read_command;
    return $cmd if (not defined $cmd);  # quit if EOF

    print "$cmd\n" if exists $opts{trace};

    if ($cmd =~ m/^C/) {        # ignore, but print "C ..." lines
      &{$mode_tab{$curmode}{flush}}("comm");
      print "$cmd\n" unless exists $opts{trace};
      next;
    }

    $cmd =~ s{^\s*}{};          # remove leading blanks

    next if $cmd =~ m/^#/;      # ignore "# ...." lines
    next if $cmd =~ m/^;/;      # ignore "; ...." lines

    $cmd =~ s{--.*}{};          # remove comments after --
    $cmd =~ s{\s*$}{};          # remove trailing blanks
    next if $cmd eq "";         # ignore empty lines

    return $cmd;
  }
}

#-------------------------------------------------------------------------------

sub do_command {
  my ($cmd) = @_;

  if ($cmd =~ /^\.mode\s*(\w*)/) {      # .mode command
    if (exists $mode_tab{$1}) {
      &{$mode_tab{$curmode}{flush}}("mode");
      &{$mode_tab{$curmode}{close}}();
      print "pi_rri($curmode)-I: closed mode\n" unless $curmode eq "nomode";
      $curmode = $1;
      $curcmd = $mode_tab{$curmode}{cmd};
      print "pi_rri($curmode)-I: open mode\n" unless $curmode eq "nomode";
      &{$mode_tab{$curmode}{open}}();

    } else {
      printf "pi_rri($curmode)-E: mode '%s' doesn't exist\n", $1;
      printf "pi_rri($curmode)-E:   use %s\n", join ",", (sort keys %mode_tab);
    }

  } else {                              # any other command
    $sigint_count = 0;                  # clear pending ^C's
    &$curcmd($cmd);
    &{$mode_tab{$curmode}{flush}}("line") if $cmd_inter;
  }
}

#-------------------------------------------------------------------------------

sub read_command {
  my $cmd;

  $cmd_inter = 0;

  while (1) {

# read command line

    if (scalar(@cmdfh)==0 && scalar(@ARGV)>0) {
      $cmd = shift @ARGV;
    } else {
      if (scalar(@cmdfh)) {
        my $fh = $cmdfh[$#cmdfh];
        $cmd = <$fh>;
        chomp $cmd if defined $cmd;
        if (defined $cmd && $cmd =~ /\\$/) { # continuation line ?
          $cmd = $`;
          my $cline = <$fh>;
          chomp $cline;
          $cmd .= $cline if defined $cline;
        }
        unless (defined $cmd) {
          $fh->close();
          pop @cmdfh;
          print "pi_rri($curmode)-I: close " . pop(@cmdfn) . "\n";
          &{$mode_tab{$curmode}{flush}}("file");
          pop @cmdargs;
          setpar_command($cmdargs[-1]) if scalar(@cmdargs);
          next;
        }
      } else {
        return undef if $only_argv;
        if (defined $term) {
          $cmd = $term->readline('>');
        } else {
          $cmd = <STDIN>;
        }
        if (-t STDIN && -t STDOUT) {
          $cmd_inter = 1;                     # signal that cmd interactive
        }
        chomp $cmd if defined $cmd;
        return undef if not defined $cmd;
        if (defined $cmd && $cmd =~ /\\$/) { # continuation line ?
          $cmd = $`;
          my $cline = <STDIN>;
          chomp $cline;
          $cmd .= $cline if defined $cline;
        }
      }
    }

# preprocess command line
#   handle substitutions

    while ($cmd =~ /\$\{(\w*):([-=])(.*?)\}/) {       # ${name:[-=]val} seen
      my $name = $1;
      my $typ  = $2;
      my $val  = $3;
      if (exists $par{$name}) {
        $cmd = $` . $par{$name} . $';
      } else {
        $cmd = $` . $val . $';
        $par{$name} = $val if ($typ eq "=");
      }
    }

    while ($cmd =~ /\$\{(\w*)\}/) {       # ${name} seen
      my $name = $1;
      if (exists $par{$name}) {
        $cmd = $` . $par{$name} . $';
      } else {
        print "pi_rri($curmode)-E: variable \"$name\" not defined\n";
        $cmd = $` . "\$?$name?" . $';   
      }
    }

    while ($cmd =~ /\$\[(.*)\]/) {       # $[name] seen
      my $evalstr = $1;
      my $evalval = eval $evalstr;
      if ($@) {
        print "pi_rri($curmode)-E: eval error for \"$evalstr\"\n";
        print "pi_rri($curmode)-E: $@\n";
        $cmd = $` . "\$?$evalstr?" . $';
      } else {
        $evalval = "" unless defined $evalval;
        $cmd = $` . $evalval . $';
      }
    }

# handle asignments

    if ($cmd =~ /^(\w*)=/) {
      my $name = $1;
      my $val = $';
      $val =~ s/--.*$//;
      $val =~ s/\s*$//;
      $par{$name} = $val;
      next;
    }

# handle @@xxx lines (pmac perl macros)

    if ($cmd =~ /^\s*\@\@(\S*)\s*(.*)$/) {    # is it a "@@xxx" macro call ?
      my $file = $1;
      my $args = $2;
      my $fileexp = filename_expand($file);

      print_fatal "pmac file $fileexp not found" unless -r $fileexp;
      open (PMACFILE, "<$fileexp") or die "failed to open $fileexp: $!";
      my @code = <PMACFILE>;
      close PMACFILE;
      my $code = join "", @code;
      ##printf "+++1 code to execute from $fileexp:\n$code---\n";

      $cmd_line = $cmd;
      $cmd_rest = $args;
      $cmd_bad  = 0;

      $sigint_count = 0;                  # clear pending ^C's
      { eval $code; }
      if ($@) {
        print STDERR "pi_rri-E: compile error in $fileexp:\n";
        print STDERR $@;
      }
      next;
    }

# handle @xxx lines (pcmd command lists)

    if ($cmd =~ /^\s*\@(.*)$/) {    # is it a "@xxx" command ?
      my $file = $1;
      my $args = "";
      if ($file =~ /\((.*)\)$/) {   # is it a "@xxx(args)" command ?
        $file = $`;
        $args = $1;
      }

      my $fileexp = filename_expand($file);

      print_fatal "pcmd file $fileexp not found" unless -r $fileexp;
      my $fh = new FileHandle;
      $fh->open("<$fileexp") or die "failed to open $fileexp: $!";
      print "pi_rri($curmode)-I: open $fileexp\n";
      push @cmdfh, $fh;
      push @cmdfn, $fileexp;
      push @cmdargs, $args;
      setpar_command($args);
    } else {
      return $cmd;
    }
  }
}

#-------------------------------------------------------------------------------

sub setpar_command {
  my ($args) = @_;
  my @arglist = split /,/,$args;
  for (my $i=scalar(@arglist); $i<8; $i++) {
    $arglist[$i] = "";
  }
  for (my $i=0; $i<scalar(@arglist); $i++) {
    my $name = $i+1;
    $par{"$name"} = $arglist[$i];
  }
}

#-------------------------------------------------------------------------------

sub nomode_open {
}

#-------------------------------------------------------------------------------

sub nomode_flush {
  my ($case) = @_;
}

#-------------------------------------------------------------------------------

sub nomode_close {
}

#-------------------------------------------------------------------------------

sub nomode_cexec {
  my ($cmd) = @_;
  print "pi_rri($curmode)-E: unknown command \"$cmd\"\n";
}

#-------------------------------------------------------------------------------

sub cpraw_open {
}

#-------------------------------------------------------------------------------

sub cpraw_flush {
  my ($case) = @_;
  cpraw_tx_match_now unless $case eq "line";
}

#-------------------------------------------------------------------------------

sub cpraw_close {
}

#-------------------------------------------------------------------------------
#  cprx 0 11110000
#  cptx 0 11110000

sub cpraw_cexec {
  my ($cmd) = @_;
  my $dat;
  if ($cmd =~ /^(cp[rt]x)\s+([01])\s+([01]{8})\s*/) {
    print "pi_rri($curmode)-E: extra data ignored: \"$'\"\n" if $';
  } else {
    print "pi_rri($curmode)-E: unknown cpraw command: \"$cmd\"\n";
    return;
  }
  $dat = vec(pack("B8",$3), 0,8);
  $dat += 0x100 if $2 eq "1";
  if ($1 eq "cprx") {
    do_cprx($dat);
  } else {
    do_cptx($dat);
  }
}

#-------------------------------------------------------------------------------

sub do_cprx {
  my ($dat) = @_;
  raw_snd9($dat);
  cpraw_tx_match;
}

#-------------------------------------------------------------------------------

sub do_cptx {
  my ($dat) = @_;
  push @cpraw_tx_expt, $dat;
  if ($dat == D9ATTN) {         # attn comma ?
    print conv_etime(), ".wtlam\n";
    cpraw_tx_match_now;         # if yes, force match now
  } else {
    cpraw_tx_match;             # otherwise just queue
  }
}

#-------------------------------------------------------------------------------

sub cpraw_tx_match_now {
  my $nexpt = scalar(@cpraw_tx_expt);

  while (scalar(@cpraw_tx_expt)) {
    if (wait_sel_filercv(1.)) {
      cpraw_tx_match;
    } else {
      print "pi_rri($curmode)-I: time out waiting for cptx response\n";
      last;
    }
  }
}

#-------------------------------------------------------------------------------

sub cpraw_tx_match {

  while (1) {
    my $dat = raw_rcv9();
    last unless defined $dat;
    push @cpraw_tx_read, $dat;
  }

  while (scalar(@cpraw_tx_expt)>0 && 
         scalar(@cpraw_tx_read)>0) {
    my $dat_e = shift @cpraw_tx_expt;
    my $dat_r = shift @cpraw_tx_read;

    print conv_etime(), "cptx ", conv_dat9($dat_r), " CHECK ";
    if ($dat_e == $dat_r) {
      print "OK";
    } else {
      print "FAIL exp=", conv_dat9($dat_e);
    }
    print "\n";
  }

}

#-------------------------------------------------------------------------------

sub rri_open {
  $rri_ref_sdef = 0x00;         # by default check for 'hard' errors
  $rri_msk_sdef = 0xf0;         # ignore the status bits + attn flag
}

#-------------------------------------------------------------------------------

sub rri_flush {
  my ($case) = @_;
  rri_cmdlist_do();
}

#-------------------------------------------------------------------------------

sub rri_close {
}

#-------------------------------------------------------------------------------
#  .cpmon 0|1
#  .rbmon 0|1
#  .scntl n 0|1
#  .sinit g8 g16
#  .sdef  [s=g8]
#  .amclr
#  .amdef name g8
#  .reset
#  .wait  n
#  .wtlam n
#  .cclst
#  rreg   <addr> [d=g16] [s=g8]
#  rblk   <addr> n [s=g8]
#         followed by n d=g16 data check values
#  wreg   <addr> g16 [s=g8]
#  wblk   <addr> n [s=g8]
#         followed by n g16 data values
#  stat   [d=g16] [s=d8]
#  attn   [d=g16] [s=d8]
#  init   <addr> g16 [s=g8]

sub rri_cexec {
  my ($cmd) = @_;

  $cmd_line = $cmd;
  $cmd_rest = "";
  $cmd_bad  = 0;

  if ($cmd =~ /^(\.cpmon|\.rbmon)\s+([01])/) {  # .cpmon, .rbmon -------------
    my $ind = ($1 eq ".cpmon") ? 15 : 14;
    $cmd_rest = $';
    rri_sideband(0x00, ($ind<<8) + $2);

  } elsif ($cmd =~ /^\.scntl\s+(\d+)\s([01])/) { # .scntl ------------------
    $cmd_rest = $';
    rri_sideband(0x00, ($1<<8) + $2);

  } elsif ($cmd =~ /^\.sinit/) {             # .sinit ------------------
    $cmd_rest = $';
    my $addr = cget_gdat(8,$rri_dbasi);
    my $data = cget_gdat(16,$rri_dbasi);
    rri_sideband($addr, $data) if (not $cmd_bad);

  } elsif ($cmd =~ /^\.sdef/) {              # .sdef -------------------------
    $cmd_rest = $';
    ($rri_ref_sdef,$rri_msk_sdef) = cget_tagval2_gdat("s",8,2);

  } elsif ($cmd =~ /^\.amclr/) {             # .amclr ------------------------
    $cmd_rest = $';
    %rri_amtbl = ();

  } elsif ($cmd =~ /^\.amdef\s+([a-zA-Z][a-zA-Z0-9]*)/) {# .amdef ------------
    $cmd_rest = $';
    my $name = $1;
    my $addr = cget_gdat(8,2);
    if (defined $addr) {
      $rri_amtbl{$name} = $addr;
    } else {
      $cmd_bad = 1;
    }

  } elsif ($cmd =~ /^\.dbasi\s+(\d+)/) {     # .dbasi  -----------------------
    $cmd_rest = $';
    my $dbase = int $1;
    $rri_dbasi = $dbase;
  } elsif ($cmd =~ /^\.dbaso\s+(\d+)/) {     # .dbaso  -----------------------
    $cmd_rest = $';
    my $dbase = int $1;
    $rri_dbaso = $dbase;
    if ($rri_dbaso == 2) {
      $rri_nodfill = " " x 15;
    } elsif ($rri_dbaso == 8) {
      $rri_nodfill = " " x  5;
    } elsif ($rri_dbaso == 16) {
      $rri_nodfill = " " x  3;
    } else {
      $rri_nodfill = "???";
    }

  } elsif ($cmd =~ /^\.reset/) {             # .reset ------------------------
    $cmd_rest = $';
    print "pi_rri($curmode)-I: $cmd currently ignored\n";

  } elsif ($cmd =~ /^\.wait\s+(\d+)/) {      # .wait ------------------------
    $cmd_rest = $';
    my $delay = int $1;
    rri_cmdlist_do();                        # flush before waiting
    for (my $i = 0; $i < $delay; $i++) {
      raw_snd9(D9IDLE);
    }

  } elsif ($cmd =~ /^\.wtlam\s+(\d+)/) {     # .wtlam ------------------------
    $cmd_rest = $';
    rri_cmdlist_do();                        # flush before wait for ATTN
    my $tstart = get_time();
    raw_get9_check(D9ATTN, "wtlam");         # ???FIXME this is a hack...
    printf "-- .wtlam   # wait for %7.3f sec\n", get_time()-$tstart;

  } elsif ($cmd =~ /^\.cclst/) {             # .cclst ------------------------
    $cmd_rest = $';
    $rri_ncmdmax = scalar(@rri_cmdlist) + 1; # force exec after next cmd

  } elsif ($cmd =~ /^rreg/) {                # rreg --------------------------
    $cmd_rest = $';
    my $addr = rri_cget_addr;
    my ($ref_data, $msk_data) = cget_tagval2_gdat("d",16,$rri_dbasi);
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "rreg",
                          addr     => $addr,
                          ref_data => $ref_data,
                          msk_data => $msk_data,
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^rblk/) {                # rblk --------------------------
    $cmd_rest = $';
    my $addr = rri_cget_addr;
    my $nblk = rri_cget_nblk;
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    my @ref_rblk;
    my @msk_rblk;
    my $i;
    cget_chkblank();
    for ($i = 0; $i < $nblk; $i++) {
      $cmd_rest = get_command() if ($cmd_rest eq "");
      $cmd_rest =~ s/^\s*//;
      my ($ref,$msk) = cget_tagval2_gdat("d",16,$rri_dbasi);
      push @ref_rblk, $ref;
      push @msk_rblk, $msk;
    }
    cget_chkblank();
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "rblk",
                          addr     => $addr,
                          nblk     => $nblk,
                          ref_rblk => [@ref_rblk],
                          msk_rblk => [@msk_rblk],
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^wreg/) {                # wreg --------------------------
    $cmd_rest = $';
    my $addr = rri_cget_addr;
    my $data = cget_gdat(16,$rri_dbasi);
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "wreg",
                          addr     => $addr,
                          data     => $data,
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^wblk/) {                # wblk --------------------------
    $cmd_rest = $';
    my $addr = rri_cget_addr;
    my $nblk = rri_cget_nblk;
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    my @dat_wblk;
    my $i;
    cget_chkblank();
    for ($i = 0; $i < $nblk; $i++) {
      $cmd_rest = get_command() if ($cmd_rest eq "");
      $cmd_rest =~ s/^\s*//;
      push @dat_wblk, cget_gdat(16,$rri_dbasi);
    }
    cget_chkblank();
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "wblk",
                          addr     => $addr,
                          nblk     => $nblk,
                          dat_wblk => [@dat_wblk],
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^stat/) {                # stat --------------------------
    $cmd_rest = $';
    my ($ref_data, $msk_data) = cget_tagval_gdat("d",16,2);
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "stat",
                          ref_data => $ref_data,
                          msk_data => $msk_data,
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^attn/) {                # attn --------------------------
    $cmd_rest = $';
    my ($ref_data, $msk_data) = cget_tagval_gdat("d",16,$rri_dbasi);
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "attn",
                          ref_data => $ref_data,
                          msk_data => $msk_data,
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^init/) {                # init --------------------------
    $cmd_rest = $';
    my $addr = rri_cget_addr;
    my $data = cget_gdat(16,$rri_dbasi);
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "init",
                          addr     => $addr,
                          data     => $data,
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } else {
    print "pi_rri($curmode)-E: unknown command: \"$cmd_line\"\n";
  }

  cget_chkblank() unless $cmd_bad;
  if ($cmd_bad) {
    print "pi_rri($curmode)-E: parse error, command ignored: \"$cmd_line\"\n";
  } else {
    if (scalar(@rri_cmdlist) >= $cmax ||
        ($rri_ncmdmax && scalar(@rri_cmdlist) >= $rri_ncmdmax)) {
      $rri_ncmdmax = undef;
      rri_cmdlist_do();
    }
  }
}

#-------------------------------------------------------------------------------

sub rri_cget_stat {
  my ($dat, $msk) = cget_tagval2_gdat("s",8,2);
  if (defined $dat) {
    return ($dat, $msk);
  } else {
    return ($rri_ref_sdef, $rri_msk_sdef);
  }
}

#-------------------------------------------------------------------------------

sub rri_cget_addr {
  my $odat;
  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^\.([a-zA-Z][a-zA-Z0-9]*)/) {
    $cmd_rest = $';
    if (exists $rri_amtbl{$1}) {
      $odat = $rri_amtbl{$1};
      if ($cmd_rest =~ /^\|/) {
        $cmd_rest = $';
        $odat |= cget_gdat(8,2);
      }
    } else {
      print "pi_rri($curmode)-E: undefined address mnemo: \"$1\"\n";
      $cmd_bad = 1;
    }
  } else {
    $odat = cget_gdat(8,2);
  }
  return $odat;
}

#-------------------------------------------------------------------------------

sub rri_cget_nblk {
  my $odat;
  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^(\d*)/) {
    $cmd_rest = $';
    $odat = int $1;
    if ($odat <= 0 || $odat > 256) {
      print "pi_rri($curmode)-E: block length <0 or >256\n";
      $cmd_bad = 1;
    }
  } else {
    $cmd_bad = 1;
  }
  return $odat;
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_dump {
  my ($href,$dblk,$fh) = @_;
  my $fh_old;

  $fh_old = select($fh) if defined $fh;

  foreach my $ele (@$href) {

    printf "-- %-4s",$ele->{cname};

    printf " %-7s","[$ele->{aname}]" if exists $ele->{aname};

    printf " c=%1.1x%1d%1d", $ele->{cmd}>>4, ($ele->{cmd}>>3)&0x1,
                             $ele->{cmd}&0x7 if exists $ele->{cmd};

    printf " a=%s",conv_dat8($ele->{addr}) if exists $ele->{addr};

    printf " n=%d", $ele->{nblk} if exists $ele->{nblk};

    printf " d=%s", gconv_dat16($ele->{data},$rri_dbaso) if exists $ele->{data};

    if (exists $ele->{ref_data}) {
      if ((defined $ele->{msk_data} && $ele->{msk_data} == 0xffff)
          || not defined $ele->{ref_data}) {
        printf " d=-%s", $rri_nodfill;
      } else {
        printf " d=%s", gconv_dat16($ele->{ref_data},$rri_dbaso);
        printf ",%s", gconv_dat16($ele->{msk_data},$rri_dbaso) if $ele->{msk_data};     
      }
    }

    if (defined $ele->{rcv_data}) {
      printf " D=%s%s", gconv_dat16($ele->{rcv_data},$rri_dbaso),
        ($ele->{err_data} ? "(#)" : "   ");
    }

    if (exists $ele->{ref_stat}) {
      if ((defined $ele->{msk_stat} && $ele->{msk_stat} == 0xffff)
          || not defined $ele->{ref_stat}) {
        printf " s=-";
      } else {
        printf " s=%s", conv_dat8($ele->{ref_stat});
        printf ",%s", conv_dat8($ele->{msk_stat}) if $ele->{msk_stat};  
      }
    }

    if (defined $ele->{rcv_stat}) {
      printf " S=%s%s", conv_dat8($ele->{rcv_stat}),
        ($ele->{err_stat} ? "(#)" : "   ");
    }

    if (exists $ele->{ok}) {
      print ($ele->{ok} ? " OK" : "FAIL");
    } else {
      print " PEND";
    }

    if (exists $ele->{dat_wblk} && $dblk) {
      my $i = 0;
      foreach ( @{$ele->{dat_wblk}} ) {
        printf "\n--  " if ($i % 8 == 0);
        printf " %s", gconv_dat16($_,$rri_dbaso);
        $i += 1;
      }
    }

    if (exists $ele->{ref_rblk} && $dblk && scalar(@{$ele->{ref_rblk}}) ) {
      my $i;
      my $nblk = $ele->{nblk};
      for ($i = 0; $i < $nblk; $i++) {
        printf "\n--  " if ($i % 4 == 0);
        if ((defined $ele->{msk_rblk}[$i] && $ele->{msk_rblk}[$i] == 0xffff)
            || not defined $ele->{ref_rblk}[$i]){
          printf " d=-%s  %s", $rri_nodfill, $rri_nodfill;
        } else {
          printf " d=%s", gconv_dat16($ele->{ref_rblk}[$i],$rri_dbaso);
          if ($ele->{msk_rblk}[$i]) {
            printf ",%s", gconv_dat16($ele->{msk_rblk}[$i],$rri_dbaso);
          } else {
            print "       ";
          }
        }
      }
    }

    if (exists $ele->{rcv_rblk} && $dblk) {
      my $i;
      my $nblk = $ele->{nblk};
      for ($i = 0; $i < $nblk; $i++) {
        printf "\n--  " if ($i % 4 == 0);
        printf " D=%s%s    ", gconv_dat16($ele->{rcv_rblk}[$i],$rri_dbaso),
          ($ele->{err_rblk}[$i] ? "(#)" : "   ");
      }
    }

    printf "\n";
  }

  select($fh_old) if defined $fh_old;

}

#-------------------------------------------------------------------------------

sub rri_sideband {
  my ($addr,$data) = @_;
  my $dl =  $data     & 0xff;
  my $dh = ($data>>8) & 0xff;
  rri_cmdlist_do();
  raw_snd8(CESC);
  raw_snd8(CESC);
  raw_snd8($addr);                          # ADDR
  raw_snd8($dl);                            # DL
  raw_snd8($dh);                            # DH
  &{$chan_tab{$curchan}{write}}();          # flush write queue
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_do {
  if (scalar(@rri_cmdlist)) {
    rri_cmdlist_exec(\@rri_cmdlist);
    rri_cmdlist_dump(\@rri_cmdlist, 1);
    @rri_cmdlist = ();
  }
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_exec {
  my ($href) = @_;
  my $seq = 0;
  my $nele = scalar(@$href);

  return unless $nele;

  $ocrc = 0;
  $icrc = 0;

  raw_snd9(D9SOP);

  foreach my $ele (@$href) {
    my $cname = $ele->{cname};
    my $cmd;

    $cmd = $rri_cname2cmd{$cname};
    $cmd |= 0x08 if $seq < $nele-1;   # set chain bit
    $cmd |= ($seq & 0xf) << 4;        # set sequence number field
    $ele->{cmd} = $cmd;
    raw_snd9_crc($cmd);
    $seq += 1;

    if ($cname eq "rreg") {
      $stat_tab{xreg} += 1;
      raw_snd9_crc($ele->{addr});
      raw_snd9($ocrc);
    } elsif ($cname eq "rblk") {
      $stat_tab{xblk} += 1;
      raw_snd9_crc($ele->{addr});
      raw_snd9_crc($ele->{nblk}-1);
      raw_snd9($ocrc);
    } elsif ($cname eq "wreg") {
      $stat_tab{xreg} += 1;
      raw_snd9_crc($ele->{addr});
      raw_snd9_crc( $ele->{data}     & 0xff);
      raw_snd9_crc(($ele->{data}>>8) & 0xff);
      raw_snd9($ocrc);
    } elsif ($cname eq "wblk") {
      $stat_tab{xblk} += 1;
      raw_snd9_crc($ele->{addr});
      raw_snd9_crc($ele->{nblk}-1);
      raw_snd9($ocrc);
      foreach ( @{$ele->{dat_wblk}} ) {
        raw_snd9_crc( $_     & 0xff);
        raw_snd9_crc(($_>>8) & 0xff);
      }
      raw_snd9($ocrc);
    } elsif ($cname eq "stat") {
      raw_snd9($ocrc);
    } elsif ($cname eq "attn") {
      raw_snd9($ocrc);
    } elsif ($cname eq "init") {
      raw_snd9_crc($ele->{addr});
      raw_snd9_crc( $ele->{data}     & 0xff);
      raw_snd9_crc(($ele->{data}>>8) & 0xff);
      raw_snd9($ocrc);
    }
  }

  raw_snd9(D9EOP);

  raw_get9_checksop() or return 0;

  foreach my $ele (@$href) {
    my $cname = $ele->{cname};
    my $idat;
    my $ok = 1;

    raw_get9_crc_check($ele->{cmd}, "cmd") or return 0;

    if ($cname eq "rreg") {
      raw_get9_crc_16bit(\$ele->{rcv_data}) or return 0;
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "rblk") {
      raw_get9_crc_check($ele->{nblk}-1, "nblk") or return 0;
      for (my $i=0; $i<$ele->{nblk}; $i++) {
        my $data;
        my $err;
        raw_get9_crc_16bit(\$data) or return 0;
        push @{$ele->{rcv_rblk}}, $data;
        $err = rri_ref_check($data, $ele->{ref_rblk}[$i], $ele->{msk_rblk}[$i]);
        push @{$ele->{err_rblk}}, $err;
        $ok = 0 if $err;
      }
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "wreg") {
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "wblk") {
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "stat") {
      raw_get9_crc_8bit(\$ele->{rcv_ccmd}) or return 0;
      raw_get9_crc_16bit(\$ele->{rcv_data}) or return 0;
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "attn") {
      raw_get9_crc_16bit(\$ele->{rcv_data}) or return 0;
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    } elsif ($cname eq "init") {
      raw_get9_crc_8bit(\$ele->{rcv_stat}) or return 0;
      raw_get9_check($icrc, "crc") or return 0;
    }

    if (defined $ele->{rcv_data}) {
      $ele->{err_data} = rri_ref_check($ele->{rcv_data},
                                       $ele->{ref_data}, $ele->{msk_data});
      $ok = 0 if $ele->{err_data};
    }
    if (defined $ele->{rcv_stat}) {
      $ele->{err_stat} = rri_ref_check($ele->{rcv_stat},
                                       $ele->{ref_stat}, $ele->{msk_stat});
      $ok = 0 if $ele->{err_stat};
    }

    $ele->{ok} = $ok;

  }

  raw_get9_checkeop() or return 0;

  return 1;
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_check_stat {
  my ($href) = @_;

  foreach my $ele (@$href) {
    return 1 if not exists $ele->{rcv_stat};
    return 1 if $ele->{err_stat};
  }

  return 0;
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_get_rval {
  my ($href,$ind) = @_;
  my $nele = scalar(@$href);

  return (undef, "#ind?#") if ($ind >= $nele);

  return (undef, "#sta?#") if not exists $$href[$ind]->{rcv_stat};

  return (undef, sprintf "#s=%2.2x#",$$href[$ind]->{rcv_stat})
    if $$href[$ind]->{err_stat};

  return (undef, "#dat?#") if (not exists $$href[$ind]->{rcv_data});

  return ($$href[$ind]->{rcv_data}, sprintf "%6.6o",$$href[$ind]->{rcv_data});
}

#-------------------------------------------------------------------------------

sub rri_cmdlist_conv_rval {
  my ($href,$ind) = @_;
  my ($val,$str) = rri_cmdlist_get_rval($href, $ind);
  return $str;
}

#-------------------------------------------------------------------------------

sub rri_ref_check {                         # check reference data (1=err)
  my ($rcv,$ref,$msk) = @_;
  if (defined $ref) {
    my $mask = (defined $msk) ? $msk : 0;
    my $mrcv = $rcv | $mask;
    my $mref = $ref | $mask;
    return 1 if $mrcv != $mref;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub pdpcp_open {
  $rri_ref_sdef = 0x00;         # by default check for 'hard' errors
  $rri_msk_sdef = 0x70;         # ignore cpuhalt,cpugo and attn
}

#-------------------------------------------------------------------------------

sub pdpcp_flush {
  my ($case) = @_;
  rri_cmdlist_do();
}

#-------------------------------------------------------------------------------

sub pdpcp_close {
}

#-------------------------------------------------------------------------------
#  .tocmd n
#  .tostp n
#  .togo  n
#  .anena 0|1
#  .cpmon 0|1
#  .rbmon 0|1
#  .scntl n 0|1
#  .sinit g8 g16
#  .sdef  [s=g8]
#  .cerr  0|1
#  .merr  0|1
#  .reset
#  .wait  n
#  .cclst
#  rr*     [d=g16] [s=g8]
#  wr*     g16 [s=g8]
#  brm     n [s=g8]
#          followed by n d=g16 data check values
#  bwm     n [s=g8]
#          followed by n g16 data values
#  wal     g16 [s=g8]
#  wah     g16 [s=g8]
#  rps     [d=g16] [s=g8]
#  wps     g16 [s=g8]
#  rm      [d=g16] [s=g8]
#  rmi     [d=g16] [s=g8]
#  wm      g16 [s=g8]
#  wmi     g16 [s=g8]
#  stapc   g16 [s=g8]
#  sta     [s=g8]
#  sto     [s=g8]
#  cont    [s=g8]
#  step    [s=g8]
#  rst     [s=g8]
#  wibrb   g16
#  ribr g6 [d=g16] [s=g8]
#  wibr g6 g16
#  wtgo
#  wtlam   [d=g16]
#

sub pdpcp_cexec {
  my ($cmd) = @_;
  my $cclast;
  my $aname;
  if ($cmd =~ /^([a-z0-9]*)/) {
    $aname = $1;
  }

  $cmd =~ s/^rsp/rr6/;                      # rsp -> rr6
  $cmd =~ s/^rpc/rr7/;                      # rsp -> rr7
  $cmd =~ s/^wsp/wr6/;                      # wsp -> wr6
  $cmd =~ s/^wpc/wr7/;                      # wsp -> wr7

  $cmd_line = $cmd;
  $cmd_rest = "";
  $cmd_bad  = 0;

  if ($cmd =~ /^\.to(cmd|stp|go)\s+(\d*)/) {# .tocmd, .tostp, .togo
    $cmd_rest = $';
    print "pi_rri($curmode)-I: $cmd currently ignored\n";

  } elsif ($cmd =~ /^\.anena\s+([01])/) {    # .anena ------------------------
    $cmd_rest = $';
    my $ena = int $1;
    my $ena_data = ($ena==0) ? 0x0000 : 0x8000;
    rri_cmdlist_do();
    push @rri_cmdlist, {cname    => "init",
                        aname    => ".anena",
                        addr     => 0xff,
                        data     => $ena_data};
    rri_cmdlist_do();

  } elsif ($cmd =~ /^(\.cpmon|\.rbmon)\s+([01])/) { # .cpmon, .rbmon ---------
    $cmd_rest = $';
    my $ind = ($1 eq ".cpmon") ? 15 : 14;
    $cmd_rest = $';
    rri_sideband(0x00, ($ind<<8) + $2);

  } elsif ($cmd =~ /^\.scntl\s+(\d+)\s([01])/) { # .scntl ------------------
    $cmd_rest = $';
    rri_sideband(0x00, ($1<<8) + $2);

  } elsif ($cmd =~ /^\.sinit/) {             # .sinit ------------------
    $cmd_rest = $';
    my $addr = cget_gdat(8,$rri_dbasi);
    my $data = cget_gdat(16,$rri_dbasi);
    rri_sideband($addr, $data) if (not $cmd_bad);

  } elsif ($cmd =~ /^\.sdef/) {              # .sdef -------------------------
    $cmd_rest = $';
    ($rri_ref_sdef,$rri_msk_sdef) = cget_tagval2_gdat("s",8,2);

  } elsif ($cmd =~ /^\.[cm]err\s*[01]/) {    # .[cm]err
    # ignore, no action

  } elsif ($cmd =~ /^\.reset/) {             # .reset ------------------------
    $cmd_rest = $';
    rri_cmdlist_do();                        # flush before reset
    push @rri_cmdlist, {cname    => "init",
                        aname    => ".reset",
                        addr     => 0x00,
                        data     => 0x01};
    rri_cmdlist_do();                        # flush after reset

  } elsif ($cmd =~ /^\.wait\s+(\d+)/) {      # .wait ------------------------
    $cmd_rest = $';
    my $delay = int $1;
    rri_cmdlist_do();                        # flush before waiting
    for (my $i = 0; $i < $delay; $i++) {
      raw_snd9(D9IDLE); 
    }

  } elsif ($cmd =~ /^\.cclst/) {             # .cclst ------------------------
    $cmd_rest = $';
    $rri_ncmdmax = scalar(@rri_cmdlist) + 1; # force exec after next cmd

  } elsif ($cmd =~ /^rr([0-7])/) {           # rr* ---------------------------
    $cmd_rest = $';
    my $rnum = int $1;
    pdpcp_cmd_rreg($aname, PDPCP_ADDR_R0+$rnum);

  } elsif ($cmd =~ /^wr([0-7])/) {           # wr* ---------------------------
    $cmd_rest = $';
    my $rnum = int $1;
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_R0+$rnum);

  } elsif ($cmd =~ /^brm/) {                 # brm ---------------------------
    $cmd_rest = $';
    my $addr = PDPCP_ADDR_MEMI;
    my $nblk = rri_cget_nblk;
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    my @ref_rblk;
    my @msk_rblk;
    my $i;
    cget_chkblank();
    for ($i = 0; $i < $nblk; $i++) {
      $cmd_rest = get_command() if ($cmd_rest eq "");
      $cmd_rest =~ s/^\s*//;
      my ($ref,$msk) = cget_tagval2_gdat("d",16,8);
      push @ref_rblk, $ref;
      push @msk_rblk, $msk;
    }
    cget_chkblank();
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "rblk",
                          aname    => $aname,
                          addr     => $addr,
                          nblk     => $nblk,
                          ref_rblk => [@ref_rblk],
                          msk_rblk => [@msk_rblk],
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^bwm/) {                 # bwm ---------------------------
    $cmd_rest = $';
    my $addr = PDPCP_ADDR_MEMI;
    my $nblk = rri_cget_nblk;
    my ($ref_stat, $msk_stat) = rri_cget_stat;
    my @dat_wblk;
    my $i;
    cget_chkblank();
    for ($i = 0; $i < $nblk; $i++) {
      $cmd_rest = get_command() if ($cmd_rest eq "");
      $cmd_rest =~ s/^\s*//;
      push @dat_wblk, cget_gdat(16,8);
    }
    cget_chkblank();
    if (not $cmd_bad) {
      push @rri_cmdlist, {cname    => "wblk",
                          aname    => $aname,
                          addr     => $addr,
                          nblk     => $nblk,
                          dat_wblk => [@dat_wblk],
                          ref_stat => $ref_stat,
                          msk_stat => $msk_stat};
    }

  } elsif ($cmd =~ /^wal/) {                # wal ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_AL);

  } elsif ($cmd =~ /^wah/) {                # wah ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_AH);

  } elsif ($cmd =~ /^rps/) {                # rps ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_rreg($aname, PDPCP_ADDR_PSW);

  } elsif ($cmd =~ /^wps/) {                # wps ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_PSW);

  } elsif ($cmd =~ /^rmi/) {                # rmi ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_rreg($aname, PDPCP_ADDR_MEMI);

  } elsif ($cmd =~ /^rm/) {                 # rm ----------------------------
    $cmd_rest = $';
    pdpcp_cmd_rreg($aname, PDPCP_ADDR_MEM);

  } elsif ($cmd =~ /^wmi/) {                # wmi ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_MEMI);

  } elsif ($cmd =~ /^wm/) {                 # wm ----------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_MEM);

  } elsif ($cmd =~ /^stapc/) {              # stapc -------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_PC);
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_STA);

  } elsif ($cmd =~ /^sta/) {                # sta ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_STA);

  } elsif ($cmd =~ /^sto/) {                # sto ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_STO);

  } elsif ($cmd =~ /^cont/) {               # cont --------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_CONT);

  } elsif ($cmd =~ /^step/) {               # step --------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_STEP);

  } elsif ($cmd =~ /^rst/) {                # rst ---------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_CNTL, PDPCP_FUNC_RST);

  } elsif ($cmd =~ /^wibrb/) {              # wibrb -------------------------
    $cmd_rest = $';
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_IBRB);

  } elsif ($cmd =~ /^ribr/) {               # ribr --------------------------
    $cmd_rest = $';
    my $off = cget_gdat(6,8);
    pdpcp_cmd_rreg($aname, PDPCP_ADDR_IBR+int($off/2));

  } elsif ($cmd =~ /^wibr/) {               # wibr --------------------------
    $cmd_rest = $';
    my $off = cget_gdat(6,8);
    pdpcp_cmd_wreg($aname, PDPCP_ADDR_IBR+int($off/2));

  } elsif ($cmd =~ /^wtgo/) {               # wtgo --------------------------
    $cmd_rest = $';
    rri_cmdlist_do();
    my $tstart = get_time();
    raw_get9_check(D9ATTN, "wtgo");         # ???FIXME this is a hack...
    printf "-- wtgo   # wait for %7.3f sec\n", get_time()-$tstart;
    push @rri_cmdlist, {cname    => "attn",
                        aname    => ".wtgo"};

  } elsif ($cmd =~ /^wtlam/) {              # wtlam -------------------------
    $cmd_rest = $';
    my ($ref_data, $msk_data) = cget_tagval2_gdat("d",16,8);
    rri_cmdlist_do();
    my $tstart = get_time();
    raw_get9_check(D9ATTN, "wtgo");         # ???FIXME this is a hack...
    printf "-- wtlam  # wait for %7.3f sec\n", get_time()-$tstart;
    push @rri_cmdlist, {cname    => "attn",
                        aname    => ".wtlam",
                        ref_data => $ref_data,
                        msk_data => $msk_data};

  } else {
    print "pi_rri($curmode)-E: unknown command: \"$cmd_line\"\n";
  }

  cget_chkblank() unless $cmd_bad;
  if ($cmd_bad) {
    print "pi_rri($curmode)-E: parse error, command ignored: \"$cmd_line\"\n";
  } else {
    if (scalar(@rri_cmdlist) >= $cmax || $cclast ||
        ($rri_ncmdmax && scalar(@rri_cmdlist) >= $rri_ncmdmax)) {
      $rri_ncmdmax = undef;
      rri_cmdlist_do();
    }
  }
}

#-------------------------------------------------------------------------------

sub pdpcp_cmd_rreg {
  my ($aname,$addr) = @_;
  my ($ref_data,$msk_data) = cget_tagval2_gdat("d",16,8);
  my ($ref_stat,$msk_stat) = rri_cget_stat;
  if (not $cmd_bad) {
    push @rri_cmdlist, {cname    => "rreg",
                        aname    => $aname,
                        addr     => $addr,
                        ref_data => $ref_data,
                        msk_data => $msk_data,
                        ref_stat => $ref_stat,
                        msk_stat => $msk_stat};
  }
}

#-------------------------------------------------------------------------------

sub pdpcp_cmd_wreg {
  my ($aname,$addr,$data) = @_;
  my $ldata = (defined $data) ? $data : cget_gdat(16,8);
  my ($ref_stat,$msk_stat) = rri_cget_stat;
  if (not $cmd_bad) {
    push @rri_cmdlist, {cname    => "wreg",
                        aname    => $aname,
                        addr     => $addr,
                        data     => $ldata,
                        ref_stat => $ref_stat,
                        msk_stat => $msk_stat};
  }
}

#-------------------------------------------------------------------------------

sub serv11_open {
  $rri_ref_sdef = 0x00;         # by default check for 'hard' errors
  $rri_msk_sdef = 0x70;         # ignore cpuhalt,cpugo and attn

  serv11_config() unless $serv11_config_done;
}

#-------------------------------------------------------------------------------

sub serv11_flush {
  my ($case) = @_;
}

#-------------------------------------------------------------------------------

sub serv11_close {
}

#-------------------------------------------------------------------------------
# <string
# (string

# lspc
# lsmem {-m|-a} g16{(:g16|nddd)} {(>|>>)file}
# ldabs {-s} file
# exa <rrange>
# dep <rrange> g16
# set ...
# sho conf
# sho att
# sho regs
# sho mmu
# sho ubm[ap]
# wtt  <unit> "string"
# attn
# att  <unit> file
# det  <unit>|all
# init
# boot <unit>
# start g16
# step
# stop
# cont
# reset
# server
#

sub serv11_cexec {
  my ($cmd) = @_;

  $cmd_line = $cmd;
  $cmd_rest = "";
  $cmd_bad  = 0;

#
# First handle 'special syntax commands: ( and <
#

  if ($cmd =~ /^([<(])/) {                  # < and ( short hands -----------
    my $str = $';
    my $ucb = cget_ucb("term", "tt0");
    return if $cmd_bad or cget_chkblank();

    my @bytes;
    if ($1 eq "<") {                        # < command
      conv_str2bytes($str, \@bytes);
      push @bytes, 0015;
    } else {                                # ( command
      if ($str =~ /^\\([0-7]{3})$/) {         # (\ooo escape
        push @bytes, oct $1;
      } elsif ($str =~ /^\\\^(.)$/) {         # (^c   escape
        my $byt = ord($1);                    # to byte value
        $byt -= 040 if ($byt >= 040);         # map to control char
        $byt -= 040 if ($byt >= 040);
        $byt -= 040 if ($byt >= 040);
        push @bytes, $byt;
      } else {
        conv_str2bytes($str, \@bytes, 1);
      }
    }
    my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
    &{$ctl->{ichrhdl}}($ucb, \@bytes);

    return;
  }

#
# Now prepare normal syntax commands
#

  if ($cmd =~ /^(\w+)\b/) {                 # get command name
    $cmd = $1;
    $cmd_rest = $';
    $cmd_rest =~ s/^\s*//;
  }

  if ($cmd =~ /^lspc/) {                    # dump pc/ps -----------------
    return if cget_chkblank();
    serv11_cexec_shoreg(0);

  } elsif ($cmd =~ /^lsmem/) {              # dump memory --------------------
    my $opt_m = cget_opt("-m");
    my $opt_a = cget_opt("-a");
    my $abeg = cget_gdat(22, 8);
    return if $cmd_bad;
    my $aend = $abeg+64;
    my $fh = *STDOUT;
    my $redi = 0;
    if ($cmd_rest =~ /^:n(\d*)/) {
      $cmd_rest = $';
      $aend = $abeg + 2*(int $1);
    } elsif ($cmd_rest =~ /^:/) {
      $cmd_rest = $';
      $aend = cget_gdat(22, 8);
      return if $cmd_bad;
    }
    if ($cmd_rest =~ /^\s*(>{1,2})([\w\/.-]+)/) {
      $cmd_rest = $';
      my $oper = $1;
      my $file = $2;
      my $fh_new = new FileHandle;
      if ($fh_new->open("$oper$file")) {
        $fh = $fh_new;
        $redi = 1;
      } else {
        print "pi_rri($curmode)-E: failed to open output file $file\n";
      }
    }

    $abeg &= 0xfffffffe;
    $aend &= 0xfffffffe;
    my $nword = int (($aend - $abeg)/2);
    $nword = 1 if $nword <= 1;

    return if cget_chkblank();

    my @data;
    my $rc = serv11_exec_rblk($abeg, 1, \@data, $nword);

    my $inst_nw  = 0;
    my $inst_str = "";
    printf $fh "Memory %8.8o:%8.8o:\n", $abeg, $aend;
    for (my $i=0; $i<$nword; $i++) {
      if ($opt_m) {
        ($inst_str, $inst_nw) = 
          pdp11_disassemble($abeg+2*$i, $data[$i],$data[$i+1],$data[$i+2]);
        printf $fh "  %6.6o :", $abeg+2*$i;
        for (my $j=0; $j<3; $j++) {
          if ($j < $inst_nw) {
            printf $fh " %6.6o", (defined $data[$i+$j]) ? $data[$i+$j] : 0;
          } else {
            print $fh "       ";
          }
        }
        printf $fh "    # %s\n", $inst_str;
        $i += $inst_nw-1;

      } elsif ($opt_a) {
        my $nline = $nword - $i;
        my $ascbuf;
        $nline = 4 if $nline > 4;
        printf $fh "  %6.6o :", $abeg+2*$i;
        for (my $j=0; $j<$nline; $j++) {
          my $word = $data[$i+$j];
          my $bl =  $word     & 0377;
          my $bh = ($word>>8) & 0377;
          printf $fh " %3.3o %3.3o", $bl, $bh;
          $ascbuf .= " " . conv_byte2ascii2($bl);
          $ascbuf .= " " . conv_byte2ascii2($bh);
        }
        print $fh " " x (8*(4-$nline)+4);
        print $fh $ascbuf;
        print $fh "\n";
        $i += $nline-1;

      } else {
        printf $fh "  %6.6o : %6.6o\n", $abeg+2*$i, $data[$i];
      }
    }
    $fh->close() if $redi;

  } elsif ($cmd =~ /^ldabs/) {              # load absolute loader format ----
    my $opt_s = cget_opt("-s");
    my $file  = cget_file();
    return if cget_chkblank();
    serv11_cexec_ldabs($file, $opt_s);

  } elsif ($cmd =~ /^exa/) {                # examine register or memory -----
    my $optset = cget_optset("ir");
    my ($ctl, $beg, $end) = cget_regrange();
    return if cget_chkblank();
    serv11_cexec_exa($optset, $ctl, $beg, $end);


  } elsif ($cmd =~ /^dep/) {                # deposit register or memory -----
    my $optset = cget_optset("ir");
    my ($ctl, $beg, $end) = cget_regrange();
    my $data = cget_gdat(16, 8);
    return if cget_chkblank();
    serv11_cexec_dep($optset, $ctl, $beg, $end, $data);


  } elsif ($cmd =~ /^set/) {                # set parameter ------------------
    my $what = cget_name();
    return if $cmd_bad;

    if ($what =~ /^sim/) {                    # set sim[ulator] ------
      my $pnam = cget_name();
      my $val  = cget_bool();
      return if $cmd_bad or cget_chkblank();
      my $ind;
      $ind = 15 if $pnam eq "cpmon";
      $ind = 14 if $pnam eq "rbmon";
      $ind = 13 if $pnam eq "tmu";
      if (defined $ind) {
        rri_sideband(0x00, ($ind<<8) + $val);
      } else {
        printf "pi_rri($curmode)-E: Invalid parameter '$pnam' for set sim\n";
      }

    } else {                                  # set <device> ---------
      my $ctl = $serv11_ctltbl{uc($what)};
      if (defined $ctl) {
        my $partbl = $ctl->{partbl};
        if (defined $partbl) {
          my $pnam = cget_name();
          return if $cmd_bad;

          my $pdsc = $partbl->{$pnam};
          if (defined $pdsc) {
            my $type = $pdsc->{type};
            if ($type =~ /^hval:([bdos])$/) {
              my $cnv = $1;
              my $val;
              if ($cnv eq "b") {
                $val = cget_bool();
              } elsif ($cnv eq "d") {
                $val = cget_gdat(32, 10);
              } elsif ($cnv eq "o") {
                $val = cget_gdat(32, 8);
              } elsif ($cnv eq "s") {
                $val = $cmd_rest;
                $val =~ s/^\s*//;
                $val =~ s/\s*$//;
                $cmd_rest = "";
              }
              return if $cmd_bad or cget_chkblank();
              $ctl->{$pnam} = $val;
            } else {
              print "pi_rri($curmode)-E: unexpected type $type in partbl\n";
            }
          } else {
            print "pi_rri($curmode)-E: '$pnam' not valid for 'set $what'\n";
          }
        } else {
          print "pi_rri($curmode)-I: nothing to set for '$what'\n";
        }
      } else {
        print "pi_rri($curmode)-E: unknown entity for 'set': \"$what\"\n";
      }
    }

  } elsif ($cmd =~ /^sho/) {                # show parameters ----------------
    my $what = cget_name();
    return if $cmd_bad;

    if ($what =~ /^conf/) {                   # sho conf[iguration] --
      return if cget_chkblank();
      serv11_cexec_shoconf();

    } elsif ($what =~ /^att/) {               # sho att --------------
      return if cget_chkblank();
      serv11_cexec_shoatt();

    } elsif ($what =~ /^regs/) {              # sho regs -------------
      return if cget_chkblank();
      serv11_cexec_shoreg(1);

    } elsif ($what =~ /^mmu/) {               # sho mmu --------------
      return if cget_chkblank();
      serv11_cexec_shommu_ssrx;
      serv11_cexec_shommu_sadr(0172300, "KM");
      serv11_cexec_shommu_sadr(0172200, "SM");
      serv11_cexec_shommu_sadr(0177600, "UM");

    } elsif ($what =~ /^ubm/) {               # sho ubmap ------------
      return if cget_chkblank();

      my @data;
      my $rc = serv11_exec_rblk(0170200, 0, \@data, 64);
      print  "UNIBUS mapping registers:\n";
      for (my $i=0; $i<32; $i++) {
        printf "  [%2d]: %2.2o,%6.6o\n", $i, $data[2*$i+1], $data[2*$i];
      }

    } else {                                  # sho <device> ---------
      my $ctl = $serv11_ctltbl{uc($what)};
      if (defined $ctl) {
        my $partbl = $ctl->{partbl};
        if (defined $partbl) {
          foreach my $pnam (sort keys %{$partbl}) {
            my $pdsc = $partbl->{$pnam};
            my $type = $pdsc->{type};
            if ($type =~ /^hval:([bdos])$/) {
              my $cnv = $1;
              my $val = $ctl->{$pnam};
              my $val_str = $val;
              if (defined $val) {
                $val_str = ($val) ? "1 (yes)" : "0 (no)" if $cnv eq "b";
                $val_str = sprintf("%6d.", $val)  if $cnv eq "d";
                $val_str = sprintf("%6.6o", $val) if $cnv eq "o";
              } else {
                $val_str = "<undef>";
              }
              printf "%4s %10s : %s\n", uc($what), $pnam, $val_str;
            } else {
              print "pi_rri($curmode)-E: unexpected type $type in partbl\n";
            }
          }
        } else {
          print "pi_rri($curmode)-I: nothing to show for '$what'\n";
        }
      } else {
        print "pi_rri($curmode)-E: unknown entity for 'sho': \"$what\"\n";
      }
    }

  } elsif ($cmd =~ /^wtt/) {               # write to TT decives -------------
    my $ucb = cget_ucb("term");
    my $str = "\\n";
    if ($cmd_rest =~ /^\s*"(.*)"\s*/) {
      $cmd_rest = $';
      $str = $1;
    }
    return if $cmd_bad or cget_chkblank();

    my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
    my @bytes;
    conv_str2bytes($str, \@bytes, 1);
    &{$ctl->{ichrhdl}}($ucb, \@bytes)

  } elsif ($cmd =~ /^attn/) {               # attn  --------------------------
    return if cget_chkblank();
    serv11_server_attn_get();

  } elsif ($cmd =~ /^att/) {                # attach  ------------------------
    my $ucb = cget_ucb();
    return if $cmd_bad;
    serv11_cexec_attdet(0,$ucb);

  } elsif ($cmd =~ /^det/) {                # detach  ------------------------
    my $ucb = cget_ucb();
    return if cget_chkblank();
    serv11_cexec_attdet(1,$ucb);

  } elsif ($cmd =~ /^init/) {               # init  --------------------------
    return if cget_chkblank();
    serv11_init_dispatch() if $serv11_init_pending;

  } elsif ($cmd =~ /^boot/) {               # boot  --------------------------
    my $ucb = cget_ucb();
    return if $cmd_bad or cget_chkblank();
    serv11_cexec_boot($ucb);

  } elsif ($cmd =~ /^start/) {              # start --------------------------
    my $addr = cget_gdat(16, 8);
    return if cget_chkblank();
    my @rval;
    my $rc;
    serv11_rri_init(".anena", 0xff, $serv11_init_anena);# enable attn+ioto
    serv11_rri_attn("attn");                            # discard old attn's
    serv11_rri_wreg("wpc", PDPCP_ADDR_PC, $addr);
    serv11_rri_wreg("sta", PDPCP_ADDR_CNTL, PDPCP_FUNC_STA);
    $rc = serv11_rri_exec(\@rval);

  } elsif ($cmd =~ /^step/) {               # step --------------------------
    my @rval;
    my $rc;
    serv11_rri_wreg("sta", PDPCP_ADDR_CNTL, PDPCP_FUNC_STEP);
    $rc = serv11_rri_exec(\@rval);
    serv11_cexec_shoreg(1);

  } elsif ($cmd =~ /^stop/) {               # stop --------------------------
    my @rval;
    my $rc;
    serv11_rri_wreg("sto", PDPCP_ADDR_CNTL, PDPCP_FUNC_STO);
    $rc = serv11_rri_exec(\@rval);
    serv11_cexec_shoreg(1);

  } elsif ($cmd =~ /^cont/) {               # cont --------------------------
    my @rval;
    my $rc;
    serv11_rri_wreg("sto", PDPCP_ADDR_CNTL, PDPCP_FUNC_CONT);
    $rc = serv11_rri_exec(\@rval);

  } elsif ($cmd =~ /^reset/) {              # reset -------------------------
    my @rval;
    my $rc;
    serv11_rri_wreg("rst", PDPCP_ADDR_CNTL, PDPCP_FUNC_RST);
    $rc = serv11_rri_exec(\@rval);

  } elsif ($cmd =~ /^server/) {             # enter server mode --------------
    return if cget_chkblank();
    serv11_server();

  } else {
    print "pi_rri($curmode)-E: unknown command: \"$cmd_line\"\n";
  }
}


#-------------------------------------------------------------------------------

sub serv11_cexec_shoreg {
  my ($mode) = @_;
  my $ipc;
  my $ips;
  my @rval;

  if ($mode > 0) {
    serv11_rri_rreg("rr0", PDPCP_ADDR_R0+0);
    serv11_rri_rreg("rr1", PDPCP_ADDR_R0+1);
    serv11_rri_rreg("rr2", PDPCP_ADDR_R0+2);
    serv11_rri_rreg("rr3", PDPCP_ADDR_R0+3);
    serv11_rri_rreg("rr4", PDPCP_ADDR_R0+4);
    serv11_rri_rreg("rr5", PDPCP_ADDR_R0+5);
    serv11_rri_rreg("rr6", PDPCP_ADDR_R0+6);
  }
  $ipc = serv11_rri_rreg("rr7", PDPCP_ADDR_R0+7);
  $ips = serv11_rri_rreg("rps", PDPCP_ADDR_PSW);

  my $rc = serv11_rri_exec(\@rval);

  print  "Processor registers and status:\n" if ($mode > 0);

  my $ps_bin = gconv_dat16($rval[$ips],2);

  printf "  PC: %6.6o  ", $rval[$ipc] if ($mode == 0);
  printf "  PS: %6.6o", $rval[$ips];
  printf "  cmo=%s",substr($ps_bin,0,2);    # bit 15:14 -> 0,2
  printf " pmo=%s",substr($ps_bin,2,2);     # bit 13:12 -> 2,2
  printf " set=%s",substr($ps_bin,4,1);     # bit 11    -> 4
  printf " pri=%d",($rval[$ips]>>5)&0x7;    # bit 07:05
  printf " t=%s",  substr($ps_bin,11,1);    # bit 04    -> 11,1
  printf " NZVC=%s", substr($ps_bin,12,4);  # bit 03:00 -> 12,4
  print  "\n";

  if ($mode > 0) {
    printf "  R0: %6.6o", $rval[0];
    printf "  R1: %6.6o", $rval[1];
    printf "  R2: %6.6o", $rval[2];
    printf "  R3: %6.6o\n", $rval[3];
    printf "  R4: %6.6o", $rval[4];
    printf "  R5: %6.6o", $rval[5];
    printf "  SP: %6.6o", $rval[6];
    printf "  PC: %6.6o\n", $rval[$ipc];
  }
}

#-------------------------------------------------------------------------------
# ssr0 177572
# ssr1 177574
# ssr2 177576
# ssr3 172516

sub serv11_cexec_shommu_ssrx {
  my @rval;

  serv11_rri_wreg("wal", PDPCP_ADDR_AL, 0177572);
  my $issr0 = serv11_rri_rreg("rmi", PDPCP_ADDR_MEMI);
  my $issr1 = serv11_rri_rreg("rmi", PDPCP_ADDR_MEMI);
  my $issr2 = serv11_rri_rreg("rmi", PDPCP_ADDR_MEMI);
  serv11_rri_wreg("lal", PDPCP_ADDR_AL, 0172516);
  my $issr3 = serv11_rri_rreg("rmi", PDPCP_ADDR_MEMI);

  my $rc = serv11_rri_exec(\@rval);

  print  "MMU registers:\n";
  printf "  SSR0: %6.6o\n", $rval[$issr0];
  printf "  SSR1: %6.6o\n", $rval[$issr1];
  printf "  SSR2: %6.6o\n", $rval[$issr2];
  printf "  SSR3: %6.6o\n", $rval[$issr3];

}

#-------------------------------------------------------------------------------
#
# Note: The ptape maindec's have even size records, except possibly for the
#       last one, and always start at an even address.
#       The lda's extracted with UPD2 PIP from the xxdp22 disk have often
#       records with 503 byte payload, starting at even and odd addresses.
#       Since blkw only handles even sized transfers on even addresses some
#       magic with the %oddbyt hash is needed to handle this correctly.
#
sub serv11_cexec_ldabs {
  my ($file,$opt_s) = @_;
  if (not -r $file) {
    print "pi_rri($curmode)-E: file $file not found or readable\n";
    return;
  }
  my $fh = new FileHandle;

  $fh->open("<$file") or die "unexpected open failure";

  my $chrnum = 0;                           # char number in block
  my $blknum = 0;                           # block number
  my $bytcnt = 0;                           # byte count
  my $ldaddr = 0;                           # load address
  my $chksum = 0;                           # check sum
  my $addr   = 0;                           # current address
  my @data;                                 # data array for transfer
  my %oddbyt;                               # odd byte cache
  my $word;

  while (1) {
    my $buf;
    my $rc = $fh->read($buf,1);
    if ($rc == 0) {
      print "pi_rri($curmode)-E: unexpected EOF in $file\n" unless $chrnum == 0;
      return;
    }

    return if $rc != 1;
    my $byt = ord($buf);
    $chksum = ($chksum + $byt) & 0377;

    if ($chrnum == 0) {                    # in blank tape
      if ($byt == 0) {
        next;
      } elsif ($byt == 1) {
        $chrnum += 1;
      } else {
        printf "pi_rri($curmode)-E: unexpected start-of-block %3.3o in $file\n",
          $byt;
        return;
      }

    } elsif ($chrnum == 1) {               # 001 frame seen
      if ($byt == 0) {
        $chrnum += 1;
      } else {
        printf "pi_rri($curmode)-E: unexpected 2nd char %3.3o in $file\n",
          $byt;
        return;
      }

    } elsif ($chrnum == 2) {               # byte count low
      $bytcnt = $byt & 0377;
      $chrnum += 1;
    } elsif ($chrnum == 3) {               # byte count high
      $bytcnt |= ($byt & 0377)<<8;
      $chrnum += 1;

    } elsif ($chrnum == 4) {               # load address low
      $ldaddr = $byt & 0377;
      $chrnum += 1;
    } elsif ($chrnum == 5) {               # load address high
      $ldaddr |= ($byt & 0377)<<8;
      $chrnum += 1;
      printf "pi_rri($curmode)-I: block %3d, length %5d byte,".
             " address %6.6o:%6.6o\n",
        $blknum, ($bytcnt-6), $ldaddr, $ldaddr+($bytcnt-6)-1;

      $addr = $ldaddr;                     # setup current address
      $word = 0;
      if (($addr & 01) == 1 && $bytcnt > 6) { # setup even byte if known...
        $word = $oddbyt{sprintf("%6.6o",$addr)};
        if (not defined $word) {
          printf "pi_rri($curmode)-W: no low byte data for %6.6o\n", $addr;
          $word = 0;
        }
      }

    } elsif ($chrnum == $bytcnt) {         # check sum byte
      if ($chksum != 0) {
        printf "pi_rri($curmode)-E: check sum error %3.3o in $file\n",
          $chksum;
        return;
      }
      if ($chrnum == 6) {
        printf "pi_rri($curmode)-I: start address %6.6o\n", $ldaddr;
        return;
      } else {
        if (($addr & 01) == 1) {           # high byte not yet seen
          push @data, $word;                  # zero fill high byte
          $oddbyt{sprintf("%6.6o",$addr)} = $word; # store even byte for later
                                                 # note that address is odd here
        }
        serv11_exec_wblk($ldaddr, 0, \@data);
        @data = ();
      }
      $chrnum  = 0;
      $blknum += 1;

    } else {                               # in data
      if (($addr & 01) == 0) {               # low byte
        $word  = $byt & 0377;
        $addr += 1;
      } else {                               # high byte
        $word |= ($byt & 0377)<<8;
        push @data, $word;
        $addr += 1;
      }
      $chrnum += 1;
    }
  }

  $fh->close();
}

#-------------------------------------------------------------------------------
# sadr format:
#   offset  0: DR[0] I space
#   offset 20: DR[0] D space
#   offset 40: AR[0] I space
#   offset 60: AR[0] D space
#
sub serv11_cexec_shommu_sadr {
  my ($base,$mode) = @_;
  my @data;
  my $rc = serv11_exec_rblk($base, 0, \@data, 32);

  for (my $i=0; $i<16; $i++) {
    my $space  = ($i<8) ? "I" : "D";
    my $ind    = $i%8;
    my $dr     = $data[$i];
    my $ar     = $data[$i+16];
    my $dr_bin = gconv_dat16($dr,2);
    my $dr_acf = $dr&0xf;                     # bit 3:0

    printf "  %s-%s[%d]: %6.6o,%6.6o", $mode,$space,$ind, $dr, $ar;
    printf "  slf=%3d", ($dr>>8)&0xff;
    printf " aib=%s", substr($dr_bin,8,2);    # bit 7:6 ->  8,2
    printf " acf=%d", $dr_acf;
    print "\n";
  }

}

#-------------------------------------------------------------------------------

sub serv11_cexec_shoconf {
  foreach my $ctlname (sort { $serv11_ctltbl{$b}->{base} <=>
                                $serv11_ctltbl{$a}->{base} }
                       keys %serv11_ctltbl) {
    my $ctl = $serv11_ctltbl{$ctlname};
    my $mask = $ctl->{probemask};
    my $ival = $ctl->{probe_ival};
    my $rval = $ctl->{probe_rval};
    my $ib_str = ($mask =~ /i/) ? ( (defined $ival) ? "y" : "n" ) : "-";
    my $rb_str = ($mask =~ /r/) ? ( (defined $rval) ? "y" : "n" ) : "-";
    printf "%-3s  %-9s  %4s: %s ib=%s rb=%s lam=%s boot=%s", $ctlname,
      $ctl->{ctltype}, $ctl->{type},
      ($ctl->{base} ? sprintf("%6.6o", $ctl->{base}) : "......"),
      $ib_str, $rb_str,
      (exists $ctl->{lam} ? sprintf("%2d",$ctl->{lam}) : " -"),
      (exists $ctl->{boot_code} ? "y" : "n");
    printf "  %s",$ctl->{probe_text} if $ctl->{probe_text};
    print  "\n";
  }
}

#-------------------------------------------------------------------------------

sub serv11_cexec_shoatt {
  foreach my $unitname (sort keys %serv11_unittbl) {
    my $ucb = $serv11_unittbl{$unitname};
    my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
    next unless $ctl->{probe_ok};
    next unless $ucb->{att_ok};
    printf "%-3s : ", $unitname;
    if ($ctl->{type} eq "disk") {
      printf "nblk=%6d wp=%s file=%s",
        $ucb->{att_nblk},
        ($ucb->{att_wpro} ? "y" : "n"),
        $ucb->{att_file};
    } elsif ($ctl->{type} eq "tape") {
      printf "wp=%s file=%s",
        ($ucb->{att_wpro} ? "y" : "n"),
        $ucb->{att_file};
    } elsif ($ctl->{type} eq "term") {
      printf "port=%s",
        $ucb->{att_port};
    }
    print "\n";
  }
}

#-------------------------------------------------------------------------------

sub serv11_cexec_attdet {
  my ($det,$ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  my $attdethdl = $ctl->{attdethdl};

  if (not defined $attdethdl) {
    printf "pi_rri($curmode)-E: attach/detach not supported for %s\n",
      $ucb->{unitname};
    return;
  }

  &{$attdethdl}($det, $ucb);                # call handler

}

#-------------------------------------------------------------------------------

sub serv11_cexec_boot {
  my ($ucb) = @_;
  my @rval;
  my $rc;

  my $unitname = $ucb->{unitname};
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if (not exists $ctl->{boot_code}) {
    print "pi_rri($curmode)-E: device $unitname not bootable\n";
    return;
  }

  serv11_init_dispatch() if $serv11_init_pending;

  my @boot_code   = @{$ctl->{boot_code}};
  my $boot_length = scalar(@boot_code);
  my $boot_mode   = $ctl->{boot_mode};
  my $boot_entry  = $ctl->{boot_entry};

  $boot_mode = "disk" unless defined $boot_mode;

  if ($boot_mode eq "disk") {
    my $boot_unit = $ctl->{boot_unit};
    $boot_code[int (($boot_unit-(BOOT_START))/2)] =
      $ucb->{ctlunit};                                    # patch in unit num
    $rc = serv11_exec_wblk(BOOT_START, 0, \@boot_code, $boot_length);

  } elsif ($boot_mode eq "ptape") {
    my $boot_base = $ctl->{boot_base};
    my $memsize = 56 * 1024;                # FIXME: check memtop !!!
    $memsize = 56*1024 if ($memsize > 56*1024);
    my $nblk8k = $memsize/020000;
    my $offset = ($nblk8k-1) * 020000;
    $boot_base  += $offset;
    $boot_entry += $offset;
    $rc = serv11_exec_wblk($boot_base, 0, \@boot_code, $boot_length);

  } else {
    print_fatal("unsupported boot mode '$boot_mode' in serv11_cexec_boot");
  }

  serv11_rri_init(".anena", 0xff, $serv11_init_anena);  # enable attn+ioto
  serv11_rri_attn("attn");                              # discard old attn's
  serv11_rri_wreg("wpc", PDPCP_ADDR_PC, $boot_entry);
  serv11_rri_wreg("sta", PDPCP_ADDR_CNTL, PDPCP_FUNC_STA);

  $rc = serv11_rri_exec(\@rval);
}

#-------------------------------------------------------------------------------

sub serv11_cexec_exa {
  my ($optset,$ctl,$beg,$end) = @_;

  if (not defined $ctl) {                   # numerical address
    for (my $addr=$beg; $addr<=$end; $addr+=2) {
      my @rval;
      serv11_rri_wreg("wal", PDPCP_ADDR_AL, $addr);
      serv11_rri_rreg("rm",  PDPCP_ADDR_MEM);
      my $rc = serv11_rri_exec(\@rval);
      printf "mem %6.6o : %6.6o\n", $addr, $rval[0];
    }

  } else {

    my $reglist = $ctl->{reglist};
    for (my $i=$beg; $i<=$end; $i++) {
      my $dsc = $reglist->[$i];
      last if not defined $reglist->[$i];
      my $name     = $dsc->{name};
      my $addr     = $dsc->{addr};
      my $offset   = $dsc->{offset};
      my $attr     = $dsc->{attr};
      my $val;
      my $addr_str = "......";
      my $acs_str  = "ib";
      my $val_str  = "......";
      my $com_str  = "";

      $addr = $ctl->{base} + $offset if defined $offset;

      $attr = 0 unless defined $attr;

      $acs_str = "rb" if ($attr & REGATTR_RBRD);
      $acs_str = "ib" if $optset =~ /i/;
      $acs_str = "rb" if $optset =~ /r/;

      if ($end > $beg &&
          ( ( ($attr & REGATTR_IBMBOX) && $acs_str eq "ib" ) ||
            ( ($attr & REGATTR_RBMBOX) && $acs_str eq "rb" )
          ) ) {
        $com_str = "mailbox skipped";

      } else {

        my $exadethdl = $dsc->{hdl};
        if (defined $dsc->{hdl}) {
          $acs_str = "  ";
          $val = &{$dsc->{hdl}}(0, $dsc);

        } else {
          if ($acs_str eq "rb") {
            my $ibrbase = $addr & ~(077);
            my $ibroff  = $addr - $ibrbase;
            serv11_rri_wreg("wibrb", PDPCP_ADDR_IBRB, $ibrbase);
            serv11_rri_rreg("ribr",  PDPCP_ADDR_IBR + int($ibroff/2));
            $acs_str = "rb";
          } else {
            serv11_rri_wreg("wal", PDPCP_ADDR_AL, $addr);
            serv11_rri_rreg("rm",  PDPCP_ADDR_MEM);
            $acs_str = "ib";
          }
          my @rval;
          my $rc = serv11_rri_exec(\@rval);
          $val = $rval[0];
        }
      }

      $addr_str = sprintf("%6.6o", $addr) if defined $addr;
      $val_str  = sprintf("%6.6o", $val)  if defined $val;
      printf "%4s %6s %2s  %6s : %6s", $ctl->{ctlname}, $name,
        $acs_str, $addr_str, $val_str;
      print "   $com_str" if defined $com_str;
      print "\n";
    }

  }
}

#-------------------------------------------------------------------------------

sub serv11_cexec_dep {
  my ($optset,$ctl,$beg,$end,$data) = @_;

  if (not defined $ctl) {                   # numerical address
    for (my $addr=$beg; $addr<=$end; $addr+=2) {
      my @rval;
      serv11_rri_wreg("wal", PDPCP_ADDR_AL, $addr);
      serv11_rri_wreg("wm",  PDPCP_ADDR_MEM,  $data);
      my $rc = serv11_rri_exec(\@rval);
    }

  } else {

    my $reglist = $ctl->{reglist};
    for (my $i=$beg; $i<=$end; $i++) {
      my $dsc = $reglist->[$i];
      last if not defined $reglist->[$i];
      my $name     = $dsc->{name};
      my $addr     = $dsc->{addr};
      my $offset   = $dsc->{offset};
      my $attr     = $dsc->{attr};
      my $acs_str  = "ib";

      $addr = $ctl->{base} + $offset if defined $offset;

      $attr = 0 unless defined $attr;

      $acs_str = "rb" if ($attr & REGATTR_RBWR);
      $acs_str = "ib" if $optset =~ /i/;
      $acs_str = "rb" if $optset =~ /r/;

      my $exadethdl = $dsc->{hdl};
      if (defined $dsc->{hdl}) {
        $acs_str = "  ";
        &{$dsc->{hdl}}(1, $dsc, $data);

      } else {
        if ($acs_str eq "rb") {
          my $ibrbase = $addr & ~(077);
          my $ibroff  = $addr - $ibrbase;
          serv11_rri_wreg("wibrb", PDPCP_ADDR_IBRB, $ibrbase);
          serv11_rri_wreg("wibr",  PDPCP_ADDR_IBR + int($ibroff/2), $data);
          $acs_str = "rb";
        } else {
          serv11_rri_wreg("wal", PDPCP_ADDR_AL,  $addr);
          serv11_rri_wreg("wm",  PDPCP_ADDR_MEM, $data);
          $acs_str = "ib";
        }
        my @rval;
        my $rc = serv11_rri_exec(\@rval);
      }

    }

  }

}

#-------------------------------------------------------------------------------
# config is called once on the first entering of serv11 mode
#
sub serv11_config {
  $serv11_config_done = 1;

  foreach my $ctlname (sort keys %serv11_ctltbl) {
    my $ctl = $serv11_ctltbl{$ctlname};
    $ctl->{probemask} = "ir" unless defined $ctl->{probemask};
    &{$ctl->{probehdl}}($ctl) if exists $ctl->{probehdl};
  }

  if (not $serv11_ctltbl{CPU}->{probe_ok}) {
    print_fatal("probe of CPU failed in serv11_open()");
  }

  init_regtbl();
  serv11_cexec_shoconf();
}

#-------------------------------------------------------------------------------

sub serv11_init_dispatch {
  foreach my $ctlname (sort keys %serv11_ctltbl) {
    my $ctl = $serv11_ctltbl{$ctlname};
    &{$ctl->{inithdl}}($ctl) if (exists $ctl->{inithdl} && $ctl->{probe_ok});
  }
  $serv11_init_pending = 0;
}

#-------------------------------------------------------------------------------

sub serv11_server {
  my $old_timeout = $raw_timeout;
  my $nfound;
  my $fds_rd_act = "";
  my $fds_rd;
  my $stat_delta = 10.;
  my $stat_count = 0;

  my $fno_rcv   = fileno($fh_rcv);
  my $fno_stdin = fileno(STDIN);

  my @telfno2dsc;

  @serv11_attntbl = ();
  foreach my $ctlname (sort keys %serv11_ctltbl) {
    my $ctl = $serv11_ctltbl{$ctlname};
    if ($ctl->{probe_ok} && exists $ctl->{lam} && exists $ctl->{attnhdl}) {
      push @serv11_attntbl, [1<<($ctl->{lam}), $ctl->{attnhdl}, $ctl];
    }
  }

  $raw_timeout   = 30.;
  $serv11_active = 1;
  print "pi_rri($curmode)-I: entering server mode\n";

  my $time_stat = get_time() + $stat_delta;

  while ($serv11_active) {
    my $time_now = get_time();
    if ($time_now >= $time_stat) {
      ##serv11_server_attn_dispatch(1);
      if ($stat_count % 20 == 0) {
        printf $fh_log "stat --         ";
        printf $fh_log "  obyte oesc osop  ibyte iesc att";
        printf $fh_log "  xreg xblk  rdisk  wdisk";
        printf $fh_log "\n";
      }
      $stat_count += 1;
      my $dt = $stat_delta;

      printf $fh_log "stat -- %s", get_timestamp();
      printf $fh_log " %6.0f", ($stat_tab{obyte} - $stat_tab_last{obyte})/$dt;
      printf $fh_log " %4.0f", ($stat_tab{oesc}  - $stat_tab_last{oesc})/$dt;
      printf $fh_log " %4.0f", ($stat_tab{osop}  - $stat_tab_last{osop})/$dt;
      printf $fh_log " %6.0f", ($stat_tab{ibyte} - $stat_tab_last{ibyte})/$dt;
      printf $fh_log " %4.0f", ($stat_tab{iesc}  - $stat_tab_last{iesc})/$dt;
      printf $fh_log " %3.0f", ($stat_tab{att}   - $stat_tab_last{att})/$dt;
      printf $fh_log " %5.0f", ($stat_tab{xreg}  - $stat_tab_last{xreg})/$dt;
      printf $fh_log " %4.0f", ($stat_tab{xblk}  - $stat_tab_last{xblk})/$dt;
      printf $fh_log " %6.0f", ($stat_tab{rdisk} - $stat_tab_last{rdisk})/$dt;
      printf $fh_log " %6.0f", ($stat_tab{wdisk} - $stat_tab_last{wdisk})/$dt;
      printf $fh_log "\n";
      %stat_tab_last = %stat_tab;

      while ($time_stat < $time_now) {
        $time_stat += $stat_delta;
      }
    }

    my $timeout = $time_stat - $time_now;

    # set timeout=0 if some unfinished business is still pending

    $timeout = 0. if $serv11_attn_mask != 0; # attn mask not yet worked down
    $timeout = 0. if scalar(@serv11_icbque); # icb queue non empty
    $timeout = 0. if scalar(@que_rcv);       # still input chars in buffer

    if ($serv11_fds_update) {
      $fds_rd_act = "";
      vec($fds_rd_act, $fno_rcv, 1)   = 1;
      vec($fds_rd_act, $fno_stdin, 1) = 1;

      @telfno2dsc = ();
      foreach my $port_str (keys %telnettbl) {
        my $teldsc = $telnettbl{$port_str};
        my $fno;
        if ($teldsc->{state} == TELNET_STATE_LISTEN) {
          $fno = fileno($teldsc->{fh_port});
        } else {
          $fno = fileno($teldsc->{fh_data});
        }
        vec($fds_rd_act, $fno, 1) = 1;
        push @telfno2dsc, [$fno, $teldsc];
      }
      $serv11_fds_update = 0;
    }

    ##printf $fh_log "+++1 select $timeout, rcvq=%d\n", scalar(@que_rcv);
    $nfound = select($fds_rd=$fds_rd_act, undef, undef, $timeout);
    ##printf $fh_log "+++2 select $nfound\n";

    if (vec($fds_rd, $fno_stdin, 1)) {
      my $cmd = <STDIN>;
      if (defined $cmd) {
        chomp $cmd;

        $cmd = "lspc" unless $cmd ne "";

        $cmd =~ s{^\s*}{};                  # remove leading blanks
        $cmd =~ s{--.*}{};                  # remove comments after --
        $cmd =~ s{\s*$}{};                  # remove trailing blanks


        if ($cmd eq "quit") {
          $serv11_active = 0;
        } else {
          if ($cmd =~ m/^C/) {            # ignore, but log "C ..." lines
            print $fh_log "$cmd\n";
          } elsif ($cmd =~ m/^#/) {       # ignore "# ...." lines
          } elsif ($cmd =~ m/^;/) {       # ignore "; ...." lines
          } else {                          # otherwise execute
            serv11_cexec($cmd);
          }
        }
      } else {                      # handle ^D
        $serv11_active = 0;
      }
    }

    # process next input char if read will not block (either fd ready for
    # input, or still chars in queue).

    if (vec($fds_rd, $fno_rcv, 1) || scalar(@que_rcv)) {
      my $dat = raw_rcv9_to(0.);
      if (not defined $dat) {
        print "pi_rri($curmode)-I: spurious select on rcv channel\n";
        next;
      } elsif ($dat == D9IDLE) {
        next;
      } elsif ($dat == D9ATTN) {
        serv11_server_attn_get();
      } else {
        printf "pi_rri($curmode)-I: spurious char on server wait: %3.3x\n",
          $dat;
        next;
      }
    }

    # process telnet sessions
    foreach (@telfno2dsc) {
      my $fno = $_->[0];
      if (vec($fds_rd, $fno, 1)) {
        my $teldsc = $_->[1];
        telnet_readhdl($teldsc);
      }
    }

    if ($serv11_attn_mask != 0) {
      serv11_server_attn_dispatch(0);
    }

    if (scalar(@serv11_icbque)) {
      my $icb = shift @serv11_icbque;
      &{$icb->{rdmahdl}}($icb);
    }

    if ($serv11_attn_mask == 0 && $serv11_attn_seen) {
      $serv11_attn_seen = 0;
      serv11_server_attn_get();
    }

  }

  $raw_timeout   = $old_timeout;
  $serv11_active = 0;
  print "pi_rri($curmode)-I: leaving server mode\n";
}

#-------------------------------------------------------------------------------

sub serv11_server_attn_get {
  my @rval;
  my $rc;

  serv11_rri_attn("attn");
  $rc = serv11_rri_exec(\@rval);

  my $mask_old = $serv11_attn_mask;
  $serv11_attn_mask |= $rval[0];            # or-in new attn flags

  if (exists $opts{tserv}) {
    printf $fh_log "serv -- attn %s :", gconv_dat16($serv11_attn_mask, 2);
    foreach my $adsc (@serv11_attntbl) {
      my $msk = $adsc->[0];
      my $ctl = $adsc->[2];
      if ($serv11_attn_mask & $msk) {
        my $pref = "";
        my $suff = "";
        if ($mask_old & $msk) {             # old flags are in ()
          $pref = "(";
          $suff = ")";
        }
        printf $fh_log " %s%s%s", $pref, $ctl->{ctlname}, $suff;
      }
    }
    printf $fh_log "\n";
  }

}

#-------------------------------------------------------------------------------

sub serv11_server_attn_dispatch {
  my ($force) = @_;
  foreach my $adsc (@serv11_attntbl) {
    my $msk = $adsc->[0];
    my $hdl = $adsc->[1];
    my $ctl = $adsc->[2];
    if (($serv11_attn_mask & $msk) || $force) {
      $serv11_attn_mask &= ~$msk;
      &{$hdl}($ctl,$force);
    }
  }
}

#-------------------------------------------------------------------------------

sub serv11_probe_gen {                      # generic probe handler
  my ($ctl) = @_;
  my $mask = $ctl->{probemask};
  my $addr = $ctl->{base};
  $addr += $ctl->{csroff} if defined $ctl->{csroff};
  my ($ival,$rval) = serv11_exec_probe($addr, $mask);
  $ctl->{probe_ival} = $ival;
  $ctl->{probe_rval} = $rval;
  $ctl->{probe_ok} = 1;
  $ctl->{probe_ok} = 0 if ($mask =~ /i/ && ! defined $ival);
  $ctl->{probe_ok} = 0 if ($mask =~ /r/ && ! defined $rval);
}

#-------------------------------------------------------------------------------

sub serv11_init_gen {                       # generic controller init handler
  my ($ctl) = @_;

  if (exists $ctl->{usethdl}) {
    foreach my $unitname (@{$ctl->{units}}) {
      my $ucb = $serv11_unittbl{$unitname};
      &{$ctl->{usethdl}}($ucb);
    }
  } else {
    printf "pi_rri($curmode)-E: usethdl not defined for %s\n", $ctl->{ctlname};
  }
}

#-------------------------------------------------------------------------------

sub serv11_detach_gen {                     # generic detach handler
  my ($ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if ($ucb->{att_ok}) {
    my $fh = $ucb->{att_fh};
    $fh->close() or die "Unexpected close error";
    $ucb->{att_ok}   = 0;
    delete $ucb->{att_file};
    delete $ucb->{att_nbyt};
    delete $ucb->{att_nblk};
    delete $ucb->{att_wpro};
    delete $ucb->{att_fh};
    delete $ucb->{att_eof};
    &{$ctl->{usethdl}}($ucb);               # setup unit registers

  } else {
    printf "pi_rri($curmode)-E: no file attached for %s\n", $ucb->{unitname};
  }
}

#-------------------------------------------------------------------------------

sub serv11_attdet_disk {                    # generic disk att/det handler
  my ($det,$ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if ($det) {                               # detach handling
    serv11_detach_gen($ucb);

  } else {                                  # attach handling
    if (cget_opt("-w")) {                     # -w remount
      return if $cmd_bad or cget_chkblank();
      my $fh = $ucb->{att_fh};
      if ($fh) {                              # mounted and open ?
        if (-w $fh) {                         # file writable ?
          $ucb->{att_wpro} = 0;                 # remove write protect
          &{$ctl->{usethdl}}($ucb);             # setup unit registers
        } else {
          printf "pi_rri($curmode)-E: file %s (for %s) is write protected\n",
            $ucb->{att_file}, $ucb->{unitname};
          return;
        }
      } else {
        printf "pi_rri($curmode)-E: no file attached for %s\n",
          $ucb->{unitname};
        return;
      }

    } else {                                  # normal (non -w) handling
      my $opt_r = cget_opt("-r");
      my $filename = cget_file();
      return if $cmd_bad or cget_chkblank();

      if (not -e $filename) {
        print "pi_rri($curmode)-E: file $filename not found\n";
        return;
      }
      if (not -r $filename) {
        print "pi_rri($curmode)-E: file $filename is not readable\n";
        return;
      }

      my $wpro = $opt_r;
      if (! $wpro && ! -w $filename) {
        print "pi_rri($curmode)-I: file $filename is write protected\n";
        $wpro = 1;
      }

      my $filesize = -s $filename;

      if (defined $ctl->{volsize}) {
        if ($filesize < $ctl->{volsize}) {
          printf "pi_rri($curmode)-W: dsk file too small, %s requires %d".
            " file $filename has %d bytes\n",
              $ucb->{unitname}, $ctl->{volsize}, $filesize;
        }
      }

      my $fh = new FileHandle;
      sysopen ($fh, $filename, $wpro ? O_RDONLY : O_RDWR)
        or die "Unexpected sysopen error";

      $ucb->{att_ok}   = 1;
      $ucb->{att_file} = $filename;
      $ucb->{att_nbyt} = $filesize;
      $ucb->{att_wpro} = $wpro;
      $ucb->{att_fh}   = $fh;

      $ucb->{att_nblk} = int ($ucb->{att_nbyt}/512);
      if ($ucb->{att_nbyt}%512 != 0) {
        print "pi_rri($curmode)-I: size $filename not multiple of 512\n";
      }
      &{$ctl->{usethdl}}($ucb);             # setup unit registers
    }
  }
}

#-------------------------------------------------------------------------------

sub serv11_attdet_ronly {                   # generic in  only att/det handler
  my ($det,$ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if ($det) {                               # detach handling
    serv11_detach_gen($ucb);

  } else {                                  # attach handling
    my $filename = cget_file();
    return if $cmd_bad or cget_chkblank();

    if (not -e $filename) {
      print "pi_rri($curmode)-E: file $filename not found\n";
      return;
    }
    if (not -r $filename) {
      print "pi_rri($curmode)-E: file $filename is not readable\n";
      return;
    }

    my $fh = new FileHandle;
    my $rc = $fh->open("<$filename");
    if (not $rc) {
      print "pi_rri($curmode)-E: failed to open file $filename\n";
      return;
    }

    $ucb->{att_ok}   = 1;
    $ucb->{att_file} = $filename;
    $ucb->{att_fh}   = $fh;
    delete $ucb->{att_eof};

    &{$ctl->{usethdl}}($ucb);               # setup unit registers
  }
}

#-------------------------------------------------------------------------------

sub serv11_attdet_wonly {                   # generic out only att/det handler
  my ($det,$ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if ($det) {                               # detach handling
    serv11_detach_gen($ucb);

  } else {                                  # attach handling
    my $filename = cget_file();
    return if $cmd_bad or cget_chkblank();

    if (not -e $filename) {
      print STDERR "pi_rri($curmode)-I: file $filename will be created\n";
    } elsif (not -w $filename) {
      print STDERR "pi_rri($curmode)-E: file $filename is not writeable\n";
      return;
    }

    my $fh = new FileHandle;
    my $rc = $fh->open(">$filename");
    if (not $rc) {
      print STDERR "pi_rri($curmode)-E: failed to open file $filename\n";
      return;
    }

    autoflush $fh;

    $ucb->{att_ok}   = 1;
    $ucb->{att_file} = $filename;
    $ucb->{att_fh}   = $fh;
    delete $ucb->{att_eof};

    &{$ctl->{usethdl}}($ucb);               # setup unit registers
  }
}

#-------------------------------------------------------------------------------

sub serv11_attdet_term {                    # generic term att/det handler
  my ($det,$ucb) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if ($det) {                               # detach handling
    my $port_str = $ucb->{att_port};
    my $teldsc = $telnettbl{$port_str};
    close $teldsc->{fh_data} if defined $teldsc->{fh_data};
    close $teldsc->{fh_port} if defined $teldsc->{fh_port};
    delete $telnettbl{$port_str};
    delete $ucb->{att_port};
    $ucb->{att_ok} = 0;
    $serv11_fds_update = 1;                 # request update of select mask

  } else {                                  # attach handling
    my $port = cget_gdat(16, 10);
    return if $cmd_bad or cget_chkblank();
    my $port_str = sprintf("%6.6d", $port);
    if (exists $telnettbl{$port_str}) {
      printf STDERR "pi_rri($curmode)-E: port %d already attached\n", $port;
      return;
    }
    my $fh_port = new FileHandle;
    my $proto = getprotobyname('tcp');
    if (not socket($fh_port, PF_INET, SOCK_STREAM, $proto)) {
      printf STDERR "pi_rri($curmode)-E: error in socket(): $!\n";
      return;
    }
    if (not setsockopt($fh_port, SOL_SOCKET, SO_REUSEADDR, 1)) {
      printf STDERR "pi_rri($curmode)-E: error in setsocketopt(): $!\n";
      return;
    }

    my $host = pack('C4', 0,0,0,0);
    my $addr = pack('S n a4 x8', 2, $port, $host);
    if (not bind($fh_port, $addr)) {
      printf STDERR "pi_rri($curmode)-E: error in bind(): $!\n";
      return;
    }

    if (not listen($fh_port, 1)) {
      printf STDERR "pi_rri($curmode)-E: error in listen(): $!\n";
      return;
    }

    $telnettbl{$port_str} = {};
    $telnettbl{$port_str}->{port}    = $port;
    $telnettbl{$port_str}->{state}   = TELNET_STATE_LISTEN;
    $telnettbl{$port_str}->{fh_port} = $fh_port;
    $telnettbl{$port_str}->{ucb}     = $ucb;

    $ucb->{att_ok}   = 1;
    $ucb->{att_port} = $port_str;

    $serv11_fds_update = 1;                 # request update of select mask

  }

}

#-------------------------------------------------------------------------------

sub serv11_probe_cpu {                      # cpu: probe handler
  my ($ctl) = @_;

  serv11_probe_gen($ctl);
  return unless $ctl->{probe_ok};

  my $reglist = $ctl->{reglist};
  my $partbl  = $ctl->{partbl};
  my $text    = "";

  my $exadep = \&serv11_exadep_cpu;

  push @{$reglist}, {name => "r0",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "r1",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "r2",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "r3",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "r4",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "r5",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "sp",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "pc",  hdl => \&serv11_exadep_cpu};
  push @{$reglist}, {name => "psw", hdl => \&serv11_exadep_cpu};

  push @{$reglist}, {name => "stklim", addr => CPU_STKLIM};
  push @{$reglist}, {name => "pirq"  , addr => CPU_PIRQ};
  push @{$reglist}, {name => "mbrk"  , addr => CPU_MBRK};
  push @{$reglist}, {name => "cpuerr", addr => CPU_CPUERR};
  push @{$reglist}, {name => "hisize", addr => CPU_HISIZE};
  push @{$reglist}, {name => "losize", addr => CPU_LOSIZE};

  my ($ival,$rval) = serv11_exec_probe(CPU_SDREG, "ir");
  if (defined $ival && defined $rval) {
    push @{$reglist}, {name => "sr", addr => CPU_SDREG, attr => REGATTR_RBWR};
    push @{$reglist}, {name => "dr", addr => CPU_SDREG, attr => REGATTR_RBRD};
  }

  push @{$reglist}, {name => "mmr0"  , addr => CPU_MMR0};
  push @{$reglist}, {name => "mmr1"  , addr => CPU_MMR1};
  push @{$reglist}, {name => "mmr2"  , addr => CPU_MMR2};
  push @{$reglist}, {name => "mmr3"  , addr => CPU_MMR3};

  my @rval;
  serv11_rri_wreg("wal", PDPCP_ADDR_AL, CPU_LOSIZE); # i/o page in 16 bit mode
  serv11_rri_rreg("rm",  PDPCP_ADDR_MEM);
  my $rc = serv11_rri_exec(\@rval);
  my $memsize = ($rval[0]+1)<<6;            # memsize in bytes
  $ctl->{memsize} = $memsize;

  $text .= ($text)?";":"" . sprintf("mem=%dkb",$memsize/1024.);

  $ctl->{probe_text} = $text;

}

#-------------------------------------------------------------------------------

sub serv11_attn_cpu {                       # cpu: attention handler
  my ($ctl,$force) = @_;
  return if $force;
  print "CPU halted\n";
  $serv11_active = 0;
  serv11_cexec_shoreg(1);
}

#-------------------------------------------------------------------------------

sub serv11_exadep_cpu {                     # cpu: exa/dep handler
  my ($dep,$dsc,$val) = @_;
  my $name = $dsc->{name};
  my $rrireg;

  $name =~ s/^sp$/r6/;
  $name =~ s/^pc$/r7/;

  if ($dep) {
    if ($name =~ /^r([0-7])$/) {
      $rrireg = PDPCP_ADDR_R0 + int $1;
    } elsif ($name eq "psw") {
      $rrireg = PDPCP_ADDR_PSW;
    } else {
      print_fatal("serv11_exadep_cpu() called with bad name '$name'");
    }
    my @rval;
    serv11_rri_wreg("r$name", $rrireg, $val);
    my $rc = serv11_rri_exec(\@rval);
    return;

  } else {
    if ($name =~ /^r([0-7])$/) {
      $rrireg = PDPCP_ADDR_R0 + int $1;
    } elsif ($name eq "psw") {
      $rrireg = PDPCP_ADDR_PSW;
    } else {
      print_fatal("serv11_exadep_cpu() called with bad name '$name'");
    }
    my @rval;
    serv11_rri_rreg("r$name", $rrireg);
    my $rc = serv11_rri_exec(\@rval);
    return $rval[0];
  }

}

#-------------------------------------------------------------------------------

sub serv11_ichr_dl11 {
  my ($ucb,$dref) = @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
  my @rval;
  my $rc;

  my $que_old = scalar( @{$ucb->{rcvque}} );
  push @{$ucb->{rcvque}}, @$dref;
  my $que_new = scalar( @{$ucb->{rcvque}} );

  if ($que_old == 0 && $que_new > 0) {
    serv11_rri_ibrb($ctl);
    serv11_rri_ribr("RCSR", $ctl, DL11_RCSR);
    $rc = serv11_rri_exec(\@rval);
    if (($rval[0] & DL11_RCSR_M_RDONE) == 0) { # RBUF not full
      my $data = shift @{$ucb->{rcvque}};
      serv11_rri_wibr("RBUF", $ctl, DL11_RBUF, $data & 0377);
      $rc = serv11_rri_exec(\@rval);
    }
  }
}

#-------------------------------------------------------------------------------

sub serv11_attn_dl11 {
  my ($ctl,$force) = @_;
  my $ucb = $serv11_unittbl{$ctl->{units}[0]};
  my @rval;
  my $rc;
  my $nxbuf = $ctl->{nxbuf_min};
  my $nxbuf_val = 0;

  $nxbuf = $ctl->{nxbuf} if defined $ctl->{nxbuf};

  serv11_rri_ibrb($ctl);
  for (my $i=0; $i<$nxbuf; $i++) {
    serv11_rri_ribr("XBUF", $ctl, DL11_XBUF);
  }

  # select(undef, undef, undef, 5.0);             # ! hack
  # printf $fh_log "HACK -- wait on DL11 attn\n"; # ! hack

  $rc = serv11_rri_exec(\@rval);

  my $rrdy;
  for (my $i=0; $i<$nxbuf; $i++) {
    my $ochr = $rval[$i] & DL11_XBUF_M_XBUF;
    my $xval = $rval[$i] & DL11_XBUF_M_XVAL;
       $rrdy = $rval[$i] & DL11_XBUF_M_RRDY;
       $ochr = $ochr & 0177 if $ucb->{rcv7bit};   # drop parity bit
    my $chr  = chr($ochr);
    my $str  = ($ochr>=040 && $ochr<0177) ? "$chr" : sprintf "\\%3.3o",$ochr;
    if (exists $opts{tserv} && $ctl->{trace} &&
        ($xval || not $force)) {
        printf $fh_log
            "serv -- DL11.%s xbuf=%6.6o xval=%s rrdy=%s rcvq=%3d sndq=%3d",
            $ctl->{ctlname}, $rval[$i],
            ($xval ? "y" : "n"), ($rrdy ? "y" : "n"),
            scalar( @{$ucb->{rcvque}} ), scalar( @{$ucb->{sndque}} );
        printf $fh_log " char=\"%s\"", $str if $xval;
        print $fh_log "\n";
    }

    if ($xval) {
      $nxbuf_val += 1;
      my $sndqueref = $ucb->{sndque};
      my $ochr_last = 0;
      $ochr_last = $$sndqueref[-1] if scalar(@$sndqueref) > 0;

      push @{$ucb->{sndque}}, $ochr;

      if ($ucb->{att_ok}) {
        telnet_writehdl($ucb);
      } else {
        if ($ctl->{ctlname} eq "TTA") {     # for console
          while (scalar( @{$ucb->{sndque}} )) {
            my $byte = shift @{$ucb->{sndque}};
            my $str  = "";
            if ($byte>=040 && $byte<0177) {
              $str = chr($byte);
            } elsif ($byte==011) {
              $str = "\t";
            } elsif ($byte==012) {
              $str = "\n";
            } elsif ($byte==015) {
              $str = "\r";
            } else {
              $str = sprintf "<%3.3o>", $byte if $byte!=000;
            }
            print $str;
          }
        }

        if ($ucb->{logfile}) {
          my $fh = $ucb->{logfh};
          if (not defined $ucb->{logfh}) {
            my $logfile = $ucb->{logfile};
            my $rc;
            $fh = $ucb->{logfh} = new FileHandle;
            $rc = $ucb->{logfh}->open(">$logfile");
            if (not $rc) {
              printf STDERR "pi_rri-E: failed to open $logfile for write\n";
              $fh = undef;
            } else {
              autoflush $fh;
            }
          }
          print $fh $str if $fh;
        }
      }

#    if ($ochr_last == 015 && $ochr == 012) {
#      while (scalar( @{$ucb->{sndque}} )) {
#       my $byte = shift @{$ucb->{sndque}};
#       my $chr  = chr($byte);
#       if ($byte>=040 && $byte <=177) {
#         print $chr
#       } else {
#         if ($byte != 000 && $byte != 012 && $byte != 015) {
#           printf "<%3.3o>", $byte
#         }
#       }
#      }
#      print "\n";
#    }
    }
  }

  if ($rrdy && scalar( @{$ucb->{rcvque}} ) ) {
    my $data = shift @{$ucb->{rcvque}};
    serv11_rri_wibr("RBUF", $ctl, DL11_RBUF, $data & 0377);
    $rc = serv11_rri_exec(\@rval);
  }

  $ctl->{nxbuf} = next_nxbuf($ctl, $nxbuf, $nxbuf_val);
}

#-------------------------------------------------------------------------------

sub serv11_uset_lp11 {
  my ($ucb) = @_;
  my @rval;

  my $lpcs = ($ucb->{att_ok}) ? 0 : LP11_CSR_M_ERR;

  serv11_rri_uset($ucb, "LPCS", LP11_CSR, $lpcs);

  my $rc = serv11_rri_exec(\@rval);
}

#-------------------------------------------------------------------------------

sub serv11_attn_lp11 {
  my ($ctl,$force) = @_;
  my $ucb = $serv11_unittbl{$ctl->{units}[0]};
  my @rval;
  my $rc;
  my $nxbuf = $ctl->{nxbuf_min};
  my $nxbuf_val = 0;

  $nxbuf = $ctl->{nxbuf} if defined $ctl->{nxbuf};

  serv11_rri_ibrb($ctl);
  for (my $i=0; $i<$nxbuf; $i++) {
    serv11_rri_ribr("LPBU", $ctl, LP11_BUF);
  }

  $rc = serv11_rri_exec(\@rval);

  for (my $i=0; $i<$nxbuf; $i++) {
    my $ochr = $rval[$i] & LP11_BUF_M_BUF;
    my $oval = $rval[$i] & LP11_BUF_M_VAL;
    my $chr  = chr($ochr);
    my $str  = "$chr";
    if (exists $opts{tserv} && $ctl->{trace} &&
        ($oval || not $force)) {
      printf $fh_log
            "serv -- LP11  buf=%6.6o  val=%s ",
            $rval[$i], ($oval ? "y" : "n");
      printf $fh_log " char=\"%s\"", $str if $oval;
      print $fh_log "\n";
    }

    if ($oval) {
      $nxbuf_val += 1;
      my $fh = $ucb->{att_fh};
      if ($fh) {
        print $fh $str;
      } else {
        printf STDERR "pi_rri($curmode)-E: spurious output '%s' for %s\n",
          $str, $ucb->{unitname};
      }
    }
  }

  $ctl->{nxbuf} = next_nxbuf($ctl, $nxbuf, $nxbuf_val);
}

#-------------------------------------------------------------------------------

sub serv11_uset_pc11 {
  my ($ucb) = @_;
  my @rval;
  my $text;
  my $addr;
  my $data;

  if ($ucb->{unitname} eq "PTR") {          # if reader
    $text = "PRCS";
    $addr = PC11_RCSR;
    $data = ($ucb->{att_ok}) ? 0 : PC11_RCSR_M_ERR;
  } else {                                  # if puncher
    $text = "PPCS";
    $addr = PC11_PCSR;
    $data = ($ucb->{att_ok}) ? 0 : PC11_PCSR_M_ERR;
  }

  serv11_rri_uset($ucb, $text, $addr, $data);

  my $rc = serv11_rri_exec(\@rval);
}

#-------------------------------------------------------------------------------

sub serv11_attdet_pc11 {                    # pc11 att/det handler
  my ($det,$ucb) = @_;

  if ($ucb->{unitname} eq "PTR") {          # if reader
    serv11_attdet_ronly($det, $ucb);        # use read-only file
  } else {                                  # if puncher
    serv11_attdet_wonly($det, $ucb);        # use write-only file
  }

}

#-------------------------------------------------------------------------------

sub serv11_attn_pc11 {
  my ($ctl,$force) = @_;

  my $ucb_ptr = $serv11_unittbl{$ctl->{units}[0]};
  my $ucb_ptp = $serv11_unittbl{$ctl->{units}[1]};
  my @rval;
  my $rc;
  my $nxbuf = $ctl->{nxbuf_min};
  my $nxbuf_val = 0;

  $nxbuf = $ctl->{nxbuf} if defined $ctl->{nxbuf};

  serv11_rri_ibrb($ctl);
  for (my $i=0; $i<$nxbuf; $i++) {
    serv11_rri_ribr("PPBUF", $ctl, PC11_PBUF);
  }

  $rc = serv11_rri_exec(\@rval);

  my $rrdy;
  for (my $i=0; $i<$nxbuf; $i++) {
    my $ochr = $rval[$i] & PC11_PBUF_M_PBUF;
    my $pval = $rval[$i] & PC11_PBUF_M_PVAL;
       $rrdy = $rval[$i] & PC11_PBUF_M_RBUSY;

    if (exists $opts{tserv} && $ctl->{trace} &&
        ($pval || not $force)) {
        printf $fh_log
            "serv -- PC11 pbuf=%6.6o pval=%s rrdy=%s \n",
            $rval[$i], ($pval ? "y" : "n"), ($rrdy ? "y" : "n");
    }

    if ($pval) {
      $nxbuf_val += 1;
      my $fh = $ucb_ptp->{att_fh};
      if ($fh) {
        print $fh chr($ochr);
      } else {
        printf STDERR "pi_rri($curmode)-E: spurious output '%3.3o' for %s\n",
          $ochr, $ucb_ptp->{unitname};
      }
    }
  }

  if ($rrdy) {
    my $fh = $ucb_ptr->{att_fh};
    if ($fh && (not $ucb_ptr->{att_eof}) ) {
      my $char = getc($fh);
      if (defined $char) {
        serv11_rri_wibr("PRBUF", $ctl, PC11_RBUF, ord($char) & 0377);
        $rc = serv11_rri_exec(\@rval);
      } else {
        serv11_rri_uset($ucb_ptr, "PRCS", PC11_RCSR, PC11_RCSR_M_ERR);
        $rc = serv11_rri_exec(\@rval);
        $ucb_ptr->{att_eof} = 1;
      }
    } else {
      printf STDERR "pi_rri($curmode)-E: spurious reader busy for %s\n",
        $ucb_ptr->{unitname};
    }
  }

  $ctl->{nxbuf} = next_nxbuf($ctl, $nxbuf, $nxbuf_val);

}

#-------------------------------------------------------------------------------

sub serv11_uset_rk11 {
  my ($ucb) = @_;
  my @rval;

  my $rkds = 0;

  $rkds = $ucb->{ctlunit}<<(RKDS_V_ID);
  if ($ucb->{att_ok}) {         # drive available
    $rkds |= RKDS_M_HDEN;             # always high density
    $rkds |= RKDS_M_SOK;              # always sector counter OK ?FIXME?
    $rkds |= RKDS_M_DRY;              # drive available
    $rkds |= RKDS_M_ADRY;             # access available
    $rkds |= RKDS_M_WPS if $ucb->{att_wpro}; # in case write protected
  }
  $ucb->{rkds} = $rkds;

  serv11_rri_uset($ucb, "RKDS", RK11_RKDS, $rkds);
  my $rc = serv11_rri_exec(\@rval);
}

#-------------------------------------------------------------------------------
# geometry: c=203;h=2;s=12 ==> 4872 blocks ==> 2 494 464 bytes
#
# several error conditions are only approximately handled:
#   OVR: when detected, no transfer done (should trim size)

sub serv11_attn_rk11 {
  my ($ctl,$force) = @_;
  my @rval;
  my $blksize = $ctl->{blksize};

  serv11_rri_ibrb($ctl);
  serv11_rri_ribr("RKWC", $ctl, RK11_RKWC);
  serv11_rri_ribr("RKBA", $ctl, RK11_RKBA);
  serv11_rri_ribr("RKDA", $ctl, RK11_RKDA);
  serv11_rri_ribr("RKMR", $ctl, RK11_RKMR);   # read to monitor CRDONE
  serv11_rri_ribr("RKCS", $ctl, RK11_RKCS);

  my $rc = serv11_rri_exec(\@rval);

  my $rkwc = $rval[0];
  my $rkba = $rval[1];
  my $rkda = $rval[2];
  my $rkmr = $rval[3];
  my $rkcs = $rval[4];

  my $se  =  $rkda                & RKDA_B_SC;
  my $hd  = ($rkda>>RKDA_V_SUR  ) & RKDA_B_SUR;
  my $cy  = ($rkda>>RKDA_V_CYL  ) & RKDA_B_CYL;
  my $dr  = ($rkda>>RKDA_V_DRSEL) & RKDA_B_DRSEL;

  my $go  = ($rkcs & RKCS_M_GO)  != 0;
  my $fu  = ($rkcs>>RKCS_V_FUNC) & RKCS_B_FUNC;
  my $mex = ($rkcs>>RKCS_V_MEX ) & RKCS_B_MEX;

  my $nwrd = ((~$rkwc) & 0xffff) + 1;          # transfer size in words
  my $nbyt = 2*$nwrd;                          # transfer size in bytes
  my $nblk = int (($nbyt+$blksize-1)/$blksize);# transfer size in blocks

  my $addr = $mex<<16 | $rkba;                 # 18 bit memory address
  my $lbn  = $se + RK11_NUMSE*$hd + RK11_NUMSE*RK11_NUMHD*$cy;

  my $ucb  = $serv11_unittbl{$ctl->{units}[$dr]};

  my $rkds = $ucb->{rkds};
  if (not defined $rkds) {
    printf $fh_log
      "serv -- RK11 ERROR: no rri device init, assume ds=0 for drive %d\n", $dr;
    $rkds = $ucb->{rkds} = $rkds = 0;
  }

  if ($go == 0) {                       # quit here if no go bit set
    if (exists $opts{tserv} && $ctl->{trace}) {
      if (not $force) {
        printf $fh_log "serv -- RK11 cs=%6.6o  go=0, spurious attn\n", $rkcs;
      }
    }
    return;
  }

  my $rker = 0;
  my $msg  = "";

  if ($fu != RKCS_CRESET &&                 # function not control reset
      (not $ucb->{att_ok})) {               # and drive not attached
    $rker = RKER_M_NXD;                     # --> abort with NXD error
    serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
    if ($fu == RKCS_SEEK || $fu == RKCS_DRESET) {
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_SBCLR) | 1<<($dr));
    }
    serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
    serv11_attn_rk11_logerr($ctl, $rker);

  } elsif ($fu != RKCS_WRITE &&             # function neither read
           $fu != RKCS_READ &&              # nor write
            ($rkcs & RKCS_M_FMT)) {         # and FMT set
    $rker = RKER_M_PGE;                     # --> abort with PGE error
    serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
    if ($fu == RKCS_SEEK || $fu == RKCS_DRESET) {
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_SBCLR) | 1<<($dr));
    }
    serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
    serv11_attn_rk11_logerr($ctl, $rker);

  } else {

    if ($fu == RKCS_CRESET) {           # Control reset -------------------
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_CRESET));

    } elsif ($fu == RKCS_WRITE) {       # Write ---------------------------
                                        #   Note: WRITE+FMT is just like WRITE
      $rker |= RKER_M_NXS if $se >= RK11_NUMSE;
      $rker |= RKER_M_NXC if $cy >= RK11_NUMCY;
      $rker |= RKER_M_WLO if $ucb->{att_wpro};
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_IBA;  # not yet supported ! FIXME !
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_RWA;  # will never be supported
      if ($rker) {
        serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        serv11_attn_rk11_logerr($ctl, $rker);
      } else {
        my $icb = {rdmahdl => \&serv11_rdma_rk11,
                   func    => "write",
                   ctl     => $ctl,
                   ucb     => $ucb,
                   lbn     => $lbn,
                   nblk    => $nblk,
                   nwrd    => $nwrd,
                   addr    => $addr,
                   nwdone  => 0,
                   rkcs    => $rkcs,        # later needed for MEX update
                   rkda    => $rkda         # later needed in RKDA update
                  };
        push @serv11_icbque, $icb;
      }

    } elsif ($fu == RKCS_READ) {        # Read ----------------------------
      $rker |= RKER_M_NXS if ($se >= RK11_NUMSE);
      $rker |= RKER_M_NXC if ($cy >= RK11_NUMCY);
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_IBA;  # not yet supported ! FIXME !
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_RWA;  # will never be supported
      if ($rker) {
        serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        serv11_attn_rk11_logerr($ctl, $rker);
      } else {

        if ($rkcs & RKCS_M_FMT) {
          my $icb = {rdmahdl => \&serv11_rdma_rk11,
                     func    => "rdfmt",
                     ctl     => $ctl,
                     ucb     => $ucb,
                     lbn     => $lbn,
                     nblk    => $nwrd,      # #blocks == #words for RD FMT !!
                     nwrd    => $nwrd,
                     addr    => $addr,
                     nwdone  => 0,
                     rkcs    => $rkcs,      # later needed for MEX update
                     rkda    => $rkda       # later needed in RKDA update
                    };
          push @serv11_icbque, $icb;
        } else {
          my $icb = {rdmahdl => \&serv11_rdma_rk11,
                     func    => "read",
                     ctl     => $ctl,
                     ucb     => $ucb,
                     lbn     => $lbn,
                     nblk    => $nblk,
                     nwrd    => $nwrd,
                     addr    => $addr,
                     nwdone  => 0,
                     rkcs    => $rkcs,      # later needed for MEX update
                     rkda    => $rkda       # later needed in RKDA update
                    };
          push @serv11_icbque, $icb;
        }
      }

    } elsif ($fu == RKCS_WCHK) {        # Write Check ---------------------
      $rker |= RKER_M_NXS if $se >= RK11_NUMSE;
      $rker |= RKER_M_NXC if $cy >= RK11_NUMCY;
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_IBA;  # not yet supported ! FIXME !
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_RWA;  # will never be supported
      if ($rker) {
        serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        serv11_attn_rk11_logerr($ctl, $rker);
      } else {
        my $icb = {rdmahdl => \&serv11_rdma_rk11,
                   func    => "wrcheck",
                   ctl     => $ctl,
                   ucb     => $ucb,
                   lbn     => $lbn,
                   nblk    => $nblk,
                   nwrd    => $nwrd,
                   addr    => $addr,
                   nwdone  => 0,
                   rkcs    => $rkcs,        # later needed for MEX update
                   rkda    => $rkda         # later needed in RKDA update
                  };
        push @serv11_icbque, $icb;
      }

    } elsif ($fu == RKCS_SEEK) {        # Seek ----------------------------
      $rker |= RKER_M_NXS if ($se >= RK11_NUMSE);
      $rker |= RKER_M_NXC if ($cy >= RK11_NUMCY);
      if ($rker) {
        serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_SBCLR) | 1<<($dr));
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        serv11_attn_rk11_logerr($ctl, $rker);
      } else {
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        $rkds &= ~(RKDS_B_SC);            # replace current sector number
        $rkds |= $se;
        $ucb->{rkds} = $rkds;
        serv11_rri_wibr("RKDS", $ctl, RK11_RKDS, $rkds);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<($dr)); # issue seek done
      }

    } elsif ($fu == RKCS_RCHK) {        # Read Check ----------------------
      $rker |= RKER_M_NXS if $se >= RK11_NUMSE;
      $rker |= RKER_M_NXC if $cy >= RK11_NUMCY;
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_IBA;  # not yet supported ! FIXME !
      $rker |= RKER_M_DRE if $rkcs & RKCS_M_RWA;  # will never be supported
      if ($rker) {
        serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker);
        serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
        serv11_attn_rk11_logerr($ctl, $rker);
      } else {
        my $icb = {rdmahdl => \&serv11_rdma_rk11,
                   func    => "rdcheck",
                   ctl     => $ctl,
                   ucb     => $ucb,
                   lbn     => $lbn,
                   nblk    => $nblk,
                   nwrd    => $nwrd,
                   addr    => $addr,
                   nwdone  => 0,
                   rkcs    => $rkcs,        # later needed for MEX update
                   rkda    => $rkda         # later needed in RKDA update
                  };
        push @serv11_icbque, $icb;
      }

    } elsif ($fu == RKCS_DRESET) {      # Drive Reset ---------------------
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<($dr)); # issue seek done

    } elsif ($fu == RKCS_WLOCK) {       # Write Lock ----------------------
      $ucb->{rkds} |= RKDS_M_WPS;         # set RKDS write protect flag
      $ucb->{att_wpro} = 1;               # set UCB  write protect flag
      serv11_rri_wibr("RKDS", $ctl, RK11_RKDS, $ucb->{rkds});
      serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
    }

  }

  if (exists $opts{tserv} && $ctl->{trace}) {
    printf $fh_log "serv -- RK11 cs=%6.6o da=%6.6o wc=%6.6o",
      $rkcs, $rkda, $rkwc;
    printf $fh_log " ad=%6.6o", $addr;
    printf $fh_log " fu=%d dchs=%d,%3d,%d,%2d", $fu, $dr, $cy, $hd, $se;
    printf $fh_log " lbn=%4d nw,nb=%5d,%2d", $lbn, $nwrd, $nblk;
    print  $fh_log "\n";
  }

  $rc = serv11_rri_exec(\@rval);

}

#-------------------------------------------------------------------------------

sub serv11_attn_rk11_logerr {
  my ($ctl,$rker) = @_;
  if (exists $opts{tserv}) {
    printf $fh_log "serv -- RK11 er=%6.6o  ERROR ABORT\n", $rker;
  }
}

#-------------------------------------------------------------------------------

sub serv11_rdma_rk11 {
  my ($icb) = @_;
  my $ctl  = $icb->{ctl};
  my $ucb  = $icb->{ucb};
  my $addr = $icb->{addr};
  my $blksize = $ctl->{blksize};
  my @rval;
  my $rc   = 1;                 # default ok, make code below shorter FIXME
  my $rker = 0;

#  printf "+++x1 func=%5s addr=%6.6o nblk=%2d nwdone=%3d\n",
#    $icb->{func}, $addr, $icb->{nblk}, $icb->{nwdone};

  if ($icb->{func} eq "read") {             # --- read function --------------
    if ($icb->{nwdone} == 0) {          # new block ?
      $rker |= RKER_M_OVR if $icb->{lbn} >= RK11_NUMBL;
      $rc = serv11_icb_disk_read($icb) if not $rker;
      $rker |= RKER_M_CSE if not $rc;   # forward disk I/O error
    }

    if (not $rker) {
      my $nwdma = int($blksize/2) - $icb->{nwdone};
      $nwdma = $icb->{nwrd}       if $nwdma > $icb->{nwrd};
      $nwdma = $serv11_rdma_chunk if $nwdma > $serv11_rdma_chunk;
      my $beg = $icb->{nwdone};
      my $end = $beg + $nwdma - 1;
      my $buf = $icb->{buf};

      serv11_rri_lalh($icb->{addr}, 3);
      serv11_rri_wblk($nwdma, [ @$buf[$beg..$end] ]);
      $rc = serv11_rri_exec(\@rval);    # FIXME: handle dma I/O error
      $stat_tab{rdisk} += 2*$nwdma;

      $icb->{nwdone} += $nwdma;
      $icb->{nwrd}   -= $nwdma;
      $icb->{addr}   += 2*$nwdma;

      if ((not $rker) &&                         # no error and
          ($icb->{nwdone} == int($blksize/2) ||  #   block done or
          $icb->{nwrd} == 0) ) {                 #   all done
        $icb->{nwdone} = 0;
        $icb->{lbn}   += 1;
        $icb->{nblk}  -= 1;
      }
    }

    if ((not $rker) && $icb->{nwrd}) {  # if no error found and not done yet
      push @serv11_icbque, $icb;        # requeue
      return;
    }

  } elsif ($icb->{func} eq "rdfmt") {       # --- read format function -------
    $rker |= RKER_M_OVR if $icb->{lbn} >= RK11_NUMBL;

    if (not $rker) {
      my $cy  = $icb->{lbn}/(RK11_NUMHD*RK11_NUMSE);
      my $da  = $cy<<(RKDA_V_CYL);
      my @buf = ($da);

      serv11_rri_lalh($icb->{addr}, 3);
      serv11_rri_wblk(1, [ @buf ]);
      $rc = serv11_rri_exec(\@rval);    # FIXME: handle dma I/O error
      $stat_tab{rdisk} += 2;

      $icb->{nwrd}  -= 1;
      $icb->{addr}  += 2;
      $icb->{lbn}   += 1;
      $icb->{nblk}  -= 1;
    }

    if ((not $rker) && $icb->{nwrd}) {  # if no error found and not done yet
      push @serv11_icbque, $icb;        # requeue
      return;
    }

  } elsif ($icb->{func} eq "write") {       # --- write function -------------
    $icb->{buf} = [] if $icb->{nwdone} == 0;
    my $nwdma = int($blksize/2) - $icb->{nwdone};
    $nwdma = $icb->{nwrd}       if $nwdma > $icb->{nwrd};
    $nwdma = $serv11_rdma_chunk if $nwdma > $serv11_rdma_chunk;

    serv11_rri_lalh($icb->{addr}, 3);
    serv11_rri_rblk($nwdma);
    $rc = serv11_rri_exec(\@rval);     # FIXME: handle dma I/O error
    $stat_tab{wdisk} += 2*$nwdma;

    $icb->{nwdone} += $nwdma;
    $icb->{nwrd}   -= $nwdma;
    $icb->{addr}   += 2*$nwdma;

    push @{$icb->{buf}}, @{$rval[0]};

    if ((not $rker) &&                            # no error and
          ($icb->{nwdone} == int($blksize/2) ||   #   block done or
           $icb->{nwrd} == 0) ) {                 #   all done
      $rc = serv11_icb_disk_write($icb);  # FIXME: handle file I/O error
      $icb->{nwdone} = 0;
      $icb->{lbn}   += 1;
      $icb->{nblk}  -= 1;
      $rker |= RKER_M_OVR if $icb->{nblk} && $icb->{lbn} >= RK11_NUMBL;
    }

    if ((not $rker) && $icb->{nwrd}) {  # if no error found and not done yet
      push @serv11_icbque, $icb;        # requeue
      return;
    }

  } elsif ($icb->{func} eq "wrcheck") {     # --- write check function -------
    if ($icb->{nwdone} == 0) {          # new block ?
      $rker |= RKER_M_OVR if $icb->{lbn} >= RK11_NUMBL;
      $rc = serv11_icb_disk_read($icb) if not $rker;
      $rker |= RKER_M_CSE if not $rc;   # forward disk I/O error
      if ((not $rker)) {
        $icb->{bufdsk} = $icb->{buf};
        $icb->{buf} = [];
      }
    }

    my $nwdma = int($blksize/2) - $icb->{nwdone};
    $nwdma = $icb->{nwrd}       if $nwdma > $icb->{nwrd};
    $nwdma = $serv11_rdma_chunk if $nwdma > $serv11_rdma_chunk;

    serv11_rri_lalh($icb->{addr}, 3);
    serv11_rri_rblk($nwdma);
    $rc = serv11_rri_exec(\@rval);     # FIXME: handle dma I/O error
    $stat_tab{wdisk} += 2*$nwdma;

    $icb->{nwdone} += $nwdma;
    $icb->{nwrd}   -= $nwdma;
    $icb->{addr}   += 2*$nwdma;

    push @{$icb->{buf}}, @{$rval[0]};

    if ((not $rker) &&                           # no error and
          ($icb->{nwdone} == int($blksize/2) ||  #   block done or
           $icb->{nwrd} == 0)) {                 #   all done
      my $bufdsk = $icb->{bufdsk};
      my $bufmem = $icb->{buf};
      my $nwmem  = scalar(@{$bufmem});
      for (my $i=0; $i<$nwmem; $i++) {
        $rker |= RKER_M_WCE if $bufdsk->[$i] != $bufmem->[$i];
      }
      $icb->{nwdone} = 0;
      $icb->{lbn}   += 1;
      $icb->{nblk}  -= 1;
      $rker |= RKER_M_OVR if $icb->{nblk} && $icb->{lbn} >= RK11_NUMBL;
    }

    my $stop = ($rker & ~RKER_M_WCE) != 0 ||     # any hard error
               (($rker & RKER_M_WCE) && $icb->{rkcs} & RKCS_M_SSE);
    if ((not $stop) && $icb->{nwrd}) {  # if no error found and not done yet
      push @serv11_icbque, $icb;        # requeue
      return;
    }

  } elsif ($icb->{func} eq "rdcheck") {     # --- read check function --------
    $rker |= RKER_M_OVR if $icb->{lbn} >= RK11_NUMBL;

    if (not $rker) {
      my $nwdma = int($blksize/2);
      $nwdma = $icb->{nwrd} if $nwdma > $icb->{nwrd};

      # Note: rkwc is decremented; rkba is untouched, no DMA transfer done
      $icb->{nwrd}   -= $nwdma;
      $icb->{lbn}    += 1;
      $icb->{nblk}   -= 1;
    }

    if ((not $rker) && $icb->{nwrd}) {  # if no error found and not done yet
      push @serv11_icbque, $icb;        # requeue
      return;
    }


  } else {                                  # --- unkown function ------------
    printf "pi_rri-E: unknown func=%s for serv11_rdma_rk11\n", $icb->{func};
  }

# common handling for dma transfer completion

  my $ba   = $icb->{addr} &0177776;         # get lower 16 bits
  my $mex  = ($icb->{addr} >> 16) & 03;     # get upper  2 bits
  my $lbn  = $icb->{lbn};
  my $nwrd = $icb->{nwrd};
  my $end  = $lbn;
  my $se   = $end % RK11_NUMSE;
     $end  = int ($end / RK11_NUMSE);
  my $hd   = $end % RK11_NUMHD;
     $end  = int ($end / RK11_NUMHD);
  my $cy   = $end;
  my $da   = ($icb->{rkda} & RKDA_M_DRSEL) |
              $se | $hd<<(RKDA_V_SUR) | $cy<<(RKDA_V_CYL);
  my $cs   = ($icb->{rkcs} & (~RKCS_M_MEX)) | ($mex << RKCS_V_MEX);

  serv11_rri_ibrb($ctl);
  serv11_rri_wibr("RKER", $ctl, RK11_RKER, $rker) if $rker;
  serv11_rri_wibr("RKWC", $ctl, RK11_RKWC, (-$nwrd)&0177777);
  serv11_rri_wibr("RKBA", $ctl, RK11_RKBA, $ba);
  serv11_rri_wibr("RKDA", $ctl, RK11_RKDA, $da);
  serv11_rri_wibr("RKCS", $ctl, RK11_RKCS, $cs) if ($cs != $icb->{rkcs});
  serv11_rri_wibr("RKMR", $ctl, RK11_RKMR, 1<<(RKMR_V_FDONE));
  serv11_attn_rk11_logerr($ctl, $rker) if $rker;
  $rc = serv11_rri_exec(\@rval);
}

#-------------------------------------------------------------------------------
# read one disk block at lbn, returns $icb->{buf}

sub serv11_icb_disk_read {              # read  one dsk file block
  my ($icb) = @_;
  my $ucb   = $icb->{ucb};
  my $ctl   = $icb->{ctl};
  my $fh    = $ucb->{att_fh};
  my $fsize = $ucb->{att_nbyt};
  my $lbn   = $icb->{lbn};
  my $blksize = $ctl->{blksize};
  my $seekpos = $lbn*$blksize;
  my $sysbuf;
  my $msg = "";
  my $rc = 0;

  $icb->{buf} = undef;

  if ($seekpos < $fsize) {
    ($rc,$sysbuf) = file_seek_read($fh, $seekpos, $blksize);
    $icb->{buf} = conv_buf2wlist($sysbuf);
  } else {
    $rc  = $blksize;                    # setup good rc
    $msg = "  past eof zero buf";
    $icb->{buf} = [];
    while ($blksize > 0) {
      push @{$icb->{buf}}, 0;
      $blksize -= 2;
    }
  }

  if (exists $opts{tserv} && $ctl->{trace}) {
    printf $fh_log "disk -- %3s  read lbn=%5d rc=%d%s\n",
      $ucb->{unitname}, $lbn, $rc, $msg;
  }

  return $rc;
}

#-------------------------------------------------------------------------------
# write one disk block at lbn, takes data from $icb->{buf}

sub serv11_icb_disk_write {             # write one dsk file block
  my ($icb) = @_;
  my $ucb   = $icb->{ucb};
  my $ctl   = $icb->{ctl};
  my $fh    = $ucb->{att_fh};
  my $fsize = $ucb->{att_nbyt};
  my $lbn   = $icb->{lbn};
  my $blksize = $ctl->{blksize};
  my $seekpos = $lbn*$blksize;
  my $sysbuf  = "";
  my $rc;

  if (scalar(@{$icb->{buf}}) > int($blksize/2)) {
    print_fatal "serv11_icb_disk_write: buf too long";
  }

  while (scalar(@{$icb->{buf}}) < int($blksize/2)) {    # zero pad to block size
    push @{$icb->{buf}}, 0;
  }

  if ($fsize <= $seekpos) {             # extend dsk file ?
    my $zerobuf = chr(0) x $blksize;
    my $cnt = 0;
    file_seek($fh, $fsize);
    while ($fsize <= $seekpos) {
      file_write($fh, $zerobuf);
      $fsize += $blksize;
      $cnt   += 1;
    }
    if (exists $opts{tserv} && $ctl->{trace}) {
      printf $fh_log "disk -- %3s extended by %d blocks\n",
         $ucb->{unitname}, $cnt;
    }
    $ucb->{att_nbyt} = $fsize;
  }

  $sysbuf  = conv_wlist2buf($icb->{buf});
  $rc = file_seek_write($fh, $seekpos, $sysbuf);

  if (exists $opts{tserv} && $ctl->{trace}) {
    printf $fh_log "disk -- %3s write lbn=%5d rc=%d\n",
      $ucb->{unitname}, $lbn, $rc;
  }

  return $rc;
}

#-------------------------------------------------------------------------------

sub serv11_rri_init {                       # issue rri init command
  my ($aname,$addr,$data) = @_;
  push @rri_cmdlist, {cname    => "init",
                      aname    => $aname,
                      addr     => $addr,
                      data     => $data,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  return undef;
}

#-------------------------------------------------------------------------------

sub serv11_rri_attn {                       # issue rri attn command
  my ($aname) = @_;
  push @rri_cmdlist, {cname    => "attn",
                      aname    => $aname,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  $rri_cmdlist[$#rri_cmdlist]->{get_data} = 1;
  return $rri_rvalcnt++;
}

#-------------------------------------------------------------------------------

sub serv11_rri_stat {                       # issue rri stat command
  my ($aname) = @_;
  push @rri_cmdlist, {cname    => "stat",
                      aname    => $aname,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  $rri_cmdlist[$#rri_cmdlist]->{get_data} = 1;
  return $rri_rvalcnt++;
}

#-------------------------------------------------------------------------------

sub serv11_rri_rreg {                       # issue rri rreg command
  my ($aname,$addr) = @_;
  push @rri_cmdlist, {cname    => "rreg",
                      aname    => $aname,
                      addr     => $addr,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  $rri_cmdlist[$#rri_cmdlist]->{get_data} = 1;
  return $rri_rvalcnt++;
}

#-------------------------------------------------------------------------------

sub serv11_rri_wreg {                       # issue rri wreg command
  my ($aname,$addr,$data) = @_;
  push @rri_cmdlist, {cname    => "wreg",
                      aname    => $aname,
                      addr     => $addr,
                      data     => $data,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  return undef;
}

#-------------------------------------------------------------------------------

sub serv11_rri_rblk {                       # issue rri rblk command
  my ($nblk) = @_;
  push @rri_cmdlist, {cname    => "rblk",
                      aname    => "brm",
                      addr     => PDPCP_ADDR_MEMI,
                      nblk     => $nblk,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  $rri_cmdlist[$#rri_cmdlist]->{get_rblk} = 1;
  return $rri_rvalcnt++;
}

#-------------------------------------------------------------------------------

sub serv11_rri_wblk {                       # issue rri wblk command
  my ($nblk,$dref) = @_;
  push @rri_cmdlist, {cname    => "wblk",
                      aname    => "bwm",
                      addr     => PDPCP_ADDR_MEMI,
                      nblk     => $nblk,
                      dat_wblk => $dref,
                      ref_stat => $rri_ref_sdef,
                      msk_stat => $rri_msk_sdef};
  return undef;
}

#-------------------------------------------------------------------------------

sub serv11_rri_lalh {                       # issue pdpcp lal and lah commands
  my ($addr,$mode) = @_;

  serv11_rri_wreg("wal", PDPCP_ADDR_AL, $addr&0xffff);  # lower 16 bits
  if ($mode>=1 and $mode<=3) {
    my $data = ($addr>>16)&0x3f | $mode<<6;
    serv11_rri_wreg("wah", PDPCP_ADDR_AH, $data);       # upper 6 bits
  }
  if ($mode<0 or $mode>3) {
    print STDERR "pi_rri($curmode)-E: bad mode $mode in serv11_exec_rblk()\n";
  }
}

#-------------------------------------------------------------------------------

sub serv11_rri_ibrb {                       # issue rbus set base address
  my ($ctl) = @_;
  serv11_rri_wreg("wibrb", PDPCP_ADDR_IBRB, $ctl->{ibrb});
  return undef;
}

#-------------------------------------------------------------------------------

sub serv11_rri_ribr {                       # issue rbus read
  my ($aname,$ctl,$off) = @_;
  my $ibroff = $ctl->{base} + $off - $ctl->{ibrb};
  return serv11_rri_rreg($aname, PDPCP_ADDR_IBR+int($ibroff/2));
}

#-------------------------------------------------------------------------------

sub serv11_rri_wibr {                       # issue rbus write
  my ($aname,$ctl,$off,$data) = @_;
  my $ibroff = $ctl->{base} + $off - $ctl->{ibrb};
  return serv11_rri_wreg($aname, PDPCP_ADDR_IBR+int($ibroff/2), $data);
}

#-------------------------------------------------------------------------------

sub serv11_rri_clear {
  @rri_cmdlist = ();
  $rri_rvalcnt = 0;
}

#-------------------------------------------------------------------------------

sub serv11_rri_exec {
  my ($dref) = @_;
  my $rc = 0;

  return $rc if scalar(@rri_cmdlist) == 0;

  rri_cmdlist_exec(\@rri_cmdlist);
  $rc = rri_cmdlist_check_stat(\@rri_cmdlist);

  if ($rc) {
    print "pi_rri($curmode)-E: serv11_rri_exec error - dump follows\n";
    if (exists $opts{log} && $opts{log} ne "") {
      print $fh_log "pi_rri($curmode)-E: serv11_rri_exec error - dump follows\n";
    }
  }
  if ($rc || exists $opts{dserv}) {
    rri_cmdlist_dump(\@rri_cmdlist, 0, $fh_log);
  }

  @{$dref} = ();
  foreach my $ele (@rri_cmdlist) {
    push @{$dref}, $ele->{rcv_data} if $ele->{get_data};
    push @{$dref}, $ele->{rcv_rblk} if $ele->{get_rblk};
  }

  @rri_cmdlist = ();
  $rri_rvalcnt = 0;

  return $rc;
}

#-------------------------------------------------------------------------------

sub serv11_rri_uset {                       # issue rbus uset writes
  my $ucb = shift @_;
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
  my $first = 1;

  while (scalar(@_)) {
    my $text = shift @_;
    my $addr = shift @_;
    my $data = shift @_;
    my $key  = "uset_" . $text;

    if ((not defined $ctl->{$key}) || $ctl->{$key} != $data) {

      serv11_rri_ibrb($ctl) if $first;
      $first = 0;

      serv11_rri_wibr($text, $ctl, $addr, $data);
      $ctl->{$key} = $data;

      if (exists $opts{tserv} && $ctl->{trace}) {
        printf $fh_log "uset -- %s %s %6.6o\n",
        $ctl->{ctltype}, $ucb->{unitname}, $data;
      }
    }
  }

}

#-------------------------------------------------------------------------------

sub serv11_exec_rblk {
  my ($addr,$mode,$dref,$nword) = @_;
  my @rval;

  serv11_rri_lalh($addr,$mode);

  while ($nword>0) {
    my $nblk = $nword;
    $nblk   = 256 if $nblk > 256;
    $nword -= $nblk;

    my $idref = serv11_rri_rblk($nblk);

    my $rc = serv11_rri_exec(\@rval);
    return $rc if $rc;

    push @$dref, @{$rval[$idref]};
  }

  return 0;
}

#-------------------------------------------------------------------------------

sub serv11_exec_wblk {
  my ($addr,$mode,$dref) = @_;
  my @rval;

  serv11_rri_lalh($addr,$mode);

  my $nword  = scalar(@$dref);
  my $offset = 0;

  if ($nword == 0) {
    print "pi_rri($curmode)-W: spurious serv11_exec_wblk() with 0 data length\n";
    return;
  }

  while ($nword>0) {
    my $nblk = $nword;
    $nblk   = 256 if $nblk > 256;
    my $beg = $offset;
    my $end = $offset+$nblk-1;

    serv11_rri_wblk($nblk, [ @$dref[$beg..$end] ]);

    $nword  -= $nblk;
    $offset += $nblk;

    my $rc = serv11_rri_exec(\@rval);
    return $rc if $rc;
  }

  return 0;
}

#-------------------------------------------------------------------------------

sub serv11_exec_probe {
  my ($addr,$mode) = @_;
  my $iib;
  my $irb;

  if ($mode =~ /i/) {
    serv11_rri_wreg("wal", PDPCP_ADDR_AL, $addr); # i/o page in 16 bit mode
    serv11_rri_rreg("rm",  PDPCP_ADDR_MEM);
    $iib = $#rri_cmdlist;
  }
  if ($mode =~ /r/) {
    my $ibrbase = $addr & ~(077);           # ibr-base   => drop last 6 bits
    my $ibroff  = $addr &  (077);           # ibr-offset => take last 6 bits

    serv11_rri_wreg("wibrb", PDPCP_ADDR_IBRB, $ibrbase);
    serv11_rri_rreg("ribr",  PDPCP_ADDR_IBR + int($ibroff/2));
    $irb = $#rri_cmdlist;
  }

  rri_cmdlist_exec(\@rri_cmdlist);
  rri_cmdlist_dump(\@rri_cmdlist, 0) if exists $opts{dserv};

  my $ival;
  my $rval;
  if (defined $iib) {
    $ival =$rri_cmdlist[$iib]->{rcv_data} if not $rri_cmdlist[$iib]->{err_stat};
  }
  if (defined $irb) {
    $rval =$rri_cmdlist[$irb]->{rcv_data} if not $rri_cmdlist[$irb]->{err_stat};
  }
  serv11_rri_clear();

  return ($ival, $rval);
}

#-------------------------------------------------------------------------------

sub next_nxbuf {                            # calculate next nxbuf value
  my ($ctl,$nxbuf,$nxbuf_val) = @_;

  if ($nxbuf_val <= $nxbuf/2) {
    $nxbuf -= $ctl->{nxbuf_inc};
  } else {
    $nxbuf += $ctl->{nxbuf_inc};
  }
  $nxbuf = $ctl->{nxbuf_min} if $nxbuf < $ctl->{nxbuf_min};
  $nxbuf = $ctl->{nxbuf_max} if $nxbuf > $ctl->{nxbuf_max};

  return $nxbuf;
}

#-------------------------------------------------------------------------------

sub telnet_readhdl {                        # telnet: socket read handler
  my ($teldsc) = @_;
  my $ucb = $teldsc->{ucb};

  if ($teldsc->{state} == TELNET_STATE_LISTEN) {
    my $fh_data = new FileHandle;
    if (not accept($fh_data, $teldsc->{fh_port})) {
      printf STDERR "pi_rri($curmode)-E: erro in accept(): $!\n";
      return;                               # FIXME: error handling ??
    }
    printf "connect on port %s for %s\n", $teldsc->{port}, $ucb->{unitname};
    my $buf;
    my $rc;
    $buf = pack("C3", TELNET_CODE_IAC, TELNET_CODE_WILL, TELNET_OPT_LINE);
    $rc  = syswrite($fh_data, $buf, length($buf));
    $buf = pack("C3", TELNET_CODE_IAC, TELNET_CODE_WILL, TELNET_OPT_SGA);
    $rc  = syswrite($fh_data, $buf, length($buf));
    $buf = pack("C3", TELNET_CODE_IAC, TELNET_CODE_WILL, TELNET_OPT_ECHO);
    $rc  = syswrite($fh_data, $buf, length($buf));
    $buf = pack("C3", TELNET_CODE_IAC, TELNET_CODE_WILL, TELNET_OPT_BIN);
    $rc  = syswrite($fh_data, $buf, length($buf));
    $buf = pack("C3", TELNET_CODE_IAC, TELNET_CODE_DO, TELNET_OPT_BIN);
    $rc  = syswrite($fh_data, $buf, length($buf));

    $teldsc->{state}   = TELNET_STATE_STREAM;
    $teldsc->{fh_data} = $fh_data;

    $buf = sprintf("\r\nconnect on port %s for %s\r\n\r\n",
                   $teldsc->{port}, $ucb->{unitname});
    $rc  = syswrite($fh_data, $buf, length($buf));

    telnet_writehdl($ucb);

    $serv11_fds_update = 1;

  } else {

    my $buf;
    my $rc;
    $rc = sysread($teldsc->{fh_data}, $buf, 64);

    if ($rc == 0) {
      printf "disconnect on port %s for %s\n", $teldsc->{port}, $ucb->{unitname};
      close ($teldsc->{fh_data});
      delete $teldsc->{fh_data};
      $teldsc->{state} = TELNET_STATE_LISTEN;
      $serv11_fds_update = 1;

    } else {
      my @int = unpack("C*", $buf);
      foreach my $byt (@int) {
        if ($teldsc->{state} == TELNET_STATE_STREAM) { # state: stream
          if ($byt == TELNET_CODE_IAC) {
            $teldsc->{state} = TELNET_STATE_IAC;
          } else {
            my $ctl = $serv11_ctltbl{$ucb->{ctlname}};
            my @bytes;
            push @bytes, $byt;
            &{$ctl->{ichrhdl}}($ucb, \@bytes);         # call ichr handler
          }
        } elsif ($teldsc->{state} == TELNET_STATE_IAC) { # state: IAC seen
          if ($byt == TELNET_CODE_WILL ||
              $byt == TELNET_CODE_WONT ||
              $byt == TELNET_CODE_DO   ||
              $byt == TELNET_CODE_DONT) {
            $teldsc->{state} = TELNET_STATE_CMD;
          } elsif ($byt == TELNET_CODE_SB) {
            $teldsc->{state} = TELNET_STATE_SUBNEG;
          } else {
            $teldsc->{state} = TELNET_STATE_STREAM;
          }
        } elsif ($teldsc->{state} == TELNET_STATE_CMD) { # state: cmd seen
          $teldsc->{state} = 0;
        } elsif ($teldsc->{state} == TELNET_STATE_SUBNEG) { # state: subneg
          if ($byt == TELNET_CODE_IAC) {
            $teldsc->{state} = TELNET_STATE_SUBIAC;
          }
        } elsif ($teldsc->{state} == TELNET_STATE_SUBIAC) { # state: subneg+IAC
          $teldsc->{state} = TELNET_STATE_STREAM;
        }
      }
    }
  }
}

#-------------------------------------------------------------------------------

sub telnet_writehdl {                       # telnet: write handler
  my ($ucb) = @_;

  my $teldsc = $telnettbl{$ucb->{att_port}};
  return if $teldsc->{state} == TELNET_STATE_LISTEN;

  while (scalar( @{$ucb->{sndque}} )) {
    my $byte = shift @{$ucb->{sndque}};
    syswrite($teldsc->{fh_data}, pack("C1",$byte), 1);
## FIXME: escape IAC !!
##    if ($byte == TELNET_CODE_CR) {
##      syswrite($teldsc->{fh_data}, pack("C1",TELNET_CODE_LF), 1);
##    }
  }

}

#-------------------------------------------------------------------------------

sub pdp11_disassemble {
  my ($pc,$d0,$d1,$d2) = @_;
  my @mem = ($d0,0,0);
  $mem[1] = $d1 if defined $d1;
  $mem[2] = $d2 if defined $d2;

  my $code = shift @mem;

  foreach my $ele (@pdp11_opcode_tbl) {
    if (($code & (~($ele->{mask})) ) == $ele->{code}) {
      my $name = $ele->{name};
      my $type = $ele->{type};
      my $str  = $name;
      if ($type eq "0arg") {
        return ($name,1);

      } elsif ($type eq "1arg" or $type eq "1fpp") {
        my $dst = $code & 077;
        my $pref = ($type eq "1fpp") ? "f" : "r";
        my ($dst_str,$dst_nw,$dst_ta) =
              pdp11_disassemble_regmod($dst, $mem[0], $pc+2, $pref);
        shift @mem if ($dst_nw);
        $str  = "$name $dst_str";
        if ($dst_ta) {
          $str .= " " x (27-length($str)) if length($str)<27;
          $str .= "; $dst_ta";
        }
        return ($str, 1+$dst_nw);

      } elsif ($type eq "2arg") {
        my $src = ($code>>6) & 077;
        my $dst = $code & 077;
        my ($src_str,$src_nw,$src_ta) = 
              pdp11_disassemble_regmod($src, $mem[0], $pc+2);
        shift @mem if ($src_nw);
        my ($dst_str,$dst_nw,$dst_ta) = 
              pdp11_disassemble_regmod($dst, $mem[0], $pc+2+2*$src_nw);
        shift @mem if ($dst_nw);
        $str  = "$name $src_str,$dst_str";
        if ($src_ta or $dst_ta) {
          $str .= " " x (27-length($str)) if length($str)<27;
          $str .= ";";
          $str .= " $src_ta" if $src_ta;
          $str .= " $dst_ta" if $dst_ta;
        }
        return ($str, 1+$src_nw+$dst_nw);

      } elsif ($type eq "rdst") {
        my $reg = ($code>>6) & 07;
        my $src = $code & 077;
        my ($src_str,$src_nw,$src_ta) = 
              pdp11_disassemble_regmod($src, $mem[0], $pc+2);
        shift @mem if ($src_nw);
        $str  = "$name $src_str,r$reg";
        if ($src_ta) {
          $str .= " " x (27-length($str)) if length($str)<27;
          $str .= "; $src_ta";
        }
        return ($str, 1+$src_nw);

      } elsif ($type eq "1reg") {
        my $reg = $code & 07;
        my $reg_str = "r$reg";
        $reg_str = "sp" if $reg == 6;
        $reg_str = "pc" if $reg == 7;
        return ("$name $reg_str", 1);

      } elsif ($type eq "br")   {
        my $off  = $code & 0177;
        my $sign = "+";
        if ($code & 0200) {
          $off  = -(((~$off) & 0177)+1);
          $sign = "-";
        }
        my $str = sprintf "$name .%s%d.", $sign, abs(2*$off);
        $str .= " " x (27-length($str)) if length($str)<27;
        $str .= sprintf "; -> %6.6o", (($pc+2)+2*$off)&0177777;
        return ($str, 1);
        
      } elsif ($type eq "sob")  {
        my $reg = ($code>>6) & 07;
        my $off = $code & 077;
        my $str = sprintf "$name r%d,.-%d.", $reg, 2*$off;
        $str .= " " x (27-length($str)) if length($str)<27;
        $str .= sprintf "; -> %6.6o", ($pc+2)-2*$off;
        return ($str, 1);
        
      } elsif ($type eq "trap") {
        my $off = $code & 0377;
        my $str = sprintf "$name %3.3o", $off;
        return ($str, 1);
        
      } elsif ($type eq "spl")  {
        my $off = $code & 07;
        my $str = sprintf "$name %d", $off;
        return ($str, 1);
        
      } elsif ($type eq "ccop")  {
        my $cc = $code & 017;
        return ("nop",1) if ($cc   == 0);
        return ("ccc",1) if ($code == 0257);
        return ("scc",1) if ($code == 0277);
        my $str = "";
        my $del = "";
        if ($code & 010) { $str .= $del . $name . "n", $del = "+" }
        if ($code & 004) { $str .= $del . $name . "z", $del = "+" }
        if ($code & 002) { $str .= $del . $name . "v", $del = "+" }
        if ($code & 001) { $str .= $del . $name . "c", $del = "+" }
        return ($str, 1);
        
      } elsif ($type eq "jsr")  {
        my $reg = ($code>>6) & 07;
        my $dst = $code & 077;
        my ($dst_str,$dst_nw,$dst_ta) =
              pdp11_disassemble_regmod($dst, $mem[0], $pc+2);
        shift @mem if ($dst_nw);
        $str  = "$name r$reg,$dst_str";
        if ($dst_ta) {
          $str .= " " x (27-length($str)) if length($str)<27;
          $str .= "; $dst_ta";
        }
        return ($str, 1+$dst_nw);
        
      } elsif ($type eq "mark") {
        my $off = $code & 077;
        my $str = sprintf "$name %3.3o", $off;
        return ($str, 1);
        
      } elsif ($type eq "rfpp") {
        my $reg = ($code>>6) & 03;
        my $dst = $code & 077;
        my ($dst_str,$dst_nw,$dst_ta) = 
              pdp11_disassemble_regmod($dst, $mem[0], $pc+2, "f");
        shift @mem if ($dst_nw);
        $str  = "$name f$reg,$dst_str";
        if ($dst_ta) {
          $str .= " " x (27-length($str)) if length($str)<27;
          $str .= "; $dst_ta";
        }
        return ($str, 1+$dst_nw);

      } else {
        return ("?type?",1);
      }
    }
  }
  return ("=inval=",1);
}

#-------------------------------------------------------------------------------

sub pdp11_disassemble_regmod {
  my ($regmod,$data,$pc,$pref) = @_;
  my $mod = ($regmod>>3) & 07;
  my $reg = $regmod & 07;

  $pref = "r" if not defined $pref or $reg>5;

  my $reg_str = "r$reg";
  $reg_str = "sp" if $reg == 6;
  $reg_str = "pc" if $reg == 7;

  if ($mod == 0) {                      # mode 0:    Rx  { Fx for float }
    $reg_str = "f$reg" if defined $pref && $pref eq "f" && $reg<=5;
    return ($reg_str, 0, "");
  } elsif ($mod == 1) {                 # mode 1:    (Rx)
    return ("($reg_str)", 0, "");
  } elsif ($mod == 2 || $mod == 3) {    # mode 2/3:  (Rx)+   @(Rx)+
    my $ind = ($mod == 3) ? "@" : "";
    if ($reg != 7) {                      # if reg != pc
      return ("$ind($reg_str)+", 0, "");
    } else {                              # if reg == pc
      my $str = sprintf "$ind#%6.6o", $data;     # 27 -> #nnn;  37 -> @#nnn
      return ($str, 1, "");
    }
  } elsif ($mod == 4 || $mod == 5) {    # mode 4/5:  -(Rx)   @-(Rx)
    my $ind = ($mod == 5) ? "@" : "";
    return ("$ind-($reg_str)", 0, "");
  } elsif ($mod == 6 || $mod == 7) {    # mode 6/7:  nn(Rx)  @nn(Rx)
    my $ind = ($mod == 7) ? "@" : "";
    my $data_str = sprintf "%o", $data;
    my $ta_str = "";
    $ta_str = sprintf "%6.6o",($pc+2+$data)&0177777 if ($reg==7);
    return ("$ind$data_str($reg_str)", 1, $ta_str);
  }
}

#-------------------------------------------------------------------------------

sub file_seek {                             # fseek wrapper
  my ($fh,$pos) = @_;
  my $rc;
  my $offset = $pos;
  my $whence = 0;
  if ($pos < 0) {                           # if offset<0 -> seek to EOF
    $offset = 0;
    $whence = 2;
  }
  $rc = $fh->seek($offset, $whence);
  if (not $rc) {
    print "pi_rri($curmode)-E: file_seek failed\n";
    $rc = 0;
  }
  return $rc;
}

#-------------------------------------------------------------------------------

sub file_read {                             # fread wrapper
  my ($fh,$nbyte) = @_;
  my $rc;
  my $buf = "";

  $rc = $fh->read($buf, $nbyte);
  if ($rc != $nbyte) {
    print "pi_rri($curmode)-E: file_read failed, got $rc, expectd $nbyte\n";
    $rc = 0;
  }
  return ($rc, $buf);
}

#-------------------------------------------------------------------------------

sub file_seek_read {                        # fseek+fread wrapper
  my ($fh,$pos,$nbyte) = @_;
  my $rc;
  my $buf;
  $rc = file_seek($fh, $pos);
  ($rc,$buf) = file_read($fh, $nbyte) if $rc;
  return ($rc, $buf);
}

#-------------------------------------------------------------------------------

sub file_write {                            # fwrite wrapper
  my ($fh,$buf) = @_;
  my $rc;
  $rc = print $fh $buf;
  if (not $rc) {
    print "pi_rri($curmode)-E: file_write failed\n";
    $rc = 0;
  }
  return $rc;
}

#-------------------------------------------------------------------------------

sub file_seek_write {                       # fseek+fwrite wrapper
  my ($fh,$pos,$buf) = @_;
  my $rc;
  $rc = file_seek($fh, $pos);
  $rc = file_write($fh, $buf) if $rc;
  return $rc;
}

#-------------------------------------------------------------------------------

sub raw_get9_crc_16bit {                    # read 16 bit value
  my ($dref) = @_;
  my $idl = raw_get9_crc();
  my $idh = undef;
  $idh = raw_get9_crc() if defined $idl;

  if (defined $idh) {
    my $idat = $idl | ($idh<<8);
    $$dref = $idat;
    return 1;
  }
  print "pi_rri($curmode)-E: receive time out\n";
  print $fh_log "ERR  -- receive time out in raw_get9_crc_16bit\n";
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_crc_8bit {                     # read 8bit value
  my ($dref) = @_;
  my $idat = raw_get9_crc();
  if (defined $idat) {
    $$dref = $idat;
    return 1;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_crc_check {                    # get 9bit, block, crc, ref value
  my ($ref,$case) = @_;
  my $dat = raw_get9_crc();
  if (defined $dat) {
    return 1 if ($dat == $ref);
    printf "pi_rri($curmode)-E: receive $case mismatch" .
           " found=0x%3.3x expect=0x%3.3x\n",
             $dat, $ref;
    return 0;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_check {                        # get 9bit, block, expect ref value
  my ($ref,$case) = @_;
  my $dat = raw_get9();
  if (defined $dat) {
    return 1 if ($dat == $ref);
    printf "pi_rri($curmode)-E: receive $case mismatch" .
      " found=0x%3.3x expect=0x%3.3x\n",
      $dat, $ref;
    return 0;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_checksop {                     # get 9bit, block, expect SOP
  my $dat;
  while(1) {
    $dat = raw_get9();
    last unless defined $dat;
    last if ($dat != D9ATTN);
    if ($serv11_active) {
      $serv11_attn_seen = 1;
    } else {
      printf "pi_rri($curmode)-W: unexpected ATTN comma dropped\n";
    }
  }
  if (defined $dat) {
    return 1 if ($dat == D9SOP);
    printf "pi_rri($curmode)-E: expect sop, but found=0x%3.3x\n", $dat;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_checkeop {                     # get 9bit, block, expect EOP
  my $dat;
  $dat = raw_get9();
  if (defined $dat) {
    return 1 if ($dat == D9EOP);
    printf "pi_rri($curmode)-E: expect eop, but found=0x%3.3x\n", $dat;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub raw_get9_crc {                          # get 9bit, block, update crc
  my $dat = raw_get9();
  $icrc = $crc8_tbl[$icrc ^ $dat] if (defined $dat && $dat < 0x100);
  return $dat;
}

#-------------------------------------------------------------------------------

sub raw_get9 {                              # get 9bit, block
  my $nidle = 0;
  my $dat = undef;
  while (1) {
    $dat = raw_rcv9_to($raw_timeout);
    last unless defined $dat;
    last if $dat != D9IDLE;
    $nidle += 1;
  }
##  print "pi_rri($curmode)-I: dropped $nidle idle commas\n" if $nidle;
  print "pi_rri($curmode)-E: receive time out\n" unless defined $dat;
  print $fh_log "ERR  -- receive time out in raw_get9\n" unless defined $dat;
  return $dat;
}

#-------------------------------------------------------------------------------

sub raw_snd9_crc {                          # put 9bit to RX, update crc
  my ($dat) = @_;
  raw_snd9($dat);
  $ocrc = $crc8_tbl[$ocrc ^ $dat] if ($dat < 0x100);
}

#-------------------------------------------------------------------------------

sub raw_snd9 {                              # put 9bit to RX
  my ($dat) = @_;

  if (exists $opts{tio9}) {
    print  $fh_log conv_etime(\$tlast_tio9),
                   "[$curchan] snd9 ", conv_dat9($dat);
    printf $fh_log " sndq=%3d", scalar(@que_snd);
    print  $fh_log "  -- idle" if $dat == D9IDLE;
    print  $fh_log "  -- sop " if $dat == D9SOP;
    print  $fh_log "  -- eop " if $dat == D9EOP;
    print  $fh_log "  -- nak " if $dat == D9NAK;
    print  $fh_log "  -- attn" if $dat == D9ATTN;
    print  $fh_log  "\n";
  }
  $stat_tab{osop} += 1 if $dat == D9SOP;

  if ($dat >= 0x100) {
    raw_snd8(CPREF | ($dat & 0x0f));
  } else {
    if ( $dat == CESC ||
        ($dat >= CPREF && $dat <= (CPREF+NCOMM)) ) {
      raw_snd8(CESC);
      raw_snd8(CEN1 | ($dat & 0x0f));
      $stat_tab{oesc} += 1;
    } else {
      raw_snd8($dat);
    }
  }
}

#-------------------------------------------------------------------------------

sub raw_snd8 {                              # put 8bit to RX
  my ($dat) = @_;
  if (exists $opts{tio8}) {
    print $fh_log conv_etime(\$tlast_tio8),
          "[$curchan] snd8   ", conv_dat8($dat),"\n";
  }
  $stat_tab{obyte} += 1;

  push @que_snd, int $dat;
}

#-------------------------------------------------------------------------------

sub raw_rcv9 {                              # get 9bit from TX, non-blocking
  return raw_rcv9_to(0.);
}

#-------------------------------------------------------------------------------

sub raw_rcv8 {                              # get 8bit from TX, non-blocking
  return raw_rcv8_to(0.);
}

#-------------------------------------------------------------------------------

sub raw_rcv9_to {
  my ($timeout) = @_;
  my $dat8 = raw_rcv8_to($timeout);
  my $dat9 = undef;

  if (defined $dat8) {
    if ($dat8 == CESC) {
      $stat_tab{iesc} += 1;
      $raw_rcv_esc = 1;
      $dat8 = raw_rcv8_to($timeout);
      return $dat8 unless defined $dat8;
    }
    if ($raw_rcv_esc) {
      $dat9 = CPREF | ($dat8 & 0x0f);
      $raw_rcv_esc = 0;
    } else {
      if ($dat8>= CPREF && $dat8<=(CPREF+NCOMM) ) {
        $dat9 = 0x100 | ($dat8 & 0x0f);
      } else {
        $dat9 = $dat8;
      }
    }
  }

  if (defined $dat9) {
    $stat_tab{att} += 1 if $dat9 == D9ATTN;
    ##print "+++9 attn seen\n" if $dat9==D9ATTN;

    if (exists $opts{tio9}) {
      print $fh_log conv_etime(\$tlast_tio9), 
                    "[$curchan] rcv9 ", conv_dat9($dat9);
      printf $fh_log " rcvq=%3d", scalar(@que_rcv);
      print $fh_log "  -- idle" if $dat9 == D9IDLE;
      print $fh_log "  -- sop " if $dat9 == D9SOP;
      print $fh_log "  -- eop " if $dat9 == D9EOP;
      print $fh_log "  -- nak " if $dat9 == D9NAK;
      print $fh_log "  -- attn" if $dat9 == D9ATTN;
      print $fh_log  "\n";
    }
  }

  return $dat9;
}

#-------------------------------------------------------------------------------

sub raw_rcv8_to {                           # get 8bit from TX, expl. time-out
  my ($timeout) = @_;
  my $buf;
  my $dat;

  &{$chan_tab{$curchan}{write}}();          # flush write queue before read

  &{$chan_tab{$curchan}{read}}($timeout) unless @que_rcv;
  $dat = shift @que_rcv;

  if (exists $opts{tio8} and defined $dat) {
    print $fh_log conv_etime(\$tlast_tio8), 
          "[$curchan] rcv8   ", conv_dat8($dat),"\n";
  }
  $stat_tab{ibyte} += 1;

  return $dat;
}

#-------------------------------------------------------------------------------

sub wait_sel_filercv {                      # poll/wait for TX to be ready
  my ($timeout) = @_;
  my $nfound=-1;
  my $fds_rd;

  while ($nfound<0) {
    $nfound = select($fds_rd=$fdset_filercv, undef, undef, $timeout);
    next if ($nfound == -1) and $! == EINTR;
    die "select error: $!" unless $nfound >= 0;
  }
  return $nfound;
 }

#-------------------------------------------------------------------------------

sub fifo_open {                             # chan fifo: open handler
  my ($arg) = @_;
  my ($file,$keep) = split /,/,$arg;
  my $file_base = $file ? $file : "tb_rriext_fifo";
  my $file_snd = $file_base . "_rx";
  my $file_rcv = $file_base . "_tx";

  $fifo_keep = $keep;
  $fdset_filercv = "";

  print_fatal("I/O mode already set to --$curchan") if ($curchan);

  if (-e $file_snd) {
    print_fatal("$file_snd exists but is not a pipe") unless (-p $file_snd);
  } else {
    mkfifo($file_snd, 0666) || die "can't mkfifo $file_snd: $!";
    print "pi_rri[fifo]-I: created fifo $file_snd\n";
  }

  if (-e $file_rcv) {
    print_fatal("$file_rcv exists but is not a pipe") unless (-p $file_rcv);
  } else {
    mkfifo($file_rcv, 0666) || die "can't mkfifo $file_rcv: $!";
    print "pi_rri[fifo]-I: created fifo $file_rcv\n";
  }

  $fh_snd = new FileHandle;
  $fh_rcv = new FileHandle;

  print "pi_rri[fifo]-I: wait to connect to $file_snd\n";
  sysopen ($fh_snd, $file_snd, O_WRONLY) || die "can't open $file_snd: $!";
  print "pi_rri[fifo]-I: connected to $file_snd\n";
  sysopen ($fh_rcv, $file_rcv, O_RDONLY) || die "can't open $file_rcv: $!";
  print "pi_rri[fifo]-I: connected to $file_rcv\n";
  vec($fdset_filercv, fileno($fh_rcv), 1) = 1;

  $curchan = "fifo";
}

#-------------------------------------------------------------------------------

sub fifo_close {                            # chan fifo: close handler
  if ($fifo_keep) {
    print "pi_rri[fifo]-I: signal 'keep-alive' to tb\n";
    raw_snd8(CESC);
    raw_snd8(CESC);
    &{$chan_tab{$curchan}{write}}();
  }
  close $fh_snd;
  close $fh_rcv;
  $fh_snd  = undef;
  $fh_rcv  = undef;
  $curchan = undef;
}

#-------------------------------------------------------------------------------

sub term_open {                             # term fifo: open handler
  my ($arg) = @_;
  my ($dev,$baud,$break) = split /,/,$arg;
  $dev   = "/dev/ttyS0" unless $dev;
  $baud  = 115200       unless $baud;
  $break = 0            unless $break;

  $fdset_filercv = "";

  print_fatal("I/O mode already set to --$curchan") if ($curchan);

  $fh_snd = new FileHandle;
  $fh_rcv = $fh_snd;            # same file handle for read and write

  sysopen ($fh_snd, $dev, O_RDWR|O_NOCTTY) || # read/write, not control TTY
    die "can't open $dev: $!";
  my $fd = fileno($fh_snd);
  vec($fdset_filercv, $fd, 1) = 1;
  $curchan = "term";

  print_fatal("$dev is not a TTY") unless isatty($fd);

  $term_oldtios = new POSIX::Termios;
  $term_oldtios->getattr($fd) || die "getattr failed: $!";

##  term_tios_print($term_oldtios);

  my $newtios = new POSIX::Termios;
  $newtios->getattr($fd) || die "getattr failed: $!";    ## hack for cygwin !!

  my $c_iflag = &POSIX::BRKINT;             # ignore parity errors
  my $c_oflag = 0;
  my $c_cflag = &POSIX::CS8 |               # 8 bit chars
                &POSIX::CSTOPB |            # 2 stop bits
                &POSIX::CREAD |             # enable receiver
                &POSIX::CLOCAL |            # ignore modem control
                LINUX_CRTSCTS;              # enable hardware flow control
  my $c_lflag = 0;
  my $speed = 0;

  $speed = &POSIX::B9600   if $baud == 9600;
  $speed = &POSIX::B19200  if $baud == 19200;
  $speed = &POSIX::B38400  if $baud == 38400;
  $speed = LINUX_B57600    if $baud == 57600;    # hack, only for linux
  $speed = LINUX_B115200   if $baud == 115200;   # hack, only for linux
  $speed = LINUX_B230400   if $baud == 230400;   # hack, only for linux
  $speed = LINUX_B460800   if $baud == 460800;   # hack, only for linux
  $speed = LINUX_B500000   if $baud == 500000;   # hack, only for linux
  $speed = LINUX_B921600   if $baud == 921600;   # hack, only for linux
  $speed = LINUX_B1000000  if $baud ==1000000;   # hack, only for linux
  $speed = LINUX_B2000000  if $baud ==2000000;   # hack, only for linux
  $speed = LINUX_B3000000  if $baud ==3000000;   # hack, only for linux

  print_fatal("speed $baud not supported") unless $speed != 0;

  $c_cflag |= $speed;

  $newtios->setiflag($c_iflag);
  $newtios->setoflag($c_oflag);
  $newtios->setcflag($c_cflag);
  $newtios->setlflag($c_lflag);
  $newtios->setcc(&POSIX::VEOF,     0);     # undef
  $newtios->setcc(&POSIX::VEOL,     0);     # undef
  $newtios->setcc(&POSIX::VERASE,   0);     # undef
  $newtios->setcc(&POSIX::VINTR,    0);     # undef
  $newtios->setcc(&POSIX::VKILL,    0);     # undef
  $newtios->setcc(&POSIX::VQUIT,    0);     # undef
  $newtios->setcc(&POSIX::VSUSP,    0);     # undef
  $newtios->setcc(&POSIX::VSTART,   0);     # undef
  $newtios->setcc(&POSIX::VSTOP,    0);     # undef
  $newtios->setcc(&POSIX::VMIN,  1);        # wait for 1 char
  $newtios->setcc(&POSIX::VTIME, 0);        #

## term_tios_print($newtios);

  $newtios->setattr($fd) || die "setattr failed: $!";

  if ($break) {
    tcsendbreak($fd, 0) || die "tcsendbreak failed: $!";
    raw_snd8 (0x80);
    &{$chan_tab{$curchan}{write}}();        # write 10000000 for autobaud
  }

}

#-------------------------------------------------------------------------------

sub term_close {                            # chan term: close handler
  $term_oldtios->setattr(fileno($fh_snd)) || die "setattr failed: $!";
  close $fh_snd;
  $fh_snd  = undef;
  $fh_rcv  = undef;
  $curchan = undef;
}

#-------------------------------------------------------------------------------

sub term_tios_print {
  my ($tios) = @_;

  my $iflag = $tios->getiflag;
  my $oflag = $tios->getoflag;
  my $cflag = $tios->getcflag;
  my $lflag = $tios->getlflag;

  printf "iflag = %8.8x:", $iflag;
  print " BRKINT" if $iflag & &POSIX::BRKINT;
  print " ICRNL " if $iflag & &POSIX::ICRNL; 
  print " IGNBRK" if $iflag & &POSIX::IGNBRK;
  print " IGNCR " if $iflag & &POSIX::IGNCR; 
  print " IGNPAR" if $iflag & &POSIX::IGNPAR;
  print " INLCR " if $iflag & &POSIX::INLCR; 
  print " INPCK " if $iflag & &POSIX::INPCK; 
  print " ISTRIP" if $iflag & &POSIX::ISTRIP;
  print " IXOFF " if $iflag & &POSIX::IXOFF; 
  print " IXON  " if $iflag & &POSIX::IXON;  
  print " PARMRK" if $iflag & &POSIX::PARMRK;
  print "\n";
  printf "oflag = %8.8x:", $oflag;
  print " OPOST " if $oflag & &POSIX::OPOST; 
  print "\n";

  printf "cflag = %8.8x:", $cflag;
  print " CLOCAL" if $cflag & &POSIX::CLOCAL;
  print " CREAD " if $cflag & &POSIX::CREAD; 
  print " CS5   " if ($cflag & &POSIX::CSIZE) == &POSIX::CS5;
  print " CS6   " if ($cflag & &POSIX::CSIZE) == &POSIX::CS6;
  print " CS7   " if ($cflag & &POSIX::CSIZE) == &POSIX::CS7;
  print " CS8   " if ($cflag & &POSIX::CSIZE) == &POSIX::CS8;
  print " CSTOPB" if $cflag & &POSIX::CSTOPB;
  print " HUPCL " if $cflag & &POSIX::HUPCL; 
  print " PARENB" if $cflag & &POSIX::PARENB;
  print " PARODD" if $cflag & &POSIX::PARODD;

  my $sbits = &POSIX::B50 | &POSIX::B75 | &POSIX::B110 | &POSIX::B134 |
                &POSIX::B150 | &POSIX::B200 | &POSIX::B300 | &POSIX::B600 |
                &POSIX::B1200 | &POSIX::B1800 | &POSIX::B2400 | &POSIX::B4800 |
                &POSIX::B9600 | &POSIX::B19200 | &POSIX::B38400;
  print " B0    " if ($cflag & $sbits) == &POSIX::B0; 
  print " B50   " if ($cflag & $sbits) == &POSIX::B50;
  print " B75   " if ($cflag & $sbits) == &POSIX::B75;
  print " B110  " if ($cflag & $sbits) == &POSIX::B110;
  print " B134  " if ($cflag & $sbits) == &POSIX::B134;
  print " B150  " if ($cflag & $sbits) == &POSIX::B150;
  print " B200  " if ($cflag & $sbits) == &POSIX::B200;
  print " B300  " if ($cflag & $sbits) == &POSIX::B300;
  print " B600  " if ($cflag & $sbits) == &POSIX::B600;
  print " B1200 " if ($cflag & $sbits) == &POSIX::B1200;
  print " B1800 " if ($cflag & $sbits) == &POSIX::B1800;
  print " B2400 " if ($cflag & $sbits) == &POSIX::B2400;
  print " B4800 " if ($cflag & $sbits) == &POSIX::B4800;
  print " B9600 " if ($cflag & $sbits) == &POSIX::B9600;
  print " B19200" if ($cflag & $sbits) == &POSIX::B19200;
  print " B38400" if ($cflag & $sbits) == &POSIX::B38400;
  print "\n";

  printf "lflag = %8.8x:", $lflag;
  print " ECHO  " if $lflag & &POSIX::ECHO;  
  print " ECHOE " if $lflag & &POSIX::ECHOE; 
  print " ECHOK " if $lflag & &POSIX::ECHOK; 
  print " ECHONL" if $lflag & &POSIX::ECHONL;
  print " ICANON" if $lflag & &POSIX::ICANON;
  print " IEXTEN" if $lflag & &POSIX::IEXTEN;
  print " ISIG  " if $lflag & &POSIX::ISIG;  
  print " NOFLSH" if $lflag & &POSIX::NOFLSH;
  print " TOSTOP" if $lflag & &POSIX::TOSTOP;
  print "\n";

  printf "cc(VEOF)  = %3.3o\n", $tios->getcc(&POSIX::VEOF);
  printf "cc(VEOL)  = %3.3o\n", $tios->getcc(&POSIX::VEOL);
  printf "cc(VERASE)= %3.3o\n", $tios->getcc(&POSIX::VERASE);
  printf "cc(VINTR) = %3.3o\n", $tios->getcc(&POSIX::VINTR);
  printf "cc(VKILL) = %3.3o\n", $tios->getcc(&POSIX::VKILL);
  printf "cc(VQUIT) = %3.3o\n", $tios->getcc(&POSIX::VQUIT);
  printf "cc(VSUSP) = %3.3o\n", $tios->getcc(&POSIX::VSUSP);
  printf "cc(VSTART)= %3.3o\n", $tios->getcc(&POSIX::VSTART);
  printf "cc(VSTOP) = %3.3o\n", $tios->getcc(&POSIX::VSTOP);
  printf "cc(VMIN)  = %3.3o\n", $tios->getcc(&POSIX::VMIN);
  printf "cc(VTIME) = %3.3o\n", $tios->getcc(&POSIX::VTIME);
# printf "cc(NCCS)  = %3.3o\n", $tios->getcc(&POSIX::NCCS);
}

#-------------------------------------------------------------------------------

sub genio_read {                            # generic io: read handler
  my ($timeout) = @_;
  my $tstart;
  my $rc;

  $tstart = get_time() if exists $opts{tiob};
  if (wait_sel_filercv($timeout)) {
    my $buf;

    while (not defined $rc) {
      $rc = sysread($fh_rcv, $buf, 64);
      next if (not defined $rc) and $! == EINTR;
      die "sysread fifo error: $!" unless defined $rc;
    }

    if (exists $opts{tiob}) {
      printf $fh_log "%s[$curchan] read  %3d bytes in %8.6f sec\n",
        conv_etime(\$tlast_tiob), $rc, get_time()-$tstart;
    }
    if ($rc) {
      push @que_rcv, unpack("C*", $buf);
    }
  }
###  if (defined $rc) {
###    printf "+++1 _read $timeout rc=%d\n", $rc;
###  } else { 
###    printf "+++1 _read $timeout rc=undef\n";
###  }
  return $rc;
}

#-------------------------------------------------------------------------------

sub genio_write {                           # generic io: write handler
##  printf "+++2 _write q=%d\n", scalar @que_snd;
  if (scalar @que_snd) {

    my $buf = pack("C*", @que_snd);
    while (length($buf)) {
      while(1) {                            # read rcv fifo before writing
        my $rc = genio_read(0.);            # to avoid blocking under cygwin
        last unless defined $rc and $rc > 0;
      }
      my $nwrite = length($buf);
###      $nwrite = 1;                      # <-- when is this really needed ???
###      printf "+++2a _write nw=%d\n", $nwrite;
      my $rc = syswrite($fh_snd, $buf, $nwrite);
      next if (not defined $rc) and $! == EINTR;
      die "syswrite fifo error: $!" unless defined $rc;
      if (exists $opts{tiob}) {
        printf $fh_log "%s[$curchan] write %3d bytes", conv_etime(\$tlast_tiob), $rc;
        printf $fh_log " of %3d in queue", length($buf) if $rc < length($buf);
        print  $fh_log "\n";
      }
      last if $rc == length($buf);
      $buf = substr($buf, $rc);
    }

    @que_snd = ();
  }
}

#-------------------------------------------------------------------------------

sub cget_chkblank {                         # check for unused chars in cmd line
  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest ne "") {
    print "pi_rri($curmode)-E: extra data ignored: \"$cmd_rest\"\n";
    print "          for command: \"$cmd_line\"\n";
    $cmd_bad = 1;
  }
  return $cmd_bad;
}

#-------------------------------------------------------------------------------

sub cget_tagval2_gdat {                     # get tag=v1[,v2], generic base
  my ($tag,$nbit,$dbase) = @_;
  my $dat;
  my $msk = undef;
  $cmd_rest =~ s/^\s*//;
###  print "+++2 |$cmd_rest|$tag|$nbit|$dbase|\n";
  if ($cmd_rest =~ /^$tag=/) {
    $cmd_rest = $';
    if ($cmd_rest =~ /^-/) {
      $cmd_rest = $';
      return (0,0xffff);
    } else {
      $dat = cget_gdat($nbit, $dbase);
      if ($cmd_rest =~ /^,/) {
        $cmd_rest = $';
        $msk = cget_gdat($nbit, $dbase);
      }
      return ($dat, $msk);
    }
  }
  return (undef, undef);
}

#-------------------------------------------------------------------------------

sub cget_tagval_gdat {                      # get tag=val, generic base
  my ($tag,$nbit,$dbase,$min,$max) = @_;
  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^$tag=/) {
    $cmd_rest = $';
    return cget_gdat($nbit, $dbase,$min,$max);
  }
  return undef;
}

#-------------------------------------------------------------------------------

sub cget_gdat {                             # get generic base value
  my ($nbit,$dbase,$min,$max) = @_;
  my $dat;

  $cmd_rest =~ s/^\s*//;
###  print "+++1 |$nbit|$dbase|$cmd_rest|\n";
  if ($cmd_rest =~ /^[xXoObBdD]"/) {
    if ($cmd_rest =~ /^[xX]"([0-9a-fA-F]+)"/) {
      $cmd_rest = $';
      $dat = hex $1;
    } elsif ($cmd_rest =~ /^[oO]"([0-7]+)"/) {
      $cmd_rest = $';
      $dat = oct $1;
    } elsif ($cmd_rest =~ /^[bB]"([01]+)"/) {
      $cmd_rest = $';
      my $odat = sget_bdat($nbit, $1);
      $dat = $odat if defined $odat;
    } elsif ($cmd_rest =~ /^[dD]"([+-]?[0-9]+)"/) {
      $cmd_rest = $';
      my $odat = (int $1) & ((1<<$nbit)-1);
      $dat = $odat;
    }
  } else {
    if ($cmd_rest =~ /^([+-]?[0-9]+)\./) {
      $cmd_rest = $';
      my $odat = (int $1) & ((1<<$nbit)-1);
      $dat = $odat;
    } elsif ($dbase == 16 && $cmd_rest =~ /^([0-9a-fA-F]+)/) {
      $cmd_rest = $';
      $dat = hex $1;
    } elsif ($dbase ==  8 && $cmd_rest =~ /^([0-7]+)/) {
      $cmd_rest = $';
      $dat = oct $1;
    } elsif ($dbase ==  2 && $cmd_rest =~ /^([01]+)/) {
      $cmd_rest = $';
      my $odat = sget_bdat($nbit, $1);
      $dat = $odat if defined $odat;
    } elsif ($dbase == 10 && $cmd_rest =~ /^([0-9]+)/) {
      $cmd_rest = $';
      $dat = int $1;
    }
  }

  if (not defined $dat) {
    $cmd_bad = 1;
    print "pi_rri($curmode)-E: cget_gdat error in \"$cmd_rest\" (base=$dbase)\n";
    return undef;
  }

  if (defined $min && $dat < $min) {
    $cmd_bad = 1;
    print "pi_rri($curmode)-E: cget_gdat range error, $dat < $min\n";
    return undef;
  }
  if (defined $max && $dat > $max) {
    $cmd_bad = 1;
    print "pi_rri($curmode)-E: cget_gdat range error, $dat > $max\n";
    return undef;
  }

  return $dat;
}

#-------------------------------------------------------------------------------

sub cget_name {                             # get name \w+

  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^(\w+)/) {
    $cmd_rest = $';
    return $1;
  }

  $cmd_bad = 1;
  print "pi_rri($curmode)-E: cget_name error in \"$cmd_rest\"\n";
  return undef;
}

#-------------------------------------------------------------------------------

sub cget_bool {                             # get boolean [01]
  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^([01])/) {
    $cmd_rest = $';
    return int($1);
  }

  $cmd_bad = 1;
  print "pi_rri($curmode)-E: cget_name error in \"$cmd_rest\"\n";
  return undef;
}

#-------------------------------------------------------------------------------

sub cget_file {                             # get filename [\w\/.]+

  $cmd_rest =~ s/^\s*//;
  if ($cmd_rest =~ /^([\w\/.-]+)/) {
    $cmd_rest = $';
    return $1;
  }

  $cmd_bad = 1;
  print "pi_rri($curmode)-E: cget_file error in \"$cmd_rest\"\n";
  return undef;
}

#-------------------------------------------------------------------------------

sub cget_ucb {                              # get ucb (read name, return ucb)
  my ($type,$name) = @_;

  $name = cget_name() unless defined $name;
  return undef if not defined $name;

  $name = uc($name);
  $name .= "0" if length($name)==2;
  if (not exists $serv11_unittbl{$name}) {
    $cmd_bad = 1;
    print "pi_rri($curmode)-E: unknown device unit $name\n";
    return undef;
  }

  my $ucb = $serv11_unittbl{$name};
  my $ctl = $serv11_ctltbl{$ucb->{ctlname}};

  if (not $ctl->{probe_ok}) {
    $cmd_bad = 1;
    print "pi_rri($curmode)-E: device controller $name not available\n";
    return undef;
  }

  if (defined $type) {
    if ($ctl->{type} ne $type) {
      $cmd_bad = 1;
      print "pi_rri($curmode)-E: $name is not type=$type\n";
      return undef;
    }
  }

  return $ucb;
}

#-------------------------------------------------------------------------------

sub cget_opt {                              # get option
  my ($opt) = @_;
  if ($cmd_rest =~ /^\s*$opt\b/) {          # opt found, followed by non \w
    $cmd_rest = $';
    return 1;
  }
  return 0;
}

#-------------------------------------------------------------------------------

sub cget_optset {                           # get option set
  my ($optset) = @_;
  my $optout = "";
  while ($cmd_rest =~ /\s*-([a-zA-Z])\b/) { # any -x found
    $cmd_rest = $';
    my $optchar = $1;
    if ($optset =~ /$optchar/) {            # char in optset ?
      $optout .= $optchar;
    } else {
      $cmd_bad = 1;
      print "pi_rri($curmode)-E: unexpected option -$optchar\n";
    }
  }
  return $optout;
}

#-------------------------------------------------------------------------------
sub cget_regrange {                         # get register/memory range
  my $ctl;
  my $beg;
  my $end;

  if (cchk_number()) {                      # numerical address
    $beg = cget_gdat(22,8);
    $end = $beg;
    if ($cmd_rest =~ m{^:}) {
      $cmd_rest =~ s{^:}{};
      $end = cget_gdat(22,8);
    } elsif ($cmd_rest =~ m{^/}) {
      $cmd_rest =~ s{^/}{};
      $end = $beg + cget_gdat(22,8) - 2;
    }

  } else {                                  # symbolical address
    my $regtbl;
    my $ctlnam = uc(cget_name());
    my $begnam = lc($ctlnam);
    my $endnam;
    if (exists $serv11_ctltbl{CPU}->{regtbl}->{$begnam}) {
      $ctlnam = "CPU";
      $regtbl = $serv11_ctltbl{CPU}->{regtbl};
    } elsif (exists $serv11_ctltbl{$ctlnam}->{regtbl}) {
      $regtbl = $serv11_ctltbl{$ctlnam}->{regtbl};
      $begnam = lc(cget_name());
    } else {
      print "pi_rri($curmode)-E: '$begnam' neither controller nor" .
        " cpu register name\n";
      $cmd_bad = 1;
      return (undef, undef, undef);
    }

    $ctl     = $serv11_ctltbl{$ctlnam};

    if (not $ctl->{probe_ok}) {
      print "pi_rri($curmode)-E: '$ctlnam' not available\n";
      $cmd_bad = 1;
      return (undef, undef, undef);
    }

    my $reglist = $ctl->{reglist};
    $beg = 0;
    $end = scalar @{$reglist}-1;

    if ($begnam ne "state") {

      $endnam = $begnam;
      if ($cmd_rest =~ m{^:}) {
        $cmd_rest =~ s{^:}{};
        $endnam = lc(cget_name());
      }

      if (not exists $regtbl->{$begnam}) {
        print "pi_rri($curmode)-E: '$begnam' not register in '$ctlnam'\n";
        $cmd_bad = 1;
        return (undef, undef, undef);
      }
      if (not exists $regtbl->{$endnam}) {
        print "pi_rri($curmode)-E: '$endnam' not register in '$ctlnam'\n";
        $cmd_bad = 1;
        return (undef, undef, undef);
      }

      $beg = $regtbl->{$begnam};
      $end = $regtbl->{$endnam};
    }
  }

  if (defined $beg && defined $end && $beg > $end) {
    my $tmp = $beg;
    $beg = $end;
    $end = $tmp;
  }

  return ($ctl, $beg, $end);
}

#-------------------------------------------------------------------------------

sub cchk_number {                           # check for number. any gdat value
                                            # except for plain hex (e.g. 'dead')
  return 1 if $cmd_rest =~ /^\s*([0-9]+)/;
  return 1 if $cmd_rest =~ /^\s*([+-]?[0-9]+)\./;
  return 1 if $cmd_rest =~ /^\s*[xX]"([0-9a-fA-F]+)"/;
  return 1 if $cmd_rest =~ /^\s*[oO]"([0-9]+)"/;
  return 1 if $cmd_rest =~ /^\s*[bB]"([01]+)"/;
  return 1 if $cmd_rest =~ /^\s*[dD]"([+-]?[0-9]+)"/;
  return 0;
}

#-------------------------------------------------------------------------------

sub sget_bdat {                             # convert 01 string -> binary value
  my ($nbit,$str) = @_;
  my $nchar = length($str);
  my $odat = 0;
  my $i;

  return undef if ($nchar != $nbit);

  for ($i = 0; $i < $nchar; $i++) {
    $odat *= 2;
    $odat += 1 if substr($str, $i, 1) eq "1";
  }
  return $odat;
}

#-------------------------------------------------------------------------------

sub conv_etime {                            # generate timestamp string
  my ($ref_elast) = @_;
  my $etime = get_time()-$time0;
  my $str   = sprintf "%12.6f ", $etime;
  if (defined $ref_elast) {
    my $dt = $etime - $$ref_elast;
    $$ref_elast = $etime;
    $str .= sprintf "(%10.6f) ", $dt;
  }
  return $str;
}

#-------------------------------------------------------------------------------

sub conv_dat9 {
  my ($dat9) = @_;
  return (($dat9 & 0x100) ? "1" : "0") . " " . conv_dat8($dat9);
}

#-------------------------------------------------------------------------------

sub conv_dat8 {
  my ($dat8) = @_;
  my $buf = "";
  vec($buf,0,8) = int $dat8;
  return unpack("B8",$buf);
}

#-------------------------------------------------------------------------------

sub conv_str2bytes {                    # string to bytelist; handle \n\r
  my ($str,$dref,$esc) = @_;

  while (length($str)) {
    if ($esc && $str =~ /^\\n/) {
      push @{$dref}, 0015;              # send CR
      $str = $';
    } elsif ($esc && $str =~ /^\\r/) {
      push @{$dref}, 0013;              # send LF
      $str = $';
    } else {
      my $chr = substr($str,0,1);
      push @{$dref}, ord($chr);
      $str = substr($str,1);
    }
  }
}

#-------------------------------------------------------------------------------

sub conv_buf2wlist {                        # string buffer -> word list
  my ($buf) = @_;
  my @sysbyt;
  my $nw = int(length($buf)/2);
  my $dref = [];
  my $i;

  push @sysbyt, unpack("C*", $buf);
  for ($i=0; $i<$nw; $i++) {
    my $bl = shift @sysbyt;                 # lsb is first
    my $bh = shift @sysbyt;
    push @{$dref}, 256*$bh + $bl;
  }
  return $dref;
}

#-------------------------------------------------------------------------------

sub conv_wlist2buf {                        # word list -> string buffer
  my ($dref) = @_;
  my @sysbyt;
  my $buf;

  foreach my $word (@{$dref}) {
    my $bl = $word      & 0xff;
    my $bh = ($word>>8) & 0xff;
    push @sysbyt, $bl;                      # lsb is first
    push @sysbyt, $bh;
  }

  $buf = pack("C*", @sysbyt);
  return $buf;
}

#-------------------------------------------------------------------------------

sub conv_byte2ascii2 {                      # byte -> 2 charcter ASCII display
  my ($byte) = @_;
  if ($byte >= 32 && $byte < 128) {
    return chr($byte) . " ";
  } else {
    my $str = "..";
    $str = "\\0" if $byte == 000;          # NUL  000 -> \0
    $str = "\\a" if $byte == 007;          # BEL  007 -> \a
    $str = "\\b" if $byte == 010;          # BS   010 -> \b
    $str = "\\t" if $byte == 011;          # TAB  011 -> \t
    $str = "\\n" if $byte == 012;          # LF   012 -> \n
    $str = "\\v" if $byte == 013;          # VT   013 -> \v
    $str = "\\f" if $byte == 014;          # FF   014 -> \f
    $str = "\\r" if $byte == 015;          # CR   015 -> \r
    return $str;
  }
}

#-------------------------------------------------------------------------------

sub gconv_dat16 {
  my ($dat,$dbase) = @_;
  if ($dbase == 2) {
    my $bufl = "";
    my $bufh = "";
    vec($bufl,0,8) = int ($dat      & 0xff);
    vec($bufh,0,8) = int (($dat>>8) & 0xff);
    return unpack("B8",$bufh) . unpack("B8",$bufl);
  } elsif ($dbase == 8) {
    return sprintf "%6.6o", int $dat;
  } elsif ($dbase == 16) {
    return sprintf "%4.4x", int $dat;
  } else {
    return "??dbase??";
  }
}
#-------------------------------------------------------------------------------

sub hdl_sigint {                            # SIGINT handler
  if ($sigint_count == 1) {
    print STDERR "\a";                     # send beep
  } elsif ($sigint_count == 2) {
    print STDERR "pi_rri($curmode)-W: not responding on ^C, next will abort\n";
  } elsif ($sigint_count == 3) {
    print STDERR "pi_rri($curmode)-E: ^C abort\n";
    exit(1);
  }
  $sigint_count += 1;
}

#-------------------------------------------------------------------------------

sub get_time {
  my ($sec, $usec) = gettimeofday();
  return $sec + 1.e-6 * $usec;
}

#-------------------------------------------------------------------------------

sub get_timestamp {
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
  return sprintf "%2.2d:%2.2d:%2.2d", $hour, $min, $sec;
}

#-------------------------------------------------------------------------------

sub filename_expand {                       # expand $nnn in name
  my ($file) = @_;
  my $fileexp = $file;

  while($fileexp =~ /\$(\w+)/) {
    if (exists $ENV{$1}) {
      $fileexp = $` . $ENV{$1} . $';
    } else {
      printf "pi_rri-E: environment variable \$%s not defined\n", $1;
      $fileexp = $` . "\$?" . $1 . "?" . $';
    }
  }

  return $fileexp;
}

#-------------------------------------------------------------------------------

sub print_fatal {
  my ($msg) = @_;
  print STDERR "pi_rri($curmode)-F: $msg\n";
  exit 1;
}

#-------------------------------------------------------------------------------

sub print_help {
  print "usage: pi_rri\n";
  print "  --help        this message\n";
  print "  --int         force interactive mode\n";
  print "  --trace       trace\n";

  printf "CPREF %2.2x\n", CPREF;
  printf "NCOMM %2.2x\n", NCOMM;
  printf "CESC  %2.2x\n", CESC;
  printf "CEN1  %2.2x\n", CEN1;

}