ucl 1.0

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

library $pic16f630
library clock4mhz
library bit_bang

package pdip
    pin 1 = power_supply
    pin 2 = ra5_in, name=io0, mask=io0_mask, bit=io0_bit
    pin 3 = ra4_in, name=io1, mask=io1_mask, bit=io1_bit
    pin 4 = ra3_in, name=serial_in, mask=serial_in_mask, bit=serial_in_bit
    pin 5 = rc5_unused
    pin 6 = rc4_out, name=debug_out, mask=debug_out_mask, bit=debug_out_bit
    pin 7 = rc3_in, name=io7, mask=io7_mask, bit=io7_bit
    pin 8 = rc2_in, name=io6, mask=io6_mask, bit=io6_bit
    pin 9 = rc1_in, name=io5, mask=io5_mask, bit=io5_bit
    pin 10 = rc0_in, name=io4, mask=io4_mask, bit=io4_bit
    pin 11 = ra2_in, name=io3, mask=io3_mask, bit=io3_bit
    pin 12 = ra1_in, name=io2, mask=io2_mask, bit=io2_bit
    pin 13 = ra0_out, name=serial_out, mask=serial_out_mask, bit=serial_out_bit
    pin 14 = ground

configure wdte=off, fosc=int_no_clk

# Pin bindings:

# TRIS masks:
constant trisa_mask =
  io2_mask | io3_mask | serial_in_mask | io1_mask | io0_mask | 0xc0
constant trisc_mask = io4_mask | io5_mask | io6_mask | io7_mask | 0xc0

# Some globals: byte
constant state_size = 12
constant state_size2 = state_size << 1
global state[state_size] array[byte]
bind command_previous = state[0]
bind command_last = state[1]
bind sent_last = state[2]
bind sent_previous = state[3]
bind raw = state[4]
bind outputs = state[5]
bind complement_mask = state[6]
bind flags = state[7]
bind low_mask = state[8]
bind high_mask = state[9]
bind rising_mask = state[10]
bind falling_mask = state[11]

bind interrupt_enable = flags@0
bind interrupt_pending = flags@1

global direction byte
global glitch byte
global index byte

global debug_character byte
global debug_counter byte
global debug_index byte

origin 0x3ff

procedure osccal
    arguments_none
    returns byte

    return 0xa0

origin 0

