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=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)=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)0: SEE IF R=ABS(A): SET R:=R-ABS(A) B 6Z2 AND TEST AGAIN. 6Z4 FSL,CF RF R0, 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 BA). 4Z9 AI,BI 0 A0) 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 BA). LB,N =X'00020103',N SWAP A/C INTG BITS 2Z9 AI,BF 0 A0, 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=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, -110 'TOO MANY TEMPS' U11-0014 9Z END