;       SCCSID = @(#)remsc.asm	6.1 92/01/29
title   remsc.asm
page    55,132
;*********************************************************************
;
;                       R E M S C . M O D
;                       =================
;
;       ===============================================================
;               INTEL CORPORATION PROPRIETARY INFORMATION
;    This software  is  supplied  under  the  terms  of  a  license
;    agreement  or non-disclosure agreement  with Intel Corporation
;    and  may not be copied nor disclosed except in accordance with
;    the terms of that agreement.
;       ===============================================================
;
;       FUNCTIONS:
;               IMPLEMENTS 80387 FPREM  INSTRUCTION.
;               IMPLEMENTS 80387 FPREM1 INSTRUCTION.
;               IMPLEMENTS 80387 FSCALE INSTRUCTION.
;
;       PUBLIC PROCEDURES:
;               REMR                    SCALE
;               ADD_TO_FRAC             ADD_TO_FRAC_2
;
;       INTERNAL PROCEDURES:
;               REMRX
;
;*************************************************************************
;
;...JANUARY 21, 1987...
;
; 12-16-91 mth  erased USE16 if def's
;-------------------------------------------------------------------------

;
                NAME    A?MRE
                .386P
                .XLIST
                INCLUDE E80387.INC
                .LIST

EMULATOR_DATA   segment dword public 'FAR_DATA'
        EXTRN   SR_MASKS:BYTE,SR_FLAGS:BYTE,SR_ERRORS:BYTE,SR_CONTROLS:BYTE
EMULATOR_DATA    ends
                ASSUME DS:EMULATOR_DATA

EMULATOR_CODE    SEGMENT dword  public  'CODE'
                ASSUME CS:FLAT

;
        EXTRN   PUT_RESULT:NEAR, SET_UP_INDEFINITE:NEAR, TEST_4W:NEAR
        EXTRN   SUBTRACTION_NORMALIZE:NEAR, MOVE_OP_TO_RESULT:NEAR
        EXTRN   UNDERFLOW_RESPONSE:NEAR, RIGHT_SHIFT_FRAC1_CL:NEAR
        EXTRN   RIGHT_SHIFT_FRAC2_CL:NEAR, LEFT_SHIFT_FRAC1_1:NEAR
        EXTRN   FIX32:NEAR, OVERFLOW_RESPONSE:NEAR, SET_STK_U_ERROR:NEAR
        EXTRN   SUBADD:NEAR, PUT_ARITH_RESULT:NEAR, SET_UP_NAN_RETURN:NEAR
        EXTRN   TEST_6W:NEAR, CLEAR_6W:NEAR, NORM_DENORM:NEAR
        EXTRN   LEFT_SHIFT_FRAC2_CL:NEAR
;
        PUBLIC  REMR, ADD_TO_FRAC, ADD_TO_FRAC_2, SCALE, REMRX


PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       REMRX:
;                       """"""
;       FUNCTION:
;                FRACTIONAL REMAINDER.
;
;       INPUTS:
;               ASSUMES DIVIDEND IS IN OP1, DIVISOR IS IN OP2,
;               NUMBER OF QUOTIENT BITS TO GENERATE IS IN AX,
;               AND Q IS CLEARED TO ALL ZEROES.
;
;       OUTPUTS:
;               IT RETURNS THE FRACTIONAL REMAINDER IN OP1, AND
;               THE LOW BITS OF THE QUOTIENT IN Q.
;
;       DATA ACCESSED:
;               - OFFSET_OPERAND1               OFFSET_OPERAND2
;               - OFFSET_RESULT
;
;       DATA CHANGED:
;               - FRAC1                 FRAC2
;
;       PROCEDURES CALLED:
;               RIGHT_SHIFT_FRAC1_CL    RIGHT_SHIFT_FRAC2_CL
;               LEFT_SHIFT_FRAC1_1              ADD_TO_FRAC
;
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
REMRX           PROC

        PUSH    EAX                             ; SAVE THE LOOP COUNT
        MOV     CL,1                            ; SHIFT FRAC1 RIGHT 1 BIT
        CALL    RIGHT_SHIFT_FRAC1_CL
        MOV     CL,1                            ; SHIFT FRAC2 RIGHT 1 BIT
        CALL    RIGHT_SHIFT_FRAC2_CL            ; RETURNS CF CLEAR,CH = 0
        MOV     ESI,OFFSET_OPERAND2             ; RESULT_FRAC <--  - FRAC2
        MOV     EDI,OFFSET_RESULT
        MOV     WORD PTR [EBP + ESI],0          ; CLEAR EXTRA BYTES
        MOV     ECX,03H                         ; LOAD LOOP COUNT
COMPLEMENT_FRAC2:
        MOV     EAX,0000H                       ; CLEAR AX,LEAVE CF INTACT
        SBB     EAX,[EBP + ESI]                 ; 0 - FRAC2
        MOV     [EBP + EDI],EAX                 ; STORE INTO RESULT FRAC
        INC     ESI                             ; BUMP OFFSETS
        INC     ESI                             ; (DOESN'T AFFECT CF)
        INC     ESI
        INC     ESI
        INC     EDI
        INC     EDI
        INC     EDI
        INC     EDI
        LOOP    COMPLEMENT_FRAC2                ; LOOP UNTIL RESULT = -FRAC2
        JMP     SHORT ENTER_LOOP

FORM_NEXT_FRAC1:
        PUSH    ECX                             ; STACK LOOP COUNT
        CALL    LEFT_SHIFT_FRAC1_1              ; SHIFT FRAC1 LEFT ONE BIT
        MOV     ESI,OFFSET_OPERAND2
        TEST    Q,01H                           ; IF LSB OF Q = 1 THEN
        JZ      DO_ADD                          ; FRAC1 <-- FRAC1 + FRAC2

ENTER_LOOP:
        MOV             ESI,OFFSET_RESULT       ; ELSE,FRAC1 <-- FRAC1 - FRAC2
DO_ADD:
        MOV     EDI,OFFSET_OPERAND1
        CALL    ADD_TO_FRAC             ; MOVE CARRY-OUT FROM ADD
        RCL     Q,1                     ; SHIFT CARRY-OUT INTO Q
;       ADC     HI_Q,0                  ; HI_Q COUNTS NON-0 QUOTIENT BITS
        POP     ECX                     ; ABOVE BIT B7 OF THE QUOTIENT.
        LOOP    FORM_NEXT_FRAC1         ; IF LOOPING DONE,
        TEST    Q,01H                   ; THEN ONE LAST ITERATION
        JNZ     LAST_SHIFT              ; FRAC1 <-- FRAC1 + FRAC2

        MOV     ESI,OFFSET_OPERAND2
        MOV     EDI,OFFSET_OPERAND1
        CALL    ADD_TO_FRAC

LAST_SHIFT:

        JMP     LEFT_SHIFT_FRAC1_1      ; SHIFT FRAC1 LEFT 1 BIT

REMRX           ENDP

PAGE
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       ADD_TO_FRAC:
;                       """""""""""
;       FUNCTION:
;               ADDS A 10-BYTE FRACTION TO ANOTHER 10-BYTE FRACTION.
;
;       INPUTS:
;               SS:EBP+ESI POINTS TO THE SOURCE FRACTION,AND SS:EBP+EDI POINTS
;               TO THE DESTINATION FRACTION.
;
;       OUTPUTS:
;               CARRY FLAG SET IF THERE WAS A CARRY OUT,ELSE RESET.
;
;       DATA ACCESSED:
;
;       DATA CHANGED:
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
ADD_TO_FRAC     PROC

        MOV     EAX,[EBP + ESI]
        XOR     AX,AX
ADD_TO_FRAC_2:
        ADD     [EBP + EDI],EAX
        MOV     EAX,[EBP + ESI + FRAC64]
        ADC     [EBP + EDI + FRAC64],EAX
        MOV     EAX,[EBP + ESI + FRAC32]
        ADC     [EBP + EDI + FRAC32],EAX

SIMPLE_RETURN:

        RET

ADD_TO_FRAC     ENDP

PAGE
;*******************************************************************************

MOV_ESI_EDI     PROC

        ADD     EDI,EBP         ; add global record offsets
        ADD     ESI,EBP
        PUSH    DS              ; SAVE A?MSR
        PUSH    SS              ; load source segment register
        POP     DS
        PUSH    SS              ; load destination segment register
        POP     ES              ; into ES
        MOV     ECX,3           ; move three dwords
        REP     MOVSD
        POP     DS              ; RELOAD A?MSR
        RET

MOV_ESI_EDI     ENDP

;*******************************************************************************

PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       REMR:
;                       """""
;       FUNCTION:
;               80387 REMAINDER INSTRUCTION
;
;       INPUTS:
;               ASSUMES THE OPERAND RECORDS ARE SET UP.
;
;       OUTPUTS:
;               RESULTS IN RESULT RECORD.
;
;       DATA ACCESSED:
;               - RESULT_REC_OFFSET             OFFSET_OPERAND1
;               - TAG1                          EXPON1
;               - WORD_FRAC1                    TAG2
;               - EXPON2                        MSB_FRAC2
;               - OFFSET_RESULT
;
;       DATA CHANGED:
;               - TAG1                          EXPON1
;
;       PROCEDURES CALLED:
;               SET_UP_INDEFINITE       SET_STK_U_ERROR
;               REMRX                           SUBTRACTION_NORMALIZE
;               MOVE_OP_TO_RESULT       UNDERFLOW_RESPONSE
;               PUT_RESULT                      TEST_4W
;               SUBADD                          MOV_ESI_EDI
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
REMR            PROC

        LAHF                            ; SAVE STACK EMPTY FLAG ('86 Z-FLAG)
        AND     SR_FLAGS,NOT (A_MASK + C_MASK)  ; CLEAR '87 A-FLAG,AND ALSO
                                                ; C-FLAG FOR 387 COMPATIBILITY
        MOV     EXP_TMP,0                       ; INITIALIZE Q AND HI_Q TO 0.
        SAHF                          ; RESTORE STACK EMPTY FLAG ('86 Z-FLAG)
        JZ      CATCH_SPECIAL_CASES   ; BRANCH IF NO STACK ERROR

        CALL    SET_STK_U_ERROR       ; STACK UNDERFLOW OCCURRED
        JMP     UNMASKED_I_ERROR?

CATCH_SPECIAL_CASES:
        MOV     AL,[EBP].TAG1           ; BOTH OPERANDS VALID?
        OR      AL,[EBP].TAG2
        JNZ     SPECIAL_CASES_HANDLER  ; NO,BRANCH TO HANDLER OF SPECIAL CASES

VALID_CASE:
        MOV     EAX,DWORD_EXPON1        ; EAX <- EXPON_DIFF = EXP1 - EXP2
        SUB     EAX,DWORD_EXPON2        ; IF EXPON_DIFF < ZERO,
        MOV     EDI,OFFSET_OPERAND1     ; THEN OP1 IS THE MODULUS
        JL      REM_OR_MOD?

        CMP     EAX,63                  ; IF EXPON_DIFF > 63,
        JLE     CALC_EXPONENT           ; THEN SET C-BIT FOR INCOMPLETE

        OR      SR_FLAGS,C_MASK         ; REDUCTION AND REPLACE EXPON_DIFF
        OR      EAX,32                  ; BY [(EXPON_DIFF or 32) mod 64]
        AND     EAX,63
CALC_EXPONENT:
        SUB     DWORD_EXPON1,EAX        ; EXPON1 <- REMAINDER EXPONENT
        INC     EAX                     ; NUM_QUOTIENT_BITS = EXPON_DIFF + 1
        CALL    REMRX                   ; CALCULATE REMAINDER FRACTION
        XOR     EAX,EAX                 ; DETECT ZERO RESULT
        MOV     EDI,OFFSET DWORD_FRAC1 + FRAC64
        CALL    TEST_4W
        JNZ     DO_NORMALIZE

        TEST    SR_FLAGS,C_MASK         ; WAS REDUCTION COMPLETE?
        JZ      REMR_ZERO               ; IF SO,PROCESS Q AS WELL

        MOV     Q,AL                    ; ELSE,MAKE Q 0 (VALUE OF AL)
        JMP     REMR_ZERO

DO_NORMALIZE:
        MOV     EDI,OFFSET_OPERAND1
        CALL    SUBTRACTION_NORMALIZE
;       MOV     [EBP].TAG1,VALID        ; UNNEEDED IF DENORMALS RETAGGED
REDUCTION_INCOMPLETE?:
        TEST    SR_FLAGS,C_MASK
        JZ      REM_OR_MOD?             ; REM OR MOD MATTERS ONLY IF COMPLETE

        MOV     Q,0                     ; IF INCOMPLETE,MAKE Q 0.
        JMP     CHECK_REM_UNDERFLOW     ; BRANCH TO CHECK UNMASKED UNDERFLOW

REM_OR_MOD?:
        LAHF                                    ; SAVE ZF TO INDICATE WHETHER
                                                ; OP2 NEEDS RESTORATION
        CMP     [EBP].OPERATION_TYPE,REM1_OP
        JNE     CHECK_REM_UNDERFLOW

        SAHF
        JNZ     OP2_RESTORED

        MOV     CL,1
        CALL    LEFT_SHIFT_FRAC2_CL
OP2_RESTORED:
        DEC     DWORD_EXPON2
        PUSH    DWORD PTR [EBP].SIGN1
        MOV     [EBP].SIGN2,POSITIVE
        MOV     [EBP].SIGN1,POSITIVE
        MOV     [EBP].OPERATION_TYPE,SUB_OP
        MOV     EAX,DWORD_EXPON1
        CMP     EAX,DWORD_EXPON2
        MOV     ESI,OFFSET_OPERAND1
        JLE     SAVE_SHIFTABLE_OP

        MOV     ESI,OFFSET_OPERAND2
SAVE_SHIFTABLE_OP:
        MOV     EDI,OFFSET_COP
        CALL    MOV_ESI_EDI
        CALL    SUBADD
        MOV     EDI,OFFSET_RESULT
        CALL    TEST_6W
        POP     DWORD PTR [EBP].SIGN1
        MOV     EDI,OFFSET_OPERAND1
        JNZ     CHECK_SIGN

TIEBREAKER:
        TEST    Q,1
        JZ      CHECK_REM_UNDERFLOW

        INC     Q
        NOT     [EBP].SIGN1
        JMP     SHORT CHECK_REM_UNDERFLOW

CHECK_SIGN:
        MOV     ESI,OFFSET_COP
        CMP     [EBP].RESULT_SIGN,POSITIVE
        JE      RESTORE_OP2?

        CALL    MOV_ESI_EDI
        MOV     EDI,OFFSET_OPERAND1
        JMP     SHORT CHECK_REM_UNDERFLOW

RESTORE_OP2?:
        MOV     EAX,DWORD_EXPON1
        CMP     EAX,DWORD_EXPON2
        JE      REDUCE_MODULUS

        MOV     EDI,OFFSET_OPERAND2
        CALL    MOV_ESI_EDI
REDUCE_MODULUS:
        INC     Q
        INC     DWORD_EXPON2
        MOV     AL,[EBP].SIGN1
        MOV     [EBP].SIGN2,AL
        CALL    SUBADD
        MOV     EDI,OFFSET_RESULT

CHECK_REM_UNDERFLOW:
                                        ; IF EXPON1 < 1,THEN UNDERFLOW
        CMP     DWORD PTR [EBP + EDI + EXPON],0001H
        JGE     DO_PUT_RESULT

        MOV     ESI,EDI                 ; GIVE STD UNDERFLOW RESPONSE
        CALL    MOVE_OP_TO_RESULT
        PUSH    DWORD PTR SR_MASKS
        OR      SR_CONTROLS,PREC64      ; "OR" WORKS ONLY BECAUSE PREC64
        MOV     RND1_INEXACT,FALSE      ; SETS ALL BITS IN THE PC FIELD
        CALL    UNDERFLOW_RESPONSE
        POP     DWORD PTR SR_MASKS
MOVE_RESULT_TO_RESULT:
        MOV     EDI,OFFSET_RESULT
        JMP     SHORT DO_PUT_RESULT

REMR_ZERO:
        MOV     DWORD_EXPON1,EAX                ; IF REMAINDER FRACTION = 0,
        MOV     [EBP].TAG1,SPECIAL              ; THEN SET RESULT TO 0
        CMP     [EBP].OPERATION_TYPE,REM1_OP
        JNE     PUT_OP1

        MOV     [EBP].SIGN1,POSITIVE
        TEST    SR_CONTROLS,RND_DOWN
        JZ      PUT_OP1

        TEST    SR_CONTROLS,RND_UP
        JNZ     PUT_OP1

        MOV     [EBP].SIGN1,NEGATIVE
PUT_OP1:
        MOV     EDI,OFFSET_OPERAND1
DO_PUT_RESULT:
        MOV     ESI,OFFSET_RESULT_REC
        CALL    PUT_RESULT
        AND     SR_FLAGS,NOT(ZERO_MASK + A_MASK + SIGN_MASK)
        MOV     AL,Q
        SHL     AL,6                    ; MOVE 3 LOW BITS OF Q TO
        JNC     FIX_Z_BIT               ; S,Z,AND A BITS
        OR      SR_FLAGS,SIGN_MASK
FIX_Z_BIT:
        SHL     AL,1
        JNC     FIX_A_BIT

        OR      SR_FLAGS,ZERO_MASK
FIX_A_BIT:
        SHL     AL,1
        JNC     REMR_DONE

        OR      SR_FLAGS,A_MASK
REMR_DONE:
        RET

SPECIAL_CASES_HANDLER:
        TEST    AL,10H          ; AL CONTAINS [EBP].TAG1 or [EBP].TAG2
        JZ      OP1_NAN?        ; NO BRANCH IF AT LEAST ONE OP UNSUPPORTED

INVALID_OPERAND:
        OR      SR_ERRORS,INVALID_MASK
UNMASKED_I_ERROR?:
        TEST    SR_MASKS,INVALID_MASK; IF UNMASKED,JUST EXIT
        JZ      REMR_DONE                       ; (C-BIT REMAINS CLEAR HERE,
                ; TO INDICATE COMPLETE REDUCTION.)
                ; ELSE,RETURN INDEFINITE

REMR_INDEF:
        MOV     EDI,OFFSET_OPERAND1
        CALL    SET_UP_INDEFINITE
LOAD_ESI_FOR_RESULT:
        MOV     ESI,OFFSET_RESULT_REC
        JMP     PUT_ARITH_RESULT

OP1_NAN?:                               ; HERE,NEITHER OP IS UNSUPPORTED.
        MOV     AL,[EBP].TAG2
        MOV     AH,[EBP].TAG1
        CMP     AH,INV
        JE      OP1_SNAN?

        CMP     AL,INV
        JNE     NON_NAN_SUPP_OPS

        JMP     SHORT SIGNAL_INVALID?

OP1_SNAN?:
        TEST    MSB_FRAC1,40H
        JZ      SIGNAL_FOR_SNAN

OP2_ALSO_NAN?:
        CMP     AL,INV
        JNE     JMP_SET_UP_NAN_RETURN

SIGNAL_INVALID?:
        TEST    MSB_FRAC2,40H
        JNZ     JMP_SET_UP_NAN_RETURN

SIGNAL_FOR_SNAN:
        OR      SR_ERRORS,INVALID_MASK ;SET I-ERROR FOR SIGNALING NAN OPERAND
        TEST    SR_MASKS,INVALID_MASK  ;IF UNMASKED,RETURN FORTHWITH
        JZ      REMR_DONE              ;ELSE,MASKED,SO RETURN MAX NAN.

JMP_SET_UP_NAN_RETURN:
        JMP     SET_UP_NAN_RETURN

NON_NAN_SUPP_OPS:
        CMP     [EBP].OPERATION_TYPE,SCALE_OP
        JE      SCALE_NON_NAN_SUPP_OPS

REM_NON_NAN_SUPP_OPS:
        CMP     AH,INFINTY
        JE      INVALID_OPERAND

        CMP     AL,SPECIAL
        JE      INVALID_OPERAND

        CMP     AH,DENORMD
        JNE     OP2_DENORM?

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JZ      REMR_DONE

        MOV     EDI,OFFSET_OPERAND1
        CMP     AL,INFINTY
        JNE     NORM_OP1

        TEST    MSB_FRAC1,80H
        JZ      OP1_TRUE_DENORMAL

        MOV     DWORD_EXPON1,1
        MOV     [EBP].TAG1,VALID
        JMP     LOAD_ESI_FOR_RESULT

OP1_TRUE_DENORMAL:
        TEST    SR_MASKS,UNDERFLOW_MASK
        JNZ     LOAD_ESI_FOR_RESULT
        CALL    NORM_DENORM
        ADD     DWORD_EXPON1,WRAP_AROUND_CONSTANT       ; ADD WRAP-AROUND
        OR      SR_ERRORS,UNDERFLOW_MASK
        JMP     LOAD_ESI_FOR_RESULT

NORM_OP1:
        PUSH    EAX
        CALL    NORM_DENORM
        POP     EAX
OP2_DENORM?:
        CMP     AL,DENORMD
        JNE     NON_ERROR_SPECIALS

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JZ      REMR_DONE

        MOV     EDI,OFFSET_OPERAND2
        PUSH    EAX
        CALL    NORM_DENORM
        POP     EAX
NON_ERROR_SPECIALS:
        CMP     AH,SPECIAL
        JE      PUT_OP1

OP2_INF?:
        CMP     AL,INFINTY
        JE      PUT_OP1

        JMP     VALID_CASE


SCALE_NON_NAN_SUPP_OPS:
        CMP     AH,INFINTY
        JNE     SCALER_DENORMD?

        CMP     [EBP].SIGN1,POSITIVE
        JNE     OP2_ALSO_INF?

        CMP     AL,SPECIAL
        JE      INVALID_OPERAND

        CMP     AL,DENORMD
        JNE     XFER_SIGN

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JZ      EXIT_SCALE

XFER_SIGN:
        MOV     AL,[EBP].SIGN2
        MOV     [EBP].SIGN1,AL
        MOV     EDI,OFFSET_OPERAND1
        JMP     PUT_SCALED_RESULT

OP2_ALSO_INF?:
        CMP     AL,INFINTY
        JE      INVALID_OPERAND

        CMP     AL,DENORMD
        JNE     ZERO_OP2

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JZ      EXIT_SCALE

ZERO_OP2:
        MOV     EDI,OFFSET_OPERAND2
        CALL    CLEAR_6W
        MOV     DWORD_EXPON2,EAX        ; CLEAR EAX
        MOV     [EBP].TAG2,SPECIAL
        JMP     PUT_SCALED_RESULT

SCALER_DENORMD?:
        CMP     AH,DENORMD
        JNE     SCALEND_DENORMD?

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JNZ     SCALEND_DENORMD?

EXIT_SCALE:
        RET

SCALEND_DENORMD?:
        CMP     AL,DENORMD
        JNE     GIVE_OP2

        OR      SR_ERRORS,DENORM_MASK
        TEST    SR_MASKS,DENORM_MASK
        JZ      EXIT_SCALE

        CMP     AH,VALID
        JNE     CHECK_UNFL_MASK

        MOV     EDI,OFFSET_OPERAND2
        CALL    NORM_DENORM
        JMP     VALID_SCALE_CASE

CHECK_UNFL_MASK:
        TEST    SR_MASKS,UNDERFLOW_MASK
        JNZ     GIVE_OP2

        JMP     SCALE_UNDERFLOW

REMR            ENDP
;

PAGE
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       SCALE:
;                       """"""
;       FUNCTION:
;               EMULATES THE 80387 SCALE INSTRUCTION.
;
;       INPUTS:
;               SCALE TERM (SCALER) FROM ST(1) IN OPERAND1,AND
;               SCALEND ("TO BE SCALED") FROM ST(0) IN OPERAND2
;
;       OUTPUTS:
;               SCALED OPERAND IN OPERAND2 RECORD OR RESULT_RECORD.
;               ERROR INDICATORS SET.
;
;       DATA ACCESSED:
;               - RESULT_REC_OFFSET             TAG1
;               - WORD_FRAC1                    OFFSET_OPERAND2
;               - TAG2                          EXPON2
;               - OFFSET_RESULT                 EXTRA_WORD_REG
;
;       DATA CHANGED:
;               - EXPON2
;
;       PROCEDURES CALLED:
;               SET_UP_INDEFINITE       FIX32           PUT_RESULT
;               MOVE_OP_TO_RESULT       UNDERFLOW_RESPONSE
;               OVERFLOW_RESPONSE
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
SCALE           PROC

        JZ      CATCH_SPCL_SCALE_CASES  ; BRANCH IF NO STACK ERROR

        CALL    SET_STK_U_ERROR         ; STACK UNDERFLOW OCCURRED
        JMP     UNMASKED_I_ERROR?

CATCH_SPCL_SCALE_CASES:
        AND     SR_FLAGS,NOT (A_MASK)   ; CLEAR '87 A-BIT
        MOV     AL,[EBP].TAG1           ; BOTH OPERANDS VALID?
        OR      AL,[EBP].TAG2
        JNZ     SPECIAL_CASES_HANDLER ;NO,BRANCH TO HANDLER OF SPECIAL CASES

VALID_SCALE_CASE:
        PUSH    DWORD PTR SR_MASKS      ; SAVE CURRENT ROUNDING CONTROLS
        OR      SR_CONTROLS,RND_TO_ZERO ; INSTITUTE ROUND BY CHOPPING
                                        ; THIS "OR" WORKS ONLY BECAUSE
                                        ; RND_TO_ZERO SETS ENTIRE RC FIELD
        CALL    FIX32                   ; CONVERT SCALE FACTOR TO INT32
        POP     DWORD PTR SR_MASKS      ; RESTORE RND CONTROL
        JZ      ADD_SCALE_TERM          ; IF ZF=1,NO OVERFLOW IN FIX32

        CMP     [EBP].SIGN1,POSITIVE
        JE      GET_LEAST_SF_XTRM_OVFL

        JMP     SHORT  GET_GRTST_SF_XTRM_UNFL

ADD_SCALE_TERM:
        MOV     EAX,[EBP].DWORD_FRAC1 + FRAC32  ; INT32 SCALE FACTOR
        CMP     EAX,LEAST_SF_XTRM_OVFL
        JLE     CHECK_XTRM_UNFL

GET_LEAST_SF_XTRM_OVFL:
        MOV     EAX,LEAST_SF_XTRM_OVFL
        JMP     SHORT  ADD_INT32_TO_DWORD_EXP

CHECK_XTRM_UNFL:
        CMP     EAX,GRTST_SF_XTRM_UNFL
        JGE     ADD_INT32_TO_DWORD_EXP

GET_GRTST_SF_XTRM_UNFL:
        MOV     EAX,GRTST_SF_XTRM_UNFL
ADD_INT32_TO_DWORD_EXP:
        ADD     DWORD_EXPON2,EAX        ; ADD SCALE TERM TO OP2'S EXPON
        CMP     DWORD_EXPON2,7FFEH
        JG      SCALE_OVERFLOW

        CMP     DWORD_EXPON2,1
        JL      SCALE_UNDERFLOW
GIVE_OP2:
        MOV     EDI,OFFSET_OPERAND2
PUT_SCALED_RESULT:
        MOV     ESI,OFFSET_RESULT_REC
        JMP     PUT_RESULT

SCALE_OVERFLOW:
        MOV     ESI,OFFSET_OPERAND2             ; MOVE OP2 TO RESULT
        CALL    MOVE_OP_TO_RESULT
        CALL    OVERFLOW_RESPONSE
        JMP     SHORT  SET_UP_RESULT

SCALE_UNDERFLOW:
        MOV     ESI,OFFSET_OPERAND2             ; MOVE OP2 TO RESULT
        CALL    MOVE_OP_TO_RESULT
        PUSH    DWORD PTR SR_MASKS
        OR      SR_CONTROLS,PREC64          ; "OR" WORKS ONLY BECAUSE PREC64
        MOV     RND1_INEXACT,FALSE          ; SETS ALL BITS IN THE PC FIELD
        CALL    UNDERFLOW_RESPONSE
        POP     DWORD PTR SR_MASKS
SET_UP_RESULT:
        MOV     EDI,OFFSET_RESULT

        JMP     PUT_SCALED_RESULT

SCALE           ENDP

EMULATOR_CODE ends
        END
