COMMON /MAICOM/ ENTRY BYTE ENTRY(14,40) BYTE LINE(80),LINE2(80),HEADER(80),SUBJEC(80) BYTE USRNAM(80),USRTMP(80) BYTE FILNAM(40),FILN2(40),MBNAME(40) BYTE MYNAME(20) BYTE TAB BYTE USRRET(14),FORWAR(14) BYTE BUIC(2),BTEMP c BYTE REPLY,QUERY BYTE REPLY,QUERY,gnull,gnorp c added cause f4p won't take a null string '' and to keep even byte INTEGER UIC INTEGER MAXLIN LOGICAL*1 EOMAIL,VALID,EQUAL,TMPLET,NONAME,FOUND,NEWBOX,KTAB EQUIVALENCE (UIC,BUIC) DATA QUERY /'?'/ DATA TAB /"11/ DATA MAXLIN /80/ DATA NENTRY /40/ !NUMBER OF ENTRIES IN MAICOM DATA NEWMAI /14/ !BYTE FLAGGING NEW MAIL IN MAICOM NEWBOX = .FALSE. c make sure the null byte is really null gnull=0 CALL WHOME (MYNAME) D CALL DEBUG ('MYNAME',MYNAME,0) D GOTO 9950 CALL ERRSET(29,,,,.FALSE.) D9950 CONTINUE ASSIGN 32757 TO I32758 GO TO 32758 32757 CONTINUE c IF (EQUAL(USRNAM,'')) PROMPT-FOR-USER-NAMES IF(.NOT.(EQUAL(USRNAM,gnull))) GO TO 32756 ASSIGN 32754 TO I32755 GO TO 32755 32754 CONTINUE 32756 LENUSR=LENGTH(USRNAM) IF(.NOT.(EQUAL(USRNAM,'ME'))) GO TO 32752 ASSIGN 32750 TO I32751 GO TO 32751 32750 GO TO 32753 32752 IF(.NOT.(EQUAL(USRNAM,'?'))) GO TO 32749 ASSIGN 32747 TO I32748 GO TO 32748 32747 GO TO 32753 32749 ASSIGN 32745 TO I32746 GO TO 32746 32745 CONTINUE 32753 CALL EXIT 32744 CONTINUE IF(.NOT.(LENGTH(FILNAM).GT.0)) GO TO 32743 WRITE (5,20) 20 FORMAT (' Use your user name, not "ME", to mail ', 1 'yourself a letter.') CALL EXIT 32743 GO TO I32744 32742 CONTINUE D CALL DEBUG ('OLD','SD0:[1,100]WHODID.LST',3) OPEN (UNIT=3,NAME='SD0:[1,100]WHODID.LST',TYPE='OLD',READONLY) C Truncate possible spaces on end of username DO 32741 I=1,12 32741 IF(USRNAM(I).EQ.32) USRNAM(I)=0 GO TO 32739 32740 IF(EQUAL(USRRET,USRNAM) .OR. LENGTH(USRRET).LE.1) GO TO 32738 32739 READ (3,11) L,LINE2 LINE2(L+1) = 0 C clear possible forwarding name DO 444 I=1,14 444 FORWAR(I)=0 DO 32737 I=1,L IF (LINE2(I).EQ.']') LINE2(I) = ',' 32737 CONTINUE C If a regular name, decode first part of line IF (L.LT.26) DECODE (L,44,LINE2) USRRET,BUIC 44 FORMAT (14A1,3X,O3,1X,O3) C If a forwarding name is there, decode it also IF (L.GE.26) DECODE (L,45,LINE2) USRRET,BUIC,FORWAR,BUIC 45 FORMAT (14A1,3X,O3,1X,O3,1X,14A1,3X,O3,1X,O3) DO 32736 I=1,14 IF(USRRET(I).EQ.' ') USRRET(I)=0 32736 IF(FORWAR(I).EQ.' ') FORWAR(I)=0 32735 BTEMP = BUIC(1) BUIC(1) = BUIC(2) BUIC(2) = BTEMP D WRITE(5,9999)USRRET,USRNAM D9999 FORMAT(' |',14A1,'|',80A1,'|') GO TO 32740 32738 NONAME = LENGTH(USRRET).LE.1 CLOSE (UNIT=3) C If a forwarding name exists, change username and tell mailer IF(FORWAR(1).EQ.0) GOTO 565 WRITE (5,553) USRRET,FORWAR 553 FORMAT(/' ',14A1,'''s mail is being forwarded to ',14A1/) OLDLEN=LENGTH(USRNAM) NEWLEN=LENGTH(FORWAR) IF(NEWLEN.GT.OLDLEN)GOTO 555 C Simpler case, new name is shorter DO 554 I=1,OLDLEN 554 USRNAM(I)=FORWAR(I) LENUSR=LENGTH(USRNAM) GOTO I32742 c Harder case, new name is longer 555 DO 556 I=1,80 556 USRTMP(I)=USRNAM(I) DO 557 I=1,NEWLEN 557 USRNAM(I)=FORWAR(I) DO 558 I=OLDLEN+1,(80+OLDLEN-NEWLEN) 558 USRNAM(I+NEWLEN-OLDLEN)=USRTMP(I) LENUSR=NEWLEN ICOM=LENUSR 565 GO TO I32742 32734 CONTINUE WRITE (3,29) (HEADER(I),I=1,LENGTH(HEADER)-1) C If TMPLET is true, we read the letter from the keyboard. If false it c came from a file. In that case, prompt for subj etc IF(TMPLET) GOTO 32733 C But don't promt for subject more than once if doing multiple sends IF(SUBJEC(1).NE.0) GOTO 3549 WRITE (5,35) READ (5,11,END=7777) L,SUBJEC SUBJEC(L+1) = 0 3549 WRITE (3,3550) (USRNAM(I),I=1,60) 3550 FORMAT(' To: ',80A1) WRITE (3,3551) (SUBJEC(I),I=1,LENGTH(SUBJEC)-1) 3551 FORMAT(' Subj: ',80A1) WRITE (3,3552) 3552 FORMAT(' ') 32733 IF(.NOT.(.TRUE.)) GO TO 32732 D CALL ERRSNS READ (2,29,END=123,ERR=1000) LINE2 LINE2(80) = 0 CALL TRUNC(LINE2) WRITE (3,291) TAB,(LINE2(I),I=1,LENGTH(LINE2)-1) 291 FORMAT (81A1) GO TO 32733 32732 CONTINUE 123 CONTINUE CLOSE (UNIT=3) CALL WFOWN(0) CALL WDFFP(-1) GO TO I32734 32731 CONTINUE CALL ASNLUN (3,'SD',0) IF(.NOT.(.NOT.NEWBOX)) GO TO 32729 CALL WDFFP(0) D CALL ERRSNS D CALL DEBUG ('NEW',MBNAME,3) OPEN (UNIT=3,NAME=MBNAME,ACCESS='SEQUENTIAL',ERR=112, 1 TYPE='NEW',CARRIAGECONTROL='LIST') NEWBOX = .TRUE. GO TO 32730 32729 CONTINUE D CALL ERRSNS D CALL DEBUG ('OLD',MBNAME,3) OPEN (UNIT=3,NAME=MBNAME,ACCESS='SEQUENTIAL',ERR=113, 1 TYPE='OLD',CARRIAGECONTROL='LIST') CALL FEOF(3) 32730 ASSIGN 32727 TO I32728 KTAB=.FALSE. GO TO 32728 32727 VALID = .TRUE. CALL WDFFP(-1) GO TO I32731 32726 CONTINUE IF (INDEX(FILNAM,'.').EQ.0) CALL CONCAT (FILNAM,'.MAI') CALL ASNLUN (3,'SY',0) D CALL ERRSNS D CALL DEBUG ('UNK',FILNAM,3) OPEN (UNIT=3,NAME=FILNAM,ACCESS='SEQUENTIAL',ERR=114, 1 TYPE='UNKNOWN',CARRIAGECONTROL='LIST') CALL FEOF(3) ASSIGN 32725 TO I32728 KTAB=.TRUE. GO TO 32728 32725 VALID = .TRUE. GO TO I32726 32724 CONTINUE CALL MVSTR(FILNAM,'LETTER.TMP') CALL ASNLUN (2,'SY',0) D CALL DEBUG ('NEW',FILNAM,2) OPEN (UNIT=2,NAME=FILNAM,TYPE='NEW',CARRIAGECONTROL='LIST') IF(SUBJEC(1).NE.0) GOTO 349 WRITE (5,35) 35 FORMAT (/'$Subject ? ') READ (5,11,END=7777) L,SUBJEC SUBJEC(L+1) = 0 349 WRITE (2,350) (USRNAM(I),I=1,60) 350 FORMAT('To: ',80A1) WRITE (2,351) (SUBJEC(I),I=1,LENGTH(SUBJEC)-1) 351 FORMAT('Subj: ',80A1) WRITE (2,352) 352 FORMAT(' ') WRITE (5,36) 36 FORMAT (/' Terminate your letter by typing on a ', 1 'line by itself.') READ (5,11,END=380) L,LINE2 LINE2(L+1) = 0 32723 IF(.NOT.(.TRUE.)) GO TO 32722 WRITE (2,29) (LINE2(I),I=1,LENGTH(LINE2)-1) READ (5,11,END=380) L,LINE2 LINE2(L+1) = 0 GO TO 32723 32722 CONTINUE 380 CONTINUE CLOSE (UNIT=5) CLOSE (UNIT=2) GO TO I32724 32721 CONTINUE GO TO 32719 32720 IF(VALID) GO TO 32718 32719 WRITE (5,31) 31 FORMAT ('$Filename to save letter to (^Z or "TRASH" to delete) ') READ (5,11,END=333) L,FILNAM FILNAM(L+1) = 0 IF (L.GT.0) CALL UCASE(FILNAM) IF(.NOT.(L.EQ.0)) GO TO 32716 ASSIGN 32715 TO I32731 GO TO 32731 32715 GO TO 32717 32716 IF(.NOT.(EQUAL(FILNAM,'TRASH'))) GO TO 32714 VALID = .TRUE. GO TO 32717 333 CLOSE (UNIT=5) FILNAM(1)=0 VALID = .TRUE. GOTO 32717 32714 ASSIGN 32713 TO I32726 GO TO 32726 32713 CONTINUE 32717 IF(.NOT.(.FALSE.)) GO TO 32712 112 CONTINUE D IERR = 112 D GOTO 120 113 CONTINUE D IERR = 113 D GOTO 120 114 CONTINUE D IERR = 114 D120 WRITE (5,9960) IERR,IERR1,IERR2,IERR3,IERR4 VALID = .FALSE. 32712 GO TO 32720 32718 CLOSE (UNIT=2,DISPOSE='DELETE') GO TO I32721 32728 CONTINUE c If ktab is true, we are writing to save file, do first line c special write with "FROM: ", then drop leading tab IF(KTAB.EQ.(.FALSE.)) GOTO 2710 READ (2,11,ERR=1001,END=110) L,LINE2 LINE2(L+1) = 0 WRITE (3,299) (LINE2(I),I=1,LENGTH(LINE2)-1) 2710 VALID=.TRUE. c32711 IF(.NOT.(.TRUE.)) GO TO 32710 32711 continue D CALL ERRSNS READ (2,11,ERR=1001,END=110) L,LINE2 LINE2(L+1) = 0 IF(KTAB.EQ.(.FALSE.)) WRITE (3,29)(LINE2(I),I=1,LENGTH(LINE2)-1) IF(KTAB.EQ.(.TRUE.)) WRITE (3,29)(LINE2(I),I=2,LENGTH(LINE2)-1) GO TO 32711 32710 CONTINUE 110 CLOSE (UNIT=3) GO TO I32728 32709 CONTINUE DO 32708 I=1,80 HEADER(I) = 0 32708 CONTINUE CALL MVSTR(HEADER,MYNAME) CALL CONCAT(HEADER,': ') CALL DATE (HEADER(LENGTH(HEADER))) CALL TRUNC(HEADER) CALL CONCAT (HEADER,' ') CALL TIME (HEADER(LENGTH(HEADER))) CALL TRUNC (HEADER) D CALL DEBUG ('HEADER',HEADER,0) GO TO I32709 32707 CONTINUE IENTRY = 0 FOUND = .FALSE. 32706 IF(.NOT.(IENTRY .LT. NENTRY )) GO TO 32705 IENTRY = IENTRY+1 D WRITE (5,9999) (ENTRY(L,IENTRY),L=1,12),(USRNAM(L),L=1,12) D9999 FORMAT(' ',12A1,'|',12A1,'|') C cant use equal cause our routine space fills C IF(.NOT.(EQUAL(ENTRY(1,IENTRY),USRNAM))) GO TO 32704 JJ=0 880 JJ=JJ+1 c if done 12 characters, its a match IF (JJ.GT.12) GOTO 895 IF(ENTRY(JJ,IENTRY).EQ.USRNAM(JJ)) GOTO 880 C if first characters don't match, no cigar IF (JJ.EQ.1) GOTO 32704 c after 1st character, space in entry matches null in username IF(ENTRY(JJ,IENTRY).EQ.32.AND.USRNAM(JJ).EQ.0) GOTO 895 c also match on space in both IF(ENTRY(JJ,IENTRY).EQ.32.AND.USRNAM(JJ).EQ.32) GOTO 895 c fell thru, no cigar GOTO 32704 895 FOUND = .TRUE. c show new mail has arrived (at each possible terminal) ENTRY(NEWMAI,IENTRY) = 1 D CALL DEBUG (' NOTIFIED',USRNAM,0) D WRITE (5,9906) ENTRY(13,IENTRY) D9906 FORMAT (' ON TT',O8) 32704 GO TO 32706 32705 WRITE (5,54) (USRNAM(I),I=1,LENGTH(USRNAM)-1) IF(.NOT.(FOUND)) GO TO 32702 WRITE (5,55) GO TO 32703 32702 WRITE (5,56) 32703 CONTINUE 54 FORMAT ('$',80A1) 55 FORMAT ('+ has been notified.') 56 FORMAT ('+ is not logged in but will be notified.') GO TO I32707 32701 CONTINUE IF (INDEX(FILNAM,'.').EQ.0) CALL CONCAT (FILNAM,'.MAI') CALL ASNLUN (2,'SY',0) D CALL DEBUG ('OLD',FILNAM,2) IF(.NOT.(TMPLET)) GO TO 32699 OPEN (UNIT=2,NAME=FILNAM,TYPE='OLD') GO TO 32700 32699 OPEN (UNIT=2,NAME=FILNAM,TYPE='OLD',READONLY) 32700 GO TO I32701 32698 CONTINUE CALL ASNLUN (1,'SD',0) CALL MVSTR (MBNAME(1),'[10,0]') CALL CONCAT (MBNAME,MYNAME) CALL CONCAT (MBNAME,'.MAI') D CALL ERRSNS D CALL DEBUG ('OLD',MBNAME,1) OPEN (UNIT=1,NAME=MBNAME,TYPE='OLD',ERR=101) IF(.NOT.(.FALSE.)) GO TO 32697 101 WRITE (5,102) 102 FORMAT (' Your mailbox is empty.') D CALL ERRSNS (N1,N2,N3,N4) D WRITE (5,9909) N1,N2,N3,N4 D9909 FORMAT (' ERRSNS RETURN:',4I8) CALL EXIT 32697 EOMAIL = .FALSE. ASSIGN 32695 TO I32696 GO TO 32696 32695 GO TO I32698 32694 CONTINUE USRNAM(LENGTH(USRNAM)+1) = 0 ICOM = INDEX(USRNAM,',') IF(.NOT.(ICOM.EQ.0)) GO TO 32692 ICOM = LENGTH(USRNAM) GO TO 32693 32692 USRNAM(ICOM) = 0 32693 CONTINUE D CALL DEBUG ('USRNAM',USRNAM,0) ASSIGN 32691 TO I32742 GO TO 32742 32691 CONTINUE 42 FORMAT (' No such user as ',20A1) IF(.NOT.(NONAME)) GO TO 32689 WRITE (5,42) (USRNAM(I),I=1,LENGTH(USRNAM)-1) GO TO 32690 32689 CALL ASNLUN (3,'SD',0) CALL MVSTR(FILN2,'[10,0]') CALL CONCAT (FILN2,USRNAM) CALL CONCAT (FILN2,'.MAI') CALL WDFFP(0) CALL WFOWN(UIC) D CALL ERRSNS D CALL DEBUG ('UNK',FILN2,3) OPEN (UNIT=3,NAME=FILN2,ACCESS='SEQUENTIAL',ERR=1002, 1 TYPE='UNKNOWN',CARRIAGECONTROL='LIST') CALL FEOF(3) 32690 GO TO I32694 32758 CONTINUE CALL GETMCR(LINE) DO 32688 I=1,MAXLIN IF (LINE(I).EQ."15) LINE(I) = 0 32688 CONTINUE USRNAM(1) = 0 FILNAM(1) = 0 MBNAME(1) = 0 ISP = INDEX(LINE,' ') !NOTE: PDS PUTS SPACE AFTER TASK IF(.NOT.(ISP.GT.0)) GO TO 32687 CALL MVSTR (LINE(1),LINE(ISP+1)) ISP = INDEX(LINE,' ') IF (ISP.GT.0) LINE(ISP) = 0 CALL MVSTR(USRNAM,LINE) 32687 IF (ISP.GT.0) CALL MVSTR(FILNAM,LINE(ISP+1)) D CALL DEBUG('LINE',LINE,0) D CALL DEBUG('USRNAM',USRNAM,0) D CALL DEBUG('FILNAM',FILNAM,0) GO TO I32758 32686 CONTINUE C Clear out subject of memo SUBJEC(1) = 0 WRITE (5,34) 34 FORMAT ('$Name of file to send ( to type letter now): ') READ (5,11,END=7777) L,FILNAM FILNAM(L+1) = 0 CALL UCASE (FILNAM) TMPLET = (LENGTH(FILNAM).LE.1) IF(.NOT.(TMPLET)) GO TO 32685 ASSIGN 32684 TO I32724 GO TO 32724 32684 CONTINUE 32685 GO TO I32686 32755 CONTINUE WRITE (5,10) 10 FORMAT ('$To: ') READ (5,11,END=7777) L,(USRNAM(I),I=1,78) 11 FORMAT (Q,80A1) USRNAM(L+1) = 0 CALL UCASE (USRNAM) GO TO I32755 32696 CONTINUE D CALL ERRSNS READ (1,25,ERR=1003,END=105) LINE 25 FORMAT (80A1) LINE(80) = 0 CALL TRUNC(LINE) IF(.NOT.(.FALSE.)) GO TO 32683 105 EOMAIL = .TRUE. D CALL DEBUG (' EOMAIL','TRUE',0) 32683 GO TO I32696 32751 CONTINUE ASSIGN 32682 TO I32744 GO TO 32744 32682 ASSIGN 32681 TO I32698 GO TO 32698 32681 IF(EOMAIL) GO TO 32680 ASSIGN 32678 TO I32679 GO TO 32679 32678 ASSIGN 32677 TO I32721 GO TO 32721 32677 ASSIGN 32675 TO I32676 GO TO 32676 32675 GO TO 32681 32680 CLOSE (UNIT=1,DISP='DELETE') GO TO I32751 32674 CONTINUE CALL MVSTR (FILN2,USRNAM(2)) IF (INDEX(FILN2,'.').EQ.0) CALL CONCAT (FILN2,'.MLS') CALL ASNLUN (2,'SY',0) D CALL DEBUG ('OLD',FILN2,2) OPEN (UNIT=2,NAME=FILN2,TYPE='OLD',ERR=130) IF(.NOT.(.FALSE.)) GO TO 32673 130 CALL MVSTR (FILN2,'SD0:[10,3]') CALL CONCAT (FILN2,USRNAM(2)) IF (INDEX(FILN2,'.').EQ.0) CALL CONCAT (FILN2,'.MLS') D CALL ERRSNS D CALL DEBUG ('OLD',FILN2,2) OPEN (UNIT=2,NAME=FILN2,TYPE='OLD',ERR=1004) 32673 READ (2,29) USRNAM USRNAM(80) = 0 CALL TRUNC(USRNAM) D CALL DEBUG (' USRNAM',USRNAM,0) CLOSE (UNIT=2) GO TO I32674 32676 CONTINUE FILNAM(1) = 0 WRITE (5,60) (USRNAM(I),I=1,LENGTH(USRNAM)-1),QUERY 60 FORMAT ('$Do you want to reply to',1X,12a1,' ') READ (5,61,END=2672) REPLY 61 FORMAT (A1) IF(.NOT.(REPLY.EQ.'Y' .OR. REPLY.EQ.'y')) GO TO 32672 ASSIGN 32671 TO I32746 GO TO 32746 32671 CONTINUE C Close terminal to clear possible ^z in above read 2672 CLOSE (UNIT=5) 32672 GO TO I32676 32670 CONTINUE 1000 CONTINUE D IERR = 1000 D GOTO 1020 1001 CONTINUE D IERR = 1001 D GOTO 1020 1002 CONTINUE D IERR = 1002 D GOTO 1020 1003 CONTINUE D IERR = 1003 D GOTO 1020 1004 CONTINUE D IERR = 1004 D GOTO 1020 D1020 CALL ERRSNS(IERR1,IERR2,IERR3,IERR4) D WRITE (5,9960) IERR,IERR1,IERR2,IERR3,IERR4 D9960 FORMAT (' ERROR AT ',I5/' RETURN FROM ERRSNS:',4I8) WRITE (5,1200) 1200 FORMAT (' MAIL -- FATAL FILE ERROR') CALL EXIT GO TO I32670 32746 CONTINUE IF(.NOT.(USRNAM(1).EQ.'@')) GO TO 32669 ASSIGN 32668 TO I32674 GO TO 32674 32668 CONTINUE 32669 IF(.NOT.(LENGTH(FILNAM).LE.1)) GO TO 32667 ASSIGN 32666 TO I32686 GO TO 32686 32666 CONTINUE 32667 ASSIGN 32665 TO I32701 GO TO 32701 32665 ASSIGN 32664 TO I32709 GO TO 32709 32664 GO TO 32662 32663 IF(LENGTH(USRNAM).LE.1) GO TO 32661 32662 ASSIGN 32660 TO I32694 GO TO 32694 32660 ASSIGN 32659 TO I32734 GO TO 32734 32659 ASSIGN 32658 TO I32707 GO TO 32707 32658 REWIND 2 CALL MVSTR (USRNAM,USRNAM(ICOM+1)) GO TO 32663 32661 IF(.NOT.(TMPLET)) GO TO 32656 CLOSE (UNIT=2,DISPOSE='DELETE') GO TO 32657 32656 CLOSE (UNIT=2) 32657 GO TO I32746 32748 CONTINUE ASSIGN 32655 TO I32744 GO TO 32744 32655 ASSIGN 32654 TO I32698 GO TO 32698 32654 IF(EOMAIL) GO TO 32653 ASSIGN 32651 TO I32652 GO TO 32652 32651 GO TO 32654 32653 GO TO I32748 32652 CONTINUE IF(.NOT.(LINE(1).EQ.TAB)) GO TO 32650 ASSIGN 32649 TO I32670 GO TO 32670 32649 CONTINUE 32650 WRITE (5,27) (LINE(I),I=1,LENGTH(LINE)-1) 27 FORMAT (/1X,80A1) GO TO 32647 32648 IF(EOMAIL.OR.(LINE(1).NE.TAB)) GO TO 32646 32647 ASSIGN 32645 TO I32696 GO TO 32696 32645 GO TO 32648 32646 GO TO I32652 32679 CONTINUE IF(.NOT.(LINE(1).EQ.TAB)) GO TO 32644 ASSIGN 32643 TO I32670 GO TO 32670 32643 CONTINUE 32644 ISP = INDEX(LINE,':') CALL MVSTR(USRNAM,LINE,ISP) FILNAM(1) = 0 CALL ASNLUN (2,'SY',0) D CALL DEBUG ('NEW','LETTER.TMP',2) OPEN (UNIT=2,NAME='LETTER.TMP',TYPE='NEW',CARRIAGECONTROL='LIST', 1 DISP='DELETE') GO TO 32641 32642 IF(EOMAIL.OR.(LINE(1).NE.TAB)) GO TO 32640 c following 2 writes changed to not write leading tab 32641 IF (LINE(1).EQ.TAB) WRITE (5,28) (LINE(I),I=2,LENGTH(LINE)-1) IF (LINE(1).NE.TAB) WRITE (5,281) (LINE(I),I=1,LENGTH(LINE)-1) IF (LINE(1).NE.TAB) LCOUNT=0 28 FORMAT (1X,80A1) 281 FORMAT (' From: ',80A1) c pause every 22 lines LCOUNT=LCOUNT+1 IF (LCOUNT.LT.22) GOTO 289 WRITE (5,282) 282 FORMAT(/'$Press RETURN for more ...') READ (5,28) REPLY LCOUNT=0 c IF (LINE(1).EQ.TAB) WRITE (2,29) (LIN c IF (LINE(1).NE.TAB) WRITE (2,29) (LINE(I),I=1,LENGTH(LINE)-1) 289 WRITE (2,29) (LINE(I),I=1,LENGTH(LINE)-1) 29 FORMAT (80A1) 299 FORMAT ('From: ',80A1) ASSIGN 32639 TO I32696 GO TO 32696 32639 GO TO 32642 32640 REWIND 2 GO TO I32679 C general exit taken on seeing ^Z from terminal 7777 CALL EXIT END SUBROUTINE WHOME (OUTMSG) BYTE OUTMSG(20) INTEGER USRBUF(160) INTEGER TTTYPE DATA TTTYPE /'TT'/ DATA LUBUF /160/ CALL GETUSR (USRBUF,LUBUF,IER) IF(.NOT.(IER.LT.0)) GO TO 32758 WRITE (5,101) IER 101 FORMAT (' ERROR',I8) STOP 32758 CALL GETLUN (5,OUTMSG) MYTI = OUTMSG(3) D WRITE (5,9901) MYTI D9901 FORMAT (' MY TI: IS ',O8) DO 32757 I=8,LUBUF,8 D WRITE (5,9902) (USRBUF(J),J=I-7,I) D9902 FORMAT (1X,6A2,2X,A2,O2) IF(.NOT.(USRBUF(I-1).EQ.TTTYPE)) GO TO 32756 IF(.NOT.(USRBUF(I).EQ.MYTI)) GO TO 32755 CALL MVSTR(OUTMSG,USRBUF(I-7),10) D CALL DEBUG ('OUTMSG',OUTMSG,0) RETURN 32755 CONTINUE 32756 CONTINUE 32757 CONTINUE WRITE (5,10) MYTI 10 FORMAT (' CANNOT IDENTIFY USER AT TI: ',O8) STOP END SUBROUTINE UCASE(STRING) BYTE STRING(1) L = LENGTH(STRING)-1 IF (L.LE.0) RETURN DO 32758 I=1,L IF (STRING(I).GE.'a'.AND.STRING(I).LE.'z') STRING(I) = 1 STRING(I)-"40 32758 CONTINUE RETURN END SUBROUTINE CONCAT(A,B) BYTE A(1),B(1) CALL MVSTR(A(LENGTH(A)),B) END SUBROUTINE DEBUG(LABEL,STRING,IUNIT) D BYTE LABEL(1),STRING(1) D WRITE (5,9901) IUNIT,(LABEL(I),I=1,LENGTH(LABEL)-1),':',' ', D 1 (STRING(I),I=1,LENGTH(STRING)-1) D9901 FORMAT (1X,I4,1X,80A1/6X,80A1) END