         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                                                                    
