Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	NURD20 Module for Readers and Printers

; COPYRIGHT (C) 1978, 1979 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
; AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.





; ++
; Facility: GALAXY for DN200
;
; Abstract:
;  This module implements the DECnet network unit record device protocol
;  (NURD).  It simulates TOPS-20 JSYS calls for card readers and line
;  printers.  The simulated JSYS's include GTJFN, OPENF, SINR, SOUT, MTOPR,
;  and CLOSF.  Interrupt processing is similar to that observed for the
;  local card reader and line printer.
;
; Environment: TOPS-20 user mode

; Modified:
;  16	Add copyright and other information so that this turkey can
;	be released into loadtest.
;
;  17	XLIST the literals, etc.
;
;  20	Restore registers before turning on interrupt system, so that
;	interrupts into the GALAXY context have the GALAXY registers.
;
;  21	Make sure that certain "OWN" locations get a separate copy in
;	each fork where we execute.  This prevents some interesting
;	problems with multiple DN200s.
;
;  22	Fix MTOPR status problem and put ERJMP following SNDINT MTOPR.
;	 Interrupt setup code did not save AC3.
;
;  23	Fix bug in LMOFLO where confusion over dump buffers and control
;	responses were causing problems.
;
;  24	Resolve further problems with flushing buffers.
;
;  25	Do effective address calculation on user byte pointer in USIN.
;
;  26	Do more effective effective-address calculation on user byte
;	pointers.  Provided routine EFADBY, which alters byte pointer
;	to reflect effective address.  Also, changed USIN, USOUT, and
;	MAPDEV to use this routine.
;
;  27	Put SETER JSYS in NURD error return, at ERRTN.
;
;  30	Changed reader input (USIN) so that EOF detection causes
;	ERJMP/ERCAL processing.  Also fixed EOF detection code.
;
;  31	Fixed bug introduced in edit #27 - a clumsy typo.
;
;  32	Fixed addressing error in TYPATT, and also repaired trivial typo.
;
;  33	Fix logic to process disconnects on links correctly.
;
;  34	Fix NRM and NRD file spec generators to use different control ID's.
;
;  35	Fix UGTJFN to get rid of aborted NRM JFN's.
;
;  36	Fix UCLOSF to close JFN's with CZ%ABT, so that JFN's go away
;	correctly.
;
;  37	Fix bug in USIN which caused loss of last card read if reader went
;	offline.
;
;  40	Change usage of IOX69 error code to DCNx8 because IOX69 is no longer
;	valid.
;
;  41	Allow 8-bit ASCII mode.
;
;  42	Code cleanup, reformatting, and general bug-fixup.
;
;  43	Rewrote interrupt handling code.
;
;  44	Fixed glitch in UOPENF, where legal device/mode checked.
;
;  45	Changed exit-time handling of interrupts because LPTSPL calls
;	us back recursively, causing an endless set of IIC's when the
;	device goes offline.
;
;  46	Added defensive code in the interrupt handler routines.
;
;  47	Fixed handling of device-online interrupt.  Wrong R value
;	was being used to load interrupt channel number.
;
;  50	Added code to solve race condition occurring when online
;	indication arrives before offline indication.
;
;  51	Fixed NRDR macro code generation - it caused improper setting
;	of info on stack, subsequently causing program execution to
;	be improperly dispatched. Also did away with the NRDRJ macro,
;	as it is not needed. Fixed bug in SOUTR error handling.
;
;  52	Repaired typo in USOUT which caused illegal instruction trap
;	whenever output error was processed for the network.


; VERSION NUMBER:
	NRDWHO==0			; WHO LAST EDITED
	NRDMAJ==1			; MAJOR VERSION NUMBER
	NRDMIN==2			; MINOR VERSION NUMBER
	NRDEDT==52			; EDIT NUMBER

%%.NRD==BYTE (3)NRDWHO (9)NRDMAJ (6)NRDMIN (18)NRDEDT	; OUR VERSION NUMBER

SUBTTL	AC's, Parameters, Constants, etc.

	SEARCH	GLXMAC
	PROLOG	(NURD20)

; *****	Accumulators

	J1=1		; JSYS AC'S
	J2=2		; ...
	J3=3		; ...
	J4=4		; ...

	A=5		; General usage
	B=A+1		;   and function
	C=B+1		;   arguments
	D=C+1		;   ...

	T1=D+1		; Temporaries
	T2=T1+1		; ...

	LS=T2+1		; Data Link Status (NRDSTS)
	DS=LS+1		; Device Status    (NRDDST)
	R=DS+1		; RDDB Pointer

	P=17		; Stack Pointer


; *****	Configuration Parameters

	NRDBSZ==^D512	; NURD MSG BUFFER SIZE
	IMSGSZ==^D16	; NSP INTERRUPT MSG SIZE(MAX)
	NURDL==^D16	; LENGTH OF NRDR ERROR HISTORY
	NRDLVL==1	; NURD PRIORITY INT LEVEL
	NRDICH==^D35	; NRD DATA LINK INT CHANNEL FOR INTERRUPT MESSAGES
	NRDDCH==^D34	; NRD DATA LINK INT CHANNEL FOR DATA RECEIVED INT
	NRDTMO==^D10	; NUMBER OF HALF-SECOND INTERVALS FOR TIMEOUT

; *****	Constants and Other Such Trivia

	URS==2		; THE NURD DECNET OBJECT TYPE


; *****	NRM Resource Types

	NRDLP==102	; REMOTE LINE PRINTER
	NRDCR==103	; REMOTE CARD READER


; *****	NRM Function Codes

	NRMRID==41	; NRM REQUESTOR-ID CODE
	NRMSPC==50	; NRM SPECIFY CODE
	    SPCRES==1		; RESERVE SUBCODE
	    SPCREF==3		; REFER SUBCODE
	    SPCOFF==4		; OFFER SUBCODE
	NRMACC==51	; NRM ACCESS CODE
	    ACCOPN==2		; OPEN SUBCODE
	    ACCCLO==3		; CLOSE SUBCODE
	    ACCREL==4		; RELEASE SUBCODE
	NRMASN==52	; NRM ASSIGN CODE
	    ASNHDN==3		; HANDOFF SUBCODE
	    ASNACK==4		; ACKNOWLEDGE SUBCODE
	NRMRSP==47	; NRM RESPONSE CODE
	NRMSTA==53	; NRM STATUS CODE
	    STAQRY==1		; QUERY SUBCODE
	    STAREP==2		; REPORT SUBCODE
	    STALTR==3		; ALTER SUBCODE
	 STARLS==20	; PERFORM AUTOMATIC RELEASE FLAG


; *****	NRM Status Report Codes
;   Device Status
;	    1	CLOSE PENDING
;	    2	OPEN PENDING
;	    4	OPEN COMPLETE
;	  100	RELEASE PENDING
;	  200	RESERVED
;	  400	HANDOFF PENDING
;	 2000	STATUS-REPORT PENDING
;	 4000	OPERATIONAL STATUS PENDING
;	10000	START ERROR PENDING
;
;   Asynchronous Report Status
;	 1	RECEIVE ERROR THRESHOLD EXCEEDED
;	 2	REPLY THRESHOLD EXCEEDED
;	 3	NAK THRESHOLD EXCEEDED
;	 4	DEVICE PROTOCOL ERROR - FATAL
;	 5	INTERVENTION REQUIRED AT DEVICE
;	 6	POWERFAIL
;	 7	DATA PIPE DISCONNECTED
;	10	DIAL-IN TERMINAL ATTACHED

SUBTTL	Local Macros

	OPDEF	$CALLR	[ JRST ]

;***
;   NRDR	Dispatch to processing code via $CALL.
;   NRDRC	   "     "      "       "    "  ERCAL.
;
;	ERRLOC = Error location, defaulting to NRDR invocation address.
;	ERRCOD = Error code, defaulting to DCNX8.
;		 A dot "." will cause the current value in J1 to be used.
;	ERRDSP = Where to go after recording error.
;		 Defaults to location following NRDR invocation.
;***

DEFINE	NRDR.	(ERRLOC,ERRCOD,ERRDSP) <
    $DSP [
	IFB  <ERRLOC>,<			;; If errloc not spec, use from stack
	    IFB	 <ERRCOD>,<		    ;; If no errcod, then
		HRLZ  J1,(P)		    ;;   just set pc
		SUB   J1,[1,,0]>	    ;;   & correct it to actual loc
	    IFNB <ERRCOD>,<		    ;; If errcod, then it may
		HRL   J1,(P)		    ;;    already be in J1 - save
		SUB   J1,[1,,0]		    ;;    J1 right half, and correct pc
					    ;;    Finally, set error code
		IFDIF <ERRCOD><(J1)>,<IFDIF <ERRCOD><.>,<HRRI J1,ERRCOD>>>>
	IFNB <ERRLOC>,<			;; If errloc specified
	    IFB  <ERRCOD>,<		    ;; If no errcod specified
		MOVSI J1,ERRLOC>	    ;;     simply set specified loc
	    IFNB <ERRCOD>,<		    ;; If errcod specified, then it may
		HRLI  J1,ERRLOC		    ;;     already be in J1
					    ;;    Finally, set error code
		IFDIF <ERRCOD><(J1)>,<IFDIF <ERRCOD><.>,<HRRI J1,ERRCOD>>>>

	IFNB <ERRDSP>,<			;; If errdsp specified, we want to
	    MOVEM J1,(P)		;;     go to somewhere special after
	    MOVEI J1,ERRDSP		;;     error processing. So replace
	    EXCH  J1,(P)>		;;     return addr on stack.
    JRST  NRDERR]
>

DEFINE	NRDR	(ERRLOC,ERRCOD,ERRDSP) <
    DEFINE $DSP(DEST)<$CALL DEST>
	NRDR.	ERRLOC,ERRCOD,ERRDSP
>
DEFINE	NRDRC	(ERRLOC,ERRCOD,ERRDSP) <
    DEFINE $DSP(DEST)<ERCAL DEST>
	NRDR.	ERRLOC,ERRCOD,ERRDSP
>

;***
;   ERR		Dispatch to literal code via JRST.
;   ERRC	   "     "     "     "    "  ERCAL.
;   ERRJ	   "     "     "     "    "  ERJMP.
;   ERRI	Generate in-line code.
;
;	ERRCOD = Error code to be loaded into J1.
;	ERRDSP = Where to go after loading code into J1.
;		 If not specified, J1 is simply loaded.
;***

DEFINE	ERR.	(ERRCOD,ERRDSP) <
    IFB  <ERRDSP>,<MOVEI J1,ERRCOD>
    IFNB <ERRDSP>,<
	$DSP [ MOVEI J1,ERRCOD
	    IFIDN <ERRDSP><CPOPJ>,<$RET>
	    IFDIF <ERRDSP><CPOPJ>,<JRST  ERRDSP>]>
>

DEFINE	ERR	(ERRCOD,ERRDSP) <
    DEFINE $DSP(DEST)<JRST DEST>
	ERR.	ERRCOD,ERRDSP
>

DEFINE	ERRC	(ERRCOD,ERRDSP) <
    DEFINE $DSP(DEST)<ERCAL DEST>
	ERR.	ERRCOD,ERRDSP
>

DEFINE	ERRJ	(ERRCOD,ERRDSP) <
    DEFINE $DSP(DEST)<ERJMP DEST>
	ERR.	ERRCOD,ERRDSP
>

DEFINE	ERRI	(ERRCOD,ERRDSP) <
	MOVEI J1,ERRCOD
    IFNB <ERRDSP>,<
	IFIDN <ERRDSP><CPOPJ>,<$RET>
	IFDIF <ERRDSP><CPOPJ>,<JRST  ERRDSP>>
>

;***
;   TYPE
;
;    STRING = The ASCII string to be output via PSOUT.  For example
;		TYPE (This is the string to be typed.)
;***

DEFINE	TYPE	(STRING) <
LSTOF.
    IFNB <STRING>,<MOVEI J1,[ASCIZ /STRING/]>
	PSOUT
LSTON.
>
	SALL			; DON'T LIST MACRO EXPANSIONS

SUBTTL	Remote Device Data Base Definition

; ***	IMPURE DATA  - PER FORK
SUBJFN:: BLOCK	1	; SUBSTITUTE JFN FOR THIS FORK & PTR TO DATA BASE
DEBUGF:	 0		; DEBUG FLAGS
DEBUGR:	 0		; RCVMSG MONITOR WORD



; *** Remote Device Data Base (RDDB)
	LOC	0

; * GENERAL AREA OF RDDB
RDSAVE:! BLOCK	17	; USER ACCUMULATOR SAVE AREA (0-16)
RDEPDL:! BLOCK	1	; U-JSYS ENTRY PDL
RDHOST:! BLOCK	2	; ASCIZ	<NODE>
RDDEV:!	 BLOCK	1	; ASCIZ	<DEV><UNIT>
RDSTS:!	 BLOCK	1	; JSYS SIMULATOR FLAGS
    UJ.XT2==      1		; (rh) JSYS HAS SKIP EXIT FOR SUCCESS
    UJ.INT==      2		;      INTERRUPTS ARE ENABLED BY USER
    UJ.TDS==      4		;      INTS ARE TEMPORARILY DISABLED BY NURD
    UJ.NRD==     10		;      NURD'S AC'S ARE LOADED, NOT USER'S
    UJ.RCV== 100000		;      DATA RECIEVED INTERRUPT HAS OCCURRED
    UJ.SSO== 200000		;      SOUTR SUSPENDED BEFORE COMPLETION
    UJ.FLS== 400000		;      FLUSH DATA BASE ON THE WAY OUT
RDERT:!	BLOCK	1	; PLACE TO REMEMBER ERROR RETURN ADDRESS
RDINTB:! BLOCK	1	; OLD PC SAVE ADDR ,, PLEVTB

; * NRM AREA OF RDDB
NRMJFN:! BLOCK	1	; NRM CONTROL LINK JFN
NRMID:!	 BLOCK	1	; CONTROL ID FOR DATA LINK
NRMSTS:! BLOCK	1	; CONTROL LINK STATUS
    NRM.CP== 1			; (rh) NRM CONNECT PENDING
    NRM.CC== 2			;      NRM CONNECT COMPLETE
    NRM.RS== 4			;      DEVICE RESERVED BY NRM
NRMCFL:! BLOCK	1	; NRM CONNECT FAILURE CODE
NRMAST:! BLOCK	1	; DEVICE STATUS FROM STATUS-REPORT
NRMASR:! BLOCK	1	; REASON CODE FOR ASYNCHRONOUS STATUS-REPORT

