#!/usr/bin/perl
# *** P856 Panel FPGA  version 0.021          -- date: Jan 03 2012 ***
#
# 
my $version  = "0.021";	# version number of this P856 Panel program
my $xversion = "-023";	# version number of the toplevel module of the P856 fpga implementation
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
#
# modifications:
# ==============
# version 0.011 (March 05 2010)
# -  initial version
# version 0.012 (March 18 2010)
# - adds the panel interrupt support
# version 0.013 (August 23 2010)
# - add the dump memory command
# version 0.014 (Oct 18 2010)
# - add load command
# version 0.015 (Oct 20 2010)
# - add boot command
# version 0.016 (Jan 06 2011)
# - add logging for dump memory command
# - add some comments
# - no implicit MC within BOOT (MC resets registers incl. BP + devices)
# version 0.017
# - Read_SWITCHES_Short: error checking added (Write_SWITCHES has a resend bit allocated)
# - svc_run ensures valid input
# version 0.018 (Aug 22 2011)
# - svc_run cleanup (resend mechnism removed)
# version 0.019 (Nov 21 2011)
# - logging completed
# - fptr logic being reset after attach/detach/reset
# version 0.020 (Dec 02 2011)
# - ptr/ptp activity displayed on console
#   If this info annoys the console output, comment out the print statements on lines:
#   802/809,889/896,2182/2189,2204/2211
# version 0.021 (Jan 03 2012)
# - disk offset register (do) added
# - disk image search and set do register
#
# Author : Theo Engel
# Contact: Info@theoengel.nl
#
# Usage:  P8Panel-xx.pl [x|m]                (where xx is some version number)
#   The argument controls the selection of disk images loaded on the sd-card
#   a) no argument: the 1st set of 4 X1215 disk images is searched and if found selected;
#   b) x          : searching is skipped; just enter an sector number in DO as offset for the selected set of disk images;
#   c) m          : search for multiple sets of disk images on the sd-card and select one.
#
# Contorl Commands:
# - 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)
# - panel interrupt signal/CntrP             (initiate a Panel Interrupt)
# - state                                    (request state of the cpu in the fpga)
# - trace [n|>]                              (executes a single or n instructions showing state (> executes untill CntrE)
# - load <filename.abs>                      (load absolute (8*8 format) executable with an .abs extension)
# - load <filename.rel>|<filename.LM|lm> <address>|mon  (load relocatable with a .rel or .LM extension at <address>) (mon loads a monitor at address 0)
# - 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 md0|md1|md2|md3 [h]                 (boot from disk md0|md1|md2|md3; h will stop the cpu after boot)  
# - rtc on|off                               (start/stop real time clock)
# - dump|du <address1> <address2>            (dump memory content from address1 up to address2)
# - exit                                     (disconnect from fpga and the control program exist; reconnection later is possible)
#
# |    means logical OR
# [..] means OPTIONAL argument
# <address>, <16 bit value> is hex value
# <register> is PC|A1|A2|A3|A4|A5|A6|A7|A8|A9|A10|A11|A12|A13|A14|A15|BP|DO 
# 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.
# DO is the disk offset register, It contains the sector address of the sd-card where the 1st x1215 disk image starts

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     => 0xA1;
use constant SET_REG  => 0x4C; # Jtag Output Select register
use constant SREG     => 0xA3; # Scratchpad-Register (A0..A15)
use constant PSW      => 0xA9; # PSW (only read)
use constant PRREG    => 0xE5; # Breakpoint Register
use constant DOREG    => 0xF5; # Disk offset register
use constant SWITCHES => 0xF1;
use constant FPTR     => 0xD2; # Fast papertape 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) (REG == PRREG, DOREG, or PC/A1..A15)
	my $Reg = shift;
	my $ra;	
	$Reg = $Reg & 0xFF;
	if($Reg == PRREG || $Reg == DOREG)
	{
		$ra = 0x00;  # breakpoint or disk-offset register is selected
	}
	else
	{
		$ra  = $Reg; # scratchpad register address (A0..A15)
		$Reg = SREG; # and select the scratchpad
	}	 	
	# JTAG message layout (9 bytes)
  	# Bytes 0x88 Action Target d1 d2 d3 d4 d5 Mode
  	#                           ^        ^  ^
  	#                          ra        hb lb                                     
	my $data = shift;
	my $hb = ($data >> 8) & 0xFF;
	my $lb = $data & 0xFF;
	if($DEBUG) {print "*** Set Reg value ra:$ra hb:$hb lb:$lb\n";}
	$txd_buffer = pack('CCCCCCCCC', 0x88,WRITE,$Reg,$ra,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) (REG == PRREG, PSW, DOREG or PC/A1..A15)
	my $Reg = shift;
	my $ra;
	$Reg = $Reg & 0xFF; 	 	
	my $rec_buffer = '01';
	# link REG to JTAG output
	if($DEBUG) {print "*** Link JTAG output\n";}
	if($Reg == PRREG || $Reg == PSW || $Reg == DOREG)
	{
		$ra = 0x00;  # breakpoint register,PSW or DOREG is selected
	}
	else
	{
		$ra  = $Reg; # scratchpad register address (A0..A15)
		$Reg = SREG; # and select the scratchpad
	}
	JTAG_Output_Select($Reg);	
	my $b1;
	my $b2;
	if($DEBUG) {print "*** Read request to Register\n";}
	$txd_buffer = pack('CCCCCCCCCCCC', 0x88,READ,$Reg,$ra,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";}
	# reg-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) ;
}

# input is byte address
sub Write_SRAM {
	my $addr = shift >> 1;  # word address
	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;}  
}

# input is byte address
sub Read_SRAM {
	my $addr = shift >> 1;  # word address
	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 (slow) 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  : Panel Interrupt
  # 2  : RTC on 
  # 1  : RTC off
  # 0  : FPTR reset
  #   
  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;}    
}

my $txd_buffer1 = pack('CCCCCCCCCCCCCCC', 0x88,READ,SWITCHES,0x00,0x00,0x00,0x00,0x00,NORMAL,0xC5,0x00,0x00,0x00,0x00,0x00);

# 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: 0
  # 0: RUNNING (1 in case CPU is running)
  my ($b0,$b1,$b2,$b3,$b4);
  if($DEBUG) {print "Read request to SWITCHES\n";}
  $ft_status = FT_Write($ft_handle, $txd_buffer1, 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);
}

# 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: 1              (check bit)
  # 0: RUNNING (1 in case CPU is running)
  $ft_status = FT_Write($ft_handle, $txd_buffer1, 15, $BytesWritten);
  my $t1 = ord($BytesWritten);	 
  $ft_status = FT_Read($ft_handle, $rec_buffer, 5, $BytesRead);
  my $t2 = ord($BytesRead);
  if($t1 eq "15" && $t2 eq "5")
  {
  	return ($rec_buffer);
  }
  else
  {
  	print "Error read-switches short" . $t1 . $t2 . "\n";
    	return 0; # error return
  }
}

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";}
  #*** print "FPTR: FT_Write returned value: $ft_status  " . 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;

# papertape format
my $null   = 0;
my $rub    = 0377;         # start of tape
my $xoff   = 0224;         # end of tape

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 $R;  		# register content
my $RA; 		# register address 0..F for P,A0..A15; undef for BP (This with resolving the register address via %R16)
my $RN; 		# register name: PC,A1..A15 are the scratchpad register names; BP is breakpoint register
my $BP; 		# preset breakpoint register
my $PC; my $A1; my $A2; my $A3; my $A4; my $A5; my $A6; my $A7; my $A8; my $A9; my $A10; my $A11; my $A12; my $A13; my $A14; my $A15;
my $PSW;
################################
# switches-write: (hb) ptrin ttyin (lb) stop step run mc cp rtc-on rtc-off read-error
# switches-read : ttyin ttyout ptrin ptpout cpuerrorstate enb checkbit running
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
my $PU;  		# papertape punch request flag
my $PR;  		# papertape reader request flag
my $TYO;  		# tty output request flag
my $TYI;  		# tty input request flag
my $key;
my $k=0;
my $readokflag;
my $cnt;
my $bell = pack("C", (0x07) );
my $ptstate=0; 		# used to show ptr/ptp activity
	  
