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 / FPDIVD.SRC < prev    next >
Text File  |  1999-04-05  |  2KB  |  86 lines
  1. ; floating point divide routine
  2. ;
  3.     NAME FPDIVD
  4.     ENTRY .FDIVD,.FDVD1
  5.     EXT .FPERR,.MPSUB,.DONE2
  6.     INCLUDE FPINIT.SRC
  7.     INCLUDE FPMAC.SRC
  8. ;
  9. .fdivd:    setupf            ;setup for 2 operands
  10. .fdvd1:    zchk    2        ;check for division by zero
  11.     jz    .fperr
  12.     mov    a,op1+msb(x)    ;get sign of op1
  13.     xra    op2+msb(x)    ;x-or with sign of op2
  14.     mov    scr1(x),a    ;save sign of result
  15.     mov    a,op1(x)    ;get exponent of op1
  16.     inr    a        ;compensate for algorithm
  17.     sub    op2(x)        ;subtract exponent of op2
  18.     jv    .fperr        ;floating point error
  19.     mov    op1(x),a    ;save exponent of result
  20.     res    sign,op1+msb(x)    ;clear sign bits in op1...
  21.     res    sign,op2+msb(x)    ;...and op2
  22.     lxi    h,-nbytes    ;add extra variable to stack
  23.     dad    s        ;for use in intermediate
  24.     sphl            ;calculations
  25.     push    h        ;save addr of lsb
  26.     xra    a        ;zero temporary variable
  27.     mvi    b,nbytes    ;zero correct number of bytes
  28. zerlp:    mov    m,a        ;zero this byte
  29.     inx    h        ;bump pointer
  30.     djnz    zerlp        ;and continue
  31.     dcx    h        ;correct pointer
  32.     push    h        ;make y point to this
  33.     pop    y        ;temporary variable
  34.     mvi    b,fracln*8-1    ;process all bits in mantissa
  35. divlp:    
  36.     push    d        ;save base-100H reg
  37.     push    b        ;save counter
  38.     lxi    h,op1        ;get addresses of two operands
  39.     dad    d
  40.     xchg            ;de <- hl = addr( op1 )
  41.     lxi    b,op2
  42.     dad    b        ;hl = addr( op2 )
  43.     mvi    b,fracln    ;process at most all bytes
  44. divd1:    dcx    h        ;bump pointers
  45.     dcx    d
  46.     ldax    d        ;get byte from op1
  47.     cmp    m        ;compare with byte from op2
  48.     jrc    divd2        ;too big don't subtract
  49.     jrnz    divd1a        ;continue if zero
  50.     djnz    divd1        ;stop when done
  51.     inr    b        ;make the next loop do nothing
  52. divd1a:    dcx    h
  53.     dcx    d
  54.     djnz    divd1a
  55.     inx    h
  56.     inx    d
  57. divd1b:    call    .mpsub        ;subtract divisor from dividend
  58.     ora    a        ;clear carry
  59. divd2:    pop    b        ;restore counter
  60.     pop    d        ;restore base-100H reg
  61.     push    psw        ;save carry
  62.     rotate    y,left        ;shift result right one bit
  63.     pop    psw        ;get carry
  64.     jrc    divd3        ;don't set a bit
  65.     bset    0,lsb(y)    ;set least significant bit
  66. divd3:    rotate    1,left        ;shift dividend left 1 bit
  67.     djnz    divlp        ;...and continue
  68.     lxi    h,op1+lsb    ;calculate addr of op1
  69.     dad    d
  70.     pop    d        ;get addr of temp variable
  71.     mvi    b,fracln    ;and copy to op1
  72. coplp:    ldax    d        ;get byte from temp
  73.     mov    m,a        ;store in op1
  74.     inx    h        ;bump pointers
  75.     inx    d
  76.     djnz    coplp
  77. ; fix stack
  78.     lxi    h,nbytes    ;size of temp variable
  79.     dad    s        ;+ stack pointer
  80.     sphl            ;is original value of sp
  81.     bit    sign,scr1(x)    ;fix sign of result
  82.     jz    .done2
  83.     bset    sign,op1+msb(x)
  84.     jmp    .done2
  85. ;
  86.