.title	natvmode - Native mode code for MERLIN
	.ident	/010100/
;+
; Abstract:	natvmode
;
;	This module is a native mode procedure to implement
;	extended functions for the compatibility mode
;	version of MERLIN which cannot be easily performed
;	in compatibility mode.
;
; Calling sequence:
;
;	= natvmode (xfer_array, cli_callback, ihd, ifd,
;		linkopt, junk, parms)
;
; Arguments:
;
; The only arguments which have any relevance at the
; user level are contained in the 'parms' parameter.
; This is facility-dependent.
;
; Nonstandard features:
;
;	1. Written in Macro-32
;	2. Requires the compatibility mode program to use
;	   the undocumented VMS "elephant" directive.  This
;	   directive allows a compatibility mode program to
;	   execute code in a native mode image.
;
; Written: 03-Apr-1981, -1.0.0-, Bruce C. Wright
; Modified: 25-Nov-1981, -1.1.0-, Bruce C. Wright
;	Changed mailbox names to be prefixed with MBX_ to
;	avoid naming conflicts.
; Verified: 25-Nov-1981, -1.1.0-, Bruce C. Wright
;-

;
; The facilities provided by this module are:
;
;   1.	Reading/writing from VAX/VMS mailboxes.  The facilities
;	provided by the Application Migration Executive are not
;	completely compatible with many PDP-11 systems becuase
;	they do not implement variable-length send/receive
;	(along with several other things like send and request).
;
;   2.	A number of terminal handler functions are not available
;	under the compatibility mode emulator.  In particular,
;	it is not possible to obtain the terminal type and some
;	of the terminal characteristics under the emulator.  The
;	VAX/VMS operating system allows up to 8 foreign terminals
;	(/FT1 through /FT8), and RSX has foreign terminal types
;	defined (T.USR0...) but the compatibility mode emulator
;	translates all foreign terminals to T.UNK (unknown type),
;	making the facility provided by the AME useless in any
;	production setting.
;
;   3.	Running the locally-written SORT package from under the
;	compatibility mode emulator is not possible:  there is
;	no way for a compatibility mode image to execute the
;	native mode sort as a replacement to the compatibility
;	mode sort, the SPWN$ directive does not function properly
;	under compatibility mode, and the send data and request
;	receiver directive only works if the target task is
;	CRF...!  This is a ludicrous state of affairs which this
;	module partially corrects.
;
;   4.	Spooler support is provided in this package.  Although
;	VAX/VMS has a very nice spooler system which is accessable
;	to native mode images, there is no way to use the facility
;	from compatibility mode unless you restrict everything to
;	going to the default queue, one copy, and no forms.  This
;	too is an unsatisfactory situation.
;
; It would be nice to be able to provide these facilities without
; having to go to such lengths to bypass the operating system.
; However, under the current Application Migration Executive, this
; is not possible.  DEC has indicated that they do not consider
; the support of the AME at any reasonable level of functionality
; to be a high priority;  until they do, we must make do as best
; we can any way we can.
;

