Google
 

Trailing-Edge - PDP-10 Archives - BB-JR93K-BB_1990 - 10,7/mon/d36com.mac
There are 27 other files named d36com.mac in the archive. Click here to see a list.
;TITLE D36COM - Common Routines for DECnet-36


;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  1976,1985,1986,1988.
;ALL RIGHTS RESERVED.


	SUBTTL	V. Brownell, W. Nichols & Tarl Neustaedter
;This is the common routine package for DECnet-36.

	SEARCH D36PAR,MACSYM
IFN FTOPS20,<
	SEARCH SCAPAR
> ;END IFN FTOPS20
	SALL

IFN FTOPS10,<
.CPYRT<1976,1988>
> ;END IFN FTOPS10

IFN FTOPS20,<
	SEARCH PROLOG
	TTITLE D36COM,,< - Common Routines for DECnet-36>
	>

IFN FTOPS10,<
	SEARCH F,S
	TITLE D36COM - Common Routines for DECnet-36
	>

	ENTRY D36INI		;DEFINE AN ENTRY POINT WHICH MUST BE CALLED,
				; SO THAT WE ARE GUARANTEED THIS WILL LOAD

	D36SYM			;SET UP D36 SPECIFIC PARAMETERS


 IFNDEF FTD36MM,FTD36MM==1	;Use DECnet-36 memory manager
	FTBYTBLT==FTOPS20	;NON-ZERO TO USE MONITOR-MONITOR BYTE BLT
	DBGS2==FTOPS20		;NON-ZERO TO DO SAVEAC's OF Q1/Q2 FOR ROUTINES
				; USED BY LLMOP
	FTFIXCOR==0		;NON-ZERO TO FORCE PHYSICALLY CONTIGUOUS
				; BUFFERS.  REQUIRED BY NISRV ONCE UPON A TIME.

IFN FTOPS10,<$RELOC>
	XRESCD			;RELOC TO HIGHSEG (RSCOD PSECT ON TOPS-20)
	SUBTTL	Table of Contents


;		Table of Contents for D36COM
;
;
;			   Section			      Page
;   1. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   2. Definitions
;        2.1.   External References . . . . . . . . . . . . .    3
;        2.2.   Core manager data structures. . . . . . . . .    4
;        2.3.   Mongenable parameters . . . . . . . . . . . .    5
;   3. Data Storage . . . . . . . . . . . . . . . . . . . . .    6
;   4. Definitions
;        4.1.   Memory Manager Tables . . . . . . . . . . . .    7
;   5. MSDs
;        5.1.   Initialize MS pointer for MB input. . . . . .    9
;        5.2.   Initialize MS for input . . . . . . . . . . .   10
;        5.3.   Set up MSD for input on received buffer . . .   11
;        5.4.   Initialize MSD for output . . . . . . . . . .   12
;   6. DNSBP
;        6.1.   Byte routines
;             6.1.1.     Store a byte pointer . . . . . . . .   13
;   7. DNF2WG
;        7.1.   Byte routines
;             7.1.1.     Fetch a two word global from an MSD.   14
;   8. MSDs
;        8.1.   Byte routines
;             8.1.1.     Get a byte . . . . . . . . . . . . .   15
;             8.1.2.     Get two bytes. . . . . . . . . . . .   16
;             8.1.3.     Get HI-ORDER 4 bytes of Ethernet Addr  17
;             8.1.4.     Get six byte Ethernet Address. . . .   18
;             8.1.5.     Get two bytes from specified position  19
;             8.1.6.     Get an extensible field. . . . . . .   20
;             8.1.7.     Get a byte, skip if non-extensible .   21
;             8.1.8.     Put a byte into message. . . . . . .   22
;             8.1.9.     Put two bytes in message . . . . . .   23
;             8.1.10.    Put two bytes to specified position.   24
;             8.1.11.    Put four bytes in message. . . . . .   25
;             8.1.12.    Put HI-ORDER 4 bytes of Ethernet Addr  26
;             8.1.13.    Put six byte Ethernet Address. . . .   27
;             8.1.14.    Put an extensible field into message   28
;             8.1.15.    Put some zero bytes. . . . . . . . .   29
;             8.1.16.    Skip some bytes. . . . . . . . . . .   30
;             8.1.17.    Go Backwards some number of bytes. .   31
;        8.2.   Read and Goto Position. . . . . . . . . . . .   32
;        8.3.   Link a Message Segment into a Message Block .   34
;        8.4.   Copy message block. . . . . . . . . . . . . .   35
;        8.5.   Calculate length of a whole message . . . . .   36
;        8.6.   Calculate Length of Message Segment . . . . .   37
;        8.7.   DNMINI - Initialize an allocated message block  38
;        8.8.   DNCMSD - Copy MSD chain to contiguous block .   39
;   9. Buffers
;        9.1.   Copy buffer to a message segment. . . . . . .   40
;        9.2.   Copy message data to a buffer . . . . . . . .   41
;  10. BYTBLT - Non fancy versions. . . . . . . . . . . . . .   42
;  11. BYTBLT - Fancy version . . . . . . . . . . . . . . . .   43
;  12. Buffers
;       12.1.   Copy user buffer to a message segment . . . .   54
;       12.2.   Copy message data to a user buffer. . . . . .   55
;  13. Core manager
;       13.1.   Smear a block of memory with value. . . . . .   56
;       13.2.   Copy some words . . . . . . . . . . . . . . .   57
;       13.3.   Get Some Words. . . . . . . . . . . . . . . .   58
;       13.4.   Get Some Zeroed Words . . . . . . . . . . . .   59
;       13.5.   Free Some Words . . . . . . . . . . . . . . .   60
;       13.6.   Get a DECnet-36 message block . . . . . . . .   61
;       13.7.   Free a DECnet-36 message block. . . . . . . .   63
;       13.8.   Fixed size block allocation entry points. . .   64
;       13.9.   Memory manager initialization code. . . . . .   66
;       13.10.  Increment count of emergency buffers. . . . .   68
;       13.11.  Return number of blocks available (for router)  69
;       13.12.  Get a Block from a Free Pool. . . . . . . . .   70
;  14. DNMCUB - Check for trashed UBL . . . . . . . . . . . .   72
;  15. Core manager
;       15.1.   Checking routines for debugging only. . . . .   73
;       15.2.   Check pointer for validity. . . . . . . . . .   74
;  16. Time
;       16.1.   Get current time in ms. . . . . . . . . . . .   76
;  17. Network management
;       17.1.   NTPARM - parameters . . . . . . . . . . . . .   77
;       17.2.   NTCTRS - counters . . . . . . . . . . . . . .   78
;  18. Trace
;       18.1.   Interface for exec-mode trace.. . . . . . . .   79
;       18.2.   SCAN's output routines. . . . . . . . . . . .   80
;       18.3.   Routine store character in shared buffer. . .   81
;  19. TOPS10
;       19.1.   AC save routines. . . . . . . . . . . . . . .   82
;  20. Kontroller data. . . . . . . . . . . . . . . . . . . .   83
;  21. Initialization routines. . . . . . . . . . . . . . . .   84
;  22. DCNJB0 - DECnet periodic checks. . . . . . . . . . . .   85
;  23. NMX
;       23.1.   Privilege checking routine. . . . . . . . . .   86
;       23.2.   Time stamp a queued even block. . . . . . . .   87
;  24. TESTSB
;       24.1.   Assert that Code is Running in section 1. . .   90
;  25. TOPS20
;       25.1.   User mode checking routines.. . . . . . . . .   91
;  26. End of D36COM. . . . . . . . . . . . . . . . . . . . .   92
	SUBTTL Definitions -- External References

;External monitor symbols

	EXT %RTBSZ		;Default executor block size (STG)
	EXT %DLBSZ		;Default maximum buffer size

;External monitor routines

	EXT RTN
	EXT RSKP
	EXT XBLTA
	EXT XBLTAT

;References into layers.

	EXT SCJINI		;Initialize SCJSYS
	EXT SCTINI		;Initialize session control, NSP and ROUTER
	EXT SCTSEC		;SCLINK once-a-second routine
	EXT NSPJIF		;LLINKS once-a-jiffy routine
	EXT RTRON		;To turn ROUTER on
	EXT RTRJIF		;ROUTER once-a-jiffy routine
	EXT RTRSEC		;ROUTER once-a-second routine
	EXT DNDJIF		;DNADLL once-a-jiffy routine
	EXT NSPCG		;TO TELL NSP ABOUT CONGESTION
	EXT NSPCR		;..
	EXT NSPJB0		;NSP periodic checks
	EXT NRTINI		;Initialize NRT

;AC definition.

	XP FL,FREE1		;NEEDED BY MEMORY MANAGER. SAVES POINTER HERE
	XP LH.ALF,<777777,,0>	;LEFT HALF QUANTITY


;Explanation of Byte Pointer Usage:
;
;In order to make the byte pointers in MDPTR and MDAUX work on
;both extended and non-extended machines, we build indexed byte
;pointers, with a Y field of zero initially.  The byte pointers
;are always indexed by T6, which is loaded from MDALA at the
;beginning of every DNxxx routine.  VGNPTR is used to point
;readers to this comment.

	VGNPTR==:<POINT 8,0(T6)>
	SUBTTL Definitions -- Core manager data structures

BEGSTR FB
	WORD NXT		;Forward pointer in a free block
ENDSTR

BEGSTR CH			;Core handler structure
	WORD BOT		;Pointer to free pool start
	WORD PTR		;pointer to first free block
	WORD AVL		;Number of available blocks
	HWORD LWM		;;; Low water mark
	HWORD REQ		;;; Size requested
;The following 3 fields are expected to be in the last word, see CHBLKS
	FIELD CON,1		;Set if this block type subject to congestion
	FIELD NUM,17		;Total blocks, alloc & unalloc.
	HWORD SIZ		;Size of blocks.
ENDSTR

;On TOPS10, structure MI is referenced by COMMON.MAC with HRRZ and other
;non-BEGSTR instructions so don't change MI rashly!

BEGSTR MI
	HWORD SIZ		;SIZE (IN WORDS) OF THE BLOCK
	HWORD CNT		;NUMBER OF BLOCKS
ENDSTR

	SUBTTL Definitions -- Mongenable parameters


;These are some default router parameters:

	RADIX 10		;NETWORK MANGLEMENT IS DECIMAL

DEFINE MP(SYMBOL,VALUE),<	;SYMBOLS DEFINED WITH MP ARE MONGENABLE
IFN FTOPS10,<EXTERN SYMBOL>	;;DEFINED IN COMDEV ON TOPS-10
IFN FTOPS20,<XP SYMBOL,VALUE>	;;AND THUS NOT DEFINED HERE ON TOPS10
>

IFN FTP4R,MP %RTMXN,1023	;MAXIMUM NODE NUMBER
	MP %RTMX3,255		;DEFAULT MAXIMUM NODE ADDRESS FOR ROUTER
	MP %RTTM3,<15*1000>	;DEFAULT HELLO FREQUENCY TIMER
	MP %RTTM4,<30*1000>	;DEFAULT NODE LISTENER TIMER
	MP %RTITM,<1*60*1000>	;INITIALIZATION TIMER
	MP %RTT3M,2		;HELLO TIMER MULTIPLIER FOR NON-BROADCAST
	MP %RTB3M,3		;HELLO TIMER MULTIPLIER - BROADCAST ADJACENCIES
	MP %RTADR,1		;DEFAULT LOCAL ADDRESS
	MP %RTHOM,1		;DEFAULT HOME AREA
	MP %RTRTY,RNT.L1	;DEFAULT ROUTER TYPE (ROUTING)
	MP %RTCTS,1		;Default cost for TST device
	MP %RTCDT,3		;Default cost for DTE device
	MP %RTCKD,4		;Default cost for KDP device
	MP %RTCDD,5		;Default cost for DDP device
	MP %RTCCI,2		;Default cost for CI device
	MP %RTCET,1		;Default cost for Ethernet device
	MP %RTCDM,2		;Default cost for DMR device
	MP %RTMXR,16		;Default maximum number of routers on an NI
	MP %RTBRA,32		;MAXIMUM NUMBER OF BROADCAST ROUTER ADJACENCIES
	MP %RTBEA,64		;MAXIMUM NUMBER OF END NODE ADJACENCIES
	MP %RTCTO,<60*1000>	;Endnode cache timeout
	MP %RTPRI,5		;OUR PRIORITY TO BE THE DESIGNATED ROUTER
	MP %RTMXC,100		;MAXIMUM LINE COST
	MP %RTMXH,16		;MAXIMUM HOPS
	MP %RTMXV,20		;DEFAULT MAXIMUM VISITS
	MP %RTTM1,<10*60*1000>	;DEFAULT MAXIMUM ROUTING MESSAGE INTERVAL (P-P)
	MP %RTBT1,<40*1000>	;DEFAULT MAXIMUM ROUTING MESSAGE INTERVAL (NI)
	XP %RTEHS,<2+7-6+21+4>	;Ethernet header size, composed of:
				;+2 Ethernet padding bytes
				;+7 Router Phase-IV pad bytes
				;-6 corrects for assumed Phase III header
				;+21 allows for full P-IV NI header
				;+4 allows for 4 KLNIA CRC bytes (input)
				;   & for byte misalignment after BLT (output)
	XP %RTVER,2		;VERSION OF ROUTER
	XP %RTECO,0		;EDIT LEVEL OF ROUTER
	XP %RTCUS,0		;CUSTOMER VERSION NUMBER

;These are LLINKS default parameter values:

	MP %NSDLY,<3*16>	;Delay factor
	MP %NSWGT,10		;Delay weight
	MP %NSINA,120		;Inactivity timer
	MP %NSRTH,10		;Retransmission threshold
	MP %NSFLR,1000		;Delay floor
	MP %NSRUF,10000		;Delay roof
	MP %NSADL,2		;ACK delay in seconds

;These are Session Control default parameter values:

	XP %SCHDR,<11+6>       	;LENGTH OF HEADERS BELOW SESSION CONTROL
				;11 IS MAX NSP HEADER LENGTH (PHASE IV)
				;6 IS ARCHITECTURALLY DEFINED RTR HDR OVERHEAD
	XP %SCP2Q,1		;PHASE II QUOTA
	MP %SCINT,<30*1000>	;INCOMING TIMER VALUE
	MP %SCOTT,<1*60*1000>	;OUTGOING TIMER VALUE

	RADIX 8			;LCG IS OCTAL

;Keep these definitions here! They need to be defined in OCTAL radix.

	XP %RTHIO,<<BYTE (8)252,0,4,0(4)0>> ;HIORD AA-00-04-00(16)
	XP %RTRMA,<<BYTE (8)253,0,0,3(4)0>> ;Multicast ID "ALL ROUTERS"
					    ; AB-00-00-03
	XP %RTEMA,<<BYTE (8)253,0,0,4(4)0>> ;Multicast ID "ALL ENDNODES"
					    ; AB-00-00-04
	SUBTTL	Data Storage

	RESDT

;Define static incarnation of DECnet-36 initialization block

	ASSUME IB.PH2,EQ,0
	ASSUME IB.RTR,EQ,0
	ASSUME IB.FCM,EQ,0
	ASSUME IB.NAM,EQ,1
	ASSUME IB.ADR,EQ,2
	ASSUME IB.MXA,EQ,3
	ASSUME IB.MXB,EQ,4
	ASSUME IB.DGL,EQ,5
	ASSUME IB.DBL,EQ,6
	ASSUME IB.BIP,EQ,7
	ASSUME IB.BSZ,EQ,10

IBBLK::	0B<POS(IBPH2)>!<%RTRTY>B<POS(IBRTR)>!<FCM.SG>B<POS(IBFCM)> ;IBFLG
IFN FTOPS20,<
	SIXBIT /TOPS20/			    	;IBNAM
	<%RTHOM>B<POS(RN%ARE)>!<%RTADR>B<POS(RN%NOD)>	;IBADR
>; END IFN FTOPS20
IFN FTOPS10,<
	0					;IBNAM
	0					;IBADR
>; END IFN FTOPS10
	EXP %RTMXN			    	;IBMXA
	EXP ^D80			    	;IBMXB
	EXP ^D0					;IBDGL
	EXP ^D8				    	;IBDBL
	EXP ^D50				;IBBIP
	EXP %DLBSZ			    	;IBBSZ

;
D36IFG::EXP 0			;0 before DECnet initializes,
				;+1 while   -"-      -"-
				;-1 after   -"-      -"-

DCNSTA::EXP DS.OFF		;INITIALLY OFF, STATES ARE IN D36PAR

DNDEFS::EXP <FLD(0,PDGOL)>!<FLD(^D16,PDDQT)>!<FLD(^D50,PDIPR)>
			 	;Flow control - Goal, Quota, Input percentage

RTRADR::EXP 0+<IFN FTOPS20,<%RTADR>> ;Our local address, setable with SETSPD
RTRHOM::EXP 0+<IFN FTOPS20,<%RTHOM>> ;Default area to which this ROUTER belongs
RTRHIO::%RTHIO			;Hi-order DECnet Ethernet address
RTRLOO::EXP 0			;Low order part of Ethernet address (computed
				; at startup by Router)
RTRBSZ::%RTBSZ 			;Default block size
RTRMXN::%RTMXN			;MAXIMUM NODE NUMBER
RTRMX3::%RTMX3			;MAXIMUM PHASE III NODE ADDRESS
EVSDRP::EXP 0			;NON-ZERO TO HAVE ROUTER SNOOP ROUTING INFO
RTRVER::%RTVER			;VERSION OF OUR ROUTER
RTRECO::%RTECO			;EDIT LEVEL OF ROUTER
RTRCUS::%RTCUS			;CUSTOMER ARGUMENT

;Freecore pointers

IFN FTOPS10,<
	.LINK	.LKAHB,DCNAHB	;ADD TO SYSTEM-WIDE LINKED LIST
DCNAHB::BLOCK	AHBLEN		;MEMORY ALLOCATION HEADER BLOCK
DCNAEB::BLOCK	AEBLEN		;MEMORY ALLOCATION EXTENT BLOCK
DCNTCR:	BLOCK	1		;TOTAL DECNET CORE REQUIREMENTS
DCNCOR::BLOCK	1		;POINTER TO DECNET CORE
DCNVFF::BLOCK	1		;DECNET FIRST FREE LOCATION
>; END IFN FTOPS10

DCNEMR:	BLOCK	1		;EMERGENCY MESSAGE BLOCK THRESHOLD
DCNTSB::BLOCK	1		;TOTAL SYSTEM BUFFERS (SET UP IN D36INI)
DCNCON::BLOCK	1		;NON-ZERO IF SYSTEM IS CONGESTED
DCNRSB::BLOCK	1		;RESERVED BUFFERS, MODIFIED UNDER SYSPIF
				; TO PROTECT AGAINST SCTRIB CALL FROM LLINKS
DCNRHT::BLOCK	1		;HIGH TIDE FOR DCNRSB

DCNRIF::BLOCK	1		;INPUT RESERVATION FAILURES
DCNROF::BLOCK	1		;OUTPUT RESERVATION FAILURES
DCNCNG:	DEC	5		;CONGESTION MESSAGE BLOCK THRESHOLD
DCNUCG:	DEC	7		;UNCONGESTION MESSAGE BLOCK THRESHOLD

IFN FTOPS10,<
EV96.0::0			;DON'T LOG EVENT 96.0
DCNTIM:	^D10			;DCNJB0 COUNTDOWN TIMER (SECONDS)
>; END IFN FTOPS10

IFN FTTRACE!FTMINTrace,<

;;NOTE - ALL THESE VALUES MUST BE SET BY SNOOP. THERE IS NO CHECKING
;WHATSOEVER THAT THE MONITOR DOES ON THEM - IT MERELY USES THEM.

ZERBPT::BLOCK 1			;FIRST BYTE POINTER IN USER'S BUFFER
CURBPT::BLOCK 1			;CURRENT BYTE POINTER
MAXBYT::BLOCK 1			;MAXIMUM NUMBER OF BYTES TO USE IN BUFFER
LASBYT::BLOCK 1			;LAST BYTE TO USE IN BUFFER (.GT. MAXBYT)
CURBYT::BLOCK 1			;CURRENT BYTE POSITION IN BUFFER
TRAJOB::BLOCK 1			;NUMBER OF JOB DOING THE TRACE
S.ETRA::BLOCK 1			;ERROR TRACE BITS
S.TRAC::BLOCK 1			;THE ORDINARY TRACE MASK

> ;END IFN FTTRACE!FTMINTrace

	XRESCD
	SUBTTL Definitions -- Memory Manager Tables

;Memory Management Definitions

;$NAM -	Three-character name of block type
;$SIZ -	Size of block in words, DNGRBL overhead added in DEFBLK macro
;$CNT -	Number of blocks
;$CON - Flag saying this block type is subject to congestion control

DEFINE BLKDFS,<
;;		$NAM,	$SIZ,	 $CNT,	$CON
   IFN FTD36MM,<
	DEFBLK (SBL,	^D7,	 ^D145,		) ;;SMALL BLOCKS
	DEFBLK (ABL,	^D31,	 ^D250,		) ;;ARBITRARY BLOCKS
	DEFBLK (BBL,	^D78,	 ^D140,		) ;;SLIGHTLY LARGER ARB. BLOCKS
;Increase LBL's by 15. for multinode CI testing /mp
	DEFBLK (LBL,	^D510,	 ^D35,		) ;;LARGE BLOCKS
						  ;; (These must fit on 1 page)
   IFE FTHMMEM,<
	DEFBLK (VBL,    ^D2058,  ^D3,           ) ;;VERY LARGE BLOCKS
   >
   IFN FTHMMEM,<				  ;;One extra for MRQTAB
	DEFBLK (VBL,    ^D2058,  ^D4,           ) ;;VERY LARGE BLOCKS
   >
   >;END IFN FTD36MM
;	DEFBLK (EBL,	^D60,	 ^D4,		) ;;EVENT BLOCKS
	DEFBLK (MBL,	MB.LEN,  ^D100,	CONGEST	) ;;MESSAGE BLOCKS
	DEFBLK (UBL,    0,	  ^D80,	CONGEST	) ;;USER-DATA BLOCKS
>;END DEFINE BLKDFS

IFE FTD36MM,<VBLSIZ==^D2058>	;NEEDED IN DNSWDS

;The following page(s) expand this macro to define the tables and symbols
;used by the memory manager (DNINIM, DNGRBL and DNFRBL)
IFE FTLSTCOR,<OVHWDS==1>
IFN FTLSTCOR,<OVHWDS==4>

;Now define symbols for $SIZ and $CNT

DEFINE DEFBLK($nam,$siz,$cnt),<
	$nam'SIZ==:$siz+OVHWDS	;;SIZE OF BLOCKS IN DECIMAL WORDS + OVERHEAD
	$nam'CNT==:$cnt		;;NUMBER OF BLOCKS
	..CORS==..CORS+<$nam'SIZ*$cnt>
>;END DEFINE DEFBLK

	..CORS==0		;INITIALIZE TOTAL MEMORY COUNTER
	BLKDFS			;DEFINE SYMBOLS

IFN CH.LEN-CH.SIZ-1,<PRINTX ? CHBLKS defined wrong>
IFN CH.NUM-CH.SIZ,  <PRINTX ? CHBLKS defined wrong>
IFN CH.CON-CH.SIZ,  <PRINTX ? CHBLKS defined wrong>

DEFINE DEFBLK($nam,$siz,$cnt,$con),<
	..CON==0		;;ASSUME NO CONGESTION CONTROL ON THIS BLK TYPE
