Trailing-Edge
-
PDP-10 Archives
-
BB-M780B-SM
-
monitor-sources/netwrk.mac
There are 6 other files named netwrk.mac in the archive. Click here to see a list.
; UPD ID= 42, FARK:<5-WORKING-SOURCES.MONITOR>NETWRK.MAC.2, 11-May-82 16:00:25 by ZIMA
;Edit 2618 - Fix extra nulls from GTHST JSYS.
; UPD ID= 518, SNARK:<5.MONITOR>NETWRK.MAC.17, 7-Mar-82 00:55:28 by PAETZOLD
;More TCO 5.1750 - Fix bad test in NETRAL/NETRAX
; UPD ID= 511, SNARK:<5.MONITOR>NETWRK.MAC.16, 6-Mar-82 21:12:37 by PAETZOLD
;More TCO 5.1750 - Remove NCPON and NCPOFF. They are in IMPPAR now
; UPD ID= 506, SNARK:<5.MONITOR>NETWRK.MAC.15, 6-Mar-82 20:51:58 by PAETZOLD
;TCO 5.1750 - Reflect that IMPALL unlocks NCPLCK in NETRAL/NETRAX
; UPD ID= 499, SNARK:<5.MONITOR>NETWRK.MAC.14, 5-Mar-82 01:53:44 by PAETZOLD
;TCO 5.1746 - Fix literal in RLNTBF for NETRBG
; UPD ID= 487, SNARK:<5.MONITOR>NETWRK.MAC.13, 25-Feb-82 20:51:26 by PAETZOLD
;More TCO 5.1739 - Fix bizarre wording in previous edit history
; UPD ID= 486, SNARK:<5.MONITOR>NETWRK.MAC.12, 25-Feb-82 17:00:11 by PAETZOLD
;TCO 5.1739 - Dont set ANBSEC for NETFRE in ASNTBF if it is last buffer
; on the NETFRE chain. This prevents NETBAUs.
; UPD ID= 126, SNARK:<5.MONITOR>NETWRK.MAC.11, 27-Aug-81 20:15:32 by PAETZOLD
;change TCO 5.1010X to 5.1473
; UPD ID= 116, SNARK:<5.MONITOR>NETWRK.MAC.10, 23-Aug-81 13:31:10 by PAETZOLD
;TCO 5.1010X - STORE PC OF CALLER TO LCKNCP IN NCPLPC
; UPD ID= 79, SNARK:<5.MONITOR>NETWRK.MAC.9, 27-Jul-81 09:09:51 by PAETZOLD
;UPDATE COPYRIGHT NOTICE
; UPD ID= 1989, SNARK:<5.MONITOR>NETWRK.MAC.8, 14-May-81 11:22:17 by PAETZOLD
;TCO 5.1321 MAKE ARPANET WORK IN RELEASE 5
;MOVE LINKF DEFINITION TO RIGHT HALF OF NETSTS
;ADD IMPBLK BUGCHK
;CHANGE ORDER OF SEARCHS OF UNV FILES
;CHANGE FLINK TO FNLINK TO AVOID CONFUSION WITH ICCS
;CHANGE NVTDET REFERENCE TO NVTDTT SO WE RETURN
; UPD ID= 1883, SNARK:<5.MONITOR>NETWRK.MAC.7, 24-Apr-81 10:48:29 by LYONS
;fix bug - tips lose network connection
; UPD ID= 967, SNARK:<5.MONITOR>NETWRK.MAC.6, 25-Aug-80 16:28:38 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 725, SNARK:<5.MONITOR>NETWRK.MAC.5, 2-Jul-80 12:08:48 by LYONS
;Remove NETIEF bughlt as it was possible to get to quite easily
; UPD ID= 724, SNARK:<5.MONITOR>NETWRK.MAC.4, 2-Jul-80 11:55:21 by LYONS
;Fix possible RELRNG buglhts
; UPD ID= 505, SNARK:<5.MONITOR>NETWRK.MAC.3, 4-May-80 00:12:59 by LYONS
; UPD ID= 452, SNARK:<5.MONITOR>NETWRK.MAC.2, 21-Apr-80 16:30:40 by LYONS
;ADD CALL TO ACJ FOR NETWORK LINK OPEN
; UPD ID= 186, SNARK:<4.MONITOR>NETWRK.MAC.55, 4-Jan-80 09:15:18 by R.ACE
;UPDATE COPYRIGHT DATE
;MAKE RLNTBF PRESERVE T1
; UPD ID= 73, SNARK:<4.MONITOR>NETWRK.MAC.54, 30-Nov-79 13:50:27 by ZIMA
;TCO 4.2585 - Make NETRBG into a BUGCHK.
;<4.MONITOR>NETWRK.MAC.53, 8-Oct-79 12:27:33, Edit by LCAMPBELL
; Proper case in HSTINI error messages
;<OSMAN.MON>NETWRK.MAC.1, 10-Sep-79 15:46:03, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>NETWRK.MAC.51, 29-May-79 17:27:39, Edit by LCAMPBELL
; Don't return error code in 1 for CVHST
;<4.MONITOR>NETWRK.MAC.14, 13-Apr-79 20:52:09, EDIT BY JBORCHEK
;FIX BYTE POINTER SETUP IN DMPBUF
;<4.MONITOR>NETWRK.MAC.41, 11-Jan-79 23:13:47, EDIT BY ZIMA
;FIX SPELLING IN BUG MESSAGE
;<4.MONITOR>NETWRK.MAC.40, 9-Jan-79 13:55:11, Edit by LCAMPBELL
; Update copyright notice
;<4.MONITOR>NETWRK.MAC.39, 21-Dec-78 11:22:51, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.38, 13-Dec-78 17:32:59, Edit by LCAMPBELL
; Remove redundant error mnemonics
;<BBN-3A-MONITOR>NETWRK.MAC.10006, 17-Nov-78 19:12:31, EDIT BY JBORCHEK
;ADD HOST TYPES FOR TOPS-20 AND UNIX
;<JBORCHEK>NETWRK.MAC.1, 16-Nov-78 18:26:43, EDIT BY JBORCHEK
;GTHST NOW TAKES JFNS
;<4.MONITOR>NETWRK.MAC.34, 6-Nov-78 16:26:44, EDIT BY JBORCHEK
;GTNCP WILL NOW TAKE .CTTRM AS NVT
;<BBN-3A-MONITOR>NETWRK.MAC.206, 26-Oct-78 19:03:32, EDIT BY JBORCHEK
;CHANGES TO LHOSTN
;<BBN-3A-MONITOR>NETWRK.MAC.202, 2-Oct-78 05:18:36, EDIT BY JBORCHEK
;HSTCHK DID NOT RETURN ERROR CODE ALL THE TIME
;<BBN-3A-MONITOR>NETWRK.MAC.201, 23-Sep-78 18:06:41, EDIT BY JBORCHEK
;SAVE THE EVENT AND OLD STATE AT DOFSM
;CLEAR HOST TABLES COMPLETELY AT HSTINI
;<4.MONITOR>NETWRK.MAC.23, 2-Sep-78 17:45:32, EDIT BY JBORCHEK
;<4.MONITOR>NETWRK.MAC.3, 1-Sep-78 18:43:19, EDIT BY JBORCHEK
;FIX MORE BUGS IN IMPHRT AND HSTSTS
;<4.MONITOR>NETWRK.MAC.21, 1-Sep-78 15:09:50, EDIT BY JBORCHEK
;FIX BUGS IN IMPHRT AND HSTSTS SIMULATIONS
;<4.MONITOR>NETWRK.MAC.20, 1-Sep-78 13:03:47, EDIT BY JBORCHEK
;LOAD JFN INTO T1 BEFORE RLJFN AT HSTINI
;<4.MONITOR>NETWRK.MAC.19, 1-Sep-78 10:45:51, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.18, 30-Aug-78 14:14:21, Edit by LCAMPBELL
; Change ERCALs to CALLs after GTHST and GTNCP, and make
; GDSTS return old-style host number
;<4.MONITOR>NETWRK.MAC.17, 29-Aug-78 14:37:55, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.16, 28-Aug-78 19:21:48, Edit by LCAMPBELL
; Simulate IMPHRT and HSTSTS GETABs so old utilites still work
;<4.MONITOR>NETWRK.MAC.15, 26-Aug-78 21:23:47, EDIT BY JBORCHEK
;ANFHS MUST BE 36 BITS WIDE
;<3A-JBORCHEK>NETWRK.MAC.3, 24-Aug-78 19:55:30, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.21, 21-Aug-78 13:20:07, EDIT BY JBORCHEK
;FIX BUGS IN GTHST
;<3-CLEMENTS>NETWRK.MAC.20, 19-Aug-78 00:53:34, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.16, 18-Aug-78 18:44:25, EDIT BY JBORCHEK
;ADD NEW GTHST FUNCTIONS
;<3-CLEMENTS>NETWRK.MAC.12, 16-Aug-78 16:18:01, EDIT BY CLEMENTS
; Add STHSTJ routine
;<3-CLEMENTS>NETWRK.MAC.11, 16-Aug-78 15:54:21, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.10, 16-Aug-78 15:38:20, EDIT BY CLEMENTS
; Make MAXBPM and MAXWPM back into constants, from literals
;<JBORCHEK>NETWRK.MAC.2, 16-Aug-78 13:38:23, EDIT BY JBORCHEK
;<4-JBORCHEK>NETWRK.MAC.2, 14-Aug-78 12:54:05, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.6, 11-Aug-78 23:44:53, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.5, 11-Aug-78 22:56:41, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.4, 11-Aug-78 16:20:42, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.3, 11-Aug-78 16:18:45, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.2, 11-Aug-78 15:09:27, EDIT BY CLEMENTS
; Remove use of local IMPLT bit
;<4.MONITOR>NETWRK.MAC.10, 7-Jul-78 01:15:43, Edit by JBORCHEK
;ADD GTNCP JSYS
;<4.MONITOR>NETWRK.NEW.7, 6-Jul-78 08:01:14, Edit by JBORCHEK
;ADD GTHST JSYS
;<4.MONITOR>NETWRK.MAC.3, 26-Jun-78 16:43:46, Edit by JBORCHEK
;<4.MONITOR>NETWRK.MAC.1, 26-Jun-78 02:48:39, Edit by JBORCHEK
;ADD HASH LOOKUP OF HOSTS
;<4.MONITOR>NETWRK.NEW.11, 18-Jun-78 14:54:55, Edit by JBORCHEK
;MORE NEW HOST STUFF
;<4.MONITOR>NETWRK.MAC.8, 9-Jun-78 23:01:08, Edit by JBORCHEK
;USE IMPPAR DEFINITIONS
;<4.MONITOR>NETWRK.MAC.2, 6-Jun-78 01:32:06, Edit by JBORCHEK
;ADD SEARCH OF IMPPAR
;<3A.MONITOR>NETWRK.MAC.6, 28-May-78 01:48:11, Edit by BORCHEK
;REMOVE OPENING NET IN 7 BIT MODE
;<3A-MONITOR>NETWRK.MAC.4, 22-Apr-78 20:37:51, Edit by BORCHEK
;SPEED UP NETWORK FTP
;<HACKS>NETWRK.MAC.8, 2-Apr-78 02:27:39, EDIT BY JBORCHEK
;USE AN ADJBP AT DMPBUF
;<3A.MONITOR>NETWRK.MAC.2, 19-Mar-78 13:07:41, Edit by BORCHEK
;GET DIR # FROM JSBSDN IN NETVER
;ONLY 8, 32, 36 BIT CONNECTIONS ALLOWED
;<4.MONITOR>NETWRK.MAC.2, 29-Jan-78 16:59:49, Edit by BORCHEK
;FIX DIR NET:<*> FROM HANGING JOB. CHECK AT NETSET FOR <*>
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979,1980,1981 Digital Equipment Corporation
; Maynard, Mass.
SEARCH IMPPAR,PROLOG,MACSYM,MONSYM
TTITLE NETWRK
; Local accumulators
DEFAC (UNIT,Q1) ;PSEUDO-UNIT NUMBER
DEFAC (IOS,Q2) ;STATUS FLAGS (FROM NETSTS(UNIT))
DEFAC (HN,Q3)
DEFAC (STS,P1)
DEFAC (JFN,P2)
DEFAC (PTR,P3)
DEFAC (DEV,P4)
DEFAC (F1,P5)
;PARAMETERS
NLNKBW==<LLINK+^D35>/^D36 ;LENGTH OF LINK BITTABLE
; NCP DATA CLUSTER
DEFSTR ANFHS,NETHST,35,36 ;FOREIGN HOST
DEFSTR ANLNK,NETAWD,8,9 ;LINK
DEFSTR ANCLKS,NETAWD,23,6 ;TIME-OUT COUNTDOWN
DEFSTR ANINPI,NETFRK,5,6 ;INS/INR PSI CHAN
DEFSTR ANFSPI,NETFRK,17,6 ;FSM PSI CHAN
DEFSTR ANFSM,NETSTS,3,4 ;FSM STATE
DEFSTR ANBSIZ,NETSTS,17,6 ;BIT STREAM BYTE SIZE
DEFSTR ANPVST,NETSTS,35,16 ;PREVIOUS 4 STATES
DEFSTR HSTIDX,HOSTN,35,18 ;INDEX TO STATUS TABLE
DEFSTR HSTNMP,HOSTN,17,16 ;POINTER TO NAME STRING
MSGALL==2 ;DESIRED MESSAGE ALLOCATION LEVEL
;FLAGS IN LH OF NETSTS
FLG(BFSND,L,IOS,020000) ;BUFFERED SEND MODE
FLG(ERRB,L,IOS,010000) ;ERROR HAS OCCURRED
FLG(EOTF,L,IOS,004000) ;END OF TRANSMISSION FLAG
FLG(SVCIF,L,IOS,002000) ;SERVICE INTERRUPTION IN PROGRESS
FLG(CLZF,L,IOS,001000) ;CONNECTION IS BEING CLOSED
FLG(DEDF,L,IOS,000400) ;HOST IS DEAD
FLG(PROGF,L,IOS,000200) ;SET IF PROGRAM IS WATCHING THIS CONNECTION
FLG(ALLFF,L,IOS,000100) ;ALLOCATION RESYNC HAS BEEN DONE
;FLAGS IN RIGHT HALF OF NETSTS
FLG(LINKF,R,IOS,400000) ;LINK TABLE INDEX VALID FLAG
;ONLY FREE BIT LEFT IN NETSTS IS B19
; Bbn socket numbers description
; A socket number is a 32-bit number which in conjunction with
; A host number specifies one end of a connection
; For bbn sockets, the 32 bit field is divided in 3 parts:
; The high 17 bits is used as follows:
; if 0: then this is a system socket
; if <100000 then the number is a bbn user number and the socket is
; is called a user socket
; if >99999 then the number is tss job-number plus 100000, and the
; socket is called a job socket
; A job socket is analogous to a temporary file and is guaranteed to
; Be unique to that job. a user socket is analogous to a regular file
; And is guaranteed to be unique to that user. a system socket is
; For use as agreed upon by members of the network for such purposes
; As inter system communication, memo-distribution etc.
; The next 14 bits are an arbitrary number which may be defaulted
; To the jfn associated with the socket or specified by the name field
; Of the file name string. the low order bit is determined by
; The gender of the socket. a socket opened for for writing
; Will have this bit equal to one. a socket opened for reading will
; Have this bit equal to zero.
; Network dispatch table
SWAPCD
NETDTB::DTBDSP (NETSET) ;DIRECTORY SETUP
DTBDSP (NETNAM) ;NAME LOOKUP
DTBDSP (NETEXT) ;EXTENSION LOOKUP
DTBDSP (NETVER) ;VERSION LOOKUP
DTBBAD (DESX9) ;PROTECTION INSERT
DTBBAD (DESX9) ;ACCOUNT INSERT
DTBBAD (DESX9) ;STATUS INSERT
DTBDSP (NETOPN) ;OPEN
DTBDSP (NETSQI) ;BYTE INPUT
DTBDSP (NETSQO) ;BYTE OUTPUT
DTBDSP (NETCLZ) ;CLOSE
DTBBAD (DESX9) ;RENAME
DTBBAD (DESX9) ;DELETE
DTBBAD (DESX9) ;DUMP
DTBBAD (DESX9)
DTBBAD (DESX9) ;MOUNT
DTBBAD (DESX9) ;DISMOUNT
DTBBAD (DESX9) ;INITIALIZE
DTBDSP (NETMTP) ;MTOPR
DTBDSP (NETGST) ;GET STATUS
DTBDSP (NETSST) ;SET STATUS
DTBSKP ;RECORD OUT
DTBDSP (RFTADN) ;READ TAD
DTBDSP (SFTADN) ;SET TAD
DTBDSP (BIOINP) ;SET JFN FOR INPUT
DTBDSP (BIOOUT) ;SET JFN FOR OUTPUT
DTBBAD (GJFX49) ;CHECK ATTRIBUTE
DTBLEN==:.-NETDTB ;GLOBAL LENGTH OF DISPATCH TABLE
; Network lock and unlock
LCKNCP::AOS NCPLCN ; COUNT CALLS TO THIS ROUTINE
NOINT
LOCK NCPLCK,<JRST LCKNC1>
LCKNC2: ; HERE WHEN WE GOT THE LOCK
PUSH P,T1 ; SAVE AN AC
MOVE T1,FORKX ; GET OUR FORK NUMBER
MOVEM T1,NCPLLK ; SAVE THE FORK NUMBER
MOVE T1,-1(P) ; GET OUT RETURN PC
MOVEM T1,NCPLPC ; SAVE THE PC OF THE LAST LOCKER
POP P,T1 ; RESTORE THE SAVED AC
RET ; RETURN TO CALLER
LCKNC1: AOS NCPLFC ; COUNT FAILURES
PUSH P,T1
MOVEI T1,NCPLKT
MDISMS
POP P,T1
JRST LCKNC2
RESCD
NCPLKT: AOSE NCPLCK
JRST 0(T4)
JRST 1(T4)
SWAPCD
ULKNCP::UNLOCK NCPLCK
OKINT
RET
; Initialize network stuff
NETINI::SE1CAL ;ENTER SECTION 1 FOR THIS ROUTINE
SETZM NETSTS
MOVE T1,[NETSTS,,NETSTS+1]
BLT T1,NETSTS+NSKT-1
SETZM NETCNC
SETZM FUNNYC
MOVE T1,[ANBSEC,,NTBUFS]
MOVEM T1,NETFRE ;INITIAL FREE LIST
MOVEI T2,NNTBFS ; SIZE OF BUFFER AREA
IDIV T2,MAXWPM ;IN CASE NOT AN EVEN MULTIPLE
IMUL T2,MAXWPM ; ..
MOVEM T2,NETFRE+2 ;FREE SPACE LEFT IN BUFFER AREA
MOVEM T1,NETFRE+3 ;START OF BUFFER AREA
ADDI T1,-1(T2) ;END OF BUFFER AREA
MOVEM T1,NETFRE+4
;INITIALIZE FREE LIST INTO ITEMS OF MAXWPM EACH
MOVEI T2,NNTBFS ;SIZE OF BUFFER REGION
IDIV T2,MAXWPM ;NUMBER OF BUFFERS IN REGION
MOVE T3,[ANBSEC,,NTBUFS] ;SET UP C TO POINT TO NET BUFFERS
NETIN2: MOVE T1,T3 ;COPY C INTO A
ADD T3,MAXWPM ;RH(T3) POINTS TO NEXT BUFFER
HRLOM T3,0(T1) ;STORE THAT IN LEFT HALF IN CURRENT BUFFER
SOJG T2,NETIN2 ;DO ANOTHER
HRRZS 0(T1) ;LAST ITEM POINTER IS 0
SETOM NETFRE+1 ;NETWORK BUFFER LOCK
SETOM NCPLCK
MOVE T1,DBUGSW ;IN SYSTEM DEBUG MODE?
CAIGE T1,2 ;IF SO, DON'T TURN ON NET.
SETOM NETON ;NET ON
MOVE T1,MAXWPM ;GET SIZE OF EACH BUFFER
IMULI T1,^D16 ;TIMES RESERVE
MOVEM T1,ASNTHR ;SETS BUFFER SPACE LOW THRESHOLD
RET
; Prepare to lookup network names
NETSET: TQNE <STEPF> ;WANT TO STEP?
RETBAD (GJFX17) ;YES. CAN'T DO IT
NOINT ;PREVENT INTS
JRST SK2RET ;AND SAY IT IS SET
; Name lookup routine
NETNAM: JUMPE T1,NAMBAD ; *. -- failure
HRLI T1,(<POINT 7,0,35>); Make lookup pointer into byte pointer
CALL NAMDEC ; Decode name
JRST NAMBAD ; Bad syntax
OKRET: TQNE <UNLKF>
JRST SK2RET
OKINT
JRST SK2RET
NAMBAD: MOVEI T1,GJFX18
JRST ERRET ; Error return
ERRET: OKINT
RET
; Extension lookup routine
NETEXT: JUMPE T1,NAMBAD ; .* -- failure
HRLI T1,(<POINT 7,0,35>); Make lookup pointer into byte pointer
CALL EXTDEC ; Decode extension to check syntax
JRST EXTBAD ; Bad syntax
JRST OKRET ; Success
EXTBAD: MOVEI T1,GJFX19
JRST ERRET
; Version lookup
NETVER: HRRES T1 ; Extend sign
CAIL T1,^D100000 ; If geq 100000
JRST NETVR1 ; Use job related socket
HLLZ T1,JSBSDN ; Get structure
LSH T1,-6
ADD T1,JSBSDN ; Add in directory
ANDI T1,177777 ; Clear junk
NETVR1: TQNE <UNLKF>
RETSKP
OKINT
RETSKP
; Decode extension string
; Called both at gtjfn and openf to decode extension string into
; Foreign socket number and host number
EXTDEC: MOVE T4,T1
ILDB T4,T4
JUMPE T4,[SETOB T1,T2
RETSKP]
MOVE T3,T1 ;GET SCRATCH POINTER
SETZ T4, ;ASSUME NO - FOUND
EXTDE1: ILDB T2,T3 ;GET A BYTE
CAIN T2,"-" ;SAVE LAST - FOUND
MOVE T4,T3
JUMPN T2,EXTDE1 ;DO WHOLE STRING
JUMPE T4,R ;NO - MEANS ERROR
DPB T2,T4 ;END HOST WITH NUL
CALL HSTLUK ;LOOKUP HOST
MOVEI T3,"-" ;RESTORE THE -
DPB T3,T1
JUMPG T2,R ;NO HOST FOUND
MOVEI T3,10 ;GET OCTAL SOCKET NUMBER
NIN
RET
MOVE T1,T4
RETSKP
HSTLUK: SAVEQ ;GET SOME ROOM
MOVE UNIT,T1 ;SAVE POINTER
MOVEI T3,10
NIN ;TRY TO GET A NUMBER
JRST HSTLKI ;TRY A NAME
MOVE UNIT,T1 ;SAVE UPDATED POINTER
MOVE T1,T2
CALL CVNHST
MOVE T4,T1 ;RETURN HOST NUMBER
MOVE T1,UNIT ;AND UPDATED POINTER
SETZ T2, ;HOST NUMBER FOUND
RET
HSTLKI: HRLZ T2,MHOSTS ;SCAN THE TABLE
HSTLK0: MOVE T1,UNIT ;DO NAME POINTER
LOAD T3,HSTNMP,(T2)
ADD T3,[POINT 7,HSTNAM]
HSTCMP: ILDB IOS,T1 ;COMPARE A STRING
ILDB HN,T3
SKIPN IOS
JUMPE HN,[LOAD T4,HSTIDX,(T2)
MOVE T4,HOSTNN(T4)
RET]
CAIN IOS,(HN)
JRST HSTCMP
AOBJN T2,HSTLK0 ;STEP TO NEXT HOST
SETZ T4, ;NO HOST FOUND
RET
RESCD
HSTHSH::MOVE T2,T1 ;DO A HASH
IDIVI T2,NHOSTS ;GET INITIAL GUESS, DIV BY PRIME
EXCH T2,T3 ;2/ FIRST GUESS
IDIVI T3,NHOSTS ;DIV BY PRIME AGAIN
CAIN T4,0 ;GET INCREMENT
MOVEI T4,1
MOVEI T3,NHOSTS ;COUNTER FOR GUESSES
HSTHLP: SKIPG HOSTNN(T2) ;NO HOST THERE?
RET ;NO, 2/ WHERE TO PUT IT
CAMN T1,HOSTNN(T2) ;MATCH?
RETSKP
ADDI T2,(T4) ;STEP BY INCREMENT
CAIL T2,NHOSTS ;WRAP AROUND IF NEEDED
SUBI T2,NHOSTS
SOJG T3,HSTHLP ;COUNT DOWN GUESSES
SETO T2, ;-1 TABLE FULL
RET
;CONVERT HOST NUMBER IN AC1 TO NEW FORMAT
CVNHST::CAMN T1,[-1] ;IF -1 USE LOCAL HOST NUMBER
MOVE T1,NLHOST
AND T1,[HSTMSK] ;CUT DOWN TO SIZE
TLNE T1,37700
RET
ANDI T1,377
TRZE T1,100 ;SET THE HOST BITS
TRO T1,200000
TRZE T1,200
TRO T1,400000
IOR T1,NETFLD ;ADD NETWORK NUMBER
RET
;CONVERT HOST NUMBER IN AC1 TO OLD FORMAT
CVOHST::CAMN T1,[-1] ;NO HOST?
JRST CVOHS1 ;RETURN 777
TDZE T1,[740077,,177700];CHECK TO SEE IF FITS IN OLD FORMAT
MOVEI T1,400 ;RETURN 400
TRZE T1,200000 ;SET THE HOST BITS
TRO T1,100
TRZE T1,400000
TRO T1,200
CVOHS1: ANDI T1,777
RET
SWAPCD
; Decode name string
; Called both at gtjfn and openf to decode name string into
; Local socket number
NAMDEC: MOVEI T3,10 ; Perhaps this should be decimal?
NIN ; Convert to a number
JRST NAMDE1 ; Failure: no number there
LDB T3,T1 ; Get terminator
CAIE T3,"#" ; If not number sign
JRST NAMDE2 ; Then ordinary
MOVE T3,CAPMSK ; Else system socket
TRNN T3,SC%WHL!SC%OPR!SC%NAS;MUST BE WHEEL, OPR, OR
; HAVE ABSOLUTE SOCKET CAPABILITY
RET ; Else fail
ILDB T3,T1 ; Get next ch
TDZA T1,T1 ; Zero for high 17 bits
NAMDE2: HRRZ T1,FILVER(JFN) ; Use filver for high 17 bits
JUMPN T3,R ; String too long
SKIPE T1
ANDI T2,77777 ; If not system socket, retain 15 bits
TRZ T2,1 ; Clear gender
ROT T1,^D15
IOR T1,T2
RETSKP
NAMDE1: MOVE T2,JFN ; Default to jfn
IDIVI T2,MLJFN ; Get the jfn
LSH T2,1 ; Jfn will end up lsh'ed 1
LDB T3,T1
JRST NAMDE2
NETDED::MOVE T1,NETSTS(UNIT) ; GET STATUS
TXNE T1,DEDF+EOTF ; HOST DEAD OR DONE
RET
RETSKP
NETHLK::LOAD T1,ANFHS,(UNIT) ; HOST
LOAD T2,ANLNK,(UNIT) ; LINK
RET
; Open network file
NETOPN: TQNE <XCTF,RNDF>
JRST ILLACC ; Illegal to access in append or xct
TQNE <READF>
TQNN <WRTF>
TQNN <READF,WRTF>
JRST ILLACC ; Must be only one of read or write
GTOKM (.GOANA,,[RETERR ()]) ; Ask ACJ for its blessing on the open
LDB T1,PBYTSZ
CAIN T1,^D8 ; Check for 8 32 or 36 bit bytes
CAIA
CAIN T1,^D32
CAIA
CAIN T1,^D36
CAIA
JRST [ MOVEI T1,SFBSX2
RET] ; Bad byte size
HLRZ T1,FILNEN(JFN)
HRLI T1,(<POINT 7,0,35>)
CALL NAMDEC ; Decode name
JRST ILLACC ; Can only happen if wheel lost
TQNE <WRTF>
TROA T1,1 ; If writing set gender bit for local
TRZ T1,1 ; Else clear it
PUSH P,T1 ; Save for later
HRRZ T1,FILNEN(JFN)
HRLI T1,(<POINT 7,0,35>)
CALL EXTDEC ; Decode extension
JRST [ POP P,T1 ; Return T1 to its place
RET] ; And return. We can go thru here if the
; host went away between the GTJFN and OPENF.
TQNE <READF>
TROA T2,1 ; If reading set gender bit for forskt
TRZ T2,1 ; Else clear
POP P,T3
LDB T4,PBYTSZ ; Get file byte size
JUMPL T1,OPNLSN ; No foreign socket, do a listen
CALL CONNECT ; Connect
RET
TQZ <WNDF>
NETOP1: HRLM UNIT,FILSKT(JFN) ;REMEMBER UNIT NUMBER
SETZ IOS, ; Clear status bits
LDB T1,[POINT 4,STS,35]
CAIE T1,5 ; In modes 5
CAIN T1,7 ; Or 7
TQO <BFSND> ; DO BUFFERED TRANSMISSION
IORB IOS,NETSTS(UNIT) ; Set it in status word
MOVEI T1,^D36
LDB T2,PBYTSZ
IDIV T1,T2 ; Get bytes per WORD
XCTBU [LDB T3,[POINT 6,2,17]];GET DESIRED SIZE OF BUFFER
IMUL T1,T3 ; DESIRED BYTES
HRLM T1,NETBUF(UNIT) ; Gives bytes per buffer
SETZM FILBYN(JFN) ; About to reference byte 0 of buffer
SETZM FILOFN(JFN) ; NEXT BYTE TO XMIT = 0
TQO <SIZF> ; CANNOT CHANGE BYTE SIZE
TQOE <WNDF> ; NO BUFFER YET. ALSO IF LISTEN
RETSKP ; Return immediately
LDB T1,[POINT 4,STS,35]
CAIE T1,6 ; Also in modes 6
CAIN T1,7 ; And 7
RETSKP ; Return immediately
LOAD T1,ANFSM,(UNIT) ; No. get current state
CAIN T1,RFCS ; Will usually be rfcs
CALL WATNOT ; If so, wait for it to not be
LOAD T1,ANFSM,(UNIT) ; Get state
MOVE IOS,NETSTS(UNIT)
TQNN <EOTF> ; IF LEFT OPND
CAIN T1,OPND ; OR STILL OPENED
RETSKP ; THEN SUCCEED
MOVX T2,PROGF
ANDCAM T2,NETSTS(UNIT) ; Program not watching
CALL NETCLD ; FSM close
TQNE <ERRB> ; ERRB REMEMBERS BAD BYTE SIZE
SKIPA T1,[OPNX22] ; MAKE THAT THE ERROR CODE
MOVEI T1,OPNX21 ; ELSE IT WAS REJECTED
RET ; And give bad return
OPNLSN: CALL LISTEN
RET ; Can't listen
TQO <WNDF> ; TO REMEMBER THAT THIS WAS A LISTEN
JRST NETOP1 ; First bin/out is accept
ILLACC: MOVEI T1,OPNX14
RET
; Wait for fsm to leave state given in a
WATNOT: HRLI T1,NOTTST ; TEST ROUTINE ADDRESS
WATNO1: MOVE T2,UNIT ; COMPUTE SCHEDULER TEST ARGUMENT
ROT T2,-9
MOVSS T1
IOR T1,T2
SKIPE INSKED
BUG(NETWNS)
MDISMS
RET
; Wait for fsm to enter a particular state
WATFOR: HRLI T1,WATTST
JRST WATNO1
RESCD
NOTTST: LDB T2,[POINT 9,T1,26] ; EXTRACT UNIT
ANDI T1,777 ; AND STATE TO TEST AGAINST
LOAD T3,ANFSM,(T2) ; GET CURRENT STA(E
CAME T1,T3 ; IS IT THE SAME
JRST 1(T4) ; NO, READY TO GO
JRST WATTS1 ; YES, MAKE OTHER TESTS
; SCHEDULER TEST WAITING FOR CONNECTION TO GET TO A STATE
WATTST: LDB T2,[POINT 9,T1,26] ; EXTRACT UNIT
ANDI T1,777 ; AND STATE
LOAD T3,ANFSM,(T2) ; GET CURRENT STATE
CAMN T3,T1 ; SAME?
JRST 1(T4) ; YES, READY TO GO
WATTS1: MOVE T3,FKINT(HN) ; Look for deferred interrupts
TLNN T3,(1B1)
JRST 0(T4) ; None. return no skip
SETZ T3,
STOR T3,ANCLKS,(T2) ; Set clock to zero to hasten time-out
JRST 0(T4)
;SCHEDULER TEST FOR BIT ALLOCATION
;CONNECTION NUMBER IN T1
BALTST: LOAD T2,ANBSIZ,(T1) ;GET BIT STREAM BYTE SIZE
LOAD T3,LTIDX,(T1) ;GET LINK TABLE INDEX
SKIPN IMPLT4(T3) ;SKIP IF NEITHER MSG ALLOC OR BUFFER
JRST BALTS1
CAMG T2,NETBAL(T1) ;MSG OK, HOW ABOUT BITS?
JRST 1(T4)
BALTS1: MOVE T3,NETSTS(T1) ;GET STATUS INFO
TXNE T3,DEDF+EOTF ;ALLOC BAD. BUT IF DEAD..STILL OK
JRST 1(T4) ;TAKE SKIP RETURN
JRST 0(T4) ;RETURN
SWAPCD
; Close network file
NETCLZ: HLRZ UNIT,FILSKT(JFN)
TQNN <WNDF> ; IF NO BUFFER EVER ASSIGNED
TQNN <WRTF> ; OR IF READING
JRST NETCL1 ; Then skip the following
CALL DMPBUF ; Dump last buffer
JRST NETCLW ; NOT ALL SENT. GO WAIT.
NETCL1:
REPEAT 0,<
TQNE <ERRF> ; ANY FINAL ERRORS
JRST [ MOVEI T1,IOX5
RET] ; DON'T CLOSE IF ANY UN-HANDLED ERRORS
>
HRROS FILSKT(JFN) ; IN CASE JFN RE-OPENED, SET UNIT TO -1
SETOM NETFRK(UNIT)
HRRZ T2,NETBUF(UNIT) ;GET BUFFER ADDRESS
CAIGE T2,1000 ;IS THERE A BUFFER
JRST NETCL3 ;NO BUFFER OF NVT
MOVEI T1,JSBFRE ;THIS IS ALSO THE BLOCK TO FREE
CALL RELFRE ;YES. RELEASE IT
NETCL3: CALL NETCLD ; FSM close
UMOVE T1,1
TDNN T1,[1,,400000]
TLNN T1,(1B1)
JRST NETCL2 ; Return immediately if no bit 1
LOAD T2,ANFSM,(UNIT)
MOVEI T1,FREE
CAIE T2,FREE
CALL WATFOR
NETCL2: MOVX T1,PROGF
ANDCAM T1,NETSTS(UNIT) ; No program wants this any more
RETSKP
NETCLD: TQNN <WRTF> ; IF NOT SENDING
SKIPA T1,[CLZR] ; THEN DO CLZR
MOVEI T1,CLZS ; ELSE do clzs
CALLRET DOFSM
NETCLW: MOVEI T2,^D60 ; 5 MINUTES OF TICKS
STOR T2,ANCLKS,(UNIT)
MOVX IOS,CLZF
IORB IOS,NETSTS(UNIT)
MDISMS
JRST NETCLZ ; AND GO TRY AGAIN
; Close nvt
NVTCLZ::MOVE T1,LSKT(UNIT)
TRNN T1,1
SKIPA T1,[CLZR]
MOVEI T1,CLZS
CALLRET DOFSM
; Network mtopr routines
NETMTP: TQNN <OPNF> ;CHECK TO SEE IF OPENED
RETBAD (CLSX1) ;NOT OPENED
HLRZ UNIT,FILSKT(JFN)
MOVE IOS,NETSTS(UNIT)
CAIG T2,26
CAIGE T2,20
RETSKP ; ANYTHING ELSE IS A NOP
JRST .+1-20(T2)
JRST NETACP
JRST NETDMP
JRST SNDINT
JRST ABTCON
JRST NETINT
JRST NETRDY
JRST NETFAL
NETACP: LOAD T2,ANFSM,(UNIT)
MOVEI T1,ACPT
CAIN T2,RFCR
CALL DOFSM
RETSKP
NETDMP: TQNE <BFSND> ;SENDING BY BUFFER?
TQNN <WRTF> ;AND A SEND CONNECTION?
RETSKP ;NO, A NOP
TQNE <WNDF> ;YES. BUFFER SET UP?
RETSKP ;NO, NOTHING TO SEND
CALL DMPBUF
JRST WATXXX
RETSKP
SNDINT: LOAD T1,ANFHS,(UNIT)
LOAD T2,ANLNK,(UNIT)
MOVE T4,LSKT(UNIT)
TRNE T4,1
SKIPA T4,[IMPINS]
MOVEI T4,IMPINR
NCPOFF
LOAD T3,ANFSM,(UNIT)
CAIN T3,OPND
CALL (T4)
NCPON
RETSKP
; WAIT FOR READY TO SEND AT LEAST ONE BYTE
ABTCON: MOVE T1,CAPENB
TXNN T1,SC%NWZ
JRST [ MOVEI T1,NTWZX1 ; NOT A NET WIZARD. FAIL.
RET]
CALL SKTDWN
RETSKP
NETRDY: TQNN <WRTF> ; RECEIVE OR SEND?
JRST NETRD1 ; RECEIVE. SEND ALLOCATES OUT
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL PKCHK ; GET BYTES THAT CAN BE SENT
JUMPE T2,[CALL WATBAL ; COMPUTE ACTIVATION TEST
JRST WATXXX] ; AND WAIT
CALL PKULCK
RETSKP
NETRD1: TQNN <WNDF> ;HAS ALLOCATION ALREADY BEEN SENT?
RETSKP
CALL FIRSTI ;NO. SEND IT OUT.
RET ;PASS ON DOWN BLOCK
RETSKP
NETINT: UMOVE T2,3
HRR T2,FORKX ; REMEMBER THIS FORK, AND USER'S
MOVEM T2,NETFRK(UNIT) ; REQUESTED PI CHANNELS
RETSKP
NETFAL: TQNE <WNDF,WRTF> ; IF READ AND FIRSTI NOT DONE
RETSKP
CALL FIRSTI ; SET UP BUFFERS AND SEND ALLOCATE
RET ;PASS ON DOWN BLOCK
RETSKP
; HERE WHEN A FORK IS KILLED, TO FORGET THE PSI INFO
NETKFK::SAVEQ
MOVSI UNIT,-NSKT
NETKF1: HRRE IOS,NETFRK(UNIT)
CAMN IOS,FORKX
SETOM NETFRK(UNIT)
AOBJN UNIT,NETKF1
RET
; HERE FROM LOGOUT CODE TO RELEASE JOB-WIDE NET RESOURCES
NETLGO::SETO T1,0 ;RELEASE ALL SPECIAL QUEUES
RELSQ
RET ; THAT'S ALL
; SKIP IF NET INPUT BUFFER EMPTY
NTSIBE::HRRZ T1,DEV ;SEE IF NETWORK JFN
CAIE T1,NETDTB
RETSKP
HLRZ UNIT,FILSKT(JFN)
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
MOVSI T2,777777
TDNN T2,IMPLT4(T1)
TDNE T2,IMPLT3(T1)
RET
RETSKP
; Network file sequential byte input
NETSQI: HLRZ UNIT,FILSKT(JFN)
MOVE IOS,NETSTS(UNIT)
TQNN <WNDF>
JRST NTSQI1
CALL FIRSTI ; Wait for listen set up buffers etc.
RET ;PASS ON DOWN BLOCK
NTSQI1: SOSL FILCNT(JFN)
JRST NTSQI2
CALL LODBUF ; Get another bufferful
RET ;PASS ON DOWN BLOCK
NTSQI2: TQNE <EOFF>
RET
ILDB T1,FILBYT(JFN)
AOS FILBYN(JFN)
RET
LODBUF: MOVX IOS,ERRB
TDNE IOS,NETSTS(UNIT)
TQO <ERRF>
ANDCAB IOS,NETSTS(UNIT)
MOVE T3,NETBUF(UNIT) ;GET ADDRESS OF BUFFER
HLL T3,FILBYT(JFN) ;GET THE BYTE SIZE
TLZ T3,770000 ;SET AT END OF FIRST WORD
TLNN T3,700 ;36 BIT MODE?
TLO T3,40000 ;NO GET BYTE OFFSET RIGHT
MOVEM T3,FILBYT(JFN) ;SAVE BYTE POINTER
HLRZ T4,NETBUF(UNIT) ;GET BUFFER SIZE
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL UPMSG ;UNPACK MESSAGE(S) INTO BUFFER
JRST [MOVX IOS,EOTF ;GET END OF FILE FLAG
TDNE IOS,NETSTS(UNIT) ;IS IT SET FOR THIS CONNECTION
JRST [ TQO <EOFF> ;YES SET FOR THIS JFN
RETSKP] ;AND RETURN
JRST WATXXX] ;BACK OUT AND WAIT THEN START OVER
HLRZ T2,NETBUF(UNIT) ;GET BUFFER SIZE IN BYTES
SUB T2,T4 ;BYTES LOADED
MOVEM T2,FILCNT(JFN) ;SET BYTES IN BUFFER FOR THIS JFN
ADDM T2,FILLEN(JFN) ;UPDATE NUMBER OF BYTES ON THIS CONN.
LOAD T4,ANBSIZ,(UNIT) ;GET BYTE SIZE
IMUL T4,T2 ;BITS RECEIVED
ADDM T4,NETBTC(UNIT) ;KEEP COUNT OF BITS RECEIVED
MOVN T2,T4 ;GET NEGATIVE OF BITS RECIEVED
ADDM T2,NETBAL(UNIT) ;DEBIT ALLOCATION FOR MESSAGE RECEIVED
CALL NETRAL ;RE-ALLOCATE IF NEEDED
SOSGE FILCNT(JFN) ;DID WE GET ANYTHING?
JRST LODBUF ;NO BYTES GO TRY AGAIN
RETSKP
NETRAL::NCPOFF ; PREVENT CONFUSION
MOVE IOS,NETSTS(UNIT)
TQNE <EOTF,DEDF>
JRST NETRAX ; DON'T BOTHER IF DEAD OR DONE
STKVAR<NETRBA,NETRMA>
MOVE T4,NETDAL(UNIT) ; GET DESIRED BIT ALLOCATION
MOVE T2,T4
ASH T2,-1 ; HALVE
MOVEM T2,NETRBA
MOVEI T3,MSGALL ; DESIRED LEVEL OF MSG ALLOC
MOVE T2,T3
ASH T2,-1 ; HALVE
MOVEM T2,NETRMA
LOAD T2,LTIDX,(UNIT) ; GET LINK TABLE INDEX
HRRZ T2,IMPLT4(T2) ; OUTSTANDING MSG ALLOC
SUB T3,T2 ; NEEDED INCREMENT
SUB T4,NETBAL(UNIT) ; NEEDED INCREMENT
LOAD T1,ANFHS,(UNIT)
LOAD T2,ANLNK,(UNIT)
CAMGE T4,NETRBA ; IF GREATER THAN HALF
CAML T3,NETRMA ; FOR EITHER ONE
JRST NETRX2 ; THEN SEND AN ALLOCATE
NETRAX: NCPON ; turn network back on
RET
NETRX2: CALL IMPALL ; SEND ALLOCATE MESSAGE
RET ; IMPALL NLOCKED NCPLCK FOR US
FIRSTI: CALL FRSTIO ; SET UP BUFFER
RET ;PASS ON DOWN BLOCK
JUMPG T2,FRSTI1 ; BUFFER SPECIFIED. USE FOR ALLOCATION
PUSH P,T1
MOVE T1,MAXBPM ; MAXIMUM BITS IN A MESSAGE
LOAD T2,ANBSIZ,(UNIT) ; CONNECTION BYTE SIZE
IDIV T1,T2 ; BYTES
IMULI T1,MSGALL ; TIMES MESSAGE ALLOCATION
POP P,T2 ; THAT PLUS FILE BUFFER BYTES
ADD T2,T1 ; IS WHAT TO USE
FRSTI1: LOAD T4,ANBSIZ,(UNIT) ; GET BYTES SIZE
IMUL T4,T2 ; BITS IN BUFFERS
MOVEM T4,NETDAL(UNIT) ; SAVE DESIRED LEVEL
CALL NETRAL ; SEND ALLOCATE AS NEEDED
RETSKP
WATLSN: LOAD T1,ANFSM,(UNIT) ; Get state of this connection
CAIN T1,OPND
RETSKP
CAIN T1,RFCR
JRST [ MOVEI T1,ACPT
CALL DOFSM
RETSKP]
CAIN T1,RFCS ; If still waiting for rfc
JRST WATLS1 ; Continue waiting
CAIE T1,LSNG
JRST [ MOVX IOS,EOTF
TDNE IOS,NETSTS(UNIT)
RETSKP ; Null file sent
MOVX IOS,ERRB!EOTF ; Connection never actually opened
IORB IOS,NETSTS(UNIT)
RETSKP]
WATLS1: MOVE T2,UNIT ;GET UNIT
ROT T2,-9 ;PUT IN BITS 0-8
HRLI T1,NOTTST ;TEST ROUTINE ADDRESS,,STATE
MOVSS T1 ;STATE TO WAIT FOR,,TEST ROUTINE ADDRESS
IOR T1,T2 ;UNIT/STATE,,TEST ROUTINE
TQO <BLKF> ;BLOCK FOR STATE CHANGE
RET
WATXXX: TQO <BLKF> ;TELL LOWER LEVEL TO BLOCK
RET
; Network file sequential byte output
NETSQO: HLRZ UNIT,FILSKT(JFN)
MOVE IOS,NETSTS(UNIT)
TQNE <DEDF,ERRB>
TQO <ERRF>
TQNE <DEDF,EOTF>
RET
PUSH P,T1
TQNN <WNDF>
JRST NTSQO4
CALL FIRSTO
JRST [POP P,0(P) ;CLEAN UP STACK
RET] ;PASS ON DOWN BLOCK
NTSQO4: TQNE <BFSND> ; IMMEDIATE SEND?
JRST NTSQO1 ; No
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL PKCHK ; HOW MANY BYTES CAN WE SEND?
POP P,T3
JUMPE T2,NTSQO3 ; NOT ENOUGH
CALL PKBYT
TRN
LOAD T1,ANBSIZ,(UNIT)
ADDM T1,NETBTC(UNIT)
MOVNS T1
ADDM T1,NETBAL(UNIT)
MOVEI T1,^D24
STOR T1,ANCLKS,(UNIT) ; RESET CLOCK TO TWO MINUTES
RET
NTSQO1: SOSL FILCNT(JFN)
JRST NTSQO2
CALL DMPBUF
JRST [POP P,T3 ;CLEAN UP STACK
JRST WATXXX] ; Can't dump now, wait
NTSQO2: AOS FILBYN(JFN)
POP P,T1
IDPB T1,FILBYT(JFN)
RET
NTSQO3: CALL WATBAL ;WAIT FOR BITS AND A MSG TO BE ALLOCATED
JRST WATXXX ; ..
DMPBUF: MOVX IOS,ERRB ;GET ERROR HAS OCCURED FLAG
TDNE IOS,NETSTS(UNIT) ;HAS ERROR OCCURED?
TQO <ERRF> ;YES. INDICATE IT FOR THE JFN
ANDCAB IOS,NETSTS(UNIT) ;CLEAR ERROR FLAG FOR CONNECTION
MOVE T4,FILOFN(JFN) ;GET CURRENT OUTPUT POINT
CAML T4,FILBYN(JFN) ;DONE?
JRST DMPDUN ;YES
TQNE <EOTF,DEDF> ;END OF FILE OR DEAD HOST
JRST [ TQO <ERRF> ;YES. SET ERROR FOR JFN
SETZM FILBYT(JFN) ;ZERO BYTE POINTER
SETZM FILBYN(JFN) ;BYTE COUNT
SETZM FILOFN(JFN) ;AND CURRENT POSITION IN FILE
HRLOI T1,377777 ;AND SET NUMBER OF BYTES TO INFINITY
MOVEM T1,FILCNT(JFN)
RETSKP]
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL PKCHK ;HOW MANY BYTES CAN WE SEND?
JUMPE T2,WATBAL ;NONE, WAIT
MOVE T4,FILBYN(JFN) ;GET BYTE COUNT
SUB T4,FILOFN(JFN) ;GET NUMBER OF BYTES IN BUFFER
CAML T4,T2
MOVE T4,T2 ;TAKE MIN OF THE TWO
MOVE T3,NETBUF(UNIT) ;GET BUFFER ADR
HLL T3,FILBYT(JFN) ;GET BYTE SIZE
TLZ T3,770000 ;END OF FIRST WORD
TLNN T3,700 ;36 BIT MODE?
TLO T3,40000 ;NO GET BYTE OFFSET RIGHT
MOVE T1,FILOFN(JFN) ;GET BYTE OFFSET
TLNE T3,6700 ;8 BIT?
JRST DMPBF1 ;NO
IDIVI T1,4 ;GET WORDS TO ADJUST IN T1
HRRZS T3 ;WE WILL ADD IN THE PROPER LH
ADD T3,[041000,,0 ;CASE 0. POINT TO PREVIOUS WORD
341000,,1 ;SO PKMSG WILL DO A BLT
241000,,1 ;OTHERS CASES USE STD. PTR
141000,,1](T2)
DMPBF1: ADDI T3,(T1) ;DO WORD OFFSET
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
PUSH P,T4 ;SAVE COUNT WE ARE ASKING FOR
CALL PKMSG ;GO PACK MESSAGE AND SEND IT
POP P,T4 ;GET BYTE COUNT BACK
ADDM T4,FILOFN(JFN) ;UPDATE BYTE COUNT OF BUFFER
LOAD T3,ANBSIZ,(UNIT) ;GET BYTE SIZE
IMUL T4,T3 ;GIVES BITS JUST SENT
ADDM T4,NETBTC(UNIT) ;KEEP COUNT OF BITS SENT
MOVNS T4 ;GET NEGATIVE OF BITS SENT
ADDM T4,NETBAL(UNIT) ;UPDATE BIT ALLOCATION
MOVEI T1,^D24
STOR T1,ANCLKS,(UNIT) ;RESET CLOCK FOR THIS CONNECTION
JRST DMPBUF ;GO CHECK FOR ERRORS
DMPDUN: SETZM FILBYN(JFN) ;ZERO BYTE COUNT FOR BUFFER
SETZM FILOFN(JFN) ;ZERO CURRENT OUTPUT POINT
MOVE T1,NETBUF(UNIT) ;GET ADDRESS OF BUFFER
HLL T1,FILBYT(JFN) ;GET THE BYTE SIZE
TLZ T1,770000 ;SET AT END OF FIRST WORD
TLNN T1,700 ;36 BIT MODE?
TLO T1,40000 ;NO GET BYTE OFFSET RIGHT
MOVEM T1,FILBYT(JFN) ;SAVE BYTE POINTER
HLRZ T1,NETBUF(UNIT) ;GET BUFFER SIZE
SUBI T1,1 ;DECREMENT IT BY ONE
MOVEM T1,FILCNT(JFN) ;AND SAVE IT AS BYTES IN BUFFER
RETSKP
WATBAL: LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL PKULCK ;UNLOCK CONNECTION TOO
MOVEI T1,BALTST ;GET ADDRESS OF TEST ROUTINE
HRL T1,UNIT ;AND UNIT TO WAIT ON
RET
FIRSTO: TQNN <BFSND> ; BUFFERED?
JRST [ CALL WATLSN ; NO, WAIT FOR CONNECTION TO OPEN
RET ;PASS ON DOWN BLOCK
TQZ <WNDF>
RETSKP]
CALL FRSTIO ; YES, SET UP BUFFER ETC
RET ;PASS ON DOWN BLOCK
RETSKP
;FRSTIO - SET UP BUFFER IN JSB FREE SPACE
;ACCEPTS UNIT/ NETWORK PSEUDO UNIT NUMBER
;RETURNS +1 FAILURE
; +2 SUCCESS
; RH NETBUF(UNIT) HAS BUFFER ADDRESS
FRSTIO: CALL WATLSN ; Wait for connection complete
RET ; Pass on down block
STKVAR <FRSTBY,FRSTBF>
MOVEI T1,^D36 ; Bits per word
LOAD T3,ANBSIZ,(UNIT) ; Connection byte size
IDIV T1,T3 ; Connection bytes per word
IMUL T3,T1 ; Used bits per word
MOVE T2,MAXBPM ; Max bits per net message
IDIVM T2,T3 ; Max words per net message
MOVEI T1,^D36 ; Bits per machine word
LDB T2,PBYTSZ ; File byte size
IDIVM T1,T2 ; File bytes per word
MOVEM T2,FRSTBY ; Save file bytes per word
HLRZ T1,NETBUF(UNIT) ; Desired bytes per buffer
IDIV T1,T2 ; Number of words needed
SKIPE T1 ; If zero
CAML T1,T3 ; Or bigger than max
MOVE T1,T3 ; Use max
MOVEM T1,FRSTBF ; Save bytes per buffer
AOS T2,T1 ; Plus header
CALL ASGJFR ;ASSIGN A PAGE IN JOB AREA
JRST [TQO <ERRF> ;INDICATE AN ERROR
RETBAD] ;RETURN
HRRM T1,NETBUF(UNIT) ;SAVE BUFFER ADDRESS
MOVE T3,FRSTBF ;GET SIZE AVAILABLE FOR BUFFER
MOVE T1,FRSTBY ;GET BYTES/WORD BACK
IMUL T1,T3 ;CALCULATE BYTES BUFFER WILL HOLD
HLRZ T2,NETBUF(UNIT) ;RETURN AS VALUE
HRLM T1,NETBUF(UNIT) ;REAL BYTES PER BUFFER
TQZ <WNDF>
RETSKP
; Attach sockets to pty
; Call: 1 ; Receive jfn of opened network connection
; 2 ; Send jfn of opened network connection
; ATNVT
; Returns
; +1 ; Cannot attach
; +2 ; Ok. the jfns are released, ac 1 has line number of
; ; Attached pty.
.ATNVT::MCENT
STKVAR <ATUNTS,ATRCJF,ATNDAD>
UMOVE JFN,1
HRRZS JFN
CALL CHKJFN ; Check jfn of receive connection
JRST ATPER0 ; Only real jfns are legal
JRST ATPER0
JRST ATPER0
MOVEI T1,ATNX2 ; Error code if test skips
TQNE <READF> ; MUST BE OPENED FOR READING
CALL CHKATP ; Check for dev=net, open, no buffer
JRST ATPER1 ; Failed one of the above
HLRZ UNIT,FILSKT(JFN)
MOVEM UNIT,ATUNTS ;SAVE DEV AND JFN
MOVEM JFN,ATRCJF
UMOVE JFN,2 ; Get send jfn
CALL CHKJFN ; Check it
JRST ATPER2 ; Must also be a real jfn
JRST ATPER2
JRST ATPER2
MOVEI T1,ATNX2 ; Becomes atNx8 at atper3
TQNE <WRTF> ; THIS ONE MUST BE FOR WRITING
CALL CHKATP ; And dev=net, open, no buffer
JRST ATPER3 ; Failed above tests
HLRZ UNIT,FILSKT(JFN)
LOAD T1,ANFSM,(UNIT)
CAIN T1,RFCS
CALL WATNOT ; Wait for response from foreign host
MOVEI T1,ATNX12 ; Error code for refused send
LOAD T2,ANFSM,(UNIT) ; Now get state
CAIE T2,OPND ; If not opnd
JRST ATPER4 ; Then fail
HRLM UNIT,ATUNTS ;SAVE SEND JFN IN LEFT HALF
HRRZ UNIT,ATUNTS ;SWITCH TO RECEIVE CONNECTION
LOAD T1,ANFSM,(UNIT) ; Get its state
CAIN T1,RFCS
CALL WATNOT ; Wait for response from foreign host
MOVEI T1,ATNX6 ; Error code for refused receive
LOAD T2,ANFSM,(UNIT)
CAIE T2,OPND ; If not opnd
JRST ATPER4 ; Then fail
NCPOFF
LOAD T1,ANFSM,(UNIT)
CAIE T1,OPND
JRST [ MOVEI T1,ATNX6
JRST ATPERZ]
HLRZ UNIT,ATUNTS ;GET SEND UNIT
LOAD T1,ANFSM,(UNIT)
CAIE T1,OPND
JRST [ MOVEI T1,ATNX12
JRST ATPERZ]
UMOVE 1,1 ; GET OPTION FLAGS
HRR T1,ATUNTS ;SET UP ARGS, RECEIVE UNIT IN 1
HLRZ T2,ATUNTS ;SEND UNIT IN 2
CALL ASNNVT ; Assign NVT to these units
JRST [ MOVEI T1,ATNX13 ; Can't, no pty's
JRST ATPERZ]
MOVEM T2,ATNDAD ;SAVE ADDRESS OF DYNAMIC DATA
HRRZ UNIT,ATUNTS ;RECIEVE UNIT
MOVX T3,PROGF
ANDCAM T3,NETSTS(UNIT) ; PROGRAM NO LONGER LOOKING
HRRM T1,NETBUF(UNIT) ; Store pty number here
HLRZ UNIT,ATUNTS ;SEND UNIT
ANDCAM T3,NETSTS(UNIT) ; NOT HERE EITHER
HRRM T1,NETBUF(UNIT) ; Also here
NCPON
IORI T1,400000 ; Convert pty to tty designator
UMOVEM T1,1 ; Return to user
CALL RELJFN ; Release send jfn
MOVE JFN,ATRCJF
CALL RELJFN ; And receive jfn
HRRZ UNIT,ATUNTS ;GET RECIEVE UNIT
MOVE T2,ATNDAD ;GET ADDRESS OF DYNAMIC DATA
CALL NVTRAL ;GO REALLOCATE
MOVE T2,ATNDAD ;GET ADDRESS OF DYNAMIC DATA
CALL ULKTTY ;UNLOCK DATA BASE
SMRETN ;RETURN SKIPPING
; Check validity of jfn for atpty
CHKATP: MOVEI T1,ATNX3 ; Receive not open
TQNN <OPNF> ; IS IT OPEN?
RET ; NO
HRRZ T2,DEV
MOVEI T1,ATNX4
CAIE T2,NETDTB
RET
MOVEI T1,ATNX5
TQNN <WNDF>
RET
RETSKP
ATPERZ: NCPON
JRST ATPER4
ATPER2: MOVEI T1,ATNX7 ; Bad send jfn
JRST ATPER5
ATPER3: ADDI T1,ATNX7-ATNX1 ; Convert receive errors to send errors
ATPER4: CALL UNLCKF
ATPER5: MOVE JFN,ATRCJF ;GET RECIEV JFN
MOVE STS,FILSTS(JFN)
ATPER1: CALL UNLCKF
JRST MRETNE ; Save error return in ac1
ATPER0: MOVEI T1,ATNX1 ; Bad receive jfn
JRST MRETNE
; Convert jfn to absolute network socket number
; Call: 1 ; Jfn
; CVSKT
; Returns
; +1 ; Error
; +2 ; Ok, in 2 the absolute socket number
.CVSKT::MCENT
MOVE JFN,T1
CALL CHKJFN
RETERR (CVSKX1)
RETERR (CVSKX1)
RETERR (CVSKX1)
CAIE PTR,NETDTB
RETERR (CVSKX1,<CALL UNLCKF>)
HLRZ T1,FILNEN(JFN)
HRLI T1,(<POINT 7,0,35>)
CALL NAMDEC
RETERR (CVSKX2,<CALL UNLCKF>)
CALL UNLCKF
UMOVEM T1,2
JRST SKMRTN
;ROUTINE TO PRODUCE THE OLD HOSTN TABLE
GHOSTN::LOAD T4,HSTIDX,(T2) ;GET INDEX
MOVE T1,HOSTNN(T4) ;GET THE HOST NUMBER
CALL CVOHST ;CONVERT TO OLD FORMAT
MOVE T3,HSTSTS(T4) ;GET HOST STATUS
ANDI T3,777000 ;GET THE RIGHT BITS
IORI T1,(T3) ;BUILD LH
SKIPGE HOSTN(T2) ;NICKNAME?
TXO T1,HS%NCK
MOVSI T1,(T1)
LOAD T3,HSTNMP,(T2) ;GET THE NAME POINTER
HRRI T1,(T3)
RET
;ROUTINE TO PRODUCE THE OLD NETAWD TABLE
GNTAWD::LOAD T1,ANFHS,(T2) ;GET THE HOST NUMBER
CALL CVOHST ;CONVERT TO OLD FORMAT
MOVSI T1,(T1) ;HOST NUMBER TO LH
MOVE T3,NETAWD(T2) ;GET REST OF WORD
TLZ T3,777 ;CLEAR OUT SLOT FOR HOST
IOR T1,T3 ;PUT IT TOGETHER
RET
;ROUTINE TO PRODUCE OLD IMPHRT GETAB TABLE.
GTBHRT::SAVEQ ;NEED SOME ACS
HRRZ UNIT,T2 ;GET INDEX
IMULI UNIT,^D36 ;CONVERT TO 1ST HOST NUMBER
HRLI UNIT,-^D36 ;LOOP COUNTER
SETO IOS, ;SET TO ALL UP
GTBHR1: ROT IOS,1 ;MAKE ROOM FOR NEXT BIT
HRRZ T1,UNIT ;GET NEXT HOST NUMBER
CAIL T1,400 ;OUT OF RANGE
JRST GTBHR2
CALL CVNHST ;CONVERT TO NEW FORMAT
CALL HSTHSH ;LOOKUP HOST INDEX
TRNA ;NOT THERE SO NOT UP
SKIPL HSTSTS(T2) ;UP?
GTBHR2: TXZ IOS,1 ;NO, CLEAR BIT
AOBJN UNIT,GTBHR1 ;LOOP FOR ALL 36 HOSTS IN THIS WORD
MOVE T1,IOS ;RETURN WORD FOR GETAB
RET
;ROUTINE TO PRODUCE OLD HSTSTS GETAB TABLE.
GTBHSS::SAVEQ ;NEED WORK SPACE
HRRZ IOS,T2 ;GET INDEX
LSH IOS,1 ;TURN INTO HOST NUMBER
MOVE T1,IOS ;HOST N
CALL GTBHSH ;GET RIGHT STATUS
HLLZ UNIT,T1 ;RESULT FOR HOST N IN LEFT HALF
AOS T1,IOS ;HOST N+1
CALL GTBHSH ;GET RIGHT STATUS
HLR UNIT,T1 ;RESULT FOR HOST N+1 IN RIGHT HALF
MOVE T1,UNIT ;RETURN WORD FOR GETAB
RET
GTBHSH: CALL CVNHST ;CONVERT TO NEW FORMAT
CALL HSTHSH ;LOOKUP HOST INDEX
JRST RFALSE ;NO SUCH HOST, RETURN 0
SKIPL T1,HSTSTS(T2) ;UP?
TXOA T1,<1B0+1B1> ;SET VALID AND DEAD BITS
MOVX T1,<1B0> ;OTHERWISE JUST SET VALID
RET
;GTNCP RETURNS A TABLE OF DATA FOR AN NCP CONNECTION
.GTNCP::MCENT
SKIPL T1 ;CHECK RANGE OF FUNCTION
CAIL T1,GTNMAX
RETERR (ARGX02) ;BAD FUNCTION NUMBER
XCT GTNDSP(T1) ;DO FUNCTION
GTNCPX: SKIPL UNIT ;GET THE INDEX
CAIL UNIT,NSKT
RETERR (GTJIX1) ;BAD INDEX
UMOVE T3,3 ;GET AC3 AND AC4 FROM USER
UMOVE T4,4
GTNCPL: HRRZ T1,T4 ;OUT OF THINGS?
CAIL T1,NCPLEN
JRST GTNCLX ;YES
XCT NCPTAB(T1) ;LOAD DATA WORD
UMOVEM T1,(T3) ;RETURN TO USER
AOJ T3,
AOBJN T4,GTNCPL ;LOOP
GTNCLX: UMOVEM T4,4 ;UPDATE COUNTER
JRST SKMRTN
NCPTAB: MOVE T1,UNIT ;(00)NCP UNIT
LOAD T1,ANFHS,(UNIT) ;(01)FOREIGN HOST
MOVE T1,LSKT(UNIT) ;(02)LOCAL SOCKET
MOVE T1,FSKT(UNIT) ;(03)FOREIGN SOCKET
LOAD T1,ANFSM,(UNIT) ;(04)FINITE STATE
LOAD T1,ANLNK,(UNIT) ;(05)LINK
CALL [ HRRZ T1,NETBUF(UNIT) ;(06)RETURN NVT IF
CAIGE T1,1000 ;THERE IS ONE
JUMPN T1,R
JRST RTRUE]
LOAD T1,ANBSIZ,(UNIT) ;(07)BYTE SIZE OF CONNECTION
CALL [ LOAD T1,LTIDX,(UNIT) ;(10)MSG ALLOC
HRRZ T1,IMPLT4(T1)
RET]
MOVE T1,NETBAL(UNIT) ;(11)BIT ALLOC
MOVE T1,NETDAL(UNIT) ;(12)DESIRED ALLOC
MOVE T1,NETBTC(UNIT) ;(13)BITS XFERRED
HLRZ T1,NETBUF(UNIT) ;(14)BYTES/BUFFER
LOAD T1,ANCLKS,(UNIT) ;(15)TIMEOUT
MOVE T1,NETSTS(UNIT) ;(16)STATUS OF CONN
NCPLEN==.-NCPTAB
GTNDSP: JRST GTNSIZ ;(00)GET TABLE SIZE
HRRZ UNIT,T2 ;(01)INDEX GIVEN
JRST GTNNVI ;(02)INPUT NVT
JRST GTNNVO ;(03)OUTPUT NVT
JRST GTNJFN ;(04)JFN
GTNMAX==.-GTNDSP ;NUMBER OF FUNCTIONS
GTNSIZ: MOVSI T2,-NSKT ;-LENGTH,,1ST INDEX
UMOVEM T2,2 ;RETURN TO USER
MOVE T3,NVTPTR ;-# NVTS,,1ST NVT
UMOVEM T3,3
JRST SKMRTN ;DONE
GTNJFN: MOVE JFN,T2 ;CHECK THE JFN
CALL CHKJFN
RETERR (GTNCX1)
RETERR (GTNCX1)
RETERR (GTNCX1)
HLRZ UNIT,FILSKT(JFN) ;GET THE UNIT
CALL UNLCKF
CAIE PTR,NETDTB ;MAKE SURE IS NET:
RETERR (GTNCX1)
JRST GTNCPX ;REJOIN MAIN CODE
GTNNVI: SKIPA UNIT,[NVTIPU] ;GET INPUT UNIT
GTNNVO: MOVEI UNIT,NVTOPU ;USE OUTPUT UNIT
CAIN T2,.CTTRM ;WANT CONTROLLING TTY?
MOVE T2,CTRLTT ;YES
ANDI T2,377777 ;CLEAR 400000
CALL NVTCHK
RETERR (GTNCX2) ;BAD NVT
CALL (UNIT) ;CALL ROUTINE
SETO UNIT, ;CATCH ERROR AS BAD UNIT
CALL ULKTTY ;UNLOCK TTY DATA BASE
JRST GTNCPX ;REJOIN MAIN CODE
;GET INFOMATION ABOUT HOSTS
.GTHST::MCENT
SKIPL T1 ;CHECK RANGE OF FUNCTION CODE
CAIL T1,GTHMAX
RETERR (ARGX02) ;BAD FUNCTION CODE
SETOB HN,DEV ;NO NUMBER NOR NAME
XCT GTHDSP(T1) ;DO THE FUNCTION
GTHSXX: MOVX T4,HS%NCK ;SET THE NICKNAME FLAG
SKIPL HN ;NO NAME
SKIPL HOSTN(HN) ;DID WE HAVE ONE?
SKIPA T4,HSTSTS(DEV) ;NO
IOR T4,HSTSTS(DEV) ;RETURN STATUS
UMOVEM T4,4
MOVE T3,HOSTNN(DEV) ;RETURN HOST NUMBER
UMOVEM T3,3
JRST SKMRTN ;SKIP RETURN
GTHDSP: JRST GTHSIZ ;(00)GET NAME TABLE SIZE
JRST GTHIDX ;(01)INDEX INTO NAME SPACE
JRST GTHNUM ;(02)CONVERT NUMBER TO STRING
JRST GTHSTR ;(03)CONVERT STRING TO NUMBER
JRST GTHHNN ;(04)STATUS BY NUMBER
JRST GTHHNI ;(05)STATUS BY INDEX
GTHMAX==.-GTHDSP ;NUMBER OF FUNCTIONS
GTHSIZ: HRLZ T2,MHOSTS ;-LENGTH,,1ST INDEX
UMOVEM T2,2 ;RETURN TO USER
MOVSI T3,-NHOSTS ;NUMBER OF HOST SLOTS
UMOVEM T3,3 ;RETURN TO USER
MOVE T4,NLHOST ;LOCAL HOST
UMOVEM T4,4 ;RETURN TO USER
JRST SKMRTN ;DONE
GTHIDX: MOVN T1,MHOSTS ;GET NUMBER OF HOST NAMES IN USE
HRRZ HN,T3 ;CHECK RANGE OF HOST NAME INDEX
CAML HN,T1
RETERR (GTJIX1) ;BAD INDEX TO HOSTN
LOAD DEV,HSTIDX,(HN) ;GET INDEX INTO HOSTNN
JRST GTHTUS ;WRITE THE STRING
GTHNUM: MOVE T1,T3 ;GET HOST NUMBER
CALL GTHNTS ;CONVERT NUMBER TO STRING
JUMPL HN,[RETERR(GTHSX3)] ;NO STRING FOR THAT NUMBER
GTHTUS: LOAD PTR,HSTNMP,(HN) ;GET THE NAME POINTER
MOVEI PTR,HSTNAM(PTR) ;POINT TO NAME
HRLI PTR,(<POINT 7,0>)
CALL GTHSOU ;WRITE STRING
JRST GTHSXX ;EXIT
GTHNTS: CALL CVNHST ;MAKE IT NEW FORMAT
CALL HSTHSH ;GET ITS INDEX
RET ;NOT THERE
HRRZ DEV,T2 ;INDEX TO DEV
HRLZ T2,MHOSTS ;SCAN TABLE FOR THIS INDEX
GTHSLP: LOAD T3,HSTIDX,(T2) ;GET INDEX
CAMN T3,DEV ;THE SAME?
JRST [ HRRZ HN,T2 ;GET NAME INDEX
RET]
AOBJN T2,GTHSLP ;LOOP
RET ;ONLY NUMBER FOUND
GTHSTR: CALL GTHSTN ;CONVERT STRING TO NUMBER
SKIPGE T2 ;VAILD STRING FOUND?
HRRZ HN,T2 ;SAVE POINTER TO HOSTN
MOVE T1,T4 ;GET INDEX TO HOSTNN
CALL CVNHST
CALL HSTHSH
RETERR(GTHSX2)
HRRZ DEV,T2
JRST GTHSXX ;EXIT
GTHSTN: STKVAR <<GTHSBF,10>>
MOVEI PTR,GTHSBF ;MAKE BYTE POINTER
HRLI PTR,(<POINT 7,0>)
CALL GTHSIN ;GET STRING FROM USER
MOVEI T1,GTHSBF ;MAKE BYTE POINTER
HRLI T1,(<POINT 7,0>)
CALLRET HSTLUK ;LOOKUP NAME
GTHHNI: HRRZ T1,T3 ;GET INDEX
CAIL T1,NHOSTS
RETERR (GTJIX1) ;BAD INDEX
SKIPA T1,HOSTNN(T1) ;GET THE NUMBER
GTHHNN: MOVE T1,T3 ;GET HOST NUMBER
CALL GTHNTS ;CONVERT NUMBER TO INDEX
JUMPL DEV,[RETERR (GTHSX1)] ;UNKNOWN HOST
JRST GTHSXX ;EXIT
GTHSIN: UMOVE T1,2 ; GET POINTER
MOVE JFN,[XCTBU [ILDB T2,T1]]
TLNN T1,777777 ; IF JFN DO THE JSYS
MOVE JFN,[BIN]
TLC T1,777777 ; CHECK FOR LH -1
TLCN T1,777777
HRLI T1,(<POINT 7,0>) ; USE STANDARD POINTER
MOVEI STS,MAXLC ; UP TO 39 CHARS
GTHSIL: XCT JFN ; DO RIGHT OPERATION
SOSG STS
MOVEI T2,0 ; AFTER MAXLC CHARS FORCE NULL
CAIL T2,140 ; LOWER CASE?
TRZ T2,40 ; YES, RAISE
CAIG T2,40 ; END ON SPACE OR LESS
MOVEI T2,0
IDPB T2,PTR
JUMPG T2,GTHSIL
BKJFN
JFCL
UMOVEM T1,2
RET
GTHSOU: UMOVE T1,2 ; GET POINTER
MOVE JFN,[XCTBU [IDPB T2,T1]]
TLNN T1,777777 ; IF JFN DO THE JSYS
MOVE JFN,[BOUT]
TLC T1,777777 ; CHECK FOR LH -1
TLCN T1,777777
HRLI T1,(<POINT 7,0>) ; USE STANDARD POINTER
GTHSOL: ILDB T2,PTR
;**;[2618] Revamp code at GTHSOL: +1L JGZ 11-MAY-82
JUMPE T2,GTHSOX ;[2618] FINISH UP ON NULL
XCT JFN ;[2618] DO RIGHT OPERATION
JRST GTHSOL ;[2618] LOOP FOR ALL BYTES
GTHSOX: UMOVEM T1,2 ;[2618] UPDATE THE USER'S DESIGNATOR
TLNE T1,777777 ;[2618] JFN?
XCT JFN ;[2618] NO, STRING - DO THE NULL
RET ;[2618]
; Flush host
.FLHST::MCENT
MOVEI T2,SC%WHL!SC%OPR
TDNN T2,CAPENB
ITERR (WHELX1)
CALL CVNHST ;CONVERT HOST NUMBER
CALL HSTDED
CALL IMSRST
JRST MRETN
; Convert host number to string
.CVHST::MCENT
SETOB HN,DEV ;NO NAME YET
MOVE T1,T2 ;GET HOST NUMBER IN RIGHT PLACE
CALL GTHNTS ;CONVERT NUMBER TO STRING
JUMPL HN,[EMRETN(CVHST1)] ;STRING NOT FOUND
LOAD T1,HSTNMP,(HN)
MOVEI T1,HSTNAM-1(T1)
CALL JFNSS
JRST SKMRTN
; Set local host number routine. Takes old or new style number.
; Sets to new style, and puts it in NLHOST.
STHSTJ::MOVE T1,T2 ; To right AC
CALL CVNHST ; Put T1 into new host format
MOVEM T1,NLHOST ; Store it
CALL CVOHST ; Set the old format number too
MOVEM T1,NOHOST
RET
; Get net status
NETGST: HLRZ UNIT,FILSKT(JFN)
LOAD T1,ANFHS,(UNIT)
CALL CVOHST ; Convert to old host format
UMOVEM T1,3
HLLZ T1,NETSTS(UNIT)
MOVE T2,FSKT(UNIT)
UMOVEM T2,4
; Set net status
NETSST: RET
; ASSIGN BUFFERS IN NETWORK AREA
RESCD
ASNTBF::MOVE T1,FORKX ; IS THIS THE NCP FORK?
CAMN T1,NCPFRK
JRST ASNTB3 ; YES, GIVE HIM BUFFER IF WE CAN
MOVE T1,NETFRE+2 ; NO, GIVE BUFFER ONLY IF ABOVE ASNTHR
CAMG T1,ASNTHR
RET ; REFUSE REQUEST -- NOT ENOUGH SPACE
ASNTB3: CAMLE T2,MAXWPM ; BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
BUG (NETRBL)
AOS ASNTBC ; COUNT CALLS
NOINT
LOCK NETFRE+1 ;LOCK NETWORK BUFFER FREE LIST
MOVE T1,NETFRE ;GET POINTER TO CURRENT BUFFER
JUMPE T1,ASNTB2 ;THERE ISN'T ONE
HRL T2,0(T1) ;GET CURRENT SIZE FIELD
HRRM T2,0(T1) ;STASH REQUESTED SIZE
HLRZS T2 ;MOVE OLD SIZE FIELD TO RH, CLEARING LH
CAMG T2,MAXWPM ;MAKE SURE ITS NOT IN USE
BUG (NETBAU)
HLRZ T2,0(T1) ;GET POINTER TO NEXT ONE IN LIST
SKIPE T2 ;IS THIS LAST BUFFER ON CHAIN?
HRLI T2,ANBSEC ;NO...PUT ON SECTION ADDRESS
MOVEM T2,NETFRE ;THAT BECOMES FIRST ONE
AOS 0(P) ;INDICATE SUCCESS
MOVN T2,MAXWPM ;MAINTAIN TOTAL SPACE AS A MATTER
;OF INTEREST
ADDM T2,NETFRE+2
ASNTB2: UNLOCK NETFRE+1 ;UNLOCK FREE LIST
OKINT
RET
; RELEASE NETWORK BUFFERS
; (ALL AC'S PRESERVED)
RLNTBF::PUSH P,T1 ;SAVE T1
MOVE T1,NETFRE+3 ;GET LOWER BUFFER AREA BOUNDARIES
CAMGE T2,T1 ;RETURNED BUFFER .GE. LOWER BOUND?
JRST RLNTER ;NO, CRASH
MOVE T1,NETFRE+4 ;GET UPPER BOUND
CAML T2,T1 ;.LT. UPPER BOUND?
JRST RLNTER ;REPORT THE PASSING OF BAD ARGUMENTS
NOINT
LOCK NETFRE+1 ;LOCK FREE LIST
HRRZ T1,0(T2) ;GET COUNT FIELD
CAMLE T1,MAXWPM ;MAKE SURE NOT ALREADY ON FREELIST
BUG (NETBAF)
MOVE T1,-1(P) ;GET PC OF CALLER
HRL T1,NETFRE ;GET POINTER TO CURRENT FIRST BUFFER
MOVEM T2,NETFRE ;RETURNED ONE IS NOW FIRST
MOVEM T1,0(T2) ;AND POINTS TO OLD FIRST ONE
;SIZE FIELD IS PC OF CALLER
MOVE T1,MAXWPM ;MAINTAIN TOTAL SPACE COUNT
ADDM T1,NETFRE+2
UNLOCK NETFRE+1 ;UNLOCK FREE LIST
OKINT
JRST PA1 ;RESTORE T1 AND RETURN
RLNTER: ;HERE ON BAD ARGUMENTS TO RLNTBF
BUG(NETRBG) ;REPORT PASSING OF BAD ARGS
JRST PA1 ;RESTORE T1 AND RETURN
SWAPCD
; The following code and tables PROVIDE a finite state machine
; Implementation of the transitions and actions produced by various
; Events associated with a connection
; Assumed are that unit indexes the proper local socket
; Events are numbered as follows
RRFC==0 ; Received an rfc
CLSR==1 ; Cls for a receive socket
CLSS==2 ; Cls for a send socket
CLZR==3 ; Close done on a receive socket
CLZS==4 ; Close done on a send socket
ACPT==5 ; Program issued an accept
CONN==6 ; Program issued a connect
LISN==7 ; Program issued a listen
RRFN==10 ; Received a rfnm with no more data outstanding
HUNG==11 ; Time out event (happens 2 minutes after last dofsm)
RRFB==12 ; RECEIVED RFC WITH NON-MATCHING BYTE SIZE
; Actions are numbered as follows
ANOP==0 ; No operation
AFNY==1 ; No operation (unexpected event)
ACLS==2 ; Send cls
ARFC==3 ; Send rfc
AOPB==4 ; Send rfc and open link
AOPL==5 ; Open link
ACLL==6 ; Close link
ACLO==7 ; Close link and send cls
AEOR==10 ; END OF RECEIVE
AEOS==11 ; END OF SEND
AES1==12 ; END OF SEND WHEN ABORTED BY FOREIGN HOST
AABT==13 ; CONNECTION ABORTED BY FAR END
ACKA==14 ; CHECK ALLOCATION
; States are numbered as follows
DEAD==0 ; Never used
CLZD==1 ; Closed
PNDG==2 ; Pending. rfc received while closed
LSNG==3 ; Listening. listen issued while closed
RFCR==4 ; Rfc received while listening
CLW1==5 ; Close wait alternate. clzr from opnd
RFCS==6 ; Rfc sent
OPND==7 ; Opened
CLSW==10 ; Waiting for a cls
DATW==11 ; Waiting for all data to be sent
RFN1==12 ; Waiting for last rfnm
CLZW==13 ; Waiting for program close
RFN2==14 ; Waiting for rfnm after clss
NUSE==15 ; THIS STATE NO LONGER USED
FREE==16 ; Not in use
; The following table of byte pointers is used to get to the next state
; Given the current state and the event
; This table is indexed by event, the table addressed by this table
; Is indexed by old state
RADIX ^D10
QQ==3
CBPFSM: REPEAT 9,<
POINT 4,NXTSTT(T2),QQ
QQ==QQ+4>
QQ==3
REPEAT 9,<
POINT 4,NXTSTT+1(T2),QQ
QQ==QQ+4>
; Following table of pointers is used to get the action to be taken
; Given the current state and the event
; This table is indexed by event, the table addressed by this table
; Is indexed by old state
QQ==3
CBAFSM: REPEAT 9,<
POINT 4,ACTION(T2),QQ
QQ==QQ+4>
QQ==3
REPEAT 9,<
POINT 4,ACTION+1(T2),QQ
QQ==QQ+4
>
; This is the transition table
; Each word contains the new state for a given old state
; Successive bytes are used for different events
; Event rrfc clsr clss clzr clzs acpt conn lisn rrfe hung rrfb old state
NXTSTT:
BYTE (4)DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD ; Dead
BYTE (4)PNDG,CLZD,CLZD,CLZD,CLZD,CLZD,RFCS,LSNG,CLZD,CLZD,CLZD ; Clzd
BYTE (4)PNDG,FREE,FREE,PNDG,PNDG,PNDG,OPND,RFCR,PNDG,CLW1,PNDG ; Pndg
BYTE (4)RFCR,LSNG,LSNG,FREE,FREE,LSNG,LSNG,LSNG,LSNG,LSNG,CLSW ; Lsng
BYTE (4)RFCR,CLZW,CLZW,CLW1,CLW1,OPND,RFCR,RFCR,RFCR,RFCR,RFCR ; Rfcr
BYTE (4)CLW1,FREE,FREE,CLW1,CLW1,CLW1,CLW1,CLW1,CLW1,FREE,CLW1 ; Clw1
BYTE (4)OPND,CLZW,CLZW,CLW1,CLW1,RFCS,RFCS,RFCS,RFCS,CLSW,CLSW ; Rfcs
BYTE (4)OPND,CLZW,RFN2,CLW1,DATW,OPND,OPND,OPND,OPND,OPND,OPND ; Opnd
BYTE (4)CLSW,CLZW,CLZW,CLW1,CLW1,CLSW,CLSW,CLSW,CLSW,CLZW,CLSW ; Clsw
BYTE (4)DATW,DATW,RFN1,DATW,DATW,DATW,DATW,DATW,CLW1,CLW1,DATW ; Datw
BYTE (4)RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,FREE,FREE,RFN1 ; Rfn1
BYTE (4)CLZW,CLZW,CLZW,FREE,FREE,CLZW,CLZW,CLZW,CLZW,CLZW,CLZW ; Clzw
BYTE (4)RFN2,RFN2,RFN2,RFN1,RFN1,RFN2,RFN2,RFN2,CLZW,CLZW,RFN2 ; Rfn2
BYTE (4)NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE ; Nuse
BYTE (4)FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE ; Free
; This is the action table
; It is referenced the same as the transition table
; Event rrfc clsr clss clzr clzs acpt conn lisn rrfe hung rrfb old state
ACTION:
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY ; Dead
BYTE (4)ANOP,AFNY,AFNY,AFNY,AFNY,ANOP,ARFC,ANOP,AFNY,ANOP,AFNY ; Clzd
BYTE (4)AFNY,ACLS,ACLS,AFNY,AFNY,ANOP,AOPB,ANOP,AFNY,ACLS,AFNY ; Pndg
BYTE (4)ANOP,AFNY,AFNY,ANOP,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,ACLS ; Lsng
BYTE (4)AFNY,ACLS,ACLS,ACLS,ACLS,AOPB,AFNY,AFNY,AFNY,ANOP,AFNY ; Rfcr
BYTE (4)AFNY,ACLL,ACLL,AFNY,AFNY,ANOP,AFNY,AFNY,AFNY,ACLL,AFNY ; Clw1
BYTE (4)AOPL,ACLS,ACLS,ACLS,ACLS,ANOP,AFNY,AFNY,AFNY,ACLS,ACLS ; Rfcs
BYTE (4)AFNY,AEOR,AES1,ACLS,AEOS,ANOP,AFNY,AFNY,AFNY,ACKA,AFNY ; Opnd
BYTE (4)ANOP,ANOP,ANOP,ANOP,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY ; Clsw
BYTE (4)AFNY,AFNY,AES1,AFNY,AFNY,ANOP,AFNY,AFNY,ACLS,ACLS,AFNY ; Datw
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,ANOP,AFNY,AFNY,ACLO,ACLO,AFNY ; Rfn1
BYTE (4)AFNY,AFNY,AFNY,ACLL,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY ; Clzw
BYTE (4)AFNY,AFNY,AFNY,ANOP,ANOP,ANOP,AFNY,AFNY,ACLO,ACLO,AFNY ; Rfn2
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY ; Nuse
BYTE (4)AFNY,AFNY,AFNY,ANOP,ANOP,AABT,AFNY,AFNY,AFNY,ANOP,AFNY ; Free
;DISPATCH TABLE FOR ACTIONS
;ROUTINES ARE CALLED EFFECTIVELY BY CALL @ACTAB(ACTION#)
ACTAB: IFIW!R ;NOP
IFIW!FUNNY ;UNEXPECTED EVENT
IFIW!SNDCLS ;SEND CLS
IFIW!SNDRFC ;SEND STR OR RTS
IFIW!NETOPB ;SNED RFC AND OPEN LINK
IFIW!NETOPL ;OPEN LINK
IFIW!NETCLL ;CLOSE LINK
IFIW!NETCLB ;CLOSE LINK AND SEND CLS
IFIW!DOEOR ;FINISH UP INPUT
IFIW!DOEOS ;FINISH UP OUTPUT
IFIW!DOES1 ;END OF SEND IF TRANSMISSION ABORTED
IFIW!DOABT ;ACCEPT ON ABORTED CONNECTION
IFIW!CKALL ;ALLOCATIN CHECK FOR OPENED CONN
RADIX 8
;UNEXPECTED EVENT
; T1/ EVENT
; UNIT/ UNIT INDEX
FUNNY: HLL T1,NETSTS(UNIT) ;GET STATUS
LOAD T2,ANFHS,(UNIT) ;GET FOREIGN HOST
BUG(NCPFUN,<<T1,D>,<T2,D>,<UNIT,D>>)
AOS FUNNYC ;COUNT THEM
MOVE T1,T2
SETZ T2,
JRST NCPERR ;AND SEND TYPE 0 ERR
; ACCEPTED AN ABORTED REQUEST
DOABT: MOVX IOS,EOTF ; SET FLAG TO CAUSE ERROR
IORB IOS,NETSTS(UNIT) ; IN STATUS WORD
RET
; CHECK ALLOCATION
CKALL: MOVE T1,LSKT(UNIT)
TRNN T1,1 ; SEND SOCKET?
RET ; NO. DO NOTHING
TQNE <ALLFF> ; Allocation failure??
TQNN <CLZF> ; BEING CLOSED?
JRST CKALL1 ; NO, IGNORE
TQO <ERRB,EOTF> ; SIGNAL ERROR, AND STOP TRANSMISSION
HLLM IOS,NETSTS(UNIT)
RET
CKALL1: LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
LOAD T2,ANBSIZ,(UNIT)
CAMG T2,NETBAL(UNIT) ; SUFFICIENT BIT ALLOCATION?
SKIPN IMPLT4(T1) ; AND MESSAGE SPACE?
JRST CKALL2 ; NO
TQZ <ALLFF>
HLLM IOS,NETSTS(UNIT)
RET
CKALL2: LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALL IMPSYN ; RESYNC ALLOCATION
MOVX IOS,ALLFF
IORB IOS,NETSTS(UNIT) ; REMEMBER WE DID THIS ONCE
RET
; END OF SEND
DOES1: CALL DOEOS
CALLRET IMPABL ; FLUSH QUEUED MESSAGES
DOEOS: MOVX IOS,EOTF
IORB IOS,NETSTS(UNIT)
LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
CALLRET IMPSDB ; SET DONE BIT IN LINK TABLE
; End of receive
DOEOR: CALL SNDCLS
HRRZ T2,NETBUF(UNIT)
JUMPE T2,DOEOS
CAIL T2,1000
JRST DOEOS
CALL DOEOS ; DO SAME AS END OF SEND
NCPON ; NCP BACK ON SO NVTDET CAN USE IT
EORNV0: HRRZ T2,NETBUF(UNIT) ; PICK UP LINE NUMBER
JUMPE T2,EORNV1 ;ALREADY GONE
PUSH P,UNIT
CALL LCKDVL ;LOCK DEVICE LOCK, GO NOINT
CALL NVTDTT
JRST EORNV2 ;FAILURE
EORNV3: UNLOKK DEVLKK ;UNLOCK THE DEVICE LOCK
OKINT ;DEVLCK WENT NOINT
POP P,UNIT
EORNV1: NCPOFF ; BACK OFF SO CALLER IS NOT CONFUSED
RET
EORNV2: TXZN T1,1B0 ;WAIT OR ERROR?
JRST [ BUG (NETDET,<<T1,D>>)
JRST EORNV3] ;GO CLEAN UP
UNLOKK DEVLKK ;UNLOCK THE DEVICE LOCK
OKINT ;DEVLKK WENT NOINT
POP P,UNIT
HRL T1,NETBUF(UNIT) ;GET TTY NUMBER
MDISMS ;WAIT UNTIL DEALLOCATE IS POSSIBLE
JRST EORNV0 ;GO TRY AGAIN
; Close link
NETCLL: LOAD T1,LTIDX,(UNIT) ;GET LINK TABLE INDEX
TQZE <LINKF> ;IS IT VALID?
CALL IMPCLL ;YES
MOVEM IOS,NETSTS(UNIT) ;SAVE STATUS
RET
NETCLB: CALL NETCLL
SNDCLS: LOAD T1,ANFHS,(UNIT) ; Get foreign host
MOVE T2,LSKT(UNIT) ; And local socket
MOVE T3,FSKT(UNIT) ; And foreign socket
TQNN <DEDF>
CALL IMPCLS ; Send the control message
RET
; OPEN LINK
NETOPL: LOAD T1,ANFHS,(UNIT)
LOAD T2,ANLNK,(UNIT)
LOAD T3,ANBSIZ,(UNIT)
MOVE T4,LSKT(UNIT)
TRNE T4,1 ; Send socket?
JRST NETOPS ; Yes, open send link
CALL IMPOPL ; No, open a receive link
SKIPA
NETOPS: CALL IMPOPS ; Open a send link
STOR T1,LTIDX,(UNIT) ; Keep the link index
MOVX IOS,LINKF ;GET VALID BIT
IORB IOS,NETSTS(UNIT) ;MARK IT AS VALID
RET
; Send rfc and open link
NETOPB: CALL NETOPL
; Send rfc
SNDRFC: TQNE <DEDF>
RET
LOAD T1,ANFHS,(UNIT) ; Get foreign host
MOVE T2,LSKT(UNIT) ; And local socket
MOVE T3,FSKT(UNIT)
LOAD T4,ANBSIZ,(UNIT) ; Byte size
TRNE T2,1
JRST IMPSTR
LOAD T4,ANLNK,(UNIT)
CAIG T4,LLINK ; is this a legal NCP link number?
CAIGE T4,FNLINK
BUG(IMPBLK,<<T4,LINK>>) ; no
JRST IMPRTS ; Send control message
; This here is the main fsm routine
DOFSM: MOVE IOS,NETSTS(UNIT)
TQNN <DEDF>
JRST DOFSMA
CALL DOFSMA
LOAD T1,ANFSM,(UNIT)
DOFSMB: PUSH P,T1
MOVEI T1,HUNG
CALL DOFSMA
LOAD T1,ANFSM,(UNIT)
POP P,T2
CAME T1,T2
JRST DOFSMB
RET
DOFSMA: NCPOFF ; Allow no control messages while here
MOVEI T2,^D24 ; Time out in 2 minutes
STOR T2,ANCLKS,(UNIT)
LOAD T2,ANFSM,(UNIT) ; Get old state
MOVE T4,T2 ; Save old state
LSH T2,1 ; Two words per old state
LDB T3,CBPFSM(T1) ; Get new state
STOR T3,ANFSM,(UNIT)
LDB T2,CBAFSM(T1) ; Get action
CAME T3,T4 ; State changed?
CALL STCPSI ; GENERATE STATE CHANGE PSI
MOVE IOS,NETSTS(UNIT) ;GET STATUS OF THE LINK
CALL @ACTAB(T2) ; Call action routine
NCPON
RET
; Generate state change PSI
STCPSI: SAVET
LOAD T1,ANPVST,(UNIT) ; Save previous 4 states
LSH T1,4
IOR T1,T4
STOR T1,ANPVST,(UNIT) ; Save previous state
HRRE T1,NETFRK(UNIT)
JUMPL T1,R ; No fork for interrupts
LOAD T2,ANFSPI,(UNIT) ; Get psi channel
CAIL T2,^D36
RET
EXCH T1,T2
CALLRET PSIRQ
; Make a socket or find existing one
GETSKT: TDZA T4,T4
MAKSKT: SETO T4,
PUSH P,T4
PUSH P,T1 ; Save foreign host
PUSH P,T2 ; Save foreign socket
PUSH P,T3 ; Save local socket
MOVE UNIT,T3
XOR UNIT,T2
TRNN UNIT,1 ; Homosexual?
JRST MAKSKX ; Yes, go tell Anita
ROT T3,-4
MOVS UNIT,T3
IMULI T3,123431
XOR UNIT,T3 ; Randomize from local socket
LSH UNIT,-1
MULI UNIT,NSKT ; Initial probe
MOVEI T4,NSKT
SETO T3,
NCPOFF
MAKSKL: LOAD T1,ANFSM,(UNIT) ; Get state of this socket
CAIE T1,FREE
CAIN T1,DEAD
JRST MAKSK1
CAIN T1,CLZW ; WAITING FOR USER TO CLOSE?
JRST MAKSKN ; YES. DON'T PICK THIS ONE
MOVE T2,LSKT(UNIT) ; What local socket is this for?
CAME T2,(P)
JRST MAKSKN ; Not the one we're after, try next
SKIPGE -2(P)
JRST MAKSK6
LOAD T2,ANFHS,(UNIT)
MOVE T1,FSKT(UNIT)
JUMPL T2,[SKIPN -3(P) ; Was getskt called?
JRST MAKSKN ; Yes, getskt called
POP P,T3 ; Makskt...suceed
JRST MAKSKF]
CAMN T2,-2(P)
CAME T1,-1(P)
JRST MAKSKN ; Foreign host or socket doesn't match
AOS -4(P) ; EVERYTHING MATCHES. SKIP RETURN
NCPON
JRST MAKSKV ; NCPON, POP STACK
MAKSK6: POP P,T3
SUB P,BHC+3
MOVE T2,FSKT(UNIT)
LOAD T1,ANFHS,(UNIT)
NCPON
RETSKP
MAKSKN: SOJLE T4,MAKSKE ; Full, error
SOJGE UNIT,MAKSKL ; Loop back for next slot
MOVEI UNIT,NSKT-1
JRST MAKSKL
MAKSK1: SKIPGE T3
MOVE T3,UNIT ; Save where it's at
CAIE T1,DEAD
JRST MAKSKN ; Space keeper, test next
MAKSK5: SKIPN -3(P)
JRST MAKSKR
MOVE UNIT,T3
SETZM NETHST(UNIT)
SETZM NETSTS(UNIT)
SETZM NETBUF(UNIT)
SETZM NETAWD(UNIT)
SETZM NETBAL(UNIT)
SETZM NETBTC(UNIT)
SETOM NETFRK(UNIT)
MOVEI T1,CLZD
STOR T1,ANFSM,(UNIT) ; Set its state to be closed
POP P,T3
MOVEM T3,LSKT(UNIT)
MAKSKF: MOVE T1,-1(P) ; Foreign host
MOVE T2,LSKT(UNIT)
TRNE T2,1 ; Receive?
JRST MAKSKQ
CALL ASNLNK ; Assign link for that host
JRST [ LOAD T1,ANFSM,(UNIT)
MOVEI T2,FREE
CAIN T1,CLZD ; Just created?
STOR T2,ANFSM,(UNIT) ; Yes, delete it
PUSH P,LSKT(UNIT)
JRST MAKSKR] ; And fail
MAKSKQ: POP P,T2 ; Common for old and new
MOVEM T2,FSKT(UNIT)
POP P,T1
STOR T1,ANFHS,(UNIT)
SUB P,BHC+1
NCPON
RETSKP
MAKSKE: JUMPGE T3,MAKSK5
TDZA T1,T1 ; FULL
MAKSKR: MOVEI T1,4 ; NON-EXISTENT
NCPON
SKIPA ; RETURN 0 OR FOUR ERROR CODE
MAKSKX: MOVEI T1,3 ; BAD PARAMETERS
MOVEM T1,-1(P) ; STORE ERROR CODE
MAKSKV: POP P,T3
POP P,T2
POP P,T1
SUB P,BHC+1
RET
; Assign link number for this connection
ASNLNK: SAVET
MOVEI T4,1(P) ; Where bits will be
PUSH P,[<1B<FNLINK>-1>_1+1]
REPEAT NLNKBW-2,<PUSH P,[-1]>
PUSH P,[-<1B<LLINK-<^D36*<NLNKBW-1>>>>]
PUSH P,UNIT ; Preserve unit
PUSH P,T1
MOVSI UNIT,-NSKT
ASNLNL: LOAD T1,ANFSM,(UNIT)
CAIE T1,FREE
CAIN T1,DEAD
JRST ASNLNN
LOAD T1,ANFHS,(UNIT)
CAME T1,0(P) ; Check all connection to this host
JRST ASNLNN ; Get next
MOVE T1,LSKT(UNIT)
TRNE T1,1 ; Only receive connections
JRST ASNLNN
LOAD T1,ANLNK,(UNIT) ; Get link assigned
IDIVI T1,^D36 ; Separate word and bit
MOVE T2,BITS(T2) ; Get the bit
ADD T1,T4
ANDCAM T2,0(T1) ; Clear bits for links in use
ASNLNN: AOBJN UNIT,ASNLNL ; Loop thru all connections
HRLI T4,-NLNKBW ; Prepare to look at all bits
SETZ T3,
ASNLNC: MOVE T1,0(T4)
JFFO T1,ASNLNF
ADDI T3,^D36
AOBJN T4,ASNLNC
RET
ASNLNF: ADD T2,T3
POP P,T1
POP P,UNIT
STOR T2,ANLNK,(UNIT)
SUB P,BHC+NLNKBW
RETSKP
; Do a listen (openf for file with no foreign host/socket)
LISTEN: CALL HSTCHK
RET
PUSH P,T4 ; Save byte size
CALL MAKSKT ; Make a socket
JRST [ POP P,T4
MOVEI T1,OPNX10
RET] ; No room
MOVEI T1,LISN
JRST CONNE1
; Do a connect (openf for file with foreign host/socket specified)
CONNEC: CALL HSTCHK
RET
PUSH P,T4 ; Save byte size
CALL MAKSKT ; Make a socket or find existing one
JRST [ POP P,T4
MOVEI T1,OPNX10
RET] ; No room
MOVEI T1,CONN
CONNE1: NCPOFF
LOAD T2,ANFSM,(UNIT)
CAIN T2,CLZD ; Received any rfc here?
JRST CONNE2 ; No
CAIN T2,PNDG ; Same question
JRST CONNE3 ; Yes
MOVEI T1,OPNX9 ; Already in use
POP P,T4
NCPON
RET
CONNE2: MOVX T4,PROGF
IORM T4,NETSTS(UNIT) ; Mark as attached to program
NCPON
POP P,T4 ; My choice of byte size
STOR T4,ANBSIZ,(UNIT) ; Set byte size
CALL DOFSM ; Send rfc etc
RETSKP
CONNE3: TRNE T3,1 ; Are we sender?
JRST CONNE2 ; Also our choice
LOAD T4,ANBSIZ,(UNIT) ; Get his byte size
CAMN T4,0(P) ; Does byte size agree?
JRST CONNE2 ; Yes, same as if my choice
NCPON
MOVEI T1,HUNG ; Flush his connection attempt
CALL DOFSM
POP P,T4
MOVEI T1,OPNX22 ; Bad byte size error
RET
; Check if host is available
HSTCHK: SKIPL IMPRDY
JRST [ MOVEI T1,OPNX19
RET]
JUMPL T1,RSKP ; ALWAYS OK IF LISTEN
CALL HSTCK0 ; CHECK THE HOST
JRST [ MOVEI T1,OPNX20 ; NO RESPONSE
RET]
JRST RSKP ; UP AND READY
HSTCK0: SAVET
LDB T2,[POINT 8,T1,19]
CAIL T2,FKHOST
RET
CALL HSTHSH ; Get the host index
JRST RSKP ; No room, try anyway
SKIPGE HSTSTS(T2) ; Up?
RETSKP ; Yes
PUSH P,T2
CALL IMSRST ; Reset him
POP P,T2
MOVEI T3,^D10 ; Wait 5 sec
HSTCK1: MOVEI T1,^D500 ; Wait
DISMS
SKIPGE HSTSTS(T2) ; Up?
RETSKP
SOJG T3,HSTCK1
RET
; Routines to call when control messages are received
; Receive cls
; Reccls(fhost,fskt,lskt)--nil
RECCLS::CALL GETSKT ; Get the socket entry
JRST NCPERR
RECCL1: MOVE T2,LSKT(UNIT)
TRNN T2,1
SKIPA T1,[CLSR]
MOVEI T1,CLSS
CALLRET DOFSM
; RECEIVED INCORRECT MESSAGE
; REPLY WITH ERR
NCPERR: SAVET
SAVEQ
MOVE T3,I8COP ; GET LAST OP CODE
MOVE HN,[I8CAL,,T4] ; COMPLAIN ABOUT LAST CONTROL MESSAGE
BLT HN,HN
CALLRET IMPERR
; Receive str
; Recstr(fhost,fskt,lskt)--nil
RECSTR::PUSH P,T4 ; Save byte size
RCSTR0: CALL MAKSKT
JRST [ POP P,T4
JRST NCPERR]
MOVE T4,0(P)
CALL CHKSKT ; MAKE SURE THIS SOCKET NOT IN USE
JRST RCSTR0 ; IT WAS. DELETED. NOW TRY AGAIN.
LOAD T1,ANFSM,(UNIT) ; What is state of this connection
CAIE T1,CLZD ; If not clzd
JRST [ LOAD T4,ANBSIZ,(UNIT) ; Then get user's byte size
CAMN T4,0(P) ; If not the same
JRST .+1
MOVEI T1,RRFB ; RECEIVED BAD BYTE SIZE
CALL DOFSM
MOVX T1,ERRB
IORM T1,NETSTS(UNIT)
POP P,T4
RET]
POP P,T4
STOR T4,ANBSIZ,(UNIT)
MOVEI T1,RRFC
CALL DOFSM
MOVE T1,UNIT
LOAD T2,ANLNK,(UNIT)
RET
CHKSKT: SAVET
LOAD T1,ANFSM,(UNIT) ; GET STATE
CAIE T1,RFCS ; STATES WHERE RFC IS EXPECTED
CAIN T1,CLZD
RETSKP
CAIN T1,LSNG
RETSKP
CALLRET SK2DWN ; KILL THE OLD ONE
CHKLNK: SAVET
STKVAR<CHKLLK,CHKLHS>
MOVEM T1,CHKLHS
MOVEM T4,CHKLLK
MOVSI UNIT,-NSKT
CHKLK1: LOAD T2,ANLNK,(UNIT) ; GET THE LINK
LOAD T3,ANFHS,(UNIT) ; AND HOST
CAMN T2,CHKLLK
CAME T3,CHKLHS
JRST CHKLK2
MOVE T2,LSKT(UNIT)
TRNN T2,1
JRST CHKLK2 ; SKIP SEND CONNECTIONS
LOAD T2,ANFSM,(UNIT) ; LINK-HOST MATCHES. GET STATE
CAIE T2,DEAD
CAIN T2,FREE
JRST CHKLK2
CAIE T2,CLZD
CAIN T2,RFCS
JRST CHKLK2
CAIE T2,LSNG
CAIN T2,CLZW
JRST CHKLK2
CALL SK2DWN
CHKLK2: AOBJN UNIT,CHKLK1
RET
; Receive rts
; Recrts(fhost,fskt,lskt,link)
RECRTS::CALL CHKLNK ; CHECK AND DELETE ANY MATCHING LINKS
PUSH P,T4 ; SAVE LINK
CALL MAKSKT ; MAKE SOCKET TABLE ENTRY
JRST [ POP P,T4 ; FAILED, SEND ERR
JRST NCPERR]
POP P,T4 ; RESTORE LINK
CALL CHKSKT ; MAKE SURE NO DUPLICATES
JRST RECRTS ; PREVIOUS CONNECTION CLOSED. TRY AGAIN
STOR T4,ANLNK,(UNIT)
MOVEI T1,RRFC
CALLRET DOFSM
; Receive rfnm
RCFRFN::MOVEI T1,RRFN
CALLRET DOFSM
; Receive ins/inr
RECINR::
RECINS::LOAD T2,ANINPI,(UNIT)
LOAD T1,ANFSM,(UNIT)
CAIGE T2,^D36 ; RETURN IF CHANNEL IS 77 OCTAL
CAIE T1,OPND
RET
HRRZ T1,NETBUF(UNIT)
SKIPE T1
CAIL T1,1000
CAIA
RET
HRRE T1,NETFRK(UNIT)
JUMPL T1,R
EXCH T1,T2
CALLRET PSIRQ
; INITIATE SERVICE INTERRUPTION (HOST DEAD)
SVCINT::MOVX IOS,SVCIF
IORB IOS,NETSTS(UNIT)
CALLRET STCPSI ; GENERATE STATE CHANGE PSI
; TERMINATE SERVICE INTERRUPTION
SVCRST::MOVX IOS,SVCIF
ANDCAB IOS,NETSTS(UNIT)
CALLRET STCPSI
; Receive reset message
RECRST::CALL NETHDN
JRST IMPRRP
; Kill all connection -- net is down
NETDWN::MOVSI UNIT,-NSKT
CALL SKTDWN
AOBJN UNIT,.-1
; Periodic check of all connections for time-out
NETCHK::MOVSI UNIT,-NSKT
NETCKL: LOAD T1,ANFSM,(UNIT)
CAIE T1,DEAD
CAIN T1,FREE
JRST NETCKN
MOVX T1,DEDF
TDNN T1,NETSTS(UNIT)
SKIPL IMPRDY
JRST NETCK1
LOAD T2,ANCLKS,(UNIT)
SOS T2
STOR T2,ANCLKS,(UNIT)
JUMPG T2,NETCKN
NETCK1: MOVEI T1,HUNG
CALL DOFSM
NETCKN: AOBJN UNIT,NETCKL
MOVEI T1,^D5000
SKIPL IMPRDY
MOVEI T1,^D500
ADD T1,TODCLK
MOVEM T1,NETTIM
RET
; Host has died
NETHDN::MOVSI UNIT,-NSKT
PUSH P,T1
NETHDL: LOAD T1,ANFSM,(UNIT)
CAIE T1,FREE
CAIN T1,DEAD
JRST NETHDX
LOAD T1,ANFHS,(UNIT)
CAMN T1,(P)
CALL SKTDWN
NETHDX: AOBJN UNIT,NETHDL
POP P,T1
RET
SK2DWN::HRRZ T2,NETBUF(UNIT)
CALL NVTCHK ; AN NVT?
JRST SKTDWN ; NO, TREAT NORMALLY
PUSH P,UNIT
PUSH P,T2
CALL SKTDWN
MOVE T2,0(P)
CALL NVTIPU ;GET INPUT UNIT
TRNA ;NO UNITS FOR THIS LINE
CALL SKTDWN ; CLOSE THE OTHER HALF
POP P,T2 ;GET ADDRESS OF DYNAMIC DATA FOR TTY
CALL ULKTTY ;UNLOCK DATA BASE
POP P,UNIT
RET
SKTDWN: LOAD T1,ANFSM,(UNIT) ; GET STATE
CAIN T1,LSNG ; IF LSNG
RET ; IGNORE
MOVX T2,ERRB!DEDF
IORM T2,NETSTS(UNIT)
CAIE T1,CLSW ; IF WAITING FOR CLOSE,
CAIN T1,CLW1
CALL SKTDW2 ; PRETEND ONE HAPPENED.
CAIE T1,RFCR
CAIN T1,OPND ; If opnd
SKTDW2: CALL RECCL1 ; Simulate receipt of cls
MOVEI T1,HUNG
CALLRET DOFSM
HSTINI::SAVEPQ
MOVX T1,<GJ%OLD+GJ%SHT>
HRROI T2,[ASCIZ /SYSTEM:HSTNAM.TXT/]
GTJFN
RET
MOVE JFN,T1
MOVE T2,[7B5+OF%RD]
OPENF
JRST [ MOVE T1,JFN
RLJFN
TRN
RET]
SETZB HN,HSTNAM ; CLEAR OLD STUFF IN TABLE
MOVSI T4,HSTNAM ; (TELNET FAILS IF THIS ISN'T DONE
HRRI T4,HSTNAM+1 ; AND IT LOOKS NEATER TO HAVE WHOLE
BLT T4,HSTNAM+NHSTN-1 ; WORD OF NULL AFTER EACH NAME)
MOVSI T4,-NHOSTS ; CLEAR HOST TABLES
HSTCLR: SETZM HOSTN(T4)
HLLZS HSTSTS(T4) ; PRESERVE HOST UP BIT
SKIPGE IMPRDY ; IF NET IS UP
JRST HSTCL1
SETZM HOSTNN(T4)
SETZM HSTSTS(T4)
HSTCL1: AOBJN T4,HSTCLR
SETZ PTR,
LUP0: MOVE T1,JFN
CALL GCH
JRST DONE
MOVE UNIT,T3 ; SAVE IN CASE THIS IS ALINE
CAIN T2,.CHLFD
JRST LUP0
CAIGE HN,NHOSTS
CAIL PTR,NHSTN
JRST FULL
BKJFN
TRN
RFPTR
TRN
MOVE STS,T2
MOVEI T3,10
NIN
JRST [ HRLI T4,[ASCIZ /Bad number/]
MOVE T3,STS
JRST SYNERR]
MOVE T1,T2
CALL CVNHST ;GET NEW FORMAT IF NEEDED
CALL HSTHSH
JUMPL T2,FULL
MOVE DEV,T2
MOVEM T1,HOSTNN(DEV)
STOR DEV,HSTIDX,(HN)
MOVE T1,JFN
BKJFN
TRN
CALL GCH
JRST PEOF
CAIE T2,","
JRST [ HRLI T4,[ASCIZ /Missing comma after host number/]
JRST SYNERR]
MOVEI T4,HSTNAM(PTR)
HRLI T4,(<POINT 7,0>)
MOVEI STS,MAXLC ; MAX OF 39 CHAR IN HOST NAME
LUP1: CALL GCH ; READ NEXT CHARACTER
JRST PEOF
CAIE T2,.CHLFD ; TERMINATE ON END OF LINE
CAIN T2,","
SETZ T2, ; OR COMMA
IBP T4
HRRZ T1,T4 ; WHERE ARE WE GOING TO PUT THIS?
CAIL T1,HSTNAM+NHSTN ; OFF END OF TABLE?
JRST FULL ; YES, SAY FULL
DPB T2,T4 ; STORE THE BYTE
SOSLE STS ; DON'T STORE ANYMORE CHARACTERS
JUMPN T2,LUP1 ; LOOP IF NOT THE END
MOVE T1,JFN
BKJFN ; GET THE TERMINATOR AGAIN
TRN
MOVX STS,HS%NAM ; THIS HOST HAS A NAME
LUP2: CALL GCH
JRST PEOF
LUP2A: CAIN T2,.CHLFD
JRST LUP2X ; DONE IF END OF LINE
CAIE T2,"," ; SCAN UNTIL COMMA FOUND
JRST LUP2
CALL GCH ; GET FIRST LETTER OF WORD
JRST PEOF
CAIN T2,","
JRST LUP2A ; JUMP IF NULL WORD
CAIN T2,12
JRST LUP2X ; DONE IF END OF LINE
SETZ T1, ; PUT VALUE OF WORD HERE
CAIN T2,"A"
MOVX T1,.HSANT
CAIN T2,"D"
MOVX T1,.HSDEC
CAIN T2,"E"
MOVX T1,.HSELF
CAIN T2,"I"
MOVX T1,.HSITS
CAIN T2,"M"
JRST [ CALL GCH
JRST PEOF
CAIN T2,"U"
MOVX T1,.HSMLT
CAIN T2,"T"
MOVX T1,.HSMTP
JRST ELUP3]
CAIN T2,"N"
JRST [ CALL GCH
JRST PEOF
CAIN T2,"E"
MOVX T1,HS%NEW
CAIN T2,"I"
MOVX T1,HS%NCK ;FLAG AS NICKNAME
JRST ELUP3]
CAIN T2,"S"
MOVX T1,HS%SRV
CAIN T2,"T"
JRST [ CALL GCH
JRST PEOF
CAIN T2,"E"
MOVX T1,.HS10X
CAIN T2,"I"
MOVX T1,.HSTIP
CAIN T2,"O"
MOVX T1,.HST20
JRST ELUP3]
CAIN T2,"U"
JRST [ CALL GCH
JRST PEOF
CAIN T2,"N"
MOVX T1,.HSUNX
CAIN T2,"S"
MOVX T1,HS%USR
JRST ELUP3]
ELUP3: HRLI T4,[ASCIZ /Unrecognized flag name/]
JUMPE T1,SYNERR ; JUMP IF NO MATCH FOUND
MOVX T2,HS%STY
HRLI T4,[ASCIZ /Multiple system type specification/]
TDNE T2,STS ; ALREADY HAVE A SYSTEM TYPE?
TDNN T2,T1 ; YES AND IS THIS TRYING TO SET IT?
TRNA
JRST SYNERR ; YES. ERROR
IOR STS,T1 ; ACCUMULATE BITS
JRST LUP2 ; AND SKIP TO COMMA/EOL
LUP2X: STOR PTR,HSTNMP,(HN) ; STORE NAME POINTER
MOVEI PTR,1-HSTNAM(T4)
MOVX T4,<1B0> ; NICKNAME FLAG (MUST BE B0)
TXZE STS,HS%NCK ; A NICKNAME?
IORM T4,HOSTN(HN) ; SET FLAGS
HRRM STS,HSTSTS(DEV) ; STORE STATUS
AOJA HN,LUP0
PEOF: MOVE T1,JFN
RFPTR
TRN
MOVE T3,T2
HRLI T4,[ASCIZ /Premature end of file/]
SYNERR: HLRO T1,T4
PSOUT
HRROI T1,[ASCIZ / in host descriptor file
/]
PSOUT
MOVE T2,UNIT
MOVE T1,JFN
SFPTR ; SET BACK TO BEGINNING OF LINE
TRN
SETO UNIT,
PERLP: MOVE T1,JFN
RFPTR
TRN
CAME T2,T3
JRST PERLP1
MOVEI T1,.PRIOU
RFPOS
HRRZ UNIT,T2
PERLP1: MOVE T1,JFN
CALL GCH1
MOVEI T2,.CHLFD
CAIN T2,.CHLFD
JRST PERLPX
MOVE T1,T2
PBOUT
JRST PERLP
PERLPX: HRROI T1,[ASCIZ /
/]
PSOUT
JUMPLE UNIT,PMRK
MOVEI T1," "
PBOUT
SOJG UNIT,.-1
PMRK: MOVEI T1,"^"
PBOUT
HRROI T1,[ASCIZ /
/]
PSOUT
JRST LUP0
FULL: HRROI T1,[ASCIZ /Host tables full before end of file
/]
PSOUT
DONE: CLOSF
TRN
MOVNM HN,MHOSTS ; SAVE -NUMBER OF HOST NAMES
CALL SWPMWE ; WRITE ENABLE SWAP MON
MOVN HN,MHOSTS ; SWPMWE CLOBBERES IT
HRLM HN,GTTAB+.HOSTN ; LENGTH OF HOSTN TABLE
HRLM PTR,GTTAB+.HSTNA ; LENGTH OF HSTNAM TABLE
CALL SWPMWP ; WRITE PROTECT
RETSKP
GCH: MOVE T1,JFN
RFPTR
TRN
MOVE T3,T2
GCH2: CALL GCH1
RET
CAIN T2,";"
JRST GCHSMC
CAIE T2,.CHTAB
CAIN T2," "
JRST GCH2
RETSKP
GCH1: CALL GBIN
RET
CAIE T2,.CHCRT
CAIN T2,.CHFFD
JRST GCH1
RETSKP
GCHSMC: CALL GBIN
RET
CAIN T2,.CHLFD
RETSKP
JRST GCHSMC
GBIN: BIN ;GET A CHAR
JUMPN T2,RSKP
GTSTS ;NULL SO CHECK FOR ERR OR EOF
TXNN T2,<GS%EOF+GS%ERR>
JRST GBIN ;FLUSH NULLS
RET
TNXEND
END