ucl 2.0

# Copyright (c) 2005-2006 by Wayne C. Gramlich
# All rights reserved.

library $pic16f688
library clock20mhz
library $uart
constant $eusart_clock = clock_rate
constant $eusart_factor = 4
library $eusart

configure fosc=hs

package pdip
    pin 1 = power_supply
    pin 2 = osc1
    pin 3 = osc2
    pin 4 = ra3_in, name=dtr
    pin 5 = rx, name=rx
    pin 6 = tx, name=tx
    pin 7 = rc3_out, name=p3
    pin 8 = rc2_out, name=p2
    pin 9 = rc1_in, name=p1
    pin 10 = rc0_in, name=p0
    pin 11 = ra2_out, name=p6
    pin 12 = ra1_in, name=p5
    pin 13 = ra0_out, name=p4
    pin 14 = ground

global error bit
global end_of_line bit
global hex_high byte
global hex_low byte
global bus_shift byte
global time_out bit
global bus_msb bit

procedure main
    arguments_none
    returns_nothing

    # This is the main procdure that initializes the the microcontroller
    # and waits for commands from the host.

    local bit9 bit
    local command byte
    local id byte
    #local index byte
    local low byte
    local node byte
    local page byte
    local receive byte
    local row byte
    local send byte
    local value byte

    #loop_forever
    #	p2 := $true
    #	p2 := $false

    # Warm up the EUSART:
    $trisc@5 := $true
    $trisc@4 := $true

    $txsta := 0
    $tx9 := $false
    $txen := $true
    $brgh := $true

    $rcsta := 0
    $spen := $true
    $rx9 := $false
    $cren := $true
    $adden := $true

    $baudctl := 0
    $brg16 := $true

    $spbrg := $eusart_19200_low
    $spbrgh := $eusart_19200_high
    #$spbrg := $eusart_115200_low
    #$spbrgh := $eusart_115200_high
    #$spbrg := $eusart_230400_low
    #$spbrgh := $eusart_230400_high

    # For debugging only -- just output a stream of 'U':
    #loop_forever
    #	loop_exactly 255
    #	    delay 600
    #		do_nothing
    #	call $uart_byte_put('U')

    # For debugging only -- Double echo:
    #loop_forever
    #	# Wait for command:
    #	command := $uart_byte_get()
    #	call $uart_byte_put(command)
    #	call $uart_byte_put(command)

    # Process commands:
    loop_forever
	# Wait for command:
	error := $false
	end_of_line := $false

	# Fetch a command letter from the user:
	#command := character_get()
	command := $uart_byte_get()
	if command & 0x80 = 0
	    # ASCII mode command:

	    # Echo the character:
	    call $uart_byte_put(command)

	    # Convert it to upper case:
	    if 'a' <= command && command <= 'z'
		command := command + ('A' - 'a')

	    # Dispatch on command letter:
	    if command = 'A'
		# Set address:
		id := hex_byte_get()
		node := hex_byte_get()
		if end_of_line_get()
		    call $uart_hex_put(id)
		    call $uart_space_put()
		    call $uart_hex_put(node)
		    call $uart_crlf_put()
	    else_if command = 'B'
		value := hex_byte_get()
		if end_of_line_get()
		    call $uart_hex_put(value)
		    call $uart_crlf_put()
	    else_if command = 'C'
		# Clear bus:
		if end_of_line_get()
		    call $uart_crlf_put()
	    else_if command = 'D'
		# Deselect:
		if end_of_line_get()
		    call $uart_crlf_put()
		    call bus_byte_send(0xff)
		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			if bus_msb
			    call $uart_byte_put('1')
			call $uart_hex_put(value)
		    call $uart_crlf_put()
	    else_if command = 'F'
		# Flush buffer
		if end_of_line_get()
		    time_out := $false
		    while !time_out
			value := bus_byte_receive()
			call $uart_space_put()
			if time_out
			    call $uart_byte_put('@')
			else
			    call $uart_hex_put(value)
		    call $uart_crlf_put()
	    else_if command = 'I'
		# Identify:
		if end_of_line_get()
		    call id_dump()
	    else_if command = 'J'
		# Jump:
		call hex_word_get()
		if end_of_line_get()
		    call $uart_hex_put(hex_high)
		    call $uart_hex_put(hex_low)
		    call $uart_crlf_put()
	    else_if command = 'P'
		# Print a page of program memory:
		page := hex_byte_get()
		if end_of_line_get()
		    row := 0
		    low := 0
		    while row < 16
			call $uart_hex_put(page)
			call $uart_hex_put(low)
			call $uart_byte_put(':')

			# Set address:
			call bus_byte_send(0)
			call bus_byte_receive()

			call bus_byte_send(page)
			call bus_byte_receive()

			call bus_byte_send(low)
			call bus_byte_receive()

			# Read the ack byte:
			call bus_byte_receive()

			# Read out 8 words:
			call bus_byte_send(1)
			call bus_byte_receive()

			call bus_byte_send(8)
			call bus_byte_receive()
			loop_exactly 8
			    value := bus_byte_receive()
			    call $uart_space_put()
			    if time_out
				call $uart_byte_put('@')
			    else
				call $uart_hex_put(value)
			    value := bus_byte_receive()
			    if time_out
				call $uart_byte_put('@')
			    else
				call $uart_hex_put(value)

			# Read the ack byte:
			call bus_byte_receive()

			call $uart_crlf_put()
			row := row + 1
			low := low + 8
	    else_if command = 'R'
		# Read:
		call hex_word_get()
		if end_of_line_get()
		    call $uart_hex_put(hex_high)
		    call $uart_hex_put(hex_low)
		    call $uart_crlf_put()
	    else_if command = 'S'
		# Select:
		node := hex_byte_get()
		if end_of_line_get()
		    call $uart_crlf_put()
		    call bus_select_send(node)
		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)
		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)
		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)
		    call $uart_crlf_put()
	    else_if command = 'W'
		# Write:
		call hex_word_get()
		value := hex_byte_get()
		if end_of_line_get()
		    call $uart_hex_put(hex_high)
		    call $uart_hex_put(hex_low)
		    call $uart_hex_put(value)
		    call $uart_crlf_put()
	    else_if command = 'X'
		# Transmit:
		value := hex_byte_get()
		if end_of_line_get()
		    #call $uart_hex_put(value)
		    #call $uart_crlf_put()
		    call bus_byte_send(value)

		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)

		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)

		    value := bus_byte_receive()
		    if time_out
			call $uart_byte_put('@')
		    else
			call $uart_hex_put(value)

		    call $uart_crlf_put()
	    else_if command = 'Z'
		# Sweep bus looking for modules:
		if end_of_line_get()
		    node := 1
		    while node != 0
			call bus_select_send(node)
			value := bus_byte_receive()
			value := bus_byte_receive()
			if !time_out
			    call $uart_hex_put(node)
			    call $uart_byte_put(':')
			    call id_dump()
			node := node + 1
	    else_if command = ':'
		# Hex:
		if end_of_line_get()
		    call $uart_crlf_put()
	    else_if command = '\r\'
		# Blank line:
		do_nothing
	    else
		# Illegal command:
		call $uart_byte_put('?')
		call $uart_crlf_put()

	    # Provide a prompt:
	    call $uart_byte_put('>')
	else
	    # Binary mode command:
	    send := (command >> 3) & 7
	    receive := command & 7
	    bit9 := $false
	    if command@6
		bit9 := $true
	    if send != 0
		loop_exactly send
		    command := $uart_byte_get()
		    if bit9
			bit9 := $false
			call bus_select_send(command)
		    else
			call bus_byte_send(command)
		    call bus_byte_receive()
	    if receive != 0
		#index := 0
		loop_exactly receive
		    command := bus_byte_receive()
		    if time_out
			call $uart_byte_put(0xfc)
		    else
			call $uart_byte_put(command)
		    #call $uart_byte_put(0x40 | index)
		    #index := (index + 1) & 0x3f


