INTEGER * 4 FUNCTION PRIME(I) INTEGER * 4 I INTEGER FD,JUNK INTEGER OPEN,MAPFD INTEGER AAAAA0(13) DATA AAAAA0/189,225,245,248,189,175,240,242,233,237,229,243,0/ IF((I.LT.1))GOTO 10001 IF((I.GT.78498))GOTO 10001 GOTO 10000 10001 PRIME=0 RETURN 10000 FD=OPEN(AAAAA0,1) IF((FD.NE.-3))GOTO 10002 PRIME=0 RETURN 10002 CALL PRWF$$(:1+:10,MAPFD(FD),LOC(PRIME),2,(I-1)*2,JUNK,JUNK) CALL CLOSE(FD) RETURN END INTEGER * 4 FUNCTION INVMOD(X1,X0) INTEGER * 4 X1,X0 INTEGER * 4 XI,XIM1,XIM2 INTEGER * 4 AI,AIM1,AIM2,BI,BIM1,BIM2 INTEGER * 4 FACTOR XIM2=X0 AIM2=1 BIM2=0 XIM1=X1 AIM1=0 BIM1=1 10003 IF((XIM2.LE.XIM1))GOTO 10004 FACTOR=XIM2/XIM1 XI=MOD(XIM2,XIM1) AI=AIM2-FACTOR*AIM1 BI=BIM2-FACTOR*BIM1 GOTO 10005 10004 IF((XIM1.LE.XIM2))GOTO 10006 FACTOR=XIM1/XIM2 XI=MOD(XIM1,XIM2) AI=AIM1-FACTOR*AIM2 BI=BIM1-FACTOR*BIM2 GOTO 10007 10006 INVMOD=-3 RETURN 10007 CONTINUE 10005 XIM2=XIM1 AIM2=AIM1 BIM2=BIM1 XIM1=XI AIM1=AI BIM1=BI IF((XI.NE.1))GOTO 10003 IF((BI.GT.0))GOTO 10008 INVMOD=BI+X0 RETURN 10008 INVMOD=BI RETURN END INTEGER * 4 FUNCTION PWRMOD(P,EAAAA0,N) INTEGER * 4 P,EAAAA0,N INTEGER I INTEGER * 4 RESULT RESULT=1 I=1 GOTO 10011 10009 I=I+(1) 10011 IF((I.GT.32))GOTO 10010 IF((RT(RS(EAAAA0,32-I),1).NE.0))GOTO 10012 RESULT=MOD(RESULT*RESULT,N) GOTO 10013 10012 RESULT=MOD(MOD(RESULT*RESULT,N)*P,N) 10013 GOTO 10009 10010 PWRMOD=RESULT RETURN END INTEGER * 4 FUNCTION GCD(X0,X1) INTEGER * 4 X0,X1 INTEGER * 4 XI,XIM1,XIM2 INTEGER * 4 MAX0,MIN0,IABS XIM2=MAX0(X0,X1) XIM1=MIN0(X0,X1) 10014 IF((XIM2.LE.XIM1))GOTO 10015 XI=MOD(XIM2,XIM1) GOTO 10016 10015 XI=MOD(XIM1,XIM2) 10016 XIM2=XIM1 XIM1=XI IF((XI.NE.0))GOTO 10014 GCD=IABS(XIM2) RETURN END INTEGER FUNCTION SETCR0(SET,SIZE) INTEGER SET INTEGER SIZE INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER DSGET SET=DSGET(((SIZE+16-1)/16)+1) MEMAA0(SET)=SIZE CALL SETIN0(SET) SETCR0=SET RETURN END SUBROUTINE SETRE0(SET) INTEGER SET CALL DSFREE(SET) RETURN END SUBROUTINE SETIN0(SET) INTEGER SET INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE SIZE=((MEMAA0(SET)+16-1)/16) DO 10017 I=1,SIZE MEMAA0(SET+I)=0 10017 CONTINUE 10018 RETURN END SUBROUTINE SETCO0(SOURCE,DESTI0) INTEGER SOURCE,DESTI0 INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE SIZE=((MIN0(MEMAA0(SOURCE),MEMAA0(DESTI0))+16-1)/16) DO 10019 I=1,SIZE MEMAA0(DESTI0+I)=MEMAA0(SOURCE+I) 10019 CONTINUE 10020 RETURN END SUBROUTINE SETIO0(SET1,SET2,DESTI0) INTEGER SET1,SET2,DESTI0 INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE INTEGER AND SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/ *16) DO 10021 I=1,SIZE MEMAA0(DESTI0+I)=AND(MEMAA0(SET1+I),MEMAA0(SET2+I)) 10021 CONTINUE 10022 RETURN END SUBROUTINE SETUN0(SET1,SET2,DESTI0) INTEGER SET1,SET2,DESTI0 INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE INTEGER OR SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/ *16) DO 10023 I=1,SIZE MEMAA0(DESTI0+I)=OR(MEMAA0(SET1+I),MEMAA0(SET2+I)) 10023 CONTINUE 10024 RETURN END SUBROUTINE SETIP0(ELEME0,SET) INTEGER ELEME0 INTEGER SET INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER WORD INTEGER OR,LS IF((ELEME0.GT.MEMAA0(SET)))GOTO 10026 IF((ELEME0.LT.1))GOTO 10026 GOTO 10025 10026 CALL ERROR('in set_insert: element out of range.') 10025 WORD=SET+(ELEME0-1)/16+1 MEMAA0(WORD)=OR(MEMAA0(WORD),LS(1,16-1-MOD(ELEME0-1,16))) RETURN END SUBROUTINE SETDE0(ELEME0,SET) INTEGER ELEME0 INTEGER SET INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER WORD INTEGER AND,NOT,LS IF((ELEME0.GT.MEMAA0(SET)))GOTO 10028 IF((ELEME0.LT.1))GOTO 10028 GOTO 10027 10028 CALL ERROR('in set_delete: element out of range.') 10027 WORD=SET+(ELEME0-1)/16+1 MEMAA0(WORD)=AND(MEMAA0(WORD),NOT(LS(1,16-1-MOD(ELEME0-1,16)))) RETURN END INTEGER FUNCTION SETEL0(ELEME0,SET) INTEGER ELEME0 INTEGER SET INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER WORD INTEGER AND,LS IF((ELEME0.GT.MEMAA0(SET)))GOTO 10030 IF((ELEME0.LT.1))GOTO 10030 GOTO 10029 10030 CALL ERROR('in set_element: element out of range.') 10029 WORD=SET+(ELEME0-1)/16+1 IF((AND(MEMAA0(WORD),LS(1,16-1-MOD(ELEME0-1,16))).EQ.0))GOTO 10031 SETEL0=1 RETURN 10031 SETEL0=0 RETURN END LOGICAL FUNCTION SETEQ0(SET1,SET2) INTEGER SET1,SET2 LOGICAL SETSU0 SETEQ0=SETSU0(SET1,SET2).AND.SETSU0(SET2,SET1) RETURN END LOGICAL FUNCTION SETSU0(SET1,SET2) INTEGER SET1,SET2 INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE,SIZE1,SIZE2 INTEGER AND,NOT,SETEL0 SIZE1=MEMAA0(SET1) SIZE2=MEMAA0(SET2) IF((SIZE1.LE.SIZE2))GOTO 10032 I=SIZE2+1 GOTO 10035 10033 I=I+(1) 10035 IF((I.GT.SIZE1))GOTO 10034 IF((SETEL0(I,SET1).NE.1))GOTO 10036 SETSU0=.FALSE. RETURN 10036 GOTO 10033 10034 CONTINUE 10032 IF((SIZE2.LE.SIZE1))GOTO 10037 I=SIZE1+1 GOTO 10040 10038 I=I+(1) 10040 IF((I.GT.SIZE2))GOTO 10039 IF((SETEL0(I,SET2).NE.1))GOTO 10041 SETSU0=.FALSE. RETURN 10041 GOTO 10038 10039 CONTINUE 10037 SIZE=((MIN0(SIZE1,SIZE2)+16-1)/16) DO 10042 I=1,SIZE IF((AND(MEMAA0(SET1+I),NOT(MEMAA0(SET2+I))).EQ.0))GOTO 10044 SETSU0=.FALSE. RETURN 10044 CONTINUE 10042 CONTINUE 10043 SETSU0=.TRUE. RETURN END SUBROUTINE SETSV0(SET1,SET2,DESTI0) INTEGER SET1,SET2,DESTI0 INTEGER MEMAA0(1) COMMON /DS$MEM/MEMAA0 INTEGER I,SIZE INTEGER AND,NOT SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/ *16) DO 10045 I=1,SIZE MEMAA0(DESTI0+I)=AND(MEMAA0(SET1+I),NOT(MEMAA0(SET2+I))) 10045 CONTINUE 10046 RETURN END C ---- Long Name Map ---- C setequal seteq0 C setdelete setde0 C setcreate setcr0 C setintersect setio0 C element eleme0 C destination desti0 C setunion setun0 C E eaaaa0 C Mem memaa0 C setinit setin0 C setremove setre0 C setsubtract setsv0 C setelement setel0 C setcopy setco0 C setinsert setip0 C setsubset setsu0