123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474 |
- ! floating point pakket voor Z80
- ! geimplementeerd zoals beschreven in
- ! Electronica top internationaal.
- ! September 1979
- ! Auteur: Hr. R. Beverdam, Zuidbroekweg 9,7642 NW Wierden
- xa: .space 1
- fpac:
- fal: .space 1
- fan: .space 1
- fam: .space 1
- fax: .space 1
- xo: .space 1
- fpop:
- fol: .space 1
- fon: .space 1
- fom: .space 1
- fox: .space 1
- .errnz xa/256-fox/256
- fpsub:
- call fpcomp ! inverteer fpacc
- fpadd:
- ld de,(fam) ! d fax,e fam
- ld bc,(fom) ! b fox,c fom
- ld a,e ! test fpacc
- or a ! 0?
- jr z,movop ! ja: som=fpop dus verplaats
- xor a
- add a,c
- ret z ! som is dus fpacc, klaar
- ld a,b
- sub d ! a:=fox-fax
- ld l,a ! bewaar verschil exponenten
- jp p,skpneg ! maak positief
- neg
- skpneg:
- cp 0x18 ! verschil meer dan 23?
- ld a,l
- jp m,lineup ! spring indien binnen bereik
- and a ! getallen te groot tov elkaar
- ret m ! klaar als fpacc het grootst
- movop:
- ld hl,fol ! verplaats fpop naar fpacc
- ld de,fal ! want fpop is het antwoord
- ld bc,4
- ldir
- ret
- lineup:
- and a ! kijk welke groter is
- jp m,shifto ! spring als fpop>fpac
- inc a ! bereken sa
- ld b,a ! save sa in b register
- ld a,1 ! so 1
- push af ! bewaar so op stapel
- jr shacop ! gr schuiven
- shifto:
- neg ! bereken fox-fax
- eqexp:
- inc a ! so 1+(fox-fax)
- push af ! bewaar so op stapel
- ld b,1 ! sa 1
- shacop:
- ld hl,(fal) ! l fal,h fan
- xor a ! xa 0
- moracc:
- sra e ! schuif fam
- rr h ! fan
- rr l ! fal
- rra ! xa
- inc d ! update voor fax
- djnz moracc ! herhaal sa keer
- ld (xa),a ! berg alles
- ld (fal),hl ! weg in
- ld (fam),de ! fpacc en xa
- pop af ! haal so terug van stapel
- ld b,a ! en zet in b register
- xor a ! xo 0
- ld hl,(fol) ! l fol,h fon
- morop:
- sra c ! schuif: fom
- rr h ! fon
- rr l !
- rra ! xo
- djnz morop ! herhaal so keer
- ld (xo),a
- ld (fol),hl
- ld (fom),bc ! berg alles weg in fpop en xo
- ld de,xa
- ld hl,xo
- ld b,4
- or a ! reset carry
- addmor:
- ld a,(de) ! haal een byte
- adc a,(hl) ! tel er een bij op
- ld (de),a ! en berg de som weer op
- inc e
- inc l
- djnz addmor ! herhaal dit 4 keer
- jr fpnorm
- fpmult:
- call setsgn
- add a,(hl) ! bereken exponent produkt
- ld (hl),a ! fax exponent produkt
- ld l,fom%256
- ex de,hl ! gebruik de als wijzer
- xor a
- ld h,a
- ld l,a ! hoogste 16 bits van pp worden nul
- exx
- ld bc,(fal)
- ld de,(fam) ! haal mc in registers
- ld d,a ! d:=0 tbv 16-bit add
- ld h,a
- ld l,a ! middelste 16 bits van pp worden nul
- ld ix,0 ! laagste 16 bits ook
- exx
- ld c,3
- mult:
- ld a,(de) ! haal een byte van mr
- dec e
- ld b,8 ! bits in a byte
- shift:
- rla ! schuif vooste bit in carry
- exx
- jr nc,noadd ! vooste bit is 0, dan niet optellen
- add ix,bc ! pp:=pp+mc
- adc hl,de ! continued
- noadd:
- add ix,ix
- adc hl,hl
- exx
- adc hl,hl ! dit schoof het hele partiele produkt <
- djnz shift ! herhaal voor alle 8 bits
- dec c
- jr nz,mult ! herhaal voor 3 bytes
- exx
- rl l
- rla
- add a,h
- ld (fal),a
- ld a,d
- exx
- adc a,l
- ld (fan),a ! rond getal in pp af en berg resultaat op
- ld a,c
- adc a,h
- ld (fam),a
- call fpnorm
- exmldv:
- ld hl,xa
- ld c,(hl)
- jp resign ! fix sign
- fpdiv:
- call setsgn
- sub (hl)
- ld (hl),a ! berg exponent quotient op
- ld hl,(fol)
- push hl
- pop ix
- ld de,(fal)
- ld a,(fam)
- or a ! fpacc = 0 ?
- jr z,fperr ! fout, deling door nul
- ld b,a ! b:=fam
- ld a,(fom)
- ld c,a
- exx
- ld hl,fam
- ld e,3
- divide:
- ld b,8
- mordiv:
- exx
- and a
- sbc hl,de
- sbc a,b ! probeer de aftrekking
- jp m,nogo ! gaat niet
- push hl
- pop ix
- ld c,a
- ex af,af2 ! quotient in tweede accumulator
- scf
- jr quorot
- nogo:
- ex af,af2
- or a
- quorot:
- rla ! volgende bit in quotient
- ex af,af2
- add ix,ix ! schuif eventueel vernieuwde
- rl c ! dd naar links
- push ix
- pop hl
- ld a,c ! zet nieuwe dd in rekenregisters
- exx
- djnz mordiv ! herhaal 8 keer
- ex af,af2
- ld (hl),a ! zet een byte van het quotient in het geheugen
- dec l
- ex af,af2
- dec e
- jr nz,divide ! herhaal 3 keer
- ld bc,(fal)
- ld hl,(fam) ! haal quotient terug in cpu
- bit 7,l
- jp z,exmldv ! als niet te groot tekenherstellen
- ld a,1 ! wel te groot
- add a,c ! eerst getal afronden
- ld c,a
- ld a,e
- adc a,b
- ld b,a
- ld a,e
- adc a,l
- ld l,a
- shft:
- inc h ! nu getal naar rechts schuiven
- rr l
- rr b
- rr c
- or a
- bit 7,l
- jr nz,shft ! door afronding weer te groot
- ld (fal),bc
- ld (fam),hl
- jr exmldv ! inspecteer teken
- setsgn:
- ld a,(fom) ! ******** setsgn ************
- ld c,1 ! teken -1
- rlca ! fpop 0 ?
- jr nc,tstacc ! nee
- rrc c ! ja, dus teken:=teken*(-1)
- ld hl,fol ! en inverteer fpop
- call complm
- tstacc:
- ld a,(fam)
- rlca ! fpacc 0?
- jr nc,init ! nee
- rrc c ! ja dus teken:=teken*(-1)
- call fpcomp
- init:
- ld hl,xa ! initialiseer nog een paar registers
- ld (hl),c
- ld a,(fox)
- ld l,fax%256
- ret
- fpcif:
- ld de,(fpac) ! integer to convert
- xor a
- sra d
- rr e
- rr a
- ld (fan),de
- ld (fal),a
- ld a,16
- ld (fax),a
- jr fpnorm
- fpcfi:
- ld a,(fax)
- dec a
- jp m,fpzero ! really integer zero here
- sub 15
- jp p,fperr ! overflow
- ld de,(fan)
- inc a
- neg
- jr z,2f
- ld b,a
- ld a,(fal)
- 1:
- sra d
- rr e
- rr a
- djnz 1b
- 2:
- bit 7,d
- jr z,0f
- inc de
- 0:
- ld (fpac),de
- ret
- fpcdf:
- ld de,(fpac)
- ld bc,(fpac+2)
- ld h,31
- 3:
- ld a,b
- and 0300
- jr z,1f
- cp 0300
- jr z,1f
- or a
- jp p,2f
- sra b
- rr c
- rr d
- inc h
- 2:
- ld a,h
- ld (fax),a
- ld (fan),bc
- ld a,d
- ld (fal),a
- ret
- 1:
- sla e
- rl d
- rl c
- rl b
- dec h
- jr 3b
- fpcfd:
- ld a,(fax)
- dec a
- jp m,fpzero
- cp 32
- jp p,fperr
- sub 31
- cpl
- ld bc,(fan)
- ld de,(fal)
- ld d,e
- ld e,0
- 1:
- dec a
- jp m,2f
- sra b
- rr c
- rr d
- rr e
- jr 1b
- 2:
- bit 7,b
- jr z,3f
- sla e
- rl d
- rl c
- rl b
- 3:
- ld (fpac+2),bc
- ld (fpac),de
- ret
- fpfef:
- ld a,(fox)
- ld (fpac),a
- 9:
- bit 7,a
- jr z,1f
- ld a,0xFF
- jr 2f
- 1:
- xor a
- 2:
- ld (fpac+1),a
- xor a
- ld (fox),a
- ret
- fpcmf:
- call fpsub
- ld a,(fam)
- ld (fpac),a
- jr 9b
- fpfif:
- call fpmult
- ld a,(fax)
- dec a
- jp m,intzero
- inc a
- ld b,a
- xor a
- ld c,0200
- ld d,a
- ld e,a
- 1:
- sra c
- rr d
- rr e
- djnz 1b
- ld hl,fam
- ld b,(hl)
- ld a,c
- and b
- ld (fom),a
- ld a,c
- xor 0177
- and b
- ld (hl),a
- dec l
- ld b,(hl)
- ld a,d
- and b
- ld (fon),a
- ld a,d
- cpl
- and b
- ld (hl),a
- dec l
- ld b,(hl)
- ld a,e
- and b
- ld (fol),a
- ld a,e
- cpl
- and b
- ld (hl),a
- ld a,(fax)
- ld (fox),a
- jr fpnorm
- intzero:
- xor a
- ld hl,fol
- ld b,4
- 1: ld (hl),a
- inc hl
- djnz 1b
- ret
- fpzero:
- xor a
- ld h,a
- ld l,a
- ld (fal),hl
- ld (fam),hl
- ret
- fpnorm:
- ld a,(fam)
- ld c,a
- or a ! fpacc < 0 ?
- call m,fpcomp ! ja -- inverteer
- ld hl,(fal)
- ld de,(fam)
- ld a,l
- or h
- or e
- jr z,fpzero ! als hele facc 0 is
- ld a,e
- mortst:
- bit 6,a ! test meest significante bit
- jr nz,catch ! stop als bit is 1
- add hl,hl ! schuif links zolang bit = 0
- adc a,a
- dec d ! pas fax ook aan
- jr mortst
- catch:
- ld e,a ! herstel nu fpacc in geheugen
- ld (fal),hl
- ld (fam),de
- resign:
- bit 7,c ! test op teken
- ret z ! positief, geen actie
- fpcomp:
- ld hl,fal
- complm:
- ld b,3 ! inverteer alleen mantisse
- xor a
- morcom:
- sbc a,(hl)
- ld (hl),a
- inc hl
- ld a,0
- djnz morcom
- or a
- ret
- fperr:
- scf
- ret
|