procedure id_dump
    arguments_none
    returns_nothing

    # This procedure will print out the id information for the
    # currently selected module.

    local value byte

    # Reset the id index:
    value := bus_byte_send_receive(0xfe)

    # Read the fixed part:
    loop_exactly 5
	value := bus_byte_send_receive(0xfd)
	call $uart_hex_put(value)
	call $uart_space_put()

		
    # Dump the name string:
    if value & 2 != 0
	call string_dump()

    # Dump the vendor string:
    if value & 1 != 0
	call string_dump()

    call $uart_crlf_put()


procedure string_dump
    arguments_none
    returns_nothing

    # This procedure will dump a string from the id information.

    local length byte

    # We have a vendor string; now read the length:
    call $uart_space_put()
    length := bus_byte_send_receive(0xfd)
    call $uart_hex_put(length)
    call $uart_byte_put(':')

    # Print out the vendor string:
    call $uart_byte_put('"')
    loop_exactly length
	call $uart_byte_put(bus_byte_send_receive(0xfd))
    call $uart_byte_put('"')


procedure bus_byte_send_receive
    argument value byte
    returns byte

    # This procedure will send {value} to the currently selected module
    # and return the response.

    call bus_byte_send(value)
    call bus_byte_receive()
    return bus_byte_receive()


