home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / LIB / ARISOURC.ZIP / FPFML.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-03-07  |  7.3 KB  |  159 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 7.0        *
  5. ; *     Real Fast Multiplication                        *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1992,1993 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   FPFML
  12.  
  13. CODE         SEGMENT BYTE PUBLIC 'CODE'
  14.  
  15.              ASSUME  CS: CODE
  16.  
  17.              PUBLIC       RealMulF, RealMulFNoChk, RealMulFNChk2, ShortMul, ShortMulRev
  18.  
  19.              ; DI:..:CL
  20.              ; DX:BX:AX
  21.  
  22. ShortMulRev  PROC    NEAR
  23.              XCHG    AX, CX
  24.              MOV     BX, SI
  25.              XCHG    DX, DI
  26. ShortMulRev  ENDP
  27.  
  28. ShortMul     PROC    NEAR
  29.              PUSH    BP                ; save TURBO-framepointer
  30.              XCHG    BX, DI            ; BX = b1, DI = a2
  31.              MOV     BP, DX            ; get sign of multiplicant
  32.              XOR     BP, BX            ; compute sign of result
  33.              AND     BP, 8000h         ; mask out sign bit
  34.              XCHG    AL, CH            ; save b3
  35.              ADD     CL, CH            ; sum of biased exponents
  36.              SBB     CH, CH            ; clear msb
  37.              NEG     CH                ;  and put possible overflow in CH
  38.              OR      CX, BP            ; zap in sign bit
  39.              PUSH    CX                ; save new exponent and sign bit
  40.              XOR     CX, CX            ; clear lo-bytes of a3 and b3
  41.              OR      DH, 80h           ; set implicit bit of multipicand
  42.              OR      BH, 80h           ; set implicit bit of multiplicator
  43.              MOV     SI, DX            ; save a1
  44.              MUL     BX                ; b1 * a3
  45.              MOV     BP, AX            ; generate sticky byte = 0
  46.              XCHG    AX, DX            ; AX = msw of product
  47.              XCHG    AX, DI            ; save msw of product, get a2
  48.              MUL     BX                ; b1 * a2
  49.              XCHG    AX, BX            ; save lsw of product, get b1
  50.              XCHG    DX, SI            ; save msw of product, get a1
  51.              ADD     BX, DI            ; add product
  52.              ADC     SI, CX            ;  to FPA
  53.              MUL     DX                ; b1 * a1
  54.              ADD     AX, SI            ; add product
  55.              ADC     DX, CX            ;  result in DX:AX:BX
  56.              JMP     $end_mantiss      ; handle exponent
  57. $zero_res:   JMP     $zero_prod2       ; result is 0
  58. ShortMul     ENDP
  59.  
  60.              ALIGN   4
  61.  
  62. RealMulF     PROC    NEAR
  63.              OR      CL, CL            ; multiplicator = 0 ?
  64.              JZ      $zero_res         ; result will be 0
  65.  
  66. RealMulFNoChk PROC    NEAR
  67.              OR      AL, AL            ; multiplicand = 0 ?
  68.              JZ      $zero_res         ; result is zero
  69.  
  70. RealMulFNChk2 PROC    NEAR
  71.              PUSH    BP                ; save TURBO-framepointer
  72.              XCHG    BX, DI            ; BX = b1, DI = a2
  73.              MOV     BP, DX            ; get sign of multiplicant
  74.              XOR     BP, BX            ; compute sign of result
  75.              AND     BP, 8000h         ; mask out sign bit
  76.              XCHG    AL, CH            ; save b3
  77.              ADD     CL, CH            ; sum of biased exponents
  78.              SBB     CH, CH            ; clear msb
  79.              NEG     CH                ;  and put possible overflow in CH
  80.              OR      CX, BP            ; zap in sign bit
  81.              PUSH    CX                ; save new exponent and sign bit
  82.              XOR     CX, CX            ; clear lo-bytes of a3 and b3
  83.              OR      DH, 80h           ; set implicit bit of multipicand
  84.              OR      BH, 80h           ; set implicit bit of multiplicator
  85. $full_mult:  XCHG    AL, CH            ; CH = b3, AL = 0
  86.              PUSH    BX                ; save b1
  87.              PUSH    DX                ; save a1
  88.              MOV     BP, DX            ; save a1
  89.              MUL     BX                ; b1 * a3
  90.              XOR     BX, BX            ; clear FPA
  91.              XCHG    AX, CX            ; get b3, save LSW (b1*a3)
  92.              XCHG    DX, BP            ; get a1, save MSW (b1*a3)
  93.              MUL     DX                ; a1 * b3
  94.              ADD     CX, AX            ; add
  95.              ADC     BP, DX            ;  result
  96.              ADC     BX, BX            ;   to FPA
  97.              MOV     AX, SI            ; b2
  98.              MUL     DI                ; a2 * b2
  99.              ADC     CX, AX
  100.              ADC     BP, DX
  101.              ADC     BX, 0
  102.              XOR     CX, CX            ; FPA = CX:BX:BP
  103.              XCHG    AX, SI            ; get b2
  104.              POP     SI                ; get a1
  105.              MUL     SI                ; a1 * b2
  106.              ADD     BP, AX            ; add
  107.              ADC     BX, DX            ;  result
  108.              ADC     CX, CX            ;   to FPA
  109.              XCHG    AX, DI            ; get a2
  110.              POP     DI                ; get b1
  111.              MUL     DI                ; a2 * b1
  112.              ADD     BP, AX            ; add result
  113.              XCHG    AX, DI            ; get a1
  114.              XCHG    CX, SI            ; CX = b1
  115.              MOV     DI, BX            ; FPA = SI:DI:BX
  116.              MOV     BX, BP            ;
  117. $sqr_end:    ADC     DI, DX            ;  to   SI:DI:BX
  118.              ADC     SI, 0             ;   FPA
  119.              MUL     CX                ; a1 * b1
  120.              ADD     AX, DI
  121.              ADC     DX, SI            ; result in DX:AX:BX
  122. $end_mantiss:POP     CX                ; CH = exponent  CL = sign
  123.              XCHG    AX, BX            ; DX:BX:AX = result
  124.              SUB     CX, 81h           ; compute new exponent-1
  125. $div_end:    OR      DX, DX            ; is mantissa normalized ?
  126.              JS      $add_sub_end      ; yes
  127.              ADD     AX, AX            ; no, shift
  128.              ADC     BX, BX            ;  FPA 1 bit
  129.              ADC     DX, DX            ;   to the left
  130.              DEC     CX                ; adjust exponent
  131. $add_sub_end:XOR     SI, SI            ; load zero
  132.              ADC     AX, 80h           ; round
  133.              ADC     BX, SI            ;  up
  134.              ADC     DX, SI            ;   mantissa
  135.              ADC     CX, SI            ; increment exponent if mantissa overfl.
  136. $round_done: POP     BP                ; restore caller's frame pointer
  137.              TEST    CH, 40H           ; test if (exponent-1) negative
  138.              JNZ     $zero_prod2       ; yes, underflow, return zero
  139.              AND     DH, 7Fh           ; force MSB of mantissa to 0
  140.              INC     CX                ; new exponent
  141.              MOV     AL, CL            ; store exponent
  142.              OR      DH, CH            ; fill in sign bit
  143.              SHR     CH, 1             ; test if exponent overflow (> FFh)
  144.              RET                       ; done
  145. $zero_prod2: XOR     AX, AX            ; load
  146.              MOV     BX, AX            ;  a
  147.              CWD                       ;   zero
  148.              RET                       ; done
  149.  
  150. RealMulFNChk2 ENDP
  151. RealMulFNoChk ENDP
  152. RealMulF     ENDP
  153.  
  154.              ALIGN   4
  155.  
  156.              ENDS
  157.  
  158.              END
  159.