;
; Define compatibility mode symbols
;
TC.WID	=	1.		; Terminal width
TC.LPP	=	2.		; Length of page in lines
TC.RSP	=	3.		; Receive baud rate
TC.XSP	=	4.		; Transmitter baud rate
TC.STB	=	5.		; Stop bit required
TC.ISL	=	6.		; Subline number on interface
TC.RAT	=	7.		; Readahead type
TC.TTP	=	8.		; Terminal type
TC.SCR	=	9.
TC.SCP	=	10.		; Terminal is a CRT
TC.HFL	=	11.		; Horizontal fill requirement
TC.VFL	=	12.		; Vertical fill required
TC.NL	=	13.		; Terminal generates 'newline,' not 'cr'
TC.SFF	=	14.		; Full simulation of form-feed
TC.HFF	=	15.		; Hardware form-feed available
TC.LVF	=	16.		; LA-36 with vertical format
TC.HHT	=	17.		; Hardware horizontal tab
TC.NST	=	18.		; Nonstandard tab stops
TC.BSP	=	19.		; Backspace is available
TC.ACR	=	20.		; Automatic cr/lf to be supplied
TC.SMR	=	21.		; Enable lower case input
TC.SMP	=	22.		; Force lower case input
TC.SMO	=	23.		; Enable lower case output
TC.CCF	=	24.		; ^C flushes typeahead
TC.ALT	=	25.		; Terminal generates ALTMODE rather than ESC
TC.IMG	=	26.		; No writes/broadcasts from other terminals
TC.NKB	=	27.		; No keyboard (no input from terminal)
TC.NPR	=	28.		; No printer (no output to terminal)
TC.ESQ	=	29.		; Escape sequence support
TC.LCP	=	30.		; Terminal has local copy
TC.PAR	=	31.		; Parity checking to be done
TC.EPA	=	32.		; Terminal has even parity
TC.DLU	=	33.		; Terminal is a dialup line
TC.BLK	=	34.		; Terminal is in block mode
TC.FRM	=	35.		; Terminal is in forms mode
TC.HLD	=	36.		; Terminal in hold screen mode
TC.TAP	=	37.		; Low-speed tape reader available
TC.CEQ	=	38.		; Compatible escape sequences
TC.NEC	=	39.
TC.SLV	=	40.
TC.PRI	=	41.
TC.UC0	=	42.		; User characteristic 0
TC.UC1	=	43.		; User characteristic 1
TC.UC2	=	44.		; User characteristic 2
TC.UC3	=	45.		; User characteristic 3
TC.UC4	=	46.		; User characteristic 4
TC.UC5	=	47.		; User characteristic 5
TC.UC6	=	48.		; User characteristic 6
TC.UC7	=	49.		; User characteristic 7
TC.UC8	=	50.		; User characteristic 8
TC.UC9	=	51.		; User characteristic 9
TC.FDX	=	52.		; Full duplex terminal
TC.BIN	=	53.		; Terminal is in binary mode
TC.REM	=	54.
TC.8BC	=	55.
TC.P8B	=	56.		; Pass-8 bits device
TC.TBF	=	57.
TC.CTS	=	58.
TC.MAX	=	59.
;
; Terminal baud rate equates
;
S.0	=	1.		; 0 baud (line turned off)
S.50	=	2.		; 50 baud
S.75	=	3.		; 75 baud
S.100	=	4.		; 100 baud
S.110	=	5.		; 110 baud
S.134	=	6.		; 134 baud
S.150	=	7.		; 150 baud
S.200	=	8.		; 200 baud
S.300	=	9.		; 300 baud
S.600	=	10.		; 600 baud
S.1200	=	11.		; 1200 baud
S.1800	=	12.		; 1800 baud
S.2000	=	13.		; 2000 baud
S.2400	=	14.		; 2400 baud
S.3600	=	15.		; 3600 baud
S.4800	=	16.		; 4800 baud
S.7200	=	17.		; 7200 baud
S.9600	=	18.		; 9600 baud
S.EXTA	=	19.		; External clock A
S.EXTB	=	20.		; External clock B
;
; Terminal type codes
;
T.UNK0	=	0.		; Unknown terminal
T.AS33	=	1.		; ASR-33 teletype
T.KS33	=	2.		; KSR-33 teletypt
T.AS35	=	3.		; ASR-35 teletype
T.L30S	=	4.		; LA-30S DECwriter
T.L30P	=	5.		; LA-30P DECwriter
T.LA36	=	6.		; LA-36 DECwriter
T.VT05	=	7.		; VT05 terminal
T.VT50	=	8.		; VT50 terminal
T.VT52	=	9.		; VT-52 terminal
T.VT55	=	10.		; VT-55 terminal
T.VT61	=	11.		; VT-61 terminal
T.L180	=	12.		; LA-180 terminal
T.V100	=	13.		; VT-100 terminal
T.L120	=	14.		; LA-120 terminal
T.SCR0	=	15.		; SCRIPS line
T.USR0	=	16.		; User 0
T.USR1	=	T.USR0+1	; User 1
T.USR2	=	T.USR1+1	; User 2
T.USR3	=	T.USR2+1	; User 3
T.USR4	=	T.USR3+1	; User 4
;
; Local terminal types
;
T.PLAS	=	19.		; Plasma panel
T.HP48	=	20.		; HP-2648 terminal
T.HP21	=	21.		; HP-2621 terminal
T.ADM1	=	22.		; ADM-1 terminal
T.AD31	=	23.		; ADM-31 terminal
T.ADM3	=	24.		; ADM-3 terminal
T.MBEE	=	25.		; Minibee terminal
T.SBEE	=	26.		; Superbee terminal
T.DIAB	=	27.		; Diablo terminal
T.GE30	=	28.		; GE-30 hardcopy terminal
T.ACT4	=	29.		; ACT-4 terminal
T.TEKT	=	30.		; Tektronix terminal
T.MICR	=	31.		; Microprocessor terminal

	.mcall	$dibdef, $jpidef, $dcdef, $smrdef
	.mcall	$getdev_s, $assign_s, $dassgn_s
	.mcall	$qiow_s, $crembx_s, $getjpi_s
	.mcall	$waitfr_s, $trnlog_s, $sndsmb_s
