;PHONE.MAC.1704 13-Aug-86 FQ+1D.4H.22M.40S., by BUDD ; Flush displaying PTYnnn. Its wrong. ;USR0:PHONE.MAC.1699 15-Mar-85 LQ+2D.3H.13M.31S., by BUDD ; Save TTYXOF in SAVTTY etc ;MSC:PHONE.MAC.1698 1-Dec-84 FQ+1D.14H.19M.18S., by BUDNE ; Make sure zero ring flag gets sent in MAKMSG ;MSC:PHONE.MAC.1680 24-Jul-84 LQ+4D.11H.17M.1S., by BUDNE ; USE DNCONN FROM TGRADY'S MS11 STUFF, IT RETURNS THE ROUTE, FLUSH PHCONN ; *** WISH LIST *** ;TRY CONNECT W/O DNCONN FIRST; PUT LOCAL NODE FDB FIRST??? (NAH) ;SAVE/RESET PROGRAM NAME FOR PUSH/MAIL COMMANDS ;-- ;MAKE EXIT DEMAND HANGUP, ADD QUIT COMMAND? ;CREATE ASSEMBLY FEATURE TESTS FOR NO NETWORK, OR JUST NO DNCONN?? ;HANDLE ^L (REFRESH) @LKCTRL ;DON'T MOVE CURSOR UNTIL WE TYPE SOMETHING... (KEEP TRACKOF CURSOR!!) ;HAVE UNHOLD COMPLAIN IF NO USERS FOUND ON HOLD ;USER SELECTABLE SWITCH HOOK; QUOTE CHAR? ;READ MONNAM.TXT FOR LOCAL HOST NAME ;KEEP RING BUFFER OF LINES FOR EACH LINK/WINDOW?? ; ; *** BUGS *** ;LOCAL RING BLASTS EVERYONE, EVEN PERSON W/ PID!! ;3-WAY PRINTS TRASH, WRONG POS FOR CURSOR??? ;SOMEONE DIALING A BUSY PERSON DOES NOT GET A BLOWOFF??? (RI.2???) ;WRAP IN ECHO IS CRUDE -- DO WORD WRAP? ; CODE IN ECHO IS CRUDE -- USE CURSOR ADDRESSING AND CEOL ;ALL OF ECHO IS CRUDE -- REWRITE ;REWRITE LOOK? ; TITLE PHONE -- Video Telephone Conversation Program SUBTTL Robert A. Brown/Philip L. Budne SEARCH MONSYM,MACSYM,CMD,DNCUNV,JOBDAT .REQUIRE SYS:CMD .REQUIRE DNCONN ;GET DNCONN FROM MS11 .REQUEST SYS:MACREL .REQUIRE HLPR20 .DIRECTIVE FLBLST SALL ASCIZ " Copyright (c) 1984 by Philip L. Budne and Digital Equipment Corp. " ; This program may be copied for non profit use, with the inclusion of ; the above Copyright. No title to and ownership of the software is ; hereby transferred. ; ; The information in this software is subject to change without notice ; and should not be construed as a commitment by anyone. ; ; Neither Digital nor the Author assume responsibility for the use or ; reliability of this software anywhere. ; ; This program, along with PHNSRV is a TOPS-20 implementation of the ; PHONE protocol as documented and implemented by the VAX/VMS PHONE ; program. ; ; I would like to thank Robert Brown of CSSE for the head start his ; version gave me, and appologize for the number of needless ; changes I have made. ; ; -Phil Budne ; DEC/LCG - SWE ; SUBTTL TABLE OF CONTENTS ; ; Section Page ; 1. TABLE OF CONTENTS. . . . . . . . . . . . . . . . . . . 2 ; 2. DEFINITIONS. . . . . . . . . . . . . . . . . . . . . . 3 ; 3. PROTOCOL ; 3.1. MESSAGE CODES . . . . . . . . . . . . . . . . 4 ; 3.2. STATUS CODES. . . . . . . . . . . . . . . . . 4 ; 4. IMPURE STORAGE . . . . . . . . . . . . . . . . . . . . 6 ; 5. CONSTANTS. . . . . . . . . . . . . . . . . . . . . . . 7 ; 6. MAIN CODE. . . . . . . . . . . . . . . . . . . . . . . 9 ; 7. COMMANDS ; 7.1. EXIT. . . . . . . . . . . . . . . . . . . . . 10 ; 7.2. HANGUP. . . . . . . . . . . . . . . . . . . . 11 ; 7.3. ANSWER. . . . . . . . . . . . . . . . . . . . 12 ; 7.4. REJECT. . . . . . . . . . . . . . . . . . . . 13 ; 7.5. DIAL. . . . . . . . . . . . . . . . . . . . . 14 ; 7.6. PUSH AND MAIL . . . . . . . . . . . . . . . . 15 ; 7.7. DIRECTORY . . . . . . . . . . . . . . . . . . 16 ; 7.8. HOLD. . . . . . . . . . . . . . . . . . . . . 17 ; 7.9. UNHOLD. . . . . . . . . . . . . . . . . . . . 18 ; 7.10. BLANK AND REDRAW TEMPLATE . . . . . . . . . . 19 ; 7.11. STATUS. . . . . . . . . . . . . . . . . . . . 21 ; 8. IPCF ; 8.1. INITIALIZATION. . . . . . . . . . . . . . . . 22 ; 8.2. RECIEVE A PAGE FROM LOCAL OR SLAVE. . . . . . 23 ; 8.3. SEND A PAGE TO A LOCAL USER . . . . . . . . . 23 ; 8.4. RECEIVE A SHORT MESSAGE, BLOCKING (FROM INFO) 23 ; 8.5. SEND A SHORT MESSAGE. . . . . . . . . . . . . 23 ; 8.6. CHECK A PID . . . . . . . . . . . . . . . . . 23 ; 8.7. CREATE A PID. . . . . . . . . . . . . . . . . 23 ; 8.8. FIND PHONE PID (IF ANY) ASSOCIATED WITH A USER NUMBER 24 ; 8.9. FIND PID ASSOCIATED WITH A NAME . . . . . . . 24 ; 8.10. ASSIGN NAME TO OURPID . . . . . . . . . . . . 24 ; 8.11. Send message to INFO. . . . . . . . . 24 ; 9. Initialization stuff . . . . . . . . . . . . . . . . . 25 ; 10. PSI ; 10.1. TURN PI OFF . . . . . . . . . . . . . . . . . 26 ; 10.2. TURN PI ON. . . . . . . . . . . . . . . . . . 26 ; 10.3. KILL IPCF INTERUPTS . . . . . . . . . . . . . 26 ; 10.4. ACTIVATE IPCF INTERUPTS . . . . . . . . . . . 26 ; 11. INTERUPT LEVEL ; 11.1. IPCF DISPATCH . . . . . . . . . . . . . . . . 27 ; 11.2. RING. . . . . . . . . . . . . . . . . . . . . 28 ; 11.3. HANGUP. . . . . . . . . . . . . . . . . . . . 29 ; 11.4. BUSY SIGNAL . . . . . . . . . . . . . . . . . 30 ; 11.5. ANSWERED. . . . . . . . . . . . . . . . . . . 31 ; 11.6. FORCED LINK . . . . . . . . . . . . . . . . . 32 ; 11.7. REJECT. . . . . . . . . . . . . . . . . . . . 33 ; 11.8. PUT ON HOLD . . . . . . . . . . . . . . . . . 34 ; 11.9. TAKEN OFF HOLD. . . . . . . . . . . . . . . . 35 ; 11.10. CONVERSATION TEXT . . . . . . . . . . . . . . 36 ; 12. TTY ; 12.1. SAVE CCOC WORD. . . . . . . . . . . . . . . . 39 ; 12.2. BLAST CCOC WORD . . . . . . . . . . . . . . . 39 ; 12.3. RESTORE CCOC WORD . . . . . . . . . . . . . . 39 ; 12.4. KILL ECHO . . . . . . . . . . . . . . . . . . 39 ; 12.5. RESTORE ECHO. . . . . . . . . . . . . . . . . 39 ; 12.6. SKIP IF INPUT BUFFER EMPTY. . . . . . . . . . 39 ; 13. TEXT CONVERSATION INPUT. . . . . . . . . . . . . . . . 40 ; 14. LOOK ; 14.1. Get character . . . . . . . . . . . . . . . . 40 ; 14.2. Send off OURBUF to all of our windows user's. 40 ; 14.3. User typed something. . . . . . . . . . . . . 40 ; 14.4. Deposit a character to be sent. . . . . . . . 40 ; 14.5. Rubout was typed. . . . . . . . . . . . . . . 40 ; 14.6. Ignore extra rubouts. . . . . . . . . . . . . 40 ; 14.7. Some control character typed. . . . . . . . . 40 ; 15. Position self. . . . . . . . . . . . . . . . . . . . . 41 ; 16. PHONE ERROR MESSAGES . . . . . . . . . . . . . . . . . 41 ; 17. GOTO ERROR LINE. . . . . . . . . . . . . . . . . . . . 41 ; 18. GOTO PROMPT LINE . . . . . . . . . . . . . . . . . . . 41 ; 19. PARSE ; 19.1. ROUTE STRING. . . . . . . . . . . . . . . . . 42 ; 19.2. USER ID STRING. . . . . . . . . . . . . . . . 43 ; 20. LINKS ; 20.1. MAKE A CONNECTION . . . . . . . . . . . . . . 44 ; 20.2. MAKE A MESSAGE. . . . . . . . . . . . . . . . 45 ; 20.3. SEND A MESSAGE. . . . . . . . . . . . . . . . 45 ; 20.4. SEND HANGUP AND CLOSE . . . . . . . . . . . . 46 ; 20.5. SEND ANY MESSAGE AND CLOSE. . . . . . . . . . 46 ; 20.6. CREATE NEW LINK BLOCK . . . . . . . . . . . . 47 ; 20.7. CREATE A NEW LINK AND CONNECT IT. . . . . . . 47 ; 20.8. SAVE A LINK IN LINK TABLE . . . . . . . . . . 47 ; 20.9. SEARCH FOR A USER . . . . . . . . . . . . . . 47 ; 21. DECNET ; 21.1. COUNT AND SEND MESSAGE. . . . . . . . . . . . 48 ; 21.2. SEND COUNTED MESSAGE. . . . . . . . . . . . . 48 ; 21.3. GET TEXT WITH TIMEOUT . . . . . . . . . . . . 48 ; 21.4. GET MESSAGE W/O TIMEOUT . . . . . . . . . . . 48 ; 21.5. CONNECT TO REMOTE SLAVE FOR DIRECTORY . . . . 49 ; 21.6. SEND A MESSAGE. . . . . . . . . . . . . . . . 49 ; 22. LOCAL ; 22.1. SEND A MESSAGE. . . . . . . . . . . . . . . . 50 ; 22.2. CHECK FOR USER. . . . . . . . . . . . . . . . 51 ; 22.3. RING. . . . . . . . . . . . . . . . . . . . . 52 ; 22.4. SEND RING TEXT. . . . . . . . . . . . . . . . 53 ; 22.5. DIRECTORY . . . . . . . . . . . . . . . . . . 54 ; 23. WINDOWS ; 23.1. ECHO. . . . . . . . . . . . . . . . . . . . . 55 ; 23.2. FIND A USER . . . . . . . . . . . . . . . . . 56 ; 23.3. ADD A NEW USER. . . . . . . . . . . . . . . . 56 ; 23.4. REDIVIDE. . . . . . . . . . . . . . . . . . . 56 ; 23.5. REMOVE A USER . . . . . . . . . . . . . . . . 57 ; 23.6. SEND TO ALL . . . . . . . . . . . . . . . . . 57 ; 24. SPECIAL. . . . . . . . . . . . . . . . . . . . . . . . 58 ; 25. CORE ALLOCATOR . . . . . . . . . . . . . . . . . . . . 60 ; 26. LUUO HANDLR. . . . . . . . . . . . . . . . . . . . . . 61 ; 27. THE END. . . . . . . . . . . . . . . . . . . . . . . . 64 SUBTTL DEFINITIONS ;AC definitions T0==0 ;DON'T BLAME ME (IT USED TO BE NAMELESS!) T1==1 T2==2 T3==3 T4==4 T5==5 .FPAC==6 ;FIRST PRESERVED AC .NPAC==4 ;THIS MANY (6..11) FL==12 ;FLAGS F$DIAL==1B0 ; DIALING F$ANSW==1B1 ; ANSWERING F$TEXT==1B2 ; TEXT AVAILABLE TO SEND F$REF==1B3 ; REFRESH NEEDED F$FAX==1B4 ; IN FAX MODE F$DECN==1B5 ; DECNET IS AVAILABLE F$SERV==1B6 ; WE RUN THE DECNET SERVER (we may dial out) W==13 ;WINDOW PTR I==14 ;USER (LINK) PTR ;;;15 ;USED BY MACREL (TRVAR ...) .A16==16 ;USED BY MACREL (ACVAR, STKVAR) P==17 ;PDL ;Feature tests LOCALF==1 ;TRUE TO ENABLE LOCAL LINKS ;Parameters SLPTIM==^D80 ;TIME FOR INPUT CHECK SLEEP (IN MS.) PSETIM==^D850 ;TIME TO PAUSE AFTER ERROR OUTPUT (IN MS.) TXTLIN==3 ;FIRST LINE OF TEXT IN WINDOW (DASHES, NAME) OURSIZ==^D<50/5> ;OURBUF SIZE IN WORDS (TYPEIN BUFFER) BUFSIZ==^D256 ;SIZE OF BUFFERS (MAX MESSAGE SIZE IN BYTES) MAXJOB==^D510 ;MAX JOB TO LIST IN DIR... MAXWND==5 ;MAX NUMBER OF WINDOWS MAXLNK==MAXWND*5 ;MAX NUMBER OF ACTIVE LINKS ;Address Space ENDCOR=477777 ;LAST WORD FOR ALLOC DATPAG==500 ;PAGE FOR IPCF DATA RECIEVE DATADR=DATPAG*1000 ;ADDRESS FOR IPCF SNDPAG==501 ;PAGE FOR IPCF SEND SNDADR=SNDPAG*1000 ;ADDRESS HSTPAG==520 ;PAGE FOR LOCAL HOSTS HSTADR=HSTPAG*1000 HSTTAB=HSTADR+5000 ; PAGES 600+ USED BY HLPR20 DEFINE RETSKP OPDEF PJRST [JUMPA 13,] OPDEF TTY$ [1B8] ;TTY HACKING LUUO .JBUUO==:40 ;LUUO INSTR .JB41==:41 ;LUUO W/ EA CALC .JBFF==:121 ;LAST USED WORD IN CORE ;REL 6.0 SYMBOLS IFNDEF .TT125,.TT125==:^D35 ;VT125 IFNDEF .TT102,.TT102==:^D37 ;VT102 IFNDEF .TTH19,.TTH19==:^D38 ;H19 (ANSI) IFNDEF .TT131,.TT131==:^D39 ;VT131 IFNDEF .MORTF,.MORTF==:54 ;READ TERMINAL FLAGS IFNDEF MO%NUM,MO%NUM==:1B34 ; REFUSE USER-MESSAGES IFNDEF MO%NTM,MO%NTM==:1B35 ; INHIBIT NON-JOB OUTPUT SUBTTL PROTOCOL -- MESSAGE CODES ; CODES LOWER THAN 7. ARE VAX LOCAL QUEUEING CODES, NEVER SENT OVER THE NET. MS$CHK==:^D7 ;CHECK USER MS$RNG==:^D8 ;RING PHONE MS$HUP==:^D9 ;HANGUP MS$BSY==:^D10 ;TARGET IS BUSY MS$ANS==:^D11 ;TARGET HAS ANSWERED MS$REJ==:^D12 ;REJECT CALL MS$DON==:^D13 ;DONE WITH SLAVE MS$TXT==:^D14 ;CONVERSATION TEXT MS$DIR==:^D15 ;NEXT DIRECTORY LINE ;16. IS A VAX INTERNAL CODE MS$3RD==:^D17 ;HANDLE FORCED LINK TO THIRD PARTY MS$HLD==:^D18 ;PUT ON HOLD MS$OFF==:^D19 ;TAKEN OFF HOLD SUBTTL PROTOCOL -- STATUS CODES ST$OTH==:^D0 ;OTHER.. ST$AOK==:^D1 ;OK ST$IUS==:^D2 ;INVALID USER SYNTAX ST$FAI==:^D3 ;SLAVE FAILED ST$UID==:^D4 ;UID MISSING ST$SNP==:^D5 ;SLAVE DOES NOT HAVE PRIVS ST$UNE==:^D6 ;USER DOES NOT EXIST ST$TTY==:^D7 ;PHONE CANNOT USE TTY (TTY CANNOT USE PHONE?) ST$LOG==:^D8 ;USER HAS LOGGED OFF ST$OFF==:^D9 ;"OFF THE HOOK" /NOBROAD, REFUSE LYNX, TTY GAG ;Control chars BS==:"H"-100 TAB==:"I"-100 BEL==:"G"-100 CR==:"M"-100 LF==:"J"-100 FF==:"L"-100 DEL==:177 ;Macros ;Opcodes for TTY$ LUUO TT$MOV==:0 ;ABS MOVE TT$JMP==:1 ;HOME TT$JME==:2 ;HOME AND ERASE TT$ERL==:3 ;ERASE TO EOL TT$ERB==:4 ;ERASE TO EOS TT$SCR==:5 ;SET SCROLL REGION TT$NRM==:6 ;NORMAL VIDEO TT$REV==:7 ;REVERSE VIDEO TT$BRI==:10 ;BRIGHT VIDEO TT$IND==:400 ;SET FOR INDIRECT ARGS TT$MVX==:TT$IND+TT$MOV ;INDIRECT MOVE TT$SCX==:TT$IND+TT$SCR ;INDIRECT SCROLL DEFINE TTY (A,B<0>,C<0>) < .%.==10 ;;SAVE RADIX RADIX 10 ;;DECIMAL TTY$ [&-1] RADIX .%. ;;RESTORE RADIX PURGE .%. > ;TTY DEFINE FATAL (STR) < JRST [ HRROI T1,[ASCIZ ~STR~] JRST .FATAL ] > ;FATAL DEFINE ERROR (STR) < JRST [ HRROI T1,[ASCIZ ~?STR~] JRST .ERROR ] > ;ERROR ; NEW COMMAND MACROS DEFINE CONFRM < JSR .CONF > ;CONFRM DEFINE NOISE (STR) < HRROI T1,[ASCIZ \STR\] JSR .NOISE > ;NOISE DEFINE T (STR,DATA,FLGS<0>) < IFE FLGS,< IFB ,< [ASCIZ |STR|],,<.'STR> ;> [ASCIZ |STR|],,DATA > ;IFE FLGS IFN FLGS,< IFB ,< [CM%FW!FLGS ASCIZ |STR|],,<.'STR> > IFNB ,< [CM%FW!FLGS ASCIZ |STR|],,DATA > > ;IFN FLGS > ;T SUBTTL IMPURE STORAGE CMDSTG ;CMD STORAGE ;CONNECT BLOCK FOR DNCONN CONBLK: DN%SPL ;Flags (WAIT LONGER) 0 ;Host string pointer ^D29 ;Remote object type 0 ;Local obj ^D8 ;Byte size 0 ;Opt data (Route file on .DNINI call) 0 ;Password 0 ;Account 0 ;User-id .NULIO ;Desc for ret op data 0 ;Length for above .NULIO ;Desc for errors .NULIO ;Desc for warnings .NULIO ;Desc for information .CONF: 0 ;JSR TO HERE MOVEI T1,[FLDDB. .CMCFM] CALL RFLDE PJRST ERRPNT JRST @.CONF .NOISE: 0 ;JSR HERE MOVEM T1,NOIFDB+.CMDAT MOVEI T1,NOIFDB CALL RFLDE PJRST ERRPNT JRST @.NOISE NOIFDB: FLDDB. .CMNOI,,0 SWHOOK: EXP "%" ;SWITCH HOOK CHAR ERRPSE: EXP PSETIM ;AMMOUNT OF TIME TO PAUSE AFTER ERROR OUTPUT OLDMOD: BLOCK 1 ;SAVED TTY MOD WORD FAXJFN: BLOCK 1 ;FACSIMILE JFN FAXFIL: BLOCK 30 ;FILE BEING FAX'ED LSTCOD: BLOCK 1 ;LAST CODE SENT BY MAKMSG ZERBEG:! ;START OF AREA TO ZERO ******************** LNKLST: BLOCK 1 ;LIST OF FREE LINK BLOCKS WNDLST: BLOCK 1 ;LIST OF FREE WINDOW BLOCKS NUMUSR: BLOCK 1 ;COUNT OF CURRENT USERS LNKTAB: BLOCK MAXLNK ;TABLE OF "ACTIVE" LINKS WNDTAB: BLOCK MAXWND ;TABLE OF WINDOWS (IN ORDER) MAXHLD: BLOCK 1 ;MAXMUM HOLD LEVEL (NORMALLY -1) LNKBLK: PHASE 0 ;**** START OF LINK BLOCK **** LNKJFN:!BLOCK 1 ;CONNECTION TO USER (SEE L$TYPE IN LNKFLG) LNKHLD:!BLOCK 1 ;HOLD LEVEL (-1 IS NORMAL, .GE. 0 IS HELD) LNKFLG:!BLOCK 1 ;FLAGS L$HELD==1B0 ; HAS YOU ON HOLD L$TYPE==,,-1 ;**MUST BE RIGHT HALF** ; LINK TYPE LNKJFN CONTAINS LT$DCN==0 ; DECNET 0,,JFN LT$LCL==1 ; LOCAL PID LNKSND:!BLOCK BUFSIZ/4+1 ;SEND BUFFER LNKRCV:!BLOCK BUFSIZ/4+1 ;RECIEVE BUFFER LNKUSR:!BLOCK 10 ;USER'S FULL NAME LNKUNO:!BLOCK 1 ;LOCAL USER NUMBER LNKJOB:!BLOCK 1 ;LOCAL JOB ASSOC WITH PID IN LNKJFN LNKRUT:!BLOCK 12 ;ROUTE WE USED LNKLEN==.-1 DEPHASE ;**** END OF LINK BLOCK **** ;WINDOW BLOCK DEFN WNDBLK: PHASE 0 ;**** START OF WINDOW BLOCK WNDCOL:!BLOCK 1 ;CURRENT COLUMN WNDLIN:!BLOCK 1 ;CURRENT LINE WNDSIZ:!BLOCK 1 ;WINDOW LENGTH (SIZE) WNDORG:!BLOCK 1 ;WINDOW ORIGIN WNDLBP:!BLOCK 1 ;LINE BUFFER POINTER WNDLNK:!BLOCK 1 ;CURRENT LINK WNDLBF:!BLOCK ^D<<80+4>/5> ;LINE BUFFER WNDLEN==.-1 DEPHASE ;**** END OF WINDOW BLOCK **** SCRSIZ: BLOCK 1 ;TERMINAL SCREEN SIZE OURBUF: BLOCK OURSIZ ;OUR TEXT (INPUT BUFFER) OURCNT: BLOCK 1 ;COUNT OF CHARS IN OURBUF OURPNT: BLOCK 1 ;BP INTO OURBUF A0: BLOCK 1 ;BP FOR INTERUPT TEXT BSYLNK: BLOCK 1 ;LINK WE ARE RINGING/ANSWERING US: BLOCK 10 ;OUR FULL USER ID STRING RINGFL: BLOCK 1 ;VALUE OF LAST RING FLAG RCVD EXCFRK: BLOCK 1 ;FORK HANDLE FOR EXEC MSFRK: BLOCK 1 ;FORK HANDLE FOR MAILER (MS) LSTERR: BLOCK 1 ;BP TO LAST ERROR ZEREND==.-1 ;********** END OF ZEROS JOBNUM: BLOCK 1 ;LAST JOB LISTED IN DIR GJIBLK: BLOCK .JIMAX+1 ;BLOCK FOR GETJI TMPSTR: BLOCK 20 ;BLOCK FOR LOCAL DIR TEMP2: BLOCK 20 ;BLOCK FOR DIRST... ERRSTR: BLOCK 10 ;BLOCK FOR LAST ERROR PTYPAR: BLOCK 1 ;GETAB OPRUNO: BLOCK 1 ;WHO TO IGNORE PIDNAM: BLOCK 5 ;BLOCK FOR PID NAME ISNDBK: BLOCK 10 ;IPCF SEND BUFFER IRCVBK: BLOCK 10 ;IPCF RCV BUFFER OURPID: BLOCK 1 ;PROCESS PID IPSND: BLOCK 4 ;MSEND BLOCK IPRCV: BLOCK 4 ;MRECV BLOCK L2SAVE: BLOCK 17 ;INTERUPT AC SAVE SAVPOS: BLOCK 1 ;SAVED CURSOR POSN DURING IPCF SAVCOC: BLOCK 2 ;SAVED CCOC FROM DURING IPCF UUOACS: BLOCK 17 ;SAVED ACS FOR TTYSTF VT10OT: BYTE (7) 33,"[",0,0,0 ;VT100 MOVE CURSOR BYTE (7) ";",0,0,0,"H",0 VT10ST: BYTE (7) 33,"[",0,0,0 ;VT100 SCROLL BYTE (7) ";",0,0,0,"r" CMNOD: FLDDB. .CMKEY,CM%SDH,0,,,CMNOD2 ;FOR PARSING NODE CMNOD2: FLDDB. .CMKEY,CM%SDH,HSTTAB OURJOB: BLOCK 1 ;OUR JOB NUMBER OURNOD: BLOCK 2 ;OUR NODE NAME OURNAM: BLOCK 15 ;OUR USER NAME OURPTR: BLOCK 1 ;SAVED BP JOBAOB: BLOCK 1 ;AOBJN FOR ALL JOBS AC1: BLOCK 1 ;CRASH ACS AC2: BLOCK 1 ;... AC3: BLOCK 1 ;... AC4: BLOCK 1 ;... AREA: BLOCK 10 ;TEMP AREA TTYTYP: BLOCK 1 ;GTTYP TERMINAL TYPE TTYCOC: BLOCK 2 ;ORIGINAL TTY CCOC WORDS TTYXOF: BLOCK 1 ;ORIGINAL END OF PAGE PAUSE PLIST: BLOCK ;PDL sweet PDL P1FLG: BLOCK 1 ;PSI LEVEL 1 PC P2FLG: BLOCK 1 ;PSI LEVEL 2 PC P3FLG: BLOCK 1 ;PSI LEVEL 3 PC SUBTTL CONSTANTS USRBRK: EXP USRB0.,USRB1.,USRB2.,USRB3. ;USER NAME BREAK SET LEVTAB: EXP P1FLG,P2FLG,P3FLG ;PSI LEVEL TABLE CHNTAB: PHASE 0 ;PSI CHANNEL TABLE IPCCHN:!2,,IPCINT ;IPCF INTERRUPT DEPHASE ;END OF STRANGENESS ;Dispatch table for functions DEFINE ACTION (CODE,ADDR) < BLOCK CODE-. EXP ADDR > ;ACTION DSPTAB: PHASE 0 ACTION MS$RNG,XRUNG ;BEING RUNG ACTION MS$HUP,XHUNG ;SOMEONE HUNG UP ACTION MS$BSY,XBUSY ;TARGET BUSY ACTION MS$ANS,XANSWR ;TARGET ANSWERED ACTION MS$REJ,XREJ ;TARGET REJECTED ACTION MS$TXT,XTEXT ;TEXT FROM REMOTE ACTION MS$3RD,XFORCE ;3RD PARTY JUST JOINED ACTION MS$HLD,XHOLD ;PUT ON HOLD ACTION MS$OFF,XUNHLD ;TAKEN OFF HOLD DSPMAX==. DEPHASE ; Main command dispatch table COMTAB: XWD COML,COML ;Lengths T ANSWER ;ANSWER (last call) T BLANK ;BLANK (screen) T DIAL ;DIAL (user) T DIRECTORY ;DIRECTORY (of users on) T EXIT ;EXIT (to superior) T F,$FACS,CM%INV!CM%ABR T FA,$FACS,CM%INV!CM%ABR $FACS: T FACSIMILE ;FACSIMILE (of file) T FAXSIMILE,$FACS,CM%INV!CM%ABR T HANGUP ;HANGUP (the phone) T HELP ;HELP T HOLD ;HOLD (current call) T LAST ;LAST (error message) T MAIL ;MAIL (using MS) T PUSH ;PUSH (command level) T REJECT ;REJECT (current call) T STATUS ;STATUS (of PHONE) T UNHOLD ;UNHOLD (previous call) COML==.-COMTAB-1 SUBTTL MAIN CODE EVEC: JRST START JRST START -1,,377777 START: RESET ;STOP THE WORLD! MOVE P,[-LPLIST,,PLIST-1] ;GET THEE A PIDDLE HLRZ T1,.JBSA ;GET INITIAL END MOVEM T1,.JBFF ;STORE MOVE T1,[CALL LUUOH] ;LUUO WORD MOVEM T1,.JB41 ;STORE MOVEI I,LNKBLK ;POINT TO NORMAL LINK BLOCK CALL INIT ;INITIALIZATION STUFF CALL TPLATE ;PUT UP TEMPLATE CALL PION ;ENABLE PI CALL CMDINI ;INITIALIZE CMD (SET UP SBK) MOVSI T1,(CM%XIF) ;ACCEPT "@" IORM T1,SBK+.CMFLG ;SET IN STATE BLOCK ;Main command loop MCOM: CALL PARSER ;PARSE AND EXECUTE A COMMAND SKIPE NUMUSR ;HAVE A CONVERSATION? CALL TEXT ; YES, GO DO TEXT JRST MCOM ;"MAY I PLEASE HAVE ANOTHER, SIR!" ;Parse one command PARSER: SETZ W, ;NO CURRENT WINDOW CALL PMTLIN ;ASSUME THE POSITION TTY ;ERASE TO EOS < PROMPT (PHONE>) ;PROMPT CALL IPON ;ENSURE PSI TURNED ON MOVEI T1,[FLDDB. .CMKEY,,COMTAB,,,[ ;PARSE KEYWORD FLDDB. .CMCFM]] ;OR SWALLOW CRLF CALL RFLDE ;PARSE, RETURN ERRORS JRST [ CALL IPOFF ; PROTECT AGAINST IPCF PJRST ERRPNT ] ; GO SCREAM ABOUT ERROR TSZ T3,T3 ;KEYWORD? JUMPN T3,CPOPJ ; NO, MUSTA BEEN CONFIRM HRRZ T1,(T2) ;GET RESULTS CALL (T1) ;CALL ACTION ROUTINE TRN ;... RET SUBTTL COMMANDS -- EXIT .EXIT: NOISE (to superior) ;EXIT command CONFRM ;BE SURE!!! TTY ;RESET SCROLL REGION TTY ;CLEAR SCREEN MOVX T1,CZ%ABT ;ABORT ADDI T1,.FHSLF ;ALL OUR FILES CLZFF ERJMP .+1 CALL RESTTY ;RESTORE TTY SETTINGS RESET ;BLAM I/O AND PIDS HALTF JRST START ;RESTART SUBTTL COMMANDS -- FACSIMILE .FACSIMILE: NOISE (of file) MOVEI T1,[FLDDB. .CMIFI] CALL RFLDE PJRST ERRPNT MOVEM T2,FAXJFN ;SAVE JFN CONFRM SKIPN NUMUSR ;ANY TALKERS? JRST [ CALL RELFAX ERROR (No current call)] ;SORRY MOVE T1,FAXJFN MOVE T2,[FLD(7,OF%BSZ)!OF%RD] OPENF JRST [ CALL RELFAX PJRST ERRPNT ] HRROI T1,FAXFIL ;GET BUFFER MOVE T2,FAXJFN SETZ T3, JFNS IDPB T3,T1 TLO FL,(F$FAX) ;SET THE FLAG!! RET RELFAX: MOVE T2,FAXJFN RLJFN TRN RET SUBTTL COMMANDS -- HANGUP .HANGUP: ACVAR ;LOOP VARS NOISE (on current call) CONFRM MOVN X1,NUMUSR ;LOOP FOR ALL WINDOWS MOVSI X1,(X1) ;-N,,0 CAIN X1,0 ;ZERO? ERROR (No current call) ;SORRY PUSH P,I ;SAVE LINK HG.LOP: MOVE T1,WNDTAB(X1) ;GET WINDOW MOVE I,WNDLNK(T1) ;GET LINK CALL FREWND ;FREE UP WINDOW CALL CLSHUP ;HANG UP MOVSI X2,-MAXLNK ;FOR ALL LINKS HG.LP2: CAME I,LNKTAB(X2) ;RIGHT LINK? AOBJN X2,HG.LP2 ; NO, LOOP CAIGE X2,0 ;FOUND? SETZM LNKTAB(X2) ; YES, ZAP AOBJN X1,HG.LOP ;LOOP SETZM NUMUSR ;NO MORE USERS PJRST POPIJ ENDAV. SUBTTL COMMANDS -- HELP .HELP: HRROI T1,[ASCIZ 'SYS:PHONE.HLP'] CALL HLPFIL## PJRST ERRPNT PJRST TPLATE SUBTTL COMMANDS -- ANSWER .ANSWER: NOISE (last call) CONFRM SKIPE T1,BSYLNK ;GOT A LINK? TLZN FL,(F$ANSW) ; AND IN ANSWER MODE ERROR (No one is calling) ;NO SETZM BSYLNK ;CLEAR BUSY LINK PUSH P,I ;SAVE CURRENT LINK MOVE I,T1 ;SWITCH TO CALLER MOVEI T1,MS$ANS ;ANSWER MESG SETZ T2, ;NO DATA CALL SNDMSG ;SEND MESS JRST [ CALL SNDERR ; LOSE LOSE PJRST POPIJ ] ; RETURN MOVE T1,I ;GET LINK CALL NEWUSR ;ASSIGN THEM A VIEWPORT TRN ; SIGH PJRST POPIJ ;RETURN SUBTTL COMMANDS -- REJECT .REJECT: NOISE (last call) ;REJECT COMMAND CONFRM ;ARE YOU SURE? SKIPE T1,BSYLNK ;GOT A LINK? TLZN FL,(F$ANSW) ; AND IN ANSWER MODE ERROR (No one is calling) ;NO SETZM BSYLNK ;CLEAR BUSY LINK PUSH P,I ;SAVE CURRENT LINK MOVE I,T1 ;SWITCH TO CALLER MOVEI T1,MS$REJ ;REJECT MESG SETZ T2, ;NO DATA CALL CLSMSG ;SEND MESS & CLOSE PJRST POPIJ ;RETURN SUBTTL COMMANDS -- DIAL DIAFDB: FLDDB. .CMUSR,,,,,DIAFD2 DIAFD2: FLDBK. .CMFLD,CM%SDH,,,,USRBRK,DIAAT DIAAT: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /@/]>,<@>,<@> .DIAL: STKVAR <> ;DIAL COMMAND NOISE (user) HRROI T1,OURNOD ;DEFAULT NODE MOVEM T1,CONBLK+DN.HST ;DIAL NODE TLNN FL,(F$SERV) ;NETWORK+SERVER? IFSKP. MOVEI T1,DIAFDB ;GET FDB SETZM ATMBUF ;CLEAR ATOM BUFFER CALL RFLDE ;TRY.. BUT RETURN ON ERROR PJRST ERRPNT HRRZ T3,T3 ;GET WINNING FDB CAIN T3,DIAFD2 ;FIELD? JRST .DIAL1 ; YES CAIN T3,DIAAT ;@? JRST .DIALN ; YES, GET NODE ELSE. MOVEI T1,[FLDDB. .CMUSR] CALL RFLDE PJRST ERRPNT ENDIF. HRROI T1,USRNAM ;GOT USER NUMBER DIRST ;CONVERT TO STRING FATAL (DIRST LOSSAGE) SETZ T2, IDPB T2,T1 ;TERMINATE TLNE FL,(F$SERV) ;NETWORK+SERVER? JRST .DIAL2 ; YES, NOW PARSE HOST CONFRM JRST .DIAL3 .DIAL1: MOVE T1,SBK+.CMABP ;FROM ATOM BUF HRROI T2,USRNAM ;TO USER BUF CALL CPYST0 ;COPY .DIAL2: MOVEI T1,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /@/]>,<@>,<@>,[ FLDDB. .CMCFM] ] CALL RFLDE ;PARSE PJRST ERRPNT TSZ T3,T3 ;"@"? JUMPN T3,.DIAL3 ;NOPE, WAS CONFIRM .DIALN: MOVEI T1,CMNOD ;NOW PARSE NODE NAME CALL RFLDE ;DO IT PJRST ERRPNT HLRO T2,(T2) ;GET NODE STRING MOVEM T2,CONBLK+DN.HST ;SAVE NODE BP CONFRM ;GET CONFIRMATION .DIAL3: CALL IPOFF ;AVOID PSI MOVE T1,CONBLK+DN.HST ;GET NODE HRROI T2,AREA ;TEMP AREA CALL CPYSTR ;COPY NODE MOVEI T1,":" ;GET A COLON IDPB T1,T2 ;TO TERMINATE IDPB T1,T2 ;NODE NAME HRROI T1,USRNAM ;GET TARGET USER CALL CPYST0 ;COPY IN CALL ERRLIN ;GOTO ERROR/STATUS LINE TTY ;CLEAR IT HRROI T1,AREA ;GET NAME CALL MAKLNK ;CREATE LINK JRST [ TRNE T1,-1 ; GOT TEXT? PSOUT ; TELL 'EM PJRST .ERROR] ; SIGH MOVEM T1,BSYLNK ;SAVE DIALING LINK MOVE I,T1 ;SET LINK MOVSI T1,() ;FIRST RING FLAG MOVEM T1,AREA ;STORE TLO FL,(F$DIAL) ;DIALING OUT ;User exists, now ring them .DIAL4: TLNN FL,(F$DIAL) ;STILL DIALING? RET ;MUST HAVE BEEN ANSWERED/REJECTED CALL ERRLIN ;GOTO ERROR/STATUS LINE TMSG ;SAY WHAT WE ARE DOING HRROI T1,LNKUSR(I) ;USER STRING PSOUT ;TYPE IT TMSG < (type any key to cancel)> CALL ENDERR ;CLEAR AND WAIT CALL IPON ;OPEN THE WINDOW MOVEI T1,MS$RNG ;RING CODE HRROI T2,AREA ;DATA CALL SNDMSG ;SEND MESS JRST [ TLZ FL,(F$DIAL) ; ERROR, CLEAR DIAL MODE PJRST SNDERR ] ; SHUT DOWN TMSG <> ;BRRRING... MOVEI T4,^D10 ;10 SECONDS .DIAL5: TLNN FL,(F$DIAL) ;GET AN ANSWER? RET ; PERHAPS!! CALL XSIBE ;ANYTHING TYPED? JRST .DIAL6 ; YES, ABORT TLNN FL,(F$DIAL) ;WAS A RING PENDING? RET ; YES, DON'T EVEN SLEEP MOVEI T1,^D1000 ;NO, WAIT A SECOND AND CHECK AGAIN CALL XHIBER ;SLEEP SOJG T4,.DIAL5 ;LOOP 10 TIMES SETZM AREA ;CLEAR RING FLAG JRST .DIAL4 ;RING AGAIN .DIAL6: TLZ FL,(F$DIAL) ;ABORTED, CLEAR DIAL MODE MOVEI T1,.PRIIN ;OUR TTY CFIBF ;CLEAR INPUT BUFFER PJRST CLSHUP ;HANG UP ENDSV. SUBTTL COMMANDS -- PUSH AND MAIL .PUSH: NOISE (command level) CONFRM SKIPE NUMUSR ;Talking? ERROR (Must hold current call first) MOVEI T4,EXCFRK ;Indicate an EXEC is wanted SKIPE T1,EXCFRK ;Do we already have a fork handle? JRST STFORK ;Go start it MOVSI T1,(GJ%OLD!GJ%SHT) HRROI T2,[ASCIZ 'DEFAULT-EXEC:'] GTJFN IFJER. MOVSI T1,(GJ%OLD!GJ%SHT) HRROI T2,[ASCIZ "SYSTEM:EXEC.EXE"] GTJFN ERJMP ERRPNT ENDIF. JRST GTFORK ;Go start it .MAIL: NOISE (using DEFAULT-MAILER:) ;I use BABYL. CONFRM ;Are you sure?? SKIPE NUMUSR ;Talking? ERROR (Must hold current call first) MOVEI T4,MSFRK ;Say we want a mailer SKIPE T1,MSFRK ;Do we have an old one? JRST STFORK ; Yes, just start it MOVSI T1,(GJ%SHT!GJ%OLD) ;Get JFN on file HRROI T2,[ASCIZ "DEFAULT-MAILER:"] GTJFN IFJER. MOVSI T1,(GJ%OLD!GJ%SHT) HRROI T2,[ASCIZ "SYS:MS.EXE"] GTJFN ERJMP ERRPNT ENDIF. GTFORK: STKVAR MOVEM T1,JFN MOVSI T1,(CR%CAP) ;Create fork w/ full caps CFORK ERJMP ERRPNT MOVEM T1,(T4) ;Save fork handle in right place MOVSI T1,(T1) ;Make Fork,,0 HRR T1,JFN ;Make Fork,,JFN GET ;Load the fork ERJMP ERRPNT STFORK: TTY ;HOME TTY ;CLEAR SCREEN MOVE T1,(T4) ;Get handle RPCAP ;Get capabilities ERJMP ERRPNT ;Sigh TLZ T2,(SC%LOG) ;DON'T ALLOW LOGOUT TLZ T3,(SC%LOG) ;DON'T ALLOW LOGOUT EPCAP ;SET CAPABILITIES SETZ T2, ;ENTRY 0 SFRKV ;IN ENTRY VECTOR ERJMP STFOR2 ; SIGH WFORK ;WAIT FOR TERMINATION ERJMP .+1 ; HUH? CALL SAVTTY ;SETUP TTY AGAIN PJRST TPLATE ;REFRESH, AND RETURN STFOR2: CALL TPLATE ;FIRST GET TEMPLATE PJRST ERRPNT ;NOW TYPE LAST ERROR ENDSV. SUBTTL COMMANDS -- DIRECTORY .DIRECTORY: ACVAR STKVAR TLNN FL,(F$DECN) ;GOT DECNET? IFSKP. NOISE (of users on) ;BE NOISY MOVEI T1,CMNOD ;PARSE A NODE CALL RFLDE PJRST ERRPNT ;ERROR IN PARSING HLRO T2,(T2) ;GET NODE STRING MOVEM T2,HOSTBP ;SAVE ELSE. NOISE (of users) ENDIF. CONFRM MOVEI I,LNKBLK ;GET STATIC LINK BLOCK CALL IPOFF MOVEI T1,LT$DCN HRRM T1,LNKFLG(I) IFN LOCALF,< TLNN FL,(F$DECN) ;HAVE NETWORK? JRST LCLDIR ; NOPE HRROI T1,OURNOD ;LOCAL MOVE T2,HOSTBP ;TARGET CALL CMPSTR JRST REMDIR ; NO MATCH LCLDIR: MOVEI T1,LT$LCL ;LINK TYPE HRRM T1,LNKFLG(I) ;LOCAL!! SETZM JOBNUM ;STARTING LOCAL JOB JRST DIR.AA > ;LOCALF REMDIR: CALL ERRLIN TTY MOVE T1,HOSTBP ;GET HOST CALL OPNCON ;OPEN DECNET CONNECTION JRST [ TRNN T1,-1 ; GOT TEXT? HRROI T1,[ASCIZ 'Some error occured'] PJRST .ERROR ] TMSG MOVE T1,HOSTBP PSOUT CALL ENDERR DIR.AA: CALL PMTLIN ;PROMPT.. TMSG TTY ;ERASE TO EOS TTY TMSG SETZ X1, ;CLEAR COUNTER DIRLOP: CALL XSIBE ;SEE IF USER TYPED SOMETHING JRST DIRABT ;ABORT CALL GETDIR ;GET NEXT LINE JUMPE T3,DIRDON ;NULL TEXT? (LENGTH = 0) CAIE X1,0 ;ANY PRINTED YET? TRNE X1,17 ;MULT OF SIXTEEN? JRST DIRTYP ; NO TMSG < --Type any character to continue--> ;YES PBIN ;WAIT CAIN T1,CR ;CR? PBIN ; SNARF LF TTY DIRTYP: TTY MOVE T1,T2 ;POINT TO BUFFER PSOUT ;TYPE IT OUT CALL CRLF ;GO TO NEXT LINE TTY ;CLEAR IT AOJA X1,DIRLOP ;LOOP DIRDON: TTY CALL CRLF JUMPE X1,[ TMSG JRST DIRWAT ] MOVEI T1,.PRIOU ;TERMINAL MOVEI T2,(X1) ;USER COUNT MOVEI T3,^D10 ;DECIMAL NOUT ;TYPE NUMBER ERJMP .+1 ;DISREGARD.. TMSG < user> MOVEI T1,"s" CAIE X1,1 ;MORE THAN ONE? PBOUT ; MAKE PLURAL DIRWAT: TMSG < (--Type any character to continue--)> PBIN ;WAIT FOR A CHARACTER DIRABT: MOVEI T1,.PRIIN ;TTY CFIBF ;CLEAR INPUT BUFFER CALL TPLATE ;PUT UP FRESH TEMPLATE JRST CLSDON ;CLOSE DOWN CONNECTION ENDAV. ENDSV. ;GET NEXT DIR LINE GETDIR: HRRZ T1,LNKFLG(I) ;GET LINK TYPE PJRST @[NDIR ; DECNET CONNECTION LDIR ](T1) ; LOCAL CONNECTION (IPCF) NDIR: MOVEI T1,MS$DIR ;ASK FOR DIRECTORY SETZ T2, ;NO DATA CALL MAKMSG ;CREATE MESSAGE CALL DECOUT ;SEND IT OUT CALL DECINW ;GET RESP. NO TIMEOUTS TRN ; IGNORE STATUS RET SUBTTL COMMANDS -- HOLD .HOLD: NOISE (current call) CONFRM ;BE SURE... SKIPN NUMUSR ;ANY USERS? ERROR (No current call) DOHOLD: ACVAR ;LOOP VAR MOVSI X1,-MAXLNK ;FOR ALL LINKS HD.LOP: SKIPN I,LNKTAB(X1) ;GET LINK JRST HD.BOT ; NONE SKIPL LNKHLD(I) ;CURRENT? JRST HD.AOS ; NO CALL KILUSR ;YES, REMOVE FROM SCREEN MOVEI T1,MS$HLD ;SEND HOLD MESS SETZ T2, ;NO DATA CALL SNDMSG ;SEND OFF TRN ; IGNORE ERROR HD.AOS: AOS LNKHLD(I) ;SEND DEEPER INTO HOLD HD.BOT: AOBJN X1,HD.LOP ;..LOOP AOS MAXHLD ;BUMP MAX HOLD LEVEL RET ENDAV. SUBTTL COMMANDS -- LAST .LAST: NOISE (error text) CONFRM SKIPN T1,LSTERR HRROI T1,[ASCIZ "No errors yet!"] PJRST .ERROR SUBTTL COMMANDS -- UNHOLD .UNHOLD:NOISE (previous call) CONFRM SKIPE NUMUSR ;ANY USERS? ERROR (Please hang up first) ;BE RUDE FOR NOW UNHOLD: ACVAR ;LOOP VAR MOVSI X1,-MAXLNK ;FOR ALL LINKS UH.LOP: SKIPN I,LNKTAB(X1) ;GOT A LINK? JRST UH.BOT ; NOPE SOSL LNKHLD(I) ;DECREMENT HOLD LEVEL JRST UH.BOT ; NOT READY YET MOVEI T1,MS$OFF ;TAKE OFF HOLD SETZ T2, ;NO MORE DATA CALL SNDMSG ;SEND OFF JRST UH.BOT ; LOOOSER MOVE T1,I ;GET LINK CALL NEWUSR ;ADD TO SCREEN TRN ; IT FIT LAST TIME!! UH.BOT: AOBJN X1,UH.LOP ;LOOP... SOSGE MAXHLD ;UP A LEVEL SETOM MAXHLD ;NOT TOO FAR!! CALL IPON ;LET THE SUN SHINE MOVEI T1,^D100 ;PAUSE SO WE GET UNHELD!! DISMS RET ENDAV. SUBTTL COMMANDS -- BLANK AND REDRAW TEMPLATE .BLANK: NOISE (screen) CONFRM TPLATE: TTY ;CLEAR SCREEN TTY ;HEADER LINE TTY ;REVERSE VIDEO TMSG ;TITLE TTY ;NORMAL VIDEO TTY MOVE T1,SWHOOK ;SWITCH HOOK CHAR CALL PUTC ;TYPE TTY MOVEI T1,.PRIOU ;TO TTY SETO T2, ;NOW MOVX T3,OT%NTM ;JUST DATE ODTIM ERJMP .+1 RET BOXES: ACVAR PUSH P,W ;SAVE WINDOW TTY TTY ;CLEAR TO EOS MOVEI W,WNDBLK ;OUR WINDOW BLOCK MOVEI T5,LNKBLK ;OUR LINK BLOCK CALL DOBOX MOVN X1,NUMUSR ;GET USER COUNT HRLZ X1,X1 ;AS -N,,0 BOXLOP: MOVE W,WNDTAB(X1) ;GET WINDOW MOVE T5,WNDLNK(W) ;GET LINK CALL DOBOX BOXBOT: AOBJN X1,BOXLOP POP P,W ;RESTORE WINDOW TLZ FL,(F$REF) ;SAY WE ARE UP TO DATE RET ENDAV. ; W/ WINDOW ; T5/ LINK DOBOX: ACVAR ;BP MOVE T2,WNDORG(W) ;GET ORIGIN MOVEI T3,1 ;FIRST COL TTY ;GO THERE HRROI T1,TP ;GET DASHES PSOUT ;TYPE AOJ T2, ;NEXT LINE MOVEI T3,^D33 ;'MIDDLE' TTY ;GO THERE TTY ;BRIGHT VIDEO HRROI T1,LNKUSR(T5) ;GET USER PSOUT ;TYPE TTY ;NORMAL VIDEO MOVE T3,LNKFLG(T5) ;GET LINK FLAGS TLNN T3,(L$HELD) ;HOLDING US? JRST BOX2 ;NO MOVEI T3,^D70 ;GO NEAR END OF LINE TTY ;GO THERE TMSG BOX2: CALL CRLF MOVEI T1,TXTLIN ;TOP OF TEXT MOVEM T1,WNDLIN(W) ;STORE MOVEI T1,1 ;FIRST COLM MOVEM T1,WNDCOL(W) ;STORE SETZ T0, ;GET NULL MOVE T1,WNDLBP(W) ;GET LINE BP IDPB T0,T1 ;STORE NULL MOVEI X1,WNDLBF(W) ;GET LINE BUF HRLI X1,(POINT 7,) ;GET BP BOX3: ILDB T1,X1 ;GET BYTE JUMPE T1,CPOPJ ;DONE CALL PUTC ;***** HACKLUDGEHACKLUDGEHACKLUDGEHACKLUDGE AOS WNDCOL(W) ;***** HACKLUDGEHACKLUDGEHACKLUDGEHACKLUDGE JRST BOX3 ;LOOP ENDAV. ;WAS CAUSING WRAP PROBLEMS.. SHORTENED TP: ASCIZ/------------------------------------------------------------------------/ SUBTTL COMMANDS -- STATUS .STATUS: ACVAR ;CALL LEVEL NOISE (of PHONE) CONFRM SKIPN NUMUSR ;ANY CURRENT? SKIPL MAXHLD ; NONE ON HOLD TRNA ERROR (No calls) TTY TTY ;ERASE TO EOS SKIPN NUMUSR ;ANY LUSERS? IFSKP. TMSG CALL CRLF SETO X1, ;CURRENT LEVEL MOVE T1,X1 ;GET LEVEL CALL DMPLVL ;DUMP IT ENDIF. SETZ X1, STSLOP: CAMLE X1,MAXHLD ;ANY PEOPLE HERE? JRST STSDON ;NOPE CALL CRLF TMSG MOVEI T1,.PRIOU MOVEI T2,(X1) ;GET LEVEL MOVEI T3,^D10 ;GET RADIX NOUT TRN TMSG <:> CALL CRLF MOVE T1,X1 ;GET LEVEL CALL DMPLVL AOJA X1,STSLOP ;GET NEXT LEVEL STSDON: CALL CRLF CALL CRLF TMSG <--Type any char to continue--> PBIN CAIN T1,"M"-100 PBIN RET ENDAV. DMPLVL: ACVAR MOVEM T1,X1 ;SAVE LEVEL MOVSI T5,-MAXLNK ;GET LOOP INDEX DMPLOP: SKIPE T4,LNKTAB(T5) ;GET LINK IF ANY CAME X1,LNKHLD(T4) ; GOT ONE, ON RIGHT LEVEL? JRST DMPBOT ; NOPE HRROI T1,LNKRUT(T4) ;GET ROUTE PSOUT ;TYPE HRROI T1,LNKUSR(T4) ;GET USER PSOUT HRRZ T2,LNKFLG(T4) ;ANY FLAGS SET? TMSG < (via > HRRO T1,[ [ASCIZ 'DECnet)'] [ASCIZ 'Local IPCF)'] ](T2) PSOUT CALL CRLF DMPBOT: AOBJN T5,DMPLOP RET ENDAV. SUBTTL IPCF -- INITIALIZATION IPCINI: MOVEI T1,.FHSLF ;CREATE FORK WIDE PID CALL CREPID ;PID RET ; MUMBLE MOVEM T1,OURPID ;USE THIS ONE FOR NOW MOVE T1,[POINT 7,PIDNAM] MOVEI T2,"<" ;>START PID NAME IDPB T2,T1 ;STORE HRROI T2,OURNAM ;USER CALL CPYTXT ;< HRROI T2,[ASCIZ ">PHONE"] CALL CPYTXT SETZ T2, IDPB T2,T1 ;TERMINATE HRROI T1,PIDNAM ;NAVE TO GIVE PID CALL NAMPID ;TRY TO ASSIGN TRNA ; LOSE, FIND OWNER JRST IPCIN2 ; WIN, GO ADD PSI HRROI T1,PIDNAM ;GET NAME CALL FNDPID ;TRY TO LOOK UP FATAL (Could not get or find your PID) CALL CHKPID ;GET OWNER FATAL (Could not get your PID's owner) CAMN T1,OURJOB ;THIS JOB?? FATAL (Your job already has an active phone) FATAL (Some other job of yours is using the phone) IPCIN2: MOVEI T1,3 ;LENGTH MOVEI T2,T3 ;ADDRESS MOVEI T3,.MUPIC ;IPCF/PI FUNCTION MOVE T4,OURPID ;PID MOVEI T5,IPCCHN ;CHANNEL MUTIL RET RETSKP SUBTTL IPCF -- RECIEVE A PAGE FROM LOCAL OR SLAVE RIPCF: MOVE T1,OURPID ;GET OUR PID MOVEM T1,IPRCV+.IPCFR ;STORE RECIEVER MOVX T1,IP%CFB!IP%CFV ;ONE PAGE, DO NOT BLOCK MOVEM T1,IPRCV+.IPCFL ;STORE FLAGS MOVE T1,[1000,,DATPAG] ;MESSAGE PAGE MOVEM T1,IPRCV+.IPCFP ;STORE POINTER MOVEI T1,4 ;LENGTH OF BLOCK MOVEI T2,IPRCV ;ADDR OF BLOCK MRECV ;GET PACKET ERJMP CPOPJ RETSKP SUBTTL IPCF -- SEND A PAGE TO A LOCAL USER ; T1/ Target PID ; CALL SIPCF ; SIPCF: MOVEM T1,IPSND+.IPCFR ;STORE RECIEVER'S PID MOVX T1,IP%CFV ;ONE PAGE MOVEM T1,IPSND+.IPCFL ;STORE FLAGS MOVE T1,OURPID ;GET OUR PID MOVEM T1,IPSND+.IPCFS ;STORE SENDER'S PID MOVE T1,[1000,,SNDPAG] ;POINT TO DATA MOVEM T1,IPSND+.IPCFP ;STORE MOVEI T1,4 ;BLOCK LENGTH MOVEI T2,IPSND ;BLOCK ADDRESS MSEND ERJMP CPOPJ RETSKP SUBTTL IPCF -- RECEIVE A SHORT MESSAGE, BLOCKING (FROM INFO) RIPCFS: MOVX T1,IP%TTL ;TRUNCATE MOVEM T1,IPRCV+.IPCFL ;STORE FLAGS MOVE T1,OURPID ;GET OUR PID MOVEM T1,IPRCV+.IPCFR ;STORE RECIEVER MOVE T1,[10,,IRCVBK] ;MESSAGE AREA MOVEM T1,IPRCV+.IPCFP ;STORE POINTER MOVEI T1,4 ;LENGTH OF BLOCK MOVEI T2,IPRCV ;ADDR OF BLOCK MRECV ;GET PACKET ERJMP CPOPJ RETSKP SUBTTL IPCF -- SEND A SHORT MESSAGE ; T1/ Target PID ; CALL SIPCFS ; ; SIPCFS: MOVEM T1,IPSND+.IPCFR ;STORE RECIEVER'S PID SETZM IPSND+.IPCFL ;CLEAR FLAGS MOVE T1,OURPID ;GET OUR PID MOVEM T1,IPSND+.IPCFS ;STORE SENDER'S PID MOVE T1,[10,,ISNDBK] ;POINT TO DATA MOVEM T1,IPSND+.IPCFP ;STORE MOVEI T1,4 ;BLOCK LENGTH MOVEI T2,IPSND ;BLOCK ADDRESS MSEND ERJMP CPOPJ RETSKP SUBTTL IPCF -- CHECK A PID ; T1/ PID ; CALL CHKPID ; ; ; T1/ owning job CHKPID: MOVEM T1,T4 ;STORE PID MOVEI T3,.MUFOJ ;FUNCTION DMOVE T1,[EXP 3,T3] ;LEN & ADDR MUTIL ;FIND THE PID'S JOB ERJMP CPOPJ ;RETURN ERROR MOVE T1,T5 ;GET JOB NUMBER RETSKP ;RETURN HAPPY SUBTTL IPCF -- CREATE A PID ; T1/ Flags,,Fork ; CALL CREPID ; ; ; T1/ PID CREPID: MOVE T4,T1 ;PUT FLAGS IN PLACE DMOVE T1,[EXP 3,T3] ;LEN & ADDR MOVEI T3,.MUCRE ;CREATE PID MUTIL ;DOIT ERJMP CPOPJ ;RETURN ERROR MOVE T1,T5 ;GET PID RETSKP ;RETURN HAPPY SUBTTL IPCF -- FIND PHONE PID (IF ANY) ASSOCIATED WITH A USER NUMBER ; (THIS IS FNDUSR IN PHNSRV) ; CALL FNDUNO ; ; ; T1/ PID FNDUNO: STKVAR <> MOVEI T1,BUFFER ;GET LOCAL BUFFER ADDR HRLI T1,(POINT 7,) ;MAKE INTO BP MOVEI T2,"<" ;> GET START OF PID NAME IDPB T2,T1 ;STORE IT MOVE T2,LNKUNO(I) ;GET USER NUMBER DIRST ;GET USER STRING RET ; SIGH < HRROI T2,[ASCIZ '>PHONE'] ;TERMINATE PID NAME CALL CPYTXT ;FILL IT OUT CALL IPOFF ;SUPRESS IPCF PSI (MUST READ RESP) HRROI T1,BUFFER ;GET PID NAME ADDR CALL FNDPID ;LOOKUP THE PID TRNA AOS (P) ;GIVE SKIP MOVEM T1,BUFFER CALL IPON ;RETURN W/ IPCF ENABLED MOVE T1,BUFFER RET SUBTTL IPCF -- FIND PID ASSOCIATED WITH A NAME ; T1/ BP TO NAME ; CALL FNDPID ; ; ; T1/ PID FNDPID: HRROI T2,ISNDBK+.IPCI2 ;NAME OF PID CALL CPYST0 ;COPY PID NAME MOVEI T1,.IPCIW ;LOOK FOR PID MOVEM T1,ISNDBK+.IPCI0 ;STORE FUNCTION SETZM ISNDBK+.IPCI1 ;SEND RESULTS TO ME ONLY CALL IPCSYS ;INTERACT W/ SYSINF RET ; GRR MOVE T1,IRCVBK+.IPCI1 ;GET PHNSRV PID RETSKP SUBTTL IPCF -- ASSIGN NAME TO OURPID ; T1/ BP to name ; CALL NAMPID ; ; NAMPID: HRROI T2,ISNDBK+.IPCI2 ;NAME OF PID CALL CPYST0 ;COPY MOVEI T1,.IPCII ;CREATE NAME MOVEM T1,ISNDBK+.IPCI0 ;STORE FUNCTION SETZM ISNDBK+.IPCI1 ;RESULTS TO ME ONLY SUBTTL IPCF -- Send message to INFO IPCSYS: SETZ T1, ;PID FOR SYSINF CALL SIPCFS ;SEND MESSAGE TO SYSINF RET ; SIGH CALL RIPCFS ;RECEIVE SHORT MESSAGE FROM SYSINF RET ; MUMBLE.. LDB T1,[POINTR IPRCV,IP%CFC] ;GET PRIV FIELD CAIE T1,.IPCCF ;FROM SYSTEM-WIDE INFO? CAIN T1,.IPCCP ; OR FROM MY INFO? TRNA ; YES!! JRST IPCSYS ; NO, WAIT FOR IT THEN LDB T2,[POINTR IPRCV,IP%CFE] ;GET SYSINF RETURN CODE JUMPN T2,CPOPJ ;SOME ERROR? RETSKP ;NOPE. SUBTTL Initialization stuff INIT: SETZB FL,ZERBEG ;ZERO MOVE T1,[ZERBEG,,ZERBEG+1] BLT T1,ZEREND ;SMEAR CALL CHKNET ;SET NETWORK FLAGS TLNN FL,(F$DECN) ;DECNET? JRST INIT2 ; NOPE CALL GETLCL ;GET LOCAL NODES SKIPE CMNOD+.CMDAT ;ALREADY READ NODE TABLE? JRST INIT2 ; YES, IGNORE MOVEI T1,CONBLK ;GET CONNECT BLOCK CALL .DNINI## ;INITIALIZE DNCONN MOVEI T1,[0,,0] ; GET PTR TO EMPTY TABLE MOVEM T1,CMNOD+.CMDAT ;STORE TABLE OF NAMES INIT2: SETOM MAXHLD ;SET UP MAX HOLD LEVEL MOVE T1,['JOBTTY'] SYSGT HLLZM T2,JOBAOB ;SAVE JOB AOBJN WORD MOVE T1,['PTYPAR'] SYSGT HRRZM T1,PTYPAR ;STORE FIRST PTY MOVSI T1,(RC%EMO) ;GET EXACT MATCH HRROI T2,[ASCIZ 'OPERATOR'] SETZ T3, RCUSR ;GET OPERATOR USER NUMBER MOVEM T3,OPRUNO ;SAVE CALL SAVTTY ;SET TERMINAL CCOC WORDS MOVEI T1,.PRIOU ;OUR TTY GTTYP ;GET TERMINAL TYPE ERCAL ERRHLT SKIPN VTXDSP(T2) ;KNOWN? FATAL (Unknown Terminal type) ;ONLY THE BEST TUNA.... MOVEM T2,TTYTYP ;SAVE MOVEI T1,.PRIOU ;OUR TTY MOVEI T2,.MORLL ;READ PAGE LEN MTOPR ;DO DEV OP CAIGE T3,1 ;LOOK REASONABLE? MOVEI T3,^D24 ; NO, GET DEFAULT MOVEM T3,SCRSIZ ;STORE ;Get our name and location HRROI T1,[ASCIZ 'TOPS20'] ;DEFAULT NODE NAME (PERHAPS MONNAM.TXT?) HRROI T2,OURNOD ;DEST CALL CPYST0 MOVEI T1,.NDGLN ;GET NODE NAME FUCNTION MOVEI T2,T3 ;ARGBLOCK ADDR HRROI T3,OURNOD ;STORE HERE MOVEM T3,CMNOD+.CMDEF ;MAKE DEFAULT NODE NAME NODE ;GET NODE NAME ERJMP QQSV ;ON THE OTHER HAND.. SETZ T0, ;GET NULL IDPB T0,T3 ;TERMINATE QQSV: GJINF ;RANDOM JOB INFO MOVEM T3,OURJOB ;SAVE JOB NUMBER MOVE T2,T1 ;PUT UID INTO T2 HRROI T1,OURNAM ;GET USER BUFFER DIRST ;MAKE USER STRING FATAL (BAD USER NUMBER) IDPB T0,T1 ;TERMINATE ;Get in form NODE::USER HRROI T1,US ;POINT TO BUFFER HRROI T2,OURNOD ;FROM OUR NODE CALL CPYTXT ;COPY IT MOVEI T2,":" ;TERMINATE NODE WITH :: IDPB T2,T1 IDPB T2,T1 HRROI T2,OURNAM ;COPY FROM OUR NODE CALL CPYTXT ;COPY HRROI T1,LNKBLK+LNKUSR ;GET OUR LINK HRROI T2,US ;GET OUR NAME CALL CPYTXT ;COPY IN MOVE T1,[POINT 7,WNDBLK+WNDLBF] ;GET BP TO OUR LINE BUFFER MOVEM T1,WNDBLK+WNDLBP ;STORE MOVEI T1,.FHSLF ;CURRENT PROCESS MOVE T2,[LEVTAB,,CHNTAB] ;PI TABLES SIR ;SET UP TABLES MOVSI T2,(1B) ;CHANNEL MASK AIC ;ACTIVATE CALL IPCINI ;INITIALIZE IPCF CALL ERRHLT ;LEAVE A TRAIL RET SUBTTL INIT -- GET LOCAL HOSTS GetLcl: Setzm HstTab ;No Locals Movei 1,5000 ;5 pages Movem 1,HstAdr ;Store count Movei 2,HstAdr ;Get dest Movei 1,.NDGNT ;Get node table NODE ;Load up table ErJmp Cpopj ; Sigh Hlrz 1,HstAdr ;Get number returned Movem 1,HstTab ;Store as table max Movn 1,1 ;Get -count Hrlz 4,1 ;-count,,0 Hrri 4,HstAdr+.NDBK1 ;Get start of blocks GetHs1: Movei 1,HstTab ;Get table addr Move 2,(4) ;Get addr of node block Hrlz 2,.NDNAM(2) ;Get addr of node name,,0 Hlr 2,2 ;Get name,,name TBADD ;Insert into table ErJmp .+1 ; Sigh Aobjn 4,GetHs1 ;Loop for all hosts Ret SUBTTL INIT -- CHECK FOR DECNET CHKNET: STKVAR MOVSI T1,(GJ%SHT) HRROI T2,[ASCIZ 'DCN:-29.'] GTJFN RET MOVEM T1,TSTJFN MOVE T2,[FLD(10,OF%BSZ)!OF%RD!OF%WR] OPENF IFJER. ;BAD DEVICE? MOVE T1,TSTJFN RLJFN TRN RET ENDIF. ;BAD DEVICE? DVCHR HLRZ T2,T2 ANDI T2,(DV%TYP) CAIE T2,.DVDCN ;RIGHT DEVICE? JRST CLSTST ; NOPE ; NOW WE ARE SURE WE HAVE DECNET!! ; LOOK FOR THE SERVER. TLO FL,(F$DECN) MOVEI T4,^D10 TSTLOP: MOVE T1,TSTJFN MOVEI T2,.MORLS MTOPR TLNE T3,(MO%CON) ;Connected? TLOA FL,(F$SERV) ; Yes!! TLNE T3,(MO%ABT!MO%SYN) ;No, connect been rejected? JRST CLSTST ; Yes, close down SOJLE T4,CLSTST ;Connection timed out MOVEI T1,^D500 ;1/2 sec DISMS JRST TSTLOP ;Try again CLSTST: MOVE T1,TSTJFN CLOSF TRN RET ENDSV. SUBTTL PSI -- TURN PI OFF PIOFF: ;;; SETZM PILVL ;SAY WE ARE OFF .PIOFF: MOVEI T1,.FHSLF ;THIS FORK DIR ;DISABLE INTERUPTS RET SUBTTL PSI -- TURN PI ON PION: ;;; SETOM PILVL ;SAY WE ARE ON .PION: MOVEI T1,.FHSLF ;THIS FORK EIR ;ENABLE INTERUPTS RET SUBTTL PSI -- KILL IPCF INTERUPTS IPOFF: JRST PIOFF MOVEI T1,.FHSLF ;OUR FORK MOVSI T2,(1B) ;IPCF CHAN DIC RET SUBTTL PSI -- ACTIVATE IPCF INTERUPTS IPON: JRST PION MOVEI T1,.FHSLF ;OUR FORK MOVSI T2,(1B) ;IPCF CHAN AIC RET SUBTTL INTERUPT LEVEL -- IPCF DISPATCH IPCINT: MOVEM 16,L2SAVE+16 ;STORE AC16 MOVEI 16,L2SAVE ;SAVE AC0..15 BLT 16,L2SAVE+15 MOVEI T1,.PRIOU ;OUR TTY RFPOS ;GET CURSOR POS MOVEM T2,SAVPOS ;SAVE RFCOC DMOVEM T2,SAVCOC CALL SETTTY ;RE-BLAST CCOC (COMND PLAYS W/ IT!!) CALL DOIPCF IINT.3: MOVEM FL,L2SAVE+FL ;SATORE FLAGS BACK HRRZ T1,SAVPOS ;GET COLM HLRZ T2,SAVPOS ;GET LINE ADDI T1,1 ;MAKE ONE BASED ADDI T2,3 ;... SKIPE L2SAVE+W ;HAVE A WINDOW? JRST IINT.4 ; YES, DON'T WORRY TTY ;NO, RESTORE TO COMND% LINE IINT.4: MOVEI T1,.PRIOU ;OUR TTY MOVE T2,SAVPOS ;GET SAVED POSN SFPOS ;SET CURSOR POS DMOVE T2,SAVCOC ;RESTORE CCOC SFCOC MOVSI 16,L2SAVE ;RESTORE ACS BLT 16,16 ;0..16 DEBRK DOIPCF: CALL RIPCF ;GET MESSAGE (PAGE) RET ; NO MORE LDB T1,[POINT 8,DATADR,7] ;GET CODE CAIG T1,DSPMAX ;IN RANGE? SKIPN T1,DSPTAB(T1) ; ANY ROUTINE? TRNA ; NO. CALL (T1) ; GO TO ROUTINE TRN ; BE CAREFULL JRST DOIPCF ;GET ANOTHER SUBTTL INTERUPT LEVEL -- RING XRUNG: MOVE T1,[POINT 8,DATADR,7] ;GET PEST HRROI T2,US ;AND US CALL CMPSTR ;ONE AND THE SAME? JRST RI.OTH ; NOPE, BE NORMAL SKIPN I,BSYLNK ;USE SAME LINK TO ANSWER!! RET ; YOU LOSE MOVEI T1,MS$ANS ;ANSWER.. SETZ T2, ;NO DATA CALL SNDMSG ;SEND MESSAGE PJRST CLSDON ; SIGH TLO FL,(F$ANSW) ;PUT INTO ANSWER MODE RET ;GO HOME ;Here with a ring from someone who is not us RI.OTH: TLNE FL,(F$DIAL) ;IN DIAL MODE? PJRST TMPBSY ; IF YES, RETURN BUSY MOVE T2,[POINT 8,DATADR,7] ;GET SENDER RI.LOP: ILDB T1,T2 ;GET BYTE JUMPN T1,RI.LOP ;TILL EOS ILDB T1,T2 ;GET RING FLAG MOVEM T1,RINGFL ;SAVE TLNE FL,(F$ANSW) ;ANSWERING ALREADY? SKIPN RINGFL ; AND THIS IS FIRST RING? TRNA ; NO. PJRST TMPBSY ; YES, SEND BACK BUSY TLNN FL,(F$ANSW) ;ANSWERING? SKIPN RINGFL ; OR NOT FIRST RING? JRST RI.2 ; YES, HANDLE SUBSEQUENT RING. MOVE T1,[POINT 8,DATADR,7] ;NO, NEW USER!! CALL MAKLNK ;MAKE LINK BACK TO THEM RET ; SIGH ;NOTE: WE QUIT NOW SO THE USER DOESN'T ;KNOW THIS B.S. WENT ON (OTHER THAN THE ;DELAY) AS OPPOSED TO CRUFTY VAX VERSION PUSH P,I ;SAVE LINK MOVE I,T1 ;SET LINK TO NEW ONE TLO FL,(F$ANSW) ;PUT INTO ANSWER MODE MOVEM I,BSYLNK ;SAVE BUSY LINK POP P,I ;RESTORE LINK JRST RI.MES ;GIVE "RING", NOW THAT BSYLNK IS SET UP! ; Answer mode, or not first ring RI.2: SKIPE T1,BSYLNK ;HAVE A LINK? TLNN FL,(F$ANSW) ; AND IN ANSWER MODE? RET ; NO PUNT THE POOR LUSER (SEND TMPBSY?) HRROI T1,LNKUSR(T1) ;GET OLD RINGER MOVE T2,[POINT 8,DATADR,7] ;GET NEW RINGER SKIPN RINGFL ;SUBSEQUENT RING CALL CMPSTR ; AND FROM SAME PERSON? RET ; YOU LOSE RI.MES: MOVE T1,[POINT 8,DATADR,7] ;GET USER HRROI T2,US ;GET US CALL CMPSTR ;ONE AND THE SAME? TRNA ;NO, KEEP TRUCK'N RET ; YES, DON'T WAST BREATH CALL ERRLIN ;GO TO MESSAGE LINE CALL SAVTTY ;*********** MOVE T1,[POINT 8,DATADR,7] ;TELL THEM WHO PSOUT ;TYPE IT TMSG < is ringing you!> ;BRRRING.. PJRST ENDERR ;Tell someone we are busy (called from RING interrupt) TMPBSY: PUSH P,I ;SAVE CURRENT LINK MOVE T1,[POINT 8,DATADR,7] ;THEIR NAME CALL MAKLNK ;MAKE LINK JRST POPIJ ; FAILED MOVE I,T1 ;SWITCH TO NEW LINK MOVEI T1,MS$BSY ;BUSY SETZ T2, ;NO DATA CALL SNDMSG ;SEND MESS TRN ; IGNORE ERROR CALL CLSDON ;SHUT DOWN THE LINK POPIJ: POP P,I ;RESTORE LINK RET SUBTTL INTERUPT LEVEL -- HANGUP XHUNG: ACVAR ;LOOP VAR SKIPN T1,BSYLNK ;GOT A BUSY LINK JRST HU.FND ; NOPE HRROI T1,LNKUSR(T1) ;GET BUSY USER MOVE T2,[POINT 8,DATADR,7] ;GET USER WHO HUNGUP CALL CMPSTR ;SAME? JRST HU.FND ; NOPE TLNE FL,(F$DIAL) ;ARE WE CALLING THEM? JRST [ CALL BRKCAL ; YES, BREAK IT THEN JRST HU.MES ] ; GO GIVE MESS TLZN FL,(F$ANSW) ;WERE THEY CALLING US? JRST HU.FND ; NO????? MOVE I,BSYLNK ;YES SETZM BSYLNK ;CLEAR LINK CALL CLSHUP ;HANG UP & SHUT DOWN THE LINK JRST HU.MES ;TELL THEM HU.FND: MOVSI X1,-MAXLNK ;SEARCH *ALL* LINKS HU.LOP: SKIPN I,LNKTAB(X1) ;GET LINK, IF ANY JRST HU.BOT ; NO LINK HRROI T1,LNKUSR(I) ;GET USER MOVE T2,[POINT 8,DATADR,7] ;GET REMOTE CALL CMPSTR ;MATCH? JRST HU.BOT ; NO CALL KILUSR ;KILL FROM SCREEN SETZM LNKTAB(X1) ;FREE LINK SLOT CALL CLSHUP ;SAY GOODBYE, KILL LINK BLOCK HU.BOT: AOBJN X1,HU.LOP ;LOOP CALL REFRSH ;RE-SPLIT SCREEN TRN ; NEVER MIND... HU.MES: CALL ERRLIN ;PUT ON ERROR LINE MOVE T1,[POINT 8,DATADR,7] ;GET USER PSOUT ;TYPE THEM TMSG < hung up> ;TELL WHAT THEY DID PJRST ENDERR ENDAV. SUBTTL INTERUPT LEVEL -- BUSY SIGNAL XBUSY: SKIPN T1,BSYLNK ;CALLER/EE? RET ; NOPE HRROI T1,LNKUSR(T1) ;GET USER MOVE T2,[POINT 8,DATADR,7] ;GET REMOTE CALL CMPSTR ;RIGHT PERSON? RET ; PHONEY PHONE CALL TLNN FL,(F$DIAL) ;IN DIAL MODE? JRST XBUS.1 ; NO, CHECK IF BEING RUNG CALL BRKCAL ;BREAK THE CALL CALL ERRLIN ;GO TO ERR LINE TMSG ;SAY WHAT WE MEAN PJRST ENDERR XBUS.1: TLZN FL,(F$ANSW) ;IN ANSWER MODE? RET ; NOPE, TOTAL LOSER MOVEI T1,MS$BSY ;THAT'L SHOW UM! SETZ T2, ;NO DATA ;Close BSYLNK ; T1/ MESSAGE CLSBSY: PUSH P,I ;SAVE LINK MOVE I,BSYLNK ;SET TO BUSY LINK SETZM BSYLNK ;DESTROY BSYLNK CALL CLSMSG ;SEND IT PJRST POPIJ ;Break current call BRKCAL: TLZ FL,(F$DIAL) ;CLEAR DIAL MODE MOVEI T1,MS$HUP ;SAY WE HUNG UP SETZ T2, ;NO DATA PJRST CLSBSY ;CLOSE BUSYLINK SUBTTL INTERUPT LEVEL -- ANSWERED XANSWR: ACVAR ;NEW LINK, LOOP VAR STKVAR <,> ;FULL ROUTE TO NEW PERSON, OLD PERSON TLNE FL,(F$DIAL) ;IN DIAL MODE? SKIPN X1,BSYLNK ;HACKING A LINK? RET ; NO, SPURIOUS HRROI T1,LNKUSR(X1) ;GET TARGET USER MOVE T2,[POINT 8,DATADR,7] ;GET REMOTE CALL CMPSTR ;COMPARE RET ; NOT WHO WE WANT TLZ FL,(F$DIAL) ;GOT AN ANSWER!! MOVE T1,BSYLNK ;GET LINK CALL NEWUSR ;GET WINDOW, SAVE LINK PJRST BRKCAL ; ABANDON SHIP!! SETZM BSYLNK ;CLEAR LINK (BRKCAL NEEDS IT) CALL ERRLIN ;REPORT ON ERROR LINE MOVE T1,[POINT 8,DATADR,7] ;GET USER PSOUT ;TYPE TMSG < ANSWERed!> ;OH BLISS CALL ENDERR ;; HERE TO FORCE LINKS TO NEW PERSON ETC.. HRROI T1,FULNAM ;PLACE FOR FULL USER NAME HRROI T2,LNKRUT(X1) ;GET FULL ROUTE CALL CPYTXT ;COPY IF ANY HRROI T2,LNKUSR(X1) ;COPY NAME TOO ; LOOP FOR ALL ACTIVE WINDOWS MOVN X2,NUMUSR ;GET USER COUNT HRLZ X2,X2 ;AS -N,,0 FRCLOP: MOVE T1,WNDTAB(X2) ;GET WINDOW MOVE I,WNDLNK(T1) ;GET LINK CAMN I,X1 ;IS THIS THE NEW USER? JRST FRCBOT ; YES, DON'T SEND ;TELL OLDPERSON ABOUT NEWPERSON MOVEI T1,MS$3RD ;GET MESSAGE TYPE MOVE T3,LNKFLG(I) ;GET LINK FLAGS TLNN T3,(L$HELD) ;HOLDING US? CALL SNDMSG ; NO, SEND TRN ; IGNORE ERRORS ;TELL NEWPERSON ABOUT OLDPERSON HRROI T1,OLDNAM ;GET PLACE FOR FULL OLD NAME HRROI T2,LNKRUT(I) ;GET OLDPERSON ROUTE CALL CPYTXT ;COPY IN HRROI T2,LNKUSR(I) ;GET OLDPERSON NAME CALL CPYTXT ;COPY MOVE I,X1 ;SET LINK TO BE NEW PERSON MOVEI T1,MS$3RD ;GET MESS TYPE HRROI T2,OLDNAM ;GET ADDR OF OLD PERSON MOVE T3,LNKFLG(I) ;GET FLAGS FOR NEW PERSON TLNN T3,(L$HELD) ;HOLDING US? (ON THE FIRST DATE?) (SO SOON??) CALL SNDMSG ;SEND TO NEW PERSON TRN ; SIGH FRCBOT: AOBJN X1,FRCLOP ;LOOP FOR ALL WINDOWS RET ;WE SHOULD NOW BE IN TALK MODE ENDAV. SUBTTL INTERUPT LEVEL -- FORCED LINK XFORCE: ACVAR ;LOOP VAR STKVAR ;BP TO USER ID. MOVE T1,[POINT 8,DATADR,7] ;GET SOURCE USER XFRC.1: ILDB T2,T1 ;GET A BYTE JUMPN T2,XFRC.1 ;UNTIL END OF NAME CALL GETUSR ;PARSE TARGET OF FORCE RET ; FAILURE!! MOVEM T3,UID ;SAVE BP TO NODE::USER ; SEARCH ALL LINKS FOR THIS USER MOVSI X1,-MAXLNK ;SEARCH *ALL* LINKS XFRC.L: SKIPN I,LNKTAB(X1) ;GET LINK, IF ANY JRST XFRC.B ; NO LINK HRROI T1,LNKUSR(I) ;GET USER MOVE T2,UID ;GET NEWPERSON CALL CMPSTR ;MATCH? TRNA ; NO, KEEP LOOKING RET ; YES, CANNOT CREATE NEW LINK XFRC.B: AOBJN X1,XFRC.L ;LOOP MOVE T1,UID ;GET NEW PERSON CALL MAKLNK ;CREATE LINK RET ; SIGH. MOVE I,T1 ;SAVE LINK CALL NEWUSR ;ADD HIR PJRST CLSHUP ; NO!! HANGUP, AND CLOSE LINK!! CALL ERRLIN ;RIGHT PLACE TMSG <> ;BEEP! MOVE T1,[POINT 8,DATADR,7] ;GET REMOTE PSOUT ;SAY WHO MOVE X1,T1 ;SAVE BP TMSG < has set up a conference call with > MOVE T1,X1 ;GET BP BACK PSOUT RET ENDAV. ENDSV. SUBTTL INTERUPT LEVEL -- REJECT XREJ: TLNE FL,(F$DIAL) ;IN DIAL MODE? SKIPN T1,BSYLNK ;HACKING A LINK? RET ; NO, SPURIOUS HRROI T1,LNKUSR(T1) ;GET TARGET USER MOVE T2,[POINT 8,DATADR,7] ;GET REMOTE CALL CMPSTR ;COMPARE RET ; NOT WHO WE WANT CALL ERRLIN ;REPORT ON ERROR LINE MOVE T1,[POINT 8,DATADR,7] ;GET USER PSOUT ;TYPE TMSG < REJECTed!> ;OH BLISS CALL ENDERR PJRST BRKCAL ;CREAK THE CALL SUBTTL INTERUPT LEVEL -- PUT ON HOLD XHOLD: MOVE T1,[POINT 8,DATADR,7] ;GET USER CALL FNDLNK ;FIND ANY LINK RET ; NO SUCH ZONE MOVSI T2,(L$HELD) ;GET HELD FLAG IORM T2,LNKFLG(T1) ;SET FLAG IN LINK SKIPL LNKHLD(T1) ;DO WE HAVE THEM ON HOLD? RET ; YES, NO SCREEN CHANGE JUMPE W,CPOPJ ;IF NOT IN A WINDOW, PUNT MOVE T1,[POINT 8,DATADR,7] ;FIND USER CALL FNDUSR ;GET WINDOW RET ; HUH? MOVE T2,WNDLIN(T1) ;GET ORIGIN ADDI T2,1 ;STATUS LINE MOVEI T3,^D70 ;COLUMN TTY ;GO THERE TMSG <(Has you on hold)> ;MESS PJRST POSION ;RESTORE POSION SUBTTL INTERUPT LEVEL -- TAKEN OFF HOLD XUNHLD: MOVE T1,[POINT 8,DATADR,7] ;GET USER CALL FNDLNK ;FIND LINK BLOCK RET ; ?? MOVSI T2,(L$HELD) ;GET FLAG ANDCAM T2,LNKFLG(T1) ;CLEAR IN LINK JUMPE W,CPOPJ ;IF NO WINDOW, PUNT SKIPL LNKHLD(T1) ;WE HAVE THEM ON HOLD? RET ; YES, NO SCREEN CHANGE (NOT ON SCREEN) MOVE T1,[POINT 8,DATADR,7] ;FIND USER CALL FNDUSR ;GET WINDOW RET ; HUH? MOVE T2,WNDLIN(T1) ;GET ORIGIN ADDI T2,1 ;STATUS LINE MOVEI T3,^D70 ;COLUMN TTY ;GO THERE TTY ;CLEAR TO END OF LINE TMSG <> ;OH BOY!! PJRST POSION ;RESTORE POSION SUBTTL INTERUPT LEVEL -- CONVERSATION TEXT XTEXT: JUMPE W,CPOPJ ;NO CURRENT WINDOW? PUNT! MOVE T1,[POINT 8,DATADR,7] ;GET USER BP CALL FNDUSR ;SEARCH ACTIVE USERS FOR A MATCH RET ;SIGH PUSH P,W ;SAVE WINDOW MOVE W,T1 ;SET WINDOW CALL POSION ;POSITION CURSOR MOVE T1,[POINT 8,DATADR,7] ;POINT TO USER XTEXT0: ILDB T0,T1 ;GET NEXT JUMPN T0,XTEXT0 ;UNTIL END MOVEM T1,A0 ;STORE BP XTEXT1: ILDB T1,A0 ;GET CHARACTER JUMPE T1,XTEXT2 ; EOS? CALL ECHO ;ECHO IT JRST XTEXT1 ;LOOP XTEXT2: POP P,W ;RESTORE WINDOW PJRST POSION ;AND POSITION SUBTTL STRINGS -- COPY FROM T1 TO T2 W/ NULL CPYST0: CALL CPYSTR ;COPY SETZ T0, ;GET NULL IDPB T0,T2 ;TERMINATE RET SUBTTL STRINGS -- COPY FROM T1 TO T2 W/O NULL CPYSTR: CALL CHKBPS CPYST2: ILDB T0,T1 JUMPE T0,CPOPJ IDPB T0,T2 JRST CPYST2 SUBTTL STRINGS -- COPY FROM T2 TO T1; BACKUP OVER NULL CPYTXT: CALL CHKBPS CPYTX2: ILDB T0,T2 JUMPE T0,CPYTX3 IDPB T0,T1 JRST CPYTX2 CPYTX3: PUSH P,T1 ;SAVE DEST IDPB T0,T1 ;STORE ZERO BYTE POP P,T1 ;RESTORE BP RET SUBTTL STRINGS -- COMPARE STRINGS FOR EQUALITY ONLY (IGNORE CASE) ; T1/ bp1 ; T2/ bp2 ; CALL CMPSTR ; ; CMPSTR: CALL CHKBPS CMPST2: ILDB T3,T1 TRZ T3,40 ILDB T4,T2 TRZ T4,40 CAIE T3,(T4) ;EQUAL? RET ; YOU LOSE JUMPN T3,CMPST2 ;AT END? RETSKP SUBTTL STRINGS -- CHECK BYTE POINTERS CHKBPS: MOVEI T4,T2 ;CHECK T2 CALL CHKBYT ;DOIT CHKBT1: MOVEI T4,T1 ;CHECK T1 CHKBYT: HLRZ T0,(T4) ;GET BYTE POINTER CAIE T0,0 ;JUST AN ADDRESS CAIN T0,-1 ; OR FROM HRROI? MOVEI T0,(POINT 7,) ; YES, MAKE REAL BYTE POINTER HRLM T0,(T4) ;PUT BACK RET SUBTTL TYPE JSYS ERROR ERRPNT: CALL ERRLIN ;GO TO ERROR LINE HRROI T1,ERRSTR ;TYPE ON TTY MOVEI T2,"?" ;A QUESTION MARK BOUT ;OUTPUT IT HRLOI T2,.FHSLF ;THIS FORK, LAST ERROR SETZ T3, ;NO LIMIT ERSTR ;TYPE ERROR TRNA ; SIGH TRN ; SIGH SETZ T2, IDPB T2,T1 HRROI T1,ERRSTR SUBTTL SUPPORT FOR ERROR MACRO .ERROR: MOVEM T1,LSTERR ;(ERROR macro always adds a "?") CALL ERRLIN MOVE T1,LSTERR PSOUT PJRST ENDERR SUBTTL SUPPORT FOR FATAL MACRO .FATAL: ESOUT ;TYPE ERROR CALL CRLF ;TYPE CRLF HALTF ;STOP JRST .-1 ;THWART CONTINUE SUBTTL JSYS ERROR AND DEATH ERRHLT: DMOVEM T1,AC1 DMOVEM T3,AC3 CALL ERRPNT HALTF JRST .-1 SUBTTL TTY -- SAVE CCOC WORD SAVTTY: MOVEI T1,.PRIOU ;OUR TTY RFCOC ;GET CCOC WORD DMOVEM T2,TTYCOC ;SAVE IT MOVEI T2,.MORXO ;READ END OF PAGE MODE MTOPR MOVEM T3,TTYXOF SUBTTL TTY -- BLAST CCOC WORD SETTTY: MOVEI T1,.PRIOU ;OUR TTY DMOVE T2,[EXP 052532555125,252525452400] ;MAKE ^H, ^G, ^L, ESC SFCOC ;ECHO AS SELF MOVEI T2,.MOXOF ;SET END OF PAGE MODE MOVEI T3,.MOOFF ;OFF MTOPR RET SUBTTL TTY -- RESTORE CCOC WORD RESTTY: MOVEI T1,.PRIOU ;OUR TTY DMOVE T2,TTYCOC ;GET OLD BITS SFCOC MOVEI T2,.MOXOF MOVE T3,TTYXOF MTOPR RET SUBTTL TTY -- KILL ECHO NOECHO: MOVEI T1,.PRIIN ;OUR TTY RFMOD ;GET MODE WORD TRZ T2,TT%ECO ;CLEAR ECHO BIT SFMOD ;SET MODES RET SUBTTL TTY -- RESTORE ECHO YSECHO: MOVEI T1,.PRIIN ;OUR TTY RFMOD ;GET MODE WORD TRO T2,TT%ECO ;SET ECHO BIT SFMOD ;SET MODES RET SUBTTL TTY -- SKIP IF INPUT BUFFER EMPTY XSIBE: MOVEI T1,.PRIIN ;CHECK OUR TTY SIBE ;INPUT BUFFER EMPTY TRNA ; EMPTY CPOPJ1: AOS (P) CPOPJ: RET XHIBER: DISMS ;SLEEP RET PUTC: PBOUT ;TYPE A CHAR RET CRLF: TMSG < > RET SUBTTL TEXT CONVERSATION INPUT TEXT: MOVEI W,WNDBLK ;OUR WINDOW CALL EC.RES ;RESET OUR LINE BUFFER MOVEI T1,TXTLIN ;GOTO TOP OF WINDOW MOVEM T1,WNDLIN(W) ;STORE MOVEI T1,1 ;AND FIRST COL MOVEM T1,WNDCOL(W) ;STORE MOVE T1,[POINT 7,OURBUF] ;TEXT BUFFER MOVEM T1,OURPNT ;STORE MOVEI T1,OURSIZ*5-1 ;COUNT MOVEM T1,OURCNT ;STORE CALL IPOFF ;KILL INTERUPTS CALL ERRLIN ;GOTO ERROR LINE TTY ;BLAST SCREEN CALL BOXES ;SET UP BOXES FOR CONVERSATION CALL NOECHO ;CLEAR TTY ECHO CALL POSION ;SET CURSOR POSN CALL DOLOOK ;GOTO INPUT LOOP CALL YSECHO ;RESTORE ECHO RET SUBTTL LOOK -- Get character DOLOOK: ACVAR ;PERM AC LOOK: SKIPN NUMUSR ;ANY MORE USERS? RET ; NOPE TLNE FL,(F$REF) ;REFRESH NEEDED? CALL BOXES ; YES, SET UP NEW BOXES TLNE FL,(F$FAX) ;FACSIMILE? JRST LKFAX ; YES, HANDLE IT CALL XSIBE ;CHECK FOR INPUT JRST LKGET ; YES! GO GET IT TLNE FL,(F$TEXT) ;ANY TEXT TO SEND? JRST LOOK0 ; YES, SEND IT CALL IPON ;NO, INTERUPTS OK AGAIN LKHANG: PBIN ;WAIT FOR A CHAR PUSH P,T1 ;SAVE CHAR CALL IPOFF ;PROHIBIT INTERUPTS AGAIN POP P,T1 ;RESTORE CHAR JRST LKGOT ;PRINT IT LOOK0: CALL LKSEND ;SEND BUFFER TLZ FL,(F$TEXT) ;CLEAR TEXT FLAG JRST LOOK ;CONTINUE SUBTTL LOOK -- Send off OURBUF to all of our windows user's LKSEND: MOVE T1,OURCNT ;GET COUNT SUBI T1,OURSIZ*5-1 ;GET CHARS PERSENT JUMPE T1,CPOPJ ;IGNORE IF EMPTY SETZ T0, ;NULL IDPB T0,OURPNT ;TERMINATE TEXT MOVEI T1,MS$TXT ;CONVERSATION TEXT HRROI T2,OURBUF ;BUFFER CALL SNDALL ;SEND TO ALL WINDOWS MOVE T1,[POINT 7,OURBUF] ;TEXT BUFFER MOVEM T1,OURPNT ;STORE MOVEI T1,OURSIZ*5-1 ;COUNT MOVEM T1,OURCNT RET SUBTTL LOOK -- Get a FAX character LKFAX: HRROI T1,[ASCIZ ' ******** FAXSIMILE OF '] CALL FAXSTR HRROI T1,FAXFIL CALL FAXSTR HRROI T1,[ASCIZ ' ******** '] CALL FAXSTR LKFAX0: CALL IPOFF ;KILL INTERUPTS LKFAX1: CALL GETFAX ;GET A CHAR JRST FAXEOF ; EOF CAIN T1,LF ;END OF LINE? JRST LKFAX2 ; YES, SEND LINE, TOSS LF PUSH P,T1 ;SAVE IT CALL ECHO ;ECHO IT POP P,T1 ;RESTORE THE CHAR CALL LKPUT ;SEND IT JRST LKFAX1 ;LOOP LKFAX2: CALL IPON ;BREATHE CALL LKSEND ;SEND THE BUFFER CALL XSIBE ;INPUT BUFFER EMPTY? JRST FAXCAN ; NO, CANCELED JRST LKFAX0 ;START AGAIN FAXCAN: HRROI T1,[ASCIZ ' ******************* FACSIMILE CANCELED ******************* '] JRST FAXDON FAXEOF: HRROI T1,[ASCIZ ' ******************* END OF FACSIMILE ******************* '] FAXDON: CALL FAXSTR CALL IPON ;RESET IPCF INTERUPTS TLZ FL,(F$FAX) ;CLEAR FAX MODE MOVE T1,FAXJFN ;GET JFN CLOSF ;CLOSE IT TRN ; SHHH JRST LOOK ;START ANEW ; T1/ BP FAXSTR: CALL CHKBT1 ;CHECK FOR HRROI OR MOVEI MOVE X1,T1 ;SAVE BP FXSTR1: ILDB T1,X1 ;GET CHAR JUMPE T1,LKSEND PUSH P,T1 ;SAVE THE CHAR CALL ECHO POP P,T1 CALL LKPUT JRST FXSTR1 GETFAX: MOVE T1,FAXJFN ;GET FAXJFN BIN ;READ A CHAR (SLOWLY) ERJMP CPOPJ ; MUST BE END OF FILE! MOVE T1,T2 ;GET CHAR IN T1 RETSKP ;HAPPY RETURN SUBTTL LOOK -- User typed something LKGET: CALL IPOFF ;KILL INTERUPTS LKGET2: PBIN ;GET CHARACTER LKGOT: CAIGE T1," " ;PRINTABLE CHARACTER? JRST LKCTRL ; NO CAIN T1,DEL ;RUBOUT? JRST LKDEL ; YES CAMN T1,SWHOOK ;SWITCH-HOOK CHAR? RET ; YES, RETURN PUSH P,T1 ;SAVE CHAR CALL ECHO ;TYPE POP P,T1 ;RESTORE CHAR CALL LKPUT ;AND STORE LKGOT2: CALL XSIBE ;ANY MORE INPUT? JRST LKGET2 ; YES IFN SLPTIM,< MOVEI T1,SLPTIM ;NO, SLEEP A LITTLE CALL XHIBER ;ZZZ CALL XSIBE ;ANY NOW? JRST LKGET2 ;YES! > ;IFN SLPTIM JRST LOOK ;NO SUBTTL LOOK -- Deposit a character to be sent LKPUT: TLO FL,(F$TEXT) ;GOT SOME!! SOSGE OURCNT ;KEEP COUNT JRST [ PUSH P,T1 ; SAVE CHAR CALL LKSEND ; SEND STUFF POP P,T1 ; RESTORE JRST LKPUT ] ; TRY AGAIN IDPB T1,OURPNT ;PUT IN BUFFER RET SUBTTL LOOK -- Rubout was typed LKDEL: MOVE T2,WNDCOL(W) ;GET COLM CAIG T2,1 ;NOT FIRST? JRST LKDINK ; IF TOO FAR, DINK THEM CALL LKPUT ;SEND MOVEI T1,DEL ;GET A NEW ONE CALL ECHO ;TYPE IT JRST LKGOT2 SUBTTL LOOK -- Ignore extra rubouts LKDINK: MOVEI T1,1 ;COLMN 1 MOVEM T1,WNDCOL(W) ;STORE MOVEI T1,BEL CALL PUTC ;DINK! JRST LKGOT2 ;CONTINUE SUBTTL LOOK -- Some control character typed ; CONTROL-L SHOULD BE HANDLED HERE LKCTRL: CAIE T1,CR ;CR? IFSKP. PBIN ;YES, STEAL LF MOVEI T1,CR ;GET A CR TO SEND JRST LKCTR1 ;DO STUFF ENDIF. CAIE T1,TAB IFSKP. MOVE X1,WNDCOL(W) ;GET COLM ADDI X1,^D8 ;ADD TAB TRZ X1,7 ;MODULO SUB X1,WNDCOL(W) ;GET AMOUNT TO MOVE MOVEI T1," " ;GET A SPACE DO. CALL LKPECH SOJGE X1,TOP. ENDDO. JRST LOOK ;START ALL OVER ENDIF. CAIN T1,"W"-100 ;^W ?? MOVEI T1,LF ; SEND INSTEAD ; PERHAPS DUMP UNWANTED CHARACTERS HERE (IE; ^E ....) LKCTR1: CALL LKPECH ;PUT AND ECHO JRST LOOK LKPECH: PUSH P,T1 CALL LKPUT POP P,T1 PJRST ECHO ENDAV. ;{X1} SUBTTL Position self POSION: ACVAR MOVE X1,WNDLIN(W) ;GET LINE ADD X1,WNDORG(W) ;ADD WINDOW ORIGIN SUBI X1,1 ;MAKE 1 BASED MOVE X2,WNDCOL(W) ;AND COLM TTY ;MOVE, INDIRECT RET ENDAV. SUBTTL PHONE ERROR MESSAGES ; T1/ PROTOCOL ERROR CODE ; CALL ERRPHN ; ERRPHN: PUSH P,T1 ;SAVE CODE CALL ERRLIN ;GOTO ERROR LINE POP P,T2 ;RESTORE CODE HRRO T1,PHNTAB(T2) ;GET MESSAGE MOVEM T1,LSTERR ;SAVE TRNE T1,-1 ;ANY MESSAGE? PSOUT ; YES, TYPEIT ; MAKE CALL TO HERE AFTER DISPLAY OF ERROR ENDERR: TTY ;CLEAR REST OF LINE MOVE T1,ERRPSE ;PAUSE INTERVAL DISMS RET SUBTTL GOTO ERROR LINE ERRLIN: TTY RET SUBTTL GOTO PROMPT LINE PMTLIN: TTY RET PHNTAB: [ASCIZ '?Some error occured'] [0] [ASCIZ '?User identification syntactically invalid'] [ASCIZ '?Slave error'] [ASCIZ '?Missing user name'] [ASCIZ '?Slave is not privileged'] [ASCIZ '?User does not exist'] [ASCIZ '?User is not at a PHONE'] [ASCIZ '?User has logged off'] [ASCIZ "?User's PHONE is off the hook"] EXP UNK,UNK,UNK UNK: ASCIZ '?Illegal status code returned' SUBTTL PARSE -- ROUTE STRING ;Take a route to a host, and fix so it looks like our route for it ;Assumes data of form {[_]NODE::} ; ie; converts A::B::C:: ; to B::A:: ; C:: is dropped since it will be the target node of the link. ; T1/ BP to dest ; T2/ BP to source REVRUT: CALL CHKBPS ;CONVERT -1,,N TO BP CALL REVRU2 TRN SETZ T3, IDPB T3,T1 RET ; Recursive helper REVRU2: STKVAR <> MOVEI T4,BUF HRLI T4,(POINT 7,) SETZM BUF ILDB T3,T2 ;GET FIRST CAIN T3,"_" ;VAX QUOTE CHAR? REV.1: ILDB T3,T2 ; YES, GET NEXT CHAR JUMPE T3,CPOPJ ;END OF STRING??? CAIN T3,":" ;END OF NODE? JRST REV.2 IDPB T3,T4 JRST REV.1 REV.2: ILDB T3,T2 ;GET NEXT BYTE (SECOND COLON) SETZ T3, IDPB T3,T4 ;TIE OFF BUFFER CALL REVRU2 ;PARSE NEXT NODE RETSKP ; GOT EOS? SKIPN BUF ;GOT A NODE? RET ; NOPE. HRROI T2,BUF ;GET PTR TO STRING CALL CPYTXT ;COPY IN MOVEI T2,":" IDPB T2,T1 IDPB T2,T1 RETSKP ENDAV. SUBTTL PARSE -- USER ID STRING ;Parse user id string from another user ;Assumes data of form {[_]NODE::}[_]OURNODE::LUSER ; T1/ bp to user id ; CALL GETUSR ; ; ; T2/ BP to USER ; T3/ BP to last NODE:: ; T4/ flag,,count GETUSR: CALL CHKBT1 ;CHECK BP IN T1 MOVE T3,T1 ;SETUP BP TO BEFORE LAST NODE:: MOVE T2,T1 ;SETUP BP TO AFTER END OF LAST NODE:: SETZ T4, ;ZERO COUNT ;Here to start field GU.1: ILDB T0,T1 ;GET NEXT CHAR CAIE T0,"_" ;VAX QUOTE CHAR? JRST GU.2 ; NO, CHECK IT OUT MOVSI T4,1 ;ZERO COUNT, SET NODE FLAG ;Here to parse text GU.L: ILDB T0,T1 ;GET ANOTHER GU.2: JUMPE T0,GU.3 ;END OF STRING CAIE T0,":" ;A COLEN? AOJA T4,GU.L ; NO, KEEP LOOKING ILDB T0,T1 ;GET NEXT BYTE CAIN T0,":" ;BETTER BE A ":" TRNN T4,-1 ; YES, ANY COUNT? RET ; NO; NULL FIELD, OR ONLY ONE ":" MOVE T3,T2 ;SAVE START OF LAST NODE MOVE T2,T1 ;MIGHT BE LAST NODE IN LIST, SAVE BP TO USER SETZ T4, ;ZERO COUNT JRST GU.1 ;START AGAIN GU.3: TLNN T4,1 ;LAST FIELD HAVE AN "_" ? CAMN T2,T3 ; NO, PARSE ANYTHING? RET ; NOTHING PARSED OR USER BEGAN WITH "_" TRNN T4,-1 ;EMPTY FIELD? RET ; YES. (FOO::) RETSKP SUBTTL LINKS -- MAKE A CONNECTION ;Make a connection on current link ; T1/ user id ; I/ link ptr ; CALL MAKCON ; ; MAKCON: STKVAR <,SAVCON,SAVUSR,SAVUNO>; BUFFER, DN.HST, BP, USRBP MOVEM T1,SAVUSR ;SAVE USER CALL GETUSR ;PARSE JRST MK.BD ; BAD MOVEM T2,SAVUNO ;SAVE BP TO USER MOVE T1,[POINT 7,TARGET] ;TARGET NODE MK.L: ILDB T0,T3 ;GET BYTE CAIN T0,":" ;END OF NODE JRST MK.E ; YES IDPB T0,T1 ;COPY JUMPN T0,MK.L ;LOOP UNTIL EOS MK.BD: HRROI T1,[ASCIZ "Bad user string"] RET ;ERROR MK.E: SETZ T0, ;NULL IDPB T0,T1 IFN LOCALF,< HRROI T1,TARGET ;GET BP HRROI T2,OURNOD ;OUR NODE CALL CMPSTR ;MAKE LOCAL CONNECTION? JRST MK.DCN ; NO MOVSI T1,(RC%EMO) ;GET EXACT MATCH MOVE T2,SAVUNO ;GET BP SETZ T3, RCUSR ;GET OPERATOR USER NUMBER ERJMP MK.UNK ; UNKNOWN JUMPE T3,MK.UNK ;DITTO MOVEM T3,LNKUNO(I) ;SAVE USER NUMBER MOVEI T1,LT$LCL ;LINK TYPE HRRM T1,LNKFLG(I) ;STORE SETZM LNKJFN(I) ;NO PID AS YET RETSKP MK.UNK: HRROI T1,[ASCIZ 'User does not exist'] RET > ;IFN LOCALF MK.DCN: MOVEI T1,LT$DCN ;DECNET HRRM T1,LNKFLG(I) ;STORE HRROI T1,TARGET PJRST OPNCON ENDAV. SUBTTL LINKS -- OPEN A DECNET CONNECTION ; T1/ BP TO HOST ; I/ PTR TO LINK ; CALL OPNCON ; ; ; OPNCON: STKVAR ;HOST BP, SAVED HOST MOVEM T1,HOSTBP ;SAVE BP ; Here to create DECnet link. Node is in TARGET. OP.DCN: MOVE T1,CONBLK+DN.HST ;SAVE OLD HOST PTR MOVEM T1,SAVEBP ;SAVE MOVE T1,HOSTBP ;GET TARGET NODE MOVEM T1,CONBLK+DN.HST ;STORE FOR DNCONN MOVEI T1,CONBLK ;GET CONNECT BLOCK SETZ T2, CALL .DNCON## ;TRY TO CONNECT JRST [ MOVE T2,SAVEBP ;GET OLD HOST MOVEM T2,CONBLK+DN.HST ;RESTORE RET ] ;RETURN ERROR (STRING IN T1) MOVEM T1,LNKJFN(I) ;SAVE JFN HRROI T1,LNKRUT(I) ;WHERE TO STORE RETURN ROUTE CAIN T2,0 ;GET A ROUTE? SKIPA T2,[-1,,[0]] ;GET BOGUS ROUTE HRROI T2,2(T2) ;GET BP TO ROUTE CALL REVRUT ;STORE INVERSE ROUTE MOVE T2,SAVEBP ;GET OLD HOST MOVEM T2,CONBLK+DN.HST ;RESTORE CONNECT BLOCK RETSKP ENDSV. SUBTTL LINKS -- MAKE A MESSAGE ; T1/ Message code ; T2/ BP to data or 0 ; I/ Link ; CALL MAKMSG ; T2/ Pointer into message buffer MAKMSG: ACVAR ;SAVE CODE and DATA MOVEM T1,LSTCOD ;STORE LAST CODE SENT MOVE COD,T1 ;SAVE LAST CODE MOVE DATA,T2 HRRZ T2,LNKFLG(I) ;GET LINK TYPE MOVE T2,[POINT 8,LNKSND(I) ;BP FOR DECNET POINT 8,SNDADR ;BP FOR IPCF ](T2) ;GET BP IDPB COD,T2 ;STORE CODE HRROI T1,LNKRUT(I) ;GET ROUTE BACK TO US CALL CPYSTR ;COPY IT IN HRROI T1,US ;STRING FOR US CALL CPYST0 ;COPY IN SKIPN T1,DATA ;RESTORE DATA, IF ANY RET ; NONE CAIE COD,MS$RNG ;RING MESSAGE? PJRST CPYSTR ; NO, BE SLOPPY CALL CHKBT1 ;MAKE SURE WE HAVE A BP ILDB T1,T1 ;GET JUST ONE BYTE IDPB T1,T2 ;STORE IN MESSAGE RET ;DONE! ENDAV. ;{COD,DATA} SUBTTL LINKS -- SEND A MESSAGE, W/ STATUS ;Send a message ; T1/ Code ; T2/ BP to data ; I/ Link ; CALL SNDMSG ; ; ; T1/ Status ; T2/ BP to data ; T3/ Count SNDMSG: PUSH P,T1 ;SAVE CODE CALL MAKMSG ;CREATE MESS PUSH P,T2 ;SAVE BP CALL IPOFF ;PROTECT AGAINST PI POP P,T2 POP P,T1 ;RESTORE CODE HRRZ T5,LNKFLG(I) ;GET LINK TYPE CALL @[ SM.DCN ; DECNET CONNECTION SM.LCL ](T5) ; LOCAL CONNECTION (IPCF) PUSH P,T1 ;SAVE STATUE PUSH P,T2 ;SAVE BP CALL IPON POP P,T2 POP P,T1 CAIN T1,ST$AOK ;OK? RETSKP RET SUBTTL LINKS -- SEND HANGUP AND CLOSE ;Send hangup and Close link ; no args CLSHUP: MOVEI T1,MS$HUP ;HANG UP SETZ T2, ;NO DATA SUBTTL LINKS -- SEND ANY MESSAGE AND CLOSE ;Close link with final message ; T1/ CODE ; T2/ DATA CLSMSG: PUSH P,T1 ;SAVE MESS CALL SNDMSG ;SEND FINAL MESSAGE TRN POP P,T1 ;RESTORE MESS CAIN T1,MS$DON ; DONE? PJRST CLSDON ;YES, SO ARE WE MOVEI T1,MS$DON ;SEND DONE SETZ T2, ;NO DATA CALL SNDMSG ;SHOVE IT OFF TRN ; IGNORE TRNA SNDERR: CALL ERRPHN ;NO, TYPE ERROR CLSDON: HRRZ T1,LNKFLG(I) ;GET LINK TYPE CAIE T1,LT$DCN ;DECNET LINK? JRST CLS.1 ; NO, JUST FREE THE BLOCK MOVE T1,LNKJFN(I) ;GET LINK JFN TLO T1,(CZ%ABT) ;ABORT LINK CLOSF ERJMP .+1 CLS.1: SETZM LNKJFN(I) ;CLEAR JFN / PID MOVE T1,I PJRST FRELNK SUBTTL LINKS -- CREATE NEW LINK BLOCK ;Create a new Link block ; T1/ BP to user ; CALL NEWLNK NEWLNK: PUSH P,T1 ;SAVE USER CALL GETLNK HRROI T2,LNKUSR(T1) ;GET ADDR FOR USER EXCH T1,(P) ;GET USER NAME CAIE T1,0 ;NULL? CALL CPYST0 ; NO, COPY IN POP P,T1 ;RESTORE LINK SETOM LNKHLD(T1) ;CLEAR HOLD LEVEL RET SUBTTL LINKS -- CREATE A NEW LINK AND CONNECT IT ;Create new link & connect to it ; T1/ BP to user ; CALL MAKLNK ; ; ; T1/ ^LINK MAKLNK: STKVAR MOVEM T1,USR ;SAVE USER NAME MOVEM I,LNK ;SAVE CURRENT LINK CALL NEWLNK ;MAKE LINK MOVE I,T1 ;GET NEW LINK MOVE T1,USR ;GET USER CALL MAKCON ;MAKE CONNECTION JRST MKL.ER ; SIGH MOVEI T1,MS$CHK ;CHECK USER MOVE T2,USR ;GET USER CALL SNDMSG ;SEND IT OFF JRST [ HRRO T1,PHNTAB(T1) ;GET ERROR JRST MKL.ER ] AOS (P) ;HAPPY RETURN MOVE T1,I ;RETURN LINK TRNA MKL.ER: MOVEM T1,LSTERR ;SAVE ERROR BP MOVE I,LNK ;RESTORE LINK RET ENDSV. SUBTTL LINKS -- SAVE A LINK IN LINK TABLE ; T1/ LINK SAVLNK: MOVSI T2,-MAXLNK ;SEARCH ALL LINKS SV.LP1: SKIPE T3,LNKTAB(T2) ;EMPTY? CAME T1,T3 ; ALREADY EXISTS? AOBJN T2,SV.LP1 ;KEEP LOOKING JUMPL T2,SV.SKP ;FOUND! MOVSI T2,-MAXLNK ;SEARCH ALL LINKS SV.LOP: SKIPE LNKTAB(T2) ;EMPTY? AOBJN T2,SV.LOP ; NO JUMPGE T2,CPOPJ ;NO FREE SLOTS MOVEM T1,LNKTAB(T2) ;STORE SV.SKP: RETSKP SUBTTL LINKS -- SEARCH FOR A USER ; T1/ user FNDLNK: ACVAR MOVE X2,T1 ;SAVE USER MOVSI X1,-MAXLNK ;FOR ALL LINKS FL.LOP: SKIPN T1,LNKTAB(X1) ;GET LINK, IF ANY JRST FL.BOT ; NONE HRROI T1,LNKUSR(T1) ;GET USER MOVE T2,X2 ;GET TARGET CALL CMPSTR ;NO, COMPARE TRNA ; NO MATCH JRST FL.WIN ; A WINNER! FL.BOT: AOBJN X1,FL.LOP ;NO, GUESS AGAIN RET ;YOU LOSE FL.WIN: MOVE T1,LNKTAB(X1) ;RETURN LINK RETSKP ENDAV. SUBTTL DECNET -- COUNT AND SEND MESSAGE ;Output text in LNKSND(I) to DECnet ; T2/ updated BP ; I/ link index ; CALL DECOUT DECOUT: MOVEI T1,@T2 ;GET THE ADDRESS PART OF NEW BP SUBI T1,LNKSND(I) ;GET THE DIFFERENCE ASH T1,2 ;MAKE IT INTO 8 BIT BYTE COUNT MOVE T4,T2 ;PRESERVE THE BYTE POINTER LDB T2,[POINT 6,T4,6+5] ;GET S FIELD OF BYTE POINTER CAIE T2,^D8 ;IS IT EIGHT BITS? FATAL (BP not 8 bit) ; YOU LOSE LDB T2,[POINT 6,T4,5] ;GET P FIELD OF BYTE POINTER SUBI T2,4 ;P STARTS AT THE RIGHT ASH T2,-3 ;DIVIDE BY EIGHT SUBI T2,4 ;REVERSE THE ORDER SUB T1,T2 ;FIGURE OUT THE FINAL COUNT MOVNI T3,(T1) ;PREPARE FOR SOUT SUBTTL DECNET -- SEND COUNTED MESSAGE ;Send counted text in LNKSND(I) via DECnet ; T3/ -count ; I/ link ptr DECCNT: SKIPN T1,LNKJFN(I) ;DECNET JFN RET ; IGNORE IF NO JFN MOVE T2,[POINT 8,LNKSND(I)] ;SEND BUFFER SOUTR ;OUTPUT RECORD ERJMP .+1 RET SUBTTL DECNET -- GET TEXT WITH TIMEOUT ;Get text from DECnet ; I/ link ; CALL DECIN ; T1/ Status Code ; T2/ BP to data ; T3/ Byte count WAIT4==^D10 ;THIS MANY SECONDS TOTAL WAITIN==^D100 ;IN THIS INCREMENT (IN MS.) DECIN: MOVE T1,LSTCOD ;GET LAST CODE FROM MAKMSG CAIE T1,MS$CHK ;CHECK? CAIN T1,MS$RNG ; OR RING? TRNA ; OK RET ; HUH???? MOVEI T4,/WAITIN ;NUMBER OF ITERATIONS DECINC: SKIPG T1,LNKJFN(I) ;GET NET JFN JRST DECIER ; NONE! SIBE ;ANY DATA (0 LENGTH RECORD NEVER SEEN!!!) JRST DECINW ; YES, GOT IT!! MOVEI T1,WAITIN DISMS SOJG T4,DECINC ;CHECK AGAIN ; JRST DECIER ;DATA TIMEOUT SUBTTL DECNET -- GET MESSAGE W/O TIMEOUT DECINW: SKIPG T1,LNKJFN(I) ;GET NET JFN JRST DECIER ; NONE!!! MOVE T2,[POINT 8,LNKRCV(I)] ;PUT IN RECIEVE BUFFER MOVNI T3,BUFSIZ ;COUNT SINR ;READ A RECORD ERJMP DECIER ; I/O ERROR JRST DECIOK DECIER: SETZM LNKRCV(I) ;CLEAR BUFFER MOVEI T1,ST$AOK ;ASSUME OK MOVEI T2,LNKRCV(I) ;GET ADDR HRLI T2,(POINT 8,) ;MAKE INTO BP SETZ T3, ;PRETEND WE READ NADA RET DECIOK: SETZ T1, ;GET NULL IDPB T1,T2 ;TIE OFF STRING MOVEI T2,LNKRCV(I) ;GET ADDR HRLI T2,(POINT 8,) ;MAKE INTO BP ADDI T3,BUFSIZ ;GET COUNT MOVEI T1,ST$OTH ;OTHER ERROR JUMPE T3,CPOPJ ;RETURN ERROR STATUS LDB T1,[POINT 8,LNKRCV(I),7] ;GET STATUS RET SUBTTL DECNET -- SEND A MESSAGE, W/ STATUS ; SEND MESSAGE OVER DECNET ; T1/ MESSAGE CODE SM.DCN: PUSH P,T1 ;SAVE CODE CALL DECOUT ;SEND POP P,T1 ;RESTORE CODE CAIE T1,MS$CHK ;CHECK USER? CAIN T1,MS$RNG ; OR RING? PJRST DECIN ;GET STATUS W/ TIMEOUT??? MOVEI T1,ST$AOK ;ELSE RETURN FINE RET SUBTTL LOCAL -- SEND A MESSAGE, W/ STATUS ; SEND MESSAGE (AT SNDADR) VIA IPCF SM.LCL: LDB T1,[POINT 8,SNDADR,7] ;GET CODE SKIPN T1,LCLTAB(T1) ;GET ROUTINE PJRST RETAOK ; RETURN AOK! PJRST (T1) ;HANDLE LOCAL MESSAGE LCLTAB: PHASE 0 ;*** FUNCTION DISPATCH *** ACTION MS$CHK,LCHECK ;Check out user ACTION MS$RNG,LRING ;Ring phone ACTION MS$HUP,FORWRD ;Remote has hung up ACTION MS$BSY,FORWRD ;Master is busy ACTION MS$ANS,FORWRD ;Phone answered ACTION MS$REJ,FORWRD ;Call rejected ACTION MS$TXT,FORWRD ;Conversation text ACTION MS$3RD,FORWRD ;Add third party ACTION MS$HLD,FORWRD ;Put PHONE on hold ACTION MS$OFF,FORWRD ;Take PHONE off hold MAXDSP==.-1 DEPHASE ; HERE TO SEND DATA IN SNDPAG FORWRD: SKIPE T1,LNKJFN(I) ;GET PID CALL SIPCF ; SEND IPCF PAGE RETOTH: TDZA T1,T1 ; "SOME OTHER ERROR" RETAOK: MOVEI T1,ST$AOK ; "ALL OK" RET SUBTTL LOCAL -- CHECK FOR USER ; I/ ^LINK W/ USER# FILLED IN LCHECK: ACVAR ;LOOP VAR, ERROR REASON, IF ANY SKIPN LNKUNO(I) ;CHECK FOR USER NUMBER JRST RETOTH ; SHOULD NEVER HAPPEN MOVE X1,JOBAOB ;GET JOB AOBJN MOVEI X2,ST$UNE ;DEFAULT REASON: USER DOES NOT EXIST LCH.1: MOVEI T1,(X1) ;GET JOB MOVE T2,[-2,,T4] ;RETURN IN T4, T5 MOVEI T3,.JITNO ;RETURN TTY, USER NUMBER GETJI ;GET JOB INFO JRST LCH.B ; NO JOB JUMPL T4,LCH.B ;DETACHED? CAME T5,LNKUNO(I) ;RIGHT STUFF? JRST LCH.B ; NOPE MOVEI T1,.TTDES(T4) ;GET TTY DESC GTTYP ;GET TTY TYPE IFJER. MOVEI X2,ST$SNP ;SLAVE LACKS PRIVS JRST LCH.B ;LOOP ENDIF. SKIPE VTXDSP(T2) ;CHECK IF GOOD TTY TYPE IFSKP. MOVEI X2,ST$TTY ;LOSING TTY TYPE JRST LCH.B ;LOOP ENDIF. MOVEI T1,.TTDES(T4) ;GET TTY DESC CALL CHKLNK ;CHECK IF OFF THE HOOK SKIPA X2,[ST$OFF] ; YES JRST LCH.U ; NO!! WE HAVE A WINNER! LCH.B: AOBJN X1,LCH.1 ;LOOP MOVE T1,X2 ;GET REASON RET ;AND FAIL ; THERE EXISTS AT LEAST ONE GOOD JOB: DOES ONE HAVE THE PID? LCH.U: CALL FNDUNO ;FIND PID TRNA MOVEM T1,LNKJFN(I) ;FOUND! - SAVE IT (WHAT ABOUT OLD VALUE?) MOVEI T1,ST$AOK RET ENDAV. SUBTTL LOCAL -- RING ; I/ ^LINK ; AREA IS NON-ZERO ON FIRST RING LRING: CALL FNDUNO ;CHECK FOR A PID JRST RG.MES ; NONE, JUST SEND VIA TTMSG PUSH P,T1 ;SAVE NEW PID CALL CHKPID ;FIND OWNER SETO T1, ; LOSER MOVEM T1,LNKJOB(I) ;SAVE, TO AVOID DOING LOCAL SENDS TO OWNER POP P,T1 ;RESTORE PID CAMN T1,LNKJFN(I) ;SAME PID AS LAST TIME? JRST RG.FWD ; YES, JUST FORWARD ;Here with a new PID MOVEM T1,LNKJFN(I) ;NO, SAVE NEW PID SKIPN T1,AREA ;WAS SOME PAST RING THE FIRST? JRST RG.FWD ; NO, THIS ONE *SHOULD* BE ;Here with a new PID, after first ring sent: forward with flag set MOVSI T1,() ;FIRST RING FLAG MOVEM T1,AREA ;STORE ;Here to send an IPCF ring RG.FWD: CAIE T1,0 ;WAS THIS RING THE FIRST? CALL LCLRNG ; YES, DO LOCAL RING FIRST TRN ; NO+IGNORE ERROR MOVEI T1,MS$RNG ;RING HRROI T2,AREA ;NEW DATA CALL MAKMSG ;CREATE MESS CALL FORWRD ;SEND! TRN RET RG.MES: CALL LCLRNG ;DO LOCAL RING TRN RET SUBTTL LOCAL -- SEND RING TEXT ;Creates message text in TMPSTR buffer and send to all suitable users ; CALL LCLRNG ; ; ; T1/ STATUS LCLRNG: ACVAR HRROI T1,TMPSTR ;POINT TO BUFFER HRROI T2,[BYTE(7)CR,LF,0] CALL CPYTXT HRROI T2,OURNAM ;OUR NAME CALL CPYTXT MOVEI T2,[ASCIZ/ is calling you at /] CALL CPYTXT TLNN FL,(F$DECN) ;HAVE NETWORK? IFSKP. MOVEI T2,OURNOD ;NODE NAME CALL CPYTXT MOVEI T2,[ASCIZ/ on /] CALL CPYTXT ENDIF. SETOB T2,T3 ;NOW, FANCY ODTIM ;OUTPUT ERJMP .+1 ; FUEY! MOVEI T2,[BYTE(7) BEL,BEL,BEL,CR,LF,0] ;DING**3, CRLF CALL CPYTXT ;Now loop for all jobs, and blat the OK ones. LR.BEG: MOVE X1,[1-MAXJOB,,1] ;AOBJN COUNT SETZB X2,X3 ;COUNT OF MATCHES, SENDS LR.LOP: MOVEI T1,(X1) ;GET JOB MOVE T2,[-.JISTM-1,,GJIBLK] ;BUFFER SETZ T3, ;START AT JOB GETJI ;GET INFO JRST LR.BOT ; U LOSE MOVE T2,LNKUNO(I) ;GET USER NUMBER CAME T2,GJIBLK+.JIUNO ;MATCH JRST LR.BOT ; NO, KEEP LOOKIN SKIPG T1,GJIBLK+.JITNO ;CHECK TERMINAL NUMBER JRST LR.BOT ; DETACHED ADDI X2,1 ;INCR MATCHES MOVE T2,LNKJOB(I) ;GET JOB CAIN T2,(X1) ;MATCH? SKIPE AREA ; FIRST RING? TRNA ; NO MATCH, OR FIRST RING JRST LR.BOT ; MATCH, NOT FIRST RING, DON'T SEND MOVE T1,GJIBLK+.JITNO ;GET TTY AGAIN MOVEI T1,.TTDES(T1) ;MAKE DEVICE HRROI T2,TMPSTR ;GET TEXT TTMSG ;SHOVE BELOW SPY LEVEL ERJMP [SETZ T3, ; TERMINATE ON ZERO. SOUT ; TRY WITH SOUT ERJMP .+1 ; IGNORE ERROR JRST .+1 ] ;KEEP GOING ADDI X3,1 ;INCR SENDS LR.BOT: AOBJN X1,LR.LOP ;...LOOP FOR ALL JOBS MOVEI T1,ST$AOK ;GET GOOD STS JUMPN X3,CPOPJ1 ;AOK IF ANY SENDS DONE MOVEI T1,ST$TTY ;ASSUME BAD TTY CAIG X2,0 ;ANY MATCHES? MOVEI T1,ST$LOG ; NO, "USER LOGGED OFF" RET ENDAV. SUBTTL LOCAL -- DIRECTORY LDIR: SETZ T5, ;COLM MOVE T4,[440700,,TMPSTR] AOS T1,JOBNUM ;GET NEXT JOB NUMBER CAILE T1,MAXJOB ;IN RANGE? JRST [ SETZ T3, ; ZERO LENGTH RET ] ;RETURN MOVE T2,[-.JIBAT-1,,GJIBLK] ;WHAT TO STORE WHERE SETZ T3, ;START AT BEGINING GETJI ;GET JOB INFO JRST LDIR ;NO JOB, GET NEXT SKIPE T1,GJIBLK+.JIUNO ;LOGGED IN? CAMN T1,OPRUNO ; SKIP JRST LDIR ; GET ANOTHER SKIPN GJIBLK+.JIBAT ;BATCH? SKIPGE GJIBLK+.JITNO ; ATTACHED? JRST LDIR ; RE-JECT MOVE T2,GJIBLK+.JIPNM ;PROGRAM NAME? CALL SIXTYP ;TYPE "PROCESS NAME" MOVEI T1,"I"-100 ;TAB CALL COLTYP ;OUTPUT CALL COLTYP ;AGAIN HRROI T1,TEMP2 ;BP MOVE T2,GJIBLK+.JIUNO ;GET USER NUMBER AGAIN DIRST ;CONVERT TO STRING ERJMP LDIR ;SIGH! SETZ T2, ;GET A NULL IDPB T2,T1 ;TIE OFF STRING MOVEI T2,TEMP2 ;GET NAME CALL STRTYP ;OUTPUT IT MOVEI T1," " ;TERMINATE WITH A SPACE CALL COLTYP ;TA DAH MOVEI T1,"I"-100 ;GET A TAB PADLOP: CAIGE T5,^D32 ;THERE YET? JRST [ CALL COLTYP ;PAD WITH TABS JRST PADLOP ] ;CONTINUE MOVE T2,GJIBLK+.JITNO ;GET TERMINAL NUMBER MOVEI T1,.TTDES(T2) ;GET DEVICE DESC GTTYP ;GET TYPE ERJMP UNUSE ; SIGH SKIPN VTXDSP(T2) ;KNOWN? UNUSE: JRST [MOVEI T2,[ASCIZ/unusable ---/] JRST DIRR2] MOVE T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER MOVEI T2,[ASCIZ /TTY/] ;ASS-U-ME IT IS A TTY ;; CAML T1,PTYPAR ;IS IT A PTY? ;; MOVEI T2,[ASCIZ /PTY/] ; YES... CALL STRTYP ;WRITE PREFIX MOVE T2,GJIBLK+.JITNO ;GET TTY NUMBER CAML T2,PTYPAR ;A PTY? SUB T2,PTYPAR ; YES, REMOVE OFFSET CALL OCTTYP ;OUTPUT NUMBER MOVE T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER MOVEI T1,.TTDES(T1) ;GET TERMINAL DEVICE DESC CALL CHKLNK ;ALLOW LINKS ? SKIPA T2,[[ASCIZ " refuse links/user messages"]] MOVEI T2,[ASCIZ " available"] DIRR2: CALL STRTYP DIRR3: SETZ T1, CALL COLTYP MOVE T2,[POINT 7,TMPSTR] MOVEI T3,^D69 ;RETURN W/ LENGTH RET ; T2/ ADDR OF ASCIZ STRING STRTYP: HRLI T2,(POINT 7,) STRTY2: ILDB T1,T2 JUMPE T1,CPOPJ CALL COLTYP JRST STRTY2 ; T2/ SIXBIT SIXTYP: MOVEI T3,6 SIXTY2: SETZ T1, LSHC T1,6 ADDI T1," " CALL COLTYP SOJG T3,SIXTY2 RET ; T2/ OCTAL OCTTYP: IDIVI T2,10 HRLM T3,(P) CAIE T2,0 CALL OCTTYP HLRZ T1,(P) ADDI T1,"0" COLTYP: IDPB T1,T4 CAIE T1,"I"-100 AOJA T5,COLRET ADDI T5,^D8 TRZ T5,^D8-1 COLRET: RET ; CHECK IF TTY OFF THE HOOK ; T1/ TTY DES ; CALL CHKLNK ; ; CHKLNK: MOVEI T2,.MORTF ;NEW FANGLED TERMINAL BITS MTOPR ;READ THEM ERJMP CHKLN2 ; OLD MONITOR? TRNE T3,MO%NUM+MO%NTM ;USER MESS/NON-JOB OUTPUT SUPRESS? RET ; YES, THATS FINAL JRST CPOPJ1 ;** NO, IGNORE LINKS BIT CHKLN2: RFMOD ;GET TERMINAL JFN MODE WORD ERJMP CPOPJ ;WHOOPS! TRNE T2,TT%ALK ;ALLOW LINKS ? AOS (P) ;YES. RET ;NO. SUBTTL WINDOWS -- ECHO ;Add a character to a window in talk mode ; T1/ char ; W/ ^window ; CALL ECHO ECHO: JUMPE T1,CPOPJ ;IGNORE NULL CAIGE T1," " ;PRINTABLE? JRST EC.CTL ; NO CAIN T1,DEL ;RUBOUT? JRST EC.DEL ; YES CALL PUTC ;NO, TYPE IT IDPB T1,WNDLBP(W) ;STORE IN LINE BUF AOS T2,WNDCOL(W) ;INCR COLMN (WHAT ABOUT EDGE?) CAIG T2,^D75 ;BEYOND COLM 75 ****** MAGIC NUMBER ****** RET ; NO, DONE MOVEI T1,CR ;GET A JRST ECHO ;SEND IT! ;Rubout EC.DEL: SETZ T1, ;RETURN NULL MOVEI T2,1 SOSG T3,WNDCOL(W) ;DECREMENT MOVEM T2,WNDCOL(W) ; TOO FAR? JUMPLE T3,CPOPJ ;YEP. HRROI T1,[BYTE (7)BS," ",BS] ;ERASE PSOUT ;TYPE IT LDB T1,WNDLBP(W) ;GET CHAR DELETED SETO T2, ;GET MINUS 1 ADJBP T2,WNDLBP(W) ;BACKUP LINE BP MOVEM T2,WNDLBP(W) ;STORE RET ;DONE ;Got control character EC.CTL: CAIN T1,"U"-100 ;CONTROL-U? JRST EC.CTU ; YES. CAIN T1,CR ;CR? JRST EC.CR ; YES CAIN T1,LF ;LF? JRST EC.LF ; YES CAIN T1,BEL JRST EC.BEL RET ;LOSER EC.BEL: PBOUT ;HERE FOR BELL RET EC.CTU: MOVEI T1,1 ;CONTROL-U MOVEM T1,WNDCOL(W) ;GO TO START OF LINE MOVEI T1,CR ;GET A CR CALL PUTC ;GO TO START OF LINE TTY ;CLEAR TO EOL EC.RES: MOVEI T1,WNDLBF(W) ;GET BUFFER ADDR HRLI T1,(POINT 7,) ;MAKE INTO BP MOVEM T1,WNDLBP(W) ;RESET LINE BUFFER PTR RET ;DONE EC.CR: CALL EC.RES ;RESET LINE BUF MOVEI T1,1 ;START OF LINE MOVEM T1,WNDCOL(W) ;STORE AOS T1,WNDLIN(W) ;STEP TO NEXT LINE CAMLE T1,WNDSIZ(W) ;STILL IN RANGE? JRST [ MOVEI T1,TXTLIN ; NO, GET TOP OF TEXT MOVEM T1,WNDLIN(W) ;STORE CALL POSION ;FORCE POSITION JRST EC.CR2 ] ;JOIN THE REST OF HUMANITY HRROI T1,[BYTE(7)CR,LF] PSOUT ;ECHO CRLF EC.CR2: TTY ;ERASE TO END OF NEW TEXT LINE MOVE T1,WNDLIN(W) ;GET LINE AGAIN CAME T1,WNDSIZ(W) ;BOTTOM? JRST [ HRROI T1,[BYTE(7)CR,LF] ;NO, CLEAR NEXT LINE PSOUT ;TYPE TTY ;CLEAR IT PJRST POSION ] ;GOTO RIGHT POSN MOVE T1,WNDORG(W) ;GET WINDOW ORIGIN ADDI T1,2 ;GET TOP LINE MOVEI T2,1 ;FIRST COLM TTY ;GO THERE TTY ;CLEAR IT PJRST POSION ;RESTORE CURSOR ; HERE TO KILL A WORD EC.LF: LDB T1,WNDLBP(W) ;GET LAST BYTE CAIE T1," " ;SPACE? JRST EC.LF1 ; NO, GOTO STATE 1 CALL EC.DEL ;KILL JUMPN T1,EC.LF ;REPEAT RET EC.LF1: LDB T1,WNDLBP(W) ;GET LAST BYTE CAIN T1," " RET ; DONE! CALL EC.DEL JUMPN T1,EC.LF1 RET SUBTTL WINDOWS -- FIND A USER ; Find an active (ie; has a window) user. ; T1/ BP to user ; CALL FNDUSR ; ; ; T1/ ^LINK FNDUSR: ACVAR MOVE X2,T1 ;SAVE USER MOVN X1,NUMUSR ;GET NEG USR COUNT HRLZ X1,X1 ;GET -N,,0 FU.LOP: MOVE T1,WNDTAB(X1) ;GET WINDOW MOVE T1,WNDLNK(T1) ;GET LINK HRROI T1,LNKUSR(T1) ;GET USER MOVE T2,X2 ;GET TARGET CALL CMPSTR ;NO, COMPARE TRNA ; NO MATCH JRST FU.WIN ; A WINNER! AOBJN X1,FU.LOP ;NO, GUESS AGAIN RET ;YOU LOSE FU.WIN: MOVE T1,WNDTAB(X1) ;GET LINK PJRST CPOPJ1 ;RETURN HAPPY ENDAV. SUBTTL WINDOWS -- ADD A NEW USER ;Put a new user on the screen ; T1/ link NEWUSR: STKVAR MOVEM T1,LINK ;SAVE LINK MOVE T1,SCRSIZ ;GET SCREEN SIZE SUBI T1,2 ;MINUS TOP LINES MOVE T2,NUMUSR ;GET CURRENT USERS IDIVI T1,2(T2) ;SPLIT AMONG USERS + (US + NEW) CAIGE T1,5 ;AT LEAST FIVE LINES? RET ; NOPE. MOVE T1,LINK ;GET LINK CALL SAVLNK ;STORE LINK RET ;FAIL IF NOT CALL GETWND ;ALLOCATE A WINDOW BLOCK MOVEI T2,TXTLIN ;TOP LINE MOVEM T2,WNDLIN(T1) ;STORE MOVEI T2,1 ;FIRST COL MOVEM T2,WNDCOL(T1) ;STORE POSN MOVEI T2,WNDLBF(T1) ;GET LINE BUFFER ADDR HRLI T2,(POINT 7,) ;MAKE BP MOVEM T2,WNDLBP(T1) ;STORE AOS T3,NUMUSR ;GET NEW USER COUNT MOVEM T1,WNDTAB-1(T3) ;SAVE IN SLOT MOVE T2,LINK ;GET LINK MOVEM T2,WNDLNK(T1) ;SAVE LINK PJRST REFRSH ENDSV. SUBTTL WINDOWS -- REDIVIDE ;No Args ;AC Usage ; T1/ size ; T2/ remainder ; T3/ scratch ; T4/ curr window ; T5/ prev window REFRSH: ACVAR ;LOOP VAR MOVE T1,SCRSIZ ;GET SCREEN SIZE SUBI T1,2 ;MINUS TOP LINES MOVE T2,NUMUSR ;GET CURRENT USERS MOVNI X1,(T2) ;GET NEG USR COUNT HRLZ X1,X1 ;GET -N,,0 IDIVI T1,1(T2) ;SPLIT AMONG USERS + US CAIGE T1,5 ;AT LEAST FIVE LINES? RET ; NOPE. MOVEI T4,WNDBLK ;GET OUR WINDOW MOVEI T3,3 ;ORIGIN MOVEM T3,WNDORG(T4) ;FOR US MOVEM T1,WNDSIZ(T4) ;GIVE US SMALLEST RF.LOP: MOVE T5,T4 ;SET PREV WINDOW MOVE T4,WNDTAB(X1) ;GET CURR WINDOW MOVE T3,WNDORG(T5) ;GET PREV ORIGIN ADD T3,WNDSIZ(T5) ;ADD PREV SIZE MOVEM T3,WNDORG(T4) ;STORE OUR ORIGIN MOVEI T3,(T1) ;GET STD SIZE SOSL T2 ;ANY REMAINDER LEFT? ADDI T3,1 ; YES, GIVE ONE TO US MOVEM T3,WNDSIZ(T4) ;STORE OUR SIZE AOBJN X1,RF.LOP ;LOOP TLO FL,(F$REF) ;NEED REFRESH PJRST CPOPJ1 ENDAV. SUBTTL WINDOWS -- REMOVE A USER ;Remove a user from screen ; I/ link KILUSR: SKIPL LNKHLD(I) ;ON HOLD? RET ; YES, NOT ON SCREEN MOVN T2,NUMUSR MOVSI T2,(T2) ;GET -N,,0 JUMPE T2,CPOPJ ;NO USERS!! KU.LOP: MOVE T1,WNDTAB(T2) ;GET WINDOW CAME I,WNDLNK(T1) ;THE RIGHT LINK? AOBJN T2,KU.LOP ; NO, LOOP JUMPGE T2,CPOPJ ;NOT FOUND, RETURN PUSH P,T2 ;SAVE INDEX CALL FREWND ;FREE WINDOW BLOCK POP P,T2 ;RESTORE LOOP INDEX JRST KU.BOT ;MOVE UP THE REST KU.MOV: MOVE T1,WNDTAB(T2) ;GET CURRENT MOVEM T1,WNDTAB-1(T2) ;MOVE BACKWARDS KU.BOT: AOBJN T2,KU.MOV ;LOOP SOS NUMUSR ;ONE LITTLE INDIAN.... TLO FL,(F$REF) ;NEEDS REFRESH!! RET SUBTTL WINDOWS -- SEND TO ALL ;Send to all active windows ; T1/ code ; T2/ data SNDALL: ACVAR > DMOVE X2,T1 ;SAVE CODE & DATA MOVN X1,NUMUSR ;GET USER COUNT HRLZ X1,X1 ;AS -N,,0 PUSH P,I ;SAVE LINK SA.LOP: MOVE T1,WNDTAB(X1) ;GET WINDOW MOVE I,WNDLNK(T1) ;GET LINK DMOVE T1,X2 ;GET CODE & DATA MOVE T3,LNKFLG(I) ;GET LINK FLAGS TLNN T3,(L$HELD) ;HOLDING US? CALL SNDMSG ; NO, SEND TRN ; IGNORE ERRORS AOBJN X1,SA.LOP ;LOOP FOR ALL WINDOWS PJRST POPIJ ENDAV. SUBTTL SPECIAL ACVAR SUPPORT .SAV1: PUSH P,.FPAC PUSHJ P,0(.A16) ;CONTINUE PROGRAM SKIPA AOS -1(P) POP P,.FPAC POPJ P, .SAV2: PUSH P,.FPAC PUSH P,.FPAC+1 PUSHJ P,0(.A16) SKIPA AOS -2(P) POP P,.FPAC+1 POP P,.FPAC POPJ P, .SAV3: .SAV4: PUSH P,.FPAC PUSH P,.FPAC+1 PUSH P,.FPAC+2 PUSH P,.FPAC+3 PUSHJ P,0(.A16) SKIPA AOS -4(P) POP P,.FPAC+3 POP P,.FPAC+2 POP P,.FPAC+1 POP P,.FPAC POPJ P, SUBTTL CORE ALLOCATOR GETWND: MOVEI T2,WNDLEN ;HERE TO ALLOCATE A FRESH WINDOW SKIPN T1,WNDLST ;ANY HANGING OUT? PJRST GETWDS ; NOPE ALLOCATE ONE MOVE T2,(T1) ;GET NEXT ON LIST MOVEM T2,WNDLST ;SAVE MOVEI T2,WNDLEN PJRST ZERWDS GETLNK: MOVEI T2,LNKLEN ;HERE TO ALLOCATE A FRESH WINDOW SKIPN T1,LNKLST ;ANY HANGING OUT? PJRST GETWDS ; NOPE ALLOCATE ONE MOVE T2,(T1) ;GET NEXT ON LIST MOVEM T2,LNKLST ;SAVE MOVEI T2,LNKLEN PJRST ZERWDS ; T2/ COUNT GETWDS: MOVE T1,T2 ;COPY LENGTH ADD T1,.JBFF ;GET NEW END OF CORE CAILE T1,ENDCOR ;GONE TOO FAR? FATAL (Out of memory) ; I DON'T KNOW HOW YOU DID IT! EXCH T1,.JBFF ;GET START OF BLOCK ZERWDS: ADDI T2,-1(T1) ;GET LAST WORD MOVSI T3,(T1) ;GET START,,0 HRRI T3,1(T1) ;GET START,,START+1 SETZM (T1) ;START THE BALL ROLLING BLT T2,(T2) ;SMEAR! RET FREWND: PUSH P,T1 CALL IPOFF POP P,T1 MOVE T2,WNDLST ;GET WINDOW LIST MOVEM T2,(T1) ;STORE IN FIRST WORD OF NEW BLOCK MOVEM T1,WNDLST ;SAVE AS FREE LIST PJRST IPON ;DONE FRELNK: PUSH P,T1 CALL IPOFF POP P,T1 MOVE T2,LNKLST ;GET LINK LIST MOVEM T2,(T1) ;SAVE IN FIRST WORD OF NEW BLOCK MOVEM T1,LNKLST ;STORE AS FREE LIST PJRST IPON SUBTTL LUUO HANDLR LUUOH: MOVEM 16,UUOACS+16 ;SAVE AC16 MOVEI 16,UUOACS ;COPY FROM ACS TO SAVE AREA BLT 16,UUOACS+15 ;SAVE AC0..15 LDB T1,[POINT 9,.JBUUO,8] ;GET INDEX CAIG T1,MAXUUO ;IN RANGE? XCT LUUTAB(T1) ; DOIT LUUDON: MOVSI 16,UUOACS ;COPY FROM SAVE TO ACS BLT 16,16 RET ;GO HOME LUUTAB: HALT . ;LUUO 0 CALL TTYSTF ;LUUO 1 MAXUUO==.-LUUTAB-1 ;Dependent terminal routines TTYSTF: MOVE T1,@.JBUUO ;GET ARG WORD LDB T3,[POINT 9,T1,8] ;GET CODE TRZE T3,TT$IND ;INDIRECT? CALL GETIND ; YES, FETCH ARGS MOVE T2,TTYTYP ;GET TTY TYPE SKIPN T2,VTXDSP(T2) ;GET BASE FATAL ADD T2,T3 ;GET ADDR SKIPN T2,(T2) ;GET ROUTINE RET ; NONE. CALL (T2) ;GO! TRNA PSOUT ;OUTPUT STRING MOVEI T1,.PRIOU ;RESET POSITION COUNTER SETZ T2, ;AVOID "WIDTH 0" SFPOS ERJMP .+1 RET VT1TBL: EXP MOV10,JMP10,JME10,ERL10,ERB10,SCL10,NRM10,REV10,BRI10 VT5TBL: EXP MOV52,JMP52,JME52,ERL52,ERB52,0,NRM62,REV62,0 DEFINE XX (NAM,ADDR) < BLOCK .TT'NAM-. EXP ADDR > ;XX VTXDSP: PHASE 0 XX V52,VT5TBL ;(15) VT52 XX 100,VT1TBL ;(16) VT100 XX 125,VT1TBL ;(35) VT125 XX K10,VT1TBL ;(36) VK100 (GIGI IN VT100 COMPAT MODE) XX 102,VT1TBL ;(37) VT102 XX H19,VT1TBL ;(38) H19 (ANSI) XX 131,VT1TBL ;(39) VT131 DEPHASE ;;;REGIS CLEAR SEQUENCE ;;;[BYTE (7)33,"P","p","s","(","e",")",33,"\"] ;(36) VK100 ;Here to fetch indirect args into T1 ; T1/ Indirect command word GETIND: LDB T2,[POINT 9,T1,17] ;GET LINE AC MOVE T2,UUOACS(T2) ;GET AC DPB T2,[POINT 9,T1,17] ;STORE VALUE LDB T2,[POINT 9,T1,26] ;GET COLM MOVE T2,UUOACS(T2) ;GET AC DPB T2,[POINT 9,T1,26] ;STORE VALUE RET ; Output an escape prefixed character ; T2/ Char PUTESC: MOVEI T1,33 CALL PUTC MOVE T1,T2 CALL PUTC RET ;*Move the cursor for a VT52 type terminal MOV52: PUSH P,T1 ;SAVE ARGS TLNE T1,000777 TRNN T1,777000 FATAL MOVEI T2,"Y" CALL PUTESC LDB T1,[POINT 9,(P),17] ;Get line number ADDI T1," "-1 CALL PUTC ;OUTPUT LDB T1,[POINT 9,(P),26] ;GET COLUMN ADDI T1," "-1 CALL PUTC POP P,T1 RET ;*Jump to home and clear the screen for VT52 JME52: HRROI T1,[BYTE (7)33,"H",33,"J",0] RETSKP ;*Jump to home JMP52: MOVEI T2,"H" PJRST PUTESC ;*Erase to end of line ERL52: MOVEI T2,"K" PJRST PUTESC ;*Erase to end of screen(page) ERB52: MOVEI T2,"J" PJRST PUTESC REV62: MOVEI T2,"T" PJRST PUTESC NRM62: MOVEI T2,"U" PJRST PUTESC ;**************************************** ;* Here are the VT100 specific routines * ;**************************************** ;Change to reverse video REV10: HRROI T1,[BYTE (7)33,"[","7","m",0] RETSKP ;Change to bold BRI10: HRROI T1,[BYTE (7)33,"[","1","m"] RETSKP NRM10: HRROI T1,[BYTE (7)33,"[","0","m"] RETSKP MOV10: PUSH P,T1 ;SAVE LINE/COL MOVE T1,[POINT 7,VT10OT,13] ;DESTINATION POINTER LDB T2,[POINT 9,(P),17] CALL MOV10A MOVEI T2,";" IDPB T2,T1 LDB T2,[POINT 9,(P),26] CALL MOV10A MOVEI T2,"H" IDPB T2,T1 POP P,T1 HRROI T1,VT10OT ;Point to string RETSKP MOV10A: MOVE T3,[NO%LFL!NO%ZRO!NO%OOV!FLD(2,NO%COL)!^D10] NOUT TRN RET ;Scroll VT100 SCL10: PUSH P,T1 ;SAVE LINE/COL MOVE T1,[POINT 7,VT10ST,13] ;DESTINATION POINTER LDB T2,[POINT 9,(P),17] CALL MOV10A MOVEI T2,";" BOUT LDB T2,[POINT 9,(P),26] CALL MOV10A MOVEI T2,"r" BOUT POP P,T1 HRROI T1,VT10ST ;Point to string RETSKP ;Jump to home JMP10: HRROI T1,[BYTE (7)33,"[","0",";","0","H"] RETSKP ;Jump to home and erase the screen JME10: HRROI T1,[BYTE (7)33,"[","0",";","0" BYTE (7)"H",33,"[","2","J" 0] RETSKP ;Erase line ERL10: HRROI T1,[BYTE (7)33,"[","0","K",0] RETSKP ;Erase to end of screen ERB10: HRROI T1,[BYTE (7)33,"[","0","J",0] RETSKP SUBTTL THE END JUNK: XLIST LIT LIST ENDJNK: DEFINE SAY (A,B,C,D,E) < PRINTX A'B'C'D'E > ;SAY IF1 < SAY <[END OF PASS1]> SAY ,\JUNK SAY \,< WORDS LITTERALS> > ;IF1 END <3,,EVEC>