# #############################################################################
#
# Copyright (c) 1999-2001 by Wayne C. Gramlich.
# All rights reserved.
#
# Permission to use, copy, modify, distribute, and sell this software
# for any purpose is hereby granted without fee provided that the above
# copyright notice and this permission are retained.  The author makes
# no representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# This is a test harness for testing the Threshold4 RoboBrick.  Please see:
#
#   http://web.gramlich.net/projects/robobricks/threshold4/index.html
#
# for more details.
#
# #############################################################################

processor pic16f84 cp=off dp=off pwrte=disabled wdte=disabled fosc=xt
constant clock_rate 4000000
constant instruction_rate clock_rate / 4
constant baud_rate 2400
constant instructions_per_bit instruction_rate / baud_rate
constant delays_per_bit 3
constant instructions_per_delay instructions_per_bit / delays_per_bit
constant delay_count instructions_per_delay / 6
constant cr 13
constant lf 10
constant sp 32

# Some bit definitions:
constant rx_slave_bit 0
constant tx_slave_bit 1
constant tx_master_bit 2
constant rx_master_bit 3
constant rx_slave_mask 1 << rx_slave_bit
constant tx_slave_mask 1 << tx_slave_bit
constant rx_master_mask 1 << rx_master_bit
constant tx_master_mask 1 << tx_master_bit

port porta a bits_only read_write_static
pin tx_master_pin porta tx_master_bit write_only
pin rx_master_pin porta rx_master_bit read_only
pin tx_slave_pin porta tx_slave_bit write_only
pin rx_slave_pin porta rx_slave_bit read_only
pin heart porta 4 write_only
port portb b unused none

constant space 0xff

global receiving bit

string_constants {
    hello_string = 0s'Threshold4'
    common_string = 0s'Common'
    interrupt_string = 0s'Interrupt'
    complement_string = 0s'Compl'
    register_string = 0s'Reg'
    high_string = 0s'High'
    low_string = 0s'Low'
    raising_string = 0s'Raise'
    falling_string = 0s'Fall'
    fail_string = 0s'Fail'
    succeed_string = 0s'Succeed'
    pattern_string = 0s'Pattern'
    masks_string = 0s'Masks'
    done_string = 0s'Done'
    patterns = 0, 1, 2, 4, 8, 15, 15 - 1, 15 - 2, 15 - 4, 15 - 8, 0
}

procedure main {
    arguments_none
    returns_nothing

    # This is the main procedure:

    variable counter byte

    # Initialize:
    tx_slave_pin := 1
    tx_master_pin := 1

    # Wait for capacitors to charge up:
    count_down counter 254 {
	call delay()
    }
    call master_string(hello_string)
    call master_crlf()

    # Main loop:
    loop_forever {
	# Get a character:
	call master_string(hello_string)
	call master_prompt()
	call test()
	call master_string(done_string)
	call master_crlf()
    }
}

procedure test {
    arguments_none
    returns_nothing

    # This procedure will test out a Threshold4 RoboBrick.

    variable index byte
    variable result byte
    variable pattern byte
    variable error bit

    # Test common shared commands:
    call common_test()

    # Test shared interrupt commands:
    call interrupt_test()

    # Test the registers:
    # Test Complement Mask Register
    call test_register(complement_string, 1, 0x10)
    # Test Low Mask Register
    call test_register(high_string, 2, 0x20)
    # Test High Mask Register
    call test_register(low_string, 3, 0x30)
    # Test Raising Mask Register
    call test_register(raising_string, 4, 0x40)
    # Test Falling Mask Register
    call test_register(falling_string, 5, 0x50)

    # Test high interrupt mask:
    call test_interrupt(high_string, 0, 0xf, 0x20)
    # Test low interrupt mask:
    call test_interrupt(low_string, 0xf, 0, 0x30)
    # Test raising interrupt mask:
    call test_interrupt(raising_string, 0, 0xf, 0x40)
    # Test falling interrupt mask:
    call test_interrupt(falling_string, 0xf, 0, 0x50)

    # Do some read pattern tests:
    index := 0
    while (index < patterns.size) {
	pattern := patterns[index]

	error := 1
	while (error) {
	    call test_pattern_prompt(pattern)
	    call master_prompt()

	    error := test_pattern(pattern, 0, 5)
	    if (!error) {
		error := test_pattern(pattern, 0xf, 0x12)
		if (!error) {
		    error := test_pattern(pattern, 0, 0x14)
		}
	    }
	}
	index := index + 1
    }
}