;
	$dibdef
	$jpidef		; Job Process Information options
	$dcdef
	$smrdef		; Spooler Symbiont options
;
; Define parameter list
;
p_xfer_array	=	4	; Transfer array
p_cli_callback	=	8	; CLI callback
p_ihd		= 	12	; ihd
p_ifd		=	16	; ifd
p_linkopt	=	20	; link options flags
p_junk		=	24	; ????
p_parms		=	28	; Parameters from compatibility mode
;
; Static storage
;
mbx_read_chan:	.long	0	; Mailbox channel for reading.
sysout:	.ascid	/SYS$OUTPUT/
	.even
;
; Define translation tables
;
	.macro	iasequ	iastype,vmstype,routine
	.word	iastype
	.if b	routine
	.word	0
	.iff
	.word	routine-iastertbl
	.endc
	.long	vmstype
	.endm
iastertbl:
	iasequ	tc.acr,0		; automatic cr/lf to be supplied
	iasequ	tc.alt,0		; terminal requires ALTMODE
	iasequ	tc.bin,tt$m_passall,xbt	; terminal to operate in binary mode
	iasequ	tc.blk,0		; terminal to operate in block mode
	iasequ	tc.bsp,0		; terminal recognises backspace
	iasequ	tc.ceq,0		; compatible escape sequences
	iasequ	tc.ccf,0		; ^C flushes typeahead.
	iasequ	tc.dlu,tt$m_remote,xbt	; dialup line
	iasequ	tc.epa,0		; even parity
	iasequ	tc.esq,tt$m_escape,xbt	; escape sequence support
	iasequ	tc.fdx,0		; full duplex mode
	iasequ	tc.frm,0		; terminal in forms mode
	iasequ	tc.hff,tt$m_mechform,xbt ; terminal recognises form feed and vt.
	iasequ	tc.hfl,0		; horizontal fill requirement
	iasequ	tc.hht,tt$m_mechtab,xbt	; terminal recognises horizontal tab
	iasequ	tc.hld,tt$m_holdscreen,xbt ; terminal in hold screen mode
	iasequ	tc.img,tt$m_nobrdcst,xbt ; no writes from other terminals
	iasequ	tc.isl,0		; subline number on interface
	iasequ	tc.lcp,0		; device has local copy
	iasequ	tc.lpp,0,xpage		; length of page in lines
	iasequ	tc.lvf,0		; LA36 with vertical format option
	iasequ	tc.nkb,0		; no keyboard on device
	iasequ	tc.nl,0			; 'newline' generated instead of 'cr'
	iasequ	tc.npr,0		; terminal has no printer (no output)
	iasequ	tc.nst,0		; nonstandard tab stops
	iasequ	tc.par,0		; parity checking is to be done.
	iasequ	tc.p8b,tt$m_eightbit,xbt ; pass-8 bits device
	iasequ	tc.rat,0		; readahead type
	iasequ	tc.rsp,0,xspeed		; read baud rate
	iasequ	tc.scp,tt$m_scope,xbt	; terminal is scope device
	iasequ	tc.sff,0		; full simulation of form-feed
	iasequ	tc.smo,tt$m_lower,xbt	; lower case output
	iasequ	tc.smp,tt$m_lower,xbt	; force lower case input
	iasequ	tc.smr,tt$m_lower,xbt	; enable lower case input
	iasequ	tc.tap,0		; low-speed tape reader
	iasequ	tc.ttp,0,xtype		; terminal type
	iasequ	tc.stb,0		; stop bit required.
	iasequ	tc.vfl,0		; vertical fill required
	iasequ	tc.wid,0,xwidth		; terminal width
	iasequ	tc.xsp,0,xspeed		; terminal transmit speed
	iasequ	0,0			; end of table
;
; Terminal type table
;
iastertyp:
	.word	dt$_ttyunkn,t.unk0	; Unknown terminal
	.word	dt$_la36,t.la36		; LA-36
	.word	dt$_vt05,t.vt05		; VT05
	.word	dt$_vt52,t.vt52		; VT52
	.word	dt$_vt55,t.vt55		; VT55
	.word	dt$_vt5x,t.vt50		; VT5x
	.word	dt$_la180,t.l180	; LA-180
	.word	dt$_vt100,t.v100	; VT-100
	.word	dt$_la120,t.l120	; LA-120
