;===============================================================================
; In the recent 'Grand Digital Computer Race' at The National Museum of Computers
; the two 6502 based machines, a BBC and Apple II only managed 70 and 38 values
; in 15 seconds -- I assume this is because it was coded in BASIC (Yuck!).
;
; We can do better. We must do better.
;
; This program works out values with up to 512 digits. On my laptop running in an
; emulator it generates 2542 results in in 0.382394 Secs with an overall CPU
; Frequency = 79.5137 Mhz. Scaled to the BBC's 2Mhz 6502 that would take 15.20
; Secs (approximately). A real BBC would be a bit slower as it has interrupts to
; handle and the I/O  would take longer but even so a more respectable ~2000
; values in 15 Secs should be possible. The Apple II will be around 50% of that
; as its clocked at 1MHz.
;
; All the real code is 6502 but I've used the WDM opcode in the emulator to
; produce output text (see UartTx) so I compile it as 65816 to enable it.
;
; Andrew Jacobs
; 2018-02-21
;-------------------------------------------------------------------------------

                .65816
               
;===============================================================================
; Macros
;-------------------------------------------------------------------------------

COMPUTE         .macro  NA,NB,NC,LA,LB,LC
                ldx     #0
                clc
                repeat
                 txa                    ; Reached end of shorter number?
                 eor    LA
                 if ne
                  lda   NA,x            ; No.
                 endif
                 adc    NB,x            ; Add digits (or zero + digit)
                 sta    NC,x
                 inx
                 txa                    ; Reached end of longer number?
                 eor    LB
                until eq
                if cs                   ; Has result extended the value?
                 lda    #1              ; Yes, add a 1 to the start
                 sta    NC,x
                 inx
                endif
                stx     LC              ; Save the new number length
                .endm
               
DISPLAY         .macro  NM,LN
                repeat
                 lda    NM-1,x          ; Fetch two digits
                 pha
                 lsr    a               ; Extract MS digits
                 lsr    a
                 lsr    a
                 lsr    a
                 if eq                  ; Leading zero?
                  cpx   LN
                  beq   Skip\?  ; Yes, suppress it
                 endif
                 ora    #'0'
                 jsr    UartTx