# The procedures below are used to test the common shared commands:

procedure common_test {
    arguments_none
    returns_nothing

    # This procedure will verify that the common shared commands work.

    variable actual byte

    # Print the ID information:
    # ID reset:
    call slave_send(0xfd)
    # Read the fixed bytes:
    call common_test_id_match(1, 0xc0)
    call common_test_id_match(0, 0xc1)
    call common_test_id_match(19, 0xc2)
    call common_test_id_match(0, 0xc3)
    call common_test_id_match(0, 0xc4)
    call common_test_id_match(0, 0xc5)
    call common_test_id_match(0, 0xc6)
    call common_test_id_match(0, 0xc7)
    call master_crlf()
    call common_test_id_bytes8()
    call common_test_id_bytes8()
    # Read the brick name:
    call common_test_id_string()
    # Read the vendor name:
    call common_test_id_string()
    # Verfify that we don't read off the end of the id and crash:
    call common_test_id_next()
    # Reset id:
    call slave_send(0xfd)
    # Verify that we are still alive:
    call common_test_id_match(1, 0xc8)

    # Read glitch:
    # Clear glitch register:
    call slave_send(0xfe)
    actual := slave_get()
    # Send a couple of glitches:
    call slave_send(0xff)
    call slave_send(0xff)
    # Read the glitch register:
    call slave_send(0xfe)
    if (slave_get() != 2) {
	call master_fail(common_string, 0xc9)
    }

    # Do a clock pulse:
    call slave_send(0xfb)
    if (slave_get() != 0) {
	call master_fail(common_string, 0xca)
    }
    # Read clock:
    call slave_send(0xfa)
    actual := slave_get()
    # Increment:
    call slave_send(0xf9)
    # Decrement:
    call slave_send(0xf8)
    # Read clock again:
    call slave_send(0xfa)
    if (actual != slave_get()) {
	call master_fail(common_string, 0xcb)
    }
}

procedure common_test_id_match {
    argument desired byte
    argument test_number byte
    returns_nothing

    # This procedure will verify that the next byte in the id is {desired}.

    if (desired != common_test_id_next()) {
	call master_fail(common_string, test_number)
    }
}

procedure common_test_id_bytes8 {
    arguments_none
    returns_nothing

    # This procedure will print out the next 8 bytes of the id in octal.

    variable count byte

    count_down count 8 {
	call master_octal(common_test_id_next())
    }
    call master_crlf()
}

procedure common_test_id_string {
    arguments_none
    returns_nothing

    # This procedure will print out the next id string.

    variable count byte

    count_down count (common_test_id_next()) {
	call master_send(common_test_id_next())
    }
    call master_crlf()
}

procedure common_test_id_next {
    arguments_none
    returns byte

    # This procedure returns the next byte from the identification string.

    call slave_send(0xfc)
    return slave_get()
}

# The procedures below are used to test the shared interrupt commands:

procedure interrupt_test {
    arguments_none
    returns_nothing

    # This procedure tests the common shared interrupt commands.

    variable counter byte

    # Clear interrupt bits:
    call slave_send(0xf0)
    call interrupt_read(0, 0xd0)

    # Set/clear interrupt pending bit only:
    call slave_send(0xf5)
    call interrupt_read(1, 0xd1)
    call slave_send(0xf4)
    call interrupt_read(0, 0xd2)
    call slave_send(0xf1)
    call interrupt_read(1, 0xd3)
    call slave_send(0xf0)
    call interrupt_read(0, 0xd4)

    # Set/clear interrupt enable bit only:
    call slave_send(0xf7)
    call interrupt_read(2, 0xd5)
    call slave_send(0xf6)
    call interrupt_read(0, 0xd6)
    call slave_send(0xf2)
    call interrupt_read(2, 0xd7)
    call slave_send(0xf0)
    call interrupt_read(0, 0xd8)

    # Now set both the interrupt enable and pending bit.
    # This must trigger an interrupt.

    call slave_send(0xf3)
    count_down counter 3 {
	call delay()
    }
    if (rx_slave_pin) {
	# No interrupt detected:
	call master_fail(interrupt_string, 0xd9)
    }
    # Read the interrupt enable bit is cleared as a side effect
    # of reading the bit.
    call interrupt_read(1, 0xda)

    # Clear the interrupt pending big:
    call slave_send(0xf0)
    call interrupt_read(0, 0xdb)
}