;
; Local terminal types patched in here
;
	.word	dt$_ft1,t.adm1		; ADM-1
	.word	dt$_ft2,t.ad31		; ADM-31
	.word	dt$_ft3,t.adm3		; ADM-3
	.word	dt$_ft4,t.hp48		; HP-2648
	.word	dt$_ft5,t.hp21		; HP-2621
	.word	dt$_ft6,t.diab		; Diablo
	.word	dt$_ft7,t.tekt		; Tektronix
	.word	dt$_ft8,t.micr		; Microprocessor
	.word	0,0			; End of table

;
; Main line code
;
natvmode::
	.word	^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	p_parms(ap),r11	; Pick up the parameter list.
	casew	(r11)+,#0,#6	; Branch to appropriate routine.
10$:	.word	crembx-10$	; Create mailbox
	.word	reambx-10$	; Read from mailbox
	.word	reimbx-10$	; Read immediate from mailbox
	.word	wrimbx-10$	; Write to mailbox
	.word	simtty-10$	; Simulate Terminal driver
	.word	simsor-10$	; Execute SORT procedure.
	.word	simspr-10$	; Simulate SPR... functions
	movw	#-98,r0		; Ilegal function.
	ret			; And return to the caller.

;
; Function 0.  Create mailbox
;
;	Argument list:
;		(none)
;
crembx:
	bsbw	alloc_mbx		; Allocate mailbox if necessary.
	ret				; And return.

;
; Function 1.  Read from mailbox
;
;	Argument list:
;		code+2 - Address of mailbox buffer
;		code+4 - Length of mailbox buffer
;		code+6 - 8-byte VMS I/O status block
;
;
reambx:
	movl	#io$_readvblk,r8	; Show to read mailbox
	brb	read_mbx		; And read the mailbox
;
; Function 2.  Read immediate from mailbox
;
;	Argument list:
;		code+2 - Address of mailbox buffer
;		code+4 - Length of mailbox buffer
;		code+6 - 8-byte VMS I/O status block
;
; Stack offsets
;
read_buffer	= -16		; Buffer area for sending process name
read_iost	= read_buffer-8	; I/O status block.
read_len	= read_iost-4	; Length of buffer.
read_itmlst	= read_len-16	; Item list for $getjpi service.
read_size	= -read_itmlst	; Size of stack frame.
;
reimbx:
	movl	#io$_readvblk!io$m_now,r8 ; Show to read mailbox
read_mbx:
	subl2	#read_size,sp		; Allocate a stack frame.
	movzwl	(r11)+,r10		; Pick up dest. address.
	movzwl	(r11)+,r9		; Pick up dest. length.
	clrq	(r11)			; Clear I/O status block.
	bsbw	alloc_mbx		; Allocate a mailbox.
	mnegw	#1,(r11)		; -1 => alloc_mbx failed
	blbs	r0,20$			; J if ok.
10$:	brw	90$			; Leave on error.
20$:	mnegw	#2,(r11)		; -2 => Illegal buffer.
	subl2	#6,r9			; Decrement from length of buffer
	bleq	10$			; J if buffer too small.
	$qiow_s	chan=mbx_read_chan, -
		func=r8, -
		iosb=(r11), -
		p1=6(r10), -
		p2=r9
	blbs	r0,30$			; J if success.
	mnegw	#3,(r11)		; -3 => $qio failed
	ret				; And return.
30$:	cmpw	#ss$_normal,(r11)	; Normal return?
	bneq	85$			; J if not.
	addw2	#6,2(r11)		; Adjust size of I/O status block.
	movw	#16,read_itmlst(fp)	; Set length of buffer in item list
	movw	#jpi$_prcnam,read_itmlst+2(fp) ; Set code of item to find.
	moval	read_buffer(fp),read_itmlst+4(fp) ; Set up buffer address.
	moval	read_len(fp),read_itmlst+8(fp) ; Set up return length.
	clrl	read_itmlst+12(fp)	; Signal last entry in item list
	$getjpi_s pidadr=4(r11), -
		itmlst=read_itmlst(fp), -
		iosb=read_iost(fp)
	blbc	r0,60$			; J on error.
	$waitfr_s efn=0			; Wait for request to complete
	blbs	r0,70$			; J on success.
60$:	clrl	read_len(fp)		; Get a zero-length process name.
70$:	movc5	read_len(fp),read_buffer(fp),#^a/ /, -
		#6,(r10)		; Move in the name.
	ret				; And return to the caller.
