Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99T-BB_1990 - 10,7/mon/latser.mac
There are 10 other files named latser.mac in the archive. Click here to see a list.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1986,1988,1990.
;ALL RIGHTS RESERVED.

IFNDEF FTOPS20,<FTOPS20==0>
IFNDEF FTOPS10,<FTOPS10==1>

	SALL

IFN FTOPS20,<
	SEARCH	MACSYM,MONSYM,PROLOG,TTYDEF
	SEARCH	NIPAR

	TTITLE	(LATSRV,,< -- LAT-20 Terminal Host>)

	XRESCD			;[7.1024]
>

IFN FTOPS10,<
	SEARCH	F,S,D36PAR,MACSYM
	SEARCH	ETHPRM

.CPYRT<1985,1990>
	TITLE	LATSER -- LAT-10 Terminal Host

	$RELOC
	$HIGH			;SO BEGSTR DOESN'T OVERLAY LOW SEG WITH JUNK

	XP	VLATSER,6	;PUT VERSION NUMBER IN STORAGE MAP AND GLOB
>
	SUBTTL	Table of Contents


;		Table of Contents for LATSER
;
;
;			   Section			      Page
;   1. Definitions - Literals - Circuit Parameters. . . . . .    3
;   2. Definitions - Literals - Slot Parameters . . . . . . .    4
;   3. External References. . . . . . . . . . . . . . . . . .    5
;   4. Definitions - Data Structures. . . . . . . . . . . . .    7
;   5. CIRCUIT BLOCK data structure definitions . . . . . . .    8
;   6. SLOT BLOCK data struction definitions. . . . . . . . .   10
;   7. Miscellaneous Structure Definitions. . . . . . . . . .   11
;   8. Symbol Definitions
;        8.1.   Macros MIN.,MAX.,MAXENT . . . . . . . . . . .   12
;   9. LATOP% JSYS
;        9.1.   Definitions . . . . . . . . . . . . . . . . .   13
;        9.2.   Entry point . . . . . . . . . . . . . . . . .   15
;        9.3.   SET/CLEAR Functions . . . . . . . . . . . . .   16
;        9.4.   SET/CLEAR SERVICE . . . . . . . . . . . . . .   17
;        9.5.   SET LAT HOST NAME . . . . . . . . . . . . . .   19
;        9.6.   SET/CLEAR HOST IDENTIFICATION STRING. . . . .   20
;        9.7.   SET/CLEAR HOST GROUP CODES. . . . . . . . . .   21
;        9.8.   SET MAXIMUM CIRCUITS. . . . . . . . . . . . .   22
;        9.9.   SHOW CHARACTERISTIC HOST. . . . . . . . . . .   24
;        9.10.  SHOW TERMINAL CONNECTS. . . . . . . . . . . .   26
;        9.11.  SHOW SERVERS. . . . . . . . . . . . . . . . .   27
;        9.12.  SHOW/ZERO COUNTERS. . . . . . . . . . . . . .   28
;        9.13.  Utility Routines
;             9.13.1.    FNDSRV . . . . . . . . . . . . . . .   29
;             9.13.2.    GTSRVR . . . . . . . . . . . . . . .   30
;             9.13.3.    SCMPAR String Compare. . . . . . . .   31
;  10. LATINI - LAT Initialization. . . . . . . . . . . . . .   33
;  11. Multicast Transmitter. . . . . . . . . . . . . . . . .   36
;  12. Routines to Build the Host Multicast Message
;       12.1.   BMCFXD. . . . . . . . . . . . . . . . . . . .   37
;       12.2.   BMCFXD. . . . . . . . . . . . . . . . . . . .   38
;       12.3.   BMCNID. . . . . . . . . . . . . . . . . . . .   39
;       12.4.   BMCSRV. . . . . . . . . . . . . . . . . . . .   40
;       12.5.   BMCRAT. . . . . . . . . . . . . . . . . . . .   41
;  13. Multicast Transmit Check Routine . . . . . . . . . . .   42
;  14. Build the START Message Template . . . . . . . . . . .   43
;  15. LAINTR
;       15.1.   LAT DLL Callback Routinea . . . . . . . . . .   44
;       15.2.   Interrupt Level Virtual Circuit Message Receiver  45
;  16. LAINTX - Interrupt Level Virtual Circuit Message Receiver  46
;  17. LARSCH - Scheduler Level Virtual Circuit Message Receiver  47
;  18. LATLSC - Ethernet Link State Change Callback . . . . .   49
;  19. Message Receiver - HMSTRT. . . . . . . . . . . . . . .   50
;  20. HSTRCB . . . . . . . . . . . . . . . . . . . . . . . .   51
;  21. CBINIT - Circuit Block Initialization. . . . . . . . .   52
;  22. CMNIAD - Find CB base on NI address. . . . . . . . . .   53
;  23. HMRUN. . . . . . . . . . . . . . . . . . . . . . . . .   55
;  24. HSTRCB . . . . . . . . . . . . . . . . . . . . . . . .   56
;  25. HMSTOP . . . . . . . . . . . . . . . . . . . . . . . .   57
;  26. Message Transmit Routines. . . . . . . . . . . . . . .   59
;  27. Message Transmitter
;       27.1.   XMTMSG. . . . . . . . . . . . . . . . . . . .   67
;       27.2.   XMTDON. . . . . . . . . . . . . . . . . . . .   68
;  28. Receive Message Handling Routines. . . . . . . . . . .   69
;  29. Transmit Message Handling Routines . . . . . . . . . .   70
;  30. Slot Demultiplexor - LSDMUX. . . . . . . . . . . . . .   72
;  31. HSSTRT . . . . . . . . . . . . . . . . . . . . . . . .   73
;  32. Slot Processing Routines
;       32.1.   STOP Slots. . . . . . . . . . . . . . . . . .   74
;       32.2.   DATA_A,DATA_B Slots . . . . . . . . . . . . .   75
;  33. Slot Block Allocation and Deallocation Routines. . . .   77
;  34. Slot Multiplexor - Main Loop . . . . . . . . . . . . .   83
;  35. BLDMSL . . . . . . . . . . . . . . . . . . . . . . . .   85
;  36. Slot Formatting Routines
;       36.1.   XSLSTA. . . . . . . . . . . . . . . . . . . .   87
;       36.2.   XSLSTP. . . . . . . . . . . . . . . . . . . .   88
;       36.3.   XSLDTA. . . . . . . . . . . . . . . . . . . .   89
;       36.4.   XSLDTB. . . . . . . . . . . . . . . . . . . .   91
;  37. Queue Handling Routines. . . . . . . . . . . . . . . .   94
;  38. Buffer Handling Routines
;       38.1.   Transmit Buffers. . . . . . . . . . . . . . .   96
;       38.2.   Receive Buffers . . . . . . . . . . . . . . .  100
;  39. TTYSRV DEVICE DEPENDENT ROUTINES . . . . . . . . . . .  101
;  40. General Untility Routines. . . . . . . . . . . . . . .  102

	SUBTTL	TOPS20 definitions

IFN FTOPS20,<

;[7.1039] Add XBLT exec to user
;
DEFINE XBLTXU (AC<T1>),<XCT 1,[EXTEND AC,[XBLT]]>

;[7.1039] Add XBLT user to exec
;
DEFINE XBLTUX (AC<T1>),<XCT 2,[EXTEND AC,[XBLT]]>

> ;END IFN FTOPS20
	SUBTTL	Definitions -- TOPS-10 -- Redefinitions of TOPS-20 Things


IFN FTOPS10,<

	OPDEF	NOP[TRN]
	DEFINE	RESCD	<$HIGH>	;Resident (nonpagged) code
	DEFINE	SWAPCD	<$HIGH>	;Swappable code
	DEFINE	XRESCD	<$XHIGH>;Resident (XRCOD PSECT)
	DEFINE	XSWAPCD	<$XHIGH>;Swappable (XNCOD PSECT)
	DEFINE	RESDT	<$LOW>	;
	DEFINE	NOSKD1	<>	;Don't have to worry
	DEFINE	OKSKD1	<>	; about these
	DEFINE	MCENT	<>	; in TOPS-10
	DEFINE	UNSPI,<UNSID>	;Secondary portal ID
	DEFINE	UN.SPI,<UN.SID>	; (NIPAR/ETHPRM)
	DEFINE	BITS,<BITTBL##>
	DEFINE	MAXACB,<MAXCIR##>
	DEFINE	MAXACC,<MAXCIR##>
	DEFINE	TODCLK,<SYSUTM##>;[7.xxxx]System uptime in milliseconds
	EXTERN	RTRADR
	EXTERN	LAHNDB
	EXTERN	NTTLAH
	EXTERN	SBBWDS
	EXTERN	SBBITS
	EXTERN	LDLIDL
	EXTERN	RTN

; Redefine the D36PAR line states.
;
	LS.OFF==0		;Off
	LS.ON==1		;On
	LS.SHT==2		;Shutdown

; XCTU is used for "normal" instructions which move data from User to eXec
;	and eXec to User
;
	DEFINE	XCTU	<PXCT 4,>	;For all "normal" instructions
	DEFINE	XCTBU	<PXCT 3,>	;To load from and deposit to user
					;with byte pointer in eXec
	SUBTTL	Definitions -- TOPS-10 -- LATOP. UUO


					;Still in IFN FTOPS10

; CALL:	MOVEI	AC,ADR
;	LATOP.	AC,
;	  <NON-SKIP>
;	<SKIP>

;LATOP. Function Code Definitions

	.LASET==0	;Set
	.LACLR==1	;Clear
	.LASCH==2	;Show characteristics of host
	.LASTC==3	;Show terminal connects
	.LASAS==4	;Show adjacent servers
	.LASCO==5	;Show counters
	.LAZCO==6	;Zero counters
	.LARHC==7	;[7.1120]Request host-initiated connect
	.LATHC==10	;[7.1120]Terminate host-initiated connect
	.LASHC==11	;[7.1120]Show host-initiated connects

;Argument list offsets

	.LAACT==0	;Argument block count
	.LAFCN==1	;LATOP% function code
	.LAPRM==2	;SET/CLEAR parameter number
	  LA%PSI==1B0	;Use PSI to interrupt (TOPS-20)
	  LA%WAI==1B0	;Wait for completion (TOPS-10)
	  LA%QUE==1B1	;Queue the request at the remote server
	  LA%SYS==1B2	;Show all host-initiated connects
	  LA%JOB==1B3	;Show all host-initiated connects for the job
	  LA%CID==777777 ;Connect id
	.LAVAL==3	;SET/CLEAR new parameter value
	  LA%CHN==0,,-1	;[7.1120]Interrupt channel
	.LABCT==2	;Buffer count
	  LA%ECB==1B0	;Use the Extended Connect Block
	.LABFA==3	;Buffer Address
	.LAQUA==4	;Qualifier
	.LADSC==5	;(ASCIZ string pointer)

	.LASVR==4	;[7.1120]Server name
	.LASVC==5	;[7.1120]Service name
	.LAPRT==6	;[7.1120]Port name
	LA%RAT==1B0	;Set the rating specified
	LA%DSC==1B1	;Set the service description

;Parameter numbers for SET/CLEAR

	.LPMAC==1	;Maximum number of active circuits
	.LPMCO==2	;Maximum number of simultaneous connects
	.LPNUM==3	;Host number
	.LPLAS==4	;LAT access state
	.LPRLI==5	;Circuit retransmit limit
	.LPTIM==6	;Circuit timer initial value
	.LPMTI==7	;Multicast timer initial value
	.LPCOD==10	;Access codes
	.LPNNM==11	;Host node name
	.LPNID==12	;Host node identification string
	.LPSRV==13	;Service rating or description (depends on .LAQUA)

;Port type codes

	.LATTY==1	;[7.1120]Standard LAT terminal connection
	.LADLP==2	;[7.1120]Dial-up Lat terminal connection
	.LAAPP==3	;[7.1120]LAT application terminal

;Status and rejection codes

	.LASOL==377777	;[7.1120]Request is being solicited
	.LAQUE==377776	;[7.1120]Request is queued
	.LACAN==377775	;[7.1120]Request was cancelled by user
	.LATMO==377774	;[7.1120]Request has timed out

	.LAUNK==00	;[7.1120]Unknown error
	.LAURD==01	;[7.1120]User requested disconnect
	.LASSP==02	;[7.1120]System shutdown in progress
	.LAISR==03	;[7.1120]Invalid slot received
	.LAISC==04	;[7.1120]Invalid service class
	.LAIRS==05	;[7.1120]Insufficient resources
	.LASIU==06	;[7.1120]Service is in use
	.LANSS==07	;[7.1120]No such service
	.LASDI==10	;[7.1120]Service is disabled
	.LASNP==11	;[7.1120]Service is not offered by requested port
	.LANSP==12	;[7.1120]No such port name
	.LAIPW==13	;[7.1120]Invalid password
	.LAENQ==14	;[7.1120]Entry is not in queue
	.LAIAR==15	;[7.1120]Immediate access rejected
	.LAACD==16	;[7.1120]Access denied
	.LACSR==17	;[7.1120]Corrupted solicit request
	.LACTI==20	;[7.1120]Command type code is illegal
	.LASCS==21	;[7.1120]Start slot can't be sent
	.LAQED==22	;[7.1120]Queue entry deleted by local node
	.LAIRP==23	;[7.1120]Inconsistent or illegal request parameters
	SUBTTL	Definitions -- TOPS-10 -- Error Codes


					;Still in IFN FTOPS10

DEFINE ITERR (ERRCOD),<
	IFB	<ERRCOD>,<CALLRET STOTAC##>
	IFNB	<ERRCOD>,<
		CALLRET [ MOVEI T1,ERRCOD
			CALLRET STOTAC##]>>

DEFINE RETBAD (ERRCOD),<
	IFB	<ERRCOD>,<RET>
	IFNB	<ERRCOD>,<
		CALLRET [ MOVEI T1,ERRCOD
			RET]>>

DEFINE .ERRT (A,B,C,D) <
	B==A
	C==A>			;internal and external name

.ERRT (00,LATX01,LABTS%,<Buffer size too small for available data>)
.ERRT (01,LATX02,LAVOR%,<LAT parameter value out of range>)
.ERRT (02,LATX03,LALNO%,<LAT is not operational>)
.ERRT (03,LATX04,LASVR%,<Invalid or unknown LAT server name>)
.ERRT (04,LATX05,LAIPN%,<Invalid LAT parameter>)
.ERRT (05,LATX06,LAIPV%,<Invalid LAT parameter value>)
.ERRT (06,LATX07,LASVC%,<Invalid or unknown LAT service name>)
.ERRT (07,LATX08,LAILR%,<Insufficient LAT Resources>)
.ERRT (10,LATX09,LAHAS%,<LAT Host name already set>)
.ERRT (11,ARGX02,LAIVF%,<Function code out of range>)
.ERRT (12,ARGX04,LAABS%,<Argument list too small>)
.ERRT (13,LATXAC,LAADC%,<Address check for argument list>)
.ERRT (14,LATXPV,LAPRV%,<No privilege for attempted operation>)
.ERRT (15,LATX10,LAPRT%,<Invalid or unknown LAT port name>) ;[7.1120]
.ERRT (16,LATX11,LACID%,<Invalid or unknown connect id>) ;[7.1120]
	SUBTTL	Definitions -- TOPS-10 -- KS10 conditionals


					;Still in IFN FTOPS10

IFE FTXMON,<

; Redefine some stuff if we running non-extended (KS10 especially)
;
	DEFINE	OWGP. (SS,ADR,POS),<POINT SS,ADR,POS>

	DEFINE	XBLT.(AC<T1>),<
IFN <AC>-T1,<PRINTX ? CAN'T XBLT VIA AC, USE T1>
	CALL	XBLTA##
>

> ;End IFN FTXMON
	SUBTTL	Definitions -- TOPS-10 -- Symbol purging macros


					;Still in IFN FTOPS10

;	Define some macros which will help purge all symbols of
;	the form ..nnnn at the end of assembly.  This will get rid
;	of about 200 useless symbols generated by .IFSKP and friends

	define	eq(a,b),<a==b>

	define	highest(sym,%tg),< ;;Macro to find highest generated symbol
	....==sixbit/%tg/&000077777777 ;;Isolate the nnnn part of ..nnnn
	eq(sym,\'....)
	purge	....>

	define	prgnum(n),<	;;Macro to purge symbol named ..nnnn
	....==sixbit/n/		;;given a number n
	ifl <n-1000>,<....==<..../100>!sixbit/0/> ;;make leading zero fill
	ifl <n-100>,<....==<..../100>!sixbit/0/>
	ifl <n-10>,<....==<..../100>!sixbit/0/>
	prgsym(..,\'....)
	purge	....>

	define prgsym(sy1,sy2),<
	purge sy1'sy2
>

	define	prgall,<	;;End product: macro to purge all symbols
if2,<				;;of the form ..nnnn
	highest XX		;;Use this just before END statement
	nn==XX
	repeat XX,<prgnum(\nn)
		nn==nn-1>

	nn==.npac
	repeat	.npac,<prgsym(.fpac,\nn)	;;get rid of .fpacN symbols
			nn==nn-1>
	purge	nn,XX,.npac>
>
	SUBTTL	Definitions -- TOPS-10 -- Accumulators


					;Still in IFN FTOPS10

; Allocate some ACs for use in LATOP. UUO
; Use W, since we don't use it for anything else.
; Use M, since it is W+1 for 7.03
; We don't bother saving W, since it is useless.
; We save M at start of LATOP. UUO and restore just before end
;   because it contains the actual UUO and AC field to store to
;
		Q1==W		;redefine some TOPS-20 ACs
		Q2==M		;( = W+1)


; Don't let TRVAR allocate storage for TOPS-10, since TOPS-10 cannot
; maintain a frame pointer.  If TRVAR is used, it will create undefined
; global symbols.
;
DEFINE TRVAR(LIST),<>

DEFINE ACDEF(N,AC),<.FPAC'N==AC>

DEFINE	FREEAC(AC),<
.NPAC==0
IRP AC,<
ACDEF(\.NPAC,AC)
.NPAC==.NPAC+1
>>

FREEAC <W,M,P1,P2,P3,P4,J>	;These are all the ACs available for ACVAR
				;Explicitly do NOT use "U" since it is used
				;for the normal TOPS-10 function to point to
				;an LDB throughout the code
					;Still in IFN FTOPS10
	SUBTTL	Definitions -- Title


DEFINE ACVAR (LIST)<
	..NAC==0		;;INIT NUMBER OF ACS USED
	IRP	LIST,<
	  .ACV1 (LIST,\..NAC)		;;PROCESS ITEMS
	..NAC==..NAC+1>
	SAVEAC	(<LIST>)	;;SAVE ACS USED (QUICK AND DIRTY)
	DEFINE	ENDAV.<.ENAV1 <LIST>>>

DEFINE .ACV1 (ITEM,N)<
	.ACV2 (ITEM,N)>		;;PEEL OFF ANGLEBRACKETS IF ANY

DEFINE .ACV2 (NAM,N)<
	IFDEF	NAM,<.IF NAM,SYMBOL,<PRINTX ACVAR NAM ALREADY DEFINED>>
	NAM==.FPAC'N	;;DEFINE VARIABLE
	$'NAM==NAM		;;FOR DDT
>

DEFINE .ENAV1 (ARGS)<
	IRP	ARGS,<
	  .ENAV2 (ARGS)>>

	DEFINE	.ENAV2 (ARG)<
	.ENAV3 (ARG)>

	DEFINE	.ENAV3 (NAM,SIZ)<
	PURGE	NAM,NAM
	>
	XOFFC=="S"-100		;XOFF CHARACTER
	XONC=="Q"-100		;XON CHARACTER

> ;End IFN FTOPS10
	SUBTTL	Definitions -- Literals -- Circuit Parameters


;
;LAT Virtual Circuit Message Types
;
	MT.RUN==0		;RUN message
	MT.STA==1		;START message
	MT.STP==2		;STOP message
	MT.MCA==^D10		;Multicast message
	MT.CMD==^D12		;[7.1120]Command message
	MT.STS==^D13		;[7.1120]Status message
	MT.SIN==^D14		;[7.1120]Solicit Information message
	MT.RIN==^D15		;[7.1120]Response Information message
	MT.EID==^D10		;[7.1150]Offset to Entry ID field in command msg

;LAT Virtual Circuit States
;

	CS.HLT==0		;HALTED
	CS.STA==1		;STARTING
	CS.RUN==2		;RUNNING
	CS.TRN==-1		;In transition between HALTED and STARTING

;
;Circuit STOP message reason codes
;

	CE.NSL==1		;No slots connected on circuit
	CE.ILL==2		;Illegal message or slot format
	CE.HLT==3		;Circuit halted by local system
	CE.NPM==4		;No progress being made
	CE.TIM==5		;Time limit expired
	CE.LIM==6		;Retransmit limit exceeded
	CE.RES==7		;Insufficient resources
	CE.STO==10		;Server circuit timer out of range
	CE.SKW==11		;Protocol version skew
	CE.INV==12		;Invalid Message

;Circuit STOP reason codes of local significance only

	CE.NIH==200		;Local NI halted

	MMHDSI==^D8		;Minimum Message Header Size
	MSTMSI==^D16		;Minimum START Message Size(excluding header)

	SUBTTL	Definitions -- Literals -- Slot Parameters


;
;LAT Slot Types
;

	ST.DTA==0		;DATA_A slot
	ST.STA==11		;START slot
	ST.DTB==12		;DATA_B slot
	ST.ATT==13		;ATTENTION slot
	ST.REJ==14		;REJECT slot
	ST.STP==15		;STOP slot

;
; LAT Slot States
;

	SS.HLT==0		;Halted
	SS.RUN==1		;Running
	SS.SIN==2		;[7.1120]Solicit Information
	SS.SAI==3		;[7.1120]Solicit Access (initialize first)
	SS.SAC==4		;[7.1120]Solicit Access
	SS.QUE==5		;[7.1120]Queued
	SS.REJ==6		;[7.1120]Rejected
	SS.TMO==7		;[7.1120]Timed out
	SS.CAI==10		;[7.1120]Cancel (initialize first)
	SS.CAN==11		;[7.1120]Cancel
	SS.MAX==SS.CAN		;[7.1120]Maximum state value

;
; SLOT Reject and Stop Reason Codes
;

	SE.USR==1		;User requested disconnect
	SE.SHU==2		;System shutdown in progress
	SE.ISR==3		;Invalid slot received
	SE.SER==4		;Invalid service class
	SE.RES==5		;Insufficient resources available
	SE.ENQ==^D12		;[7.1120]Entry is not in queue
	SE.CSR==^D15		;[7.1120]Corrupted solicit request
;
; DATA_B Slot Control Flag Bit Definitions
; Low order bit always set to enable "HOSTSYNC" flow control ala VAX
; Other bits Enables/Disables "TTSYNC" in VAX terms.

	SL.EXF==^B0101		;[7.1039]Enable XON/XOFF recognition in server
	SL.DXF==^B1001		;[7.1039]Disable XON/XOFF recognition in server

; Connect id's for pending requests have a random portion (determined by
; the array PRRAND) and a fixed protion (the index into PRVECT and 
; PRRAND).
;
	PR.NDX==000377		;[7.1120]The LO eight-bits are the index
	PR.RAN==000377		;[7.1120]The HO eight-bits are random
	PR%RAN==<PR.RAN>B27	;[7.1120]Here is the position of PR.RAN

;
; SLOT Size Definitions
;

	SLHDSI==4		;Slot header size
	ATTSIZ==SLHDSI		;ATTENTSION slot size
	DTBSIZ==SLHDSI+5	;DATA_B slot size
IFN FTOPS20,<
	NIPIA==DLSCHN		;Priority Interrupt Assignment for KLNI
>

;
;Response Information Status Bits
;
	RI%NDS==1		;[7.1120]Node is disabled
	RI%NSS==2		;[7.1120]No such service
	RI%CMD==4		;[7.1120]Node can accept a command message
;
;Miscellaneous Constants
;

	LAHPV==5		;Highest protocol version supported
	LALPV==5		;Lowest protocol version supported
	PROVER==5		;Our LAT protocol version
	PROECO==1		;[7.1120]Our LAT protocol ECO
	MXSLSI==^D40		;[7346]Maximum slot size we will receive
	MXSLTS==^D64		;Maximum slot sessions per circuit
	LMRFSI==^D1504		;Receive buffer size
	MXHSRV==10		;Maximum number of services offered
IFN FTOPS20,<
	LHPRID==6		;Product code type for TOPS-20 host
>
IFN FTOPS10,<
	LHPRID==7		;Product code type for TOPS-10 host
>
	SCITTY==1		;Interactive terminal service class
	MAXXBF==2		;Maximum number of transmit buffers/circuit
	CBMAXI==^D255		;[7.1164]Absolute maximum circuit id
	PRMAXI==^D64		;[7.1120]Maximum pending requests
	SLHDSZ==4		;Slot header size (bytes)
	MAXCRE==2		;Maximum number of credits to extend to remote.
	MXBALC==6		;Number of ticks to wait before sending
				; unsolicited message to server
	DLL.FL==1B0		;[7.1120]UNUID: Buffer is in DLL (NI service)
	SAV.FL==1B1		;[7.1120]UNUID: Buffer for pending request
	MSB.FL==2		;[7.1155]Symbol for Master/slave bit
	MINXBF==^D46		;Minimum transmit buffer size

	XRESCD			;[7.1024]

	SUBTTL	Definitions -- Data Structures


; UN Block Extension

BEGSTR	UE
	WORD	LW0		;Queue Link Word for linking buffers to CB Qs
	WORD	LW1		;Queue Link Word for linking buffers to NI Qs
ENDSTR

;
; Buffer offsets
;

	UNB.OF==UE.LEN		;Start of UN block for all buffers
	MDB.OF==UE.LEN+UN.LEN	;Start of MD block
	XBF.OF==UE.LEN+UN.LEN+MD.LEN
	SBF.OF==UE.LEN+UN.LEN

	SZMSTP==<XBF.OF+SZ.MHD+1>;STOP message size in words
	SZ.SHD==4		;Slot header size
	SZ.ATT==1		;Attention size
	SZ.REJ==0		;Reject slot size
	SZ.SDB==5		;DATA_B slot size
	SZ.SSP==0		;Stop slot size
	SZ.SST==6		;Start slot size
	SZ.XBF==<^D1500+3>/4
	SZ.MSP==^D10		;Start message size
	SZ.MHD==^D8		;Message header size

	ML.NNM==6		;Max length of node name
	ML.SYS==^D16		;Max length of system name
	ML.LOC==^D64		;Max length of location field
	ML.DSC==^D64		;Max length of description field
	ML.SRN==^D16		;[7.1120]Max length of server name
	ML.PRN==^D16		;[7.1120]Max length of port name
	ML.SVN==^D16		;[7.1120]Max length of service name
	ML.SID==^D64		;Max length of service identification field
	ML.HMC==^D33+<1+ML.NNM>+<1+ML.DSC>+MXHSRV*<1+ML.SVN+1+ML.SID>+2
				;Host multicast message max length
	ML.HSM==^D12+<1+ML.NNM>+<1+ML.LOC>+<1+ML.SYS>+1
				;Host start message max length
	ML.HCM==^D54+ML.SRN+ML.SYS+ML.SVN+ML.PRN
				;[7.1120]Max length of host command msg
	MW.SYS==<ML.SYS+4>/5	;[7.1039]Max length of system name in words
	MW.LOC==<ML.LOC+4>/5	;[7.1039]Max length of location field in words
	MW.SHC==4+<ML.SRN+4>/5+<ML.PRN+4>/5+<ML.SVN+4>/5
				;[7.1120]Length of an .LASSC Status block
	MW.OCB==<<ML.SYS+4>/5>+2;[7.1120]Length of an "old style" connect
                                ;block
	MW.ECB==MW.OCB+1+<<<ML.SYS+4>/5>*2>
				;[7.1120]Length of an "extended" connect
                                ;block 

	SUBTTL	Definitions -- Data Structures -- Host Node (HN) Block


;Host Node Data Structures
;

BEGSTR	GB			;SERVICE BLOCK
	WORD	RAT		;Service Rating.
	HWORD	NC		;Count of bytes in service name.
	HWORD	LC		;Count of bytes in service description
	WORD	NAM,<<ML.SVN+4>/5>	;Storage for up to 16 bytes of service name.
	WORD	HID,<<ML.SID+4>/5>	;Storage for up to 64 bytes of service id.
ENDSTR

BEGSTR	HN			;HOST NODE Data Base
	FIELD	FLG,^D18
	 BIT RUN		;NI run state
	 BIT ANY		;Reconstruct of START msg necessary
	 BIT CIP		;Virtual circuit connect in progress
	FILLER	^D10
	FIELD	CFL,^D8		;Multicast message change flags
	 BIT OTH		;Something other than above changed
	 BIT FIL
	 BIT CLS		;A host service class changed
	 BIT SVD		;A host service description changed
	 BIT SVR		;A host service rating changed
	 BIT SVN		;A host service name changed
	 BIT NDD		;Host Node Description changed
	 BIT ACS		;Access Codes changed
;START OF PARAMETERS DISPLAYED BY .LASCH
	HWORD	MXC		;Maximum allocatable circuit blocks
	HWORD	NCC		;Number of currently allocated circuit blocks
	HWORD	MAC		;Maximum number of active circuits
	HWORD	NAC		;Number of currently active circuits
	HWORD	MCO		;Maximum number of simultaneous connects
	HWORD	CON		;Current number of active connects
	HWORD	NUM		;Host number
	HWORD	LAS		;LAT access state
	HWORD	RLI		;Virtual circuit message retransmit limit
	HWORD	TIM		;Virtual circuit timer initial value (ms)
	HWORD	MTI		;Multicast timer initial value (sec)
;END OF PARAMETERS DISPLAYED BY .LASCH
	HWORD	RAT		;Host node dynamic rating
	HWORD	PRG		;Host progress timer
	HWORD	NRB		;Number of receive buffers allocated
				;[7.xxxx]Remove definition of HNRTX
	HWORD	CMT		;[7.1120]Command message retry timer (ms)
	HWORD	CMX		;[7.1120]Command message retry limit
	WORD	HST		;Address of state table
	WORD	QAC,2		;Queue header for active circuit blocks
	WORD	QIC,2		;Queue header for inactive circuit blocks
	WORD	NIQ,2		;Interrupt level message queue
	WORD	SCQ,2		;Scheduler level message queue
	WORD	PID		;NI Portal ID
	HWORD	NXI		;Next circuit block index to assign
	HWORD	NSV		;Number of offered services
	WORD	LOK		;Lock for HN data base
	HWORD	NMC		;Host node name count
	HWORD	IDC		;Host identification string count
	WORD	NAM,2		;Host node name string
	WORD	ID,<<ML.DSC+4>/5>	;Host identification string
	WORD	SMT,<<<ML.HSM+3>/4>+SBF.OF>;Start message template
	WORD	MCM,<<ML.HMC+3>/4>	;Copy of the multicast message.
	WORD	SRV,<GB.LEN*MXHSRV>;Storage for service blocks
ENDSTR

BEGSTR	AC,HN.LST		;ACCESS CODES
	WORD	LNG		;Access code string length in bytes
	WORD	COD,^D32	;Storage for 256 bit bit-mask
ENDSTR

;LAT Circuit counters for all servers

BEGSTR	HC,AC.LST
	WORD	RCV		;Messages received
	WORD	XMT		;Messages transmitted
	WORD	RTR		;Messages retransmitted
	WORD	SEQ		;Receive message sequence errors
	WORD	IMR		;Illegal messages received
	WORD	ISR		;Illegal slots received
	WORD	RES		;Resource errors
	WORD	MSK		;Illegal message error mask
ENDSTR

	SUBTTL	Definitions -- Data Structures -- Circuit Block (CB)


BEGSTR	CB			;CIRCUIT BLOCK
	WORD	LNK,2		;Queue Link words (must be first words)
	HWORD	RID		;Circuit handle assigned by the remote
	HWORD	LID		;Local circuit index
	FIELD	FLG,3		;Virtual circuit flags
	 BIT RRF		;Reply requested flag
	 BIT MRS		;Must reply soon flag
	 BIT MRN		;Must reply now flag
	HWORD	CSB		;Count since balanced
	HWORD	SDC		;Number of slots with data waiting
	HWORD	TSQ		;Next transmit sequence number
	HWORD	RSQ		;Next expected receive sequence number
	HWORD	LRA		;Sequence number of last message ack'd by remote node.
	WORD	TIM		;Current value of circuit timer.
	HWORD	RTC		;Current retransmit count
	WORD	KAV		;[7295]2*Server Keep-alive-timer in ms.
				; (in jiffies for TOPS-10)
	WORD	KAT		;TODCLK last time message receieved from server
	HWORD	QUA		;Circuit quality
	HWORD	ERR		;Reason code for last time circuit stopped
	HWORD	DLL		;Number of transmit buffers in the DLL
	WORD	XBQ,2		;Queue of free transmit buffers
	WORD	AKQ,2		;Unacknowledged queue header
	WORD	SBQ,2		;Circuit slot queue
;
;The following are returned as part of the LATOP Get Server information info.
;
	WORD	DNI,2		;NI address of remote server
	HWORD	MTF		;Maximum transmit frame size for circuit
	HWORD	RPV		;Remote protocol version and ECO
	HWORD	MSL		;Maximum slots allowed by remote
	HWORD	NBF		;Additional transmit buffers allowed by remote
	HWORD	CTI		;Value of remote's circuit timer
	HWORD	KTI		;Value of remote's keep-alive timer
	HWORD	PTC		;Product type code for remote node
	HWORD	STA		;Virtual circuit state
	HWORD	NUM		;Remote's system number
	HWORD	RSC		;Remote's system name count
	HWORD	RLC		;Remote's location text count
	WORD	SNM,<<ML.SVN+4>/5>	;Remote's system name
	WORD	LOC,<<ML.LOC+4>/5>	;Remote's location string
ENDSTR
BEGSTR	CC,CB.LST		;CIRCUIT COUNTERS
	WORD	RCV		;Messages received
	WORD	XMT		;Messages transmitted
	WORD	RTR		;Messages retransmitted
	WORD	SEQ		;Receive message sequence errors
	WORD	IMR		;Illegal messages received
	WORD	ISR		;Illegal slots received
	WORD	RES		;Resource errors
	WORD	MSK		;Illegal message error mask
ENDSTR


; Boundary definitions in the CB for CLEAR and SHOW
; LAT Control Program functions.

	  CLRBEG==CB.FLG	;First clear field for .LACLR
	  CLREND==CB.DLL	;End of clear field for .LACLR
	  SASBEG==CB.DNI	;Start of .LASAS fields for single server
	  SASBG==CB.STA		;Start of .LASAS fields for multiple servers
	  SASEN==CB.SNM+<ML.SYS+4>/5 ;End of .LASAS fields for single server
	  SASEND==CB.LOC+<ML.LOC+4>/5 ;End of .LASAS fields for multiple servers

	SUBTTL	Definitions -- Data Structures -- Slot Block (SB)


BEGSTR	SB
	WORD	LNK,2		;Queue link word (must be first)
	FIELD	FLG,^D18	;Flags
				;*** Beginning of bits to be kept in order ***
	  BIT SDP		;Slot data present (must be sign bit)
	  BIT REJ		;Send REJECT Slot
	  BIT STR		;Send START Slot
	  BIT FOU		;Flush output
	  BIT OUT		;Output data available
	  BIT FCC		;Flow control change
	  BIT STO		;Send STOP Slot(Must be last)
				;*** End of bits to be kept in order ***
	  SBSMSK==SBREJ!SBSTR!SBFOU!SBOUT!SBFCC!SBSTO ;[7.1120]
				;[7.1120]Mask of bits which match BLSDSP
	  BIT DLP		;[7.1120]This slot is a dialup line
	HWORD	ATS		;Maximum attention slot size
	HWORD	MDS		;Maximum slot data size
	HWORD	STA		;Slot state
	HWORD	RID		;Remote slot id
	HWORD	LID		;Local slot id
	HWORD	XCR		;Transmit credits available to us
	HWORD	RCR		;Receive credits still outstanding
	HWORD	REA		;Reason code for stop or reject
	HWORD	SRC		;[7.1120]Server name count
	HWORD	PRC		;[7.1120]Port name count
	HWORD	SVC		;[7.1120]Service name count
	WORD	SRN,<<ML.SRN+4>/5>	;[7.1120]Server name
	WORD	PRN,<<ML.PRN+4>/5>	;[7.1120]Port name
	WORD	SVN,<<ML.SVN+4>/5>	;[7.1120]Service name
	WORD	TDB		;Terminal data block
	WORD	CBA		;Circuit block address for this slot
	WORD	PRA		;[7.1120]Pending request block address 
IFN FTOPS10,<
	FIELD	REM,^D18	;More flags for TOPS-10
	BIT	TTO		;"Character in SBCHR" bit, must be sign bit
	BIT	XNF		;"XON/XOF processing enabled
	HWORD	CHR		;space to hold saved character
> ;End IFN FTOPS10
ENDSTR

	SUBTTL	Definitions -- Data Structures -- Pending Request Block (PR)


;[7.1120]
BEGSTR	PR
	FIELD	FLG,^D18	;Flags
	  BIT WAI		;Wait for the connection
	  BIT QUE		;Queue this request
	HWORD	STA		;State (internal use only)
	HWORD	STS		;Status (visible to user)
	HWORD	QDP		;Queue depth
	HWORD	CID		;Local connect id
	HWORD	EID		;Remote entry id
	HWORD	JOB		;Job number (JCH for TOPS-10)
	HWORD	FRK		;Fork number
	HWORD	PSI		;PSI channel number
	HWORD	CMC		;Command message retry count
	HWORD	SRC		;Server name count
	HWORD	PRC		;Port name count
	HWORD	SVC		;Service name count
	WORD	SRN,<<ML.SRN+4>/5>	;Server name
	WORD	PRN,<<ML.PRN+4>/5>	;Port name
	WORD	SVN,<<ML.SVN+4>/5>	;Service name
	WORD	CMT		;Command message retry timer
	WORD	SBA		;Address of slot block
	WORD	XBA		;Address of COMMAND message
	WORD	DNI,2		;Address of remote server
ENDSTR

	SUBTTL	Definitions -- Data Structures -- Miscellaneous


BEGSTR	QL			;Halfword Queue Link Word
	WORD	FWD		;Next forward queue element
	WORD	BWD		;Previous backward queue element
ENDSTR

	SUBTTL	Definitions -- External References


IFN FTOPS20,<
	EXT	DNGWDZ
	EXT	DNFWDS
	EXT	TTCHI
	EXT	LATMCT		;CLK2TM table timer for multicast
	EXT	LATCMT		;[7.1120]CLK2TM table timer for command message
>;END IFN FTOPS20

	SUBTTL	Definitions -- MIN.,MAX.,MAXENT Macros


; Macro MIN. (symbol,list) - Assigns minimum arithmetic value of list of items.
;

DEFINE MIN. (SYM,LIST),
	<IRP LIST,<..X==LIST	;;Assign first value in list
		   STOPI>
	 IRP LIST,<IFL <LIST-..X>,<..X==LIST>> ;;Assign lowest in list
	 SYM==:..X>		;;Generate value

;
; Macro MAX. (symbol,list) - Assigns maximum arithmetic value of list of items.
;

DEFINE MAX. (SYM,LIST),
	<IRP LIST,<..X==LIST	;;Assign first value in list
		   STOPI>
	 IRP LIST,<IFG <LIST-..X>,<..X==LIST>> ;;Assign highest in list
	SYM==:..X>		;;Generate value

DEFINE PARTB. (PRM,MAX,MIN,CLRVAL,INSTR,FLAGS) <

	.ORG <.LP'PRM+TBRNGE-1>
	EXP	<MAX,,MIN>
	.ORG
	.ORG <.LP'PRM+TBFLGS-1>
	EXP	<FLAGS!CLRVAL>
	.ORG
	.ORG <.LP'PRM+TBEXEC-1>
	IFB	<INSTR>,<
	STOR	T2,HN'PRM,(Q2)
	>
	IFNB	<INSTR>,<
	INSTR
	>
	.ORG
	>

	SUBTTL	Definitions -- Local Variables



	RESDT

CBVECT:	BLOCK	1
SBVECT:	BLOCK	1
PRVECT:	BLOCK	1		;[7.1120]Table of pending requests
PRRAND:	BLOCK	1		;[7.1120]Table of "random" connect id values
PRBITS:	BLOCK	<PRMAXI+^D35>/^D36	;[7.1120]Bit table for PRVECT
PRBITN==.-PRBITS		;[7.1120]Length of PRBITS table
LASDEF::EXP	LS.ON		;LAT Access Default State
NSLOTS:	BLOCK	1

IFN FTOPS20,<
PRWMSK:	BLOCK	<PRMAXI+^D35>/^D36	;[7.1120]Wake up mask for LATST
LAHNDB:	BLOCK	1

	MAX.	(TMPLNG,<<GB.LEN+1>,ML.NNM,ML.DSC>)
	NR	(TMPBLK, TMPLNG)
	TMPGB==TMPBLK+1
> ;end IFN FTOPS20

IFN FTOPS10,<
OURNAM:	BLOCK	2
OURCNT:	BLOCK	1
LATRTQ:	BLOCK	2		;QUEUE FOR LAT LDBS
LATFRE:	BLOCK	QL.LEN		;QUEUE FOR LAT FREE CORE BLOCKS
LATLOC:	BLOCK	1		;START OF LAT FREE CORE (SET UP AT ONCE TIME)
LATMCT:	BLOCK	1		;Multicast timer (in seconds for TOPS-10)
LATNFB:	BLOCK	1		;Number of free buffers in pool
LATWFB:	BLOCK	1		;Number of free buffers wanted for new circuits
LATRFB:	BLOCK	1		;Number of buffers requested on last cycle
LASBAD:	BLOCK	2		;Ethernet address of sender of last bad msg
MSGDID:	BLOCK	1		;Destination ID from msg
MSGSID:	BLOCK	1		;Source ID from msg
MSGACK:	BLOCK	1		;ACK/SEQ field from msg
STPCOD:	BLOCK	1		;Stop reason
SLTDID:	BLOCK	1		;Destination ID from RUN msg
SLTSID:	BLOCK	1		;Source ID from RUN msg
SLTCNT:	BLOCK	1		;Slot count from RUN msg
SLTTYP:	BLOCK	1		;Slot type/credits/reason
SLTEPT:	BLOCK	1		;Pointer to the next slot

	MAX.	(TMPLNG,<<GB.LEN+1>,ML.NNM,ML.DSC>)
TMPBLK:	BLOCK	TMPLNG		;Temporary block for LATOP.
	TMPGB==TMPBLK+1

>;end IFN FTOPS10

	SUBTTL	LATOP% JSYS -- Dispatch


	XSWAPCD			;[7.1024]

XNENT	(.LATOP,G)		;[7.1024].LATOP::, X.LATO::

IFN FTOPS20,<
	MCENT
	UMOVE	Q1,1		;Get the argument block address
> ;End IFN FTOPS20

IFN FTOPS10,<
	SAVEAC	<W,M,P1,P2,P3,P4>;Save W (Q1) and M (Q2)
	MOVE	Q1,T1		;Get the argument block address
	MOVE	J,.CPJOB##	;Also need job number

; For TOPS10, we must address-check the argument block or else we might
; get an IME doing a UMOVE or UMOVEM.
;
	MOVE	M,T1		;Point to user's argument block
	SNCALL	(GETWRD##,MCSEC1);Get the first word (arg count)
	 ITERR (LATXAC)		;Arg block is not addressable!
	MOVE	P1,T1		;Save length of argument block
	MOVE	T1,Q1		;Copy address of argument block
	MOVE	T2,P1		;Copy length of argument block
	SNCALL	(ARNGE##,MCSEC1)	;Address check the argument block
	 NOP			;Not addressable!
	 ITERR (LATXAC)		;Not writeable!
				; (error because .LABCT gets rewritten)
> ;End IFN FTOPS10

				; ..
				; ..

	SKIPN	Q2,LAHNDB	;If there is no data base,
	ITERR	(LATX03)	; then LAT is not operational
	UMOVE	P1,.LAACT(Q1)	;Get the length of the argument block
	UMOVE	P2,.LAFCN(Q1)	;Get the function code
	SKIPL	P2		;
	CAILE	P2,FNCMAX	;Range check the function code
	ITERR	(ARGX02)	;Function code out of range
	LDB	T1,[POINTR (FNCDSF(P2),LF%MSZ)]	;[7.1120]
	CAMGE	P1,T1		;[7.1120]Is the argument block big enough?
	ITERR	(ARGX04)	;[7.1120]No, argument list too small
	MOVE	P3,FNCDSF(P2)	;[7.1120]Get the function flags word
	TXNN	P3,LF%PRV	;[7.1120]Is this a privileged operation?
	IFSKP.			;[7.1120]Yes, then check capabilities
IFN FTOPS20,<
	  MOVE T1,CAPENB	;[7.1120]
	  TXNN T1,SC%WHL!SC%OPR ;[7.1120]Has WHEEL or OPERATOR privileges?
	  ITERR (CAPX1)		;[7.1120]No, insufficient privileges
> ;End IFN FTOPS20
IFN FTOPS10,<
	  MOVSI T1,JP.POK	;[7.xxxx]Has POKE, JACCT, or [1,2]
	  SNCALL (PRVBIT##,MCSEC1) ; privileges?
	   TRNA			;Yes, proceed
	  ITERR (LATXPV)	;No, insufficient privileges
> ;End IFN FTOPS10
	ENDIF.

				; ..
				; ..

IFN FTOPS20,<
	NOINT			;Don't allow PSI while owning lock
	LOCK	HN.LOK(Q2)	;Get the lock
	CALL	@FNCDSP(P2)	;[7.1120]Dispatch to perform the function
	IFSKP.			;[7.1120]
	  UNLOCK HN.LOK(Q2)	;[7.1120]Release data base lock
	  OKINT			;[7.1120] and allow interrupts
	  MRETNG		;[7.1120]Return to the user
	ELSE.			;[7.1120]
	  UNLOCK HN.LOK(Q2)	;[7.1120]Release data base lock
	  OKINT			;[7.1120] and allow interrupts
	  ITERR ()		;[7.1120]Error already reported
	ENDIF.			;[7.1120]
	MRETNG			;[7.1120]Return to user
> ;End IFN FTOPS20

; For TOPS-10, check the addressability of the show buffer.
;
IFN FTOPS10,<
	TXNN	P3,LF%SBF	;Is there a show buffer?
	IFSKP.			;Yes, then check addressability
	UMOVE	T1,.LABFA(Q1)	;Get address of show buffer
	XCTU	[HRRE T2,.LABCT(Q1)]	;Get length of show buffer
	SNCALL	(ARNGE##,MCSEC1)	;Address check the show buffer
	 NOP			;Not addressable!
	 ITERR (LATXAC)		;Not writeable!
	ENDIF.

	CALL	@FNCDSP(P2)	;Dispatch to perform the function
	 ITERR ()		;Error already reported
	RETSKP			;Return to the user
> ;End IFN FTOPS10
;[7.1120]LATOP% JSYS dispatch table

DEFINE FNC,<

	XALL			;;List generated table

XX	.LASET, LASET, LF%PRV       , .LAVAL+1  ;; (0) Set host parameters
XX	.LACLR, LACLR, LF%PRV       , .LAPRM+1  ;; (1) Clear host parameters
XX	.LASCH, LASCH, LF%SBF       , .LABFA+1  ;; (2) Show characteristics
XX	.LASTC, LASTC, LF%SBF       , .LABFA+1  ;; (3) Show terminal connects
XX	.LASAS, LASAS, LF%SBF       , .LAQUA+1  ;; (4) Show adjacent servers
XX	.LASCO, LASCO, LF%SBF       , .LABFA+1  ;; (5) Show counters
XX	.LAZCO, LAZCO, LF%PRV!LF%SBF, .LABFA+1  ;; (6) Zero counters
XX	.LARHC, LARHC, LF%PRV       , .LADSC+1  ;; (7) Request host-initiated connect
XX	.LATHC, LATHC, LF%PRV       , .LAPRM+1  ;;(10) Terminate host-initiated connect
XX	.LASHC, LASHC, LF%PRV!LF%SBF, .LAQUA+1  ;;(11) Show host-initiated connects

	SALL			;;Turn listing back on

> ;End DEFINE FNC
DEFINE XX (CODE,DISP,FLAG,MNSZ),<
	XADDR. DISP		; CODE
> ;End DEFINE XX


; Generate function dispatch table
;
FNCDSP:	FNC			;[7.1120]
FNCMAX==.-FNCDSP-1		;[7.1120]Maximum LATOP% JSYS function code


LF%PRV==1B0			;[7.1120]Privileged function
LF%SBF==1B1			;[7.1120]Address check show buffer
LF%MSZ==777			;[7.1120]Minimum size of the argument block


DEFINE XX (CODE,DISP,FLAG,MNSZ),<
	EXP	FLAG!MNSZ	; CODE
> ;End DEFINE XX


; Generate function flags table
;
FNCDSF:	FNC			;[7.1120]
	SUBTTL	LATOP% JSYS -- Set/Clear Functions -- SSERVC


;LASET - Set LAT host parameters.
;LACLR - Clear LAT host parameters.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASET/LACLR
; Return+1: Failure, T1/ error code
; Return+2: Success

LASET:	
LACLR:	UMOVE	T1,.LAPRM(Q1)	;Get the parameter number to set/clear.
	CAIL	T1,MNSPAR	;Range check it
	CAILE	T1,MXSPAR	; ...
	RETBAD	(LATX06)	;Parameter number out of range
	CAIE	P2,.LACLR
	IFSKP.
	  MOVX T3,LF%CLR	;Is this parameter clearable?
	  TDNN T3,TBFLGS-1(T1)	; ...
	  RETBAD (LATX07)	;No, return error
	  HRRZ T2,TBFLGS-1(T1)	;Get the value to clear to
	  JRST LASET0		; and go clear it.
	ENDIF.
	UMOVE	T2,.LAVAL(Q1)	;Get the new value to set
	MOVX	T3,LF%RNG	;Check if this parameter value should
	TDNN	T3,TBFLGS-1(T1)	; be range checked.
	IFSKP.			;Yes
	  MOVE T3,TBRNGE-1(T1)	;Get the upper and lower ranges.
	  HRRZ T4,T3		;Lower bound
	  HLRZS T3		;Upper bound
	  CAML T2,T4
	  CAMLE T2,T3
	  RETBAD (LATX02)
	ENDIF.
LASET0:	HLRZ	T3,TBFLGS-1(T1)	;Change flags to set.
	ANDI	T3,377
	IORM	T3,HN.FLG(Q2)	;Set them
	XCT	TBEXEC-1(T1)	;Do the store.
	RETSKP

	LF%RNG==1B1		;Do range check on parameter value to set
	LF%LOK==1B2		;Lock the database before setting parameter
	LF%CLR==1B3		;Parameter may be cleared.

MAX. (MXSPAR,<.LPMAC,.LPMCO,.LPNUM,.LPLAS,.LPRLI,.LPTIM,.LPMTI,.LPCOD,.LPNNM,.LPNID,.LPSRV>)
MIN. (MNSPAR,<.LPMAC,.LPMCO,.LPNUM,.LPLAS,.LPRLI,.LPTIM,.LPMTI,.LPCOD,.LPNNM,.LPNID,.LPSRV>)

TBRNGE:	BLOCK	<MXSPAR-MNSPAR+1>
TBFLGS:	BLOCK	<MXSPAR-MNSPAR+1>
TBEXEC:	BLOCK	<MXSPAR-MNSPAR+1>

	PARTB. (MAC,CBMAXI,1,^D10,<JRST SETMAC>,LF%RNG!LF%CLR) ;[7.1164]
	PARTB. (MCO,NTTLAH,1,NTTLAH,,LF%RNG!LF%CLR)
	PARTB. (NUM,177777,0,RTRADR,,LF%RNG!LF%CLR)
	PARTB. (LAS,LS.ON,LS.OFF,0,,LF%RNG!<HNOTH_^D18>)
	PARTB. (RLI,100,0,^D30,,LF%RNG!LF%CLR)
	;[7.xxxx] Remove subroutine SETRTX.
	PARTB. (TIM,^D100000,^D100,^D1000,,LF%RNG!LF%CLR) ;[7.1120]
	PARTB. (MTI,60,10,^D30,,LF%RNG!LF%CLR!<HNOTH_^D18>)
	PARTB. (COD,0,0,0,<JRST SETCOD>,LF%CLR!<HNACS_^D18>)
	PARTB. (NNM,0,0,0,<JRST SETNNM>,0)
	PARTB. (NID,0,0,0,<JRST SETNID>,LF%CLR!<HNNDD_^D18>)
	PARTB. (SRV,0,0,0,<JRST SSERVC>,LF%CLR)
	SUBTTL	LATOP% JSYS -- SET/CLEAR SERVICE

;SSERVC - Set LAT Service
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL SSERVC
; Return+1: Failure, T1/ error code
; Return+2: Success

SSERVC:	SAVEAC	<P3,P4>
	CALL	FNDSRV		;(T1-T4/T1)Find the service to be set/cleared.
	 RETBAD ()
	MOVEM	T1,P3		;Save the service block address
	CAIN	P2,.LACLR	;Clearing rather than setting?
	JRST	CSERVC		;Yes.
	SETZ	P4,0		;P4 will be used to assemble the change flags
	UMOVE	T1,.LAQUA(Q1)	;Get the flags and rating
	TXNN	T1,LA%RAT	;Set the rating?
	IFSKP.			;Yes.
	  TXO P4,HNSVR		;Set rating change flag
	  HRRE T2,T1
	  MOVE T3,T2
	  AOS T2
	  CAIL T2,0		;Range check the rating.
	  CAILE T2,^D256	; ...
	  RETBAD ()		;Out of range
	  STOR T3,GBRAT,+TMPGB	;Store the rating
	ENDIF.
	TXNN	T1,LA%DSC	;Set the description?
	IFSKP.
	  TXO P4,HNSVD		;Description change flag
	  UMOVE T1,.LADSC(Q1)	;Get the user's pointer to description string
IFN FTOPS10,<
	  SNCALL (CKSTR##,MCSEC1) ;Is the ASCIZ string addressable?
	   RETBAD (LATXAC)	;No, address check for argument list
> ;End IFN FTOPS10
	  MOVX T2,<POINT 7,GB.HID+TMPGB>;Where to put it.
	  MOVEI T3,ML.SID	;Maximum string count
	  CALL UMVAZS		;(T1-T3/T3)Move the string
	   RETBAD (LATX06)
	  STOR T3,GBLC,+TMPGB	;Store the description length
	ENDIF.
	SKIPN	TMPBLK		;Did we add a new service?
	IFSKP.
	  OPSTRM <AOS>,HNNSV,(Q2);Yes.
	  TXO P4,HNSVN		;Flag that number of services changed
	ENDIF.
	IORM	P4,HN.FLG(Q2)	;Enter the assebled flags
	MOVEI	T1,GB.LEN	;Move the new service
	XMOVEI	T2,TMPGB	; to the service block
	MOVE	T3,P3		; supplied by FNDSRV.
	XBLT. T1
	RETSKP

	SUBTTL	LATOP% JSYS -- Set/Clear Functions -- CSERVC


;CSERVC - Clear LAT service.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL CSERVC
; Return+1: Failure, T1/ error code
; Return+2: Success

CSERVC:	MOVE	T3,T1		;Start of overlay
	LOAD	T1,HNNSV,(Q2)	;Number of services before clear
	CAIN	T1,1		;There must always be at least one service
	RETBAD(LATX07)		;So return an error.
	IMULI	T1,GB.LEN	;Total length of service blocks
	XMOVEI	T4,HN.SRV(Q2)	;Service block start address
	ADD	T1,T4		;Address of first word outside service block
	XMOVEI	T2,GB.LEN(T3)	;First address to move down
	SUB	T1,T2		;Number of words to move down
	SKIPG	T1		;Is there a service block above?
	JRST	CSRVC0		;No so nothing to move
	XBLT. T1		;Compress all blocks downward
CSRVC0:	OPSTRM	<SOS>,HNNSV,(Q2)	;One service less.
	MOVEI	T1,HNCLS!HNSVD!HNSVR!HNSVN
	IORM	T1,HN.FLG(Q2)	;Indicate service changed.
	RETSKP

	SUBTTL	LATOP% JSYS -- Set/Clear Functions -- SETNNM


;SETNNM - Set LAT host name.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL SETNNM
; Return+1: Failure, T1/ error code
; Return+2: Success

SETNNM:	OPSTR	<SKIPE>,HNNMC,(Q2);Has one already been set?
	RETBAD	(LATX09)	;Yes, illegal to reset.
	UMOVE	T1,.LABFA(Q1)	;Node name string pointer from the user.
IFN FTOPS10,<
	SNCALL	(CKSTR##,MCSEC1)	;Is the ASCIZ string addressable?
	 RETBAD (LATXAC)	;No, address check for argument list
> ;End IFN FTOPS10
	MOVX	T2,<POINT 7,TMPBLK>;Pointer to where to build the string.
	MOVEI	T3,ML.NNM	;Maximum node name count.
	CALL	UMVAZS		;(T1-T3/T3)Move the ASCIZ string.
	 RETBAD (LATX06)
	STOR	T3,HNNMC,(Q2)	;Store the actual string count
	MOVEI	T1,<ML.NNM+4>/5	;Maximum number of words in the string
	XMOVEI	T2,TMPBLK	;Move the string to
	XMOVEI	T3,HN.NAM(Q2)	; the host node data base
	XBLT. T1		; ...
	RETSKP

	SUBTTL	LATOP% JSYS -- Set/Clear Functions -- SETNID/CLRNID


;SETNID/CLRNID - Set/Clear host identification string.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL SETNID/CLRNID
; Return+1: Failure, T1/ error code
; Return+2: Success

SETNID:	CAIN	P2,.LACLR	;Clearing rather than setting?
	JRST	CLRNID		;Yes.
	UMOVE	T1,.LABFA(Q1)	;Node description string pointer from the user.
IFN FTOPS10,<
	SNCALL	(CKSTR##,MCSEC1)	;Is the ASCIZ string addressable?
	 RETBAD (LATXAC)	;No, address check for argument list
> ;End IFN FTOPS10
	MOVX	T2,<POINT 7,TMPBLK>;Pointer to where to build the string.
	MOVEI	T3,ML.DSC	;Maximum node description count.
	CALL	UMVAZS		;(T1-T3/T3)Move the ASCIZ string.
	 RETBAD (LATX06)
	STOR	T3,HNIDC,(Q2)	;Store the actual string count
	MOVEI	T1,<ML.DSC+4>/5	;Maximum number of words in the string
	XMOVEI	T2,TMPBLK
	XMOVEI	T3,HN.ID(Q2)
	XBLT. T1
	RETSKP

CLRNID:	SETZRO	HNIDC,(Q2)	;Clear the string count
	RETSKP

	SUBTTL	LATOP% JSYS -- Set/Clear Functions -- SETCOD


; SETCOD - Set/clear access codes
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL SETCOD
; Return+1: Failure, T1/ error code
; Return+2: Success

SETCOD:
IFN FTOPS10,<
	UMOVE	T1,.LABFA(Q1)	;Get address of string
	MOVEI	T2,^D8		;and length
	SNCALL	(ARNGE##,MCSEC1)	; so check it.
	 ITERR (LATXAC)	;not there
	  NOP			;not writeable (that's ok)
> ;End IFN FTOPS10
	SAVEAC	<P1>
	STKVAR	<USRPTR,MSKPTR>
	SETZM	TMPBLK		;Zero out the storage where mask to be built.
	XMOVEI	T2,TMPBLK	;Zero the first workd
	XMOVEI	T3,1(T2)	;Address of second word
	MOVEI	T1,^D7		;Number of words to zero.
	XBLT. T1		;
	UMOVE	T1,.LABFA(Q1)	;Group code address in user space.
	HRLI	T1,441000	;Make an 8-bit byte pointer
	MOVEM	T1,USRPTR	;Save it as pointer to user code string.
	MOVX	T1,<POINT 8,TMPBLK>;Pointer to temporary storage for mask
	MOVEM	T1,MSKPTR	;Save it too.
	MOVEI	P1,^D32		;Number of bytes to do
	DO.
	  XCTBU [ILDB T1,USRPTR];Get a user group code byte
	  CALL BITSWP		;(T1/T1)Swap the bits
	  IDPB T1,MSKPTR	;Put into mask words
	  SOJG P1,TOP.		;Continue for full count
	ENDDO.
	MOVEI	T1,^D8		;32 bytes is 8 words
	XMOVEI	T2,AC.COD+7(Q2)	;Address of last group code word in database
	DO.
	  MOVE T3,TMPBLK-1(T1)	;Get a mask word, going backwards
	  CAIN P2,.LACLR	;Clearing of Setting?
	  IFSKP.
	    IORM T3,(T2)	;Set the bits
	  ELSE.
	    ANDCAM T3,(T2)	;Clear the bits
	  ENDIF.
	  SOS T2
	  SOJG T1,TOP.
	ENDDO.
	RETSKP			;Return success.
;BITSWP - Swap all bits in an 8-bit byte.
;
; T1/ Byte to swap
;	CALL BITSWP
; Return+1: Always, T1/ Swapped byte

BITSWP:	SAVEAC	<P1>
	JUMPE	T1,RTN		;If no bits, don't bother
	MOVEI	T3,1		;Bit to test
	MOVEI	T4,200		;Mirror bit
	SETZ	P1,		;Initialize result
	DO.
	  TRNE T1,(T3)		;Is the bit set?
	  TRO P1,(T4)		;Yes, set mirror bit in result
	  LSH T3,1		;Shift bit to test
	  LSH T4,-1		; and mirror bit
	  JUMPN T4,TOP.		;Done?
	ENDDO.
	MOVE	T1,P1		;Return swapped byte in T1
	RET

	SUBTTL	LATOP% JSYS -- SET MAXIMUM CIRCUITS
;[7.1164] Add routine SETMAC
;SETMAC - Set Maximum Circuits
;Call:	T2/ New Maximum Circuits value
;	Q2/ Host node data base address
;RETSKP - always
;
;	This routine is called when a user issues the SET MAX CIRCUITS
;command to LCP.  When it is called, HNMAC has already been range checked.
;It is in the range of 1 - CBMAXI.  

SETMAC:	STOR	T2,HNMAC,(Q2)	;Store the new value
	ADDI	T2,MAXACB	;HNMXC should be at least HNMAC+MAXACB
	OPSTR	<CAMG T2,>,HNMXC,(Q2)	;Is it?
	IFSKP.			;No, its not
	  CAILE T2,CBMAXI	;so make sure its not greater than CBMAXI
	  MOVEI T2,CBMAXI	; (It was, but its not now)
	  STOR T2,HNMXC,(Q2)	;And update HNMXC
	ENDIF.			;
	RETSKP			;All done

	XRESCD			;[7.1024]

;UMVAZS - Move a user ASCIZ string into monitor space.
;
; T1/ User's string pointer
; T2/ Monitor's destination pointer
; T3/ Maximum string length in bytes
;	CALL UMVAZS
; Return+1: Failure, string too long
; Return+2: Success, T3/ Number of bytes moved

UMVAZS:	STKVAR	<MAXCNT>
	MOVEM	T3,MAXCNT	;Save the maximum count
	SETZ	T3,		;Clear the string count
IFN FTOPS20,<
	TLC	T1,-1		;Make an ASCII pointer to the
	TLCN	T1,-1		; user's buffer
	HRLI	T1,(<POINT 7,0>)	; if necessary.
> ;End IFN FTOPS20
UMVAZ0:	XCTBU	[ILDB T4,T1]	;Get a character from his string.
	JUMPE	T4,RSKP		;Null found so string ended
	CAML	T3,MAXCNT	;If we are at the maximum, read no more.
	RET
	IDPB	T4,T2		;Deposit character in temp storage.
	AOJA	T3,UMVAZ0	;Increment string count

	ENDSV.

;MMVAZS - Move ASCIZ string within monitor context

;Call:	T1/ Source ASCIZ Pointer
;	T2/ Destination Pointer
;	T3/ Maximum string count permitted
;RET -  If string longer than maximum, truncated.
;	T3/ Actual string count

MMVAZS:	STKVAR	<MAXCNT>
	MOVEM	T3,MAXCNT	;Save the maximum count
	SETZ	T3,		;Clear the string count
IFN FTOPS20,<
	TLC	T1,-1		;[7.1039]Make an ASCII pointer to the
	TLCN	T1,-1		;[7.1039] user's buffer
	HRLI	T1,(<POINT 7,0>)	;[7.1039] if necessary.
> ;End IFN FTOPS20
MMVAZ0:	ILDB	T4,T1		;Get a character from his string.
	JUMPE	T4,RTN		;Null found so string ended
	CAML	T3,MAXCNT	;If we are at the maximum, read no more.
	RET
	IDPB	T4,T2		;Deposit character at destination
	AOJA	T3,MMVAZ0	;Increment string count

	ENDSV.
	SUBTTL	LATOP% JSYS -- Show Characteristics of Host

	XSWAPCD			;[7.1024]

;LASCH - Show LAT host characteristics.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASCH
; Return+1: Failure, T1/ error code
; Return+2: Success


LASCH:	SAVEAC	<P1,P2,P3>
	UMOVE	T3,.LABFA(Q1)	;User buffer address

;Check to see if the user provided buffer is large enough for all the data
;
	LOAD	T1,HNNSV,(Q2)	;Compute the total buffer size
	IMULI	T1,GB.LEN	; required.
	ADDI	T1,<HN.MXC-HN.MTI+<ML.LOC+3>/4+<ML.DSC+3>/4+<ML.NNM+3>/4+^D16>
	CALL	UBFCHK		;[7.1039](T1,Q1/T1)Is user's buffer big enough?
	 RETBAD ()		;[7.1039]No, too small

;Move fixed length dynamic parameters from the host node database (HN) to the
;user's buffer.
;
	MOVEI	T1,<HN.MTI-HN.MXC+1>;Number words to move
	XMOVEI	T2,HN.MXC(Q2)	;Address of first HN parameter to move
	XBLTXU	T1

;Move static parameters to the user's buffer.
;
	MOVEI	T1,5		;Number of words to move
	XMOVEI	T2,[EXP <LAHPV,,LALPV>;Static parameter address
		   EXP <PROECO,,PROVER>
		   EXP <MXSLSI,,MXSLTS>
		   EXP <LMRFSI,,MXHSRV>
		   EXP <LHPRID,,0>]
	XBLTXU	T1

;Move the access code words
;
	MOVEI	P3,^D32		;Number of bytes for the access codes
	XMOVEI	P2,AC.COD(Q2)	;Address of the access codes
	TXO	P2,<OWGP. 8,0>	;Make global pointer
	MOVE	P1,T3		;Current address in user's buffer.
	TXO	P1,<OWGP. 8,0>	;Make a byte pointer
	DO.
	  ILDB T1,P2		;Get a byte for group codes
	  CALL BITSWP		;(T1/T1)Swap the bits
	  XCTBU [IDPB T1,P1]	;Deposit swapped byte into user buffer.
	  SOJG P3,TOP.		;Do all bytes
	HRRZI	T3,1(P1)	;Make user pointer an address again.
	ENDDO.
;Move Host node name and host node description
;
	MOVEI	T1,<<ML.NNM+4>/5+<ML.DSC+4>/5+1>	;[7.1039]
	XMOVEI	T2,HN.NMC(Q2)	;[7.1039]Address of node name and description
	XBLTXU	T1		;[7.1039]

;Move the service blocks
;
	LOAD	T1,HNNSV,(Q2)	;Number of services currently defined
	UMOVEM	T1,(T3)		;Move to user buffer
	AOS	T3		;Advance buffer address
	LOAD	T1,HNNSV,(Q2)	;Get the size of the
	IMULI	T1,GB.LEN	; service blocks.
	XMOVEI	T2,HN.SRV(Q2)	;Address of service blocks
	XBLTXU	T1
	RETSKP

	SUBTTL 	LATOP% JSYS -- Show Terminal Connects


;LASTC - Show terminal connects.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASTC
; Return+1: Failure, T1/ error code
; Return+2: Success

;[7.1039]Clean up register usage in LASTC/LAS1C
LASTC:	SAVEAC	<P1,P2,P3>
	STKVAR	<LTTCNT>
	LOAD	T1,HNCON,(Q2)	;How many do we think are connected?
	MOVE	P1,T1		;Save count
	XMOVEI	P3,LAS1C	;[7.1120]Get routine to handle old connect blk
	MOVEI	T3,MW.OCB	;[7.1120]Initialize T3 with old size
	UMOVE	T2,.LABCT(Q1)	;[7.1120]Get the ECB flag
	TXNN	T2,LA%ECB	;[7.1120]Is it set?
	IFSKP.			;[7.1120]Yes, so...
	  XMOVEI P3,LAS2C	;[7.1120] get routine to handled new
	  MOVEI T3,MW.ECB	;[7.1120] connect block and use new size.
	ENDIF.			;[7.1120]
	IMUL	T1,T3		;[7.1120]Calculate buffer space requirements
	CALL	UBFCHK		;[7.1039](T1,Q1/T1)Is his buffer big enough?
	 RETBAD ()		;[7.1039]No, too small
	MOVEI	T1,NTTLAH	;Get size of SBvect
	MOVEM	T1,LTTCNT	;Save in local for decrementing
	UMOVE	T3,.LABFA(Q1)	;Get user's buffer address
	MOVE	P2,SBVECT	;Point to table of SBs
LASTCL:	SKIPE	T1,1(P2)	;Is there a slot block there?
	CALL	0(P3)		;[7.1120](T1,T3/T3)Yes-move data to user buffer
	 JRST LASTCN		;No, go for next one
	SOJLE	P1,LASTCD	;Have we given the user as many as we said?
LASTCN:	SOSLE	LTTCNT		;Or have we exhausted SBVECT?
	AOJA	P2,LASTCL	;No, just go for next data block
LASTCD:	UMOVE	T1,.LABFA(Q1)	;Done, get address of show buffer again
	SUB	T3,T1		;Calculate number of words moved
	XCTU	[HRLM T3,.LABCT(Q1)]	;and store it.
	RETSKP			;And give good return

;LAS1C - Move one connect block to the user's show buffer.
;
; T1/ Slow block address
; T3/ Next address in the show buffer
;	CALL LAS1C
; Return+1: Failure, no attached terminal or circuit block
; Return+2: Success, T3/ Updated address into show buffer

LAS1C:
IFN FTOPS20,<
	SKIPE	T2,SB.TDB(T1)	;Any LDB associated with slot?
	SKIPN	T4,SB.CBA(T1)	;Any circuit block?
	RET			;No, skip this one
	DYNST			;Get TTY line number (in T2)
> ;End IFN FTOPS20
IFN FTOPS10,<
	SKIPE	U,SB.TDB(T1)	;Any LDB associated with slot?
	SKIPN	T4,SB.CBA(T1)	;Any circuit block?
	RET			;No, skip this one
	LDB	T2,@[IW MCSEC1,LDPLNO##]	;Get TTY line number
> ;End IFN FTOPS10
	OPSTR	<HRLZ T1,>,CBRSC,(T4)	;Get server name string count
	UMOVEM	T2,0(T3)	;Give the TTY line number to the user
	UMOVEM	T1,1(T3)	;Store counts
	ADDI	T3,2		;Two words have been moved
	MOVEI	T1,<<ML.SYS+4>/5>	;Get length of string
	XMOVEI	T2,CB.SNM(T4)	;Source name string
	XBLTXU	T1		;Fill in the user's buffer
	RETSKP
;LAS2C - Move one extended connect block to the user's show buffer.
;[7.1120]
; T1/ Slow block address
; T3/ Next address in the show buffer
;	CALL LAS2C
; Return+1: Failure, no attached terminal or circuit block
; Return+2: Success, T3/ Updated address into show buffer

LAS2C:	MOVE	T4,T1		;Stash the SB address here
IFN FTOPS20,<
	SKIPE	T2,SB.TDB(T4)	;Any LDB associated with slot?
	SKIPN	SB.CBA(T4)	;Any circuit block?
	RET			;No, skip this one
	DYNST			;Get TTY line number (in T2)
> ;End IFN FTOPS20
IFN FTOPS10,<
	SKIPE	U,SB.TDB(T4)	;Any LDB associated with slot?
	SKIPN	SB.CBA(T4)	;Any circuit block?
	RET			;No, skip this one
	LDB	T2,@[IW MCSEC1,LDPLNO##]	;Get TTY line number
> ;End IFN FTOPS10
	UMOVEM	T2,0(T3)	;Give the TTY line number to the user
	MOVEI	T2,.LATTY	;Assume standard tty
	OPSTR	<SKIPE>,SBDLP,(T4);Is this a dialup?
	MOVEI	T2,.LADLP	;Maybe, if it isn't an application terminal...
	OPSTR	<SKIPE>,SBPRA,(T4);Is it an application terminal?
	MOVEI	T2,.LAAPP	;Yes
	OPSTR	<HRL T2,>,SBSRC,(T4)	;Get server name string count
	UMOVEM	T2,1(T3)	;Store counts
	ADDI	T3,2		;Two words have been moved
	MOVEI	T1,<<ML.SYS+4>/5>	;Get length of string
	XMOVEI	T2,SB.SRN(T4)	;Source name string
	XBLTXU	T1		;Fill in the user's buffer
	OPSTR	<HRL T2,>,SBPRC,(T4)	;Get the port name count
	OPSTR	<HRR T2,>,SBSVC,(T4)	;Get the service name count
	UMOVEM	T2,0(T3)	;Give these counts to the user
	AOS	T3		;Another word has been moved
	MOVEI	T1,<<ML.SYS+4>/5>*2	;Get length of the string
	XMOVEI	T2,SB.PRN(T4)	;Port/service name strings
	XBLTXU	T1		;Fill in the user's buffer
	RETSKP
	SUBTTL	LATOP% JSYS -- Show Adjacent Servers


;LASAS - Show adjacent servers.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASAS
; Return+1: Failure, T1/ error code
; Return+2: Success

LASAS:	CAIL	P1,.LAQUA+1	;[7.1120]
	XCTU	[SKIPN T1,.LAQUA(Q1)]	;Is there a server name?
	IFSKP.			;Yes, return information for that one
IFN FTOPS20,<
	  CALL MAKPTR		;(T1/T1)Make a valid ASCIZ pointer.
>
IFN FTOPS10,<
	  SNCALL (CKSTR##,MCSEC1) ;Is the ASCIZ string addressable?
	   RETBAD (LATXAC)	;No, address check for argument list
> ;End IFN FTOPS10
	  CALL GTSRVR		;(T1,Q2/T1)Find circuit block by server name.
	   RETBAD ()		;Unknown server
	  MOVE T4,T1		;Save the circuit block address
	  MOVEI T1,<SASEND-SASBEG>;# words returned for single server
	  CALL UBFCHK		;[7.1039](T1,Q1/T1)Is user's buffer big enough?
	   RETBAD ()		;No, too small
 	  UMOVE T3,.LABFA(Q1)	;Get his buffer address
	  XMOVEI T2,SASBEG(T4)	;Address of source
	  XBLTXU T1		;Move to user space
	  RETSKP		;Return successfully.
	ENDIF.

	LOAD	T1,HNNCC,(Q2)	;Get the number of allocated circuit blocks
	IMULI	T1,<<<ML.SYS+4>/5>+3>;Compute space needed in user's buffer
	CALL	UBFCHK		;[7.1039](T1,Q1/T1)Is user's buffer big enough?
	 RETBAD ()		;[7.1039]No, too small
	UMOVE	T3,.LABFA(Q1)	;Get user buffer address
	MOVE	T4,HN.QAC(Q2)	;First element on the active queue
	CALL	SASLP		;Get all those on the active queue
	MOVE	T4,HN.QIC(Q2)	;Do the same for
	CALL	SASLP		; the inactive queue.
	RETSKP			;Return successfully.

SASLP:	JUMPE	T4,RTN		;No more circuit blocks on this queue
	MOVE	T1,CB.RSC(T4)	;get <number,,name count>
	UMOVEM	T1,(T3)		;Give it to user
	ADDI	T3,1		;Bump destination address
	MOVEI	T1,<<ML.SYS+4>/5>	;There are 4 words of name
	XMOVEI	T2,CB.SNM(T4)	;Address of first to copy
	XBLTXU	T1		;Copy to user's space
	DMOVE	T1,CB.DNI(T4)	;Get Ethernet address
	XCTU	[DMOVEM T1,(T3)]	;Give it to the user
	ADDI	T3,2		;Account for those words
	LOAD	T4,QLFWD,+CB.LNK(T4);Get the next CB
	JRST	SASLP		;And continue looping thru queue

	SUBTTL	LATOP% JSYS -- Show Counters


;LASCO - Show LAT Counters.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASCO
; Return+1: Failure, T1/ error code
; Return+2: Success

LASCO:	UMOVE	T1,.LAQUA(Q1)	;Get server name requested
	CALL	GTLCOB		;(T1/T1,T2)Get counter block given server name.
	 RET			;Error, already reported
	XCTU	[HRLM T1,.LABCT(Q1)];Tell user
	XCTU	[HRRZ T3,.LABCT(Q1)];Get his buffer count.
	CAMGE	T3,T1		;Has user allocated large enough buffer?
	RETBAD	(LATX01)	;No
	UMOVE	T3,.LABFA(Q1)	;Get his buffer address
	XBLTXU	T1
	RETSKP

	SUBTTL	LATOP% JSYS -- Zero counters


;LAZCO - Zero LAT Counters.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LAZCO
; Return+1: Failure, T1/ error code
; Return+2: Success

LAZCO:	UMOVE	T1,.LAQUA(Q1)	;Get server name requested
	CALL	GTLCOB		;(T1/T1,T2)Get counter block given server name.
	 RET			;Error, already reported
	SETZM	(T2)		;Zero the first counter
	XMOVEI	T3,1(T2)	;
	SOSLE	T1		;Compute number of words to zero
	XBLT. T1		;Zero the block
	RETSKP			;Return successfully.
;GTLCOB - Get LAT Counter Block.  Get the length and address of the LAT
; counter block based on server number.

;CALL:	T1/ Pointer to server name or [0,,-1]
;RET:	Error - server unknown
;RETSKP:Success with
;	T1/ Counter block length in words
;	T2/ Counter block address

GTLCOB:	XCTU	[SKIPN T1,.LAQUA(Q1)]	;[7.1039]Get server name requested
	IFSKP.			;Zero a particular server's counters
IFN FTOPS20,<
	  CALL MAKPTR		;(T1/T1)Make a valid pointer
>
IFN FTOPS10,<
	  SNCALL (CKSTR##,MCSEC1) ;Check to see if ASCIZ string is addressable
	   RETBAD (LATXAC)	;Nope, lose
>;end ifn FTOPS10
	  CALL GTSRVR		;(T1,Q2/T1)Find circuit block given server name
	   RETBAD ()		;Unknown server
	  XMOVEI T2,CC.BEG(T1)	;Server counter block address
	  MOVEI T1,CC.LEN	;Server counter block length
	ELSE.			;Local host counters wanted
	  MOVEI T1,HC.LEN	;Host counter block length
	  XMOVEI T2,HC.BEG(Q2)	;Host counter block address
	ENDIF.
	RETSKP
	SUBTTL	LATOP% JSYS -- Request Host-Initiated Connect


;[7.1120]
;LARHC - Request host-initiated connect.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LARHC
; Return+1: Failure, T1/ error code
; Return+2: Success

LARHC:	MOVEI	T1,PR.LEN	;Length of the pending request block
	CALL	MMGTZW		;(T1/T1)Allocate memory
	 RETBAD (LATX08)	;Error, insufficient LAT resources
	MOVEM	T1,P2		;Save address of pending request block
	CALL	CKRHC		;(Q1,Q2,P1,P2)Check the arguments
	IFSKP.
	  LOAD T1,PRCID,(P2)	;Save the connect id
	  XCTU [HRRM T1,.LAPRM(Q1)]
	  OPSTR <SKIPN>,PRWAI,(P2) ;Wait for the connection?
	  RETSKP		;Return (PSI interrupt on connection)
	  MOVE T1,P2		;Get address of pending request block
	  CALL PRWAIT		;(T1)Wait for the connection
	  MOVE T1,P2		;Get address of pending request block
	  LOAD T2,PRSTS,(P2)	;Return with status, rejection code,
	  UMOVEM T2,.LAVAL(Q1)	; or Terminal Designator
IFN FTOPS20,<
	  TXNE T2,.TTDES	;Did the connection succeed?
> 				;End IFN FTOPS20
IFN FTOPS10,<
	  CAIL T2,.UXTRM	;
	  CAILE T2,.UXTRM+777	;Did the connection succeed?
	  TRNA			;No, SKIP
>				;End IFN FTOPS10
	  RETSKP		;Yes - the connection succeeded.
	  SETZ T2,		;Here if it failed... Clear T2
	  XCTU [HRRM T2,.LAPRM(Q1)] ;Connect ID is invalid
	  CALL PRDEL		;Delete the pending request
	  RETSKP		;Return
	ENDIF.
	EXCH	T1,P2		;Save the error code and get the
				; address of the pending request block
	CALL	PRDEL		;(T1)Delete the pending request block
	MOVE	T1,P2		;Restore the error code
	RETBAD	()		;
;[7.1120]
;CKRHC - Check the .LARHC argument list and fill in the pending request block.
; This subroutine does almost all of the work for the routine LARHC so
; that LARHC can easily deallocate resources if an error occurs.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ Address of the pending request block
;	CALL CKRHC
; Return+1: Failure, T1/ error code
; Return+2: Success

CKRHC:	MOVX	T1,.LASOL	;Initialize status to "Soliciting"
	STOR	T1,PRSTS,(P2)	;
	UMOVE	T3,.LAPRM(Q1)	;Get the parameter word
	SETO	T1,		;
	TXNE	T3,LA%QUE	;Should the server queue this request?
	STOR	T1,PRQUE,(P2)	;Yes, set this bit

IFN FTOPS20,<
	SAVEAC	<P3>		;Get an AC
	MOVE	P3,T3		;Save user's parm's here
	MOVE	T2,JOBNO	;Get my job number
	STOR	T2,PRJOB,(P2)	;Save it here
	MOVE	T2,FORKX	;Get my fork number
	STOR	T2,PRFRK,(P2)	;Save it here
	TXNN	T3,LA%PSI	;Using the interrupt system?
	IFSKP.
	  LDB T2,[POINTR (T3,LA%CHN)]
	  STOR T2,PRPSI,(P2)	;Save the interrupt channel
	ELSE.
	  STOR T1,PRWAI,(P2)	;Save the event wait flag
	ENDIF.

> ;End IFN FTOPS20

IFN FTOPS10,<
	TXNE	T3,LA%WAI	;Is the wait bit set?
	STOR	T1,PRWAI,(P2)	;Yes, set the event wait flag
	MOVE	T2,.CPJCH##	;Save the JCH
	STOR	T2,PRFRK,(P2)	;
	ANDI	T2,JOBMSK##	;Save the job number
	STOR	T2,PRJOB,(P2)	;
> ;End IFN FTOPS10

				; ..
				; ..

; Get the server name, service name, and port name.
;
	CALL	MVRHC		;(Q1,P1,P2)Move the ASCIZ strings
	 RETBAD ()		;Error, return
	OPSTR	<SKIPG>,PRSRC,(P2)	;Is there a server name?
	RETBAD	(LATX04)	;No, invalid or unknown server name
	LOAD	T1,PRSVC,(P2)	;Get the length of the service name
	LOAD	T2,PRPRC,(P2)	;Get the length of the port name
	SKIPN	T1		;Is there a service name
	SKIPE	T2		; or port name?
	TRNA 			;Yes, all is well
	RETBAD	(LATX07)	;No, invalid or unknown service name

; Format the Solicit Information message.
;
	CALL	PRGET		;(/T1)Get a free PRVECT index number
	 RETBAD (LATX08)	;Error, insufficient LAT resources
	STOR	T1,PRCID,(P2)	;Save the PRVECT index number
	MOVX	T1,SBF.OF+<ML.HCM+4>/5	;Get max length of a command msg
	CALL	MMGTZW		;(T1/T1)Allocate space for one
	 RETBAD (LATX08)	;Error, insufficient LAT resources
	STOR	T1,PRXBA,(P2)	;Save address of transmit buffer
	MOVE	T1,P2		;Copy the address of pending request block
	CALL	FMSIN		;(T1)Format Solicit Information message
	 RETBAD ()		;Error, return
	MOVX	T1,SS.SIN	;Change to Soliciting Information state
	STOR	T1,PRSTA,(P2)	; (need the Ethernet address)
	LOAD	T1,PRCID,(P2)	;Get the PRVECT index number
	ANDI	T1,PR.NDX	;Throw away the random portion
IFN FTOPS20,<
	TXNE	P3,LA%PSI	;Does the user want to block?
	IFSKP.
	  MOVE T2,T1		;Yes, don't destroy T1 (index into PRVECT)
	  IDIVI T2,^D36		;Calculate the offset T2,
	  MOVE T3,BITS(T3)	; and the bit in T3
	  IORM T3,PRWMSK(T2)	;Set it now, so scheduler test will block
	ENDIF.
>				;End IFN FTOPS20
	ADD	T1,PRVECT	;Calculate address of PRVECT entry
	MOVEM	P2,(T1)		;Save address of slot block
	RETSKP			;
;[7.1120]
;MVRHC - Move the string values for the routine CKRHC.
;
; Q1/ User argument block address
; P1/ Length of user argument block
; P2/ Address of the pending request block
;	CALL MVRHC
; Return+1: Failure, T1/ error code
; Return+2: Success

MVRHC:	SAVEAC	<P3>		;Save P3
	MOVN	P3,P1		;
	CAILE	P1,.LAPRT+1	;Too many arguments specified?
	MOVNI	P3,.LAPRT+1	;Yes, use the maximum
	ADDI	P3,.LASVR	;Calculate the negative number of strings
	HRLZS	P3		;Make it an AOBJN pointer

; Loop for each of the ASCIZ strings specified.
;
MVRHC1:	MOVEI	T1,.LASVR(P3)	;Calculate the address 
	ADD	T1,Q1		; of the ASCIZ string pointer
	XCTU	[SKIPN T1,(T1)]	;Get the string pointer itself
	JRST	MVRHC2		;None, try the next one
IFN FTOPS20,<
	TLNN	T1,777777	;Is it a valid byte pointer?
	JRST	MVRHC3		;No, invalid or unknown name
> ;End IFN FTOPS20
IFN FTOPS10,<
	TLNN	T1,777777	;Is it a valid byte pointer?
	TXO	T1,<POINT 7>	;No, make it a valid byte pointer
	SNCALL	(CKSTR##,MCSEC1)	;(T1)Is this string addressable?
	 RETBAD (LATXAC)	;No, address check for argument list
> ;End IFN FTOPS10
	XMOVEI	T2,(P2)		;Calculate the destination address
	ADD	T2,RHCDST(P3)	;Make it a global byte pointer
	MOVE	T3,RHCMXL(P3)	;Get the maximum length
	CALL	UMVAZS		;(T1,T2,T3/T3)Move the ASCIZ string
	 JRST MVRHC3		;Error, invalid or unknown name
	XCT	RHCXCT(P3)	;Save the length of the string
MVRHC2:	AOBJN	P3,MVRHC1	;Save all of the ASCIZ strings
	RETSKP			;

; Come here to return with an invalid or unknown name error.
;
MVRHC3:	MOVE	T1,RHCERR(P3)	;Return with appropriate error code
	RET
;[7.1120] Table of destination byte pointers
;
RHCDST:	OWGP. 7,PR.SRN		;Server name
	OWGP. 7,PR.SVN		;Service name
	OWGP. 7,PR.PRN		;Port name


; Table of maximum lengths
;
RHCMXL:	EXP	ML.SRN		;Server name
	EXP	ML.SVN		;Service name
	EXP	ML.PRN		;Port name


; Table of instructions to save the byte count
;
RHCXCT:	STOR	T3,PRSRC,(P2)	;Server name
	STOR	T3,PRSVC,(P2)	;Service name
	STOR	T3,PRPRC,(P2)	;Port name
	

; Table of error codes if the name is invalid
;
RHCERR:	EXP	LATX04		;Invalid or unknown server name
	EXP	LATX07		;Invalid or unknown service name
	EXP	LATX10		;Invalid or unknown port name
;[7.1120]
;PRGET - Get a free PRVECT index number.
;
;	CALL PRGET
; Return+1: Failure, insufficient resources
; Return+2: Success, T1/ PRVECT index number

PRGET:	MOVSI	T3,-PRBITN	;Look for a free PR block index
IFN FTOPS10,<UUOLOK		;Get the interlock: one user at a time>
PRGET1:	SKIPE	T1,PRBITS(T3)	; by examining the free PR block words
	JFFO	T1,PRGET2	; for the first 1 bit.  This represents
	AOBJN	T3,PRGET1	; the first free PR block index.
IFN FTOPS10,<UUONLK		;Give up the interlock>
	RET			;No PR blocks available
PRGET2:	MOVE	T1,BITS(T2)	;Clear the bit since the index is
	ANDCAM	T1,PRBITS(T3)	; no longer free.
IFN FTOPS10,<UUONLK		;Give up the interlock>
	HRRZ	T1,T3		;Compute the PR block index,
	IMULI	T1,^D36		; which must be greater than zero.
	ADDI	T1,1(T2)	;
	CAILE	T1,PRMAXI	;Larger than the maximum?
	RET			;Yes, insufficient resources
	MOVE	T3,T1		;Copy the index number
	ADD	T3,PRRAND	;Get address of random number
	AOS	T2,(T3)		;Get the next random number
	ANDI	T2,PR.RAN	;Perform modulo arithematic
	JUMPG	T2,PRGET3	;Non-zero: use it in the connect id
	AOS	(T3)		;Get the next random number
	AOS	T2		;Wrap around to one
PRGET3:	DPB	T2,[POINTR (T1,PR%RAN)]	;Fill in the ranom portion
	RETSKP			;
	XRESCD			;[7.1120]

;[7.1120]
;PRREL - Release a PRVECT index number.
;
; T1/ PRVECT index number
;	CALL PRREL
; Return+1: Always

PRREL:	ANDI	T1,PR.NDX	;Throw away the random portion
	JUMPE	T1,RTN		;Zero left: return
	MOVE	T2,T1		;Copy the index number
	ADD	T2,PRVECT	;Get address of PRVECT entry
	SETZM	(T2)		;Clear the address
	SOS	T1		;PRVECT index numbers start with one
	IDIVI	T1,^D36		;Get the PRBITS index and bit number
	MOVE	T2,BITS(T2)	;Get a bit to set with
	IORM	T2,PRBITS(T1)	;Set the bit to indicate that it is free
	RET			;


;[7.1120]
;PRDEL - Delete a PRVECT entry.
;
; T1/ Address of pending request block
;	CALL PRDEL
; Return+1: Always

PRDEL:	SAVEAC	<P1>		;
	MOVE	P1,T1		;Save address of pending request block
	OPSTR	<SKIPN T1,>,PRSBA,(P1)	;Is there a slot block?
	IFSKP.			;
	  BUG. (CHK,LATIPR,LATSER,SOFT,<LAT Invalid PR block>,<<P1,PRBLOK>,<T1,SBBLOK>>,<

Cause:	A	Pending Request block was about to be deleted that still had a
	Slot block attached to it.

>)
	ENDIF.
	OPSTR	<SKIPE T1,>,PRCID,(P1)	;Is there a PRVECT index number?
	CALL	PRREL		;(T1)Yes, release it
	OPSTR	<SKIPN T1,>,PRXBA,(P1)	;Is there a transmit buffer?
	IFSKP.
	  MOVX T2,DLL.FL	;
	  EXCH T2,UNUID+UNB.OF(T1) ;Clear the "Keep me" bit
	  TXNN T2,DLL.FL	;Is this buffer inside NI service?
	  CALL MMFREE		;(T1)No, release this buffer
	ENDIF.
	MOVE	T1,P1		;
	CALLRET	MMFREE		;(T1)Deallocate the slot block
;[7.1120]
;FMSIN - Format a Solicit Information message.
;
; T1/ Address of pending request block
;	CALL FMSIN
; Return+1: Failure, T1/ Error code
; Return+2: Success

FMSIN:	SAVEAC	<P1,P2,P3>	;
	MOVE	P1,T1		;Save address of pending request block
	LOAD	P2,PRXBA,(P1)	;Get address of transmit buffer
	SKIPN	P3,LAHNDB	;Get address of host node (HN) table
	RETBAD	(LATX03)	;Error, LAT is not operational
	SETZ	T3,		;Initialize the byte count
	XMOVEI	T4,SBF.OF(P2)	;Get address of transmit buffer
	TXO	T4,<OWGP. 8,0>	;Make it a global byte pointer
	STOR	T4,UNBFA,+UNB.OF(P2)	;Save the byte pointer

; Build the fixed portion of the message.
;
	MOVX	T1,MT.SIN_2	;Message type = Solicit Information
				; (RM bits = 0) protocol format = 0
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,LALPV_10+LAHPV	;Hishest protocol version and
				; lowest procotol version
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,PROECO_10+PROVER;Current protocol version and
				; current protocol ECO level
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,LMRFSI+^D14	;Data link receive frame size
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	LOAD	T1,PRCID,(P1)	;Use PRVECT index number
				; as the solicit identifier
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	LOAD	T1,HNCMT,(P3)	;Get the response timer
	IDIVI	T1,^D1000	;[7.xxxx]Convert to seconds
	CALL	MVBY2		;(T1,T3,T4/T3,T4)

				; ..
				; ..

	LOAD	T1,PRSRC,(P1)	;Get the server name count
	XMOVEI	T2,PR.SRN(P1)	;Get address of server name string
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	LOAD	T1,ACLNG,(P3)	;Get the length of the group code
	XMOVEI	T2,AC.COD(P3)	;Get address of group code
	TXO	T2,<OWGP. 8,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put it in the string
	LOAD	T1,HNNMC,(P3)	;Get the host name count
	XMOVEI	T2,HN.NAM(P3)	;Get address of the host name
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	LOAD	T1,PRSVC,(P1)	;Get the service name length
	XMOVEI	T2,PR.SVN(P1)	;Get address of service name
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	SETZ	T1,		;
	IDPB	T1,T4		;No parameters specified
	ADDI	T3,1		;Update the length of the message
	STOR	T3,UNBSZ,+UNB.OF(P2)	;Save the length of the message
	DMOVE	T1,[BYTE (8) 11,00,53,00,00,17,00,00]
	OPSTRM	<DMOVEM T1,>,UNDAD,+UNB.OF(P2)	;Store multicast address
	RETSKP			; (09-00-2B-00-00-0F)
;[7.1120]
;FMSAC - Format a Solicit Access message.
;
; T1/ Address of pending request block
;	CALL FMSAC
; Return+1: Failure, T1/ Error code
; Return+2: Success

FMSAC:	SAVEAC	<P1,P2,P3>	;
	MOVE	P1,T1		;Save address of pending request block
	LOAD	P2,PRXBA,(P1)	;Get address of transmit buffer
	SKIPN	P3,LAHNDB	;Get address of host node (HN) table
	RETBAD	(LATX03)	;Error, LAT is not operational
	SETZ	T3,		;Initialize the byte count
	XMOVEI	T4,SBF.OF(P2)	;Get address of transmit buffer
	TXO	T4,<OWGP. 8,0>	;Make it a global byte pointer
	STOR	T4,UNBFA,+UNB.OF(P2)	;Save the byte pointer 

; Build the fixed portion of the command message.
;
	MOVX	T1,MT.CMD_2	;Message type = Command Message
				; (RM bits = 0) protocol format = 0
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,LALPV_10+LAHPV	;Highest protocol version and
				; lowest protcol version
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,PROECO_10+PROVER;Current protocol version and
				; current protocol ECO level
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,LMRFSI+^D14	;Data link receive frame size
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	LOAD	T1,PRCID,(P1)	;Use PRVECT index number
				; as the request number
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	SETZ	T1,0		;Entry identifier = 0
	CALL	MVBY2		;(T1,T3,T4/T3,T4)
	MOVX	T1,1		;Solicit non-queued access and no status
	OPSTR	<SKIPE>,PRQUE,(P1)	;Do we want queued access?
	MOVX	T1,2_10+2	;Solicit queued access and send status
				; every time the queue depth changes
	CALL	MVBY2		;(T1,T3,T4/T3,T4)

				; ..
				; ..

; Fill in the first part of the object information: the server name.
;
	LOAD	T1,PRSRC,(P1)	;Get the server name count
	XMOVEI	T2,PR.SRN(P1)	;Get address of server name string
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message

; Fill in the subject information.
;
	LOAD	T1,ACLNG,(P3)	;Get the length of the group code
	XMOVEI	T2,AC.COD(P3)	;Get address of group code
	TXO	T2,<OWGP. 8,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	LOAD	T1,HNNMC,(P3)	;Get the host name count
	XMOVEI	T2,HN.NAM(P3)	;Get address of the host name
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	SETZ	T1,		;
	IDPB	T1,T4		;There is no subject port name
	IDPB	T1,T4		;There is no subject description name
	ADDI	T3,2		;Update the length of the message

; Fill in the object information.
;
	LOAD	T1,PRSVC,(P1)	;Get the service name length
	XMOVEI	T2,PR.SVN(P1)	;Get address of service name
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	LOAD	T1,PRPRC,(P1)	;Get the port name length
	XMOVEI	T2,PR.PRN(P1)	;Get address of port name
	TXO	T2,<OWGP. 7,0>	;Make it a global byte pointer
	CALL	MVSTC		;(T1-T4/T3,T4)Put string in message
	SETZ	T1,		;
	IDPB	T1,T4		;No parameters specified
	ADDI	T3,1		;Update the length of the message
	STOR	T3,UNBSZ,+UNB.OF(P2)	;Save the length of the message
	OPSTR	<DMOVE T1,>,PRDNI,(P1)	;Use the correct Ethernet address
	OPSTRM	<DMOVEM T1,>,UNDAD,+UNB.OF(P2)
	RETSKP			;
;[7.1120]
;FMCAN - Change the Solicit Access to a Cancel Entry message.
;
; T1/ Address of pending request block
;	CALL FMCAN
; Return+1: Failure, no entry id
; Return+2: Success

FMCAN:	SAVEAC	<P1,P2>		;
	MOVE	P1,T1		;Save address of slot block
	OPSTR	<SKIPE T1,>,PREID,(P1)	;Is there an entry id?
	OPSTR	<SKIPN P2,>,PRXBA,(P1)	;Is there a transmit buffer?
	RET			;No, no Status messages received
	XMOVEI	T3,<SBF.OF>(P2)	;[7.1150]Get address of transmit buffer
	TXO	T3,<OWGP. 8,0>	;[7.1150]Make it a global byte pointer
	MOVEI	T4,MT.EID	;[7.1150]Get the offset to the entry id
	ADJBP	T4,T3		;[7.1150]Point there
	CALL	MVBY2		;(T1,T3,T4/T3,T4)Put entry-id in message
	MOVX	T3,3		;[7.1150]Command type = Cancel
	IDPB	T3,T4		;[7.1150]Put it in the message
	RETSKP			;
;[7.1120]
;MVSTC - Move a counted string (including the byte count).
;MVSTR - Move a counted string.
;
; T1/ Source count
; T2/ Source byte pointer
; T3/ Destination count
; T4/ Destination byte pointer
;	CALL MVSTC or MVSTR
; Return+1: Always
;  T3/ Destination count
;  T4/ Destination byte pointer

MVSTC:	IDPB	T1,T4		;Put the byte count in the message
	ADDI	T3,1		;Update the length of the message
MVSTR:	SAVEAC	<P1>		;
MVSTR1:	SOJL	T1,RTN		;Negative: finished
	ILDB	P1,T2		;Get the next character
	IDPB	P1,T4		;Put it in the message
	AOJA	T3,MVSTR1	;Count this character and continue


;[7.1120]
;MVBY2 - Move two bytes (LO first).
;
; T1/ Source
; T3/ Destination count
; T4/ Destination byte pointer
;	CALL MVBY2
; Return+1: Always
;  T3/ Destination count
;  T4/ Destination byte pointer

MVBY2:	IDPB	T1,T4		;Save the LO byte first
	LSH	T1,-^D8		;Shift the HO byte into position
	IDPB	T1,T4		;Save the HO byte
	ADDI	T3,2		;Update the byte count
	RET			;
;[7.1120]
IFN FTOPS20,<
	RESCD
LATST::	IDIVI T1,^D36		;Bit number in T1: Calculate the offset in T1
	MOVE	T2,BITS(T2)	; and the bit number in T2.
	TDNE	T2,PRWMSK(T1)	;Skip if bit clear
	RET			;Keep sleeping
	RETSKP			;Wake user
> ;End IFN FTOPS20

	XRESCD

;[7.1120]
;PRWAIT - Wait for a connection.
;
; T1/ Address of pending request block
;	CALL PRWAIT
; Return+1: Always

PRWAIT:
IFN FTOPS20,<
	LOAD	T2,PRSTS,(T1)	;Get the status of the connection
	CAIE	T2,.LASOL	;Is it being solicited
	CAIN	T2,.LAQUE	; or queued?
	TRNA			;Yes, go ahead.
	RET			;No, return
	LOAD	T2,PRCID,(T1)	;Get the connect id
	ANDI	T2,PR.NDX	;Just keep the index into PRVECT
	HRL	T1,T2		;Save it for later, LH of T1
	HRRI	T1,LATST	;Scheduler test in the right
	UNLOCK	HN.LOK(Q2)	;Unlock the database so others can use it
	OKINT			;So we can receive interrupts (and type ^C)
	MDISMS			;Wait...
	NOINT			;We woke up, so go NOINT again
	LOCK	HN.LOK(Q2)	;Lock the database again
	RET			;All done...

>;END IFN FT0PS20

IFN FTOPS10,<
	SAVEAC	<J,W,P1>	;
	MOVE	P1,T1		;Save address of pending request block
PRWAI1:	LOAD	T1,PRSTS,(P1)	;Get the status of the connection
	CAXE	T1,.LASOL	;Is it being solicited
	CAXN	T1,.LAQUE	; or queued?
	TRNA			;Yes, continue waiting
	RET			;No, return
	MOVX	T1,EV.LAT	;LAT event
	LOAD	J,PRJOB,(P1)	;Get the job number
	SNCALL	(ESLEEP##,MCSEC0)	;[7.yyyy](T1,J)Go to sleep
	JRST	PRWAI1		;Awake for some reason: check connection
> ;End IFN FTOPS10
;[7.1120]
;PRWAKE - Wake up a job.
;
; T1/ Address of pending request block
;	CALL PRWAKE
; Return+1: Always

PRWAKE:
IFN FTOPS20,<
	OPSTR	<SKIPN>,PRWAI,(T1);Waiting for the connection?
	IFSKP.
	  LOAD T2,PRCID,(T1)	;Yes, Get the connect id
	  ANDI T2,PR.NDX	;Strip off the random part
	  IDIVI T2,^D36		;Calculate offset in T2,
	  MOVE T3,BITS(T3)	;  mask in T3
	  ANDCAM T3,PRWMSK(T2)	;Clear the bit
	ELSE.
	  LOAD T2,PRFRK,(T1)	;Get the Fork number
	  LOAD T1,PRPSI,(T1)	;Get the PSI channel
	  CALLX (MSEC1,PSIRQ)	;(T1,T2/)Interrupt him
	ENDIF.
	RET			;All done
>;END IFN FTOPS20
IFN FTOPS10,<
	SAVEAC	<J>		;
	OPSTR	<SKIPN>,PRWAI,(T1);Wait for the connection?
	IFSKP.
	  LOAD T1,PRFRK,(T1)	;Get the JCH
	  SNCALL (CTXEWK##,MCSEC1) ;(T1)Wake that job
	   JFCL			;
	  RET			;
	ENDIF.
	LOAD	J,PRFRK,(T1)	;Get the JCH
	SIGNAL	C$LAT		;Signal a LAT event
	  JFCL			;
	RET			;
> ;End IFN FTOPS10
;[7.1120]
;LATXPR - Transmit Command Messages for pending requests.
;
;	CALL LATXPR
; Return+1: Always

XRENT	(LATXPR,G)		;LATXPR:: XLATXP::
	SAVEAC	<P1,P2,P3,P4,Q1,Q2>
	STKVAR	<MAXCMC,NXTCMT>	;
IFN FTOPS20,<
	MOVEI	T1,^D1000	;1000 Milliseconds
	MOVEM	T1,LATCMT	;Re-initialize the Command Message Timer
> ;End IFN FTOPS20
	SKIPN	P4,LAHNDB	;Get address of host node (HN) data base
	RET			;None, don't transmit
	LOAD	T1,HNLAS,(P4)	;Get the LAT access state
	CAXE	T1,LS.ON	;Is it ON?
	RET			;No, don't transmit
	LOAD	T1,HNCMX,(P4)	;Get the maximum command message 
	MOVEM	T1,MAXCMC	; retry count
	MOVE	P3,TODCLK	;Get the system uptime
	LOAD	T1,HNCMT,(P4)	;Calculate the next time to transmit
	ADD	T1,P3		; a command message
	MOVEM	T1,NXTCMT	;

; Find a PRVECT entry whose timer has expired.
;
	MOVX	P1,PRMAXI	;Get the number of entires
	MOVE	P2,PRVECT	;Get address of PRVECT table (minus one)
XLATP1:	SOJL	P1,RTN		;None left, return
	SKIPE	Q1,1(P2)	;Is there an entry?
	OPSTR	<CAMGE P3,>,PRCMT,(Q1)	;Is it time to transmit?
	AOJA	P2,XLATP1	;No, keep looking
	MOVX	T1,DLL.FL	;Get a bit to test with
	OPSTR	<SKIPE Q2,>,PRXBA,(Q1)	;Get address of transmit buffer
	OPSTR	<TDNE T1,>,UNUID,+UNB.OF(Q2)	;Does DLL still have it?
	AOJA	P2,XLATP1	;Yes, can't touch it at this time
	LOAD	T1,PRSTA,(Q1)	;Get the current (internal) state
	AOJA	P2,@XMTDSP(T1)	;Increment the PRVECT entry address
				; and take care of this entry

				; ..
				; ..

; Table of states for the PRVECT entries
;
XMTDSP:	XADDR. XLATP2		;(0) Halt
	XADDR. XLATP2		;(1) Run
	XADDR. XLATP5		;(2) Solicit Information
	XADDR. XLATP3		;(3) Solicit Access (initialize first)
	XADDR. XLATP5		;(4) Solicit Access
	XADDR. XLATP2		;(5) Queued
	XADDR. XLATP2		;(6) Rejected
	XADDR. XLATP2		;(7) Timed Out
	XADDR. XLATP4		;(8) Cancel (initialize first)
	XADDR. XLATP5		;(9) Cancel
XMTMAX==.-XMTDSP-1
IF1,<IFL <XMTMAX-SS.MAX>,<PRINTX ?Entries missing in XMTDSP>>

; Come here to set the retransmit timer to infinity so that this routine
; will never bother with this PRVECT entry again.
;
XLATP2:	HRLOI	T1,377777	;Make the retransmit timer so large
	STOR	T1,PRCMT,(Q1)	; we will never go through here again
	SETZRO	PRCMC,(Q1)	;
	JRST	XLATP1		;Find another PRVECT entry

; Come here to set up the Solicit Access message.
;
XLATP3:	MOVE	T1,Q1		;Get address of pending request block
	CALL	FMSAC		;(T1)Format a Solicit Access message
	 JRST XLATP1		;Error, try again later
	MOVX	T1,SS.SAC	;Change state to Solicit Access
	STOR	T1,PRSTA,(Q1)	; 
	JRST	@XMTDSP(T1)	;

; Come here to set up the Cancel Message.
;
XLATP4:	MOVE	T1,Q1		;Get address of pending request block
	CALL	FMCAN		;(T1)Format a Cancel message
	 JRST XLTIMO		;Error, remove this slot block
	MOVX	T1,SS.CAN	;Change state to Cancel
	STOR	T1,PRSTA,(Q1)	; 
	JRST	@XMTDSP(T1)	;

				; ..
				; ..

; Come here to transmit a message.
;
XLATP5:	OPSTRM	<AOS T1,>,PRCMC,(Q1)	;Increment the retry count
	CAMLE	T1,MAXCMC	;Have we retried too many times?
	JRST	XLTIMO		;Yes, we have timed out
	MOVE	T1,NXTCMT	;Reset the command message timer
	STOR	T1,PRCMT,(Q1)	;
	LOAD	T1,HNPID,(P4)	;Save the PID
	STOR	T1,UNPID,+UNB.OF(Q2)
	STOR	Q2,UNRID,+UNB.OF(Q2)	;Save buffer address
	MOVX	T1,SAV.FL	;Keep this buffer
	STOR	T1,UNUID,+UNB.OF(Q2) 
	MOVX	T1,UNA.EV	;Use EXEC virtual memory
	STOR	T1,UNADS,+UNB.OF(Q2)
	MOVX	T1,NU.XMT	;Function = transmit
	XMOVEI	T2,UNB.OF(Q2)	;Address of UN block
IFN FTOPS20,<CALL DLLUNI##	;Call NI service>
IFN FTOPS10,<SNCALL (DLLUNI##,MCSEC1) ;Call NI service>
	 TRN			;Ignore error
	JRST	XLATP1		;Look for another PRVECT entry

; Come when we have timed out.
;
XLTIMO:	LOAD	T1,PRSTA,(Q1)	;Get the current (internal) state
	CAXE	T1,SS.CAI	;
	CAXN	T1,SS.CAN	;Was this request cancelled?
	TRNA			;Yes, delete the PRVECT entry
	IFSKP.
	  MOVE T1,Q1		;Get the address of the slot block
	  CALL PRDEL		;Delete the PRVECT entry
	  JRST XLATP1		;Find another PRVECT entry
	ENDIF.
	MOVX	T1,SS.TMO	;Change state to Timed Out
	STOR	T1,PRSTA,(Q1)	;
	MOVX	T1,.LATMO	;
	STOR	T1,PRSTS,(Q1)	;
	MOVE	T1,Q1		;Get address of pending request block
	CALL	PRWAKE		;(T1)Wake the user's job
	JRST	@XMTDSP+SS.TMO	;Make the retransmit timer so large
				; we will never go through here again
	SUBTTL	LATOP% JSYS -- Terminate Host-Initiated Connects


	XSWAPCD			;[7.1120]

;[7.1120]
;LATHC - Terminate host-initiated connects.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LATHC
; Return+1: Failure, T1/ error code
; Return+2: Success

LATHC:	UMOVE	T2,.LAPRM(Q1)	;Get the connect id and flags
IFN FTOPS20,<
	MOVE	T1,FORKX	;Get the current fork number
>				; End IFN FTOPS20
IFN FTOPS10,<
	MOVE	T1,.CPJCH##	;Get the current job number/context
>; End IFN FTOPS10
	TXNN	T2,LA%JOB	;Terminate all server connects for the job?
	IFSKP.
	  CALL JBTHC		;(T1)Terminate all pending connects
	   RETBAD ()		;Uh oh... Open files!
	  RETSKP		; for the current fork
	ENDIF.
	HRRZ	T3,T2		;Get the connect id
	ANDI	T2,PR.NDX	;Throw away the random portion
	SKIPLE	T2		;Less than or equal to zero
	CAILE	T2,PRMAXI	; or greater than the maximum?
	RETBAD	(LATX11)	;Yes, invalid or unknown connect id
	ADD	T2,PRVECT	;Calculate address of PRVECT entry
	SKIPN	T2,(T2)		;Is this entry in use?
	RETBAD	(LATX11)	;No, invalid or unknown connect id
	OPSTR	<CAME T3,>,PRCID,(T2)	;Is this the RIGHT connect id?
	RETBAD	(LATX11)	;No, invalid or unknown connect id
	OPSTR	<CAME T1,>,PRFRK,(T2)	;Does this job own the connection?
	RETBAD	(LATX11)	;No, invalid or unknown connect id
IFN FTOPS20,<
	LOAD	T1,PRSTS,(T2)	;Get the status
	TRZN	T1,.TTDES	;Is this a TTY designator?
	IFSKP.			;Yes, so...
	  ADDI T1,DVXTT0	;Point into the device tables
	  MOVX T3,DV%OPN	;Get the open flag?
	  TDNE T3,DEVCHR(T1)	;Is there an open file on this device?
	  RETBAD (DEVX6)	;Yes!
	ENDIF.
>				;End IFN FTOPS20
	MOVE	T1,T2		;Get address of pending request block
	CALL	PRCAN		;(T1)Cancel this pending request
	RETSKP			;
;[7.1120]
;LATRST - This routine is called each time TOPS-10 does a RESET UUO.
; The TOPS-20 version is called from KSELF.
; Give up all of the server connections for the specified job.
;
; T1/ Fork number (TOPS-20)
; J/ Job number (JCH) (TOPS-10)
;	CALL LATRST
; Return+1: Always

IFN FTOPS20,<
XRENT (LATRST,G)		;LATRST::,XLATRS:
	SAVEAC	<Q1>		;
	SKIPN	Q1,LAHNDB	;Do we have lat?
	RET			;no
	NOINT			;No more interruptions
	LOCK	HN.LOK(Q1)	;Lock the database
	CALL	JBTHC		;Release reverse lat resources
	 NOP			;Don't care
	UNLOCK	HN.LOK(Q1)	;Let others have the database
	OKINT			;I'm not busy any more
	RET 			;All done
>				;End IFN FTOPS20
IFN FTOPS10,<
	RESCD
LATPSI::SETZ T2,		;Dummy PSI callback routine
	RET
LATRST::MOVE T1,.CPJCH		;Get the JCH
	SE1ENT			;Return in section 1
IFN FTXMON,<
	XJRST	[JBTHC]		;Do the rest in section 2
	XRESCD
> ;End IFN FTXMON
> ;End IFN FTOPS10

;[7.1120]
;JBTHC - Terminate all of the host-initiated connects for a specified job.
;Note: To be called NOINT with the database locked.
; T1/ Fork number
;	CALL JBTHC
; Return+1: At least one device has an open file, and hasn't been terminated
; Return+2: All connections terminated

JBTHC:	SAVEAC	<P1,P2,P3>	;
	STKVAR	<OPFLG>		;"Device is open" Flag
	MOVX	P1,PRMAXI	;Get the length of the PRVECT table
	MOVE	P2,PRVECT	;Get the address of the PRVECT table
	MOVE	P3,T1		;Copy the fork number
	SETZM	OPFLG		;Clear Error flag
JBTHC1:	SOJL	P1,JBTHC3	;Negative: no more PRVECT entries
	SKIPN	T1,1(P2)	;Is this table entry in use?
	AOJA	P2,JBTHC1	;No, keep looking
	LOAD	T2,PRFRK,(T1)	;Get the fork number for this connection
	CAME	T2,P3		;Do the fork numbers match?
	AOJA	P2,JBTHC1	;Keep looking
IFN FTOPS20,<
	LOAD	T2,PRSTS,(T1)	;Get the status
	TRZN	T2,.TTDES	;Is this a TTY designator?
	IFSKP.			;Yes, so...
	  ADDI T2,DVXTT0	;Point into the device tables
	  MOVX T3,DV%OPN	;Get the open flag?
	  TDNN T3,DEVCHR(T2)	;Is there an open file on this device?
	  JRST JBTHC2		;No, go cancel it
	  SETOM OPFLG		;Yes, set the flag
	  AOJA P2,JBTHC1	;and keep looking...
	ENDIF.			;
>				;End IFN FTOPS20
JBTHC2:	CALL	PRCAN		;Cancel this connection
	AOJA	P2,JBTHC1	;Keep going	
JBTHC3:
IFN FTOPS20,<
	SKIPE	OPFLG		;Any errors?
	RETBAD	(DEVX6)		;Yes
> ;End IFN FTOPS20
	RETSKP			;No, all is well...
	ENDSV.			;

;PRCAN - Cancel a pending request.
;[7.1120]
; T1/ Address of pending request block
;	CALL PRCAN
; Return+1: Always

PRCAN:	LOAD	T3,PRSTA,(T1)	;Get the current (internal) state
	CALLRET	@CANDSP(T3)	;Change state to Cancel or hang up

PRCAN1:	MOVX	T2,SS.CAI	;
	STOR	T2,PRSTA,(T1)	;Change to Cancel state
	MOVX	T2,.LACAN	; (initialize first)
	STOR	T2,PRSTS,(T1)	;
	SETZRO	PRCMC,(T1)	;Clear the retransmit timer so that
	SETZRO	PRCMT,(T1)	; LATXPR will start right away
	RET			;Return

PRCAN2:	LOAD	T2,PRSBA,(T1)	;Get address of slot block
	JUMPE	T2,@CANDSP+SS.SAC	;None: treat it as still soliciting
IFN FTOPS20,<
	LOAD	T2,PRSTS,(T1)	;Get the TTY designator
	TXZN	T2,.TTDES	;Do we have one?
	JRST	@CANDSP+SS.SAC	;No
	SAVEAC	<Q1,Q2,P1,P2,P3,P4,P5>
	CALLRET	LTHNGU		;(T2)Yes, hang up the line.
>				;End IFN FTOPS20
IFN FTOPS10,<
	SAVEAC	<W,M,P1,P2,P3,P4,J>
	LOAD	U,SBTDB,(T2)	;Get the LDB address
	JUMPE	U,@CANDSP+SS.SAC	;[7.xxxx]None: treat it as still soliciting
	CALL	LTHNGU		;[7.xxxx](U)Got it: hang up the line
	 NOP			;[7.xxxx]Oh well, we tried
	RET			;[7.xxxx]
> ;End IFN FTOPS10
	CALLRET	@CANDSP+SS.SAC	;None: treat it as still soliciting

; Table of states for the PRVECT entries
;
CANDSP:	XADDR. PRCAN2		;(0) Halt
	XADDR. PRCAN2		;(1) Run
	XADDR. PRCAN1		;(2) Solicit Information
	XADDR. PRCAN1		;(3) Solicit Access (initialize first)
	XADDR. PRCAN1		;(4) Solicit Access
	XADDR. PRCAN1		;(5) Queued
	XADDR. PRDEL		;(6) Rejected
	XADDR. PRDEL		;(7) Timed out
	XADDR. PRCAN1		;(8) Cancel (initialize first)
	XADDR. PRCAN1		;(9) Cancel
CANMAX==.-CANDSP-1
IF1,<IFL <CANMAX-SS.MAX>,<PRINTX ?Entries missing in CANDSP>>
	SUBTTL	LATOP% JSYS -- Show Host-Initiated Connects


	XSWAPCD			;[7.1120]

;[7.1120]
;LASHC - Show host-initiated connects.
;
; Q1/ User argument block address
; Q2/ LAT host node data base address
; P1/ Length of user argument block
; P2/ LAT function code
;	CALL LASHC
; Return+1: Failure, T1/ error code
; Return+2: Success

LASHC:	XCTU	[HRRZ P3,.LABCT(Q1)]	;Get the length of the show buffer
	UMOVE	T3,.LABFA(Q1)	;Get address of show buffer
	UMOVE	T1,.LAQUA(Q1)	;Get the flags,,connect id
	IDIVI	P3,MW.SHC	;Calculate the maximum number 
				; of connections that will fit there
	SETO	P4,		;Use job number minus one (for the search)
	TXNE	T1,LA%SYS	;Show all server connects on the system?
	JRST	LASHC1		;Yes, start the search
	TXNN	T1,LA%JOB	;Show all server connects for this job?
	IFSKP.
IFN FTOPS20,<
	MOVE	P4,JOBNO	;Get the current job number
>				;End IFN FTOPS20
IFN FTOPS10,<
	MOVE	P4,.CPJOB##	;Get the current job number
> 				;End IFN FTOPS10
	  JRST LASHC1		;Find the connections for this job
	ENDIF.

; Come here to return the status of a paritcular server connection.
;
	LDB	T4,[POINTR (T1,LA%CID)]	;Get the connect id
	ANDI	T4,PR.NDX	;Throw away the random portion
	SKIPLE	T4		;Less than or equal to zero
	CAILE	T4,PRMAXI	; or greater than the maximum?
	RETBAD	(LATX11)	;Yes, invalid or unknown connect id
	ADD	T4,PRVECT	;Calculate address of PRVECT entry
	SKIPN	T4,(T4)		;Is this entry in use?
	RETBAD	(LATX11)	;No, invalid or unknown connect id
	MOVX	T1,MW.SHC	;Save the number of words needed
	XCTU	[HRLM T1,.LABCT(Q1)]
	SOSGE	P3		;Is the show buffer large enough?
	RETBAD	(ARGX04)	;No, argument block too small
	CALL	MVSHC		;(T2,T4/T2)Move the Status block
	RETSKP			;

				; ..
				; ..

; Find the all server connections (P4=minus one) or all those for a user
; job (P4=n).
;
LASHC1:	MOVX	P1,PRMAXI	;Get the length of the PRVECT table
	MOVE	P2,PRVECT	;Get the address of the PRVECT table
LASHC2:	SOJL	P1,LASHC4	;Negative: no more PRVECT entries
	ADDI	P2,1		;Increment the address of the entry
	SKIPN	T4,(P2)		;Is this table entry in use?
	JRST	LASHC2		;No, keep looking
	JUMPL	P4,LASHC3	;Minus one: take all server connections
	LOAD	T1,PRJOB,(T4)	;Get the job number for this connection
	CAME	T1,P4		;Do the job numbers match?
	JRST	LASHC2		;No, keep looking
LASHC3:	SOJL	P3,LASHC2	;Negative: avoid overflowing the buffer
	CALL	MVSHC		;(T2,T4/T2)Move the Status block
	JRST	LASHC2		;Find all of the server connections

; Return the number of words needed in the show buffer.
;
LASHC4:	XCTU	[SUB T3,.LABFA(Q1)]	;Calculate the number of words written
	JUMPL	P3,LASHC5	;Negative: show buffer is too small
	XCTU	[HRLM T3,.LABCT(Q1)]	;Save the number of words written
	RETSKP			;
LASHC5:	MOVMS	P3		;Calculate the additional number
	IMULI	P3,MW.SHC	; of words needed
	ADD	T3,P3		;Calculate the total amount needed
	XCTU	[HRLM T3,.LABCT(Q1)]	;Save the number of words needed
	RETBAD	(LATX04)	;Argument block too small
;[7.1120]
;MVSHC - Move the status information for LASHC.
;
; T3/ Destination in user address space
; T4/ Address of pending request block
;	CALL MVSHC
; Return+1: Always, T3/ Address of next word to write

MVSHC:	LOAD	T2,PRJOB,(T4)	;Get the job number
	LOAD	T1,PRCID,(T4)	;Get the connect id
	HRL	T1,T2		;Get job number,,connect id
	UMOVEM	T1,(T3)		;Put it in the show buffer
	LOAD	T2,PRSTS,(T4)	;Get the status of the connection
	LOAD	T1,PRQDP,(T4)	;Get the queue depth
	HRL	T1,T2		;Get status,,queue depth
	UMOVEM	T1,1(T3)	;Put it in the show buffer
	LOAD	T2,PRSRC,(T4)	;Get the server name count
	LOAD	T1,PRPRC,(T4)	;Get the port name count
	HRL	T1,T2		;Get server name count,,port name count
	UMOVEM	T1,2(T3)	;Put it in the show buffer
	ADDI	T3,3		;Update the destination address
	MOVEI	T1,<ML.SRN+4>/5	;Get the maximum length of the name
	XMOVEI	T2,PR.SRN(T4)	;Get the address of server name
	XBLTXU	T1		;Copy the name into user space
	MOVEI	T1,<ML.PRN+4>/5	;Get the maximum length of the name
	XMOVEI	T2,PR.PRN(T4)	;Get the address of the port name
	XBLTXU	T1		;Copy the name into user space
	LOAD	T1,PRSVC,(T4)	;Get the service name count
	HRLZ	T1,T1		;Get the service name count,,0
	UMOVEM	T1,(T3)		;Put it in the show buffer
	ADDI	T3,1		;Update the destination address
	MOVEI	T1,<ML.SVN+4>/5	;Get the maximum length of the name
	XMOVEI	T2,PR.SVN(T4)	;Get the address of the service name
	XBLTXU	T1		;Copy the name into user space
	RET			;
	SUBTTL	LATOP% JSYS -- Utility Routines -- FNDSRV

;FNDSRV - find the service block requested by the user based on the
; service name provided.

;Call:	no arguments
;Return:
;	RET - error
;	RETSKP - success, T1/ address of service block

FNDSRV:	SAVEAC	<P1,P2>
	MOVEI	T1,TMPLNG-1	;Zero the storage for assembling user's
	XMOVEI	T2,TMPBLK	; service name.
	XMOVEI	T3,TMPBLK+1	; ...
	SETZM	TMPBLK		; ...
	XBLT. T1		; ...

;Get the Service Name string from the user and put it into the service
;block build area.
;
	UMOVE	T1,.LABFA(Q1)	;Pointer to user's service name string
IFN FTOPS10,<
	SNCALL	(CKSTR##,MCSEC1)	;Check to see if ASCIZ string is addressable
	 RETBAD (LATXAC)	;Nope, lose
>;end ifn FTOPS10
IFN FTOPS20,<
	CALL	MAKPTR		;(T1/T1)Make a valid ASCIZ pointer
>
	XMOVEI	T2,TMPGB+GB.NAM	;Pointer of where to put it
	TXO	T2,<OWGP. 7,0>	; ...
	MOVEI	T3,<ML.SVN+4/5>	;[7.1120]Maximum length
	CALL	UMVAZS		;(T1-T3/T3)Move the string to exec space
	 RETBAD (LATX07)	;Service name too long
	STOR	T3,GBNC,+TMPGB	;Store the count of service name from user

;Loop through all service blocks looking for a name match.
;
	XMOVEI	P2,HN.SRV(Q2)	;Address of start of service blocks
	OPSTR	<SKIPN P1,>,HNNSV,(Q2);Number of currently defined services
	JRST	FSFALS		;There are none defined.
	DO.
	  XMOVEI T1,GB.NAM(P2)	;Address of service block's service name
	  TXO T1,<OWGP. 7,0>
	  LOAD T2,GBNC,(P2)	;Count of service block's service name
	  XMOVEI T3,TMPGB+GB.NAM;Address of user's service name
	  TXO T3,<OWGP. 7,0>
	  LOAD T4,GBNC,+TMPGB	;Count of user's service name
	  CALL SCMPAR		;Compare the strings
	  IFSKP.		;MATCH FOUND
	    MOVEI T1,.LASET	;If a SET...
	    XCTU [CAME T1,.LAFCN(Q1)]
	    IFSKP.
	      MOVEI T1,GB.LEN	; then copy entire service block to the
	      XMOVEI T2,(P2)	; temporary block so that new values
	      XMOVEI T3,TMPGB	; overlay the old.
 	      XBLT. T1
	    ENDIF.
	    MOVE T1,P2		;In both cases (SET/CLEAR) return service
	    RETSKP		; block address.
	  ENDIF.
	  ADDI P2,GB.LEN	;No match here so
	  SOJG P1,TOP.		; advance to next service block
	ENDDO.

;Service block not found.  If function is SET, see if there is room for
;a new service.  If function is CLEAR, nothing further required.
;
FSFALS:	MOVEI	T1,.LASET	;If service name not found and the function
	XCTU	[CAME T1,.LAFCN(Q1)]; request is not a SET,
	RETBAD	(LATX07)	; then return an error. Otherwise,
	XMOVEI	T1,<GB.LEN*MXHSRV+HN.SRV>(Q2); get end of service block address
	CAML	P2,T1		; and compare with first free block address
	RETBAD	(LATX08)	;There is no room for new service.
	SETOM	TMPBLK		;There is room.  Flag to increment # services.
	MOVE	T1,P2		;Return service block address for new entry.
	RETSKP

	SUBTTL	LATOP% JSYS -- Utility Routines -- GTSRVR

;GTSRVR - Routine to get the circuit block address for a particular
; server based on server name.
;
;CALL:	T1/ Pointer to server name supplied by user
;	Q2/ LAT host node data base address
;RET - 	Error, no circuit block with the requested server name
;RETSKP	Success,
;	T1/ Circuit block address for requested server

GTSRVR:	SAVEAC	Q1		;Get an AC for circuit block address.
	MOVX	T2,<POINT 7,TMPBLK>;Pointer to where to move name string.
	MOVEI	T3,ML.DSC	;Maximum server name string length.
	CALL	UMVAZS		;(T1-T3/T3)Move the ASCIZ string.
	 RETBAD (LATX04)
	MOVX	T1,<POINT 7,TMPBLK>;Pointer to user's name string in local storage
	MOVE	T2,T3		;Length of the user's name string.
	LOAD	Q1,HNQAC,(Q2)	;Get first CB on active queue
	CALL	GCBNAM		;See if desired server there
	IFSKP.
	  MOVE T1,Q1		;Return the CB address on successful
	  RETSKP		; match.
	ENDIF.
	LOAD	Q1,HNQIC,(Q2)	;Get first CB on inactive queue
	CALL	GCBNAM
	IFSKP.
	  MOVE T1,Q1		;Return the CB address on successful
	  RETSKP		; match.
	ENDIF.
	RETBAD	(LATX04)	;Not anywhere, return error.

;GCBNUM - searches a particular queue of circuit blocks looking for a match
; on the server name.

GCBNAM:	SAVEAC	<T1,T2>		;Preserve string pointer and count.
	JUMPE	Q1,RTN		;No more circuit blocks on this queue
	DO.
	  XMOVEI T3,CB.SNM(Q1)	;Address of server name
	  TXO T3,<OWGP. 7,0>	;Make a pointer
	  LOAD T4,CBRSC,(Q1)	;Count in name
	  CALL SCMPAR		;(T1-T4)Do the compare
	   SKIPA		;No match
	  RETSKP		;Match
	  OPSTR <SKIPN Q1,>,QLFWD,+CB.LNK(Q1)
	  RET			;No match for any CBs on queue.
	  JRST TOP.		;Try next CB.
	ENDDO.
	SUBTTL	LATOP% JSYS -- Utility Routines -- SCMPAR String Compare

;SCMPAR - String Compare

;Call:	T1/ First string byte pointer
;	T2/ First string count
;	T3/ Second string byte pointer
;	T4/ Second string count
;RET 	Mismatch
;RETSKP Match

SCMPAR:	SAVEAC	<T1,T2,T3,T4>	;Preserve the byte pointers.
	STKVAR	<PTR1,PTR2>
	CAME	T2,T4		;If lengths don't match then obviously
	RET			; the strings don't either.
	MOVEM	T1,PTR1		;Save the byte pointers
	MOVEM	T3,PTR2		; to the strings.
	DO.
	  ILDB T1,PTR1		;Get next character from
	  ILDB T2,PTR2		; each string.
	  CALL UPPERC		;(T1/T1)Uppercase one.
	  EXCH T1,T2
	  CALL UPPERC		;(T1/T1)Uppercase the other.
	  CAME T1,T2		;Compare the result.
	  RET			;Different so return failure.
	  SOJG T4,TOP.		;Match, so continue with the next.
	ENDDO.
	RETSKP			;Full match, return success.

	ENDSV.

;UPPERC - Uppercase a character

;Call:	T1/ Character
;RET	Always with T1/ uppercased character

UPPERC:	CAIL	T1,"a"
	CAILE	T1,"z"
	SKIPA
	SUBI	T1,40
	RET
;UBFCHK - Routine to check if user supplied buffer large enough
;This routine added by 7.1039.  It supercedes LABFCK.
; Call:
;	T1/ Minimum size required of user buffer
;	Q1/ User's argument block address
; Return:
;	RET			;Too small (LATX01 in T1)
;	RETSKP			;Large enough

UBFCHK:	XCTU	[HRLM T1,.LABCT(Q1)]	;Tell user
	XCTU	[HRRZ T2,.LABCT(Q1)]	;Get his buffer count.
	CAMGE	T2,T1		;Has user allocated large enough buffer?
	RETBAD	(LATX01)	;No
	RETSKP			;Yes


;MAKPTR- Make a valid ASCIZ pointer if not already
;
IFN FTOPS20,<
MAKPTR:	MOVE	T2,T1		;Make a proper pointer in case the user
	TLC	T2,-1		; supplied one of the form
	TLCN	T2,-1		; -1,,address
	HRLI	T1,440700	; ...
	RET
> ;End IFN FTOPS20

;[7.1039] Routine LABFCK was here...


;	Last thing in LATOP. UUO code
;
IFN FTOPS10,<
	PURGE	Q1,Q2		;undefine TOPS-20 ACs
> ;End IFN FTOPS10
	SUBTTL	TOPS-10 -- SCNSER Interface -- LDBISR Dispatch


	RESCD

IFN FTOPS10,<

LATDSP::RET			;( 0)ILLEGAL NOW.  DON'T USE!!
	RET			;( 1)MODEM CONTROL
	XJRST	[LATSEC]	;( 2)ONCE A SECOND CALL (NOT PER TTY)
	RET			;( 3)INITIALIZE
	JRST	SETCHP##	;( 4)CHANGE HARDWARE PARMS (let SCNSER do it)
	RET			;( 5)LINE PARM CONTROL
	RET			;( 6)SET TERMINAL ELEMENT
	XJRST	[LATREM]	;( 7)STUFF FOR REMOTE TERMINALS
	RETSKP			;(10)IS LINE DEFINED ON STATION (YES)

> ;End IFN FTOPS10
	SUBTTL	TOPS-10 -- NETOP. Functions


;NETDIL - tell user the node and port where his TTY is connected
;
;Call: (in section 1 already)
;
;	U/ LDB of LAT terminal
;	M/ Address of user's NETOP. arg list
;Return:
;	ECDX?	depending on error
;	RETSKP	node name stored in string block pointed to by user's arg list
;
;Uses P1,P2 (already saved by higher routine), T1-T4, M

	SWAPCD

IFN FTOPS10,<

NETDIL::MOVE	P1,M		;SAVE ADDRESS OF ARG LIST
	EXCTUX	<SKIPN M,5(P1)>	;POINT TO NODE NAME STRING BLOCK
	 JRST	NTDIL1		;NO STRING BLOCK FOR NAME
	CALL	CHKSTB##	;CHECK STRING BLOCK FOR ADDRESSABILITY
	 JRST	NOPADC##	;ADDRESS CHECK
	MOVE	T3,LDBLAT##(U)	;GET ADDRESS OF SB BLOCK
	MOVE	T3,SB.CBA(T3)	;GET ADDRESS OF CORRESPONDING CB BLOCK
	LOAD	T1,CBRSC,(T3)	;GET BYTE COUNT FOR NAME
	XMOVEI	T3,CB.SNM(T3)	;GET ADDRESS OF NODE NAME
	CALL	MOV7T8		;MOVE THE STRING
	 JRST	NOPADC##	;NOT ENOUGH ROOM
NTDIL1:	EXCTUX	<SKIPN M,6(P1)>	;POINT TO PORT NAME STRING BLOCK
	 RETSKP			;BELIEVE IT OR NOT, WE'RE DONE
	CALL	CHKSTB##	;CHECK THE STRING BLOCK
	 JRST	NOPADC##	;NOT THERE
	MOVE	T3,LDBLAT##(U)	;GET ADDRESS OF SB BLOCK AGAIN
	LOAD	T1,SBPRC,(T3)	;GET BYTE COUNT OF PORT NAME
	JUMPE	T1,RSKP		;Nothing to store
	XMOVEI	T3,SB.PRN(T3)	;GET ADDRESS OF PORT NAME
	CALL	MOV7T8		;(M,T1,T2,T3)
	 JRST	NOPADC##	;NOT ENOUGH ROOM
	RETSKP
> ;End IFN FTOPS10
;MOV7T8 - Move a 7-bit monitor string to an 8-bit user string.
;
; M/ Address of string block
; T1/ Count of source string
; T3/ Address of source string
; T4/ Count of destination string
;	CALL MOV7T8
; Return+1: Failure, address check
; Return+2: Success

IFN FTOPS10,<
MOV7T8:
IFN FTXMON,<
	CALL	SSPCS##		;PRESERVE PCS FOR CALLER
>
	PUSH	P,T1		;SAVE COUNT FOR A BIT
	MOVE	T1,M		;COPY POINTER TO STRING BLOCK
	CALL	SXPCS##		;SETUP PCS
	 JRST TPOPJ##		;I THOUGHT WE KNEW IT WOULD FIT?
	POP	P,T1		;RESTORE BYTE COUNT
	EXCTXU	<HRLM T1,(M)>	;STUFF BYTE COUNT INTO STRING BLOCK
	CAILE	T1,(T4)		;ENOUGH SPACE TO STORE?
	 RET			;NO
	MOVSI	T2,(<POINT 7,>!1B12)	;MAKE GLOBAL BYTE POINTER
	PUSH	P,T4+1		;SAVE A COUPLE OF ACS
	PUSH	P,T4+2		; T1 HAD BETTER BE LESS THAN 12
	MOVSI	T4+1,(<POINT 8,>!1B12)
	EXCTUX	<XMOVEI T4+2,1(M)>	;GLOBAL ADDRESS OF DEST.
	PXCT	11,[EXTEND	T1,[MOVSLJ
			0]]	;MOVE THE BYTES (I HOPE)
	 JFCL
	POP	P,T4+2
	POP	P,T4+1
	RETSKP
> ;End IFN FTOPS10
	SUBTTL	LATINI - LAT Initialization

	XRESCD			;[7.1024]

;LATINI - LAT Initialization
;
;Call:	CALL LATINI
;	  Error return - resource failure
;	Normal Return

	ENTRY	LATINI		;Kepp LINK happy in library search mode

XRENT	(LATINI,G)		;[7.1024]LATINI::, XLATIN::

	ACVAR	<HN,XB,W1,W2>	;Reserve AC for Host Node data base address

IFN FTOPS10,<
	PUSHJ	P,LAGTCR	;[7.xxxx]Get size of LAT freecore needed
IFE FTXMON,<
	PUSHJ	P,INICOR##	;[7.xxxx]Allocate core
	MOVEM	T2,LATLOC	;[7.xxxx]Save starting address
> ;End IFE FTXMON
IFN FTXMON,<
	MOVE	T2,T1		;[7.xxxx]Copy here for GFWNZN
	MOVEI	T1,(MS.DCN)	;[7.xxxx]Section number
	PUSHJ	P,GFWNZN##	;[7.xxxx]Ask ONCMOD for non-zero section core
	  HALT	.		;[7.xxxx]*** FOR NOW
	MOVEM	T1,LATLOC	;[7.xxxx]Save as lowest address in freecore
> ;End IFN FTXMON
>; End IFN FTOPS10

	MOVEI	T1,HC.LST	;Get memory for the Host Node (HN) tables
	CALL	MMGTZW		;(T1/T1)Get zeroed memory
	 JRST INIRES		;Resource failure. Should not happen.
	MOVE	HN,T1		;Base address for host node database references
	MOVEM	HN,LAHNDB	;Store the data base address
	SETONE	HNRUN,(HN)	;[7.1039]Start with the NI not running
	MOVEI	T1,CBMAXI	;Get storage for CBVECT
	CALL	MMGTZW		;(T1/T1)
	 JRST INIRES		;Resource failure.
; Circuit block index numbers start with one (not zero).
; When used as an index into the CBVECT array, the first
; word of the array is never used, and the address of the
; last CB is written in some other block.
	SOS	T1		;Save the address minus one:
	MOVEM	T1,CBVECT	; circuit block indices start with one.
	MOVEI	T1,NTTLAH	;Get storage for SBVECT
	CALL	MMGTZW		;(T1/T1)
	 JRST INIRES		;Resource failure.
; Slot block index numbers start with one (not zero).
; When used as an index into the SBVECT array, the first
; word of the array is never used, and the address of the
; last SB is written in some other block.
	SOS	T1		;Save the address minus one: 
	MOVEM	T1,SBVECT	;slot block indices start with one.
	MOVEI	T1,PRMAXI	;[7.1120]
	CALL	MMGTZW		;[7.1120]Get storage for PRVECT
	 JRST INIRES		;[7.1120]Resource failure
	SOS	T1		;[7.1120]Save the address minus one:
	MOVEM	T1,PRVECT	;[7.1120] PR slot indices start with one
	MOVEI	T1,PRMAXI	;[7.1120]
	CALL	MMGTZW		;[7.1120]Get storage for PRRAND table
	 JRST INIRES		;[7.1120]Resource failure
	SOS	T1		;[7.1120]Save address minus one:
	MOVEM	T1,PRRAND	;[7.1120] PRRAND indices start with one

IFN FTOPS10,<
;
;	Now carve up the core we got at ONCE time
;	The free core pool will be turned into a
;	linked list of fixed length buffers from which we can allocate
;	transmit and receive buffers.

	SETZRO	QLFWD,+LATFRE	;Clear out the queue
	SETZRO	QLBWD,+LATFRE
	CALL	LAGTCR		;()Find out how much memory we got at ONCE time
	IDIVI	T1,BUFSIZ	;See how many buffers will fit
	MOVE	T4,T1		;Put it where we need it later.
	MOVEM	T4,LATNFB	;Remember how many we have at start
	MOVE	T2,LATLOC	;Start of first one
	CALL	ALCBUF		;Link them together
	MOVE	T1,LATNAM##	;Get our node name
	CALL	CVTNOD		;Convert to ASCII
>;END IFN FTOPS10
	DMOVE	T1,OURNAM	;Get the local host name
	DMOVEM	T1,HN.NAM(HN)	;Store in HN block
	MOVE	T1,OURCNT	;Host name length in characters
	STOR	T1,HNNMC,(HN)	;Store in HN block
IFN FTOPS20,<
	MOVX	T1,<POINT 7,SVN##>	;Pointer to MONNAM.TXT
>
IFN FTOPS10,<
	MOVX	T1,<POINT 7,CONFIG##>	;Pointer to Monitor name
>
	XMOVEI	T2,HN.ID(HN)	;Where to put it.
	TXO	T2,<OWGP. 7,0>	; ...
	MOVEI	T3,ML.DSC	;Maximum length allowed
	CALL	MMVAZS		;(T1-3/T3)Move the string
	 TRN			;Don't care, take truncated string
	STOR	T3,HNIDC,(HN)	;Store real count
	MOVE	T1,RTRADR	;Get the default host number
	STOR	T1,HNNUM,(HN)
	MOVEI	T1,^D60		;[7.1039]Default Host message retransmit limit
	STOR	T1,HNRLI,(HN)
	MOVEI	T1,^D1000	;Default host virtual circuit timer (msec)
	STOR	T1,HNTIM,(HN)
	MOVEI	T2,^D30		;Default host multicast timer (sec)
	STOR	T2,HNMTI,(HN)
	MOVEI	T1,^D10000	;[7.1120]Default command message retry time (ms)
	STOR	T1,HNCMT,(HN)	;[7.1120]
	MOVEI	T1,^D5		;[7.1120]Default command message retry limit
	STOR	T1,HNCMX,(HN)	;[7.1120]
	MOVE	T1,LASDEF	;[7.1039]Get the default LAT Access State
	STOR	T1,HNLAS,(HN)	;[7.1039] and store it
	CAIN	T1,LS.OFF	;[7.1039]If def. state = on, start transmitting
	IFSKP.			;[7.1039] multicast messages immediately
IFN FTOPS20,<
	  IMULI T2,^D1000	;[7.1039]Multicast in milliseconds
>;END IFN FTOPS20
	  MOVEM	T2,LATMCT	;[7.1039]Initialize scheduler long timer word
	ENDIF.
	MOVEI	T1,MAXACB	;[7.1164]Default max allocatable circuit blocks
	STOR	T1,HNMXC,(HN)	
	MOVEI	T1,MAXACC	;[7.1164]
	STOR	T1,HNMAC,(HN)	;[7.1039]And maximum active circuits
	MOVEI	T1,CBMAXI	;Get a random number in the range or 1 to
	CALL	RANDOM		; (T1/T1)maximum value of circuit block index
	STOR	T1,HNNXI,(HN)	;Store as next CB index to assign
	MOVEI	T1,NTTLAH	;Default max number of simultaneous connects
	STOR	T1,HNMCO,(HN)
	MOVEI	T1,^D32		;Number of access code bytes
	STOR	T1,ACLNG,(HN)
IFN FTOPS20,<
	MOVSI	T1,(1B7)	;Set group 0 on
	MOVEM	T1,AC.COD(HN)	;Store as first byte of access codes
> ;END IFN FTOPS20
IFN FTOPS10,<
IFN FTXMON,<
	XMOVEI	T3,AC.COD(HN)	;Point to destination of XBLT
	XMOVEI	T2,LATIGE##	;From MONGENed groups enabled
	MOVEI	T1,^D8		;Enough room for 32 bytes
	EXTEND	T1,[XBLT]	;Move the bytes
> ;END IFN FTXMON
IFE FTXMON,<
	MOVEI	T1,AC.COD(HN)	;Point to destination of BLT
	HRLI	T1,LAT.GE##	;From MONGENed groups enabled
	BLT	T1,AC.COD+7(HN)	;Move the bytes
> ;END IFE FTXMON
> ;END IFN FTOPS10
	MOVEI	T1,1
	STOR	T1,HNNSV,(HN)	;Default number of host services offered
	XMOVEI	W1,HN.SRV(HN)	;Address of the host service blocks
	STOR	T1,GBRAT,(W1)
	MOVE	T1,OURCNT	;Default service name is node name so
	STOR	T1,GBNC,(W1)	; store the count
	DMOVE	T1,OURNAM	; and the name
	DMOVEM	T1,GB.NAM(W1)
	LOAD	T1,HNIDC,(HN)	;[7.1039]Get Host node id count
	CAILE	T1,ML.SID	;[7.1039]Don't exceed the maximum allowed
	MOVEI	T1,ML.SID	;[7.1039]
	STOR	T1,GBLC,(W1)	;[7.1039]Save it
	ADDI	T1,4		;[7.1039]Convert from bytes to words
	IDIVI	T1,5		;[7.1039]
	XMOVEI	T2,HN.ID(HN)	;[7.1039]Get address of host descriptor
	XMOVEI	T3,GB.HID(W1)	;[7.1039]And address of service descriptor
	XBLT. T1		;[7.1039]Make service descriptor same as host
	XMOVEI	XB,HN.MCM(HN)	;Address of the multicast message block
	MOVE	T1,[BYTE (8)11,0,53,0,(4)0];Store multicast address
	MOVE	T2,[BYTE (8)0,17,0,0]; ...
	OPSTRM	<DMOVEM T1,>,UNDAD,+UNB.OF(XB);09-00-2B-00-00-0F
	SETO	T1,0		;Use random number for incarnation count
	CALL	BMCFXD		;(T1,HN,XB)Build fixed part of message
	CALL	BMCACS		;(HN,XB)Enter the host access code string
	CALL	BMCNID		;(HN,XB)Enter the host node name and descriptn
	CALL	BMCSRV		;(HN,XB)Build the services
	SETONE	HNLOK,(HN)	;Initialize database lock
	STOR	XB,UNRID,+UNB.OF(XB);Store for xmit complete processing
	CALL	BLDSTM		;(HN)Now build the START message template
	MOVX	T1,NTTLAH	;[7.1120]Get the number of slot blocks
	MOVEI	T2,SBBITS	;[7.1120]Get address of allocation table
	CALL	BITON		;[7.1120](T1,T2)Initialize to all ones
	MOVX	T1,PRMAXI	;[7.1120]Get the number of PR blocks
	MOVEI	T2,PRBITS	;[7.1120]Get address of allocation table
	CALL	BITON		;[7.1120](T1,T2)Initialize to all ones
IFN FTOPS20,<
	MOVX	T1,PRMAXI	;[7.1120]Get the number of PR blocks
	MOVEI	T2,PRWMSK	;[7.1120]Get addr of scheduler test table
	CALL	BITOF		;[7.1120](T1,T2)Initialize to all zeros
>;END IFN FTOPS20
	SETZRO	UNCHN,+UNB.OF(XB);For now, later must read channel list
	SETZRO	UNPAD,+UNB.OF(XB);We use padding
	MOVEI	T1,^B0110000000000100	;Protocol ID is 60-04
	STOR	T1,UNPRO,+UNB.OF(XB)
	XMOVEI	T1,LATCBR	;Callback routine address
	STOR	T1,UNCBA,+UNB.OF(XB)
	MOVX	T1,NU.OPN	;NISRV Open function
	XMOVEI	T2,UNB.OF(XB)	;Use this for open as well
IFN FTOPS20,<
	CALL	DLLUNI##
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)
>
	IFSKP.
	  XMOVEI T2,UNB.OF(XB)	;Load address of UN block
	  CALL LATLSC		;(T1-2)Check to see if NI is running
	  LOAD T1,UNPID,+UNB.OF(XB) ;Get the PID return from the DLL
	  STOR T1,HNPID,(HN)	; and store for later calls to the DLL.
	  CALL GETRBF		;(HN)Get a buffer for receives
	   TRN			;Will have to get buffers later
	ENDIF.
	RET
INIRES:
	BUG. (CHK,LATINE,LATSER,SOFT,<LATINI failed to initialize>,,<

Cause:	Could not obtain sufficient memory for the LAT host databases.

Action:	Determine why there is so little resident memory available at system
	startup.

Data:	HN.LST words for the host node database, CBMAXI words for CBVECT,
	and NTTLAH words for SBVECT.

>)
	SKIPE	T1,LAHNDB	;Start with a clean slate when we try
	CALL	MMFREE		; (T1)to initialize later...
	SKIPE	T1,CBVECT	; ...
	CALL	MMFREE		; (T1)...
	SKIPE	T1,SBVECT	; ...
	CALL	MMFREE		; (T1)...
	SKIPE	T1,PRVECT	;[7.1120] ...
	CALL	MMFREE		;[7.1120] ...
	SKIPE	T1,PRRAND	;[7.1120] ...
	CALL	MMFREE		;[7.1120] ...
	RET

	ENDAV.
;[7.1120]
;BITON - Set a number of bits in a table.
;BITOF - Clear a number of bits in a table
;
; T1/ Number of bits to set
; T2/ Address of the array
;	CALL BITON/BITOF
; Return+1: Always

BITOF:	TDZA	T4,T4		;Clear T4, and skip
BITON:	SETO	T4,		;T4 = 0 implies BITOF was called.
	SAVEAC	<P1>		;Don't trash P1
	MOVEM	T2,T3		;Copy the destination address
	IDIVI	T1,^D36		;Calculate the number of whole words
	MOVEM	T2,P1		;Save the number of bits left over
	JUMPLE	T1,BITON1	;No whole words: check for bits left
	MOVEM	T4,(T3)		;Initialize the first word
	MOVE	T2,T3		;Make that the source address
	AOS	T3		;The destination is the next word
	SOSLE	T1		;Do we need to set more than one word?
	XBLT. T1		;Yes, use a block transfer
BITON1:	JUMPE	P1,RTN		;Zero bits left: return
	MOVEI	T1,1		;Calculate the negative number
	SUB	T1,P1		; of bits to shift plus one
	MOVX	T2,1B0		;Get a bit to be shifted
	ASH	T2,(T1)		;Build a bit mask for the last word
	SKIPN	T4		;BITOF?
	SETCA	T2,		;Yes. T2 = ~T2
	MOVEM	T2,(T3)		;Use it
	RET			;
	SUBTTL	Subroutine -- CWHLAT - Type a server spec for WHERE command

;CWHLAT - Types a server spec given a LATSER-owned LDB.
;
; Call:
;	U/ Target LDB address
;	0(P)/ Command LDB address
;
; Return:
;	RET			;If success
;	via CWHNCN		;If line is not owned by LATSER
;
; Used: T1-T4

	RESCD

IFN FTOPS10,<
CWHLAT::POP	P,T1		;Can't call SE1ENT with junk on stack!
	SE1ENT			;So we can access NZS data
	PUSH	P,T1		;RE-save LDB of command term
	SKIPN	T1,LDBLAT##(U)	;Get slot block associated with target TTY
	 PJRST	CWHNCN##	;Not connected now.
	POP	P,U		;Point to command terminal for typeout
	PUSH	P,DEVNAM(F)	;Save TTY name
	PUSH	P,SB.CBA(T1)	; and Circuit Block address.
	CALL	TTYKLQ##	;ZAP useless TTY DDB
	CALL	INLMES##	;Type out an intro
	 ASCIZ	/LAT	/		; guess what!
	MOVE	T2,(P)		;Get LAT circuit block address
	LOAD	T1,CBRSC,(T2)	;Get server name count from it
	ADD	T2,[OWGP. 7,CB.SNM]	;Make byte pointer to name
	CALL	TCSTR		;(T1-T2)Type a counted string
	MOVEI	T3,"("		;Separate it
	CALL	COMTYO##	; from location
	POP	P,T2		;Get CB address for last time
	LOAD	T1,CBRLC,(T2)	;Get server location count from it
	ADD	T2,[OWGP. 7,CB.LOC]	;Make byte pointer to location
	CALL	TCSTR		;(T1-T2)Type a counted string
	CALL	INLMES##	;Close it off
	 ASCIZ	/) /		;and separate it.
	POP	P,T2		;Get TTY name
	CALL	PRNAME##	; and type it.
	CALLRET	PCRLF##		;and return
					;Still in IFN FTOPS10

; Routine TCSTR - type a counted ASCII string
;
;Call:	T1/ byte count
;	T2/ byte pointer
;
TCSTR:	SOJL	T1,CPOPJ##	;No chars to type
	PUSH	P,T1		;save the count in a safe place
TCST1:	ILDB	T3,T2		;Get a character
	CALL	COMTYO##	; and type it
	SOSL	(P)		;Count them down
	JRST	TCST1		; and do them all
	POP	P,T1		;trim the stack
	RET			; and return

	XRESCD

; Once-A-Second code
;
LATSEC:	SKPCPU	(0)		;SKIP IF WE'RE ON POLICY CPU
	RET			;NO, ONLY RUN ONCE A SECOND!
	CALL	XLATXP		;[7.1120]Transmit Command messages
	SKIPLE	LATMCT		;IS the timer non-zero?
	SOSLE	LATMCT		;Count down the timer
	 RET			;Not time to do anything yet
;	CALLRET	LATXMC		;()Fall into multicast transmit code
>;end IFN FTOPS10
	SUBTTL	Multicast Transmitter

;LATXMC	- Transmit Multicast Message

;CALL:	CALL LATXMC
;	Normal Return

XRENT	(LATXMC,G)		;[7.1024]LATXMC::, XLATXM::

	ACVAR	<HN,XB,W1,W2>
	MOVE	HN,LAHNDB	;Get the HN data base address
	LOAD	T1,HNMTI,(HN)	;Reset the multicast timer
IFN FTOPS20,<
	IMULI	T1,^D1000	;Convert from seconds to milliseconds
>;END IFN TOPS20
	MOVEM	T1,LATMCT	;
	CALL	CHKXMC		;(HN)Transmit the multicast this time?
	 RET			;No.
	CALL	GETRBF		;(HN)Post more receive buffers if necessary.
	 TRN			;Not necessary.
	CALL	DYNRAT		;(HN)Check if dynamic rating needs update.
	XMOVEI	XB,HN.MCM(HN)	;Get the address of the multicast msg
	OPSTR	<SKIPE W1,>,HNCFL,(HN);If nothing changed in HN database
	OPSTR	<SKIPL>,HNLOK,(HN); or something changed by db id locked
	JRST	SNDMNC		; then send the old image of mc msg
	CAIE	W1,HN%SVR	;Did only the ratings change?
	JRST	LATXM0		;No, something else changed
	CALL	BMCRAT		;(HN,XB)Go update the ratings
	JRST	LATXM2		; and send the mc msg
LATXM0:	SETZ	T1,0		;So BMCFXD will increment incarnation count
	TRNE	W1,HN%OTH	;Did something in fixed part of mc change?
	CALL	BMCFXD		;(T1,HN,XB)Yes, go rebuild fixed part of mc msg
	TRNE	W1,HN%ACS	;Did any access codes change?
	CALL	BMCACS		;(HN,XB)Yes, go rebuild access code field
	TRNE	W1,HN%NDD	;Did the host node description change?
	CALL	BMCNID		;(HN,XB)Rebuild the node description
	TRNN	W1,HN%NDD	; and the service fields
LATXM1:	TRNE	W1,HN%SVN!HN%SVD!HN%SVR;Did anything in any service change?
	CALL	BMCSRV		;(HN,XB)Yes, reconstruct all service fields
LATXM2:	SETZRO	HNCFL,(HN)	;Clear data base change flags
SENDMC:	MOVX	T1,<POINT 8,<SBF.OF+1>(XB),23>;Pointer msg change flags
	LDB	T2,T1		;Message incarnation field
	AOS	T2		;Add one
	DPB	T2,T1		; and put back into msg
	ILDB	T2,T1		;Load current change flag settings from msg
	TDC	T2,W1		;Complement those bits which represent change
	DPB	T2,T1		; and put back into msg
SNDMNC:	XMOVEI	T1,<SBF.OF>(XB)	;Set up one word global to buffer for
	TXO	T1,<OWGP. 8,0>	; NISRV and
	STOR	T1,UNBFA,+UNB.OF(XB); store in UN block
	LOAD	T1,HNPID,(HN)	;Get the PID for the DLL
	STOR	T1,UNPID,+UNB.OF(XB)
	MOVX	T1,NU.XMT	;Set NI function to transmit
	XMOVEI	T2,UNB.OF(XB)	;Address of arguement block for NISRV
IFN FTOPS20,<
	CALL	DLLUNI##	;Call NI service
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)	;Call NI service
>
	 TRN			;Ignore error
	RET			;Return
	SUBTTL	Routine to check/compute the Dynamic Rating

;DYNRAT - Routine to check/compute the Dynamic Rating

DYNRAT:
IFN FTOPS20,<
	MOVE	T1,RJAV+2	;15 minute load average
	FSC	T1,2		;Multiply by 4
	FIXR	T1,T1		;and convert/round to integer
	SUBI	T1,^D255	;Subtract from 255 to give negative rating.
	SKIPLE	T1		;Assure rating
	MOVX	T1,-1		; is at least 1
	MOVMS	T1		;Make rating positive
	OPSTR	<CAMN T1,>,HNRAT,(HN)	;Compare with current dynamic rating
	RET			;No change; return.
	STOR	T1,HNRAT,(HN)	;Store new rating in HN block
	SETONE	HNSVR,(HN)	;Indicate rating has changed.
>;END IFN FTOPS20
IFN FTOPS10,<
	MOVEI	T1,1		;No dynamic rating for TOPS-10
>;END IFN FTOPS10
	RET
	SUBTTL	Routines to Build the Host Multicast Message -- BMCFXD

;BMCFXD - Build fixed portion of the multicast message

;Call:	T1/ Incarnaction count flag
;	HN/ Host Node Data Base Address
;	XB/ Address of the multicast message block in HN
;	CALL BMCFXD
;
; This routine builds the first ^D12 bytes of the multicast message.  It is
; called either to build a new message or to update the fixed portion if any
; of the parameters in the fixed portion have changed since the last multicast
; message was transmitted.  This routine does not modify the message count.

BMCFXD:	STKVAR	<INCFLG>	;Save the incarnaction
	MOVEM	T1,INCFLG	; flag.
	MOVX	T1,<POINT 8,<SBF.OF>(XB)>	;Byte pointer to start of msg
	STOR	T1,UNBFA,+UNB.OF(XB); is needed to fill in the msg header
	MOVEI	T1,MT.MCA_2	;Message type for multicast message
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	MOVEI	T1,^D8		;Set 80ms preferred server circuit timer
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	MOVEI	T1,LALPV_^D8+LAHPV;Highest and lowest permitted protocol version
	CALL	LAP2B0		;(T1)
	MOVEI	T1,PROECO_^D8+PROVER	;Enter current protocol version and ECO
	CALL	LAP2B0		;(T1)
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(XB);Get old incarnation count and assume
	AOS	T1		; we just want to increment it.
	SKIPN	INCFLG		;If this is initialization, we want a "random"
	IFSKP.			; incarnation count instead.
	  MOVEI T1,^D255	;Maximum value incarnation count can have.
	  CALL RANDOM		; (T1/T1)the initial message incarnation count.
	ENDIF.
	OPSTRM	<DPB T1,>,UNBFA,+UNB.OF(XB); and put back
	LOAD	T1,HNCFL,(HN)	;Get the change flags
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	MOVEI	T1,LMRFSI+^D14	;Receive buffer size (including E-net header)
	CALL	LAP2B0		;(T1)
	LOAD	T1,HNMTI,(HN)	;Get the multicast timer interval
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	MOVEI	T1,0		;Set status indicating accepting new sessions.
	LOAD	T2,HNLAS,(HN)	;Get the current LAT access state
	CAIE	T2,LS.ON	;Is it on?
	MOVEI	T1,1		;No, indicate not accepting new sessions.
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	RET
	SUBTTL	Routines to Build the Host Multicast Message -- BMCFXD

;BMCACS - Enter Access Codes into the Multicast Message - BMCACS

;Call:	HN/ Host Node Data Base Address
;	XB/ Address of the multicast message block in HN
;	CALL BMCACS
;	Normal Return
;
; This routine builds ^D32 bytes of host access codes.  It is called either to
; build a new message or to update the fixed length access code field if any of
; the access codes have changed since the last multicast message was
; transmitted.  This routine does not modify the message count.

BMCACS:
	MOVX	T1,<POINT 8,<SBF.OF+^D12/4>(XB)>	;ACs start at a fixed location
	STOR	T1,UNBFA,+UNB.OF(XB)	;Store as byte pointer to message buffer
	LOAD	T1,ACLNG,(HN)	;Count of the access code string
	MOVX	T2,<POINT 8,AC.COD(HN)>	;Source string byte pointer
	CALL	PTCST0		;(XB,T1,T2)Transfer the string to the message
	RET
	SUBTTL	Routines to Build the Host Multicast Message -- BMCNID

;BMCNID - Enter Access Codes into the Multicast Message - BMCNID

;Call:	HN/ Host Node Data Base Address
;	XB/ Address of the multicast message block in HN
;	CALL BMCNID
;	Normal Return
;
; This routine enters the host node name and descriptor strings into the
; multicast message block.  It is called either to build a new message or to
; update the fixed length access code field if the node name or descriptor
; has changed since the last multicast message was transmitted.  If this
; routine is called, the rest of the multicast message must be rebuilt.  This
; routine does not modify the message count.

BMCNID:
	MOVX	T1,<POINT 8,<SBF.OF+^D12/4+^D32/4>(XB),7>	;Node name starts here
	STOR	T1,UNBFA,+UNB.OF(XB)	;Store as byte pointer to message buffer
	LOAD	T1,HNNMC,(HN)	;Host name count
	MOVX	T2,<POINT 7,HN.NAM(HN)>	;Source string byte pointer
	CALL	PTCST0		;(XB,T1,T2)Transfer host node name to m.c.msg
	LOAD	T1,HNIDC,(HN)	;Count of host node description string
	MOVX	T2,<POINT 7,HN.ID(HN)>	;Move the host node id string to the
	CALL	PTCST0		; (XB,T1,T2)m.c. message
	RET
	SUBTTL	Routines to Build the Host Multicast Message -- BMCSRV

;BMCSRV - Build the Available Host Services Data - BMCSRV

;Call:	HN/ Host Node Data Base Address
;	XB/ Address of the multicast message block in HN
;	CALL BMCSRV
;	Normal Return
;
; This routine enters all service blocks and the service classes into the
; multicast message block.  It is called either to build a new message or to
; update the message when any service name or description has changed since
; the last multicast message was transmitted.  This routine does modify the
; message count.

BMCSRV:	SAVEAC	<W1,W2>
	LOAD	W1,HNNSV,(HN)	;Get the total number of offered services
	SKIPN	W1		;Must be at least one service to offer
	RET			;Nope.
	MOVEI	T4,^D12+^D33+1	;Initialize msg count
	MOVX	T3,<POINT 8,<SBF.OF+^D12/4+^D32/4>(XB),7>;Get pointer to node name
	ILDB	T1,T3		;Get node name count
	ADDI	T4,1(T1)	;Include in total msg count
	ADJBP	T1,T3		;Adjust to node descriptor
	ILDB	T3,T1		;Get the node description count
	ADDI	T4,1(T3)	;Include in total msg count
	ADJBP	T3,T1		;Adjust pointer to start of Service Block
	STOR	T4,UNBSZ,+UNB.OF(XB);Store msg count so far
	STOR	T3,UNBFA,+UNB.OF(XB);Current message byte pointer
	OPSTRM	<IDPB W1,>,UNBFA,+UNB.OF(XB);Already counted
	XMOVEI	W2,HN.SRV(HN)	;Address of start of service blocks
SRVLP:	OPSTR	<SKIPGE T1,>,GBRAT,(W2)	;Get the service rating
	LOAD	T1,HNRAT,(HN)	;If negative, load current host dynamic rating.
	OPSTRM	<AOS>,UNBSZ,+UNB.OF(XB);Account for rating in the byte count
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB);Store in mc msg
	LOAD	T1,GBNC,(W2)	;Get the service name count
	MOVX	T2,<POINT 7,GB.NAM(W2)>	;Pointer to service name
	CALL	PTCSTR		;(XB,T1,T2)Move name string to mc msg
	LOAD	T1,GBLC,(W2)	;Get the service description count
	MOVX	T2,<POINT 7,GB.HID(W2)>;Pointer to the service description string
	CALL	PTCSTR		;(XB,T1,T2)Move to mc msg
	ADDI	W2,GB.LEN	;Address of next block
	SOJN	W1,SRVLP	;Loop through all services
	MOVEI	T1,1_^D8+1	;Service class 1 only
	CALL	LAP2BY		;(XB,T1)
	RET
	SUBTTL	Routines to Build the Host Multicast Message -- BMCRAT

;BMCRAT - Update the MC Msg with the current service ratings - BMCRAT

;Call:	HN/ Host Node Data Base Address
;	XB/ Address of the multicast message block in HN
;	CALL BMCRAT
;	Normal Return
;
; This routine loops though all the service blocks and updates the
; corresponding service rating in the multi-cast message. This routine does
; NOT modify the message count itself.

BMCRAT:	SAVEAC	<W1,W2>
	MOVX	T3,<POINT 8,<SBF.OF+^D12/4+^D32/4>(XB),7>;Get pointer to node name
	ILDB	T1,T3		;Get node name count
	ADJBP	T1,T3		;Adjust to node descriptor
	ILDB	T3,T1		;Get the node description count
	ADJBP	T3,T1		;Adjust pointer to start of Service Block
	ILDB	W1,T3		;Get number of services from msg
	XMOVEI	W2,HN.SRV(HN)	;Address of start of service blocks
RATLP:	OPSTR	<SKIPGE T1,>,GBRAT,(W2)	;Get the service rating
	LOAD	T1,HNRAT,(HN)	;If negative, load current host dynamic rating.
	IDPB	T1,T3		;Store updated rating in mc msg
	LOAD	T1,GBNC,(W2)	;Get the service name count
	OPSTR	<ADD T1,>,GBLC,(W2);Add the service description count
	ADDI	T1,2		;Account for the 2 count fields
	ADJBP	T1,T3		;Adjust the pointer
	MOVE	T3,T1		;Put adjusted pointer back where we want it
	ADDI	W2,GB.LEN	;Address of next block
	SOJN	W1,RATLP	;Loop through all services
	RET
	SUBTTL	Multicast Transmit Check Routine

;CHKXMC - Check for Transmit of Multicast Message

;Call:	HN/ Address of the Host Node Data Base
;RET -	Don't transmit
;RETSKP	Transmit

CHKXMC:	LOAD	T1,HNLAS,(HN)	;Transmit only if LAT access state is ON and
	LOAD	T2,HNNMC,(HN)	; there is a host name defined.
	CAIN	T1,LS.ON	; is ON.
	SKIPN	T2
	RET
	TMNE	HNRUN,(HN)	;Is the NIA running?
	RET			;No, don't send any messages.
	RETSKP
	SUBTTL	Build the START Message Template

;BLDSTM - Build the START Message Template

;Call:	HN/ Address of the Host Node Data Base
;	CALL BLDSTM
;	Normal Return
;
; This routine builds the "static" portions of the start message:  those
; fields which do not change very frequently. Fields which change frequently
; are set up by the transmitting routines.  This routine also sets up the
; message size in UNBSZ of the NISRV UN block.

BLDSTM:	SAVEAC	<W1>
	XMOVEI	XB,HN.SMT(HN)	;Address of START message template
	MOVX	T1,<POINT 8,<SBF.OF+<SZ.MHD>/4>(XB)>;Point beyond the msg header
	STOR	T1,UNBFA,+UNB.OF(XB); since it will change with each transmission.
	MOVEI	W1,^D12		;Count of fixed fields (including count fields)
	MOVEI	T1,LMRFSI+^D14	;Minimum receive buffer size
	CALL	LAP2B0		;(XB,T1)Store in msg
	MOVEI	T1,PROECO_^D8+PROVER	;Enter current LAT protocol version
	CALL	LAP2B0		;(XB,T1) and ECO
	LOAD	T1,HNMCO,(HN)	;System-wid maximum LAT connects allowed
	CAILE	T1,MXSLTS	; compared to max slots per virtual circuit
	MOVEI	T1,MXSLTS	;Get the smaller of the two
	CALL	LAP2B0		;(XB,T1)
	MOVEI	T1,0		;Timers are non-zero when from server
	CALL	LAP2B0		;(XB,T1) only.
	LOAD	T1,HNNUM,(HN)	;Get the host number
	CALL	LAP2B0		;(XB,T1) and store as 2 bytes in msg
	MOVEI	T1,LHPRID	;LAT Host product ID is TOPS-20 Host
	CALL	LAP2B0		;(XB,T1) and store as 2 bytes in msg
	LOAD	T1,HNNMC,(HN)	;Host Node Name count
	ADDI	W1,1(T1)	;Add to the total message byte count
	MOVX	T2,<POINT 7,HN.NAM(HN)>;Host node name source string
	CALL	PTCST0		;(XB,T1,T2)Put into start message as NODE NAME
	LOAD	T1,HNNMC,(HN)	;Host Node Name count
	ADDI	W1,1(T1)	;Add to the total message byte count
	MOVX	T2,<POINT 7,HN.NAM(HN)>;Host node name source string
	CALL	PTCST0		;(XB,T1,T2)Put in start message as SYSTEM NAME
	LOAD	T1,HNIDC,(HN)	;Count of description string
	ADDI	W1,1(T1)	;Add to the total message byte count
	MOVX	T2,<POINT 7,HN.ID(HN)>;Description string source pointer
	CALL	PTCST0		;(XB,T1,T2)Put into start message
	MOVEI	T1,0		;There are no parameters
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB); is zero
	ADDI	W1,1		;Include in total count
	CAIG	W1,MINXBF	;Send at least the minimum
	MOVEI	W1,MINXBF	; size.
	STOR	W1,UNBSZ,+UNB.OF(XB);Store message byte count
	STOR	XB,UNRID,+UNB.OF(XB);Store buffer address for completion routines.
	RET

	ENDAV.
	SUBTTL	LAINTR -- LAT DLL Callback Routinea

;LATCBR - dispatch to routine to handle DLL callback

;Call:	T1/ NU.RCV
;	T2/UN block address
;	CALL LATCBR
;	Normal return

LATCBR:	ACVAR	<HN,XB,RB>	;Reserve some registers
	MOVE	HN,LAHNDB	;Get the host node data base address
	MOVE	T4,T3		;Save NISRV's error register
	CAIL	T1,MINCBF	;Validate the callback function code
	CAIG	T1,MAXCBF
	CALLRET	@CBRDSP-MINCBF(T1)	;Valid, call the proper routine
	BUG. (CHK,LATICB,LATSER,SOFT,<LATCBR called from NISRV with illegal callback function code>,<<T1,CODE>>,<

Cause:	NISRV	has called the LATSER callback routine with an invalid function
	code.

Data:	CODE	- Function code

>)
;[7.1024]
;[7.1024] **WARNING** If ILLCBR is moved out of PSECT XRCOD then the
;[7.1024] "IFIW ILLCBR" in the CBRDSP dispatch table must be changed.
;[7.1024]
ILLCBR:
	RET

	MIN. (MINCBF,<NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RCL,NU.RCI,NU.RCC,NU.SCA,NU.RPL,NU.RPI,NU.RPC>) ;Minimum callback function
	MAX. (MAXCBF,<NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RCL,NU.RCI,NU.RCC,NU.SCA,NU.RPL,NU.RPI,NU.RPC>) ;Maximum callback function

CBRDSP:	XADDR. LAINTR		;NU.RCV: Datagram received
	XADDR. LAINTX		;NU.XMT: Datagram transmit complete
	XADDR. ILLCBR		;NU.EMA: Enable Multicast
	XADDR. ILLCBR		;NU.DMA: Disable Multicast

	XADDR. ILLCBR		;NU.RCL: Read channel list
	XADDR. LATLSC		;NU.RCI: Link state changed
	XADDR. ILLCBR		;NU.RCC: Read channel counters
	XADDR. LATSCA		;NU.SCA: Set channel address

	XADDR. ILLCBR		;NU.RPL: Read portal list
	XADDR. ILLCBR		;NU.RPI: Read portal information
	XADDR. ILLCBR		;NU.RPC: Read portal counters

	SUBTTL	LAINTR -- Interrupt Level Virtual Circuit Message Receiver

;LAINTR - Processes a circuit message at NI interrupt level

;Call:	T1/ NU.RCV
;	T2/UN block address
;	T4/NISRV's T3
;	CALL LAINTR
;	Normal return

LAINTR:	LOAD	RB,UNRID,(T2)	;Get address of message block
	JUMPE	T4,LANTR1	;[7.1039]If error code is 0 proceed

; Here, there was an error on receive.  Don't wait for tick time
;  to turn the buffer around.
;
	MOVE	T1,RB		;[7.1039]Get address of receive buffer
	CALL	RBPOSS		;[7.1039](T1)Repost it now (preserving T1-T4)
	 TRNA 			;[7.1039]Couldn't re-post. Process it later.
	RET			;[7.1039]Buffer re-posted. We're done for now.

LANTR1:	MOVEI	T1,UN.LEN	;[7.1039]Length of the block to copy
	XMOVEI	T3,UNB.OF(RB)	;Address of where to copy the UN block
	XBLT. T1		;Copy the UN block to buffer header
	MOVEI	T1,NU.RCV	;Scheduler needs to know buffer type.
	MOVE	T2,RB		;Address of element to put onto queue
	CALL	LAINT0		;(T1,T2,T4)Do common actions
	RET			;And return to NISRV dismissing interrupt
	SUBTTL	LAINTX - Interrupt Level Virtual Circuit Message Receiver

;LAINTX - Processes a circuit message at NI interrupt level

;Call:	T1/ NU.XMT
;	T2/UN block address
;	T4/NISRV's T3
;	CALL LAINTX
;	Normal return

LAINTX:	LOAD	XB,UNRID,(T2)	;Get the buffer address
	LOAD	T3,UNDAD,+UNB.OF(XB);Get first 4 bytes (low order) of NI address
	TXNE	T3,1B7		;Is the multicast bit on?
	RET			;Yes, nothing to do
	MOVX	T3,<POINT 8,<SBF.OF>(XB)>;Point to the msg header
	ILDB	T2,T3		; and get the message type
	LSH	T2,-2		;Shift off M and RRF bits
	CAIE	T2,MT.STA	;If a START message,
	IFSKP.			; then release lock on the START message
	  SETZRO HNCIP,(HN)	; template and return.
	  RET
	ENDIF.
	MOVE	T2,XB
	CALL	LAINT0		;(T1,T2,T4)Do common actions
	RET

; Routine to perform interrupt level actions common to both receive data and
; transmit complete.
;
LAINT0:	STOR	T1,UNCBA,+UNB.OF(T2);Store callback type for scheduler processing
	STOR	T4,UNSPI,+UNB.OF(T2);Save NISRV's error return
IFN FTOPS10,<
	ETHLOK			;Interlock queue access
>
	OPSTR	<SKIPN T3,>,HNNIQ,+1(HN);Is the Q currently empty?
	IFSKP.			;NO
	  STOR T2,UELW1,(T3)	;New forward for old Q tail element
	  SETZRO UELW1,(T2)	;New tail's forward link is zero.
	ELSE.			;YES
	  STOR T2,HNNIQ,(HN)	;New queue header forward pointer
	ENDIF.
	STOR	T2,HNNIQ,+1(HN)	;New queue header tail pointer
IFN FTOPS10,<
	ETHULK			;Release interlock
>
	RET

	ENDAV.
	SUBTTL	LARSCH - Scheduler Level Virtual Circuit Message Receiver

;LARSCH - Complete circuit message processing at scheduler level

IFN FTOPS10,<			;[7.yyyy]
	RESCD			;[7.yyyy]
LATSTO::SKPCPU	(0)		;[7.yyyy]On policy CPU?
	RET			;[7.yyyy]No, do nothing
;	CALLRET LARSCH		;[7.yyyy]Yes, fall into LARSCH
> ;End IFN FTOPS10

XRENT	(LARSCH,G)		;[7.1024]LARSCH::, XLARSC::

	ACVAR	<HN,XB,RB,CB,SB,W1,W2>;Get a set of dedicated ACs
	TRVAR	<MSGDID,MSGSID,MSGACK,STPCOD>;Message hdr variable, etc.
	SETZ	CB,		;[7234] No circuit block yet
	SKIPN	HN,LAHNDB	;Get the host node database address
	RET			;If none, not initialized yet.
	CALL	MOVNIQ		;(T1,T2)Move all messages from NI to Sched que
IFN FTOPS10,<
	SETZM	LATWFB		;Say we don't want more buffers yet
>

MSGNXT:	OPSTR	<SKIPN T2,>,HNSCQ,(HN);Get first element on the scheduler Q
	CALLRET	LAMUX		;No more so call the slot multiplexor
	OPSTR	<SKIPN T3,>,UELW1,(T2);Get new head or queue if any
	STOR	T3,HNSCQ,+1(HN)	;None, so clear the queue header tail pointer
	STOR	T3,HNSCQ,(HN)	;Set new queue header forward pointer
	SETZRO	UELW1,(T2)	;Clear link word
	LOAD	T1,UNCBA,+UNB.OF(T2)
	CAIE	T1,NU.XMT	;Is this a transmit complete?
	IFSKP.			;Yes...
	  CALL XMTDON		;(T1,T2)Do scheduler level transmit done stuff
	  JRST MSGNXT		; and continue with next message
	ENDIF.
	MOVE	RB,T2		;Message address obtained
	SKIPE	T1,UN.SPI+UNB.OF(RB);Was there an error?
	JRST	MSGDON		;Re-post and ignore
	OPSTRM	<AOS>,HCRCV,(HN)	;Increment count of received messages
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB)	;[7.1120]Get the message type from the buffer
	MOVE	T1,T2		;[7.1120]
	LSH	T1,-2		;Shift off the M and RRF bits
	CAIL	T1,MINMTY	;Range check message type
	CAILE	T1,MAXMTY	;...
	IFNSK.
	  BUG. (CHK,LATIMT,LATSER,SOFT,<LAT Illegal Message Type>,<<T1,MSGTYP>>,<

Cause:	The LAT virtual circuit message was received with a message type out
	of range.

Data:	MSGID	- Message type

>)
	ELSE.
	  TRNE T2,MSB.FL	;[7.1155]Test the Master/Slave bit
	  IFSKP.		;[7.1155]If it's a slave message...
	    CAIE T1,MT.RIN	;[7.1155]Is it a Response Information Message
	    CAIN T1,MT.STS	;[7.1155] or a status message?
	    TRNA		;[7.1155] Yes, skip
	    JRST MSGDON		;[7.1155] No.  Ignore for now
	  ENDIF.		;[7.1155]
	  CALL @MSGDSP-MINMTY(T1) ;Dispatch to process the message
	ENDIF.
MSGDON:	CALL	RELRBF		;(RB)Ignore for now
	JRST	MSGNXT


	MIN. (MINMTY,<MT.RUN,MT.STA,MT.STP,MT.STS,MT.RIN>) ;[7.1120]Minimum message type code
	MAX. (MAXMTY,<MT.RUN,MT.STA,MT.STP,MT.STS,MT.RIN>) ;[7.1120]Maximum message type code


MSGDSP:	XADDR. HMRUN		;[7.1052]RUN message received
	XADDR. HMSTRT		;[7.1052]START message received
	XADDR. HMSTOP		;[7.1052]STOP message received
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. RTN		;[7.1120]
	XADDR. HMSTAT		;[7.1120]STATUS message received
	XADDR. RTN		;[7.1120]
	XADDR. HMINFO		;[7.1120]RESPONSE INFORMATION received
;MOVNIQ - Move all messages on the NI queue to the Scheduler queue

;Call:	T1/ Pointer to head of NIQ
;	T2/ Pointer to tail of NIQ
;	CALL MOVNIQ
;	Normal return
;
;Uses: T3,T4

MOVNIQ:
IFN FTOPS20,<
	CHNOFF	NIPIA		;Turn off NI interrupts
>
IFN FTOPS10,<
	ETHLOK			;Turn off NI interrupts
>
	DMOVE	T1,HN.NIQ(HN)	;Get the header contents
	SETZM	HN.NIQ(HN)	;Clear the queue begin pointer
	SETZM	HN.NIQ+1(HN)	;Clear the end pointer
IFN FTOPS20,<
	CHNON	NIPIA		;Turn NI back on
>
IFN FTOPS10,<
	ETHULK			;Turn NI back on
>
	OPSTR	<SKIPN T3,>,HNSCQ,+1(HN);Is there anything on the queue?
	IFSKP.			;YES
	  STOR T1,UELW1,(T3)	;Add new elements at the queue tail.
	ELSE.			;NO
	  STOR T1,HNSCQ,(HN)	;New queue header forward pointer
	ENDIF.
	STOR	T2,HNSCQ,+1(HN)	;New queue header tail pointer.
	RET
	SUBTTL	LATLSC - Ethernet Link State Change Callback

;LATLSC - Process an asynchronous link state change

;Call:	T1/ NU.RCI
;	T2/ UN block address
;	Normal return
;

LATLSC:	MOVX	T3,HNRUN
	TMNN	UNRUN,(T2)	;[7.1039]Is the NI running?
	IFSKP.			;[7.1039]
	  ANDCAM T3,HN.FLG(HN)	;[7.1039]NI is up
	ELSE.			;[7.1039]
	  IORM T3,HN.FLG(HN)	;NI went down.
	ENDIF.
	RET


;LATSCA - Process a set channel address callback

;Call:	T1/ NU.SCA
;	T2/ UN block address
;	Normal return
;

LATSCA:	MOVEI	T1,1		;
	SKIPLE	LATMCT		;Send the multicast message at the
	MOVEM	T1,LATMCT	; next once-a-second time
	RET			;
;[7.1120]
;MSBGN - Parse the beginning of the RUN, START, and STOP messages.
;
; RB/ Address of message block
;	CALL MSBGN
; Return+1: Always

MSBGN:	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB)
	MOVEM	T1,NSLOTS	;Get number of slots in message
	DECR	UNBSZ,+UNB.OF(RB)	;Reduce byte count by two
	DECR	UNBSZ,+UNB.OF(RB) 
	CALL	LAG2BY		;Get the destination ID from msg 
	MOVEM	T1,MSGDID	; (2 bytes, unsigned)
	CALL	LAG2BY		;Get the source id from the msg
	MOVEM	T1,MSGSID	; (2 bytes, unsigned)
	CALL	LAG2BY		;Get the ACK/SEQ field from msg
	MOVEM	T1,MSGACK	; (2 bytes, unsigned)
	RET			;
	SUBTTL	Message Receiver - HMSTRT


;HMRUN - Process a Host START Message
;
; RB/ Address of receive buffer
; CB/ Address of circuit block
; HN/ Address of host node data base
;	CALL HMSTRT
; Return+1: Always

HMSTRT:	CALL	MSBGN		;[7.1120](RB)Parse the beginning
	TMNN	HNCIP,(HN)	;If the START message template is locked
	SKIPN	MSGSID		;or source's message handle is 0
	RET			; ignore since server will persist.
	LOAD	T1,HNLAS,(HN)	;[7.1039]If LAT access state is not ON, ignore
	CAIE	T1,LS.ON	;[7.1039] the START message. 
	 RET			;[7.1039] ...
	LOAD	T1,HNNAC,(HN)	;If the addition of this circuit brings total
	OPSTR	<CAML T1,>,HNMAC,(HN); over the maximum number of active circuits
	JSP	T2,NOCRE0	;[7234] then reject it.
	CALL	HSTRCB		;(RB/CB)Find CB associated with this circuit.
	 RET			;None.  Error action already taken.
	LOAD	T1,CBSTA,(CB)	;Get the current circuit state
	CAIE	T1,CS.RUN	;[7.1039]If the state is running,
	IFSKP.			;[7.1039]
	  CALL RELSBS		;[7.1039](CB)Release all current slots
	  CALL RFXBFS		;[7.1039](CB)Release all buffers on free queue
	  CALL MDLXBF		;[7.1039](CB)Make all buffers on ACK queue for later release
	ENDIF.			;[7.1039]
	CALL	GETXBH		;(CB)Get necessary number of transmit buffer
	 SKIPA			; headers (+MSD pointers)
	CALL	GETRBF		;(HN)Go see if we need more receive buffers
	 JSP T2,NOCRES		;Could not get the necessary buffer quota
	CALL	CBINIT		;(CB,RB)Initialize all host CB parameters
	 RET			;START message format bad. Error action done.
	CALL	MTTSTR		;()Send a START message
	MOVEI	T1,CS.STA	;Put the circuit into the
	STOR	T1,CBSTA,(CB)	; STARTING state.
IFN FTOPS10,<
	MOVEI	T1,MAXXBF+1	;New circuit, add some buffers
	CAMLE	T1,LATNFB	;Are there already enough free buffers?
	ADDM	T1,LATWFB	;No, ask for some more
>;END IFN FTOPS10
	RET
	SUBTTL 	HSTRCB

;HSTRCB - Find the circuit block for a received START msg on a LAT host.

;Call:	RB/ address of received message block
;	CALL HSTRCB
;	 Error Return - CB not found
;	Normal Return
;	CB/ Circuit Block address

HSTRCB:	XMOVEI	T1,HN.QIC(HN)	;Search the inactive CB queue first
	CALL	CMNIAD		;(T1,RB/CB)Look for NI address match
	 SKIPA			;Not found on the inactive CB queue
	JRST	CBIFND		;Correct CB found on inactive CB queue
NFND1:	XMOVEI	T1,HN.QAC(HN)	;Not on inactive Q, try active Q
	CALL	CMNIAD		;(T1,RB/CB)Look for NI address match
	 SKIPA			;Not on active queue either
	JRST	CBAFND		;Active CB has been found
NFND2:	LOAD	T2,HNNAC,(HN)	;Get number of currently active CBs
	OPSTR	<CAML T2,>,HNMXC,(HN)	;Compare with maximum allowed
	IFSKP.			;Not at maximum number of CBs allowed
	  MOVEI T1,CC.LST	;The number of words to get for a CB
	  CALL MMGTZW		;(T1/T1)Go get them
	   JSP T2,NOCRES	;Failed
	  MOVE CB,T1		;This is the new CB address
	  MOVEI T1,CS.HLT	;Don't assume that the halted state
	  STOR T1,CBSTA,(CB)	; is zero.
	  OPSTRM <AOS>,HNNCC,(HN);Increment number of allocated CBs.
	  JRST CBALNW		;Allocated new CB successfully
	ENDIF.
	OPSTR	<SKIPN CB,>,QLBWD,+HN.QIC(HN);Check inactive Q for free CB
	JSP	T2,NOCRES	;None, so can't reuse an inactive CB
CBIFND:	MOVE	T2,CB		;Remove from inactive CB queue
	CALL	LAUNQ		;(T1,T2)
CBALNW:	CALL	CBGNIX		;(CB)Get next assignable index for the CB
	XMOVEI	T1,HN.QAC(HN)	;Put at the front of the active
	MOVE	T2,CB		; CB
	CALL	LAQUE		;(T1,T2) queue
	OPSTRM	<AOS>,HNNAC,(HN)	;New active circuit. Count it.
	SETONE	CBSTA,(CB)	;Set state to non-HALTED since now active
	OPSTRM	<AOS>,CCRCV,(CB)	;Increment per server count
	OPSTR	<DMOVE T1,>,UNSAD,+UNB.OF(RB);Move the source NI address from
	OPSTRM	<DMOVEM T1,>,CBDNI,(CB)	; message to the CB
CBAFND:	RETSKP			;Return success
	SUBTTL	CBINIT - Circuit Block Initialization

;CBINIT - Initialize a Circuit Block from the Contents of a START Message

;Call:	CB/ Address of Circuit Block
;	RB/ Address of Message Block
;	CALL CBINIT
;	 Error Return - START Message content in error.
;	Normal Return

CBINIT:	MOVEI	T1,MSTMSI	;Check to see if the message is at least
	OPSTR	<CAMLE T1,>,UNBSZ,+UNB.OF(RB); the minimum size for a START msg
	JSP	T2,ILLMES	;No, too short.
	SETZM	CLRBEG(CB)	;Clear the region which must be initialized
	MOVEI	T1,<CLREND-CLRBEG>; to zero when a circuit block is
	XMOVEI	T2,CLRBEG(CB)	; re-used.
	XMOVEI	T3,CLRBEG+1(CB)	; ...
	XBLT. T1		; ...
	MOVE	T1,MSGSID	;Move source's circuit ID from message
	STOR	T1,CBRID,(CB)	; to circuit block
	CALL	LAG2BY		;(MA/T1)Get maximum transmit frame size which
	STOR	T1,CBMTF,(CB)	; the remote will allow
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);LAT protocol version used by remote
	CAIL	T1,LALPV	;Check if in the range of version supported
	CAILE	T1,LAHPV	; by this node
	JSP	T2,LVSKEW	;Out of range, return error
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Remote's protocol ECO level
	LSH	T2,^D9		;Shift protocol version
	IOR	T1,T2		;OR version and ECO level
	STOR	T1,CBRPV,(CB)	; and store as single unit
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Maximum number of slots in VC message
	STOR	T1,CBMSL,(CB)	; permitted by remote
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Number of additional receive buffers
	STOR	T1,CBNBF,(CB)	; queued by remote for this circuit
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Remote's circuit timer value
	STOR	T1,CBCTI,(CB)	;
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Remote's keep-alive timer value
	STOR	T1,CBKTI,(CB)	;
	IMULI	T1,^D2000	;[7.xxxx]Convert to ms and multiply by 2 (fudge factor)
	STOR	T1,CBKAV,(CB)	; and store in keep alive value field.
	MOVX	T1,-^D6		;Decrement residual message count by what we
	OPSTRM	<ADDM T1,>,UNBSZ,+UNB.OF(RB); have read so far.
	CALL	LAG2BY		;(MA/T1)Get the "facility number"
	STOR	T1,CBNUM,(CB)
	CALL	LAG2BY		;(MA/T1)Get the product type code
	STOR	T1,CBPTC,(CB)
	MOVEI	T1,0		;Skip the circuit name
	CALL	GTCSTR		;(T1,T2,RB)
	 JSP T2,ILLMES		;Illegally formatted message
	MOVEI	T1,ML.SYS	;Maximum length of system's name string
	XMOVEI	T2,CB.SNM(CB)	;Where copy the name string
	TXO	T2,<OWGP. 7,0>
	CALL	GTCSTR		;(T1,T2,RB)
	 JSP T2,ILLMES		;Illegally formatted message
	STOR	T1,CBRSC,(CB)	;Save the length of the name string
	MOVEI	T1,ML.LOC	;Maximum length of the system's location string
	XMOVEI	T2,CB.LOC(CB)	;Where to copy the location string
	TXO	T2,<OWGP. 7,0>
	CALL	GTCSTR		;(T1,T2,RB)
	 JSP T2,ILLMES		;Illegally formatted message
	STOR	T1,CBRLC,(CB)	;Save the length of the location string
	RETSKP
	SUBTTL	CMNIAD - Find CB base on NI address

;CMNIAD - search the CBs on a CB queue looking for one which has the same
;	NI address as the source NI address in the incoming message.

;Call:	T1/ Queue header of CB queue to search
;	RB/ Address of the circuit message
;	CALL CMNIAD
;	 Not found return
;	Success return
;	T1/ unchanged
;	CB/ circuit block address if found, 0 otherwise

CMNIAD:	LOAD	CB,QLFWD,(T1)	;Get the first queue entry
CMLOOP:	JUMPE	CB,RTN		;Is this last entry?
	LOAD	T3,CBDNI,(CB)	;First 4 bytes of remote NI address from CB
	LOAD	T4,CBDNI,+1(CB)	;Last 2 bytes
	OPSTR	<CAMN T3,>,UNSAD,+UNB.OF(RB);Compare with message destination adr
	OPSTR	<CAME T4,>,UNSAD,+<UNB.OF+1>(RB)	;...
	IFNSK.
	  LOAD CB,QLFWD,+CB.LNK(CB); Get next forward CB
	  JRST CMLOOP		;Try again
	ENDIF.
	RETSKP			;Return success
;CBGNIX - Get the next assignable index for a CB

;Call:	CB/ address of circuit block
;	CALL CBGNIX
;	Normal Return
;
; This routine is called each time a CB is to be used for a new LAT
; virtual circuit.  The old index vector (CBVECT) pointer to the CB
; is deleted and a new index is generated.

CBGNIX:	MOVE	W1,CBVECT	;Get the address of the CB index vector
	OPSTR	<SKIPN T2,>,CBLID,(CB);Get the old circuit index, if any.
	IFSKP.
	  ADD T2,W1		;Get the address of the pointer to this CB
	  SETZM (T2)		; in the CB index vector and clear it.
	ENDIF.
	LOAD	T2,HNNXI,(HN)	;Get the next available index to assign
	STOR	T2,CBLID,(CB)	;Set the new index in the CB
	MOVE	T1,W1		;Address of teh CB index vector
	ADD	T1,T2		;Offset into this vector for new index
	MOVEM	CB,(T1)		;Set the new pointer to point to new CB
CBGNX0:	AOS	T2		;Increment the next available index
	AOS	T1		; and the corresponding index vector pointer
	CAIG	T2,CBMAXI	;Time to wrap around?
	IFSKP.			;Yes
	  MOVEI T2,1		;Always start at 1
	  MOVE T1,W1
	ENDIF.
	SKIPE	(T1)		;Is this vector entry free?
	JRST	CBGNX0		;No, try next
	STOR	T2,HNNXI,(HN)	;Store new "next assignable index"
	RET
	SUBTTL	HMRUN


;HMRUN - Process a Host RUN Message
;
; RB/ Address of receive buffer
; CB/ Address of circuit block
; HN/ Address of host node data base
;	CALL HMRUN
; Return+1: Always

HMRUN:	CALL	MSBGN		;[7.1120](RB)Parse the beginning
	CALL	HRUNCB		;(RB/CB)Get the circuit block address
	 RET			;None, error action already comleted
	SKIPE	T2,MSGDID	;Destination and source circuit IDs from
	SKIPN	T1,MSGSID	; the message may not be zero
	JSP	T2,ILLMES	;If so, it is illegal
	LOAD	T3,CBRID,(CB)	;Get the remote's circuit index from the CB
	LOAD	T4,CBLID,(CB)	; and our circuit index from the CB must match
	CAMN	T1,T3		; the source id and
	CAME	T2,T4		; the destination id from the msg.
	JSP	T2,INVRUN	;Invalid RUN msg, go terminate the circuit.
	MOVE	T1,TODCLK	;Get current time
	STOR	T1,CBKAT,(CB)	;Save time for keep-alive process
	MOVEI	T1,CS.RUN	;Put in RUNNING state if not there already
	STOR	T1,CBSTA,(CB)	;Store state in CB
	MOVE	T1,MSGACK	;Get the SEQ/ACK number
	MOVE	W1,T1		;
	ANDI	T1,377		;Received message sequence number
	LSH	W1,-^D8		;Last message ack'd by remote
	LOAD	T3,CBRSQ,(CB)	;Previous recv SEQ number
	AOS	T3		;Increment
	ANDI	T3,377		;Modulo 256
	CAME	T1,T3		;Is is the expected sequence number
	IFSKP.
	  STOR T1,CBRSQ,(CB)	;Update expected sequence number for next time
	ELSE.
	  SETZM NSLOTS		;No, ignore any slots in this message
	  OPSTRM <AOS>,HCSEQ,(HN);Increment Host's count
	  OPSTRM <AOS>,CCSEQ,(CB);Increment per-server count
	ENDIF.
	LOAD	T3,CBLRA,(CB)	;Previous "last ACK from remote"
	STOR	W1,CBLRA,(CB)	;New "last ACK from remote"
	CAMGE	W1,T3		;Is new ACK less than old ACK?
	ADDI	W1,^D256	;Yes, new ACK has wrapped around
	SUB	W1,T3		;Number of messages ACK'd by this msg
	CAILE	W1,MAXXBF	;Range check it and if out of range
	JSP	T2,ILLMES	; treat as an illegal message
	SKIPN	W1		;If anything got ACK'd
	IFSKP.
	  SETZRO CBRTC,(CB)
	ENDIF.
NXTACK:	JUMPE	W1,ACKDON	;No new messages ACK'd
	MOVE	XB,CB.AKQ(CB)	;Sneak look at buffer at head of Q
	CALL	RELXBF		;(XB)Free large MSD buffer.
	XMOVEI	T1,CB.AKQ(CB)	;Unqueue the now acknowledged buffers
	CALL	UNQ1WF		;(T1/T2) from the ACK wait queue
	 JSP T2,ILLMES	;Should not happen
	XMOVEI	T1,CB.XBQ(CB)	;Queue them back to the transmit buffer
	CALL	QUE1WB		;(T1,T2) queue.
	SOJA	W1,NXTACK
ACKDON:	OPSTR	<SKIPN>,CBAKQ,(CB);If all messages ack'd
	SETZRO	CBTIM,(CB)	; clear the circuit timer.
	SETONE	CBMRS,(CB)	;Indicate we must respond to this msg "soon"
	CALL	LSDMUX		;(RB)Go process all slots in the RUN message
	IFNSK.			;Invalid slot type returned.
	  BUG. (INF,LATIST,LATSER,SOFT,<LAT Illegal Slot Type>,<<T2,SLTID>>,<

Cause:	LAT	Slot received with Slot type out of range.

Data:	SLTID	- Slot ID

>)
	  MOVEI T1,CE.ILL	;Set up stop reason code.
	  CALL MTTSTP		;(T1,XB,RB,CB)Illegal slot, kill the circuit
	ENDIF.
	RET			;All slots processed, return receive buffer
	SUBTTL 	HSTRCB

;HRUNCB - Find the circuit block for a received RUN/STOP msg on a LAT host.

;Call:	RB/ address of received message block
;	CALL HRUNCB
;	 Error Return - CB not found
;	Normal Return
;	CB/ Circuit Block address
;

HRUNCB:	SKIPN	CB,MSGDID	;Index to CB from received message
	JSP	T2,ILLMS0	;Zero message destination index is illegal
	CAIG	CB,CBMAXI	;If CB index is greater than our max
	IFSKP.
	  SETZ CB,		;it's also illegal, so flag no circuit
	  JSP T2,ILLMS0		;and go send a stop message
	ENDIF.
	ADD	CB,CBVECT	;Add address of vector of pointers to CBs
	SKIPN	CB,(CB)		;The real circuit block address
	JSP	T2,INVRUN	;Circuit probably went away.
	OPSTR	<DMOVE T3,>,CBDNI,(CB);All 6 bytes of remote NI address from CB
	OPSTR	<CAMN T3,>,UNSAD,+UNB.OF(RB);Compare with message destination adr
	OPSTR	<CAME T4,>,UNSAD,+<UNB.OF+1>(RB)
	 SKIPA			;Not the right CB
	JRST	HRNFND		;Found the CB
	XMOVEI	T1,HN.QAC(HN)	;Try searching the active Q
	CALL	CMNIAD		;(T1,RB/CB)
	 SKIPA			;Not there either
	JRST	HRNFND		;Found the CB
	XMOVEI	T1,HN.QIC(HN)	;Try searching the inactive Q
	CALL	CMNIAD		;(T1,RB/CB)
	 JSP T2,ILLMES		;Non-existent CB. Treat as illegal message.
HRNFND:	OPSTRM	<AOS>,CCRCV,(CB)	;Increment per-server count
	RETSKP			;Found the CB
	SUBTTL	HMSTOP


;HMSTOP - Process a Host STOP Message
;
; RB/ Address of receive buffer
; CB/ Address of circuit block
; HN/ Address of host node data base
;	CALL HMSTOP
; Return+1: Always

HMSTOP:	CALL	MSBGN		;[7.1120](RB)Parse the beginning
	CALL	HRUNCB		;(RB/CB)Get the CB for this STOPS message
	 RET			;None, error action already done
	SKIPE	MSGSID		;Is the source ID in MSG non-zero?
	JSP	T2,ILLMES	;Yes, that's not legal
	LOAD	T1,CBLID,(CB)	;Get our remote ID for circuit. It must be
	LOAD	T2,CBSTA,(CB)	;Current circuit state
	CAIE	T2,CS.HLT	;[7481]Is it halted or
	CAME	T1,MSGDID	; an invalid STOP message?
	RET			;[7481]Yes, just ignore it.
	CALLRET	CBKILL		;[7481](CB)Release all CB resources and
				;[7481] put it on the inactive queue

; Routines to terminate a circuit because of some error.  T1 contains
; the error to be entered into the STOP message.

ILLMES:	OPSTRM	<AOS>,CCIMR,(CB)	;Increment per-server count
ILLMS0:	OPSTRM	<AOS>,HCIMR,(HN)	;Increment host count
	MOVEI	T1,CE.ILL	;Illegally formatted message received
	JRST	INFSTP		;Join common code to kill off circuit

LVSKEW:	MOVEI	T1,CE.SKW	;Version skew between server and host,
	JRST	INFSTP		; cannot support connection.

NOCRES:	OPSTRM	<AOS>,CCIMR,(CB)	;Increment per-server count
NOCRE0:	OPSTRM	<AOS>,HCIMR,(HN)	;Increment host count
	MOVEI	T1,CE.RES	;Insufficient resources to support new circuit.
	JRST	INFSTP

XMTLIM:	MOVEI	T1,CE.LIM	;Retransmit limit exceeded. Server probably
	JRST	INFSTP		; has gone away.

IDLHLT:	MOVEI	T1,CE.NSL	;Circuit halted because there are no more slots
	JRST	MTTSTP

LCLHLT:	MOVEI	T1,CE.HLT	;Circuit halted by local system. Either stopped
	JRST	MTTSTP		; by operator or last slot has disconnected.

IFN FTOPS20,<
NIHALT:	MOVEI	T1,CE.NIH	;NI halted
	SETZ	T2,0		;PC meaningless
	JRST	INFSTP
>;END IFN FTOPS20

INVRUN:	MOVEI	T1,CE.INV	;Invalid message
	JRST	INFSTP
INFSTP:	OPSTR	<DMOVE T3,>,CBDNI,(CB)	;[7369]GET ADDRESS IN T3 AND T4
	BUG. (INF,LATNSC,LATSER,SOFT,<LAT Host node stopped circuit>,<<T1,CODE>,<T2,PC>,<T3,HIADDR>,<T4,LOADDR>>,<

Cause:	LAT	Host node stopped the circuit.

Action:	Look at the Reason Code in T1 and the PC in T2.  This error, if
	relatively infrequent is nothing to be concerned about.  If it occurs
	frequently, use the CODE and PC to determine further action.
	HIADDR	and LOADDR specify the Ethernet address of the remote
	server whose circuit has been stopped.

Data:	CODE	- Reason code
	PC	- PC
	HIADDR	- High order 32 bits of Ethernet address
	LOADDR	- Low order 16 bits of Ethernet address
>)				;[7369]
	JRST	MTTSTP
	SUBTTL	HMSTAT -- Receive Status Message


;[7.1120]
;HMSTAT - Receive a Status Message
;
; RB/ Address of message block
;	CALL HMSTAT
; Return+1: Always

HMSTAT:	STKVAR	<NENTRY>	;
	LOAD	W1,UNBSZ,+UNB.OF(RB)	;Get the length of the message
	CAIGE	W1,^D12		;Is it at least this big?
	RET			;No, invalid message
	LOAD	W2,UNBFA,+UNB.OF(RB)	;Get the byte pointer for the message
	MOVEI	T4,3		;Point to the current protocol version
	ADJBP	T4,W2		;
	ILDB	T1,T4		;Get the current protocol version
	ILDB	T2,T4		;Get the current protocol ECO
	CAXL	T1,PROVER	;
	CAXGE	T2,PROECO	;Is it what we expect?
	RET			;No, invalid message
	ADDI	T4,1		;Point to the number of entries
	ILDB	T1,T4		;Get the number of entries
	JUMPE	T1,RTN		;No entries: nothing to be done
	MOVEM	T1,NENTRY	;
	ILDB	W2,T4		;Get the length of the subject name
	TRNE	W2,1		;Is it an even number?
	ADDI	W2,1		;No, it has a pad character
	ADJBP	W2,T4		;Build a byte pointer to the entry
HMSTA1:	ILDB	W1,W2		;Get the length of the entry
	CAIL	W1,^D14		;Is it at least this big?
	CALL	RDSTA		;(W1,W2)Yes, handle this status entry
	SOSGE	NENTRY		;Is there another entry?
	RET			;No, finished
	ADJBP	W1,W2		;Point to the next entry
	MOVEM	W1,W2		;
	JRST	HMSTA1		;Parse the next entry
;[7.1120]
;RDSTA - Handle an entry for a Status message
;
; W1/ Length of this entry
; W2/ Byte pointer to this entry
; RB/ Address of message block
;	CALL RDSTA
; Return+1: Always

RDSTA:	SAVEAC	<W2>		;Don't trash W2...
	ILDB	T3,W2		;Get the entry status
	ILDB	T4,W2		;Get the entry error
	IBP	W2		;
	ILDB	SB,W2		;Get the LO byte of the request id
	ILDB	T1,W2		;Get the HO byte of the request id
	LSH	T1,^D8		;Assemble the request id
	ADD	SB,T1		;
	MOVEM	SB,T1		;Save a copy for later
	ANDI	SB,PR.NDX	;Throw away the random portion
	SKIPE	SB		;
	CAILE	SB,PRMAXI	;Is it a valid request id?
	RET			;No, invalid message
	ADD	SB,PRVECT	;Calculate address of PRVECT entry
	SKIPN	SB,(SB)		;Is this pending request block in use?
	RET			;No, invalid request id
	OPSTR	<CAME T1,>,PRCID,(SB)	;Does it match this connect id?
	RET			;No, invalid request id
	ILDB	T1,W2		;Get the LO byte of the entry id
	ILDB	T2,W2		;Get the HO byte of the entry id
	LSH	T2,^D8		;Assemble the entry id
	ADD	T1,T2		;
	SKIPE	T1		;Is there an entry id?
	STOR	T1,PREID,(SB)	;Yes, save it
	TXNE	T3,1_7		;Is the request rejected?
	JRST	RDSTA1		;Yes, special handling

				; ..
				; ..

; Come here when the request is accepted: save the queue depth.
;
	LOAD	T1,PRSTA,(SB)	;Get the current (internal) state
	CAXE	T1,SS.SAC	;Solicit Access state
	CAXN	T1,SS.QUE	; or Queued state?
	TRNA			;Yes, save the queue depth
	RET			;No, ignore this message
	IBP	W2		;Skip past the queue timer
	IBP	W2		;
	ILDB	T1,W2		;Get the LO byte of the queue position
	ILDB	T2,W2		;Get the HO byte of the queue position
	LSH	T2,^D8		;Assemble the queue position
	ADD	T1,T2		;
	STOR	T1,PRQDP,(SB)	;Save the queue depth
	MOVX	T1,SS.QUE	;
	LOAD	T2,PRSTA,(SB)	;Get the current (internal) state
	CAXE	T2,SS.SAC	;Is this the Soliciting Access state?
	RET			;No, return (do not change state)
	STOR	T1,PRSTA,(SB)	;Yes, change to Queued state
	MOVX	T1,.LAQUE	;[7.1155]Set the external status to queued
	STOR	T1,PRSTS,(SB)	;
	HRLOI	T1,377777	;Set the retransmit timer so large
	STOR	T1,PRCMT,(SB)	; that LATXPR will never see it
	SETZRO	PRCMC,(SB)	;
	RET			;

				; ..
				;..

; Come here for a rejection code.
;
RDSTA1:	MOVX	T1,SS.REJ	;
	LOAD	T2,PRSTA,(SB)	;Get the current (internal) state
	CALLRET	@REJDSP(T2)	;Change state to Reject or delete entry

RDSTA2:	STOR	T1,PRSTA,(SB)	;Change to Reject state
	STOR	T4,PRSTS,(SB)	;Return the rejection code
	MOVE	T1,SB		;
	CALLRET	PRWAKE		;(T1)Wake the job

RDSTA3:	MOVE	T1,SB		;
	CALLRET	PRDEL		;(T1)Delete this PRVECT entry

; Table of states for the PRVECT entries
;
REJDSP:	XADDR. RTN		;(0) Halt
	XADDR. RTN		;(1) Run
	XADDR. RTN		;(2) Solicit Information
	XADDR. RTN		;(3) Solicit Access (initialize first)
	XADDR. RDSTA2		;(4) Solicit Access
	XADDR. RDSTA2		;(5) Queued
	XADDR. RTN		;(6) Rejected
	XADDR. RTN		;(7) Timed Out
	XADDR. RDSTA3		;(8) Cancel (initialize first)
	XADDR. RDSTA3		;(9) Cancel
REJMAX==.-REJDSP-1
IF1,<IFL <REJMAX-SS.MAX>,<PRINTX ?Entries missing in REJDSP>>
	SUBTTL	HMINFO -- Receive Response Information Message


;[7.1120]
;HMINFO - Receive a Response Information Message
;
; RB/ Address of message block
;	CALL HMINFO
; Return+1: Always

HMINFO:	LOAD	W1,UNBSZ,+UNB.OF(RB)	;Get the length of the message
	CAIGE	W1,^D20		;Is it at least this long?
	RET			;No, invalid message
	LOAD	W2,UNBFA,+UNB.OF(RB)	;Get the byte pointer for the message
	MOVEI	T4,3		;Point to the current protcol version
	ADJBP	T4,W2		;
	ILDB	T1,T4		;Get the current protcol version
	ILDB	T2,T4		;Get the current protocol ECO
	CAXL	T1,PROVER	;
	CAXGE	T2,PROECO	;Is it what we expect?
	RET			;No, invalid message
	IBP	T4		;Skip data link frame size
	IBP	T4		;...
	ILDB	SB,T4		;Get the LO byte of the solicit id
	ILDB	T1,T4		;Get the HO byte of the solicit id
	LSH	T1,^D8		;Assemble the solicit id
	ADD	SB,T1		;
	MOVE	T1,SB		;Save a copy of it.
	ANDI	SB,PR.NDX	;Throw away the random portion
	SKIPE	SB		;
	CAILE	SB,PRMAXI	;Is it a valid solicit id?
	RET			;No, invalid message
	ADD	SB,PRVECT	;Calculate address of PRVECT entry
	SKIPN	SB,(SB)		;Is this pending request block in use?
	RET			;No, invalid solicit id
	OPSTR	<CAME T1,>,PRCID,(SB)	;Is it this one?
	RET			;No, invalid solicit id
	ILDB	T2,T4		;Get LO byte of the Response Status
	ILDB	T1,T4		;Get HI byte of the Response Status
	LSH	T1,^D8		;Assemble the response status
	ADD	T1,T2		;
	TXNE	T1,RI%NSS	;Does the node offer the requested service?
	JRST	HMIRJ1		;No.  Go reject this request
	ILDB	T2,T4		;Get LO byte of Source Node Status
	ILDB	T1,T4		;Get HI byte of Source Node Status
	LSH	T1,^D8		;Assemble the source node status
	ADD	T1,T2		;
	TXNN	T1,RI%NDS	;Is the node disabled?
	TXNN	T1,RI%CMD	;No, Can we send a command message?
	JRST	HMIRJ2		;No.  Go reject this request
				;
				;

; The message has been verified.  Save the Ethernet address and set up
; to transmit the Solicit Access message.
;
	MOVEI	T1,6		;Get the length of the Ethernet address
	MOVE	T2,T4		;Get the source byte pointer
	XMOVEI	T4,PR.DNI(SB)	;Get address of destination
	TXO	T4,<OWGP. 8,0>	;Make it a global byte pointer
	CALL	MVSTR		;(T1-T4/T3,T4)Move the Ethernet address
	MOVX	T1,SS.SAI	;
	LOAD	T2,PRSTA,(SB)	;Get the current (internal) state
	CAXE	T2,SS.SIN	;Is this the Solicit Information state?
	RET			;No, return
	STOR	T1,PRSTA,(SB)	;Yes, change to Solicit Access (init first)
	SETZRO	PRCMT,(SB)	;Clear the command message timer
	SETZRO	PRCMC,(SB)	; and the retry count
	RET			;
HMIRJ1:	MOVX	T1,.LANSS	;Frump up a "No such service" response
	TRNA			;skip
HMIRJ2:	MOVX	T1,.LASCS	;Frump up a "Start slot can not be sent"
	STOR	T1,PRSTS,(SB)	;Store this in the status field
	MOVX	T1,SS.REJ	;Reject the request
	STOR	T1,PRSTA,(SB)	;Change state
	HRLOI	T2,377777	;[7.1120]Set the timer to infinity 
	STOR	T2,PRCMT,(SB)	;[7.xxxx][7.1120] so that LATXPR won't see it
	SETZRO	PRCMC,(SB)	;[7.xxxx][7.1120]Clear the command message count
	MOVE	T1,SB		;[7.xxxx]
	CALLRET	PRWAKE		;[7.1120](T1)Wake the job
	SUBTTL	Message Transmit Routines

;MTTSTR - transmit a START message

;Call:	CALL MTTSTR
;	Normal Return
;
; This routine builds the START message header in the template from the host
; node data base and transmits it. It sets the interlock so that the template
; cannot be changed at process level by the LATOP% JSYS.  The message count
; is not changed since it is already correct (hence LAP2B0 is called instead of
; LAP2BY).  Cannot fail after this point since sending a STOP will clobber
; the START msg template.

MTTSTR:	SETONE	HNCIP,(HN)	;Set interlock on the msg template
	XMOVEI	XB,HN.SMT(HN)	;Address of start message template
	MOVX	T1,<POINT 8,<SBF.OF>(XB)>;Set pointer to the message header
	STOR	T1,UNBFA,+UNB.OF(XB); for BMSGHD.
	MOVEI	T1,<MT.STA_2>	;Build a START
	CALL	BMSGHD		;(T1,XB,CB) message header
	XMOVEI	T1,<SBF.OF>(XB)	;Build the one word global
	TLO	T1,(<OWGP. 8,0>)	;[7.1039] byte pointer.
	STOR	T1,UNBFA,+UNB.OF(XB);
	OPSTR	<DMOVE T1,>,CBDNI,(CB);
	OPSTRM	<DMOVEM T1,>,UNDAD,+UNB.OF(XB);
	LOAD	T1,HNPID,(HN)	;Get the Portal ID for NISRV
	STOR	T1,UNPID,+UNB.OF(XB)
	MOVX	T1,NU.XMT	;Go transmit but don't
	XMOVEI	T2,UNB.OF(XB)	; use the usual routine
IFN FTOPS20,<
	CALL	DLLUNI##
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)
>
	IFSKP.
	  OPSTRM <AOS>,HCXMT,(HN);Increment host count
	  OPSTRM <AOS>,CCXMT,(CB);Increment per-server count
	ELSE.
	  SETZRO HNCIP,(HN)	;Release the lock
	ENDIF.
	RET


;[7481]
;CBKILL - Kill a circuit by releasing all slots and buffers
;
;Call:	CB/ address of the circuit block
;	CALL CBKILL
;	Normal return

CBKILL:	CALL	RELSBS		;(CB/)Release all slots for this CB
	CALL	RFXBFS		;(CB/)Release all buffers on
	CALL	MDLXBF		;(CB/)free queue and mark all those in DLL
;	CALLRET CBDACT		; and move CB to the inactive queue


;CBDACT - Deactivate CB by moving to inactive queue
;
;Call:	CB/ address of the circuit block
;	CALL CBDACT
;	Normal return

CBDACT:	JUMPE	CB,RTN		;If there is no CB, don't do the following
	SETZRO	CBRID,(CB)	;Clear remote circuit index
	MOVEI	T1,CS.HLT	;If the current circuit state is not halted
	OPSTR	<CAMN T1,>,CBSTA,(CB); move CB from active to inactive queue
	RET			; otherwise CB is already on inactive queue
	STOR	T1,CBSTA,(CB)	;Set the state to halted now
	XMOVEI	T1,HN.QAC(HN)	;Remove
	MOVE	T2,CB		; the circuit block
	CALL	LAUNQ		;(T1,T2) from the active queue
	XMOVEI	T1,HN.QIC(HN)	; and queue to
	MOVE	T2,CB		;Need the CB address again.
	CALL	LAQUE		;(T1,T2) the inactive queue
	OPSTRM	<SOS>,HNNAC,(HN)	;Reduce the number of active circuits
	RET
;MDLXBF - Remove all buffers from ACK Wait queue, and mark them
;		for deletion at transmit complete.

;Call:	CB/ circuit block address
;	CALL MDLXBF
;	Normal return

MDLXBF:	SETZRO	CBDLL,(CB)	;No buffers in DLL now
MDLXB1:	XMOVEI	T1,CB.AKQ(CB)	;Address of the ACK wait queue
	CALL	UNQ1WF		;(T1/T2)Unqueue next buffer on Q
	 RET			;Done
	MOVEI	T1,0		;Mark buffer for freeing at xmit done
	EXCH	T1,UN.UID+UNB.OF(T2)	;and get current "DLL" flag
	JUMPL	T1,MDLXB1	;If in DLL, it will be freed at XMTDON
	MOVE	XB,T2		; else we have to free it now.
	CALL	RELXBH		;(XB)
	JRST	MDLXB1
;MTTSTP - transmit a STOP message

;Call:	T1/ stop reason code
;	XB/ address of transmit buffer
;	RB/ address of recieve buffer
;	CB/ address of circuit block (may be 0)
;	CALL MTTSTP
;	Normal return

MTTSTP:	MOVEM	T1,STPCOD	;Save the stop reason.
	JUMPE	CB,MTTSP0	;If there is not CB, just send stop msg.
	STOR	T1,CBERR,(CB)	;Store reason for the stop in the CB
	LOAD	T1,CBRID,(CB)	;Get the id to which to send the STOP
	SKIPE	T1		;[7.1039]If it is zero, assume MSGSID already
	MOVEM	T1,MSGSID	;[7.1155][7.1039] has the correct ID.  This may
				;[7.1039] prevent sending an illegal STOP with
				;[7.1039] zero in the destination ID field.
	CALL	CBKILL		;[7481](CB/)Release all CB resources and
				;[7481] put it on the inactive queue
;
;	Here to actually send a stop message
;	Always get a temp xmit buffer.
;	Then send the message with a 0 in UNUID so that
;	XMTDON will always just release the buffer.
;
MTTSP0:	MOVX	T1,HNRUN	;If the NI
	TDNE	T1,HN.FLG(HN)	; is no longer running
	 RET			;We're done.
	MOVEI	T1,SZMSTP	;There will be no buffers so get one
	CALL	MMGTZW		;(T1/T1)
	 RET			;Couldn't. Assume we did.
	MOVE	XB,T1		;Transmit buffer for STOP message
	MOVX	T1,<POINT 8,<XBF.OF>(XB)>;Byte pointer to start of msg
	STOR	T1,UNBFA,+UNB.OF(XB);Store byte ptr to use building STOP msg
	MOVEI	T1,MT.STP_2	;Message type (STOP) and number of slots (=0)
	CALL	LAP2B0		;(XB,T1) to message
	MOVE	T1,MSGSID	;Get the source ID from the received message
	CALL	LAP2B0		;(XB,T1) and enter as dest. ID to msg to send.
	MOVEI	T1,0		;Get a 0 source ID
	CALL	LAP2B0		;(XB,T1) and enter into msg to send
	CALL	LAP2B0		;(XB,T1)Ack and sequence number must be zero.
	MOVE	T1,STPCOD	;Enter Disconnect reason and Reason text byte
	CALL	LAP2B0		;(XB,T1) (=0 since text field not used) to msg.
	XMOVEI	T1,<XBF.OF>(XB)	;Set up 1 word global byte pointer
	TLO	T1,(<OWGP. 8,0>)	; to the transmit data for NISRV
	STOR	T1,UNBFA,+UNB.OF(XB); and store in UN block
	MOVEI	T1,MINXBF	;Initialize to zero
	STOR	T1,UNBSZ,+UNB.OF(XB); the message count
	CALLRET	XMTMSN		;(CB,XB,RB)Go give the message to the DLL.
				; It will be freed at XMTDON
;MTTRUN - transmit a RUN message

;Call:	XB/ address of the transmit buffer
;	CALL MTTRUN
;	Normal return

MTTRUN:	JUMPE	XB,RTN		;No message to transmit
	XMOVEI	T1,CB.XBQ(CB)	;Unqueue the transmit buffer
	CALL	UNQ1WF		;(T1/T2) from the free Q
	 NOP			;Would not be here if queue empty.
	OPSTR	<SKIPE>,CBXBQ,(CB);Is this our last transmit buffer?
	IFSKP.
	  SETONE CBRRF,(CB)	;Yes, set the reply requested flag
	  LOAD T1,HNTIM,(HN)	;[7.xxxx][7.1120]Value for circuit timer (jiffies)
	  ADD T1,TODCLK		;Plus current time
	  STOR T1,CBTIM,(CB)	;Store in circuit timer
	ENDIF.
	XMOVEI	T1,CB.AKQ(CB)	; and queue to the end
	CALL	QUE1WB		;(T1,T2) of the ACK queue
	LOAD	T1,CBTSQ,(CB)	;Get the transmit sequence number
	AOJ	T1,		; and increment it by one before
	STOR	T1,CBTSQ,(CB)	; using it in the next transmitted msg.
	MOVX	T1,<POINT 8,<XBF.OF>(XB)>;Set message pointer to point to
	STOR	T1,UNBFA,+UNB.OF(XB); the RUN message header.
	MOVEI	T1,MT.RUN_2	;Message type for the header.
	CALL	BMSGHD		;(T1,XB,CB)Build the message header
	MOVEI	T1,SZ.MHD	;Store the message header length
	OPSTR	<SKIPN>,MDNXT,+MDB.OF(XB); which if there is no slot data
	MOVEI	T1,MINXBF	; must be the minimum NI datagram size.
	STOR	T1,MDBYT,+MDB.OF(XB); in the appropriate place
	SETZRO	UNBSZ,+UNB.OF(XB);MBZ for MSD type transmits
	XMOVEI	T1,<MDB.OF>(XB)	;Address of the first MSD block
	STOR	T1,UNBFA,+UNB.OF(XB);stored where usually byte pointer goes.
	CALL	XMTMSG		;(CB,XB,RB)No, go transmit a single buffer XB
	RET
;TMRCHK - Host circuit timer check routine.  This routine performs actions
; base on the state of the circuit timer.
;Call:	CB/ circuit block address
;Return:
;	RET - no further action required for this circuit
;	RESKSP - continue processing

TMRCHK:	OPSTR	<SKIPN T1,>,CBTIM,(CB);Is the circuit timer running?
	RETSKP			;No, continue processing circuit
	SUB	T1,TODCLK	;Account for current time
	SKIPL	T1		;Any time still left?
	IFSKP.			;Circuit timer has expired.
	  LOAD T1,HNRLI,(HN)	;Get the retransmit limit.
	  OPSTR <CAMG T1,>,CBRTC,(CB);Have we reached the limit?
	  IFSKP.		;No, so
	    CALL XUNAKQ		;(CB,HN) retransmit the unack queue
	    LOAD T1,HNTIM,(HN)	;[7.xxxx][7.1120] and reset the timer from now.
	    ADD T1,TODCLK	;
	    STOR T1,CBTIM,(CB)	;Restore reset timer to CB
	  ELSE.
	    JSP T2,XMTLIM	; otherwise, terminate the circuit
	  ENDIF.		; cause communication broken with remote.
	  RET
	ENDIF.
	RETSKP
;XUNAKQ - Transmit all messages on the unacknowledged queue

XUNAKQ:	OPSTR	<SKIPN>,CBDLL,(CB);Don't retransmit if already transmitting
	OPSTR	<SKIPN XB,>,QLFWD,+CB.AKQ(CB)	;First msg to retransmit
	RET			;Should be
	OPSTRM	<AOS>,HCRTR,(HN)	;Increment host count
	OPSTRM	<AOS>,CCRTR,(CB)	; and per-server count
	OPSTRM	<AOS>,CBRTC,(CB)	;Increment retransmit count
XMTALL:	OPSTRM	<AOS>,CBDLL,(CB)	;Increment buffers in DLL
	LOAD	T1,HNPID,(HN)		;Reset the portal ID
	STOR	T1,UNPID,+UNB.OF(XB)
	MOVX	T1,NU.XMT		;Transmit function
	XMOVEI	T2,UNB.OF(XB)		;UN block
IFN FTOPS20,<
	CALL	DLLUNI##
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)
>
	IFNSK.
	  OPSTRM <SOS>,CBDLL,(CB)
	ENDIF.
	SKIPE	XB,UE.LW0(XB)	;Next XB on queue to (re)transmit
	JRST	XMTALL		;Still more, continue to give buffers to DLL
	RET
; BMSGHD - Build a LAT Virtual Circuit Message Header

;Call:	T1/ <Message type>_2
;	XB/ Message buffer address
;	CB/ Address of the Circuit Block

BMSGHD:	MOVE	T2,NSLOTS	;Number of slots in message
	LSH	T2,^D8		;Shift to left byte position
	IOR	T1,T2		;Or in message type (shifted)
	OPSTR	<SKIPE>,CBRRF,(CB);If the Reply Request Flag is set
	IORI	T1,1		; set it in message header
	CALL	LAP2B0		;(XB,T1)Enter as 1st 2 bytes of header
	LOAD	T1,CBRID,(CB)	;Get the remote's circuit index
	CALL	LAP2B0		;(XB,T1) and enter as 2 byte field
	LOAD	T1,CBLID,(CB)	;Get our circuit index
	CALL	LAP2B0		;(XB,T1) and enter as 2 byte field
	LOAD	T1,CBRSQ,(CB)	;ACK number
	LSH	T1,^D8		;Shift to left byte position
	LOAD	T2,CBTSQ,(CB)	;Send Seq Number
	ANDI	T2,377		;Modulo 256
	IOR	T1,T2
	CALL	LAP2B0		;(XB,T1)
	RET
	SUBTTL	Message Transmitter -- XMTMSG

;XMTMSG - Transmit a LAT Message

;Call:	CB/ 0 or Circuit Block Address
;	XB/ Address of the UN block/Transmit Buffer
;	RB/ Address of Receive Buffer if XB/0
;	UNBSZ/ Message byte count
;	CALL XMTMSG
;	Normal Return
;
; This routine sets up the UN block for NISRV and issues the transmit
; function.  Only UNBSZ must be set by the caller.  If there is no CB,
; the information is taken from the receive buffer, otherwise from the
; circuit block.
;
; If there is no possibility of an ACK (such as sending a STOP message),
; then call XMTMSN, which will set UNUID to 0 so that the buffer will
; just be returned to free memory after NISRV has sent it.
;

XMTMSN:	TDZA	T1,T1		;Enter here if you just want to free the buffer
				;  when transmit is done.
XMTMSG:	MOVE	T1,CB
	TXO	T1,DLL.FL	;Set "buffer-in-DLL" flag
	STOR	T1,UNUID,+UNB.OF(XB)	;Save the CB address for completion action
	JUMPE	CB,XMNOCB	;Case with no assigned circuit block
	LOAD	T1,HNPID,(HN)	;Portal ID
	OPSTR	<DMOVE T2,>,CBDNI,(CB)	;Get destination NI adr from CB
	OPSTRM	<AOS>,CBDLL,(CB)	;Increment # buffers in the DLL
	JRST	XMTMS0		;Go do common code
XMNOCB:	LOAD	T1,UNPID,+UNB.OF(RB);Get the portal ID
	OPSTR	<DMOVE T2,>,UNSAD,+UNB.OF(RB)	;Source NI address from recvd msg
XMTMS0:	STOR	T1,UNPID,+UNB.OF(XB);Store in xmit buffer
	OPSTRM	<DMOVEM T2,>,UNDAD,+UNB.OF(XB)	; to the xmit buffer
	STOR	XB,UNRID,+UNB.OF(XB);Remember the buffer address
	MOVEI	T1,UNA.EV
	STOR	T1,UNADS,+UNB.OF(XB);Tell NISRV we are using EXEC virtual memory
	MOVX	T1,NU.XMT	;NI transmit function code
	XMOVEI	T2,UNB.OF(XB)	;UN block address
IFN FTOPS20,<
	CALL	DLLUNI##
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)
>
	IFSKP.
	  OPSTRM <AOS>,HCXMT,(HN)
	  JUMPE CB,RTN
	  OPSTRM <AOS>,CCXMT,(CB)
	ELSE.
	  MOVX T1,DLL.FL	;Get "buffer-in-DLL" flag
	  ANDCAB T1,UN.UID+UNB.OF(XB) ;clear it in message
	  SKIPN T1
	  CALL RELXBH		;(XB)
	  JUMPN CB,RTN
 	  OPSTRM <SOS>,CBDLL,(CB);Failed so put back count where is was
	ENDIF.
	RET
	SUBTTL	Message Transmitter -- XMTDON

;XMTDON - Message Transmitter Transmit Done Scheduler Level Routine

;Call:	T1/ NU.XMT
;	T2/ UN block address
;	CALL XMTDON
;	Normal return
;
; If the UNRID is zero, there is no longer a CB for this buffer because the
; circuit went away and we don't care what happens at transmit complete.  Just
; release the buffer.  If the CB state is stopping, complete the stopping of
; the circuit which could not be done earlier because all xmit buffers were in
; the DLL.

XMTDON:	SAVEAC	<CB>
	MOVE	XB,T2		;Move transmit buffer adr to conventional AC.
	LOAD	CB,UNUID,+UNB.OF(T2)	;Get the CB address
	TXZ	CB,DLL.FL	;Clear the "buffer-in-DLL" flag
	STOR	CB,UNUID,+UNB.OF(T2)	; and store back this way
	TXNE	CB,SAV.FL	;[7.1120]Keep this buffer?
	RET			;[7.1120]Yes, return
	JUMPE	CB,RELXBH	;If there is no CB, release buffer and header and return
	OPSTRM	<SOS>,CBDLL,(CB)	;One less buffer in the DLL
	RET
	SUBTTL	Receive Message Handling Routines

;LAG2BY - obtains two bytes from the message which is assumed to be a 16-bit
; quantity.

;Call:	MA/ Message base address
;	CALL LAG2BY
;	Normal Return
;Changes T2
;	T1/ 16-bit quantity

LAG2BY:	MOVX	T1,-2		;Amount to decrement the count by
	OPSTRM	<ADDM T1,>,UNBSZ,+UNB.OF(RB);Update message count
	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Get low order byte
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get high order byte
	LSH	T2,^D8		;Shift high order byte left
	IOR	T1,T2		;Make a 16-bit quantity
	RET			;Return with result

;GTCSTR - Move Counted String from a Message

;Call:	T1/ Maximum count to move
;	T2/ Destination byte pointer for string
;	RB/ Message base address
;Changes T1,T2,T3,T4

IGCSTR:	SETZ	T1,		;[7.1039]Here to ignore a counter string
GTCSTR:	SAVEAC	<W1,W2>		;Get two work registers
	OPSTR	<SKIPN T3,>,UNBSZ,+UNB.OF(RB);Byte count left in message
	RET			;Return error. Message unexpectedly truncated
	OPSTR	<ILDB W1,>,UNBFA,+UNB.OF(RB);Count of the counted string
	SUBI	T3,1(W1)	;Calculate new residual message count
	JUMPL	T3,RTN		;Message truncated
	STOR	T3,UNBSZ,+UNB.OF(RB);Store back into message header
	SKIPE	W1		;A null string?
	IFSKP.
	  MOVEI T1,0		;Yes, return zero count
	  RETSKP		; successfully
	ENDIF.
	MOVE	T3,W1		;Copy of the actual string count
	CAMLE	T3,T1		;Get the minimum of (actual string count,
	MOVE	T3,T1		; maximum string count) for copy loop index
	MOVEM	T3,T1		; and store as actual count copied
	LOAD	T4,UNBFA,+UNB.OF(RB);Save initial value of byte pointer
	JUMPE	T1,GTCDON	;Skipping over this field
GTCSLP:	OPSTR	<ILDB W2,>,UNBFA,+UNB.OF(RB);Fetch a source byte
	IDPB	W2,T2		;Store as destination byte
	SOJN	T3,GTCSLP	;Loop till all bytes copied
GTCDON:	ADJBP	W1,T4		;Adjust byte pointer properly in case less than
	STOR	W1,UNBFA,+UNB.OF(RB); the full string was copied
	RETSKP			;Return success, T1/ count of string fetched
	SUBTTL	Transmit Message Handling Routines

;LAP2BY - Put 2 bytes to message

;Call:	XB/ Address of the transmit buffer
;	T1/ 16-bit quantity to ouput
;	CALL LAP2BY or CALL LAP2B0
;	Normal return
;T1 perserved, T2 used
;
; This routine enters a 16-bit quantity as two bytes from T1 into the transmit
; buffer with the least significant entered first.  It assumes that UNBFA is
; set up with the proper byte pointer to the message buffer. The alternate
; entry LAP2B0 differs from LAP2BY in that LAP2B0 does not increment the
; message byte count whereas LAP2BY does.

LAP2BY:	MOVEI	T2,2		;Amount to increment the message count by
	OPSTRM	<ADDM T2,>,UNBSZ,+UNB.OF(XB);Update the count in message header
LAP2B0:	MOVE	T2,T1		;In order to return T1 preserved.
	OPSTR	<IDPB T2,>,UNBFA,+UNB.OF(XB);Low order byte entered first
	LSH	T2,-^D8		;Shift hi byte into position
	OPSTR	<IDPB T2,>,UNBFA,+UNB.OF(XB);High order byte goes to b buffer
	RET

;PTCSTR - put counted string to message buffer

;Call:	XB/ Address of the transmit buffer
;	T1/ Count to enter into buffer
;	T2/ Source string byte pointer

PTCSTR:	MOVEI	T3,1(T1)	;Increment to include count byte
	OPSTRM	<ADDM T3,>,UNBSZ,+UNB.OF(XB);Increment count in buffer
PTCST0:	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB);Put the string count to buffer
	MOVE	T3,T1		;Save copy of count for decrementing
PTCSTL:	JUMPE	T3,RTN		;If count exhausted, done with copying
	ILDB	T4,T2		;Get the next source string byte
	OPSTR	<IDPB T4,>,UNBFA,+UNB.OF(XB);Put it to buffer
	SOJA	T3,PTCSTL	;Continue til string count zero

;PTUSTR - put uncounted string to message buffer

;Call:	XB/ Address of the transmit buffer
;	T1/ Count to enter into buffer
;	T2/ Source string byte pointer

PTUSTR:	OPSTRM	<ADDM T1,>,UNBSZ,+UNB.OF(XB);Increment count in buffer
	MOVE	T3,T1		;Save copy of count for decrementing
PTUSTL:	JUMPE	T3,RTN		;If count exhausted, done with copying
	ILDB	T4,T2		;Get the next source string byte
	OPSTR	<IDPB T4,>,UNBFA,+UNB.OF(XB);Put it to buffer
	SOJA	T3,PTUSTL	;Continue til string count zero
;RBPOST - Return Receive Buffer to DLL

;Call:	T1/ Message block address
;	CALL RBPOST
;	Normal Return
;

RBPOSS:	SAVEAC	<T1,T2,T3,T4>	;[7.1039]Preserve T1-T4
RBPOST:	MOVEI	T2,LMRFSI	;Size of the buffer
	STOR	T2,UNBSZ,+UNB.OF(T1);Store in UN block for NISRV
	XMOVEI	T2,<SBF.OF>(T1)	;Set up 1 word global byte pointer
	TLO	T2,(<OWGP. 8,0>)	;[7.1039] to the transmit data for NISRV
	STOR	T1,UNRID,+UNB.OF(T1);Store the buffer address for callback
	STOR	T2,UNBFA,+UNB.OF(T1); and store in UN block
	LOAD	T2,HNPID,(HN)	;Get the Portal ID for NISRV
	STOR	T2,UNPID,+UNB.OF(T1)
	MOVEI	T2,UNA.EV
	STOR	T2,UNADS,+UNB.OF(T1);Tell NISRV we are using EXEC virtual memory
	XMOVEI	T2,UNB.OF(T1)	;UN block address
	MOVX	T1,NU.RCV	;Post receive buffer function code
IFN FTOPS20,<
	CALL	DLLUNI##
>
IFN FTOPS10,<
	SNCALL	(DLLUNI##,MCSEC1)
>
	IFNSK.
IFN FTOPS20,<
	  BUG. (CHK,LAPRBF,LATSER,SOFT,<Specify Receive Buffer Failure>,<<T1,DLLERC>>,<

Cause:	LATSER	received an error from NISRV while attempting to post a
	receive buffer.

Data:	DLLERC	- Error code returned by NISRV

>)
>;END IFN FTOPS20
	  RET
	ENDIF.
	RETSKP
	SUBTTL	Slot Demultiplexor - LSDMUX

;LSDMUX - Process all slots in a received RUN message
;
;Call:	RB/ Address of RUN message
;	CALL LSDMUX
;	 Error return - illegal slot encountered
;	Normal return

	MIN. (MINSTY,<ST.DTA,ST.STA,ST.STP,ST.DTB,ST.ATT,ST.REJ>) ;Minimum slot type code
	MAX. (MAXSTY,<ST.DTA,ST.STA,ST.STP,ST.DTB,ST.ATT,ST.REJ>) ;Maximum slot type code

LSDMUX:	TRVAR	<SLTDID,SLTSID,SLTCNT,SLTTYP,SLTEPT>	;Assign some variables on stack
	SKIPN	T1,NSLOTS	;Any slots left to process?
	RETSKP			;No, return successfully
NXTSLT:	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get the destination id
	MOVEM	T2,SLTDID
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get the source id
	MOVEM	T2,SLTSID
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get the slot data count
	LOAD	T3,UNBSZ,+UNB.OF(RB);Get the current message count
	STOR	T2,UNBSZ,+UNB.OF(RB)	;[7.1120]Save the slot data count
	AOS	T1,T2		;Round up to the nearest even number
	TRZ	T1,1		; since they may be 1 pad byte in slot
	SUBI	T3,SLHDSZ(T1)	;Subtract the total slot size
	MOVEM	T3,SLTCNT	;[7.1120]Save the byte count left in message
	JUMPL	T3,ILLSLT	;Error if message has ended prematurely
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get the slot type/credits/reason
	MOVEM	T2,SLTTYP
	ADJBP	T1,UN.BFA+UNB.OF(RB);Point to next slot
	MOVEM	T1,SLTEPT	;in case we need to skip later
	LSH	T2,-4		;Shift off the credits field
	CAIL	T2,MINSTY	;Range check slot type
	CAILE	T2,MAXSTY
	CALLRET	ILLSLT		;Slot ID out of range, illegal slot
	CALL	@SLTDSP-MINSTY(T2)	;Dispatch to proper routine
	JRST	ILLSLT
	SOSG	NSLOTS		;Indicate one less slot to process
	RETSKP			;Count went to zero, so done.
	MOVE	T1,SLTCNT	;[7.1120]Restore the byte count
	STOR	T1,UNBSZ,+UNB.OF(RB)	;[7.1120] left in this message
	MOVE	T1,SLTEPT	;Get pointer to next slot's data
	MOVEM	T1,UN.BFA+UNB.OF(RB);and force pointer to there
	JRST	NXTSLT		;Still some left, go do next

SLTDSP:	XADDR. HSDATA		;[7.1052]Data A slot
	XADDR. RTN		;[7.1052]Undefined
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. RTN		;[7.1052]    "
	XADDR. HSSTRT		;[7.1052]Start Slot
	XADDR. HDRDAT		;[7.1052]Data B Slot
	XADDR. IGNSLT		;[7.1052]Attention Slot
	XADDR. RTN		;[7.1052]Reject Slot
	XADDR. HSSTOP		;[7.1052]Stop Slot

	SUBTTL	HSSTRT - Process a START SLOT Message


;HSSTRT - Process a START SLOT message.
;
; HN/ Address of host node data base
; CB/ Address of circuit block
; RB/ Address of receive buffer
;	CALL HSSTRT
; Return+1: Failure, invalid slot (cease parsing RUN message)
; Return+1: Success, SB/ Address of slot block (or zero)

HSSTRT:	SKIPE	SLTSID		;Source ID 0 is illegal
	SKIPE	SLTDID		;Destination ID of non-0 is illegal
	CALLRET	ILLSLT		;Report an illegal slot received
	MOVNI	T1,3		;[7.1120]Number of bytes to be read
	ADDB	T1,UN.BSZ+UNB.OF(RB)	;[7.1120]Update the byte count
	JUMPL	T1,ILLSLT	;[7.1120]Negative: illegal slot
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB);Get the service class requested
	CAIE	T2,SCITTY	;Only interactive terminal class permitted
	CALLRET	ILLSLT		;If not, slot is illegal.
	CALL	SBALOC		;(CB/SB)Allocate a slot block
	 RETSKP			;Ignore since server should persist and we
				; assume we should almost always get an SB
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB)
	STOR	T2,SBATS,(SB)	;Attention slot size maximum
	OPSTR	<ILDB T2,>,UNBFA,+UNB.OF(RB)
	STOR	T2,SBMDS,(SB)	;Data slot size maximum
	LOAD	T1,CBRSC,(CB)	;[7.1120]Get the server name count
	CAILE	T1,ML.SRN	;[7.1120]Is it too big for a slot block?
	MOVEI	T1,ML.SRN	;[7.1120]Yes, this is the maximum length
	STOR	T1,SBSRC,(SB)	;[7.1120]Save the server name count
	ADDI	T1,4		;[7.1120]Convert fro bytes to words
	IDIVI	T1,5		;[7.1120]
	XMOVEI	T2,CB.SNM(CB)	;[7.1120]Get address of source
	XMOVEI	T3,SB.SRN(SB)	;[7.1120]Get address of descriptor
	XBLT. T1		;[7.1120]Copy the string
	MOVEI	T1,ML.SVN	;[7.1120]Max length of service name
	MOVX	T2,<POINT 7,<SB.SVN>(SB)>	;[7.1120]Point to slot name string
	CALL	GTCSTR		;[7.1039](T1,T2,RB)Get a counted string
	 SETZ T1,		;[7.1039]Ran out of message
	STOR	T1,SBSVC,(SB)	;[7.1120]Store actual length of name
	CALL	IGCSTR		;[7.1039](T1,T2,RB)Ignore subject service name
	 JRST HSSTR2		;[7.1039]No more data in message
; Now we are into the variable parameter part of the START SLOT message.
; Loop and record whatever fields we think are important.
;
HSSTR1:	SOSL	T1,UN.BSZ+UNB.OF(RB)	;[7.1039]Count down bytes in slot
	ILDB	T1,UN.BFA+UNB.OF(RB)	;[7.1039]Get Parameter number
	JUMPLE	T1,HSSTR2	;[7.1039]Ran out of bytes, or hit end of parms
	CAILE	T1,SBPRMX	;[7.1039]Greater than max parm we know about?
	 SETZ T1,		;[7.1039]Yes, we will just ignore it.
	CALL	@SBPRTB(T1)	;[7.1039]Call routine to deal with parameter
	 JRST HSSTR2		;[7.1039]Ran out of message
	JRST	HSSTR1		;[7.1039]Get next parameter from slot


; Come here when the START SLOT has been parsed.  Check to see whether 
; or not the values are correct and the resources are available.
;
HSSTR2:	OPSTRM	<AOS>,HNCON,(HN)	;[7.1120]Increment the number of connects
	LOAD	T2,SBREA,(SB)	;[7.1120]Get a reject code (if any)
	JUMPN	T2,SLREJ0	;[7.1120]Got one: reject this connection
	OPSTR	<SKIPN T1,>,SBPRA,(SB)	;[7.1120]Host initiated connect?
	IFSKP.			;[7.1120]
	  SKIPG T1		;[7.1120]Is this a duplicate?
	  IFSKP.		;[7.1120]No:
	    LOAD T2,PRSTA,(T1)	;[7.1120]Get the (internal) state
	    CALLRET @HSSDSP(T2)	;[7.1120]Accept if in SAC or QUE state
	  ELSE.			;[7.1120]
	    OPSTRM <SOS>,HNCON,(HN) ;[7.1120]
	    CALL RELSB		;[7.1120](SB,CB)Release this slot block
	    RETSKP		;[7.1120] (it is a dulplicate)
	  ENDIF.		;[7.1120]
	ENDIF.			;[7.1120]
HSSTR3:	LOAD	T1,HNCON,(HN)	;[7.1120]Get the number of connects.
	OPSTR	<CAMLE T1,>,HNMCO,(HN);Check if maximum exceeded.
	JRST	SLRESF		;No additional sessions permitted.
IFN FTOPS10,<
	MOVE	T1,STATES##	;Get system states word
	TRNE	T1,ST.NRT	;Are remote TTYs allowed?
	JRST	SLSHUT		;Nope, reject the connection
> ;End IFN FTOPS10
	CALL	GETTDB		;(SB)Get a terminal data block and start a job
	 JRST SLRESF		;No terminal data blocks available
	OPSTR	<SKIPN T1,>,SBPRA,(SB)	;[7.1120]Host initiated connect?
	IFSKP.			;[7.1120]
	  MOVX T2,SS.RUN	;[7.1120]Change to the RUN state
	  STOR T2,PRSTA,(T1)	;[7.1120]
	  MOVX T2,377777	;[7.1120]Set the timer to infinity
	  STOR T2,PRCMT,(T1)	;[7.1120] so that LATXPR won't see it
	  SETZRO PRCMC,(T1)	;[7.1120]Clear the command message count
	  CALL PRWAKE		;[7.1120](T1)Wake the job
	ENDIF.			;[7.1120]
	MOVX	T1,SBSTR!SBFCC	;Flag this slot as waiting to send a START
	CALL	SSBDAV		;(T1/SB) and a DATA_B slot when MUX runs.
	RETSKP			;Return success


; Table of states for the PRVECT entries
;
HSSDSP:	XADDR. SLCSRF		;(0) Halt
	XADDR. SLCSRF		;(1) Run
	XADDR. SLCSRF		;(2) Solicit Information
	XADDR. SLCSRF		;(3) Solicit Access (initialize first)
	XADDR. HSSTR3		;(4) Solicit Access
	XADDR. HSSTR3		;(5) Queued
	XADDR. SLCSRF		;(6) Rejected
	XADDR. SLCSRF		;(7) Timed out
	XADDR. SLUSRF		;(8) Cancel (initialize first)
	XADDR. SLUSRF		;(9) Cancel
HSSMAX==.-HSSDSP-1
IF1,<IFL <HSSMAX-SS.MAX>,<PRINTX ?Entries missing in HSSDSP>>
; Come here to reject the START SLOT for various reasons.
;
SLUSRF:	SKIPA	T2,[SE.USR]	;[7.1120]User requested disconnect
SLSHUT:	MOVX	T2,SE.SHU	;[7.1120]System shutdown in progress
	JRST	SLREJ0		;[7.1120]
SLRESF:	SKIPA	T2,[SE.RES]	;[7.1120]Insufficient resources
SLCSRF:	MOVX	T2,SE.CSR	;[7.1120]Corrupted solicit request
SLREJ0:	STOR	T2,SBREA,(SB)	;[7.1120]Save the rejection code
	OPSTR	<SKIPG T1,>,SBPRA,(SB)	;[7.1120]Get address of PR block
	IFSKP.			;[7.1120]
	  STOR T2,PRSTS,(T1)	;[7.1120]Save the rejection code
	  MOVX T2,SS.REJ	;[7.1120]
	  STOR T2,PRSTA,(T1)	;[7.1120]Change state to Rejected
	  HRLOI T2,377777	;[7.1120]Set the timer to infinity 
	  STOR T2,PRCMT,(T1)	;[7.1120] so that LATXPR won't see it
	  SETZRO SBPRA,(SB)	;[7.1120]Clear the SB's pointer to the PR
	  SETZRO PRSBA,(T1)	;[7.1120]Clear the PR's pointer to the SB
	  SETZRO PRCMC,(T1)	;[7.1120]Clear the command message count
	  CALL PRWAKE		;[7.1120](T1)Wake the job
	ENDIF.			;[7.1120]
	MOVX	T1,SBREJ	;[7.1120]Make this slot waiting to send 
	CALL	SSBDAV		;[7.1120](T1,SB) a REJECT SLOT
	RETSKP			;[7.1120]
;[7.1039]
; Dispatch table of routines to deal with parameters from start slot
;
SBPRTB:	XADDR. IGCSTR		;[7.1039](0)Ignore ones we don't know about
	XADDR. GETFLG		;[7.1120](1)Flag word
	XADDR. LINKPR		;[7.1120](2)Queue entry
	XADDR. IGCSTR		;[7.1039](3)Reserved
	XADDR. IGCSTR		;[7.1120](4)Server name
	XADDR. GETPRN		;[7.1039](5)Port name
SBPRMX=.-SBPRTB-1


;[7.1120]
;GETFLG - Get pertinent START SLOT flags.
;
; SB/ Address of slot block
; RB/ Address of receive buffer
;	CALL GETFLG
; Return+2: Always

GETFLG:	SOS	UN.BSZ+UNB.OF(RB)	;Ignore the byte count
	IBP	UN.BFA+UNB.OF(RB)	;
	CALL	LAG2BY		;(RB/T1)Get 2 bytes (unsigned)
	TRNN	T1,1		;Is this a dial-up line?
	RETSKP			;No, return
	SETONE	SBDLP,(SB)	;Yes, set the bit in the SB
	RETSKP			;


;[7.1120]
;LINKPR - Link this start slot to a pending request block.
;
; SB/ Address of slot block
;	CALL LINKPR
; Return+2: Always, SBPRA/ Address of PR block (or minus one)
;	or SBREA/ Reject code SE.ENQ (entry not in queue)

LINKPR:	SOS	UN.BSZ+UNB.OF(RB)	;Ignore the byte count
	IBP	UN.BFA+UNB.OF(RB)	;
	CALL	LAG2BY		;(RB/T1)Get two bytes (unsigned)
	MOVEM	T1,T2		;Save the connect id
	ANDI	T1,PR.NDX	;Throw away the random portion
	ADD	T1,PRVECT	;Get address of PRVECT entry
	SKIPN	T1,(T1)		;Get address of pending request block
	JRST	LINKP1		;None: invalid connect id
	LOAD	T3,PRCID,(T1)	;Get the connect id
	CAME	T3,T2		;Is it what we expected?
	JRST	LINKP1		;No, invalid connect id
	LOAD	T2,PRSBA,(T1)	;Is there already a slot block?
	JUMPN	T2,LINKP2	;Yes: ignore this duplicate
	STOR	SB,PRSBA,(T1)	;Save address of slot block
	STOR	T1,SBPRA,(SB)	;Save address of pending request block
	RETSKP			;
LINKP1:	MOVX	T1,SE.ENQ	;Reject code: entry not in queue
	STOR	T1,SBREA,(SB)	;
	RETSKP			;
LINKP2:	SETONE	SBPRA,(SB)	;Invalid connect id: return with
	RETSKP			; minus one as the address


REPEAT 0,<
;[7.1120]Delete this routine
;GETSRN - Get server name.
;
; SB/ Address of slot block
;	CALL GETSRN
; Return+1: Error, couldn't get counted string
; Return+2: Success, T1/ character count

GETSRN:	MOVE	T2,[POINT 7,SB.SRN(SB)]	;Get server name
	MOVEI	T1,ML.SRN	;Set up max length of server name
	CALL	GTCSTR		;(T1,T2,RB)Go get the string
	IFSKP.
	  STOR T1,SBSRC,(SB)	;Save the server name count
	  RETSKP		;Skip return
	ENDIF.
	SETZ	T1,		;Error: return with character count zero
	RET			;
> ;End REPEAT 0


;[7.1120]
;GETPRN - Get object port name.

; SB/ Address of slot block
;	CALL GETPRN
; Return+1: Error, couldn't get counted string
; Return+2: Success, T1/ character count

GETPRN:	MOVE	T2,[POINT 7,SB.PRN(SB)]	;Get object port name
	MOVEI	T1,ML.PRN	;Set up max length of port name
	CALL	GTCSTR		;(T1,T2,RB)Go get the string
	IFSKP.
	  STOR T1,SBPRC,(SB)	;Save the port name count
	  RETSKP		;Skip return
	ENDIF.
	SETZ	T1,		;Error: return with character count zero
	RET			;
	SUBTTL	Slot Processing Routines - STOP Slots

;HSSTOP - Process a STOP Slot.
;
;Call:	SB/ Slot block address
;	CALL HSSTOP
;	 Error return - 
;	Normal return

HSSTOP:	SKIPN	T2,SLTDID	;Destination ID cannot be zero
	CALLRET	IGNSLT		; but if it is zero, just ignore it.
	SKIPN	SLTSID		;Source ID must be zero
	CAILE	T2,NTTLAH	;Is the SBVECT index in range?
	CALLRET	ILLSLT		;No. Slot is illegal
	MOVE	T1,SBVECT	;Get the slot block address from
	ADD	T1,T2		; the destination slot id
	SKIPE	SB,(T1)		;If the SB address is zero
	OPSTR	<CAME CB,>,SBCBA,(SB); or CB address has changed then
	JRST	IGNSLT		; ignore the slot since already gone.
	CALL	RELSB		;(CB,SB)Release all slot resources	
	RETSKP			;Return success
	SUBTTL	Slot Processing Routines - DATA_A,DATA_B Slots

;HSDATA - Process a DATA_A Slot
;
;Call:  SB/ Slot block address
;	CALL HSDATA
;	 Error return - illegal slot
;	Normal return

HSDATA:	CALL	HDRDAT		;Go process data slot header
	 RET			;Illegal slot, error return
	SKIPN	W1,UN.BSZ+UNB.OF(RB)	;[7.1120]Get the number of characters in the slot
	RETSKP			;None, return
IFN FTOPS20,<
	LOAD	T2,SBTDB,(SB)	;Terminal dynamic data base
	DYNST			;Get the line number
NXSLCH:	OPSTR	<ILDB T1,>,UNBFA,+UNB.OF(RB);Get a character.
	CALLX	(MSEC1,TTCHI)	;[7.1024]Call TTYSRV to enter into input buffer
	 TRN			;Ignore error
>;end IFN FTOPS20

IFN FTOPS10,<
	LOAD	U,SBTDB,(SB)	;Get line data block address
NXSLCH:	OPSTR	<ILDB T3,>,UNBFA,+UNB.OF(RB);Get a character.
	SNCALL	(RECPTY##,MCSEC1);Call SCNSER to enter into input buffer
>;end IFN FTOPS10

	SOJG	W1,NXSLCH	;If still more, continue
	RETSKP			;Otherwise return success
HSDATB:				;Process received DATA_B slot (NOP)

HDRDAT:	SKIPE	T2,SLTDID	;Destination ID cannot be zero
	CAILE	T2,NTTLAH	; or greater than maximum slot index
	CALLRET	ILLSLT		;Illegal slot
	MOVE	T3,SLTSID	;Source ID from the slot
	MOVE	T1,SBVECT	;Get the address of the SB
	ADD	T1,T2		; based on the remote slot id from 
	SKIPN	SB,(T1)		; the message 
	CALLRET	IGNSLT		;No slot block.
	OPSTR	<CAME T3,>,SBRID,(SB)	;Is slot source ID equal to SB remote ID?
	CALLRET	IGNSLT		;No, ignore the slot
	LOAD	T3,SBSTA,(SB)	;Get the slot state
	CAIN	T3,SS.RUN	;If the slot state is not running or
	OPSTR	<CAME CB,>,SBCBA,(SB)	; the circuit block address has changed
	CALLRET	IGNSLT		; then slot disappeared already so ignore.
	MOVE	T3,SLTTYP	;See if remote extended us any transmit
	ANDI	T3,17		; credits. If so, add them to what we already
	OPSTRM	<ADDM T3,>,SBXCR,(SB); have.
	SKIPN	UN.BSZ+UNB.OF(RB)	;[7.1120]Do remote credit check only if there was
	RETSKP			; data in the slot.
	OPSTR	<SOSGE T3,>,SBRCR,(SB)	;Decrement the receive credits
	JRST	ILLSLT		;Illegal, server sent data with no credits	
	STOR	T3,SBRCR,(SB)	;Store back updated credits count
	SKIPE	T3		;If receive credits have gone to zero,
	IFSKP.			; then indicate we need to grant more credits
	  MOVX T1,SBOUT		; by setting setting data available
	  CALL SSBDAV		; for MUX when it runs next time.
	ENDIF.
	RETSKP
	SUBTTL	Slot Block Allocation and Deallocation Routines


;SBALOC - Slot Block Allocation Routine
;
;Call:	CB/ circuit block address
;	CALL SBALOC
;	 Error Return
;	Normal Return
;	SB/ Address of allocated slot block
;
; This routine allocates and initializes a new slot block.

SBALOC:	MOVEI	T1,SB.LEN	;Number of words to allocate for a slot blk
	CALL	MMGTZW		;Try to get them
	 RET			;Can't
	MOVE	SB,T1		;Put address in proper AC
	MOVSI	T4,-SBBWDS	;Look for a free slot block index
SBANXT:	SKIPE	T1,SBBITS(T4)	; by examining the free slot block words
	JFFO	T1,SBAGO	; for the first 1 bit.  This represents
	AOBJN	T4,SBANXT	; the first free slot block index
	 RET			;No slot block available
SBAGO:	HRRZS	T4		;Clear out left half
	MOVE	T3,BITS(T2)	;Clear the bit since the index is
	ANDCAM	T3,SBBITS(T4)	; no longer free
	IMULI	T4,^D36		;Compute the slot block index
	ADDI	T2,1(T4)	;Cannot be zero
	STOR	T2,SBLID,(SB)	;Store in SB as local slot index
	MOVE	T1,SBVECT	;Now store the address of the slot block
	ADD	T1,T2		; in the vector of slot block address, which
	MOVEM	SB,(T1)		; is indexed by slot block index
	XMOVEI	T1,CB.SBQ(CB)	;Queue the SB to the circuit block's 
	MOVE	T2,SB		; queue of slot blocks.
	CALL	LAQUE		;
	MOVEI	T1,CS.STA	;Set the slot state
	STOR	T1,SBSTA,(SB)	; to starting.
	STOR	CB,SBCBA,(SB)	;Store the circuit block address in SB
	MOVE	T1,SLTSID	;Get the remote's slot id
	STOR	T1,SBRID,(SB)	;Store as our remote id
	MOVE	T1,SLTTYP	;Get the Slot type/credits from recv's slot
	ANDI	T1,17		;Keep only the number of credits extended to us
	STOR	T1,SBXCR,(SB)	;Store is slot block as our transmit credits
	MOVEI	T1,MAXCRE	;Maximum credits to extend to remote
	STOR	T1,SBRCR,(SB)	; to current number of remote credits
	RETSKP			;Return successfully
;SSBDAV - Set Slot BLock Data Available
;
;Call:	T1/ Bit to set in SB.FLG
;	SB/ Slot block address
;	CALL SSBDAV
;	Normal Return

SSBDAV:	SKIPGE	T2,SB.FLG(SB)	;Is there already data available?
	IFSKP.			;No, so set it now
	  OPSTRM <AOS>,CBSDC,(CB);Increment number of slots waiting
	  TLO T2,400000		; and indicate this slot now waiting	 
	ENDIF.
	IOR	T2,T1		;OR in new reason for waiting
	MOVEM	T2,SB.FLG(SB)	; and store back
	RET			;Return

;CSBDAV - Clear Slot BLock Data Available
;
;Call:	T1/ Bit to clear in SB.FLG
;	SB/ Slot block address
;	CALL SSBDAV
;	Normal Return

CSBDAV:	SKIPL	T2,SB.FLG(SB)	;Is "data available" already clear?
	RET			;Yes
	ANDCM	T2,T1		;Clear the desired bit
	TXNE	T2,SBSMSK	;Are all bits off now?
	IFSKP.
	  OPSTRM <SOS>,CBSDC,(CB)
	  MOVEI T2,0
	ENDIF.
	HLLM	T2,SB.FLG(SB)
	RET
;RELSBS - Release all Slot Blocks and their Resources for a virtual circuit
;
;Call:	CB/ Address of the circuit block
;	CALL RELSBS
;	Normal Return

RELSBS:	JUMPE	CB,RTN		;No slots to release if no circuit block
	OPSTR	<SKIPN SB,>,QLFWD,+CB.SBQ(CB);Get the address of first SB on Q
	RET			;If zero, there are no more on the queue
	CALL	RELSB		;Release the slot block
	JRST	RELSBS		;Go do the next
	RET

;RELSB - Release a Slot Block and its Resources
;
;Call:	CB/ Address of the circuit block for slot
;	SB/ Address of the slot block to release
;	CALL RELSB
;	Normal Return
;	SB/ address of previous slot or listhead

RELSB:
IFN FTOPS20,<
	OPSTR	<SKIPN T2,>,SBTDB,(SB)	;Is there a terminal data base
	JRST	RELSB0		;No, go just release the SB resources
	SETZM	TTDEV(T2)	;Clear the slot block address in the TDB.
	SETZRO	TTPRM,(T2)	;TDB no longer permanent
	SETZRO	TTOTP,(T2)	;Clear output in progress so sched tests work.
	OPSTR	<SKIPE T1,>,SBPRA,(SB)	;[7.1120]Was this "host initiated"?
	IFSKP.			;[7.1120]-No
	  DYNST			;Get the static line number
	  CALLX (MSEC1,NTYCOF)	;[7.1024]Go detach the job
	  LOAD T2,SBTDB,(SB)	;Get the TDB address again.
	  LOAD T1,TCJOB,(T2)	;If there is a controlling job, don't release
	  CAIE T1,-1		; the TDB since this will be done
	  JRST RELSB0		; later by JOBCOF.
	ELSE.
	  LOAD T3,PRSTS,(T1)	;[7.1120]Get the status
	  TRZN T3,.TTDES	;[7.1120]Do we have a tty-designator?
	  JRST RELTT		;[7.1120]No. (That's odd...)
	  ADDI T3,DVXTT0	;[7.1120]Get the device index
	  MOVX T1,DV%ASN	;[7.1120]Indicate device is
	  ANDCAM T1,DEVCHR(T3)	;[7.1120] no longer assigned.
	  MOVEI T1,-1		;[7.1120]Mark the device as free.
	  HRLM T1,DEVUNT(T3)	;[7.1120]
	ENDIF.			;[7.1120]
RELTT:	DYNST			;No controlling job so we must release the
	CALLX	(MSEC1,TTYDE0)	;[7.1024] the dynamic data base here.
	 TRN			;TTYSRV already reports this.
>;end IFN FTOPS20
IFN FTOPS10,<
	OPSTR	<SKIPN U,>,SBTDB,(SB)	;Is there a terminal data base
	JRST	RELSB0		;No, go just release the SB resources
	PUSH	P,J		;NGVLDB blows J (our W2)
	CALL	NGVLDB		;Give the LDB back to SCNSER
	POP	P,J		;Get our AC back
>;end IFN FTOPS10
RELSB0:	OPSTR	<SKIPN T1,>,SBPRA,(SB)	;[7.1120]Is there a pending request block?
	IFSKP.			;[7.1120]
	  SETZRO PRSBA,(T1)	;[7.1120]Yes, clear its slot block address
	  CALL PRDEL		;[7.1120](T1)Delete the pending request block
	ENDIF.			;[7.1120]
	OPSTR	<XMOVEI T1,>,CBSBQ,(CB)	;Point to the CB SBQ header
	MOVE	T2,SB		; and
	CALL	LAUNQ		; release the SB from this queue
	SKIPL	SB.FLG(SB)	;Did this SB have any data waiting?
	IFSKP.			;Yes
	  OPSTRM <SOS>,CBSDC,(CB) ;Reduce number of slots with data waiting
	ENDIF.
	OPSTRM	<SOS>,HNCON,(HN)	;Reduce number of active connects.
	CALL	RLSBID		;Release the SB local id.
	MOVE	T1,SB
	OPSTR	<SKIPN SB,>,QLBWD,(SB);Set up so the slot mux gets the correct
	XMOVEI	SB,CB.SBQ(CB)	; next slot.
	CALL	MMFREE		;Free the memory
	RET
;RLSBID - Release a Slot Block's local id.
;
;Call:	SB/ Address of the SB
;	CALL RLSBID
;	Normal Return

RLSBID:	OPSTR	<SKIPN T1,>,SBLID,(SB);Get the SB local index
	RET			;Already zero. Nothing to do.
	MOVE	T2,SBVECT	;Clear the pointer to SB
	ADD	T2,T1		; in the vector of SB addresses
	SETZM	(T2)		; ...
	SOS	T1		;Normalize to zero
	IDIVI	T1,^D36		;Now clear the bit to indicate that the
	MOVE	T3,BITS(T2)	; slot block index is now free
	IORM	T3,SBBITS(T1)	; ...
	SETZ	T1,		;Clear the local
	STOR	T1,SBLID,(SB)	; SB ID.
	RET
;GETTDB - get terminal dynamic data base
;
;Call:	SB/ slot block address
;	CALL GETTDB
;	 Error return
;	Normal return

IFN FTOPS20,<
GETTDB:	SAVEAC	<W1,W2>
	MOVE	W1,TT1LIN+TT.LAH
GTTDB0:	LOAD	T1,TTSTY,(W1)	;Get the line type
	CAIE	T1,TT.LAH
	 RET
	MOVE	T2,W1
	CALLX	(MSEC1,STADYN)	;[7.1024]
	 JUMPE T2,GTTDB2
GTTDB1:	AOJA	W1,GTTDB0	;Try next line
GTTDB2:	MOVE	T2,W1
	CALLX	(MSEC1,TTYASC)	;[7.1024]
	 JRST GTTDB1
	CALLX	(MSEC1,STADYN)	;[7.1024]
	 JRST GTTDB1
	STOR	T2,SBTDB,(SB)
	MOVEM	SB,TTDEV(T2)
	SETONE	TCJOB,(T2)	
	SETONE	TTPRM,(T2)	
	OPSTR	<SKIPE W2,>,SBPRA,(SB)	;[7.1120]
	IFSKP.			;[7.1120]
	  MOVEI T1,.CHCNC
	  MOVE T2,W1
	  CALLX (MSEC1,TTCHI)	;[7.1024]
	   NOP
	ELSE.			;[7.1120]
	  MOVEI T1,.TTDES(W1)	;[7.1120]Make a TTY Designator
	  STOR T1,PRSTS,(W2)	;[7.1120]Stash it away
	  ADDI W1,DVXTT0	;[7.1120]DVXTT0 + TTY Number = device index
	  LOAD T1,PRJOB,(W2)	;[7.1120]Get the real controlling job number
	  STOR T1,TCJOB,(T2)	;[7.1120]Set it in the TDB...
	  HRLM T1,DEVUNT(W1)	;[7.1120]...And here too
	  MOVX T1,DV%ASN	;[7.1120]Mark it as assigned
	  IORM T1,DEVCHR(W1)	;[7.1120]
	  MOVE T1,W2		;[7.1120]PR address in T1
	  CALL PRWAKE		;[7.1120]Tell the user
	ENDIF.			;[7.1120]
	RETSKP
>;END IFN FTOPS20
; Get a remote LDB and make it mine
;
; Return:
;	RET			;FAILED
;	RETSKP			;SUCCESS

IFN FTOPS10,<
GETTDB:	SAVEAC	<W>		;SCNSER/NETSER WILL USE THIS

;Allocate an LDB
;
	MOVSI	T1,LTLLAT##	;FLAG A NEW LAT TERMINAL
	MOVEI	T3,LATDSP	;LAT'S ISR DISPATCH TABLE
	SNCALL	(GETLDB##,MCSEC1) ;(T1,T3/U)GET A REMOTE TTY LDB
	 RET			;GO ANNOUNCE THE FAILURE

;Finish making this a LAT LDB
;
	MOVEI	T1,LATRTQ	;GET POINTER TO OUTPUT Q HEADER
	HRLZM	T1,LDBQUH##(U)	;STORE FOR SCNSER (TOPOKE/TOTAKE)
	STOR	U,SBTDB,(SB)	;REMEMBER OUR LDB
	MOVEM	SB,LDBLAT##(U)	;STORE SB PTR IN LDB TOO
	MOVEI	T1,APCLAT##	;GET LATSRV CODE
	DPB	T1,@[IW MCSEC1,LDPAPC##] ;SET ASYNC PORT CHARACTERISTIC
	MOVEI	T1,M.LIDL##	;GET MAX. IDLE TIME FOR LAT LINES
	SNCALL	(SCNADT##,MCSEC1) ;(T1,U)SET THE TIMER GOING
	LDB	T1,@[IW MCSEC1,LDPXNF##] ;Find out our XON/XOF setting
	STOR	T1,SBXNF,(SB)	;And make LAT's setting agree (we will also
				; send a DATA_B slot to inform LATbox).

;If not a host-initiated connect, run INITIA on the TTY.
;
	OPSTR	<SKIPE T1,>,SBPRA,(SB) ;Host-initiated connect?
	JRST	GETTD1		;No, return TTY number
	SNCALL	(TTFGRT##,MCSEC1) ;Yes, use the .HELLO force command
	RETSKP			;Success return
GETTD1:	LDB	T2,@[IW MCSEC1,LDPLNO##] ;(U)Get the TTY number
	ADDI	T2,.UXTRM	;
	STOR	T2,PRSTS,(T1)	;Copy it in the status field
	RETSKP			;Success (do not run INITIA)
	SUBTTL	Subroutines -- NGVLDB - Give an LDB back to SCNSER

					;Still in IFN FTOPS10

;NGVLDB - Give an LDB back to SCNSER
;
; Call:	U/ Pointer to LDB
;
; Return:
;	RET			;ALWAYS

NGVLDB:	SETZM	LDBLAT##(U)	;CLEAR OUT BY-NOW-STALE POINTER
	MOVEI	T1,IONND%	;"NODE DOWN" (PATH LOST/ETC) ERROR
	SNCALL	(DETLDB##,MCSEC1)	;DETACH THE LDB/DDB
	XJRST	[MCSEC1+FRELDB##]	;RETURN LDB TO SCNSER FREE POOL

>;END IFN FTOPS10
;LHRRH - LAT device dependent "return remote host" code
;
; Given the line #, returns the originating hostname, line and
; network type. Places this info in the users NTINF% .NWRRH
; argument block.  NTINF has already checked the user arguments
; for validity.
;
; Call with T1/ address of internal arg block
;
;   ARG+.NWABC/ # of bytes available for host name
;   ARG+.NWFNC/ not used
;   ARG+.NWNNP/ byte pointer to store hostname string
;   ARG+.NWLIN/ address of dynamic data for line
;   ARG+.NWTTF/ flags, and network and terminal types
;   ARG+.NWNNU/ node # word 1
;   ARG+.NWNU1/ node # word 2
;
; Returns + 1 on error with T1/ error code
;	  + 2 on success

IFN FTOPS20,<
XRENT	(LHRRH,G)		;[7.1024]LHRRH::, XLHRR::

	SASUBR	<UAB>
	MOVEM	T1,UAB		;SAVE OUTPUT POINTER
	MOVX	T4,NW%LAT	;SET NETWORK TYPE
	DPB	T4,[POINT 9,.NWTTF(T1),17]	;STORE NETWORK TYPE
	MOVE	T2,.NWLIN(T1)	;GET DYNAMIC DATA ADR
	NOSKED			;PROTECT SB/CB FROM CHANGING BENEATH US
	MOVE	T2,TTDEV(T2)	;GET SB ADDRESS
	JUMPE	T2,LHRRH3
	LOAD	T3,SBCBA,(T2)	;GET CB ADDRESS
	JUMPE	T3,LHRRH3
	LOAD	T4,CBDNI,(T3)	;GET NI ADDRESS (WORD 1)
	MOVEM	T4,.NWNNU(T1)
	LOAD	T4,CBDNI,+1(T3)	;GET NI ADDRESS (WORD 2)
	MOVEM	T4,.NWNNU+1(T1)
	MOVE	T2,T3		;SAVE CB ADDRESS IN T2
	LOAD	T3,CBRSC,(T3)	;GET COUNT OF CHARACTERS
	JUMPE	T3,LHRRH3	;IF ZERO - NO HOST NAME
	CAML	T3,.NWABC(T1)	;MAKE SURE NO MORE THAN MAX
	MOVE	T3,.NWABC(T1)	;ENFORCE IT
	MOVE	T1,.NWNNP(T1)	;GET POINTER TO OUTPUT STRING
	OPSTR	<XMOVEI T2,>,CBSNM,(T2)	;GET ADR OF REMOTE NAME STRING
	TXO	T2,<OWGP. 7,>	;FORM BYTE POINTER TO BUFFER
	EXCH	T1,T2		;PUT POINTER WHERE MMVAZS WANTS THEM
	CALL	MMVAZS		;COPY THE STRING
LHRRH2:	SETZ	T1,
	IDPB	T1,T2		;DEPOSIT A NULL
	MOVE	T1,UAB		;GET POINTER TO USER ARG BLOCK
	MOVX	T2,NW%NNN	;GET "NO NODE NAME KNOWN" FLAG
	SKIPN	T3		;GOT A NODE NAME ?
	IORM	T2,.NWTTF(T1)	;NO - SET THE "NO NODE NAME KNOWN" FLAG
	OKSKED			;DONE WITH SB/CB
	RETSKP

LHRRH3:	MOVE	T2,.NWNNP(T1)	;GET POINTER TO OUTPUT STRING
	SETZ	T3,		;NO NODE NAME
	CALLRET	LHRRH2		;UPDATE HOSTNAME STRING, AND RETURN
>;END IFN FTOPS20
	SUBTTL	Slot Multiplexor - Main Loop

;LAMUX Slot Multiplexor Main Loop
;
;Call:	CALL LAMUX
;	Normal return

LAMUX:
IFN FTOPS10,<
	CALL	LATSCN		;Scan active LDBs
	LOAD	CB,QLFWD,+HN.QAC(HN)	;Get the first CB on the active queue
LANXCB:	JUMPE	CB,CHKWFB	;All CBs processed, check if we need buffers
>;end IFN FTOPS10
IFN FTOPS20,<
	LOAD	CB,QLFWD,+HN.QAC(HN)	;Get the first CB on the active queue
LANXCB:	JUMPE	CB,RTN		;All CBs processed, return
	TMNN	HNRUN,(HN)	;[7.1039]Is the NI still running?
	IFSKP.			;[7.1039]
	  CALL NIHALT		;[7.1039]()No, so deallocate all resources
	  JRST MXNXCB		;[7.1039]
	ENDIF.			;[7.1039]
>
	SETZM	NSLOTS		;Initialize number of slots in this msg
	LOAD	T1,CBSTA,(CB)	;Consider only those circuits which are
	CAIE	T1,CS.RUN	; in the running state
	JRST	MXNXCB		; ...
	OPSTR	<SKIPE>,CBSBQ,(CB);[7.1039]If there are no slots for this circuit
	IFSKP.			;[7.1039] kill it and look at the next one
	  CALL	IDLHLT		;[7.1039]()
	  JRST	MXNXCB		;[7.1039]
	ENDIF.			;[7.1039]
	LOAD	T1,HNLAS,(HN)	;Get the current access state.
	CAIN	T1,LS.OFF	;If the access state is now off,
	  JRST MXNXC2		;  kill this circuit and look at next.
	SETZRO	CBRRF,(CB)	;No RRF set yet
	CALL	TMRCHK		;Check for circuit timer related functions.
	 JRST MXNXCB		;Continue with next circuit.
	TMNN	CBMRN,(CB)	;Must we go balanced (reply to server) now?
	JRST	LMNMRN		;No
; We have received a message from the server and must respond message now.  If
; there is a free transmit buffer and there is slot data waiting to be sent,
; then build the slots in a large MSD transmit buffer and send it.  If the MSD
; buffer is not available or there is no slot data waiting, just send a RUN
; message header.  If there are no free transmit buffers, retransmit the queue
; of unacknowledged messages.

	MOVX	T1,CBMRS!CBMRN!CBRRF;Clear all flags
	ANDCAM	T1,CB.FLG(CB)	; since we will reply now.
	SETZRO	CBCSB,(CB)	;Clear count since balanced
	SKIPN	XB,CB.XBQ(CB)	;Is there a transmit buffer header free?
	JRST	LMNOXB		;No, go transmit unACK'd Q
	OPSTR	<SKIPE >,CBSDC,(CB);There is a buffer, is there data waiting?	
	CALL	BLDMSL		;Everything there so build slots in buffer
	 NOP			;No slots, but don't care
	CALL	MTTRUN		;Transmit either hdr only or full message
	JRST	MXNXCB		;Go to next circuit block
LMNOXB:	CALL	XUNAKQ		;Transmit all messages on the unack'd Q
	JRST	MXNXCB

; Check to see if we just received a message from the server.  If so,
; flag to force a reply at the next sheduler cycle.  We wait one cycle in
; case user programs are controlling echoing in the hopes that response
; will be smoother.

LMNMRN:	TMNN	CBMRS,(CB)	;Must reply soon?
	JRST	LMUNSL
	SETONE	CBMRN,(CB)	;Yes, set to force reply on next cycle	
	JRST	MXNXCB

; We are in balanced mode, i.e. the response to the latest server message
; has already been sent.  Check here to see if we ought to send an unsolicited
; message.  We are allowed one.  We wait at least MXBALC scheduler cycles since
; last going balanced.  If after that period there is slot data waiting, we
; send an unsolicited message to the server.
; If we have not data to send, wait another MXBALC cycles before trying again.
;
LMUNSL:	LOAD	T1,CBCSB,(CB)	;Number of cycles to wait before sending
	CAIL	T1,MXBALC	;Have we waited long enough?
	IFSKP.			;No, so
	  AOJ T1,		; increment the count
	  STOR T1,CBCSB,(CB)	; and wait
	  JRST MXNXCB		; some more.
	ENDIF.

; We have waited long enough. If there is slot data waiting and resouces
; available, send an unsolicited message to the server
;
	SKIPN	XB,CB.XBQ(CB)	;Is there a transmit buffer header free?
	JRST	MXNXCB		;No, so don't send anything
	SETZRO	CBCSB,(CB)	;We might send data, reset the ticker.
	OPSTR	<SKIPE >,CBSDC,(CB);Is there slot data waiting?
	CALL	BLDMSL		;Build a message full of slots
	 JRST MXNXC1		; If no slots, do keep-alive timing.
	CALL	MTTRUN		;There are slots in the message so send it.
MXNXCB:	LOAD	CB,QLFWD,(CB)	;Index of the next CB on active queue
	JRST	LANXCB		;Continue looping
	RET

; We don't have any unsolicited data to send, check if we have heard
; from the server within the last few SERVER_KEEP_ALIVE_TIMER seconds.
; If not, we will assume the server died, and we will kill the circuit.
;
MXNXC1:	MOVE	T1,TODCLK	;Get the current time
	LOAD	T2,CBKAT,(CB)	;Get the time last msg received
	OPSTR	<ADD T2,>,CBKAV,(CB)	;Add the keep-alive time
	CAML	T1,T2		;Have we hit limit yet?
MXNXC2:	CALL	LCLHLT		;Yes, we have not heard from the server
	JRST	MXNXCB		;in a long time, so kill the circuit.
	SUBTTL	BLDMSL

;BLDMSL - Build RUN Message Slots
;
;Call:	CB/ Address of Circuit Block
;	CALL BLDMSL
;	Normal return
;
; This routine scans through all slots associated with a LAT virtual circuit
; and builds RUN message slots for those which have data waiting to be sent 
; to the remote node.  SBFLGS contains a bits mask which indicates which
; type of slot must be built for the slot block. More than one bit may be set.

BLDMSL:	OPSTR	<SKIPN SB,>,QLFWD,+CB.SBQ(CB);Get addr of first slot for this CB
	RET			;There are none
	SETZRO	UNBSZ,+UNB.OF(XB); and message count
	SETZM	MD.NXT+MDB.OF(XB)	;[7.1039]No transmit buffer yet.
BLSLOP:	SKIPL	W1,SB.FLG(SB)	;Does this slot have data waiting?
	JRST	MXNXSL		;No, loop to next slot
	ANDX	W1,SBSMSK	;[7.1120]Clear all but the flags
BLNXSL:	JFFO	W1,BLSDSP	;Find first flags bit which is lit.
MXNXSL:	OPSTR<SKIPE SB,>,QLFWD,(SB);Get next slot's index and
	JRST	BLSLOP		; continue with the next slot
BLSLCP:	SKIPN	NSLOTS		;Check to see if any slots entered at all
	RET			;None.

;If we couldn't get through all slots, rotate this circuit's slot queue so
;that we resume next time with the slot we did not complete this time.

	SKIPN	SB		;Did we get through the whole queue?
	IFSKP.			;NO
	  OPSTR <CAMN SB,>,QLFWD,+CB.SBQ(CB);Is slot already at the Q head?
	  IFSKP.		;NO
	    LOAD T3,QLFWD,+CB.SBQ(CB);Get old queue head
	    LOAD T4,QLBWD,+CB.SBQ(CB);Get old queue tail
	    STOR T3,QLFWD,(T4)	;Joint them together
	    STOR T4,QLBWD,(T3)	; ...
	    LOAD T3,QLBWD,(SB)	;Get new Q tail from new Q head
	    SETZRO QLFWD,(T3)	;Clear new tail's forward ptr
	    SETZRO QLBWD,(SB)	;Clear new head's backward ptr
	    STOR SB,QLFWD,+CB.SBQ(CB);New head
	    STOR T3,QLBWD,+CB.SBQ(CB);New tail
	  ENDIF.
	ENDIF.
;Compute final byte count padding to minimum NI datagram size if necessary.

	LOAD	T1,UNBSZ,+UNB.OF(XB);Store the larger of the final real message
	CAIG	T1,MINXBF-MMHDSI	; count and the minimum count as the message
	MOVEI	T1,MINXBF-MMHDSI	; count.
	MOVE	T3,MD.NXT+MDB.OF(XB)	;[7.1039]Get MSD address
	STOR	T1,MDBYT,(T3)	;[7.1039]and store count in MSD
	RETSKP

; Check first to see if adding a new slot causes the number of slots in a
; message to exceed the maximum permitted by remote.

BLSDSP:	LOAD	T3,CBMSL,(CB)	;Get the maximum permitted by remote
	CAMG	T3,NSLOTS	; and compare with number of slots so far.
	JRST	BLSLCP		;At maximum, stop processing this circuit.

; Check to see if there is enough room remaining in the transmit buffer to
; include this slot.

	HLRZ	T1,SLLNTB-1(W2)	;Minimum bytes required for this slot type.
	LOAD	T3,UNBSZ,+UNB.OF(XB);Current number of bytes in the buffer.
	ADD	T1,T3		;Count if we include this new slot.
	CAILE	T1,SZ.XBF	;Compare with total transmit buffer capacity.
	JRST	BLSLCP		;Will not fit so stop processing this circuit.

; Call the routine to build the slot.  It may or may not be entered into the
; message. At this point however it is always marked as having been processed.

	MOVE	T1,BITS(W2)	;Get the mask for the bit
	ANDCM	W1,T1		;Indicate that this slot has been processed.
	CALL	@SLBDSP-1(W2)	;Build the slot.
	 JRST BLNXSL		;Slot not entered. Try next.

; Slot successfully entered into the transmit buffer. Update the buffer counts.
; Terminal character count has already been added.

	HRRZ	T1,SLLNTB-1(W2)	;Get the count for the slot header.	
	OPSTR	<ADD T1,>,UNBSZ,+UNB.OF(XB);Get the message count so far
	TRNN	T1,1		;Is the count even?
	IFSKP.			;No, must pad to even number
	  OPSTR <IDPB T1,>,UNBFA,+UNB.OF(XB);Put fill byte into message
	  AOS T1		;Increment total in message
	ENDIF.
	STOR	T1,UNBSZ,+UNB.OF(XB);
	AOS	NSLOTS		;Increment number of slots in the message.
	JRST	BLNXSL		;Get next slot request.
	MIN. (MINSFL,<^L<SBREJ>,^L<SBSTR>,^L<SBSTO>,^L<SBOUT>,^L<SBFOU>,^L<SBFCC>>)
	MAX. (MAXSFL,<^L<SBREJ>,^L<SBSTR>,^L<SBSTO>,^L<SBOUT>,^L<SBFOU>,^L<SBFCC>>)

SLBDSP:	XADDR. XSLREJ			;[7.1052]Reject
	XADDR. XSLSTA			;[7.1052]Start
	XADDR. XSLATT			;[7.1052]Attention
	XADDR. XSLDTA			;[7.1052]Data A
	XADDR. XSLDTB			;[7.1052]Data B
	XADDR. XSLSTP			;[7.1052]Stop

SLLNTB:	EXP	<SZ.SHD+SZ.REJ,,SZ.SHD+SZ.REJ>	;[7.1052]Reject
	EXP	<SZ.SHD+SZ.SST,,SZ.SHD+SZ.SST>	;[7.1052]Start
	EXP	<SZ.SHD+SZ.ATT,,SZ.SHD+SZ.ATT>	;[7.1052]Attention
	EXP	<SZ.SHD,,SZ.SHD>	;[7.1052]Data A
	EXP	<SZ.SHD+SZ.SDB,,SZ.SHD+SZ.SDB>	;[7.1052]Data B
	EXP	<SZ.SHD+SZ.SSP,,SZ.SHD+SZ.SSP>	;[7.1052]Stop

	SUBTTL	Slot Formatting Routines

;XSLSTA - Format a START Slot in the Transmit Buffer
;
;Call:	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLSTA
;	Normal Return

XSLSTA:	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 RET			;No, and can't get any.
	MOVEI	T1,SS.RUN	;Put the slot in the
	STOR	T1,SBSTA,(SB)	; RUNNING state.
	MOVEI	T1,<<ST.STA_^D12>!<MAXCRE_^D8>!SZ.SST>;COUNT/TYPE/CREDITS fields
	CALL	BSLTHD		;Build the slot header	
	MOVEI	T1,SCITTY	;Only available service class currently
	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB)
	MOVEI	T1,MXSLSI	;Maximum slot size for all slot types
	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB);As maximum attention slot size
	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB);As maximum data slot size
	MOVEI	T1,0
	CALL	LAP2B0		;Zero slot names
	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB);No parameters either
	MOVX	T1,SBSTR	;Indicate that this slot request successfully
	CALL	CSBDAV		; and entirely completed.
	RETSKP

;XSLREJ - Format a REJECT Slot in the Transmit Buffer
;
;Call:	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLREJ
;	Normal Return

XSLREJ:	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 RET			;No, and can't get any.
	LOAD	T1,SBREA,(SB)	;Get the reject reason code
	LSH	T1,^D8
	MOVEI	T1,<ST.REJ_^D12!SZ.REJ>(T1)	;COUNT/TYPE/REASON fields
	CALL	BSLTHD		;Go build the slot header
	MOVX	T1,SBREJ	;Indicate that this slot request successfully
	CALL	CSBDAV		; and entirely completed.
	CALL	RELSB		;Release the slot.
	RETSKP			;That's all there is to a REJECT slot.
	SUBTTL	Slot Formatting Routines

;XSLSTP - Format a STOP Slot in the Transmit Buffer
;
;Call:	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLSTP
;	Normal Return

XSLSTP:	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 RET			;No, and can't get any.
	CALL	RLSBID		;Release the local slot block ID.
	LOAD	T1,SBREA,(SB)	;Get the stop reason code
	LSH	T1,^D8
	MOVEI	T1,<ST.STP_^D12!SZ.SSP>(T1)	;COUNT/TYPE/REASON fields
	CALL	BSLTHD		;Go build the slot header
	MOVX	T1,SBSTO	;Indicate that this slot request successfully
	CALL	CSBDAV		; and entirely completed.
	CALL	RELSB		;Now go release the slot
	RETSKP

;XSLATT - Format a ATTENTION Slot in the Transmit Buffer
;
;Call:	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLATT
;	Normal Return

XSLATT:	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 RET			;No, and can't get any.
	MOVEI	T1,<ST.ATT_^D12!SZ.ATT>;COUNT/TYPE fields
	CALL	BSLTHD		;Go build the slot header
	MOVEI	T1,1B30
	OPSTRM	<IDPB T1,>,UNBFA,+UNB.OF(XB);Deposit control flags
	MOVX	T1,SBFOU	;Indicate that this slot request successfully
	CALL	CSBDAV		; and entirely completed.
	RETSKP
	SUBTTL	Slot Formatting Routines

;XSLDTA - Format a DATA_A Slot in the Transmit Buffer
;
;Call:	W1/ Slot Block Flags
;	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLDTA
;	Normal Return

; If we have transmit credit available, compute the maximum number of terminal
; output characters which may be entered into the slot.  If we no longer have
; credit, set the character count to zero.

XSLDTA:	SAVEAC	<W1,W2>
IFN FTOPS20,<
	SETZ	W1,		;Assume character count is zero.
	OPSTR	<SKIPN>,SBXCR,(SB);Do we still have any transmit credit?
	IFSKP.
 	  LOAD T2,SBTDB,(SB)	;Get address of TDB
	  TMNE <TTSFG,TTRXF>,(T2);Check if at a page stop.  If so, character
	  IFSKP.		; stays 0 (cannot call TTSND).
	    MOVEI W1,SZ.XBF-SZ.SHD;Get the residual buffer (minus slot header)
	    OPSTR <SUB W1,>,UNBSZ,+UNB.OF(XB); count.
	    CALL GTCHCT		;(T2/T1)Get total character count
	    CAMLE W1,T1		;Smaller of residual count - 4 and TTOCT+TSALC
	    MOVE W1,T1		;TTOCT+TSALC was smaller
	    OPSTR <CAMLE W1,>,SBMDS,(SB) ;Compare with maximum DATA_A slot size
	    LOAD W1,SBMDS,(SB)	;Maximum allowed by remote is less.
	  ENDIF.
	ENDIF.

; Determine if the remote needs more credits and if we can give him any.  If
; he doesn't or we can't and there is no terminal output data to be sent(count
; from above is 0) , exit without building the slot since there is no need to
; send one.  Otherwise at least a DATA_A slot header will be sent.  If it is 
; extending credit, there may or may not be output data.

	CALL	CRECHK		;Check if we can grant more credit remote
	 SKIPE W1		;Can't or don't need to so if there is no data
	SKIPA			; either, no need to send a slot. Otherwise,
	JRST	XSLDA3		; send at least empty slot granting new credit.
	MOVE	W2,T1		;Save CRECHK result
	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 JRST XSLDA3		;No, and can't get any.
	MOVE	T1,W2		;Retrieve CHECHK results
	LSH	T1,^D8		;Shift into proper position
	IORI	T1,<ST.DTA_^D12>(W1);Fill in the rest of last 2 slot header bytes.
	CALL	BSLTHD		;Go build the slot header
	JUMPE	W1,XSLDA2	;No slot data and no credits used.
	MOVNS	W1		;Set up to be used in an AOBJN
	HRLZS	W1		;... [-count,,0]
XSLDA0:	LOAD	T2,SBTDB,(SB)	;Dynamic TT data base
	CALLX	(MSEC1,TTSND)	;[7.1024]Get a character from the buffer
	 JRST [ HRRZS W1
	        MOVEI T1,1(W1)
	        MOVNS T1
		OPSTR <ADJBP T1,>,UNBFA,+UNB.OF(XB)
		DPB W1,T1
		JRST XSLDA1]

	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB)	;[7.1039]Enter character into buffer
	AOBJN	W1,XSLDA0	;Continue if more characters
XSLDA1:	LOAD	T1,SBXCR,(SB)	;Get our transmit credit count
	SOS	T1		;Decrement since we may consume one credit now.
	STOR	T1,SBXCR,(SB)	; send data so store decremented credit count.
					;Still in IFN FTOPS20

; Determine whether to slot request was FULLY completed.  If not, don't
; clear the request bit since it will have to be completed next time around.

XSLDA2:	OPSTRM	<ADDM W1,>,UNBSZ,+UNB.OF(XB);Update the total message count.
	OPSTRM	<ADDM W2,>,SBRCR,(SB);Update his credit count.
	LOAD	T2,SBTDB,(SB)	;Get the TDB address back
	CALL	GTCHCT		;(T2/T1)Get remaining character count. If more,
	JUMPN	T1,RSKP		; return and do not clear request bit.
	SETZRO	TTOTP,(T2)	;Clear TTY output active if not more data.
	OPSTR	<SKIPN>,SBRCR,(SB);If remote has zero credit for transmits
	RETSKP			; return successfully without clearint request.
	MOVX	T1,SBOUT	; Otherwise mark this request as complete.
	CALL	CSBDAV
	RETSKP

XSLDA3:	LOAD	T2,SBTDB,(SB)	;Get the TDB address
	CALL	GTCHCT		;(T2/T1)Get remaining character count.
	JUMPN	T1,RTN
	SETZRO	TTOTP,(T2)	;There is no more terminal output, clear
	RET			; the TTOTP bit and return.

>;end ifn ftops20

IFN FTOPS10,<
	LOAD	U,SBTDB,(SB)	;Get address of LDB.
				;We will carry this in U for a while
	SETZ	W1,		;Assume character count is zero.
	OPSTR	<SKIPN>,SBXCR,(SB);Do we still have any transmit credit?
	IFSKP.
	  MOVEI W1,SZ.XBF-SZ.SHD;Get the residual buffer (minus slot header)
	  OPSTR <SUB W1,>,UNBSZ,+UNB.OF(XB); count.
	  OPSTR <CAMLE W1,>,SBMDS,(SB) ;Compare with maximum DATA_A slot size
	  LOAD W1,SBMDS,(SB)	;Maximum allowed by remote is less.
	ENDIF.

; Determine if the remote needs more credits and if we can give him any.
; If he doesn't or we can't and there is no terminal output data to be
; sent, exit without building the slot since there is no need to send
; one. Otherwise at least a DATA_A slot header will be sent. If it is
; extending credit, there may or may not be output data. We don't know
; at this point how many characters SCNSER has for us to send, so just
; keep trying to get chars until we fill the slot or run out of
; characters
;
;	at this point:
;	W1/ max characters we can send
;
	MOVNS	W1		;Make into
	HRLZS	W1		;AOBJN word
;
;	now:
;	W1/ -max,,0
;
	JUMPE	W1,NOCHR	;We don't have credit to send. Don't get a char
	SKIPGE	SB.TTO(SB)	;Is there saved character? (SBTTO is sign bit)
	 JRST GOTCHR		;Yes
	SNCALL	(XMTCHR##,MCSEC1)	;No, try to get a character from SCNSER
	 JRST NOCHR		;SCNSER doesn't have any for us.
	SETONE	SBTTO,(SB)	;SCNSER does have one, remember we got it
	STOR	T3,SBCHR,(SB)	;and save it away
GOTCHR:	AOBJN	W1,.+1		;Got a char, count it
NOCHR:	CALL	CRECHK		;Check if we can grant more credit remote
	 TRNE W1,777777	;Can't or don't need to. See if any data?
	SKIPA			;Got data or can grant credit, send a slot
	 RET			;No slot to send, just return
	MOVE	W2,T1		;Save CRECHK result
	CALL	XBFCHK		;Do we have a transmit buffer yet?
	 RET			;No, and can't get any.
	LOAD	T1,SBXCR,(SB)	;Get our transmit credit count
	SOS	T1		;Decrement since we may consume one credit now
	TRNE	W1,777777	;If data count is not zero, we will definitely
	 STOR T1,SBXCR,(SB)	;Store updated credit count

;Can't build slot header yet, since we don't know how many characters
; we will send.  Save a pointer to the slot character count, and
; call BSLTHD anyway.  We will stuff the char count later.
;
;At this point, the slot byte pointer points to the DST_SLOT_ID
;
	MOVEI	T1,3		;the byte count is the 3rd byte of the slot
	OPSTR	<ADJBP T1,>,UNBFA,+UNB.OF(XB)	;so make a DPB pointer to it
	PUSH	P,T1		;save first word of byte pointer
	PUSH	P,T2		;and possible second word
					;Still in IFN FTOPS10

;Now build the slot header
;
	MOVE	T1,W2		;get CRECHK results
	LSH	T1,^D8		;Shift to proper position
	IORI	T1,<ST.DTA_^D12>	;fill in the flag
	CALL	BSLTHD		;build the slot header (with bad char count)
	TRNN	W1,777777	;Is there some data?
	 JRST XSLDA2		;No, no characters to move
	LOAD	T3,SBCHR,(SB)	;Yes, get saved character.
	SETZRO	SBTTO,(SB)	;And remember we got it.
	OPSTR	<IDPB T3,>,UNBFA,+UNB.OF(XB)	;Stuff first character into buffer
	JUMPGE	W1,XSLDA2	;if (heaven help us) there was only space for
				;one character, stop now.
XSLDA0:	SNCALL	(XMTCHR##,MCSEC1)	;Get a character from SCNSER
	 JRST XSLDA2		;None left
	OPSTR	<IDPB T3,>,UNBFA,+UNB.OF(XB)	;Stuff a character into buffer
	AOBJN	W1,XSLDA0	;Count characters done

; Here we have either filled up the slot or run out of characters.
; Stuff the actual character count into the slot header.
;
XSLDA2:	POP	P,T2		;retrieve pointer to slot header
	POP	P,T1		; byte count
	DPB	W1,T1		;and stuff actual character count
	HRRZ	T1,W1		;get character count by itself
	OPSTRM	<ADDM T1,>,UNBSZ,+UNB.OF(XB)	;and update total message count.
	OPSTRM	<ADDB W2,>,SBRCR,(SB)	;Update his credit count. (remember total)
	JUMPE	W1,RSKP		;If we don't have any transmit credits, or
	SKIPE	W2		;If the remote has zero credits for transmits
	SKIPL	LDBDCH##(U)	;Or if SCNSER doesn't think line is idle
	.CREF	LDLIDL		;(really checking this bit)
	 RETSKP		;Return successfully without clearing request
	MOVX	T1,SBOUT	;Otherwise, mark this request as complete.
	CALL	CSBDAV
	RETSKP
>;END IFN FTOPS10

	SUBTTL	Slot Formatting Routines

;XSLDTB - Format a DATA_B Slot in the Transmit Buffer
;
;Call:	SB/ Slot Block Address
;	CB/ Circuit Block Address
;	XB/ Transmit Buffer Address
;	CALL XSLDTB
;	Normal Return
;

XSLDTB:	OPSTR	<SKIPE>,SBXCR,(SB);Do we still have any transmit credit?
	CALL	XBFCHK		;Check if we have a transmit buffer yet.
	 RET			; Didn't and can't get one.
	LOAD	T1,SBXCR,(SB)	;Current number of transmit credits available
	SOS	T1		;Decrement since this slot will consume one.
	STOR	T1,SBXCR,(SB)	;Store updated credit count
IFN FTOPS10,<
	LOAD	U,SBTDB,(SB)	;Point to LDB
>;end IFN FTOPS10
	CALL	CRECHK		;Does remote need credits?
	 NOP			;Dont't care if he did and we can't provide
	OPSTRM	<ADDM T1,>,SBRCR,(SB)	;[7275] Update remote credit count
	LSH	T1,^D8		;Shift to proper position.
	IORI	T1,<ST.DTB_^D12>!SZ.SDB;Fill in rest of last 2 header bytes.
	CALL	BSLTHD		;Go build the slot header
	MOVEI	T1,SL.DXF	;Assume disabling XOFF recognition	
IFN FTOPS20,<
	LOAD	T2,SBTDB,(SB)	;Get the terminal data base address
	TMNE	TT%PGM,TTFLGS(T2)	
>;end IFN FTOPS20
IFN FTOPS10,<
	LOAD	U,SBTDB,(SB)	;Get LDB address
	LDB	T2,@[IW MCSEC1,LDPXNF##]	;Get XON/XOF flag
	SKIPE	T2		;disabling XON/XOF recognition?
>;end IFN FTOPS10
	MOVEI	T1,SL.EXF	;No, enabling	
	OPSTR	<IDPB T1,>,UNBFA,+UNB.OF(XB);Enter control flags to buffer	
	MOVEI	T1,<XONC_^D8!XOFFC>	;XON and XOFF characters
	CALL	LAP2B0		;Enter them into buffer
	CALL	LAP2B0		;Also input XON/XOFF characters
	MOVX	T1,SBFCC
	CALL	CSBDAV
	RETSKP

BSLTHD:	MOVE	T3,T1		;Save input arg
	LOAD	T1,SBLID,(SB)	;Remote slot ID
	LSH	T1,^D8		;Shift to second byte
	OPSTR	<IOR T1,>,SBRID,(SB)	;Local slot ID into first byte
	CALL	LAP2B0		;(Clobbers T2 only.)
	MOVE	T1,T3		;Get original argument back
	CALL	LAP2B0		;Enter count/slot type/credits
	RET


;CRECHK - Remote Credit Check Routine
;
;Call:	SB/ Slot Block Address
;	CALL CRECHK
;	 No-Grant return
;	Grant return
;	T1/ <Number to grant>

; If the remote has less than the maximum number of transmit credits, try to
; compute the number of additional credits to grant him and return in T1, 
; shifted by one byte (for convenience of caller).  We can only grant credit
; if there is room for a non-zero integral number of full slot buffers (of
; length MXSLSI).

;[7469]	If terminal has pause at end of page enabled always be sure to
;[7469]	grant at least 1 credit.  If zero credits are granted and  the
;[7469]	user hits end of page they will not be able to resume type out
;[7469]	by pressing the unpause character, since the LAT box will  not
;[7469]	be able to send it.

CRECHK:	MOVEI	T1,MAXCRE	;Maximum number of credits remote may have.
	OPSTR	<SUB T1,>,SBRCR,(SB);His deficiency.
	JUMPE	T1,RTN		;Can't grant him more-- he already has limit.
	MOVE	T3,T1		;Save remote's credit deficiency.
IFN FTOPS20,<
	LOAD	T4,SBTDB,(SB)	;Get the terminal dynamic pointer
	LOAD	T1,TIMAX,(T4)	;Maximum that will fit in an input buffer
	SUB	T1,TTICT(T4)	;Subtract current input count to get whats left
	IDIVI	T1,MXSLSI	;Compute number of slot buffer that would fit
	IFE. T1
	  SETONE TTFWK,(T4)	;[7469] Hopefully start the process running
	  JE TT%PGM,TTFLGS(T4),RTN ;[7469] Jump if not in page mode
	  TMNE TTNXO,(T4)	;[7469] Pause at end of page?
	  MOVEI T1,1		;[7469] Yes, always grant 1 credit
	ENDIF.
	JUMPE	T1,[SETONE TTFWK,(T4);None, so can't grant more so force
		  JRST RTN]	; the process to wake.
>;end IFN FTOPS20

IFN FTOPS10,<
	MOVEI	T1,TTIWRN##	;Get max characters for an input buffer
	SUB	T1,LDBTIC##(U)	;Minus number that have been echoed
	SUB	T1,LDBECC##(U)	;Also minus number that have not yet echoed
	IDIVI	T1,MXSLSI	;Compute number of slot buffer that would fit
	JUMPE	T1,RTN		;None, so can't grant more.
>;end IFN FTOPS10

	CAMLE	T1,T3		;Make sure he never gets a total of more than
	MOVE	T1,T3		; the maximum allowed.
	RETSKP


IGNSLT:	SETZM	UN.BSZ+UNB.OF(RB)	;[7.1120]Force data to be ignored.
	RETSKP			;This is a good return.

ILLSLT:	OPSTRM	<AOS>,HCISR,(HN)	;Increment host count
	OPSTRM	<AOS>,CCISR,(CB)	; and the per-server count
ILLSLX:	RET			;Give a bad return

	SUBTTL	-  Queue Handling Routines

;LAQUE - Add an element to the front of a queue
;
;Call:	T1/ Address of Queue Header
;	T2/ Address of Element to Add
;	CALL LAQUE
;	Normal Return
; This routine is used to queue either CBs or SBs.  The queue headers
; and link words are always two words, and are described by the BEGSTR QL.
; All elements are linked in both forward and backward directions.

LAQUE:	MOVE	T4,T1		;Save queue header address
	OPSTR	<SKIPE T3,>,QLFWD,(T1)	;Get old first queue element if any.
	MOVE	T1,T3		; Old first element or Q header backward
	STOR	T2,QLBWD,(T1)	; pointer points to new element
	STOR	T2,QLFWD,(T4)	;Store new first queue element
	SETZRO	QLBWD,(T2)	;Zero its backward pointer
	STOR	T3,QLFWD,(T2)	;Set up its forward pointer
	RET

;LAUNQ - Dequeue a queue element
;
;Call:	T1/ Address of queue header
;	T2/ Address of queue element to be unqueued
;	CALL LAUNQ
;	Normal return
;
;Uses:	T3,T4

LAUNQ:	LOAD	T3,QLBWD,(T2)	;Get elements backward pointer
	LOAD	T4,QLFWD,(T2)	;Get its forward ptr also.
	SKIPN	T2,T4		;Remove the element from the backward list
	XMOVEI	T2,QL.FWD(T1)	; by updating the backward
	STOR	T3,QLBWD,(T2)	; ptr of either next Q element or Q head
	SKIPE	T3		;If backward ptr 0 update Q head forward ptr
	XMOVEI	T1,QL.FWD(T3)	; otherwise  update that of the previous Q
	STOR	T4,QLFWD,(T1)	; element
	RET

	

;QUE1WB - Routine to queue and element to the back of a 1 directional queue.
;
;Call:	T1/ address of Q header block
;	T2/ address of queue element to add to queue
;	CALL QUE1WB
;	Normal return

QUE1WB:	OPSTR	<SKIPN T3,>,QLBWD,(T1);Address of first element on Q
	MOVE	T3,T1		;Zero, Q header fwd ptr points to new element
	STOR	T2,QLFWD,(T3)	;Update forward ptr of Q hdr or old Q tail
	SETZRO	QLFWD,(T2)	;Zero new elements forward ptr
	STOR	T2,QLBWD,(T1)	;New tail ptr
	RET

;UNQ1WF - Routine to remove an element from the front of a 1 directional queue.
;
;Call:	T1/ address of the Q header block
;	CALL UNQ1WF
;	 Error return - queue emtpy	
;	Normal return
;	T2/ address of element

UNQ1WF:	OPSTR	<SKIPN T2,>,QLFWD,(T1);Address of first element on Q
	RET			;Zero, so queue is empty
	OPSTR	<SKIPN T3,>,QLFWD,(T2);If only 1 element on Q then update
	STOR	T3,QLBWD,(T1)	; the Q headers tail ptr (set to 0)
	STOR	T3,QLFWD,(T1)	;There is a new head of the Q (or 0)
	RETSKP			;Return with the Q element in T2

	SUBTTL	- Buffer Handling Routines - Transmit Buffers

;GETXBH - Get the necessary number of transmit buffer headers
;
;Call:	CB/ Address of the circuit block
;	CALL GETXBH
;	  Error return - insufficient resources
;	Normal return

GETXBH:	MOVSI	W1,-MAXXBF	;Number of buffers to get
GTXNXT:	MOVEI	T1,<<MINXBF+3>/4+XBF.OF>;Buffer length to get
	CALL	MMGTZW		;Go get the storage
	 JRST GTXFL		;Failed to get all that are needed
	MOVX	T2,<POINT 8,0>
	STOR	T2, MDAUX,+MDB.OF(T1);
	MOVEI	T2,SZ.MHD	;The message header always has 
	STOR	T2,MDBYT,+MDB.OF(T1); 8 bytes.
	MOVEI	T2,VMC.XC	;Always use exec virtual paging
	STOR	T2,MDVMC,+MDB.OF(T1); ...
	XMOVEI	T2,<XBF.OF>(T1)	;
	STOR	T2,MDALA,+MDB.OF(T1);Address of start of header
	MOVE	T2,T1		;Now queue to circuit blocks queue of free
	XMOVEI	T1,CB.XBQ(CB)	; transmit buffers
	CALL	QUE1WB		; ...
	AOBJN	W1,GTXNXT	;Get as many as required
	RETSKP

; Failed to get the nececessary number of buffers. Must free those
; which we did get.

GTXFL:	XMOVEI	T1,CB.XBQ(CB)	;Unqueu each from the transmit free Q
	CALL	UNQ1WF		; ...
	 RET			;No more there so return with error
	MOVE	T1,T2		;Give back the buffer to the memory
	CALL	MMFREE		; manager
	JRST	GTXFL		; and continue looping til all returned


;GETXBF - Get one long transmit buffer for real data
;
;Call:	CB/ Address of the circuit block
;	XB/ Address of the 1st MSD (header)	
;	CALL GETXBH
;	  Error return - insufficient resources
;	Normal return
;	T3/ MSD address (also saved in MD.NXT+MDB.OF(XB))

GETXBF:	MOVEI	T1,<MD.LEN+SZ.XBF>;Buffer length to get
IFN FTOPS20,<
	CALL	MMGTZW		;Go get the storage
>
IFN FTOPS10,<
	CALL	GETZBF		;Go get the storage
>
	 RET			;No luck!
	MOVE	T3,T1
	SETZ	T1,
	MOVX	T2,<POINT 8,0>
	STOR	T2,MDAUX,(T3);Byte pointer to message
	MOVEI	T1,SZ.XBF
	STOR	T1,MDBYT,(T3);Zero length
	MOVEI	T1,VMC.XC	;Always use exec virtual paging
	STOR	T1,MDVMC,(T3); ...
	XMOVEI	T1,<MD.LEN>(T3)	;
	MOVEM	T3,MD.NXT+MDB.OF(XB)	;Link header MSD to this
	STOR	T1,MDALA,(T3)	;Message address
	RETSKP


;XBFCHK - Check for Transmit buffer
;
;Call:	XB/
;	CALL XBFCHK
;	 Error Return
;	Normal Return

XBFCHK:	SKIPE	T3,MD.NXT+MDB.OF(XB)	;[7.1039]If we already have one,
	 RETSKP		;return
	CALL	GETXBF		;Get an MSD transmit buffer
 	 RET			;None available, return failure
	XMOVEI	T1,<MD.LEN>(T3)	;[7.1039]Make a one word 8 bit
	TLO	T1,(<OWGP. 8,0>)	;[7.1039] global byte pointer and save as
	STOR	T1,UNBFA,+UNB.OF(XB); message byte pointer.
	RETSKP


;RFXBFS - Release all free transmit buffers
;
;Call:	CB/ circuit block address
;	CALL RFXBFS
;	Normal return
;

RFXBFS:	XMOVEI	T1,CB.XBQ(CB)	;Address of the free xmit buffer queue
	CALL	UNQ1WF		;Unqueue the head of the Q
	 RET
	MOVE	XB,T2		;Put buffer address where RELXBH wants it
	CALL	RELXBH		;Go release it
	JRST	RFXBFS		;Get next

;RELXBF - Release Transmit Buffer
;
;Call:	XB/ Address of buffer header
;	CALL RELXBF
;	Normal return

RELXBF:	MOVEI	T1,0		;[7.1039]
	EXCH	T1,MD.NXT+MDB.OF(XB)	;[7.1039]If there is no MSD style buffer
	JUMPE	T1,RTN		;[7.1039] then just return
IFN FTOPS20,<
	CALLRET	MMFREE		;[7.1039] and free the MSD's storage.
>
IFN FTOPS10,<
	CALLRET	GIVBF		; and free the MSD's storage.
>
;RELXBH - Release Transmit Buffer Header and Buffer
;
;Call:	XB/ Address of buffer header
;	CALL RELXBH
;	Normal return

RELXBH:	CALL	RELXBF		;Release the buffer first
	MOVE	T1,XB		;Now the header
	CALL	MMFREE
	RET

	SUBTTL	- Buffer Handling Routines - Receive Buffers

;GETRBF - Get a Receive buffer
;
;Call:	CALL GETRBF
;	 Error return - no receive buffers
;	Normal Return
;
; This routine checks to see if enough receive buffers have been posted
; to the NI DLL to support the number of currently active circuits plus
; a new one.  If  buffers are needed and can be obtained, they are posted
; directly to the NI DLL.  If some are needed, and cannot be obtained,
; the error return is taken.

GETRBF:	STKVAR	<BUFADR>
	LOAD	T1,HNNRB,(HN)	;Do check to see if we need more buffers.
	LOAD	T2,HNNAC,(HN)
	CAIL	T1,1(T2)
	 RETSKP		;No additional are needed. Return success.
	MOVEI	T1,<<LMRFSI+3>/4+UN.LEN+UE.LEN>	;Receive buffer size
IFN FTOPS20,<
	CALL	MMGTZW		;Get the number of required buffers
>
IFN FTOPS10,<
	CALL	GETZBF		;Get the number of required buffers
>
	 RET			;Can't, return error.
	MOVEM	T1,BUFADR	;Save address in case we can't post buffer
	CALL	RBPOST		;Post the receive buffer to NISRV
	IFSKP.
	  OPSTRM <AOS>,HNNRB,(HN);Increment the number of receive buffers
	  RETSKP		;Return success
	ENDIF.
	MOVE	T1,BUFADR	;Get address of buffer
IFN FTOPS20,<
	CALLRET	MMFREE		;Free the memory
>
IFN FTOPS10,<
	CALLRET	GIVBF		;Free the memory
>

	ENDSV.

;RELRBF - Release a Receive buffer
;
;Call:	RB/ Address of the buffer to release
;	CALL RELRBF
;	Normal Return
;
; This routine frees a receive buffer if there is already a sufficient number
; posted to the NI DLL otherwise the buffer is re-posted to the NI DLL.

RELRBF:	LOAD	T1,HNNRB,(HN)	;Do we still need this buffer?
	LOAD	T2,HNNAC,(HN)
	CAILE	T1,1(T2)
	 JRST RELRB0		;No, so free it
	MOVE	T1,RB		;Yes, so
	CALL	RBPOST		; re-post it to NISRV
	 JRST RELRB0		;NISRV could not accept it?! Release it.
	RET			;Successfully re-posted. Return.
RELRB0:	MOVE	T1,RB		;Here to free the buffer.
IFN FTOPS10,<
	CALL	GIVBF
>
IFN FTOPS20,<
	CALL	MMFREE
>
	OPSTRM	<SOS>,HNNRB,(HN)	;Reduce the number of receive buffers
	RET

IFN FTOPS10,<
	SUBTTL	SCNSER DEVICE DEPENDANT ROUTINES
;
;	TOPS10 does not call a device dependant routine for each output
;	 character. Nor does it call a routine to change TTY PAGE.
;	At each scheduler interval, we scan all LDBs in LATSER's queue
;	to see what must be done with each one.
;
LATSCN:	MOVEI	T1,LATRTQ	;Get SCNSER's queue header
	SNCALL	(TOTAKE##,MCSEC1)	;Get next active LDB on the chain
	 RET			;None. Just return.
	SKIPN	SB,LDBLAT##(U)	;Get slot block address
	 RET			;None. This guy's a loser so punt.
	MOVEI	T1,0		;T1 will get Slot flags
	MOVEI	T3,L1RCHP##
	TDNE	T3,LDBBYT##(U)	;Need to change parameters?
	 CALL LATCHP	;Yes. See what needs change and set T1
	TXO	T1,SBOUT	;Always set flag for output. Check later anyway
;
; Here if we MIGHT have characters to output, or need to change TTY PAGE
;
	MOVE	CB,SB.CBA(SB)	;And associated circuit block address
	CALL	SSBDAV		;And set this slot's flags
	JRST	LATSCN		;Look at next LDB in the queue
;
;Routine to see if we need to change recognition of XON/XOFF
;
;Call:	U/ LDB address
;
;Return:	Flag SBFCC set in T1 if we need to change
;
LATCHP:	ANDCAM	T3,LDBBYT##(U)	;Turn off CHP bit to show we checked
	LDB	T2,@[IW MCSEC1,LDPXNF##]	;Get XON/XOF flag
	LOAD	T3,SBXNF,(SB)	;Get bit that says what the LAT knows
	CAMN	T2,T3		;Are they already the same?
	 RET			;Yes, no need to send a message, then
	TXO	T1,SBFCC	;Different. Need to send a message
	STOR	T2,SBXNF,(SB)	;AND remember what we are now.
	RET
>;end IFN FTOPS10
	ENDAV.

IFN FTOPS20,<
	SUBTTL	TTYSRV DEVICE DEPENDENT ROUTINES

XRENT	(LTSTRO,G)		;[7.1024]LTSTRO::, XLTSTR::

	MOVX	T1,SBOUT
	SETONE	TTOTP,(T2)	;Set output active
	JRST	LTSSDC

XRENT	(LTCOBF,G)		;[7.1024]LTCOBF::, XLTCOB::

	MOVX	T1,SBFOU
	JRST	LTSSDC

XRENT	(LTEXF,G)		;[7.1024]LTEXF::, XLTEXF::

	MOVX	T1,SBFCC
LTSSDC:	ACVAR	<HN,XB,RB,CB,SB,W1,W2>
	NOSKD1
	CHNOFF	DLSCHN
	SKIPN	SB,TTDEV(T2)	;Get the slot data base from TDB if not 0
	JRST	LTSSD0
	MOVE	CB,SB.CBA(SB)	;Get the circuit data base from slot block.
	SAVEAC	<T2>		;TTYSRV needs T2 returned intact
	CALL	SSBDAV
LTSSD0:	CHNON	DLSCHN
	OKSKD1
	RET

; TTYSRV Device Dependent Routine to see if SENDAL should be done on this
; line. 
; Call:	T2/ Line Number
;	Non-skip Return/ Skip SENDALL to this Line
;	Skip Return    / Do SENDALL to this Line

XRENT	(LTSALL,G)		;[7.1024]LTSALL::, XLTSAL::

	SKIPG	TTACTL(T2)	;Is line fully active?
	RET			;No, don't do SENDALL
	RETSKP			;Yes, do the SENDALL

; TTYSRV device dependent routine to perform hang-up action
;
;Call:	T2/ Line Number

XRENT	(LTHNGU,G)		;[7.1024]LTHNGU::, XLTHNG:
	SAVEAC	<T2>		;Caller wants this back intact
	CALLX	(MSEC1,STADYN)	;[7.1024]Get the dynamic data base
	 RET			;There is none
	MOVX	T1,SBSTO	;Mark to send STOP slot if necessary
	CALL	LTSSDC		;(CALLRET won't work here)
	RET

; TTYSRV device dependent routine to see if output is possible on a line
;
; Call:	T2/ TDB Address
;	Non-skip Return/ Output not possible
;	Skip Return    / Output possible

XRENT	(LTTCOU,G)		;[7.1024]LTTCOU::, XLTTCO::

	RETSKP

; TTYSRV device dependent routine to set LAT Host terminal lines as 
; high speed lines.
;
;RETSKP always with:
;	T3/ ^D9600 to simulate high speed output
;	T4/ IBFRC1 the high speed terminal characteristics word

XRENT	(LTSOF,G)		;[7.1024]LTSOF::, XLTSOF::

	MOVEI	T3,^D9600	;Fake 9600 baud
	MOVE	T4,IBFRC1	;High speed buffer word
	RETSKP			;Always
>;end IFN FTOPS20

IFN FTOPS10,<
	SUBTTL  More SCNSER device dependant routines

;Routine LTHNGU - LAT "disconnect" function
;Called by SCNSER thru ISRREM entry point in dispatch vector with
; a function code if IRRDSC in T3
;
;	U/ LDB address
;	T3/IRRDSC
;	CALL LTHNGU
;	Returns +2 always (note: there is no "error" return)
;
LTHNGU:	MOVX	T1,SBSTO	;Yes, we want to stop this slot
	CALL	LTSSDC		;SO do it
	RETSKP			;And indicate success to SCNSER
;
;Routine LATREM
;Called from SCNSER through dispatch vector element ISRREM (7)
;
;	U/ LDB address
;	T3/ Function code
;		Possible values are:
;		(1) Input buffer low (ignored)
;		(2) Input character not stored (ignored)
;		(IRRSCG) Eat all output characters
;		(IRRDSC) Disconnect LAT terminal
;		(IRRTMO) Disconnect idle terminal
;
LATREM:	CAIN	T3,IRRDSC	;Is the the "disconnect" function?
	 CALLRET LTHNGU	;Yes, do it.
	CAIN	T3,IRRTMO	;Is it the "timeout" function?
	 CALLRET LTHNGU	;Yes, do it.
	CAIE	T3,IRRSCG	;Is it "send character gobbler"?
	 RET			;No, those are all we know about
LTCOBF:	MOVX	T1,SBFOU	;User hit ^O, tell remote to gobble output
LTSSDC:	ACVAR	<HN,XB,RB,CB,SB,W1,W2>
	ETHLOK			;Interlock against races
	SKIPN	SB,LDBLAT##(U)	;Get slot data base from LDB
	 JRST LTSSD0		;Not there any more, ignore
	MOVE	CB,SB.CBA(SB)	;Get circuit data base from slot block.
	CALL	SSBDAV
LTSSD0:	ETHULK			;Release interlock
	RET
>;end IFN FTOPS10
				

	SUBTTL	General Untility Routines

;
;RANDOM - get a "random" number
;
;Call:	T1/ Maximum number allowed
;	CALL RANDOM
;	Normal Return
;	T1/ Random Number

RANDOM:	MOVE	T4,T1		;Save for modulo
IFN FTOPS20,<
	CALLX	(MSEC1,LGTAD)	;[7.1024]Get internal time and date
>;end IFN FTOPS20
IFN FTOPS10,<
	MOVE	T1,DATE##	;get TOPS-10 time and date
>;end IFN FTOPS10
	ANDI	T1,777777	;Time only
	IDIV	T1,T4		;MODULO max, (which is the remainder in T2)
	SKIPN	T1,T2		;GET remainder
	MOVEI	T1,1		;But if it's zero, make it 1
	RET

;GTCHCT - Get character count for terminal output.
;Call:	T2/ TDB address
;Return:
;	T1/ Total character count

IFN FTOPS20,<

GTCHCT:	SETZ	T1,0
	TMNN	TTSAL,(T2)	;Is there a send all in progress?
	IFSKP.			;Yes, must include count of the
	  LOAD T1,TSALC,(T2)	; send all buffer.
	ENDIF.
	ADD	T1,TTOCT(T2)	;Add the terminal buffer count.
	RET

>;END IFN FTOPS20

	ENDAV.
	SUBTTL	LAGTCR - LAT memory management routines

;
;	Subroutine to tell COMMON how much core LAT needs at ONCE time
;
;Call:	CALL LAGTCR
;
;Return: +1 always with T1/ size of memory LAT needs, which is:
;
;		Space for 1 outstanding receive buffer +
;		 for each possible open circuit: MAXXBF transmit buffers
;		  + 1 receive buffer

IFN FTOPS10,<

;	MAX.(BUFSIZ,<RBFSIZ,XBFSIZ>)	;BUFSIZ is size of largest buffer
;	BUFSIZ==BUFSIZ+QL.LEN		;we need + 2 words for linking list
	BUFSIZ==PAGSIZ		;Oh, the hell with it! receive buffers have
				;to be contiguous, so don't bother to
				;split a buffer across a page boundary.
				;Luckily, the actual size of a buffer
				;is slightly smaller than a page.
	NBUFS==<1+<MAXXBF+1>>	;
;


	$CSUB
LAGTCR::
	MOVEI	T1,<BUFSIZ*NBUFS>
	RET
	XRESCD

;
;	Routine to ask for more memory from user free core
;	We should get it a tick or two later.
;
CHKWFB:	SKIPE	T1,LATWFB	;Do we want any more buffers?
	SKIPE	LATRFB		;And have we not yet aksed for them?
	 RET			;No to either, don't get memory now.
;
;	Here we have finally decided it's our turn to ask for some memory
;
	IMULI	T1,BUFSIZ	;Calculate how many words
	TRZE	T1,PG.BDY	;Round up to page bound
	ADDI	T1,PAGSIZ
	MOVEM	T1,LATRFB	;Remember how many words we asked for.
	LSH	T1,W2PLSH	;Convert to pages
	HRLI	T1,(MS.DCN)	;Section to allocate from
	XMOVEI	T2,CHKRFB	;Callback routine address
	XJRST	[MCSEC1+GETCLP##]	;Ask for the space
;
;	CHKRFB - Routine called when VMSER gave us memory
;		If so, link it into free buffer list
;
CHKRFB:	MOVE	T4,T1		;Get address of start
	SETZ	T1,		;Get a zero
	EXCH	T1,LATRFB	;Get number of pages we wanted (and clear it)
	IDIVI	T1,BUFSIZ	;Convert to number of buffers
	ADDM	T1,LATNFB	;Indicate that we've got more
	MOVE	T2,T4		;Get address of first buffer
	MOVE	T4,T1		;save buffer count
ALCBUF:	MOVEI	T1,LATFRE	;QUEUE header for LAT free core
	CALL	QUE1WB		;Link this buffer to the list.
	ADDI	T2,BUFSIZ	;Point to next one.
	SOJG	T4,ALCBUF	;Until all buffers have been allocated.
	RET
;
;	GETZBF - Routine to get a receive or transmit buffer and zero it.
;
;Call:	T1/ required size
;Return: +1 failure
;	 +2 success T1/ address of buffer
;
GETZBF:	PUSH	P,T1		;Save size wanted
	MOVEI	T1,LATFRE	;Address of queue header for free pool
	CALL	UNQ1WF		;Get a buffer
	 JRST TPOPJ		;Couldn't, restore T1 and return.
	SOS	LATNFB		;One less free buffer
	PUSH	P,T2		;SAVE ADDRESS OF BUFFER
	XMOVEI	T3,1(T2)	;POINT TO SECOND WORD
	SETZM	(T2)		;ZERO FIRST WORD
	MOVEI	T1,BUFSIZ-1	;SET UP TO ZERO THE WHOLE BLOCK
	XBLT. T1		;DO IT
	POP	P,T2		;RESTORE ADDRESS
	POP	P,T1		;Restore size
	HRLI	T1,'LAT'	;check word
	MOVEM	T1,(T2)		;save <'LAT',,size> as first word
	HRRZ	T3,T1		;Isolate size
	ADD	T3,T2		;Point to end of buffer
	HRLI	T1,'END'
	MOVEM	T1,1(T3)
	XMOVEI	T1,1(T2)	;POINT to address of data portion
	RETSKP

;
;	GIVBF - Routine to give back a buffer to free pool
;
;Call:	T1/ address of data portion of buffer
;Return: +1 always
;
GIVBF:	SUBI	T1,1		;Point to size word
	HLRZ	T2,(T1)		;Get check code
	HRRZ	T3,(T1)		;Get size
	ADD	T3,T1		;Point to near end of buffer
	HLRZ	T3,1(T3)	;Get ending check code
	CAIN	T3,'END'	;See if either end has been wiped out
	CAIE	T2,'LAT'	;Is it still there?
	 BUG. (CHK,LATMEM,LATSER,SOFT,<LAT buffer overwritten>,<<T1,ADDRESS>>,<
While trying to return a buffer, LATSER discovered it had been overwritten.>)
	MOVE	T2,T1		;Now return the buffer
	MOVEI	T1,LATFRE	;To the queue of free buffers
	AOS	LATNFB		;Count one more buffer available
	CALLRET	QUE1WB		;For re-use
> ;END IFN FTOPS10

MMGTZW:
IFN FTOPS20,<
	CALLRET	DNGWDZ		;[7.1024]
>;END IFN FTOPS20
IFN FTOPS10,<
	MOVEI	T2,1(T1)	;Going to ask for 1 more word for check
	PUSH	P,T2		;save requested size
	SNCALL	(GETEWZ##,MCSEC1)	;Get zeroed core from ethernet free pool
	 JRST TPOPJ		;No luck
	POP	P,T2		;Get back requested size
	ADDI	T1,1		;Point to data portion of block
	MOVEM	T2,-1(T1)	;save length as first word of block
	RETSKP			;And return it to caller
>;END IFN FTOPS10

MMFREE:
IFN FTOPS20,<
	CALLRET	DNFWDS		;[7.1024]
>
IFN FTOPS10,<
	XMOVEI	T2,-1(T1)	;Point to block-1
	HRRZ	T1,(T2)		;Which contains length of block
	XJRST	[MCSEC1+GIVEWS##]	;and give it back to ethernet free pool.
;
;	Subroutine to convert SIXBIT nodename to ASCII
;
;Call:	T1/ SIXBIT node name
;
;Return: +1 always with ASCII in OURNAM, OURNAM+1
;	and character in OURCNT
;
CVTNOD:	SETZM	OURCNT		;No characters yet
	SETZM	OURNAM		;Or name
	SETZM	OURNAM+1	; ...
	JUMPE	T1,RTN		;Done if no characters left
	MOVE	T3,[POINT 7,OURNAM]	;Where to put node name
CVTNO1:	SETZ	T2,		;Zap the temp AC
	ROTC	T1,6		;Get next character into T2
	ADDI	T2,40		;Convert to ASCII
	AOS	OURCNT		;Count characters done
	IDPB	T2,T3		;Put the character into the name
	JUMPN	T1,CVTNO1	;Continue
	RET			;Done
>;END IFN FTOPS10
	XLIST
	LIT

IFN FTOPS10,<
	define	.xcrf1(syms),<
	irp	syms,<purge syms>>
	.xcmsy			;Purge some stupid MACSYM symbols
	PRGALL			;Purge all ..nnnn symbols
>;end IFN FTOPS10

	END