;(Cont'd)

; * NRD AREA OF RDDB
NRDJFN:! BLOCK	1	; NRD DATA LINK JFN
NRDULA:! BLOCK	1	; BULA FOR DATA LINK
NRDSTS:! BLOCK	1	; DATA LINK STATUS
    NRD.CP==      1		; (rh) NRD CONNECT PENDING
    NRD.CC==      2		;      NRD CONNECT COMPLETE
    NRD.LP==      4		;      SET=> DEVICE=LPT, NOT SET=> DEVICE=CDR
    NRD.IM==     10		;      COLUMN IMAGE MODE SET
    NRD.AI==     20		;      AUGMENTED COLUMN IMAGE MODE SET
    NRD.OP==     40		;      DEVICE OPEN PENDING
    NRD.OC==    100		;      DEVICE OPEN COMPLETE
    NRD.EN==    200		;      INTERRUPTS ARE ENABLED FOR SOFT ERRORS
    NRD.EO==    400		;      EOF DETECTED(CDR) OR SET(LPT)
    NRD.ER==   1000		;      DATA ERROR DETECTED(CDR)
    NRD.PL==   2000		;      PAGE LIMIT EXCEEDED
    NRD.AB==   4000		;      ABORT COMPLETE RECEIVED
    NRD.FE==  10000		;      FATAL ERROR AT REMOTE DEVICE
    NRD.PS==  20000		;      DEVICE PAUSED
    NRD.TO==  40000		;      DEVICE TIMED OUT
    NRD.RS== 100000		;      RESUME ISSUED
    NRD.OF== 1,,0		; (lh) DEVICE IS OFFLINE
    NRD.ON== 2,,0		;      ONLINE RCVD, OFFLINE NOT HERE YET
    NRD.NO== 4,,0		;      ONLINE RCVD, BUT REPORTING DEFERRED
NRDDST:! BLOCK	1	; DEVICE STATUS CODE - KEPT IN MTOPR FLAGS
NRDCFL:! BLOCK	1	; NRD CONNECT FAILURE CODE
NRDSEQ:! BLOCK	1	; DATA MSG SEQUENCE NO.
NRDSGC:! BLOCK	1	; PTR TO SEGMENT COUNT
NRDSEG:! BLOCK	1	; PTR TO CURRENT SEGMENT HEAD
NRDSGS:! BLOCK	1	; NO. SEGMENTS LEFT TO PROCESS
NRDSGN:! BLOCK	1	; CURRENT SEGMENT COUNT
NRDREP:! BLOCK	1	; REPEATED DATA ITEM
NRDTMC:! BLOCK	1	; TIMEOUT COUNTER
NRDATT:! BLOCK	1	; LAST ATTENTION MSG REASON CODE
NRDASQ:! BLOCK	1	; LAST ATTENTION MSG SEQUENCE NUMBER
NRDLPC:! BLOCK	1	; PAGE COUNT AT LAST ATTENTION MSG
NRDCSQ:! BLOCK	1	; LAST CONTROL MSG SEQ NO. (RCVD,,SENT)
NRDCCR:! BLOCK	1	; LAST CONTROL MSG RECIEVED: COMMAND,,RESPONSE
NRDCAP:! BLOCK	1	; DEVICE CAPAB. LIST  (LENGTH,,ADDRESS)
NRDIER:! BLOCK	1	; PTR TO  LAST INTERNAL ERROR ENTRY
NRDERH:! BLOCK	NURDL	; NRDR ERROR HISTORY - LOCATIONS OF DETECTED ERRORS
NRDCHN:! BLOCK	1	; INTERRUPT CHANNEL ENABLED MASK
NRDRPT:! BLOCK	1	; NRDRBF PTR	(RECEIVE MSG BUFFER)
NRDRCN:! BLOCK	1	; NUMBER OF BYTES IN NRDRBF
NRDSPT:! BLOCK	1	; NRDSBF PTR	(SEND MSG BUFFER)
NRDSCN:! BLOCK	1	; NUMBER OF BYTES IN NRDSBF
NRDLIM:! BLOCK	1	; MAX BLOCK SIZE REMOTE CAN TAKE

;(Cont'd)

; ***	NURD DEVICE FEATURES
; FORMAT OF ENTRY:
;	WORD 1:	  8B7 - FID OF UNKNOWN FID	(NRDUFE ONLY)
;		  1B8 - FEATURE READ FLAG
;		 8B17 - NUMBER OF BYTES IN VALUE
;		18B35 - VALUE IF CLASS 0 OR CLASS 1 WITH 2 OR LESS BYTES
;			  ADDRESS OF STRING IF MORE THAN 2 BYTES
;
;	WORD 2:	  9B8 - FEATURE FLAGS RETURNED
;		 9B17 - FEATURE CLASS RETURNED
;		18B35 - RESPONSE RETURNED
NRDFET:!		; COMMON DEVICE FEATURES
	 BLOCK	2	; FE.ESC	RESERVED FOR FUTURE ESCAPE CODE
	 BLOCK	2	; FE.DAT	DATA MODE
	 BLOCK	2	; FE.SER	SERIAL NUMBER
NFELCR:! BLOCK	2	; FE.LCR	LOWER CASE RAISE
	 BLOCK	2	; FE.FWD	FORM WIDTH
	 BLOCK	2	; FE.EOF	EOF RECOGNITION
	 BLOCK	2	; FE.DVT	DEVICE TYPE
	 BLOCK	2	; FE.TRN	RECORD TRUNCATION
	 BLOCK	2	; FE.FNM	FORM NAME
	 BLOCK	2	; FE.DWD	DEVICE WIDTH

NRDLPF:!		; LPT SPECIFIC FEATURES
	 BLOCK	2	; LP.HT		HORIZONTAL TABS
	 BLOCK	2	; LP.SFC	STANDARD VERTICAL FORMS CONTROL
	 BLOCK	2	; LP.OVP	OVERPRINT LIMIT
	 BLOCK	2	; LP.CVF	CUSTOM VFU
	 BLOCK	2	; LP.FCC	FORTRAN CARRIAGE CONTROL
	 BLOCK	2	; LP.VFR	VARIABLE FORMS RATIO
	 BLOCK	2	; LP.CHS	CHARACTER SET
	 BLOCK	2	; LP.PLE	PAGE LIMIT ENFORCEMENT
	 BLOCK	2	; LP.OPV	OPTICAL VFU

NRDCRF:!		; CDR SPECIFIC FEATURES
	 BLOCK	2	; CD.CWD	CARD WIDTH
NRDUFE:! BLOCK	2	; CATCHES ANY UNKNOWN FID'S
NRDFSN:! BLOCK	1	; SEQ NO. OF LAST FEATURE MSG SENT
NRDFSQ:! BLOCK	1	; SEQ NO. OF LAST FEATURE MSG RECEIVED

; * BUFFERS
NRDRBF:! BLOCK	NRDBSZ/4 ; NURD RECEIVE MSG BUFFER
NRDSBF:! BLOCK	NRDBSZ/4 ; NURD SEND MSG BUFFER
NRDIBF:! BLOCK	IMSGSZ/4 ; INTERRUPT MESSAGE BUFFER
RDDBSZ:!		 ; SIZE OF RDDB
	RELOC

SUBTTL	NURD Message Definition

; *****	NURD Message Format
; MESSAGE TYPE (1):B
	NM.TYP==17	; MESSAGE TYPE MASK
	NM.DAT== 0	; DATA MESSAGE
	NM.ATT== 1	; ATTENTION MESSAGE
	NM.FTR== 2	; FEATURES MESSAGE
	NM.CTL== 3	; CONTROL MESSAGE
	NM.ALR== 4	; ALERT MESSAGE
	NM.CAP== 5	; CAPABILITIES MESSAGE
	NM.OTR== 6	; ***CURRENT OUT OF RANGE VALUE***
; MESSAGE FLAGS (1):BM
; TYPE-DEPENDENT MESSAGE DATA <MSGDATA>

; *** DATA MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; DATA FLAGS (1):BM
	ND.ACK== 1	; ACKNOWLEDGE REQD
	ND.IER== 2	; INPUT ERROR
	ND.EOF== 4	; SEGMENT IS END OF FILE
; SEGMENT COUNT (1):B
; START OF DATA (COUNTED FIELD)

; *** ATTENTION MESSAGE <MSGDATA>
; LAST GOOD ID (1):B
; ATTENTION CODE (1):B
	N.ASTC== 1	; STATUS CHANGE
	N.AACK== 2	; DATA ACKNOWLEDGEMENT
	N.ARQS== 3	; REQUESTED
	N.AABC== 4	; OUTPUT ABORT RECEIVED OR INPUT ABORT COMPLETE
	N.APLE== 5	; PAGE LIMIT EXCEEDED
; ATTENTION FLAGS, UP TO 3 BYTES (EX):BM
	NA.FAT==  1	; <1>FATAL ERROR
	NA.OFL==  2	;    OFFLINE
	NA.PAU==  4	;    PAUSED
	NA.OMD== 10	;    OUT OF MEDIA
	NA.JAM== 20	;    JAMMED
	NA.OOF== 40	;    OPERATOR OFFLINE
	NA.NOE==100	;    NON OPERATOR ERROR
	NA.OUF==  1	; <2>OUTPUT FULL
	NA.NAC==  2	;    DEVICE NOT ACCESSIBLE
	NA.DTO==  4	;    DEVICE TIME OUT
	NA.RNA== 10	;    RESOURCE NOT AVAILABLE
	NA.PF==	 20	;    (CR) PICK FAILURE
	NA.PSE== 20	;    (LP) PAPER SLEW ERROR
	NA.RAP== 40	;    (CR) READ AFTER PUNCH ERROR
	NA.INK== 40	;    (LP) OUT OF INK
	NA.REG==100	;    (CR) REGISTRATION ERROR
	NA.OVP== 1	; <3>(CR) ILLEGAL OVERPRINT
	NA.IVP== 1	;    (LP) INVALID PUNCH ERROR
; PAGE/CARD COUNTER (2):B

; *** FEATURES MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; NUMBER OF FEATURES SPECS IN MSG (1):B
; FEATURES IDENTIFIER (1):B
	RADIX	10
	FE.DAT==  1	; (C1) DATA MODE
	    DM.ASC==1		; 7 BIT ASCII
	    DM.CLI==2		; COLUMNIMAGE
	    DM.EBC==3		; EBCDIC
	    DM.AUG==4		; AUGMENTED COLUMNIMAGE
	    DM.AS8==5		; 8 BIT ASCII
	FE.SER==  2	; (C1) SERIAL NUMBER
	FE.LCR==  3	; (C0) LOWER CASE RAISE
	FE.FWD==  4	; (C1) FORM WIDTH
	FE.EOF==  5	; (C1) EOF RECOGNITION
	    EO.ASC==1		; ASCII
	    EO.IMG==2		; IMAGE
	FE.DVT==  6	; (C1) DEVICE TYPE
	FE.TRN==  7	; (C0) RECORD TRUNCATION
	FE.FNM==  8	; (C1) FORM NAME
	FE.DWD==  9	; (C1) DEVICE WIDTH
	LP.HT== 130	; (C1) HORIZONTAL TAB STOP
	LP.SFC==131	; (C0) STANDARD VERTICAL FORMS CONTROL
	LP.OVP==132	; (C1) OVERPRINT LIMIT
	LP.CVF==133	; (C1) CUSTOM VFU
	LP.FCC==134	; (C0) FORTRAN CARRIAGE CONTROL
	LP.VFR==135	; (C1) VARIABLE FORMS RATIO
	    VF.6LI==1		; 6 LINES PER INCH
	    VF.8LI==2		; 8 LINES PER INCH
	LP.CHS==136	; (C1) CHARACTER SET
	    CH.64== 1		; 64 CHARACTER SET
	    CH.96== 2		; 96 CHARACTER SET
	LP.PLE==137	; (C1) PAGE LIMIT ENFORCEMENT
	LP.OPV==138	; (C1) OPTICAL VFU NAME
	CD.CWD==130	; (C1) CARD WIDTH
	FE.ALL==255	; AFFECTS ALL FEATURES(READ OR SET TO STD.)
	RADIX	8
; FEATURES FLAGS (1):BM
	NF.CMD== 1	; 0 = READ,  1 = SET FEATURES.
	NF.STD== 2	; STANDARD FLAG
; FEATURE CLASS (1):B
	FC.CL0== 0	; (C0) CLASS 0 => <BIT> FORM
	FC.CL1== 1	; (C1) CLASS 1 => <CNT><...> FORM
	FC.SST== 2	; SET TO STANDARD
; FEATURE RESPONSE FIELD (1):B
	FR.USF== 1	; UNSUPPORTED FEATURE
	FR.BCL== 2	; BAD CLASS SPEC'D
	FR.NST== 3	; NO STANDARD VALUE
	FR.ERR== 4	; FEATURE DATA OR FORMAT ERROR
	FR.CPN== 5	; CHANGE PENDING
	FR.NEB== 6	; NOT ENOUGH BUFFER (FOR REPORT)
	FR.DNP== 7	; DEVICE NOT PAUSED
; FEATURES DATA (CLASS DEPENDENT)

; *** CONTROL MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; COMMAND (1):B
	NC.AUE== 1	; (INT) ABORT UNTIL EOF
	NC.AUC== 2	; (INT) ABORT UNTIL CLEARED
	NC.CAB== 3	; CLEAR OUTPUT ABORT/ACK INPUT ABORT
	NC.RQS== 4	; REQUEST STATUS
	NC.DMP== 5	; DUMP OUTPUT BUFFERS
	NC.PAU== 6	; (INT) PAUSE
	NC.RES== 7	; (INT) RESUME
	NC.RQC==10	; REQUEST CAPABILITIES
; RESULT CODE (1):B
	NR.ABS== 0	; (AUE,AUC) ABORT STATE
	NR.NAB== 1	; (AUE,AUC) NOTHING TO ABORT
	NR.NOE== 2	; (AUE)     NO EOF DEFINED
	NR.ACC== 0	; (CAB)     ABORT COMPLETE CLEARED
	NR.ACN== 1	; (CAB)     ABORT COMPLETE NOT SET
	NR.ATT== 0	; (RQS)     ATTENTION MSG FOLLOWS
	NR.DMP== 0	; (DMP)     OUTPUT BEING DUMPED
	NR.NOB== 1	; (DMP)     NO OUTPUT BUFFERED
	NR.DPS== 0	; (PAU)     DEVICE WILL PAUSE
	NR.PAU== 1	; (PAU)     DEVICE ALREADY PAUSED
	NR.NDP== 2	; (PAU)     NO DATA TRANSFER TO PAUSE
	NR.RES== 0	; (RES)     DEVICE WILL RESUME
	NR.NPS== 1	; (RES)     DEVICE NOT PAUSED
	NR.NDR== 2	; (RES)     NO DATA TRANSFER TO RESUME
	NR.CAP== 0	; (RQC)     CAPABILITIES FOLLOWS


; *** CAPABILITIES MESSAGE <MSGDATA>
; NUMBER OF CAPABILITY CODES IN LIST (1):B
; LIST OF CAPABILITY CODES ():B

SUBTTL	UGTJFN

;	UGTJFN SIMULATES A GTJFN FOR A REMOTE DEVICE
;	AC1 = GJ%SHT+[GJ%FOU]
;	AC2 = PTR TO DEVICE SPEC: "<NODE>::P<DEV>[<UNIT>]:"
;		DEFAULT UNIT= 0
;
;	CALL:	PUSHJ	P,UGTJFN
;		ERROR RETURN - AC1 = ERROR CODE
;		SUCCESS RETURN - AC1 = JFN SUBSTITUTE(ADR OF RDDB FOR DEVICE)

UGTJFN::$CALL	MKRDDB			; CREATE DATA BASE & SAVE REGS
	  $RET				; PROBLEMS
	$CALL	USETUP			; NOW DO SETUPS
	MOVE	J2,RDSAVE+J2(R)		; GET DEVICE PTR AGAIN
	$CALL	MAPDEV			; MAP DEVICE SPEC INTO NSP FORMAT
	  JRST	UGTR3			; J1 = ERROR CODE

; ESTABLISH CONTROL LINK TO NRM
	$CALL	GNRMSP			; GENERATE DEV SPEC FOR NRM
	MOVE	J2,A			; GET PTR TO SPEC
	MOVX	J1,GJ%SHT		; GET NRM JFN
	GTJFN				; ...
	  ERJMP	[	MOVE	P,-1(A)		; RESTORE STACK PTR
			JRST	UGTR3]		; ERROR CODE IS IN J1
	MOVE	P,-1(A)			; FLUSH NRM SPEC FROM PDL
	MOVEI	T1,NRM.CP		; SET CONNECT PENDING
	IORM	T1,NRMSTS(R)		; ...
	HRRZM	J1,NRMJFN(R)		; SAVE NRM JFN
	HRRZS	J1			; NOW TO CONNECT TO NRM
	MOVX	J2,10B5+OF%RD+OF%WR+OF%NWT+OF%PLN ; ...
	OPENF				; ...
	  ERJMP	UGTR2			; ? NO NRM
	$CALL	CONWAT			; WAIT FOR CONNECT COMPLETE
	  JRST	[	MOVEM	J3,NRMCFL(R)	; ? FAILED - SAVE STATUS
			ERRI	OPNX21,UGTR2]	; CONNECT REFUSED
	MOVX	T1,NRM.CP!NRM.CC	; CLEAR CONNECT PENDING,
	XORM	T1,NRMSTS(R)		;   & SET CONNECT COMPLETE
	HRRZ	T1,R			; USE UPPER 16 BITS
	LSH	T1,-2			;   OF RDDB ADR AS
	MOVEM	T1,NRMID(R)		;   CONTROL ID
	$CALL	DEVRSR			; RESERVE THE DEVICE
	  JRST	UGTR2			; NOT AVAILABLE
	MOVEI	T1,NRM.RS		; SET DEVICE RESERVED
	IORM	T1,NRMSTS(R)		; ...
	MOVE	J1,NRMJFN(R)		; DETERMINE MAXIMUM BUFFER
	MOVEI	J2,.MORSS		;   SIZE OF REMOTE NODE
	MTOPR				; ...
	CAILE	J3,NRDBSZ		; WE WILL USE THE SMALLER OF
	MOVEI	J3,NRDBSZ		;   REMOTE'S BUFFER SIZE
	MOVEM	J3,NRDLIM(R)		;   OR OURS.

; ESTABLISH DATA LINK TO NRD
	$CALL	GNRDSP			; GENERATE DEV SPEC FOR NRD
	MOVE	J2,A			; COPY THE POINTER TO SPEC
	MOVX	J1,GJ%SHT		; GET NRD JFN
	GTJFN				; ...
	  ERJMP	[	MOVE	P,-1(A)
			JRST	UGTR2]
	MOVE	P,-1(A)			; FLUSH NRD SPEC FROM PDL
	TXO	LS,NRD.CP		; SET CONNECT PENDING
	HRRZM	J1,NRDJFN(R)		; SAVE NRD JFN
	HRRZS	J1			; CONNECT TO NRD
	MOVX	J2,10B5+OF%RD+OF%WR+OF%NWT+OF%PLN ; ...
	OPENF				; ...
	  ERRJ	BOTX05,UGTR1		; ? NO NURD
	$CALL	CONWAT			; WAIT FOR CONNECT COMPLETE
	  JRST	[	MOVEM	J3,NRDCFL(R)	; ? FAILED - SAVE STATUS
			ERRI	OPNX21,UGTR1]	; CONNECT REFUSED
	TXC	LS,NRD.CP!NRD.CC	; CLEAR CONNECT PENDING &
					; SET CONNECT COMPLETE

; GET THE BULA SUPPLIED IN OPTIONAL DATA OF CONNECT CONFIRM
	MOVE	J1,NRDJFN(R)
	MOVEI	J2,.MORDA
	MOVSI	J3,(POINT 8)
	HRRI	J3,NRDRBF(R)		; RESULT STRING PTR
	MTOPR
	CAIGE	J4,1			; CHECK THE AMT RETURNED
	NRDR	,,UGTR1			; NONE ?
	LDB	T1,[POINT 8,NRDRBF(R),7] ; 1ST BYTE = BULA
	MOVEM	T1,NRDULA(R)
	MOVEM	R,RDSAVE+J1(R)		; DONE WITH UGTJFN, SO RETURN
	JRST	SUCRTN			;   JFN SUBSTITUTE IN CALLER J1

; NRD AND NRM JFNS ASSIGNED - FLUSH BOTH
UGTR1:	$CALL	FLSNRD			; FLUSH NRD JFN

; NRM JFN ASSIGNED - FLUSH IT
UGTR2:	$CALL	FLSNRM			; FLUSH THE NRM JFN

; NO JFN'S ASSIGNED
UGTR3::	SETZB	LS,NRDSTS(R)		; A CLEAN SLATE
	SETZB	DS,NRDDST(R)		; ...
	MOVEI	T1,UJ.FLS		; SET THE "FLUSH" FLAG
	IORM	T1,RDSTS(R)		; ...
	JRST 	ERRTN			; ERROR RETURN TO THE USER

FLSNRD:	SKIPA	T1,NRDJFN(R)		; DISCONNECT NRD CONTROL LINK
FLSNRM:	MOVE	T1,NRMJFN(R)		; DISCONNECT NRM CONTROL LINK
	$CALL	SAV1J			; PRESERVE J1
	MOVE	J1,T1			; SET TO DO CLOSE
	CLOSF				; CLOSE THE LINK
	  MOVE	J1,T1			; ??
	RLJFN				; RELEASE THE JFN
	  $RET				; ??
	$RET				; ALL DONE

; WAIT FOR CONNECT EVENT FOR JFN IN J1
CONWAT:	MOVEI	J2,NRDTMO		; BOUND OUR WAIT TIME
	MOVEM	J2,NRDTMC(R)		; ...
CONW1:	MOVEI	J2,.MORLS		; READ LINK STATUS
	MTOPR				; ...
	  NRDRC	,,CPOPJ			; ? OOPS
	TXNE	J3,MO%CON		; J3 = LINK STATUS
	PJRST	CPOPJ1			; CONNECTED
	TXNE	J3,MO%WFC+MO%WCC	; WAITING FOR ONE ?
	SOSGE	NRDTMC(R)		; YES, MORE TIME LEFT ?
	$RET				; NOPE - SOMETHING WRONG, RET STATUS
	PUSH	P,J1			; WAIT HAF A SECOND
	MOVEI	J1,^D500		; ...
	DISMS				; ...
	POP	P,J1			; ...
	JRST	CONW1			; CHECK IT AGAIN


; GET SPACE FOR A REMOTE DEVICE DATA BASE AND INIT IT
MKRDDB:	PUSH	P,J2			; SAVE COUPLE OF REGS
	PUSH	P,J1			; ...

; THE FOLLOWING CODE ENSURES THAT THE PAGE CONTAINING "SUBJFN" IS COPIED
;  INTO EACH FORK WHERE NURD20 RUNS.
	MOVEI	J1,SUBJFN		; FORM PAGE NUMBER
	ADR2PG	J1			; ...
	HRLI	J1,.FHSLF		; FORK IS THE CURRENT ONE
	MOVX	J2,PA%RD+PA%WT+PA%EX+PA%CPY ; SET ACCESS ATTRIBUTES
	SPACS
	  ERJMP	[	MOVEI	J1,.FHSLF	; GET ERROR CODE
			GETER			; ...
			MOVE	J1,J2		; PUT CODE INTO J1
			POP	P,J2		; THROW AWAY SAVED J1
			POP	P,J2		; RESTORE J2
			$RET]			; LEAVE
	MOVEI	J1,RDDBSZ		; RDDB BLOCK SIZE
	$CALL	M%GMEM			; GET DATABASE MEMORY
	MOVEM	16,RDSAVE+16(J2)	; STASH USER AC'S IN SAVE AREA
	MOVEI	16,RDSAVE(J2)		; ...
	BLT	16,RDSAVE+15(J2)	; ...
	POP	P,RDSAVE+J1(J2)		; COMPLETE USER AC SAVING OPERATION
	POP	P,RDSAVE+J2(J2)		; ...
	MOVX	J1,1B<.ICDAE>		; SET DEFAULT SOFT INTERRUPT CHANNEL
	MOVEM	J1,NRDCHN(J2)		; ...

	MOVE	R,J2			; R = PTR TO NEW RDDB
	MOVEM	R,SUBJFN		; PRESERVE THE RDDB PTR FOR THIS FORK
	PJRST	CPOPJ1			; THUS CAUSING THE PAGE TO BE COPIED

SUBTTL	UOPENF

; UOPENF SIMULATES AN OPENF FOR A REMOTE DEVICE
; USER MUST HAVE PREVIOUSLY USED UGTJFN TO MAKE THINGS WORK
;
;	AC1 = JFN SUBSTITUTE
;	AC2 = FLAGS
;		OF%BSZ	-	6 BIT BYTE SIZE FIELD
;				7,8,12,16 SUPPORTED
;		OF%MOD	-	4 BIT DATA MODE FIELD
;				0=> ASCII
;				8=> IMAGE
;		OF%RD	-	READ ACCESS
;		OF%WR	-	WRITE ACCESS
;		OF%OFL	-	OPEN DEVICE EVEN IF OFFLINE
;
;	LEGAL DATA MODE/BYTE SIZE COMBINATIONS
;	SIZE	MODE CODE	MODE
;	   7	    0		ASCII
;	   8	    0		ASCII
;	  12	    8		COLUMN IMAGE
;	  16	    8		AUGMENTED COLUMN IMAGE

UOPENF::$CALL	SETUP2			; SETUP FOR SKIP RETURN JSYS
	  JRST	ERRTN			; JFN NOT ASSIGNED
	LDB	T1,[POINT 6,J2,5]	; GET BYTE SIZE
	LDB	T2,[POINT 4,J2,9]	;   AND DATA MODE
	JUMPE	T2,[	CAIE	T1,7		; ASCII MODE - CHECK BYTE SIZE
			CAIN	T1,10		; ...
			SKIPA			; TIS TRULY LEGAL SIZE
			ERR	SFBSX2,ERRTN	; OOPS !
			TXNN	LS,NRD.LP	; FOR LPT ?
			JRST	UOPNC		; NO, CDR THEN
			TXNE	J2,OF%RD	; MUST WRITE TO LPT
			ERR	OPNX13,ERRTN	; TUT,TUT - TRYING TO READ
			TXNE	J2,OF%WR	; BETTER SAY WRITE
			JRST	UOPNX		; AWRIGHT !
			ERRI	OPNX4,ERRTN]	; A BUMMER
	CAIN	T2,^D8			; THE ONLY OTHER LEGAL MODE IS 8
	TXNE	LS,NRD.LP		;   AND ONLY FOR CDR
	ERR	OPNX14,ERRTN		; INVALID MODE
	CAIN	T1,^D12			; IMAGE MODE - CHECK BYTE SIZE
	JRST	UOPN1			; COLUMN IMAGE
	CAIE	T1,^D16			; AUG COL IMAGE ?
	ERR	SFBSX2,ERRTN		; NO, SO BYTE SIZE ERROR
	TXOA	LS,NRD.AI		; AUGMENTED COLUMN IMAGE MODE
UOPN1:	TXO	LS,NRD.IM		; COLUMN IMAGE MODE

UOPNC:	TXNE	J2,OF%WR		; TRYING TO WRITE TO CDR ?
	ERR	OPNX13,ERRTN		; DUMMY !
	TXNN	J2,OF%RD		; WE ARE SUPPOSED TO READ FROM IT
	ERR	OPNX3,ERRTN		; ! READ I SAID

UOPNX:	TXO	LS,NRD.OP		; OPEN DEVICE NOW
	$CALL	OPNDEV			; SEND ACCESS-OPEN TO NRM
	  JRST	ERRTN
	TXC	LS,NRD.OP!NRD.OC	; FLUSH DEV OPEN PENDING
					;   AND SET DEVICE OPENED
	SETZM	NRDRCN(R)		; INIT FOR IO
	SETZM	NRDSCN(R)		; INIT FOR IO
	SETOM	NRDLPC(R)		; SET PAGE COUNT AS FLAG THAT
					;   NO STATUS HAS BEEN RECEIVED
	$CALL	SNDRQS			; REQUEST STATUS
	$CALL	RCVRQS			; AND WAIT FOR IT
	  NRDR	,,ERRTN			; DATA MSG BLOCKING STATUS RSP
	$CALL	SETMOD			; SET DATA MODE
	TXNE	LS,NRD.LP
	$CALL	[	TXO	DS,MO%LVU	; ONLY OPTICAL VFU AVAIL
			$CALLR	SETLCR]		; INIT THE LPT AS UPPER CASE
	$CALL	RDFTRS			; READ DEVICE FEATURES
	  NRDR	,,ERRTN			; DATA MSG BLOCKING ??
	JRST	SUCRTN			; ALL DONE !!

SUBTTL	USOUT

; USOUT SIMULATES A SOUT FOR A REMOTE DEVICE(LPT)
;
;	AC1 = JFN SUBSTITUTE
;	AC2 = PTR TO STRING
;	AC3 = COUNT
;	AC4 = TERMINATION CHAR IF COUNT>0
;
;	STRING TERMINATION CONVENTION:
;		COUNT > 0=> TERMINATE ON COUNT OR CHAR= (AC4)
;		COUNT= 0=> TERMINATE ON CHAR= 0
;		COUNT < 0=> TERMINATE ON COUNT
;
;	DATA MESSAGE FORMAT:
;		<0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
;	SEGMENT FORMENT:
;		<CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>

USOUT::	$CALL	SETUP1			; NON-SKIP JSYS
	  JRST	ERRTN			; NO SUCH JFN
	TXNE	LS,NRD.CC		; CHECK LINK STILL CONNECTED
	TXNN	LS,NRD.OC		; CHECK DEVICE OPENED
	ERR	DESX5,ERRTN		; "FILE" NOT OPEN
	TXNN	LS,NRD.LP		; CHECK THAT DEVICE IS AN LPT
	ERR	IOX2,ERRTN		; "FILE" NOT OPEN FOR WRITING
	TLC	J2,-1			; GENERIC POINTER ?
	TLCN	J2,-1			;   BACK TO ORIG, SKIP IF WAS NONZERO
	HRLI	J2,(POINT 7)		; IT WAS GENERIC - MAKE IT SPECIFIC
	$CALL	EFADBY			; DO BYTE POINTER EFFECTIVE ADDR CALC
	SKIPA				; J2 IS NOW A PROPER PTR

USO0:	$CALL	USYCLE			; START NEW BUFFER
USO1:	$CALL	RCVNRM			; CHECK FOR ASYNCHRONOUS NRM MESSAGES
	  NRDR	,,ERRTN			; NRM ERROR
	JUMPN	A,USO1			; READ ALL OF THEM
USO2:	$CALL	RCVMSG			; CHECK FOR INCOMING MSGS 1ST
	  NRDR	,,ERRTN			; READ ERROR
	JUMPE	A,[NRDR .,,ERRTN]	; DATA MSG SHOULDN'T BE HERE!!
	JUMPG	A,USO2			; PROCESS EVERYTHING ELSE IN SIGHT
	TXNE	LS,NRD.OF		; CHECK FOR OFFLINE
	$CALL	[	MOVX	T1,NRD.ON	; WE ARE OFF, BUT
			TDNE	T1,NRDSTS(R)	;   ALREADY BACK ?
			$CALLR	SNDRES		; YES, SO TELL DN200 TO RESUME
			ERRI	GJFX28,ERRTN]	; DEVICE WENT OFFLINE
	TXNE	DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%LPC
	ERR	IOX5,ERRTN		; DEVICE ERROR
	TXNE	LS,NRD.PS		; NO ERRORS - PAUSED ?
	$CALL	SNDRES			; YES - TRY TO RESUME
	$CALL	SBFINI			; INIT MSG BUF
	MOVE	D,NRDLIM(R)		; GET MAX MSG SIZE
	SETZB	T1,T2			; INIT NRD DATA MSG
	IDPB	T1,NRDSPT(R)		; NURD MSG TYPE
	IDPB	T1,NRDSPT(R)		; NURD MSG FLAGS
	AOS	T1,NRDSEQ(R)
	IDPB	T1,NRDSPT(R)		; MSG SEQUENCE NO.
	IDPB	T2,NRDSPT(R)		; DATA MSG FLAGS
	IDPB	T2,NRDSPT(R)		; MSG SEGMENT COUNT
	MOVE	T1,NRDSPT(R)
	MOVEM	T1,NRDSGC(R)		; SAV PTR TO SEG CNT
	SUBI	D,5			; SUB MSG OVERHEAD FROM CNT
USO3:	CAIG	D,2			; MAKE SURE THERE IS ROOM FOR A SEGMENT
	JRST	USO0			; CYCLE THE MSG BUFFER
	SETZ	C,			; BEGIN NEW SEGMENT
	IDPB	C,NRDSPT(R)		; SEGMENT HEAD
	MOVE	T1,NRDSPT(R)
	MOVEM	T1,NRDSEG(R)		; SAV PTR TO SEGMENT HEAD
	LDB	T1,NRDSGC(R)		; COUNT THE SEGMENT IN MSG
	AOS	T1
	DPB	T1,NRDSGC(R)
	SOJA	D,USO5			; COUNT SEGMENT HEAD IN BUFFER

USO4:	CAIL	C,^D127			; CHECK SEGMENT SIZE LIMIT
	JRST	USO3			; BEGIN NEW SEGMENT
USO5:	ILDB	T1,J2			; STUFF THE SEGMENT FROM STRING
	IDPB	T1,NRDSPT(R)		; STRING CHARACTER
	AOS	C
	DPB	C,NRDSEG(R)		; COUNT THE CHAR IN SEGMENT
	JUMPL	J3,[	AOJL	J3,USO7		; TERMINATE BY COUNT
			JRST	USO9]		; ...
	JUMPG	J3,[	SOJE	J3,USO8		; TERMINATE BY COUNT
			CAME	J4,T1		;   OR BY CHARACTER
			JRST	USO7		; NOPE
			JRST	USO8]		; STOP NOW
	JUMPE	T1,USO8			; TERMINATE BY CHAR= 0

USO7:	SOJG	D,USO4			; COUNT CHAR IN BUFFER
	JRST	USO0			; CYCLE BUFFER & BEGIN NEW NURD MSG

USO8:	MOVNI	T1,1			; SOURCE TERMINATED BY BYTE
	ADJBP	T1,J2			; BACK UP PTR
	MOVE	J2,T1
USO9:	$CALL	USYCLE			; SOURCE DONE - FLUSH OUT BUFFER
	JRST	SUCRTN

USYCLE:	$CALL	SAV4J			; SAVE J1-J4
	MOVE	J1,NRDJFN(R)		; SET THE OUTPUT JFN
	$CALL	SNDBUF			; SEND THE STUFF
	  JRST	[	DMOVEM	J2,RDSAVE+J2(R)	; SET RETURN J2 & J3, BECAUSE
			JRST	ERRTN]		;   SOUTR ABORT
	DMOVEM	J2,RDSAVE+J2(R)		; SET RETURN VALUE OF J2,J3
	SKIPE	DEBUGF
	$CALL	TYBUF
	TXO	DS,MO%IOP		; SET IO IN PROGRESS FOR LPT
	$RET

SUBTTL	USIN

; USIN SIMULATES A SIN FOR A REMOTE DEVICE(CDR)
;
;	AC1 = JFN SUBSTITUTE
;	AC2 = PTR TO STRING
;	AC3 = COUNT
;	AC4 = TERMINATION CHAR IF COUNT>0
;
;	STRING TERMINATION CONVENTION:
;		COUNT > 0=> TERMINATE ON COUNT OR CHAR= (AC4)
;		COUNT= 0=> TERMINATE ON CHAR= 0
;		COUNT < 0=> TERMINATE ON COUNT
;
;	DATA MESSAGE FORMAT:
;		<0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
;	SEGMENT FORMENT:
;		<CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>

USIN::	$CALL	SETUP1			; NON-SKIP JSYS
	  JRST	ERRTN			; BAD JFN
	TXNE	LS,NRD.CC		; CHECK LINK STILL CONNECTED
	TXNN	LS,NRD.OC		; CHECK DEVICE OPENED
	ERR	DESX5,ERRTN		; "FILE" NOT OPEN
	TXNE	LS,NRD.LP		; CHECK THAT DEVICE IS A CDR
	ERR	IOX3,ERRTN		; "FILE" NOT OPEN FOR READING
	$CALL	INTOFF
	TXZ	LS,NRD.FE!NRD.TO!NRD.OF!NRD.PL
	MOVEM	LS,NRDSTS(R)		; UPDATE LINK STATUS
	TXZ	DS,MO%FER!MO%HE!MO%SER!MO%RCK!MO%PCK!MO%SFL!MO%HEM!MO%LCI!MO%LPC!MO%EOF
	MOVEM	DS,NRDDST(R)		; UPDATE DEVICE STATUS
	$CALL	INTON
	TLC	J2,-1			; GENERIC POINTER ?
	TLCE	J2,-1			;   BACK TO ORIG, SKIP IF WAS ZERO
	JRST	SIN0			; IT'S ALRIGHT LIKE IT IS
	TXNN	LS,NRD.IM!NRD.AI	; CHECK IMAGE MODES
	JRST	[	HRLI	J2,(POINT 7)	; ASCII
			JRST	SIN0]		; ...
	TXNN	LS,NRD.AI
	JRST	[	HRLI	J2,(POINT 12)	; COLUMN IMAGE MODE
			JRST	SIN0]		; ...
	HRLI	J2,(POINT 16)		; AUGMENTED COLUMN IMAGE MODE
SIN0:	$CALL	EFADBY			; DO BYTE POINTER EFFECTIVE ADDR CALC
	SKIPE	D,NRDRCN(R)		; CHECK FOR CURRENT BUFFER
	JRST	USIN1			; BUFFER IN PROGRESS
SIN1:	TXNE	LS,NRD.OF		; CHECK FOR OFFLINENESS
	JRST	[	TXNE	LS,NRD.EO	; BUT DO WE HAVE EOF TOO ?
			JRST	USIEF1		; YEP, SO JUST EOF
			MOVX	T1,NRD.ON	; SEE IF ALREADY BACK
			TDNN	T1,NRDSTS(R)	; ...
			ERR	GJFX28,USINER	; DEVICE IS REALLY OFFLINE
			$CALL	SNDRES		; TRY TO RERSUME IT
			JRST	.+1]		; THEN GO ON
	TXNE	DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%SFL!MO%PCK!MO%RCK
	ERR	IOX5,USINER		; DEVICE ERROR
	TXNE	LS,NRD.PS		; NO ERRORS - PAUSED ?
	$CALL	SNDRES			; YES - TRY TO RESUME
SIN2:	$CALL	RCVNRM			; CHECK FOR NRM ASYNCHRONOUS MESSAGES
	  NRDR	,,USINER		; NRM ERROR
	JUMPN	A,SIN2			; GOT 1 - READ ALL OF THEM
	$CALL	RCVMSG			; READ A MSG
	  JRST	USINER			; READ ERROR
	JUMPL	A,[	MOVEI	J1,^D250	; NOTHING - TRY AGAIN LATER
			DISMS			; ZZZ
			JRST 	SIN1]		; ...
	JUMPG	A,SIN1			; SOMETHING BESIDES DATA
	MOVNI	D,5			; DATA MSG IN NRDRBF
	ADDB	D,NRDRCN(R)		; GET BUFFER COUNT
	JUMPL	D,[NRDR .,,USINER]	; INSUFF DATA FOR NURD MSG
	IBP	NRDRPT(R)		; ADVANCE PAST NURD MSG FLAGS
	ILDB	T1,NRDRPT(R)		; MSG SEQUENCE NO.
	MOVEM	T1,NRDSEQ(R)
	ILDB	T2,NRDRPT(R)		; DATA FLAGS
	ILDB	T1,NRDRPT(R)		; GET NO. SEGMENTS
	MOVEM	T1,NRDSGS(R)
	SETZM	NRDSGN(R)		; INIT CURRENT SEG CNT
	TXNN	T2,ND.EOF		; EOF ?
	JRST	SIN3
	TXO	LS,NRD.EO
	TXO	DS,MO%EOF
	TXNN	LS,NRD.AI!NRD.IM	; CHECK ASCII OR IMAGE
	JRST	USIEOF			; ASCII EOF MSG GETS SPECIAL TREATMENT
	TXZ	T2,ND.IER		; IMAGE - IGNORE DATA ERRORS
SIN3:	TXNE	T2,ND.IER		; DATA ERROR DETECTED
	TXOA	LS,NRD.ER		; YES
	TXZA	LS,NRD.ER
	TXOA	DS,MO%RCK
	TXZA	DS,MO%RCK
	ERR	IOX5,USINR1		; DATA ERROR - USER CAN READ THIS
					;   CARD BY REISSUING ANOTHER USIN
USIN1:	MOVE	C,NRDSGN(R)		; GET CURRENT SEGMENT  BYTE CNT
	JUMPL	C,USIN4			; MORE LEFT IN COMPRESSION SEQUENCE
	JUMPG	C,USIN6			; MORE LEFT IN NORMAL SEQUENCE
USIN2:	SOSGE	NRDSGS(R)		; COUNT SEGMENTS
	JRST	SIN1			; MSG DONE
	SOJL	D,[NRDR .,,USINER]	; INSUFF DATA FOR SEG HEADER
	ILDB	T1,NRDRPT(R)		; GET NEXT SEGMENT HEAD
	TXZN	T1,200			; CHECK FOR COMPRESSION SEQUENCE
	SKIPA	C,T1			; NORMAL
	MOVN	C,T1			; COMPRESSION SEQUENCE
	JUMPE	C,SIN1			; EOR=> MSG DONE
	JUMPG	C,USIN6			; BEGIN NEW NORMAL SEQUENCE
; BEGIN NEW COMPRESSION SEQUENCE
	SOJL	D,[NRDR .,,USINER]	; INSUFF DATA FOR LOW DATA BYTE
	ILDB	T1,NRDRPT(R)		; GET REPEATED DATA ITEM
	TXNN	LS,NRD.IM!NRD.AI	; CHECK SIZE OF DATA ITEM
	JRST	USIN3			; ASCII MODE
	SOJL	D,[NRDR .,,USINER]	; INSUFF DATA FOR HIGH BYTE
	ILDB	T2,NRDRPT(R)		; GET HIGH PART
	DPB	T2,[POINT 8,T1,27]
USIN3:	MOVEM	T1,NRDREP(R)		; SAVE REPEAT ITEM
USIN4:	MOVE	T1,NRDREP(R)		; GET REPEAT ITEM
	IDPB	T1,J2			; STUFF THE ITEM
	JUMPL	J3,[	AOJL	J3,USIN5	; TERMINATE ON COUNT
			AOJA	C,USINX]	; DEST SURFEITED
	JUMPG	J3,[	SOSE	J3		; STOP ON COUNT OR BYTE= (AC4)
			CAMN	T1,J4		; ...
			AOJA	C,USINX		; FULL
		USIN5:	AOJL	C,USIN4		; MORE - COUNT ITEM IN SEGMENT
			JRST	USIN2]		; NEED NEW SEGMENT
	JUMPN	T1,USIN5			; MORE
	AOJA	C,USIN9			; SATISFIED

USIN6:	SOJL	D,[NRDR .,,USINER]	; INSUFF DATA FOR LOW DATA BYTE
	ILDB	T1,NRDRPT(R)		; GET NEXT DATA ITEM
	TXNN	LS,NRD.IM!NRD.AI	; CHECK SIZE OF DATA ITEM
	JRST	USIN7			; ASCII
	SOJL	D,[NRDR .,,USINER]	; INSUFF DATA FOR HIGH BYTE
	ILDB	T2,NRDRPT(R)		; GET HIGH PART
	DPB	T2,[POINT 8,T1,27]
USIN7:	IDPB	T1,J2			; STUFF THE DATA ITEM
	JUMPL	J3,[	AOJL	J3,USIN8	; TERMINATED BY COUNT
			SOJA	C,USINX]	; STUFFED
	JUMPG	J3,[	SOSE	J3		; STOP BY COUNT OR BYTE=(AC4)
			CAMN	T1,J4
			SOJA	C,USINX		; SATIATED
		USIN8:	SOJG	C,USIN6		; COUNT DATA ITEM IN SEGMENT
			JRST	USIN2]		; NEED NEW SEGMENT
	JUMPN	T1,USIN8			; TERMINATED BY BYTE= 0
	SUBI	C,1			; FULL
USIN9:	MOVNI	A,1			; TERMINATED ON ZERO BYTE - BACK UP PTR
	ADJBP	A,J2
	MOVE	J2,A

; END OF DEST BUFFER
USINX:	MOVEM	C,NRDSGN(R)		; DESTINATION STRING TERMINATED
	MOVEM	D,NRDRCN(R)		; SAVE CURRENT MSG STATUS
	DMOVEM	J2,RDSAVE+J2(R)		; SET RETURN VALUE OF J2,J3
	TXNN	LS,NRD.EO		; IF EOF SET (IMAGE EOF) FALL THRU
	JRST	SUCRTN

; EOF - FLUSH MESSAGE, SET EOF CONDITION
USIEOF:	$CALL	RCVRQ			; WAIT FOR ATTENTION MSG WHICH FOLLOWS
	  NRDR				; READ ERROR OR DATA BLOCKING
USIEF1:	TXZ	LS,NRD.ER!NRD.FE!NRD.TO	; IGNORE HARD ERRORS
	TXZ	DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%SFL!MO%PCK!MO%RCK
	ERR	IOX4			; OK TO PROCEED NOW
	SETZM	NRDRCN(R)		; MESSAGE FAULT EXIT- FLUSH MSG
	TXNE	LS,NRD.AI!NRD.IM	; CHECK ASCII OR IMAGE
	JRST	ERRTN			; LET USER KNOW ABOUT IT

USINER:	SETZM	NRDRCN(R)		; MESSAGE FAULT EXIT- FLUSH MSG
USINR1:	DMOVEM	J2,RDSAVE+J2(R)		; SET RETURN VALUE OF J2,J3
	JRST	ERRTN

SUBTTL	UMTOPR

; UMTOPR SIMULATES MTOPR JSYS FOR REMOTE DEIVCES
;
;	AC1 = JFN SUBSTITUTE
;	AC2 = FUNCTION CODE
;	AC3 = ARG OR PTR TO ARG BLOCK

UMTOPR::$CALL	SETUP1			; NON-SKIP JSYS
	  JRST	ERRTN			; BAD JFN
	TXNE	LS,NRD.CC		; CHECK LINK STILL CONNECTED
	TXNN	LS,NRD.OC		; MAKE SURE DEVICE IS OPENED
	ERR	DESX5,ERRTN		; "FILE" NOT OPENED
	TXNE	LS,NRD.LP		; LPT ?
	JRST	[	SKIPE	NRDSCN(R)	; YES, SO FLUSH OUTPUT
			$CALL	SNDNRD		; ...
			MOVE	T1,[-LTOPRL,,LTOPR]
			JRST	UMT1]
	MOVE	T1,[-CTOPRL,,CTOPR]	; CDR

UMT1:	HLRZ	T2,(T1)			; SCAN DEV TABLE FOR FUNCTION
	CAMN	T2,J2
	JRST	[	HRRZ	T1,(T1)		; DISPATCH TO FUNC PROCESSOR
			JRST	(T1)]		; ...
	AOBJN	T1,UMT1			; CHECK ALL POSSIBILITIES
	ERRI	MTOX1,ERRTN		; INVALID FUNCTION

; LPT MTOPR FUNCTIONS
LTOPR:	.MOPSI,,LMOPSI		; ENABLE SOFTWARE INTERRUPTS
	.MONOP,,LMONOP		; IO WAIT
	.MOLVF,,LMOLVF		; LOAD VFU
	.MORVF,,LMORVF		; READ VFU NAME
	.MOLTR,,LMOLTR		; LOAD TRANSLATION RAM
	.MORTR,,LMORTR		; READ NAME OF TRANSLATION RAM
	.MOSTS,,LMOSTS		; SET LPT STATUS
	.MORST,,LMORST		; READ LPT STATUS
	.MOFLO,,LMOFLO		; ABORT LPT OUTPUT
LTOPRL==.-LTOPR

; CDR MTOPR FUNCTIONS
CTOPR:	.MOPSI,,CMOPSI		; ENABLE SOFTWARE INTERRUPTS
	.MORST,,CMORST		; READ CDR STATUS
CTOPRL==.-CTOPR

; ENABLE INTERRUPTS FOR DEVICE CHANGES:
;	DEVICE ONLINE STATE OR PAGE COUNTER OVERFLOW
LMOPSI:
CMOPSI:	MOVE	T2,J3			; GET ARG BLOCK PTR
	$CALL	EFADR			; FIND IT
	MOVN	T2,1(T1)		; GET CHANNEL NUMBER - IGNORE FLAGS
	MOVX	T1,1B0			; ...
	ROT	T1,(T2)			; ...
	MOVEM	T1,NRDCHN(R)		; SET CHANNEL ENABLE MASK
	MOVEI	T1,NRD.EN		; SET INTERRUPT ENABLED FLAG
	IORM	T1,NRDSTS(R)		; ...
	TXO	LS,NRD.EN		;   BOTH PLACES
	JRST	SUCRTN			; THAT'S ALL FOLKS

; READ LPT STATUS
LMORST:	MOVE	T1,NRDSEQ(R)		; CHECK AGE OF CURRENT STATUS
	XOR	T1,NRDASQ(R)		; ...
	TXNE	T1,377			; SKIP IF ATT MSG WAS FOR LAST DATA MSG
	TXNE	LS,NRD.PS		; NO USE  IF PAUSED
	JRST	LMORS1			; CURRENT STATUS WILL SUFFICE
	$CALL	SNDRQS			; REQUEST STATUS
	$CALL	RCVRQS			; WAIT FOR IT
	  NRDR	,,ERRTN			; DATA MSG BLOCKING STATUS RSP

; MO%LCP IS AUTOMATICALLY MAINTAINED IN FEATURE MSG RPOCESSING BASED ON
; CURRENT VALUE OF FE.LCR AS THE STATUS OF THIS FEATURE WILL DETERMINE
; WHETHER LOWER CASE CHARACTERS WILL PRINT.  UOPENF INITS THE LPT BY SETTING
; FE.LCR=1=> MO%LCP=0.
; LMOSTS CAN ATTEMPT TO SET FE.LCR=0 AND MO%LCP WILL BE SET ONLY IF THAT
; SUCCEEDS.
LMORS1:

; CDR CAN'T SEND STATUS BECAUSE OF POSSIBLE DEADLOCK IN RETURN DATA STREAM
CMORST:	MOVE	T2,J3			; RETURN UPDATED STATUS TO USER
	$CALL	EFADR			; FIND IT
	PUSH	P,T1
	$CALL	SETDST			; UPDATE DEVICE STATUS
	POP	P,T2
	PUSH	T2,DS			; STORE DEVICE STATUS
	MOVE	T1,-1(T2)		; CHECK BLOCK LENGTH
	CAILE	T1,2
	PUSH	T2,NRDLPC(R)		; WANTS PAGE COUNT ALSO
	JRST	SUCRTN

LMONOP:	$CALL	LPTIOW			; IO WAIT FOR LPTSO WAIT
	  NRDR	,(J1),ERRTN		; DATA MSG BLOCKING DUMP RSP
	JRST	SUCRTN			; THEN GO AWAY

; IO WAIT FUNCTION FOR LPT
LPTIOW:	$CALL	SNDDMP			; DUMP OUTPUT BUFFERS
	$CALL	RCVCRS			; GET THE RESPONSE
	  $RET				; DUMP RESPONSE IS BLOCKED BY DATA MSG
	CAIN	A,NR.NOB		; A = RESULT RETURNED BY DUMP MSG
	PJRST	CPOPJ1			; NO OUTPUT BUFFERED - DONE
	MOVEI	J1,^D1000		; WAIT A SEC
	DISMS
	JRST	LPTIOW			; TRY AGAIN

LMOLVF:					; LOAD THE VFU
LMORVF:					; READ THE VFU NAME
LMOLTR:					; LOAD THE TRANSLATION RAM
LMORTR:					; READ THE TRANSLATION RAM NAME
	ERRI	DESX9,ERRTN		; INVALID OPERATION FOR DEVICE

LMOSTS:	MOVE	T2,J3			; SET LPT STATUS
	$CALL	EFADR			; FIND IT
	MOVE	D,T1			; SAVE PTR FOR A WHILE
	MOVX	T1,MO%EOF		; SET EOF ? - IF SO, MUST BE DONE 1ST
	TDNN	T1,1(D)
	JRST	LMOST1			; NOPE
					; YES - CONSTRUCT NULL DATA MSG
	$CALL	SBFINI			; INIT THE BUFFER
	SETZ	T2,
	IDPB	T2,NRDSPT(R)		; DATA MSG
	IDPB	T2,NRDSPT(R)		; NO NURD FLAGS
	AOS	T1,NRDSEQ(R)
	ANDI	T1,377
	IDPB	T1,NRDSPT(R)		; SEQUENCE NO.
	MOVEI	T1,ND.ACK!ND.EOF
	IDPB	T1,NRDSPT(R)		; SET EOF AND ACK THIS MSG !!
	IDPB	T2,NRDSPT(R)		; NO DATA SEGMENTS
	MOVE	J1,NRDJFN(R)		; SEND IT
	$CALL	SNDBUF
	  JRST	ERRTN			; DEVICE WENT OFFLINE
	TXO	DS,MO%EOF		; SET EOF FLAGS, SINCE RESPONSE WON'T
	TXO	LS,NRD.EO		;   INDICATE EOF STATE(NURD SPEC CROCK)

LMOST1:	MOVX	T1,MO%LCP		; LOWER CASE ?
	TDNN	T1,1(D)
	JRST	LMOST2			; NO
					; SET LOWER CASE RAISE OFF
	MOVEI	A,FE.LCR		; FEATURE ID
	MOVEI	B,0			; VALUE
	MOVEI	C,0			; NO. BYTES IN VALUE(CLASS 0)
	$CALL	SETFTR			; ONLY SUCCESS WILL SET MO%LCP=1

LMOST2:	MOVE	B,2(D)			; SET THE PAGE LIMIT ??
	CAMN	B,[-1]
	JRST	LMOST3			; NO
					; YES, B = VALUE (0 => TURN OFF)
	MOVEI	A,LP.PLE		; FEATURE ID
	MOVEI	C,2			; NO. BYTES IN VALUE
	$CALL	SETFTR			; SET PAGE LIMIT ENFORCEMENT

LMOST3:	MOVX	T1,MO%SER		; RESET SOFT ERROR
	TDNN	T1,1(D)
	JRST	LMOST4
	TDZ	DS,T1			; RESET THE FLAG
	MOVEM	DS,NRDDST(R)		; UPDATE ENTRY STATE
	$CALL	SNDRES			; ATTEMPT RESUME - CLEAR ERROR FLAGS

LMOST4:	$CALL	LPTIOW			; WAIT TIL ALL STATE CHANGES PROCESSED
	  NRDR	,,ERRTN			; OH?
	JRST	SUCRTN			; AWRIGHT !

; FLUSH LPT OUTPUT
LMOFLO:	$CALL	SNDAUC			; SEND ABORT UNTIL CLEAR
	$CALL	RCVCRS			; WAIT FOR CONTROL RESPONSE
	  NRDR	,,ERRTN			; DATA MSG BLOCKING CONTROL RSP
	CAIE	A,NR.NAB		; WHEN NOTHING TO ABORT CONTINUE ON
	JRST	[	MOVEI	J1,^D1000	; WAIT A SECOND
			DISMS			;  ZZZ
			JRST	LMOFLO]		;   AND TRY AGAIN
	$CALL	SNDCAB			; CLEAR THE ABORT
	$CALL	RCVCRS			; WAIT FOR RESPONSE
	  NRDR	,,ERRTN			; DATA MSG BLOCKING CONTROL RSP
	CAIE	A,NR.ACC		; ABORT CLEARED?
	NRDR	,,ERRTN			; NO, THEN PROTOCOL ERROR
	JRST	SUCRTN

; SET DEVICE STATUS TO CURRENT STATE
SETDST:	HLRZ	T1,NRDSTS(R)		; GET CONDITIONS FROM INT LEVEL
	TLO	LS,(T1)
	TXNE	LS,NRD.OF
	TXOA	DS,MO%OL
	TXZ	DS,MO%OL
	SKIPE	NRMASR(R)		; CHECK NRM REPORTED PROBLEM
	TXO	DS,MO%FER!MO%SER	; ALWAYS FATAL
	$RET

SUBTTL	UCLOSF

; UCLOSF SIMULATES A CLOSF JFN FOR REMOTE DEVICES
;	AC1 = FLAGS,,SUBSTITUTE JFN
; CLOSE DEVICE=>	CLOSE NRD DATA LINK
;			CLOSE NRM CONTROL LINK
;			RELEASE JFNS
;			FLUSH DATA BASE

UCLOSF::$CALL	SETUP2			; SKIP TYPE JSYS
	  JRST	ERRTN			; OOPS!
	$CALL	INTOFF			; FLUSH INTS
	SETO	A,			; ASSUME WE WILL BE SUCCESSFUL
	MOVX	J1,CZ%ABT		; ABORT THE JFNS ANYWAY
	HRR	J1,NRDJFN(R)		; GET NRD'S JFN
	CLOSF				; CLOSE NRD LINK WITH FLAGS
	  SETZ	A,			; ? AN ERROR
	MOVE	J1,NRDJFN(R)		; NOW TO RELEASE
	RLJFN				;   THE JFN
	  SETZ	A,			; ??
	MOVX	J1,CZ%ABT		; NOW THE SAME TREATMENT FOR NRM
	HRR	J1,NRMJFN(R)		; GET THE JFN
	CLOSF				; CLOSE NRM LINK
	  SETZ	A,			; PECULIAR !
	MOVE	J1,NRMJFN(R)		; GET RID OF JFN
	RLJFN				; ...
	  SETZ	A,			; ?
	MOVEI	T1,UJ.FLS		; NOW TO GET RID OF DATABASE
	IORM	T1,RDSTS(R)		; SET THE FLUSH FLAG
	JUMPE	A,ERRTN			; ERROR OCCURED IF ZERO FLAG
	JRST	SUCRTN			; AHA !!

SUBTTL	NSP Support Functions

; J1 = JFN FOR DEST
; CLOBBERED T1,J2,J3,J4
SNDBUF:	MOVSI	J2,(POINT 8)		; POINT TO THE BUFFER
	HRRI	J2,NRDSBF(R)		;   IN NRDSBF
	MOVEI	J3,NRDSBF(R)		; CALC NO. BYTES
	SUBI	J3,@NRDSPT(R)		; J3 = -NO. WORDS
	ASH	J3,2			; 4 BYTES PER WORD
	LDB	J4,[POINT 6,NRDSPT(R),5] ; DET PARTIAL WORD BYTES
	HRREI	J4,-^D36(J4)		; [0,-8,-16,-24,-32]
	ASH	J4,-3			; [0,-1,-2,-3,-4]
	ADD	J3,J4			; J3 =  -<NO. BYTES IN MSG>
	JUMPGE	J3,CPOPJ1		; FORGET IT

SENDER:	MOVEI	T1,UJ.SSO		; FLUSH SUSPENDED SOUTR FLAG
	ANDCAB	T1,RDSTS(R)		; ...
	TXNE	T1,UJ.RCV		; CHECK FOR MSG ARRIVING VERY RECENTLY
	JRST	BRKS			; SEEMS SO
	SOUTR				; SEND THE BUFFER
USOWTR:	  ERJMP	SOERR			; SOUTR ERROR! - PROBABLY LINK BROKEN
	SETZM	NRDSCN(R)		; MAKE THE BUFFER EMPTY
	PJRST	CPOPJ1

SOERR:	PUSH	P,J2			; SAVE USER J2
	PUSH	P,J3			;   AND J3
	MOVEI	J1,.FHSLF		; SOUTR ERROR EXIT
	GETER				; DETERMINE ERROR CONDITION
	PUSH	P,J2			; SAVE ERROR CODE FOR LATER
	MOVE	J1,NRDJFN(R)		; CHECK CONDITION OF LINK
	MOVEI	J2,.MORLS
	MTOPR
	TXNN	J3,MO%ABT!MO%SYN
	TXNN	J3,MO%CON
	TXZA	LS,NRD.CC!NRD.OC	; LINK BROKEN
	TXOA	DS,MO%SER		; SOFT ERROR?
	TXOA	DS,MO%FER		; BROKEN LINK IS FATAL
	SKIPA
	TXZ	DS,MO%OL		; DON'T GET CONFUSED BY OFFLINE
	POP	P,J1			; GET ERROR CODE TO J1
	POP	P,J3			; RESTORE USER J3
	POP	P,J2			; AND J2
	$RET				; LEAVE

; PROCESS RECEIVED DATA IN CASE DEVICE WENT OFFLINE
; NOTE: INTERRUPTS ARE NOT ENABLED UNTIL ALL INITIAL NRM EXCHANGES ARE COMPLETE
; AND DEVICE IS SUCCESSFULLY OPENED.  THEREFORE(INVOKE IMPLACABLE LOGIC HERE)
; ANY NRM MESSAGES RECEIVED HERE MUST NECESSARILY BE ASYNCHRONOUS ERROR
; REPORTS - HENCE SHOULD ALWAYS TAKE NONSKIP RETURN FROM RCVNRM!

BRKS:	PUSH	P,A			; SAVE A COUPLE OF REGS
	PUSH	P,B			; ...

BR1:	$CALL	RCVNRM			; CHECK NRM DISASTERS
	  NRDR	,,BR3
	JUMPN	A,BR1			; JUST IN CASE LOGIC FAILS

BR2:	$CALL	RCVMSG			; PROCESS DATA LINK MSGS
	  NRDR	,,BR3
	JUMPG	A,BR2			; GOBBLE ALL
	TXNN	LS,NRD.OF!NRD.PS	; DO WE STILL HAVE A DEVICE ?
	JRST	[	POP	P,B		; YES, RESTORE REGS
			POP	P,A		; ...
			JRST	SENDER]		; EVERYTHING OK - TRY AGAIN

; DEVICE FELL OVER - SUSPEND SOUTR
BR3:	POP	P,B			; RESTORE REGS
	POP	P,A			; ...
	SETZM	NRDSCN(R)		; FLUSH THE BUFFER
	ERRI	GJFX28,CPOPJ		; DEV OFFLINE - RET TO CALLER OF SNDBUF

; SEND THE CURRENT BUFFER AS AN INTERRUPT MSG
;	J1 = JFN FOR DEST
SNDINT:	MOVEI	J4,NRDSBF(R)		; CALC NO. BYTES
	SUBI	J4,@NRDSPT(R)		; J4 = -NO. WORDS
	ASH	J4,2			; 4 BYTES PER WORD
	LDB	J3,[POINT 6,NRDSPT(R),5] ; DET PARTIAL WORD BYTES
	HRREI	J3,-^D36(J3)		; [0,-8,-16,-24,-32]
	ASH	J3,-3			; [0,-1,-2,-3,-4]
	ADD	J4,J3			; J4 =  -<NO. BYTES IN MSG>
	JUMPGE	J4,CPOPJ		; FORGET IT
	MOVMS	J4			; POSITIVE BYTE COUNT
	MOVEI	J3,NRDSBF(R)		; OUTPUT STRING PTR
	HRLI	J3,(POINT 8)
	MOVEI	J2,.MOSIM
	MTOPR				; SEND THE BUFFER
	  ERJMP	CPOPJ			; RETURN ON AN ERROR
	SETZM	NRDSCN(R)		; MAKE THE BUFFER EMPTY
	$RET


; READ A MSG INTO NRDRBF
;	J1 = JFN
RCVBUF:	MOVSI	J2,(POINT 8)		; BUILD BYTE POINTER
	HRRI	J2,NRDRBF(R)		;   INTO BUFFER
	MOVEM	J2,NRDRPT(R)		; SAVE PTR FOR CALLER'S USE
	MOVNI	J3,NRDBSZ
	SINR				; READ A MSG
	  ERJMP	CPOPJ			; ?
	ADDI	J3,NRDBSZ		; CALC NO. BYTES READ
	MOVEM	J3,NRDRCN(R)
	PJRST	CPOPJ1

SUBTTL	NURD Support Functions

; SEND A SPECIFY-RESERVE MSG TO NRM
;	CLOBBERS J1,J2,*J3,*J4,T1,T2

DEVRSR:	$CALL	SBFINI			; INIT BUFFER FOR USE
	MOVE	J2,NRDSPT(R)		; PICK UP BYTE PTR
	MOVEI	T1,NRMSPC		; INSERT SPECIFY CODE
	IDPB	T1,J2			; ...
	MOVEI	T1,SPCRES		; INSERT RESERVE SUBCODE
	IDPB	T1,J2			; ...
	MOVE	T1,NRMID(R)		; PUT IN THE CONTROL ID
	IDPB	T1,J2			; FIRST THE LOW BYTE
	LSH	T1,-10			;  THEN THE HIGH BYTE
	IDPB	T1,J2			;  ...
	MOVEI	T1,NRDLP		; ASSUME WE ARE RESERVING A LP
	TXNN	LS,NRD.LP		; IS IT AN LP ?
	MOVEI	T1,NRDCR		; NOPE, IT IS A CR, SO GUESSED WRONG
	IDPB	T1,J2			; INSERT THE RESOURCE CODE
	MOVEI	T2,3			; THERE ARE 3 CHARS IN
	IDPB	T2,J2			;   THE DEVICE NAME
	MOVE	J1,[POINT 7,RDDEV(R)]	; POINT AT THE DEVICE NAME
	ILDB	T1,J1			; GET A CHARACTER OF NAME
	IDPB	T1,J2			; DEV NAME CH
	SOJG	T2,.-2			; DO EM ALL
	MOVEM	J2,NRDSPT(R)		; UPDATE THE BYTE PTR IN DATABASE
	MOVE	J1,NRMJFN(R)
	$CALL	SNDBUF			; SEND THE MSG TO NRM
	  $RET				; DEVICE WENT OFFLINE
	$CALL	RCVRSP			; WAIT FOR RESPONSE
	  $RET				; BAD RESPONSE - J1 = ERROR CODE

; A = ORIGINAL REQUEST CODE  -  B = RESPONSE CODE
	CAIE	A,NRMSPC		; CHECK IF RIGHT RESPONSE
	NRDR	,BOTX05,CPOPJ		; NRM NOT RESPONDING TO REQUEST
	CAIGE	B,^D20			; CHECK RESPONSE CODE
	PJRST	CPOPJ1			; OK

; RESPONSE ERROR
RSPERR:	CAIN	B,^D20			; ACCESS NOT PERMITTED
	ERR	DESX2,CPOPJ		; TERMINAL NOT AVAIL
	CAIN	B,^D25			; RESOURCE NON-EXISTENT
	ERR	GJFX16,CPOPJ		; NO SUCH DEVICE
	CAIN	B,^D26			; RESOURCE NOT AVAILABLE
	ERR	OPNX7,CPOPJ		; DEVICE ASSIGNED TO ANOTHER JOB
	ERRI	BOTX05,CPOPJ		; ELSE - PROTOCOL INITIALIZATION FAILED

; SEND AN ACCESS-OPEN TO NRM
;	CLOBBERS: J1,J2,*J3,*J4,T1,T2
OPNDEV:	$CALL	SBFINI			; INIT BUFFER FOR USE
	MOVE	J2,NRDSPT(R)		; GET BYTE PTR
	MOVEI	T1,NRMACC		; INSERT ACCESS CODE
	IDPB	T1,J2			; ...
	MOVEI	T1,ACCOPN		; PUT IN OPEN SUBCODE
	IDPB	T1,J2			; ...
	MOVE	T1,NRMID(R)		; INSERT THE NRM ID
	IDPB	T1,J2			;   THE LOW BYTE
	LSH	T1,-10			;     AND
	IDPB	T1,J2			;       THE HIGH BYTE
	MOVEI	T1,URS			; SET THE SERVER PROCESS TYPE
	IDPB	T1,J2			; ...
	SETZ	T1,			; NO SERVER DESCRIPTOR FIELD
	IDPB	T1,J2			; ...
	MOVEI	T1,1			; SERVER PROCESS OPTIONS FIELD LENGTH
	IDPB	T1,J2			; ...
	MOVE	T1,NRDULA(R)		; SET LINK ADDR
	IDPB	T1,J2			; ...
	MOVEM	J2,NRDSPT(R)		; UPDATE BYTE POINTER
	MOVE	J1,NRMJFN(R)		; GET NRM'S JFN
	$CALL	SNDBUF			; SEND THE MSG TO NRM
	  $RET				; DEVICE WENT OFFLINE
	$CALL	RCVRSP			; WAIT FOR RESPONSE
	  $RET				; BAD RESPONSE - J1 = ERROR CODE

; A = ORIGINAL REQUEST CODE  -  B = RESPONSE CODE
	CAIE	A,NRMACC		; CHECK RIGHT RESPONSE
	NRDR	,BOTX05,CPOPJ		; NRM NOT RESPONDING TO REQUEST
	CAIL	B,^D20			; CHECK RESPONSE
	JRST	RSPERR			; ERROR RESPONSE
	MOVE	T1,NRDRCN(R)		; RESPONSE OK - CHECK BULA RETURNED
	ILDB	T2,NRDRPT(R)
	CAIL	T1,4			; MUST BE AT LEAST 4 BYTES LEFT
	CAIGE	T2,3			; FIELD MUST BE AT LEAST 3 BYTES LONG
	NRDR	,BOTX05,CPOPJ		; GARBAGE
	IBP	NRDRPT(R)		; SKIP BTN
	IBP	NRDRPT(R)
	ILDB	T1,NRDRPT(R)		; GET BULA
	MOVNI	T2,4
	ADDM	T2,NRDRCN(R)		; FOR DEBUGGING
	CAME	T1,NRDULA(R)		; BETTER BE US
	NRDR	,BOTX05,CPOPJ		; LOSER
	PJRST	CPOPJ1			; OK

; RECEIVE A RESPONSE MSG FROM NRM
RCVRSP:	$CALL	SAV4J			; SAVE J1-J4
	MOVEI	J1,NRDTMO		; SET TIMEOUT THING
	MOVEM	J1,NRDTMC(R)		; ...
RCVRS1:	$CALL	RCVNRM			; GO GET A MSG FROM NRM
	  NRDR	,DCNX11,STASHJ		; LINK ABORTED
	JUMPE	A,[	SOSGE	NRDTMC(R)	; HAVE WE MESSED LONG ENUF ?
			NRDR	.,BOTX05,STASHJ	; YES, SO GIVE UP
			MOVEI	J1,^D500	; NOTHING, SO WAIT
			DISMS			; ...
			JRST RCVRS1]		; CHECK AGAIN
	MOVE	J4,NRDRCN(R)		; CHECK MINIMUM LENGTH
	CAIL	J4,5			;   FOR RESPONSE MSG
	CAIE	A,NRMRSP		; CHECK RIGHT MSG TYPE
	NRDR	,BOTX05,STASHJ		; THINGS ARE IN A BAD WAY
	MOVE	A,B			; A = ORIGINAL REQUEST CODE
	$CALL	GETWRD			; GET CONTROL-ID
	CAME	J3,NRMID(R)		; CHECK THAT IT IS FOR THIS FORK
	NRDR	,,STASHJ		; WRONG FORK ???
	$CALL	GETWRD			; GET RESPONSE CODE
	MOVE	B,J3			;   AND SAVE IN B
	MOVNI	J4,6			; ADJUST BUFFER COUNT
	ADDM	J4,NRDRCN(R)		; ...
	PJRST 	CPOPJ1			; RETURN  A = ORIGINAL REQUEST CODE
					;	  B = RESPONSE CODE
					;	  NRDRPT POINTING AT OPT DATA

; STASHJ
; THIS EXIT ROUTINE ASSUMES THE STACK HAS BEEN MOST RECENTLY CHANGED
; BY A CALL TO SAV4J.  IT STORES THE CURRENT J1 INTO SAVED J1, SO THE
; CURRENT J1 WILL BE RETURNED TO CALLER.
STASHJ:	MOVEM	J1,-4(P)		; OVERWRITE STORED J1
	$RET				; AND LEAVE

RCVNRM:	$CALL	SAV4J			; RECEIVE A MSG FROM NRM
RCVN0:	MOVE	J1,NRMJFN(R)		; CHECK FOR INPUT
	SIBE
	  JRST	RCVN1			; SOMETHING
	SETZB	A,B			; RET NOTHING
	MOVX	J2,.MORLS		; READ LINK STATUS
	MTOPR
	  ERJMP	STASHJ			; ERROR RETURN
	TXNE	J3,MO%CON		; ARE WE CONNECTED STILL?
	AOS	(P)			; YES, SET FOR SUC RETURN
	$RET				; GO BACK

RCVN1:	$CALL	RCVBUF			; RECEIVE THE MSG
	  PJRST	STASHJ			; READ ERROR
	ILDB	A,NRDRPT(R)		; A = MSG FUNCTION(BYTE 1)
	ILDB	B,NRDRPT(R)		; B = SUBCODE(BYTE 2)
	CAIN	A,NRMSTA		; SPECIAL CHECK FOR STATUS-REPORT
	CAIE	B,STAREP
	PJRST	CPOPJ1			; NOPE - LET CALLER INTERPRET THE MSG

; STATUS-REPORT
	$CALL	GETWRD			; GET CONTROL-ID
	CAME	J3,NRMID(R)		; IS IT US ??
	ERR	DCNX8,STASHJ		; NO !
	IBP	NRDRPT(R)		; SKIP STSTYPE FIELD
	ILDB	J3,NRDRPT(R)		; GET COUNT OF STSDAT FIELD
	CAIE	J3,4			; MUST BE 4
	ERR	DCNX8,STASHJ
	$CALL	GETWRD			; GET J3 = STATUS ASSOC WITH THE DEVICE
	MOVEM	J3,NRMAST(R)
	$CALL	GETWRD			; GET J3 = NRM DEVICE STATUS
	MOVEM	J3,NRMASR(R)
	JUMPE	J3,RCVN0
	TXOA	DS,MO%FER!MO%SER
	ERRI	DCNX8			; MSG FORMAT ERROR
	PJRST	STASHJ

GETWRD:	ILDB	J3,NRDRPT(R)		; GET WORD FROM NRDRBF
	ILDB	J4,NRDRPT(R)
	DPB	J4,[POINT 8,J3,27]
	$RET

; GENERAL MSG RECEIVER - PROCESSES ALL BUT DATA MSGS
RCVMSG:	$CALL	SAV4J
	MOVEI	A,UJ.RCV		; FLUSH DATA RECEIVED FALG
	ANDCAM	A,RDSTS(R)
	SETO	A,			; INIT LAST MSG READ FLAG
	MOVE	J1,NRDJFN(R)		; CHECK FOR INPUT
	SIBE
	  JRST	RCVM1			; SOMETHING THERE
	MOVE	J1,NRDJFN(R)		; SEE IF LINK STILL CONNECTED
	MOVX	J2,.MORLS		; READ LINK STATUS
	MTOPR
	  ERJMP	STASHJ			; ERROR RETURN
	TXNN	J3,MO%CON		; ARE WE CONNECTED STILL?
	PJRST	STASHJ			; NO,SO GIVE ERROR RETURN
	PJRST	CPOPJ1			; YES, BUT NO DATA AT PRESENT

RCVM1:	MOVE	J1,NRDJFN(R)		; SET APPROP JFN
	PUSHJ	P,RCVBUF		; RECEIVE IT!
	  PJRST	STASHJ			; READ ERROR
	SKIPE	DEBUGR
	PUSHJ	P,RCVTYP

; CHECK TYPE
	ILDB	A,NRDRPT(R)		; GET NURD MSG TYPE BYTE
	CAIL	A,NM.OTR		; CHECK RANGE
	MOVEI	A,NM.OTR		; OOPS, MAP TO KNOWN ILLEGAL VALUE
	$CALL	@RCVMT(A)		; DO THE REQUESTED THING
	SKIPE	A			; DATA MSG ?
	SETZM	NRDRCN(R)		; NO, ZERO THE MSG
	PJRST	CPOPJ1			; GET OUT

RCVMT:	CPOPJ1				; DATA MSG
	ATTMSG				; ATTENTION MSG
	FTRMSG				; FEATURES MSG
	CTLMSG				; CONTROL MSG
	[NRDR	.,,CPOPJ]		; ALERT MSG - ILLEGAL HERE
	CAPMSG				; CAPABILITIES MSG
	[NRDR	.,IOX5,CPOPJ]		; SOMEONE CHANGING REMOTE NURD

; ATTENTION MSG FORMAT:
;   <NM.ATT><NURD FLGS><LAST SEQ NO.><ATT. REASON CODE><DEVSTS 1-3><PAGE CNT 2>
;
; PROCESS AN ATTENTION MSG IN NRDRBF.  NRDRPT IS POINTING TO NURD MSG TYPE BYTE
ATTMSG:	IBP	NRDRPT(R)		; SKIP NURD MSG FLAGS
	ILDB	J1,NRDRPT(R)		; GET SEQ. NO.
	MOVEM	J1,NRDASQ(R)		; SAVE AS INDICATOR OF STATUS CURRENCY
	ILDB	J1,NRDRPT(R)		; ATTENTION REASON CODE
	MOVEM	J1,NRDATT(R)		; SAVE FOR POSTERITY
	CAILE	J1,N.APLE		; CHECK LIMIT
	SETZ	J1,			; A BAD ONE
	$CALLR	@.+1(J1)		; DISPATCH TO REASON CODE PROCESSOR
	 [NRDR	.,,ATTM]		; BAD CODE
	 ATTM				; STATUS CHANGE
	 ATTM				; DATA ACKNOWLEDGE
	 ATTM				; REQUESTED
	 [	TXO	LS,NRD.AB		; ABORT COMPLETE
		TXZ	DS,MO%IOP		; CLEAR IO IN PROGRESS
		JRST	ATTM]
	 [	TXO	LS,NRD.PL		; PAGE LIMIT EXCEEDED
		TXO	DS,MO%LPC+MO%SER	; ...
		JRST	ATTM]

ATTM:	ILDB	J1,NRDRPT(R)		; BYTE 1 FLAGS
	TXNE	J1,NA.FAT		; FATAL ERROR ?
	TXOA	LS,NRD.FE
	TXZA	LS,NRD.FE
	TXOA	DS,MO%FER
	TXZ	DS,MO%FER
	TXNE	J1,NA.OFL!NA.PAU	; DEVICE OFFLINE OR PAUSED ?
	TXOA	LS,NRD.OF
	TXZA	LS,NRD.OF
	TXOA	DS,MO%OL
	TXZ	DS,MO%OL
	TXNE	J1,NA.PAU		; DEVICE PAUSED ?
	TXOA	LS,NRD.PS
	TXZA	LS,NRD.PS
	TXZ	DS,MO%IOP		; FLUSH IO IN PROGRESS
	TXNN	LS,NRD.LP		; SKIP IF LPT
	JRST	ATTMC			;  TIS A CDR

; LPT
	TXNE	J1,NA.OMD!NA.JAM!NA.OOF!NA.NOE
	TXO	DS,MO%HE
	TXNN	J1,200			; CHECK EXTENSION
	JRST	ATTMX
	ILDB	J1,NRDRPT(R)		; BYTE 2 FLAGS
	TXNE	J1,NA.DTO		; DEVICE TIME OUT
	TXOA	LS,NRD.TO
	TXZA	LS,NRD.TO
	TXO	DS,MO%FER
	TXNE	J1,NA.OUF!NA.NAC!NA.RNA!NA.PSE!NA.INK
	TXO	DS,MO%HE
	TXNN	J1,200			; CHECK EXTENSION
	JRST 	ATTMX
	ILDB	J1,NRDRPT(R)		; BYTE 3 FLAGS
	TXNE	J1,NA.OVP		; OVERPRINT
	TXO	DS,MO%HE
	JRST	ATTMX

; CDR
ATTMC:	TXNE	J1,NA.OMD		; OUT OF MEDIA
	TXOA	DS,MO%HEM
	TXZ	DS,MO%HEM
	TXNE	J1,NA.JAM!NA.OOF!NA.NOE	; MISC GARBAGE
	TXO	DS,MO%HE
	TXNN	J1,200			; CHECK EXTENSION
	JRST 	ATTMX
	ILDB	J1,NRDRPT(R)		; BYTE 2 FLAGS
	TXNE	J1,NA.OUF		; OUTPUT FULL
	TXOA	DS,MO%SFL
	TXZ	DS,MO%SFL
	TXNE	J1,NA.NAC!NA.RNA
	TXO	DS,MO%HE
	TXNE	J1,NA.DTO		; DEVICE TIME OUT
	TXOA	LS,NRD.TO
	TXZA	LS,NRD.TO
	TXO	DS,MO%FER
	TXNE	J1,NA.PF		; PICK FAILURE
	TXOA	DS,MO%PCK
	TXZ	DS,MO%PCK
	TXNE	J1,NA.REG!NA.RAP	; MISC MUNG
	TXO	DS,MO%FER
	TXNN	J1,200			; CHECK EXTENSION
	JRST	ATTMX
	ILDB	J1,NRDRPT(R)		; BYTE 3 FLAGS
	TXNE	J1,NA.IVP		; INVALID PUNCH ERROR
	TXOA	DS,MO%RCK
	TXZ	DS,MO%RCK

; DONE WITH DEVICE STATUS
ATTMX:	ILDB	J1,NRDRPT(R)		; GET LOW PAGE COUNT
	ILDB	J2,NRDRPT(R)		; GET HIGH PAGE COUNT
	DPB	J2,[POINT 8,J1,27]
	MOVEM	J1,NRDLPC(R)		; SAVE COUNT FOR THIS UPDATE
	$RET

; FEATURES MESSAGE FORMAT:
;	<NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
;   FEATURE SPEC FORMAT:
;	<FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
;	VALUE FORMAT:
;	CLASS 0:	<VALUE>			(LSB)
;	CLASS 1:	<CNT><CNT BYTES>	(LEAST SIGNIFICANT BYTE 1ST)

FTRMSG:	$CALL	SAV4
	IBP	NRDRPT(R)		; SKIP NURD FLAGS
	ILDB	J1,NRDRPT(R)		; GET SEQ NO.
	MOVEM	J1,NRDFSQ(R)
	ILDB	C,NRDRPT(R)		; GET NO. FEATURE SPECS
	MOVE	D,NRDRCN(R)		; MSG LENGTH
	SUBI	D,3			; SUBSTRACT MSG OVERHEAD
	JUMPL	D,[NRDR .,,CPOPJ]	; PRETTY SHORT FEATURE MSG

; PROCESS NEXT FEATURE SPEC
FTRM1:	SOJL	C,FTRXIT
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	A,NRDRPT(R)		; GET FEATURE ID
	CAILE	A,FE.DWD
	JRST	FTRM2
	LSH	A,1			; CALC CELL LOC
	ADDI	A,NRDFET(R)
	JRST	FTRM6

; NOT A COMMON FEATURE - TRY DEVICE SPECIFIC
FTRM2:	TXNN	LS,NRD.LP
	JRST	FTRM3			; CDR
	CAIL	A,LP.HT			; LPT
	CAILE	A,LP.OPV
	JRST	FTRM4			; NOT LPT
	SUBI	A,LP.HT
	LSH	A,1
	ADDI	A,NRDLPF(R)
	JRST	FTRM6

FTRM3:	CAIE	A,CD.CWD		; CDR
	JRST	FTRM4			; NOT CDR
	SUBI	A,CD.CWD
	LSH	A,1
	ADDI	A,NRDCRF(R)
	JRST	FTRM6

FTRM4:	CAIE	A,FE.ALL		; ALLNESS ?
	JRST	FTRM5			; NO -  A MYSTERY FID
	IBP	NRDRPT(R)		; FLUSH FLAGS
	IBP	NRDRPT(R)		; FLUSH CLASS
	IBP	NRDRPT(R)		; FLUSH RESPONSE
	SUBI	D,3
	JRST	FTRM1

FTRM5:	SETZM	NRDUFE(R)		; UNKNOWN FID
	DPB	A,[POINT 8,NRDUFE(R),7]	; SAVE ID FOR LAUGHS
	MOVEI	A,NRDUFE(R)
	SKIPA

FTRM6:	SETZM	(A)			; A = PTR TO FEATURE CELL
	SETZM	1(A)			; INIT THE CELL AND LOAD NEW STUFF
	MOVEI	J1,1
	DPB	J1,FRDP			; SET FEATURE READ FLAG
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	J1,NRDRPT(R)		; GET FLAGS
	DPB	J1,FFLP
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	J1,NRDRPT(R)		; GET CLASS
	DPB	J1,FCLP
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	J2,NRDRPT(R)		; GET RESPONSE
	DPB	J2,FRSP
	JUMPN	J2,FTRM1		; NON-ZERO RESPONSE(ERROR)==> NO VALUE
					; EXTRACT THE FEATURE VALUE
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	B,NRDRPT(R)		; GET LOW VALUE
	JUMPE	J1,FTRM7			; CLASS 0=> B = VALUE
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	J1,NRDRPT(R)		; CLASS 1=> B = CNT, GET J1 = LOW VALUE
	EXCH	B,J1			; B = LOW VALUE, J1 = CNT
	DPB	J1,FLNP			; SAVE LENGTH OF VALUE
	CAILE	J1,2
	JRST	FTRM8			; STRING

FTRM7:	DPB	B,FVLPL			; DEP LOW VALUE
	SOJLE	J1,FTRM1			; COUNT THE BYTES
	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	B,NRDRPT(R)		; GET HIGH VALUE
	DPB	B,FVLPH
	JRST	FTRM1

FTRM8:	ADDI	J1,3			; ROUND NUMBER OF BYTES TO FULL WORD
	LSH	J1,-2			;   AND GET NUMBER OF WORDS NEEDED
	$CALL	M%GMEM			; GET THE MEMORY
	EXCH	J1,J2			; J1 = ADDR, J2 = LENGTH
	HRRM	J1,(A)			; SAVE PTR TO STRING
	HRLI	J1,(POINT 8)
	JRST	FTRM9A

FTRM9:	SOJL	D,[NRDR .,,FTRXIT]	; MSG TOO SHORT
	ILDB	B,NRDRPT(R)		; GET NEXT VALUE BYTE
FTRM9A:	IDPB	B,J1			; STUFF IT
	SOJG	J2,FTRM9
	JRST	FTRM1

; SPECIAL FEATURE VALUE CHECKS
FTRXIT:	MOVEI	A,NFELCR(R)		; CHECK FE.LCR=> MO%LCP STATE
	LDB	J1,FRDP			; CHECK IF DEFINED YET
	JUMPE	J1,CPOPJ		; NOT READ YET
	LDB	J1,FRSP			; CHECK RESPONSE
	JUMPN	J1,CPOPJ		; ERROR RSP INVALIDATES FEATURE VALUE,
					;   PROBABLY=> VALUE CAN'T BE CHANGED,
					;   OR DOESN'T EXIST=> UPPER CASE ONLY
	LDB	J1,FVLP			; GET THE FEATURE VALUE
	SKIPE	J1
	TXZA	DS,MO%LCP		; UPPER CASE
	TXO	DS,MO%LCP		; LOWER CASE
	$RET


FRDP:	POINT	1,(A),8		; FEATURE READ FLAG
FLNP:	POINT	8,(A),17	; FEATURE VALUE LENGTH
FVLP:	POINT	18,(A),35	; FEATURE VALUE
FVLPL:	POINT	8,(A),35	; LOW FEATURE VALUE
FVLPH:	POINT	8,(A),27	; HIGH FEATURE VALUE
FFLP:	POINT	9,1(A),8	; FEATURE FLAGS
FCLP:	POINT	9,1(A),17	; FEATURE CLASS
FRSP:	POINT	18,1(A),35	; FEATURE RESPONSE

; CONTROL MESSAGE FORMAT:
;	<NM.CTL><NURD FLAGS><SEQ NO.><COMMAND><RESPONSE>

CTLMSG:	IBP	NRDRPT(R)		; SKIP NURD FLAGS
	ILDB	J1,NRDRPT(R)		; SEQ NO.
	HRLM	J1,NRDCSQ(R)		; SAVE
	ILDB	J1,NRDRPT(R)		; COMMAND
	MOVSM	J1,NRDCCR(R)
	ILDB	J1,NRDRPT(R)		; RESPONSE
	HRRM	J1,NRDCCR(R)		; SAVE IT TOO
	$RET


; CAPABILITIES MESSAGE FORMAT:
;	<NM.CAP><NURD FLAGS><LIST BYTE COUNT>< COUNT FID'S>

CAPMSG:	IBP	NRDRPT(R)		; SKIP	NURD FLAGS
	ILDB	J1,NRDRPT(R)		; BYTE COUNT
	AOS	J1			; TOTAL LIST LENGTH
	ADDI	J1,3			; CALC NUMBER OF WORDS NEEDED
	LSH	J1,-2			; ...
	HLRZ	J2,NRDCAP(R)		; CHECK FOR PREVIOUS LIST
	JUMPE	J2,CAPM1		; VIRGIN
	CAMG	J1,J2			; IS IT BIG ENOUGH ?
	JRST	CAPM2			; OK
	PUSH	P,J1			; TOO SHORT - SAVE NEW LENGTH
	MOVE	J1,J2			; GET OLD LENGTH
	HRRZ	J2,NRDCAP(R)		;   AND ADDRESS
	$CALL	M%RMEM			; SEND IT BACK
	POP	P,J1			; GET NEW LENGTH BACK

CAPM1:	$CALL	M%GMEM			; GET A NEW BLOCK
	HRL	J2,J1			; J2 = SIZE,,ADDR
	MOVEM	J2,NRDCAP(R)		; SAVE IT

CAPM2:	LDB	J2,NRDRPT(R)		; GET NUMBER OF BYTES AGAIN
	MOVSI	T1,(POINT 8)		; MAKE PTR TO XFER INTO BLOCK
	HRR	T1,NRDCAP(R)		; ...
	SKIPA	J1,J2			; SKIP INTO CAPM3 WITH LENGTH IN J1

CAPM3:	ILDB	J1,NRDRPT(R)		; GET NEXT BYTE
	IDPB	J1,T1			; XFER IT
	SOJGE	J2,CAPM3		; MOVE EM ALL
	$RET				; DONE

; WAIT FOR RESPONSE OF JUST ISSUED DUMP OR CONTROL MSG
RCVCRS:	MOVEI	T1,NRDTMO		; SET TIMEOUT COUNTER
	MOVEM	T1,NRDTMC(R)		; ...
RCVC1:	MOVE	T1,NRDCSQ(R)		; TEST IF LAST RCVD SEQ=LAST ISSUED SEQ
	TSC	T1,T1			; ...
	JUMPE	T1,[	HRRZ	A,NRDCCR(R)	; YES, GET RESPONSE
			PJRST	CPOPJ1]		;   AND LEAVE
	$CALL	RCVMSG			; RECEIVE SOME MORE MSGS
	  $RET				; READ ERROR
	JUMPL	A,[	SOSGE	NRDTMC(R)	; NOTHING - COUNT THIS LOOP
			$RET			; GIVE UP
			MOVEI	J1,^D500	; WAIT .5 SEC
			DISMS			; ZZZ
			JRST	RCVC1]		; GO CHECK AGAIN
	JUMPG	A,RCVC1			; SOMETHING - GO SEE
	NRDR	,,CPOPJ			; DATA MSG BLOCKING CONTROL MSG

; WAIT FOR ATTENTION MSG RESPONSE TO JUST ISSUED STATUS REQUEST
RCVRQS:	$CALL	RCVCRS			; WAIT FOR RESPONSE TO STATUS REQUEST
	  $RET				; BLOCKED OR READ ERROR
;	$CALLR	RCVRQ			; FINISH UP

; RECEIVE AN ATTENTION MSG
RCVRQ:	MOVEI	T1,NRDTMO		; SET TIMEOUT COUNTER
	MOVEM	T1,NRDTMC(R)		; ...
RCVR1:	$CALL	RCVMSG			; JUST WAIT TIL NEXT ATTN MSG ARRIVES
	  $RET				; READ ERROR
	JUMPL	A,[	SOSGE	NRDTMC(R)	; SPUN OUR WHEELS LONG ENUF ?
			$RET			; YES, SO GIVE UP
			MOVEI	J1,^D500	; NO - WAIT A WHILE
			DISMS			; YAWN
			JRST	RCVR1]		;   AND TRY AGAIN
	JUMPE	A,[NRDR .,,CPOPJ]	; DATA MSG BLOCKING RSP
	CAIE	A,NM.ATT		; CHECK IF ATT MSG RECEIVED
	JRST	RCVR1			; NOPE - TRY AGAIN
	PJRST	CPOPJ1			; GOT IT

; WAIT FOR RESPONSE TO JUST ISSUED FEATURE MSG
FTRWAT:	MOVEI	T1,NRDTMO		; SET TIMEOUT COUNTER
	MOVEM	T1,NRDTMC(R)		; ...
FTRW1:	$CALL	RCVMSG			; RECEIVE SOMETHING
	  $RET				; READ ERROR
	JUMPL	A,[	SOSGE	NRDTMC(R)	; NOTHING - TRY AGAIN ?
			$RET			; NOPE, GIVE UP
			MOVEI	J1,^D500	; YES, LETS WAIT
			DISMS			; ...
			JRST	FTRW1]		; GO AGAIN
	JUMPE	A,[NRDR .,,CPOPJ]	; FTR RSP BLOCKED BY DATA MSG
	CAIE	A,NM.FTR		; FEATURE MSG ?
	JRST	FTRW1			; NO, LOOK FURTHER
	MOVE	T1,NRDFSN(R)		; COMPARE LAST SEQ RECEIVED
	CAMN	T1,NRDFSQ(R)		;   TO LAST ONE SENT
	PJRST	CPOPJ1			; THIS IS IT !
	JRST	FTRW1			; DRUDGERY

; CONTROL MESSAGE FORMAT:
;	<NM.CTL><NURD MSG FLGS><SEQ NO.><COMMAND><RESULT>

MKCMSG:	PUSH	P,T1			; SAVE THE COMMAND
	$CALL	SBFINI			; INIT THE BUFFER
	MOVEI	T1,NM.CTL
	IDPB	T1,NRDSPT(R)		; CONTROL MSG TYPE
	SETZ	T2,
	IDPB	T2,NRDSPT(R)		; NURD MSG FLAGS
	AOS	T1,NRDSEQ(R)		; GEN NEXT CONTROL SEQ NO.
	ANDI	T1,377			; 8 BIT WRAP
	HRRM	T1,NRDCSQ(R)		; SAVE LAST SENT SEQ NO.
	IDPB	T1,NRDSPT(R)		; NEXT CONTROL SEQ NO.
	POP	P,T1
	IDPB	T1,NRDSPT(R)		; COMMAND
	IDPB	T2,NRDSPT(R)		; NULL RESULT
	$RET				; DONE

SNDDMP:	SKIPA	T1,[NC.DMP]		; SEND A DUMP OUT BUFFER MSG
SNDRQS:	MOVEI	T1,NC.RQS		; SEND A STATUS REQUEST MSG
	$CALL	MKCMSG			; MAKE THE MSG
	$CALL	SAV4J
	MOVE	J1,NRDJFN(R)
	$CALL	SNDBUF			; NORMAL MSG
	  JRST	ERRTN			; PROBLEMS
	$RET

SNDCAB:	SKIPA	T1,[NC.CAB]		; SEND A CLEAR ABORT MSG
SNDAUC:	MOVEI	T1,NC.AUC		; SEND AN ABORT UNTIL CLEAR MSG
MSNDIC:	$CALL	MKCMSG			; MAKE THE MSG
	$CALL	SAV4J
	MOVE	J1,NRDJFN(R)
	$CALLR	SNDINT			; DO THE INTERRUPT MSG AND RETURN

SNDRES:	MOVEI	T1,NC.RES		; SEND A RESUME MSG
	$CALL	MSNDIC			; INTERRUPT MSG
	TXO	LS,NRD.RS		; SET RESUME ISSUED FLAG
	$CALL	INTOFF			; CLEAR ERR FLAGS - FIXED BY ATTN MSG
	TXZ	LS,NRD.FE!NRD.PS!NRD.TO!NRD.OF!NRD.ON!NRD.PL
	MOVEM	LS,NRDSTS(R)		; UPDATE LINK STATUS
	TXZ	DS,MO%FER!MO%HE!MO%SER!MO%RCK!MO%PCK!MO%SFL!MO%HEM!MO%LCI!MO%LPC!MO%EOF!MO%OL
	TXO	DS,MO%IOP		; SET IO IN PROGRESS AGAIN
	MOVEM	DS,NRDDST(R)		; UPDATE DEVICE STATUS
	$CALLR	INTON

; SET LOWER CASE RAISE=> UPPER CASE ONLY PRINTER
SETLCR:	$CALL	SAV3			; SAVE A-C
	TXZ	DS,MO%LCP
	MOVEI	A,FE.LCR		; FID
	MOVEI	B,1			; ITS VALUE
	MOVEI	C,0			; 1 BIT VALUE
	$CALLR	SETFTR


; SET THE DATA MODE
SETMOD:	$CALL	SAV3
	MOVEI	A,FE.DAT		; FEATURE ID
	TXNN	LS,NRD.IM!NRD.AI	; DETERMINE DATA MODE
	JRST	SETMDA			; ASCII
	TXNN	LS,NRD.AI
	SKIPA	B,[DM.CLI]		; COLUMN IMAGE
	MOVEI	B,DM.AUG		; AUGMENTED COLUMN IMAGE
	SKIPA
SETMDA:	MOVEI	B,DM.ASC		; ASCII
	MOVEI	C,1			; NO. BYTES IN VALUE
;	$CALLR	SETFTR			; SET THE FEATURE

; FEATURE MESSAGE FORMAT:
;	<NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
;   FEATURE SPEC FORMAT:
;	<FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
;	VALUE FORMAT:
;	CLASS 0		<VALUE - LOW ORDER BIT OF BYTE>
;	CLASS 1		<COUNT><...COUNT BYTES...> (LEAST SIGNIFICANT BYTE 1ST)
;
;	A = FEATURE ID
;	B = VALUE
;	C = NO. BYTES IN VALUE

SETFTR:	$CALL	SBFINI			; INIT THE BUFFER
	MOVEI	T1,NM.FTR
	IDPB	T1,NRDSPT(R)		; MSG TYPE
	SETZ	T2,
	IDPB	T2,NRDSPT(R)		; NURD FLAGS
	AOS	T1,NRDSEQ(R)		; GEN NEXT DATA SEQ NO.
	ANDI	T1,377
	MOVEM	T1,NRDFSN(R)		; SAVE NO. OF LAST FEATURE MSG SENT
	IDPB	T1,NRDSPT(R)		; SEQ NO.
	MOVEI	T1,1			; ONLY ALLOWED TO SET  1 AT A TIME
	IDPB	T1,NRDSPT(R)		; NO. FEATURE SPECS
; NOW FORMAT FEATURE SPEC
	IDPB	A,NRDSPT(R)		; FEATURE ID
	MOVEI	T1,NF.CMD		; BIT SET=> SET FEATURE
	IDPB	T1,NRDSPT(R)		; FLAGS
	SKIPE	T1,C			; DETERMINE FEATURE CLASS
	MOVEI	T1,FC.CL1
	IDPB	T1,NRDSPT(R)		; FEATURE CLASS
	IDPB	T2,NRDSPT(R)		; NULL RESPONSE FIELD
	SKIPE	C			; CLASS 0=> INSERT VALUE ONLY
	IDPB	C,NRDSPT(R)		; CLASS 1=> INSERT COUNT THEN VALUE
SETFTV:	IDPB	B,NRDSPT(R)		; INSERT NEXT LOWEST BYTE
	LSH	B,-10
	SOJG	C,SETFTV
	$CALLR	SNDNRD			; SEND THE MESSAGE

; FEATURE MESSAGE FORMAT:
;	<NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
;   FEATURE SPEC FORMAT:
;	<FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
;	VALUE FORMAT:
;	CLASS 0		<VALUE - LOW ORDER BIT OF BYTE>
;	CLASS 1		<COUNT><...COUNT BYTES...> (LEAST SIGNIFICANT BYTE 1ST)
;
;	A = FEATURE ID
;	B = FLAG FIELD
;	C = CLASS FIELD

REDFTR:	$CALL	SBFINI			; INIT THE BUFFER
	MOVEI	T1,NM.FTR
	IDPB	T1,NRDSPT(R)		; MSG TYPE
	SETZ	T2,
	IDPB	T2,NRDSPT(R)		; NURD FLAGS
	AOS	T1,NRDSEQ(R)		; GEN NEXT DATA SEQ NO.
	ANDI	T1,377
	MOVEM	T1,NRDFSN(R)		; SAVE NO. OF LAST FEATURE MSG SENT
	IDPB	T1,NRDSPT(R)		; SEQ NO.
	MOVEI	T1,1			; ONLY ALLOWED TO SET  1 AT A TIME
	IDPB	T1,NRDSPT(R)		; NO. FEATURE SPECS
; NOW FORMAT FEATURE SPEC
	IDPB	A,NRDSPT(R)		; FEATURE ID
	IDPB	B,NRDSPT(R)		; FLAGS
	IDPB	C,NRDSPT(R)		; FEATURE CLASS
	IDPB	T2,NRDSPT(R)		; NULL RESPONSE FIELD
;	$CALLR	SNDNRD			; SEND THE MESSAGE

SNDNRD:	$CALL	SAV4J			; SEND REMAINING OUTPUT
	MOVE	J1,NRDJFN(R)
	$CALL	SNDBUF
	  JRST	ERRTN			; DEVICE WENT OFFLINE
	$RET

; READ ALL THE DEVICE FEATURES
RDFTRS:	$CALL	SAV3
	MOVEI	A,FE.ALL		; FEATURE ID
	SETZB	B,C			; B = FLAG FIELD, C = CLASS FIELD
	$CALL	REDFTR			; SEND A READ FEATURE MSG
	$CALLR	FTRWAT			; WAIT ON RESPONSE

; INIT NRDSBF FOR USE
SBFINI:	MOVEI	T1,NRDSBF+1(R)
	HRLI	T1,-1(T1)
	SETZM	-1(T1)
	BLT	T1,NRDSBF+NRDBSZ/4-1(R)
	MOVE	T1,[POINT 8,NRDSBF(R)]
	MOVEM	T1,NRDSPT(R)
	$RET

SUBTTL	Miscellaneous Support Functions

; MAP A DEVICE SPEC
;
; INPUT:  J2 = PTR TO DEVICE SPEC: "<NODE>::P<DEV>[<UNIT>]:"
;
; OUTPUT: DEVICE SPEC IN RDHOST(R)
;	  T1,T2,J1,J2 = CLOBBERED
MAPDEV:	TLC	J2,-1			; GENERIC POINTER ?
	TLCN	J2,-1			;   BACK TO ORIG, SKIP IF WAS NONZERO
	HRLI	J2,(POINT 7)		; IT WAS GENERIC - MAKE IT SPECIFIC
	$CALL	EFADBY			; CALC EFFECTIVE ADDR
	MOVEI	J1,6			; LIMIT FOR HOST NAME
	SKIPA	T1,[POINT 7,RDHOST(R)]
MAPD1:	IDPB	T2,T1
	ILDB	T2,J2			; NEXT CH
	JUMPE	T2,MAPD4		; END OF STRING
	CAIE	T2,":"
	JRST	[	SOJGE	J1,MAPD1	; END OF HOST NAME
			ERRI	NODX01,CPOPJ]	; HOST NAME TOO LONG
	MOVE	T1,[POINT 7,RDDEV(R)]
	MOVEI	J1,4			; ALLOW 3 DEV + 1 UNIT
	ILDB	T2,J2
	JUMPE	T2,MAPD4
	CAIN	T2,":"
	ILDB	T2,J2			; FLUSH EXTRA :
	JUMPE	T2,MAPD4
	CAIN	T2,"P"			; FLUSH LEADING P
MAPD3:	ILDB	T2,J2
	JUMPE	T2,MAPD4
	CAIN	T2,":"
	JRST	MAPD4
	CAIE	T2,"T"			; FLUSH T FROM LPT
	CAIN	T2,"D"			; FLUSH D FROM CDR
	SKIPA
	IDPB	T2,T1
	SOJGE	J1,MAPD3
	ERRI	ARGX19,CPOPJ		; INVALID UNIT NO.

MAPD4:	LDB	T2,T1			; GET LAST CH
	CAIL	T2,"0"
	CAILE	T2,"9"
	MOVEI	T2,"0"			; USE A DEFAULT OF ZERO
	IDPB	T2,T1
	LDB	T1,[POINT 14,RDDEV(R),13] ; GET 1ST 2 CHARS OF DEV NAME
	CAIN	T1,"CR"
	JRST	MAPD5
	CAIE	T1,"LP"
	ERR	GJFX16,CPOPJ		; NO SUCH DEVICE
	TXOA	LS,NRD.LP		; SET DEVICE= LPT
MAPD5:	TXZ	LS,NRD.LP		; SET DEVICE= CDR
CPOPJ1:	AOS	(P)			; MAKE IT A SKIP RETURN
CPOPJ:	$RET				; RETURN

; GNRxSP
; GNRMSP - CREATE AN NRM JFN SPEC
; GNRDSP - CREATE AN NRD JFN SPEC
;
; INPUT:  DEVICE SPEC IN RDHOST(R)
;
; OUTPUT: A = PTR TO THE SPEC ON STACK
;	  -1(A) = PTR TO RESTORE PDL FROM
;	  T1,T2 = CLOBBERED

GNRMSP:	TDZA	T2,T2			; ZERO SIGNALS NRM SPEC
GNRDSP:	MOVEI	T2,1			; ONE SIGNALS JFN SPEC
	POP	P,T1			; REMOVE THE RETURN ADR
	MOVE	A,P			; GET RESTORATION PDL PTR
	PUSH	P,A			; SAVE IT ON STACK
	MOVSI	A,(POINT 7)		; A = PTR TO BEG OF SPEC
	HRRI	A,1(P)
	ADD	P,[6,,6]		; 30 BYTE SPEC
	PUSH	P,T1			; PUT RETURN ADR BACK ON
	$CALL	SAV2			; SAVE A & B
	MOVE	B,[POINT 7,[ASCIZ .DCN:.]]
	$CALL	INSTR			; INSERT NSP DEV TYPE
	MOVE	B,[POINT 7,RDHOST(R)]
	$CALL	INSTR			; INSERT NODE NAME
	MOVE	B,GNRTB(T2)		; GET ID STRING
	$CALL	INSTR			; INSERT OBJECT AND ATRIB.
	MOVEI	T1,"0"			; USERID OF 20 MEANS LP
	TXNN	LS,NRD.LP		; LPT?
	MOVEI	T1,"1"			; NO,USERID OF 21 MEANS CR
	IDPB	T1,A			; STORE FINAL CHARACTER
	SETZ	T1,			; MAKE IT ASCIZ STRING
	IDPB	T1,A			; ...
	$RET				; RET NRM JFN SPEC ON STACK,

GNRTB:	POINT 7,[ASCIZ .-NRM;USERID:2.]
	POINT 7,[ASCIZ .-002;USERID:2.]

INSTR:	ILDB	T1,B			; A = DEST PTR, B = SRC PTR
	JUMPE	T1,CPOPJ		; QUIT ON NULL BYTE
	IDPB	T1,A			; INSERT THIS BYTE IN DEST STRING
	JRST	INSTR			; HOHUM

; EFADR - EFFECTIVE ADDRESS CALCULATION FUNCTION
;	ENTRY:	T2 = WORD TO BEGIN EFFECTIVE ADR CALC ON
;		REGS 0-R SAVED AT RDSAVE(R)
;	EXIT:	T1 = EFFECTIVE ADDRESS

EFADR:	LDB	T1,[POINT 4,T2,17]	; GET INDEX FIELD
	JUMPE	T1,EFAD1		; NO INDEXING
	CAIG	T1,16			; CHECK FOR T1 -> SAVED AC
	ADDI	T1,RDSAVE(R)		; T1 = PTR TO REG SLOT
	CAIN	T1,P			; CHECK FOR STACK REFERENCE
	JRST	[	MOVE	T1,RDEPDL(R)	; YES, GET CONTENT BEFORE NURD
			SOJA	T1,.]		; ...
	HRRZ	T1,(T1)			; T1 = PTR TO INDEX REG - GET CONTENTS
EFAD1:	ADDI	T1,(T2)			; T1 = INDEXED ADDRESS
	CAIG	T1,R			; CHECK FOR T1 -> SAVED AC
	ADDI	T1,RDSAVE(R)		; T1 = PTR TO REG SLOT
	TLNN	T2,(@)			; CHECK FOR INDIRECT ADDRESSING
	$RET				; ALL DONE
	MOVE	T2,(T1)			; ANOTHER ROUND
	JRST	EFADR			; ...

; BYTE POINTER EFFECTIVE ADDRESS CALCULATION
;
; INPUT:  J2 = BYTE POINTER (NOT THE -1,,ADDR THING)
;
; OUTPUT: J2 = APPROPRIATELY MODIFIED BYTE POINTER
;
; ALL OTHER CONDITIONS ARE EXACTLY AS FOR EFADR, ABOVE.

EFADBY:	MOVE	T2,J2			; COPY THE INPUT ARG
	TLZ	J2,(@(17))		; TURN OFF INDIR AND INDEX IN RETURN
	$CALL	EFADR			; DO THE EFFECTIVE ADDR CALCULATION
	HRR	J2,T1			; ADD THE ADDR HALFWORD
	$RET				; ALL DONE

SUBTTL	Entry Setup

; USER ENTRY REGISTER SETUP
;
; INPUT:  CALL WITH USER REGS UNMODIFIED
;
; OUTPUT: LS = DATA LINK STATUS - NRDSTS(R)
;	  DS = DEVICE STATUS - NRDDST(R)
;	  R  = RDDB PTR
;	  J1,T1,T2 = CLOBBERED

SETUP1:	PUSH	P,[0]			; NON-SKIP TYPE JSYS
	SKIPA
SETUP2:	PUSH	P,[UJ.XT2]		; SKIP TYPE JSYS
	XOR	J1,SUBJFN		; SEE IF AN OK JFN
	TRNE	J1,-1			; ...
	JRST	[	POP	P,J1		; NO, CLEAN UP STACK
			ERRI	DESX3,CPOPJ]	; SAY WE HAVE A PROBLEM
	XOR	J1,SUBJFN		; BACK TO ORIGINAL J1
	MOVEM	16,RDSAVE+16(J1)	; SAVE THE CALLER AC'S
	MOVEI	16,RDSAVE(J1)		; ...
	BLT	16,RDSAVE+15(J1)	; ...
	HRRZ	R,J1			; SET THE DATABASE POINTER
	POP	P,T2			; GET THE ENTRY FLAG
	AOSA	(P)			; SKIP EXIT
					; SKIP INTO FOLLOWING CODE
; SPECIAL ENTRY FOR UGTJFN
; INPUTS AND OUTPUTS SAME AS SETUPx, ABOVE.
USETUP:	MOVEI	T2,UJ.XT2		; SET FOR SKIP TYPE JSYS
	POP	P,T1			; SAVE INITIAL STATE OF PDL
	MOVEM	P,RDEPDL(R)		;   FOR ERROR EXITS
	PUSH	P,T1			; PUT RETURN ADDRESS BACK ONTO STACK
	MOVE	T1,RDSTS(R)		; RECORD ENTRY STATUS
	TXZ	T1,UJ.XT2		; SET EXIT TYPE
	IOR	T1,T2			; ...
	MOVEI	J1,.FHSLF		; DETERMINE SOFTWARE INTERRUPT STATE
	SKPIR				; SKIP IF ON
	  TXZA	T1,UJ.INT		; INTERRUPTS NOT ON
	TXO	T1,UJ.INT		; INTERRUPTS ARE ON
	TXZ	T1,UJ.TDS		; FLUSH TEMP DISABLE FLAG
	MOVEM	T1,RDSTS(R)		; SAVE ENTRY STATE
	$CALL	INTOFF			; DISABLE INTERRUPTS
	MOVEI	T1,UJ.NRD		; PROCLAIM THAT WE
	IORM	T1,RDSTS(R)		;   IS PROCESSING
	MOVE	LS,NRDSTS(R)		; LOAD DATA LINK STATUS
	MOVE	DS,NRDDST(R)		; LOAD DEVICE STATUS
	$CALL	SETDST			; UPDATE DEVICE STATUS
	MOVEM	DS,NRDDST(R)		;   TO ENTRY STATE
	$CALL	INTON			; ENABLE INTERRUPTS
	TXNE	LS,NRD.OC		; OPEN COMPLETE?
	$CALL	INRDIN			; YES,INIT FOR NURD INTERRUPT MESSAGES
	SETZM	NRDIER(R)		; INIT OUR ERROR PTR AT UJSYS ENTRY
	SETZM	RDERT(R)		; NO ERROR RETURN YET SPECIFIED
	$RET

SUBTTL	Exit Routes & Error Processing

; USER LEVEL ERROR EXIT
ERRTN:	PUSH	P,J2			; J1 = ERROR CODE
	MOVE	J2,J1			; COPY ERROR CODE
	MOVEI	J1,.FHSLF		; SO CAN DO SETER
	SETER				;  ...
	MOVE	J1,J2			; RESTORE J1
	POP	P,J2			;   AND J2
	CAME	R,SUBJFN		; DO WE HAVE A DATABASE ?
	$RET				; NO, LEAVE - NO AC'S SAVED
	$CALL	INTOFF			; DISALLOW INTERRUPTS FOR AWHILE
	MOVE	P,RDEPDL(R)		; RESTORE ENTRY PDL
	MOVEM	J1,RDSAVE+J1(R)		; SET ERROR CODE RETURN
	LDB	T2,[POINT 23,@(P),35]	; GET POSSIBLE ERJMP/ERCAL DISP ADDR
	$CALL	EFADR			;   AND CALC THE EFFECTIVE ADDR TO T1
	LDB	T2,[POINT 13,@(P),12]	; GET OPCODE TO SEE IF ERJMP OR ERCAL
	CAIN	T2,<ERCAL>_-^D23	; HAS CALLER SPECIFIED ERCAL ?
	HRRZM	T1,RDERT(R)		; SET ADDRESS, WITH  0 FLAG
	CAIN	T2,<ERJMP>_-^D23	; WAS AN ERJMP SPECIFIED ?
	HRROM	T1,RDERT(R)		; SET ADDRESS, WITH -1 FLAG
	$CALL	SETDST			; UPDATE DEVICE STATUS
	TXNE	LS,NRD.OF		; IS DEVICE OFFLINE ?
	JRST	[	MOVEM	LS,NRDSTS(R)	; UPDATE STS BEFORE INT
			MOVEM	DS,NRDDST(R)	; ...
			MOVX	J1,NRD.EN	; SEE IF USER IS ENABLED
			TDNE	J1,NRDSTS(R)	;   FOR THIS INTERRUPT
			JRST	CKI3		; SEEMS TO BE
			JRST	ERRTX]		; NOPE, JUST BE QUIET
	MOVE	J1,NRDDST(R)		; GET DEVICE STATUS AT ENTRY
	XOR	J1,DS			; J1 = BITS CHANGED SINCE ENTRY
	MOVE	J2,DS
	AND	J2,J1			; J2 = BITS GONE HIGH
	TXNE	J2,MO%FER!MO%HE!MO%LCI	; CHECK FOR HARD ERRORS
	JRST	CKI2			; HARD ERROR
	TXNE	J2,MO%SER!MO%LPC	; CHECK SOFT ERRORS
	JRST	CKI3			; SOFT ERROR
	TXNN	LS,NRD.LP		; DO WE HAVE LPT ?
	TXNN	J1,MO%EOF		; NO, SEE IF EOF ON CDR
	JRST	ERRTX			; NEITHER LPT, OR EOF ON CDR
	MOVX	J2,1B<.ICEOF>		; EOF IT IS!
	JRST	CKI4			; GO DO IT TO IT
CKI2:	SKIPA	J2,[1B<.ICDAE>]		; HARD=> DATA ERROR
CKI3:	MOVE	J2,NRDCHN(R)		; SOFT=> USE USER DEFINED CHANNEL
CKI4:	MOVEI	J1,.FHSLF
	IIC				; GEN AN INTERRUPT
	  ERJMP	ERRTX			; ??
	SETZM	RDERT(R)		; CLEAR ERCAL/ERJMP INDICATOR
ERRTX:	SKIPN	J1,RDERT(R)		; DO WE HAVE ERJMP/ERCAL TO SIMULATE ?
	JRST	UEXIT			; NOPE
	JUMPG	J1,[	AOS	(P)		; ERCAL, FIX USER'S RETURN ADDR
			PUSH	P,J1		; PUT ERCAL LOC ON STACK
			JRST	UEXIT]		; OK
	HRRM	J1,(P)			; ERJMP, SET APPROP DISPATCH ADDRESS
	$CALLR	UEXIT			; FINISH UP AND LEAVE

; ***	SUCRTN
; THIS IS NORMAL (SUCCESS) EXIT FROM NURD20
SUCRTN:	MOVEI	T1,UJ.XT2		; SUCCESS EXIT
	MOVE	P,RDEPDL(R)		; RESTORE ENTRY PDL
	TDNE	T1,RDSTS(R)		; CHECK EXIT TYPE
	AOS	(P)			; A SKIP RETURN
	$CALL	INTOFF			; TURN OFF INTERRUPTS

UEXIT:	TXZ	LS,NRD.RS		; FLUSH RESUME ISSUED FLAG
	HRRM	LS,NRDSTS(R)		; DATA LINK STATUS, RESTORE USER FLAGS
	MOVEM	DS,NRDDST(R)		; DEVICE STATUS
	MOVE	J3,NRDSTS(R)		; SEE IF WE HAVE
	TXZN	J3,NRD.NO		;   AN ALERT TO REPORT
	JRST	UEX0			; NOPE
	MOVEM	J3,NRDSTS(R)		; CLEAR THE FLAG
	TXNN	J3,NRD.EN		; DOES USER WANT TO KNOW ?
	JRST	UEX0			; NOPE
	MOVEI	J1,.FHSLF		; YES, SO WE WILL
	MOVE	J2,NRDCHN(R)		;   INTERRUPT
	IIC				;      HIM
	  ERJMP	UEX0			; ? WELL, WE REALLY TRIED

UEX0:	MOVEI	T1,UJ.NRD		; UNPROCLAIM NURD PROCESSING
	ANDCAM	T1,RDSTS(R)		; ...
	MOVSI	16,RDSAVE(R)		; RESTORE AC'S
	BLT	16,16			; ...
	$CALL	SAV2J			; SAVE SOME REGISTERS TEMPORARILY
	MOVE	J2,SUBJFN		; GET DATA BASE POINTER
	MOVE	J1,RDSTS(J2)		; GET RDSTS
	PUSH	P,J1			; FOR LATER PROCESSING
	TXNN	J1,UJ.FLS		; ARE WE FLUSHING THE DATA BASE?
	$CALLR	UEXX			; NO, ENABLE INTERRUPTS AND GET OUT
	SKIPN	J1,RDINTB(J2)		; HAVE WE FOOLED WITH INT SYSTEM ?
	JRST	UEX1			; NOPE
	HLRZM	J1,NRDLVL-1(J1)		; YES, SO RESTORE INT PC LOCATION
	MOVEI	J1,.FHSLF		; TURN OFF OUR INTERRUPTS
	MOVX	J2,1B<NRDICH>+1B<NRDDCH>;   BOTH CHANNELS
	DIC				; ...
	MOVE	J2,SUBJFN		; GET RDDB PTR AGAIN
	SKIPN	J2,NRDCAP(J2)		; NOW, CLEAN UP CORE CHUNKS
	JRST	UEX1			; NONE THERE
	HLRZ	J1,J2			; GET LENGTH
	HRRZS	J2			;   AND ISOLATE ADDRESS
	$CALL	M%RMEM			; GIVE IT BACK
UEX1:	MOVEI	J1,RDDBSZ		; NOW FOR MAIN DATABASE
	MOVE	J2,SUBJFN		; GET ADDRESS OF IT
	SETOM	SUBJFN			; CLOBBER POINTER
	$CALL	M%RMEM			; GIVE UP MEMORY

UEXX:	MOVEI	J1,.FHSLF		; SET TO TURN ON INTERRUPT SYS
	POP	P,J2			; GET BACK THE RDSTS WORD
	TXNE	J2,UJ.TDS		; DID WE DISABLE THE INT SYSTEM ?
	EIR				; YES, TURN IT BACK ON
	$RET				;   AND LEAVE	

; INTERNAL ERROR PROCESSOR
; CALL:	INVOKED BY NRDR MACRO
;	SAVES LOCATION OF ERROR IN NRDIER
;
; IN:	 J1 = Error location ,, Error code
;	(P) = Continuation address (return)
;
; OUT:	 J1 = Error code

NRDERR:	TRNN	J1,-1			; ANY CODE SET ?
	HRRI	J1,DCNX8		; NO, SUPPLY THE DEFAULT
	PUSH	P,J1			; SAVE INPUT ARG
	SKIPE	J1,NRDIER(R)		; GET ERR BUFFER PTR
	AOBJN	J1,NR1			; OK, ADVANCE PTR
	MOVSI	J1,-NURDL		; WRAPAROUND
	HRRI	J1,NRDERH(R)		; ...
NR1:	POP	P,(J1)			; SAVE LOCATION,,CODE FOR ERROR
	MOVEM	J1,NRDIER(R)		; UPDATE NRDERH PTR
	HRRZ	J1,(J1)			; ISOLATE CODE IN J1
	TXO	DS,MO%FER!MO%SER	; ALL NRDR'S ARE FATAL
	$RET

SUBTTL	Interrupt Processing

NURDPC:	BLOCK	1			; NURD INTERRUPT LEVEL PC SAVER

; INIT NURD INTERRUPT SERVICE

INRDIN:	SKIPE	RDINTB(R)		; INTERRUPTS ALREADY ENABLED?
	$RET				; YES, JUST EXIT
	$CALL	SAV3J
	MOVEI	J1,.FHSLF
	RIR				; READ USER'S INTERRUPT DATA
	JUMPE	J2,CPOPJ		; SIR HAS NOT BEEN DONE
	MOVE	T1,[NRDLVL,,INRD]
	MOVEM	T1,NRDICH(J2)		; SET NRD SERVICE IN PCHNTB
	MOVE	T1,[NRDLVL,,DNRD]
	MOVEM	T1,NRDDCH(J2)
	MOVEI	T1,NURDPC
	MOVSS	J2
	HRL	J2,NRDLVL-1(J2)		; REMEMBER OLD CONTENTS OF PLEVTB
	MOVEM	T1,NRDLVL-1(J2)		; SET NURD PC SAVE LOC IN PLEVTB
	MOVEM	J2,RDINTB(R)		; SAVE THIS INFO FOR LATER FIXUP
	MOVE	J1,NRDJFN(R)		; ENABLE INTS FOR DATA LINK MSGS
	MOVEI	J2,.MOACN
	MOVX	J3,<.MOCIA>B8+<NRDICH>B17+<NRDDCH>B26
	MTOPR
	MOVEI	J1,.FHSLF
	MOVX	J2,1B<NRDICH>+1B<NRDDCH>
	AIC				; ACTIVATE NRD CHANNEL
	$RET

; TURN ON INTERRUPTS
INTON:	$CALL	SAV1J			; SAVE J1
	MOVEI	J1,UJ.TDS		; CHECK FOR
	TDNN	J1,RDSTS(R)		;   INTERRUPT DISABLE
	$RET				; NOT DISABLED
	ANDCAM	J1,RDSTS(R)		; CLEAR DISABLED FLAG
	MOVEI	J1,.FHSLF		; TURN THE INT SYSTEM
	EIR				;   BACK ON
	$RET				; LEAVE

; TURN OFF INTERRUPTS
INTOFF:	$CALL	SAV1J			; SAVE J1
	MOVEI	J1,UJ.INT		; IS THE INT SYSTEM OFF
	TDNN	J1,RDSTS(R)		; ?
	$RET				; YES, IT IS OFF - GO AWAY
	MOVEI	J1,.FHSLF		; NO, TURN IT OFF
	DIR				; ...
	MOVEI	J1,UJ.TDS		; REMEMBER THAT WE DID IT
	IORM	J1,RDSTS(R)		; ...
	$RET				; LEAVE

; RECEIVED A DATA INTERRUPT
; WE MUST BE CAREFUL TO PRESERVE USER AC'S

DNRD:	PUSH	P,A			; SAVE A COUPLE
	PUSH	P,B			;   OF AC'S
	SKIPG	B,SUBJFN		; GET RDDB POINTER
	JRST	DNRDX			; DEFENSIVE
	MOVEI	A,UJ.RCV		; SET RCV DATA INT FLAG
	IORM	A,RDSTS(B)		; ...
	HRRZ	A,NURDPC		; CHECK FOR POSSIBLE WAIT CONDITIONS
	CAIL	A,SENDER		; ARE WE IN REGION OF INTEREST ?
	CAILE	A,USOWTR		; SOUTR WAIT
	JRST	DNRDX			; NOT IN  SOUTR REGION
	CAIN	A,USOWTR		; AT ACTUAL SOUTR WAIT ?
	JUMPE	J3,[	MOVE	A,NURDPC	; SOUTR IS DONE
			JRST	DNBRK]		; GO SET APPROP PC
	MOVEI	A,UJ.SSO		; SET SUSPENDED SOUTR  FLAG
	IORM	A,RDSTS(B)		; ...
	MOVEI	A,BRKS			; SET BREAK PC
	HLL	A,NURDPC		; ...

DNBRK:	TXO	A,1B5			; SET USER MODE
	MOVEM	A,NURDPC		; TOP LEVEL WILL RESUME
DNRDX:	POP	P,B			; RESTORE CLOBBERED AC'S
	POP	P,A			; ...
	DEBRK				; DISMISS INTERRUPT

; NURD INTERRUPT MESSAGE PROCESSOR
INRD:	PUSH	P,J1			; SAVE SOME
	PUSH	P,J2			;   AC'S FOR
	PUSH	P,J3			;    WHILE WE
	PUSH	P,J4			;     ARE WORKING
	PUSH	P,R			;       ...
	SKIPG	R,SUBJFN		; GET RDDB FOR THIS FORK
	JRST	INRDX			; DEFENSIVE
	MOVE	J1,NRDJFN(R)		; READ THE MESSAGE
	MOVEI	J2,.MORIM
	MOVEI	J3,NRDIBF(R)
	HRLI	J3,(POINT 8)		; J3 = PTR TO BUFFER
	PUSH	P,J3			; SAVE IT FOR READING
	MTOPR				; GET IT - J4 = NO. CHARS READ
	POP	P,J3
	JUMPE	J4,INRDX		; VACUOUS MSG
	ILDB	J1,J3			; GET MSG TYPE
	CAIE	J1,NM.ALR		; BETTER BE AN ALERT MSG!
	JRST	INRDX			; IGNORE  ???

; ALERT - DEVICE CLAIMS TO BE FIXED
	MOVX	J1,NRD.OF		; WE ARE NO LONGER OFFLINE
	TDNN	J1,NRDSTS(R)		; SEE IF WE EVER KNEW WE WERE OFFLINE
	JRST	[	MOVX	J1,NRD.ON	; NO, OFFLINE NOT HERE YET
			IORM	J1,NRDSTS(R)	; LETS REMEMBER THIS
			JRST	INRDX]		;   FOR LATER
	ANDCAB	J1,NRDSTS(R)		; WE ARE OFFLINE, SO CLEAR IT
	TXNN	J1,NRD.EN		; DOES USER WANT TO KNOW ?
	JRST	INRDX			; NOPE
	MOVX	J1,UJ.NRD		; CHECK FOR
	TDNE	J1,RDSTS(R)		;   NURD PROCESSING
	JRST	[	MOVX	J1,NRD.NO	; WE WANT TO
			IORM	J1,NRDSTS(R)	;   SAY ONLINE
			JRST	INRDX]		;     AS WE LEAVE
	MOVEI	J1,.FHSLF		; ISSUE AN INTERRUPT
	MOVE	J2,NRDCHN(R)		;    ON USER'S CHANNEL
	POP	P,R			; BUT FIRST, BACK TO
	POP	P,J4			;   USER'S AC'S
	POP	P,J3			;   ...
	IIC				; TICKLE !
	  ERJMP	INRDXX			; ??
	JRST	INRDXX			; LEAVE

INRDX:	POP	P,R			; RESTORE AC'S
	POP	P,J4			; ...
	POP	P,J3			; ...
INRDXX:	POP	P,J2			; ...
	POP	P,J1			; ...
	DEBRK				; DISMISS INTERRUPT

SUBTTL	Debug Typeout Routines

TYBUF:	$CALL	SAV4J
	$CALL	SAV4
	$CALL	TCRLF
	TYPE	(Seq: )
	MOVEI	A,NRDSBF(R)
	HRLI	A,(POINT 8)
	IBP	A			; SKIP NURD MSG TYPE
	IBP	A			; SKIP NURD FLGS
	ILDB	J2,A
	$CALL	NUMO			; SEQ NUMBER
	TYPE	(   Flags: )
	ILDB	J2,A
	$CALL	ONUMO			; DATA FLAGS
	TYPE	(   Segs: )
	ILDB	J2,A
	MOVE	B,J2			; SAVE IT
	$CALL	NUMO			; NO. SEGMENTS
	$CALL	TCRLF			; B = NO. OF SEGMENTS
TYBUF1:	SOJL	B,CPOPJ			; DONE
	ILDB	C,A			; GET NEXT SEGMENT HEAD

TYBUF2:	SOJL	C,TYBUF1		; SEG DONE
	ILDB	J1,A
	PBOUT
	JRST	TYBUF2

TCRLF:	TYPE	(
)
	$RET

; CALL WITH NUMBER IN J2, CLOBBERS J1
ONUMO:	SKIPA	J1,[^D8]		; OCTAL OUT
NUMO:	MOVEI	J1,^D10			; DECIMAL OUT
	PUSH	P,J3			; SAVE J3
	MOVE	J3,J1			; SET RADIX
	MOVEI	J1,.PRIOU		; SEND TO TTY
	NOUT				; SEND THE NUMBER
	  JFCL				; ??
	POP	P,J3			; RESTORE J3
	$RET

; MONITOR RECEIVED NURD MESSAGES
RCVTYP:	$CALL	SAV4J
	$CALL	SAV4
	MOVE	D,NRDRCN(R)		; GET BUFFER COUNT
	MOVE	A,NRDRPT(R)		; GET PTR
	SOJL	D,[	TYPE	(Empty message !!)
			$CALLR	TCRLF]
	ILDB	B,A			; GET MSG TYPE
	CAIL	B,NM.OTR
	$RET				; ILLEGAL TYPE
	MOVE	J1,RMONTP(B)		; CHECK IF THIS TYPE MONITORED
	TDNN	J1,DEBUGR
	$RET				; NO
	$CALL	TCRLF
	MOVE	J1,MSGTYP(B)		; TYPE
	TYPE
	TYPE	(   NURD msg flags: )
	SOJL	D,[	TYPE	(...Insuff data)
			$CALLR	TCRLF]
	ILDB	J2,A
	$CALL	ONUMO
	$CALL	TCRLF
	$CALLR	@MTYPER(B)		; DISPATCH TO INDIVIDUAL MSG TYPER

MTYPER:	TYPDAT			; DATA
	TYPATT			; ATTENTION
	TYPFTR			; FEATURES
	TYPCTL			; CONTROL
	TYPALR			; ALERT
	TYPCAP			; CAPABILITIES

MONDAT==1
MONATT==2
MONFTR==4
MONCTL==10
MONALR==20
MONCAP==40

RMONTP:	MONDAT
	MONATT
	MONFTR
	MONCTL
	MONALR
	MONCAP

MSGTYP:	[ASCIZ /Data msg: /]
	[ASCIZ /Attention msg: /]
	[ASCIZ /Feature msg: /]
	[ASCIZ /Control msg: /]
	[ASCIZ /Alert msg: /]
	[ASCIZ /Capabilities msg: /]

; DATA MESSAGE FORMAT:
;	<0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
; SEGMENT FORMENT:
;	<CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>
;
;	A = PTR TO <SEQ NO.>
;	D = REMAINING BUFFER COUNT

TYPDAT:	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	$CALL	TYPSEQ			; SEQ NO.
	TYPE	(   Flags: )
	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	ILDB	B,A
	MOVE	C,[-DMFL,,DMFTX]
	$CALL	TYPAFL			; TYPE THE FLAGS
	TYPE	(   Segment count: )
	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	ILDB	C,A			; GET SEG CNT
	MOVE	J2,C
	$CALL	NUMO
	MOVNI	C,1(C)
	MOVSI	C,(C)			; C = -<CNT+1>,,0

TYPSEG:	$CALL	TCRLF			; END LAST SEQUENCE
	AOBJP	C,TYPDON		; NO MORE SEGS
	TYPE	(Segment: )
	HRRZ	J2,C
	$CALL	NUMO
	TYPE	(   Count: )
	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	ILDB	B,A			; GET SEG SIZE
	MOVE	J2,B
	$CALL	NUMO
	$CALL	TCRLF
	JUMPN	B,TYPSG1
	TYPE	(EOR)
	JRST TYPSEG

TYPSG1:	TXZN	B,200			; CHECK FOR COMPRESSED
	JRST	TYPSG2
	TYPE	(Compressed segment: )
	MOVE	J2,B
	$CALL	NUMO
	MOVEI	J1,"<"
	PBOUT
	TXNE	LS,NRD.IM!NRD.AI
	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	$CALL	TYPITM
	MOVEI	J1,">"
	PBOUT
	JRST	TYPSEG

TYPSG2:	SOJL	B,TYPSEG		; UNCOMPRESSED
TYPSG3:	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	TXNE	LS,NRD.IM!NRD.AI
	SOJL	D,TYPDXR		; NOT ENOUGH FOR NEXT BYTE
	$CALL	TYPITM
	SOJL	B,TYPSEG
	TXNN	LS,NRD.IM!NRD.AI
	JRST	TYPSG3
	MOVEI	J1,","			; SEPARATE IMAGE ITEMS BY COMMAS
	PBOUT
	JRST	TYPSG3

TYPDXR:	TYPE	(...Insuff data)
	$CALL	TCRLF
TYPDON:	$RET

TYPSEQ:	TYPE	(Sequence: )
	ILDB	J2,A
	$CALLR	NUMO

TYPITM:	ILDB	J1,A			; TYPE A DATA ITEM
	TXNN	LS,NRD.IM!NRD.AI	; CHECK TWO BYTES
	JRST	[	PBOUT			; ASCII
			$RET]			; ...
	ILDB	J2,A			; IMAGE MODE
	DPB	J2,[POINT 8,J1,27]
	MOVE	J2,J1
	$CALLR	ONUMO


DEFINE	DATXT (FLAG,TEXT) <
	ND.'FLAG,,[ASCIZ /'TEXT'/]
>
DMFTX:	DATXT	ACK,Acknowledge
	DATXT	IER,Input-error
	DATXT	EOF,EOF
DMFL==.-DMFTX

TYPALR:
TYPCAP:	JRST	TCRLF

; ATTENTION MSG FORMAT:
;   <NM.ATT><NURD FLGS><LAST SEQ NO.><ATT. REASON CODE><DEVSTS 1-3><PAGE CNT 2>
;
;	A = PTR TO <LAST SEQ NO.>
;	D = REMAINING BYTES IN BUFFER

TYPATT:	SOJL	D,TYPDXR
	$CALL	TYPSEQ			; SEQ NO.
	TYPE	(   Reason: )
	SOJL	D,TYPDXR
	ILDB	B,A			; GET REASON
	CAIG	B,N.APLE
	SKIPA	J1,RESNCD(B)		; EXPLAIN WHY
	MOVEI	J1,[ASCIZ /Apparently just for kicks/]
	TYPE
	$CALL	TCRLF			; BEGIN FLAGS ON NEW LINE
	TYPE	(Flags: )
	SOJL	D,TYPDXR
	ILDB	B,A			; GET FLAGS
	MOVE	C,[-BYT1L,,BYT1TB]
	$CALL	TYPAFL
	TXNN	B,200			; CHECK EXTENSION
	JRST	TYPAPG
	SOJL	D,TYPDXR
	ILDB	B,A
	MOVE	C,[-BYT2L,,BYT2TB]
	$CALL	TYPAFL
; DEVICE SPECIFIC FLAGS
	TXNN	LS,NRD.LP
	SKIPA	C,[-CBYT2L,,CBYT2T]
	MOVE	C,[-LBYT2L,,LBYT2T]
	$CALL	TYPAFL
	TXNN	B,200			; CHECK FOR THIRD BYTE
	JRST	TYPAPG
	SOJL	D,TYPDXR
	ILDB	B,A
	TXNN	LS,NRD.LP
	SKIPA	C,[-CBYT3L,,CBYT3T]
	MOVE	C,[-LBYT3L,,LBYT3T]
	$CALL	TYPAFL

TYPAPG:	$CALL	TCRLF			; PAGE COUNT ON NEW LINE
	TYPE	(Page count: )
	SOS	D
	SOJL	D,TYPDXR
	ILDB	J2,A
	ILDB	J1,A
	DPB	J1,[POINT 8,J2,27]
	$CALL	NUMO
	$CALLR	TCRLF

TYPAFL:	TSNN	B,(C)			; CHECK FOR BIT SET
	JRST	TYPAFX			;   B = FLAGS, C = TABLE
	HRRZ	J1,(C)			; YES - GET TEXT
	TYPE
	MOVEI	J1," "
	PBOUT
TYPAFX:	AOBJN	C,TYPAFL
	$RET

RESNCD:	[ASCIZ /No reason at all, really/] ; RESERVED
	[ASCIZ /Device status change/]
	[ASCIZ /Data acknowledgement/]
	[ASCIZ /Requested/]
	[ASCIZ /Abort received/]
	[ASCIZ /Page limit exceeded/]

DEFINE	ATTXT (FLAG,TEXT) <
	NA.'FLAG,,[ASCIZ /'TEXT'/]
>
BYT1TB:	ATTXT	FAT,Fatal
	ATTXT	OFL,Offline
	ATTXT	PAU,Paused
	ATTXT	OMD,Out-of-media
	ATTXT	JAM,Jam
	ATTXT	OOF,Opr-offline
	ATTXT	NOE,Non-opr-error
BYT1L==.-BYT1TB

BYT2TB:	ATTXT	OUF,Output-full
	ATTXT	NAC,Device-not-accessible
	ATTXT	DTO,Device-timeout
	ATTXT	RNA,Resource-not-avail
BYT2L==.-BYT2TB

LBYT2T:	ATTXT	PSE,Paper-slew
	ATTXT	INK,Ink
LBYT2L==.-LBYT2T

LBYT3T:	ATTXT	OVP,Overprint
LBYT3L==.-LBYT3T

CBYT2T:	ATTXT	PF,Pick-fail
	ATTXT	RAP,Read-after-punch-error
	ATTXT	REG,Registration-error
CBYT2L==.-CBYT2T

CBYT3T:	ATTXT	IVP,Invalid-punch
CBYT3L==.-CBYT3T

; FEATURES MESSAGE FORMAT:
;	<NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
;   FEATURE SPEC FORMAT:
;	<FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
;	VALUE FORMAT:
;	CLASS 0:	<VALUE>			(LSB)
;	CLASS 1:	<CNT><CNT BYTES>	(LEAST SIGNIFICANT BYTE 1ST)
;
;	A = PTR  TO <SEQ NO.>
;	D = REMAINING BYTES IN BUFFER

TYPFTR:	SOJL	D,TYPDXR
	$CALL	TYPSEQ			; SEQ NO.
	TYPE	(   No. feature specs: )
	SOJL	D,TYPDXR
	ILDB	C,A			; GET NO. SPECS
	MOVE	J2,C
TYPFT0:	$CALL	NUMO
TYPFT1:	$CALL	TCRLF			; FEATURE SPEC LOOP
	SOJL	C,CPOPJ
	TYPE	(Feature ID: )
	SOJL	D,TYPDXR
	ILDB	B,A			; GET FID
	MOVE	J3,[-TCMNL,,TCMNF]
TYPFT2:	HLRZ	J4,(J3)
	CAMN	B,J4
	JRST	TYPFID
	AOBJN	J3,TYPFT2
	TXNN	LS,NRD.LP		; CHECK DEVICE SPECIFIC FID'S
	SKIPA	J3,[-TCDRL,,TCDRF]
	MOVE	J3,[-TLPTL,,TLPTF]
TYPFT3:	HLRZ	J4,(J3)
	CAMN	B,J4
	JRST	TYPFID
	AOBJN	J3,TYPFT3
	MOVEI	J3,[0,,[[ASCIZ /Mystery feature/],,0]]
TYPFID:	HRRZ	J3,(J3)
	HLRZ	J1,(J3)			; GET FEATURE NAME
	TYPE
	TYPE	(   Flags: )
	SOJL	D,TYPDXR
	ILDB	B,A
	TXNN	B,NF.CMD
	SKIPA	J1,[[ASCIZ /READ/]]
	MOVEI	J1,[ASCIZ /SET/]
	TYPE
	MOVEI	J1,[ASCIZ / STD/]
	TXNE	B,NF.STD
	TYPE
	TYPE	(   Class: )
	SOJL	D,TYPDXR
	ILDB	B,A
	CAILE	B,FC.CL1
	JRST	TYPFC2
	MOVE	J2,B
	$CALL	NUMO
	JRST	TYPFRS

TYPFC2:	CAIE	B,FC.SST
	SKIPA	J1,[[ASCIZ /No class at all/]]
	MOVEI	J1,[ASCIZ /Set-to-std/]
	TYPE

TYPFRS:	MOVE	J4,B			; SAVE CLASS FOR VALUE
	TYPE	(   Response: )
	SOJL	D,TYPDXR
	ILDB	B,A
	CAILE	B,TRSPL
	MOVEI	B,TRSPL
	MOVE	J1,TRSPT(B)
	TYPE
	JUMPN	B,TYPFT1		; NO VALUE IF ERROR RESPONSE
	CAILE	J4,FC.CL1
	JRST	TYPFT1			; SET TO STD=> NO VALUE
	TYPE	(   Value: )
	CAIE	J4,FC.CL0
	JRST	TYPVC1
	SOJL	D,TYPDXR
	ILDB	J1,A
	TXNN	J1,1			; 1 BIT VALUE
	SKIPA	J1,[[ASCIZ /OFF/]]
	MOVEI	J1,[ASCIZ /ON/]
	TYPE
	JRST	TYPFT1

TYPVC1:	SOJL	D,TYPDXR		; TYPE CLASS 1 VALUE,
					;   J3->[[NAME],,VALUE TABLE]
	ILDB	B,A			; GET FIELD SIZE
	JUMPE	B,TYPFT1		; NULL VALUE ??
	SOJL	D,TYPDXR
	ILDB	J2,A			; LOW ORDER BYTE
	SOJE	B,TYPVLW		; 1 BYTE
	SOJG	B,[	AOS	B		; STRING
			MOVE	J1,J2
		TYPST:	PBOUT			; TYPE AS ASCII
			SOJL	B,TYPFT1	; STRING DONE
			SOJL	D,TYPDXR
			ILDB	J1,A
			JRST	TYPST]
	SOJL	D,TYPDXR		; ASSUME 16 BIT NUM
	ILDB	J4,A
	DPB	J4,[POINT 8,J2,27]

TYPVLW:	HRRZ	J3,(J3)			; TYPE BYTE/WORD VALUE,
					;   J3->[[NAME],,VALUE TABLE]
	JUMPE	J3,TYPFT0		; NO INTERPRETATION - TYPE NUMBER

TPVLW1:	SKIPN	J4,(J3)			; SEARCH VALUE TABLE
	JRST	TYPFT0			; UNKNOWN VALUE - TYPE NUMERIC
	HLRZS	J4
	CAME	J4,J2
	AOJA	J3,TPVLW1
	HRRZ	J1,(J3)			; GET STR PTR
	TYPE
	JRST	TYPFT1

DEFINE	FENAM (FTR,TEXT,VALTBL) <
	FTR,,[[ASCIZ /'TEXT'/],,VALTBL]
>
TCMNF:	FENAM 0,<Reserved>		; RESERVED FOR FUTURE ESCAPE CODE
	FENAM FE.DAT,<Data mode>,DATVL	; (CLASS 1)
;	   DM.ASC==		1	; 7 BIT ASCII
;	   DM.CLI==		2	; COLUMNIMAGE
;	   DM.EBC==		3	; EBCDIC
;	   DM.AUG==		4	; AUGMENTED COLUMNIMAGE
;	   DM.AS8==		5	; 8 BIT ASCII
	FENAM FE.SER,<Serial number>	; (CLASS 1)
	FENAM FE.LCR,<Lower case raise>	; (CLASS 0)
	FENAM FE.FWD,<Form width>	; (CLASS 1)
	FENAM FE.EOF,<EOF recognition>,EOFVL	; (CLASS 1)
;	   EO.ASC==		1	; ASCII
;		EOFASC==		7417	; ASCII EOF (COLUMN 1) PUNCH
;	   EO.IMG==		2	; IMAGE
	FENAM FE.DVT,<Device type>	; (CLASS 1)
	FENAM FE.TRN,<Record truncation>; (CLASS 0)
	FENAM FE.FNM,<Form name>	; (CLASS 1)
	FENAM FE.DWD,<Device width>	; (CLASS 1)
	FENAM FE.ALL,<All>
TCMNL==.-TCMNF

DEFINE	FEVAL (VAL,TEXT) <
	VAL,,[ASCIZ \'TEXT'\]
>
DATVL:	FEVAL	DM.ASC,<ASCII>
	FEVAL	DM.CLI,<Column-image>
	FEVAL	DM.EBC,<EBCDIC>
	FEVAL	DM.AUG,<Augmented-column-image>
	FEVAL	DM.AS8,<ASCII(8)>
	0				; TABLE TERMINATOR
EOFVL:	FEVAL	EO.ASC,<ASCII>
	FEVAL	EO.IMG,<Image>
	0				; TABLE TERMINATOR

TLPTF:	FENAM LP.HT,<Horizontal tab stop>	; (CLASS 1)
	FENAM LP.SFC,<Std vertical forms control>	; (CLASS 0)
	FENAM LP.OVP,<Overprint limit>	; (CLASS 1)
	FENAM LP.CVF,<Custom VFU>	; (CLASS 1)
	FENAM LP.FCC,<FORTRAN carriage control>	; (CLASS 0)
	FENAM LP.VFR,<Variable forms ratio>,VFRVL	; (CLASS 1)
;	   VF.6LI==		1	; 6 LINES PER INCH
;	   VF.8LI==		2	; 8 LINES PER INCH
	FENAM LP.CHS,<Character set>,CHSVL	; (CLASS 1)
;	   CH.64==		1	; 64 CHARACTER SET
;	   CH.96==		2	; 96 CHARACTER SET
	FENAM LP.PLE,<Page limit enforcement>	; (CLASS 1)
	FENAM LP.OPV,<Optical VFU name>	; (CLASS 1)
TLPTL==.-TLPTF

VFRVL:	FEVAL	VF.6LI,<6 lpi>
	FEVAL	VF.8LI,<8 lpi>
	0				; TABLE TERMINATOR

CHSVL:	FEVAL	CH.64,<64 char set>
	FEVAL	CH.96,<96 char set>
	0				; TABLE TERMINATOR

TCDRF:	FENAM CD.CWD,<Card width>	; (CLASS 1)
TCDRL==.-TCDRF

TRSPT:	[ASCIZ /0/]
	[ASCIZ /Unsupported feature/]
	[ASCIZ /Bad class specified/]
	[ASCIZ /No standard value/]
	[ASCIZ /Data or format error/]
	[ASCIZ /Change pending/]
	[ASCIZ /Insufficient buffer space to send this message !!/]
	[ASCIZ /Device not paused/]
TRSPL==.-TRSPT

; CONTROL MESSAGE FORMAT:
;	<NM.CTL><NURD FLAGS><SEQ NO.><COMMAND><RESPONSE>
;
;	A = PTR TO <SEQ NO.>
;	D = REMAINING BYTES IN BUFFER

TYPCTL:	SOJL	D,TYPDXR
	$CALL	TYPSEQ			; SEQUENCE NO.
	TYPE	(   Command: )
	SOJL	D,TYPDXR
	ILDB	B,A			; GET COMMAND
	CAILE	B,NC.RQC
	MOVEI	B,ILCMD
	MOVE	J1,TYPCTB(B)		; GET TEXT
	TYPE
	TYPE	(   Response: )
	SOJL	D,TYPDXR
	ILDB	C,A			; GET RESPONSE CODE
	DPB	B,[POINT 8,C,27]	; MAKE COM.RES CODE
	MOVE	B,[-CRESL,,CRESTB]

TYPCT1:	HLRZ	J1,(B)
	CAME	J1,C
	AOBJN	B,TYPCT1
	HRRZ	J1,(B)
	TYPE
	$CALLR	TCRLF

TYPCTB:	[ASCIZ /Undefined command(0)/]
	[ASCIZ /Abort til EOF/]
	[ASCIZ /Abort til clear/]
	[ASCIZ /Clear abort/]
	[ASCIZ /Request status/]
	[ASCIZ /Dump output buffers/]
	[ASCIZ /Pause/]
	[ASCIZ /Resume/]
ILCMD:	[ASCIZ /Undefined command/]
	[ASCIZ /Request capabilities/]

DEFINE	CTXT (COM,RES,TEXT) <
	<NC.'COM>B27!<NR.'RES>B35,,[ASCIZ /'TEXT'/]
>
CRESTB:	CTXT	AUE,ABS,<Abort state>
	CTXT	AUE,NAB,<Nothing to abort>
	CTXT	AUE,NOE,<No EOF defined!>
	CTXT	AUC,ABS,<Abort state>
	CTXT	AUC,NAB,<Nothing to abort>
	CTXT	CAB,ACC,<Abort cleared>
	CTXT	CAB,ACN,<Abort not set>
	CTXT	RQS,ATT,<Attention message follows>
	CTXT	DMP,DMP,<Dumping>
	CTXT	DMP,NOB,<No output buffered>
	CTXT	PAU,DPS,<Device will pause>
	CTXT	PAU,PAU,<Device already paused>
	CTXT	PAU,NDP,<No data transfer to pause>
	CTXT	RES,RES,<Device will resume>
	CTXT	RES,NPS,<Device not paused>
	CTXT	RES,NDR,<No data xfer to resume>
	CTXT	RQC,CAP,<Capabilities message follows>
CRESL==.-CRESTB
	[ASCIZ /Undefined response code/]


IFNDEF	DEBUG,<LSTON.> ;   INTERESTING TO LOOK AT, SO XLIST THEM

SUBTTL	AC Save Coroutines

; These routines (SAVxx) act as co-routines to the routines which
; call them, thus no corresponding "restore" routines are needed.
; When the calling routine returns to its caller, it returns via
; the appropriate restore routine, automatically.

SAV1J:	EXCH	J1,(P)			; SAVE J1 GET CALLERS ADDRESS
	PUSH	P,.+3			; SAVE RETURN ADDRESS FOR CALLER
	HRLI	J1,-1(P)		; MAKE IT LOOK LIKE RESULT OF JSA
	JRA	J1,(J1)			; CALL THE CALLER
	  CAIA	.			; NON-SKIP RETURN
	AOS	-1(P)			; SKIP RETURN
	JRST	RES1J			; RESTORE J1

SAV2J:	EXCH	J1,(P)			; SAVE J1 GET CALLERS ADDRESS
	PUSH	P,J2			; SAVE J2
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	J1,-2(P)		; SETUP FOR THE JRA
	JRA	J1,(J1)			; CALL THE CALLER
	  CAIA	.			; NON-SKIP RETURN
	AOS	-2(P)			; SKIP RETURN
	JRST	RES2J			; RESTORE J2,J1

SAV3J:	EXCH	J1,(P)			; SAVE J1 GET RETURN ADDRESS
	PUSH	P,J2			; SAVE J2
	PUSH	P,J3			; SAVE J3
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	J1,-3(P)		; SETUP FOR JRA
	JRA	J1,(J1)			; AND CALL THE CALLER
	  CAIA	.			; NON-SKIP
	AOS	-3(P)			; SKIP RETURN
	JRST	RES3J			; AND RESTORE J3,J2,J1

SAV4J:	EXCH	J1,(P)			; SAVE J1 GET RETURN ADDRESS
	PUSH	P,J2			; SAVE J2
	PUSH	P,J3			; SAVE J3
	PUSH	P,J4			; SAVE J4
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	J1,-4(P)		; SETUP FOR RETURN
	JRA	J1,(J1)			; AND RETURN
	  CAIA	.			; NON-SKIP RETURN
	AOS	-4(P)			; SKIP RETURN

	POP	P,J4			; RESTORE J4
RES3J:	POP	P,J3			; RESTORE J3
RES2J:	POP	P,J2			; RESTORE J2
RES1J:	POP	P,J1			; RESTORE J1
	$RET				; AND RETURN

SAV1:	EXCH	A,(P)			; SAVE A GET CALLERS ADDRESS
	PUSH	P,.+3			; SAVE RETURN ADDRESS FOR CALLER
	HRLI	A,-1(P)			; MAKE IT LOOK LIKE RESULT OF JSA
	JRA	A,(A)			; CALL THE CALLER
	  CAIA	.			; NON-SKIP RETURN
	AOS	-1(P)			; SKIP RETURN
	JRST	RES1			; RESTORE A

SAV2:	EXCH	A,(P)			; SAVE A GET CALLERS ADDRESS
	PUSH	P,B			; SAVE B
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	A,-2(P)			; SETUP FOR THE JRA
	JRA	A,(A)			; CALL THE CALLER
	  CAIA	.			; NON-SKIP RETURN
	AOS	-2(P)			; SKIP RETURN
	JRST	RES2			; RESTORE B,A

SAV3:	EXCH	A,(P)			; SAVE A GET RETURN ADDRESS
	PUSH	P,B			; SAVE B
	PUSH	P,C			; SAVE C
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	A,-3(P)			; SETUP FOR JRA
	JRA	A,(A)			; AND CALL THE CALLER
	  CAIA	.			; NON-SKIP
	AOS	-3(P)			; SKIP RETURN
	JRST	RES3			; AND RESTORE C,B,A

SAV4:	EXCH	A,(P)			; SAVE A GET RETURN ADDRESS
	PUSH	P,B			; SAVE B
	PUSH	P,C			; SAVE C
	PUSH	P,D			; SAVE D
	PUSH	P,.+3			; SAVE RETURN ADDRESS
	HRLI	A,-4(P)			; SETUP FOR RETURN
	JRA	A,(A)			; AND RETURN
	  CAIA	.			; NON-SKIP RETURN
	AOS	-4(P)			; SKIP RETURN

	POP	P,D			; RESTORE D
RES3:	POP	P,C			; RESTORE C
RES2:	POP	P,B			; RESTORE B
RES1:	POP	P,A			; RESTORE A
	$RET				; AND RETURN

	END