#!/usr/bin/perl
# *** X16 Panel FPGA  version 0.09          -- date: Jan 22 2010 ***
#
# History:
# 0.09 (JAN 22 2010) support for fast papertape reader added (09 is the 1st version for X16-03)
# 0.08 (JAN 21 2010) svc_run optimized (08 was the last version for X16-02)
# 0.07 (JAN 19 2010) boot counts chars/sec
# 0.06 (JAN 12 2010) extended mode: 32K support; logging added for trace and ex M
# 0.05 (JAN 10 2010) ldh changed: default the content being loaded is not displayed
# 0.04 (JAN 05 2010) published version using version 0.034 as start
# 
my $version  = "0.09";
my $xversion = "-03";
my $DEBUG    = 0;     # 1 to show debug information; 0 to suppress that info
my $testflag = 0;     # be set to 1 allows testing without the fpga board being connected

# Author : Theo Engel
# Contact: Info@theoengel.nl
#
# Usage:  X16Panel-xx.pl                     (where xx is some version number)
#
# - examine|ex <register>                    (show register content)
# - examine|ex m <address>                   (interactively shows content of <address>, <address>+2, .. until s is replied)
# - deposit|de <register> [<16 bit value>]   (if no content specified, content is requested from the keyboard until s is replied)
# - deposit|de m <address> [<16 bit value>]  (if no content specified, content of <address>, <address>+2, .. is requested from the keyboard until s is replied)
# - mc                                       (master clear; reset the computer to its initial state)
# - step                                     (execute a single instruction)
# - run                                      (execute program, starting with the instruction set in the PC)
# - stop/CntrE                               (stop program execution)
# - state                                    (request state of the cpu in the fpga)
# - trace [n|>]                              (executes a single or n instructions showing state (> executes untill CntrE)
# - ss                                       (sets/resets one or more sense switches)
# - s?                                       (show the sense switches setting)
# - ldhex|ldh <fn>.hex                       (load program into memory from a disk file (file format: absolute hexadecimal))
# - log [on|off] | <file>                    (log command progress in a logfile; off switches logging off; on resumes logging)
# - attach|att ptr|ptp <file>                (attach a file on disk to either the papertape reader or puncher)
# - detach|det ptr|ptp                       (the attached file will be detached from the device and the device is closed)
# - reset ptr|ptp|mem                        (resets the ptr or ptp, or sets the memory to zero)
# - boot                                     (boot from the papertape reader (ptr must be attached to a file with proper papertape format)  
# - mode [hex|h] | [oct|o]                   (set control in/out to either hexadecimal or octal; no argument, shows mode (default=octal))
# - exit                                     (disconnect from fpga and the control program exist; reconnection later is possible)
#
# |    means logical OR
# [..] means OPTIONAL argument
# <address> is hex value of 0..7FFF, or octal value 0..77777
# <register> is PC|P,A,B,X,BP (X=read only: the X=Rgister can be set by changing memory location 0).
# When the TTY is used by the CPU, the key combination CntrE stops the execution of the cpu (like the stop command).
# BP is Breakpoint Register. At the end of the execution of an instruction, BP is compared with PC: the address of the next
# instruction to execute. In case BP and PC are equal, the CPU is stopped.

use strict;
use bytes;
use Term::ReadKey;
use Time::HiRes qw(gettimeofday tv_interval);
use IO::Handle;

#########################################################################################################################
# FTD2XX/JTAG interface on Win32
use Win32::API;
use Carp;
# Future Technology Devices International USB JTAG Windows driver interface
Win32::API->Import( 'ftd2xx', 'ULONG FT_Open(int iDevice, LPHANDLE handle)');
Win32::API->Import( 'ftd2xx', 'ULONG FT_SetLatencyTimer(HANDLE handle, UCHAR latency)');
Win32::API->Import( 'ftd2xx', 'ULONG FT_Read(HANDLE handle, LPCTSTR Buffer, DWORD BytesToRead, LPDWORD BytesRead)');
Win32::API->Import( 'ftd2xx', 'ULONG FT_Write(HANDLE handle, LPCTSTR Buffer, DWORD BytesToWrite, LPDWORD BytesWritten)');
Win32::API->Import( 'ftd2xx', 'ULONG FT_Close(HANDLE handle)');

# JTAG message bytes
# Action
use constant SETUP    => 0x61;
use constant WRITE    => 0x83;
use constant READ     => 0x94;
# Target
use constant LED      => 0xF0;
use constant SEG7     => 0xE1;
use constant SRAM     => 0xA5;
use constant SET_REG  => 0x4C; # Jtag Output Select register
use constant AREG     => 0xA3; # A-Register
use constant BREG     => 0xA9; # B-Register
use constant XREG     => 0xA1; # X-Register
use constant PCREG    => 0xAD; # P-Register = Program Counter
use constant PRREG    => 0xE5; # Breakpoint Register
use constant SWITCHES => 0xF1;
use constant FPTR     => 0xC2; # Fast pepertape reader
# Mode
use constant OUTSEL   => 0x33;
use constant NORMAL   => 0xAA;
use constant DISPLAY  => 0xCC;
#
# JTAG message layout at application level (8 bytes).
#    At FTD2-level the message is packed with header byte for a write command (size | 0x80)
#    and a header byte and trailing bytes for a subsequent read request commnand
#
# Action Target d1 d2 d3 d4 d5 Mode
#
###########################################################
# JTAG application level routines, using USB JTAG Channel 0
###########################################################
#    Open_USB_Port() )
#    Close_USB_Port()  
#    These routines set/reset the variable: $USB_is_Open
my $USB_is_Open = 0;        # port closed
my $Buffer = pack('C', 0);
#
###########################################################
# USB1 device level (uses imported FT_xxx routines)
###########################################################
#    USB1_Open_Device()
#    USB1_Close_Device()
#    USB1_Reset_Device()
#    Init_JTAG()
my $Init_CMD = pack('CCCCC', 0x26,0x27,0x26,0x81,0x00); # init command string
my $USB1_Open = 0;
#
###########################################################
# FTD2XX device level
###########################################################
#    FT_Open(int iDevice, LPHANDLE handle)
#    FT_Close(HANDLE handle)   
#    FT_SetLatencyTimer(HANDLE handle, UCHAR latency)
#    FT_Read(HANDLE handle, LPCTSTR Buffer, DWORD BytesToRead, LPDWORD BytesRead)   
#    FT_Write(HANDLE handle, LPCTSTR Buffer, DWORD BytesToWrite, LPDWORD BytesWritten)
my $DeviceNumber = 0;
my $ft_handle;
my $ft_handle_p  = '1234'; #Preallocate 4 bytes
my $BytesToWrite = 1;
my $BytesWritten = '1234'; #Preallocate 4 bytes
my $BytesToRead;
my $BytesRead    = '1234'; #Preallocate 4 bytes
my $ft_status;
my $txd_buffer;            # string sent from fpga to jtag
#
#############################################################################################
# USB1 device level (uses imported FT_xxx routines)
#############################################################################################

sub USB1_Open_Device {
	if(! $USB1_Open)
	{
		print "Open USB1 device\n";
		$ft_status = FT_Open($DeviceNumber,$ft_handle_p);
		$ft_handle = unpack ('L',$ft_handle_p); # dereference handle
		if($DEBUG) {print "*** FT_Open returned value: $ft_status, DeviceHandle - $ft_handle\n";}
		if($ft_status != 0) 
		{
			print "*** Error-1: USB1 Open; status nonzero\n"; 
			return 0; 
		}
		$ft_status = FT_SetLatencyTimer($ft_handle, 0x02);
		if($DEBUG) {print "*** FT_SetLatencyTime returned value: $ft_status, DeviceHandle - $ft_handle\n";}
		if($ft_status != 0) 
		{ 
			print "*** Error-2: USB1 Open\n"; 			
			return 0; 
		} 
		else 
		{
			print "USB1 device is Open\n";
			$USB1_Open = 1;
			return 1;
		}
	}
	else
	{
		print "USB1 device was already Open\n";
		return 1;
	} 
}

sub USB1_Close_Device {	
	$Buffer = pack('C', 0x1F);
	if($USB1_Open)
	{
		$ft_status = FT_Write($ft_handle, $Buffer, $BytesToWrite, $BytesWritten);
		if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  	if($ft_status != 0) 
  	{ 
 			print "*** Error-1: USB1 Close; status nonzero\n";  		
  		return 0; 
  	}
    $ft_status = FT_Close($ft_handle);
 		if($DEBUG) {print "*** FT_Close returned value: $ft_status, DeviceHandle - $ft_handle\n";}
	  if($ft_status != 0) 
	  { 
 			print "*** Error-2: USB1 Close\n"; 	  	
	  	return 0; 
	  } 
	  else 
	  { 
			print "USB1 device is Closed\n";
			$USB1_Open = 0;  	
	  	return 1; 
	  }
	}
	else
	{
		print "USB1 device was already Closed\n";
		return 1;
	} 	 
}

sub Init_JTAG {
	print "Init JTAG\n";
  $ft_status = FT_Write($ft_handle, $Init_CMD, 5, $BytesWritten); 
	if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
 	if($ft_status != 0) { return 0; } else {return 1;} 
}
 
sub USB1_Reset_Device {
	print "Reset USB1\n";
	if(USB1_Close_Device())
	{
		sleep(1);
		if(USB1_Open_Device())
		{
			if(Init_JTAG())
			{
				 return 1; 
			}
		}
	}
	else 
	{
		return 0;
	} 
}

############################################################################
### JTAG Application level routines
############################################################################
my $rec_buffer = '01234'; #Preallocate 5 bytes

sub Open_USB_Port {
 if(USB1_Reset_Device())
 {
  $USB_is_Open = 1;
  return 1;
 }
 else
 {
 	print "*** Error to open USB JTAG port\n";
 	exit;
 } 		
}

sub Close_USB_Port {
	if($USB_is_Open)
	{
		USB1_Close_Device;		
		$USB_is_Open = 0;
	}
}
############################################################################
## JTAG messages to control the FPGA 
#  (to be used at application level after the USB port is opened)
############################################################################
# Write_LED(red, green) (10 red leds left + 8 green leds right
sub Write_LED {

	my $r = shift;
	my $r1 = $r & 0xFF;
	my $r2 = ($r >> 8) & 0x03;
	my $g = shift;
	$g = $g & 0xFF;
	if($DEBUG) {print "Set the LEDs\n";}
	# JTAG message layout (9 bytes)
  # #Bytes 0x88 Action Target d1 d2 d3 d4 d5 Mode

	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,LED,0x00,$r2,$r1,0x00,$g,DISPLAY);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {print "*** FT_Write returned value: $ft_status\nDeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
 	if($ft_status != 0) { return 0; } else {return 1;} 
}

sub Write_SEG7 {
	my $d = shift;
	if($DEBUG) {print "Set the SEG7 values\n";}
	my $d1= $d & 0xFF;
	my $d2=($d>>8) &0xFF;
	
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,SEG7,0x00,0x00,0x00,$d2,$d1,DISPLAY);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {print "*** FT_Write returned value: $ft_status\nDeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
 	if($ft_status != 0) { return 0; } else {return 1;}   
}

