


		    PNOTICE_mcs.alm                 01/12/87  1201.2r w 01/12/87  1201.2        2853


	dec	1			"version 1 structure
	dec	1			"no. of pnotices
	dec	3			"no. of STIs
	dec	100			"lgth of all pnotices + no. of pnotices
          acc       "Copyright (c) 1987 by Massachusetts Institute of
Technology and Honeywell Information Systems, Inc."

	aci	"C1MCSM0C0000"
	aci	"C2MCSM0C0000"
	aci	"C3MCSM0C0000"
	end
   



		    autobaud_tables.map355          09/20/88  1435.9rew 09/20/88  1432.6       57213


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* * Copyright (c) 1972 by Massachusetts Institute of        *
* * Technology and Honeywell Information Systems, Inc.      *
* *                                                         *
* ***********************************************************


* HISTORY COMMENTS:
*  1) change(86-02-14,Kozlowski), approve(88-08-15,MCR7965),
*     audit(88-09-08,Farley), install(88-09-20,MR12.2-1115):
*     Autobaud with <cr>, "l" and "L" at 9600, 4800, 2400, 1200 and 300 baud.
*  2) change(86-03-12,Kozlowski), approve(88-08-15,MCR7965),
*     audit(88-09-09,Farley), install(88-09-20,MR12.2-1115):
*     Allow 60 seconds for autobauding and removed 133 autobaud code.
*  3) change(88-07-22,Beattie), approve(88-08-15,MCR7965),
*     audit(88-09-09,Farley), install(88-09-20,MR12.2-1115):
*     Prepared for installation.
*                                                      END HISTORY COMMENTS


	lbl	,autobaud_tables
	ttl	control tables for automatic baud selection
	editp	on
	pmc	off
	detail	off
	pcc	off
	rem
	rem
auto	null
	symdef	auto
	symdef	autost
	rem
	symref	begin	return here in control tables after hanging up
	symref	signal	after baud set, return here to signal dialup
	symref	diftyp	exit to control tables here for 1050 or 2741
	symref	cct.2	cct for 2741 or 1050
	symref	cct.br	cct to break on all characters
	rem
	start	auto
	rem
	rem
	pmc	save,on
	csbits
	tconst
	cctdef
	rem
	tib
	pmc	restore
	rem
	ttls
*         These control tables assume the user has hit  carriage
*         return or typed either an upper case or lower case "l" at
*         some unknown baud  rate. The character(s) read at 4800 baud
*         are tested to determine the baud rate. The speeds supported
*         are:
*
*         300 baud input
*         <cr>, lc-"l", and uc-"L" all show up as a line break only
*
*         1200 baud input
*         <cr>    = 1111000 1111110            (170 176    ) any   parity
*         lc-"l" and uc-"L" show up as a line break plus
*         lc-"l"  = 1111000 1111000            (170 170    ) space parity
*         lc-"l"  = 1111000 1111000 1111000    (170 170 170) mark  parity
*         uc-"L"  = 0000000 0000000 1111000    (170 000    ) space parity
*         uc-"L"  = 0000000                    (000        ) mark  parity
*
*         2400 baud input
*         <cr>    = 1100110 0000000            (146 000    ) space parity
*         <cr>    = 1100110 1100000            (146 140    ) mark  parity
*         lc-"l"  = 1100000 0011110            (140 036    ) space parity
*         lc-"l"  = 1100000 1111110            (140 176    ) mark  parity
*         uc-"L"  = 1100000 0011000            (140 030    ) space parity
*         uc-"L"  = 1100000 1111000            (140 170    ) mark  parity
*         4800 baud input
*         <cr>    = 0001101                    (015        ) any   parity
*         lc-"l"  = 1101100                    (154        ) any   parity
*         uc-"L"  = 1001100                    (114        ) any   parity
*         9600 baud input
*         <cr>    = 1111110                    (176        ) space parity
*         <cr>    = 1111111                    (177        ) mark  parity
*                 = 1111001                    (171        ) sometimes...
*         lc-"l"  = 1111101                    (175        ) any   parity
*         uc-"L"  = 1111101                    (175        ) any   parity
	rem
*	define character codes for making these tests
	rem
cc.000	bool	000
cc.015	bool	015
cc.030	bool	030
cc.036	bool	036
cc.114	bool	114
cc.140	bool	140
cc.146	bool	146
cc.154	bool	154
cc.170	bool	170
cc.171	bool	171
cc.175	bool	175
cc.176	bool	176
cc.177	bool	177
	rem
*	character strings for testing results of autobaud test
	rem
ck1200	chstr	(rescan,match,cc.170)
cl1200	chstr	(rescan,match,cc.000)
ck2400	chstr	(rescan,match,cc.146,ignore,cmplst,cc.140,cc.000)
cl2400	chstr	(rescan,match,cc.140
	etc	,ignore,cmplst,cc.176,cc.170,cc.036,cc.030)
ck4800	chstr	(rescan,cmplst,cc.015,cc.154,cc.114)
ck9600	chstr	(rescan,cmplst,cc.177,cc.176,cc.175,cc.171)
	eject
autost	clrflg	(tfkybd,tfprtr,tfctrl,tfsftr)
	rem
retry	stpchn
	dumpin
	config		configure initially to 4800 baud
	baud	4800
	rmode	fg.lpr+fg.lpo	receive parity off
	smode	fg.lps+fg.8bt	send 8-bit chars with parity
	contrl	stat	check current status
	wait	0,0,0
	status	0,cts,ldoff
	status	0,cd,ldoff
	status	suprec,0,st1200	this means new 1200 baud modem
	status	0,suprec,normal	this means old-style modems
	rem
normal	setcct	cct.br	cct to break on all characters
	contrl	rxmit+srec
	rem
	setime	60	Wait a reasonable time
	wait	hang,0,0
	status	0,cts,ldoff
	status	0,cd,ldoff
	status	brkchr,0,gotchr	a character found
	status	break,0,ckbrk	give character time to arrive
	rem
ckbrk	contrl	stat	check current status
	wait	0,0,0	incoming char should be here by now
	status	0,cd,ldoff
	status	0,cts,ldoff
	status	brkchr,0,gotchr	a character found is likely 1200
	status	break,brkchr,set300
	rem	break with no characters is 300 baud

gotchr	setime	-250	wait 1/4 second for rest
	rem
	wait	ready,0,0
	status	0,cd,ldoff
	status	0,cts,ldoff
	rem
ready	stpchn
	rem
scan1	inscan	ck1200,scan2
	goto	st1200
scan2	inscan	cl1200,scan3
	goto	st1200
scan3	inscan	ck2400,scan4
	goto	st2400
scan4	inscan	cl2400,scan5
	goto	st2400
scan5	inscan	ck4800,scan6
	goto	st4800
scan6	inscan	ck9600,retry
	goto	st9600
	rem
*	come here when baud determined
	rem
st9600	scntr	9600
	goto	join
	rem
st4800	scntr	4800
	goto	join
	rem
st2400	scntr	2400
	goto	join
	rem
st1200	scntr	1200
	goto	join
	rem
set300	scntr	300
	goto	join
	rem
*	come here to finish up and return
	rem
join	config
	baud	0	baud rate is in counter
	dumpin
	setcct	scc.df	to normal hsla cct for modes
	goto	signal	back to signal dialup
	rem
*	come here if a vital dataset lead drops
	rem
ldoff	setime	3	give it a chance to change its mind
	wait	hang,0,0	but after 3 secs give up
	status	dsr+cts+cd,0,retry line is back to normal, start over
	rem
*	come here to hang up terminal after timeout 
	rem
hang	stpchn
	dumpin
	dmpout
	contrl	rdtr
	setime	5
	wait	hung,0,0
	status	0,cts,hung
hung	goto	begin	back to top of control tables
	rem
	end
   



		    breakpoint_man.map355           09/23/82  1220.5rew 09/23/82  1203.9       67014


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* * Copyright (c) 1972 by Massachusetts Institute of        *
* * Technology and Honeywell Information Systems, Inc.      *
* *                                                         *
* ***********************************************************

	ttl	module to handle breakpoints in control tables
	ttls
	lbl	,breakpoint_man
	editp	on
	pmc	on
	detail	off
	pcc	off
	rem
	rem
	tib
	comreg
	pmc	off
	ttls
bkpt	null
	symdef	bkpt
	start	bkpt
	rem
	symdef	brkptr	handles requests from diaman
	symdef	brkhit	handles breaks ops for interpreter
	symdef	brktab	address of break table pointer
	rem
	symref	istbrk
	symref	gettib
	symref	setptw
	rem
sm.cd	equ	4	location of cmd data in sub-mbx
	rem
brline	equ	sm.cd+0	line number
braddr	equ	sm.cd+1	addr of break
bractc	equ	sm.cd+2	action code
brflag	equ	sm.cd+3	flags
	rem
*	values for action codes
	rem
actset	equ	1	set break
actrst	equ	2	reset break
actstr	equ	3	restart line from breakpoint
	rem
	rem
*	format of break table
	rem
nbreak	equ	10	max number of breaks
	rem
btbadr	equ	0	addr of break
btblin	equ	1	line number
btborg	equ	2	origional op_block code
btbflg	equ	3	flags
btblen	equ	4	length of entry in table
	rem
*	btbflg values
	rem
trcoff	bool	400000	stop tracing when break is hit
	eject
*	define address and length of break table
*	ring-4 multics software finds the following 3 words thru
*	.crbrk and pretends to understand their meaning
	rem
brktab	ind	brtab
	vfd	18/nbreak
ercode	oct	0	error code from last bkpt request.
	rem		after performing a bkpt operation, ring-4
	rem		multics software will read this word
	rem		to check for errors.
	rem
*	values for ercode
	rem
*	1 = bad address
*	2 = bad line
*	3 = no entry in table
*	4 = line not at break
*	5 = no room in table
*	6 = no opblock at address
*	7 = invalid request
	rem
	rem
************************************************************************
*
*	modified 79 july 27 by art beattie to call setptw after
*	  call to gettib.
*
************************************************************************
	eject
*	subroutine to handle request from dia_man.
*	entered with sub-mbx addr in x3
	rem
brkptr	subr	brq,(x1,x2,x3)
	rem
*	check address supplied in args
	rem
	ila	1	error code, in case bad
	ldq	braddr,3	pick up value
	tmi	brqerr-*
	cmpq	a.a004-*,*	=.crmem
	tpl	brqerr-*	toobig
	rem
*	check that line number, if given, is ok
	rem
	stz	tibadr-*	0 will mean no line
	lda	brline,3	get line from mbx
	tmi	brqgo-*	none
	tsy	a.a005-*,*	=gettib, get real tib address
	tsy	a.a007-*,*	(setptw) virtualize tib address
	sta	tibadr-*
	szn	tibadr-*	was an addr returned?
	tnz	brqgo-*	yes
	ila	2	bad line number
	tra	brqerr-*
	rem
*	check action code to see what kind of request this is
	rem
brqgo	stz	ercode-*
	lda	bractc,3	get code
	icmpa	actset
	tze	set-*	to set a break
	icmpa	actrst
	tze	reset-*	to reset a break
	icmpa	actstr
	tze	start-*	to restart after a break
brqinv	ila	7	error, invalid request
	rem
brqerr	sta	ercode-*	come here to store error
brqret	return	brkptr
	eject
*	set a breakpoint
	rem
set	lda	braddr,3*	get current opblock
	ana	l.a001-*	=777000
	cmpa	l.a001-*	does it look like valid opblock?
	tze	set1-*	yes
	ila	6	error code, no opblock
	tra	brqerr-*
set1	ldx1	a.a001-*	=brtab, address of break table
	lda	braddr,3	pickup break addr
set5	cmpa	btbadr,1	entry for this address?
	tze	set4-*	yes, just update it
	iacx1	btblen
	cmpx1	a.a002-*	=brttbe, end of table?
	tnz	set5-*	no
	rem
	ldx1	a.a001-*	scan table again for free entry
set3	szn	btbadr,1	look for free empty
	tze	set2-*	found one
	iacx1	btblen	next entry
	cmpx1	a.a002-*	end of table?
	tnz	set3-*	no
	ila	5	error, no room
	tra	brqerr-*	no room for entry, give up
	rem
set2	ldx2	braddr,3	address to set break
	stx2	btbadr,1	save in break table
	lda	0,2	get orig opblock
	sta	btborg,1	save in table
	lda	bkop-*	get a breakpoint opblock
	sta	0,2	break is set
set4	lda	brline,3	line number
	sta	btblin,1
	lda	brflag,3	copy flags
	sta	btbflg,1
	tra	brqret-*	done
	eject
	rem
*	reset a break
	rem
reset	ldx2	braddr,3	address of break toreset
	tze	reset3-*	bad
	ldx1	a.a001-*	=brtab, start of table
reset2	cmpx2	btbadr,1	find entry for this break
	tze	reset1-*	got it
	iacx1	btblen
	cmpx1	a.a002-*	=brttbe, end of table
	tnz	reset2-*
reset3	ila	3	error, no entry
	tra	brqerr-*	cant find entry, give up
reset1	lda	btborg,1	get origional opblock
	sta	0,2	replace it
	stz	btbadr,1	free table entry
	tra	brqret-*	done
	eject
*	restart a line at a breakpoint
	rem
start	szn	tibadr-*	line specified?
	tze	brqinv-*	no, done
	ldx1	tibadr-*	addr of tib
	lda	t.flg3,1	third word of flags
	cana	l.a002-*	=tfbkpt see if at break
	tnz	start5-*	is is
	ila	4	error, not at break
	tra	brqerr-*
start5	ldx2	braddr,3	get starting address specified
	tze	start7-*	none given, use t.cur
	lda	0,2	be sure opblock at start address
	ana	l.a001-*	=777000
	cmpa	l.a001-*
	tze	start6-*	good opblock
	ila	6	error, no opblock
	tra	brqerr-*
start6	stx2	t.cur,1	starting address becomes t.cur
	ila	0	no new opblock for intp
	tra	start2-*
start7	ldx2	t.cur,1	addr of current opblock
	lda	0,2	pick it up
	cmpa	bkop-*	is it a break?
	tze	start1-*	yes, intpreter will want something else
	ila	0	not a break, interpeter can use real op
	tra	start2-*
start1	ldx1	a.a001-*	=brtab, must scan to find real op
start4	cmpx2	btbadr,1	found entry?
	tze	start3-*	yes
	iacx1	btblen
	cmpx1	a.a002-*	end of tab?
	tnz	start4-*
	lda	nullop-*	give intpreter a nullop to exec
	tra	start2-*
start3	lda	btborg,1	give interpreter the origional op
start2	sta	saveop-*	saveop for intp
	lda	brflag,3	get flags
	cana	l.a004-*	asked to start tracing?
	tze	2	no
	stz	a.a006-*,*	=.crtsw
	ldx1	tibadr-*	interpreter needs tib addr
	lda	saveop-*	op for intp
	tsy	a.a003-*,*	=istbrk, restart after break
	tra	brqret-*	done
saveop	bss	1
	eject
*	subroutine called by the intpreterer when a break point op
*	is found. entered with tib in x1, current op pointer in x2.
*	an in line return indicates that the break should not be
*	taken; the a will contain the opblock to execute instead.
*	a skip return will mean take the break.
	rem
brkhit	subr	hit,(x3)
	rem
	ldx3	a.a001-*	=brtab, start of break table
hit2	cmpx2	btbadr,3	entry for current opblock?
	tze	hit1-*	yes, found it
	iacx3	btblen
	cmpx3	a.a002-*	end of table
	tnz	hit2-*
	tra	hit3-*	no entry in table, so must take break
hit1	szn	btblin,3	is break for special line?
	tmi	hit4-*	no, take break
	lda	t.line,1	check to see if this is the line
	cmpa	btblin,3
	tze	hit4-*	it is, take break
	lda	btborg,3	no break, return origional opblock
	tra	hitret-*
hit4	lda	btbflg,3	get flag word
	cana	l.a003-*	=trcoff, should we stop tracing?
	tze	hit3-*	no
	ila	1
	sta	a.a006-*,*	=.crtsw
hit3	aos	brkhit-*	skip means take break
hitret	return	brkhit
	eject
	rem
	rem
a.a001	ind	brtab	address of break table
a.a002	ind	brtabe	address of end of table
a.a003	ind	istbrk	control table rtn to restart break
a.a004	ind	.crmem
a.a005	ind	gettib
a.a006	ind	.crtsw
a.a007	ind	setptw
	rem
l.a001	vfd	o18/777000
l.a002	vfd	o18/tfbkpt
l.a003	vfd	o18/trcoff
l.a004	vfd	o18/400000
	rem
tibadr	bss	1
	rem
bkop	bkptop		a breakpoint opblock
nullop	nullop		a no-operation opblock
	rem
brtab	null		the break table
	bss	btblen*nbreak
brtabe	null
	rem
	end
  



		    console_man.map355              09/23/82  1220.5rew 09/23/82  1204.1      234396


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* * Copyright (c) 1972 by Massachusetts Institute of        *
* * Technology and Honeywell Information Systems, Inc.      *
* *                                                         *
* ***********************************************************

	lbl	,console_man
	ttl	console manager for 355 with multics
	rem
	rem
	pmc	off
	pcc	on
	detail	on
	editp	on
	rem
	rem
	symdef	cons
	rem
	symdef	wcon	write console routine
	rem		called from outside in emergency
	symdef	contip	terminate interrupt processor for above
	rem
	symdef	consol	console interrupt processing routine
	symdef	consjt	so init can find jump tables
	rem
	symref	mdisp	dispatcher return
	symref	secdsp	event dispatcher return
	symref	dspqur	dispatcher queuer entry
	symref	conabt	console operator abort routine
	symref	invp	main interrupt processing routine
	symref	g3wjt	get 3rd word of jump table routine
	symref	octasc	octal to ascii conversion subroutine
	rem
	rem
	rem
	rem
	rem
	pmc	save,on
cons	null
	start	cons,7
	ttls	console read and write routines
************************************************************************
*
* these routines are used to write messages
* on the datanet-355 console and/or to receive messages from the
* system operator.
*
* the routines have no queueing capability, so a "busy flag" is used to
* prevent more than one access to the console at a time.  if the console
* is busy at the time the user calls "write" or "wrcon," a return is made
* immediately to a special "busy return" point in the user's calling
* sequence.  at this time the user would (perhaps) queue up a time
* delayed routine to retry at a later time.  if the console is not busy
* when the user calls, his request will be initiated and control
* returned to his "accepted return" point.
*
************************************************************************
*
* calling sequence for "write" --
*	pre-set registers -- the a, q, and x1 registers must be set up as
*		required by the dispatcher queuer.  this specifies the        
*		routine which will be queued when the write operation        
*		terminates.        
*
*	tsy     write-*
*	zero    <address of data icw>
*	---     <accepted return point>
*	---     <busy return point>
*
************************************************************************
*
* calling sequence for "wrcon" --
*
*	pre-set registers -- the a, q, and x1 registers must
*		be set up as required by the dispatcher queuer.        
*		this specifies the routine which will be queued        
*		when the read operation has terminated.        
*
*	tsy     wrcon-*
*	zero    <address of output data icw>
*	zero    <address of input-area data icw>
*	---     <accepted return point>
*	---     <busy return point>
*
************************************************************************
	eject
