INTEGER FUNCTION LSGETF(PTR,FD) INTEGER PTR INTEGER FD INTEGER LINE(102) INTEGER STRLEN,LINEL0 INTEGER J,K INTEGER GETLIN INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF CALL LSALLO(PTR,0) K=PTR STRLEN=0 10000 LINEL0=GETLIN(LINE,FD) IF((LINEL0.NE.-1))GOTO 10001 LSGETF=-1 GOTO 10002 10001 IF((LINE(LINEL0).NE.138))GOTO 10003 CALL LSMAKE(J,LINE) CALL LSJOIN(K,J) LSGETF=STRLEN+LINEL0 GOTO 10002 10003 IF((LINE(LINEL0).NE.131))GOTO 10004 LINE(LINEL0)=0 LINEL0=LINEL0-(1) 10004 CONTINUE CALL LSMAKE(J,LINE) CALL LSJOIN(K,J) STRLEN=STRLEN+(LINEL0) CALL LSPOS(K,9999) GOTO 10000 10002 RETURN END SUBROUTINE LSPUTF(PTR,FD) INTEGER PTR INTEGER FD INTEGER LINE(102) INTEGER K INTEGER LSPOS INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF K=PTR 10005 CALL LSEXTR(K,LINE,102) CALL PUTLIN(LINE,FD) IF((LSPOS(K,102).NE.0))GOTO 10005 RETURN END INTEGER FUNCTION LSJOIN(PTR1,PTR2) INTEGER PTR1,PTR2 INTEGER K INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF K=PTR1 CALL LSPOS(K,9999) REF(K)=PTR2+300 LSJOIN=PTR1 RETURN END INTEGER FUNCTION LSCMPK(PTR,STR) INTEGER PTR INTEGER STR(1) INTEGER I1 INTEGER I2 INTEGER C1,C2 INTEGER LSGETC I1=PTR I2=1 C2=STR(I2) 10006 IF((LSGETC(I1,C1).NE.C2))GOTO 10007 IF((C1.NE.0))GOTO 10008 LSCMPK=189 RETURN 10008 I2=I2+(1) C2=STR(I2) GOTO 10006 10007 IF((C1.EQ.0))GOTO 10010 IF((C2.EQ.0))GOTO 10011 IF((C1.GE.C2))GOTO 10011 GOTO 10010 10011 GOTO 10009 10010 LSCMPK=188 GOTO 10012 10009 LSCMPK=190 10012 RETURN END INTEGER FUNCTION LSCOMP(STR1,STR2) INTEGER STR1,STR2 INTEGER I1,I2 INTEGER C1,C2 INTEGER LSGETC I1=STR1 I2=STR2 10013 IF((LSGETC(I1,C1).NE.LSGETC(I2,C2)))GOTO 10014 IF((C1.NE.0))GOTO 10015 LSCOMP=189 RETURN 10015 GOTO 10013 10014 IF((C1.EQ.0))GOTO 10017 IF((C2.EQ.0))GOTO 10018 IF((C1.GE.C2))GOTO 10018 GOTO 10017 10018 GOTO 10016 10017 LSCOMP=188 GOTO 10019 10016 LSCOMP=190 10019 RETURN END INTEGER FUNCTION LSCUT(PTR1,POS,PTR2) INTEGER PTR1,PTR2 INTEGER POS INTEGER I,J,K INTEGER C INTEGER LSPOS I=PTR1 IF((POS.GT.0))GOTO 10020 PTR2=PTR1 LSCUT=PTR1 CALL LSALLO(PTR1,0) GOTO 10021 10020 IF((LSPOS(I,POS).NE.0))GOTO 10022 CALL LSALLO(PTR2,0) LSCUT=PTR2 GOTO 10023 10022 CALL LSALLO(J,1) PTR2=I+1 LSCUT=PTR2 K=I CALL LSGETC(I,C) CALL LSPUTC(K,J+300) CALL LSPUTC(J,C) 10023 CONTINUE 10021 RETURN END SUBROUTINE LSINS(PTR1,POS1,PTR2,POS2,LEN) INTEGER PTR1,PTR2 INTEGER POS1,POS2,LEN INTEGER I,J,C INTEGER LSPOS INTEGER LSLEN INTEGER LSSUBS INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF IF((LEN.GT.0))GOTO 10024 RETURN 10024 IF((POS1.LE.0))GOTO 10025 J=0 CALL LSCOPY(PTR2,POS2,J,2) CALL LSDEL(J,LEN+2,9999) CALL LSPOS(J,1) I=PTR1 C=LSPOS(I,POS1) IF((C.NE.0))GOTO 10026 I=PTR1 C=LSPOS(I,LSLEN(I)) 10026 REF(J)=C REF(I)=J+300 CALL LSPOS(J,9999) REF(J)=I+1+300 GOTO 10027 10025 J=LSSUBS(PTR2,POS2,LEN) I=PTR1 PTR1=J CALL LSPOS(J,9999) REF(J)=I+300 10027 RETURN END INTEGER FUNCTION LSTAKE(PTR,LEN) INTEGER PTR INTEGER LEN INTEGER C INTEGER I,J INTEGER LSGETC,LSPUTC INTEGER LSALLO INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF I=PTR LSTAKE=LSALLO(J,LEN) 10028 IF((LSPUTC(J,(LSGETC(I,C))).EQ.0))GOTO 10029 GOTO 10028 10029 RETURN END INTEGER FUNCTION LSDROP(PTR,LEN) INTEGER PTR INTEGER LEN INTEGER J INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF LSDROP=0 CALL LSCOPY(J,LEN+1,LSDROP,1) RETURN END INTEGER FUNCTION LSSUBS(PTR,POS,LEN) INTEGER PTR INTEGER POS,LEN INTEGER C INTEGER J,K INTEGER I,LEN1 INTEGER LSGETC,LSPOS INTEGER LSLEN INTEGER LSALLO INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF IF((LEN.LT.9999))GOTO 10030 LEN1=LSLEN(PTR)-POS+2 GOTO 10031 10030 LEN1=LEN 10031 LSSUBS=LSALLO(K,LEN1) J=PTR C=LSPOS(J,POS) I=1 GOTO 10034 10032 I=I+(1) 10034 IF(((I.GT.LEN).OR.(C.EQ.0)))GOTO 10033 CALL LSPUTC(K,LSGETC(J,C)) GOTO 10032 10033 RETURN END SUBROUTINE LSDEL(PTR,POS,LEN) INTEGER PTR INTEGER POS,LEN INTEGER I,J INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF IF((LEN.GT.0))GOTO 10035 RETURN 10035 I=PTR CALL LSPOS(I,POS) J=I CALL LSFREE(J,LEN) IF((J.NE.0))GOTO 10036 REF(I)=0 GOTO 10037 10036 REF(I)=J+300 10037 RETURN END SUBROUTINE LSCOPY(PTR1,POS1,PTR2,POS2) INTEGER PTR1,PTR2 INTEGER POS1,POS2 INTEGER C,J,K INTEGER LSGETC,LSPUTC INTEGER LSLEN INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF J=PTR1 CALL LSPOS(J,POS1) IF((PTR2.NE.0))GOTO 10038 CALL LSALLO(PTR2,POS2-1+LSLEN(J)) 10038 K=PTR2 CALL LSPOS(K,POS2) 10039 IF((LSPUTC(K,LSGETC(J,C)).EQ.0))GOTO 10040 GOTO 10039 10040 RETURN END INTEGER FUNCTION LSPOS(PTR,POS) INTEGER PTR INTEGER POS INTEGER I INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF I=1 GOTO 10043 10041 I=I+(1) 10043 IF((I.GE.POS))GOTO 10042 10044 IF((REF(PTR).LT.300))GOTO 10045 PTR=REF(PTR)-300 GOTO 10044 10045 IF((REF(PTR).NE.0))GOTO 10046 GOTO 10042 10046 PTR=PTR+(1) GOTO 10041 10042 CONTINUE 10047 IF((REF(PTR).LT.300))GOTO 10048 PTR=REF(PTR)-300 GOTO 10047 10048 LSPOS=REF(PTR) RETURN END INTEGER FUNCTION LSMAKE(PTR,STR) INTEGER PTR INTEGER STR(1) INTEGER I,J INTEGER LENGTH INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF CALL LSALLO(PTR,LENGTH(STR)) J=PTR I=1 GOTO 10051 10049 I=I+(1) 10051 IF((STR(I).EQ.0))GOTO 10050 CALL LSPUTC(J,STR(I)) GOTO 10049 10050 LSMAKE=PTR RETURN END INTEGER FUNCTION LSEXTR(PTR,STR,MAX) INTEGER PTR INTEGER STR(1) INTEGER MAX INTEGER I,J INTEGER LSGETC INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF J=PTR I=1 GOTO 10054 10052 I=I+(1) 10054 IF((I.GE.MAX))GOTO 10053 IF((LSGETC(J,STR(I)).NE.0))GOTO 10055 GOTO 10053 10055 GOTO 10052 10053 STR(I)=0 LSEXTR=I-1 RETURN END INTEGER FUNCTION LSLEN(PTR) INTEGER PTR INTEGER I,J,C INTEGER LSGETC INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF J=PTR I=1 GOTO 10058 10056 I=I+(1) 10058 IF((LSGETC(J,C).EQ.0))GOTO 10057 GOTO 10056 10057 LSLEN=I-1 RETURN END INTEGER FUNCTION LSGETC(PTR,C) INTEGER PTR INTEGER C INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF 10059 IF((REF(PTR).LT.300))GOTO 10060 PTR=REF(PTR)-300 GOTO 10059 10060 C=REF(PTR) LSGETC=C IF((REF(PTR).EQ.0))GOTO 10061 PTR=PTR+(1) 10062 IF((REF(PTR).LT.300))GOTO 10063 PTR=REF(PTR)-300 GOTO 10062 10063 CONTINUE 10061 RETURN END INTEGER FUNCTION LSPUTC(PTR,C) INTEGER PTR INTEGER C INTEGER I INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF 10064 IF((REF(PTR).LT.300))GOTO 10065 PTR=REF(PTR)-300 GOTO 10064 10065 IF((REF(PTR).EQ.0))GOTO 10066 REF(PTR)=C PTR=PTR+(1) IF((C.NE.0))GOTO 10067 I=PTR CALL LSFREE(I,9999) 10067 LSPUTC=C GOTO 10068 10066 LSPUTC=0 10068 RETURN END INTEGER FUNCTION LSALLO(PTR,LEN) INTEGER PTR INTEGER LEN INTEGER I,J,FLAG INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF INTEGER AAAAA0(24) INTEGER AAAAB0(19) DATA AAAAA0/212,239,239,160,237,225,238,249,160,236,233,238,235,22 *9,228,160,243,244,242,233,238,231,243,0/ DATA AAAAB0/240,242,239,231,242,225,237,160,244,229,242,237,233,23 *8,225,244,229,228,0/ FLAG=0 10069 IF((HO+LEN+2.GT.TOP))GOTO 10070 PTR=HO+1 HO=HO+(LEN+1) I=PTR GOTO 10073 10071 I=I+(1) 10073 IF((I.GE.HO))GOTO 10072 REF(I)=-2 GOTO 10071 10072 REF(HO)=0 LSALLO=PTR RETURN 10070 J=0 I=NA GOTO 10076 10074 I=I+(1) 10076 IF((REF(I).EQ.0))GOTO 10075 10077 IF((REF(I).LT.300))GOTO 10078 I=REF(I)-300 GOTO 10077 10078 IF((REF(I).NE.0))GOTO 10079 GOTO 10075 10079 J=J+(1) IF((J.LE.LEN))GOTO 10080 PTR=NA REF(I)=0 NA=I+1 LSALLO=PTR RETURN 10080 GOTO 10074 10075 IF((FLAG.NE.1))GOTO 10081 CALL REMARK(AAAAA0) CALL LSDUMP CALL ERROR(AAAAB0) 10081 FLAG=1 CALL LSFREE(NA,9999) GOTO 10084 10082 HO=HO-(1) 10084 IF((REF(HO).NE.-1))GOTO 10083 GOTO 10082 10083 I=HO HO=HO+(1) REF(HO)=0 NA=HO 10085 IF((I.LE.1))GOTO 10086 GOTO 10089 10087 I=I-(1) 10089 IF((REF(I).EQ.-1))GOTO 10088 GOTO 10087 10088 IF((I.GT.1))GOTO 10090 GOTO 10091 10090 REF(I)=NA+300 I=I-(1) GOTO 10094 10092 I=I-(1) 10094 IF(((REF(I).NE.-1).OR.(I.LE.1)))GOTO 10093 REF(I)=-2 GOTO 10092 10093 NA=I+1 GOTO 10085 10086 CONTINUE GOTO 10069 10091 RETURN END SUBROUTINE LSFREE(PTR,LEN) INTEGER PTR INTEGER LEN INTEGER I,J,K INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF IF((PTR.EQ.0))GOTO 10096 IF((REF(PTR).EQ.-1))GOTO 10096 GOTO 10095 10096 RETURN 10095 K=0 I=PTR GOTO 10099 10097 I=I+(1) 10099 IF((K.GE.LEN))GOTO 10098 10100 IF((REF(I).LT.300))GOTO 10101 J=I I=REF(J)-300 REF(J)=-1 GOTO 10100 10101 IF((REF(I).NE.0))GOTO 10102 REF(I)=-1 PTR=0 RETURN 10102 REF(I)=-1 K=K+(1) GOTO 10097 10098 PTR=I RETURN END SUBROUTINE LSINIT INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF TOP=4090-1 HO=1 NA=1 REF(1)=0 RETURN END SUBROUTINE LSDUMP INTEGER I,J,POS INTEGER TOP,NA,HO,REF(4090) COMMON /LS$BUF/TOP,NA,HO,REF INTEGER AAAAC0(23) INTEGER AAAAD0(10) INTEGER AAAAE0(14) INTEGER AAAAF0(14) INTEGER AAAAG0(3) INTEGER AAAAH0(5) INTEGER AAAAI0(14) INTEGER AAAAJ0(5) INTEGER AAAAK0(9) DATA AAAAC0/212,239,240,189,170,233,160,160,200,207,189,170,233,16 *0,160,206,193,189,170,233,170,238,0/ DATA AAAAD0/204,239,227,160,170,233,186,160,160,0/ DATA AAAAE0/204,211,214,207,201,196,160,168,170,233,169,170,238,0/ DATA AAAAF0/204,211,206,213,204,204,160,168,170,233,169,170,238,0/ DATA AAAAG0/190,190,0/ DATA AAAAH0/188,170,233,190,0/ DATA AAAAI0/170,238,190,160,190,160,190,160,190,160,190,160,190,0/ DATA AAAAJ0/188,188,170,238,0/ DATA AAAAK0/208,244,242,160,170,233,170,238,0/ CALL PRINT(-15,AAAAC0,TOP,HO,NA) I=1 GOTO 10105 10103 I=I+(1) 10105 IF((I.GT.HO))GOTO 10104 CALL PRINT(-15,AAAAD0,I) POS=0 GOTO 10106 10107 J=0 GOTO 10110 10108 I=I+(1) 10110 IF(((I.GT.HO).OR.(REF(I).NE.-2)))GOTO 10109 J=J+(1) GOTO 10108 10109 CALL PRINT(-15,AAAAE0,J) I=I-(1) GOTO 10111 10112 J=0 GOTO 10115 10113 I=I+(1) 10115 IF(((I.GT.HO).OR.(REF(I).NE.-1)))GOTO 10114 J=J+(1) GOTO 10113 10114 CALL PRINT(-15,AAAAF0,J) I=I-(1) GOTO 10111 10116 CALL PRINT(-15,AAAAG0) GOTO 10119 10117 I=I+(1) 10119 IF(((I.GT.HO).OR.(REF(I).GE.300)))GOTO 10118 IF(((REF(I).LT.160).OR.(REF(I).GT.254)))GOTO 10120 CALL PUTCH(REF(I),-15) GOTO 10121 10120 CALL PRINT(-15,AAAAH0,REF(I)) 10121 POS=POS+(1) IF((POS.LE.20))GOTO 10122 CALL PRINT(-15,AAAAI0) POS=0 10122 IF((REF(I).NE.0))GOTO 10123 I=I+(1) GOTO 10118 10123 GOTO 10117 10118 CALL PRINT(-15,AAAAJ0) I=I-(1) GOTO 10111 10106 IF((REF(I).EQ.-2))GOTO 10107 IF((REF(I).EQ.-1))GOTO 10112 IF((REF(I).LT.300))GOTO 10116 CALL PRINT(-15,AAAAK0,REF(I)-300) 10111 GOTO 10103 10104 RETURN END C ---- Long Name Map ---- C linelen linel0