fpp.s 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474
  1. ! floating point pakket voor Z80
  2. ! geimplementeerd zoals beschreven in
  3. ! Electronica top internationaal.
  4. ! September 1979
  5. ! Auteur: Hr. R. Beverdam, Zuidbroekweg 9,7642 NW Wierden
  6. xa: .space 1
  7. fpac:
  8. fal: .space 1
  9. fan: .space 1
  10. fam: .space 1
  11. fax: .space 1
  12. xo: .space 1
  13. fpop:
  14. fol: .space 1
  15. fon: .space 1
  16. fom: .space 1
  17. fox: .space 1
  18. .errnz xa/256-fox/256
  19. fpsub:
  20. call fpcomp ! inverteer fpacc
  21. fpadd:
  22. ld de,(fam) ! d fax,e fam
  23. ld bc,(fom) ! b fox,c fom
  24. ld a,e ! test fpacc
  25. or a ! 0?
  26. jr z,movop ! ja: som=fpop dus verplaats
  27. xor a
  28. add a,c
  29. ret z ! som is dus fpacc, klaar
  30. ld a,b
  31. sub d ! a:=fox-fax
  32. ld l,a ! bewaar verschil exponenten
  33. jp p,skpneg ! maak positief
  34. neg
  35. skpneg:
  36. cp 0x18 ! verschil meer dan 23?
  37. ld a,l
  38. jp m,lineup ! spring indien binnen bereik
  39. and a ! getallen te groot tov elkaar
  40. ret m ! klaar als fpacc het grootst
  41. movop:
  42. ld hl,fol ! verplaats fpop naar fpacc
  43. ld de,fal ! want fpop is het antwoord
  44. ld bc,4
  45. ldir
  46. ret
  47. lineup:
  48. and a ! kijk welke groter is
  49. jp m,shifto ! spring als fpop>fpac
  50. inc a ! bereken sa
  51. ld b,a ! save sa in b register
  52. ld a,1 ! so 1
  53. push af ! bewaar so op stapel
  54. jr shacop ! gr schuiven
  55. shifto:
  56. neg ! bereken fox-fax
  57. eqexp:
  58. inc a ! so 1+(fox-fax)
  59. push af ! bewaar so op stapel
  60. ld b,1 ! sa 1
  61. shacop:
  62. ld hl,(fal) ! l fal,h fan
  63. xor a ! xa 0
  64. moracc:
  65. sra e ! schuif fam
  66. rr h ! fan
  67. rr l ! fal
  68. rra ! xa
  69. inc d ! update voor fax
  70. djnz moracc ! herhaal sa keer
  71. ld (xa),a ! berg alles
  72. ld (fal),hl ! weg in
  73. ld (fam),de ! fpacc en xa
  74. pop af ! haal so terug van stapel
  75. ld b,a ! en zet in b register
  76. xor a ! xo 0
  77. ld hl,(fol) ! l fol,h fon
  78. morop:
  79. sra c ! schuif: fom
  80. rr h ! fon
  81. rr l !
  82. rra ! xo
  83. djnz morop ! herhaal so keer
  84. ld (xo),a
  85. ld (fol),hl
  86. ld (fom),bc ! berg alles weg in fpop en xo
  87. ld de,xa
  88. ld hl,xo
  89. ld b,4
  90. or a ! reset carry
  91. addmor:
  92. ld a,(de) ! haal een byte
  93. adc a,(hl) ! tel er een bij op
  94. ld (de),a ! en berg de som weer op
  95. inc e
  96. inc l
  97. djnz addmor ! herhaal dit 4 keer
  98. jr fpnorm
  99. fpmult:
  100. call setsgn
  101. add a,(hl) ! bereken exponent produkt
  102. ld (hl),a ! fax exponent produkt
  103. ld l,fom%256
  104. ex de,hl ! gebruik de als wijzer
  105. xor a
  106. ld h,a
  107. ld l,a ! hoogste 16 bits van pp worden nul
  108. exx
  109. ld bc,(fal)
  110. ld de,(fam) ! haal mc in registers
  111. ld d,a ! d:=0 tbv 16-bit add
  112. ld h,a
  113. ld l,a ! middelste 16 bits van pp worden nul
  114. ld ix,0 ! laagste 16 bits ook
  115. exx
  116. ld c,3
  117. mult:
  118. ld a,(de) ! haal een byte van mr
  119. dec e
  120. ld b,8 ! bits in a byte
  121. shift:
  122. rla ! schuif vooste bit in carry
  123. exx
  124. jr nc,noadd ! vooste bit is 0, dan niet optellen
  125. add ix,bc ! pp:=pp+mc
  126. adc hl,de ! continued
  127. noadd:
  128. add ix,ix
  129. adc hl,hl
  130. exx
  131. adc hl,hl ! dit schoof het hele partiele produkt <
  132. djnz shift ! herhaal voor alle 8 bits
  133. dec c
  134. jr nz,mult ! herhaal voor 3 bytes
  135. exx
  136. rl l
  137. rla
  138. add a,h
  139. ld (fal),a
  140. ld a,d
  141. exx
  142. adc a,l
  143. ld (fan),a ! rond getal in pp af en berg resultaat op
  144. ld a,c
  145. adc a,h
  146. ld (fam),a
  147. call fpnorm
  148. exmldv:
  149. ld hl,xa
  150. ld c,(hl)
  151. jp resign ! fix sign
  152. fpdiv:
  153. call setsgn
  154. sub (hl)
  155. ld (hl),a ! berg exponent quotient op
  156. ld hl,(fol)
  157. push hl
  158. pop ix
  159. ld de,(fal)
  160. ld a,(fam)
  161. or a ! fpacc = 0 ?
  162. jr z,fperr ! fout, deling door nul
  163. ld b,a ! b:=fam
  164. ld a,(fom)
  165. ld c,a
  166. exx
  167. ld hl,fam
  168. ld e,3
  169. divide:
  170. ld b,8
  171. mordiv:
  172. exx
  173. and a
  174. sbc hl,de
  175. sbc a,b ! probeer de aftrekking
  176. jp m,nogo ! gaat niet
  177. push hl
  178. pop ix
  179. ld c,a
  180. ex af,af2 ! quotient in tweede accumulator
  181. scf
  182. jr quorot
  183. nogo:
  184. ex af,af2
  185. or a
  186. quorot:
  187. rla ! volgende bit in quotient
  188. ex af,af2
  189. add ix,ix ! schuif eventueel vernieuwde
  190. rl c ! dd naar links
  191. push ix
  192. pop hl
  193. ld a,c ! zet nieuwe dd in rekenregisters
  194. exx
  195. djnz mordiv ! herhaal 8 keer
  196. ex af,af2
  197. ld (hl),a ! zet een byte van het quotient in het geheugen
  198. dec l
  199. ex af,af2
  200. dec e
  201. jr nz,divide ! herhaal 3 keer
  202. ld bc,(fal)
  203. ld hl,(fam) ! haal quotient terug in cpu
  204. bit 7,l
  205. jp z,exmldv ! als niet te groot tekenherstellen
  206. ld a,1 ! wel te groot
  207. add a,c ! eerst getal afronden
  208. ld c,a
  209. ld a,e
  210. adc a,b
  211. ld b,a
  212. ld a,e
  213. adc a,l
  214. ld l,a
  215. shft:
  216. inc h ! nu getal naar rechts schuiven
  217. rr l
  218. rr b
  219. rr c
  220. or a
  221. bit 7,l
  222. jr nz,shft ! door afronding weer te groot
  223. ld (fal),bc
  224. ld (fam),hl
  225. jr exmldv ! inspecteer teken
  226. setsgn:
  227. ld a,(fom) ! ******** setsgn ************
  228. ld c,1 ! teken -1
  229. rlca ! fpop 0 ?
  230. jr nc,tstacc ! nee
  231. rrc c ! ja, dus teken:=teken*(-1)
  232. ld hl,fol ! en inverteer fpop
  233. call complm
  234. tstacc:
  235. ld a,(fam)
  236. rlca ! fpacc 0?
  237. jr nc,init ! nee
  238. rrc c ! ja dus teken:=teken*(-1)
  239. call fpcomp
  240. init:
  241. ld hl,xa ! initialiseer nog een paar registers
  242. ld (hl),c
  243. ld a,(fox)
  244. ld l,fax%256
  245. ret
  246. fpcif:
  247. ld de,(fpac) ! integer to convert
  248. xor a
  249. sra d
  250. rr e
  251. rr a
  252. ld (fan),de
  253. ld (fal),a
  254. ld a,16
  255. ld (fax),a
  256. jr fpnorm
  257. fpcfi:
  258. ld a,(fax)
  259. dec a
  260. jp m,fpzero ! really integer zero here
  261. sub 15
  262. jp p,fperr ! overflow
  263. ld de,(fan)
  264. inc a
  265. neg
  266. jr z,2f
  267. ld b,a
  268. ld a,(fal)
  269. 1:
  270. sra d
  271. rr e
  272. rr a
  273. djnz 1b
  274. 2:
  275. bit 7,d
  276. jr z,0f
  277. inc de
  278. 0:
  279. ld (fpac),de
  280. ret
  281. fpcdf:
  282. ld de,(fpac)
  283. ld bc,(fpac+2)
  284. ld h,31
  285. 3:
  286. ld a,b
  287. and 0300
  288. jr z,1f
  289. cp 0300
  290. jr z,1f
  291. or a
  292. jp p,2f
  293. sra b
  294. rr c
  295. rr d
  296. inc h
  297. 2:
  298. ld a,h
  299. ld (fax),a
  300. ld (fan),bc
  301. ld a,d
  302. ld (fal),a
  303. ret
  304. 1:
  305. sla e
  306. rl d
  307. rl c
  308. rl b
  309. dec h
  310. jr 3b
  311. fpcfd:
  312. ld a,(fax)
  313. dec a
  314. jp m,fpzero
  315. cp 32
  316. jp p,fperr
  317. sub 31
  318. cpl
  319. ld bc,(fan)
  320. ld de,(fal)
  321. ld d,e
  322. ld e,0
  323. 1:
  324. dec a
  325. jp m,2f
  326. sra b
  327. rr c
  328. rr d
  329. rr e
  330. jr 1b
  331. 2:
  332. bit 7,b
  333. jr z,3f
  334. sla e
  335. rl d
  336. rl c
  337. rl b
  338. 3:
  339. ld (fpac+2),bc
  340. ld (fpac),de
  341. ret
  342. fpfef:
  343. ld a,(fox)
  344. ld (fpac),a
  345. 9:
  346. bit 7,a
  347. jr z,1f
  348. ld a,0xFF
  349. jr 2f
  350. 1:
  351. xor a
  352. 2:
  353. ld (fpac+1),a
  354. xor a
  355. ld (fox),a
  356. ret
  357. fpcmf:
  358. call fpsub
  359. ld a,(fam)
  360. ld (fpac),a
  361. jr 9b
  362. fpfif:
  363. call fpmult
  364. ld a,(fax)
  365. dec a
  366. jp m,intzero
  367. inc a
  368. ld b,a
  369. xor a
  370. ld c,0200
  371. ld d,a
  372. ld e,a
  373. 1:
  374. sra c
  375. rr d
  376. rr e
  377. djnz 1b
  378. ld hl,fam
  379. ld b,(hl)
  380. ld a,c
  381. and b
  382. ld (fom),a
  383. ld a,c
  384. xor 0177
  385. and b
  386. ld (hl),a
  387. dec l
  388. ld b,(hl)
  389. ld a,d
  390. and b
  391. ld (fon),a
  392. ld a,d
  393. cpl
  394. and b
  395. ld (hl),a
  396. dec l
  397. ld b,(hl)
  398. ld a,e
  399. and b
  400. ld (fol),a
  401. ld a,e
  402. cpl
  403. and b
  404. ld (hl),a
  405. ld a,(fax)
  406. ld (fox),a
  407. jr fpnorm
  408. intzero:
  409. xor a
  410. ld hl,fol
  411. ld b,4
  412. 1: ld (hl),a
  413. inc hl
  414. djnz 1b
  415. ret
  416. fpzero:
  417. xor a
  418. ld h,a
  419. ld l,a
  420. ld (fal),hl
  421. ld (fam),hl
  422. ret
  423. fpnorm:
  424. ld a,(fam)
  425. ld c,a
  426. or a ! fpacc < 0 ?
  427. call m,fpcomp ! ja -- inverteer
  428. ld hl,(fal)
  429. ld de,(fam)
  430. ld a,l
  431. or h
  432. or e
  433. jr z,fpzero ! als hele facc 0 is
  434. ld a,e
  435. mortst:
  436. bit 6,a ! test meest significante bit
  437. jr nz,catch ! stop als bit is 1
  438. add hl,hl ! schuif links zolang bit = 0
  439. adc a,a
  440. dec d ! pas fax ook aan
  441. jr mortst
  442. catch:
  443. ld e,a ! herstel nu fpacc in geheugen
  444. ld (fal),hl
  445. ld (fam),de
  446. resign:
  447. bit 7,c ! test op teken
  448. ret z ! positief, geen actie
  449. fpcomp:
  450. ld hl,fal
  451. complm:
  452. ld b,3 ! inverteer alleen mantisse
  453. xor a
  454. morcom:
  455. sbc a,(hl)
  456. ld (hl),a
  457. inc hl
  458. ld a,0
  459. djnz morcom
  460. or a
  461. ret
  462. fperr:
  463. scf
  464. ret