procedure interrupt_read {
    argument desired byte
    argument test_number byte
    returns_nothing

    # This procedure will verify that the interrupt bits match {desired}.

    call slave_send(0xef)
    if (slave_get() != desired) {
	call master_fail(interrupt_string, test_number)
    }
}

# The procedures below are more specific to testing the Threshold4:

procedure test_masks {
    arguments_none
    returns_nothing

    variable command byte

    call master_string(masks_string)
    command := 1
    while (command <= 5) {
	call slave_send(command)
	call master_octal(slave_get())
	command := command + 1
    }
    call master_crlf()
}

procedure test_register {
    argument name string
    argument read_command byte
    argument write_command byte
    returns_nothing

    # This procedure will test out a register.

    variable index byte
    variable pattern byte

    index := 0
    while (index < patterns.size) {
	pattern := patterns[index]
	call slave_send(write_command | pattern)
	call slave_send(read_command)
	if (slave_get() != pattern) {
	    call master_fail(name, pattern)
	}
	index := index + 1
    }
}

procedure test_pattern {
    argument pattern byte
    argument complement byte
    argument error byte
    returns bit

    variable result byte

    # Set complement mask:
    call slave_send(0x10 | complement)
    
    # Raw read:
    call slave_send(6)
    result := slave_get()
    if (result != pattern) {
	call master_octal(result)
	call master_fail(pattern_string, error)
	return 1
    }

    # Regular Read:
    call slave_send(0)
    result := slave_get()
    if (result != pattern ^ complement) {
	call master_octal(result)
	call master_fail(pattern_string, error | 1)
	return 1
    }

    return 0
}

procedure test_pattern_prompt {
    argument pattern byte
    returns_nothing

    # This procedure will outpu `0's and `*'s for each bit in pattern.

    variable count byte

    count_down count 4 {
	if (pattern@3) {
	    call master_send(0c'*')
	} else {
	    call master_send(0c'0')
	}
	pattern := pattern << 1
    }
}

procedure test_interrupt {
    argument name string
    argument start_pattern byte
    argument end_pattern byte
    argument set_command byte
    returns_nothing

    # This procedure will test to see that an interrupt occurs.

    variable pattern byte
    variable temp byte
    variable counter1 byte
    variable counter2 byte

    # Do the setup:
    pattern := start_pattern + 1
    while (pattern != start_pattern) {
	call test_pattern_prompt(start_pattern)
	call master_prompt()
	call slave_send(0)
	pattern := slave_get()
    }
    call test_masks()

    # Set the mask:
    call slave_send(set_command | 0xf)
    call test_masks()

    # Enable interrupt:
    call slave_send(0xf2)
    # Verify that interrupt flag is off:
    call slave_send(0xef)
    temp := slave_get()
    if (temp != 2) {
	call master_octal(temp)
	call master_fail(name, 0x20)

	# Clear the mask:
	call slave_send(set_command)

	return
    }

    # Now ask the user to change the input.
    call test_pattern_prompt(end_pattern)

    # Wait for the interrupt:
    # (255*255)/(3*2400)=9.03sec:
    counter1 := 255
    while (counter1 != 0) {
	counter1 := counter1 - 1
	counter2 := 255
	while (counter2 != 0) {
	    counter2 := counter2 - 1
	    call delay()
	    if (!rx_slave_pin) {
		counter2 := 0
		counter1 := 0
	    }
	}
    }
    if (rx_slave_pin) {
	# We timed out:
	call master_fail(name, 0x21)
	# Verify that pending bit is on and enable bit gets turned off:
	call slave_send(0xef)
	if (slave_get() != 1) {
	    call master_fail(name, 0x22)
	}
    } else {
	call master_string(name)
	call master_string(succeed_string)
	call master_crlf()
    }

    # Clear the mask:

    call slave_send(set_command)

    # Clear the interrupt pending and enable mask:
    call slave_send(0xf0)
}

