Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ietsrc/xdefin.p11
There are 5 other files named xdefin.p11 in the archive. Click here to see a list.
	.SBTTL	XDEFIN - DN60 series definitions

.REPT 0


                          COPYRIGHT (c) 1982,1981,1980, 1979
            DIGITAL EQUIPMENT CORPORATION, maynard, mass.

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
TRANSFERRED.

THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.

DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

.ENDR
;MODULE REVISION HISTORY


; 3(000) BS		ADDED COUNTER FOR INCOMIG MESSAGES QUEUED TO XLATE TASK
;
; 3(001) 18-Apr-79 JW	Add some definitions for the 2020
;
; 3(002)  3-MAY-79 BS	MODIFIED TO SAVE REGISTERS ON STOPCODE WITH DEBUG OFF
;
; 3(003)  3-MAY-79 BS	ADD EBCDIC TO ASCII TRANSLATE TABLE SWITCH
;
; 3(004)  7-MAY-79 JW	ADD ROOM IN 2020 DMC LCB FOR SOME STATISTICS
;
; 3(005) 15-MAY-79 BS	ADD SPACE IN LINE CONTROL BLOCK FOR LINE SIGNATURE
;
; 3(006) 01-JUN-79 BS	ADD FLAG FOR H/W ABORT TO LINE FLAGS
;
; 3(007) 08-JUN-79 BS	ADD VERSION NUMBERS TO MODULE
;
; 3(010) 22-Jun-79 KR	add TCIRH bit to TCFG1 for device TCB's
;
; 3(011) 26-JUN-79 BS	MAKE LINE DRIVER TYPE LAST ENTRY IN PDP-10 STATISTICS
;
; 4(012) 26-JUN-79 BS	UPGRADE MAJOR TO VERSION 4 AND TURN DEBUG OFF
;
; 4(013) 21-AUG-79 BS	ADD POINTER TO LINE ENABLE TCB FOR DL10 DRIVER
; 4(014) 19-SEP-80 RLS	ADD HSPIGO PARAMETER - CONTROLS REPETITIVE
;			TRANSLATION OF INPUT TRANSMISSION BLOCKS IN XLHASP
;			(XHEBAS) AND XL3780(XLEBAS) BEFORE MAKING SCHDEULER PASS.

; 4(015) 15-OCT-80 RLS	ORIGINAL MANGLING TO ACCOMODATE NEW XDRIVERS AND
;			TEN INTERFACE COMMON CODE.
; 4(016) 06-FEB-81 RLS	modify trace macro to allow block traces
; 4(017) 25-Feb-81 RLS	add parameters XNRTY,RNRTY to control transmission
;			and reception retries.  Replaces magic constants
;			and arcane formulas(wrong) found in code.
; 4(020) 01-Apr-81 RLS	Move TCCMSG,TCDMSG from TENTSK tcb to global storage.
; 4(021) 07-Apr-81 RLS	Modify chunk definitions.
; 4(022) 17-Apr-81 RLS	Transform static flow control to static/line control
; 4(023) 14-APR-82 RLS	Awfullotaedits.
; 4(024) 15-APR-82 RLS	Flush old retry parameters XNRTY,RNRTY...define new 
;			pars PRIRTY,SECRTY for primary,secondary nodes. LB.ERC
;			will be initialized to the appropriate value at line
;			enable time. LB.RRY is flushed as a counter, only 
;			LB.RTY is used now. GCO 4.2.1322
; 4(025) 21-APR-82 RLS	GCO 4.2.1329 - set all the flow control parameters.
; 4(026) 26-APR-82 RLS	GCO 4.2.1334 - flush TRCFLG, do some formatting for listing
; 4(027) 18-JUN-82 RLS	GCO 4.2.1392 - correct definition of eot line statistics
; 4(030) 29-JUN-82 RLS	GCO 4.2.1412 - define NORPLY parameter and LB.NHA to
;			count successive hardware aborts.
; 4(031) 09-AUG-82 RLS	GCO 4.2.1485 - reduce NORPLY to 2, 3 takes too long.

VDEFIN=031

VEDIT=VEDIT+VDEFIN
; VERSION VMAJOR.VMINOR(2400) -- MAY 1, 1979 /JBS/MM/BS

VMAJOR=4
VMINOR=2
VWHO=0			;who last edited this program
;3(007)VEDIT=2400	;edit number
;3(007)VMAJOR=VMAJOR	;major version number
;3(007)VMINOR=VMINOR	;minor version number
	.SBTTL		Parameters - of the system variety

; PARAMETERS:	These may not be changed; they are presented
;		here to guide the reader by avoiding magic
;		constants in the body of the code)
;		Therefore be very careful when you change them.

;line driver type codes

DQDRV=1				;DQ11 driver
KDPDRV=2			;KMC/DUP11 driver
DUPDRV=3			;DUP11 driver


;process priority level assignments
;	all device services will begin interrupt processing at level 7 then
;	turn down to their appropriate level after suspending the clock(the
;	clock interrupts at BR6 and screws up everything)
;	Line drivers must not be interrupted but must be able to interrupt
;	other devices in general. Other devices must protect themselves against
;	interrupts during any time critical intervals but must keep these to a 
;	minimum.

PR.LIN=	7			;line driver interrupt process level
.IF NE,FT.DUP
PR.CLK=4			;must keep all interrupts below dup BR level
PR.TEN=4
.IFF
PR.CLK=	6			;clock interrupt process level
PR.TEN=	7			;10 interface device driver interrupt process level
.ENDC	;.IF NE,FT.DUP

.IIF NDF,DEBUG,DEBUG=0		;set to 1 to include debugging code
.IIF	NDF,DTBUG,DTBUG=0	;set to nonzero to include ten driver debug code
				; or 00 for production
.IIF NDF,FT.CHK=DEBUG		;include checking if debugging
.IIF NDF,FTRACE,FTRACE=DEBUG	;include tracing if debugging
.IIF NDF,TRCLOD,TRCLOD=0	;no default tracing
.IIF NDF,TRCHLD,TRCHLD=0	;no default trace halt condtions
.IIF NDF,DB.SEQ,DB.SEQ=0	;no special line sequence check debug hack -
.IF NE,DB.SEQ
;DB.SEQ set causes bsc to expect received files to have 4 digit sequencial line
; numbers preceeded by a .
.ENDC

.IIF NDF,CHOWNR,CHOWNR=0	;do not include chunk owner recording normally

.IIF NDF,FT.PAT,FT.PAT=0	;generate FT.PAT words of patch space