85$:	mnegw	#4,(r11)		; -4 => Mailbox read failed.
90$:	ret				; And return to the caller.



;
; Subroutine to create a mailbox if necessary.
;
;	Argument list:
;		(none)
;
;	Returns:
;		As returned by system services in r0.
;
; Stack offsets
;
cre_desc	= 0		; Character string descriptor
cre_len		= cre_desc	; Length in character descriptor
cre_addr	= cre_desc+4	; Address in character descriptor
cre_mbxname	= cre_addr+4	; Mailbox name (to be concatenated
				; with below).
cre_name	= cre_mbxname+4	; Returned name of process.
cre_itmlst	= cre_name+16	; Item list to $getjpi
cre_size	= cre_itmlst+16	; Size of area.
;
alloc_mbx:
	tstl	mbx_read_chan		; A channel already allocated?
	beql	1$			; J if not, reallocate it.
	brw	99$			; And leave --- no need to reallocate.
1$:	pushr	#^m<r11>		; Save r11
	subl2	#cre_size,sp		; Allocate space on stack.
	movl	sp,r11			; Get a temporary "frame"
	movw	#16,cre_itmlst(r11)	; Set up length of item.
	movw	#jpi$_prcnam,cre_itmlst+2(r11) ; Set up get proc. name.
	moval	cre_name(r11),cre_itmlst+4(r11) ; Point to process name.
	moval	cre_len(r11),cre_itmlst+8(r11) ; Set return length addr
	clrl	cre_itmlst+12(r11)	; And last item - end of list
	$getjpi_s itmlst=cre_itmlst(r11)
	blbc	r0,90$			; J if error.
	moval	cre_mbxname(r11),r0	; point to the mailbox name.
	movl	r0,cre_addr(r11)	; Set up string descriptor.
	movl	#^a/MBX_/,(r0)+		; Mailbox name =
					;	MBX_processname
	addl2	#4,cre_len(r11)		; Adjust the length.
	cmpw	cre_len(r11),#10	; Length too large?
	bleq	30$			; J if not.
	movw	#10,cre_len(r11)	; Set length = 6
30$:	locc	#^a/:/,cre_len(r11),cre_mbxname(r11) ; Find a : if any.
	beql	35$			; J if none found.
	movb	#^a/./,(r1)		; Otherwise, move in a .
	brb	30$			; And try to find another.
35$:	$crembx_s prmflg=0, -
		chan=mbx_read_chan, -
		maxmsg=#256, -
		promsk=#^x0f565, -
		lognam=cre_desc(r11)
90$:	addl2	#cre_size,sp		; Free up stack space.
	popr	#^m<r11>		; Recover r11
99$:	rsb				; And return to the caller.

;
; Function 3.  Write to mailbox
;
;	Argument list:
;		code+2 - Address of mailbox buffer
;		code+4 - Length of mailbox buffer
;		code+6 - Address of compatibility mode
;			 character descriptor of target mailbox
;		code+8 - 8-byte VMS I/O status block
;
wri_desc	= -8		; Descriptor for write mailbox
wri_name	= wri_desc - 10	; Name of write mailbox
wri_chan	= wri_name - 4	; Channel on which write is done
wri_size	= -wri_chan	; Length of stack frame.
;
wrimbx:
	subl2	#wri_size,sp		; Allocate space on stack.
	movzwl	(r11)+,r10		; Pick up dest. address.
	movzwl	(r11)+,r9		; Pick up dest. length.
	movzwl	(r11)+,r8		; Pick up address of task.
	movzwl	(r11)+,r7		; Pick up length of taskname.
	clrq	(r11)			; Clear I/O status block.
	bsbw	alloc_mbx		; allocate the mailbox.
					; (this won't be used by write
					; but should be allocated here
					; to avoid any race conditions).
	mnegw	#1,(r11)		; -1 => allocation failed.
	blbs	r0,5$			; Keep going if no errors.
	brw	90$			; Leave on error.
5$:	moval	wri_name(fp),r6		; Get address of mailbox name.
	movl	r6,wri_desc+4(fp)	; Set the address in descriptor
	movl	#^a/MBX_/,(r6)+		; Mailbox name =
					;	MBX_processname
	cmpl	r7,#6			; Process name <= 6 characters?
	bleq	10$			; J if so.
	movl	#6,r7			; Force process name = 6 characters.