sub JTAG_Output_Select {
	my $Obj = shift;        # Object which is requested to generate output from the FPGA over the JTAG to the PC
	$Obj = $Obj & 0xFF;
  $txd_buffer = pack('CCCCCCCCC', 0x88,SETUP,SET_REG,0x12,0x34,0x56,0x00,$Obj,OUTSEL);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
	if($DEBUG) {	print "*** FT_Write returned value: $ft_status\nDeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";} 
  if($ft_status != 0) { return 0; } else {return 1;}  
}

sub Write_Register {
  # Write_Register(REG,$data)
	my $Reg = shift;
	$Reg = $Reg & 0xFF; 	
	# JTAG message layout (9 bytes)
  # Bytes 0x88 Action Target d1 d2 d3 d4 d5 Mode
  #                                    ^  ^
  #                                   hb lb                                     
	my $data = shift;
	my $hb = ($data >> 8) & 0xFF;
	my $lb = $data & 0xFF;
	if($DEBUG) {print "*** Set Reg value hb:$hb lb:$lb\n";}
		
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,$Reg,0x00,0x00,0x00,$hb,$lb,NORMAL);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle\nBytes Written - ".ord($BytesWritten)."\n";}
  if($ft_status != 0) { return 0; } else {return 1;}  
}

sub Read_Register {
	#  $x = Read_Register(REG)
	my $Reg = shift;
	$Reg = $Reg & 0xFF; 	 	
	my $rec_buffer = '01';
	# link REG to JTAG output
	if($DEBUG) {print "*** Link JTAG output\n";}
	JTAG_Output_Select($Reg);	
	my $b1;
	my $b2;
	if($DEBUG) {print "*** Read request to Register\n";}
	$txd_buffer = pack('CCCCCCCCCCCC', 0x88,READ,$Reg,0x00,0x00,0x00,0x00,0x00,NORMAL,0xC2,0x00,0x00);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 12, $BytesWritten); 
	if($DEBUG) {print "*** FT_Write returned value: $ft_status\nDeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  # the areg-control of control.v sends 1st the low byte, then the high byte
  # chars in the rec_buffer are stored by FT_Read from left to right, so
  # the low byte is stored in position 0 and the high byte in position 1
  $ft_status = FT_Read($ft_handle, $rec_buffer, 2, $BytesRead);
  if($DEBUG) {print "*** FT_Read returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Read - ".ord($BytesRead)."\n";}
  ($b2,$b1) = unpack ('CC', $rec_buffer);
  # lb  hb
  return (($b1 & 0xFF) << 8) + ($b2 & 0xFF) ;
}

sub Write_SRAM {
	my $addr = shift;
	my $data = shift;
	if($DEBUG) {print "Write SRAM\n";}
	my $a1 = ($addr >> 16) & 0xFF;
	my $a2 = ($addr >> 8)  & 0xFF;
	my $a3 = $addr & 0xFF;
	my $d1 = ($data >> 8) & 0xFF;
	my $d2 = $data & 0xFF;
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,SRAM,$a1,$a2,$a3,$d1,$d2,NORMAL);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  if($ft_status != 0) { return 0; } else {return 1;}  
}

sub Read_SRAM {
	my $addr = shift;
	my $rec_buffer = '01';
	# link SRAM to JTAG output
	if($DEBUG) {print "*** Link JTAG output to SRAM\n";}
	JTAG_Output_Select(SRAM);	
	my $a1 = ($addr >> 16) & 0xFF;
	my $a2 = ($addr >> 8)  & 0xFF;
	my $a3 = $addr & 0xFF;
	my $b1;
	my $b2;
	if($DEBUG) {print "Read request to SRAM\n";}
	$txd_buffer = pack('CCCCCCCCCCCC', 0x88,READ,SRAM,$a1,$a2,$a3,0x00,0x00,NORMAL,0xC2,0x00,0x00);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 12, $BytesWritten); 
	if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  # the sram-control of cmd.v sends 1st the low byte, then the high byte
  # chars in the rec_buffer are stored by FT_Read from left to right, so
  # the low byte is stored in position 0 and the high byte in position 1
  $ft_status = FT_Read($ft_handle, $rec_buffer, 2, $BytesRead);
	if($DEBUG) {print "*** FT_Read returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Read - ".ord($BytesRead)."\n";}
  ($b2,$b1) = unpack ('CC', $rec_buffer);
  # lb  hb  
  return (($b1 & 0xFF) << 8) + ($b2 & 0xFF) ;
}

sub Write_SWITCHES {
	# JTAG message layout (9 bytes)
  # Bytes 0x88 Action Target d1 d2 d3 d4 d5 Mode
  #                              ^  ^  ^  ^
  #                             pr ty hb lb 
  # Write_SWITSCHES(lb,hb,ty,pr)
  #####     hb                                    
  # 15 :
  # 14 :
  # 13 :
  # 12 :
  # 11 :
  # 10 :
  # 9  : PTRin (1 => CMD_PTRin has a character for the papertape reader controler)
  # 8  : TTYin (1 => CMD_TTYin has a character for the teletype controler)
  ######    lb (7 msb, 0 lsb) 
  # 7  : Stop (request stop execution of instructions: => CPU sets iRunning=0)
  # 6  : Step (request execution of a single instruction)
  # 5  : Run  (request execution of instructions until HLT or Stop: => CPU sets iRunning=0)
  # 4  : Master Clear
  # 3  : sense switch 1 (left)
  # 2  : sense switch 2 
  # 1  : sense switch 3 
  # 0  : sense switch 4 (right)
  #   
	my $lb = shift; $lb = $lb & 0xFF;
	my $hb = shift;	$hb = $hb & 0xFF;
	my $ttych = shift; $ttych = $ttych & 0xFF;
	my $ptrch = shift; $ptrch = $ptrch & 0xFF;	
	if($DEBUG) {print "Set Switches: ptr=" . prhex(8,$ptrch) . " tty=" . prhex(8,$ttych) . " hb=" . prhex(8,$hb) . " lb=" . prhex(8,$lb) . "\n";}
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,SWITCHES,0x00,$ptrch,$ttych,$hb,$lb,NORMAL);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {*** print "FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  if($ft_status != 0) { return 0; } else {return 1;}    
}

# Read_SWITCHES selects the JTAG output target 1st and then initiates the read request.
sub Read_SWITCHES {
	# link SWITCHES to JTAG output
	if($DEBUG) {print "*** Link JTAG output to SWITCHES\n";}
	JTAG_Output_Select(SWITCHES);
	# 5 bytes are received:  state, IR(2byte) ttyout ptrout ; of which state is the 1st one
  ##state## 7 msb, 0 lsb 
	# 76543210
  # 7: TTYin  request (1 in case TTY requests an input character from the PC=>FPGA)
  # 6: TTYout request (1 in case the TTY requests the PC to get a char from FPGA and print (in byte 4 of this message))
  # 5: PTRin  request (1 in case PTR requests an input character from the PC=>FPGA) 
  # 4: PTPout request (1 in case the PTR requests the PC to get a char from FPGA and punch (in byte 5 of this message))
  # 3: ERROR bit
  # 2: ENB   bit
  # 1: C     bit
  # 0: RUNNING (1 in case CPU is running)
	my ($b0,$b1,$b2,$b3,$b4);
	if($DEBUG) {print "Read request to SWITCHES\n";}
	$txd_buffer = pack('CCCCCCCCCCCCCCC', 0x88,READ,SWITCHES,0x00,0x00,0x00,0x00,0x00,NORMAL,0xC5,0x00,0x00,0x00,0x00,0x00);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 15, $BytesWritten); 
	if($DEBUG) {print "*** FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  $ft_status = FT_Read($ft_handle, $rec_buffer, 5, $BytesRead);
	if($DEBUG) {print "*** FT_Read returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Read - ".ord($BytesRead)."\n";}
  ($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $rec_buffer);
  my $ir = (($b2 & 0xFF) << 8) | ($b1 & 0xFF);
  if($DEBUG) {print "Read Switch: st=" . prhex(8,$b0) . " IR=" . prhex(16,$ir) . " tyo=" . prhex(8,$b3) . " puo=" . prhex(8,$b4) . "\n";}
  return ($rec_buffer);
}

my $txd_buffer1 = pack('CCCCCCCCCCCCCCC', 0x88,READ,SWITCHES,0x00,0x00,0x00,0x00,0x00,NORMAL,0xC5,0x00,0x00,0x00,0x00,0x00);
# Read_SWITCHES-Short assumes that the JTAG output is already selected by a previous JTAG_Output_Select(SWITCHES)
# (short version of Read_SWITCHES to optimise the speed of svc_run)
sub Read_SWITCHES_Short {
	# 5 bytes are received:  state, IR(2byte) ttyout ptrout ; of which state is the 1st one
  ##state## 7 msb, 0 lsb 
	# 76543210
  # 7: TTYin  request (1 in case TTY requests an input character from the PC=>FPGA)
  # 6: TTYout request (1 in case the TTY requests the PC to get a char from FPGA and print (in byte 4 of this message))
  # 5: PTRin  request (1 in case PTR requests an input character from the PC=>FPGA) 
  # 4: PTPout request (1 in case the PTR requests the PC to get a char from FPGA and punch (in byte 5 of this message))
  # 3: ERROR bit
  # 2: ENB   bit
  # 1: C     bit
  # 0: RUNNING (1 in case CPU is running)
	$ft_status = FT_Write($ft_handle, $txd_buffer1, 15, $BytesWritten); 
  $ft_status = FT_Read($ft_handle, $rec_buffer, 5, $BytesRead);
  return ($rec_buffer);
}

sub Write_FPTR {
	# JTAG message layout (9 bytes)
  # Bytes 0x88 Action Target d1 d2 d3 d4 d5 Mode
  #                           ^  ^  ^  ^  ^
  #                          b4 b3 b2 b1 b0 <= 5 bytes read by PTR and transferred to FPGA in 0ne block 
  # Write_FPTR (b0,b1,b2,b3,b4)
	my ($b0,$b1,$b2,$b3,$b4);
	$b0=shift;$b1=shift;$b2=shift;$b3=shift; $b4=shift; # 5 bytes to tranfer over the JTAG
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,FPTR,$b4,$b3,$b2,$b1,$b0,NORMAL);
	$ft_status = FT_Write($ft_handle, $txd_buffer, 9, $BytesWritten); 
  if($DEBUG) {*** print "FT_Write returned value: $ft_status, DeviceHandle - $ft_handle, Bytes Written - ".ord($BytesWritten)."\n";}
  if($ft_status != 0) { return 0; } else {return 1;}    	
}	