************************************************************************
*
* console "terminate interrupt" processing routine
*
* the "terminate interrupt" is caused, naturally enough, when data
* transfer between the console teletypewriter and the 355 terminates.
*
* several "abnormal" events can also cause this interrupt, and these
* are indicated in the code.
*
* the routine responds to this interrupt by indicating to the approprate
* user routine that his requested data transfer has been completed.
*
************************************************************************
*
* console "special interrupt" processing routine
*
* the "special interrupt" is caused by pressing the "break" key on the
* console tty.  the routine "spcon" is called in response to this
* interrupt.  this is the method to be used by the operator to request
* the performance of the several special operations provided.
*
* the routine responds to the special interrupt by printing "???" to
* which the operator is expected to type in one of the commands
* listed below --
*
*	command variable(s)     function
*
*	abort                   abort 355.  cause an immediate dump.
*	alter   aaaaa,bbbbbb    store bbbbbb in location aaaaa, absolute.
*	peek    aaaaa           write contents of loc aaaaa, absolute
*	peek    aaaaa,n         write n words starting at aaaaa.
*	test                    call the on-line t&d system.
*
* n.b. -- future developers
*	command words must be at least four (4) characters in length.  to
*	increase the number of variable fields, see the comments in the
*	"idx" subroutine.
************************************************************************
	rem
	rem
	systm
	comreg
	rem
	pmc	restore
cr	bool	15
lf	bool	12
xoff	bool	23
	ttls	write -- write console routine
************************************************************************
*
*	write    write console routine
*
************************************************************************
	rem
write	subr	wri,(x1,inh)
	rem
	szn	nocon-*	see if console is not configured or down
	tnz	w05-*	yes
	szn	conbsy-*	? console busy ?
	tze	w10-*	no
w05	null
	aos	write-*	yes, go to user's "busy return"
	tra	wribak-*
	rem
	rem
	rem
w10	null
	aos	conbsy-*	set busy flag
	aos	cwrite-*	set write operation control flag
	aos	cwconf-*	set wcon routine in control flag
	ldi	wrisi-*	>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
	rem
	staq	cqueaq-*	save parameters of routine to be queued
	stx1	cquex1-*	when write operation terminates
	ldaq	csicw-*	set up status icw mailbox
	staq	csicwa-*,*
	ldx1	write-*,*	set up data icw mailbox
	ldaq	0,1
	staq	cdicwa-*,*
	staq	cwwicw-*	save output data icw
	rem
	sel	tych	issue write command
	cioc	cwpcw-*
	rem
wribak	null
	aos	write-*
	return	write
	ttls	wrcon -- write-then-read console routine
************************************************************************
*
*	wrcon   write-then-read console routine
*
************************************************************************
	rem
wrcon	subr	wrc,(inh,x1)
	rem
	szn	nocon-*	see if console is not configured or down
	tnz	w105-*	yes
	szn	conbsy-*	? console busy ?
	tze	w110-*	no
w105	null
	aos	wrcon-*	yes, go to user's "busy return"
	aos	wrcon-*
	tra	wrcbak-*
	rem
	rem
	rem
w110	null
	aos	conbsy-*	set busy flag
	aos	cwrite-*	set write operation control flag
	stz	cwconf-*	clear wcon routine in control flag
	ldi	wrcsi-*	>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
	rem
	staq	cqueaq-*	save parameters of routine to be queued
	stx1	cquex1-*	when read operation terminates
	ldaq	csicw-*	set up status icw mailbox
	staq	csicwa-*,*
	ldx1	wrcon-*,*	set up data icw mailbox
	ldaq	0,1
	staq	cdicwa-*,*
	staq	cwwicw-*	save output data dcw
	aos	wrcon-*	save input-area data icw
	ldx1	wrcon-*,*
	ldaq	0,1
	staq	cwricw-*
	rem
	sel	tych	issue write command
	cioc	cwpcw-*
	rem
wrcbak	null
	aos	wrcon-*	go to user's "accepted return" point
	tra	wrcon-*,*
	rem
	rem	*********************************************************
	rem	* continue after write operation terminates and initiate
	rem	* the read operation
	rem	*********************************************************
	rem
wrcont	null
	stz	cwrite-*	clear write operation control flag
	ldaq	csicw-*	set up status icw mailbox
	staq	csicwa-*,*
	ldaq	cwricw-*	set up input-area data icw mailbox
	staq	cdicwa-*,*
	rem
	cioc	crpcw-*
	rem
	tra	1,*	return to dispatcher
cdisp	ind	secdsp
	ttls	wcon -- emergency write routine
	rem
	rem
**********************************************************************
*   wcon is the routine called from outside console_man to write error
*   messages and crash warnings on the console.
*
*   it does not return to its caller until the write is complete.
*   it expects that only level 0, 1, and 2 interrupts are enabled,
*   and that other interrupts will go to an "ignore" subroutine.
*
*   in general, contip will be the terminate interrupt processor
*   associated with this routine, rather than consol as for write
*   and wrcon.
*
*   calling sequence:
*
*	tsy     wcon-*
*	zero    <address of data icw>
*	---     <error return>
*	---     <normal return>
*
**********************************************************************
	rem
	rem
cntrlx	bool	30
sbits	bool	50
	rem
	rem
	rem
wcon	subr	wco,(x1,inh)
	rem
	szn	nocon-*	is there a console?
	tnz	wcobak-*	take error return if not
	rem
	szn	conflg-*,*	(=.crcon) console io enabled now?
	tnz	wcook-*	no, ignore call
	rem
	aos	conbsy-*	mark console busy
	ldx1	wcon-*,*	get icw address
	ldaq	0,1	get icw
	staq	cdicwa-*,*	put it in mailbox
	ldaq	csicw-*	get status icw
	staq	csicwa-*,*
	rem
	sel	tych
	cioc	cwpcw-*	(write pcw)
	rem
wco010	null
	eni		>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
	dis		wait for interrupt
	tra	-1
	rem
	ttls	contip -- terminate interrupt ptocessor for wcon
	rem
contip	ind	**
	sti	conind-*	hang on to indicators
	inh		<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	szn	conbsy-*	if console isn't busy,
	tnz	wco020-*
	ldi	conind-*	restore indicators and
	tra	contip-*,*	ignore interrupt
	rem
wco020	null
	lda	cstat-*	get status; is it "ready"?
	tpl	wcobak-*	no, take error return
	rem
	arl	9	ptro or control char?
	icana	sbits
	tze	wcobak-*	neither, take error return
	rem
	ldx1	cdicwa-*,*	pick up last character transmitted
	lda	-1,1,b.1
	icmpa	cntrlx	"control-x"?
	tze	wcobak-*	yes, error return
	rem
wcook	aos	wcon-*	else bump for good return
	rem
wcobak	null
	aos	wcon-*	bump return address once
	stz	conbsy-*	not busy any more
	rem
	return	wcon
	rem
	rem
conind	bss	1	for storing indicators
	ttls	data for wcon, wrcon, write
	rem
	even
csicw	icw	cstat,b.0,1	status icw image
cwpcw	oct	0,44	pcw -- write
crpcw	oct	0,50	pcw -- read
cwwicw	bss	2	wrcon's current output data icw
cwricw	bss	2	wrcon's current input data icw
cqueaq	bss	2	queue data for wrcon
	rem
cstat	bss	1	status store area
cquex1	bss	1	queue data for wrcon
conbsy	bss	1	console busy flag (<>0=busy)
nocon	bss	1	no console (<>0) flag
cwrite	bss	1	write operation control flag
cwconf	bss	1	wcon routine in control (<>0) flag
	rem
csicwa	ind	tyst	address of console status icw mailbox
cdicwa	ind	tyicw	address of console data icw mailbox
	rem
conflg	ind	.crcon
	ttls	consol -- console interrupt processing routine
************************************************************************
*
* the sequence of events in processing the terminate and special
* interrupts from the system console is as follows:
*
*	1.      the appropriate interrupt cell is set by the iom.
*
*	2.      the processor acknowledges the interrupt by executing a
*		"tsy x,*" where "x" is the address of the appropriate        
*		interrupt vector, which points to a "jump table."        
*
*	3.      the jump table routine stores the value of the ic and
*		sends control to the "invp" routine.        
*
*	4.      the "invp" routine saves registers and sends control to
*		the routine "consol" below.        
*
*	5.      "consol" determines from the 3rd word of the jump table
*		which console interrupt (terminate or special) occurred,        
*		and enters the appropriate parameters into the event        
*		dispatcher's queue.        
*
************************************************************************
	rem
	rem	*********************************************************
	rem	* terminate and special interrupt jump tables
	rem	*********************************************************
	rem
consjt	null		symbol that init finds
contmj	ind	**
	tsy	invpx-*,*
	vfd	12/0,6/modcon
	rem
conspj	ind	**
	tsy	invpx-*,*
	vfd	12/-1,6/modcon
	eject
	rem	*********************************************************
	rem	* console interrupt processing routine
	rem	*********************************************************
	rem
consol	null
	inh		<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	tsy	g3wjtx-*,*	get 3rd word of jump table
	iaq	0	? terminate or special interrupt ?
	tmi	con20-*	special, go process
	rem
	rem	terminate interrupt...
	rem
	ldaq	tmaq-*	queue up the terminate interrupt
	ldx1	tmx1-*	processing routine in event
con10	null
	tsy	tmquer-*,*	dispatcher
	tra	cmdisp-*,*
	rem
	rem	special interrupt...
	rem
con20	null
	szn	sibusy-*	? special interrupt already active ?
	tnz	cmdisp-*,*	yes, ignore this one
	aos	sibusy-*	no, set flag to block others
	ldaq	spaq-*	queue up the special interrupt
	ldx1	spx1-*	processing routine in event
	tra	con10-*
	rem
	rem
	rem
invpx	ind	invp	main interrupt processor
g3wjtx	ind	g3wjt
cmdisp	ind	mdisp	return to master dispatcher
	rem
modcon	set	6
	ttls	tmcon -- console terminate interrupt processor
************************************************************************
*
*	tmcon   console terminate interrupt processor -- part 1
*
************************************************************************
	rem
tmcon	null
	szn	conbsy-*	? busy flag set ?
	tnz	t10-*	yes, as it should be!
	aos	tmeict-*	no, count this extraneous interrupt
	tra	cdisp-*,*	return to dispatcher
	rem
t10	null
tsel	sel	**	select console channel
	szn	cwrite-*	? read or write termination ?
	tze	tmread-*	read, go process accordingly
	rem
	rem	*********************************************************
	rem	* process write termination status
	rem	*********************************************************
	rem
	lda	cstat-*	? status = ready ?
	tmi	t30-*	yes
	rem
t20	null
	aos	cwrite-*
	lda	cwrite-*	test to see if console may be down
	cmpa	cntrbl-*	(377777 octal)
	tnz	t25-*	no, keep hanging in there
	rem
	rem	we have tried to go to the console 131071 times.
	rem	it must be down. set a switch to indicate this
	rem	and disable interrupts for the console.
	rem
	sel	tych	select console channel
	cioc	cnmpcw-*	connect to mask pcw
	aos	nocon-*	set switch to indicate no console
	tra	cdisp-*,*	return to dispatcher
t25	null
	ldaq	csicw-*	re-issue the write command
	staq	csicwa-*,*
	ldaq	cwwicw-*
	staq	cdicwa-*,*
	cioc	cwpcw-*
	tra	cdisp-*,*
	rem
t30	null
	arl	9
	icana	32	(000040)     ? status = ptro ?
	tze	t20-*	no, re-issue write command
	szn	cwconf-*	? wcon or wrcon initiated write ?
	tze	wrcont-*	wrcon, return to issue read
	rem
texit	null
	inh		<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	stz	cwrite-*	no longer in write sequence
	ldaq	cqueaq-*	queue user's courtesy call routine
	ldx1	cquex1-*
	tsy	tmquer-*,*
	stz	conbsy-*	clear console busy flag
	rem
	szn	spint-*	? special interrupt waiting ?
	tze	cdisp-*,*	no, return to dispatcher
	ldaq	spaq-*	yes, queue special interrupt
	ldx1	spx1-*	processor
	tsy	tmquer-*,*
	stz	spint-*
	tra	cdisp-*,*	return to dispatcher
	rem
	rem	*********************************************************
	rem	* process read termination status
	rem	*********************************************************
	rem
tmread	null
	lda	cstat-*
	arl	9
	icana	128	(000200)    ? status = timer runout ?
	tnz	t20-*	yes, re-issue write command
	rem
t40	null
	icana	64	(000100)     ? status = tro ?
	tnz	t20-*	yes, re-issue write command
	ldx1	cdicwa-*,*	no, get last input character
	lda	-1,1,b.1
	icmpa	cntrlx	? control-x ?
	tze	t20-*	yes, re-issue write command
	icmpa	cr+pbit	? carriage return ?
	tze	t50-*	yes
	icmpa	xoff+pbit	? x-off ?
	tnz	t20-*	no, re-issue write command
	rem
t50	null
	lda	cstat-*	? status = ready ?
	tpl	t20-*	no, re-issue write command
	tra	texit-*
	rem
	rem
	rem
	even
tmaq	oct	13
	ind	tmcon
tmx1	zero	0
	rem
tmquer	ind	dspqur
tmeict	bss	1	count of extraneous interrupts
cntrbl	oct	377777
	even
cnmpcw	oct	0,010000	mask bit on to disable channel
	ttls	spcon -- console special interrupt processor
************************************************************************
*
*	 spcon  console special interrupt processor
*
************************************************************************
	rem
spcon	null
	szn	conbsy-*	? any outstanding console io ?
	tze	sp9-*	no, proceed
	aos	spint-*	yes, set special interrupt flag
	tra	cdisp-*,*	return to dispatcher
	rem
sp9	null
	lda	msg1p-*	set message "???"
sp9a	null
	sta	sp15-*
	rem
sp10	null
	ldaq	spbaq-*	write-then-read message 1, 2, or 3
	ldx1	spbx1-*
	tsy	wrcon-*
sp15	zero	**
	zero	spicwi
	tra	cdisp-*,*	accepted -- return to dispatcher
	rem
	ldaq	spaqt-*	busy -- re-queue with 5-second
	ldx1	spx1-*	time delay
	tsy	tmquer-*,*
	tra	cdisp-*,*
	rem
	rem	*********************************************************
	rem	* continue after operator's message has been read
	rem	*********************************************************
	rem
spconb	null
	ldx1	spoptb-*	x1 points to op-code table
	rem
sp100	null
	ldaq	input-*	get 1st 4 characters of input data
	cmpa	0,1	search
	tnz	sp110-*	op-code
	cmpq	1,1	table
	tze	2,1*	for match
	rem
sp110	null
	iacx1	3	bump pointer
	cmpx1	spopnd-*	? end of table ?
	tnz	sp100-*	no, continue search
	rem
	arl	9
	icmpa	cr+pbit	? null line -- cr only ?
	tze	sp115-*	yes, exit
	rem
	lda	msg3p-*	set message "what?"
	tra	sp9a-*
	rem
sp115	null
	inh		<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	stz	sibusy-*	yes, ignore this message
	tra	cdisp-*,*
	rem
	rem
	rem
	even
spicw1	icw	msg1,b.0,6
spicw2	icw	msg2,b.0,8
spicw3	icw	msg3,b.0,8
spicwi	icw	input,b.0,24
spaq	vfd	12/0,o6/14,18/spcon
spbaq	vfd	12/0,o6/14,18/spconb
spaqt	vfd	12/5,o6/14,18/spcon
input	bss	12
	rem
pbit	bool	200
spx1	zero	0
spbx1	zero	0
spint	bss	1
sibusy	bss	1	"special interrupt processor" flag
	rem
msg1p	zero	spicw1
msg2p	zero	spicw2
msg3p	zero	spicw3
	rem
msg1	vfd	9/cr,9/lf
	aci	2,???
msg2	vfd	9/cr,9/lf
	aci	3,more?
msg3	vfd	9/cr,9/lf
	aci	3,what?
	rem
	rem
	rem
spoptb	zero	*+1
	vfd	o18/101102
	vfd	o18/317322
	vfd	18/xabort
	vfd	o18/120305
	vfd	o18/305113
	vfd	18/xpeek
	vfd	o18/101314
	vfd	o18/324305
	vfd	18/xalter
	vfd	o18/324305
	vfd	o18/123324
	vfd	18/xtest
spopnd	zero	*
	ttls	operator command processing routines
************************************************************************
*
*	abort
*
* this command causes an immediate system disaster dump (if a printer is
* configured) just as though a processor fault had occurred.
*
************************************************************************
	rem
xabort	null
	stz	sibusy-*
	tsy	1,*
	ind	conabt
	eject
************************************************************************
*
*	peek    aaaaa
*	peek    aaaaa,n
*
* this command causes the contents of specified locations to be written
* onto the console teletypewriter.  if "n" is present, it specifies the
* number of words to be written, otherwise only one word will be written
* aaaaa specifies the address of the first, or only, word written.
*
* up to eight words will be printed per line
*
************************************************************************
	rem
xpeek	null
	ldx3	spicwi-*	x3 points to input message
	tsy	idx-*	extract one or two octal fields
	rem
	rem	c(idxof1) = address of 1st, or only, word to be typed
	rem	c(idxof2) = number of words to be typed (0 = one word)
	rem
	szn	idxof2-*	if zero was specified, make it 1
	tnz	2
	aos	idxof2-*
	rem
xpk10	null
	lda	xalmem-*,*	mask address to allowable range
	ansa	idxof1-*
	ldq	idxof1-*	convert address to ascii
	ldx3	xpkout-*
	tsy	xpkcnv-*,*
	rem
	iacx3	0,b.1	leave extra blank after address
	ila	9	initialize tally
	sta	xpkicw+1-*
	rem
	lda	idxof2-*	get remaining count
	icmpa	8
	tmi	2	if it's less than 8, use as is
	ila	8	else use 8
	rem
	iera	-1	c(a) <- -c(a)
	iaa	1
	sta	remain-*	hang on to remainder
	rem
xpk15	null		conversion loop
	iacx3	0,b.1	precede word with a blank
	ldq	idxof1-*,*	convert data word to ascii
	tsy	xpkcnv-*,*
	rem
	ila	7
	asa	xpkicw+1-*	increment tally
	aos	idxof1-*	and data address
	aos	remain-*	more data words for this line?
	tnz	xpk15-*	yes, go convert next one
	rem		else write out the line
	rem
xpk20	null
	ldaq	xpkqa1-*
	ldx1	xpkqx1-*
	tsy	xpkwc-*,*	write address and contents
	zero	xpkicw
	tra	xpdisp-*,*	(accepted)
	tra	xpk20-*	(busy)
	rem
	rem	*********************************************************
	rem	* continue processing after 1st write terminates
	rem	*********************************************************
	rem
xpeekb	null
	rem
	ila	-8	any more words to be typed?
	asa	idxof2-*	yes if result > 0
	tmi	2	no
	tnz	xpk10-*	yes
	rem
xpk50	null
	lda	msg2p-*	set message "more?"
	tra	sp9a-*
	rem
	rem
	rem
	even
xpkqa1	vfd	12/0,o6/14
	ind	xpeekb
xpkicw	icw	xpkmsg,b.0,**
	rem
	rem		new-line and 64 blanks initially
xpkmsg	vfd	9/cr,9/lf
	aci	16
	aci	16
	rem
xpkout	zero	xpkmsg+1,b.0
xpkcnv	ind	octasc
xpkqx1	zero	0
xpkwc	ind	write
xpdisp	ind	secdsp
remain	bss	1	number of words remaining to be printed on line
	eject
************************************************************************
*
*	alter   aaaaa,bbbbbb
*
* this command causes the octal number  bbbbbb  to be stored in the
* location whose absolute octal address is aaaaa.
* the octal address, aaaaa, will be "anded" with either 077777 or
* 037777, depending on the size of core storage in use.
*
************************************************************************
	rem
xalter	null
	ldx3	spicwi-*	x3 points to input message
	tsy	idx-*	extract one or two octal fields
	rem
	lda	idxof1-*	limit address to 16k or 32k size
	ana	xalmem-*,*
	cax1
	lda	idxof2-*	store data in specified address
	sta	0,1
	ila	1
	sta	idxof2-*	peek location just altered
	tra	xpk10-*
	rem
	rem
	rem
