*
* PI_SPIGOT.S
* Compute digits of PI on Apple II to 4000 digits
* Algorithm: Rabinowitz-Wagon Decimal Spigot
* Assembler: LISA 2.5D / DOS 3.3
* Target: Apple II 128K (only ~22KB RAM needed)
*
* -----------------------------------------------
* MEMORY MAP
* -----------------------------------------------
*   $0000-$001B  Zero page variables
*   $0900        Program origin
*   $3FFE-$3FFF  Cell 0 (special leading cell)
*   $4000-$A82B  Working array, 13334 cells x 2 bytes
*
* -----------------------------------------------
* ALGORITHM SUMMARY
* -----------------------------------------------
* Array A[0..LEN] initialized to 2 in every cell.
* Each pass (right to left) produces one predigit:
*
*   carry = 0
*   for i = LEN downto 1:
*     x      = A[i] * 10 + carry
*     A[i]   = x MOD (2i+1)
*     carry  = (x DIV (2i+1)) * i
*   x        = A[0] * 10 + carry
*   A[0]     = x MOD 10
*   predigit = x DIV 2
*
* Predigits buffered to handle 9->10 carry.
*
* -----------------------------------------------
* CARRY BOUND - why 24-bit math is sufficient
* -----------------------------------------------
* Invariant: A[i] < 2i+1 always holds.
* Max x at cell i is approximately 30*i.
* At i=13334, x < 400000, fits in 19 bits.
* 24-bit intermediates provide ample headroom.
*
* -----------------------------------------------
* ZERO PAGE EQUATES
* -----------------------------------------------
ARLO     EQU $00
ARHI     EQU $01
DNLO     EQU $02
DNHI     EQU $03
IXLO     EQU $04
IXHI     EQU $05
XL       EQU $06
XM       EQU $07
XH       EQU $08
CL       EQU $09
CM       EQU $0A
CH       EQU $0B
QL       EQU $0C
QM       EQU $0D
QH       EQU $0E
PRDIG    EQU $0F
NINES    EQU $10
DCLO     EQU $11
DCHI     EQU $12
COL      EQU $13
TMP      EQU $14
DVLO     EQU $15
DVHI     EQU $16
RELO     EQU $17
REHI     EQU $18
SAVDIG   EQU $19
MLLO     EQU $1A
MLHI     EQU $1B
GOTSAV   EQU $1C
*
* -----------------------------------------------
* PRECOMPUTED SPLIT CONSTANTS
* LISA 2.5D has no < > byte extraction operators.
* All 16-bit values split manually here.
*
* ARRBASE = $4000
* ARRLEN  = 13334 = $3416
* MAXDIG  = 4000  = $0FA0
* Last cell ptr  = $A82A  ($4000+(13334-1)*2)
* Last denom     = 26669  = $682D  (2*13334+1)
* -----------------------------------------------
ARBASLO  EQU $00
ARBASHI  EQU $40
ARLENLO  EQU $16
ARLENHI  EQU $34
MXDIGLO  EQU $A0
MXDIGHI  EQU $0F
LSTPLO   EQU $2A
LSTPHI   EQU $A8
LSTDLO   EQU $2D
LSTDHI   EQU $68
*
* Apple II ROM entry points
COUT     EQU $FDED
HOME     EQU $FC58
*
* -----------------------------------------------
* PROGRAM ENTRY POINT
* -----------------------------------------------
         ORG $0900
*
START    JSR HOME
         JSR BANNER
         JSR INITARR
         JSR INITZP
*
* Main digit loop.
* Each pass produces one predigit.
* EMIT converts predigits to confirmed digits.
* Loop until DCHI:DCLO reaches MAXDIG.
*
DIGLOOP  JSR PASS
         JSR EMIT
         LDA DCLO
         CMP #MXDIGLO
         BNE DIGLOOP
         LDA DCHI
         CMP #MXDIGHI
         BNE DIGLOOP
*
         JSR FLUSH
         JSR NEWLIN
         JSR DONE
         RTS
*
* -----------------------------------------------
* INITARR
* Fill all cells with value 2.
* Cell 0 at $3FFE/$3FFF.
* Cells 1..ARRLEN at ARRBASE+(i-1)*2.
* Each cell: low byte first, high byte second.
*
* 16-bit counter IXHI:IXLO counts from ARRLEN
* down to zero. Borrow handled explicitly:
* if IXLO is zero before decrement, IXHI goes
* first. Loop exits when both bytes are zero.
* -----------------------------------------------
*
INITARR  LDA #2
         STA $3FFE
         LDA #0
         STA $3FFF
