mach/z80/int/fpp.s

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