TITLE 'EVAL-B00,10/10/73,DWG702985'
PAGE
*
*
* E X T E R N A L C O M M U N I C A T I O N
*
*
* DEFINITIONS
*
DEF EVAL@ START OF PROCEDURE
DEF FCEILING FLOATING CEILING
DEF FFACT FLOATING FACTORIAL
DEF FFCOMB FLOATING COMBINATORIAL
DEF FFCOMPAR FLOATING COMPARISON
DEF FFLOOR FLOATING FLOOR
DEF FFRESIDU FLOATING RESIDUE
DEF F2I FLOATING TO INTEGER CONVERSION
DEF ICEILING INTEGER CEILING
DEF IFACT INTEGER FACTORIAL
DEF IFLOOR INTEGER FLOOR
DEF IICOMB INTEGER COMBINATORIAL
DEF IIRESIDU INTEGER RESIDUE
DEF IROLL INTEGER ROLL
DEF SETFUZZ SET UP FUZZ VALUE
DEF SETORG SET UP ORIGIN VALUE
*
* REFERENCES
*
REF ERDOMAIN DOMAIN ERROR
REF EVALTMPS TEMPS LOCATED IN APLUTSI(WINDOW) U11-0004
REF FLOT0 FLOATING CONSTANT 0.0
REF FLOT1 FLOATING CONSTANT 1.0
REF FLOT2 FLOATING CONSTANT 2.0
REF FUZZBIT FUZZ BIT (DOUBLEWORD, ONE BIT)
REF FUZZCNT FUZZ COUNT
REF FUZZLIMS FUZZ LIMITS (FLOATED)
REF FUZZMASK FUZZ MASK
REF INTGOVFL INTEGER OVERFLOW (DOMAIN CHANGE)
REF ORGADJ ADJUSTED INDEX ORIGIN = 1-ORIGIN
REF ORIGIN INDEX ORIGIN
REF RANDOM RANDOM SEED
PAGE
*
*
* A S S E M B L Y P A R A M E T E R S
*
*
SYSTEM SIG5F
PROGSECT CSECT 1
EVAL@ RES 0 START OF PROCEDURE
*
* REGISTERS
*
N EQU 3 INDEX REG
LX EQU 5 INDEX LINK REG
AI EQU 7 LEFT ARG INTG
BI EQU 9 RIGHT ARG INTG
CI EQU 15 DIFFERENCE INTG
PI EQU 13 PRODUCT INTG
RI EQU 7 RESULT INTG
AF EQU 6 LEFT ARG FLOT
AF1 EQU 7 *
BF EQU 8 RIGHT ARG FLOT
BF1 EQU 9 *
CF EQU 14 DIFFERENCE FLOT
CF1 EQU 15 *
PF EQU 12 PRODUCT FLOT
RF EQU 6 RESULT FLOT
L2 EQU 13 LINK REG
L1 EQU 14 LINK REG
PAGE
*
*
* P R O C S
*
*
TLOC SET 0 U11-0006
*
TEMP CNAME 1
DTEMP CNAME 2
PROC
DO1 NAME=2
TLOC SET TLOC+(TLOC&1) U11-0009
DISP TLOC U11-0010
LF EQU EVALTMPS+TLOC U11-0011
TLOC SET TLOC+NAME U11-0012
PEND
*
*
EVEN CNAME 0
ODD CNAME 1
PROC
LF EQU %
ERROR,1,(CF(2)+NAME)&1 'REGISTER HAS WRONG PARITY'
PEND
*
*
EQUAL CNAME
PROC
LF EQU %
ERROR,1,1-(CF(2)=CF(3)) 'REGISTERS MUST BE EQUAL'
PEND
PAGE
*
*
* FUZZ APPLYING PROCS
*
*
OPEN R
FUZZ CNAME
PROC
ERROR,1,1-((NUM(AF)>0)&(NUM(CF)=2)) 'BAD AF OR CF'
R SET CF(2) SET REGISTER
LF CLM,R FUZZLIMS IF VALUE WITHIN FUZZ (ABSOLUTE)
BCR,9 AF OF ZERO, GO TO GIVEN LOC.
AD,R FUZZBIT PERTURB VALUE SLIGHTLY UPWARDS
CW,R =X'00F00000' TEST SIGN AND FRACTION OVFL
BCS,5 %+2 IF POSITIVE, AND FRACTION OVFL,
* LEAVE EXPON INCREASED BY 1,
AW,R =X'00100000' AND SET FRACTION = .1.
AND,R+1 FUZZMASK DISCARD A FEW FRACTION BITS
FAL,R FLOT0 GUARANTEE VALUE PROPERLY NORMALYZED
PEND
CLOSE R
PAGE
*
*
* F U N C T I O N E V A L U A T O R S
*
*
* THE FUNCTION EVALUATION SUBROUTINES MUST NOT CLOBBER
* REGISTERS 1, 2, 4, 10, 11 (KNOWN BY XSEG-GENERATING
* MODULES AS N, K, N1, N2, AND N3).
*
*
USECT PROGSECT
*
*
* FLOATING TO INTEGER CONVERSION
*
* CONVERTS FLOATING VALUE IN AF/AF1 TO INTEGER VALUE
* IN AI, IF POSSIBLE. LINK IS LX AND THERE ARE TWO
* RETURNS:
* BAL+1: THE VALUE IS WAY TOO BIG IN MAGNITUDE
* (A NEGATIVE AI IS RETURNED), OR IT WAS
* IN RANGE BUT NOT WITHIN 'FUZZ' OF AN
* INTEGER (ITS 'FLOOR' IS RETURNED IN AI).
* BAL+2: THE VALUE IS WITHIN 'FUZZ' OF AN INTEGER,
* WHICH IS RETURNED IN AI, WITH LCC SET.
*
F2I EQU %
CLM,AF INTGLIMS IS VALUE IN RANGE ?
BCR,9 7Z2
LI,AI -1 NO, SET AI NEGATIVE
B 0,LX AND RETURN TO BAL+1.
7Z2 FUZZ,AF 7Z4 APPLY FUZZ TO VALUE
STD,AF X
FAL,AF BIG YES, PUT INTG PART IN AF1 (=AI).
STW,AF1 NUMER SAVE INTG PART
FSL,AF BIG SEE IF FRACTION WAS ZERO
CD,AF X
BE 7Z3
LW,AI NUMER NO, GET FLOOR
B 0,LX AND TAKE BAL+1 RETURN.
7Z3 LW,AI NUMER YES, GET VALUE
B 1,LX AND TAKE BAL+2 RETURN.
7Z4 LI,AI 0 VALUE NEAR ZERO: SET
STD,AI X SAVE DW ZERO FOR FL. PT. USE
B 1,LX RESULT =0, TAKE OK EXIT.
*
*
BOUND 8
INTGLIMS DATA X'B7800000',X'487FFFFF'
BIG DATA X'4E200000',0
EXPON4E DATA X'4E000000',0
FLOT1X DATA X'40FFFFFF',X'FFFFFFFF'
PAGE
*
*
* INTEGER FLOOR
*
* COMPUTES THE INTEGER FLOOR OF A FLOATING ARG, IF
* WITHIN RANGE. LINK IS LX.
*
IFLOOR EQU %
FSL,AF FUZZNEG APPLY FUZZ (ABSOLUTE)
BGEZ %+2 SUBTRACT 1 FROM NEGATIVE VALUE
FSL,AF FLOT1X SINCE FAL TRUNCATES TOWARDS ZERO.
CLM,AF INTGLIMS IF PERTURBED VALUE IS IN INTG RANGE,
BCS,9 INTGOVFL
FAL,AF BIG PUT INTG PART IN AF1 (=AI).
B 0,LX RETURN
*
*
* INTEGER CEILING
*
* COMPUTES THE INTEGER CEILING OF A FLOATING ARG, IF
* WITHIN RANGE. LINK IS L1.
*
ICEILING EQU %
LCD,AF AF CEILING(X)
BAL,LX IFLOOR = -FLOOR(-X)
LCW,AI AI
BNOV *L1
B INTGOVFL
PAGE
*
*
* FLOATING FLOOR
*
* COMPUTES THE FLOATING FLOOR OF A FLOATING ARG.
* LINK IS LX.
*
FFLOOR EQU %
FSL,AF FUZZNEG APPLY FUZZ (ABSOLUTE)
BGEZ %+2 SUBTRACT 1 FROM NEGATIVE VALUE
FSL,AF FLOT1X SINCE FAL TRUNCATES TOWARDS ZERO.
FAL,AF EXPON4E TRUNCATE FRACTION
B 0,LX RETURN
*
*
* FLOATING CEILING
*
* COMPUTES THE FLOATING CEILING OF A FLOATING ARG.
* LINK IS L1.
*
FCEILING EQU %
LCD,AF AF CEILING(X)
BAL,LX FFLOOR = -FLOOR(-X)
LCD,AF AF
B *L1
PAGE
*
*
* FLOATING COMPARISON SETUP
*
* APPLIES FUZZ TO THE TWO FLOATING POINT
* VALUES IN 'AF' AND 'BF'. LINK IS LX.
*
FFCOMPAR EQU %
FUZZ,BF 8Z2 APPLY FUZZ TO BF
8Z1 FUZZ,AF FZERORTN APPLY FUZZ TO AF
B 0,LX RETURN
8Z2 LD,BF FLOT0 BF NEAR ZERO: SET IT TO 0.0
B 8Z1 DO AF
*
FZERORTN LI,AF 0 FLOT ZERO: BOTH AF WORDS =0
IZERORTN LI,AI 0 INTG ZERO: AI=0
B 0,LX RETURN
PAGE
*
*
* INTEGER ROLL
*
* COMPUTES A RANDOM INTEGER N IN THE RANGE
* ORIGIN <= N <= (AI)+ORIGIN-1. IT IS RETURNED
* IN AI. LINK IS LX. RANDOM SEED IS UPDATED.
*
IROLL EQU %
AI,AI 0 MAKE SURE IT'S POSSIBLE TO PICK N;
BLEZ ERDOMAIN I.E., WE NEED AI>0.
XW,AI RANDOM SAVE ARG, GET RANDOM SEED VALUE
ODD,AI
MI,AI 65539 UPDATED SEED =
AND,AI =X'7FFFFFFF' SEED*65539 (MOD 2**31).
XW,AI RANDOM STORE UPDATED SEED, GET ARG
MW,AI-1 RANDOM N = FLOOR(ARG*SEED/(2**31))+ORIGIN
SLD,AI-1 -31
AW,AI ORIGIN <= ARG, SO NO OVFL MAY OCCUR.
B 0,LX
PAGE
*
*
* SET FUZZ VALUE
*
* GIVEN 'K' (THE NUMBER OF BITS TO IGNORE) IN AI, WITH
* 0<=K<=31, THIS ROUTINE SETS UP ALL FUZZ-DEPENDENT
* PARAMETERS AND RETURNS TO BAL+2 WITH THE OLD K VALUE
* IN AI. IF K IS NOT IN RANGE, IT RETURNS TO BAL+1
* WITHOUT CHANGING FUZZ. LINK IS LX.
*
SETFUZZ EQU %
CI,AI -32 IF K<0 OR K>31,
BANZ 0,LX RETURN TO BAL+1.
LI,BF 0 SET FUZZBIT = 2**(K-1), A DOUBLEWORD
LI,BF1 1 QUANTITY CONTAINING EXACTLY ONE
SLD,BF -1,AI 1-BIT, FOLLOWED BY K-1 ZEROS.
STD,BF FUZZBIT
LW,BF =X'40000000' INSTALL EXPONENT TO FLOAT
SFL,BF 14 FUZZBIT VALUE.
STW,BF FUZZLIMS+1 +FUZZBIT(FLOATED) IS UPPER LIM
LCW,BF BF
STW,BF FUZZLIMS -FUZZBIT(FLOATED) IS LOWER LIM
LI,BF1 1
SLS,BF1 0,AI
LCW,BF1 BF1 SET FUZZMASK = -2**K, A SINGLE
STW,BF1 FUZZMASK WORD MASK OF 32-K ONES, K ZEROS.
XW,AI FUZZCNT STORE NEW K, GET OLD K
B 1,LX RETURN TO BAL+2
*
*
* SET ORIGIN VALUE
*
* GIVEN 'G' (THE INDEX ORIGIN) IN AI, WITH 0<=G<=1,
* THIS ROUTINE SETS UP ALL ORIGIN-DEPENDENT PARAMETERS
* AND RETURNS TO BAL+2 WITH THE OLD G VALUE IN AI.
* IF G IS NOT IN RANGE, IT RETURNS TO BAL+1 WITHOUT
* CHANGING ORIGIN. LINK IS LX.
*
SETORG EQU %
CI,AI -2 IF G<0 OR G>1,
BANZ 0,LX RETURN TO BAL+1.
EOR,AI =1 1-G
STW,AI ORGADJ SET NEW 'ADJUSTED ORIGIN'
EOR,AI =1 RESTORE G
XW,AI ORIGIN SAVE NEW G, GET OLD G
B 1,LX RETURN TO BAL+2
PAGE
*
*
* INTEGER RESIDUE
*
* COMPUTES R = RESIDUE(A,B) = B-A*K >= 0 FOR INTEGER
* A AND B. LINK IS LX. NO OVERFLOW IS POSSIBLE SINCE
* EITHER 0<=R<ABS(A) OR R=B.
*
IIRESIDU EQU %
LAW,CI AI COPY ABS(A) TO CI (OVFL MAY BE
* IGNORED; CODE WORKS IN ALL CASES).
BNEZ 5Z1 IS A ZERO ?
LW,RI BI A=0. IF B>=0, R=B.
BGEZ 0,LX
B ERDOMAIN ELSE, R UNDEFINED.
5Z1 LW,RI BI A NONZERO, EXTEND B'S SIGN
BGEZ 5Z2 SO WE CAN DIVIDE B BY ABS(A)
LI,RI-1 -1 AND GET THE REMAINDER.
B 5Z3
5Z2 LI,RI-1 0
5Z3 DW,RI-1 CI DIVIDE: REM=B-A*J IS IN RI-1
BNOV 5Z4 THE ONLY WAY IT CAN OVFL IS FOR
LI,RI 0 A=+-1, B=-2**31; WHENCE R=0.
B 0,LX
5Z4 LW,RI RI-1 R=B-A*J; ABS(R)<ABS(A)
BGEZ 0,LX IF R>=0, WE'RE DONE
AW,RI CI ELSE R:=R+ABS(A) >0
B 0,LX
PAGE
*
*
* FLOATING RESIDUE
*
*
* COMPUTES R = RESIDUE(A,B) = B-A*K >= 0 FOR FLOATING
* A AND B. LINK IS LX.
*
FFRESIDU EQU %
LAD,CF AF C:=ABS(A)
BNEZ 6Z1
LD,RF BF A=0; IF B>=0,R=B.
BGEZ 0,LX
B ERDOMAIN ELSE, R UNDEFINED.
6Z1 LD,RF BF A NON ZERO, SAVE B
FDL,BF CF B:= B/ABS(A)
FAL,BF EXPON4E B:= FLOOR(B/ABS(A)) = J
FML,BF CF
FSL,RF BF R:= B-J*ABS(A); ABS(R)<ABS(A)
6Z2 CLM,RF FUZZLIMS IF R IS WITHIN FUZZ OF ZERO,
BCR,9 FZERORTN SET R=0 AND EXIT.
BGZ 6Z3
FAL,RF CF R<0: SET R:=R+ABS(A)
B 6Z2 AND TEST AGAIN.
6Z3 CD,RF CF R>0: SEE IF R<ABS(A)
BL 6Z4 R<ABS(A), SEE IF VERY NEAR ABS(A)
FSL,RF CF R>=ABS(A): SET R:=R-ABS(A)
B 6Z2 AND TEST AGAIN.
6Z4 FSL,CF RF R<ABS(A): SEE IF R IS WITHIN FUZZ
CLM,CF FUZZLIMS OF ABS(A).
BCS,9 0,LX NO: EXIT.
B FZERORTN YES: SET R:=0 AND EXIT.
PAGE
*
*
* INTEGER FACTORIAL
*
* 'IFACT' COMPUTES R=FACTORIAL(A) FOR AN INTEGER ARG.
* LINK IS LX.
*
IFACT LW,N AI COPY ARG (AI=RI)
BGZ 3Z2 IF A>0, GO INTO MULTIPLY LOOP
BLZ ERDOMAIN IF A<0, DOMAIN ERROR
LI,RI 1 A=0; FACT(0)=1
B 0,LX RETURN
EQUAL,AI,RI INITIALLY, R=A
3Z1 ODD,RI
MW,RI N R:=R*N, N>=1
BNOV 3Z2 CONTINUE IF PRODUCT OK
B INTGOVFL ELSE, INTEGER OVERFLOW
3Z2 BDR,N 3Z1 N:=N-1
B 0,LX N=0, R=FACT(A); RETURN
PAGE
*
*
* FLOATING FACTORIAL
*
* 'FFACT' COMPUTES R=FACTORIAL(A) FOR A FLOATING ARG.
* LINK IS LX. DOMAIN ERRORS RESULT IN DIVISION BY ZERO.
*
* NOTE: (1) 'CW' COMMANDS ARE USED INSTEAD OF 'CD'; THEY
* HAVE THE SAME EFFECT FOR THE GIVEN DATA
* AND ARE FASTER.
* (2) INTERMEDIATE RESULTS ARE KEPT IN REGS INSTEAD
* OF CORE; THE EXTRA TIME REQ'D BY FML/FDL
* IS LESS THAN THAT REQ'D BY EXTRA LD AND STD.
*
FFACT EQU %
STW,LX LINKTEMP SAVE LINK
BAL,L2 FIXIT IF ARG NEAR INTG, MAKE IT EXACT
BLZ ERDOMAIN IF ARG = NEG INTG, ERROR
LD,PF FLOT1 P:=1
AI,AF 0 TEST ARGUMENT
BGEZ 1Z3
1Z1 FAL,AF FLOT1 A<0, A:=A+1
FDL,PF AF P:=P/A
AI,AF 0 CONTINUE UNTIL A>=0
BLZ 1Z1
B 1Z4
1Z2 FML,PF AF A>=1, P:=P*A
FSL,AF FLOT1 A:=A-1
1Z3 CW,AF FLOT1 CONTINUE UNTIL A<1
BGE 1Z2
1Z4 LW,LX LINKTEMP RESTORE LINK
*
* WE NOW HAVE 0<=A<1, AND MAY EVALUATE FACT(A)
* = FACT(A+1)/(A+1), WHERE FACT(A+1) IS EVALUATED
* AS A DEGREE 15 POLYNOMIAL IN 'A'.
*
* 'FACTPOLY' IS ALSO CALLED BY THE COMBINATORIAL ROUTINE
* TO PERFORM R:=P*FACT(A) WHERE 0<=A<1.
*
FACTPOLY EQU %
STD,AF X X:=A
FAL,AF FLOT1
STD,AF Y Y:=A+1
LD,RF COEFF15
LI,N 15
1Z5 FML,RF X R:=SUM(I=0,15) OF C(I)*X**I
FAL,RF COEFF0-2,N =FACT(A+1)
BDR,N 1Z5
FDL,AF Y R:= FACT(A+1)/(A+1) = FACT(A)
FML,RF PF R:=P*FACT(A)
B 0,LX RETURN
PAGE
*
*
* INTEGER COMBINATORIAL
*
* 'IICOMB' COMPUTES R=COMBINATORIAL(A,B)
* =FACT(B)/(FACT(A)*FACT(B-A))
* FOR INTEGER ARGS. LINK IS LX.
*
IICOMB EQU %
LW,CI BI C=B-A
SW,CI AI
BGZ 4Z9
BLZ 4Z5
4Z4 LI,RI 1 A=0 OR C=0: R= 1
B 0,LX
4Z5 AI,AI 0 B<A
BGZ 4Z8
BEZ 4Z4 IF A=0, R=1
4Z7 LI,RI 0 B<A<0 OR ...: R= 0
B 0,LX
4Z8 XW,AI CI B<A, 0<A: SWAP A/C (C<0<A, SO THAT
* HEREAFTER, A<0<C, B>A).
4Z9 AI,BI 0 A<B
BLZ 4Z15 IF A<B<0, R= A+ / C-
AI,AI 0
BGZ 4Z10
BLZ 4Z7 A<0<=B: R= 0
B 4Z4 A=0: R= 1
4Z10 CW,CI AI 0<A<B: SET C:=MIN(A,C), R= B- / C-
BLE 4Z11
LW,CI AI
4Z11 LW,AI BI INIT NUMERATOR TO 1ST FACTOR (=B)
LW,N CI INIT DENOM AND COUNT = C (>0)
4Z12 BDR,N 4Z13 COUNT LOOP, DECR DENOM FACTOR
DW,AI CI DONE: R = NUMER/DENOM
B 0,LX RETURN
4Z13 AI,BI -1 DECR NUMER FACTOR
MW,AI BI INCLUDE NEW FACTOR IN NUMER
BNOV 4Z14
B INTGOVFL
4Z14 MW,CI N INCLUDE NEW FACTOR IN NUMER
BNOV 4Z12 CONTINUE
B INTGOVFL
4Z15 AI,AI 1 R = A+ / C-
LW,BI AI INIT NUMER TO 1ST FACTOR (=A+1)
LW,N CI INIT DENOM AND COUNT = C (>0)
4Z16 BDR,N 4Z17 COUNT LOOP, DECR DENOM FACTOR
DW,AI CI DONE: R = NUMER/DENOM
B 0,LX RETURN
4Z17 AI,BI 1 INCR NUMER FACTOR
MW,AI BI INCLUDE NEW FACTOR IN NUMER
BNOV 4Z18
B INTGOVFL
4Z18 MW,CI N INCLUDE NEW FACTOR IN DENOM
BNOV 4Z16
B INTGOVFL
PAGE
*
*
* FLOATING COMBINATORIAL
*
* 'FFCOMB' COMPUTES R=COMBINATORIAL(A,B)
* =FACT(B)/(FACT(A)*FACT(B-A))
* FOR FLOATING ARGS. LINK IS L1.
*
FFCOMB EQU %
STW,L1 LINKTEMP SAVE LINK (=CF)
LD,CF BF
FSL,CF AF C:=B-A
*
* PART 1 - DETERMINE WHICH ONES AMONG A,B,C ARE WITHIN
* FUZZ OF INTEGERS.
*
LI,N 0 INIT CODE: NEITHER A/C INTEGER
BAL,L2 FIXIT IF 'A' NEAR INTEGER, MAKE IT EXACT,
AI,N 1 AND SET 'A INTG' BIT.
XW,AF CF SWAP A/C (BIT 31 OF N IS REALLY
XW,AF1 CF1 'C INTG' BIT).
BAL,L2 FIXIT IF 'A' NEAR INTEGER, MAKE IT EXACT,
AI,N 2 AND SET 'A INTG' BIT.
B 2Z1,N
2Z1 B 2Z2 NEITHER A/C INTG: TRY 'B'
B 2Z3 ONLY 'C' INTG: GO TEST SIGNS
B 2Z3 ONLY 'A' INTG: GO TEST SIGNS
LD,BF AF BOTH A/C INTG: MAKE 'B' EXACTLY
FAL,BF CF = A+C.
B 2Z3 GO TEST SIGNS
2Z2 XW,AF BF NEITHER A/C INTG: TEMPORARILY
XW,AF1 BF1 SWAP A/B TO TEST 'B'.
BAL,L2 FIXIT IF 'B' NEAR INTG, MAKE IT EXACT,
BLZ ERDOMAIN AND REQUIRE B>=0.
XW,AF BF UPDATE 'B' AND RESTORE 'A'
XW,AF1 BF1
*
* PART 2 - CASE TESTING, ACCORDING TO SIGNS OF A,B,C
*
2Z3 LD,PF FLOT1 P:=1
AI,CF 0 TEST C (=B-A)
BGZ 2Z9
BLZ 2Z5
2Z4 LD,RF FLOT1 A=0 OR C=0: R= 1
B *LINKTEMP
2Z5 AI,AF 0 B<A
BGZ 2Z8
BEZ 2Z4 IF A=0, R=1
B 2Z6,N
2Z6 B 2Z31 B<A<0, A&C FRAC: R= A+ C+ / B+
B 2Z7 B<A<0, C INTG: R= 0
B 2Z7 B<A<0, A INTG: R= 0
2Z7 LD,RF FLOT0 B<A<0, A&C INTG: R= 0
B *LINKTEMP
2Z8 XW,AF CF B<A, 0<A: SWAP A/C (C<0<A, SO THAT
XW,AF1 CF1 HEREAFTER, A<0<C, B>A).
LB,N =X'00020103',N SWAP A/C INTG BITS
2Z9 AI,BF 0 A<B
BLZ 2Z12,N
AI,AF 0 A<B, 0<=B
BGZ 2Z11,N
BLZ 2Z10,N
B 2Z4 A=0: R= 1
2Z10 B 2Z39 A<0<=B, A&C FRAC: R= A+ B- / C-
B 2Z22 A<0<=B, C INTG: R= B- / C-
B 2Z7 A<0<=B, A INTG: R= 0
B 2Z7 A<0<=B, A&C INTG: R= 0
2Z11 B 2Z42 0<A<B, A&C FRAC: R= B- / A- C-
B 2Z22 0<A<B, C INTG: R= B- / C-
B 2Z21 0<A<B, A INTG: R= B- / A-
CD,CF AF 0<A<B, A&C INTG: SET C=MIN(A,C),
BLE 2Z22 THEN R= B- / C-
B 2Z21
2Z12 B 2Z35 A<B<0, A&C FRAC: R= A+ / B+ C-
B 2Z23 A<B<0, C INTG: R= A+ / C-
B 2Z7 A<B<0, A INTG: R= 0
B 2Z23 A<B<0, A&C INTG: R= A+ / C-
*
* PART 3 - RUN ONE OR TWO LOOPS TO GET A,B,C DOWN TO VALUES
* BETWEEN 0 AND 1, SO THAT THEIR FACTORIALS ARE COMPUTABLE.
*
* INTEGER CASES (C IS A POSITIVE INTEGER, SO R MAY BE
* COMPUTED DIRECTLY BY A MULTIPLY-DIVIDE LOOP; FRACTIONAL
* FACTORIALS CANCEL):
*
2Z21 LD,CF AF A>0, A INTG
2Z22 FML,PF BF C>0, C INTG: P:=P*B/C
FDL,PF CF
FSL,BF FLOT1 B:=B-1
FSL,CF FLOT1 C:=C-1
BGZ 2Z22 CONTINUE UNTIL C=0
LD,RF PF R = P
B *LINKTEMP RETURN
2Z23 FAL,AF FLOT1 C>0, C INTG: A:=A+1
FML,PF AF P:=P*A/C
FDL,PF CF
FSL,CF FLOT1 C:=C-1
BGZ 2Z23 CONTINUE UNTIL C=0
LD,RF PF R = P
B *LINKTEMP RETURN
*
* FRACTIONAL CASES:
*
2Z31 FAL,AF FLOT1 B<A<0, A:=A+1
FAL,BF FLOT1 B:=B+1
FML,PF AF P:=P*A/B
FDL,PF BF
AI,AF 0 B<A<1
BLZ 2Z31
B 2Z33 A OK, B<A
2Z32 FAL,BF FLOT1 A OK, B<0, B:=B+1
FAL,CF FLOT1 C:=C+1
FML,PF CF P:=P*C/B
FDL,PF BF
2Z33 AI,BF 0 A OK, B<1
BLZ 2Z32
B 2Z45 A,B OK
2Z35 FAL,AF FLOT1 A<=B<0, A:=A+1
FAL,BF FLOT1 B:=B+1
FML,PF AF P:=P*A/B
FDL,PF BF
AI,BF 0 A<=B<1
BLZ 2Z35
B 2Z37 B OK, A<=B
2Z36 FAL,AF FLOT1 B OK, A<0, A:=A+1
FML,PF AF P:=P*A/C
FDL,PF CF
FSL,CF FLOT1 C:=C-1
2Z37 AI,AF 0 B OK, A<1
BLZ 2Z36
B 2Z45 A,B OK
2Z39 FAL,AF FLOT1 A<0<=B, A:=A+1
FML,PF AF P:=P*A/C
FDL,PF CF
FSL,CF FLOT1 C:=C-1
AI,AF 0 A<1, B>=0
BLZ 2Z39
B 2Z44 A OK, B>=0
2Z41 FML,PF BF 1<=A<=B, P:=P*B/A
FDL,PF AF
FSL,AF FLOT1 A:=A-1
FSL,BF FLOT1 B:=B-1
2Z42 CW,AF FLOT1 0<=A<=B
BGE 2Z41
B 2Z44 A OK, B>=A
2Z43 FML,PF BF A OK, B>=1, P:=P*B/C
FDL,PF CF
FSL,BF FLOT1 B:=B-1
FSL,CF FLOT1 C:=C-1
2Z44 CW,BF FLOT1 A OK, B>=0
BGE 2Z43
2Z45 EQU % A,B OK
*
* WE NOW HAVE 0<=A<1, 0<=B<1, AND C=B-A; THUS, -1<C<1.
* R = P*FACT(B)/(FACT(A)*FACT(C)) MAY BE EVALUATED
* BY USING THE FACTORIAL POLYNOMIAL FOR A AND B;
* C MAY REQUIRE AN UPWARD SHIFT OF 1.
*
AI,CF 0 A,B OK, -1<C<1
BGEZ 2Z46
FAL,CF FLOT1 A,B OK, -1<C<0, C:=C+1
FML,PF CF P:=P*C
2Z46 STD,PF NUMER A,B,C OK, SAVE P
LD,PF FLOT1 P:=1
BAL,LX FACTPOLY R:=FACT(A)
LD,PF RF
LD,AF CF
BAL,LX FACTPOLY R:=FACT(A)*FACT(C)
STD,RF DENOM SAVE IT
LD,AF BF
LD,PF NUMER
BAL,LX FACTPOLY R:=P*FACT(B)
FDL,RF DENOM R:=P*FACT(B)/(FACT(A)*FACT(C))
B *LINKTEMP =COMB(A,B); RETURN
PAGE
*
*
* CHECK FOR NEARNESS OF F.P. VALUE TO INTEGER
*
* IF 'AF' IS WITHIN FUZZ OF AN INTEGER, 'FIXIT' RETURNS
* TO BAL+1 WITH THE EXACT F.P. REPRESENTATION OF THAT
* INTEGER IN 'AF'. OTHERWISE, IT RETURNS TO BAL+2 WITH
* 'AF' UNCHANGED. IN EITHER CASE, SIGN INFO IS RETURNED
* IN LCC. LINK IS L2. BF/CF ARE NOT CLOBBERED.
*
FIXIT EQU %
STD,AF Y SAVE THE GIVEN VALUE
BAL,LX F2I ATTEMPT TO CONVERT TO INTEGER
B 9Z1 NO WAY: BRANCH
LD,AF X YUP: GET F.P. VERSION CREATED
B *L2 BY 'F2I' AND RETURN TO BAL+1.
9Z1 AI,L2 1 FRACTIONAL: BUMP RETURN ADR
LD,AF Y RESTORE ORIGINAL VALUE, SET LCC
B *L2 RETURN TO BAL+2
PAGE
*
*
* LOCAL DATA/TEMPS
*
*
X DTEMP FACT: ARG FOR POLYNOMIAL EVAL
Y DTEMP FACT: DIVISOR FOR POLYNOMIAL EVAL
NUMER DTEMP COMB: NUMERATOR
DENOM DTEMP COMB: DENOMINATOR
LINKTEMP TEMP LINK REG SAVE TEMP
*
* FACTORIAL POLYNOMIAL COEFFICIENTS
*
BOUND 8
COEFF0 DATA,8 FL'+0.9999999999999999032'
DATA,8 FL'+0.4227843350985151178'
DATA,8 FL'+0.4118403304219814831'
DATA,8 FL'+0.0815769194013886786'
DATA,8 FL'+0.0742490079434012692'
DATA,8 FL'-0.0002669510287555266'
DATA,8 FL'+0.0111538196719066992'
DATA,8 FL'-0.0028515012430346494'
DATA,8 FL'+0.0020997590350770629'
DATA,8 FL'-0.0009083465574200521'
DATA,8 FL'+0.0004677678114964956'
DATA,8 FL'-0.0002064476319159326'
DATA,8 FL'+0.0000815530498066373'
DATA,8 FL'-0.0000248410053848712'
DATA,8 FL'+0.0000051063592072582'
COEFF15 DATA,8 FL'-0.0000005113262726698'
PAGE
*
*
* GLOBAL DATA
*
*
* THE FOLLOWING IS INCLUDED TO INDICATE THE NAMES,
* STRUCTURE, AND DEFAULT VALUES OF THE VARIOUS GLOBAL
* PARAMETERS PERTINENT TO FUNCTION EVALUATION.
*
DO 0
*
CSECT 0
BOUND 8
FUZZBIT DATA 0,X'200' 1-BIT IN LEAST SIGNIFICANT POSITION
FUZZLIMS DATA -X'35200000',; LIMITS FOR TESTING ABSOLUTE
+X'35200000' DISTANCE TO ZERO.
FUZZMASK DATA X'FFFFFC00' RIGHT-HALF SIGNIFICANCE MASK
FUZZCNT DATA 10 COUNT OF BITS TO BE IGNORED (0...31)
ORGADJ DATA 0 1-ORIGIN
ORIGIN DATA 1 INDEX ORIGIN (0 OR 1)
RANDOM DATA 123456789 RANDOM SEED (MUST BE ODD)
*
FIN
FUZZNEG EQU FUZZLIMS =-FUZZ VAL (ALMOST) IN F.L. FORM
*
ERROR,X'F',TLOC>10 'TOO MANY TEMPS' U11-0014
9Z END