mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-06-10 06:29:34 +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.
891 lines
21 KiB
Plaintext
891 lines
21 KiB
Plaintext
;
|
|
; File: Elems68K1.a
|
|
;
|
|
; Copyright: © 1988-1991 by Apple Computer, Inc., all rights reserved.
|
|
;
|
|
; This file is used in these builds: Mac32
|
|
;
|
|
; Change History (most recent first):
|
|
;
|
|
; <4> 5/21/91 gbm Nail a couple of warnings
|
|
; <3> 9/15/90 BG Removed <2>. 040s are behaving more reliably now.
|
|
; <2> 7/4/90 BG Added EclipseNOPs to deal with flakey 040s.
|
|
; <1.1> 11/11/88 CCH Fixed Header.
|
|
; <1.0> 11/9/88 CCH Adding to EASE.
|
|
; <1.1> 5/16/88 BBM FBcc -> FBccL (new macros that donÕt conflict w/ 881) <1.1>
|
|
; <1.0> 2/12/88 BBM Adding file for the first time into EASEÉ
|
|
|
|
;m1 1
|
|
;m4 7
|
|
;he ''MAC Elementary Functions''
|
|
;fo 'ELEMS68K1.ASM'Page %'14 JAN 85'
|
|
; File: ELEMS68K1.TEXT
|
|
|
|
;ne 100
|
|
|
|
;
|
|
; 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...
|
|
; 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
|
|
STLOCK EQU -48 ; HIGH WORD OF HANDLE
|
|
|
|
STFRAMESIZE EQU -48 ; 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 NNNN NNN0
|
|
; where X=1 for 2- or 3-address functions, Y=1 for 3-address functions,
|
|
; and <NNNN 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 $00FE ; MASK FOR JUMP TABLE INDEX
|
|
OPXPWRI EQU $8010 ; OPCODE FOR X^I
|
|
|
|
|
|
;
|
|
; For scaling via FSCALBX, integer argument must be kept less than the
|
|
; maximum magnitude in a 16-bit integer. When outlandish scaling is
|
|
; r.EQUired 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
|
|
|
|
;ne 100
|
|
;
|
|
; First allocate a stack frame as described above and save registers.
|
|
; Use conditional assembly to 'protect' Lisabug from Mac Package header.
|
|
;
|
|
IF fpformac+fpfordeb THEN
|
|
|
|
BRA.S START
|
|
|
|
DC.W $00
|
|
DC.L ('PACK')
|
|
DC.W $5
|
|
DC.W $0001
|
|
|
|
ENDIF
|
|
|
|
START
|
|
LINK A6,#STFRAMESIZE ; ALLOCATE TEMP CELLS
|
|
MOVEM.L D0-D7/A0-A4,-(SP) ; PRESERVE WORKING REGS
|
|
CLR.L D3 ; ERROR BITS AND OPCODE
|
|
|
|
IF FPFORMAC THEN
|
|
IF ROMRSRC THEN
|
|
; NO HASSLE IF ROM RSRC
|
|
ELSE
|
|
MOVE.L APPPACKS+20,A0 ; HANDLE TO PACK5
|
|
MOVE.B (A0),STLOCK(A6) ; SAVE STATE OF LOCK BIT
|
|
BSET #LOCK,(A0) ; LOCK PACKAGE
|
|
ENDIF ; ROMRSRC
|
|
ENDIF ; FORMAC
|
|
|
|
|
|
;
|
|
; Load the registers as follows:
|
|
; 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 s.EQUence at label RESULTDELIVERED.
|
|
;
|
|
LEA STRET(A6),A3 ; POINT TO RET ADRS
|
|
LEA STOPCODE(A6),A0 ; POINT INTO STACK ARGS
|
|
MOVE.W (A0)+,D3 ; GET OPCODE
|
|
BPL.S 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.
|
|
;
|
|
MOVE.L (A3),(A0) ; RET ADRS ON SRC ADRS
|
|
MOVE.W #KI2ADRS,(A3) ; STACK KILL COUNT
|
|
MOVE.L A4,D5 ; PRETEND THERE'S A SRC2
|
|
|
|
MOVEQ #15,D2 ; PRESET SRC CLASS IN CASE X^I
|
|
CMPI.W #OPXPWRI,D3 ; SPECIAL CASE WITH INTEGER OP
|
|
BEQ.S CLASSSKIP
|
|
CLASSCOM
|
|
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
|
|
MOVE.L (A3),(A0) ; RET ADRS ON SRC ADRS
|
|
MOVE.W #KI3ADRS,(A3) ; STACK KILL COUNT
|
|
BRA.S CLASSCOM
|
|
|
|
;
|
|
; 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
|
|
FCLASSX ; 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
|
|
MOVE.L (A3),(A0) ; RET ADRS
|
|
MOVE.W #KI1ADRS,(A3) ; 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
|
|
;ne 100
|
|
;
|
|
; 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
|
|
;
|
|
PEA STENV(A6) ; A0 POINTS TO ENV SAVE SLOT
|
|
FPROCENTRY
|
|
|
|
;
|
|
; 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
|
|
FADDX
|
|
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
|
|
FX2X
|
|
NANEXIT
|
|
BRA RESULTDELIVERED
|
|
NONANS
|
|
|
|
;ne 100
|
|
;
|
|
; 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
|
|
;
|
|
;
|
|
;
|
|
; .WORD $FFFF ; BREAKPOINT FOR DEBUGGING
|
|
;
|
|
;
|
|
;
|
|
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
|
|
|
|
;ne 100
|
|
;
|
|
; 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
|
|
PEA (A1) ; ADDRESS OF LEADING COEF
|
|
PEA (A0) ; ADDRESS OF ACCUM
|
|
FX2X
|
|
POLYLOOP
|
|
PEA (A2)
|
|
PEA (A0)
|
|
FMULX ; ACCUM <-- ACCUM * X
|
|
ADDQ.L #8,A1 ; SKIP 10 BYTES TO NEXT
|
|
ADDQ.L #2,A1 ; ...COEFFICIENT
|
|
PEA (A1)
|
|
PEA (A0)
|
|
FADDX ; 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 by getting, tweaking, and restoring the
|
|
; environment word.
|
|
; 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
|
|
SUBQ.L #2,SP ; ALLOCATE WORD
|
|
PEA (SP)
|
|
FGETENV
|
|
BCLR D0,(SP) ; XCP BIT IN HI BYTE
|
|
PEA (SP)
|
|
FSETENV
|
|
CLEAREXIT
|
|
ADDQ.L #2,SP
|
|
TST.B D0 ; FINISH FOR TEST
|
|
RTS
|
|
|
|
|
|
;
|
|
; Utility to force an flag.
|
|
; 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
|
|
MOVE.W D0,-(SP)
|
|
PEA (SP)
|
|
FSETXCP
|
|
BRA.S CLEAREXIT
|
|
|
|
;
|
|
; 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
|
|
MOVE.W D0,-(SP)
|
|
PEA (SP)
|
|
FTESTXCP
|
|
MOVE.B (SP),D0 ; RESULT IN HI BYTE
|
|
BRA.S CLEAREXIT
|
|
|
|
;
|
|
; Floating scalb function computes (A0) <-- (A0) * 2^(A1)
|
|
; Because of the 15-bit exponent range, just two invocations
|
|
; of FSCALBX are r.EQUired if an over/underflow is to be stimulated.
|
|
; A0, A1, and (A1) are not modified.
|
|
; Uses: cells J and Y, A3
|
|
;
|
|
SCALBXX
|
|
MOVE.W #MAXINT,STJ(A6) ; SEEDED INTEGER SLOT
|
|
LEA STY+10(A6),A3 ; BEYOND CELL Y
|
|
MOVE.L 6(A1),-(A3) ; COPY OF (A1)
|
|
MOVE.L 2(A1),-(A3)
|
|
MOVE.W (A1),-(A3)
|
|
|
|
BCLR #7,(A3) ; ABS (A1) COPY
|
|
|
|
;
|
|
; If (SP) is larger than MAXINT then do one step of scaling by MAXINT.
|
|
;
|
|
BSR.S VSMAXINT
|
|
FBGES SKIPFIRSTSCALB ; FLOATING >=
|
|
|
|
;
|
|
; Must diminish (A3) by FPKMAXINT.
|
|
;
|
|
PEA FPKMAXINT
|
|
PEA (A3)
|
|
FSUBX
|
|
|
|
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.
|
|
;
|
|
SKIPFIRSTSCALB
|
|
BSR.S VSMAXINT ; (SP) VS FPMAXINT
|
|
FBGES At1 ; FLOATING >= ???? was local @1
|
|
|
|
PEA FPKMAXINT
|
|
BRA.S At3 ; ???? was local @3
|
|
At1 ; ???? was local @1
|
|
PEA (A3) ; USE REDUCED VALUE
|
|
At3 ; ???? was local @3
|
|
PEA STJ(A6) ; ADDRESS OF INT SLOT
|
|
FX2I
|
|
|
|
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)
|
|
FSCALBX
|
|
RTS
|
|
|
|
;
|
|
; Compare STY(A6) with FPMAXINT.
|
|
;
|
|
VSMAXINT
|
|
PEA STY(A6)
|
|
PEA FPKMAXINT
|
|
FCMPX
|
|
RTS
|
|
;ne 100
|
|
;
|
|
; 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 r.EQUired, the computation is cast in the form
|
|
; log2(1+z). The only difference between LN and LOG2 is that the
|
|
; former r.EQUires a final multiplication by LN(2).
|
|
;
|
|
; The four functions are distinguished by the BTLOGBASE2 and
|
|
; BDLOG1PLUSX bits as described in the .EQU 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
|
|
FCMPX
|
|
FBUGTS LOGERROR ; -1 > OPERAND --> ERROR
|
|
FBLTS LOG12R ; FIND LOG(1+X)
|
|
; FALL THROUGH WHEN = -1
|
|
LOG0
|
|
BRA DIVM0STUFF
|
|
; END OF SPECIAL CASES
|
|
|
|
;ne 100
|
|
;
|
|
; 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)
|
|
FADDX ; W <-- 1+T
|
|
|
|
;
|
|
; Now compare with bounds SQRT(1/2) and SQRT(2).
|
|
;
|
|
PEA FPKSQRTHALF
|
|
PEA (A4)
|
|
FCMPX
|
|
FBULES LOG2R
|
|
|
|
PEA (A4)
|
|
PEA FPKSQRT2
|
|
FCMPX
|
|
FBLES LOG2R
|
|
|
|
;
|
|
; Input T is within the r.EQUired 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 LOGAPPROX
|
|
BRA LOGFINI
|
|
|
|
;ne 100
|
|
;
|
|
; 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)
|
|
FLOGBX
|
|
|
|
;
|
|
; Then scale T down to range 1 to 2. Use custom scale function with a
|
|
; floating number as the second argument.
|
|
;
|
|
BCHG #7,(A1) ; -L IN W
|
|
MOVEA.L A4,A0
|
|
BSR SCALBXX ; (A0) <-- (A0) * 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)
|
|
FCMPX
|
|
FBULEL At11 ; ???? was local @1 <1.1>
|
|
|
|
PEA FPK1
|
|
PEA STW(A6)
|
|
FADDX ; INCREMENT L
|
|
|
|
PEA FPK2
|
|
PEA (A4)
|
|
FDIVX ; DIVIDE T BY 2
|
|
At11 ; ???? was local @1
|
|
|
|
;
|
|
; Now must subtract 1 from (A4) in order to use LOGAPPROX,
|
|
; which approximates LOG2(1+S).
|
|
;
|
|
PEA FPK1
|
|
PEA (A4)
|
|
FSUBX
|
|
|
|
BSR LOGAPPROX
|
|
|
|
;
|
|
; Add L in. Exit via check to see whether to multiply by LN(2).
|
|
;
|
|
PEA STW(A6)
|
|
PEA (A4)
|
|
FADDX
|
|
|
|
|
|
;
|
|
; Finish up with a multiply by LN(2) if a natural log was r.EQUested.
|
|
;
|
|
LOGFINI
|
|
BTST #BTLOGBASE2,D3
|
|
BNE.S @1
|
|
|
|
PEA FPKLOGE2
|
|
PEA (A4)
|
|
FMULX ; LOG2(X) * LN(2)
|
|
@1
|
|
BRA RESULTDELIVERED
|
|
|
|
|
|
;ne 100
|
|
;
|
|
; 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
|
|
FCLASSX ; 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)
|
|
FADDX ; S := S + 2
|
|
|
|
PEA (A4)
|
|
PEA (A1) ; ADRS OF CELL X
|
|
FDIVX ; 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
|
|
|
|
FMULX ; 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)
|
|
FMULX ; 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)
|
|
FDIVX ; (R * P(R*R)) / Q(R*R)
|
|
|
|
BSR FORCEINEXACT
|
|
RTS ; EXIT LOGAPPROX
|
|
|
|
;ne 100
|
|
;
|
|
; 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...
|
|
|
|
;ne 100
|
|
;
|
|
; Finally, a result has been placed in (A4). Restore the environment,
|
|
; signaling any r.EQUired 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
|
|
;
|
|
; Restore from environment word
|
|
;
|
|
PEA STENV(A6)
|
|
FPROCEXIT
|
|
;
|
|
; Clean up the regs and exit. Unlike foolishness of May 84, move the state of
|
|
; STLOCK(A6) back to package handle.
|
|
;
|
|
IF FPFORMAC THEN
|
|
IF ROMRSRC THEN
|
|
; NO HASSLE
|
|
ELSE
|
|
MOVE.L APPPACKS+20,A0 ; HANDLE TO PACKAGE
|
|
MOVE.B STLOCK(A6),(A0) ; RESTORE PREVIOUS STATE <26Mar85>
|
|
ENDIF ; ROMRSRC
|
|
ENDIF ; FPFORMAC
|
|
|
|
MOVEM.L (SP)+,D0-D7/A0-A4 ; RESTORE ALL REGS
|
|
UNLK A6
|
|
ADDA.W (SP),SP
|
|
RTS
|
|
|
|
|