fpmath-sf.S 16 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036
  1. ; SF format is:
  2. ;
  3. ; [sign] 1.[23bits] E[8bits(n-127)]
  4. ;
  5. ; SEEEEEEE Emmmmmmm mmmmmmmm mmmmmmmm
  6. ;
  7. ; [A+0] mmmmmmmm
  8. ; [A+1] mmmmmmmm
  9. ; [A+2] Emmmmmmm
  10. ; [A+3] SEEEEEEE
  11. ;
  12. ; Special values (xxx != 0):
  13. ;
  14. ; r11 r10 r9 r8
  15. ; [HL+3] [HL+2] [HL+1] [HL+0]
  16. ; s1111111 10000000 00000000 00000000 infinity
  17. ; s1111111 1xxxxxxx xxxxxxxx xxxxxxxx NaN
  18. ; s0000000 00000000 00000000 00000000 zero
  19. ; s0000000 0xxxxxxx xxxxxxxx xxxxxxxx denormals
  20. ;
  21. ; Note that CMPtype is "signed char" for rl78
  22. ;
  23. #include "vregs.h"
  24. #define Z PSW.6
  25. ; External Functions:
  26. ;
  27. ; __int_isnan [HL] -> Z if NaN
  28. ; __int_iszero [HL] -> Z if zero
  29. START_FUNC __int_isinf
  30. ;; [HL] points to value, returns Z if it's #Inf
  31. mov a, [hl+2]
  32. and a, #0x80
  33. mov x, a
  34. mov a, [hl+3]
  35. and a, #0x7f
  36. cmpw ax, #0x7f80
  37. skz
  38. ret ; return NZ if not NaN
  39. mov a, [hl+2]
  40. and a, #0x7f
  41. or a, [hl+1]
  42. or a, [hl]
  43. ret
  44. END_FUNC __int_isinf
  45. #define A_SIGN [hl+0] /* byte */
  46. #define A_EXP [hl+2] /* word */
  47. #define A_FRAC_L [hl+4] /* word */
  48. #define A_FRAC_LH [hl+5] /* byte */
  49. #define A_FRAC_H [hl+6] /* word or byte */
  50. #define A_FRAC_HH [hl+7] /* byte */
  51. #define B_SIGN [hl+8]
  52. #define B_EXP [hl+10]
  53. #define B_FRAC_L [hl+12]
  54. #define B_FRAC_LH [hl+13]
  55. #define B_FRAC_H [hl+14]
  56. #define B_FRAC_HH [hl+15]
  57. START_FUNC _int_unpack_sf
  58. ;; convert 32-bit SFmode [DE] to 6-byte struct [HL] ("A")
  59. mov a, [de+3]
  60. sar a, 7
  61. mov A_SIGN, a
  62. movw ax, [de+2]
  63. and a, #0x7f
  64. shrw ax, 7
  65. movw bc, ax ; remember if the exponent is all zeros
  66. subw ax, #127 ; exponent is now non-biased
  67. movw A_EXP, ax
  68. movw ax, [de]
  69. movw A_FRAC_L, ax
  70. mov a, [de+2]
  71. and a, #0x7f
  72. cmp0 c ; if the exp is all zeros, it's denormal
  73. skz
  74. or a, #0x80
  75. mov A_FRAC_H, a
  76. mov a, #0
  77. mov A_FRAC_HH, a
  78. ;; rounding-bit-shift
  79. movw ax, A_FRAC_L
  80. shlw ax, 1
  81. movw A_FRAC_L, ax
  82. mov a, A_FRAC_H
  83. rolc a, 1
  84. mov A_FRAC_H, a
  85. mov a, A_FRAC_HH
  86. rolc a, 1
  87. mov A_FRAC_HH, a
  88. ret
  89. END_FUNC _int_unpack_sf
  90. ; func(SF a,SF b)
  91. ; [SP+4..7] a
  92. ; [SP+8..11] b
  93. START_FUNC ___subsf3
  94. ;; a - b => a + (-b)
  95. ;; Note - we cannot just change the sign of B on the stack and
  96. ;; then fall through into __addsf3. The stack'ed value may be
  97. ;; used again (it was created by our caller after all). Instead
  98. ;; we have to allocate some stack space of our own, copy A and B,
  99. ;; change the sign of B, call __addsf3, release the allocated stack
  100. ;; and then return.
  101. subw sp, #8
  102. movw ax, [sp+4+8]
  103. movw [sp], ax
  104. movw ax, [sp+4+2+8]
  105. movw [sp+2], ax
  106. movw ax, [sp+4+4+8]
  107. movw [sp+4], ax
  108. mov a, [sp+4+6+8]
  109. mov [sp+6], a
  110. mov a, [sp+4+7+8]
  111. xor a, #0x80
  112. mov [sp+7], a
  113. call $!___addsf3
  114. addw sp, #8
  115. ret
  116. END_FUNC ___subsf3
  117. START_FUNC ___addsf3
  118. ;; if (isnan(a)) return a
  119. movw ax, sp
  120. addw ax, #4
  121. movw hl, ax
  122. call !!__int_isnan
  123. bnz $1f
  124. ret_a:
  125. movw ax, [sp+4]
  126. movw r8, ax
  127. movw ax, [sp+6]
  128. movw r10, ax
  129. ret
  130. 1: ;; if (isnan (b)) return b;
  131. movw ax, sp
  132. addw ax, #8
  133. movw hl, ax
  134. call !!__int_isnan
  135. bnz $2f
  136. ret_b:
  137. movw ax, [sp+8]
  138. movw r8, ax
  139. movw ax, [sp+10]
  140. movw r10, ax
  141. ret
  142. 2: ;; if (isinf (a))
  143. movw ax, sp
  144. addw ax, #4
  145. movw hl, ax
  146. call $!__int_isinf
  147. bnz $3f
  148. ;; if (isinf (b) && a->sign != b->sign) return NaN
  149. movw ax, sp
  150. addw ax, #8
  151. movw hl, ax
  152. call $!__int_isinf
  153. bnz $ret_a
  154. mov a, [sp+7]
  155. mov h, a
  156. mov a, [sp+11]
  157. xor a, h
  158. bf a.7, $ret_a
  159. movw r8, #0x0001
  160. movw r10, #0x7f80
  161. ret
  162. 3: ;; if (isinf (b)) return b;
  163. movw ax, sp
  164. addw ax, #8
  165. movw hl, ax
  166. call $!__int_isinf
  167. bz $ret_b
  168. ;; if (iszero (b))
  169. movw ax, sp
  170. addw ax, #8
  171. movw hl, ax
  172. call !!__int_iszero
  173. bnz $4f
  174. ;; if (iszero (a))
  175. movw ax, sp
  176. addw ax, #4
  177. movw hl, ax
  178. call !!__int_iszero
  179. bnz $ret_a
  180. movw ax, [sp+4]
  181. movw r8, ax
  182. mov a, [sp+7]
  183. mov h, a
  184. movw ax, [sp+10]
  185. and a, h
  186. movw r10, ax
  187. ret
  188. 4: ;; if (iszero (a)) return b;
  189. movw ax, sp
  190. addw ax, #4
  191. movw hl, ax
  192. call !!__int_iszero
  193. bz $ret_b
  194. ; Normalize the two numbers relative to each other. At this point,
  195. ; we need the numbers converted to their "unpacked" format.
  196. subw sp, #16 ; Save room for two unpacked values.
  197. movw ax, sp
  198. movw hl, ax
  199. addw ax, #16+4
  200. movw de, ax
  201. call $!_int_unpack_sf
  202. movw ax, sp
  203. addw ax, #8
  204. movw hl, ax
  205. addw ax, #16+8-8
  206. movw de, ax
  207. call $!_int_unpack_sf
  208. movw ax, sp
  209. movw hl, ax
  210. ;; diff = a.exponent - b.exponent
  211. movw ax, B_EXP ; sign/exponent word
  212. movw bc, ax
  213. movw ax, A_EXP ; sign/exponent word
  214. subw ax, bc ; a = a.exp - b.exp
  215. movw de, ax ; d = sdiff
  216. ;; if (diff < 0) diff = -diff
  217. bf a.7, $1f
  218. xor a, #0xff
  219. xor r_0, #0xff ; x
  220. incw ax ; a = diff
  221. 1:
  222. ;; if (diff >= 23) zero the smaller one
  223. cmpw ax, #24
  224. bc $.L661 ; if a < 23 goto 661
  225. ;; zero out the smaller one
  226. movw ax, de
  227. bt a.7, $1f ; if sdiff < 0 (a_exp < b_exp) goto 1f
  228. ;; "zero out" b
  229. movw ax, A_EXP
  230. movw B_EXP, ax
  231. movw ax, #0
  232. movw B_FRAC_L, ax
  233. movw B_FRAC_H, ax
  234. br $5f
  235. 1:
  236. ;; "zero out" a
  237. movw ax, B_EXP
  238. movw A_EXP, ax
  239. movw ax, #0
  240. movw A_FRAC_L, ax
  241. movw A_FRAC_H, ax
  242. br $5f
  243. .L661:
  244. ;; shift the smaller one so they have the same exponents
  245. 1:
  246. movw ax, de
  247. bt a.7, $1f
  248. cmpw ax, #0 ; sdiff > 0
  249. bnh $1f ; if (sdiff <= 0) goto 1f
  250. decw de
  251. incw B_EXP ; because it's [HL+byte]
  252. movw ax, B_FRAC_H
  253. shrw ax, 1
  254. movw B_FRAC_H, ax
  255. mov a, B_FRAC_LH
  256. rorc a, 1
  257. mov B_FRAC_LH, a
  258. mov a, B_FRAC_L
  259. rorc a, 1
  260. mov B_FRAC_L, a
  261. br $1b
  262. 1:
  263. movw ax, de
  264. bf a.7, $1f
  265. incw de
  266. incw A_EXP ; because it's [HL+byte]
  267. movw ax, A_FRAC_H
  268. shrw ax, 1
  269. movw A_FRAC_H, ax
  270. mov a, A_FRAC_LH
  271. rorc a, 1
  272. mov A_FRAC_LH, a
  273. mov a, A_FRAC_L
  274. rorc a, 1
  275. mov A_FRAC_L, a
  276. br $1b
  277. 1:
  278. 5: ;; At this point, A and B have the same exponent.
  279. mov a, A_SIGN
  280. cmp a, B_SIGN
  281. bnz $1f
  282. ;; Same sign, just add.
  283. movw ax, A_FRAC_L
  284. addw ax, B_FRAC_L
  285. movw A_FRAC_L, ax
  286. mov a, A_FRAC_H
  287. addc a, B_FRAC_H
  288. mov A_FRAC_H, a
  289. mov a, A_FRAC_HH
  290. addc a, B_FRAC_HH
  291. mov A_FRAC_HH, a
  292. br $.L728
  293. 1: ;; Signs differ - A has A_SIGN still.
  294. bf a.7, $.L696
  295. ;; A is negative, do B-A
  296. movw ax, B_FRAC_L
  297. subw ax, A_FRAC_L
  298. movw A_FRAC_L, ax
  299. mov a, B_FRAC_H
  300. subc a, A_FRAC_H
  301. mov A_FRAC_H, a
  302. mov a, B_FRAC_HH
  303. subc a, A_FRAC_HH
  304. mov A_FRAC_HH, a
  305. br $.L698
  306. .L696:
  307. ;; B is negative, do A-B
  308. movw ax, A_FRAC_L
  309. subw ax, B_FRAC_L
  310. movw A_FRAC_L, ax
  311. mov a, A_FRAC_H
  312. subc a, B_FRAC_H
  313. mov A_FRAC_H, a
  314. mov a, A_FRAC_HH
  315. subc a, B_FRAC_HH
  316. mov A_FRAC_HH, a
  317. .L698:
  318. ;; A is still A_FRAC_HH
  319. bt a.7, $.L706
  320. ;; subtraction was positive
  321. mov a, #0
  322. mov A_SIGN, a
  323. br $.L712
  324. .L706:
  325. ;; subtraction was negative
  326. mov a, #0xff
  327. mov A_SIGN, a
  328. ;; This negates A_FRAC
  329. mov a, A_FRAC_L
  330. xor a, #0xff ; XOR doesn't mess with carry
  331. add a, #1 ; INC doesn't set the carry
  332. mov A_FRAC_L, a
  333. mov a, A_FRAC_LH
  334. xor a, #0xff
  335. addc a, #0
  336. mov A_FRAC_LH, a
  337. mov a, A_FRAC_H
  338. xor a, #0xff
  339. addc a, #0
  340. mov A_FRAC_H, a
  341. mov a, A_FRAC_HH
  342. xor a, #0xff
  343. addc a, #0
  344. mov A_FRAC_HH, a
  345. .L712:
  346. ;; Renormalize the subtraction
  347. mov a, A_FRAC_L
  348. or a, A_FRAC_LH
  349. or a, A_FRAC_H
  350. or a, A_FRAC_HH
  351. bz $.L728
  352. ;; Mantissa is not zero, left shift until the MSB is in the
  353. ;; right place
  354. 1:
  355. movw ax, A_FRAC_H
  356. cmpw ax, #0x0200
  357. bnc $.L728
  358. decw A_EXP
  359. movw ax, A_FRAC_L
  360. shlw ax, 1
  361. movw A_FRAC_L, ax
  362. movw ax, A_FRAC_H
  363. rolwc ax, 1
  364. movw A_FRAC_H, ax
  365. br $1b
  366. .L728:
  367. ;; normalize A and pack it
  368. movw ax, A_FRAC_H
  369. cmpw ax, #0x01ff
  370. bnh $1f
  371. ;; overflow in the mantissa; adjust
  372. movw ax, A_FRAC_H
  373. shrw ax, 1
  374. movw A_FRAC_H, ax
  375. mov a, A_FRAC_LH
  376. rorc a, 1
  377. mov A_FRAC_LH, a
  378. mov a, A_FRAC_L
  379. rorc a, 1
  380. mov A_FRAC_L, a
  381. incw A_EXP
  382. 1:
  383. call $!__rl78_int_pack_a_r8
  384. addw sp, #16
  385. ret
  386. END_FUNC ___addsf3
  387. START_FUNC __rl78_int_pack_a_r8
  388. ;; pack A to R8
  389. movw ax, A_EXP
  390. addw ax, #126 ; not 127, we want the "bt/bf" test to check for denormals
  391. bf a.7, $1f
  392. ;; make a denormal
  393. 2:
  394. movw bc, ax
  395. movw ax, A_FRAC_H
  396. shrw ax, 1
  397. movw A_FRAC_H, ax
  398. mov a, A_FRAC_LH
  399. rorc a, 1
  400. mov A_FRAC_LH, a
  401. mov a, A_FRAC_L
  402. rorc a, 1
  403. mov A_FRAC_L, a
  404. movw ax, bc
  405. incw ax
  406. bt a.7, $2b
  407. decw ax
  408. 1:
  409. incw ax ; now it's as if we added 127
  410. movw A_EXP, ax
  411. cmpw ax, #0xfe
  412. bnh $1f
  413. ;; store #Inf instead
  414. mov a, A_SIGN
  415. or a, #0x7f
  416. mov x, #0x80
  417. movw r10, ax
  418. movw r8, #0
  419. ret
  420. 1:
  421. bf a.7, $1f ; note AX has EXP at top of loop
  422. ;; underflow, denormal?
  423. movw ax, A_FRAC_H
  424. shrw ax, 1
  425. movw A_FRAC_H, ax
  426. mov a, A_FRAC_LH
  427. rorc a, 1
  428. movw A_FRAC_LH, ax
  429. mov a, A_FRAC_L
  430. rorc a, 1
  431. movw A_FRAC_L, ax
  432. incw A_EXP
  433. movw ax, A_EXP
  434. br $1b
  435. 1:
  436. ;; undo the rounding-bit-shift
  437. mov a, A_FRAC_L
  438. bf a.0, $1f
  439. ;; round up
  440. movw ax, A_FRAC_L
  441. addw ax, #1
  442. movw A_FRAC_L, ax
  443. bnc $1f
  444. incw A_FRAC_H
  445. ;; If the rounding set the bit beyond the end of the fraction, increment the exponent.
  446. mov a, A_FRAC_HH
  447. bf a.1, $1f
  448. incw A_EXP
  449. 1:
  450. movw ax, A_FRAC_H
  451. shrw ax, 1
  452. movw A_FRAC_H, ax
  453. mov a, A_FRAC_LH
  454. rorc a, 1
  455. mov A_FRAC_LH, a
  456. mov a, A_FRAC_L
  457. rorc a, 1
  458. mov A_FRAC_L, a
  459. movw ax, A_FRAC_L
  460. movw r8, ax
  461. or a, x
  462. or a, A_FRAC_H
  463. or a, A_FRAC_HH
  464. bnz $1f
  465. movw ax, #0
  466. movw A_EXP, ax
  467. 1:
  468. mov a, A_FRAC_H
  469. and a, #0x7f
  470. mov b, a
  471. mov a, A_EXP
  472. shl a, 7
  473. or a, b
  474. mov r10, a
  475. mov a, A_SIGN
  476. and a, #0x80
  477. mov b, a
  478. mov a, A_EXP
  479. shr a, 1
  480. or a, b
  481. mov r11, a
  482. ret
  483. END_FUNC __rl78_int_pack_a_r8
  484. START_FUNC ___mulsf3
  485. ;; if (isnan(a)) return a
  486. movw ax, sp
  487. addw ax, #4
  488. movw hl, ax
  489. call !!__int_isnan
  490. bnz $1f
  491. mret_a:
  492. movw ax, [sp+4]
  493. movw r8, ax
  494. mov a, [sp+11]
  495. and a, #0x80
  496. mov b, a
  497. movw ax, [sp+6]
  498. xor a, b ; sign is always a ^ b
  499. movw r10, ax
  500. ret
  501. 1:
  502. ;; if (isnan (b)) return b;
  503. movw ax, sp
  504. addw ax, #8
  505. movw hl, ax
  506. call !!__int_isnan
  507. bnz $1f
  508. mret_b:
  509. movw ax, [sp+8]
  510. movw r8, ax
  511. mov a, [sp+7]
  512. and a, #0x80
  513. mov b, a
  514. movw ax, [sp+10]
  515. xor a, b ; sign is always a ^ b
  516. movw r10, ax
  517. ret
  518. 1:
  519. ;; if (isinf (a)) return (b==0) ? nan : a
  520. movw ax, sp
  521. addw ax, #4
  522. movw hl, ax
  523. call $!__int_isinf
  524. bnz $.L805
  525. movw ax, sp
  526. addw ax, #8
  527. movw hl, ax
  528. call !!__int_iszero
  529. bnz $mret_a
  530. movw r8, #0x0001 ; return NaN
  531. movw r10, #0x7f80
  532. ret
  533. .L805:
  534. ;; if (isinf (b)) return (a==0) ? nan : b
  535. movw ax, sp
  536. addw ax, #8
  537. movw hl, ax
  538. call $!__int_isinf
  539. bnz $.L814
  540. movw ax, sp
  541. addw ax, #4
  542. movw hl, ax
  543. call !!__int_iszero
  544. bnz $mret_b
  545. movw r8, #0x0001 ; return NaN
  546. movw r10, #0x7f80
  547. ret
  548. .L814:
  549. movw ax, sp
  550. addw ax, #4
  551. movw hl, ax
  552. call !!__int_iszero
  553. bz $mret_a
  554. movw ax, sp
  555. addw ax, #8
  556. movw hl, ax
  557. call !!__int_iszero
  558. bz $mret_b
  559. ;; at this point, we're doing the multiplication.
  560. subw sp, #16 ; save room for two unpacked values
  561. movw ax, sp
  562. movw hl, ax
  563. addw ax, #16+4
  564. movw de, ax
  565. call $!_int_unpack_sf
  566. movw ax, sp
  567. addw ax, #8
  568. movw hl, ax
  569. addw ax, #16+8-8
  570. movw de, ax
  571. call $!_int_unpack_sf
  572. movw ax, sp
  573. movw hl, ax
  574. ;; multiply SI a.FRAC * SI b.FRAC to DI r8
  575. subw sp, #16
  576. movw ax, A_FRAC_L
  577. movw [sp+0], ax
  578. movw ax, A_FRAC_H
  579. movw [sp+2], ax
  580. movw ax, B_FRAC_L
  581. movw [sp+8], ax
  582. movw ax, B_FRAC_H
  583. movw [sp+10], ax
  584. movw ax, #0
  585. movw [sp+4], ax
  586. movw [sp+6], ax
  587. movw [sp+12], ax
  588. movw [sp+14], ax
  589. call !!___muldi3 ; MTMPa * MTMPb -> R8..R15
  590. addw sp, #16
  591. movw ax, sp
  592. movw hl, ax
  593. ;; add the exponents together
  594. movw ax, A_EXP
  595. addw ax, B_EXP
  596. movw bc, ax ; exponent in BC
  597. ;; now, re-normalize the DI value in R8..R15 to have the
  598. ;; MSB in the "right" place, adjusting BC as we shift it.
  599. ;; The value will normally be in this range:
  600. ;; R15 R8
  601. ;; 0001_0000_0000_0000
  602. ;; 0003_ffff_fc00_0001
  603. ;; so to speed it up, we normalize to:
  604. ;; 0001_xxxx_xxxx_xxxx
  605. ;; then extract the bytes we want (r11-r14)
  606. 1:
  607. mov a, r15
  608. cmp0 a
  609. bnz $2f
  610. mov a, r14
  611. and a, #0xfe
  612. bz $1f
  613. 2:
  614. ;; shift right, inc exponent
  615. movw ax, r14
  616. shrw ax, 1
  617. movw r14, ax
  618. mov a, r13
  619. rorc a, 1
  620. mov r13, a
  621. mov a, r12
  622. rorc a, 1
  623. mov r12, a
  624. mov a, r11
  625. rorc a, 1
  626. mov r11, a
  627. ;; we don't care about r8/r9/r10 if we're shifting this way
  628. incw bc
  629. br $1b
  630. 1:
  631. mov a, r15
  632. or a, r14
  633. bnz $1f
  634. ;; shift left, dec exponent
  635. movw ax, r8
  636. shlw ax, 1
  637. movw r8, ax
  638. movw ax, r10
  639. rolwc ax, 1
  640. movw r10, ax
  641. movw ax, r12
  642. rolwc ax, 1
  643. movw r12, ax
  644. movw ax, r14
  645. rolwc ax, 1
  646. movw r14, ax
  647. decw bc
  648. br $1b
  649. 1:
  650. ;; at this point, FRAC is in R11..R14 and EXP is in BC
  651. movw ax, bc
  652. movw A_EXP, ax
  653. mov a, r11
  654. mov A_FRAC_L, a
  655. mov a, r12
  656. mov A_FRAC_LH, a
  657. mov a, r13
  658. mov A_FRAC_H, a
  659. mov a, r14
  660. mov A_FRAC_HH, a
  661. mov a, A_SIGN
  662. xor a, B_SIGN
  663. mov A_SIGN, a
  664. call $!__rl78_int_pack_a_r8
  665. addw sp, #16
  666. ret
  667. END_FUNC ___mulsf3
  668. START_FUNC ___divsf3
  669. ;; if (isnan(a)) return a
  670. movw ax, sp
  671. addw ax, #4
  672. movw hl, ax
  673. call !!__int_isnan
  674. bnz $1f
  675. dret_a:
  676. movw ax, [sp+4]
  677. movw r8, ax
  678. mov a, [sp+11]
  679. and a, #0x80
  680. mov b, a
  681. movw ax, [sp+6]
  682. xor a, b ; sign is always a ^ b
  683. movw r10, ax
  684. ret
  685. 1:
  686. ;; if (isnan (b)) return b;
  687. movw ax, sp
  688. addw ax, #8
  689. movw hl, ax
  690. call !!__int_isnan
  691. bnz $1f
  692. dret_b:
  693. movw ax, [sp+8]
  694. movw r8, ax
  695. mov a, [sp+7]
  696. and a, #0x80
  697. mov b, a
  698. movw ax, [sp+10]
  699. xor a, b ; sign is always a ^ b
  700. movw r10, ax
  701. ret
  702. 1:
  703. ;; if (isinf (a)) return isinf(b) ? nan : a
  704. movw ax, sp
  705. addw ax, #4
  706. movw hl, ax
  707. call $!__int_isinf
  708. bnz $1f
  709. movw ax, sp
  710. addw ax, #8
  711. movw hl, ax
  712. call $!__int_isinf
  713. bnz $dret_a
  714. dret_nan:
  715. movw r8, #0x0001 ; return NaN
  716. movw r10, #0x7f80
  717. ret
  718. 1:
  719. ;; if (iszero (a)) return iszero(b) ? nan : a
  720. movw ax, sp
  721. addw ax, #4
  722. movw hl, ax
  723. call !!__int_iszero
  724. bnz $1f
  725. movw ax, sp
  726. addw ax, #8
  727. movw hl, ax
  728. call !!__int_iszero
  729. bnz $dret_a
  730. br $dret_nan
  731. 1:
  732. ;; if (isinf (b)) return 0
  733. movw ax, sp
  734. addw ax, #8
  735. movw hl, ax
  736. call $!__int_isinf
  737. bnz $1f
  738. mov a, [sp+7]
  739. mov b, a
  740. mov a, [sp+11]
  741. xor a, b
  742. and a, #0x80
  743. mov r11, a
  744. movw r8, #0
  745. mov r10, #0
  746. ret
  747. 1:
  748. ;; if (iszero (b)) return Inf
  749. movw ax, sp
  750. addw ax, #8
  751. movw hl, ax
  752. call !!__int_iszero
  753. bnz $1f
  754. mov a, [sp+7]
  755. mov b, a
  756. mov a, [sp+11]
  757. xor a, b
  758. or a, #0x7f
  759. mov r11, a
  760. movw r8, #0
  761. mov r10, #0x80
  762. ret
  763. 1:
  764. ;; at this point, we're doing the division. Normalized
  765. ;; mantissas look like:
  766. ;; 01.xx.xx.xx
  767. ;; so we divide:
  768. ;; 01.xx.xx.xx.00.00.00.00
  769. ;; by 01.xx.xx.xx
  770. ;; to get approx 00.80.00.00.00 to 01.ff.ff.ff.00
  771. subw sp, #16 ; save room for two unpacked values
  772. movw ax, sp
  773. movw hl, ax
  774. addw ax, #16+4
  775. movw de, ax
  776. call $!_int_unpack_sf
  777. movw ax, sp
  778. addw ax, #8
  779. movw hl, ax
  780. addw ax, #16+8-8
  781. movw de, ax
  782. call $!_int_unpack_sf
  783. movw ax, sp
  784. movw hl, ax
  785. ;; divide DI a.FRAC / SI b.FRAC to DI r8
  786. subw sp, #16
  787. movw ax, A_FRAC_L
  788. movw [sp+4], ax
  789. movw ax, A_FRAC_H
  790. movw [sp+6], ax
  791. movw ax, B_FRAC_L
  792. movw [sp+8], ax
  793. movw ax, B_FRAC_H
  794. movw [sp+10], ax
  795. movw ax, #0
  796. movw [sp+0], ax
  797. movw [sp+2], ax
  798. movw [sp+12], ax
  799. movw [sp+14], ax
  800. call !!___divdi3 ; MTMPa / MTMPb -> R8..R15
  801. addw sp, #16
  802. movw ax, sp
  803. movw hl, ax
  804. ;; subtract the exponents A - B
  805. movw ax, A_EXP
  806. subw ax, B_EXP
  807. movw bc, ax ; exponent in BC
  808. ;; now, re-normalize the DI value in R8..R15 to have the
  809. ;; MSB in the "right" place, adjusting BC as we shift it.
  810. ;; The value will normally be in this range:
  811. ;; R15 R8
  812. ;; 0000_0000_8000_0000
  813. ;; 0000_0001_ffff_ff00
  814. ;; so to speed it up, we normalize to:
  815. ;; 0000_0001_xxxx_xxxx
  816. ;; then extract the bytes we want (r9-r12)
  817. 1:
  818. movw ax, r14
  819. cmpw ax, #0
  820. bnz $2f
  821. movw ax, r12
  822. cmpw ax, #1
  823. bnh $1f
  824. 2:
  825. ;; shift right, inc exponent
  826. movw ax, r14
  827. shrw ax, 1
  828. movw r14, ax
  829. mov a, r13
  830. rorc a, 1
  831. mov r13, a
  832. mov a, r12
  833. rorc a, 1
  834. mov r12, a
  835. mov a, r11
  836. rorc a, 1
  837. mov r11, a
  838. mov a, r10
  839. rorc a, 1
  840. mov r10, a
  841. mov a, r9
  842. rorc a, 1
  843. mov r9, a
  844. mov a, r8
  845. rorc a, 1
  846. mov r8, a
  847. incw bc
  848. br $1b
  849. 1:
  850. ;; the previous loop leaves r15.r13 zero
  851. mov a, r12
  852. cmp0 a
  853. bnz $1f
  854. ;; shift left, dec exponent
  855. movw ax, r8
  856. shlw ax, 1
  857. movw r8, ax
  858. movw ax, r10
  859. rolwc ax, 1
  860. movw r10, ax
  861. movw ax, r12
  862. rolwc ax, 1
  863. movw r12, ax
  864. ;; don't need to do r14
  865. decw bc
  866. br $1b
  867. 1:
  868. ;; at this point, FRAC is in R8..R11 and EXP is in BC
  869. movw ax, bc
  870. movw A_EXP, ax
  871. mov a, r9
  872. mov A_FRAC_L, a
  873. mov a, r10
  874. mov A_FRAC_LH, a
  875. mov a, r11
  876. mov A_FRAC_H, a
  877. mov a, r12
  878. mov A_FRAC_HH, a
  879. mov a, A_SIGN
  880. xor a, B_SIGN
  881. mov A_SIGN, a
  882. call $!__rl78_int_pack_a_r8
  883. addw sp, #16
  884. ret
  885. END_FUNC ___divsf3