#################################################################################################################
# ascii conversion table
my %ch;
$ch{0x20}=' ';
$ch{0x21}='!';
$ch{0x22}="\"";
$ch{0x23}="\#";
$ch{0x24}='$';
$ch{0x25}='%';
$ch{0x26}='&';
$ch{0x27}="\'";
$ch{0x28}='(';
$ch{0x29}=')';
$ch{0x2a}='*';
$ch{0x2b}='+';
$ch{0x2c}=',';
$ch{0x2d}='-';
$ch{0x2e}='.';
$ch{0x2f}="\/";
$ch{0x30}='0';
$ch{0x31}='1';
$ch{0x32}='2';
$ch{0x33}='3';
$ch{0x34}='4';
$ch{0x35}='5';
$ch{0x36}='6';
$ch{0x37}='7';
$ch{0x38}='8';
$ch{0x39}='9';
$ch{0x3a}="\:";
$ch{0x3b}="\;";
$ch{0x3c}='<';
$ch{0x3d}='=';
$ch{0x3e}='>';
$ch{0x3f}='?';
$ch{0x40}='@';
$ch{0x41}='A';
$ch{0x42}='B';
$ch{0x43}='C';
$ch{0x44}='D';
$ch{0x45}='E';
$ch{0x46}='F';
$ch{0x47}='G';
$ch{0x48}='H';
$ch{0x49}='I';
$ch{0x4a}='J';
$ch{0x4b}='K';
$ch{0x4c}='L';
$ch{0x4d}='M';
$ch{0x4e}='N';
$ch{0x4f}='O';
$ch{0x50}='P';
$ch{0x51}='Q';
$ch{0x52}='R';
$ch{0x53}='S';
$ch{0x54}='T';
$ch{0x55}='U';
$ch{0x56}='V';
$ch{0x57}='W';
$ch{0x58}='X';
$ch{0x59}='Y';
$ch{0x5a}='Z';
$ch{0x5b}='[';
$ch{0x5c}="\\";
$ch{0x5d}=']';
$ch{0x5e}='^';
$ch{0x5f}='_';

 # digit conversion
my %cvdig;             
$cvdig{'0'}=0x0;
$cvdig{'1'}=0x1;
$cvdig{'2'}=0x2;
$cvdig{'3'}=0x3;
$cvdig{'4'}=0x4;
$cvdig{'5'}=0x5;
$cvdig{'6'}=0x6;
$cvdig{'7'}=0x7;
$cvdig{'8'}=0x8;
$cvdig{'9'}=0x9;
$cvdig{'A'}=0xa;
$cvdig{'B'}=0xb;
$cvdig{'C'}=0xc;
$cvdig{'D'}=0xd;
$cvdig{'E'}=0xe;
$cvdig{'F'}=0xf;

my $RUNCPU=0; # 1 if CPU is running; HLT, Stop, or Breakpoint Equal to PC set $RUNCPU to 0
my $nrr;      # # read switches between console and running CPU
# elapsed runtime measurement
my @t0;		    # start point elapsed time measurement during run command
my $secs;     # run elapsed time in secs
my $cps;      # cycles per second during run command

# device control block layout
use constant FILE     => 15;
use constant FC       => 16;

# device control block declaration
my @PTR;
my @PTP;
$PTR[FILE]      = "";                   # attached file (name; 0 if not attached/inoperable)
$PTR[FC]=0;                             # file handle of attached file
$PTP[FILE]      = "";                   # attached file (name; 0 if not attached/inoperable)
$PTP[FC]=0;                             # file handle of attached file

######################### Console controller ################################
# CPU register values, etc
my $leds;		# 10 red leds left + 8 green leds right
my $A;  # A register
my $B;  # B register
my $XR; # X register (copied from M[0] in flipflop register)
my $XM; # X register (as in memory location 0)
my $P;  # program counter
my $BP; # preset breakpoint register
# switches: ptrin ttyin stop step run mc ss1 ss2 ss3 ss4
my $Switch;
my $CpuActive;
my $ssr;
my ($b0,$b1,$b2,$b3,$b4);
my $ssch;
my $error_ptr=0;
my $error_ptp=0;
my $nlcr=0;	
my $nch=0; # number of chars read by ptr
my ($ch0,$ch1,$ch2,$ch3,$ch4); # 5 bytes to be send to Fast PTR CU in FPGA
	  
# run service routine (JTAG output mus already be selected!)
sub svc_run {
	  $ssr = Read_SWITCHES_Short(); # read 5 bytes: state, IR(2byte) ttyout ptpout
    $nrr=$nrr+1; # count number of ReadSwitches
		($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $ssr);
  	# my $IR = (($b2 & 0xFF) << 8) | ($b1 & 0xFF); # instruction register
  	# my $RUN = ($b0 & 1);
  	# my $C   = ($b0 & 2) >> 1;  # c bit
  	# my $ENB = ($b0 & 0x04);  # enb bit
  	# my $ERR = ($b0 & 0x08);  # error bit
  	my $PU  = ($b0 & 0x10);  # papertape punch request
  	my $PR  = ($b0 & 0x20);  # papertape reader request
  	my $TYO = ($b0 & 0x40);  # tty output request
  	my $TYI = ($b0 & 0x80);  # tty input request

  	if($PR) # papertape reader request
  	{
  		if($PTR[FC] != 0)
  		{ 
				# Fast PTR code
  			$ch0=read_ptr(); $ch1=read_ptr(); $ch2=read_ptr(); $ch3=read_ptr(); $ch4=read_ptr();  # read 5 bytes
  			$nch=$nch+5;
  			if($ch0 != 0) # 0 => EOT
  			{
  				$ch0 = $ch0 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					print "\nPapertape reader: EOT\n";
  					$error_ptr=1;  				
  				}
  			} 			
  			if($ch1 != 0) # 0 => EOT
  			{
  				$ch1 = $ch1 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					print "\nPapertape reader: EOT\n";
  					$error_ptr=1;  				
  				}
  			} 		
  			if($ch2 != 0) # 0 => EOT
  			{
  				$ch2 = $ch2 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					print "\nPapertape reader: EOT\n";
  					$error_ptr=1;  				
  				}
  			} 
  			if($ch3 != 0) # 0 => EOT
  			{
  				$ch3 = $ch3 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					print "\nPapertape reader: EOT\n";
  					$error_ptr=1;  				
  				}
  			}
  			if($ch4 != 0) # 0 => EOT
  			{
  				$ch4 = $ch4 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					print "\nPapertape reader: EOT\n";
  					$error_ptr=1;  				
  				}
  			} 
  			# print prhex(8,$ch0) . prhex(8,$ch1) . prhex(8,$ch2) . prhex(8,$ch3) . prhex(8,$ch4) . "\n";
  			Write_FPTR($ch0,$ch1,$ch2,$ch3,$ch4);
  		}
  		else
  		{
  			if($error_ptr==0)
  			{
  				print "\nPTR request, but not attached\n";
  				$error_ptr=1;  				
  			}
  		}  			
  	}
  	if($PU) # papertape punch request
  	{
  		if($PTP[FC] != 0)
  		{
          punch_ptp($b4); # punch the byte
        }			
  		else
  		{
  			if($error_ptp == 0)
  			{
  				print "PTP request, but not attached\n";
  				$error_ptp=1;  	  				
  			}
  		}   			
  	}
    # tty service 
    # - read/print tty characters
    # - stop by pressing the stop key CntrE  	
  	# listen to Cntr E, etc ($b3 is byte to print, if there)	  
	  my $key;
	  my $k=0;

		if(defined ($key = ReadKey(-1)))
		{
			$k = ord ($key);
		}
		if($TYI)
		{
			# input request
			if($nlcr)
			{
      	        Write_SWITCHES($Switch,1,$nlcr,0);	
				# print "\n";	      			
				$nlcr=0;
			}
			elsif($k)
			{
				# ENTER provides 0A under Unix and 0D under Windows
				if($k == 0xA)     
				{
					print "\n";
					$nlcr=0xA;
					Write_SWITCHES($Switch,1,0xD,0);
				}
				elsif($k == 0xD)
				{
					print "\n";
					$nlcr=0xA;
					Write_SWITCHES($Switch,1,0xD,0);			
				}
				elsif($k == 5)
				{
					Write_SWITCHES($Switch,1,0,0); # dummy when stop in input mode
				}					
				else
				{
					print UP($key);
					Write_SWITCHES($Switch,1,ord(UP($key)),0);
				}
			}
		}
		if($TYO)
		{
			# output request
			$b3 = $b3 & 0x7F;
			if($b3 == 0xD)
			{
				# print "\r";
			}
			elsif($b3 == 0xA)
			{
				print "\n";
			}
			elsif(($b3 > 0x1F) && ($b3 < 0x60))    # printable characters 
			{
				print chr($b3);
			}
		}
		if((defined $key) && ($k == 5))  # CntrE => Stop
		{
			if(CpuIsInactive())
			{
				print "Cpu is already inactive\n";
			}
			else
			{
				$Switch = $Switch | 0x80; # set CPU Stop bit
				Write_SWITCHES($Switch,0,0,0);
				$Switch = $Switch & 0x0F; # save the sense switch setting	
				print "\nKeyboard interrupt\n";
			}
			$RUNCPU = 0;		
		}
 		if(! ($b0 & 1)) 
		{
  		$RUNCPU = 0;          # cpu stopped
  	}
}

##############################################################################
print "**X16 Panel, version $version **X16$xversion (32kW)**\n";

my $cmd;      # command string
my $mode="O"; # H=hex O=octal (default)
my $logfile=""; # currently trace and examine M can be logged
my $log=0;    # default, no logging
my $file;
my $n;
my $m;
my $s;
my @w; 		    # itemized command string
@w = @ARGV;   # possible initial do string

if($testflag == 0) {
	Open_USB_Port;
}