procedure main
    arguments_none
    returns_nothing

    local command byte
    local temp byte
    local do_send bit

    # Initalize all of the globals:
    call reset()

    # Process commands:
    loop_forever
	# Wait for command:
	command := byte_get()

	# Dispatch on command 
	switch command >> 6
	  # 00xx xxxx:
	  case 0
	    # 0000 xxxx:
	    switch command >> 4
	      case 0
		do_send := 1
		switch command
		  case_maximum 15
		  case 0
		    # 0000 0000 (Read Inputs):
		    temp := raw ^ complement_mask
		  case 1
		    # 0000 0001 (Read Outputs):
	    	    temp := outputs ^ complement_mask
	      	  case 2
		    # 0000 0010 (Read Direction):
		    temp := complement_mask
		  case 3
		    # 0000 0011 (Read Raw):
		    temp := direction
	      	  case 4
		    # 0000 0100 (Read Read Low Mask):
		    temp := low_mask
	      	  case 5
		    # 0000 0101 (Read High Mask):
		    temp := high_mask
	      	  case 6
		    # 0000 0110 (Read Rising Mask):
		    temp := rising_mask
	      	  case 7
		    # 0000 0111 (Read Falling Mask):
		    temp := falling_mask
	      	  case 8
		    # 0000 1000 (Read Inputs Raw):
		    temp := raw
	      	  case 9
		    # 0000 1001 (Read Outputs Raw):
		    temp := outputs
		  default
		    # 0000 101x or 0000 11xx (Do nothing):
		    do_send := 0
		if do_send
		    call byte_put(temp)
	      case 1
		# 0001 xxxx:
		switch command & 15
		  case_maximum 15
	      	  case 0
		    # 0001 0000 (Reset Outputs):
		    outputs := complement_mask
	      	  case 1
		    # 0001 0001 (Set Outputs):
		    outputs := byte_get() ^ complement_mask
	      	  case 2
		    # 0001 0010 (Set Complement Mask):
		    complement_mask := byte_get()
	      	  case 3
		    # 0001 0011 (Set Direction Mask):
		    direction := byte_get()
		    call direction_set()
	      	  case 4
		    # 0001 0100 (Set Low Mask):
		    low_mask := byte_get()
	      	  case 5
		    # 0001 0101 (Set High Mask):
		    high_mask := byte_get()
	      	  case 6
		    # 0001 0110 (Set Rising Mask):
		    rising_mask := byte_get()
	      	  case 7
		    # 0001 0111 (Set Falling Mask):
		    falling_mask := byte_get()
	      	  case 8
		    # 0001 1000 (Set Outputs Raw):
		    outputs := byte_get()
		  case 9
		    # 0001 1001 (Reset Everything):
		    call reset()
		  default
		    # 0001 101x or 0001 11xx (Do Nothing):
		    do_nothing
	      case 2
		# 0110 vbbb (Set Output Bit):
		temp := mask[command & 7]
		if command@3
		    outputs := outputs | temp
		else
		    outputs := outputs & (temp ^ 0xff)
	      case 3
		# 0011 xxxx (Do Nothing):
		do_nothing
	  case 1
	    # 01xx xxxx:
	    switch (command >> 4) & 3
	      case 0
		# 0100 llll (Set Outputs Low):
		outputs := outputs & 0xf0 | (command ^ complement_mask) & 0xf
	      case 1
		# 0101 hhhh (Set Outputs High):
		outputs :=
		  ((command << 4) ^ (complement_mask & 0xf0)) | outputs & 0xf
	      case 2
		# 0110 llll (Set Direction Low):
		direction := direction & 0xf0 | command & 0xf
		call direction_set()
	      case 3
		# 0111 hhhh (Set Direction High):
		direction := (command << 4) | direction & 0xf
		call direction_set()
	  case 2
	    # 10xx xxxx:
	    do_nothing
	  case 3
	    # 11xx xxxx:
	    switch (command >> 3) & 7
	      default
	      	# 110x xxxx or 1110 0xxx:
		do_nothing
	      case 5
		# 1110 1xxx:
		if command = 0xef
		    # 1110 1111 (Read Interrupt Bits):
		    temp := 0
		    if interrupt_pending
			temp@0 := 1
		    if interrupt_enable
			temp@1 := 1
		    call byte_put(temp)
	      case 6
		# 1111 0xxx:
		# Switching between register banks generates bulky code;
		# Keep code generation in bank 0 by assigning command to
		# temp:
		temp := command
		switch temp & 7
		  case 0, 1, 2, 3
		    # 1111 00ep (Set Interrupt Bits):
		    interrupt_enable := temp@1
		    interrupt_pending := temp@0
		  case 4, 5
		    # 1111 010p (Set Interrupt Pending):
		    interrupt_pending := temp@0
		  case 6, 7
		    # 1111 011e (Set Interrupt Enable):
		    interrupt_enable := temp@0
	      case 7
		switch command & 7
 		  case 0
		    # 1111 1000 (Clock Decrement):
		    $osccal := $osccal - $osccal_lsb
		  case 1
		    # 1111 1001 (Clock Increment):
		    $osccal := $osccal + $osccal_lsb
 		  case 2
		    # 1111 1010 (Clock Read):
		    call byte_put($osccal)
		  case 3
		    # 1111 1011 (Clock Pulse):
		    call byte_put(0)
 		  case 4
		    # 1111 1100 (ID Next):
		    temp := 0
		    if index < id.size
			temp := id[index]
		        index := index + 1
		    call byte_put(temp)
		  case 5
		    # 1111 1101 (ID Reset):
		    index := 0
 		  case 6
		    # 1111 1110 (Glitch Read):
		    call byte_put(glitch)
		    glitch := 0
		  case 7
		    # 1111 1111 (Glitch):
		    if glitch != 0xff
			glitch := glitch + 1


procedure direction_set
    arguments_none
    returns_nothing

    # This procedure will set the direction appropriately.

    local temp byte

    # Deal with port C:
    temp := 0
    if direction@4
	temp@io4_bit := 1
    if direction@5
	temp@io5_bit := 1
    if direction@6
	temp@io6_bit := 1
    if direction@7
	temp@io7_bit := 1
    $trisc := temp

    # Deal with port A:
    temp := 0
    temp@serial_in_bit := 1
    if direction@0
	temp@io0_bit := 1
    if direction@1
	temp@io1_bit := 1
    if direction@2
	temp@io2_bit:= 1
    if direction@3
	temp@io3_bit := 1
    $trisa := temp


