perm filename IMPCOM.MAC[IP,NET] blob
sn#702352 filedate 1983-02-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00074 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00007 00002 TITLE IMPCOM - IMP COMMAND HANDLER
C00008 00003 job data values we need
C00009 00004 SUBTTL PARAMETER, SYMBOL, AND MACRO DEFINITIONS
C00010 00005 flags used in the command parser.
C00014 00006 MACRO FOR DEFINING A NETWORK CONNECTION BLOCK
C00015 00007 bits used in connection parameter word
C00017 00008 SUBTTL COMMAND TABLES
C00019 00009 COMMAND NAME TABLE
C00020 00010 COMMAND DISPATCH TABLE
C00021 00011 SUBTTL INITIALIZATION AND COMMAND DECODING
C00023 00012 MOVSI T3,'HLP' ASSUME HELP FILE ON HLP:
C00025 00013 INIT TTYCHN,0 GRAB TTY SO WE CAN DIDDLE STATUS BITS
C00028 00014 BRING THE SYSTEM UP AND DOWN
C00030 00015 CLOSE COMMAND
C00032 00016 LISTEN COMMAND
C00034 00017 CONNECT COMMAND
C00035 00018 STATUS COMMAND. RETURNS STATUS OF SELECTED SOCKETS OR
C00036 00019 SUBROUTINE TO TYPE THE STATUS OF SPECIFIC IMP DEVICES
C00038 00020 HOST COMMAND. GIVES INFORMATION ABOUT ONE OR MORE SPECIFIED
C00042 00021 here when we got a new host.
C00044 00022 NEWS COMMAND. DOES THE EQUIVALENT OF
C00047 00023 HERE AFTER CHECKING ALL MATCHING IMPS
C00048 00024 CHECK OUT THE PARAMETERS
C00051 00025 HERE WHEN A CONNECTION HAS BEEN SET UP
C00054 00026 TELN4A: XTTY TELBLK CROSSPATCH THE TTY
C00057 00027 ROUTINE TO SETUP ECHO STATE ACCORDING TO LAST STATE AND SWITCHES
C00059 00028 ERROR COMMAND. GETS ERROR COUNTS AND STATISTICS.
C00062 00029 MAIN DRIVING LOOP FOR IMP ERROR STATISTICS FUNCTION
C00066 00030 TABLES FOR DRIVING 'IMP ERROR' OUTPUT
C00068 00031 SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
C00069 00032 SUBROUTINE TO TYPE IMP MESSAGE TYPES
C00073 00033 ROUTINE TO TYPE BUFFER STATISTICS
C00074 00034 SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
C00075 00035 SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
C00076 00036 SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
C00077 00037 SUBROUTINE TO TYPE IMP MESSAGE TYPES
C00079 00038 SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
C00081 00039 type output TCP types
C00082 00040 HELP COMMAND -- PROVIDES HELPING TEXT
C00084 00041 ROUTINE TO DO HELP WITH NO ARGUMENTS
C00086 00042 ASSEMBLE HELP NAME TABLE
C00087 00043 HELP DISPATCH TABLE
C00088 00044 ACTION ROUTINES FOR LEXICAL INTERPRETER
C00090 00045 SUBROUTINE TO INITIALIZE FOR FIELD OR NAME INPUT
C00095 00046 HERE TO SAVE COMBLK NAME
C00098 00047 try to give a list of possible hosts.
C00101 00048 SAVE THE PARAMETER
C00104 00049 PARLST: -PARLEN,,PARNAM
C00106 00050 PARSYM:
C00108 00051 SWITCH TABLES
C00110 00052 SUBROUTINES
C00112 00053 SUBROUTINE TO GET THE NEXT TEXT FIELD
C00116 00054 CMDERM: SIXBIT \? C&OMMAND ERROR#!\
C00118 00055 CONTINUE TYPSTS
C00121 00056 SUBROUTINE TO TYPE OUT BOTH HOST NAME AND NICKNAME, IF A NICKNAME
C00124 00057 SUBROUTINE TO SET UP AN ICP CONNECTION
C00126 00058 CONTINUATION OF THE ICP CODE
C00127 00059 STILL MORE ICP CODE
C00129 00060 SUBROUTINE TO MATCH EACH IMP IN THE SYSTEM WITH THE COMMAND
C00132 00061
C00136 00062 CONTINUATION OF PARAMETER CHECKING
C00138 00063 ROUTINE TO SEARCH FOR A GIVEN SIXBIT NAME IN A NAME TABLE, WITH ANY
C00142 00064 SUBROUTINE TO TYPE THE TABLE POINTED TO BY T2.
C00143 00065 DATE ROUTINE
C00146 00066 file information. the FSETUP uuo moves this information to their
C00147 00067 CONNECTION BLOCKS, FILE BLOCKS, INITIAL PARAMETERS
C00151 00068 AUXILIARY ROUTINES
C00152 00069 IMP STATES -- ONE WORD PER STATE
C00153 00070 COMMAND SCANNER
C00155 00071 SUBROUTINE TO GET A PARAMETER FIELD
C00157 00072 SUBROUTINE TO GET A TEXT OR NUMBER FIELD
C00160 00073 STORAGE
C00163 00074 file blocks for hiseg blocks FilIcp, FilOTL, and FilHlp
C00164 ENDMK
C⊗;
TITLE IMPCOM - IMP COMMAND HANDLER
SUBTTL SUNDBERG/RLS/HVZ/EAT/EW13/HVZ/DMB/drp -- 15 may 80
; find all the symbols we might need.
SEARCH IMP,HstTbl,Tulip,MacTen,UUOSym
$TwoSeg
$High
ENTRY IMPCOM
VERSION 13,,102,1
; job data values we need
EXTERN .JBREL, .JBFF, .JbDDT, .JbSa, .JbUsy, .JbSym, .JbCor
; feature test switches for conditional compilation control
ifndef FtKSeg,<FtKSeg==0> ;drp -1 if want to kill hiseg while
;drp crosspatched.
;CONSTANTS
PDLEN==100 ;PUSHDOWN STACK LENGTH
;I/O CHANNELS
; 0,1 RESERVED FOR UUO PACKAGE
;[tcp] ICPCHN==2 ;INITIAL CONNECTION PROTOCOL CHANNEL
; 2,3 RESERVED FOR DATA TRANSFER PROTOCOL(AFTER ICP)
ITLCHN==2 ;TELNET CHANNEL (AFTER ICP)
OTLCHN==3 ;TELNET OUTPUT CHANNEL
HLPCHN==4 ;CHANNEL FOR READING HELP FILE
TTYCHN==5 ;CHANNEL FOR SETTING TTY STATUS BITS
SUBTTL PARAMETER, SYMBOL, AND MACRO DEFINITIONS
A= 11 ; three regs used for keeping important
B= 12 ; information from being destroyed by the
C= 13 ; tulip and impsub modules.
; flags used in the command parser.
; several of these flags are actually defined in Tulip.mac, but
; are "redefined" here for documentation purposes.
; do NOT try to second guess these flags: ALWAYS use the TX?? macro.
FLAG (LZEFLG) ;LEADING ZEROES NOT TO BE SUPPRESSED
FLAG (ODDFLG) ;FLAGS ODD (OUTPUT) SOCKET OPERATION
HstCmd==OddFlg ; reuse: also indicates HOST command
FLAG (BRKFLG) ;A BREAK CHAR WAS SEEN
FLAG (RUNFLG) ;IMPCOM WAS CALLED WITH A RUN
FLAG (LOGFLG) ;JOB IS LOGGED IN
FLAG (LETFLG) ;AT LEAST ONE LETTER IN THE SYMBOL
FLAG (DEVFLG) ;DEVICE SPECIFIED
FLAG (HSTFLG) ;HOST "
FLAG (LCLFLG) ;LOCAL SOCKET
FLAG (RMTFLG) ;REMOTE SOCKET
FLAG (BYTFLG) ;BYTE SIZE
FLAG (JOBFLG) ;JOB NUMBER SPECIFIED
FLAG (STTFLG) ;STATE SPECIFIED
FLAG (USRFLG) ;A USER NUMBER WAS SPECIFIED
FLAG (WATFLG) ;A WAIT CODE WAS GIVEN
FLAG (IVLFLG) ;A TIME INTERVAL WAS GIVEN
FLAG (ALLFLG) ;AN ALLOCATION WAS SPECIFIED
COMFGS==DEVFLG!HSTFLG!LCLFLG!RMTFLG!BYTFLG!JOBFLG!STTFLG!HstCmd!ODDFLG!USRFLG!IVLFLG!ALLFLG
FLAG (ALLSWT) ;/ALL -- USE ALL PROGRAMMER NUMBERS
FLAG (SLFSWT) ;/SELF -- THIS JOB ONLY
FLAG (OUTSWT) ;/OUTPUT -- OUTPUT SIDE ONLY
FLAG (INPSWT) ;/INPUT -- INPUT SIDE ONLY
FLAG (LNGSWT) ;/LONG -- GIVES LONG FORM OF DATA
FLAG (GODSWT) ;/DEITY -- USER WANTS SPECIAL ACTION
FLAG (NWTSWT) ;/NOWAIT -- IGNORE WAIT TIME PARAMETERS
FLAG (FSTSWT) ;/FAST -- SHORT STATUS LISTING
FLAG (TTLSWT) ;/TITLE -- FORCE PRINTING OF TITLE
FLAG (SITSWT) ;/SITE:N SPECIFIED RATHER THAN /HOST:N
FLAG (ECHSWT) ;/ECHO -- LOCAL ECHOING
FLAG (NECSWT) ;/NOECHO -- REMOTE ECHOING
FLAG (LFSWT) ;/LF -- SEND LF AFTER CR
FLAG (NLFSWT) ;/NOLF -- DON'T SEND LF AFTER CR
FLAG (ABSSWT) ;/ABSOLUTE LOCAL SOCKET NUMBER SPECIFIED
COMSWS==ALLSWT!SLFSWT!OUTSWT!INPSWT!NWTSWT!SITSWT!ECHSWT!NECSWT!LFSWT!NLFSWT!ABSSWT
Flag (NckNam) ; have printed at least one nickname
FLAG (TITLTY) ;TITLE ALREADY TYPED
FLAG (DUPLEX) ;THIS IS A DUPLEX CONNECTION
FLAG (SEPARA) ;[96bit] seen the character separating
; the site number from the host.
IfL $FlagN,<Printx ? Too many flags defined.>
;MACRO FOR DEFINING A NETWORK CONNECTION BLOCK
;[96bit] redefine to handle new UUO format
DEFINE NET (D, L, H, R, B<↑D8>)<
;;ARGUMENTS
;; D PDP-10 DEVICE NAME. MAY BE LOGICAL OR PHYSICAL.
;; IF LEFT BLANK A FREE IMP DEVICE WILL BE ASSIGNED.
;; L LOCAL (8 BIT) SOCKET NUMBER. DEFAULT IS 0.
;; H REMOTE HOST NUMBER. DEFAULT IS 0 (ILLEGAL).
;; R REMOTE SOCKET NUMBER. DEFAULT IS 0.
;; B CONNECTION BYTE SIZE. DEFAULT IS 8.
SIXBIT \D\
EXP -1
EXP L
EXP H
EXP R
XWD B,0
>
; bits used in connection parameter word
PW.NLF==1B0 ;NO LINEFEED DESIRED AFTER CR
PW.NEC==1B1 ;NO ECHOING DESIRED
; what to do for a command error: print a message, and flush line,
; then quit.
Define CmdErr(Msg)
<
EDisix [Stop1A,,Msg]
>
; what to do for a table lookup failure
Define TabErr(Msg)
<
Jrst [ ; table error: remember why
Movei T2,Msg ; load message
Jrst TabDcd ; sort everything out
]
>
; move to column position.
; NOTE: it blows away T4.
Define WTab (Pos)
<
Call [Push p,T1 ; save a reg
movei T1,Pos ; get the offset
PJrst Tabit ; and go do the routine
]
>
SUBTTL COMMAND TABLES
;FLAGS IN LH OF COMMAND DISPATCH TABLE
CM.LOG==1B0 ;LOGIN NOT REQUIRED
CM.AVL==1B1 ;NETWORK NEED NOT BE AVAILABLE
CM.MON==1B2 ;IMP MONITOR NOT REQUIRED
DEFINE COMS <
CC CLOSE
CC CONNECT
CC DEASSIGN,<AVL>
CC ERROR,<AVL>
CC HELP,<LOG,AVL,MON>
CC HOST,<LOG,AVL,MON>
CC LISTEN,<AVL>
CC NCPDWN,<AVL>
CC NCPINI,<AVL>
CC NCPUP,<AVL>
CC NEWS
CC RESET
CC Request ; do a listen and wait for reply
CC STATUS,<LOG,AVL>
CC TALK
CC TELNET
CC Tn ; another equivalent
>
;SPECIAL ADDITIONAL HELP TEXTS AVAILABLE
DEFINE HELPS <
CC CONTROL
CC ECHO
CC ESCAPE
CC SAMPLE
CC SHIFT
CC SOCKET
CC STATE
CC SWITCH
CC SYNTAX
>
;COMMAND NAME TABLE
COMLST: -COMLEN,,COMNAM ;POINTER TO COMMAND LIST
DEFINE CC(C,F) <
<SIXBIT \C\>
>
COMNAM: COMS
COMLEN==.-COMNAM ;LENGTH OF COMMAND LIST
;COMMAND DISPATCH TABLE
DEFINE CC(C,F) <
ZZ== 0
IFNB <F>,<IRP F<
ZZ== ZZ!CM.'F
>>
ZZ + I.'C
>
COMDSP: COMS
SUBTTL INITIALIZATION AND COMMAND DECODING
IMPCOM: JFCL ;IGNORE CCL ENTRY
TDZA F,F ;CLEAR FLAGS
IMPCO1: MOVEI F,RUNFLG ;SIGNAL RUN COMMAND OR UUO
MOVE P,[IOWD PDLEN,PDL]
Save F ; don't let it clear the flags
Start ; but reinitialize tulip
Restore F ; get it back.
Move T1,[Call FScan] ; change tty to use FSCAN
Movem T1,TTiBlk## + FilXct ; for input
Move T1,[Call CntOut] ; and use CntOut
Movem T1,TToBlk## + FilXct ; for output
MOVE T1,[ZERO,,ZERO+1]
SETZM ZERO
BLT T1,ZEREND
MOVE T1,[FILLHI,,FILL]
BLT T1,FILEND
FSetUp FilHlp ; set up the help lowseg block
GETPPN T1, ;GET PROJ,PROG
JFCL ;(GETPPN SKIPS IF JACCT)
MOVEM T1,PRJPRG
PJOB T1, ;JOB NUMBER
MOVEM T1,JOBN
movn T2,T1 ; negative job number
JobSts T2, ; get job status
SETZ T2, ;NO STATUS BITS
TXNE T2,Jb.Uli ;JOB LOGGED IN?
TXO F,LOGFLG ;YES, REMEMBER SO
LHOST HSTBLK ;RETURN LOCAL HOST NUMBER
SETZM THSITE ;MUST BE NON-IMP MONITOR
;[96bit]LDB T1,[POINT 9,THSITE,17] ;GET NUMBER OF IMPS IN THIS SYSTEM
LDB T1,[POINT 9,.IbDev + HstBlk,17] ;[96bit] # of imps
MOVEM T1,IMPNUM ;SAVE FOR LATER
VERS SYSVER ;RETURN IMP SYSTEM SOFTWARE VERSIONS
SETZM SYSVER ;HOW CAN THIS BE?
MOVSI T3,'HLP' ;ASSUME HELP FILE ON HLP:
SKIPE .JBDDT ;UNLESS DEBUGGING
MOVSI T3,'DSK'
HRROI T1,.GTSGN ;GET HI-SEG NUMBER FOR THIS JOB
GETTAB T1,
SETZ T1, ;NO HI-SEG??
JUMPLE T1,IMPC1A ;JUMP IF NOT USING A HI-SEG
MOVSI T2,(T1) ;GET DIRECTORY HI-SEG WAS INITED FROM
HRRI T2,.GTPPN
GETTAB T2,
SETZ T2, ;OBSOLETE OR SOMETHING, ASSUME SYS.
tlnn t2,-1 ; is this a monitor SFD pointer?
setz t2, ; yes. forget it.
JUMPE T2,IMPC1A ;JUMP IF NONE
MOVSI T3,(T1) ;GET HI-SEG DEVICE
HRRI T3,.GTDEV
GETTAB T3,
SKIPGE T3,T2 ;LEVEL C--DEVICE IS IN PPN IF NEGATIVE
JRST .+2 ;LEVEL D, OR LEVEL C NON-DISK
MOVSI T3,'DSK' ;LEVEL C DISK
IMPC1A: MOVEM T3,HLPFIL+FILDEV ;STORE HISEG DEVICE NAME
MOVEM T2,HLPFIL+FILPPN ;STORE HISEG DIRECTORY
ifn FtKSeg,< ;drp may need this to get hiseg back
MOVEM T3,RUNDEV ;STORE ALSO IN GETSEG ARGLIST
MOVEM T2,RUNPPN ;STORE ALSO IN GETSEG ARGLIST
> ;drp end of ifn FtKSeg
INIT TTYCHN,0 ;GRAB TTY SO WE CAN DIDDLE STATUS BITS
SIXBIT \TTY\
0
IDIOT ;TTY NOT AVAILABLE
Hrlzi T1,ComNd ; assume a need to parse "Imp <command>"
TXNE F,RUNFLG ;IS IT?
JRST IMPCO2 ;NO, GO PROMPT FOR INPUT
RESCAN 1 ;MAYBE, RESCAN INPUT LINE
SKPINL ;MIGHT BE SOMETHING THERE. IS THERE?
TXOA F,RUNFLG ;NO, PROMPT FOR INPUT
JRST IMPCO3 ;YES, GO PROCESS "IMP" COMMAND
IMPCO2: WCHI "*" ;PROMPT FOR INPUT
Hrlzi T1,ComNm ; enter the productions at this point
IMPCO3: CALL TEXTIN ;GET COMMAND INTO A
TXNE F,BRKFLG ;END OF LINE?
JUMPE A,IMPCO5 ;YES, JUMP IF NO COMMAND
MOVE T2,COMLST ;COMMAND TABLE
;[96bit]CALL SIXSRC ;SEARCH IT
;[96bit] CMDERR CMDERM
Call SixSrA ; search table for what's in A
TABERR [Sixbit \&COMMAND!\] ;[96bit] tell why not found
MOVE T1,COMDSP(T1) ;FOUND IT--GET DISPATCH ENTRY
TXNN T1,CM.LOG ;LOGIN REQUIRED?
TXNE F,LOGFLG ;YES, JOB LOGGED IN?
CAIA ;YES OR NOT REQUIRED
CMDERR [SIXBIT\?L&OGIN PLEASE#!\]
lhost hstblk ;drp get latest local stats.
setzm thsite ;drp mark this as a failure.
TXNN T1,CM.AVL ;NETWORK AVAILABILITY REQUIRED?
;[96bit]SKIPL THSITE ;YES, IT IT?
SKIPL .IbStt + HstBlk ; yes. is it available?
CAIA ;YES OR NOT REQUIRED
CMDERR [SIXBIT\?N&ETWORK NOT AVAILABLE#!\]
TXNN T1,CM.MON ;IMP MONITOR REQUIRED?
SKIPE THSITE ;YES, IS IT?
JRST (T1) ;YES OR NOT REQUIRED, DISPATCH
CMDERR [SIXBIT\?N&ON-&IMP& MONITOR RUNNING#!\]
;HERE ON BLANK COMMAND (I.E. JUST <CR> OR "IMP<CR>")
IMPCO5:
MOVEI T2,CtrlZ ;[96bit] was the last
CAMN T2,TTiBlk## + FilCur ;[96bit] character a control Z?
EXIT ;[96bit] yep: exit
TXNE F,LOGFLG ;JOB LOGGED IN?
JRST IMPCO1 ;YES, GO TO CUSP LEVEL
CMDERR [SIXBIT\?L&OGIN PLEASE#!\] ;NO, DON'T ALLOW CUSP LEVEL
;BRING THE SYSTEM UP AND DOWN
I.NCPU: NCPUP COMBLK ;COMBLK NEEDED FOR ADDRESS CHECKING
IMPERR
JRST STOP
I.NCPD: PUSHJ P,RUSURE ;GET CONFIRMATION
JRST STOP ;NO
NCPDWN COMBLK ;COMBLK ADDRESS NEEDED FOR ADDRESS CHECK
IMPERR
JRST STOP
;COMPLETELY REINITIALIZE THE IMP SYSTEM
I.NCPI: PUSHJ P,RUSURE ;GET CONFIRMATION
JRST STOP ;SECOND THOUGHTS
NCPINI COMBLK ;DO IT
IMPERR ;BOOBOO
JRST STOP
;RESET A SPECIFIED HOST (PRIVILEGED)
I.RESE: TXNE F,BRKFLG ;ERROR IF BLANK LINE
CMDERR ARGERM
PUSHJ P,SETME ;SET DEFAULTS
PUSHJ P,LISTIN ;SCAN ARGUMENT (HOST NAME)
TXNE F,<COMSWS+COMFGS-HSTFLG> ;SEE WHAT WE GOT
JRST A.ECMD ;TOO MUCH
PUSHJ P,RUSURE ;OK, REQUEST CONFIRMATION
JRST STOP
NCPRST COMBLK ;RESET THE HOST
IMPERR
JRST STOP
;ROUTINE TO REQUEST CONFIRMATION OF CATASTROPHIC FUNCTIONS
; PUSHJ P,RUSURE
; COMMAND NOT CONFIRMED
; COMMAND CONFIRMED
RUSURE: CLRBFI ;CLEAR TYPEAHEAD
TXZ F,BRKFLG ;FLAG EMPTY LINE
WSIX [SIXBIT\A&RE YOU SURE? !\]
Rchf P2 ;GET FIRST CHARACTER OF RESPONSE
CAIE P2,"Y" ;WAS IT YES?
CAIN P2,"Y"+40
Aos (P) ; yes: set skip return
PJrst Flush ; flush the rest of the line and return
;CLOSE COMMAND
I.CLOS: MOVEI P1,STTBLK ;DO WORK HERE
TXNE F,BRKFLG ;EMPTY LINE?
CMDERR ARGERM ;YES
SETZ P2,
CLOS1: CALL SETME ;INIT DEFAULTS
CALL FIELDN ;GET SOME SPECS
MOVEI A,CLOS2 ;SUBROUTINE
CALL ALLIMP ; TO EXECUTE FOR ALL IMPS
TXZ F,<COMSWS!COMFGS>
TXNE F,BRKFLG ;BREAK?
JRST TSTOP ;YES, DONE
JRST CLOS1
CLOS2: TXNN F,<GODSWT!DEVFLG> ;UNLESS EXPLICIT DEVICE OR /DEITY
ITTY (P1) ;CHECK FOR JOB CONTROL
JRST .+3 ;NO
SKIPGE 1(P1) ;MAYBE, CHECK BITS
POPJ P, ;IMP CONTROLS JOB, DON'T TRY TO CLOSE IT
MOVEM A,(P1) ;SAVE PHYSICAL NAME IN CASE OF GODSWT ON
CLOS (P1) ;CLOSE THE SOCKET
IMPERR ;ERROR
CLOS 1,.IBDEV(P1) ;NOW FORCE, JUST IN CASE
JFCL ;AND IGNORE ANY ERRORS
AOJA P2,Cpopj## ;COUNT IT
;DEASSIGN THE IMP DEVICE (SAFER THAN MONITOR CONSOLE COMMAND)
I.DEAS: MOVEI P1,STTBLK
TXNE F,BRKFLG
CMDERR ARGERM ;EXPLICIT ARGUMENT NEEDED
SETZ P2,
DEAS1: CALL SETME ;DEFAULTS
CALL FIELDN ;GET DEVICE SPEC
MOVEI A,DEAS2
CALL ALLIMP
TXZ F,<COMSWS!COMFGS>
TXNE F,BRKFLG ;DONE?
JRST TSTOP ;YES
JRST DEAS1
;SUBROUTINE TO DEASSIGN AN IMP DEVICE
DEAS2: DEAS (P1)
IMPERR
AOJA P2,Cpopj##
;LISTEN COMMAND
I.LIST: MOVEI P1,STTBLK
SETZ P2,
CALL SETME ;DEFAULTS
TXNN F,BRKFLG ;DONT SCAN IF NOTHING THERE
CALL LISTIN ;GET COMMAND
TXNN F,LCLFLG ;LOCAL SOCKET GIVEN?
NoLcl: CmdErr [Sixbit \? L&ocal socket must be specified.#!\]
MOVEI A,LIST3 ;ACTION SUBROUTINE
CALL ALLIMP ;DO FOR ALL IMP DEVICES
JUMPG P2,STOP ;DONE IF FOUND ANYTHING
Listen COMBLK ;GET A NEW ONE
IMPERR
JRST STOP
;THE LISTEN SUBROUTINE. CALLED FOR EACH SPECIFIED IMP
LIST3: Listen STTBLK ;DO THE LISTEN
IMPERR
AOJA P2,Cpopj## ;COUNT IT AND EXIT
;Request COMMAND
I.Requ: MOVEI P1,STTBLK
SETZ P2,
CALL SETME ;DEFAULTS
TXNN F,BRKFLG ;DONT SCAN IF NOTHING THERE
CALL LISTIN ;GET COMMAND
TXNN F,LCLFLG ;LOCAL SOCKET GIVEN?
Jrst NoLcl ; go complain
MOVEI A,Requ3 ;ACTION SUBROUTINE
CALL ALLIMP ;DO FOR ALL IMP DEVICES
JUMPG P2,STOP ;DONE IF FOUND ANYTHING
Request COMBLK ;GET A NEW ONE
IMPERR
JRST STOP
;THE Request SUBROUTINE. CALLED FOR EACH SPECIFIED IMP
Requ3: Request STTBLK ;DO THE Request
IMPERR
AOJA P2,Cpopj## ;COUNT IT AND EXIT
;CONNECT COMMAND
I.CONN: MOVEI P1,STTBLK
SETZ P2,
CALL SETME ;SET DEFAULTS
TXNN F,BRKFLG
CALL LISTIN ;GET COMMAND
MOVEI A,CONN4
CALL ALLIMP
JUMPG P2,STOP ;DONE IF FOUND ONE
TXNN F,LCLFLG ;LOCAL SOCKET GIVEN?
Jrst NoLcl ; need a local socket.
CONN COMBLK ;CONNECT
IMPERR
JRST STOP ;YES
;SUBROUTINE TO CALL FOR EACH IMP
CONN4: CONN (P1) ;ATTEMPT TO CONNECT
IMPERR
AOJA P2,Cpopj## ;COUNT IT AND RETURN
;STATUS COMMAND. RETURNS STATUS OF SELECTED SOCKETS OR
; DEVICES.
I.STAT: MOVEI P1,STTBLK ;STATUS CONNECTION BLOCK
STAT (P1) ;JUST SEEIF IT WORKS
SKIPLE .IBSTT(P1) ;SKIP IF NOT AVAILABLE
TDZA P2,P2 ;CLEAR COUNTER
IMPERR STOP ;ERROR MESSAGE AND OUT
MOVEI P3,XSTBLK ;BLOCK FOR READING EXTENDED STATUS
STAT1: CALL SETME ;INITIALIZE DEFAULTS
TXNN F,BRKFLG ;EMPTY LINE?
CALL FIELDN ;GET NEXT FIELD
MOVEI A,STAT3 ;THE TYPEOUT ROUTINE
CALL ALLIMP ;TEST ALL IMPS
TXNE F,BRKFLG
JRST STOP
TXZ F,<COMSWS!COMFGS>
JRST STAT1
;SUBROUTINE TO TYPE THE STATUS OF SPECIFIC IMP DEVICES
STAT3: hrrz T2,.IBSTT+STTBLK ; get state
TXNN F,<INPSWT!OUTSWT!SLFSWT!DEVFLG!STTFLG> ; HVZ-4/23/75
JUMPE T2,STAT9 ;DONT TYPE CLOSED SOCKETS
MOVEM A,.XSDEV(P3) ;STORE DEVICE NAME
MOVEI T2,.XSSIZ-1 ;SET NUMBER OF ITEMS WANTED
MOVEM T2,.XSNUM(P3)
XSTAT (P3) ;READ EXTENDED STATUS
TXZ F,LNGSWT ;ERROR, NOTE THAT WE CAN'T DO LONG STATUS
STAT3B: PUSHJ P,TYPSTS ;TYPE STATUS OF IMP
TXNN F,LNGSWT ;/LONG?
AOJA P2,Cpopj## ;NO, FINISHED
;DO LONG STATUS
WDEC ↑D9,.XSPrt(P3) ; protocol
WDEC ↑D11,.XSRWn(P3) ; receive window
WDEC ↑D11,.XSSWn(P3) ; send window
wdec ↑d11,.xsRTT(p3) ; retransmission timeout time
STAT8: W2CHI CRLF
STAT9: AOJA P2,Cpopj##
;HOST COMMAND. GIVES INFORMATION ABOUT ONE OR MORE SPECIFIED
; HOSTS.
I.HOST: Txo F,HstCmd ; now in a host command
TXNN F,BRKFLG ;NULL ARGUMENTS TO COMMAND?
JRST HOST1 ;NO
TXO F,ALLSWT ;YES, FORCE /ALL
JRST HOST4
HOST1: CALL FIELDN ;GET NEXT FIELD
TXNE F,<SITSWT!ALLSWT!HSTFLG> ;SOME HOST OR /ALL GIVEN?
TXNE F,<<COMSWS!COMFGS>-<SITSWT!ALLSWT!HSTFLG!HstCmd>> ;NO OTHERS?
;[96bit]JRST A.ECMD ;TOO LITTLE OR TOO MUCH
JRST A.SWBD ;[96bit] a switch that wasn't right
HOST4: Movei T2,GotHst ; where to go when we find a host
Movei T3,GotNck ; where to go for each nickname
Txnn F,AllSwt ; /all?
jrst Host4a ; no: jump on.
Txo F,TtlSwt ; force a title
Movei T1,[0] ; set up to scan all the table
Jrst Host4b ; and go match with everyone
Host4a: Txne F,SitSwt ; site number?
Jrst HstSit ; yes: go with site number
Txnn F,LetFlg ; and letters seen?
Jrst HstNmb ; no: hope we found a number.
Movei T1,AscBuf ; point to the host string
Host4b: Call HstGen## ; go do it
Jrst NoHTbl ; tables are not available
Jrst NotThr ; host not in tables
Jrst HstEnd ; and rejoin ending code
; looking for a particular site, by number
HstNmb: Skipa T4,[Ih.Net!Ih.Hst!Ih.Imp] ; mask for exact match
; looking for all the hosts at a single site.
HstSit: Movx T4,Ih.Imp ; set site mask
Move T1,.IbHst+ComBlk ; get host number
Call HstNGn## ; find the numbers
Jrst NoHTbl ; no host tables
Jrst NotThn ; no such site
HstEnd: Call NckCln ; clean up leftover nickname and <crlf>
TXZ F,<COMSWS!COMFGS> ; HVZ-4/23/75
TXNE F,BRKFLG ;DONE?
JRST STOP ;YES
JRST I.HOST
NoHTbl: CmdErr [Sixbit \? H&ost tables cannot be accessed.#!\]
NotThr: EDisix [Stop1A,,[Sixbit \? N&o hosts match ""%"".#!\]
Wasc AscBuf
]
NotThn: Move T1,.IbHst+ComBlk ; retrieve host number
EDisix [Stop1A,,[Sixbit \? N&o hosts match %.#!\]
Call TypHNm ; print the host number
]
; here when we got a new host.
GotHst: TXON F,TITLTY ;TITLE ALREADY TYPED?
Txzn F,TTLSWT ;NO, WANT TITLE?
JRST HOST5 ;NO OR ALREADY TYPED
WSix [Sixbit\#N&umber &N&ame &S&tatus$&N&icknames#!\]
;TYPE A HOST
HOST5: Call NckCln ; check for close nicknames. new line.
Clearm ChrCnt ; make believe in first column
Andi T3,ht$Sts ; mask all but the server status
push p,t1 ;[tcp] save ascii name
move T1,T2 ; get host number in place
Call TypHNm ; type site number
pop p,t2 ;[tcp] restore ascii name
Wtab ↑d11 ; to next tab stop
WAsc (T2) ; type ascii name
Wtab ↑d28 ; find a tab stop
WAsc @[[Asciz \(None)\] ; ? not defined
[Asciz \Server\]
[Asciz \User\]
[Asciz \Tip\]
](T3) ; type status
Return ; and return
GotNck: Txoe F,NckNam ; is this the first nickname?
Disix [Host6a,,[Sixbit \, !\]] ; no: separate
WTab ↑d9 ; go to a good column
; (in HOST, we're past it already)
W2Chi " (" ; and then tab to place
Host6a: Wasc (T1) ; print this nickname
Return ; and go back to HstGen
NckCln: Txze F,NckNam ; no nicknames printed for him yet
Wchi ")" ; but there was at least one for last
TCrLf: W2Chi CrLf ; output a crlf
Return ; and return
;NEWS COMMAND. DOES THE EQUIVALENT OF
; TELNET BBN-TENEX /REMOTE:#367
; TO ACCESS THE NETWORK NEWS SERVICE
I.NEWS: MOVEI P1,TELBLK ;TELNET CONNECTION BLOCK
CALL SETME ;SETUP COMMAND DEFAULTS
MOVEI T1,367 ;PRESET REMOTE SOCKET
MOVEM T1,.IBRMT+COMBLK
;[96bit]MOVEI T1,↑D241 ;PRESET REMOTE HOST -- HVZ-4/23/75
;[96bit]HRRM T1,.IBHST+COMBLK
movei T1,600061 ;[96bit] preset host.
MOVEM T1,.IBHST+COMBLK ;[96bit]
TXO F,<HSTFLG!RMTFLG> ;PRETEND THESE ARGS TYPED
JRST TELN0A ;DO NORMAL TELNET PROCESSING
;TELNET COMMAND. GENERATES OR CONNECTS TO A PREVIOUSLY
; GENERATED CONNECTION.
I.Tn:
I.TALK:
I.TELN: MOVEI P1,TELBLK
CALL SETME ;SET DEFAULTS
TELN0A: TXNN F,BRKFLG
CALL LISTIN ;SCAN WHOLE LINE
TXNE F,<INPSWT!OUTSWT>
;[96bit]JRST A.ECMD ;TOO MUCH!
JRST A.SWBD ;[96bit] none are legal.
SETZB P2,P3 ;CLEAR COUNTER
JSP A,TELNE0 ;SET SUBROUTINE ADDRESS
LDB T2,[POINT 6,.IBSTT+STTBLK,35]
JUMPE T2,Cpopj## ;IGNORE CLOSED SOCKETS
Move T1,A ; get device
TXNE F,DEVFLG ;UNLESS EXPLICIT DEVICE TYPED,
JRST TELN0B ; SKIP SPECIAL CHECKS
HLRZ T2,.IBDEV+STTBLK ;FTP MAKES LOGICAL NAME BE JOB # IN RIGHT,
CAIN T2,'FTP' ; AND FTP IN LEFT
POPJ P, ;WHICH WE NORMALLY WON'T WANT TO CONNECT TO
ITTY T1 ;CHECK FOR JOB CONTROL
JRST .+2 ;NO
JUMPL T2,Cpopj## ;YES, SKIP THIS IMP IF IT CONTROL A JOB
TELN0B:
;[tcp] TXNN F,ODDFLG ;WHICH SIDE?
;[tcp] SKIPA P3,T1 ;INPUT, JUST REMEMBER NAME
;[tcp] CAME P3,T1 ;OUTPUT--DID INPUT SIDE MATCH TOO?
;[tcp] POPJ P, ;NO--NOT A DUPLEX SOCKET (YET)
move p3,t1 ;[tcp]
MOVE P4,P3 ;YES, REMEMBER DEVICE NAME
AOJA P2,Cpopj## ;COUNT IT
TELNE0: CALL ALLIMP ;EXECUTE FOR ALL IMP DEVICES
;HERE AFTER CHECKING ALL MATCHING IMPS
JUMPE P2,TELNE1 ;JUMP IF NO MATCH
SOJG P2,TELNE9 ;ERROR IF MORE THAN ONE DUPLEX DEVICE
MOVEM P4,.IBDEV(P1) ;REMEMBER PHYSICAL NAME
MOVEM P4,.IBDEV+.IBSIZ(P1)
SETZM .IBLCL(P1) ;CHECK THE INPUT SIDE
STAT (P1)
IMPERR STOP
LDB T1,[POINT 6,.IBSTT(P1),35]
JUMPE T1,TELNE1 ;USE IT IF NOT CLOSED, OTHERWISE TRY TO SET UP
;[96bit]HRRZ T1,.IBHST(P1) ;GET HOST
MOVE T1,.IBHST(P1) ;[96bit] GET HOST
Disix [[SIXBIT \%: R&ECONNECTED TO !\]
WNAME .IBDEV(P1)
]
Call TypHst ; go print the host
Jrst TelNe4 ; go away
;CHECK OUT THE PARAMETERS
TELNE1: TXNN F,DEVFLG ;DEVICE GIVEN?
JRST TELN1A ;NO
MOVS T1,.IBDEV+COMBLK ;YES, GET COMMAND DEVICE
CAIN T1,'ICP'
EDisix [SPECER,,[SIXBIT \? D&EVICE!\]]
MOVSM T1,.IBDEV(P1) ;USE IT
MOVSM T1,.IBDEV+STTBLK
JRST TELNE6
TELN1A: MOVE T1,.IBDEV(P1) ;GET DEFAULT DEVICE NAME (TELNET:)
DEVCHR T1, ;DO WE ALREADY HAVE A TELNET:?
TXNN T1,DV.AVL
JRST TELNE6 ;NO, USE LOGICAL NAME TELNET:
SETZM .IBDEV+STTBLK ;YES, DON'T USE ANY LOGICAL NAME
SETZM .IBDEV(P1)
TELNE6:
TXNN F,LCLFLG ;LOCAL SOCKET GIVEN?
JRST GTFRSK ;NO, GO FIND A FREE SOCKET NUMBER
;[tcp] MOVE T1,.IBLCL+COMBLK ;LOCAL SOCKET
;[tcp] ANDI T1,↑O777 ;JUST 9 BITS
;[tcp] CAIL T1,2 ;TOO SMALL?
;[tcp] TRNE T1,1 ;NO, ODD?
;[tcp] EDisix [SKTER,,[SIXBIT \? L&OCAL !\]]
JRST TELNE5
GTFRSK: SETCM T1,FRESKT ;GET HIGH WORD OF SOCKET NUMBER USE MAP
JFFO T1,GTFRS1 ;ANY FREE SOCKET BLOCKS?
SETCM T1,FRESKT+1 ;NO, TRY LOW WORD
JFFO T1,.+2
IDIOT ;ALL 64 SOCKET BLOCKS IN USE?????!!!!!
ADDI T2,↑D36 ;OFFSET BECAUSE USING LOW WORD
GTFRS1: LSH T2,2 ;CONVERT TO FIRST SOCKET # IN BLOCK
MOVEI T1,2(T2) ;LEAVE ROOM FOR ICP SOCKET
TELNE5: MOVEM T1,.IBLCL(P1)
MOVE T1,.IBHST+COMBLK
TXNE F,HSTFLG ;HOST
;[96bit]HRRM T1,.IBHST(P1)
MOVEM T1,.IBHST(P1) ;[96bit]
;[tcp] TXNN F,BYTFLG ;BYTE SIZE
;[tcp] JRST TELNE2
;[96bit]HLRZS T1
;[tcp] HLRZ T1,.IbByt+ComBlk ;[96bit]
;[tcp] CAIE T1,↑D8 ;ONLY 8 IS LEGAL
;[tcp] EDisix [SPECER,,[SIXBIT \? B&YTE SIZE!\]]
TELNE2: TXNN F,RMTFLG
JRST TELNE3
skipa t1,.ibrmt+ComBlk ;[tcp]
;[tcp] MOVE T1,.IBRMT+COMBLK
;[tcp] TROA T1,1 ;MUST BE ODD
TELNE3: MOVEI T1,27 ;SOCKET 23(27 octal) is now default TELNET ICP SOCKET
movem t1,.ibrmt(p1) ; save in the connection block
CALL ICPGET
JRST STOP
;HERE WHEN A CONNECTION HAS BEEN SET UP
;[96bit]HRRZ T1,.IBHST(P1)
MOVE T1,.IBHST(P1) ;[96bit]
EDisix [[SIXBIT \%: C&ONNECTED TO !\]
WNAME .IBDEV(P1)
]
Call TypHst ; type out the host name
TELNE4: MOVE P2,[POINT 7,THSHST] ; setup for ascii local host name
MOVEI T2,[
PUSHJ P,[
Came P2,[Point 7,LstHst,27] ; any room?
IDPB U1,P2 ; yes.
POPJ P,
]
]
Movem T2,OFile## ;OUTPUT PSEUDO-FILE
;[96bit]HRRZ T1,THSITE ;GET LOCAL HOST NUMBER
MOVE T1,THSITE ;[96bit] GET LOCAL HOST NUMBER
PUSHJ P,TYPHSN ;CONVERT AND STORE LOCAL HOST NAME
WCHI Null ;TERMINATE PROPERLY
SETZM OFile## ;RESTORE NORMAL TTY OUTPUT
MOVE T2,(P1) ;READ CONNECTION PARAMETER WORD FROM DDB
RCPAR T2
SETZ T3, ;UNLIKELY ERROR -- ASSUME STANDARD SETTINGS
TXNE F,LFSWT ;/LF?
TXZ T3,PW.NLF ;YES, CLEAR NO-LINEFEED FLAG
TXNE F,NLFSWT ;/NOLF?
TXO T3,PW.NLF ;YES, SET NO-LINEFEED FLAG
TXNN T3,PW.NLF ;WANT LINE FEED SUPPRESSED?
JRST TELN4 ;NOPE, DON'T BOTHER WITH UUOING
SETO T1, ;FETCH CURRENT LINE CHARACTERISTICS
GETLCH T1
TXO T1,GL.PTM ;YES, SET PAPER-TAPE MODE BIT
SETLCH T1 ;SET LINE CHARACTERISTICS IN CASE CHANGED
TELN4: PUSHJ P,ECHCHK ;YES, SEND APPROPRIATE CODE TO SERVER
RESC ESCBLK ;READ THE CURRENT ESCAPES AND QUOTES
IMPERR TELN4A ;ERROR, DON'T CHANGE ANYTHING
SKIPN T1,ESCBLK ;QUOTE CHARACTER ALREADY EXIST?
MOVEI T1,"N"&37 ;NO, SUPPLY ↑N
MOVE T2,ESCBLK+1 ;ALLOW LACK OF SHIFT CHARACTER
SKIPN T3,ESCBLK+2 ;LOCAL ESCAPE CHARACTER EXIST?
MOVEI T3,"←"&37 ;NO, SUPPLY ↑←
MOVE T4,ESCBLK+3 ;ALLOW LACK OF NETWORK ESCAPE
PESC T1 ;SET ESCAPES AND QUOTES
IMPERR TELN4A ;SOMETHING ILLEGAL, BUT CONNECT ANYWAY
TELN4A: XTTY TELBLK ;CROSSPATCH THE TTY
IMPERR TELN4Q
SKIPG T1,ALLBTS ;SPECIAL ALLOCATION DESIRED?
JRST TELN4B ;NO
MOVEM T1,.IBRMT+TELBLK ;YES, STORE IN BLOCK
HLRZM P,.IBHST+TELBLK ;REQUEST MAXIMUM MESSAGE ALLOCATION
SETALL TELBLK ;DO IMPUUO
IMPERR .+1 ;ERROR--COMPLAIN BUT IGNORE
TELN4B: PUSHJ P,XPWAIT ;WAIT UNTIL CROSSPATCH IS BROKEN
SKPINL ;FLUSH POSSIBLE CONTROL-O
JFCL
PESC ESCBLK ;RESTORE THE OLD QUOTES AND ESCAPES
JFCL ;HAPPENS IF WE BECOME DETACHED
TELN4D: EDisix [TELN4Q,,[SIXBIT \#B&ACK TO % JOB %#!\]
WAsc THSHST ;TYPE LOCAL HOST NAME
WDEC JOBN]
;HERE WHEN MORE THAN ONE IMP SATISFIED THE COMMAND SPECS.
TELNE9: EDisix [STOP,,[SIXBIT \? A&MBIGUOUS SPECIFICATION#!\]]
;HERE TO GET TTY LINE CHARACTERISTICS IN FORCE AT END OF CROSSPATCH
; AND STORE THEM IN THE USER PARAMETER WORD IN THE IMP DDB, THEN
; REINSTATE THE LINE CHARACTERISTICS THAT WERE IN EFFECT BEFORE
; THE CROSSPATCH WAS MADE
TELN4Q: SETO T1, ;FETCH CURRENT LINE BITS
GETLCH T1
SETZ T2, ;START NEW CONNECTION PARAMETER WORD
TXZE T1,GL.PTM ;STILL IN PAPER-TAPE MODE?
TXO T2,PW.NLF ;YES, REMEMBER NO LINEFEED DESIRED
SETLCH T1 ;CLEAR PAPER TAPE MODE IN CASE SET
STATZ TTYCHN,IO.SUP ;SUPPRESSING ECHO?
TXO T2,PW.NEC ;YES, REMEMBER NO ECHO DESIRED
SETSTS TTYCHN,0 ;NOW BRING BACK ECHOING
MOVE T1,(P1) ;FETCH IMP DEVICE NAME
STAT (P1) ;GET CURRENT STATUS
EDisix [STOP,,[SIXBIT\C&ONNECTION NO LONGER OPEN#!\]]
LDB T3,[POINT 6,.IBSTT(P1),35] ;FETCH STATE
CAIE T3,.ISEst ;STILL OPEN?
EDisix [STOP,,[SIXBIT\C&ONNECTION NO LONGER OPEN#!\]]
PCPAR T1 ;YES, PUT LINE BITS INTO IMP DDB
JFCL ;OOP---
JRST STOP ;DONE
;ROUTINE TO SETUP ECHO STATE ACCORDING TO LAST STATE AND SWITCHES
ECHCHK: TXNE F,ECHSWT ;USER WANTS TO ECHO?
TXNN T3,PW.NEC ;YES, IS THAT WHAT WE'RE DOING?
JRST .+2 ;NO TO 1ST OR YES TO SECOND
JRST ECHCMP ;WANTS TO ECHO, MUST TELL SERVER
TXNE F,NECSWT ;CONVERSELY, WANT SERVER TO ECHO?
TXNE T3,PW.NEC ;YES, WHAT'S SERVER DOING?
JRST ECHSET ;NO CHANGE, MAKE SURE WE'RE DOING ON TTY AS REQUIRED
;ROUTINE TO SWITCH ECHO STATE OF THE SERVER
ECHCMP: FSetUp FilOTL ; set up lowseg block (ImpFil)
MOVE T1,.IBDEV+TELOBK ;FETCH DEVICE NAME
MOVEM T1,ImpFil+FILDEV ;STORE IN FILE BLOCK
FoGet ImpFil ;OPEN TELNET CONNECTION FOR OUTPUT
WCHI .TNIAC ;START OFF COMMAND WITH AN IAC
TXCN T3,PW.NEC ;SWITCH. WERE WE ECHOING?
WCHI .TNDO ;YES, TELL SERVER TO
TXNN T3,PW.NEC ;ARE WE ECHOING NOW?
WCHI .TNDNT ;YES, TELL SERVER NOT TO
WCHI .TOECH ;AND SAY WE'RE NEGOTIATING ECHO
FOCLOS ImpFil ;CLOSE OUT FILE
SETZM OFile##
ECHSET: TXNN T3,PW.NEC ;SERVER ECHO?
POPJ P, ;NO, WE ARE
SETSTS TTYCHN,IO.SUP ;YES, SUPPRESS OURS
OUTSTR [ASCIZ//] ;TELL MONITOR
POPJ P, ;RETURN
;ERROR COMMAND. GETS ERROR COUNTS AND STATISTICS.
I.ERRO: PUSH P,.JBFF ;REMEMBER FIRST FREE LOC
PUSH P,.JBREL ;AND CURRENT TOP OF LOW CORE
HRRZ T1,.JBFF ;WHERE TO START BUILDING TABLE
HRLI T1,T2 ;AC TO INDEX INTO TABLE WITH
MOVEM T1,GTTOLD ;SAVE FOR LATER
MOVEI T2,GTBSiz(T1) ;TABLE SPACE WANTED (WITH ROOM FOR EXPANSION)
MOVEM T2,.JBFF ;SAVE NEW FIRST FREE
CAMG T2,.JBREL ;DO WE ALREADY HAVE THAT MUCH?
JRST .+3 ;YES, PROCEED
CORE T2, ;NO, OBTAIN MORE FROM MONITOR
CMDERR [SIXBIT\? I&NSUFFICIENT CORE#!\]
HRLI T1,(T1) ;CLEAR THE TABLE
AOS T2,T1
SETZM -1(T1)
BLT T1,↑D199(T2)
Clearm WATIVL ;CLEAR WAIT INTERVAL
Clearm ErBits ; clear selection bits
Hrlzi T1,ERRARG ;SCAN THE REMAINDER OF THE COMMAND LINE
TXNN F,BRKFLG ; (IF THERE IS ONE)
PUSHJ P,TEXTIN
TXNE F,<COMFGS+COMSWS-IVLFLG> ;CHECK SWITCHES
;[96bit]JRST A.ESWT ;WRONG KIND
JRST A.SWBD ;[96bit] can't use here
MOVE T1,SYSVER ;BEGIN TYPEOUT
HLRZ T2,T1
Move P4,ErBits ; make select bits convenient
TLNN P4,-1 ;ANY SELECTED TYPEOUTS?
Disix [[SIXBIT\#NCP &VERSION %.% OPERATING STATISTICS%!\]
WOCTI (T1) ;NCP VERSION
WOCTI (T2) ;IMPSER VERSION
HRLI P4,-1] ;GIVE ALL TYPEOUTS
Movem P4,ErBits ; save them again
;BACK HERE TO BEGIN ANOTHER PASS OF THE ENTIRE SUMMARY. ON THE FIRST
; PASS, THE IN-CORE TABLE IS ALL ZERO AND THUS ALL NONZERO ENTRIES
; GET PRINTED. ON SUBSEQUENT PASSES, ONLY ITEMS THAT HAVE CHANGED
; GET PRINTED.
IERR0: MOVSI P1,-NGTTBL ;NUMBER OF GETTAB SUBTABLES
TIMER T1, ;GET TIME WE STARTED THIS PASS
MOVEM T1,LASTIM ;SAVE FOR COMPUTING INTERVAL
Disix [[SIXBIT\##%%#------------#!\]
PUSHJ P,TTIME ;PRINT TIME AND DATE
PUSHJ P,TDATE]
;MAIN DRIVING LOOP FOR IMP ERROR STATISTICS FUNCTION
IERR1: HRRZ T1,GTTSTP(P1) ;GET SUBTABLE POINTER INDEX
HLL T1,ErBits ;GET REQUEST BITS
LSH T1,(T1) ;SHIFT APPROPRIATE BIT TO SIGN
JUMPGE T1,IERR8 ;JUMP IF DON'T WANT THIS PRINTOUT
TXZ F,TITLTY ;CLEAR TITLE FLAG
HLLZ P2,GTTSTP(P1) ;GET NEG. NUMBER OF ENTRIES IN SUBTABLE
HRLZ P3,GTTSTP(P1) ;GET SUBTABLE NUMBER
HRRI P3,.GTIMP ;SELECT IMP GETTAB TABLE
GETTAB P3, ;RETURN SUBTABLE POINTER
JRST IERR8 ;LOST THAT ONE
HRLI P3,P2 ;SET INDEX FIELD FOR @
MOVE P4,GTTDSP(P1) ;FETCH DISPATCH ENTRY FOR SUBTABLE
;LOOP REPEATED FOR EACH ITEM IN A SUBTABLE
IERR2: MOVSI T1,@P3 ;COMPUTE ACTUAL .GTIMP ENTRY FOR ITEM
HLRZ T2,T1 ;SAVE FOR INDEX INTO IN-CORE TABLE
HRRI T1,.GTIMP ;SELECT IMP GETTAB TABLE
GETTAB T1, ;GET THE ITEM
JRST IERR5 ;NOT TODAY
CAMN T1,@GTTOLD ;HAS IT CHANGED SINCE LAST WE LOOKED?
TLNE P4,(EG.ACR) ;NO, BUT CHECK FOR ALWAYS-CALLED-ROUTINE
PUSHJ P,(P4) ;CALL ROUTINE TO PRINT ENTRY
MOVEM T1,@GTTOLD ;SAVE AS PREVIOUS VALUE OF THIS ITEM
IERR5: AOBJN P2,IERR2 ;REPEAT FOR EACH ITEM IN SUBTABLE
IERR8: AOBJN P1,IERR1 ;REPEAT FOR ALL SUBTABLES
;LOOP HERE WHILE TIMING REPORT INTERVAL
IERR8A: SKIPN T1,WATIVL ;WAIT INTERVAL SPECIFIED?
JRST IERR9 ;NO, FINISH UP
IMULI T1,↑D60 ;YES, CONVERT INTERVAL TO JIFFIES
ADD T1,LASTIM ;COMPUTE TIME FOR NEXT REPORT
TIMER T2, ;RETURN CURRENT TIME OF DAY
CAMGE T2,T1 ;HAVE WE ARRIVED AT NEXT REPORT TIME?
CAMGE T2,LASTIM ;NO, BUT LOOK OUT FOR MIDNIGHT
JRST IERR0 ;TIME FOR A NEW REPORT
SUB T1,T2 ;NOT YET, COMPUTE REMAINING TIME IN JIFFIES
IDIVI T1,↑D60 ;CONVERT TO SECONDS
CAIL T1,↑D60 ;MORE THAN A SLEEP'S WORTH?
MOVEI T1,↑D60 ;YES, CUT DOWN TO 1 MINUTE
SLEEP T1, ;WAIT A WHILE
JRST IERR8A ;RECHECK WAITING TIME
;HERE TO FINISH UP COMMAND
IERR9: POP P,P4 ;FLUSH SUBTABLE BITS
POP P,T1 ;GET BACK OLD CORE
CAMGE T1,.JBREL ;LESS THAN CURRENT?
CORE T1, ;YES, RETURN SOME
JFCL
POP P,.JBFF ;RESTORE FREE PTR
JRST STOP
;TABLES FOR DRIVING 'IMP ERROR' OUTPUT
EG.ACR==1B0 ;ALWAYS CALL ITEM ROUTINE (EVEN IF ENTRY ZERO)
DEFINE GTTBLS <
SUBTBL 16,IHM,<> ;;IMP-HOST MESSAGES
SUBTBL 5 ,EPL,<> ;;[96bit] error in previous leader
SUBTBL 7 ,INC,<> ;;[96bit] incomplete transmission
SUBTBL 8 ,DMF,<> ;;IMP DATA MESSAGE FAULTS
SUBTBL 3 ,BHS,<> ;;BUFFER HANDLING STATISTICS
SUBTBL 24,HMS,<> ;;HISTOGRAM OF MESSAGE SIZES
subtbl 5 ,IPE,<> ;; IP errors
subtbl 3 ,IPD,<> ;; IP data
subtbl 4 ,ICE,<> ;; ICMP errors
subtbl 20,ICM,<> ;; ICMP types
subtbl 15,TCE,<> ;; TCP errors
subtbl 6 ,TCI,<> ;; TCP input types
subtbl 6 ,TCO,<> ;; TCP output types
>
;LENGTHS AND SUBTABLE NUMBER TABLE
DEFINE SUBTBL(N,STN,FLAGS) <
-↑D'N ,, <%IS'STN>B53
GTBSiz==GTBSiz+↑d'N ;; add to table size
>
GTBSiz==0 ; assume there are no gettab entries
GTTSTP: GTTBLS
NGTTBL==.-GTTSTP ;NUMBER OF SUBTABLES
;FLAGS AND DISPATCH ADDRESSES
DEFINE SUBTBL(N,STN,FLAGS) <
ZZ== 0
IFNB <FLAGS>,<IRP FLAGS <ZZ==ZZ!EG.'FLAGS>>
ZZ + GTT'STN
>
GTTDSP: GTTBLS
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTDMF: TXON F,TITLTY ;NEED TO TYPE TITLE?
WSIX [SIXBIT\#IMP &DATA MESSAGE FAULTS:#!\]
Disix [Cpopj##,,[SIXBIT\ %: %#!\]
WSIX @IMPDMF(P2)
WDEC T1]
;LABELS FOR IMP DATA MESSAGE FAULTS
IMPDMF: [SIXBIT\H&ARDWARE FAULT!\]
[sixbit\P&rotocol not &IP!\]
[SIXBIT\B&AD MESSAGE TYPE!\]
[SIXBIT\D&ISCARDED &RFNM&S!\]
[SIXBIT\S&IMULATED (TIMED OUT) &RFNM&S!\]
[SIXBIT\B&AD MESSAGE SIZE!\]
[sixbit \O&ut of buffers during TTY output!\]
[sixbit \IMPMAK& failures!\]
;SUBROUTINE TO TYPE IMP MESSAGE TYPES
GTTIHM: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#R&ECEIVED &IMP& MESSAGES:#!\]
Clearm ChrCnt ; set to column 0
WSIX @IMPNAM(P2) ;TYPE LABEL
WTAB ↑D10
WDEC 7,T1 ;TYPE VALUE
PJrst TCrLf ; type a crlf and return
;IMP MESSAGE TYPE LABELS
IMPNAM: [SIXBIT\R&EGULAR!\]
[SIXBIT\E&RR W/O ID!\]
[SIXBIT\IMP &DOWN!\]
[SIXBIT\B&LK'D LINK!\]
[SIXBIT\NOP!\]
[SIXBIT\RFNM!\]
[SIXBIT\D&d hst sts!\]
[SIXBIT\D&EST DEAD!\]
[SIXBIT\E&RR W/ID!\]
[SIXBIT\I&NC TRANS!\]
[SIXBIT\IMP &RESET!\]
[SIXBIT\11!\]
[SIXBIT\12!\]
[SIXBIT\13!\]
[SIXBIT\14!\]
[SIXBIT\15!\]
;[96bit] error in previous leader messages from the imp
GTTEPL: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#E&RROR IN PREVIOUS LEADER MESSAGES:#!\]
Clearm ChrCnt ; set to column 0
WSIX @EPLCOD(P2) ;TYPE LABEL
WTAB ↑D20
WDEC 7,T1 ;TYPE VALUE
PJrst TCrLf ; type a crlf and return
EPLCOD: [SIXBIT \E&RROR FLIPFLOP SET!\]
[SIXBIT \M&ESSAGE TOO SMALL!\]
[SIXBIT \I&LLEGAL MESSAGE TYPE!\]
[SIXBIT \L&EADER FORMAT WRONG!\]
[SIXBIT \E&RROR NUMBER WAS BAD!\]
GTTINC: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#I&ncomplete transmission messages:#!\]
clearm chrcnt ;set to column 0
WSIX @INCCOD(P2) ;TYPE LABEL
WTAB ↑D20
WDEC 7,T1 ;TYPE VALUE
PJrst TCrLf ; type a crlf and return
INCCOD: [SIXBIT \D&ESTINATION HOST DID NOT ACCEPT MESSAGE QUICKLY ENOUGH!\]
[SIXBIT \M&ESSAGE WAS TOO LONG!\]
[SIXBIT \H&OST TOOK TOO LONG TO TRANSMIT MESSAGE TO &IMP&!\]
[SIXBIT \M&ESSAGE LOST IN THE NETWORK DUE TO &IMP& OR CIRCUIT FAILURE!\]
[SIXBIT \IMP &COULD NOT ACCEPT THE ENTIRE MESSAGE!\]
[SIXBIT \IMP I/O &FAILURE DURING RECEIPT OF MESSAGE!\]
[SIXBIT \E&RROR NUMBER WAS BAD!\]
;ROUTINE TO TYPE THE DATA MESSAGE SIZE HISTOGRAM
GTTHMS: TXON F,TITLTY ;NEED TITLE?
WSIX [SIXBIT\#H&ISTOGRAM OF RECEIVED DATA MESSAGE SIZES#∨
&B&ITS &C&OUNT#!\]
Clearm ChrCnt ; set to column 0
MOVEI T3,1 ;COMPUTE POWER OF 2
LSH T3,(P2)
Disix [Cpopj##,,[SIXBIT\<%%%#!\]
WDEC T3
WTAB ↑D6
WDEC 7,T1]
;ROUTINE TO TYPE BUFFER STATISTICS
GTTBHS: TXON F,TITLTY ;NEED TITLE?
W2CHI CRLF ;NOT REALLY, BUT SOME SPACE IS NICE
MOVEI T3,↑D50(T1) ;TURN INTO T1 PERCENTAGE
IDIVI T3,↑D100
MOVEI T4,(P2) ;GET SUBTABLE INDEX
CAIN T4,%ISAFB ;IS IT THE BUFFER AVERAGE?
MOVE T1,T3 ;YES, GET THE THING WE JUST COMPUTED
WDEC T1
WSIX @BHSTAB(P2)
POPJ P,
;LABELS FOR BUFFER HANDLING STATISTICS
BHSTAB: [SIXBIT\ &BUFFER OVERRUNS#!\]
[SIXBIT\ &FREE BUFFERS#!\]
[SIXBIT\"% &AVERAGE BUFFER UTILIZATION#!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTIPE: TXON F,TITLTY ;NEED TO TYPE TITLE?
WSIX [SIXBIT\#IP& errors:#!\]
Disix [Cpopj##,,[SIXBIT\ %: %#!\]
WSIX @IPETxt(P2)
WDEC T1]
IPETxt:
[sixbit \N&ot enough bytes for &IP& leader!\]
[sixbit \U&nknown protocol!\]
[sixbit \W&rong version!\]
[sixbit \L&eader checksum failed!\]
[sixbit \U&nknown option seen!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTIPD: TXON F,TITLTY ;NEED TO TYPE TITLE?
WSIX [SIXBIT\#IP& statistics:#!\]
Disix [Cpopj##,,[SIXBIT\ %: %#!\]
WSIX @IPDTxt(P2)
WDEC T1]
IPDTxt:
[sixbit \M&essages parsed with options!\]
[sixbit \F&ragmented messages seen!\]
[sixbit \F&ragmented messages reassembled!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTICE: TXON F,TITLTY ;NEED TO TYPE TITLE?
WSIX [SIXBIT\#ICMP& errors:#!\]
Disix [Cpopj##,,[SIXBIT\ %: %#!\]
WSIX @ICETxt(P2)
WDEC T1]
ICETxt:
[sixbit \N&ot enough bytes for &ICMP& leader!\]
[sixbit \N&ot enough bytes for &ICMP& message!\]
[sixbit \C&hecksum failed!\]
[sixbit \T&ype unknown!\]
;SUBROUTINE TO TYPE IMP MESSAGE TYPES
GTTICM: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#R&ECEIVED &ICMP& MESSAGES:#!\]
Clearm ChrCnt ; set to column 0
WSIX @ICMTxt(P2) ;TYPE LABEL
WTAB ↑D20
WDEC 7,T1 ;TYPE VALUE
PJrst TCrLf ; type a crlf and return
ICMTxt:
[sixbit \E&cho reply!\]
[sixbit \1!\]
[sixbit \2!\]
[sixbit \D&estination unreachable!\]
[sixbit \S&ource quench!\]
[sixbit \R&edirect!\]
[sixbit \6!\]
[sixbit \7!\]
[sixbit \E&cho!\]
[sixbit \9!\]
[sixbit \10!\]
[sixbit \T&ime exceeded!\]
[sixbit \P&arameter problem!\]
[sixbit \T&imestamp!\]
[sixbit \T&imestamp reply!\]
[sixbit \I&nformation request!\]
[sixbit \I&nformation reply!\]
[sixbit \17!\]
[sixbit \18!\]
[sixbit \19!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTTCE: TXON F,TITLTY ;NEED TO TYPE TITLE?
WSIX [SIXBIT\#TCP& errors:#!\]
Disix [Cpopj##,,[SIXBIT\ %: %#!\]
WSIX @TCETxt(P2)
WDEC T1]
TCETxt:
[sixbit \N&ot enough bytes for &TCP& leader!\]
[sixbit \N&ot enough bytes for &TCP& message!\]
[sixbit \C&hecksum failed!\]
[sixbit \P&ort not supported!\]
[sixbit \C&ould not get &DDB& for incoming connection!\]
[sixbit \C&ould not get &ITY& for incoming connection!\]
[sixbit \U&nknown option seen!\]
[sixbit \TCP& leader with options seen!\]
[sixbit \TCP& message tranmission queue pointers wrong!\]
[sixbit \TCP& packets retransmitted!\]
[sixbit \M&essages received which were not next!\]
[sixbit \M&essages previously not next which were used!\]
[sixbit \M&essages completely out of receive window!\]
[sixbit \M&essages with front out of receive window!\]
[sixbit \M&essages with end out of receive window!\]
; type output TCP types
GTTTCO: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#S&ent &TCP& MESSAGES:#!\]
jrst GTTTCX
; type input TCP types
GTTTCI: TXON F,TITLTY ;TITLE IF NEEDED
WSIX [SIXBIT\#R&ECEIVED &TCP& MESSAGES:#!\]
GTTTCX: Clearm ChrCnt ; set to column 0
WSIX @TCPTyp(P2) ;TYPE LABEL
WTAB ↑D13
WDEC 7,T1 ;TYPE VALUE
PJrst TCrLf ; type a crlf and return
TCPTyp:
[sixbit \FIN!\]
[sixbit \SYN!\]
[sixbit \R&eset!\]
[sixbit \PUSH!\]
[sixbit \ACK&nowlege!\]
[sixbit \U&rgent!\]
;HELP COMMAND -- PROVIDES HELPING TEXT
I.HELP: FIOPEN HLPFIL ;OPEN HELP FILE FOR INPUT
INBUF HLPCHN,1 ;NEED ONE BUFFER TO SYNCHRONIZE INPUT
MOVEI T1,HLPNDX
TXNE F,BRKFLG ;END OF LINE?
JRST HELP2 ;YES
HELP1: SETZM IFile## ;READ FROM TTY
CALL GETSYM ;GET A FIELD
JUMPE A,A.ECMD ;ERROR IF EMPTY
MOVE T2,COMLST ;SEARCH FOR MATCH
;[96bit]CALL SIXSRC ;AMONG COMMAND LIST
Call SixSrA ; check for A in commands
JRST HELP3
HELP2: MOVE T1,COMXCT(T1) ;GET RIGHT HELP ENTRY
JRST HELP3A ;DO IT
;HERE TO TRY SECOND HELP LIST
HELP3: Exch T1,A ; recall arg, save results
MOVE T2,HLPLST ;SEARCH
CALL SIXSRC
;[96bit] JRST A.ECMD ;ERROR IF NOT FOUND
Jrst [ ; still not found
Or T1,A ; ambiguous if ambiguous in one list.
TabErr [Sixbit \HELP& argument!\] ; give error
]
MOVE T1,HLPXCT(T1) ;GET THE RIGHT HELP ENTRY
HELP3A: HLRZ T2,T1 ;GET INDEX INTO HELP FILE
FISEL HLPFIL ;SELECT FILE FOR INPUT
PUSHJ P,(T1) ;DO HELP OPERATION
TXNN F,BRKFLG ;DONE?
JRST HELP1 ;NO
JRST STOP ;YES
;ROUTINE TO DO HELP WITH NO ARGUMENTS
HELP4: WSIX VERMSG ;TYPE VERSION NUMBER OF IMPCOM
WSIX [SIXBIT \T&HE FOLLOWING COMMANDS ARE AVAILABLE:#!\]
MOVE T2,COMLST ;LIST ALL OF THE COMMANDS
CALL TYPLST
MOVEI T2,MHELP## ;TYPE STANDARD MESSAGE
PUSHJ P,HLPTYP
MOVE T2,HLPLST ;TYPE REMAINING HELP ARGUMENTS
JRST TYPLST
;ROUTINE TO TYPE THE HELP MESSAGE WHOSE RELATIVE ADDRESS IN THE FILE
; IS GIVEN IN B.
HLPTYP: IDIVI T2,200 ;SEPARATE BLOCKS AND WORDS
IMULI T3,5 ;TURN REMAINDER INTO BYTES
SETZM HLPFIL+FILCTR ;FORCE READ
USETI HLPCHN,1(T2) ;SELECT THE RIGHT BLOCK
RCH T1 ;READ T1 CHARACTER
SOJG T3,.-1 ; UNTIL WE GET TO THE MESSAGE
WCH T1 ;PRINT IT
RCH T1 ;GET NEXT
JUMPN T1,.-2 ;CONTINUE TO END OF MESSAGE
POPJ P, ;DONE
;HANDLE ERRORS READING HELP FILE
HLPER1: ERRIOP HLPFIL ;INPUT OPEN FAILURE
JRST STOP
HLPER2: ERRLK HLPFIL ;LOOKUP FAILURE
JRST STOP
HLPER3: ERRIN HLPFIL ;INPUT ERROR
JRST STOP
;IMPCOM VERSION NUMBER
Define XX(V,U,E,W)<
Ifnb <W>,<Sixbit \V'U(E)-W#!\>
Ifb <W>,<Sixbit \V'U(E)#!\>
>
VERMSG: VerStr ; set up the string, according to XX
; (Verstr is "XX V,U,E,W" from VERSION)
;ASSEMBLE HELP NAME TABLE
DEFINE CC(A) <
IRP A< <SIXBIT \A\>
>>
HLPNAM: HELPS
HLPLST: HLPNAM-.,,HLPNAM
;HELP DISPATCH TABLE
DEFINE CC(A,F) <
IFDIF <A><HELP>,<
M'A## ,, HLPTYP
>
IFIDN <A><HELP>,<
HLPNDX==.-COMXCT
M'A## ,, HELP4
>>
COMXCT: COMS
HLPXCT: HELPS
SUBTTL ACTION ROUTINES FOR LEXICAL INTERPRETER
;Subroutine to check for a recognized monitor command, and figure
; out what it's trying to tell us. If it's not recognized, we
; assume it's "run" or some such, so we flush input and prompt.
A.ICHK: Move T2,MonPnt ; point at the monitor commands
Call SixSrA ; try to find A there
Jrst NotMon ; not a monitor command i recognize
Skipn A,MonEql(T1) ; grab the equivalent impcom command
Return ; none: continue scanning the line
LCh P2 ; back pedal: put back next char.
Jrst A.Ret## ; that was easy: return command
NotMon: Txo F,RunFlg ; flag that there's no command to parse
CALL FLUSH ;THROW AWAY LINE
WCHI "*" ;PROMPT
RChf P2 ; get the first character
RETURN
; monitor commands ImpCom may recognize
MonCom: Sixbit .ImpCom. ; standard monitor intro
Sixbit .Tn. ; abbreviation for TelNet
Sixbit .Connec. ; "Connect" also means "TelNet"
MonPnt: MonCom-.,,MonCom ; pointer to table
; equivalences: what the monitor commands want ImpCom to do
MonEql: 0 ; IMPCOM=nothing, just start parsing
Sixbit .TelNet. ; TN=TelNet
Sixbit .TelNet. ; CONNECT=TelNet
;SUBROUTINE TO INITIALIZE FOR FIELD OR NAME INPUT
A.TINI: TXZ F,SEPARA ;[96bit] "." not seen yet
SETZM HstAdr ;[96bit] CLEAR HOST NUMBER
Txne F,HstFlg ; have a host in the buffer?
Tdza B,B ; make stores go out the window.
Move B,[Point 7,AscBuf] ; point at the ascii buffer
Move C,[POINT 6,A] ; set the sixbit word pointer
A.NINI: Clear A, ; clear the sixbit word or number
A.Fini: MOVEI T1,↑D10 ;SET RADIX 10
MOVEM T1,RADIX
TXZ F,LETFLG ;CLEAR LETTER FLAG
;[96bit]SETZM HstAdr ;CLEAR HOST NUMBER
RETURN
A.OINI: MOVEI T1,↑D8
MOVEM T1,RADIX
RETURN
;HERE TO PACK ANOTHER DECIMAL DIGIT
A.DPAK: IMUL A,RADIX ;DECIMAL DIGIT
ADDI A,-"0"(P2) ;PACK IT
RETURN
;HERE TO PACK ANOTHER SIXBIT CHARACTER
A.TPAK: Came B,[Point 7,AscEnd,27] ; any more room in ascii buf?
Idpb P2,B ; yes: put char in buffer
CAIGE P2,↑O140 ;UPPER CASE?
SUBI P2,↑O40 ;YES. CONVERT TO SIXBIT
TRNN A,↑O77 ;MAKE SURE OF ROOM
IDPB P2,C ;DEPOSIT CHARACTER
Caie P2,"-" ; is it a dash? (dash is a letter)
TXNN P3,DIGIT ;IS IT A DIGIT?
TXOA F,LETFLG ;NO
TXNE F,LETFLG ;ANY LETTERS SO FAR?
POPJ P, ;YES, DON'T DO ANY NUMERIC STUFF
EXCH T1,HstAdr ;NO, MIGHT WANT NUMBER LATER
IMUL T1,RADIX ;SO...
ADDI T1,40-"0"(P2) ; BUILD
EXCH T1,HstAdr ; IT UP
Return
;[96bit] routines to parse host/site number
A.HNPK: TXOE F,SEPARA ;[96bit] remember we've started
JRST HNPK1 ;[96bit] already been here before
EXCH A,HstAdr ;[96bit] get host number, store
; the imp number in place
DPB A,HSTPLC ;[96bit] put host no. in place
Return ; and go back to work
HNPK1: push p,a ;[tcp] save what we now know is
;[tcp] the IMP number
move a,HstAdr ;[tcp] get address as given so far
txne a,ih.Net ;[tcp] a net number yet?
jrst [ ;[tcp] yes. must be giving
;[tcp] double imp field.
ldb a,ImpPlc ;[tcp] get old imp field
lsh a,↑d8 ;[tcp] shift over to next 8 bit field
ior a,(p) ;[tcp] mush new in with new old.
dpb a,ImpPlc ;[tcp] put back in place
pop p,a ;[tcp] clear stack
return ;[tcp] return to parsing
]
ldb a,HstPlc ;[tcp] get what we thought was
;[tcp] a host number
DPB A,NETPLC ;[tcp] turned out to be the net number
ldb a,ImpPlc ;[tcp] get imp number
dpb a,HstPlc ;[tcp] except we now know that it's
;[tcp] the host number.
pop p,a ;[tcp] recover real imp number
dpb a,ImpPlc ;[tcp] store where it should be.
RETURN ;[96bit] and back to parsing
IMPPLC: Pointr (HstAdr,Ih.Imp) ;[96bit] host number position
HSTPLC: Pointr (HstAdr,Ih.Hst) ;[96bit] host number position
NETPLC: Pointr (HstAdr,Ih.Net) ;[96bit] network number position
;HERE TO SAVE COMBLK NAME
A.DSAV: MOVEM A,.IBDEV+COMBLK
TXON F,DEVFLG
RETURN ;OK
;HERE ON SWITCH ERROR
A.ESWT: CMDERR SWTERM ;TYPE MESSAGE AND EXIT
;[96bit] here when we found an improper switch on
A.SWBD: CMDERR BADSWT ;[96bit] bad switch seen
;HERE ON COMMAND ERROR
A.ECMD: CMDERR CMDERM
; figure out a host field
A.SHst: TXOE F,HSTFLG ;REMEMBER HOST SEEN, CHECK FOR 2ND
CmdErr [Sixbit \? M&ore than one host specified.#!\]
Txnn F,LetFlg ; seen any letters?
Jrst HstLgl ; nope: must be a number
Setz T1, ; make sure name is ascii
idpb T1,B ; by ending with zero
Txne F,HstCmd ; are we in a host command?
Return ; yes: let it handle anything.
Movei T1,AscBuf ; check the string for a host name
Call HstNam## ; is this a host name?
CmdErr [Sixbit \? H&ost tables cannot be read. &P&lease use host numbers.#!\]
Jrst AnyHst ; none: make a list of possibilities
Dpb T2,PHostN ; put it in the block
Return ; squared away
;[96bit] check for legal host, and do some necessary twiddling
HstLgl: Move T1,HstAdr ; retrieve the host number
TXZN F,SEPARA ;[96bit] did we get the site and host
; separately?
CALL HstCon ;[96bit] no: convert from old to new.
skipe t1 ;[tcp] don't allow zero
TXNE T1,<-1-<Ih.Net!Ih.Hst!Ih.Imp>> ;[96bit] any bad bits?
EDisix [SpecEr,,[Sixbit \? H&ost number!\]]
;[96bit] until networks are here, check to see if he's trying
;[tcp] TXNE T1,Ih.Net ;[96bit] any network number given?
;[tcp] CMDERR [Sixbit \? M&ultiple networks not yet available#!\]
txnn t1,ih.Net ;[tcp] got a net number?
txo t1,<insvl. (↑d10,ih.Net)> ;[tcp] no. assume arpanet
Dpb T1,PHostN ; put it in the block
Return ; and return
; try to give a list of possible hosts.
AnyHst: Txz F,NckNam ; clear nick name flag
Txo F,TtlSwt ; remember haven't yet explained.
Movei T1,AscBuf ; point to the string again
Movei T2,HstLst ; where to go for each host
Movei T3,GotNck ; standard nickname parser
Call HstGen## ; go to it
Pjrst NoHTbl ; can't find host table????
Pjrst NotThr ; say nothing matches that.
Call NckCln ; add close ) for nickname, and <crlf>
PJrst Stop1A ; end. go restart.
; when listing ambiguous host spec, come here for each host
HstLst: Txze F,TtlSwt ; explained yet?
EDisix [[Sixbit \&? ""%"" is an ambiguous host name:#!\]
Wasc AscBuf ; replay what was typed
]
Call NckCln ; end nicknames if needed, add <crlf>
Clearm ChrCnt ; set to column 0
WChi Tab ; tab over one
WAsc (T1) ; output the host name
Return
; routines to decide why a switch is bad
; first, switch without parameter
SwtBdA: Move T2,ParLst ; search the switches which do take parm
Movei B,[SixBit \&must have!\] ; what to say if found there
Jrst SwtBa1 ; now jump to common code
; now for switches that do take parameters
SwtBad: Move T2,SwtLst ; search parameter-less switch list
Movei B,[SixBit \&cannot have!\] ; what to say if found there
SwtBa1: Jumpl T1,SwtAmb ; false alarm: switch was ambiguous
Call SixSrA ; check the opposite table
TabErr SwtStr ; really not around: explain why.
EDisix [Stop1a,,[SixBit \T&he switch ""%"" % an argument.#!\]
WName A ; what we were looking for
WSix (B) ; what was wrong with it
]
SwtAmb: Jsp T2,TabDcd ; ambiguous: go into normal table print
SwtStr: Sixbit \&switch!\ ; sixbit string for error printing
;SAVE THE PARAMETER
A.PSAV: MOVE T2,PARLST ;FIND IT
;[96bit]CALL SIXSRC
;[96bit] JRST A.ESWT
Call SixSrA ; search the table for the value in A
Jrst SwtBad ; figure out what was wrong with it
HRRZM T1,PPARAM
RETURN
;PARAMETER VALUE
A.PVAL: MOVE T4,PPARAM ;GET REMEMBERED INDEX
Move T1,A ; position value
TXNN T1,40B5 ;SYMBOL?
JRST PVAL2 ;NO
SKIPN T2,PARSYM(T4) ;SYMBOLIC OK?
;[96bit] JRST A.ESWT
CMDERR [Sixbit \? S&witch Argument must be a number#!\];[96]
JUMPG T2,(T2) ;GO TO SUBROUTINE
CALL SIXSRC ;YES. SEARCH
;[96bit] JRST A.ESWT
TABERR [Sixbit \&SWITCH ARGUMENT!\] ;[96bit]
MOVE T4,PPARAM ;GET INDEX AGAIN
PVAL1: XCT PARVAL(T4) ;GET THE VALUE
PVAL2: TDOE F,PARFLG(T4) ;SET FLAG, SKIP IF OFF
JRST PVAL3
DPB T1,PARTAB(T4) ;DEPOSIT THE VALUE
RETURN
;HERE IF FLAG ALREADY SET
PVAL3: LDB T2,PARTAB(T4) ;GET PREVIOUS VALUE
CAME T2,T1 ;BETTER BE SAME
;[96BIT]JRST A.ESWT
CMDERR [Sixbit \? S&witch contradicts previous input#!\];[96]
RETURN
;HERE TO HANDLE SWITCH WITHOUT VALUE
A.SSWT: MOVE T2,SWTLST
;[96bit]CALL SIXSRC ;FIND IT
;[96bit] JRST A.ESWT ;NOT THERE
Call SixSrA ; find it, using parameter in A
Jrst SwtBdA ; figure out what was wrong.
XCT SWTXCT(T1) ;DO IT
JRST A.ESWT
RETURN
;HERE TO HANDLE SUBFIELD OF 'ERROR' COMMAND
A.ESRC: MOVE T2,ERRLST ;SEARCH FOR NAME IN ERROR TABLE
;[96bit]PUSHJ P,SIXSRC
;[96bit] JRST A.ECMD ;NOT FOUND
Call SixSrA ; find the parameter in A
TABERR [Sixbit \ERROR& ARGUMENT!\]
Move T1,ErrBit(T1) ; get the bits
Iorm T1,ErBits ; and or them in with the others.
POPJ P,
PARLST: -PARLEN,,PARNAM
PARNAM:
;[96bit]SIXBIT \HOST\ Host switch removed[96bit]
SIXBIT \SITE\
SIXBIT \LOCAL\
SIXBIT \REMOTE\
;[tcp] SIXBIT \BYTESI\
JOBNAM: SIXBIT \JOB\
SIXBIT \STATE\
SIXBIT \USER\
SIXBIT \WAIT\
SIXBIT \INTERV\
SIXBIT \ALLOCA\
PARLEN==.-PARNAM
PARFLG:
;[96bit]HSTFLG Host switch removed[96bit]
SITSWT
LCLFLG
RMTFLG
;[tcp] BYTFLG
JOBFLG
STTFLG
USRFLG
WATFLG
IVLFLG
ALLFLG
PARTAB:
PHOSTN:
;[96bit]POINT 8, .IBHST+COMBLK, 35 Host switch removed[96bit]
;[96bit]POINT 8, .IBHST+COMBLK, 35
POINT 32, .IBHST+COMBLK, 35 ;[96bit]
POINT 32, .IBLCL+COMBLK, 35
POINT 36, .IBRMT+COMBLK, 35
;[tcp] POINT 18, .IBBYT+COMBLK, 17
POINT 18, .IBSTT+COMBLK, 17
POINT 6, .IBSTT+COMBLK, 35
POINT 23, .IBLCL+COMBLK, 26
PWATCD: POINT 3, WAITCD##, 35
POINT 36, WATIVL, 35
POINT 36, ALLBTS, 35
PARSYM:
;[96bit]EXP 0 ;'HOST' Host switch removed[96bit]
EXP 0 ;'SITE'
EXP 0 ;'LOCAL'
EXP 0 ;'REMOTE'
;[tcp] EXP 0 ;'BYTESIZE'
-1,,SLFNAM ;'JOB'
STTLST: NSTATE,,STATES ;'STATE'
-1,,SLFNAM ;'USER'
EXP 0 ;'WAIT'
EXP 0 ;'INTERVAL'
EXP 0 ;'ALLOCATE'
PARVAL:
;[96bit]JFCL ;'HOST' Host remove[96bit]
JFCL ;'SITE'
JFCL ;'LOCAL'
JFCL ;'REMOTE'
;[tcp] JFCL ;'BYTE'
MOVE T1,JOBN ;'JOB'
JFCL ;'STATE'
HRRZ T1,PRJPRG ;'USER'
JFCL ;'WAIT'
JFCL ;'INTERVAL'
JFCL ;'ALLOCATE'
ERRLST: -ERRLEN ,, ERRNAM
ERRNAM: SIXBIT \IMPMES\
SIXBIT \IMPFLT\
Sixbit \EPLCNT\
Sixbit \INCCNT\
SIXBIT \HISTOG\
SIXBIT \BUFFER\
Sixbit \ERRORS\
sixbit \IPData\
sixbit \TCPDat\
ERRLEN==.-ERRNAM
ERRBIT: 1B<<%ISIHM>B53>
1B<<%ISDMF>B53>
1B<<%IsEPL>B53>
1b<<%IsINC>B53>
1B<<%ISHMS>B53>
1B<<%ISBHS>B53>
1B<<%ISEPL>B53>!1b<<%IsINC>B53>!1b<<%IsIPE>B53>!1b<<%IsICE>B53>!1b<<%IsTCE>B53>!1B<<%IsDMF>B53>
1b<<%IsIPD>B53>!1b<<%IsIPE>B53>!1b<<%IsICD>B53>!1b<<%IsICE>B53>
1b<<%IsTCE>B53>!1b<<%IsTCI>B53>!1b<<%IsTCO>B53>
;SWITCH TABLES
;LIST OF SWITCH NAMES
SWTNAM: SIXBIT \ALL\
INPNAM: SIXBIT \INPUT\
SIXBIT \OUTPUT\
SLFNAM: SIXBIT \SELF\
SIXBIT \SLOW\
SIXBIT \NOWAIT\
SIXBIT \FAST\
SIXBIT \LONG\
SIXBIT \DEITY\
SIXBIT \TITLES\
SIXBIT \ECHO\
SIXBIT \NOECHO\
SIXBIT \LF\
SIXBIT \NOLF\
SIXBIT \ABSOLU\
SWTLST: SWTNAM-.,,SWTNAM
;TABLE OF THINGS TO DO ON A SWITCH
SWTXCT: TXOA F,ALLSWT ;/ALL
TXOA F,INPSWT ;/INPUT
TXOA F,OUTSWT ;/OUTPUT
JRST SLFSET ;/SELF
JRST SLOSET ;/SLOW
TXOA F,NWTSWT ;/NOWAIT
JRST FSTSET ;/FAST
TXOA F,LNGSWT ;/LONG
TXOA F,GODSWT ;/DEITY
TXOA F,TTLSWT ;/TITLES
TXOA F,ECHSWT ;/ECHO
TXOA F,NECSWT ;/NOECHO
TXOA F,LFSWT ;/LF
TXOA F,NLFSWT ;/NOLF
TXOA F,ABSSWT ;/ABSOLUTE
SLFSET: MOVEI T4,JOBNAM-PARNAM
JRST PVAL1
FSTSET: MOVEI T1,2 ;/FAST, SET CODE 2
TXOA F,FSTSWT ;ALSO SET FLAG
SLOSET: MOVEI T1,5 ;128 SEC = SLOW
WATSET: DPB T1,PWATCD
RETURN
SUBTTL SUBROUTINES
; count each character and count it
CntOut: aos ChrCnt ; keep count of characters
OutChr U1 ; and output this one
Return ; return!
; space to a particular column. assumes T1 is pushed on the stack.
TabIt: Camg T1,ChrCnt ; are we there yet?
Jrst TPopj ; get T1 back and return
Wchi " " ; space to column
jrst TabIt ; and loop
Tpopj: pop p,T1 ; restore T1
Return ; and return.
; routine to read a character, and ignore it if it's ignorable.
; also sets the break flag if it's a break char.
FScan: Call Save2## ; save some regs
FScan1: inchwl P1 ; get the character
RFLG P1 ;GET FLAGS
TXNE P2,IGNOR ;CONTROL CHAR?
JRST FSCAN1 ;YES, IGNORE
TXNE P2,BREAK ;BREAK?
TXO F,BRKFLG ;YES
Move U1,P1 ; put char where it'll be found
RETURN
;SUBROUTINE TO FLUSH THE REST OF THE LINE
FLUSH1: RChf P2 ;GET ANOTHER CHARACTER
FLUSH: TXNN P3,BREAK ;BREAK?
JRST Flush1 ;NO
TXZ F,BRKFLG ;YES, AND START OVER
RETURN ;RETURN
;SUBROUTINE TO GET THE NEXT TEXT FIELD
GETSYM: Hrlzi T1,Label ; make entry to RdCmd at LABEL
JRST TEXTIN
;SUBROUTINE TO GET THE NEXT FIELD
FIELDN: Hrlzi T1,Field ; enter RdCmd at FIELD
Jrst Textin
;SUBROUTINE TO GET THE ENTIRE LINE
LISTIN: Hrlzi T1,LIST ; enter RdCmd at LIST
TextIn: Hrri T1,RdCmd ; the production table is RdCmd
PJrst LexInt## ; go produce.
;HERE WHEN DONE
TSTOP: JUMPG P2,STOP
TSTOP1: EDisix [STOP,,[SIXBIT \? S&OCKET NOT FOUND#!\]]
; here if we got a table error. SixScr sets T1<0 if ambiguous,
; table description is pointer to by T2. SixSrc returns the object
; it was searching for in T3.
TabDcd: move T1,1+[ ; decide which brand of failure
[Sixbit \&an ambiguous!\] ; T1=-1
[Sixbit \¬ a recognized!\] ; T1= 0
](T1)
EDisix [Stop1A,,[Sixbit \&? ""%"" is % %.#!\]
WName T3 ; give object of search
Wsix (T1) ; which type
Wsix (T2) ; description
]
; here if we can't trust P3
Stop1A: Txnn f,BrkFlg ; end of line yet?
call Flush1 ; no: swallow line
jrst Stop1 ; and to the normal stuff
;HERE ON SOME SPECIFICATION ERRORS
SKTER: WSIX [SIXBIT \&SOCKET!\]
SPECER: WSIX [SIXBIT \& SPECIFICATION ERROR#!\]
;HERE WHEN ALL THROUGH
STOP: TXNN F,BRKFLG ;END OF LINE?
CALL FLUSH ;NOT YET
STOP1: SKPINL ;SUPPRESS EFFECT OF CONTROL-O
JFCL
TXNE F,RUNFLG ;RUN COMMAND?
JRST STOP3 ;YES
TXNE F,LOGFLG ;NO, JOB LOGGED IN?
JRST STOP2 ;YES
WSIX [SIXBIT\#.!\] ;NO, HAVE TO TYPE OUR OWN PERIOD
LOGOUT ;AND LOG OURSELF OUT
STOP2: RESET ;ENSURE ALL FILES CLOSED
EXIT 1, ;SILENT EXIT
STOP3: SETZM OFile## ;YES. OR CONTINUE
ifn FtKSeg,< ;drp need to undo meddle if we getsegged
Skipn LowHTS## ;HAS THE HOST TABLE BEEN SETUP?
SKIPN THSHST ;NO, WAS IT BECAUSE HISEG DISAPPEARED
; WHILE WE WERE TELNETTING?
> ;drp end of ifn FtKSeg
JRST IMPCO1 ;JUST RESTART
ifn FtKSeg,< ;drp must rerun, since we have meddle bit set
MOVEI T1,RUNDEV ;YES, DO A RUN INSTEAD OF RESTARTING
RUN T1, ; BECAUSE OTHERWISE WE WON'T BE ABLE TO
HALT ; REBUILD THE HOST TABLE BECAUSE WE
; DID A GETSEG AND THAT'S MEDDLING.
> ;drp end of ifn FtKSeg
CMDERM: SIXBIT \? C&OMMAND ERROR#!\
SWTERM: SIXBIT \? S&WITCH ERROR#!\
BADSWT: Sixbit \? I&NAPPROPRIATE SWITCH SEEN#!\ ;[96bit]
ARGERM: SIXBIT \? E&XPLICIT ARGUMENT REQUIRED#!\
;SUBROUTINE TO TYPE THE STATUS OF THE CONNECTION BLOCK
; WHOSE ADDRESS IS IN P1. ENTER WITH PHYSICAL NAME IN T1.
TYPSTS: TXOE F,TITLTY ;TITLE ALREADY TYPED?
JRST TYPST0 ;YES, PROCEED
TXNN F,<FSTSWT!LCLFLG!DEVFLG> ;/FAST OR EXPLICIT ARG?
TXC F,TTLSWT ;NO, COMPLEMENT /TITLE SWITCH
TXNN F,TTLSWT ;TITLE TO BE TYPED?
JRST TYPST0 ;NO
TXNN F,FSTSWT ;SKIP IF /FAST
WSIX [SIXBIT\IMP L&OGICAL &J&OB &L&OCAL-&P&ort &S&TATE &F&OREIGN-&H&OST &F&OREIGN-&P&ort &TTY#!\]
TXNE F,FSTSWT ;SKIP IF NOT /FAST
WSIX [SIXBIT\IMP L&OGICAL &J&OB &S&TATE &F&OREIGN-&H&OST &TTY#!\]
TXNE F,LNGSWT ;EXTENDED STATUS
WSIX [SIXBIT\ P&rt &R&'cv-wnd &S&end-wnd &R&etran#!\]
;CONTINUE TYPSTS
TYPST0: Clearm ChrCnt ; set to column 0
MOVSI T2,(A) ;PUT SIXBIT DEVICE NUMBER IN LH
TLNN T2,77 ;RIGHT-JUSTIFY
LSH T2,-6
TLNN T2,77
LSH T2,-6
WSIX 3,T2 ;PRINT IMP NUMBER
WTAB 5 ;LINE UP
CAMN A,.IBDEV(P1) ;ANY LOGICAL NAME ASSIGNED?
JRST .+3 ;NO
WNAME .IBDEV(P1) ;YES, PRINT IT
WCHI ":" ;AND A COLON
WTAB ↑D13 ;LINE UP AGAIN
HLRZ T2,.IBSTT(P1) ;GET JOB#
WDECI 3,(T2) ;PRINT IT
WCHI " "
hrrz T4,.IBSTT(P1) ;GET STATE
TXNE F,FSTSWT ;/FAST?
JRST TYPST1 ;YES, OMIT LOCAL SOCKET
JUMPE T4,.+2 ;OMIT ALSO IF THIS SIDE CLOSED
WOCT ↑D11,.IBLCL(P1) ;PRINT LOCAL SOCKET NUMBER
WTAB ↑D30 ;LINE UP AGAIN
TYPST1: WSIX 6,STATES(T4) ;PRINT STATE
JUMPE T4,TCrLf ;DONE IF CLOSED STATE
;[tcp] HLRZ T2,.IBBYT(P1) ;GET BYTE SIZE
;[tcp] TXNN F,FSTSWT ;/FAST?
;[tcp] WDECI 4,(T2) ;NO, PRINT BYTE SIZE
WCHI " "
;[96bit]HRRZ T1,.IBHST(P1) ;GET HOST NUMBER
MOVE T1,.IBHST(P1) ;GET HOST NUMBER
PUSHJ P,TYPHSN ;TYPE HOST NAME FOR THAT NUMBER
WTAB ↑D37 ;ADVANCE TO NEXT FIELD
TXNE F,FSTSWT ;/FAST?
JRST TYPST2 ;YES
WTAB ↑D50 ;NO, CORRECT ADVANCE
WOCT ↑D13,.IBRMT(P1) ;TYPE REMOTE SOCKET #
TYPST2: Move T1,A ; get device into T1
ITTY T1 ;GET CROSSPATCHED OR CONTROLLED TTY
JRST TCrLf ;OMIT IF ERROR RETURN
JUMPGE T2,TYPST3 ;JUMP IF LOCAL TTY CROSSPATCHED
WOCTI 5,(T2) ;ELSE IS REMOTE TTY LINE (ITY)
JRST TCrLf ;DONE
TYPST3: HRRZS T2 ;CLEAR JUNK IN LH
GETLCH T2 ;RETURN LINE CHARACTERISTICS
TXZ T2,.UxTrm ; zap the terminal bit
TXNN T2,Gl.Cty ;IS IT THE CTY?
Disix [Cpopj,,[SIXBIT\ *%#!\] ;NO
WOCTI (T2)]
WSIX [SIXBIT\ *CTY!\] ;YES
PJrst TCrLf ; finish line and return
;SUBROUTINE TO TYPE OUT BOTH HOST NAME AND NICKNAME, IF A NICKNAME
; EXISTS, GIVEN HOST NUMBER IN T1.
TypHst: Push p,T1 ; save host number in case fails
Movei T2,TypNam ; go here when found host
Movei T3,GotNck ; here for each nick name
Seto T4, ; look for exact match
hrrm T4,ChrCnt ; put large number into chrcnt so no tab
Txz F,NckNam ; remember no nicknames printed yet
Pushj P,HstNGn ; do it
Jfcl ; couldn't get the table
Jrst TypHs2 ; and type the number (not found)
Call NckCln ; clean up leftover nickname, add CRLF
Jrst TPopj ; clear stack and return
;SUBROUTINE TO TYPE OUT THE NAME OF THE HOST WHOSE NUMBER IS GIVEN IN T1
TypHsn: Push p,T1 ; save the host number for failure
Pushj P,HstNum## ; find the name
Jfcl ; lost
Jrst TypHs3 ; host not there: type number
Pop P,T2 ; clean up the stack
TypNam: Wasc (T1) ; output the host name
Return ; clear stack and return
;HERE IF HOST NOT IN TABLES, OR TABLES UNAVAILABLE
TypHs2: Pop P,T1 ; get back the host number
Call TypHs4 ; type the host number
PJrst TCrLf ; give a crlf and return
; get back the host number, and tell we're faking it.
TYPHS3: Pop P,T1 ; restore host number
TypHs4: WSix [Sixbit \H&ost !\] ;[96bit] output host
; routine to print a host number as <host>.<Site>
TypHNm: lsh t1,4 ; left justitfy it
skipa t4,[4] ; four bytes in a host number (and
; skip into loop.
TypHNL: wchi "." ; separator
setz t2, ; clear out target
rotc t1,↑d8 ; get next byte of host number
wdec t2 ; print it
sojg t4,TypHNL ; loop until happy
return ; go home
;SUBROUTINE TO SET UP AN ICP CONNECTION
;CALL:
; MOVE P1,[ADDRESS OF 2 CONNECTION BLOCKS]
; MOVE T1,[TARGET REMOTE ICP SOCKET NUMBER]
; CALL ICPGET
; ERROR RETURN ... MESSAGE TYPED. NO CONNECTION.
; OK RETURN ... CONNECTION SET UP
ICPGET:
repeat 0,< ;[tcp] much simpler in TCP
TRNN T1,1 ;REMOTE SOCKET BETTER BE ODD
IDIOT
MOVEM T1,ICPBLK+.IBRMT
MOVE T1,.IBHST(P1) ;HOST
;[96bit]HRRM T1,ICPBLK+.IBHST
MOVEM T1,ICPBLK+.IBHST ;[96bit]
MOVEM T1,.IBHST+.IBSIZ(P1)
MOVE T1,.IbByt(P1) ;[96bit] get byte size
MOVEM T1,.IbByt+.IbSiz(P1) ;[96bit] and store.
MOVE T1,.IBLCL(P1) ;LOCAL INPUT SOCKET
CAIG T1,↑O777
CAIGE T1,2
IDIOT
TRNE T1,1
IDIOT
SUBI T1,2
MOVEM T1,ICPBLK+.IBLCL ;INITIAL LOCAL SOCKET
ADDI T1,3
MOVEM T1,.IBLCL+.IBSIZ(P1) ;LOCAL OUTPUT SOCKET
SETZM .IBRMT(P1) ;CLEAR REMOTE SOCKET FIELDS FOR LISTEN
SETZM .IBRMT+.IBSIZ(P1)
Listen .IBDEV(P1) ;LISTEN ON BOTH SOCKETS
IMPERR Cpopj##
MOVE T1,.IBDEV(P1) ;TRANSFER ALLOCATED DEVICE NAME IF NECESSARY
MOVEM T1,.IBDEV+.IBSIZ(P1)
Listen .IBDEV+.IBSIZ(P1)
IMPERR ICPGE9
;CONTINUATION OF THE ICP CODE
ICPGE1: CONN ICPBLK ;CONNECT
IMPERR ICPGE6
FSETUP FILICP
FiGet ImpFil ; open IPC:
MOVSI T1,(POINT 32) ;SET ICP BYTE SIZE
HLLM T1,ImpFil+FILPTR
RCH T2 ;GET THE 32-BIT SOCKET NUMBER
FRel ImpFil ;CLOSE OUT THE ICP DATA CONNECTION
SETZM IFile## ;CLEAR INPUT FILE POINTER
CLOS ICPBLK
IMPERR .+1
CLOS 1,ICPBLK ;JUST IN CASE
JFCL
TLO T2,(1B0) ;IN CASE ITS 0
TRO T2,1
MOVEM T2,.IBRMT(P1)
TRZ T2,1 ;MUST BE EVEN
MOVEM T2,.IBRMT+.IBSIZ(P1)
> ; end of repeat 0
;STILL MORE ICP CODE
CONN .IBDEV(P1) ;CONNECT
IMPERR ICPGE8
;[tcp] CONN .IBDEV+.IBSIZ(P1)
;[tcp] IMPERR ICPGE8
JRST Cpopj1## ;SKIP RETURN
repeat 0,< ;[tcp]
;VARIOUS ENTRIES FOR VARIOUS LEVELS OF ERROR RECOVERY
ICPGER: ERRIN ImpFil ;INPUT ERROR READING ICP FILE
ICPGE5: FRel ImpFil ;CLEAN UP ICP DEVICE
ICPGE6: CLOS 1,ICPBLK
JFCL
CLOS 1,ICPBLK
JFCL
ICPGE8: CLOS 1,.IBDEV+.IBSIZ(P1) ;CLOSE OUT OUTPUT THEN INPUT SIDE
JFCL
CLOS 1,.IBDEV+.IBSIZ(P1)
JFCL
> ;[tcp]
ICPGE8:
ICPGE9: CLOS 1,.IBDEV(P1) ;CLOSE OUT INPUT SIDE
JFCL
CLOS 1,.IBDEV(P1)
JFCL
SETZM IFile## ;JUST IN CASE
RETURN ;AND TAKE NON-SKIP RETURN
;SUBROUTINE TO MATCH EACH IMP IN THE SYSTEM WITH THE COMMAND
; SPECIFICATIONS. FOR EACH ONE THAT MATCHES, CALL THE ROUTINE
; WHOSE ADDRES WAS SPECIFIED IN A.
ALLIMP: SAVE A
;[tcp] TXZ F,ODDFLG
SETZB A,FRESKT ;LOWEST IMP NUMBER TO START
SETZM FRESKT+1 ;CLEAR SOCKET USE MAP
ALLIM1: SETZM .IBLCL+STTBLK
TXZ F,DUPLEX ;CLEAR DUPLEX CONNECTION FLAG
PUSH P,A ;SAVE CURRENT IMP NUMBER
ALLIM2: PUSHJ P,IMPSIX ;CONVERT TO SIXBIT NAME
MOVEM A,.IBDEV+STTBLK ;PHYSICAL NAME
STAT STTBLK ;GET STATUS
JRST ALLIM5 ;THIS ONE LOSES
CALL STATST ;TEST IT
JRST ALLIM3 ;NO MATCH
CALL @-1(P) ;CALL THE SUBROUTINE
JRST ALLIM3 ;NOW GO FOR NEXT
RESTORE A
JRST ALLIM6 ;EXIT ON SKIP RETURN FROM SUBROUTINE
ALLIM3: MOVE A,(P) ;GET BACK IMP NUMBER
;[tcp] TXCE F,ODDFLG ;COMPLEMENT ODD FLAG, WAS IT ON?
;[tcp] JRST ALLIM5 ;YES
;[tcp] SETOM .IBLCL+STTBLK ;NO, IT IS NOW
;[tcp] JRST ALLIM2
ALLIM5: POP P,A ;RESTORE IMP NUMBER
CAMGE A,IMPNUM ;COMPARE TO NUMBER OF IMPS IN SYSTEM
AOJA A,ALLIM1 ;GO DO SOME MORE
ALLIM6: RESTORE A
RETURN
;SET UP DEFAULTS
SETME: SETZM COMBLK ;CLEAR COMMAND BLOCK
MOVE T1,[COMBLK,,COMBLK+1]
BLT T1,COMBLK+.IBSIZ-1
HRRZ T1,JOBN ;JOB NUMBER
HRLM T1, .IBSTT+COMBLK
SETZM WAITCD## ;DEFAULT ON WAIT CODE
RETURN
STATST: Move T1,A ; position arg
MOVE T2,.IBLCL+STTBLK ;GET LOCAL SOCKET NUMBER
IDIVI T2,400 ;SEPARATE OUT USER-SPECIFIED PART
ROT T2,-1 ;PUT JOB SPECIFIER IN LH
HRRZ T4,PRJPRG ;GET OUR USER #
CAME T2,T4 ;IS IT ONE OF OUR SOCKETS?
JRST STATS0 ;NO
LSH T3,-2 ;YES, DIVIDE USER PART OF SOCKET BY 4
MOVN T2,T3 ;NEGATE
MOVSI T3,400000 ;BIT TO SET USE MAP WITH
SETZ T4, ;IT'S 64 BITS LONG (SINCE 256 SOCKETS)
LSHC T3,(T2) ;POSITION SOCKET BLOCK # BITS FROM LEFT
IORM T3,FRESKT ;MARK 4-WORD SOCKET BLOCK IN USE
IORM T4,FRESKT+1
STATS0: TXNE F,DEVFLG ;DEVICE SPECIFIED?
CAMN T1,.IBDEV+COMBLK ;YES, IS THIS THE ONE?
JRST STATS1 ;YES OR NOT NEEDED
MOVE T1,.IBDEV+STTBLK ;NO MATCH, TRY LOGICAL NAME
CAME T1,.IBDEV+COMBLK ;SAME?
POPJ P, ;NO, NO MATCH
STATS1:
;[tcp] MOVE T1,.IBLCL+STTBLK ;FETCH LOCAL SOCKET NUMBER
;[tcp] ANDI T1,1 ;REMEMBER SEX ONLY
;[tcp] XCT [TXNE F,OUTSWT ;IF INPUT SOCKET AND /OUTPUT
;[tcp] TXNE F,INPSWT](T1) ;OR OUTPUT SOCKET AND /INPUT
;[tcp] POPJ P, ; THEN NO MATCH
;[96bit]MOVE T1,.IBHST+STTBLK ;OK, GET BYTE SIZE,,HOST
;[96bit]XOR T1,.IBHST+COMBLK ;COMPARE TO SUPPLIED PARAMETERS
;[96bit]TRNN F,BYTFLG ;BYTE SIZE SPECIFIED?
;[96bit]TLZ T1,-1 ;NO, DON'T CHECK BYTE SIZE
;[96bit]TDNN F,[SITSWT+HSTFLG] ;HOST SPECIFIED?
;[96bit]TRZ T1,-1 ;NO, DON'T CHECK HOST
;[96bit]TLNE F,(SITSWT) ;ONLY SITE GIVEN?
;[96bit]TRZ T1,777700 ;YES, DON'T CARE WHICH HOST AT SITE
;[96bit]JUMPN T1,CPOPJ ;JUMP IF SUPPLIED PARAMETERS DON'T MATCH
TXNN F,<SITSWT!HSTFLG> ;[96bit] HOST SPECIFIED?
JRST Stats2 ;[96bit] no: don't check it.
MOVE T1,.IBHST+STTBLK ;[96bit] OK, GET HOST
XOR T1,.IBHST+COMBLK ;[96bit] COMPARE TO SUPPLIED PARAMETERS
TXNE F,SITSWT ;[96bit] ONLY SITE GIVEN?
TXZ T1,Ih.Hst ;[96bit] YES, mask out host number.
JUMPN T1,CPOPJ ;[96bit] JUMP if address doesn't match
Stats2:
;[tcp] TXNN F,BYTFLG ;[96bit] BYTE SIZE SPECIFIED?
;[tcp] JRST Stats3 ;[96bit] no: don't check
;[tcp] MOVE T1,.IbByt+SttBlk ;[96bit] get byte size
;[tcp] CAME T1,.IbByt+ComBlk ;[96bit] does it match?
;[tcp] POPJ P, ;[96bit] no: no match
Stats3: ;[96bit]
MOVE T1,.IBSTT+STTBLK ;GET JOB#,,STATE
XOR T1,.IBSTT+COMBLK ;COMPARE TO PARAMETERS SUPPLIED
TRZ T1,777700 ;MASK OUT JUNK
TXNN F,<SLFSWT!JOBFLG> ;/JOB:N OR /SELF? -- HVZ-4/23/75
TLZ T1,-1 ;NO, DON'T CHECK JOB
TXNN F,STTFLG ;STATE SPECIFIED?
TRZ T1,-1 ;NO, DON'T CHECK STATE
JUMPN T1,CPOPJ ;RETURN IF SUPPLIED PARAMETERS DON'T MATCH
;CONTINUATION OF PARAMETER CHECKING
MOVE T1,.IBRMT+STTBLK ;FETCH REMOTE SOCKET NUMBER
XOR T1,.IBRMT+COMBLK ;COMPARE TO USER PARAMETER
TXNE F,RMTFLG ;REMOTE SOCKET SPECIFIED?
JUMPN T1,CPOPJ ;YES, RETURN IF THEY DON'T MATCH
MOVE T1,.IBLCL+STTBLK ;FETCH LOCAL SOCKET NUMBER
MOVE T2,.IBLCL+COMBLK ;FETCH PARAMETER SUPPLIED BY USER
XOR T1,T2 ;COMPARE
CAIG T2,777 ;FULL SOCKET SPECIFIED?
ANDI T1,777 ;NO, IGNORE OWNER STUFF
TXNE F,USRFLG ;/USER?
TRZ T1,377 ;YES, DON'T CARE WHICH OF HIS SOCKETS
TXNE F,<USRFLG!LCLFLG> ;/LOCAL OR /USER?
JUMPN T1,CPOPJ ;YES, JUMP IF PARAMETERS DON'T MATCH
HLRZ T1,.IBSTT+STTBLK ;GET REAL OWNER OF IMP DEVICE
TXNN F,<ALLSWT!SLFSWT!DEVFLG!JOBFLG!USRFLG!RMTFLG> ;DO WE CARE?
CAMN T1,JOBN ;YES, SEE IF WE OWN IT
JRST Cpopj1## ;WE OWN IT OR DON'T CARE
POPJ P, ;NOT THIS ONE
;SUBROUTINE TO MANUFACTURE THE NAME SIXBIT\IMPN\ OUT OF THE NUMBER
; GIVEN IN A, AND RETURN IT IN A. Clobbers B.
IMPSIX: SETZ B, ;INIT RESULT
IMPSX1: LSHC A,-3 ;SHIFT OFF A DIGIT
LSH B,-3 ;SIXBITIZE IT
TXO B,<<'0'>B5>
JUMPN A,IMPSX1 ;BACK IF MORE DIGITS
HLRZ A,B ;PUT RESULT IN RH
HRLI A,'IMP' ;'IMP' IN LH
POPJ P,
;ROUTINE TO SEARCH FOR A GIVEN SIXBIT NAME IN A NAME TABLE, WITH ANY
;UNIQUE ABBREVIATIONS ALLOWED.
;ARGS: T1 SIXBIT NAME OR ABBREVIATION TO BE SEARCHED FOR
; T2 XWD -<LENGTH OF TABLE>,<ADR OF TABLE>
;THE NON-SKIP RETURN IS TAKEN IF THERE IS NO EXACT OR UNIQUE MATCH.
;T1 WILL BE ZERO IF THERE WAS NO MATCH, AND -1 IF THERE WAS
;AN AMBIGUOUS ABBREVIATION.
;THE SKIP RETURN IS TAKEN IF EITHER THE NAME EXACTLY MATCHES AN ENTRY IN THE
;TABLE OR THE ABBREVIATION MATCHES EXACTLY ONE ENTRY. THE INDEX OF THE
;MATCHING ENTRY (RELATIVE TO THE START OF THE TABLE) IS RETURNED IN T1.
;IF DUPLICATE ENTRIES APPEAR IN THE TABLE, they will be ambiguous
; Enter at SixSrA with argument in A. A is not disturbed.
;AC'S CLOBBERED: T1,T2,T3,T4
; (T3 returns argument)
;AC usage: T1 current offset into table (first entry is 1)
; (correct by decrementing when returning)
; T2 IOWD pointer to entry in table currently
; being considered.
; T3 entry we're looking for. (T1 parameter)
; T4 Sixbit of current entry. (for hacking upon)
; P1 Offset of partial match, or 0 if none yet,
; or -1 if ambiguous entries have been seen
; P2 mask for removing unwanted bits from a guess
SixSrA: Skipa T3,A ; entry to search for entry in A
SixSrc: Move T3,T1 ; save the entry
Call Save2## ; get a couple more ACs
Setzb T1,P1 ; clear offset count and partial match
; first, figure out the mask for the characters actually present.
Seto P2, ; start the Mask as all ones
SixSr1: Tdnn T3,P2 ; is this in free space yet?
Jrst SixSr2 ; yes: go scan the table
Lsh P2,-6 ; no: shift it down a character
Jrst SixSr1 ; and loop.
; now scan the table for the entry
SixSr2: aos T1 ; increment offset. (can't be zero)
Move T4,(T2) ; get the next table entry
Camn T4,T3 ; is this it?
Soja T1,Cpopj1## ; yes: complete success. return T1
Tdz T4,P2 ; no: clear chars that aren't there
Came T4,T3 ; better?
Jrst SixSr3 ; no: go loop
; partial match found.
Skipn P1 ; have we seen anything before?
Skipa P1,T1 ; no: save this one as partial match
Seto P1, ; yes: flag ambiguous entries seen
SixSr3: Aobjn T2,SixSr2 ; increment table entry and loop.
; table exhausted: see if there's anything intelligent
Skipg T1,P1 ; is there an offset?
popj p, ; no: error return, T1 set
Soja T1,Cpopj1## ; yes: found something. return happy,
; and make T1 real offset.
;SUBROUTINE TO TYPE THE TABLE POINTED TO BY T2.
TYPLST: HLLZ T1,T2 ;COPY COUNT, ZERO INDEX
HRLI T2,T1 ;PREPARE TO INDIRECT/INDEX
TYPLS0: TRNN T1,7 ;FINISHED A ROW?
W2CHI CRLF ;YES, START ANOTHER
WNAME @T2 ;TYPE AN ENTRY
WCHI TAB ;TAB
AOBJN T1,TYPLS0 ;LOOP IF MORE
WSIX [SIXBIT\##!\] ;ADVANCE
POPJ P,
;DATE ROUTINE
;OUTPUT DATE ONTO CURRENT OUTPUT FILE, IN FORM DD-MMM-YY.
;CALL AT ADATE: ARG IN ACCUMULATOR T1 (IN 12-BIT FORM ((Y-64)*12+M-1)*31+D-1).
;CALL AT TDATE: NO ARG - OUTPUT TODAY'S DATE.
;AC'S CLOBBERED: T1,T2
TDATE: DATE T1, ;GET TODAY'S DATE FROM MONITOR
W2CHI " " ;OUTPUT TWO SPACES
ADATE: IDIVI T1,↑D31 ;EXTRACT DAY-1
WDECI 2,1(T2) ;OUTPUT DAY IN 2-CHARACTER FIELD
IDIVI T1,↑D12 ;SEPARATE MONTH AND YEAR
CAIGE T2,6 ;WHICH HALF OF YEAR?
SKIPA T2,MONTAB(T2) ;FIRST HALF. USE LEFT HALF OF ENTRY
MOVS T2,MONTAB-6(T2) ;SECOND HALF. USE RIGHT HALF OF ENTRY
WCHI "-"
WSIX 3,T2 ;MONTH
WCHI "-"
WDECI 2,↑D64(T1) ;YESR
RETURN
MONTAB: SIXBIT /JANJUL/
SIXBIT /FEBAUG/
SIXBIT /MARSEP/
SIXBIT /APROCT/
SIXBIT /MAYNOV/
SIXBIT /JUNDEC/
;TIME ROUTINE
;OUTPUT TIME ONTO CURRENT OUTPUT FILE, IN FORM HH:MM:SS.
;CALL AT JTIME WITH ARG IN ACCUMULATOR T1 (JIFFIES SINCE MIDNIGHT).
;CALL AT TTIME TO OUTPUT PRESENT TIME.
;AC'S CLOBBERED: T1,T2
W2CHI " " ;OUTPUT TWO SPACES
JRST MTIME ;GO OUTPUT ARG AS MINUTES
TTIME: TIMER T1, ;GET PRESENT TIME (JIFFIES SINCE MIDNIGHT)
JTIME: IDIVI T1,↑D60 ;CONVERT JIFFIES TO SECONDS
MTIME: PUSH P,F ;SAVE PRESENT STATE OF FLAGS
TXO F,LZEFLG ;SET TO PRINT LEADING ZEROES
IDIVI T1,↑D3600 ;SEPARATE HOURS AND MINUTES
IDIVI T2,↑D60 ;GET OUT SECONDS
Disix [[SIXBIT\%:%:%!\] ;PRINT TIME
WDEC 2,T1
WDEC 2,T2
WDEC 2,T3]
FPOPJ: POP P,F ;RESTORE STATE OF FLAGS
RETURN
; file information. the FSETUP uuo moves this information to their
; lowseg locations, where they are used.
; ICP information
;[tcp] FILICP: FILE ICPCHN,I,ImpFil,<DEV(ICP),STATUS(6),EOF(ICPGER),INPUT(ICPGER)>
; telnet info
FILOTL: FILE OTLCHN,O,ImpFil,<DEV(TELNET),STATUS(2)>
; help file
FILHLP: FILE HLPCHN,I,HLPFIL,<DEV(HLP),NAME(IMPCOM),EXT(HLP)
,OPEN(HLPER1),LOOKUP(HLPER2),INPUT(HLPER3),EOF(HLPER3)>
;CONNECTION BLOCKS, FILE BLOCKS, INITIAL PARAMETERS
$low ;drp to LOWSEG to get our bearings
Fill: ;drp where we're going to put this data
$high ;drp back to HISEG to set up data
FillHi: ;drp this is where the data will really be
phase Fill ;drp but define symbols as if in the lowseg
;MACRO NET DEVICE,LOCAL,HOST,REMOTE,BYTESIZE
ICPBlk: NET ICP,,,,↑D32 ;ICP CONNECTION BLOCK
TelBlk:
TelIBk: NET TELNET,2,,,↑D8
TelOBk: NET TELNET,3,,,↑D8
;PHASED LOW-SEGMENT CODE TO THROW AWAY THE HIGH SEGMENT AND DO THE
; CROSSPATCH WAIT OPERATION.
ifn FtKSeg,< ;drp routine to kill hiseg when crosspatched
XPWait: PUSH P,F ;SAVE FLAGS
PUSH P,P1 ;SAVE POINTER TO TELNET CONNECTION BLOCK
push p,.JbSa ; save the start address
MOVEM P,SAVPDP ;SAVE P, SINCE AC'S ARE CLOBBERED BY GETSEG
MOVSI T1,1
SKIPN .JBDDT ;UNLESS DEBUGGING,
CORE T1, ; ELIMINATE HISEG
JFCL ;HUH??
;[96bit]HRLI P1,.IUXWT ;SETUP CROSSPATCH WAIT OPERATION CODE
HRLI P1,.IUXWT(If.New) ;[96bit] new format.
MCALL P1,LowUUO ;DO IT
INCHRW T2 ;DO IT THE OLD WAY IF IT FAILS
MOVEI T1,RUNDEV ;POINT TO GETSEG COMMAND LIST
SKIPE .JBDDT ;IF DEBUGGING,
JRST .+3 ; DON'T DO TI
GETSEG T1, ;GET BACK IMPCOM HISEG
HALT ;LET THE MONITOR SAY WHAT HAPPENED
MOVE P,SAVPDP ;RESTORE P
pop p,.JbSa ; restore the start address
POP P,P1 ;RESTORE P1
POP P,F ;RESTORE FLAGS
POPJ P, ;RETURN
; lowseg copy of sixbit ImpUUO, so we have one when no highseg
LowUUO: SixBit \ImpUUO\
;GETSEG COMMAND LIST (MODIFIED DURING INITIALIZATION)
RUNDEV:!SIXBIT /SYS/
SIXBIT /IMPCOM/
0
0
RUNPPN:!0
0
> ;drp end of ifn FtKSeg
FilEnd==.-1 ;drp get last word's location
FilLen==.-Fill ;drp get the length of the area
DEPHASE
$low ;drp now to the LOWSEG to define area
block FilLen ;drp allocate the space for data.
$high ;drp back to HISEG and normalacy
ife FtKSeg,< ;drp normal hiseg method for going into IW
XPWait: hrrz t1,p1 ;drp get pointer to block
HRLI t1,.IUXWT(If.New) ;drp wait for end of xpatch
MCALL t1,IMPUUO## ;drp DO IT
INCHRW T2 ;drp DO IT THE OLD WAY IF IT FAILS
popj p, ;drp and return
> ;drp end of ife FtKSeg
;AUXILIARY ROUTINES
;[96bit] routine to convert T1 from old format to new format.
HstCon: CAIL T1,↑D256 ;[96bit] larger than old format?
RETURN ;[96bit] yep: must be new alreay
LDB T2,[Point 2,T1,35-6] ;[96bit] host number
LSH T2,↑D16 ;[96bit] shift
LDB T1,[Point 6,T1,35] ;[96bit] get imp number
IOR T1,T2 ;[96bit] mash them together
RETURN ;[96bit] all converted
;IMP STATES -- ONE WORD PER STATE
STATES: SIXBIT \CLOSED\
SIXBIT \LISTEN\
sixbit \SYNSnt\
sixbit \SYNRP\
sixbit \SYNRA\
sixbit \Establ\
sixbit \FIN1\
sixbit \FIN2\
sixbit \Clsing\
sixbit \TimWat\
sixbit \ClsWat\
sixbit \LstAck\
NSTATE==:STATES-.
SUBTTL COMMAND SCANNER
TblBeg RdCmd ; productions to read the command line.
;ENTER HERE TO GET THE COMMAND
COMND: PROD( <SG> ,CALL, ,TEXT )
PROD( <SG> ,ICHK, ,COMNM )
;ENTER HERE TO GET THE COMMAND AFTER PROMPTING WITH '*'
COMNM: PROD( <SG> ,CALL, ,TEXT )
COMNM1: PROD( <BLANK> , ,*,COMNM1 )
PROD( SEMI ,CALL, ,FLUSHX )
PROD( -<BREAK> , ,←,COMNM2 )
COMNM2: PROD( <SG> ,RET , , )
;ENTER HERE TO GET A PARAMETER FIELD WITHOUT REGARD TO SWITCHES,
; DEVICE SPECIFIERS, ETC.
LABEL: PROD( <SG> ,CALL, ,TEXT )
LABEL1: PROD( <BLANK> , ,*,LABEL1 )
PROD( SEMI ,CALL, ,FLUSHX )
LABEL2: PROD( -<BLANK!DELIM!BREAK> , ,←,LABEL3 )
LABEL3: PROD( <SG> ,RET , , )
;ENTER HERE TO GET THE ENTIRE COMMAND
LIST: PROD( <SG> ,CALL, ,FIELD0 )
PROD( <DELIM> , ,*,LIST )
PROD( -<BREAK> ,ECMD, , )
PROD( <SG> ,RET , , )
;ENTER HERE TO GET THE NEXT FIELD
FIELD: PROD( <BLANK> , ,*,FIELD )
PROD( -<BREAK!DELIM> ,CALL, ,FIELD0 )
PROD( <BREAK!DELIM> ,RET , , )
PROD( <SG> ,ECMD, , )
;SUBROUTINE TO GET A PARAMETER FIELD
FIELD0: PROD( <SG> ,FINI, ,FIELD1 )
FIELD1: PROD( <BLANK> , ,*,FIELD1 )
PROD( LPAREN , ,*,LPARN )
PROD( "/" , ,*,SLASH )
PROD( <DELIM!BREAK> ,RET , , )
PROD( <SG> ,CALL, ,TEXT )
PROD( ":" ,DSAV,*,FIELD1 )
PROD( <EQUALS> ,ECMD, , )
PROD( <SG> ,SHST, ,FIELD1 )
;HERE TO HANDLE SLASH (SWITCH)
SLASH: PROD( <SG> ,CALL, ,SWITCH )
PROD( <SG> , , ,FIELD1 )
;HERE TO HANDLE LEFT PARENTHESES (SWITCHES)
LPARN: PROD( <BLANK> , ,*,LPARN )
PROD( RPAREN , ,*,FIELD1 )
PROD( <SG> ,CALL, ,SWITCH )
PROD( <DELIM> , ,*,LPARN )
PROD( -<BREAK> , , ,LPARN )
PROD( <SG> ,Ret , , )
;SUBROUTINE TO PROCESS A SWITCH
SWITCH: PROD( <SG> ,CALL, ,TEXT1 )
PROD( -<EQUALS> ,SSWT, ,SWIT2 )
PROD( <SG> ,PSAV,*,SWIT1 )
SWIT1: PROD( <SG> ,CALL, ,NAME )
PROD( <SG> ,PVAL, ,SWIT2 )
SWIT2: PROD( <BLANK> , ,*,SWIT2 )
PROD( <SG> ,RET , , )
;SUBROUTINE TO GET A TEXT OR NUMBER FIELD
NAME: PROD( <SG> ,NINI, ,NAME1 )
NAME1: PROD( <BLANK> , ,*,NAME1 )
NAME2: PROD( <DELIM!BREAK> ,RET , , )
PROD( <LETTER> , , ,TEXT1 )
PROD( <SG> , , ,NUMB2 )
;SUBROUTINE TO GET A TEXT FIELD
TEXT: PROD( <BLANK> , ,*,TEXT )
TEXT1: PROD( <SG> ,TINI, ,TEXT2 )
TEXT2: PROD( "#" ,OINI,*,TEXT3 ) ;[96bit] to octal
TEXT3: PROD( <LETTER!DIGIT> ,TPAK,*,TEXT3 )
PROD( "-" ,TPAK,*,TEXT3 ) ;[96bit] or -?
PROD( "." , ,*,HNUMB ) ;[96bit] #.#?
PROD( <SG> , , ,NUMB3 )
;[96bit] subroutine to complete parsing a host number: "#.#.#"
HNUMB: PROD( <SG> ,CALL, ,NUMB ) ;[96bit] get number
PROD( "." ,HNPK,*,HNUMB ) ;[96bit] put in place
PROD( <SG> ,HNPK, ,NUMB3 ) ;[96bit] put in place
;SUBROUTINE TO GET A DECIMAL NUMBER
NUMB: PROD( <SG> ,NINI, ,NUMB1 )
NUMB1: PROD( <BLANK> , ,*,NUMB1 )
NUMB2: PROD( "#" ,OINI,*,NUMB2 )
PROD( <DIGIT> ,DPAK,*,NUMB2 )
NUMB3: PROD( <BLANK> , ,*,NUMB3 )
PROD( -SEMI ,RET , , )
FLUSHX: PROD( -<BREAK> , ,*,FLUSHX )
PROD( <SG> ,RET , , )
;SUBROUTINE TO GET ARGUMENTS FOR THE ERROR COMMAND
ERRAR0: PROD( <SG> ,CALL,*,SWITCH )
ERRARG: PROD( <BLANK> , ,*,ERRARG )
PROD( SEMI ,CALL, ,FLUSHX )
PROD( <BREAK> ,RET , , )
PROD( "/" , , ,ERRAR0 )
PROD( COMMA , ,*,ERRARG )
PROD( <SG> ,CALL, ,TEXT )
PROD( <SG> ,ESRC, ,ERRARG )
TblEnd ; end of RdCmd
SUBTTL STORAGE
$Low ; to low seg
ZERO==. ;CLEAR FROM HERE
RADIX: BLOCK 1 ;CURRENT TYPEIN RADIX
HstAdr: BLOCK 1 ;POSSIBLE HOST NUMBER DURING TEXT INPUT
COMBLK: BLOCK .IBSIZ ;FOR SAVING PARAMETERS ON COMMAND INPUT
STTBLK: BLOCK .IBSIZ ;FOR TAKING STATUS OF CONNECTION
PPARAM: BLOCK 1 ;FOR HOLDING PARAMETER POINTER DURING SPECS
CONFLG: BLOCK 1 ;FLAGS A CONTROL CHARACTER TO TELNET
PRJPRG: BLOCK 1 ;PROJECT,PROGRAMMER NUMBER
JOBN: BLOCK 1 ;JOB NUMBER
ChrCnt: Block 1 ; count of characters output on this line
ESCBLK: BLOCK 4 ;PARAMETERS FOR ESCAPES AND QUOTES
IMPNUM: block 1 ;NUMBER OF IMPS IN SYSTEM
HSTBLK: BLOCK .IBHST ;PARAMETER BLOCK FOR LHOST UUO
THSITE: BLOCK 1 ;LOCAL SITE PARAMETERS (PART OF HSTBLK BLOCK)
THSHST: BLOCK BufWds ;LOCAL HOST NAME IN SIXBIT
LstHst==.-1 ; last word of the host buffer
AscBuf: Block BufWds ; block for ascii text of command field,
; in case it is a host name
AscEnd==.-1 ; last word of block
SYSVER: BLOCK 1 ;IMP SYSTEM VERSIONS (IMPSER,,NETCON)
XSTBLK: BLOCK .XSSIZ ;BLOCK FOR READING EXTENDED STATUS
FRESKT: BLOCK 2 ;LOACL SOCKET NUMBER USE MAP
WATIVL: BLOCK 1 ;WAIT INTERVAL FOR ERROR STATISTICS
LASTIM: BLOCK 1 ;TIME-OF-DAY OF MOST RECENT REPORT
GTTOLD: BLOCK 1 ;POINTER TO OLD STATISTICS TABLE
ErBits: Block 1 ; place to build up the bits for ERROR cmd.
XNMSAV: BLOCK 1 ;REMEMBERS GETTAB SUBTABLE POINTER FOR %ISXNM
ALLBTS: BLOCK 1 ;# OF BITS TO ALLOCATE ON TELNET COMMAND
ifn FtKSeg,< ;drp needed if we do getsegs
SAVPDP: BLOCK 1 ;SAVES P OVER GETSEGS
> ;drp end of FtKSeg
PDL: BLOCK PDLEN
ZEREND==.-1 ;CLEAR TO HERE
; file blocks for hiseg blocks FilIcp, FilOTL, and FilHlp
ImpFil: BLOCK FBSIZE ; block used for ICP and TelNet control
HLPFIL: BLOCK FBSIZE ;FILE BLOCK FOR READING HELP MESSAGES
$High ; back to high seg for literals
END