COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER A$BUF(200) INTEGER DEFN(400),T,TOKEN(102) INTEGER GETTOK INTEGER AP,ARGSTK(100),CALLST(20),NLB,PLEV(20) INTEGER LOOKUP,PUSH INTEGER TABLE(32000) COMMON /DS$MEM/TABLE INTEGER DEFTYP(2),INCTYP(2),SUBTYP(2),IFTYP(2),INCLT0(2),DIVTYP(2) *,DNLTYP(2),UNDEF0(2) INTEGER PARSCL INTEGER AAAAA0(5) INTEGER AAAAB0(18) INTEGER AAAAC0(7) INTEGER AAAAD0(5) INTEGER AAAAE0(7) INTEGER AAAAF0(7) INTEGER AAAAG0(5) INTEGER AAAAH0(7) INTEGER AAAAI0(4) INTEGER AAAAJ0(9) INTEGER AAAAK0(3) DATA DEFTYP/-10,0/,INCTYP/-12,0/,SUBTYP/-13,0/,IFTYP/-11,0/,INCLT0 */-14,0/,DIVTYP/-15,0/,DNLTYP/-16,0/,UNDEF0/-17,0/ DATA AAAAA0/219,173,229,221,0/ DATA AAAAB0/213,243,225,231,229,186,160,237,225,227,242,239,160,21 *9,173,229,221,0/ DATA AAAAC0/228,229,230,233,238,229,0/ DATA AAAAD0/233,238,227,242,0/ DATA AAAAE0/243,245,226,243,244,242,0/ DATA AAAAF0/233,230,229,236,243,229,0/ DATA AAAAG0/233,238,227,236,0/ DATA AAAAH0/228,233,246,229,242,244,0/ DATA AAAAI0/228,238,236,0/ DATA AAAAJ0/245,238,228,229,230,233,238,229,0/ DATA AAAAK0/168,169,0/ IF((PARSCL(AAAAA0,A$BUF).NE.-3))GOTO 10000 CALL ERROR(AAAAB0) 10000 BP=0 LASTP=0 CALL DSINIT(32000) IFP=1 IFST(IFP)=-10 OFP=1 OFST(OFP)=-11 CALL INSTAL(AAAAC0,DEFTYP) CALL INSTAL(AAAAD0,INCTYP) CALL INSTAL(AAAAE0,SUBTYP) CALL INSTAL(AAAAF0,IFTYP) CALL INSTAL(AAAAG0,INCLT0) CALL INSTAL(AAAAH0,DIVTYP) CALL INSTAL(AAAAI0,DNLTYP) CALL INSTAL(AAAAJ0,UNDEF0) CP=0 AP=1 EP=1 T=GETTOK(TOKEN,102) GOTO 10003 10001 T=GETTOK(TOKEN,102) 10003 IF((T.EQ.-1))GOTO 10002 IF((T.NE.-100))GOTO 10004 IF((LOOKUP(TOKEN,DEFN).NE.0))GOTO 10005 CALL PUTTOK(TOKEN) GOTO 10006 10005 CP=CP+(1) IF((CP.LE.20))GOTO 10007 CALL ERROR('call stack overflow.') 10007 CALLST(CP)=AP AP=PUSH(EP,ARGSTK,AP) CALL PUTTOK(DEFN) CALL PUTCHR(0) AP=PUSH(EP,ARGSTK,AP) CALL PUTTOK(TOKEN) CALL PUTCHR(0) AP=PUSH(EP,ARGSTK,AP) T=GETTOK(TOKEN,102) CALL PBSTR(TOKEN) IF((T.EQ.168))GOTO 10008 CALL PBSTR(AAAAK0) 10008 PLEV(CP)=0 10006 GOTO 10009 10004 IF((T.NE.219))GOTO 10010 NLB=1 10011 T=GETTOK(TOKEN,102) IF((T.NE.219))GOTO 10012 NLB=NLB+(1) GOTO 10013 10012 IF((T.NE.221))GOTO 10014 NLB=NLB-(1) IF((NLB.NE.0))GOTO 10015 GOTO 10016 10015 GOTO 10017 10014 IF((T.NE.-1))GOTO 10018 CALL ERROR('EOF in string.') 10018 CONTINUE 10017 CONTINUE 10013 CALL PUTTOK(TOKEN) GOTO 10011 10016 GOTO 10019 10010 IF((CP.NE.0))GOTO 10020 CALL PUTTOK(TOKEN) GOTO 10021 10020 IF((T.NE.168))GOTO 10022 IF((PLEV(CP).LE.0))GOTO 10023 CALL PUTTOK(TOKEN) 10023 PLEV(CP)=PLEV(CP)+(1) GOTO 10024 10022 IF((T.NE.169))GOTO 10025 PLEV(CP)=PLEV(CP)-(1) IF((PLEV(CP).LE.0))GOTO 10026 CALL PUTTOK(TOKEN) GOTO 10027 10026 CALL PUTCHR(0) CALL EVAL(ARGSTK,CALLST(CP),AP-1) AP=CALLST(CP) EP=ARGSTK(AP) CP=CP-(1) 10027 GOTO 10028 10025 IF((T.NE.172))GOTO 10029 IF((PLEV(CP).NE.1))GOTO 10029 CALL PUTCHR(0) AP=PUSH(EP,ARGSTK,AP) GOTO 10030 10029 IF((T.NE.192))GOTO 10031 IF((A$BUF(229-225+1).EQ.0))GOTO 10031 CALL NGETC(T) CALL PUTCHR(T) GOTO 10032 10031 CALL PUTTOK(TOKEN) 10032 CONTINUE 10030 CONTINUE 10028 CONTINUE 10024 CONTINUE 10021 CONTINUE 10019 CONTINUE 10009 GOTO 10001 10002 IF((CP.EQ.0))GOTO 10033 CALL ERROR('unexpected EOF.') 10033 GOTO 10036 10034 OFP=OFP-(1) 10036 IF((OFP.LE.1))GOTO 10035 CALL CLOSE(OFST(OFP)) GOTO 10034 10035 GOTO 10039 10037 IFP=IFP-(1) 10039 IF((IFP.LE.1))GOTO 10038 CALL CLOSE(IFST(IFP)) GOTO 10037 10038 CALL SWT END INTEGER FUNCTION GETTOK(TOKEN,TOKSIZ) INTEGER TOKSIZ INTEGER TOKEN(TOKSIZ) INTEGER I INTEGER NGETC,TYPE I=1 GOTO 10042 10040 I=I+(1) 10042 IF((I.GE.TOKSIZ))GOTO 10041 GETTOK=TYPE(NGETC(TOKEN(I))) IF((GETTOK.EQ.225))GOTO 10043 IF((GETTOK.EQ.176))GOTO 10043 IF((GETTOK.EQ.223))GOTO 10043 GOTO 10041 10043 GOTO 10040 10041 IF((I.LT.TOKSIZ))GOTO 10044 CALL ERROR('token too long.') 10044 IF((I.LE.1))GOTO 10045 CALL PUTBAK(TOKEN(I)) I=I-(1) GETTOK=-100 10045 TOKEN(I+1)=0 RETURN END INTEGER FUNCTION LOOKUP(NAME,DEFN) INTEGER NAME(102),DEFN(400) COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER I,J,K INTEGER TABLE(32000) COMMON /DS$MEM/TABLE I=LASTP GOTO 10048 10046 I=I-(1) 10048 IF((I.LE.0))GOTO 10047 J=NAMPTR(I) K=1 GOTO 10051 10049 K=K+(1) 10051 IF((NAME(K).NE.TABLE(J)))GOTO 10050 IF((NAME(K).EQ.0))GOTO 10050 J=J+(1) GOTO 10049 10050 IF((NAME(K).NE.TABLE(J)))GOTO 10052 CALL SCOPY(TABLE,J+1,DEFN,1) LOOKUP=1 RETURN 10052 GOTO 10046 10047 LOOKUP=0 RETURN END SUBROUTINE INSTAL(NAME,DEFN) INTEGER NAME(102),DEFN(400) COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER TABLE(32000) COMMON /DS$MEM/TABLE INTEGER NLEN INTEGER LENGTH INTEGER P INTEGER DSGET CALL UNINS0(NAME) IF((LASTP.LT.500))GOTO 10053 CALL PUTLIN(NAME,-15) CALL REMARK(': too many definitions.') RETURN 10053 NLEN=LENGTH(NAME)+1 P=DSGET(NLEN+LENGTH(DEFN)+1) LASTP=LASTP+1 NAMPTR(LASTP)=P CALL SCOPY(NAME,1,TABLE,P) CALL SCOPY(DEFN,1,TABLE,P+NLEN) RETURN END INTEGER FUNCTION PUSH(EP,ARGSTK,AP) INTEGER EP,ARGSTK(100),AP IF((AP.LE.100))GOTO 10054 CALL ERROR('arg stack overflow.') 10054 ARGSTK(AP)=EP PUSH=AP+1 RETURN END SUBROUTINE PUTTOK(STR) INTEGER STR(102) INTEGER I I=1 GOTO 10057 10055 I=I+(1) 10057 IF((STR(I).EQ.0))GOTO 10056 CALL PUTCHR(STR(I)) GOTO 10055 10056 RETURN END SUBROUTINE PUTCHR(C) INTEGER C COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST IF((CP.NE.0))GOTO 10058 CALL PUTCH(C,OFST(OFP)) GOTO 10059 10058 IF((EP.LE.2000))GOTO 10060 CALL ERROR('evaluation stack overflow.') 10060 EVALST(EP)=C EP=EP+(1) 10059 RETURN END SUBROUTINE EVAL(ARGSTK,I,J) INTEGER ARGSTK(100),I,J COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER ARGNO,K,M,N,T INTEGER INDEX,LENGTH INTEGER AAAAL0 INTEGER AAAAM0 INTEGER AAAAN0(11) DATA AAAAN0/176,177,178,179,180,181,182,183,184,185,0/ T=ARGSTK(I) AAAAL0=EVALST(T) GOTO 10061 10062 CALL DODEF(ARGSTK,I,J) GOTO 10063 10064 CALL DOINCR(ARGSTK,I,J) GOTO 10063 10065 CALL DOSUB(ARGSTK,I,J) GOTO 10063 10066 CALL DOIF(ARGSTK,I,J) GOTO 10063 10067 CALL DOINC0(ARGSTK,I,J) GOTO 10063 10068 CALL DODIV0(ARGSTK,I,J) GOTO 10063 10069 CALL DODNL GOTO 10063 10070 CALL DOUND0(ARGSTK,I,J) GOTO 10063 10061 AAAAM0=AAAAL0+18 GOTO(10070,10069,10068,10067,10065,10064,10066,10062),AAAAM0 K=T+LENGTH(EVALST(T))-1 GOTO 10073 10071 K=K-(1) 10073 IF((K.LE.T))GOTO 10072 IF((EVALST(K-1).EQ.164))GOTO 10074 CALL PUTBAK(EVALST(K)) GOTO 10075 10074 IF((EVALST(K).NE.164))GOTO 10076 CALL PUTBAK(164) K=K-(1) GOTO 10077 10076 ARGNO=INDEX(AAAAN0,EVALST(K))-1 IF((ARGNO.LT.0))GOTO 10078 IF((ARGNO.GE.J-I))GOTO 10078 N=I+ARGNO+1 M=ARGSTK(N) CALL PBSTR(EVALST(M)) 10078 K=K-(1) 10077 CONTINUE 10075 GOTO 10071 10072 IF((K.NE.T))GOTO 10079 CALL PUTBAK(EVALST(K)) 10079 CONTINUE 10063 RETURN END SUBROUTINE DODEF(ARGSTK,I,J) INTEGER ARGSTK(100),I,J COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER A2,A3 IF((J-I.LE.2))GOTO 10080 A2=ARGSTK(I+2) A3=ARGSTK(I+3) CALL INSTAL(EVALST(A2),EVALST(A3)) 10080 RETURN END SUBROUTINE DOINCR(ARGSTK,I,J) INTEGER ARGSTK(100),I,J COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER K INTEGER CTOI K=ARGSTK(I+2) CALL PBNUM(CTOI(EVALST,K)+1) RETURN END SUBROUTINE PBNUM(N) INTEGER N INTEGER M,NUM INTEGER MOD INTEGER DIGITS(11) DATA DIGITS/176,177,178,179,180,181,182,183,184,185,0/ NUM=N 10081 M=MOD(NUM,10) CALL PUTBAK(DIGITS(M+1)) NUM=NUM/10 IF((NUM.NE.0))GOTO 10081 RETURN END SUBROUTINE DOSUB(ARGSTK,I,J) INTEGER ARGSTK(100),I,J COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER AP,FC,K,NC INTEGER CTOI,LENGTH,MIN0 IF((J-I.GE.3))GOTO 10082 RETURN 10082 IF((J-I.GE.4))GOTO 10083 NC=102 GOTO 10084 10083 K=ARGSTK(I+4) NC=CTOI(EVALST,K) 10084 K=ARGSTK(I+3) AP=ARGSTK(I+2) FC=AP+CTOI(EVALST,K)-1 IF((FC.LT.AP))GOTO 10085 IF((FC.GE.AP+LENGTH(EVALST(AP))))GOTO 10085 K=FC+MIN0(NC,LENGTH(EVALST(FC)))-1 GOTO 10088 10086 K=K-(1) 10088 IF((K.LT.FC))GOTO 10087 CALL PUTBAK(EVALST(K)) GOTO 10086 10087 CONTINUE 10085 RETURN END SUBROUTINE DOIF(ARGSTK,I,J) INTEGER ARGSTK(100),I,J COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER A2,A3,A4,A5 INTEGER EQUAL IF((J-I.GE.5))GOTO 10089 RETURN 10089 A2=ARGSTK(I+2) A3=ARGSTK(I+3) A4=ARGSTK(I+4) A5=ARGSTK(I+5) IF((EQUAL(EVALST(A2),EVALST(A3)).NE.1))GOTO 10090 CALL PBSTR(EVALST(A4)) GOTO 10091 10090 CALL PBSTR(EVALST(A5)) 10091 RETURN END INTEGER FUNCTION NGETC(C) INTEGER C COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER GETCH IF((BP.LE.0))GOTO 10092 C=BUF(BP) GOTO 10093 10092 BP=1 10094 BUF(BP)=GETCH(C,IFST(IFP)) IF((IFP.EQ.1))GOTO 10096 IF((C.NE.-1))GOTO 10096 GOTO 10095 10096 GOTO 10097 10095 CALL CLOSE(IFST(IFP)) IFP=IFP-(1) GOTO 10094 10097 CONTINUE 10093 IF((C.EQ.-1))GOTO 10098 BP=BP-(1) 10098 NGETC=C RETURN END SUBROUTINE PBSTR(IN) INTEGER IN(102) INTEGER I INTEGER LENGTH I=LENGTH(IN) GOTO 10101 10099 I=I-(1) 10101 IF((I.LE.0))GOTO 10100 CALL PUTBAK(IN(I)) GOTO 10099 10100 RETURN END SUBROUTINE PUTBAK(C) INTEGER C COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST BP=BP+(1) IF((BP.LE.500))GOTO 10102 CALL ERROR('too many characters pushed back.') 10102 BUF(BP)=C RETURN END SUBROUTINE DOINC0(ARGSTK,I,J) INTEGER I,J,ARGSTK(100) COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER FD,NM INTEGER OPEN IF((J-I.GE.2))GOTO 10103 RETURN 10103 NM=ARGSTK(I+2) FD=OPEN(EVALST(NM),1) IF((FD.NE.-3))GOTO 10104 CALL PUTLIN(EVALST(NM),-15) CALL REMARK(': can''t open include.') GOTO 10105 10104 IFP=IFP+(1) IFST(IFP)=FD 10105 RETURN END SUBROUTINE DODIV0(ARGSTK,I,J) INTEGER I,J,ARGSTK(100) COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER FD,NM INTEGER OPEN,CREATE NM=ARGSTK(I+2) IF((EVALST(NM).NE.0))GOTO 10106 IF((OFP.LE.1))GOTO 10107 CALL CLOSE(OFST(OFP)) OFP=OFP-(1) 10107 RETURN 10106 IF((OFP.LT.10))GOTO 10108 CALL PUTLIN(EVALST(NM),-15) CALL REMARK(': too many output files.') RETURN 10108 IF((J-I.NE.2))GOTO 10109 FD=CREATE(EVALST(NM),3) GOTO 10110 10109 FD=OPEN(EVALST(NM),3) 10110 IF((FD.NE.-3))GOTO 10111 CALL PUTLIN(EVALST(NM),-15) CALL REMARK(': can''t open for output.') GOTO 10112 10111 CALL WIND(FD) OFP=OFP+(1) OFST(OFP)=FD 10112 RETURN END SUBROUTINE DODNL INTEGER C INTEGER NGETC 10113 C=NGETC(C) IF((C.EQ.160))GOTO 10113 IF((C.EQ.137))GOTO 10113 IF((C.EQ.138))GOTO 10114 CALL PUTBAK(C) 10114 RETURN END SUBROUTINE UNINS0(NAME) INTEGER NAME(102) INTEGER TABLE(32000) COMMON /DS$MEM/TABLE COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER I,J,K INTEGER EQUAL I=LASTP GOTO 10117 10115 I=I-(1) 10117 IF((I.LE.0))GOTO 10116 J=NAMPTR(I) IF((EQUAL(TABLE(J),NAME).NE.1))GOTO 10118 CALL DSFREE(NAMPTR(I)) K=I+1 GOTO 10121 10119 K=K+(1) 10121 IF((K.GT.LASTP))GOTO 10120 NAMPTR(K-1)=NAMPTR(K) GOTO 10119 10120 LASTP=LASTP-(1) RETURN 10118 GOTO 10115 10116 RETURN END SUBROUTINE DOUND0(ARGSTK,I,J) INTEGER I,J,ARGSTK(100) COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10) INTEGER BP INTEGER BUF INTEGER IFP INTEGER IFST INTEGER OFP INTEGER OFST COMMON /CLOOK/LASTP,NAMPTR(500) INTEGER LASTP INTEGER NAMPTR COMMON /CMACRO/CP,EP,EVALST(2000) INTEGER CP INTEGER EP INTEGER EVALST INTEGER NAM NAM=ARGSTK(I+2) CALL UNINS0(EVALST(NAM)) RETURN END C ---- Long Name Map ---- C doundef dound0 C uninstal unins0 C undeftyp undef0 C incltyp inclt0 C doinclude doinc0 C dodivert dodiv0