JIFSEC=^D60			;clock ticks per second (approx)

DLGNWT=^D10			;wait this many seconds after a pdp-10
				; crash before trying to come back.
TRCTBL=^D1024			;entries in trace table (only used if debugging)
CHOWNL=400			;entries in chunk owner table

DQRLMT=600.			;don't let the dq11s read more than this
				; many bytes in one message (otherwise will
				; fill core with trailing pads, reducing
				; throughput badly).

NORPLY=2			;number of successive communications attempt
				;cycles ending in hardware abort before declaring
				;the line down
	.SBTTL		Parameters - flow control

; the following static flow control parameters are quite sensitive. a dynamic
; flow control would be much better...someday.

XBSZ0=<DQRLMT/CHDATL>+1		;chunks required to receive a maximum length xmission block
XBSZ=XBSZ0			;chunks required to transmit one

.IIF NE,FT.KDP,XBSZ=XBSZ+1	;KMC transmitter driver needs an extra

LXTN=XBSZ0+2			;chunks required to move an xmit block to XTENCM
				;...LXTN  is the high water mark

TXLN=2				;chunks required to move a 10 ascii chunk to the BSC task

DRPOOL=XBSZ+XBSZ0		;absolute lower limit for GETCHK (pool of chunks for line drivers)

;input suspension

CHDRTH=DRPOOL+LXTN+2		;chunk resource level at which BSC replies wack(2780/3780) or
				; does universal suspend/unsuspend(HASP)
CHSRPL=CHDRTH+LXTN		;threshold at which unversal unsuspend is done

DHNGRY=2			;low threshold of msgs q'd to dev at which it is unsuspended
DSRFIT=DHNGRY+10.		;high threshold at which device is suspended


;output suspension
XLDRTH=DRPOOL+TXLN+1		;lower chunk limit for cuttin off input from ten(2780/3780)
HLDRTH=CHSRPL			;...for HASP, an allowance for input



SYNLEN=^D100			;number of data characters per sync character
				; inserted to be sure line is synchronized.
NDHASP=6			;maximum # of device types supported on hasp

XBLKDF=^D400			;default transmission block size
MDMXTT=^D150			;wait this long for kmc11 to follow "active" toggle
MDMXSD=^D32			;leave this much room at the end
				; of the current chunk for a receive silo.
				; (i.e., set silo warning this far from end of the chunk)
.IIF GE,<MDMXSD-CHDATL>,.ERROR	MDMXSD-CHDATL ;silo warning area too large

; the following retry counts are normally strapped in IBM equipment to 3 or 15.

PRIRTY=15.			;primary station(termination) - number of times
				; to retry transmission of a message before
				; delcaring line to be down
SECRTY=15.			;secondary station(emulation) - number of times
				; to retry reception of a message before
				; delcaring line to be down
	.SBTTL		 additional listing control


.IIF NDF,FTTRLS,FTTRLS=0	;default to short translate table listing
	.SBTTL		definitions of special EBCDIC characters

EBCSOH=001			;start of header
EBCSTX=002			;start of text
EBCETX=003			;end of text
EBCHT =005			;horizontal tab
EBCDLE=020			;data link escape
EBCNL =025			;new line
EBCIGS=035			;interchange group separator
EBCIRS=036			;interchange record separator
EBCIUS=037			;interchange unit separator
EBCETB=046			;end of text block
EBCESC=047			;escape (carriage control)
EBCENQ=055			;enquiry
EBCSYN=062			;synchronous idle
EBCEOT=067			;end of transmission
EBCNAK=075			;negative acknowledgment
EBCBLK=100			;blank
EBCLPD=125			;leading pad character
EBCAK1=141			;ack 1 (following dle)
EBCWAK=153			;wait and ack (following dle)
EBCAK0=160			;ack 0 (following dle)
EBCRVI=174			;reverse interrupt (following dle)
EBCPAD=377			;pad at end of messages
	.SBTTL		DL10 window definition

	.=DLBASE		; establish base in upper 16k
	.BLKW	1		; dl10 status register
	.BLKW	2		; not used
DLXNAM:	.BLKW	1		; program name byte pointer (sixbit)
	.BLKW	1		; not used
DLXOK:	.BLKW	1		; pdp-11 alive indicator.  incremented
				;	by 10 once/second.  set 0 by 11.
				;	if .lt.2, 11 is alive.
DLXHLT:	.BLKW	1		; dn60 11->10 stop code
DLXDWN:	.BLKW	1		; 1=>up, 0=>down & tell opr, -1=>down & quiet
DLXUPT:	.BLKW	1		; not used
DLXSWD:	.BLKW	1		; global status word
	DLS.DP=1		;deposit 11 core
	DLS.EX=2		;examin 11 core
	GBADDR=4		; DLXADR is bad
	GHOLD=10		; hold everything
DLXADR:	.BLKW	1		; address for load/store in 11 core
DLXDAT:	.BLKW	1		; contents of contents of dlxadr
DLXREC:	.BLKW	1		;max record length
DLXMOD:	.BLKW	1		; modification number
	WINVER=3		;window version numver
DLXTA:	.BLKW	1		; pdp-10 alive indicator.  incremented
				;	by 11 once/second.  set -1 by
				;	10.  if .le.1, 10 is alive.
DLXTS:	.BLKW	1		; status of 10.  0 initially
				;		+1 started initialization
				;		-1 running
DLXES:	.BLKW	1		; status of 11.  0 initially
				;		+1 started initialization
				;		-1 running
DLXMXL:	.BLKW	1		; maximum number of lines on dn60
DLXLT1:	.BLKW	1		;place to put "null time" lights
DLXLT2:	.BLKW	1		; (two words for 32 bits)
DLXOPE:	.BLKW	1		;11-operation:
				; 0 = idle
				; 1 = request to read data
				; 2 = request to write data
				; 3 = request to read device status
				; 4 = request to write device status
				; 5 = request to read line status
				; 6 = request to write line status
DLXLNE:	.BLKW	1		;line number of operation
DLXDVE:	.BLKW	1		;device number of operation
DLXOPX:	.BLKW	1		;10-operation code
				; 0 = idle
				; 1 = read data (into 10)
				; 2 = write data (from 10)
				; 3 = read device status
				; 4 = write device command
				; 5 = read line status
				; 6 = write line command
				; 7 = read dn60 status
				; 8 = write dn60 command
DLXLNX:	.BLKW	1		;line number of operation
DLXDVX:	.BLKW	1		;device number of operation
DLXRST:	.BLKW	1		;result code
DLXXFR:	.BLKW	1		;number of bytes transfered
DLXCBP:	.BLKW	40		;pairs of count,byte pointer