while(1)
{
	# read a command
	prlog( "> " );
	$cmd = <STDIN>;
	cmdlog($cmd);
	chop $cmd;
	@w = split(/ /, $cmd);

	if(UP($w[0]) eq "TSF") # for debugging only
	{
		$testflag = 1;
		print "Testflag set\n";
	}
	elsif(UP($w[0]) eq "TFR") # for debugging only
	{
		$testflag = 0;
		print "Testflag reset\n";		
	}
	elsif(UP($w[0]) eq "MODE")
	{
		if(UP($w[1]) eq "HEX" || UP($w[1]) eq "H")
		{
			$mode = "H";
		}
		elsif(UP($w[1]) eq "OCT" || UP($w[1]) eq "O")
		{
			$mode = "O";
		}
		else
		{
			print "Mode is: " . $mode . "\n";
		}			
	}
	elsif(UP($w[0]) eq "LOG")
	{
		if($w[1] ne "")
		{
			if(UP($w[1]) eq "ON" || UP($w[1]) eq "OFF")
			{
				if(UP($w[1]) eq "ON")
				{
					if($logfile ne "")
					{
						$log=1;
					  print "Set LOG ON, LOG in existing $logfile\n";						
					}
					else
					{
						print "No logfile specified\n";
					}
				}
				if(UP($w[1]) eq "OFF")
				{
					$log=0;
				}
			}
			else
			{
				if($logfile ne "")
				{
					close LOG || die "can't close $logfile: $!";
					print "Previous logfile $logfile is closed\n";	
				}
				$logfile = $w[1];
				if(! open (LOG, ">$logfile"))
				{
					print "Cannot open the new logfile: $logfile\n";
					$logfile = "";					
				}
				else
				{
					$log = 1;
					print "Set LOG ON, LOG dumped in $logfile\n";
				}
			}																			
		}
		else
		{
			print "Invalid parameter; use: log [on|off] | <file>\n";
		}
	}
	elsif(UP($w[0]) eq "LOGTEXT")
	{
		print LOG "***********************************************************************\n"; 
	}		
  elsif(UP($w[0]) eq "EXAMINE" || UP($w[0]) eq "EX")
	{
		if(CpuIsInactive())
		{
			if(UP($w[1]) =~ /^M/)
			{
				$s = UP($w[2]);
				if($mode eq "H")
				{
					$s=cvhex($s);
				}
				else
				{
					$s=cvoct($s);
				}				
				if($s >= 0)
				{
					$s=$s & 0x7FFF;
					while(1)
					{
						$m=Read_SRAM($s);
						
						if($mode eq "H")
						{
							prlog("Addr:" . prhex(16,$s) . " Data:" . prhex(16,$m) . " " . DecodeIR($m) . " .");
						}
						else
						{
							prlog("Addr:" . proct($s) . " Data:" . proct($m) . " " . DecodeIR($m) . " .");
						}
						$m = <STDIN>;
						cmdlog($m);
						$s = $s + 1;
						if(($m =~ /s/) || ($s > 0x7FFF))
						{
							last;
						}
					}
				}
				else
				{
					prlog("No valid address (mode is:" . $mode . "\n");
				}
			}
			elsif(UP($w[1]) eq "A")
			{
				$A=Read_Register(AREG);
				if($mode eq "H")
				{
					prlog("$w[1] = " . prhex(16,$A) . "\n");
				}
				else
				{
					prlog("$w[1] = " . proct($A) . "\n");
				}					
			}
			elsif(UP($w[1]) eq "B")
			{
				$B=Read_Register(BREG);	
				if($mode eq "H")
				{
					prlog("$w[1] = " . prhex(16,$B) . "\n");
				}
				else
				{
					prlog("$w[1] = " . proct($B) . "\n");
				}						
			}	
			elsif(UP($w[1]) eq "X")
			{
				$XR=Read_Register(XREG);
				$XM=Read_SRAM(0x0000);
				if(	$mode eq "H")
				{
					prlog("$w[1] = " . prhex(16,$XM) . "(Xm)" . prhex(16,$XR) . "(Xr)\n");
				}
				else
				{
					prlog("$w[1] = " . proct($XM) . "(Xm)" . proct($XR) . "(Xr)\n");
				}					
			}					
			elsif(UP($w[1]) eq "PC" || UP($w[1]) eq "P")
			{
				$P=Read_Register(PCREG);
				if(	$mode eq "H")
				{
					prlog( "$w[1] = " . prhex(16,$P) . "\n" );
				}
				else
				{
					prlog( "$w[1] = " . proct($P) . "\n" );
				}					
			}
			elsif(UP($w[1]) eq "BP")
			{
				$BP=Read_Register(PRREG);
				if(	$mode eq "H")
				{
					prlog("$w[1] = " . prhex(16,$BP) . "\n");
				}
				else
				{
					prlog("$w[1] = " . proct($BP) . "\n");
				}					
			}					
			else
			{
				prlog("Wrong memory or register reference $w[1]\n");
			}
		}
		else
		{
			prlog("CPU is active: reading a Register or Memory is disabled\n");
		}
	}
	elsif(UP($w[0]) eq "DEPOSIT" || UP($w[0]) eq "DE")
	{		
		if(CpuIsInactive())
		{
			if(UP($w[1]) =~ /^M/)
			{
				$s = UP($w[2]);               # address
				$m = UP($w[3]);               # content				
				if($mode eq "H")
				{
					$s=cvhex($s);
					$m=cvhex($m);
				}
				else
				{
					$s=cvoct($s);
					$m=cvoct($m);
				}																						
				if($s >= 0)
				{
				  $s=$s & 0x7FFF; # 32 k words maximum							
					if($m >= 0)
					{
				    $m=$m & 0xFFFF;									
						if($mode eq "H")
						{
							print "Set Memory, Addr = " . prhex(16,$s) . " Data = " . prhex(16,$m) . " " . DecodeIR($m) ."\n";
						}
						else
						{
							print "Set Memory, Addr = " . proct($s) . " Data = " . proct($m) . " " . DecodeIR($m) ."\n";	
						}						
						Write_SRAM($s,$m);
					}
					else
					{
						# read content from keyboard
						while($s<0x4000)
						{
							$m = Read_SRAM($s); # read existing content
							if($mode eq "H")
							{
								print prhex(16, $s) . "  " . prhex(16,$m) . " " . DecodeIR($m) . " ? ";
							}
							else
							{
								print proct($s) . "  " . proct($m) . " " . DecodeIR($m) . " ? ";
							}							
							$m = <STDIN>;
							if($m =~ /s/)
							{
								last;                 # stop
							}
							elsif($m =~ /[\da-fA-F]/)
							{
								chomp $m;
								$m=UP($m);
								if($mode eq "H")
								{
									$m=cvhex($m);
								}
								else
								{
									$m=cvoct($m);
								}								
								if($m >= 0)
								{
									$m=$m & 0xFFFF;							
									Write_SRAM($s,$m);
   							}
								else
								{
									print "Wrong content (mode is:" . $mode . ")\n";
									$s = $s - 1;       # redo current address
								}
							}
							$s = $s + 1;
						}
					}
				}
				else
				{
					print "Wrong address (mode is:" . $mode . "\n";
				}
			}
			elsif(UP($w[1]) eq "A")
			{
				if($w[2] eq undef)
				{
					prlog( "$w[1] = ");
					$s = <STDIN>;			# input 16 bit hex number
					cmdlog($s);
					chomp $s;
					$s = UP($s);
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}																														
					if($s >= 0)
					{
					  $s=$s & 0xFFFF;																																			
						$A=$s;
						if($mode eq "H")
						{
							prlog( "Set A-Register to: " . prhex(16,$A) . "\n");
						}
						else
						{
							prlog( "Set A-Register to: " . proct($A) . "\n");
						}						
						Write_Register(AREG,$A);
					}
					else
					{
						prlog( "Error input number (mode is:" . $mode . ")\n");
					}
				}
				else
				{
					$s = UP($w[2]);                   # content			
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}												
					if($s >= 0)
					{
					  $s=$s & 0xFFFF;																																			
						$A=$s;
						if($mode eq "H")
						{
							prlog( "Set A-Register to: " . prhex(16,$A) . "\n");
						}
						else
						{
							prlog( "Set A-Register to: " . proct($A) . "\n");
						}						
						Write_Register(AREG,$A);
					}
					else
					{
						prlog( "Error input number (mode is:" . $mode . ")\n");
					}					
				}
				print_stopped_state();			
			}
			elsif(UP($w[1]) eq "B")
			{
				if($w[2] eq undef)
				{
					print "$w[1] = ";
					$s = <STDIN>;			# input 16 bit hex number
					chomp $s;
					$s = UP($s);
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0xFFFF;																																			
						$B=$s;
						if($mode eq "H")
						{
							print "Set B-Register to: " . prhex(16,$B) . "\n";
						}
						else
						{
							print "Set B-Register to: " . proct($B) . "\n";
						}						
						Write_Register(BREG,$B);
					}
					else
					{
						print "Error input number (mode is:" . $mode . ")\n";
					}
				}
				else
				{
					$s = UP($w[2]);                   # content
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0xFFFF;																																			
						$B=$s;
						if($mode eq "H")
						{
							print "Set B-Register to: " . prhex(16,$B) . "\n";
						}
						else
						{
							print "Set B-Register to: " . proct($B) . "\n";
						}						
						Write_Register(BREG,$B);
					}
					else
					{
						print "Error input number (mode is:" . $mode . ")\n";
					}					
				}
				print_stopped_state();			
			}			
			elsif(UP($w[1]) eq "PC" || UP($w[1]) eq "P")
			{
				if($w[2] eq undef)
				{
					prlog( "$w[1] = ");
					$s = <STDIN>;			# input 16 bit hex number
					cmdlog($s);
					chomp $s;
					$s = UP($s);
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0x7FFF;																																			
						$P=$s;
						if($mode eq "H")
						{
							prlog( "Set PC-Register to: " . prhex(16,$P) . "\n");
						}
						else
						{
							prlog( "Set PC-Register to: " . proct($P) . "\n");
						}						
						Write_Register(PCREG,$P);
					}
					else
					{
						prlog( "Error input number (mode is:" . $mode . ")\n");
					}
				}
				else
				{
					$s = UP($w[2]);                   # content
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0x7FFF;																																			
						$P=$s;
						if($mode eq "H")
						{
							prlog("Set PC-Register to: " . prhex(16,$P) . "\n");
						}
						else
						{
							prlog("Set PC-Register to: " . proct($P) . "\n");
						}						
						Write_Register(PCREG,$P);
					}
					else
					{
						prlog("Error input number (mode is:" . $mode . ")\n");
					}					
				}
				print_stopped_state();			
			}
			elsif(UP($w[1]) eq "BP")			
			{
				if($w[2] eq undef)
				{
					prlog("$w[1] = ");
					$s = <STDIN>;			# input 16 bit hex number
					cmdlog($s);
					chomp $s;
					$s = UP($s);
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0x7FFF;																																			
						$BP=$s;
						if($mode eq "H")
						{
							prlog( "Set BP-Register to: " . prhex(16,$BP) . "\n");
						}
						else
						{
							prlog( "Set BP-Register to: " . proct($BP) . "\n");
						}						
						Write_Register(PRREG,$BP);
					}
					else
					{
						prlog( "Error input number (mode is:" . $mode . ")\n");
					}
				}
				else
				{
					$s = UP($w[2]);                   # content
					if($mode eq "H")
					{
						$s=cvhex($s);
					}
					else
					{
						$s=cvoct($s);
					}													
					if($s >= 0)
					{
					  $s=$s & 0x7FFF;																																			
						$BP=$s;
						if($mode eq "H")
						{
							prlog( "Set BP-Register to: " . prhex(16,$BP) . "\n");
						}
						else
						{
							prlog( "Set BP-Register to: " . proct($BP) . "\n");
						}						
						Write_Register(PRREG,$BP);
					}
					else
					{
						prlog( "Error input number (mode is:" . $mode . ")\n");
					}					
				}
				print_stopped_state();			
			}			
			else
			{
				prlog( "Wrong register $w[1]\n");
			}
		}
		else
		{
			prlog( "CPU is active: writing a Register or Memory is disabled\n");
		}
	}
	elsif(UP($w[0]) eq "MC")
	{
		if(CpuIsInactive())
		{
			$Switch = $Switch | 0x10; # set master clear bit
			Write_SWITCHES($Switch,0,0,0);
			$Switch = $Switch & 0x0F; # save the sense switch setting
			print_stopped_state();			
		}
		else
		{
			prlog( "Cpu is active; Master Clear not allowed\n");
		}
  }
  elsif(UP($w[0]) eq "RUN")
	{
		if(CpuIsInactive())
		{
			print "Run, TTY switched to CPU\n";
			@t0 = gettimeofday ();             # fix t0 to measure elapsed time			
			
			$RUNCPU = 1;                       # reset by a stopped CPU
			ReadMode 4;                        # prepare console mode
			STDOUT->autoflush(1);              # for MSWin32
			$Switch = $Switch | 0x20;          # set CPU Run bit
			Write_SWITCHES($Switch,0,0,0);
			$Switch = $Switch & 0x0F;          # save the sense switch setting
			$nrr    = 0;                       # reset number of READ-SWITCHES	
			$nch    = 0;                       # reset number of chars read by ptr	
			$error_ptr=0;		                   # reset PTR error
			$error_ptp=0;		                   # reset PTP error
      JTAG_Output_Select(SWITCHES);      # select JTAG output
      
      # while the CPU on the FPGA board is running, keep in contact with
      # the board to check its state and to serve the peripherals.			
			while($RUNCPU)
			{
				svc_run();
			}
			ReadMode 0;                        # reset console
			STDOUT->autoflush(0);              # for MSWin32
			$secs = tv_interval (\@t0);        # elapsed run time in secs
			if($secs > 0)
			{			
			  $nrr = sprintf("%.0f",($nrr / $secs)); # round
			  $nch = sprintf("%.0f",($nch / $secs)); # round					
			}
			print_stopped_state();
      prlog( "CPU stopped; TTY switched to Panel\n");
			prlog( "$nrr ReadSwitches per second; $nch cps on PTR\n");
		}
		else
		{
			prlog("Cpu is already active; Run not allowed\n");
		}
  }
	elsif(UP($w[0]) eq "STEP" || UP($w[0]) eq "S")
	{
		if(CpuIsInactive())
		{
	  	$Switch = $Switch | 0x40; # set the CPU Step bit
		  Write_SWITCHES($Switch,0,0,0);
		  $Switch = $Switch & 0x0F; # save the sense switch setting
			print_stopped_state();
		}
		else
		{
			  prlog("Cpu is active; Step not allowed\n");
		}		
  } 
	elsif(UP($w[0]) eq "STOP")
	{
		if(CpuIsInactive())
		{
			prlog("Cpu is already inactive\n");
		}
		else
		{
			$Switch = $Switch | 0x80; # set stop bit
			Write_SWITCHES($Switch,0,0,0);
			$Switch = $Switch & 0x0F; # save the sense switch setting	
			print_stopped_state();
		}
  } 
	elsif(UP($w[0]) eq "STATE")
	{
		print_stopped_state();
	}
  elsif(UP($w[0]) eq "SS")
	{
			if($w[1] eq undef)
			{
				print "Set Sense Switches 1234 as a 4 bit hex number (0-F): ";
				$s = <STDIN>;			# input hex number
				chomp $s;
				$s = UP($s);
				if( (($s=cvhex($s)) >= 0) && ($s < 16))
				{
					print "Set Sense Switches 1234 to: " . prhex(4,$s) . "\n";
					$Switch=$s;
				  Write_SWITCHES($Switch,0,0,0);						
				}
				else
				{
					print "Error input hex number\n";
				}
			}
			else
			{
				$s = UP($w[1]);                   # content
				if( (($s=cvhex($s)) >= 0) && ($s < 16))
				{
					print "Set Sense Switches 1234 to: " . prhex(4,$s) . "\n";
					$Switch=$s;
				  Write_SWITCHES($Switch,0,0,0);						
				}
				else
				{
					print "Error input hex number\n";
				}
			}
	}
	elsif(UP($w[0]) eq "S?")
	{
		prlog("Sense Switches S1234=" . prhex(4,$Switch) . "\n");
	}
	elsif(UP($w[0]) eq "LDHEX" || UP($w[0]) eq "LDH")
	{
		my $s0;
		my $s1;
		if(CpuIsInactive())
		{		
			if($w[1] ne undef)
			{
				if(UP($w[1]) eq "S")
				{
					# show content of file while loading
					if($w[2] =~ /.hex/)
					{
						if(! open (FHX, $w[2]))
						{
							print "Unable to open file: $w[2]\n";
						}
						else
						{
							while($s=<FHX>)
							{
								chop $s;
								($s0,$s1) = split(/\,/,$s); #             $s0=addr, $s1=content ##############  space => ,
								$s0=cvhex($s0) & 0x7FFF; 
								$s1=cvhex($s1);
								print prhex(16,$s0) . " " . prhex(16,$s1) . "  octal:" . proct($s0) . " " . proct($s1) . "\n";				
			    			Write_SRAM($s0,$s1);
							}
						}
					}
					else
					{
						print "No proper filename is specified: syntax is: ldhex|ldh [s] <fn>.hex\n";
					}					
				}
				else
				{
					if($w[1] =~ /.hex/)
					{
						if(! open (FHX, $w[1]))
						{
							print "Unable to open file: $w[1]\n";
						}
						else
						{
							while($s=<FHX>)
							{
								chop $s;
								($s0,$s1) = split(/\,/,$s); #             $s0=addr, $s1=content ##############  space => ,
								$s0=cvhex($s0) & 0x7FFF; 
								$s1=cvhex($s1);
								# print prhex(16,$s0) . " " . prhex(16,$s1) . "  octal:" . proct($s0) . " " . proct($s1) . "\n";				
			    			Write_SRAM($s0,$s1);
							}
						}
					}
					else
					{
						print "No proper filename is specified: syntax is: ldhex|ldh [s] <fn>.hex\n";
					}
				}
			}
			else
			{
				print "No parameters specified: syntax is: ldhex|ldh [s] <fn>.hex\n";
			}
		}
		else
		{
			print "Load Program: CPU is active; Load not allowed\n";
		}		
	}
	elsif(UP($w[0]) eq "ATTACH" || UP($w[0]) eq "ATT")
	{
		if(UP($w[1]) eq "PTR")
		{
			$file = $w[2];
			if($file eq "")
			{
				print "No proper filename\n";
			}
			else
			{
				if($PTR[FILE] ne "")
				{
					close ($PTR[FC]) || die "can't close $PTR[FILE]: $!";
					print "File $PTR[FILE] detached from device PTR and closed\n";
					$PTR[FILE] = "";         # file detached and closed; device inoperable	
				}
				if(! open (PTR, $file))
				{
					print "Cannot open papertape input file: $file\n";
					$PTR[FILE]="";
					$PTR[FC]=0;					
				}
				else
				{
					$PTR[FC] = \*PTR;
					binmode $PTR[FC], ":raw";
					print "File $file attached to device PTR\n";
					$PTR[FILE] = $file;           # file attached and open
				}
			}
		}	
		elsif(UP($w[1]) eq "PTP")
		{
			$file = $w[2];
			if($file eq "")
			{
				print "No proper filename\n";
			}
			else
			{
				if($PTP[FILE] ne "")
				{
					close ($PTP[FC]) || die "can't close ($PTP[FILE]: $!";
					print "File $PTP[FILE] detached from device PTP and closed\n";
					$PTP[FILE] = "";         # file detached and closed; device inoperable	
				}				
				if(! open (PTP, ">:raw", $file))
				{
					print "Cannot open papertape punch file: $file\n";
					$PTP[FILE]="";
					$PTP[FC]=0;
				}
				else
				{
					$PTP[FC] = \*PTP;
					print "File $file attached to device PTP\n";
					$PTP[FILE] = $file;		      # file attached and open
				}
			}				
		}	
		else
		{
			print "Unsupported device $w[1] requested for file attachement\n";
		}
	}	
	elsif(UP($w[0]) eq "DETACH" || UP($w[0]) eq "DET")
	{
		if(UP($w[1]) eq "PTR")
		{
			$file = $PTR[FILE];
			if($file eq "")
			{
				print "Device PTR not attached\n";
			}
			else
			{
				close ($PTR[FC]) || die "can't close $file: $!";
				print "File $file detached from device PTR and closed\n";
				$PTR[FILE] = "";         # file detached and closed; device inoperable
				$PTR[FC]=0;	
			}
		}
		elsif(UP($w[1]) eq "PTP")
		{
			$file = $PTP[FILE];
			if($file eq "")
			{
				print "Device PTP not attached\n";
			}
			else
			{
				close ($PTP[FC]) || die "can't close $file: $!";
				print "File $file detached from device PTP and closed\n";			
				$PTP[FILE] = "";			# file detached and closed; device inoperable	
				$PTP[FC]=0;	
			}				
		}		
		else
		{
			print "Unsupported device $w[1]\n";
		}
	}			
	elsif(UP($w[0]) eq "RESET")
	{	
		if(UP($w[1]) eq "PTP")
		{
			reset_ptp();
		}
		elsif(UP($w[1]) eq "PTR")	
		{
			reset_ptr();
		}
		elsif(UP($w[1]) eq "MEM")
		{
			my $k=0;
			while($k<0x8000)
			{
				Write_SRAM($k,0);		
				$k=$k+1;
			}
		}
		else
		{
			prlog ("Unsupported device $w[1]\n");
		}
	}
  elsif(UP($w[0]) eq "TRACE")	
  {
  	my $nlcr = 0;
  	my $delay = 0;
  	my $k;
  	my $t;
  	my $key;
  	my $error_ptr=0;
  	my $error_ptp=0;
  	my $nbr;
  	my ($ch0,$ch1,$ch2,$ch3,$ch4);
  	
  	if($w[1] eq "")
  	{
  		$nbr=1;
  	}
  	elsif($w[1] eq '>')
  	{
  		$nbr=-1 # continues until CntrE or HLT
  	}
  	else
  	{
  		$nbr=cvdec($w[1]);
  	}
  	
  	$RUNCPU=1;
  	
  	while($RUNCPU)
  	{
  		$nbr=$nbr-1; 
  		$Switch = $Switch | 0x40; # set the CPU Step bit
	  	Write_SWITCHES($Switch,0,0,0);
	  	$Switch = $Switch & 0x0F; # save the sense switch setting
			
	  	my $s = Read_SWITCHES(); # read 5 bytes
	  	my ($b0,$b1,$b2,$b3,$b4);
    	($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $s);
 	  	my $IR = (($b2 & 0xFF) << 8) | ($b1 & 0xFF); # instruction register
 	  	my $RUN = ($b0 & 1);
 	  	my $C   = ($b0 & 2) >> 1;  # c bit
 	  	my $ENB = ($b0 & 0x04);    # enb bit
    	my $ERR = ($b0 & 0x08);    # error bit
    	my $PU  = ($b0 & 0x10);    # papertape punch request
    	my $PR  = ($b0 & 0x20);    # papertape reader request
 	  	my $TYO = ($b0 & 0x40);    # tty output request
 	  	my $TYI = ($b0 & 0x80);    # tty input request 			
	  	$P=Read_Register(PCREG);
	  	$A=Read_Register(AREG);	
	  	$B=Read_Register(BREG);
	  	$XR=Read_Register(XREG);
	  	$XM=Read_SRAM(0x0000);
	  	if($mode eq "H")
			{
				if($log)
				{
					prlog("P" . prhex(16,$P) . " IR" . prhex(16,$IR) . " " . DecodeIR($IR) . " A" . prhex(16,$A) . " B" . prhex(16,$B) ." C" . prhex(4,$C) . " Xm" . prhex(16,$XM) . " Xr". prhex(16,$XR));
				}
				else
				{
					# prlog("P" . prhex(16,$P) . " IR" . prhex(16,$IR) . " A" . prhex(16,$A) . " B" . prhex(16,$B) ." C" . prhex(4,$C) . " Xm" . prhex(16,$XM) . " Xr". prhex(16,$XR));
					prlog("P" . prhex(16,$P) . " IR " .  DecodeIR($IR) . " A" . prhex(16,$A) . " B" . prhex(16,$B) ." C" . prhex(4,$C) . " Xm" . prhex(16,$XM) . " Xr". prhex(16,$XR));

				}
			}
			else
			{
				if($log)
				{
					prlog("P" . proct($P) . " IR" . proct($IR) . " " . DecodeIR($IR) . " A" . proct($A) . " B" . proct($B) ." C" . prbit($C) . " Xm" . proct($XM) . " Xr". proct($XR));
				}
				else
				{
					#prlog("P" . proct($P) . " IR" . proct($IR) . " A" . proct($A) . " B" . proct($B) ." C" . prbit($C) . " Xm" . proct($XM) . " Xr". proct($XR));					
					#prlog("P" . proct($P) . " IR " . DecodeIR($IR) . " A" . proct($A) . " B" . proct($B) ." C" . prbit($C) . " Xm" . proct($XM) . " Xr". proct($XR));
					prlog("P" . proct($P) . " IR " . DecodeIR($IR) . " A" . proct($A) . " B" . proct($B) ." C" . prbit($C) . " Xm" . proct($XM));
				}
			}
      if($RUN){ prlog(" R")}  else { prlog(" H")};
			if($ENB){ prlog(" E")}  else { prlog("  ")};
			if($ERR){ prlog(" ER")} else { prlog("   ")};
			if($TYO){ prlog(" TO")} else { prlog("   ")};
			if($TYI){ prlog(" TI")} else { prlog("   ")};		
			if($PU) { prlog(" PU")} else { prlog("   ")};
			if($PR) { prlog(" PR")} else { prlog("   ")};
      prlog("\n");			  
	  	if($RUN){ prlog("\n***Warning: ERROR STATE, Cpu remains active\n");}
	  	if($ERR){ prlog("\n***Warning: ERROR STATE, Error bit is 1\n");}			  	  	
    
	  	if($RUN == 0 && $ERR == 0) # RUN==0 is OK because we are stepping (RUN must be 0 after STEP)
	  	{
				ReadMode 4;                        # prepare console mode
				STDOUT->autoflush(1);              # for MSWin32
				if(defined ($key = ReadKey(-1)))
				{
					$k = ord ($key);
					if($k == 5)
					{
						$RUNCPU=0;
					}
				}
				ReadMode 0;                        # reset console
			  STDOUT->autoflush(0);              # for MSWin32									  		
  			if($PR) # papertape reader request
  			{
  				if($PTR[FC] != 0)
  				{
						# Fast PTR code
  					$ch0=read_ptr(); $ch1=read_ptr(); $ch2=read_ptr(); $ch3=read_ptr(); $ch4=read_ptr();  # read 5 bytes
  					if($ch0 != 0) # 0 => EOT
  					{
  						$ch0 = $ch0 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							print "\nPapertape reader: EOT\n";
  							$error_ptr=1;  				
  						}
  					} 			
  					if($ch1 != 0) # 0 => EOT
  					{
  						$ch1 = $ch1 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							print "\nPapertape reader: EOT\n";
  							$error_ptr=1;  				
  						}
  					} 		
  					if($ch2 != 0) # 0 => EOT
  					{
  						$ch2 = $ch2 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							print "\nPapertape reader: EOT\n";
  							$error_ptr=1;  				
  						}
  					} 
  					if($ch3 != 0) # 0 => EOT
  					{
  						$ch3 = $ch3 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							print "\nPapertape reader: EOT\n";
  							$error_ptr=1;  				
  						}
  					}
  					if($ch4 != 0) # 0 => EOT
  					{
  						$ch4 = $ch4 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							print "\nPapertape reader: EOT\n";
  							$error_ptr=1;  				
  						}
  					} 
  					Write_FPTR($ch0,$ch1,$ch2,$ch3,$ch4);
  					prlog("ptr=>:" . prhex(8,$ch0) . prhex(8,$ch1) . prhex(8,$ch2) . prhex(8,$ch3) . prhex(8,$ch4) . "\n");  					
  				}
  				else
  				{
  					if($error_ptr==0)
  					{
  						print "\nPTR request, but not attached\n";
  						$error_ptr=1;  				
  					}
  				}
  			}  			  					
  			if($PU) # papertape punch request
  			{
  				if($PTP[FC] != 0)
  				{
        	  punch_ptp($b4); # punch the byte
      		}			
  				else
  				{
  					if($error_ptp == 0)
  					{
  						prlog( "\nPTP request, but not attached\n" );
  						$error_ptp=1;  	  				
  					}
  				}   			
  			}
 				if($TYO) # Tty output request
				{
					# output mode
					$b3 = $b3 & 0x7F;
					if($b3 == 0xD)
					{
						prlog( "Tty output character:0xD\r" );
					}
					elsif($b3 == 0xA)
					{
						prlog( "Tty output character:0xA\n" );
					}
					else
					{
						prlog("Tty output character:");
						prlog( chr($b3));
						
					}
					prlog("\n");
				}
 				if($TYI) # Tty input request
				{
					# input mode	
					$delay=$delay-1;		
					if($nlcr && ($delay == 0))
					{
	      		Write_SWITCHES($Switch,1,$nlcr,0);			
						$nlcr=0;
					}
					else
					{
						prlog("Tty input character requested\n");
						if(defined ($key))
						{
							$k=ord(UP($key));
							prlog("Tty input(octal):" . proct($k));
	  					prlog( " (char) ."); prlog(chr($k)); prlog(".\n");
	  					# ENTER provides 0A under Unix and 0D under Windows
							if($k == 0xA)     
							{
								prlog("\n");
								$nlcr=0xA;
								# delay during TRACE sending nlcr for 3 steps otherwise TTY immediately busy after INA 
								$delay=4; 
								Write_SWITCHES($Switch,1,0xD,0);
							}
							elsif($k == 0xD)
							{
								prlog("\n");
								$nlcr=0xA;
								# delay during TRACE sending nlcr for 3 steps otherwise TTY immediately busy after INA 
								$delay=4; 								
								Write_SWITCHES($Switch,1,0xD,0);			
							}	
							else
							{
								Write_SWITCHES($Switch,1,$k,0);
							}
						}
					}#else
				}#if	  							
     	}#if($RUN == 0 && $ERR == 0)
      else
      {
      	$RUNCPU=0; #stop if RUN==1 or ERR==1 or CntrE
      }
      if($RUNCPU == 1 && $nbr == 0)
      {
      	# trace next?
      	$nbr=1;
        prlog(" ?");
			  $m = <STDIN>;
			  cmdlog($m);
			  if($m =~ /s/ || $m == 5)
			  {
				  last;                 # stop
			  }
			}
			if($nbr < 0)              # $nbr < 0 for continues trace only: stop on HLT??
			{
				if($IR==0)
				{
					$RUNCPU=0;
					print "*** HLT instruction stopped the trace ***\n";
				}
				$nbr = -1;
			}      	
  	}#while($RUNCPU)
  }
	elsif(UP($cmd) eq "BOOT")
	{
		if(CpuIsInactive())
		{
			if($PTR[FC] != 0)
			{
				# 93 FF 00 00 93 FF is stop pattrn
				my $p1=0; my $p2=0, my $p3=0, my $p4=0, my $p5=0; my $p6=0;
				my $ssch;
				my $nc  = 0;	
				my $ncs = 0;			
				# put the PTR Keyin Loader into RAM
				Write_SRAM(0x0001,0x102F); # STA '57   (010057) SAVE START ADDRESS
				Write_SRAM(0x0002,0x3001); # OCP 1     (030001) START PTR
				Write_SRAM(0x0003,0xB201); # INA '1001 (131001) CRA AND INPUT BYTE
				Write_SRAM(0x0004,0x0403); # JMP *-1   (002003) WAIT UNTIL READY
				Write_SRAM(0x0005,0x8220); # SNZ       (101040) LEADER?
				Write_SRAM(0x0006,0x0403); # JMP *-3   (002003) YES, READ NEXT BYTE
				Write_SRAM(0x0007,0x1000); # STA 0     (010000) SAVE POINTER
				Write_SRAM(0x0008,0xB201); # INA '1001 (131001) CRA AND INPUT BYTE
				Write_SRAM(0x0009,0x0408); # JMP *-1   (002010) WAIT UNTIL READY
				Write_SRAM(0x000A,0x4338); # LGL 8     (041470) TO UPPER BYTE								
				Write_SRAM(0x000B,0xB001); # INA 1     (130001) INPUT BYTE
				Write_SRAM(0x000C,0x040B); # JMP *-1   (002013) WAIT UNTIL READY
				Write_SRAM(0x000D,0x9000); # STA* 0    (110000) STORE OVER POINTER
				Write_SRAM(0x000E,0x2800); # IRS 0     (024000) INCREMENT POINTER
				Write_SRAM(0x000F,0x8020); # SZE       (100040) STOP READING WHEN A==0
                                   # JMP '10   1ST INSTRUCTION LOADED: READ NEXT
                # Master Clear
				$Switch = $Switch | 0x10;       # set master clear bit
				Write_SWITCHES($Switch,0,0,0);
				$Switch = $Switch & 0x0F;       # save the sense switch setting	
				# Program Counter = 1
				Write_Register(PCREG,1);
				# Run		
				$Switch = $Switch | 0x20;       # set CPU Run bit
				Write_SWITCHES($Switch,0,0,0);
				$Switch = $Switch & 0x0F;       # save the sense switch setting
			  $RUNCPU = 1;                    # reset by a stopped CPU				
 				$error_ptr=0;  
			  @t0 = gettimeofday ();          # fix t0 to measure elapsed time			

				my $ssr = Read_SWITCHES(); # read 5 bytes: state, IR(2byte) ttyout ptpout
				my ($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $ssr);
				my $PU  = ($b0 & 0x10);  # papertape punch request
 				my $PR  = ($b0 & 0x20);  # papertape reader request
 				my $TYO = ($b0 & 0x40);  # tty output request
 				my $TYI = ($b0 & 0x80);  # tty input request
 		
 				if($PR) # papertape reader request				
 				{
 					while($RUNCPU && ($error_ptr == 0))
 					{
 						$ssch=read_ptr(); # read byte from file
 						if($ssch != 0)
 						{
 							$nc=$nc+1;
 							$ssch=$ssch & 0xFF;
 							
 							Write_SWITCHES($Switch,2,0,$ssch); # and write to fpga
 							# print "$nc " . prhex(16,$ssch) . "\n";
              # stop ? six last character read:
 							$p1=$p2; $p2=$p3; $p3=$p4; $p4=$p5; $p5=$p6; $p6=$ssch;
 							if($p1 == 0x93 && $p2 == 0xFF && $p3 == 0 && $p4 == 0 && $p5 == 0x93 && $p6 == 0xFF)
 							{
 								$RUNCPU = 0;
 							}
 							print "$nc \r";
 						}
 						else
 						{
 							if($error_ptr==0)
 							{
 								prlog("Papertape reader: EOT\n");
 								$error_ptr=1;  				
 							}
  					}
  				}
  			}				
	  		if($PU || $TYO || $TYI) # other reqeust: ERROR
			  {
          prlog("Error: Unexpected device event\n");
 				}
 				else
 				{
 					# CPU stopped
 					$secs = tv_interval (\@t0);        # elapsed run time in secs
					if($secs > 0)
					{			
			  		$ncs = sprintf("%.0f",($nc / $secs)); # round					
					}
					prlog("\n");
					prlog("CPU stopped: $nc characters read from PTR ($ncs char/sec)\n");
					print_stopped_state();
				}
			}
			else
			{
				prlog("Boot: No Boot file is attached to the Papertape Reader\n");
			}
	  }
		else
		{
			prlog("Boot: CPU is active; Boot not allowed\n");
		}	  			
	}	
	elsif(UP($cmd) eq "KEYIN")
	{
		if(CpuIsInactive())
		{
			Write_SRAM(0x0001,0x102F); # STA '57   (010057) SAVE START ADDRESS
			Write_SRAM(0x0002,0x3001); # OCP 1     (030001) START PTR
			Write_SRAM(0x0003,0xB201); # INA '1001 (131001) CRA AND INPUT BYTE
			Write_SRAM(0x0004,0x0403); # JMP *-1   (002003) WAIT UNTIL READY
			Write_SRAM(0x0005,0x8220); # SNZ       (101040) LEADER?
			Write_SRAM(0x0006,0x0403); # JMP *-3   (002003) YES, READ NEXT BYTE
			Write_SRAM(0x0007,0x1000); # STA 0     (010000) SAVE POINTER
			Write_SRAM(0x0008,0xB201); # INA '1001 (131001) CRA AND INPUT BYTE
			Write_SRAM(0x0009,0x0408); # JMP *-1   (002010) WAIT UNTIL READY
			Write_SRAM(0x000A,0x4338); # LGL 8     (041470) TO UPPER BYTE								
			Write_SRAM(0x000B,0xB001); # INA 1     (130001) INPUT BYTE
			Write_SRAM(0x000C,0x040B); # JMP *-1   (002013) WAIT UNTIL READY
			Write_SRAM(0x000D,0x9000); # STA* 0    (110000) STORE OVER POINTER
			Write_SRAM(0x000E,0x2800); # IRS 0     (024000) INCREMENT POINTER
			Write_SRAM(0x000F,0x8020); # SZE       (100040) STOP READING WHEN A==0
                                       # JMP '10   1ST INSTRUCTION LOADED: READ NEXT
            prlog("Keyin loader for PTR loaded\n");
		}
	}
	elsif((UP($cmd) eq "EXIT"))
	{
		if($testflag == 0)
		{
			if(CpuIsInactive())
			{
				Close_USB_Port;
				prlog ("EXIT!\n");
			  if($logfile ne "")
			  {
					close LOG || die "can't close $logfile: $!";
					print "Logfile $logfile is closed\n";	
				}				
			  exit;
			}
			else
			{
				prlog ("CPU still active; Stop 1st, then Exit\n");
			}
		}
		else
		{
			prlog ("EXIT!\n");
			if($logfile ne "")
			{
				close LOG || die "can't close $logfile: $!";
				print "Logfile $logfile is closed\n";	
			}
			exit;
		}	
	}
	else
	{
		prlog("Unknown command\n");
	}
	@w = (); # reset
}

