english
version "1.0"
identify "xyz"

#: Copyright (c) 2007 by Wayne C. Gramlich.
#, All rights reserved.

module manual

#: This procedure implements code for explicity stepping a machine tool.

import
    character
    float
    format
    in_stream
    integer
    logical
    memory
    out_stream
    string
    system
    unsigned
    vector
    unix_system
    unix_termios


define controller
    record
	file_descriptor unsigned	#: Controller file descriptor
	buffer memory			#: Buffered commands
	buffer_amount unsigned		#: Amount of data buffered
	buffer_checksum unsigned	#: Buffer checksum
	memory memory			#: Memory buffer
	unix_system unix_system		#: unix system
    generate allocate, erase, identical, print


procedure static_ram_get@controller
    takes
	controller controller
	address unsigned
    returns unsigned

    #: This procedure will send {address} to {controller}:

    low :@= control_put_get@(controller, address & 0xff, 0xe0)
    middle :@= control_put_get@(controller, (address >> 8) & 0xff, 0xe1)
    high :@= control_put_get@(controller, (address >> 16) & 0xff, 0xe2)
    return command_put_get@(controller, 0xe3)


procedure buffer_append@controller
    takes
	controller controller
	command unsigned
    returns_nothing

    #: This procedure will append {command} to the buffer in {command}.

    buffer_amount :@= controller.buffer_amount
    controller.buffer_checksum :+= command
    controller.buffer[buffer_amount] := command
    controller.buffer_amount := buffer_amount + 1