# run service routine (JTAG output must already be selected!)

sub svc_run {
	# ensure valid input
	$readokflag = 0;
	$cnt = 0;
	while(! $readokflag)
	{
		$b0 = 0;
	  	$ssr = Read_SWITCHES_Short(); # read 5 bytes: state, IR(2byte) ttyout ptpout
      		if($ssr)
      		{
      			($b0,$b1,$b2,$b3,$b4) = unpack ('CCCCC', $ssr);
      		}
      		if($b0 & 2)
      		{
      			$readokflag = 1;
      		}
      		else
      		{
      			Write_SWITCHES(0,0,0,0); # ask for a resend
      			print $bell;
      			$cnt = $cnt + 1;
      			if($cnt==10)
      			{
      				$RUNCPU = 0;
      				print "JTAG link down.\n";
      			}
      		}
	}
	# valid input
	$nrr=$nrr+1; # count number of ReadSwitches
	$PU  = ($b0 & 0x10);  # papertape punch request
	$PR  = ($b0 & 0x20);  # papertape reader request
	$TYO = ($b0 & 0x40);  # tty output request
	$TYI = ($b0 & 0x80);  # tty input request
	
    	# 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)	  
	$k=0;
    	$Switch=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 || $k == 0xD)     
			{	
				Write_SWITCHES($Switch,1,0xD,0);
				prlog("\n");
				$nlcr=0xA;
			}
			elsif($k == 5 || $k == 16)
			{
				Write_SWITCHES($Switch,1,0,0); # dummy when Stop or CP in input mode
			}					
			else
			{
				Write_SWITCHES($Switch,1,ord(UP($key)),0);
				prlog(UP($key));
			}
		}
	}
	if($TYO)
	{
		# output request
		$b3 = $b3 & 0x7F;
		if($b3 == 0xD)
		{
			prlog("\n");
		}
		elsif($b3 == 0xA)
		{
			#print "\n";
			;
		}
		elsif(($b3 > 0x1F) && ($b3 < 0x60))    # printable characters 
		{
			prlog(chr($b3));
		}
	}
	if(defined $key) 
	{
		if($k == 5)  # CntrE => Stop
		{
			if(CpuIsInactive())
			{
				prlog("\nCpu is already inactive\n");
			}
			else
			{
				$Switch = 0x80; # set CPU Stop bit
				Write_SWITCHES($Switch,0,0,0);
				prlog("\nKeyboard interrupt (Panel: STOP)\n");
			}
			$RUNCPU = 0;		
		}
		if($k == 16)  # CntrP => Panel Interrupt (CP)
		{
			if(CpuIsInactive())
			{
				prlog("\nPanel Interrupt: Cpu is not running\n");
			}
			else
			{
				$Switch = 0x08; # set CPU Panel Interrupt bit
				Write_SWITCHES($Switch,0,0,0);
				prlog("\nPanel Interrupt\n");
			}	
		}
	}
		
 	if(! ($b0 & 1)) 
	{
  		$RUNCPU = 0;          # cpu stopped
  	}
  	
  	if($PU) # papertape punch request
  	{
  		if($PTP[FC] != 0)
  		{
  			if($DEBUG) 
  			{
  				print("PTP:" . prhex(8,$b4) . "\r"); # show ptp activity
  			}
  			else
  			{
  				ptactivity(); ##<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  			}
          		punch_ptp($b4); # punch the byte
        	}			
  		else
  		{
  			if($error_ptp == 0)
  			{
  				prlog("\nPTP request, but not attached\n");
  				$error_ptp=1;  	  				
  			}
  		}   			
  	}
  	
  	if($PR) # papertape reader request
  	{
  		if(($PTR[FC] != 0) && ($error_ptr == 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)
  				{
  					prlog("\nPapertape reader: EOT\n");
  					$error_ptr=1;  				
  				}
  			} 			
  			if($ch1 != 0) # 0 => EOT
  			{
  				$ch1 = $ch1 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					prlog("\nPapertape reader: EOT\n");
  					$error_ptr=1;  				
  				}
  			} 		
  			if($ch2 != 0) # 0 => EOT
  			{
  				$ch2 = $ch2 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					prlog("\nPapertape reader: EOT\n");
  					$error_ptr=1;  				
  				}
  			} 
  			if($ch3 != 0) # 0 => EOT
  			{
  				$ch3 = $ch3 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					prlog("\nPapertape reader: EOT\n");
  					$error_ptr=1;  				
  				}
  			}
  			if($ch4 != 0) # 0 => EOT
  			{
  				$ch4 = $ch4 & 0xFF;
  			}
   			else
  			{
  				if($error_ptr==0)
  				{
  					prlog("\nPapertape reader: EOT\n");
  					$error_ptr=1;  				
  				}
  			} 
  			if($DEBUG)
  			{
  				print("PTR:" . prhex(8,$ch0) . prhex(8,$ch1) . prhex(8,$ch2) . prhex(8,$ch3) . prhex(8,$ch4) . "\r"); # show ptr activity
  			 }
  			else
  			{
  				ptactivity(); ##<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  			}
  			Write_FPTR($ch0,$ch1,$ch2,$ch3,$ch4);
  		}
  		else
  		{
  			if($error_ptr==0)
  			{
  				prlog("\nPTR request, but not attached\n");
  				$error_ptr=1;  				
  			}
  		}  			
  	}


}

##############################################################################
print "**P8Panel, version $version **P856$xversion (32kW)**\n";

# register conversion table
my %R16;
$R16{"PC"}  = 0;	# 0000
$R16{"A1"}  = 0x2;	# 0010
$R16{'A2'}  = 0x4;	# 0100
$R16{'A3'}  = 0x6;	# 0110
$R16{'A4'}  = 0x8;	# 1000
$R16{'A5'}  = 0xA;	# 1010
$R16{'A6'}  = 0xC;	# 1100
$R16{'A7'}  = 0xE;	# 1110
$R16{'A8'}  = 0x1;	# 0001
$R16{'A9'}  = 0x3;	# 0011
$R16{'A10'} = 0x5;	# 0101
$R16{'A11'} = 0x7;	# 0111
$R16{'A12'} = 0x9;	# 1001
$R16{'A13'} = 0xB;	# 1011
$R16{'A14'} = 0xD;	# 1101
$R16{'A15'} = 0xF;	# 1111
# register symbols
use constant PC  => 0x0;
use constant A1  => 0x2;
use constant A2  => 0x4;
use constant A3  => 0x6;
use constant A4  => 0x8;
use constant A5  => 0xA;
use constant A6  => 0xC;
use constant A7  => 0xE;
use constant A8  => 0x1;
use constant A9  => 0x3;
use constant A10 => 0x5;
use constant A11 => 0x7;
use constant A12 => 0x9;
use constant A13 => 0xB;
use constant A14 => 0xD;
use constant A15 => 0xF;

my $cmd;        # command string
my $logfile=""; # currently trace, dump 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;     # $w[0] is an optional argument to control disk image searching on the sd-card

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