xalmem	ind	.crmem	contains highest address in core
	eject
************************************************************************
*
*	test                    call the on-line t&d system
*
* this command will allow the future on-line t&d system to be called by
* the 355 console operator.
*
************************************************************************
	rem
xtest	null
	stz	sibusy-*
	tra	1,*	(temporary return)
	ind	secdsp
	rem
	ttls	idx -- console input data extraction subroutine
************************************************************************
*
* this subroutine is used to extract octal numbers from the input string
* typed on the system console.  the routine was designed to permit the
* operator to make quick corrections to the octal numbers he may be
* required to type.
*
* for the purposes of this subroutine, the input string is assumed to be
* one octal number or two octal numbers separated by a comma.  in the
* examples which follow, the first column is the input string, the
* symbol <eom> stands for either a "carriage return" or "x-off"
* character.  the second and third columns are the output of this sub-
* routine -- idxof1 = octal field #1 and idxof2 = octal field #2
*
* as the input string is scanned (from left to right), octits (which is
* the word used to refer to octal integers) are saved in one of the
* "octal field registers" until a non-octit is encountered.  if this
* non-octit is --
*
*	-- <eom>, control is immediately returned to the calling program.
*
*	-- a comma, the saving of octits in the current octal field
*		register is stopped, a pointer (x2) is bumped to point to        
*		the next octal field register, and scanning continues.        
*
*	-- letter x, all octits and resulting octal fields are ignored,
*		the octal field registers are reset to zero, and scanning        
*		begins with the next input character.        
*
*	-- any other non-octit, the octits thus far typed and being saved
*		in the current octal field register are ignored, the        
*		current octal field register is reset to zero, and        
*		scanning continues at the next character.        
*
* the octal field registers will contain a maximum of six octits.  since
* each new octit enters the register at the right end by moving the pre-
* vious contents left, typing more than six octits removes the high
* order extra octits and saves only the low order six octits.
*
* examples --
*
*	input string                    idxof1  idxof2
*
*	123456<eom>                     123456  000000
*	123456,654321<eom>              123456  654321
*	1<eom>                          000001  000000
*	1,2<eom>                        000001  000002
*	1234567432,7654321346<eom>      567432  321346
*	13e12,456e556<eom>              000012  000556
*	123,456x321,654<eom>            000321  000654
*
************************************************************************
*
* calling sequence --
*
*	x3 = character/word address of start of the input string
*
*	tsy     idx-*
*
* exit conditions --
*
*	x2 = address of last octal field register used
*
* n.b. -- future developers...
*		the following must be done to modify this subroutine to        
*		handle more than the present two octal fields.        
*	1.  following the instruction at <idx10+2>,
*	    insert <stz idxof3-*>, <stz idxof4-*>, etc.
*	2.  change the instruction at <idxlof> to <idxlof zero idxof#+1>,
*	    where # is the number of octal fields.
*	3.  following the instruction at <idxof2>,
*	    insert <idxof3 bss 1>, <idxof4 bss 1>, etc.
*
************************************************************************
	rem
idx	ind	**
	rem
idx10	null
	ldx2	idxfof-*	x2 points to octal field register
	stz	idxof1-*	clear octal field registers
	stz	idxof2-*
	stz	idxpco-*	clear pco flag
	rem
idx20	null
	lda	0,3,b.0	get current input character
	icmpa	cr+pbit	? carriage return ?
	tze	idx-*,*	yes, return to user
	icmpa	xoff+pbit	? x-off ?
	tze	idx-*,*	yes, return to user
	iacx3	0,b.1	bump input character pointer
	cmpx2	idxlof-*	? more than 2 octal fields ?
	tze	idx-*,*	yes, return to user
	rem
	iana	127 (000177)	strip parity bit
	caq
	qrl	3
	iaq	-6	? current character an octit ?
	tnz	idx30-*	no
	szn	idxpco-*	? previous character an octit ?
	tnz	3	yes
	stz	0,2	no, clear current octal field register,
	aos	idxpco-*	set pco flag
	ldq	0,2	store octit
	als	18-3	in current octal
	llr	3	field
	stq	0,2	register
	tra	idx20-*
	rem
idx30	null
	stz	idxpco-*	clear pco flag
	icmpa	44	(000054)     ? current input character a comma ?
	tnz	3	no
	iacx2	1	yes, bump pointer to next field reg.
	tra	idx20-*
	rem
	icmpa	88 (000130)	? current input character the letter x ?
	tze	idx10-*	yes, clear all and start over
	tra	idx20-*	no, resume scanning
	rem
	rem
	rem
idxfof	zero	idxof1
idxlof	zero	idxof2+1
idxof1	bss	1	octal field register #1
idxof2	bss	1	octal field register #2
idxpco	bss	1	previous character octit flag
	end



		    control_tables.map355           04/10/86  1359.3rew 04/10/86  1343.8      361161


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* * Copyright (c) 1972 by Massachusetts Institute of        *
* * Technology and Honeywell Information Systems, Inc.      *
* *                                                         *
* ***********************************************************

	
	lbl	,control_tables
	editp	on
	pmc	off
	pcc	off
	detail	off
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*
*	control_tables, ctrl
*
*	     The control_tables are the primary driving program
*	for the 355. They are interpreted by the control table
*	interpreter, who performs various functions on behalf
*	of the tables and calls the lsla, hsla, and dia interface
*	routines when required.
*
*	     This module contains the control tables for general-purpose
*	low-speed lines and vanilla synchronous lines. It also contains
*	all cct's, device tables, etc. Other modules contain
*	special-purpose control tables for such things as g115, ards,
*	tn1200 on 202c modem, and anything else which might come up.
*
*	     The tables specify what actions are to be peformed for
*	each line on the 355 and in what sequence these are to be
*	done. This includes control of the datasets, printer/keyboard
*	addressing for terminals which require it, and the initiation
*	of i/o to the terminals. The tables are entered (or "started")
*	for each line at the label "begin" by the init routine. After
*	that the path through the tables is controlled by external
*	events and the actions taken by these tables.
*
*	Originally coded 6/14/74 by Mike Grady
*	Modified by Bob Adsit 7/20/75 to handle 115's
*	Modified by Robert Coren 7/31/75 to handle tn1200 on 202c
*	Modified by Robert Coren 4/29/76 to split up into several modules
*	Modified by C. Hornig October 1980 to not send DLE EOT on hangup
*	Modified by T. Oke to allow hardware flow control using CTS
*	Modified by T. Oke to merge rapid breaks (less than .25 seconds)
*	  and avoid buffer overruns -- TR8447
*	Modified by D. W. Cousins on Nov 22 1985 to abort the hungup 
*	  500 ms timer for X.25 in order to process the activation order
*	  in time, else the wait loop will lose it. (TR PHX19612)
*
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

* HISTORY COMMENTS:
*  1) change(86-02-03,Kissel), approve(86-02-03,MCR7324):
*     Modified to abort the hangup 500 ms timer for X.25 in order to process
*     the activation order in time.  Otherwise, the wait loop would lose it
*     (TR phx19612).
*                                                      END HISTORY COMMENTS

	ttl	control_tables
	rem
	rem
ctrl	null		/* setup primary symdef */
	rem
	symdef	ctrl
	rem
	symdef	begin
	symdef	hungup
	symdef	tdhung
	symdef	signal
	symdef	error
	symdef	cct.2
	symdef	stpchn
	symdef	diftyp	autobaud returns here for 1050 or 2741
	symdef	cct.3	syncronous etx cct
	symdef	cct.br
	symdef	chkaut	acu_tables come back to here
	symdef	maskr	restart point after masking channel
	rem
	symref	acutst
	symref	astart
	symref	ahang
	symref	tstart
	symref	ant202
	symref	gstar
	symref	bscstr
	symref	vstart
	symref	autost
	symref	a1star
	symref	a2star
	symref	a3star
	symref	s1star
	symref	s2star
	symref	s3star
	symref	pvstar
	symref	x25str
	symref	hdlstr
	symref	colts
	rem
	ind	begin1	/* 0, starting location of control tables */
	ind	devtbl	/* 1, ptr to array of device info tbls */
	dec	-1	/* 2, used to be ptr to cct array */
	ind	devtyp	/* 3, ptr to device type - speed table */
	ind	wru	/* 4, ptr to answerback reading code */
	bss	1	/* 5, reserve for delay tbl ptr*/
	ind	brk	/* 6, ptr to send line break code*/
	rem
	rem
	start	ctrl
	rem
	rem
	ttls	macro definitions
	eject
* * * * * * * * * * * * * * * * * * * * *
*
*	devtyp macro
*
* * * * * * * * * * * * * * * * * * * * *
	rem
devtyp	macro
	vfd	1/#1,4/0,o4/#2,o9/#3
	endm	devtyp
	rem
* * * * * * * * * * * * * * * * * * * * *
*
*	devtbl macro
*
* * * * * * * * * * * * * * * * * * * * *
	rem
devtbl	macro
	tab2	#1	sequence chars
	zero	#2	cct table addr
	zero	#3	keyboard addressing string array
	zero	#4	printer      "         "     "
	vfd	o18/#5	addressing flag and others
	tab6	#6	carriage movement table
	pmc	save,off
dk	set	0
	idrp	#7
	ife	dk,0,3
dk	set	1
dval	set	#7
	ife	1,2,4
dk	set	0
	pmc	restore
	vfd	o9/dval,o9/#7	break list
	pmc	save,off
	idrp
	pmc	restore
	ife	dk,1,1
	vfd	o9/dval,o9/0
	endm	devtbl
	rem
tab2	macro
	vfd	o9/#1,o9/#2
	endm	tab2
	rem
tab4	macro
	vfd	o9/#1,o9/#2
	vfd	o9/#3,o9/#4
	endm	tab4
	rem
tab6	macro
	vfd	o9/#1,o9/#2
	vfd	o9/#3,o9/#4
	vfd	o9/#5,o9/#6
	endm	tab6
	rem
* * * * * * * * * * * * * * * * * * * * *
*
*	adstr macro
*
* * * * * * * * * * * * * * * * * * * * *
	rem
adstr	macro
	pmc	save,off
adcnt	set	0
adk	set	0
	idrp	#1
	ife	adk,0,3
adk	set	1
adval	set	#1
	ife	1,2,4
adk	set	0
	pmc	restore
	vfd	o9/adval,o9/#1
	pmc	save,off
adcnt	set	adcnt+1
	idrp
adcnt	set	adcnt+1
adcnt	set	adcnt/2
adcnt	set	madlen-adcnt
	pmc	restore
	ife	adk,1,1
	vfd	o9/adval,o9/0
	bss	adcnt
	endm	adstr
	rem
	pmc	save,on
	tib
	meters
	buffer
	csbits
	tconst
	pmc	restore
	rem
	rem
inlshf	bool	155	/* ibm nl with uppercase bit */
	rem
	rem
	rem	scan control strings
	rem
	rem
iscn1	chstr	(rescan,search,ibmnl)
iscn2	chstr	(rescan,search,ibmeot)
iscn3	chstr	(rescan,search,inlshf)
iscn6	chstr	(rescan,search,eotshf)
	ttls	device info tables
devtbl	zero	d.asci	table for ascii devices
	zero	d.1050	table for 1050's
	zero	d.2741	table for 2741's
	zero	d.ards	table for the ards
	zero	d.sync	table for sync devices
	zero	d.sync	table for g115's
	zero	d.sync	table for bsc
	zero	d.t202	table for t202
	zero	d.vip	table for vip
	zero	d.asci	table for async1
	zero	d.asci	table for async2
	zero	d.asci	table for async3
	zero	d.sync	table for sync1
	zero	d.sync	table for sync2
	zero	d.sync	table for sync3
	zero	d.sync	table for polled vip
	zero	d.sync	table for X.25 LAP
	rem
	rem
	rem
	rem
	rem	devtbl flags
	rem
dtfctl	bool	1	default setting of tfctrl
dtfsft	bool	4	default setting of tfsftr
	rem
	rem	break list types
	rem
blt.s	bool	1	break on one char
blt.d	bool	2	break on two chars
blt.t	bool	3	break on three chars
blt.p1	bool	775	break on char plus one
	rem
	rem
d.asci	devtbl	(0,0),0,k.asci,p.asci,0,
	etc	(nl,cr,tab,bs,nochar,nochar),(blt.t,ff,nl,etx)
	rem
d.1050	devtbl	(0,0),0,k.1050,p.1050,dtfctl+dtfsft,
	etc	(ibmnl,nochar,ibmtab,ibmbs,ibmup,ibmdwn),
	etc	(blt.d,ibmnl,ibmeot)
	rem
d.2741	devtbl	(0,0),0,k.2741,p.2741,dtfctl+dtfsft,
	etc	(ibmnl,nochar,ibmtab,ibmbs,ibmup,ibmdwn),
	etc	(blt.d,ibmnl,ibmeot)
	rem
d.ards	devtbl	(0,0),0,0,0,0,(nl,cr,tab,bs,nochar,nochar),
	etc	(blt.d,ff,nl)
	rem
d.sync	devtbl	(101,102),0,0,0,0,
	etc	(nochar,nochar,nochar,nochar,nochar,nochar),
	etc	(blt.p1,etx)
	rem
d.t202	devtbl	(0,0),0,0,0,0,(nl,cr,tab,bs,nochar,nochar),
	etc	(blt.t,etx,ack,nak)
	rem
d.vip	devtbl	(0,0),0,0,0,0,
	etc	(nochar,nochar,nochar,nochar,nochar,nochar),
	etc	(blt.p1,etx)
	rem
	rem
madlen	equ	4	max addressing string length
	rem
k.asci	adstr	(1,ack)
	rem
p.asci	adstr	(1,nak)
	rem
k.1050	adstr	(4,ibmdwn,ibmeot,ibmsl,ibm0)
	rem
p.1050	adstr	(2,ibmsl,ibm9)
	rem
k.2741	adstr	(2,ibmdwn,ibmeot)
	rem
p.2741	adstr	(1,eoa)
	ttls	devtyp tables - device type/speed correspondence
	rem
	rem	Note: 2400 and 1800 synchronous are out of order for
	rem	compatibility with previous version that did not have
	rem	1200 and 1800
	rem
	rem	code      async speed         sync speed
	rem	----      ----- -----         ---- -----
	rem
	rem	01         75                  1200
	rem	02         110                 2400
	rem	03         134.5               1800
	rem	04         150                 4800
	rem	05         300                 5400
	rem	06         600                 7200
	rem	07         1050                9600
	rem	10         1200               19200
	rem	11         1800               40800
	rem	12         option             50000
	rem	13	 ----		72000
	rem
async	equ	1
sync	equ	0
	rem
devtyp	devtyp	async,02,ttasci	110 baud, ascii type
	devtyp	async,03,tt2741	133 baud, 2741/1050
	devtyp	async,04,ttasci	150 baud, ascii type
	devtyp	async,05,ttasci	300 baud, ascii type
	devtyp	async,06,ttasci	600 baud, ascii type
	devtyp	async,10,ttasci	1200 baud, ascii type
	devtyp	async,11,ttasci	1800 baud, ascii type
	devtyp	async,12,ttasci	optn baud, ascii type
	devtyp	sync,01,ttsync	1200 baud, sync type
	devtyp	sync,03,ttsync	1800 baud, sync type
	devtyp	sync,02,ttsync	2400 baud, sync type
	devtyp	sync,04,ttsync	4800 baud, sync type
	devtyp	sync,06,ttsync	7200 baud, sync type
	devtyp	sync,07,ttsync	9600 baud, sync type
	devtyp	sync,10,ttsync	19200 baud, sync type
	devtyp	sync,11,ttsync	40800 baud, sync type
	devtyp	sync,12,ttsync	50000 baud, sync type
	devtyp	sync,13,ttsync	72000 baud, sync type
	dec	-1	end of table
	ttls	cct's - control character tables
	rem
	pmc	save,on
	cctdef
	pmc	restore
	rem
	rem
	base	64
	rem
	rem
cct.2	null	* cct for ibm 2741 on hsla subchannel
	rem
	vfd	9/ct.ncs,9/ct.ncs * 000   001
	vfd	9/ct.ncs,9/ct.ncs * 002   003
	vfd	9/ct.ncs,9/ct.ncs * 004   005
	vfd	9/ct.ncs,9/ct.ncs * 006   007
	vfd	9/ct.ncs,9/ct.ncs * 010   011
	vfd	9/ct.ncs,9/ct.ncs * 012   013
	vfd	9/ct.ncs,9/ct.ncs * 014   015
	vfd	9/ct.ncs,9/ct.ncs * 016   017
	vfd	9/ct.ncs,9/ct.ncs * 020   021
	vfd	9/ct.ncs,9/ct.ncs * 022   023
	vfd	9/ct.ncs,9/ct.ncs * 024   025
	vfd	9/ct.ncs,9/ct.ncs * 026   027
	vfd	9/ct.ncs,9/ct.ncs * 030   031
	vfd	9/ct.ncs,9/ct.ncs * 032   033
	vfd	9/ct.ncs,9/ct.ncs * 034   035
	vfd	9/ct.ncs,9/ct.ncs * 036   037
	vfd	9/ct.ncs,9/ct.ncs * 040   041
	vfd	9/ct.ncs,9/ct.ncs * 042   043
	vfd	9/ct.ncs,9/ct.ncs * 044   045
	vfd	9/ct.ncs,9/ct.ncs * 046   047
	vfd	9/ct.ncs,9/ct.ncs * 050   051
	vfd	9/ct.ncs,9/ct.ncs * 052   053
	vfd	9/ct.ncs,9/ct.mrk * 054   nl
	vfd	9/ct.ncs,9/ct.ncs * 056   057
	vfd	9/ct.ncs,9/ct.ncs * 060   061
	vfd	9/ct.ncs,9/ct.ncs * 062   063
	vfd	9/ct.ncs,9/ct.ncs * 064   065
	vfd	9/ct.ncs,9/ct.ncs * 066   067
	vfd	9/ct.ncs,9/ct.ncs * 070   071
	vfd	9/ct.ncs,9/ct.ncs * 072   073
	vfd	9/ct.mrk,9/ct.ncs * eot   075
	vfd	9/ct.ncs,9/ct.ncs * 076   077
	rem
	vfd	9/ct.ncs,9/ct.ncs * 100   101
	vfd	9/ct.ncs,9/ct.ncs * 102   103
	vfd	9/ct.ncs,9/ct.ncs * 104   105
	vfd	9/ct.ncs,9/ct.ncs * 106   107
	vfd	9/ct.ncs,9/ct.ncs * 110   111
	vfd	9/ct.ncs,9/ct.ncs * 112   113
	vfd	9/ct.ncs,9/ct.ncs * 114   115
	vfd	9/ct.ncs,9/ct.ncs * 116   117
	vfd	9/ct.ncs,9/ct.ncs * 120   121
	vfd	9/ct.ncs,9/ct.ncs * 122   123
	vfd	9/ct.ncs,9/ct.ncs * 124   125
	vfd	9/ct.ncs,9/ct.ncs * 126   127
	vfd	9/ct.ncs,9/ct.ncs * 130   131
	vfd	9/ct.ncs,9/ct.ncs * 132   133
	vfd	9/ct.ncs,9/ct.ncs * 134   135
	vfd	9/ct.ncs,9/ct.ncs * 136   137
	vfd	9/ct.ncs,9/ct.ncs * 140   141
	vfd	9/ct.ncs,9/ct.ncs * 142   143
	vfd	9/ct.ncs,9/ct.ncs * 144   145
	vfd	9/ct.ncs,9/ct.ncs * 146   147
	vfd	9/ct.ncs,9/ct.ncs * 150   151
	vfd	9/ct.ncs,9/ct.ncs * 152   153
	vfd	9/ct.ncs,9/ct.mrk * 154   nl
	vfd	9/ct.ncs,9/ct.ncs * 156   157
	vfd	9/ct.ncs,9/ct.ncs * 160   161
	vfd	9/ct.ncs,9/ct.ncs * 162   163
	vfd	9/ct.ncs,9/ct.ncs * 164   165
	vfd	9/ct.ncs,9/ct.ncs * 166   167
	vfd	9/ct.ncs,9/ct.ncs * 170   171
	vfd	9/ct.ncs,9/ct.ncs * 172   173
	vfd	9/ct.mrk,9/ct.ncs * eot   175
	vfd	9/ct.ncs,9/ct.ncs * 176   177
	rem