procedure master_prompt {
    arguments_none
    returns_nothing

    # This procedure will wait until the user types a character:

    variable character byte

    call master_send(0c'?')
    character := master_get()
    call master_send(character)
    call master_crlf()
}

procedure master_get {
    arguments_none
    returns byte

    # This procedure will wait for, receive and return the next byte
    # from the master.

    variable character byte

    # FIXME: should be "return get_byte(rx_master_mask)"

    character := 0xfc
    while (character = 0xfc) {
	character := get_byte(rx_master_mask)
    }
    return character
}

procedure master_fail {
    argument test_name string
    argument test_number byte
    returns_nothing

    # This procedure will output `fail' followed by a carriage return
    # and line feed.

    call master_string(fail_string)
    call master_string(test_name)
    call master_octal(test_number)
    call master_crlf()
}

procedure master_crlf {
    arguments_none
    returns_nothing

    # This procedure will output a carriage return line feed to the master.

    call master_send(cr)
    call master_send(lf)
}

procedure master_string {
    argument message string
    returns_nothing

    # This procedure will output {message} to the master.

    variable size byte
    variable index byte

    index := 0
    count_down size (message.size) {
	call master_send(message[index])
	index := index + 1
    }
    call master_send(sp)
}

procedure master_octal {
    argument number byte
    returns_nothing

    # This procedure will output {number} in octal to the master.

    # Output the character in octal:
    call master_send((number>>6) + 0c'0')
    call master_send(((number>>3) & 7) + 0c'0')
    call master_send((number & 7) + 0c'0')
    call master_send(32)
}

procedure slave_send {
    argument character byte
    returns_nothing

    # This procedure will send {character} to the slave RoboBrick.

    call send_byte(character, tx_slave_mask)
}

procedure master_send {
    argument character byte
    returns_nothing

    # This procedure will send {character} to the master.

    call send_byte(character, tx_master_mask)
}

procedure slave_get {
    arguments_none
    returns byte

    # This procedure will wait for, receive and return the next byte
    # from the slave

    variable result byte

    # FIXME: should be "return get_byte(rx_slave_mask)"

    result := get_byte(rx_slave_mask)
    return result
}

procedure get_byte {
    argument mask byte
    returns byte

    # Get an 8-bit byte from {mask} bit of {porta} and return it.
    # If no character shows up in a while 0xfc is returned.

    variable count byte
    variable char byte

    # Wait until a start bit arrives:
    receiving := 1
    count := 0
    while (porta & mask != 0) {
	count := count - 1
	if (count = 0) {
	    return 0xfc
	}
	call delay()
    }

    # Skip over the start bit:
    call delay()
    call delay()
    call delay()

    # Sample in the middle third of each data bit:
    char := 0
    count_down count 8 {
	call delay()
	char := char >> 1
	if (porta & mask != 0) {
	    char := char | 0x80
	}
	call delay()
	call delay()
    }

    # Skip over 1/3 of the stop bit:
    call delay()

    return char
}

procedure send_byte {
    argument char byte
    argument mask byte
    returns_nothing

    # Send {char} to {mask} bit of {porta}.

    variable count byte
    variable mark byte

    if (receiving) {
	receiving := 1
	call delay()
	call delay()
    }

    # Send the start bit:
    mark := mask ^ space
    porta := mark
    call delay()
    call delay()
    call delay()

    # Send the data:
    count_down count 8 {
	if (char@0) {
	    porta := space
	} else {
	    porta := mark
	}
	char := char >> 1
	call delay()
	call delay()
	call delay()
    }

    # Send the stop bit:
    porta := space
    call delay()
    call delay()
    call delay()
}

procedure delay {
    arguments_none
    returns_nothing
    uniform_delay instructions_per_delay

    # This procedure will delay for 1/3 of a bit time.
}