;CHAT.MAC;14 13-OCT-81 08:32:21 EDIT BY TAFT ; Revise host name table ;CHAT.MAC;13 16-APR-81 16:53:47 EDIT BY TAFT ; Fix bug in host-name command that prevented use of names containing ; an implicit nonzero socket number. ;CHAT.MAC;12 2-FEB-81 12:29:29 EDIT BY TAFT ; Revise host name table ;CHAT.MAC;11 3-JUL-79 10:31:10 EDIT BY TAFT ; Reset P when restarted at RECV0 ;CHAT.MAC;10 24-APR-78 12:14:50 EDIT BY TAFT ; Add names of all IFSs to host name table. ; Fix crash caused by log.file.for.current.connection when there ; is no connection. ;CHAT.MAC;9 17-JUL-77 12:56:59 EDIT BY TAFT ; Add IFS command ;CHAT.MAC;8 13-APR-77 12:54:36 EDIT BY TAFT ; Add initial Chat.Commands feature ; Correct implementation of timing mark ;CHAT.MAC;7 21-MAR-77 16:50:45 EDIT BY TAFT ; Add simple host name collector ;CHAT.MAC;4 21-MAR-77 02:05:53 EDIT BY TAFT ; Find help file on Chat.help ;CHAT.MAC;3 21-MAR-77 01:03:37 EDIT BY TAFT ; Conversion from TELNET to CHAT: ; Rip out all the BCPL call stuff ; Rip out all option negotiation and RCTE code ; Remove Arpanet-related stuff (netstat, socket.map, status.of ...) ; Rewrite DOICP to make Pup connections ; Remove state change stuff ; Insert commands "Maxc1" and "Maxc2" until we can figure out ; a good way of collecting host names. ;TELNET.MAC;135 4-FEB-75 14:55:16 EDIT BY DODDS TITLE CHAT -- TENEX PUP USER TELNET SUBTTL E. A. Taft, based on TELNET by R.S.Tomlinson SEARCH STENEX ENTVEC: JRST START ; entry vector: start adr JRST START ; restart adr, changed later VERNUM: ASCIZ \1.04 2-Feb-81\ BLOCK 3 OPDEF ERROR[1B8] ; Accumulators A=1 B=2 C=3 D=4 X=5 Y=6 Z=7 PTR=10 TAB=11 NOA=12 CNX=13 NCNX=14 P=17 F=0 ; Flags (rh of f) REMOTF==1 ; Operating in remote mode COMMDF==4 ; In command mode NSTIWF==2 ; Don't do stiw's ICPMOD==10 ; ICP in progress TMPF==400000 ; Temporary flags TMPF2==200000 TMPF3==100000 TMPF4==40000 TMPF5==20000 TMPF6==10000 ; Parameters NPDL==2000 ; Size of push list NCONN==7 ; Number of connections to remember IESC=="Z"-100 ; Initial escape character ICBF=="O"-100 ; Initial clear output buffer character ESCCHN==0 ; Use channel 0 for escape ABNCHN==2 ; Channel 2 for abnormal connection termination CBFCHN==4 SAVBFS==4000 ; Size of string saving buffer LOC 200000 ; fork data area SPDL: BLOCK 100 APDL: BLOCK 50 FKRET1: BLOCK 1 FKRET2: BLOCK 1 FKRET3: BLOCK 1 FSVCNX: BLOCK 1 ; fork's cnx for use by INSRCV IRSST: BLOCK 1 ; ditto temp for Send status IACSAV: BLOCK 20 ; ditto AC save area SAVBUF: BLOCK SAVBFS LOC 100000 ; Where to store variables INTEGER CONTAB ARRAY PDL[NPDL] ARRAY COMBUF,LINBUF,HLPBUF[200] ARRAY BIGBUF[4000] INTEGER LODFLG,WATFLG,TCASE,TRMLWC,BPTR,LPTR,SVP INTEGER TTCOC0,TTCOC1,TTMOD0,TTMODR,TTMODC,JOBTIW,HDX,NFANCY INTEGER ESCAPE,ESCCOD,CBFCHR,CBFCOD,LSTBDI,CONCSF,ABNLCK,ABNCNX INTEGER LCASCF,UCASCF,LCASC,LCASL,UCASC,UCASL,UNSFT INTEGER SYNC,QUOT,QUOTF,SPECWK ARRAY FAC,LGDRST[20] INTEGER IJFN,SCRJFN,SCRCNT,SCRTIM,REALTT,CMCALX,CRNLSW,CMDJFN INTEGER DIVJFN,DIVSWT,RLACJ,SPCFRK,ACTVSW,ACTVTM INTEGER SKTMSK,FSKT,FHST,FHSTN,RETPC1,RETPC2,RETPC3 ARRAY SNDFRK,RCVFRK,DMTIME,LSKT,ELCLF,LFCRF,LNBFF[NCONN+1] ARRAY XPARNT,RCVBSW,CBFCNT,ALTJFN,ALTJCT,SNDATM,RCVATM[NCONN+1] ARRAY RAISEF,LOWERF,ECHCOC,CONTB,SAVINP,SAVINC,SAVONP,SAVSWT[NCONN+1] ARRAY RHLDCT,RSHLCT,RBUFCT,RBFECT,RBFSCT[NCONN+1] ARRAY RHLDBF,RHLDPT,RECHPT,RSNDPT,LGFJFN,LGFCNT,LGFTIM[NCONN+1] ARRAY SNDJFN,RECJFN[NCONN+1] ; Send & Receive jfns ARRAY SYNCNT[NCONN+1] ; Sync count (interrupts - data marks) ARRAY CONNAM[3+3*NCONN] INTEGER SWOFLG,CLROBF,TERM,JUNK RELOC ; Program starts here START: MOVEI A,100 SIBE JRST RSTART HRROI A,[ASCIZ / Chat -- Pup User Telnet /] PSOUT HRROI A,VERNUM PSOUT RSTART: RESET ; Reset the world MOVE P,[XWD -NPDL,PDL-1] MOVE A,[PUSHJ P,UUO] MOVEM A,41 MOVEI A,400000 RPCAP ; Find out what we can do AND B,[1B0!1B2] IOR C,B EPCAP ; Enable control-c stealing TLNE C,(1B0) TROA F,NSTIWF TRZ F,NSTIWF SETZB F,VARS MOVE A,[XWD VARS,VARS+1] BLT A,EVARS-1 ; Zero all variables, set BCPL params SETOM ABNLCK ; Unlock abnormal interrupt handler. SETOM UCASC SETOM UCASL SETOM LCASC SETOM LCASL SETOM UNSFT SETOM QUOT SETOM SYNC MOVSI B,-NCONN ICNVL: MOVE A,[BYTE (1)0,0,0,0,0,0,0,1,0,1,1,0,0,1] MOVEM A,ECHCOC(B) ; Initial control character local echo SETOM LFCRF(B) SETOM ELCLF(B) AOBJN B,ICNVL MOVEI A,CONTB MOVEM A,CONTAB ; Contab points at contb MOVEI A,IESC ; Setup initial escape character MOVEM A,ESCAPE PUSHJ P,CVINTC ; Convert character to interrup channel HALT . ; Can't fail MOVEM A,ESCCOD MOVEI A,ICBF MOVEM A,CBFCHR PUSHJ P,CVINTC HALT . MOVEM A,CBFCOD SETZM FSVCNX MOVEI A,400000 CIS MOVE B,[XWD LEVTAB,CHNTAB] SIR EIR MOVEI A,100 RFMOD ; Find out what kind of line we have MOVEM B,TTMOD0 ; Remember same TRNE B,1B32 ; Hdx terminal? SETOM HDX ; Yes, set hdx flag TLNE B,(1B3) SETOM TRMLWC ; Remember term has lower case ANDCMI B,77B23!3B25!17B29!1B30!1B31 PUSH P,B IORI B,17B23!0B25!1B29 MOVEM B,TTMODC ; In command mode: break-all, echo-none POP P,B IORI B,17B23!1B29 MOVEM B,TTMODR ; No change for remote mode RFCOC ; Get standard control output control MOVEM B,TTCOC0 MOVEM C,TTCOC1 GJINF PUSH P,A ; Save login dir number HRROI A,HLPBUF ; Build name Chat.Commands MOVEI B,"<" BOUT POP P,B DIRST 0 HRROI B,[ASCIZ />CHAT.COMMANDS/] SETZ C, SOUT MOVSI A,(1B2+1B17) ; Old file, short form HRROI B,HLPBUF GTJFN JRST INIT1 ; Not there MOVEM A,CMDJFN ; Ok, save jfn MOVE B,[7B5+1B19] ; Open for reading OPENF PUSHJ P,[SETZ A, ; Can't, just release jfn and ignore EXCH A,CMDJFN JRST CLRJFN] INIT1: MOVE A,[JRST PCLP] ; set up restart adr MOVEM A,ENTVEC+1 PCLP: MOVEI A,ESCCHN ; Psi channel HRL A,ESCCOD ; Escape terminal code ATI MOVEI A,CBFCHN HRL A,CBFCOD ATI ; Assign MOVE B,[1B!1B!1B!1B9!1B11!17B18] MOVEI A,400000 AIC ; Activate interrupt channel ; Main command loop COMLP: TRO F,COMMDF TRZ F,TMPF3!ICPMOD MOVEI A,101 DOBE MOVE P,[XWD -NPDL,PDL-1] MOVE NCNX,CNX SETO B, MOVEI A,-5 TRNN F,NSTIWF STIW ; Restore terminal interrupt word MOVEI A,100 MOVE B,TTMODC SKIPE NFANCY JRST [ TRZ B,77B23 TRO B,2B25!16B23 JRST .+1] SFMOD ; Set tty mode for command input MOVE B,[BYTE (2)0,0,1,1,1,1,1,2,0,2,2,1,2,2,1,1,1,1] MOVE C,[BYTE (2)0,1,1,1,1,1,0,1,1,0,1,1,1,2] SFCOC HRROI A,[ASCIZ / #/] PUSHJ P,.PSOUT ; Prompt character MOVE PTR,[POINT 7,COMBUF-1,34] MOVEM PTR,LPTR ; Pointer to beginning of line MOVEI A," " IDPB A,PTR ; Deposit initial space to line up MOVE TAB,COMTAB ; Setup to use comtab PUSHJ P,SYMVAL ; Call symbol evaluator SKIPE SNDJFN(CNX) ; Was connection created or TRNN F,REMOTF ; Remote mode? JRST COMLP ; No. stay in command mode TRZ F,COMMDF MOVEM CNX,FSVCNX ; save CNX for later restoration HRROI A,[ASCIZ /# /] PUSHJ P,.PSOUT MOVEI A,-5 MOVN C,ESCCOD MOVSI B,400000 ROT B,(C) ; Get bit for escape code PUSH P,B MOVN C,CBFCOD MOVSI B,400000 ROT B,0(C) IORM B,0(P) POP P,B IORI B,1B30 ; Include carrier off TRNN F,NSTIWF STIW ; And set tiw to that REST0: MOVEI A,100 MOVE B,TTMODR SKIPE XPARNT(CNX) TRZ B,3B29 SFMOD ; Set tty mode for remote MOVE B,[BYTE (2)0,0,0,0,0,0,0,2,2,2,2,2,2,2,0,0,0,0] MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2] SFCOC ; echo all formatter + bell in remote MOVEI A,101 GTTYP SETZ C, CAIL B,12 ; is terminal a scope? JRST [ EXCH C,B STTYP ; yes, save & set to 33 for remote JRST .+1 ] MOVEM C,REALTT ; save terminal type or 0 if not scope MOVE A,RCVFRK(CNX) FFORK ; Freeze it MOVEI A,400000 DIR ; Interrupts off to avoid confusion SETZM SAVSWT(CNX) ; Resume output MOVE A,RCVFRK(CNX) RFSTS ; Get pc of receive fork MOVE A,RCVFRK(CNX) HRRZS B CAIG B,RECV0 ; If fork will get back to RECVO JRST REST2 ; let it proceed CAIG B,RECVB JRST REST1 CAIL B,RCVBX CAILE B,RCVB1+1 SKIPE RCVBSW(CNX) JRST REST1 JRST REST2 REST1: MOVEI B,RECV0 ; Else restart it at RECV0 SFORK REST2: MOVE A,SNDFRK(CNX) ; if io wait and input file assigned, RFSTS MOVE A,SNDFRK(CNX) HRRZS B CAIN B,PBINX+1 SKIPN ALTJFN(CNX) JRST REST3 MOVEI B,.PBIN ; restart .PBIN to prevent input hang SFORK REST3: MOVEI A,400000 EIR MOVE A,RCVFRK(CNX) RFORK ; And resume MOVE A,SNDFRK(CNX) RFORK ; Resume send fork SKIPE ACTVSW ; if not auto-switching, wait JRST REST3A WFORK ; Should wait forever HRROI A,[ASCIZ / Funny fork termination. Restarted./] PUSHJ P,.PSOUT JRST RSTART REST3A: TIME MOVEM A,RCVATM(CNX) ; advance new fork's active time to now REST4: MOVEI A,^D15000 DISMS ; here for auto-switching. wait 1 min.. TIME SUB A,ACTVTM MOVE B,A CAML A,RCVATM(CNX) ; send and recv forks inactive for CAMGE B,SNDATM(CNX) ; more than time constant? JRST REST4 ; no, go back to sleep MOVSI X,-NCONN REST5: MOVE A,SNDJFN(X) ; yes, scan for an active connection JUMPE A,REST6 SKIPLE SAVINC(X) JRST REST7 REST6: AOBJN X,REST5 JRST REST4 ; if none found keep current one & loop REST7: SETOM SAVSWT(CNX) MOVEI A,400000 DIR MOVEI A,100 ; active cnx found: turn off current cnx CFIBF MOVE A,SNDFRK(CNX) FFORK PUSHJ P,TBEL HRROI A,[ASCIZ / Switching to connection /] PUSHJ P,.PSOUT HRRZ A,X IMULI A,3 HRROI A,CONNAM(A) PUSHJ P,.PSOUT HRROI A,[ASCIZ /. /] PUSHJ P,.PSOUT HRRZ CNX,X TRO F,REMOTF MOVEM CNX,FSVCNX ; and turn on active one JRST REST0 ; Abnormal interrupts come here BADINT: MOVE CNX,FSVCNX MOVEI A,101 DOBE TIME SUBI A,^D15000 CAMGE A,LSTBDI ; Within 5 seconds of last bad int? JRST BADBAD ; Very bad HRROI A,[ASCIZ / Abnormal interrupt from location /] PUSHJ P,.PSOUT HRRZ B,RETPC1 MOVEI C,10 MOVEI A,101 PUSHJ P,.NOUT JFCL HRROI A,[ASCIZ /. /] PUSHJ P,.PSOUT TIME MOVEM A,LSTBDI JRST ESCINZ BADBAD: HALTF JRST BADINT ; If remote host initiates disconnect, rec'v fork inits int'rpt to here ABNINT: MOVE CNX,FSVCNX MOVE X,ABNCNX ; Get the correct cnx PUSHJ P,DISC1 JRST ESCINZ ; Clear outbuf int comes here CBFINT: MOVE CNX,FSVCNX SKIPE A,SNDJFN(CNX) AOSE QUOTF JRST CBFINZ PUSH P,B MOVEI B,SENDO JRST SPCSND CBFINZ: SETOM CLROBF PUSH P,A MOVEI A,101 CFOBF POP P,A DEBRK DEBRK ; Escape interrupt comes to here ESCINT: AOSE QUOTF ; if quote prefix typed and JRST ESCINV MOVE CNX,FSVCNX SKIPN A,SNDJFN(CNX) ; If connection exists, JRST ESCINV PUSH P,B MOVEI B,SENDE SPCSND: PUSH P,A ; Then sent escape character MOVE A,SNDFRK(CNX) FFORK SFORK RFORK POP P,A POP P,B DEBRK ESCINV: MOVEI A,100 CFIBF ; do this early for performance MOVEI A,101 TRNE F,COMMDF ; command mode? CFOBF ; yes, flush output JRST ESCINY ESCINZ: MOVEI A,100 CFIBF ESCINY: SKIPE RLACJ ; Is there likely to be a jfn in ac 1? TDNE A,[XWD -1,700000] SKIPA ; Apparently not PUSHJ P,CLRJFN ; Apparently yes SETZM RLACJ SKIPE A,SNDFRK(CNX) ; If there is a send fork FFORK ; Freeze it SKIPN A,RECJFN(CNX) ; Connected? JRST ESCINW ; No, skip this SETOM SAVSWT(CNX) ; Switch to saving input SKIPE A,RCVFRK(CNX) RFORK ; Leave running ESCINW: SKIPE A,SPCFRK ; If there is a special fork KFORK ; Kill it SETZM SPCFRK SKIPE A,IJFN PUSHJ P,CLRJFN SETZM IJFN ; Release temporary jfn's TRNE F,ICPMOD PUSHJ P,RELCON ; release connections if ICP was in prog SKIPE B,REALTT ; scope terminal type saved? JRST [ MOVEI A,101 STTYP ; yes, restore type for command mode MOVEI A,100 SIBE ; any type-ahead since cfibf? JRST .+1 ; yes, restored ok MOVEI B,40 STI ; no, simulate char in to break PBIN ; scroll hold, if any JRST .+1 ] ESCI1: SKIPE A,CMDJFN ; Is there an initial command file? PUSHJ P,CLRJFN ; Yes, close it SETZM CMDJFN MOVE A,[XWD 10000,COMLP] MOVEM A,RETPC1 DEBRK ; Debrk back to comlp LEVTAB: RETPC1 RETPC2 RETPC3 CHNTAB: REPEAT ESCCHN, XWD 1,ESCINT XWD 1,BADINT XWD 1,ABNINT XWD 1,BADINT XWD 2,CBFINT REPEAT <^D36-5-ESCCHN>, FKLVT: FKRET1 FKRET2 FKRET3 FKCHT: 0 XWD 3,RCVINS 0 REPEAT ^D7,<0> 0 XWD 1,IOERR REPEAT ^D36-^D12,<0> DEBRK ; Get a character GCH: PUSHJ P,.PBIN CAIE A,177 CPOPJ: POPJ P, HRROI A,[ASCIZ /XXX/] PUSHJ P,.PSOUT JRST COMLP ; Echo character in a ECHOIT: SKIPE HDX PUSHJ P,PBOUT0 SKIPE HDX POPJ P, SKIPE NFANCY TRNN F,COMMDF PUSHJ P,.PBOUT POPJ P, ; Primary output with case indicate .PEOUT: PUSHJ P,PBOUT0 CAIL A,100 ; Does character have case? SKIPE TRMLWC ; Or does terminal have lower case? JRST EOUTX1 ; Caseless SKIPGE LCASL SKIPL LCASC SKIPA JRST EOUTX1 ; Don't indicate if shift chars absent SKIPGE UCASL SKIPL UCASC SKIPA JRST EOUTX1 CAIE A,177 CAIN A,137 JRST EOUTX1 PUSH P,B MOVE B,A ANDI B,40 ; Extract case ANDCMI A,40 ; Force upper CAMN B,TCASE ; Same as current case? JRST EOUTX0 ; No need to indicate PUSH P,A JUMPE B,IUPC ; Upper case SKIPG A,LCASL ; Do we have a lower case lock? JRST LCS1 ; No, try for lowercase char PBOUT ; Yes, print it MOVEM B,TCASE ; And remember new case JRST EOUTX LCS1: SKIPG A,LCASC ; Have we a lower case char prefix? JRST EOUTX ; No, can't indicate PBOUT ; Yes, print it JRST EOUTX ; But don't change case IUPC: SKIPG A,UCASL ; Do we have a upper case lock JRST UCS1 PBOUT MOVEM B,TCASE JRST EOUTX UCS1: SKIPG A,UCASC JRST EOUTX PBOUT EOUTX: POP P,A EOUTX0: POP P,B EOUTX1: CAME A,UCASC CAMN A,UCASL JRST ESPCL CAME A,LCASC CAMN A,LCASL JRST ESPCL CAMN A,QUOT JRST ESPCL PBOUT POPJ P, ESPCL: PUSH P,A SKIPLE A,QUOT PBOUT POP P,A PBOUT POPJ P, ; Primary input .PBIN: PUSH P,B PBIN1: MOVEI A,100 TRNE F,COMMDF JRST PBIN0 SKIPN ALTJFN(CNX) JRST PBIN2 MOVE A,ALTJFN(CNX) ; if alt. file exists & in remote mode, SOSGE ALTJCT(CNX) ; take input from file, else tty JRST [ SETZ NOA, PUSHJ P,SETALT ; if ct shows eof, close & release JRST PBIN1 ] BIN MOVE A,B POP P,B POPJ P, PBIN2: PBIN0: SKIPE A,CMDJFN ; Taking input from initial command file? JRST PBIN4 ; Yes MOVEI A,101 RFMOD ; will echo be generated? TRNE B,3B33!3B25 JRST [ MOVEI B,PBOUT0 EXCH B,0(P) JRST .+2] PBIN3: POP P,B PBINX: PBIN POPJ P, ; Get input from initial command file PBIN4: BIN JUMPE B,[GTSTS ; End of file? TLNN B,(1B8) JRST PBIN4 ; No, flush null PUSHJ P,CLRJFN ; Yes, close file SETZM CMDJFN JRST PBIN1] ; Get input by other means CAIE B,15 ; Carriage return? JRST PBIN5 ; No BIN ; See if line feed follows CAIE B,12 BKJFN ; No, back up so it will be read CAI MOVEI B,37 ; Substitute eol for crlf PBIN5: MOVE A,B POP P,B TRNE F,COMMDF ; In command mode? PUSHJ P,PBOUT0 ; Yes, echo the char POPJ P, ; Primary output .PBOUT: PBOUT PBOUT0: SKIPN SCRJFN POPJ P, PUSH P,B MOVE B,A MOVE A,SCRJFN CAIN B,37 JRST [ MOVEI B,15 ; translate EOL to BOUT MOVEI B,12 BOUT MOVEI B,37 JRST .+2 ] BOUT PUSHJ P,SCRUPD MOVE A,B POP P,B POPJ P, .PLOUT: PUSHJ P,.PBOUT CAIA PLOUT0: PUSHJ P,PBOUT0 PLOUT1: SKIPN LGFJFN(CNX) POPJ P, PLOUT2: PUSH P,A MOVE B,A MOVE A,LGFJFN(CNX) CAIN B,37 JRST [ MOVEI B,15 BOUT MOVEI B,12 BOUT MOVEI B,37 JRST .+2 ] BOUT PUSHJ P,LGFUPD MOVE A,B POP P,B POPJ P, .GTJFN: MOVE B,[XWD 100,101] GTJFN0: SETOM RLACJ GTJFN JRST [ SETZM RLACJ POPJ P,] MOVEM A,IJFN SETZM RLACJ PUSH P,C SETZ C, MOVE B,A SKIPE A,SCRJFN JFNS POP P,C PUSHJ P,SCRUPD MOVE A,B JRST SKPRET .NOUT: NOUT POPJ P, SKIPE A,SCRJFN NOUT JFCL PUSHJ P,SCRUPD MOVEI A,101 AOS (P) POPJ P, .SOUT: SKIPN A,SCRJFN JRST .SOUT0 PUSH P,B PUSH P,C SOUT PUSHJ P,SCRUPD POP P,C POP P,B .SOUT0: MOVEI A,101 SOUT POPJ P, .PSOUT: SKIPE SCRJFN PUSH P,A PSOUT SKIPN SCRJFN POPJ P, EXCH B,0(P) PUSH P,C MOVE A,SCRJFN SETZ C, SOUT PUSHJ P,SCRUPD MOVE A,B POP P,C POP P,B POPJ P, ; Uuo handler UUO: HRRO A,40 PUSHJ P,ERROUT MOVEI A,400000 CIS EIR JRST COMLP ERROUT: PUSH P,A MOVEI A,101 DOBE POP P,A PUSHJ P,.PSOUT MOVEI A,^D1000 DISMS MOVEI A,100 CFIBF POPJ P, ; Convert interrupt character to code CVINTC: CAIG A,33 JRST SKPRET CAIE A,177 CAIN A,40 SKIPA POPJ P, CAIN A,40 MOVEI A,^D29 CAIN A,177 MOVEI A,^D28 JRST SKPRET ; type bell TBEL: PUSH P,A MOVEI A,7 PBOUT POP P,A POPJ P, ; Map fork one to one with this fork through page 177 ; Call: A ; Fork handle ; PUSHJ P,MAPFRK ; Returns ; +1 ; Always. transparent MAPFRK: PUSH P,C PUSH P,D PUSH P,B MOVSI D,-177 MOVSI B,(A) MOVSI A,400000 MOVSI C,160000 MAPFKL: HRR A,D HRR B,D PMAP AOBJN D,MAPFKL HLRZ A,B POP P,B POP P,D POP P,C POPJ P, INIFRK: MOVEM NCNX,CNX+FAC MOVEI B,FAC SFACS MOVE B,[XWD FKLVT,FKCHT] CIS SIR EIR MOVSI B,(1B1!1B2!1B11) AIC POPJ P, ; Close and release jfn CLRJFN: PUSH P,A CLOSF JFCL POP P,A RLJFN JFCL POPJ P, ; Macro for generating commands DEFINE CC(STR,VAL)< POINT 7,[ASCIZ \STR\ VAL] > ; Top level commands TOPC: XWD -1,NULTAB CC(<;*%x>,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) XWD -1,CODTB CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) XWD -1,YNTB CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) XWD -1,HOSTAB COMTAB: XWD TOPC-.,TOPC YNT: CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) YNTB: XWD YNT-.,YNT ; Null table NTP: CC(<>,) NULTAB: XWD NTP-.,NTP ; Table of character code specifiers CDTB: CC(,) CC(,) CC(,) CC(<%o*%o>,) CODTB: XWD CDTB-.,CDTB ; Command table for terminal modes TRMT: CC(,) CC(,) CC(,) CC(,) TRMTAB: XWD TRMT-.,TRMT ; Command table for echo modes ETP: CC(,) CC(,) CC(,) CC(,) CC(,) ECTAB: XWD ETP-.,ETP ; Command table for socket lookup STP: CC(,) XWD -1,SETTAB XWD -1,NULTAB SKTTAB: XWD STP-.,STP STB: CC(,) CC(,) SETTAB: XWD STB-.,STB ; Pup host names -- these go into the main command table. ; I would do something better if I really understood how this ; all worked! HTP: CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) HOSTAB: XWD HTP-.,HTP ; "Any character" table - used to collect arbitrary strings ; (like host names) ANYT: CC(<%x*%x>,) ANYTAB: XWD ANYT-.,ANYT ; Octal number table OCT: CC(<%o*%o>,) OCTB: XWD OCT-.,OCT ; Decimal number table DCM: CC(<%d*%d>,) DCMTB: XWD DCM-.,DCM ; Letter table LTR: CC(<%a>,) LTRTB: XWD LTR-.,LTR ; Connection name table NAMT: CC(<%n*%n>,) NAMTB: XWD -2,[XWD NAMT-.,NAMT XWD -1,CONTAB] ; Case shift command table SFTAB: CC(,) CC(,) CC(,) CC(,) SFTB: XWD SFTAB-.,SFTAB ; table of identifiers for describe command DSCRT: CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) CC(,) DSCRTB: XWD DSCRT-.,DSCRT ; Symbol evaluator SYMVAL: SETO NOA, SYMVAN: MOVEM PTR,BPTR ; Save beginning of symbol SYMLUP: PUSHJ P,GCH ; Get a character CAIE A,"A"-100 ; Control-a CAIN A,"H"-100 ; Or control-h JRST DELCH ; Delete character CAIN A,"R"-100 JRST RETYPE ; Control-r, retype line CAIN A,"W"-100 ; Control-w JRST DELWRD ; Delete word CAIN A,"?" ; Question mark JRST PRQUES ; Print options CAIE A,33 ; Altmode or CAIN A,37 ; Eol JRST SYMEND ; Lookup CAIE A,"," ; Comma CAIN A," " ; Or space same thing JRST SYMEND IDPB A,PTR ; Else deposit into string PUSHJ P,TRMST SKIPE NFANCY JRST SYMLPE SETZ X, ; Clear x MOVEM P,SVP ; Save p MOVE Y,TAB ; Init y PUSHJ P,SYMLUK ; Lookup the current symbol MOVE P,SVP ; Restore p JUMPE X,[DPB X,PTR ; Smash null onto last character MOVE A,PTR BKJFN ; Back up pointer 0 MOVEM A,PTR JRST DING] ; And echo bell SYMLPE: LDB A,PTR ; Symbol still ok, get char PUSHJ P,ECHOIT JRST SYMLUP ; And loop DELCH: CAMN PTR,BPTR ; Delete character, any to delete? JRST DING ; No, echo bell MOVEI A,"\" PUSHJ P,.PBOUT LDB A,PTR PUSHJ P,.PBOUT MOVE A,PTR BKJFN 0 MOVEM A,PTR JRST SYMLUP TRMST: PUSH P,A PUSH P,PTR SETZ A, IDPB A,PTR POP P,PTR POP P,A POPJ P, DING: MOVEI A,7 PUSHJ P,.PBOUT JRST SYMLUP DELWRD: CAMN PTR,BPTR ; Delete word JRST DING ; Nothing MOVEI A,"#" PUSHJ P,.PBOUT PUSHJ P,.PBOUT DELW0: MOVE PTR,BPTR JRST SYMLUP RETYPE: MOVE A,PTR MOVEI B,0 IDPB B,A MOVEI A,15 PUSHJ P,.PBOUT MOVEI A,12 PUSHJ P,.PBOUT MOVE A,LPTR PUSHJ P,.PSOUT JRST SYMLUP ; End of symbol, try lookup SYMEND: MOVEM A,TERM ; Save terminator PUSHJ P,TRMST SETZ X, MOVE Y,TAB PUSHJ P,SYMLUK JUMPE X,[HRROI A,[ASCIZ / ? /] PUSHJ P,ERROUT MOVE A,TERM CAIE A,37 JRST DELW0 JRST COMLP] CAIE X,1 ; Exactly one symbol JRST SYMAMB ; No. ambiguous POP P,C ; Leave pointer to head in c POP P,B ; Get pointer to tail of command SYMCLP: ILDB A,B ; Copy to terminal JUMPE A,SYMECL MOVE D,TERM SKIPE HDX JRST NCOMP SKIPN NFANCY SKIPE CONCSF NCOMP: CAIN D,33 PUSHJ P,.PBOUT IDPB A,PTR JRST SYMCLP SYMECL: MOVEI A,40 MOVE D,TERM CAIN D,33 JRST [ PUSHJ P,.PBOUT JRST .+4] CAIE D,37 MOVE A,D PUSHJ P,ECHOIT IDPB A,PTR PUSHJ P,TRMST TRZ F,TMPF3!TMPF4!TMPF5 XCT 1(B) ; Execute "value" POPJ P, ; And return XCT 2(B) ; If first value skips, execute 2nd POPJ P, SYMAMB: JUMPE X,DING ; Nothing left, go ding POP P,C ; Leave pointer to head in c POP P,B ; Get pointer to tail ILDB A,B ; Get first ch of tail JUMPN A,[SOJA X,SYMAMB] ; If not null, then loop SYMAML: SOJLE X,SYMECL ; Else unique SUB P,[XWD 2,2] ; Flush the junk JRST SYMAML PRQUES: PUSHJ P,ECHOIT PUSHJ P,TRMST SETZ X, MOVE Y,TAB TRZ F,TMPF5 TRO F,TMPF6 PUSHJ P,SYMLUK ; Get all the possibilities PRQUEL: JUMPE X,RETYPE ; All done, retype the line MOVEI A,37 PUSHJ P,.PBOUT ; Eol TRZ F,TMPF!TMPF2!TMPF4 PRQUEN: ILDB A,0(P) JUMPE A,PRQUEE PRQUEB: CAIN A,"*" JRST [ TRNE F,TMPF3 ; reassurance if in "not" mode TRNE F,TMPF5!TMPF6 CAIA JRST [ PUSH P,A HRROI A,[ASCIZ /[but otherwise] /] PUSHJ P,.PSOUT TRO F,TMPF5 POP P,A JRST PRQUEB] HRROI A,[ASCIZ /.. CAIE B,"%" POPJ P, ILDB B,C CAMN B,A AOS 0(P) ; skip if we have one POPJ P, ] CAIA ; do we have one? JRST [ HRROI A,[ASCIZ //] TRZE F,TMPF2 HRROI A,[ASCIZ /s>/] TRZN F,TMPF HRROI A,[ASCIZ />/] PUSHJ P,.PSOUT JRST PRQUEN PRQUEE: SUB P,[XWD 2,2] ; Flush pointer to end SOJA X,PRQUEL ; And loop ; Lookup symbol ; Operates recursively and accumulates a list of things on the stack SYMLUK: PUSH P,SVP ; Save old bottom MOVEM P,SVP ; Svp points to chain of svp TLNE Y,7000 ; Byte pointer in y? JRST SYMLK1 ; No aobjn word PUSH P,Y ; Yes, sve y MOVE D,BPTR ; Get pointer to symbol SYMLKL: ILDB A,D ; Get character from input ILDB B,Y ; And from table entry PUSHJ P,SYMCMP ; Compare the characters JRST SYMNEQ ; Not equal JUMPN A,SYMLKL ; Continue until null SYMEQL: MOVE A,Y BKJFN ; Back up pointer to tail JRST [ CAIE A,600150 ; dont bomb out if empty list-- 0 ; (non-neg. AOBJN ptr) JRST SYMNEX ] MOVEM A,Y EXCH Y,-2(P) ; Pointer to tail to stack, get ret POP P,A ; Pointer to head POP P,SVP ; Restore svp PUSH P,A ; Pointer to head back to stack AOJA X,0(Y) ; Return and count items SYMNEQ: JUMPE A,SYMEQL ; If input ends first, then substring SYMNEX: SUB P,[XWD 1,1] ; Else flush saved y POP P,SVP ; Restore svp POPJ P, ; And return SYMLK1: PUSH P,Z ; Save z MOVE Z,Y ; Use as place to count y SYMLK3: MOVE Y,0(Z) ; Loop to here for each item PUSHJ P,SYMLUK ; Do this item AOBJN Z,SYMLK3 ; Loop over all things MOVE A,P ; Get p SUB A,[XWD 1,1] CAMN A,SVP ; Any items saved on stack? JRST SYMLK4 ; No, shuffle not needed MOVE A,SVP ; Get base of stack MOVE Z,1(A) ; Restore z POP A,SVP ; Restore svp MOVE Y,0(A) ; Get return MOVEI B,0(A) ; Where to blt to HRLI B,3(A) ; And where from BLT B,-3(P) ; Copy stack down SUB P,[XWD 3,3] JRST 0(Y) ; Return SYMLK4: POP P,Z POP P,SVP POPJ P, SYMCMP: CAIN B,"*" ; Asterisk JRST SYMMNY ; Means any number of CAIN B,"%" ; Percent JRST SYMCLS ; Means character class CAIN B,"#" ; Pound sign JRST SYMNCL ; Means not character class SYMCM2: PUSH P,B PUSH P,A XOR A,B TRZ B,40 ; Ignore case of b CAIL B,"A" ; Then if b has CAILE B,"Z" ; a letter SKIPA TRZ A,40 ; Then ignore case of difference SKIPN A AOS -2(P) POP P,A POP P,B POPJ P, SYMMNY: PUSH P,Y ; Save where we are in table entry ILDB B,Y ; Get what we are doing many of PUSHJ P,SYMCMP ; Check match JRST SYMMNN ; Not equal ILDB B,Y ; See if next is also equal PUSHJ P,SYMCMP JRST [ EXCH A,0(P) ; Not equal, get back y, save a BKJFN 0 MOVEM A,Y POP P,A JRST SKPRET] SUB P,[XWD 1,1] ; Matches next thing, use it instead SKPRET: AOS(P) POPJ P, SYMMNN: SUB P,[XWD 1,1] ; Go to next thiing ILDB B,Y JRST SYMCMP SYMCLS:ILDB B,Y ; Get class indicator CAIN B,"%" ; %% means % JRST SYMCM2 CAIN B,"d" ; d means decimal digit JRST SYMDEC CAIN B,"o" ; o means octal digit JRST SYMOCT CAIN B,"h" JRST SYMHEX CAIN B,"a" ; a means alphabetic JRST SYMALP CAIN B,"n" ; n means alphameric JRST SYMALM CAIN B,"s" ; s means separator JRST SYMSEP CAIN B,"p" ; p for punctuation JRST SYMPNC CAIN B,"x" JRST SYMANY POPJ P, ; Else fail SYMNCL: PUSHJ P,SYMCLS AOS (P) POPJ P, SYMANY: AOS (P) POPJ P, SYMDEC: CAIG A,"9" CAIGE A,"0" POPJ P, JRST SKPRET SYMOCT: CAIG A,"7" CAIGE A,"0" POPJ P, JRST SKPRET SYMHEX: CAIG A,"9" CAIGE A,"0" JRST SYMHE1 JRST SKPRET SYMHE1: TRZ A,40 CAIG A,"F" CAIGE A,"A" POPJ P, JRST SKPRET SYMALM: PUSHJ P,SYMDEC JRST SYMALP JRST SKPRET SYMALP: TRZ A,40 CAIG A,"Z" CAIGE A,"A" POPJ P, JRST SKPRET SYMSEP:SYMPNC:POPJ P, ; Host-name command CONMAX: MOVE A,C ; Pointer to host name JRST CONNX ; Enter "Connect" ; Connect.to .CONN: MOVE TAB,ANYTAB ; Collect arbitrary string PUSHJ P,SYMVAL MOVE A,BPTR ; Save pointer to it CONNX: MOVEM A,FHST MOVE B,[1B0+2B17+C] ; See if legal name expression PUPNM JRST [ HRROI A,[ASCIZ / ? /] PUSHJ P,ERROUT MOVE A,TERM CAIE A,37 JRST .CONN JRST COMLP] TLNE C,-1 ; Net and host specified? TRNN C,-1 JRST [ HRROI A,[ASCIZ / Insufficient address expression./] PUSHJ P,ERROUT JRST COMLP] MOVEM D,FSKT MOVSI X,-NCONN CONNX2: SKIPE A,SNDJFN(X) ; Find an empty connection AOBJN X,CONNX2 JUMPGE X,[ERROR [ASCIZ /too many connections./]] HRRZS NCNX,X MOVE A,NCNX IMULI A,3 ADDI A,CONNAM HRLI A,440700 MOVEI B,1(X) MOVEI C,010 NOUT JFCL IBP A HRLI X,() MOVEM X,1(A) PUSHJ P,DEFSKT CONN2: HRROI A,[ASCIZ /is /] PUSHJ P,.PSOUT TRO F,ICPMOD ; set "ICP in progress" PUSHJ P,ASNSKT PUSHJ P,DOICP ; Do icp JRST [ SKIPN WATFLG ; Failed. wait? JRST [ TRZ F,ICPMOD ; No POPJ P, ] HRROI A,[ASCIZ / First attempt failed, trying again ... /] SKIPG WATFLG PUSHJ P,.PSOUT SKIPLE WATFLG PUSHJ P,TBEL MOVMS WATFLG MOVEI A,^D10000 DISMS JRST .-2] MOVEI A,7 MOVEI B,20 SKIPLE WATFLG PUSHJ P,.PBOUT SOJG B,.-2 MOVEI A,400000 DIR HRROI A,[ASCIZ /complete/] PUSHJ P,.PSOUT TRZ F,ICPMOD SKIPE A,SNDFRK(NCNX) JRST CONN3 MOVSI A,(1B1) CFORK JRST [ JSP X,CONFL0 ASCIZ /can't create send fork./] MOVEM A,SNDFRK(NCNX) PUSHJ P,MAPFRK CONN3: PUSHJ P,INIFRK SKIPE A,RCVFRK(NCNX) JRST CONN4 MOVSI A,(1B1) CFORK JRST [ JSP X,CONFL1 ASCIZ /can't create receive fork./] MOVEM A,RCVFRK(NCNX) PUSHJ P,MAPFRK CONN4: PUSHJ P,INIFRK MOVE CNX,NCNX HLRE A,CONTAB MOVNS A ADD A,CONTAB HRRZ B,CNX IMULI B,3 ADDI B,CONNAM HRLI B,440700 MOVEM B,(A) MOVSI B,-1 ADDM B,CONTAB MOVN A,LSKT(CNX) ASH A,-1 MOVSI B,(1B0) ROT B,(A) IORM B,SKTMSK SETZM SAVSWT(CNX) MOVEI B,SEND MOVE A,SNDFRK(CNX) FFORK SFORK MOVE A,RCVFRK(CNX) MOVEI B,RECV FFORK SFORK TRO F,REMOTF MOVEM CNX,FSVCNX ; change save loc to reflect new CNX MOVEI A,"." PUSHJ P,.PBOUT MOVEI A,400000 EIR POPJ P, CONFL1:CONFL0: HRROI A,[ASCIZ /, but /] PUSHJ P,.PSOUT PUSHJ P,RELCON CONFLX: PUSHJ P,.PSOUT POPJ P, ; Assign local socket for connection ASNSKT: SETCM A,SKTMSK PUSH P,B JFFO A,ASNSK1 MOVEI B,177 ASNSK1: MOVE A,B POP P,B LSH A,1 POPJ P, ; Get foreign socket number or return default socket DEFSKT: SETZM WATFLG SETOM LODFLG DEFSK0: MOVE A,TERM CAIN A,37 POPJ P, MOVE TAB,SKTTAB PUSHJ P,SYMVAL ; Look for qualifiers JRST DEFSK0 ; Perform icp DOICP: MOVEM A,LSKT(NCNX) ; Remember local socket HRROI A,HLPBUF ; Build complete name here HRROI B,[ASCIZ /PUP:/] SETZ C, SOUT MOVE B,LSKT(NCNX) MOVEI C,10 NOUT 0 HRROI B,[ASCIZ /!J./] SETZ C, SOUT MOVE B,FHST ; Foreign host name SOUT LDB B,A ; See if command scanner put space on end CAIN B,40 BKJFN ; Yes, back up over it CAI HRROI B,[ASCIZ /+Telnet/] SKIPG FSKT ; Foreign socket specified? SOUT ; No, default MOVSI A,(1B2+1B17) ; Short form, name from string HRROI B,HLPBUF GTJFN ; Get a JFN for the port JRST OPNCO7 MOVEM A,SNDJFN(NCNX) ; Ok, save output JFN MOVE B,[8B5+8B17+1B20] ; Bytesize 8, 30-second timeout OPENF ; Initiate rendezvous JRST OPNCO4 ; Failed ; Now make name string and open same port for input MOVE C,[2,,C] ; Get foreign port address GDSTS PUSH P,D ; Save it PUSH P,C CVSKT ; Get local port address 0 PUSH P,C HRROI A,HLPBUF ; Where to build name HRROI B,[ASCIZ /PUP:/] SETZ C, SOUT POP P,B MOVEI C,10 NOUT 0 HRROI B,[ASCIZ /!A./] SETZ C, SOUT HLRZ B,0(P) ; Recover net MOVEI C,10 NOUT 0 MOVEI B,"#" BOUT POP P,B ; Host HRRZS B NOUT 0 MOVEI B,"#" BOUT POP P,B ; Socket NOUT 0 MOVSI A,(1B2+1B17) ; Short form, name from string HRROI B,HLPBUF GTJFN ; Get a JFN for the port JRST OPNCO6 ; Failed (unlikely) MOVEM A,RECJFN(NCNX) ; Ok, save input JFN MOVE B,[8B5+1B19] ; Bytesize 8, open for input OPENF JRST OPNCO5 ; Failed (unlikely) JRST SKPRET ; Return +2 ; Failure from first OPENF OPNCO4: HRLM A,0(P) ; Save error code MOVE A,SNDJFN(NCNX) ; Recover JFN RLJFN ; Release it 0 HLRZ A,0(P) ; Recover error code JRST OPNCO7 ; Failure from second OPENF OPNCO5: HRLM A,0(P) ; Save error code HRRZ A,RECJFN(NCNX) ; Release the input JFN RLJFN 0 HLRZ A,0(P) ; Recover error code ; Failure from second GTJFN OPNCO6: HRLM A,0(P) HRRZ A,SNDJFN(NCNX) ; Get output JFN MOVEI B,25 ; Abort function SETZ C, ; No code assigned HRROI D,[ASCIZ /Connection attempt aborted/] ; Abort text MTOPR ; Abort the connection CLOSF ; Close the port 0 ; Can't fail after abort done HLRZ A,0(P) OPNCO7: SETZM RECJFN(NCNX) SETZM SNDJFN(NCNX) SKIPLE WATFLG POPJ P, ; No message on repeat failures HRROI B,[ASCIZ /of unknown problem./] CAIN A,OPNX20 ; Check for special cases HRROI B,[ASCIZ /connection attempt timed out./] CAIN A,OPNX21 HRROI B,[ASCIZ /connection attempt rejected by remote host./] HRROI A,[ASCIZ /incomplete, because /] PSOUT MOVE A,B PSOUT POPJ P, ; Take fail return RELCON: MOVEI A,400000 DIR MOVE X,NCNX PUSHJ P,DSCNCT MOVEI A,400000 EIR POPJ P, DSCNCT: MOVE A,SNDJFN(X) ; Disconnect current conx CLOSF JRST [ MOVE A,SNDJFN(X) CLOSF CAI JRST .+1] MOVE A,RECJFN(X) CLOSF CAI MOVE A,SNDJFN(X) RLJFN CAI MOVE A,RECJFN(X) RLJFN CAI SETZM SNDJFN(X) SETZM RECJFN(X) POPJ P, ; Disconnect .DISC: MOVE A,TERM MOVE X,CNX CAIN A,37 JRST DISC1 SKIPL TAB,CONTAB POPJ P, PUSHJ P,SYMVAL MOVE X,A DISC1: MOVEI A,400000 DIR CAMN X,CNX TRZ F,REMOTF MOVE A,ABNCNX ; Might be abncnx SETOM ABNCNX ; Clear it CAMN X,A ; And if it was SETOM ABNLCK ; Unlock abnlck MOVEI A,0 EXCH A,ALTJFN(X) ; flush file input if any SKIPLE A PUSHJ P,CLRJFN SKIPN A,RECJFN(X) POPJ P, ; No connection MOVE A,RCVFRK(X) FFORK SETZ NOA, EXCH X,CNX PUSHJ P,SETLGF EXCH X,CNX PUSHJ P,DSCNCT ; break connection MOVN A,LSKT(X) ASH A,-1 MOVSI B,(1B0) ROT B,(A) ANDCAM B,SKTMSK IMULI X,3 ; Compute pointer to this name ADDI X,CONNAM HRLI X,440700 MOVE Y,CONTAB CAME X,0(Y) ; Search for entry in contb AOBJN Y,.-1 MOVE A,1(Y) ; Move entries above here, down to MOVEM A,0(Y) ; fill in the gap AOBJN Y,.-2 MOVSI X,1 ADDM X,CONTAB ; One less entry in contb MOVEI A,400000 EIR POPJ P, ; Set name for connection .STNAM: MOVE TAB,NAMTB TRO F,TMPF3 PUSHJ P,SYMVAL JUMPGE A,NAMINU HRRZ A,NCNX IMULI A,3 ADDI A,CONNAM HRLI A,440700 MOVE B,BPTR MOVEI C,^D8 LDB D,PTR ; Get terminator SOUT ; Copy through it SETZ B, DPB B,A ; Replace terminator with null MOVE B,NCNX HRLI B,() MOVEM B,1(A) POPJ P, NAMINU: ERROR [ASCIZ /name already in use/] ; Set auto switching to active connection feature ACTVST: JUMPE NOA,[ SETZM ACTVSW POPJ P, ] HRROI A,[ASCIZ /after /] PUSHJ P,.PSOUT MOVEI B,2 MOVE A,TERM CAIN A,37 JRST [ MOVEI A,101 ; if crlf, use default value MOVEI C,12 PUSHJ P,.NOUT JFCL MOVEI A,40 PUSHJ P,.PBOUT MOVE A,B JRST ACTVS2 ] ACTVS1: MOVE TAB,DCMTB PUSHJ P,SYMVAL ; else get time limit in min. SKIPG A ; only positive times... JRST [ HRROI A,[ASCIZ / ? /] PUSHJ P,.PSOUT JRST ACTVS1 ] ACTVS2: IMULI A,^D60000 MOVEM A,ACTVTM SETOM ACTVSW MOVE B,A HRROI A,[ASCIZ /minutes./] CAIN B,^D60000 HRROI A,[ASCIZ /minute./] PUSHJ P,.PSOUT POPJ P, ; Wait for a connection wanting to print WATRET: MOVSI X,-NCONN WATREL: SKIPN A,SNDJFN(X) JRST WATREX SKIPG SAVINC(X) JRST WATREX HRROI A,[ASCIZ / connection /] PUSHJ P,.PSOUT HRRZ A,X IMULI A,3 HRROI A,CONNAM(A) PUSHJ P,.PSOUT HRROI A,[ASCIZ / ready. /] PUSHJ P,.PSOUT HRRZ A,X JRST RETCO1 WATREX: AOBJN X,WATREL MOVEI A,^D10000 DISMS JRST WATRET ; Retrieve connection RETCON: SKIPL TAB,CONTAB JRST [ HRROI A,[ASCIZ / No connections. /] PUSHJ P,.PSOUT POPJ P,] PUSHJ P,SYMVAL RETCO1: MOVEM A,CNX TRO F,REMOTF POPJ P, ; List connections LSTCON: TRZ F,TMPF MOVE X,CONTAB JUMPGE X,LSTCOX LSTCOL: HRROI A,[ASCIZ / -Name- -From- --To-- /] TRON F,TMPF PUSHJ P,.PSOUT SETZ C, MOVE A,(X) PUSHJ P,.PSOUT MOVE B,1(A) MOVEI A,11 PUSHJ P,.PBOUT HRRZ B,SNDJFN(B) MOVEI A,101 MOVE C,[BYTE (3)0,0,1,1,0,0,0(5)0,0,2] JFNS SKIPE A,SCRJFN JFNS PUSHJ P,SCRUPD MOVEI A,37 PUSHJ P,.PBOUT LSTCOX: AOBJN X,LSTCOL HRROI A,[ASCIZ / No saved connections./] TRZN F,TMPF PUSHJ P,.PSOUT POPJ P, ; Exec .EXEC: HRROI B,[ASCIZ /EXEC.SAV/] MOVSI C,(1B0) ; cause interrupts to go off MOVSI A,100001 JRST SBGET ; Run .RUN: MOVSI A,100003 MOVE B,[XWD 100,101] SETZ C, SBGET: PUSH P,B PUSHJ P,GTJFN0 JRST [ POP P,A TLNN A,-1 PUSHJ P,.PSOUT ERROR [ASCIZ / not available./]] SUB P,[XWD 1,1] MOVEI A,400000 DIR MOVSI A,(1B1!1B3) MOVEI B,FAC CFORK JRST [ HRROI A,[ASCIZ /No forks available./] JRST GETF] MOVEM A,SPCFRK HRLZ A,SPCFRK HRR A,IJFN GET SETZM IJFN MOVEI A,400000 EIR JUMPGE C,SBGET4 DIR MOVE A,ESCCOD DTI MOVE A,CBFCOD DTI SBGET4: PUSH P,C MOVEI A,100 MOVE B,TTCOC0 MOVE C,TTCOC1 SFCOC MOVE B,TTMOD0 SFMOD HRRZ B,0(P) MOVE A,SPCFRK SFRKV WFORK MOVEI A,400000 DIR MOVE A,SPCFRK KFORK SETZM SPCFRK POP P,C JUMPGE C,SBGET5 MOVEI A,ESCCHN HRL A,ESCCOD ATI MOVEI A,CBFCHN HRL A,CBFCOD ATI SBGET5: MOVEI A,400000 EIR POPJ P, GETF: PUSH P,A MOVEI A,400000 EIR SKIPE A,IJFN PUSHJ P,CLRJFN SETZM IJFN POP P,A PUSHJ P,.PSOUT POPJ P, ; Set escape character SETESC: PUSHJ P,SETICH ESCAPE ESCCOD ESCCHN POPJ P, SETCBF: PUSHJ P,SETICH CBFCHR CBFCOD CBFCHN POPJ P, SETICH: MOVE X,0(P) ADDI X,3 EXCH X,0(P) SETIC1: PUSHJ P,.PBIN CAIN A,"?" JRST PRESC PUSH P,A PUSHJ P,CVINTC JRST SETED PUSH P,A MOVEI A,400000 DIR POP P,A MOVE B,0(P) MOVEM B,@0(X) EXCH A,@1(X) DTI HRLZ A,@1(X) HRRI A,@2(X) ATI MOVE A,0(P) CAIL A,40 JRST SETE1 MOVEI A,"^" PUSHJ P,ECHOIT MOVEI A,100 ADDM A,0(P) SETE1: POP P,A PUSHJ P,ECHOIT MOVEI A,400000 EIR POPJ P, SETED: POP P,A MOVEI A,7 PUSHJ P,.PBOUT JRST SETIC1 PRESC: PUSHJ P,ECHOIT ; echo the "?" HRROI A,[ASCIZ / control-@ through control-z altmode rubout space /] PUSHJ P,.PSOUT MOVE A,LPTR PUSHJ P,.PSOUT JRST SETIC1 ; Set terminal modes SETTRM: MOVE TAB,TRMTAB JRST SYMVAL ; Set synch character SETSNC: SETOM SYNC JUMPGE NOA,SETIWK PUSHJ P,.PBIN PUSHJ P,ECHOIT MOVEM A,SYNC JRST SETIWK ; Set single charcter quote prefix SETQOT: SETOM QUOT JUMPGE NOA,SETIWK PUSHJ P,.PBIN PUSHJ P,ECHOIT MOVEM A,QUOT JRST SETIWK ; Set unshift prefix SETUNS: SETOM UNSFT JUMPGE NOA,SETIWK PUSHJ P,.PBIN PUSHJ P,ECHOIT MOVEM A,UNSFT JRST SETIWK ; Set case shift prefixes SETSHF: PUSH P,NOA ; Save noa MOVE TAB,SFTB PUSHJ P,SYMVAL POP P,NOA SETOM (A) ; Turn off prefix JUMPGE NOA,SETIWK ; Done if "no" PUSH P,A PUSHJ P,.PBIN PUSHJ P,ECHOIT MOVEM A,@(P) SUB P,[XWD 1,1] SETIWK: PUSH P,C ; create new special char. PUSH P,B ; wakeup mask SETZ A, MOVSI C,-NSPECH ADD C,[XWD 2,2] ; omitting escape & clrobf SETIW1: HLRZ B,CSTAB(C) SKIPGE B,(B) ; lookup each spec. char. JRST SETIW2 HLRZ B,RCTGTB(B) ; OR in wakeup memshp if it exists IOR A,B SETIW2: AOBJN C,SETIW1 MOVEM A,SPECWK ; store in specwk POP P,B POP P,C POPJ P, ; Echo.mode.is .ECHO: MOVE TAB,ECTAB JRST SYMVAL CHGECH: HRROI A,[ASCIZ /A half-duplex terminal (which I believe you have) will not work well with remote echoing./] SKIPE HDX SKIPE ELCLF(CNX) CAIA PUSHJ P,.PSOUT POPJ P, ; DONT ECHO ; Terminal has lower case SETLWR: MOVEM NOA,TRMLWC MOVSI B,(1B3) JUMPGE NOA,SETLW1 IORM B,TTMODR IORB B,TTMODC JRST SETLW2 SETLW1: ANDCAM B,TTMODR ANDCAB B,TTMODC SETLW2: MOVEI A,101 STPAR POPJ P, SNDSNC: SKIPN A,SNDJFN(CNX) ; Send "sync" POPJ P, ; Connection not ok MOVEI B,22 ; First send interrupt SETZB C,D MTOPR MOVEI B,3 ; Then send mark type DM MOVEI C,1 MTOPR POPJ P, ; Set control character echoing SETCOC: PUSHJ P,GCH CAIN A,"?" JRST SETCOQ PUSHJ P,ECHOIT SETCO2: CAIN A,37 MOVEI A,15 MOVEM A,TERM PUSHJ P,.PBIN PUSHJ P,ECHOIT EXCH A,TERM ANDI A,37 MOVSI B,400000 MOVNS A ROT B,(A) SKIPN NOA ANDCAM B,ECHCOC(CNX) SKIPE NOA IORM B,ECHCOC(CNX) MOVE A,TERM CAIE A,37 JRST [ CAIE A,40 CAIN A,"," JRST SETCOC JRST SETCO2] POPJ P, SETCOQ: HRROI A,[ASCIZ / control characters or letter equivalents /] PUSHJ P,.PSOUT MOVE A,LPTR PUSHJ P,.PSOUT JRST SETCOC SETCOE: MOVEI A,7 PUSHJ P,.PBOUT JRST SETCOC ; Print current modes PRCMD: MOVSI X,-NPMDTB PRCMD1: MOVEI A,37 PUSHJ P,.PBOUT MOVSI C,CNX HLR C,PCMDTB(X) HRROI A,[ASCIZ /no /] SKIPN @C PUSHJ P,.PSOUT HRRO A,PCMDTB(X) PUSHJ P,.PSOUT AOBJN X,PRCMD1 HRROI A,[ASCIZ / Special characters: /] PUSHJ P,.PSOUT MOVSI X,-NSPECH PCSLP: HLRZ B,CSTAB(X) SKIPG (B) JRST PCSLPN HRRO A,CSTAB(X) PUSHJ P,.PSOUT MOVEI A,11 PUSHJ P,.PBOUT MOVE A,(B) PUSHJ P,.PBOUT PCSLPE: MOVEI A,37 PUSHJ P,.PBOUT PCSLPN: AOBJN X,PCSLP SKIPE D,ECHCOC(CNX) SKIPN ELCLF(CNX) POPJ P, ; Done if not local echo or no coc HRROI A,[ASCIZ / Local echo for control /] PUSHJ P,.PSOUT PRCM2: JFFO D,.+1 MOVSI B,400000 MOVN C,D+1 ROT B,(C) ANDCAM B,D JUMPN D,PRCM1 HRROI A,[ASCIZ /and /] CAME B,ECHCOC(CNX) PUSHJ P,.PSOUT PRCM1: MOVEI A,100(D+1) PUSHJ P,.PBOUT JUMPE D,CPOPJ HRROI A,[ASCIZ /, /] PUSHJ P,.PSOUT JRST PRCM2 PCMDTB: XWD RAISEF,[ASCIZ /Raise/] XWD LOWERF,[ASCIZ /Lower/] XWD ELCLF,[ASCIZ /Local echo/] XWD LFCRF,[ASCIZ /Echo linefeed for carriage return/] XWD LNBFF,[ASCIZ /Line buffer/] NPMDTB==.-PCMDTB CSTAB: XWD ESCAPE,[ASCIZ /Escape: /] XWD CBFCHR,[ASCIZ /Clrobf: /] XWD QUOT,[ASCIZ /Quote: /] XWD UNSFT,[ASCIZ /Unshift:/] XWD LCASC,[ASCIZ /Char.lower:/] XWD LCASL,[ASCIZ /Lock.lower:/] XWD UCASC,[ASCIZ /Char.upper:/] XWD UCASL,[ASCIZ /Lock.upper:/] XWD SYNC,[ASCIZ /Synch: /] NSPECH==.-CSTAB ; Help .HELP: HRROI A,[ASCIZ / The describe command is the efficient way to get specific questions answered; type "describe describe" to see how./] PUSHJ P,.PSOUT HRROI A,[ASCIZ / You may also wish to list the file CHAT.HELP on the LPT: for future reference./] PUSHJ P,.PSOUT HRROI A,[ASCIZ / Or you may continue with "help" to get the help file typed out in pieces. Continue? /] PUSHJ P,.PSOUT PUSHJ P,OPNHLP ; open help file POPJ P, ; can't JRST TYPAL TYPLP: MOVEI X,^D20 TYPLP1: MOVE A,IJFN MOVE B,[POINT 7,COMBUF] MOVEI C,200*5-3 MOVEI D,12 SIN GTSTS TLNE B,1000 JRST ETYPL MOVEI A,101 MOVE B,[POINT 7,COMBUF] MOVEI C,200*5-3 MOVEI D,12 PUSHJ P,.SOUT SOJG X,TYPLP1 CAIGE C,200*5-3-2 JRST TYPLP1 HRROI A,[ASCIZ / More help? /] PUSHJ P,.PSOUT TYPAL: PUSHJ P,.PBIN CAIE A,"Y" CAIN A,"Y"+40 JRST TYPMO CAIE A,"N" CAIN A,"N"+40 JRST TYPNO MOVEI A,7 PUSHJ P,.PBOUT JRST TYPAL TYPMO: HRROI A,[ASCIZ /Yes /] PUSHJ P,.PSOUT JRST TYPLP TYPNO: HRROI A,[ASCIZ /No /] PUSHJ P,.PSOUT JRST ETYPX ETYPL: SUBI C,200*5-3 SOUT ETYPX: MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN POPJ P, ; describe .DSCRB: MOVE TAB,DSCRTB PUSHJ P,SYMVAL ; get identifier, str ptr in bptr PUSHJ P,OPNHLP ; now open help file POPJ P, SETZB B,X ; overlay null to separator in input DPB B,PTR DSCRB1: PUSHJ P,RDHLRB ; read help file up to next rubout PUSHJ P,RDHLP ; read following string MOVE D,BPTR MOVE Y,[POINT 7,HLPBUF] ; now compare string from file MOVE A,HLPBUF ; to "[no] ", scan off if present, CAMN A,[ASCII /[no] /] ADDI Y,1 ; then compare input identifier string DSCRB2: ILDB A,D ; to present string from file ILDB B,Y PUSHJ P,SYMCMP JRST [ JUMPE A,DSCRB3 ; unequal: substring match if input JRST DSCRB1 ] ; ends first; else get next record JUMPN A,DSCRB2 ; exact match if null, else keep cmprng DSCRB3: MOVEI A,37 ; file rec matches input identifier PUSHJ P,.PBOUT ; type initial PUSHJ P,.PBOUT DSCRB4: MOVEI A,101 MOVE B,[POINT 7,HLPBUF] MOVEI C,200*5-3 MOVEI D,177 ; type out text PUSHJ P,.SOUT LDB A,B CAIN A,177 ; did output end on a rubout marker? JRST ETYPX ; yes, done, close file & exit PUSHJ P,RDHLP ; no, read another buffer load JRST DSCRB4 RDHLRB: JUMPE X,RDHLRR ; read file up to rubout marker RDHLRC: LDB A,X ; if str ptr in b, check if already CAIN A,177 ; at a rubout POPJ P, ; yes, exit RDHLRR: PUSHJ P,RDHLP ; no rubout, read another record JRST RDHLRC RDHLP: MOVE A,IJFN ; read help file into buffer GTSTS TLNE B,1000 ; failure if file already at eof ERROR [ASCIZ /help item not found./] MOVE B,[POINT 7,HLPBUF] ; (should never happen) MOVEI C,200*5-3 MOVEI D,177 ; read full buffer or up to rubout SIN MOVE X,B ; save updated pointer GTSTS TLNN B,1000 POPJ P, MOVEI A,177 IDPB A,X ; if eof, smash rubout into buf POPJ P, OPNHLP: MOVEI A,400000 ; get and open help file DIR HRROI B,[ASCIZ /CHAT.HELP/] MOVSI A,100001 GTJFN JRST [ MOVEI A,400000 EIR HRROI A,[ASCIZ /Help file not found./] PUSHJ P,.PSOUT POPJ P,] MOVEM A,IJFN MOVEI A,400000 EIR MOVE A,IJFN MOVE B,[XWD 70000,200000] OPENF JRST [ MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN HRROI A,[ASCIZ /Help file can't be opened./] PUSHJ P,.PSOUT POPJ P,] JRST SKPRET ; 2nd return if success ; Typescript to a file SETSCR: PUSHJ P,UGTAD MOVEM B,SCRTIM ; Time of last typescript entry SETZM SCRCNT ; Characters output since last openf MOVEI A,400000 DIR SETZ A, EXCH A,SCRJFN SKIPLE A PUSHJ P,CLRJFN MOVEI A,400000 EIR SKIPL NOA ; file flushed, done if "no" POPJ P, PUSHJ P,.PBIN ; wait for input CAIE A,33 CAIN A,37 ; get default typscr file if CR or ESC JRST [ MOVEI A,400000 DIR GJINF MOVE B,A HRROI A,LGDRST ; always open file in login directory DIRST JFCL ; (can't fail) MOVEI A,[ 1B0 XWD 377777,377777 0 POINT 7,LGDRST REPEAT 5,<0> ] HRROI B,[ASCIZ /CHAT.TYPESCRIPT;T;P770000/] GTJFN JRST [ MOVEI A,400000 EIR POPJ P,] PUSH P,A MOVE B,[XWD 70000,20000] OPENF JRST [ POP P,A RLJFN JFCL MOVEI A,400000 EIR POPJ P,] HRROI B,[ASCIZ / CHAT typescript file started at /] SETZ C, SOUT SETO B, MOVE C,[1B1+1B7+1B12+1B17] ODTIM MOVEI B,15 BOUT MOVEI B,12 BOUT POP P,SCRJFN MOVEI A,400000 EIR POPJ P,] SKIPN HDX PBOUT ; echo first char typed... MOVEI A,100 ; if non-terminator typed, back up BKJFN ; and get user-named file 0 MOVEI A,[XWD 460000,0 XWD 100,101 REPEAT 4,<0> XWD 500000,770000 REPEAT 2,<0>] SETZ B, PUSHJ P,GTJFN0 ; get any file name, but with self-only ERROR [ASCIZ /File not available./] MOVE B,[XWD 70000,100000] OPENF JRST [ MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN ERROR [ASCIZ /Cannot open file./]] MOVEI A,400000 DIR MOVEI B,0 EXCH B,IJFN MOVEM B,SCRJFN EIR POPJ P, ; Get uniform time in secs UGTAD: GTAD HRRZS B,A HLRZS A IMULI A,^D24*^D60*^D60 ADDB A,B POPJ P, ; Update script file SCRUPD: SKIPN SCRJFN POPJ P, PUSH P,A PUSH P,B SKIPGE SCRTIM JRST SCRUP0 ; Forced update PUSHJ P,UGTAD SUB B,SCRTIM ; Ho long since last update? CAIG B,^D30 JRST SCRUPX ; Never less than 30 secs CAIL B,^D300 JRST SCRUP0 ; Always every 5 min MOVE A,SCRJFN RFPTR SETZ B, SUB B,SCRCNT CAIG B,^D1000 JRST SCRUPX ; Then not fewer thant 1000 chars SCRUP0: PUSHJ P,UGTAD MOVEM B,SCRTIM MOVE A,SCRJFN RFPTR SETZ B, MOVEM B,SCRCNT HRLI A,400000 CLOSF JFCL HRRZS A MOVE B,[XWD 70000,20000] OPENF 0 SCRUPX: POP P,B POP P,A POPJ P, ; Connection's output to a file as it arrives SETLGF: PUSHJ P,UGTAD MOVEM B,LGFTIM(CNX) ; Time of last logging entry SETZM LGFCNT(CNX) ; Characters output since last openf MOVEI A,400000 DIR SETZ A, EXCH A,LGFJFN(CNX) SKIPLE A PUSHJ P,CLRJFN MOVEI A,400000 EIR SKIPL NOA ; file flushed, done if "no" POPJ P, MOVEI A,[XWD 460000,0 XWD 100,101 REPEAT 4,<0> XWD 500000,770000 REPEAT 2,<0>] SETZ B, PUSHJ P,GTJFN0 ; get any file name, but with self-only ERROR [ASCIZ /File not available./] MOVE B,[XWD 70000,100000] OPENF JRST [ MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN ERROR [ASCIZ /Cannot open file./]] MOVEI A,400000 DIR MOVEI B,0 EXCH B,IJFN MOVEM B,LGFJFN(CNX) MOVE A,LGFJFN(CNX) HRROI B,[ASCIZ / CHAT logging file started at /] SETZ C, SOUT SETO B, MOVE C,[1B1+1B7+1B12+1B17] ODTIM SKIPN SNDJFN(CNX) ; Is there a connection? JRST LGNJFN ; No, don't try to print its name HRROI B,[ASCIZ / on connection /] SETZ C, SOUT MOVE B,CNX IMULI B,3 ADDI B,CONNAM HRROS B SOUT HRROI B,[ASCIZ / from /] SOUT HRRZ B,SNDJFN(CNX) MOVE D,B MOVSI C,() JFNS HRROI B,[ASCIZ / to /] SETZ C, SOUT MOVE B,D MOVSI C,() JFNS LGNJFN: MOVEI B,15 BOUT MOVEI B,12 BOUT MOVEI A,400000 EIR POPJ P, ; Update logging file LGFUPD: SKIPN LGFJFN(CNX) POPJ P, PUSH P,A PUSH P,B SKIPGE LGFTIM(CNX) JRST LGFUP0 ; Forced update PUSHJ P,UGTAD SUB B,LGFTIM(CNX) ; How long since last update? CAIG B,^D60 JRST LGFUPX ; Never less than 60 secs CAIL B,^D300 JRST LGFUP0 ; Always every 5 min MOVE A,LGFJFN(CNX) RFPTR SETZ B, SUB B,LGFCNT(CNX) CAIG B,^D10 JRST LGFUPX ; Then not fewer thant 10 chars LGFUP0: PUSHJ P,UGTAD MOVEM B,LGFTIM(CNX) MOVE A,LGFJFN(CNX) RFPTR SETZ B, MOVEM B,LGFCNT(CNX) HRLI A,400000 CLOSF JFCL HRRZS A MOVE B,[XWD 70000,20000] OPENF 0 LGFUPX: POP P,B POP P,A POPJ P, ; Divert output to a file SETDIV: MOVEI A,400000 DIR MOVEI A,0 EXCH A,DIVJFN SKIPLE A PUSHJ P,CLRJFN MOVEI A,400000 EIR JUMPGE NOA,CPOPJ MOVSI A,460003 PUSHJ P,.GTJFN ERROR [ASCIZ /File not found./] MOVE B,[XWD 70000,100000] OPENF JRST [ MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN ERROR [ASCIZ /Cannot open./]] MOVEI A,400000 DIR MOVEI B,0 EXCH B,IJFN MOVEM B,DIVJFN EIR POPJ P, ; Take input from a file (remote mode) SETALT: MOVEI A,400000 DIR MOVEI A,0 EXCH A,ALTJFN(CNX) SKIPLE A PUSHJ P,CLRJFN MOVEI A,400000 EIR JUMPGE NOA,CPOPJ MOVSI A,160003 PUSHJ P,.GTJFN ERROR [ASCIZ /File not found./] MOVE B,[XWD 1,11] MOVEI C,C GTFDB LDB B,[POINT 6,C,11] CAIE B,7 ERROR [ASCIZ /Not an ASCII file./] SIZEF ERROR [ASCIZ /File not found./] MOVEM B,ALTJCT(CNX) MOVE B,[XWD 70000,200000] OPENF JRST [ MOVE A,IJFN PUSHJ P,CLRJFN SETZM IJFN ERROR [ASCIZ /Cannot open./]] MOVEI A,400000 DIR MOVEI B,0 EXCH B,IJFN MOVEM B,ALTJFN(CNX) EIR POPJ P, ; Print where we are .WHERE: MOVEI A,37 PUSHJ P,.PBOUT SKIPN A,SNDJFN(CNX) JRST NOCC HRROI A,[ASCIZ /Connection /] PUSHJ P,.PSOUT MOVE A,CNX IMULI A,3 ADDI A,CONNAM HRROS A PUSHJ P,.PSOUT HRROI A,[ASCIZ / from /] PUSHJ P,.PSOUT HRRZ B,SNDJFN(CNX) MOVEI A,101 MOVSI C,() JFNS SKIPE A,SCRJFN JFNS HRROI A,[ASCIZ / to /] PUSHJ P,.PSOUT HRRZ B,SNDJFN(CNX) MOVEI A,101 MOVSI 3,() JFNS SKIPE A,SCRJFN JFNS MOVEI A,37 PUSHJ P,.PBOUT NOCC: MOVE A,[SIXBIT /SYSVER/] SYSGT MOVE D,P HRRZ C,B HLLZS B .WHRL: MOVE A,C HRL A,B GETAB JFCL PUSH P,A AOBJN B,.WHRL PUSH P,[0] HRROI A,1(D) PUSHJ P,.PSOUT MOVE P,D HRROI A,[ASCIZ / Job /] PUSHJ P,.PSOUT GJINF PUSH P,1 MOVEI A,101 MOVE B,C MOVEI C,12 PUSHJ P,.NOUT JFCL HRROI A,[ASCIZ /, terminal /] PUSHJ P,.PSOUT MOVE B,D MOVEI C,10 MOVEI A,101 PUSHJ P,.NOUT JFCL HRROI A,[ASCIZ /, user /] PUSHJ P,.PSOUT POP P,B MOVEI A,101 DIRST JFCL SKIPLE A,SCRJFN DIRST JFCL HRROI A,[ASCIZ / CHAT version /] PUSHJ P,.PSOUT HRROI A,VERNUM PUSHJ P,.PSOUT POPJ P, ; Reset .RESET: JRST RSTART ; Logout .LGOUT: HRROI A,[ASCIZ / [Confirm] /] PUSHJ P,.PSOUT PUSHJ P,.PBIN CAIE A,37 POPJ P, PUSHJ P,.PBOUT MOVNI 1,1 LGOUT HALTF ; Quit, exit back to exec .QUIT: SETOM SCRTIM PUSHJ P,SCRUPD ; Update script before leaving MOVSI CNX,-NCONN QUITA: SETOM LGFTIM(CNX) PUSHJ P,LGFUPD AOBJN CNX,QUITA MOVEI A,400000 DIR HALTF MOVEI A,-4 FFORK MOVE CNX,FSVCNX MOVEI A,400000 EIR POPJ P, ; Send code and control SNDDCD: IBP BPTR ; Send decimal # as code PUSHJ P,CVDEC JRST SNDC SNDOCD: IBP BPTR ; Send octal # as code SNDOCT: PUSHJ P,CVOCT JRST SNDC SNDHCD: IBP BPTR ; Send hex # as code SETZ A, SNDHCL: ILDB B,BPTR JUMPE B,SNDC CAIL B,"A" ADDI B,11 ANDI B,17 ASH A,4 ADD A,B JRST SNDHCL SNDCTL: MOVE TAB,LTRTB ; Send control char. PUSHJ P,SYMVAL ANDI A,37 JRST SNDC SNDCD1: PUSHJ P,CVOCT SNDC: MOVE B,A SKIPN SNDJFN(CNX) POPJ P, PUSHJ P,SNDCH ; Send and push out byte PUSHJ P,TRNSMT POPJ P, ; Set remote mode SETREM: SKIPE A,SNDJFN(CNX) TRO F,REMOTF POPJ P, DOCOMT: PUSHJ P,GCH PUSHJ P,ECHOIT CAIE A,37 JRST DOCOMT POPJ P, CVOCT: SKIPA C,[10] CVDEC: MOVEI C,^D10 MOVE A,BPTR NIN SETZ B, MOVE A,B POPJ P, SEND: CIS MOVEM CNX,FSVCNX ; save CNX for later restoration MOVE P,[XWD -100,SPDL-1] MOVE PTR,[POINT 7,LINBUF-1,34] ; Send terminal parameters first MOVEI A,101 SKIPN B,REALTT ; Really a scope? GTTYP ; No, get actual type MOVEI A,4 ; Send terminal type PUSHJ P,SNTPAR MOVEI A,101 RFMOD LDB C,[POINT 7,B,10] ; Save length PUSH P,C LDB B,[POINT 7,B,17] ; Get width MOVEI A,2 ; Send line width PUSHJ P,SNTPAR POP P,B MOVEI A,3 ; Send line length PUSHJ P,SNTPAR SEND0: PUSHJ P,.PBIN SKIPE ACTVSW ; account time PUSHJ P,SNDTIM ANDI A,177 SKIPE XPARNT(CNX) ; Completely transparent? JRST [ MOVE B,A ; Yes PUSHJ P,SNDCH PUSHJ P,TRNSMT JRST SEND0] AOSN QUOTF JRST SEND02 ; Not special (may be shifted though) CAMN A,QUOT ; Quote character JRST [ SETOM QUOTF ; Yes, remember JRST SEND0] CAMN A,SYNC ; Synch substitute JRST [ PUSHJ P,SNDSNC ; Yes, send sync seq JRST SEND0] CAMN A,UNSFT ; Now for the shifts...unshift? JRST [ SETZM RAISEF(CNX) SETZM LOWERF(CNX) SETZM UCASCF SETZM LCASCF ; clear all shift flags JRST SEND0] CAME A,LCASC CAMN A,UCASC JRST SETCAS CAME A,LCASL CAMN A,UCASL JRST SETCAS SEND02: CAIG A,136 ; Regular character...needs shift? CAIGE A,100 JRST SEND1 ; Not upper case AOSE UCASCF ; Upper case. if no upper case shift PUSHJ P,SFTDWN ; Then see if down shift wanted JRST SEND3 SEND1: CAIG A,176 CAIGE A,140 JRST SEND3 ; Not lower case either AOSE LCASCF ; Lower case. if no down shift PUSHJ P,SFTUP ; Then shift up if wanted JRST SEND3 SETCAS: SETZM LCASCF ; Clear character shifts SETZM UCASCF CAMN A,LCASC ; If lower case char prefix JRST [ SETOM LCASCF ; Remember JRST SEND0] CAMN A,UCASC ; If upper case char prefix JRST [ SETOM UCASCF ; Remember JRST SEND0] SETZM LOWERF(CNX) ; Clear shift locks SETZM RAISEF(CNX) CAMN A,LCASL JRST [ SETOM LOWERF(CNX) JRST SEND0] CAMN A,UCASL JRST [ SETOM RAISEF(CNX) JRST SEND0] SEND3: SKIPN LNBFF(CNX) ; If not line buffering PUSHJ P,SNDBUF ; Send any stuff already buffered CAIN A,37 MOVEI A,15 REPEAT 0,< JRST [ HRROI A,15 PUSHJ P,SNDDO SETCM A,LFCRF(CNX) ; Get complement of switch HRRI A,12 ; Line feed JRST .+1] > PUSHJ P,SNDDO HRRZS A CAIE A,12 CAIN A,33 PUSHJ P,SNDBUF JRST SEND0 SFTDWN: AOSE LCASCF SKIPE LOWERF(CNX) TRO A,140 POPJ P, SFTUP: AOSE UCASCF SKIPE RAISEF(CNX) TRZ A,40 POPJ P, SENDO: SKIPA A,CBFCHR SENDE: MOVE A,ESCAPE JRST SEND3 SNDBUF: CAMN PTR,[POINT 7,LINBUF-1,34] POPJ P, PUSHJ P,TRMST MOVE PTR,[POINT 7,LINBUF-1,34] MOVE C,PTR SNDBF1: ILDB B,C ; YES, it's true, replace a SOUT with SKIPN B ; a tight loop including SNDCH! JRST [ PUSHJ P,TRNSMT ; This make me soffer so... POPJ P, ] PUSHJ P,SNDCH JRST SNDBF1 SNDDO: SKIPE LNBFF(CNX) JRST SNDLBF MOVE B,A PUSHJ P,SNDCH ; Unbuffered: send char & push it out PUSHJ P,TRNSMT MOVE A,B JRST SNDECH ; Send character in B on send connection CNX SNDCH: HRRZ A,SNDJFN(CNX) BOUT POPJ P, ; Force transmission of buffered characters TRNSMT: HRRZ A,SNDJFN(CNX) MOVEI B,21 MTOPR POPJ P, ; Send terminal parameter ; A/ mark type, B/ parameter value SNTPAR: PUSH P,B MOVE C,A MOVE A,SNDJFN(CNX) MOVEI B,3 MTOPR POP P,B BOUT MOVEI B,21 MTOPR POPJ P, SNDECH: JUMPL A,CPOPJ ; Never echo ch with -1 lh SKIPN HDX ; If hdx terminal SKIPN ELCLF(CNX) ; If not local echo POPJ P, ; Then done SNDEC1: MOVE B,ECHCOC(CNX) ROT B,(A) ; Prepare to test coc CAIGE A,40 ; If not control JUMPGE B,CPOPJ PUSHJ P,PLOUT1 PUSHJ P,.PEOUT ; Echo POPJ P, SNDLBF: CAIE A,"A"-100 CAIN A,"H"-100 JRST [ CAMN PTR,[POINT 7,LINBUF-1,34] JRST [ MOVEI A,7 PUSHJ P,.PBOUT POPJ P,] MOVEI A,"\" PUSHJ P,.PBOUT LDB A,PTR PUSHJ P,.PBOUT MOVE A,PTR BKJFN 0 MOVEM A,PTR POPJ P,] CAIN A,"X"-100 JRST [ MOVEI A,"#" PUSHJ P,.PBOUT PUSHJ P,.PBOUT MOVEI A,37 PUSHJ P,.PBOUT MOVE PTR,[POINT 7,LINBUF-1,34] POPJ P,] CAIN A,"R"-100 JRST [ MOVEI A,37 PUSHJ P,.PBOUT PUSHJ P,TRMST MOVE A,[POINT 7,LINBUF-1,34] PUSHJ P,.PSOUT POPJ P,] IDPB A,PTR SKIPE ELCLF(CNX) PUSHJ P,SNDECH POPJ P, ; input character class membership table ; TENEX wakeup class in lh (10,4,2,1=>F,C,P,A) ; RCTE break class in rh *** not used by CHAT *** RCTGTB: REPEAT 10, ; ^@-^G (C,5) REPEAT 6, ; ^H-^M (F,4) REPEAT 22, ; ^N-^_ (C,5) XWD 2,400 ; SPACE (P,9) XWD 2,40 ; ! (P,6) REPEAT 6, ; "#$%&' (P,8) REPEAT 2, ; () (P,7) REPEAT 2, ; *+ (P,8) XWD 2,40 ; , (P,6) XWD 2,200 ; - (P,8) XWD 2,40 ; . (P,6) XWD 2,200 ; / (P,8) REPEAT 12, ; 0-9 (A,3) REPEAT 2, ; :; (P,6) XWD 2,100 ; < (P,7) XWD 2,200 ; = (P,8) XWD 2,100 ; > (P,7) XWD 2,40 ; ? (P,6) XWD 2,200 ; @ (P,8) REPEAT 32, ; A-Z (A,1) XWD 2,100 ; [ (P,7) XWD 2,200 ; \ (P,8) XWD 2,100 ; ] (P,7) REPEAT 3, ; ^_` (P,8) REPEAT 32, ; a-z (A,2) XWD 2,100 ; { (P,7) XWD 2,200 ; | (P,8) XWD 2,100 ; } (P,7) XWD 2,200 ; ~ (P,8) XWD 4,20 ; DEL (C,5) ; routines to store time of last net i/o SNDTIM: PUSH P,A PUSH P,B ; send fork time accounting TIME MOVEM A,SNDATM(CNX) POP P,B POP P,A POPJ P, RCVTIM: PUSH P,A PUSH P,B ; receive fork time accounting TIME MOVEM A,RCVATM(CNX) POP P,B POP P,A POPJ P, RECV: CIS MOVEM CNX,FSVCNX HRRZ A,RECJFN(CNX) MOVEI B,24 MOVSI C,017777 MTOPR ; Ins interrupts on channel 1 SETZM SYNCNT(CNX) ; clean INS count SETZM CBFCNT(CNX) RECVY: SETZM SAVINC(CNX) ; Loop to here to reset buffer MOVE A,[POINT 7,SAVBUF] MOVEM A,SAVINP(CNX) MOVEM A,SAVONP(CNX) RECV0: MOVE CNX,FSVCNX ; restore CNX in case fork restarted MOVE P,[XWD -100,SPDL-1] SKIPE SAVSWT(CNX) ; Saving output up? JRST RECVR ; Yes, check if full and do it SKIPE SAVINC(CNX) ; No, any saved characters? JRST RECVU ; Yes, unsave them JRST RECVB0 ; No, get next input RECVR: MOVEI A,SAVBFS*5-5 CAMG A,SAVINC(CNX) RECVH: HALTF RECVB0: SETOM RCVBSW(CNX) ; Sw stays set until BIN for rstrtng RECVB: PUSHJ P,RCVCH SKIPE LGFJFN(CNX) PUSHJ P,PLOUT2 MOVE B,A SKIPE ACTVSW PUSHJ P,RCVTIM ; account time SKIPE CBFCNT(CNX) JRST RECVFT ; Flushing output or DM timing RECVBA: SKIPE SAVSWT(CNX) ; Saving up the output? JRST RECVS ; Yes, go put it in buffer RECV1: AOSN CRNLSW ; was last char a ? JUMPE B,RECV0 ; yes, if this char is a null, flush it CAIN B,15 ; is this char a ? SETOM CRNLSW ; yes, set switch to screen RECV2: SKIPE CLROBF JRST RECVFL SKIPLE A,DIVJFN JRST RECVX MOVE A,B PUSHJ P,.PEOUT JRST RECV0 RECVS: PUSHJ P,RECVSV JRST RECV0 RECVU: SKIPE CLROBF ; Clear output buffer? JRST [ MOVE A,SAVINP(CNX) MOVEM A,SAVONP(CNX) SETZM SAVINC(CNX) LDB B,SAVONP(CNX) JRST RECVFL] MOVNI A,SAVBFS ; No ADD A,SAVONP(CNX) ; Wrapped pointer if needed CAMN A,[POINT 7,SAVBUF-1,34] MOVEM A,SAVONP(CNX) ; Wrap pointer ILDB B,SAVONP(CNX) ; Get byte SOS SAVINC(CNX) ; Account JRST RECV1 ; Go put it out RECVSV: MOVNI A,SAVBFS ; Prepare wrapped pointer ADD A,SAVINP(CNX) CAMN A,[POINT 7,SAVBUF-1,34] MOVEM A,SAVINP(CNX) ; And use it if needed IDPB B,SAVINP(CNX) ; Store character AOS A,SAVINC(CNX) ; Account SKIPE SWOFLG ; Swo and CAIE A,1 ; First character? POPJ P, ; No MOVEI A,101 DOBE HRROI A,[ASCIZ / Output waiting from connection /] PUSHJ P,.PSOUT MOVE A,CNX IMULI A,3 HRROI A,CONNAM(A) PUSHJ P,.PSOUT MOVEI A,37 PUSHJ P,.PBOUT POPJ P, RECVX: BOUT SKIPE DIVSWT JRST RECVN SKIPLE A,SCRJFN BOUT MOVE A,B PUSHJ P,.PEOUT RECVN: CAIE B,12 JRST RECV0 MOVEI A,101 SOBE JRST [ HRROI A,[ASCIZ /... /] SKIPN DIVSWT PUSHJ P,.PSOUT SETOM DIVSWT JRST RECV0] SETZM DIVSWT JRST RECV0 RECVFL: MOVEM B,D HRRZ A,RECJFN(CNX) SKIPN SAVINC(CNX) SIBE JRST RECV0 MOVEI C,2 RECVF1: MOVEI A,^D500 DISMS HRRZ A,RECJFN(CNX) SIBE JRST RECV0 SOJG C,RECVF1 SETZM CLROBF MOVEI A,37 PUSHJ P,.PBOUT MOVE B,D JRST RECV2 ; Receive character, return it in A. ; Handles Marks and Ends internally RCVCH: MOVE A,RECJFN(CNX) PUSHJ P,RCVBIN JUMPE B,RCVCH2 ; Maybe EOF RCVCH1: MOVE A,B POPJ P, RCVCH2: SETZ C, GDSTS ; Check state of connection TLNE B,(1B5) JRST RCVEOF ; End encountered TLZN B,(1B4) JRST [ SETZ B, ; Just a null data byte JRST RCVCH1] SDSTS ; A Mark, clear it MOVEI B,23 ; Read mark type MTOPR CAIN C,1 ; Data mark? JRST [ SOS SYNCNT(CNX) ; Decrement sync count PUSHJ P,ZCFOBF ; Consider whether to flush JRST RCVCH] CAIN C,5 ; Timing mark? JRST [ MOVEI A,101 ; Yes, wait for tty buffer to empty DOBE MOVE A,SNDJFN(CNX) ; Send timing mark reply MOVEI B,3 MOVEI C,6 MTOPR JRST RCVCH] ; We should never receive a timing mark reply since we never ; send a timing mark. The other mark types should not be ; received by a Telnet user. JRST RCVCH ; Just ignore IOERR: HRROI A,[ASCIZ / IO error for connection /] MOVE CNX,FSVCNX ; restore cnx to be sure JRST GENABN RCVEOF: MOVE CNX,FSVCNX SKIPN SAVSWT(CNX) SKIPE SAVINC(CNX) JRST RECVH ; Delay eof response until buffer gone HRROI A,[ASCIZ /Remote disconnect of /] GENABN: PUSH P,A AOSE ABNLCK ; Wait for abnormal interpt handler JRST [ MOVEI A,^D1000 DISMS JRST .-1] POP P,A PUSHJ P,.PSOUT MOVE A,CNX IMULI A,3 HRROI A,CONNAM(A) PUSHJ P,.PSOUT MOVEM CNX,ABNCNX MOVEI A,-1 MOVSI B,(1B) IIC ; Initiate abnormal interpt in superior MOVEI A,^D100000 DISMS ; And hang JRST .-2 RECVFT: SKIPG CBFCNT(CNX) ; go to flush output if neg. JRST RECV0 PUSH P,B TIME ; If pos., there is an excess of DM's, POP P,B SUB A,DMTIME(CNX) ; check elapsed time since last DM JUMPL A,RECVBA ; go on if less than limit MOVEI A,400000 DIR ; else disable interrups to avoid SETZM SYNCNT(CNX) ; confusion, then clear INS counts SETZM CBFCNT(CNX) MOVEI A,400000 EIR JRST RECVBA ZCFOBF: AOS CBFCNT(CNX) ; if ct -> 0, output flushing stops SKIPL SYNCNT(CNX) ; if INS ct pos, more DM's to come, POPJ P, ; clearing continues MOVEI A,101 ; if INS ct neg, DM came first, SKIPN SAVSWT(CNX) ; initiate clearing of buf CFOBF SETZM SAVINC(CNX) MOVE A,[POINT 7,SAVBUF] MOVEM A,SAVINP(CNX) MOVEM A,SAVONP(CNX) TIME ; start timing interval from receipt of ADDI A,^D5000 ; last excess DM: if no balancing INS MOVEM A,DMTIME(CNX) ; in 5 sec., counts will be cleared POPJ P, ; (lost INS, presumably) RCVBIN: ; Called from RCVCH rtn: ; BIN done here so restart routine can ; tell if BIN has been completed yet RCVBX: SETZM RCVBSW(CNX) ; --switch set from entry to RCVCH RCVB1: BIN ; until this point-- this to prevent a ; restarted conx from hanging on BIN, POPJ P, ; and other undesirable effects RCVINS: MOVEM 17,IACSAV+17 ; INS interrupts come here MOVEI 17,IACSAV BLT 17,IACSAV+16 MOVE CNX,FSVCNX AOS A,SYNCNT(CNX) SOS CBFCNT(CNX) ; If ct -> 0, flushing stops SKIPG A ; if ct neg, more INS's to come JRST RCVINX MOVEI A,101 ; if ct pos, INS arrived first, SKIPN SAVSWT(CNX) ; start clearing output CFOBF SETZM SAVINC(CNX) MOVE A,[POINT 7,SAVBUF] MOVEM A,SAVINP(CNX) MOVEM A,SAVONP(CNX) HRRZ A,FKRET2 CAIE A,RECVH CAIN A,RECVH+1 JRST [ MOVEI A,RECV0 HRRM A,FKRET2 JRST RCVINX] RCVINX: HRLZI 17,IACSAV BLT 17,17 DEBRK LOC VARS: BLOCK 1 NCONN1==NCONN+1 VAR HSFSTR: BLOCK 20 FMODSW: BLOCK 7 SPARE: BLOCK 3 NMODSW==.-FMODSW EVARS: RELOC END START