SUBROUTINE SORT(IFD,OFD) INTEGER IFD,OFD INTEGER LINBUF(32768),NAME(30) INTEGER INFIL(7),LINPTR(4096),NLINES,HIGH,LIM,LOW,T INTEGER GTEXT INTEGER OUTFD INTEGER MAKFIL,OPEN HIGH=0 10000 T=GTEXT(LINPTR,NLINES,LINBUF,IFD) CALL QUICK(LINPTR,NLINES,LINBUF) IF((T.NE.-1))GOTO 10002 IF((HIGH.GT.0))GOTO 10002 GOTO 10001 10002 HIGH=HIGH+(1) OUTFD=MAKFIL(HIGH) CALL PTEXT(LINPTR,NLINES,LINBUF,OUTFD) CALL CLOSE(OUTFD) 10001 CONTINUE IF((T.NE.-1))GOTO 10000 IF((HIGH.NE.0))GOTO 10003 CALL PTEXT(LINPTR,NLINES,LINBUF,OFD) CALL REWIND(OFD) RETURN 10003 LOW=1 GOTO 10006 10004 LOW=LOW+(7) 10006 IF((LOW.GE.HIGH))GOTO 10005 LIM=MIN0(LOW+7-1,HIGH) CALL GOPEN(INFIL,LOW,LIM) IF((LIM.LT.HIGH))GOTO 10007 CALL MERGE(INFIL,LIM-LOW+1,OFD) GOTO 10008 10007 HIGH=HIGH+(1) OUTFD=MAKFIL(HIGH) CALL MERGE(INFIL,LIM-LOW+1,OUTFD) CALL CLOSE(OUTFD) 10008 CALL GREMOV(INFIL,LOW,LIM) GOTO 10004 10005 CALL REWIND(OFD) RETURN END SUBROUTINE GNAME(N,NAME) INTEGER N INTEGER NAME(30) INTEGER AAAAA0(17) DATA AAAAA0/189,244,229,237,240,189,175,248,244,189,240,233,228,18 *9,170,233,0/ CALL ENCODE(NAME,30,AAAAA0,N) RETURN END INTEGER FUNCTION MAKFIL(N) INTEGER N INTEGER NAME(30) INTEGER CREATE CALL GNAME(N,NAME) MAKFIL=CREATE(NAME,3) IF((MAKFIL.NE.-3))GOTO 10009 CALL CANT(NAME) 10009 RETURN END SUBROUTINE GOPEN(INFIL,LOW,LIM) INTEGER INFIL(7) INTEGER LOW,LIM INTEGER NAME(30) INTEGER I INTEGER OPEN I=1 GOTO 10012 10010 I=I+(1) 10012 IF((I.GT.LIM-LOW+1))GOTO 10011 CALL GNAME(LOW+I-1,NAME) INFIL(I)=OPEN(NAME,1) IF((INFIL(I).NE.-3))GOTO 10013 CALL CANT(NAME) 10013 GOTO 10010 10011 RETURN END SUBROUTINE GREMOV(INFIL,LOW,LIM) INTEGER INFIL(7) INTEGER LOW,LIM INTEGER NAME(30) INTEGER I I=1 GOTO 10016 10014 I=I+(1) 10016 IF((I.GT.LIM-LOW+1))GOTO 10015 CALL CLOSE(INFIL(I)) CALL GNAME(LOW+I-1,NAME) CALL REMOVE(NAME) GOTO 10014 10015 RETURN END SUBROUTINE MERGE(INFIL,NFILES,OUTFIL) INTEGER INFIL(7),OUTFIL INTEGER NFILES INTEGER LINBUF(900) INTEGER GETLIN INTEGER I,INF,LBP,LP1,NF,LINPTR(7) LBP=1 NF=0 I=1 GOTO 10019 10017 I=I+(1) 10019 IF((I.GT.NFILES))GOTO 10018 IF((GETLIN(LINBUF(LBP),INFIL(I)).EQ.-1))GOTO 10020 NF=NF+(1) LINPTR(NF)=LBP LBP=LBP+(102) 10020 GOTO 10017 10018 CALL QUICK(LINPTR,NF,LINBUF) 10021 IF((NF.LE.0))GOTO 10022 LP1=LINPTR(1) CALL PUTLIN(LINBUF(LP1),OUTFIL) INF=LP1/102+1 IF((GETLIN(LINBUF(LP1),INFIL(INF)).NE.-1))GOTO 10023 LINPTR(1)=LINPTR(NF) NF=NF-(1) 10023 CALL REHEAP(LINPTR,NF,LINBUF) GOTO 10021 10022 RETURN END SUBROUTINE REHEAP(LINPTR,NF,LINBUF) INTEGER LINPTR(1),NF INTEGER LINBUF(32768) INTEGER I,J INTEGER COMPA0 I=1 GOTO 10026 10024 I=J 10026 IF((2*I.GT.NF))GOTO 10025 J=2*I IF((J.GE.NF))GOTO 10027 IF((COMPA0(LINPTR(J),LINPTR(J+1),LINBUF).LE.0))GOTO 10028 J=J+(1) 10028 CONTINUE 10027 IF((COMPA0(LINPTR(I),LINPTR(J),LINBUF).GT.0))GOTO 10029 GOTO 10025 10029 CALL EXCHAN(LINPTR(I),LINPTR(J),LINBUF) GOTO 10024 10025 RETURN END INTEGER FUNCTION GTEXT(LINPTR,NLINES,LINBUF,INFILE) INTEGER LINPTR(4096),NLINES INTEGER LINBUF(32768) INTEGER INFILE INTEGER LBP,LEN INTEGER GETLIN NLINES=0 LBP=1 10030 LEN=GETLIN(LINBUF(LBP),INFILE) IF((LEN.NE.-1))GOTO 10031 GOTO 10032 10031 NLINES=NLINES+(1) LINPTR(NLINES)=LBP LBP=LBP+(LEN+1) IF((LBP.GE.32768-102))GOTO 10033 IF((NLINES.GE.4096))GOTO 10033 GOTO 10030 10033 CONTINUE 10032 GTEXT=LEN RETURN END SUBROUTINE PTEXT(LINPTR,NLINES,LINBUF,OUTFIL) INTEGER LINPTR(4096),NLINES INTEGER LINBUF(32768) INTEGER OUTFIL INTEGER I,J I=1 GOTO 10036 10034 I=I+(1) 10036 IF((I.GT.NLINES))GOTO 10035 J=LINPTR(I) CALL PUTLIN(LINBUF(J),OUTFIL) GOTO 10034 10035 RETURN END INTEGER FUNCTION COMPA0(LP1,LP2,LINBUF) INTEGER LP1,LP2 INTEGER LINBUF(1) INTEGER C1,C2,UC1,UC2 INTEGER MAPUP INTEGER I,J I=LP1 J=LP2 10037 C1=LINBUF(I) C2=LINBUF(J) IF((C1.EQ.C2))GOTO 10038 GOTO 10039 10038 IF((C1.NE.0))GOTO 10040 COMPA0=0 RETURN 10040 I=I+(1) J=J+(1) GOTO 10037 10039 UC1=MAPUP(C1) UC2=MAPUP(C2) GOTO 10041 10042 COMPA0=-1 GOTO 10043 10044 COMPA0=+1 GOTO 10043 10045 COMPA0=-1 GOTO 10043 10041 IF((UC1.LT.UC2))GOTO 10042 IF((UC1.GT.UC2))GOTO 10044 IF((225.GT.C1))GOTO 10046 IF((C1.GT.250))GOTO 10046 GOTO 10045 10046 CONTINUE COMPA0=+1 10043 RETURN END SUBROUTINE EXCHAN(LP1,LP2,LINBUF) INTEGER LP1,LP2 INTEGER LINBUF(1) INTEGER K K=LP1 LP1=LP2 LP2=K RETURN END SUBROUTINE QUICK(LINPTR,NLINES,LINBUF) INTEGER LINPTR(1),NLINES INTEGER LINBUF(1) INTEGER I,J,LV(12),P,PIVLIN,UV(12) INTEGER COMPA0 LV(1)=1 UV(1)=NLINES P=1 10047 IF((P.LE.0))GOTO 10048 IF((LV(P).LT.UV(P)))GOTO 10049 P=P-(1) GOTO 10050 10049 I=LV(P)-1 J=UV(P) PIVLIN=LINPTR(J) 10051 IF((I.GE.J))GOTO 10052 I=I+(1) GOTO 10055 10053 I=I+(1) 10055 IF((COMPA0(LINPTR(I),PIVLIN,LINBUF).GE.0))GOTO 10054 GOTO 10053 10054 J=J-(1) GOTO 10058 10056 J=J-(1) 10058 IF((J.LE.I))GOTO 10057 IF((COMPA0(LINPTR(J),PIVLIN,LINBUF).GT.0))GOTO 10059 GOTO 10057 10059 GOTO 10056 10057 IF((I.GE.J))GOTO 10060 CALL EXCHAN(LINPTR(I),LINPTR(J),LINBUF) 10060 GOTO 10051 10052 J=UV(P) CALL EXCHAN(LINPTR(I),LINPTR(J),LINBUF) IF((I-LV(P).GE.UV(P)-I))GOTO 10061 LV(P+1)=LV(P) UV(P+1)=I-1 LV(P)=I+1 GOTO 10062 10061 LV(P+1)=I+1 UV(P+1)=UV(P) UV(P)=I-1 10062 P=P+(1) 10050 GOTO 10047 10048 RETURN END C ---- Long Name Map ---- C compare compa0 C initcrossref initc0 C putbackstr putbb0 C putback putba0 C obufcom obufc0 C buildcrossref build0 C underline under0 C dumpbuffer dumpb0 C enterkw enter0 C outputkeyword outpu0 C boldface boldf0 C skipblanksandcomments skipb0 C printcrossref print0