COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER GETTO0,TTYPE,EQUAL,LOOKUP,INFO(3) INTEGER TOKEN(200) INTEGER DEFIO0(7) INTEGER UNDEF0(9) INTEGER INCLU0(8) DATA DEFIO0/228,229,230,233,238,229,0/ DATA UNDEF0/245,238,228,229,230,233,238,229,0/ DATA INCLU0/233,238,227,236,245,228,229,0/ CALL INITI0 TTYPE=GETTO0(TOKEN) GOTO 10002 10000 TTYPE=GETTO0(TOKEN) 10002 IF((TTYPE.EQ.-1))GOTO 10001 IF((TTYPE.NE.225))GOTO 10003 IF((EQUAL(TOKEN,DEFIO0).NE.1))GOTO 10004 CALL ENTER0 GOTO 10005 10004 IF((EQUAL(TOKEN,UNDEF0).NE.1))GOTO 10006 CALL REMOV0 GOTO 10007 10006 IF((EQUAL(TOKEN,INCLU0).NE.1))GOTO 10008 CALL INCLV0 GOTO 10009 10008 IF((LOOKUP(TOKEN,INFO,DEFTA0).NE.1))GOTO 10010 CALL SAVEI0(INFO) IF((INFO(2).NE.0))GOTO 10011 CALL EXPAND GOTO 10012 10011 BACKP0=INPTR0 10013 IF((INLIN0(INPTR0).NE.160))GOTO 10014 INPTR0=INPTR0+(1) GOTO 10013 10014 IF((INLIN0(INPTR0).EQ.168))GOTO 10015 INPTR0=BACKP0 GOTO 10016 10015 INPTR0=INPTR0+(1) CALL GETAR0 10016 CALL EXPAND 10012 GOTO 10017 10010 ALLBL0=0 CALL MOVEF0 10017 CONTINUE 10009 CONTINUE 10007 CONTINUE 10005 GOTO 10018 10003 ALLBL0=0 CALL MOVEF0 10018 GOTO 10000 10001 CALL SWT END SUBROUTINE ADDARG COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER PTR,LENGTH,DSGET IF((MACRO0(36).GE.MACRO0(34)))GOTO 10019 MACRO0(36)=MACRO0(36)+(1) IF((BPTRA0.NE.1))GOTO 10020 PTR=0 GOTO 10021 10020 BUFFE0(BPTRA0)=0 PTR=DSGET(LENGTH(BUFFE0)) CALL SCOPY(BUFFE0,1,MEMAA0,PTR) 10021 MACRO0(MACRO0(36))=PTR 10019 BPTRA0=1 RETURN END SUBROUTINE CLEAR0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 BUFFE0(BPTRA0)=0 IF((ALLBL0.EQ.0))GOTO 10023 IF((DEFIN0.EQ.0))GOTO 10023 GOTO 10022 10023 IF((INFIL0(LEVEL0).EQ.SWTDE0))GOTO 10022 CALL PUTLIN(BUFFE0,-11) 10022 BPTRA0=1 ALLBL0=1 RETURN END SUBROUTINE ENTER0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER LOOKUP,DEFLE0,INFO(3),I,FILEM0,NUMPA0 INTEGER PTR,DSGET,PARAM0(32) INTEGER GETTO0,TOKEN(200),DEFIP0(400) NUMPA0=0 DEFIN0=1 IF((GETTO0(TOKEN).EQ.168))GOTO 10024 CALL SYNERR('missing left paren in define.') INPTR0=BACKP0 GOTO 10025 10024 IF((GETTO0(MACRP0).EQ.225))GOTO 10026 CALL SYNERR('non_alphanumeric name in define.') GOTO 10027 10026 CALL GETPA0(NUMPA0,PARAM0) IF((ERROS0.NE.0))GOTO 10028 CALL READD0(DEFIP0,NUMPA0,PARAM0,DEFLE0) 10028 IF((ERROS0.NE.0))GOTO 10029 PTR=DSGET(DEFLE0) I=1 GOTO 10032 10030 I=I+(1) 10032 IF((I.GT.DEFLE0))GOTO 10031 MEMAA0(PTR+I-1)=DEFIP0(I) GOTO 10030 10031 IF((LOOKUP(MACRP0,INFO,DEFTA0).NE.1))GOTO 10033 CALL DSFREE(INFO(1)) 10033 INFO(1)=PTR INFO(2)=NUMPA0 INFO(3)=DEFLE0-1 CALL ENTER(MACRP0,INFO,DEFTA0) 10029 CONTINUE 10027 CONTINUE 10025 CALL SKIP(FILEM0) DEFIN0=0 ERROS0=0 I=1 GOTO 10036 10034 I=I+(1) 10036 IF((I.GT.NUMPA0))GOTO 10035 CALL DSFREE(PARAM0(I)) GOTO 10034 10035 RETURN END SUBROUTINE EXPAND COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER PTR,ARGNUM,I PTR=MACRO0(33)-1 I=MACRO0(35) GOTO 10039 10037 I=I-(1) 10039 IF((I.LE.0))GOTO 10038 IF((MEMAA0(PTR+I).GE.0))GOTO 10040 ARGNUM=-(MEMAA0(PTR+I)) IF(((ARGNUM.GT.MACRO0(36)).OR.(MACRO0(ARGNUM).EQ.0)))GOTO 1004 *1 CALL MOVET0(MEMAA0(MACRO0(ARGNUM))) 10041 GOTO 10042 10040 INPTR0=INPTR0-(1) INLIN0(INPTR0)=MEMAA0(PTR+I) 10042 GOTO 10037 10038 I=1 GOTO 10045 10043 I=I+(1) 10045 IF((I.GE.MACRO0(36)))GOTO 10044 CALL DSFREE(MACRO0(I)) GOTO 10043 10044 RETURN END SUBROUTINE GETAR0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER PAREN0 INTEGER TTYPE,GETTO0,TOKEN(200) PAREN0=1 10046 TTYPE=GETTO0(TOKEN) IF((TTYPE.NE.168))GOTO 10047 ALLBL0=0 CALL MOVEF0 PAREN0=PAREN0+(1) GOTO 10048 10047 IF((TTYPE.NE.169))GOTO 10049 PAREN0=PAREN0-(1) IF((PAREN0.LE.0))GOTO 10050 ALLBL0=0 CALL MOVEF0 GOTO 10051 10050 CALL ADDARG GOTO 10052 10051 GOTO 10053 10049 IF((TTYPE.NE.172))GOTO 10054 IF((PAREN0.NE.1))GOTO 10054 CALL ADDARG GOTO 10055 10054 ALLBL0=0 CALL MOVEF0 10055 CONTINUE 10053 CONTINUE 10048 CONTINUE IF((TTYPE.NE.-1))GOTO 10046 10052 IF((TTYPE.NE.-1))GOTO 10056 CALL SYNERR('missing right paren after define.') 10056 RETURN END SUBROUTINE GETPA0(NUMPA0,PARAM0) INTEGER NUMPA0 INTEGER PARAM0(32) COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER DSGET INTEGER GETTO0,TOKEN(200),C INTEGER LENGTH C=GETTO0(TOKEN) IF((C.NE.168))GOTO 10057 10058 C=GETTO0(TOKEN) IF((C.NE.172))GOTO 10059 CALL SYNERR('missing parameter in definition.') ERROS0=1 GOTO 10060 10059 IF((C.NE.169))GOTO 10061 GOTO 10062 10061 IF((NUMPA0.LE.32))GOTO 10063 CALL SYNERR('too many parameters.') ERROS0=1 GOTO 10064 10063 IF((C.EQ.225))GOTO 10065 CALL SYNERR('non-numeric parameter not allowed.') ERROS0=1 GOTO 10066 10065 NUMPA0=NUMPA0+(1) PARAM0(NUMPA0)=DSGET(LENGTH(TOKEN)) CALL SCOPY(TOKEN,1,MEMAA0,PARAM0(NUMPA0)) 10066 C=GETTO0(TOKEN) IF((C.NE.169))GOTO 10067 GOTO 10062 10067 IF((C.EQ.172))GOTO 10068 CALL SYNERR('missing comma in parameter list.') ERROS0=1 10068 CONTINUE 10064 CONTINUE 10060 CONTINUE GOTO 10058 10062 IF((GETTO0(TOKEN).EQ.172))GOTO 10069 CALL SYNERR('missing comma in define.') ERROS0=1 10069 GOTO 10070 10057 IF((C.EQ.172))GOTO 10071 CALL SYNERR('missing comma in define.') ERROS0=1 10071 CONTINUE 10070 RETURN END INTEGER FUNCTION GETTO0(TOKEN) INTEGER TOKEN(200) COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER CHART0,MAPDN,TYPE INTEGER FILEM0,I CALL SKIP(FILEM0) IF((FILEM0.NE.-1))GOTO 10072 GETTO0=-1 GOTO 10073 10072 IF((TYPE(INLIN0(INPTR0)).NE.225))GOTO 10074 BACKP0=INPTR0 CHART0=TYPE(INLIN0(INPTR0)) I=1 10075 IF((CHART0.EQ.225))GOTO 10077 IF((CHART0.EQ.176))GOTO 10077 IF((CHART0.EQ.223))GOTO 10077 IF((CHART0.EQ.164))GOTO 10077 GOTO 10076 10077 IF((CHART0.NE.223))GOTO 10079 IF((CHART0.NE.164))GOTO 10079 GOTO 10078 10079 IF((MAPAA0.NE.1))GOTO 10080 TOKEN(I)=MAPDN(INLIN0(INPTR0)) GOTO 10081 10080 TOKEN(I)=INLIN0(INPTR0) 10081 I=I+(1) 10078 INPTR0=INPTR0+(1) CHART0=TYPE(INLIN0(INPTR0)) GOTO 10075 10076 TOKEN(I)=0 GETTO0=225 GOTO 10082 10074 BACKP0=INPTR0 GETTO0=INLIN0(INPTR0) INPTR0=INPTR0+(1) 10082 CONTINUE 10073 RETURN END SUBROUTINE INCLV0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER TYPE,FILEN0(200) INTEGER I,OPEN,LENGTH,DSGET IF((ALLBL0.NE.1))GOTO 10083 BPTRA0=1 10083 CONTINUE 10084 IF((INLIN0(INPTR0).NE.160))GOTO 10085 INPTR0=INPTR0+(1) GOTO 10084 10085 IF((INLIN0(INPTR0).EQ.167))GOTO 10087 IF((INLIN0(INPTR0).EQ.162))GOTO 10087 GOTO 10086 10087 INPTR0=INPTR0+(1) 10086 I=1 10088 IF((TYPE(INLIN0(INPTR0)).EQ.225))GOTO 10090 IF((TYPE(INLIN0(INPTR0)).EQ.176))GOTO 10090 IF((INLIN0(INPTR0).EQ.189))GOTO 10090 IF((INLIN0(INPTR0).EQ.223))GOTO 10090 IF((INLIN0(INPTR0).EQ.175))GOTO 10090 IF((INLIN0(INPTR0).EQ.174))GOTO 10090 IF((INLIN0(INPTR0).EQ.170))GOTO 10090 IF((INLIN0(INPTR0).EQ.173))GOTO 10090 IF((INLIN0(INPTR0).EQ.166))GOTO 10090 IF((INLIN0(INPTR0).EQ.164))GOTO 10090 IF((INLIN0(INPTR0).EQ.163))GOTO 10090 GOTO 10089 10090 FILEN0(I)=INLIN0(INPTR0) I=I+(1) INPTR0=INPTR0+(1) GOTO 10088 10089 IF((I.LE.1))GOTO 10092 IF((INLIN0(INPTR0).EQ.160))GOTO 10093 IF((INLIN0(INPTR0).EQ.167))GOTO 10093 IF((INLIN0(INPTR0).EQ.162))GOTO 10093 GOTO 10092 10093 GOTO 10091 10092 CALL SYNERR('invalid file name in include.') GOTO 10094 10091 FILEN0(I)=0 LEVEL0=LEVEL0+(1) IF((LEVEL0.LE.5))GOTO 10095 CALL SYNERR('includes nested too deeply.') GOTO 10096 10095 INFIL0(LEVEL0)=OPEN(FILEN0,1) SAVEF0(LEVEL0)=DSGET(LENGTH(FILEN0)) LINEN0(LEVEL0)=0 CALL SCOPY(FILEN0,1,MEMAA0,SAVEF0(LEVEL0)) 10096 IF((INFIL0(LEVEL0).NE.-3))GOTO 10097 CALL SYNERR('can''t open include file.') 10097 CONTINUE 10094 INPTR0=INPTR0+(1) RETURN END SUBROUTINE INITI0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER MKTABL,LENGTH,LEN,GETARG,OPEN,DSGET INTEGER FILEN0(200) INTEGER USAGE0(34) INTEGER PARSCL INTEGER AAAAA0(15) INTEGER AAAAB0(19) INTEGER AAAAC0(6) DATA USAGE0/213,243,225,231,229,186,160,228,229,230,233,238,229,16 *0,219,173,230,160,252,160,237,221,160,251,230,233,236,229,238,225, *237,229,253,0/ DATA AAAAA0/230,188,230,236,225,231,190,237,188,230,236,225,231,19 *0,0/ DATA AAAAB0/189,233,238,227,236,189,175,243,247,244,223,228,229,23 *0,174,242,174,233,0/ DATA AAAAC0/211,212,196,201,206,0/ CALL DSINIT(25000) COMMA0=1 IF((PARSCL(AAAAA0,A$BUF).NE.-3))GOTO 10098 CALL ERROR(USAGE0) 10098 IF((A$BUF(237-225+1).EQ.0))GOTO 10099 MAPAA0=1 GOTO 10100 10099 MAPAA0=0 10100 LEVEL0=1 IF((A$BUF(230-225+1).NE.0))GOTO 10101 INFIL0(LEVEL0)=OPEN(AAAAB0,1) SWTDE0=INFIL0(LEVEL0) GOTO 10102 10101 SWTDE0=-1 LEN=GETARG(COMMA0,FILEN0,200) COMMA0=COMMA0+(1) IF((LEN.NE.-1))GOTO 10103 INFIL0(LEVEL0)=-10 SAVEF0(1)=DSGET(5) LINEN0(1)=0 CALL SCOPY(AAAAC0,1,MEMAA0,SAVEF0(1)) GOTO 10104 10103 INFIL0(LEVEL0)=OPEN(FILEN0,1) IF((INFIL0(1).NE.-3))GOTO 10105 CALL CANT(FILEN0) GOTO 10106 10105 SAVEF0(1)=DSGET(LENGTH(FILEN0)) CALL SCOPY(FILEN0,1,MEMAA0,SAVEF0(1)) LINEN0(1)=0 10106 CONTINUE 10104 CONTINUE 10102 DEFTA0=MKTABL(3) INPTR0=400 BPTRA0=1 INLIN0(400)=0 DEFIN0=0 ALLBL0=1 ERROS0=0 RETURN END SUBROUTINE MOVEF0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 10107 IF((BACKP0.GE.INPTR0))GOTO 10108 BUFFE0(BPTRA0)=INLIN0(BACKP0) BPTRA0=BPTRA0+(1) BACKP0=BACKP0+(1) GOTO 10107 10108 RETURN END SUBROUTINE MOVET0(TEXT) INTEGER TEXT(1) COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER LEN,LENGTH,I LEN=LENGTH(TEXT) INPTR0=INPTR0-(LEN) I=1 GOTO 10111 10109 I=I+(1) 10111 IF((I.GT.LEN))GOTO 10110 INLIN0(INPTR0+I-1)=TEXT(I) GOTO 10109 10110 RETURN END SUBROUTINE READD0(DEF,NUMPA0,PARAM0,DEFLE0) INTEGER DEF(400) INTEGER NUMPA0 INTEGER PARAM0(32) INTEGER DEFLE0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER UNMAT0,FILEM0,J,EQUAL,TYPE INTEGER TOKEN(200) INTEGER AAAAD0 INTEGER AAAAE0 UNMAT0=0 DEFLE0=1 10112 IF((DEFLE0.LT.400))GOTO 10113 CALL SYNERR('definition too long.') 10113 AAAAD0=TYPE(INLIN0(INPTR0)) GOTO 10114 10115 DEF(DEFLE0)=138 DEFLE0=DEFLE0+(1) INPTR0=INPTR0+(1) IF((INPTR0.NE.400))GOTO 10116 CALL READL0(FILEM0) IF((FILEM0.NE.-1))GOTO 10117 CALL SYNERR('missing right paren after definition.') DEF(DEFLE0)=0 GOTO 10118 10117 CONTINUE 10116 GOTO 10119 10120 UNMAT0=UNMAT0+(1) DEF(DEFLE0)=168 DEFLE0=DEFLE0+(1) INPTR0=INPTR0+(1) GOTO 10119 10121 UNMAT0=UNMAT0-(1) IF((UNMAT0.GE.0))GOTO 10122 DEF(DEFLE0)=0 INPTR0=INPTR0+(1) GOTO 10118 10122 DEF(DEFLE0)=169 DEFLE0=DEFLE0+(1) INPTR0=INPTR0+(1) GOTO 10119 10123 CALL GETTO0(TOKEN) J=1 GOTO 10126 10124 J=J+(1) 10126 IF((J.GT.NUMPA0))GOTO 10125 IF((EQUAL(MEMAA0(PARAM0(J)),TOKEN).NE.1))GOTO 10127 GOTO 10125 10127 GOTO 10124 10125 IF((J.GT.NUMPA0))GOTO 10128 DEF(DEFLE0)=-J DEFLE0=DEFLE0+(1) GOTO 10129 10128 IF((EQUAL(MACRP0,TOKEN).NE.1))GOTO 10130 DEF(DEFLE0)=219 DEFLE0=DEFLE0+(1) 10131 IF((BACKP0.GE.INPTR0))GOTO 10132 DEF(DEFLE0)=INLIN0(BACKP0) DEFLE0=DEFLE0+(1) BACKP0=BACKP0+(1) GOTO 10131 10132 DEF(DEFLE0)=221 DEFLE0=DEFLE0+(1) GOTO 10133 10130 CONTINUE 10134 IF((BACKP0.GE.INPTR0))GOTO 10135 DEF(DEFLE0)=INLIN0(BACKP0) DEFLE0=DEFLE0+(1) BACKP0=BACKP0+(1) GOTO 10134 10135 CONTINUE 10133 CONTINUE 10129 GOTO 10119 10114 IF(AAAAD0.EQ.138)GOTO 10115 AAAAE0=AAAAD0-167 GOTO(10120,10121),AAAAE0 IF(AAAAD0.EQ.225)GOTO 10123 DEF(DEFLE0)=INLIN0(INPTR0) DEFLE0=DEFLE0+(1) INPTR0=INPTR0+(1) 10119 CONTINUE GOTO 10112 10118 RETURN END SUBROUTINE READL0(FILEM0) INTEGER FILEM0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER GETLIN,OPEN,LENGTH,LEN,GETARG INTEGER DSGET INTEGER FILEN0(200) INTEGER AAAAF0(6) DATA AAAAF0/211,212,196,201,206,0/ FILEM0=1 CALL CLEAR0 10136 IF((FILEM0.EQ.-1))GOTO 10137 IF((GETLIN(BUFFE0,INFIL0(LEVEL0)).EQ.-1))GOTO 10138 CALL MOVET0(BUFFE0) CALL SCOPY(BUFFE0,1,CURRE0,1) FILEM0=1 LINEN0(LEVEL0)=LINEN0(LEVEL0)+(1) ERROR0=0 GOTO 10137 10138 IF((LEVEL0.LE.1))GOTO 10139 CALL CLOSE(INFIL0(LEVEL0)) LEVEL0=LEVEL0-(1) GOTO 10140 10139 IF((INFIL0(LEVEL0).NE.SWTDE0))GOTO 10141 LEN=GETARG(COMMA0,FILEN0,200) COMMA0=COMMA0+(1) SWTDE0=-1 IF((LEN.NE.-1))GOTO 10142 INFIL0(LEVEL0)=-10 SAVEF0(1)=DSGET(5) LINEN0(1)=0 FILEM0=1 CALL SCOPY(AAAAF0,1,MEMAA0,SAVEF0(1)) GOTO 10143 10142 INFIL0(LEVEL0)=OPEN(FILEN0,1) IF((INFIL0(LEVEL0).NE.-3))GOTO 10144 CALL CANT(FILEN0) 10144 SAVEF0(1)=DSGET(LENGTH(FILEN0)) LINEN0(1)=0 CALL SCOPY(FILEN0,1,MEMAA0,SAVEF0(1)) FILEM0=1 10143 GOTO 10145 10141 IF((INFIL0(1).EQ.-10))GOTO 10146 CALL CLOSE(INFIL0(1)) LEN=GETARG(COMMA0,FILEN0,200) COMMA0=COMMA0+(1) IF((LEN.NE.-1))GOTO 10147 FILEM0=-1 GOTO 10148 10147 INFIL0(1)=OPEN(FILEN0,1) IF((INFIL0(1).NE.-3))GOTO 10149 CALL CANT(FILEN0) 10149 SAVEF0(1)=DSGET(LENGTH(FILEN0)) CALL SCOPY(FILEN0,1,MEMAA0,SAVEF0(1)) LINEN0(1)=0 FILEM0=1 10148 GOTO 10150 10146 FILEM0=-1 10150 CONTINUE 10145 CONTINUE 10140 CONTINUE GOTO 10136 10137 RETURN END SUBROUTINE REMOV0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER TOKEN(200),GETTO0 INTEGER LOOKUP,INFO(3) DEFIN0=1 IF((GETTO0(TOKEN).EQ.168))GOTO 10151 CALL SYNERR('missing left paren after undefine.') GOTO 10152 10151 IF((GETTO0(TOKEN).EQ.225))GOTO 10153 CALL SYNERR('non-alphanumeric name in undefine.') GOTO 10154 10153 IF((LOOKUP(TOKEN,INFO,DEFTA0).NE.1))GOTO 10155 CALL DSFREE(INFO(1)) CALL DELETE(TOKEN,DEFTA0) 10155 IF((GETTO0(TOKEN).EQ.169))GOTO 10156 CALL SYNERR('missing right paren after undefine.') GOTO 10157 10156 CONTINUE 10158 IF((INLIN0(INPTR0).NE.160))GOTO 10159 INPTR0=INPTR0+(1) GOTO 10158 10159 IF((INLIN0(INPTR0).NE.138))GOTO 10160 INPTR0=INPTR0+(1) 10160 CONTINUE 10157 CONTINUE 10154 CONTINUE 10152 DEFIN0=0 RETURN END SUBROUTINE SAVEI0(INFO) INTEGER INFO(3) COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 MACRO0(33)=INFO(1) MACRO0(34)=INFO(2) MACRO0(35)=INFO(3) MACRO0(36)=0 CALL CLEAR0 RETURN END SUBROUTINE SKIP(FILEM0) INTEGER FILEM0 COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER BRACK0,SKIPF0 INTEGER SKIPC0 FILEM0=1 SKIPF0=0 BRACK0=1 10161 IF((BPTRA0.NE.102))GOTO 10162 CALL CLEAR0 CALL SYNERR('line too long.') 10162 CONTINUE 10163 IF((INLIN0(INPTR0).NE.160))GOTO 10164 IF((BPTRA0.GE.102))GOTO 10164 BUFFE0(BPTRA0)=160 BPTRA0=BPTRA0+(1) INPTR0=INPTR0+(1) GOTO 10163 10164 IF((INLIN0(INPTR0).NE.219))GOTO 10165 BRACK0=BRACK0+(1) INPTR0=INPTR0+(1) SKIPC0=221 ALLBL0=0 SKIPF0=1 GOTO 10166 10165 IF((INLIN0(INPTR0).EQ.167))GOTO 10168 IF((INLIN0(INPTR0).EQ.162))GOTO 10168 GOTO 10167 10168 SKIPC0=INLIN0(INPTR0) SKIPF0=1 ALLBL0=0 GOTO 10169 10167 IF((INLIN0(INPTR0).NE.163))GOTO 10170 SKIPC0=138 SKIPF0=1 ALLBL0=0 10170 CONTINUE 10169 CONTINUE 10166 IF((SKIPF0.NE.1))GOTO 10171 10172 BUFFE0(BPTRA0)=INLIN0(INPTR0) BPTRA0=BPTRA0+(1) INPTR0=INPTR0+(1) IF((INLIN0(INPTR0).EQ.SKIPC0))GOTO 10173 IF((INLIN0(INPTR0).EQ.138))GOTO 10173 IF((INPTR0+1.EQ.400))GOTO 10173 GOTO 10172 10173 CONTINUE 10171 IF((INLIN0(INPTR0).EQ.SKIPC0))GOTO 10175 IF((INLIN0(INPTR0).EQ.138))GOTO 10175 GOTO 10174 10175 IF((SKIPC0.EQ.221))GOTO 10176 BUFFE0(BPTRA0)=INLIN0(INPTR0) BPTRA0=BPTRA0+(1) 10176 INPTR0=INPTR0+(1) SKIPF0=0 10174 IF((INLIN0(INPTR0).NE.138))GOTO 10177 IF((INPTR0+1.NE.400))GOTO 10177 BUFFE0(BPTRA0)=138 BPTRA0=BPTRA0+(1) INPTR0=400 CALL READL0(FILEM0) GOTO 10178 10177 IF((INLIN0(INPTR0).NE.138))GOTO 10179 BUFFE0(BPTRA0)=138 BPTRA0=BPTRA0+(1) INPTR0=INPTR0+(1) CALL CLEAR0 GOTO 10180 10179 IF((INPTR0.NE.400))GOTO 10181 CALL READL0(FILEM0) 10181 CONTINUE 10180 CONTINUE 10178 IF((FILEM0.NE.-1))GOTO 10182 GOTO 10183 10182 CONTINUE IF((INLIN0(INPTR0).EQ.138))GOTO 10161 IF((INLIN0(INPTR0).EQ.160))GOTO 10161 IF((INLIN0(INPTR0).EQ.167))GOTO 10161 IF((INLIN0(INPTR0).EQ.162))GOTO 10161 IF((INLIN0(INPTR0).EQ.163))GOTO 10161 IF((INLIN0(INPTR0).EQ.219))GOTO 10161 IF((SKIPF0.NE.0))GOTO 10161 10183 RETURN END SUBROUTINE SYNERR(MESSA0) INTEGER MESSA0(1) COMMON /CHARS0/INLIN0,INPTR0,BACKP0,BUFFE0,BPTRA0,ALLBL0,DEFIN0,IN *FIL0,SAVEF0,LINEN0,LEVEL0,CURRE0,ERROR0,ERROS0,MAPAA0,A$BUF,SWTDE0 *,COMMA0 INTEGER INLIN0(400),BUFFE0(102),CURRE0(102) INTEGER INPTR0,BACKP0,BPTRA0,ALLBL0,DEFIN0,INFIL0(5),LEVEL0,LINEN0 *(5),SAVEF0(5),ERROR0,ERROS0,MAPAA0,SWTDE0,COMMA0 INTEGER A$BUF(200) COMMON /STACK/MACRO0,MACRP0 INTEGER MACRP0(200) INTEGER MACRO0(36) INTEGER MEMAA0(25000) COMMON /DS$MEM/MEMAA0 COMMON /DEFTAB/DEFTA0 INTEGER DEFTA0 INTEGER LEN,LENGTH,ITOC INTEGER BUF(102) INTEGER STDFI0(6) INTEGER AAAAG0(5) INTEGER AAAAH0(14) DATA STDFI0/211,212,196,201,206,0/ DATA AAAAG0/170,243,170,243,0/ DATA AAAAH0/160,160,160,163,163,163,163,163,160,170,240,170,238,0/ IF((ERROR0.NE.0))GOTO 10184 BUF(1)=168 IF((LEVEL0.NE.0))GOTO 10185 CALL SCOPY(STDFI0,1,BUF,2) GOTO 10186 10185 CALL SCOPY(MEMAA0(SAVEF0(LEVEL0)),1,BUF,2) 10186 LEN=LENGTH(BUF)+1 BUF(LEN)=169 BUF(LEN+1)=160 LEN=LEN+(2) IF((LEVEL0.LE.0))GOTO 10187 LEN=LEN+(ITOC(LINEN0(LEVEL0),BUF(LEN),102)) GOTO 10188 10187 LEN=LEN+(ITOC(LINEN0(1),BUF(LEN),102)) 10188 BUF(LEN)=186 BUF(LEN+1)=160 BUF(LEN+2)=0 CALL PRINT(-15,AAAAG0,BUF,CURRE0) 10184 CALL PRINT(-15,AAAAH0,MESSA0) ERROR0=1 IF((LEVEL0.GE.1))GOTO 10189 CALL ERROR(' ##### unexpected EOF.') 10189 RETURN END C ---- Long Name Map ---- C parencount paren0 C Macroname macrp0 C movetoinline movet0 C message messa0 C Inptr inptr0 C Allblanks allbl0 C paramtable param0 C filename filen0 C Deftable defta0 C getparams getpa0 C bracketlevel brack0 C stdfile stdfi0 C Errorindefine erros0 C getargs getar0 C readline readl0 C Defineline defin0 C includestring inclu0 C removestring remov0 C charstore chars0 C Backptr backp0 C Savefilename savef0 C Bptr bptra0 C Commandarg comma0 C filemark filem0 C readdef readd0 C definestring defio0 C definition defip0 C clearbuffer clear0 C usagestring usage0 C skipflag skipf0 C Map mapaa0 C numparams numpa0 C Level level0 C Mem memaa0 C includefile inclv0 C Erroroncurrentline error0 C skipchar skipc0 C initialize initi0 C undefinestring undef0 C enterstring enter0 C deflength defle0 C Infile infil0 C Currentline curre0 C saveinfo savei0 C Buffer buffe0 C movefrominline movef0 C chartype chart0 C unmatchedparens unmat0 C gettoken getto0 C Swtdefs swtde0 C Macrocall macro0 C Inline inlin0 C Linenumber linen0