IFNB <$con>,<..CON==1>		;;IF CONTROLLED, SET 1-BIT FLAG
	$nam'CB: BLOCK CH.LEN-2
	EXP <FLD(<$cnt>,CHLWM)>
	EXP <FLD(<..con>,CHCON)>!<FLD(<$nam'SIZ>,CHSIZ)>!<FLD(<$cnt>,CHNUM)>
	PURGE ..CON
>;END DEFINE DEFBLK

	RESDT

CHBLKQ:	CHBLKN			;FOR GETTAB PURPOSES. DO NOT MOVE
CHBLKS::!BLKDFS			;VECTOR OF CH BLOCKS
CHBLKN==<.-CHBLKS>/CH.LEN	;NUMBER OF CH BLOCKS WE HAVE

IFN FTHMMEM,<
MRQTAB::BLOCK 1			;Pointer to memory request table
MRQMAX: BLOCK 1			;Maximum table address
>  ;END FTHMMEM

	XRESCD
	SUBTTL MSDs -- Initialize MS pointer for MB input

;DNGINI - Initialize MS for input (DNGxxx routines)
;
; Call:
;	T1/ Pointer to Input Message Block
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,T2,MS
;
;Note:  We are assuming that someone has set up the dynamic byte
;pointer and the count when the message came in (usually the DLL will
;have done this).  The DNGxxx routines use the dynamic byte pointer and
;count to go through the message.
;
;Callers assume that is it OK to call this routine more than
;once on a given message.
;
;This routine works for MB's only.

	INTERNAL DNGINI
	XRESCD
DNGINI:
	XMOVEI MS,IN.MSD(T1)	;POINT TO THE INPUT MSD
	RET			; AND RETURN
	SUBTTL MSDs -- Initialize MS for input

;DNGMSI - Initialize an MSD for a raw (empty) buffer
;
; Call:
;	T1/ MSD address
;	T2/ Buffer Address
;	T3/ Buffer Length in bytes
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS
;

	XRESCD
DNGMSI::
	MOVE MS,T1		;MAKE MS POINT TO MSD
	SETZRO MDNXT,(MS)	;INPUT MSD's CAN'T BE CHAINED
	MOVX T1,VGNPTR		;BUILD A VIRGIN BYTE POINTER
	STOR T1,MDAUX,(MS)	;STORE THE BYTE POINTER FOR LATER PEOPLE
	STOR T1,MDPTR,(MS)	; AND STORE THE DYNAMIC BYTE POINTER
	STOR T2,MDALA,(MS)	;STORE BUFFER ADDRESS
	SETZRO MDBYT,(MS)	;NOTHING RECEIVED YET
	STOR T3,MDALL,(MS)	;SET BUFFER LENGTH
	RET			; AND RETURN
	SUBTTL MSDs -- Set up MSD for input on received buffer

;DNGMSS - Set up an initialized MSD to point to received data
;
; Call:
;	T1/ MSD address
;	T2-T3/ 2 word global pointer to data in receive buffer
;	T4/ Receive data length in bytes
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS
;

	XRESCD
DNGMSS::
	MOVE MS,T1		;MAKE MS POINT TO MSD
	STOR T4,MDBYT,(MS)	;SET RECEIVED BYTE COUNT
	LOAD T1,MDALA,(MS)	;GET RAW BUFFER ADDRESS
	SUB T3,T1		;GET WORD OFFSET TO RECEIVE DATA IN BUFFER
	ADDI T2,(T3)		;ADD OFFSET IN E-field OF POINTER
	TXZ T2,1B12		;CLEAR 2 word global bit
	TLO T2,T6		;SET STANDARD INDEX FOR VGNPTR
	STOR T2,MDPTR,(MS)	;STORE POINTER
	RET			; AND RETURN
	SUBTTL MSDs -- Initialize MSD for output

;DNPINI - Initialize MSD ptr and count for output (DNPxxx routines)
;
; Call:
;	T1/ Pointer to MSD to initialize
;It is assumed that the byte pointer wanted starts at the allocated
;address of the MSD (MDALA).
;
; Return:
;	RET			;ALWAYS, LEAVING T1 ALONE
;
; Uses: T1,T2,MS
;
;The DNPxxx routines will use the byte pointers and byte count in the
;MSD.  There are two byte pointers, one which is updated all the time
;and one which is left alone for future people to use.

	XRESCD
DNPINI::
	MOVE MS,T1		;MAKE MS POINT TO MSD
	MOVX T2,VGNPTR		;BUILD A VIRGIN BYTE POINTER
	STOR T2,MDAUX,(MS)	;STORE THE BYTE POINTER FOR LATER PEOPLE
	STOR T2,MDPTR,(MS)	; AND STORE THE DYNAMIC BYTE POINTER
	SETZRO MDBYT,(MS)	;JUST IN CASE
	RET			;ONLY RETURN


;DNPINR is a variant of DNPINI for re-initializing an MSD which is to
;have data added to it.

	XRESCD
DNPINR::
	MOVE MS,T1		;MAKE MS POINT TO MSD
	RET			;THAT'S ALL FOR A RE-INITIALIZATION

	SUBTTL DNSBP -- Byte routines -- Store a byte pointer

;DNSBP - Store a byte pointer into an MSD
;
; Call:
;	T1 & T2/ Byte pointer of any type, except OWGBP, indexed or indirect
;	T3/ Pointer to MSD to modify
;
;DNSBP makes the indicated MSD point to the same byte as the passed byte
;pointer.

	INTERNAL DNSBP
	XRESCD
DNSBP:	LDB T4,[POINT 6,T1,5]	; Fetch P field of byte pointer
	CAILE T4,44		; One word global?
	  BUG.(HLT,COMBBP,D36COM,SOFT,<DNSBP called with OWGBP>,,<

Cause:	DNSBP was called with a one-word global byte pointer.  DNSPB is
	only set up to handle local one-word and two-word byte pointers,
	without indexing or indirection.

Action:	Either change the caller to pass a two-word byte pointer or upgrade
	DNSBP to handle OWGBPs.
>)
	TXZN T1,1B12		; Two word byte pointer?
	 HRRZ T2,T1		;  No, one word pointer.  Fetch Y field.
	OPSTR <SUB T2,>,MDALA,(T3) ; Compute Y field for MDPTR
	HRR T1,T2		; Install it
	TXZ T1,37B17		; Clear indexing and indirection
	TXO T1,<(T6)>		; Use index AC T6
	STOR T1,MDPTR,(T3)	; Save the byte pointer
	RET

	SUBTTL DNF2WG -- Byte routines -- Fetch a two word global from an MSD

;DNF2WG - Fetch a two word global byte pointer from an MSD
;
; Call:
;	T1/ Pointer to MSD
; Return: T1 & T2/ Two word global byte pointer
;

	INTERNAL DNF2WG
	XRESCD
DNF2WG:	LOAD T2,MDALA,(T1)	; Fetch Y field for byte pointer
	LOAD T1,MDPTR,(T1)	; Fetch P & S fields
	TXC T1,<1B12+<(T6)>>	; Clear AC and @, set two word global
	RET

	SUBTTL MSDs -- Byte routines -- Get a byte

;DNG1BY - Get one byte from message
;
; Call:
;	MS/ Pointer to current MSD in use
;
; Return:
;	RET			;RAN OUT OF BYTES
;	RETSKP			;SUCCESS: T1 CONTAINING BYTE
;
; Uses: T1,MS

	INTERNAL DNG1BY
	XRESCD
DNG1BY:	LOAD T6,MDALA,(MS)	;;SET UP INDEX FOR MDPTR
	OPSTRM <SOS T1,>,MDBYT,(MS) ;;UPDATE THE COUNT
	JUMPL T1,RTN		;;RETURN IF WE RAN OUT
	OPSTRM <ILDB T1,>,MDPTR,(MS) ;;GET THE NEXT BYTE
	RETSKP			;TO SENDER
	SUBTTL MSDs -- Byte routines -- Get two bytes

;DNG2BY - Get two bytes from message
;
; Call:
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WHEN WE'RE OUT OF BYTES
;	RETSKP			;SUCCESS: WITH T1 CONTAINING THE 16 BIT BYTE
;
; Uses: T1,T2,MS

	INTERNAL DNG2BY
	XRESCD
DNG2BY:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	MOVX T1,-2		;WE NEED TWO BYTES
	OPSTRM <ADDB T1,>,MDBYT,(MS) ;UPDATE STRING COUNT
	JUMPL T1,RTN		;IF THERE ISN'T ENOUGH ROOM, LEAVE
	OPSTRM <ILDB T1,>,MDPTR,(MS) ;GET THE LOW BYTE
	OPSTRM <ILDB T2,>,MDPTR,(MS) ;GET THE NEXT BYTE
	LSH T2,^D8		;PLACE IT IN THE HIGH POSITION
	IOR T1,T2		;MAKE UP 16-BIT VALUE
	RETSKP			; AND RETURN TO SENDER

	SUBTTL MSDs -- Byte routines -- Get HI-ORDER 4 bytes of Ethernet Addr

;DNGHIO - Get high order four bytes of Ethernet address from message
;
; Call:
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WHEN WE'RE OUT OF BYTES
;	RETSKP			;SUCCESS: WITH
;			T1/ Ethernet Address, bytes 0,1,2,3 left justified
;
; Uses: T1,T2,T3,MS

	INTERNAL DNGHIO
	XRESCD
DNGHIO:	STKVAR <STG>
	SETZM STG
	MOVX T2,<POINT 8,STG>	;POINT TO 4 BYTE STRING
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	HRLZI T3,<-4>		;SET UP LOOP COUNT
DNGHI1:	OPSTRM <SOS T1,>,MDBYT,(MS) ;;UPDATE THE COUNT
	JUMPL T1,RTN		;;RETURN IF WE RAN OUT
	OPSTRM <ILDB T1,>,MDPTR,(MS) ;GET CURRENT BYTE
	IDPB T1,T2		;OUTPUT CURRENT BYTE
	AOBJN T3,DNGHI1		;DO ALL 4 BYTES
	MOVE T1,STG		;MAKE 4 BYTE STRING ON STACK
	RETSKP			;AND GIVE HIM A GOOD RETURN
	ENDSV.

	SUBTTL MSDs -- Byte routines -- Get six byte Ethernet Address

;DNGENA - Get six byte Ethernet address from message
;
; Call:
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WHEN WE'RE OUT OF BYTES
;	RETSKP			;SUCCESS: WITH
;			T1/ Ethernet Address, bytes 0,1,2,3 left justified
;			T2/ Ethernet Address, bytes 4,5 left justified
;
; Uses: T1,T2,T3,MS

	INTERNAL DNGENA
	XRESCD
DNGENA:	STKVAR <STG1,STG2>
	SETZM STG1		;MAKE FOR CLEAN RESULT
	SETZM STG2
	MOVX T2,<POINT 8,STG2>	;POINT TO 6 BYTE STRING
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	HRLZI T3,<-6>		;SET UP LOOP COUNT
DNGEN1:	OPSTRM <SOS T1,>,MDBYT,(MS) ;;UPDATE THE COUNT
	JUMPL T1,RTN		;;RETURN IF WE RAN OUT
	OPSTRM <ILDB T1,>,MDPTR,(MS) ;GET CURRENT BYTE
	IDPB T1,T2		;OUTPUT CURRENT BYTE
	AOBJN T3,DNGEN1		;DO ALL 6 BYTES
	DMOVE T1,STG2		;MAKE 6 BYTE STRING ON STACK
	RETSKP			;AND GIVE HIM A GOOD RETURN
	ENDSV.

	SUBTTL MSDs -- Byte routines -- Get two bytes from specified position
;DNG2BS - Get two bytes from message at a specified position
;
; Call:	T1/ Beginning byte position
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WHEN WE'RE OUT OF BYTES
;	RETSKP			;SUCCESS: WITH T1 CONTAINING THE 16 BIT BYTE
;
; Uses: T1,T2,T3,MS
DNG2BS::LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
;Need to check if went past end of message
;This code only checks for buffer exceeded
;	MOVX T1,-2		;WE NEED TWO BYTES
;	OPSTRM <ADDB T1,>,MDBYT,(MS) ;UPDATE STRING COUNT
;	JUMPL T1,RTN		;IF THERE ISN'T ENOUGH ROOM, LEAVE
	MOVEI T2,2(T1)
	OPSTRM <SUB T2,>,MDALL,(MS)
	JUMPG T2,RTN		;IF THERE ISN'T ENOUGH ROOM, LEAVE
	OPSTRM <ADJBP T1,>,MDAUX,(MS) ;ADJUST TO SPECIFIED BYTE POSITION
	MOVE T3,T1		;SAVE ADJUSTED POINTER FOR USE
	ILDB T1,T3		;GET THE LOW BYTE
	ILDB T2,T3		;GET THE NEXT BYTE
	LSH T2,^D8		;PLACE IT IN THE HIGH POSITION
	IOR T1,T2		;MAKE UP 16-BIT VALUE
	RETSKP			; AND RETURN TO SENDER
	SUBTTL MSDs -- Byte routines -- Get an extensible field

;DNGEBY - Get an extensible field from message
;
; Call:
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;IF WE RAN OUT OF BYTES
;	RETSKP			;SUCCESS: WITH T1 CONTAINING THE BYTE
;
; Uses: T1-T4,MS

	XRESCD
DNGEBY::
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	SETZ T1,		;BUILD BYTE IN T1
	MOVE T3,[POINT 7,T1,35]	;MAKE BYTE POINTER FOR BUILDING BYTE
DNGEB1:	OPSTRM <SOS T4,>,MDBYT,(MS) ;DECREMENT THE COUNT
	JUMPL T4,RTN		;GIVE ERROR RETURN IF WE'RE OUT
	OPSTRM <ILDB T2,>,MDPTR,(MS) ;GET THE NEXT BYTE
	DPB T2,T3		;PUT IT IN WORD WE'RE BUILDING
	TRNN T2,200		;IS IT EXTENSIBLE
	RETSKP			;NO, RETURN
	ADD T3,[7B5]		;CONTINUE BUILDING
	JRST DNGEB1		; BY LOOPING
	SUBTTL MSDs -- Byte routines -- Get a byte, skip if non-extensible

;DNGSBY - Get a byte, giving non-skip return if extensible
;
; Call:
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WE GOT AN EXTENSIBLE BYTE OR RAN OUT OF BYTES
;	RETSKP			;T1 CONTAINING THE BYTE
;
; Uses: T1,MS

	INTERNAL DNGSBY
	XRESCD
DNGSBY:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	OPSTRM <SOS T1,>,MDBYT,(MS) ;DECREMENT THE COUNT
	JUMPL T1,RTN		;IF WE'RE OUT, GIVE ERROR RETURN
	OPSTRM <ILDB T1,>,MDPTR,(MS) ;YUP, GET NEXT ONE
	TRNN T1,200		;IS IT EXTENSIBLE?
	AOS (P)			;GIVE GOOD RETURN
	RET			;RETURN
	SUBTTL MSDs -- Byte routines -- Put a byte into message

;DNP1BY - Place one byte into message
;
; Call:
;	T1/ The byte
;	MS/ Pointer to current output MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS

	INTERNAL DNP1BY
	XRESCD
DNP1BY:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	OPSTRM <IDPB T1,>,MDPTR,(MS) ;PUT BYTE IN MESSAGE
	INCR MDBYT,(MS)		;INCREMENT THE COUNT
	RET			;RETURN TO SENDER
	SUBTTL MSDs -- Byte routines -- Put two bytes in message

;DNP2BY - Place two bytes into message stream
;
; Call:
;	T1/ 2 bytes (a PDP-11 word)
;	MS/ Pointer to current output MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS

	XRESCD
DNP2BY::
  IFN DBGS2,<SAVEAC <T6>>	;*LLMOP*
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT FIRST PART OF WORD
	LSH T1,-^D8		;SHIFT A BYTE
	OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT NEXT PART
	MOVEI T1,2		;WE DID TWO BYTES
	OPSTRM <ADDM T1,>,MDBYT,(MS) ;INCREMENT THE COUNT
	RET			;RETURN TO SENDER

	SUBTTL MSDs -- Byte routines -- Put two bytes to specified position
;DNP2BS - Put two bytes in message at a specified position
;
; Call:	T1/ Beginning byte position
;	T2/ 2 bytes (a PDP-11 word)
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;WHEN WE'RE OUT OF BYTES
;	RETSKP			;SUCCESS: WITH T1 CONTAINING THE 16 BIT BYTE
;
; Uses: T1,T2,T3,MS

	XRESCD
DNP2BS::
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
;	MOVEI T3,2(T1)
;	OPSTRM <SUB T3,>,MDALL,(MS)
;	JUMPG T3,RTN		;IF THERE ISN'T ENOUGH ROOM, LEAVE
	OPSTRM <ADJBP T1,>,MDAUX,(MS) ;ADJUST TO SPECIFIED BYTE POSITION
	IDPB T2,T1		;PUT THE LOW BYTE
	LSH T2,-^D8		;SHIFT TO HI BYTE
	IDPB T2,T1		;PUT THE NEXT BYTE
	RET			; AND RETURN TO SENDER

	SUBTTL MSDs -- Byte routines -- Put four bytes in message

;DNP4BY - Place four byte value into message stream
;
; Call:
;	T1/ 4 bytes (a PDP-11 double word)
;	MS/ Pointer to current output MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS

	INTERNAL DNP4BY
	XRESCD
DNP4BY:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	HRLZI T2,<-4>		;SET UP LOOP COUNT
DNP4B1:	OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT FIRST BYTE OF WORD
	LSH T1,-^D8		;SHIFT TO NEXT BYTE
	OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
	AOBJN T2,DNP4B1		;DO ALL BYTES IN WORD
	RET			;RETURN TO SENDER

	SUBTTL MSDs -- Byte routines -- Put HI-ORDER 4 bytes of Ethernet Addr

;DNPHIO - Put high order four bytes of Ethernet address in message
;
; Call:
;	T1/ Ethernet Address, bytes 0,1,2,3 left justified
;	MS/ Pointer to current output MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,T2,MS

	INTERNAL DNPHIO
	XRESCD
DNPHIO:	STKVAR <STG>
	MOVEM T1,STG		;MAKE 4 BYTE STRING ON STACK
	MOVX T2,<POINT 8,STG>	;POINT TO 4 BYTE STRING
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	HRLZI T3,<-4>		;SET UP LOOP COUNT
DNPHI1:	ILDB T1,T2		;GET CURRENT BYTE
	OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT CURRENT BYTE
	OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
	AOBJN T3,DNPHI1		;DO ALL 4 BYTES
	RET			;AND GIVE HIM A GOOD RETURN
	ENDSV.

	SUBTTL MSDs -- Byte routines -- Put six byte Ethernet Address

;DNPENA - Put six byte Ethernet address in message
;
; Call:
;	T1/ Ethernet Address, bytes 0,1,2,3 left justified
;	T2/ Ethernet Address, bytes 4,5 left justified
;	MS/ Pointer to current output MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,T2,MS

	INTERNAL DNPENA
	XRESCD
DNPENA:	STKVAR <STG1,STG2>
	DMOVEM T1,STG2		;MAKE 6 BYTE STRING ON STACK
	MOVX T2,<POINT 8,STG2>	;POINT TO 6 BYTE STRING
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	HRLZI T3,<-6>		;SET UP LOOP COUNT
DNPEN1:	ILDB T1,T2		;GET CURRENT BYTE
	OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT CURRENT BYTE
	OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
	AOBJN T3,DNPEN1		;DO ALL 6 BYTES
	RET			;AND GIVE HIM A GOOD RETURN
	ENDSV.

	SUBTTL MSDs -- Byte routines -- Put an extensible field into message

;DNPEBY - Put extensible byte into message stream
;
; Call:
;	T1/ Byte
;	MS/ Pointer to current input MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,T2,MS

	INTERNAL DNPEBY
	XRESCD
DNPEBY:	
     DO.
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	CAIG T1,177		;IS IT BIG ENUF FOR AN EXTENSIBLE BYTE?
	CALLRET DNP1BY		;NO, OUTPUT THE REST AS ONE BYTE
	LSHC T1,-7		;PUSH BYTE OVER TO T2
	ROT T2,7		;LINE IT UP
	TRO T2,200		;LIGHT UP "EXTENSIBLE" BIT
	OPSTRM <IDPB T2,>,MDPTR,(MS) ;PUT BYTE IN STREAM
	INCR MDBYT,(MS)		;INCREMENT COUNT
     LOOP.
     ENDDO.

	SUBTTL MSDs -- Byte routines -- Put some zero bytes

;DNPZB - Put (T1) bytes of zeros into a message
;
; Call:
;	MS/ Pointer to current MSD
;	T1/ Number of zeros to put
;	
; Return:
;	RET
;
; Uses: T1,MS

	INTERNAL DNPZB
	XRESCD
DNPZB:	JUMPE T1,RTN		;Nothing to do if zero
	OPSTRM <ADDM T1,>,MDBYT,(MS) ;Adjust the byte count
	LOAD T6,MDALA,(MS)	;Set up index for MDPTR
	SETZ T2,		;Datum is a zero
DNPZB1:	OPSTRM <IDPB T2,>,MDPTR,(MS) ;Put byte in message
	SOJG T1,DNPZB1		;Put as many as requested
	RET

	SUBTTL MSDs -- Byte routines -- Skip some bytes

;DNSKBY - Skip (T1) bytes in input message
;
; Call:
;	MS/ Pointer to current input MSD
;	T1/ Number of Bytes to Skip
;
; Return:
;	RET			;WHEN WE RAN OUT OF BYTES
;	RETSKP			;ON SUCCESS
;
; Uses: T1,T2,MS

	INTERNAL DNSKBY
	XRESCD
DNSKBY:	JUMPE T1,RSKP		;Success return if no bytes to skip
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	MOVN T2,T1		;GET THE NEGATIVE COUNT
	OPSTRM <MOVNS>,MDBYT,(MS) ;NEGATE COUNT
	OPSTRM <SUBB T2,>,MDBYT,(MS) ;SUBTRACT THE NUMBER OF BACKSPACES
	JUMPL T2,RTN		;IF WE'RE OUT, GIVE ERROR RETURN
	OPSTR <ADJBP T1,>,MDPTR,(MS) ;ADJUST THE BYTE POINTER
	STOR T1,MDPTR,(MS)	;STORE THE POINTER BACK
	RETSKP			;WE'RE OK
	SUBTTL MSDs -- Byte routines -- Go Backwards some number of bytes

;DNBKBY - Go backwards (T1) bytes in input message
;
; Call:
;	T1/ Number of bytes to go backwards over
;	MS/ Pointer to input MSD
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,MS
;
;Note:  It is your responsiblity to make sure that you do not go
;backwards over an MSD boundary.  If you do the program will not work.

	INTERNAL DNBKBY
	XRESCD
DNBKBY:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	OPSTRM <ADDM T1,>,MDBYT,(MS) ;ADJUST THE BYTE COUNT
	MOVN T1,T1		;GET NEGATIVE COUNT
	OPSTR <ADJBP T1,>,MDPTR,(MS) ;ADJUST THE BYTE POINTER
	FIXADJ T1		;COMPENSATE FOR BUG IN BP EA CALC
	STOR T1,MDPTR,(MS)	;STORE THE POINTER BACK
	RET			;TO SENDER
	SUBTTL MSDs -- Read and Goto Position

;DNRPOS - Read the current position in the input data
;
; Call:
;	MS/ Pointer to input MSD
;
; Return:
;	RET			;Always, T1 holds full-word of position
;				; which can be fed to DNGPOS
;
; Uses: T1
;
;Note that DNRPOS is called far more frequently than DNGPOS, so
;DNRPOS is simple, where DNGPOS is complicated.

	INTERNAL DNRPOS
	XRESCD
DNRPOS:	LOAD T1,MDBYT,(MS)	;LOAD UP 'BYTES TO GO'
	RET			;THAT WAS EASY



;NSP's message trace facility (TRCMSG) makes illicit use of
;the MSD fields and of the nature of the position value returned
;by DNRPOS.



;DNGPOS - Go to a position in the input data spec'd by caller
;
; Call:
;	T1/ POSition word returned from DNRPOS
;	MS/ Pointer to input MSD
;
; Return:
;	RET
;
; Uses: T1,T2
;
;Caller passes a value returned from DNRPOS (above).  No other
;routines are expected to understand the contents of the POSition word.
;This routine should be called for INPUT MESSAGES ONLY.

	INTERNAL DNGPOS
	XRESCD
DNGPOS:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	TLNN MS,770000		;MAKE SURE LEFT HALF ISN'T GARBAGE
	OPSTR <CAMGE MS,>,CHBOT,+MBLCB ;MAKE SURE WE HAVE AN MS
	  BUG.(CHK,COMDNP,D36COM,SOFT,<DNGPOS called with bad MS>,,<

Cause:	The ac MS points to memory not used by message blocks.
	This was found during range checking.

Action:	Trace back to the caller and find out why there is a bad pointer.
>,RTN)
	LOAD T2,MDBYT,(MS)	;GET CURRENT 'BYTES TO GO'
	STOR T1,MDBYT,(MS)	;STORE SAVED 'BYTES TO GO'
	SUB T2,T1		;DERIVE BYTES TO BACK UP
	OPSTR <ADJBP T2,>,MDPTR,(MS) ;BACK UP THE BYTE POINTER
	FIXADJ T2		;COMPENSATE FOR BUG IN BP EA CALC
	STOR T2,MDPTR,(MS)	;STORE THE UPDATED BYTE POINTER
	RET
;DNGOPS - Go to a position in the input data spec'd by caller
;
; Call:
;	T1/ POSition word returned from DNRPOS
;	MS/ Pointer to input MSD
;
; Return:
;	RET
;
; Uses: T1,T2
;
;Caller passes a value returned from DNRPOS (above).  No other
;routines are expected to understand the contents of the POSition word.
;This routine should be called for OUTPUT MESSAGES ONLY.

	INTERNAL DNGOPS
	XRESCD
DNGOPS:	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	TLNN MS,770000		;MAKE SURE LEFT HALF ISN'T GARBAGE
	OPSTR <CAMGE MS,>,CHBOT,+MBLCB ;MAKE SURE WE HAVE AN MS
	  BUG.(CHK,COMODP,D36COM,SOFT,<DNGOPS called with bad MS>,,<

Cause:	The ac MS points to memory not used by message blocks.
	This was found during range checking.

Action:	Trace back to the caller and find out why there is a bad pointer.
>,RTN)
	LOAD T2,MDBYT,(MS)	;GET CURRENT 'BYTES TO GO'
	STOR T1,MDBYT,(MS)	;STORE SAVED 'BYTES TO GO'
	SUBM T1,T2		;DERIVE BYTES TO BACK UP
	OPSTR <ADJBP T2,>,MDPTR,(MS) ;BACK UP THE BYTE POINTER
	FIXADJ T2		;COMPENSATE FOR BUG IN BP EA CALC
	STOR T2,MDPTR,(MS)	;STORE THE UPDATED BYTE POINTER
	RET

	SUBTTL MSDs -- Link a Message Segment into a Message Block

;DNLMSS - Link message segment into MB
;
; Call:
;	T1/ Pointer to MSD that will point to segment
;	T2/ Pointer to previous MSD
;	T3/ Pointer to data (segment)
;	T4/ Count of bytes in data
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1-T4

	INTERNAL DNLMSS
	XRESCD
DNLMSS:	JUMPE T3,DNLMS1		;IF NO POINTER IS SPECIFIED, JUST LINK PREVIOUS
	STOR T3,MDAUX,(T1)	;STORE THE BYTE POINTER
	STOR T3,MDPTR,(T1)	; AND THE DYNAMIC BYTE POINTER
	STOR T4,MDBYT,(T1)	;STORE THE BYTE COUNT
	STOR T4,MDALL,(T1)	; AND THE ALLOCATED LENGTH
DNLMS1:	STOR T1,MDNXT,(T2)	;LINK PREVIOUS MSD TO US
	RET			;RETURN
	SUBTTL MSDs -- Copy message block

;DNCPMS - Gather message blocks MSDs into a new message block
;
; Call:
;	MB/ Pointer to message block to copy
;
; Return:
;	RET			;ERROR IN COPYING
;	RETSKP			;T1 POINTING TO NEW MESSAGE BLOCK
;				; MB STILL POINTING TO OLD BLOCK
; Uses: T1-T5
;
;Note that the byte pointers in MDPTR and MDAUX are indexed by
;(T6), see comment at VGNPTR definition, above.  Since we are
;using two msg blks here, one of the byte ptrs has to have its
;X field changed to T3.

	INTERNAL DNCPMS
	XRESCD
DNCPMS:	SAVEAC <P1,P2>		;P1 WILL POINT TO NEW MESSAGE BLOCK

;First, allocate a new message block

	MOVE T1,MB		;POINTER TO SOURCE MSG BLK
	CALL DNLENG		;HOW MANY BYTES IN IT?
	CALL DNGMSG		;GET A NEW MSG BLK FOR THAT MANY
	  RET			;CAN'T RETURN FAILURE TO CALLER
	MOVE P1,T1		;SAVE POINTER TO NEW MSG BLK

;Now we can fill in the new message block with data as if
;it had come from the outside world: all in IN.MSD.

	SETZ T4,		;WE'LL COLLECT BYTE COUNT HERE
	OPSTR <SKIPN T5,>,MBFMS,(MB) ;GET PTR TO FIRST MSD
	JRST DNCPM6		     ;LEAVE NOW IF NO DATA TO COPY
DNCPM1:	OPSTR <SKIPN T3,>,MDNXT,(T5) ;REMEMBER ADDR OF LAST MSD IN T5
	JRST DNCPM2		     ;DON'T COUNT LAST MSD IN CHAIN
	OPSTR <ADD T4,>,MDBYT,(T5)   ;COUNT THIS MSD'S DATA
	MOVE T5,T3		;MOVE TO NEXT MSD
	JRST DNCPM1		;THERE IS A NEXT, GO COUNT IT

DNCPM2:	LOAD T6,MDAUX,(T5)	;INDEXED 8-BIT BYTE PTR TO BEG OF SOURCE
	HRRZ T2,T6		;ISOLATE OFFSET IN RH OF BYTE PTR
	TLNE T6,700000		;IS IT 041000,,xxx?
	JRST DNCPM3		;NO, NO PROBLEM
	TLO T6,400000		;YES, MAKE IT 4410xx,nnn+1
	HRRI T6,1(T6)		;NON-CARRYING ADD TO RH, TLO JUST MADE IFIW
DNCPM3:	OPSTR <ADD T2,>,MDALA,(T5) ; WHICH WAS INDEXED BY T6=MDALA
	MOVEI T3,3(T4)		;GET BYTES BEFORE THIS MSD, ROUNDED UP
	ASH T3,-2		;CALCULATE WORDS FOR ALL BUT LAST MSD
	HRR T6,T3		;SAVE INDEXED BYTE PTR TO BEG OF DEST
	OPSTR <ADD T3,>,MDALA,+IN.MSD(P1) ;ADD ALLOC ADDR IN DEST MSD

	LOAD T1,MDBYT,(T5)	;GET # OF BYTES IN LAST MSD
	ADDI T1,3+3		;ADD 3 BEFORE + 3 AFTER FOR BLT MISALIGNMENT
	ASH T1,-2		;CALC # OF WORDS TO BLT
	CALL XBLTAT		;(T1,T2,T3)COPY MONITOR TO MONITOR
;Calc dest start byte ptr into T5, byte pointer indexed by T3 for MOVSLJ

	MOVE T3,T4		   ;GET # BYTES BEFORE BLT DATA
	OPSTR <ADD T3,>,MDBYT,(T5) ;GET TOTAL LENGTH OF NEW MESSAGE
	STOR T3,MDBYT,+IN.MSD(P1)  ;STORE IN NEW MSD
	JUMPE T4,[		   ;DON'T CHANGE 441006,,0 TO 041006,,-1
		  STOR T6,MDPTR,+IN.MSD(P1)
		  JRST DNCPM6]	   ;ALL DONE
	MOVN T5,T4		   ;NEGATE # OF BYTES BEFORE BLT'D DATA
	ADJBP T5,T6		   ;(T6) BYTE PTR TO START OF MSG
	FIXADJ T5		   ;COMPENSATE FOR BUG IN BP EA CALC
	STOR T5,MDPTR,+IN.MSD(P1)  ;NEW BEG PTR, STILL INDEXED BY T6
	TLZ T5,17		   ;GET RID OF T6 INDEX FOR USE BELOW
	TLO T5,T3		   ;REPLACE IT WITH T3 INDEX
	LOAD T3,MDALA,+IN.MSD(P1)  ;WE'LL INDEX DEST BPT WITH T3

;MB will now point to source MSDs instead of source msg blk

	LOAD P2,MBFMS,(MB)	;PICK UP PTR TO FIRST MSD
DNCPM5:	TMNN MDNXT,(P2)		;IS THIS THE LAST MSD?
	JRST DNCPM6		;YES, ALREADY BLT'D, DON'T MOVSLJ IT
	LOAD T1,MDBYT,(P2)	;LENGTH OF DATA IN THIS MSD
	LOAD T2,MDAUX,(P2)	;BYTE PTR TO BEG OF DATA
	LOAD T6,MDALA,(P2)	;BYTE PTR IN T2 IS INDEXED BY T6
	MOVE T4,T1		;COPY SOURCE LENGTH TO DEST LENGTH
	EXTEND T1,[MOVSLJ]	;PREPEND HEADER TO USER DATA
	  BUG.(CHK,COMMTS,D36COM,SOFT,<New message block too short>,,<

Cause:	A MOVSLJ instruction in D36COM has failed.

>,RTN)
	LOAD P2,MDNXT,(P2)	;GET PTR TO NEXT MSD IN CHAIN
	JRST DNCPM5		;GO COPY NEXT IF ITS NOT LAST

DNCPM6:	XMOVEI T1,IN.MSD(P1)	;GET POINTER TO INPUT MSD IN NEW MSG
	STOR T1,MBFMS,(P1)	;STORE AS FIRST MSD IN MSD CHAIN
	MOVE T1,P1 		;T1 PTS TO NEW MSG BLK FOR CALLER
	RETSKP			;RETURN SUCCESS
	SUBTTL MSDs -- Calculate length of a whole message

;DNLENG - Find length of message left
;
; Call:
;	T1/ Pointer to Message Block
;
; Return:
;	RET			;ALWAYS WITH T1 CONTAINING COUNT
;
; Uses: T1,T2

	INTERNAL DNLENG
	XRESCD
DNLENG:
	SETZ T2,		;KEEP COUNTER IN T2
	LOAD T1,MBFMS,(T1)	;GET POINTER TO FIRST MSD IN MSG BLK

DNLEN1:	OPSTR <ADD T2,>,MDBYT,(T1) ;ADD UP THE COUNT
	LOAD T1,MDNXT,(T1)	;GET THE NEXT MSD
	JUMPN T1,DNLEN1		;LOOP IF WE GOT SOME MORE
	MOVE T1,T2		;PUT IT WERE WE WANT IT
	RET			;OTHERWISE RETURN
	SUBTTL MSDs -- Calculate Length of Message Segment

;DNSLNG - Figure out length of MS segment
;
; Call:
;	T1/ Pointer to input MSD
;
; Return:
;	RET			;ALWAYS WITH LENGTH IN T1
;
; Uses: T1,T2
;
;Use this instead of looking at the count yourself, so that we can
;wedge the byte count somewhere with extended byte pointers.

	INTERNAL DNSLNG
	XRESCD
DNSLNG:	LOAD T1,MDBYT,(T1)	;GET OUR BYTE COUNT
	RET			; AND RETURN
	SUBTTL MSDs -- DNMINI - Initialize an allocated message block
;DNMINI - Initialize a message block
;
;Call
;	T1/ Pointer to message block
;	T2/ Number of user bytes desired
;Return
;	RET			;ON ALLOCATION FAILURE FOR USER DATA BLOCK
;				; (WILL DE-ALLOCATE MESSAGE BLOCK)
;	RETSKP			;SUCCESS, VIRGIN MESSAGE BLOCK WITH USER DATA

	INTERNAL DNMINI
	XRESCD
DNMINI:	TDZA T3,		;FLAG AN UNPRIVED CALL
DNMINP:	SETO T3,		;FLAG A PRIVED CALL
	SAVEAC <P1,P2,P3>
	MOVEI P2,3+3(T2)	;SAVE NUMBER OF USER DATA BYTES
				; NEEDED, WITH LEEWAY BEFORE & AFTER FOR
				; BYTE MISALIGNMENT FROM BLT'D DATA
				; IN ROUTINES LIKE DNCU2M, DNCPMS
	MOVE P3,T3		; Save privelege flag
	SKIPN P1,T1		;SAVE PTR TO MSG BLK
	BUG.(CHK,COMMZP,D36COM,SOFT,<DNMINI was passed a zero pointer>,,<

Cause:	Some caller probably meant to ask for zero bytes of user data in T2
	and mistakenly put the count in T1, which is supposed to be the
	pointer to the message block to refresh.

Action:	Find caller on the stack and fix it.

>,RTN)
	XMOVEI T2,UD.DAT(P1)	;PTR TO LITTLE USER DATA BFR IN MSG BLK
	LOAD T1,MDALA,+UD.MSD(P1) ;GET MSD'S PTR TO USER DATA
	JUMPE T1,DNMIN1		;JUMP IF NO USER DATA BLK PTR
	CAME T1,T2		;ARE THESE THE SAME?
	  JRST DNMIN2		;NO, WE HAVE A SEPARATE USER DATA BLOCK
DNMIN1:	CAIG P2,UDH.LN		;NO SEPARATE BLOCK, DO WE WANT ONE?
	  JRST DNMIN4		;NO, LITTLE USER DATA BLOCK IS GOOD ENOUGH
	XMOVEI T1,UBLCB		;YES, PTR TO CH FOR USER DATA BLKS
	LOAD P2,CHSIZ,(T1)	;Get size of UBL
	SUBI P2,OVHWDS		; Allowance for overhead word(s)
	IMULI P2,4		;Convert to bytes for caller
	MOVE T2,P3		; Get privilege flag
	CALL DNGRBA		;(T1,T2)GO GET BIG UD BLK (T6 IS PRIV FLAG)
	  RET			;WE LOSE

IFN FTLSTCOR,<
	MOVE T2,-4(P)		;GET CALLER'S PC
	MOVEM T2,(T1)		;PUT INTO FIRST HEADER WORD
	MOVE T2,['D36INI']	;PUT TEST THING
	MOVEM T2,1(T1)		; IN SECOND HEADER WORD
	ADDI T1,2		;POINT PAST HEADER WORDS
>;END IFN FTLSTCOR

	STOR T1,MDALA,+UD.MSD(P1) ;STORE ALLOCATED ADDRESS OF USER DATA
	JRST DNMIN5		;WE ARE WARM AND FUZZY NOW

DNMIN2:	CAILE P2,UDH.LN		;WE HAVE A BLK, DO WE NEED IT?
	  JRST DNMIN5		;YES, WE ARE ALL WARM AND FUZZY

IFN FTLSTCOR,<
	SUBI T1,2		;ACCOUNT FOR THE HEADER WORDS
>;END IFN FTLSTCOR

	XMOVEI T2,UBLCB		;POINTER TO CH FOR USER DATA BLOCKS
	CALL DNFRBL		;(T1,T2)RELEASE THE USER DATA BLOCK
	XMOVEI T2,UD.DAT(P1)	;PTR TO PLACE WE CAN FIT USER DATA IN
DNMIN4:	STOR T2,MDALA,+UD.MSD(P1) ;STORE ALLOCATED ADDRESS OF USER DATA
DNMIN5:	STOR P2,MDALL,+UD.MSD(P1) ;STASH AWAY ALLOCATED LENTGH OF STRING

	XMOVEI T1,NM.HDR(P1)	  ;GET POINTER TO NSP HEADER AREA
	STOR T1,MDALA,+NM.MSD(P1) ;STORE IT IN ALLOCATED ADDRESS FIELD
	MOVX T1,NMH.LN		  ;GET THE NSP HEADER AREA LENGTH (IN BYTES)
	STOR T1,MDALL,+NM.MSD(P1) ;STORE AWAY THE ALLOCATED LENGTH

	XMOVEI T1,RM.HDR(P1)	  ;GET POINTER TO RTR HEADER AREA
	STOR T1,MDALA,+RM.MSD(P1) ;STORE POINTER IN ALLOCATED ADDRESS FIELD
	MOVX T1,RMH.LN		  ;GET LENGTH OF HEADER AREA (IN BYTES)
	STOR T1,MDALL,+RM.MSD(P1) ;STORE ALLOCATED LENGTH FOR SOMEONE

	SETZRO MDBYT,+UD.MSD(P1)  ;NO BYTES IN USER DATA MSD YET
	SETZRO MDBYT,+NM.MSD(P1)  ;NO BYTES IN NSP MSD YET
	SETZRO MDBYT,+RM.MSD(P1)  ;NO BYTES IN ROUTER MSD YET

	MOVX T1,VGNPTR		  ;BUILD A VIRGIN BYTE PTR
	STOR T1,MDAUX,+UD.MSD(P1) ;STASH AWAY BYTE POINTER TO USER DATA
	STOR T1,MDPTR,+UD.MSD(P1) ;STASH AWAY IN DYNAMIC POINTER
	STOR T1,MDAUX,+NM.MSD(P1) ;STORE IN NSP STRING POINTER FIELD
	STOR T1,MDPTR,+NM.MSD(P1) ;AND IN THE DYNAMIC BYTE POINTER AREA
	STOR T1,MDAUX,+RM.MSD(P1) ;STORE IT IN STRING POINTER
	STOR T1,MDPTR,+RM.MSD(P1) ;AND IN THE DYNAMIC BYTE POINTER

;Link all of the MSD's to their header areas

	SETZRO MDNXT,+UD.MSD(P1)  ;NO FORWARD PTR FROM USER DATA MSD
	SKIPE T1,P2		  ;ANY USER DATA?
	XMOVEI T1,UD.MSD(P1)	  ;YES, GET POINTER TO USER DATA MSD
	STOR T1,MDNXT,+NM.MSD(P1) ;STORE USER DATA OR ZERO AS NEXT TO NSP
	XMOVEI T1,NM.MSD(P1)	  ;POINT TO THE NSP MSD
	STOR T1,MDNXT,+RM.MSD(P1) ;POINT RTR'S NEXT POINT TO NSP MSD
	XMOVEI T1,RM.MSD(P1)	  ;POINT TO THE START OF THE RTR MSD
	STOR T1,MBFMS,(P1)	  ;STORE THAT AS THE FIRST MSD POINTER

;Here to fix up the msg blk

	SETZM MB.FLG(P1)	;CLEAR OUT COMMON FLAGS WORD
	SETZM MB.CHN(P1)	;ASSUME NO LOOPBACK CHANNEL
	SETZM NM.FLG(P1)	;CLEAR OUT LLINKS' FLAGS WORD
IFN NM.FLG-NM.CNT,<SETZM NM.CNT(P1)> ;SEND COUNT IF IN DIFFERENT WORD
	SETZM RM.FLG(P1)	;CLEAR OUT ROUTER'S FLAGS WORD
	SETZM RM.ICP(P1)	;CLEAR INPUT CIRCUIT POINTER
	SETZM RM.OCP(P1)	;CLEAR OUTPT CIRCUIT POINTER
	SETZM RM.MK1(P1)	;CLEAR OUT THE EVENT MARK TO INDICATE NO ROUTER HEADER
	RETSKP			;RETURN SUCCESS

	SUBTTL MSDs -- DNCMSD - Copy MSD chain to contiguous block

;DNCMSD - copy a MSD chain to a contiguous block
;
;Call:	T1/ 30-bit pointer of destination block
;	T2/ # of bytes in destination block
;	MB/ message block address
;	CALL DNCMSD
;	 +1 return: not room to copy message
;	+2 return: success with -
;		T1/ BP to destination string without any address information
;		T2/ # of pad bytes required to word-align
;		T3/ total # of bytes (excluding pad) in message

	INTERNAL DNCMSD
	XRESCD
DNCMSD:	SAVEAC <P1,P2,T5,T6>
	STKVAR <PRECNT,TOTCNT,DSTBLK,DSTCNT,NRPAD,DSTPTR>
;PRECNT is the sum of bytes in all MSDs except the last one
;TOTCNT is the total number of bytes in the message
;DSTBLK is address of destination block
;DSTCNT is the number of bytes the destination block can accomodate
;NRPAD is the number of pad bytes needed to word-align the message
;DSTPTR is the destination byte pointer as returned to the user
	MOVEM T1,DSTBLK		;Save destination address
	MOVEM T2,DSTCNT		;Save # of bytes in destination block

;Find last MSD and count bytes along the way (into T1)
	LOAD MS,MBFMS,(MB)	;Get first MSD
	SETZ T1,		; and clear count
	DO.			;Loop
	  OPSTR <SKIPN T2,>,MDNXT,(MS) ;Is there another MSD?
	  EXIT.			; -no, this is the last - exit
	  OPSTR <ADD T1,>,MDBYT,(MS) ;Count the # of bytes in this MSD
	  MOVE MS,T2		;Go to next MSD
	  LOOP.			; and loop back
	ENDDO.
	MOVEM T1,PRECNT		;Save count of bytes before last MSD

;Should we do XBLT or MOVSLJs?
	LOAD T2,MDBYT,(MS)	;Get # of bytes in last MSD
	ADD T1,T2		;Calculate total # of bytes in message
	MOVEM T1,TOTCNT		; and save that
	CAIG T2,20		;More than 20 bytes in last MSD?
	JRST COPSLJ		; -no, copy with MOVSLJ

;Do XBLT

;The bytepointer in a MSD is of the format x41006,,nnn
	LOAD T1,MDAUX,(MS)	;Get the last MSDs pointer
	HRRZ T2,T1		;Isolate offset
	LDB T1,[POINT 3,T1,2]	;Get "x" from byte pointer
;The "x" is either 0 (make it into 4, and increase offset), 1,2,3 or 4
	SKIPE T1		;Is it 0?
	IFSKP.			; then
	  MOVX T1,4		;  make it 4
	  AOJ T2,		;  and increase offset
	ENDIF.

  IFN FTDEBUG <			;Verify bp only if debugging
	CAILE T1,4		;Should never be greater than 4
	BUG.(CHK,DNBBP,CIDLL,SOFT,<Bad byte-pointer>,,<

Cause:	CIDLL while copying a DECnet message to a SCA buffer, saw a
	bytepointer in a MSD where the first three bits are 5,6 or 7.

>,RTN)
  >

;T2 is the offset from the last MSD bytepointer - make it XBLT source address
	OPSTR <ADD T2,>,MDALA,(MS) ;Thats it!

;Since the last MSD do not need to start on a word boundary, there may be
; room for a couple of bytes there:
	MOVE T1,[EXP 3,2,1,0]-1(T1) ;Get that # of bytes
	MOVE T3,PRECNT		;Get number of bytes before last MSD
	SUB T3,T1		; and number of bytes that do not fit
;T3 is the number of bytes before the word where the last MSD starts
	MOVEI T4,3(T3)		;Add 3 and
	ASH T4,-2		; divide by 4 to get number of words
;T4 now has number of words before last MSD in destination
	MOVE T5,T4		;Get word count
	ASH T5,2		; and make into bytes
	SUB T5,T3		;Difference is number of pad bytes
	MOVEM T5,NRPAD

;Verify that destination block has room for all bytes
	ADD T5,TOTCNT		;Total length is message length + pad bytes
	CAMLE T5,DSTCNT		;Fit?
	RET			; -no, return error
;Calculate # of words in XBLT
	OPSTR <ADD T1,>,MDBYT,(MS) ;Add # of "spare bytes" in first word
				; with number of bytes in last MSD
	ADDI T1,3		;Add 3 to
	ASH T1,-2		; make word count
;T2 is already loaded
	MOVE T3,DSTBLK		;Load destination block address
	ADD T3,T4		; and add in offset
	EXTEND T1,[XBLT]	;XBLT...

;Now copy all MSDs except the last one with MOVSLJs
;T1 and T4 is byte count
;T2 is source byte pointer, indexed by P1 (and not T6)
;T5 is destination byte pointer, indexed by P2 (and not T6)
;P1 is source word address (MDALA)
;P2 is destination block address (DSTBLK)
	LOAD MS,MBFMS,(MB)	;Point to first MSD
	MOVE T5,NRPAD		;Get number of pad bytes
	MOVE T1,[POINT 8,0]	;Make destination pointer without address
	ADJBP T5,T1		;Make destination pointer point by pad in T5
	FIXADJ T5		;COMPENSATE FOR BUG IN BP EA CALC
	MOVEM T5,DSTPTR		; and save it for a while
	TLO T5,P2		;Now insert index through P2
	MOVE P2,DSTBLK		;Load destination block address
	DO.			;Until last MSD do..
	  OPSTR <SKIPN>,MDNXT,(MS) ;Is there another MSD?
	  EXIT.			; -no, this is the last one - dont copy
	  CALL CMSDSG		; Copy one MSD segment
	  LOAD MS,MDNXT,(MS)	; and move to next MSD
	  LOOP.
	ENDDO.

;All done for the XBLT case - just return
	MOVE T1,DSTPTR		;Get destination pointer
	MOVE T2,NRPAD		; and number of pad bytes
	MOVE T3,TOTCNT		; and length of entire message
	RETSKP

;COPSLJ - copy all segments with MOVSLJs
;T1 and T4 is byte count
;T2 is source byte pointer, indexed by P1 (and not T6)
;T5 is destination byte pointer, indexed by P2 (and not T6)
;P1 is source word address (MDALA)
;P2 is destination block address (DSTBLK)
;
COPSLJ:	MOVE T1,TOTCNT		;Room for message?
	CAMLE T1,DSTCNT		; ..
	RET			; -no, error return
	LOAD MS,MBFMS,(MB)	;Point to first MSD
	MOVE T5,[POINT 8,(P2)]	;Make destination pointer
	MOVE P2,DSTBLK		;Load destination block address
	DO.			;Until last MSD do..
	  CALL CMSDSG		; Copy one MSD segment
	  OPSTR <SKIPN MS,>,MDNXT,(MS) ;Move to next MSD if there is one
	  EXIT.			; -no, at end, exit
	  LOOP.
	ENDDO.

;All done for the MOVSLJ case - just return
	MOVSI T1,(POINT 8,0)	;Get LH of destination pointer
	SETZ T2,		;Number of pad bytes
	MOVE T3,TOTCNT		; and length of entire message
	RETSKP
	ENDSV.

;CMSDSG - copy a MSD segment
;
;Call:	T5/ destination byte pointer indexed by P2
;	P2/ destination address
;	MS/ points to current MSD
;May use T1-T6, P1

CMSDSG:	LOAD T1,MDBYT,(MS)	;# of bytes to copy
	JUMPE T1,RTN		; -nothing to copy
	LOAD T2,MDAUX,(MS)	;Get byte pointer to source
	TLZ T2,17		;Clear out index AC
	TLO T2,P1		; and make it index through P1
	LOAD P1,MDALA,(MS)	;Get source word address to P1
	MOVE T4,T1		; and move count
	EXTEND T1,[MOVSLJ]	;Copy the bytes
	BUG.(CHK,DNSLJ,CIDLL,SOFT,<MOVSLJ failed>,,<

Cause:	A MOVSLJ instruction did not skip.
>)
	RET

	SUBTTL	Buffers -- Copy buffer to a message segment

;DNCB2M - Copy buffer to a message segment
;
; Call:
;	T1/ Byte Count
;	T2/ 1- or 2-word Byte Pointer to String Block
;	T3/ Optional second word of byte pointer
;	MS/ Pointer to current message segment
;
; Return:
;	RET			;ALWAYS WITH T2 CONTAINING UPDATED BYTE POINTER
;				; AND T1, T2 & T3 UPDATED
;
; Uses: T1-T6
;
;Note that this is used only to copy from a DECnet (monitor) buffer to
;a DECnet message block.

	INTERNAL DNCB2M
	XRESCD
DNCB2M:	STKVAR <BYTCNT>
	MOVEM T1,BYTCNT		;Save count of bytes asked to copy
	TXNE T2,1B12		;IS IT A 2-WORD GLOBAL PTR?
	HRR T2,T3		;YES, MAKE LOCAL PTR FOR OLD MACHINES
	MOVE T4,T1		;SET UP THE DESTINATION BYTE COUNT
	LOAD T5,MDPTR,(MS)	; AND THE DESTINATION BYTE POINTER
	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
 	CALL BBM2M		;(T1-T6/T1-T6) MOVE BYTES
 	 TRN			;WON'T HAPPEN
	MOVE T4,BYTCNT		;Number of bytes requested to copy
	SUBI T4,(T1)		;Minus those we didn't send
	OPSTRM <ADDM T4,>,MDBYT,(MS) ;INCREMENT THE BYTE COUNT
	STOR T5,MDPTR,(MS)	;STORE THE UPDATED BYTE POINTER
	RET			;RETURN
	ENDSV.

	SUBTTL	Buffers -- Copy message data to a buffer

;DNCM2B - Copy message data to a buffer
;
; Call:
;	T1/ Count of bytes
;	T2/ 1- or 2-word Byte Pointer to buffer
;	T3/ Optional second word of byte pointer
;	MS/ Pointer to current message segment
;
; Return:
;	RET			;IF LENGTH IS NOT CORRECT
;	RETSKP			;ON SUCCESSFUL COPY WITH T1 AND T2 CONTAINING
;				; BYTE COUNT AND POINTER
;
; Uses: T1-T6

	INTERNAL DNCM2B
	XRESCD
DNCM2B:	OPSTR <CAMLE T1,>,MDBYT,(MS) ;MESSAGE BIG ENOUGH?
	RET			     ;NO, LET CALLER DEAL WITH ERROR
	SAVEAC <P1>		;Will contain index AC
	MOVE T4,T1		;SET UP DESTINATION BYTE COUNT
	DMOVE T5,T2		; AND DESTINATION BYTE PTR
	TXNE T5,1B12		;2-WORD BYTE PTR TO MONITOR BUFFER?
	HRR T5,T6		;YES, MAKE LOCAL FOR OLD MACHINES
	MOVN T2,T1		;GET NEGATIVE COUNT
	OPSTRM <ADDM T2,>,MDBYT,(MS) ;UPDATE THE BYTE COUNT
	LOAD T2,MDPTR,(MS)	;SET UP THE SOURCE BYTE POINTER
	MOVE P1,T2		; and save it for restore
	TLZE T2,17		;IS MDPTR INDEXED?
	TLO  T2,T3		;YES, USE T3, NOT T6
	LOAD T3,MDALA,(MS)	;SET UP INDEX FOR MDPTR
 	CALL BBM2M		;(T1-T6/T1-T6) MOVE BYTES
 	 TRN			;WON'T HAPPEN
	TLZN T2,17		;MDPTR indexed?
	IFSKP.			; -yes, restore old index AC
	  AND P1,[17,,0]	;  Clear out everything but old index AC
	  TDO T2,P1		;   and put it into byte pointer
	ENDIF.
	STOR T2,MDPTR,(MS)	;STORE BACK THE UPDATED SOURCE BYTE PTR
	MOVE T1,T4		;UPDATE COUNT FOR CALLER
	DMOVE T2,T5		;ALSO POSSIBLY 2-WORD BYTE PTR
	RETSKP			;RETURN SUCCESS

	SUBTTL BYTBLT - Non fancy versions
IFE FTBYTBLT,<
BBM2M:	JUMPLE T1,RSKP		;RETURN WHEN DONE
	ILDB CX,T2		;GET A BYTE
	IDPB CX,T5		;DEPOSIT A BYTE
	SOJA T1,BBM2M		;COUNT DOWN
>;END IFE FTBYTBLT
	SUBTTL BYTBLT - Fancy version

IFN FTBYTBLT,<

COMMENT #
	Indirection not permitted
	If a byte pointer passed to this routine is indexed, the index
	register must be T3 for the source, T6 for the destination.

	Does three special cases:
	1) 8 bit bytes, in "normal" position
	2) packs 8 bit bytes into words
	3) unpacks words into 8 bit bytes
	In all other cases, do an ILDB, IDPB loop