cct.3	null	* cct for use with grts, terminate on etx + bcc
	rem
	vfd	9/ct.ncs,9/ct.ncs * 000   001
	vfd	9/ct.ncs,9/ct.grt * 002   etx
	vfd	9/ct.ncs,9/ct.ncs * 004   005
	vfd	9/ct.ncs,9/ct.ncs * 006   007
	vfd	9/ct.ncs,9/ct.ncs * 010   011
	vfd	9/ct.ncs,9/ct.ncs * 012   013
	vfd	9/ct.ncs,9/ct.ncs * 014   015
	vfd	9/ct.ncs,9/ct.ncs * 016   017
	vfd	9/ct.ncs,9/ct.ncs * 020   021
	vfd	9/ct.ncs,9/ct.ncs * 022   023
	vfd	9/ct.ncs,9/ct.ncs * 024   025
	vfd	9/ct.ign,9/ct.ncs * syn   027
	vfd	9/ct.ncs,9/ct.ncs * 030   031
	vfd	9/ct.ncs,9/ct.ncs * 032   033
	vfd	9/ct.ncs,9/ct.ncs * 034   035
	vfd	9/ct.ncs,9/ct.ncs * 036   037
	rem
	rem
	dup	1,48
	vfd	9/ct.ncs,9/ct.ncs
	rem
	rem
*	cct that breaks on all characters
*	used occosionally for 1050's and 2741's, and
*	externally by autobaud tables
	rem
cct.br	null
	dup	1,64
	vfd	9/ct.eol,9/ct.eol
	ttls	wait for dialup
tdhung	null		/* defined symbol for "hungup" t&d channel */
begin	tstglb	gbf6up,start	/* make sure 6180 is up before start */
begin1	wait	0,0,begin	/* wait for test state */
	rem
start	tstflg	tfauto,isauto	/* make all autobaud lines start ascii */
	goto	start1
isauto	setype	ttasci
	rem
start1	tstflg	tfhang,hangak	/* check for extra hangup */
	gotype	(norm,norm,norm,astart,norm,gstar,bscstr,tstart,vstart,a1
	etc	star,a2star,a3star,s1star,s2star,s3star,pvstar,x25str,hdl
	etc	str,colts) /* start up */
	rem
norm	tstflg	tfacu,acutst	/* check if auto call unit is to be started */
	tstflg	tflisn,listen	/* if told to listen do it */
restrt	clrflg	tfhang
maskr	wait	0,0,begin	/* wait till told to start again */
	rem
hangak	signal	hangup	/* acknowledge hangup orders, since */
	goto	restrt	/* host may depend on interrupt */
	rem
hungup	stpchn		/* hungup, stop and start over */
	contrl	rdtr	/* reset data term ready */
	setcct	scc.dl	/* get rid of any cct */
	setime	-500	/* make sure we leave dtr down for at least */
	wait	begin,0,hgtest	/* half a second */
	rem
hgtest	tstglb	gbf6up,h1test	/* fnp must be up, else false start */
	waitm		/* no go - return to wait loop */
	rem
h1test	iftype	ttx25l,x25str	/* x25 only aborts hangup timer */
	waitm		/* all others must wait */
	rem
listen	clrflg	tfhang	/* so as not to be caught later by an old hangup */
	contrl	sdtr+srts+stat	/* set dtr and wait for status */
	setime	0	/* turn off the timer */
	rem
	wait	0,0,tstlsn	/* and wait here */
	status	ring,cd+cts+dsr,waitcd /* ring, wait for cd */
	status	cd+cts+dsr,0,dialed /* all on, dialup */
	rem
waitcd	setime	20	/* wait 20 secs for cd */
	rem
	wait	nocd,0,tstlsn	/* if timeout, hangup on him */
	status	cd+cts+dsr,0,dialed
	rem
nocd	contrl	rdtr	/* nothing, hangup on him now */
	setime	5	/* wait 5 secs for this to happen */
	wait	hungup,0,0	/* go to hungup when done */
	rem
dialed	tstglb	gbf6up,godial	/* make sure we're supposed to accept calls */
	goto	hungup	/* we aren't */
godial	gotype	(chkaut,diftyp,diftyp,error,dialsy)
	rem
chkaut	setcct	scc.df	/* set default ascii cct */
	tstflg	tfauto,autost	/* do autobaud setting if needed */
	goto	signal
	rem
tstlsn	tstglb	gbf6up,tsthng	/* see if multics stopped accepting calls */
	goto	hungup	/* it did */
	eject
************************************************************************
*
*	perform test to determine if 1050 or 2741 terminal
*	the following code runs only on lsla's
*
************************************************************************
	rem
diftyp	ifhsla	difh01	/* special processing for hsla lines */
	dcwlst
	cmd	srec	/* enter receive mode for eoa */
	input	1,eoa	/* look for eoa from 2741 */
	cmd	smark	/* marker if recvd */
	rem
	setime	3	/* wait 3 seconds for eoa */
	rem
	wait	dt1050,0,0	/* timeout, is 1050 */
	status	marker,0,dt2741	/* yup, its a 2741 */
	rem
dt1050	setype	tt1050	/* set to 1050 */
	rem
	dcwlst		/* make sure is really 1050 */
	cmd	sbrk	/* send line break */
	setime	1	/* give line break half a second to take */
	wait	dt105a,0,0
dt105a	dcwlst
	cmd	rrec+sxmit	/* go into xmit mode */
	output	(ibmeot)	/* put 2741 into control-receive */
	cmd	srec+rxmit	/* go into recv */
	input	1,eoa	/* should respond with eoa */
	cmd	smark	/* send marker status */
	rem
	setime	3	/* wait 3 seconds for device */
	wait	signal,0,0	/* timeout, is really 1050 */
	status	marker,0,dt2741	/* got eoa, really 2741 */
	rem
dt2741	setype	tt2741	/* set to 2741 */
	goto	signal
	rem
************************************************************************
*
*	perform test to determine if 1050 or 2741 terminal
*	the following code runs only on hsla's
*
************************************************************************
	rem
difh01	setcct	cct.br	/* break on all characters */
	contrl	srec	/* set receive mode to wait for eoa */
	setime	3
	wait	difh02,0,0
	status	brkchr,0,difh03	/* got it, must be 2741 */
	rem
difh02	setype	tt1050	/* no eoa, probably 1050 */
	dcwlst		/* but try 2741 test once more */
	cmd	sbrk
	setime	1	/* give line break time to take */
	wait	difh2a,0,0
difh2a	dcwlst
	cmd	sxmit
	output	(ibmeot)
	cmd	rxmit
	setime	3
	wait	difh04,0,0	/* wait for eoa once more */
	rem
	status	brkchr,0,difh03	/* really 2741 */
	rem
difh03	setype	tt2741
difh04	setcct	cct.2	/* back to standard cct */
	goto	signal
	rem
************************************************************************
*
*	signal dialu to multics to say terminal is here
*
************************************************************************
	rem
dialsy	setcct	cct.3	/* cct for sync line */
	rem
signal	dmpout		/* throw away any leftover output from 6180 */
	dumpin		/* likewise any input left on the line */
	signal	dialup	/* tell multics about this line */
	rem
	goto	getwrk	/* start looking for work */
	ttls	wru - read the answer back for a line
************************************************************************
*
*	perform wru processing to read answerback
*	dia_man puts this address in t.cur to make us start here
*
************************************************************************
	rem
wru	wait	0,0,rdansb	/* test state here when answer back wanted */
	rem
rdansb	scntr	0
	rem
anslp	gotype	(rawru,ra1050,ra2741,error,error,error,error,ant202)
	rem
************************************************************************
*
*	ascii line
*
************************************************************************
	rem
rawru	stpchn		/* halt channel */
	dcwlst		/* dcw list to read answerback */
	cmd	sxmit	/* enter xmit mode */
	output	(awru)	/* send ascii wru char */
	cmd	rxmit+srec	/* go into receive mode */
	rem
	clrflg	tfkybd	/* clobbered keyboard */
	goto	answt	/* wait */
	rem
************************************************************************
*
*	1050 on lsla
*
************************************************************************
	rem
ra1050	stpchn		/* halt channel */
	ifhsla	rahs10	/* seperate code for hsla
	dcwlst		/* dcw list for 1050 answerback */
	cmd	sbrk	/* send line break */
	setime	1	/* give it time to happen */
	wait	ra105a,0,0
ra105a	dcwlst
	cmd	sxmit+rrec
	output	(adprtr)
	cmd	rxmit+srec	/* enter rec for ans */
	rdtly	1	/* read only one char */
	cmd	sxmit+rrec	/* finish addressing */
	output	(eoa)
	cmd	rxmit+sterm
	rem
	clrflg	tfkybd	/* no more keyboard */
	setflg	tfprtr	/* printer on now */
	goto	answt	/* wait */
	rem
************************************************************************
*
*	1050 on hsla
*
************************************************************************
	rem
rahs10	setcct	cct.br	/* break on all chars */
	dcwlst
	cmd	sbrk
	setime	1	/* give it time to happen */
	wait	rahs1a,0,0
rahs1a	dcwlst
	cmd	sxmit+srec
	output	(adprtr)
	cmd	rxmit
	setime	4
	wait	anstim,0,tsthng
	status	0,cts,hang2
	status	0,cd,hang2
	status	brkchr,0,rahs30	/* got reply */
	rem
rahs30	dcwlst	sxmit+rrec
	output	(eoa)
	cmd	rxmit+sterm
	wait	anstim,0,tsthng
	status	0,cd,hang2
	status	0,cts,hang2
	status	term,0,rahs40
rahs40	setflg	tfprtr
	clrflg	tfkybd
	setcct	cct.2
	goto	ansend
	rem
************************************************************************
*
*	2741 line
*
************************************************************************
	rem
ra2741	stpchn		/* halt channel */
	setcct	cct.2	/* should be this if hsla */
	dcwlst
	cmd	sbrk	/* line break */
	setime	1
	wait	ra274a,0,0
ra274a	dcwlst
	cmd	sxmit+rrec
	output	(eoa,ibmprf,ibmpls,ibmeot)
	cmd	rxmit+srec
	rem
	clrflg	tfkybd
	goto	answt	/* wait */
	rem
************************************************************************
*
*	common answerback code
*
************************************************************************
	rem
answt	setime	4	/* wait four seconds for response */
	rem
	wait	anstim,0,0	/* retry on timeout */
	status	0,cts,hang2
	status	0,cd,hangb
	status	brkchr,0,ansend	/* got it */
	status	term,0,ansend	/* also */
	eject
ansend	sendin		/* ship it */
	goto	getwrk	/* continue real stuff */
	rem
anstim	acntr	1	/* bump counter */
	tcntr	3,ansnot	/* too much, punt */
	rem
	goto	anslp	/* loop for more */
	rem
ansnot	signal	wrutim	/* tell as_ that there is no answer back */
	stpchn		/* throw away any funny input */
	dumpin
	iftype	tt1050,ansnt2	/* must reset cct on hsla 1050 */
	goto	getwrk
ansnt2	setcct	cct.2
	goto	getwrk
	ttls	brk - send line break to the terminal
************************************************************************
*
*	send line break at users request
*	dia_man puts this address in t.cur to make us start here
*
************************************************************************
	rem
brk	wait	0,0,brkst	/*test state here when send break wanted*/
	rem
brkst	scntr	0
	rem
	stpchn		/* kill user channel */
	dumpin		/* throw away input */
	setime	-100	/* wait for 100mils */
	contrl	sbrk
	wait	brkout,0,0
	status	0,cts,hang2
	status	0,cd,hangb
	status	break,0,brkout
brkout	setcct	scc.bs	/* back to base cct, in case */
	clrflg	tffip	/* turn off frame in progress */
	tstflg	tfquit,writnl	/* print new-line if asked to */
	clrflg	(tfprtr,tfkybd)	/* nothing is addressed now */
	goto	getwrk	/* no newline, go read more */
	ttls	reading part of control tables
************************************************************************
*
*	start of real work of control_tables. if there is output
*	to do, go do it, otherwise setup to read.
*
************************************************************************
	rem
getwrk	clrflg	(tfwabt,tfrabt)	/* clear in case we just did one */
	tstwrt	write	/* if any writing, do it */
	tstflg	tfhang,hanga	/* if we are to hangup, do it */
	tstflg	tfctrl,ckkybd	/* if control mode, check kybd */
	goto	read	/* go directly to it */
	rem
************************************************************************
*
*	starting input on a device that requires keyboard
*	addressing. do it here.
*
************************************************************************
	rem
ckkybd	tstflg	tfkybd,read	/* if kybd addressed, read */
	clrflg	tfprtr	/* we are about to kill prtr */
	rem
	gotype	(kbasci,kb1050,kb2741,error,read)
	rem
kbasci	dcwlst		/* dcwlst to address kybd */
	cmd	rrec+sxmit	/* set xmit mode */
	output	(adkybd)	/* send ack to tty37 */
	cmd	srec+rxmit+smark /* marker when done */
	rem
	goto	kybdwt	/* go to wait block */
	rem
kb1050	null
kb2741	ifhsla	kbhs01	/* special processing for hsla lines */
	dcwlst		/* same basic stuff 1050/2741 */
	cmd	sxmit+rrec	/* set xmit mode */
	output	(adkybd)	/* 1050 = lc, eot, /, 0 */
	rem		/* 2741 = lc, eot */
	cmd	srec+rxmit	/* set recv to get eoa */
	input	1,eoa	/* read 1 look for eoa */
	cmd	smark	/* send marker */
	rem
	clrflg	tfupsf	/* we have sent low shift to device */
	goto 	kybdwt	/* wait for marker */
	rem
kbhs01	setcct	cct.br	/* break on all characters */
	dcwlst	
	cmd	sxmit+srec
	output	(adkybd)
	cmd	rxmit
	setime	3
	wait	kbhs03,0,tsthng	/* wait for addressing to complete */
	status	0,cd,hang2
	status	break,0,kbhs04	/* user hit quit */
	status	brkchr,0,kbhs02	/* break char, kybd addressed */
	rem
kbhs04	setcct	cct.2	/* back to standard cct */
	goto	otquit
kbhs02	setcct	cct.2
	clrflg	tfupsf
	dumpin
	goto	kybdon
kbhs03	setcct	cct.2
	goto	kybdto
	rem
kybdwt	setime	3	/* wait 3 secs for keyboard */
	rem
	wait	kybdto,0,0	/* wait for kybd to be addressed */
	status	0,cd,hangb	/* no cd, maybe hangup */
	status	break,0,otquit	/* quit, tell 6180 */
	status	marker,0,kybdon	/* done addressing */
	rem
kybdon	setflg	tfkybd	/* kybd on, set flag */
	tstwrt	write	/* if we are to write do it */
	goto	rwait	/* go to read wait */
	rem
kybdto	contrl	rrec+rxmit+smark /* time out, stop and give up */
	wait	0,0,tstdmp
	status	0,cd,hangb
	status	marker,0,getwrk
	rem
************************************************************************
*
*	keyboard  addressing not required,  just set  rcv mode
*
************************************************************************
	rem
read	contrl	srec+rxmit	/* setup regular read */
	rem
************************************************************************
*
*	in receive mode now, wait for something to happen
*
************************************************************************
	rem
rwait	setime	0	/* turn off the timer */
	rem
	wait	0,rabort,tstrbp /* wait here for something */
	status	0,cd,hangb
	status	parity,0,sndchk	/* watch for parity errors */
	status	break,0,inquit
	status	brkchr,0,ckdata	/* check for eot 2741 */
	status	exh,0,inexh	/* too much input */
	status	xte,0,inxte	/* input too fast */
	status	prexh,0,preshp
	rem
************************************************************************
*
*	got input data - break character status
*
************************************************************************
	rem
ckdata	tstflg	tfrabt,dmpin	/* are we supposed to throw it away? */
	gotype	(sndata,sndata,ck2741,error,sndata)
	rem
preshp	meter2	m.prex,1
	sendin		/* just send data on pre-exaust */
	waitm
	rem
************************************************************************
*
*	input is from 2741. special processing required for eots
*
************************************************************************
	rem
ck2741	inscan	iscn1,ckupnl	/* see if it looks like uppercase nl */
	setflg	tfeotx	/* got the nl, eot is next */
	goto	sndata	/* ship the data now */
	rem
ckupnl	inscan	iscn3,ckeot	/* not an nl, see if it's eot */
	setflg	tfeotx	/* eot would be appropriate now */
	goto	sndata	/* pretend uppercase NL is lowercase NL */

ckeot	inscan	iscn2,upeot	/* might be shifted eot */
	goto	goteot	/* all right, we have eot */
upeot	inscan	iscn6,sndata	/* non-standard break, just send input */
	rem
goteot	tstflg	tfeotx,ckfin	/* got the eot, fix kybd */
	clrflg	tfkybd	/* however his keyboard is still unaddressed */
	goto	inquit	/* not expected, must be quit */
	rem
ckfin	clrflg	tfeotx	/* got it, turn of expected flag */
	stpchn		/* stop the channel */
	dumpin		/* throw away the eot */
	goto	kb2741	/* unlock his keyboard */
	rem
************************************************************************
*
*	have real data to send to multics
*
************************************************************************
	rem
sndata	sendin		/* send data to 6180 */
	tstwrt	getwrk	/* make sure no write to be done */
	goto	rwait	/* wait for more input */
	rem
************************************************************************
*
*	parity error. this is ignored except for sync line type
*
************************************************************************
	rem
sndchk	meter1	m.par,1
	iftype	ttsync,sndstp	/* if line sync type, stop channel */
	goto	sndata	/* else send data in to multics */
	rem
sndstp	stpchn		/* stop reciever (resync) */
	sendin		/* ship stuff anyway */
	goto	getwrk	/* look for other processing */
	rem
************************************************************************
*
*	come here when too much input, or input too fast
*
************************************************************************
	rem
inxte	meter1	m.xte,1
	goto	holdup
	rem
inexh	meter2	m.exh,1
holdup	stpchn		/* kill users channel */
	sendin		/* ship off any input */
	meter1	m.quit,1	/* count 'bell-quits' */
	gotype	(holdac,holdwt,holdwt,error,holdwt)
holdac	scntr	0	/* zero a bell counter */
holdbl	dcwlst		/* warn  user of problems  with  bells */
	cmd	sxmit
	output	(bel)
	cmd	rxmit+sterm
	wait	0,0,tstrbt	/* wait for  bells to finish */
	status	0,cd,hangb
	status	break,0,otquit
	status	term,0,holdlp
	rem
holdlp	acntr	1	/* count bells */
	tcntr	3,holdwt	/* done */
	setime	-150	/* scientifically determined optimal bell delay */
	wait	holdbl,0,tstrbt
	status	0,cd,hangb
	status	break,0,inquit
	rem
