! File: NEWIO2.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. MODULE HIIO(TIMER=EXTERNAL(SIX12))= BEGIN SWITCHES NOLIST; REQUIRE COMMON.BEG; REQUIRE IOMACS.BEG; REQUIRE IO.BEG; SWITCHES LIST; BEGIN MACRO CASEX(A)=(A; NOVALUE)$, TENOR11(TEN,ELEVEN)=(ELEVEN; NOVALUE)$; BIND DEVCHR=4, ! FOR CALLI CMUDEC=-2; ! FOR CALLI BIND ERR1M=MSG(Illegal Switch - ), ERR2M=MSG(Illegal Character - ), ERR4M=MSG(Command Error), ERR5M=MSG(LOOKUP/ENTER Failure - ), PPNERRM=MSG(Invalid PPN), CRLFSTR=MSG(?M?J); MACRO NEXTCHAR=(CCHAR_SCANI(BUFDATA[0,BYTEPF]))$, ABORTCMD=TTYMES(CRLFSTR); CMDERR_1$, INRANGE(A,X,Y)=(A GEQ X AND A LEQ Y) $; MACRO IMAGEMF=8,1$, ! DEVICE CAN DO IMAGE MODE ASCIIMF=1,1$, ! DEVICE CAN DO ASCII MODE TTYDEVF=21,1$, ! DEVICE IS A TTY SWTBIT=FLAGS<0,1>$, ! TRUE --> IN SWITCH MODE INFOBIT=FLAGS<1,1>$, ! TRUE --> SOMETHING SEEN NAMEBIT=FLAGS<2,1>$, ! TRUE ==> FILENAME SEEN DEVBIT=FLAGS<3,1>$, ! TRUE ==> EXPLICIT DEVICE SEEN EXTBIT=FLAGS<4,1>$, ! TRUE ==> EXPLICIT EXTENSION GIVEN NDEBITS=FLAGS<2,3>$, ! NON ZERO IF A FILE SEEN ENDBIT=FLAGS<5,1>$, ! TRUE ==> END OF CMD STRING SEEN ARWBIT=FLAGS<6,1>$, ! TRUE ==> LEFT ARROW (OR =) SEEN SLSHBIT=FLAGS<7,1>$, ! TRUE ==> ENTERED SWITCH MODE WITH SLASH UNBIT=FLAGS<8,1>$; ! TRUE ==> IN COMPLEMENT SWITCH MODE MACRO PACK4(A,B,C,D,E,F,G,H)=#H^28 OR #G^24 OR #F^20 OR #E^16 OR #D^12 OR #C^8 OR #B^4 OR #A$; BIND CTTAB=PLIT( PACK4(17,00,00,00,00,00,00,00), PACK4(17,17,12,17,17,12,00,00), PACK4(00,00,00,00,00,00,00,00), PACK4(00,00,12,12,00,00,00,00), PACK4(17,14,17,00,00,00,00,00), PACK4(05,03,00,00,11,04,07,13), PACK4(02,02,02,02,02,02,02,02), PACK4(02,02,06,00,00,10,00,00), PACK4(15,01,01,01,01,01,01,01), PACK4(01,01,01,01,01,01,01,01), PACK4(01,01,01,01,01,01,01,01), PACK4(01,01,01,16,00,00,00,10), PACK4(00,01,01,01,01,01,01,01), PACK4(01,01,01,01,01,01,01,01), PACK4(01,01,01,01,01,01,01,01), PACK4(01,01,01,00,00,12,00,17) ); STRUCTURE CTYPSTR[I]=(.CTYPSTR+.I^(-3))<(.I AND #7)*4,4>; MAP CTYPSTR CTTAB; EXTERNAL OPN, RLS, FILESELECT; ROUTINE GETCMD= BEGIN MACHOP TTCALL=#51, INPUT=#66, RELEASE=#71; IF ABS(.TTYDIR) EQL 2 THEN BEGIN LOCAL L; L_.BUFDATA[0,BYTEPF]; IF SCANI(L) EQL 0 THEN IF .TTYDIR LSS 0 THEN CALLI(0,#12) ELSE TTYDIR_1 ELSE RETURN; END; OPN(0,SIXBIT 'TTY',1,1); BUFDATA[0,FILENAMEF]_SIXBIT 'BLISS'; BUFDATA[0,EXTF]_SIXBIT "TTI"; BUFDATA[0,PPNF]_0; IF NOT LKUP(0) THEN (TTCALL(3,PLIT (ASCIZ 'CANNOT FIND BLISS.TTI???M?J')); CALLI(0,#12)); INPUT(0,0); RELEASE(0,0); 1 END; ! OF GETCMD ROUTINE TTYSIX(WORD)= BEGIN REGISTER C; LOCAL PTR; PTR_WORD<36,6>; DECR I FROM 5 TO 0 DO IF (C_SCANI(PTR)) EQL 0 THEN EXITLOOP ELSE TTYLIST(C_.C+#40); END; ! OF TTYSIX ROUTINE CCLMES= BEGIN TTYMES(IF BLIS11 THEN MSG(BLIS11:?I) ELSE MSG(BLIS10:?I)); TTYSIX(.BUFDATA[SRCCHN,FILENAMEF]); TTYLIST("."); TTYSIX(.BUFDATA[SRCCHN,EXTF]^18); TTYMES(CRLFSTR) END; ! OF CCLMES BIND IMAGEMODE=#10, ASCILINEMODE=1; ROUTINE OPNTTY= BEGIN ! OPEN TTY FOR OUTPUT ON CHANNEL TTYCHN MACHOP OUTPUT=#67; IF .TTYDIR LSS 0 THEN CALLI(0,#12); OPN(TTYCHN,SIXBIT 'TTY',ASCILINEMODE,1^18); BUFDATA[TTYCHN,FILENAMEF]_SIXBIT 'BLISS'; BUFDATA[TTYCHN,EXTF]_SIXBIT "TTO"; NTR(TTYCHN); OUTPUT(TTYCHN,0); NOVALUE END; ! OF OPNTTY ROUTINE INITTMPS= (FILTMP_EXTTMP_PPNTMP_0; DEVTMP_SIXBIT 'DSK'; NOVALUE); BIND REALFLAGS=FLAGS; ROUTINE PERMSG= BEGIN MACRO GETPPN=(REGISTER QQ; QQ_0; CALLI(QQ,#24))$, GREET(WHO,WHAT)=WHO:EXITSELECT TTYMES((PLIT ASCIZ WHAT)<29,7>)$; BIND HY00=#220660, RL13=#476457, FP03=#145753, EC03=#112423, CP06=#057076, CW09=#064031, WW17=#641573, RT01=#504111, DJ51=#075415, PK02=#431202, BL03=#032013, FTN45=#1446, RG01=#1377, MS10=#350064; IF .EFDB NEQ 0 THEN RETURN; SELECT GETPPN AND #777777 OF NSET GREET(HY00,'WELCOME TO BLISS/11 COUNTRY, HYDRA?M?J'); GREET(CP06,'HELLO CHUCK?M?J'); GREET(EC03,'HELLO ELLIS?M?J'); GREET(FP03,'HELLO FRED?M?J'); GREET(CW09,'OH CHUCKO!?M?J'); GREET(WW17,'IT''S BIG DADDY BILL!?M?J'); GREET(RT01,'HOWDY, RON?M?J'); GREET(DJ51,'HELLO DAVE?M?J'); GREET(PK02,'GOOD LUCK PAUL?M?J'); GREET(MS10,'HELLO MARY?M?J'); GREET(FTN45,'GOOD LUCK FORTRAN-IV PLUS?M?J'); GREET(RG01,'THESIS!?M?J'); GREET(BL03,'HI BRUCE?M?J') TESN; EFDB_-1 END; GLOBAL ROUTINE INITIO(TOG)= BEGIN LOCAL BINFIL,PPNBUF[2],CTYPE,SYMBOL,PSYMBOL,CNTR; REGISTER FLAGS,CCHAR; ROUTINE LKUPNTR= ! DO LOOKUPS OR ENTERS AS REQUIRED BEGIN ! RETURNED VALUE: ! 0: LOOKUP/ENTER FAILED OR DEVICE ERROR ! 1: A-OK MAP BUFVEC NEXTCHN; REGISTER R; LOCAL FUNNYPPN; !***** DEBUG ***** BIND DEBUGPPN=#025603032524; !***** DEBUG ***** BIND DFLTEXT= IF BLIS10 THEN PLIT( 0, 0, SIXBIT ' REL', SIXBIT ' LST', SIXBIT ' BLI' ) ELSE PLIT( 0, 0, SIXBIT ' OBJ', SIXBIT ' P11', SIXBIT ' B11' ); FUNNYPPN_0; !***** DEBUG ***** R_.DEVTMP; CALLI(R,DEVCHR); IF .R EQL 0 THEN RETURN 0; SELECT .NEXTCHN OF NSET BINCHN: IF NOT .R THEN RETURN 0 ELSE BINFLG_0; LSTCHN: IF NOT .R THEN RETURN 0 ELSE (LSTFLG_0; IF .R THEN (TTYLST_1; RETURN 1)); SRCCHN: IF NOT .R THEN RETURN 0 TESN; IF NOT OPN(.NEXTCHN,.DEVTMP, IF .NEXTCHN EQL BINCHN THEN IMAGEMODE ELSE ASCILINEMODE, SELECT .NEXTCHN OF NSET BINCHN: NUMBUFS^18; LSTCHN: IF .TTYLST THEN 1^18 ELSE NUMBUFS^18; SRCCHN: IF .R THEN 1 ELSE NUMBUFS TESN) ! END OF CALL TO OPN THEN RETURN 0; NEXTCHN[FILENAMEF]_.FILTMP; NEXTCHN[EXTF]_IF .EXTBIT THEN .EXTTMP ELSE .DFLTEXT[.NEXTCHN]; NEXTCHN[PPNF]_IF .PPNTMP EQL 0 THEN .PPNPERM ELSE .PPNTMP; IF .PPNTMP EQL 0 THEN FUNNYPPN_-1 ELSE PPNTMP_0; IF( !********** DEBUG ********** IF .NEXTCHN NEQ SRCCHN THEN NTR(.NEXTCHN) ELSE IF NOT LKUP(.NEXTCHN) THEN IF NOT .EXTBIT THEN (NEXTCHN[EXTF]_0; LKUP(.NEXTCHN)) ELSE 0 ELSE 1 ) NEQ 0 THEN RETURN 1 ELSE IF .FUNNYPPN THEN (PPNTMP_DEBUGPPN; RETURN LKUPNTR()) ELSE RETURN 0 END; ! OF LKUPNTR ROUTINE CCLLNK= BEGIN ! ISSUE RUN UUO FOR REQUEST EXTERNAL JOBDA; BIND RUNBLK=JOBDA+10; BIND MOVEI=#201, HRLI=#505, CALLI=#47, JFCL=#255, JRST=#254, RUNPLIT=PLIT( INST(MOVEI,0,#1777), INST(HRLI,0,1), INST(CALLI,0,#11), INST(JFCL,0,0), INST(MOVEI,0,RUNBLK<0,0>), INST(HRLI,0,1), INST(CALLI,0,#35), INST(JRST,4,0) ); IF NOT .INFOBIT THEN RETURN CMDERR_1; RUNBLK[0]_IF .DEVBIT THEN .DEVTMP ELSE SIXBIT 'SYS'; RUNBLK[1]_.FILTMP; RUNBLK[2]_RUNBLK[3]_RUNBLK[4]_RUNBLK[5]_0; IF .EXTBIT THEN RUNBLK[2]_.EXTTMP; IF .PPNTMP NEQ 0 THEN RUNBLK[4]_.PPNPERM; DECR I FROM 7 TO 0 DO JOBDA[.I]_.RUNPLIT[.I]; JOBDA() END; ! OF CCLLNK ROUTINE ERR1= ( TTYMES(ERR1M); IF .CCHAR LEQ "Z" THEN TTYLIST(.CCHAR) ELSE (TTYLIST("-"); TTYLIST(.CCHAR-26)); ABORTCMD); ROUTINE ERR2= ( TTYMES(ERR2M); TTYLIST(.CCHAR); ABORTCMD); ROUTINE ERR4= ( TTYMES(ERR4M); ABORTCMD); ROUTINE ERR5= ( TTYMES(ERR5M); TTYSIX(.DEVTMP); TTYLIST(":"); TTYSIX(.FILTMP); TTYLIST("."); TTYSIX(.EXTTMP); ABORTCMD); ROUTINE PPNERR= ( TTYMES(PPNERRM); ABORTCMD); IF .TOG EQL 0 THEN BEGIN BUFDATA[0,ADRWORD]_CMDBUF^18 + CMDHDR<0,0>; CCLINIT(); RESET(); FLAGS_PPNPERM_BINFIL_0; NOTREE_0; BINFLG_LSTFLG_1; FINALSW_1; ACCUM[0]_ACCUM[1]_-2; PACCUM_(ACCUM-1)<1,7>; NEXTCHN_BINCHN; OPNTTY(); PERMSG() END ELSE BEGIN BINFIL_1; FLAGS_.REALFLAGS; NEXTCHN_SRCCHN END; CURCHN_SRCCHN; INITTMPS(); SYMBOL_CMDERR_0; CNTR_6; PSYMBOL_SYMBOL<36,6>; SEQNUM_' '; SOSPGC_1; PAGCNT_-1; IF .TOG EQL 0 THEN IF .CCLCTL EQL 0 THEN (TTYLIST("*"); GETCMD()); WHILE .CMDERR EQL 0 DO BEGIN WHILE NEXTCHAR EQL 0 DO IF .CCLCTL NEQ 0 THEN CALLI(0,#12); CTYPE_.CTTAB[.CCHAR]; IF NOT .SWTBIT THEN CTYPE_.CTYPE+5; CASE .CTYPE OF SET ! 0 - ERROR ERR1(); ! 1 - SWITCH MODE ALPHA BEGIN INFOBIT_1; CCHAR_UPPERCASE(.CCHAR); IF .UNBIT THEN (UNBIT_0; CCHAR_.CCHAR+26); CASE .CCHAR-"A" OF SET TENOR11(ERR1(),ERR1()); ! A TENOR11(ERR1(),ERR1()); ! B TENOR11(XREF_1,XREFLG_1); ! C TENOR11(DEBFLG_1,DEBFLG_1); ! D TENOR11(EMFLG_1,EMFLG_1); ! E TENOR11(FSAVFLG_1,FINALSW_1); ! F TENOR11(GRFLG_1,SEGSW_1); ! G TENOR11((TWOFLG_NOT .TWOFLG; HGHFLG_NOT .HGHFLG), HYDRASW_1); ! H TENOR11(IFLAG_1,ERR1()); ! I TENOR11(ERR1(),ERR1()); ! J TENOR11(LSTFLG_1,QUIKSW_1); ! K TENOR11(LSTFLG_0,LSTFLG_0); ! L TENOR11(MFLAG_1,MLFLG_1); ! M TENOR11(ERRBIT_0,ERRBIT_1); ! N TENOR11(NPTFLG_0,NPTFLG_0); ! O TENOR11(PROFLG_1,PICSW_1); ! P TENOR11(ERR1(),MRKFLG_0); ! Q TENOR11(SRFLG_0,ERR1()); ! R TENOR11(SFLAG_1,SFLG_1); ! S TENOR11(TTFLAG_MHTIME_1,ERR1()); ! T TENOR11(NPTFLG_0,UNAMESW_1); ! U TENOR11(TWOFLG_NOT .TWOFLG,ERR1()); ! V TENOR11(ERR1(),ERR1()); ! W TENOR11(CODETOG_0,NOTREE_-1); ! X TENOR11(ERR1(),ERR1()); ! Y TENOR11(ERR1(),ZIPSW_1); ! Z TENOR11(ERR1(),ERR1()); ! -A TENOR11(ERR1(),ERR1()); ! -B TENOR11(XREF_0,XREFLG_0); ! -C TENOR11(DEBFLG_0,DEBFLG_0); ! -D TENOR11(EMFLAG_0,EMFLG_0); ! -E TENOR11(FSAVFLG_0,FINALSW_0); ! -F TENOR11(GRFLG_0,SEGSW_0); ! -G TENOR11(ERR1(),ERR1()); ! -H TENOR11(IFLAG_0,ERR1()); ! -I TENOR11(ERR1(),ERR1()); ! -J TENOR11(ERR1(),QUIKSW_0); ! -K TENOR11(LSTFLG_1,LSTFLG_1); ! -L TENOR11(MFLAG_0,MLFLG_0); ! -M TENOR11(ERRBIT_0,ERRBIT_0); ! -N TENOR11(NPTFLG_1,NPTFLG_1); ! -O TENOR11(ERR1(),PICSW_0); ! -P TENOR11(ERR1(),MRKFLG_1); ! -Q TENOR11(SRFLG_1,ERR1()); ! -R TENOR11(SFLAG_0,SFLG_0); ! -S TENOR11(TTFLAG_MHTIME_0,ERR1()); ! -T TENOR11(ERR1(),UNAMESW_0); ! -U TENOR11(ERR1(),ERR1()); ! -V TENOR11(ERR1(),ERR1()); ! -W TENOR11(ERR1(),ERR1()); ! -X TENOR11(ERR1(),ERR1()); ! -Y TENOR11(ERR1(),ZIPSW_0) ! -Z TES; IF .SLSHBIT THEN SWTBIT_SLSHBIT_0; END; ! OF SWITCH MODE ALPHA ! 2 - NUMBER IN SWITCH MODE ERR1(); ! 3 - SWITCH ESCAPE <)> CASEX(SWTBIT_0); ! 4 - UNSWITCH <-> CASEX(UNBIT_1); ! 5 - ERROR CHAR NORMAL MODE ERR2(); ! 6 - NORMAL MODE ALPHA BEGIN CCHAR_UPPERCASE(.CCHAR); INFOBIT_NAMEBIT_1; IF .BINFIL EQL 0 THEN REPLACEI(PACCUM,.CCHAR); IF (CNTR_.CNTR-1) GEQ 0 THEN REPLACEI(PSYMBOL,.CCHAR-#40) END; ! OF 6 ! 7 - NORMAL MODE NUMBER BEGIN INFOBIT_NAMEBIT_1; IF .BINFIL EQL 0 THEN REPLACEI(PACCUM,.CCHAR); IF (CNTR_.CNTR-1) GEQ 0 THEN REPLACEI(PSYMBOL,.CCHAR-#40) END; ! OF 7 ! 8 - ERROR ERR2(); ! 9 - ERROR ERR2(); ! 10 - ENTER SWITCH MODE <(> CASEX(SWTBIT_1); ! 11 - COLON BEGIN IF .DEVBIT THEN ERR4() ELSE DEVBIT_1; DEVTMP_.SYMBOL; IF .BINFIL EQL 0 THEN (PACCUM_ACCUM<36,7>;ACCUM_ACCUM[1]_-2); CNTR_6; PSYMBOL_SYMBOL<36,6>; SYMBOL_0 END; ! OF 11 ! 12 - DOT BEGIN EXTBIT_1; FILTMP_.SYMBOL; CNTR_3; PSYMBOL_SYMBOL<36,6>; SYMBOL_0 END; ! 0F 12 ! 13 - LEFT ARROW <_> OR EQUAL <=> BEGIN ARWBIT_1; BINFIL_.BINFIL+1; IF BLIS11 THEN NEXTCHN_LSTCHN; IF .EXTBIT THEN EXTTMP_.SYMBOL ELSE FILTMP_.SYMBOL; IF NOT LKUPNTR() THEN ERR5(); INITTMPS(); NDEBITS_0; NEXTCHN_SRCCHN; CNTR_6; PSYMBOL_SYMBOL<36,6>; SYMBOL_0 END; ! OF 13 ! 14 - COMMA BEGIN IF NOT .INFOBIT THEN EXITCASE NEXTCHN_LSTCHN; BINFIL_.BINFIL+1; IF .EXTBIT THEN EXTTMP_.SYMBOL ELSE FILTMP_.SYMBOL; IF NOT LKUPNTR() THEN ERR5(); INITTMPS(); NDEBITS_0; IF .ARWBIT THEN (REALFLAGS_.FLAGS; RETURN 1); NEXTCHN_LSTCHN; CNTR_6; PSYMBOL_SYMBOL<36,6>; SYMBOL_0; END; ! OF 14 ! 15 - CARRIAGE RETURN BEGIN IF NOT .INFOBIT THEN RETURN 0; ENDBIT_1; IF .EXTBIT THEN EXTTMP_.SYMBOL ELSE FILTMP_.SYMBOL; IF NOT LKUPNTR() THEN (ERR5(); RETURN 0); NDEBITS_0; IF NOT .ARWBIT THEN (ERR4(); RETURN 0); IF .CCLCTL NEQ 0 THEN CCLMES(); REALFLAGS_.FLAGS; RETURN 1 END; ! OF 15 ! 16 - ENTER SWITCH MODE SWTBIT_SLSHBIT_1; ! 17 - RUN REQUEST BEGIN IF .EXTBIT THEN EXTTMP_.SYMBOL ELSE FILTMP_.SYMBOL; CCLLNK() END; ! OF 17 ! 18 - RESERVED FOR INDIRECT FILE <@> BEGIN MACHOP INPUT=#66, RELEASE=#71; IF .EXTBIT THEN EXTTMP_.SYMBOL ELSE FILTMP_.SYMBOL; OPN(0,.DEVTMP,1,1); BUFDATA[0,FILENAMEF]_.FILTMP; BUFDATA[0,EXTF]_(IF .EXTBIT THEN .EXTTMP); BUFDATA[0,PPNF]_IF .PPNTMP EQL 0 THEN .PPNPERM ELSE .PPNTMP; LKUP(0); INPUT(0,0); RELEASE(0,0); TTYDIR_SELECT .TTYDIR OF NSET -1:-2; 1:2 TESN; INITTMPS(); NDEBITS_0; NEXTCHN_LSTCHN; CNTR_6; PSYMBOL_SYMBOL<36,6>; SYMBOL_0 END; ! OF 18 ! 19 - PPN SPECIFICATION <[> BEGIN LOCAL PPNBUF[2],PPPNBUF; PPNBUF_(PPNBUF+1)_0; PPPNBUF_PPNBUF<36,7>; NEXTCHAR; IF INRANGE(.CCHAR,"0","7") THEN ! OCTAL PPN BEGIN WHILE .CCHAR NEQ "," DO ( IF NOT INRANGE(.CCHAR,"0","7") THEN PPNERR(); PPNBUF_.PPNBUF^3 + .CCHAR-"0"; NEXTCHAR ); PPNTMP_.PPNBUF; PPNBUF_0; NEXTCHAR; WHILE .CCHAR NEQ "]" DO ( IF NOT INRANGE(.CCHAR,"0","7") THEN PPNERR(); PPNBUF_.PPNBUF^3 + .CCHAR-"0"; NEXTCHAR ); PPNTMP_.PPNBUF END ! OF THEN ELSE IF NOT CMUSW THEN PPNERR() ELSE ! CMU PPN IF DECR I FROM 8 TO 0 DO (REPLACEI(PPPNBUF,.CCHAR); IF NEXTCHAR EQL "]" THEN EXITLOOP 0) LSS 0 THEN PPNERR() ELSE ! CMU CONVERT (REGISTER R; R_PPNTMP<0,0>^18+PPNBUF<0,0>; IF NOT SKIP(CALLI(R,CMUDEC)) THEN PPNERR()); ! END OF ELSE IF .NDEBITS EQL 0 THEN PPNPERM_.PPNTMP END; ! OF 19 ! 20 - IGNORE 0 TES !END OF CASE ON .CTYPE END; ! OF WHILE LOOP CCLCTL_0 ! IF WE EVER GET HERE THE COMMAND WAS ABORTED END; ! OF INITIO END END ELUDOM