CALL BBM2M
  	T1/ source count
	T2/ source b.p.
	T3/ optional source b.p. word 2 or index for source b.p.
	T4/ destination count
	T5/ destination b.p.
	T6/ optional destination b.p. word 2 or index for destination b.p.
	returns +1 on failure (bad arguments)
	returns +2 on success
	with T1-T6 updated.

	Assumes that the 8 bit byte pointers are "normal",
	i.e., as below, or one word global.

	When the word position is used, it means the number of
	bytes not yet used in the word addressed by the E field of the bp.
	441000,,X - position is 4
	341000,,X - position is 3
	241000,,X - position is 2
	141000,,X - position is 1
	041000,,X - position is 0

	For 36 bit byte pointers, the count means the number of 8 bit bytes

	#
IFN FTOPS10,<
	P4==FREE1		;EXTRA ACS FOR BYTE BLT
	P5==FREE2
>; END IFN FTOPS10

SMLBLT==30			;MINIMUM FOR COMPLICATED WAY.
BP2==1B12			;2 WORD BP BIT
BBM2M::	SAVEAC <P1,P2,P3,P4,P5>	;SAVE ACS USED BY THIS ROUTINE
	TRVAR <OWGS,OWGD,<PRG,LPRG>>
	LDB P1,[POINT 6,T2,5]	;GET P OF SOURCE
	LDB P3,[POINT 6,T5,5]	;GET P OF DESTINATION
	CAIG P1,44		;OWGBP SOURCE ?
  	IFSKP.
	  CAIG P1,60		;8 BIT
	  CAIL P1,54		; BYTES ?
	  IFSKP.
	    MOVEI P2,10		;YES.
	    SUBI P1,54		;GET
	    MOVNS P1		; POSI-
	    ADDI P1,4           ;  TION
	    SETOM OWGS		;MARK ONE WORD GLOBAL SOURCE
	  ELSE.
	    MOVEI P2,7		;NO.
	  ENDIF.
	ELSE.
	  LDB P2,[POINT 6,T2,11] ;NO. GET S OF SOURCE
	  TRNE P1,3		;IN NORMAL POSITION ?
	  JRST BY8LP		;NO. DO SLOWLY.
	  LSH P1,-3		;GET POSITION.
	  SETZM OWGS		;MARK NOT ONE WORD GLOBAL SOURCE
	ENDIF.
	CAIG P3,44		;OWGBP SOURCE ?
  	IFSKP.
	  CAIG P3,60		;YES. 8 BIT
	  CAIL P3,54		; BYTES ?
	  IFSKP.
	    MOVEI P4,10		;YES.
	    SUBI P3,54		;GET
	    MOVNS P3		; POSI-
	    ADDI P3,4           ;  TION
	    SETOM OWGD		;MARK ONE WORD GLOBAL DEST.
	  ELSE.
	    MOVEI P4,7		;NO.
	  ENDIF.
	ELSE.
	  LDB P4,[POINT 6,T5,11] ;NO. GET S OF SOURCE
	  TRNE P3,3		;IN NORMAL POSITION ?
	  JRST BY8LP		;NO. DO SLOWLY.
	  LSH P3,-3		;GET POSITION
	  SETZM OWGD		;MARK NOT ONE WORD GLOBAL DEST.
	ENDIF.
	;...
	;...