10$:	movc3	r7,(r8),(r6)		; Move in the process name.
	addl2	#4,r7			; Adjust the length of the string.
	locc	#^a/ /,r7,wri_name(fp)	; Locate first blank (if any)
	subl2	r0,r7			; Adjust length of string.
	movl	r7,wri_desc(fp)		; set up length of name.
20$:	locc	#^a/:/,r7,wri_name(fp)	; Try to find a :
	beql	30$			; J if none there.
	movb	#^a/./,(r1)		; Replace it with a .
	brb	20$			; And try again.
30$:	mnegw	#2,(r11)		; -2 => $assign failed
	$assign_s devnam=wri_desc(fp), -
		chan=wri_chan(fp)
	blbc	r0,90$			; Leave on error.
	mnegw	#3,(r11)		; -3 => $qiow failed
	$qiow_s	chan=wri_chan(fp), -
		func=#io$_writevblk!io$m_now, -
		iosb=(r11), -
		p1=(r10), - 
		p2=r9
	blbc	r0,90$			; Leave on error.
	cmpw	#ss$_normal,(r11)	; I/O normal?
	bneq	80$			; J if not.
	$dassgn_s chan=wri_chan(fp)	; Deassign channel.
	blbs	r0,90$			; leave with success if ok.
	mnegw	#5,(r11)		; -5 => $dassgn failed
	brb	90$			; And leave.
80$:	mnegw	#4,(r11)		; -4 => Write to mailbox failed
90$:	ret				; And return.

;
; Function 4.  Simulate terminal driver functions.
;
; Stack offsets
;
tty_buffersize	= 100		; Size of tty buffer area.
tty_buffer	= -tty_buffersize ; Buffer for $getdev service.
tty_desc	= tty_buffer-8	; Character descriptor of buffer.
tty_trnbuf	= tty_desc-64	; Translation buffer
tty_trndesc	= tty_trnbuf-8	; Descriptor for translation buffer
tty_junk	= tty_trndesc-4	; Junk area for sys$trnlog
tty_size	= -tty_junk	; Size of stack frame.
;
simtty:
	subl2	#tty_size,sp	; Allocate stack frame.
	movl	#64,tty_trndesc(fp) ; Set up translation buffer
	moval	tty_trnbuf(fp),tty_trndesc+4(fp) ; ... And descriptor
	moval	sysout+8,sysout+4 ; ... set up another char. descriptor.
	$trnlog_s lognam=sysout, -
		rsllen=tty_trndesc(fp), -
		rslbuf=tty_trndesc(fp), -
		acmode=tty_junk(fp), -
		table=tty_junk(fp)
	blbc	r0,15$		; Leave on error.
	cmpb	#^O<33>,@tty_trndesc+4(fp) ; Process permanent?
	bneq	10$		; J if not.
	addl2	#4,tty_trndesc+4(fp) ; Skip past first part of name.
	subl2	#4,tty_trndesc(fp) ; And decrement length.
10$:	movl	#tty_buffersize,tty_desc(fp) ; Set up ...
	moval	tty_buffer(fp),tty_desc+4(fp) ; ... descriptor.
	$getdev_s devnam=tty_trndesc(fp), -
		prilen=tty_desc(fp), -
		pribuf=tty_desc(fp)
	blbs	r0,20$		; j if everything ok.
	cmpl	r0,#ss$_bufferovf ; Overflow is ok (we're only
	beql	20$		; interested in first bytes)
	cmpl	r0,#ss$_nonlocal ; Network is ok.
	beql	20$		; ...
15$:	brb	90$		; Leave if fatal error.
20$:	movl	tty_desc+4(fp),r9 ; Point to the buffer returned.
	movzwl	(r11)+,r0	; Pick up address of buffer.
	movzwl	(r11)+,r8	; Get length of list.
	ashl	#-1,r8,r8	; Divide length by 2.
	beql	90$		; Leave if 0
	movl	r0,r11		; Point to buffer.
30$:	movb	(r11)+,r7	; Get characteristic to find.
	moval	iastertbl,r6	; Point to translation table.
40$:	cmpb	r7,(r6)		; Found match?
	beql	50$		; J if so.
	addl2	#8,r6		; Get to next element in table.
	tstb	(r6)		; At end of table?
	bneq	40$		; J if not.
	clrb	(r11)+		; Clear unknown value.
	brb	60$		; And continue.
50$:	movzwl	2(r6),r1	; Get offset of routine.
	moval	iastertbl,r2	; Get address of table.
	addl2	r2,r1		; Absolutise offset to subroutine.
	jsb	(r1)		; Call the subroutine.