*
         LDA #ARBASLO
         STA ARLO
         LDA #ARBASHI
         STA ARHI
*
         LDA #ARLENLO
         STA IXLO
         LDA #ARLENHI
         STA IXHI
*
INILP    LDY #0
         LDA #2
         STA ($00),Y
         INY
         LDA #0
         STA ($00),Y
*
         CLC
         LDA ARLO
         ADC #2
         STA ARLO
         BCC INISKP
         INC ARHI
INISKP   NOP
*
         LDA IXLO
         BNE INIDEC
         DEC IXHI
INIDEC   DEC IXLO
*
         LDA IXLO
         ORA IXHI
         BNE INILP
         RTS
*
* -----------------------------------------------
* INITZP
* Zero all working zero page variables.
* -----------------------------------------------
*
INITZP   LDA #0
         STA CL
         STA CM
         STA CH
         STA PRDIG
         STA NINES
         STA SAVDIG
         STA DCLO
         STA DCHI
         STA COL
         STA GOTSAV
         RTS
*
* -----------------------------------------------
* PASS
* One full right-to-left spigot pass.
* On return PRDIG holds raw predigit (0-10).
* -----------------------------------------------
*
PASS     LDA #0
         STA CL
         STA CM
         STA CH
*
         LDA #ARLENLO
         STA IXLO
         LDA #ARLENHI
         STA IXHI
*
         LDA #LSTPLO
         STA ARLO
         LDA #LSTPHI
         STA ARHI
*
         LDA #LSTDLO
         STA DNLO
         LDA #LSTDHI
         STA DNHI
*
* -----------------------------------------------
* PASSLP - one cell per iteration
* -----------------------------------------------
*
PASSLP   LDY #0
         LDA ($00),Y
         STA XL
         INY
         LDA ($00),Y
         STA XM
         LDA #0
         STA XH
*
* XH:XM:XL = A[i] * 10
* x*10 = (x*2) + (x*8)
* Shift left once -> x*2, save in QH:QM:QL
* Shift left twice more -> x*8
* Add saved x*2 to get x*10
*
         ASL XL
         ROL XM
         ROL XH
         LDA XL
         STA QL
         LDA XM
         STA QM
         LDA XH
         STA QH
         ASL XL
         ROL XM
         ROL XH
         ASL XL
         ROL XM
         ROL XH
         CLC
         LDA XL
         ADC QL
         STA XL
         LDA XM
         ADC QM
         STA XM
         LDA XH
         ADC QH
         STA XH
*
* XH:XM:XL = A[i]*10 + carry
         CLC
         LDA XL
         ADC CL
         STA XL
         LDA XM
         ADC CM
         STA XM
         LDA XH
         ADC CH
         STA XH
*
* Divide by denominator (2i+1)
         LDA DNLO
         STA DVLO
         LDA DNHI
         STA DVHI
         JSR DIV24
*
* Store remainder back into A[i]
         LDY #0
         LDA RELO
         STA ($00),Y
         INY
         LDA REHI
         STA ($00),Y
*
* New carry = quotient * i
* QL holds quotient (always < 11, fits in 8 bits)
* Copy i to MLLO/MLHI to protect IXLO/IXHI
         LDA IXLO
         STA MLLO
         LDA IXHI
         STA MLHI
         LDA QL
         STA TMP
         JSR MUL16CRY
*
* Decrement i (16-bit, explicit borrow)
         LDA IXLO
         BNE IXDEC
         DEC IXHI
IXDEC    DEC IXLO
*
* Denominator for next cell = current - 2
         LDA DNLO
         SEC
         SBC #2
         STA DNLO
         BCS DNDONE
         DEC DNHI
DNDONE   NOP
*
* Array pointer back by 2 bytes
         LDA ARLO
         SEC
         SBC #2
         STA ARLO
         BCS ARDONE
         DEC ARHI
ARDONE   NOP
*
* Continue while i != 0
* BNE PASSLP would be out of range (loop is >128 bytes).
* Invert: branch over a JMP when zero (done),
* otherwise JMP back to top of loop.
         LDA IXLO
         ORA IXHI
         BEQ PASSDONE
         JMP PASSLP