procedure bus_byte_send
    argument value byte
    returns_nothing

    # This procedure will cause a {value} byte to be sent to the bus.

    #call $uart_byte_put('{')
    loop_exactly 4
	call shift2(value & 3)
	value := value >> 2
    call shift2(4)
    #call $uart_byte_put('}')


procedure bus_select_send
    argument node byte
    returns_nothing

    # This procedure will cause a {node} select byte to be sent.

    loop_exactly 4
	call shift2(node & 3)
	node := node >> 2
    call shift2(5)


procedure bus_byte_receive
    arguments_none
    returns byte

    # This procedure receive a byte from the bus processor.
    # {time_out} is set if no byte is received in a reasonable
    # amount of time.

    #call $uart_byte_put('[')
    time_out := $false
    # Where does 15*20 come from?  This seems to be the minimum
    # timeout that works with programming a PIC16F876.
    loop_exactly 15
	loop_exactly 20
	    call shift2(6)
	    if !(bus_shift@1)
		# We got one:
		bus_msb := $false
		if bus_shift@0
		    bus_msb := $true
		loop_exactly 4
		    call shift2(0)
		#call $uart_byte_put(']')
		return bus_shift
    time_out := $true
    #call $uart_byte_put(']')
    return 0


procedure shift2
    argument value byte
    returns_nothing

    # This procedure will cause 3 bits to be sent to the bus processor
    # and 2 bits returned from the bus processor into {bus_shift}.

    #call $uart_byte_put('<')

    # Set the 3 bits to send up.  The two lower bits are data and
    # the 3rd bit is STROBE.
    p4 := $false
    p3 := $false
    p2 := $false

    if value@2
	p4 := $true
    #	call $uart_byte_put('1')
    #else
    #	call $uart_byte_put('0')
    if value@1
	p3 := $true
    #	call $uart_byte_put('1')
    #else
    #	call $uart_byte_put('0')
    if value@0
	p2 := $true
    #	call $uart_byte_put('1')
    #else
    #	call $uart_byte_put('0')

    # Let the bus processor know that we have some data:
    if p6
	#call $uart_byte_put('L')
	p6 := $false
	# Wait until the bus processor has a response.
	while p5
	    do_nothing
    else
	#call $uart_byte_put('H')
	p6 := $true
	# Wait until the bus processor has a response.
	while !p5
	    do_nothing

    # The bus processor has a response.  Now grab the data.
    bus_shift := bus_shift << 2
    if p1
	bus_shift@1 := $true
    #	call $uart_byte_put('1')
    #else
    #	call $uart_byte_put('0')
    if p0
	bus_shift@0 := $true
    #	call $uart_byte_put('1')
    #else
    #	call $uart_byte_put('0')

    #call $uart_byte_put('>')


procedure character_get
    arguments_none
    returns byte

    # This procedure will get a character from the user and echo it.
    # If the user types '\r\', an extra line feed is output and
    # the global {end_of_line} bit is set.

    local character byte

    character := $uart_byte_get()
    call $uart_byte_put(character)
    if character = '\r\'
	end_of_line := $true
	call $uart_byte_put('\n\')
    return character


procedure end_of_line_get
    arguments_none
    returns bit

    # This procedure will return 1 if end of line has been reached
    # without error; otherwise 0 is returned and an error exclamation
    # point ('!') is output.

    local character byte

    if error
	return 0
    while !end_of_line
	character := character_get()
	if character != '\r\' && character != '\t\' && character != ' '
	    error := $true
	    call $uart_byte_put('!')
	    call $uart_crlf_put()
	    return 0
    return 1


procedure hex_byte_get
    arguments_none
    returns byte

    # This procedure will get a hex byte from the user.  Zero, one or
    # more spaces and tabs may preceed the hex byte.

    call hex_word_get()
    return hex_low


procedure hex_word_get
    arguments_none
    returns_nothing

    # This procedure will get a 16-bit hexadecimal value and return
    # the result in {hex_high} and {hex_low}.

    local character byte
    local digit byte

    hex_high := 0
    hex_low := 0
    character := ' '
    if !end_of_line
	while character = ' ' || character = '\t\'
	    character := character_get()

	loop_forever
	    if '0' <= character && character <= '9'
		digit := character - '0'
	    else_if 'A' <= character && character <= 'F'
		digit := character + (10 - 'A')
	    else_if 'a' <= character && character <= 'f'
		digit := character + (10 - 'a')
	    else_if character = ' ' || character = '\t\' || end_of_line
		return
	    else
		error := $true
		return
	    hex_high := (hex_high << 4) | (hex_low >> 4)
	    hex_low := (hex_low << 4) | digit
	    character := character_get()