fsqrt:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Entry conditions: 32-bit argument in AM ;
;   register.                             ;
; Exit conditions: 16-bit square root in  ;
;   d register.                           ;
; Modified: D, E, X, Y                    ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

      ldy  #0000     ;start with 0 count
      tmxed          ;arg in x:e:d
      xgde           ;lsw in e, msw in d
      tsta           ;msb=0?
      beq  fazero    ;yes, normalize
      aiy  #$01      ;1 shift more
      lsrd           ;divide by 2
      rore           ;
      lsrd           ;next divide by 2
      bita #$ff      ;done?
      beq  fdzero    ;yes
      rore           ;finish divide
      aiy  #$01      ;1 shift more
      lsrd           ;divide by 2 again
      rore           ;
      lsrd           ;next divide by 2
      bita #$ff      ;done?
      beq  fdzero    ;yes
      rore           ;finish divide
      aiy  #$01      ;1 shift more
      lsrd           ;divide by 2
      rore           ;
      lsrd           ;next divide by 2
                     ;
fdzero: rore         ;normalized argument in d:e
      asld           ;;;mult by 2 for table address
      ldx  #roottabl+2 ;base address of root table
      adx            ;;;add offset
      ldd  0,x       ;get nearest root from table
      subd -2,x      ;minus the lower root
      lsre           ;make the remainder a signed fraction
      fmuls          ;b*(xa+1-xa)
      adce -2,x      ;b*(xa+1-xa)+xa
      xgdy           ;# of shifts, k, in d
      addd #-4       ;d-4 in d
      negd           ;4-d in d
      beq  fddone    ;this is 0
      lsre           ;denormalize the result
      addd #-1       ;next
      beq  fddone    ;
      lsre           ;shift back
      addd #-1       ;next
      beq  fddone    ;
      lsre           ;shift back
                     ;
fddone: xgde         ;result in d
      rts            ;out
                     ;
fazero: cmpb #$3f    ;done normalizing?
      bhi  fadz      ;yes, k=0
      aiy  #$01      ;one shift more
      asle           ;divide by 2
      rold           ;
      asle           ;divide by 2 again
      rold           ;done
      cmpb #$3f      ;done normalizing?
      bhi  fadz      ;yes, k=2
      aiy  #$01      ;one shift more
      asle           ;divide by 2
      rold           ;
      asle           ;and again
      rold           ;done
      cmpb #$3f      ;done?
      bhi  fadz      ;yes, k=4
      aiy  #$01      ;one shift more
      asle           ;divide by 2
      rold           ;
      asle           ;and again
      rold           ;done, k=6
                     ;
fadz:  asld          ;;;mult by 2 to be table address
      ldx  #roottabl+2 ;table base address
      adx            ;;;add offset
      ldd  0,x       ;get table word
      subd -2,x      ;(xa+1-xa)
      lsre           ;make remainder a signed fraction
      fmuls          ;b*(xa+1-xa)
      adce -2,x      ;b*(xa+1-xa)+xa
      lsre           ;divide by 16 right off, since arg<224
      lsre           ;
      lsre           ;
      lsre           ;OK
      xgdy           ;# of shifts, k, in d
      tstd           ;=0?
      beq  fazone    ;done
      lsre           ;denormalize the result, divide by 2
      addd #-1       ;next
      beq  fazone    ;done
      lsre           ;divide by 2
      addd #-1       ;next
      beq  fazone    ;done
      lsre           ;divide by 2
                     ;