; each pair works as follows:

;  when a data transfer is set up, the 10 uses as many
;  pairs as needed to follow the user's page map.  when a
;  count is decremented to zero the next pair is used.
;  if a count is found to be zero, this is the end.

DLEND:	.BLKW	0		; end of window used part

	.BLKB	DLBASE+128.-DLEND ;unused part of 64. word window
	.SBTTL		input silo control block

; this must be defined before the line control block, since
;  the lcb contains two of them.

.=0

MDSLFG:	.BLKW	1		;flags
MDSLFE=B0			;kmc11 should interrupt the
				; pdp-11 when storing data in the silo
MDSLFF=B1			;silo is full
MDSLFO=B2			;silo has overflowed
MDSLFW=B4			;silo has reached warning level
MDSLPG=B7			;kmc11 has gotten the pointers below
MDSLPT:	.BLKW	1		;silo pointer - next char goes here
MDSLPW:	.BLKW	1		;silo warning level
MDSLPL:	.BLKW	1		;silo limit

; end of area known to the kmc11 microcode

MDSLCC:	.BLKW	1		;pointer to current chunk
	.EVEN
MDSLLN:	.BLKW	0		;length of silo area
	.SBTTL		line block offsets

;line block will be preceeded by two "jsr" instructions - destinations will be
; interrupt process of line driver, one for transmitter interrupt and one for 
; receiver interrupts.

;	JSR	R4,XMTRI; transmitter interrupt processor
			; R4 points to line block - 4
;	JSR	R4,RCVRI; receiver interrupt processor
			; R4 points to line block
; The address fields of the JSR's are setup by the individual line driver's
;  initialization code.

	.MACRO	DEFLCB	N	; generate a line block for line N
	.LIST	ME
	.ENABL	LC

.IF IDN,<N>,B			; check for generic case
.=0				; yes - set origin to obtain offsets
.IFF
L'N'XI:	JSR	R4,@(PC)+	; transmitter interrupt target
L'N'XA:	BUGHLT			; default target
L'N'RI:	JSR	R4,@(PC)+	; receiver interrupt target
L'N'RA:	BUGHLT			; default target

LVECRI=L'N'RI-.			; offset from LB to receiver service
LVECRA=L'N'RA-.			; offset from LB to receiver service address
LVECXI=L'N'XI-.			; offset from LB to transmitter service
LVECXA=L'N'XA-.			; offset from LB to transmitter service address
LVECL=.-L'N'XI			; define length of this area

L'N:				; define standard label for line block
.ENDC				; .IF IDN,<N>,B


L'N'.STS:	.BLKW	1		;status bits - some known to KMC11

	LS.ENB=B15		;the line has been "enabled"
	LS.ERR=B14		;there has been an error on the line
	LS.RSE=B13		;the receive silo has been emptied
				; (kmc11 only)
	LS.KLC=B12		;the "kill" operation has completed
				; (only on kmc11)
	LS.RGO=B11		;waiting for carrier to start receiver
				;  (on kmc11, waiting for write initiation
				;  to start receiver)
	LS.XGO=B10		; waiting for delayed clear-to-send to
				;  start transmitter
	LS.RRN=B9		; receiver running
	LS.XRN=B8		; transmitter running

	LS.ACT=LS.RGO!LS.RRN!LS.XGO!LS.XRN ;non-zero = activity

	LS.MDE=B7		;the kmc11 has detected an error
				;  (kmc11 only)
	LS.CAR=B5		;we have seen carrier since starting receiver
				; (only with dup11 and kmc11) 
	LS.CTL=B4		;the write is of a control message
	LS.LWR=B3		;last write - dont follow by a read
	LS.CIE=B2		;post bsc task on next character
				;  (only with dup11 and kmc11) 
	LS.CMP=B1		; function complete
				; (only with kmc11) 
	LS.KIL=B0		; kill current function
				; (only with kmc11) 

.IF IDN,<N>,B
L'N'.LNU:	.BLKW	1		;line number
.IFF
L'N'.LNU:	.WORD	N		;line number
.ENDC	;.IF IDN,<N>,B
L'N'.SLA:	.BLKW	1		;address of dq11/dup11 csr
L'N'.SLV:	.BLKW	1		; address of dq11/dup11 interrupt vector
L'N'.MSG:	.BLKW	1		;pointer to message being sent 
L'N'.CMA:	.BLKW	1		;pointer to control message being sent 
L'N'.CMC:	.BLKW	1		;length of control message being sent 
.IF NE,FT.KDP
L'N'.SLO:	.BLKW	1		;pointer to input silo control block

; end of area known to the kmc11 microcode

L'N'.DRP:	.BLKW	1		;carrier drop while receiver running timer and statistic
				;low byte  - counter of such events
				;high byte - timer to distinguish kmc/dataset race
				; at slow line speeds from crufty carrier

L'N'.SO1:	.BLKB	MDSLLN		;first kmc11 silo
L'N'.SO2:	.BLKB	MDSLLN		;second kmc11 silo
L'N'.MD:	.BLKW	1		; pointer to kmc11 control block
.ENDC ;.IF NE,FT.KDP

L'N'.ST1:	.BLKW	0		;beginning of bsc statistics sent to '10
L'N'.SE1:	.BLKW	1		;count of line error interrupts
L'N'.SE2:	.BLKW	1		;status reg 1 at last error
L'N'.SE3:	.BLKW	1		;status reg 2 at last error
L'N'.SE4:	.BLKW	1		;count of receiver "not fast enough"
L'N'.SE5:	.BLKW	1		;count of transmitter "not fast enough"
L'N'.SE6:	.BLKW	1		;count of clear-to-send failures

; bsc statistics recorded during output

L'N'.OC1:	.BLKW	1		;count of messages sent and ACK'd
L'N'.OC2:	.BLKW	1		;count of NAK's received
L'N'.OC3:	.BLKW	1		;count of invalid responses to TTD or HASP BCB error
L'N'.OC4:	.BLKW	1		;count of invalid responses and crufty messages
L'N'.OC5:	.BLKW	1		;count of TTD's sent
L'N'.OC6:	.BLKW	1		;count of WACK's received in response to messages
L'N'.OC7:	.BLKW	1		;count of EOT's sent which abort the line
L'N'.OC8:	.BLKW	1		;count of invalid bids or responses to bids or refused bids
L'N'.OC9:	.BLKW	1		;count of RVI's received while transmitting