procedure reset
    arguments_none
    returns_nothing

    # This procedure will initialize all global registers:

    $cmcon := 7

    # Initialize global registers:
    index := 0
    loop_exactly state_size
	state[index] := 0
	index := index + 1

    interrupt_enable := 0
    interrupt_pending := 0
    debug_counter := 0
    debug_index := 0
    debug_character := 0

    # This sets TRISA and TRISC:
    call direction_set()

    # Initialize remaining registers:
    glitch := 0
    index := 0


procedure delay
    arguments_none
    returns_nothing
    exact_delay delay_instructions

    # This procedure delays 1/3 of a bit.

    local temp byte
    local previous byte
    local current byte
    local not_current byte
    local changed byte

    # Kick the dog:
    watch_dog_reset

    # Read inputs:
    raw := 0
    if io7
	raw@7 := 1
    if io6
	raw@6 := 1
    if io5
	raw@5 := 1
    if io4
	raw@4 := 1
    if io3
	raw@3 := 1
    if io2
	raw@2 := 1
    if io1
	raw@1 := 1
    if io0
	raw@0 := 1

    # Write out port C:
    temp := 0
    if outputs@7
	temp@io7_bit := 1
    if outputs@6
	temp@io6_bit := 1
    if outputs@5
	temp@io5_bit := 1
    if outputs@4
	temp@io4_bit := 1
    if debug_out
	temp@debug_out_bit := 1
    $portc := temp

    # Write out port A:
    temp := 0
    if outputs@3
	temp@io3_bit := 1
    if outputs@2
	temp@io2_bit := 1
    if outputs@1
	temp@io1_bit := 1
    if outputs@0
	temp@io0_bit := 1
    if serial_out
	temp@serial_out_bit := 1
    $porta := temp

    # Setup for interrupts:
    previous := current
    # Read the I/O port once:
    current := raw ^ complement_mask
    not_current := current ^ 0xf
    changed := current ^ previous

    # See about triggering the interrupt_pending flag:
    if (low_mask & not_current) | (high_mask & current) |
      (changed & current & rising_mask) |
      (changed & not_current & falling_mask) != 0
	interrupt_pending := 1

    # Send an interrupt if interrupts are enabled:
    if interrupt_pending
	if interrupt_enable
	    # Shove serial out to low:
	    interrupt_enable := 0
	    serial_out := 0

    # Provide debug information:
    switch debug_counter
      case 0
	# Send out start bit:
	debug_out := 0
      case 3, 6, 9, 12, 15, 18, 21, 24, 27
	# Send out data bit or stop bit:
	if debug_character@0
	    debug_out := 1
	else
	    debug_out := 0
      case 4, 7, 10, 13, 16, 19, 22, 25
	# Select next bit of debug_character:
	debug_character := debug_character >> 1
	debug_character@7 := 1
      case 28
	debug_character := debug_index >> 1
      case 30
	debug_character := state[debug_character]
      case 31
	if !(debug_index@0)
	    debug_character := debug_character >> 4
      case 32
 	debug_character := (debug_character & 0xf) + '0'
      case 33
	if debug_character > '9'
	    debug_character := debug_character + 'A' - '0' - 10
      case 34
	if debug_index >= state_size2
	    debug_character := '\r\'
      case 35
	if debug_index >= state_size2 + 1
	    # Turn off cursor and blink mode:
	    debug_character := 0x88
      case 36
	debug_index := debug_index + 1
      case 37
	if debug_index >= state_size2 + 2
	    debug_index := 0
      case 38
	debug_counter := 0xff
      default
	do_nothing
    debug_counter := debug_counter + 1


constant zeros8 = "\0,0,0,0,0,0,0,0\"
constant module_name = "\9\Digital8B"
constant vendor_name = "\13\Mondotronics"
string id = "\1,0,32,1,3,1,0,0\" ~ zeros8 ~ zeros8 ~ module_name ~ vendor_name

string mask = "\1,2,4,8,16,32,64,128\"