###########################################################################
# logging
sub prlog {
	my $s=shift;
	print $s;
	if($log)
	{
		print LOG $s;
	}
}
# commands not echo'd to console
sub cmdlog{
 my $s=shift;
	if($log)
	{
		print LOG $s;
	}
}
###########################################################################
sub CpuIsInactive {
    my $s = Read_SWITCHES(); # read 5 bytes
	my ($b0,$b1,$b2,$b3,$b4);
	($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $s);
    my $IR = (($b2 & 0xFF) << 8) | ($b1 & 0xFF);
    my $C  = ($b0 & 2) >> 1;
    if($DEBUG) {print "IR=" . prhex(16,$IR) . " C=" . prhex(4,$C) . "\n";}
    if($b0 & 1) 
	{
		$CpuActive=1;
	 	if($DEBUG) {print "*** CPU is Active\n";}
	} 
	else 
	{
		$CpuActive=0;
	 	if($DEBUG) {print "CPU is InActive\n";}
	}
	if($CpuActive==0) {return 1;} else {return 0;}
}

############################################################################
sub print_stopped_state
{
	my $s = Read_SWITCHES(); # read 5 bytes
	my ($b0,$b1,$b2,$b3,$b4);
	($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $s);
 	my $IR = (($b2 & 0xFF) << 8) | ($b1 & 0xFF); # instruction register
 	my $RUN = ($b0 & 1);
 	my $C   = ($b0 & 2) >> 1;  # c bit
 	my $ENB = ($b0 & 0x04);  # enb bit
 	my $ERR = ($b0 & 0x08);  # error bit
 	my $PU  = ($b0 & 0x10);  # papertape punch request
 	my $PR  = ($b0 & 0x20);  # papertape reader request
   	my $TYO = ($b0 & 0x40);  # tty output request
   	my $TYI = ($b0 & 0x80);  # tty input request 		
	$P=Read_Register(PCREG);
	$A=Read_Register(AREG);	
	$B=Read_Register(BREG);	
	$XR=Read_Register(XREG);
	$XM=Read_SRAM(0x0000);
	prlog("\n");
	if($mode eq "H")
	{
		prlog("P" . prhex(16,$P) . " IR" . prhex(16,$IR) . " A" . prhex(16,$A) . " B" . prhex(16,$B) ." C" . prhex(4,$C) . " Xm" . prhex(16,$XM) . " Xr". prhex(16,$XR));
	}
	else
	{
		prlog("P" . proct($P) . " IR" . proct($IR) . " A" . proct($A) . " B" . proct($B) ." C" . prbit($C) . " Xm" . proct($XM) . " Xr". proct($XR));				
	}
    if($RUN){ prlog(" R")}  else { prlog(" H")};
	if($ENB){ prlog(" E")}  else { prlog("  ")};
	if($ERR){ prlog(" ER")} else { prlog("   ")};
	if($TYO){ prlog(" TO")} else { prlog("   ")};
	if($TYI){ prlog(" TI")} else { prlog("   ")};		
	if($PU) { prlog(" PU")} else { prlog("   ")};
	if($PR) { prlog(" PR")} else { prlog("   ")};
  prlog("\n");			  
  if($RUN){ prlog("\n***Warning: ERROR STATE, Cpu remains active\n");}
  if($ERR){ prlog("\n***Warning: ERROR STATE, Error bit is 1\n");}			  
}