# Search and select a set of X1215 disk images on the sd-card
my $Disk_Offset=0x200; 	# sector on sd-card where 1st X1215 image starts (initial value)
if($w[0] eq "x")
{
	# skip searching
	print "Enter an Disk Image Offset (or 1 if no disks are required): ";
	$s = <STDIN>;			# input 16 bit hex number
	chomp $s;
	$s = UP($s);
	$s=cvhex($s);																													
	if($s >= 0)
	{
	  	$s=$s & 0xFFFF;																																			
	        print "Set Register DO to: " . prhex(16,$s) . "\n";
		Write_Register(DOREG,$s); # set the disk offset register
		$Disk_Offset = $s;
	}
	else
	{
		print "Error input number.\n";
	}
}
elsif($w[0] eq "m")
{
	print "Option not implemented yet.\n";
}
elsif($w[0] eq "")
{
	my $s0; my $s1; my $R;
	
	if(! open (FHX, "SRMD0.hex"))
	{
		print "Unable to open file: SRMD0.hex\n";
		exit;
	}
	else
	{
		while($s=<FHX>)
		{
			chop $s;
			($s0,$s1) = split(/\,/,$s); # $s0=addr, $s1=content
			$s0=cvhex($s0) & 0xFFFF; 
			$s1=cvhex($s1);
			#print prhex(16,$s0) . " " . prhex(16,$s1) . "  octal:" . proct($s0) . " " . proct($s1) . "\n";
			Write_SRAM($s0,$s1);
		}
		print "SRMD0.hex loaded\n";
	}
	print "Searching for the 1st X1215 disk images on the sd-card.\n";
	
	#while(1) <<<<<<<<<<
	#{ <<<<<<<<<<<<
		$Switch = 0x10; # set master clear bit
		Write_SWITCHES($Switch,0,0,0);
		$RUNCPU = 1;                       # reset by a stopped CPU
		ReadMode 4;                        # prepare console mode
		STDOUT->autoflush(1);              # for MSWin32
		Write_Register(DOREG,$Disk_Offset); # set DO register (lost after MC)
		Write_Register("PC",0x10);
		$Switch = 0x20; # set CPU Run bit
		Write_SWITCHES($Switch,0,0,0);
      		JTAG_Output_Select(SWITCHES);      # select JTAG output
		while($RUNCPU)
		{
			svc_run();
		}
		ReadMode 0;                        # reset console
		STDOUT->autoflush(0);              # for MSWin32		
		# comes back after a HLT
		#print_stopped_state();
		$R=Read_Register($R16{"A13"}); # result in A13
		$Disk_Offset = $Disk_Offset + $R;
		print "Header record at: " . prhex(16,$Disk_Offset) . "\n";
		if($R)
		{
			# $R is the offset to the header sector (relative to $Disk_Offset)
			$Disk_Offset = $Disk_Offset + 1; # 1st sector of X1215 image 0 ?
			$R = $Disk_Offset + 0x7FFE;      # offset to trailer record ?
			if($R > 0xFFFF)
			{
				$Disk_Offset = 0;
				print "\nError Stop: sector number trailer > 0xFFFF\n";
				#last; <<<<<<<<<<
			}
			$Switch = 0x10; # set master clear bit
			Write_SWITCHES($Switch,0,0,0);
			Write_Register(DOREG,$R); # set DO pointing to trailer
			print "Offset set for trailer sector: " . prhex(16,$R) . "\n";
			$R=Read_Register(DOREG); 
			print "Disk Offset: " . prhex(16,$R) . "\n";
			$RUNCPU = 1;                       # reset by a stopped CPU
			ReadMode 4;                        # prepare console mode
			STDOUT->autoflush(1);              # for MSWin32
			Write_Register("PC",0xB4);
			$Switch = 0x20; # set CPU Run bit
			Write_SWITCHES($Switch,0,0,0);
      			JTAG_Output_Select(SWITCHES);      # select JTAG output
			while($RUNCPU)
			{
				svc_run();
			}
			ReadMode 0;                        # reset console
			STDOUT->autoflush(0);              # for MSWin32			
			# comes back after a HLT
			#print_stopped_state();
			Write_Register(DOREG,$Disk_Offset); # reset DO to the point we were (1st sector of X1215 image 0 ?)
			$R=Read_Register($R16{"A13"}); # result in A13
			if($R == 0)
			{
				# trailer record found
				# set register DO to the found disk offset
				print "Trailer identified: register DO set to: " . prhex(16,$Disk_Offset) . " (X1215 image 0)\n";
				# last; # stop searching <<<<<<<<<<<<<<<				
			}
			else
			{
				# no trailer record; continue searching for a next header/trailer
				print "No Trailer linked to this header.\n";
				$Disk_Offset = 0; # <<<<<<<<<<<<<<<<< remove in case of loop
			}
			# continue searching
		}
		else
		{
			# no header found
			$Disk_Offset = 0;
			print "\nError Stop: no header sector found.\n";
			# last; <<<<<<<<<<<<<<<<<
		}
	#} <<<<<<<<<<<<<<<<<
}

