; This is MF-EXTRA.MAR as of 16-August-1990 ; Composed of routines contributed by John Lavagnino (Brandeis University) ; and Ned Freed (Innosoft International) .TITLE MF_EXTRA Math functions and extra routines for MF .IDENT /1.0/ ; If not replaced, the standard versions of these functions account ; for over 30% of the processing time used by METAFONT. These ; assembly-language versions are much faster because they can use ; extended-precision arithmetic to make the calculations directly, ; rather than by the iterative method used for portability in ; standard METAFONT. ; ; function makefraction(p, q: integer): fraction; ; { Calculate the function floor( (p * 2^28) / q + 0.5 ) } ; { if both p and q are positive. If not, then the value } ; { of makefraction is calculated as though both *were* } ; { positive, then the result sign adjusted. } ; { (e.g. makefraction ALWAYS rounds away from zero) } ; { In case of an overflow, return the largest possible } ; { value (2^31-1) with the correct sign, and set global } ; { variable "aritherror" to 1. Note that -2^31 is } ; { considered to be an illegal product for this type of } ; { arithmetic! } ; ; function makescaled(p, q: integer): scaled; ; { Calculate the function floor( (p * 2^16) / q + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; function takefraction(q: integer; f: fraction): integer; ; { Calculate the function floor( (q * f) / 2^28 + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; function takescaled(q: integer; f: scaled): integer; ; { Calculate the function floor( (q * f) / 2^16 + 0.5 ) } ; { Rounding same as in makefraction(). } ; ; ; Passes the TRAP test, version of December 4, 1989, with MF 2.0 --- ; though that test doesn't claim to exercise these fully. Also checked ; by generating a few CM fonts and comparing them with output from the ; unmodified program; and by comparison with the results of a C ; version of the standard routines on several million random pairs of ; integers. ; John Lavagnino, Department of English, Brandeis University, June 1990. ; Bitnet: lav@brandeis ; Internet: lav@binah.cc.brandeis.edu .external aritherror ; set on overflow TRUE = 1 ; value for aritherror EL_GORDO = ^x7fffffff ; 2^31-1 FRACTION_ONE = ^x10000000 ; 2^28 UNITY = ^x10000 ; 2^16 .psect $code, pic, shr, nowrt, long, exe ; long makescaled(p_ptr, q_ptr) [METAFONT: The Program, section 114.] ; long *p_ptr, *q_ptr .entry makescaled, ^m ;-- Move our scale factor into R3, and go to common code for ; makefraction and makescaled to compute (2^16 * p) div q. movl #UNITY, r3 brb make_code ; long makefraction(p_ptr, q_ptr) [METAFONT: The Program, section 107.] ; long *p_ptr, *q_ptr .entry makefraction, ^m ;-- Move our scale factor into R3, and continue in common code for ; makefraction and makescaled to compute (2^28 * p) div q. movl #FRACTION_ONE, r3 ;-- Argument handling for makefraction and makescaled, which differ only ; by a scale factor. make_code: ;-- First we figure out the correct sign for the result and make the ; arguments positive, as in the Pascal version in Metafont: The Program. ; This saves us from complications about which direction we're rounding ; in, etc. ; Put p into R2; make it positive, and save the original sign in R4. movzbl #1, r4 movl @4(ap), r2 bgeq 10$ mnegl r2, r2 mnegl r4, r4 10$: ; Put q into R1; make it positive, and save the correct sign for the ; final result of our calculations in R4. Then off to common code for ; main calculations. movl @8(ap), r1 bgeq main_calc mnegl r1, r1 mnegl r4, r4 brb main_calc ; long takescaled(q_ptr, f_ptr) [METAFONT: The Program, section 112.] ; long *q_ptr, *f_ptr .entry takescaled, ^m ;-- Move our divisor into R1, and go to common code for ; takefraction and takescaled to compute (q * f) div (2^16). movl #UNITY, r1 brb take_code ; long takefraction(q_ptr, f_ptr) [METAFONT: The Program, section 109.] ; long *q_ptr, *f_ptr .entry takefraction, ^m ;-- Move our divisor into R1, and continue in common code for ; takefraction and takescaled to compute (q * f) div (2^28). movl #FRACTION_ONE, r1 ;-- Argument handling for takefraction and takescaled, which differ ; only in the divisor that's used. take_code: ;-- First get sign for result and make arguments positive. ; Put q into R2; make it positive, and save the original sign in R4. movzbl #1, r4 movl @4(ap), r2 bgeq 10$ mnegl r2, r2 mnegl r4, r4 10$: ; Put f into R3; make it positive, and save the correct sign for the ; final result of our calculations in R4. movl @8(ap), r3 bgeq 20$ mnegl r3, r3 mnegl r4, r4 20$: ;-- Common code for the principal calculation for all these functions. ; At this point R2 and R3 should be the integers we multiply to get the ; dividend, R1 the divisor, and R4 the sign for the result. main_calc: ; Compute the dividend, R2 * R3. Output from the following is a ; quadword integer, in R2 and R3. emul r2, r3, #0, r2 ; Now divide the previous result by our divisor, R1. The quotient goes ; into R0, the remainder into R3. ediv r1, r2, r0, r3 ;-- Now checks for errors, rounding correction, and sign correction. ; Overflow checks. The BVS instruction checks for overflow as ; detected by EDIV, which uses the same criterion as Metafont ; (magnitude no greater than EL_GORDO, 2^31 - 1) for positive ; results. (A negative magnitude of 2^31 is allowed by the VAX, but ; we don't need to check for it because we made the input arguments ; positive.) bvs overflow ; If remainder R3 is more than half the divisor R1, increment our ; answer, because we want to round up and EDIV rounds down. rotl #1, r3, r3 cmpl r3, r1 blssu 10$ incl r0 bvs overflow 10$: ; Apply correct sign to the result. mull2 r4, r0 ; Successful return. Our answer is in R0. ret ;-- Overflow return: return EL_GORDO with the proper sign, and set ; the aritherror flag. overflow: mull3 #EL_GORDO, r4, r0 movb #TRUE, aritherror ret ; Code to handle indirect call of functions; we pass it a list of ; parameters, the last of which is the address of the routine to call and ; this code passes control to that routine with the given parameters. ; Contributed from MATHLIB by Ned Freed (Innosoft International): ; ned@ymir.claremont.edu .entry indirect,^m<> ashl #2,(ap),r0 addl2 ap,r0 callg (ap),@(r0) ret .end