home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPL60N19 / ARISOURC / F48FINT.ASM < prev    next >
Assembly Source File  |  1993-01-25  |  3KB  |  80 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 6.0        *
  5. ; *     Real Int Function                               *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1992 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   F48FINT
  12.  
  13.              INCLUDE SE.ASM
  14.  
  15.  
  16. CODE         SEGMENT BYTE PUBLIC
  17.  
  18.              ASSUME  CS:CODE
  19.  
  20. ; Publics
  21.  
  22.              PUBLIC  RInt
  23.  
  24. ;-------------------------------------------------------------------------------
  25. ; RInt represents the standard function Int. It computes the integral part of a
  26. ; TURBO-Pascal six byte floating point number, the result being a floating point
  27. ; number.
  28. ;
  29. ; INPUT:     DX:BX:AX  floating point number
  30. ;
  31. ; OUTPUT:    DX:BX:AX  integral part of floating point number
  32. ;
  33. ; DESTROYS:  AX,BX,CX,DX,SI,DI,Flags
  34. ;-------------------------------------------------------------------------------
  35.  
  36. RInt         PROC    FAR
  37.              CMP     AL, 0A8h          ; is argument > 2^39 ?
  38.              JNB     $no_change        ; yes, return number unchanged
  39.              CMP     AL, 80h           ; argument < 1 ?
  40.              JBE     $res_zero         ; yes, return zero
  41.              MOV     CX, AX            ; save
  42.              MOV     SI, BX            ;  original
  43.              MOV     DI, DX            ;   argument
  44.              CMP     AL, 88h           ; argument >= 2^7 ?
  45.              SBB     DH, DH            ; yes, DH=0 (else DH=FFh)
  46.              CMP     AL, 90h           ; argument >= 2^15 ?
  47.              SBB     DL, DL            ; yes, DL=0 (else DL=FFh)
  48.              CMP     AL, 98h           ; argument >= 2^23 ?
  49.              SBB     BH, BH            ; yes, BH=0 (else BH=FFh)
  50.              CMP     AL, 0A0h          ; argument >= 2^31 ?
  51.              SBB     BL, BL            ; yes, BL=0 (else BL=FFh)
  52.              NOT     DX                ; generate first
  53.              NOT     BX                ;  32 bits of mask
  54.              AND     AX, 7             ; clear LSB of mask, test if 1-bit shift
  55.              JZ      $shiftr_done      ; no further shifting required
  56.  
  57.              ALIGN   4
  58.  
  59. $shift_loop: ADD     AL, 0FFh          ; dec. shift counter, set carry flag
  60.              RCR     DX, 1             ; extend mask 1 bit
  61.              RCR     BX, 1             ;  to the
  62.              RCR     AH, 1             ;   right
  63.              JNZ     $shift_loop       ; shift until counter zero
  64. $shiftr_done:AND     DX, DI            ; mask out mantissa
  65.              AND     BX, SI            ;  bits containing
  66.              AND     CH, AH            ;   integral part of number
  67.              XCHG    AX, CX            ; get back exponent
  68.              RET                       ; done
  69. $res_zero:   XOR     AX, AX            ; load
  70.              MOV     BX, AX            ;   a
  71.              CWD                       ;    zero
  72. $no_change:  RET                       ; exit
  73. RInt         ENDP
  74.  
  75.              ALIGN   4
  76.  
  77. CODE         ENDS
  78.  
  79.              END
  80.