mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-09-06 18:54:30 +00:00
1246 lines
36 KiB
Plaintext
1246 lines
36 KiB
Plaintext
|
;
|
|||
|
; File: ELEMS020_1.a
|
|||
|
;
|
|||
|
; Copyright: <09> 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
|
|||
|
|