mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-09-07 09:54:37 +00:00
1582 lines
52 KiB
Plaintext
1582 lines
52 KiB
Plaintext
|
;
|
|||
|
; File: Munger.a
|
|||
|
;
|
|||
|
; Contains: Byte String munger
|
|||
|
;
|
|||
|
; Copyright: <09> 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 <20>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<77>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
|
|||
|
|
|||
|
|