; statistics recorded during input

L'N'.IC1:	.BLKW	1		;count of messages received ok
L'N'.IC2:	.BLKW	1		;count of bad BCC's
L'N'.IC3:	.BLKW	1		;count of NAK's sent in response to data messages
L'N'.IC4:	.BLKW	1		;count of WACK's sent
L'N'.IC5:	.BLKW	1		;count of TTD's received
L'N'.IC6:	.BLKW	1		;count of EOT's received which abort the stream
L'N'.IC7:	.BLKW	1		;count of receiver time outs
L'N'.IC8:	.BLKW	1		;count of messages with invalid char after DLE
				; (transparent only)
L'N'.IC9:	.BLKW	1		;count of attempts to change between
				;  transparent and normal mode in a
				;  message (blocked messages only)
L'N'.TTO:	.BLKW	1		;count of transmitter time-outs.
L'N'.CSD:	.BLKW	1		;clear-to-send delay in jiffys

; miscellaneous information reported to the 10

L'N'.SE7:	.BLKW	1		;count of silo overflows
L'N'.MDS:	.BLKW	1		;length of silo warning area
L'N'.MDU:	.BLKW	1		;max amount of silo warning area used
L'N'.MBL:	.BLKW	1		;maximum transmission block length
				; 0 means no blocking
				; must be set to 400. for 2780 and hasp
				; and 512. for 3780 mode of rje operation
L'N'.MLR:	.BLKW	1		;maximum  logical records per message
				; 0 = unlimited
				; normally set as follows:
				;   0 for ibm 3780 and hasp
				;   2 for ibm 2780 without multi-record
				;   7 for ibm 2780 with multi-record
				; since depth last set.

L'N'.SIG:	.BLKW	1		; line signature - obsolete

L'N'.TYP:	.BLKW	1		;line driver type 3(011)
				; 1 = dq11,
				; 2 = kmc11/dup11,
				; 3 = dup11 without kmc11

L'N'.ST2:	.BLKW	0		;end of bsc statistics sent to 10

L'N'.NHA:	.BLKW	1		;no. successive attempts ending with LF.HWA set
L'N'.TRL:	.BLKW	1		;number of trailing pads after data message
L'N'.NTC:	.BLKW	1		;number of tcb's built for xlate tasks
L'N'.EQW:	.BLKW	1		;time to wait for enq (default = 1 sec)
L'N'.EQN:	.BLKW	1		;number of enq's to send (default = 3)
L'N'.DEW:	.BLKW	1		;ticks to wait before enabling modem interrupts
L'N'.ERC:	.BLKW	1		;retry count for this line
L'N'.RTY:	.BLKW	1		;retry counter
L'N'.CH1:	.BLKW	1		;pointer to primary chunk (input)
L'N'.CH2:	.BLKW	1		;pointer to secondary chunk (input)
L'N'.CH3:	.BLKW	1		;pointer to primary chunk (output)
L'N'.CH4:	.BLKW	1		;pointer to secondary chunk (output)
L'N'.MSC:	.BLKW	1		;count of messages waiting to be sent
				; (includes message in lb.msg, if any)
L'N'.CHD:	.BLKW	1		;count of times chunks depleted
L'N'.TC1:	.BLKW	1		;pointer to tcb for bsc driver
L'N'.TCD:	.BLKW	NDHASP		;pointer to tcb for translater (for all devices)
L'N'.DIC:	.BLKW	1		;count of dataset interrupts
L'N'.DIS:	.BLKW	1		;status of dataset interrupt
L'N'.DIP:	.BLKW	1		;status of dataset interrupt
					; processed (dup11 only)
L'N'.ERS:	.BLKW	1		;error bits stored here
L'N'.XCL:	.BLKW	1		;count of times transmitter clock lost
L'N'.RCL:	.BLKW	1		;count of times receiver clock lost
L'N'.XST:	.BLKW	1		;last transmitter status register
L'N'.XCT:	.BLKW	1		;count of transmit and status interrupts
L'N'.RST:	.BLKW	1		;last receiver status register
L'N'.RCT:	.BLKW	1		;count of receiver interrupts
L'N'.RBF:	.BLKW	1		;list of receive buffers
L'N'.CCH:	.BLKW	1		;chunk currently being received
L'N'.CCR:	.BLKW	1		;byte count left to fill in current chunk
L'N'.CHL:	.BLKW	1		;pointer to current receive chunk's byte count
L'N'.CCD:	.BLKW	1		;in dup11, pointer to current data location
				; in chunk being filled.
.IF NE,FT.DUP
L'N'.CCX:	.BLKW	1		; ptr to chunk list for dup transmitter
L'N'.CXD:	.BLKW	1		; data ptr for dup transmitter
L'N'.CXR:	.BLKW	1		; character for dup transmitter
.ENDC	;.IF NE,FT.DUP
L'N'.DVT:	.BLKW	1		;device type (1 = ibm 3780, 2=ibm 2780
				; 3 = hasp-multileaving)
L'N'.FGS:	.BLKW	1		;flags (visible to 10):
	LF.SIM=B0		;simulate (as opposed to support) mode
	LF.PRI=B1		;primary (as opposed to secondary) bsc
	LF.SON=B2		;line is signed on
	LF.TSP=B3		;output transparent on the line
	LF.DIP=B4		;line disable in progress
	LF.EIP=B5		;line enable in progress
	LF.LAP=B6		;line abort in progress
	LF.OFL=B7		;output device off line
	LF.DAC=B8		;line disable complete
	LF.DIS=B9		;disable done by dte failure
	LF.HWA=B10		;hardware abort due to line condition
	LF.CME=B11		;communications established

L'N'.FRE:	.BLKW	1		;count of free chunks available to this line
L'N'.USE:	.BLKW	1		;count of chunks in use by this line
L'N'.RES:	.BLKW	1		;count of chunks reserved in LB.FRE
L'N'.ALR:	.BLKW	1		;line event alarm timer

L'N'.CRD:	.BLKW	1		;number of characters read so far in this message
L'N'.RG0:	.BLKW	1		;space to store dq11 regs on stop code
L'N'.RG1:	.BLKW	1
L'N'.RG2:	.BLKW	1
L'N'.RG3:	.BLKW	1
.IF NE,FT.DQ
L'N'.RGI:	.BLKW	20		;space for dq11 internal registers
.ENDC	;.IF NE,FT.DQ