sub prx { 
my $v = shift;
my $s = sprintf ("%x", $v);
print $s;
}

sub prhex {
	# print hex
	# $n is number of bits
	# $v is value
	my $n = shift;
	my $v = shift;
	my $s;
	if($n == 0)
	{
		return "";
	}
	elsif($n<5)
	{
		$s = sprintf(" %01X", $v);	
	}
	elsif($n<9)
	{
		$s = sprintf(" %02X", $v);
	}
	elsif($n<13)
	{		
		$s = sprintf(" %03X", $v);
	}
	elsif($n<17)
	{		
		$s = sprintf(" %04X", $v);
	}
	elsif($n<21)
	{
		$s = sprintf(" %05X", $v);
	}
	elsif($n<25)
	{						
		$s = sprintf(" %06X", $v);
	}
	elsif($n<29)
	{		
		$s = sprintf(" %07X", $v);
	}
	elsif($n<33)
	{
		$s = sprintf(" %08X", $v);
	}
	# print "prhex: $s ";
	return $s;
}

sub rtrim {
	my $s = shift;
	my $l = length($s);
	my $i = $l;
	if ($l > 0)
	{
		while($i > 0)
		{
			if((substr($s,$i-1,1)) ne " ")
			{ 
				last;
			}
			else
			{
				$i=$i-1;
			}
		}
	}
	else
	{
		return "";
	}
	if($i == 0)
	{
		return "";
	}
	else
	{
		return substr($s,0,$i);
	}
}

