home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 13.ddi / RTLSYS.ZIP / F87H.ASM < prev    next >
Encoding:
Assembly Source File  |  1992-10-28  |  10.3 KB  |  565 lines
  1.  
  2. ; *******************************************************
  3. ; *                            *
  4. ; *     Turbo Pascal Run-time Library                   *
  5. ; *    8087 Support Routines                *
  6. ; *                            *
  7. ; *     Copyright (c) 1988,92 Borland International     *
  8. ; *                            *
  9. ; *******************************************************
  10.  
  11.     TITLE    F87H
  12.  
  13.     INCLUDE    SE.ASM
  14.  
  15. ; Shortcut opcodes
  16.  
  17. scSin        EQU    90ECH
  18. scCos        EQU    90EEH
  19. scTan        EQU    90F0H
  20. scArcTan    EQU    90F2H
  21. scLog        EQU    90F4H
  22. scLog2        EQU    90F6H
  23. scLog10        EQU    90F8H
  24. scExp        EQU    90FAH
  25. scExp2        EQU    90FCH
  26. scExp10        EQU    90FEH
  27.  
  28.     IF DPMIVersion
  29.     EXTRN    __AHIncr:ABS
  30.     ENDIF
  31.  
  32. DATA    SEGMENT    WORD PUBLIC
  33.  
  34. ; Externals
  35.  
  36.     EXTRN    PrefixSeg:WORD,Test8087:BYTE,SaveInt02:DWORD
  37.  
  38. ; Local workspace
  39.  
  40. CWDefault    DW    ?        ;Default control word
  41. TempWord    LABEL    WORD        ;Temporary word
  42. TempLong    DD    ?        ;Temporary longword
  43. EnvBuffer    LABEL    BYTE        ;Environment buffer
  44. CtrlWord    DW    ?        ;Saved control word
  45. StatWord    DW    ?        ;Saved status word
  46. TagWord        DW    ?        ;Saved tag word
  47. Instruction    DD    ?        ;Saved instruction pointer
  48. Operand        DD    ?        ;Saved operand pointer
  49.  
  50. DATA    ENDS
  51.  
  52. CODE    SEGMENT    BYTE PUBLIC
  53.  
  54.     ASSUME    CS:CODE,DS:DATA
  55.  
  56. ; Externals
  57.  
  58.     EXTRN    HaltTurbo:NEAR,HaltError:NEAR,Terminate:NEAR
  59.  
  60. ; Publics
  61.  
  62.     PUBLIC    FTrunc,FRound,FInt,FSqrt,FSin,FCos,FArcTan,FLn,FExp
  63.     PUBLIC    FFrac,FRealExt,FExtReal,Check8087,Init8087
  64.  
  65. ; Chop rounding control word
  66.  
  67. CWChop        DW    1F3FH
  68.  
  69. ; Floating point infinity
  70.  
  71. FConINF        DT    07FFF8000000000000000R
  72.  
  73. ; Turn off emulation for 8087 presence test
  74.  
  75.     NOEMUL
  76.  
  77. ; Check if 8087 is present
  78. ; Out    AL = 8087 flag (0/1/2/3)
  79.  
  80. Check8087:
  81.  
  82. ; Start out by scanning the environment for an 87=Y/N entry.
  83.  
  84.     MOV    BX,OFFSET TempWord    ;Point BX to TempWord
  85.     XOR    DI,DI            ;Point ES:DI to environment
  86.     MOV    ES,PrefixSeg
  87.     MOV    ES,ES:pspEnvSeg
  88.     MOV    CX,7FFFH        ;Max environment length
  89.     CLD
  90. @@1:    MOV    AX,ES:[DI].w0        ;Get first 2 chars of env string
  91.     OR    AL,AL            ;End of environment?
  92.     JE    @@3            ;Yes, @@3
  93.     CMP    AX,'78'            ;Is it '87' variable?
  94.     JNE    @@2            ;No, @@2
  95.     MOV    AX,ES:[DI].w2        ;Get next 2 chars
  96.     CMP    AL,'='            ;Is '87' followed by '='?
  97.     JNE    @@2            ;No, @@2
  98.     AND    AH,NOT ' '        ;Convert to upper case
  99.     CMP    AH,'Y'            ;Compare to 'Y'
  100.     JMP    SHORT @@4
  101. @@2:    XOR    AX,AX            ;Find next environment string
  102.     REPNE    SCASB
  103.     JE    @@1
  104.  
  105. ; There was no 87 variable in the environment. To check for 80x87
  106. ; presence, instruct the processor to store its control word in
  107. ; memory, and then check if it actually did it.
  108.  
  109. @@3:    XOR    AX,AX            ;Clear 80287 BUSY latch
  110.     OUT    0F0H,AL
  111.     FNINIT                ;Initialize 80x87
  112.     MOV    [BX],AX            ;Clear status word
  113.     FNSTCW    [BX]            ;Store status word
  114.     MOV    CX,20            ;Wait for a while
  115.     LOOP    THIS NEAR
  116.     MOV    AX,[BX]            ;Pick up saved status word
  117.     AND    AX,0F3FH        ;Mask out unwanted bits
  118.     CMP    AX,033FH        ;Compare to 80x87 default
  119.  
  120. ; The zero flag now indicates whether an 80x87 is present. If there
  121. ; is an 80x87, determine which. The 80387 defaults to affine infinity,
  122. ; whereas the 8087 and 80287 default to projective.
  123.  
  124. @@4:    MOV    DX,1330H        ;8087/80287 control word
  125.     MOV    AL,0            ;Indicate no 80x87
  126.     JNE    @@5
  127.     PUSH    SP            ;Check 8088/8086
  128.     POP    AX
  129.     CMP    AX,SP            ;Not equal on 8088/8086
  130.     MOV    AL,1            ;Indicate 8087
  131.     JNE    @@5
  132.     FINIT                ;Initialize
  133.     FLD1                ;Generate +INF
  134.     FLDZ
  135.     FDIV
  136.     FLD    ST(0)            ;Generate -INF
  137.     FCHS
  138.     FCOMPP                ;Compare infinities
  139.     FSTSW    [BX]            ;Store status
  140.     FWAIT
  141.     MOV    AX,[BX]            ;Status to flags
  142.     SAHF
  143.     MOV    AL,2            ;Indicate 80287
  144.     JE    @@5
  145.     MOV    DX,1332H        ;80387 control word
  146.     MOV    AL,3            ;Indicate 80387
  147. @@5:    MOV    Test8087,AL        ;Save 80x87 indicator
  148.     MOV    CWDefault,DX        ;Save default control word
  149.     RET
  150.  
  151. ; Turn emulation back on
  152.  
  153.     EMUL
  154.  
  155. ; Initialize 8087 emulator
  156. ; In    SI = Emulator entry offset
  157. ;    DI = Shortcut entry offset
  158.  
  159. Init8087:
  160.  
  161.     PUSH    DS
  162.     PUSH    CS
  163.     POP    DS
  164.     MOV    AX,dosSetInt*256+34H    ;Emulator interrupt handlers
  165.     MOV    CX,10
  166.     MOV    DX,SI
  167. @@1:    INT    DOS
  168.     INC    AX
  169.     LOOP    @@1
  170.     MOV    DX,DI            ;Shortcut interrupt handler
  171.     INT    DOS
  172.     MOV    DX,OFFSET Int02Handler    ;8087 interrupt handler
  173.     MOV    AL,02H
  174.     INT    DOS
  175.     MOV    DX,OFFSET Int75Handler    ;80287 interrupt handler
  176.     MOV    AL,75H
  177.     INT    DOS
  178.     POP    DS
  179.     IF DPMIVersion
  180.     MOV    AX,CS            ;Get code segment alias
  181.     ADD    AX,__AHIncr
  182.     MOV    ES,AX
  183.     MOV    AX,SaveInt02.ofs    ;Initialize INT 2 jump vector
  184.     MOV    ES:JumpInt02.ofs,AX
  185.     MOV    AX,SaveInt02.seg
  186.     MOV    ES:JumpInt02.seg,AX
  187.     ELSE
  188.     MOV    AX,SaveInt02.ofs    ;Initialize INT 2 jump vector
  189.     MOV    CS:JumpInt02.ofs,AX
  190.     MOV    AX,SaveInt02.seg
  191.     MOV    CS:JumpInt02.seg,AX
  192.     ENDIF
  193.     FINIT                ;Initialize 8087
  194.     FLDCW    CWDefault        ;Load default control word
  195.     RETF
  196.  
  197. ; Interrupt 75H handler (AT's, 80287)
  198.  
  199. Int75Handler:
  200.  
  201.     PUSH    AX
  202.     XOR    AL,AL            ;Clear BUSY latch
  203.     OUT    0F0H,AL
  204.     MOV    AL,20H            ;End-of-interrupt
  205.     OUT    0A0H,AL
  206.     OUT    20H,AL
  207.     POP    AX
  208.  
  209. ; Interrupt 02H handler (PC's, 8087)
  210.  
  211. Int02Handler:
  212.  
  213.     PUSH    AX            ;Save registers
  214.     PUSH    DS
  215.     MOV    AX,SEG DATA        ;Reset DS
  216.     MOV    DS,AX
  217.     CMP    Test8087,0        ;8087 present?
  218.     JNE    @@1            ;Yes, @@1
  219.     FSTENV    EnvBuffer        ;Store environment
  220.     JMP    SHORT @@2
  221.     NOEMUL                ;Can't emulate no-wait opcode
  222. @@1:    FNSTENV    EnvBuffer        ;No wait, store environment
  223.     FWAIT                ;Wait for it
  224.     EMUL                ;Turn emulation back on
  225. @@2:    MOV    AL,CtrlWord.b0        ;Unmasked exceptions to AL
  226.     NOT    AL
  227.     AND    AL,StatWord.b0
  228.     JS    Exception        ;IR=1 if 8087 caused interrupt
  229.     POP    DS            ;Restore registers
  230.     POP    AX
  231.  
  232. ; Jump to saved INT 2 handler
  233.  
  234.         DB    0EAH        ;JMP FAR
  235. JumpInt02    DD    ?
  236.  
  237. ; 8087 exception handler
  238.  
  239. Exception:
  240.  
  241.     STI                ;Enable interrupts
  242.     TEST    AL,3FH-mDE        ;Anything but denormal exception
  243.     JE    FixDenormal        ;is an error
  244.     FINIT                ;Initialize 8087
  245.     FLDCW    CWDefault
  246.     POP    CX            ;Remove saved registers
  247.     POP    CX
  248.     POP    CX            ;Get interrupt return address
  249.     POP    BX
  250.     CMP    Test8087,0        ;8087 present
  251.     JE    @@1            ;No, @@1
  252.     IF DPMIVersion
  253.     MOV    CX,Instruction.ofs    ;Get instruction address
  254.     MOV    BX,Instruction.seg
  255.     ELSE
  256.     MOV    DX,Instruction.ofs    ;Get normalized instruction
  257.     MOV    CL,4            ;address
  258.     SHR    DX,CL
  259.     MOV    BX,Instruction.seg
  260.     AND    BX,0F000H
  261.     ADD    BX,DX
  262.     MOV    CX,Instruction.ofs
  263.     AND    CX,0FH
  264.     ENDIF
  265. @@1:    TEST    AL,mIE            ;Convert exception mask to
  266.     JNE    @@2            ;run-time error number
  267.     MOV    DX,200
  268.     TEST    AL,mZE
  269.     JNE    @@3
  270.     MOV    DX,205
  271.     TEST    AL,mOE
  272.     JNE    @@3
  273.     MOV    DX,206
  274.     TEST    AL,mUE
  275.     JNE    @@3
  276. @@2:    MOV    DX,207
  277. @@3:    XCHG    AX,DX            ;Error code to AX
  278.     JMP    Terminate        ;Run-time error
  279.  
  280. ; Denormal exceptions never occur with the emulator
  281.  
  282.     NOEMUL
  283.  
  284. ; Retry subroutine
  285.  
  286. Retry:
  287.  
  288.     PUSH    DS            ;Save DS
  289.     LDS    BX,Operand        ;Pick up operand
  290.     WAIT
  291.  
  292. RetryOpcode     DW    9090H        ;Fxxx DS:[BX]
  293.  
  294.     POP    DS            ;Restore DS
  295.     RET
  296.  
  297. ; Fix denormal operands
  298.  
  299. FixDenormal:
  300.  
  301.     PUSH    BX            ;Save BX
  302.     IF DPMIVersion
  303.     PUSH    ES            ;Save ES
  304.     LES    BX,Instruction        ;Get instruction address
  305.     TEST    ES:[BX].b0,80H        ;Prefix?
  306.     JNE    @@0            ;No, @@0
  307.     INC    BX            ;Skip prefix byte
  308. @@0:    MOV    AX,ES:[BX]        ;Get instruction
  309.     XCHG    AL,AH            ;Bytes reversed in FSTENV image
  310.     MOV    BX,CS            ;Construct CS alias in ES
  311.     ADD    BX,__AHIncr
  312.     MOV    ES,BX
  313.     ELSE
  314.     MOV    AX,Instruction.w2    ;Pick up opcode
  315.     ENDIF
  316.     MOV    BL,AL            ;Memory operand?
  317.     AND    BL,0C0H
  318.     CMP    BL,0C0H
  319.     JE    @@1            ;No, @@1
  320.     AND    AL,38H            ;Change EA to DS:[BX]
  321.     OR    AL,7
  322. @@1:    XCHG    AL,AH            ;Swap low and high
  323.     AND    AL,7            ;Convert to ESC opcode
  324.     OR    AL,0D8H
  325.     IF DPMIVersion
  326.     MOV    ES:RetryOpcode,AX    ;Store opcode
  327.     ELSE
  328.     MOV    CS:RetryOpcode,AX    ;Store opcode
  329.     ENDIF
  330.     CMP    AX,07D9H        ;FLD DWORD
  331.     JE    @@4
  332.     CMP    AX,07DDH        ;FLD QWORD
  333.     JE    @@4
  334.     CMP    AX,2FDBH        ;FLD TBYTE
  335.     JE    @@4
  336.     CMP    AX,17D8H        ;FCOM DWORD
  337.     JE    @@5
  338.     CMP    AX,17DCH        ;FCOM QWORD
  339.     JE    @@5
  340.     CMP    AX,1FD8H        ;FCOMP DWORD
  341.     JE    @@5
  342.     CMP    AX,1FDCH        ;FCOMP QWORD
  343.     JE    @@5
  344.     CMP    AX,37D8H        ;FDIV DWORD
  345.     JE    @@2
  346.     CMP    AX,37DCH        ;FDIV QWORD
  347.     JE    @@2
  348.     FCLEX                ;Clear exceptions
  349.     CALL    Retry            ;Retry arithmetic operation
  350.     JMP    SHORT @@3
  351. @@2:
  352.     IF DPMIVersion
  353.     SUB    ES:RetryOpcode,37D8H-07D9H ;Convert FDIV to FLD
  354.     ELSE
  355.     SUB    CS:RetryOpcode,37D8H-07D9H ;Convert FDIV to FLD
  356.     ENDIF
  357.     CALL    Retry            ;Load operand
  358.     CALL    Normalize        ;Normalize operand
  359.     FCLEX                ;Clear exceptions
  360.     FDIV                ;Do divide
  361. @@3:    FSTSW    TempWord        ;Store status
  362.     FWAIT
  363.     MOV    AL,TempWord.b0        ;Add new exceptions to saved
  364.     OR    StatWord.b0,AL        ;status word
  365. @@4:    CALL    Normalize        ;Normalize result
  366. @@5:    FCLEX                ;Must do this before FLDENV
  367.     AND    StatWord.b0,NOT mDE    ;Clear denormal exception
  368.     FLDENV    EnvBuffer        ;Reload environment
  369.     IF DPMIVersion
  370.     POP    ES
  371.     ENDIF
  372.     POP    BX            ;Restore and return
  373.     POP    DS
  374.     POP    AX
  375.     IRET
  376.  
  377. ; Examine ST and normalize if required
  378.  
  379. Normalize:
  380.  
  381.     FXAM                ;Examine
  382.     FSTSW    TempWord        ;Status word to AX
  383.     FWAIT
  384.     MOV    AX,TempWord
  385.     TEST    AX,mC3+mC2+mC0        ;Unnormal?
  386.     JE    @@1            ;Yes, @@1
  387.     TEST    AX,mC3            ;Normal, NAN, or INF?
  388.     JE    @@2            ;Yes, @@2
  389.     TEST    AX,mC2            ;Zero?
  390.     JE    @@2            ;Yes, @@2
  391.     FSTP    ST(0)            ;Denormal becomes zero
  392.     FLDZ
  393.     RET
  394. @@1:    FLD    FConINF            ;Normalize unnormal
  395.     FXCH
  396.     FPREM
  397.     FSTP    ST(1)
  398. @@2:    RET
  399.  
  400. ; Turn emulation back on
  401.  
  402.     EMUL
  403.  
  404. ; Convert Real to Extended
  405.  
  406. FRealExt:
  407.  
  408.     OR    AL,AL
  409.     JE    @@1
  410.     XOR    CL,CL
  411.     MOV    CH,AH
  412.     MOV    AH,DH
  413.     AND    AH,80H
  414.     ADD    AX,3F7EH
  415.     OR    DH,80H
  416.     PUSH    AX
  417.     PUSH    DX
  418.     PUSH    BX
  419.     PUSH    CX
  420.     XOR    CX,CX
  421.     PUSH    CX
  422.     MOV    BX,SP
  423.     FLD    TBYTE PTR SS:[BX]
  424.     FWAIT
  425.     ADD    SP,10
  426.     RETF
  427. @@1:    FLDZ
  428.     RETF
  429.  
  430. ; Convert Extended to Real
  431.  
  432. FExtReal:
  433.  
  434.     SUB    SP,10
  435.     MOV    BX,SP
  436.     FSTP    TBYTE PTR SS:[BX]
  437.     FWAIT
  438.     ADD    SP,2
  439.     POP    CX
  440.     POP    BX
  441.     POP    DX
  442.     POP    AX
  443.     MOV    DI,AX
  444.     AND    AX,7FFFH
  445.     SUB    AX,3F7EH
  446.     JBE    @@2
  447.     OR    AH,AH
  448.     JNE    @@4
  449.     MOV    AH,CH
  450.     SHL    CL,1
  451.     ADC    AH,0
  452.     ADC    BX,0
  453.     ADC    DX,0
  454.     JC    @@3
  455. @@1:    SHL    DX,1
  456.     SHL    DI,1
  457.     RCR    DX,1
  458.     RETF
  459. @@2:    XOR    AX,AX
  460.     XOR    BX,BX
  461.     XOR    DX,DX
  462.     RETF
  463. @@3:    INC    AL
  464.     JNE    @@1
  465. @@4:    MOV    AX,205
  466.     JMP    HaltError
  467.  
  468. ; Trunc function
  469.  
  470. FTrunc:
  471.  
  472.     FSTCW    CtrlWord
  473.     FLDCW    CWChop
  474.     FISTP    TempLong
  475.     FWAIT                ;486 needs FWAIT before FLDCW
  476.     FLDCW    CtrlWord
  477.     MOV    AX,TempLong.w0
  478.     MOV    DX,TempLong.w2
  479.     RETF
  480.  
  481. ; Round function
  482.  
  483. FRound:
  484.  
  485.     FISTP    TempLong
  486.     FWAIT
  487.     MOV    AX,TempLong.w0
  488.     MOV    DX,TempLong.w2
  489.     RETF
  490.  
  491. ; Int function
  492.  
  493. FInt:
  494.  
  495.     FSTCW    CtrlWord
  496.     FLDCW    CWChop
  497.     FRNDINT
  498.     FWAIT                ;486 needs FWAIT before FLDCW
  499.     FLDCW    CtrlWord
  500.     RETF
  501.  
  502. ; Frac function
  503.  
  504. FFrac:
  505.  
  506.     FSTCW    CtrlWord
  507.     FLDCW    CWChop
  508.     FLD    ST(0)
  509.     FRNDINT
  510.     FSUB
  511.     FWAIT                ;486 needs FWAIT before FLDCW
  512.     FLDCW    CtrlWord
  513.     RETF
  514.  
  515. ; Sqrt function
  516.  
  517. FSqrt:
  518.  
  519.     FSQRT
  520.     RETF
  521.  
  522. ; Sin function
  523.  
  524. FSin:
  525.  
  526.     INT    3EH
  527.     DW    scSin
  528.     RETF
  529.  
  530. ; Cos function
  531.  
  532. FCos:
  533.  
  534.     INT    3EH
  535.     DW    scCos
  536.     RETF
  537.  
  538. ; ArcTan function
  539.  
  540. FArcTan:
  541.  
  542.     INT    3EH
  543.     DW    scArcTan
  544.     RETF
  545.  
  546. ; Ln function
  547.  
  548. FLn:
  549.  
  550.     INT    3EH
  551.     DW    scLog
  552.     RETF
  553.  
  554. ; Exp function
  555.  
  556. FExp:
  557.  
  558.     INT    3EH
  559.     DW    scExp
  560.     RETF
  561.  
  562. CODE    ENDS
  563.  
  564.     END
  565.