L'N'.ENV:					;entry vectors for associated line driver
L'N'.INI:	.BLKW	1			;line driver initialization
L'N'.RED:	.BLKW	1			;read a message
L'N'.WRT:	.BLKW	1			;transmit a data message
L'N'.CTL:	.BLKW	1			;transmit a control message
L'N'.KIL:	.BLKW	1			;kill off the line io
L'N'.INW:	.BLKW	1			;wake bsc on next recieved char
L'N'.DON:	.BLKW	1			;set DTR on
L'N'.DOF:	.BLKW	1			;set DTR off
L'N'.DTS:	.BLKW	1			;get DTR,DSR status
L'N'.TIK:	.BLKW	1			;once per tick routine
L'N'.TRP:	.BLKW	1			;stop code processor for line driver

L'N'$ENL=<.-L'N'.ENV>/2			;length of entry block

L'N'.SZ0=.-L'N'.STS			;size of line block proper

L'N'.SIZ=L'N'.SZ0+LVECL		;total length of line block - allow space for
				;line driver interrupt targets which preceed line block

	.NLIST	ME
	.ENDM			; DEFLCB N
	DEFLCB	B		; define line block offsets
	.SBTTL		KMC11 control block

; there is one of these control blocks for each kmc11.

.=0

MDFGE:	.BLKW	1		;11-flags:
MDFER=B0			;11-running (set when first line
				; is enabled)
MDFEA=B4			;active toggle

MDFGK:	.BLKW	1		;kmc flags:
MDFKR=B0			;kmc running
MDFKA=B4			;kmc active response

MDALE:	.BLKW	1		;11-alive counter
MDALK:	.BLKW	1		;kmc-alive counter
MDLCB:	.BLKW	4		;lcb pointers (up to 4)

; end of the area known to kmc11 microcode

MDTIC:	.BLKW	1		;counter for one second code
MDALKS:	.BLKW	1		;previous copy of kmc alive counter

MDTLN:	.BLKW	0		;length of kmc11 control block
	.SBTTL		task control block

.=0
TCEW:	.BLKW	0		;event word

 EBTIME=B0			;task sleep timer event
 EBALR=B1			;asynchronous event alarm
 EBINTR=B2			;interrupt/abnormal error/intertask signal event
 EBQCHK=B3			;chunk queued to task event
 EBQMSG=B4			;message queued to task event
 EBTENI=B5			;ten request event

TCWK:	.BLKB	1		;events to wake on
TCEV:	.BLKB	1		;events that have happened
TCWKEV:	.BLKW	1		;events at task wakeup

TCHAIN:	.BLKW	1		;pointer to next task control block
TCPC:	.BLKW	1		;task's pc when inactive
TCPS:	.BLKW	1		;task's ps when inactive
TCSP:	.BLKW	1		;task's stack pointer when inactive
TCSPT:	.BLKW	1		;initial value of stack ptr
TCMSG1:	.BLKW	1		;pointer to oldest msg queued to this task
TCMSG2:	.BLKW	1		;pointer to newest msg queued to this task
TCMSG3:	.BLKW	1		;count of messages queued to this task
TCCHKQ:	.BLKW	1		;ptr to head of chunk queue for task
TCCHK2:	.BLKW	1		;ptr to end of chunk queue
TCGMC:	.BLKW	1		;counter for waiting for storage
TCLCB:	.BLKW	1		;pointer to lcb for this task
TCTIM:	.BLKW	1		;wait time in jiffies
TCST2:	.BLKW	1		;secondary status bits:

 TCLBK=B0			;the current output print line has been broken.
 TCDTA=B1			;there is some data in this record (used
				; to distinguish ttd from imbedded enq).
 TCEOT=B2			;an eot has been sent or received
				; so it is not necessary to send another
				; to abort the transmission.
 TCESC=B3			;set if the last character for input
				; translation in printer mode
				; was an escape.
 TCIGS=B4			;set if the last character for input
				; translation was an igs.
 TCXET=B5			;received block ended in etx, expect
				; an eot next.
 TCAK1=B6			;sending: next ack expected is ack1
				;receiving: last ack response was ack1
 TCNRD=B7			;no response to data message.  after
				; sending an enq, accept wrong ack as
				; meaning nak.
 TCHGST=B8			;on indicates hasp status changed in fcs
				;this enables latest status to be transmitted
				;to the hasp side
 TCETB=B10			;indicates etb received from hasp
 TCDIS=B11			;DLE-EOT received - other end wants to hang up

TCFG1:	.BLKW	1		;flag bits (visible to the pdp-10):

 TCSTG=B0			;xlate suspended waiting for storage
 TCIRH=B3			;input permission request held 3(010)
 TCPRI=B4			;interpret printer carriage control on input
 TCPRO=B5			;interpret printer carriage control on output
 TCTSP=B6			;do output in transparent bsc
 TCCMP=B7			;do component selection
 TCCPS=B8			;use compress/expand functions
 TCPCO=B9			;page counter has overflowed
 TCPCE=B10			;page counter interrupts enabled
 TCOBS=B11			;use old bsc protocol: ius, etb and etx imply
				; irs, there is no "print-nospace" function,
				; and cards are padded to 80 characters
 TCDMP=B12			;output being dumped [1(627)]
 TCIPH=B13			;send input permission granted to hasp =1
 TCIOM=B14			;flag for input mode (=1) for hasp devices
 TCOTC=B15			;flag for output eof or dump set by xalte
				;cleared by bsc task when all data is shipped

TCFG2:	.BLKW	1		;more flag bits (also visible to the pdp-10)

 TCOPR=B0			;output permission requested
 TCOPG=B1			;output permission granted
 TCORN=B2			;output running
 TCOEF=B3			;output eof signaled
 TCIEF=B3			;input eof received
 TCOEC=B4			;output eof complete
 TCOAB=B5			;output abort started
 TCOAC=B6			;output abort complete
 TCIPR=B7			;input permission requested
 TCIPG=B8			;input permission granted
 TCIRN=B9			;input running
 TCIAB=B10			;input abort started
 TCIAC=B11			;input abort completed
 TCIEC=B12			;input eof completed
 TCIWR=B13			;input permission was requested [2(770)]
 TCOWR=B14			;ouput permission was requested (hasp)
 TCDSP=B15			;device's output suspended by hasp
				;in bsc tcb tcdsp set implies universal suspension of all devices

TCMSG:	.BLKW	1		;pointer to current message

TCSSA:				;start of area specific to each task type

; the following are used only by the translation tasks