fazone: xgde         ;result in d
      rts            ;out

 roottabl:
 dc.w $0
 dc.w $1000
 dc.w $16A1
 dc.w $1BB6
 dc.w $2000
 dc.w $23C7
 dc.w $2731
 dc.w $2A55
 dc.w $2D41
 dc.w $3000
 dc.w $3299
 dc.w $3511
 dc.w $376D
 dc.w $39B0
 dc.w $3BDE
 dc.w $3DF8
 dc.w $4000
 dc.w $41F8
 dc.w $43E2
 dc.w $45BE
 dc.w $478E
 dc.w $4952
 dc.w $4B0C
 dc.w $4CBC
 dc.w $4E62
 dc.w $5000
 dc.w $5196
 dc.w $5323
 dc.w $54AA
 dc.w $562A
 dc.w $57A3
 dc.w $5916
 dc.w $5A82
 dc.w $5BEA
 dc.w $5D4C
 dc.w $5EA8
 dc.w $6000
 dc.w $6153
 dc.w $62A1
 dc.w $63EC
 dc.w $6531
 dc.w $6673
 dc.w $67B1
 dc.w $68EB
 dc.w $6A22
 dc.w $6B55
 dc.w $6C84
 dc.w $6DB1
 dc.w $6EDA
 dc.w $7000
 dc.w $7123
 dc.w $7243
 dc.w $7361
 dc.w $747B
 dc.w $7593
 dc.w $76A9
 dc.w $77BC
 dc.w $78CC
 dc.w $79DA
 dc.w $7AE6
 dc.w $7BEF
 dc.w $7CF7
 dc.w $7DFC
 dc.w $7EFF
 dc.w $8000
 dc.w $80FF
 dc.w $81FC
 dc.w $82F7
 dc.w $83F0
 dc.w $84E8
 dc.w $85DE
 dc.w $86D2
 dc.w $87C4
 dc.w $88B4
 dc.w $89A3
 dc.w $8A90
 dc.w $8B7C
 dc.w $8C66
 dc.w $8D4F
 dc.w $8E36
 dc.w $8F1C
 dc.w $9000
 dc.w $90E3
 dc.w $91C4
 dc.w $92A4
 dc.w $9383
 dc.w $9461
 dc.w $953D
 dc.w $9618
 dc.w $96F2
 dc.w $97CA
 dc.w $98A1
 dc.w $9977
 dc.w $9A4C
 dc.w $9B20
 dc.w $9BF3
 dc.w $9CC4
 dc.w $9D95
 dc.w $9E64
 dc.w $9F33
 dc.w $A000
 dc.w $A0CC
 dc.w $A198
 dc.w $A262
 dc.w $A32B
 dc.w $A3F4
 dc.w $A4BB
 dc.w $A581
 dc.w $A647
 dc.w $A70B
 dc.w $A7CF
 dc.w $A892
 dc.w $A954
 dc.w $AA15
 dc.w $AAD5
 dc.w $AB95
 dc.w $AC53
 dc.w $AD11
 dc.w $ADCE
 dc.w $AE8A
 dc.w $AF45
 dc.w $B000
 dc.w $B0BA
 dc.w $B173
 dc.w $B22B
 dc.w $B2E3
 dc.w $B399
 dc.w $B450
 dc.w $B505
 dc.w $B5BA
 dc.w $B66E
 dc.w $B721
 dc.w $B7D3
 dc.w $B885
 dc.w $B937
 dc.w $B9E7
 dc.w $BA97
 dc.w $BB46
 dc.w $BBF5
 dc.w $BCA3
 dc.w $BD51
 dc.w $BDFD
 dc.w $BEA9
 dc.w $BF55
 dc.w $C000
 dc.w $C0AA
 dc.w $C154
 dc.w $C1FD
 dc.w $C2A6
 dc.w $C34E
 dc.w $C3F6
 dc.w $C49C
 dc.w $C543
 dc.w $C5E9
 dc.w $C68E
 dc.w $C733
 dc.w $C7D7
 dc.w $C87B
 dc.w $C91E
 dc.w $C9C1
 dc.w $CA63
 dc.w $CB04
 dc.w $CBA6
 dc.w $CC46
 dc.w $CCE6
 dc.w $CD86
 dc.w $CE25
 dc.w $CEC4
 dc.w $CF62
 dc.w $D000
 dc.w $D09D
 dc.w $D13A
 dc.w $D1D7
 dc.w $D272
 dc.w $D30E
 dc.w $D3A9
 dc.w $D444
 dc.w $D4DE
 dc.w $D577
 dc.w $D611
 dc.w $D6AA
 dc.w $D742
 dc.w $D7DA
 dc.w $D872
 dc.w $D909
 dc.w $D9A0
 dc.w $DA36
 dc.w $DACC
 dc.w $DB62
 dc.w $DBF7
 dc.w $DC8B
 dc.w $DD20
 dc.w $DDB4
 dc.w $DE47
 dc.w $DEDB
 dc.w $DF6E
 dc.w $E000
 dc.w $E092
 dc.w $E124
 dc.w $E1B5
 dc.w $E246
 dc.w $E2D7
 dc.w $E367
 dc.w $E3F7
 dc.w $E487
 dc.w $E516
 dc.w $E5A5
 dc.w $E633
 dc.w $E6C1
 dc.w $E74F
 dc.w $E7DD
 dc.w $E86A
 dc.w $E8F7
 dc.w $E983
 dc.w $EA0F
 dc.w $EA9B
 dc.w $EB27
 dc.w $EBB2
 dc.w $EC3D