holdwt	setime	10	/* give user 10 seconds to quit */
	contrl	sbrk
	wait	inquit,0,tstrbt
	status	0,cd,hangb
	status	break,0,inquit
	ttls	utility functions
rabort	null		/* come here when output arrives */
	ckinpt	getwrk	/* check for input, none goto getwrk */
	tstflg	tfplit,raplit	/* polite mode? */
	goto	getwrk	/* no, process normally */
	rem
raplit	setime	30	/* partial input, wait for it to complete */
	wait	pltout,0,tsthng
	status	0,cd,hangb
	status	parity,0,sndchk	/* watch for parity errors */
	status	break,0,otquit
	status	brkchr,0,ckdata	/* check for eot 2741 */
	status	exh,0,inexh
	status	xte,0,inxte
	status	prexh,0,preshp
	rem
pltout	null		/* we have waited long enough, process output */
	tstflg	tfrabt,tstecp	/* are we supposed to throw away accumulated input? */
	goto	getwrk	/* no, proceed */
	rem
tstdmp	tstflg	tfwabt,dump	/* test for dump output */
	goto	tsthng	/* no, check for hangup */
	waitm
	rem
tstrbp	tstflg	tfrabt,tstplt	/* dump input? */
	goto	tsthng	/* no, check for hangup */
	rem
tstrbt	tstflg	tfrabt,tstecp	/* check for read abort */
tsthng	tstflg	tfhang,hanga	/* hang it up */
twaitm	waitm
	rem
tstplt	ckinpt	getwrk	/* there isn't anything to throw away */
	tstflg	tfplit,twaitm	/* if being polite, dump it later */
tstecp	tstflg	tfecpx,echoat	/* are we in echoplex? */
	goto	dmpin	/* no, just dump it */
	rem
echoat	ckinpt	getwrk	/* no accumulated input, forget it */
	echo	atchar	/* put at sign in echo buffer */
	rem
dmpin	stpchn		/* stop the channel */
	dumpin		/* throw away read chain */
	dmprpy		/* dump any accumulated replay */
	goto	getwrk
	rem
dump	stpchn		/* stop channel */
	dmpout		/* dump the output */
	goto	getwrk
	rem
inquit	stpchn		/* stop the input for now */
	setcct	scc.bs	/* back to base cct, in case */
	clrflg	tffip	/* turn off frame in progress */
	sendin		/* send any input to 6180 */
	signal	quit	/* tell 6180 */

***************************************************************************
*
*	Throw away rapid breaks to prevent over-run.
*	Here we require a .25 second gap between observable breaks to
*	prevent too many breaks and send_outputs caused by a terminal
*	set at too low a line speed.
*
*	This is done by waiting .25 seconds before continuing break
*	processing.  If another break occurs within this period, it is
*	ignored and any stored up input is dumped, to prevent buffer
*	over-commitment.
*
*	We will get out of it, either if mcs sends us stuff, or the line
*	is hung up (cd drops).
*
***************************************************************************

iqthld	setime	-250	/* wait 1/4 second for break timeout
	wait	iqtcon,iqtcon,tsthng  /* timeout or mcs output - continue
*                                            control order - obey hangup
	status	0,cd,hangb	/* carrier drop loses the line
	status	break,0,iqtbrk	/* continued break

iqtbrk	dumpin                        /* lose the input accumulated input
          dmprpy                        /* dump accumulated replay
          goto iqthld                   /* continue break

iqtcon	tstflg	tfquit,writnl	/* print new-line if asked to */
	clrflg	(tfprtr,tfkybd)	/* nothing is addressed now */
	goto	getwrk	/* no newline, go read more */
	rem
otquit	stpchn		/* stop the input for now */
	setcct	scc.bs	/* back to base cct */
	clrflg	tffip	/* turn off frame in progress */
	sendin		/* ship any input */
	setfld	t.omct,0	/* treat like block acknowledgement */
	signal	quit	/* tell 6180 */

*****************************************************************************
*
*	Same break processing as for input, for same reasons.
*
****************************************************************************

oqthld	setime	-250
	wait	oqtcon,oqtcon,tsthng
	status	0,cd,hangb
	status	break,0,oqtbrk

oqtbrk	dumpin
	dmprpy
	goto	oqthld

oqtcon	tstflg	tfquit,qdump	/* dump and print nl ? */
	clrflg	(tfprtr,tfkybd)	/* we'll have to re-address */
	goto	getwrk	/* go look for work to be done */
	rem
qdump	dmpout		/* throw away the output chain */
writnl	prepnl		/* setup new-line for output */
	scntr	-10	/* flag meaning printing new-line after quit */
	goto	write2
	rem
error	punt	1	/* ards error */
	ttls	writing part of tables
write	tstflg	tfpfnl,write3	/* see if in prefixnl mode */
	goto	write1	/* no, dont prepnl check */
write3	ckinpt	write1	/* check to see if input snuck in */
	prepnl		/* it did, setup to write newline */
write1	scntr	0	/* flag meaning not doing nl after quit */
write2	tstflg	tfctrl,ckprtr	/* if we need to address ptr */
	goto	print	/* nope, go and print */
	rem
ckprtr	tstflg	tfprtr,print	/* if we need to address ptr */
	clrflg	tfkybd	/* yes, clear kybd */
	rem
	gotype	(ptasci,pt1050,pt2741,error,print)
	rem
ptasci	dcwlst		/* dcw list to address prtr */
	cmd	sxmit+rrec	/* go to xmit mode */
	output	(adprtr)	/* send prtr addr string, nak for 37 */
	cmd	smark	/* send marker when done */
	output	(outmsg)	/* send the data */
	cmd	sterm+rxmit	/* and terminate when finished */
	rem
	goto	prtrwt	/* go wait for addressing */
	rem
pt1050	dcwlst		/* dcw list for 1050 adressing */
	cmd	sbrk	/* send a line break */
	setime	1	/* have to let it happen */
	wait	pt105a,0,0
pt105a	dcwlst
	cmd	sxmit+rrec	/* go to transmit mode */
	output	(adprtr)	/* address 1050 prtr, with /9 */
	cmd	srec+rxmit	/* enter receive mode */
	input	1,null	/* read one char */
	cmd	sxmit+rrec	/* enter transmit mode again */
	output	(eoa)	/* send eoa char */
	cmd	smark	/* send marker status when done */
	output	(outmsg)	/* now, send the guys data */
	cmd	sterm+rxmit	/* and terminate when done */
	rem
	goto	prtrwt	/* wait for addressing to finish */
	rem
pt2741	dcwlst		/* address 2741 printer */
	cmd	sbrk	/* send a line break */
	setime	1	/* give it time */
	wait	pt274a,0,0
pt274a	dcwlst
	cmd	sxmit+rrec	/* enter transmit mode */
	output	(adprtr)	/* address printer now with eoa */
	cmd	smark	/* send marker when done addressing */
	output	(outmsg)	/* send the data */
	cmd	sterm+rxmit	/* send term when done outout */
	rem
	clrflg	tfeotx	/* clear eot expected flag */
	goto	prtrwt
	rem
prtrwt	setime	5	/* wait 5 secs for addressing */
	rem
	wait	prtrto,0,tsthng	/* if timeout, punt */
	status	0,cd,hangb
	status	marker,0,prtron	/* printer is addressed now */
	status	break,0,otquit	/* quit? */
	rem
prtrto	stpchn		/* timed out waiting for printer addressing */
	contrl	stat	/* make sure no hangup during stpchn */
	setime	-150
	wait	prttim,0,tstdmp
	status	0,cd,hangb
	rem
prttim	tstflg	tfwabt,dump
	tstwrt	write1	/* real timeout, try again */
	goto	getwrk
	rem
prtron	setflg	tfprtr	/* printer on now */
	tcntr	-10,wwait	/* ignore write-abort on nl after quit */
	tstflg	tfwabt,dump	/* were we asked to punt */
	goto	wwait	/* no, wait for write to finish */
	rem
print	tstflg	tffdpx,printf	/* full dpx, dont reset rec */
	tstflg	tfecpx,printf	/* likewise for echoplex */
	rem
	dcwlst		/* start output on device wo addressing */
	cmd	sxmit+rrec	/* enter xmit mode and reset rec */
	output	(outmsg)	/* put in the data */
	cmd	sterm+rxmit	/* and terminate */
	rem
	goto	wwait	/* wait for terminate */
	rem
printf	tstflg	(tfblak,tfofc),chkeob /* check for block acknowledgement */
sprint	dcwlst		/* full dpx write */
	cmd	sxmit+srec	/* enter xmit mode */
	output	(outmsg)
	cmd	sterm+rxmit	/* term when done */
	rem
wwait	tstflg	tfrpon,wwait1	/* replay already started? */
	tstflg	tfrply,prplay	/* no, should we start one? */
	goto	wwait1	/* no, go wait */
	rem
prplay	ckinpt	wwait1	/* check for any input */
	setflg	tfrpon	/* set replay in progress flag */
	gtinpt		/* scoop up current input */
	rem
wwait1	setime	0	/* turn off the timer */
	rem
	wait	0,0,wtest	/* wait for status or dump */
	status	0,cd,hangb
	status	brkchr,0,wsend	/* send data input during full dpx */
	status	exh,0,wexh	/* stop the receiver now */
	status	break,0,otquit	/* quit? */
	status	term,0,wterm	/* all done */
	rem
wterm	tstflg	tfrabt,tstecp	/* see if there was a resetread */
	tstwrt	getwrk	/* if any to do, do it */
	tstflg	tfrpon,wdrply	/* replay ready, do it */
	tstflg	tfplit,wdplit	/* check polite write term */
	goto	getwrk	/* all ok */
	rem
wdrply	tstrpy	wdrpdn	/* if no replay chain goto wdrpdn */
	setime	1	/* wait 1 second for all output */
	wait	wdrpto,write1,tstrbt
	status	0,cd,hangb
	status	brkchr,0,wsend	/* send data input during full dpx */
	status	exh,0,wexh	/* stop the receiver now */
	status	break,0,otquit	/* quit? */
	rem
wdrpto	replay		/* make the saved input an output chain */
	goto	write1	/* put out those chars now */
	rem
wdrpdn	clrflg	tfrpon	/* done now, clear flag */
	goto	getwrk	/* all done replaying */
	rem
wdplit	ckinpt	getwrk	/* had we just been polite to him? */
	setime	1	/* yes, wait for more output */
	wait	wdplto,write1,tsthng
	status	0,cd,hangb
	status	brkchr,0,wsend	/* send data input during full dpx */
	status	exh,0,wexh	/* stop the receiver now */
	status	break,0,otquit	/* quit? */
	rem
wdplto	goto	getwrk	/* ok, we have waited for all output */
	rem
wsend	tstflg	tfrabt,wtstec	/* see if we were told to throw it away */
	sendin		/* no, ship the data */
	waitm		/* and wait some more */
	rem
wtstec	tstflg	tfecpx,wdecho	/* echoplex? */
	goto	wdmpin	/* no, just dump it */
	rem
wdecho	echo	atchar	/* put at sign in echo buffer */
wdmpin	dumpin		/* throw away input */
	dmprpy		/* dump any accumulated replay */
	waitm		/* keep waiting */
	rem
wexh	meter2	m.exh,1
	contrl	rrec	/* stop the input now */
	goto	wsend	/* ship it and wait more */
	rem
wtest	tcntr	-10,wtestm	/* doning newline after quit */
	tstflg	tfwabt,dump	/* dump_output, do it */
wtestm	clrflg	tfwabt
	waitm		/* but don't perform hangup till output finishes */
	rem
chkeob	tstfld	t.omct,2,waitak	/* more than two blocks outstanding? */
	goto	sprint	/* proceed with output */
	rem
waitak	contrl	srec	/* we have to be able to see ack char */
	wait	0,0,tstack	/* here to suspend output until ack */
	status	0,cd,hangb	/* likewise */
	status	brkchr,0,wsend	/* forward input anyway */
	status	exh,0,wexh	/* always handle exhaust */
	status	break,0,otquit	/* likewise quit */
	rem
tstack	tstfld	t.omct,2,wtest	/* wasn't ack, look for other things */
	goto	sprint	/* was ack, resume output */
	ttls	check and perform hangups
	rem	come here when told to hangup line
	rem
hanga	stpchn		/* stop the channel */
	tstwrt	write	/* make sure there is no output now */
	setime	1	/* wait to make sure there's no more output */
	rem
	wait	hanga1,getwrk,0	/* if timeout, time to hang up */
	status	0,cts,hang3	/* line is hung up anyway */
	status	0,cd,hang3	/* likewise */
	rem
hanga1	gotype	(hang5,hang5,hang5,ahang,hang3)
	rem
	rem
	rem
	rem	come here when cts drops on a line
	rem
hang2	gotype	(hang5,hang5,hang5,hang5,hang10)
	rem
hang5	contrl	rxmit+rrec+rdtr+stat /* hangup and request status */
	rem
hangwt	setime	5	/* wait 5 seconds for it to happen */
	rem
	wait	hang3,0,0	/* if timeout, give up on him */
	status	0,cts,hang3	/* still down, done */
	rem
hang3	stpchn		/* stop channel again */
	dmpout		/* throw away output */
	signal	hangup	/* did it, tell 6180 */
	clrflg	(tflisn,tfhang)	/* clear the listen and hangup flags */
	goto	hungup
	rem
	rem
	rem
	rem	here when cd drops on a line
	rem
hangb	setime	1	/* wait one sec for carrier */
	rem
	wait	hang4,0,0	/* if timeout, check somemore */
	status	0,cts,hang2	/* if cts has dropped now, hangup */
	rem
hang4	contrl	rxmit+rrec+stat	/* get status of line */
	setime	5	/* wait 5 seconds */
	rem
	wait	hang4,0,0	/* if timeout, try to get status again */
	status	0,cts,hang2	/* cts down, hangup */
	status	0,cd,hang2	/* cd down still, giveup */
	status	cd+cts+dsr,0,hangqt /* back up, call it quit */
	rem
hangqt	gotype	(hang6,hang6,hang6,hang6,hang11)
	rem
hang6	sendin		/* send any input to 6180 */
	signal	quit	/* tell 6180 of quit */
	goto	dump	/* dump any output, what else can I do */
	rem
	rem	here when cd or cts drop on private sync lines
	rem
hang10	contrl	rxmit+rrec+stat	/* get line status */
	setime	10	/* wait 10 seconds for return */
	rem
	wait	hang10,0,tsthng
	status	cd+cts+dsr,0,hang11
	rem
hang11	goto	getwrk
	rem
	rem
	rem
*	the following is a control table subroutine to stop a channel
*	it is called by the stpchn macro from all control tables.
	rem
stpchn	contrl	rrec+rxmit+smark
	setime	1	/* if it doesn't come through in a second */
	wait	stptmo,0,0	/* try again */
	status	marker,0,stpch2
stpch2	retsub
	rem
stptmo	addlcl	stptmc,1	/* timed out, keep count */
	goto	stpchn	/* try it again */
stptmc	oct	0
	rem
	end
   



		    dia_man.map355                  01/12/87  1321.1r   01/12/87  1314.0     1112022


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* * Copyright (c) 1972 by Massachusetts Institute of        *
* * Technology and Honeywell Information Systems, Inc.      *
* *                                                         *
* ***********************************************************

	ttl	multics/fnp direct interface adapter -- dia_man
	lbl	,dia_man
	pmc	off
	pcc	on
	editp	on
	rem
*************************************************************
*
*  note:  cs means "central system"
*
*************************************************************
*
*		dia_man contains the code to control the direct interface
*		adapter (dia) in order to handle communications between
*		the fnp and multics. all such communications are transmitted
*		by means of "mailboxes" of eight (36-bit) words each
*		which are supplied by the cs.
*
*		dia activity is triggered by:
*			1) entries in the dia i/o request queues
*			   (placed there by the denq entry)
*
*			2) interrupts from the cs indicating that
*			   a mailbox is to be transmitted to the fnp
*
*		the two basic scenarios are as follows
*
*		1) fnp-initiated i/o
*
*		entry is placed in request queue by denq
*		(one queue for each line)
*		dgetwk (which is scheduled at completion of i/o cycle)
*		finds entry and builds large mailbox which it writes
*		into cs memory
*		cs responds either by "freeing" the mailbox
*		(interrupt level 12-15) or by rewriting it with new
*		information (interrupt level 8-11), in either case
*		causing an entry to be added to the mailbox queue;
*		dia_man reads the mailbox as described below, interprets
*		it and marks it free
*		queue entries are freed immediately upon sending of the mailbox
*		except in the case of input operations, which are freed
*		when the input has been accepted
*
*		2) cs-initiated i/o
*
*		cs sends interrupt to add entry to mailbox queue
*		when dgetwk finds mailbox queue non-empty, it calls
*		rdmbx to read the mailbox in from the cs
*		dia_man does whatever is indicated by the contents of the
*		mailbox, and when finished either writes a modified copy
*		of the mailbox back to the cs or just informs the cs
*		that the mailbox is free
*
*
*		during such a cycle as described above, a global
*		lock (the "dia lock") is locked so that there is no attempt
*		to process more than one mailbox at a time
*
*		a "transaction control word" is used to indicate the
*		current state of the dia i/o cycle in progress
*
*		two interrupt handlers are used:
*		dterm handles the interrupt that comes in at the com-
*		pletion of each i/o operation and schedules
*		the transaction processor (dtrans) to deal with the
*		results of the i/o
*
*		dmail handles the "mailbox ready" interrupt from the
*		cs and adds an entry to the mailbox queue
*
*		except when copying output buffers from the cs,
*		dcws for dia i/o are built starting at location "dcws"
*		in the "conect" subroutine
*
*		the address and length of the current dcw list are
*		also kept in "conect" so that if necessary the most
*		recent i/o can simply be restarted by calling conect
*		again
*
*
*		labelling conventions:
*
*		literals have names of the form l.xnnn
*		where "x" is a letter that varies from subroutine
*		to subroutine and "nnn" is a 3-digit number that starts
*		over for each new value of "x"
*
*		address constants have names of the form a.xnnn
*		where "x" and "nnn" are as above
*
*
*		coded August 1974 by Robert S. Coren
*		modified December 1975 by Jay Goldman
*		modified November 1978 by robert coren for fnp-initiated
*		   mailboxes.
*		modified 4th of July, 1979 by Bernard Greenberg
*		   for FNP echo negotiation
*		modified 1979 may by art beattie to support dn6670
*		   extended memory.
*		modified September 1984 by Robert Coren to zero block
*		   count when turning off oflow and to call hmode when
*		   setting flow control characters.
*		modified April 1985 by Robert Coren to include tfabf0
*		   and tfabf1 in "permanent" t.flg3 flags
*
*************************************************************
	
* HISTORY COMMENTS:
*  1) change(86-04-23,Coren), approve(86-04-23,MCR7300),
*     audit(86-05-19,Beattie), install(86-07-08,MR12.0-1089):
*     Modified November 1984 by Robert Coren to read echo negotiation break
*     table from CS.
*                                                      END HISTORY COMMENTS

	eject
	symdef	dia
	symdef	dterm
	symdef	dmail
	symdef	denq
	symdef	dindcw
	symdef	dicell
	symdef	dmbx
	symdef	derrq
	symdef	diajt
	symdef	dlist
	symdef	diconf
	symdef	ecgifl
	symdef	lctlck
	symdef	diasel	'sel' instruction in conect subroutine
	rem
	symref	mdisp
	symref	secdsp
	symref	dspqur
	symref	g3wjt
	symref	getbuf
	symref	getbfh
	symref	frebuf
	symref	frebfh
	symref	frelbf
	symref	getmem
	symref	fremem
	symref	gettib
	symref	globsw
	symref	iwrite
	symref	itest
	symref	loutav,houtav
	symref	invp
	symref	hmode
	symref	trace
	symref	ctrl
	symref	brkptr
	symref	shrcct	hsla_man subr to release cct
	symref	setptw	set page table word
	symref	setbpt	set buffer page table word
	symref	cvabs	convert buffer address to absolute
	symref	mvpgsc	move data paging source
	symref	mvpgtg	move data paging target
	symref	hcfg	hsla reconfigure subroutine
	symref	hunmsk	unmask subchannel
	symref	mincs
	symref	mincd
	symref	mupdat
	rem
	ttls	m a c r o s
	rem