if($Disk_Offset == 0)
{
	print "No X1215 disk images selected.\n"; 
	exit;
}

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;
		prlog("Testflag set\n");
	}
	elsif(UP($w[0]) eq "TFR") # for debugging only
	{
		$testflag = 0;
		prlog("Testflag reset\n");		
	}
        elsif(UP($w[0]) eq "FPTR") # for debugging only
	{
		$n=1000;
		while($n)
		{
			my $ch0; my $ch1; my $ch2; my $ch3; my $ch4; 
			$ch0=0x30;$ch1=0x30;$ch2=0x30;$ch3=0x30;$ch4=0x30;
                	print prhex(8,$ch0) . prhex(8,$ch1) . prhex(8,$ch2) . prhex(8,$ch3) . prhex(8,$ch4) . "\n";
  			Write_FPTR($ch0,$ch1,$ch2,$ch3,$ch4);
  			$n=$n-1;
  		}		
	}	
	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;
					  	prlog("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 "")
				{
					prlog("Previous logfile $logfile is closed\n");	
					close LOG || die "can't close $logfile: $!";
					
				}
				$logfile = $w[1];
				if(! open (LOG, ">$logfile"))
				{
					print "Cannot open the new logfile: $logfile\n";
					$logfile = "";					
				}
				else
				{
					$log = 1;
					prlog("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 "RTC")
	{
		if(CpuIsInactive())
		{
			if(UP($w[1]) eq "ON")
			{
					Write_SWITCHES(0x04,0,0,0);
					prlog("Set RTC On\n");
			}
			else
			{
				if(UP($w[1]) eq "OFF")
				{
					Write_SWITCHES(0x02,0,0,0);
					prlog("Set RTC Off\n");
				}
				else
				{
					prlog("Invalid RTC command\n");
				}
			}
		}
	}					
  	elsif(UP($w[0]) eq "EXAMINE" || UP($w[0]) eq "EX")
	{
		if(CpuIsInactive())
		{
			if(UP($w[1]) =~ /^M/)
			{
				$s = UP($w[2]);
				$s=cvhex($s);			
				if($s >= 0)
				{
					$s=$s & 0xFFFE;
					while(1)
					{
						$m=Read_SRAM($s);
						prlog("Addr:" . prhex(16,$s) . " Data:" . prhex(16,$m) . " .");
						$m = <STDIN>;
						cmdlog($m);
						$s = $s + 2;
						if(($m =~ /s/) || ($s > 0xFFFF))
						{
							last;
						}
					}
				}
				else
				{
					prlog("No valid address\n");
				}
			}
			elsif(UP($w[1]) eq "PC"  || UP($w[1]) eq "A1"  || UP($w[1]) eq "A2"  || UP($w[1]) eq "A3"  || 
			      UP($w[1]) eq "A4"  || UP($w[1]) eq "A5"  || UP($w[1]) eq "A6"  || UP($w[1]) eq "A7"  || UP($w[1]) eq "A8"  || 
			      UP($w[1]) eq "A9"  || UP($w[1]) eq "A10" || UP($w[1]) eq "A11" || UP($w[1]) eq "A12" || UP($w[1]) eq "A13" ||
			      UP($w[1]) eq "A14" || UP($w[1]) eq "A15" || UP($w[1]) eq "BP"  || UP($w[1]) eq "DO")
			{			
				$RN=UP($w[1]); # register name
				$RA=$R16{$RN}; # register address
        			if($RN eq "BP")
        			{
        				$R=Read_Register(PRREG); # read breakpoint register
        			}
        			elsif($RN eq "DO")
        			{
        				$R=Read_Register(DOREG); # read disk offset register
        			}
        			else
        			{
        				$R=Read_Register($RA);   # read scratchpad register
        			}
				prlog("$RN = " . prhex(16,$R) . "\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				
				$s=cvhex($s);
				$m=cvhex($m);																				
				if($s >= 0)
				{
				  $s=$s & 0xFFFE;             # 64 k bytes maximum / word boundary
					if($m >= 0)
					{
				    $m=$m & 0xFFFF;									
						prlog("Set Memory, Addr = " . prhex(16,$s) . " Data = " . prhex(16,$m) . "\n");
						Write_SRAM($s,$m);
					}
					else
					{
						# read content from keyboard
						while($s<0x10000)
						{
							$m = Read_SRAM($s); # read existing content
							prlog(prhex(16, $s) . "  " . prhex(16,$m) . " ? ");
							$m = <STDIN>;
							if($m =~ /s/)
							{
								last;                 # stop
							}
							elsif($m =~ /[\da-fA-F]/)
							{
								chomp $m;
								$m=UP($m);
								$m=cvhex($m);								
								if($m >= 0)
								{
									$m=$m & 0xFFFF;							
									Write_SRAM($s,$m);
   							}
								else
								{
									prlog("Wrong content\n");
									$s = $s - 2;       # redo current address
								}
							}
							$s = $s + 2;
						}
					}
				}
				else
				{
					prlog("Wrong address\n");
				}
			}
			elsif(UP($w[1]) eq "PC"  || UP($w[1]) eq "A1"  || UP($w[1]) eq "A2"  || UP($w[1]) eq "A3"  || 
			      UP($w[1]) eq "A4"  || UP($w[1]) eq "A5"  || UP($w[1]) eq "A6"  || UP($w[1]) eq "A7"  || UP($w[1]) eq "A8"  || 
			      UP($w[1]) eq "A9"  || UP($w[1]) eq "A10" || UP($w[1]) eq "A11" || UP($w[1]) eq "A12" || UP($w[1]) eq "A13" ||
			      UP($w[1]) eq "A14" || UP($w[1]) eq "A15" || UP($w[1]) eq "BP"  || UP($w[1]) eq "DO")
			{
				$RN=UP($w[1]); # register name
				$RA=$R16{$RN}; # register address
				if($w[2] eq undef)
				{
					prlog( "$RN = ");
					$s = <STDIN>;			# input 16 bit hex number
					cmdlog($s);
					chomp $s;
					$s = UP($s);
					$s=cvhex($s);																													
					if($s >= 0)
					{
					  	$s=$s & 0xFFFF;																																			
						$R=$s;
						prlog( "Set Register $RN to: " . prhex(16,$R) . "\n");
						if($RN eq "BP")
						{
							Write_Register(PRREG,$R); # set the breakpoint register
						}
						elsif($RN eq "DO")
						{
							Write_Register(DOREG,$R); # set the disk offset register
							$Disk_Offset = $R;
						}
						else
						{
							Write_Register($RA,$R);   # set a scratchpad register
						}
					}
					else
					{
						prlog( "Error input number\n");
					}
				}
				else
				{
					$s = UP($w[2]);                   # content			
					$s=cvhex($s);										
					if($s >= 0)
					{
					  	$s=$s & 0xFFFF;																																			
						$R=$s;
						prlog( "Set Register $RN to: " . prhex(16,$R) . "\n");
						if($RN eq "BP")
						{
							Write_Register(PRREG,$R); # set the breakpoint register
						}
						elsif($RN eq "DO")
						{
							Write_Register(DOREG,$R); # set the disk offset register
							$Disk_Offset = $R;
						}						
						else
						{
							Write_Register($RA,$R);   # set a scratchpad register
						}											
					}
					else
					{
						prlog( "Error input number\n");
					}					
				}
				print_stopped_state();			
			}
			else
			{
				prlog("Wrong memory or register reference $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 = 0x10; # set master clear bit
			Write_SWITCHES($Switch,0,0,0);
			Write_Register(DOREG,$Disk_Offset); # set the disk offset register
		}
		else
		{
			prlog( "Cpu is active; Master Clear not allowed\n");
		}
  	}
  	elsif(UP($w[0]) eq "RUN")
	{
		if(CpuIsInactive())
		{
			prlog( "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 = 0x20;                    # set CPU Run bit
			Write_SWITCHES($Switch,0,0,0);
			$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( "\nCPU stopped; TTY switched to Panel\n");
			#prlog( "$nrr ReadSwitches per second; $nch cps on PTR, secs:$secs\n");
			prlog( "$nrr ReadSwitches per second; secs:$secs\n");
		}
		else
		{
			prlog("Cpu is already active; Run not allowed\n");
		}
  	}
	elsif(UP($w[0]) eq "BOOT")
	{
		if(CpuIsInactive())
		{
			if(UP($w[1]) eq "MD0" || UP($w[1]) eq "MD1" || UP($w[1]) eq "MD2" || UP($w[1]) eq "MD3")
			{
				# Boot from disk
				# Master Clear			
				# $Switch = 0x10; # set master clear bit
				# Write_SWITCHES($Switch,0,0,0);
				# set A15 with the boot parameters
				if(UP($w[1]) eq "MD0")
				{
					Write_Register(A15,0x63C2); # boot from unit 0 drive 0 (address 02)
				}
				elsif(UP($w[1]) eq "MD1")
				{
					Write_Register(A15,0x63E2); # boot from unit 0 drive 0 (address 22)
				}
				elsif(UP($w[1]) eq "MD2")
				{
					Write_Register(A15,0x63D2); # boot from unit 0 drive 0 (address 12)
				}				
				elsif(UP($w[1]) eq "MD3")
				{
					Write_Register(A15,0x63F2); # boot from unit 0 drive 0 (address 32)
				}
				# store the boot loader in memory; the boot loader loads the ipl program
								# * BASE REGISTER INITIALIZATION
				Write_SRAM(0x0000,0x0254);	# BOOT   LDK         A2,INR               A2 = ADDRESS INR INSTRUCTION	
				Write_SRAM(0x0002,0x0336);  	#        LDK         A3,CIO               A3 = ADDRESS CIO INSTRUCTION
				Write_SRAM(0x0004,0x0472);  	#        LDK         A4,SST               A4 = ADDRESS SST INSTRUCTION
                                    	# * SET DEVICE ADDRESS TO INITIALIZE THE I/O COMMANDS
				Write_SRAM(0x0006,0x861E);  	#        LDR         A6,A15               A6 = VALUE OF THE KEYS
				Write_SRAM(0x0008,0x263F);  	#        ANK         A6,/3F               KEEP JUST THE DEVICE ADDRESS
				Write_SRAM(0x000A,0xAE29);  	#        ORRS        A6,A2                INIT INR WITH DEVICE ADDRESS
				Write_SRAM(0x000C,0xAE2D);  	#        ORRS        A6,A3                INIT CIO WITH DEVICE ADDRESS
				Write_SRAM(0x000E,0xAE41);  	#        ORS         A6,HIO               INIT THE HALT IO WITH DEVICE ADDRESS
				Write_SRAM(0x0010,0x0070);  
                                    	# * SET CONTROLLER TYPE AND ADDRESS
				Write_SRAM(0x0012,0x871E);  	#        LDR         A7,A15               MULTI OR SINGLE DEVICE CU?
				Write_SRAM(0x0014,0x3FC8);  	#        SLC         A7,8
				Write_SRAM(0x0016,0x5602);  	#        RF(6)       INIT20               JUMP IF SINGLE
				Write_SRAM(0x0018,0x260F);  	#        ANK         A6,/F                MULTI: KEEP CONTROLLER ADDRESS (CA)
                                    	# * INITIALIZE THE WER INSTRUCTIONS AND SST ONE
				Write_SRAM(0x001A,0xAE31);  	# INIT20 ORRS        A6,A4                INIT SST WITH DEVICE OR CONTROLLER ADDR
				Write_SRAM(0x001C,0x3E41);  	#        SLL         A6,1                 COMPUTE EXTERNAL REGISTER ADDRESS
				Write_SRAM(0x001E,0xAE41);  	#        ORS         A6,WER1              UPDATE WER INSTRUCTIONS
				Write_SRAM(0x0020,0x0042);  
				Write_SRAM(0x0022,0xAE41);  	#        ORS         A6,WER2
				Write_SRAM(0x0024,0x0044);  
				Write_SRAM(0x0026,0x811C);  	#        LDR         A1,A7                A1 = BOU LINES
				Write_SRAM(0x0028,0x0550);  	#        LDK         A5,/50               BLOCK LENGTH TO BE LOADED
				Write_SRAM(0x002A,0x0680);  	#        LDK         A6,/80               IN LOCATION /80.....
                                    	# * CHECK DEVICE TYPE
				Write_SRAM(0x002C,0x3FE7);  	#        SRC         A7,7                 IS THE DEVICE A DISK OR NOT ?
				Write_SRAM(0x002E,0x5612);  	#        RF(6)       WER1                 NO
				Write_SRAM(0x0030,0x3FC1);  	#        SLC         A7,1                 IS IT A FIXED HEADS DISK ?
				Write_SRAM(0x0032,0x5604);  	#        RF(6)       NOSEEK               YES => NO SEEK TO ZERO
				Write_SRAM(0x0034,0x0103);  	#        LDK         A1,3                 EXECUTE A SEEK TO ZERO OPERATION
				Write_SRAM(0x0036,0x41C0);  	# CIO    CIO         A1,1,0               ON THE MOVING HEADS DISK
                                    	# * PREPARE THE NEXT LOGICAL IO FOR A DISK
				Write_SRAM(0x0038,0x811E);  	# NOSEEK LDR         A1,A15               COMPUTE THE 
				Write_SRAM(0x003A,0x3966);  	#        SRL         A1,6                 SECTOR
				Write_SRAM(0x003C,0x213C);  	#        ANK         A1,/3C               NUMBER
				Write_SRAM(0x003E,0x8520);  	#        LDKL        A5,/80CD             1ST WORD FOR MX FOR A DISK
				Write_SRAM(0x0040,0x80CD); 
                                    	# * EXECUTE THE LOGICAL IO OPERATION FOR ANY DEVICE, ON MX OR CP
				Write_SRAM(0x0042,0x7500);  	# WER1   WER         A5,0                 FOR ANY DEVICE (DISK OR NOT) EXECUTE THE WER,
				Write_SRAM(0x0044,0x7601);  	# WER2   WER         A6,1                 THE CHANNEL IS
				Write_SRAM(0x0046,0xF031);  	#        EXR*        A4                   EXECUTE SST A7,..
				Write_SRAM(0x0048,0xF02D);  	#        EXR*        A3                   EXECUTE CIO A1,..
				Write_SRAM(0x004A,0x5C06);  	#        RB(4)       *-4                  REFUSED !  TRY AGAIN
                                    	# * CHECK WHETHER THE CHANNEL WANTED TO TAKE THE ACTION
				Write_SRAM(0x004C,0x8194);  	#        LDR         A9,A5                A9 = NBR OF CHARS TO READ
				Write_SRAM(0x004E,0x871E);  	# MX::CP LDR         A7,A15               IS THE DEVICE CONNECTED TO
				Write_SRAM(0x0050,0x3F43);  	#        SLL         A7,3                 THE MULTIPLEX CHANNEL ?
				Write_SRAM(0x0052,0x561E);  	#        RF(6)       SST                  YES, SEND AN SST
				                    					# * NO, CONNECTED TO CP => INPUT ONE CHARACTER/WORD FROM THE DEVICE
				Write_SRAM(0x0054,0x4F00);  	# INR    INR         A7,0,0               READ INTO A7
				Write_SRAM(0x0056,0x541A);  	#        RF(4)       SST                  REFUSED !, SEND AN SST TO KNOW WHY
				Write_SRAM(0x0058,0xE994);  	#        CWR         A9,A5                LEADING CHAR ?
				Write_SRAM(0x005A,0x5404);  	#        RF(4)       INR10                NO
				Write_SRAM(0x005C,0x871C);  	#        LDR         A7,A7                YES
				Write_SRAM(0x005E,0x580C);  	#        RB(0)       INR
				                    					# * CHECK WHETHER WORD OR CHARACTER MODE
				Write_SRAM(0x0060,0x879E);  	# INR10  LDR         A15,A15              CHARACTER MODE ?
				Write_SRAM(0x0062,0x5604);  	#        RF(6)       STORE                YES
				Write_SRAM(0x0064,0x8739);  	#        STR         A7,A6                STORE WORD JUST READ FROM CP
				Write_SRAM(0x0066,0x1601);  	#        ADK         A6,1                 USE SAME ROUTINE FOR WORD AND CHAR MODE
                                    	# * STORE CHAR JUST READ AND CHECK FOR END OF TRANSFER
				Write_SRAM(0x0068,0xE739);  	# STORE  SCR         A7,A6                STORE ONE CHAR TO /80 + (A6)
				Write_SRAM(0x006A,0x1601);  	#        ADK         A6,1                 PREPARE FOR NEXT LOCATION TO STORE
				Write_SRAM(0x006C,0x1D01);  	#        SUK         A5,1                 OTHER CHAR TO READ ?
				Write_SRAM(0x006E,0x5C1C);  	#        RB(4)       INR                  YES, LOOP TO INPUT
                                    	# * END OF TRANSFER, EXECUTE A CIO HALT
				Write_SRAM(0x0070,0x4180);  	# HIO    CIO         A1,0,0               TO EXCHANGE
                                    	# * EXECUTE AN SST AND ANALYZE THE STATUS 
				Write_SRAM(0x0072,0x4FC0);  	# SST    SST         A7,0                 
				Write_SRAM(0x0074,0x5C28);  	#        RB(4)       MX::CP               REFUSED ! => THIS HANDLES BOTH CASES: WAIT ON CP OR MX
				Write_SRAM(0x0076,0xA720);  	#        ANKL        A7,/4007             
				Write_SRAM(0x0078,0x4007); 
                                    	# * TEST: BIT 1  = DEVICE BECAME READY
                                    	# *       BIT 13 = DATA FAULT
                                    	# *       BIT 14 = THROUGHPUT ERROR
                                    	# *       BIT 15 = NOT OPERABLE
				Write_SRAM(0x007A,0x0C00);  	#        AB(4)       /00                  ONE OF THESE CONDITIONS => RESTART THE BOOTSTRAP
				Write_SRAM(0x007C,0x0F84);  	#        AB          /84                  NORMAL END => JUMP TO IPL
                                    	#        END         BOOT
				if(UP($w[2]) eq "H")
				{
					Write_SRAM(0x007C,0x207F);             # HALT, after loading IPL is complete
					prlog("After IPL is loaded, Boot stops (start address IPL is /0084)\n");
				}
				else
				{
					Write_SRAM(0x007C,0x0F84);             # AB /84 => RUN starting at begin 1st address of IPL
					prlog("After IPL is loaded, Boot starts IPL (Default)\n");			
				}
				prlog("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 = 0x20;                    # set CPU Run bit
				Write_SWITCHES($Switch,0,0,0);
				$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( "\nCPU stopped; TTY switched to Panel\n");
				#prlog( "$nrr ReadSwitches per second; $nch cps on PTR, secs:$secs\n");
				prlog( "$nrr ReadSwitches per second; secs:$secs\n");
			}
		}
		else
		{
			prlog( "Cpu is active; Boot not allowed\n");
		}  
  	}
	elsif(UP($w[0]) eq "STEP" || UP($w[0]) eq "S")
	{
		if(CpuIsInactive())
		{
	  		$Switch = 0x40; # set the CPU Step bit
		  	Write_SWITCHES($Switch,0,0,0);
			print_stopped_state();
		}
		else
		{
			prlog("Cpu is active; Step not allowed\n");
		}		
  	} 
	elsif(UP($w[0]) eq "STOP")
	{
		$Switch = 0x80; # set stop bit
		Write_SWITCHES($Switch,0,0,0);
		print_stopped_state();
  	} 
	elsif(UP($w[0]) eq "STATE")
	{
		print_stopped_state();
	}
	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]))
						{
							prlog("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) & 0xFFFF; 
								$s1=cvhex($s1);
								prlog( prhex(16,$s0) . " " . prhex(16,$s1) . "  octal:" . proct($s0) . " " . proct($s1) . "\n");				
			    					Write_SRAM($s0,$s1);
							}
						}
					}
					else
					{
						prlog("No proper filename is specified: syntax is: ldhex|ldh [s] <fn>.hex\n");
					}					
				}
				else
				{
					if($w[1] =~ /.hex/)
					{
						if(! open (FHX, $w[1]))
						{
							prlog("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) & 0xFFFF; 
								$s1=cvhex($s1);
								# print prhex(16,$s0) . " " . prhex(16,$s1) . "  octal:" . proct($s0) . " " . proct($s1) . "\n";				
			    					Write_SRAM($s0,$s1);
							}
						}
					}
					else
					{
						prlog("No proper filename is specified: syntax is: ldhex|ldh [s] <fn>.hex\n");
					}
				}
			}
			else
			{
				prlog("No parameters specified: syntax is: ldhex|ldh [s] <fn>.hex\n");
			}
		}
		else
		{
			prlog("Load Program: CPU is active; Load not allowed\n");
		}		
	}
	elsif(UP($w[0]) eq "LOAD")
	{
		my $leader = "false";
		my $c;
		my $w;
		my $err=0;
		my $ba=0;     # begin address of load area
		my $wc=0;     # word count
		my $l;
		my $mode = ""; 

		$file = $w[1];	
		if(CpuIsInactive())
		{
			if ($file eq "" || (( $file !~ /\.abs/ ) && ( $file !~ /\.rel/ ) && ( $file !~ /\.LM/ ) && ( $file !~ /\.lm/ )))
			{
				prlog("No filename, or wrong extension (must be .abs or .rel/.LM/.lm)\n");
				$err=1;
			}
										
			if($w[1] =~ /\.abs/)
			{
				# load a 8+8 formatted papertape
				$mode = 'a';
			}
		
			if($w[1] =~ /\.rel/ || $w[1] =~ /\.LM/ || $w[1] =~ /\.lm/)
			{
				if($w[2] ne "" && $w[2] =~ /^[0-9a-f]/)
				{
					# load a relocatable load module
					$ba = cvhex(UP($w[2]));
					$ba = $ba & 0xFFFE;	
					$mode = 'r';
				}
				elsif($w[2] ne "" && $w[2] eq "mon")
				{
					# load a relocatable monitor load module at address 0
					$ba = -8;
					$mode = 'm';				
				}			
				else
				{
					prlog("Load address missing\n");
					$err = 1;
				}			
			}
		}
		else
		{
			prlog("Load Program: CPU is active; Load not allowed\n");
			$err = 1;			
		}			

		if($err == 0)
		{
			if(! open (IN, $file))
			{
				prlog("Unable to open requested load file: $file\n");
				$err = 1;
			}
		}
		
		if($err == 0 && $mode eq 'a')
		{
			binmode IN, ":raw";			
			prlog("Load $w[1]\n");
			# Read bootable 8+8 formatted paper tape
			# skip leader
			while( 1 )
			{
				$c = nextchar();
				# skip leader in case there
				if ($leader eq "false")
				{
					next if $c eq $null;
					$leader = "true";
					prlog( "Leader skipped\n");
					last;
				}
			}
			$wc = nextword();                       # word count
			$ba = (nextword() + 2) & 0xFFFE;        # begin address of load area
			my $low = $ba;
			my $high = $ba + $wc*2;
			my $chksum = 0;
			prlog("Load " . prhex(16,$wc) . " words\; start loading at" . prhex(16,$ba) . "\n");
			$l = 0;
			while($l < $wc)
			{
				$w = nextword();
				$chksum = $chksum ^ $w;
				Write_SRAM($ba,$w);                   # $M[$ba] = $w;
				$ba = $ba + 2;
				$l = $l + 1;
			}	
			my $chk = nextword();	
			if( ($chksum - $chk) != 0)
			{
				prlog("Checksum error\n");
			}
			$c =nextchar();
			if($c != $xoff)
			{
				prlog("No x-off marking end of tape\n");
			}
			close (IN) || die "can't close $file: $!";
			prlog("LOADING COMPLETE\; 1st free address is" . prhex(16,$high) . "\n");
			Write_Register(0,$low);             	# $R[0] = $low;	PC == default start address
			prlog("Default start address (P) is:" . prhex(16,$low) . "\n");
		}
		
		if($err == 0 && $mode eq 'r')
		{		
			# load relocatable load module
			binmode IN, ":raw";			
			prlog("Load $w[1]\n");
			nextword(); # header word 1
			nextword(); # header word 2
      			my $sa = nextword();    # start address
			my $ns = nextword();    # number of sectors
			$wc    = nextword();    # length in words, counted in bytes
			$wc    = $wc >> 1;      # length in words (# words to be loaded)
			nextword();             # sym table pointer for debugging: not used at this moment
			prlog("Load " . prhex(16,$wc) . " words\; start loading at" . prhex(16,$ba) . "\; relative start address is" . prhex(16,$sa) . "\n");
      			# $ba is the relocator
		  	Write_SRAM($ba,$sa);    	# $M[$ba]   = $sa;
			Write_SRAM(($ba+2),$ns);	# $M[$ba+2] = $ns;
			Write_SRAM(($ba+4),($wc << 1)); # $M[$ba+4] = $wc << 1;
			Write_SRAM(($ba+6),0);          # $M[$ba+6] = 0; sym table pointer for debugging: not used at this moment
				
			my $k = 0;              # total number of words relocated
			$l=4;			# total number of words loaded
			my $i=4;		# number of code/data words retrieved from record
			
			while($l<$wc)		# loading complete ?
			{
				if($i == 0)
				{
					# skip header
			        nextword(); 		# header word 1
			        nextword(); 		# header word 2
        }
				# load record
				while(($i<188) && ($l<$wc))
				{
					$w=nextword();
					Write_SRAM(($ba+($l*2)),$w);	# $M[$ba+($l*2)] = $w;
					$i=$i+1;
					$l=$l+1;
				}
				# skip to relocation table, if not there yet
				while($i<188)
				{
					nextword();
					$i=$i+1;
				}
				# relocate this record
				$i=0;
				while($i<12)    			# scan the relocation table
				{
					my $rw = nextword();
					my $j = 0;
					while(($j<16) && ($k<$l))
					{
						if($rw & 0x8000)
						{
							# $M[$ba+($k*2)] = ($M[$ba+($k*2)] + $ba) & 0xFFFF ; # relocate
							$w = (Read_SRAM($ba+($k*2)) + $ba) & 0xFFFF;
							Write_SRAM(($ba+($k*2)),$w);
						}
						$rw = $rw << 1;
						$j=$j+1;
						$k=$k+1;
					}
					$i=$i+1;
				}
				# skip to end of record
				nextword(); # trailer word 1
				nextword(); # trailer word 1
				nextword(); # trailer word 1
				$i=0;
			}
			close (IN) || die "can't close $file: $!";
			$i=$ba+($l*2);      				# first free address 
			prlog("LOADING COMPLETE\; 1st free address is" . prhex(16,$i) . "\n");
			Write_Register(0,Read_SRAM($ba));  		# $R[0] = $M[$ba]; PC == start address
			prlog("Start address (P) is: " . prhex(16,Read_SRAM($ba)) . "\n");			
		}
		if($err == 0 && $mode eq 'm')
		{		
			# load relocatable monitor load module at address 0
			binmode IN, ":raw";			
			prlog("Load monitor $w[1]\n");
			nextword(); # header word 1
			nextword(); # header word 2
      			my $sa = nextword()-8;  # start address (relocated)
			my $ns = nextword();    # number of sectors
			$wc    = nextword();    # length in words, counted in bytes
			$wc    = $wc >> 1;      # length in words
			nextword();             # sym table pointer for debugging: not used at this moment
			
			prlog("Load " . prhex(16,$wc) . " -4 words\; start loading at" . prhex(16,0) . "\n");
      			# $ba is the relocator (-8 !)
			my $sec0=1; 		# sector 0 indicator
			my $low=0;
			my $high=0;	
			my $k = 4;              # total number of words relocated
			$l=4;			# total number of words loaded
      			my $i=4;		# number of code/data words retrieved from record
			
			while($l<$wc)
			{
				if($i == 0)
				{
					# skip header
			        	nextword(); 	# header word 1
			        	nextword(); 	# header word 2
        			}					
				# load record
				while(($i<188) && ($l<$wc))
				{
					$w=nextword();
					Write_SRAM(($ba+($l*2)),$w);		# $M[$ba+($l*2)] = $w;
					$i=$i+1;
					$l=$l+1;
				}
				# skip to relocation table, if not there yet
				while($i<188)
				{
					nextword();
					$i=$i+1;
				}
				# relocate this record
				$i=0;
				while($i<12)    # scan the relocation table
				{
					my $rw = nextword();
					my $j = 0;
					if($sec0)
					{
						# skip 1st 4 words of sector 0
						$rw = $rw << 4;
						$j  = 4;
						$sec0=0;
					}					
					while(($j<16) && ($k<$l))
					{
						if($rw & 0x8000)
						{
							# $M[$ba+($k*2)] = ($M[$ba+($k*2)] + $ba) & 0xFFFF ; # relocate
							$w = (Read_SRAM($ba+($k*2)) + $ba) & 0xFFFF;
							Write_SRAM(($ba+($k*2)),$w);
						}
						$rw = $rw << 1;
						$j=$j+1;
						$k=$k+1;
					}
					$i=$i+1;
				}
				# skip to end of record
				nextword(); # trailer word 1
				nextword(); # trailer word 1
				nextword(); # trailer word 1
				$i=0;
			}
			close (IN) || die "can't close $file: $!";
			$i=$ba+($l*2);      # first free address 
			prlog("LOADING COMPLETE\; 1st free address is" . prhex(16,$i) . "\n");
			$high=$ba+($l*2)-2;
			$i = "Used memory area is: low=" . prhex(16,$low) . " high=" . prhex(16,$high);
			prlog("$i\n");					
			Write_Register(0,$sa);				# $R[0] = $sa;	PC == start address
			prlog("Start address (P) is:" . prhex(16,$sa) . "\n");			
		}		
	}
	elsif(UP($w[0]) eq "ATTACH" || UP($w[0]) eq "ATT")
	{
		if(UP($w[1]) eq "PTR")
		{
			$file = $w[2];
			if($file eq "")
			{
				prlog("No proper filename\n");
			}
			else
			{
				if($PTR[FILE] ne "")
				{
					close ($PTR[FC]) || die "can't close $PTR[FILE]: $!";
					prlog("File $PTR[FILE] detached from device PTR and closed\n");
					$PTR[FILE] = "";         # file detached and closed; device inoperable	
				}
				if(! open (PTR, $file))
				{
					prlog( "Cannot open papertape input file: $file\n");
					$PTR[FILE]="";
					$PTR[FC]=0;					
				}
				else
				{
					$PTR[FC] = \*PTR;
					binmode $PTR[FC], ":raw";
					prlog("File $file attached to device PTR\n");
					$PTR[FILE] = $file;           # file attached and open
				}
				Write_SWITCHES(1,0,0,0);		# reset fptr
			}
		}	
		elsif(UP($w[1]) eq "PTP")
		{
			$file = $w[2];
			if($file eq "")
			{
				prlog("No proper filename\n");
			}
			else
			{
				if($PTP[FILE] ne "")
				{
					close ($PTP[FC]) || die "can't close ($PTP[FILE]: $!";
					prlog("File $PTP[FILE] detached from device PTP and closed\n");
					$PTP[FILE] = "";         # file detached and closed; device inoperable	
				}				
				if(! open (PTP, ">:raw", $file))
				{
					prlog("Cannot open papertape punch file: $file\n");
					$PTP[FILE]="";
					$PTP[FC]=0;
				}
				else
				{
					$PTP[FC] = \*PTP;
					prlog("File $file attached to device PTP\n");
					$PTP[FILE] = $file;		      # file attached and open
				}
			}				
		}	
		else
		{
			prlog("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 "")
			{
				prlog("Device PTR not attached\n");
			}
			else
			{
				close ($PTR[FC]) || die "can't close $file: $!";
				prlog("File $file detached from device PTR and closed\n");
				$PTR[FILE] = "";         # file detached and closed; device inoperable
				$PTR[FC]=0;
				Write_SWITCHES(1,0,0,0);		# reset fptr	
			}
		}
		elsif(UP($w[1]) eq "PTP")
		{
			$file = $PTP[FILE];
			if($file eq "")
			{
				prlog("Device PTP not attached\n");
			}
			else
			{
				close ($PTP[FC]) || die "can't close $file: $!";
				prlog("File $file detached from device PTP and closed\n");			
				$PTP[FILE] = "";			# file detached and closed; device inoperable	
				$PTP[FC]=0;	
			}				
		}		
		else
		{
			prlog("Unsupported device $w[1]\n");
		}
	}
	elsif(UP($w[0]) eq "DUMP" || UP($w[0]) eq "DU")
	{
		my $str;
		my $c;
		my $M;
		$s = UP($w[1]);		
		if(($m=cvhex($s)) >= 0)
		{
			$m=$m & 0xFFE0;
			$s = UP($w[2]);	
			if(($n=cvhex($s)) >= 0)
			{
				# dump on screen
				while($m < $n)
				{
					$str="";
					$s=0;
					prlog( prhex(16,$m) . " ");
					while($s<8)
					{
						$M = Read_SRAM($m);
						prlog( prhex(16,$M));
						$c=$ch{($M >> 8) & 0xFF};
						if($c ne undef)
						{	
							$str = $str . $c;
						}
						else
						{
							$str = $str . ".";
						}
						$c=$ch{$M & 0xFF};
						if($c ne undef)
						{
							$str = $str . $c;
						}
						else
						{
							$str = $str . ".";
						}						
						$m=$m+2;
						$s=$s+1;
					}
					prlog("  $str\n");
				}
			}
			else
			{
				prlog ("End address wrong or missing\n");
			}
		}
		else
		{
			prlog ("Begin address wrong or missing\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<0x10000)
			{
				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 = 0x40; # set the CPU Step bit
	  	Write_SWITCHES($Switch,0,0,0);
			
	  	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 $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 
 	  	
		$PC =Read_Register(PC);
		$A1 =Read_Register(A1);	
		$A2 =Read_Register(A2);	
		$A3 =Read_Register(A3);
		$A4 =Read_Register(A4);	
		$A5 =Read_Register(A5);	
		$A6 =Read_Register(A6);
		$A7 =Read_Register(A7);	
		$A8 =Read_Register(A8);	
		$A9 =Read_Register(A9);
		$A10=Read_Register(A10);	
		$A11=Read_Register(A11);	
		$A12=Read_Register(A12);	
		$A13=Read_Register(A13);	
		$A14=Read_Register(A14);	
		$A15=Read_Register(A15);
		$PSW=Read_Register(PSW);	
			
		prlog("P" . prhex(16,$PC) . " IR" . prhex(16,$IR) . " PSW" . prhex(16,$PSW) . " ");
  		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");	
	
		prlog("R"      . prhex(16,$A1)  . prhex(16,$A2)  . prhex(16,$A3) . 
		prhex(16,$A4)  . prhex(16,$A5)  . prhex(16,$A6)  . prhex(16,$A7) . 
		prhex(16,$A8)  . prhex(16,$A9)  . prhex(16,$A10) . prhex(16,$A11) .
		prhex(16,$A12) . prhex(16,$A13) . prhex(16,$A14) . prhex(16,$A15));

      		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)
  						{
  							prlog("\nPapertape reader: EOT\n");
  							$error_ptr=1;  				
  						}
  					} 			
  					if($ch1 != 0) # 0 => EOT
  					{
  						$ch1 = $ch1 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							prlog("\nPapertape reader: EOT\n");
  							$error_ptr=1;  				
  						}
  					} 		
  					if($ch2 != 0) # 0 => EOT
  					{
  						$ch2 = $ch2 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							prlog("\nPapertape reader: EOT\n");
  							$error_ptr=1;  				
  						}
  					} 
  					if($ch3 != 0) # 0 => EOT
  					{
  						$ch3 = $ch3 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							prlog("\nPapertape reader: EOT\n");
  							$error_ptr=1;  				
  						}
  					}
  					if($ch4 != 0) # 0 => EOT
  					{
  						$ch4 = $ch4 & 0xFF;
  					}
   					else
  					{
  						if($error_ptr==0)
  						{
  							prlog("\nPapertape reader: EOT\n");
  							$error_ptr=1;  				
  						}
  					} 
  					Write_FPTR($ch0,$ch1,$ch2,$ch3,$ch4);
  					if($DEBUG)
  					{
  						print("PTR:" . prhex(8,$ch0) . prhex(8,$ch1) . prhex(8,$ch2) . prhex(8,$ch3) . prhex(8,$ch4) . "\r"); # show ptr activity
  			 		}
  					else
  					{
  						ptactivity(); ##<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  					}
  				}
  				else
  				{
  					if($error_ptr==0)
  					{
  						prlog("\nPTR request, but not attached\n");
  						$error_ptr=1;  				
  					}
  				}
  			}  			  					
  			if($PU) # papertape punch request
  			{
  				if($PTP[FC] != 0)
  				{
  					if($DEBUG)
  					{
  						print("PTP:" . prhex(8,$b4) . "\r"); # show ptp activity
  			 		}
  					else
  					{
  						ptactivity(); ##<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  					}
        	  			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;
				$Switch=0;		
				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 INR 
							$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 INR 
							$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;
				prlog("*** HLT instruction stopped the trace ***\n");
			}
			$nbr = -1;
		}      	
  	}#while($RUNCPU)
  	}
	elsif((UP($cmd) eq "EXIT"))
	{
		if($testflag == 0)
		{
			if(CpuIsInactive())
			{
			  Close_USB_Port;
			  if($logfile ne "")
			  {
			     prlog("Logfile $logfile is closed\n");
			     close LOG || die "can't close $logfile: $!";
			  }
			  if($PTR[FILE] ne "")
	                  {
		             $file = $PTR[FILE];
		             close ($PTR[FC]) || die "can't close $file: $!";
		             prlog("PTR closed\n");
		          }
			  if($PTP[FILE] ne "")
			  {
		            $file = $PTP[FILE];
		            close ($PTP[FC]) || die "can't close $file: $!";
		            prlog("PTP closed\n");
		          }
		          prlog ("EXIT!\n");				
			  exit;
			}
			else
			{
				prlog ("CPU still active; Stop 1st, then Exit\n");
			}
		}
		else
		{
			prlog ("EXIT!\n");
			if($logfile ne "")
			{
				prlog("Logfile $logfile is closed\n");
				close LOG || die "can't close $logfile: $!";
			}
			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;
		print LOG "\n";
	}
}
###########################################################################
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 $str= "IR=" . prhex(16,$IR) . "\n";
  	if($DEBUG) {prlog($str);}
  	if($b0 & 1) 
	{
		$CpuActive=1;
	 	if($DEBUG) {prlog("*** CPU is Active\n");}
	} 
	else 
	{
		$CpuActive=0;
	 	if($DEBUG) {prlog("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 $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 	
   	
	$PC =Read_Register(PC);
	$A1 =Read_Register(A1);	
	$A2 =Read_Register(A2);	
	$A3 =Read_Register(A3);
	$A4 =Read_Register(A4);	
	$A5 =Read_Register(A5);	
	$A6 =Read_Register(A6);
	$A7 =Read_Register(A7);	
	$A8 =Read_Register(A8);	
	$A9 =Read_Register(A9);
	$A10=Read_Register(A10);	
	$A11=Read_Register(A11);	
	$A12=Read_Register(A12);	
	$A13=Read_Register(A13);	
	$A14=Read_Register(A14);	
	$A15=Read_Register(A15);
	$PSW=Read_Register(PSW);
  	prlog("\n");
  
	prlog("P" . prhex(16,$PC) . " IR" . prhex(16,$IR) . " PSW" . prhex(16,$PSW) . " ");
  	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");	

	prlog("R"      . prhex(16,$A1)  . prhex(16,$A2)  . prhex(16,$A3) . 
	prhex(16,$A4)  . prhex(16,$A5)  . prhex(16,$A6)  . prhex(16,$A7) . 
	prhex(16,$A8)  . prhex(16,$A9)  . prhex(16,$A10) . prhex(16,$A11) .
	prhex(16,$A12) . prhex(16,$A13) . prhex(16,$A14) . prhex(16,$A15));
	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 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 = $_;
}

# read octad from papertape, attached to filecode IN (used by SCP load commands)
sub nextchar {
	my $c;
	read(IN,$c,1);
	$c = unpack("C", $c); 	#get new current char
	return ($c & 0xFF);
}

# read word (2 octads) from papertape
sub nextword {
	my $w = nextchar();
	$w = $w << 8;
	$w = $w + nextchar();;
	return $w;
}
	
# 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";
		Write_SWITCHES(1,0,0,0);		# reset fptr
		prlog("File $file reattached to device PTR\n");
	}
	else
	{
		prlog("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;
		prlog("File $file reattached to device PTP\n");
	}
	else
	{
		prlog("No file attached to device PTP\n");
	}
}

sub ptactivity{
	if($ptstate == 0)
	{
		print "\-\r";
	}
	if($ptstate == 1)
	{
		print "\\\r";
	}
	if($ptstate == 2)
	{
		print "\/\r";
		$ptstate=0;
	}
	else
	{
		$ptstate=$ptstate+1;
	}
}