;Dispose of the various cases
	CAIN P2,10		;8 BIT SOURCE
	CAIE P4,44		; AND 36 BIT DESTINATION ?
	TRNA  			;NO.
	JRST IN36		;YES. GO DO IT.
	CAIN P2,44		;36 BIT SOURCE AND
	CAIE P4,10		; 8 BIT DESTINATION ?
	TRNA			;NO.
	JRST OUT36   		;YES.
	CAMGE T4,T1		;IS THERE ROOM ?
	RET         		;NO. BOMB OUT.
	SUB T4,T1		;YES. OBTAIN RETURNED COUNT.
	CAIG T1,SMLBLT		;JUST A FEW BYTES ?
	JRST BY8LP 		;YES. DO IT EASILY
	CAMN P2,P4		;BYTE SIZES EQUAL AND
	CAIE P2,10		; 8 BIT BYTES ?
	JRST BY8LP   		;NO. DO IT THE SLOW WAY.
;Here when 8 bit bytes and using a fast method.
;Convert source position and byte pointer if necessary.
	IFE. P1 		;IS IT 0 ?
	  MOVEI P1,4		;YES. CONVERT IT TO 4
	  SKIPN OWGS		;ONE WORD GLOBAL ?
	  IFSKP.
	    TLZ T2,600000	;YES. CONVERT POINTER
	    TLO T2,540000
	  ELSE.
	    TLO T2,440000	;NO. CONVERT POINTER
	  ENDIF.
	  TXNN T2,BP2		;2 WORD BYTE POINTER ?
	  IFSKP.
    	    AOS T3     		;YES.
	  ELSE.
	    HRRZ CX,T2		;NO.
	    AOS CX
	    HRR T2,CX
	  ENDIF.
	ENDIF.
;Convert dest. position and byte pointer if necessary.
 	IFE. P3                 ;IS IT 0 ?
	  MOVEI P3,4		;YES. CONVERT
	  SKIPN OWGD		;ONE WORD GLOBAL ?
	  IFSKP.
	    TLZ T5,600000	;YES. CONVERT POINTER
	    TLO T5,540000
	  ELSE.
	    TLO T5,440000	;NO. CONVERT POINTER
	  ENDIF.
	  TXNN T5,BP2		;2 WORD BYTE POINTER ?
	  IFSKP.
    	    AOS T6     		;YES.
	  ELSE.
	    HRRZ CX,T5		;NO.
	    AOS CX
	    HRR T5,CX
	  ENDIF.
	ENDIF.
;BLT or BYTE BLT ?
	CAME P1,P3  		;POSITIONS MATCH ?
	JRST BY8SLW		;(T1-T6,P1-P4) NO. BYTE BLT.
	;...
	;...
;BLT - Here when positions match. transfer 0-3 bytes slowly, blt, then
;transfer the last 0-3 bytes slowly.
BBBLT:	CAIN P1,4		;POSITION = 4 ? (WORD ALIGNED)
	IFSKP.
	  SUB T1,P1	        ;NO. MOVE SOME BYTES. UPDATE COUNT.
BBBLT1:	  ILDB P5,T2  		;DO
	  IDPB P5,T5  		; THOSE
	  SOJG P1,BBBLT1	;  BYTES
	  MOVEI P5,1		;REMEMBER WE WERE HERE.
	ELSE.
	  SETZ P5,		;WE DIDN'T MOVE BYTES.
	ENDIF.
;Get source address
	MOVE P2,T2
	SKIPN OWGS		;ONE WORD GLOBAL ?
	IFSKP.
	  TLZ P2,770000		;YES. 30 BITS, NO INDIRECTION OR INDEXING
	ELSE.
	  TXNN P2,BP2		;NO. 2 WORD B.P. ?
	  IFSKP.
	    XMOVEI P2,(T3) 	;YES. GET ADDRESS
	  ELSE.
            TLZ P2,777740	;NO. ONE WORD LOCAL
	    TXO P2,<XMOVEI P2,>	;OBTAIN
	    XCT P2		; ADDRESS
	  ENDIF.
	ENDIF.
	ADD P2,P5		;ADD IN IF THE B.P. WAS AT THE END OF A WORD.
;get destination address
	MOVE P3,T5
	SKIPN OWGD 		;ONE WORD GLOBAL ?
	IFSKP.
	  TLZ P3,770000		;YES. 30 BITS, NO INDIRECTION OR INDEXING
	ELSE.
	  TXNN P3,BP2		;NO. 2 WORD B.P. ?
	  IFSKP.
	    XMOVEI P3,(T6) 	;YES. GET ADDRESS
	  ELSE.
	    TLZ P3,777740	;NO. ONE WORD LOCAL
	    TXO P3,<XMOVEI P3,>	;OBTAIN
	    XCT P3		; ADDRESS
	  ENDIF.
	ENDIF.
	ADD P3,P5		;ADD IN IF THE B.P.S WERE AT THE END OF A WORD.
	MOVE P1,T1   		;SAVE REMAINING BYTE COUNT
	LSH T1,-2		;CONVERT TO WORD COUNT
	EXCH P2,T2		;SAVE SOURCE BYTE POINTER (WORDS 1 & 2)
	EXCH P3,T3		; SET UP FOR XBLT
	CALL XBLTA		;(T1,T2,T3) MOVE IT.
	MOVE T1,P1   		;UPDATE
	LSH T1,-2		; THE
	MOVE T2,P2   		;  BYTE
	MOVE T3,P3   		;   POINTERS BY THAT MANY WORDS
	CALL UPDBPW		;(T1,T2,T3,T5,T6/T2,T3,T5,T6)
	MOVE T1,P1   		;REMAINING BYTE
	ANDI T1,3 		; COUNT
;	CALLRET BY8LP 		;FINISH OFF THOSE FEW BYTES.
;Transfer bytes the easy & slow way
;CALL BY8LP
;T1/ Byte count
;T2,T3/ Source bp
;T5,T6/ Destination bp
;RETURNS +2 ALWAYS
;Uses T1-T6,CX
BY8LP:	JUMPE T1,RSKP
BY8LP1:	ILDB CX,T2
	IDPB CX,T5
	SOJG T1,BY8LP1
	RETSKP
;Update byte pointers by words
;Call UPDBPW
;T1/ Word count
;T2,T3/ Source byte pointer
;T5,T6/ Destination byte pointer
;Returns +1 always with T2,T3,T5,T6 updated
;Uses CX
;Preserves all other ACs
UPDBPW:	TXNN T2,BP2		;TWO WORD BP ?
	IFSKP.
	  ADD T3,T1		;YES.
	ELSE.
	  HRRZ CX,T2		;NO. DO IT THIS WAY SO
	  ADD CX,T1		; NEGATIVE OFFSET IN B.P.
	  HRR T2,CX		;  WORKS
	ENDIF.
	TXNN T5,BP2		;TWO WORD BP ?
	IFSKP.
	  ADD T6,T1		;YES.
	ELSE.
	  HRRZ CX,T5		;NO. DO IT THIS WAY SO
	  ADD CX,T1		; NEGATIVE OFFSET IN B.P.
	  HRR T5,CX		;  WORKS
	ENDIF.
	RET
;Here when byte positions do not match
;Call BY8SLW
;T1/ Byte count
;T2,T3/ Source byte pointer
;T4/ Remaining byte count already updated
;T5,T6/ Destination byte pointer
;P1/ Source position
;P3/ Dest. position
;Returns +1 always with
;T2,T3,T5,T6 updated.
;uses P1-P5
;uses the TRVAR OWGS, OWGD
BY8SLW:	SUB T1,P3		;UPDATE COUNT
                    		;COMPUTE (SOURCE-DESTINATION MOD 4)
	SUB P1,P3  		; WHAT SOURCE POSITION
	CAIG P1,0		;  WILL BE AFTER
	ADDI P1,4		;   FILLING FIRST WORD OF DEST.
BY8BL1: ILDB P5,T2		;FILL IN FIRST WORD OF DESTINATION
	IDPB P5,T5
	SOJG P3,BY8BL1
;at this point the destination position is 4, and the
;source position is 1, 2, or 3.
	MOVE P4,T1    		;SAVE COUNT
	MOVE P2,T2    		;AND BYTE
	MOVE P3,T3    		; POINTER
	MOVEI T1,LPRG		;GET COPY OF
	XMOVEI T2,PROTO		;PROTOTYPE BYTE BLT
	XMOVEI T3,PRG		;ON THE STACK
	CALL XBLTA
	MOVE T1,P4 		;RESTORE COUNT AND BYTE POINTER
	MOVE T2,P2
	MOVE T3,P3
;Alter the program on the stack (TRVAR PRG)
	CAIN P1,3       	;POSITION NOT 3 ?
	IFSKP.
	  XMOVEI P2,PRG  	;YES. MUST ALTER. ADDRESS OF BYTBLT ROUTINE
	  MOVE P3,3(P2)  	;GET FIRST INSTRUCTION TO BE ALTERED
	  XCT PROT1-1(P1)	;ALTER IT.
	  MOVEM P3,3(P2)	;STICK IT IN THE PROGRAM.
	  MOVE P3,4(P2)		;GET SECOND INSTRUCTION TO BE ALTERED
	  TXZ P3,17B12		;CLEAR AC FIELD
	  TXO P3,11B12		;SET IT TO P2
	  MOVEM P3,4(P2)	;STICK IT IN THE PROGRAM.
	ENDIF.
	;...
	;...
;Get source address
	MOVE P3,T2
	SKIPN OWGS		;ONE WORD GLOBAL ?
	IFSKP.
	  TLZ P3,770000		;YES. 30 BITS, NO INDIRECTION OR INDEXING
	ELSE.
	  TXNN P3,BP2		;NO. 2 WORD B.P. ?
	  IFSKP.
	    XMOVEI P3,(T3)  	;YES. GET ADDRESS
	  ELSE.
            TLZ P3,777740	;NO. ONE WORD LOCAL
	    TXO P3,<XMOVEI P3,>	;OBTAIN
	    XCT P3		; ADDRESS
	  ENDIF.
	ENDIF.
;Get destination address
	MOVE P4,T5
	SKIPN OWGD 		;ONE WORD GLOBAL ?
	IFSKP.
	  TLZ P4,770000		;YES. 30 BITS, NO INDIRECTION OR INDEXING
	ELSE.
	  TXNN P4,BP2		;NO. 2 WORD B.P. ?
	  IFSKP.
	    XMOVEI P4,(T6) 	;YES. GET ADDRESS
	  ELSE.
	    TLZ P4,777740	;NO. ONE WORD LOCAL
	    TXO P4,<XMOVEI P4,>	;OBTAIN
	    XCT P4		; ADDRESS
	  ENDIF.
	ENDIF.
	AOS P4			;SINCE B.P. WAS AT END OF WORD
;Set up word count for shifting program.
	MOVE P5,T1   		;GET BYTE COUNT
	LSH P5,-2		;CONVERT TO WORD COUNT
	CALL PRG		;(P3,P4,P5)GO SHIFT AWAY
;Finish up.
	MOVE P1,T1   		;UPDATE
	LSH T1,-2		; BYTE
	CALL UPDBPW		;  POINTERS (T1,T2,T3,T5,T6/T2,T3,T5,T6)
	MOVE T1,P1   		;GET REMAINING
	ANDI T1,3		; BYTE COUNT
	JRST BY8LP   		;FINISH IT OFF

;Alteration table for the LSHC instruction in PRG.
PROT1:	HRRI P3,-^D8
	HRRI P3,-^D16
;Prototype 8 bit byte blt, where bytes are aligned, and source and destination
;are not in phase, and the destination position is 4.
;The E field of PROTO+3 will be be ^D12, -^D8 or -^D16
;The AC field of PROTO+4 will be be T1 or T2
;This routine, as written, will do the transfer for source position = 3.
;The low order 4 bits of the destination words will be randomized.
;P3/ address of source
;P4/ address of destination
;P5/ word count
;Uses P1-P5
;Assumes that the count is positive.
PROTO:	DMOVE P1,(P3)		;GET SOME SOURCE
	AOS P3			;UPDATE SOURCE ADDRESS
	LSH P1,-4		;RIGHT JUSTIFY FIRST SOURCE WORD
	LSHC P1,^D12		;E FIELD FILLED IN AT RUN TIME - ALIGN SOURCE
	MOVEM P1,(P4)		;AC FIELD FILLED IN AT RUN TIME - FILL DEST.
	AOS P4			;UPDATE DESTINATION ADDRESS
	SOJG P5,PRG		;LOOP, THE TOP OF THIS ROUTINE IS REALLY PRG.
	RET
LPRG==.-PROTO
	ENDTV.
;pack 8 bit bytes into 36 bit words
;JRST IN36
;T1/ # of 8 bit bytes
;T2,T3/ 8 bit byte pointer
;T4/ # of 8 bit bytes
;T5,T6/ 36 bit byte pointer
;Indirection not permitted
;If a byte pointer passed to this routine is indexed, the index
;register must be T3 for the source, T6 for the destination.
;Uses P1-P5
;Returns +2 on success, with T1-T6 updated
;Returns +1 on failure (no room)
IN36:	MOVE P4,T1		;COMPUTE # OF WORDS
	LSH P4,1		; WORDS = BYTES * 2 / 9
	IDIVI P4,11
	ANDI P5,3		;ANY REMAINDER ?
	IFN. P5
	  AOS P4		;YES. NEED ONE MORE WORD.
	ENDIF.
	CAMGE T4,T1		;ENOUGH ROOM ?
	RET			;NO.
	SUB T4,T1		;YES. UPDATE # OF 8 BIT BYTES LEFT IN BUFFER.
;Get destination address
	TXNN T5,BP2		;2 WORD B.P. ?
	IFSKP.
	  XMOVEI P3,(T6)  	;YES. GET ADDRESS
	ELSE.
	  MOVE P3,T5		;NO. ONE WORD
          TLZ P3,777740		; LOCAL, MASK OFF P & S
	  TXO P3,<XMOVEI P3,>	;OBTAIN
	  XCT P3		; ADDRESS
	ENDIF.
;update destination pointer
	TXNN T5,BP2		;2 WORD BYTE POINTER ?
	IFSKP.
	  ADD T6,P4  		;YES. UPDATE IT.
	ELSE.
	  HRRZ CX,T5		;NO. UPDATE ONE WORD BYTE POINTER
	  ADD CX,P4
	  HRR T5,CX
	ENDIF.
;loop
IN36A: 	SETZB P1,P2		;INIT WORDS
	MOVEI P5,11   		;ASSUME ENOUGH ROOM
	CAIGE T1,11		;ENOUGH ROOM FOR 2 WORDS OF BYTES ?
	MOVE P5,T1		;NO. GET SMALLER COUNT
;subloop
IN36B: 	LSHC P1,10		;SHIFT BYTES
	ILDB CX,T2    		;GET NEXT BYTE FROM NET BUFFER
	DPB CX,[POINT 8,P2,35]	;STASH IT
	SOJG P5,IN36B 		;DO THEM ALL
	SUBI T1,11		;UPDATE REMAINING BYTE COUNT
	IFL. T1			;SOME ODD BYTES AT THE END ?
  	  LSHC P1,-4		;YES. ALIGN ODD WORD
	  MOVEM P2,(P3)   	;STORE ODD WORD AND DONE.
	ELSE.
	  DMOVEM P1,(P3)        ;STORE BOTH WORDS
	  ADDI P3,2 		;INCREMENT DESTINATION POINTER
	  JUMPG T1,IN36A	;DO MORE IF NEEDED
	ENDIF.
;end loop. update destination byte pointer
	SETZ T1,		;WE TRANSFERRED ALL THOSE BYTES.
	RETSKP			;ALL DONE
;unpack 36 bit bytes into 8 bit bytes
;JRST OUT36
;T1/ # of 8 bit bytes in the 36 bit byte buffer
;T2,T3/ 36 bit byte pointer
;T4/ size in words of 8 bit byte buffer
;T5,T6/ 8 bit byte pointer
;Returns +2 on success, with T1-T6 updated
;Returns +1 on failure (no room)
;Uses P1-P5
;Indirection not permitted
;If a byte pointer passed to this routine is indexed, the index
;register must be T3 for the source, T6 for the destination.
OUT36:	STKVAR <WCNT>
	MOVE P1,T1		;Get request count
	CAILE T1,^D9		;If nine or less just transfer them
	IFSKP.
	  SETZM WCNT		;All bytes transferred
	ELSE.
	  IDIVI P1,^D9		;Number of 8 bit bytes in two words
	  IMULI P1,^D9		;Compute the number that fit on word boundary
	  EXCH P1,T1
	  SUB P1,T1		;P1 will contain number we can't copy
	  MOVEM P1,WCNT		;Remember that
	ENDIF.
;Get source address
	TXNN T2,BP2		;2 WORD B.P. ?
	IFSKP.
	  XMOVEI P1,(T3)  	;YES. GET ADDRESS
	ELSE.
	  MOVE P1,T2		;NO. ONE WORD
          TLZ P1,777740		; LOCAL, MASK OFF P & S
	  TXO P1,<XMOVEI P1,>	;OBTAIN
	  XCT P1		; ADDRESS
	ENDIF.
	MOVE P2,T1		;COMPUTE # OF WORDS
	LSH P2,1		; WORDS = BYTES * 2 / 9
	IDIVI P2,11
	ANDI P3,3		;ANY REMAINDER ?
	IFN. P3
	  AOS P2		;YES. NEED ONE MORE WORD.
	ENDIF.
	CAMGE T4,T1		;ENOUGH ROOM ?
	RET			;NO.
	SUB T4,T1		;YES. UPDATE # OF 8 BIT BYTES LEFT IN BUFFER.
	TXNN T2,BP2		;2 WORD BYTE POINTER ?
	IFSKP.
	  ADD T3,P2  		;YES. UPDATE IT.
	ELSE.
	  HRRZ CX,T2		;NO. UPDATE ONE WORD BYTE POINTER
	  ADD CX,P2
	  HRR T2,CX
	ENDIF.
;outer loop
OUT36A:	CAIL P2,2 		;HAVE AT LEAST 2 MORE WORDS?
	IFSKP.
	  MOVE P3,(P1)         	;NO. GET LAST WORD
	  SETZ P4,		;AND THE OTHER IS NULL.
	  MOVEI P5,5		;5 MORE BYTES TO MOVE
	ELSE.
	  DMOVE P3,(P1)         ;GET TWO MORE WORDS
	  ADDI P1,2 		;INCREMENT
	  MOVEI P5,11		;MOVE 9 BYTES
	ENDIF.
       	SUBI P2,2 		;TAKE TWO WORDS WORTH OF BYTES.
;inner loop
OUT36B:	ROTC P3,10		;GET NEXT BYTE RIGHT JUSTIFIED
	IDPB P4,T5        	;STORE IT
	SOJG P5,OUT36B		;DO ALL BYTES
	JUMPG P2,OUT36A		;GO DO MORE DATA
;finish up.
	MOVE T1,WCNT		;Number of bytes we didn't transfer
	RETSKP
	ENDSV.
IFN FTOPS10,<PURGE P4,P5>

> ;END IFN FTBYTBLT

	SUBTTL	Buffers -- Copy user buffer to a message segment

;DNCU2M - Copy user buffer to a message segment
;
; Call:
;	T1/ User Byte Count
;	T2/ User Byte Pointer
;	T3/ Optional second word of byte pointer, not implemented yet
;		for user mode
;	MS/ Pointer to current message segment
;
; Return:
;	RET			;ALWAYS, WITH T2 CONTAINING UPDATED BYTE PTR
;				; AND T1 CONTAINING UPDATED BYTE COUNT
;
; Uses: T1-T6

	XRESCD
DNCU2M::TSTS6
	TORESCD			;Run in section 1 because of PXCT