jumptb	macro
	idrp	#1
jmps#1	zero
	tsy	ivp-*,*
	vfd	4/0,7/#1,1/0,6/mbxmod
	idrp
	endm
	rem
	rem
	rem
	rem
mpy	macro	(multiplier location-*)
	mpf	#1
	lrl	1
	endm
	rem
	rem
dvd	macro	(divisor location-*)
	qls	1
	dvf	#1
	endm
	rem
	pmc	save,on
	systm
	rem
	comreg
	rem
	tib
	rem
	sfcm	hsla
	rem
	meters
	rem
	devtab
	rem
	dlytbl
	rem
	buffer
	rem
	global
	rem
	hslatb
	rem
	csbits
	rem
	ttls	dia mailbox opcodes
	diaop
	rem
	alterp
	rem
	ttls	symbol definitions
	rem
	rem	transaction control word states
	rem
tcfrst	equ	0	first interrupt of session
tcdcwl	equ	1	dcw list was read
tcdata	equ	2	data was read
tcmbxr	equ	3	mailbox was read
tcwrd	equ	4	wrote data to cs
tcblst	equ	5	blast message was read
tcpchm	equ	6	reading data for patch_fnp order
tcdmpm	equ	7	writing data for dump_fnp order
tcinmb	equ	8	sent input in a mailbox
tcmetr	equ	9	sent metering information
tcrecn	equ	10	echo neg. table was read
tcreq	equ	11	sent mailbox request count
tcfree	equ	12	freed mailbox
tcwmbx	equ	13	wrote mailbox to cs
	rem
tcmax	equ	14	maximum value of tcword + 1
maxbuf	equ	20	maximum number of cs buffers
	rem
	rem
	rem	dia opcodes
	rem
diatrg	bool	65	transfer gate from cs to fnp
diadis	bool	70	disconnect
diainf	bool	71	interrupt fnp
diajmp	bool	72	jump
diainc	bool	73	interrupt cs
diardc	bool	74	read configuration switches
diaftc	bool	75	data transfer from fnp to cs
diactf	bool	76	 "      "      "   cs to fnp
diawrp	bool	77	wraparound
	rem
	rem
	rem
ntflsn	bool	/tflisn	for turning off listen flag
ntfacu	bool	/tfacu	for turning off acu flag
lnmask	bool	000700	lsla/hsla number in line number
submsk	bool	000077	subchannel number in line number
hslafl	bool	001000	hsla bit in line number
retry	bool	400000	flag for retrying i/o request
rejflg	bool	200000	flag indicating i/o request has been rejected
quitfl	bool	100000	flag indicating a quit or hangup is in queue
nretry	bool	/retry*/rejflg
ntfwrt	bool	/tfwrit
fatal	bool	777640	bits in status word indicating unrecoverable
	rem		error
maxerr	equ	5	maximum number of consecutive dia errors
maxcke	equ	2	maximum number of consecutive checksum errors
maxchn	equ	24	max number of buffers sent to cs by 1 dcw list
	rem
eb.tly	equ	2	position in echo buffer of tally (upper 9 bits)
	rem
qtib	equ	0	offset from tib entry of tib address
qbuf	equ	1	offset from tib entry of buffer address
	rem
dtprty	equ	0	priority for dtrans
gtprty	equ	1	priority for dgetwk
rtprty	equ	gtprty	priority for dretry
	rem
	rem
mqmask	bool	17	mask for mailbox queue address
mnmask	bool	37	mask for mailbox number in 3rd word
	rem		of jump table
	rem
	rem
	rem	parity for dcws
	rem
pupper	bool	040000	parity bit for bits 0-17
plower	bool	020000	parity bit for bits 18-35
npbits	bool	/pupper*/plower	both bits off
	rem
absflg	bool	400000	flag to indicate absolute addressing
	rem
	rem
	rem	cs mailbox header format
	rem	(36-bit offsets)
	rem
mh.pcw	equ	0	peripheral control word
mh.cnt	equ	mh.pcw+1	mailbox request count
mh.tim	equ	mh.cnt+1	terminate interrupt multiplex word (timw)
mh.oct	equ	mh.tim+1	old request count
mh.sub	equ	mh.pcw+8	submailbox area
mh.fsb	equ	mh.sub+64	start of FNP-controlled submailboxes
	rem
	rem
	rem	cs submailbox
	rem	(18-bit offsets)
	rem
sm.lno	equ	0	line number and fnp number
sm.fre	equ	sm.lno+1	number of free FNP buffers
sm.cdl	equ	sm.fre+1	command data length (in 6-bit chars)
sm.op	equ	sm.cdl+1	opcode and i/o command
sm.cd	equ	sm.op+1	command data (6 18-bit words)
sm.adr	equ	sm.cd+6	cs data address
sm.len	equ	sm.adr+1	data length
sm.cks	equ	sm.len+4	checksum
	rem
	rem	fields in fnp-controlled submailbox with
	rem	input-in-mailbox opcode
	rem
sm.ict	equ	sm.cdl	input character count
sm.dat	equ	sm.cd	input data
sm.fcd	equ	sm.dat+50	flags with input data
	rem
	rem	fields in fnp-controlled submailbox with
	rem	accept-input opcode
	rem
sm.nbf	equ	4	number of buffers in input chain
sm.dcw	equ	6	start of pseudo-dcw list
	rem
mbxmax	equ	2*sm.fcd-2*sm.dat
	rem
sm3msk	bool	700000	mask for fnp number
smlmsk	bool	001777	mask for line number
smomsk	bool	777000	mask for opcode
smcmsk	bool	000777	mask for i/o command
	rem
mbxsz	equ	16
fmbxsz	equ	56	size of fnp-controlled mailbox
	rem
ecbits	equ	256	number of useful bits in echo negotiation
	rem		break table
ecnlen	equ	ecbits/16	resulting length in words
	rem
bufinc	bool	003000	mask for flags showing amount by which
	rem		buffer tally has been adjusted
	rem
ttcolt	equ	19	line type for colts executive channel
	rem
trmmod	equ	2
mbxmod	equ	3
	rem
	rem
	rem	memory trace types
	rem
mt.trm	equ	1
mt.mbx	equ	2
mt.rmb	equ	3
mt.inq	equ	4
mt.wcd	equ	5
mt.ouq	equ	6
mt.inc	equ	7
mt.wmb	equ	8
mt.fre	equ	9
mt.wtx	equ	10
mt.rtx	equ	11
mt.alt	equ	12
mt.acu	equ	13
	rem
	rem	printer trace switches
	rem
tr.que	bool	002
tr.mbx	bool	004
tr.int	bool	010
	rem
ct.dev	equ	1	offset in control tables of array of
	rem		device table pointers
ct.wru	equ	4	offset in control tables of "wru" wait block
ct.dly	equ	5	offset in control tables of first delay table
ct.brk	equ	6	offset in control tables of send_break pointer
	rem
dia	null
	start	dia,2,c3mcsm0c0000
	pmc	restore
	rem
	ttls	dterm -- handles terminate interrupts from dia
	rem
	rem	this entry processes terminate interrupts.
	rem	it checks the status and if a recoverable
	rem	error occurred, it restarts the i/o.
	rem	if the i/o succeeded, it uses the transaction
	rem	control word (tcword) to see whether to schedule
	rem	the transaction processor or the "get-work" subroutine.
	rem
	rem
dterm	null
	rem
	rem		status should be 000001000000
	lda	stat-*	high-order word of status
	icmpa	1
	tnz	dte005-*
	szn	stat+1-*	is low-order word 0?
	tze	dte010-*	yes, all is well
dte005	null
	rem
	lda	errcnt-*	no, get error count
	als	1	double error count to use as an offset
	cax2
	ldaq	stat-*	store bad status in table
	staq	a.a011-*,*	(badsts,2)
	lda	errcnt-*	calc true count
	iaa	1
	sta	bdstct-*	number of consecutive io errors in table
	rem
	lda	stat+1-*	get right-hand word in a
	ana	l.a003-*	see if it's one of the restartable ones
	tze	2
	die	2	it wasn't, die
	rem
	lda	errcnt-*	get error count again
	icmpa	maxerr	reached maximum?
	tmi	2
	die	3	yes, that's all for you
	rem
	iaa	1	increment count
	sta	errcnt-*
	ilq	errmsg	queue an error message to tell cs
	ldx2	a.a007-*	addr(sterr), command data for error message
	tsy	a.a008-*,*	derrq
	rem
	smeter	mincs,.mdias,l.a004-*
	rem
	szn	iopend-*	did we have a connect pending?
	tze	2	no, don't reconnect
	tsy	a.a003-*,*	(conect) reconnect the i/o
	tra	a.a002-*,*	return to master dispatcher
	rem
	rem		i/o was all right
dte010	null
	stz	errcnt-*	start error count over
	szn	iopend-*	were we actually expecting something?
	tze	a.a002-*,*	(mdisp) no, ignore it
	stz	iopend-*	if we were, we have it now
	rem
	trace	mt.trm,tr.int,(a.a001-*(*))
	rem
	lda	a.a001-*,*	(tcword) get transaction control word
	tmi	dte020-*	it had better not be negative
	tze	dte040-*	if it's zero, nothing to do
	icmpa	tcmax	if it's over maximum
	tmi	2	  we die
dte020	die	4
	icmpa	tcinmb	did we write a mailbox with input?
	tze	a.a002-*,*	(mdisp) yes, don't do anything until we hear
	rem		more from multics
	rem
	icmpa	tcreq	one of the ones we have to act on?
	tpl	dte030-*	no, just go unlock
	rem		yes, schedule transaction processor
	ldaq	l.a002-*	priority and address of dtrans
	tsy	a.a004-*,*	dspqur
	tra	a.a002-*,*	back to master dispatcher
	rem
dte030	null		nothing to do, unlock dia and call gate
	tsy	a.a005-*,*	unlock
dte040	null
	tsy	a.a006-*,*	gate
	tra	a.a002-*,*	back to master dispatcher
	rem
	rem
	rem
a.a001	ind	tcword	transaction control word
a.a002	ind	mdisp	master dispatcher
a.a003	ind 	conect
a.a004	ind	dspqur	scheduling routine
a.a005	ind	unlock
a.a006	ind	gate
a.a007	ind	sterr
a.a008	ind	derrq
a.a009	ind	shinp	short input flag
a.a010	ind	mbxfre,3	for marking FNP mailboxes free
a.a011	ind	badsts,2	index into bad status table
	rem
	even
l.a001	oct	1,0	good status from dia
l.a002	zero	dtprty	priority and address for
	ind	dtrans	scheduling dtrans
l.a003	vfd	18/fatal	non-restartable dia errors
l.a004	dec	1
	rem
	rem
iopend	dec	1	indicates whether i/o is pending
	rem		but set to 1 so first call to gate will happen
	rem
	even
errcnt	oct	0	count of dia i/o errors
sterr	dec	2	command data for reporting dia error
stat	oct	1,0	place where dia status is to go
badsts	bss	12	bad status table
bdstct	oct	0	number of consecutive errors in table
	rem
	ttls	dmail -- handler for mailbox interrupt
	rem
	rem	this entry handles interrupt that comes in when
	rem	mailbox is read from cs
	rem
	rem	it queues the mailbox for later processing
	rem
dmail	null		get 3rd word of jump table
	tsy	a.b001-*,*	g3wjt
	rem		word is in q
	lls	11	shift mailbox number into a low
	iana	mnmask	mask out rest of word
	icmpa	12	is it to be read or just freed?
	tmi	dma010-*	read
	szn	a.a009-*,*	(shinp) is there short input pending?
	tze	dma010-*	no, deal with it later
	cax1		save mailbox number for trace
	iaa	-12	get mailbox # in range 0-3
	cax3		mark it free now
	lda	a.a010-*,*	mbxfre,3
	icmpa	inmbx	is this the one?
	tnz	dma012-*	no, free mailbox later
	rem		else do it now
	stz	a.a010-*,*	mbxfre,3
	stz	a.a009-*,*	zero the flag now
	ila	-1	and decrement mbx use count
	asa	a.b018-*,*	mbused
	ldaq	l.a002-*	scheduling stuff for dtrans
	tsy	a.a004-*,*	dspqur -- make sure transaction processor runs
	tra	dma020-*	done
dma010	null
	cax1		get mailbox no. into x1
dma012	tsy	upmbq-*	update the mailbox queue
	rem
	cx1a		get mailbox no. again
	icmpa	8	ours originally?
	tmi	dma020-*	no, done
	iaa	-8	get it in range 0-3
	cax3		yes, look at saved opcode
	lda	a.a010-*,*	mbxfre,3
	icmpa	inmbx	input in mailbox?
	tnz	dma020-*	no
	rem		yes, it must have been rejected
	szn	a.a009-*,*	(shinp) were we working on it now?
	tze	dma020-*	no, worry about it later
	stz	a.a009-*,*	yes, clear the flag now
	tsy	a.a005-*,*	(unlock) make sure mailbox gets read
	rem
dma020	null
	trace	mt.mbx,tr.int,(x1)
	tra	a.b002-*,*	return to master dispatcher
	rem
	rem
	rem	rpmbx is scheduled to cause reprocessing of a mailbox
	rem	because of lack of buffer space. to the rest of dia_man,
	rem	it will appear that an interrupt was received for the
	rem	mailbox and handled by dmail
	rem
	rem	mailbox number is in x1
	rem
rpmbx	null
	tsy	upmbq-*	update mailbox queue
	tra	a.b015-*,*	return to secondary dispatcher
	rem
	ttls	upmbq -- update mailbox queue
	rem
	rem	mailbox number to be added to queue of mailboxes to be
	rem	processed is passed in x1
	rem
upmbq	subr	upm,(inh,x1)
	rem
	ldx2	mbqnxa-*	get offset of next available slot
	lda	a.b014-*,*	in mailbox queue
	icmpa	-1	is it free?
	tnz	upm010-*	it had better be
	lda	mbqcnt-*	get count, which had better be <16
	icmpa	16
	tmi	upm020-*
upm010	die	1	mailbox queue overflowed
	rem
upm020	null
	aos	mbqcnt-*	increment queue count
	stx1	a.b014-*,*	store number in queue entry
	rem
	aos	mbqnxa-*	bump "next available" pointer
	ila	mqmask	make it mod 16
	ansa	mbqnxa-*
	rem
	tsy	a.b003-*,*	gate (to schedule dgetwk)
	return	upmbq
	rem
	ttls	rdmbx -- subroutine to read mailbox from cs
	rem
	rem	this subroutine is called by dgetwk when mailbox
	rem	queue count is non-zero in order to read a mailbox from
	rem	the cs. The number of the mailbox is picked up from the
	rem	"next-to-process" entry of the mailbox queue
	rem
	rem	the routine is entered with interrupts inhibited,
	rem	x1 points to saved copy of indicators for reenabling them
	rem
rdmbx	subr	rdm,(x2,x3)
	rem
	lda	mbqcnt-*	get mailbox queue count
	tnz	2	if it's zero,
	die	5	we screwed up somehow
	rem
	iaa	-1	decrement it
	sta	mbqcnt-*
	ldx2	mbqnxt-*	get pointer to next entry to process
	ldq	a.b014-*,*	pick up mailbox number
	ila	-1	and mark the entry as free
	sta	a.b014-*,*
	aos	mbqnxt-*	bump the "next-to-process" pointer
	ila	mqmask	force it mod 16
	ansa	mbqnxt-*
	cqa		get mailbox number
	tmi	rdm010-*	make sure it's in range of
	icmpa	16	0-15
	tmi	2
rdm010	die	6
	icmpa	12	mailbox to be read or just freed?
	tmi	rdm020-*	read
	iaa	-12	freed, get number to be 0-3
	cax3		to use as index to freed words
	stz	a.b016-*,*	mbxfre,3
	ila	-1	and decrement mbx use count
	asa	a.b018-*,*	mbused
	ldi	0,1	****enable interrupts now
	ila	tcfree	set tcword to "freed mailbox"
	sta	a.b012-*,*	tcword
	rem
	tsy	a.b017-*,*	unlock
	tsy	a.b003-*,*	(gate) make sure dgtwrk runs
	tra	rdmbak-*	done
rdm020	null		we are to read mailbox
	rem		save mailbox number
	sta	a.b008-*,*	mbxno
	icmpa	8	fnp's or cs's?
	tmi	rdm030-*	his
	iaa	-8	ours, make it 0 to 3
	mpy	l.b001-*	(fmbxsz/2) get size
	iaq	mh.fsb	and correct offset
	stq	mbxadr-*
	ila	fmbxsz/2	size again
	sta	rdsize-*	save it for later
	tra	rdm040-*
rdm030	null
	als	3	multiply mbx no by 8 for addressing
	iaa	mh.sub	get full offset in mailbox area
	sta	mbxadr-*	save it
	ila	8	get correct size for cs-controlled mailbox
	sta	rdsize-*
rdm040	null
	rem
	ldi	0,1	****enable interrupts
	stz	a.b004-*,*	count of consecutive checksum errors
	rem
	trace	mt.rmb,tr.mbx,(a.b008-*(*))
	rem
	rem		now set up dcw list to read the mailbox
	rem
	ldx3	a.b005-*	get address of dcw area
	lda	a.b007-*,*	(csmbx) get cs mailbox header addr
	ada	mbxadr-*	add mailbox offset
	ilq	diactf	get cs -> fnp opcode
	staq	0,3
	rem
	ldq	rdsize-*	tally for reading mailbox
	lda	a.b006-*	addr(savmbx), w.2
	staq	2,3
	rem
	rem		save dcw list address for conect subroutine
	stx3	a.b009-*,*	dcwadr
	iacx3	4	point to next place for dcw
	tsy	a.b011-*,*	(bdisc) set up disconnect dcw
	rem		save tally for conect subroutine
	ila	4
	sta	a.b010-*,*	dcwlen
	rem
	rem		dcws are all set up
	rem		set transaction control word
	rem		to "mailbox read"
	rem
	ila	tcmbxr
	sta	a.b012-*,*	tcword
	rem
	tsy	a.b013-*,*	conect
rdmbak	return	rdmbx
	eject
a.b001	ind	g3wjt	get 3rd word of jump table
a.b002	ind	mdisp	master dispatcher
a.b003	ind	gate
a.b004	ind	ckecnt	count of consecutive checksum errors
a.b005	ind	dcws	static dcw list
a.b006	zero	savmbx,w.2	fnp's copy of last-read mailbox
a.b007	ind	csmbx	cs address of mailbox header
a.b008	ind	mbxno	mailbox number
a.b009	ind	dcwadr	conect's address of dcw list
a.b010	ind	dcwlen	conect's dcw tally
a.b011	ind	bdisc	subroutine to build a disconnect dcw
a.b012	ind	tcword	transaction control word
a.b013	ind	conect	subroutine to connect to dia
a.b014	ind	mbqhed,2	for accessing mailbox queue entries
a.b015	ind	secdsp	secondary dispatcher
a.b016	ind	mbxfre,3
a.b017	ind	unlock
a.b018	ind	mbused
	rem
	rem
l.b001	zero	fmbxsz/2
	rem
	rem