PASSDONE NOP
*
* -----------------------------------------------
* Cell 0 at $3FFE/$3FFF, denominator = 10
* predigit = (A[0]*10 + carry) DIV 10
* A[0]     = (A[0]*10 + carry) MOD 10
* -----------------------------------------------
*
         LDA $3FFE
         STA XL
         LDA $3FFF
         STA XM
         LDA #0
         STA XH
*
         ASL XL
         ROL XM
         ROL XH
         LDA XL
         STA QL
         LDA XM
         STA QM
         LDA XH
         STA QH
         ASL XL
         ROL XM
         ROL XH
         ASL XL
         ROL XM
         ROL XH
         CLC
         LDA XL
         ADC QL
         STA XL
         LDA XM
         ADC QM
         STA XM
         LDA XH
         ADC QH
         STA XH
*
         CLC
         LDA XL
         ADC CL
         STA XL
         LDA XM
         ADC CM
         STA XM
         LDA XH
         ADC CH
         STA XH
*
         LDA #10
         STA DVLO
         LDA #0
         STA DVHI
         JSR DIV24
*
* Store remainder (mod 10) back to A[0]
         LDA RELO
         STA $3FFE
         LDA #0
         STA $3FFF
*
         LDA QL
         STA PRDIG
         RTS
*
* -----------------------------------------------
* DIV24
* 24-bit / 16-bit division.
*
* Input:  XH:XM:XL  = 24-bit dividend
*         DVHI:DVLO = 16-bit divisor
* Output: QH:QM:QL  = 24-bit quotient
*         REHI:RELO = 16-bit remainder
*
* Method: shift-and-subtract, 24 iterations.
* X register used as counter, destroyed on exit.
* -----------------------------------------------
*
DIV24    LDA #0
         STA QL
         STA QM
         STA QH
         STA RELO
         STA REHI
         LDX #24
*
D24LP    ASL XL
         ROL XM
         ROL XH
         ROL RELO
         ROL REHI
         LDA REHI
         CMP DVHI
         BCC D24NO
         BNE D24YES
         LDA RELO
         CMP DVLO
         BCC D24NO
*
D24YES   SEC
         LDA RELO
         SBC DVLO
         STA RELO
         LDA REHI
         SBC DVHI
         STA REHI
         SEC
         ROL QL
         ROL QM
         ROL QH
         DEX
         BNE D24LP
         RTS
*
D24NO    CLC
         ROL QL
         ROL QM
         ROL QH
         DEX
         BNE D24LP
         RTS
*
* -----------------------------------------------
* MUL16CRY
* 8-bit * 16-bit = 24-bit multiply.
*
* Input:  TMP       = 8-bit multiplier (max 10)
*         MLHI:MLLO = 16-bit multiplicand (copy of i)
* Output: CH:CM:CL  = 24-bit product (becomes carry)
*
* MLLO/MLHI are shifted in place and consumed.
* TMP is shifted right and consumed.
* IXLO/IXHI are never touched by this routine.
* Caller must copy IXLO/IXHI to MLLO/MLHI first.
*
* Method: shift-and-add, 8 iterations.
* -----------------------------------------------
*
MUL16CRY LDA #0
         STA CL
         STA CM
         STA CH
         LDX #8
*
MULLP    LSR TMP
         BCC MULSHFT
         CLC
         LDA CL
         ADC MLLO
         STA CL
         LDA CM
         ADC MLHI
         STA CM
         LDA CH
         ADC #0
         STA CH
*
MULSHFT  ASL MLLO
         ROL MLHI
         DEX
         BNE MULLP
         RTS
*
* -----------------------------------------------
* EMIT
* Manages predigit buffer, emits confirmed digits.
*
* PRDIG = 9:   INC NINES, return
* PRDIG = 10:  output SAVDIG+1, output NINES zeros,
*              reset NINES and SAVDIG
* PRDIG = 0-8: if GOTSAV=0 (no prior digit saved yet):
*                set GOTSAV=1, save PRDIG, return
*              else: output SAVDIG, output NINES nines,
*                save new PRDIG, reset NINES
* -----------------------------------------------
*
EMIT     LDA PRDIG
         CMP #9
         BEQ EMIT9
         CMP #10
         BEQ EMIT10
*
* Normal digit 0-8: check if we have a saved digit yet
         LDA GOTSAV
         BNE EMITNORM
*
* No saved digit yet -- this is the very first predigit
EMITFST  LDA #1
         STA GOTSAV
         LDA PRDIG
         STA SAVDIG
         RTS