IFN FTOPS10,<
	TXZ T2,1B12		;DON'T ALLOW USER 2-WORD BPTs
	LOAD T4,MDBYT,(MS)	;GET COUNT OF BYTES ALREADY IN MSG BLK
	OPSTRM <ADDM T1,>,MDBYT,(MS) ;INCREMENT THE BYTE COUNT
	JUMPG T4,DNCUM0		;CAN'T BLT IF SOME ALREADY THERE

	HLRZ T4,T2		;GET P & S FIELDS OF USER BPT
	CAIE T4,441000		;IS IT A STANDARD 8-BIT PTR?
	CAIN T4,341000		;IN ANY OF THE 4 POSITIONS?
	JRST DNCUMB		;YES, WE CAN BLT
	CAIE T4,241000		;TWO MORE
	CAIN T4,141000		; NORMAL ONES TO CHECK
	JRST DNCUMB		;YES, WE CAN BLT
	CAIN T4,041000		;NO, STANDARD 'NEXT-WORD' BPT?
	JRST [	TLO T2,400000	;YES, MAKE IT 441000,,N+1
		HRRI T2,1(T2)	; . . .
		JRST DNCUMB]	;AND BLT THE DATA
DNCUM0:
>;END OF IFN FTOPS10

;Here if we must do a byte-wise copy

IFN FTOPS20,<OPSTRM <ADDM T1,>,MDBYT,(MS)> ;INCREMENT THE BYTE COUNT

	LOAD T6,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	LOAD T5,MDPTR,(MS)	; AND THE DESTINATION BYTE POINTER
	SKIPG T4,T1		;SET UP THE DESTINATION BYTE COUNT
	RET			;IF NON-POSITIVE, WE'RE DONE
DNCUM1:	XCTBU [ILDB CX,T2]	;GET THE BYTE FROM USER BUFFER
	IDPB CX,T5		;PUT IT IN THE MESSAGE BLOCK
	SOJG T1,DNCUM1		;LOOP UNTIL DONE
	STOR T5,MDPTR,(MS)	;STORE THE UPDATED BYTE POINTER
	RET			;RETURN

IFN FTOPS10,<
;Here if we can BLT the user data

DNCUMB:	HLLZ T4,T2		;PICK UP ADJUSTED USER BPT'S P&S FIELDS
	TLO T4,T6		;MDAUX IS INDEXED BY T6
	STOR T4,MDAUX,(MS)	;STORE NEW BEG-OF-MSG BYTE POINTER
	MOVE T5,T1		;GET BYTE LENGTH AGAIN
	ADJBP T5,T4		;FIGURE BYTE PTR AT END OF NEW DATA
	STOR T5,MDPTR,(MS)	;STORE NEW END-OF-MSG BYTE POINTER

	LDB T4,[POINT 3,T2,2]	;PICK UP WORD ALIGNMENT FROM BYTE POINTER
	MOVNS T4		;NEGATE
	ADDI T4,7(T1)		;CALCULATE MESSAGE WORD COUNT
	ASH T4,-2		;...
IFN FTXMON,<
	HRRZ T5,T2		;SOURCE ADDR, USER ALWAYS IN SECTION 0
	LOAD T6,MDALA,(MS)	;ALLOCATED ADDRESS OF MONITOR DATA BLK
	XCT 2,[EXTEND T4,[XBLT]] ;COPY FROM USER TO MONITOR
>;END IFN FTXMON
IFE FTXMON,<
	LOAD T5,MDALA,(MS)	;DESTINATION ADDR IN MONITOR SPACE
	HRL T5,T2		;SOURCE ADDR IN USER SPACE
	ADDI T4,-1(T5)		;MAKE DEST END ADDRESS IN SECTION 0
	XCT 1,[BLT T5,(T4)]	;COPY USER TO MONITOR
>;END IFE FTXMON
	MOVE T4,T1		;GET LENGTH (BYTES) AGAIN
	ADJBP T4,T2		;MAKE NEW USER BPT
	MOVEM T4,T2		;PUT BACK FOR CALLER
	SETZM T1		;UPDATED BYTE COUNT FOR CALLER
	RET			;ONLY RETURN
>;END OF IFN FTOPS10

	SUBTTL	Buffers -- Copy message data to a user buffer

;DNCM2U - Copy message data to a user buffer
;
; Call:
;	T1/ Count of bytes
;	T2/ Pointer to data
;	T3/ Optional second word of byte pointer
;	MS/ Pointer to current message segment
;
; Return:
;	RET			;IF LENGTH IS NOT CORRECT
;	RETSKP			;ON SUCCESSFUL COPY WITH T1 AND T2 CONTAINING
;				; BYTE COUNT AND POINTER
;
; Uses: T1-T6

	XRESCD			;Previous context executes run in section 1
DNCM2U::TSTS6
	TORESCD
	IFN DBGS2,<SAVEAC <T5,T6>> ;*LLMOP*
	TXNE T2,1B12		;2-WORD BYTE PTR?
	HRR T2,T3		;YES, MAKE LOCAL FOR OLD MACHINES
	MOVE T4,T1		;SET UP DESTINATION BYTE COUNT
	DMOVE T5,T2		;AND DESTINATION BYTE POINTER
	OPSTR <CAMLE T1,>,MDBYT,(MS) ;MESSAGE BIG ENOUGH?
	RET			     ;NO, LET CALLER DEAL WITH ERROR
	MOVN T2,T1		;SET UP NEGATIVE COUNT
	OPSTRM <ADDM T2,>,MDBYT,(MS) ;UPDATE THE BYTE COUNT
	LOAD T2,MDPTR,(MS)	;SET UP THE SOURCE BYTE POINTER
	TLZE T2,17		;IS MDPTR INDEXED?
	TLO  T2,T3		;YES, USE T3, NOT T6
	LOAD T3,MDALA,(MS)	;SET UP INDEX FOR MDPTR
	JRST DNCMU2		;START IN MIDDLE OF LOOP
DNCMU1:	ILDB CX,T2		;GET THE BYTE FROM MESSAGE BLOCK
	XCTBU [IDPB CX,T5]	;PLACE BYTE IN USER BUFFER
DNCMU2:	SOJGE T4,DNCMU1		;DO UNTIL DONE
	STOR T2,MDPTR,(MS)	;STOR THE UPDATED BP TO MESSAGE
	MOVE T1,T4		;UPDATE COUNT FOR CALLER
	DMOVE T2,T5		; ALSO POSSIBLY 2-WORD BYTE PTR
	RETSKP			;RETURN SUCCESS
	SUBTTL Core manager -- Smear a block of memory with value
;DNSWDS - Smear a value into a block of words
;
;Call:	T1/ Address of start of block
;	T2/ Address of end of block
;	T3/ Value to put in block (typically zero)
;	CALL DNSWDS
;	Normal Return
;
;Changes T1,T2,T3,T4

	INTERNAL DNSWDS
	XRESCD
DNSWDS:	MOVEM T3,(T1)		;STORE THE VALUE TO BE SMEARED
	MOVE T3,T2		;ADDR OF EO BLOCK INTO T3
	MOVE T2,T1		;ADDR OF BEG OF BLK INTO T2
	SUBM T3,T1		;NUMBER OF WORDS TO COPY INTO T1
	XMOVEI T3,1(T2)		;CALC SMEARING DESTINATION ADDR
	CAILE T1,VBLSIZ		;IS THIS A LEGITIMATE SMEAR?
	BUG.(CHK,COMSTB,D36COM,SOFT,<Smear request too big>,,<

Cause:	The caller has requested that a very large block be smeared.

Action:	Find out what the caller really wanted to smear and fix the call.

>,DNSWD1)
	CALLRET XBLTAT		;(T1,T2,T3)COPY MONITOR TO MONITOR

DNSWD1:	MOVEI T1,VBLSIZ		;TRY TO RECOVER FROM OVERSIZE SMEAR
	CALLRET XBLTAT		;(T1,T2,T3)COPY MONITOR TO MONITOR
	SUBTTL Core manager -- Copy some words

;DNCPYW - Copy words using a BLT or a XBLT
;
; Call:
;	T1/ From
;	T2/ To
;	T3/ Count
;
; Return:
;	RET			;ALWAYS
; Uses:

	INTERNAL DNCPYW
	XRESCD
DNCPYW:	EXCH T1,T3		;CHANGE TO T1/COUNT, T2/TO, T3/FROM
	EXCH T2,T3		;CHANGE TO T1/COUNT, T2/FROM, T3/TO
	CALLRET XBLTAT		;(T1,T2,T3)COPY MONITOR TO MONITOR
	SUBTTL Core manager -- Get Some Words

;DNGWDP - Get memory-Lowest priority - process context
;DNGWDN - Get memory-normal priority
;DNGWDH - Get memory-Highest priority
;DNGWDS - Get some words, not zeroed
;
; Call:
;	T1/ Count of words we want
;
; Return:
;	RET			;ON ALLOCATION FAILURE
;	RETSKP			;WITH T1 POINTING TO WORDS
;
;
;Note: The count of words allocated is stored in the word before the
;returned pointer.

	XRESCD
DNGWDS::

IFE FTD36MM,<
IFN FTOPS20,<
DNGWDH::MOVEI T2,.RESP1		;Get memory-High priority
	JRST GTWRDS
DNGWDN::SKIPA T2,[.RESP2]	;Get memory-normal priority
DNGWDP::MOVEI T2,.RESP3		;Get memory-Process context (process can be
				; descheduled)
>
IFN FTOPS10,<
DNGWDH::
DNGWDN::
DNGWDP::
>>
IFN FTD36MM,<
DNGWDH::
DNGWDN::
DNGWDP::
>
GTWRDS:
	SAVEAC	<P1,T6>		;NOTE - THIS ROUTINE "KNOWS" HOW MANY ACS ARE
				;  SAVED, AND USES THIS KNOWLEDGE TO LOOK AT
				;  THE STACK. SEE FTLSTCORE.
IFE FTD36MM,<
IFN FTOPS20,<
	STKVAR <MEMPRI>		; Priority to get memory from ASGRES
	MOVEM T2,MEMPRI		; Save it
>>
	HRRZ P1,T1		;SAVE THE COUNT
	MOVEI T2,1(T1)		;T2 GETS NUMBER OF WORDS.
IFN FTLSTCOR, ADDI T2,2		;Overhead for check words
IFN FTD36MM,<
	OPSTR <CAMLE T2,>,CHSIZ,+VBLCB	;WILL A LARGE A-BLOCK SATISFY REQUEST?
	BUG.(CHK,COMATB,D36COM,SOFT,<A-Block request too big>,,<

Cause:	For the time being, until we get a real memory-manager for non
	message-block requests, we only support requests for memory
	up to the size of a VBL block, see DEFBLK macro.

Action:	Wait for the real memory manager or make the size of VBLs bigger
	than they are now.

>,RTN)
>  ;End FTD36MM
IFN FTHMMEM,<
	SKIPN T6,MRQTAB		; Get address of our memory request table
	IFSKP.
	  ADD T6,P1		; Index by request amount
	  CAML T6,MRQMAX	; Have we goone too far?
	  IFSKP.
	    AOS (T6)		; Increment the count of requests this size
	    HRRZ T3,(T6)	; Get current outstanding requests
	    HLRZ T4,(T6)	; Get the previous high water mark
	    CAMLE T3,T4		; Is this higher?
	     HRLM T3,(T6)	; Yes, it becomes new high water mark
	  ENDIF.
	ENDIF.