.=TCSSA
TCBFP:	.BLKW	1		;pointer to line buffer
TCBFC:	.BLKW	1		;length of line buffer
TCHPS:	.BLKW	1		;current horizontal position (0 = left margin)
TCVPS:	.BLKW	1		;current vertical position (0 = top of page)
TCRSZ:	.BLKW	1		;device record size ( default = 132 for lpt
				; and = 80 for card reader and punch units)
TCPGC:	.BLKW	1		;page count register
TCDVT:	.BLKW	1		;device type
TCDEV:	.BLKW	1		;device number for this xlate task
TCIMC:	.BLKW	1		;count of incoming messages queued to xlate task
TCCCI:	.BLKW	1		;input carriage control character
TCCTP:	.BLKW	1		;component type: 0 = unknown,
				; 1 = printer, 2 = punch.
TCHFU:	.BLKW	160./16.	;horizontal tab stops (1 bit per
				; position, set = stop.)
TCSBF:	.BLKW	1		;start of buffer for compressed data
TCEBF:	.BLKW	1		;end of buffer for compr data
TCELB:	.BLKW	1		;ptr to the end of line buffer
TCPRCB:	.BLKW	1		;pointer to the rcb
TCCSCB:	.BLKW	1		;current  scb being formed
TCPSCB:	.BLKW	1		;pointer to scb
TCXPCH:	.BLKW	1		;pointer to received data chunk (next)
TCMSC:	.BLKW	1		;count of messages queued by this device
TCCEOF:	.BLKW	1		;count eof sent to bsc
TCCRQT:	.BLKW	1		;count requests sent to remote
TCCDPG:	.BLKW	1		;count permission grants received

TCSIZE=.			;length of a task control block

; the following are used only by the bsc tasks

.=TCSSA

TCCMA:	.BLKW	1		;control message to prompt for next data
				; message when reading, or 0
TCCMC:	.BLKW	1		;length of the above control message
TCRDVT:	.BLKW	1		;current device #
TCBSCF:	.BLKW	1		;miscellaneous flags

 TCITSP=B0			;input received in transparent mode
 TCDIDO=B1			;last operation xmit=1 (receive=0)
 TCSTMS=B2			;status or message was sent in xmit
 TCSONM=B3			;signon was queued to bsc task to xmit
 TCDTMS=B4			;flag to indicate data message was in t.b.
 TCSLMS=B5			;flag to indicate console message

TCSTB:	.BLKW	1		;ptr to start of transmission block
TCRBCB:	.BLKW	1		;current received block count
TCXBCB:	.BLKW	1		;expected block count
TCTBCB:	.BLKW	1		;block count for transmit
TCPBCB:	.BLKW	1		;block count for reprting bcb error
TCRFCS:	.BLKW	1		;received function contol byte 1
TCTFCS:	.BLKW	1		;function control word to transmit
TCPFCS:	.BLKW	1		;for prev fcs
TCCRCB:	.BLKW	1		;current received record control byte
TCSRCB:	.BLKW	1		;current received srcb
TCRQPT:	.BLKW	1		;srcb for request permission to transmit
TCDPG:	.BLKW	1		;srcb for device whose permission is granted
TCSDM:	.BLKW	1		;start of device message from xlate
TCDTB:	.BLKW	1		;current device for transmission block
TCSLFT:	.BLKW	1		;space left in transmission block
TCRMSG:	.BLKW	1		;start of chain of received messages for 
				;different hasp devices
TCRCID:	.BLKW	1		;received i.d. for current block
TCERB:	.BLKW	1		;save bcb for error reporting
TCBCBE:	.BLKW	1		;count bcb errors recvd

T.ENV:				;entry vectors for associated line driver
T.INI:	.BLKW	1		;line driver initialization
T.RED:	.BLKW	1		;read a message
T.WRT:	.BLKW	1		;transmit a data message
T.CTL:	.BLKW	1		;transmit a control message
T.KIL:	.BLKW	1		;kill off the line io
T.INW:	.BLKW	1		;wake bsc on next recieved char
T.DON:	.BLKW	1		;set DTR on
T.DOF:	.BLKW	1		;set DTR off
T.DTS:	.BLKW	1		;get DTR,DSR status
T.TIK:	.BLKW	1		;once per tick routine
T.TRP:	.BLKW	1		;stop code processor for line driver

T$ENL=<.-T.ENV>/2		;length of entry block

.IIF LT TCSIZE-.,TCSIZE=.	;length of a task control block

; the following are used only by tentsk

.=TCSSA

TCXLT:	.BLKW	1		;pointer to translate task being fed
TCXFR:	.BLKW	1		;count of bytes transfered across the dl10
TCPDM:	.BLKW	1		;current ptr to dev msg
				;
T.HDR:				;beg of arg block from xdriver
T.FN:	.BLKB	1		;primary function code - tentsk dispatches on it
T.RES:	.BLKB	1		;result code returned to ten
T.DEV:	.BLKB	1		;device(0 for 2780/3780,component code for hasp)
T.LIN:	.BLKB	1		;line number
T.LNG:	.BLKW	1		;requested number of bytes to transfer

T.CMSG:	.BLKW	1		;ptr to next chunk in msg being read to ten

.IIF LT TCSIZE-.,TCSIZE=. 	;length of a task control block

STKLEN=CHSIZE-TCSIZE		;minimum room left in ass end of tcb for stack
				;some tasks have more room
	.SBTTL		chunks

.=0
CHNXT:	.BLKW	1		;pointer to next chunk (0 if none)
CHLEN:	.BLKW	1		;bytes of data in this chunk
CHDAT:	.BLKW	0		;first byte of data in this chunk

; the 1st chunk in a message has message header data

MSGNXT:	.BLKW	1		;pointer to next message in queue (0 if none)
MSGLCH:	.BLKW	1		;pointer to last chunk of message
MSGCLP:	.BLKW	1		;pointer to chlen of current chunk being filled
MSGPTR:	.BLKW	1		;pointer to first empty/full char position
				; in message (in current chunk)
MSGCNT:	.BLKW	1		;count of bytes left in current chunk
MSGSNL:	.BLKW	1		;bytes to go before inserting a syn
MSGLEN:	.BLKW	1		;overall length of message
MSGID:	.BLKW	1		;message identification (used from xlate
				; to 10 task to identify source line)
MSGFGS:	.BLKW	1		;flags
 MSGTSP=B0			;message was received in bsc transparent mode

MSGNLR:	.BLKW	1		;number of logical records in this message
				; (used only by xlate)

MSGHDL:				;length of message header
MHDAT:	.BLKB	CHSIZE-.	;beginning of data in message header chunk