*
* Normal path: flush saved digit and buffered 9s, save new
EMITNORM LDA SAVDIG
         JSR OUTDIG
*
         LDX NINES
         BEQ EMITSAVE
ENILOOP  LDA #9
         JSR OUTDIG
         DEX
         BNE ENILOOP
*
EMITSAVE LDA #0
         STA NINES
         LDA PRDIG
         STA SAVDIG
         RTS
*
EMIT9    INC NINES
         RTS
*
EMIT10   LDA GOTSAV
         BEQ EMIT10Z        ; no saved digit yet, skip output
         LDA SAVDIG
         CLC
         ADC #1
         JSR OUTDIG
         LDX NINES
         BEQ EMIT10Z
EMITZLP  LDA #0
         JSR OUTDIG
         DEX
         BNE EMITZLP
EMIT10Z  LDA #1
         STA GOTSAV
         LDA #0
         STA NINES
         STA SAVDIG
         RTS
*
* -----------------------------------------------
* FLUSH
* Emit remaining buffered state at end of run.
* -----------------------------------------------
*
FLUSH    LDA SAVDIG
         JSR OUTDIG
         LDX NINES
         BEQ FLDONE
FLOOP    LDA #9
         JSR OUTDIG
         DEX
         BNE FLOOP
FLDONE   RTS
*
* -----------------------------------------------
* OUTDIG
* Output one decimal digit (value 0-9) in A.
*
* First digit outputs digit then decimal point.
* Newline every 50 digit positions.
* Increments DCHI:DCLO each call.
*
* Apple II COUT requires high bit set:
*   digit n -> n + $B0
*   period  -> $AE
*   CR      -> $8D
* -----------------------------------------------
*
OUTDIG   PHA
         LDA DCLO
         ORA DCHI
         BNE OUTDIG2
*
         PLA
         PHA
         CLC
         ADC #$B0
         JSR COUT
         LDA #$AE
         JSR COUT
         LDA #2
         STA COL
         JMP OUTINC
*
OUTDIG2  PLA
         PHA
         CLC
         ADC #$B0
         JSR COUT
         INC COL
         LDA COL
         CMP #39
         BNE OUTINC
         JSR NEWLIN
*
OUTINC   PLA
         INC DCLO
         BNE OUTRET
         INC DCHI
OUTRET   RTS
*
* -----------------------------------------------
* NEWLIN
* Output carriage return, reset column counter.
* -----------------------------------------------
*
NEWLIN   LDA #$8D
         JSR COUT
         LDA #0
         STA COL
         RTS
*
* -----------------------------------------------
* BANNER
* Print startup header using indexed LDA from
* inline table. Zero terminated.
* All bytes pre-encoded with high bit set.
*
* Decodes as:
*   PI SPIGOT - APPLE II    (CR)
*   RABINOWITZ-WAGON 3000 DIGITS  (CR)(CR)
* -----------------------------------------------
*
BANNER   LDX #0
BANLP    LDA BANTXT,X
         BEQ BANDONE
         JSR COUT
         INX
         BNE BANLP
BANDONE  RTS
*
* "PI SPIGOT - APPLE II" + CR
* P=$D0 I=$C9 ' '=$A0 S=$D3 P=$D0 I=$C9 G=$C7
* O=$CF T=$D4 ' '=$A0 -=$AD ' '=$A0 A=$C1
* P=$D0 P=$D0 L=$CC E=$C5 ' '=$A0 I=$C9 I=$C9
* CR=$8D
BANTXT   HEX D0C9A0D3D0C9C7CF
         HEX D4A0ADA0C1D0D0CC
         HEX C5A0C9C9
         HEX 8D
* "RABINOWITZ-WAGON 4000 DIGITS" + CR + CR + $00
         HEX D2C1C2C9CECFD7C9
         HEX D4DAADD7C1C7CFCE
         HEX A0B4B0B0B0A0C4C9
         HEX C7C9D4D3
         HEX 8D8D
         BYT 0
*
* -----------------------------------------------
* DONE
* Print completion message.
* Decodes as: CR + "DONE." + CR
* D=$C4 O=$CF N=$CE E=$C5 .=$AE
* -----------------------------------------------
*
DONE     LDX #0
DONELP   LDA DONETXT,X
         BEQ DONEEND
         JSR COUT
         INX
         BNE DONELP
DONEEND  RTS
*
DONETXT  HEX 8D
         HEX C4CFCEC5AE
         HEX 8D
         BYT 0
*
         END