>  ;END FTHMMEM
IFN FTD36MM,<
	XMOVEI T1,VBLCB
	OPSTR <CAMG T2,>,CHSIZ,+LBLCB ;SEE IF IT MIGHT BE A LARGE BLOCK
	XMOVEI T1,LBLCB		;YES, POINTER TO CH FOR LARGE A-BLOCKS
	OPSTR <CAMG T2,>,CHSIZ,+BBLCB ;HOW ABOUT A LARGE-MEDIUM BLOCK?
	XMOVEI T1,BBLCB		;YES, POINTER TO CH FOR LARGE-MEDIUM A-BLOCKS
	OPSTR <CAMG T2,>,CHSIZ,+ABLCB ;HOW ABOUT A MEDIUM BLOCK?
	XMOVEI T1,ABLCB		;YES, POINTER TO CH FOR MEDIUM A-BLOCKS
	OPSTR <CAMG T2,>,CHSIZ,+SBLCB ;HOW ABOUT A SMALL BLOCK?
	XMOVEI T1,SBLCB		;YES, POINTER TO CH FOR SMALL A-BLOCKS
	STOR P1,CHREQ,(T1)	;;; Remember amount requested
	CALL DNGRBL		;ALLOCATE AN A-BLOCK (DON'T ZERO IT)
	  RET			;TELL CALLER WE LOST
>;END IFN FTD36MM
IFE FTD36MM,<
  IFN FTOPS20,<
	MOVE T1,T2		; Number of words needed
	HRL T1,MEMPRI		; Use priority requested by user
	MOVEI T2,.RESNP		;  from the DECnet extended pool
	XCALL (MSEC1,ASGRES)
  >  ;End FTOPS20
  IFN FTOPS10,<
	MOVEI T3,DCNACB##	; Get DECnet allocation control block
	MCALL (RG,MSEC1,GTXWDS##) ; Go allocate memory
  >
	 RET			; Tell caller we failed to get memory
>;END IFE FTD36MM
IFN FTLSTCOR,<
  IFE FTD36MM!FTOPS10,<
	  MOVE T2,-6(P)		;STKVAR uses 2 more
	  CAMN T2,[XADDR. DNGTAG] ;IS THIS A CALL FROM GET ZERO WORDS?
          MOVE T2,-11(P)	;YES, GET ADDRESS OF HIS CALLER
  >
  IFN FTD36MM!FTOPS10,<
          MOVE T2,-3(P)		;GET CALLING PC
	  CAMN T2,[XADDR. DNGTAG] ;IS THIS A CALL FROM GET ZERO WORDS?
          MOVE T2,-6(P)		;YES, GET ADDRESS OF HIS CALLER
  >
	  MOVEM T2,(T1)		;SAVE CALLER'S PC AT START OF BLOCK
	  AOJ T1,		;POINT PAST WHERE WE SAVED THE PC
> ;END IFN FTLSTCOR
	MOVEM P1,(T1)		;STORE COUNT IN RH OF OVERHEAD WORD
	MOVSI T2,'D36'		;MAKE A TEST THINGY
	HLLM T2,(T1)		;STORE IN LEFT HALF OF FIRST WORD
	AOJ T1,			;RETURN POINTER TO USER PART OF BLOCK
IFN FTLSTCOR,<
	MOVE T2,T1		; Get address of user data
	ADD T2,P1		; Point to 1 word past end of requested buffer
	MOVE T3,['D36COM']	; Get value to check against
	MOVEM T3,(T2)		; Write value into last word in block
>  ;End IFN FTLSTCOR
	RETSKP			;RETURN SUCCESS
	ENDSV.
	SUBTTL Core manager -- Get Some Zeroed Words

;DNGWDZ - Just like DNGWDS but the words are smeared to zero.
;	  Note that this is quite a lot more expensive than DNGWDS.
;
; Call:
;	T1/ Count of words we want
;
; Return:
;	RET			;ON ALLOCATION FAILURE
;	RETSKP			;WITH T1 POINTING TO WORDS
;
; Uses: T1-T4
;
;Note: The count of words allocated is stored in the word before the
;returned pointer.

	XRESCD
DNGWDZ::

IFE FTD36MM,<
IFN FTOPS20,<
DNGWZH::MOVEI T2,.RESP1
	JRST DNGWZ1
DNGWZN::SKIPA T2,[.RESP2]
DNGWZP::MOVEI T2,.RESP3
>
IFN FTOPS10,<
DNGWZH::
DNGWZN::
DNGWZP::
>>
IFN FTD36MM,<
DNGWZH::
DNGWZN::
DNGWZP::
>
DNGWZ1:	SAVEAC P1		;TO HOLD THE COUNT
				;(NOTE, GTWRDS KNOWS HOW MANY ACS ARE SAVED)
	MOVE P1,T1		;SAVE THE COUNT
	CALL GTWRDS		;GET SOME WORDS
DNGTAG:	 RET			;PROPOGATE ERROR RETURN
;Zero the words.
	MOVE T2,T1		;ADDRESS OF BLOCK
	ADDI T2,-1(P1)		;POINT TO LAST WORD IN BLOCK
	SETZ T3,		;WHAT TO SMEAR IT WITH
	MOVE P1,T1		;SAVE ADDRESS OF BLOCK
	CALL DNSWDS		;SMEAR ZEROES INTO BLOCK
	MOVE T1,P1		;RESTORE ADDRESS OF BLOCK FOR CALLER
	RETSKP			; AND GIVE GOOD RETURN
	SUBTTL Core manager -- Free Some Words

;DNFWDS - Free what DNGWDS took away
;
; Call:
;	T1/ Pointer to words allocated by DNGWDS
;
; Return:
;	RET			;ALWAYS
;
; Uses: T1,T2

	INTERNAL DNFWDS
	XRESCD
DNFWDS:	SOSG T1			;POINT T1 TO HEADER WORD
	BUG.(CHK,COMFWZ,D36COM,SOFT,<Tried to free words at zero>,,<

Cause:	DNFWDS was called with a 0 pointer.

Action:	Find the caller on the stack and determine why it has no valid
	pointer to free space.
>,RTN)

	HLRZ T3,(T1)		;GET THINGY TO CHECK AGAINST.
	CAIN T3,'D36'		;IS IT WHAT WE PUT THERE?
	IFSKP.
	  MOVE T2,(P)		; Get caller's address
	  BUG.(HLT,COMMMS,D36COM,SOFT,<Bad pointer passed to memory manager>,<<T1,BUFFER>,<T2,CALLER>>,<

Cause:	When DNGWDS gives out a block of memory, a check word is left
	right before the first word of memory given to the user. This
	word contains the length of the block in the right half, and a "check"
	quantity in the left to verify that this block is what is expected.
	This bug means that this word has either been trashed, or the
	pointer we have been passed is bad.

Action:	First determine if the pointer is bad, if the check word is trashed,
	or if the check word is 63D.  If the check word is 63D the memory has
	already been returned and we are trying to return it again.  If the
	check word is trashed then possible the owner trashed it or the user
	of the memory block previous to this one wrote too far.  If FTD36MM=0
	then the owner of the memory block is recorded in the block's header.
	For more detail see FREE.MAC.

Data:	BUFFER - Address of faulty buffer
	CALLER - Address of caller that provided the buffer

>,RTN)
	ENDIF.
	MOVEI T2,'63D'		; Destroy check word left half
	HRLM T2,(T1)		;  in case freed more than once
	HRRZ T2,(T1)		;GET COUNT OF WORDS BEING RETURNED
IFN FTLSTCOR,<
	MOVE T3,T1		; Get address of current position in block
	ADDI T3,1(T2)		; Point to first free location after requested
	MOVE T3,(T3)		; Get test string
	CAMN T3,['D36COM']	; Does it match?
	IFSKP.
	  MOVE T3,-1(T1)	; Get owner's PC
	  BUG. (CHK,COMCWT,D36COM,SOFT,<Check word trashed>,<<T1,MEMADR>,<T3,OWNER>>,<

Cause:	DNFWDS called with memory to return that had check word at end of
	requested buffer trashed.

Action:	See what routine called with the bad block and find out why the 
	check word was smashed.
>)
	ENDIF.
>  ;End IFN FTLSTCOR

IFN FTHMMEM,<
	SKIPN T3,MRQTAB		;Pointer to request table
	IFSKP.
	  ADD T3,T2		;Index to proper place
	  CAMGE T3,MRQMAX	;Be sure we don't go too far
	   SOS (T3)		; and decrement request count
	ENDIF.
>  ;END FTHMMEM
	AOJ T2,			;ADD IN WORD OF OVERHEAD
IFN FTLSTCORE,<
	ADDI T2,2		;Account for check words
	SOJ T1,			;DECREMENT POINTER TO OUR BLOCK.
	SETZM (T1)		;ERASE NAME OF OWNER OF BLOCK
>;END IFN FTLSTCORE
IFN FTD36MM,<
	MOVE T3,T2		;COPY SIZE OF RETURNING BLOCK
	XMOVEI T2,VBLCB		;ASSUME LARGEST BLOCK SIZE
	OPSTR <CAMG T3,>,CHSIZ,+LBLCB ;SEE IF IT MIGHT BE A LARGE BLOCK
	XMOVEI T2,LBLCB		;YES, POINTER TO CH FOR LARGE A-BLOCKS
	OPSTR <CAMG T3,>,CHSIZ,+BBLCB ;HOW ABOUT A LARGE-MEDIUM BLOCK?
	XMOVEI T2,BBLCB		;YES, POINTER TO CH FOR LARGE-MEDIUM A-BLOCKS
	OPSTR <CAMG T3,>,CHSIZ,+ABLCB ;HOW ABOUT A MEDIUM BLOCK?
	XMOVEI T2,ABLCB		;YES, POINTER TO CH FOR MEDIUM A-BLOCKS
	OPSTR <CAMG T3,>,CHSIZ,+SBLCB ;HOW ABOUT A SMALL BLOCK?
	XMOVEI T2,SBLCB		;YES, POINTER TO CH FOR SMALL A-BLOCKS
	CALLRET DNFRBL		;T1/ BLOCK TO FREE, T2/ CH BLOCK TO PUT IT ON
>;END IFN FTD36MM

IFE FTD36MM,<
  IFN FTOPS20,<
	XCALLRET (MSEC1,RELRES)	;Release memory
  >
  IFN FTOPS10,<
	EXCH T1,T2		;CORE1 WANTS T1/COUNT, T2/ADDRESS
	MOVEI T3,DCNACB##	;GET ADDRESS OF DECNET ALLOCATION CONTROL BLOCK
	MCALL (RG,MSEC1,GVXWDS##) ;LET GO OF OUR CORE.
	RET
  >
>;END IFE FTD36MM
	SUBTTL Core manager -- Get a DECnet-36 message block
;DNGMSG - Get a virgin message block and enough user data space for us
;
;Call:
;	T1/ Number of user data bytes needed.
;Return
;	RET		;ON ALLOCATION FAILURE
;	RETSKP		;T1 POINTS TO MESSAGE BLOCK, AND UD.MSD POINTS
;			; TO USER DATA FIELD, WHEREVER ALLOCATED

	XRESCD
DNGMSG::
	TRACE COM,Getting virgin message
	SAVEAC P1
	MOVE P1,T1		;SAVE COUNT OF USER DATA BYTES REQ'D
	XMOVEI T1,MBLCB		;POINTER TO CH FOR MESSAGE BLOCKS
	CALL DNGRBL		;(T1/T1)GO GET THE BLOCK
	  RET			;COULDN'T GET IT, RETURN AN ERROR
IFN FTLSTCOR,<
	MOVE T2,-2(P)		;GET CALLER'S PC
	MOVEM T2,(T1)		;PUT INTO FIRST HEADER WORD
	MOVE T2,['D36MSG']	;PUT TEST THING
	MOVEM T2,1(T1)		; IN SECOND HEADER WORD
	ADDI T1,2		;POINT PAST HEADER WORDS
>;END IFN FTLSTCOR
	MOVE T2,P1		;GET BACK NUMBER OF USER BYTES DESIRED
	MOVE P1,T1		;SAVE ADDR OF BLOCK
	SETZRO MDALA,+UD.MSD(P1) ;TELL DNMINI WE HAVE NO USER DATA NOW
	CALL DNMINI		;(T1,T2)MAKE THE MSG BLK SHINY NEW
	  JRST DNGMS1		;ERROR. RETURN MESSAGE BLOCK FIRST
	MOVE T1,P1		;PUT MB ADDRESS WHERE USER CAN FIND IT
	RETSKP			;GOOD RETURN, TELL CALLER WE WON

DNGMS1:	MOVE T1,P1		;GET ADDR OF MSG BLOCK WE WANT TO RETURN

IFN FTLSTCOR,<
	SUBI T1,2		;POINT TO START OF BLOCK
	HLRZ T2,1(T1)		;GET TEST THING
	CAIN T2,'D36'		;TEST IT.
	IFSKP.
	  MOVE T2,(T1)		;FAILED. GET ALLOCATOR'S ADDRESS
	  MOVE T3,1(T1)		;GET TEST THING
	  MOVE T4,-2(P)		;GET CALLER'S PC
	  BUG.(HLT,COMMS3,D36COM,SOFT,<Bad pointer passed to memory manager>,<<T1,BLKADR>,<T2,ALCADR>,<T3,TESTWD>,<T4,CALLER>>,<

Cause:	A header word is trashed or there is a bad pointer.

Action:	Check DNMINI to see why it trashed the check word

Data:	BLKADR - Block address
	ALCADR - Address of allocator
	TESTWD - Test thing
	CALLER - Address of caller to memory management
>)
	  RET
	ENDIF.
	SETZM 1(T1)		;CLEAR TEST THING.
	SETZM (T1)		;CLEAR ALLOCATOR'S PC
>;END IFN FTLSTCOR

	XMOVEI T2,MBLCB		;POINTER TO CH FOR MESSAGE BLOCKS
	CALLRET DNFRBL		;RELEASE THE BLOCK, AND GIVE BAD RETURN
;Get emergency message block.  Same as DNGMSG except it BUGs on failure.

	INTERNAL DNGEMS
	XRESCD
DNGEMS:
	TRACE COM,Getting virgin emergency buffer
	SAVEAC P1
	MOVE P1,T1		;SAVE NUMBER OF USER DATA BYTES NEEDED
	XMOVEI T1,MBLCB		;POINTER TO CH FOR MESSAGE BLOCKS
	CALL DNGRBP		;GET BLOCK, PRIV'D TO USE EMERGENCY BLKS
	  RET			;PROPOGATE ERROR RETURN, CALLER WILL BUG
IFN FTLSTCOR,<
	MOVE T2,-2(P)		;GET CALLER'S PC
	MOVEM T2,(T1)		;PUT INTO FIRST HEADER WORD
	MOVE T2,['D36EMS']	;PUT TEST THING
	MOVEM T2,1(T1)		; IN SECOND HEADER WORD
	ADDI T1,2
>;END IFN FTLSTCOR
	MOVE T2,P1		;GET BACK NUMBER OF USER BYTES DESIRED
	MOVE P1,T1		;SAVE ADDR OF BLOCK HERE, JUST IN CASE
	SETZRO MDALA,+UD.MSD(P1) ;TELL DNMINI WE HAVE NO USER DATA NOW
	CALL DNMINP		;PRIV'D ENTRY TO GET USER-DATA BUFFER
	  RET			;PROPOGATE ERROR RETURN, CALLER WILL BUG
	SETONE MBEBF,(P1)	;MARK THIS AS AN EMERGENCY BUFFER FOR ROUTER
	MOVE T1,P1		;PUT MB ADDRESS WHERE USER CAN FIND IT
	RETSKP			;GOOD RETURN, TELL CALLER WE WON
	SUBTTL Core manager -- Free a DECnet-36 message block
;DNFMSG - Give back what DNGMSG gave us
;
;Call
;	T1/ Pointer to message block to return
;Return
;	RET			;ALWAYS
;
;Note - If MDALA points to other than UD.DAT we will assume that MDALA
;	is a pointer to a separate user data block, and we will return
;	that block as well.

	INTERNAL DNFMSG
	XRESCD
DNFMSG:	
IFN FTPARANOID,<
	CAML T1,MBLCB		;THIS MUST COME FROM THE MBL BLOCKS
	IFSKP.
	  MOVE T2,0(P)		;IT DIDN'T. CALLER'S PC
	  BUG.(HLT,COMMPR,D36COM,SOFT,<Message pointer check>,<<T1,ACLADR>,<T2,CALLER>>,<

Cause:	DNFMSG caller tried to return a piece of memory not in the
	range of message blocks.

Action:	See stack for caller and find why it is trying to return
	a bad message block.

>)
	  RET
	ENDIF.
>;END IFN FTPARANOID

IFN FTLSTCOR,<
	SUBI T1,2		;POINT TO START OF BLOCK
	HLRZ T2,1(T1)		;GET TEST THING
	CAIN T2,'D36'		;TEST IT
	IFSKP.
   	  MOVE T2,(T1)		;FAILED. GET ALLOCATOR'S ADDRESS
	  MOVE T3,1(T1)		;TEST THING
	  MOVE T4,0(P)		;CALLER'S PC
	  BUG.(HLT,COMMS1,D36COM,SOFT,<Bad pointer passed to memory manager>,<<T1,BLKADR>,<T2,ALCADR>,<T3,TESTWD>,<T4,CALLER>>,<

Cause:	A header word is trashed or there is a bad pointer.

Data:	BLKADR - Address of memory block
	ALCADR - Allocator's address
	TESTWD - Test Word
	CALLER - Caller to memory management
>)
	  RET
	ENDIF.
	ADDI T1,2		;GET PAST THE HEADER WORDS
>;END IFN FTLSTCOR

	XMOVEI T2,UD.DAT(T1)	;GET EXTENDED POINTER TO UD.DAT
	OPSTR <SKIPE T3,>,MDALA,+UD.MSD(T1) ;GET ALLOCATED ADDRESS OF USER DATA
	 CAMN T3,T2		;IF MDALA ISN'T US, RELEASE HIM
	  JRST DNFMS0		;THE UBL IS NOT SEPARATE, JUST RELEASE MBL
	PUSH P,T1		;SAVE POINTER TO MBL
	MOVE T1,T3		;POINTER TO SEPARATE USER-DATA BLOCK
IFN FTLSTCOR,<
	SUBI T1,2		;POINT TO START OF BLOCK
	HLRZ T2,1(T1)		;GET TEST THING
	CAIN T2,'D36'		;TEST IT.
	IFSKP.
   	  MOVE T2,(T1)		;FAILED. GET ALLOCATOR'S ADDRESS
	  MOVE T3,1(T1)		;TEST THING
	  MOVE T4,-1(P)		;CALLER'S PC
	  BUG.(HLT,COMMS2,D36COM,SOFT,<Bad pointer passed to memory manager>,<<T1,BLKADR>,<T2,ALCADR>,<T3,TESTWD>,<T4,CALLER>>,<

Cause:	A header word is trashed or there is a bad pointer.

Data:	BLKADR - Address of memory block
	ALCADR - Allocator's address
	TESTWD - Test Word
	CALLER - Caller to memory management
>)
	  POP P,T1
	  RET
	ENDIF.
	SETZM 1(T1)		;CLEAR TEST THING.
	SETZM (T1)		;CLEAR ALLOCATOR'S PC
>;END IFN FTLSTCOR

	XMOVEI T2,UBLCB		;POINTER TO CH FOR USER DATA BLOCKS
	CALL DNFRBL		;RELEASE THE USER-DATA BLOCK
	POP P,T1		;GET BACK POINTER TO MESSAGE BLOCK
DNFMS0:

IFN FTLSTCOR,<
	SUBI T1,2		;THE HEADER WORDS
	SETZM (T1)		;CLEAR ALLOCATOR'S ADDRESS
	SETZM 1(T1)		;CLEAR TEST THING
>;END IFN FTLSTCOR

	XMOVEI T2,MBLCB		;POINTER TO CH FOR MESSAGE BLOCKS
	CALLRET DNFRBL		;FREE THE MESSAGE BLOCK ITSELF
	SUBTTL Core manager -- Fixed size block allocation entry points

repeat 0, < ;DNGEBL and DNFEBL will be removed completely when code is proven

;DNGEBL - Get an event block
;DNGEBP - (Doesn't exist)
;
;Call:
;
;Return:
;	RET			;ON ALLOCATION FAILURE
;	RETSKP			;WITH T1 POINTING TO BLOCK

DNGEBL::XMOVEI T1,EBLCB		;POINTER TO CH FOR EVENT BLOCKS
	CALLRET DNGRBL		;ALLOCATE THE BLOCK (DON'T ZERO IT)
;DNFEBL - Free an event data block
;Call
;	T1/ Pointer to block to be returned to free pool
;Return
;	RET			;Always.
;
;DNFEBL is called by NTMAN

DNFEBL::XMOVEI T2,EBLCB		;POINTER TO CH FOR EVENT BLOCKS
	CALLRET DNFRBL		;DE-ALLOCATE THE BLOCK
> ;End repeat 0

	SUBTTL Core manager -- Memory manager initialization code

;DNINIM - Initialize fixed core block memory manager.
;Call:
;
;Return:
;	RET	always.

	XSWAPCD
DNINIM::
IFN FTOPS10,<
	SAVEAC <T5,T6,P1>	;GET US A FEW PRESERVED REGISTERS
	MOVE T1,DCNVFF		;GET POINTER TO DECNET CORE
>;END IFN FTOPS10

IFN FTOPS20,<
	SAVEAC <T5,T6,P1,P2>	;GET US A FEW PRESERVED REGISTERS
	MOVSI T1,DNBSE1		;GET BUFFER ADDRESS (START OF DECnet SECTION)
	MOVE P2,T1		;SAVE START OF BUFFER ALLOCATION
>;END IFN FTOPS20


;T1 contains pointer to next available word of pool
;P1 contains length of memory init table CHBLKN

	MOVX P1,CHBLKN		;POINT PAST END OF CH BLOCKS
DNINM2:	SOJL P1,DNINM4		;POINT TO PREVIOUS CH BLOCK
	MOVE T3,P1		;WHICH CH ARE WE WORKING ON
	IMULI T3,CH.LEN		;POINTER TO WHICH CH WITHIN CHBLKS
	XMOVEI T4,CHBLKS	;POINTER TO CHBLKS VECTOR
	ADD T4,T3		;POINTER TO OUR CURRENT CH BLOCK
	LOAD T6,CHNUM,(T4) 	;GET NUMBER OF BLOCKS FOR THIS TYPE
	STOR T6,CHAVL,(T4)	;SAVE NUMBER OF BLOCKS AVAILABLE
	JUMPLE T6,DNINM2	;(JUST IN CASE OF DEFINING 0 BLOCKS FOR A TYPE)
	LOAD T5,CHSIZ,(T4) 	;GET SIZE OF BLOCKS FOR THIS TYPE
IFN FTFIXCOR,<
	CALL DNINCH		;(T1/T1)CHECK THAT BLOCK STAYS ON PAGE
>; End of FTFIXCOR
	STOR T1,CHBOT,(T4)	;SAVE START OF POOL FOR THIS TYPE OF BLOCKS
	STOR T1,CHPTR,(T4)	;SAVE POINTER TO FIRST FREE BLOCK
DNINM3:	MOVE T2,T1		;SAVE POINTER TO BLOCK
	ADD T1,T5		;POINT TO NEXT BLOCK
IFN FTFIXCOR,<
	CALL DNINCH		;(T1/T1)CHECK THAT BLOCK STAYS ON PAGE
>; End of IFN FTFIXCOR
	STOR T1,FBNXT,(T2)	;STORE POINTER TO NEXT BLOCK
	SOJG T6,DNINM3		;DO ANOTHER BLOCK
	SETZRO FBNXT,(T2)	;LAST BLOCK HAS END OF LIST INSTEAD OF POINTER
	JRST DNINM2		;GO DO ANOTHER TYPE OF CORE BLOCK

DNINM4:

IFN FTOPS10,<
	MOVEM T1,DCNVFF		;SAVE ADDRESS OF DECNET FIRST FREE
>; END IFN FTOPS10
IFN FTOPS20,<			;LOCK DOWN THE PAGES WE'VE JUST ALLOCATED
	MOVE P1,T1		;SAVE FINAL ADDRESS IN P1
	TLZ P1,-1		;CLEAR ANY SECTION NUMBER
	ADDI P1,777		;ROUND UP TO FULL PAGE
	LSH P1,-11		;CONVERT TO NUMBER OF PAGES
	MOVE T1,P2		;GET BACK ADDRESS OF START OF ALLOCATION
	XCALL (MSEC1,FPTA)	;GET THE PAGE TABLE
	MOVEM T1,P2		;SAVE FIRST PAGE NUMBER
DNINM6:	XCALL (MSEC1,MLKPG)	;LOCK THE PAGE IN MEMORY
	AOS T1,P2		;STEP TO NEXT PAGE
	SOJG P1,DNINM6		;LOCK IT TOO IF ITS NEEDED
>;END IFN FTOPS20
IFN FTHMMEM,<
	MOVEI T1,VBLSIZ		;Reserve a very large block for memory request
	CALL DNGWDS		; table
	 SETZ T1,		;
	MOVEM T1,MRQTAB		;Save for DNGWDS/DNFWDS
>  ;END FTHMMEM
	CALL DNNMSG		;(/T1)RETURN LESSER OF # MBLs & # UBLs
	MOVEM T1,DCNTSB		;STORE AS TOTAL SYSTEM BUFFERS
	CALLRET CHKCNG		;(T1)CHECK CONGESTION THRESHOLDS
;Local subroutine to check that a block is wholly contained in a page
;only called from DNINIM, right here.
;	T1/ Proposed starting address of new block
;	T5/ Length of new block

;Preserves T2,T4,T5,T6
IFN FTFIXCOR,<
DNINCH:	CAILE T5,1000		;BLOCK LESS THAN A PAGE IN LENGTH
	RET			;NO, CAN'T FIT IT IN A PAGE ANYWAY
	MOVX T3,777		;MASK FOR ADDRESSES WITHIN A PAGE
	AND T3,T1		;GET BLK'S OFFSET W/IN PAGE
	ADD T3,T5		;WILL BLOCK
	TRNN T3,777000		; CROSS PAGE BOUNDARY?
	RET			;NO, LEAVE ADDRESS ALONE
	ADDI T1,777		;YES, ROUND
	TRZ T1,777		; UP TO NEXT PAGE
	RET			;ONLY RETURN
>; End of IFN FTFIXCOR

	XRESCD			;Back to resident

	SUBTTL Core manager -- Increment count of emergency buffers

;DNGEBF - Used to define the number of buffers to be saved for emergencies
;Call
;	T1/ Number of buffers to reserve
;Return
;	RET			;Not enough buffers to let you do this
;	RETSKP			;Extra emergency buffers saved

	XRESCD
DNGEBF::
	TRACE COM,Reserving buffers for emergencies
	SYSPIF			;DELICATE STUFF, MAKE SURE NO ONE TOUCHES US
	CAML T1,DCNTSB		;#ASKING FOR ALL THE BUFFERS?
	 JRST DONRET		;#YES, LOSE
	ADDM T1,DCNEMR		;#RAISE EMERGENCY THRESHOLD
	ADDM T1,DCNCNG		;# AND CONGESTION THRESHOLD
	ADDM T1,DCNUCG		;# AND UNCONGESTION THRESHOLD
	MOVNS T1		;#LOWER SCLINK'S LIMITS
	ADDB T1,DCNTSB		;#TOTAL SYSTEM BUFFERS
	CALL CHKCNG		;#(T1)CHECK CONGESTION THRESHOLDS
	SYSPIN			;#ALLOW INTERRUPTS AGAIN
	RETSKP			;TELL CALLER WE RESERVED HIS BUFFERS


;CHKCNG check that congestion thresholds still make sense
;	after other levels have been shifted
;
;Call:	SYSPIF still from changing other thresholds, if needed
;	T1/ Contents of DCNTSB

CHKCNG:	CAMGE T1,DCNCNG		;#COMPARE WITH DECLARED CONGEST THRESHOLD
	MOVEM T1,DCNCNG		;#CONGEST TOO LARGE, REPLACE WITH DCNTSB
	CAMGE T1,DCNUCG		;#COMPARE WITH DECLARED UNCONGEST THRESHOLD
	MOVEM T1,DCNUCG		;#UNCONGEST TOO LARGE, REPLACE WITH DCNTSB
	MOVE T1,DCNUCG		;#GET UN-CONGESTION THRESHOLD
	SUBI T1,2		;#ASSURE A MARGIN OF AT LEAST 2
	CAMGE T1,DCNCNG		;# BETWEEN CONGESTION & UNCONGESTION
	MOVEM T1,DCNCNG		;# TO PREVENT KAF FLIPPING BETWEEN CNG & UCG
	RET			;#ONLY RETURN FROM CHKCNG
	SUBTTL Core manager -- Return number of blocks available (for router)
;DNNMSG - Return MIN(UBL,MBL) available.
;Call
;Return
;	+1, T1/ Number of blocks available for router
;Note - This is probably innacurate. Re-do later accounting for emergency
;reserves and allocations to session control.

	INTERNAL DNNMSG
	XRESCD
DNNMSG:	LOAD T1,CHAVL,+UBLCB	;GET NUMBER OF USER DATA BLOCKS AVAILABLE
	OPSTR <CAMLE T1,>,CHAVL,+MBLCB ;MAKE SURE WE HAVE MORE MBL'S
	LOAD T1,CHAVL,+MBLCB	;NOPE, MBL'S ARE LEAST COMMON, USE THEM.
	RET			;RETURN
	SUBTTL Core manager -- Get a Block from a Free Pool

;DNGRBL - Get the first block from free pool, if enough are left
;DNGRBP - Same, Privileged to get emergency blocks
;DNGRBA - Same, but T2 is zero for non-priv'd, -1 for priv'd
;Call
;	T1/ Pointer to CH block for this type of block
;Return
;	RET			;ON ALLOCATION FAILURE
;	RETSKP			;WITH T1 CONTAINING ADDRESS OF BLOCK

DNGRBL:	TDZA T2,T2		;ZERO MEANS NO PRIVS FOR EMERGENCY BLKS
DNGRBP:	MOVEI T2,1		;NON-ZERO MEANS WE HAVE PRIVS
DNGRBA:	SAVEAC <P1,P2>
IFN FTPARANOID,<
	STKVAR <S1,S2>		;Scratch storage
>
	DMOVE P1,T1		;SAVE POINTER TO CH BLOCK & PRIV FLAG
	SYSPIF			;#CODE BELOW CANNOT BE INTERRUPTED
	LOAD T1,CHAVL,(P1)	;#GET CURRENTLY AVAILABLE BLOCK COUNT
	JE CHCON,(P1),DNGRB2	;#JUMP IF BLK TYPE NOT CONGESTION CONTROLLED
	CAMG T1,DCNCNG		;#WILL WE GO BELOW CONGESTION THRESHOLD?
	SKIPE DCNCON		;#YES, WERE WE ALREADY CONGESTED?
	JRST DNGRB1		;#NO, DON'T ANNOUNCE CONGESTION TWICE
	SETOM DCNCON		;#YES, SET CONGESTION FLAG
	SYSPIN
	TRACE COM,DNGRBL congested
	CALL NSPCG		; TELL NSP THAT WE ARE GETTING CONGESTED
	SYSPIF
	LOAD T1,CHAVL,(P1)	;#GET NEW AVAIL COUNT AFTER NSPCG CALL
DNGRB1:	CAMG T1,DCNEMR		;#WILL WE GO BELOW EMERGENCY THRESHOLD?
	JUMPE P2,DONRET		;#YES, DON'T GIVE HIM THE BLOCK UNLESS PRIV'D
DNGRB2:	JUMPLE T1,DONRET	;#NO, FAIL IF THERE ARE NO MORE BLOCKS
	OPSTRM <SOS>,CHAVL,(P1) ;#DECREMENT AVAILABLE BLOCKS
	LOAD T1,CHLWM,(P1)	;;; Get the low water mark so far
	LOAD T2,CHAVL,(P1)	;;;  and current available
	CAMLE T1,T2		;;; Have we gone lower
	 STOR T2,CHLWM,(P1)	;;; Yes, remember new mark
	OPSTR <SKIPN T1,>,CHPTR,(P1) ;#GET PTR TO FIRST AVAILABLE BLOCK
	 BUG.(CHK,COMIEL,D36COM,SOFT,<Illegal end of list pointer>,,<

Cause:	CHAVL, the available count, indicated there was at least one block
	on the free list, but the first pointer was zero.

Action:	A forward pointer in a block which was returned some time ago was 
	probably smashed.

>,DONRET)
	LOAD T2,FBNXT,(T1)	;#GET PTR TO NEXT AVAILABLE BLOCK
IFN FTPARANOID,<
	JUMPE T2,DNGRB3		;IF NEXT POINTER IS ZERO, IT'S OK
	MOVEM T1,S1		;SAVE POINTER TO CURRENT BLOCK
	MOVEM T2,S2		;SAVE POINTER TO NEXT BLOCK
	MOVE T1,T2		;GET POINTER TO NEXT BLOCK
	MOVE T2,P1		;GET POINTER TO CH BLOCK
	CALL DNCHFB		;CHECK THE NEXT BLOCK
	 JRST DONRET		;;; We don't ever expect to get here cause
				;;; DNCHFB BUGHLT's if error
	MOVE T1,S1
	MOVE T2,S2
DNGRB3:
>;END OF IFN FTPARANOID
	STOR T2,CHPTR,(P1)	;#POINT PAST BLOCK WE NOW HAVE
	SYSPIN			;#ALLOW INTERRUPTS AGAIN
IFN FTPARANOID,<
	MOVE T2,P1		;COPY PTR
	CALL DNCHFB		;CHECK PTR TO CORE WE HAVE BEEN GIVEN
	 RET			;IN CASE WE FIND OUR BUG
>;END OF IFN FTPARANOID
IFN FTLSTCOR,<
	LOAD T2,CHSIZ,(P1)	; Get size of this block in words
	ADD T2,T1		; Point to 1 word past end
	MOVE T3,['D36COM']	; Get value to check against
	MOVEM T3,-1(T2)		; Write value into last word in block
> ;End IFN FTLSTCOR
	RETSKP			;RETURN SUCCESS
	ENDSV.
;DNFRBL - Free a block

;Call:	T1/ Ptr to block to be freed
;	T2/ Ptr to CH block for free list
;	CALL DNFRBL
;	Only Return

DNFRBL:	SAVEAC <P1,P2>
	DMOVE P1,T1		;T1/ SAVE ADDR OF BLOCK TO BE RETURNED
				;T2/ SAVE ADDR OF CH BLOCK
IFN FTPARANOID,<
	CALL DNCHFB		;CHECK PTR TO CORE WE HAVE BEEN GIVEN
	  RET			;IN CASE WE FIND OUR BUG
>;END OF IFN FTPARANOID
IFN FTLSTCOR,<
	MOVE T1,P1		; Get back address of block
	LOAD T2,CHSIZ,(P2)	; Get allocated size of block
	ADDI T1,-1(T2)		; Point to last word
	MOVE T1,(T1)		; Get test string
	CAMN T1,['D36COM']	; Does it match?
	IFSKP.
	  MOVE P2,-3(P)		; Caller's PC
	  BUG. (CHK,COMEBT,D36COM,SOFT,<End of memory block trashed>,<<P1,MEMADR>,<P2,CALLER>>,<

Cause:	DNFRBL called with block to return that had its last word smashed.

Action:	See who called with the bad block and find out why the last word
	was smashed.
>)
	  RET
	ENDIF.
> ;End FTLSTCOR
	SYSPIF			;#KEEP DATA BASE CLEAN WHILE WE CHANGE IT
	LOAD T2,CHPTR,(P2)	;#ADDRESS OF CURRENT FIRST AVAIL BLOCK
	STOR T2,FBNXT,(P1)	;#SAVE IN OUR FREE BLOCK
	STOR P1,CHPTR,(P2)	;#FIRST AVAIL BLOCK IS NOW US
	OPSTRM <AOS>,CHAVL,(P2) ;#INCREMENT THE NUMBER OF AVAIL BLOCKS
	SKIPN DCNCON		;#IS SYSTEM CONGESTED?
	JRST DONRET		;#NO, SYSPIN AND RETURN
	TMNN CHCON,(P2)		;#IS BLK TYPE CONGESTION CONTROLLED?
	JRST DONRET		;#NO, SYSPIN AND RETURN

;Here if system is congested, whether or not we are returning a message blk.

	LOAD T1,CHAVL,+UBLCB	;#YES, GET NUMBER OF USER DATA BLOCKS AVAILABLE
	OPSTR <CAMLE T1,>,CHAVL,+MBLCB ;#MAKE SURE WE HAVE MORE MBL'S
	LOAD T1,CHAVL,+MBLCB	;#NOPE, MBL'S ARE LEAST COMMON, USE THEM.
	CAMGE T1,DCNUCG		;#ARE WE AT UNCONGESTION THRESHOLD?
	JRST DONRET		;#NO, SYSPIN AND RETURN
	MOVE T1,DCNTSB		;#YES, CHECK SCTL'S RESERVATION COUNTER
	SUB T1,DCNRSB		;#SUBTRACT RESERVED FROM TOTAL BUFFERS
	CAMGE T1,DCNUCG		;#DIFFERENCE ABOVE UNCONGEST THRESH TOO?
	JRST DONRET		;#NO, MUST HAVE RESERVED SMALL BFRS IN MSG BLK
	SETZM DCNCON		;#YES, NO LONGER CONGESTED
	SYSPIN			;END OF CRITICAL SECTION
	CALLRET NSPCR		;TELL NSP & SCTL THE NEWS


DONRET::SYSPIN			;GENERAL SYSPIN/RET FOR D36COM
	RET

	SUBTTL  DNMCUB - Check for trashed UBL
;Call:
;	T1/ Address of UBL
;
;	BUGCHK's if trashed UBL detected

IFN FTLSTCOR,<
DNMCUB::XMOVEI T2,UBLCB			; Address of UBL core block
	LOAD T2,CHSIZ,(T2)		; Get allocated size of block
	ADDI T1,-3(T2)			; Point to last word
	MOVE T1,(T1)			; Get test string
	CAME T1,['D36COM']		; Does it match?
	  BUG. (CHK,D36UBT,D36COM,SOFT,<End of UBL trashed>,,<

Cause:	DNADLL called with message received that had its last word smashed.

Action:	See who called DNADLL with a bad block.  Look for too short a
	buffer from DNADLL or a message too long from driver or a message
	beginning one or more words too far into buffer.
>)
	RET
>  ;End IFN FTLSTCOR

	SUBTTL Core manager -- Checking routines for debugging only

IFN FTCORBUG,<

;DNCHCH - Check CH pointer for validity. Debugging routine only
;Call
;	T1/ CH pointer to check.
;Return
;	RET		;If we find our BUG
;	RETSKP		;If the CH is kosher


DNCHCH:	SAVEAC <T1,T2,T3,T4>	;SAVE SOME ACS
	SYSPIF			;TURN OFF INTERRUPTS FOR A WHILE
	XMOVEI T2,CHBLKS	;GET POINTER TO VALID CH BLOCKS
	MOVE T3,T2		;COPY IT
	ADDI T3,CH.LEN*<CHBLKN-1> ;POINTER TO LAST VALID BLOCK
	CAMG T1,T3		;ARE WE BEYOND GOOD BLOCKS?
	 CAMGE T1,T2		;OR BELOW GOOD BLOCKS?
	  BUG.(CHK,COMCHO,D36COM,SOFT,<CH pointer out of range>,,<

Cause:	In the core block checking routines, the internal pointer
	to the CH begstr applying to this type of block is bad.

	This may mean that your executable code has been trashed.
>,DNCHX)
	MOVE T4,T1		;SAVE A COPY OF CH POINTER
	SUB T1,T2		;GET RELATIVE ADDRESS WITH BLOCKS
	IDIVI T1,CH.LEN		;FIND OUT IF WE ARE ON A BOUNDARY
	SKIPE T2		;IF NO REMAINDER, THE ADDRESS IS GOOD
	 BUG.(CHK,COMCHB,D36COM,SOFT,<CH pointer off by a few>,,<

Cause:	A pointer internal to the core management routines is off
	by a few words. This probably means that an AC has been 
	trashed by adding to it or XORing some bits.
>,DNCHX)
	LOAD T1,CHAVL,(T4)	;GET NUMBER OF AVAILABLE BLOCKS
	OPSTR <CAMLE T1,>,CHNUM,(T4) ;COMPARE AGAINST TOTAL NUMBER OF BLOCKS
	 BUG.(CHK,COMCHA,D36COM,SOFT,<Number of available FB blocks to large>,,<

Cause:	When checking the CH begstr for a type of block, we noticed that
	we have more blocks available than we started out with. Since
	DNCHFB is supposed to defend against this, what probably has
	happened is that CHNUM has been trashed.
>,DNCHX)
	JN CHBOT,(T4),DNCHX1	;MAKE SURE WE HAVE BEEN INITIALIZED
	BUG.(CHK,COMMMI,D36COM,SOFT,<Memory manager must be initialized>,,<

Cause:	The field CHBOT, which indicates where a free core pool starts,
	is zero. This field gets set when the core manager initializes.

Action:	If DNINIM has already been called, check it to make sure it is
	initializing all CH blocks.
>,DNCHX)

DNCHX1:	AOS (P)			;GIVE SKIP RETURN
DNCHX:	SYSPIN			;GIVE UP INTERLOCK
	RET			; AND RETURN

>;END OF IFN FTCORBUG
	SUBTTL Core manager -- Check pointer for validity
IFN FTPARANOID,<

;DNCHFree Block - Check Free Block pointer for validity.
;
;Call:
;	T1/ Free Block pointer to check.
;	T2/ CH pointer for this Free Block
;	Note, call when you think the Free Block is NOT on the free list
;Return:
;	RET		;When we find our bug
;	RETSKP		;If Free Block is kosher

DNCHFB:	SAVEAC <T1,T2,T3,T4,P1,P2,FL,FREE2>
	DMOVE P1,T1		;Save FB & CH pointers
IFN FTCORBUG,<
	MOVE T1,T2		;GET AC DNCHCH WANTS
	CALL DNCHCH		;CHECK THE CH POINTER TO MAKE SURE
	 RET			;OOPS
>; END IFN FTCORBUG

	LOAD T3,CHBOT,(P2)	;GET ADDRESS OF START OF POOL
IFE FTFIXCOR,<			;these checks don't work on page-aligned
				; pools.
	LOAD T4,CHNUM,(P2)	;GET NUMBER OF BLOCKS
	SOJ T4,			;BACK DOWN BY ONE, TO GET HIGHEST NUMBER BLOCK
	OPSTR <IMUL T4,>,CHSIZ,(P2) ;MULTIPLY BY SIZE
	ADD T4,T3		;ADD IN LOW ADDR, GET HIGHEST LEGAL ADDR FOR FB
	CAMG P1,T4		;RANGE CHECK THE FB POINTER
>; End of IFE FTFIXCOR
	 CAMGE P1,T3		;NOT ABOVE MAX, CHECK FOR BELOW MAX
	  BUG.(HLT,COMFBO,D36COM,SOFT,<FB pointer is out of range>,,<

Cause:	A free block pointer being checked is not pointing to the 
	free core allocated for this type of block.

Action:	Find out who supplied this pointer.
>,RTN)
IFE FTFIXCOR,<			;these checks don't work on page-aligned
				; pools.
	MOVE T1,P1		;GET BACK FB POINTER
	SUB T1,T3		;CONVERT POINTER TO RELATIVE ADDR
	OPSTR <IDIV T1,>,CHSIZ,(P2) ;CONVERT TO ABSOLUTE NUMBER OF BLOCK
	SKIPE T2		;MAKE SURE WE WERE ON A BLOCK BOUNDARY
	 BUG.(HLT,COMFBT,D36COM,SOFT,<FB pointer is off by a few>,,<

Cause:	A free block pointer is off by a few words. This probably means
	that the user of this pointer had added a constant, and forgot
	to restore it when giving back the block.

Action:	Trace the user of this pointer, and make sure the pointer is
	valid when given to the memory manager.
>,RTN)

>; End of IFE FTFIXCOR

IFN FTCORBUG,<
;Check the entire FB data structure, making sure all pointers in blocks
; are good, and this block isn't already on the free list.

	SYSPIF			;TURN OFF INTERRUPTS
	LOAD FREE2,CHAVL,(P2)	;GET NUMBER OF BLOCKS WE THINK ARE ON LIST
	LOAD T1,CHPTR,(P2)	;GET POINTER TO FIRST FB BLOCK
DNCHF1:	JUMPE T1,DNCHF2		;AT END OF LIST, EXIT
IFE FTFIXCOR,<			;these checks don't work on page-aligned
				; pools.
	CAMG T1,T4		;IS IT ABOVE HIGH RANGE?
>; End of IFE FTFIXCOR
	 CAMGE T1,T3		;OR BELOW LOW RANGE?
	  BUG.(CHK,COMAFB,D36COM,SOFT,<A free block pointer is bad>,,<

Cause:	There is a block on a free list whose address is not in the 
	range expected for this list.  The offending pointer is in P1.

Action:	Somebody back on the stack is probably returning a block to the
	wrong free list or is returning a junk pointer.
>,DNCHX)
	MOVE FL,T1		;SAVE FOR DURATION OF ROUTINE

IFE FTFIXCOR,<			;these checks don't work on page-aligned
				; pools.
	SUB T1,T3		;RELATIVE POINTER
	OPSTR <IDIV T1,>,CHSIZ,(P2) ;CONVERT TO ABSOLUTE BLOCK NUMBER
	SKIPE T2		;MAKE SURE WE WERE ON A BLOCK BOUNDARY
	BUG.(CHK,COMFBB,D36COM,SOFT,<FB in data base is off by a few>,,<

Cause:	DNCHFB has found a block on a free list, most likely just returned
	to it, whose address is not on a block boundary for blocks on
	this free list.  The offending pointer is in P1.

Action:	Somebody back on the stack is probably returning a junk pointer,
	either a real pointer to a block which has been incremented or
	decremented or a completely junk pointer.

>,DNCHX)
>; End of IFE FTFIXCOR
	CAMN FL,P1		;MAKE SURE THIS ISNT THE BLOCK I HAVE
	 BUG.(CHK,COMFBF,D36COM,SOFT,<FB is already on free list>,,<

Cause:	The block that P1 points at is already on the free list and
	is being returned again.

Action:	Somebody back on the stack is returning a block which is already
	free.  Either that caller is in error or some previous returner
	is in error.
>,DNCHX)

	LOAD T1,FBNXT,(FL)	;GET NEXT POINTER IN THE LIST
	SOJA FREE2,DNCHF1	;AND TRY AGAIN

DNCHF2:	SKIPE FREE2		;ASSURE WE CHECKED RIGHT NUMBER OF BLOCKS
	BUG.(CHK,COMFBA,D36COM,SOFT,<FB available count is wrong>,,<

Cause:	DNCHFB walked a free list and found a different number of
	blocks on the list than the header indicated.

Action:	Somebody probably smashed a forward pointer in a block which was
	returned some time ago.  Find out who.
>,DNCHX)
	SYSPIN			;TURN THEM BACK ON
>;END OF IFN FTCORBUG

	RETSKP			;INDICATE ALL WARM AND FUZZY


;DNCHMB - Check a message block pointer. Called from ROUTER.
;Call
;	MB/ Pointer to message block
;Return
;	Always. Will BUG if an error, but will return.

	INTERNAL DNCHMB
	XRESCD
DNCHMB:	SAVEAC <T1,T2>		;WE ARE GOING TO USE THESE ACS
	MOVE T1,T3		;MESSAGE BLOCK POINTER
IFN FTLSTCOR,<
	SUBI T1,2		;ALLOW FOR HEADER WORDS
>;END IFN FTLSTCOR
	XMOVEI T2,MBLCB		;POINTER TO THE CH STRUCTURE WE CARE ABOUT.
	JRST DNCHFB		;GO AND DO COMPLETE CHECKS FOR THE POINTER

>;END OF IFN FTPARANOID
	SUBTTL Time -- Get current time in ms.

;DNGTIM - Get a timestamp in the proper units into T1
;
;Call:	CALL	DNGTIM
;	Normal Return with time in T1
;Changes T1,T2

	TIMBAS==:^D1000		;FRACTIONS OF A SECOND WITH WHICH TIME
				;IS REPRESENTED.  USED BY OTHER
				;ROUTINES WHICH MANIPULATE TIMERS
	INTERNAL DNGTIM
	XRESCD
DNGTIM:
IFN FTOPS10,<
	MOVE T1,SYSUTM##	;GET MILLISECONDS OF SYSTEM UPTIME
>;End of IFN FTOPS10

IFN FTOPS20,<
	MOVE T1,TODCLK		;GET MILLSECONDS OF SYSTEM UPTIME
>;End of IFN FTOPS20

	RET

	SUBTTL Network management -- NTPARM - parameters

;NTPARM - network management operations for parameters
;
;This routine will make it easier to implement the 'set', 'read' and 'clear'
; network management functions.
;
;Call:	T1/ address of parameter table
;	T2/ length of parameter table (i.e. # of parameters defined)
;	T3/ requested function (NF.SET, NF.RED or NF.CLR)
;	P1/ address of NF block
;	CALL NTPARM
;	 +1 return on error with T1/ network management error code
;	+2 return on success
;
;The PARAMETER macro that is used to define the parameter table contains
; instructions to be executed to set, read and clear a parameter. NTPARM
; expects this instruction (that of course may be a CALL) to:
;	- always return +1
;
;When the instruction is executed, P1 will contain the NF address and T2
;	on set:		the new value
;	on clear:	the default value specified in the table
;	on read:	should return with the new value
;
; NTPARM will not touch any AC except T1-T4
;

	INTERNAL NTPARM
	XSWAPCD
NTPARM:	STKVAR <TABADR,TABLEN,FUNC,BUFLAG>
	MOVEM T1,TABADR		;Save table address
	MOVEM T2,TABLEN		; and table length
	SETZM FUNC		;Assume function is READ (FUNC EQ 0)
	CAIN T3,NF.SET		;Is it SET?
	 SETOM FUNC		; -yes, set FUNC EQ -1
	CAIN T3,NF.CLR		;Or CLEAR?
	 MOVEM T3,FUNC		; -yes, move value GT 0 to FUNC
	ASSUME NF.CLR,GT,0

;Loop over parameter table, AC usage is:
;	T2/ parameter #
;	T3/ loop index
;	T4/ address of PA block

	LOAD T2,NFPRM,(P1)	;Get parameter number
	SETZ T3,		;Begin at index 0
	DO.			;LOOP
	  CAML T3,TABLEN	;  Done all entries
	  RNMXER (NF.UPT)	;   -no match, return error
	  MOVE T4,TABADR	;  Get table address
	  ADD T4,T3		;   and make pointer to current table entry
	  MOVE T4,(T4)		;    and make pointer to PA block
	  OPSTR <CAMN T2,>,PAPNR,(T4) ;Correct parameter number?
	  EXIT.			;  -yes, exit loop
	  AOJA T3,TOP.		;  -no, loop back and try next index
	ENDDO.

	TMNN PABEX,(T4)		;Is NTMAN supplied buffer ok?
	IFSKP.
	  SETOM BUFLAG		; Indicate buffer is expected
	  TMNE NFBFF,(P1)	; Is buffer present?
	  IFSKP.
	    BUG. (CHK,NTNBFS,D36COM,SOFT,<No buffer supplied>,,<

Cause:	The routine NTPARM was called to handle a network management parameter.
	The caller of NTPARM said that it expects the call from NTMAN to
	supply a buffer for the parameters to be read from or stored into.
	None was supplied.
>)
	    RNMXER (NF.MPE)	; Return "management program error"
	  ENDIF.
	ELSE.
;Verify that buffer flag is clear (this routine handles only single value
; returns)
	  SETZM BUFLAG		; No buffer, data appears in argument block
	  TMNN NFBFF,(P1)	;Buffer flag set?
	  IFSKP.		; -yes,
	    BUG.(CHK,NTBSUP,D36COM,SOFT,<Buffer supplied>,,<

Cause:	The routine NTPARM was called to handle a network management parameter.
	The routine can only handle returns of a single value, but NTMAN had
	supplied a multi-word buffer.
>)
	    RNMXER (NF.MPE)	; and return "management program error"
	  ENDIF.
	ENDIF.
;Here when buffers are checked and table address is selected
	MOVX T1,NF.FCS		;This will be a flag (sigh) to indicate error
	SKIPL FUNC		;Is it SET?
	IFSKP.			; -yes,
	  TMNE PANST,(T4)	;Can this parameter be set
	   RNMXER (NF.OPF)	;No, return error
	  LOAD T2,NFBUF,(P1)	;  No, get new value and check it
	  TMNE PADRC,(T4)	;Have we been told not to range check this
	  IFSKP.	 	;value?
	    OPSTR <CAML T2,>,PAMIN,(T4) ; Less than the minimum?
	     OPSTR <CAMLE T2,>,PAMAX,(T4) ; or greater than the maximum?
	      RNMXER (NF.IPV)	; Yes, bad value
	  ENDIF.
	  OPSTR <XCT>,PASET,(T4) ;  Execute instruction to do SET (If the
				;    execute calls a routine it is not obliged
				;    to use T2)
	ELSE.
	  SKIPG FUNC		; -no, is it CLEAR
	  IFSKP.		;  -yes,
	    TMNE PANCL,(T4)	;Can this parameter be cleared?
	     RNMXER (NF.OPF)	;No, return error
	    LOAD T2,PADEF,(T4)	;    Load default value as promised
	    OPSTR <XCT>,PACLR,(T4) ; execute instruction to do CLEAR (If the
				;     executed intruction calls a routine the
				;     the routine is not obliged to use T2
	  ELSE.			;  -no, it is READ
	    OPSTR <XCT>,PARED,(T4) ; Get value
	    SKIPL BUFLAG	; If buffer present data is already stored
	     STOR T2,NFBUF,(P1)	;     and return it in NF block
	  ENDIF.
	ENDIF.
	ASSUME NF.NDP,EQ,0
	JUMPLE T1,RTN		; If T1 is negative (error) or 0 (no data),
				;  then return error
	RETSKP			;All done, return

	ENDSV.
	XRESCD

	SUBTTL Network management -- NTCTRS - counters

;NTCTRS - network management operations for counters
;
;This routine will make it easier to implement the 'show' and 'show and zero'
; network management functions.
;
;Call:	T1/ address of counter table
;	T2/ length of counter table (i.e. # of counters defined)
;	T3/ requested function (NF.SHO or NF.SZC)
;	P1/ address of NF block
;	CALL NTCTRS
;	 +1 return on error with T1/ network management error code
;	+2 return on success
;
;The COUNTER macro that is used to define the counter table contains
; instructions to be executed to read and to clear a counter. NTCTRS
; expects this instruction (that of course may be a CALL) to:
;	- always return +1
;	- return the counter value in T1
;	- not destroy any accumulators, including T2-T4
;When the instruction is executed, P1 will contain the NF address. NTCTRS
; will not touch any AC except T1-T4
;
;If the read/read & clear operation has to be interlocked, then the caller
; is responsible for interlocking before calling NTCTRS.

	INTERNAL NTCTRS
	XSWAPCD
NTCTRS:	STKVAR <TABADR,TABLEN,DOCLR>
	MOVEM T1,TABADR		;Save counter table address
	MOVEM T2,TABLEN		; and length of table
	SETZM DOCLR		;Assume read-only operation
	CAIN T3,NF.SZC		;Is it zero also?
	 SETOM DOCLR		; -yes, flag clear should be done

;Verify that the 'buffer present' flag is set
	TMNE NFBFF,(P1)		;Is it set?
	IFSKP.			; -no, bugcheck and return error
	  BUG.(CHK,NTNBUF,D36COM,SOFT,<No buffer supplied>,,<

Cause:	NTMAN requested a show counter operation, but did not supply a
	buffer to store the counters in.
>)
	  RNMXER (NF.MPE)	; and return "management program error"
	ENDIF.

;Verify that buffer is large enough for all counters in table
	MOVE T1,TABLEN		;Get # of counters
	ASH T1,1		; and we use two words for each counter
	OPSTR <CAMG T1,>,NFBLN,(P1) ;Compare with supplied size
	IFSKP.			; -too big,
	  BUG.(CHK,NTBTSM,D36COM,SOFT,<Buffer too small>,,<

Cause:	NTMAN requested a show counter operation, but did not supply a
	buffer large enough to store all the counters.
>)
	  RNMXER (NF.MPE)	; -and return "management program error"
	ENDIF.
	STOR T1,NFBLN,(P1)	;Store # of words we are going to write...

;Loop over all counters, AC usage is:
;	T2/ address of counter buffer
;	T3/ index into counter table
;	T4/ pointer to current CT block

	LOAD T2,NFBUF,(P1)	;Get buffer address
	SETZ T3,		;Start at index 0
	DO.			;LOOP
	  CAML T3,TABLEN	;  Done all counters yet?
	  RETSKP		;   -yes, return suceess
	  MOVE T4,TABADR	;  Get address of counter table
	  ADD T4,T3		;   and add in index
	  MOVE T4,(T4)		;    and make pointer to CT block
	  LOAD T1,CTHDR,(T4)	;  Get counter header (width,,nr)
	  MOVEM T1,(T2)		;   and store in buffer
	  OPSTR <XCT>,CTRED,(T4) ; Read the value of the counter
	  MOVEM T1,1(T2)	;   and store in buffer
	  ADDI T2,2		;  Update buffer pointer with 2
	  TMNN CTBMF,(T4)	; Is this a bit mapped counter?
	  IFSKP.
	    SETONE KBBMF,-2(T2)	; Yes, set the flag for NTMAN
	    OPSTR <XCT>,CTBMP,(T4) ;Get the bit map
	    MOVEM T1,(T2)	; and store for NTMAN
	    AOJ T2,		;  and advance the buffer pointer
	  ENDIF.

	  SKIPE DOCLR		;  Should the counter be cleared?
	  OPSTR <XCT>,CTCLR,(T4) ;  -yes, do so!
	  AOJA T3,TOP.		;  Update loop index and loop back
	ENDDO.
;Will never get here
	ENDSV.

	XRESCD

	SUBTTL Trace -- Interface for exec-mode trace.
IFN FTTRACE!FTMINTrace,<
;.TCRLF -- TYPE OUT AN END OF LINE
;.TTABC -- TYPE OUT A TAB
;.TRBRK -- TYPE OUT A RIGHT BRACKET (CLOSE BRACKET PAIR)
;.TSPAC -- TYPE OUT A SPACE CHARACTER

.TCRLF::MOVEI	T1,"M"-100	;CARRIAGE RETURN
	PUSHJ	P,.TCHAR	;PRINT THE CHARACTER OUT
	MOVEI	T1,"J"-100	;LION FEED
	PJRST	.TCHAR		;FINISH OFF

.TTABC::MOVEI	T1,"I"-100
	PJRST	.TCHAR		;TYPE OUT A TAB
.TRBRK::MOVEI	T1,"]"		;RIGHT BRACKET
	PJRST	.TCHAR		;TYPE IT OUT
.TSPAC::MOVEI	T1," "		;SPACE
	PJRST	.TCHAR		;TYPE IT OUT TOO.

;.TDECW -- TYPE OUT SIGNED DECIMAL NUMBER
;.TOCTW -- TYPE OUT SIGNED OCTAL NUMBER
;.TRDXW -- TYPE OUT SIGNED NUMBER (RADIX IN T3)
;	(IF RADIX .GT. 9, WILL USE ALPHAS AFTER DIGITS)
;CALL:	MOVE	T1,NUMBER
;	PUSHJ	P,.TOCTW/.TDECW/.TRDXW
;USES T1, T2, T3

.TOCTW::SKIPA	T3,[10]		;INITIALIZE FOR OCTAL RADIX
.TDECW::MOVEI	T3,^D10		;INITIALIZE FOR DECIMAL RADIX

.TRDXW::JUMPGE	T1,TRDXW1	;CHECK FOR NEGATIVE
	PUSH	P,T1		;SAVE NUMBER FROM .TCHAR
	MOVEI	T1,"-"		;YES--GET MINUS
	PUSHJ	P,.TCHAR	;PRINT IT
	POP	P,T1		;RESTORE OUR NUMBER
	MOVMS	T1		;GET MAGNITUDE
TRDXW1:	IDIV	T1,T3		;DIVIDE BY RADIX
	PUSH	P,T2		;SAVE REMAINDER
	SKIPE	T1		;SEE IF ANYTHING LEFT
	PUSHJ	P,TRDXW1	;YES--LOOP BACK WITH PD LIST
	POP	P,T1		;GET BACK A DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	CAILE	T1,"9"		;SEE IF OVERFLOW DIGITS
	ADDI	T1,"A"-"9"-1	;YES--SWITCH TO ALPHABETICS
	PJRST	.TCHAR		;TYPE IT AND RETURN
	SUBTTL Trace -- SCAN's output routines
;.TSTRG -- TYPE ASCIZ STRING
;CALL:	MOVEI	T1,LOCTN. OF STRING
;	PUSHJ	P,.TSTRG
;USES T1

.TSTRG::HRLI	T1,(POINT 7)	;CONVERT ADDRESS TO POINTER
	TRNN	T1,-1		;SEE IF SOMETHING THERE
	POPJ	P,		;NO--RETURN EMPTY HANDED
	PUSH	P,T1		;STORE IN SAFE PLACE		[501]
TSTRG1:	ILDB	T1,(P)		;GET NEXT CHARACTER		[501]
	JUMPE	T1,[		;RETURN WHEN DONE		[501]
		POP P,T1	;PUT T1 BACK
		POPJ P,]	;RETURN
	PUSHJ	P,.TCHAR	;OUTPUT CHARACTER
	JRST	TSTRG1		;LOOP UNTIL DONE
	SUBTTL Trace -- Routine store character in shared buffer
;.TCHAR -- TYPE OUT A CHARACTER
;CALL: MOVEI T1,CHARACTER
;	PUSHJ P,.TCHAR
;This routine is the meat of the trace facility - Each character goes
;through here, being deposited in the user buffer according to a
;carefully established protocol. If any changes are made, make very
;sure D36TRC is capable of handling them.
;*#* Note 0:T2 Will be set by putting a snoop breakpoint at DCNTRA.
;*#* Note 1: The AOS SOS here assumes that any PI excursion will take less
;		time than the user would to read the entire buffer
;*#* Note 2: The wrapping of the buffer must be done with SYSPIF, since
;		we could have the other cpu use an invalid byte pointer
;		while we are resetting stuff

XP TAKBYT,0
XP LSTBYT,2

.TCHAR::SETZ	T2,		;CLEAN OUT OUR AC. SNOOP WILL SET VALUE
DCNTRA:	SKIPN	T2		;GET ADDRESS OF USER'S BLOCK, AND MAKE SURE
	 POPJ	P,		; WE HAVE A USER'S BLOCK. IF NOT, RETURN NOW.
;(*#* Note 0 *#*)
;RESERVE A BYTE
	AOS	T3,TAKBYT(T2)	;BUMP NUMBER OF BYTES IN BUFFER TAKEN
	CAML	T3,MAXBYT	;IS THIS GOING TO FIT?
	 JRST [	SOS TAKBYT(T2)	;NO, BUMP THE COUNT BACK DOWN
		AOS LSTBYT(T2)	;BUMP COUNT OF LOST BYTES
		POPJ P,]	;RETURN QUIETLY (*#* Note 1 *#*)
;WE HAVE OUR BYTE RESERVED. LET'S PUT IT IN THE BUFFER
	SYSPIF			;(*#* Note 2 *#*)
	AOS	T3,CURBYT	;#INCREMENT CURRENT BYTE POSITION IN BUFFER
	CAML	T3,LASBYT	;#DO WE HAVE TO WRAP AROUND?
	 JRST [	SETZM CURBYT	;#RESET CURRENT BYTE POSITION
		MOVE T3,ZERBPT	;#GET BYTE POINTER TO THE ZEROTH BYTE IN BUFFER
		MOVEM T3,CURBPT	;#SAVE AS CURRENT BYTE POINTER
		JRST .+1]
	IDPB	T1,CURBPT	;#DEPOSIT THE BYTE IN THE USER'S BUFFER
	SYSPIN			;ALLOW OTHER CPU IN
	CAIE	T1,12		;IS THIS A LINE FEED?
	RET			;NO, JUST RETURN
	MOVE	T1,TRAJOB	;YES, GET JOB NUMBER OF TRACER
	JRST	WAKJOB##	;WAKE HIM UP

>;END OF IFN FTTRACE!FTMINTR
	SUBTTL TOPS10 -- AC save routines

;These routines are defined in MACSYM.REL, but we normally don't load
;with that, so here they are:

IFN FTOPS10,<

.SAV1::	PUSH P,.FPAC
	CALL 0(.SAC)
	  TRNA
	AOS -1(P)
	POP P,.FPAC
	RET

.SAV2::	PUSH P,.FPAC+0
	PUSH P,.FPAC+1
	CALL 0(.SAC)
	  TRNA
	AOS -2(P)
	POP P,.FPAC+1
	POP P,.FPAC+0
	RET

.SAV3::	PUSH P,.FPAC+0
	PUSH P,.FPAC+1
	PUSH P,.FPAC+2
	CALL 0(.SAC)
	  TRNA
	AOS -3(P)
	POP P,.FPAC+2
	POP P,.FPAC+1
	POP P,.FPAC+0
	RET

.SAV4::	ADJSP P,4
	DMOVEM .FPAC+0,-3(P)
	DMOVEM .FPAC+2,-1(P)
	CALL 0(.SAC)
	  TRNA
	AOS -4(P)
	DMOVE .FPAC+0,-3(P)
	DMOVE .FPAC+2,-1(P)
	ADJSP P,-4
	RET

>;END OF IFN FTOPS10
	SUBTTL Kontroller data

DEFINE KNMMCS,<
;	       Symbol,Name,Cost, Maximum receive block size
	KNMMAC LD.TST,TST,%RTCTS,0			;TST DEVICE
	KNMMAC LD.DTE,DTE,%RTCDT,<^D576>		;DTE DEVICE
	KNMMAC LD.KDP,KDP,%RTCKD,<^D576>		;KDP DEVICE
	KNMMAC LD.DDP,DDP,%RTCDD,<^D576>		;DDP DEVICE
	KNMMAC LD.CIP,CI, %RTCCI,<^D576>		;CI DEVICE
IFN FTOPS20,<
	KNMMAC LD.ETH,NI, %RTCNI,<^D1504-%RTEHS>	;NI DEVICE
>; END IFN FTOPS20
IFN FTOPS10,<
	KNMMAC LD.ETH,ETH,%RTCET,<^D1504-%RTEHS>	;ETHERNET CHANNEL
>; END IFN FTOPS10
	KNMMAC LD.DMR,DMR,%RTCDM,<^D576>		;DMR DEVICE
>;END OF KNMMCS

DEFINE KNMMAC(sym,name,cost,bsize),<
	IFN <.-KONNAM-sym>,<PRINTX ?nam device incorrectly defined at KONNAM>
	ASCII /name/
>;END OF KNMMAC

	RESCD
IFN FTOPS10,<RESDT>
KONNAM::KNMMCS
IFN <.-KONNAM-LD.MAX-1>,<PRINTX ?Incorrect number of kontrollers defined>
IFN FTOPS10,<RESCD>

DEFINE KNMMAC(sym,name,cost,bsize),<EXP cost>
KONCST::KNMMCS

DEFINE KNMMAC(sym,name,cost,bsize),<EXP bsize>
MXLBSZ::KNMMCS
	XRESCD
	

	SUBTTL	Initialization routines  --  Compute Core Requirements


;DCNCCR computes the total DECnet core requirements.
;Call:
;	PUSHJ	P,DCNCCR
;Returns:
;	T1/ Size of DECnet core

IFN FTOPS10,<
	INTERNAL DCNCCR
	XRENT DCNCCR

	SAVEAC <P1>		;SAVE P1
	SETZ P1,		;START WITH ZERO

	PUSHJ P,D36CCR		;COMPUTE D36COM'S CORE REQUIREMENTS
	ADD P1,T1		;ADD TO TOTAL
	PUSHJ P,SCTCCR##	;COMPUTE SCLINK'S CORE REQUIREMENTS
	ADD P1,T1		;ADD TO TOTAL
	PUSHJ P,NSPCCR##	;COMPUTE LLINK'S CORE REQUIREMENTS
	ADD P1,T1		;ADD TO TOTAL
	PUSHJ P,RTRCCR##	;COMPUTE ROUTER'S CORE REQUIREMENTS
	ADD P1,T1		;ADD TO TOTAL
	PUSHJ P,DNDCCR##	;COMPUTE DNADLL'S CORE REQUIREMENTS
	ADD P1,T1		;ADD TO TOTAL

	MOVE T1,P1		;GET TOTAL CORE REQUIREMENTS
	MOVEM T1,DCNTCR		;SAVE FOR STATISTICS
	RET			;AND RETURN
>; END IFN FTOPS10
;D36CCR computes D36COM's core requirements.
;Call:
;	PUSHJ	P,D36CCR
;Returns:
;	T1/ Size of D36COM core

IFN FTOPS10,<
D36CCR:	SAVEAC <P1>		;SAVE P1
	SETZ P1,		;START WITH ZERO

	LOAD T1,IBBSZ,+IBBLK	;GET REQUESTED SIZE OF BUFFERS
	ADDI T1,%RTEHS+3	;ADD IN MAXIMUM ROUTER OVERHEAD
	LSH T1,-2		;CONVERT TO WORDS
	ADDI T1,OVHWDS		;ALLOWANCE FOR OVERHEAD WORD(S)
	STOR T1,CHSIZ,+UBLCB	;SAVE IN CH BLOCK
	LOAD T1,IBMXB,+IBBLK	;GET NUMBER OF BUFFERS TO BUILD
	STOR T1,CHNUM,+UBLCB	;SAVE IN CH BLOCK
	MOVE T2,T1		;GET NUMBER OF UBLS
	LSH T2,-2		;INCREASE THE NUMBER OF MBLS
	ADD T1,T2		;BY ONE FOURTH OF THE NUMBER OF UBLS
	STOR T1,CHNUM,+MBLCB	;AND SAVE IT
	MOVEI T3,CHBLKN		;GET NUMBER OF CH BLOCKS
	XMOVEI T4,CHBLKS	;AND ADDRESS OF CH BLOCKS
D36CC1:	LOAD T1,CHNUM,(T4)	;GET NUMBER OF THIS TYPE OF FREE BLK
	LOAD T2,CHSIZ,(T4)	;SIZE OF THIS TYPE OF FREE BLK
	IMUL T1,T2		;MULTIPLY TO GET WORDS REQ'D
	ADD P1,T1		;ADD INTO TOTAL
	ADDI T4,CH.LEN		;STEP TO NEXT CH BLOCK
	SOJG T3,D36CC1		;LOOP OVER ALL CH BLOCKS
	MOVE T1,P1		;GET MEMORY REQUIREMENTS
	RET			;AND RETURN
>; END IFN FTOPS10
	SUBTTL Initialization routines


;The DECnet initialization routine

	XNENT D36INI

  IFN FTOPS20,<
	SKIPN [DCN]		;Is DECnet turned on?
	RET			; -no, just return
  >

	SAVEAC <T5,T6>		;SAVE SOME ACS
	MOVX T1,1		;Set D36IFG
	MOVEM T1,D36IFG		; to +1 to indicate DECnet is initializing
IFN FTOPS10,<
	PUSHJ	P,M10INI	;INIT -10 MEMORY MANAGEMENT
	MOVE	T1,DCNNAM##	;GET DECNET NODE NAME
	STOR	T1,IBNAM,+IBBLK	;STORE SIXBIT NODE NAME
	MOVE	T1,DCNNUM##	;GET DECNET NODE NUMBER (ADDRESS)
	MOVEM	T1,RTRADR	;SAVE FOR ALL OF DECNET TO SEE
	MOVE	T2,DCNHOM##	;GET DECNET HOME AREA NUMBER
	MOVEM	T2,RTRHOM	;SAVE THIS TOO
	STOR	T2,RN%ARE,T1	;COMBINE BOTH AREA AND NODE NUMBERS
	STOR	T1,IBADR,+IBBLK	;FILL IN INITIALIZATION BLOCK
	MOVE	T1,DCNRTY##	;GET ROUTER TYPE
	STOR	T1,IBRTR,+IBBLK	;SAVE
	MOVE	T1,DCNCOR	;GET ADDRESS WHERE DECNET CORE ALLOCATION
	MOVEM	T1,DCNVFF	;SET UP AS ADDRESS OF DECNET FIRST FREE
>
	LOAD T1,IBADR,+IBBLK	;Make sure local node index
	LDB T1,[POINTR(T1,RN%NOD)] ; and
	OPSTR <CAMLE T1,>,IBMXA,+IBBLK ; MAXIMUM ADDRESS are consistent
	  BUG.(CHK,COMBNN,D36COM,SOFT,<Bad local node number>,,<

Cause:	The node number set with the NODE command in the CONFIG file
	is higher than the DECNET MAXIMUM-ADDRESS value set in the same file.
	DECnet cannot initialize.

Action:	Make the startup file consistent.
>,RTN)
	LOAD T1,IBDBL,+IBBLK	; Get default buffers per link
	LSH T1,1		; Allow that many for transmit and receive
	STOR T1,PDDQT,+DNDEFS	;  and save it for SCJSYS
IFN FTOPS20,<
	LOAD T1,IBBSZ,+IBBLK	; Get requested block size
	ADDI T1,%RTEHS+3	; Add maximum Router overhead
	IDIVI T1,4		; Convert to words
IFE FTLSTCOR,<AOJ T1,>		; Allowance for overhead word
IFN FTLSTCOR,<ADDI T1,4>	; Overhead words for trace of lost blks
	STOR T1,CHSIZ,+UBLCB	; Save as size to build UBLs
	LOAD T1,IBMXB,+IBBLK	; Get maximum number of UBL's to build
	STOR T1,CHNUM,+UBLCB	; Save it for initializer
	MOVE T2,T1		; Get number of UBLs
	LSH T2,-2		; Increase the number of MBLs
	ADD T1,T2		;  by one fourth of the number of UBLs
	STOR T1,CHNUM,+MBLCB	;  and save it
>; END IFN FTOPS20
	CALL DNINIM		;GO INITIALIZE OUR MEMORY MANAGER
	CALL SCTINI		;CALL SC WHO WILL CALL NSP AND SO ON
	  BUG.(CHK,COMCID,D36COM,SOFT,<Couldn't initalize DECNET>,,<

Cause:	SCTINI has found some reason to object about the DECnet environment.
	See SCTINI for the reasons it will take a non-skip return.

>,RTN)
	XCALL (MSEC1,NRTINI)	;INITIALIZE DECnet NRT AS WELL
	 TRN			;EAT UP ANY POSSIBLE SKIP RETURN
	CALL RTRON		;TURN ON ROUTER (WHICH TURNS ON DECNET)
	 TRN			;EAT ANY POSSIBLE SKIP RETURN
IFN FTOPS20,XCALL (MSEC1,SCJINI) ;(20)INITIALIZE SCJSYS
IFN FTOPS10,<
	MOVE T1,DCNTCR		;GET TOTAL CORE REQUIREMENTS
	ADD T1,DCNCOR		;ADD BASE ADDRESS OF DECNET CORE
	CAME T1,DCNVFF		;SHOULD MATCH CURRENT FINAL FIRST FREE ADDRESS
	BUG.(CHK,COMCAW,D36COM,SOFT,<Core allocation wrong>,,,RTN)
>; END IFN FTOPS10
	SETOM D36IFG		;Flag that DECnet is now initialized
	RET			;RETURN

IFN FTOPS10,<
;INITIALIZE MEMORY MANAGEMENT STUFF FOR THE -10

M10INI:	XMOVEI	P4,DCNACB##	;GET ADDRESS OF DECNET ALLOCATION CONTROL BLOCK
	XMOVEI	P3,DCNAHB	;AND ADDRESS OF ALLOCATION HEADER BLOCK
	XMOVEI	P2,DCNAEB	;AND ADDRESS OF ALLOCATION EXTENT BLOCK
	MOVEM	P3,ACBAHB(P4)	;LINK BLOCKS TOGETHER
	SETZM	AHBNXT(P3)	;...
	MOVEM	P2,AHBAEB(P3)	;...
	SETZM	AEBNXT(P2)	;...
	MOVE	T1,ACBCSZ(P4)	;GET CHUNK SIZE IN WORDS
	MOVEM	T1,AHBCSZ(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVE	T1,ACBSEC(P4)	;GET SECTION NUMBER OF ALLOCATION
	MOVEM	T1,AHBSEC(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVE	T1,ACBINI(P4)	;GET INITIAL ALLOCATION AMOUNT IN WORDS
	MOVEM	T1,AHBFRE(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVEM	T1,AHBLWM(P3)	;...
	MOVEM	T1,AHBINI(P3)	;...
	MOVEM	T1,AHBCUR(P3)	;...
	MOVEM	T1,AEBFRE(P2)	;INITIALIZE ALLOCATION EXTENT BLOCK
	MOVEM	T1,AEBLWM(P2)	;...
	MOVEM	T1,AEBSIZ(P2)	;...
	MOVE	T1,ACBTHR(P4)	;GET THRESHOLD ALLOCATION AMOUNT IN WORDS
	MOVEM	T1,AHBTHR(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVE	T1,ACBINC(P4)	;GET INCREMENTAL ALLOCATION AMOUNT IN WORDS
	MOVEM	T1,AHBINC(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVE	T1,ACBMIN(P4)	;GET MINIMUM ALLOCATION AMOUNT IN WORDS
	MOVEM	T1,AHBMIN(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	MOVE	T1,ACBMAX(P4)	;GET MAXIMUM ALLOCATION AMOUNT IN WORDS
	MOVEM	T1,AHBMAX(P3)	;INITIALIZE ALLOCATION HEADER BLOCK
	SETZM	AHBPND(P3)	;CLEAR PENDING ALLOCATION AMOUNT
	MOVE	T1,AEBSIZ(P2)	;GET SIZE OF ALLOCATION EXTENT
	IDIV	T1,AHBCSZ(P3)	;COMPUTE NUMBER OF CHUNKS
	ADDI	T1,^D35		;COMPUTE SIZE OF BITMAP
	IDIVI	T1,^D36		; (REMAINDER IN T2)
	PUSH	P,T2		;SAVE FOR A MOMENT
	PUSHJ	P,INICOR##	;ALLOCATE CORE
	MOVN	T3,T1		;CREATE AOBJN POINTER TO BITMAP
	HRLS	T3		;...
	HRR	T3,T2		;GET START ADDRESS OF ALLOCATED CORE
	MOVEM	T3,AEBBMP(P2)	;SAVE AOBJN POINTER TO BITMAP
	ADD	T1,T2		;COMPUTE LAST WORD IN BITMAP
	POP	P,T2		;GET REMAINDER BACK
	SUBI	T2,^D35		;CALCULATE NUMBER OF BITS TO MARK OFF
	MOVNS	T2		; IN LAST WORD OF BITMAP
	SETO	T4,		;START WITH A COMPLETE MASK
	LSH	T4,(T2)		;COMPUTE MASK OF BITS TO KEEP
	SETCAM	T4,-1(T1)	;MARK OFF APPROPRIATE BITS IN LAST WORD
;FOLLOWING CODE ALLOCATES SPACE FOR DECNET BUFFERS
IFE FTXMON,<
	PUSHJ	P,DCNCCR	;GET TOTAL WORDS REQUIRED IN T1
	ADD	T1,DCNAEB+AEBSIZ ;PLUS SIZE OF BITMAP POOL
	PUSHJ	P,INICOR##	;ALLOCATE CORE
	MOVEM	T2,DCNAEB+AEBADR ;SAVE BITMAP POOL ADDRESS
	ADD	T2,DCNAEB+AEBSIZ ;OFFSET TO START OF USABLE CORE
	MOVEM	T2,DCNCOR	;SAVE ADDRESS OF DECNET CORE
> ;END IFE FTXMON
IFN FTXMON,<
	PUSHJ	P,DCNCCR	;GET TOTAL DECNET WORDS REQ'D IN T1
	ADD	T1,DCNAEB+AEBSIZ ;ADD AMOUNT FOR BITMAP POOL
	MOVEI	T2,PG.BDY(T1)	;ROUND UP TO PAGE BOUNDARY
	TRZ	T2,PG.BDY	;...
	MOVEI	T1,(MS.DCN)	;SECTION NUMBER
	PUSHJ	P,GFWNZN##	;ASK ONCMOD FOR THE CORE
	  HALT	.		;** FOR NOW
	MOVEM	T1,DCNAEB+AEBADR ;SAVE AS ADDRESS OF BITMAP POOL
	ADD	T1,DCNAEB+AEBSIZ ;OFFSET PAST BITMAP POOL
	MOVEM	T1,DCNCOR	;SAVE AS STARTING ADDRESS OF DECNET CORE
> ;END IFN FTXMON
	POPJ	P,		;RETURN

> ;END IFN FTOPS10
	SUBTTL DCNJIF - DECnet Once-a-jiffy check

	INTERNAL DCNJIF
	XRENT DCNJIF

	CALL RTRJIF		;Call ROUTER
IFN FTOPS10,<
	SKPCPU (0)		;On policy CPU?
	RET			;No, return now
>; END IFN FTOPS10

	CALL DNDJIF		;Call DNADLL
	CALLRET NSPJIF		;And LLINKS
	SUBTTL DCNSEC - DECnet Once-a-second check

	INTERNAL DCNSEC
	XRENT DCNSEC

IFN FTOPS20,<
	MOVEI T1,^D1000		;Get milliseconds in dcnsec interval
	MOVEM T1,DCNTIM		;Initialize count-down in stg
> ;END IFN FTOPS20
IFN FTOPS10,<
	SOSG DCNTIM		;Time for XDCNJB checks?
	CALL XDCNJB		;Yes, do periodic checks
>; END IFN FTOPS10

	CALL RTRSEC		;Call ROUTER's second routine
	CALLRET SCTSEC		;Call SCLINK's second routine and return

	SUBTTL DCNJB0 - DECnet periodic checks

	INTERNAL DCNJB0
	XNENT DCNJB0

IFN FTOPS10,<
	MOVEI T1,^D10		;Reset DCNJB0 interval
	MOVEM T1,DCNTIM		;...
>; END IFN FTOPS10
	CALLRET NSPJB0		;Call NSP periodic check and return

	SUBTTL	DCNMOV	- SET MEMORY OFFLINE Support


IFN FTOPS10,<
IFN FTLOCK,<
	INTERNAL DCNMOV
	XNENT	DCNMOV

	CALL SCTMOV##		;Have SCLINK move any name/address pages
	RET
>; END IFN FTLOCK
>; END IFN FTOPS10
	SUBTTL NMX -- Privilege checking routine.

	INTERNAL NMXPRV
	XSWAPCD
NMXPRV:
LLMPRV::			;USED BY LLMOP
IFN FTOPS10,<
	MOVSI T1,JP.POK		;PRIVILEGE BIT.
	MCALL (RG,MSEC1,PRVBIT##) ;ASK MONITOR IF ALLOWED.
	 RETSKP			;HE IS
	RET			;RETURN TO USER
>
IFN FTOPS20,<
	MOVE T1,CAPENB		;ENABLED CAPABILITES
	TXNN T1,<SC%WHL+SC%OPR>	;WHEEL OR OPERATOR?
	RNMXER (CAPX1)		;NO, RETURN LACK OF PRIVS
 	RETSKP
>
	SUBTTL NMX -- Time stamp a queued even block
;NMXTIM - Time stamp a queued event block.
;Call
;	TOPS-20:
;		T1/ Todclk of event.
;Return
;	RET always,
;		T1/ Number of julian half days,
;		T2/ Number of seconds into current half day,
;		T3/ Number of milliseconds into current second.

	INTERNAL NMXTIM
	XSWAPCD
NMXTIM:
IFN FTOPS10,<
	MOVE T1,DATE##		;GET CURRENT UDT (IN DAYS,,FRACTION)
	MOVE T2,TIME##		;GET CURRENT TIME (IN JIFFIES SINCE MIDNIGHT)
	LSH T1,-^D17		;TRUNCATE TO NUMBER OF HALF DAYS.
	SUBI T1,124210_1	;CONVERT DAYS SINCE 1858 TO DAYS SINCE 1977
	MOVE T3,[^D60*^D60*^D12]
	IMUL T3,TICSEC##	;SECONDS SINCE HALF-DAY
	TRNE T1,1		;IS THIS THE SECOND HALF OF A DAY?
	SUB T2,T3		;YES, RECORD SECONDS SINCE HALF-DAY
	IDIV T2,TICSEC##	;CONVERT JIFFIES INTO SECONDS.
	IMULI T3,^D1000		;CONVERT TO NUMBER OF MILLISECONDS*TICSEC
	IDIV T3,TICSEC##	;CONVERT TO NUMBER OF MILLISECONDS.
	SKIPL T2		;MAKE SURE WE HAVE A POSITIVE NUMBER OF SECONDS
	TDNE T1,[XWD -1,600000] ;MAKE SURE NO DATE OVERFLOW
	BUG.(HLT,COM911,D36COM,SOFT,<The date is past 9 November 2021>,,<

Cause:	The 2 byte julian half-day field in an event message is limited
	to 9 november 2021. The routine above has calculated the julian
	half-day, and has found that it overflowed.

	I doubt very much that the date itself has really gone past 2021.
	Probably someone smashed an AC or the routine to get the time
	from the monitor is returning junk.
>)
	RET
>;END IFN FTOPS10

IFN FTOPS20,<
; Enter here with Todclk in T1
	SAVEAC <Q1,Q2>
	STKVAR <ROUND>		;rounding flag
	SETZM ROUND		;intialize
;duplicate of LGTAD, except no rounding, and save the leftover
	MUL T1,[1B17]		;shift binary point
	DIV T1,JFDAY		;time since startup in T1, remainder in T2
	HLRZ Q1,T2		;convert remainder to ms, and save
	HRRZ Q2,T2		;save the pittance that is left
	ADD T1,TADIDT		;data & time in T1 internal format
   				; (except leftover ms)
;find out if ODCNV% will round up.
	HRRZ T3,T1		;get time
	MULI T3,FULDAY     	; will ODCNV%
	DIV T3,[1B17]		;  round up
	CAIL T4,400000		;   one second ?
	SETOM ROUND		;it will. remember this
;compute leftover milliseconds.
	HRRZ T3,T1		;get time again
	MUL T3,JFDAY		;convert back to ms
	ADD T4,Q2		; add that pittance to least sig. word
	DIV T3,[1B17]		;  end of computation.
	MOVE Q2,T3		;save it
    	IDIVI T3,^D1000		; modulo
	IMULI T3,^D1000		;  one
	SUB Q2,T3		;   thousand
	ADD Q1,Q2		;total leftover milliseconds
;get date & time
	MOVE T2,T1		;convert internal time to years, Julian
	MOVX T4,<IC%JUD>	; days & seconds
	ODCNV%      		;(T2,T4/T2,T4)
	;...
	;...
;convert date to Julian half days
	HLRZ T1,T2		;get year
	CAIL T1,FYEAR 		;range
	CAIL T1,FYEAR+YRTABL	; check
 	  BUG.(CHK,NMXTBG,JNTMAN,SOFT,<NMXTIM table obsolete>,,<

Cause:	The table used by NMXTIM is obsolete.

Action: Create a new table.

>,RTN)
	MOVE T1,YEARTB-FYEAR(T1) ;get number of days before this year
	HRRZS T2		;isolate days
	SOS T2			;don't count today.. it's not over yet.
	ADD T1,T2		;total days
	LSH T1,1		; half days
;diddle milliseconds & seconds
	HRRZ T2,T4		;seconds since midnight
	MOVE T3,Q1		;milliseconds in T3
	CAIGE T3,^D1000		;too many milliseconds ?
	IFSKP.
	  SUBI T3,^D1000	;yes. make them small.
	  AOS T2		;increment seconds
	ENDIF.
	SKIPN ROUND		;did ODCNV% round up ?
	IFSKP.
	  SOSL T2		;yes. take that second away. cross half day ?
	  IFSKP.
	    SOS T1		;yes. take away a half day,
	    MOVEI T2,HLFDAY-1	; and make a lot of seconds
	  ENDIF.
	ENDIF.
NMXTM1:	CAIGE T2,HLFDAY		;too many seconds ?
	IFSKP.
	  SUBI T2,HLFDAY	;yes. make them small.
	  AOS T1		;increment half days
	  JRST NMXTM1		;and try again.
	ENDIF.
	RET
 	ENDSV.			;end STKVAR
FULDAY=^D<24*3600>		;the number of seconds in a day
HLFDAY=^D<12*3600>		;the number of seconds in a half day
;this table gives the number of julian days since (& including) JAN 1 1977
; for the years FYEAR (=1982) to FYEAR+YRTABL-1
FYEAR=^D1982			;the first year in this table
YEARTB:	^D1826
	^D2191
	^D2556
	^D2922
	^D3287
	^D3652
	^D4017
	^D4383
	^D4748
	^D5113
	^D5478
	^D5844
	^D6209
	^D6574
	^D6939
	^D7305
	^D7670
	^D8035
	^D8400

YRTABL=.-YEARTB
	XRESCD
>
	SUBTTL TOPS20 -- User mode checking routines.
IFN FTOPS20,<
;CHKBPT - Check out a byte pointer the user has passed us.
;Byte size must be null or 8 bit bytes.
;Returns +1 on failure with error in T1
;Returns +2 on success preserving T1 & T2
;Uses T3

	INTERNAL CHKBPT
	XRESCD
CHKBPT:	JUMPE T1,RSKP		;IF NULL, THAT IS O.K.
	LDB T3,[POINT 6,T1,11]	;GET THE USER'S BYTE SIZE
	CAIN T3,^D8		;8 BIT BYTES?
	RETSKP			;YES, ALL O.K.
	MOVX T1,NEADC%		;NO, RETURN AN ERROR
	RET
> ;END IFN FTOPS20
	SUBTTL	End of D36COM

IFN FTOPS20, TNXEND
IFN FTOPS20,<

;Hack for section testing
	INTERNAL $TSTS6
	RESCD
;Come here with JSP CX,$TSTS6
$TSTS6:	PUSH P,CX		;Save return address
	XHLLI CX,.
	HLRZS CX
	CAIN CX,XCDSEC
	JRST $TSTS7
	PUSH P,T1
	MOVE T1,(P)
	BUG. (CHK,NISEC6,D36COM,SOFT,<Not in section 6>,<<T1,CALADR>>,<

Cause:	Code that should be running in section 6 is not.

Data:	CALADR - Address of routine not in section 6
>)
	POP P,T1
$TSTS7:	POP P,CX
	JRST (CX)
> ;END IFN FTOPS20

IFN FTOPS10,<
	RESDT
D36LOW::!
	XRESCD
>; END IFN FTOPS10
	END