; state machine to DOT graph file format

; REFERENCES:
;       https://oeis.org/A060843
;       https://bbchallenge.org
;       https://turingmachine.io

match =PARAMS,PARAMS
        display 10,'expected usage examples:',10,\
                9,      'fasmg sm_dot.g -i "PARAMS equ 1RB0LD_1RC0RF_1LC1LA_0LE1RH_1LF0RB_0RC0RE"',10,\
                9,      'dot -Tpng sm_dot.dot -o "BB(6,2).png"',10
        err 'PARAMS missing'
else match Q=,S=,I,PARAMS
        file_gather <'states = ',`Q,' symbols = ',`S,' index = ',`I>,\
                <IndexForm Q,S,I>
else match any,PARAMS
        file_gather <`any>, <CompactLinearForm `any>
end match

macro file_gather note*, body*
        format binary as 'dot'
        db '###',10
        db '### generated file',10
        db '### ',note,10
        db '###',10
        db 'digraph statemachine {',10
        db '    rankdir=LR;',10
        db '    node [shape = circle fixedsize=true fillcolor=lightgray style=filled];',10
        body
        db '    Halt [shape = doublecircle];',10
        db '}',10
end macro

macro IndexForm states*,symbols*,index*
        local reduce,state,value,target,write,direction,attributes
        reduce = index

        struc StateName I*
                local result,chars,i
                i = I mod (states+1)
                if i = states
                        . = 'Halt'
                else
                        if I eqtype 0
                        else
                                I = I / states
                        end if
                        result = 0
                        chars = 0
                        while 1
                                result = (result shl 8)+'A'+(i mod 26)
                                chars = chars + 1
                                i = i/26
                                if i = 0
                                        break
                                end if
                        end while
                        . = string (result bswap chars)
                end if
        end struc

        struc SymbolName I*
                repeat 1, n:I mod symbols
                        . = `n
                end repeat
                if I eqtype 0
                else
                        I = I / symbols
                end if
        end struc

        repeat states
                state StateName %-1
                ; NOTE: this ordering creates a unique decode of index:
                repeat symbols
                        value SymbolName %-1

                        target StateName reduce
                        write SymbolName reduce
                        if reduce and 1
                                direction = 'L'
                                attributes reequ ''
                        else
                                direction = 'R'
                                attributes reequ ' color = "red"'
                        end if
                        reduce = reduce shr 1
                        if symbols = 2 ; decorate edges based on binary tape writing
                                if write = '0'
                                        attributes reequ attributes,' arrowhead = onormal'
                                end if
                        end if

                        db '    ',state,' -> ',target,\
                                ' [ label = "',value,'; ',write,', ',direction,'"',\
                                attributes,' ];',10
                end repeat ; symbols
        end repeat ; states
end macro

; WARNING: assume valid input: compact linearized transition matrix
; see: https://www.sligocki.com/2022/10/09/standard-tm-format.html

macro CompactLinearForm matrix*
        local reduce,symbols,symbol,states
        states = 1
        symbol = 0
        reduce = 0+matrix
        ; precompute so halt state is known
        while reduce > 0
                if reduce and 0xFF = '_'
                        reduce = reduce shr 8
                        ; next row of transition table
                        if ~ definite symbols
                                symbols := symbol
                        else if symbols <> symbol
                                err 'invalid compact linearized form'
                        end if
                        states = states + 1
                        symbol = 0
                else
                        transitions =: reduce and 0xFF_FF_FF
                        reduce = reduce shr 24
                        symbol = symbol + 1
                end if
        end while
        state = 'A'
        symbol = 0
        irpv transition, transitions
                if transition = '---' ; undefined transition
                else
                        target = transition shr 16
                        value = symbol + '0'
                        write = 0xFF and transition
                        direction = 0xFF and (transition shr 8)
                        if target > states + 'A' - 1
                                target = 'Halt'
                        end if
                        if direction = 'R'
                                attributes reequ ' color = "red"'
                        else
                                attributes reequ ''
                        end if
                        if write = '0'
                                attributes reequ attributes,' arrowhead = onormal'
                        end if
                        db '    ',state,' -> ',target,\
                                ' [ label = "',value,'; ',write,', ',direction,'"',\
                                attributes,' ];',10
                end if
                symbol = symbol + 1
                if symbol = symbols
                        state = state + 1
                        symbol = 0
                end if
        end irpv
end macro    

; Marxen–Buntrock 5-state busy beaver machine.
; It runs 47,176,870 steps and halts with 4,098 ones on the tape.
TheMachine:
; RCX: middle of zeroed tape buffer, guard pages at extents, and VEH.
; RDX: tape head position.
; RAX: step count.
        xor edx, edx
        xor eax, eax
        ; fall-through to first state ...

; The following values are indexed in response to the tape read value:
;       w0/m0/n0 are in response to zero read.
;       w1/m1/n1 are in response to one read.
;
;       write           move            next
iterate <w0,w1,         m0,m1,          n0,     n1>,\
        1,1,            inc,dec,        2,      3,\     ; A
        1,1,            inc,inc,        3,      2,\     ; B
        1,0,            inc,dec,        4,      5,\     ; C
        1,1,            dec,dec,        1,      4,\     ; D
        1,0,            inc,dec,        halt,   1       ; E

        .%:                             ; state label, 1-based.

        ; read tape into carry flag, write tape value:
        iterate lookup,\
                btr,\   ;00     always 0
                bt,\    ;01     keep
                btc,\   ;10     invert
                bts     ;11     always 1

                indx 2*w0+w1+1
                lookup [rcx], rdx
                break
        end iterate

        jc .%.1
        m0 rdx
        inc rax
        jmp .n0
.%.1:
        m1 rdx
        inc rax
        jmp .n1

end iterate

.halt:
        retn