10 SUB MADWAST(LONG P,PC,PSL,R0,R1) ! unsolicited MB write & 20 ! Ruth E. Reebel & ! Copyright (c) 1982 by & ! Amherst Associates Incorporated & ! 210 Old Farm Road & ! Amherst, Massachusetts 01002 & 1000 EXTERNAL LONG FUNCTION SYS$QIO,SYS$QIOW,SYS$WAKE & \ EXTERNAL LONG FUNCTION SYS$CREMBX,SYS$SETPRN,SYS$DASSGN,SYS$CANCEL & \ EXTERNAL LONG FUNCTION SYS$CRELOG,SYS$DELLOG,SYS$TRNLOG & \ EXTERNAL LONG IO$_READVBLK,IO$M_NOW & \ EXTERNAL LONG IO$_WRITEVBLK,IO$M_CANCTRLO & \ DECLARE LONG FUNRD,FUNTTY,SYS_STATUS & \ FUNRD=LOC(IO$_READVBLK) OR LOC(IO$M_NOW) & \ FUNTTY=LOC(IO$_WRITEVBLK) OR LOC(IO$M_CANCTRLO) & 1010 COMMON (A1) MBX.CH%,LOG.CH%,TTY.CH%,CTL.FLG%,BAS.FOR% & \ COMMON (A1) STRING PRCNAMJPI=15%,INFIL=2% & \ PUT.CH%=3% & 1015 L.$=EDIT$(PRCNAMJPI,6%) & \ L.$="L"+RIGHT$(L.$,2%) & \ IF BAS.FOR%=0% THEN S.$=SPACE$(15%) & \ SYS_STATUS=SYS$TRNLOG(L.$,,S.$,,,) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ BAS.FOR%=-2% IF LEFT(S.$,7%)="FORTRAN" & ! if bas.for%=0 then this is a reattach or new user. We need to know & ! if program being run was basic or fortran (for carriage control). & ! The logical LRUTHR0 is present if a FORTRAN prog is being run. & 1020 MAP(IOSB.1) LONG IOSB_L(1),STRING REC_BUFFER=512% & \ MAP(IOSB.1) WORD IOSB_W(3) & 1030 SYS_STATUS=SYS$QIO(,MBX.CH% BY VALUE,FUNRD BY VALUE, & IOSB_L() BY REF,,, & REC_BUFFER BY REF,512% BY VALUE,,,,) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & ! read what was written in MB by detproc & 1040 P$=LEFT$(REC_BUFFER,IOSB_W(1%)) & \ P1$=" " & \ P1$=MID$(P$,IOSB_W(1%)-1%,2%) IF LEN(P$)>1% & ! save last two char for print control (see line 1080) & 1045 MAP (BASFOR) STRING OUTBUF=512% & \ IF LEFT$(P$,13%)=":FORTRAN:CCR:" OR BAS.FOR%=-2% THEN & CLOSE PUT.CH% & \ OPEN "SYS$OUTPUT" AS FILE #PUT.CH%,RECORDTYPE FORTRAN,MAP BASFOR & IF INFIL="TT" & \ OPEN "SYS$OUTPUT" AS FILE #PUT.CH%,RECORDTYPE ANY,MAP BASFOR & IF INFIL<>"TT" & \ SYS_STATUS=SYS$CRELOG(1% BY VALUE,L.$,"FORTRAN",) & IF BAS.FOR%<>-2% & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & IF BAS.FOR%<>-2% & \ BAS.FOR%=-1% & \ GOTO 1090 & 1047 IF LEFT$(P$,11%)=":BASIC:CCR:" OR BAS.FOR%=0% THEN & CLOSE PUT.CH% & \ OPEN "SYS$OUTPUT" AS FILE #PUT.CH%,MAP BASFOR, & RECORDTYPE ANY IF INFIL<>"TT" & \ OPEN "SYS$OUTPUT" AS FILE #PUT.CH%,MAP BASFOR & IF INFIL="TT" & \ SYS_STATUS=SYS$DELLOG(1% BY VALUE,L.$,) IF BAS.FOR%<0% & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & IF BAS.FOR%<0% & \ BAS.FOR%=1% & \ GOTO 1090 & 1048 IF LEFT(P$,11%)=":TERM:CHAR:" THEN & CALL TERMCHAR ! change terminal characteristics & \ GOTO 1090 & 1049 GOTO 1065 IF LEN(P$)<2% & \ P2$=LEFT$(P$,2%) & \ P2$=MID$(P$,2%,2%) IF BAS.FOR%=-1% & 1050 IF LEN(P$)>2% AND ASCII(P2$)=32% AND ASCII(MID$(P2$,2%,1%))=8% THEN & P$=RIGHT$(P$,3%) IF BAS.FOR%=1% & \ P$=LEFT$(P$,1%)+RIGHT$(P$,4%) IF BAS.FOR%=-1% & \ CTL.FLG%=1% & \ GOTO 1080 & ! special print via FNQUES (see line 1040 in MADRAST) & 1060 IF MID$(P$,1%,2%)="1"+CHR$(15%) OR P1$=CHR$(32%)+CHR$(8%) & OR (BAS.FOR%=-1% AND ASCII(P$)=36%) THEN & SYS_STATUS=SYS$QIOW(,TTY.CH% BY VALUE,FUNTTY BY VALUE,,,, & ,,,,,) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ GOTO 1090 IF MID$(P$,1%,2%)="1"+CHR$(15%) & ! terminal control command for CTRL O catch & ! "1"+chr$(15%) = applicatn prg cancels ctrl o & ! the other two cancel ctrl o at an input question & ! for basic or fortran & 1065 GOTO 1070 IF ASCII(P$)<>2% & ! following lines only relate to BIG BROTHER: our watching program & \ SYS_STATUS=SYS$CANCEL(MBX.CH% BY VALUE) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ PRCNAM$=EDIT$(PRCNAMJPI,6%) & \ PRTNAM$=RIGHT$(PRCNAM$,2%) & \ WEEP$=RIGHT$(P$,2%) & \ IF ASCII(WEEP$)=0% THEN & PRCNAM$="W"+PRTNAM$ & 1067 SYS_STATUS=SYS$SETPRN(PRCNAM$ BY DESC) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ SYS_STATUS=SYS$DASSGN(MBX.CH% BY VALUE) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ MBX.CH%=0% & \ SYS_STATUS=SYS$CREMBX(,MBX.CH%,,,,,PRCNAM$ BY DESC) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & 1069 LSET REC_BUFFER="MAILBOX SWITCH COMPLETED." & \ IOSB_W(1%)=25% !length of above & \ SYS_STATUS=SYS$QIOW(,MBX.CH% BY VALUE,IO$_WRITEVBLK,,,, & REC_BUFFER BY REF,IOSB_W(1%) BY VALUE,,,,) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ CALL MASETDR & \ GOTO 1090 & 1070 CTL.FLG%=-1% IF P$=":BYE: MENU" & \ CTL.FLG%=-2% IF P$=":ATT: MENU" & \ IF CTL.FLG%<0% THEN & SYS_STATUS=SYS$WAKE(,) & \ CALL SYS$EXIT(SYS_STATUS BY VALUE) IF (SYS_STATUS AND 1%)=0% & \ GOTO 1090 & ! if user is done with this process, MAINUP must be awakened & 1079 GOTO 1090 IF P$=" PREVIOUS LOGICAL NAME ASSIGNMENT REPLACED" & ! boy, this is dumb (but it works) & 1080 GOTO 1085 IF BAS.FOR%=-1% & \ IF ASCII(P1$)=32 AND ASCII(MID$(P1$,2%,1%))=8% THEN & P$=LEFT$(P$,LEN(P$)-2%) & ! above handles input with prompt (eg INPUT "CENTER";C$) & ! (CHR$(32)+CHR$(8) added to end) & ELSE P$=P$+CHR$(13%)+CHR$(10%) & IF INFIL="TT" & ! print to tty (p.s. 32=SP; 8=BS) & 1085 C%=LEN(P$) & \ LSET OUTBUF=P$ & \ PUT #PUT.CH%,COUNT C% & 1090 CALL MASETDW & ! reset mailbox write attention AST & 32767 SUBEND