sub proct
{
	# convert 16bit number into an  octal string
	my $n=shift;
	$n=$n & 0xFFFF;
	my $d1=$n >> 15 + "0";
	my $d2= (($n >> 12) & 0x7) + "0";
	my $d3= (($n >>  9) & 0x7) + "0";
	my $d4= (($n >>  6) & 0x7) + "0";	
	my $d5= (($n >>  3) & 0x7) + "0";	
	my $d6= ($n & 0x7) + "0";
	return " " . $d1 . $d2 . $d3 . $d4 . $d5 . $d6;
}

sub prbit
{
	# convert single bit number to string
	my $n=shift;
	my $d=" 0";
	$n=$n & 1;
	if($n)
	{
		$d=" 1";
	}
	return $d;
}
		   
sub prdec
{
	# print number
	# $n is number of digits (string)
	# $v is value
	my $n = shift;
	my $v = shift;
	my $s;
	my $format="\%0" . $n . "d";
	$s = sprintf($format, $v);
	# print "$s ";
	return "  $s  ";
}

# convert hex string in expression to binary (1 leading space allowed)
sub cvhex
{
	my $s = UP(shift);
	my $i = 0;
	my $r=0;
	my $d=0;
	my $c=substr($s,$i,1);
    if($c eq ' ')
    {
        $i=$i+1;
        $c=substr($s,$i,1);
    }
	if($c =~ /[0-9A-F]/ )	# at least 1 hex digit required
	{
		while (($c = substr($s,$i,1)) =~ /[0-9A-F]/)
		{
			$d = $cvdig{$c};
			$r = ($r << 4) + $d;
			$i = $i + 1;
		}	
		if ($r > 0xFFFF)
		{
			return -1;
		}
		return $r;
	}
	else
	{
		return -1;
	}
}

# convert decimal string in expression to binary
sub cvdec
{
	my $s = shift;
	my $i = 0;
	my $r=0;
	my $d=0;
	my $c;
	if(($c=substr($s,$i,1)) =~ /[0-9]/ )	# at least 1 hex digit required
	{
		while (($c = substr($s,$i,1)) =~ /[0-9]/)
		{
			$d = $cvdig{$c};
			$r = ($r * 10) + $d;
			$i = $i + 1;
		}
		if ($r > 0xFFFF)
		{
			return -1;
		}
		return $r;
	}
	else
	{
		return -1;
	}
}

