EXTERNAL BHNDLR SHORTCALL MKONU$(18) INTEGER USAGE0(25) INTEGER A$BUF(200) INTEGER AAAAA0(4) INTEGER PARSCL INTEGER AAAAB0(6) DATA USAGE0/213,243,225,231,229,186,160,160,237,239,239,244,160,21 *9,173,225,160,188,238,225,237,229,190,221,0/ DATA AAAAA0/5,-11819,-13868,-23392/ DATA AAAAB0/225,188,242,243,190,0/ CALL MKONU$(AAAAA0,LOC(BHNDLR)) CALL INITLZ IF((PARSCL(AAAAB0,A$BUF).NE.-3))GOTO 10000 CALL ERROR(USAGE0) 10000 IF((A$BUF(225-225+1).EQ.0))GOTO 10001 CALL CHECK0(A$BUF(A$BUF(225-225+27))) GOTO 10002 10001 CALL LOGIN CALL DOCMDS CALL LOGOUT CALL CLEAN 10002 CALL SWT END SUBROUTINE AUTHOR INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER P,I INTEGER GETENT INTEGER UENTRY(102,5),PERM(102),BUF(102),PERM2(102) INTEGER AUPOS(17) INTEGER AUTHS(323) DATA AUTHS/1,238,193,228,228,160,195,239,238,230,229,242,229,238,2 *27,229,243,0,2,238,196,229,236,229,244,229,160,195,239,238,230,229 *,242,229,238,227,229,243,0,4,238,193,228,228,160,205,229,237,226,2 *29,242,243,0,5,238,196,229,236,229,244,229,160,205,229,237,226,229 *,242,243,0,6,249,204,233,243,244,160,195,239,238,230,229,242,229,2 *38,227,229,243,0,7,249,204,233,243,244,160,213,243,229,242,243,0,8 *,249,197,238,244,229,242,160,212,229,248,244,0,9,249,211,245,226,2 *37,233,244,160,195,239,238,230,229,242,229,238,227,229,160,197,238 *,244,242,233,229,243,0,10,249,211,245,226,237,233,244,160,208,229, *242,243,239,238,225,236,160,206,239,244,229,243,0,11,238,195,232,2 *25,238,231,229,160,193,245,244,232,239,242,233,250,225,244,233,239 *,238,243,0,12,249,210,229,246,233,229,247,160,195,239,238,230,229, *242,229,238,227,229,160,197,238,244,242,233,229,243,0,13,249,210,2 *29,246,233,229,247,160,208,229,242,243,239,238,225,236,160,206,239 *,244,229,243,0,14,249,202,239,233,238,160,195,239,238,230,229,242, *229,238,227,229,243,0,15,249,204,233,243,244,160,195,239,238,230,2 *29,242,229,238,227,229,160,205,229,237,226,229,242,243,0,3,249,193 *,226,233,236,233,244,249,160,244,239,160,204,239,231,160,201,238,0 *,16,238,196,229,236,229,244,229,160,213,243,229,242,243,0/ DATA AUPOS/16,1,19,40,54,71,90,103,116,144,168,192,220,244,263,289 *,309/ IF((PERMI0(11).NE.238))GOTO 10003 CALL ERRMSG('You are not permitted to change authorizations.') RETURN 10003 CALL ASK('User: .',BUF) IF((BUF(1).NE.0))GOTO 10004 RETURN 10004 CALL INIENT(UENTRY,5) CALL PUTKEY(UENTRY,BUF) IF((GETENT(UENTRY,5,MULFI0,1).NE.-1))GOTO 10005 CALL ERRMSG('That is not the name of a Moot user.') RETURN 10005 CALL GETDAT(PERM,239,UENTRY,5) IF((PERM(3).NE.238))GOTO 10006 CALL ERRMSG('User is currently logged in; authorization.') CALL ERRMSG('may not be changed.') RETURN 10006 I=2 GOTO 10009 10007 I=I+(1) 10009 IF((I.GT.AUPOS(1)+1))GOTO 10008 P=AUPOS(I) CALL GETYN(AUTHS(P),AUTHS(P+1),AUTHS(P+2),PERM) GOTO 10007 10008 I=1 GOTO 10012 10010 I=I+(1) 10012 IF((I.GT.18))GOTO 10011 IF((PERMI0(I).NE.238))GOTO 10013 IF((PERM(I).NE.249))GOTO 10013 CALL ERRMSG('Sorry, new authorizations must be a subset.') CALL ERRMSG('of your own.') RETURN 10013 GOTO 10010 10011 CALL LOCK IF((GETENT(UENTRY,5,MULFI0,0).NE.-1))GOTO 10014 CALL UNLOCK CALL ERRMSG('User disappeared while permissions were changing.') RETURN 10014 CALL GETDAT(PERM2,239,UENTRY,5) IF((PERM2(3).NE.238))GOTO 10015 CALL UNLOCK CALL ERRMSG('User logged in@.@.@.authorizations may not change.' *) RETURN 10015 CALL PUTDAT(PERM,239,UENTRY,5) CALL UPDENT(UENTRY,5,MULFI0,0) CALL UNLOCK RETURN END SUBROUTINE BHNDLR(PARAM) INTEGER * 4 PARAM INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 BROKE0=1 RETURN END SUBROUTINE CHECK0(USERN0) INTEGER USERN0(1) INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER CENTRY(102,7),UENTRY(102,4),BUF(102),CNAME(102) INTEGER L,LASTE0,NUMCO0 INTEGER CTOI,GETENT,GETLIN INTEGER CLFD,SCRFD INTEGER OPEN,MKTEMP INTEGER AAAAC0(5) INTEGER AAAAD0(40) INTEGER AAAAE0(8) DATA AAAAC0/170,243,170,238,0/ DATA AAAAD0/212,232,229,160,230,239,236,236,239,247,233,238,231,16 *0,227,239,238,230,229,242,229,238,227,229,243,160,225,242,229,160, *225,227,244,233,246,229,186,170,238,0/ DATA AAAAE0/160,160,160,160,160,170,243,0/ NUMCO0=0 SCRFD=MKTEMP(3) CALL INIENT(UENTRY,4) CALL PUTKEY(UENTRY,USERN0) CALL INIENT(CENTRY,7) CALL LOCK CLFD=OPEN(CLFIL0,1) 10016 L=GETLIN(CNAME,CLFD) IF((L.NE.-1))GOTO 10017 GOTO 10018 10017 CNAME(L)=0 IF((CNAME(1).NE.225))GOTO 10019 CALL PUTKEY(CENTRY,CNAME(2)) L=GETENT(CENTRY,7,CLFIL0,0) CALL GETDAT(BUF,227,CENTRY,7) L=1 LASTE0=CTOI(BUF,L) CALL GETDAT(BUF,231,CENTRY,7) IF((GETENT(UENTRY,4,BUF,0).EQ.-1))GOTO 10020 CALL GETDAT(BUF,227,UENTRY,4) L=1 IF((LASTE0.LE.CTOI(BUF,L)))GOTO 10021 CALL PRINT(SCRFD,AAAAC0,CNAME(2)) NUMCO0=NUMCO0+(1) 10021 CONTINUE 10020 CONTINUE 10019 CONTINUE GOTO 10016 10018 CALL CLOSE(CLFD) CALL UNLOCK IF((NUMCO0.LE.0))GOTO 10022 CALL PRINT(-11,AAAAD0) CALL REWIND(SCRFD) 10023 IF((GETLIN(BUF,SCRFD).EQ.-1))GOTO 10024 CALL PRINT(-11,AAAAE0,BUF) GOTO 10023 10024 CONTINUE 10022 CALL RMTEMP(SCRFD) RETURN END SUBROUTINE CKMESG INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER I,LSEEN,LENTRD INTEGER CTOI,ITOC,LENGTH,GETLIN,GETENT INTEGER BUF(102),CENTRY(102,7) INTEGER FD INTEGER OPEN INTEGER AAAAF0(39) DATA AAAAF0/217,239,245,160,232,225,246,229,160,243,229,229,238,16 *0,170,233,160,237,229,243,243,225,231,229,243,160,239,245,244,160, *239,230,160,170,233,174,170,238,0/ IF((.NOT.JOINE0))GOTO 10025 CALL INIENT(CENTRY,7) CALL PUTKEY(CENTRY,CONNA0) IF((GETENT(CENTRY,7,CLFIL0,1).NE.-1))GOTO 10026 RETURN 10026 CALL GETDAT(BUF,227,CENTRY,7) I=1 LENTRD=CTOI(BUF,I) CALL GETDAT(BUF,227,CONEN0,4) I=1 LSEEN=CTOI(BUF,I) IF((LENTRD.LE.LSEEN+10))GOTO 10027 CALL PRINT(-11,AAAAF0,LSEEN,LENTRD) GOTO 10028 10027 IF((LENTRD.LE.LSEEN))GOTO 10029 CALL REVCES(LSEEN+1,LENTRD) 10029 CONTINUE 10028 CONTINUE 10025 CALL GETDAT(BUF,233,CUSER0,5) I=1 LSEEN=CTOI(BUF,I) CALL LOCK FD=OPEN(NPNFI0,1) IF((FD.NE.-3))GOTO 10030 CALL UNLOCK RETURN 10030 I=GETLIN(BUF,FD) CALL CLOSE(FD) I=1 LENTRD=CTOI(BUF,I) CALL UNLOCK IF((LENTRD.LE.LSEEN))GOTO 10031 CALL REVPNS(LSEEN+1,LENTRD) 10031 RETURN END SUBROUTINE CLEAN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 CALL REMOVE(ENTFI0) RETURN END SUBROUTINE DOCMDS INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER GETCMD INTEGER CMDPOS(19) INTEGER CMDS(187) INTEGER AAAAG0 INTEGER AAAAH0 DATA CMDS/1,225,228,228,160,227,239,238,230,229,242,229,238,227,22 *9,0,2,228,229,236,229,244,229,160,227,239,238,230,229,242,229,238, *227,229,0,3,225,228,228,160,237,229,237,226,229,242,0,4,228,229,23 *6,229,244,229,160,237,229,237,226,229,242,0,5,236,233,243,244,160, *227,239,238,230,229,242,229,238,227,229,243,0,6,236,233,243,244,16 *0,245,243,229,242,243,0,11,236,233,243,244,160,237,229,237,226,229 *,242,243,0,7,229,238,244,229,242,0,8,229,228,233,244,0,9,234,239,2 *33,238,0,17,233,238,228,229,248,0,10,242,229,246,233,229,247,0,12, *243,245,226,237,233,244,0,13,225,245,244,232,239,242,233,250,229,0 *,14,243,244,225,244,245,243,0,15,237,225,233,236,0,16,236,229,244, *244,229,242,0,99,241,245,233,244,0/ DATA CMDPOS/18,1,17,36,48,63,81,93,107,114,120,126,133,141,149,160 *,168,174,182/ 10032 BROKE0=0 CMDCN0=CMDCN0+(1) IF((CMDCN0.LE.1))GOTO 10033 CMDCN0=1 CALL CKMESG 10033 AAAAG0=GETCMD('@..',CMDPOS,CMDS) GOTO 10034 10035 CALL MKCONF GOTO 10036 10037 CALL RMCONF GOTO 10036 10038 CALL MKMEMB GOTO 10036 10039 CALL RMMEMB GOTO 10036 10040 CALL LCONFS GOTO 10036 10041 CALL LUSERS GOTO 10036 10042 CALL MKTEXT GOTO 10036 10043 CALL EDITB0 GOTO 10036 10044 CALL JOIN GOTO 10036 10045 CALL REVCEN GOTO 10036 10046 CALL LMEMB GOTO 10036 10047 CALL SUBCEN GOTO 10036 10048 CALL AUTHOR GOTO 10036 10049 CALL STATUS GOTO 10036 10050 CALL SUBPN GOTO 10036 10051 CALL REVPN GOTO 10036 10052 CALL INDEX GOTO 10036 10053 GOTO 10054 10034 AAAAH0=AAAAG0+2 GOTO(10053,10055,10035,10037,10038,10039,10040,10041,10042,10043 *,10044,10045,10046,10047,10048,10049,10050,10051,10052,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055,10055 *,10055,10055,10053),AAAAH0 10055 CONTINUE 10036 CONTINUE GOTO 10032 10054 RETURN END SUBROUTINE EDITB0 INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER ENTFD INTEGER OPEN ENTFD=OPEN(ENTFI0,1) IF((ENTFD.NE.-3))GOTO 10056 CALL ERRMSG('No entry has been made.') RETURN 10056 CALL CLOSE(ENTFD) CALL EDIT(ENTFI0,-10,-11) RETURN END SUBROUTINE ERRMSG(MSG) INTEGER MSG(1) INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 CALL REMARK(MSG) INBUF0(IBPAA0)=0 RETURN END SUBROUTINE INDEX INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER SCRFD,TEXTFD INTEGER OPEN,MKTEMP INTEGER L,NUMBER INTEGER GETLIN INTEGER LINE(102),NUMBER(102),SENDER(102),SUBJ(102),DATE(102) INTEGER AAAAI0(36) INTEGER AAAAJ0 INTEGER AAAAK0(31) INTEGER AAAAL0 INTEGER AAAAM0(20) INTEGER AAAAN0(22) DATA AAAAI0/160,206,239,174,170,177,177,244,206,225,237,229,170,18 *0,177,244,211,245,226,234,229,227,244,170,183,178,244,196,225,244, *229,170,238,170,238,0/ DATA AAAAK0/170,180,172,180,243,160,170,177,182,172,177,182,243,16 *0,170,180,182,172,180,182,243,160,170,184,172,184,243,174,170,238, *0/ DATA AAAAM0/240,225,231,229,160,170,233,187,160,227,239,238,244,23 *3,238,245,229,191,160,0/ DATA AAAAN0/240,225,231,229,160,170,233,160,168,230,233,238,225,23 *6,160,240,225,231,229,169,160,0/ IF(JOINE0)GOTO 10057 CALL ERRMSG('You are not currently in a conference.') RETURN 10057 SCRFD=MKTEMP(3) CALL LOCK TEXTFD=OPEN(CURIN0,1) IF((TEXTFD.NE.-3))GOTO 10058 CALL PUTLIN(CURIN0,-15) CALL ERRMSG(': can''t open.') CALL UNLOCK RETURN 10058 CALL PRINT(SCRFD,AAAAI0) 10059 L=GETLIN(LINE,TEXTFD) IF((L.EQ.-1))GOTO 10060 LINE(L)=0 AAAAJ0=LINE(1) GOTO 10061 10062 CALL SCOPY(LINE,2,NUMBER,1) GOTO 10063 10064 CALL SCOPY(LINE,2,SENDER,1) GOTO 10063 10065 CALL SCOPY(LINE,2,SUBJ,1) GOTO 10063 10066 CALL SCOPY(LINE,11,DATE,1) GOTO 10063 10067 CALL PRINT(SCRFD,AAAAK0,NUMBER,SENDER,SUBJ,DATE) GOTO 10063 10061 AAAAL0=AAAAJ0-224 GOTO(10062,10068,10068,10066,10068,10068,10068,10068,10067,100 *64,10065),AAAAL0 10068 CONTINUE 10063 CONTINUE 10060 CONTINUE IF((L.NE.-1))GOTO 10059 CALL CLOSE(TEXTFD) CALL UNLOCK CALL REWIND(SCRFD) CALL PAGE(SCRFD,AAAAM0,AAAAN0,22,-11,2) CALL RMTEMP(SCRFD) RETURN END SUBROUTINE INITLZ INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER I INTEGER CLSTR(27) INTEGER MULSTR(31) INTEGER PNISTR(24) INTEGER PNTSTR(23) INTEGER NPNSTR(25) DATA CLSTR/189,229,248,244,242,225,189,175,237,239,239,244,174,245 *,175,227,239,238,230,229,242,229,238,227,229,243,0/ DATA MULSTR/189,229,248,244,242,225,189,175,237,239,239,244,174,24 *5,175,237,225,243,244,229,242,223,245,243,229,242,236,233,243,244, *0/ DATA PNISTR/189,229,248,244,242,225,189,175,237,239,239,244,174,24 *5,175,240,238,223,233,238,228,229,248,0/ DATA PNTSTR/189,229,248,244,242,225,189,175,237,239,239,244,174,24 *5,175,240,238,223,244,229,248,244,0/ DATA NPNSTR/189,229,248,244,242,225,189,175,237,239,239,244,174,24 *5,175,240,238,223,238,245,237,226,229,242,0/ BROKE0=0 DO 10069 I=1,18 PERMI0(I)=249 10069 CONTINUE 10070 PERMI0(1)=238 PERMI0(2)=238 PERMI0(4)=238 PERMI0(5)=238 PERMI0(11)=238 PERMI0(18+1)=0 CALL INIENT(CUSER0,5) CALL INIENT(CONEN0,4) CALL SCOPY(CLSTR,1,CLFIL0,1) CALL SCOPY(MULSTR,1,MULFI0,1) CALL SCOPY(PNISTR,1,PNIFI0,1) CALL SCOPY(PNTSTR,1,PNTFI0,1) CALL SCOPY(NPNSTR,1,NPNFI0,1) CALL SCRATF(ENTFI0,102) IBPAA0=1 INBUF0(IBPAA0)=0 CMDCN0=1 RETURN END SUBROUTINE JOIN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER CENTRY(102,7),BUF(102) INTEGER GETENT INTEGER TXTFD,INXFD,ULFD INTEGER OPEN IF((PERMI0(14).NE.238))GOTO 10071 CALL ERRMSG('You are not permitted to join conferences.') RETURN 10071 CALL UPDCEN CALL INIENT(CENTRY,7) CALL ASK('Conference: .',BUF) IF((BUF(1).NE.0))GOTO 10072 RETURN 10072 CALL PUTKEY(CENTRY,BUF) IF((GETENT(CENTRY,7,CLFIL0,1).NE.-1))GOTO 10073 CALL ERRMSG('That is not the name of an active conference.') RETURN 10073 CALL GETKEY(CENTRY,CONNA0) CALL GETDAT(CURTX0,229,CENTRY,7) CALL GETDAT(CURIN0,230,CENTRY,7) CALL GETDAT(CURUL0,231,CENTRY,7) CALL LOCK TXTFD=OPEN(CURTX0,3) IF((TXTFD.EQ.-3))GOTO 10074 CALL CLOSE(TXTFD) 10074 INXFD=OPEN(CURIN0,3) IF((INXFD.EQ.-3))GOTO 10075 CALL CLOSE(INXFD) 10075 ULFD=OPEN(CURUL0,3) IF((ULFD.EQ.-3))GOTO 10076 CALL CLOSE(ULFD) 10076 CALL UNLOCK IF((TXTFD.EQ.-3))GOTO 10078 IF((INXFD.EQ.-3))GOTO 10078 IF((ULFD.EQ.-3))GOTO 10078 GOTO 10077 10078 CALL ERRMSG('System security is preventing access to that confer *ence.') RETURN 10077 IF((GETENT(CONEN0,4,CURUL0,1).NE.-1))GOTO 10079 CALL ERRMSG('You are not a member of that conference.') RETURN 10079 JOINE0=.TRUE. RETURN END SUBROUTINE LCONFS INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER GETLIN INTEGER SCR,FD INTEGER MKTEMP,OPEN IF((PERMI0(6).NE.238))GOTO 10080 CALL ERRMSG('You are not permitted to list active conferences.') RETURN 10080 SCR=MKTEMP(3) CALL LOCK FD=OPEN(CLFIL0,1) IF((FD.NE.-3))GOTO 10081 CALL ERRMSG('can''t open conference list.') RETURN 10081 CALL FCOPY(FD,SCR) CALL CLOSE(FD) CALL UNLOCK CALL REWIND(SCR) 10082 IF((GETLIN(BUF,SCR).EQ.-1))GOTO 10083 IF((BUF(1).NE.225))GOTO 10084 CALL PUTLIN(BUF(2),-11) 10084 IF((BROKE0.NE.1))GOTO 10085 GOTO 10083 10085 GOTO 10082 10083 CALL RMTEMP(SCR) RETURN END SUBROUTINE LMEMB INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER L INTEGER GETLIN INTEGER SCR,FD INTEGER MKTEMP,OPEN INTEGER AAAAO0(8) INTEGER AAAAP0(7) INTEGER AAAAQ0(8) DATA AAAAO0/170,243,170,179,176,244,160,0/ DATA AAAAP0/170,243,170,181,244,160,0/ DATA AAAAQ0/170,243,170,177,181,244,160,0/ IF((PERMI0(15).NE.238))GOTO 10086 CALL ERRMSG('You are not permitted to list conference members.') RETURN 10086 IF(JOINE0)GOTO 10087 CALL LUSERS RETURN 10087 SCR=MKTEMP(3) CALL LOCK FD=OPEN(CURUL0,1) IF((FD.NE.-3))GOTO 10088 CALL ERRMSG('can''t open users list.') RETURN 10088 CALL FCOPY(FD,SCR) CALL CLOSE(FD) CALL UNLOCK CALL REWIND(SCR) 10089 L=GETLIN(BUF,SCR) IF((L.EQ.-1))GOTO 10091 IF((BROKE0.EQ.1))GOTO 10091 GOTO 10090 10091 GOTO 10092 10090 IF((BUF(1).NE.225))GOTO 10093 BUF(L)=0 CALL PRINT(-11,AAAAO0,BUF(2)) L=GETLIN(BUF,SCR) BUF(L)=0 CALL PRINT(-11,AAAAP0,BUF(2)) L=GETLIN(BUF,SCR) BUF(L)=0 CALL PRINT(-11,AAAAQ0,BUF(2)) L=GETLIN(BUF,SCR) CALL PUTLIN(BUF(2),-15) 10093 CONTINUE GOTO 10089 10092 CALL RMTEMP(SCR) RETURN END SUBROUTINE LOGIN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER PWORD(102),BUF(102) INTEGER DUPLEX,CODE INTEGER GETENT,EQUAL,DUPLX$,SEM$TS INTEGER * 4 FM 10094 CALL ASK('Please enter your name: .',BUF) IF((BUF(1).EQ.0))GOTO 10094 CALL PUTKEY(CUSER0,BUF) IF((SEM$TS(1,CODE).EQ.-1))GOTO 10095 CALL SLEEP$(INTL(5000)) IF((SEM$TS(1,CODE).EQ.-1))GOTO 10096 CALL ERROR('The data base is locked --- please ask for assista *nce.') 10096 CONTINUE 10095 CALL LOCK IF((GETENT(CUSER0,5,MULFI0,0).NE.-1))GOTO 10097 CALL PUTDAT(0,232,CUSER0,5) FM=0 CALL FMTOC(FM,BUF) CALL PUTDAT(BUF,233,CUSER0,5) CALL GETTIM(BUF) CALL PUTDAT(BUF,228,CUSER0,5) PERMI0(3)=238 CALL PUTDAT(PERMI0,239,CUSER0,5) CALL MAKENT(CUSER0,5,MULFI0,0) CALL UNLOCK CALL REMARK('Ah, an unfamiliar name@..') CALL REMARK('If you would like the name you just specified.') CALL REMARK('to be the name by which Moot will identify you.') CALL REMARK('(the management recommends calling name followed.') CALL REMARK('by last name, both capitalized), please verify.') CALL ASK('by typing ''y'': .',BUF) IF((BUF(1).EQ.249))GOTO 10098 IF((BUF(1).EQ.217))GOTO 10098 CALL REMARK('Very well@. Please reenter Moot and try again@.. *') CALL GETKEY(CUSER0,BUF) CALL DELENT(BUF,MULFI0,1) CALL SWT 10098 CALL REMARK('Please enter a secret password, which will be.') DUPLEX=DUPLX$(-1) CALL DUPLX$(:140000) CALL ASK('required to reenter the Moot in the future: .',PWORD) CALL DUPLX$(DUPLEX) CALL REMARK('.') CALL PWCRYP(PWORD) CALL PUTDAT(PWORD,232,CUSER0,5) GOTO 10099 10097 CALL GETDAT(PERMI0,239,CUSER0,5) IF((PERMI0(3).NE.238))GOTO 10100 CALL UNLOCK CALL ERROR('You are not permitted to log in now.') 10100 PERMI0(3)=238 CALL PUTDAT(PERMI0,239,CUSER0,5) CALL UPDENT(CUSER0,5,MULFI0,0) CALL UNLOCK DUPLEX=DUPLX$(-1) CALL DUPLX$(:140000) CALL ASK('Please enter your password: .',PWORD) CALL DUPLX$(DUPLEX) CALL REMARK('.') CALL PWCRYP(PWORD) CALL GETDAT(BUF,232,CUSER0,5) IF((EQUAL(PWORD,BUF).NE.0))GOTO 10101 CALL REMARK('Your password was incorrect.') CALL REMARK('Please recheck it and try again.') PERMI0(3)=249 CALL PUTDAT(PERMI0,239,CUSER0,5) CALL UPDENT(CUSER0,5,MULFI0,1) CALL SWT 10101 CONTINUE 10099 PERMI0(3)=249 CALL PUTDAT(PERMI0,239,CUSER0,5) CALL REMARK('Welcome to the Moot@..') JOINE0=.FALSE. CALL GETKEY(CUSER0,USERA0) CALL PUTKEY(CONEN0,USERA0) RETURN END SUBROUTINE LOGOUT INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) CALL UPDCEN CALL GETTIM(BUF) CALL PUTDAT(BUF,228,CUSER0,5) CALL UPDENT(CUSER0,5,MULFI0,1) RETURN END SUBROUTINE LUSERS INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER L INTEGER GETLIN INTEGER SCR,FD INTEGER MKTEMP,OPEN INTEGER AAAAR0(7) DATA AAAAR0/170,243,170,179,176,244,0/ IF((PERMI0(7).NE.238))GOTO 10102 CALL ERRMSG('You are not permitted to list Moot users.') RETURN 10102 SCR=MKTEMP(3) CALL LOCK FD=OPEN(MULFI0,1) IF((FD.NE.-3))GOTO 10103 CALL ERRMSG('can''t open users list.') RETURN 10103 CALL FCOPY(FD,SCR) CALL CLOSE(FD) CALL UNLOCK CALL REWIND(SCR) 10104 L=GETLIN(BUF,SCR) IF((L.EQ.-1))GOTO 10106 IF((BROKE0.EQ.1))GOTO 10106 GOTO 10105 10106 GOTO 10107 10105 IF((BUF(1).NE.225))GOTO 10108 BUF(L)=0 CALL PRINT(-11,AAAAR0,BUF(2)) L=GETLIN(BUF,SCR) IF((BUF(1).NE.228))GOTO 10109 CALL PUTLIN(BUF(2),-11) 10109 L=GETLIN(BUF,SCR) IF((BUF(1).NE.228))GOTO 10110 CALL PUTLIN(BUF(2),-11) 10110 L=GETLIN(BUF,SCR) IF((BUF(1).NE.228))GOTO 10111 CALL PUTLIN(BUF(2),-11) 10111 CONTINUE 10108 CONTINUE GOTO 10104 10107 CALL RMTEMP(SCR) RETURN END SUBROUTINE MKCONF INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER GETENT INTEGER ENTRY(102,7),ANSWER(102) LOGICAL EQUNAM INTEGER FD INTEGER CREATE INTEGER AAAAS0(5) INTEGER AAAAT0(7) INTEGER AAAAU0(2) INTEGER AAAAV0(4) DATA AAAAS0/239,240,229,238,0/ DATA AAAAT0/227,236,239,243,229,228,0/ DATA AAAAU0/176,0/ DATA AAAAV0/249,229,243,0/ IF((PERMI0(1).NE.238))GOTO 10112 CALL ERRMSG('You are not permitted to make conferences.') RETURN 10112 CALL INIENT(ENTRY,7) CALL ASK('Title: .',ANSWER) CALL PUTKEY(ENTRY,ANSWER) IF((GETENT(ENTRY,1,CLFIL0,1).EQ.-1))GOTO 10113 CALL ERRMSG('A conference by that name already exists.') RETURN 10113 CALL ASK('Access (open or closed): .',ANSWER) IF(EQUNAM(ANSWER,AAAAS0))GOTO 10114 IF(EQUNAM(ANSWER,AAAAT0))GOTO 10114 CALL ERRMSG('Access must be ''open'' or ''closed''.') RETURN 10114 CALL PUTDAT(ANSWER,226,ENTRY,7) CALL PUTDAT(AAAAU0,227,ENTRY,7) CALL GETTIM(ANSWER) CALL PUTDAT(ANSWER,228,ENTRY,7) CALL ASK('File for storage of text: .',ANSWER) CALL PUTDAT(ANSWER,229,ENTRY,7) CALL ASK('File for storage of index: .',ANSWER) CALL PUTDAT(ANSWER,230,ENTRY,7) CALL ASK('File for storage of user list: .',ANSWER) CALL PUTDAT(ANSWER,231,ENTRY,7) CALL ASK('Is the information above acceptable? .',ANSWER) IF(EQUNAM(ANSWER,AAAAV0))GOTO 10115 RETURN 10115 CALL GETDAT(ANSWER,229,ENTRY,7) FD=CREATE(ANSWER,3) IF((FD.NE.-3))GOTO 10116 CALL CANT(ANSWER) 10116 CALL CLOSE(FD) CALL GETDAT(ANSWER,230,ENTRY,7) FD=CREATE(ANSWER,3) IF((FD.NE.-3))GOTO 10117 CALL CANT(ANSWER) 10117 CALL CLOSE(FD) CALL GETDAT(ANSWER,231,ENTRY,7) FD=CREATE(ANSWER,3) IF((FD.NE.-3))GOTO 10118 CALL CANT(ANSWER) 10118 CALL CLOSE(FD) CALL MAKENT(ENTRY,7,CLFIL0,1) RETURN END SUBROUTINE MKMEMB INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER CENTRY(102,7),UENTRY(102,4),BUF(102) INTEGER JUNK INTEGER GETENT,ITOC LOGICAL EQUNAM INTEGER AAAAW0(2) INTEGER AAAAX0(9) INTEGER AAAAY0(12) DATA AAAAW0/176,0/ DATA AAAAX0/239,226,243,229,242,246,229,242,0/ DATA AAAAY0/240,225,242,244,233,227,233,240,225,238,244,0/ IF((PERMI0(4).NE.238))GOTO 10119 CALL ERRMSG('You are not permitted to add members to conferences *.') RETURN 10119 CALL INIENT(CENTRY,7) CALL ASK('Conference name: .',BUF) IF((BUF(1).NE.0))GOTO 10120 RETURN 10120 CALL PUTKEY(CENTRY,BUF) IF((GETENT(CENTRY,7,CLFIL0,1).NE.-1))GOTO 10121 CALL ERRMSG('That is not the name of an active conference.') RETURN 10121 CALL INIENT(UENTRY,4) CALL ASK('User name: .',BUF) IF((BUF(1).NE.0))GOTO 10122 RETURN 10122 CALL PUTKEY(UENTRY,BUF) IF((GETENT(UENTRY,4,CENTRY(2,7),1).EQ.-1))GOTO 10123 CALL ERRMSG('The user is already a member of the conference.') RETURN 10123 IF((GETENT(UENTRY,1,MULFI0,1).NE.-1))GOTO 10124 CALL ERRMSG('Warning: there is no Moot user by that name.') 10124 CALL PUTDAT(AAAAW0,227,UENTRY,4) 10125 CALL ASK('''Observer'' or ''participant'' status? .',BUF) IF(EQUNAM(BUF,AAAAX0))GOTO 10127 IF(EQUNAM(BUF,AAAAY0))GOTO 10127 GOTO 10126 10127 GOTO 10128 10126 CALL ERRMSG('Please enter ''observer'' or ''participant''.') GOTO 10125 10128 CALL PUTDAT(BUF,238,UENTRY,4) CALL PUTDAT(0,228,UENTRY,4) CALL GETDAT(BUF,231,CENTRY,7) CALL MAKENT(UENTRY,4,BUF,1) RETURN END SUBROUTINE MKTEXT INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER FD INTEGER CREATE IF((PERMI0(8).NE.238))GOTO 10129 CALL ERRMSG('You are not permitted to enter text.') RETURN 10129 CALL REMOVE(ENTFI0) FD=CREATE(ENTFI0,3) IF((FD.NE.-3))GOTO 10130 CALL ERRMSG('can''t open temporary file for text storage.') RETURN 10130 CALL ASK('Subject: .',BUF) CALL PUTLIN(BUF,FD) CALL PUTCH(138,FD) CALL ASK('Reference entries: .',BUF) CALL PUTLIN(BUF,FD) CALL PUTCH(138,FD) CALL REMARK('Text:.') CALL FCOPY(-10,FD) CALL CLOSE(FD) RETURN END SUBROUTINE REVCEN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER START,FINISH,I INTEGER CTOI IF(JOINE0)GOTO 10131 CALL ERRMSG('You are not currently in a conference.') RETURN 10131 IF((PERMI0(12).NE.238))GOTO 10132 CALL ERRMSG('You are not permitted to review conference entries. *') RETURN 10132 CALL ASK('Entry or range of entries: .',BUF) I=1 START=CTOI(BUF,I) IF((START.NE.0))GOTO 10133 CALL ERRMSG('Entries are specified by number.') RETURN 10133 IF((BUF(I).NE.173))GOTO 10134 I=I+(1) FINISH=CTOI(BUF,I) IF((FINISH.NE.0))GOTO 10135 CALL ERRMSG('Entries are specified by number.') RETURN 10135 IF((FINISH.GE.START))GOTO 10136 FINISH=START 10136 GOTO 10137 10134 FINISH=START 10137 CALL REVCES(START,FINISH) RETURN END SUBROUTINE REVCES(START,FINISH) INTEGER START,FINISH INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER I,L,LSEEN,LREVD INTEGER CTOI,GETENT,GETLIN INTEGER BUF(102),IENTRY(102,6),SENDER(102),SUBJ(102),XREF(102),DAT *E(102) INTEGER * 4 SM INTEGER TEXTFD,SCRFD INTEGER OPEN,MKTEMP INTEGER AAAAZ0 INTEGER AAABA0(10) INTEGER AAABB0(36) INTEGER AAABC0 INTEGER AAABD0(20) INTEGER AAABE0(22) DATA AAABA0/170,238,170,238,219,170,233,221,160,0/ DATA AAABB0/170,243,172,160,170,243,210,229,186,160,160,170,243,19 *5,242,239,243,243,173,210,229,230,229,242,229,238,227,229,186,160, *160,170,243,170,238,0/ DATA AAABD0/240,225,231,229,160,170,233,187,160,227,239,238,244,23 *3,238,245,229,191,160,0/ DATA AAABE0/240,225,231,229,160,170,233,160,168,230,233,238,225,23 *6,160,240,225,231,229,169,160,0/ CALL ITOC0F(START,BUF,5) CALL INIENT(IENTRY,6) CALL PUTKEY(IENTRY,BUF) IF((GETENT(IENTRY,6,CURIN0,1).NE.-1))GOTO 10138 CALL ERRMSG('Entry number specified is out of range.') RETURN 10138 CALL GETDAT(BUF,233,IENTRY,6) CALL CTOFM(BUF,SM) SCRFD=MKTEMP(3) CALL LOCK TEXTFD=OPEN(CURTX0,1) IF((TEXTFD.NE.-3))GOTO 10139 CALL UNLOCK CALL ERROR('Fatal error --- can''t open text storage file.') 10139 CALL SEEKF(SM,TEXTFD) 10140 L=GETLIN(BUF,TEXTFD) IF((L.EQ.-1))GOTO 10142 IF((BROKE0.EQ.1))GOTO 10142 GOTO 10141 10142 GOTO 10143 10141 AAAAZ0=BUF(1) GOTO 10144 10145 I=2 LREVD=CTOI(BUF,I) IF((LREVD.LE.FINISH))GOTO 10146 LREVD=LREVD-1 GOTO 10143 10146 CALL PRINT(SCRFD,AAABA0,LREVD) GOTO 10147 10148 BUF(L)=0 CALL SCOPY(BUF,2,SENDER,1) GOTO 10147 10149 CALL SCOPY(BUF,2,SUBJ,1) GOTO 10147 10150 CALL SCOPY(BUF,2,XREF,1) GOTO 10147 10151 CALL SCOPY(BUF,2,DATE,1) GOTO 10147 10152 CALL PRINT(SCRFD,AAABB0,SENDER,DATE,SUBJ,XREF) 10153 CALL PUTLIN(BUF(2),SCRFD) L=GETLIN(BUF,TEXTFD) IF((BUF(1).NE.250))GOTO 10153 GOTO 10147 10144 AAABC0=AAAAZ0-224 GOTO(10145,10154,10154,10151,10154,10154,10154,10154,10154,10148 *,10149,10152,10150),AAABC0 10154 CONTINUE 10147 CONTINUE GOTO 10140 10143 CALL CLOSE(TEXTFD) CALL UNLOCK CALL REWIND(SCRFD) CALL PAGE(SCRFD,AAABD0,AAABE0,22,-11,2) CALL GETDAT(BUF,227,CONEN0,4) I=1 LSEEN=CTOI(BUF,I) IF((LREVD.LE.LSEEN))GOTO 10155 CALL ITOC0F(LREVD,BUF,5) CALL PUTDAT(BUF,227,CONEN0,4) 10155 CALL RMTEMP(SCRFD) RETURN END SUBROUTINE REVPN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER START,FINISH,I INTEGER CTOI IF((PERMI0(13).NE.238))GOTO 10156 CALL ERRMSG('You are not permitted to review personal notes.') RETURN 10156 CALL ASK('Note number or range of numbers: .',BUF) I=1 START=CTOI(BUF,I) IF((START.NE.0))GOTO 10157 CALL ERRMSG('Notes are specified by number.') RETURN 10157 IF((BUF(I).NE.173))GOTO 10158 I=I+(1) FINISH=CTOI(BUF,I) IF((FINISH.NE.0))GOTO 10159 CALL ERRMSG('Notes are specified by number.') RETURN 10159 IF((FINISH.GE.START))GOTO 10160 FINISH=START 10160 GOTO 10161 10158 FINISH=START 10161 CALL REVPNS(START,FINISH) RETURN END SUBROUTINE REVPNS(START,FINISH) INTEGER START,FINISH INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER I,L,NOTENO,LASTNT INTEGER CTOI,GETENT,GETLIN INTEGER BUF(102),PENTRY(102,7),SENDER(102),SUBJ(102),XREF(102),DAT *E(102) LOGICAL EQUNAM INTEGER * 4 SM INTEGER TEXTFD,SCRFD INTEGER OPEN,MKTEMP INTEGER AAABF0 INTEGER AAABG0(45) INTEGER AAABH0 INTEGER AAABI0(20) INTEGER AAABJ0(22) DATA AAABG0/170,238,170,238,219,170,233,221,160,170,243,172,160,17 *0,243,210,229,186,160,160,170,243,195,242,239,243,243,173,242,229, *230,229,242,229,238,227,229,186,160,160,170,243,170,238,0/ DATA AAABI0/240,225,231,229,160,170,233,187,160,227,239,238,244,23 *3,238,245,229,191,160,0/ DATA AAABJ0/240,225,231,229,160,170,233,160,168,230,233,238,225,23 *6,160,240,225,231,229,169,160,0/ CALL GETDAT(BUF,233,CUSER0,5) I=1 LASTNT=CTOI(BUF,I) CALL ITOC0F(START,BUF,5) CALL INIENT(PENTRY,7) CALL PUTKEY(PENTRY,BUF) IF((GETENT(PENTRY,7,PNIFI0,1).NE.-1))GOTO 10162 CALL ERRMSG('Note number specified is out of range.') RETURN 10162 CALL GETDAT(BUF,233,PENTRY,7) CALL CTOFM(BUF,SM) SCRFD=MKTEMP(3) CALL LOCK TEXTFD=OPEN(PNTFI0,1) IF((TEXTFD.NE.-3))GOTO 10163 CALL UNLOCK CALL ERROR('Fatal error --- can''t open text storage file.') 10163 CALL SEEKF(SM,TEXTFD) 10164 L=GETLIN(BUF,TEXTFD) IF((L.EQ.-1))GOTO 10166 IF((BROKE0.EQ.1))GOTO 10166 GOTO 10165 10166 GOTO 10167 10165 AAABF0=BUF(1) GOTO 10168 10169 I=2 NOTENO=CTOI(BUF,I) IF((NOTENO.LE.FINISH))GOTO 10170 GOTO 10167 10170 LASTNT=MAX0(NOTENO,LASTNT) GOTO 10171 10172 BUF(L)=0 CALL SCOPY(BUF,2,SENDER,1) GOTO 10171 10173 BUF(L)=0 IF(EQUNAM(BUF(2),USERA0))GOTO 10174 10175 IF((BUF(1).EQ.250))GOTO 10176 L=GETLIN(BUF,TEXTFD) GOTO 10175 10176 CONTINUE 10174 GOTO 10171 10177 CALL SCOPY(BUF,2,SUBJ,1) GOTO 10171 10178 CALL SCOPY(BUF,2,XREF,1) GOTO 10171 10179 CALL SCOPY(BUF,2,DATE,1) GOTO 10171 10180 CALL PRINT(SCRFD,AAABG0,NOTENO,SENDER,DATE,SUBJ,XREF) 10181 CALL PUTLIN(BUF(2),SCRFD) L=GETLIN(BUF,TEXTFD) IF((BUF(1).NE.250))GOTO 10181 GOTO 10171 10168 AAABH0=AAABF0-224 GOTO(10169,10182,10182,10179,10182,10182,10182,10182,10182,10172 *,10177,10180,10178,10182,10182,10173),AAABH0 10182 CONTINUE 10171 CONTINUE GOTO 10164 10167 CALL CLOSE(TEXTFD) CALL UNLOCK CALL REWIND(SCRFD) CALL PAGE(SCRFD,AAABI0,AAABJ0,22,-11,2) CALL RMTEMP(SCRFD) CALL ITOC0F(LASTNT,BUF,5) CALL PUTDAT(BUF,233,CUSER0,5) RETURN END SUBROUTINE RMCONF INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER ENTRY(102,7),BUF(102) INTEGER GETENT IF((PERMI0(2).NE.238))GOTO 10183 CALL ERRMSG('You are not permitted to remove conferences.') RETURN 10183 CALL INIENT(ENTRY,7) CALL ASK('Conference name: .',BUF) IF((BUF(1).NE.0))GOTO 10184 RETURN 10184 CALL PUTKEY(ENTRY,BUF) IF((GETENT(ENTRY,7,CLFIL0,1).NE.-1))GOTO 10185 CALL ERRMSG('That is not the name of an active conference.') RETURN 10185 CALL GETDAT(BUF,229,ENTRY,7) CALL REMOVE(BUF) CALL GETDAT(BUF,230,ENTRY,7) CALL REMOVE(BUF) CALL GETDAT(BUF,231,ENTRY,7) CALL REMOVE(BUF) CALL GETKEY(ENTRY,BUF) CALL DELENT(BUF,CLFIL0,1) RETURN END SUBROUTINE RMMEMB INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER CENTRY(102,7),NAME(102),BUF(102) INTEGER GETENT IF((PERMI0(5).NE.238))GOTO 10186 CALL ERRMSG('You are not permitted to remove members from confer *ences.') RETURN 10186 CALL INIENT(CENTRY,7) CALL ASK('Conference name: .',NAME) IF((NAME(1).NE.0))GOTO 10187 RETURN 10187 CALL PUTKEY(CENTRY,NAME) IF((GETENT(CENTRY,7,CLFIL0,1).NE.-1))GOTO 10188 CALL ERRMSG('That is not the name of an active conference.') RETURN 10188 CALL ASK('User name: .',NAME) IF((NAME(1).NE.0))GOTO 10189 RETURN 10189 CALL GETDAT(BUF,231,CENTRY,7) CALL DELENT(NAME,BUF,1) RETURN END SUBROUTINE STATUS INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102),NAME(102) INTEGER GETLIN INTEGER FD,ULFD INTEGER OPEN,MKTEMP INTEGER AAABK0(11) INTEGER AAABL0(8) INTEGER AAABM0(31) INTEGER AAABN0(45) DATA AAABK0/208,242,229,243,229,238,244,186,170,238,0/ DATA AAABL0/160,160,160,160,160,170,243,0/ DATA AAABM0/170,238,217,239,245,160,225,242,229,160,233,238,160,22 *7,239,238,230,229,242,229,238,227,229,160,167,170,243,167,170,238, *0/ DATA AAABN0/170,238,217,239,245,160,225,242,229,160,238,239,244,16 *0,233,238,160,225,160,227,239,238,230,229,242,229,238,227,229,160, *225,244,160,244,232,233,243,160,244,233,237,229,170,238,0/ FD=MKTEMP(3) CALL LOCK ULFD=OPEN(MULFI0,1) IF((ULFD.NE.-3))GOTO 10190 CALL UNLOCK CALL ERRMSG('Cannot open master userlist.') RETURN 10190 CONTINUE 10191 IF((GETLIN(BUF,ULFD).EQ.-1))GOTO 10192 IF((BUF(1).NE.225))GOTO 10193 CALL SCOPY(BUF,2,NAME,1) GOTO 10194 10193 IF((BUF(1).NE.239))GOTO 10195 IF((BUF(3+1).NE.238))GOTO 10196 CALL PUTLIN(NAME,FD) 10196 CONTINUE 10195 CONTINUE 10194 GOTO 10191 10192 CALL CLOSE(ULFD) CALL UNLOCK CALL REWIND(FD) CALL PRINT(-11,AAABK0) 10197 IF((GETLIN(BUF,FD).EQ.-1))GOTO 10198 CALL PRINT(-11,AAABL0,BUF) GOTO 10197 10198 CALL RMTEMP(FD) IF((.NOT.JOINE0))GOTO 10199 CALL PRINT(-11,AAABM0,CONNA0) GOTO 10200 10199 CALL PRINT(-11,AAABN0) 10200 RETURN END SUBROUTINE SUBCEN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER ENTFD,TEXTFD INTEGER OPEN INTEGER CENTRY(102,7),IENTRY(102,6),BUF(102) INTEGER I,LE INTEGER GETENT,CTOI,GETLIN LOGICAL EQUNAM INTEGER * 4 MARKF INTEGER AAABO0(9) INTEGER AAABP0(5) INTEGER AAABQ0(5) INTEGER AAABR0(5) INTEGER AAABS0(5) DATA AAABO0/239,226,243,229,242,246,229,242,0/ DATA AAABP0/170,243,170,238,0/ DATA AAABQ0/170,227,170,243,0/ DATA AAABR0/170,227,170,238,0/ DATA AAABS0/170,233,170,238,0/ IF(JOINE0)GOTO 10201 CALL ERRMSG('You are not currently in a conference.') RETURN 10201 IF((PERMI0(9).NE.238))GOTO 10202 CALL ERRMSG('You are not permitted to submit text.') RETURN 10202 ENTFD=OPEN(ENTFI0,1) IF((ENTFD.NE.-3))GOTO 10203 CALL ERRMSG('No entry has been made.') RETURN 10203 CALL GETDAT(BUF,238,CONEN0,4) IF((.NOT.EQUNAM(BUF,AAABO0)))GOTO 10204 CALL ERRMSG('You have ''observer'' status only; you cannot submi *t.') RETURN 10204 CALL LOCK TEXTFD=OPEN(CURTX0,3) IF((TEXTFD.NE.-3))GOTO 10205 CALL UNLOCK CALL ERROR('fatal error --- can''t open conference text file.') 10205 CALL WIND(TEXTFD) CALL INIENT(CENTRY,7) CALL PUTKEY(CENTRY,CONNA0) IF((GETENT(CENTRY,7,CLFIL0,0).NE.-1))GOTO 10206 CALL UNLOCK CALL ERROR('fatal error --- can''t get conference entry.') 10206 CALL GETDAT(BUF,227,CENTRY,7) I=1 LE=CTOI(BUF,I)+1 CALL ITOC0F(LE,BUF,5) CALL PUTDAT(BUF,227,CENTRY,7) CALL PUTDAT(BUF,227,CONEN0,4) CALL UPDENT(CENTRY,7,CLFIL0,0) CALL INIENT(IENTRY,6) CALL PUTKEY(IENTRY,BUF) CALL PUTDAT(USERA0,234,IENTRY,6) I=GETLIN(BUF,ENTFD) CALL PUTDAT(BUF,235,IENTRY,6) I=GETLIN(BUF,ENTFD) CALL PUTDAT(BUF,237,IENTRY,6) CALL GETTIM(BUF) CALL PUTDAT(BUF,228,IENTRY,6) CALL FMTOC(MARKF(TEXTFD),BUF) CALL PUTDAT(BUF,233,IENTRY,6) CALL MAKENT(IENTRY,6,CURIN0,0) I=1 GOTO 10209 10207 I=I+(1) 10209 IF((I.GT.6))GOTO 10208 CALL PRINT(TEXTFD,AAABP0,IENTRY(1,I)) GOTO 10207 10208 CONTINUE 10210 IF((GETLIN(BUF,ENTFD).EQ.-1))GOTO 10211 CALL PRINT(TEXTFD,AAABQ0,236,BUF) GOTO 10210 10211 CALL PRINT(TEXTFD,AAABR0,250) CALL CLOSE(ENTFD) CALL CLOSE(TEXTFD) CALL UNLOCK CALL PRINT(-11,AAABS0,LE) RETURN END SUBROUTINE SUBPN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER PENTRY(102,7),BUF(102) INTEGER L,I,LE INTEGER GETENT,GETLIN,CTOI INTEGER ENTFD,TEXTFD,NPNFD INTEGER OPEN,CREATE INTEGER * 4 MARKF INTEGER AAABT0(5) INTEGER AAABU0(5) INTEGER AAABV0(5) INTEGER AAABW0(5) DATA AAABT0/170,243,170,238,0/ DATA AAABU0/170,243,170,238,0/ DATA AAABV0/170,227,170,238,0/ DATA AAABW0/170,233,170,238,0/ IF((PERMI0(10).NE.238))GOTO 10212 CALL ERRMSG('You are not permitted to send personal notes.') RETURN 10212 CALL INIENT(PENTRY,7) CALL ASK('Addressee: .',BUF) IF((BUF(1).NE.0))GOTO 10213 RETURN 10213 CALL PUTKEY(PENTRY,BUF) IF((GETENT(PENTRY,1,MULFI0,1).NE.-1))GOTO 10214 CALL ERRMSG('That name does not correspond to a Moot user.') RETURN 10214 CALL PUTDAT(BUF,240,PENTRY,7) ENTFD=OPEN(ENTFI0,1) IF((ENTFD.NE.-3))GOTO 10215 CALL ERRMSG('No entry has been made.') RETURN 10215 CALL LOCK NPNFD=OPEN(NPNFI0,3) IF((NPNFD.NE.-3))GOTO 10216 CALL UNLOCK CALL ERROR('Personal note key file is unavailable.') 10216 L=GETLIN(BUF,NPNFD) I=1 LE=CTOI(BUF,I)+1 CALL ITOC0F(LE,BUF,5) CALL REWIND(NPNFD) CALL PRINT(NPNFD,AAABT0,BUF) CALL CLOSE(NPNFD) CALL PUTKEY(PENTRY,BUF) TEXTFD=OPEN(PNTFI0,3) IF((TEXTFD.NE.-3))GOTO 10217 CALL UNLOCK CALL ERROR('Fatal error --- cannot open text file.') 10217 CALL WIND(TEXTFD) CALL PUTDAT(USERA0,234,PENTRY,7) L=GETLIN(BUF,ENTFD) CALL PUTDAT(BUF,235,PENTRY,7) L=GETLIN(BUF,ENTFD) CALL PUTDAT(BUF,237,PENTRY,7) CALL GETTIM(BUF) CALL PUTDAT(BUF,228,PENTRY,7) CALL FMTOC(MARKF(TEXTFD),BUF) CALL PUTDAT(BUF,233,PENTRY,7) CALL MAKENT(PENTRY,7,PNIFI0,0) L=1 GOTO 10220 10218 L=L+(1) 10220 IF((L.GT.7))GOTO 10219 CALL PRINT(TEXTFD,AAABU0,PENTRY(1,L)) GOTO 10218 10219 BUF(1)=236 10221 IF((GETLIN(BUF(2),ENTFD).EQ.-1))GOTO 10222 CALL PUTLIN(BUF,TEXTFD) GOTO 10221 10222 CALL PRINT(TEXTFD,AAABV0,250) CALL CLOSE(TEXTFD) CALL UNLOCK CALL PRINT(-11,AAABW0,LE) CALL CLOSE(ENTFD) RETURN END SUBROUTINE UPDCEN INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER BUF(102) INTEGER GETENT IF((.NOT.JOINE0))GOTO 10223 CALL GETTIM(BUF) CALL PUTDAT(BUF,228,CONEN0,4) CALL UPDENT(CONEN0,4,CURUL0,1) JOINE0=.FALSE. 10223 RETURN END SUBROUTINE DELENT(KEY,FNAME,LOCKIT) INTEGER KEY(102),FNAME(102) INTEGER LOCKIT INTEGER SRC,DST INTEGER OPEN,CREATE INTEGER SCRAT(102),BUF(102) INTEGER L INTEGER GETLIN LOGICAL EQUNAM CALL SCRATF(SCRAT,102) IF((LOCKIT.NE.1))GOTO 10224 CALL LOCK 10224 SRC=OPEN(FNAME,1) IF((SRC.NE.-3))GOTO 10225 CALL PUTLIN(FNAME,-15) CALL ERRMSG(': can''t open.') IF((LOCKIT.NE.1))GOTO 10226 CALL UNLOCK 10226 RETURN 10225 DST=CREATE(SCRAT,3) IF((DST.NE.-3))GOTO 10227 CALL CLOSE(SRC) CALL ERRMSG('can''t open scratch file for deletion.') IF((LOCKIT.NE.1))GOTO 10228 CALL UNLOCK 10228 RETURN 10227 CONTINUE 10229 L=GETLIN(BUF,SRC) IF((L.NE.-1))GOTO 10230 CALL CLOSE(SRC) CALL CLOSE(DST) CALL REMOVE(SCRAT) IF((LOCKIT.NE.1))GOTO 10231 CALL UNLOCK 10231 RETURN 10230 IF((BUF(1).NE.225))GOTO 10232 IF((.NOT.EQUNAM(KEY,BUF(2))))GOTO 10233 10234 L=GETLIN(BUF,SRC) IF((L.NE.-1))GOTO 10235 GOTO 10236 10235 CONTINUE IF((BUF(1).NE.225))GOTO 10234 CALL PUTLIN(BUF,DST) CALL FCOPY(SRC,DST) GOTO 10236 10233 CONTINUE 10232 CALL PUTLIN(BUF,DST) GOTO 10229 10236 CALL CLOSE(SRC) CALL REMOVE(FNAME) CALL CLOSE(DST) CALL RENAME(SCRAT,FNAME) IF((LOCKIT.NE.1))GOTO 10237 CALL UNLOCK 10237 RETURN END SUBROUTINE GETDAT(DATUM,FLAG,ENTRY,SIZE) INTEGER DATUM(1),FLAG INTEGER SIZE INTEGER ENTRY(102,SIZE) INTEGER I DATUM(1)=0 I=2 GOTO 10240 10238 I=I+(1) 10240 IF((I.GT.SIZE))GOTO 10239 IF((ENTRY(1,I).NE.FLAG))GOTO 10241 CALL SCOPY(ENTRY(2,I),1,DATUM,1) RETURN 10241 GOTO 10238 10239 RETURN END INTEGER FUNCTION GETENT(ENTRY,SIZE,FNAME,LOCKIT) INTEGER SIZE,LOCKIT INTEGER ENTRY(102,SIZE),FNAME(1) INTEGER FD INTEGER OPEN INTEGER LINE(102) INTEGER L,ACTSIZ INTEGER GETLIN LOGICAL EQUNAM IF((LOCKIT.NE.1))GOTO 10242 CALL LOCK 10242 FD=OPEN(FNAME,1) IF((FD.NE.-3))GOTO 10243 CALL PUTLIN(FNAME,-15) CALL ERRMSG(': can''t open.') GETENT=-1 IF((LOCKIT.NE.1))GOTO 10244 CALL UNLOCK 10244 RETURN 10243 CONTINUE 10245 CONTINUE 10246 L=GETLIN(LINE,FD) IF((L.NE.-1))GOTO 10247 GETENT=-1 CALL CLOSE(FD) IF((LOCKIT.NE.1))GOTO 10248 CALL UNLOCK 10248 RETURN 10247 CONTINUE IF((LINE(1).NE.225))GOTO 10246 LINE(L)=0 IF((.NOT.EQUNAM(ENTRY(2,1),LINE(2))))GOTO 10245 CALL SCOPY(LINE,1,ENTRY(1,1),1) ACTSIZ=2 GOTO 10251 10249 ACTSIZ=ACTSIZ+(1) 10251 IF((ACTSIZ.GT.SIZE))GOTO 10250 L=GETLIN(ENTRY(1,ACTSIZ),FD) IF((L.NE.-1))GOTO 10252 GOTO 10250 10252 ENTRY(L,ACTSIZ)=0 GOTO 10249 10250 GETENT=ACTSIZ-1 CALL CLOSE(FD) IF((LOCKIT.NE.1))GOTO 10253 CALL UNLOCK 10253 RETURN END SUBROUTINE GETKEY(ENTRY,KEY) INTEGER ENTRY(102,1),KEY(102) CALL SCOPY(ENTRY(2,1),1,KEY,1) RETURN END SUBROUTINE INIENT(ENTRY,SIZE) INTEGER SIZE INTEGER ENTRY(102,SIZE) INTEGER I I=1 GOTO 10256 10254 I=I+(1) 10256 IF((I.GT.SIZE))GOTO 10255 ENTRY(1,I)=176 ENTRY(2,I)=0 GOTO 10254 10255 ENTRY(1,1)=225 RETURN END SUBROUTINE LOCK INTEGER CODE CALL SEM$WT(1,CODE) IF((CODE.EQ.0))GOTO 10257 CALL ERROR('fatal error --- mutual exclusion failure.') 10257 RETURN END SUBROUTINE MAKENT(ENTRY,SIZE,FNAME,LOCKIT) INTEGER SIZE,LOCKIT INTEGER ENTRY(102,SIZE),FNAME(102) INTEGER FD INTEGER OPEN INTEGER I INTEGER AAABX0(5) DATA AAABX0/170,243,170,238,0/ IF((LOCKIT.NE.1))GOTO 10258 CALL LOCK 10258 FD=OPEN(FNAME,3) IF((FD.NE.-3))GOTO 10259 CALL UNLOCK CALL PUTLIN(FNAME,-15) CALL ERROR(': can''t open for update.') GOTO 10260 10259 CALL WIND(FD) I=1 GOTO 10263 10261 I=I+(1) 10263 IF((I.GT.SIZE))GOTO 10262 CALL PRINT(FD,AAABX0,ENTRY(1,I)) GOTO 10261 10262 CALL CLOSE(FD) 10260 IF((LOCKIT.NE.1))GOTO 10264 CALL UNLOCK 10264 RETURN END SUBROUTINE PUTDAT(DATUM,FLAG,ENTRY,SIZE) INTEGER DATUM(1),FLAG INTEGER SIZE INTEGER ENTRY(102,SIZE) INTEGER I,L INTEGER LENGTH I=2 GOTO 10267 10265 I=I+(1) 10267 IF((I.GT.SIZE))GOTO 10266 IF((ENTRY(1,I).EQ.FLAG))GOTO 10269 IF((ENTRY(1,I).EQ.176))GOTO 10269 GOTO 10268 10269 CALL SCOPY(DATUM,1,ENTRY(2,I),1) L=LENGTH(ENTRY(2,I)) IF((ENTRY(L+1,I).NE.138))GOTO 10270 ENTRY(L+1,I)=0 10270 ENTRY(1,I)=FLAG RETURN 10268 GOTO 10265 10266 CALL ERROR('in putdat: datum doesn''t fit in entry.') RETURN END SUBROUTINE PUTKEY(ENTRY,KEY) INTEGER ENTRY(102,1),KEY(102) INTEGER L INTEGER LENGTH ENTRY(1,1)=225 CALL SCOPY(KEY,1,ENTRY(2,1),1) L=LENGTH(ENTRY(2,1)) IF((ENTRY(L+1,1).NE.138))GOTO 10271 ENTRY(L+1,1)=0 10271 RETURN END SUBROUTINE UNLOCK INTEGER CODE CALL SEM$NF(1,CODE) IF((CODE.EQ.0))GOTO 10272 CALL ERROR('fatal error --- mutual exclusion failure.') 10272 RETURN END SUBROUTINE UPDENT(ENTRY,SIZE,FNAME,LOCKIT) INTEGER SIZE,LOCKIT INTEGER ENTRY(102,SIZE),FNAME(1) INTEGER SRC,DST INTEGER OPEN,CREATE INTEGER SCRAT(102),BUF(102) INTEGER L,I INTEGER GETLIN,LENGTH LOGICAL EQUNAM INTEGER AAABY0(5) INTEGER AAABZ0(5) DATA AAABY0/170,243,170,238,0/ DATA AAABZ0/170,243,170,238,0/ CALL SCRATF(SCRAT,102) DST=CREATE(SCRAT,3) IF((DST.NE.-3))GOTO 10273 CALL ERROR('can''t open scratch file for update.') 10273 IF((LOCKIT.NE.1))GOTO 10274 CALL LOCK 10274 SRC=OPEN(FNAME,3) IF((SRC.NE.-3))GOTO 10275 CALL UNLOCK CALL CLOSE(DST) CALL REMOVE(SCRAT) CALL PUTLIN(FNAME,-15) CALL ERROR(': can''t open.') 10275 I=1 GOTO 10278 10276 I=I+(1) 10278 IF((I.GT.SIZE))GOTO 10277 CALL PRINT(DST,AAABY0,ENTRY(1,I)) GOTO 10276 10277 CONTINUE 10279 L=GETLIN(BUF,SRC) IF((L.NE.-1))GOTO 10280 CALL CLOSE(DST) CALL REMOVE(SCRAT) I=1 GOTO 10283 10281 I=I+(1) 10283 IF((I.GT.SIZE))GOTO 10282 CALL PRINT(SRC,AAABZ0,ENTRY(1,I)) GOTO 10281 10282 CALL CLOSE(SRC) IF((LOCKIT.NE.1))GOTO 10284 CALL UNLOCK 10284 RETURN 10280 IF((BUF(1).NE.225))GOTO 10285 IF((.NOT.EQUNAM(ENTRY(2,1),BUF(2))))GOTO 10286 10287 L=GETLIN(BUF,SRC) IF((L.NE.-1))GOTO 10288 GOTO 10289 10288 CONTINUE IF((BUF(1).NE.225))GOTO 10287 CALL PUTLIN(BUF,DST) CALL FCOPY(SRC,DST) GOTO 10289 10286 CONTINUE 10285 CALL PUTLIN(BUF,DST) GOTO 10279 10289 CALL CLOSE(SRC) CALL REMOVE(FNAME) CALL CLOSE(DST) CALL RENAME(SCRAT,FNAME) IF((LOCKIT.NE.1))GOTO 10290 CALL UNLOCK 10290 RETURN END SUBROUTINE ASK(QUEST,REPLY) INTEGER QUEST(1) INTEGER REPLY(102) INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER I,L INTEGER GETLIN INTEGER AAACA0(3) DATA AAACA0/170,240,0/ 10291 CONTINUE 10292 IF((INBUF0(IBPAA0).NE.160))GOTO 10293 IBPAA0=IBPAA0+(1) GOTO 10292 10293 IF((INBUF0(IBPAA0).NE.0))GOTO 10294 CALL PRINT(-11,AAACA0,QUEST) L=GETLIN(INBUF0,-10) IF((L.NE.-1))GOTO 10295 GOTO 10296 10295 INBUF0(L)=0 IBPAA0=1 10297 IF((INBUF0(IBPAA0).NE.160))GOTO 10298 IBPAA0=IBPAA0+(1) GOTO 10297 10298 CONTINUE 10294 I=1 GOTO 10301 10299 IBPAA0=IBPAA0+(1) 10301 IF(((INBUF0(IBPAA0).EQ.187).OR.(INBUF0(IBPAA0).EQ.0)))GOTO 10300 REPLY(I)=INBUF0(IBPAA0) I=I+(1) GOTO 10299 10300 REPLY(I)=0 IF((INBUF0(IBPAA0).NE.187))GOTO 10302 IBPAA0=IBPAA0+(1) 10302 IF((REPLY(1).NE.191))GOTO 10303 GOTO 10296 10303 GOTO 10304 10296 GOTO 10291 10304 RETURN END INTEGER FUNCTION GETCMD(PROMPT,STRPOS,ALTS) INTEGER PROMPT(1) INTEGER STRPOS(1) INTEGER ALTS(1) INTEGER CLFIL0(102),MULFI0(102),PNIFI0(102),PNTFI0(102),ENTFI0(102 *),NPNFI0(102) COMMON /FILCO0/CLFIL0,MULFI0,PNIFI0,PNTFI0,ENTFI0,NPNFI0 INTEGER USERA0(102),CONNA0(102),CURUL0(102),CURIN0(102),CURTX0(102 *),CUSER0(102,5),CONEN0(102,4),PERMI0(102) COMMON /CUCOM0/USERA0,CONNA0,CURUL0,CURIN0,CURTX0,CUSER0,CONEN0,PE *RMI0 LOGICAL JOINE0 INTEGER INBUF0(102) INTEGER IBPAA0,BROKE0,CMDCN0 COMMON /MISCO0/JOINE0,INBUF0,IBPAA0,BROKE0,CMDCN0 INTEGER CURCH INTEGER I,J,COUNT,VAL,P INTEGER GETLIN LOGICAL EQUNAM INTEGER AAACB0(3) INTEGER AAACC0(39) INTEGER AAACD0(10) INTEGER AAACE0(23) INTEGER AAACF0(35) INTEGER AAACG0(10) DATA AAACB0/170,240,0/ DATA AAACC0/208,236,229,225,243,229,160,229,238,244,229,242,160,23 *9,238,229,160,239,230,160,244,232,229,160,230,239,236,236,239,247, *233,238,231,186,170,238,170,238,0/ DATA AAACD0/160,160,160,160,160,170,243,170,238,0/ DATA AAACE0/213,238,242,229,227,239,231,238,233,250,229,228,160,22 *7,239,237,237,225,238,228,170,238,0/ DATA AAACF0/217,239,245,160,237,245,243,244,160,228,233,230,230,22 *9,242,229,238,244,233,225,244,229,160,226,229,244,247,229,229,238, *170,238,170,238,0/ DATA AAACG0/160,160,160,160,160,170,243,170,238,0/ 10305 CONTINUE 10306 CONTINUE 10307 IF((INBUF0(IBPAA0).NE.160))GOTO 10308 IBPAA0=IBPAA0+(1) GOTO 10307 10308 IF((INBUF0(IBPAA0).NE.0))GOTO 10309 CALL PRINT(-11,AAACB0,PROMPT) I=GETLIN(INBUF0,-10) IF((I.NE.-1))GOTO 10310 GOTO 10311 10310 INBUF0(I)=0 IBPAA0=1 10312 IF((INBUF0(IBPAA0).NE.160))GOTO 10313 IBPAA0=IBPAA0+(1) GOTO 10312 10313 CONTINUE 10309 GOTO 10314 10311 GOTO 10306 10314 P=IBPAA0 10315 CONTINUE 10316 IF((INBUF0(IBPAA0).NE.160))GOTO 10317 IBPAA0=IBPAA0+(1) GOTO 10316 10317 IF((INBUF0(IBPAA0).NE.191))GOTO 10318 IBPAA0=IBPAA0+(1) CALL PRINT(-11,AAACC0) I=2 GOTO 10321 10319 I=I+(1) 10321 IF((I.GT.STRPOS(1)+1))GOTO 10320 J=STRPOS(I) CALL PRINT(-11,AAACD0,ALTS(J+1)) GOTO 10319 10320 CALL PUTCH(138,-11) INBUF0(IBPAA0)=0 GOTO 10322 10318 IF((INBUF0(IBPAA0).NE.0))GOTO 10323 GOTO 10324 10323 IF((INBUF0(IBPAA0).NE.187))GOTO 10325 IBPAA0=IBPAA0+(1) GOTO 10322 10325 CONTINUE 10326 IF(((((INBUF0(IBPAA0).EQ.160).OR.(INBUF0(IBPAA0).EQ.137)).OR.( *INBUF0(IBPAA0).EQ.187)).OR.(INBUF0(IBPAA0).EQ.0)))GOTO 10327 IBPAA0=IBPAA0+(1) GOTO 10326 10327 CURCH=INBUF0(IBPAA0) INBUF0(IBPAA0)=0 COUNT=0 I=2 GOTO 10330 10328 I=I+(1) 10330 IF((I.GT.STRPOS(1)+1))GOTO 10329 J=STRPOS(I) IF((.NOT.EQUNAM(INBUF0(P),ALTS(J+1))))GOTO 10331 VAL=ALTS(J) COUNT=COUNT+(1) 10331 GOTO 10328 10329 IF((COUNT.NE.0))GOTO 10332 CALL PRINT(-11,AAACE0) INBUF0(IBPAA0)=0 GOTO 10322 10332 INBUF0(IBPAA0)=CURCH IF((COUNT.NE.1))GOTO 10333 GETCMD=VAL RETURN 10333 CONTINUE GOTO 10315 10324 CALL PRINT(-11,AAACF0) I=2 GOTO 10336 10334 I=I+(1) 10336 IF((I.GT.STRPOS(1)+1))GOTO 10335 J=STRPOS(I) IF((.NOT.EQUNAM(INBUF0(P),ALTS(J+1))))GOTO 10337 CALL PRINT(-11,AAACG0,ALTS(J+1)) 10337 GOTO 10334 10335 CALL PUTCH(138,-11) INBUF0(IBPAA0)=0 10322 GOTO 10305 END SUBROUTINE GETYN(INX,DEFALT,PROMPT,ARRAY) INTEGER INX INTEGER DEFALT,PROMPT(1),ARRAY(1) INTEGER BUF(102) INTEGER GETLIN INTEGER AAACH0(9) INTEGER AAACI0 INTEGER AAACJ0 DATA AAACH0/170,243,160,168,170,227,169,160,0/ 10338 CALL PRINT(-11,AAACH0,PROMPT,ARRAY(INX)) CALL ASK('.',BUF) AAACI0=BUF(1) GOTO 10339 10340 ARRAY(INX)=249 GOTO 10341 10342 ARRAY(INX)=238 GOTO 10341 10343 ARRAY(INX)=DEFALT GOTO 10341 10344 GOTO 10341 10345 GOTO 10346 10339 IF(AAACI0.EQ.0)GOTO 10344 AAACJ0=AAACI0-190 GOTO(10345,10347,10347,10347,10347,10343),AAACJ0 IF(AAACI0.EQ.206)GOTO 10342 IF(AAACI0.EQ.217)GOTO 10340 IF(AAACI0.EQ.228)GOTO 10343 IF(AAACI0.EQ.238)GOTO 10342 IF(AAACI0.EQ.249)GOTO 10340 10347 CALL ERRMSG('Unacceptable input, please try again.') GOTO 10346 10341 GOTO 10348 10346 GOTO 10338 10348 RETURN END SUBROUTINE CTOFM(STR,FM) INTEGER STR(1) INTEGER * 4 FM INTEGER I INTEGER * 4 CTOL I=1 FM=CTOL(STR,I) RETURN END LOGICAL FUNCTION EQUNAM(ABBREV,NAM) INTEGER ABBREV(1),NAM(1) INTEGER MAPDN INTEGER I,J I=1 J=1 10349 CONTINUE 10350 IF((ABBREV(I).NE.160))GOTO 10351 I=I+(1) GOTO 10350 10351 CONTINUE 10352 IF((NAM(J).NE.160))GOTO 10353 J=J+(1) GOTO 10352 10353 IF((ABBREV(I).NE.0))GOTO 10354 EQUNAM=.TRUE. RETURN 10354 IF((NAM(I).NE.0))GOTO 10355 EQUNAM=.FALSE. RETURN 10355 CONTINUE 10356 IF((MAPDN(ABBREV(I)).NE.MAPDN(NAM(J))))GOTO 10357 IF((ABBREV(I).EQ.160))GOTO 10359 IF((ABBREV(I).EQ.137))GOTO 10359 IF((ABBREV(I).EQ.0))GOTO 10359 GOTO 10358 10359 GOTO 10357 10358 I=I+(1) J=J+(1) GOTO 10356 10357 IF((ABBREV(I).EQ.160))GOTO 10361 IF((ABBREV(I).EQ.137))GOTO 10361 IF((ABBREV(I).EQ.0))GOTO 10361 GOTO 10360 10361 CONTINUE 10362 IF((NAM(J).EQ.160))GOTO 10363 IF((NAM(J).EQ.137))GOTO 10363 IF((NAM(J).EQ.0))GOTO 10363 J=J+(1) GOTO 10362 10363 GOTO 10364 10360 EQUNAM=.FALSE. RETURN 10364 CONTINUE GOTO 10349 END SUBROUTINE FMTOC(FM,BUF) INTEGER * 4 FM INTEGER BUF(102) INTEGER JUNK INTEGER LTOC JUNK=LTOC(FM,BUF,102) RETURN END SUBROUTINE GETTIM(BUF) INTEGER BUF(102) CALL DATE(2,BUF) BUF(9)=160 CALL DATE(1,BUF(10)) RETURN END SUBROUTINE ITOC0F(INT,STR,SIZE) INTEGER INT,SIZE INTEGER STR(SIZE) INTEGER I,L INTEGER ITOC INTEGER LSTR(10) L=ITOC(INT,LSTR,10) I=1 GOTO 10367 10365 I=I+(1) 10367 IF((I.GT.SIZE-L-1))GOTO 10366 STR(I)=176 GOTO 10365 10366 CALL SCOPY(LSTR,1,STR,I) RETURN END SUBROUTINE PWCRYP(PWORD) INTEGER PWORD(102) INTEGER I,L INTEGER LENGTH L=LENGTH(PWORD) I=1 GOTO 10370 10368 I=I+(1) 10370 IF((I.GT.L))GOTO 10369 PWORD(I)=OR(AND(PWORD(I),NOT(PWORD(L))),AND(NOT(PWORD(I)),PWORD( *L))) IF((PWORD(I).GE.160))GOTO 10371 PWORD(I)=PWORD(I)+160 10371 GOTO 10368 10369 RETURN END SUBROUTINE RENAME(OLD,NEW) INTEGER OLD(1),NEW(1) INTEGER FDOLD,FDNEW INTEGER OPEN,CREATE FDOLD=OPEN(OLD,1) IF((FDOLD.NE.-3))GOTO 10372 CALL CANT(OLD) 10372 FDNEW=CREATE(NEW,3) IF((FDNEW.NE.-3))GOTO 10373 CALL CANT(NEW) 10373 CALL FCOPY(FDOLD,FDNEW) CALL CLOSE(FDOLD) CALL CLOSE(FDNEW) CALL REMOVE(OLD) RETURN END SUBROUTINE SCRATF(NAME,MAXLEN) INTEGER MAXLEN INTEGER NAME(MAXLEN) INTEGER PID(102) INTEGER I INTEGER FD INTEGER OPEN INTEGER AAACK0(16) DATA AAACK0/189,244,229,237,240,189,175,237,239,164,170,243,164,17 *0,233,0/ CALL DATE(4,PID) I=1 GOTO 10376 10374 I=I+(1) 10376 IF((I.GT.10))GOTO 10375 CALL ENCODE(NAME,MAXLEN,AAACK0,PID,I) FD=OPEN(NAME,1) IF((FD.NE.-3))GOTO 10377 RETURN 10377 CALL CLOSE(FD) GOTO 10374 10375 CALL ERROR('fatal error --- cannot generate scratch file name.') END C ---- Long Name Map ---- C Pnifil pnifi0 C Entfil entfi0 C Curul curul0 C numconfs numco0 C Npnfil npnfi0 C Conent conen0 C lastentered laste0 C Miscom misco0 C Mulfil mulfi0 C Clfil clfil0 C Pntfil pntfi0 C editbuffer editb0 C usagemessage usage0 C Permit permi0 C checkforactivity check0 C Broke broke0 C Inbuf inbuf0 C Ibp ibpaa0 C User usera0 C Curinx curin0 C Cucom cucom0 C Cuser cuser0 C Joined joine0 C Cmdcnt cmdcn0 C Filcom filco0 C Connam conna0 C username usern0 C Curtxt curtx0