home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / PASCALZ4.ZIP / D3 / ROUND.SRC < prev    next >
Text File  |  1999-04-05  |  2KB  |  54 lines
  1. ; truncate and round functions (used to convert float -> integer)
  2. ;
  3.     NAME ROUND
  4.     ENTRY .ROUND,.TRUNC,L129,L130
  5.     EXT .FADD,.RNGERR
  6.     INCLUDE FPINIT.SRC
  7. ;
  8. L130:
  9. .round:    pop    h        ;get return address
  10.     pop    d        ;get low word
  11.     xthl            ;get high word
  12.     push    h        ;save high word
  13.     push    d        ;save low word
  14.     mov    d,a        ;set op2 = .5
  15.     mov    e,a
  16.     mov    h,a
  17.     mvi    a,80h        ;make sign of op2 = sign of op1
  18.     ana    l
  19.     ori    40h        ;set bit to the right of the binary pt
  20.     mov    l,a        ;save as high byte of mantissa
  21.     push    h        ;save op2
  22.     push    d
  23.     call    .fadd        ;increase the magnitude of op1 by .5
  24.     pop    d        ;get number to .truncate
  25.     pop    h
  26.     jr    trunc2        ;...and go truncate
  27. L129:
  28. .trunc:    pop    h        ;get return address
  29.     pop    d        ;get low word of #
  30.     xthl            ;get high word
  31. trunc2:    mov    e,d        ;throw away low 8 bits
  32.     mov    d,l
  33.     bit    sign,h        ;check for negative exponent
  34.     jrnz    zeroi        ;return zero integer
  35.     mvi    a,15        ;# of shifts assuming zero exponent
  36.     sub    h        ;get actual # of shifts
  37.     jc    .rngerr        ;number too big return error message
  38.     res    sign,d        ;clear sign bit
  39.     jrz    dones        ;done shifting
  40.     mov    b,a        ;install counter
  41. shft:    srlr    d        ;shift high byte
  42.     rrar    e        ;rotate low byte
  43.     djnz    shft        ;continue until done
  44. dones:    xra    a        ;clear acc, carry
  45.     bit    sign,l        ;check sign bit
  46.     rz            ;sign is +ive, return now!
  47.     lxi    h,0        ;negate de
  48.     dsbc    d        ;by subtracting
  49. dntngt:    xchg            ;return integer in de
  50.     ret
  51. zeroi:    lxi    d,0        ;return a value of zero
  52.     xra    a        ;clear acc
  53.     ret
  54.