rdsize	bss	1	size of this mailbox in 36-bit words
dmsvi	bss	1	place to save indicators
mbxadr	bss	1	offset for cs address of mailbox
mbqcnt	oct	0	mailbox queue count
mbqnxa	oct	0	next available entry in mailbox queue
mbqnxt	oct	0	next entry in mailbox queue to process
	rem
	rem
	base	16
	rem		mailbox queue
mbqhed	dec	-1,-1,-1,-1,-1,-1,-1,-1
	dec	-1,-1,-1,-1,-1,-1,-1,-1
	rem
	ttls	gate -- subroutine to schedule dgetwk
	rem
	rem	subroutine called when a task is completed to make
	rem	sure that dgetwk gets scheduled. dgetwk will figure
	rem	out if there's more work to do
	rem
	rem	if dgetwk is already scheduled, we won't bother
	rem
gate	subr	gat,(inh,a,q)
	rem
	szn	gqued-*	see if it's already queued
	tnz	gatbak-*	it is, just return
	rem
	aos	gqued-*	else mark it queued now
	ldaq	l.c001-*	get dgetwk's priority and address
	tsy	a.c001-*,*	(dspqur) and schedule it
	rem
gatbak	return	gate
	rem
	ttls	dgetwk -- reads or requests a mailbox
	rem
	rem	this routine is scheduled by gate to find out
	rem	if there's anything to do
	rem	(more mailboxes to read or request)
	rem
	rem	if the dia lock is locked we will do nothing
	rem
	rem
dgetwk	null
	sti	dgsvi-*	hold on to indicators
	inh		****inhibit interrupts
	rem
	smeter	mupdat,.mimbx,mbused-* good time to update this
	rem
	stz	gqued-*	turn off "dgetwk queued" flag
	szn	a.c002-*,*	(=dilock) is dia already locked?
	tnz	dgebak-*	if it is, return
	tsy	a.c003-*,*	(=lock) else, lock it
	rem
	szn	a.c014-*,*	(mbqcnt) any mailboxes waiting to be read?
	tze	dge005-*	no, don't bother
	ldx1	a.c016-*	(dgsvi) get address of where indicators are stored
	tsy	a.c015-*,*	(rdmbx) go read the mailbox
	tra	a.c018-*,*	and return to secondary dispatcher
	rem
dge005	szn	qcnt-*	anything in the queue?
	tze	dge030-*	no, nothing to do
	ldx3	a.c019-*	addr (mbxfre)
	ila	-4	check if any are free
dge010	szn	0,3	this one?
	tze	dge020-*	yes
	iaa	1	no, are there more?
	tze	dge030-*	no, we'll have to deal with it later
	iacx3	1	look at next
	tra	dge010-*
	rem
dge020	aos	mbused-*	keep count of mailboxes in use
	iaa	12	make it in range 8-11
	sta	a.c020-*,*	mbxno
	ldx3	a.c022-*	addr (savmbx)
	tsy	a.c021-*,*	filmbx
	tra	dgebak-*	all done
	rem		if we come here, nothing to do
dge030	null		so just clear dia lock and return
	tsy	a.c017-*,*	unlock
	rem
dgebak	null
	ldi	dgsvi-*	****restore indicators (to enable)
	tra	a.c018-*,*	return to secondary dispatcher
	rem
	rem
	rem
a.c001	ind	dspqur	scheduling routine
a.c002	ind	dilock	dia lock
a.c003	ind	lock	locking subroutine
a.c004	ind	tcword	transaction control word
a.c006	ind	dcws	static area for building dcw list
a.c007	ind	dcwadr	address of dcw list (for conect)
a.c008	ind	dcwlen	length of dcw list (36-bit words)
*a.c009	unused
a.c010	ind	csmbx	cs mailbox header address
a.c011	ind 	bint	subroutine to build interrupt dcw
a.c012	ind	bdisc	subroutine to build disconnect dcw
a.c013	ind	conect	subroutine to do connect to dia
a.c014	ind	mbqcnt	mailbox queue count
a.c015	ind	rdmbx	subroutine to read a mailbox from cs
a.c016	ind	dgsvi	saved indicators (to pass to rdmbx)
a.c017	ind	unlock	unlocking subroutine
a.c018	ind	secdsp	secondary dispatcher
a.c019	ind	mbxfre
a.c020	ind	mbxno
a.c021	ind 	filmbx
a.c022	ind	savmbx	mailbox save area
	rem
l.c002	oct	004000	for masking overflow
	even
l.c001	zero	gtprty	priority and address
	ind	dgetwk	for scheduling dgetwk
	rem
	even
qcnt	oct	0
mbxfre	bss	4	words marked to show fnp mailboxes in use
mbused	oct	0	number of inbound mailboxes now in use
gqued	oct	0	"dgetwk is queued" flag
dgsvi	bss	1	place to save indicators
	rem
	ttls	denq -- subroutine to add entry to dia i/o queue
	rem
	rem	this subroutine is called from outside dia_man
	rem	to queue a request for dia i/o.
	rem
	rem	separate queues are maintained for each
	rem	line; a list of tibs and queue pointers is maintained
	rem	for finding the queue for each line.
	rem
	rem	we will update the mailbox request count as long as
	rem	there are no "accept input" requests already
	rem	on the queue for this line; but there may never be more
	rem	than one mailbox request outstanding for an "accept input"
	rem	opcode for any line.
	rem
	rem	if a quit or a hangup is queued, and there is a
	rem	rejected "accept input" at the head of
	rem	the queue, all accept inputs are cleansed from the queue
	rem	to ensure that the quit or hangup gets sent.
	rem
	rem	at entry:
	rem
	rem	q: opcode to be put in mailbox
	rem	x1: virtual tib address
	rem
	rem	the opcode is stored in queue element
	rem
	rem	queue consists of chained buffers, each pointing
	rem	to next buffer
	rem	elements are processed first in, first out
	rem
denq	subr	den,(a,q,x2,x3)
	stz	noai-*	initialize
	lda	t.line,1	save line number for trace
	sta	a.d013-*,*	(curqln)
	cx1a		need real tib address in a
	ldx2	t.sfcm,1	assume this is an hsla tib
	ldx2	sf.hsl,2	get hsla table entry for this channel
	lda	ht.tib,2	this is the real tib address
	rem
den010	null
	tsy	a.d006-*,*	getque
	rem		address of this tib's entry in list is in x2
	lda	densq-*	is this to mask the line?
	icmpa	linmsk
	tnz	den030-*	no, proceed normally
	ilq	0	initialize q decrement
	tsy	a.d007-*,*	(getqai) any accept inputs in queue?
	tra	den020-*	no, queue linmsk now
	lda	0,2	yes, look at first one
	ana	l.d009-*	(retry+rejflg) see if it's active
	cmpa	l.d010-*	(retry only)
	tze	denbak-*	it is, do the rest when it finishes
	ilq	1	otherwise, it's counted in the queue
den020	tsy	a.d001-*,*	(qmask) empty the queue and add linmsk
	adq	a.d011-*,*	(nnonai) now have total number removed
	stq	dendec-*	that had been counted in qcnt
	lda	a.d009-*,*	(qcnt)
	sba	dendec-*	decrement the count accordingly
	sta	a.d009-*,*
	tra	denbak-*	finished now
	rem
den030	tsy	a.d007-*,*	(getqai) find first accept input in queue
	tra	den060-*	none, so must update request count
	tra	den070-*	adding entry after a previous accept input
	rem		so no need to update request count
	rem
den060	null		add one to queue entry count
	aos	noai-*	there's no accept input now
	aos	a.d009-*,*	(qcnt)
	tsy	a.d003-*,*	(gate) make sure dgetwk gets scheduled
	rem		to process queue
den070	ldx2	densx2-*	get pointer to data
	ldq	densq-*	and origional opcode
	tsy	a.d010-*,*	(adqent) update queue
	rem
	cqa		get opcode in a
	icmpa	accin	is opcode "accept input"?
	tnz	den140-*
	ila	1	get double-precision 1
	lrl	18
	szn	noai-*	first accept input for this line?
	tnz	den080-*	yes
	adaq	prevai-*	no, meter presence of previous one
	staq	prevai-*
	tra	den090-*
den080	adaq	nprvai-*	meter addition of accept input without one already
	staq	nprvai-*
den090	ldq	t.icp,1	get pointer to head of chain
	tnz	2	(which must exist)
	die	19
	rem
	lda	t.dlst,1	get last buffer of previous chain
	tze	den120-*	if any
	tsy	a.d014-*,*	setbpt
	cax3		get virtual address
	rem		hook new chain onto
	stq	bf.nxt,3	previous one
	tra	den130-*
den120	null
	rem		no old chain, set up new chain pointer
	stq	t.dcp,1
den130	null
	cqa		get t.icp back
den131	tsy	a.d014-*,*	(setbpt) convert it
	cax3
	stz	denbuf-*	init buffer count
	stz	accum-*	start counter
den132	lda	bf.siz,3	count the number of 32-word blocks
	arl	15	get size code in low-order 3 bits
	iaa	1
	asa	t.dcpl,1	save length of t.dcp chain
	szn	bf.nxt,3	is this last buffer in chain?
	tze	den135-*	yes, go mark it
	lda	bf.flg,3	is this the end of a message?
	cana	l.d001-*	=bfflst
	tnz	den133-*	yes, break chain here
	lda	bf.tly,3	no, increment running tally
	ana	l.d007-*	=buftmk
	ada	accum-*	new result
	cmpa	l.d008-*	more than max chain length?
	tpl	den133-*	yes
	sta	accum-*	no, save new running tally
	lda	denbuf-*	get buffer count
	iaa	1	increment
	icmpa	maxchn	more than max number of buffers ?
	tpl	den133-*	yes
	sta	denbuf-*	save new buffer count
	lda	bf.nxt,3	and check next
	tsy	a.d014-*,*	setbpt
	cax3
	tra	den132-*
	rem
den133	ldx2	densx2-*	put another accept input in queue
	ldq	densq-*
	tsy	a.d010-*,*	(=adqent)
	rem
den135	lda	l.d001-*	=bfflst
	orsa	bf.flg,3	mark buffer as last in request
	lda	bf.nxt,3	are there more?
	tnz	den131-*	yes, start counting again
	cx3a		get absolute address to save
	tsy	a.d015-*,*	cvabs
	sta	t.dlst,1	else mark end of chain
	rem
	stz	t.icp,1	zero out tib fields so lsla_man or
	stz	t.ilst,1	hsla_man can start new chain
	stz	t.icpl,1
	lda	l.d012-*	tfinq
	orsa	t.flg3,1	inproc may add characters to t.dcp chain 
	tra	denbak-*	all done
	rem
den140	null		is it quit or hangup?
	icmpa	brkcon	check for quit
	tze	den150-*	yup
	icmpa	lindis	no, check for hangup
	tnz	denbak-*	none of above, we're all done
den150	null		we must cleanse any accept inputs from the queue
	stz	t.scll,1	turn off echo negotiation
	tsy	a.d007-*,*	(getqai) are there any?
	tra	denbak-*	no, forget it
	lda	0,2	yes, has it been rejected?
	cana	l.d005-*	=rejflg
	tnz	den160-*
	ora	l.d006-*	(=quitfl) if not, mark there's a quit
	sta	0,2	behind it in case it does get rejected
	tra	denbak-*
	rem
den160	null		cleanse the queue
	tsy	a.d008-*,*	cleanq
	rem
denbak	return	denq
	rem
denbuf	bss	1
noai	bss	1
	even
prevai	bss	2	count of accept inputs when one already
			present for the same channel
nprvai	bss	2	count of accept inputs added to queue
			without one already present
	ttls	deque -- remove an accept input from an i/o queue
	rem
	rem	the first item in the relevant line's i/o queue
	rem	must be an "accept input"; it will be removed from the
	rem	queue, and the mailbox request count will be updated
	rem
	rem	x1: virtual tib address
	rem
deque	subr	deq,(a,q,x1,x2,x3)
	rem
	lda	a.n001-*,*	(tibadr) get real tib address
	tsy	a.d006-*,*	(getque)
	rem		x2 -> tib table entry
	tsy	a.d007-*,*	(=getqai) find first accept input
	die	16	none is fatal
	szn	a.d011-*,*	(=nnonai) be sure no other entries before accin
	tze	2	ok
	die	16
	rem
	tsy	a.d012-*,*	(dlqent) free accept input entry
	rem
	lda	t.flg3,1	is the channel masked?
	cana	l.d011-*	tfmask
	tze	deq005-*	no, proceed
	tsy	a.d001-*,*	(qmask) now is the time to empty the queue
	tra	deqbak-*	that's it
	rem
deq005	tsy	a.d007-*,*	(=getqai) find first accin in new queue
	tra	deq010-*	none
	lda	l.d012-*	tfinq
	orsa	t.flg3,1	it's okay to add to existing t.dcp chain
	ila	1	must add 1 to req cnt for accin
	tra	2
deq010	ila	0
	ada	a.d011-*,*	(=nnonai) add in entries before  accin
	tze	deqbak-*	no requests in queue, return
	asa	a.d009-*,*	qcnt
	rem
deqbak	null		all done
	return	deque
	ttls	dretry -- scheduled to retry accept input
	rem
	rem	this entry is scheduled if an attempt to send
	rem	input to the cs was rejected for lack of
	rem	buffer space. it turns off the "rejected" flag
	rem	in the first "accept input" entry for the tib
	rem	pointed to by x1, and puts out a request for one mailbox
	rem
	rem	if there is no rejected request queued for this
	rem	line, we will do nothing
	rem
	rem	x1 - real tib address
	rem
dretry	null
	rem
	cx1a		need real tib address in a
	tsy	a.d006-*,*	getque
	tsy	a.d007-*,*	(=getqai) find first accept input
	tra	drebak-*	none, return
	lda	0,2	pick up queue entry
	cana	l.d005-*	(=rejflg) has it been rejected?
	tze	drebak-*	no, queue must have been cleaned
	rem		we have one
	lda	l.d004-*	=nretry
	ansa	0,2	zero "retry" flag
	aos	a.d009-*,*	(qcnt) add one to count of queue entries
	tsy	a.d003-*,*	(gate) schedule dgetwk
drebak	tra	a.d005-*,*	return to secondary dispatcher
	rem
	rem
a.d001	ind	qmask	subr that clears queue and adds linmsk
a.d003	ind	gate
a.d005	ind	secdsp	secondary dispatcher
a.d006	ind	getque	subroutine to find entry in tib queue list
a.d007	ind	getqai	subr thats finds first accin in queue
a.d008	ind	cleanq	cleans accept inputs out of queue
a.d009	ind	qcnt	 count of pending queue entries
a.d010	ind	adqent	subr that adds entry to end of queue
a.d011	ind	nnonai	counter set by getqai subr that indicates
	rem		the number of entries before the first accin
a.d012	ind	dlqent	subr that deletes entry from the queue
a.d013	ind	curqln	line number for trace
a.d014	ind	setbpt
a.d015	ind	cvabs
	rem
	rem
l.d001	vfd	18/bfflst
l.d002	oct	37	for checking 0 mod 32
l.d003	oct	004000	inhibit overflow indicator
l.d004	vfd	18/nretry
l.d005	vfd	18/rejflg
l.d006	vfd	18/quitfl
l.d007	vfd	18/buftmk
l.d008	dec	2048	arbitrary maximum chain length
l.d009	vfd	o18/retry+rejflg
l.d010	vfd	18/retry
l.d011	vfd	18/tfmask
l.d012	vfd	18/tfinq
	rem
	rem
dendec	bss	1	amount by which to decrement qcnt if masking
accum	bss	1	running length of chain in characters
	rem
	ttls	derrq -- subroutine to add entry to error message queue
	rem
	rem	this subroutine adds an entry to a special i/o
	rem	queue for error messages. each entry contains an
	rem	opcode and 4 words (72 bits) of command data to be
	rem	passed to the cs
	rem	queue is allocated in buffers of which second word is zero,
	rem	leaving room for 6 five-word entries
	rem
	rem	because this routine can be called at interrupt
	rem	time, it must save and restore the variables used
	rem	to describe the current request queue
	rem
	rem	at entry:
	rem
	rem	q: opcode
	rem	x2: address of command data
	rem
derrq	subr	der,(inh,a,q,x2,x3)
	rem
	lda	a.n005-*,*	=curque
	ldq	a.d013-*,*	=curqln
	staq	tcurq-*	save these in temporary
	lda	a.n009-*,*	=curqbf
	sta	tcurbf-*	this too
	rem
	stz	a.d013-*,*	=curqln, zero line number
	lda	a.n004-*	get address of simulated tib table entry
	sta	a.n005-*,*	(curque)
	rem
	ldq	dersq-*	restore opcode to q
	adq	l.n002-*	(=004000) indicate 4 words of data
	tsy	a.d010-*,*	(adqent) add entry to error queue
	aos	a.n002-*,*	qcnt
	rem		now restore common values
	ldaq	tcurq-*
	sta	a.n005-*,*	=curque
	stq	a.d013-*,*	=curqln
	lda	tcurbf-*
	sta	a.n009-*,*	=curqbf
	return	derrq
	rem
	rem
a.n001	ind	tibadr
a.n002	ind	qcnt
a.n003	ind	fremem
a.n004	ind	errqtb
a.n005	ind	curque
a.n006	ind	pchbuf
a.n007	ind	pchadr
a.n008	ind	pchlen
a.n009	ind	curqbf
a.n010	ind	tcword
	rem
l.n002	oct	004000
	rem
*	the following two words simuulate a tib table entry for
*	the dia error queue. the first word corresponds to the
*	tib address word, but is not used here. the second word
*	points to the first buffer in the queue.
	rem
errqtb	oct	0
errqbf	oct	0
	even
tcurq	bss	1	temporary for saving curque
tcurln	bss	1	likewise for curqln
tcurbf	bss	1	likewise for curqbf
	rem
tcword	oct	0	transaction control word
	ttls	dtrans -- transaction processor
	rem
	rem	this subroutine is scheduled after dia i/o is finished
	rem	in order to process the results of the i/o
	rem
	rem	the transaction control word  (tcword)
	rem	indicates what was just done
	rem
	rem	dia lock is locked at entry
	rem
dtrans	null
	lda	a.n010-*,*	(tcword) get transaction control word
	tze	dtr100-*	do nothing if it's zero
	icmpa	tcreq	is its value one that requires action?
	tpl	dtr100-*	no, go away
	rem
	lda	a.n001-*,*	(tibadr) get real address of relevant tib
	tsy	a.e019-*,*	(setptw) virtualize it
	cax1		need it in x1
	rem
	lda	tcword-*	get tcword back in a
	icmpa	tcdcwl	did we read dcw list?
	tnz	dtr010-*	if not, try something else
	rem		if so, set up dcw list to read the data
	tsy	a.e001-*,*	(rddata)
	tra	dtr200-*	error return (buffer allocation failed)
	ila	tcdata	reset transaction control word
	sta	tcword-*	to "read data"
	tsy	a.e002-*,*	(conect) do the connect
	tra	a.e003-*,*	return to secondary dispatcher
	rem
dtr010	null
	icmpa	tcdata	did we read data?
	tnz	dtr050-*	if not, try something else
	stz	bflag-*	indicate not blast write
	tsy	write-*	set up chains and notify control tables
	rem
	rem
	szn	sndflg-*	immediate send output response?
	tze	dtr090-*	no, just free mailbox and return
	ldx3	a.e033-*	addr (savmbx)
	aos	sm.cd,3	turn on send output flag in mbx
	cx3a
	tsy	a.e034-*,*	(wmbx) write mailbox back
	tra	a.e003-*,*	(secdsp) and done
	rem
dtr050	null
	icmpa	tcmbxr	did we read a mailbox?
	tnz	dtr060-*
	tsy	a.e014-*,*	(decmbx) yes, go decode it
	tra	a.e003-*,*	that's all
	rem
