Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/phone20/phone.mac
There are 3 other files named phone.mac in the archive. Click here to see a list.
;MSC:<BUDNE.FONE>PHONE.MAC.1733 16-Aug-85 NM+1D.1H.50M.32S., by BUDNE
; Released to "integration tools clearinghouse"
;MSC:<BUDNE.FONE>PHONE.MAC.1719 26-Jun-85 FQ+1D.19H.38M.48S., by BUDNE
; Add more status info, and OUTSTR LUUO
;MSC:<BUDNE.FONE>PHONE.MAC.1706 26-Jun-85 FQ+1D.18H.37M.30S., by BUDNE
; Add code at .ERROR to check for lossage from DNCONN
;MSC:<BUDNE.FONE>PHONE.MAC.1700 26-Dec-84 NM+4D.10H.49M.6S., by BUDNE
; Remove PTYnnn stuff
;MSC:<BUDNE.FONE>PHONE.MAC.1698 1-Dec-84 FQ+1D.14H.19M.18S., by BUDNE
; Make sure zero ring flag gets sent in MAKMSG
;MSC:<BUDNE.FONE>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
;--
;HAVE STATUS SHOW TEMP LINK (IE; FROM A FOREIGN RINGER)
;MAKE EXIT DEMAND HANGUP, ADD QUIT COMMAND?
;CREATE ASSEMBLY FEATURE TESTS FOR NO NETWORK, OR JUST NO DNCONN??
;HANDLE ^L (REFRESH) @LKCTRL
;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??
;DON'T MOVE CURSOR UNTIL WE TYPE SOMETHING... (KEEP TRACK OF CURSOR!!)
;
; *** BUGS ***
;AT XTEXT QUEUE PACKETS IF NOT CURRENTLY IN TALK CONTEXT
;DISABLE PAUSE ON END-OF-PAGE (AT LEAST WHILE TALKING (SAME TIME AS ECHO)
;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?
;<LF> CODE IN ECHO IS CRUDE -- USE CURSOR ADDRESSING AND CEOL
;ALL OF ECHO IS CRUDE -- REWRITE
;REWRITE LOOK?
;
;WHAT HAPPENS TO TEXT WHEN YOU ARE AT "COMMAND" LEVEL? (TOSSED?)
;
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, 1985 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 <SYSTEM>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 <JRST CPOPJ1>
OPDEF PJRST [JUMPA 13,]
OPDEF TTY$ [1B8] ;TTY HACKING LUUO
OPDEF OUTSTR [2B8] ;OUTPUT LITTERAL STRING
.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$ [<BYTE (9)TT$'A,B,C>&-1]
RADIX .%. ;;RESTORE RADIX
PURGE .%.
> ;TTY
DEFINE TMSG (STR) <
OUTSTR [ASCIZ ~STR~]
> ;TMSG
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 <DATA>,< [ASCIZ |STR|],,<.'STR> ;> [ASCIZ |STR|],,DATA
> ;IFE FLGS
IFN FLGS,<
IFB <DATA>,< [CM%FW!FLGS
ASCIZ |STR|],,<.'STR> >
IFNB <DATA>,< [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
NODBUF: BLOCK <NBFLEN==3> ;BUFFER FOR NODE NAME
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,<Host name>,<DEF>,CMNOD2 ;FOR PARSING NODE
CMNOD2: FLDDB. .CMKEY,CM%SDH,HSTTAB,,,CMNOD3
CMNOD3: FLDBK. .CMFLD,CM%SDH,,,,NODBRK
BRINI. (-1,-1,-1,-1) ;INITIALIZE BREAK MASK
UNBRK. ("0","9") ;ALLOW DIGITS
UNBRK. ("A","Z") ;ALLOW UPPER
UNBRK. ("a","z") ;ALLOW LOWER
NODBRK: EXP W0.,W1.,W2.,W3.
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
PLIST: BLOCK <LPLIST==200> ;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 <ERB> ;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 <SCR,1,24> ;RESET SCROLL REGION
TTY <JME> ;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 <X1,X2> ;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 /@/]>,<@<Host name>>,<@>
.DIAL: STKVAR <<USRNAM,20>> ;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 /@/]>,<@<Host name>>,<@>,[
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
CALL NODEBP ;GET BP TO NODE...
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 <ERL> ;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,(<BYTE(7)1>) ;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 <Ringing user > ;SAY WHAT WE ARE DOING
OUTSTR LNKUSR(I) ;USER STRING
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 $SIBE ;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 $HIBER ;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 <JFN>
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 <JMP> ;HOME
TTY <ERB> ;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 <X1>
STKVAR <HOSTBP>
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
CALL NODEBP ;GET BP TO NODE
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 <ERL>
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 <Directory of >
MOVE T1,HOSTBP
PSOUT
CALL ENDERR
DIR.AA: CALL PMTLIN ;PROMPT..
TMSG <Press any key to cancel>
TTY <ERB> ;ERASE TO EOS
TTY <MOV,5,1>
TMSG <Process Name User Name Terminal Phone Status
>
SETZ X1, ;CLEAR COUNTER
DIRLOP: CALL $SIBE ;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 <MOV,6,1>
DIRTYP: TTY <ERL>
MOVE T1,T2 ;POINT TO BUFFER
PSOUT ;TYPE IT OUT
CALL CRLF ;GO TO NEXT LINE
TTY <ERL> ;CLEAR IT
AOJA X1,DIRLOP ;LOOP
DIRDON: TTY <ERB>
CALL CRLF
JUMPE X1,[
TMSG <No users>
JRST DIRWAT ]
MOVEI T2,(X1) ;USER COUNT
CALL TDEC ;TYPE IT
TMSG < user>
MOVEI T1,"s"
CAIE X1,1 ;MORE THAN ONE?
CALL PUTC ; MAKE PLURAL
DIRWAT: TMSG < (--Type any character to continue--)>
PBIN ;WAIT FOR A CHARACTER
DIRABT: CALL $CLRBFI ;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 <X1> ;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 <X1> ;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!!
CALL $HIBER ;SLEEP
RET
ENDAV.
SUBTTL COMMANDS -- BLANK AND REDRAW TEMPLATE
.BLANK: NOISE (screen)
CONFRM
TPLATE: TTY <JME> ;CLEAR SCREEN
TTY <MOV,1,28> ;HEADER LINE
TTY <REV> ;REVERSE VIDEO
TMSG <TOPS-20 Phone utility> ;TITLE
TTY <NRM> ;NORMAL VIDEO
TTY <MOV,1,67>
MOVE T1,SWHOOK ;SWITCH HOOK CHAR
CALL PUTC ;TYPE
TTY <MOV,1,70>
MOVEI T1,.PRIOU ;TO TTY
SETO T2, ;NOW
MOVX T3,OT%NTM ;JUST DATE
ODTIM
ERJMP .+1
RET
BOXES: ACVAR <X1>
PUSH P,W ;SAVE WINDOW
TTY <MOV,3,1>
TTY <ERB> ;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 <X1> ;BP
MOVE T2,WNDORG(W) ;GET ORIGIN
MOVEI T3,1 ;FIRST COL
TTY <MVX,T2,T3> ;GO THERE
OUTSTR TP ;GET DASHES
AOJ T2, ;NEXT LINE
MOVEI T3,^D33 ;'MIDDLE'
TTY <MVX,T2,T3> ;GO THERE
TTY <BRI> ;BRIGHT VIDEO
OUTSTR LNKUSR(T5) ;GET USER
TTY <NRM> ;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 <MVX,T2,T3> ;GO THERE
TMSG <On Hold>
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 <X1> ;CALL LEVEL
NOISE (of PHONE)
CONFRM
TTY <MOV,5,1>
TTY <ERB> ;ERASE TO EOS
TMSG <Status of PHONE:>
CALL CRLF
CALL CRLF
TMSG <User: >
OUTSTR US
CALL CRLF
TMSG <Switch-hook: >
MOVE T1,SWHOOK ;SWITCH HOOK CHAR
CALL PUTC
CALL CRLF
TLNN FL,(F$SERV) ;SERVER AVAIL?
IFSKP.
TMSG <System has PHONE server -- you may dial out>
ELSE.
TLNN FL,(F$DECN) ;DECNET AVAIL?
IFSKP.
TMSG <System has DECnet, but no server -- you cannot dial out>
ELSE.
TMSG <System has no DECnet.>
ENDIF.
ENDIF.
CALL CRLF
SKIPN NUMUSR ;ANY LUSERS?
IFSKP.
TMSG <Current calls:>
CALL CRLF
SETO T1, ;GET LEVEL
CALL DMPLVL ;DUMP IT
ENDIF.
SETZ X1,
DO.
CAMLE X1,MAXHLD ;ANY PEOPLE HERE?
EXIT.
CALL CRLF
TMSG <Hold level >
MOVEI T2,(X1) ;GET LEVEL
CALL TDEC ;TYPE IT
MOVEI T1,":"
CALL PUTC
CALL CRLF
MOVE T1,X1 ;GET LEVEL
CALL DMPLVL
AOJA X1,TOP. ;GET NEXT LEVEL
OD.
SKIPN T4,BSYLNK ;TEMP LINK?
IFSKP.
TMSG <Temp link to:>
CALL CRLF
CALL DMPLNK
ENDIF.
CALL CRLF
CALL CRLF
TMSG <--Type any char to continue-->
PBIN
CAIN T1,"M"-100
PBIN
RET
ENDAV.
DMPLVL: ACVAR <X1>
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
CALL DMPLNK ;DUMP THIS LINK
DMPBOT: AOBJN T5,DMPLOP
RET
ENDAV.
; T4/ POINTER TO LINK
DMPLNK: OUTSTR LNKRUT(T4) ;GET ROUTE
OUTSTR LNKUSR(T4) ;GET USER
HRRZ T2,LNKFLG(T4) ;ANY FLAGS SET?
TMSG < (via >
OUTSTR @[ [ASCIZ 'DECnet)']
[ASCIZ 'Local IPCF)'] ](T2)
PJRST CRLF
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
; <ok>
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
; <lose>
; <ok>
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
; <invalid>
; <valid>
; 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
; <lose>
; <win>
; 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
; <NO>
; <YES>
; T1/ PID
FNDUNO: STKVAR <<BUFFER,^D9>>
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
; <NOPE>
; <YEP>
; 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
; <loss>
; <ok>
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 <SYSTEM>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 <SYSTEM>INFO?
CAIN T1,.IPCCP ; OR FROM MY <SYSTEM>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<IPCCHN>) ;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 T1,5000 ;5 pages
MOVEM T1,HSTADR ;Store count
MOVEI T2,HSTADR ;Get dest
MOVEI T1,.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 <TSTJFN>
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)
CALL $UPTIME ;Get current uptime
MOVE T4,T1 ;Copy
ADDI T4,^D<1000*5> ;Allow 5 seconds for connect
TSTLOP: MOVE T1,TSTJFN
MOVEI T2,.MORLS ;Read link status function
MTOPR
ERJMP CLSTST
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
CALL $UPTIME ;Get uptime now
CAML T1,T4 ;Time left?
JRST CLSTST ; No, timed out
MOVEI T1,^D500 ;Yes, sleep for 1/2 sec
CALL $HIBER ;Zzz
JRST TSTLOP ;Try again
CLSTST: MOVE T1,TSTJFN
CLOSF
TRN
RET
ENDSV.
; HERE AFTER PARSING WITH CMNOD.
NODEBP: HRRZ T3,T3 ;GET WINNER
HLRO T2,(T2) ;GET NODE STRING BP (IF TABLE)
CAIE T3,CMNOD3 ;DID FIELD WIN?
RET ; NO, RETURN TABLE ENTRY
HRROI T1,NODBUF ;PLACE FOR NODE
HRROI T2,ATMBUF ;SOURCE
MOVNI T3,NBFLEN*5-1 ;MAX LEN
SETZ T4, ;OR NULL
SOUT
HRROI T2,NODBUF
RET
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<IPCCHN>) ;IPCF CHAN
DIC
RET
SUBTTL PSI -- ACTIVATE IPCF INTERUPTS
IPON: JRST PION
MOVEI T1,.FHSLF ;OUR FORK
MOVSI T2,(1B<IPCCHN>) ;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 <MVX,T2,T1> ;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.
; Here with first ring when not currently answering, and user is not
; us. Silently establish link back to them, and set "answer mode".
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 <X1> ;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 <User is busy> ;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 <X1,X2> ;NEW LINK, LOOP VAR
STKVAR <<FULNAM,20>,<OLDNAM,20>> ;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 <X1> ;LOOP VAR
STKVAR <UID> ;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 <MVX,T2,T3> ;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 <MVX,T2,T3> ;GO THERE
TTY <ERL> ;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
; <neq>
; <eql>
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: CALL CHKBT1 ;MAKE INTO REAL BP
MOVEM T1,LSTERR ;(ERROR macro always adds a "?")
ILDB T2,T1 ;CHECK FOR LEADING CRLF (FROM DNCONN)
CAIE T2,CR ; WAS CR?
JRST .ERR1 ;NOPE
ILDB T2,T1 ;GET NEXT
CAIN T2,LF ;IS LF?
MOVEM T1,LSTERR ; YES, SAVE WITHOUT CRUD
.ERR1: CALL ERRLIN
MOVE T1,LSTERR
PSOUT
PJRST ENDERR
SUBTTL SUPPORT FOR FATAL MACRO
.FATAL: ESOUT ;TYPE ERROR
CALL CRLF ;TYPE CRLF
JRST DOEXIT
SUBTTL JSYS ERROR AND DEATH
ERRHLT: DMOVEM T1,AC1
DMOVEM T3,AC3
CALL ERRPNT
DOEXIT: HALTF
JRST DOEXIT
SUBTTL TTY -- SAVE CCOC WORD
SAVTTY: MOVEI T1,.PRIOU ;OUR TTY
RFCOC ;GET CCOC WORD
DMOVEM T2,TTYCOC ;SAVE IT
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
RET
SUBTTL TTY -- RESTORE CCOC WORD
RESTTY: MOVEI T1,.PRIOU ;OUR TTY
DMOVE T2,TTYCOC ;GET OLD BITS
SFCOC
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
$SIBE: MOVEI T1,.PRIIN ;CHECK OUR TTY
SIBE ;INPUT BUFFER EMPTY
TRNA ; EMPTY
CPOPJ1: AOS (P)
CPOPJ: RET
$HIBER: DISMS ;SLEEP
RET
$UPTIME: TIME ;GET SYSTEM UPTIME IN MS.
RET
$CLRBFI: MOVEI T1,.PRIIN ;TTY
CFIBF ;CLEAR INPUT BUFFER
RET
PUTC: PBOUT ;TYPE A CHAR
RET
CRLF: TMSG <
>
RET
; TYPE DECIMAL NUMBER IN T2
TDEC: MOVEI T1,.PRIOU ;TERMINAL
MOVEI T3,^D10 ;DECIMAL
NOUT ;TYPE NUMBER
ERJMP .+1 ;DISREGARD..
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 <ERB> ;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 <X1> ;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 $SIBE ;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 '
**** Facsimile of ']
CALL FAXSTR
TLNN FL,(F$SERV) ;COULD THIS BE A DECNET CALL?
IFSKP.
HRROI T1,OURNOD
CALL FAXSTR
MOVEI T1,":"
CALL ECHO
MOVEI T1,":"
CALL ECHO
ENDIF.
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 $SIBE ;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 $SIBE ;ANY MORE INPUT?
JRST LKGET2 ; YES
IFN SLPTIM,<
MOVEI T1,SLPTIM ;NO, SLEEP A LITTLE
CALL $HIBER ;ZZZ
CALL $SIBE ;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 <LF> 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 <X1,X2>
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 <MVX,X1,X2> ;MOVE, INDIRECT
RET
ENDAV.
SUBTTL PHONE ERROR MESSAGES
; T1/ PROTOCOL ERROR CODE
; CALL ERRPHN
; <ALWAYS>
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 <ERL> ;CLEAR REST OF LINE
MOVE T1,ERRPSE ;PAUSE INTERVAL
CALL $HIBER
RET
SUBTTL GOTO ERROR LINE
ERRLIN: TTY <MOV,2,1>
RET
SUBTTL GOTO PROMPT LINE
PMTLIN: TTY <MOV,3,1>
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 <<BUF,5>>
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
; <failed to parse>
; <ok>
; 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
; <lose, error string in T1>
; <win, type and 'JFN' set up>
MAKCON: STKVAR <<TARGET,10>,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
; <ERROR, BP IN T1>
; <AOK, LINK JFN AND ROUTE SET UP>
;
OPNCON: STKVAR <HOSTBP,SAVEBP> ;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
MAKMSG: ACVAR <COD> ;SAVE CODE
MOVEM T1,LSTCOD ;STORE LAST CODE SENT
MOVE COD,T1 ;SAVE LAST CODE
PUSH P,T2 ;SAVE DATA
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
POP P,T1 ;RESTORE DATA, IF ANY
JUMPE T1,CPOPJ ;NONE? DONE!
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 IS MESSAGE
RET ;DONE!
ENDAV. ;{COD}
SUBTTL LINKS -- SEND A MESSAGE, W/ STATUS
;Send a message
; T1/ Code
; T2/ BP to data
; I/ Link
; CALL SNDMSG
; <error>
; <ok>
; 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
; <nope>
; <yep>
; T1/ ^LINK
MAKLNK: STKVAR <USR,LNK>
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 <X1,X2>
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????
CALL $UPTIME ;GET UPTIME IN MS
MOVE T4,T1 ;COPY
ADDI T4,WAIT4*^D1000 ;WAIT TILL THEN
DECINC: SKIPG T1,LNKJFN(I) ;GET NET JFN
JRST DECIER ; NONE!
SIBE ;ANY DATA (0 LENGTH RECORD NEVER SEEN!!!)
JRST DECINW ; YES, GOT IT!!
CALL $UPTIME ;GET SYSTEM UPTIME
CAML T1,T4 ;TIME RUN OUT?
JRST DECIER ; YES, TIMEOUT
MOVEI T1,WAITIN
CALL $HIBER
JRST DECINC ;LOOK AGAIN
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 <X1,X2> ;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,(<BYTE(7)1>) ;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
; <LOSS>
; <AOK>
; T1/ STATUS
LCLRNG: ACVAR <X1,X2,X3>
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 <OPERATOR>
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
; <OFF THE HOOK>
; <IN A SOCIABLE MOOD>
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 <CR>
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.
OUTSTR [BYTE (7)BS," ",BS] ;ERASE
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: CALL PUTC ;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 <ERL> ;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
CALL CRLF
EC.CR2: TTY <ERL> ;ERASE TO END OF NEW TEXT LINE
MOVE T1,WNDLIN(W) ;GET LINE AGAIN
CAME T1,WNDSIZ(W) ;BOTTOM?
JRST [ CALL CRLF
TTY <ERL> ;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 <MVX,T1,T2> ;GO THERE
TTY <ERL> ;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
; <LOSS>
; <WIN>
; T1/ ^LINK
FNDUSR: ACVAR <X1,X2>
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 <LINK>
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 <X1> ;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 <X1,<X2,2>>
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
CALL $OUTSTR ;LUUO 2
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 <Unknown TTY type>
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 <Bad call to MOV52>
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
; TOPS-20 OUTSTR LUUO
$OUTSTR: HRROI T1,@.JBUUO ;GET EA
PSOUT ;OUTPUT IT
RET
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 = >,\JUNK
SAY \<ENDJNK-JUNK>,< WORDS LITTERALS>
> ;IF1
END <3,,EVEC>