# convert octal string in expression to binary
sub cvoct
{
	my $s = shift;
	my $i = 0;
	my $r=0;
	my $d=0;
	my $c;
	if(($c=substr($s,$i,1)) =~ /[0-7]/ )	# at least 1 octal digit required	
	{
		while (($c = substr($s,$i,1)) =~ /[0-7]/)		
		{
			$d = $cvdig{$c};
			$r = ($r << 3) + $d;
			$i = $i + 1;	
		}
		if ($r > 0xFFFF)
		{
			return -1;
		}
		return $r;
	}
	else
	{
		return -1;
	}
}

# translate string to upper case
sub UP {
	my $s = shift;
    $_ = $s;
	tr/a-z/A-Z/;
	return $s = $_;
}

sub DecodeIR {
	# generates string of 12 characters
  my $IR = shift;
  my $opcode = ($IR & 0x3C00) >> 10;
  my $flag = ($IR & 0x8000) >> 15;
  my $tag  = ($IR & 0x4000) >> 14;
  my $page = ($IR & 0x0200) >> 9;
  my $io   = ($IR & 0xC000) >> 14;
  my $sc;    # shift count
  my $shc;   # shift code
  my $S="";  # output string
  my $d1; my $d2; my $d3; my $d4;
  my $error = 0;
  
  if($opcode == 0x1)
  {
  	# JMP
  	$S = $S . "JMP";
  }
  elsif($opcode == 0x2)
  {
  	# LDA
  	$S = $S . "LDA";  	 
  }
  elsif($opcode == 0x3)
  {
  	# ANA
  	$S = $S . "ANA";  	
  }
  elsif($opcode == 0x4)
  {
  	# STA
  	$S = $S . "STA";  	
  }
  elsif($opcode == 0x5)
  {
  	# ERA
  	$S = $S . "ERA";  	 
  }
  elsif($opcode == 0x6)
  {
  	# ADD
  	$S = $S . "ADD";  	
  }
  elsif($opcode == 0x7)
  {
  	# SUB
  	$S = $S . "SUB";  	
  }
  elsif($opcode == 0x8)
  {
  	# JST
  	$S = $S . "JST";  	 
  }
  elsif($opcode == 0x9)
  {
  	# CAS
  	$S = $S . "CAS";  	
  }
  elsif($opcode == 0xA)
  {
  	# IRS
  	$S = $S . "IRS";  	
  }
  elsif($opcode == 0xB)
  {
  	# IMA
  	$S = $S . "IMA";  	 
  }
  elsif($opcode == 0xC)
  {
  	# IO
  	if($io == 0)
  	{
  		$S = $S . "OCP";
  	}
  	elsif($io == 1)
  	{
  		$S = $S . "SKS";
  	}
  	elsif($io == 2)
  	{
  		$S = $S . "INA";
  	}  	  	   	
  	elsif($IR == 0xF010)
  	{
  		$S = $S . "SMK";
  	}   	 
  	elsif($IR == 0xF210)
  	{
  		$S = $S . "OTK";
  	}
  	else
  	{
   		$S = $S . "OTA"; 
   	}		  	
  }
  elsif($opcode == 0xD)
  {
  	# XXX LDX/STX
  	if($tag)
  	{
  		$S = $S . "LDX";
  	}
  	else
  	{
   		$S = $S . "STX";
   	}
  }
  
  if($opcode == 0x0)
  {
  	# generic of shift
  	if( ($IR & 0xC000) == 0x4000)
  	{
  		# shift
  		$sc =$IR & 0x003F; $sc= ((~ $sc) + 1) & 0x003F; # shift count
  		$shc=($IR & 0x03C0) >> 6;                       # shift code
  		if   ($shc == 0xE) {$S=$S . "ALR";}
  		elsif($shc == 0xD) {$S=$S . "ALS";} 
  		elsif($shc == 0x6) {$S=$S . "ARR";} 
    	elsif($shc == 0x5) {$S=$S . "ARS";} 
  		elsif($shc == 0xA) {$S=$S . "LLR";} 		
    	elsif($shc == 0x9) {$S=$S . "LLS";} 
  		elsif($shc == 0xC) {$S=$S . "LGL";} 
    	elsif($shc == 0x4) {$S=$S . "LGR";} 
  		elsif($shc == 0x8) {$S=$S . "LLL";}  						
  		elsif($shc == 0x0) {$S=$S . "LRL";} 
    	elsif($shc == 0x2) {$S=$S . "LRR";} 
  		elsif($shc == 0x1) {$S=$S . "LRS";}
   		else { $S = $S . "**SH*" . "     " . "**" ; $error=1; }  # 12 chars

   		if($error == 0)
   		{
   			$S = $S . prdec(2,$sc);
   			$S = $S . "   ";
   		} 		  		  		
  	}
  	else
  	{
  		if   ($IR == 0x0000) { $S=$S . "HLT"; }
  		elsif($IR == 0x0009) { $S=$S . "DXA";	}
  		elsif($IR == 0x000B) { $S=$S . "EXA";	}
  		elsif($IR == 0x0023) { $S=$S . "INK";	}
   		elsif($IR == 0x0081) { $S=$S . "IAB";	} 		
  		elsif($IR == 0x0101) { $S=$S . "ENB";	}  			
  		elsif($IR == 0x0201) { $S=$S . "INH";	} 		
  		elsif($IR == 0x8000) { $S=$S . "SKP";	}
   		elsif($IR == 0x8001) { $S=$S . "SRC";	} 		
  		elsif($IR == 0x8002) { $S=$S . "SR4";	}  			
  		elsif($IR == 0x8004) { $S=$S . "SR3";	}  		
  		elsif($IR == 0x8008) { $S=$S . "SR2";	}  			
  		elsif($IR == 0x8010) { $S=$S . "SR1";	}  	  		
   		elsif($IR == 0x801E) { $S=$S . "SSR";	}
   		elsif($IR == 0x8020) { $S=$S . "SZE";	} 		
  		elsif($IR == 0x8040) { $S=$S . "SLZ";	}  			
  		elsif($IR == 0x8100) { $S=$S . "SPL";	} 		
  		elsif($IR == 0x8200) { $S=$S . "NOP";	}
   		elsif($IR == 0x8201) { $S=$S . "SSC";	} 		
  		elsif($IR == 0x8202) { $S=$S . "SS4";	}  			
  		elsif($IR == 0x8204) { $S=$S . "SS3";	}  		
  		elsif($IR == 0x8208) { $S=$S . "SS2";	}  			
  		elsif($IR == 0x8210) { $S=$S . "SS1";	}  		
     	elsif($IR == 0x821E) { $S=$S . "SSS";	}
   		elsif($IR == 0x8220) { $S=$S . "SNZ";	} 			
  		elsif($IR == 0x8240) { $S=$S . "SLN";	} 		
  		elsif($IR == 0x8300) { $S=$S . "SMI";	}
   		elsif($IR == 0xC014) { $S=$S . "CHS";	} 		
  		elsif($IR == 0xC020) { $S=$S . "CRA";	}  		
  		elsif($IR == 0xC040) { $S=$S . "SSP";	}  			
  		elsif($IR == 0xC080) { $S=$S . "RCB";	}		
  		elsif($IR == 0xC0D0) { $S=$S . "CSA";	} 		
  		elsif($IR == 0xC101) { $S=$S . "CMA";	}
   		elsif($IR == 0xC140) { $S=$S . "SSM";	} 		
  		elsif($IR == 0xC180) { $S=$S . "SCB";	}  			
  		elsif($IR == 0xC224) { $S=$S . "CAR";	}  		
  		elsif($IR == 0xC228) { $S=$S . "CAL";	}  			
  		elsif($IR == 0xC260) { $S=$S . "ICL";	}  		
     	elsif($IR == 0xC286) { $S=$S . "AOA";	}
   		elsif($IR == 0xC28E) { $S=$S . "ACA";	} 			
  		elsif($IR == 0xC2A0) { $S=$S . "ICR";	} 		
  		elsif($IR == 0xC2E0) { $S=$S . "ICA";	}
   		elsif($IR == 0xC107) { $S=$S . "TCA";	}  # 1 100 000 100 000 111
   		else { $S = $S . "**G *" . "     " . "**" ; $error=1; }  # 12 chars   		
   		
   		if($error == 0)
   		{
   			$S = $S . "         ";
   		}
 	}
  }
  elsif($opcode == 0xC)
  {
    if( $IR == 0xF210)
    {
    	$S = $S . "         "; # OTK
    }
    else
    {
      # device address
      $d1=(($IR >>  9) & 0x1) + "0";                  # address (4  octads)
      $d2=(($IR >>  6) & 0x7) + "0";
      $d3=(($IR >>  3) & 0x7) + "0";
      $d4=($IR & 0x7) + "0";
      $S=$S . "  " . $d1 . $d2 . $d3 . $d4 . "   ";
    }
  }
  elsif($opcode == 0xE || $opcode == 0xF) #xxx* 1nnn,1 " 12 chars
	{
        # ... ERROR
        $S = $S . "**OP*" . "     " . "**" ; # 12 chars
	}
  else 
  {
  	# MR: generate address
  	if($flag){$S=$S . "* ";}	else{$S=$S . "  ";}   # indirect addressing
  	if($page){$S=$S . "1";}	  else{$S=$S . "0";}    # page bit
  	$d1=(($IR >>  6) & 0x7) + "0";                  # address (3 octads)
    $d2=(($IR >>  3) & 0x7) + "0";		 
    $d3=($IR & 0x7) + "0";
    $S=$S . $d1 . $d2 . $d3;
    if($tag)
    {
    	if($opcode == 0xD){$S=$S . "   ";} else{$S=$S . ",1 ";}  # index 
    }
    else
    {
    	$S=$S . "   ";
    }
  }
  return $S;
}
	
# read octad from papertape, attached to filecode PTR
sub read_ptr {
	my $c;
	if(	read($PTR[FC],$c,1) )
	{
		$c = unpack("C", $c); 	         # get next char
		return (($c & 0xFF) | 0x8000);   # nonzero if not eot
	}
	else
	{
		return 0;
	}
}

sub reset_ptr {
	# if attached, reattach (set file at load point)
	if($PTR[FILE] ne "")
	{
		$file = $PTR[FILE];
		close ($PTR[FC]) || die "can't close $file: $!";
		open (PTR, $file) || die "Cannot open papertape inputfile $file: $!";
		$PTR[FC] = \*PTR;
		binmode $PTR[FC], ":raw";	
		print "File $file reattached to device PTR\n";
	}
	else
	{
		print "No file attached to device PTR\n";
	}
}

# punch a byte on papertape connected to filecode PTP
sub punch_ptp {
    my($a) = @_;
    my $byte;
	my $fc = $PTP[FC];
    $byte = pack("C", ($a & 0xFF) );
    print $fc $byte;
}
    
sub reset_ptp {
	# if attached, reattach
	if($PTP[FILE] ne "")
	{
		$file = $PTP[FILE];
		close ($PTP[FC]) || die "can't close $file: $!";
		open (PTP, ">:raw", $file) || die "Cannot open paper punch file $file: $!";	
		$PTP[FC] = \*PTP;
		print "File $file reattached to device PTP\n";
	}
	else
	{
		print "No file attached to device PTP\n";
	}
}