procedure buffer_send@controller
    takes
	controller controller
    returns_nothing

    #: This procedure will send buffer in {controller} to the controller.

    buffer_append@(controller, 0xf8)

    start_address :@= controller.memory_in

    unix_system :@= controller.unix_system
    file_descriptor :@= controller.file_descriptor
    buffer :@= controller.buffer
    buffer_amount :@= controller.buffer_amount
    bytes_written :@=
      write@(unix_system, file_descriptor, buffer, 0, buffer_amount)
    assert bytes_written = buffer_amount

    end_address :@= controller.memory_in

    system :@= standard@system()
    debug_stream :@= system.error_out_stream
    if buffer_amount != end_address - start_address
	format@format2[unsigned, unsigned](debug_stream,
	  "%d% != %d%\n\", bytes_written, end_address - start_address)
    format@format1[unsigned](debug_stream,
      "[0x%x%]:", start_address)

    index :@= 0
    loop
	while index < buffer_amount
	#remote_byte :@= static_ram_get@(controller, start_address + index)
	#if remote_byte = buffer[index]
	#    format@format1[unsigned](debug_stream, " %x%", buffer[index])
	#else
	#    format@format3[unsigned, unsigned, unsigned](debug_stream,
	#      " [0x%x%]:%x% !=%x%",
	#      start_address + index, buffer[index], remote_byte)
	index :+= 1
    put@("\n\", debug_stream)

    controller.buffer_amount := 0


procedure control_put_get@controller
    takes
	controller controller
	control unsigned
	command unsigned
    returns unsigned

    #: This procedure will load the control register of {controller} with
    #, {control} and then execute {command}.

    command_put@(controller, 0xc0 | (control & 0xf))
    command_put@(controller, 0xd0 | (control >> 4))
    return command_put_get@(controller, command)


procedure create@controller
    takes_nothing
    returns controller

    # Open up connection to box:
    file_descriptor :@= terminal_open@termios("/dev/ttyUSB0", 115200, false)
    if file_descriptor >= 10000
	system :@= standard@system()
	debug_stream :@= system.error_out_stream
	format@format1[unsigned](debug_stream,
	  "fd=0x%x%\n\", file_descriptor)
	return ??

    # Allocate a command buffer:
    buffer :@= create@memory(10000)
    index :@= 0
    loop
	while index < buffer.size
	buffer[index] := index & 0x7f
	index :+= 1

    # Allocate small memory buffer
    memory :@= create@memory(16)
    index := 0
    loop
	while index < memory.size
	memory[index] := index & 0x7f
	index :+= 1

    unix_system :@= one_and_only@unix_system()

    # Allocate and return new {controller} object:
    initialize controller:: controller := allocate@controller()
	controller.buffer := buffer
	controller.buffer_amount := 0
	controller.buffer_checksum := 0
	controller.file_descriptor := file_descriptor
        controller.memory := memory
	controller.unix_system := unix_system
    return controller


procedure checksum_get@controller
    takes
	controller controller
    returns unsigned

    #: The procedure will query {controller} and return the
    #, the memory in pointer value:

    low_byte :@= command_put_get@(controller, 0xeb)
    high_byte :@= command_put_get@(controller, 0xec)

    return (high_byte << 8) | low_byte


procedure chunk_current_get@controller
    takes
	controller controller
    returns unsigned

    #: The procedure will query {controller} and return the
    #, the memory in pointer value:

    return command_put_get@(controller, 0xed)


procedure chunk_enable_get@controller
    takes
	controller controller
    returns unsigned

    #: The procedure will query {controller} and return the
    #, the memory in pointer value:

    return command_put_get@(controller, 0xee)


procedure direction_append@controller
    takes
	controller controller
	direction_mask unsigned
    returns_nothing

    #: This procedure will append a direction mask command to the buffer in
    #, {controller} using {direction_mask}.

    buffer_append@(controller, 0xb0 | (direction_mask & 0xf))


procedure drain@controller
    takes
	controller controller
    returns_nothing

    #: This procedure will drain {controller}.

    drain@termios(controller.file_descriptor)


procedure step@controller
    takes
	controller controller
	mask unsigned
	increment logical
	delay unsigned
	line string
    returns_nothing

    #: This procedure will do it all:

    system :@= standard@system()
    debug_stream :@= system.error_out_stream

    before :@= line.size
    count :@= unsigned_lop@(line)
    after :@= line.size
    if before = after
	count := 1

    loop
	while count != 0
	count :-= 1

	if increment
	    direction_append@(controller, 0)
	else
	    direction_append@(controller, mask)
	step_append@(controller, mask, delay)

    buffer_send@(controller)
    checksum :@= controller.checksum
    if (controller.buffer_checksum & 0xffff) = checksum
	result1 :@= command_put_get@(controller, 0xfc)
	chunk :@= controller.chunk_current
	controller.buffer_checksum := 0
	result2 :@= command_put_get@(controller, 0xf0 | (chunk & 7))
	format@format2[unsigned, unsigned](debug_stream,
	  "result1=0x%x% result2=0x%x%\n\", result1, result2)
    else
	format@format2[unsigned, unsigned](debug_stream,
	  "Checksum mismatch 0x%x% != 0x%x%\n\",
	  checksum, controller.buffer_checksum)

procedure step_append@controller
    takes
	controller controller
	mask unsigned
	delay unsigned
    returns_nothing

    #: This procedure will append a stepcommand to the buffer in
    #, {controller} using {direction_mask}.

    buffer_append@(controller, 0x80 | ((delay >> 10) & 0xf))
    buffer_append@(controller, 0x90 | ((delay >> 6) & 0xf))
    buffer_append@(controller, 0xa0 | ((delay >> 2) & 0xf))
    buffer_append@(controller, ((delay & 3)<<5) | (mask & 0xf))


procedure memory_in_get@controller
    takes
	controller controller
    returns unsigned

    #: The procedure will query {controller} and return the
    #, the memory in pointer value:

    low_byte :@= command_put_get@(controller, 0xe5)
    middle_byte :@= command_put_get@(controller, 0xe6)
    high_byte :@= command_put_get@(controller, 0xe7)

    return (high_byte << 16) | (middle_byte << 8) | low_byte


procedure memory_out_get@controller
    takes
	controller controller
    returns unsigned

    #: The procedure will query {controller} and return the
    #, the memory out pointer value:

    low_byte :@= command_put_get@(controller, 0xe8)
    middle_byte :@= command_put_get@(controller, 0xe9)
    high_byte :@= command_put_get@(controller, 0xea)

    return (high_byte << 16) | (middle_byte << 8) | low_byte


procedure command_put_get@controller
    takes
	controller controller
	command unsigned
    returns unsigned

    #: This procedure will send {command} to {controller}, get a response,
    #, and return it.

    file_descriptor :@= controller.file_descriptor
    memory :@= controller.memory
    unix_system :@= controller.unix_system

    command_put@(controller, command)
    bytes_read :@= read@(unix_system, file_descriptor, memory, 0, 1)
    assert bytes_read = 1

    #system :@= standard@system()
    #debug_stream :@= system.error_out_stream
    #format@format1[unsigned](debug_stream,
    #  " (%x%)", memory[0])
    #flush@(debug_stream)

    return memory[0]


procedure command_put@controller
    takes
	controller controller
	command unsigned
    returns_nothing

    #: This procedure will send {command} to {controller}, get a response,
    #, and return it.

    file_descriptor :@= controller.file_descriptor
    memory :@= controller.memory
    unix_system :@= controller.unix_system

    memory[0] := command
    bytes_written :@= write@(unix_system, file_descriptor, memory, 0, 1)
    assert bytes_written = 1

    #system :@= standard@system()
    #debug_stream :@= system.error_out_stream
    #format@format1[unsigned](debug_stream,
    #  " %x%", command)



procedure main
    takes
	system system
    returns unsigned

    #: This procedure will test the communication protocol with
    #, the buffer box.

    in_stream :@= system.standard_in_stream
    out_stream :@= system.standard_out_stream
    debug_stream :@= system.error_out_stream

    a_mask :@= 8
    x_mask :@= 4
    y_mask :@= 2
    z_mask :@= 1

    controller :@= create@controller()
    assert controller !== ??

    # Command loop:
    delay :@= 1000
    line :@= allocate@string()
    loop
	memory_in :@= controller.memory_in
	memory_out :@= controller.memory_out
	checksum :@= controller.checksum
	chunk_current :@= controller.chunk_current
	chunk_enable :@= controller.chunk_enable
	format@format6[unsigned, unsigned, unsigned, unsigned, unsigned,
	   unsigned](out_stream,
	  "mi=0x%x% mo=0x%x% bcs=0x%x% cs=0x%x% cc=%d% ce=%d%>",
	   memory_in, memory_out, controller.buffer_checksum, checksum,
	   chunk_current, chunk_enable)
	flush@(out_stream)
	drain@(controller)
	line_read@(in_stream, line, false)
	command :@= symbol_lop@(line, ??)
	if command != ""
	    #format@format1[string](debug_stream,
	    #  "%ds%\n\", command)
	    if prefix_match@("quit", command)
		return 0
	    if prefix_match@("x", command)
		step@(controller, x_mask, true, delay, line)
	    if prefix_match@("X", command)
		step@(controller, x_mask, false, delay, line)
	    if prefix_match@("y", command)
		step@(controller, y_mask, true, delay, line)
	    if prefix_match@("Y", command)
		step@(controller, y_mask, false, delay, line)
	    if prefix_match@("z", command)
		step@(controller, z_mask, true, delay, line)
	    if prefix_match@("Z", command)
		step@(controller, z_mask, false, delay, line)
	    if prefix_match@("a", command)
		step@(controller, a_mask, true, delay, line)
	    if prefix_match@("A", command)
		step@(controller, a_mask, false, delay, line)

	    if prefix_match@("dump", command)
		before :@= line.size
		address :@= unsigned_lop@(line)
		after :@= line.size
		if before = after
		    address := 0
		offset :@= 0
		loop
		    while offset < 8
		    format@format1[unsigned](debug_stream,
		      " %x%", static_ram_get@(controller, address + offset))
		    offset :+= 1
		put@("\n\", debug_stream)
	    if prefix_match@("send", command)
		buffer_send@(controller)
	    if prefix_match@("go", command)
		before :@= line.size
		chunk :@= unsigned_lop@(line)
		after :@= line.size
		if before != after
		    result :@= command_put_get@(controller, 0xf0 | (chunk & 7))
		    format@format1[unsigned](debug_stream,
		      "result = 0x%x%\n\", result)
	    if prefix_match@("commit", command)
		result :@= command_put_get@(controller, 0xfc)
		controller.buffer_checksum := 0
		format@format1[unsigned](debug_stream,
		  "result=0x%x%\n\", result)
	    if prefix_match@("rollback", command)
		result :@= command_put_get@(controller, 0xfd)
		controller.buffer_checksum := 0
		format@format1[unsigned](debug_stream,
		  "result=0x%x%\n\", result)
	    if prefix_match@("delay", command)
		before :@= line.size
		new_delay :@= unsigned_lop@(line)
		after :@= line.size
		if before != after
		    delay := delay

    return 0