dtr060	null
	icmpa	tcblst	did we read blast message?
	tnz	dtr080-*
	ldx3	blbuf-*	yes, get buffer address
	rem
	iacx3	2*bufsiz	save address of second buffer
	stx3	blbuf2-*
	aos	bflag-*	so write will know this is blast
	rem
	ldx2	a.e029-*,*	.crttb
	rem		start scanning all tibs
dtr065	null
	lda	qtib,2	this is the real tib address
	tsy	a.e019-*,*	(setptw) virtualize it
	cax1		put in x1
	lda	t.stat,1	find out if it's dialed up
	ana	l.e010-*	tsfcd+tsfdsr
	cmpa	l.e010-*	carrier and dsr both on?
	tnz	dtr075-*	not dialed up, look at next
	rem
	lda	t.type,1	get line type
	icmpa	8	tn1200 on 202c?
	tze	dtr070-*	yes, treat like ascii
	icmpa	5	regular terminal type (1-4)?
	tpl	dtr075-*	no, look at next tib
	icmpa	2	is it ibm-type?
	tze	dtr068-*	it's 1050
	icmpa	3	if not, 2741?
	tnz	dtr070-*	no
dtr068	ldx3	blbuf2-*	yes, point to ebcdic buffer
	ila	1	set ebcdic indicator
	tra	dtr072-*
	rem
dtr070	ldx3	blbuf-*	ascii, point to ascii buffer
	ila	0	set ascii indicator
dtr072	tsy	gblast-*	allocate output buffers
	tsy	write-*	update output chain, tell control tables
	rem
dtr075	iacx2	2	look at next entry in tib list
	cmpx2	a.e030-*,*	(.crtte) reached end?
	tnz	dtr065-*	no, look at next tib
	ilq	6*bufsiz	yes, free message buffers
	ldx3	blbuf-*
	tsy	a.e024-*,*	(frebuf)
	rem
	tra	dtr090-*	free mailbox and return
	rem
dtr080	icmpa	tcpchm	patching memory?
	tnz	dtr084-*	no
	ldx2	a.n006-*,*	(pchbuf) yes. address of buffer
	ldx3	a.n007-*,*	(pchadr) address to patch
	ldq	a.n008-*,*	(pchlen) length of patch
	tsy	a.e018-*,*	(mvpgtg) move the patch into place
dtr083	null		release buffer
	ldx3	a.n006-*,*	(pchbuf) memory space to free
	ldq	a.n008-*,*	(pchlen) length of memory space
	tsy	a.n003-*,*	(fremem)
	tsy	a.e009-*,*	(gate) make sure dgetwk runs
	tra	dtr100-*	and done
	rem
dtr084	icmpa	tcdmpm	dumping memory?
	tze	dtr083-*	yes. release temp memory space
	rem
dtr085	icmpa	tcinmb	wrote data in mailbox?
	tnz	dtr089-*	no
	lda	t.dcp,1	yes, must take buffers off chain now
	ldx3	t.dcp,1	for call to frelbf
	stz	dnblks-*	initialize count
dtr086	tsy	a.e037-*,*	setbpt
	cax2		get virutal address in x2
	lda	bf.siz,2	get buffer size
	arl	15	in 32-word blocks
	iaa	1
	asa	dnblks-*	update count
	lda	bf.flg,2	this the last one?
	cana	l.e005-*	bfflst
	tnz	dtr088-*	yes
	lda	bf.nxt,2	look at next
	tnz	dtr086-*
dtr088	ldq	dnblks-*	get block count
	tsy	a.e017-*,*	(instrp) take them off t.dcp chain
	cx3a
	tsy	a.e005-*,*	(frelbf)
	tsy	a.e016-*,*	(deque) remove accin from queue now
	ila	tcfree	set transaction control word to indicate
	sta	tcword-*	end of transaction
	tsy	a.e009-*,*	(gate) make sure dgetwk runs
	tra	dtr100-*	done with transaction
	rem
dtr089	icmpa	tcmetr	sent metering info?
	tnz	dtr110-*
	ldx3	a.e035-*,*	(gmebuf) get address of temporary buffer
	ldq	a.e036-*,*	(gmesiz)
	tsy	a.n003-*,*	(fremem) we're through with it now
	tra	dtr090-*	free mailbox and return
	rem
dtr090	null		free mailbox and return
	tsy	a.e013-*,*	frembx
	tra	a.e003-*,*	and return to secondary dispatcher
	rem
dtr100	null		nothing to do, unlock dia lock
	tsy	a.e023-*,*	unlock
	tra	a.e003-*,*	return to secondary dispatcher
	rem
dtr110	icmpa	tcrecn	did we read echo negotiation table?
	tnz	dtr150-*	no
	ldx2	a.e020-*	(addr (pdcws)) point to the table
	tsy	a.e021-*,*	makecn
	tra	dtr090-*	free mailbox and return
	rem
dtr150	null		by default, we wrote data to cs
	rem		free buffer chain that was sent
	lda	a.e015-*,*	oldhed
	tsy	a.e005-*,*	frelbf
	tsy	a.e016-*,*	(deque) remove accin from queue now
	tsy	a.e009-*,*	(gate) make sure dgetwk runs
	tra	dtr100-*	unlock & return
	rem
	rem
dtr200	null		attempt to allocate output buffers failed
	rem		we will schedule rpmbx to reprocess the
	rem		mailbox after 6 seconds
	ldx1	a.e027-*,*	mbxno
	ldaq	l.e008-*	time, priority, and address of rpmbx
	tsy	a.e028-*,*	dspqur
	ila	tcmax	set transaction control word to illegal value
	sta	tcword-*
	tra	dtr100-*
	ttls	write -- subroutine to set up for sending output
write	subr	wri,(x2)
	stz	sndflg-*
	lda	t.flg3,1	is this for a line that's been masked?
	cana	l.e013-*	tfmask
	tze	wri003-*	no, proceed
	szn	bflag-*	for blast message?
	tnz	wribak-*	yes, done
	lda	a.e007-*,*	(rhead) else free the buffer chain now
	tsy	a.e005-*,*	(frelbf) since we certainly can't use it
	tra	wribak-*
	rem
wri003	lda	l.e001-*	=tfwrit
	cana	t.flg,1	output in progress?
	tze	wri005-*	no, check t.ocp chain
	lda	t.flg2,1	else see if it's in block acknowledge
	ana	l.e009-*	=tfblak+tfofc
	cmpa	l.e009-*	both on?
	tze	wri005-*	yes, don't chain to t.ocur
	lda	t.echo,1	else check if there's pending echoing
	tze	wri040-*	obviously not, chain new stuff on
	tsy	a.e037-*,*	setbpt
	cax2
	lda	eb.tly,2	there's an echo buffer, anything in it?
	arl	9	isolate tally
	tze	wri040-*	no, chain new stuff on
wri005	null		else check current chain pointer
	lda	t.ocp,1	load the pointer
	tnz	wri010-*	already there, must chain on here too
	rem		none, just set ptr
	lda	a.e007-*,*	=rhead (set by rddata)
	sta	t.ocp,1	new output chain
	tra	wri030-*	skip out
	rem
wri010	tsy	a.e037-*,*	setbpt
	cax2
	szn	bf.nxt,2	any forward ptr this block?
	tze	wri020-*	no, chain in here
	lda	bf.nxt,2	chain to next block
	tra	wri010-*	loop
	rem
wri020	null
	cmeter	mincs,m.over,l.e012-*
	rem
	lda	a.e007-*,*	(=rhead) get head of new chain
	sta	bf.nxt,2	reset forward ptr in block
	rem
wri030	null		call "write" entry of control table interpreter
	tsy	a.e010-*,*	iwrite
	tra	wribak-*
	rem
wri040	null		write is in progress
	szn	t.ocur,1	make sure there's a real live chain
	tnz	2
	die	20	there had better be
	rem
	cmeter	mincs,m.over,l.e012-*
	rem		hook new output chain onto active chain
	lda	t.olst,1	get old last buffer
	tsy	a.e037-*,*	setbpt
	cax2
	lda	a.e007-*,*	=rhead (head of new data)
	sta	bf.nxt,2	attach new chain
	lda	a.e008-*,*	=rtail
	sta	t.olst,1	update "last buffer"
	rem		update output chain buffer count
	lda	a.e025-*,*	ndcws (same as number of new buffers)
	asa	t.ocnt,1
	szn	bflag-*	is this for blast?
	tnz	wri050-*	yes, don't check for threshold
	ila	bufthr	is count over threshold now?
	cmpa	t.ocnt,1
	tmi	wri050-*	yes, it's all right
	aos	sndflg-*	no, ask for more output
	rem
wri050	null
	lda	t.type,1	is this colts executive channel?
	icmpa	ttcolt
	tze	wribak-*	yes, don't call anybody
	lda	t.line,1	get line number to find out if it's
	rem		hsla or lsla
	cana	l.e002-*	=hslafl
	rem		call relevant "output available" entry
	tnz	wri060-*
	tsy	a.e011-*,*	loutav
	tra	wribak-*
wri060	tsy	a.e012-*,*	houtav
wribak	return	write
	ttls	storage for dtrans and write
	rem
a.e001	ind	rddata	subroutine to set up dcw lists to read data
a.e002	ind	conect
a.e003	ind	secdsp	secondary dispatcher
a.e004	ind	dcwadr	address of last-used dcw list
a.e005	ind	frelbf	subroutine to free a linked list of input buffers
a.e007	ind	rhead	head of buffer chain allocated by rddata
a.e008	ind	rtail	tail "     "     "       "      "    "
a.e009	ind	gate
a.e010	ind	iwrite
a.e011	ind	loutav	lsla "output available" subroutine
a.e012	ind	houtav	hsla     "      "           "
a.e013	ind	frembx
a.e014	ind	decmbx
a.e015	ind	oldhed	old head of input chain just sent
a.e016	ind	deque
a.e017	ind	instrp
a.e018	ind	mvpgtg	move data paging target subroutine
a.e019	ind	setptw	set page table word
a.e020	ind	pdcws
a.e021	ind	makecn
a.e023	ind	unlock
a.e024	ind	frebfh	subroutine to free a single buffer
a.e025	ind	ndcws	same as number of buffers read in
a.e026	ind	denq
a.e027	ind	mbxno
a.e028	ind	dspqur
a.e029	ind	.crttb	head of tib list
a.e030	ind	.crtte	end of tib list
a.e032	ind	getbfh
a.e033	ind	savmbx
a.e034	ind	wmbx
a.e035	ind	gmebuf
a.e036	ind	gmesiz
a.e037	ind	setbpt
	rem
	rem
l.e001	vfd	18/tfwrit
l.e002	vfd	18/hslafl
l.e003	oct	37	for testing 0 mod 32
l.e004	oct	004000	inhibit overflow indicator
l.e005	vfd	18/bfflst
l.e007	vfd	18/ntfwrt
	even
l.e008	vfd	12/1,6/rtprty
	ind	rpmbx	for scheduling rpmbx after 1 second
	rem
l.e009	vfd	18/tfblak+tfofc
l.e010	vfd	18/tsfcd+tsfdsr
l.e011	vfd	18/gbfbla	"blast" flag (for utilities)
l.e012	dec	1	for meter increment
l.e013	vfd	18/tfmask
	rem
	rem
dtrsvi	bss	1	for saving indicators
	rem		blast buffers are three consecutive
	rem		double-size buffers
	rem		first is ascii, second is ebcdic,
	rem		third is correspondence
blbuf	bss	1	address of blast buffers
blbuf2	bss	1	address of ebcdic blast buffers
bflag	bss	1	flag indicating blast call
dnblks	bss	1	number of 32-word blocks to take off chain
	ttls	gblast -- subroutine to allocate buffers for blast output
sndflg	bss	1
	rem
	rem		this subroutine allocates the buffer(s) to be used
	rem		to send a blast message to a particular line
	rem		one double-size buffer is sent to ascii lines,
	rem		or two to ebcdic lines.
	rem
	rem		the message is copied into the allocated buffers
	rem
	rem		Inputs:
	rem		   x3 points to source for message
	rem		   a  is 0 for ascii or 1 for ebcdic
	rem
gblast	subr	gbl,(x2)
	rem
	sta	tflag-*	save arguments
	stx3	gsrce-*
	rem
	ilq	2*bufsiz	get double buffer size
	szn	tflag-*	ebcdic?
	tze	2	no
	qls	1	yes, double it again
	tsy	a.e032-*,*	getbuf
	die	10	if we can't get buffers, forget it
	rem
	sta	gtarg-*	store absolute target address
	stx3	vtarg-*	and virtual also
	ldx2	gsrce-*
	stq	gsize-*
gbl010	ldaq	0,2	get two words of source
	staq	0,3	put them in target buffer
	iacx2	2
	iacx3	2
	ila	-2	reduce count
	asa	gsize-*
	tnz	gbl010-*	not exhausted, go around again
	rem
	lda	gtarg-*	get address of head buffer
	sta	a.e007-*,*	(rhead) where write will look for it
	ldx3	vtarg-*	get virtual address back
	szn	tflag-*	ascii or ebcdic?
	tze	gbl020-*	ascii
	iaa	2*bufsiz	ebcdic, set forward pointer
	sta	bf.nxt,3
	tra	2
gbl020	stz	bf.nxt,3	ascii, only one buffer
	sta	a.e008-*,*	(rtail)
	return	gblast
	rem
	rem
tflag	bss	1	ascii/ebcdic flag
gsrce	bss	1	address of source characters
gtarg	bss	1	address of target buffer
vtarg	bss	1	virtual address of target buffer
gsize	bss	1	size of target buffer
	rem
ckecnt	oct	0	consecutive checksum error count
	ttls	decmbx -- routine to decode a mailbox from the cs
	rem
	rem	this routine is called if transaction control word
	rem	indicates that a mailbox has been read from the cs.
	rem	it will interpret the mailbox that has been read into
	rem	"savmbx" and take appropriate action depending on the
	rem	i/o command and opcode in the mailbox
	rem
	rem
decmbx	subr	dec
	ldx3	a.f018-*	=addr(savmbx)
	lda	sm.lno,3	get line number from mailbox
	ana	l.f001-*	=smlmsk
	tnz	dec005-*	there's really a line number
	stz	a.f017-*,*	(tibadr) use 0
	tra	dec010-*	there's a 0 in the a for x1
dec005	null		convert to tib address
	tsy	a.f003-*,*	gettib
	sta	a.f017-*,*	(tibadr) save real tib address
	tsy	a.e019-*,*	(setptw) virtualize it
dec010	cax1		x1 gets virtual tib address
	rem		pick up i/o command
	ldq	sm.op,3	get i/o command and opcode
	ila	0
	lls	9
	sta	opcode-*	 save opcode
	rem
	ila	0
	lls	9	get i/o command into a
	icmpa	wcd	write command data?
	tnz	dec210-*	 no, check for something else
	rem		yes, search wcd table to determine
	rem		where to go
	trace	mt.wcd,tr.mbx,(a.f023-*(*),opcode,sm.lno(3))
	rem
	ldx2	a.f004-*	(wcdtab)
	lda	opcode-*
dec015	null
	cmpa	0,2	check opcode against table entry
	tze	1,2*	if it matches, go where table says
	iacx2	2	else check next entry
	cmpx2	a.f025-*,*	(wcdend) reached end?
	tnz	dec015-*	no, look at next entry
	die	8	else invalid
	rem
	rem
dec020	null		terminal accepted
	szn	tibadr-*	is this line really configured?
	tze	dec100-*	if not, forget it
	ilq	sndout	queue "send output"
	tsy	a.f005-*,*	denq
	tra	dec100-*
	rem
dec030	null		disconnect line
	szn	tibadr-*	is there a tib?
	tze	dec100-*	no, don't try to do anything
	lda	l.f002-*	(tfhang)
	orsa	t.flg,1	hang it up
	lda	l.f003-*	(ntflsn)
	ansa	t.flg,1	turn off listen flag
	rem		call test-state entry of interpreter
	tsy	a.f006-*,*	(itest)
	tra	dec100-*
	rem
dec040	null		disconnect all lines
	lda	l.f004-*	(gbfhng) turn on "hung up" flag
	orsa	a.f007-*,*	globsw
	rem		now hang up all dialed-up lines
	ldx2	a.f013-*,*	(.crttb)
	rem
dec045	null
	lda	qtib,2	get real tib address
	tsy	a.e019-*,*	(setptw) virtualize it
	cax1		put virtual tib address in x1
	lda	l.f002-*	(tfhang)
	orsa	t.flg,1	set hangup flag in tib
	tsy	a.f006-*,*	(itest)
	rem
	iacx2	2	look at next entry in tib list
	cmpx2	a.f039-*,*	(.crtte) reached end?
	tnz	dec045-*	no, go around again
	tra	dec100-*
	rem
dec046	null		don't accept calls
	lda	l.f005-*	(gbfup)
	iera	-1	complement it
	ansa	a.f007-*,*	(globsw) turn it off
	tra	dec100-*	that's all
	rem
dec050	null		accept calls
	rem		turn global "cs up" switch on
	lda	l.f005-*	(gbfup)
	orsa	a.f007-*,*	(globsw)
	lda	sm.cd,3	get buffer limit for input
	sta	a.f029-*,*	(blimit) save for future use
	rem		now call itest for all lines in case they need to
	rem		start listening again
	ldx2	a.f013-*,*	.crttb
dec054	lda	qtib,2	get tib address
	tze	dec055-*	none, skip it
	tsy	a.e019-*,*	setptw
	cax1		now have virtual tib address
	tsy	a.f006-*,*	itest
dec055	iacx2	2	next entry in tib list
	cmpx2	a.f039-*,*	(.crtte) reached the end?
	tnz	dec054-*	no, do the next one
	tra	dec100-*
	rem
dec060	null		reject request
	rem		i.e. cs didn't have room for input
	rem		we will schedule retry routine to retry
	rem		"accept input" one second from now
	tsy	a.f008-*,*	reject
	tra	dec100-*
	rem
dec065	null		enter receive mode
	szn	tibadr-*	not if no line
	tze	dec100-*
	lda	l.f015-*	(tfercv)
	orsa	t.flg2,1	turn on flag (in second word)
	tsy	a.f006-*,*	(itest) tell interpreter
	tra	dec100-*	done
	rem
dec070	null		terminal rejected
	szn	tibadr-*	don't try to hang up nonexistent line
	tze	dec100-*
	lda	l.f002-*	(tfhang)
	orsa	t.flg,1	hang it up, tell interpreter
	tsy	a.f006-*,*	(itest)
	tra	dec100-*	done
	rem
dec075	null		set line type
	szn	tibadr-*	if no line, skip it
	tze	dec100-*
	lda	sm.cd,3	get new type
	sta	t.type,1	set it in tib
	tra	dec100-*	that's all
	rem
dec080	null		checksum error
	ila	0	rewrite same mailbox as last time
	tsy	a.f010-*,*	wmbx
	tra	a.f026-*,*	(decbak) return now
	rem
dec085	null		blast message
	tsy	a.f040-*,*	(rblast) sets up dcw to read msg
	ila	tcblst	set transaction control word
	sta	a.f021-*,*	(tcword)
	tsy	a.f002-*,*	(conect)
	tra	a.f026-*,*	(decbak)
	rem
dec090	null		alter parameters, done by subroutine
	szn	tibadr-*	but not if there's no line
	tze	dec100-*
	tsy	a.f009-*,*	(alterp)
	tra	dec100-*	done
	rem
dec095	null		dial out request
	szn	tibadr-*	but not if there's no line
	tze	dec100-*
	tsy	a.f032-*,*	(acusr) done by subrou