SUBROUTINE CPREP0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T INTEGER SKIPW0,LOOKUP,DGETS0 INTEGER TEXT(200) INTEGER INFO(3) INTEGER AAAAA0 INTEGER AAAAB0 10000 T=DGETS0(TEXT) IF((T.EQ.160))GOTO 10000 IF((T.EQ.163))GOTO 10000 IF((T.NE.138))GOTO 10001 RETURN 10001 IF((T.NE.1023))GOTO 10003 IF((LOOKUP(TEXT,INFO,PPTBL0).EQ.0))GOTO 10003 GOTO 10002 10003 CALL SYNERR('Unrecognized # statement.',0) RETURN 10002 AAAAA0=INFO(2) GOTO 10004 10005 CALL REMOV0 GOTO 10006 10007 CALL ENTES0 GOTO 10006 10008 CALL OPENI0 GOTO 10006 10009 CALL PROCG0 GOTO 10006 10010 CALL PROCH0 GOTO 10006 10011 CALL GOBBL0 GOTO 10006 10013 CALL SYNERR('#if not implemented.',0) GOTO 10006 10014 CALL RESET0 GOTO 10006 10004 AAAAB0=AAAAA0-1034 GOTO(10007,10015,10015,10011,10006,10015,10015,10015,10015,10015, * 10015,10015,10009,10010,10013,10008,10015,10014,10015,10015, * 10015,10015,10015,10015,10015,10015,10015,10005),AAAAB0 10015 CALL FATAL0('Bogus IDPTR in Pp_tbl entry.') 10006 IF((SKIPW0(TEXT).EQ.138))GOTO 10016 CALL SYNERR('Garbage following preprocessor statement.',0) 10016 RETURN END SUBROUTINE PROCG0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T INTEGER LOOKUP,DGETS0 INTEGER TEXT(200) INTEGER INFO(3) 10017 T=DGETS0(TEXT) IF((T.EQ.160))GOTO 10017 IF((T.EQ.1023))GOTO 10018 CALL SYNERR('Only identifiers may appear after #ifdef.',0) GOTO 10019 10018 IF((LOOKUP(TEXT,INFO,KEYWD0).NE.0))GOTO 10020 CALL GOBBL0 10020 CONTINUE 10019 RETURN END SUBROUTINE PROCH0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T INTEGER LOOKUP,DGETS0 INTEGER TEXT(200) INTEGER INFO(3) 10021 T=DGETS0(TEXT) IF((T.EQ.160))GOTO 10021 IF((T.EQ.1023))GOTO 10022 CALL SYNERR('Only identifiers may appear after #ifndef.',0) GOTO 10023 10022 IF((LOOKUP(TEXT,INFO,KEYWD0).NE.1))GOTO 10024 CALL GOBBL0 10024 CONTINUE 10023 RETURN END SUBROUTINE GOBBL0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T,NL INTEGER LOOKUP,DGETS0 INTEGER TEXT(200) INTEGER INFO(3) T=DGETS0(TEXT) NL=0 10025 CONTINUE 10026 IF((T.EQ.163))GOTO 10027 IF((T.NE.-1))GOTO 10028 CALL SYNERR('Unmatched #if@.@.@. statement.',0) RETURN 10028 T=DGETS0(TEXT) GOTO 10026 10027 CONTINUE 10029 IF((T.EQ.163))GOTO 10031 IF((T.EQ.160))GOTO 10031 GOTO 10030 10031 T=DGETS0(TEXT) GOTO 10029 10030 IF((T.NE.1023))GOTO 10034 IF((LOOKUP(TEXT,INFO,PPTBL0).EQ.0))GOTO 10034 GOTO 10032 10032 IF((INFO(2).EQ.1039))GOTO 10036 IF((INFO(2).EQ.1038))GOTO 10036 GOTO 10035 10036 IF((NL.NE.0))GOTO 10035 GOTO 10037 10035 IF((INFO(2).EQ.1049))GOTO 10039 IF((INFO(2).EQ.1047))GOTO 10039 IF((INFO(2).EQ.1048))GOTO 10039 GOTO 10038 10039 NL=NL+(1) GOTO 10040 10038 IF((INFO(2).NE.1039))GOTO 10041 NL=NL-(1) 10041 CONTINUE 10040 CONTINUE 10034 T=DGETS0(TEXT) GOTO 10025 10037 RETURN END SUBROUTINE RESET0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T,I,K INTEGER CTOI,CTOC,SKIPW0 INTEGER TEXT(200),C T=SKIPW0(TEXT) IF((T.EQ.1025))GOTO 10042 CALL SYNERR('Integer required after #line.',0) GOTO 10043 10042 I=1 K=CTOI(TEXT,I) IF((TEXT(I).EQ.0))GOTO 10044 CALL SYNERR('Integer required after #line.',0) GOTO 10045 10044 IF((LEVEL0.LE.0))GOTO 10046 LINEN0(LEVEL0)=K 10046 CONTINUE 10045 CONTINUE 10043 T=SKIPW0(TEXT) IF((T.NE.138))GOTO 10047 CALL PUTBA0(138) GOTO 10048 10047 IF((T.NE.1026))GOTO 10049 I=CTOC(TEXT(2),MODUL0,200) MODUL0(I)=0 GOTO 10050 10049 IF((T.NE.162))GOTO 10051 I=1 GOTO 10054 10052 I=I+(1) 10054 IF((I.GT.200))GOTO 10053 IF((INBUF0(IBPAA0).EQ.0))GOTO 10055 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10056 10055 CALL REFIL0(C) 10056 IF((C.EQ.162))GOTO 10053 IF((C.EQ.138))GOTO 10053 IF((C.EQ.-1))GOTO 10053 GOTO 10057 10057 MODUL0(I)=C GOTO 10052 10053 MODUL0(I)=0 IF((C.EQ.162))GOTO 10060 CALL SYNERR('Missing ending bracket in #line.',0) 10059 GOTO 10060 10051 CALL SYNERR('File name must follow integer in #line.',0) 10060 CONTINUE 10050 CONTINUE 10048 RETURN END SUBROUTINE OPENI0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER CUROK,T,FP INTEGER FOLLOW,SKIPW0,LENGTH,CTOC INTEGER FD INTEGER OPEN INTEGER TEXT(200),FILEN0(180),C,TERM INTEGER SDUPL INTEGER AAAAC0(7) DATA AAAAC0/189,233,238,227,236,189,0/ IF((LEVEL0.LT.5))GOTO 10061 CALL FATAL0('#Includes nested too deeply.') 10061 T=SKIPW0(TEXT) IF((T.EQ.188))GOTO 10063 IF((T.EQ.162))GOTO 10063 IF((T.EQ.167))GOTO 10063 GOTO 10062 10063 IF((T.NE.188))GOTO 10064 TERM=190 CUROK=0 GOTO 10065 10064 TERM=T CUROK=1 10065 FP=1 GOTO 10068 10066 FP=FP+(1) 10068 IF((FP.GT.200))GOTO 10067 IF((INBUF0(IBPAA0).EQ.0))GOTO 10069 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10070 10069 CALL REFIL0(C) 10070 IF((C.EQ.TERM))GOTO 10067 IF((C.EQ.138))GOTO 10067 IF((C.EQ.-1))GOTO 10067 GOTO 10071 10071 FILEN0(FP)=C GOTO 10066 10067 FILEN0(FP)=0 IF((C.EQ.TERM))GOTO 10074 CALL SYNERR('Missing ending bracket in #include.',0) 10073 GOTO 10074 10062 IF((T.NE.1026))GOTO 10075 CUROK=1 FP=CTOC(TEXT(2),FILEN0,180) FILEN0(FP)=0 GOTO 10076 10075 CALL SYNERR('File name must follow #include.',0) RETURN 10076 CONTINUE 10074 FD=-3 IF((CUROK.NE.1))GOTO 10077 FD=OPEN(FILEN0,1) 10077 FP=1 GOTO 10080 10078 FP=FP+(LENGTH(DIRNA0(FP))+1) 10080 IF((FD.NE.-3))GOTO 10079 IF((FP.GE.DIRTO0))GOTO 10079 IF((FOLLOW(DIRNA0(FP),0).NE.-2))GOTO 10078 FD=OPEN(FILEN0,1) CALL FOLLOW(0,0) 10081 GOTO 10078 10079 IF((FD.NE.-3))GOTO 10082 IF((FOLLOW(AAAAC0,0).NE.-2))GOTO 10082 FD=OPEN(FILEN0,1) CALL FOLLOW(0,0) 10082 IF((FD.NE.-3))GOTO 10083 CALL CTOC(FILEN0,ERROR0,200) CALL SYNERR('Can''t open #include file.',0) RETURN 10083 FNAME0(LEVEL0)=SDUPL(MODUL0) CALL CTOC(FILEN0,MODUL0,180) LEVEL0=LEVEL0+(1) LINEN0(LEVEL0)=0 INFIL0(LEVEL0)=FD RETURN END SUBROUTINE REMOV0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER T INTEGER SKIPW0,LOOKUP INTEGER ID(200),TEXT(200) INTEGER INFO(3) IF((SKIPW0(ID).EQ.1023))GOTO 10084 CALL SYNERR('Identifier must follow ''#undef''.',0) RETURN 10084 IF((LOOKUP(ID,INFO,KEYWD0).EQ.0))GOTO 10086 IF((INFO(1).NE.1))GOTO 10086 GOTO 10085 10086 RETURN 10085 CALL DSFREE(INFO(2)) CALL DELETE(ID,KEYWD0) RETURN END SUBROUTINE INVOK0(INFO) INTEGER INFO(3) INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER I,NP,J,L INTEGER CTOC INTEGER DEFN(1000) INTEGER N INTEGER TABLE(32) INTEGER AAAAD0(3) INTEGER AAAAE0(5) DATA AAAAD0/170,233,0/ DATA AAAAE0/162,170,243,162,0/ IF((INFO(3).NE.-2))GOTO 10087 CALL ENCODE(DEFN,1000,AAAAD0,SYMLI0) CALL PUTBC0(DEFN) RETURN 10087 IF((INFO(3).NE.-3))GOTO 10088 CALL ENCODE(DEFN,1000,AAAAE0,MODUL0) CALL PUTBC0(DEFN) RETURN 10088 CONTINUE NP=0 IF((INFO(3).LE.-1))GOTO 10089 CALL GETAC0(TABLE,NP) 10089 J=1 I=INFO(2) GOTO 10092 10090 I=I+(1) 10092 IF((MEMAA0(I).EQ.0))GOTO 10091 IF((MEMAA0(I).EQ.1023))GOTO 10093 DEFN(J)=MEMAA0(I) J=J+(1) GOTO 10094 10093 I=I+(1) IF((NP.LT.MEMAA0(I)))GOTO 10095 J=J+(CTOC(MEMAA0(TABLE(MEMAA0(I))),DEFN(J),1000-J+1)) 10095 CONTINUE 10094 IF((J.LT.1000-1))GOTO 10090 CALL SYNERR('result of define invocation too long.',0) GOTO 10091 10091 DEFN(J)=0 CALL PUTBC0(DEFN) I=1 GOTO 10099 10097 I=I+(1) 10099 IF((I.GT.NP))GOTO 10098 CALL DSFREE(TABLE(I)) GOTO 10097 10098 RETURN END SUBROUTINE ENTES0 INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER ID(200),DEFN(1000),TEXT(200) INTEGER I,T,NP INTEGER SKIPW0,GETFO0,DGETS0 INTEGER PARAMS,P INTEGER GETDE0,MKTABL T=SKIPW0(ID) IF((T.EQ.1023))GOTO 10100 CALL SYNERR('only identifiers may be defined.',0) RETURN 10100 T=DGETS0(TEXT) IF((T.NE.168))GOTO 10101 IF((GETFO0(PARAMS,NP).NE.-3))GOTO 10102 RETURN 10102 T=SKIPW0(TEXT) GOTO 10103 10101 NP=-1 PARAMS=0 10103 CALL PUTBC0(TEXT) P=GETDE0(PARAMS) IF((P.NE.-3))GOTO 10104 RETURN 10104 CALL INSTA0(ID,NP,P) CALL PUTBA0(138) RETURN END SUBROUTINE INSTA0(ID,NP,P) INTEGER ID(102) INTEGER NP INTEGER P INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER INFO(3) INTEGER LOOKUP IF((LOOKUP(ID,INFO,KEYWD0).NE.1))GOTO 10105 IF((INFO(1).NE.1))GOTO 10105 CALL DSFREE(INFO(2)) 10105 INFO(1)=1 INFO(3)=NP INFO(2)=P CALL ENTER(ID,INFO,KEYWD0) RETURN END INTEGER FUNCTION DGETS0(TEXT) INTEGER TEXT(1) INTEGER TL INTEGER C INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER AAAAF0 INTEGER AAAAG0 10106 IF((INBUF0(IBPAA0).EQ.0))GOTO 10107 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10108 10107 CALL REFIL0(C) 10108 AAAAF0=C GOTO 10109 10110 TEXT(1)=C TL=2 IF((INBUF0(IBPAA0).EQ.0))GOTO 10111 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10112 10111 CALL REFIL0(C) 10112 CONTINUE 10113 IF((193.GT.C))GOTO 10116 IF((C.GT.218))GOTO 10116 GOTO 10115 10116 IF((225.GT.C))GOTO 10117 IF((C.GT.250))GOTO 10117 GOTO 10115 10117 IF((176.GT.C))GOTO 10118 IF((C.GT.185))GOTO 10118 GOTO 10115 10118 IF((C.EQ.164))GOTO 10115 IF((C.EQ.223))GOTO 10115 GOTO 10114 10115 TEXT(TL)=C TL=TL+1 IF((TL.LT.200))GOTO 10119 CALL SYNERR('token too long.',0) GOTO 10114 10119 IF((INBUF0(IBPAA0).EQ.0))GOTO 10120 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10113 10120 CALL REFIL0(C) 10121 GOTO 10113 10114 TEXT(TL)=0 CALL PUTBA0(C) DGETS0=1023 RETURN 10122 TEXT(1)=C TL=2 IF((INBUF0(IBPAA0).EQ.0))GOTO 10123 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10124 10123 CALL REFIL0(C) 10124 CONTINUE 10125 IF((176.GT.C))GOTO 10126 IF((C.GT.185))GOTO 10126 TEXT(TL)=C TL=TL+(1) IF((TL.LT.200))GOTO 10127 CALL SYNERR('Token too long.',0) GOTO 10126 10127 IF((INBUF0(IBPAA0).EQ.0))GOTO 10128 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10125 10128 CALL REFIL0(C) 10129 GOTO 10125 10126 TEXT(TL)=0 CALL PUTBA0(C) DGETS0=1025 RETURN 10130 IF((INBUF0(IBPAA0).EQ.0))GOTO 10131 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10132 10131 CALL REFIL0(C) 10132 IF((C.NE.138))GOTO 10133 GOTO 10106 10133 TEXT(1)=220 TEXT(2)=C TEXT(3)=0 DGETS0=1026 RETURN 10135 IF((INBUF0(IBPAA0).EQ.0))GOTO 10136 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10137 10136 CALL REFIL0(C) 10137 IF((C.NE.170))GOTO 10138 IF((INBUF0(IBPAA0).EQ.0))GOTO 10139 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10140 10139 CALL REFIL0(C) 10140 CONTINUE 10141 CONTINUE 10142 IF((C.EQ.170))GOTO 10143 IF((C.EQ.-1))GOTO 10143 IF((INBUF0(IBPAA0).EQ.0))GOTO 10144 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10142 10144 CALL REFIL0(C) 10145 GOTO 10142 10143 IF((C.NE.-1))GOTO 10146 CALL SYNERR('missing trailing comment delimiter.',0) GOTO 10106 10146 IF((INBUF0(IBPAA0).EQ.0))GOTO 10148 C=INBUF0(IBPAA0) IBPAA0=IBPAA0+(1) GOTO 10149 10148 CALL REFIL0(C) 10149 CONTINUE IF((C.NE.175))GOTO 10141 10147 GOTO 10106 10138 CALL PUTBA0(C) C=175 GOTO 10150 10109 IF(AAAAF0.EQ.164)GOTO 10110 AAAAG0=AAAAF0-174 GOTO(10135,10122,10122,10122,10122,10122,10122,10122,10122,10122 *,10122,10150,10150,10150,10150,10150,10150,10150,10110,10110,10110 *,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110 *,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110 *,10110,10150,10130,10150,10150,10110,10150,10110,10110,10110,10110 *,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110 *,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110,10110 *),AAAAG0 10151 GOTO 10150 10150 TEXT(1)=C TEXT(2)=0 DGETS0=C RETURN END INTEGER FUNCTION GETFO0(TABLE,NUMBER) INTEGER TABLE INTEGER NUMBER INTEGER T INTEGER SKIPW0 INTEGER TEXT(200) INTEGER MKTABL INTEGER INFO(3) TABLE=MKTABL(3) NUMBER=0 10152 T=SKIPW0(TEXT) IF((NUMBER.NE.0))GOTO 10153 IF((T.NE.169))GOTO 10153 GETFO0=-2 RETURN 10153 IF((T.EQ.1023))GOTO 10154 CALL SYNERR('define formal parameters must be identifiers.', *0) CALL RMTABL(TABLE) GETFO0=-3 RETURN 10154 CONTINUE NUMBER=NUMBER+1 INFO(3)=NUMBER CALL ENTER(TEXT,INFO,TABLE) T=SKIPW0(TEXT) IF((T.EQ.172))GOTO 10155 IF((T.EQ.169))GOTO 10155 CALL SYNERR('commas must separate define formal parameters.',0 *) CALL RMTABL(TABLE) GETFO0=-3 RETURN 10155 CONTINUE IF((T.NE.169))GOTO 10152 GETFO0=-2 RETURN END INTEGER FUNCTION SKIPW0(TEXT) INTEGER TEXT(1) INTEGER T INTEGER DGETS0 10156 T=DGETS0(TEXT) IF((T.EQ.160))GOTO 10156 IF((T.EQ.137))GOTO 10156 SKIPW0=T RETURN END INTEGER FUNCTION GETDE0(TABLE) INTEGER TABLE INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER BUFLEN,L INTEGER DGETS0,LOOKUP,LENGTH INTEGER DEFN(1000),TEXT(200) INTEGER SDUPL INTEGER INFO(3) INTEGER AAAAH0 BUFLEN=1 DEFN(1)=0 10157 AAAAH0=DGETS0(TEXT) GOTO 10158 10161 CALL SYNERR('Missing right paren or EOF in define text.',0) GOTO 10160 10162 IF((TABLE.EQ.0))GOTO 10164 IF((LOOKUP(TEXT,INFO,TABLE).NE.1))GOTO 10164 TEXT(1)=1023 TEXT(2)=INFO(3) TEXT(3)=0 10163 GOTO 10164 10158 IF(AAAAH0.EQ.-1)GOTO 10161 IF(AAAAH0.EQ.138)GOTO 10160 IF(AAAAH0.EQ.1023)GOTO 10162 10164 L=LENGTH(TEXT) IF((BUFLEN+L.LT.1000))GOTO 10165 CALL SYNERR('definition too long.',0) GOTO 10160 10165 CALL SCOPY(TEXT,1,DEFN,BUFLEN) BUFLEN=BUFLEN+L GOTO 10157 10160 IF((TABLE.EQ.0))GOTO 10166 CALL RMTABL(TABLE) 10166 GETDE0=SDUPL(DEFN) RETURN END SUBROUTINE GETAC0(TABLE,NP) INTEGER TABLE(32) INTEGER NP INTEGER NP,T INTEGER DGETS0,COLLE0 INTEGER BUF(1000),TEXT(200) INTEGER SDUPL 10167 T=DGETS0(TEXT) IF((T.EQ.160))GOTO 10167 IF((T.EQ.137))GOTO 10167 IF((T.EQ.168))GOTO 10168 NP=0 CALL PUTBC0(TEXT) RETURN 10168 NP=1 GOTO 10171 10169 NP=NP+1 10171 IF((NP.GT.32))GOTO 10170 T=COLLE0(BUF) TABLE(NP)=SDUPL(BUF) IF((T.NE.-1))GOTO 10169 RETURN 10170 CALL SYNERR('Too many actual parameters specified.',0) NP=32 RETURN END INTEGER FUNCTION COLLE0(BUF) INTEGER BUF(1000) INTEGER I,NLPAR,L INTEGER LENGTH,DGETS0 INTEGER INQUO0 INTEGER TEXT(200) INTEGER SYMTE0(200),NSYMT0(200) INTEGER SYMLE0,SYMBO0,SYMLI0,NSYML0,NSYMB0,NSYMM0 INTEGER SYMPT0,NSYMP0 COMMON /LEXCOM/SYMBO0,NSYMB0,SYMLE0,NSYML0,SYMPT0,NSYMP0,SYMTE0,NS *YMT0,SYMLI0,NSYMM0 INTEGER INBUF0(1105) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER DIRTO0,DFOTO0 INTEGER PPTBL0 INTEGER DIRNA0(300),DFONA0(300) COMMON /PPCOM/PPTBL0,DIRTO0,DIRNA0,DFOTO0,DFONA0 INTEGER KEYWD0,IDTBL0(50),SMTBL0(50) INTEGER LLAAA0 COMMON /IDCOM/LLAAA0,KEYWD0,IDTBL0,SMTBL0 INTEGER MEMAA0(30000) COMMON /DS$MEM/MEMAA0 INTEGER SEMSK0(300),CTLSK0(50) INTEGER SEMSP0,CTLSP0 COMMON /PARCOM/SEMSK0,SEMSP0,CTLSK0,CTLSP0 INTEGER INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LABEL0,PO *INT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0(20),MODEU0(20),MODE *V0 COMMON /MODCOM/INTMO0,CHARM0,SHORT0,LONGM0,UNSIG0,FLOAT0,DOUBL0,LA *BEL0,POINT0,SHORU0,LONGU0,CHARU0,MODET0,MODEL0,MODES0,MODEU0,MODEV *0 INTEGER EXPSK0(100),PROCM0,PROCR0 INTEGER EXPSP0,OBJNO0 INTEGER * 4 ZINIT0 COMMON /EXPCOM/EXPSK0,EXPSP0,OBJNO0,PROCM0,PROCR0,ZINIT0 INTEGER OUTFP0,NERRS0 INTEGER MODUL0(200),ERROR0(200) INTEGER A$BUF(200) INTEGER OUTFI0(3),CKFIL0 INTEGER FNAME0(5) COMMON /MISCOM/MODUL0,ERROR0,A$BUF,OUTFI0,OUTFP0,CKFIL0,NERRS0,FNA *ME0 INTEGER AAAAI0 INTEGER AAAAJ0 I=1 BUF(1)=0 NLPAR=0 INQUO0=160 10173 AAAAI0=DGETS0(TEXT) GOTO 10174 10175 IF((INQUO0.NE.160))GOTO 10177 NLPAR=NLPAR+1 10176 GOTO 10177 10178 IF((INQUO0.NE.160))GOTO 10177 NLPAR=NLPAR-1 IF((NLPAR.GE.0))GOTO 10180 GOTO 10181 10180 CONTINUE 10179 GOTO 10177 10182 IF((INQUO0.NE.160))GOTO 10183 INQUO0=162 GOTO 10177 10183 IF((INQUO0.NE.162))GOTO 10185 INQUO0=160 10185 CONTINUE 10184 GOTO 10177 10186 IF((INQUO0.NE.160))GOTO 10187 INQUO0=167 GOTO 10177 10187 IF((INQUO0.NE.167))GOTO 10189 INQUO0=160 10189 CONTINUE 10188 GOTO 10177 10190 IF((INQUO0.NE.160))GOTO 10177 IF((NLPAR.GT.0))GOTO 10177 GOTO 10181 10192 CALL SYNERR('unbalanced paren or EOF in define actual paramete *r list.',0) GOTO 10181 10174 IF(AAAAI0.EQ.-1)GOTO 10192 AAAAJ0=AAAAI0-161 GOTO(10182,10193,10193,10193,10193,10186,10175,10178,10193,10193 *,10190),AAAAJ0 10193 CONTINUE 10177 L=LENGTH(TEXT) IF((I+L.LT.1000))GOTO 10194 CALL SYNERR('define actual parameter too long.',0) GOTO 10181 10194 CALL SCOPY(TEXT,1,BUF,I) I=I+(L) GOTO 10173 10181 IF((TEXT(1).NE.172))GOTO 10195 COLLE0=-2 RETURN 10195 COLLE0=-1 RETURN END C ---- Long Name Map ---- C dumpsymentry dumpt0 C Procmode procm0 C declspecifiers decls0 C enterdefinition entes0 C islvalue islva0 C outoper outop0 C installdefinition insta0 C Nerrs nerrs0 C dumpsym dumps0 C entersmdecl entex0 C enumspecifier enums0 C openinclude openi0 C Nsymbol nsymb0 C Expsk expsk0 C enterchildmode enter0 C gencast genca0 C Dfoname dfona0 C checkarith check0 C droplitval dropl0 C outgoto outgo0 C returnstatement retur0 C Nsymlen nsyml0 C Symptr sympt0 C ckfncall ckfnc0 C cleanupll clean0 C genmakearith genma0 C Outfp outfp0 C alloctemp alloe0 C forstatement forst0 C outinitend outio0 C outsize outsi0 C putbackstr putbc0 C Floatmodeptr float0 C createmode creat0 C displaymode displ0 C Expsp expsp0 C convoper convo0 C outexprtree outey0 C putback putba0 C structdeclaratorlist strue0 C Nsymtext nsymt0 C Modelist model0 C Fnametable fname0 C filename filen0 C genopnd genoq0 C isconstant iscon0 C isstored issto0 C Dirname dirna0 C invokemacro invok0 C makemode makem0 C notstatementstart notsu0 C outexpr outex0 C structdecllist struf0 C Ll llaaa0 C Modesavelen modeu0 C functionheader funct0 C outdeclarations outde0 C Charunsmodeptr charu0 C Modesavetype modes0 C structdeclaration struc0 C Dfotop dfoto0 C ckputname ckpuu0 C findmode findm0 C refillbuffer refil0 C Keywdtbl keywd0 C declarations decla0 C entersiblingmode entew0 C genoper genop0 C getlong getlo0 C typeorscspec typeo0 C declarator declb0 C ssalloc ssall0 C accesssym acces0 C declarelabel declc0 C ifstatement ifsta0 C initializer initj0 C isnullconv isnul0 C resetline reset0 C Charmodeptr charm0 C ckputmode ckput0 C createsavedmode creau0 C displaysc dispo0 C dumpexpr dumpe0 C foldconst foldc0 C getlitval getli0 C initdeclarator initd0 C statementlabel statf0 C Idtbl idtbl0 C checkdeclaration checl0 C enumdeclarator enumd0 C gentoboolean gento0 C isarith isari0 C processifdef procg0 C Dirtop dirto0 C constantexpr const0 C expression expre0 C outstmt outst0 C checkfunctiondeclaration checm0 C convtype convt0 C dostatement dosta0 C enterll entev0 C Intmodeptr intmo0 C Doublemodeptr doubl0 C Zinitlen zinit0 C makesym makes0 C breakstatement break0 C expr10 expr10 C externaldefinition exter0 C structorunionspecifier struh0 C Symbol symbo0 C Nsymline nsymm0 C Inbuf inbuf0 C Ibp ibpaa0 C collectquotedstring collf0 C notstatementend notst0 C outname outna0 C arrayinit array0 C displayoper dispn0 C fatalerr fatal0 C findsym finds0 C scalarinit scala0 C Symlen symle0 C Pointermodeptr point0 C genindex genin0 C Ckfile ckfil0 C ckfndef ckfnd0 C displayop dispm0 C enteriddecl entet0 C isaggregate isagg0 C removedefinition remov0 C statement state0 C Level level0 C Mem memaa0 C Objno objno0 C arithexcep arith0 C compoundstatement compo0 C continuestatement conti0 C dgetsym dgets0 C initdeclaratorlist inite0 C outmode outmo0 C processdebug procf0 C savemode savem0 C Nsymptr nsymp0 C Labelmodeptr label0 C Shortunsmodeptr shoru0 C allocstruct allod0 C structinit strug0 C Symtext symte0 C cpreprocessor cprep0 C process proce0 C recordsym recor0 C Unsignedmodeptr unsig0 C Longunsmodeptr longu0 C enterkw enteu0 C outproccallarg outps0 C allocatestorage alloc0 C displaysymbol dispp0 C alignmode align0 C initialize initi0 C nextistype nexti0 C skipwhitespace skipw0 C Shortmodeptr short0 C Modulename modul0 C getactualparameters getac0 C gotostatement gotos0 C switchstatement switc0 C Outfile outfi0 C ckfnend ckfne0 C convconst convc0 C dumpmode dumpm0 C ispointer ispoi0 C primary prima0 C Infile infil0 C Longmodeptr longm0 C comparemode compa0 C modifyparammode modif0 C sizeofmode sizeo0 C Ctlsk ctlsk0 C inquote inquo0 C collectactualparameter colle0 C outinitstart outip0 C Pptbl pptbl0 C Smtbl smtbl0 C Modesavect modev0 C ckfnarg ckfna0 C Semsk semsk0 C Procrtnv procr0 C getdefinition getde0 C putlong putlo0 C getformalparameters getfo0 C putbacknum putbb0 C Ctlsp ctlsp0 C Modetable modet0 C genconvert genco0 C processifndef proch0 C structdeclarator strud0 C abstractdeclarator abstr0 C deallocexpr deall0 C gobbleuntilelseorendif gobbl0 C outinit outin0 C outproc outpr0 C putlitval putli0 C ssdealloc ssdea0 C typename typen0 C whilestatement while0 C Symline symli0 C Linenumber linen0 C Semsp semsp0 C Errorsym error0