INTEGER LINBUF(16384),NAME(30),KEYBUF(16384) INTEGER GTEXT,MAKFIL,OPEN,NEXTF0 INTEGER INFIL(6),KEYPTR(2048),NLINES INTEGER HIGH,LIM,LOW,OUTFD,T,ARGP,IFD CALL OPTARG(ARGP) IF((NEXTF0(ARGP,IFD).NE.-1))GOTO 10000 IFD=-10 10000 HIGH=0 10001 CONTINUE 10002 T=GTEXT(KEYPTR,NLINES,KEYBUF,LINBUF,IFD) CALL QUICK(KEYPTR,NLINES,KEYBUF) HIGH=HIGH+(1) OUTFD=MAKFIL(HIGH) CALL PTEXT(KEYPTR,NLINES,KEYBUF,LINBUF,OUTFD) CALL CLOSE(OUTFD) IF((T.NE.-1))GOTO 10002 IF((IFD.EQ.-10))GOTO 10003 CALL CLOSE(IFD) 10003 CONTINUE IF((NEXTF0(ARGP,IFD).NE.-1))GOTO 10001 LOW=1 GOTO 10006 10004 LOW=LOW+(6) 10006 IF((LOW.GE.HIGH))GOTO 10005 LIM=MIN0(LOW+6-1,HIGH) CALL GOPEN(INFIL,LOW,LIM) HIGH=HIGH+(1) OUTFD=MAKFIL(HIGH) CALL MERGE(INFIL,LIM-LOW+1,OUTFD) CALL CLOSE(OUTFD) CALL GREMOV(INFIL,LOW,LIM) GOTO 10004 10005 CALL GNAME(HIGH,NAME) OUTFD=OPEN(NAME,1) IF((OUTFD.NE.-3))GOTO 10007 CALL CANT(NAME) 10007 CALL FCOPY(OUTFD,-11) CALL CLOSE(OUTFD) CALL REMOVE(NAME) CALL SWT END SUBROUTINE GNAME(N,NAME) INTEGER NAME(30) INTEGER N INTEGER AAAAA0(18) DATA AAAAA0/189,244,229,237,240,189,175,243,244,164,189,240,233,22 *8,189,170,233,0/ CALL ENCODE(NAME,30,AAAAA0,N) RETURN END INTEGER FUNCTION MAKFIL(N) INTEGER NAME(30) INTEGER CREATE INTEGER N CALL GNAME(N,NAME) MAKFIL=CREATE(NAME,3) IF((MAKFIL.NE.-3))GOTO 10008 CALL CANT(NAME) 10008 RETURN END SUBROUTINE GOPEN(INFIL,LOW,LIM) INTEGER NAME(30) INTEGER I,INFIL(6),LIM,LOW INTEGER OPEN I=1 GOTO 10011 10009 I=I+(1) 10011 IF((I.GT.LIM-LOW+1))GOTO 10010 CALL GNAME(LOW+I-1,NAME) INFIL(I)=OPEN(NAME,1) IF((INFIL(I).NE.-3))GOTO 10012 CALL CANT(NAME) 10012 GOTO 10009 10010 RETURN END SUBROUTINE GREMOV(INFIL,LOW,LIM) INTEGER NAME(30) INTEGER I,INFIL(6),LIM,LOW I=1 GOTO 10015 10013 I=I+(1) 10015 IF((I.GT.LIM-LOW+1))GOTO 10014 CALL CLOSE(INFIL(I)) CALL GNAME(LOW+I-1,NAME) CALL REMOVE(NAME) GOTO 10013 10014 RETURN END SUBROUTINE MERGE(INFIL,NFILES,OUTFIL) INTEGER LINBUF(900),KEYBUF(900) INTEGER GETLIN INTEGER I,INF,LBP,KBP,LP1,KP1,NF,NFILES,OUTFIL INTEGER INFIL(6),KEYPTR(6) LBP=1 KBP=1 NF=0 I=1 GOTO 10018 10016 I=I+(1) 10018 IF((I.GT.NFILES))GOTO 10017 IF((GETLIN(LINBUF(LBP),INFIL(I)).EQ.-1))GOTO 10019 CALL MAKEK0(KEYBUF(KBP+1),LINBUF(LBP)) KEYBUF(KBP)=LBP NF=NF+(1) KEYPTR(NF)=KBP+1 LBP=LBP+(102) KBP=KBP+(102) 10019 GOTO 10016 10017 CALL QUICK(KEYPTR,NF,KEYBUF) 10020 IF((NF.LE.0))GOTO 10021 LP1=KEYBUF(KEYPTR(1)-1) CALL PUTLIN(LINBUF(LP1),OUTFIL) INF=LP1/102+1 IF((GETLIN(LINBUF(LP1),INFIL(INF)).NE.-1))GOTO 10022 KEYPTR(1)=KEYPTR(NF) NF=NF-(1) GOTO 10023 10022 KP1=KEYPTR(1) CALL MAKEK0(KEYBUF(KP1),LINBUF(LP1)) 10023 CALL REHEAP(KEYPTR,NF,KEYBUF) GOTO 10020 10021 RETURN END SUBROUTINE REHEAP(LINPTR,NF,LINBUF) INTEGER LINBUF(16384) INTEGER COMPA0 INTEGER I,J,NF,LINPTR(NF) 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(KEYPTR,NLINES,KEYBUF,LINBUF,INFILE) INTEGER LINBUF(16384),KEYBUF(16384) INTEGER GETLIN,MAKEK0 INTEGER INFILE,LBP,KBP,LLEN,KLEN,KEYPTR(2048),NLINES NLINES=0 LBP=1 KBP=1 10030 LLEN=GETLIN(LINBUF(LBP),INFILE) IF((LLEN.NE.-1))GOTO 10031 GOTO 10032 10031 KLEN=MAKEK0(KEYBUF(KBP+1),LINBUF(LBP)) KEYBUF(KBP)=LBP NLINES=NLINES+(1) KEYPTR(NLINES)=KBP+1 LBP=LBP+(LLEN+1) KBP=KBP+(KLEN+2) IF(((LBP.LT.16384-102).AND.(NLINES.LT.2048)))GOTO 10030 10032 GTEXT=LLEN RETURN END SUBROUTINE PTEXT(KEYPTR,NLINES,KEYBUF,LINBUF,OUTFIL) INTEGER LINBUF(16384),KEYBUF(16384) INTEGER I,J,KEYPTR(2048),NLINES,OUTFIL I=1 GOTO 10035 10033 I=I+(1) 10035 IF((I.GT.NLINES))GOTO 10034 J=KEYBUF(KEYPTR(I)-1) CALL PUTLIN(LINBUF(J),OUTFIL) GOTO 10033 10034 RETURN END INTEGER FUNCTION COMPA0(LP1,LP2,LINBUF) INTEGER LINBUF(1) INTEGER I,J,LP1,LP2 INTEGER DIREC0 INTEGER DICTI0 COMMON /COPTS/DIREC0,DICTI0 I=LP1 J=LP2 10036 IF((LINBUF(I).NE.LINBUF(J)))GOTO 10037 IF((LINBUF(I).NE.0))GOTO 10038 COMPA0=0 RETURN 10038 I=I+(1) J=J+(1) GOTO 10036 10037 IF((LINBUF(I).GE.LINBUF(J)))GOTO 10039 COMPA0=-DIREC0 GOTO 10040 10039 COMPA0=DIREC0 10040 RETURN END SUBROUTINE EXCHAN(LP1,LP2,LINBUF) INTEGER LINBUF(1) INTEGER K,LP1,LP2 K=LP1 LP1=LP2 LP2=K RETURN END SUBROUTINE QUICK(LINPTR,NLINES,LINBUF) INTEGER LINBUF(1) INTEGER COMPA0 INTEGER I,J,LINPTR(1),LV(20),NLINES,P,PIVLIN,UV(20) LV(1)=1 UV(1)=NLINES P=1 10041 IF((P.LE.0))GOTO 10042 IF((LV(P).LT.UV(P)))GOTO 10043 P=P-1 GOTO 10044 10043 I=LV(P)-1 J=UV(P) PIVLIN=LINPTR(J) 10045 IF((I.GE.J))GOTO 10046 I=I+1 GOTO 10049 10047 I=I+1 10049 IF((COMPA0(LINPTR(I),PIVLIN,LINBUF).GE.0))GOTO 10048 GOTO 10047 10048 J=J-1 GOTO 10052 10050 J=J-1 10052 IF((J.LE.I))GOTO 10051 IF((COMPA0(LINPTR(J),PIVLIN,LINBUF).GT.0))GOTO 10053 GOTO 10051 10053 GOTO 10050 10051 IF((I.GE.J))GOTO 10054 CALL EXCHAN(LINPTR(I),LINPTR(J),LINBUF) 10054 GOTO 10045 10046 J=UV(P) CALL EXCHAN(LINPTR(I),LINPTR(J),LINBUF) IF((I-LV(P).GE.UV(P)-I))GOTO 10055 LV(P+1)=LV(P) UV(P+1)=I-1 LV(P)=I+1 GOTO 10056 10055 LV(P+1)=I+1 UV(P+1)=UV(P) UV(P)=I-1 10056 P=P+1 10044 GOTO 10041 10042 RETURN END SUBROUTINE OPTARG(ARGP) INTEGER ARGP INTEGER GETARG INTEGER ARG(128) INTEGER DIREC0 INTEGER DICTI0 COMMON /COPTS/DIREC0,DICTI0 DIREC0=1 DICTI0=0 ARGP=1 GOTO 10059 10057 ARGP=ARGP+1 10059 IF((GETARG(ARGP,ARG,128).EQ.-1))GOTO 10058 IF((ARG(1).NE.173))GOTO 10060 IF(((ARG(2).NE.242).AND.(ARG(2).NE.210)))GOTO 10061 DIREC0=-1 GOTO 10062 10061 IF(((ARG(2).NE.228).AND.(ARG(2).NE.196)))GOTO 10063 DICTI0=1 GOTO 10064 10063 GOTO 10058 10064 CONTINUE 10062 GOTO 10065 10060 GOTO 10058 10065 GOTO 10057 10058 RETURN END INTEGER FUNCTION NEXTF0(ARGP,FD) INTEGER ARGP,FD INTEGER GETARG,OPEN INTEGER ARG(128) 10066 IF((GETARG(ARGP,ARG,128).NE.-1))GOTO 10067 NEXTF0=-1 RETURN 10067 ARGP=ARGP+1 IF(((ARG(1).NE.173).OR.(ARG(2).NE.0)))GOTO 10068 FD=-10 GOTO 10069 10068 FD=OPEN(ARG,1) IF((FD.NE.-3))GOTO 10070 CALL PRINT(-15,'*s: can''t open*n.',ARG) 10070 CONTINUE 10069 CONTINUE IF((FD.EQ.-3))GOTO 10066 RETURN END INTEGER FUNCTION MAKEK0(KEYBUF,LINBUF) INTEGER KEYBUF(102),LINBUF(102) INTEGER I,J INTEGER T INTEGER TYPE,MAPUP INTEGER DIREC0 INTEGER DICTI0 COMMON /COPTS/DIREC0,DICTI0 J=1 I=1 GOTO 10073 10071 I=I+1 10073 IF(((LINBUF(I).EQ.0).OR.(LINBUF(I).EQ.138)))GOTO 10072 IF((DICTI0.NE.1))GOTO 10074 T=TYPE(LINBUF(I)) IF((((T.NE.225).AND.(T.NE.176)).AND.(T.NE.160)))GOTO 10075 KEYBUF(J)=MAPUP(LINBUF(I)) J=J+1 10075 GOTO 10076 10074 KEYBUF(J)=LINBUF(I) J=J+1 10076 GOTO 10071 10072 KEYBUF(J)=0 MAKEK0=J-1 RETURN END C ---- Long Name Map ---- C makekey makek0 C compare compa0 C direction direc0 C dictionary dicti0 C nextfile nextf0