home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPL60N19 / ARISOURC / FP48RND.ASM < prev    next >
Assembly Source File  |  1993-01-25  |  9KB  |  187 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 6.0        *
  5. ; *     Real Round/Trunc                                *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1992 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   FP48RND
  12.  
  13.              INCLUDE SE.ASM
  14.  
  15.  
  16. CODE         SEGMENT BYTE PUBLIC
  17.  
  18.              ASSUME  CS:CODE
  19.  
  20. ; Externals
  21.              EXTRN   HaltError:NEAR
  22.  
  23. ; Publics
  24.  
  25.              PUBLIC  RealTrunc,RTrunc,RRound
  26.  
  27. ;-------------------------------------------------------------------------------
  28. ; RealTrunc converts a TURBO-Pascal six byte floatingpoint number to a four
  29. ; byte signed integer. Truncation or rounding can be requested by the caller
  30. ; by setting a flag. If the conversion results in a long integer overflow, the
  31. ; routine returns with the carry flag set. When rounding is selected, the
  32. ; routine complies with the IEEE "round to nearest or even" mode. For example,
  33. ; Round (4.5) = 4, but Round (5.5) = 6. Special care is taken to accomodate
  34. ; correct handling of the smallest LONGINT number 8000000h.
  35. ;
  36. ; INPUT:     DX:BX:AX  floating point number
  37. ;            CH        rounding flag ( 0 = trunc, all others = round)
  38. ;
  39. ; OUTPUT:    DX:AX     converted longint number
  40. ;            CF        set if overflow occured
  41. ;
  42. ; DESTROYS:  AX,BX,CX,DX,Flags
  43. ;-------------------------------------------------------------------------------
  44.  
  45. $long_zero:  XOR     AX, AX            ; load
  46.              CWD                       ;  zero into DX:AX
  47.              RETN                      ; exit
  48. $too_big:    JNZ     $ovrfl_err2       ; abs (number) > 2^32
  49.              CMP     DH, 80h           ; num negative && abs (num) < 2^32-2^24 ?
  50.              JNE     $ovrfl_err2       ; no, overflow
  51.              XOR     AL, AL            ; clear sticky flag
  52.              PUSH    DX                ; save original sign
  53.              OR      DH, 80h           ; set hidden bit
  54.              JMP     $shft_done        ; too big numbers caught by 2nd check
  55. $ovrfl_err2: IFDEF   NOOVERFLOW
  56.              MOV     CH, DH            ; get sign
  57.              ENDIF
  58.              STC                       ; signal error
  59.              RETN                      ; exit
  60.  
  61.              ALIGN   4
  62.  
  63. RealTrunc    PROC    NEAR
  64.              ADD     AL, 60h           ; number to big ?
  65.              JC      $too_big          ; probably, do detailed check
  66.              CMP     AL, 0E0h          ; number < 0.5 ?
  67.              JB      $long_zero        ; return zero
  68. $size_ok:    PUSH    DX                ; save sign
  69.              OR      DH, 80h           ; set implicit mantissa bit
  70.              MOV     CL, AL            ; counter
  71.              XOR     AL, AL            ; initialize sticky flag
  72.              CMP     CL, -16           ; 16-bit shift possible ?
  73.              JA      $byte_shift       ; no, try 8-bit shift
  74.              OR      AL, AH            ; accumulate
  75.              OR      AL, BL            ;  sticky flag
  76.              MOV     AH, BH            ; shift DX:BX:AH
  77.              MOV     BX, DX            ;  16 bits to
  78.              XOR     DX, DX            ;   the right
  79.              ADD     CL, 16            ; remaining bit shifts
  80.              JZ      $shft_done        ; no shifts left, ->
  81. $byte_shift: CMP     CL, -8            ; 8-bit shift possible ?
  82.              JA      $4bit_shift       ; no, try nibble shift
  83.              OR      AL, AH            ; accumulate sticky flag
  84.              MOV     AH, BL            ; shift
  85.              MOV     BL, BH            ;  DX:BX:AH
  86.              MOV     BH, DL            ;   8 bits
  87.              MOV     DL, DH            ;    to the
  88.              XOR     DH, DH            ;     right
  89.              ADD     CL, 8             ; remaining bit shifts
  90.              JZ      $shft_done        ; no bit shifts left
  91. $4bit_shift: NEG     AL                ; sticky flag <> 0 ?
  92.              SBB     AL, AL            ; set to FFh if not 0
  93.              CMP     CL, -4            ; nibble shift possible ?
  94.              JA      $bit_shift        ; no, try single bit shifts
  95.              SHR     DX, 1             ; shift DX:BX:AH
  96.              RCR     BX, 1             ;  1 bit to
  97.              RCR     AX, 1             ;   the right and accumulate sticky flag
  98.              SHR     DX, 1             ; shift DX:BX:AH
  99.              RCR     BX, 1             ;  1 bit to
  100.              RCR     AX, 1             ;   the right and accumulate sticky flag
  101.              SHR     DX, 1             ; shift DX:BX:AH
  102.              RCR     BX, 1             ;  1 bit to
  103.              RCR     AX, 1             ;   the right and accumulate sticky flag
  104.              SHR     DX, 1             ; shift DX:BX:AH
  105.              RCR     BX, 1             ;  1 bit to
  106.              RCR     AX, 1             ;   the right and accumulate sticky flag
  107.              ADD     CL, 4             ; remaining bit shifts
  108.              JZ      $shft_done        ; no shifts left
  109. $bit_shift:  NEG     AL                ; sticky flag <> 0 ?
  110.              SBB     AL, AL            ; set to FFh if not 0
  111.  
  112.              ALIGN   4
  113.  
  114. $shift_loop: SHR     DX, 1             ; shift DX:BX:AH
  115.              RCR     BX, 1             ;  1 bit to
  116.              RCR     AX, 1             ;   the right and accumulate sticky flag
  117.              INC     CL                ; adjust shift counter
  118.              JNZ     $shift_loop       ; until counter zero
  119. $shft_done:  NEG     CH                ; test if rounding flag set
  120.              SBB     CH, CH            ; CH = FFh if rounding, CH = 0 if trunc
  121.              AND     AH, CH            ; clear fraction part if trunc
  122.              ADD     AX, 8000h         ; round up ? AH = guard, AL = sticky
  123.              JNZ     $round            ; if no tie case (AH = 80, AL = 0)
  124.              ROR     BL, 1             ; move least significant
  125.              ROL     BL, 1             ;  bit into carry
  126. $round:      POP     CX                ; get original sign flag
  127.              ADC     BX, 0             ; round up
  128.              ADC     DX, 0             ;  result if carry set
  129.              XCHG    AX, BX            ; result in DX:AX
  130.              OR      CH, CH            ; original argument negative ?
  131.              JNS     $pos_long         ; no, was positive
  132.              NOT     DX                ; negate
  133.              NEG     AX                ;  longint
  134.              SBB     DX, -1            ;   in DX:AX
  135.              JNC     $rnd_done         ; DX:AX = 0, no need to check for ovrfl.
  136. $pos_long:   IFDEF   NOOVERFLOW
  137.              MOV     BH, CH            ; save original sign flag
  138.              ENDIF
  139.              XOR     CH, DH            ; XOR sign of argument and sign of result
  140.              ADD     CH, CH            ; CY, if signs differ (= overflow)
  141. $rnd_done:   IFDEF   NOOVERFLOW
  142.              MOV     CH, BH            ; restore original sign flag
  143.              ENDIF
  144.              RET                       ; done
  145.  
  146. RealTrunc    ENDP
  147.  
  148.              ALIGN   4
  149.  
  150. RTrunc       PROC    FAR
  151.              XOR     CH, CH            ; flag truncation
  152.              CALL    RealTrunc         ; convert real to longint
  153.              JC      RRangeError       ; longint overflowed
  154.              RET                       ; done
  155. RTrunc       ENDP
  156.  
  157.              ALIGN   4
  158.  
  159. RRound       PROC    FAR
  160.              MOV     CH, 1             ; flag rounding
  161.              CALL    RealTrunc         ; convert real to longint
  162.              JC      RRangeError       ; longint overflowed
  163.              RET                       ; done
  164. RRound       ENDP
  165.  
  166.              IFDEF   NOOVERFLOW
  167.  
  168. RRangeError: MOV     DX, 07FFFh        ; load biggest positive
  169.              MOV     AX, 0FFFFh        ;  LONGINT number
  170.              ADD     CH, CH            ; check if negative (CY=1)
  171.              ADC     AX, 0             ; load biggest negative
  172.              ADC     DX, 0             ;  LONGINT number, if negative
  173.              RETF
  174.  
  175.              ELSE
  176.  
  177. RRangeError: MOV     AX, 0CFh          ; error code 207 (invalid fp operation)
  178.              JMP     HaltError         ; execute error handler
  179.  
  180.              ENDIF
  181.  
  182.              ALIGN   4
  183.  
  184. CODE         ENDS
  185.  
  186.              END
  187.