mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-06-01 07:41:58 +00:00
4325cdcc78
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
1246 lines
36 KiB
Plaintext
1246 lines
36 KiB
Plaintext
;
|
||
; File: ELEMS020_1.a
|
||
;
|
||
; Copyright: © 1990-1991 by Apple Computer, Inc., all rights reserved.
|
||
;
|
||
; This file is used in these builds: Mac32
|
||
;
|
||
; Change History (most recent first):
|
||
;
|
||
; <6> 5/21/91 gbm Nail a couple of warnings
|
||
; <5> 9/15/90 BG Removed <4>. 040s are behaving more reliably now.
|
||
; <4> 7/17/90 BG Added EclipseNOPs for flakey 040s.
|
||
; <3> 4/14/90 JJ Make changes to support new binary-to-decimal, 96-bit precision,
|
||
; and improved Pack 5.
|
||
; <2> 3/2/90 JJ Changed value of SANETrapAddr to point directly to dispatch
|
||
; table.
|
||
; <1> 3/2/90 JJ First checked in.
|
||
;
|
||
; To Do:
|
||
;
|
||
|
||
;-----------------------------------------------------------
|
||
; File: ELEMS020_1.a
|
||
;-----------------------------------------------------------
|
||
|
||
;-----------------------------------------------------------
|
||
; 26 MAR 90 Modified to support 96-bit extended type (JPO).
|
||
;-----------------------------------------------------------
|
||
|
||
;-----------------------------------------------------------
|
||
; There are four logarithm functions: LN(x), LOG2(x), LN(1+x), and LOG2(1+x).
|
||
; They share much of the same code, but are distinguished by two bits.
|
||
; In the same way, EXP(x), EXP2(x), EXP(x)-1, EXP2(x)-1 share the same
|
||
; startup code.
|
||
;-----------------------------------------------------------
|
||
|
||
BLANKS ON
|
||
STRING ASIS
|
||
|
||
BTLOGBASE2 EQU 1 ; SET IF EITHER LOG2(X) OR LOG2(1+X)
|
||
; SET IF EITHER EXP2(X) OR EXP2(X)-1
|
||
BTLOG1PLUSX EQU 2 ; SET IF EITHER LN(1+X) OR LOG2(1+X)
|
||
; SET IF EITHER EXP(X)-1 OR EXP2(X)-1
|
||
|
||
;-----------------------------------------------------------
|
||
; When ELEMS68 is entered the stack has the form:
|
||
; ret adrs < opcode word < dst adrs < src adrs < src2 adrs
|
||
; with a second source address only in the case of the financial functions
|
||
; Compound and Annuity. A LINK is made through A6 (leaving A5 intact for
|
||
; the debugger people) and the following stack frame is set up:
|
||
;
|
||
; ......
|
||
; source2 address -- only if Compound or Annuity
|
||
; source address -- for Comp., Ann., X^I, X^Y
|
||
; destination address
|
||
; opcode word
|
||
; return address -- top of stack on entry to ELEMS68
|
||
; saved A6 -- for LINK, pntd to by A6 throughout ELEMS68
|
||
; environment word-- slot to save user's env across ELEMS68
|
||
; I -- word for integer temporary
|
||
; J -- word...
|
||
; W -- 5 words for extended temporary
|
||
; X -- 5 words...
|
||
; Y -- 5 words...
|
||
; Z -- 5 words...
|
||
; SRCCOPY -- 5 words for 80-bit copy of 96-bit SRC
|
||
; SRC2COPY -- 5 words for 80-bit copy of 96-bit SRC2
|
||
; saved D0-D7/A0-A4-- done with MOVEM.L after LINK
|
||
;
|
||
; After the operand addresses are fetched, the return address is written
|
||
; onto the deepest operand address, and the high word of the return address
|
||
; (the top of stack after the UNLK) is set to the number of bytes down to
|
||
; the relocated return address. To see how simple the subsequent exit
|
||
; procedure is, look at the code below label RESULTDELIVERED.
|
||
;
|
||
; The following constants index the stack frame off of A6:
|
||
;-----------------------------------------------------------
|
||
|
||
STSRC2 EQU 18 ; SOURCE2
|
||
STSRC EQU 14 ; SOURCE
|
||
STDST EQU 10 ; DESTINATION
|
||
STOPCODE EQU 8 ; OPCODE WORD
|
||
STRET EQU 4 ; RETURN ADDRESS
|
||
STA5 EQU 0 ; SAVED A6
|
||
STENV EQU -2 ; ENVIRONMENT SLOT
|
||
STI EQU -4 ; I
|
||
STJ EQU -6 ; J
|
||
STW EQU -16 ; W
|
||
STX EQU -26 ; X
|
||
STY EQU -36 ; Y
|
||
STZ EQU -46 ; Z
|
||
SCOPY EQU -56 ; SRC copy
|
||
S2COPY EQU -66 ; SRC2 copy
|
||
STLOCK EQU -68 ; HIGH WORD OF HANDLE
|
||
|
||
STFRAMESIZE EQU -68 ; SIZE OR FRAME FROM LINK
|
||
|
||
;-----------------------------------------------------------
|
||
; The following constants give the number of stack bytes to pop before exit.
|
||
;-----------------------------------------------------------
|
||
KI1ADRS EQU 6 ; OLD RET AND OPCODE
|
||
KI2ADRS EQU 10 ; OLD RET, OPCODE, DST
|
||
KI3ADRS EQU 14 ; OLD RET, OPCODE, DST, SRC
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; The opword is defined as:
|
||
; XY00 0000 Z0NN NNN0
|
||
; where X=1 for 2- or 3-address functions, Y=1 for 3-address functions,
|
||
; Z = 1 for 96-bit extended operands, and <NN NNN0> is the index
|
||
; into the jump table for the specific instruction.
|
||
;-----------------------------------------------------------
|
||
OP2ADRS EQU 15 ; SET IF 2-ADRS
|
||
OP3ADRS EQU 14 ; SET IF 3-ADRS
|
||
OPMASK EQU $003E ; MASK FOR JUMP TABLE INDEX
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; For scaling via FSCALBX, integer argument must be kept less than the
|
||
; maximum magnitude in a 16-bit integer. When outlandish scaling is
|
||
; required below, FSCALBX is called in units of MAXINT.
|
||
;-----------------------------------------------------------
|
||
|
||
MAXINT EQU 32767 ; 2^15 - 1
|
||
|
||
;-----------------------------------------------------------
|
||
; When raising extended to an integer power, do explicit multiplies when
|
||
; the exponent is smaller than some threshold. It's 255 for now.
|
||
; When the exponent exceeds this threshold, computation is done with
|
||
; log and exp.
|
||
;-----------------------------------------------------------
|
||
|
||
SMALLEXP EQU 255
|
||
|
||
;-----------------------------------------------------------
|
||
; The environment word is maintained at low memory addr FPSTATE.
|
||
;-----------------------------------------------------------
|
||
|
||
FPSTATE EQU $0A4A
|
||
|
||
;-----------------------------------------------------------
|
||
; The PACK4 (SANE FP) entry point is in low memory addr SANETrapAddr.
|
||
;-----------------------------------------------------------
|
||
|
||
SANETrapAddr EQU ToolTable+4*$1eb ; address of Pack4 in dispatch table
|
||
|
||
;-----------------------------------------------------------
|
||
; Here are the poor man's macros for getting at the arithmetic:
|
||
;-----------------------------------------------------------
|
||
|
||
MACRO
|
||
ELFADDX
|
||
MOVE #0,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFSUBX
|
||
MOVE #2,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFMULX
|
||
MOVE #4,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFDIVX
|
||
MOVE #6,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFCMPX
|
||
MOVE #8,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFREMX
|
||
MOVE #$C,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFI2X
|
||
BSR ELI2X
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFX2X
|
||
MOVE #$0E,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFX2I
|
||
MOVE #$2010,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFRINTX
|
||
MOVE #$14,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFSCALBX
|
||
MOVE #$18,-(SP)
|
||
JSR (A3)
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFPROCEXIT
|
||
BSR ELPROCEXIT
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFLOGBX
|
||
BSR ELLOGBX
|
||
ENDM
|
||
|
||
MACRO
|
||
ELFCLASSX
|
||
BSR ELCLASSX
|
||
ENDM
|
||
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
;-----------------------------------------------------------
|
||
; ELEMS020---sole entry point to package
|
||
;-----------------------------------------------------------
|
||
;-----------------------------------------------------------
|
||
|
||
ELEMS020 PROC EXPORT
|
||
LINK A6,#STFRAMESIZE ; ALLOCATE TEMP CELLS
|
||
MOVEM.L D0-D7/A0-A4,-(SP) ; PRESERVE WORKING REGS
|
||
MOVEQ #0,D3 ; ERROR BITS AND OPCODE
|
||
|
||
;-----------------------------------------------------------
|
||
; Load the registers as follows:
|
||
; A3 <-- PACK4 (SANE FP) entry point stored
|
||
; in low memory global SANETrapAddr
|
||
; A4 <-- dst adrs
|
||
; D4 <-- src adrs, if any
|
||
; D5 <-- src2 adrs, if any, dst if there is none
|
||
; D3 <-- opcode word
|
||
; D2 <-- src class, if any
|
||
; D1 <-- dst/src2 class
|
||
;
|
||
; D6 <-- scratch
|
||
; D7 <-- scratch
|
||
;
|
||
; Nuisance: must avoid trying to classify the integer src to the X^I operation.
|
||
;
|
||
; Note: the assembly language class function FCLASSX returns a nonzero value
|
||
; with the sign of the input argument; the magnitude of the value is 1
|
||
; greater than the value of the Pascal enumerated type in the Elems interface.
|
||
;
|
||
; Note after the operand addresses are fetched the stack is set up for later
|
||
; exit, that is the return address is moved to the deepest available long
|
||
; word and the number of other bytes to kill is stored in the high word of
|
||
; the former return address. See the stack notes in the EQU section above
|
||
; and the exit sequence at label RESULTDELIVERED.
|
||
;-----------------------------------------------------------
|
||
|
||
MOVEA.L (SANETrapAddr).W,A3 ; A3 <- PACK4 entry point for duration
|
||
LEA STRET(A6),A2 ; POINT TO RET ADRS
|
||
LEA STOPCODE(A6),A0 ; POINT INTO STACK ARGS
|
||
MOVE.W (A0)+,D3 ; GET OPCODE
|
||
BPL DSTONLY ; QUICK TEST OF #OP2ADRS BIT
|
||
|
||
MOVEA.L (A0)+,A4 ; DST ADRS, ANOTHER ADRS COMING
|
||
MOVE.L (A0),D4 ; SRC TOO, BUT NO INCREMENT
|
||
BTST #OP3ADRS,D3
|
||
BNE.S HAVESRC2
|
||
|
||
;-----------------------------------------------------------
|
||
; Get here if have src and dst operands only.
|
||
;-----------------------------------------------------------
|
||
TST.B D3 ; 96-bit extended?
|
||
BPL.S @1 ; no. 80-bit
|
||
|
||
MOVE.W (A4),2(A4) ; yes. convert DST to 80-bit and bump pointer
|
||
ADDQ.L #2,A4
|
||
|
||
@1:
|
||
MOVE.L (A2),(A0) ; RET ADRS ON SRC ADRS
|
||
MOVE.W #KI2ADRS,(A2) ; STACK KILL COUNT
|
||
MOVE.L A4,D5 ; PRETEND THERE'S A SRC2
|
||
|
||
MOVEQ #15,D2 ; PRESET SRC CLASS IN CASE X^I
|
||
MOVEQ #OPMASK,D0 ; SPECIAL CASE WITH INTEGER OP
|
||
AND.W D3,D0
|
||
CMPI.B #$10,D0
|
||
BEQ.S CLASSDSTORSRC2
|
||
|
||
CLASSCOM:
|
||
TST.B D3 ; 96-bit extended?
|
||
BPL.S CLCOM2 ; no. 80-bit
|
||
CLCOM1:
|
||
MOVE.L D4,A0 ; yes. copy 96-bit SRC to 80-bit SRCCOPY
|
||
LEA SCOPY(A6),A1
|
||
MOVE.L A1,D4 ; D4 points to SRCCOPY
|
||
MOVE.W (A0),(A1)+
|
||
MOVE.L 4(A0),(A1)+
|
||
MOVE.L 8(A0),(A1)
|
||
CLCOM2:
|
||
MOVEA.L D4,A0 ; CLASSIFY SRC OPERAND
|
||
BSR.S CLASSIFY
|
||
MOVE.W D0,D2 ; SRC CLASS CODE
|
||
CLASSSKIP:
|
||
BRA.S CLASSDSTORSRC2
|
||
|
||
;-----------------------------------------------------------
|
||
; Get here if src, src2, and dst operands. Get src2 adrs and classify.
|
||
; Only Compound and Annuity have a src2.
|
||
;-----------------------------------------------------------
|
||
HAVESRC2:
|
||
ADDQ.L #4,A0 ; SKIP OVER SRC ADRS
|
||
MOVE.L (A0),D5 ; SRC2 addr
|
||
MOVE.L (A2),(A0) ; RET ADRS ON SRC ADRS
|
||
MOVE.W #KI3ADRS,(A2) ; STACK KILL COUNT
|
||
TST.B D3 ; 96-bit extended operands?
|
||
BPL.S CLCOM2 ; no. 80-bit extended
|
||
|
||
ADDQ #2,A4 ; yes. bump DST pointer for 80-bit interim result
|
||
MOVE.L D5,A0 ; copy 96-bit SRC2 to 80-bit SRC2COPY
|
||
LEA S2COPY(A6),A1
|
||
MOVE.L A1,D5
|
||
MOVE.W (A0),(A1)+
|
||
MOVE.L 4(A0),(A1)+
|
||
MOVE.L 8(A0),(A1)
|
||
BRA.S CLCOM1 ; copy 96-bit SRC to 80-bit SRCCOPY
|
||
|
||
;-----------------------------------------------------------
|
||
; Handy place to stick the following routine.
|
||
; Input: A0 = operand address
|
||
; Output: D0 = class code
|
||
; Uses: stack cell I to receive class
|
||
; D0.B has value 1-6 according to SNAN, QNAN, INF, ZERO, NORMAL, DENORMAL
|
||
; and the high bit D0.W (i.e. #$8000) is set according to the op's sign.
|
||
;-----------------------------------------------------------
|
||
CLASSIFY:
|
||
PEA (A0) ; EXTENDED SOURCE
|
||
PEA STI(A6) ; INTEGER DST FOR CLASS
|
||
ELFCLASSX ; RETURNS SIGNED 1-6
|
||
MOVE.W STI(A6),D0
|
||
BPL.S @1
|
||
NEG.W D0
|
||
ORI.W #$8000,D0 ; ISOLATE SIGN IN HIGH BIT
|
||
@1
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Get here in usual case of unary operator.
|
||
;-----------------------------------------------------------
|
||
DSTONLY:
|
||
MOVEQ #15,D2 ; FAKE A NON-NAN CLASS CODE
|
||
MOVE.L (A0),A4 ; DST ADRS
|
||
TST.B D3 ; 96-bit extended?
|
||
BPL.S @1 ; no. 80-bit
|
||
|
||
MOVE.W (A4),2(A4) ; yes. convert to 80-bit and bump pointer
|
||
ADDQ.L #2,A4
|
||
|
||
@1:
|
||
MOVE.L (A2),(A0) ; RET ADRS
|
||
MOVE.W #KI1ADRS,(A2) ; KILL COUNT
|
||
MOVE.L A4,D5 ; PRETEND DST IS SRC2
|
||
|
||
CLASSDSTORSRC2:
|
||
MOVEA.L D5,A0 ; SRC2 OR DST ADRS
|
||
BSR.S CLASSIFY
|
||
MOVE.W D0,D1
|
||
|
||
;-----------------------------------------------------------
|
||
; Now save the user's environment and set all flags and halts off and rounding
|
||
; to nearest.
|
||
; Output: Environment cell.
|
||
; Uses: cell I to hold default environment
|
||
;-----------------------------------------------------------
|
||
MOVE.W (FPSTATE).W,STENV(A6) ; save environment in cell
|
||
CLR.W (FPSTATE).W ; set default environment
|
||
|
||
;-----------------------------------------------------------
|
||
; Check for NANs, either D1 (dst/src2) or D2 (src) equal to 1 or 2.
|
||
; If the src is a NAN, there might be two NANs so let floating add
|
||
; determine precedence, or propagate the one NAN. If just the dst
|
||
; (or possibly src2) is a NAN, do a simple move, in order to touch
|
||
; any signaling NAN that may have appeared.
|
||
;-----------------------------------------------------------
|
||
SUBQ.B #FCINF,D2 ; IS < 0 FOR SRC NANS
|
||
BGE.S NOT2NANS
|
||
|
||
MOVEA.L D5,A0 ; MIGHT BE DST OR SRC2
|
||
MOVEA.L A4,A1 ; ALWAYS DST ADRS
|
||
BSR.S A0TOA1 ; JUST BIT COPY
|
||
MOVE.L D4,-(SP) ; SRC ADRS
|
||
PEA (A4) ; ALWAYS DST ADRS
|
||
ELFADDX
|
||
BRA.S NANEXIT
|
||
NOT2NANS:
|
||
SUBQ.B #FCINF,D1 ; CHECK SRC2 OR DST
|
||
BGE.S NONANS
|
||
|
||
MOVE.L D5,-(SP) ; SRC2 OR DST ADRS
|
||
PEA (A4) ; DST ADRS
|
||
ELFX2X
|
||
NANEXIT:
|
||
BRA RESULTDELIVERED
|
||
NONANS:
|
||
|
||
;-----------------------------------------------------------
|
||
; Fall through to here in typical case of no NANs.
|
||
; Have dst address in A4, src address in D4, dst or src2 address in D5.
|
||
; D1 and D2 contain the dst/src2 and src class codes, decremented by
|
||
; #FCINF.
|
||
; Jump to specific routine based on opword in D3.W.
|
||
;-----------------------------------------------------------
|
||
LIFTOFF:
|
||
MOVE.W D3,D0
|
||
ANDI.W #OPMASK,D0
|
||
MOVE.W ELEMSTAB(D0),D0
|
||
JMP LIFTOFF(D0)
|
||
|
||
|
||
ELEMSTAB:
|
||
DC.W LOGTOP-LIFTOFF ; LNX
|
||
DC.W LOGTOP-LIFTOFF ; LOG2X
|
||
DC.W LOGTOP-LIFTOFF ; LN1X
|
||
DC.W LOGTOP-LIFTOFF ; LOG21X
|
||
|
||
DC.W EXPTOP-LIFTOFF ; EXPX
|
||
DC.W EXPTOP-LIFTOFF ; EXP2X
|
||
DC.W EXP1TOP-LIFTOFF ; EXPX - 1
|
||
DC.W EXP1TOP-LIFTOFF ; EXP2X - 1
|
||
|
||
DC.W XPWRITOP-LIFTOFF
|
||
DC.W XPWRYTOP-LIFTOFF
|
||
DC.W COMPOUNDTOP-LIFTOFF
|
||
DC.W ANNUITYTOP-LIFTOFF
|
||
|
||
DC.W SINTOP-LIFTOFF
|
||
DC.W COSTOP-LIFTOFF
|
||
DC.W TANTOP-LIFTOFF
|
||
DC.W ATANTOP-LIFTOFF
|
||
|
||
DC.W RANDTOP-LIFTOFF
|
||
|
||
;-----------------------------------------------------------
|
||
; Utility to copy an extended operand from (A0) to (A1), resetting
|
||
; A1 to point to the head. Turns out not to be useful to reset A0,
|
||
; since it is always thrown away.
|
||
;-----------------------------------------------------------
|
||
A0TOA1:
|
||
MOVE.L (A0)+,(A1)+
|
||
MOVE.L (A0)+,(A1)+
|
||
MOVE.W (A0),(A1)
|
||
SUBQ.L #8,A1
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Utility to evaluate a polynomial using Horner's recurrence.
|
||
; Input: A0 pts to result field (preserved).
|
||
; A1 pts to coefficient table (advanced beyond table).
|
||
; A2 pts to function value (preserved).
|
||
; Uses: D0
|
||
; All operands are extended. The polynomial table consists of
|
||
; a leading word N, a positive integer giving the degree of the
|
||
; polynomial, and then (N+1) extended coefficients, starting with
|
||
; that of the leading term.
|
||
; RESULT <-- C0 initially.
|
||
; RESULT <-- (RESULT * X) + CJ for J = 1 to DEGREE
|
||
; Since A1 is advanced beyond the end of the given coefficient table,
|
||
; POLEVAL may be used successively with consecutive tables, after setting
|
||
; A1 just once.
|
||
;-----------------------------------------------------------
|
||
POLYEVAL:
|
||
MOVE.W (A1)+,D0 ; GET LOOP INDEX
|
||
MOVE.L (A1),(A0) ; transfer leading coefficient to
|
||
MOVE.L 4(A1),4(A0) ; result field
|
||
MOVE.W 8(A1),8(A0)
|
||
|
||
POLYLOOP:
|
||
PEA (A2)
|
||
PEA (A0)
|
||
ELFMULX ; ACCUM <-- ACCUM * X
|
||
ADDQ.L #8,A1 ; SKIP 10 BYTES TO NEXT
|
||
ADDQ.L #2,A1 ; ...COEFFICIENT
|
||
PEA (A1)
|
||
PEA (A0)
|
||
ELFADDX ; ACCUM <-- ACCUM + CJ
|
||
SUBQ.W #1,D0
|
||
BGT.S POLYLOOP
|
||
|
||
ADDQ.L #8,A1 ; SKIP BEYOND END OF TABLE
|
||
ADDQ.L #2,A1
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Clear the exception flag.
|
||
; Uses: D0.
|
||
;-----------------------------------------------------------
|
||
CLEARUFLOW:
|
||
MOVEQ #FBUFLOW,D0
|
||
BRA.S CLEARX
|
||
|
||
CLEAROFLOW:
|
||
MOVEQ #FBOFLOW,D0
|
||
BRA.S CLEARX
|
||
|
||
CLEARINVALID:
|
||
MOVEQ #FBINVALID,D0
|
||
BRA.S CLEARX
|
||
|
||
CLEARINEXACT:
|
||
MOVEQ #FBINEXACT,D0
|
||
|
||
CLEARX:
|
||
BCLR D0,(FPSTATE).W ; exception bit in high byte
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Utility to force an exception flag. No halts are enabled in
|
||
; environment due to PROCENTRY, so simply turn on appropriate
|
||
; exception bit in environment global.
|
||
; Uses: D0.
|
||
;-----------------------------------------------------------
|
||
FORCEOFLOW:
|
||
MOVEQ #FBOFLOW,D0
|
||
BRA.S FORCEX
|
||
|
||
FORCEUFLOW:
|
||
MOVEQ #FBUFLOW,D0
|
||
BRA.S FORCEX
|
||
|
||
FORCEDIVZER:
|
||
MOVEQ #FBDIVZER,D0
|
||
BRA.S FORCEX
|
||
|
||
FORCEINVALID:
|
||
MOVEQ #FBINVALID,D0
|
||
BRA.S FORCEX
|
||
|
||
FORCEINEXACT:
|
||
MOVEQ #FBINEXACT,D0
|
||
|
||
FORCEX:
|
||
BSET D0,(FPSTATE).W ; exception bit in high byte
|
||
RTS
|
||
|
||
;-----------------------------------------------------------
|
||
; Utility to test an exception flag.
|
||
; Output: Z flag in CCR is true if flag is off, Z is false if flag is set.
|
||
;-----------------------------------------------------------
|
||
TESTDIVZER:
|
||
MOVEQ #FBDIVZER,D0
|
||
BRA.S TESTX
|
||
TESTUFLOW:
|
||
MOVEQ #FBUFLOW,D0
|
||
BRA.S TESTX
|
||
TESTOFLOW:
|
||
MOVEQ #FBOFLOW,D0
|
||
BRA.S TESTX
|
||
TESTINVALID:
|
||
MOVEQ #FBINVALID,D0
|
||
BRA.S TESTX
|
||
TESTINEXACT:
|
||
MOVEQ #FBINEXACT,D0
|
||
TESTX: ; test exception bit in high byte
|
||
BTST D0,(FPSTATE).W ; of environment word
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Floating scalb function computes (A0) <-- (A0) * 2^(A1)
|
||
; Because of the 15-bit exponent range, just two invocations
|
||
; of FSCALBX are required if an over/underflow is to be stimulated.
|
||
; A0, A1, and (A1) are not modified.
|
||
; Uses: cells J and Y, A2
|
||
;-----------------------------------------------------------
|
||
SCALBXX:
|
||
MOVE.W #MAXINT,STJ(A6) ; SEEDED INTEGER SLOT
|
||
LEA STY+10(A6),A2 ; BEYOND CELL Y
|
||
MOVE.L 6(A1),-(A2) ; COPY OF (A1)
|
||
MOVE.L 2(A1),-(A2)
|
||
MOVE.W (A1),-(A2)
|
||
|
||
BCLR #7,(A2) ; ABS (A1) COPY
|
||
|
||
;-----------------------------------------------------------
|
||
; If ABS(A1) is larger than MAXINT then do one step of scaling by MAXINT.
|
||
;-----------------------------------------------------------
|
||
BSR.S VSMAXINT
|
||
FBGES At1 ; FLOATING >=
|
||
|
||
;-----------------------------------------------------------
|
||
; Must diminish (A2) by FPKMAXINT.
|
||
;-----------------------------------------------------------
|
||
PEA FPKMAXINT
|
||
PEA (A2)
|
||
ELFSUBX
|
||
|
||
TST.B (A1) ; CHECK OPERAND SIGN
|
||
BPL.S @1
|
||
NEG.W STJ(A6) ; -MAXINT IN INTEGER CELL
|
||
@1:
|
||
BSR.S SCALEINT ; SCALE BY STJ(A6)
|
||
|
||
;-----------------------------------------------------------
|
||
; If (SP) exceeds FPKMAXINT at this step, just force signed FPMAXINT.
|
||
;-----------------------------------------------------------
|
||
BSR.S VSMAXINT ; (A2) VS FPMAXINT
|
||
FBGES At1 ; FLOATING >=
|
||
|
||
PEA FPKMAXINT
|
||
BRA.S At3
|
||
|
||
At1:
|
||
PEA (A2) ; USE REDUCED VALUE
|
||
|
||
At3:
|
||
PEA STJ(A6) ; ADDRESS OF INT SLOT
|
||
ELFX2I
|
||
|
||
TST.B (A1)
|
||
BPL.S @5
|
||
|
||
NEG.W STJ(A6) ; FORCE SIGN OF INTEGER
|
||
@5:
|
||
;-----------------------------------------------------------
|
||
; FALL THROUGH AND EXIT
|
||
;
|
||
; Scale (A0) by integer at STJ(A6).
|
||
;-----------------------------------------------------------
|
||
SCALEINT:
|
||
PEA STJ(A6)
|
||
PEA (A0)
|
||
ELFSCALBX
|
||
RTS
|
||
|
||
;-----------------------------------------------------------
|
||
; Compare STY(A6) with FPMAXINT.
|
||
;-----------------------------------------------------------
|
||
VSMAXINT:
|
||
PEA STY(A6)
|
||
PEA FPKMAXINT
|
||
ELFCMPX
|
||
RTS
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; ELLOGBX---fast LOGB routine expects finite, nonzero extended
|
||
; input, and so is nonexceptional. Interface is the same as
|
||
; that of the SANE ROM routine except for the absence of
|
||
; OPWORD on stack. Upon entry,
|
||
; STACK: &ret < &DST (input extended addr).
|
||
; Upon exit, integral exponent value is written in extended
|
||
; format to DST addr and stack is popped.
|
||
;-----------------------------------------------------------
|
||
ELLOGBX:
|
||
MOVEM.L A0/D0-D2,-(SP) ; save small # of registers
|
||
MOVEQ #0,D1 ; zero D1
|
||
MOVEA.L 20(SP),A0 ; A0 <- &DST
|
||
MOVE.W (A0),D1 ; D1.W <- sign/exp
|
||
BCLR #15,D1 ; sign of operand irrelevant
|
||
MOVE.L 2(A0),D0 ; sig.HI into D0
|
||
BMI.S @3 ; already normalized
|
||
|
||
BFFFO D0{0:0},D2 ; find first set bit in sig.HI
|
||
BNE.S @1 ; sig.HI is nonzero
|
||
|
||
SUB.W D2,D1 ; adjust exp (D2 must contain 32)
|
||
MOVE.L 6(A0),D0 ; D0 <- sig.LO (must be nonzero)
|
||
BFFFO D0{0:0},D2 ; find first set bit in sig.LO
|
||
@1:
|
||
SUB.W D2,D1 ; adjust exp to normalized value
|
||
@3:
|
||
MOVE.W #$401E,D0 ; tentative exp for LOGB
|
||
SUB.W #$3FFF,D1 ; unbias exp of input
|
||
BGT.S @7 ; result > 0
|
||
BLT.S @5 ; result < 0
|
||
|
||
MOVE.L D1,D0 ; zero result
|
||
BRA.S @9 ; deliver it
|
||
@5:
|
||
BSET #15,D0 ; negative result; set sign bit
|
||
NEG.W D1 ; negate integer
|
||
@7:
|
||
BFFFO D1{0:0},D2 ; find first one to normalize
|
||
LSL.L D2,D1 ; shift left
|
||
SUB.W D2,D0 ; adjust result exponent
|
||
@9:
|
||
MOVE.W D0,(A0)+ ; deliver exp of result
|
||
MOVE.L D1,(A0)+ ; deliver sig.HI
|
||
CLR.L (A0) ; sig.LO is zero
|
||
|
||
MOVEM.L (SP)+,A0/D0-D2 ; restore registers
|
||
RTD #4 ; return
|
||
|
||
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; ELCLASSX---fast CLASSX routine simulates the SANE ROM
|
||
; routine except for absence of OPWORD on stack. Upon entry,
|
||
; STACK: &ret < &DST < &SRC.
|
||
; Upon exit, classify code (integer) is written to &DST and
|
||
; stack is popped.
|
||
;-----------------------------------------------------------
|
||
ELCLASSX:
|
||
MOVEM.L A0/D0-D1,-(SP) ; save small # of registers
|
||
MOVEA.L 20(SP),A0 ; SRC addr
|
||
MOVE.W (A0)+,D0 ; get sign/exp in D0.W
|
||
ADD.L D0,D0 ; sign in D0 bit 16
|
||
LSR.W #1,D0 ; positive exp in D0.W
|
||
|
||
CMPI.W #$7FFF,D0 ; max exp?
|
||
BEQ.S @5 ; yes, NAN or INF class
|
||
|
||
MOVE.L (A0)+,D1 ; normalized?
|
||
BPL.S @8 ; zero or unnormalized
|
||
|
||
@2:
|
||
MOVEQ #5,D1 ; NORMAL
|
||
|
||
@3:
|
||
BTST #16,D0 ; negate class code if
|
||
BEQ.S @4 ; sign bit is set
|
||
NEG.W D1
|
||
@4:
|
||
MOVEA.L 16(SP),A0 ; DST addr
|
||
MOVE.W D1,(A0) ; deliver classify result
|
||
MOVEM.L (SP)+,A0/D0-D1 ; restore registers
|
||
RTD #8 ; done
|
||
|
||
|
||
@5: ; INF or NAN class
|
||
MOVE.L (A0)+,D1 ; read high half of significand
|
||
ADD.L D1,D1 ; clr explicit bit of sig
|
||
LSR.L #1,D1
|
||
BEQ.S @7 ; INF or SNAN class since sig high is zero
|
||
|
||
BTST #30,D1 ; QNAN or SNAN
|
||
BEQ.S @6 ;
|
||
|
||
MOVEQ #2,D1 ; QNAN
|
||
BRA.S @3
|
||
@6:
|
||
MOVEQ #1,D1 ; SNAN
|
||
BRA.S @3
|
||
|
||
@7:
|
||
MOVE.L (A0),D1 ; INF or SNAN?
|
||
BNE.S @6 ; SNAN
|
||
|
||
MOVEQ #3,D1 ; INF
|
||
BRA.S @3
|
||
|
||
@8:
|
||
BEQ.S @11 ; ZERO or SUBNORM
|
||
|
||
@9:
|
||
SUBQ.W #1,D0 ; normalization loop
|
||
ADD.L D1,D1
|
||
BPL.S @9
|
||
|
||
@10:
|
||
TST.W D0 ; negative exponent means SUBNORM
|
||
BPL.S @2 ; nonnegative means NORMAL
|
||
|
||
MOVEQ #6,D1 ; SUBNORM
|
||
BRA.S @3
|
||
|
||
@11: ; high significand is zero
|
||
SUB.W #32,D0 ; decrease exponent
|
||
MOVE.L (A0),D1 ; D1 <- low significand
|
||
BEQ.S @12 ; ZERO
|
||
BPL.S @9 ; still unnormalized
|
||
BRA.S @10 ; check exponent
|
||
|
||
@12:
|
||
MOVEQ #4,D1 ; ZERO
|
||
BRA.S @3
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; ELI2X---Fast INT2X conversion routine uses SANE ROM interface
|
||
; except for absence of OPWORD on stack. Upon entry:
|
||
; STACK: &ret < &DST < &SRC, where &SRC contains a 16-bit
|
||
; integer value and &DST will store the 80-bit
|
||
; extended result of the conversion.
|
||
; Upon exit, the stack is popped.
|
||
;-----------------------------------------------------------
|
||
ELI2X:
|
||
MOVEM.L A0/D0-D1,-(SP) ; save 3 registers
|
||
MOVEA.L 20(SP),A0 ; A0 <- SRC addr
|
||
MOVE.W #$400E,D0 ; set exponent for integer in D0.HI
|
||
SWAP D0
|
||
MOVE.W (A0),D0 ; SRC integer into D0.LO
|
||
BEQ.S @5 ; zero
|
||
BPL.S @1 ; positive; normalize
|
||
|
||
BSET #31,D0 ; negative; set sign bit
|
||
NEG.W D0 ; negate D0.L0
|
||
BMI.S @3 ; already normalized
|
||
|
||
@1:
|
||
SWAP D0 ; swap exp and first 16 sig bits
|
||
BFFFO D0{0:16},D1 ; find first one bit in sig
|
||
SUB.W D1,D0 ; adjust exponent
|
||
SWAP D0 ; swap exp and sig bits back
|
||
LSL.W D1,D0 ; shift significand to normalize
|
||
|
||
@3:
|
||
MOVEA.L 16(SP),A0 ; DST addr
|
||
MOVE.L D0,(A0)+ ; write extended result
|
||
CLR.L (A0)+ ; with trailing zeros
|
||
CLR.W (A0)
|
||
|
||
MOVEM.L (SP)+,A0/D0-D1 ; pop registers
|
||
RTD #8 ; return
|
||
|
||
@5:
|
||
MOVEQ #0,D0 ; zero result
|
||
BRA.S @3 ; output it
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; ELPROCEXIT---Fast PROCEXIT routine uses SANE ROM interface
|
||
; except for absence of OPWORD on stack. Upon entry:
|
||
; STACK: &ret < &DST, where &DST contains an environment
|
||
; word to be restored.
|
||
; Upon exit, the current exceptions are ORed into the environment
|
||
; at &DST, the result becomes the new environment, a halt is
|
||
; taken if any of the current exceptions were halt-enabled in
|
||
; the restored environment, and the stack is popped.
|
||
;-----------------------------------------------------------
|
||
ELPROCEXIT:
|
||
MOVEM.L D0/D6/A0,-(SP) ; Use 3 registers
|
||
MOVEA.L 16(SP),A0 ; old environment addr
|
||
MOVE.W #$0019,D6 ; opword into D6.HI
|
||
SWAP D6
|
||
MOVE.W #$1F00,D6 ; exception mask in D6.W
|
||
AND.W (FPSTATE).W,D6 ; current exceptions in D6.W
|
||
MOVE.W (A0),D0 ; old environment into D0.W for restoration
|
||
|
||
FASTFIN:
|
||
OR.W D6,D0 ; OR new exceptions with old environment
|
||
MOVE.W D0,($0A4A).W ; store resulting environment
|
||
LSR.W #8,D6 ; check for halt
|
||
AND.W D6,D0
|
||
BNE.S FASTHALT ; handle halt
|
||
|
||
FASTEX:
|
||
MOVE D0,CCR ; zero CCR
|
||
MOVEM.L (SP)+,D0/D6/A0 ; restore registers
|
||
RTD #4 ; done
|
||
|
||
;-----------------------------------------------------------
|
||
; Fast halt vectoring routine for PROCEXIT
|
||
;-----------------------------------------------------------
|
||
FASTHALT:
|
||
LEA 16(SP),A0 ; A0 points to DST addr on stack
|
||
CLR.W -(SP) ; push CCR = 0 below D0 save
|
||
MOVE.W D0,-(SP) ; push HALT exceptions
|
||
PEA (SP) ; push MISCHALTINFO record pointer
|
||
MOVE.L 8(A0),-(SP) ; push bogus SRC2 addr
|
||
MOVE.L 4(A0),-(SP) ; push bogus SRC addr
|
||
MOVE.L (A0),-(SP) ; push DST addr
|
||
SWAP D6 ; push opword
|
||
MOVE.W D6,-(SP)
|
||
MOVEA.L ($0A4C).W,A0 ; call user halt handler
|
||
JSR (A0)
|
||
|
||
MOVE.L (SP)+,D0 ; pop HALT exception/CCR off stack
|
||
BRA.S FASTEX ; exit
|
||
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
;-----------------------------------------------------------
|
||
; Logarithm functions.
|
||
; All four functions LN(x), LOG2(x), LN(1+x), and LOG2(1+x)
|
||
; are launched by common error-checking code. In the usual case
|
||
; that arithmetic is required, the computation is cast in the form
|
||
; log2(1+z). The only difference between LN and LOG2 is that the
|
||
; former requires a final multiplication by LN(2).
|
||
;
|
||
; The four functions are distinguished by the BTLOGBASE2 and
|
||
; BDLOG1PLUSX bits as described in the EQUATES section above.
|
||
;
|
||
; Since the only operand is the destination, the relevant class code
|
||
; (already diminished by FCINF in the NAN check) is in D1.
|
||
;-----------------------------------------------------------
|
||
;-----------------------------------------------------------
|
||
LOGTOP:
|
||
SUBQ.B #1,D1
|
||
BPL.S LOGFINITE ; -1 FOR INF, NONNEG FOR FINITE
|
||
|
||
TST.W D1 ; CHECK SIGN BIT
|
||
BPL PINFSTUFF ; LOG(+INF) IS +INF
|
||
LOGERROR:
|
||
MOVEQ #NANLOG,D0 ; ERROR CODE
|
||
BRA ERRORNAN ; LOG(-INF) IS AN ERROR
|
||
LOGFINITE:
|
||
BTST #BTLOG1PLUSX,D3
|
||
BNE.S LOG1PLUSX
|
||
|
||
TST.B D1 ; 0 IF OPERAND IS 0
|
||
BEQ.S LOG0 ; -INF, WITH DIVIDE BY 0
|
||
|
||
TST.W D1 ; CHECK SIGN
|
||
BMI.S LOGERROR
|
||
BRA.S LOG2R ; COMPUTE LOG(X)
|
||
LOG1PLUSX:
|
||
TST.B D1
|
||
BEQ RESULTDELIVERED ; LOG(+-0) IS +-0
|
||
|
||
PEA (A4)
|
||
PEA FPKM1
|
||
ELFCMPX
|
||
FBUGTS LOGERROR ; -1 > OPERAND --> ERROR
|
||
FBLTS LOG12R ; FIND LOG(1+X)
|
||
; FALL THROUGH WHEN = -1
|
||
LOG0:
|
||
BRA DIVM0STUFF
|
||
;-----------------------------------------------------------
|
||
; END OF SPECIAL CASES
|
||
;-----------------------------------------------------------
|
||
|
||
;-----------------------------------------------------------
|
||
; Compute LOG2(1+T) for some positive, finite T.
|
||
; If 1+T falls outside the range SQRT(1/2) to SQRT(2) then
|
||
; just go to the code for LOG2(S) below. Else use LOGAPPROX
|
||
; on T itself, IGNORING the sum 1+T.
|
||
;-----------------------------------------------------------
|
||
LOG12R:
|
||
|
||
;-----------------------------------------------------------
|
||
; First compute 1+T, saving the input T in cell W.
|
||
;-----------------------------------------------------------
|
||
MOVEA.L A4,A0 ; INPUT PTR
|
||
LEA STW(A6),A1 ; PTR TO W CELL
|
||
BSR A0TOA1 ; COPY OF INPUT IN W
|
||
|
||
PEA FPK1
|
||
PEA (A4)
|
||
ELFADDX ; W <-- 1+T
|
||
|
||
;-----------------------------------------------------------
|
||
; Now compare with bounds SQRT(1/2) and SQRT(2).
|
||
;-----------------------------------------------------------
|
||
PEA FPKSQRTHALF
|
||
PEA (A4)
|
||
ELFCMPX
|
||
FBULES LOG2R
|
||
|
||
PEA (A4)
|
||
PEA FPKSQRT2
|
||
ELFCMPX
|
||
FBLES LOG2R
|
||
|
||
;-----------------------------------------------------------
|
||
; Input T is within the required range so restore input value and
|
||
; just LOGAPPROX and finish up.
|
||
;-----------------------------------------------------------
|
||
MOVEA.L A1,A0 ; STW(A6) LEFT FROM BEFORE
|
||
MOVEA.L A4,A1
|
||
BSR A0TOA1
|
||
|
||
BSR.S LOGAPPROX
|
||
BRA.S LOGFINI
|
||
|
||
;-----------------------------------------------------------
|
||
; Compute LOG2(T) for some positive, finite T.
|
||
; Represent T as 2^L * Q for SQRT(1/2) <= Q <= SQRT(2).
|
||
; Then LOG2(T) is L + LOG2(Q).
|
||
; LOG2(Q) for that restricted range is computed at LOGAPPROX below.
|
||
;-----------------------------------------------------------
|
||
LOG2R:
|
||
|
||
;-----------------------------------------------------------
|
||
; Compute LOGB(T), i.e. L, in W.
|
||
;-----------------------------------------------------------
|
||
MOVEA.L A4,A0
|
||
LEA STW(A6),A1
|
||
BSR A0TOA1 ; COPY X TO W
|
||
|
||
PEA (A1)
|
||
ELFLOGBX
|
||
|
||
;-----------------------------------------------------------
|
||
; Then scale T down to range 1 to 2. A single scaling step suffices
|
||
; since the logb result ranges between -16446 and +16383
|
||
;-----------------------------------------------------------
|
||
BCHG #7,(A1) ; -L IN W
|
||
PEA (A1) ; CONVERT LOGB RESULT TO INTEGER
|
||
PEA STJ(A6) ; USE CELL J
|
||
ELFX2I
|
||
PEA STJ(A6)
|
||
PEA (A4)
|
||
ELFSCALBX ; (A4) <-- (A4) * 2^(A1)
|
||
BCHG #7,(A1) ; BACK TO L IN W
|
||
|
||
;-----------------------------------------------------------
|
||
; If scaled value exceeds SQRT(2), then halve T and increment L.
|
||
;-----------------------------------------------------------
|
||
PEA FPKSQRT2
|
||
PEA (A4)
|
||
ELFCMPX
|
||
FBULES At11
|
||
|
||
PEA FPK1
|
||
PEA STW(A6)
|
||
ELFADDX ; INCREMENT L
|
||
|
||
SUB.W #1,(A4) ; HALVE T BY DECREMENTING ITS EXPONENT
|
||
|
||
At11:
|
||
;-----------------------------------------------------------
|
||
; Now must subtract 1 from (A4) in order to use LOGAPPROX,
|
||
; which approximates LOG2(1+S).
|
||
;-----------------------------------------------------------
|
||
PEA FPK1
|
||
PEA (A4)
|
||
ELFSUBX
|
||
|
||
BSR.S LOGAPPROX
|
||
|
||
;-----------------------------------------------------------
|
||
; Add L in. Exit via check to see whether to multiply by LN(2).
|
||
;-----------------------------------------------------------
|
||
PEA STW(A6)
|
||
PEA (A4)
|
||
ELFADDX
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Finish up with a multiply by LN(2) if a natural log was requested.
|
||
;-----------------------------------------------------------
|
||
LOGFINI:
|
||
BTST #BTLOGBASE2,D3
|
||
BNE.S @1
|
||
|
||
PEA FPKLOGE2
|
||
PEA (A4)
|
||
ELFMULX ; LOG2(X) * LN(2)
|
||
@1:
|
||
BRA RESULTDELIVERED
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Compute LOG2(1+S) for S between SQRT(1/2) and SQRT(2).
|
||
; Assume all special cases have been filtered out and that
|
||
; number (A4) is indeed within range.
|
||
; Let R := S / (2 + S).
|
||
; Then LOGAPPROX := R * P(R*R) / Q(R*R),
|
||
; where the coefficients are taken from LOG21P and LOG21Q.
|
||
;
|
||
; Leave cell W alone, for use by LOG2R.
|
||
; Use cell Y for R, X for R*R.
|
||
; Use (A4) for R * P(R*R); then Y for Q(R*R).
|
||
; Registers A0-A2 are used by the POLYEVAL.
|
||
;
|
||
; To avoid spurious inexact, filter out 0.
|
||
; To keep accuracy, filter out denorms.
|
||
;-----------------------------------------------------------
|
||
LOGAPPROX:
|
||
PEA (A4) ; INPUT OPERAND X
|
||
PEA STJ(A6) ; CELL J FOR CLASS
|
||
ELFCLASSX ; LEAVES -6, ..., 6 IN CELL J
|
||
MOVE.W STJ(A6),D0
|
||
BPL.S @1
|
||
NEG.W D0
|
||
@1
|
||
SUBQ.W #FCZERO,D0 ; QUICK EXIT IF ZERO, #FCZERO=4
|
||
BNE.S LANONZERO
|
||
RTS
|
||
|
||
LANONZERO:
|
||
SUBQ.W #1,D0 ; #FCNORM=5, #FCDENORM=6
|
||
BEQ.S LANORMAL
|
||
|
||
;-----------------------------------------------------------
|
||
; Since log2(1 + tiny) = ln(1 + tiny) / ln(2) and ln(1 + tiny) is tiny + ...
|
||
; just divide denorm by ln(2) and return. Share exit code with main computation.
|
||
;-----------------------------------------------------------
|
||
PEA FPKLOGE2
|
||
BSR FORCEUFLOW
|
||
BRA.S LAFINI
|
||
|
||
LANORMAL:
|
||
MOVEA.L A4,A0
|
||
LEA STX(A6),A1
|
||
BSR A0TOA1 ; COPY ARGUMENT TO X
|
||
|
||
PEA FPK2
|
||
PEA (A4)
|
||
ELFADDX ; S := S + 2
|
||
|
||
PEA (A4)
|
||
PEA (A1) ; ADRS OF CELL X
|
||
ELFDIVX ; X := S / S + 2
|
||
|
||
MOVEA.L A1,A0 ; ADRS OF CELL X
|
||
PEA (A1) ; TWO COPIES FOR SQUARE
|
||
PEA (A1)
|
||
LEA STY(A6),A1 ; ADRS OF CELL Y
|
||
BSR A0TOA1 ; Y := R
|
||
|
||
ELFMULX ; X := R * R
|
||
|
||
;-----------------------------------------------------------
|
||
; Evaluate P(R*R) into (A4).
|
||
;-----------------------------------------------------------
|
||
MOVEA.L A4,A0 ; RESULT SLOT
|
||
LEA LOG21P,A1 ; COEFFICIENTS OF P
|
||
LEA STX(A6),A2 ; R*R
|
||
BSR POLYEVAL ; P(R*R)
|
||
|
||
;-----------------------------------------------------------
|
||
; Evaluate R * P(R*R) into (A4); then finished with R in Y.
|
||
;-----------------------------------------------------------
|
||
PEA STY(A6) ; R
|
||
PEA (A4) ; P(R*R)
|
||
ELFMULX ; R * P(R*R)
|
||
|
||
;-----------------------------------------------------------
|
||
; Evaluate Q(R*R) into cell Y.
|
||
;-----------------------------------------------------------
|
||
LEA STY(A6),A0 ; RESULT SLOT
|
||
LEA LOG21Q,A1 ; COEFFICIENTS OF Q
|
||
LEA STX(A6),A2 ; R*R
|
||
BSR POLYEVAL ; Q(R*R)
|
||
|
||
;-----------------------------------------------------------
|
||
; Be sure inexact is set (isn't it set in the course of things?) and clear
|
||
; all underflows up to the last step.
|
||
; Finally, divide (R* P(R*R)) in (A4) by Q(R*R) in cell Y.
|
||
;-----------------------------------------------------------
|
||
BSR CLEARUFLOW
|
||
|
||
PEA STY(A6)
|
||
LAFINI:
|
||
PEA (A4)
|
||
ELFDIVX ; (R * P(R*R)) / Q(R*R)
|
||
|
||
BSR FORCEINEXACT
|
||
RTS ; EXIT LOGAPPROX
|
||
|
||
;-----------------------------------------------------------
|
||
; Trailing stubs to deal with special values to be delivered.
|
||
; It is less efficient to use a BSR.S at every label and compute the
|
||
; value's address from the return address on the stack.
|
||
;-----------------------------------------------------------
|
||
P0STUFF:
|
||
LEA FPK0,A0
|
||
BRA.S STUFFVAL
|
||
M0STUFF:
|
||
LEA FPKM0,A0
|
||
BRA.S STUFFVAL
|
||
P1STUFF:
|
||
LEA FPK1,A0
|
||
BRA.S STUFFVAL
|
||
M1STUFF:
|
||
LEA FPKM1,A0
|
||
BRA.S STUFFVAL
|
||
DIVP0STUFF:
|
||
BSR FORCEDIVZER
|
||
PINFSTUFF:
|
||
LEA FPKINF,A0
|
||
BRA.S STUFFVAL
|
||
DIVM0STUFF:
|
||
BSR FORCEDIVZER
|
||
MINFSTUFF:
|
||
LEA FPKMINF,A0 ; AND FALL THROUGH...
|
||
|
||
|
||
STUFFVAL:
|
||
MOVEA.L A4,A1 ; DST ADRS
|
||
BSR A0TOA1 ; STUFF THE VAL
|
||
STUFFEXIT:
|
||
BRA.S RESULTDELIVERED
|
||
|
||
|
||
;-----------------------------------------------------------
|
||
; Fabricate a silent NAN, set Invalid, and deliver to destination.
|
||
; D0.B should be a nonzero byte code.
|
||
;-----------------------------------------------------------
|
||
ERRORNAN:
|
||
ORI.L #$7FFF4000,D0 ; MAX EXP AND QNANBIT SET! <01APR85>
|
||
MOVE.L D0,(A4)+
|
||
CLR.L (A4)+
|
||
CLR.W (A4)
|
||
SUBQ.L #8,A4
|
||
BSR FORCEINVALID
|
||
|
||
;-----------------------------------------------------------
|
||
; FALL THROUGH TO...
|
||
;-----------------------------------------------------------
|
||
|
||
;-----------------------------------------------------------
|
||
; Finally, a result has been placed in (A4). Restore the environment,
|
||
; signaling any required exceptions, restore the registers,
|
||
; clean up the stack, and go. The return address has been written onto the
|
||
; deepest operand address, and the high word of the old return address is
|
||
; an integer count of the amount of stack to kill to get to the true return
|
||
; address.
|
||
;-----------------------------------------------------------
|
||
RESULTDELIVERED:
|
||
;-----------------------------------------------------------
|
||
; The first step is to expand the 80-bit result to 96 bits if
|
||
; the operation is for the latter format. In this case, A4
|
||
; contains &DST + 2, and the sign/exponent must simply be
|
||
; copied from (A4) to -2(A4).
|
||
;-----------------------------------------------------------
|
||
TST.B D3 ; 96-bit result required?
|
||
BPL.S @1 ; no. 80-bit OK
|
||
|
||
MOVE.W (A4),-2(A4) ; yes. copy sign/exp to lead word
|
||
|
||
;-----------------------------------------------------------
|
||
; Restore from environment word
|
||
;-----------------------------------------------------------
|
||
@1:
|
||
PEA STENV(A6)
|
||
ELFPROCEXIT
|
||
;-----------------------------------------------------------
|
||
; Clean up the regs and exit.
|
||
;-----------------------------------------------------------
|
||
|
||
MOVEM.L (SP)+,D0-D7/A0-A4 ; RESTORE ALL REGS
|
||
UNLK A6
|
||
ADDA.W (SP),SP
|
||
RTS
|