


		    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 subroutine
	tra	dec100-*
	rem
dec096	null		dump memory
	stx3	dctemp-*	save mailbox address
	ldq	sm.cd+3,3	get length of area to dump
	stq	pchlen-*	so memory space can be freed later
	tsy	a.f012-*,*	(getmem) get equal amount of memory space
	die	10	failed
	stx3	pchbuf-*	save address of buffer
	ldx3	dctemp-*	retrieve mailbox address
	rem		copy memory to dump into buffer, it may come
	rem		 from upper 32k
	ldx2	sm.cd+2,3	get source address
	ldq	sm.cd+3,3	get length of memory to be dumped
	ldx3	pchbuf-*	get address of target
	tsy	a.f014-*,*	(mvpgsc) move data paging source
	rem
	ldx3	dctemp-*	retrieve mailbox address
	lda	pchbuf-*	put buffer address in mailbox
	sta	sm.cd+2,3
	ila	tcdmpm	set tcword for dump_fnp order
	sta	a.f021-*,*	(tcword)
	ilq	diaftc	we'll be writing to cs
	tra	dec098-*	enter common code with patch_fnp order
	rem
dec097	null		patch memory
	stx3	dctemp-*	save mailbox addr
	ldq	sm.cd+3,3	get length of area to patch
	tsy	a.f012-*,*	(getmem) get equal amount of memory space
	die	10	failed
	stx3	pchbuf-*	save address of patch buffer
	cx3a
	ldx3	dctemp-*	get mailbox addr back
	ldq	sm.cd+2,3	fnp address to patch
	stq	pchadr-*	save
	sta	sm.cd+2,3	setup transfer to temp buffer
	ldq	sm.cd+3,3	get length in words
	stq	pchlen-*	and save
	ila	tcpchm	set tcword for patch_fnp order
	sta	a.f021-*,*	(tcword)
	ilq	diactf	we'll be reading from cs
dec098	ldx2	a.f033-*	(dcws)
	stx2	a.f034-*,*	(dcwadr)
	ila	10	space for five dcws
	sta	a.f035-*,*	(dcwlen)
	rem		get cs address
	lda	sm.cd+1,3	bottom 18 bits anyway
	staq	0,2	store along with opcode (set above)
	lda	sm.cd,3	high-order 6 bits of cs address?
	tze	dec099-*	not there
	als	6	yes, put in dcw (24-29)
	orsa	1,2
	rem
dec099	null
	ldaq	sm.cd+2,3	get fnp address and tally
	ora	l.f016-*	(0,w.2)
	iaq	1	convert tally to 36-bit words
	qrs	1
	staq	2,2	put them in dcw
	cx2a		get dcw address
	iaa	4	updated
	cax3		into x3
	rem		free the mailbox (can't use frembx because
	rem		it assumes a new dcw list)
	tsy	a.f036-*,*	(wtimw)
	tsy	a.f037-*,*	(bint)
	iacx3	4
	tsy	a.f038-*,*	(bdisc)
	tsy	a.f002-*,*	(conect)
	tra	a.f026-*,*	(decbak) done
	rem
dec100	null		through with wcd, free the mailbox
	tsy	a.f011-*,*	(frembx)
	tra	a.f026-*,*	(decbak) and return
	rem
dec101	null		msgsiz
	lda	t.line,1	find out if hsla line
	cana	l.f007-*	hslafl
	tze	dec100-*	it isn't, ignore this mailbox
	ldx2	t.sfcm,1	get sfcm address
	lda	sm.cd,3	get new message size
	sta	sf.mms,2	save it
	tra	dec100-*	done
	rem
dec105	null		fnp_break order
	tsy	a.f041-*,*	(=brkptr) subr to do break point request
	tra	dec100-*	done
	rem
dec106	stx3	lctlmb-*	line_control - save mbx addr
	tsy	a.f006-*,*	make test state call
	stz	lctlmb-*	this means line_control done
	tra	dec100-*
	rem
dec107	null		set_delay
	szn	tibadr-*	any line?
	tze	dec100-*	not really
	cx3a		get pointer to
	iaa	sm.cd	command data
	cax2		into x2
	tsy	a.f044-*,*	makdly
	tra	dec100-*
	rem
dec300	null		set framing chars
	szn	tibadr-*	forget it if no line
	tze	dec100-*
	lda	sm.cd,3	get the characters
	sta	t.frmc,1	save in tib
	lda	t.line,1
	cana	l.f007-*	=hslafl
	tze	dec100-*	not hsla line, don't bother
	tsy	a.f048-*,*	=hmode
	tra	dec100-*
	rem
	eject
a.f001	ind	gmeter	sets up dcw list to report meters
a.f002	ind	conect
a.f003	ind	gettib	translates line number to tib
a.f004	ind	wcdtab	branch table for wcd opcodes
a.f005	ind	denq
a.f006	ind	itest	interpreter's "test_state" entry
a.f007	ind	globsw	global switch word
a.f008	ind	reject
a.f009	ind	alterp	subroutine for "alter parameters"
a.f010	ind	wmbx
a.f011	ind	frembx
a.f012	ind	getmem
a.f013	ind	.crttb	head of tib list
a.f014	ind	mvpgsc	move data paging source subroutine
a.f015	ind	ecgifl	echo negotiation input flush
*a.f016			unused
a.f017	ind	tibadr	some places can`t quite reach it
a.f018	ind	savmbx
a.f019	ind	rddcw
a.f021	ind	tcword	transaction control word
a.f022	ind	indata	subroutine to set up dcws for sending
	rem		input to cs
a.f023	ind	mbxno
a.f024	ind	.crmet
a.f025	ind	wcdend
a.f026	ind	decbak	return from this routine
a.f027	ind	setbpt
a.f029	ind	blimit
*a.f030	unused
	rem
a.f032	ind	acusr	for starting acu
a.f033	ind	dcws	standard dcw area
a.f034	ind	dcwadr
a.f035	ind	dcwlen
a.f036	ind	wtimw	updates timw
a.f037	ind	bint	builds interrupt dcw
a.f038	ind	bdisc	builds disconnect dcw
a.f039	ind	.crtte	end of tib list
a.f040	ind	rblast
a.f041	ind	brkptr	break point request handler
*a.f042	unused
*a.f043	unused
a.f044	ind	makdly
*a.f045	unused
*a.f046	unused
*a.f047	unused
a.f048	ind	hmode	subr that handles mode change for hsla lines
	rem
	rem
l.f001	vfd	18/smlmsk
l.f002	vfd	18/tfhang
l.f003	vfd	18/ntflsn
l.f004	vfd	18/gbfhng
l.f005	vfd	18/gbfup
l.f006	vfd	18/tfblak+tfofc
l.f007	vfd	18/hslafl
l.f008	vfd	18/lnmask
l.f009	vfd	18/nretry
l.f010	vfd	18/tfitim
l.f011	vfd	18/tfblak
l.f012	vfd	o18//tfitim
l.f013	vfd	18/tfctrl
l.f014	vfd	o18//tfblak
l.f015	vfd	18/tfercv
l.f016	zero	0,w.2
l.f017	vfd	18/tfofc
l.f018	vfd	18/tfdild
l.f019	vfd	18/tfifc
	rem
	rem
tibadr	bss	1	real address of currently relevant tib
opcode	bss	1	opcode from mailbox
dctemp	bss	1	temporary
lctlmb	oct	0	contains mbx addr during line_control order
pchbuf	bss	1	address of patch buffer
pchadr	bss	1	address being patched
pchlen	bss	1	number of words to patch
	eject
dec210	null		not wcd
	icmpa	wtx	write text?
	tnz	dec230-*	no, try rtx
	lda	opcode-*	yes, get opcode
	icmpa	accout	must be accept output or
	tze	dec220-*	accept last output
	icmpa	aclout
	tze	dec220-*
	die	8	otherwise, forget it
	rem
dec220	null		set up to read dcw list
	rem
	trace	mt.wtx,tr.mbx,(a.f023-*(*),sm.lno(3),sm.adr+1(3))
	rem
	szn	tibadr-*	is there really a line?
	tze	dec100-*	if not, just free mailbox and return
	rem
	tsy	a.f019-*,*	rddcw
	rem
	rem		set transaction control word to
	ila	tcdcwl	"dcw list read"
	sta	a.f021-*,*	tcword
	tsy	a.f002-*,*	conect
	tra	decbak-*	and return
	rem
	rem
dec230	null		i/o command is rtx or invalid
	icmpa	rtx
	tze	2
	die	17
	rem
	rem		it's rtx, opcode must be
	lda	opcode-*	input accepted
	icmpa	inacc
	tze	2
	die	8
	rem
	trace	mt.rtx,tr.mbx,(a.f023-*(*),sm.lno(3))
	rem
	rem		put together dcw list for transmitting input
	rem		to cs
	tsy	a.f022-*,*	indata
	rem
	ila	tcwrd	set transaction control word to "wrote data"
	sta	a.f021-*,*	tcword
	tsy	a.f002-*,*	conect
	rem
decbak	return	decmbx
	rem
dec350	null		set echnego break table
	rem
	rem		the table is too big to fit in a mailbox,
	rem		so we'll read it into the pseudo-dcw area
	szn	tibadr-*
	tze	dec100-*	no line?
	tsy	a.f019-*,*	(rddcw)
	ila	tcrecn	set tcword to "read echo neg. table"
	sta	a.f021-*,*	tcword
	tsy	a.f002-*,*	conect
	tra	decbak-*
	rem
dec360	null		start echo negotiation
	rem		which has the option to refuse echnegooin
	rem		by zeroing t.scll for any reason whatsoever.
	szn	tibadr-*
	tze	dec100-*	no line
	lda	t.echo,1	is there pending echoing?
	tze	dec370-*	no
	tsy	a.f027-*,*	setbpt
	cax2
	lda	eb.tly,2	maybe
	arl	9	isolate tally to make sure
	tnz	dec380-*	yes, can't echnego
dec370	szn	t.dcp,1	is there a dia-queued input chain?
	tnz	dec380-*	yes, don't negotiate
	tsy	a.f015-*,*	(engifl) get icp chain queued
	szn	t.entp,1	make sure there had better be a table
	tze	dec380-*	punt if not
	lda	sm.cd,3	get # of chars seen by ring 0
	cmpa	t.sncc,1	is it the same as # of chars we sent out?
	tnz	dec380-*	no, can't echnego
	lda	sm.cd+1,3	get screen length left, 0 works too.
	sta	t.scll,1	ok, we're echo negotiating
	tra	dec100-*
dec380	null		fail to start echo negotiation
	stz	t.scll,1	shoulda been zero anyway for engogo
	tra	dec100-*
	rem
dec400	null		stop echo negotiation
	szn	tibadr-*
	tze	dec100-*
	tsy	a.f015-*,*	get queued stuff out
	ilq	engaof	acknowledge_echnego_stop
	tsy	a.f005-*,*	(denq) send one
	tra	dec380-*	turn off negotiation
	rem
dec440	null		init echo negotiation
	szn	tibadr-*
	tze	dec100-*	no line?
	tsy	a.f015-*,*	get the act synchronized
	stz	t.sncc,1	synchronize ctrs
	ilq	engain	acknowledge_echnego_init
	tsy	a.f005-*,*	(denq)
	tra	dec100-*
	rem
dec450	null		set input flow control chars
	lda	sm.cd,3	get the characters
	sta	t.ifch,1
	szn	sm.cd+1,3	timeout options specified?
	tze	dec455-*	no
	lda	l.f010-*	=tfitim
	orsa	t.flg3,1	yes, set it in tib
	tra	dec458-*
dec455	lda	l.f012-*	=^tfitim
	ansa	t.flg3,1	otherwise, turn it off
dec458	lda	t.flg2,1	check if iflow already on
	cana	l.f019-*	=tfifc
	tze	dec100-*	no, never mind
	tsy	a.f048-*,*	(hmode) have to make sure cct is updated
	tra	dec100-*
	rem
dec460	null		set output flow control chars
	lda	sm.cd,3	get the chars
	cmpa	t.ofch,1	have they changed?
	tze	dec462-*	no, may not want to reinitialize
	sta	t.ofch,1	else store them
	tra	dec463-*	and skip other test
dec462	lda	t.flg2,1	check for modes already on
	ana	l.f006-*	=tfblak+tfofc
	cmpa	l.f006-*	both on?
	tze	dec464-*	yes, don't initialize block count
dec463	stz	t.omct,1	initialize message count
dec464	szn	sm.cd+1,3	block acknowledgement protocol?
	tze	dec465-*	no
	lda	l.f011-*	=tfblak
	orsa	t.flg2,1	yes, set it in tib
	tra	dec468-*
dec465	lda	l.f014-*	=^tfblak
	ansa	t.flg2,1	otherwise, turn it off
dec468	lda	t.flg2,1	see if mode is already on
	cana	l.f017-*	=tfofc
	tze	dec100-*	nope
	tsy	a.f048-*,*	(hmode) yes, have to make sure cct gets updated
	tra	dec100-*
	rem
dec470	null		report meters
	szn	a.f024-*,*	(.crmet) is metering enabled?
	tze	dec100-*	no, just free mailbox
	tsy	a.f001-*,*	gmeter subroutine does it all
	tra	decbak-*
	rem
	rem
	even
savmbx	bss	fmbxsz	copy of input mailbox
	rem
	eject
	rem
	rem	This macro is used to set up a branch table fo
	rem	mailbox opcodes. It generates a word containing
	rem	 the opcode to be checked for, and a word containing
	rem	the address to branch to for that opcode.
	rem
optab	macro	c,m
	zero	#1
	ind	#2
	rem
	endm	optab
	rem
wcdtab	null		table of locations for transfer
	rem		on wcd opcodes
	optab	termac,dec020
	optab	dislin,dec030
	optab	disall,dec040
	optab	accall,dec050
	optab	rejreq,dec060
	optab	entrcv,dec065
	optab	trmrej,dec070
	optab	setcls,dec075
	optab	cserr,dec080
	optab	alter,dec090
	optab	blast,dec085
	optab	disacc,dec100
	optab	incomp,dec100
	optab	frmchr,dec300
	optab	brack,dec100
	optab	dodial,dec095
	optab	dmpmem,dec096
	optab	pchmem,dec097
	optab	brkpnt,dec105
	optab	noacc,dec046
	optab	linctl,dec106
	optab	setdly,dec107
	optab	msgsiz,dec101
	optab	engstb,dec350
	optab	engogo,dec360
	optab	engoff,dec400
	optab	engini,dec440
	optab	infcc,dec450
	optab	outfcc,dec460
	optab	rmeter,dec470
wcdend	zero	*	to mark end of table
	rem
	rem
*
*	this subroutine is called by a linctl opblock to see if the
*	current test state call is caused by a line_control
*	order. the convention is that during a line_control order,
*	"lctlmb" is non-zero, and contains the mailbox addr
*
lctlck	subr	lct,(a)
	lda	a.g007-*,*	=lctlmb, pick up mailbox addr
	tze	lctret-*	not line contorl
	iaa	sm.cd	get addr of data
	cax3
	aos	lctlck-*	take skip return
lctret	return	lctlck
	ttls	alterp -- subroutine to handle "alter parameters"
	rem
	rem
	rem	this subroutine does whatever is necessary when an
	rem	"alter parameters" opcode is sent from the cs
	rem
	rem	the subcommand to be performed is in the first 9
	rem	bits of the command data in the mailbox
	rem	for most of the subcommands currently implemented,
	rem	the low-order bit of the first word of command
	rem	data indicates "on" or "off"
	rem
	rem	at entry:
	rem	x1 -- virtual tib address
	rem	x3 -- mailbox address
	rem
alterp	subr	alt
	rem
	trace	mt.alt,tr.mbx,(sm.cd(3))
	rem
	stz	caltst-*	initialize "call itest" flag
	stz	chmode-*	and "call hmode" flag
	stz	checho-*	and "change acho mode" flag
	lda	a.g009-*	=t.flg,1
	sta	flgptr-*	initialize pointer to t.flg
	lda	t.type,1	is this colts executive channel?
	icmpa	ttcolt	if so, we use a much shorter
	tze	alt500-*	list of subcommands
	lda	sm.cd,3	get first 18 bits of command data
	lrl	9	isolate subcommand
	ldx2	a.g001-*	addr(alttab)
alt010	null
	cmpa	0,2	does subcommand match table entry?
	tze	1,2*	yes, go process it
	iacx2	2	no, check next
	cmpx2	a.g011-*,*	(altend) if not at end of table
	tnz	alt010-*
	die	8	else die
	rem
alt020	null		crecho
	lda	l.g001-*	=tfcrec
	tra	alt135-*	join common code
	rem
alt030	null		lfecho
	lda	l.g002-*	=tflfec
	tra	alt135-*
	rem
alt040	null		tbecho
	lda	l.g003-*	=tftbec
	tra	alt140-*
	rem
alt050	null		handle quit
	lda	l.g004-*	=tfquit
	tra	alt150-*
	rem
alt060	null		listen
	tsy	a.g012-*,*	(setsiz) pick up buffer size from mailbox
	qrl	0	check flag
	tze	alt065-*	turning it off, don't worry
	lda	t.flg3,1	was the channel masked?
	cana	l.g027-*	=tfmask
	tze	alt065-*	no
	tsy	a.g013-*,*	(hunmsk) yes, unmask it now
alt065	lda	l.g005-*	=tflisn
	aos	caltst-*	call itest when done
	rem
	tra	alt150-*
	rem
alt070	null		lock
	lda	l.g008-*	=tfctrl
	tra	alt150-*
	rem
alt080	null		full duplex
	lda	l.g009-*	=tffdpx
	tra	alt150-*
	rem
alt090	null		change-string
	tra	altbak-*	that's all
	rem
alt100	null		who-are-you
	rem		must start control tables at special place
	rem		to read answerback
	lda	l.g005-*	=tflisn
	cana	t.flg,1	if line isn't listening,
	tze	altbak-*	don't bother
	rem
	ila	-wruinc	check list of line types for which wru is no good
	ldx2	a.g005-*	addr(wrutbl)
	ldq	t.type,1
	rem
alt101	cmpq	0,2	is this one?
	tze	alt102-*	yes
	iacx2	1	look at next
	iaa	1	exhausted table?
	tnz	alt101-*	no
	rem
	ilq	wrutim	send "wru timeout" right away
	tsy	a.g006-*,*	denq
	tra	altbak-*
	rem
alt102	ldx2	a.g004-*	addr(ctrl)
	lda	ct.wru,2	address of special wait block
	sta	t.cur,1	tell interpreter to start there
	stz	t.reta,1	in case we yanked it out of subr
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt110	null		echoplex mode
	lda	l.g011-*	=tfecpx
	tra	alt135-*
	rem
alt120	null		framei mode
	lda	t.line,1	hsla line?
	cana	l.g010-*	=hslafl
	tze	alt125-*	no, buffer sizes are uninteresting
	qrl	0	check the flag
	tze	alt125-*	turning it off, no buffer sizes
	ldx2	t.sfcm,1	get sfcm address
	lda	sm.cd+1,3	get intermediate buffer size
	tsy	rndsiz-*	get it in words
	sta	sf.bsz,2	save it
	lda	sm.cd+2,3	get size to be used during frame
	tze	2	if any
	tsy	rndsiz-*	in words
	sta	sf.fbs,2	save it
	rem
alt125	null
	ila	t.flg2-t.flg
	asa	flgptr-*	update flgptr to point to t.flg2
	lda	l.g018-*	tffrmi
	tra	alt140-*
	rem
alt135	aos	checho-*	echoing mode changed
	rem
alt140	null
	aos	chmode-*
	rem
alt150	null		flag on or off?
	qrl	0
	tze	alt160-*
	orsa	flgptr-*,*	on
	tra	alt170-*
alt160	null		off
	iera	-1
	ansa	flgptr-*,*
	rem
alt170	null		mode changed?
	szn	chmode-*
	tze	alt180-*	no
	lda	t.line,1	yes, hsla line?
	cana	l.g010-*	hslafl
	tze	alt175-*	no
	tsy	a.g003-*,*	call hmode
	rem
alt175	szn	checho-*	did we change an echoing mode?
	tze	alt180-*	no
	lda	t.flg,1
	cana	l.g016-*	tflfec+tfcrec+tfecpx
	tnz	alt180-*	echoing not all off
	tsy	a.g008-*,*	(deldly) we have stopped echoing, remove delay table
	stz	t.dtp,1
	rem
alt180	null		call itest?
	szn	caltst-*
	tze	altbak-*	no,return
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt190	null		dump input
	lda	l.g013-*	=tfrabt
	orsa	t.flg2,1	set read abort flag
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt200	null		dump output
	lda	l.g006-*	=tfwabt
	orsa	t.flg,1	on
	lda	l.g007-*	=^tfwrit
	ansa	t.flg,1	tfwrit off
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt210	null		xmit hold
	lda	l.g012-*	=tfxhld
	qrl	0	on or off?
	tze	alt220-*
	orsa	t.flg2,1	on, just do it
	tra	altbak-*
alt220	null		off, we'll have to do test-state also
	iera	-1
	ansa	t.flg2,1	turn flag off
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt230	null		replay mode
	lda	l.g014-*	(=tfrply) get bit
	rem
alt240	qrl	0	on or off?
	tze	alt245-*	off, do it
	orsa	t.flg2,1	turn it on
	tra	altbak-*
	rem
alt245	null
	iera	-1	invert flag bit
	ansa	t.flg2,1	turn it off
	tra	altbak-*
	rem
alt250	null		polite mode
	lda	l.g015-*	(=tfplit) get the bit
	tra	alt240-*	common code to set second flag word bits
	rem
alt260	null		set buffer size
	tsy	setsiz-*	just do it
	tra	altbak-*	and begone
	rem
alt270	null		breakall mode
	ila	t.flg3-t.flg
	asa	flgptr-*	make flgptr point to t.flg3
	lda	l.g019-*	(=tfbral) prepare to set breakall flag
	tra	alt140-*
	rem
alt280	null		prefixnl mode
	ila	t.flg2-t.flg
	asa	flgptr-*
	lda	l.g020-*	(=tfpfnl)
	tra	alt150-*
	rem
alt290	null		iflow mode
	ila	t.flg2-t.flg	make flgptr point to t.flg2
	asa	flgptr-*
	lda	t.line,1	is it hsla line?
	cana	l.g010-*	=hslafl
	tze	alt295-*
	ldx2	t.sfcm,1	if so, have to update buffer size
	lda	sm.cd+1,3	get it from mailbox
	tsy	rndsiz-*
	sta	sf.fbs,2
alt295	lda	l.g021-*	=tfifc
	tra	alt140-*	go set it
	rem
alt300	null		oflow mode
	ila	t.flg2-t.flg	make flgptr point at t.flg2
	asa	flgptr-*
	qrl	0	turning it on or off?
	tnz	alt309-*	on, go ahead
	lda	t.flg2,1	off, was it block acknowledgement?
	cana	l.g023-*	=tfblak
	tze	alt309-*	no, hsla_man will take care of it
	stz	t.omct,1	else must reset counter
	aos	caltst-*	and alert control tables
alt309	lda	l.g022-*	=tfofc
	tra	alt140-*	go do it
	rem
alt310	null		odd parity
	ila	t.flg3-t.flg	make flgptr point at t.flg3
	asa	flgptr-*
	lda	l.g024-*	=tfoddp
	tra	alt140-*
	rem
alt320	null		no input parity
	ila	t.flg3-t.flg	make flgptr point at t.flg3
	asa	flgptr-*
	lda	l.g025-*	=tf8in
	tra	alt150-*
	rem
alt330	null		no output parity
	ila	t.flg3-t.flg	make flgptr point at t.flg3
	asa	flgptr-*
	lda	l.g026-*	=tf8out
	tra	alt140-*
	rem
	rem
alt400	null		send line break
	rem		must start control tables at special place
	rem		to send line break
	rem
	ldx2	a.g004-*	addr(ctrl)
	lda	ct.brk,2	address of special wait block
	sta	t.cur,1	tell interpreter to start there
	stz	t.reta,1	in case we yanked it out of subr
	tsy	a.g002-*,*	itest
	tra	altbak-*
	rem
alt500	null		come here for colts channel
	lda	sm.cd,3	get ifrst 18 bits of command data
	lrl	9	isolate subcommand
	ldx2	a.g010-*	addr (alctab)
alt510	null
	cmpa	0,2	does subcommand match table entry?
	tze	1,2*	yes, go process it
	iacx2	2	no, check next
	cmpx2	alcend-*	reached end of table?
	tnz	alt510-*	no, look again
	tra	altbak-*	ignore any not in table
	rem
altbak	return	alterp
	rem
	rem
	rem
a.g001	ind	alttab
a.g002	ind	itest	"test_state" entry of interpreter
a.g003	ind	hmode	"change-mode" entry of hsla_man
a.g004	ind	ctrl
a.g005	ind	wrutbl	table of invalid "wru" line types
a.g006	ind	denq
a.g007	ind	lctlmb
a.g008	ind	deldly
a.g009	ind	t.flg,1	used to set up address variable for flag word
a.g010	ind	alctab
a.g011	ind	altend
a.g012	ind	setsiz
a.g013	ind	hunmsk
	rem
l.g001	vfd	18/tfcrec
l.g002	vfd	18/tflfec
l.g003	vfd	18/tftbec
l.g004	vfd	18/tfquit
l.g005	vfd	18/tflisn
l.g006	vfd	18/tfwabt
l.g007	vfd	18/ntfwrt
l.g008	vfd	18/tfctrl
l.g009	vfd	18/tffdpx
l.g010	vfd	18/hslafl
l.g011	vfd	18/tfecpx
l.g012	vfd	18/tfxhld
l.g013	vfd	18/tfrabt
l.g014	vfd	18/tfrply
l.g015	vfd	18/tfplit
l.g016	vfd	18/tflfec+tfcrec+tfecpx
l.g017	vfd	18/bfmsiz
l.g018	vfd	18/tffrmi
l.g019	vfd	18/tfbral
l.g020	vfd	18/tfpfnl
l.g021	vfd	18/tfifc
l.g022	vfd	18/tfofc
l.g023	vfd	18/tfblak
l.g024	vfd	18/tfoddp
l.g025	vfd	18/tf8in
l.g026	vfd	18/tf8out
l.g027	vfd	18/tfmask
	rem
	rem
caltst	bss	1	flag indicating whether to call itest
chmode	bss	1	flag indicating mode change
checho	bss	1	flag indicating echo-mode change
altemp	bss	1	temporary storage
atemp2	bss	1	more temporary storage
flgptr	ind	**	this will be set with x1 modification
	rem
	rem
alttab	equ	*	branch table for alter parameters subcommands
	rem
	optab	alcrec,alt020
	optab	allfec,alt030
	optab	altbec,alt040
	optab	alquit,alt050
	optab	allisn,alt060
	optab	allock,alt070
	optab	alfdpx,alt080
	optab	alchng,alt090
	optab	alwru,alt100
	optab	alecpx,alt110
	optab	aldpin,alt190
	optab	aldump,alt200
	optab	alxhld,alt210
	optab	alrply,alt230
	optab	alplit,alt250
	optab	alfrmi,alt120
	optab	alsetb,alt260
	optab	albral,alt270
	optab	alpfnl,alt280
	optab	alifc,alt290
	optab	alofc,alt300
	optab	aloddp,alt310
	optab	al8in,alt320
	optab	al8out,alt330
	optab	albrk,alt400
altend	zero	*	marks end of table
	rem
	rem
alctab	equ	*	branch table used for colts channel
	optab	allisn,alt060
	optab	aldpin,alt190
	optab	aldump,alt200
alcend	zero	*	marks end of table
	rem
	rem		table of line types for which wru is allowed
wrutbl	dec	1	ascii
	dec	2	1050
	dec	3	2741
	dec	8	202c6
wruinc	equ	*-wrutbl	length of table
	ttls	rndsiz -- subroutine to convert buffer size to words
	rem
	rem	this subroutine takes a buffer size in characters
	rem	and returns it in words rounded up to the next
	rem	multiple of 32
	rem
	rem	input:
	rem	   a -- chars per buffer
	rem
	rem	output:
	rem	   a -- buffer size in words
	rem
	rem
rndsiz	subr	rnd
	iaa	71	round up to multiple of 32 words
	ars	6
	als	5	convert to words
	cmpa	l.g017-*	(bfmsiz) respect upper limit
	tmi	2
	lda	l.g017-*
	return	rndsiz
	rem
	rem
*	setsiz -- subroutine to set buffer size in sfcm
	rem
	rem
	rem	copy input buffer size from mailbox to sf.bsz for
	rem	listen order or set_buffer_size order (dialout)
	rem
	rem	input:
	rem	   x1 -- virtual tib address
	rem	   x3 -- submailbox address
	rem
	rem	output:
	rem	   buffer size stored in sf.bsz
	rem	   zero stored in sf.mms
	rem
	rem
setsiz	subr	set,(q,x2)
	lda	t.line,1	is this an hsla line?
	cana	l.g010-*	hslafl
	tze	setbak-*	no, don't bother with sfcm stuff
	ldx2	t.sfcm,1
	tze	setbak-*	better leave it alone if no sfcm
	lda	sm.cd+1,3	get buffer size in chars
	tsy	rndsiz-*	get it in words rounded up to multiple of 32
	sta	sf.bsz,2	save size in sfcm
	stz	sf.mms,2	start clean
setbak	return	setsiz
	ttls	filmbx -- subroutine to fill FNP-controlled mailbox from i/o queue
	rem
	rem
	rem		this routine is called by dgetwk if the i/o queue is
	rem		non-empty and there's a free mailbox for sending to the CS
	rem
	rem		x3: mailbox save area address
	rem
	rem
filmbx	subr	fil
	rem		start by getting request from i/o queue
	tsy	a.v027-*,*	(fetch)
	lda	0,2	pick up opcode word from queue
	sta	filopc-*
	stx2	filtmp-*	save queue address
	als	9	put opcode in mailbox
	iora	rcd	with rcd
	sta	sm.op,3
	stz	sm.cdl,3	initialize command data length to zero
	stz	sm.lno,3	likewise line number
	ila	-1	correct the queue count
	asa	a.v004-*,*	(qcnt)
	lda	filopc-*	pick up opcode again
	ana	l.v019-*	(=007000) see if any data words
	tze	fil020-*	none
	ars	9	compute nwords
	caq
	cx3a
	iaa	sm.cd	point at beginning of command data
	cax1
	ldx2	filtmp-*	get opcode back
fil010	null
	lda	1,2	pick up word from queue
	sta	0,1	store in mailbox
	iaq	-1
	tze	fil020-*	all words moved in
	iacx1	1	bump pointers
	iacx2	1
	tra	fil010-*
	rem
fil020	null		now dequeue the error message
	lda	filopc-*	pick up original opcode
	iana	255
	sta	filopc-*	save masked version
	icmpa	errmsg	sending an error message?
	tnz	fil030-*	no
	ldx2	filtmp-*	addr of q entry
	ldx1	l.v004-*	(=0) so dlqent will know not to meter
	tsy	a.v042-*,*	(=dlqent) delete it
	tra	fil120-*	done
	rem
fil030	ldx1	a.v043-*,*	address of current queue
	lda	qtib,1	get real tib addrss
	sta	a.v001-*,*	(tibadr) save real tib address
	tsy	a.v006-*,*	(setptw) virtualize it
	cax1		put virtual tib address in x1
	lda	t.line,1	put line number in mailbox
	orsa	sm.lno,3
	rem		now deal with opcode
	lda	filopc-*
	icmpa	accin	"accept input"?
	tze	fil100-*	yes, go do special stuff
	ldx2	filtmp-*	get queue address
	tsy	a.v042-*,*	(=dlqent) and free it
	rem
	trace	mt.ouq,tr.que,(filtmp,filopc,t.line(1))
	rem
	lda	filopc-*	get op code again
	ldx2	a.v015-*	addr(rcdtab)
fil040	null		search table for opcode
	cmpa	0,2	if found,
	tze	1,2*	branch according to table
	iacx2	2	else go to next entry
	cmpx2	rcdend-*	table exhausted?
	tnz	fil040-*
	die	8	yes, invalid opcode
	rem
	rem
fil050	null		accept new terminal
	rem
	smeter	mincs,.mndil,l.v001-*
	smeter	mupdat,.mdilc,(a.v007-*(*))
	rem
	lda	t.type,1	pass type back as command data
	stz	sm.cd,3	cs looks at 36 bits
	sta	sm.cd+1,3
	stz	sm.cd+2,3	zero second 36 bits of command data
	stz	sm.cd+3,3
	lda	l.v017-*	(=tfauto)
	cana	t.flg,1	is the an autobaud line?
	tze	fil060-*	no
	ldx2	t.sfcm,1	address of software com region
	ldx2	sf.hsl,2	address of hsla table
	lda	ht.flg,2	flag word
	iana	htfspd	isolate speed
	iaa	-1	compute cs speed index
	icmpa	7	less then 1200?
	tmi	2	yes
	iaa	-1	further fudge (multics does not know 1050 baud)
	sta	sm.cd+3,3	and store in command data
fil060	ila	12	set command data length also
	sta	sm.cdl,3
	lda	l.v018-*	tfdild
	orsa	t.flg2,1	mark it dialed up now
	tra	fil120-*
	rem
fil070	null		line disconnected
	rem		turn off listen flag in tib
	lda	l.v003-*	=^tflisn
	ansa	t.flg,1
	lda	l.v010-*	get permanent t.flg bits
	ansa	t.flg,1	turn off all the others
	lda	l.v011-*	get permanent t.flg2 bits
	ansa	t.flg2,1	turn off all the others
	lda	l.v014-*	get permanent t.flg3 bits
	ansa	t.flg3,1	turn off all the others
	rem
	rem		if this type of line has tfctrl by default,
	rem		leave it on
	ldx3	a.v024-*	addr(ctrl)
	ldx3	ct.dev,3	array of device table addresses
	adcx3	t.type,1	indexed by device type
	ldx3	-1,3	(which starts at 1, not 0)
	rem		x3 -> relevant device table entry
	lda	l.v012-*	dtfctl
	cana	dt.flg,3	should tfctrl be on?
	tze	fil080-*	no, leave it off
	lda	l.v013-*	=tfctrl
	orsa	t.flg,1	turn it on
	rem
fil080	null
	lda	t.echo,1	is there an echo buffer?
	tze	fil090-*
	ilq	bufsiz	if so, free it
	tsy	a.v016-*,*	frebfh
	stz	t.echo,1
	rem
fil090	null
	tsy	a.v045-*,*	(deldly) get rid of any delay table
	stz	t.dtp,1	and remember that it's gone
	tsy	a.v047-*,*	(deletb) free echnego tbl if any
	stz	t.entp,1	and remember that it's gone
	stz	t.scll,1	turn off pendant echo negotiation
	stz	t.sncc,1	Clear this for good luck
	rem
	smeter	mincs,.mndil,l.v002-*
	smeter	mupdat,.mdilc,(a.v007-*(*))
	rem		if hsla line, free cct buffer if any
	lda	t.line,1	is it hsla line?
	cana	l.v007-*	=hslafl
	tze	fil120-*	if not, don't bother
	lda	t.type,1	make sure it's a real channel
	icmpa	ttcolt	and not just colts executive
	tze	fil120-*	nope
	ilq	0
	tsy	a.v046-*,*	shrcct
	tra	fil120-*	that's it for disconnected line
	rem
	rem
fil100	null		accept input
	ila	9	command data will be 54 bits
	sta	sm.cdl,3
	rem		get count of input characters to put in cmd
	tsy	a.v017-*,*	(incnt) data
	rem
	lda	a.v030-*,*	(.crnbf) get number of buffers left
	sta	sm.fre,3	tell multics what it is
	szn	a.v005-*,*	(shinp) was it short input?
	tze	fil120-*	no
	ila	inmbx	yes, reset opcode
	sta	filopc-*
	lda	l.v005-*	(^tfinq) while, accept input is being processed,
	ansa	t.flg3,1	don't allow appending to the last buffer
	tra	fil120-*
	rem
	rem
fil110	null		send output
	ila	9	54 bits of command data
	sta	sm.cdl,3	because we will put buffer count in same
	rem		place as for accept input
	lda	a.v030-*,*	(.crnbf) get number of buffers remaining
	sta	sm.fre,3
	rem
	rem
fil120	null		finished with rcd, now write mailbox
	rem		back to cs
	lda	filopc-*
	ldx2	a.v002-*,*	mbxno
	sta	a.v003-*,*	mbxfre-8,2 (mark mailbox with current opcode)
	lda	a.v018-*	addr(savmb)
	tsy	a.v010-*,*	wmbx
filbak	return	filmbx
	eject
	rem
	rem
a.v001	ind	tibadr
a.v002	ind	mbxno
a.v003	ind	mbxfre-8,2
a.v004	ind	qcnt
a.v005	ind	shinp
a.v006	ind	setptw	set up variable cpu page table word
a.v007	ind	.mndil
*a.v008		unused
*a.v009		unused
a.v010	ind	wmbx
a.v015	ind	rcdtab	branch table for rcd opcodes
a.v016	ind	frebfh
a.v017	ind	incnt	subroutine to count input characters
a.v018	ind	savmbx
a.v024	ind	ctrl
a.v027	ind	fetch
a.v030	ind	.crnbf
a.v042	ind	dlqent
a.v043	ind	curque
a.v045	ind	deldly
a.v046	ind	shrcct	subr that shares or releases cct
a.v047	ind	deletb
	rem
	rem
l.v001	dec	1
l.v002	dec	-1
l.v003	vfd	18/ntflsn
l.v004	dec	0
l.v005	vfd	o18//tfinq
l.v007	vfd	18/hslafl
l.v010	vfd	18/tfdlup+tfauto
l.v011	vfd	18/tfsftr
l.v012	vfd	18/dtfctl
l.v013	vfd	18/tfctrl
l.v014	vfd	18/tfbkpt+tfoddp+tfmask+tfabf0+tfabf1
l.v017	vfd	18/tfauto
l.v018	vfd	18/tfdild
l.v019	oct	007000
	rem
	rem
filtmp	bss	1
filopc	bss	1
	rem
	rem
rcdtab	null		branch table for rcd opcodes
	rem
	optab	acctrm,fil050
	optab	lindis,fil070
	optab	sndout,fil110
	optab	brkcon,fil120
	optab	wrutim,fil120
	optab	acupwi,fil120
	optab	acudlo,fil120
	optab	acuacr,fil120
	optab	acung,fil120
	optab	linsta,fil120
	optab	engain,fil120
	optab	engaof,fil120
	optab	linmsk,fil070
rcdend	zero	*	to mark end of table
	rem
	ttls	gmeter -- report meters to cs
	rem
	rem	this subroutine sets up a dcw list to copy either
	rem	per-channel or FNP-wide meters in response to a 
	rem	report-meters mailbox. The meters are copied to a
	rem	temporary buffer both to avoid having them paged out and
	rem	to make sure a consistent copy is sent.
	rem
	rem	at entry:
	rem	x1 contains address of tib (or tibadr = 0 if for whole fnp)
	rem	x3 points to mailbox; sm.cd in mailbox contains address
	rem	   of cs buffer
	rem
gmeter	subr	gme,(x2,x3)
	szn	a.s001-*,*	(tibadr) for a subchannel?
	tze	gme010-*	no
	ldx2	t.metr,1	yes, get pointer to its meters
	ilq	m.synl	this is how much space they take up
	stq	gmelen-*
	tra	gme020-*
gme010	ldx2	a.s002-*	whole fnp, get addr (.mdilc)
	ilq	.mleng	size of metering area
	stq	gmelen-*	this is how much to copy
	iaq	14	extra stuff copied from elsewhere
gme020	stq	gmesiz-*	save size
	tsy	a.s003-*,*	getmem
	die	10	please not
	stx3	gmebuf-*	save address of buffer
	ldq	gmelen-*	get copying length
gme030	lda	0,2	copy a word
	sta	0,3
	iacx2	1	move to next
	iacx3	1
	iaq	-1	any more?
	tnz	gme030-*	yes
	rem
	szn	a.s001-*,*	(tibadr) for a subchannel?
	tnz	gme040-*	yes
	rem		no, fill in some extra fnp-wide stuff
	ldx2	a.s010-*	addr (.crbdt)
	ldaq	0,2	get bootload time
	staq	0,3
	ldaq	2,2	all 4 words of it
	staq	2,3
	ldx2	a.s011-*,*	(.crsked) get pointer to idle meters
	ldaq	0,2	this is 8 words
	staq	4,3
	ldaq	2,2
	staq	6,3
	ldaq	4,2
	staq	8,3
	ldaq	6,2
	staq	10,3
	ldaq	a.s012-*,*	(yelcnt) get edac error count
	staq	12,3
	rem
gme040	ldx2	a.s004-*	addr (dcws) -- put dcw list in usual place
	stx2	a.s005-*,*	dcwadr
	ila	4	set length
	sta	a.s006-*,*	dcwlen
	rem
	ldx3	gmesx3-*	get mailbox pointer
	lda	sm.cd,3	get cs address
	ilq	diaftc	fnp -> cs transfer
	staq	0,2
	lda	gmebuf-*	get pointer to data
	ora	l.s001-*	0,w.2 for dia
	ldq	gmesiz-*	get data length
	qrs	1	in 36-bit words
	staq	2,2	rest of dcw
	iacx2	4	point to place for next dcw
	cx2a		but bdisc wants it in x3
	cax3
	tsy	a.s007-*,*	(bdisc) disconnect dcw
	ila	tcmetr	set transaction control word
	sta	a.s008-*,*	tcword
	tsy	a.s009-*,*	conect
	return	gmeter
	rem
	rem
a.s001	ind	tibadr
a.s002	ind	.mdilc
a.s003	ind	getmem
a.s004	ind	dcws
a.s005	ind	dcwadr
a.s006	ind	dcwlen
a.s007	ind	bdisc
a.s008	ind	tcword
a.s009	ind	conect
a.s010	ind	.crbdt
a.s011	ind	.crskd
a.s012	ind	yelcnt
	rem
l.s001	zero	0,w.2
	rem
	rem
gmebuf	bss	1	address of temporary space for meters
gmesiz	bss	1	size of same
gmelen	bss	1	length to copy from metering area
	ttls	makdly -- allocate new delay table
	rem
	rem	this subroutine takes a list of delay values and associates
	rem	them with a given line. It does this by searching the chain of delay
	rem	tables starting at .crdly, and if it finds one matching the
	rem	supplied values it increases its reference count; if
	rem	none is found, it chains a new one on to the end. t.dtp is
	rem	updated accordingly.
	rem
	rem	input:
	rem	   x1 -> virtual tib address
	rem	   x2 -> array of 6 delay values
	rem
	rem
makdly	subr	mak,(x2,x3)
	rem
	ilq	dl.siz-dl.hsz	count of values
	ldx3	maksx2-*	use x3 for tbl clobberably
mak010	szn	0,3	find out if all are zero
	tnz	mak020-*	clearly not
	iacx3	1	check next
	iaq	-1	are there more?
	tnz	mak010-*	yes
	ila	0
	cax3		indicate no table
	tra	mak030-*	and go delete old one
	rem
mak020	null
	ldx3	a.p001-*	addr (.crdly) -- start looking at existing tables
	ilq	dl.siz-dl.hsz	table size
	tsy	a.p004-*,*	(=cmptbl) x2 -> table
	tra	mak040-*	didnt find it, x3 is last
	rem		come here if corresponding table already exists
	cmpx3	t.dtp,1	already in use by this line?
	tze	makret-*	yes, nothing to do
	aos	dl.rfc,3	up the reference count
	rem
mak030	null		here to update t.dtp and free old table
	tsy	deldly-*	free old one
	stx3	t.dtp,1	save it in tib
	rem
makret	return	makdly
mak040	null		table does not already exist
	ilq	dl.siz	allocate a new block
	tsy	a.p002-*,*	=newtbl
	tra	mak030-*
	rem
	ttls	deldly -- free delay table
	rem
	rem	frees delay table pointed to by t.dtp
	rem	if reference count > 1, just reduces it
	rem
	rem	x1 -> virtual tib address
	rem
	rem
deldly	subr	dld,(x3)
	rem
	ilq	dl.siz	use delay tbl size
	cx1a		use t.dtp
	iaa	t.dtp
	cax3		get tbl ptr in x3
	tsy	deltbl-*
	return	deldly
	rem
	rem	delete any table
	rem	delay or echnego
	rem	x1 = tib (not used)
	rem	x3 = ptr to tib tbl ptr word
	rem	q = size of table (for fremem)
	rem
deltbl	subr	del,(x1,x2,x3,q)
	ldx3	0,3	is there an old table?
	tze	delret-*	no, forget it
	rem
	lda	dl.rfc,3	anyone else using it?
	iaa	-1
	sta	dl.rfc,3	decrement ref count
	tnz	delret-*	someone else wants it, leave it alone
	rem
	ldx1	dl.bck,3	get pointer to previous block
	ldx2	dl.fwd,3	and next one
	tze	2	is no next one
	stx1	dl.bck,2	if there is, attach it to previous one
	stx2	dl.fwd,1	correct previous block's forward ptr
	rem		note: even if freed block is first one, its
	rem		backptr points to .crdly or .cretb
	rem
	rem		q has right size at this point.
	tsy	a.p003-*,*	=fremem
	rem
delret	return	deltbl
	rem
	rem
	rem
a.p001	ind	.crdly
a.p002	ind	newtbl
a.p003	ind	fremem
a.p004	ind	cmptbl
	rem
	ttls	table sharing routines
	rem
	rem	compare tables for sharing
	rem	x1 => tib (saved, not used)
	rem	x2 => values in table
	rem	x3 -> chain head
	rem	q = size of table data
	rem
cmptbl	subr	cmt,(x2,q)
	rem
cmt010	null
	lda	0,3	get next in chain
	tze	cmt050-*	there are no more
	sta	cmtbuf-*
	cax3		find out if this one matches new one
	iacx3	dl.hsz	start at first value
cmt020	lda	0,2
	cmpa	0,3	values equal?
	tze	cmt030-*	yes, look at next
	ldx3	cmtbuf-*	no, see if there are more in chain
	ldx2	cmtsx2-* restore pointer to first value
	ldq	cmtsq-*	restore count
	tra	cmt010-*
	rem
cmt030	iaq	-1	checked all values?
	tze	cmt040-*	yes, we've found matching table
	iacx2	1	no, move to next value
	iacx3	1
	tra	cmt020-*	and test again
	rem
cmt040	ldx3	cmtbuf-*
	aos	cmptbl-*
cmt050	return	cmptbl
	rem
cmtbuf	bss	1
	rem
	rem
	rem	subr to allocate a new table
	rem	x2 -> table data
	rem	x3 -> end of previous chain
	rem	q = data size, incl.header
	rem	return x3 -> new block
	rem
newtbl	subr	nwt,(x2,x3,q)
	rem
	tsy	a.p501-*,*	=getmem
	die	10	if we can't get one, horrors.
	stx3	nwttmp-*	this is the new one
	rem
	ldx2	nwtsx3-*	thread it to previous one
	stx2	dl.bck,3
	stx3	dl.fwd,2
	ila	1	initialize reference count
	sta	dl.rfc,3
	iacx3	dl.hsz	point to first value
	ldx2	nwtsx2-*	restore pointer to supplied values
	ldq	nwtsq-*	get table length
	iaq	-dl.hsz	dont copy the header!
nwt010	lda	0,2
	sta	0,3
	iaq	-1	got 'em all ?
	tze	nwt020-*	yes
	iacx2	1	no, get another
	iacx3	1
	tra	nwt010-*
nwt020	null
	ldx3	nwttmp-*
	stx3	nwtsx3-*
	return	newtbl
	rem
a.p501	ind	getmem
nwttmp	bss	1
	rem
	ttls	makecn - make echnego table
	rem
	rem	make an echo negotiation bit table
	rem	try to share it like a delay table
	rem
	rem
makecn	subr	mnt,(x2,x3)
	rem
mnt010	null
	ldx3	a.y001-*	addr (.cretb) -- start looking at existing tables
	ilq	ecnlen	table size
	tsy	a.y002-*,*	(=cmptbl) x2 -> table
	tra	mnt040-*	didnt find it, x3 is last
	rem		come here if corresponding table already exists
	cmpx3	t.entp,1	already in use by this line?
	tze	mnt030-*	yes, nothing to do
	aos	dl.rfc,3	up the reference count
	rem
mnt020	null		here to update t.dtp and free old table
	tsy	deletb-*	free old one
	stx3	t.entp,1	save it in tib
	rem
mnt030	return	makecn
mnt040	null		table does not already exist
	ilq	dl.hsz+ecnlen	allocate a new block
	tsy	a.y003-*,*	=newtbl
	tra	mnt020-*

	rem
a.y001	ind	.cretb
a.y002	ind	cmptbl
a.y003	ind	newtbl
	rem
	rem	Free echo negotiation table
deletb	subr	dle,(x3)
	rem
	ilq	dl.hsz+ecnlen
	cx1a
	iaa	t.entp
	cax3
	tsy	a.y501-*,*	(=deltbl)
	return	deletb
	rem
a.y501	ind	deltbl
	rem
	ttls	ecgifl  -- echnego input flush (to 6180)
	rem	send icp chains off to dcp chain (dia queue)
	rem	so echnego sync requests work.
	rem
ecgifl	subr	ecf
	rem
	szn	t.icp,1	do we have an icp chain?
	tze	ecfret-*
	ilq	accin	send accept input
	tsy	a.y601-*,*	(denq)
ecfret	return	ecgifl
	rem
a.y601	ind	denq
	rem
	ttls	rblast -- subroutine to set up dcw for reading blast message
	rem
	rem	mailbox address passed in x3
	rem	address field of mailbox (word 10) points to
	rem	6-buffer area containing blast message in three languages
	rem	(two buffers per message)
	rem
rblast	subr	rbl,(x3)
	ldx2	a.t003-*	(dcws)
	stx2	a.t004-*,*	(dcwadr) tell conect to use usual dcw place
	ila	4
	sta	a.t005-*,*	dcwlen
	rem
	lda	sm.adr,3	get cs address
	ilq	diactf	read cs opcode
	staq	0,2	into dcw
	ilq	6*bufsiz	get three double buffers together
	tsy	a.t001-*,*	(getbfh)
	die	10	oh my god
	sta	a.t007-*,*	(blbuf) for dtrans
	ilq	3*bufsiz	3 buffers worth of 36-bit words
	staq	2,2	put in dcw
	lda	l.t005-*	=absflg
	orsa	3,2	put absolute address flag in dcw
	iacx2	4	next dcw
	cx2a
	cax3		into x3 for bdisc
	tsy	a.t006-*,*	(bdisc) build disconnect dcw
	return	rblast	done
	ttls	acusr -- subroutine to handle dial out request
	rem
	rem	this routine sets the tfacu flag in the tib and then
	rem	it copies the phone number that has been passed
	rem	to the fnp in the command data portion of the mailbox
	rem	into a buffer (coverting the 6bit bcd into 9bit)
	rem	and invokes the control table interpreter at the test state
	rem	entry.
	rem
acusr	subr	acu
	rem
	lda	t.flg3,1	was the channel masked?
	cana	l.t006-*	=tfmask
	tze	acu005-*	no
	tsy	a.t008-*,*	(hunmsk) if so, unmask it now
acu005	null
	rem
	trace	mt.acu,tr.mbx,(sm.cdl(3),sm.cd(3),sm.cd+1(3),sm.cd+2(3),s
	etc	m.cd+3(3))
	rem
	lda	l.t001-*	(tfacu)
	orsa	t.flg2,1	set flag on
	rem		now to get a buffer
	lda	sm.cdl,3	get number of digits
	ana	l.t007-*	(low-order 9 bits only)
	tpl	acu010-*	must be at least 1 digit
	die	8	bad acu request, stop
	rem
acu010	null
	cx3a		getbuf restores all but x3
	cax2		x2 will contain addr of mailbox
	ilq	bufsiz	get a buffers worth
	tsy	a.t001-*,*	(getbuf)
	die	10	no buffers means bad problems
	stx3	t.ocp,1	remember absolute addr of buffer
	ldq	sm.cdl,2	get number of digits
	qls	9	reduce to lower half-word only
	qrl	9
	stq	1,3	store as tally in buffer
	iacx3	bf.dta	set x3 to addr of data part of buffer
	iacx2	sm.cd	set x2 to addr of command data part of mailbox
	rem
	rem		now to copy 6bit chars from mailbox into
	rem		9bit chars in buffer. number of characters
	rem		to move is in q.
	rem
	cx2a
	ora	l.t002-*	(0,c.0) change x2 to 6bit chars
	cax2
	cx3a
	ora	l.t003-*	(0,b.0) change x3 to 9bit chars
	cax3
	rem
acumvc	null
	lda	0,2,c.0	load 6bits right justified (other bits of q are zeroed)
	sta	0,3,b.0	store rightmost 9bits
	iacx2	0,c.1	move 1 char to right
	iacx3	0,b.1	move 1 byte to right
	iaq	-1	decrement count of digits remaining
	tpl	acumvc-*	stop when count goes to zero
	tsy	a.t002-*,*	(itest)
	return	acusr
	rem
a.t001	ind	getbuf
a.t002	ind	itest	"test_state" entry of interpreter
a.t003	ind	dcws
a.t004	ind	dcwadr
a.t005	ind	dcwlen
a.t006	ind	bdisc
a.t007	ind	blbuf	place to store address of blast buffers
a.t008	ind	hunmsk
	rem
l.t001	vfd	18/tfacu
l.t002	zero	0,c.0	for setting '6bit char mode'
l.t003	zero	0,b.0	for setting '9bit char mode'
l.t004	zero	0,w.2	for setting 36-bit mode
l.t005	vfd	18/absflg
l.t006	vfd	18/tfmask
l.t007	oct	000777
	rem
	ttls	fetch -- subroutine to get next item to satisfy an rcd
	rem
	rem	this routine first checks error message queue;
	rem	otherwise entry is taken from queue for a tib
	rem	inputs: none
	rem
	rem	outputs:
	rem	x2: pointer to queue entry
	rem
fetch	subr	fet,(a,q,x3)
	rem
	szn	a.o001-*,*	(=errqbf) anyting in error queue?
	tze	fet010-*	no
	lda	a.o002-*	(=errqtb) addr of simulated tib table
	sta	a.o007-*,*	(=curque)
	tra	fet050-*
	rem
fet010	null
	ldx2	dqcur-*	look at tib table entry whose turn it is
	tnz	fet020-*	if it's never been set,
	ldx2	a.o004-*,*	set it to .crttb
fet020	null
	cmpx2	a.o003-*,*	(.crtte) time to wrap around?
	tnz	2
	ldx2	a.o004-*,*	.crttb
	rem
	szn	qbuf,2	is there a queue for this line?
	tnz	fet040-*	yes, go get something out of it
fet030	null
	iacx2	2	look at next tib entry
	cmpx2	dqcur-*	have we gone all the way around?
	tnz	fet020-*
	die	9	yes, spurious rcd
	rem
fet040	stx2	a.o007-*,*	(=curque) save current tib table entry
fet050	tsy	a.o008-*,*	(=getqhd) get head of queue
	die	8	queue can't be empty
	rem
	lda	0,2	pick up first word of entry
	tpl	fet060-*	not already picked up
	ldx2	a.o007-*,*	pick up current queue
	tra	fet030-*	back tp bump to next
fet060	iana	255	mask down to opcode
	tnz	2	make sure it's more or less legal
	die	8
	rem
	lda	l.o001-*	(=400000) set active bit
	orsa	0,2
	ldx3	a.o007-*,*	(curque) get current tib table entry
	cmpx3	a.o002-*	(errqtb) is it error queue?
	tze	fetbak-*	yes
	iacx3	2	bump i/o queue to next tib
	stx3	dqcur-*
fetbak	return	fetch
	rem
	rem
a.o001	ind	errqbf
a.o002	ind	errqtb
a.o003	ind	.crtte
a.o004	ind	.crttb
	rem
a.o006	ind	dlqent
a.o007	ind	curque
a.o008	ind	getqhd
	rem
l.o001	oct	400000
	rem
dqcur	ind	0	pointer to entry in tib table whose turn it is
	ttls	getque -- finds entry in tib i/o queue list
	rem
	rem	this subroutine finds the entry in the tib i/o queue list
	rem	for a given tib
	rem
	rem	input:
	rem	a: real tib address
	rem
	rem	output:
	rem	x2: address of entry in list
	rem
	rem	if there is none, we will crash
	rem
getque	subr	gtq
	rem
	ldx2	a.o004-*,*	(.crttb) get pointer to tib table base
gtq010	null
	cmpa	qtib,2	is this the one?
	tze	gtqbak-*	yes, we got it
	iacx2	2	no, look at next
	cmpx2	a.o003-*,*	(.crtte)
	tnz	gtq010-*	if there are any more
	die	22	else crash
	rem
gtqbak	stx2	a.o007-*,*	(=curque) save current queue addr
	return	getque
	ttls	reject -- subroutine to reschedule rejected accept input
	rem
	rem	this subroutine finds the rejected accept input for the tib
	rem	pointed to by x1, marks it "rejected", and schedules
	rem	dretry routine to try it again a second later
	rem
	rem	x1 - virtual tib address
	rem
reject	subr	rej
	lda	a.q001-*,*	(tibadr) need real tib address for getque
	tsy	getque-*
	rem		x2 -> tib queue entry
	tsy	a.q004-*,*	(=getqai) find first accept input
	die	16	better be one
	szn	a.q005-*,*	(=nonnai) better be nothing before it
	tze	2
	die	16
	rem
	lda	0,2	is there a quit or hangup behind it?
	cana	l.q001-*	=quitfl
	tze	rej040-*	no
	tsy	a.q002-*,*	(cleanq) yes, remove all accept inputs
	rem		from queue
	tra	rejbak-*
	rem
rej040	null		mark entry rejected
	ora	l.q002-*	=rejflg
	sta	0,2
	ldx1	a.q001-*,*	(tibadr) need real address for dspqur
	ldaq	l.q003-*	delay time, priority, and address of dretry
	tsy	a.q003-*,*	dspqur
	rem
rejbak	return	reject
	rem
	rem
a.q001	ind	tibadr	real tib address
a.q002	ind	cleanq
a.q003	ind	dspqur
a.q004	ind	getqai
a.q005	ind	nnonai
	rem
l.q001	vfd	18/quitfl
l.q002	vfd	18/rejflg
	even
l.q003	vfd	12/1,6/rtprty	delay time, priority, and address
	ind	dretry	for scheduling dretry
	ttls	cleanq -- remove accept inputs from queue with a reject
	rem
	rem	this routine is called to remove all accept input requests
	rem	from a line's i/o queue so that quits and hangups will go
	rem	through although an input request has been rejected
	rem
	rem	input:
	rem	     x1: virtual tib address
	rem	     x2: address of first accept input in queue
	rem
cleanq	subr	cle,(a,q,x2,x3)
	rem
	lda	t.dcp,1	free any input chain(s)
	tze	cle003-*
	tsy	a.r001-*,*	frelbf
	stz	t.dcp,1
	stz	t.dlst,1
	stz	t.dcpl,1
cle003	null
	lda	t.icp,1
	tze	cle006-*
	tsy	a.r001-*,*
	stz	t.icp,1
	stz	t.ilst,1
	stz	t.icpl,1
	rem
cle006	null
	lda	a.q005-*,*	(=nnonai) number of queue entries before first accin
	sta	savnai-*	will need this in a second
	tsy	a.r003-*,*	(=dlqent) delete the accept inpuut
cle010	tsy	a.r004-*,*	(=getqai) find first accept input again
	tra	cle020-*	none, queue is clean
	tsy	a.r003-*,*	(=dlqent) delete this accept input
	tra	cle010-*	back to find another
cle020	lda	a.q005-*,*	(=nnonai) this is total entries now in queue
	sba	savnai-*	subtract out number before the first accin
	rem		that used to be there and get the number
	rem		if new mailboxes needed
	tze	2	were none, do nothing
	asa	a.r002-*,*	qcnt
	rem
	return	cleanq
	rem
	rem
a.r001	ind	frelbf
a.r002	ind	qcnt
a.r003	ind	dlqent
a.r004	ind	getqai
	rem
savnai	bss	1
	ttls	incnt -- subroutine to get input character count
	rem
	rem	this subroutine gets count of input characters
	rem	for "accept input" in order to send the count to the
	rem	cs
	rem	it also sets the "break" flag in the mailbox if appropriate
	rem
	rem	x1 -- virtual tib address
	rem	x3 -- mailbox address
	rem
incnt	subr	inc,(x2,x3)
	rem
	stz	icount-*	initialize character count
	stz	iflags-*	and break char flag
	stz	nbufs-*	and buffer count
	lda	a.h001-*	addr (tallys)
	sta	tallyp-*	initialize temporary tally array pointer
	lda	t.dcp,1	point to beginning of input chain
	rem
inc010	null
	aos	nbufs-*	bump buffer count
	tsy	a.h003-*,*	setbpt
	cax2		get virtual address
	lda	bf.tly,2	get tally from buffer
	ana	l.h001-*	=buftmk
	tnz	2	if it's zero, something's very wrong
	die	21
	rem
	asa	icount-*	add it into count
	sta	tallyp-*,*	save it in temporary array
	aos	tallyp-*	bump array pointer
	lda	bf.flg,2	is break flag in buffer on?
	cana	l.h002-*	=bffbrk
	tze	inc020-*
	ilq	1
	stq	iflags-*	yes, turn it on in mailbox
	rem
inc020	null		last buffer?
	cana	l.h003-*	=bfflst
	tze	inc030-*	no, go to next
	rem		else we're done
	trace	mt.inc,tr.que,(icount,t.line(1))
	rem
	szn	t.ocp,1	is there any kind of output chain?
	tnz	inc025-*
	szn	t.ocur,1
	tze	inc040-*	no
	rem
inc025	ila	2	yes, set flag in command data
	orsa	iflags-*
	rem
inc040	lda	iflags-*	store flags
	sta	sm.fcd,3
	lda	icount-*	get total char count
	icmpa	mbxmax	will it fit in mailbox?
	tmi	inc050-*	yes, go copy the data
	sta	sm.ict,3	no, put the char count in the mbx
	lda	a.h002-*	addr (sm.dcw)+1
	sta	incdcw-*	initialize pointer to dcws in mbx
	ila	0
	ldq	nbufs-*	get number of buffers in chain
	staq	sm.nbf,3	put it in mbx
	rem		we'll count it in q
	lda	a.h001-*	reinitialize pointer to temp array of tallies
	sta	tallyp-*
	rem
inc045	lda	tallyp-*,*	get next tally
	sta	incdcw-*,*	store it in mbx
	iaq	-1	count it
	tze	incbak-*	finished when we reach zero
	aos	tallyp-*	bump pointers
	ila	2
	asa	incdcw-*
	tra	inc045-*	back for next one
	rem
inc050	ila	inmbx	change opcode
	als	9	to "input in mailbox"
	iora	rcd	(keep it rcd)
	sta	sm.op,3
	cx3a
	ada	l.h006-*	(sm.dat,b.0) point x3 at mailbox data area
	cax3
	lda	t.dcp,1	point x2 at input chain
	sta	oldhed-*	save it for later freeing
	stz	icount-*	start count over
inc060	tsy	a.h003-*,*	setbpt
	cax2
	lda	bf.tly,2
	ana	l.h001-*	buftmk
	asa	icount-*	keep count of total number
	stx2	ibufp-*	remember current buffer address
	caq		hold running count in q
	cx2a
	ada	l.h007-*	(bf.dta,b.0) get pointer to data in buffer
	cax2
inc080	lda	0,2,b.0	get a character form the buffer
	sta	0,3,b.0	store it in mailbox
	iacx2	0,b.1	bump pointers
	iacx3	0,b.1
	iaq	-1	count the character
	tnz	inc080-*	if more, go get the next one
	ldx2	ibufp-*	no more, get buffer pointer back in x2
	lda	bf.flg,2	last one?
	cana	l.h003-*	bfflst
	tnz	inc090-*	yes, wrap it up
	lda	bf.nxt,2	no, get forward pointer
	tra	inc060-*	process next buffer
	rem
inc090	null
	lda	icount-*	get final count
	ldx3	incsx3-*	get saved mailbox address
	sta	sm.ict,3
	aos	shinp-*	set flag showing short input in progress
	rem
incbak	return	incnt
	rem
inc030	null
	lda	bf.nxt,2
	tnz	inc010-*	go process next buffer
	rem		if there isn't one, something's wrong
	die	11
	rem
	rem
	rem
	rem
a.h001	ind	tallys	pointer to tally array
a.h002	ind	sm.dcw+1,3	pointer to lower half of dcws
a.h003	ind	setbpt
	rem
	rem
l.h001	vfd	18/buftmk
l.h002	vfd	18/bffbrk
l.h003	vfd	18/bfflst
l.h004	oct	777774
*l.h005	unused
l.h006	zero	sm.dat,b.0
l.h007	zero	bf.dta,b.0
l.h008	oct	777000
	rem
nbufs	bss	1	number of buffers processed so far
icount	bss	1	number of characters processed
iflags	bss	1	flags for sending back to multics
increm	bss	1	amount by which tally has beeen adjusted
itally	bss	1
ibufp	bss	1
shinp	bss	1	global dia_man flag indicating short input transaction
tallyp	bss	1	pointer to current element of tally array
incdcw	bss	1	pointer to current pseudo-dcw in mailbox
tallys	bss	24	temporary array of buffer tallies
	ttls	indata -- sets up dcw list for rtx
	rem
	rem	this subroutine sets up a dcw list for sending
	rem	an input chain to the cs
	rem	the mailbox in "savmbx" has the following information
	rem	in (18-bit) words 8-11:
	rem
	rem	word 8:	second address or 0
	rem	word 9:	second tally or 0
	rem	word 10:	data address
	rem	word 11:	tally
	rem
	rem	words 8 and 9 are only used if cs is supplying
	rem	two addresses because of wraparound in its circular
	rem	input buffer
	rem
	rem	tallies are in characters
	rem
	rem	x1: virtual tib address
	rem
indata	subr	ind
	ldx3	a.i001-*	addr(dcws)
	stx3	a.i002-*,*	dcwadr
	stx3	curdcw-*	initialize dcw pointer
	stz	a.i003-*,*	initialize dcwlen
	ldx3	a.i004-*	addr(savmbx) -- get mailbox address
	rem
	lda	t.dcp,1	get pointer to first buffer
	sta	oldhed-*	hang on to it for later freeing
	iacx3	sm.dcw	point to dcw array in mbx
	stx3	pdcwa-*
	stz	nblks-*	initialize this too
	rem
ind010	null
	sta	curabs-*	save absolute address of current buffer
	tsy	a.i008-*,*	setbpt
	cax2		get virtual address
	lda	bf.siz,2	find out how many blocks long this buffer is
	arl	15
	iaa	1
	asa	nblks-*	keep running count
	lda	bf.tly,2	get buffer tally
	ana	l.i001-*	=buftmk
	caq		put tally in q
	lda	curabs-*	recover buffer address
	iaa	bf.dta	get fnp address in a
	tsy	indcw-*	make the dcw
	rem
	lda	bf.flg,2	is this last buffer?
	cana	l.i002-*	=bfflst
	tnz	ind050-*	yes,finish up
	lda	bf.nxt,2	no, get next buffer
	tnz	ind010-*
	die	11	 bad news if there isn't one
	rem
ind050	null		no more input buffers
	ldq	nblks-*
	tsy	instrp-*	take buffers of dcp chain
	ldx3	curdcw-*	get dcw address
	rem		to set timw bit
	rem		and make interrupt and disconnect dcws
	tsy	a.i007-*,*	wtimw (which updates x3 itself)
	tsy	a.i005-*,*	bint
	iacx3	4
	tsy	a.i006-*,*	bdisc
	ila	8	update dcw length
	asa	a.i003-*,*	dcwlen
	return	indata	all done
	rem
	ttls	indcw -- build dcw for indata
	rem
	rem	input:
	rem	a -- fnp address
	rem	q -- tally in characters
	rem
	rem	curdcw contains address of dcw to be built
	rem	pdcwa contains pointer to next pseudo-dcw
	rem	   containing cs address
	rem	both of these are to be updated
	rem	as is dcwlen (no. of 36-bit words in dcw list)
	rem
indcw	subr	inw,(a,q,x3)
	rem
	ldx3	curdcw-*	get dcw pointer
	iaq	3	convert tally to words
	qrs	2	(words = (char+3)/4)
	staq	2,3	put tally and fnp address in dcw
	lda	l.i003-*	=absflg
	orsa	3,3	mark dcw for absolute addressing
	ldaq	pdcwa-*,*	get next absolute cs address
	llr	6	get low-order 18 bits in a
	qls	12	isolate high-order part of address
	qrl	6	it ends up in bits 24-29 of dcw
	staq	0,3	store in dcw
	rem
	ila	diaftc	get opcode (fnp -> cs transfer)
	orsa	1,3	store in dcw
	ila	4
	asa	curdcw-*	update dcw pointer
	ila	2	and list length
	asa	a.i003-*,*	dcwlen
	asa	pdcwa-*
	return	indcw	that's all
	ttls	instrp -- subroutine to strip input buffers of t.dcp chain
	rem
	rem	removes input buffers that have been sent from t.dcp chain
	rem	and adjusts t.dcpl accordingly
	rem
	rem	input:
	rem	q -- number of buffers in chain sent
	rem
instrp	subr	ins,(q)
	lda	t.dcpl,1	we've removed some blocks from t.dcp chain
	sba	inssq-*	this many
	sta	t.dcpl,1
	lda	bf.nxt,2	save next-pointer from last buffer
	sta	t.dcp,1	will be head of next input chain
	tnz	2	if there isn't another chain,
	stz	t.dlst,1	kill tail pointer
	stz	bf.nxt,2	zero next-pointer so chain can be freed
	return	instrp
	ttls	storage for indata and indcw
	rem
a.i001	ind	dcws
a.i002	ind	dcwadr
a.i003	ind	dcwlen
a.i004	ind	savmbx
a.i005	ind	bint
a.i006	ind	bdisc
a.i007	ind	wtimw
a.i008	ind	setbpt
	rem
	rem
l.i001	vfd	18/buftmk
l.i002	vfd	18/bfflst
l.i003	vfd	18/absflg
	rem
	rem
oldhed	bss	1	head of input chain being sent
curdcw	bss	1	address of current dcw
pdcwa	bss	1	address of current pseudo-dcw in mailbox
blimit	bss	1	highest allowed cs address + one
nblks	bss	1	number of 32-word blocks used by input chain
curabs	bss	1	absolute address of current buffer
	rem
	ttls	rddcw -- set up dcw list to read cs dcw list
	rem
	rem	this subroutine is called when a decoded mailbox
	rem	contains a wtx command
	rem
	rem	the mailbox contains (in words 10-11) the address
	rem	and length (in 36-bit words) of a cs dcw list
	rem	for transmitting the output data
	rem
	rem	this routine creates dia dcw list to read the cs
	rem	dcw list (the "pseudo-dcws") into a static area
	rem
	rem	x3 contains the mailbox address
	rem
rddcw	subr	rdw,(x3)
	rem		set up dcw address and length for conect
	ldx2	a.j001-*	addr(dcws)
	stx2	a.j002-*,*	dcwadr
	ila	4
	sta	a.j003-*,*	dcwlen
	rem
	ldaq	sm.adr,3	get address and length of cs dcw list
	cmpa	blimit-*	make sure it's probably in buffer area
	tnc	rdw010-*	it isn't
	stq	ndcws-*	save length
	stq	3,2	put tally in dcw
	ilq	diactf	get cs->fnp transfer opcode
	staq	0,2	put it in dcw
	rem
	lda	a.j006-*	get address of pseudo-dcw area (pdcws)
	sta	2,2	put in fnp address of dcw
	rem
	iacx2	4	bump dcw pointer
	cx2a		copy it into x3 to make disconnect dcw
	cax3
	tsy	a.j005-*,*	bdisc
rdwbak	return	rddcw	all done
	rem
rdw010	die	20
	rem
	ttls	rddata -- set up dcw list to read output data
	rem
	rem	this subroutine uses the pseudo-dcws read from
	rem	the cs by rddcw to set up a dia dcw list for
	rem	reading in the output data itself
	rem
	rem	the dcws will be built in a static area (dcws) and
	rem	a chain of buffers will be allocated for the data
	rem
rddata	subr	rdd
	rem
	ldx1	a.j001-*	(dcws) get address of dcw list area
	stx1	a.j002-*,*	(dcwadr) setup dcw list address for conect
	lda	ndcws-*	length of dcw list is
	iaa	1	2*(ndcws+1) because of disconnect dcw
	als	1
	sta	a.j003-*,*	(dcwlen) setup dcw list length for conect
	rem
	ldx2	a.j006-*	get pointer to first pseudo-dcw
	stz	rhead-*	init head of chain addr
	stz	rtail-*	init tail of chain addr
	lda	ndcws-*	get number of dcws
	iera	-1	negate it
	iaa	1
	sta	dcwcnt-*	init loop counter
	rem
rdd010	null
	ldq	1,2	get character tally
	tnz	2	zero ain't posssible
	die	20
	iaq	67	4 chars overhead + 63 to round up
	qrs	6	divide by 64 (chars per buffer)
	qls	bufshf	multiply by words per buffer
	tsy	a.j004-*,*	getbfh
	tra	rdd030-*	failed, go clean up
	caq		put new buffer addr in q
	lda	rtail-*	get addr of prev buffer
	tze	rdd015-*	no prev buffer
	tsy	a.j009-*,*	setbpt
	cax3
	stq	bf.nxt,3	chain to next buffer
	tra	2
rdd015	stq	rhead-*	save head of chain
	stq	rtail-*	save tail of chain
	cqa		put new buffer addr in a
	tsy	a.j009-*,*	setbpt
	cax3		convert it into x3
	rem
	lda	0,2	get cs address from pseudo-dcw
	tze	rdd040-*	zero address is unlikely to be right
	cmpa	blimit-*	so is one below the buffer area
	tnc	rdd040-*
	ilq	diactf	cs -> fnp transfer opcode
	staq	0,1	put in dcw
	lda	1,2	get character tally
	orsa	bf.tly,3	put it in buffer
	iaa	3	convert to words
	ars	2	right-adjust
	ora	l.j002-*	=absflg
	lrs	18	and put in q
	lda	rtail-*	get absolute buffer address
	iaa	bf.dta	get pointer to output buffer data
	staq	2,1	put fnp address and tally in dcw
	rem
	iacx1	4	point to next place for dcw
	aos	dcwcnt-*	increment loop counter
	tze	rdd020-*	done if zero
	iacx2	2	get addr of next pseudo-dcw
	tra	rdd010-*	build next dcw
	rem
rdd020	null		through building dcws
	rem		except for disconnect
	cx1a		put addr of next dcw ...
	cax3		in x3 (for bdisc)
	tsy	a.j005-*,*	bdisc
	aos	rddata-*	give success return
	rem
rddbak	return	rddata
	rem
rdd030	null		couldn't allocate enough data buffers
	lda	rhead-*	must free data buffers
	tze	rddbak-*	none allocated yet
	tsy	a.j008-*,*	frelbf
	tra	rddbak-*	cleanup and take error exit
	rem
rdd040	die	20
	ttls	storage for rddcw and rddata
	rem
a.j001	ind	dcws	static dcw list area
a.j002	ind	dcwadr	conect's address of base of dcw list
a.j003	ind	dcwlen	length of dcw list (36-bit words)
a.j004	ind	getbfh	subroutine to get a buffer from high memory
a.j005	ind	bdisc	subroutine to make a disconnect dcw
a.j006	ind	pdcws	address of static pseudo-dcw area
a.j007	ind	frebuf	subroutine to release a single buffer
a.j008	ind	frelbf	subroutine to free linked list of buffers
a.j009	ind	setbpt	subroutine to convert buffer address to 15-bit
	rem
	rem
l.j001	vfd	18/buftmk
l.j002	vfd	18/absflg	absolute address ing in dcw
	rem
	rem
ndcws	bss	1	number of cs dcws in list
rhead	bss	1	address of head of allocated output chain
rtail	bss	1	address of last buffer in allocated chain
dcwcnt	bss	1	dcw loop counter
	even
pdcws	bss	16*2	space for reading in pseudo-dcws
	ttls	bint -- builds an "interrupt cs" dcw
	rem
	rem	interrupt cell assignment has been set by init
	rem	from configuration status
	rem
	rem	x3 points to dcw to be built
	rem
bint	subr	bin
	rem
	ldaq	intdcw-*	get interrupt cell and opcode
	staq	0,3
	lda	l.z001-*	0,w.2
	ilq	0
	staq	2,3	this stuff will be ignored, but should be 36-bit
	return	bint
	rem
	ttls	bdisc -- builds a "disconnect" dcw
	rem
	rem	a "disconnect" dcw will be put at the address
	rem	pointed to by x3
	rem
bdisc	subr	bdi
	rem
	ila	0
	ilq	diadis	disconnect opcode
	staq	0,3
	lda	l.z001-*	0,w.2 (make unused fnp address 36-bit addressing)
	ilq	0
	staq	2,3
	return	bdisc
	rem
l.z001	zero	0,w.2
	rem
	even
intdcw	oct	0
dindcw	vfd	12/0,6/diainc	interrupt cell is or'ed in at init time
	rem
	ttls	lock and unlock -- control the dia lock
	rem
	rem	no new dia activity is initiated while the dia
	rem	lock is locked
	rem
lock	subr	loc,(inh)
	rem
	szn	dilock-*	lock already locked?
	tze	2
	die	14	yes, we shouldn't be locking it again
	rem
	lda	lock-*	no, lock it with address of caller
	sta	dilock-*
	return	lock
	rem
	rem
	rem
unlock	subr	unl,(inh)
	rem
	szn	dilock-*	is it unlocked?
	tnz	2
	die	15	then we shouldn't be trying to unlock it
	rem
	stz	dilock-*	unlock it now
	return	unlock
	rem
	rem
dilock	oct	0	dia lock
	rem
	ttls	conect -- connect to the dia
	rem
	rem	this subroutine is called when it's time to
	rem	do a connect to the dia
	rem
	rem	it must:
	rem		store the address and tally (36-bit words)
	rem		of the dcw list in the list icw
	rem
	rem		calculate parity on all the dcws in the list
	rem
	rem		put the list icw address in the pcw mailbox
	rem
	rem		issue the connect
	rem
	rem	dcwadr is preset with the address of the dcw list
	rem	dcwlen is preset with the number of 36-bit words
	rem	this is so that in case of an i/o error we can
	rem	just use the same dcw list again
	rem
conect	subr	con,(inh)
	rem
	lda	a.k003-*,*	globsw
	cana	l.k005-*	(gbfhng) is anyone listening at other end?
	tnz	conbak-*	no, don't bother doing connect
	rem
	lda	dcwadr-*	get pointer to head of list
	cax2
	ora	l.k004-*	0.w,2
	ldq	dcwlen-*	get length
	staq	lsticw-*
	rem
	rem		now calculate parity on dcws
	rem		set bit 21 to be odd parity with bits 0-17
	rem		then set bit 22 to be odd parity with bits 18-35
	rem
con010	null
	lda	l.k001-*	=npbits
	ansa	1,2	turn them both off first
	lda	0,2	get high-order word
	alp	18	get parity
	tnz	con020-*	already odd, do nothing
	lda	l.k002-*	=pupper
	orsa	1,2	or on upper parity bit
	rem
con020	null
	lda	1,2	get second word
	alp	18
	tnz	con030-*	if already odd, don't bother it
	lda	l.k003-*	=plower
	orsa	1,2	or on lower parity bit
	rem
con030	null		on to next dcw word
	iaq	-1	any more?
	tze	con040-*
	iacx2	2	yes, bump pointer
	tra	con010-*	go around again
	rem
con040	null		parity all set
	ldaq	licadr-*	get address and parity of list icw
	staq	a.k001-*,*	(dimb) dia pcw mailbox
	rem		refresh status icw
	ldaq	sticw-*	clean status icw model
	staq	a.k002-*,*	(dist) dia status icw
	ila	1	indicate that connect is pending
	sta	a.k004-*,*	iopend
	rem
	rem
diasel	sel	**	patched by init for correct channel
	cioc	a.k001-*,*	dimb (dia pcw mailbox)
	rem		that's it
conbak	return	conect
	rem
	rem
a.k001	ind	dimb	dia pcw mailbox
a.k002	ind	dist
a.k003	ind	globsw
a.k004	ind	iopend
	rem
l.k001	vfd	18/npbits
l.k002	vfd	18/pupper
l.k003	vfd	18/plower
l.k004	zero	0,w.2	36-bit addressing
l.k005	vfd	18/gbfhng
	rem
	rem
	even
lsticw	icw	dcws,w.2,4	list icw
dlist	null		init uses this to do parity calculations
sticw	icw	stat,w.2,1,1	dia status icw template
	rem		with exhaust bit so we always see latest one
	rem
	even
licadr	zero	lsticw,w.2	list icw address
	oct	70	init will or in parity
	rem
dcwadr	bss	1	address of dcw list
dcwlen	bss	1	length of dcw list (36-bit words)
	even
dcws	bss	4*28	place where most dcw lists are created
	rem
	ttls	wmbx -- write a mailbox to the cs
	rem
	rem	this subroutine writes a mailbox to the cs after
	rem	computing the checksum and storing it in the mailbox
	rem
	rem	a contains address of mailbox to be written, which
	rem	will first be copied into swmbx
	rem	if a is 0, mailbox is already in swmbx, and
	rem	is being rewritten because of checksum error
	rem
	rem	mailbox number in mbxno will be used by wtimw
	rem	to determine what bit to set in cs's
	rem	"terminate interrupt multiplex word" (timw)
	rem	and the mailbox size
	rem
wmbx	subr	wmb
	rem
	cax3		get mailbox address
	tze	wmb020-*	if zero, use swmbx
	rem		else we'll copy it in
	lda	mbxno-*
	icmpa	8	fnp or cs origin?
	tmi	3	cs
	ila	-fmbxsz/2	fnp, use large size
	tra	2
	ila	-8	get repetition count
	sta	rcnt-*
	iera	-1	now make it positive
	iaa	1
	sta	wsize-*
	ldx2	a.l001-*	addr(swmbx)
	rem
wmb010	null
	ldaq	0,3	pick up two words of mailbox
	staq	0,2	copy them
	aos	rcnt-*	is that all?
	tze	wmb020-*
	iacx2	2	no, bump input and output pointers
	iacx3	2
	tra	wmb010-*	do it again
	rem
wmb020	null		set transaction control word
	szn	a.l011-*,*	shinp
	tze	3	if "short input", set it to
	ila	tcinmb	"sent input in mailbox"
	tra	2	else, set it
	ila	tcwmbx	to "wrote mailbox"
	sta	a.l002-*,*	tcword
	rem
	rem		now set up dcw list
	trace	mt.wmb,tr.mbx,(mbxno)
	rem
	ldx3	a.l004-*	addr(dcws)
	stx3	a.l005-*,*	dcwadr
	ila	10	10 words of dcws
	sta	a.l006-*,*	dcwlen
	rem
	lda	mbxno-*	get mailbox number
	icmpa	8	cs mailbox?
	tmi	wmb030-*	yes
	iaa	-8	no, get it in range 0-3
	mpy	l.l004-*	(fmbxsz) use fnp size
	cqa
	iaa	mh.fsb	add base of fnp mailbox area
	tra	wmb040-*
wmb030	null
	als	3	for cs mailbox, use mailbox no. times 8
	iaa	mh.sub	and offset of submailbox 0
wmb040	null
	ada	csmbx-*	add address of cs mailbox header
	ilq	diaftc	fnp->cs transfer opcode
	staq	0,3	cs address and opcode into dcw
	rem
	lda	a.l001-*	get addr(swmbx) in a
	ora	l.l001-*	0,w.2
	ldq	wsize-*	tally for writing mailbox
	staq	2,3	into dcw
	iacx3	4	point to next dcw
	rem		call subroutine to update timw
	tsy	wtimw-*
	rem		dcw pointer is also updated
	rem		now put in interrupt and disconnect dcws
	tsy	a.l007-*,*	bint
	iacx3	4
	tsy	a.l008-*,*	bdisc
	rem		all done, now just connect
	tsy	a.l009-*,*	conect
	return	wmbx
	rem
	ttls	frembx -- tells cs a mailbox is free
	rem
	rem	this subroutine sets up a dcw list to or on 
	rem	the bit corresponding to a mailbox being frees in the
	rem	cs's "terminate interrupt multiplex word" (timw)
	rem
frembx	subr	fre
	rem		set transaction control word
	ila	tcfree	to "mailbox freed"
	sta	a.l002-*,*	tcword
	rem
	trace	mt.fre,tr.mbx,(mbxno)
	rem
	lda	mbxno-*	cs or fnp mailbox?
	icmpa	8
	tmi	fre010-*	cs
	icmpa	12	fnp, rewritten or not?
	tmi	2	yes
	iaa	-4	no, get number in range 8-11
	iaa	-8	now get it in range 0-3
	cax3
	stz	a.l012-*,*	(mbxfre,3) mark it free
	ila	-1	decrement used count
	asa	a.l015-*,*	mbused
	tsy	a.l013-*,*	(unlock) unlock dia now
	tsy	a.l014-*,*	(gate) make sure dgetwk runs
	tra	frebak-*	no need to tell multics anything
fre010	null
	ldx3	a.l004-*	addr(dcws)
	stx3	a.l005-*,*	dcwadr
	ila	8	8 words of dcws
	sta	a.l006-*,*	dcwlen
	tsy	wtimw-*	set up dcws to update timw
	rem		set up interrupt and disconnect dcws
	tsy	a.l007-*,*	bint
	iacx3	4
	tsy	a.l008-*,*	bdisc
	rem		do connect now
	tsy	a.l009-*,*	conect
frebak	return	frembx
	rem
	ttls	wtimw -- sets up dcws to update timw
	rem
	rem	this subroutine sets up dcws to "or" in a bit
	rem	corresponding to the mailbox number in "mbxno"
	rem	to the cs's "terminate interrupt multiplex word" (timw)
	rem
	rem	we will use the dia opcode "transfer gate", which means
	rem	"read and clear cs and or fnp",
	rem	followed by fnp->cs transfer
	rem
	rem	x3 contains address of first dcw to be built
	rem	on return it will point to next free spot in dcw list
	rem
wtimw	subr	wti
	rem
	lda	l.l002-*	"arl 0" instruction
	ora	mbxno-*	make it "arl [mbxno]"
	sta	wti010-*	store it where we'll execute it
	rem		get high-order bit for shifting
	lda	l.l003-*	=400000
	rem		shift it
wti010	zero		shift instruction goes here
	sta	timw-*	result will be new timw
	rem		now set up dcws
	lda	csmbx-*	cs address of mailbox header
	iaa	mh.tim	+offset of timw
	ilq	diatrg	"transfer gate" opcode
	staq	0,3
	ilq	diaftc	second dcw is same but with fnp->cs transfer
	staq	4,3
	rem
	lda	a.l010-*	addr(timw),w.2
	ilq	1	tally of one 36-bit word
	staq	2,3	this is for both dcws
	staq	6,3
	rem
	iacx3	8	update dcw pointer
	return	wtimw	that's all
	rem
	ttls	storage for wmbx, frembx, wtimw
	rem
a.l001	ind	swmbx
a.l002	ind	tcword
*a.l003		unused
a.l004	ind	dcws
a.l005	ind	dcwadr
a.l006	ind	dcwlen
a.l007	ind	bint
a.l008	ind	bdisc
a.l009	ind	conect
a.l010	zero	timw,w.2
a.l011	ind	shinp	"short input" flag
a.l012	ind	mbxfre,3
a.l013	ind	unlock
a.l014	ind	gate
a.l015	ind	mbused
	rem
	rem
l.l001	zero	0,w.2
l.l002	arl	0	template for shift of [mbxno] bits
l.l003	oct	400000
l.l004	zero	fmbxsz/2
	rem
	rem
wsize	bss	1	size of this mailbox (in 36-bit words)
	even
timw	bss	2	fnp's copy of cs timw
rcnt	bss	1	repetition count for copying mailbox
mbxno	bss	1	mailbox number
	rem
	even
swmbx	bss	56	mailbox to be written
	rem
	ttls	dia configuration region
	rem
	rem
	even
cspab	oct		port a and port b
cspcd	oct		port c and port d
csmbx	oct		cs mailbox address
csics	oct		cs interrupt cell switch
cslwa	oct		lower address bounds switches
	rem		(bits 0-8)
csupc	oct		upper address bounds switches
	rem		(bits 0-8)
	rem		bit 15 - store timer
	rem		bit 16 - address bounds
zerwd	oct	0,0	36 bit zero word for end-of-file
cssca	oct		cs system controller address
	rem
dicell	equ	csics
dmbx	equ	csmbx
diconf	equ	cspab
	ttls	qmask -- clear out a queue for masked channel
	rem
************************************************************
*
*	This routine is called when it's time to add a
*	"mask channel" entry to a dia request queue. First
*	it clears out whatever is currently in the channel's
*	queue, and frees its t.dcp chain, if any.
*	It is called by denq when a linmsk op code is passed
*	to it, unless there's a currently active accept input in
*	in the queue; in the latter case, it is called by deque
*	when the accept input is finished. in either case, it is
*	the caller's responsibility to worry about decrementing
*	qcnt to account for the removed queue entries.
*
*	input:
*	     x1: virtual tib address
*	     curque points to corresponding tib table entry
*
************************************************************
	rem
qmask	subr	qma,(a,q,x2,x3)
	rem
	ldx3	a.m001-*,*	curque
qma010	ldx2	qbuf,3	get pointer to first entry in queue
	tze	qma020-*	none left
	stx2	curqbf-*	make sure dlqent knows where to look
	tsy	a.m002-*,*	(dlqent) remove it
	tra	qma010-*	do next one
qma020	lda	t.dcp,1	if any queued input,
	tze	qma030-*
	tsy	a.m003-*,*	(frelbf) not any more
	stz	t.dcp,1
	stz	t.dcpl,1
	stz	t.dlst,1
qma030	ilq	linmsk	get opcode
	tsy	a.m004-*,*	adqent
	aos	a.m005-*,*	(qcnt) update queue count
	tsy	a.m006-*,*	(gate) make sure dgetwk runs
	return	qmask
	rem
a.m001	ind	curque
a.m002	ind	dlqent
a.m003	ind	frelbf
a.m004	ind	adqent
a.m005	ind	qcnt
a.m006	ind	gate
	ttls	subroutines to manage dia queues
	rem
************************************************************
*
*	One dia queue is maintained for each tib as well
*	as one for an error queue.
*	each queue consists of blocks linked
*	together with one entry per block.
*
*	format of first word of a dia queue entry
*
*	*******************************
*	*         *     *             *
*	* flags   * cnt *  opcode     *
*	*         *     *             *
*	*******************************
*	0        5 6   8 9           17
*
*	followed by the number of data words specified in count
*
*	format of a block in the dia queue
*
*	word 0 (qbnext) - address of next buffer in chain
*	                  0 specifies end of chain
*	word 1 (qbsize) - size of this block in words
*	word 2 (qbdata) - queue entries start here
*
************************************************************
	rem
*	define buffer addresses
	rem
qbnext	equ	0	addr of next buffer
qbsize	equ	1	number of words in this block
qbdata	equ	2	data starts here
	rem
*	the queue handling routines set and/or depend on the
*	following variables:
	rem
curque	bss	1	must contain the address of the tib
	rem		table entry for the current queue
curqbf	bss	1	address of buffer that contains current
	rem		queue entry
curqln	bss	1	current line number, set for trace
nnonai	bss	1	set by getqai to indicate the number
	rem		if non-accept input queue entries
	rem		before the first accept input entry
	eject
************************************************************
*
*	adqent - subroutine to add a new entry to a dia queue
*
*	at input, the q contains the dia opcode in the lower
*	half and, if data is to be passed, the word count
*	in the upper half. if the word count is non-0,
*	x2 must contain the address of the data.
*
*	this subroutine can be called by derrq at interrupt time,
*	and therefore must run inhibited
*
*	there are no outputs.
*
************************************************************
	rem
adqent	subr	adq,(inh,a,q,x2,x3)
	cqa		first word of queue entry
	ars	9	get word count
	iaa	1	allow 1 word for opcode
	sta	adqsnw-*	save number of words required
	rem
*	the new entry goes in the last buffer, so find it
	rem
	ldx2	curque-*	tib table entry
	ldx3	qbuf,2	get buffer pointer
	tze	adq010-*	no buffers, go allocate one
adq030	szn	qbnext,3	is this last buffer?
	tze	adq010-*	yes
	ldx3	qbnext,3	follow thread
	tra	adq030-*
	rem
*	must allocate a new buffer for this entry
	rem
adq010	stx3	adqtmp-*	save last buffer address
	lda	adqsnw-*	number of data words
	iaa	3	+1 for chain, +1 for size, +1 for rounding
	iana	-2	force it even
	caq
	tsy	a.u001-*,*	(=getmem) allocate new entry
	die	10
	stq	qbsize,3	save size
	szn	qbuf,2	is this the first buffer for queue
	tze	adq050-*	yes
	ldx2	adqtmp-*	get pointer to old last buffer
	stx3	qbnext,2	complete chain
	tra	adq040-*
adq050	stx3	qbuf,2	store as first buffer in chain
	rem
*	now a buffer has been found where the entry will fit
	rem
adq040	stx3	curqbf-*	this is the new current buffer
	iacx3	qbdata	address of first word to use
	rem
	trace	mt.inq,tr.que,(x3,adqsq,curqln)
	rem
	lda	adqsq-*	pick up opcode from save area
	sta	0,3	store in queue
	iacx3	1	and bump pointer
	ars	9	get number of data words to copy
	tze	adq060-*	none
	ldx2	adqsx2-*	get their address
adq070	ldq	0,2	get a word
	stq	0,3	copy it
	iacx2	1	bump pointers
	iacx3	1
	iaa	-1
	tnz	adq070-*	loop til copied
adq060	szn	curqln-*	was this for s apecific line?
	tze	adqbak-*	no, skip metering
	rem
	ldx3	t.metr,1
	cmeter	mincs,m.cql,l.u001-*
	cmeter	mupdat,m.dql,(m.cql(3))
	rem
adqbak	return	adqent	all done
	rem
adqsnw	bss	1
adqtmp	bss	1
	rem
a.u001	ind	getmem
a.u002	ind	fremem
	rem
	rem
l.u001	dec	1	for metering
l.u002	dec	-1	likewise
	eject
************************************************************
*
*	dlqent - suboutine to delete an entry for the queue.
*
*	input - x2 must point at entry to delete
*
************************************************************
	rem
dlqent	subr	dlq,(a,q,x2,x3)
	rem
	cx1a		for a specific line?
	tze	dlq010-*	no, no metering
	ldx3	t.metr,1
	cmeter	mincs,m.cql,l.u002-*
	cmeter	mupdat,m.dql,(m.cql(3))
	rem
dlq010	ldx3	curqbf-*	start of buffer
	ldx2	qbnext,3	hold onto pointer to next buffer
	ldq	qbsize,3
	tsy	a.u002-*,*	(=fremem) free this buffer
	rem
*	rethread the buffer chain
	rem
	lda	curqbf-*	addr of buffer just freed
	ldx3	curque-*	tib table entry
	cmpa	qbuf,3	did we free first buffer in chain
	tnz	dlq040-*	no
	stx2	qbuf,3	yes, next buffer now first
	tra	dlqret-*
dlq040	ldx3	qbuf,3	follow buffer trail
dlq060	cmpa	qbnext,3	does this buffer point to one just freed?
	tze	dlq050-*	yes
	ldx3	qbnext,3
	tra	dlq060-*
dlq050	stx2	qbnext,3	thread out freed buffer
dlqret	return	dlqent
	eject
************************************************************
*
*	getqhd - subroutine to find first entry in a dia queue.
*
*	no inputs
*
*	output - if queue empty, return is inline
*	otherwise, a skip return is done, and x2 will point to the
*	first entry.
*
************************************************************
	rem
getqhd	subr	ghd
	rem
	ldx2	curque-*	current tib table
	ldx2	qbuf,2	first buffer
	tze	ghdret-*	queue empty
	stx2	curqbf-*	this becomes current buffer
	iacx2	qbdata	data starts here
	aos	getqhd-*	found entry, so skip
ghdret	return	getqhd
	rem
	rem
************************************************************
*
*	getqai - subroutine to find first accept input in queue
*
*	output - x2 points to accept input, if found, and
*	a skip return is made. if not found, the return is inline.
*	the variable nnonai is set to the number of queue
*	entries skipped over.
*
************************************************************
	rem
getqai	subr	gai,(a,x3)
	rem
	stz	nnonai-*	zero counter initially
	tsy	getqhd-*	get head of queue
	tra	gairet-*	empty
gai020	lda	0,2	pick up opcode
	iana	255
	icmpa	accin	found it?
	tze	gai010-*	yes
	aos	nnonai-*	count something else
	ldx3	curqbf-*	get block address
	ldx2	qbnext,3	go to next
	tze	gairet-*	if any
	stx2	curqbf-*	this is current buffer now
	iacx2	qbdata	point at data
	tra	gai020-*	check for accin
gai010	aos	getqai-*	skip return, found accin
gairet	return	getqai
	ttls		j u m p  t a b l e s
	rem
	rem
	rem	format:
	rem
	rem	word 0 return addr after interrupt processed
	rem	word 1 place to go on interrupt (in dia_man)
	rem	word 2 ioc#,channel#,module#(3)
	rem
	rem
diajt	null		used to find jump tables for setting up iv's
jmptm	zero		terminate
	tsy	ivp-*,*
	vfd	4/0,8/0,6/trmmod
	rem
	rem		mailbox requests
	jumptb	(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
	rem
ivp	zero	invp
	rem
	rem
enddia	equ	*
	end
  



		    gicb.map355                     11/16/82  1646.0rew 11/16/82  1639.8      161388


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

	lbl	gicb,gicb
	ttl	mcs/fnp intercomputer bootload routine
	ttls	copyright 1970 by honeywell information systems inc.
************************************************************
*
*  note:  cs means "central system"
*
************************************************************
*	change list
*
*	modified to run on dia by rbs june 24, 1972
*	modified for multics boot of fnp by mjg may 25, 1976
*
************************************************************
	pcc	on	print assembler control cards
	pmc	on	print macro expansions
	editp	on	print special edit control characters
	abs		assemble in absolute format
	rem
cksum	macro		checksum calculation macro
	ldx3	2	get return address
	tra	cksum-*	calculate checksum
	ind	*	location of 'here' and 'now'
	endm	cksum
	rem
parity	macro	c,m	dia parity calculation macro
	ldx3	2	get location of dcw
	tsy	parity-*	call parity calculation routine
	ind	#1	location of dia dcw
	endm	parity
	rem
	systm		define system description symbols
	comreg
	ttls	intercomputer symbol definitions
	rem
	rem	dia icw symbol definitions
	rem
csadd	equ	0	cs store address
intopc	equ	1	interrupt cell and op-code
fnpadd	equ	2	fnp address (36 bit data transfer)
tally	equ	3	tally (36 bit words)
	rem
	rem	dia operation code symbol definitions
	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	data transfer from cs to fnp
diawrp	bool	77	wraparound
	ttls	datanet fnp hardware communication region
	rem
	rem	i n t e r r u p t   v e c t o r s
	rem
	rem
	rem		channel 00 interrupt vectors
	rem
	vfd	3/w.2,15/*+2	bootload list icw
	vfd	3/0,1/1,1/1,13/2
	zero
	vfd	18/diadis	disconnect dcw
	zero	0,w.2	with 36 bit xfer mode
	zero
	dup	1,10
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 01 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 02 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 03 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	ind	.rtrn.	spring loaded interrupt vector
	ind	.dia3.	entry for dia on channel 3
	dup	1,13
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 04 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	ind	.rtrn.	spring loaded interrupt vector
	ind	.dia4.	entry for dia on channel 4
	dup	1,13
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 05 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	ind	.rtrn.	spring loaded interrupt vector
	ind	.dia5.	entry for dia on channel 5
	dup	1,13
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 06 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 07 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 08 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 09 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 10 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 11 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 12 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	ind	.rtrn.	spring loaded interrupt vector
	ind	.dia14	entry for dia on channel 14(8)
	dup	1,13
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 13 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 14 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	rem
	rem		channel 15 interrupt vectors
	rem
	ind	.icft.	iom fault vector
	dup	1,15
	ind	.rtrn.	spring loaded interrupt vector
	eject
	rem
	rem	i n t e r r u p t   c e l l s
	rem
	dec	0	level  0
	dec	0	level  1
	dec	0	level  2
	dec	0	level  3
	dec	0	level  4
	dec	0	level  5
	dec	0	level  6
	dec	0	level  7
	dec	0	level  8
	dec	0	level  9
	dec	0	level 10
	dec	0	level 11
	dec	0	level 12
	dec	0	level 13
	dec	0	level 14
	dec	0	level 15
	rem
	rem	i o m   f a u l t   s t a t u s
	rem
	dec	0	channel  0
	dec	0	channel  1
	dec	0	channel  2
	dec	0	channel  3
	dec	0	channel  4
	dec	0	channel  5
	dec	0	channel  6
	dec	0	channel  7
	dec	0	channel  8
	dec	0	channel  9
	dec	0	channel 10
	dec	0	channel 11
	dec	0	channel 12
	dec	0	channel 13
	dec	0	channel 14
	dec	0	channel 15
	eject
	rem
	rem	p r o c e s s o r   f a u l t   v e c t o r s
	rem
	ind	.falt.	startup fault
	ind	.falt.	shutdown fault
	ind	.falt.	memory parity fault
	ind	.falt.	illegal operation code fault
	ind	.falt.	overflow fault
	ind	.falt.	illegal memory operation fault
	ind	.falt.	divide check fault
	ind	.falt.	illegal program interrupt fault
	rem
	rem	i o m   m a i l b o x   c o m m   r e g i o n
	rem
	dec	0	interval timer mailbox
	dec	0	elapsed timer mailbox
diaind	dec	0	indicator storage area for checksum
	dec	0
	even
diasts	dec	0,0	bootload dia status storage area
	vfd	3/w.2,15/diasts	dia status icw
	vfd	3/0,1/0,1/1,1/1,12/2
	ttls	load mcs/fnp system
	rem
icbt10	null
	ldaq	iclist-*	get list icw for mcs load
	ldx1	l.trm2-*	set where to go after loading mcs/fnp
	tra	diaioc-*	initiate mcs/fnp loading
.trm2	ind	**
	rem
	rem	check dia status from mcs/fnp read
	rem
	ldq	diasts+1-*	check second status word
	tnz	icgtsr-*	bad status - e r r o r
	rem
	rem	compute checksum
	rem
	lda	iclmts+1-*	calculate length of mcs
	sba	iclmts-*	*
	cax1		move to index one
	ldi	icindc-*	reset indicator storage
	sti	diaind-*	*
	tra	5	branch around zeroes
	rem
	dec	0	two words of zeroes that must be at loc
	dec	0	474 & 475 so that pager won't be activated
	dec	0	476-477 is dn6670 'yellow' counter and is
	dec	0	 incremented by one for each edac error
	rem
	ldx2	lmcs2-*	get starting location plus two
	ldaq	.mcs.-*	get first two words
	iacx1	-2	reduce length
	cksum		calculate checksum for mcs/fnp
	sbaq	icksma-*	compare cksum to that made by cs system
	tnz	icgtcr-*	***checksum error***
	eject
	rem
	rem	move mcs/fnp system into position
	rem
	lda	iclmts+1-*	calculate end of mcs code
	ada	lmcs-*	*
	cax2		move to index two
	sta	.mov1a-*	store start of .mov1 code
	ldx1	s.mov-*	get beginning of move code
	rem
icbt40	lda	0,1	move
	sta	0,2	the
	iacx1	1	move
	iacx2	1	code
	aos	l.mov-*	reduce counter
	tnz	icbt40-*	not done, continue
	rem
	lda	icintn-*	get execute interrupt cell number
	arl	3	shift off emergency int cell no.
	als	12	position number
	ora	dimbx-*	add in mailbox base address
	cax3		move to index three
	ldx2	iclmts-*	get the start of mcs
	ldx1	lmcs-*	get where it is right now
	tra	.mov1a-*,*	enter move one routine
	eject
	rem
	rem	send unsuccessful bootload status to cs system
	rem
icgtsr	null		dia status error when reading mcs
	lda	.ssts2-*	set to store status error status
	tra	icbt50-*
icgtcr	null		checksum error on mcs data
	lda	.ssts1-*	set to store checksum error status
	ilq	0	clear the q
	tra	icbt50-*
dianfr	null		dia configuration error
	ora	.ssts3-*	set to store configuration error status
	stz	icepc-*	no exception processing for this one
icbt50	null
	aos	icepc-*	reduce exception processing counter
	tmi	icbt10-*	dont give up yet, reissue command
	staq	.sstat-*	store status to be sent to cs
	lda	dimbx-*	calculate location of bootload status
	iaa	6	add offset of bootload status area
	sta	stdcw1-*	store in data transfer dcw
	lda	icintn-*	get execute interrupt cell to set
	arl	3	shift off emergency int cell no.
	als	6	position cell number
	orsa	stdcw2+1-*	store in interrupt dcw
	ldx1	lstsls-*	get length of status dcw block
	parity	stslst	calculate parity for status dcw's
	ldaq	stslst-*	get list icw for status store
	ldx1	l.trm3-*	set where to go after storing status
	tra	diaioc-*	store bad status of the bootload
	eject
	rem
	rem	checksum calculation routine
	rem
cksum	null
	ldi	diaind-*	get the indicators
	tnc	2	test for carry
	adaq	diary-*	carry. simulate awc instruction
	adaq	0,2	add in next word
	sti	diaind-*	save indicators
	iacx2	2	bump data pointer
	iacx1	-2	reduce counter
	tnz	cksum-*	continue to end of block
	tra	1,3	return
	rem
	rem	initiate i/o on dia channel
	rem
diaioc	staq	list-*	set list icw mailbox
	lda	dialst-*	get pointer to list icw
	ilq	56	get command of 70 for pcw
	staq	dimb-*	store in pcw mailbox
	stx1	lditm-*,*	set terminate vector
	ila	2	set word count for parity check
	cax1		*
	parity	dimb	calculate dia parity for pcw mailbox
	cioc	dimb-*	initiate i/o in dia channel
	dis		wait for interrupt
	tra	-1	*
	rem
	rem	calculate dia parity
	rem
parity	ind	**	return address
	ldq	0,3	get first word of dcw
	lda	1,3	get second word of dcw
	qlp	18	calculate parity for 1st word
	tnz	2	odd parity...
	ora	parwd1-*	even - set parity bit
	alp	18	calculate parity for 2nd word
	tnz	2	odd parity...
	ora	parwd2-*	even - set parity bit
	sta	1,3	restore second word with parity bits
	iacx3	2	bump pointer to next pair of words
	iacx1	-2	decrement word count
	tnz	parity+1-*	more to do
	aos	parity-*	increment return pointer
	tra	parity-*,*	and return
	ttls	constants and buffers
	rem
list	equ	298	list icw storage
	rem
stslst	dcw	stdcw1,6	send bootload status list icw
stdcw1	vfd	18/,18/diaftc	data transfer fnp to cs dcw
	dcw	.sstat,1
stdcw2	vfd	18/,18/diainc	interrupt cs dcw
	zero	0,w.2
	zero
	vfd	18/,18/diadis	disconnect dcw
	zero	0,w.2
	zero
lstsls	ind	*-stslst	length of status dcw block
	rem
icepc	dec	-3	exception processing counter
	rem
	even
diary	dec	0,1	cksum carry constant
icindc	oct	024000	indicator register constant
lditm	ind	**	location of dia terminate vector
	rem		(filled in depending on which one gets used)
	rem
parwd1	oct	040000	parity bit for 1st word of dia dcw
parwd2	oct	020000	parity bit for 2nd word of dia dcw
	rem
	even
.sstat	oct	400000,000000	status for successful bootload
.ssts1	oct	410000	status for checksum error on bootload
.ssts2	oct	420000	status for bad status on bootload
.ssts3	oct	430000	status for configuration error
	rem
l.trm2	ind	.trm2	terminate vector when reading mcs/fnp
l.trm3	ind	icbtsp-1	terminate vector for storing status
	rem
.mcs.	equ	512	loading base for mcs/fnp system
lmcs	ind	.mcs.	base of mcs/fnp system
lmcs2	ind	.mcs.+2	location of mcs/fnp loading base + two
dialst	ind	list,w.2	location of  list icw with 36 bit xfer
	rem
	eject
	rem
	rem	move program
	rem
mvllmt	equ	*-4	low limits of mcs
mvhlmt	equ	*-3	high limit of mcs
mvwdct	equ	*-2	word count for mcs
mventy	equ	*-1	entry point for mcs
	rem
.mov1	ldq	0,1	move mcs/fnp system
	stq	0,2	*
	iacx1	1	bump load pointer
	iacx2	1	bump store pointer
	cmpx1	.mov1a-*	everything moved?
	tnz	.mov1-*	no. continue moving
	lda	movchn-*	yes. pass dia channel to init routine
	ldx2	mvhlmt-*	also upper limit of mcs for clearing memory
	ldx1	mventy-*	get entry point of mcs
	tra	-1,1	enter mcs
.mov1a	ind	**	location of .mov1 at end of mcs program
	rem
movchn	oct	0	dia channel will be stored here
s.mov	ind	.mov1	location  of the beginning of move code
l.mov	vfd	18/-movchn+.mov1-1  length of move code (negated)
	eject
	rem
	rem
	rem	* * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem	*  n.b.  the following org means one must be very careful
	rem	*        when adding code above loc 722 (8)
	rem	* * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	org	466
	rem
.icft.	ind	**	dia channel fault
	dis	1	stop on iom fault
	tra	-1
	rem
.falt.	ind	**	processor fault
	dis	2	stop on fault
	tra	-1
	rem
icser	dis	3	bad dia status on bootload
	tra	-1	stop on bad status
	rem
diaksr	dis	4	checksum error on bootload data
	tra	-1	stop on checksum error
	rem
icbtsp	dis	5	unsuccessful bootload attempt
	tra	-1	stop on unsuccessful bootload
	rem
.rtrn.	ind	**	spring loaded vector for
	tra	-1,*	extraneous interrupts
	ttls	future site of bootload communication block
	rem
	org	480
	rem
	dup	1,32	reserve communication area
btcomm	dec	0
	ttls	cs bootload validation
	rem
	org	512
	rem
.dia3.	ind	**	entry when dia is on channel 3
	ila	3
	sta	diachn-*
	stz	.dia3.-*	so as not to gum up checksum
	tra	.icbt.-*
	rem
.dia4.	ind	**	entry when dia is on channel 4
	ila	4
	sta	diachn-*
	stz	.dia4.-*	so as not to gum up checksum
	tra	.icbt.-*
	rem
.dia5.	ind	**	entry when dia is on channel 5
	ila	5
	sta	diachn-*
	stz	.dia5.-*	so as not to gum up checksum
	tra	.icbt.-*
	rem
.dia14	ind	**	entry when dia is on channel 14 (8)
	ila	12
	sta	diachn-*
	stz	.dia14-*	so as not to gum up checksum
	tra	.icbt.-*
	rem
.icbt.	null		start of bootload program
	rem
	rem	check dia status from bootload
	rem
	ldq	diasts+1-*	check second status word
	tnz	icser-*	bad status means bad bootload
	rem
	rem	compute checksum
	rem
	rem
	ldi	icindc-*	reset indicator storage word
	sti	diaind-*	*
	stz	.rtrn.-*	reset interrupt spring vector
	ldx2	sintv2-*	get the start of the interrupt vectors
	ldaq	intvc-*	get the first words which were there
	ldx1	diant1-*	get the first cksum counter
	cksum		calculate cksum 1/4
	ldx1	diant2-*	get second cksum counter
	ldx2	sfltst-*	start of fault status words
	cksum		calculate cksum 2/4
	ldx1	diant3-*	get third cksum counter
	ldx2	sdiast-*	location of dia status icw
	cksum		calculate cksum 3/4
	ldx1	diant4-*	get fourth cksum counter
	ldx2	sdimb4-*	location of dia dcw mailbox plus four
	cksum		calculate cksum 4/4
	staq	temp-*	save checksum
	eject
	rem
	rem	move bootload communication region
	rem
	ldx1	ltbtcm-*	get pointer to temporary comm region
	ldx2	lbtcom-*	get pointer to permenant comm region
	ilq	-32	set counter
btcmov	lda	0,1	move bootload
	sta	0,2	communication block
	iacx1	1	increment
	iacx2	1	block pointers
	iaq	1	reduce counter
	tnz	btcmov-*	continue
	rem
	rem	store dia channel in saved indicators and set
	rem	dia interrupt vector
	rem
	lda	diachn-*	get channel number
	sta	movchn-*	put it where it can be found by move routine
	orsa	icindc-*	put it in select register portion of indicators
	ldi	icindc-*	set the indicators
	als	4	convert to interrupt vector address
	iaa	2
	sta	lditm-*	save it
	rem
	rem	check bootload checksum
	rem
	ldaq	temp-*	get checksum
	sbaq	icksmb-*	compare cksum to that made by cs
	tnz	diaksr-*	...checksum error...
	ldx2	sintv2-*	get pointer to start of interrupt vector
	ldaq	14,2	reset vectors used during bootload
	staq	-2,2	*
	ldaq	12,2	*
	staq	0,2	*
	staq	2,2	*
	eject
	rem
	rem	read dia configuration
	rem
	ldx1	lcnfls-*	get length of configuration dcw block
	parity	cnflst	calculate parity for configuration dcw's
	ldx1	l.trm1-*	set return address for terminate from
	ldaq	cnflst-*	get configuration list icw
	tra	diaioc-*	the configuration read & go initiate i/o
	rem
.trm1	ind	**
	ldq	csmbx-*	get the mailbox address from the switches
	lda	csics-*	get the interrupt cell number
	cmpq	dimbx-*	is it the same as the cs said?
	tnz	dianfr-*	no. configuration error
	rem
	cmpa	icintn-*	compare interrupt cell switches
	tnz	dianfr-*	no good, report error
	rem
	tra	lbt10-*,*	all ok so far, load mcs
	rem
lbt10	ind	icbt10	location of the mcs load routine
	rem
ltbtcm	ind	tbtcom	location of temporary boot comm region
lbtcom	ind	btcomm	location of permanent boot comm region
	even
temp	dec	0,0	temporary storage
	rem
	rem	dia configuration data area
	rem
	even
config	null
cspab	oct		port a and port b
cspcd	oct		port c and port d
csmbx	oct		cs mailbox address
csics	oct		cs interrupt cell switch
cslwa	oct		lower address bounds switches
csupc	oct		upper address bounds switches
	bss	2
	eject
sintv2	ind	intv+2	location of interrupt vectors plus two
sfltst	ind	fltst	location of iom fault status words
sdiast	ind	dist	location of dia status icw
sdimb4	ind	dimb+4	location of dia pcw mailbox plus four
diant1	dec	254	cksum counter for interrupt vector area
diant2	dec	24	cksum counter for flt vctrs & flt status
diant3	dec	2	cksum counter for dia status icw
diant4	ind	end-icbt10-2	cksum counter for bootload program
	rem
cnflst	dcw	*+2,4	configuration list icw
	vfd	18/,18/diardc	read configuration dcw
	dcw	config,4
	vfd	18/,18/diadis	disconnect dcw
	zero	0,w.2
	zero
lcnfls	ind	*-cnflst	length of configuration dcw block
	rem
	rem
l.trm1	ind	.trm1	terminate vector for configuration read
	even
intvc	vfd	3/w.2,15/2	first words of interrupt vector area
	vfd	3/0,1/1,1/1,13/2
	rem
	rem
	date
	ttls	bootload communication block
	rem
tbtcom	even
end	equ	*+32	last location to be included in checksum
	rem		of bootload program
	loc	480
	rem
	rem	mcs/fnp list icw control block
	rem
iclist	dcw	icdcw1,**	list icw
icdcw1	vfd	18/,18/diactf	dcw number one
	vfd	3/w.2,15/.mcs.	load 0 - 8k
	vfd	6/0,12/0
icdcw2	vfd	18/,18/diactf	dcw number two
	vfd	3/w.2,15/.mcs.+8192 load 8 - 16k
	vfd	6/0,12/0
icdcw3	vfd	18/,18/diactf	dcw number three
	vfd	3/w.2,15/.mcs.+16384 load 16 - 24k
	vfd	6/0,12/0
icdcw4	vfd	18/,18/diactf	dcw number four
	vfd	3/w.2,15/.mcs.+24576 load 24 - 32k
	vfd	6/0,12/0
icdcw5	vfd	18/,18/diadis	dcw number five - disconnect
	vfd	18/0,18/0
dimbx	dec	0	cs mailbox address
icintn	dec	0	cs interrupt cells
	dec	0,0	unused
iclmts	dec	0,0	mcs load limits
icksma	dec	0,0	mcs checksum
icksmb	dec	0,0	bootload checksum
	rem
	org	end
diachn	oct	0	dia channel number is deliberately stored
	rem		outside checksum area
	end



		    hsla_man.map355                 09/20/88  1435.9rew 09/20/88  1432.7     1341972


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

* HISTORY COMMENTS:
*  1) change(85-07-29,Cousins), approve(85-10-28,MCR7274),
*     audit(85-07-29,Coren), install():
*     change hardware status queue refresh mechanism
*        to swap between a pair of queues.  This strategy avoids windows in
*        refresh operation during which status can arrive unnoticed.
*  2) change(85-10-28,Cousins), approve(85-10-28,MCR7275),
*     audit(85-10-28,Coren), install():
*     Change suspend/resume strategy to send a PCW with the transmit bit off
*      instead of manipulating ICWs to force an exhaust condition.
*  3) change(85-11-08,Coren), approve(85-11-08,MCR7275),
*     audit(85-11-17,Beattie), install(88-09-20,MR12.2-1115):
*     Make some corrections to the changes for suspend/resume.
*  4) change(85-12-20,Kozlowski), approve(88-08-15,MCR7965),
*     audit(88-09-08,Farley), install(88-09-20,MR12.2-1115):
*     Add support to set speeds of 2400, 4800 and 9600 as required by
*     autobaud_tables.
*  5) change(88-07-22,Beattie), approve(88-08-15,MCR7965),
*     audit(88-09-08,Farley), install(88-09-20,MR12.2-1115):
*     Prepared for installation.
*                                                      END HISTORY COMMENTS

	ttl	hsla_man - multics/fnp (mcs) hsla manager
	ttls	hsla_man - multics/fnp (mcs) hsla manager
	lbl	,hsla_man
	editp	on
	pmc	on
	pcc	off
	base	8
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hsla_man, hsla
*
*	     This is hsla_man, the high speed line
*	adaptor support routine for the multics/fnp
*	communications system (mcs). It is driven by
*	dcw lists supplied by the control_tables and
*	interrupts from the various types of lines
*	connected to the hsla subchannels.
*
*	     Status from the interrupts is not
*	processed at interrupt time, but is queued
*	for later processing. This avoids problems of
*	processing status for a line while the call side
*	is changing parameters about that line.
*
*	coded 9/5/74 by mike grady
*
*	modified 79 jul 20 by art beattie to support dn6670
*	  extended memory.
*
*	modified july 1981 by robert coren to incorporate
*	   dave cousins' code for faster icw switching.
*
*	modified september 1984 by robert coren to fix several bugs:
*	   correct the order of storing icw words;
*	   set flow control characters in first half of a double cct;
*	   resume suspended output on quit;
*	   make mskchn free chains correctly if t.ocur is
*	    a non-first subset of t.ocp;
*	   fix oscan's check for overflowing t.pos with tabs;
*	   make hmode resume output if oflow turned off while
*	    suspended.
*	modified april 1985 by robert coren to make scan subroutine not
*	   use page table entry if buffer address is in low memory.
*
*	modified sept 1985 by D. W. Cousins to do suspend and resume
*	   by turning off the pcw transmit bit instead of forcing
*	   an exhaust condition, which could result in a race with the
*	   hardware.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	tib
	ttls	software communications region, hsla
	sfcm	hsla
	rem
	rem
	hwcm
	rem
	meters
	rem
	hslatb
	csbits
	devtab
	buffer
	rem
hbfnch	equ	bufsiz*2-5	number of real spots in hsla input bfr
	rem
	comreg
	rem
	dlytbl
	ttls
	cctdef
	ttls	symrefs and symdefs
	symdef	hsla	primary sysdef
	symdef	hdcw	dcw list processor
	symdef	hintr	interrupt processor
*	symdef	hbreak	change break list
	symdef	hgeti	get ptr and tally of input bfr
	symdef	hmode	chnage modes entry
	symdef	houtav	output has arrived entry
	symdef	hcfg	change confiuration
	symdef	hslajt	location of hsla jump tables
	symdef	setcct	setcct opblock handler
	symdef	shrcct	shared cct handler
	symdef	hcheck	to start echoing if possible
	symdef	cbufsz	change sf.bsz size for sync pre alloc buffer
	symdef	hunmsk	subroutine to unmask a subchannel
	rem
	rem
	symref	trace
	symref	outprc	processor for output sub-op
	symref	istat	entry in intrp for status
	symref	maskr	return point in control_tables after masking
	symref	itest	test-state entry of control_tables
	symref	invp	interrupt handler in scheduler
	symref	g3wjt	entry to get interrupt info
	symref	dspqur	secondary dispatcher
	symref	mdisp	return to master dispatcher
	symref	secdsp	return to secondary dispatcher
	symref	gettib	entry to get the tib addr
	symref	getbuf	entry to grab a buffer
	symref	getbfh	entry to grab a buffer from high memory
	symref	frebuf	entry to free a buffer
	symref	frebfh	entry to free a buffer in high memory
	symref	frelbf	entry to free a buffer chain
	symref	setbpt	entry to convert buffer address to virtual
	symref	cvabs	entry to convert address to absolute
	symref	denq	queuer for dia man requests
	symref	derrq	queuer for error messages to cs
	symref	meterc	metering subroutine
	symref	getmem
	symref	fremem
	symref	getcmt	get address of carriage mvmt tbl
	symref	inproc	processes input chars for asynchronous lines
	symref	setptw	set up page table word
	symref	mincs
	symref	mincd
	symref	mupdat	metering subroutines
	rem
	rem
	rem
hsla	null
	start	hsla,6
	hslast
	ttls	hsla pcw op-codes and broadside commands
	rem
	rem	pcw command type codes
	rem
pcw.0	bool	000000	command type 0 pcw
pcw.1	bool	200000	cmd type 1 w/broadside
pcw.2	bool	400000	config type 2 async
pcw.3	bool	600000	config type 3 sync
	rem
	rem	op-codes
	rem
p.nop	bool	000000	no operation
p.ris	bool	010000	request input status
p.ros	bool	020000	request output status
p.rcs	bool	030000	request config status
p.msk	bool	040000	set subchannel mask bit
p.rmsk	bool	050000	reset subchannel mask bit
p.sriw	bool	060000	switch receive icw
p.ssiw	bool	070000	switch send icw
p.init	bool	100000	initialize
p.smsk	bool	110000	store subchannel mask register
	bool	120000
	bool	130000
p.rsyn	bool	140000	re-sync the subchannel
p.tlbk	bool	150000	transmit line break
	bool	160000
	bool	170000
	rem
	rem	broadside bits
	rem
pb.rcv	bool	000400	set receive mode
pb.xmt	bool	000200	set xmit mode
pb.wam	bool	000100	set wraparound mode
pb.dtr	bool	000040	set data terminal ready
pb.rts	bool	000020	set request to send
pb.mby	bool	000010	make busy
pb.sxt	bool	000004	set supervisory transmit
pb.tre	bool	000004	set tally runout enable (hdlc)
pb.crq	bool	000002	set call request(acu)
pb.msk	bool	000001
	rem
	rem	pcw type 2 (asynch confiuration) mode bits
	rem
p2.5bt	bool	140000	5-bit characters
p2.6bt	bool	150000	6-bit characters
p2.7bt	bool	160000	7-bit characters
p2.8bt	bool	170000	8-bit characters
p2.mbt	bool	170000	mask for char size field
p2.lpr	bool	000040	lateral parity receive
p2.lps	bool	000020	lateral parity send
p2.lpo	bool	000010	lateral parity odd
p2.icw	bool	000004	two send icw's
p2.cct	bool	000002	cct enable
p2.spr	bool	000001
	rem
	rem
	rem	pcw type 3 (sync config)
	rem
p3.itf	bool	000400	hdlc interframe time fill
p3.beb	bool	000400	bsc ebcdic mode
p3.btr	bool	000200	bsc transparent
	ttls	random bits, flags, and definitions
	rem
	rem	sub-op types for dcw list
	rem
dl.cmd	equ	1	command sub-op
dl.in	equ	2	input sub-op
dl.out	equ	3	output sub-op
dl.rdt	equ	4	read tally sub-op
dl.sup	equ	5	additional command sub-op data
	rem
	rem	sub-op types for config list
	rem
fg.smd	equ	1	set mode bit
fg.rmd	equ	2	reset mode bit
fg.bd	equ	3	change baud rate
	rem
	rem	control tables and cct stuff
	rem
ct.dev	equ	1	offset of dev table ptr
	rem
ttasci	equ	1	t.type value for ascii channels
	rem
linmsk	bool	103
sndout	bool	105	send output op for denq
errmsg	bool	115	error message op for derrq
	rem
	rem
lposhf	equ	5	amount to shift tfoddp to get p2.lpo
lpsshf	equ	3	amount to shift tf8out to get p2.lps
	rem
	rem
h1ch	equ	6	first hsla iom channel number
h3ch	equ	8	last hsla iom channel number
	rem
schdmn	equ	4	module number for scheduler invp
	rem
minsiz	equ	bufsiz	size of smallest asynchronous input pseudo-buffer
	rem
mxntty	equ	32	max number subchannels per hsla
maxtty	equ	mxntty*3	max tty on hslas
	rem
hpri	equ	6	priority of hsla_man hstprc
hprip3	equ	3	high priority for ptro status
hprip2	equ	2	highest priority for >9600 ptro status
	rem
sw.dbg	equ	0	on if debugging the module
	rem
nl	bool	12	new-line
ff	bool	14	form-feed
cr	bool	15	carriage return
tab	bool	11	horizontal tab
etx	bool	3
	rem
bwndow	bool	077000	base address of paging window
	eject
************************************************************************
*
*	format of cct descriptor entry
*	one exists for each shared cct
*
************************************************************************
	rem
cct.nx	equ	0	pointer to next entry
cct.pr	equ	1	pointer to previous entry
cct.ad	equ	2	address of the cct
cct.sz	equ	3	length of the cct
cct.rc	equ	4	referenct count
cct.ln	equ	5	length of descriptor
	rem
	rem
	rem
	rem	equates for echo buffer things
	rem
eb.inp	equ	0
eb.otp	equ	1
eb.tly	equ	2
eb.dta	equ	2
	rem
ebmax	equ	bufsiz*2-5
	ttls	trace types and switches
	rem
tt.dcw	equ	1	trace hdcw calls
tt.pcw	equ	2	trace pcw connects
tt.int	equ	3	trace interrupts
tt.sta	equ	4	trace status
tt.ira	equ	5	trace icw recovery attempt
	rem
	rem
ts.dcw	bool	000002
ts.pcw	bool	000004
ts.int	bool	000010
ts.sta	bool	000020
	ttls	macros for hsla_man
	rem
	rem	macro to generate command bit lookup
	rem
cmdtab	macro
	vfd	1/#2,17/#1
	ife	'#2','c.on',2
	vfd	18/#3
	ife	1,0,1
	vfd	o18//#3
	endm
	rem
	rem	macro to generate pcw lookup table
	rem
pcwtab	macro
	vfd	18/#1
	vfd	18/#2
	endm
	rem
	rem	macro to generate config mode bit lookup table entry
	rem
cfgtab	macro
	vfd	18/#1
	vfd	18/#2
	vfd	18/#3
	ind	#4
	endm
	rem
	rem	macro to generate status lookup tables
	rem
stats	macro
	vfd	18/#1
	ind	#2
	endm
	rem
	rem	macro to setup status match table
	rem
smap	macro
	vfd	18/#1
	vfd	18/#2
	endm
	rem
	rem	macro to do real divide
	rem
dvd	macro
	qls	1
	dvf	#1
	endm
	eject
	rem
	rem	macro to do real multiply
	rem
mpy	macro
	mpf	#1
	lrl	1
	endm
	rem
	rem	generates the odd word of a dn6670 paged data address icw
	rem	  which allows iom to directly address 64k memory.
	rem	uses same format as icw pseudo-op except the address is
	rem	  is not supplied and the third argument must be supplied.
	rem
amicwo	macro
	vfd	2/2,3/#1,1/#3,12/#2
	endm	amicwo
	ttls	hdcw - hsla dcw list processor
	pmc	off
hdcw	subr	dcw,(x1,x2,x3)	save the index regs
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hdcw
*
*	     subroutine called by interpreter to process
*	a dcw list found in the control_tables.
*
*	Upon entry:
*	     x1 - virtual tib address
*	     t.dcwa - address of dcw list
*	     t.dcwl - dcw list length
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get ptr to sfcm
	lda	sf.flg,2	get sfcm flags
	icana	sffech	some echo now?
	tze	dcw004-*	no, go ahead
	rem
	lda	t.dcwl,1	get count of times we've skipped out
	lrl	9	it's in upper half of t.dcwl
	iaa	1	increment it
	icmpa	60	over limit?
	tpl	dcw002-*	yes, force it through
	rem
	lls	9	restore lower half of word
	sta	t.dcwl,1	update count
	ilq	7	meter delayed processing
	tsy	a.a008-*,*	meterc
	tra	dcwret-*	done here for now
	rem
dcw002	ila	sffech	we're going to force this off
	iera	-1
	ansa	sf.flg,2
	rem
	ila	pb.xmt	transmit mode too
	iera	-1
	ansa	sf.pcw,2
	rem
	ilq	8	meter overriding of sffech
	tsy	a.a008-*,*	meterc
	rem
dcw004	ila	-1	we're going to process dcw list
	arl	9	wipe out count in upper half of t.dcwl
	ansa	t.dcwl,1
	rem
dcw005	lda	t.dcwl,1	look for real work to be done
	tnz	2	sure, go do it.
	die	8
	rem
	ldx3	sf.hsl,2	get pointer to hsla table entry
	ldx3	ht.tib,3	get real tib address for trace
	trace	tt.dcw,ts.dcw,(x3,t.dcwa(1),t.dcwl(1))
	rem
	ldx3	t.dcwa,1	get ponter to dcw list
	lda	0,3	get first dcw
	arl	18-3	shift to get type
	icmpa	dl.cmd	is it a command dcw?
	tze	dcw010-*	yes, go process it
	rem
	icmpa	dl.in	is it input sub-op?
	tze	dcwret-*	yes, done
	rem
	icmpa	dl.rdt	is it a read tally sub-op?
	tze	dcwret-*	yes, done
	rem
	tsy	bldobf-*	look for output sub-op
	rem
	tra	dcwret-*	all done.
	rem
dcw010	ldq	l.a005-*	(=p.ris) get request input status op
	stq	dcwpcw-*	save for later
	rem
	lda	t.stat,1	pick up tib status
	ana	l.a001-*	(=tsfxmt&tsfrcv) isolate rcv and xmt
	sta	dcwst-*	and save for later, also
	rem
	lda	a.a001-*	(=cmdtab) get addr of cmd table
	sta	cmdls-*	set for subr to use
	lda	a.a002-*	(=cmdend) get end of table addr
	sta	cmdle-*	also for subr
	tsy	cmdprc-*	process the command op
	rem
	szn	t.dcwl,1	any more dcw list left?
	tze	dcw020-*	no, done
	rem
	ldx3	t.dcwa,1	yes, get addr of dcw list
	lda	0,3	get the dcw
	arl	18-3	shift down to look at type
	rem
	icmpa	dl.sup	is it a supplemental cmd op?
	tnz	dcw020-*	no, continue
	rem
	lda	a.a011-*	(=suptab) get addr of sup table
	sta	cmdls-*	set for subr process
	lda	a.a012-*	(=supend) end of cmd table
	sta	cmdle-*	set also for subr
	tsy	cmdprc-*	process sup cmd op
	rem
dcw020	lda	dcwst-*	get the old rcv & xmt modes
	ana	l.a003-*	(=tsfrcv) old rcv mode only
	era	l.a003-*	(=tsfrcv) ^old rcv mode now
	cana	t.stat,1	^oldrcv&rcv, did we just enter rcv?
	tze	dcw030-*	no, continue...
	rem
	lda	sf.flg,2	synchronous line?
	cana	l.a010-*	=sffsyn
	tze	dcw025-*	no, don't set message size
	ldq	sf.mms,2	get max message size
	stq	sf.rms,2	reset residual message size
	rem
dcw025	tsy	bldibf-*	go setup rcv data
	rem
	lda	l.a011-*	get control rcv mask
	iera	-1	invert bits
	ansa	t.flg2,1	turn off control rcv
	rem
dcw030	lda	t.stat,1	get the tib status
	cana	l.a004-*	(=tsfxmt) in xmit mode?
	tze	dcw035-*	no
	rem
	szn	sf.ob0,2	get addr of first output
	tnz	dcw035-*	output still ready, skip
	szn	sf.ob1,2	check second
	tnz	dcw035-*	likewise
	rem
	tsy	bldobf-*	yes, setup output buffers
	tra	dcw040-*	done
	rem
dcw035	lda	t.stat,1	get new xmit mode setting
	ana	l.a004-*	(=tsfxmt) leave only xmit mode
	era	l.a004-*	(=tsfxmt) invert for ^xmit
	cana	dcwst-*	^xmit&oldxmit, did we just leave xmit mode?
	tze	dcw040-*	no, continue
	rem
	lda	l.a008-*	(=sffstp) get bit to indicate this
	ldx2	t.sfcm,1	get ptr to sfcm and
	orsa	sf.flg,2	turn it on in the sfcm
	rem
dcw040	lda	l.a007-*	(=tsfbrk) shd we send line break?
	cana	t.stat,1	line break?
	tze	dcw050-*	no, skip it
	rem
	ldq	l.a006-*	(=p.tlbk) transmit line break op
	stq	dcwpcw-*	reset default op code
	rem
	iera	-1	complement tsfbrk
	ansa	t.stat,1	and turn it off in tib
	rem
dcw050	ldx2	t.sfcm,1	get ptr to sfcm
	ldx3	a.a003-*	(=pcwtab) get ptr to pcw table
	lda	l.a014-*	(pb.msk) preserve "masked" bit
	ansa	sf.pcw,2	init rest of pcw to zero
	rem
dcw055	lda	t.stat,1	get tib status bits
	cana	0,3	is this one on in tib?
	tze	dcw060-*	no, jump out
	rem
	lda	1,3	get pcw broadside bit
	orsa	sf.pcw,2	and or it into or pcw
	rem
dcw060	iacx3	pcwlen	add in table element size
	cmpx3	a.a004-*	(=pcwend) at end of table?
	tnz	dcw055-*	no, loop
	rem
	lda	t.flg,1	check for suspended output
	cana	l.a012-*	=tfosus
	tze	dcw070-*	not suspended, all is well
	lda	l.a013-*	=^pb.xmt
	ansa	sf.pcw,2	if suspended we don't want xmit now
	rem
dcw070	lda	dcwpcw-*	get the op-code
	tsy	a.a007-*,*	do a connect
	rem
	szn	t.dcwl,1	any more dcw list now?
	tze	dcwret-*	no, done
	rem
	lda	dcwpcw-*	get pcw just sent
	cmpa	l.a006-*	(=p.tlbk) sent line break?
	tnz	dcwret-*	no, done
	rem
	ldx3	t.dcwa,1	get addr of dcw list
	lda	0,3	get the next dcw
	arl	18-3	shift into position
	icmpa	dl.cmd	is it command?
	tze	dcw005-*	yes, process it now
	rem
dcwret	return	hdcw	all done, go back
	rem
	rem
dcwpcw	bss	1	(altrd) save pcw op-code for connect
dcwst	bss	1	(altrd) status save for old rcv and xmt
	rem
	rem
l.a001	vfd	18/tsfxmt+tsfrcv tib rcv and xmt
l.a002	vfd	o18/400000	on/off bit in cmdtab
l.a003	vfd	18/tsfrcv	tib receive alone
l.a004	vfd	18/tsfxmt	tib transmit alone
l.a005	vfd	18/p.ris	request input status op-code
l.a006	vfd	18/p.tlbk	transmit line break op-code
l.a007	vfd	18/tsfbrk	tib transmit line break
l.a008	vfd	18/sffstp	stop channel bit
l.a009	oct	077777
l.a010	vfd	18/sffsyn
l.a011	vfd	18/tfcrcv
l.a012	vfd	18/tfosus
l.a013	vfd	o18//pb.xmt
l.a014	vfd	18/pb.msk
	rem
	rem
a.a001	ind	cmdtab	command bit lookup table
a.a002	ind	cmdend
a.a003	ind	pcwtab	pcw bit lookup table
a.a004	ind	pcwend
a.a005	ind	outprc	output sub-op processor
a.a006	ind	seticw	setup icw's subr
a.a007	ind	cioc	connect routine
a.a008	ind	meterc
*a.a009        unused
a.a011	ind	suptab
a.a012	ind	supend
	rem
	ttls	command and pcw lookup tables
	rem
	rem	command table
	rem
cmdtab	null
	cmdtab	c.srec,c.on,tsfrcv
	cmdtab	c.rrec,c.off,tsfrcv
	cmdtab	c.sxmt,c.on,tsfxmt
	cmdtab	c.rxmt,c.off,tsfxmt
	cmdtab	c.sdtr,c.on,tsfdtr
	cmdtab	c.rdtr,c.off,tsfdtr
	cmdtab	c.ssup,c.on,tsfsxt
	cmdtab	c.rsup,c.off,tsfsxt
	cmdtab	c.stat,c.on,tsfst
	cmdtab	c.sbrk,c.on,tsfbrk
	cmdtab	c.smrk,c.on,tsfmrk
	cmdtab	c.strm,c.on,tsftrm
	cmdtab	c.srqs,c.on,tsfrts
	cmdtab	c.rrqs,c.off,tsfrts
cmdend	equ	*
	rem
suptab	null
	cmdtab	c.scrq,c.on,tsfcrq
	cmdtab	c.rcrq,c.off,tsfcrq
supend	equ	*
	rem
cmdlen	equ	2
	rem
c.on	equ	0
c.off	equ	1
	rem
	rem	pcw table
	rem
pcwtab	null
	pcwtab	tsfrcv,pb.rcv
	pcwtab	tsfxmt,pb.xmt
	pcwtab	tsfdtr,pb.dtr
	pcwtab	tsfrts,pb.rts
	pcwtab	tsfsxt,pb.sxt
	pcwtab	tsfcrq,pb.crq
pcwend	equ	*
	rem
pcwlen	equ	2
	ttls	cmdprc - subr to process cmd op from list
cmdprc	subr	cpr,(x1,x2)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	cmdprc
*
*	     this subroutine is internal proc for hdcw
*	which processes type 1 and 5 dcw cmd blocks.
*	it is list driven.
*
*	upon entry:
*	     x1 - virtual tib address
*	     cmdls - points to head of list
*	     cmdle - points to end of list
*
*	returns:
*	     tib flags set
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	cmdls-*	get addr of command table
cpr010	lda	0,3	pick up cmd bits
	ana	l.a009-*	leave only the cmd bits
	cana	0,2	is this cmd bit on in dcw?
	tze	cpr030-*	no, continue loop
	rem
	lda	0,2	look at function bit
	cana	l.a002-*	(=400000) is it on?
	tnz	cpr020-*	yes, we want to turn bit off in tib
	rem
	lda	1,2	pick up t.stat bits
	orsa	t.stat,1	and turn them on in the tib
	rem
	tra	cpr030-*	go look for more work
	rem
cpr020	lda	1,2	get the correct bits
	ansa	t.stat,1	and turn them off in the tib
	rem
cpr030	iacx2	cmdlen	increment table ptr
	cmpx2	cmdle-*	at the end of table?
	tnz	cpr010-*	nope, go for more
	rem
	aos	t.dcwa,1	increment dcw list addr
	ila	-1	and decrement the dcw list
	asa	t.dcwl,1	length word
	rem
	return	cmdprc
	rem
cmdls	bss	1
cmdle	bss	1
	ttls	bldobf - build output buffers from dcw list
bldobf	subr	bob,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	bldobf
*
*	     subroutine to build output buffers from
*	an output dcw. called by hdcw.
*
*	upon entry:
*	     x1 - virtual tib address
*	     t.dcwa - addr of output dcw
*	     t.dcwl - length of dcw list
*
*	returns:
*	     a pair of output buffers is ready to connect to.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.dcwl,1	is dcw list gone?
	tze	bobret-*	yes, exit
	rem
	ldx3	t.dcwa,1	get addr of first dcw
	lda	0,3	pick up that dcw
	arl	18-3	get the sub-op type
	icmpa	dl.out	is it output?
	tnz	bobret-*	no, exit
	rem
	tsy	a.a005-*,*	(=outprc) go process output subop
	rem
	ldx2	t.sfcm,1	get sfcm address
	lda	t.flg,1	check for output suspended
	cana	l.b007-*	=tfosus
	tnz	bobret-*	it is, wait for resume char
	tsy	a.a006-*,*	(=seticw) else set up the icw's
	rem
bobret	return	bldobf	all done
	ttls	bldibf - build input buffers
bldibf	subr	bib,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	bldibf
*
*	     this subroutine builds input buffers from dcw
*	list. called by hdcw.
*
*	upon entry:
*	     x1 - virtual tib address
*	     t.dcwa - addr of dcw list
*	     t.dcwl - length of dcw list
*
*	returns:
*	     a pair of input buffers to connect to.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	pick up sfcm addr
	ldx3	sf.hcm,2	pick up addr of hwcm
	rem
	iacx3	h.ric0	add in offset
	stx3	bibicw-*	save ptr to icw
	ldx3	t.sfcm,1	get ptr to sfcm again
	iacx3	sf.ib0	add in offset of ib1
	stx3	bibibp-*	and save taht too
	rem
	lda	sf.flg,2	get sfcm flags
	icana	sffcii	which icw is active?
	tze	bib010-*	primary, use it first
	rem
	ila	h.ric1-h.ric0	get diff
	asa	bibicw-*	add to save to get right one
	ila	sf.ib1-sf.ib0	get other diff
	asa	bibibp-*	and update ptr
	rem
bib010	tsy	rboibf-*	setup old input buffer
	rem
	ila	sfhmk	pick up icw mask
	ersa	bibicw-*	switch icw ptr to alt
	ila	sfbfmk	pick up buffer mask
	ersa	bibibp-*
	rem
	lda	t.flg2,1	get tib flags
	cana	l.b015-*	(=tfcrcv) control rcv mode?
	tze	bib020-*	no, need another buffer
	rem
	stz	bibibp-*,*	zero input buffer ptr
	ldx3	bibicw-*	get icw addr
	lda	a.b009-*	(=bnispc) get addr of spare word
	ldq	l.b008-*	(=450000) get exhausted tally
	staq	0,3	set icw
	tra	bibret-*	done
	rem
bib020	tsy	bnibuf-*	build a new input buffer
	rem
bibret	return	bldibf	all done in here
	rem
	rem
	rem
bibibp	bss	1	(altrd) ptr to sf.ib0/1
bibicw	bss	1	(altrd) ptr to icw1/2
bibcnt	bss	1	(altrd) count for cct copy
bibabs	bss	1	(altrd) absolute ptr to reused buffer
bibvir	bss	1	(altrd) virtual pointer to reused buffer
	rem
	rem
l.b001	vfd	18/bufsmk	buffer size code mask
l.b002	zero	minsiz
l.b003	vfd	18/sffsyn
l.b004	vfd	18/tffrmi
l.b005	zero	0,b.1
l.b006	vfd	18/tfifc
l.b007	vfd	18/tfosus
l.b008	oct	450000
l.b009	vfd	18/bfflst
l.b010	ind	0,b.0
l.b011	vfd	18/buftmk
	even
*l.b012	unused
l.b013	vfd	18/tfabf0
l.b014	vfd	18/tfabf1
l.b015	vfd	18/tfcrcv
l.b016	vfd	18/tfmrcv
l.b017	vfd	18/tffip
	rem
	rem
a.b001	ind	getbfh
a.b002	ind	setbpt
a.b003	ind	bldicw
a.b004	ind	.crpte
*a.b005
a.b006	ind	ghibuf
*a.b007	unused
*a.b008
a.b009	ind	bnispc
	ttls	rboibf - rebuild old input buffer
rboibf	subr	rbo,(x1)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	rboibf
*
*	     this routines checks for a partially filled
*	input buffer. if one is found it is setup as the
*	current input buffer, with correct icw and buffer
*	tallies. if none is found bnibuf is called to allocate
*	a fresh one.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     bibibp - ind word to sf.ib0/1
*	     bibicw - ind word to h.ric0/1
*
*	returns:
*	     icw and sf.ib0/1 setup
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	sf.flg,2	synchronous line?
	cana	l.b003-*	=sffsyn
	tze	rbo050-*	no, don't reuse old buffer
	rem
	szn	t.icp,1	any input chain now?
	tze	rbo050-*	nope, no need to reuse any
	rem
	lda	t.ilst,1	get ptr to last buffer
	sta	bibabs-*
	tsy	a.b002-*,*	(setbpt) convert to virtual
	cax3
	lda	bf.tly,3	get tally
	ana	l.b011-*	(=buftmk) leave only tally
	sta	bibcnt-*	save it
	lda	bf.siz,3	get buffer size code
	arl	15	right adjust
	als	bufshf+1	convert to chars
	iaa	hbfnch	one buffer, less overhead
	cmpa	bibcnt-*	is buffer full (tally = size)?
	tze	rbo050-*	yes, can't add to it
	sta	rbotly-*	save max tally
	rem
	lda	t.flg2,1	get tib flags
	cana	l.b016-*	(=tfmrcv) message rcv mode ?
	tze	rbo005-*	no, continue
	lda	l.b009-*	(=bfflst)
	orsa	bf.flg,3	set buffer last flag
	tra	rbo050-*	get a shiny new buffer
	rem
rbo005	stx3	bibvir-*	save buffer ptr
	lda	t.icp,1	get ptr to head of chain
	caq		save it
	tsy	a.b002-*,*	setbpt
	cax3		get virtual address
	cmpq	bibabs-*	same as tail?
	tnz	rbo010-*	no
	rem
	stz	t.icp,1	zero all chain ptrs now
	stz	t.ilst,1
	tra	rbo030-*
	rem
rbo010	lda	bf.nxt,3	get the next ptr
	cmpa	bibabs-*	does it point to last?
	tze	rbo020-*	yes, steal off chain
	lda	bf.nxt,3	bump to next on chain
	caq		hang on to absolute address
	tsy	a.b002-*,*	setbpt
	cax3		get virtual in x3
	tra	rbo010-*	loop
	rem
rbo020	stz	bf.nxt,3	clobber next pointer
	stq	t.ilst,1	make as new last
	rem
rbo030	lda	bf.siz,3	get buffer size code
	arl	15	right adjust
	iera	-1	add one and negate
	asa	t.icpl,1	decrement chain length
	rem
	lda	bibabs-*	get ptr to buffer we will use
	sta	bibibp-*,*	put ptr into sfcm
	tsy	a.b002-*,*	setbpt
	cax3
	stz	bf.nxt,3	make next ptr zero
	lda	l.b001-*	get size code mask
	ansa	bf.tly,3	leave only size code
	lda	rbotly-*	get max tally
	orsa	bf.tly,3	put tally in buffer
	rem
	lda	bibcnt-*	get tally in buffer
	ars	1	divide to get word count
	ada	l.b010-*	(=0,b.0) add in addr bits
	iaa	bf.dta	add offset of data
	asa	bibvir-*	add into address of buffer
	lda	bibcnt-*	get tally again
	icana	1	is it odd?
	tze	rbo040-*	no
	rem
	ldx3	bibvir-*	get addr
	iacx3	0,b.1	bump up
	stx3	bibvir-*	put it back
rbo040	lda	rbotly-*	get whole tally
	sba	bibcnt-*	leave icw tally
	caq		put into q
	lda	bibvir-*	get virtual addr
	ldx3	bibicw-*	get ptr to icw
	tsy	a.b003-*,*	(bldicw) fill in icw now
	tra	rboret-*
	rem
rbo050	null		no partial input buffer
	tsy	bnibuf-*	allocate a new one
	rem
rboret	return	rboibf
	rem
rbotly	bss	1
	ttls	bnibuf - build a new input buffer for the current icw
bnibuf	subr	bni,(x1)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	bnibuf
*
*	     this routine allocates a new input buffer
*	for the current icw and sets the tally.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     bibibp - ind word to sf.ib0/1
*	     bibicw - ind word to h.ric0/1
*
*	returns:
*	     icw and bf.tly setup
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	tsy	a.b006-*,*	(=ghibuf) get input buffer
	tra	2	error, no buffer
	tra	bni030-*	got buffer, continue
	rem
	rem		failed to get buffer, best we can
	rem		do now is to set exhaust bit in icw
	stz	bibibp-*,*	zero input buffer ptr
	ldx3	bibicw-*	get icw addr
	lda	a.b009-*	(=bnispc) get addr of spare word
	ldq	l.b008-*	(=450000) get exhausted tally
	staq	0,3	set icw
	tra	bniret-*	better luck next time
	rem
bni030	szn	bibibp-*,*	be sure no old buffer left
	tze	2
	die	9
	rem
	sta	bibibp-*,*	store addr in sfcm ib1/2
	lda	sf.flg,2	synchronous line?
	cana	l.b003-*	=sffsyn
	tnz	bni040-*	yes, this buffer will go into an input chain
	cx3a		no, this is a "pseudo-buffer"
	ora	l.b005-*	(0,b.1) data starts in 2nd character
	tra	bni050-*
	rem
bni040	iacx3	bf.dta	add in offset of start of data
	cx3a
	ora	l.b010-*	(=0,b.0) get the character addressing flags
	rem
bni050	ldx3	bibicw-*	get ptr to icw
	tsy	bldicw-*	set it up
	lda	sf.flg,2	sync line?
	cana	l.b003-*	=sffsyn
	tze	bniret-*	no, don't bother with buffer size stuff
	ldq	sf.bsz,2	*get current buffer size
	tsy	cbufsz-*	*set sync prebuffer if needed
	rem
bniret	return	bnibuf
	rem
bnispc	bss	1	space to store char on tally runout
	ttls	bldicw - build a data icw
**********************************************************************
*
*	bldicw: sets up a data icw for transfer to/from extended
*	memory. translates an old-style 32k icw into extended form.
*
*	input:
*	   a  - character address (assumes buffer pte correct)
*	   q  - tally
*	   x3 - address of icw
*
*	output:
*	   an icw of the following form:
*	   word 0: 18-bit address
*	   word 1: bit 0 = 1
*	           bit 1 = 0
*	           bits 2-4: character addressing code
*	           bit 5 = 0
*	           bits 6-17 = tally
*
**********************************************************************
	rem
bldicw	subr	bic,(inh,a,q)
	ana	l.v005-*	(o077777) get word part alone
	tsy	a.v003-*,*	(cvabs) convert to absolute
	sta	0,3	put it in icw
	lda	bicsa-*	get address back in a
	ana	l.v003-*	(o700000) get character code alone
	arl	2	move it to bits 2-4
	ora	l.v004-*	(o400000) get 18-bit address flag
	ora	bicsq-*	or in tally
	sta	1,3	this is second word
	return	bldicw
	ttls	cbufsz - change buffer size
**********************************************************************
*
*	cbufsz - change buffer size in sfcm
*
*	this subroutine sets up the preallocated
*	buffer chain queue for a given buffer size.
*	   q -- new size
*	  x1 -- tib address
*
*	written for icw switching problem by
*		D. W. Cousins on March 24,1981
*
***********************************************************************
cbufsz	subr	cbu,(x1,x2,x3)
	ldx2	t.sfcm,1	*load sfcm
	tze	cburet-*	*problem no sfcm
	cqa		*set some indicators
	icmpa	32
	tmi	cbu010-*	*not if less then 32 words
	cmpa	l.v001-*	*(=401)check for max
	tmi	2	*within range
cbu010	ldq	l.v002-*	*(=400)set to max
	stq	sf.bsz,2	*ok store it
	qrs	5	*set up table index
	iaq	-1	*
	cqa
	cax3
	ila	4
	sta	a.v001-*,*	*=pbfmax,3 set max buffer count
	tsy	a.v002-*,*	*=albchs
cburet	return	cbufsz
a.v001	ind	pbfmax,3	max buffer count for this pool
a.v002	ind	albchs	allocated buffer check
a.v003	ind	cvabs
	rem
l.v001	oct	000401	max buffer + 1 in octal words
l.v002	oct	000400	max in octal words for buffer
l.v003	oct	700000
l.v004	oct	400000
l.v005	oct	077777
	ttls	ghibuf - get hsla input buffer
ghibuf	subr	ghi
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ghibuf
*
*	allocates an hsla input buffer of the proper size
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	return 1:
*	     no more buffers can/should be allocated
*
*	return 2:
*	     virtual buffer addr in x3, with size code and tally
*	      set up if appropriate
*	     absolute buffer address in a
*	     buffer tally in q
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ilq	bufsiz	buffer size for control rcv mode
	lda	t.flg2,1	get tib flags
	cana	l.b015-*	control rcv mode?
	tnz	ghi025-*	yes
	rem
	ldq	sf.bsz,2	get regular buffer size
	cana	l.b016-*	(=tfmrcv) message rcv mode ?
	tnz	ghi015-*	yes, get size
	lda	sf.flg,2	synchronous line?
	cana	l.b003-*	=sffsyn
	tnz	ghi025-*	yes, use full size
	lda	t.flg2,1	no, are we in a frame?
	ldq	sf.fbs,2	if so, use frame buffer size
	cana	l.b017-*	=tffip
	tnz	ghi010-*	we are
	cana	l.b006-*	=tfifc
	tnz	ghi010-*	likewise if input flow control
	ldq	sf.bsz,2	but if in blk_xfer, use intermediate size
	cana	l.b004-*	=tffrmi
	tnz	ghi010-*	that's it
	ldq	l.b002-*	(=minsiz) else use minimum size
ghi010	null		here to allocate asynchronous pseudo-buffer
	cmpq	l.b002-*	(=minsiz) is buffer nore than minimum size?
	tze	2	equal isn't larger
	tpl	ghi012-*	larger is
	lda	l.b013-*	(tfabf0) use one of the permanent ones
	cana	t.flg3,1	first one available?
	tze	ghi011-*	no, use second
	ldx3	t.abf0,1	yes, get it
	ersa	t.flg3,1	turn flag off
	tra	ghi01a-*
ghi011	lda	l.b014-*	tfabf1
	cana	t.flg3,1	is other one available?
	tze	ghi012-*	no, we'll have to allocate
	ldx3	t.abf1,1	yes, get other permanent buffer
	ersa	t.flg3,1	mark it unavailable
ghi01a	cx3a		convert address to virtual
	sta	ghiadr-*	butr save it first
	tsy	a.b002-*,*	setbpt
	cax3		back to x3
	ldq	0,3	get size (in upper half)
	qrl	8	convert to chars in lower half
	tra	ghi014-*
ghi012	null		have to really allocate
	tsy	a.b001-*,*	getbfh
	tra	ghi040-*	couldn't get it
	sta	ghiadr-*	hang on to absolute address (virtual is in x3)
	cqa		we have to store size in first char
	als	9
	sta	0,3
	stz	1,3	get rid of supposed size code
	stq	sf.csz,2	keep it here, too
	qls	1	convert to characters
ghi014	lda	ghiadr-*	get address back
	iaq	-3	size char. and ***two*** extra char. at end
	aos	ghibuf-*	for successful return
	tra	ghiret-*	done
	rem
ghi015	null		here for message receive mode
	szn	sf.mms,2	test max message size
	tze	ghi025-*	zero, ignore it
	rem
	lda	sf.rms,2	get residual message size
	tze	ghiret-*	zero, don't want buffer
	tmi	ghiret-*	negative, don't want buffer
	iaa	6	buffer overhead + round-up
	ars	1	convert to words
	sta	ghitmp-*	put in temporary
	cmpq	ghitmp-*	compare with buffer size
	tmi	ghi020-*	buffer size is smaller, use it
	caq		use message size instead
	rem
ghi020	tsy	a.z007-*,*	(=getbfh) get a buffer
	tra	ghi040-*	failed, make error return
	sta	ghiadr-*	succeeded, save absolute address
	rem
	qls	1	convert buffer size to characters
	iaq	-5	subtract overhead
	cqa		move to a
	iera	-1	negate a
	iaa	1
	asa	sf.rms,2	decrement residual message size
	tra	ghi030-*	done
	rem
ghi025	tsy	a.z007-*,*	(=getbfh) get a buffer
	tra	ghi040-*	failed, make error return
	sta	ghiadr-*	save absolute address
	rem
ghi030	aos	ghibuf-*	setup normal return
	stz	bf.nxt,3	init the next ptr
	lda	bf.siz,3	get buffer size code
	arl	15	right adjust
	als	bufshf+1	convert to chars
	iaa	hbfnch	one buffer, less overhead
	orsa	bf.tly,3	put tally in buffer
	caq		save tally in q
	lda	ghiadr-*	get absolute address back
	rem
ghiret	return	ghibuf
	rem
ghi040	null		allocation failed, meter it
	cmeter	mincs,m.inaf,l.z017-*
	tra	ghiret-*
	rem
ghitmp	bss	1
ghiadr	bss	1
	eject
	ttls	makcct - make cct based on modes
************************************************************************
*
*	subroutine to compute a cct for an ascii line.
*	all modes (crecho,lfecho,tabecho,echoplex, etc.)
*	are taken into account to compute the proper cct.
*
*	called with:
*		x1 - virtual tib address
*
************************************************************************
	rem
makcct	subr	mct,(x1,x2,x3,a,q)
	rem
*	first, get memory for cct
	rem
	ilq	64	normal ones are 64 words
	stz	mctsbx-*	initialize indicator
	lda	t.flg2,1
	cana	l.z001-*	=tffrmi, check for blk_xfer mode
	tze	mct060-*	no
	lda	t.frmc,1	any framing chars?
	tze	mct060-*	no
	arl	9	is there a start char?
	tnz	mct059-*	yes
	aos	mctsbx-*	indicate single cct with block xfer
	tra	mct060-*
mct059	iaq	64	must use double size
mct060	stq	mctsz-*	remember size
	tsy	a.z001-*,*	=getmem
	die	9
	stx3	mctad-*	save address
	rem
*	fill in default for all character positions.
*	this is:
*		ct.ncs	for most modes
*		ct.mrk	for echoplex & breakall
	rem
	ldq	l.z002-*	=vfd 9/ct.ncs,9/ct.ncs
	szn	mctsbx-*	single cct with block xfer?
	tnz	mct005-*	yes, ignore other modes
	lda	t.flg,1
	cana	l.z003-*	=tfecpx, in echoplex mode?
	tze	2	no
	ldq	l.z004-*	=vfd 9/ct.mrk,9/ct.mrk use marker for echoplex
	lda	t.flg3,1
	cana	l.z005-*	=tfbral, in breakall mode
	tze	2	no
	ldq	l.z004-*	=vfd 9/ct.mrk,9/ct.mrk marker on all characters
mct005	ila	64	store 64 copies
mct010	stq	0,3
	iacx3	1
	iaa	-1
	tnz	mct010-*
	rem
*	if double cct, second half is filled with
*	ct.ncs + ct.tb1 (to stay in second cct when entered)
	rem
	lda	mctsz-*	get size
	icmpa	64
	tze	mct020-*	standard size
	ldq	l.z007-*	=vfd 9/ct.ncs+ct.tb1,9/ct.ncs+ct.tb1
	ila	64	store 64 copies
mct030	stq	0,3
	iacx3	1
	iaa	-1
	tnz	mct030-*
	rem
*	fill in special character codes
	rem
mct020	ldx3	mctad-*	cct address
	szn	mctsbx-*	single cct with block xfer?
	tnz	mct055-*	yes, skip this stuff
	lda	t.flg3,1	check for breakall mode
	cana	l.z005-*	=tfbral
	tnz	mct050-*	skip for breakall mode,
	ila	nl	break on newline
	ilq	ct.mrk
	tsy	mctstr-*
	ila	ff	break on formfeed
	tsy	mctstr-*
	ila	etx	break on etx
	tsy	mctstr-*
	lda	t.flg,1	break on cr, if lfecho
	cana	l.z009-*	=tflfec
	tze	3
	ila	cr
	tsy	mctstr-*
	ilq	ct.mrk
	lda	t.flg,1	marker on tab, if tabecho
	cana	l.z008-*	=tftbec
	tze	3
	ila	tab
	tsy	mctstr-*
	rem
*	fill in codes for blk_xfer mode
	rem
mct050	lda	t.flg2,1
	cana	l.z001-*	=tffrmi
	tze	mct040-*
	lda	t.frmc,1	get framing chars
	tze	mct040-*	none, skip
	ilq	ct.tb1	switch to second cct
	ars	9	start char
	tsy	mctstr-*
	iacx3	64	switch to second cct
mct055	lda	t.frmc,1	get framing chars
	ana	l.z010-*	=o777
	ilq	ct.mrk
	tsy	mctstr-*
	ldx3	mctad-*	get pointer to first cct back
mct040	lda	t.flg2,1	check for input flow control
	cana	l.z006-*	=tfifc
	tze	mct080-*
	lda	t.ifch,1	yes
	arl	9	get suspend char
	tze	mct070-*	never mind, there is none
	ilq	ct.mrk	set marker for it
	tsy	mctstr-*
mct070	lda	t.flg2,1	recover flag word
mct080	cana	l.z015-*	(=tfofc) check output flow control
	tze	mct100-*
	cana	l.z016-*	(=tfblak) yes, block acknowledge also?
	tnz	mct090-*	yes, marker on ack char only
	lda	t.ofch,1	otherwise for both characters
	arl	9	get suspend char
	ilq	ct.mrk	marker in cct
	tsy	mctstr-*
mct090	lda	t.ofch,1	nopw get resume char (or ack)
	ana	l.z010-*	=o777
	ilq	ct.mrk
	tsy	mctstr-*
	rem
*	cct now ready, so store it
	rem
mct100	ldx3	mctad-*	its address
	ldq	mctsz-*	its size
	tsy	shrcct-*
	tsy	a.z002-*,*	and release temp memory
	rem
	szn	mctsbx-*	single cct with block xfer?
	tze	mctret-*	no
	lda	l.z014-*	(=tffip) get frame in progress bit
	orsa	t.flg2,1	always on for this cct
	rem
mctret	return	makcct
	rem
mctsz	bss	1
mctad	bss	1
mctsbx	bss	1
	rem
	rem
*	subroutine to store 1 cct character
	rem
mctstr	subr	cst,(a,q)
	ars	1	get word offset
	stx3	csttmp-*	cct address
	ada	csttmp-*	word address
	ora	l.z011-*	=0,b.0 - make character addressing
	cax2
	lda	cstsa-*	get character again
	iana	1	isolate last bit
	tze	2	even
	iacx2	0,b.1	go to odd address
	stq	0,2,b.0	update cct
	return	mctstr
	rem
csttmp	bss	1
	rem
a.z001	ind	getmem
a.z002	ind	fremem
a.z003	ind	.crcct
a.z004	ind	getbuf
a.z005	ind	frebuf
a.z006	ind	makcct
a.z007	ind	getbfh
	rem
l.z001	vfd	o18/tffrmi
l.z002	vfd	9/ct.ncs,9/ct.ncs
l.z003	vfd	o18/tfecpx
l.z004	vfd	9/ct.mrk,9/ct.mrk
l.z005	vfd	o18/tfbral
l.z006	vfd	o18/tfifc
l.z007	vfd	9/ct.ncs+ct.tb1,9/ct.ncs+ct.tb1
l.z008	vfd	o18/tftbec
l.z009	vfd	o18/tflfec
l.z010	oct	777
l.z011	ind	0,b.0
l.z012	vfd	o18/sffdct
l.z013	vfd	o18/sffsct
l.z014	vfd	o18/tffip
l.z015	vfd	o18/tfofc
l.z016	vfd	o18/tfblak
l.z017	dec	1
	eject
	ttls shrcct - subroutine to share and store ccts
************************************************************************
*
*	subroutine to store and share ccts
*
*	it is called with:
*		x3 -> cct
*		q = size (0 for no new cct)
*
*	the channel is update to use this cct, freeing the old cct
*	if necessary. The new cct is shared with an existing cct if possible.
*
************************************************************************
	rem
shrcct	subr	sct,(a,q,x1,x2,x3)
	rem
*	first, find the length of the cct. if the length is given
*	as 64, check to see if a short cct can be used
	rem
	stq	sctsz-*	size as given
	cqa
	tze	sct010-*	no new cct
	icmpa	64	single cct?
	tnz	sct020-*	no, cant use short cct
	iaa	-16	check 64-16 words
	ldq	l.z002-*	=vfd 9/ct.ncs,9/ct.ncs
sct030	cmpq	16,3	check all cct words
	tnz	sct020-*	cant use short cct
	iacx3	1
	iaa	-1
	tnz	sct030-*	loop
	ila	16	test passes - use short cct
	sta	sctsz-*
	rem
*	now try to locate an existing cct that matches the new one
	rem
sct020	stz	sctnds-*	pointer to new descriptor
	ldx1	a.z003-*,*	addr of first descriptor
	tze	sct010-*	none, no existing cct to share
sct060	lda	sctsz-*	size of new cct
	cmpa	cct.sz,1	match against existing cct
	tnz	sct040-*	sizes dont match, skip word check
	ldx2	sctsx3-*	addr of callers cct
	ldx3	cct.ad,1	address of existing cct
sct050	ldq	0,2	word to compare
	cmpq	0,3
	tnz	sct040-*	no match
	iacx2	1
	iacx3	1
	iaa	-1
	tnz	sct050-*
	stx1	sctnds-*	found matching cct in use
	lda	cct.ad,1	address of good cct
	ldx1	sctsx1-*	get tib address
	ldx2	t.sfcm,1
	cmpa	sf.cct,2	is this the cct already in use?
	tze	sctret-*	yes, all done
	tra	sct010-*
sct040	ldx1	cct.nx,1	step to next cct descriptor
	tnz	sct060-*
	rem
*	locate old cct descriptor and decrement usage
	rem
sct010	stz	sctods-*	pointer to old descriptor
	ldx1	sctsx1-*	get tib address
	ldx2	t.sfcm,1
	lda	sf.flg,2
	cana	l.z012-*	=sffdct, useing dynamic cct?
	tze	sct070-*	no old cct to locate
	ldx1	a.z003-*,*	=.crcct
sct090	tnz	2
	die	6	cant find cct descriptor
	ldx3	cct.ad,1	cct pointed to by this descrip
	cmpx3	sf.cct,2	this channels cct?
	tze	sct080-*	yes
	ldx1	cct.nx,1	keep looking
	tra	sct090-*
sct080	stx1	sctods-*	save address
	rem
*	setup descriptor for new cct if needed
	rem
sct070	szn	sctsz-*	is there new cct?
	tnz	sct160-*	yes
	ila	0	addr of no cct
	ilq	0	not short flag
	tra	sct110-*
sct160	ldx1	sctnds-*	new descriptor address
	tnz	sct170-*	all setup already
	ilq	cct.ln	allocate space for new descriptor
	tsy	a.z001-*,*	=getmem
	die	9
	stx3	sctnds-*
	ldx1	sctnds-*
	ldx3	a.z003-*,*	=.crcct, addr of first cct desc
	tze	2	new one is only desc
	stx1	cct.pr,3	make second desc point at first
	stx1	a.z003-*,*	new desc to head of chain
	stx3	cct.nx,1	make first point to second
	stz	cct.pr,1	no previous pointer
	rem
*	allocate memory for new cct and copy it. memory must be 64-word aligned
	rem
	ldq	sctsq-*	origional size
	iaq	32	allocate extra 32 words to force alignment
	tsy	a.z004-*,*	=getbuf
	die	9
	cx3a		allocate address?
	icana	=o77	on 64-word boundry?
	tze	sct120-*	yes
	iaa	32	this will get to 64-word boundry
	sta	cct.ad,1	for the real cct
	tra	sct130-*
sct120	sta	cct.ad,1	allocated address is aligned ok
	adcx3	sctsq-*	get addr of 32 words at end to free
sct130	ilq	32	free the extra 32 words
	tsy	a.z005-*,*	=frebuf
	lda	sctsz-*	set size
	sta	cct.sz,1
	icmpa	16	is this 16 word cct
	tnz	sct140-*	no
	ldx3	cct.ad,1	can free last 32 words of 64 word buffer
	iacx3	32
	ilq	32
	tsy	a.z005-*,*	=frebuf
sct140	ldx2	cct.ad,1	setup to copy cct
	ldx3	sctsx3-*
	lda	cct.sz,1
sct150	ldq	0,3	copy loop
	stq	0,2
	iacx2	1
	iacx3	1
	iaa	-1
	tnz	sct150-*
	stz	cct.rc,1	zero reference count
sct170	aos	cct.rc,1	new user of this cct
	ilq	0	flag meaning not short cct
	lda	cct.sz,1
	icmpa	16
	tnz	2
	ilq	1	it is short cct
	lda	cct.ad,1	address of cct
	rem
*	make channel use the new cct (it maybe 0)
*	a -> cct, q = short cct switch
*	a descriptor cannot be referenced here (there may not be one)
	rem
sct110	ldx1	sctsx1-*	tib address
	ldx2	t.sfcm,1
	sta	sf.cct,2	record cct address
	lda	l.z012-*	=sffdct, dynamic cct bit
	szn	sf.cct,2	is there cct
	tnz	2
	ila	0	reset bit
	era	sf.flg,2	get bit into word
	ana	l.z012-*	=sffdct
	ersa	sf.flg,2
	lda	l.z013-*	short cct bit
	iaq	0	test flag, is it short?
	tnz	2
	ila	0	not short
	era	sf.flg,2	store in flag word
	ana	l.z013-*	=sffsct
	ersa	sf.flg,2
	ldx3	sf.hcm,2	update hardware comm region too
	lda	sf.cct,2
	als	3
	iaq	0	short cct?
	tze	2	no
	iora	=o100	set short flag
	sta	h.baw,3	this effects he change officially
	rem
*	all done with old cct for this line, free it if last user
	rem
	ldx1	sctods-*	old descriptor address
	tze	sctret-*	no old one
	ila	-1	decrement usage count
	asa	cct.rc,1
	tnz	sctret-*	no
	ldq	cct.sz,1	free the cct first
	ldx3	cct.ad,1
	tsy	a.z005-*,*	=frebuf
	ldx2	cct.pr,1	unthread descriptor
	ldx3	cct.nx,1
	tze	2
	stx2	cct.pr,3	make next point to previous
	iacx2	0	is there a previous?
	tze	3	no
	stx3	cct.nx,2	make prev point at next
	tra	2
	stx3	a.z003-*,*	=.crcct, make next first
	cx1a		free descriptor
	cax3
	ilq	cct.ln
	tsy	a.z002-*,*	=fremem
	rem
sctret	return	shrcct
	rem
sctsz	bss	1	size of cct
sctods	bss	1	old descriptor address
sctnds	bss	1	new descriptor address
	ttls	setcct - implements the setcct opblock
	rem
************************************************************************
*
*	subroutine use by the interpreter when it encounters a setcct opblock
*
*	x1 - virtual tib address
*	a  =  arg to opblock
*
************************************************************************
	rem
setcct	subr	cct,(a,q,x2,x3)
	rem
	ldx2	t.sfcm,1
	ldx3	sf.hcm,2
	rem
	icmpa	scc.dl	delete cct?
	tze	cct010-*
	icmpa	scc.df	set default cct?
	tze	cct020-*
	icmpa	scc.bs	set to base of cct?
	tze	cct030-*
	rem
*	argument is real cct address
	rem
	ilq	0	release dynamic cct, if any
	tsy	shrcct-*
	sta	sf.cct,2
	als	3	align for baw
	sta	h.baw,3
	tra	cctret-*
	rem
*	process various coded requests
	rem
cct010	ilq	0	delete current cct
	tsy	shrcct-*
	tra	cctret-*
cct020	tsy	a.z006-*,*	build cct from modes
	tra	cctret-*
cct030	ldq	sf.cct,2	set to base cct
	qls 	3
	lda	sf.flg,2	get flags
	cana	l.z013-*	=sffsct, short cct?
	tze	2	no
	iaq	=o100	short cct bit for h.baw
	stq	h.baw,3
	rem
cctret	return	setcct
	ttls	hbreak - entry point to change break list
* hbreak	subr	brk,(x1,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hbreak
*
*	     entry to change the break list. causes
*	hsla_man to build a new cct for the line.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x3 - points to change break command data
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem
*	well that is all for now
	rem
*	return	hbreak
	ttls	hgeti - entry to collect input from current buffer
hgeti	subr	hgi,(x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hgeti
*
*	obtains a ptr to the unscanned portion of the current input buffer
*	(if any)
*	and the number of unscanned characters in the buffer.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x3 - points to 2 words (returned)
*
*	returns:
*	     x3 -> 1st: virtual ptr to first unscanned character of buffer
*		   2nd: tally        
*		   buffer page table entry set up
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get virtual sfcm addr
	tsy	gettly-*	get current buffer addr & tally
	iaa	0	is there a buffer at all?
	tze	hgi020-*	no, done
	szn	sf.nic,2	any scanning done in this buffer?
	tze	hgi020-*	no, use as is
	sta	hgitly-*	save buffer tally temporarily
	cmpx3	sf.nic,2	scan pointer at beginning?
	tze	hgi010-*	yes, nothing new
	cx3a		convert current buffer pointer to word addr
	ana	l.r007-*	=o077777
	sta	hgibp-*	save
	lda	sf.nic,2	get scan pointer
	ana	l.r007-*	(=o077777) convert to word address
	sba	hgibp-*	number of words already scanned
	caq
	qls	1	convert to characters
	cx3a		started at odd character?
	cana	l.r008-*	=o100000
	tze	2	no
	iaq	-1	yes, one character less
	lda	sf.nic,2	stopped at odd character?
	cana	l.r008-*	=o100000
	tze	2	no
	iaq	1	yes, one character more
	ldx3	sf.nic,2	point to first unscanned char
	lda	hgitly-*	get original tally
	stq	hgitly-*	this is number already scanned
	sba	hgitly-*	result is number remaining
	tze	hgi010-*	none
	tpl	hgi020-*	negative would mean none
hgi010	ila	0	return zero tally
	cax3		and zero buffer address
hgi020	stx3	hgisx3-*,*	return buffer addr
	ldx3	hgisx3-*	restore x3
	sta	1,3	return tally
	rem
	return	hgeti
	rem
hgitly	bss	1
hgibp	bss	1
	ttls	gettly - get the addr and tally of the current input buffer
gettly	subr	gtl,(x2,inh)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	gettly
*
*	computes the tally of, i.e. the number of chars in,
*	the current input buffer.  if the buffer is active
*	(icw active), the tally is given by the difference
*	between the max buffer tally and the icw tally.
*	if not active, the tally is given by the tally
*	field of the buffer.
*
*	upon entry:
*	     x1 - virtual tib address
*
*	returns:
*	     x3 - points to first char. current buffer (or zero if none)
*	      a - contains buffer tally (or zero if none)
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get virtual sfcm address
	lda	sf.flg,2	get sfcm flags
	ldq	sf.ib0,2	get primary buffer addr
	icana	sffcii	alt buffer in use
	tze	2	no
	ldq	sf.ib1,2	get alt buffer addr
	rem
	iaq	0	do we have a buffer ?
	tnz	gtl010-*	yes, continue
	ila	0	return zero tally
	cax3		return zero buffer addr
	tra	gtlret-*
	rem
gtl010	ldx3	sf.hcm,2	get hwcm addr
	iacx3	h.ric0	get primary rcv icw addr
	icana	sffcii	alt icw active ?
	tze	2	no
	iacx3	h.ric1-h.ric0	get alt rcv icw addr
	rem
	cqa		move buffer addr to a
	tsy	a.r001-*,*	setbpt
	ldq	1,3	get icw tally
	cax3		move (virtual) buffer addr to x3
	lda	sf.flg,2	synchronous line?
	cana	l.r004-*	=sffsyn
	tnz	gtl020-*	yes, regular buffer
	cx3a		no, point to second char. of block
	ada	l.r006-*	0,b.1
	cax3
	lda	-1,3,b.1	pick up size from first char.
	als	1	convert to chars (allow for ***two*** at end)
	iaa	-3	a now contains max. tally
	tra	gtl030-*
	rem
gtl020	null
	lda	bf.tly,3	get buffer tally word
	ana	l.r001-*	(=buftmk) leave only tally
	sta	gtltmp-*	hang on to max. tally
	cx3a		update pointer to first data char.
	ada	l.r005-*	=bf.dta,b.0
	cax3		back to x3
	lda	gtltmp-*	restore tally
	rem
gtl030	null
	qls	5	get rid of character addressing bits
	qrl	5
	cmpq	l.r002-*	(=010000) icw tally exhausted ?
	tze	gtlret-*	yes, done
	rem
	stq	gtltmp-*	put icw tally in temp
	sba	gtltmp-*	subtract from max buffer tally
	rem
gtlret	return	gettly
	rem
gtltmp	bss	1
	rem
a.r001	ind	setbpt
	rem
l.r001	vfd	18/buftmk
l.r002	oct	010000
l.r003	vfd	o18/777000
l.r004	vfd	18/sffsyn
l.r005	zero	bf.dta,b.0
l.r006	zero	0,b.1
l.r007	oct	077777
l.r008	oct	100000
	ttls	hcfg - entry point to change configuration of channel
hcfg	subr	cfg,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hcfg
*
*	     entry to change to the configuration of the channel
*	the current config pcw (stored in the sfcm at sf.cfg) is
*	is modified according to the sub-op's in the config list
*	and a pcw type 2 is issued, the new current config pcw
*	is stored in the sfcm.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - points to first config sub-op
*
*	returns:
*	    x2 - points to opblock after sub-ops
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get addr of sfcm
	ldaq	sf.cfg,2	get current config pcw
	staq	newcfg-*	newcfg will be modified
	ldx3	cfgsx2-*	get address of first sub-op
	rem
cfg010	null		start of sub-op decoding loop
	lda	0,3	pick up sub-op
	ana	l.r003-*	=777000
	cmpa	l.r003-*	is this opblock, not a sub-op
	tze	cfg070-*	yes, done
	ila	0	zero a
	ldq	0,3	get sub-op
	lls	3	isolate sub-op code in a
	qrl	3	right justify sub-op data
	icmpa	fg.bd	changing the baud rate?
	tze	cfg050-*	go process baud sub-op
	rem
	rem		mode sub-op (smode or rmode)
	rem		find specified entry in cfgtab
	llr	18	swap a and q
	rem		sub-op code is in q
	rem		sub-op data is in a
	sta	cfgsub-*
cfg019	ldx2	a.q001-*	get addr of config table (=cfgtab)
cfg020	cana	0,2	compare sub-op data with cfgtab entry
	tze	cfg041-*	tra if desired bit not set
	lda	0,2	bit that just matched
	era	l.q002-*	(=777777) invert all bits
	ansa	cfgsub-*	turn off in arg - this bit done
	rem
	szn	3,2	check for subr
	tze	2	skip if no subr
	tsy	3,2*	call subr (subr must maintain x1, x2,
	rem		x3, and q)
	rem
	lda	1,2	get first word of pcw mask
	cmpq	l.q001-*	check for rmode
	tnz	cfg030-*	transfer if smode
	rem
	rem		reset a mode bit
	era	l.q002-*	invert the bits
	ansa	newcfg-*	reset the bit
	lda	2,2	get 2nd word of mask
	era	l.q002-*
	ansa	newcfg-*+1
	tra	cfg040-*
	rem
cfg030	null		set a mode bit
	orsa	newcfg-*	set the bit in the new config pcw
	lda	2,2
	orsa	newcfg-*+1
	rem
cfg040	null
	lda	cfgsub-*
	tze	cfg060-*	all bits processed
	tra	cfg019-*	back to next bit
	rem
cfg041	iacx2	cfglen	next cfgtab entry
	cmpx2	a.q002-*	end of table?
	tnz	cfg020-*	nope, try again
	tra	cfg060-*	next config list entry
	rem
cfg050	null		change baud rate
	qls	0	baud rate given?
	tnz	2	yes
	ldq	t.cntr,1	if not in control table, it is here
	ldx2	a.q004-*	(=cfgbds) addr of baud table
cfg052	cmpq	0,2	does it match baud given
	tze	cfg051-*	yes
	iacx2	1	step to next entry
	cmpx2	a.q005-*	(cfgbds+cfgbdl) at end of table?
	tnz	cfg052-*	no
	die	2
	rem
cfg051	stz	cfgsvf-*	this will be setting of ebcdic bit in sfcm
	cmpq	bd133-*	setting to 133 baud?
	tnz	cfg053-*	no
	lda	l.q010-*	(=sffebd) ebcdic bit for sfcm
	sta	cfgsvf-*
cfg053	lda	l.q003-*	mask for pcw baud bits
	ansa	newcfg-*+1	turn off current bits
	lda	cfgflg-cfgbds,2	get pcw bits to set baud rate
	orsa	newcfg-*+1	and store in pcw
	stx2	cfgtmp-*	save baud table index
	ldx2	t.sfcm,1	get addr of sfcm from tib
	lda	l.q011-*	(=^sffebd)
	ansa	sf.flg,2	turn off ebcdic bit
	lda	cfgsvf-*	get new value
	orsa	sf.flg,2	and set it
	ldx2	sf.hsl,2	get hsla table addr from sfcm
	lda	l.q008-*	mask to turn off speed field
	ansa	ht.flg,2
	lda	cfgtmp-*	retreive baud table index
	sba	a.q004-*	get offset in table
	iaa	1	this gives final baud index
	orsa	ht.flg,2	save in hsla table
	rem
	rem		check that pcw is type 2
	lda	newcfg-*
	ana	l.q006-*	zero all but pcw type code
	cmpa	l.q007-*	check for right type
	tze	cfg060-*
	die	2
	rem
cfg060	null
	iacx3	1	next entry in config list
	tra	cfg010-*	go back for another entry
	rem
cfg070	stx3	cfgsx2-*	all done, return bumbed addr to caller
	ldx2	t.sfcm,1	get sfcm addr again
	rem
	ldaq	newcfg-*	get new config pcw
	staq	sf.cfg,2	save it in sfcm
	rem
	rem		now select channel and do cioc
	rem
	tsy	sndcfg-*
	return	hcfg	done
	rem
	even
newcfg	bss	2	(altrd) pcw temp for new config pcw
cfgsub	bss	1	(altrd) copy of sub-op data
cfgtmp	bss	1
cfgsvf	bss	1
	rem
a.q001	ind	cfgtab
a.q002	ind	cfgend
a.q003	ind	cioc
a.q004	ind	cfgbds
a.q005	ind	cfgbds+cfgbdl
	rem
l.q001	vfd	18/fg.rmd
l.q002	vfd	o18/777777
l.q003	vfd	o18/777400	mask to zero baud bits
l.q004	sel	*-*	template select instruction
l.q005	vfd	18/p.ssiw
l.q006	vfd	o18/600000
l.q007	vfd	o18/pcw.2
l.q008	vfd	o18//htfspd
l.q009	vfd	o18//p2.mbt
l.q010	vfd	o18/sffebd
l.q011	vfd	o18//sffebd
	rem
cfgbds	dec	75	tables of bauds that can be configured
	dec	110
bd133	dec	133
	dec	150
	dec	300
	dec	600
	dec	1050	shouldn't be here but dia_man understands
	dec	1200
	dec	1800
	dec	2400
	dec	4800
	dec	7200	filler to index into baud_rates properly
	dec	9600
cfgbdl	equ	*-cfgbds
	rem		pcw bits to set each baud
cfgflg	oct	021	  75 baud
	oct	200	 110 baud
	oct	100	 133 baud
	oct	040	 150 baud
	oct	020	 300 baud
	oct	161	 600 baud
	oct	010	1050 baud
	oct	004	1200 baud
	oct	002	1800 baud
	oct	301	2400 baud
	oct	321	4800 baud
	oct	000	7200 baud (for indexing into baud_rates)
	oct	341	9600 baud
	rem
	ttls	config mode bits lookup table
cfgtab	null
	cfgtab	fg.icw,p2.icw,0,cfgicw icw bit is in first word of pcw
	cfgtab	fg.lpr,p2.lpr,0,0
	cfgtab	fg.lps,p2.lps,0,0
	cfgtab	fg.lpo,p2.lpo,0,0
	cfgtab	fg.5bt,p2.5bt,0,cfgrsc
	cfgtab	fg.6bt,p2.6bt,0,cfgrsc
	cfgtab	fg.7bt,p2.7bt,0,cfgrsc
	cfgtab	fg.8bt,p2.8bt,0,cfgrsc
	cfgtab	fg.beb,0,p3.beb,0
	cfgtab	fg.btr,0,p3.btr,0
	cfgtab	fg.cct,p2.cct,0,0
cfgend	equ	*
	rem
cfglen	equ	4
	rem
cfgicw	subr	icw
	rem
	rem	this subroutine is called when the number
	rem	of send icw's is being changed.
	rem	we always make sure that the channel is set to
	rem	use the primary send icw.
	rem
	lda	sf.flg,2	get tib flags
	icana	sffcoi	are we currently using alternate?
	tze	icwbak-*	transfer if not
	rem
	lda	l.q005-*	switch send icw pcw op-code
	tsy	a.q003-*,*	(=cioc) do a connect
icwbak	null
	return	cfgicw	done
	rem
*	subroutine to turn off the character size field in the pcw
	rem
cfgrsc	subr	rsc
	lda	l.q009-*	(=^p2.mbt)
	ansa	newcfg-*
	return	cfgrsc
	rem
*	subroutine to send the config pcw
	rem
sndcfg	subr	snd,(x1,x2,x3)
	lda	t.line,1	get line no
	ars	6
	iana	7	turn off "is_hsla" bit
	iaa	h1ch	add in base hsla chan no to
	rem		get iom chan no 6, 7, or 8
	ora	l.q004-*	(=sel 0) or in sel instruction
	sta	1	make a the next instruction
	sel	*-*	(patched) select correct channel
	rem
	ldx3	sf.hsl,2	get pointer to hsla table entry
	ldx3	ht.tib,3	get real tib address for trace
	trace	tt.pcw,ts.pcw,(x3,newcfg,newcfg+1)
	rem
	cioc	sf.cfg,2	hit the channel with the pcw
	return	sndcfg
	ttls	hmode - entry point to change modes
hmode	subr	mod,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hmode
*
*	     entry to notify us that certain mode bits
*	have been changed, including those having to do
*	with echoing, flow control, or parity.
*
*	upon entry:
*	     x1 - virtual tib address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get virtual sfcm address
	tze	modret-*	no sfcm, forget it
	lda	sf.flg,2	check for ebcd type
	cana	l.p013-*	=sffebd
	tnz	2	don't touch cct if it is
	tsy	a.p001-*,*	=makcct, select proper cct
	rem
	lda	t.flg2,1	find out if entered or left framei
	ana	l.p001-*	isolate tffrmi
	era	sf.flg,2	compare it against sffofr (same bit position)
	ana	l.p001-*	isolate relevant bit
	tze	mod010-*	not changed
	ersa	sf.flg,2	it is, change it in sfcm
	lda	l.p006-*	=sffnib
	orsa	sf.flg,2	we'll need a new input buffer
	rem
	lda	t.flg2,1	get tib flags
	cana	l.p001-*	(=tffrmi) frame input mode ?
	tnz	mod010-*	yes
	lda	l.p005-*	(=/tffip) cannot be frame in progress
	ansa	t.flg2,1	so turn off tffip
	rem
mod010	lda	t.flg2,1	check for input flow control
	cana	l.p007-*	=tfifc
	tze	mod020-*	no
	lda	l.p006-*	=sffnib
	orsa	sf.flg,2	yes, we'll need a new input buffer
mod020	lda	l.p012-*	p2.lps, on initially
	sta	tstcfg-*	we're going to see if we have to
	lda	t.flg3,1	change parity configuration
	ana	l.p008-*	tfoddp
	arl	lposhf	line it up on p2.lpo
	orsa	tstcfg-*	if on in tib, on in pcw
	lda	t.flg3,1	get flags again
	ana	l.p009-*	=tf8out
	arl	lpsshf	line it up on p2.lps
	ersa	tstcfg-*	on in tib => off in pcw, and vice versa
	lda	sf.cfg,2
	ana	l.p010-*	p2.lpo+p2.lps
	cmpa	tstcfg-*	have we changed either of these bits?
	tze	mod030-*	no, don't bother with new pcw
	lda	l.p011-*	^(p2.lpo+p2.lps)
	ansa	sf.cfg,2	turn them off so we can start clean
	lda	tstcfg-*	get new values
	orsa	sf.cfg,2
	tsy	sndcfg-*	now set the pcw
	rem
mod030	lda	t.flg2,1	check if we left oflow with output suspended
	cana	l.p020-*	=tfofc
	tnz	mod040-*	mode is on, never mind
	lda	t.flg,1	is output suspended now?
	cana	l.p021-*	=tfosus
	tze	mod040-*	no, no problem
	tsy	a.p012-*,*	(resout) yes, resume it
	rem
mod040	lda	t.flg,1	get the tib flags
	cana	l.p002-*	(=tfcrec+lfec+tbec+ecpx) any echoing modes on?
	tze	modret-*
	rem
	szn	t.echo,1	is there an echo buffer?
	tnz	modret-*	yes, done
	rem
	ilq	bufsiz	allocate a buffer
	tsy	a.p002-*,*	(=getbfh)
	tra	modret-*	if couldn't get it, tough
	rem
	sta	t.echo,1	set absolute ptr to echo buffer
	cx3a		put virtual addr into a
	ada	l.p003-*	(=eb.dta,b.1) make ptr to data
	sta	eb.inp,3	set in ptr
	sta	eb.otp,3	set out ptr
	stz	eb.tly,3	zero the tallytoo
	rem
modret	return	hmode
	rem
tstcfg	bss	1	place for temporary parity bits
	rem
a.p001	ind	makcct
a.p002	ind	getbfh
a.p003	ind	denq
a.p004	ind	maskr	restart wait block in control_tables
a.p005	ind	cioc
a.p006	ind	frelbf
a.p007	ind	frebuf
a.p008	ind	setbpt
a.p009	ind	fribuf
a.p010	ind	fremem
a.p011	ind	itest
a.p012	ind	resout
	rem
l.p001	vfd	18/tffrmi
l.p002	vfd	18/tfcrec+tflfec+tftbec+tfecpx
l.p003	ind	eb.dta,b.1
l.p004	vfd	18/tfecpx
l.p005	vfd	o18//tffip
l.p006	vfd	18/sffnib
l.p007	vfd	18/tfifc
l.p008	vfd	18/tfoddp
l.p009	vfd	18/tf8out
l.p010	vfd	18/p2.lpo+p2.lps
l.p011	vfd	o18//p2.lpo*/p2.lps
l.p012	vfd	18/p2.lps
l.p013	vfd	18/sffebd
l.p014	vfd	o18//tflisn
l.p015	vfd	18/tfmask
l.p016	vfd	18/p.rmsk
l.p017	vfd	18/sffsct+sffebd+sffdct+sffcii+sffcoi
l.p018	vfd	18/sffbsc+sffsyn+sffhdl
l.p019	oct	010000	icw exhaust bit
l.p020	vfd	18/tfofc
l.p021	vfd	18/tfosus
	ttls	subroutines for masking/unmasking channel
	rem
	rem	mskchn is called by the status processor when it discovers
	rem	that the interrupt handler masked a channel because of
	rem	excessive interrupts. its job is to report this to the
	rem	host (via denq), set a flag in the tib, and force the
	rem	channel to its starting point in the control tables. the
	rem	channel should remain dormant until the host sends a new
	rem	listen order.
	rem
	rem	x1 contains virtual tib address as usual
	rem	x2 contains virtual sfcm address
	rem
mskchn	subr	msk,(x3)
	ilq	linmsk
	tsy	a.p003-*,*	denq
	lda	l.p014-*	=^tflisn
	ansa	t.flg,1	force listen flag off
	lda	l.p015-*	=tfmask
	orsa	t.flg3,1	and masked flag on
	rem		now clear out all buffers (except t.dcp,
	rem		which is dia_man's problem)
	stz	mocur-*	initialize ocur flag
	lda	t.ocp,1
	tze	msk010-*
msk005	cmpa	t.ocur,1	is t.ocur included in t.ocp?
	tze	msk007-*	yes
	tsy	a.p008-*,*	(setbpt) not this one, look at next
	cax3
	lda	bf.nxt,3	pointer to next buffer
	tnz	msk005-*	if any
	tra	msk008-*	else no match, proceed
msk007	aos	mocur-*	set flag to indicate overlap
msk008	lda	t.ocp,1	get original pointer back
	tsy	a.p006-*,*	frelbf
msk010	lda	t.ocur,1
	tze	msk020-*
	szn	mocur-*	was t.ocur chain subset of t.ocp chain?
	tnz	msk015-*	yes, it's already been freed
	tsy	a.p006-*,*	frelbf
msk015	stz	t.ocur,1
msk020	stz	t.ocp,1
	stz	sf.ob0,2
	stz	sf.ob1,2
	stz	t.ocnt,1	all output buffers flushed now
	lda	t.icp,1
	tze	msk050-*
	tsy	a.p006-*,*	frelbf
	stz	t.icp,1
	stz	t.icpl,1
msk050	lda	sf.ib0,2
	tze	msk060-*
	tsy	a.p008-*,*	(setbpt) fribuf wants virtual address
	cax3		in x3
	tsy	a.p009-*,*	fribuf
	stz	sf.ib0,2
msk060	lda	sf.ib1,2
	tze	msk070-*
	tsy	a.p008-*,*	(setbpt) fribuf wants virtual address
	cax3		in x3
	tsy	a.p009-*,*	fribuf
	stz	sf.ib1,2
msk070	null		buffers all gone, wipe out temporary sfcm flags
	lda	l.p017-*	sfcm flags that should stay around
	ora	l.p018-*	and more of the same
	ansa	sf.flg,2	turning off any others that are on
	ldx3	sf.hcm,2	ruin all icws
	ila	0
	ldq	l.p019-*	=010000, exhaust bit
	staq	h.ric0,3
	staq	h.ric1,3
	staq	h.sic0,3
	staq	h.sic1,3
	stz	sf.nic,2	don't keep old character pointers
	rem
	lda	t.type,1	ascii or other?
	icmpa	ttasci
	tnz	msk075-*	non-ascii, check for tib extension
	lda	t.rcp,1	else check for replay chain
	tze	msk080-*	none, we're finished
	tsy	a.p006-*,*	(frelbf) free it
	stz	t.rcp,1	not there any more
	tra	msk080-*	done now
	rem
msk075	ldx3	t.elnk,1	get address of tib extension to free it
	tze	msk080-*	none, do nothing
	stz	t.elnk,1	no longer has ext
	ldq	0,3	length
	iaq	1	plus control word
	tsy	a.p010-*,*	=fremem
	rem
msk080	stz	t.reta,1
	lda	a.p004-*	address of restarting op block
	sta	t.cur,1	make channel start there next time
	tsy	a.p011-*,*	(itest) poke it so it goes to right tables
	return	mskchn
	rem
	rem
	rem
	rem	hunmsk is called by dia_man when a listen order is
	rem	received for a channel with tfmask on (i.e., that has
	rem	previously been masked). it resets the various masked bits,
	rem	re-establishes the sfcm status queue pointers, and unmasks
	rem	the channel.
	rem
	rem
hunmsk	subr	unm,(inh,x2)
	ldx2	t.sfcm,1	we'll need the sfcm
	lda	sf.pcw,2
	icana	pb.msk	did we mask it, in fact?
	tze	unm010-*	no
	cx2a		get (virtual) address of
	iaa	sf.waq	software status queue
	sta	sf.nxp,2	and store it
	sta	sf.nxa,2	in sfcm
	lda	sf.ssl,2	get length of queue
	sta	sf.tly,2	initialize this too
	stz	sf.pcw,2	clear out the "masked" bit
	lda	l.p016-*	(=p.rmsk) get "reset mask" opcode
	tsy	a.p005-*,*	cioc
unm010	lda	l.p015-*	=tfmask
	iera	-1	complement tib "masked" bit
	ansa	t.flg3,1	so as to turn it off
	return	hunmsk
	rem
	rem
	rem
mocur	bss	1	indicator for whether t.ocp and t.ocur
	rem		chains overlap
	ttls	cioc - connect subroutine
cioc	subr	cio,(x1,x2,x3,inh)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	cioc
*
*	     subroutine to perform a connect to a hsla
*	subchannel. a pcw type 1 is issued with the pcw
*	broadside bits in the sfcm.
*
*	upon entry:
*	     a  - contains pcw op-code to use
*	     x1 - virtual tib address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	sta	ciopcw-*	save the pcw op-code
	lda	l.c006-*	(=pcw.1) get command type code
	orsa	ciopcw-*	and put it into pcw
	lda	t.line,1	get the line number
	iana	31	(=o37) leave just subch number
	als	6	position it for pcw
	orsa	ciopcw-*	put into pcw
	rem
	ldx2	t.sfcm,1	get ptr to sfcm
	lda	sf.pcw,2	get pcw broadside bits
	sta	ciopcw+1-*	put them into pcw, too
	rem
	rem	pcw model setup, select chan and do cioc
	rem
	lda	t.line,1	get line no again
	ars	6
	iana	7	turn off "is_hsla" bit
	iaa	h1ch	add in base hsla chan no
	rem		to get iom chan no 6, 7 or 8
	ora	l.c007-*	(=sel 0) or in select instruction
	sta	1	put it down to execute
	sel	0	(patched) select the right chan
	rem
	ldx3	sf.hsl,2	get pointer to hsla table entry
	ldx3	ht.tib,3	get real tib address for trace
	trace	tt.pcw,ts.pcw,(x3,ciopcw,ciopcw+1)
	rem
	cioc	ciopcw-*	hit channel with pcw
	return	cioc
	even
ciopcw	bss	2	(altrd) pcw temp for cioc
	ttls	seticw - setup the output icw's
seticw	subr	sic,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	seticw
*
*	     seticw setups the output icw's for the
*	buffer chain pointed to by t.ocur. it assumes no
*	active output icw and stores into both.
*
*	upon entry:
*	     x1 - virtual tib address
*
*	returns:
*	     both output icw's setup
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get addr of sfcm
	ldx3	sf.hcm,2	get addr of hwcm region
	rem
	iacx3	h.sic0	add in offset
	stx3	sicicw-*	save it away
	ldx3	t.sfcm,1	get ptr to sfcm
	iacx3	sf.ob0	add in other offset
	stx3	sicobp-*	save it also
	rem
	lda	sf.flg,2	get sfcm flag word
	icana	sffcoi	which icw is active?
	tze	sic010-*	primary, use it first
	rem
	ila	h.sic1-h.sic0	get difference
	asa	sicicw-*	update ind word
	ila	sf.ob1-sf.ob0	get other difference
	asa	sicobp-*	save it also
	rem
sic010	lda	t.ocur,1	pick up ptr to next output buffer
	sta	sicobp-*,*	put into the sfcm
	tsy	a.c005-*,*	setbpt
	cax3		get virtual address
	stx3	sicbuf-*	hang on to it
sic020	cx3a		get ptr into the a
	tze	sicret-*	no buffer
	iaa	bf.dta	get offset of data
	ora	l.c005-*	(=0,b.0) or in the character  addressing
	caq		hide it away
	rem
	lda	bf.tly,3	get the buffer tally
	ana	l.c001-*	(=buftmk) isolate the tally
	llr	18	switch a and q
	stx3	settmp-*
	ldx3	sicicw-*	get ptr to icw words
	tsy	a.c006-*,*	(bldicw) set up icw
	rem
	ldx3	settmp-*	get the buffer addr again
	tsy	a.c002-*,*	(=oscan) scan the buffer
	rem
	tsy	a.c001-*,*	(=outpar) output parity for ebcdic
	rem
sic030	lda	bf.flg,3	get buffer flag bits
	cana	l.c002-*	(=bfflst) last buffer in msg?
	tnz	sic050-*	yes, pretty much done
	rem
	szn	bf.nxt,3	is there any more chain?
	tze	sicret-*	nope, all done here
	rem
	ila	sfhmk	get mask to switch icw ptr
	ersa	sicicw-*
	ila	sfbfmk	get mask to switch buffer ptrs
	ersa	sicobp-*
	rem
	lda	bf.nxt,3	get addr of next guy in chain
	sta	sicobp-*,*	and into sfcm
	tsy	a.c005-*,*	(setbpt) get virtual address
	cax3		we'll need it in x3 too
	iaa	bf.dta	get offset of data
	ora	l.c005-*	(=0,b.0) or in char addressing bits
	caq		hang on to address
	rem
	lda	bf.tly,3	get the tally
	ana	l.c001-*	(=buftmk) isolate tally
	llr	18	switch a and q
	ldx3	sicicw-*	get ptr to icw
	tsy	a.c006-*,*	(bldicw) put into icw
	rem
	lda	t.ocur,1	get ptr to first buffer
	tsy	a.c005-*,*	setbpt
	cax3
	lda	bf.nxt,3	get next buffer addr
	tsy	a.c005-*,*	setbpt
	cax3
	tsy	a.c002-*,*	(=oscan) scan the buffer
	tsy	a.c001-*,*	(=outpar) output parity for ebcdic
	rem
	lda	bf.flg,3	get buffer flags
	cana	l.c002-*	(=bfflst) last buffer ?
	tze	sicret-*	no
	rem
sic050	lda	l.c010-*	(=sffhdl) is it HDLC?
	cana	sf.flg,2
	tze	sicret-*	no
	lda	l.c008-*	(=tsftre) get tally runout enable bit
	orsa	t.stat,1	turn it on in tib status
	rem
	rem
sicret	return	seticw
	rem
	rem
sicicw	bss	1	(altrd) icw ptr
sicobp	bss	1	(altrd) sf.ob0/1 ptr
oddchr	bss	1
settmp	bss	1
sicbuf	bss	1	virtual pointer to current buffer
sicnoc	bss	1	local address of next output character
	rem
l.c001	vfd	18/buftmk
l.c002	vfd	18/bfflst
*l.c003		unused
*l.c004		unused
l.c005	ind	0,b.0
l.c006	vfd	18/pcw.1	pcw type 1
l.c007	sel	0	select instruction
l.c008	vfd	18/tsftre
l.c009	vfd	o18//tfwrit
l.c010	vfd	18/sffhdl
	rem
a.c001	ind	outpar
a.c002	ind	oscan
a.c003	ind	freout
a.c004	ind	g3wjt
a.c005	ind	setbpt
a.c006	ind	bldicw
	ttls	hintr - hsla interrupt handler
hintr	null
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hintr
*
*	     this routine handles interrupts for all of
*	the hsla subchannels, and takes status from the
*	hardware status buffer and queues it for process-
*	ing by the scheduled status processor, hstprc. hstprc
*	will be scheduled to process the status queue if it is
*	not already scheduled.
*
*	upon entry:
*	     a call to g3jwt will return the third word of
*	     the jump table, as follows:
*
*		bits 0-3    iom channel number        
*		bits 4-5    hsla number(1-3)        
*		bits 6-10   subchannel number(0-31)        
*		bits 11-17  module number of hsla_man        
*
*	returns:
*	     entries queued for hstprc
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	tsy	a.c004-*,*	(=g3jwt) get third word of jump table
	stq	intjtw-*	save the result
	rem
	trace	tt.int,ts.int,(intjtw)
	ldq	intjtw-*
	cqa		put copy into the a
	ars	12	shift down to get hsla number
	iana	3	leave only the hsla number
	iaa	-1	subtract one to get 0-2
	ora	l.d001-*	(=000010) turn on is_hsla bit
	als	6	shift back into proper position
	sta	intlno-*	save as part of line number
	rem
	cqa		get another copy
	ars	7	shift down subchannel number
	iana	31	leave only subchan number
	orsa	intlno-*	put into line number
	rem
	lda	intlno-*	pick it up for call
	tsy	a.d005-*,*	(=gettib) get the tib addr
	iaa	0	set the indicators
	tze	intret-*	no tib, ignore interrupt
	rem
	sta	intrtb-*	save real tib address for dspqur
	tsy	a.d010-*,*	(setptw) virtualize real tib address
	sta	intvtb-*	save for easy reference
	cax1		put virtual tib address into x1
	ldx2	t.sfcm,1	get the virtual sfcm address
	tnz	2	should be non-zero
	die	10	nope, die
	rem
	lda	sf.ssl,2	figure out current number of pending status
	sba	sf.tly,2	to meter it
	sta	intcnt-*
	cmeter	mupdat,m.nst,intcnt-*
	rem
	stz	inthqf-*	clear status exhaust indicator
	stz	intsqo-*	clear status queue overflow switch
	ila	hpri	get basic priority
	sta	intskd-*	set in sked words
	rem
	ldx3	sf.hcm,2	get hardware comm region address
	lda	h.aicw+1,3 get second word of status icw
	cana	l.d002-*	is it exhausted?
	tze	int002-*	no
	aos	inthqf-*	indicate that is so for later
	rem
int002	lda	t.sfcm,1	get address of sfcm
	iaa	sf.sta	add in the queue offset
	sta	intcrp-*	first status if primary
	rem
	lda	sf.flg,2	get sfcm flag word
	cana	l.d019-*	(=sffcai) is hardware alt buffer being used
	tnz	int004-*	yes
	rem
	lda	l.d019-*	(=sffcai) or in alt hardware status
	orsa	sf.flg,2
	lda	intcrp-*	get back address of status queu
	iaa	sf.shq-sf.sta add in the difference
	tra	int006-*
	rem
int004	lda	l.d020-*	(=^sffcai)
	ansa	sf.flg,2	turn off alt indicator
	ldq	intcrp-*	get current position
	ila	sf.shq-sf.sta delta of hardware queue
	asa	intcrp-*	adjust first status pointer
	cqa		get back orginal address for status
	rem
int006	sta	intvir-*	temporarily save virtual address
	tsy	a.d007-*,*	(cvabs) get absolute address for icw
	ldq	intsai-*	second word of status icw
int007	staq	h.aicw,3	store icw now
	nop		buy some time
	cmpa	h.aicw,3	see if we change it
	tze	int008-*	yes all done
	ldx3	intvir-*	set to point to first status of this queue
	szn	0,3	set indicators
	tnz	int008-*	new status all done
	ldx3	sf.hcm,2	get hcm address
	tra	int007-*	try again
	rem
int008	lda	intcrp-*	get first status to process
	iaa	sfhsiz*2+2 calc end of queue
	sta	intend-*	for later processing
	ldx3	intcrp-*	set to point to first status
	rem
	lda	sf.flg,2	get sfcm flags
	icana	sffisc	inactive subchannel?
	tnz	int050-*	yes, get out of here
	rem
int010	lda	0,3	is this status word zero?
	tze	int050-*	yes, all done
	cana	l.d010-*	(=hs.rcs) rcv status ?
	tze	int014-*	no
	rem
	cana	l.d004-*	(=hs.tro) tally runout ?
	tze	int011-*	no
	rem
	rem		tally runout means we just dropped out of
	rem		rcv mode.  make sure we stay out.
	rem
	lda	l.d011-*	(=/pb.rcv)
	ansa	sf.pcw,2	turn off pcw rcv bit
	tra	int020-*
	rem
int011	cana	l.d007-*	(=hs.siw) switching icw ?
	tze	int020-*	no, continue
	rem
	stx3	intcrp-*	save status queue addr
	caq		put status word in q
	rem
	ldx3	sf.hcm,2	get hwcm addr
	iacx3	h.ric0	get primary rcv icw addr
	cana	l.d008-*	(=hs.aiw) alt icw active ?
	tze	2	no
	iacx3	h.ric1-h.ric0	get alt rcv icw addr
	rem
	lda	1,3	get icw tally
	ana	l.d009-*	(=007777) leave only tally
	sta	inttly-*	save it
	rem
	lda	l.d018-*	(=410000) get exhausted tally
	sta	1,3	put it in icw
	rem
	lda	sf.flg,2	synchronous?
	cana	l.d005-*	=sffsyn
	tnz	int012-*	yes
	cqa		no, get first word of status again
	tra	int013-*	skip tally manipulation
int012	cqa		get status back in a
	ldx3	sf.ib0,2	get primary buffer addr
	cana	l.d008-*	(=hs.aiw) alt. icw active ?
	tze	2	no
	ldx3	sf.ib1,2	get alt buffer addr
	cx3a		virtualize it
	tsy	a.d001-*,*	setbpt
	cax3
	rem
	ldq	bf.tly,3	get max buffer tally
	sbq	inttly-*	subtract icw tally
	stq	bf.tly,3	put actual tally in buffer
	rem
int013	ldx3	intcrp-*	restore status queue addr
	rem
int014	cana	l.d007-*	(=hs.siw) switching icw ?
	tze	int020-*	no, process status at normal priority
	rem
*	lda	sf.flg,2	get sfcm flags
*	cana	l.d005-*	synchronous line ?
*	tze	int015-*	no, use priority 3
*	rem
*	ldx2	sf.hsl,2	get address of hsla table
*	lda	ht.flg,2	pick up word with speed
*	ldx2	t.sfcm,1	restore x2
*	iana	htfspd	leave only the channel speed
*	icmpa	8	is it more than 9600 baud?
*	tmi	int015-*	no, use priority 3
*	rem
*	ila	hprip2	use real high priority
*	tra	2
	rem
int015	ila	hprip3	get priority 3 for sked
	sta	intskd-*	reset scheduler priority
	rem
	lda	l.d014-*	=sffmsp
	iera	-1	if switching icws, turn it off
	ansa	sf.flg,2
	rem
int020	szn	sf.tly,2	any room in status queue?
	tnz	int025-*	yes, continue
	rem
	szn	intsqo-*	status overflow occurred already ?
	tnz	int024-*	yes, skip it
	rem
	tsy	a.d015-*,*	handle status queue overflow
	aos	intsqo-*	remember it
	rem
int024	stz	0,3	zero the ignored status
	tra	int030-*	leave here
	rem
int025	lda	sf.flg,2	synchronous?
	cana	l.d005-*	=sffsyn
	tnz	int028-*	yes, skip the marker test
	lda	0,3	get first word of status
	cana	l.d013-*	(=hs.nms) marker status?
	tze	int028-*	nope
	lda	sf.flg,2	yes, is one already pending
	cana	l.d014-*	(=sffmsp)
	tze	int027-*	no, we'll have to store this one
	lda	0,3	(get first word of status back)
	cana	l.d015-*	yes, but are there any other interesting ones?
	tnz	int027-*	yep
	stz	0,3	ignore this status
	tra	int040-*
	rem
int027	lda	0,3	get first word of status again
	cana	l.d007-*	(=hs.siw) switching icws?
	tnz	int028-*	then don't set flag
	lda	l.d014-*	=sffmsp
	orsa	sf.flg,2	turn it on
int028	null
	ldaq	0,3	get the current status words
	staq	sf.nxa,2*	put into the software queue
	stz	0,3	zero the current status
	rem
	cana	l.d007-*	*is it hs.siw for switching
	tze	int28a-*	*no continue
	cana	l.d010-*	*is it hs.rcv recieve only
	tze	int28a-*	*no again
	lda	sf.flg,2
	cana	l.d017-*	*(sffhdl+sffbsc) is it bsc or HDLC?
	tze	int28a-*	no
	tsy	a.d014-*,*	*(swphic) switch buffer now
	rem
int28a	ila	-1	decrement the tally
	asa	sf.tly,2
	ila	4	increment the next available
	asa	sf.nxa,2	pointer
	rem
	lda	sf.ssl,2	get length of status queue
	als	2	in words
	sta	intsql-*
	cx2a		put sfcm ptr into a
	iaa	sf.waq
	ada	intsql-*	get ptr to end of status queue
	cmpa	sf.nxa,2	are we at end of queue?
	tnz	int030-*	nope, continue
	rem
	cx2a		copy sfcm ptr to a
	iaa	sf.waq	get ptr to beginning of queue
	sta	sf.nxa,2	put into q ptr, wrapping q
	rem
int030	lda	sf.flg,2	get the sfcm flags
	icana	sffskd	is the status processor scheduled?
	tnz	int040-*	yes, continue
	rem
	ila	sffskd	get flag bit
	orsa	sf.flg,2	turn it on now
	rem
	ldx1	intrtb-*	get real tib address for dspqur
	ldaq	intskd-*	(queue element)
	tsy	a.d002-*,*	(=dspqur) queue hstprc to process status
	rem		note: x1 contains real tib address
	ldx1	intvtb-*	restore virtual tib address to x1
	rem
int040	iacx3	2	bump to next status
	cmpx3	intend-*	are we at end of buffer?
	tnz	int010-*	no, continue
	rem
int050	szn	intsqo-*	did we overflow?
	tnz	int060-*	yes and we process it
	szn	inthqf-*	hardware overflow?
	tze	int060-*	no
	rem
	cmeter	mincs,m.hsqo,l.d016-*
	rem
	tsy	sqovfl-*	handle status queue overflow
	aos	intsqo-*	now process hardware the same as software
	rem
int060	null
int070	szn	intsqo-*	did we get another status queue overflow?
	tze	intret-*	no, all is well
	rem
	aos	sf.rct,2	bump the repeat count
	lda	sf.rct,2	get the new value
	icmpa	20	compare to some random number
	tmi	intret-*	no there yet, let channel run a bit more
	rem
	ldx2	t.sfcm,1	reset sfcm ptr
	ila	pb.msk	set software "mask" bit
	sta	sf.pcw,2	in pcw, and zero other bits (like dtr!!)
	lda	l.d003-*	(=p.msk) get mask op
	tsy	a.d009-*,*	(=cioc) connect to channel
	rem
intret	tra	a.d004-*,*	(=mdisp) return to master dispatcher
	rem
	rem
intcnt	bss	1	used for count of pending status
intjtw	bss	1	(altrd) 3rd word of jump table
inthqf	bss	1	hardware queue overflow
intend	bss	1	(altrd) end of hardware status buffer
intcrp	bss	1	(altrd) current hardware status ptr
intrtb	bss	1	save for real tib address
intvtb	bss	1	save for virtual tib address
intsql	bss	1	length of software status queue
intvir	bss	1	virtual address of head of hardware status queue
	rem
	even
intskd	zero	hpri	priority of hstprc
	ind	hstprc	routine to be run
intsai	amicwo	w.2,sfhsiz,0
	rem
	rem	following two words must be together for error message
interr	dec	4	error code
intlno	bss	1	(altrd) line number - tib type
	rem
intsqo	bss	1
inttly	bss	1
	rem
	rem
l.d001	vfd	o18/000010	is_hsla bit
l.d002	vfd	o18/010000
l.d003	vfd	18/p.msk
l.d004	vfd	18/hs.tro
l.d005	vfd	18/sffsyn
l.d006	oct	000130,000110
l.d007	vfd	18/hs.siw
l.d008	vfd	18/hs.aiw
l.d009	oct	007777
l.d010	vfd	18/hs.rcs
l.d011	vfd	o18//pb.rcv
l.d012	vfd	18/sffsqo
l.d013	vfd	18/hs.nms
l.d014	vfd	18/sffmsp
l.d015	vfd	18/hs.siw+hs.ptr+hs.tro+hs.dss
l.d016	dec	1
l.d017	vfd	18/sffhdl+sffbsc
l.d018	oct	410000	exhausted icw with 18-bit addressing on
l.d019	vfd	18/sffcai	altenate status buffer
l.d020	vfd	o18//sffcai and mask for turning off alt status
	rem
a.d001	ind	setbpt
a.d002	ind	dspqur
a.d003	ind	0,w.2
a.d004	ind	mdisp
a.d005	ind	gettib
a.d006	ind	.crpte	pointer to variable cpu page table word
a.d007	ind	cvabs
*a.d008	unused
a.d009	ind	cioc
a.d010	ind	setptw	set up page table word
a.d011	ind	stpcnt
a.d012	ind	stpret
a.d013	ind	stpswd
a.d014	ind	swphic
a.d015	ind	sqovfl
	ttls	preallocated buffer tables
	rem
	rem	preallocated chain table
	rem	a pointer to the preallocated buffer pool.
	rem
pchtbl	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	rem
	rem	preallocated chain left table
	rem	the number of buffers in the preallocated chain
	rem
pchlft	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	rem
	rem	preallocated buffer max count table
	rem
pbfmax	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	oct	000000
	ttls	albchs - allocate buffer check
******************************************************************************
*
*	albchs - alocate buffer check
*
*	This will check and allocate the preallocated buffer
*	chains for any high speed sync lines.
*	If no buffer can be allocated,
*	the icw switching code will handle it when the time comes
*	as an exhaust condition.
*	Coded for switching icw problem by
*		D. W. Cousins on March 24, 1981
*
*****************************************************************************
albchs	subr	alb,(a,q,x1,x2,x3)
	ila	0	*set up index for table
	cax2
alb010	icmpa	8	*is it max yet
	tze	albret-*	*finish
	lda	a.w003-*,*	*(pbfmax,2) get max buffer for this line
	tze	alb040-*	*if zero no allocate
	sta	pamax-*	*store it temp for compare
alb020	lda	a.w002-*,*	*(pchlft,2) number of buffer left
	cmpa	pamax-*	*compare number left to max
	tze	alb040-*	*already full
	tpl	alb040-*	*that all for now
	cx2a		*calc the bufer size
	iaa	1
	als	5
	caq		*put it in q for getubf
	tsy	a.w004-*,*	*=getubf
	tra	alb030-*	*error no buffer
	sta	albabs-*	save absolute address
	lda	bf.siz,3	*get it real size
	arl	15
	als	bufshf+1
	iaa	hbfnch
	orsa	bf.tly,3
	ldx3	albabs-*	get absolute address again
	tsy	adtopa-*	*add it to the chain
	rem
	smeter	mincd,.mbfpa,l.w002-*
	rem
	tra	alb020-*	*go again
alb030	null		*allocation failed it ok now
alb040	iacx2	1	*inc the counter for next buffer
	cx2a		*get it to a for max test
	tra	alb010-*	*check again
albret	return	albchs
	rem
pamax	bss	1
albabs	bss	1
	rem
a.w001	ind	pchtbl,2	prellocated buffer chain
a.w002	ind	pchlft,2	number of buffer left in chain
a.w003	ind	pbfmax,2	max number of buffer in a chain
a.w004	ind	getbfh	get user buffer
a.w005	ind	frebfh	free buffer
a.w006	ind	setbpt	virtualize buffer address
	rem
l.w001	vfd	18/sffhdl+sffbsc
l.w002	dec	1
	ttls	adtopa - add to preallocated chain
***********************************************************************
*	adtopa - add to preallocated chain
*
*	This inhibited code adds a buffer to the
*	preallocated chain for a particular buffer size.
*
*	   x2 contains offset into buffer-size tables for the
*		given size.
*
*	This is to help icw switching problem
*	coded by D. W. Cousins on March 24, 1981
*
*********************************************************************
adtopa	subr	adt,(x1,inh)
	lda	a.w001-*,*	(pchtbl,2) get head of chain
	tze	adt020-*	*may be finish
adt010	tsy	a.w006-*,*	setbpt
	cax1		*ok we got the virtual address
	lda	bf.nxt,1	*get the next address
	tze	adt030-*	*good we arrive
	tra	adt010-*	*again
adt020	stx3	a.w001-*,*	*(pchtbl,2) store the address at the head
	tra	adt040-*	*all done
adt030	stx3	bf.nxt,1	*store it in the buffer
adt040	aos	a.w002-*,*	*(pchlft,2) add one to number of buffer in chain
	return	adtopa	*all done
	ttls	dumsbf - dump store buffer
*******************************************************************
*
*	dumsbf - dump store buffer
*
*	icw switching stored the buffer address with the software
*	status in the sfcm for bsc and hdlc channels. This will dump it.
*
*	Written by D. W. Cousins on April 13, 1981 for sicw problem
*
*******************************************************************
	rem
dumsbf	subr	dsf,(x2)
	ldx2	t.sfcm,1	*some basic check
	lda	sf.flg,2
	cana	l.w001-*	* (sffhdl+sffbsc) is it bsc or hdlc?
	tze	dsfret-*	*no
	ilq	0	*going to tell frebuf to use buffer size
	lda	bftsa-*	*get the buffer
	tze	dsfret-*	*zero buffer address
	tsy	a.w005-*,*	*=frebfh
dsfret	return	dumsbf
	rem
bftx3	bss	1
bftsa	bss	1
	ttls	sqovfl - status queue overflow
sqovfl	subr	sqo(x2)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	sqovfl
*
*	finds the last status stored in the software
*	status queue and turns on the sqo bit.  also,
*	takes the channel out of receive mode.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	cmeter	mincs,m.ssqo,l.d016-*
	rem
	lda	l.d012-*	(=sffsqo)
	cana	sf.flg,2	status queue overflow pending ?
	tnz	sqoret-*	yes, done
	orsa	sf.flg,2	indicate status queue overflow
	rem
	lda	l.d011-*	(=/pb.rcv)
	ansa	sf.pcw,2	turn off pcw rcv bit
	ila	p.nop	get pcw nop command
	tsy	a.d009-*,*	(cioc) exit rcv mode
	rem
	lda	sf.ssl,2	get length of status queue
	qls	4	in words
	sta	sqosql-*
	cx2a		put sfcm addr in a
	iaa	sf.waq	get start of status queue addr
	cmpa	sf.nxa,2	next status at start of queue ?
	tnz	sqo010-*	no
	ada	sqosql-*	get end of queue addr
	tra	sqo020-*
	rem
sqo010	null
	lda	sf.nxa,2	get next status addr
	rem
sqo020	null
	iaa	-4	back up to last status
	cax2		put in x2
	rem
	ila	hs.sqo	get status queue overflow bit
	orsa	0,2	set sqo in last status
	rem
sqoret	return	sqovfl
	rem
sqosql	bss	1
	ttls	hstprc - hsla status processor
hstprc	null		transfered to by secondary dispatcher
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	hstprc
*
*	     this routine is the main guts of hsla_man.
*	it is the scheduled status processor, which processes
*	the status queued for it by hintr, the interrupt
*	handling routine. All queued status for a line is processed
*	by hstprc before it returns. some of this processing
*	may result in the dcw interpreter or the control
*	table interpreter being called.
*
*	upon entry:
*	     x1 - real tib address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	cx1a		get real tib address in a
	sta	stptib-*	save for use with dspqur and trace
	tsy	a.d010-*,*	(setptw) virtualize real tib address
	cax1		virtual tib address goes in x1
	ldx2	t.sfcm,1	get virtual sfcm address
	rem
	lda	sf.ssl,2	figure out current number of pending status
	sba	sf.tly,2	to meter it
	sta	a.d011-*,*	(stpcnt)
	cmeter	mupdat,m.nst,(a.d011-*(*))
	rem
	lda	sf.tly,2	get queue tally
	cmpa	sf.ssl,2	is it at max?
	tze	a.e019-*,*	(stp210) yes, no work to be done here
	rem
	stz	a.d011-*,*	(stpcnt) zero status processed counter
	rem
stp010	lda	sf.pcw,2	check to see if channel is masked
	icana	pb.msk
	tze	stp012-*	it isn't, proceed
	tsy	a.e026-*,*	(mskchn) it is, report it
	ila	sffskd	through processing status
	iera	-1	so turn off "scheduled" bit
	ansa	sf.flg,2
	stz	sf.rct,2
	tra	a.e027-*,*	(stpret) all finished
stp012	aos	a.d011-*,*	(stpcnt) bump counter of number processed
	lda	a.d011-*,*	(stpcnt) get counter value
	icmpa	3	have we done to many in a row?
	tmi	stp015-*	no
	rem
	ldx1	stptib-*	yes. get real tib address
	ila	hpri	get default scheduling priority
	ldq	intskd-*+1	(=hstprc) get addr of status processor
	tsy	a.d002-*,*	(=dspqur) reschedule status processor
	tra	a.d012-*,*	(=stpret) done for now
	rem
stp015	tsy	a.e023-*,*	(=albchs)
	ldaq	sf.nxp,2*	pick up the next status to be processed
	staq	a.d013-*,*	(=stpswd) save it away
	ldx3	sf.nxp,2	*get address of current status
	lda	2,3	*get the buffer address
	sta	bftsa-*	*store it now
	stx3	bftx3-*	*save the address to it
	trace	tt.sta,ts.sta,(stptib,stpswd,stpswd+1)
	rem
	aos	sf.tly,2	increment the tally
	ila	4	and also the next ptr
	asa	sf.nxp,2	to the status q
	rem
	lda	sf.ssl,2	get size of status queue
	als	2	in words
	sta	stpsql-*
	cx2a		put x2 into a
	iaa	sf.waq	get ptr to end of queue
	ada	stpsql-*
	cmpa	sf.nxp,2	are we at the end?
	tnz	stp020-*	no, continue
	rem
	cx2a		put sfcm into a again
	iaa	sf.waq	make ptr to head of queue
	sta	sf.nxp,2	and reset ptr, wraping queue
	rem
stp020	stz	stpmrk-*	init saved status
	lda	stpswd-*	get the first word of status
	cana	l.e001-*	(=hs.rcs) input status?
	tze	a.e020-*,*	(=stp100) no, output status
	eject
	rem	input status processor
	rem
	lda	t.stat,1
	ana	l.e006-*	(tsfst+tsfmrk+tsftrm) isolate requested status
	sta	stpmrk-*	save it for later
	iera	-1
	ansa	t.stat,1	turn off the tib flags
	rem
	lda	stpswd+1-*	get the 2nd status word
	arl	1	line up with tib rcv status bit
	ora	t.stat,1	or in tib status
	ana	l.e002-*	(=tsfrcv) leave only that, rcv mode?
	tnz	stp030-*	yes, continue
	rem
	tsy	a.e001-*,*	(=dmpbuf) dump any input buffers
	tsy	dumsbf-*	dump tempory store buffer
	rem
	lda	stpswd-*	get the first word of status
	cana	l.e007-*	(=hs.dss) any data set status changes?
	tze	stp080-*	no, skip rest of hardware status
	rem
	tsy	a.e009-*,*	(=ipdss) process the data set changes
	rem
	tra	a.e024-*,*	(stp095)
	rem
stp030	lda	stpswd-*	get the status word
	ars	12	shift into line with the other bit
	era	sf.flg,2	x-or the other one in
	icana	sffcii	are the two bits the same?
	tze	stp040-*	yes, all ok
	rem
	lda	sf.flg,2	*must check for bsc and hdlc
	cana	l.e014-*	*(sffhdl+sffbsc) bsc or hdlc?  already got buffer
	tnz	stp040-*
	rem
	trace	tt.ira,ts.sta,(stptib) trace recovery try
	rem
	ldx3	sf.ib0,2	get ptr to first input buffer
	lda	sf.flg,2	get sfcm flag bits
	icana	sffcii	are we in alt buffer?
	tze	2	no
	ldx3	sf.ib1,2	get it here
	rem
	cx3a		any buffer?
	tze	stp035-*	no buffer
	rem
	rem		need virtual address
	tsy	a.e025-*,*	setbpt
	cax3
	tsy	a.e013-*,*	(=ipterm) simulate terminate interrupt
	rem
stp035	ila	sffcii	get bit
	ersa	sf.flg,2	invert it, we are right now?
	rem
stp040	lda	sf.flg,2	*check line type
	cana	l.e014-*	*(sffhdl+sffbsc) is it bsc or hdlc?
	tze	stp045-*	*no
	lda	stpswd-*	switched icws?
	cana	l.e024-*	=hs.siw
	tze	stp045-*	no, buffer isn't stored with status
	ldx3	bftsa-*	*load the buffer address
	tra	stp050-*	*go to next step
stp045	ldx3	sf.ib0,2	get primary buffer prt
	lda	sf.flg,2	get the sfcm flags
	icana	sffcii	alternate icw?
	tze	stp050-*	no, continue
	ldx3	sf.ib1,2	get the secondary buf ptr
	rem
stp050	stx3	stpbuf-*	indicate which buffer
	iacx3	0	zero buffer address ?
	tnz	stp051-*	no
	lda	l.e018-*	get mask for status word 0
	ansa	stpswd-*	turn off bits that imply a buffer
	lda	l.e019-*	get mask for status word 1
	ansa	stpswd+1-*	turn off bits that imply a buffer
	rem
stp051	lda	l.e014-*	(=sffbsc+sffhdl)
	cana	sf.flg,2	is it bisync or HDLC?
	tze	stp060-*	no
	rem
	rem	check bisync and hdlc status conditions
	rem
stp052	lda	stpswd-*	get first status word
	cana	l.e007-*	(=hs.dss), data set status change?
	tze	2	no
	tsy	a.e009-*,*	(=ipdss), process it first
	rem
	lda	stpswd-*	*load status word
	cana	l.e004-*	=hs.siw
	tze	stp053-*	*not switching yet
	lda	bftsa-*	*load the buffer address
	tze	stp053-*	*no buffer get out
	tsy	a.e025-*,*	setbpt
	cax3		get virtual address in x3
	tsy	a.e015-*,*	*(=ipbfsw) switch buffers
	rem
stp053	stz	stptra-*	zero status accumulation
	lda	l.e023-*	(=sffhdl)
	cana	sf.flg,2	HDLC line?
	tnz	stp05a-*	yes
	rem
	ldx3	a.e016-*	get bsc status map ptr
	lda	a.e017-*	get bsc status map end ptr
	sta	stpend-*	save it
	tra	stp05b-*
	rem
stp05a	ldx3	a.e021-*	get hdlc status map ptr
	lda	a.e022-*	get hdlc status map end ptr
	sta	stpend-*	save it
	rem
stp05b	lda	stpswd-*	get first status word
stp054	cana	0,3	isolate interesting bits
	tnz	stp057-*	if on, set them
	rem
stp056	iacx3	2	bump table ptr
	cmpx3	stpend-*	end of table ?
	tze	stp058-*	yes
	rem
	szn	0,3	switch words ?
	tnz	stp054-*	not yet
	rem
	lda	stpswd+1-*	get second status word
	tra	stp056-*
	rem
stp057	caq		save status word
	lda	1,3	get status bits
	orsa	stptra-*	turn them on
	cqa		restore status word
	tra	stp056-*
	rem
stp058	lda	stptra-*	check for any new status bits
	tze	stp080-*	none - try usual case
	rem
	lda	t.stat,1	get tib status flags
	iana	s.dss	leave only common bits
	ora	stptra-*	add interesting bits
	tsy	a.e004-*,*	(=istat) call interp to process status
	tra	stp075-*	continue
	rem
	even
stpswd	bss	2	save area for status word
stpbuf	bss	1	ptr to current buffer
stptra	bss	1	addr of routine to run
stpcnt	bss	1	count of processed status this call
stpmrk	bss	1	saved copy of tsfst+tsfmrk+tsftrm
stptib	bss	1	saved value of real tib address
stpend	bss	1	set to bscend or hdcend
stpsql	bss	1	length of software status queue
	rem
	rem
	rem
l.e001	vfd	18/hs.rcs
l.e002	vfd	18/tsfrcv
l.e003	vfd	o18//tsfst
l.e004	vfd	18/hs.siw
l.e005	vfd	18/tsfmrk+tsftrm
l.e006	vfd	18/tsfst+tsfmrk+tsftrm
l.e007	vfd	18/hs.dss
l.e008	vfd	o18/410000
l.e009	vfd	18/sffstp
l.e010	vfd	18/hs.nms
l.e011	vfd	18/hs.ptr
l.e012	vfd	18/tsfst
l.e013	vfd	o18//sffsqo
l.e014	vfd	18/sffhdl+sffbsc
l.e015	vfd	18/hs.rcv
l.e016	vfd	18/hs.xmt
l.e017	vfd	18/s.xte
l.e018	vfd	o18//hs.nms*/hs.dms*/hs.trm*/hs.ptr*/hs.per
l.e019	vfd	o18//hs.rbt*/hs.crc
l.e020	vfd	18/hs.per
l.e021	vfd	18/s.prty
*l.e022	unused
l.e023	vfd	18/sffhdl
l.e024	vfd	18/hs.siw
	rem
a.e001	ind	dmpbuf
a.e002	ind	istats
a.e003	ind	iends
a.e004	ind	istat
a.e005	ind	ostats
a.e006	ind	oends
a.e007	ind	hdcw
a.e008	ind	secdsp
a.e009	ind	ipdss
a.e010	ind	ipptro
a.e011	ind	dssflg
a.e012	ind	echock
a.e013	ind	ipterm
a.e014	ind	opptro
a.e015	ind	ipbfsw
a.e016	ind	bscsts
a.e017	ind	bscend
a.e018	ind	stp010
a.e019	ind	stp210
a.e020	ind	stp100
a.e021	ind	hdcsts
a.e022	ind	hdcend
a.e023	ind	albchs
a.e024	ind	stp095
a.e025	ind	setbpt
a.e026	ind	mskchn
a.e027	ind	stpret
	rem
	ttls	status lookup tables for hstprc
	rem
	rem	input status table
	rem
istats	stats	hs.tro,iptro
	stats	hs.trm,ipterm
	stats	hs.nms,ipmark
	stats	hs.ptr,ipptro
	stats	hs.xte,ipxte
	stats	hs.dss,ipdss
iends	equ	*
	rem
	rem	output status table
	rem
ostats	stats	hs.ptr,opptro
	stats	hs.tro,optro
	stats	hs.xte,opxte
oends	equ	*
	rem
	rem	table to map bisync status to wait block status
	rem
bscsts	smap	hs.trm,s.brch
	smap	hs.nms,s.bmk
	smap	hs.dms,s.bdmk
	smap	hs.xte,s.xte
	smap	hs.per,s.prty
	smap	hs.tro,s.xte
	smap	0,0
	smap	hs.rbt,s.rbt
	smap	hs.crc,s.prty
	smap	hs.rto,s.rto
bscend	equ	*
	rem
	rem	table to map hdlc status to wait block status
	rem
hdcsts	smap	hs.tro,s.exh
	smap	hs.isd,s.isd
	smap	hs.xte,s.xte
	smap	hs.fce,s.fcse
	smap	hs.rab,s.rabt
	smap	0,0
	smap	hs.byt,s.pbyt
	smap	hs.rbt,s.rbt
hdcend	equ	*
	ttls	hstprc - hsla status processor
	eject
stp060	lda	stpswd-*	get status word
	cana	l.e020-*	(=hs.per) parity error ?
	tze	stp062-*	no
	rem
	lda	t.stat,1	get tib status
	iana	s.dss	leave only interesting bits
	ora	l.e021-*	(=s.prty) set parity error status
	tsy	a.e004-*,*	(=istat) call interpreter
	rem
stp062	ldx3	a.e002-*	(=istats) get status table ptr
	lda	stpswd-*	get the status word
stp065	cana	0,3	is this status bit on?
	tnz	stp070-*	yes, call that routine
	rem
	iacx3	2	bump the ptr to next entry
	cmpx3	a.e003-*	(=iends) end of table?
	tnz	stp065-*	no, continue loop
	rem
	tra	stp080-*	continue status processing
	rem
stp070	lda	1,3	get the routine to call
	sta	stptra-*	save this addr
	lda	stpbuf-*	get pointer to the current buffer
	tsy	a.e025-*,*	setbpt
	cax3
	tsy	stptra-*,*	go call that routine
	rem
	lda	stpswd-*	get status word
	cana	l.e010-*	(=hs.nms) was it marker status?
	tze	stp075-*	no, continue
	rem
	cana	l.e011-*	(=hs.ptr) ptro status also?
	tze	stp075-*	no
	rem
	tsy	a.e010-*,*	(=ipptro) process the ptro
	rem
stp075	lda	stpswd-*	get the status word
	cana	l.e004-*	(=hs.siw) switching icw's?
	tze	stp095-*	no, continue
	rem
	ila	sffcii	get the icw indicator bit
	ersa	sf.flg,2	and flip the bit in flag word
	tra	stp095-*	finish the status processing
	rem
stp080	lda	l.e009-*	(=sffstp) get the stop channel bit
	cana	sf.flg,2	did we just reset xmit mode?
	tze	stp090-*	no, done
	rem
	iera	-1	invert the bit
	ansa	sf.flg,2	and turn it off in the sfcm
	rem
	stz	sf.ob0,2	zero ptrs in case we
	stz	sf.ob1,2	just did a stop channel
	rem
	ldx3	sf.hcm,2	get ptr to hwcm
	lda	l.e008-*	(=410000) get the exhaust bit
	sta	h.sic0+1,3	store in both icws to
	sta	h.sic1+1,3	make sure hsla does not use again
	rem
stp090	lda	stpswd-*	get the status word
	cana	l.e004-*	(=hs.siw) are we switching icw's?
	tze	stp092-*	no, continue
	rem
	ila	sffcii	get the icw bit
	ersa	sf.flg,2	invert it now
	rem
stp092	lda	sf.flg,2	get sfcm flag bits
	icana	sffech	is echo in progress now?
	tnz	stp095-*	yes, skip it
	rem
	lda	sf.pcw,2	get pcw bits
	icana	pb.xmt	are we in xmit mode?
	tnz	stp095-*	yes, can't echo now
	rem
	tsy	a.e012-*,*	(=echock) check about echoing now
	tra	stp095-*	win, we started to echo
	tra	stp095-*	but who cares anyway.
	rem
stp095	lda	stpmrk-*	any requested status?
	tze	stp200-*	no, continue
	cana	l.e005-*	(=tsfmrk+tsftrm) marker or terminate?
	tze	stp096-*	no
	rem
*	only do terminate and/or marker status if hardware status agrees
*	with tib status with respect to recieve and transmit modes
	rem
	lda	t.stat,1	pick up tib status
	als	1	line up tib rcv bit with hw rcv bit
	era	stpswd+1-*	get xor of rcv bits
	ana	l.e015-*	(=hs.rcv) isolate result
	tnz	stp096-*	bits were different
	lda	t.stat,1	get tib status bits again
	ars	1	line up xmt bits
	era	stpswd+1-*
	ana	l.e016-*	isolate xor of xmt bits
	tnz	stp096-*	bits were different
	rem
	lda	t.stat,1	get tib status
	iana	s.dss	but only the ones we want
	ora	stpmrk-*	get requested status bits
	ana	l.e003-*	(=/tsfst) but turn off this one
	caq		save status bits
	lda	l.e005-*	(=tsfmrk+tsftrm)
	iera	-1	invert bits
	ansa	stpmrk-*	turn off marker and terminate
	cqa		get saved status back in a
	rem
	tsy	a.e004-*,*	(=istat) call intrp to process status
	tra	stp200-*	done with rcv status
	rem
stp096	lda	stpmrk-*
	cana	l.e012-*	(=tsfst) requested status?
	tze	stp200-*	no, all done with status
	rem
	lda	l.e012-*	(=tsfst) get the bit
	iera	-1	invert it
	ansa	stpmrk-*	turn it off
	rem
	aos	a.e011-*,*	(=dssflg) set flag to ipdss
	rem		to indicate requested status
	tsy	a.e009-*,*	(=ipdss) process status
	tra	stp200-*	done
	eject
	rem	output status processor
	rem
stp100	lda	stpswd-*	get the status word
	ars	11	align the icw bits
	era	sf.flg,2	leave only the one we want
	icana	sffcoi	should not be on!
	tze	stp105-*	good, all ok
	rem
	trace	tt.ira,ts.sta,(stptib) trace recovery try
	rem
	ldx3	sf.ob0,2	recover output buffers
	lda	sf.flg,2	get flags
	icana	sffcoi	alt output bfr?
	tze	2	no
	ldx3	sf.ob1,2	yes, get it
	rem
	cx3a		set indicators
	tze	stp101-*	no buffer
	rem
	tsy	a.e025-*,*	setbpt
	cax3		now we have virtual address
	tsy	a.e014-*,*	(=opptro) simulate ptro on buffer
	tra	stp105-*	it flipped indicator for us
	rem
stp101	ila	sffcoi	get bit
	ersa	sf.flg,2	flip it
	rem
stp105	ldx3	sf.ob0,2	get the current output buffer ptr
	lda	sf.flg,2	get the sfcm flags
	icana	sffcoi	are we using alternate icw?
	tze	stp110-*	no, primary in use
	ldx3	sf.ob1,2	get the alternate buf ptr
	rem
stp110	stx3	stpbuf-*	save the buffer ptr
	ldx3	a.e005-*	(=ostats) get ptr to table of status
	rem
stp120	lda	stpswd-*	get the status word
	cana	0,3	is this bit on?
	tnz	stp130-*	yes, call routine
	rem
	iacx3	2	increment ptr
	cmpx3	a.e006-*	(=oends) end of table?
	tnz	stp120-*	no, loop more
	rem
	lda	stpswd-*	get status word
	cana	l.e004-*	(=hs.siw) are we switching send icw's?
	tze	3	skip if not
	ila	sffcoi	get bit
	ersa	sf.flg,2	flip it
	tra	stp200-*	yes, all done
	rem
stp130	lda	1,3	get addr of routine to call
	sta	stptra-*	save it
	lda	stpbuf-*	get buffer addr
	tsy	a.e025-*,*	setbpt
	cax3		now we have virtual address
	tsy	stptra-*,*	go to routine
	rem
	eject
stp200	ila	hs.sqo
	cana	a.f008-*,*	(stpswd) status queue overflow ?
	tze	stp205-*	no
	rem
	lda	l.e013-*	(=/sffsqo)
	ansa	sf.flg,2	turn off status queue overflow flag
	rem
	lda	t.stat,1	get tib status bits
	iana	s.dss	but only the ones we want
	ora	l.e017-*	(=s.xte) set xte status
	tsy	a.e004-*,*	(=istat) call interpreter
	rem
stp205	lda	a.f009-*,*	(stpmrk) in case requested status not performed
	orsa	t.stat,1	put back for next time
	lda	sf.tly,2	get the wrap around queue tally
	cmpa	sf.ssl,2	is queue empty?
	tnz	a.e018-*,*	(stp010) no, more status to be processed
	rem
stp210	ila	sffskd	get the sCked flag
	iera	-1	invert it
	ansa	sf.flg,2	and store it into sfcm
	rem
	lda	sf.tly,2	tally still at max?
	cmpa	sf.ssl,2	well?
	tnz	a.e018-*,*	(=stp010) nope, process more status
	stz	sf.rct,2	zero sqo repeat count
	rem
	lda	a.f008-*,*	(=stpswd) get the status word
	cana	l.f008-*	(=hs.rcs) is this receive status?
	tze	stpret-*	nope, done
	rem
	szn	sf.ob0,2	are both of the output buffers gone yet?
	tnz	stpret-*	not first one
	szn	sf.ob1,2	second?
	tnz	stpret-*	nope, done
	rem
	lda	t.flg,1	is output suspended?
	cana	l.f012-*	=tfosus
	tnz	stpret-*	yes, we'l pick up rest of dcw list later
	rem
	lda	l.f009-*	(=sffhdl)
	cana	sf.flg,2	skip this for HDLC lines
	tnz	stpret-*
	rem
	lda	t.dcwl,1	is there a dcw list?
	tze	stpret-*	nope, done
	rem
	tsy	a.f011-*,*	(=hdcw) call the dcw list processor
	rem
stpret	tra	a.f012-*,*	(=secdsp) return to secondary dispatcher
	rem
	rem
	ttls	dmpbuf - proc to dump input buffers when we exit rcv
dmpbuf	subr	dmp,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	dmpbuf
*
*	     proc to dump the input buffers when we leave
*	receive mode. If there is any input in the current
*	input buffer, we will chain it onto the input
*	chain, otherwise we will just free the buffers.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	szn	sf.ib0,2	look to see if the buffers are already gone.
	tnz	dmp005-*	first one isn't, proceed
	szn	sf.ib1,2	it is, what about second?
	tze	dmpret-*	yes, all done
	rem
dmp005	tsy	a.f004-*,*	(=gettly) get current buffer tally & addr
	sta	dmptmp-*	save buffer tally
	cx3a		is there a buffer ?
	tze	dmp050-*	no, skip null buffer
	lda	sf.flg,2	synchronous line?
	cana	l.f006-*	sffsyn
	tze	dmp010-*	no
	cx3a		yes, back to beginning of buffer
	sba	l.f007-*	bf.dta,b.0
	cax3
	tra	dmp020-*
dmp010	null		asynchronous pseudo-buffer
	cx3a		just wipe out char. addressing
	ana	l.f001-*	=o077777
	cax3
dmp020	szn	dmptmp-*	zero tally?
	tze	dmp040-*	yes, free buffer
	rem
	lda	sf.flg,2	synchronous?
	cana	l.f006-*	=sffsyn
	tnz	dmp030-*	yes, copy to input chain
	tsy	a.f003-*,*	(=scan) else scan chars
	stz	sf.nic,2	make sure next scan starts clean
	tra	dmp040-*	scan took care of copying to input chain
	rem
dmp030	lda	l.f002-*	(=buftmk) get tally mask
	iera	-1	invert mask
	ansa	bf.tly,3	zero tally field
	lda	dmptmp-*	get back buffer tally
	orsa	bf.tly,3	put tally in buffer
	rem
	tsy	a.f002-*,*	(=parity) strip off parity bits
	rem
	tsy	a.f005-*,*	(=ichain) put buffer on input chain
	tra	dmp050-*	free second buffer
	rem
dmp040	tsy	fribuf-*
	rem
dmp050	cx3a
	tsy	a.f007-*,*	cvabs
	rem		we need absolute address for this
	cmpa	sf.ib0,2	primary buffer addr in x3 ?
	tze	3	yes
	lda	sf.ib0,2	no, get primary buffer addr
	tra	2
	lda	sf.ib1,2	get alt. buffer addr
	tze	dmp060-*	skip null buffer
	tsy	a.f010-*,*	setbpt
	cax3		fribuf wants virtual address
	tsy	fribuf-*	free the buffer
	rem
dmp060	stz	sf.ib0,2	zero the buffer ptrs
	stz	sf.ib1,2
	rem
dmpret	return	dmpbuf	all done
	rem
	rem
	rem
	rem
fribuf	subr	fri,(x3)	free an input buffer for dmpbuf
	rem
	lda	sf.flg,2	synchronous?
	cana	l.f006-*	=sffsyn
	tze	fri005-*	no
	cx3a		yes, get absolute address
	tsy	a.f007-*,*	cvabs
	tra	fri030-*	and free it
fri005	cx3a		else find out if it's one of the permanent ones
	tsy	a.f007-*,*	cvabs
	cmpa	t.abf0,1	is it first one?
	tnz	fri010-*	no
	lda	l.f010-*	(tfabf0) yes
	orsa	t.flg3,1	mark it available
	tra	fribak-*	done
fri010	cmpa	t.abf1,1	is it the other one?
	tnz	fri020-*	no, free it
	lda	l.f011-*	tfabf1
	orsa	t.flg3,1	mark 2nd one available
	tra	fribak-*
fri020	ldq	0,3	else get size out of buffer
	qrl	9
	tra	fri040-*
	rem
fri030	ilq	0	let frebfh determine size
fri040	tsy	a.f001-*,*	frebfh
fribak	return	fribuf
	rem
	rem
dmptmp	bss	1
	rem
	rem
l.f001	oct	077777
l.f002	vfd	18/buftmk
l.f003	vfd	18/tflfec+tfcrec+tftbec
l.f004	vfd	18/s.prex
l.f005	vfd	18/s.exh
l.f006	vfd	18/sffsyn
l.f007	zero	bf.dta,b.0
l.f008	vfd	18/hs.rcs
l.f009	vfd	18/sffhdl
l.f010	vfd	18/tfabf0
l.f011	vfd	18/tfabf1
l.f012	vfd	18/tfosus
	rem
a.f001	ind	frebfh
a.f002	ind	parity
a.f003	ind	scan
a.f004	ind	gettly
a.f005	ind	ichain
a.f006	ind	istat
a.f007	ind	cvabs
a.f008	ind	stpswd
a.f009	ind	stpmrk
a.f010	ind	setbpt
a.f011	ind	hdcw
a.f012	ind	secdsp
	ttls	addbuf - add buffer to input chain
addbuf	subr	abf
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	addbuf
*
*	adds a buffer to the end of the input chain and
*	signals pre-exhaust and/or exhaust status if
*	appropriate.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - buffer to be added to input chain
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	tsy	ichain-*	thread buffer onto input chain
	rem
	lda	sf.flg,2	get sfcm flags
	cana	l.f006-*	(=sffsyn) synch line ?
	tnz	abf010-*	yes, don't check pre-exhaust
	rem
	lda	t.icpl,1	get input chain length
	icmpa	10	at pre-exhaust limit ?
	tmi	abf011-*	no
	rem
	lda	t.stat,1	get tib status
	iana	s.dss	relevant bits only
	ora	l.f004-*	(=s.prex) set pre-exhaust status
	tsy	a.f006-*,*	(=istat) call interpreter
	rem
abf010	null
	lda	l.f009-*	(=sffhdl)
	cana	sf.flg,2	is it HDLC?
	tnz	abfret-*	don't check for exaust
	rem
	lda	t.icpl,1	get input chain length again
abf011	ada	t.dcpl,1	get total input buffer usage
	icmpa	40	at exhaust limit ?
	tmi	abfret-*	no, done
	rem
	lda	t.stat,1	get tib status
	iana	s.dss	relevant bits only
	ora	l.f005-*	(=s.exh) set exhaust status
	tsy	a.f006-*,*	(=istat) call interpreter
	rem
abfret	return	addbuf
	ttls	ichain - thread buffer onto input chain
ichain	subr	ich,(x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ichain
*
*	threads a buffer onto the end of the input chain
*	and updates the chain length (t.icpl)
*
*	upon entry:
*	     x1 - virtual tib address
*	     x3 - virtual address of buffer to be threaded
*                   onto input chain
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	cx3a
	tsy	a.g006-*,*	(cvabs) get absolute address
	szn	t.ilst,1	any input chain ?
	tnz	ich010-*	yes
	rem
	sta	t.icp,1	start a new chain
	sta	t.ilst,1	end a new chain
	tra	ich020-*
	rem
ich010	caq		safe store
	lda	t.ilst,1	get addr of last buffer
	tsy	a.g007-*,*	setbpt
	cax2		virtual address into x2
	stq	bf.nxt,2	thread on new last buffer
	stq	t.ilst,1	update last ptr
	cqa		set up pte for last buffer again
	tsy	a.g007-*,*	(address is already in x3)
	rem
ich020	lda	bf.siz,3	get buffer size code
	arl	15	right adjust
	iaa	1	get true block count
	asa	t.icpl,1	update input chain length
	rem
	return	ichain
	ttls	ipterm - process input terminate status
ipterm	subr	trm,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipterm
*
*	     process the input terminate status. this will
*	be stored as a result of a user typing nis break
*	character, and can only mean that it is time to
*	ship his data to the cs.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - points to the current buffer
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	l.g001-*	(=bffbrk) get the break bit
	orsa	bf.flg,3	turn it on in the buffer
	rem
	lda	sf.flg,2	synchronous line?
	cana	l.g004-*	=sffsyn
	tnz	trm010-*	no, don't bother scanning
	rem
	tsy	a.g005-*,*	(=scan) scan the input
	rem
trm010	tsy	a.g002-*,*	(=setnib) setup new input buffer
	rem
	lda	sf.flg,2	synchronous?
	cana	l.g004-*	=sffsyn
	tze	trm020-*	no, scan took care of input chain
	tsy	a.g003-*,*	(=parity) strip off parity
	tsy	a.g008-*,*	(=addbuf) add buffer to input chain
	rem
trm020	lda	t.stat,1	get the tib status bits
	iana	s.dss	but only the ones we want
	ora	l.g002-*	s.brch
	tsy	a.g001-*,*	(=istat) call status processor
	rem
	return	ipterm
	rem
l.g001	vfd	18/bffbrk
l.g002	vfd	18/s.brch
l.g003	vfd	o18//sffmsp
l.g004	vfd	18/sffsyn
	rem
a.g001	ind	istat
a.g002	ind	setnib
a.g003	ind	parity
a.g005	ind	scan
a.g006	ind	cvabs
a.g007	ind	setbpt
a.g008	ind	addbuf
	ttls	ipmark - process input marker status
ipmark	subr	mrk,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipmark
*
*	process input marker status indicating one or more
*	of the following events:
*
*	- any char received in echoplex or breakall mode
*
*	- tab received in tabecho mode
*
*	- frame begin char received in frame input mode
*
*	- any break character received
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - points to buffer
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	l.g003-*	=^sffmsp
	ansa	sf.flg,2	indicate no marker pending
	rem
	tsy	a.g005-*,*	(=scan) scan the input
	rem
	return	ipmark
	rem
	ttls	ipbfsw - process buffer switch for bisync and hdlc
ipbfsw	subr	bsw
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipbfsw
*
*	     process buffer switch for bisync and hdlc channels
*
*	upon entry:
*	     x1 - points to tib
*	     x2 - points to sfcm
*	     x3 - points to the current buffer (virtual address)
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	tsy	a.i008-*,*	(=parity) strip all parity
	rem
	tsy	a.i009-*,*	(=addbuf) add buffer to input chain
	stz	a.x001-*,*	*=bftsa  all finished, clear it
	ldx3	a.x002-*,*	*=bftx3 buffer address pointer
	stz	2,3
	stz	a.x002-*,*	*=bftx3 clear up old buffer address
	rem
bswret	return	ipbfsw
a.x001	ind	bftsa
a.x002	ind	bftx3
	ttls	swphic - switch preallocated icw s
**********************************************************************
*
*	swphic - switch with preallocated buffer for icw
*
*	This routine will start the icw switching process using
*	the preallocated buffer pools. It sets up the registers
*	and other variables to complete the switch. It will store
*	the buffer in the software com area; it will not add it to
*	the input chain in the tib.
*
*	upon entry:
*	 x1 - tib
*	 x2 - sfcm
*
*	returns:
*
*	Coded by D. W. Cousins for icw switch problem
*
**********************************************************************
swphic	subr	swp,(i,x2,x3)
	cx2a		*get address of sfcm into a
	caq		*place it into q
	iaq	sf.ib0	*add in offset
	lda	sf.flg,2	*get software flags
	sta	sfflag-*	*store them for later
	ana	l.y001-*	*=^sfcii mask
	sta	sf.flg,2
	lda	sf.nxa,2*	*load the status word
	arl	12
	iana	sffcii	*mask all bits ecept alt icw
	orsa	sf.flg,2	*this should work
	lda	sf.flg,2	*get the flags for test
	icana	sffcii	*alternate buffer
	tze	2	*no
	iaq	sf.ib1-sf.ib0	*change offset
	stq	sfptr-*	*save it tempory
	ldq	sfptr-*,*	*load the buffer address
	ldx3	sf.nxa,2	*load current ptr to status
	stq	2,3	*store buffer after the status
	lda	sf.bsz,2	*get this line buffer size
	ars	5	*get table index
	iaa	-1
	cax2
	inh
	ldq	a.y001-*,*	(=pchtbl,2) get the buffer address
	tze	swp010-*	no buffer
	ila	-1
	asa	a.y002-*,*	(=pchlft,2) reduce buffer total
	cqa
	sta	swpabs-*	save it for later
	tsy	a.y003-*,*	(setbpt)
	cax3		place virtual address into x3
	ldq	bf.nxt,3	get next address
	stq	a.y001-*,*	(=pchtbl,2) put it as the head
	ldi	swpsi-*
	stz	bf.nxt,3	zero next buffer pointer
	lda	bf.tly,3	get it tally
	ana	l.f002-*	=buftmk mask the tally
	caq		place it in q
	ldx2	t.sfcm,1	get sfcm again
	lda	l.y002-*	=sffnib
	iera	-1
	ansa	sf.flg,2
	ansa	sfflag-*	*save it here also
	lda	swpabs-*	get absolute address back
	sta	sfptr-*,*
	rem
	stq	swpq-*	hang on to size
	smeter	mincd,.mupab,l.y003-*
	tra	swp020-*
	rem
swp010	ila	0
	ldx2	t.sfcm,1	get sfcm again
	ldi	swpsi-*	restore interrupt state
	stz	sfptr-*,*
	cax3
	rem
	stq	swpq-*	hang on to size
	smeter	mincd,.mpanf,l.y003-*
	rem
swp020	ldq	swpq-*
	tsy	nibicw-*
	lda	sfflag-*	*return old sf.flg
	sta	sf.flg,2
	return	swphic
	rem
a.y001	ind	pchtbl,2
a.y002	ind	pchlft,2
a.y003	ind	setbpt
	rem
l.y001	vfd	o18//sffcii
l.y002	vfd	18/sffnib
l.y003	dec	1
	rem
sfflag	bss	1
sfptr	bss	1
swpq	bss	1
swpabs	bss	1
	ttls	ipxte - process input transfer timing error
ipxte	subr	ixt,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipxte
*
*	     process transfer timing errors. currently we
*	will not expect these, and will crash on any.
*
*	upon entry:
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	die	4
	rem
	return	ipxte
	ttls	ipptro - process input pre-tally runout
ipptro	subr	ipt,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipptro
*
*	     process input pre-tally runout status. this
*	status is stored just before we switch to a new input
*	buffer, and the old one should be put onto the input
*	chain.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - points to the buffer
*
*	returns:
*	     with a new input buffer setup
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	sf.flg,2	synchronous line?
	cana	l.i001-*	=sffsyn
	tnz	ipt010-*	yes, copy buffer directly to chain
	rem
	tsy	a.i001-*,*	(=scan) scan rest of input data
	tra	ipt030-*
	rem
ipt010	tsy	a.i008-*,*	(=parity) remove parity bits
	tsy	a.i009-*,*	(=addbuf) add buffer to input chain
	rem
ipt030	tsy	a.i005-*,*	(=setnib) setup new input buffer
	rem
	return	ipptro	bye
	ttls	iptro - process input tally runout
iptro	subr	itr,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	iptro
*
*	     processs input tally runout status. this indicates
*	an attempt to use an exhausted icw.  this could occur
*	either because there was not enough time to set up a new
*	buffer or because no buffer was available.  the latter
*	case is indicated by a zero buffer address.  in this case,
*	we signal exhaust status to the interpreter.  in the
*	former case, we signal transfer timing error (xte) status.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - points to buffer
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.stat,1	get tib status bits
	iana	s.dss	but only the ones we want
	rem
	iacx3	0	do we have a buffer?
	tze	3	no
	ora	l.i003-*	(=s.xte) set xte status
	tra	2
	ora	l.i009-*	(=s.exh) set exhaust status
	rem
	tsy	a.i004-*,*	(=istat) call interpreter
	rem
	return	iptro	all done
	rem
	rem
l.i001	vfd	18/sffsyn
*l.i002
l.i003	vfd	18/s.xte
*l.i004
*l.i005		unused
l.i006	vfd	18/tfecpx+tftbec
*l.i007		unused
l.i009	vfd	18/s.exh
	eject
a.i001	ind	scan
*a.i002
*a.i003
a.i004	ind	istat
a.i005	ind	setnib
*a.i007
a.i008	ind	parity
a.i009	ind	addbuf
	ttls	ipdss - process data set status change
ipdss	subr	ids,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	ipdss
*
*	     process data set status changes. record the
*	change and inform the control_tables.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     lower 18 bits of status in stpswd+1
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	stz	idsst-*	zero current status word
	ldx3	a.j002-*	(=hstat) get the address of the table
	rem
	lda	t.flg2,1	are we dialing out?
	cana	l.j002-*	=tfacu
	tnz	ids010-*	yes
	rem		else we'll have to mask off acu bits
	lda	l.j003-*	^hs.dlo & ^hs.pwi
	ansa	a.j006-*,*	=stpswd
	lda	l.j004-*	^hs.ads & ^hs.acr
	ansa	a.j001-*,*	=stpswd+1
	rem
ids010	lda	a.j001-*,*	(=stpswd+1) get the status word
	cana	0,3	is this a match?
	tze	ids020-*	no, keep looking
	rem
	lda	1,3	get the bit to set
	orsa	idsst-*	or into saved status
	rem
ids020	iacx3	2	increment to next entry
	cmpx3	a.j003-*	(=ehstat) end of table?
	tnz	ids010-*	no, continue
	rem
	ldx3	a.j005-*	(=h1stat) get the address of the table for first
	rem
ids030	lda	a.j006-*,*	(=stpswd) get the status word
	cana	0,3	is this a match
	tze	ids040-*	no, skip it
	rem
	lda	1,3	get the bit to set
	orsa	idsst-*	or into saved status
	rem
ids040	iacx3	2	increment to next entry
	cmpx3	a.j007-*	(=endh1) end of table?
	tnz	ids030-*	no, continue
	rem
	ila	0	zero the a reg
	szn	dssflg-*	requested status?
	tze	2	no
	rem
	lda	l.j001-*	(=s.st) get status bit
	stz	dssflg-*	clear flag
	rem
	ora	idsst-*	get new data set status
	tsy	a.j004-*,*	(=istat) call interpreter w/status
	rem
	rem		if this was line break, and output is suspended,
	rem		resume it
	lda	idsst-*	get status flags
	cana	l.j005-*	=s.brk
	tze	ids050-*	wasn't line break, never mind
	lda	t.flg,1	was output suspended?
	cana	l.j006-*	=tfosus
	tze	ids050-*	no, don't worry about it
	tsy	a.j008-*,*	(resout) start output going again
ids050	null
	ila	15	(=o17) mask for common bits
	rem		cd+cts+dsr+src
	ansa	idsst-*	leave only those bits now
	iera	-1	flip over the mask
	ansa	t.stat,1	turn off the bits in the tib
	rem
	lda	idsst-*	get the real status bits
	orsa	t.stat,1	and turn only those on in the tib
	rem
	return	ipdss	all done
	rem
	rem
idsst	bss	1	(altrd) loc for current dataset status
dssflg	oct	0	(altrd) flag to indicate requested status
	rem
hstat	smap	hs.dsr,s.dsr
	smap	hs.cts,s.cts
	smap	hs.cd,s.cd
	smap	hs.src,s.sprc
	smap	hs.ri,s.ring
	smap	hs.brk,s.brk
	smap	hs.acr,s.acr
	smap	hs.ads,s.ads
ehstat	equ	*
	rem
h1stat	smap	hs.dlo,s.dlo
	smap	hs.pwi,s.pwi
endh1	equ	*
	rem
	rem
l.j001	vfd	18/s.st
l.j002	vfd	18/tfacu
l.j003	vfd	o18//hs.dlo*/hs.pwi   ^(acu bits in first word)
l.j004	vfd	o18//hs.acr*/hs.ads   ^(acu bits in second word)
l.j005	vfd	18/s.brk
l.j006	vfd	18/tfosus
	rem
a.j001	ind	stpswd+1	status save word
a.j002	ind	hstat
a.j003	ind	ehstat
a.j004	ind	istat
a.j005	ind	h1stat
a.j006	ind	stpswd
a.j007	ind	endh1
a.j008	ind	resout
	ttls	setnib - setup new input buffer
setnib	subr	snb,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	setnib
*
*	     setup a new input buffer for the channel. the
*	buffer will be allocated, and the icw setup
*	ready to be used by the channel.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx3	a.h004-*,*	.crbpe
	lda	0,3	have to save buffer pte
	sta	snbpte-*
	rem
	cx2a		get sfcm addr into a
	caq		now into the q
	iaq	sf.ib0	add in offset
	rem
	lda	sf.flg,2	get the flags
	icana	sffcii	alternate buffer?
	tze	snb010-*	no,
	rem
	iaq	sf.ib1-sf.ib0	change offset
	rem
snb010	stq	snbptr-*	save the ptr
	rem
	lda	sf.flg,2	synchronous line?
	cana	l.h001-*	=sffsyn
	tnz	snb030-*	yes, always allocate afresh
	stz	sf.nic,2	async, clear current char. pointer
	lda	snbptr-*,*	is there one now?
	tze	snb030-*	no, we'll have to allocate one
	tsy	a.h003-*,*	(setbpt) yes, get virtual address
	cax3
	lda	sf.flg,2	get flag word back
	cana	l.h003-*	(sffnib) are we supposed to allocate one anyway?
	tnz	snb020-*	yes
	ldq	0,3	get size of current one
	qrl	9
	cmpq	sf.csz,2	is it correct?
	tnz	snb025-*	no
	qls	1	yes, convert it to characters
	iaq	-3	allow for overhead (***two*** at end)
	tra	snb050-*
	rem
snb020	ldq	0,3	make sure we have the size
	qrl	9
snb025	lda	snbptr-*,*	find out if it's a permanent one
	cmpa	t.abf0,1
	tnz	snb027-*	not first one
	lda	l.h005-*	(tfabf0) yes, mark it available
	orsa	t.flg3,1
	tra	snb030-*
snb027	cmpa	t.abf1,1	second one?
	tnz	snb028-*	no, it's allocated
	lda	l.h006-*	tfabf1
	orsa	t.flg3,1	mark it available
	tra	snb030-*	get new one
snb028	tsy	a.h001-*,*	(frebfh) free the old one
	rem
snb030	tsy	a.h007-*,*	(=ghibuf) get input buffer
	tra	snb040-*	error, cannot get buffer
	rem
	sta	snbptr-*,*	store the buffer ptr
	rem
	lda	l.h003-*	=sffnib
	iera	-1	turn it off
	ansa	sf.flg,2
	tra	snb050-*	continue
	rem
snb040	stz	snbptr-*,*	no buffer, zero buffer ptr
	ila	0
	cax3		and x3 too
	rem
snb050	tsy	nibicw-*	setup icw
	rem
	ldx3	a.h004-*,*	.crbpe
	lda	snbpte-*	get saved pte back
	sta	0,3	restore it
	return	setnib
	rem
snbptr	bss	1	(altrd) pointer to current buf ptr
snbpte	bss	1	saved copy of buffer pte
	ttls	nibicw - setup new input icw
nibicw	subr	nib,(inh,q,x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	nibicw
*
*	     setup new icw for the input buffer which is
*	being setup. the buffer addr is in x3, and sffcii
*	tells us which icw to setup.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - virtual buffer address
*	     q - contains buffer tally
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	sf.hcm,2	get the hwcm ptr
	rem
	iaa	h.ric0	get ptr to icw
	sta	nibiwp-*	save it in temp
	rem
	lda	sf.flg,2	get the flags
	icana	sffcii	alternate buffer?
	tze	nib010-*	no, go
	rem
	lda	nibiwp-*	get the ptr
	iaa	h.ric1-h.ric0	add offset
	sta	nibiwp-*	save it in temp
	rem
nib010	ldx3	nibsx3-*	restor buffer ptr to x3
	tze	nib020-*	zero buffer addr, special case
	rem
	lda	sf.flg,2	synchronous?
	cana	l.h001-*	=sffsyn
	tze	nib015-*	no
	cx3a		get buffer ptr into a reg
	ada	l.h002-*	bf.dta,b.0
	tra	nib016-*
nib015	cx3a		get buffer ptr into a reg
	ora	l.h004-*	(=0,b.1) async, start at second char
nib016	ldx3	nibiwp-*	get ptr to icw in x3
	rem
	ldq	nibsq-*	get buffer tally
	tsy	a.h002-*,*	(bldicw) and store into icw
	tra	nibret-*	done
	rem
nib020	lda	a.h008-*	(=bnispc) get addr of spare word
	ldq	l.h007-*	(=450000) get exhausted tally
	staq	nibiwp-*,*	set icw
	rem
nibret	return	nibicw
	rem
nibiwp	bss	1	(altrd) icw ptr
	eject
	rem
l.h001	vfd	18/sffsyn
l.h002	ind	bf.dta,b.0
l.h003	vfd	18/sffnib
l.h004	zero	0,b.1
l.h005	vfd	18/tfabf0
l.h006	vfd	18/tfabf1
l.h007	oct	450000
	rem
a.h001	ind	frebfh
a.h002	ind	bldicw
a.h003	ind	setbpt
a.h004	ind	.crbpe
*a.h005
*a.h006
a.h007	ind	ghibuf
a.h008	ind	bnispc
	ttls	parity - strip parity bits off input characters
parity	subr	par,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	parity
*
*	     parity will remove the parity bits from the
*	input data. status will have noted any parity errors
*	for us.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - virtual buffer address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.flg3,1	see if we should bother
	cana	l.m007-*	=tf8in
	tnz	par030-*	no, keeping all 8 bits
	rem
	cx3a
	cmpa	l.m009-*	(=1000(8)) bad?
	tpl	2	no, continue
	die	1	gotcha
	rem
	lda	t.flg3,1	see if parity should be kept
	cana	l.m010-*	=tfkpar
	tnz	par030-*	dont strip parity
	rem
	ldq	l.m001-*	(=177177) get parity bits
	rem
	lda	sf.flg,2	get sfcm flags
	icana	sffebd	ebcdic characters?
	tze	par010-*	no,
	rem
	ldq	l.m002-*	(=077077) get the ebcdic parity mask
	rem
par010	lda	bf.tly,3	get the buffer tally
	ana	l.m003-*	(=buftmk) leave only tally
	iaa	1	add one
	ars	1	divide by two
	sta	parcnt-*	store it here
	ila	0	get a zero
	ssa	parcnt-*	makes it negative
	rem
	iacx3	bf.dta	point to data in buffer
	cqa		put parity mask into a reg
	rem
par020	ansa	0,3	mask parity bits
	iacx3	1	bump ptr
	aos	parcnt-*	decrement count
	tmi	par020-*	loop
	rem
par030	return	parity
	rem
parcnt	bss	1
	rem
l.m001	vfd	o18/177177
l.m002	vfd	o18/077077
l.m003	vfd	18/buftmk
l.m004	vfd	18/tflfec
l.m005	ind	0,b.0
l.m006	vfd	18/tftbec
l.m007	vfd	18/tf8in
l.m008	vfd	18/tffip
l.m009	oct	1000
l.m010	vfd	18/tfkpar
	rem
	ttls	outpar - output parity for ebcdic terminals
outpar	subr	opr,(x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	outpar
*
*	     outpar generates parity bits on 6-bit ebcdic
*	data. odd parity only.
*
*	upon entry:
*	     x2 - virtual sfcm address
*	     x3 - virtual buffer address
*
*	returns:
*	     parity bits in buffer
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	sf.flg,2	get the sfcm flag bits
	icana	sffebd	edcbic data?
	tze	oprret-*	no
	rem
	lda	bf.tly,3	get the buffer tally
	ana	l.m003-*	(=buftmk) leave only tally
	sta	oprcnt-*	save
	ila	0
	ssa	oprcnt-*	make negative
	rem
	lda	oprsx3-*	reload x3 value
	ora	l.m005-*	(=char bits)
	iaa	bf.dta	point at data
	cax3		put into x3
	rem
opr010	lda	0,3,b.0	pick up char
	iana	63	drop to 6 bits
	alp	18	get the parity on it
	tnz	2	all ok now
	iora	64	or in 7th bit for odd-parity
	sta	0,3,b.0	replace char
	iacx3	0,3,b.1	bump ptr
	aos	oprcnt-*	decrement count
	tmi	opr010-*	loop for all chars
	rem
oprret	return	outpar	done
	rem
oprcnt	bss	1
	ttls	oscan - scan the output to get t.pos
oscan	subr	scn,(x1,x2,x3,a)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	oscan
*
*	scans an output buffer and updates the column
*	position in t.pos accordingly.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x3 - virtual buffer address
*
*	returns:
*	     updated column position in t.pos
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get virtual sfcm address
	lda	sf.flg,2	asynchronous?
	cana	l.n004-*	=sffsyn
	tnz	scnret-*	no
	rem
	rem		see if output scan is needed
	lda	t.flg,1	get tib flags
	cana	l.m006-*	(=tftbec) tabecho mode ?
	tnz	scn010-*	yes, must scan
	cana	l.n011-*	(=tfecpx+tfcrec) echoplex or crecho mode?
	tze	scnret-*	no, skip scan
	rem
	ldx2	t.dtp,1	any delay table ?
	tze	scnret-*	no, skip scan
	szn	dl.cr,2	any cr delays ?
	tze	scnret-*	no, skip scan
	rem
scn010	lda	bf.tly,3	get buffer tally
	ana	l.n002-*	(=buftmk) leave only tally
	iaa	0	anything to scan ?
	tze	scnret-*	nope
	tmi	scnret-*	be serious
	sta	scntly-*	save tally
	rem
	cx3a		put buffer addr in a
	iaa	bf.dta	get addr of data
	ora	l.n001-*	(=0,b.0) make char address
	cax3		put it in x3
	tsy	a.o003-*,*	=getcmt, get the addr of cmt in x2
	stx2	scncmt-*	save addr
	rem
scn020	ldx2	scncmt-*	get cmt addr
	stz	scnidx-*	zero index
	rem
	ilq	4-1	set max cmt table size
	lda	t.flg2,1	get tib flags
	cana	l.n006-*	(=tfsftr) is this one a shifter?
	tze	2	nope
	iaq	2	extend cmt, look at shifts
	rem
	lda	0,3,b.0	get the char we are interested in
	ana	l.n007-*	(=000177) mask out parity
	sta	scnchr-*	save it
scn030	cmpa	0,2,b.0	is it a special char?
	tze	scn040-*	yes, process
	rem
	cmpq	scnidx-*	at max yet?
	tze	scn031-*	yes, character not found in cmt
	rem
	aos	scnidx-*	bump index word
	iacx2	0,b.1	bump cmt ptr
	tra	scn030-*	loop processing more cmt chars
	rem
	rem	not in cmt, must be regular char
	rem
scn031	lda	t.flg2,1	get the tib flag bits
	cana	l.n006-*	(=tfsftr) shifty device?
	tze	scn035-*	no
	rem
	lda	t.flg2,1
	cana	l.n005-*	(=tfupsf) in upshift now?
	tze	scn037-*	no
	lda	0,3,b.0	get the char
	iora	64	set 100 bit
	sta	0,3,b.0	replace char
	tra	scn037-*
	rem
scn035	lda	scnchr-*	get current character again
	icmpa	32	is it a printing char?
	tmi	scn200-*	no, get out
	rem
scn037	lda	t.pos,1	get current position
	icmpa	255	over limit ?
	tpl	scn200-*	yes, don't increment
	rem
	aos	t.pos,1	increment position
	tra	scn200-*	continue
	rem
scn040	ldx2	scnidx-*	get the index value
	tra	a.n001-*,*	(=scntbl,2*) go to right routine
	rem
scntbl	ind	scn050	line-feed
	ind	scn060	carriage return
	ind	scn070	tab
	ind	scn080	backspace
	ind	scn090	upshift
	ind	scn100	downshift
	rem
scn050	null		linefeed
	stz	t.pos,1	reset column position
	tra	scn200-*
	rem
scn060	null		carriage return
	stz	t.pos,1	reset column position
	tra	scn200-*
	rem
scn070	null		tab
	ldq	t.pos,1	get current position
	ila	0	prepare to divide aq
	dvd	l.n003-*	(=10) divide by 10
	stq	scntmp-*	save remainder
	rem
	ila	10	get max cols per tab
	sba	scntmp-*	get cols moved
	ada	t.pos,1	this will be new column position
	icmpa	255	over limit ?
	tpl	scn200-*	yes, don't increment
	sta	t.pos,1	update column position
	tra	scn200-*
	rem
scn080	lda	t.pos,1	backspace
	tze	scn200-*	already in column 0, do nothing
	iaa	-1	otherwise decrement column position
	sta	t.pos,1
	tra	scn200-*	done
	rem
scn090	lda	l.n005-*	(=tfupsf) set bit on
	orsa	t.flg2,1	in tib, we are upshifted now
	tra	scn200-*
	rem
scn100	lda	l.n005-*	(=tfupsf) get bit
	iera	-1	complement it
	ansa	t.flg2,1	turn it off in tib
	rem
scn200	iacx3	0,b.1	bump buffer ptr
	rem
	ila	-1	decrement
	asa	scntly-*	the scan tally
	tnz	scn020-*	loop for more
	rem
scnret	return	oscan
	rem
	ttls	scan - scan and process an input buffer
scan	subr	isc,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	scan
*
*	calls inproc to scan an input buffer, update the column
*	position in t.pos accordingly, perform echoing and
*	beginning of frame detection when scanning the current
*	input buffer.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x3 - virtual buffer address
*
*	returns:
*	     updated column position in t.pos
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	a.n006-*,*	.crbpe
	lda	0,2	save buffer pte
	sta	iscpte-*	which callers count on being preserved
	rem
	ldx2	t.sfcm,1	get virtual sfcm address
	lda	sf.flg,2	asynchronous?
	cana	l.n004-*	=sffsyn
	tnz	iscret-*	no
	rem
	lda	t.flg2,1	save tffip for later comparison
	ana	l.n012-*	=tffip
	sta	scnfrm-*
	rem
	ldx3	sf.hcm,2	get hwcm address
	lda	sf.nic,2	get addr of next char to process
	tnz	isc010-*	if any
	lda	iscsx3-*	otherwise, use beginning of buffer
	ora	l.n011-*	0,b.1
	rem
isc010	sta	fstchr-*	temp store begin point
	ana	l.n008-*	(=o077777) make it word address
	sta	fstwrd-*
	lda	sf.flg,2	now find out which icw we're on
	icana	sffcii
	tze	2
	iacx3	h.ric1-h.ric0
	lda	iscpte-*	get page base address
	iana	-256	mask down to address only
	sta	iscbas-*
	ldaq	0,3	get address of hardware's next char
	rem		make sure it's in high memory
	tmi	isc013-*	high-order bit is on, it is
	cmpa	l.n014-*	(bwndow)
	tmi	isc015-*	below buffer window, so skip page address
	rem		manipulation
isc013	sba	iscbas-*	get offset within page
	ada	l.n014-*	(bwndow) buffer window base address
isc015	sta	nxtwrd-*	this is word part of next address
	llr	18	switch a and q
	als	2	shift out 18-bit addressing flag
	arl	15	get character addressing flag in low 3 bits
	qls	3	move word address up next to it
	lrl	3	now whole thing is in the q
	stq	nxtchr-*	save it
	lda	nxtwrd-*	get word address
	caq
	sbq	fstwrd-*	find word difference
	qls	1	convert to chars
	lda	l.n009-*	=o100000
	cana	fstchr-*	started on odd char?
	tze	2	no
	iaq	-1	yes, one character less
	cana	nxtchr-*	ended on odd char?
	tze	2	no
	iaq	1	yes, one character more
	iaq	0	is total any chars at all?
	tze	iscret-*	no
	tmi	iscret-*	and no
	rem
	lda	sf.flg,2	get ebcdic bit for inproc
	iana	sffebd
	ldx3	fstchr-*	get address
	tsy	a.n002-*,*	inproc
	ldx3	nxtchr-*	update scan pointer now
	stx3	sf.nic,2
	sta	scntmp-*	hang on to returned flags
	lda	t.flg2,1	did we enter or leave a frame?
	ana	l.n012-*	=tffip
	cmpa	scnfrm-*	same as before?
	tze	isc020-*	yes
	lda	l.n013-*	(=sffnib) no, we'll need a different buffer size
	orsa	sf.flg,2
isc020	lda	scntmp-*	get returned flags
	icana	retsus	output_suspend char?
	tze	isc030-*	no
	tsy	a.n004-*,*	(susout) yes, manipulate icws
	tra	iscret-*	and done
isc030	icana	retres	output_resume char?
	tze	isc040-*	no
	tsy	a.n005-*,*	(resout) yes, restore icws
	tra	iscret-*	done
isc040	icana	reteco	inproc added char(s) to echo buffer?
	tze	iscret-*	no
	lda	sf.flg,2	get sfcm flag bits
	icana	sffech	echoing on now?
	tnz	iscret-*	yes, done
	rem
	lda	sf.pcw,2	look at pcw bits
	icana	pb.xmt	are we already xmiting?
	tnz	iscret-*	yes, done
	rem
	tsy	a.n003-*,*	(=echock) try to do echoing
	tra	iscret-*	echoing started
	rem
iscret	ldx2	a.n006-*,*	.crbpe
	lda	iscpte-*	restore original pte
	sta	0,2
	return	scan
	rem
	rem
scntmp	bss	1
scncmt	bss	1
scnidx	bss	1
scntly	bss	1
scnchr	bss	1
scnfrm	bss	1
fstchr	bss	1
fstwrd	bss	1
nxtchr	bss	1
nxtwrd	bss	1
iscbas	bss	1
iscpte	bss	1
	rem
l.n001	ind	0,b.0
l.n002	vfd	18/buftmk
l.n003	dec	10
l.n004	vfd	18/sffsyn
l.n005	vfd	18/tfupsf
l.n006	vfd	18/tfsftr
l.n007	oct	000177
l.n008	oct	077777
l.n009	oct	100000
l.n010	vfd	18/tfcrec
l.n011	ind	0,b.1
l.n012	vfd	18/tffip
l.n013	vfd	18/sffnib
l.n014	vfd	18/bwndow
	rem
a.n001	ind	scntbl,2*
a.n002	ind	inproc
a.n003	ind	echock
a.n004	ind	susout
a.n005	ind	resout
a.n006	ind	.crbpe
	rem
	rem
reteco	bool	000001
retsus	bool	000002
retres	bool	000004
	rem
	rem
a.o001	ind	setbpt
*a.o002
a.o003	ind	getcmt
	rem
*l.o001
*l.o002
l.o003	ind	eb.dta,b.1
*l.o004
*l.o005
*l.o006
*l.o007
*l.o008
*l.o009
l.o010	vfd	18/tfrpon
	ttls	geteb - get chars from the echo buffer
geteb	subr	geb,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	geteb
*
*	     subroutine to get the pointer and tally of
*	chars in the echo buffer which are to be
*	echoed now.
*
*	input:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	output:
*	     a - char address of data
*	     q - tally in chars
*
*	calling sequence:
*	     tsy   geteb-*
*	     tra   fail-*  no more to echo
*	     tra   good-*  got some chars
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx3	t.echo,1	get ptr to echo buffer
	tze	geb005-*	none
	rem
	lda	t.flg2,1	get tib flag bits
	cana	l.o010-*	(=tfrpon) replay on?
	tnz	geb005-*	yes, inhibit removal from echo buffer
	rem
	cx3a		convert echo buffer address
	tsy	a.o001-*,*	(setbpt) to virtual
	cax3
	lda	eb.tly,3	get the echo buffer tally
	ars	9	shift
	tnz	geb010-*	we have some
	rem
geb005	lls	36	zero aq
	tra	gebret-*	return, fail exit
	rem
geb010	lda	eb.otp,3	get ptr to chars to be echoed
	als	3
	arl	3	drop char addressing
	sta	gebadr-*	save
	cx3a		get echo buf ptr again
	iaa	32	point to end
	sba	gebadr-*	get difference
	als	1	multiply by two
	sta	gebtly-*	save
	rem
	lda	eb.otp,3	get outptr
	ars	15	leave only char bits
	icana	1	is it odd char?
	tze	geb020-*	no, ok
	rem
	lda	gebtly-*	fix up the tally
	iaa	-1
	sta	gebtly-*
	rem
geb020	ldx2	eb.otp,3	get ptr
	stx2	gebadr-*	save it
	lda	eb.tly,3	get the real tally
	lrs	9	into lower a
	cmpa	gebtly-*	compare against max possible
	tpl	geb030-*	more, use tally to end of buffer
	rem
	sta	gebtly-*	less, use real tally
	ldx2	eb.inp,3	advance otp to inp
	tra	geb040-*
	rem
geb030	sta	gebtmp-*	save value of a reg
	cx3a		get ptr to base of buffer
	ada	l.o003-*	(=eb.dta,b.1) point to start of data
	cax2		put into x2 now
	lda	gebtmp-*	get back saved a reg
	rem
geb040	sba	gebtly-*	get new tally
	lls	9	get back into position
	sta	eb.tly,3	put back into eb
	rem
	stx2	eb.otp,3	reset otp now
	rem
	aos	geteb-*	bump return addr to good
	ldaq	gebadr-*	get return args
	rem
gebret	return	geteb
	rem
	even
gebadr	bss	1
gebtly	bss	1
	rem
gebtmp	bss	1
	ttls	echock - check to see if any echoing to do
echock	subr	eck,(x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	echock
*
*	     subroutine to test if any chars in echo buf
*	and start echoing if there are.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	returns:
*	     +1 - if echoing started
*	     +2 - if no echoing to do
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.stat,1	make sure data set leads are up
	ana	l.t001-*	=tsfdtr+tsfdsr+tsfcts+tsfcd
	cmpa	l.t001-*	they must all be on
	tnz	eck020-*	we won't echo to a dead line
	rem
	lda	t.flg,1	nor to one whose output is suspended
	cana	l.t003-*	=tfosus
	tnz	eck020-*
	rem
	tsy	geteb-*	check the echo buffer
	tra	eck020-*	none, return +2
	rem
	staq	eckicw-*	save icw for now
	rem
	ldx3	sf.hcm,2	get ptr to hwcm region
	iacx3	h.sic0	point at primary icw
	rem
	lda	sf.flg,2	get flags
	icana	sffcoi	alternate icw?
	tze	eck010-*	no
	rem
	iacx3	h.sic1-h.sic0	bump up to alt
eck010	ldaq	eckicw-*	get the icw to use
	tsy	a.t002-*,*	(bldicw) put into icw
	rem
	ila	sffech	get flag for echo
	orsa	sf.flg,2	turn it on
	rem
	ila	pb.xmt	get xmit mode for pcw
	orsa	sf.pcw,2	turn it on too
	rem
	lda	l.t002-*	(=p.nop) get pcw command
	tsy	a.t001-*,*	(=cioc) connect to channel
	rem
	tra	eckret-*	done
	rem
eck020	aos	echock-*	bump return addr
	rem
eckret	return	echock	return to caller
	even
eckicw	bss	2
	rem
	rem
a.t001	ind	cioc
a.t002	ind	bldicw
	rem
	rem
l.t001	vfd	18/tsfdtr+tsfdsr+tsfcts+tsfcd
l.t002	vfd	18/p.nop
l.t003	vfd	18/tfosus
	ttls	hcheck - start echoing if not in xmit
	rem
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*
*	this routine is called by the inproc subroutine of the
*	utilities in order to make sure echoing starts before sending
*	status to the control tables.
*
*	upon entry:
*	     x1 - virtual tib address
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
	rem
hcheck	subr	hch,(x2)
	ldx2	t.sfcm,1
	lda	sf.pcw,2	find out if in xmit now
	icana	pb.xmt
	tnz	hchret-*	we are, deal with echoing later
	tsy	echock-*	else start it now
	tra	hchret-*	if there is any
hchret	return	hcheck
	ttls	subroutines to suspend and resume output
	rem
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*
*	this routine is called by scan if inproc returns an indication
*	that an output_suspend character was received. It will turn off
*	the transmitter by cioc with a pcw with ^pb.xmt off. If a 
*	tally runout occurs, it will not process it now but later when
*	resume is performed. If pre-tally runout occurs, it will be 
*	processed normally and t.ocur will reflect the changes.
*	upon entry:
*	    x1 - tib address
*	    x2 - sfcm address
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
	rem
susout	subr	sus,(x3,i)
	lda	t.flg,1	suspend already in progress?
	cana	l.s005-*	(=tfosus)
	tnz	susret-*	yes, punt for now
	lda	sf.pcw,2	in transmit at the moment?
	icana	pb.xmt
	tze	sus010-*	no, skip pcw manipulation
*
*	NOTE: inh is not really needed, but make a smooth
*	transaction and insure minimum amount of output
*	being transmitted at this time 
*
	inh		<+><+><+><+><+><+><+><+><+><+>
	lda	l.s002-*	(=^pb.xmt) load mask to flip xmt
	ansa	sf.pcw,2	set xmt off in pcw
	lda	l.s007-*	=p.nop
	tsy	a.s002-*,* cioc
sus010	lda	l.s005-*	(=tfosus)
	orsa	t.flg,1	mark tib to show output suspended
susret	return	susout
	eject
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*
*	this subroutine is called when inproc detects an output_resume
*	character. It turns off the "output suspended" flag, then checks
*	to see if anything is on t.ocur; if so it will restart the output
*	channel by pcw connect, else it will simulate output TRO by
*	calling the optro routine.
*	upon entry:
*	    x1 - tib address
*	    x2 - sfcm address
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
	rem
	rem
resout	subr	res
	lda	t.flg,1	suspended?
	cana	l.s005-*	tfosus
	tze	resret-*	no, return
	lda	l.s006-*	^tfosus
	ansa	t.flg,1	turn the flag off
	szn	t.ocur,1	any pending output chain?
	tze	res010-*	no, simulate tro
	ila	pb.xmt	else go back into transmit
	orsa	sf.pcw,2
	lda	l.s007-*	=p.nop
	tsy	a.s002-*,*	cioc
	tra	resret-*	done
	rem
res010	tsy	a.s003-*,*	optro
resret	return	resout
	rem
	rem
	rem
*l.s001	unused
l.s002	vfd	o18//pb.xmt	revert xmit pcw mask
*l.s003	unused
l.s004	oct	010000	icw exhaust and 0 tally
l.s005	vfd	18/tfosus
l.s006	vfd	o18//tfosus
l.s007	vfd	18/p.nop	pcw no-op command
*l.s008	unused
*l.s009	unused
*l.s010	unused
	rem
	rem
*a.s001	unused
a.s002	ind	cioc
a.s003	ind	optro
	rem
	ttls	opptro - output pre-tally runout status
opptro	subr	opt,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	opptro
*
*	     process the pre-tally runout status. this
*	is stored as the hsla picks up the last char from
*	the buffer and therefore we will setup a new output
*	buffer and icw.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     x3 - virtual buffer address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	sf.flg,2	get the sfcm flafs
	icana	sffech	is a tab, cr, lf, echo in progress?
	tnz	optret-*	yes, all done here
	rem
	ldx3	a.k009-*,*	.crbpe
	lda	0,3	get current page base address
	sta	optpte-*	save it
	lda	t.ocur,1	get t.ocur, points to buffer just finished
	tze	opt015-*	somebody dumped while we weren't looking
	tsy	a.k007-*,*	setbpt
	cax3		virtual version of t.ocur
	lda	bf.flg,3	get buffer flags
	cana	l.k009-*	check hold output buffer flag
	tze	opt006-*	no - as usual
	cana	l.k010-*	check last buffer in message flag
	tze	opt006-*	no - as usual
	stz	t.ocur,1	break chain here
	tra	opt008-*
opt006	null
	lda	bf.nxt,3	get the next ptr
	sta	t.ocur,1	update t.ocur
	rem
opt008	null
	lda	sf.flg,2	get sfcm flag word
	icana	sffcoi	are we using alternate?
	tze	2	nope, continue
	iacx2	sf.ob1-sf.ob0	add offset of alternate
	stz	sf.ob0,2	zero correct buffer ptr (note use of x2)
	ldx2	t.sfcm,1	restore sfcm ptr
	rem
	szn	t.ocur,1	any more buffers left
	tze	opt010-*	no, zero last ptr also
	rem
	lda	t.ocur,1	get ptr to first
	tsy	a.k007-*,*	(setbpt)
	cax3		in virtual form
	lda	bf.flg,3	get buffer flags
	cana	l.k010-*	(=bfflst) last buffer in msg?
	tnz	opt015-*	yes, leave here
	rem
	szn	bf.nxt,3	look at next ptr in first
	tze	opt015-*	no more, all done
	rem
	ila	0	indicate sffcoi is inactive now
	tsy	a.k003-*,*	(=nobicw) setup new output icw
	rem
	tra	opt020-*	all done
	rem
opt010	stz	t.olst,1	zero the last pointer
	rem
	lda	l.k018-*	(=tfwrit) get flag bit
	iera	-1	flip it over
	ansa	t.flg,1	and turn it off in tib
	rem
opt015	ldx3	sf.hcm,2	we will now zero address field of icw
	lda	sf.flg,2	find out which one
	icana	sffcoi
	tze	2
	iacx3	h.sic1-h.sic0	adjust x3 accordingly
	stz	h.sic0,3	this will be correct icw
	rem
opt020	ldx3	a.k009-*,*	.crbpe
	lda	optpte-*	get original pte back
	sta	0,3	restore it
	ldx3	optsx3-*	get ptr to buffer just finished
	tze	optret-*	someone did a stpchn, don't bother
	tsy	a.k002-*,*	(freout) free it and update count
optret	null
	lda	a.k008-*,*	get saved status word
	cana	l.k007-*	(=hs.siw) are we switching icw's?
	tze	3	don't change sffcoi in not
	ila	sffcoi	get the current icw switch
	ersa	sf.flg,2	flip it over in flag word
	rem
optfin	return	opptro
	rem
optpte	bss	1	safe store for buffer pte
	ttls	houtav - hsla output available entry
houtav	subr	hav,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	houtav
*
*	     routine to setup icws for output which may
*	arrive at the right time from a send_output
*	op to the cs.
*
*	upon entry:
*	     x1 - virtual tib address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldx2	t.sfcm,1	get ptr to sfcm for this guy
	tze	havret-*	none, forget it
	ldx3	sf.hcm,2	get ptr to hwcm
	rem
	lda	h.sic0+1,3	get tally word of first
	ora	h.sic1+1,3	get tally word of second
	cana	l.k002-*	(=010000) is either exhaust bit on?
	tze	havret-*	no, made in plenty of time
	rem
	lda	t.flg,1	is output suspended?
	cana	l.k006-*	tfosus
	tnz	havret-*	yes, don't interfere
	rem
	lda	h.sic0+1,3	get first again
	ana	h.sic1+1,3	get the second
	cana	l.k002-*	(=010000) are they both on?
	tnz	havret-*	yes, return, too late to act
	rem
	lda	h.sic0+1,3	get first yet again
	cana	l.k002-*	(=010000) was this the one?
	tze	hav010-*	no
	lda	sf.flg,2	yes, see if software thinks it's active
	cana	l.k001-*	=sffcoi
	tze	havret-*	it does, there's status pending
	tra	hav020-*	go ahead
hav010	lda	sf.flg,2	alternate was exhausted
	cana	l.k001-*	(=sffcoi) did we think it was active?
	tnz	havret-*	yes, there must be status pending
	rem
hav020	lda	t.ocur,1	get ptr to t.ocur
	tsy	a.k007-*,*	setbpt
	cax3		virtual
	szn	bf.nxt,3	check to make sure all is ok
	tnz	2	yes
	die	12	no bad error
	rem
	ila	1	indicate that sffcoi is active now
	tsy	a.k003-*,*	(=nobicw) go setup icws
	rem
havret	return	houtav
	ttls	nobicw - new output buffer icw setup
nobicw	subr	nob,(a,x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	nobicw
*
*	     setup the output icw and buffer for the
*	next output buffer in the chain.
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*	     a = 0 sffcoi points to inactive icw
*		 1 sffcoi points to active icw        
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	ldq	sf.hcm,2	get addr of hwcm
	lda	t.sfcm,1	get addr of sfcm also
	rem
	iaq	h.sic0	get offset of icw 0
	iaa	sf.ob0	and buf0
	sta	nobibp-*	save it away
	stq	nobiwp-*	and this also
	rem
	lda	sf.flg,2	get the flags
	szn	nobsa-*	check input arg
	tze	2	normal, sffcoi points to inactive one
	iera	sffcoi	invert meaning of sffcoi
	rem
	icana	sffcoi	alt?
	tze	nob010-*	nope, continue
	rem
	ila	h.sic1-h.sic0	get the diff
	asa	nobiwp-*	update word
	ila	sf.ob1-sf.ob0	get other diff
	asa	nobibp-*	update word
	rem
nob010	lda	t.ocur,1	get the current buffer ptr
	tsy	a.k007-*,*	setbpt
	cax3
	lda	bf.nxt,3	get the next guy
	sta	nobibp-*,*	put into sfcm
	tsy	a.k007-*,*	setbpt
	cax3		hang on to virtual address
	stx3	nobbuf-*	save it away as well
	rem
	iaa	bf.dta	add in offset of data
	ora	l.k003-*	(=0,b.0) get char addressing flags
	caq		hang on to it
	rem
	lda	bf.tly,3	get the tally from buffer
	ana	l.k004-*	(=buftmk) isolate tally
	llr	18	switch a and q
	ldx3	nobiwp-*	get the icw ptr
	tsy	a.k010-*,*	(bldicw) store icw
	rem
	ldx3	nobbuf-*	get latest buffer pointer back
	lda	l.k016-*	(=sffhdl)
	cana	sf.flg,2	is it HDLC?
	tze	nob020-*	no
	lda	bf.flg,3	get buffer flags
	cana	l.k010-*	(=bfflst) last buffer ?
	tze	nob020-*	no
	rem
	lda	l.k014-*	(=pb.tre) get tally runout enable bit
	orsa	sf.pcw,2	turn it on in saved pcw
	lda	l.k013-*	(=p.ris) get pcw opcode
	tsy	a.k011-*,*	(=cioc) connect
	rem
nob020	tsy	a.k005-*,*	(=oscan) scan output buffer
	tsy	a.k001-*,*	(=outpar) put parity on ebcdic
	rem
nobret	return	nobicw
	rem
nobibp	bss	1
nobiwp	bss	1
nobbuf	bss	1
	rem
	rem
	rem
l.k001	vfd	18/sffcoi
l.k002	vfd	o18/010000
l.k003	ind	0,b.0
l.k004	vfd	18/buftmk
l.k005	vfd	18/p.nop
l.k006	vfd	18/tfosus
l.k007	vfd	18/hs.siw
l.k008	vfd	18/bffctl
l.k009	vfd	18/bffhld	hold output buffer flag
l.k010	vfd	18/bfflst	last buffer in message flag
l.k011	vfd	18/c.rrec+c.rdtr+c.sbrk
l.k012	vfd	18/tfacu
l.k013	vfd	18/p.ris
l.k014	vfd	18/pb.tre
*l.k015	see below
l.k016	vfd	18/sffhdl
*l.k017	unused
l.k018	vfd	18/tfwrit
	even
l.k015	oct	0,1	for adding 1 to doubleword
	even
havcnt	bss	2
	rem
	rem
a.k001	ind	outpar
a.k002	ind	freout
a.k003	ind	nobicw
a.k004	ind	denq
a.k005	ind	oscan
a.k006	ind	echock
a.k007	ind	setbpt
a.k008	ind	stpswd	status save word
a.k009	ind	.crbpe
a.k010	ind	bldicw
a.k011	ind	cioc
	ttls	optro - output tally runout status
optro	subr	otr,(x1,x2,x3)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	optro
*
*	     process the tally runout status, this means
*	that the output is finished, or that we didnt
*	reconnect the next buffer in time.
*
*	NOTE: if output is in suspend state, this routine will
*	be no-op by a tra to otrret.
*
*	upon entry:
*	     x1 & x2 -as usual
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.flg,1	was output suspended?
	cana	l.l003-*	tfosus
	tze	otr050-*	no, normal processing
	rem
	tra	otrret-*	no processing for now
	rem
otr050	szn	t.dcwl,1	any dcw list to do?
	tze	otr060-*	no, check echo
	rem
	ldx3	t.dcwa,1	get addr of said list
	lda	0,3	get the dcw
	arl	15	get op type
	icmpa	dl.cmd	is it cmd dcw?
	tnz	otr060-*	no, not so important
	rem
	lda	0,3	reload dcw
	cana	l.k011-*	(=c.rrec+c.rdtr+c.sbrk) ?
	tnz	otr070-*	yes, process dcw first
	rem
otr060	tsy	a.k006-*,*	(=echock) test for echoing
	tra	otrret-*	good, there was some
	tra	otr070-*	no, cleanup the remains
	rem
otr070	lda	sf.flg,2	get the sfcm flags
	icana	sffech	is a tab, cr, lf, echo in progress?
	tze	otr080-*	no, cleanup
	rem
	ila	sffech	get the echo flag
	iera	-1	invert the word
	ansa	sf.flg,2	and turn it off in sfcm
	rem
	ila	pb.xmt	get the xmt bit
	iera	-1
	ansa	sf.pcw,2	and turn it off in the pcw
	rem
otr080	lda	t.dcwl,1	any dcw list?
	tze	otrret-*	nope, done
	icmpa	1	exactly one dcw left?
	tnz	otr100-*	no, process it like any other
	ldx3	t.dcwa,1	otherwise see if it's a normal end-of-output
	lda	0,3	get the subop
	cmpa	otrdc1-*	=(cmd rxmit+sterm)
	tnz	otr100-*	 no, check for one other special
	stz	t.dcwl,1	we're going to take care of dcwlist now
	tsy	gentrm-*	do terminate status
	tra	otrret-*	done
	rem		check for same but also turning off rts
otr100	tsy	a.l003-*,*	(=hdcw) call dcw processor
	rem
otrret	return	optro
	rem
	rem
otrdc1	cmd	c.rxmt+c.strm
otrdc2	cmd	c.rxmt+c.rrqs+c.strm
otrdc3	cmd	c.rrqs
	ttls	opxte - output transfer timing error status
opxte	subr	oxt,(x1)
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	opxte
*
*	     output transfer timming errors are very
*	unusual, and in debugging mode we will
*	die on them, otherwise ctrl tables will
*	be poked with status
*
*	upon entry:
*	     x1 - virtual tib address
*	     x2 - virtual sfcm address
*
*	returns:
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	lda	t.stat,1	get the tib status bits
	iana	s.dss	but only the ones we want
	ora	l.l002-*	(=s.xte) get the xte status
	tsy	a.l004-*,*	(=istat) call intrp
	rem
	ife	sw.dbg,1,1
	die	7
	rem
	return	opxte
	ttls	gentrm - subroutine to generate output terminate status
	rem
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*	gentrm
*
*		this subroutine is called by optro to generate terminate
*	status and clean up after exiting transmit mode
*
*	upon entry:
*		x1 - virtual tib address
*		x2 - virtual sfcm address
*
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
gentrm	subr	gen
	stz	sf.ob0,2	xmit is down, no buffers now
	stz	sf.ob1,2
	ldx3	sf.hcm,2	get hardware comm address
	lda	l.l006-*	=o410000
	sta	h.sic0+1,3	mark both send icws exhausted
	sta	h.sic1+1,3
	lda	l.l007-*	=^tsfxmt
	ansa	t.stat,1	not in xmit now
	ila	pb.xmt	mark sf.pcw also
	iera	-1
	ansa	sf.pcw,2
	lda	t.stat,1	get current status
	iana	s.dss	interesting part
	ora	l.l008-*	(=s.term) set terminate status
	tsy	a.l004-*,*	istat
	return	gentrm
	rem
	rem
	rem
*l.l001		unused
l.l002	vfd	18/s.xte
l.l003	vfd	18/tfosus
l.l004	vfd	18/sffcoi
*l.l005	unused
l.l006	oct	410000	exhausted icw tally word
l.l007	vfd	o18//tsfxmt
l.l008	vfd	18/s.term
*l.l009	unused
*l.l010	unused
l.l011	vfd	o18//tfosus
	rem
a.l001	ind	otrdc3
a.l002	ind	setbpt
a.l003	ind	hdcw
a.l004	ind	istat
a.l005	ind	resout
	ttls	freout subroutine, frees output buffer
	rem
	rem	this subroutine is called when output from a buffer is
	rem	finished. its job is to free the buffer (unless its
	rem	bffhld flag is on), decrement t.ocnt, and issue a send_output
	rem	request if appropriate
	rem
	rem	at entry:
	rem	   x1 cpntains virtual tib address
	rem	   x3 contains virtual address of buffer
	rem
	rem
freout	subr	fre,(x3)
	rem
	lda	bf.flg,3	get buffer flags
	cana	l.u001-*	check hold output buffer flag
	tnz	freret-*	yes - dont free the buffer
	rem
	cana	l.u002-*	(=bffctl) control info in this buffer?
	tnz	fre010-*	yes, don't decrement count
	rem
	ila	-1	get the minus one
	asa	t.ocnt,1	decrement counter
	rem
	lda	t.flg2,1	get 2nd word of tib flags
	cana	l.u003-*	check if we just used acu
	tnz	fre010-*	there's no output to ask for
	rem
	lda	t.ocnt,1	get new value of count
	icmpa	bufthr	are we at the threshold?
	tnz	fre010-*	no, continue
	rem
	szn	t.ocp,1	is there more output in the FNP already?
	tnz	fre010-*	yes, don't ask for more yet
	rem
	ilq	sndout	get the "send_output" op-code
	tsy	a.u001-*,*	(=denq) queue it up
	rem
fre010	cx3a
	tsy	a.u003-*,*	(cvabs) get absolute address of buffer
	ilq	0	let frebfh get buffer size
	tsy	a.u002-*,*	(=frebfh) free the spent buffer
	rem
freret	return	freout
	rem
	rem
a.u001	ind	denq
a.u002	ind	frebfh
a.u003	ind	cvabs
	rem
l.u001	vfd	18/bffhld
l.u002	vfd	18/bffctl
l.u003	vfd	18/tfacu
	ttls	hsla jump tables
	rem
	rem	macro to create jump tables
	rem
jmptbl	macro
	crsm	on
	idrp	#1
#3#1	ind	invp	interrupt processor (sked$invp)
	zero	0
	tsy	#3#1-*,*
#2#1	vfd	4/h1ch+#1-1,2/#1,5/0,7/schdmn
	dup	5,31
	zero	0
	tsy	#3#1-*,*
subch	set	*-#2#1
subch	set	subch/3
	vfd	4/h1ch+#1-1,2/#1,5/subch,7/schdmn
	idrp
	endm	jmptbl
	rem
	rem
	rem
	rem
	rem	*********************************************************
	rem	*
	rem	* a jump table consists of a three word vector.
	rem	* a jump table is transferred to by the hardware upon an
	rem	* interrupt for this device.
	rem	*
	rem	* word 0 is tsy'ed to by the hardware and thus contains
	rem	*        the ic at the time of the interrupt
	rem	* word 1 contains the instruction tsy scheduler$invp
	rem	* word 2 contains a packed representation of the device
	rem	*        which interrupted -- it has:
	rem	*        4 bits of iom chan #,
	rem	*        2 bits device # (1 - 3 for hsla's),
	rem	*        5 bits subchannel # (0 - 37(8) for hsla's)
	rem	*        7 bits module # for the scheduler.
	rem	*
	rem	*********************************************************
	rem
	rem
hslajt	null
	rem
	jmptbl	(1,2,3)
	rem
	end



		    ic_sampler.map355               09/23/82  1220.5rew 09/23/82  1209.9       34587


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

	ttl	module to monitor performce by sampling ic
	lbl	,ic_sampler
	pmc	off
	pcc	on
	editp	on
	rem
	symref	etrip	start of elapsed timer handler - contains ic
	symref	sked	lowest address to check
	symref	idlmrk	start of idle loop
	symref	idlend	end of idle loop
	symref	intp	beginning of interpreter
	symref	intend	end of interpreter
	rem
	symdef	icmon	routine to do the work
	symdef	icmdat	data base for external programs
	rem
	rem
*	this module is controlled by data in the following table.
*	the format of this table is known to ring-4 multics
*	software (debug_fnp), from where it is read and patched.
	rem
icsamp	null
	start	icsamp
	rem
	even
icmdat	null
action	oct	0	multics sets this to request action
	rem		1 = start monitoring
	rem		2 = stop monitoring
	rem		3 = clear table
confrm	oct	0	we set this to confirm receipt of action
	rem		1 = action performed
	rem		2 = illegal action
enable	oct	0	when non-zero, monitoring is on
tbaddr	ind	table	address of data area
tblen	ind	ltable	number of words (2 per bucket)
shift	oct	5	amount to shift address (bucket size)
base	ind	sked	lowest address to watch
	even
orange	oct	0,0	count of out-of-range samples
ilpcnt	oct	0,0	count of samples in idle loop
	eject
icmon	subr	icm,(x1,x2)
	rem
*	first, perform any outstanding actions
*	ring-4 multics software sets an action code. this module responds
*	by performing the action next time is is called and
*	storing a confirmation in 'confrm'
	rem
	lda	action-*	pick up the code
	tze	icm070-*	no request
	icmpa	1	start?
	tze	icm010-*
	icmpa	2	stop?
	tze	icm020-*
	icmpa	3	clear?
	tze	icm030-*
	ila	2	invalid action
	tra	icm060-*	go report it
	rem
icm010	ila	1	start
	sta	enable-*
	tra	icm050-*
	rem
icm020	stz	enable-*	stop
	tra	icm050-*
	rem
icm030	ldx1	tbaddr-*	first addr to clear
	ila	0
	sba	tblen-*	get -length
	ars	1	convert to -double words
	sta	icmtmp-*
	ila	0
	ilq	0
icm040	staq	0,1	clear the table
	iacx1	2
	aos	icmtmp-*
	tmi	icm040-*
	staq	orange-*	clear out-of-range too
	staq	ilpcnt-*	and times at the dis
	rem
icm050	ila	1	report success
icm060	sta	confrm-*
	stz	action-*
	eject
*	now, compute a bucket number and record ic
	rem
icm070	szn	enable-*	are we monitoring?
	tze	icmret-*	no
	lda	shift-*	build shift instruction
	ora	l.a001-*	=arl 0
	sta	icm080-*
	lda	a.a001-*,*	=etrip, the ic interrupted
	cmpa	a.a003-*	=addr(idloop-1) are we in idle loop?
	tmi	icm075-*	no, we're before the beginning
	cmpa	a.a005-*	=addr(idlend+1) check end
	tmi	icm110-*	we're idle, meter it as such
icm075	cmpa	a.a006-*	addr(intp) within interpreter?
	tmi	icm077-*	no
	cmpa	a.a007-*	addr(intend) maybe
	tpl	icm077-*	no
	lda	icmsx2-*	yes, use x2 instead (op block address)
icm077	sba	base-*	get offset
	tmi	icm090-*	out of range
icm080	arl	*-*	divide to get bucket number
	als	1	multiply by 2 (for double word)
	cmpa	tblen-*	too high?
	tpl	icm090-*	yes
	ada	tbaddr-*	compute bucket address
	cax1
	tra	icm100-*
	rem
icm110	ldx1	a.a004-*	=ilpcnt, addr of idle bucket
	tra	icm100-*
	rem
icm090	ldx1	a.a002-*	use out-or-range bucket
	rem
icm100	ila	0
	ilq	1	build a 1
	adaq	0,1
	staq	0,1
	rem
icmret	return	icmon
	rem
	rem
icmtmp	bss	1
a.a001	ind	etrip
a.a002	ind	orange
a.a003	ind	idlmrk	one location before idloop
a.a004	ind	ilpcnt
a.a005	ind	idlend+1
a.a006	ind	intp
a.a007	ind	intend
l.a001	arl	0
	rem
	rem
	even
table	bss	2000
ltable	equ	*-table
	rem
	end
 



		    init.map355                     02/03/86  1012.1rew 01/31/86  0830.0      661851


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

	lbl	,init
	ttl	init - fnp initialization module for multics 
	rem
***********************************************************************
*
*  note:  cs means "central system"
*
***********************************************************************
*
* init is the initialization module for mcs. it is entered from
* gicb just after bootload. init is always the last module
* loaded into the fnp and most of it is freed as buffer
* space after initialization is complete.
*
* this routine takes care of setting up each configured
* io channel and allocating tibs for each line.
*
* initially coded for gerts and stolen for mcs.
* modified by Coren for mcs.
* modified by grady and coren to delete pre-init code
*   from other modules.
* modified by Grady to add stuff for printer init.
* modified by art beattie to support dn6670 extended memory.
* modified by Robert Coren to add allocation of metering area
* modified by Robert Coren to support buffers in extended memory and
*   to eliminate code for 32k FNP.
* modified September 1983 by Robert Coren to check for zero-length
*   trace buffer.
*
***********************************************************************
	rem
	pcc	on
	pmc	off
	detail	on
	editp	on
	rem
	symdef	init
	symdef	istart
	rem
	symref	ignore	ignore interrupts routine
	symref	badint	extraneous interrupt routine
	symref	exist	summary of which iom channels exist
	symref	iomflt	iom channel fault routine
	symref	hfv	hardware fault vector entry base address
	symref	msdsp	master dispatcher entry location
	symref	etrip	elapsed timer rollover interrupt proc.
	symref	dicell	dia configuration switch data location
	symref	dindcw	dia_man interrupt dcw
	symref	wcon	console routine entry point
	symref	contip	console terminate interrupt proc address
	symref	conchn	console channel number
	symref	getbuf	buffer allocating subroutine
	symref	frebuf	buffer freeing subroutine
	symref	frebfh	free buffer in extended memory
	symref	getmem	memory allocating subroutine
	symref	fremem	memory freeing subroutine
	symref	fresml	routine to clean up fres space
	symref	bfcksw	switch that controls buffer checking
	symref	ctrl	control tables
	symref	itest	"test-state" entry to interpreter
	symref	hslajt	hsla jump tables
	symref	diajt	dia jump tables
	symref	dlist	dia icws, pcws, etc.
	symref	diconf	dia configuration area
	symref	consjt	console jump tables
	symref	timrjt	timer jump tables
	symref	utsave	place in utilities where regs get saved
	symref	pterm	printer terminate interrupt handler
	symref	pspec	printer special handler
	symref	brktab	addr of table in breakpoint_man
	symref	skdata	address of scheduler data block
	symref	icmdat	address of ic-moniroting data block
	symref	etrmon	address of icmdat in sskdata
	symref	etrint	address of timer interval in skdata
	symref	idlint	idle metering interval
	symref	idloop	start of idle loop
	symref	idlcnt	counter maintained by idle loop
	symref	idlmax	maximum idle count value
	symref	idlmin	mininum  "     "    "
	symref	dspqur	secondary queuer
	symref	secdsp	secondary dispatcher
	symref	setptw	set page table word
	symref	trace	trace module
	symref	endtrc	(in trace module) last word in trace buffer
	symref	nxtrce	(in trace module) next entry in trace buffer
	symref	mvplmm	move paged lower memory maximum address
	symref	conman	set to -1 by init if console_man is in image
	symref	getbfm	interrupt time metering area for getbuf
	symref	diasel	'sel' instruction in dia_man
	symref	fpsel	and two in utilities
	symref	obsel
	rem
	pmc	save,on
	systm
	comreg
	rem
	hwcm
	rem
	tib
	rem
	meters
	rem
	sfcm	hsla
	rem
	devtab
	rem
	buffer
	eject
pbit	bool	200
	rem
	rem		character codes
	rem
cr	bool	15
lf	bool	12
stx	bool	2
esc	bool	33
sync	bool	26
us	bool	37
	rem
	rem
ptro	bool	2000	pre-tally runout status
rts	bool	20	set request-to-send
dtr	bool	40	data terminal ready
rcv	bool	400	receive mode
snd	bool	200	send mode
	rem
	rem		pcw opcodes
	rem
initop	bool	10
reqcst	bool	3
rstmsk	bool	5
setmsk	bool	4
stomrg	bool	11
	ttls	configuration tree table definitions
************************************************************************
* these symbolic names are used to access the various fields of the
* configuration tree table (fig tree).
*
* three symbols are defined for each field:
*
*	fa      can be used as a mask to isolate the field.
*	fb      can be used as a mask when the field is right justified.
*	fc      the position ofthe lsb of the field.
*
* when changes are made to this table, be sure to check all useage
* of symbols beginning with "fa".
************************************************************************
	rem
fampx	bool	400000	1 = multiplexed channel
fbmpx	bool	1
fcmpx	equ	0
	rem
farel	bool	200000	1 = device released
fbrel	bool	1
fcrel	equ	1
	rem
faasyn	bool	100000	1 = asynchronous device
fbasyn	bool	1
fcasyn	equ	2
	rem
fadacn	bool	070000	device number for hsla and lsla
fbdacn	bool	7
fcdacn	equ	5
	rem
fatnd	bool	004000	1 = t&d is in control
fbtnd	bool	1
fctnd	equ	6
	rem
fachrl	bool	003000	character length code
fbchrl	bool	3
fcchrl	equ	8
	rem
fadevc	bool	000760	device type code
fbdevc	bool	37
fcdevc	equ	13
	rem
fasped	bool	000017	device speed code
fbsped	bool	17
fcsped	equ	17
	eject
	rem	*********************************************************
	rem	* device type codes
	rem	*********************************************************
	rem
dnimp	bool	00	not implemented
	rem
dclock	bool	01	fnp's clocks
	rem
ddia	bool	02	dia
	rem
dhsla	bool	03	hsla
	rem
dlsla	bool	04	lsla
	rem
dcon	bool	05	console
	rem
dprint	bool	06	printer
	rem
	rem	unused codes 07 - 14
	ttls	symbol definition	rem
	rem
	pmc	on,save
	hslatb
	pmc	restore
	rem
	rem
	rem	********************************************
	rem	* modem types
	rem	********************************************
	rem
mt103a	equ	1
mt201c	equ	2
mt2025	equ	3
mt2026	equ	4
mt208a	equ	5
mt208b	equ	6
mt209a	equ	7
	rem	10-17 unused
	rem
tt2741	equ	3	terminal type "2741"
ttbsc	equ	7	line type for bisync
ttx25	equ	17	line type for x.25
tthdlc	equ	18	line type for hdlc
ttcolt	equ	19	line type for colts channel
	rem
diardc	bool	74	dia opcode -- read configuration
diadis	bool	70	dia opcode -- disconnect
	rem
	rem
	rem
init	null
	start	init,9
	pmc	restore
	rem
	even
tibtab	bss	816	2 words per tib (unused space will be freed)
	ttls	init macros
	rem
	rem	*******************************************************
	rem	*
	rem	*  dn6670 paged data address icw (odd word)
	rem	*    allows IOM to directly address all 64k memory
	rem	*
	rem	*******************************************************
	rem
amicwo	macro
	vfd	2/2,3/#1,1/#3,12/#2
	endm	amicwo
	rem
	rem
	rem	* multiply macro
	rem
mpy	macro
	mpf	#1
	lrl	1
	endm	mpy
	ttls	miscellaneous subroutines
************************************************************************
* setclk -- set interval timer
* rstclk -- reset interval timer
*
* entry -- setclk
*
*	lda     (number milliseconds)
*	ldq     (return address on runout)
*	tsy     setclk-*
*
* entry -- rstclk
*
*	tsy     rstclk-*
************************************************************************
	rem
setclk	ind	**
	sti	scindc-*	save io select register
	sel	tmch	select clock channel
	cioc	scoff-*	turn clock off
	sta	scvalu-*,*	store time value
	stq	sciv-*,*	store user's iv
	cioc	scon-*	turn clock on
	ldi	scindc-*	restor io select reg <?><?><?><?><?><?><?><?>
	tra	setclk-*,*	return
	rem
	rem
	rem
rstclk	ind	**
	sti	scindc-*	save io select register
	sel	tmch	select clock channel
	cioc	scoff-*	turn clock off
	ldi	scindc-*	restore io select register <?><?><?><?><?>
	tra	rstclk-*,*	return
	rem
	rem
	rem
	even
scon	oct	0,0
scoff	oct	0,010000
scvalu	ind	itmb	interval timer mailbox address
sciv	ind	tmro	interval timer runout iv address
scindc	bss	1
	ttls	main initialization loop
	rem
******************************************************************************
*
* the code from istart-1 to the begining of channel initialization is only
* executed once.  therefore, this code is located at the end of the module
* so it can be released as buffer space and used for tib and sfcm allocation.
* this helps in making available as much memory as
* possible for channel initialization.
*
******************************************************************************
	rem
	rem
	rem	*********************************************************
	rem	* scan fig tree and initialize devices
	rem	*********************************************************
	rem
figtre	ind	**+0,1	points to current "fig" -- 1st word
	ind	**+1,1	points to current "fig" -- 2nd word
	rem
itl010	null
	lda	iomch-*
	als	1
	cax1		x1 = 2 * iom channel number
	lda	figtre-*,*	pluck a fig from the tree of knowledge
	caq
	ldx2	figtre+1-*,*	get wd 2 of entry
	arl	18-fcdevc-1	r-just device code bits
	rem
	rem	* at this point,
	rem	*      q  = word  0 of config table
	rem	*      x1 = 2 * (iom channel #)
	rem	*      x2 = word  1 of config table
	rem
	iana	fbdevc	? non-implemented channel ?
	tze	nodev-*	yes
	icmpa	ddia	? device = dia ?
	tze	a.a001-*,*	(dia) yes
	icmpa	dhsla	? device = hsla ?
	tze	a.a002-*,*	(hsla) yes
	icmpa	dprint	? device = printer ?
	tze	a.a004-*,*	(print) yes
	icmpa	dclock	? device = clocks ?
	tze	a.a005-*,*	(clocks) yes, also -- last iom channel
	rem
itl020	null
	aos	iomch-*	bump to next iom channel
	tra	itl010-*
	rem
	rem
	rem	device initialization routines:
a.a001	ind	dia	direct interface adapter
a.a002	ind	hsla	high speed line adapter
*a.a003		unused
a.a004	ind	print	line printer
a.a005	ind	clocks	clocks -- final start up procedures
a.a006	zero	savein
	rem
l.a001	qls	0
savein	bss	3*16
	ttls	nodev -- initialize for non-implemented channel
************************************************************************
* non-implemented channel:
*
*  --set appropriate iv's to point to an "extraneous interrupt"
*    reporting routine.
*
*  --send a mask pcw (bit 23 =1) to insure channel is off.
************************************************************************
	rem
nodev	null
	rem
	lda	iomch-*	compute base address of iv's for
	als	1	this channel
	ada	iomch-*
	ada	a.a006-*	(savein)
	cax1
	lda	a.b001-*	(badint)
	sta	0,1
	sta	1,1
	sta	2,1
	lda	iomch-*	store channel # in "sel"
	ora	l.b001-*	(sel 0) instruction
	sta	ndv010-*
	rem
ndv010	sel	**	select the channel
	cioc	nmpcw-*	send mask pcw
	rem
	tra	itl020-*
	rem
	rem
	rem
a.b001	ind	badint
	rem
l.b001	sel	0
	rem
iomch	zero	0	current iom channel number
	even
nmpcw	oct	0,010000	pcw0 -- mask channel
	ttls	print - initialize for line printer
**********************************************************************
* setup to run the line printer. init the interrupt vectors
* into ptrac.
**********************************************************************
	rem
print	null
	rem
	lda	iomch-*	get the channel number
	als	1	times 2
	ada	iomch-*	now is times 3
	ada	a.a006-*	(savein) plus base of save area
	cax1		copy into x1
	rem
	lda	a.c001-*	(pspec) get special handler addr
	sta	1,1	put into save area
	lda	a.c002-*	(pterm) and terminate handler
	sta	2,1	save it too, to be restored later
	rem
	tra	itl020-*	return for next channel
	rem
	rem
a.c001	ind	pspec
a.c002	ind	pterm
	ttls	dia -- initialize for inter-computer adapter
************************************************************************
* this routine initializes the dia by reading the setting of the
* configuration data switches.
************************************************************************
	rem
dia	null
	rem
	aos	icflag-*
	rem
	lda	iomch-*
	cmpa	diachn-*	is it the one on which we got the interrupt?
	tnz	itl020-*	no, ignore it altogether
	orsa	dia030-*
	orsa	dia070-*
	orsa	dia020-*
	orsa	a.d007-*,*	bst010
	orsa	a.d025-*,*	diasel (in dia_man)
	orsa	a.d026-*,*	fpsel (in utilities)
	orsa	a.d027-*,*	obsel (in utilities)
	als	1	set level 1 iv to extraneous int routine
	ada	iomch-*
	ada	a.a006-*	(savein)
	cax1
	lda	a.b001-*	(badint)
	sta	1,1
	rem
	lda	l.d001-*	(=o400000)
dia020	arl	**
	sta	cdiaic-*	save operand for "sic"
	rem
	ldq	a.d002-*,*	(exist)
dia030	qls	**	? does this channel exist ?
	tmi	dia040-*	yes
	tra	1,*
	ind	stop04	"dia does not exist" eeeeeeeeeeeeeeeeeeee
	rem
dia040	ldx2	a.d010-*	(diajt)
	stx2	2,1	put address of dia terminate jump table
	rem		in saved iv
	lda	diachn-*	and put dia channel no. in jump table entries
	als	14	line it up
	orsa	2,2
	ldx1	a.d011-*	(dis0) -- first dia "special" iv
	ilq	-16	we will store 16 jump table addresses
dia050	iacx2	3	increment jump table address
	stx2	0,1	put it in interrupt vector
	orsa	2,2	and store channel number
	iaq	1	bump counter
	tze	dia060-*	all done
	iacx1	16	no, bump interrupt vector address
	tra	dia050-*	go round again
	rem
dia060	ldx2	a.d012-*	(dlist)
	lda	1,2	get 2nd word of status icw template
	ora	l.d003-*	(=o010000) 'or' in exhaust bit
	caq
	lda	0,2	get rest of status icw template
	staq	a.d013-*,*	(dist) store it in status icw mbx
	cx2a
	iaa	2	point to pcw template
	cax3		in x3
	ila	2	get count
	cax1
	tsy	a.d014-*,*	(parity)
	rem		pcw has correct parity now
	ldaq	2,2	pick it up
	staq	a.d001-*,*	(dimb) put it in pcw mailbox
	rem
	iacx2	6	point x2 at dcw area
	ila	0	we will set up dcw list to read configuration
	ilq	diardc	config opcode (74)
	staq	0,2
	lda	a.d015-*	(diconf),w.2
	ilq	4
	staq	2,2
	rem		now disconnect dcw
	ila	diadis	disconnect opcode (70)
	sta	5,2
	lda	l.d002-*	(0,w.2)
	sta	6,2
	cx2a
	cax3		copy into x3 for parity subroutine
	ila	8	get count
	cax1
	tsy	a.d014-*,*	(parity)
	rem
dia070	null
	sel	**
	lda	diatmv-*,*	pick up terminate vector location of
	sta	ictmtp-*	dia and temp store it
	lda	a.d008-*	(dia090) pick up location to use for this
	sta	diatmv-*,*	terminate and put in iv loc
	cioc	a.d001-*,*	(dimb) pcw -- read dia configuration switches
	rem
	ila	5	set timeout (5 ms) for terminate interrupt
	ldq	dia080-1-*	pick up addr of timeout handler
	tsy	a.d005-*,*	(setclk) and go start up clock
	dis		wait for dia interrupt
	tra	-1	dont let just any interrupt do it
	rem
	ind	dia080
dia080	ind	**
	tra	1,*
	ind	stop05	"dia did not respond in time" eeeeeeeeeee
	rem
dia090	ind	**	gets "tsy"d to on dia interrupt
	tsy	a.d006-*,*	(rstclk) dia terminate interrupt occurred
	rem
	lda	a.d016-*	(dia100) get new temporary iv
	sta	diatmv-*,*	
	ldaq	initst-*	get "init entered" status
	tsy	a.d024-*,*	(btsts) send it to dia
	tra	dia100+1-*	if we come here, we are in sim
	rem
	rem		btsts waits for interrupt
	rem
dia100	ind	**	tsy'd to after interrupt
	lda	ictmtp-*	pick up saved loc of dia terminate
	sta	diatmv-*,*	handler, and put it back
	rem
	rem		put terminate interrupt cell into dia_man's dcw
	lda	a.d003-*,*	(dicell) get it from configuration switches
	arl	3	isolate terminate interrupt cell
	als	6
	orsa	a.d009-*,*	(dindcw)
	rem		dia is all set up now
	tra	itl020-*
	eject
	rem
a.d001	ind	dimb	dia mailbox address
a.d002	ind	exist
a.d003	ind	dicell
a.d005	ind	setclk
a.d006	ind	rstclk
a.d007	ind	bts010
a.d008	ind	dia090
a.d009	ind	dindcw
a.d010	ind	diajt
a.d011	ind	dis0
a.d012	ind	dlist
a.d013	ind	dist
a.d014	ind	parity
a.d015	zero	diconf,w.2
a.d016	ind	dia100
a.d017	ind	hslano
a.d018	ind	hlahcr
a.d019	ind	getchn
a.d020	ind	hmsg01+2
a.d021	ind	iwcon
a.d022	ind	hslajt
a.d023	zero	.criom
a.d024	ind	btsts	bootload status reporting routine
a.d025	ind	diasel	'sel' instruction in dia_man
a.d026	ind	fpsel	'sel' instruction in fault processor
a.d027	ind	obsel	'sel' instruction in crash routine
	rem
l.d001	oct	400000
l.d002	zero	0,w.2
l.d003	oct	010000	exhaust bit
	even
initst	oct	450000,000000	"init entered" status
	rem
cdiaic	bss	1
icflag	oct	0
ictmtp	oct	0
diachn	bss	1	dia iom channel
diatmv	ind	**	patched to address of dia terminate vector
	ttls	hsla -- initialize for high speed line adapter
	rem
************************************************************************
*
* this routine will initialize all that is necessary to operate
* from one to three high speed line adapters.  subchannels which are
* found to not exist or configured improperly will be marked by
* setting the "exhaust" bit in the active status icw. no tib or software
* comm region will be created for such subchannels.
*
************************************************************************
	rem
	rem
	rem	*      this procedure is entered with:
	rem	* q  = word 0 of config table
	rem	* x1 = 2 * (iomchannel #)
	rem	* x2 = word 1 of config table
	rem
hsla	null
	cqa		lets figure out the hsla #
	arl	18-fcdacn-1	from word 0 of config table
	iana	fbdacn	-- now we have got it
	iaa	-1	internal count is from 0
	sta	a.d017-*,*	(hslano) save it for later
	iaa	1
	als	9	multiply by 1000 (octal) and we
	sta	a.d018-*,*	(hlahcr) have the hardware region address
	rem
	cax3		x3 -> this hsla hardware comm region
	rem
	lda	iomch-*	now, lets see if this iom channel
	ora	l.a001-*	(qls 0) exists (from the "exist" variable)
	sta	+2	put this "qls iomch#" where we will execute it
	ldq	a.d002-*,*	(exist) pick up the knowledgeable variable
	qls	**	and shift left until our bit is in the
	rem		sign position (this loc patched)
	tmi	hsl010-*	this channel does exist
	rem
	tsy	a.d019-*,*	(getchn) get the current iom chan # in ascii
	stq	a.d020-*,*	(hmsg01+2) and save its ascii value
	tsy	a.d021-*,*	(iwcon) use "disaster" mode console routine
	ind	hicw01
	nop		dont bomb if no console exists
	tra	itl020-*	give up on this hsla
	rem
hsl010	null		hsla does exist, and was initialized
	ila	97	get size of each jump table (per hsla)
	mpy	hslano-*	times hsla no to get addr offset
	rem
	adq	a.d022-*	(hslajt) add in base addr
	stq	hjtloc-*	save
	aos	hjtloc-*	bump by one to skip ind word
	rem
	stz	hsbchn-*	set to 0th subchannel
	cx1a		get iom channel no.
	rem		times 2
	ada	a.d023-*,*	(.criom)
	cax2		pointer to iom table entry
	ldx2	1,2	pointer to hsla table
	rem
	rem	*********************************************************
	rem	*
	rem	*      perform the following initialization procedures for
	rem	* each subchannel that was configured in the cdt.
	rem	* if a subchannel does not exist, or does not conform
	rem	* to the configuration desired, set the "exhaust" bit in
	rem	* its active status icw; otherwise, allocate a tib
	rem	* (terminal information block) and a software comm.
	rem	* region for the subchannel.
	rem	*
	rem	*********************************************************
	rem
hsl020	null
	lda	iomch-*	get the iom channel number
	ora	l.b001-*	(sel 0) and build a "sel" instruction
	sta	1	and put it where we'll use it
	sel	**	(patched) select this hsla
	rem
	ldaq	h.cnfg,3	get config pcw, if any (stored
	rem		here by load_fnp_ routine)
	tze	hsl400-*	this channel isnt configured
	rem
	staq	hcnfig-*	save the configuration pcw
	rem
	cx3a		get addr of hwcm into the a
	arl	9	divide by 1000(8)
	als	2	multiply by 4(8)
	sta	hivloc-*	save as iv location so far
	lda	hsbchn-*	get subchannel number
	icmpa	16	is it > 20(8)?
	tmi	hsl030-*	no, continue
	rem
	aos	hivloc-*	yes, bump ivloc by one
	iaa	-16	and decrement sbchn by 16
hsl030	als	4	multiply subchn by 20(8)
	asa	hivloc-*	add into ivloc
	rem
	lda	hjtloc-*	get the jump table addr
	sta	hivloc-*,*	deposit in iv
	rem
	ldaq	hsticw-*	set my active status icw
	staq	h.aicw,3	and store it in hwcm
	rem
	rem		build an "unmask" pcw
	lda	hsbchn-*	load subchannel number
	als	6	move into subchannel field
	ora	hunmsk-*	or in pcw 0, command 5
	ldq	hunmsk+1-*	and pick up no broadside commands
	staq	hpcw-*	and save this pcw for execution
	rem
	cioc	hpcw-*	unmask the subchannel
	rem
	cioc	hcnfig-*	configure this subchannel
	rem
	lda	hsbchn-*	now lets build a "request config" pcw
	als	6	move subchannel number in
	ora	hreqcn-*	(=230000) pcw 1,command 3
	ldq	hreqcn+1-*	get second word (request to send)
	staq	hpcw-*	and save it for a bit later
	rem
	stz	h.cnfg,3	clear config status words to be able
	stz	h.cnfg+1,3	to detect no response
	rem
	cioc	hpcw-*	request configuration status
	rem
	ila	10	wait 10 ms for status store
	ldq	hsl040-1-*	get location to tsy thru then
	tsy	a.f001-*,*	(setclk) go start up the clock
	dis
	tra	-1	ignore all interrupts til then
	rem
	ind	hsl040
hsl040	ind	**	control gets here when done waiting
	rem		for config status store
	rem	*********************************************************
	rem	*      now test received configuration status against
	rem	* desired configuration and other criteria.
	rem	*********************************************************
	rem
	ldaq	hcnfig-*	test upper half for matching bits
	ana	hmask1-*	(=o600076) (see hmask1 for expl)
	sta	htemp-*	this is what it should be
	rem
	lda	h.cnfg,3	now, lets see what it is
	ana	hmask1-*	(=o600076) (see hmask1 for expl)
	cmpa	htemp-*	see if what is is what should be
	tnz	hsl390-*	nope, go mask off channel
	rem
	cana	l.f002-*	(=o200000) is it synchronous?
	tnz	hsl050-*	if so, don't bother with second word
	rem
	lda	h.cnfg+1,3	pick up lower half of status to test char length
	ana	l.f003-*	(=o170000) mask out all but character lengths
	cmpa	l.f004-*	(=o040000) see if 8 bit byte size
	tze	hsl050-*	yes, this is ok
	cmpa	l.f005-*	(=o020000) see if 7 bit byte size
	tze	hsl050-*	yes, this is ok
	cmpa	l.f006-*	(=o010000) see if 6 bit byte size
	rem		yes, this is ok, fall through
	tnz	hsl390-*	not ok, mask out this channel
	rem
	rem
hsl050	null
	lda	ht.flg,2	get the baud rate into
	iana	htfspd	hbaud for maktib
	sta	hbaud-*
	rem
	lda	ht.flg,2	get flags again
	ana	l.f008-*	(hftasy) is it sync or async?
	arl	7	just put bit into hbaud
	orsa	hbaud-*	in the right place
	rem
	stx2	hsavx2-*	save ptr to hsla table entry
	rem		set up software comm. region and tib
	stx3	hsavx3-*	save hardware comm. region address
	tsy	a.f003-*,*	(hgsfcm) allocate an sfcm
	rem
	ldx3	hsavx3-*	get hwcm address and store
	sta	h.sfcm,3	software comm. region address
	rem
	rem		set up active status icw in hwcm
	iaa	sf.sta	point to hardware status in sfcm
	ldq	hsaicw-*	get odd word of dn6670 status icw
	staq	h.aicw,3	note that the channel can store 6 though
	rem		 tally is set to 5. hardware stores status
	rem		 in sixth word after tally runout.
	lda	l.f010-*	(=o10000) exhaust bit in icw
	sta	h.sic0+1,3	init both of the xmit
	sta	h.sic1+1,3	to exhaust condition
	rem
	rem		now get line number
	ldq	hslano-*	hsla number
	qls	6
	adq	hsbchn-*	subchannel no.
	adq	l.f001-*	(=o1000) hsla indicator
	rem		now make the tib
	lda	hbaud-*	restore baud code
	tsy	a.f008-*,*	(maktib) allocate a tib for it
	rem
	sta	ht.tib,2	put real tib address in hsla table entry
	rem
	lda	h.sfcm,3	get real sfcm address from hwcm
	tsy	a.f013-*,*	(setptw) virtualize it
	sta	t.sfcm,1	put virtual sfcm address in tib
	cax2		get it into right register
	rem
	rem	fill in stuff in sfcm
	rem
	stx3	sf.hcm,2	put hwcm addr into sfcm
	cx2a		get sfcm addr in a
	iaa	sf.waq	put starting address of wraparound queue
	sta	sf.nxa,2	in sfcm pointers
	sta	sf.nxp,2
	lda	a.f016-*,*	 (hsfssl) initialize count of free slots in queue
	sta	sf.tly,2
	sta	sf.ssl,2	save as status queue length too
	lda	hsavx2-*	address of hsla table
	sta	sf.hsl,2	save addr in sfcm
	rem
	ldx2	hsavx2-*	reload ptr to hsla table
	lda	ht.flg,2	get the flag bits
	arl	4	shift line type into position
	iana	31	mask down
	tze	hsl060-*	none specified, use default
	rem
	sta	t.type,1	put into tib
	rem
hsl060	lda	ht.flg,2	reload flag bits
	sta	htflgt-*	save in "stack" temporary
	ldx2	t.sfcm,1	reload sfcm ptr
	cana	l.f008-*	(htfasy) asynchronous?
	tnz	hsl070-*	yes
	lda	l.f017-*	(sffsyn) no, mark the sfcm
	orsa	sf.flg,2
	lda	htflgt-*	get the hsla table flags back
	rem
hsl070	null
	arl	9	look at modem type this time
	iana	15	mask down
	tze	hsl180-*	none specified
	rem
	iaa	-1	relative to zero
	ada	a.f011-*	(hsl080) get jump list base
	sta	hsltra-*	store so we can indirect
	rem
	tra	hsltra-*,*	dispatch on modem type
	rem
hsl080	tra	hsl130-*	mt103a
	tra	hsl090-*	mt201c
	tra	hsl140-*	mt202c5
	tra	hsl150-*	mt202c6
	tra	hsl160-*	mt208a
	tra	hsl120-*	mt208b
	tra	hsl170-*	mt209a
	rem
hsl090	lda	htflgt-*	get ht flags
	cana	l.f011-*	(htfpl) private line dataset?
	tnz	hsl180-*	yes, all done
	rem
hsl100	lda	l.f012-*	(tfdlup) set tib flag for dial operation
	orsa	t.flg,1	in first tib flag word
	tra	hsl180-*	done
	rem
hsl120	tra	hsl100-*	208b are always dial
	rem
hsl130	null		nothing special for these datasets
hsl140	null
hsl150	null
hsl160	null
hsl170	null
hsl180	null
	eject
	rem	process line type specification
	rem
	lda	t.type,1	now process type setting
	iaa	-1	can never be zero here
	ada	a.f012-*	(hsl190) get table base
	sta	hsltra-*	save to indirect through
	rem
	tra	hsltra-*,*	dispatch on line type
	rem
hsl190	null
	tra	hsl200-*	ascii
	tra	hsl210-*	1050
	tra	hsl220-*	2741
	tra	hsl240-*	ards
	tra	hsl250-*	sync
	tra	hsl260-*	g115
	tra	hsl230-*	bsc
	tra	hsl270-*	202etx
	tra	hsl280-*	vip
	tra	hsl290-*	async1
	tra	hsl300-*	async2
	tra	hsl310-*	async3
	tra	hsl320-*	sync1
	tra	hsl330-*	sync2
	tra	hsl340-*	sync3
	tra	hsl350-*	polled vip
	tra	hsl234-*	X.25 LAP
	tra	hsl234-*	HDLC
	tra	hsl359-*	COLTS
	rem
hsl200	lda	htflgt-*	get hsla table flag bits
	cana	l.f014-*	(hftop1) option 1 set?
	tze	hsl360-*	no
	lda	l.f016-*	(tfauto) opt1 means autobaud
	orsa	t.flg,1
	tra	hsl360-*
	rem
hsl210	null		1050 or
hsl220	ila	sffebd	2741
	orsa	sf.flg,2	set ebcdic flag in sfcm
	tra	hsl360-*	done
	rem
hsl230	lda	l.f013-*	(sffbsc) bsc type
	orsa	sf.flg,2	set sffbsc in sfcm
	tra	hsl360-*
	rem
hsl234	lda	l.f015-*	(=sffhdl) HDLC type
	orsa	sf.flg,2	set in SFCM
	tra	hsl360-*
	rem
hsl240	null		nothing to do for these types
hsl250	null
hsl260	null
hsl270	null
hsl280	null
hsl290	null
hsl300	null
hsl310	null
hsl320	null
hsl330	null
hsl340	null
hsl350	null
hsl359	null
hsl360	null
	eject
	rem
	stx1	sf.tib,2	put tib addr in sfcm
	rem
	ldaq	hcnfig-*	get configuration pcw for channel
	staq	sf.cfg,2	store it in sfcm for later modifications
	rem
	ldx2	hsavx2-*	reload ptr to hsla table
	ldx3	hsavx3-*	and ptr to hwcm
	rem
	rem
hsl380	null		increment to next subchannel
	iacx2	2	next hsla table entry
	iacx3	16	hwcm is 16 words long
	aos	hsbchn-*	bump subchannel number
	ila	3	bump jump table ptr
	asa	hjtloc-*	by three
	rem
	ila	32	valid numbers are 0 - 31
	cmpa	hsbchn-*	see if still more subchannels
	tnz	hsl020-*	yes, go process them
	rem		no, now store the mask register
	rem
	cioc	hsmska-*	store the mask register
	cioc	hsmskb-*	in case this is a dn6670, do it for each mlc
	cioc	hsmskc-*
	cioc	hsmskd-*
	rem
	tra	1,*	return to main routine
	ind	itl020
	rem
	rem
hjtloc	bss	1	hold current jump table addr
hsbchn	bss	1	this loc always has cur subchannel number
hslano	bss	1	current hsla number
	eject
	rem
hsl390	null		come here for bad configuration
	tsy	a.f002-*,*	(hgetch) get iom channel number in ascii
	stq	hmsg02+2-*	and store in error message
	lda	hsbchn-*	pick up subchannel number
	ada	a.f005-*	(hsasbc) add offset of subchannel table
	sta	htemp-*	store it for a moment
	lda	htemp-*,*	and pick up ascii equiv of subch nums
	sta	hmsg02+6-*	and store into error message
	tsy	a.f004-*,*	(iwcon) use disaster mode console routine
	ind	hicw02
	nop		ignore inability to write on console
	rem
	ila	-1	set sfcm addr in hwcm to -1
	sta	h.sfcm,3
	lda	hsbchn-*	load subchannel number
	als	6	move into subchannel field
	ora	hmskch-*	or in pcw 0, command 4
	ldq	hmskch+1-*	and pick up no broadside commands
	staq	hpcw-*	and store for execution
	rem
	cioc	hpcw-*	mask this subchannel
	rem
	rem		end up here for badly-configured or
	rem		non-configured line
hsl400	null		we will set up active status icw with
	rem		exhaust bit on
	cx3a		get hwcm address
	iaa	h.baw	we will point status icw at base address word
	rem		pointer to avoid getting status stored randomly
	ldq	hbdicw+1-*	get rest of icw with exhaust bit
	staq	h.aicw,3
	tra	hsl380-*	on to next subchannel
	rem
	rem
	even
	rem
hbdicw	icw	**,w.2,1,1	status icw for inactive subchannel
	rem
hsticw	icw	hstat,w.2,1	icw to store status for configuration
hicw01	icw	hmsg01-1,b.0,32	icw to type on fnp console
hicw02	icw	hmsg02-1,b.0,44	icw to type on fnp console
	rem		  status
	rem
	rem		pcw to unmask a subchannel
hunmsk	vfd	2/0,4/rstmsk,2/0,4/**,6/0,18/0
	rem
	rem		pcw to mask a subchannel
hmskch	vfd	2/0,4/setmsk,2/0,4/**,6/0,18/0
	rem		pcw to request configuration status
hreqcn	vfd	2/1,4/reqcst,2/0,4/**,6/0,18/rts
	rem		pcw to store the mask register
hsmska	vfd	2/0,4/stomrg,12/0,18/0
hsmskb	vfd	2/0,4/stomrg,6/8,6/0,18/0
hsmskc	vfd	2/0,4/stomrg,6/16,6/0,18/0
hsmskd	vfd	2/0,4/stomrg,6/24,6/0,18/0
hpcw	bss	2	temporary for pcws to execute
hcnfig	bss	2	temporary for configuration pcw
hastat	bss	2	temporary storage for status icw
	rem
hstat	bss	4	destination of status words for configuration
	rem
hsaicw	amicwo	w.2,sfhsiz,0	dn6670 icw prototype (odd word) for hardware
	rem		  status
htibad	bss	1	tib address
hbaud	bss	1	baud rate code(temporary)
hivloc	bss	1	holds location of iv for this subchannel
htemp	bss	1	an alround temporary
hsavx2	bss	1	place to save hsla table addr
hsavx3	bss	1	place to save hwcm address
hsltra	bss	1	jump indirect through this word
htflgt	bss	1	temp for hsla table flags
hlahcr	vfd	3/0,15/**	hsla's hcr base address
hmask1	oct	600076	mask to leave only (mbo's, async/sync
	rem		 parity stuff, icw alternation, and ccc enabled
hmask2	oct	004377	mask to leave only (2 stop bits and speed)
	rem
a.f001	ind	setclk	routine to delay for n ms
a.f002	ind	getchn	routine to convert iom channel to ascii
a.f003	ind	hgsfcm
a.f004	ind	iwcon	routine to write on console if there
a.f005	ind	hsasbc	table of ascii equivs of subch nums
a.f006	ind	.crmem	last legal address configured
a.f007	ind	getmem	memory allocating subroutine
a.f008	ind	maktib	subroutine for making a tib
a.f009	ind	.crtrb	base address of trace buffer
a.f010	ind	tibadr	real tib address
a.f011	ind	hsl080
a.f012	ind	hsl190
a.f013	ind	setptw	set up page table entry
a.f014	ind	.crmet	flag indicating metering
a.f015	ind	metadr	real metering area address
a.f016	ind	hsfssl	number of entries in software status queue
	rem
	rem
l.f001	oct	1000	hsla indicator
l.f002	oct	200000	this bit is on if synchronous
l.f003	oct	170000	mask to leave only char length field
l.f004	oct	040000	char length field of 6 bits
l.f005	oct	020000	char length field of 7 bits
l.f006	oct	010000	char length field of 8 bits
l.f007	oct	000400	bit for marking asynch baud code
l.f008	vfd	18/htfasy	"async" bit in hsla table entry
l.f009	zero	0,w.2	36-bit addressing
l.f010	oct	010000	exhaust bit in icw
l.f011	vfd	18/htfpl	private line flag
l.f012	vfd	18/tfdlup	dialup flag in tib
l.f013	vfd	18/sffbsc	bisync bit in sfcm
l.f014	vfd	18/htfop1	hsla table option flag 1
l.f015	vfd	18/sffhdl	HDLC channel
l.f016	vfd	18/tfauto	autobaud flag in tib
l.f017	vfd	18/sffsyn	synchronous flag in sfcm
l.f018	oct	024000	inhibit interrupts and overflow
	rem
	detail	off	dont print all the words for messages
	rem
	vfd	9/cr,9/lf
hmsg01	aci	14,*ch-xx, hsla does not exist
	vfd	9/cr,9/lf
hmsg02	aci	20,*ch-xx, sch-xx, bad configuration status
	vfd	9/cr,9/lf
	rem
hsasbc	null		table of ascii subchannel nums
	aci	1,00
	aci	1,01
	aci	1,02
	aci	1,03
	aci	1,04
	aci	1,05
	aci	1,06
	aci	1,07
	aci	1,08
	aci	1,09
	aci	1,10
	aci	1,11
	aci	1,12
	aci	1,13
	aci	1,14
	aci	1,15
	aci	1,16
	aci	1,17
	aci	1,18
	aci	1,19
	aci	1,20
	aci	1,21
	aci	1,22
	aci	1,23
	aci	1,24
	aci	1,25
	aci	1,26
	aci	1,27
	aci	1,28
	aci	1,29
	aci	1,30
	aci	1,31
	aci	1,32
	aci	1,33
	aci	1,34
	aci	1,35
	aci	1,36
	aci	1,37
	aci	1,38
	aci	1,39
	aci	1,40
	aci	1,41
	aci	1,42
	aci	1,43
	aci	1,44
	aci	1,45
	aci	1,46
	aci	1,47
	aci	1,48
	aci	1,49
	aci	1,50
	aci	1,51
	aci	1,52
	rem
	detail	on
	ttls	hsla subroutine to get a sfcm or sfcm/tib pair
	rem
hgsfcm	subr	hgs,(x1,x2,i)
	rem
	rem		figure out sfcm size
	lda	ht.flg,2
	arl	4	shift line type down
	iana	31	isolate it
	icmpa	ttx25	x.25?
	tze	hgs001-*	yes
	icmpa	tthdlc	hdlc?
	tze	hgs001-*	yes
	icmpa	ttbsc	bisync?
	tze	hgs001-*	yes
	ilq	sfssq	none of above, use short status queue
	tra	hgs002-*
hgs001	ilq	sflsq	use long size
hgs002	stq	hsfssl-*	save queue length
	qls	2	multiply by 4 (to get in words)
	iaq	sf.hln	add basic sfcm length
	stq	hsflen-*	this is total size to allocate
	rem
	rem
	rem
	rem	*****************************************************************
	rem	*    the following code allocates space for a sfcm and tib
	rem	*  starting at 32768.  the sfcm and tib have to be allocated in
	rem	*  the same page for a given channel.
	rem	*
	rem	*    since the tib has to be allocated now, its real address is
	rem	*  stored in 'tibadr'.  the 'maktib' subroutine is coded to
	rem	*  account for this.
	rem	*****************************************************************
	rem
	stz	hmetln-*	initially
	szn	a.f014-*,*	(.crmet) are we metering at all?
	tze	hgs008-*	no, skip this calculation
	lda	ht.flg,2	see if it's synchronous channel
	cana	l.f008-*	=htfasy
	tnz	hgs003-*	no
	ilq	m.synl	yes, use synchronous length
	tra	2
hgs003	ilq	m.asyl	else asynchronous
	stq	hmetln-*	save this for later
hgs008	null
	lda	hcurpg-*	get page base address
	ada	hsflen-*	recalculate the end of the pair
	sta	a.f010-*,*	(tibadr)
	ada	htibln-*
	sta	a.f015-*,*	(metadr)
	ada	hmetln-*
	caq		get it into the right register
	rem
hgs010	null
	szn	a.f009-*,*	(.crtrb) is trace configured?
	tnz	hgs020-*	yes
	cmpq	a.f006-*,*	(.crmem) no. will sfcm/tib pair fit in
	tra	hgs030-*	  rest of memory?
	rem
hgs020	null
	cmpq	a.f009-*,*	(.crtrb) will sfcm/tib pair fit below
	rem		  trace buffer?
hgs030	null
	tnc	hgs040-*	yes. we are cool
	tze	hgs040-*	whew. this better be the last one
	die	1	no. out of memory
	rem
hgs040	null
	stq	hnxstp-*
	lda	hcurpg-*	get sfcm address for return
	caq
	ldi	l.f018-*	(=o024000) inhibit overflow
	adq	l.i006-*	=256
	stq	hcurpg-*	save address of next page for next pair
	rem
hgsret	null
	return	hgsfcm
	rem
	rem
hcurpg	dec	32768	base of current page
hnxstp	dec	32768	pointer to next sfcm/tib pair
hsflen	oct	0	next even number of words in sfcm
hsfssl	oct	0	size of software status queue
htibln	oct	0	next even number of words in tib
hmetln	oct	0
	ttls	maktib -- subroutine to allocate a tib
	rem
	rem	this subroutine allocates space for a tib (terminal
	rem	information block) and fills in stuff common to hsla
	rem	and lsla
	rem
	rem	input:
	rem		a reg contains baud rate code
	rem		(with bit 9 marking asynch line)
	rem		q reg contains line number
	rem
	rem	output:
	rem		x1: contains virtual tib address
	rem		 a: contains real tib address
	rem
maktib	subr	mak,(x2,x3)
	rem
	staq	mtemp-*	save baud rate code and line number
	lda	tibadr-*	get real tib address
*
*  save tib address in table for later use
	rem
	ldx2	a.i003-*,*	(.crtte) get address of next available slot
	sta	0,2
	iacx2	2	bump pointer
	stx2	a.i003-*,*	(.crtte)
	rem
	ldx3	a.i001-*	(ctrl) get control_tables address
	ldx3	3,3	x3 points to device type table
	rem
mak020	null		search table for type corresponding to baud rate
	lda	0,3	get table entry
	icmpa	-1	hit end of table?
	tnz	2
	die	6	if so, very bad news
	lrl	9	get baud rate code in a, device type in q
	cmpa	mtemp-*	matches argument?
	tze	mak030-*
	iacx3	1	no, keep looking
	tra	mak020-*
	rem
	rem		now put associated device type into tib
mak030	null
	lda	tibadr-*	virtualize tib address
	tsy	a.i004-*,*	(setptw)
	cax1		get it into x1
	qrl	9	align device type in q
	stq	t.type,1
	ldq	mtemp+1-*	get line number again
	stq	t.line,1	put it in tib
	lda	a.i001-*,*	(ctrl) pointer to start of control tables
	sta	t.cur,1	this is where interpreter will start
	rem
	ldx3	a.i001-*	(ctrl)
	ldx3	1,3	addr(array of device table addresses)
	adcx3	t.type,1	index by device type
	ldx3	-1,3	convert index to offset
	rem		x3 now points to relevant device table entry
	lda	dt.flg,3	find out how tfctrl should be set
	cana	l.i001-*	(dtfctl)
	tze	mak040-*	it's off to start with
	lda	l.i002-*	(tfctrl)
	orsa	t.flg,1	if dtfctl was on, turn tfctrl on
mak040	null
	lda	dt.flg,3	now check setting of dtfsft
	cana	l.i004-*	(dtfsft)
	tze	mak050-*
	lda	l.i005-*	(tfsftr) get tib bit to set
	orsa	t.flg2,1
mak050	null
	iacx3	dt.brk	get address of default break list
	stx3	t.brkp,1	into tib
	rem
	lda	metadr-*	get address of metering area
	tsy	a.i004-*,*	(setptw) virtualize it
	sta	t.metr,1
	rem
	rem
	rem		for asynchronous line, take 2 32-word blocks
	rem		for permanent input buffers (if available).
	rem		remainder of page is added to buffer pool
	rem
	lda	mtemp-*	synchronous line?
	cana	l.i006-*	(=o400)
	tze	mak070-*	yes, don't bother with buffers
	lda	hcurpg-*	get address of next page base
	sba	hnxstp-*	find out how much space is left in page
	icmpa	2*bufsiz	enough for two buffers?
	tnc	mak070-*	no, skip it
	lda	hnxstp-*	get starting address
	sta	t.abf0,1	this is first one
	caq
	tsy	a.i004-*,*	(setptw)
	cax2		make it addressable
	ila	bufsiz	get size in words
	als	9	store in first character
	sta	0,2
	iaq	bufsiz	point to next one
	stq	t.abf1,1	address into tib
	iacx2	bufsiz	virtual address also
	sta	0,2
	iaq	bufsiz	this is address of remaining space in the page
	szn	a.i007-*,*	is there any trace buffer?
	tnz	mak058-*	yes, go ahead
	cmpq	a.i008-*,*	(.crmem) else see if it fits in memory
	tra	2
mak058	cmpq	a.i007-*,*	(.crtrb) does it overlap trace buffer?
	tnc	mak060-*	no
	tze	mak060-*	also no, but it's close
	die	1	yes, image won't work
mak060	lda	l.i007-*	tfabf0+tfabf1
	orsa	t.flg3,1	mark them available
	cmpq	hcurpg-*	any space left in page?
	tze	makbak-*	no, that's all
	stq	hnxstp-*	yes, save address
mak070	lda	hnxstp-*	get last available address
	iaa	bufsiz-1	round it up to even bufsiz boundary
	iana	-bufsiz
	sta	hnxstp-*	save it for size determination
	ldq	hcurpg-*	find end of page
	sbq	hnxstp-*	how much space is left?
	tze	makbak-*	none
	tnc	makbak-*	this is unlikely, but check anyway
	tsy	a.i006-*,*	(frebfh) free what remains in the page
makbak	null		that's all
	lda	tibadr-*	this is the real value where virtual value is
	rem		  is in the x1 register
	return	maktib
	rem
	rem
a.i001	ind	ctrl	control tables
a.i002	ind	getmem	memory allocating subroutine
a.i003	ind	.crtte
a.i004	ind	setptw	set up page table word
a.i005	ind	.crmet
a.i006	ind	frebfh
a.i007	ind	.crtrb
a.i008	ind	.crmem
	rem
l.i001	vfd	18/dtfctl
l.i002	vfd	18/tfctrl
l.i003	oct	1000
l.i004	vfd	18/dtfsft
l.i005	vfd	18/tfsftr
l.i006	oct	400
l.i007	vfd	18/tfabf0+tfabf1
	rem
	even
mtemp	bss	2	place to put arguments
tibadr	bss	1	real address of allocated tib
metadr	bss	1	real address of allocated metering area
	ttls	stopxx -- error notification routines
	rem
	rem
stop	ind	**
	orsa	badsts-*	put error code in status
	ldq	a.k001-*,*	(iomch) get iom channel number
	stq	badsts+1-*	put it in bootload status
	iaa	-2	no. get 2*(message index)
	als	1
	ada	a.j001-*	(icws)
	sta	stp020-*	this is the icw to be passed to wcon
	szn	inhchn-*	does message need channel number?
	tnz	stp010-*	no
	cax1		copy icw address
	lda	0,1	get message address
	ana	l.j001-*	(=o077777) get rid of char addressing
	cax1
	tsy	getchn-*	get channel number for error message
	stq	3,1	store channel number in message
	rem
stp010	null
	tsy	a.k002-*,*	(iwcon) write it on console
stp020	zero	**	icw address goes here
	nop		don't fret if no console
	rem
	ldaq	badsts-*	notify cs of error
	tsy	a.j003-*,*	(btsts)
	dis		just stop
	tra	-1
	rem
	even
badsts	oct	440000,000000
	rem
	rem
stop02	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	2
	tsy	stop-*
	rem
stop03	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	3
	tsy	stop-*
	rem
stop04	null
	ila	4
	tsy	stop-*
	rem
stop05	null
	ila	5
	tsy	stop-*
	rem
stop06	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	6
	tsy	stop-*
	rem
warn07	ind	**
	tsy	getchn-*
	stq	msg07+2-*
	tsy	a.k002-*,*	(iwcon)
	zero	icw07
	nop		dont let lack of console screw us
	tra	warn07-*,*	return to caller
	rem
stop08	null
	aos	inhchn-*
	ila	8
	tsy	stop-*
	rem
stop09	null
	ila	9
	tsy	stop-*
	rem
stop10	null
	ila	10
	tsy	stop-*
	rem
stop11	null
	ila	11
	tsy	stop-*
	rem
stop12	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	12
	tsy	stop-*
	rem
stop13	null
	ila	13
	tsy	stop-*
	rem
stop14	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	14
	tsy	stop-*
	rem
stop15	null
	aos	inhchn-*	inhibit storing of channel no. in message
	ila	15
	tsy	stop-*
	rem
inhchn	oct	0
	rem
a.j001	ind	icws
*a.j002		unused
a.j003	ind	btsts
	rem
l.j001	oct	077777	to eliminate character addressing
	eject
	rem	*********************************************************
	rem	* getchn -- get current iom channel number, convert to
	rem	*           ascii code, and place in q-register
	rem	*********************************************************
	rem
getchn	ind	**
	lda	a.k001-*,*	(iomch) get current iom channel number
	als	18-6	convert to ascii characters and leave
	ilq	6	in q-register
	llr	3
	qls	6
	iaq	6
	llr	3
	tra	getchn-*,*
	rem
a.k001	ind	iomch
a.k002	ind	iwcon
	eject
	even
icws	null
	rem
icw02	icw	msg02-1,b.0,28
icw03	icw	msg03-1,b.0,32
icw04	icw	msg04-1,b.0,30
icw05	icw	msg05-1,b.0,30
icw06	icw	msg06-1,b.0,30
icw07	icw	msg07-1,b.0,32
icw08	icw	msg08-1,b.0,40
icw09	icw	msg09-1,b.0,40
icw10	icw	msg10-1,b.0,42
icw11	icw	msg11-1,b.0,40
icw12	icw	msg12-1,b.0,38
icw13	icw	msg13-1,b.0,44
icw14	icw	msg14-1,b.0,36
icw15	icw	msg15-1,b.0,36
	rem
	detail	off
	rem
	vfd	9/cr,9/lf
msg02	aci	13,timer channel not enabled
	vfd	9/cr,9/lf
msg03	aci	15,more than one dia configured
	vfd	9/cr,9/lf
msg04	aci	13,*ch-xx, dia does not exist
	vfd	9/cr,9/lf
msg05	aci	13,*ch-xx, dia did not respond in time
	vfd	9/cr,9/lf
msg06	aci	15,extended memory not configured
	vfd	9/cr,9/lf
msg07	aci	14,*ch-xx, lsla does not exist
	vfd	9/cr,9/lf
msg08	aci	18,core image specifies too much memory
	vfd	9/cr,9/lf
msg09	aci	18,*ch-xx, illegal lsla speed specified
	vfd	9/cr,9/lf
msg10	aci	19,*ch-xx, lsla failed for the tenth time
	vfd	9/cr,9/lf
msg11	aci	18,*ch-xx, lsla actual <> desired speed
	vfd	9/cr,9/lf
msg12	aci	17,timer switch set to 64 khz, s/b 1
	vfd	9/cr,9/lf
msg13	aci	20,*ch-xx, actual config doesn't match cdt
	vfd	9/cr,9/lf
msg14	aci	16,pager is disabled or inoperative
	vfd	9/cr,9/lf
msg15	aci	16,unable to allocate trace buffer
	vfd	9/cr,9/lf
	rem
	detail	on
	ttls	initialization main program -- wrap up
***********************************************************************
*
*  all devices have now been initialized
* all that remains is to open up the appropriate floodgates in an
* orderly and meaningful sequence.
*
***********************************************************************
	rem
clocks	null
	rem
	rem
	rem	*********************************************************
	rem	* if t&d executive channel is configured, allocate a tib
	rem	* for it. if in >32k, we will keep the sfcm area and fake
	rem	* an hsla table entry therein to store the real tib
	rem	* address, so the code in dia_man that finds the tib
	rem	* table entry this way will work.
	rem	*********************************************************
	rem
	szn	a.m037-*,*	.crtdt
	tze	itl025-*	line not configured
	tsy	a.m039-*,*	(hgsfcm) set up tib address
	sta	csfcm-*	save sfcm address
	lda	l.m004-*	(=o412) give it a baud rate of 9600
	ldq	l.m003-*	=o1777, line number for colts
	tsy	a.m038-*,*	maktib
	sta	a.m037-*,*	save tib address in .crtdt
	ila	ttcolt	set line type
	sta	t.type,1
	lda	csfcm-*	get sfcm address back
	tsy	a.m034-*,*	(setptw) get virtual addr
	sta	t.sfcm,1	keep it for future reference
	cax2		we will pretend 2nd and 3rd words are
	iaa	1	hsla table entry
	sta	sf.hsl,2
	cax3		in order to save real tib address there
	lda	a.m037-*,*	(.crtdt)
	sta	ht.tib,3
	stx1	sf.tib,2	just for cleanliness
	rem
	rem	*********************************************************
	rem	* send bootload status to cs. first we'll spin our wheels
	rem	* for a second or so to give it time to process the
	rem	* previous status
	rem	*********************************************************
	rem
itl025	ila	1
	ilq	-1	aq contains 1777777, a good-sized loop index
itl026	sbaq	dbl1-*	a doubleword 1
	tnz	itl026-*	keep going until it's zero
	ldaq	gudsts-*	get some good status
	tsy	btsts-*	send the bootload status
	rem
	inh		inhibit interrupts <-><-><-><-><-><-><-><-><-><
	rem
	rem	*********************************************************
	rem	* restore level 0, 1, and 2 interrupt vectors to their
	rem	* operational settings
	rem	*********************************************************
	rem
	ldx3	a.m030-*	(intv+256)
	ldx2	a.m031-*	(savein+48-3)
	rem
itl030	null
	lda	0,2
	ldq	1,2
	staq	-16,3
	lda	2,2
	sta	-14,3
	iacx2	-3
	iacx3	-16
	tnz	itl030-*
	rem
	lda	a.m027-*	(consjt)
	cmpa	l.m001-*	(=o776) is console_man in image?
	tze	itl040-*	no. skip console stuff
	sta	a.m028-*,*	(tytm) yes. set up interrupt vectors for console
	iaa	3	now point to "special" jump table
	sta	a.m029-*,*	(tyrq)
	rem
itl040	null
	eject
	rem	************************************************
	rem	* now free all of init for use as buffer
	rem	* space. note we will run in here for
	rem	* awhile, so we must be careful about allocating
	rem	* buffers.
	rem	************************************************
	rem
	aos	a.m017-*,*	(bfcksw) suspend buffer size checking
	lda	a.m020-*,*	(.crtte)
	iaa	bufsiz-1	round up to bufsiz boundary
	iana	-bufsiz
	sta	cbufr-*	this will be beginning of buffer space
	rem
	ldq	a.m001-*,*	(.crbuf) old buffer area start
	sbq	cbufr-*	q contains total size
	cax3		point at which to be freed
	stx3	a.m001-*,*	(.crbuf) so frebuf doesn't get upset
	tsy	a.m013-*,*	(frebuf)
	rem
	lda	cbufr-*	start of buffer space
	sba	a.m020-*,*	(.crtte) free space before first buffer
	icmpa	2	if at least 2 words, we will use it
	tmi	itl050-*
	ldx3	a.m020-*,*	(.crtte) addr of small space
	caq
	stx3	a.m001-*,*	(.crbuf)
	tsy	a.m016-*,*	(fremem)
	rem
itl050	null		now free the rest of extended memory
	rem		one page at a time
	sti	itlind-*	save indicators
	ldi	l.m002-*	(=024000o) inhibit interrupt & overflow
	lda	a.m041-*,*	(hcurpg)
itl052	ada	l.m006-*	(=256) get address of end of page
	szn	a.m042-*,*	(.crtrb) is there any trace buffer?
	tze	itl055-*	no, free whole page
	cmpa	a.m042-*,*	(.crtrb) overlaps trace buffer?
	tnc	itl055-*	no
	tze	itl055-*	not quite
	lda	a.m042-*,*	.crtrb
	sba	a.m041-*,*	hcurpg
	iana	-bufsiz	rounded to bufsize, this is actual amount left
	tze	itl058-*	which isn't any
	tnc	itl058-*
	caq		get size in q
	tra	itl056-*
itl055	ldq	l.m006-*	(=256) free whole page
itl056	lda	a.m041-*,*	(hcurpg)
	tsy	a.m043-*,*	frebfh
	ada	l.m006-*	(=256) next page address
	sta	a.m041-*,*	hcurpg
	cmpa	a.m044-*,*	.crmem
	tnc	itl052-*	if any more pages
	rem
itl058	tsy	a.m033-*,*	(fresml) clean up small space
	nop		dont care which return
	stz	a.m018-*,*	(.crnbs) number of buffers for small space
	stz	a.m017-*,*	(bfcksw) enable buffer checking
	rem
	lda	a.m035-*,*	.crnbf
	als	bufshf	get buffer pool size in words
	sta	a.m036-*,*	(.mpool) store where metering will find it
	ldi	itlind-*	restore previous indicators
	rem
	rem	********************************************************
	rem	* start the control tables for each tib we created
	rem	********************************************************
	rem
	ldx2	a.m019-*	(tibtab) get address of first entry in tib
	rem		  address table
	stx2	a.m012-*,*	(.crttb) save it in system comreg
	rem
itl060	null
	cmpx2	a.m020-*,*	(.crtte) any more?
	tze	itl070-*	no
	lda	0,2	yes. get real tib address
	tsy	a.m034-*,*	(setptw) virtualize it
	cax1		get virtual tib address into x1
	tsy	a.m014-*,*	(itest) call test-state entry of interpreter
	iacx2	2	get address of next entry
	tra	itl060-*	get next entry
	rem
itl070	null
	eject
	rem	*********************************************************
	rem	* setup the interval and elapsed timers
	rem	*********************************************************
	rem
	stz	a.m006-*,*	(itmb) interval timer value = 0 
	lda	a.m007-*	(timrjt) interval timer jump table
	sta	a.m008-*,*	(tmro) timer interrupt vector
	lda	a.m021-*,*	(etrint) get elapsed timer default value
	sta	a.m009-*,*	(etmb)
	lda	a.m010-*	(etrip) elapsed timer interrupt handler
	sta	a.m011-*,*	(etr) timer interrupt vector
	tsy	a.m015-*,*	(rstclk) turn clock off
	rem
	ldaq	sdqdat-*	schedule dummy rtn to kick off timer
	tsy	a.m026-*,*	(dspqur) since clock doesnt start til it is used
	rem
	rem	*********************************************************
	rem	* setup pointer to scheduler control blocks
	rem	*********************************************************
	rem
	lda	a.m022-*	(skdata) addr of scheduler block
	sta	a.m023-*,*	(.crskd) store in .crskd
	lda	a.m024-*	(icmdat) addr of ic monitoring data
	cmpa	l.m001-*	(=o776) is it configured?
	tze	2	no
	sta	a.m025-*,*	(etrmon) store addr in sked block
	rem
	rem	*********************************************************
	rem	* set a level 2 interrupt for the dia so it can run
	rem	*********************************************************
	rem
	lda	a.m005-*,*	(cdiaic) get mask word for interrupt cell
	sic	2
	rem
	rem	*********************************************************
	rem	* set the interrupt enable mask register according to the
	rem	* number of hsla's configured.
	rem	*********************************************************
	rem
	ldx1	a.m003-*,*	(.crnhs)
	adcx1	a.m032-*	(cenimk)
	lda	0,1
	sier
	rem
	stz	a.m004-*,*	(.crcon) make sure console io enabled
	eject
	rem	*********************************************************
	rem	* well, here goes everything
	rem	*********************************************************
	rem
	eni		enable interrupts <+><+><+><+><+><+><+><+><+><+
	rem
	tra	1,*	go to the main dispatcher "dis"
	ind	msdsp
	eject
	rem
a.m001	ind	.crbuf	addr of very 1st buffer
*a.m002		unused
a.m003	ind	.crnhs	number of hsla's configured
a.m004	ind	.crcon	console io flag
a.m005	ind	cdiaic	set interrupt cell word for dia
a.m006	ind	itmb	interval timer mailbox addr
a.m007	ind	timrjt	interval timer jump table addr
a.m008	ind	tmro	interval timer iv addr
a.m009	ind	etmb	elapsed timer mailbox addr
a.m010	ind	etrip	elapsed timer interrupt handler
a.m011	ind	etr	elapsed timer iv addr
a.m012	ind	.crttb
a.m013	ind	frebuf
a.m014	ind	itest	"test-state" entry of interpreter
a.m015	ind	rstclk	stop clock routine
a.m016	ind	fremem
a.m017	ind	bfcksw
a.m018	ind	.crnbs
a.m019	zero	tibtab	pointer to current entry of tib address table
a.m020	zero	.crtte	pointer to end of tib address table
a.m021	ind	etrint	address of default elapsed timer value
a.m022	ind	skdata	address of scheduler control block
a.m023	ind	.crskd
a.m024	ind	icmdat	address of data in ic-monitor routine
a.m025	ind	etrmon	pointer to icmdat in skdata
a.m026	ind	dspqur
a.m027	ind	consjt	console_man jump tables
a.m028	ind	tytm	console terminate iv
a.m029	ind	tyrq	console special iv
a.m030	zero	intv+256
a.m031	zero	savein+48-3
a.m032	zero	cenimk
a.m033	ind	fresml
a.m034	ind	setptw	set up variable cpu page table word
a.m035	ind	.crnbf	number of free "buffers"
a.m036	ind	.mpool	buffer pool size for metering
a.m037	ind	.crtdt	t&d channel indicator (later tib address)
a.m038	ind	maktib
a.m039	ind	hgsfcm
a.m040	ind	hsflen
a.m041	ind	hcurpg
a.m042	ind	.crtrb
a.m043	ind	frebfh
a.m044	ind	.crmem
	rem
l.m001	oct	776	address of missing module
l.m002	oct	024000	inhibit interrupts & overflow
l.m003	oct	1777	line number for colts pseudo-channel
l.m004	oct	412	baud rate code for async 9600 baud
l.m005	oct	100000	first address above 32k
l.m006	dec	256
	even
sdqdat	vfd	12/60,6/1
	ind	secdsp
	rem
	even
gudsts	oct	400000,000000	bootloaded successfully status
dbl1	dec	0,1	a doubleword 1 for subtracting from aq
cbufr	zero
	rem
csfcm	bss	1	"sfcm" for colts channel
itlind	bss	1	for safe-storing indicators
	rem
cenimk	oct	740000,776000,777700,777774
	even
clkonx	oct	0,0
	ttls	btsts - send bootload status to cs
************************************************************************
*    this routine will send status to the central system
************************************************************************
btsts	ind	**
	staq	.sstat-*	save status to be sent
	lda	intcel-*	get interrupt cell word
	ana	mbxmsk-*	mask mailbox address
	iaa	6	add in relative location of status word
	sta	stdcw1-*	store in data transfer dcw
	rem
	lda	intcel-*	get execute interrupt cell to set
	arl	6	position it
	ana	intmsk-*	mask away extraneous bits
	orsa	stdcw2+1-*	store in interrupt dcw
	rem
	ldx1	lstsls-*	get length of status dcw block
	ldx3	lstsl-*	get pointer to dcw block
	tsy	parity-*	go calculate parity
	rem
	ldaq	list-*	get list icw pointer (dia pcw)
	staq	ldimb-*,*	store in pcw mailbox
	rem
	ila	2	set word count for parity calculation
	cax1
	ldx3	ldimb-*	calculate dia parity for pcw mailbox
	tsy	parity-*
	rem
	ldaq	limodl-*	get the list icw model
	staq	stslst-*	fill in for dia
	rem
bts010	sel	**	select the intercomputer channel
	cioc	ldimb-*,*	initiate i/o in dia channel
	dis		wait for interrupt
	tra	btsts-*,*	return
	eject
	rem
	even
.sstat	dec	0,0	bootload status to go
mbxmsk	oct	007777	mailbox address mask
intmsk	oct	007700	interrupt cell mask
ldimb	ind	dimb	dia mailbox location
lstsl	ind	stslst	location of status list
	even
list	zero	stslst,w.2	pcw model - ptr to list icw
	oct	72	opcode - list operation
	rem
limodl	dcw	stdcw1,6	bootload status list icw model
stslst	oct	0,0	place for list icw
stdcw1	vfd	18/,12/,o6/75	data transfer fnp to cs dcw
	dcw	.sstat,1
stdcw2	vfd	18/,12/,o6/73	interrupt cs dcw
	zero	0,w.2
	oct
stdcw3	vfd	18/,12/,o6/70	disconnect dcw
	zero	0,w.2
	oct
lstsls	ind	*-stslst	length of status dcw block
	ttls	calculate parity routine
	rem
parity	ind	**
	ldq	0,3	get first word of dcw
	lda	1,3	get second word of dcw
	rem
	qlp	18	calculate parity for 1st word
	tnz	2	odd parity...
	ora	parwd1-*	even - set parity bit
	rem
	alp	18	calculate parity for 2nd word
	tnz	2	odd parity...
	ora	parwd2-*	even - set parity bit
	rem
	sta	1,3	restore 2nd word with parity bits
	rem
	iacx3	2	bump words pointer
	iacx1	-2	decrement word count
	tnz	parity+1-*	more to do
	rem
	tra	parity-*,*	return
	rem
parwd1	oct	040000	parity bit for 1st word of dia dcw
parwd2	oct	020000	parity bit for 2nd word of dia dcw
	rem		beginning of free space while init is running
intcel	dec	0	interrupt cell passed by gicb
	ttls	iwcon - common interface to wcon
	rem
iwcon	subr	iwc,(x1)
	szn	a.n001-*,*	(conman) is console_man in image?
	tze	iwc020-*	no. take error return
	lda	iwcon-*,*	yes. get icw address
	sta	iwc010-*	store it after tsy to wcon
	aos	iwcon-*	set up for error return
	tsy	a.n002-*,*	(wcon) write on console
iwc010	zero	**	icw address
	tra	iwcret-*	error return
	rem
iwc020	null
	aos	iwcon-*	bump return address
	rem
iwcret	null
	return	iwcon
	rem
	rem
a.n001	ind	conman
a.n002	ind	wcon
	ttls	initialization main program
	rem
	rem
	rem	*********************************************
	rem	* gicb enters inti by way of
	rem	*        tra =(istart-1),*
	rem	*
	rem	* and passes:
	rem	*     the highest address in mcs in x2
	rem	*     the interrupt cell for the cs in x3
	rem	*     the dia iom channel in the a
	rem	**********************************************
	rem
	stx3	a.t017-*,*	(intcel) set interrupt cell
istart	null
	inh		inhibit interrupts <-><-><-><-><-><-><-><-><-><
	rem
	sta	a.t003-*,*	(diachn) save dia i/o channel
	rem		and derive terminate interrupt vector address
	als	4	which is 16*(channel)+2
	iaa	2
	sta	a.t010-*,*	diatmv
	rem
	rem	**************************************************************
	rem	* clear all unused configured memory including extended memory
	rem	**************************************************************
	rem
	lda	a.t008-*,*	(.crmem) get memory size
	sta	a.t007-*,*	(mvplmm) set lower memory maximum address
	sta	istpcl-*	stops memory clear loop
	cmpa	l.t002-*	(=32768) is last address above 32k?
	tnc	a.t022-*,*	(stop06) no. we can't run this code
	lda	l.t002-*	(=32768) yes. calculate last address in lower 32k
	iaa	-1
	sta	istpcl-*	stops memory clear loop
	iaa	-256	account for paging window
	iaa	-256	and buffer window
	sta	a.t007-*,*	(mvplmm) set lower memory maximum address
*
*  check pager operation
*
	ldx1	l.t009-*	get address of loc. 0
	lda	0,1	save its contents
	sta	itloc0-*
	ila	-1	put something recognizable there
	sta	0,1
	ldx1	l.t004-*	(window) base of window
	stz	0,1	clear test cells
	stz	-256,1
	ldx3	a.t009-*,*	(.crpte)
	lda	l.t006-*	(=o100040) init page table to window page 77000
	sba	l.t003-*	(=o400)
	sba	l.t003-*	(=o400)
	sta	0,3
	lda	a.t006-*,*	(.crcpt) init cpu pager
	sta	a.t004-*,*	(cptp)
	ila	-1	lets see where this goes
	sta	0,1	store test value
	stz	0,3	disable pager
	lda	0,1	this is the real 77400, has it changed?
	tnz	itl120-*	yes. bad news
	lda	-256,1	this is where store should go
	icmpa	-1	is it correct?
	tnz	itl120-*	no. bad news
	rem
itl100	null		clear lower memory loop
	stz	0,2	clear one word
	iacx2	1	udate pointer
	cmpx2	istpcl-*	is clearing finished?
	tnz	itl100-*	no. continue clear
	stz	0,2	yes. clear the last location
	rem
	lda	a.t008-*,*	(.crmem) get memory size
	iaa	1	yes. calculate stop for memory clear loop
	sta	istpcl-*
	ldx1	l.t004-*	(window) get pointer to paged address space
	ldx2	a.t009-*,*	(.crpte) get address of variable page table entry
	lda	l.t006-*	(=o100040) set up page table entry for window
	sta	0,2
	ldx3	l.t003-*	(=o400) set up counter
	lda	iabsad-*	absolute address value
	ldi	l.t001-*	inhibit overflow
	rem
itl110	null		clear one page of extended memory loop
	stz	0,1	clear one word
	cana	l.t008-*	(=o077777) first word of a 32k block?
	tnz	itl115-*	no, proceed
	stx1	itx1-*	save contents of x1
	ldx1	l.t009-*	zero
	szn	0,1	did we clobber loc. 0?
	tze	a.t002-*,*	(stop08) yes, there isn't this much memory
	ldx1	itx1-*	restore x1
itl115	iaa	1	increment absolute address value
	cmpa	istpcl-*	has the whole upper memory been written?
	tze	itl140-*	yes. extended memory clearing is done
	iacx1	1	no. increment page pointer
	iacx3	-1	done with this page?
	tze	itl118-*	yes, set up for next
	stz	0,1	no. continue clearing
	tra	itl115-*
	rem
itl118	sta	iabsad-*	save absolute address value
	lda	0,2	current page table entry
	ada	l.t003-*	(=o400) point to next page in upper memroy
	sta	0,2	hope the pager sees this
	lda	iabsad-*	restore absolute address value to A register
	ldx1	l.t004-*	(window) re-init page pointer
	ldx3	l.t003-*	(=o400) re-init counter
	tra	itl110-*	do the next page
	rem
itl120	null
	aos	ipgerr-*	remember paging error
	tra	itl180-*	init iv's for console write
	rem
a.t001	ind	setptw+1
a.t002	ind	stop08
a.t003	ind	diachn
a.t004	ind	cptp
a.t006	ind	.crcpt
a.t007	ind	mvplmm	lower memory maximum address (in utilities)
a.t008	ind	.crmem	memory size
a.t009	ind	.crpte
a.t010	ind	diatmv
*a.t011		unused
*a.t012		unused
*a.t013		unused
a.t014	ind	stop14
a.t016	ind	.criom
a.t017	ind	intcel
a.t019	ind	figtre
a.t020	ind	hsflen
a.t021	ind	htibln
a.t022	ind	stop06
	rem
l.t001	oct	024000	inhibit overflow and interrupts
l.t002	dec	32768
l.t003	oct	400
l.t004	vfd	18/window
l.t005	tra	-1,*
l.t006	vfd	10/128,3/1,5/0
l.t007	nop
l.t008	oct	077777
l.t009	oct	0
l.t010	oct	020000	inhibit interrupts only
	rem
iabsad	oct	100000
ipgerr	oct	0
istpcl	oct	0
itcerr	oct	0
itx1	bss	1
itloc0	bss	1
itrcdm	oct	0	dummy area used in case trace module is not
	rem		 configured
	rem
pte.s	bool	100	page table entry security bit
window	bool	77400
	rem
	even
hfvi	ind	hfv	fault vector images
	ind	hfv+2
	ind	hfv+4
	ind	hfv+6
	ind	hfv+8
	ind	hfv+10
	ind	hfv+12
	ind	hfv+14
	eject
	rem
itl140	null
	ila	pte.s	turn on 'security' bit in ptw so
	orsa	0,2	 any reference to window will cause a store fault
	rem
	rem	*********************************************************
	rem	* set up some values for hgsfcm subroutine in init module
	rem	*********************************************************
	rem
	ila	t.leng	get length of tib
	iaa	1	make it an even number of words
	iana	-2
	sta	a.t021-*,*	(htibln)
	rem
itl170	null
	ldx1	a.u007-*	(fltv) move processor fault vector images to
	ldaq	hfvi-*	fault vector locations
	staq	0,1
	ldaq	hfvi+2-*
	staq	2,1
	ldaq	hfvi+4-*
	staq	4,1
	ldaq	hfvi+6-*
	staq	6,1
	rem
	rem	*********************************************************
	rem	* get buffer routine metering area address
	rem	*********************************************************
	rem
	lda	a.u025-*	addr (getbfm)
	sta	a.u026-*,*	.crbtm
	rem
	rem	*********************************************************
	rem	* if breakpoint_man in coreimage, setup .crbrk
	rem	*********************************************************
	rem
	lda	a.u015-*	(brktab) address of break control table
	cmpa	l.u004-*	(=o776) valid (not equal to 776)
	tnz	2	yes, ok
	ila	0	use 0, no break table
	sta	a.u016-*,*	(.crbrk) store in comm region
	eject
	rem	*********************************************************
	rem	* set up fig tree table pointers
	rem	*********************************************************
	rem
	ldx1	a.t019-*	(figtre)
	lda	a.t016-*,*	(.criom) get address of fig tree table
	asa	0,1
	asa	1,1
	rem
itl180	null
	rem
	rem	*********************************************************
	rem	* if console_man is in coreimage, turn on 'conman' switch
	rem	*********************************************************
	rem
	lda	a.u011-*	(wcon) get address of entry point in console_man
	cmpa	l.u004-*	(=o776) is console_man in image?
	tze	itl190-*	no
	ila	-1	yes. turn on conman switch
	sta	a.u014-*,*	(conman)
	rem
itl190	null
	rem
	rem	*********************************************************
	rem	* set up level 0, 1, and 2 iv's so that "iom channel
	rem	* faults" are trapped and all other's ignored.  save
	rem	* previous contents of these iv's for later restoration.
	rem	*********************************************************
	rem
	ldi	l.t010-*	(=o020000) resume permission of overflow faults
	ldx1	l.t009-*	zero
	lda	itloc0-*	restore original contents of location 0
	sta	0,1
	ldx1	l.t003-*	(=o400) fill iom channel fault iv's
	lda	a.u008-*	(iomflt) with pointer's to "iomflt"
	sta	-16,1
	iacx1	-16
	tnz	-2
	rem
	ldx3	l.t003-*	(=o400) replace all zero iv's with a pointer
	lda	a.u027-*	(ignore)    to an ignore interrupts routine
itl200	null
	ldq	-1,3
	tnz	2
	sta	-1,3
	iacx3	-1
	tnz	itl200-*
	rem
	ldx3	l.t003-*	(=o400) save present values of level 0, 1, 2
	ldx2	a.u024-*	(savein+48-3) interrupt vectors for restoration
itl210	null
	ldaq	-16,3	later
	sta	0,2
	stq	1,2
	lda	-14,3
	sta	2,2
	ldaq	ignrad-*	set iv's to "ignore"
	staq	-16,3
	sta	-14,3
	iacx2	-3
	iacx3	-16
	tnz	itl210-*
	rem
	lda	l.u005-*	(=o700000) enable level 0,1,2 interrupts
	sier		<-><+><-><+><-><+><-><+><-><+><-><+>
	rem
	ila	3*16+1	allow any interrupts waiting
	rem		to cycle thru
	eni		enable interrupts <+><+><+><+><+><+><+><+><+><+
	nop
	iaa	-1	loop for a while to give them a chance
	tnz	-2	 to do their thing
	rem
	rem		now run the idle loop for one metering interval
	rem		to establish a counter value for an idle interval
	rem
	lda	a.u017-*	addr (itl215)
	sta	a.u018-*,*	(etr) direct timer interrupt to here
	ila	0	get negative interval size to set timer
	sba	a.u019-*,*	idlint
	sta	a.u009-*,*	etmb
	tra	a.u020-*,*	(idloop) run the idle loop till timer goes off
	rem
itl215	ind	**	elapsed timer runout comes here
	ldaq	a.u021-*,*	idlcnt
	staq	a.u022-*,*	(idlmax) this is maximum value
	staq	a.u023-*,*	(idlmin) and also minimum so far
	lda	ignrad-*	now ignore timer interrupts again
	sta	a.u018-*,*	etr
	ila	0	and clear the counter
	ilq	0
	staq	a.u021-*,*	idlcnt
	rem
	ldx1	l.t003-*	(=o400) fill iom channel fault iv's
	lda	a.u008-*	(iomflt) with pointer's to "iomflt"
	sta	-16,1
	iacx1	-16
	tnz	-2
	rem
	lda	a.u010-*,*	(conchn) initialize console terminate iv
	als	4
	cax1
	lda	a.u012-*	(contip)
	cmpa	l.u004-*	(=o776) is console_man in image?
	tze	itl220-*	no. skip console stuff
	sta	2,1	yes. set up console terminate interrupt vector
	lda	a.u013-*,*	(.crcon) save console switch
	sta	conswt-*
	stz	a.u013-*,*	(.crcon) zero switch so cr/lf goes through
	tsy	a.u011-*,*	(wcon) send cr/lf to console to unmask channel
	zero	iwcrlf	(9/cr,9/lf)
	nop		don't loop if no console
	lda	conswt-*	restore .crcon
	sta	a.u013-*,*	(.crcon)
	rem
itl220	null
	eject
	rem	***********************************************************
	rem	* now that the console has been set up,
	rem	*  check for fatal errors.
	rem	***********************************************************
	rem
	szn	ipgerr-*	was there a paging error?
	tnz	a.t014-*,*	(stop14) yes. cannot continue
	rem
	rem
	rem	***********************************************************
	rem	* check if timer is enabled and running
	rem	***********************************************************
	rem
	lda	a.u009-*,*	(etmb) get current value of elapsed timer
	ldq	l.v002-*	(=1000) get two millisecond counter
	iaq	-1	wait two milliseconds
	tnz	-1
	cmpa	a.u009-*,*	(etmb) check and see if timer changed
	tnz	itl230-*	yes-ok
	tra	1,*	no. error...timer not enabled
	ind	stop02
	rem
	rem
	rem	***********************************************************
	rem	* check to make sure interval timer switch is set
	rem	* to click every msec and not every 64th of a msec
	rem	***********************************************************
	rem
itl230	null
	ila	2	set timer to go off in 2 msec
	ldq	itl250-*	..
	tsy	a.v018-*,*	(setclk)
	ldq	l.v001-*	(=250) get half millisecond counter
	iaq	-1	wait half millisecond
	tnz	-1	..
	stz	itl250-*	if we finished counting, timer is set to click
	rem		every msec. set flag and wait for timer to go off
	dis
itl240	ind	stop12
itl250	ind	*+1	addr of place to go on timer interrupt
	ind	**
	szn	itl250-*	did we finish counting above?
	tnz	itl240-*,*	no - timer sw is wrong - inform cs
	eject
	rem	***********************************************************
	rem	* determine which iom channels are physically present.
	rem	* save the results in word "exist" such that a one in
	rem	* bit position "x" indicates that channel "x" exists.
	rem	***********************************************************
	rem
itl260	null
	ilq	0	the q reg contains the status found so far
	ila	0	want x1 to hold current subch num -- but
	cax1		it needs to be loaded first
	rem
	ldx3	xstsav-*	x3 will point to table of 16 readbacks
	rem
itl270	null
	cx1a		get the iom chan num into a reg
	ora	l.v003-*	(sel 0) 'or' in the sel instruction
	sta	1	put it where we will execute it
	sel	**	(altrd) select the current iom chan
	stex	itemp-*	store this channel's static status
	lda	itemp-*	pick up the status status
	sta	0,3	save it in readback vector
	icmpa	0	by experiment, non-existant channels
	rem		* return 0, most others dont (dia is exception)
	tze	2	it doesn't exist, dont turn on this bit
	iaq	1	it does exist, turn on low order bit
	qls	1	move over to make room for next channel
	iacx1	1	add one to subchannel number
	iacx3	1	add one to readback vector loc
	cx1a		get the subchannel number again
	icmpa	16	was it the last one,
	tnz	itl270-*	no
	rem
	qls	1	move word over one more to left justify
	rem
	rem	dia doesn't perform properly for experiment, so...
	rem
	stq	mexist-*,*	save word where others can find it
	lda	a.u028-*,*	(diachn) get dia channel
	ora	l.u006-*	'arl 0'
	sta	itl275-*	patch shift instruction
	lda	l.u007-*	(=o400000) get bit to shift
itl275	arl	**
	orsa	mexist-*,*	update 'exists' word
	eject
	rem	*********************************************************
	rem	* send an initialize pcw to each hsla configured
	rem	*********************************************************
	rem
itl280	null
	szn	a.u002-*,*	(.crnhs) first, are there any hsla's ??
	tze	a.u004-*,*	(itl350) no, don't bother with this code
	tra	itl300-*	skip over channel incrementation
	rem
itl290	null		* come here to increment to next channel
	aos	a.u005-*,*	(iomch)
itl300	null
	lda	a.u005-*,*	(iomch) load iom channel
	als	1	multiply by two
	cax1		x1 <- 2 * (iom ch #)
	lda	a.u006-*,*	(figtre,*) pick up 1st word of config tree
	arl	18-fcdevc-1	right justify the device type
	iana	fbdevc	mask out the rest of the word
	icmpa	dhsla	is it any hsla ??
	tnz	itl310-*	no, jump out of this section
	rem		* yes, prepare to initialize it
	lda	a.u005-*,*	(iomch) pick up the iom channel #
	ora	l.u003-*	(sel 0) 'or' in a select instruction
	sta	+1	store in where we will execute it
	sel	**	(this instruction patched above)
	rem		* select this hsla for operation
	rem
	rem		* now, check to see if this channel exists
	iana	15	mask out all but iom channel # (=o17)
	ora	l.u002-*	(qls 0) 'or' in 'qls' instruction
	sta	+2	store where we will execute it
	ldq	a.u003-*,*	(exist) pick up word on which channels exist
	qls	**	(patched from above)
	rem		* move desired bit into sign bit
	tpl	itl320-*	doesn't exist, the hsla initialization
	rem		* will print out a message later
	rem
	rem		* initialize this hsla
	rem		* (we need to hit it 4 times in case it's a 6670
	rem		*   with 4 mlcs pretending to be 1 hsla)
	cioc	ipcwa-*	pcw1, cmd 10, subchannel 0
	cioc	ipcwb-*	 "      "          "     8
	cioc	ipcwc-*	 "      "          "     16
	cioc	ipcwd-*	 "      "          "     24
	tra	itl320-*
	rem
itl310	null
	icmpa	dclock	is this the clock (the clock must be
	rem		* the last iom channel
	tze	itl330-*	yes, go initialize the devices
	rem
itl320	null		* no, go look for other hsla's
	tra	itl290-*
	rem
itl330	null
	lda	l.u001-*	(=5000) set clock for 5 sec to allow hsla's
	ldq	a.u001-*	(itl340) to finish
	tsy	a.v018-*,*	(setclk) wait here for clock to time out
	dis
	tra	-1
	rem
	rem
	rem
	rem
a.u001	ind	itl340	jump over the following area of data
a.u002	ind	.crnhs	number of hsla's configured
a.u003	ind	exist
a.u004	ind	itl350
a.u005	ind	iomch
a.u006	ind	figtre,*
a.u007	zero	fltv	fault vector base address
a.u008	ind	iomflt	iom channel fault routine
a.u009	ind	etmb	elapsed timer mailbox
a.u010	ind	conchn
a.u011	ind	wcon
a.u012	ind	contip
a.u013	ind	.crcon
a.u014	ind	conman
a.u015	ind	brktab	address of table in breakpoint_man
a.u016	ind	.crbrk
a.u017	ind	itl215
a.u018	ind	etr	elapsed timer interrupt vector
a.u019	ind	idlint	idle metering interval (in scheduler)
a.u020	ind	idloop	start of idle loop (in scheduler)
a.u021	ind	idlcnt	counter incremented by idle loop (in scheduler)
a.u022	ind	idlmax	maximum value of idlcnt (in scheduler)
a.u023	ind	idlmin	minimum   "   "    "     "      "
a.u024	zero	savein+48-3
a.u025	ind	getbfm
a.u026	ind	.crbtm
a.u027	ind	ignore
a.u028	ind	diachn
	rem
l.u001	dec	5000
l.u002	qls	0
l.u003	sel	0
l.u004	oct	776	a missing address
l.u005	oct	700000
l.u006	arl	0
l.u007	oct	400000
	rem
	even
ipcwa	vfd	2/1,4/initop,12/0,18/0  initialize pcw
ipcwb	vfd	2/1,4/initop,6/8,6/0,18/0   same for second mlc
ipcwc	vfd	2/1,4/initop,6/16,6/0,18/0  third
ipcwd	vfd	2/1,4/initop,6/24,6/0,18/0  fourth
	rem
	rem
	rem
itl340	ind	**
itl350	null
	stz	a.u005-*,*	(iomch)
	eject
	rem	***********************************************************
	rem	* set up initial buffer space parameters.
	rem	* we will allocate buffers starting at istart of init
	rem	* but we will free the rest of init for use as buffer space
	rem	* later.  the code from istart to the end of init is no
	rem	* longer needed.
	rem	***********************************************************
	rem
	lda	a.v007-*	(istart-1) the begining of the end of init
	iaa	bufsiz-1	round to buffer boundary
	iana	-bufsiz
	cax3		address to free
	sta	a.v020-*,*	(.crbuf) starting addr of buffer area
	lda	a.v023-*	(endtrc) is trace module in image?
	cmpa	l.u004-*	(=o776)
	tnz	itl360-*	yes
	lda	a.v012-*	(itrcdm) no. fake out initialization of
	sta	a.v019-*	(nxtrce) trace module
	sta	a.v023-*	(endtrc)
	sta	a.v025-*	(.crtrb)
	sta	a.v026-*	(.crtrc)
	rem
itl360	null
	lda	a.v013-*,*	(mvplmm) set up trace variables
	sta	a.v023-*,*	(endtrc)
	iaa	1
	rem
itl370	null
	sba	a.v020-*,*	(.crbuf) base of current free buffer area
	tze	a.v027-*,*	(stop15) there's no room left
	tnc	a.v027-*,*	(stop15) bad news
	caq		>0. ok. almost ready for frebuf
*
* finish up trace buffer allocation
	rem
	lda	a.v022-*,*	(.crmem) yes. put trace buffer at high
	rem		 end of configured memory
	sta	a.v023-*,*	(endtrc)
	sba	a.v024-*,*	(.crtsz)
	cmpa	a.v023-*,*	(endtrc) is there really a trace buffer?
	tze	2	no, skip the addition
	iaa	1
	sta	a.v025-*,*	(.crtrb)
	sta	a.v026-*,*	(.crtrc)
	sta	a.v019-*,*	(nxtrce)
	cmpa	l.v006-*	(=32768) is base above 32k?
	tnc	a.v027-*,*	(stop15) no. cannot handle this
	rem
itl380	null
	tsy	a.v014-*,*	(frebuf) free initial buffer space
	lda	a.v008-*	(utsave)
	sta	a.v009-*,*	(.crreg) save place where regs are saved
	lda	a.v010-*	(tibtab) init end of tib tab ptr
	sta	a.v011-*,*	(.crtte) so maktib can fill it in
	stz	a.v006-*,*	(bfcksw) enable buffer size checking
	rem
	tra	1,*
	ind	itl010	all set to pick the figtre
	eject
	rem
diexst	oct	020000	bit to be turned on to say dia exists
mexist	ind	exist
	rem
xstsav	ind	*+1	ptr to table of stex reads from devices
	bss	16
	even
ignrad	ind	ignore	ignore interrupts routine
	ind	ignore
	rem
iwcrlf	icw	l.v004,b.0,2
	rem
a.v006	ind	bfcksw
a.v007	ind	istart-1
a.v008	ind	utsave
a.v009	ind	.crreg
a.v010	ind	tibtab
a.v011	ind	.crtte
a.v012	ind	itrcdm
a.v013	ind	mvplmm	lower memory maximum address (in utilities)
a.v014	ind	frebuf
*a.v015		unused
*a.v016		unused
*a.v017		unused
a.v018	ind	setclk
a.v019	ind	nxtrce	(in trace module) next entry in trace buffer
a.v020	ind	.crbuf
a.v021	ind	.crpte	variable cpu page table entry
a.v022	ind	.crmem	last legal memory address
a.v023	ind	endtrc	(in trace module) last word in trace buffer
a.v024	ind	.crtsz
a.v025	ind	.crtrb
a.v026	ind	.crtrc
a.v027	ind	stop15
	rem
l.v001	dec	250	half of a millisecond in inst xec time
l.v002	dec	1000	two milliseconds in inst xec time
l.v003	sel	0
l.v004	vfd	9/cr,9/lf
*l.v005		unused
l.v006	dec	32768
	rem
itemp	bss	1
conswt	bss	1	temporary for .crcon
	end
 



		    interpreter.map355              11/18/82  1425.7rew 11/18/82  1422.0      611910


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

	ttl	intp -- control table interpreter for mcs/fnp
	lbl	,interpreter
	rem
********************************************************************************
*
* modified 79 jul 29 by art beattie to use real tib address in trace calls
*   and call 'setptw' in 'itmout' routine.
* modified 81 jan 16 by robert coren to add metering op blocks
*
********************************************************************************
	rem
	rem
	pcc	on
	pmc	off
	editp	on
	symdef	intp
	symdef	itmout,itest,iwrite,istat,istbrk
	symdef	globsw
	symdef	cvaddr
	symdef	adbyte
	symdef	getcmt
	symdef	intend	end of interpreter
	symdef	-mcall
	symdef	-mcal2
	pmc	save,on
	comreg
	tib
	meters
	sfcm	hsla
	devtab
	buffer
	ttls	symbol definitions
	symref	ctrl
	symref	secdsp,setime,frelbf
	symref	denq,meterc
	symref	hdcw,ldcw
	symref	hgeti
	symref	hcfg
	symref	trace
	symref	getbuf,frebuf
	symref	getbfh,frebfh
	symref	getmem,fremem
	symref	brkhit
	symref	lctlck
	symref	setcct
	symref	puteco
	symref	setptw	set up variable cpu page table word
	symref	setbpt	set up buffer page table word
	symref	cvabs	convert virtual address to absolute
	symref	gettib
	symref	mincs,mincd,mupdat,mmsg
	rem
statop	bool	777004	status op code
waitop	bool	777003	wait op code
accin	equ	74	accept input mailbox op code
sndout	bool	105	send output mailbox op code
sparms	bool	104	send params opcode
space	bool	040	ascii space char
cr	bool	015	ascii carriage return
upshft	bool	034	ebcdic up-shift
dnshft	bool	037	ebcdic down-shift
ibmeot	bool	074	ebcdic eot
ntfwrt	bool	/tfwrit	for turning tfwrit off
ntfrpn	bool	/tfrpon	for turning tfrpon off
hslafl	bool	001000
	rem
	rem
	rem	memory trace types
	rem
mt.tst	equ	1
mt.wrt	equ	2
mt.sta	equ	3
mt.tim	equ	4
mt.blk	equ	5
	rem
	rem	tracing switches
	rem
tr.ent	bool	040
tr.blk	bool	100
	rem
ct.dev	equ	1	offset in control tables of pointer
	rem		to device table entry pointers
intp	null
	start	intp,3
	pmc	restore
	rem
globsw	oct	0	"global swtches" word
	ttls	itest entry for test-state
	rem
*	this entry called by dia_man for test-state
*
*	input:
*	     x1 - virtual tib address
	rem
itest	subr	ite,(x1,x2,x3,a,q)
	rem
	lda	t.line,1	get line number
	tsy	a.c002-*,*	(gettib) get real tib address in a
	cax2		put in x2 for trace
	rem
	trace	mt.tst,tr.ent,(x2,t.cur(1))
*
	tsy	iinchk-*,*	make sure entry is valid
	tra	ite001-*	at breakpoint, ignore call
	ldx2	3,2	get branch point for test-state
	tze	ite001-*	never mind if there isn't one
	tsy	iintrp-*,*	call interp to do work
ite001	return	itest
	ttls	iwrite entry for output
	rem
*	entry for write, called by dia_man when output is to be sent
*
*	input:
*	     x1 - virtual tib address
	rem
iwrite	subr	iwr,(x1,x2,x3,a,q)
	rem
	lda	t.line,1	get line number
	tsy	a.c002-*,*	(gettib) get real tib address in a
	cax2		put in x2 for trace
	rem
	trace	mt.wrt,tr.ent,(x2,t.cur(1))
*
	tsy	iinchk-*,*
	tra	iwr001-*	at breakpoint, ignore call
	ldx2	2,2	get branch point for write
	tze	2	if any
	tsy	iintrp-*,*
iwr001	return	iwrite
*
	ttls	istat entry to process status
*
*	entry called by hsla_man or lsla_man with standard
*	status word in a register and virtual tib address in x1.
*	checks op blocks following current wait to see if any
*	status tests succeed, and if so, calls interp to proceed.
*	if a non-status block is encountered before any of the status
*	matches, then return, doing nothing.
*
istat	subr	ist,(x1,x2,x3,a,q)
	sta	istsav-*	hang on to status word
	rem
	lda	t.line,1	get line number
	tsy	a.c002-*,*	(gettib) get real tib address in a
	cax2		put in x2 for trace
	rem
	trace	mt.sta,tr.ent,(x2,t.cur(1),istsav)
	tsy	iinchk-*,*	make sure its ok
	tra	istbak-*	at breakpoint, ignore call
ist010	null
	iacx2	4	get next op block
	lda	0,2	get type code
	cmpa	l.a001-*	check against status op code
	tze	ist020-*	okay, go ahead
	rem
	tra	istbak-*	no status blocks to check
*
ist020	null
	lda	istsav-*	get status back in a
	cana	3,2	check "off" bits
	tnz	ist010-*	if not all off, get next status
	ana	2,2	ok, get "on" bits
	cmpa	2,2	are they all on?
	tnz	ist010-*	that didn't work either
*
*		                fell through, get branch point and call        
	trace	mt.blk,tr.blk,(x2,l.a002)
	ldx2	1,2	interp
	tsy	iintrp-*,*
istbak	null
	return	istat
*
l.a001	vfd	o18/statop
l.a002	oct	4	constant for status op block type
istsav	bss	1	saved status
*
	ttls	itmout entry for processing timeouts
*
*	called by secondary dispatcher
*
*	input:
*	     x1 - real tib address
	rem
itmout	null
	rem
	cx1a		get real tib address in a
	sta	itmtib-*	save real tib address for trace
	tsy	a.c001-*,*	(setptw) virtualize it
	cax1		put virtual tib address in x1
	rem
	trace	mt.tim,tr.ent,(itmtib,t.cur(1))
	rem
	tsy	iinchk-*,*	set up
	tra	iscdsp-*,*	in breakpoint, ignore call
*
	ldx2	1,2	get timeout branch if any
	tze	2
	tsy	iintrp-*,*	and do it
	tra	iscdsp-*,*	back to secondary dispatcher
*
iscdsp	ind	secdsp	secondary dispatcher
iinchk	ind	inchek	interpreter entry validation
iintrp	ind	interp	main interpreter subroutine
	rem
itmtib	bss	1	saves real tib address
	ttls	istbrk entry for restarting from breakpoint
	rem
istbrk	subr	ibk,(x1,x2,x3)
	sta	brkopc-*	may contain the real op to execute
	tsy	iinchk-*,*	do std setup
	tra	ibk001-*	at breakpoint, good
	stz	brkopc-*	not at breakpoint, cleanup
	tra	ibkret-*	and return
	rem
ibk001	lda	l.c003-*	=^tfbkpt
	ansa	t.flg3,1	not at break anymore
	tsy	iintrp-*,*	call intpreter
ibkret	return	istbrk
	rem
brkopc	oct	0	real op to exec when starting from break
	ttls	inchek subroutine to validate and set up at entry
*
*	this subroutine makes sure everything is legal at entry to
*	interpreter, and puts address of current wait block in x2
*
inchek	subr	inc,(a)
*
	cx1a		make sure x1 is non-zero
	tnz	2
	die	1
*
	ldx2	t.cur,1	get pointer to current wait blk
	tnz	2	which had better be non-zero
	die	2
	rem
	lda	t.flg3,1	see if at break
	cana	l.c002-*	=tfbkpt
	tnz	incret-*	at break, take nonskip return
*
	lda	0,2	get op block type
	cmpa	l.c001-*	which should be "wait"
	tze	2
	die	3
	aos	inchek-*	take skip return
*
incret	return	inchek
*
a.c001	ind	setptw	set up variable cpu page table word
a.c002	ind	gettib
	rem
l.c001	vfd	o18/waitop
l.c002	vfd	o18/tfbkpt
l.c003	vfd	o18//tfbkpt
	ttls	interp subroutine processes most control blocks
*
*	interp: main subroutine of control table interpreter, called
*	tib address in x1 and pointer to first block to process in
*	x2. starts at top for every fresh op block
*
interp	subr	int,(x2,x3)
	rem
	szn	brkopc-*	op to exec from bkpt restart?
	tze	int010-*	no
	lda	brkopc-*	yes, pick it up
	stz	brkopc-*
	tra	int011-*
*
int010	null		head of main loop
	lda	0,2	get op block type
int011	lrs	9	extend high-order 9 bits
	icmpa	-1	which must be all on
	tze	2
	die	4
*		                 isolate type so as to use        
*		                 jump table        
	qrl	9	get it in low-order
	cqa		of a
	tze	int020-*	zero is not allowed
	icmpa	maxop	it can't be too big either
	tmi	2
int020	null
	die	8
*		                now we'll load type into x3 and use it        
*		                 to index jump table        
	cax3
	trace	mt.blk,tr.blk,(x2,x3)
	adcx3	int030-*	add address of head of jump table
	tra	0,3*	and go through indirect word
*
int030	zero	*	address of jump table
*		                jump table follows        
	ind	int100	(01) goto
	ind	int200	(02) iftyp
	ind	int300	(03) wait
	ind	int400	(04) status
	ind	int500	(05) dcwlst
	ind	int600	(06) setime
	ind	int700	(07) gotype
	ind	int800	(10) setflg
	ind	int900	(11) clrflg
	ind	in1000	(12) tstflg
	ind	in1100	(13) dmpout
	ind	in1200	(14) signal
	ind	in1300	(15) meter
	ind	intbak	(16) waitm just returns
	ind	in1500	(17) sendin
	ind	in1600	(20) tstwrt
	ind	in1700	(21) tstglb
	ind	in1800	(22) setype
	ind	in1900	(23) scntr
	ind	in2000	(24) acntr
	ind	in2100	(25) tcntr
	ind	in2200	(26) getext
	ind	in2300	(27) retext
	ind	in2400	(30) inscan
	ind	in2500	(31) outscn
	ind	in2600	(32) bldmsg
	ind	in2700	(33) dumpin
	ind	in2800	(34) setchr
	ind	in2900	(35) cmpchr
	ind	in3000	(36) calsub
	ind	in3100	(37) retsub
	ind	in3200	(40) holdot
	ind	in3300	(41) ifhsla
	ind	in3400	(42) config
	ind	in3500	(43) ckinpt
	ind	in3600	(44) gtinpt
	ind	in3700	(45) replay
	ind	in3800	(46) dmprpy
	ind	in3900	(47) prepnl
	ind	in4000	(50) tstrpy
	ind	in4100	(51) echo
	ind	in4200	(52) setcct
	ind	in4300	(53) dmpmsg
	ind	in4400	(54) setlcl
	ind	in4500	(55) addlcl
	ind	in4600	(56) tstlcl
	ind	in4700	(57) setlcf
	ind	in4800	(60) clrlcf
	ind	in4900	(61) tstlcf
	ind	in5000	(62) setlcv
	ind	in5100	(63) calasm
	ind	in5200	(64) bkptop
	ind	in5300	(65) linctl
	ind	in5400	(66) linsta
	ind	in5500	(67) tstlcv
	ind	in5600	(70) nullop
	ind	in5700	(71) unwind
	ind	in5800	(72) settmv
	ind	in5600	(73) retpms obsolete (ind to nullop)
	ind	in6000	(74) gotov
	ind	in6100	(75) gocase
	ind	in6200	(76) setfld
	ind	in6300	(77) addfld
	ind	in6400	(100) tstfld
	ind	in6500	(101) meter1
	ind	in6600	(102) meter2
	ind	in6700	(103) meteru
	ind	in6800	(104) meterm
	ind	in2620	(105) bldims
maxop	equ	*-int030	defines end of table
*
intbak	null		return point
	return	interp
*
*
*
*
int100	null		goto
	ldx2	1,2	get address from block
	tra	int010-*	and go around again
*
*	test terminal type
*	iftype <terminal type test value>,<ptg on equal>
*
int200	null
	lda	1,2	get terminal type test value
	cmpa	t.type,1	vs tib terminal type
	tze	int210-*	equal
	iacx2	3	go to next block
	tra	int010-*
int210	ldx2	2,2	get new block address
	tra	int010-*
*
*
int300	null		wait
	szn	incall-*	check if still in called subroutine
	tze	2
	die	13	wait block executed between call and retu
	stx2	t.cur,1	store pointer to wait block in
	tra	intbak-*	tib and return
*
*
int400	null		status is illegal except after wait
	die	5
*
*
int500	null		dcwlst, handled by subroutine
	tsy	idcwc-*,*
	tra	int010-*
*
idcwc	ind	dcwcnt
*
*
int600	null		setime
	lda	1,2	get interval
int601	tsy	istime-*,*
	iacx2	2	bump to next block
	tra	int010-*
istime	ind	setime	scheduler entry to set timer
*
*
int700	null		gotype
	ldq	t.type,1	make sure terminal type code
	tze	int710-*	is positive
	tpl	2
int710	null
	die	12
*
int720	iacx2	1	advance to branch point
	lda	0,2	get branch point
	tmi	int710-*	end of list
	iaq	-1	decrement count
	tze	int730-*	found branch point
	tra	int720-*	loop
int730	cax2		get new address
	tra	int010-*	and process it
*
*
int800	null		setflg
	lda	1,2	get word of flags to turn on
	orsa	t.flg,1	and do it
	lda	2,2	same for second word
	orsa	t.flg2,1
	iacx2	3	bump to next block
	tra	int010-*
*
*
int900	null		clrflg
	lda	1,2	get word of flags to turn off
	iera	-1	complement it
	ansa	t.flg,1	turn off specified tib flags
	lda	2,2	get  second word
	iera	-1	complement  it
	ansa	t.flg2,1	turn these off,too
	iacx2	3	on to the next
	tra	int010-*
*
*
in1000	null		tstflg
	lda	2,2	get flags to test
	ana	t.flg,1	isolate them from tib flag word
	cmpa	2,2	are they all on?
	tnz	in1010-*
	lda	3,2	get  second word to test
	ana	t.flg2,1
	cmpa	3,2	are they all on too?
	tnz	in1010-*
	ldx2	1,2	yes, get new op block address
	tra	int010-*
in1010	null
	iacx2	4	no, bump to next block
	tra	int010-*
*
*
in1100	null		dmpout
	stz	sndflg-*	initialize this
	lda	t.ocp,1	get output chain pointer
	tze	in1110-*	and if its non-zero, free chain
	sta	in1190-*	save address
	tsy	a.d005-*,*	setbpt
	cax3		get addressable pointer
	lda	bf.flg,3	get buffer flags
	cana	l.d007-*	=hold output buffers flag
	tze	in1108-*	no - normal dmpout
in1104	cana	l.d006-*	=last buffer in message flag
	tnz	in1106-*	yes - release partial chain
	lda	bf.nxt,3	get forward link
	tze	in1107-*	end of chain - treat as normal dmpout
	tsy	a.d005-*,*	setbpt
	cax3		as above
	lda	bf.flg,3	get buffer flags
	tra	in1104-*
in1106	lda	bf.nxt,3	get forward link
	stz	bf.nxt,3	unlink rest of chain
	ldx3	t.ocp,1	get output chain pointer
	sta	t.ocp,1	establish new output chain
	cx3a
	tsy	ifrel-*,*	release first message in chain
	stz	t.ocur,1	void current buffer stuff
	stz	t.olst,1
	tra	in1140-*
	rem
in1107	aos	sndflg-*	make sure about sndout
	lda	t.ocp,1	get ptr to chain
	tsy	ifrel-*,*	free chain
	stz	t.ocp,1	zero ptr
	stz	t.ocur,1
	stz	t.olst,1
	tra	in1120-*
	rem
in1108	lda	in1190-*	get absolute chain address
	tsy	ifrel-*,*
	stz	t.ocp,1
	aos	sndflg-*	we must do "send output" if t.ocp chain was freed
in1110	null
	rem		do the same for chain being
	lda	t.ocur,1	output currently
	tze	in1120-*
	tsy	ifrel-*,*
	stz	t.ocur,1
	stz	t.olst,1
	lda	t.line,1	hsla line?
	cana	l.d010-*	=hslafl
	tze	in1120-*	no
	ldx3	t.sfcm,1	yes, we'll need sfcm address
	stz	sf.noc,3	not partway through an output buffer now
	rem
in1120	null
	szn	sndflg-*	did we free t.ocp chain?
	tnz	in1125-*	yes, queue "send output"
	ila	bufthr	if we threw away more than "threshold" buffers,
	cmpa	t.ocnt,1	we'll have to ask for more output
	tpl	in1130-*
in1125	null
	ilq	sndout
	tsy	idenq-*,*	dia enqueueing routine
in1130	null
	stz	t.ocnt,1	no buffers in write chain now
	lda	l.d002-*	^tfwrit
	ansa	t.flg,1	tfwrit must be turned off
in1140	null
	iacx2	1	bump to next block
	tra	int010-*
	rem
in1190	bss	1
ifrel	ind	frelbf	free buffer chain subroutine
*
*
in1200	null		signal
	ldq	1,2	get signal type
	tsy	idenq-*,*	call dia queuing routine
	iacx2	2	bump to next block
	tra	int010-*
idenq	ind	denq	dia enqueuing routine
*
*
in1300	null		meter
	ldq	1,2	get meter type
	tsy	imetrc-*,*	and call metering utility
	iacx2	2	next block
	tra	int010-*
imetrc	ind	meterc
*
*
in1500	null		sendin
	lda	t.icp,1	get input chain pointer
	tze	in1520-*	forget it if zero
	cmpa	t.ilst,1	see if there's only 1 buffer
	tnz	in1510-*	no, send the chain
	tsy	a.d005-*,*	setbpt
	cax3
	lda	bf.tly,3	otherwise make sure tally
	ana	l.d001-*	is non-zero
	tze	in1520-*
*
in1510	null
	ilq	accin	put "accept input" opcode in q
	tsy	idenq-*,*	for dia enqueuing routine
*
in1520	null
	iacx2	1	next block
	tra	int010-*
*
*
*
in1600	null		tstwrt
	szn	t.ocp,1	is there an output chain
	tnz	in1605-*
	szn	t.ocur,1	or is there one we're working on now?
	tze	in1610-*
in1605	null
	ldx2	1,2	yes, get branch address
	tra	int010-*
in1610	null		no, go to next block
	iacx2	2
	tra	int010-*
*
*
in1700	null		tstglb
	lda	iglob-*,*	pick up global switches
	ana	1,2	isolate the one(s) we're testing
	cmpa	1,2	all on?
	tnz	in1710-*
	ldx2	2,2	yes, get new op block addr.
	tra	int010-*
in1710	iacx2	3	fail, get next block
	tra	int010-*
iglob	ind	globsw
*
*
in1800	null		setype
	lda	1,2	get new type from op block
	sta	t.type,1	set it in tib
	ldx3	a.d004-*	addr (ctrl)
	ldx3	ct.dev,3	get pointer to device tables
	adcx3	t.type,1	indexed by line type
	ldx3	-1,3	subtract 1 for 0 origin
	iacx3	dt.brk	add in offset of break table
	stx3	t.brkp,1	update break table address
	iacx2	2	next block
	tra	iin010-*,*
*
in1900	null		scntr (set counter)
	lda	1,2	get new value
	sta	t.cntr,1	store it in counter
	iacx2	2	next block
	tra	iin010-*,*
*
in2000	null		acntr (add to counter)
	lda	t.cntr,1	origional value
	ldq	1,2	increment
	tsy	a.d001-*,*	=addnov
	sta	t.cntr,1
	iacx2	2	next block
	tra	iin010-*,*
*
in2100	null		tcntr (test counter)
	lda	1,2	get test value
	cmpa	t.cntr,1	same as counter?
	tze	in2110-*
	iacx2	3	no, go to next block
	tra	iin010-*,*
in2110	null
	ldx2	2,2	yes, get new block address
	tra	iin010-*,*
	rem
	rem
	rem
a.d001	ind	addnov
a.d002	ind	getmem
a.d003	ind	fremem
a.d004	ind	ctrl
a.d005	ind	setbpt
a.d006	ind	cvabs
	rem
l.d001	vfd	18/buftmk	buffer tally mask
l.d002	vfd	18/ntfwrt
l.d003	oct	400000	extension buffer in use flag
l.d004	oct	77	sub-buffer tally mask
l.d005	oct	777	mask for right half
l.d006	vfd	18/bfflst	last buffer in message flag
l.d007	vfd	18/bffhld	hold output buffers flag
*l.d008	unused
*l.d009	unused
l.d010	vfd	18/hslafl
	rem
incall	oct	0	hold area - return point from called subr
ifrlbf	ind	frelbf	free linked chain of buffers subroutine
	rem
	rem
sndflg	bss	1	indicates whether to do "send output" on dmpout
*
*	get tib extension
*	getext < # words needed>,<ptg on failure>
*
in2200	szn	t.elnk,1	does line have extension?
	tze	2	no
	die	14	die
	ldq	1,2	number of words needed
	iaq	1	+1 for length word
	tsy	a.d002-*,*	=getmem
	tra	in2210-*	no room
	lda	1,2	length requested
	sta	0,3	save in extension
	stx3	t.elnk,1	save extension address
	iacx2	3	skip 3 words for this opblock
	tra	iin010-*,*	and go to next
in2210	ldx2	2,2	take failure return
	tra	iin010-*,*
*
*	return a tib extension
*	retext
*
in2300	ldx3	t.elnk,1	get address
	tze	in2310-*	none, do nothing
	stz	t.elnk,1	no longer has ext
	ldq	0,3	length
	iaq	1	plus control word
	tsy	a.d003-*,*	=fremem
in2310	iacx2	1
	tra	iin010-*,*
*
*	input scan
*	inscan <address of control string>,<ptg on failure>
*
in2400	ila	0	get input scan indicator
	tsy	iscnop-*,*	call scan subroutine
	tra	iin010-*,*
iscnop	ind	scanop
*
*	output scan
*	outscn <address of control string>,<ptg on failure>
*
in2500	ila	1	get output scan indicator
	tsy	iscnop-*,*	call scan subroutine
	tra	iin010-*,*
*
*
*
iin010	ind	int010
ibldut	ind	bldutl
iadbyt	ind	adbyte
*
*	build output message
*	bldmsg <address of control string>,<ptg on failure>
*
in2600	null
	tsy	ibldut-*,*	(=bldutl) build the message
	tra	in2670-*	failed
	lda	t.ocp,1	get output chain pointer
	sta	bf.nxt,3	chain it to this one
	cx3a		get our absolute address
	tsy	a.d006-*,*	cvabs
	sta	t.ocp,1	replace output chain pointer
	rem
in2605	iacx2	3	go to next block
	tra	iin010-*,*
*
*	build input message
*	bldims <address of control string>,<ptg on failure>
*
in2620	null
	tsy	ibldut-*,*	(=bldutl) build the message
	tra	in2670-*	failed
	lda	t.icp,1	get input chain pointer
	sta	bf.nxt,3	chain it to current one
	cx3a
	tsy	a.d006-*,*	cvabs
	sta	t.icp,1	place input chain pointer
	tra	in2605-*	return
*
* Here for failing bldmsg
*
in2670	ldx2	2,2	get failure block address
	tra	iin010-*,*
*
*	dump input chain
*	dumpin
*
in2700	lda	t.icp,1	get input chain ptr
	tze	in2710-*	no chain
	tsy	ifrlbf-*,*	free input chain
	stz	t.icp,1	zero chain pointer
	stz	t.ilst,1	zero pointer to last buffer
	stz	t.icpl,1
in2710	iacx2	1	go to next block
	tra	iin010-*,*
*
*	set byte value in tib extension
*	setchr <destination>,<source>
*
in2800	lda	1,2	get byte positions
	arl	9	isolate dest byte
	tsy	iadbyt-*,*	get its byte adress
	die	15	not tib extension byte
	stx3	in2850-*	save - dest address
	lda	1,2
	ana	l.d005-*	=o777 - isolate source byte
	tsy	iadbyt-*,*	get its address
	tra	in2810-*	not 46x value
	lda	0,3,b.0	get source byte
in2810	ldx3	in2850-*	get dest byte address
	sta	0,3,b.0	place in tib byte
	iacx2	2	go to next block
	tra	iin010-*,*
in2850	bss	1	destination byte address
in2860	bss	1	source byte address
*
*	compare bytes
*	cmpchr <source>,<test value>,<ptg on equal>
*
in2900	lda	1,2	get byte positions
	arl	9	isolate source byte
	tsy	iadbyt-*,*	get its byte address
	tra	in2910-*	not 46x value
	lda	0,3,b.0	get source byte
in2910	sta	in2860-*	save for compare
	lda	1,2
	ana	l.d005-*	=o777 - isolate test value
	tsy	iadbyt-*,*	get its address
	tra	in2920-*	not 46x value
	lda	0,3,b.0	get test value
in2920	cmpa	in2860-*	vs source byte
	tze	in2930-*	equal
	iacx2	3	go to next block
	tra	iin010-*,*
in2930	ldx2	2,2	get equal block address
	tra	iin010-*,*
*
*	call subroutine
*	calsub <subroutine entry point>
*
in3000	szn	incall-*	check return point
	tze	2	ok - not in use
	die	13	multiple subroutine calls
	lda	1,2	get entry point block address
	iacx2	2
	szn	t.reta,1	tib return addr used yet?
	tnz	in3001-*	yes
	stx2	t.reta,1
	tra	in3002-*
in3001	stx2	incall-*	save return point
in3002	cax2		go to subroutine
	tra	iin010-*,*
*
*	return from subroutine
*	retsub
*
in3100	szn	incall-*	check second return point
	tze	in3101-*	not in use
	ldx2	incall-*
	stz	incall-*
	tra	iin010-*,*
in3101	szn	t.reta,1	check first return point
	tnz	2
	die	13
	ldx2	t.reta,1
	stz	t.reta,1
	tra	iin010-*,*
*
*	set hold output buffer flag
*	holdot
*
in3200	lda	t.ocp,1	get output chain pointer
	tnz	in3220-*
in3210	iacx2	1	go to next block
	tra	iin010-*,*
in3220	tsy	a.g015-*,*	setbpt
	cax3
	lda	in3290-*	get hold output buffer flag
	orsa	bf.flg,3	set on in buffer
	lda	bf.flg,3
	ana	in3280-*	check for last buffer in message
	tnz	in3210-*	yes
	lda	bf.nxt,3	get forward pointer
	tze	in3210-*
	tra	in3220-*
	rem
in3280	vfd	18/bfflst	last buffer in message flag
in3290	vfd	18/bffhld	hold output buffer flag
*
*	test for hsla line
*	ifhsla
*
in3300	null		ifhsla
	lda	t.line,1	get line number to find out if hsla line
	arl	9	get hsla bit down at end
	tze	in3310-*	not hsla
	ldx2	1,2	is hsla, get branch point
	tra	iin010-*,*	go get new block
in3310	null		not hsla
	iacx2	2	go to next block
	tra	iin010-*,*
*
*	reconfigure operation for hsla's
*	config
*
in3400	null		config
	lda	t.line,1	be sure hsla
	arl	9
	tnz	2
	die	16
	iacx2	1	point at first sub-op
	tsy	icnfg-*,*	config block processed by subroutine
	tra	iin010-*,*	and continue with next op block
	rem
icnfg	ind	hcfg	subroutine to process config block
*
*	check for partial input line for channel
*	ckinpt
*
in3500	null		ckinpt
	lda	t.icp,1	is there an input chain?
	tze	in3510-*	no, check for hsla
	tsy	a.g015-*,*	setbpt
	cax3
	lda	bf.tly,3	yes, see if it's more than just cr
	ana	l.g001-*	(=buftmk) isolate tally in first buffer
	iaa	-2	is it more than 1?
	tpl	in3595-*	yes, there's a partial line
	rem		(otherwise result would have been negative)
	cx3a		no, get pointer to first character
	ada	l.g007-*	bf.dta,b.0
	cax3		in order to
	tra	in3520-*	check to see if it's carriage return
	rem
in3510	lda	t.line,1
	arl	9	is it an hsla line?
	tze	in3590-*	no, there's no input
	rem
	ldx3	a.g001-*	(=indblk) 2 word arg blk for hgeti
	tsy	a.g002-*,*	(=hgeti) call routine to check input
	lda	indblk+1-*	any chars in buffer?
	tze	in3590-*	no, at left margin
	icmpa	1	 more than one char?
	tnz	in3595-*	yes, we have partial input
	ldx3	indblk-*	no, look at character
in3520	lda	0,3,b.0	pick up the char
	iana	127	strip off parity
	sta	tmpchr-*	hang on to it
	icmpa	cr	is it carriage return?
	tze	in3590-*	yes, no partial input
	icmpa	upshft	case shift character?
	tze	in3590-*	yes, doesn't count
	icmpa	dnshft	or lower shift?
	tze	in3590-*	yes, don't count it either
	lda	t.flg2,1	check for output flow control chars
	cana	l.g008-*	tfofc
	tze	in3540-*	mode not on, skip it
	ldq	t.ofch,1	get the chars
	cana	l.g009-*	tfblak
	tnz	in3530-*	if block ack, don't check 1st char
	cqa
	arl	9	suspend character
	cmpa	tmpchr-*	got it?
	tze	in3590-*	yes, doesn't count
in3530	lls	27	isolate resume/ack char
	arl	9
	cmpa	tmpchr-*
	tze	in3590-*	it is one, don't count it
in3540	lda	t.type,1	is this a 2741?
	icmpa	3
	tnz	in3595-*	no, don't check further
	lda	tmpchr-*	get character back into a
	iana	63	mask off shift
	icmpa	ibmeot	is it an eot?
	tnz	in3595-*	no, we have partial input
	rem
in3590	ldx2	1,2	get fail addr, no partial line
	tra	a.g003-*,*	(=int010) return
	rem
in3595	iacx2	2	all well, partial input ready
	tra	a.g003-*,*	(=int010) return
*
*	routine to scoop up input and make output chain at t.rcp
*	gtinpt
*
in3600	null
	stx2	in3694-*	save x2 value
	rem
	tsy	a.g006-*,*	(=getcmt) get pointer to cmt
	rem		returned in x2
	lda	1,2,b.0	get tab from cmt
	sta	a.g007-*,*	(tabchr) save for copybf
	lda	1,2,b.1	likewise backspace
	sta	a.g008-*,*	(bschar)
	rem
	lda	t.type,1	is it a 1050 or 2741?
	icmpa	2	(1050)
	tze	in3602-*
	icmpa	3	(2741)
	tnz	in3603-*
in3602	ila	61	yes, use ebcdic pad
	tra	in3604-*
	rem
in3603	ila	0	no, use ascii pad
in3604	sta	a.g008-*,*	(delchr) save for copybf
	stz	t.rcp,1	to initialize
	rem
	lda	t.icp,1	get ptr to head of input chain
	tze	in3650-*	none, check hsla
	rem
in3610	tsy	a.g015-*,*	setbpt
	cax2
	lda	bf.tly,2	get the output buffer tally
	ana	l.g001-*	(=buftmk) mask tally
	caq		hold on to it
	stx2	in3695-*	save original buffer pointer
	cx2a		move pointer to first char
	ada	l.g007-*	bf.dta,b.0
	cax2
	cqa		get tally back
	tsy	a.g010-*,*	(copybf) copy it into replay chain
	rem
	ldx2	in3695-*	restore x2 with buffer pointer
	lda	bf.nxt,2	get fwd ptr in this buffer
	tnz	in3610-*	enter copy loop if another buffer
	stx3	in3693-*	save pointer to last buffer
	rem
in3650	lda	t.line,1	special code for hsla's
	arl	9	we are done if its an lsla
	tze	in3680-*	we are.
	rem
	ldx3	a.g001-*	(=indblk) 2 word arg blk
	tsy	a.g002-*,*	(=hgeti) get input ptrs and tally
	szn	indblk+1-*	any input at all?
	tze	in3680-*	no, done
	rem
	lda	indblk+1-*	get the tally
	rem
	ldx2	indblk-*	get ptr to input bffr
	tsy	a.g010-*,*	(copybf) copy this stuff
	tra	2	buffer address is in x3 already
	rem
in3680	ldx3	in3693-*	get ptr to last buffer in chain
	lda	a.g016-*,*	(ctpte) get target pte back
	sta	a.g017-*,*	.crbpe,*
	lda	l.g004-*	(=bffrpy) get replay flag
	orsa	bf.flg,3	set in buffer
	rem
	ldx2	in3694-*
	iacx2	1	skip this block
	tra	a.g003-*,*	(=int010)
	rem
in3693	bss	1
	rem
in3694	bss	1
in3695	bss	1
indblk	bss	2
	rem
a.g001	ind	indblk
a.g002	ind	hgeti
a.g003	ind	int010
a.g004	ind	getbfh
a.g005	ind	frelbf
a.g006	ind	getcmt
a.g007	ind	tabchr	in copybf
a.g008	ind	delchr	in copybf
a.g009	ind	bschar	in copybf
a.g010	ind	copybf	subroutine to copy input buffer into replay buffer
a.g011	ind	addnov
a.g012	ind	puteco
a.g013	ind	frebfh
a.g014	ind	setcct	hsla mans cct setter
a.g015	ind	setbpt
a.g016	ind	ctpte	in copybf
a.g017	ind	.crbpe,*
	rem
l.g001	vfd	18/buftmk
l.g002	ind	0,b.0
l.g003	oct	000777
l.g004	vfd	18/bffrpy
l.g005	vfd	18/ntfrpn
l.g006	vfd	18/bffbrk
l.g007	zero	bf.dta,b.0
l.g008	vfd	18/tfofc
l.g009	vfd	18/tfblak
	rem
tmpchr	bss	1	temporary storage for test char
*
*	op to make gtinpt chain the real output chain
*	replay
*
in3700	null		replay
	ldx3	t.rcp,1	get replay chain ptr
	szn	t.ocp,1	make sure no output ready now
	tze	2
	die	17
	rem
	stx3	t.ocp,1	set as head of chain
	stz	t.rcp,1	zero replay chain ptr
	rem
	iacx2	1	next block please
	tra	a.g003-*,*	(=int010)
*
*	dump the replay chain, if any
*	dmprpy
*
in3800	null		dmprpy
	lda	t.rcp,1	get ptr
	tze	in3810-*	none, done
	rem
	tsy	a.g005-*,*	(=frelbf)
	stz	t.rcp,1	freed
	rem
in3810	iacx2	1	next block
	lda	l.g005-*	=^tfrpon
	ansa	t.flg2,1	replay not on now
	tra	a.g003-*,*	(=int010)
*
*	op to prepare newline and delays for output now
*	prepnl
*
in3900	null
	ilq	bufsiz	allocate buffer for the nl
	tsy	a.g004-*,*	(=getbfh)
	die	18
	rem
	sta	in3994-*	save absolute address of buffer
	stx3	in3991-*	save virtual addr of buffer
	stx2	in3992-*	save x2 for awhile
	rem
	stz	in3993-*	init the tally for the buffer
	rem
	cx3a		setup x3 with char addressing too
	iaa	bf.dta	offset of data in buffer
	ora	l.g002-*	(=0,b.0) char bits
	cax3		back into x3
	rem
	tsy	a.g006-*,*	(getcmt) get cmt pointer
	lda	0,2,b.1	get the cr char from the cmt
	cmpa	l.g003-*	(=000777) no char?
	tze	in3910-*	yes, dont use it
	rem
	sta	0,3,b.0	put cr into buffer
	iacx3	0,b.1	bump ptr
	aos	in3993-*	bump tally
	rem
in3910	lda	0,2,b.0	get the nl char
	sta	0,3,b.0	put the char into the buffer
	iacx3	0,b.1	bump the ptr
	aos	in3993-*	bump the tally
	rem
	ilq	0	get the pad for ascii (null)
	rem
	lda	t.type,1	get the type of this guy
	icmpa	2	is it 1050?
	tze	in3913-*	yes
	icmpa	3	is it 2741?
	tnz	in3915-*	no
in3913	ila	-17	more delays for ebcdic types
	ilq	61	octal 75 is idle for 1050/2741
	tra	in3920-*
	rem
in3915	ila	-8	get the count of pads to send
in3920	stq	0,3,b.0	deposit for idle
	iacx3	0,b.1	bump ptr
	aos	in3993-*	count tally
	iaa	1	decrement count
	tnz	in3920-*	loop
	rem
	ldx3	in3991-*	reload ptr to buffer
	lda	in3993-*	get the correct tally
	sta	bf.tly,3	save in buffer
	rem
	lda	t.ocp,1	get head of chain
	sta	bf.nxt,3	make head ptr nxt in our buffer
	ldx3	in3994-*	get absolute address back
	stx3	t.ocp,1	make us head now
	rem
	ldx2	in3992-*	reload op block ptr
	iacx2	1	skip the block
	tra	a.g003-*,*	(=int010)
	rem
in3991	bss	1
in3992	bss	1
in3993	bss	1
in3994	bss	1
*
*	op to test replay chain ptr
*	tstrpy
*
in4000	null
	szn	t.rcp,1	any replay chain?
	tnz	in4010-*	yes
	rem
	ldx2	1,2	no, take fail addr
	tra	a.g003-*,*	(=int010)
	rem
in4010	iacx2	2	ok skip block
	tra	a.g003-*,*	(=int010)
*
*	op to insert char in echo buffer
*	echo
*
in4100	null
	ldq	1,2	get character
	tsy	a.g012-*,*	(=puteco)
	iacx2	2	next op block
	tra	a.g003-*,*	(=int010)
*
*	initialize cct to specific table
*	setcct	<addr of cct to be used>
*
h.baw	equ	8	base address word in hwcm
*
in4200	lda	t.line,1	be sure it is hsla
	arl	9
	tze	in4201-*	lsla, ignore
	lda	1,2	get arg
	tsy	a.g014-*,*	=setcct
in4201	iacx2	2	go to next op block
	tra	a.g003-*,*	(=int010)
*
*	dump input message up to break char
*	dmpmsg
*
in4300	lda	t.icp,1	get head of input chain
	tze	in4310-*	there isn't any, we're done
	sta	in4391-*	save absolute address
	tsy	a.g015-*,*	setbpt
	cax3
	lda	bf.flg,3	find out if this is end
	ana	l.g006-*	=bffbrk
	sta	in4390-*	save for later
	lda	bf.nxt,3	get forward pointer
	sta	t.icp,1	new head of chain
	lda	bf.siz,3	get buffer size
	arl	15	size-1
	iera	-1	add 1 and negate
	asa	t.icpl,1	subtract from chain length
	lda	in4391-*	get absolute address for freeing
	ilq	0
	tsy	a.g013-*,*	frebfh
	szn	in4390-*	was it last in message?
	tze	in4300-*	no, look at new head
in4310	szn	t.icp,1	is head of chain zero?
	tnz	2	no, that's cool
	stz	t.ilst,1	make sure no one thinks there's a chain
	iacx2	1	done, go to next block
	tra	a.g003-*,*	=int010
	rem
in4390	bss	1	used to hold latest value of bffbrk
in4391	bss	1	holds absolute buffer address
*
*	setlcl - set a local variable
*
in4400	ldx3	1,2	addr of variable
	tsy	cvaddr-*	get real address
	lda	2,2	new value
	sta	0,3	this is the job
	iacx2	3
	tra	a.g003-*,*	=int010
*
*	addlcl - add value to a local variable
*
in4500	ldx3	1,2	addr of variable
	tsy	cvaddr-*
	lda	0,3	starting value
	ldq	2,2	increvemt
	tsy	a.g011-*,*	(addnov) do the add
	sta	0,3	and store result
	iacx2	3
	tra	a.g003-*,*	=int010
*
*	tstlcl - test local variable and goto if equal
*
in4600	ldx3	1,2	addr of variable
	tsy	cvaddr-*
	lda	2,2	test val
	cmpa	0,3
	tze	in4601-*	do the goto
	iacx2	4
	tra	a.g003-*,*	=int010
in4601	ldx2	3,2	get branch addr
	tra	a.g003-*,*	=int010
*
*	setlcf - set flag in local variable
*
in4700	ldx3	1,2	addr of variable
	tsy	cvaddr-*
	lda	2,2	new bits to set
	orsa	0,3	set them
	iacx2	3
	tra	a.g003-*,*	=int010
*
*	clrlcf - clear flag in local variable
*
in4800	ldx3	1,2	addr of variable
	tsy	cvaddr-*
	ila	-1
	era	2,2	get invverted mask
	ansa	0,3	turn off bits
	iacx2	3
	tra	a.g003-*,*	=int010
*
*	tstlcf - test flag in local variable and goto if on
*
in4900	ldx3	1,2	addr of variable
	tsy	cvaddr-*
	lda	2,2	bits to test
	ana	0,3	test them
	cmpa	2,2	all on?
	tze	in4901-*	yes
	iacx2	4
	tra	a.g003-*,*	=int010
in4901	ldx2	3,2	get place to go
	tra	a.g003-*,*	=int010
*
*	setlcv - set local variable from another one
*
in5000	ldx3	1,2	address of target
	tsy	cvaddr-*
	stx3	in5001-*
	ldx3	2,2	address of source
	tsy	cvaddr-*
	lda	0,3	pick up data
	sta	in5001-*,*
	iacx2	3
	tra	a.g003-*,*	=int010
in5001	bss	1
*
*	subroutine to get address of local variables.
*	a positve number is a real address.
*	a negative number is a tib externion offset, and is converted
*	to a real address.
*	entered with address in x3
*
cvaddr	subr	cva
	cx3a
	icmpa	0	test for minus
	tpl	cvaret-*	normal address
	szn	t.elnk,1	be sure there is tib extension
	tnz	2
	die	14
	iera	-1	invert offset
	iaa	1
	ada	t.elnk,1	now have real address
	cax3
cvaret	return	cvaddr
*
*	calasm - call an assembler subr from control tables
*
in5100	cx2a
	iaa	3	get param list addr
	cax3		store here for call
	ada	2,2	get addr of opblock after params
	sta	in5101-*	save for return
	ldx2	2,2	load param count
	tsy	-2,3*	and call subr
	cx2a		check return value
	tnz	a.g003-*,*	subr set return addr
	ldx2	in5101-*	continue in line
	tra	a.g003-*,*	=int010
in5101	bss	1
*
*	bkptop - breakpoint ecountered
*
in5200	tsy	a.h002-*,*	=brkhit, see what to do
	tra	a.h003-*,*	=int011, dont break, a contains op
	lda	l.h002-*	=tfbkpt, set break flag
	orsa	t.flg3,1
	tra	a.h004-*,*	=int300, exit thru wait opblock
*
*	linctl - checks to see if test state call was caused
*	         by a line_control order from cs
*
in5300	tsy	a.h005-*,*	=lctlck, dia man entry to check
	tra	in5301-*	not a line control call
	stx3	in5302-*	save temporarily
	ldx3	1,2	where to store data
	tsy	cvaddr-*
	cx2a		save opblock addr
	ldx2	in5302-*	address of line_control data
	ldq	0,2	copy 4 words
	stq	0,3
	ldq	1,2
	stq	1,3
	ldq	2,2
	stq	2,3
	ldq	3,2
	stq	3,3
	iaa	3	address of next opblock
	cax2
	tra	a.g003-*,*	=int010
in5301	ldx2	2,2	take failuure addr
	tra	a.g003-*,*
in5302	bss	1
*
*	linsta - line status to send signal to cs
*
in5400	ldx3	1,2	addr of data
	tsy	cvaddr-*
	stx2	in5302-*	save opblock addr
	cx3a
	cax2
	ldq	l.h003-*	=004124, linsta code with wordcount=4
	tsy	a.h006-*,*	=denq
	ldx2	in5302-*	current opblock
	iacx2	2	advance to next
	tra	a.g003-*,*
*
*	tstlcv - compares two variables and does goto if equal
*
in5500	ldx3	1,2	addr of first
	tsy	cvaddr-*
	stx3	in5501-*	save first addr
	ldx3	2,2	addr of second
	tsy	cvaddr-*
	lda	0,3	get second value
	cmpa	in5501-*,*	compare to first
	tze	in5502-*	got a match
	iacx2	4	on to next op
	tra	a.h009-*,*	=int010
in5502	ldx2	3,2	get success addr
	tra	a.h009-*,*	=int010
in5501	bss	1
*
*	nullop - a no-operation, do nothing
*
in5600	iacx2	1
	tra	a.h009-*,*	=int010
*
*	unwind - zeores all subroutine return addresses to return
*	         highest level.
*
in5700	stz	a.h007-*,*	=incall
	stz	t.reta,1
	tra	in5600-*
*
*	settmv - set time from a variable
*
in5800	ldx3	1,2	get variable address
	tsy	cvaddr-*
	lda	0,3	pick up time
	tra	a.h008-*,*	=int601, join setime path
*
*	retpms - return parameters
*
* in5900	null		return parameters
* 	ilq	sparms	put return params opcode in q
* 	tsy	idenk-*,*	for dia enqueueing routine
* 	iacx2	1	skip this block
* 	tra	a.h009-*,*	(=int010)
idenk	ind	denq	dia enqueueing routine
*
*	gotov - go to a variable
*
in6000	ldx3	1,2	get variable address
	tsy	cvaddr-*
	ldx2	0,3	get target address
	tra	a.h009-*,*	=int010
	rem
*
*	gocase -  goto computed on case basis
*
in6100	null		goto computed on case
	stx2	gocsva-*	save opblock table IC
	lda	1,2	get varriable addr
	sta	gocval-*	save this addr in temp loc
	ana	gocmsk-*	see if tib ext is char or word
	cmpa	gocmsk-*	see if o760
	tnz	in6101-*	if not char in tib
	lda	gocval-*	word, so get addr from cvaddr
	ora	gocend-*	get this to a full o777XXX
	cax3		move this addr to x3
	tsy	cvaddr-*	go get the real address
	lda	0,3	get value of this varriable
	tra	in6102-*	have addr so go do rest
in6101	lda	gocval-*	char so go get that addr
	tsy	goctib-*,*	get real addr
	tra	in6102-*	literal, so have value
	lda	0,3,b.0	go get value from tib
in6102	sta	gocval-*	so store it
	lda	2,2	get addr compare list
	ora	gocbyt-*	set for byte addressing
	sta	gocvls-*	save addr in word
	ldx3	3,2	get addr of jmp list
	ldx2	gocvls-*	get addr of cmp list to an index
in6103	lda	gocend-*	get ond of list marker
	cmpa	0,3	check for end of string
	tze	in6107-*	if end return
	lda	0,2,b.0	get char from cmp list
	cmpa	goclsn-*	see if end of value list
	tze	in6107-*	end so return
	stx3	gocjls-*	save our jmp addr, we need x3
	ana	gocmsk-*	o760, see if char or word
	cmpa	gocmsk-*	see if word (o760)
	tnz	in6104-*	if not char, tib ext word
	lda	0,2,b.0	word so get value back to get
	ora	gocend-*	get to a full o777XXX
	cax3		move addr to x3 for cvaddr
	tsy	cvaddr-*	go get real addr
	lda	0,3	get value of varriable
	tra	in6105-*	go do it
in6104	lda	0,2,b.0	char so go get it.
	tsy	goctib-*,*	get tib ext addr if needed
	tra	in6105-*	literal so have it
	lda	0,3,b.0	get real value from tib ext
in6105	null		do rest of this entry
	ldx3	gocjls-*	load our jmp list back
	cmpa	gocval-*	compare two values
	tze	in6106-*	if equal found it
	iacx2	0,b.1	incr x2 to next character
	iacx3	1	incr our index counter
	tra	in6103-*	try next value to compare
in6106	null		found our value
	ldx2	0,3	set x2 to the jmp addr
	tra	a.h009-*,*	go return =int010
in6107	null		value not in our table
	ldx2	gocsva-*	get old opblock table IC
	iacx2	4	incr x2 to next opblock in table
	tra	a.h009-*,*	go return =int010
gocsva	bss	1	temp of old x2
gocvls	bss	1	varriable list addr
gocjls	bss	1	jump list addr
gocend	oct	777000	end of list records
gocmsk	oct	760	mask for char or word tib ext
gocval	bss	1	store value to match
goclsn	oct	000777	end of chrstr list
goctib	ind	adbyte	get character from tib
gocsvt	bss	1	save area
gocbyt	zero	0,b.0	set to byte addressing
	rem
	rem
in6200	null		setfld
	lda	2,2	get value to set
	sta	1,2*	store it (op block indirects through x1)
	iacx2	3	on to next
	tra	a.h009-*,*	int010
	rem
in6300	null		addfld
	lda	1,2*	get contents of tib field
	ldq	2,2	get increment
	tsy	a.h010-*,*	addnov
	sta	1,2*	result to tib field  (op block indirects through x1)
	iacx2	3	on to next
	tra	a.h009-*,*	int010
	rem
in6400	null		tstfld
	lda	2,2	get value to test against
	cmpa	1,2*	compare it to field
	tze	in6410-*	equal, branch
	iacx2	4	else advance to next block
	tra	a.h009-*,*	int010
in6410	ldx2	3,2	get branch address
	tra	a.h009-*,*	(int010) go to it
	rem
in6500	null		meter1 (add to single-word meter)
	lda	a.h011-*	addr (mincs)
	tra	mjoin-*
	rem
in6600	null		meter2 (add to double-word meter)
	lda	a.h012-*	addr(mincd)
	tra	mjoin-*
	rem
in6700	null		meteru (update meter & meter count)
	lda	a.h013-*	addr (mupdat)
mjoin	null		a contains address of subroutine
mcall	tra	mret-*	patched to nop by bind_fnp if metering enabled
	sta	mentry-*
	lda	t.metr,1	get pointer to metering area
	ada	1,2	plus offset of specified meter
	ldq	2,2	get increment from op block
	tsy	mentry-*,*	call subroutine
mret	iacx2	3	next op block
	tra	a.h009-*,*	int010
	rem
in6800	null		meterm (meter synchronous message)
mcal2	tra	mret2-*	***see note at mcall
	lda	t.metr,1	get pointer to metering area
	szn	1,2	input or output?
	tnz	in6810-*	output
	iaa	m.nim	input, get correct offset
	ldx3	t.icp,1	and buffer pointer
	tra	in6820-*
in6810	iaa	m.nom	get offset for output metering
	ldx3	t.ocp,1	and buffer pointer
in6820	tsy	a.h014-*,*	mmsg
mret2	iacx2	2	next op block
	tra	a.h009-*,*	int010
	rem
	rem
mentry	ind	0	set to address of appropriate metering routine
	ttls	subroutine to get address of carriage movement table
	rem
getcmt	subr	get
	rem
	ldx2	a.h001-*	(=ctrl) get addr of base of ctrl
	lda	ct.dev,2	to get ptr to device tables
	ada	t.type,1	add in the type of this guy
	iaa	-1	correct for zero offset
	cax2		get ptr to ptr to correct devtbl
	lda	0,2	now have ptr to devtbl
	iaa	dt.cmt	add in offset of cmt
	ora	l.h001-*	(=0,b.0) add in char addressing
	cax2		put into x2
	return	getcmt
	rem
l.h001	zero	0,b.0
l.h002	vfd	o18/tfbkpt
l.h003	oct	004124
l.h004	oct	004000
l.h005	oct	400000
l.h006	oct	377777
a.h001	ind	ctrl
a.h002	ind	brkhit
a.h003	ind	int011
a.h004	ind	int300
a.h005	ind	lctlck
a.h006	ind	denq
a.h007	ind	incall
a.h008	ind	int601
a.h009	ind	int010
a.h010	ind	addnov
a.h011	ind	mincs
a.h012	ind	mincd
a.h013	ind	mupdat
a.h014	ind	mmsg
	ttls	addnov - add the q to the a without causing overflow
	rem
addnov	subr	ano,(i)
	sta	anosva-*	save "a" temporarily
	lda	anosi-*	get indicators
	ora	l.h004-*	=004000, inhibit overflow
	sta	anotmp-*
	ldi	anotmp-*
	stq	anotmp-*	the addend
	lda	anosva-*
	ada	anotmp-*	why we're here
	tov	2	failed
	tra	anoret-*	add ok, return
	iaa	0
	tmi	annovp-*	answer was minus, set to +infinity
	lda	l.h005-*	=400000
	tra	anoret-*
annovp	lda	l.h006-*	=377777
anoret	return	addnov
anotmp	bss	1
anosva	bss	1
	ttls	dcwcnt subroutine counts words in dcwlst op block
*
dcwcnt	subr	dcw
*
*	calculates number of words in dcwlst op block and calls
*	appropriate subroutine to process it
*
maxdcw	equ	6
	rem
	rem
	iacx2	1	point to first subop
	stx2	t.dcwa,1	store starting address
*
dcw010	null		head of word-counting loop
	lda	0,2	get next word
	arl	9	isolate subop code
	cmpa	l.e005-*	(=o777) are all 9 bits on?
	tze	dcw080-*	yes, all through with dcwlst
	arl	6	isolate 3 high-order bits
	icmpa	1	die if less than 1
	tmi	dcw020-*
	icmpa	3	if output, handle specifically
	tze	dcw030-*
	icmpa	maxdcw	check against maximum value
	tmi	2	less is okay
dcw020	null		unrecognizable subop
	die	6
	rem		here if 1, 2, 4, or 5, just go to next word
	iacx2	1
	tra	dcw010-*
*
dcw030	null		output subop, count chars.
	cx2a		switch x2 to 9-bit byte addr.
	ora	l.e001-*	0,b.0
	cax2
dcw040	null
	iacx2	0,b.1	next character
dcw050	null
	lda	0,2,b.0	pick up char.
	cmpa	l.e002-*	=o000477
	tze	dcw070-*	end of output subop
	cmpa	l.e003-*	(=o000400) literal?
	tmi	dcw040-*	yes, get next char.
	era	l.e003-*	else turn off high-order bit
	icmpa	1	check for printer
	tze	dcw040-*	or keyboard addressing
	icmpa	2	and go to next char
	tze	dcw040-*	in either case
*
	icmpa	3	splice in output chain?
	tnz	dcw060-*
	iacx2	0,b.1	if so, next char. must be
	lda	0,2,b.0	"end  f output" or we die
	cmpa	l.e002-*	=o000477
	tze	dcw070-*
	die	7
*
dcw060	null
	icmpa	4	repeat?
	tze	2	it had better be
	die	6
	iacx2	1,b.1	bump x2 by 3 chars
	tra	dcw050-*
*
dcw070	null		end of output subop
	cx2a		restore word addressing to x2
	ana	l.e004-*	=o077777
	cax2
	iacx2	1	go to next word
	tra	dcw010-*
*
dcw080	null		end of dcwlst
	lda	l.e007-*	(o777000)
	ansa	t.dcwl,1	zero t.dcwl but preserve skip count in upper char
	cx2a		calculate dcwlst length
	sba	t.dcwa,1
	orsa	t.dcwl,1	and put it in tib
	lda	t.line,1	get high-order bit of
	arl	9	line number
	tze	dcw090-*
	tsy	ihdcw-*,*	hsla
	tra	dcwbak-*
dcw090	null
	tsy	ildcw-*,*	lsla
*
dcwbak	return	dcwcnt
*
*
ihdcw	ind	hdcw	hsla dcwlst processor
ildcw	ind	ldcw	lsla dcwlst processor
*
l.e001	zero	0,b.0	to switch to char addressing
l.e002	oct	477
l.e003	oct	400
l.e004	oct	77777
l.e005	oct	777
l.e006	oct	514	control string byte - seteom
l.e007	oct	777000
	ttls	subroutines for copying into replay chain
	rem
copybf	subr	cop,(x2)
	rem
	rem		this routine is called to copy an input buffer
	rem		into the replay chain
	rem		inputs:
	rem		    x2 contains virtual pointer to input buffer
	rem		     a contains buffer tally
	rem
	rem		outputs:
	rem		    x3 points to last buffer in replay chain
	rem		     but buffer ptw is restored to its original
	rem		     value
	rem
	iera	-1	negate the tally
	iaa	1
	sta	citly-*	save it
	lda	a.i002-*,*	.crbpe,*
	sta	cspte-*	save "source" page table entry
	ldq	0,2,b.0	get first character now (x2 will be
	rem		temporarily invalid)
	rem
	szn	t.rcp,1	have we started building the chain yet?
	tnz	cop010-*	yes
	tsy	cgetbf-*	no, get a buffer to start it with
	rem
	stz	cpos-*	column position starts at zero
	ila	10	first tab stop is 10
	sta	ctab-*
	tra	cop030-*
	rem
cop010	ldx3	clchar-*	get pointer to next place to store char
	rem
cop030	cmpq	tabchr-*	is it a tab?
	tnz	cop070-*	no
	lda	t.flg,1	yes, are we in tab echo?
	cana	l.i003-*	=tftbec
	tnz	cop050-*	yes
	tsy	cpchar-*	no, put tab in buffer
	ldq	delchr-*	now we'll put in delays for the real tab
	ila	3	three of 'em
	rem
cop040	tsy	cpchar-*	put one in replay buffer
	iaa	-1
	tnz	cop040-*	do another if not finished
	rem
	tra	cop090-*	ok, done with this char
	rem
cop050	lda	ctab-*	we're in tab echo, how many spaces?
	sba	cpos-*	this many
	ilq	space
cop060	tsy	cpchar-*	put it in
	iaa	-1	more?
	tnz	cop060-*	yes
	rem
	lda	ctab-*	update column position
	sta	cpos-*
	iaa	10
	sta	ctab-*	and next tab stop
	tra	cop090-*
	rem
cop070	tsy	cpchar-*	not a tab, store it
	lda	t.flg,1	tab echo?
	cana	l.i003-*	=tftbec
	tze	cop090-*
	lda	cpos-*	yes, update position
	cmpq	bschar-*	which way did we go?
	tnz	cop080-*
	iaa	-1	backspace
	tra	2
cop080	iaa	1	forward
	sta	cpos-*
	cmpa	ctab-*	did we reach next tab stop?
	tmi	cop090-*
	ila	10	yes, update tab stop
	asa	ctab-*
	rem
cop090	lda	cspte-*	restore source pte
	sta	a.i002-*,*	.crbpe,*
	iacx2	0,b.1	bump input pointer
	ldq	0,2,b.0	get next character
	aos	citly-*	have we done it all?
	tnz	cop030-*	no, process next char
	rem
	stx3	clchar-*	done, save character position in buffer
	ldx3	clast-*	return buffer pointer for gtinpt
	return	copybf
	eject
cpchar	subr	cpc,(a,q,x2)
	rem
	rem		this subroutine stores the character
	rem		passed in the q into the replay chain
	rem		pointed into by x3, updating x3 as appropriate
	rem
	lda	ctpte-*	use target pte
	sta	a.i002-*,*	.crbpe,*
	rem
	szn	cotly-*	is there room?
	tnz	cpc010-*	yes
	tsy	cgetbf-*	no, get a buffer
	rem		x3, cotly, and clast are also updated now
cpc010	stq	0,3,b.0
	iacx3	0,b.1
	aos	cotly-*
	ldx2	clast-*	get buffer pointer
	aos	bf.tly,2	keep tally accurate
	return	cpchar
	eject
cgetbf	subr	cge,(q,x2)
	rem
	rem		this subroutine allocates a buffer
	rem		for adding to the replay chain
	rem		address at which first char is to be stored
	rem		is returned in x3
	rem
	ilq	bufsiz
	tsy	a.i001-*,*	getbfh
	die	18	bad news if we couldn't get one
	rem
	ilq	-bufnch	initialize negative tally
	stq	cotly-*
	ldq	a.i002-*,*	(.crbpe,*) hang on to pte
	rem		(set by getbfh)
	rem
	szn	t.rcp,1	is there a chain already?
	tnz	cge010-*	yes, ok
	sta	t.rcp,1	no, this is the beginning of it
	tra	cge020-*
cge010	ldx2	ctpte-*	use old target pte
	stx2	a.i002-*,*	.crbpe,*
	sta	clast-*,*	set forward pointer in preceding buffer
	stq	a.i002-*,*	(.crbpe,*) restore latest pte
cge020	stx3	clast-*	this is last one now
	stq	ctpte-*	and this is corresponding pte
	rem
	cx3a		point to beginning of data
	ada	l.i001-*	=bf.dta,b.0
	cax3
	return	cgetbf
	rem
	rem
a.i001	ind	getbfh
a.i002	ind	.crbpe,*
	rem
l.i001	zero	bf.dta,b.0
*l.i002		unused
l.i003	vfd	18/tftbec
	rem
citly	bss	1	residual source tally (negative)
cotly	bss	1	residual target tally (negative)
cpos	bss	1	current column position
ctab	bss	1	next tab stop
clast	bss	1	pointer to last buffer in replay chain
clchar	bss	1	pointer to next place for replay character
cspte	bss	1	source page table entry
ctpte	bss	1	target page table entry
	rem
tabchr	bss	1	tab character for this terminal
delchr	bss	1	pad character
bschar	bss	1	backspace
	ttls	scanop subroutine processes both inscan and outscn block
*
scanop	subr	sca
*
	sta	isctyp-*,*	set scan type
	stx2	iscsx2-*,*	save x2 value during scan
	lda	a.a014-*,*	sccbpe
	sta	a.a012-*,*	(.crbpe,*) get previous buffer pte so that
	rem		saved value of pbufp will work
	lda	1,2	get control string address
	ora	l.u001-*	0,b.0
	sta	iscstr-*,*	save control string byte address
sca000	null		get next byte from control string
	tsy	iscnxt-*,*	via subroutine
	tra	a.a004-*,*	(sca260) end of control string
	tra	sca004-*	control byte = 5xx
	tra	sca001-*	error - literal in control string
	rem
sca004	ana	l.u002-*	=o77 - isolate scan subop
	tnz	2	zero not allowed
	die	15	error in control string
	rem
	icmpa	sca003	check for max subop
	tmi	2
	die	15	error in control string
	cax3
	adcx3	sca002-*	add address of jump table
	tra	0,3*	go to subop routine
sca002	zero	*	address of jump table
*		                        subop jump table        
	ind	sca010	match for equal
	ind	sca020	search for char
	ind	sca030	ignore
	ind	sca040	start bcc computation
	ind	sca050	find end of chain
	ind	sca060	compare bcc
	ind	sca070	compare with mask
	ind	sca080	rescan
	ind	sca090	start lrc computation
	ind	sca100	insert lrc
	ind	sca110	compare lrc
	ind	sca120	set last buffer in message flag
	ind	sca130	replace current char
	ind	sca140	compare with list
	ind	sca150	move byte
	ind	sca160	move byte with mask
	ind	sca170	count chars
	ind	sca180	search for match on either of two values
	ind	sca190	turn on bits in char
	ind	sca200	turn off bits in char
	ind	sca210	check sync termination char
	ind	sca220	move last two chars in message to tib extension
	ind	sca230	skip to next char, update block check
sca003	equ	*-sca002	defines end of jump table
	rem
sca001	die	15	error in control string
	eject
sca010	null		match for equal
	tsy	ischkc-*,*	get compare value
	die	15	error in control string
	sta	scwrk1-*	save byte for compare
	tsy	isgtch-*,*	pick up char.
	tra	a.a005-*,*	(=sca300) no char, forget it
*
	cmpa	scwrk1-*	see if it's the match char
	tnz	a.a005-*,*	(=sca300) no
	tra	sca000-*	yes
*
*
*
*
sca020	null		search for char
	tsy	ischkc-*,*	get search value
	die	15	error in control string
	sta	scwrk1-*	save for compare
	tsy	isgtch-*,*	get char, without bumping pointer
	tra	a.a005-*,*	(=sca300) if any
sca022	null
	szn	a.a009-*,*	(=scbccf) are we in process of block check
	tze	2
	ersa	a.a008-*,*	(=scbcc) yes, do it
	cmpa	scwrk1-*	check against search char.
	tze	sca000-*	got it
	szn	a.a007-*,*	(=sccntf) are we in process of char count
	tze	2	no
	tsy	a.a006-*,*	(=scount) go ahead and count this char
	tsy	iscnex-*,*	no match, bump pointer
	tra	a.a005-*,*	(=sca300) if not possible, fail
	tra	sca022-*	else, go look at char
*
*
*
sca230	null		skip char, but update block check
	szn	a.a009-*,*	(=scbccf) block check in progress ?
	tze	sca030-*	no
	tsy	isgtch-*,*	get current char
	tra	a.a005-*,*	(=sca300) end of data
	ersa	a.a008-*,*	(=scbcc) update block check
	rem
sca030	null		ignore
	tsy	iscnex-*,*	skip over next char.
	tra	sca032-*	trying to skip past end, add more room
sca031	szn	a.a007-*,*	(=sccntf) are we in process of char count
	tze	2	no
	tsy	a.a006-*,*	(=scount) go ahead and count this char
	tra	sca000-*
	rem
sca032	szn	isctyp-*,*	check scan type
	tze	a.a005-*,*	(=sca300) inscan, fail can't add
	rem
	ldx3	a.a001-*,*	(=pbufp)
	lda	bf.tly,3	get buffer tally
	ana	l.k001-*	(=buftmk) leave only tally
	icmpa	bufnch	compare to max tally
	tmi	sca033-*	ok, will fit here
	rem
	lda	bf.flg,3	get buffer flags
	ana	l.k002-*	(=bfflst) save last flag
	sta	scasva-*
	iera	-1	invert it
	ansa	bf.flg,3	make sure it's off
	rem
	cx3a		we will save its absolute address
	tsy	a.a011-*,*	cvabs
	sta	scaprv-*
	lda	bf.nxt,3
	sta	scasvn-*	save forward pointer from current last buffer
	ilq	bufsiz	get a new one
	tsy	a.i001-*,*	=getbuf
	tra	a.a005-*,*	=sca300, scan fails
	sta	scacur-*	save absolute address of new buffer
	lda	scasvn-*	forward pointer from old last pointer
	sta	bf.nxt,3	chain after current buffer
	ldq	a.a012-*,*	(.crbpe,*) hang on to pte (protect from setbpt)
	lda	scaprv-*	get previous buffer back
	tsy	a.a013-*,*	setbpt
	cax2
	lda	scacur-*
	sta	bf.nxt,2	make old last buffer point at current
	stq	a.a012-*,*	(.crbpe,*) restore pte
	rem
	lda	scasva-*	get saved a
	sta	bf.flg,3	set last flag same as before
	rem
	ila	1
	sta	a.a002-*,*	(=ptally) and set to one
	cx3a		get ptr to buffer
	iaa	bf.dta	add offset to data
	ora	l.k003-*	point to data
	sta	a.a003-*,*	(=pdatp) store
	stx3	a.a001-*,*	(=pbufp) save buffer addr too
	rem
	aos	bf.tly,3	bump tally up one
	tra	sca031-*
	rem
sca033	aos	bf.tly,3
	tsy	iscnex-*,*	now bump pointers, we made room
	die	15	die if room not found
	tra	sca031-*
	rem
l.k001	vfd	18/buftmk
l.k002	vfd	18/bfflst
l.k003	zero	0,b.0	for character addressing
a.a001	ind	pbufp
a.a002	ind	ptally
a.a003	ind	pdatp
a.a004	ind	sca260
a.a005	ind	sca300
a.a006	ind	scount
a.a007	ind	sccntf
a.a008	ind	scbcc
a.a009	ind	scbccf
a.a010	ind	scend
a.a011	ind	cvabs
a.a012	ind	.crbpe,*
a.a013	ind	setbpt
a.a014	ind	sccbpe
	rem
scaprv	bss	1
scacur	bss	1
scasvn	bss	1
scasva	bss	1
*
*
*
sca040	null		start bcc computation
sca090	null		start lrc computation
	aos	a.u003-*,*	(scbccf) turn flag on
	stz	a.u004-*,*	(scbcc) initialize block check char
	tra	sca000-*	all done
*
scwrk1	bss	1	work area
*
*
*
sca050	null		find end of chain
	tsy	a.a010-*,*	(scend)
	tra	sca300-*	wasn't any chain
	tra	sca000-*	ok, get next byte
*
*
*
sca060	null		compare bcc
sca110	null		compare lrc
	szn	a.u003-*,*	(scbccf) make sure we were doing it
	tnz	2
	die	10
*
	stz	a.u003-*,*	(scbccf) turn off flag
	tsy	a.u002-*,*	(=sgtchr) get next char
	tra	sca300-*	if any
*
	cmpa	a.u004-*,*	(scbcc) is block check correct?
	tnz	sca300-*	no
	tra	sca000-*	yes
*
*
*
sca070	null		compare with mask
	tsy	a.u001-*,*	(=schkcc) get compare value
	die	15	error in control string
	sta	scwrk2-*	save compare value
	tsy	a.u001-*,*	(=schkcc) get mask value
	die	15	error in control string
	sta	scwrk3-*	save mask value
	ansa	scwrk2-*	mask compare value
*
	tsy	a.u002-*,*	(=sgtchr) get next char
	tra	sca300-*	if we can
	ana	scwrk3-*	apply the mask
	cmpa	scwrk2-*	match?
	tnz	sca300-*	no, fail
	tra	sca000-*
*
l.u001	zero	0,b.0
l.u002	oct	77
	rem
a.u001	ind	schkcc
a.u002	ind	sgtchr
a.u003	ind	scbccf
a.u004	ind	scbcc
	rem
scwrk2	bss	1	work area
scwrk3	bss	1
scwrk4	bss	1
	rem
ipbufp	ind	pbufp
iscstr	ind	sccstr
iscnxt	ind	sccnxt
iscsx2	ind	scsvx2
isctyp	ind	scntyp
ischkc	ind	schkcc
isgtch	ind	sgtchr
iscnex	ind	scnext
*
*
*
sca080	null		rescan - initialize pointers and flags
	tsy	scinit-*	call scan init subroutine
	tra	sca000-*
*
*
*
sca100	null		insert lrc
	rem
	szn	scbccf-*	were we doing bcc?
	tnz	2	ok
	die	15	no, kill it
	rem
	stz	scbccf-*	clear flag, used bcc value
	tsy	isgtch-*,*	get addr of byte
	die	15	error in control string
	rem
	lda	scbcc-*	get bcc value
	sta	0,3,b.0	put into msg
	tra	sca000-*
*
*
*
sca120	null		set last buffer in message flag
	ldx3	a.a001-*,*	(=pbufp) get addr of current buffer
	lda	l.s008-*	(=bfflst) get last buffer in message flag
	orsa	bf.flg,3	turn it on
	tra	sca000-*
*
*
*
sca130	null		replace current char
	tsy	isgtch-*,*	get byte address of next char in chain
	tra	sca300-*	none
	tsy	ischkc-*,*	get replace value
	die	15	error in control string
	sta	0,3,b.0	replace current char
	tra	sca000-*
*
*
*
sca140	null		compare with list
	tsy	sgtchr-*	get next char in chain
	tra	sca300-*	none - failure
	sta	scwrk3-*	save for compare
sca144	tsy	a.s003-*,*	(=sccnxt) get value from control string
	tra	sca300-*	end of control string - failure
	tra	sca300-*	5xx - failure
	tsy	a.s002-*,*	(=adbyte) check for 46x
	tra	sca148-*	not 46x
	lda	0,3,b.0	get tib byte value
sca148	cmpa	scwrk3-*	match?
	tze	sca146-*	yes
	tra	sca144-*	keep looking
sca146	tsy	a.s003-*,*	(=sccnxt) just pass by values
	tra	sca260-*	end of control string
	tra	sca004-*	5xx
	tra	sca146-*
*
*
*
sca150	null		move byte
	tsy	a.s003-*,*	(=sccnxt) get 46x value
	tra	1
sca152	die	15	error - must be 46x
	tsy	a.s002-*,*	(=adbyte) get byte address
	tra	sca152-*	not 46x
	stx3	scwrk2-*	save byte address
	ila	-1
sca154	sta	scwrk3-*	prime mask area
	tsy	sgtchr-*	get next char and address
	tra	sca300-*	none
	ana	scwrk3-*	mask char
	ldx3	scwrk2-*	get byte address
	sta	0,3,b.0	place in tib
	tra	sca000-*
*
*
*
sca160	null		move byte with mask
	tsy	iscnxt-*,*	get 46x value
	tra	1
sca162	die	15	error - must be 46x
	tsy	a.s002-*,*	(=adbyte) get byte address
	tra	sca162-*	not 46x
	stx3	scwrk2-*	save byte address
	tsy	schkcc-*	get mask value
	tra	sca162-*	error - in control string
	tra	sca154-*	same as move byte
*
*
*
sca170	null		count chars
	tsy	iscnxt-*,*	get 46x value
	tra	1
sca172	die	15	error - must be 46x
	tsy	a.s002-*,*	(=adbyte) get byte address
	tra	sca172-*	not 46x
	stx3	sccnta-*	save byte address for count accumulation
	stz	0,3,b.0	zero count in tib
	aos	sccntf-*	set count flag
	tra	sca000-*
*
*
*
sca180	null		search for match on either of two values
	tsy	schkcc-*	get first search value
	die	15	error in control string
	sta	scwrk3-*	save for compare
	tsy	schkcc-*	get second search value
	die	15
	sta	scwrk4-*
	tsy	sgtchr-*	get char, w/o bumping ptr
	tra	sca300-*	fail if none
sca182	null
	szn	scbccf-*	are we in process of block check
	tze	2
	ersa	scbcc-*	yes, do it
	cmpa	scwrk3-*	check vs first value
	tze	a.s001-*,*	(sca000) got it
	cmpa	scwrk4-*	check vs second value
	tze	a.s001-*,*	(sca000) got it
	szn	sccntf-*	are we in process of char count
	tze	2
	tsy	scount-*	go ahead and count this char
	tsy	iscnex-*,*	no match, bump ptr
	tra	sca300-*	fail, no more chars
	tra	sca182-*	else, go look at char
*
*
*
sca190	null		turn on bits in char
	tsy	schkcc-*	get bit pattern
	die	15	error - in control string
	sta	scwrk2-*	save
	tsy	sgtchr-*	get next char address
	tra	sca300-*	no next char
	lda	scwrk2-*	get bit pattern
	orsa	0,3,b.0	turn on bits
	tra	a.s001-*,*	(=sca000) done
*
*
*
sca200	null		turn off bits in char
	tsy	schkcc-*	get bit pattern
	die	15	error in control string
	sta	scwrk2-*	save
	tsy	sgtchr-*	get next char address
	tra	sca300-*	no next char
	lda	scwrk2-*	get bit pattern
	orsa	0,3,b.0	turn bits on
	ersa	0,3,b.0	now really turn them off
	tra	a.s001-*,*	(=sca000)
*
*
*
sca210	tsy	schkcc-*	get char from control string
	die	15	error in control string
	sta	scwrk4-*	save for compare
	stz	sca216-*	reset flag
	rem
sca215	ldx3	a.s007-*,*	(pbufp) get ptr to head of list
	stz	sccbuf-*	zero prev buf ptr
sca211	lda	bf.flg,3	get flag bits
	cana	l.s008-*	(=bfflst) last buffer in msg?
	tnz	sca212-*	yes, use this buffer
	rem
	szn	bf.nxt,3	more in chain?
	tze	sca212-*	no, use this one
	rem
	cx3a		get absolute address
	tsy	a.s005-*,*	cvabs
	sta	sccbuf-*	save ptr to this buffer
	lda	bf.nxt,3	bump to next
	tsy	a.s004-*,*	setbpt
	cax3
	tra	sca211-*
	rem
sca212	stx3	a.s007-*,*	(pbufp) remember where we are
	cx3a		copy to a
	iaa	bf.dta	point at data
	ora	l.s002-*	with char addressing
	sta	a.s008-*,*	(pdatp) save
	rem
	lda	bf.tly,3	get tally in buffer
	ana	l.s001-*	(=buftmk) only tally
	icmpa	2	at least two chars in this buffer?
	tmi	sca214-*	no, must use prev buffer
	rem
	iaa	-2	backup to look at term char
	lrl	1	divide by two (save bit)
	asa	pdatp-*	add into ptr
	ldx3	pdatp-*	get it
	rem
	lls	1	get bit back
	icana	1	on?
	tze	sca213-*	ok as is
	rem
	iacx3	0,b.1	bump ptr to odd char
	stx3	pdatp-*	save ptr always
sca213	szn	sca216-*	check flag
	tnz	sca224-*	move 2 chars
	lda	0,3,b.0	get the supposed term char
	cmpa	scwrk4-*	is this it?
	tze	a.s001-*,*	(=sca000) yes, we got it...
	rem
	tra	sca300-*	fail
	rem
	rem	since we know bcc was in last buffer, etx must be
	rem	last char in this buffer.
	rem
sca214	lda	sccbuf-*	get ptr to next-to-last buffer
	tze	sca300-*	fail - not two chars in message
	tsy	a.s004-*,*	setbpt
	sta	sccntl-*	save virtual address of buffer
	iaa	bufsiz-1	point to last word
	ada	l.s009-*	(=0,b.1) and last char
	cax3		copy to index reg
	szn	sca216-*	check flag
	tnz	sca226-*	move 2 chars
	ldq	0,3,b.0	else get character for comparison
	ldx3	sccntl-*	get address of buffer
	lda	bf.nxt,3	get address of last buffer again
	tsy	a.s004-*,*	(setbpt) restore pte
	cmpq	scwrk4-*	now test the character
	tze	a.s001-*,*	(=sca000) success
	tra	sca300-*	failure
*
sca216	bss	1	flag for move last two chars to tib
*
*
*
sca220	null		move last two chars to tib extension
	stz	sca216-*	reset flag
	tsy	sccnxt-*	get 46x value
	tra	1	not 46x
sca222	die	15	error in control string
	tsy	adbyte-*	get byte address
	tra	sca222-*	not 46x
	stx3	scwrk3-*	save first char addr
	tsy	sccnxt-*	get second 46x value
	tra	sca222-*	not 46x
	tra	sca222-*	not 46x
	tsy	adbyte-*	get byte addr
	tra	sca222-*	not 46x
	stx3	scwrk4-*	save second char addr
	aos	sca216-*	set flag
	tra	sca215-*	do search for last chars
sca224	null		return from search
	lda	0,3,b.0	get second to last char
	iacx3	0,b.1	bump to next char
	stx3	pdatp-*	always save current ptr
	ldq	0,3,b.0	get last char
	tra	sca227-*	store into tib ext
sca226	null		return - last two chars split between buffers
	ldx2	0,3,b.0	get second to last char
	ldx3	sccntl-*	get pointer to beginning of next-to-last
	lda	bf.nxt,3	get last
	tsy	a.s004-*,*	(setbpt) restore pte
	cx2a		get character into a
	ldx3	pdatp-*	get data ptr - last buffer
	ldq	0,3,b.0	get last char
sca227	null		store two chars into tib ext
	ldx3	scwrk3-*	place to store next to last
	sta	0,3,b.0	into tib ext
	ldx3	scwrk4-*	and last char
	stq	0,3,b.0	into tib ext, too
	tra	a.s001-*,*	(=sca000)done
*
*
*
sca260	null		scan was a success
	ldx2	scsvx2-*	get scan block address
	iacx2	3	go to next block
scabak	null
	lda	a.s006-*,*	.crbpe,*
	sta	sccbpe-*	save pte in case of another scan
	return	scanop
*
*
*
sca300	null		general scan failure
	ldx2	scsvx2-*	get scan block address
	ldx2	2,2	get branch point
	tra	scabak-*
*
*
l.s001	vfd	18/buftmk	buffer tally mask
l.s002	zero	0,b.0	for char addressing
l.s003	oct	77777	for word addressing
l.s004	oct	77	mask for 5xx values
l.s005	oct	777	end of control string designator
l.s006	oct	700	5xx mask
l.s007	oct	500	test value
l.s008	vfd	18/bfflst	last buffer in message flag
l.s009	ind	0,b.1
	rem
a.s001	ind	sca000
a.s002	ind	adbyte
a.s003	ind	sccnxt
a.s004	ind	setbpt
a.s005	ind	cvabs
a.s006	ind	.crbpe,*
a.s007	ind	pbufp
a.s008	ind	pdatp
	rem
sccbpe	bss	1	safe store for pte
scbcc	bss	1	cumulative block check char
scbccf	bss	1	block check in progress flag
tmask	bss	1	place to save masked char.
scntyp	bss	1	input or output scan indicator
	rem		=0, input scan
	rem		=1, output scan
scsvx2	bss	1	save area for scan block address
sccstr	bss	1	control string byte address
sccnta	bss	1	byte address - char count accumulation
sccntf	bss	1	char count in progress flag
sccbuf	bss	1	absolute ptr to next-to-last buffer
sccntl	bss	1	virtual pointer to same
	ttls	utilities for scan
*
*	scount increments tib extension byte designated by count scan subop
*	max accumulated count = 511
*
scount	subr	sco,(a,x3)
	ldx3	sccnta-*	get accumulation byte address
	lda	0,3,b.0	get accumulation byte
	iaa	1	increment it
	ana	l.s005-*	=o777
	tze	2	overflow
	sta	0,3,b.0	place it back in tib
	return	scount
*
*	scinit subroutine initializes scan pointers
*
scinit	subr	sci
	lda	t.icp,1	get input chain pointer
	szn	scntyp-*	check scan type - input or output
	tze	sci010-*	input
	lda	t.ocp,1	get output chain pointer
sci010	null
	tsy	a.s004-*,*	setbpt
	sta	pbufp-*	save virtual address
	szn	pbufp-*
	tze	scibak-*	no chain, forget it
	stz	ptally-*	zero out scan tallies
	aos	ptally-*	pointing at char now
	iaa	bf.dta	point to data
	ora	l.s002-*	0,b.0
	sta	pdatp-*	save data pointers
scibak	null
	stz	scbccf-*	zero block check flag
	stz	sccntf-*	zero char count in progress flag
	return	scinit
*
*	sgtchr  uses pointers to find current char and return it in a
*		it does not advance the pointers        
*		output - return1 = no more chars        
*		         return2 = current char in a        
*
sgtchr	subr	sgt
	szn	pbufp-*	check buffer pointer
	tze	sgtbak-*	none exists
	rem
	ldx3	pdatp-*
	lda	0,3,b.0
	aos	sgtchr-*	did it
	rem
sgtbak	return	sgtchr
*
*	schkcc gets next byte from control string and checks for 777,5xx values
*	if byte = 46x then its tib value is returned in a
*	output - return1 = byte in a = 777 or 5xx
*		return2 = byte in a        
*
schkcc	subr	sch,(x3)
	tsy	sccnxt-*	get control string byte
	tra	schbak-*	777
	tra	schbak-*	5xx
	tsy	adbyte-*	check for 46x
	tra	sch020-*	not 46x
	lda	0,3,b.0	get byte value
sch020	aos	schkcc-*	return2
schbak	null
	return	schkcc
*
*	scnext bumps character pointers
*	returns to location after call if no more chars,
*	otherwise puts char in a and returns two locations past call
*
scnext	subr	scn,(x3)
*
	ldx3	pbufp-*	any buffer at all?
	tze	scnbak-*	no, done
	rem
	lda	bf.tly,3	get the buffer tally
	ana	l.s001-*	(=buftmk) only tally
	cmpa	ptally-*	any chars left to look at?
	tmi	2	no, over the limit now
	tnz	scn020-*	yes, process
	rem
	lda	bf.flg,3	get flag bits
	cana	l.s008-*	(=bfflst) last buffer in msg?
	tnz	scnbak-*	yes, done
	rem
	lda	bf.nxt,3	get fwd ptr
	tze	scnbak-*	none, give up
	rem
	tsy	a.s004-*,*	setbpt
	sta	pbufp-*	new buffer
	iaa	bf.dta	nake ptr to data
	ora	l.s002-*	add in char addressing
	sta	pdatp-*	save ptr
	stz	ptally-*
	cax3		copy ptr to x3
	tra	scn030-*	finish up
	rem
scn020	ldx3	pdatp-*	load ptr to char
	iacx3	0,b.1	bump it
	stx3	pdatp-*	save
scn030	aos	ptally-*	bump tally
	lda	0,3,b.0	load char
	rem
	aos	scnext-*	indicate good bump
scnbak	return	scnext
*
*	sccnxt places next byte from scan control string into a
*	output - return1 = end of control string - byte in a = 777
*		return2 = byte in a = 5xx        
*		return3 = byte in a = xxx        
*
sccnxt	subr	scc,(x2)
	ldx2	sccstr-*	get control string byte address
	lda	0,2,b.0	get control string byte
	cmpa	l.s005-*	=o777
	tze	sccbak-*	end of control string
	iacx2	0,b.1	advance to next byte
	stx2	sccstr-*	save
	caq
	ana	l.s006-*	=o700
	cmpa	l.s007-*	=o500 - scan subop designator
	tze	scc010-*
	aos	sccnxt-*	return 3
scc010	aos	sccnxt-*	return 2
	cqa		retrieve control string byte
sccbak	return	sccnxt
*
*
*	scend implements the end-of-chain subop, setting
*	the pointers to the last character in the chain
*	output - return1 = no chain
*		return2 = found it
*
scend	subr	sce
	ldx3	pbufp-*	get buffer pointer
	tze	scebak-*	fail if no chain
sce010	lda	bf.flg,3	see if this is last one
	cana	l.t006-*	bfflst
	tnz	sce020-*	yes it is
	szn	bf.nxt,3	not marked as such, is there another?
	tze	sce020-*	no, use this one
	lda	bf.nxt,3	yes, on to next
	tsy	a.s004-*,*	setbpt
	cax3
	tra	sce010-*
sce020	null
	stx3	pbufp-*	this is current one now 
	lda	bf.tly,3	get tally
	ana	l.t007-*	buftmk
	sta	ptally-*
	rem
	iaa	-1	less one for last char
	lrl	1	divide by two to get word offset
	ada	pbufp-*	make a pointer out of it
	ada	l.t008-*	bf.dta,b.0
	cax3		put into x3 for now
	lls	1	get low order bit back
	icana	1	is low order bit on?
	tze	2	nope, ok
	iacx3	0,b.1	bump by one char
	stx3	pdatp-*
	aos	scend-*	bump return pointer
scebak	return	scend
*
*
*
	even
	rem		permanent scan pointers
pbufp	bss	1	virtual address of current buffer
ptally	bss	1
pdatp	bss	1	virtual address of current character
*
*	subroutine to form an address in q of a byte in tib extension
*	input - a = char value from scan control string
*	output - return1 = char value not 46x
*		return2 = x3 contains byte address        
*
adbyte	subr	adb,(a)
	caq		save input value
	ana	l.t001-*	=o760 - check for 46x
	cmpa	l.t002-*	=o460
	tze	adb010-*	ok - form byte address
	tra	adbbak-*	input not 46x
adb010	ldx3	t.elnk,1	get tib extension address
	tnz	2	one exists
adb020	die	14
	lda	0,3	get length
	als	1	times 2 = char count
	sta	adb100-*
	cqa
	ana	l.t004-*	=o17 - isolate byte designator
	cmpa	adb100-*	vs max + 1 byte position
	tmi	2	ok - within range
	tra	adb020-*
	caq
	cx3a
	ora	l.t005-*	=0,b.1 - make into byte address
	cax3
adb030	iacx3	0,b.1	advance address - one byte
	iaq	-1	decrement byte position
	tmi	adb040-*	all done
	tra	adb030-*
adb040	null
	aos	adbyte-*	advance return point
adbbak	return	adbyte
adb100	bss	1	work area
	rem
	rem
l.t001	oct	760	mask
l.t002	oct	460	byte position designator
l.t003	oct	77	sub-buffer tally mask
l.t004	oct	17	byte position   mask
l.t005	zero	0,b.1	address advance value
l.t006	vfd	18/bfflst
l.t007	vfd	18/buftmk
l.t008	zero	bf.dta,b.0
l.t009	zero	0,b.0
l.t010	oct	514	seteom
*
* Utility to build a message
*
bldutl	subr	bld
	ilq	bufsiz
	tsy	a.m003-*,*	(=getbfh) get a bufsiz buffer
	tra	bldret-*	no buffers available
	sta	bld099-*	save absolute
	stx3	bld092-*	and virtual address
	rem
	cx3a
	ada	l.t008-*	(=bf.dta,b.0) point to data
	sta	bld096-*	save
	rem
	lda	1,2	get control string address
	ora	l.t009-*	(=0,b.0)
	sta	a.m001-*,*	(=sccstr) save for sccnxt subroutine
	rem
	ila	-bufnch	max number chars in buffer
	sta	bld098-*	save for count down
	stz	bld090-*	zero tally count
bld010	tsy	a.m002-*,*	(=sccnxt) get next byte from control string
	tra	bld040-*	end of control string
	tra	bld030-*	control byte = 5xx
	tsy	adbyte-*	literal or tib byte?
	tra	bld020-*	must be a literal, store it
	lda	0,3,b.0	get the char from the tib
bld020	ldx3	bld096-*	get ptr to data in buffer
	sta	0,3,b.0	store char in buffer
	iacx3	0,b.1	bump ptr
	stx3	bld096-*
	rem
	aos	bld090-*	bump tally
	aos	bld098-*	decrement max tally
	tze	bld050-*	control string too long
	tra	bld010-*	ok, get next byte
	rem
bld030	cmpa	l.t010-*	(=o514) - check for seteom
	tnz	bld050-*	error - not seteom
	rem
	ldx3	bld092-*	get buffer address
	lda	l.t006-*	(=bfflst) get last buffer in message flag
	orsa	bf.flg,3	set on in buffer
	tra	bld010-*
	rem
bld040	ldx3	bld092-*	get buffer address
	lda	bld090-*	get tally count
	tze	bld050-*	no chars placed in buffer
	orsa	bf.tly,3	place tally in buffer
	aos	bldutl-*	successful return
bldret	return	bldutl
	rem
bld050	lda	bld099-*	get buffer address
	ilq	0
	tsy	a.m004-*,*	(=frebfh) return buffer - error or not used
	tra	bldret-*
	rem
bld090	bss	1	tally count
bld092	bss	1	save area - virtual buffer address
bld096	bss	1	save area - data pointer
bld098	bss	1	max tally count
bld099	bss	1	absolute buffer address
	rem
a.m001	ind	sccstr
a.m002	ind	sccnxt
a.m003	ind	getbfh
a.m004	ind	frebfh
*
intend	null
	end
  



		    mclt.map355                     12/01/82  1453.7rew 12/01/82  1413.3      120996


* ***********************************************************
* *                                                         *
* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *                                                         *
* ***********************************************************
	lbl	,colts
	ttl	 mclt multics hc fnp colts exec rev c 821015
	bci	2,821015
	cpr	1981
*
*
* insert comments on purpose of module
*
*
	pcc	on
	pmc	off
	editp	on
	detail	on
	symdef	mclt
	symdef	colts
	symdef	tdip
	symref	begin
	symref	g3wjt
	symref	mdisp
	symref	secdsp
	symref	dspqur
	symref	getbuf
	symref	setbpt
	symref	frebuf
	symref	itest
	symref	gettib
	symref	setptw
	symref	denq
	symref	tdhung
	symref	cvabs
	pmc	save,on
mclt	null
	start	mclt
	tib
	csbits
	tconst
	hwcm
	sfcm
	buffer
	global
	comreg
	ttls	test tib extension definitions
*
	tibex	tb3wjt,word
	tibex	tbscid,word
	tibex	tbiflg,word
	tibex	tbaicw,word
	tibex	tbaiw2,word
	tibex	tbconf,word
	tibex	tbcnf2,word
	tibex	tberc1,word
	tibex	tberc2,word
	tibex	tbhcrb,word
	tibex	tbcbfs,word
	tibex	tbtmp1,word
	tibex	tbtmp2,word
	tibex	tbtmp3,word
	tibex	tbtmp4,word
	tibex	tbtcur,word
	tibex	tbrtib,word
	tibex	tbaux1,word
	tibex	tbvtib,word
	tibex	tbaux2,word
	tibex	tbbufr,word
	tibex	tbbufs,word
	tibex	tbmtal,word
	tibex	tbbtal,word
	tibex	tbspar,word
	tibex	tbsic1,word
	tibex	tbsice,word
*
 	pmc	restore
	ttls	colts executive line handler
*
colts	tstflg	tflisn,slisn
	wait	0,0,begin
*
slisn	signal	dialup
	wait	0,sendr,tshang
*
tshang	tstflg	tfhang,shang
	waitm
*
shangc	calasm	t6dis
shang	signal	hangup
	goto	tdhung
*
sendr	clrflg	tfwrit
	calasm	tdac1
	tstflg	tfupsf,gtibex
sndicm	calasm	tstc11
	tstflg	tfhang,shangc
	sendin
	signal	sndout
	wait	0,sendr,tshngc
*
tshngc	tstflg	tfhang,shangc
	waitm
*
gtibex	clrflg	tfupsf
	getext	tibxsz,texerr
	calasm	tstc3
	goto	sndicm
texerr	calasm	tstc2
	goto	sndicm
*
	ttls	colts test page line handler
*
ctest	wait	0,schan,tchang
*
tchang	tstflg	tfhang,chang
	waitm
*
chang	calasm	t6dtp
	retext
	signal	hangup
	goto	tdhung
*
schan	clrflg	tfwrit
	calasm	tdac2
schana	tstflg	tfofc,schanb
	calasm	prcmes
stcht	setime	1
	wait	timer,0,tchng
*
tchng	tstflg	tfhang,chang
	tstflg	tfacu,timer
	waitm
*
timer	setime	0
	calasm	timprc
sndtes	tstflg	tfhang,chang
	sendin
	signal	sndout
	goto	ctest
*
schanc	clrflg	tfwrit
	calasm	tdac7
	goto	schana
*
schanb	clrflg	tfofc
	signal	sndout
	wait	0,schanc,tthang
tthang	tstflg	tfhang,chang
	waitm
*
       ttls    process dac icm from 600
tdac1	subr	td1
	lda	t.ocp,1	get outbuf ptr
	sta	t.ocur,1	save as current
	stz	t.ocp,1	clear orig ptr
	iaa	2	step to start of icm
	tsy	xsbpt-*,*	set ptr in buff page table for icm base
	sta	t.occh,1	save relative addr of icm
	cax2		copy icm addr to index reg
	lda	t600cd,2	get command code from icm
	icmpa	toplx2	is it link nrx2?
	tze	lnorx2-*	yes, go link it
	icmpa	toplx1	is it link nrx1?
	tze	lnorx1-*	yes, go link
	ldx2	pnores-*	see if non-res exec already linked
	tze	tdac8-*	no, bad news
	icana	toplk2
	tnz	lkmod2-*	go link tp submod2
	icana	toplk1
	tnz	lkmod1-*	go link tp submod1
	icana	topsrt
	tnz	tstc-*	go start test
tdac8	ila	topinv
prcend	sta	temp3-*	save reply code
	ldx2	zerov-*
	return	tdac1	return to op blocks
*
tstc9	ila	topgo	load op complete code
	tra	prcend-*	and return
       rem
rtdac9	ind	tdac9
*
	ttls	process tp dac icm
*
prcmes	subr	pr2
	ldx2	pnores-*	get nrx1 ptr
	tsy	tpproc,2	process msg
	icmpa	0	is it bad icm?
	tnz	tpdac8-*	yes, send back icm
	ldx2	dsp1bs-*	get tp submod ptr
	lda	rtdac9-*	set up return from submod
	sta	ep15,2	save ptr in submod
	tra	ep11,2	go to submod icm decode
*
tdac9	null
	ldx1	-tbvtib,1	restore test tib ptr
	ldx2	t.elnk,1	get tib ext ptr
	lda	-tbtmp2,2	get desired timer value
	sta	stcht+1-*	save for setime
	ldx2	zerov-*
	return	prcmes
*
tpdac8	ldx2	sndtst-*	get op block return ptr
	return	prcmes
*
tdac2	subr	td2
	ldx2	pnores-*	get nrx1 ptr
	tsy	tpda2,2
	ldx2	zerov-*
	return	tdac2	return to op blocks
*
tdac7	subr	td7
	ldx2	pnores-*	get nrx1 ptr
	tsy	tpda7,2
	ldx2	zerov-*
	return	tdac7	return to op blocks
*
       ttls    return icm to 600/6000
*
tstc11	subr	t11
	ldx2	t.occh,1	get icm ptr
	lda	temp3-*	get reply code
	stz	temp3-*	clear temp loc
	sta	t355cd,2	save reply in exec icm
	ldx3	t.ocur,1	set up inp buff ptrs
	stx3	t.icp,1	first buff addr
	ldx3	t.olst,1	last buff addr
	stx3	t.ilst,1
	ldx3	t.ocnt,1	output buff count
	stx3	t.icpl,1	use as input buff count
	stz	t.ocur,1	clear pointers
	stz	t.occh,1
	ldx2	zerov-*
	return	tstc11	return to op blocks
*
tstc2	subr	tc2
	ila	topbuf	get buffer denial code
	ldx2	zerov-*
	return	tstc2	return to op blocks
*
tstc3	subr	tc3
	ldx2	pnores-*	get ptr to nrx1
	tsy	tptc3,2	set up test channel
	ldx2	zerov-*
	return	tstc3	return to op blocks
*
xsbpt	ind	setbpt	set buffer page base
xcvab	ind	cvabs	convert virtual to abs address
sndtst	ind	sndtes
pnores	ind	**	ptr to nrx1
zerov	oct	0
       ttls    channel test request
*
tstc   null        initiate test start
	ldx2	pnores-*	get nrx1 ptr
	tsy	tptstc,2
	icmpa	topinv	check for bad icm
	tze	prcend-*	invalid icm
	icmpa	topbuf	check for buffer denial

	tze	prcend-*	buff denial return
	tra	tstc9-*	normal return
*
       ttls    line dis connect processor
t6dis	subr	t6d
	ldx2	pnores-*	get nrx1 addr
	tze	t6ret-*	gone, so return
	lda	tpmodu,2	get number of users
	tze	t6ds1-*	none, so release nr exec
	stx1	execfl-*	tp still active so set exec disc flag
	tra	t6ret-*	return
t6ds1	tsy	relex-*	release nr exec
t6ret	ldx2	zerov-*
	return	t6dis	return to op blocks
*
modrsl	zero
	ldq	1,3	load size of buffer
	qrl	10	position to num of wds
	iaq	bufsiz	correct count
	tsy	tdlblk-*,*	release it
	tra	modrsl-*,*	return
*
relex	zero
	ldx2	pnores-*	get nrx1 ptr
	tze	relex-*,*	nr exec gone so return
	ldx3	tpxm2,2	get nrx2 ptr
	tze	rlx1-*	already gone
	tmi	rlx1-*	likewise
	tsy	modrsl-*	release nrx2
rlx1	ldx3	pnores-*	get nrx1 ptr
	tsy	modrsl-*	release nrx1
	stz	pnores-*	clear ptr
	tra	relex-*,*	return
*
t6dtp	subr	t6p
	ldx2	dsp1bs-*	get submod addr
       tze     wrapup-*        submod 1 not loaded
       szn     ep10,2          is part 2 loaded?
       tpl     ep14,2          yes go to submod wrapup
wrapup inh
	ldx2	pnores-*	get ptr to nrx1
	tsy	tpdis,2	go finish disconnect
	eni
	lda	dsp1bs-*	get tp submod ptr
	tnz	wrpend-*	tp still present
	lda	execfl-*	tp gone,check if exec disc
	tze	wrpend-*	exec still active
	tsy	relex-*	release non res exec mods
	stz	execfl-*	clear flag
wrpend	ldx2	zerov-*
	return	t6dtp	return to op blocks
*
execfl	oct	0
*
	ttls	link exec non-resi