mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2025-02-21 04:28:58 +00:00
0ba83392d4
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.
1582 lines
52 KiB
Plaintext
1582 lines
52 KiB
Plaintext
;
|
|
; File: Munger.a
|
|
;
|
|
; Contains: Byte String munger
|
|
;
|
|
; Copyright: © 1986-1992 by Apple Computer, Inc., all rights reserved.
|
|
;
|
|
; Change History (most recent first):
|
|
;
|
|
; <SM3> 10/22/92 CSS Fixed short branch to regular branches.
|
|
; <SM2> 5/21/92 kc Append "Trap" to the names of HandToHand, PtrToXHand, PtrToHand,
|
|
; HandAndHand and PtrAndHand to avoid name conflict with the glue.
|
|
; <6> 2/10/92 JSM Moved this file to Munger folder, keeping all the old revisions.
|
|
; <5> 10/17/91 JSM Cleanup header, roll-in FixTypoInFixAtan2 patch from
|
|
; MungerPatches.a, remove non-68020 code since we'll never build
|
|
; another 68000 ROM, remove 68881 code which was never used.
|
|
; <4> 9/28/90 SAM Removed EclipseNOPs that were breaking the 68000 builds.
|
|
; <3> 9/13/90 BG Removed <2>. 040s are behaving more reliably now.
|
|
; <2> 6/22/90 CCH Added some NOPs for flaky 68040's.
|
|
; <C914> 10/29/87 rwh Port to Modern Victorian
|
|
; 12/9/86 JTC Back out until state issues resolved.
|
|
; <C412> 11/17/86 JTC Add conditional code to implement fixed-pt elems using Ô881.
|
|
; <A343> 11/3/86 JTC fixed fixDiv/FracDiv problem. Fixed or frac results with a one
|
|
; bit in bit #31 is falsely forced to the overflow value.
|
|
; <A279> 10/27/86 JTC Changed two addq instructions to addq.l instructions in Munger.a
|
|
; to fix a small rounding problem in the fixed point routines.
|
|
; 10/20/86 CRC Added 68020 specific flavors of LongMul, FixMul, FracMul,
|
|
; FixRatio
|
|
; <C206> 10/9/86 bbm Modified to mpw aincludes.
|
|
; <C169> 9/23/86 JTC Replace master ptr bit twiddling with mem mgr calls.
|
|
; 2/19/86 BBM Made some modifications to work under MPW
|
|
; 8/28/85 BBM Temporarily restored ForRAM Equate
|
|
; 7/26/85 RDC Removed ForRAM equate (included in Newequ file)
|
|
; 5/13/85 SC Exit bug w/d0 in munger
|
|
; 5/8/85 SC Added new trap XMunger
|
|
; 5/8/85 SC Fixed bug in 4 May work and cleaned up
|
|
; 5/4/85 SC Sped up munger per Ernie suggestions and TextEdit needs. New
|
|
; local blockmove proc avoids dispatch for 0-1 bytes moved. Only
|
|
; one _SetHandleSize and one less _BlockMove on replace calls
|
|
; 4/23/85 JTC Added fixed-point stuff.
|
|
; 4/16/85 SC Made HandAndHand more robust, doesn't allow source or dest to
|
|
; purge.
|
|
; 1/29/85 EHB Added fix to make returned offset correct (=offset + length 2)
|
|
; 1/28/85 EHB Added fix to make compare respect string boundaries In
|
|
; HandToHand, make original Handle unpurgeable, and if original
|
|
; already purged, then don't try to clone it.
|
|
; 1/23/85 LAK Adapted for new equate files.
|
|
;
|
|
|
|
MACHINE MC68020
|
|
|
|
; WARNING: CHANGE HISTORIES APPEAR AT THREE DIFFERENT PLACES IN
|
|
; THIS FILE. MAKE SURE YOU CHECK ALL THREE.
|
|
; (I know this should be cleaned up, some day it will.)
|
|
;---------------------------------------------------------------
|
|
; Fixed-point code added 21 Apr 85 by JTC.
|
|
; MacApp method code added 08 May 85 by JTC.
|
|
; More fixed-point code added 13 May 85 JTC.
|
|
;---------------------------------------------------------------
|
|
|
|
;---------------------------------------------------------------
|
|
;
|
|
; Byte String munger
|
|
;
|
|
; FUNCTION Munger( h0: Handle; o0: LONGINT;
|
|
; p1: Pointer; l1: LONGINT;
|
|
; p2: Pointer; l2: LONGINT ): LONGINT
|
|
;
|
|
; This routine performs various byte-string manipulations. The general
|
|
; theme is that handle "h0" (indirectly pointing to an uninterpereted
|
|
; string of bytes) is operated on starting at or beyond byte-offset
|
|
; "o0" The pointer/length tuple (p1,l1) defines a substring to
|
|
; be replaced with the second substring (p2,l2). There are many
|
|
; variations depending on which parameters are nullified by passing
|
|
; a zero.
|
|
;
|
|
; The fully expanded arguments will search h starting at o and replace
|
|
; the first occurence of (p1,l1) with (p2,l2).
|
|
;
|
|
; The variations are:
|
|
;
|
|
; If p1 = 0 the substring defined by offset "o0" of length "l1" will be
|
|
; replaced by the substring (p2,l2). The length parameter l1 can be
|
|
; set negative to define substring from o0 to the end of string at H
|
|
;
|
|
; If l1 = 0 the substring (p2,l2) will simply be inserted at offset "o0"
|
|
;
|
|
; If p2 = 0 no replacement or deletion will occur; this, with the function
|
|
; return value, is useful for locating substrings in h
|
|
;
|
|
; If l2 = 0 the substring used for replacing is null so a delete will
|
|
; occur in all the above cases
|
|
;
|
|
; The function returned value is the final offset at which the replacement
|
|
; occurs. A negative value implies the substring couldn't be found in
|
|
; the case of a search. Or was out of range in the case of an offset-type
|
|
; specification.
|
|
;
|
|
;-----------------------------------------------------------------------
|
|
|
|
BLANKS ON
|
|
STRING ASIS
|
|
|
|
LOAD 'StandardEqu.d'
|
|
|
|
Bytes PROC EXPORT
|
|
|
|
EXPORT Munger ; Munger 100% U.S. RDA
|
|
EXPORT XMunger ; X-tra Munger <11May85>
|
|
|
|
; local defs
|
|
|
|
sloppy EQU -4 ; local copy of slop factor <11May85>
|
|
physical EQU sloppy-4 ; physical handle size <11May85>
|
|
mungeLink EQU physical ; munger stack frame <11May85>
|
|
|
|
; parameter defs for both Munger and XMunger <11May85>
|
|
|
|
h0 EQU 28 ; 4 bytes - Handle
|
|
o0 EQU 24 ; 4 bytes - offset
|
|
p1 EQU 20 ; 4 bytes - pointer 1
|
|
l1 EQU 16 ; 4 bytes - length 1
|
|
p2 EQU 12 ; 4 bytes - pointer 2
|
|
l2 EQU 8 ; 4 bytes - length 2
|
|
|
|
return EQU 32 ; 4 bytes - return value
|
|
mungeParams EQU 24 ; nBytes of parameters
|
|
|
|
Munger
|
|
LINK A6,#mungeLink ; <11May85>
|
|
MOVEM.L D2-D7/A2-A4,-(SP) ; save regs <11May85>
|
|
|
|
MOVE.L h0(A6),A2 ; get handle <11May85>
|
|
MOVE.L A2,A0 ; Get handle size <11May85>
|
|
_GetHandleSize
|
|
MOVE.L D0,D5 ; save it as logical size <11May85>
|
|
MOVE.L D0,physical(A6) ; save it physical too <11May85>
|
|
CLR.L sloppy(A6) ; we must be neat <11May85>
|
|
|
|
BSR.S MungeGuts ; it's the real thing <11May85>
|
|
|
|
MOVE.L D2,return(A6) ; return offset <11May85>
|
|
|
|
MOVEQ #mungeParams,D1 ; fix up stack <13May85>
|
|
mungeBye
|
|
MOVEM.L (SP)+,D2-D7/A2-A4 ; restore regs <11May85>
|
|
UNLK A6 ; <11May85>
|
|
MOVE.L (SP)+,A0 ; return address <11May85>
|
|
ADD D1,SP ; fix up stack <13May85>
|
|
JMP (A0) ; <11May85>
|
|
|
|
; FUNCTION XMunger( slop: LONGINT; h0: Handle; o0: LONGINT; <11May85>
|
|
; p1: Pointer; l1: LONGINT; <11May85>
|
|
; p2: Pointer; l2: LONGINT ): LONGINT <11May85>
|
|
|
|
logical EQU 36 ; logical size - LONGINT <11May85>
|
|
slop EQU 32 ; slop value - LONGINT <11May85>
|
|
xReturn EQU 40 ; 4 bytes - return value <11May85>
|
|
xMungeParam EQU 32 ; nBytes of parameters <11May85>
|
|
|
|
XMunger
|
|
LINK A6,#mungeLink ; <11May85>
|
|
MOVEM.L D2-D7/A2-A4,-(SP) ; save regs <11May85>
|
|
|
|
MOVE.L h0(A6),A2 ; get handle <11May85>
|
|
MOVE.L A2,A0 ; Get handle size <11May85>
|
|
_GetHandleSize
|
|
MOVE.L D0,physical(A6) ; save it physical too <11May85>
|
|
MOVE.L logical(A6),D5 ; get the logical size <11May85>
|
|
|
|
MOVE.L slop(A6),sloppy(A6) ; relocate slop value <11May85>
|
|
BSR.S MungeGuts ; it's the real thing <11May85>
|
|
|
|
MOVE.L D2,xReturn(A6) ; return offset <11May85>
|
|
|
|
MOVEQ #xMungeParam,D1 ; fix up stack <13May85>
|
|
BRA mungeBye ; <11May85>
|
|
|
|
; This is the real munger code, all parameters are off A6 except slop
|
|
|
|
; Register usage:
|
|
;
|
|
; A2 contains handle to be munged
|
|
; D5 contains handle's size
|
|
; D2 contains offset o0 (and modified to contain return value)
|
|
; A3 contains pointer one p1
|
|
; D3 contains length one l1
|
|
; A4 contains pointer two p2
|
|
; D4 contains length two l2
|
|
|
|
MungeGuts
|
|
; MOVE.L h0(A6),A2 ; get handle
|
|
; MOVE.L A2,A0 ; Get handle size
|
|
; _GetHandleSize
|
|
; MOVE.L D0,D5 ; save it away
|
|
; MOVE.L D0,incisor(A6) ; save it here too
|
|
|
|
MOVE.L o0(A6),D2 ; get offset
|
|
MOVE.L p1(A6),A3 ; get pointer 1
|
|
MOVE.L p2(A6),A4 ; get pointer 2
|
|
MOVE.L l1(A6),D3 ; get length 1
|
|
BEQ doInsert ; if l1 = 0 do insertion only
|
|
|
|
BPL.S notInfinite ; see if l1 is funny
|
|
fixL1
|
|
MOVE.L D5,D3 ; l1 = length - o0
|
|
SUB.L D2,D3
|
|
notInfinite
|
|
MOVE.L D5,D0 ; Get length
|
|
SUB.L D3,D0 ; length - (delLength+offset)
|
|
BLT.S notFound ; escape if search > length
|
|
|
|
SUB.L D2,D0 ;
|
|
BLT.S fixL1 ; it's not ok if negative
|
|
|
|
MOVE.L A3,D0 ; test for find op (p1 = 0)?
|
|
BEQ doDelete ; <SM3> CSS
|
|
|
|
; Look for substring (p1,l1) starting at "o0"
|
|
|
|
MOVE.L (A2),D6 ; dereference the handle and save
|
|
|
|
MOVE.L D5,D7 ; get size of string
|
|
SUB.L D3,D7 ; subtract l1 <EHB 28-Jan-84>
|
|
ADD.L D6,D7 ; point to last valid search loc
|
|
|
|
ADD.L D2,D6 ; point to first valid loc(add o0)
|
|
|
|
outer
|
|
MOVE.L D3,D1 ; inner loop ctr for compare
|
|
SUBQ.L #1,D1 ; fix up for DBRA <4May85>
|
|
|
|
MOVE.L D6,A0 ; working copy of handle^
|
|
MOVE.L A3,A1 ; working copy of search string
|
|
inner
|
|
CMP.L D6,D7 ; see if anchor if past limit
|
|
BCS.S notFound
|
|
|
|
CMPM.B (A0)+,(A1)+ ; compare bytes
|
|
BNE.S tryNext
|
|
|
|
; SUBQ.L #1,D1 ; -1 next <4May85>
|
|
; BNE.S inner ; <4May85>
|
|
DBRA D1,inner ; <4May85>
|
|
|
|
; If it gets to here, it matched so take the offset and run
|
|
MOVE.L D6,D2 ; set offset to anchor loc and..
|
|
SUB.L (A2),D2 ; subtract orig. to make into offset
|
|
BRA.S tryDelete
|
|
|
|
; The match failed on this byte, move anchor to next and try again
|
|
tryNext
|
|
ADDQ.L #1,D6 ; anchor ++
|
|
BRA.S outer
|
|
|
|
; The match failed entirely, go home with negative code
|
|
notFound
|
|
MOVEQ #-1,D2 ; offset = -1
|
|
BRA.S go2Home
|
|
|
|
; This is a special local version of block move to handle simple cases quickly <4May85>
|
|
; that arise from the brain-damaged textedit calls. <4May85>
|
|
; <4May85>
|
|
bm ; local, faster block move <4May85>
|
|
CMP.L A0,A1 ; identity move? <4May85>
|
|
BEQ.S zeroErr ; skip if so <4May85>
|
|
SUBQ.L #1,D0 ; only move <=1 byte? <4May85>
|
|
BLE.S @0 ; small move? <4May85>
|
|
ADDQ.L #1,D0 ; fix up subtract above <4May85>
|
|
_BlockMove ; move 'em on out <4May85
|
|
RTS ; adios <4May85>
|
|
@0 ; <4May85>
|
|
BLT.S zeroErr ; nothing to move <4May85>
|
|
MOVE.B (A0),(A1) ; special case 1 byte <4May85>
|
|
zeroErr ; <11May85>
|
|
MOVEQ #0,D0 ; must return zero <4May85>
|
|
RTS ; adios <4May85>
|
|
|
|
; Special local cover of sethandlesize. Doesn't shrink the handle if newsize <11May85>
|
|
; is within sloppy(A6) of physical(A6). And, if it grows it, it adds sloppy(A6)<11May85>
|
|
; on for the next time. Since this is called only once per Munger call, it <11May85>
|
|
; doesn;t have to update the physical size. <11May85>
|
|
; <11May85>
|
|
shs ; <11May85>
|
|
MOVE.L D0,-(SP) ; save D0 <11May85>
|
|
SUB.L physical(A6),D0 ; subtract physical size <11May85>
|
|
BEQ.S @0 ; escape if same size <11May85>
|
|
BGT.S @1 ; it must be shrinking to check <11May85>
|
|
NEG.L D0 ; ABS it <11May85>
|
|
CMP.L sloppy(A6),D0 ; within range? <11May85>
|
|
BGT.S @1 ; nope, must set away <11May85>
|
|
@0 ; <11May85>
|
|
ADDQ #4,SP ; drop D0 because we can ignore <11May85>
|
|
BRA zeroErr ; the call - return no error <11May85>
|
|
@1 ; <11May85>
|
|
MOVE.L (SP)+,D0 ; restore D0 <11May85>
|
|
ADD.L sloppy(A6),D0 ; add slop value <11May85>
|
|
_SetHandleSize ; <11May85>
|
|
RTS ; it's been real... <11May85>
|
|
|
|
|
|
; Now delete l1 characters at offset in D2 which contains a possibily modified
|
|
; offset "o0"
|
|
|
|
|
|
tryDelete
|
|
MOVE.L A4,D0 ; if = 0 no deletion/insertion
|
|
BEQ.S go2Home ; just do a find
|
|
|
|
; Delete the substring at o0 (D2) of length l1(D3)
|
|
|
|
doDelete
|
|
MOVE.L l2(A6),D4 ; get length 2 <4May85>
|
|
BNE.S doReplace ; do replace <4May85>
|
|
|
|
MOVE.L D5,D0 ; calc new size
|
|
SUB.L D3,D0 ; = oldsize - l1
|
|
MOVE.L D0,D5 ; save new size
|
|
SUB.L D2,D0 ; amount to move (length - (o0+l1)
|
|
|
|
MOVE.L (A2),A1 ; dereference handle for dest.
|
|
ADD.L D2,A1 ; and add offset o0
|
|
MOVE.L A1,A0 ; source = dest +
|
|
ADD.L D3,A0 ; l1
|
|
|
|
BSR bm ; use our blockmove <4May85>
|
|
; _BlockMove ; <4May85>
|
|
|
|
MOVE.L A2,A0 ; reset size
|
|
MOVE.L D5,D0 ; new size
|
|
|
|
BSR shs ; <11May85>
|
|
; _SetHandleSize ; <11May85>
|
|
go2Home
|
|
BRA.S goHome ; done, go home <4May85>
|
|
|
|
|
|
doInsert
|
|
MOVE.L l2(A6),D4 ; get length 2
|
|
BEQ.S goHome ; if = 0 no insertion go home
|
|
|
|
MOVE.L D5,D0 ; new size = old + l2
|
|
ADD.L D4,D0 ; D5 contains old size
|
|
MOVE.L A2,A0 ; get handle
|
|
BSR shs ; <11May85>
|
|
; _SetHandleSize ; <11May85>
|
|
BNE.S goHome ; escape if error
|
|
|
|
; Make room for new part by sliding over remainder
|
|
MOVE.L (A2),A1 ; dereference handle for dest
|
|
ADD.L D2,A1 ; offset dest by o0
|
|
MOVE.L A1,A0 ; source = dest so far
|
|
ADD.L D4,A1 ; offset dest by l2
|
|
MOVE.L D5,D0 ; nBytes = oldLength -
|
|
SUB.L D2,D0 ; offset -
|
|
BSR bm ; use our blockmove <4May85>
|
|
; _BlockMove ; <4May85>
|
|
|
|
finishUp ; <4May85>
|
|
MOVE.L (A2),A1 ; dereference handle for dest
|
|
ADD.L D2,A1 ; offset dest by o0
|
|
MOVE.L A4,A0 ; source = p2
|
|
MOVE.L D4,D0 ; nBytes = l2
|
|
BSR bm ; use our blockmove <4May85>
|
|
; _BlockMove ; <4May85>
|
|
ADD.L D4,D2 ; return offset + length 2 <EHB 29-Jan-85>
|
|
|
|
goHome
|
|
RTS ; <11May85>
|
|
|
|
; Replace the substring at o0(D2) of length l1(D3) with substring at <8May85>
|
|
; p2(A4) of length l2(D4). Thanks Ernie... <8May85>
|
|
; Decide whether the thing is growing or shrinking. If growing, the handle <8May85>
|
|
; handlesize is set 1st, then the trailing piece moved. If shrinking, the <8May85>
|
|
; piece is moved first, the handleSize set. After that, the new piece is <8May85>
|
|
; inserted <8May85>
|
|
; <8May85>
|
|
doReplace ; <8May85>
|
|
MOVE.L D4,D1 ; start with l2 <8May85>
|
|
SUB.L D3,D1 ; subtract l1 <8May85>
|
|
BEQ.S finishUp ; skip if no change <8May85>
|
|
BGT.S @0 ; handle's growing, bm after <8May85>
|
|
; <8May85>
|
|
BSR.S MoveTail ; move the tail <8May85>
|
|
@0 ; <8May85>
|
|
MOVE.L A2,A0 ; get handle <8May85>
|
|
MOVE.L D5,D0 ; get old size <8May85>
|
|
ADD.L D1,D0 ; add delta l2-l1 <8May85>
|
|
; <8May85>
|
|
BSR shs ; <11May85>
|
|
; _SetHandleSize ; <11May85>
|
|
BNE goHome ; oops <8May85>
|
|
; <8May85>
|
|
; Now slide the trailing piece up to make room for insertion <8May85>
|
|
; <8May85>
|
|
TST.L D1 ; did handle grow? <8May85>
|
|
BMI finishUp ; if so, block move done before <8May85>
|
|
; <8May85>
|
|
BSR.S MoveTail ; move the tail <8May85>
|
|
; <8May85>
|
|
BRA finishUp ; go finish up <8May85>
|
|
MoveTail ; <8May85>
|
|
MOVE.L (A2),A1 ; dereference handle for dest. <8May85>
|
|
ADD.L D2,A1 ; and add offset o0 <8May85>
|
|
; <8May85>
|
|
MOVE.L A1,A0 ; source = dest + <8May85>
|
|
ADD.L D3,A0 ; l1 <8May85>
|
|
ADD.L D4,A1 ; add offset o0 and length l2 <8May85>
|
|
; <8May85>
|
|
MOVE.L D5,D0 ; get old size <8May85>
|
|
SUB.L D3,D0 ; = oldsize - l1 <8May85>
|
|
SUB.L D2,D0 ; amt to move (length - (o0+l1) <8May85>
|
|
; <8May85>
|
|
BRA bm ; use our blockmove <8May85>
|
|
|
|
|
|
;----------------------------------------------------------------------
|
|
;
|
|
; Handle /Pointer clone routines
|
|
;
|
|
;
|
|
; HandToHand takes a handle in A0 and returns a clone in A0
|
|
; PtrToXHand takes a pointer in A0, a handle in A1, and a size in D0. It
|
|
; clones the pointer from A0 into the existing handle in A1
|
|
; PtrToHand takes a pointer in A0, a size in D0 and returns a clone in A0
|
|
; HandAndHand takes handle in A0 and concatenates to handle in A1
|
|
; PtrAndHand takes ptr,length in A0,D0 and concatenates to handle in A1
|
|
;
|
|
; Returns Memory Mgr code in D0
|
|
;
|
|
|
|
EXPORT HandToHandTrap
|
|
EXPORT PtrToXHandTrap
|
|
EXPORT PtrToHandTrap
|
|
EXPORT HandAndHandTrap
|
|
EXPORT PtrAndHandTrap
|
|
|
|
HandToHandTrap
|
|
_HGetState ; D0 <- master ptr state<C169>
|
|
MOVE.B D0,-(SP) ; save for exit <C169>
|
|
MOVE.L A0,-(SP) ; save the handle <EHB 28-Jan-85>
|
|
_HNoPurge ; nonpurgeable for now <C169>
|
|
MOVE.L A0,A1 ; save the handle <EHB 28-Jan-85>
|
|
_GetHandleSize ; and get the size <EHB 28-Jan-85>
|
|
TST.L D0 ; purged handle? <EHB 28-Jan-85>
|
|
BMI.S handRest ; =>yes, exit pronto <EHB 28-Jan-85>
|
|
|
|
MOVE.L D0,D1 ; save length <EHB 28-Jan-85>
|
|
_NewHandle ; <EHB 28-Jan-85>
|
|
MOVE.L (A1),A1 ; dereference source into A1 <EHB 28-Jan-85>
|
|
BSR.S cloneCommon ; <EHB 28-Jan-85>
|
|
handRest
|
|
; Get here with D0=error code, A0=result ptr. Must perserve<C169>
|
|
; them while restoring mp state from stack. D1/A1 are free.
|
|
MOVE.L D0,D1 ; <C169>
|
|
MOVE.L A0,A1 ; <C169>
|
|
MOVE.L (SP)+,A0 ; restore handle <EHB 28-Jan-85> <C169>
|
|
MOVE.B (SP)+,D0 ; <EHB 28-Jan-85> <C169>
|
|
_HSetState ; <C169>
|
|
MOVE.L D1,D0 ; restore saved results <C169>
|
|
MOVE.L A1,A0 ; <C169>
|
|
RTS ; <EHB 28-Jan-85>
|
|
|
|
PtrToXHandTrap
|
|
EXG A0,A1 ; save source pointer
|
|
MOVE.L D0,D1 ; save length
|
|
_SetHandleSize ; Set the handle length
|
|
BRA.S cloneCommon
|
|
PtrToHandTrap
|
|
MOVE.L A0,A1 ; save source pointer
|
|
MOVE.L D0,D1 ; save length
|
|
_NewHandle
|
|
|
|
; A0 contains dest. handle, A1 contains source pointer, D2 offset into dest, D1
|
|
; amount to move
|
|
|
|
cloneCommon
|
|
BNE.S noRoom ; didn't get space, so skip
|
|
MOVEQ #0,D2 ; no offset for these
|
|
clone2Common
|
|
MOVE.L A0,-(SP) ; save handle for return
|
|
MOVE.L (A0),A0 ; dereference
|
|
ADD.L D2,A0 ; add in offset (=0 most times)
|
|
EXG A0,A1 ; switch source/dest
|
|
MOVE.L D1,D0 ; restore length
|
|
_BlockMove ; counts on D0 being returned 0
|
|
|
|
MOVE.L (SP)+,A0 ; get handle for return
|
|
noRoom
|
|
RTS
|
|
|
|
; Concatenates handle in A0 onto handle in A1
|
|
|
|
HandAndHandTrap
|
|
_HGetState ; D0 <- mp state <C169>
|
|
MOVE.B D0,-(SP) ; save across call <C169>
|
|
MOVE.L A0,-(SP) ; save the handle
|
|
_HNoPurge ; <C169>
|
|
|
|
_GetHandleSize ; and get the size
|
|
TST.L D0 ; purged handle?
|
|
BMI.S handRest ; =>yes, exit pronto
|
|
|
|
MOVE.L D0,D1 ; save add-on length
|
|
|
|
EXG A1,A0 ; get dest handle
|
|
_GetHandleSize
|
|
|
|
MOVE.L D0,D2 ; save existing length
|
|
BMI.S handRest ; error in dest exit pronto
|
|
|
|
ADD.L D1,D0 ; add in new length
|
|
_SetHandleSize
|
|
BNE.S handRest ; escape if error
|
|
|
|
MOVE.L (A1),A1 ; dereference source
|
|
BSR clone2Common ; go do it
|
|
BRA handRest
|
|
|
|
PtrAndHandTrap
|
|
MOVE.L D0,D1 ; save add-on length
|
|
|
|
EXG A1,A0 ; get dest handle
|
|
_GetHandleSize
|
|
MOVE.L D0,D2 ; save existing length
|
|
ADD.L D1,D0 ; add in new length
|
|
_SetHandleSize
|
|
BNE.S noRoom ; escape if error
|
|
BRA.S clone2Common ; go do it
|
|
|
|
;-------------------------------------------------------------------
|
|
; Pulled from file: Method.TEXT
|
|
;
|
|
; PROCEDURE MethodDispatch ( 'uses nonstandard stack params ' );
|
|
; (SP) = selector table address
|
|
; 4(SP) = actual return address
|
|
; 8(SP) = receiver
|
|
; 07 May 85 JTC Written by MacApp group -- typed by their new AA!
|
|
; 17 Jun 86 DBG Tweaks for performance
|
|
;-------------------------------------------------------------------
|
|
EXPORT MethodDispatch
|
|
MethodDispatch
|
|
MoveA.L (SP)+,A0 ; A0 := Method table address
|
|
MoveA.L 4(SP),A1 ; A1 := receiver handle
|
|
MoveA.L (A1),A1 ; A1 := receiver ptr
|
|
Move.W (A1),D0 ; D0 := receiver's class #
|
|
Move.W (A0)+,D1 ; D1 := number of implementations of method (-1)
|
|
Cmp.W (A0),D0 ; cached class # versus receiver class #
|
|
BNE.S search ; Not Equal => must search table
|
|
jmpMeth
|
|
Move.W 2(A0),D0 ; D0 := A5/A0 relative offset to method
|
|
BClr #0,D0 ; 0=>A5; 1=>A0
|
|
BNE.S A0Rel ; 1 => do A0
|
|
Jmp 0(A5,D0.W) ; via Jump Table
|
|
A0Rel
|
|
Jmp 2(A0,D0.W) ; jump to method, A0 pointing to word before offset
|
|
search
|
|
Move.W D0,(A0) ; cache the class #
|
|
Move.L A0,D2 ; D2 := cache address
|
|
loopa
|
|
AddQ.L #4,A0 ; A0 := ptr to next class # in table
|
|
Cmp.W (A0),D0 ; next class # versus given class #
|
|
DBCC D1,loopa ; fall through if (A0) unsigned <= D0
|
|
BEq.S found ; Eq => found it
|
|
MoveA.L MASuperTab,A1 ; A1 := handle to Superclass table
|
|
MoveA.L (A1),A1 ; A1 := ptr to Superclass table
|
|
BrA.S doSuper ; Get Superclass
|
|
loopb
|
|
AddQ.L #4,A0 ; A0 := ptr to next class # in table
|
|
loop2
|
|
Cmp.W (A0),D0 ; next class # versus given class #
|
|
DBCC D1,loopb ; fall through if (A0) unsigned <= D0
|
|
BEq.S found ; Eq => found it
|
|
doSuper
|
|
Move.W 0(A1,D0.W),D0 ; D0 := Superclass # of D0 (D0 is always even!)
|
|
BNE.S loop2 ; Not Equal => still worth searching
|
|
|
|
; Error condition: method not found
|
|
MoveA.L D2,A1 ; A1 := cache address
|
|
Clr.L (A1)
|
|
Move.L MAErrProc,A1 ; address of error routine
|
|
Jmp (A1)
|
|
found
|
|
MoveA.L D2,A1 ; A1 := cache address
|
|
Move.W 2(A0),2(A1) ; store method offset in cache
|
|
BrA.S jmpMeth
|
|
|
|
;-------------------------------------------------------------------
|
|
; End of MacApp Method code...
|
|
;-------------------------------------------------------------------
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; File: Used to be . . . AdMath.ASM . . . now part of Toolbox Utilities.
|
|
;
|
|
; Assembly language FixMul, FixDiv, Sqrt, FixRatio, FracMul, FracDiv,
|
|
; and FracSqrt.
|
|
; Written by J. Coonen 8 Sep 84.
|
|
; 13 Sep 84 JTC added FixRatio, FracMul, FracDiv, and FracSqrt.
|
|
; 22 Jan 85 CRC added FixSin, removed ones in ROM, Sqrt; tweaked for Pascal
|
|
; 4 Feb 85 CRC tweaked FixSin into FracSin, added fixed point ROM sources
|
|
; 21 Apr 85 JTC Fixed up for ROM use: <18Apr85>
|
|
; 1) Remove Macro definitions.
|
|
; 2) Remove FFixMul(Fixed, Fracd) entry point -- it's the same as FracMul!
|
|
; 3) Add QD fixed-point routines to comment.
|
|
; 4) Fix bug in FixRound.
|
|
; 5) Renamed FixFixRatio (was FFixRatio)
|
|
; 22 Apr 85 JTC Modified calling convention for LongMul to be custom for Bill. <22Apr85>
|
|
; 24 Apr 85 JTC Modified all calls to preserve all but A0. <24Apr85>
|
|
; 13 May 85 JTC One last bash at new routines. <13May85>
|
|
; <C156>15 Sep 86 CRC FixRound: Add almost 1/2 instead of -1/2 in negative case
|
|
; <C576>30 Dec 86 EHB CRC LongMul,FixMul,FracMul,FixRatio were trashing too many registers
|
|
; Added a few RTD's for speed
|
|
; <C693>25 Jan 87 EHB Undid some mysterious changes in FixRatio that broke it
|
|
;
|
|
; FUNCTION FixMul (x, y: Fixed): Fixed; { returns x*y, signed }
|
|
;
|
|
; FUNCTION FracMul (x, y: Fracd): Fracd; { returns x*y }
|
|
;
|
|
; PROCEDURE LongMul (x, y: LONGINT; VAR z: Int64bit); { returns 64-bit x*y, signed }
|
|
;
|
|
; FUNCTION FixDiv (x, y: Fixed): Fixed; { returns x/y, signed }
|
|
;
|
|
; FUNCTION FracDiv(x, y: Fracd): Fixed; { returns x/y }
|
|
;
|
|
; FUNCTION FixRatio(x, y: Integer): Fixed; { returns x/y }
|
|
;
|
|
; FUNCTION FixRound (x: Fixed) : INTEGER; { returns x, rounded to integer }
|
|
;
|
|
; FUNCTION FracSqrt (x: Fracd) : Fracd; { returns square root of x }
|
|
;
|
|
; FUNCTION FracSin (x: Fixed) : Fracd; { returns Sin(x) }
|
|
;
|
|
; FUNCTION FracCos (x: Fixed) : Fracd; { returns Cos(x) }
|
|
;
|
|
; FUNCTION FixATan2 (x, y : LongInt): Fixed; { returns ATan(y/x) }
|
|
;
|
|
; FUNCTION HiWord (x: LONGINT) : INTEGER; { returns hi word of x }
|
|
;
|
|
; FUNCTION LoWord (x: LONGINT) : INTEGER; { returns lo word of x }
|
|
;
|
|
; FUNCTION Long2Fix, Fix2Long, Fix2Frac, Frac2Fix (x: inputType): outputType;
|
|
;
|
|
; FUNCTION Fix2X, X2Fix, Frac2X, X2Frac (x: inputType): outputType;
|
|
;
|
|
; Type Fixed is 32-bit binary fixed-point with binary point between
|
|
; high and low words. Sign is kept a la 2's-complement.
|
|
; Type double is 64-bit IEEE binary floating point.
|
|
; Type Fracd is 32-bit binary fixed point-point with binary point
|
|
; after leading bits. Sign is kept a la 2's-complement.
|
|
;
|
|
; Exceptional cases:
|
|
; Fixed overflow is set to $7FFFFFFF when positive, $80000000 when
|
|
; negative.
|
|
; Division by zero yields $7FFFFFFF when x is positive or zero,
|
|
; and $80000000 when x is negative.
|
|
;
|
|
; Calling conventions:
|
|
; Lisa/Mac Pascal stack arguments and return values.
|
|
; Exception: LongMul preserves all but A0 -- special for quickdraw. <22Apr85>
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; When this package is adapted for RAM, set this value to 1. It prevents
|
|
; collisions with sacred names defined in first-round system.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
FixedPRAM EQU 0 ; <28aug85> BBM
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; There are two flavors of multiply, FracMul and FixMul. FracMul uses the
|
|
; top 35 bits of the 64-bit product: the top two are shifted off the left,
|
|
; the the last bit is used for rounding. FixMul uses the middle 32 bits
|
|
; of the product, with the attendant overflow checks, and rounds with a
|
|
; 32nd bit.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; .PROC FixMath,0 Don't need this in toolbox utilities. <21Apr85>
|
|
EXPORT FracMul
|
|
EXPORT FracDiv
|
|
EXPORT FixDiv
|
|
EXPORT FracSqrt
|
|
EXPORT FracSin
|
|
EXPORT FracCos
|
|
EXPORT FixATan2
|
|
EXPORT Long2Fix
|
|
EXPORT Fix2Long
|
|
EXPORT Fix2Frac
|
|
EXPORT Frac2Fix
|
|
EXPORT Fix2X
|
|
EXPORT X2Fix
|
|
EXPORT Frac2X
|
|
EXPORT X2Frac
|
|
IF FixedPRAM THEN
|
|
EXPORT RLongMul
|
|
EXPORT RFixMul
|
|
EXPORT RHiWord
|
|
EXPORT RLoWord
|
|
EXPORT RFixRatio
|
|
EXPORT RFixRound
|
|
ELSE
|
|
EXPORT LongMul
|
|
EXPORT FixMul
|
|
EXPORT HiWord
|
|
EXPORT LoWord
|
|
EXPORT FixRatio
|
|
EXPORT FixRound
|
|
ENDIF
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; PROCEDURE LongMul (x, y: LONGINT; VAR z: Int64bit); { returns 64-bit x*y, signed }
|
|
;
|
|
; CLOBBERS ONLY A0
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
IF FixedPRAM THEN
|
|
RLongMul
|
|
ELSE
|
|
LongMul
|
|
ENDIF
|
|
|
|
; RTS EQU 8
|
|
; Z EQU 12
|
|
; Y EQU 16
|
|
; X EQU 20
|
|
|
|
MOVEM.L D0-D1,-(SP) ;save work registers
|
|
MOVE.L 16(SP),D1 ;get y
|
|
MULS.L 20(SP),D0:D1 ;multiply x by y to form 64 bit result
|
|
MOVE.L 12(SP),A0 ;get var Z
|
|
MOVE.L D0,(A0)+ ;store high word
|
|
MOVE.L D1,(A0)+ ;store low word
|
|
MOVEM.L (SP)+,D0-D1 ;restore work registers
|
|
RTD #12 ;strip params and return
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; FracMul, FixMul
|
|
;
|
|
; CLOBBERS ONLY A0
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
FracMul
|
|
LEA 3,A0 ; mark as FracMul (# of extra bits above result)
|
|
BRA.S commonMul
|
|
|
|
IF FixedPRAM THEN
|
|
RFixMul
|
|
ELSE
|
|
FixMul
|
|
ENDIF
|
|
|
|
CMP.L #$00010000,4(SP); is y 1?
|
|
BEQ.S returnX
|
|
CMP.L #$00010000,8(SP); is x 1?
|
|
BEQ.S returnY
|
|
LEA 17,A0 ; mark as FixMul (# of extra bits above result)
|
|
|
|
commonMul
|
|
|
|
RET EQU 16 ; return address (after 4 regs)
|
|
Y EQU RET+4 ; Y parameter
|
|
X EQU Y+4 ; X parameter
|
|
RESULT EQU X+4
|
|
|
|
MOVEM.L D0-D2/A1,-(SP) ; save everything but A0
|
|
MOVE.L Y(SP),D1 ; get argument y
|
|
SMI D2 ; remember sign
|
|
TST.L X(SP) ; check sign of x
|
|
SMI D0 ; remember its sign as well
|
|
EOR.B D0,D2 ; combine to signs together
|
|
EXTB.L D2 ; make it a mask for overflow check
|
|
MULS.L X(SP),D0:D1 ; get argument x; multiply by y
|
|
MOVE.L D1,-(SP) ; save 64 bit result away for bit extract
|
|
MOVE.L D0,-(SP)
|
|
|
|
; overflow occured if top bits are not equal to xored signs
|
|
|
|
MOVE.L A0,D0 ; 16 for FixMul; 2 for FracMul
|
|
BFEXTS (SP){0:D0},D1 ;get either first 3 or first 17 bits
|
|
CMP D1,D2
|
|
BEQ.S @noOverFlow
|
|
|
|
; if one of the operands are 0, and the other one is negative, weÕll get here even though
|
|
; there is no overflow. Check for 0 in result going on.
|
|
|
|
MOVE.L (SP)+,D1 ;get high word of result
|
|
OR.L (SP)+,D1 ;zero if and only if the low and high words are zero.
|
|
BEQ.S @returnResult
|
|
|
|
MOVEQ #-1,D1 ;-1
|
|
LSR.L #1,D1 ;$7FFFFFFF
|
|
EOR.L D2,D1 ;$7FFFFFFF (largest positive) or $80000000 (largest negative)
|
|
BRA.S @returnResult
|
|
|
|
@noOverFlow
|
|
|
|
;no overflow; extract result
|
|
SUBQ #1,D0 ;get sign bit as well
|
|
BFEXTS (SP){D0:0},D1 ;get 32 bits of results (0 = 32: assembler bug/oversight)
|
|
|
|
;if 1/2 bit is set, add 1. Note that to be painstakingly correct, if the result is negative
|
|
;add 1 only if a bit smaller than the 1/2 bit is also set. The exact one-half case should
|
|
;not round up.
|
|
|
|
ADD #32,D0 ; bump D0 to 1/2 bit
|
|
BFEXTU (SP){D0:1},D2 ; get the 1/2 bit
|
|
BEQ.S @commonEnd
|
|
TST.L D1 ; result is minus?
|
|
BPL.S @add1
|
|
ADDQ #1,D0 ; advance to next bit (the 1/4 bit)
|
|
MOVEQ #64,D2 ;
|
|
SUB D0,D2 ; determine number of bits remaining
|
|
BFEXTU (SP){D0:D2},D0
|
|
BEQ.S @commonEnd
|
|
@add1
|
|
ADDQ.L #1,D1 ; bump the result
|
|
|
|
@commonEnd
|
|
ADDQ #8,SP ; throw away 64 bit result
|
|
@returnResult
|
|
MOVE.L D1,RESULT(SP) ; save result
|
|
MOVEM.L (SP)+,D0-D2/A1 ; restore registers
|
|
RTD #8 ; strip params and return
|
|
|
|
returnX
|
|
MOVE.L 8(SP),12(SP)
|
|
RTD #8
|
|
|
|
returnY
|
|
MOVE.L 4(SP),12(SP)
|
|
RTD #8
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Restore sign to D0, with check for overflow. On overflow store max
|
|
; value with appropriate sign.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
reSign
|
|
TST.L D0
|
|
BMI.S fixOver ; result must be 80000000
|
|
TST.B D6
|
|
BEQ.S TwoParmExit
|
|
NEG.L D0
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Common exit routine for all two parm routines.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
TwoParmExit
|
|
MOVE.W #8,8(A6) ; A6: savedA6 << RET << x ...
|
|
MOVE.L D0,16(A6) ; A6: savedA6 << RET << x << y << result slot
|
|
BRA.S CustomExit
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Common exit routine for all one parm routines.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
OneParmExit
|
|
MOVE.W #4,8(A6) ; A6: savedA6 << RET << x ...
|
|
MOVE.L D0,12(A6) ; A6: savedA6 << RET << x << result slot
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Custom exit -- expect 8(A6) to be amount to kill from stack
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
CustomExit
|
|
MOVEM.L (SP)+,D0-D6/A1 ; restore registers
|
|
UNLK A6
|
|
MOVE.L (SP)+,A0
|
|
ADDA.W (SP),SP ; kill the params
|
|
JMP (A0)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Common entry routine for all.
|
|
; Preserves all but A0.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
StdEntry
|
|
MOVE.L (SP)+,A0 ; local return address
|
|
LINK A6,#0
|
|
MOVEM.L D0-D6/A1,-(SP) ; save scratch registers
|
|
JMP (A0) ; return
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Common startup routine fetches x,y from 12(A6) and unpacks into D1,D2.
|
|
; Sign of result is stored in bit #15 of D6.16.
|
|
; NOTE: D1 and D2 are reversed from the Adobe version of these routines
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
fixArgs
|
|
MOVEM.L 8(A6),D1-D2 ; D1=y D2=x
|
|
fixArg1
|
|
TST.L D1
|
|
SMI D6
|
|
BPL.S @41
|
|
NEG.L D1
|
|
@41
|
|
TST.L D2
|
|
BPL.S @43
|
|
NEG.L D2
|
|
NOT.B D6 ; bit 7 is XOR of x,y signs
|
|
@43
|
|
RTS
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Forces max value with correct sign.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
fixOver
|
|
MOVEQ #1,D0
|
|
ROR.L #1,D0 ; get max negative Fixed, $80000000
|
|
TST.B D6
|
|
BNE.S TwoParmExit
|
|
SUBQ.L #1,D0 ; 7FFFFFFF when positive
|
|
BRA.S TwoParmExit
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; FixDiv:
|
|
; Dividing xxxx.xxxx by yyyy.yyyy. Must prenormalize y to run division
|
|
; algorithm. To minimize number of divide steps, prenormalize x as well.
|
|
; Step count = 1-int + 16-frac + 1-round + y-shifts - x-shifts - 1-DBRA.
|
|
; Cases: count <= 0 quo := 0
|
|
; 0 < count < 32 quo := as computed
|
|
; count >= 32 quo := fixOver
|
|
; Note that we can accommodate the "extra" round bit because the signed
|
|
; result is really only 31 bits wide in magnitude.
|
|
;
|
|
; FracDiv:
|
|
; Step count = 1-int + 30-frac + 1-round + y-shifts - x-shifts - 1-DBRA.
|
|
;
|
|
; FixDiv:
|
|
; Step count = 1-int + 16-frac + 1-round + y-shifts - x-shifts - 1-DBRA.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
FracDiv
|
|
BSR.S StdEntry
|
|
MOVEQ #31,D3 ; 1 + 30 + 1 - 1 = signature of FixRatio
|
|
BRA.S comDiv
|
|
FixDiv
|
|
BSR.S StdEntry
|
|
MOVEQ #17,D3 ; 1 + 16 + 1 - 1 = signature of ...
|
|
comDiv
|
|
BSR.S fixArgs
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Initialize quo, have step count in D3; and check for division by zero.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
MOVEQ #0,D0 ; initialize quo
|
|
TST.L D1
|
|
BNE.S @13 ; entry to next loop, D1 tested
|
|
BRA.S FixOver
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Loop to prenormalize y.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
@11
|
|
ADDQ.W #1,D3
|
|
ADD.L D1,D1
|
|
@13
|
|
BPL.S @11
|
|
TST.L D2
|
|
BEQ.S TwoParmExit ; hasty retreat if 0/0
|
|
@14 BRA.S @17 ; entry to next loop, D2 tested
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Loop to prenormalize x.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
@15
|
|
SUBQ.W #1,D3
|
|
ADD.L D2,D2
|
|
@17
|
|
BPL.S @15
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Check for cases above, based on step count in D3.W
|
|
; The 0-based quotient bit count is in D3, for a DBRA loop below.
|
|
; D3 <= 0 means that there are no (nonzero) quotient bits to compute,
|
|
; that is, the result is zero. D3 < 32 means that we're computing
|
|
; at most 32 real bits, so there can be no overflow.
|
|
; Now the subtle part: with normalized dividend and divisor, there is at
|
|
; most one leading 0 bit before the nonzero quotient begins. That means
|
|
; that when the D3 = 32 (that is, 33 quotients bits coming), we overflow
|
|
; precisely when the leading quotient bit is 1; otherwise, we just fall
|
|
; into the divide loop where a zero quotient bit would have taken us.
|
|
; Finally D3 > 32 gurantees overflow.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
TST.W D3
|
|
BLE.S TwoParmExit ; StdExit, 0 is the result
|
|
|
|
CMPI.W #32,D3 ; changed for #31 to # 32 <A279/28Oct86>
|
|
BLT.S L23 ; fall into loop, guaranteed no overflow <A343/03Nov86>
|
|
|
|
BGT.S fixover ; was bra.s until now, overflow guaranteed <A343/03Nov86>
|
|
CMP.L D1,D2 ; D1 < D2 --> CarrySet -->first bit is zero <A343/03Nov86>
|
|
BCS.S L27 ; falls in when 0 quo bits go <A343/03Nov86>
|
|
|
|
BRA.S fixOver
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Divide loop, to divide D2 by D1, developing D3.W quotient bits into D0.
|
|
; At each step quotient is left shifted one place; in event of carry-out
|
|
; be sure to force subtract. Because of tests above, there's no chance
|
|
; of overflow except during round step.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
L21
|
|
ADD.L D0,D0 ; make way for next quo bit
|
|
;;; BCS.S FixOver ; remove test from inner loop <A279/27Oct86>
|
|
ADD.L D2,D2 ; shift dividend
|
|
BCS.S L25 ; force subtract on carry
|
|
L23
|
|
CMP.L D1,D2 ; divisor vs dividend
|
|
BCS.S L27 ; skip subtract if too small
|
|
L25
|
|
SUB.L D1,D2
|
|
ADDQ.W #1,D0 ; no carry here
|
|
L27
|
|
DBRA D3,L21
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Use the low bit of D0 to round the result.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
LSR.L #1,D0
|
|
BCC.S reSign
|
|
ADDQ.L #1,D0
|
|
BRA.S reSign
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Square root of a Frac xx.xxxxxxxx . In this case, the leading two
|
|
; bits of the Fract are BOTH taken to be integer, that is, the value is
|
|
; interpreted as unsigned.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Square roots based on classical schoolboy algorithm.
|
|
; P = (SUM Aj*10^-j)^2
|
|
; = A1 * A1 * 10^-2 +
|
|
; ( 2(10*A1) + A2 ) * A2 * 10^-4 +
|
|
; ( 2(10^2*A1 + 10*A2) + A3 ) * A3 * 10^-6 +
|
|
; ( 2(10^3*A1 + 10^2*A2 + 10*A3) + A4 ) * A4 * 10^-8 + ...
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
FracSqrt
|
|
BSR.S StdEntry
|
|
MOVE.L 8(A6),D3 ; fetch input Frac
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Know that lead bit of root is 0, so only 31 bits plus a round bit are
|
|
; required. Alas, this just spills over a longword, so compute in a
|
|
; 64-bit field. Compute root into D0-D1. Maintain radicand in D2-D3.
|
|
; Loop counter in D4. Before each step, the root has the form:
|
|
; <current root>01 and after each step: <new root>1, where the number
|
|
; shown spans D0 and the highest two bits of D1.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
MOVEQ #0,D0
|
|
MOVEQ #1,D1
|
|
ROR.L #2,D1 ; D1 := 4000 0000
|
|
MOVEQ #0,D2 ; clear high radicand
|
|
MOVEQ #31,D4 ; need 32 bits less 1-DBRA
|
|
|
|
frSqrtLoop
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Try radicand minus trial root. Use subtle fact that C is the complement
|
|
; of the next root bit at each step.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
SUB.L D1,D3
|
|
SUBX.L D0,D2 ; no carry means root=1
|
|
BCC.S @72
|
|
|
|
ADD.L D1,D3
|
|
ADDX.L D0,D2
|
|
@72
|
|
DC.W $0A3C ;EORI #16,CCR - complement X bit
|
|
DC.W $0010
|
|
|
|
ADDX.L D0,D0 ; set root bit while shifting
|
|
|
|
ADD.L D3,D3 ; shift radicand two places
|
|
ADDX.L D2,D2
|
|
ADD.L D3,D3
|
|
ADDX.L D2,D2
|
|
|
|
DBRA D4,frSqrtLoop
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Shift the 32-bit root in D0 right one bit and round.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
LSR.L #1,D0
|
|
BCC.S OneParmExit
|
|
ADDQ.L #1,D0
|
|
BRA.S OneParmExit ; <23Apr85>
|
|
|
|
; Experiment in crunching: FixRatio written using common code, at what cost?
|
|
IF FixedPRAM THEN
|
|
RFixRatio
|
|
ELSE
|
|
|
|
FixRatio
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; FixRatio(numerator,denominator: INTEGER): Fixed;
|
|
;
|
|
; CLOBBERS ONLY D0-D1
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
ENDIF
|
|
|
|
MOVE 4(SP),D0 ; get denominator
|
|
BEQ.S @overFlow ; check for division by zero
|
|
MOVEQ #0,D1 ; clear high part of D1
|
|
MOVE 6(SP),D1 ; get numerator
|
|
CMP D0,D1
|
|
BEQ.S @returnOne
|
|
EXT.L D0
|
|
SWAP D1 ; multiply denominator by $1000
|
|
DIVS.L D0,D1 ; all done
|
|
MOVE.L D1,8(SP) ; return fixed result
|
|
RTD #4 ; strip params and return
|
|
|
|
@overFlow
|
|
MOVEQ #-1,D1
|
|
LSR.L #1,D1 ; a very large positive number
|
|
TST 6(SP) ; is numerator negative?
|
|
BPL.S @0
|
|
NEG.L D1 ; a very large negative number
|
|
@0 MOVE.L D1,8(SP) ; return fixed result
|
|
RTD #4 ; strip params and return
|
|
|
|
@returnOne
|
|
MOVEQ #1,D1
|
|
SWAP D1
|
|
MOVE.L D1,8(SP) ; return fixed result
|
|
RTD #4 ; strip params and return
|
|
|
|
chkSign TST.B D6 ; was original signed?
|
|
BEQ.S @9 ; common code for this & FracSin, FracCos
|
|
NEG.L D0
|
|
@9 BRA.S OneParmExit
|
|
FixRatEasy
|
|
MOVEQ #1,D0 ; 0000.0001 <23Apr85>
|
|
SWAP D0 ; make it 1.0 <23Apr85>
|
|
BRA.S OneParmExit
|
|
|
|
|
|
IF FixedPRAM THEN
|
|
RLoWord
|
|
ELSE
|
|
LOWORD
|
|
ENDIF
|
|
;----------------------------------------------------
|
|
;
|
|
; FUNCTION LoWord(x: Fixed): INTEGER;
|
|
;
|
|
MOVE.W 6(SP),8(SP) ;GET LO WORD
|
|
BRA.S StripRet
|
|
|
|
;----------------------------------------------------
|
|
;
|
|
; FUNCTION HiWord(x: Fixed): INTEGER;
|
|
;
|
|
IF FixedPRAM THEN
|
|
RHiWord
|
|
ELSE
|
|
HIWORD
|
|
ENDIF
|
|
MOVE.W 4(SP),8(SP) ;RETURN HI WORD OF RESULT
|
|
StripRet MOVE.L (SP)+,(SP) ;STRIP PARAM
|
|
RTS ;RETURN
|
|
|
|
;----------------------------------------------------
|
|
;
|
|
; FUNCTION FixRound(x: Fixed): INTEGER;
|
|
;
|
|
; Tricky routine requires that one add 1/2 to the MAGNITUDE of x, then CHOP toward 0.
|
|
; Chopping a 2's-complement value requires an increment if the value of the fraction is
|
|
; nonzero. To be polite, also check for overflow:
|
|
; $7FFF8000 and above carries out to $8000xxxx, which must be pinned at $7FFF.
|
|
; $80007FFF and above (in magnitude) carry out to $7FFF8xxx, which must be pinned at $8000.
|
|
; Lovely trick: note that regardless of its negation, the low word of D1 is $8000! Use it!
|
|
; Subtle case: it looks simple to add 1/2 (toward +INF) and take floor (toward -INF) to get FixRound
|
|
; to come out. Alas, this messes up in half-way cases, to wit, 3/2 --> 2 but -3/2 --> -1 !!!
|
|
; change made 15-Sep-86 CRC: add almost 1/2 instead of -1/2 in negative case
|
|
|
|
IF FixedPRAM THEN
|
|
RFixRound
|
|
ELSE
|
|
FIXROUND
|
|
ENDIF
|
|
|
|
MOVE.L (SP)+,A0 ;get return address
|
|
MOVEQ #1,D1
|
|
ROR.W #1,D1 ;compute $00008000
|
|
MOVE.L (SP)+,D0 ;get passed argument
|
|
BPL.S @positive
|
|
NOT D1 ;for negative, make it $00007FFF
|
|
@positive ADD.L D1,D0 ;round up, but not as far if negative
|
|
BVC.S @notTooBig ;fell off the end of the positive world
|
|
MOVEQ #-2,D0 ;get $FFFFFFFE
|
|
ROR.L #1,D0 ;compute $7FFFFFFF
|
|
@notTooBig
|
|
SWAP D0 ;get hi word result
|
|
MOVE D0,(SP) ;and return integer
|
|
JMP (A0) ;go home
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; FUNCTION FracSin (x: Fixed) : Fract; { returns Sin(x) }
|
|
;
|
|
; FUNCTION FracCos (x: Fixed) : Fract; { returns Cos(x) }
|
|
;
|
|
; Written by KLH 8 May 85
|
|
;
|
|
; Description: Fixed Point Sine & Cosine. It would be wise to use values
|
|
; of PI/4, PI/2 or PI obtained from FixATan2 for angle conversions.
|
|
; Undone: 1) code would be improved if A2 were saved and restored in
|
|
; standard entry and exits.
|
|
; 2) Need to make standard bypass when reduced arguments are 0, maybe.
|
|
;
|
|
;
|
|
; (|x| div Pi/4) mod 8 Argument Range sin (x) cos (x)
|
|
; D6 := |x| div Pi/4 D3 := x
|
|
;
|
|
; 0 0 to Pi/4 sin (x) cos (x)
|
|
; 1 Pi/4 to Pi/2 cos (Pi/2 - x) sin (Pi/2 - x)
|
|
; 2 Pi/2 to 3*Pi/4 cos (x) -sin (x)
|
|
; 3 3*Pi/4 to Pi sin (Pi/2 - x) -cos (Pi/2 - x)
|
|
; 4 Pi to 5*Pi/4 -sin (x) -cos (x)
|
|
; 5 5*Pi/4 to 3*Pi/2 -cos (Pi/2 - x) -sin (Pi/2 - x)
|
|
; 6 3*Pi/2 to 7*Pi/4 -cos (x) sin (x)
|
|
; 7 7*Pi/4 to 2*Pi -sin (Pi/2 - x) cos (Pi/2 - x)
|
|
;
|
|
; Note; 1) when D6 is odd D3 := Pi/2 - D3
|
|
; 2) if (cosine entry) then D6 := D6 + 2, use sine column
|
|
; 3) if (x < 0) and (sine entry) then D6 := D6 + 4
|
|
; 4) 'move.b #$66,-(sp)'
|
|
; 'btst D6,(sp)+' tests (D6 mod 8) bit of $66
|
|
; 5) the above scheme reduces all cosine and sine calls to
|
|
; the appropriate sine or cosine in the range 0 to Pi/4
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
FracCos
|
|
BSR.S StdEntry
|
|
MOVEQ #2,D6 ;This is a Cosine, PI/2 phase shift
|
|
BRA.S FSin2
|
|
|
|
FracSin
|
|
BSR.S StdEntry
|
|
MOVEQ #0,D6 ;flag that this is a Sine routine, No phase shift
|
|
FSin2
|
|
MOVE.L 8(A6),D3 ;get angle
|
|
bpl.s @3 ;input argument is postive
|
|
tst.l D6
|
|
bne.s @2 ;not Sine routine
|
|
addq #4,D6 ;Add PI phase shift, argument negative for sine
|
|
@2 neg.l D3
|
|
@3 move.l #$0000c910,D5 ;D5 := PI/4 (fixed)
|
|
divu D5,D3
|
|
add.l D3,D6
|
|
clr.w D3
|
|
swap D3
|
|
btst #0,D6
|
|
beq.s @4
|
|
sub.w D5,D3 ; D3 := D3 - PI/4
|
|
neg.w D3 ; D3 := -D3
|
|
@4 swap D3 ; frac := fixed/2
|
|
lsr.l #3,D3
|
|
MOVE.l A2,-(SP) ;need an address register
|
|
SUB.L #16,SP ;space for 4 FracMul's function result
|
|
|
|
move.l D3,-(sp)
|
|
move.l D3,-(sp)
|
|
bsr FracMul ;d5 := sqr (D3)
|
|
MOVE.L (SP)+,D5
|
|
move.b #$66,-(sp)
|
|
btst D6,(sp)+
|
|
bne.S PolyCos
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; sin (x) := (x/2)*(sn0 + x2*(sn1 + x2*sn2)), where x2 := sqr (x/2)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
LEA sn0,A2 ;polynomial constants Sine
|
|
MOVEQ #4,D4 ;2 iterations, counting from 0 by fours.
|
|
bra.s PolyLoop
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; cos (x) := cs0 + x2*(cs1 + x2*(cs2 + x2*cs3)), where x2 := sqr (x/2)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
PolyCos LEA cs0,A2 ;polynomial constants for Cosine
|
|
MOVEQ #8,D4 ;3 iterations, counting from 0 by fours.
|
|
|
|
PolyLoop
|
|
move.L 4(A2,D4),-(sp)
|
|
@3 MOVE.l D5,-(SP) ;push sqr (x) onto stack
|
|
bsr FracMul
|
|
move.L 0(A2,D4),D0
|
|
add.L D0,(sp) ;add coefficient to stack
|
|
SUBQ #4,D4
|
|
BPL.S @3
|
|
move.b #$66,-(sp)
|
|
btst D6,(sp)+
|
|
bne.S NotSine
|
|
|
|
move.l d3,-(sp) ;push original argument onto stack
|
|
jsr FracMul ;do final multiply for Sine
|
|
|
|
|
|
NotSine
|
|
move.l (sp)+,D0 ;pop result into D0 register
|
|
MOVE.L (SP)+,A2 ;restore extra register
|
|
|
|
move.b #$f0,-(sp)
|
|
btst D6,(sp)+
|
|
beq.s @9
|
|
neg.l D0
|
|
|
|
@9 Bra.S OneParmExit
|
|
|
|
sn0 DC.L $7FFFD609 ; 1.9999899949540321990 0.000000561
|
|
sn1 DC.L $AAB3314D ; -1.3328129532011865770 0.000000561
|
|
sn2 DC.L $10A208E5 ; 0.2598898155860768873 0.000000561
|
|
|
|
cs0 DC.L $40000000 ; 1.0
|
|
cs1 DC.L $800011A7 ; -1.9999957911835540090 0.000000032
|
|
cs2 DC.L $2AA7F29A ; 0.6665007113846229170 0.000000032
|
|
cs3 DC.L $FA6E2A42 ; -0.0870260574471380774 0.000000032
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; FUNCTION FixATan2 (x, y: LONGINT): Fixed; { returns ArcTan (x, y) }
|
|
;
|
|
; Written by KLH 8 May 85
|
|
;
|
|
; Description: FixATan2 returns the angle (fixed, radians) in the range
|
|
; [-PI to PI] to the point (x, y: Longint). For consistency with fracCos
|
|
; and fracSin it would be wise to use value of PI/4, PI/2 or PI obtained
|
|
; from this function for angle conversions.
|
|
; Undone: 1) (0, 0) currently yields 0, is this OK?
|
|
; 2) code would be improved if A2 were saved and restored in
|
|
; standard entry and exits.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
FixATan2
|
|
BSR.S StdEntry
|
|
|
|
moveq #0,D6
|
|
MOVE.L 12(A6),D3 ; get X
|
|
bpl.s @1 ; if X < 0 then
|
|
addq #2,D6 ; set 2nd bit of D6
|
|
neg.l D3 ; X := abs |X|
|
|
bpl.s @1
|
|
subq.l #1,D3 ; uh oh, it's still negative, make largest positive <fixed> <5>
|
|
|
|
@1 MOVE.L 8(A6),D0 ; get Y
|
|
bpl.s @2 ; if Y < 0s then
|
|
addq #1,D6 ; set lowest bit of D6
|
|
neg.l D0 ; y := |y|
|
|
bpl.s @2
|
|
subq.l #1,D0 ; make largest positive <fixed> <5>
|
|
|
|
@2 MOVE.l A2,-(SP) ; need an address register
|
|
SUB.L #32,SP ; space for 8 Longints function results 8LP
|
|
|
|
cmp.l D3,D0 ; D0 - D3
|
|
ble.s bigger ; is |Y| > |X| if yes then
|
|
addq #4,D6 ; set 3rd bit of D6
|
|
|
|
move.l D3,-(sp) ; argument for ArcTan is |X|/|Y|
|
|
beq.s NoPoly ; reduced argument is zero
|
|
move.l D0,-(sp)
|
|
bra.s GetATanArg
|
|
|
|
NoPoly move.l D3,D0
|
|
NoPoly2 Add.l #36,sp ; clean up stack 0LP
|
|
bra.s bypass
|
|
|
|
bigger move.l D0,-(sp) ; reduced argument for ArcTan is |Y|/|X|
|
|
beq.s NoPoly2 ; reduced argument is zero or 0/0
|
|
move.l D3,-(sp)
|
|
|
|
GetATanArg ; 10LP
|
|
bsr FracDiv
|
|
MOVE.L (SP),D3 ;save argument
|
|
move.l (sp),-(sp) ; 9LP
|
|
bsr FracMul ;D5 := sqr (D3)
|
|
MOVE.L (SP)+,D5 ; 6LP
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; ArcTan (x) := x*(at0 + x2*(at1 + x2*(at2 + x2*(at3 + x2*(at3 + x2*at5))))),
|
|
;
|
|
; where x2 := sqr (x)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
LEA at0,A2 ; polynomial constants for ArcTangent 6LP
|
|
MOVE.L 20(a2),-(sp) ; push last coefficient onto stack 7LP
|
|
MOVEQ #16,D4 ; 5 iterations, counting from 0 by fours.
|
|
@3 MOVE.l D5,-(SP) ; push sqr (x) onto stack
|
|
bsr FracMul
|
|
move.L 0(A2,D4),D0
|
|
add.L D0,(sp) ; add coefficient to stack
|
|
SUBQ #4,D4
|
|
BPL.S @3
|
|
; 2LP
|
|
move.l d3,-(sp) ; push original argument onto stack
|
|
jsr FracMul ;do final multiply
|
|
|
|
move.l (sp)+,D0 ; pop result into D0 register
|
|
|
|
MOVEQ #14,D2 ; with ArcTangent
|
|
LSR.L D2,D0 ; shift right 14 bits, for frac to fixed
|
|
bcc.s bypass
|
|
addq.l #1,D0 ; round up
|
|
|
|
bypass MOVE.L (SP)+,A2 ; restore extra register
|
|
|
|
move.l #$00019220,D5 ; D5 := PI/2 (fixed)
|
|
btst #2,D6
|
|
beq.s @2 ; X < Y
|
|
sub.l D5,D0 ; D0 := D0 - PI/2
|
|
neg.l D0 ; D0 := -D0
|
|
|
|
@2 btst #1,D6
|
|
beq.s @1 ; X was positive
|
|
lsl.l #1,D5 ; D5 := PI
|
|
sub.l D5,D0 ; D0 := D0 - PI
|
|
neg.l D0 ; D0 := -D0
|
|
|
|
@1 btst #0,D6
|
|
beq.s @0 ; Y was positive
|
|
neg.l D0 ; D0 := -D0
|
|
|
|
@0 Bra.S TwoParmExit
|
|
|
|
at0 DC.L $3FFFA073 ; 0.9999772190799163233 0.000001662
|
|
at1 DC.L $EAB64EBE ; -0.3326228278407496104 0.000001662
|
|
at2 DC.L $0C62F72C ; 0.1935403757729599042 0.000001662
|
|
at3 DC.L $F88C77F2 ; -0.1164264811847172587 0.000001662
|
|
at4 DC.L $035E92FE ; 0.0526473506160217409 0.000001662
|
|
at5 DC.L $FF3FFE62 ; -0.0117191354060452945 0.000001662
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; FUNCTION Fix2X (x: Fixed ): Extended;
|
|
; FUNCTION Frac2X (x: Fract ): Extended;
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
Fix2X
|
|
move.w #$400E,D1 ; set extended exponent for 2^15
|
|
bra.s ComE
|
|
Frac2X
|
|
move.w #$4000,D1 ; set extended exponent for 2^1
|
|
ComE MOVE.L (SP)+,A0 ; save return address
|
|
move.l (sp)+,D0 ; put Fixed or Frac into D0
|
|
bne.s NotZero
|
|
moveq #0,D1 ; zero exponent
|
|
bra.s fin
|
|
|
|
NotZero bpl.s shftgn
|
|
add.w #$8000,D1 ; set Extended sign bit
|
|
neg.l D0
|
|
bmi.s fin ; largest negative number, thus it is normalized
|
|
|
|
shftgn subq.w #1,D1 ; decrement Extended exponent
|
|
lsl.l #1,D0 ; shift until normalized
|
|
bpl.s shftgn
|
|
|
|
fin move.l (sp),A1 ; get effective address of return argument
|
|
move.w D1,(A1) ; stuff sign & exponent
|
|
move.l D0,2(A1) ; stuff significand
|
|
clr.l 6(A1) ; clear low word of Extended
|
|
|
|
jmp (A0)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; FUNCTION X2Fix (x: Extended ): Fixed;
|
|
; FUNCTION X2Frac(x: Extended ): Fract;
|
|
;
|
|
; Note: Assumes Extended numbers are normalized
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
X2Fix
|
|
move.w #$400e,D1 ; exponent for Ext. for correct Fixed significand
|
|
bra.s X2F
|
|
X2Frac
|
|
move.w #$4000,D1 ; exponent for Ext. for correct Frac significand
|
|
X2F MOVEm.L (SP)+,A0/A1 ; save return address/get Extended address
|
|
move.w (A1),D0 ; get exponent
|
|
bclr #15,D0 ; D0 := abs (D0)
|
|
sub.w D0,D1 ; D1 := D1 - D0
|
|
blt.s MaxIt ; either a NaN, Inf or too large for fixed or frac
|
|
move.l 2(A1),D0 ; get most significant part of significand
|
|
tst.w D1
|
|
bne.s @1 ; unnormalize number
|
|
|
|
tst 6(A1) ; is the 33rd bit set necessitating a round up
|
|
bra.s @2
|
|
|
|
@1 cmp.w #32,D1 ; D1 - 32
|
|
blt.s @3 ; Ok to Shift
|
|
bne.s ZeroIt ; even MSB shifted too far to cause a rounding
|
|
moveq #0,D0 ; 32 bit shift, zero leading 32 bits & check 33rd
|
|
tst 2(A1) ; is the 33rd bit set necessitating a round up
|
|
@2 bmi.s RndUp
|
|
bra.s rtnX2F
|
|
|
|
@3 lsr.l D1,D0 ; shift
|
|
bcc.s rtnX2F
|
|
RndUp addq.l #1,D0 ; round up
|
|
bcs.s MaxIt ; MaxIt if overflow
|
|
|
|
rtnX2F tst (A1)
|
|
bmi.s NegRslt
|
|
tst.l D0
|
|
bmi.s MaxIt ; positive value too large
|
|
FinX2F move.l D0,(sp)
|
|
jmp (A0)
|
|
|
|
ZeroIt moveq #0,D0 ; put here to save a word
|
|
NegRslt neg.l D0
|
|
ble.s FinX2F ; D0 was zero or a valid negative value
|
|
|
|
MaxIt tst.w (A1)
|
|
MaxE2 bpl.s @1
|
|
moveq #1,D0 ; move.l $00000001,D0 -> $80000000,D0
|
|
bra.s @2
|
|
|
|
@1 clr.l D0
|
|
subq.l #2,D0 ; move.l $fffffffe,D0 -> $7fffffff,D0
|
|
|
|
@2 ror.l #1,D0
|
|
bra.s FinX2F
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; FUNCTION Long2Fix (x: Longint ): Fixed;
|
|
; FUNCTION Fix2Long (x: Fixed ): Longint;
|
|
; FUNCTION Fix2Frac (x: Fixed ): Fract;
|
|
; FUNCTION Frac2Fix (x: Fract ): Fixed;
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
Fix2Long
|
|
moveq #16,D1
|
|
bra.s ComFF
|
|
|
|
Frac2Fix
|
|
moveq #14,D1
|
|
ComFF MOVE.L (SP)+,A0 ; save return address
|
|
move.l (sp)+,D0 ; put Fixed or Frac into D0
|
|
bpl.s @2
|
|
neg.l D0
|
|
lsr.l D1,D0
|
|
bcc.s @1
|
|
addq.l #1,D0 ; <A279/27Oct86>
|
|
@1 neg.l D0
|
|
bra.s FinX2F
|
|
|
|
@2 lsr.l D1,D0
|
|
bcc.s FinX2F
|
|
addq.l #1,D0 ; <A279/27Oct86>
|
|
bra.s FinX2F
|
|
|
|
Long2Fix
|
|
moveq #16,D1
|
|
bra.s ComLF
|
|
|
|
Fix2Frac
|
|
moveq #14,D1
|
|
ComLF MOVE.L (SP)+,A0 ; save return address
|
|
move.l (sp)+,(sp)
|
|
move.l (sp),D0 ; put Longint or Fixed into D0
|
|
asl.l D1,D0
|
|
; check for overflow & take appropriate action depending on the sign
|
|
bvc.s FinX2F ; no overflow
|
|
move.l (sp),D1 ; sets N condition code
|
|
bra.s MaxE2
|
|
|
|
END
|
|
|
|
|