MHDATL=.-MHDAT			;length of data in message header chunk
CHDATL=.-CHDAT			;length of data in ordinary chunks
	.SBTTL		hasp-multileaving definitions

; record-control-byte definitions

RCBRD1=223			;rcb for card reader 1
RCBRD2=243			;rcb for card reader 2
RCBRD3=263			;rcb for card reader 3
RCBRD4=303			;rcb for card reader 4

RCBPR1=224			;rcb for line printer 1
RCBPR2=244			;rcb for line printer 2
RCBPR3=264			;rcb for line printer 3
RCBPR4=304			;rcb for line printer 3

RCBPU1=225			;rcb for card punch 1
RCBPU2=245			;rcb for card punch 2
RCBPU3=265			;rcb for card punch 3
RCBPU4=305			;rcb for card punch 4

RCBCI= 222			;rcb for console input(operator commands)
RCBCO= 221			;rcb for console output
RCBRQP=220			;rcb for request permission for device
RCBPRG=240			;rcb for permission granted for device
RCBCBE=340			;rcb for bcb error reported in xmit
RCBCTL=360			;rcb for control record (signon)
RCBSON=301			;srcb for signon
RCBSOF=302			;srcb for signoff
RCBRTE=227			;rcb for console routing
RCBINQ=242			;rcb for console inquiry with routing


; function control sequence are defined below:

FCSRD1=B11			;fcs for card  reader 1
FCSRD2=B10			;fcs for card reader 2
FCSRD3=B9			;fcs for card reader 3
FCSRD4=B8			;fcs for card  reader 4

FCSPR1=B11			;fcs for line printer 1
FCSPR2=B10			;fcs for line printer 2
FCSPR3=B9			;fcs for line printer 3
FCSPR4=B8			;fcs for line printer 4

FCSPU1=B0			;fcs for card punch 1
FCSPU2=B1			;fcs for card punch 2
FCSPU3=B2			;fcs for card punch 3
FCSPU4=B3			;fcs for card punch 4

FCSCSL=B6			;fcs for console device
FCSUNV=B14			;fcs for total suspension
FCSINI=107617			;all streams going
FCSYSP=140200			;shut off all streams
FCSADS=100200			;all devices suspended
FCSAGO=104301			;for lpt1,csl and punch1 going

; block count byte definitions

BCBINI=240			;this resets the bcb count to zero
BCBINB=240			;same as above

; terminal type definitions

TT3780=1			;terminal type is an ibm 3780
TT2780=2			;terminal type is an ibm 2780
TTHASP=3			;terminal type hasp-multileaving

; translation option definitions
; used by each assembled translate task to set its bit

XLOP37=B0			;for 2780/3780 translate option

XLOPHS=B1			;for hasp translation option
	.SBTTL		trace definitions

; macro to cause a value to be placed in the trace table,
;  along with the pc of the caller, as an indication of the
;  meaning of the entry.

	.MACRO	TRACE	BITS,ARG,?LBL
.IF NE,FTRACE
	BIT	#BITS,TRCBTS	;trace
	BEQ	LBL		;trace
	ATRACE	<ARG>		;trace
LBL:				;trace
.ENDC ;.IF NE,FTRACE
	.ENDM	TRACE

	.MACRO	ATRACE	ARGS
.IF NE,FTRACE
	$NARG	$$TRCN,<ARGS>
.IF EQ,$$TRCN-1
	TRAC1	<ARGS>
.IFF
	.IRP ARG,<ARGS>
	MOV	ARG,-(SP)	;trace arg
	.ENDM
	MOV	#$$TRCN,-(SP)	;trace
	CALL	TRCSBB		;trace
.ENDC	; .IF EQ,$$TRCN-1
.ENDC	;.IF NE,FTRACE
	.ENDM

	.MACRO	TRAC1,ARG
	MOV	ARG,-(SP)	;trace arg
	CALL	TRCSBR		;trace
	.ENDM

	.MACRO	$NARG	VAR,LIST
VAR=0
	.IRP	L,<LIST>
VAR=VAR+1
	.ENDM
	.ENDM

	.MACRO	TRACB	BITS,TBL,N,?LBL
.IF NE,FTRACE
	BIT	#BITS,TRCBTS	;trace
	BEQ	LBL		;trace
	JSR	PC,TRCBLK	;trace
	.WORD	TBL		;trace TBL
	.WORD	N		;trace N
LBL:
.ENDC	;.IF NE,FTRACE
	.ENDM	TRACB
	.SBTTL		global data storage

.=0				;now define storage for real
	.BLKW	LVPDVC		;words to leave for pdl and vectors
PDL:				;push-down list ends here

; the first few words are sent to the pdp-10 on a "read dn60
;  status" function, and must not, therefore, be changed.

D60ST1:	.BLKW	0		;beginning of dn60 status
JOBVER:	.WORD	VMAJOR,VMINOR,VEDIT,VWHO ;version number
	.WORD	WINVER		;version number of dl10 window
LOWZ1:	.BLKW	0		;start of area to clear on initialization
CHFREC:	.BLKW	1		;count of free chunks
NSLINS:	.BLKW	1		;number of synchronous lines
D60CSZ:	.BLKW	1		;chunk size (for reporting to -10)
D60OPN:	.BLKW	1		;dn60 options
MDVER:	.BLKW	4		;kmc11 version number
D60ERC:	.BLKW	1		;error code on last error
D60ERL:	.BLKW	1		;line number in error last
D60ERD:	.BLKW	1		;device number (or rcb) on last error
D60ACT:	.BLKW	NLINES*2	;active device map for nlines
				; 2 words per line
D60ST2:	.BLKW	0		;end of dn60 status

NDQ11:	.BLKW	1		;number of dq11s
NDUP11:	.BLKW	1		;number of dup11s
NKMC11:	.BLKW	1		;number of kmc11s

TCCMSG:	.BLKW	NLINES		;pointer to message being sent to 10,
				; or zero.
TCDMSG:	.BLKW	NLINES*NDHASP	;to keep ptrs for device messages (hasp)

CHFST:	.BLKW	1		;pointer to first free chunk
CHTAIL:	.BLKW	1		;address of last free chunk
CHLOW:	.BLKW	1		;address of lowest chunk
CHHGH:	.BLKW	1		;address of highest chunk

FRECNT:	.BLKW	1		;total dynamic pool
LINSHR:	.BLKW	1		;current per line allocation of dynamic pool
TOTCNT:	.BLKW	1		;total chunks available
PRMCNT:	.BLKW	1		;number of permanently allocated chunks
				;note: totcnt = frecnt + prmcnt   (ideally)