60$:	sobgtr	r8,30$		; And loop over entire buffer.
90$:	movl	#1,r0		; Success.
	ret			; And return.
;
; Subroutine to examine a bit field.
;
xbt:	clrl	r1		; Set the output code
	bitl	4(r6),8(r9)	; Is the appropriate bit set?
	beql	10$		; J if not.
	incl	r1		; Set r1 = 1 if so.
10$:	movb	r1,(r11)+	; Output the bit
	rsb			; And return to the caller.
;
; Subroutine to return Page size
;
xpage:	movb	11(r9),(r11)+	; Output the page length.
	rsb			; And return to the caller.
;
; Subroutine to return speed
;
xspeed:
	movb	#16,(r11)+	; Fake 4800. baud for now.
	rsb			; And return to the caller.
;
; Subroutine to return terminal type
;
xtype:
	moval	iastertyp,r6	; Point to the terminal table.
10$:	cmpb	(r6),5(r9)	; Right terminal type?
	beql	20$		; J if so.
	addl2	#4,r6		; To next entry.
	tstw	(r6)		; At end of table?
	bneq	10$		; J if not.
	movb	#t.unk0,(r11)+	; Output unknown terminal.
	rsb			; And return to the caller.
20$:	movb	2(r6),(r11)+	; Output unknown terminal.
	rsb			; And return to the caller.
;
; Subroutine to return page width
;
xwidth:	movb	6(r9),(r11)+	; Output the width.
	rsb			; And return to the caller.

;
; Function 5.  Execute SORT procedures
;
simsor:
	movl	#1,r0		; Success.
	ret			; And return.

;
; Function 6.  Execute Spooler functions
;
spr_buffer	= -80		; Buffer for send to Spooler symbiont
spr_bufaddr	= spr_buffer-4	; Pointer to buffer (string descr)
spr_len		= spr_bufaddr-4	; Length of buffer (string descr)
spr_size	= -spr_len	; Size of stack space.
;
simspr:
	subl2	#spr_size,sp		; Allocate space off stack.
	moval	spr_buffer(fp),spr_bufaddr(fp) ; Set up string descr.
	moval	spr_buffer(fp),r9	; Point to buffer.
	movw	#smr$k_enter,(r9)+	; Put code into buffer.
	movb	#5,(r9)+		; Get the size of the name.
	movb	(r11)+,(r9)+		; Move in first byte of name
	movb	(r11)+,(r9)+		; Move in second byte of name.
	cvtbl	(r11)+,r8		; Get the device number.
	rotl	#-4,r8,r7		; Divide by 16 (in effect)
	addb3	#^a/A/,r7,(r9)+		; Output the controller number.
;	rotl	#-3,r8,r7		; Divide by 8 (in effect)
;	bicb2	#^x0fe,r7		; Mask off unneeded bits.
;	addb3	#^a/0/,r7,(r9)+		; Output a 0 or 1
	bicb2	#07,r8			; Isolate low order bits.
	addb3	#^a/0/,r8,(r9)+		; Output low order device number.
	movb	#^a/:/,(r9)+		; And output a :
	movl	#10,r8			; Get size of remainder.
10$:	clrb	(r9)+			; Clear out remainder of buffer.
	sobgtr	r8,10$			; ...
;
	incl	r11			; Skip the priority.
	movw	(r11)+,r10		; Get copies, forms, delete.
;
	movb	#7,(r9)+		; Get device length of user file.
	movb	#^a/_/,(r9)+		; Output a _
	movb	(r11)+,(r9)+		; Output low order device name
	movb	(r11)+,(r9)+		; Output high order device name.
	cvtwl	(r11)+,r8		; Get the device unit number.
	rotl	#-4,r8,r7		; Divide by 16 (in effect)
	addb3	#^a/A/,r7,(r9)+		; Output the controller number.
	rotl	#-3,r8,r7		; Divide by 8 (in effect)
	bicb2	#^x0fe,r7		; Mask off unimportant bits.
	addb3	#^a/0/,r7,(r9)+		; Output the high order device num
	bicb2	#7,r8			; Mask off all but low order bits
	addb3	#^a/0/,r8,(r9)+		; Finish up the device number.
	movb	#^a/:/,(r9)+		; And end device name with :
	movl	#8,r8			; Get remaining length of name
