;       SCCSID = @(#)lipsq.asm	6.1 92/01/29
title   lipsq.asm
page    55,132
;***************************************************************************
;
;                       L I P S Q . 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 THE LOADING OF THE CONSTANTS:
;                ONE, LOG BASE 2 OF TEN, LOG BASE 2 OF E, PI,
;                LOG BASE 10 OF 2, LOG BASE E OF 2, AND ZERO.
;               IMPLEMENTS THE 80387 SQUARE ROOT INSTRUCTION.
;               IMPLEMENTS THE 80387 INTEGER PART INSTRUCTION.
;
;       PUBLIC PROCEDURES:
;               LOAD_CON                SQRT                    INTPT
;
;*****************************************************************************
;
;...DECEMBER 14, 1986...
; 12-16-91  mth  removed USE16 stuff
;-----------------------------------

                NAME    A?MLI
                .386P
                .XLIST
                INCLUDE E80387.INC
                include  icmacros.inc
                .LIST

;...DECLARE STATUS REGISTER SEGMENT...
;
EMULATOR_DATA   segment dword public 'FAR_DATA'
        EXTRN   SR_MASKS:BYTE, SR_ERRORS:BYTE, SR_FLAGS:BYTE

EMULATOR_DATA    ends

createSeg EMULATOR_CODE, A?MED, dword, public, CODE, FLAT
defgrp FLAT, <A?MED>

                ASSUME DS:EMULATOR_DATA

EMULATOR_CODE    SEGMENT dword  public  'CODE'
                ASSUME CS:FLAT

;
        EXTRN   PUT_SI_RESULT:NEAR,  STICKY_RIGHT_SHIFT:NEAR,  ROUND:NEAR
        EXTRN   ADDITION_NORMALIZE:NEAR,  LEFT_SHIFT:NEAR,  GETX:NEAR
        EXTRN   SET_UP_INDEFINITE:NEAR,  CLEAR_6W:NEAR,  SET_6W:NEAR
        EXTRN   TEST_4W:NEAR,  LEFT_SHIFT_RESULT_CL:NEAR
        EXTRN   LEFT_SHIFT_FRAC1_CL:NEAR,  LEFT_SHIFT_FRAC2_CL:NEAR
        EXTRN   ADD_TO_FRAC_2:NEAR,  GRADUAL_UNDERFLOW:NEAR
        EXTRN   SUBTRACTION_NORMALIZE:NEAR,  PUT_INDEFINITE:NEAR
        EXTRN   I_MASKED?:NEAR,  SET_I_MASKED?:NEAR,  SET_D_MASKED?:NEAR
        EXTRN   NORM_DENORM:NEAR,  GET_PRECISION:NEAR
        EXTRN   SET_STK_U_ERROR:NEAR,  PUT_OP1_RESULT:NEAR
;
        PUBLIC  LOAD_CON,  INTPT,  SQRT

;
;       67 BIT TEMP REAL FLOATING POINT NUMBERS FOR PUSH CONSTANT INSTRUCTIONS
;
TREAL_TABLE:
        DW      00000H,00000H,00000H,00000H,08000H,03FFFH       ;TREAL_ONE
        DW      04000H,08AFEH,0CD1BH,0784BH,0D49AH,04000H       ;TREAL_L2T
        DW      0C000H,0F0BBH,05C17H,03B29H,0B8AAH,03FFFH       ;TREAL_L2E
        DW      0C000H,0C234H,02168H,0DAA2H,0C90FH,04000H       ;TREAL_PI
        DW      0A000H,0F798H,0FBCFH,09A84H,09A20H,03FFDH       ;TREAL_LG2
        DW      0E000H,079ABH,0D1CFH,017F7H,0B172H,03FFEH       ;TREAL_LN2
        DW      00000H,00000H,00000H,00000H,00000H,00000H       ;TREAL_0
PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       LOAD_CON
;                       """"""
;       FUNCTION:
;               IMPLEMENTS THE LOAD CONSTANTS INSTRUCTIONS.
;
;       INPUTS:
;               OFFSET OF FPN POINTER IN BX REGISTER.
;
;       OUTPUTS:
;               CONSTANT VALUE ON TOP OF STACK
;
;       DATA ACCESSED:
;               - OFFSET_RESULT
;
;       DATA CHANGED:
;               - MEM_OPERAND_POINTER
;
;       PROCEDURES CALLED:
;               GETX
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;  ALL LOAD CONSTANT INSTRUCTIONS USE THE SAME ENTRY POINT.
;
LOAD_CON        PROC    NEAR
;
;   THE CONTENTS OF BX IS USED AS AN INDEX TO TREAL_TABLE.
;   GETX UNPACKS THE EXTENDED FLOATING POINT NUMBER AND PUT_RESULT
;   PUSHES THE VALUE TO THE TOP OF THE 80387 STACK.
;
        SHR    BL,1                     ; TAKE CARE OF EXTRA SHI
        MOV    EAX,06H                  ; TREAL_TABLE PTR = CS:
        MUL    BL                       ; INDEX * 6 - (6 * 2)

        ADD    EAX,A?MEDOFFSET TREAL_TABLE - LOAD_1_OP * 12  ; * (LOAD_1_OP)
        MOV    ESI,EAX                  ; STORE TREAL PTR

        MOV    DWORD PTR [EBP].RESULT_DWORD_FRAC,0
        MOV    AX,WORD PTR CS:[ESI]
        MOV    WORD PTR [EBP].RESULT_DWORD_FRAC + FRAC80,AX
        MOV    EAX,DWORD PTR CS:[ESI] + 2
        MOV    DWORD PTR [EBP].RESULT_DWORD_FRAC + FRAC64,EAX
        MOV    EAX,DWORD PTR CS:[ESI] + 6
        MOV    DWORD PTR [EBP].RESULT_DWORD_FRAC + FRAC32,EAX
        MOVZX  EAX,WORD PTR CS:[ESI] + 10
        MOV    DWORD_RESULT_EXPON,EAX
        XOR    EAX,EAX                  ; NOT SECOND ROUNDING
        MOV    DWORD PTR [EBP].RESULT_SIGN,EAX
        MOV    DL,PREC64
        MOV    EDI,OFFSET_RESULT
        CALL   ROUND
        MOV    EDI,OFFSET_RESULT
        CALL   ADDITION_NORMALIZE     ; (POSSIBLE RENORMALIZE)
        AND    SR_FLAGS,NOT A_MASK
        XOR    EAX,EAX
        MOV    [EBP].BEFORE_ERROR_SIGNALS, EAX
        LAHF
        MOV    EDI,OFFSET_RESULT
        JMP    PUT_SI_RESULT

LOAD_CON        ENDP

PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       INTPT:
;                       """""
;       FUNCTION:
;               IMPLEMENTS 80387 INTEGER PART INSTRUCTION
;
;       INPUTS:
;
;       OUTPUTS:
;
;       DATA ACCESSED:
;               - OFFSET_RESULT         OFFSET_OPERAND1
;               - TAG1                  EXPON1
;               - WORD_FRAC1
;
;       DATA CHANGED:
;               - TAG1                  EXPON1
;               - RESULT
;
;       PROCEDURES CALLED:
;               GRADUAL_UNDERFLOW       TEST_4W
;               ROUND                   SUBTRACTION_NORMALIZE
;               PUT_OP1_RESULT
;
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
INTPT           PROC

;  MOV    AH, TRUE            ; load constant

        JZ     SEPARATE_CASES           ; BRANCH IF NO STACK ERROR

        CALL   SET_STK_U_ERROR
        TEST   SR_MASKS,INVALID_MASK
        JZ     INTPT_DONE

        JMP    PUT_OP1_RESULT           ; MASKED STACK ERROR, SO RETURN INDEF

SEPARATE_CASES:

        AND    SR_FLAGS, NOT A_MASK     ; INITIALIZE A-BIT TO 0
        MOV    AL,[EBP].TAG1            ; load op1 tag
        CMP    AL,VALID
        JE     VALID_CASE

        CMP    AL,DENORMD
        JE     DENORMALIZED_OPERAND

        CMP    AL,UNSUPP
        JNE    CHECK_NAN

        MOV    EDI,OFFSET_OPERAND1
        CALL   SET_UP_INDEFINITE

SET_I_ERR:

        OR     SR_ERRORS,INVALID_MASK
        TEST   SR_MASKS, INVALID_MASK
        JZ     INTPT_DONE

        JMP    PUT_OP1_RESULT           ; MASKED I-ERROR, SO RETURN INDEF

INTPT_DONE:
        RET

CHECK_NAN:
        CMP    AL,INV
        JE     KIND_OF_NAN?

        JMP    PUT_OP1_RESULT           ; INFINITY OR 0, SAME ANSWER

KIND_OF_NAN?:
        TEST   MSB_FRAC1,40H
        JZ     MAKE_QNAN

        JMP    PUT_OP1_RESULT           ; OP1 IS A  QNAN, SO PASS IT THROUGH

MAKE_QNAN:
        OR     MSB_FRAC1,40H            ; OP1 IS AN SNAN, SO MAKE IT A QNAN,
        JMP    SHORT SET_I_ERR          ; AND SIGNAL I_ERROR.

DENORMALIZED_OPERAND:
        OR     SR_ERRORS,DENORM_MASK
        TEST   SR_MASKS, DENORM_MASK
        JZ     INTPT_DONE

        MOV    [EBP].EXPON1,0001H       ; IF MASKED D-ERROR, MAKE VALID
        MOV    [EBP].TAG1,VALID

VALID_CASE:
        MOV    EAX,403EH
        CMP    DWORD_EXPON1,EAX         ; IF EXPON >= 63, THEN NUMBER
        JGE    GIVE_OP1                 ; IS ALREADY AN INTEGER

        MOV    EDI,OFFSET_OPERAND1      ; GRADUAL UFLOW UNTIL EXPON=63
        PUSH   EDI
        CALL   GRADUAL_UNDERFLOW
        POP    EDI                      ; ROUND TO PRECISION 64
        MOV    DL,PREC64
        MOV    AL,FALSE
        CALL   ROUND
        CMP    RND1_INEXACT,TRUE
        JNE    DETECT_ZERO

        OR     SR_ERRORS,INEXACT_MASK
        CMP    ADDED_ONE,TRUE
        JNE    DETECT_ZERO

        OR     SR_FLAGS,A_MASK

DETECT_ZERO:

        XOR    EAX,EAX
        MOV    EDI,OFFSET DWORD_FRAC1 + 4 ; IF FRACTION = 0, RESULT = 0
        CALL   TEST_4W
        JZ     ZERO_RESULT

        MOV    EDI,OFFSET_OPERAND1      ; NORMALIZE
        CALL   SUBTRACTION_NORMALIZE
        JMP    PUT_OP1_RESULT

ZERO_RESULT:
        MOV    DWORD_EXPON1,EAX         ;SET RESULT TO TRUE ZERO
        MOV    [EBP].TAG1,SPECIAL

GIVE_OP1:

        JMP    PUT_OP1_RESULT

INTPT           ENDP

PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       SQRTX:
;
;       FUNCTION:
;                FRACTIONAL SQUARE ROOT ROUTINE.
;
;       INPUTS:
;               ASSUMES VALID, NON-ZERO,POSITIVE, NORMALIZED
;               FRACTION IS IN FRAC1.
;
;       OUTPUTS
;               LEAVES FRACTIONAL SQUARE ROOT IN RESULT.
;
;       DATA ACCESSED:
;               - OFFSET_OPERAND1               LSB_FRAC1
;               - OFFSET_OPERAND2               WORD_FRAC2
;               - OFFSET_RESULT                 LSB_FRAC2
;               - RESULT_WORD_FRAC              LSB_RESULT
;               - MSB_FRAC1
;
;       DATA CHANGED:
;               - WORD_FRAC2                    LSB_FRAC2
;               - RESULT_WORD_FRAC              LSB_RESULT
;
;       PROCEDURES CALLED:
;               LEFT_SHIFT_RESULT_CL            LEFT_SHIFT_FRAC1_CL
;               LEFT_SHIFT_FRAC2_CL             CLEAR_6W
;               SET_6W                          ADD_TO_FRAC_2
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
SQRTX           PROC

        MOV    EDI,OFFSET RESULT_DWORD_FRAC     ; DURING THIS COMPUTATION,
        CALL   CLEAR_6W                         ; THE LSB OF THE RESULT WILL
        MOV    EDI,OFFSET DWORD_FRAC2           ; HOLD G AND S, AND THE MSB
        CALL   SET_6W                           ; WILL HOLD CARRY-OUT BITS
        AND    ECX,000000FFH                    ; CLEAR 3 HIGH BYTES OF ECX
        STC                                     ; CF HOLDS THE QUOTIENT BIT
        PUSH   65                               ; ITERATE 65 TIMES
        PUSHFD                                  ; STACK THE QUOTIENT BIT
        JMP    SHORT ENTER_SQRT_LOOP

SQRT_LOOP:
        PUSH   ECX
        PUSHFD                                  ; STACK THE Q_BIT (IN CF)
        MOV    CL, 1
        CALL   LEFT_SHIFT_RESULT_CL             ; SHIFT RESULT LEFT ONE BIT
        POPFD                                   ; INJECT THE NEW Q_BIT INTO
        PUSHFD                                  ; THE LEAST SIGNIFICANT BYTE
        ADC    CL,CL                            ; CL IS 0 AFTER LEFT_SHIFT
        OR     BYTE PTR LSB_RESULT + 1,CL       ; Q_BIT IS CL'S BIT B0
        MOV    CL,2                             ; INTO THE LSB
        CALL   LEFT_SHIFT_FRAC2_CL              ; SHIFT FRAC2 LEFT 2 BITS
ENTER_SQRT_LOOP:
        MOV    AL,MSB_FRAC1                     ; G AND S BITS OF FRAC2 <--
        AND    AL,0C0H                          ; TOP 2 BITS OF FRAC1
        MOV    LSB_FRAC2,AL
        MOV    CL,2                             ; SHIFT FRAC1 LEFT 2
        CALL   LEFT_SHIFT_FRAC1_CL
        MOV    AL,0C0H
        MOV    AH,LSB_RESULT + 1
        POPFD                                   ; TEST Q_BIT
        JC     Q_BIT_SET

        SHL    EAX,16                           ; TAKE CARE OF EXTRA LOW WORD
        CALL   ADD_TO_FRAC2                     ; FRAC2.GS <-- FRAC2.GS +
        JMP    SHORT SET_Q_BIT                  ; RESULT.11

Q_BIT_SET:
        NOT    AH                               ; AH <-- NOT(LSB_RESULT + 1)
        SHL    EAX,16                           ; TAKE CARE OF EXTRA LOW WORD
        ADD    [EBP].DWORD_FRAC2,  EAX          ; FRAC2.GS  <--   FRAC2.GS
        MOV    EAX,[EBP].RESULT_DWORD_FRAC + FRAC64     ; + NOT(RESULT).11
        NOT    EAX
        ADC    [EBP].DWORD_FRAC2 + FRAC64, EAX
        MOV    EAX,[EBP].RESULT_DWORD_FRAC + FRAC32
        NOT    EAX
        ADC    [EBP].DWORD_FRAC2 +FRAC32,EAX

SET_Q_BIT:
        POP    ECX                              ; RELOAD LOOP COUNT
        LOOP   SQRT_LOOP                        ; LOOP UNTIL DONE
        RCR    CL,1                             ; SET G BIT OF RESULT TO Q_BIT
        OR     LSB_RESULT, CL
        MOV    AX,RESULT_WORD_FRAC              ; FRAC2 <- FRAC2 +
        INC    AH                               ; RESULT + 1
        SHL    EAX,16
        CALL   ADD_TO_FRAC2
        MOV    EDI,OFFSET DWORD_FRAC2 + FRAC64  ; IF FRAC2 = 0 THEN
        XOR    EAX,EAX                          ; S_BIT OF RESULT = 0,
        CALL   TEST_4W                          ; OTHERWISE 1.
        OR     AL,LSB_FRAC2 + 1
        JZ     LEFT_ADJUST_RESULT

        OR     LSB_RESULT, 40H

LEFT_ADJUST_RESULT:

        MOV    CL,8                             ; SHIFT RESULT LEFT 8 BITS
        JMP    LEFT_SHIFT_RESULT_CL             ; TO ELIMINATE CARRY

ADD_TO_FRAC2:

        MOV    ESI,OFFSET RESULT_DWORD_FRAC     ; ESI POINTS TO THE ADDEND
        MOV    EDI,OFFSET DWORD_FRAC2           ; EDI POINTS TO THE RESULT

        JMP    ADD_TO_FRAC_2                    ; ADD RESULT FRAC TO FRAC2

SQRTX           ENDP

PAGE
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;                       SQRT:
;
;       FUNCTION:
;               IMPLEMENTS THE 80387 SQRT INSTRUCTION
;
;       INPUTS:
;               ASSUME OP1 IS SET UP
;
;       OUTPUTS:
;               RESULT
;
;       DATA ACCESSED:
;               - RESULT_RECORD_OFFSET          RESULT_EXPON
;               - OFFSET_OPERAND1               TAG1
;               - SIGN1                         EXPON1
;               - MSB_FRAC1                     OFFSET_OPERAND1
;               - OFFSET_RESULT                 RESULT_SIGN
;               - RESULT_TAG
;
;       DATA CHANGED:
;               - EXPON1                        RESULT_SIGN
;               - RESULT_TAG                    RESULT_EXPON
;
;       PROCEDURES CALLED:
;               SET_UP_INDEFINITE               STICKY_RIGHT_SHIFT
;               SQRTX                           ROUND
;               ADDITION_NORMALIZE              AFFINE_INFINITY?
;               SET_I_MASKED?                   GET_PRECISION
;               SET_D_MASKED?                   PUT_SI_RESULT
;
;"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
SQRT            PROC

        JZ     SQRT_CONT                ; IF STACK ERROR, SQRT DONE

        CALL   SET_STK_U_ERROR
        TEST   SR_MASKS,INVALID_MASK
        JNZ    PUT_OP1                  ; MASKED STACK ERROR, SO RETURN INDEF

SQRT_DONE:
        RET

SQRT_CONT:
        AND    SR_FLAGS,NOT A_MASK
        MOV    AL,[EBP].TAG1            ; LOAD TAG FOR OP1
        CMP    AL,VALID
        JNE    OP1_DENORM?

        CMP    [EBP].SIGN1,POSITIVE     ; I_ERROR IF NEGATIVE
        JNE    I_ERROR

        JMP    SHORT   SQRT_VALID_CASE

OP1_DENORM?:
        CMP    AL,DENORMD               ; IF OP1 DENORMALIZED,
        JNE    OP1_ZERO?

        CMP    [EBP].SIGN1,POSITIVE     ; I_ERROR IF NEGATIVE
        JNE    I_ERROR

        JMP    SHORT   D_ERROR          ; THEN SIGNAL D_ERROR

OP1_ZERO?:
        CMP    AL,SPECIAL               ; IF OP1 = 0,
        JE     PUT_OP1                  ; THEN GIVE 0 AS THE RESULT

        CMP    AL,UNSUPP
        JE     I_ERROR

        CMP    AL,INV                   ; IF OP1 NAN, FIND WHAT KIND
        JNE    INF_OP1

        JMP    KIND_OF_NAN?

INF_OP1:
        CMP    [EBP].SIGN1,POSITIVE     ; INFINITY CASE
        JE     PUT_OP1                  ; -INFINITY IS INVALID

I_ERROR:
        CALL   SET_I_MASKED?            ; FOR UNSUPPORTED OR NEGATIVE,
        JZ     SQRT_DONE                ; NON-ZERO OPERANDS

        MOV    EDI,OFFSET_RESULT
        CALL   SET_UP_INDEFINITE        ; IF MASKED I_ERROR, THEN GIVE
        JMP    SQRT_GIVE_RESULT         ; INDEFINITE

PUT_OP1:                                ; IF OP1 = +/- ZERO, INDEF, OR
        JMP    GIVE_OP1                 ; +INF, THEN OP1 IS THE RESULT

D_ERROR:
        CALL   SET_D_MASKED?            ; OP1 IS DENORMAL OR PSEUDO-DENORMAL
        JZ     SQRT_DONE

        MOV    EDI,  OFFSET_OPERAND1
        CALL   NORM_DENORM              ; IF D_ERROR MASKED, MAKE VALID

SQRT_VALID_CASE:

        SUB    DWORD_EXPON1,EXPONENT_BIAS
        TEST   DWORD_EXPON1,0001H
        JZ     EVEN_EXPON

        DEC    DWORD_EXPON1             ; IF EXPON1 ODD, THEN EXPON1 <--
        JMP    SHORT HALVE_EXPONENT     ; EXPON1 - 1

EVEN_EXPON:
        MOV    CL,1                     ; IF EXPON1 EVEN, THEN SHIFT
        XOR    AL,AL                    ; DWORD_FRAC1 RIGHT ONE BIT
        MOV    EDI,OFFSET_OPERAND1
        CALL   STICKY_RIGHT_SHIFT

HALVE_EXPONENT:

        MOV    EAX,DWORD_EXPON1
        SAR    EAX,1
        ADD    EAX,EXPONENT_BIAS
        MOV    DWORD_RESULT_EXPON, EAX
        CALL   SQRTX                    ; CALCULATE FRACTION

SQRT_ROUND_RESULT:

        XOR    EAX,EAX                  ; NOT SECOND ROUNDING
        MOV    DWORD PTR [EBP].RESULT_SIGN,EAX  ; SET SIGN AND TAG
        MOV    EDI,OFFSET_RESULT        ; ROUND RESULT
        CALL   GET_PRECISION
        CALL   ROUND
        MOV    EDI,OFFSET_RESULT
        CALL   ADDITION_NORMALIZE       ; (POSSIBLE RENORMALIZE)
        CMP    RND1_INEXACT,TRUE
        JNE    SQRT_GIVE_RESULT

        OR     SR_ERRORS,INEXACT_MASK
        CMP    ADDED_ONE,TRUE
        JNE    SQRT_GIVE_RESULT

        OR     SR_FLAGS,A_MASK

SQRT_GIVE_RESULT:

        MOV    EDI,OFFSET_RESULT

        JMP    PUT_SI_RESULT

SQRT    ENDP
;
;
EMULATOR_CODE ends
        END