PHYLIM:	.BLKW	1		;number of bytes of main memory
MEMERR:	.BLKW	1		;mf11-up error register
NXMPC:	.BLKW	1		;pc on last bus trap
NXMGO:	.BLKW	1		;where to go on bus trap
NXMSP:	.BLKW	1		;sp to use on bus trap (0=fatal)
ILSERR:	.BLKW	2		;ps and pc on ill instr (etc) trap
ILSTYP:	.BLKW	1		;type of illegal trap
TRPERR:	.BLKW	2		;pc and ps on trap instr (stopcd)

STOPR0:	.BLKW	1		;R0 on last stopcode
STOPR1:	.BLKW	1		;R1 on last stopcode
STOPR2:	.BLKW	1		;R2 on last stopcode
STOPR3:	.BLKW	1		;R3 on last stopcode
STOPR4:	.BLKW	1		;R4 on last stopcode
STOPR5:	.BLKW	1		;R5 on last stopcode
STOPSP:	.BLKW	1		;SP on last stopcode

.IF EQ,FTKG11			;if we have a kg11-a...
STOPKG:	.BLKW	3		;kg11-a regs on last stopcode
.ENDC	;.IF EQ,FTKG11
TRPCOD:	.BLKW	1		;value of last stopcode

DLGONE:	.BLKW	1		; = -1 if dl10 gone (pdp-10 crashed)
TENALV:	.BLKW	1		;0 til 10 comes to life

JIFCLK:	.BLKW	1		;clock maintained by kw11-l
SECCLK:	.BLKW	1		;1 second count down timer - CLKINT

DSPCLK:	.BLKW	1		;clock maintained by dispatcher
DSPSEC:	.BLKW	1		;counts to jifsec to measure one second

BSYMAX:	.BLKW	1		;maximum time between dispatcher idle cycles
				;following counters reset every 4096 jiffies(1 minute)
BSYMIN:	.BLKW	1		;#ticks when tasks were running(pseudo busy time)
IDLMIN:	.BLKW	1		;#ticks when no tasks running(pseudo idle time)
				;folowing counters reset every 64 jiffies(1 second)
BSYSEC:	.BLKW	1		;#ticks when tasks were running(pseudo busy time)
IDLSEC:	.BLKW	1		;#ticks when no tasks running(pseudo idle time)

TCBP1:	.BLKW	1		;pointer to highest-priority task control blocks
				;  (dq11 drivers)
TCBP2:	.BLKW	1		;pointer to medium-priority task control blocks
				;  (dl10 driver)
TCBP3:	.BLKW	1		;pointer to lowest-priority task control blocks
				;  (all others)
DSPUPT:	.BLKW	2		;up time in seconds (32 bits)
TCDLDR:	.BLKW	1		;pointer to the dl10 driver tcb
DLGNTM:	.BLKW	1		;time (seconds) dl10 has been gone
DSPTCB:	.BLKW	1		;currently running task's tcb

LINCSR:	.BLKW	NLINES		;pointer to csr for each line device
LINVEC:	.BLKW	NLINES		;pointer to interrupt for each line device
LINTYP:	.BLKW	NLINES		;line driver typ code for each line device
LINTBL:	.BLKW	NLINES		;pointer to line block for each enabled line

.IF NE,FTRACE
TRCPTR:	.BLKW	1		;pointer to next trace table entry
TRCTBS:	.BLKW	TRCTBL*2	;the trace table (2 words per entry)
TRCTBE:	.BLKW	0		;end of trace table (for wrap-around)

TRCBTS:	.WORD	TRCLOD		;patch bits on to trace events
 TRCDQD=B0			;trace all bsc task data, one char at a time
 TRCDQF=B1			;trace all line driver functions
 TRCCNK=B2			;trace chunk manipulations
 TRCDSP=B3			;trace dispatcher functions
 TRCQUE=B4			;trace queueing of messages and chunks
 TRCXLD=B5			;trace all xlate data, one char at a time
 TRCBCC=B6			;trace bcc computations
 TRCABO=B7			;trace message stream abnormal termination (can also halt)
 TRCPAD=B8			;stop on receiving an ebcdic pad character in
				; non-transparent data
 TRCTEN=B9			;trace pdp-10 data flow
 TRCDTE=B10			;trace ten/twenty hardware interface functions
 TRCPRO=B11			;trace ten interface protocol states
 TRCBCB=B12			;trace bcb for hasp
 TRCFLO=B13			;trace flow control
 TRCINT=B14			;trace interrupts
 TRCLIN=B15			;trace line traffic and control

TRCHLT:	.WORD	TRCHLD		;patch bits on to enable debugging stops
 TRCTER=B0			;stop on pdp-10 protocol error
 TRCTBO=B1			;stop when trace buffer overflows
 TRCLER=B2			;stop on line errors
;TRCABO=B7			;halt on message stream abnormal termination
.ENDC ;.IF NE,FTRACE

.IF NE,CHOWNR
CHOWNT:	.BLKW	CHOWNL		;table for recording chunk owners
.ENDC ;.IF NE,CHOWNR

.IF NE,FTKG11
KGSIMW:	.BLKW	1		;bcc accumulator for kg11-a simulation
.ENDC ;.IF NE,FTKG11


; area to store dn60, line or device status prior to sending them
;  over the dte20.

DTTTSB:	.BLKW	D60ST2-D60ST1+10 ;dn60 status has max length
DTSBLN=.-DTTTSB			;buffer length for testing

.IF NE,FT.KDP

; the kmc11 control blocks.  since we support up to 12 lines,
;  and since each kmc11 handles up to 4 of them, we can have
;  up to 3 kmc11's.

NKMCR=<<NLINES-1>/4>+1		;number of kmc's required to handle nlines

MDTBL:	.BLKW	MDTLN*NKMCR 	;kmc11 control blocks
MDCSR:	.BLKW	NKMCR		;csr for each kmc11
MDVEC:	.BLKW	NKMCR		;vector for each kmc11

.IF NE,DEBUG
MDMUTT:	.BLKW	1		;max value of mdmxtt required
.ENDC ;.IF NE,DEBUG

.ENDC ;.IF NE,FT.KDP

SKDWRD:	.BLKW	1		;scheduler pass required if non-zero
SKDP:	.BLKW	1		;priority of interrupting task

LOWZ2:	.BLKW	0		;end of area to clear

.IF NE,FT.PAT
PATCH:	.BLKW	FT.PAT
.ENDC;.IF NE,FT.PAT