20$:	clrb	(r9)+			; Clear remaining device name
	sobgtr	r8,20$			; And loop over device name.
	movw	(r11)+,(r9)+		; Output the file ID
	movw	(r11)+,(r9)+		; ...
	movw	(r11)+,(r9)+		; ...
	movw	(r11)+,(r9)+		; Output the directory ID
	movw	(r11)+,(r9)+		; ...
	movw	(r11)+,(r9)+		; ...
;
	movc5	#0,(r0),#0,#20,(r9)	; Clear out the file name buffer.
	movl	r9,r7			; Get the file name area into r7
	clrb	(r7)+			; Skip past the length.
	bsbw	r50cvt3			; Convert file name to Ascii
	movb	#^a/./,(r7)+		; Add in a . for file type.
	bsbw	r50cvt1			; Convert file type to Ascii
;	movb	#^a/;/,(r7)+		; Add in a ; for version.
	tstw	(r11)+			; Skip past file version number.
	subl	r9,r7			; Compute length of string.
	decl	r7			; Minus one for length byte.
	cvtlb	r7,(r9)			; Put it into the file name string.
	addl2	#20,r9			; Skip over the file name area.
;
	movb	#smo$k_copies,(r9)+	; Select copies option.
	bicl3	#^x0ffffffe0,r10,r6	; Get the number of copies.
	bneq	40$			; J if specified correctly.
	movl	#1,r6			; Otherwise supply default.
40$:	movb	r6,(r9)+		; Output number of copies.
;
	rotl	#-5,r10,r6		; Shift forms to right hand side
	bicl2	#^x0fffffff8,r6		; Clear off high order garbage.
	movb	#smo$k_formtype,(r9)+	; Output form type code.
	movb	r6,(r9)+		; Output the forms.
;
	bitw	#^o040000,r10		; Is the preserve indicator on?
	bneq	50$			; J if so.
	movb	#smo$k_delete,(r9)+	; Mark file for delete after printing.
;
50$:	subl2	spr_bufaddr(fp),r9	; Get size of buffer.
	movl	r9,spr_len(fp)		; And set it in the string descriptor.
	clrq	(r11)			; Clear I/O status.
	bsbw	alloc_mbx		; Allocate a mailbox channel if reqd
	blbc	r0,90$			; J if error.
;
	$sndsmb_s msgbuf=spr_len(fp), -	; Send message to symbiont.
		chan=mbx_read_chan	; Mailbox to send message.
	blbc	r0,90$			; Leave on error.
;
	$qiow_s	efn=0, -		; Event flag number
		chan=mbx_read_chan, -
		func=#io$_readvblk, -
		iosb=(r11), -
		p1=spr_buffer(fp), -
		p2=#80
	blbc	r0,90$			; J on error.
	movl	#1,r0			; Success.
	ret				; And return.
90$:	mnegw	#1,(r11)		; Show error.
	mnegw	#1,r0			; Show error.
	ret				; And return.

;
; Subroutine to convert from Radix-50 words to Ascii
;
; Borrowed from the RSX AME.
;
; On input,
;
;	r7 = address of target string
;	r11 = address of Radix-50 words
;
; On output,
;
;	r0 = <destroyed>
;	r1 = <destroyed>
;	r7 = address of next byte in target string
;	r11 = address of next word to convert
;
; A blank will stop conversion.
;
r50cvt3:
	movzwl	(r11)+,r0		; Get a word to convert
	bsbb	cvt			; Convert it
r50cvt2:
	movzwl	(r11)+,r0		; Get a word to convert
	bsbb	cvt			; Convert it
r50cvt1:
	movzwl	(r11)+,r0		; Get a word to convert
cvt:	clrl	r1			; Clear scratch space in r1
	ediv	#40,r0,r0,-(sp)		; Divide
	ediv	#40,r0,r0,-(sp)		;   out the
	ediv	#40,r0,r0,-(sp)		;     Radix-50
	cvtlb	(sp)+,(r7)		; Pick up first Radix-50 character.
	bsbb	50$			; Convert to Ascii
	cvtlb	(sp)+,(r7)		; Pick up second Radix-50 character
	bsbb	50$			; Convert to Ascii
	cvtlb	(sp)+,(r7)		; Pick pu third Radix-50 character.
50$:	tstb	(r7)			; Found a blank?
	beql	done			; J if so - no more convert.
	cmpb	#27,(r7)		; Letter?
	bgtru	60$			; J if so.
	beql	55$			; J if $
	addb2	#9,(r7)			; Adjust the .
55$:	addb2	#-55,(r7)		; Adjust . and $
60$:	addb2	#64,(r7)+		; Adjust letters.
done:	rsb				; And return to the caller.
	.end	natvmode