ucl 1.0

# Copyright (c) 2000-2004 by Wayne C. Gramlich & William T. Benson.
# All rights reserved.

library $pic16f630
library clock4mhz
library bit_bang

package pdip
    pin 1 = power_supply
    pin 2 = ra5_in, name = south, mask = south_pin_mask
    pin 3 = ra4_in, name = west, mask = west_pin_mask
    pin 4 = ra3_in, name = serial_in
    pin 5 = rc5_out, name = east_led
    pin 6 = rc4_out, name = north_led
    pin 7 = rc3_out, name = west_led
    pin 8 = rc2_out, name = sout_led
    pin 9 = rc1_unused
    pin 10 = rc0_unused
    pin 11 = ra2_out, name = serial_out
    pin 12 = ra1_in, name = east, mask = east_pin_mask
    pin 13 = ra0_in, name = north, mask = north_pin_mask
    pin 14 = ground

constant port_mask =
  north_pin_mask | east_pin_mask | south_pin_mask | west_pin_mask

# Bearing constants:
constant north_bearing = 0
constant north_east_bearing = 1
constant east_bearing = 2
constant south_east_bearing = 3
constant south_bearing = 4
constant south_west_bearing = 5
constant west_bearing = 6
constant north_west_bearing = 7

# Bearing mask constants:
constant north_mask = 1 << north_bearing
constant north_east_mask = 1 << north_east_bearing
constant east_mask = 1 << east_bearing
constant south_east_mask = 1 << south_east_bearing
constant south_mask = 1 << south_bearing
constant south_west_mask = 1 << south_west_bearing
constant west_mask = 1 << west_bearing
constant north_west_mask = 1 << north_west_bearing

# Global variables go here:
global raw byte
global interrupts byte
global mask byte
global bearing byte

# Interrupt and shaft direction bits:
global interrupt_pending bit
global interrupt_enable bit
    
global command_previous byte
global command_last byte
global sent_previous byte
global sent_last byte

procedure main
    arguments_none
    returns_nothing

    local command byte
    local glitch byte
    local id_index byte
    local high byte
    local index byte
    local result byte
    local temp byte

    # Initialize everything:
    interrupts := 0
    interrupt_enable := 0
    interrupt_pending := 0
    glitch := 0
    id_index := 0

    # Loop waiting for commands:
    loop_forever
	# Get a command byte:
	command := byte_get()

	# Dispatch on command:
	switch command >> 6
	  case 0
	    # Command = 00xx xxxx:
	    switch (command >> 3) & 7
	      case 0
		# Command = 0000 0xxx:
		switch command & 7
		  case 0
		    # Read Bearing (Command = 0000 0000):
		    call byte_put(bearing)
		  case 1
		    # Read Interrupt Mask (Command = 0000 0001):
		    call byte_put(interrupts)
		  case 2
		    # Read Raw (Command = 0000 0010):
		    call byte_put(raw)
		  case 3
		    # Set Intterupt Mask (Command = 0000 0011):
		    interrupts := byte_get()
		  case 4, 5, 6, 7
		    do_nothing
	      case 1, 2, 3, 4, 5, 6, 7
		do_nothing
	  case 1, 2
	    # Command = 01xx xxxx or10xx xxxx:
	    do_nothing
	  case 3
	    # Command = 11xx xxxx:
	    switch (command >> 3) & 7
	      case 5
		# Command = 1110 1xxx:
		if (command & 7) = 7
		    # Return Interrupt Bits (Command = 1110 1111):
		    result := 0
		    if interrupt_enable
			result@1 := 1
		    if interrupt_pending
			result@0 := 1
		    call byte_put(result)
	      case 6
		# Shared Interrupt commands.
		switch (command >> 1) & 3
		  case 0, 1
		    # Set Interrupt Bits (Command = 1110 00ep):
		    interrupt_enable := command@1
		    interrupt_pending := command@0
		  case 2
		    # Set Interrupt Pending (Command = 1110 010p):
		    interrupt_pending := command@0
		  case 3
		    # Set Interrupt Enable (Command = 1110 011e):
		    interrupt_enable := command@0
	      case 7
		# Shared commands (Command = 1111 1ccc):
		switch command & 7
		  case 0
		    # Clock Decrement (Command = 1111 1000):
		    $osccal := $osccal - $osccal_lsb
		  case 1
		    # Clock Increment (Command = 1111 1001):
		    $osccal := $osccal + $osccal_lsb
		  case 2
		    # Clock Read (Command = 1111 1010):
		    call byte_put($osccal)
		  case 3
		    # Clock Pulse (Command = 1111 1011):
		    call byte_put(0)
		  case 4
		    # ID Next (Command = 1111 1100):
		    temp := 0
		    if id_index < id.size
			temp := id[id_index]
			id_index := id_index + 1
		    call byte_put(temp)
		  case 5
		    # ID Reset (Command = 1111 1101):
		    id_index := 0
		  case 6
		    # Glitch Read (Command = 1111 1110):
		    call byte_put(glitch)
		    glitch := 0
		  case 7
		    # Glitch (Command = 1111 1111):
		    if glitch != 0xff
			glitch := glitch + 1


procedure delay
    arguments_none
    returns_nothing
    exact_delay delay_instructions

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

    local temp byte

    # Kick the dog:
    watch_dog_reset

    raw := ($porta & port_mask) ^ port_mask
    if raw & north_pin_mask != 0
	if raw & east_pin_mask != 0
	    bearing := north_east_bearing
	    mask := north_east_mask
	else_if raw & west_pin_mask != 0
	    bearing := north_west_bearing
	    mask := north_west_mask
	else
	    bearing := north_bearing
	    mask := north_mask
    else_if raw & south_pin_mask != 0
	if raw & east_pin_mask != 0
	    bearing := south_east_bearing
	    mask := south_east_mask
	else_if raw & west_pin_mask != 0
	    bearing := south_west_bearing
	    mask := south_west_mask
	else
	    bearing := south_bearing
	    mask := south_mask
    else_if raw & east_pin_mask != 0
	bearing := east_bearing
	mask := east_mask
    else_if raw & west_pin_mask != 0
	bearing := west_bearing
	mask := west_mask
    else
	bearing := 0xff
	mask := 0xff

    # Deal with interrupts:
    if interrupts & mask != 0
	interrupt_pending := 1
    if interrupt_enable && interrupt_pending
	serial_out := 0
	interrupt_enable := 0


constant zero8 = "\0,0,0,0,0,0,0,0\"
constant module_name = "\9\Compass8D"
constant vendor_name = "\15\Gramlich&Benson"

string id = "\1,0,22,0,0,0,0,0\" ~ zero8 ~ zero8 ~ module_name ~ vendor_name