Skip\?:          pla                    ; Extract LS digit
                 and    #$0f
                 ora    #'0'
                 jsr    UartTx          ; And print
                 dex
                until eq
                lda     #10             ; Send CR/LF to output
                jsr     UartTx`
                .endm
               
;===============================================================================
; Workspace
;-------------------------------------------------------------------------------

                .page0
                .org    $10
               
LEN_A           .space  1
LEN_B           .space  1
LEN_C           .space  1

;===============================================================================
; Number workspaces (for 512 digits)
;-------------------------------------------------------------------------------

                .bss
                .org    $1000
               
NUM_A           .space  256
NUM_B           .space  256
NUM_C           .space  256

;===============================================================================
; The emulator expects the S28 to contain a ROM image so this is kicked off via
; the dummy reset vector.
;-------------------------------------------------------------------------------

                .code
                .org    $f000

Fibonacci:
                ldx     #1              ; Initialise number lengths
                stx     LEN_A
                stx     LEN_B
                stx     LEN_C
               
                lda     #0
                sta     NUM_A           ; Start with A = 0
                stx     NUM_B           ; .. and B = 1
               
                sed                     ; Work in decimal mode
               
ComputeLoop:           
                ; C = A + B
               
                COMPUTE NUM_A,NUM_B,NUM_C,LEN_A,LEN_B,LEN_C
                cpx     #0
                if eq
                 jmp    AllDone         ; Result is over 512 digits
                endif           
                DISPLAY NUM_C,LEN_C
               
                ; A = B + C

                COMPUTE NUM_B,NUM_C,NUM_A,LEN_B,LEN_C,LEN_A
                cpx     #0
                if eq
                 jmp    AllDone         ; Result is over 512 digits
                endif           
                DISPLAY NUM_A,LEN_A
               
                ; B = C + A

                COMPUTE NUM_C,NUM_A,NUM_B,LEN_C,LEN_A,LEN_B
                cpx     #0
                if eq
                 jmp    AllDone         ; Result is over 512 digits
                endif           
                DISPLAY NUM_B,LEN_B

                jmp     ComputeLoop
               
UartTx:
                wdm     #$01            ; Use emulator I/O
                rts
               
AllDone:
                wdm     #$ff            ; Stop the emulator
                jmp     AllDone
               
                .org    $fffc
                .word   Fibonacci       ; Dummy RESET vector
               
                .end

   .ORG $1000
   
   ; Macros
   
printbcd   .macro   ; Print a byte in A as a pair of BCD digits
   pha      ; Save the value for later
   lsr      ; Isolate the high nybble and print it first
   lsr
   lsr
   lsr
   ora #$30   ; Turn the isolated digit into its ASCII character
   printchar   ; Print the character
   pla      ; Retrieve the original value
   and #$0f   ; Isolate the low nybble
   ora #$30   ; Make it ASCII
   printchar   ; Print it
   .endm
   
printchar   .macro   ; Print the character in A as an ASCII value
   ; do whatever here
   sta $e001
   .ENDM
   
   ; Fibonacci algorithm - calculates numbers up to 510 digits in BCD form
   ; a = 1
   ; b = 1
   ; print a
   ; a = a + b
   ; print b
   ; b = b + a
   
init   ; Initialize buffers to 0000[...]1
   ldx #$01
   stx bufa
   stx bufb
   lda #$00
.l   sta bufa,x
   sta bufb,x
   inx
   bne .l
   
   ldy #$01   ; Initialize the maximum-length counter
   
loop   txa      ; Check - is X zero?
   beq pashort   ; If so, cut the print loop short
   
printa   ; Print buffer A as BCD values, one byte (2 digits) at a time
   lda bufa,x   ; X should be left pointing to the current MSB
   printbcd   ; Print it as a BCD pair
   dex      ; Drop down to the next most significant byte
   bne printa
pashort   lda bufa,x   ; Get and print the LSB since the loop ends early
   printbcd
   
   LDA #$20   ; Print a space
   printchar
   
   ; Note: SED and CLD could be moved out of the loop if decimal mode
   ; won't affect any other code (i.e. character printing,) but it's a
   ; negligible difference anyway.
   sed      ; Prep for BCD addition
   clc
   LDX #$ff   ; Set X to $FF
addb2a   ; Add buffer B to A as BCD values
   inx
   lda bufa,x   ; Get the current byte from A
   adc bufb,x   ; Add the current byte from B
   STA bufa,x   ; Store it back to A
   DEY      ; Decrement the maximum-length counter
   bne addb2a   ; If it's > 0, go to the next byte
   iny      ; If it's 0, reset it for the next iteration just in case
   BCS addb2a   ; If we carried out, go to the next byte
   cld      ; Leave decimal mode
   
   TXA      ; Update the maximum-length counter
   TAY
   INY
   
   cpx #$ff   ; Did we run to the end of the buffer?
   beq done   ; If so, we're done here
   
   TXA      ; Check - is X zero?
   beq pbshort   ; If so, cut the print loop short
   
printb   ; Print buffer B as BCD values, one byte (2 digits) at a time
   lda bufb,x   ; X should be left pointing to the current MSB
   printbcd   ; Print it as a BCD pair
   dex      ; Drop down to the next most significant byte
   bne printb
pbshort   lda bufb,x   ; Get and print the LSB since the loop ends early
   printbcd
   
   ; Note: SED and CLD could be moved out of the loop if decimal mode
   ; won't affect any other code (i.e. character printing,) but it's a
   ; negligible difference anyway.
   sed      ; Prep for BCD addition
   clc
   ldx #$ff   ; Set X to $FF
adda2b   ; Add buffer A to B as BCD values
   inx
   lda bufb,x   ; Get the current byte from A
   adc bufa,x   ; Add the current byte from B
   STA bufb,x   ; Store it back to A
   DEY      ; Decrement the maximum-length counter
   BNE adda2b   ; If it's > 0, go to the next byte
   iny      ; If it's 0, reset it for the next iteration just in case
   BCS adda2b   ; If we carried out, go to the next byte
   cld      ; Leave decimal mode
   
   TXA      ; Update the maximum-length counter
   TAY
   INY
   
   cpx #$ff   ; Did we run to the end of the buffer?
   beq done   ; If so, we're done here
   
   LDA #$20   ; Print a space
   printchar
   
   JMP loop   ; If we're not done, continue
   
done   ; If we are done, finish
   brk
   
   ; Buffers
bufa   .set $2000
bufb   .set $2100

0669260914144474
2383972451046333
4341778432843725
1805687861613243
9625858202478278
9140698057971348
5513550524628221
6604878690798813
8893035851040403
0806030527298628
6853890899496037
8909866230416986
5421475796599705
5876430614925437
1892863787317305
7897731694551328
7392301441138267
0293400725105488
1903535683969679
7453359616023179
7925656175919745
2805998203167417
9044885601740086
7886789122530726
0989620372623122
3715318210405157
8714172040612830
4969924233370562
76562264