Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93d-bb - 7,6/ap017/fal.y17
There is 1 other file named fal.y17 in the archive. Click here to see a list.
	Universal FALUNV - Universal Symbol Definitions for the FAL Modules

	Search	MACTEN,UUOSYM		; Get the standard symbol definitions
	Search	SWIL			; Get some SWIL symbols
	Search	GLXMAC,QSRMAC,ORNMAC	; 'Coupla other nice universals
	Search	ACTSYM			; Get the accounting system symbols

	SALL				; Make the listing look nice
	.Directive	FLBLST		;  very nice

; Version number information:

FALVER==2				; Major version number
FALMIN==1				; Minor version number
FALEDT==50				; Edit number
FALWHO==0				; Who last patched

%FAL==<BYTE(3)FALWHO(9)FALVER(6)FALMIN(18)FALEDT>

Comment ~

FAL -- File Access Listener

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1987.
ALL RIGHTS RESERVED.
~  ; End Comment
	SUBTTL	Table of Contents

;		     Table of Contents for FAL
;
;				  Section		      Page
;
;
;    1. Definitions
;        1.1    Assembly Parameters, Channel, Other Random Sym   5
;        1.2    Status Flags, Stream Blocking Bits . . . . . .   6
;        1.3    Macros . . . . . . . . . . . . . . . . . . . .   7
;        1.4    Error Handler Interface  . . . . . . . . . . .   8
;        1.5    GLXLIB Symbols . . . . . . . . . . . . . . . .  10
;        1.6    Stream Parameter Area  . . . . . . . . . . . .  11
;    2. End of FALUNV  . . . . . . . . . . . . . . . . . . . .  12
;    3. Commentary . . . . . . . . . . . . . . . . . . . . . .  14
;    4. Definitions
;        4.1    Local Accumulator Usage  . . . . . . . . . . .  15
;        4.2    Macros . . . . . . . . . . . . . . . . . . . .  16
;    5. Storage
;        5.1    Static Impure  . . . . . . . . . . . . . . . .  17
;        5.2    Static Pure - IB and HELLO Message Blocks  . .  18
;        5.3    Static Pure
;            5.3.1    WTO Response Strings . . . . . . . . . .  19
;    6. Program Startup  . . . . . . . . . . . . . . . . . . .  20
;    7. Scheduler
;        7.1    Idle Loop  . . . . . . . . . . . . . . . . . .  21
;        7.2    CHKHNG - Check for Hung Streams  . . . . . . .  22
;        7.3    CHKTIM - Routine to Check Wakeup Time  . . . .  23
;        7.4    DSCHD - Deschedule the Current Stream  . . . .  24
;        7.5    CHKQUE - Receive and Schedule an IPCF Message   26
;        7.6    CHKOBJ - Validate the QUASAR/Orion/OPR Message  28
;        7.7    GETBLK - Break an IPCF Message into its Data B  29
;    8. QUASAR Service Routines
;        8.1    ACK - Process an ACK . . . . . . . . . . . . .  30
;        8.2    CONTIN, PAUSE - Continue or Pause a Stream . .  31
;        8.3    DEFINE - Set Object Data . . . . . . . . . . .  32
;        8.4    DSTATUS - Send Status Info . . . . . . . . . .  33
;        8.5    CHKPNT - Checkpoint A Stream . . . . . . . . .  34
;        8.6    KILL - Abort a Connection  . . . . . . . . . .  36
;        8.7    SETUP - Handle Stream Setup  . . . . . . . . .  37
;        8.8    SHUTDN - Shutdown Processing on a Stream . . .  39
;        8.9    FALEND - Process FAL Stream Termination  . . .  40
;    9. FALSWI Service
;        9.1    SETCHN - Inform the World about a New Channel   41
;   10. IPCF Subroutines
;       10.1    FNDOBJ - Find an Object Block in our Data Base  42
;       10.2    RSETUP - Respond to a Setup Message  . . . . .  43
;       10.3    SNDQSR - Send a Message to Quasar  . . . . . .  44
;       10.4    QSRGON - Flag that QUASAR has Gone Away  . . .  45
;       10.5    QSRBAK - Flag QUASAR is Back . . . . . . . . .  46
	SUBTTL	Table of Contents (page 2)

;		     Table of Contents for FAL
;
;				  Section		      Page
;
;
;   11. PSI Routines
;       11.1    INTINI - Initialize the PSI System . . . . . .  47
;       11.2    INDCON - Connect a Disk Channel to the Interru  48
;       11.3    INDDIS - Disconnect a Disk Channel from the In  49
;       11.4    INTCON - Connect a Stream to the Interrupt Sys  50
;       11.5    INTDIS - Disconnect a Stream from the Interrup  51
;       11.6    INTCNA, INTDNA - Connect an ANF-10 Channel to   52
;       11.7    INTCND - Connect a DECnet Channel to the Inter  53
;       11.8    ANFINT - ANF-10 Interrupt Service  . . . . . .  54
;       11.9    DECINT - DECnet Interrupt Service  . . . . . .  55
;       11.10   DSKINT - Disk Interrupt Service  . . . . . . .  57
;       11.11   IPCINT - IPCF Message Available Interrupt Serv  58
;   12. SWIL Memory Manager
;       12.1    .MMGWD - Get some Words of Memory  . . . . . .  59
;       12.2    .MMFWD - Deallocate a Chunk of Memory  . . . .  60
;   13. Operator Messages
;       13.1    BEGJOB - Begin a FAL Job . . . . . . . . . . .  61
;       13.2    ENDJOB - End a FAL Job . . . . . . . . . . . .  62
;       13.3    ERRMSG - STOPCD/ERROR/WARN/INFRM Processor . .  63
;       13.4    FRCCHK - Force a Checkpoint  . . . . . . . . .  65
;       13.5    NETERR - Report a Network Lossage Error  . . .  66
;       13.6    .STOPCD - Abort a Stream . . . . . . . . . . .  67
;   14. Dummy SWIL Routines
;       14.1    .ASKYN, .ASKNY . . . . . . . . . . . . . . . .  68
;   15. End of FALQSR  . . . . . . . . . . . . . . . . . . . .  69
;   16. Definitions
;       16.1    Accumulator Usage  . . . . . . . . . . . . . .  71
;   17. FAL initialization
;       17.1    FALINI set FAL job parameters  . . . . . . . .  73
;       17.2    UTXINI initialize USERS.TXT buffer . . . . . .  75
;   18. Main FAL processing loop . . . . . . . . . . . . . . .  79
;   19. FAL "JOB" process  . . . . . . . . . . . . . . . . . .  81
;   20. File read access . . . . . . . . . . . . . . . . . . .  91
;       20.1    Subroutines - RENAME option  . . . . . . . . . 100
;   21. File write access  . . . . . . . . . . . . . . . . . . 101
;   22. File rename access . . . . . . . . . . . . . . . . . . 113
;   23. File delete access . . . . . . . . . . . . . . . . . . 115
;   24. File directory-list access . . . . . . . . . . . . . . 116
;   25. File (BATCH) submission access . . . . . . . . . . . . 117
;   26. General-purpose file-level subroutines . . . . . . . . 118
;   27. General-purpose non-specific subroutines . . . . . . . 137
;   28. FALGLX Interface Routines  . . . . . . . . . . . . . . 147
;   29. CDB initialization vectors . . . . . . . . . . . . . . 151
;   30. SWIL Argument Blocks . . . . . . . . . . . . . . . . . 152
;   31. Impure data  . . . . . . . . . . . . . . . . . . . . . 153
	Subttl	Revision History

;INITIAL VERSION CREATED FROM NIK 25-MAR-80

;6	RDH	18-Mar-84
;	Fix typo that broke RSX/RSTS/VAX non-wildcarded directory; Do not
;	generate a FOP field (at FFAD28), just "echo" back whatever the
;	remote has sent (keeps RSTS happy, probably the right thing to do
;	anyway).

;11	RDH	16-Jul-84
;	Send ACK between each file for DIRECTORY LIST if talking to
;	a DAP protocol version 7 (or later) accessor.

;12	RDH	29-Nov-84
;	A zero-length USERS.TXT file causes UTXINI to do a "random"
;	core allocation, typically resulting in ?PC out of bounds
;	(by deallocating part of the hi seg).

;13	DRB	13-Dec-84
;	Add multistream operation to allow a single copy of FAL to provide
;	multiple FAL server connections.  This edit makes the following
;	major changes:
;		1)  Add multithreaded support.  Make all network I/O non-
;		    blocking and add a scheduler.
;		2)  Add a QUASAR/ORION interface to allow control of FAL
;		    via OPR.
;		3)  Remove from the NFT/NIP/TSC utility and make FAL a
;		    standalone module.
;		4)  Remove the command interface, which is replaced by (2)
;		    above.
;		5)  Add a GLXLIB interface so that we don't have to reinvent
;		    the wheel when we're talking with QUASAR.
;	The last point above implies that FAL will now be dealing with both
;	GLXLIB and SWIL.  In order to keep conflicts to a minimum, this edit
;	will also split FAL into two code modules: one which contains the
;	scheduler and GLXLIB interface, the other contains the mainline FAL
;	code and SWIL interface.

;14	DRB	29-Jan-85
;	Release any I/O channels if a connection is aborted.

;15	DRB	31-Jan-85
;	Clean up the file write error code if we get an input error from the
;	network.  This is probably due to the other end going away, and is
;	nothing to get riled up about.

;16	DRB	05-Feb-85
;	Make sure the "file open" status bit always gets cleared before we
;	call ENDJOB so that we don't send bogus status updates to QUASAR.

;17	DRB	07-Feb-85
;	Clear all related blocking and wake bits when disabling interrupts for
;	network or disk.

;20	DRB	14-Feb-85
;	FILIFF (called by the ERROR macro handler) is observing the register
;	preservation conventions.  Make it do so.

;21	DRB	14-Feb-85
;	Remove lots of error and/or warning messages that get sent to OPR due
;	to user command error (from NFT).  Change lots of spurious STOPCDs to
;	non-fatal errors or warnings.  Change other error/warning messages to
;	DEBUG messages which only get typed if FTDEBUG is on.

;22	DRB	25-Mar-85
;	Re-implement the rejection list and add code to receive both the
;	rejection list and network ppn via the new .QOODB QUASAR message.

;23	DRB	16-Apr-85
;	Don't crash when/if QUASAR goes away or restarts.  If C%SEND returns an
;	error, just mark all current streams as potentially killable when
;	QUASAR restarts, and corrupt all their object blocks so that any new
;	streams started by a new QUASAR won't look like any of the old ones.
;	Keep trying to retransmit HELLO messages to QUASAR until it looks up
;	again.  If we successfully receive or transmit a message to QUASAR,
;	mark all the old streams for shutdown, since the new QUASAR is probably
;	going to tell us to start some new streams.  Note that this leaves two
;	holes:  First, if QUASAR is stopped and restarted with the same PID,
;	and we don't try to send anything while he's out, we'll never know that
;	he was gone.  The new guy won't know who we are, and this whole edit is
;	for naught.  Perhaps we should watch for NAKs, and assume that QUASAR
;	is gone and back.  Second,  if we were running more than 1/2 NFAL
;	streams at the time of failure, and the new QUASAR attempts to start
;	more than 1/2 NFAL new streams, we're probably going to fail in some
;	random fashion.  We really ought to keep a queue of streams to be
;	started if no slots are available.

;24	DRB	17-Apr-85
;	Prevent ILM crashes if we receive a shutdown for a stream we don't
;	have.

;25	DRB	18-Apr-85
;	Pay attention to received NAKs from QUASAR.

;26	DRB	11-Jul-85	QAR 868149
;	Don't allow setups from remote operators.  This can be detected by
;	comparing the node number in the setup object block with that stored
;	by SWIL in .MYNNM.

;27	DRB	23-Jul-85
;	Don't allow the job to go virtual until some monitor bugs get fixed.

;30	LEO	15-AUG-85
;	DO COPYRIGHTS.

;31	DRB	16-Oct-85
;	Always get the user's profile when starting a new DAP access.  Use
;	this profile to find the user's name.  Convert the eight bit username
;	to SIXBIT, and supply it for spooled file prints. Additionally, pay
;	attention to the bit in the user's profile which enables network file
;	access, and refuse any connection (with invalid user/password error)
;	which attempts to reference a userid that doesn't have this set
;	in the profile.

;32	DRB	30-Oct-85
;	Edit 31 correctly gets the user's name from the user profile and stores
;	it in .IOQ6N.  Unfortunately, SWIQUE stomps on .IOQ6N later when it
;	tries to validate the username/password.  Save .IOQ6N around the call
;	to QUEOP1 until SWIQUE gets fixed such as to not put garbage into
;	these two words.  Also, output more descriptive error messages to
;	the operator than "invalid PPN/Password" if the connection is rejected
;	due to the operator's rejection list or if the user doesn't have
;	network file access privileges.

;33	DRB	19-Nov-85
;	Update for new ACTSYM symbols.

;34	DRB	20-Nov-85
;	New ACTDAE uses 8 bit ASCII passwords in SIXBIT, so do the same here.

;35	DRB	22-Nov-85
;	Fix the I/O abort code such that channels really do get released when
;	the network link is aborted.  This requires edit 1025 to SWIL.

;36	DRB	02-Dec-85
;	If a stream gets going reading or writing a file at full speed, it may
;	never deschedule, especially on heavily loaded systems.  This somewhat
;	defeats the multithreaded idea.  Add fairness counts to the file read
;	and write loops.  Also, fix a typo in the write record loop.

;37	DRB	26-Dec-85
;	Another iteration on aborting I/O, due to edit 1026 of SWIL.  With any
;	luck, this is the last time around on this one.

;40	RDH	4-Jan-86	SPR 10-35424
;	Can't transfer LSN-formatted ASCII.

;41	DRB	16-Jan-86
;	Non-blocking disk I/O misses interrupts, because we're too smart about
;	when we enable the PSI system.  Quit being so "smart".

;42	DRB	22-Jan-86
;	Pre-zero the password block so we don't get confused over old fragments
;	laying around from prior connections.

;43	BSC	25-Mar-86
;	Modify the BADDAP Macro to return a STATUS message to remote task when
;	a DAP error occurs.

;44	BSC	8-Apr-86
;	Let SHR flags in an ACCESS message include the flag for
;	"No access by other users". DECnet/E DAP version 5.6 sets this.

;45	TL	4-Dec-86
;	Use edit 1047 of SWILIO to correctly transfer implied-CRLF files
;	with imbedded non-trailing carriage control (such as MACRO-32's
;	listing files).  See edit 1047 in SWIL for more details.

;46	RCB	5-Dec-86
;	Change to use the new STOPCD macro rather than the old $STOP.
;	This only words because FALGLX searches GLXMAC before FALUNV, and
;	the FAL module doesn't search GLXMAC at all.  Keep it this way.

;47	KDO	13-Aug-87
;	Allow a Configuration message at the start of a new access.

;50	KDO	18-Aug-87
;	Fix the SCAN (SWIL) intercept routine.
	Subttl	Definitions -- Assembly Parameters, Channel, Other Random Symbols

; Feature tests

ND	FTUTXT,0		; Default exclude support for USERS.TXT
ND	FTDEBUG,-1		; Default to debugging features

; Other assembly parameters:

ND	$NTPPN,<377777,,377777>	; Default access PPn
ND	NFAL,^D30		; Maximum number of concurrent streams
ND	NANF10,^D15		; Maximum number of ANF-10 streams
ND	PDSIZE,200		; Size of push down list
ND	CHKPTIM,^D30		; Default time between checkpoints
ND	CHKMIN,^D10		; Minimum number of seconds between checkpoints
ND	HNGTIM,^D60*3		; Time (seconds) before I/O is considered hung
ND	QSRTRY,^D60*3		;[23] Hello retry interval when QUASAR down
ND	DIRCNT,^D10		; Number of files to list before blocking (directory)
ND	PSWDLN,^D39		; Maximum number of characters in a password
PSWDWD==<PSWDLN+3>/4		;[34] Number of words in password string
ND	ARSPLN,.AEACC+1		;[33] Length of the ACTDAE response buffer
ND	CHARFC,10000		;[36] Maximum chars copied before deschedule
ND	RECFC,100		;[36] Maximum records copied before deschedule

; I/O channels internally dedicated

	UTX==10			; For reading USERS.TXT

; Constant parameters:

XP	MSBSIZ,<FAL.ST+<^D60/5>>; The size of a message block
XP	.PSLEN,.PSVIS+1		; Length of a PSI block

; Some stream abort reasons:

$FSNNS==1		; No network software
$FSISP==2		; Insufficient privileges
$FSNRM==3		;[26] Can't start remote FAL streams

; Some message type symbols:

.ETINF==0	; Informational message
.ETBEG==1	; Beginning of session message
.ETEND==2	; End of session message
.ETREJ==3	; Connection rejected
.ETWRN==4	; Warning message
.ETERR==5	; Error message
.ETSTP==6	; Stream STOPCD
.ETPRO==7	;[21] Protocol error message
.ETMAX==.ETPRO	;[21] Maximum message type value

IFN FTDEBUG,<
.ETDBG==10	;[21] Debug error message
.ETMAX==.ETDBG	;[21] Redefine the maximum message type >
	Subttl	Definitions -- Status Flags, Stream Blocking Bits

; Some status flags we'll find in S:

S.RUN==1B0		; The FAL stream has been started
S.OPEN==1B1		; A connection is active for this stream
S.PSIN==1B2		; Network interrupts have been enabled
S.PSID==1B3		; Disk interrupts have been enabled
S.SHUT==1B4		; Shut this stream down
S.KILL==1B5		; Abort the current connection
S.NPPN==1B6		; Connection is using NETPPN
S.CONN==1B7		; Connection accepted, waiting for link to start
S.QSRD==1B8		;[23] QUASAR has gone away
S.PROF==1B9		;[31] We have the user's profile
S.CLR==S.OPEN!S.PSIN!S.PSID!S.KILL!S.NPPN!S.CONN!S.PROF ; Flags to clear between connections

; Stream blocking status bits:

PSF%NI==1B0		; Stream is blocked waiting for network input
PSF%NO==1B1		; Stream is blocked waiting for network output
PSF%SL==1B2		; Sleeping
PSF%ST==1B3		; Stopped by the operator
PSF%CW==1B4		; Waiting for network connection
PSF%DI==1B5		; Stream is blocked waiting for local input
PSF%DO==1B6		; Stream is blocked waiting for local output
PSF%DF==1B7		; Stream is blocked because disk is offline
PSF%CR==1B8		; Stream has crashed
PSF%IO==PSF%NI!PSF%NO!PSF%DI!PSF%DO	; Stream is blocked for some kind of I/O
	Subttl	Definitions -- Macros

; Define a macro to allocate storage on the per stream process pages.
; This macro was copied from LPTSPL.MAC

DEFINE LP(SYM,VAL),<
IF1,<
   XLIST
   IFNDEF J...X,<J...X=0>
   IFDEF SYM,<PRINTX	? Parameter SYM used twice>
   SYM==J...X
   J...X==J...X+VAL
   LIST
   SALL
>  ;; End IF1

IF2,<
   .XCREF
   J...X==SYM
   .CREF
   SYM==J...X
>  ;; End IF2
>  ; End DEFINE LP

; A macro to pull a symbol from a universal file that we've searched

DEFINE	GS (SYM),<
	.XCREF
...FOO==SYM
	.CREF >
	Subttl	Definitions -- Error Handler Interface

;      The following definitions are to provide the SWIL context routines
; a mechanism for accessing the Orion WTO facility.

; A macro to kill of a stream, with optional $WTO text:

DEFINE	STOPCD (TXT,RTN,ADR,DIE<.STOPCD##>),<
IFB <TXT>,JRST	DIE			;; If no text, just kill off the stream
IFNB <TXT>,<
	PUSHJ	P,@[Z      ERRMSG##	;; Got some text - type it
		    XWD    .ETSTP,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z	   ADR		;; Optional data for typeout routine
		    Z	   DIE]		;; A place to go die > >

; A macro to complain about protocol errors

DEFINE	BADDAP (MAC<0>,MIC,TXT,DIE<.POPJ##>),<
	PUSHJ	P,@[EXP    DAPERR##	;; Address of DAP status sender
		    IFB    <MIC>,<EXP MAC>             ;; DAP status for MA.SYN
		    IFNB   <MIC>,<EXP MAC!<$DH'MIC_6>> ;; DAP status otherwise
		    EXP    [ASCIZ ~TXT~];; Text to type out
		    EXP    DIE]		;; A place to go when we're done >

; A macro to type an error message:

DEFINE	ERROR (PFX,TXT,RTN<0>,ADR<0>,DIE<.POPJ##>),<
E..'PFX:!PUSHJ	P,@[Z      ERRMSG##	;; Address of text typer
		    XWD    .ETERR,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z	   ADR		;; Optional data for typeout routine
		    Z	   DIE]		;; A place to go when we're done >

; A macro to say we're rejecting a connection:

DEFINE REJECT (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
R..'PFX:!PUSHJ	P,@[Z      ERRMSG##	;; Address of text typer
		    XWD    .ETREJ,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z	   ADR		;; Optional data for typeout routine
		    Z	   DIE]		;; A place to go when we're done >
; A macro to type warning messages:

DEFINE	WARN (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
W..'PFX:!PUSHJ	P,@[Z      ERRMSG##	;; Address of text typer
		    XWD    .ETWRN,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z      ADR		;; Optional data for typeout routine
		    Z      DIE]		;; A place to go on return >

; One more time, for information messages:

DEFINE	INFRM (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
I..'PFX:!PUSHJ	P,@[Z      ERRMSG##	;; Address of text typer
		    XWD    .ETINF,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z	   ADR		;; Optional data for typeout routine
		    Z      DIE]		;; A place to return to >

; Last one is for DEBUG only errors:

IFE FTDEBUG,<DEFINE DEBUG (TXT,RTN,ADR,DIE<.+1>),<JRST DIE> >

IFN FTDEBUG,<
DEFINE	DEBUG (TXT,RTN<0>,ADR<0>,DIE<.+1>),<
	PUSHJ	P,@[Z      ERRMSG##	;; Address of text typer
		    XWD    .ETDBG,[ASCIZ ~TXT~]
		    Z      RTN		;; Optional typeout routine
		    Z      ADR		;; Optional data for typeout routine
		    Z      DIE]		;; A place to return to > >


; Definitions of MACCODE field values to use when invoking BADDAP macro.

	MA.PND==0B23	; Operation in progress
	MA.SUC==1B23	; Successful result
	MA.UNS==2B23	; Unsupported DAP request
	MA.RES==3B23	; Reserved
	MA.FOP==4B23	; Error occurred before file opened
	MA.TER==5B23	; Transfer error i.e. I/O error on a file
	MA.TWN==6B23	; Transfer warning i.e. operation completed abnormally
	MA.ACT==7B23	; Access termination error on a file
	MA.FMT==10B23	; Format error parsing message
	MA.INV==11B23	; Invalid field in message
	MA.SYN==12B23	; Synchronization error i.e. DAP message out of order
	Subttl	Definitions -- GLXLIB Symbols

;      Pull some symbols out of GLXLIB so that the SWIL half of FAL doesn't
; have to search any QUASAR/GLXLIB related universals to mess with these
; symbols.

; Symbols in a file descriptor block:

GS	.FDLEN		; Length and type word
GS	FD.LEN		; Mask to length field
GS	FD.TYP		; Mask to type field
GS	.FDLEN		; Length of the FD
GS	.FDFIL		; Pointer to first word in file descriptor
GS	.FDSTR		; Structure name
GS	.FDNAM		; File name
GS	.FDEXT		; Extension
GS	.FDPPN		; Project programmer number
GS	.FDPAT		; Remaining path (SFDs)
GS	FDXSIZ		; Maximum length of an FD

; Some symbols from SWIL for FALGLX

GS	IO.DCN		; DECnet network type
GS	IO.ANF		; ANF-10 network type
GS	JWW.FL		; Watch bits for "first" in error processing

; Some symbols for reading the rejection list:

RJ.NOD==REJ.ND-ARG.DA	;[22] Rejected node name
;RJ.NDM==REJ.NM-ARG.DA	;[22] Rejected node name mask
RJ.PPN==REJ.PP-ARG.DA	;[22] Rejected PPN
RJ.PPM==REJ.MK-ARG.DA	;[22] Rejected PPN mask
RJ.MAX==REJ.SZ-ARG.DA	;[22] Length of the rejection sub block
	Subttl	Definitions -- Stream Parameter Area

; Define the storage on the per stream pages:

	LP	J$$BEG,0	; Beginning of the parameter area

; Storage required by the scheduler:

	LP	J$RPDL,PDSIZE	; The context pushdown list
	LP	J$RACS,20	; The saved context ACs
	LP	J$RTIM,1	; Time that the current request started

; Parameter storage for the FAL process:

	LP	J$FTYP,1	; FAL stream type (ANF-10 or DECnet)
	LP	J$FSLP,1	; Sleep time after FAL disconnect
	LP	J$DOFF,1	; Old PC when disk offline

; Record management:

	LP	J$RALC,2	; Allocation pointer to record buffer
	LP	J$RLEN,1	; Record length (Input Service Routine call)
	LP	J$RBUF,1	; Record buffer (Input Service Routine call)

; Stream status storage:

	LP	J$STFD,FDXSIZ	; File descriptor of current file being accessed
	LP	J$SNOD,1	; Node that this stream is connected to
	LP	J$SACC,1	; File access type
	LP	J$SBYT,1	; Number of bytes transfered
	LP	J$SUSR,^D8	; Username of accessor
	LP	J$SPSW,PSWDWD	; Password string (8 bit ASCIZ)
	LP	J$SACT,^D8	; Account string of access

; Storage for SWIL interface:

	LP	J$SMSG,^D100	; Area to build error message strings
	LP	J$SWLD,1	; Pointer to WILD's storage
	LP	J$SERP,1	;[50] Saved PDL pointer
	LP	J$SERT,1	;[50] Error routine

; Storage for talking to the accounting daemon

	LP	J$ABLK,20	; ACTDAE QUEUE. UUO argument block
	LP	J$AUSR,^D10	; A copy of the 8 bit username
	LP	J$ARSP,ARSPLN	; A buffer for ACTDAE's response

; Other misc variables:

	LP	J$DCNT,1	; Number of directory files before blocking
	LP	J$LCHK,1	; Time of last checkpoint/status update
	LP	J$SFC,1		;[36] Fairness count for reading/writing files

	LP	J$$END,0	; Size of the per stream area
	Subttl	End of FALUNV

	PRGEND
	Title	FALGLX -- GLXLIB Interface and Scheduler for FAL

	Search	JOBDAT			; Get the job data symbols
	Search	GLXMAC			; Get the GLXLIB parameters
	PROLOG	(FAL)			; Do the standard GLXLIB setup
	Search	QSRMAC			; Get QUASAR symbols
	Search	ORNMAC			;  and the OPR/ORION parmeters
	Search	FALUNV			; Get our symbols
	Search	SWIL			; And finally, SWIL

	SALL				; Make the listing look nice
	.Directive	FLBLST		;  etc...

; Stuff the version number in .JBVER:

	LOC	.JBVER
	EXP	%FAL

	RELOC	0			; Normal relocation

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO

Comment ~

FAL -- File Access Listener

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986.
ALL RIGHTS RESERVED.

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 OR 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.

~
	Subttl	Commentary

Comment ~

   Herein lies FAL's interface to GLXLIB and the stream scheduler. These
functions have been taken out of the main FAL module so that the GLXLIB
interface does not interfere with the SWIL interface in the main line
code. Thus, this module will interface the SWIL environment routines to
GLXLIB, performing any calling and AC convention translation. Since
GLXLIB and SWIL use different AC definitions, AC usage will probably be
the largest potential source of problems.  The following is a map of AC
usage of both the subroutine libraries:

AC	GLXLIB		SWIL
 0	  TF		 M0
 1	  S1		 T1
 2	  S2		 T2
 3	  T1		 T3
 4	  T2		 T4
 5	  T3		 P1
 6	  T4		 P2
 7	  P1		 P3
10	  P2		 P4
11	  P3		 IO
12	 P4/M		 ID
13	  		 CI
14			 CO
15	  J		 J
16	  S		 S
17	  P		 P

   The most notable fallout of this is that GLXLIB's T3 and T4 map
to SWIL's P1 and P2.  Thus, we must save SWIL's P1/2 so that they are
not destroyed by calls to FALGLX which may assume that these are
temporary registers.

NOTE WELL:

   Calls to .SAVE1, .SAVE2, .SAVE3, .SAVE4 or $SAVE (P1), $SAVE(P1,P2),
$SAVE (P1,P2,P3) and $SAVE (P1,P2,P3,P4) will result in SWIL's .SAVEn routine
being called and NOT GLXLIB's.  These routines will save FALGLX's T3, T4, P1
and P2.  In general, don't try these routines from FALGLX.

~  ; End Comment
	Subttl	Definitions -- Local Accumulator Usage

; Despite the fact the the GLXLIB universals should have already defined
; these for us, we're going to go redefine them ourselves, just to avoid
; any confusion:

    TF==0	; Returned True/False status
    S1==1	; Argument register
    S2==2	;  other argument register
    T1==3	; Temporaries
    T2==4
    T3==5
    T4==6
    P1==7	; Preserved registers
    P2==10
    P3==11
    P4==12
     M==12	; Current message pointer (overlaps P4)
     J==15	; Job context pointer
     S==16	; Current stream status
     P==17	; Stack pointer
	Subttl	Definitions -- Macros

; Define a macro to build an interrupt service routine header for ANF-10
; interrupts.

DEFINE ANFINH(Z),<
	XLIST
	$BGINT	1,		;; Normal interrupt service routine entry
	MOVEI	S1,Z		;; Get the stream number
	MOVEI	S2,ANFVEC+<.PSLEN*Z> ;; Point to the PSI block
	JRST	ANFINT		;; Continue in main line code
	ANHDSZ==4		;; Length of this header
	LIST >	; End define ANFINH

; Another one, but this time for disk interrupts:

DEFINE DSKINH(Z),<
	XLIST
	$BGINT	1,		;; Normal interrupt service routine entry
	MOVEI	S1,Z		;; Get the stream number
	MOVEI	S2,DSKVEC+<.PSLEN*Z> ;; Point to the PSI block
	JRST	DSKINT		;; Continue in main line code
	DSHDSZ==4		;; Length of this header
	LIST >
	Subttl	Storage -- Static Impure

; Some impure storage

PDL:	BLOCK	PDSIZE		; The stack

BZER==.			; Start of memory to zero on startup
QSRDIE:	BLOCK	1		;[23] Non-zero if QUASAR is dead
MESSAG:	BLOCK	1		; Address of the message just received
IMESS:	BLOCK	1		; IPCF message: -1 means something to be released
BLKADR:	BLOCK	1		; IPCF message block address save area
SAB:	BLOCK	SAB.SZ		; Send argument block
MSGBLK:	BLOCK	MSBSIZ		; A block to build message into
RUTINE:	BLOCK	1		; IPCF message dispatch
TEXTCT:	BLOCK	1		;[21] Number of chars remaining in TEXTBP
TEXTBP:	BLOCK	1		; A byte pointer for DEPBP

SCHEDL:	BLOCK	1		; Stream scheduling counter
SLEEPT:	BLOCK	1		; Sleep interval
FALBTS:	BLOCK	1		; Non-zero if status wants to be stored to saved register block

; The resident stream database:

STREAM:	BLOCK	1		; The current stream number
FALACT:	BLOCK	NFAL		; -1 if stream is active, 0 otherwise
FALPAG:	BLOCK	NFAL		; Address of the FAL stream data
FALOBA:	BLOCK	NFAL		; Table of object block addresses
FALOBJ:	BLOCK	OBJ.SZ*NFAL	; Table of object blocks
FALWKT:	BLOCK	NFAL		; Stream's wakeup time
FALSTW:	BLOCK	NFAL		; Stream status word
FALWAK:	BLOCK	NFAL		; Reasons why a stream should wake up.
				;  Parallel to FALSTW (prevents races)
IFN FTDEBUG,<
FALBLK:	BLOCK	NFAL		; UDT when stream blocked for I/O >
FALCHK:	BLOCK	NFAL		; Stream checkpoint indicator
				;  contains the time for the next checkpoint
FALCHN:	BLOCK	NFAL		; FAL stream's channel number
  FC%ANF==1B0			  ; Channel is ANF-10 (not DECnet)
FALDSK:	BLOCK	NFAL		; FAL stream's disk channel number

; Interrupt system storage:

PSIVEC:	BLOCK	0		; Start of the interrupt system storage
IPCVEC:	BLOCK	.PSLEN		; IPCF interrupt block
DECVEC:	BLOCK	.PSLEN		; DECnet interrupt block
ANFVEC:	BLOCK	.PSLEN*NANF10	; ANF-10 interrupt blocks
DSKVEC:	BLOCK	.PSLEN*NFAL	; Disk interrupt blocks
EZER==.-1		; End of memory to zero on startup
	Subttl	Storage -- Static Pure - IB and HELLO Message Blocks

; Setup the interrupt system block ala GLXLIB:

IB:	$BUILD	IB.SZ
	 $SET (IB.PRG,,%%.MOD)		; Setup the program name
	 $SET (IB.INT,,PSIVEC)		; Setup the interrupt vector address
	 $SET (IB.PIB,,PIB)		; Setup the PIB address
	 $SET (IB.FLG,IP.STP,1)		; Stopcodes to Orion
	 $SET (IB.FLG,IB.NPF,1)		;[27] Don't enable the page fault handler
	$EOB

; The PIB:

PIB:	$BUILD	PB.MNS
	 $SET (PB.HDR,PB.LEN,PB.MNS)	; PIB length,,0
	 $SET (PB.FLG,IP.PSI,1)		; PSI on
	 $SET (PB.INT,IP.CHN,0)		; Interrupt channel
	$EOB

; The hello message we send to QUASAR on startup:

HELLO:	$BUILD	HEL.SZ
	 $SET (.MSTYP,MS.TYP,.QOHEL)	; Message type (Hello again)
	 $SET (.MSTYP,MS.CNT,HEL.SZ)	; Message length
	 $SET (HEL.NM,,<'FAL   '>)	; Program name
	 $SET (HEL.FL,HEFVER,%%.QSR)	; QUASAR version number
	 $SET (HEL.NO,HENNOT,1)		; Number of object types (1)
	 $SET (HEL.NO,HENMAX,NFAL)	; Maximum number of streams
	 $SET (HEL.OB,,.OTFAL)		; FAL's object type
	$EOB

; A dummy object block for stray $WTOs

DUMOBJ:	$BUILD	OBJ.SZ
	 $SET (OBJ.TY,,.OTFAL)		;[23] Our object type
	 $SET (OBJ.UN,OU.LRG,0)		;[23] The unit number (zero)
	 $SET (OBJ.ND,,0)		;[23] The node name/number
	$EOB
	Subttl	Storage -- Static Pure -- WTO Response Strings

; Table of abort messages:

SETMSG:	[ASCIZ	~Shutdown by operator~]
	[ASCIZ	~No network software~]
	[ASCIZ	~Insufficient privileges~]
	[ASCIZ	~Cannot start remote FAL streams~]
	[ASCIZ	~Shutdown~]

; Table of file access strings indexed by function code (from J$SACC)

CHKFNC:	[ASCIZ	~(unknown function)~]	; 0 - Not known
	[ASCIZ	~Reading~]		; 1 - Read file
	[ASCIZ	~Writing~]		; 2 - Write file
	[ASCIZ	~Rename~]		; 3 - Rename file
	[ASCIZ	~Delete~]		; 4 - Delete file
	[ASCIZ	~(illegal function)~]	; 5 - ???
	[ASCIZ	~Directory of~]		; 6 - Directory of files
	[ASCIZ	~Submit~]		; 7 - Submit file
	[ASCIZ	~Execute~]		; 10 - Execute file
CHKFLN==.-CHKFNC		; Highest function code we know about
	Subttl	Program Startup

FAL::	JFCL				; Avoid CCL entry
	RESET				; As usual
	MOVE	P,[IOWD PDSIZE,PDL]	; Setup the stack pointer
	SETZM	BZER			; Clear a word of storage
	MOVE	S1,[BZER,,BZER+1]	; Make a pointer to get the rest
	BLT	S1,EZER			; Clear all our impure storage
	MOVEI	S1,IB.SZ		; Get the IB size
	MOVEI	S2,IB			; Point to the IB
	PUSHJ	P,I%INIT		; Initialize the world
	PUSHJ	P,FALINI##		; Initialize the SWIL side of the world
	PUSHJ	P,INTINI		; Initialize the interrupt system
	PUSHJ	P,I%ION			; Turn the interrupt system on
	MOVEI	T1,HELLO		; Point to the hello message
	PUSHJ	P,SNDQSR		; Tell QUASAR we're here
	MOVSI	P1,-NFAL		; Setup the stream counter
				; Fall into the scheduler loop
	Subttl	Scheduler -- Idle Loop

;   Here is the stream scheduler.  We loop over each stream, running it
; if possible, then check for any pending IPCF messages to process.

; This code borrowed from LPTSPL.MAC

MAIN:	SKIPN	FALACT(P1)		; Is this stream active?
	  JRST	MAIN.2			; No, skip it
	HRRZM	P1,STREAM		; Yes, store as the current stream number
	MOVE	J,FALPAG(P1)		; Get the context storage page
	PUSHJ	P,CHKTIM		; Adjust the sleep time if needed
	PUSHJ	P,DSTATUS		; Do any status stuff
	SKIPE	FALSTW(P1)		; Is this stream blocked?
	  JRST	MAIN.2			; Yes, go on to the next stream
	SETZM	FALWAK(P1)		; If we're awake, no reason to wake us
	MOVEM	P1,SCHEDL		; No, store the scheduling counter
	HRLZ	T1,J$SWLD(J)	; * Hack * Point at the saved WILD data
	HRRI	T1,.WILDZ##	; * Hack * Point to where it goes
	BLT	T1,.WILDZ##+.WILDL##-1	; Move WILD's data back
	MOVSI	0,J$RACS+1(J)		; Setup the source address for the BLT
	HRRI	0,1			; Get the destination address
	BLT	0,17			; Restore the stream ACs
	POPJ	P,			; And return to the stream context

; Here when the stream blocks again

MAIN.1:	MOVE	P1,SCHEDL		; Restore the scheduler counter
	PUSHJ	P,DSTATUS		; Do the status thing again
	PUSHJ	P,CHKTIM		; Reset the wakeup timer

; Here to schedule the next stream

MAIN.2:	AOBJN	P1,MAIN			; Loop back for the next stream number
	PUSHJ	P,CHKQUE		; Check for incoming IPCF messages
	SKIPN	QSRDIE			;[23] Is QUASAR dead?
	  JRST	MAIN.3			;[23] No, don't send any hellos then
	MOVEI	T1,HELLO		;[23] Yes, try to send
	PUSHJ	P,SNDQSR		;[23]  a HELLO message
	SKIPN	QSRDIE			;[23] We tried.  Did we succeed?
	  JRST	MAIN.4			;[23] Yes. Everything probably just woke up
	SKIPE	S1,SLEEPT		;[23] No.  Get the sleep interval
	  JRST	MAIN.3			;[23] None, don't sleep then
	SKIPG	S1			;[23] Is there really one?
	  MOVX	S1,QSRTRY		;[23] No, set our default interval
	MOVEM	S1,SLEEPT		;[23] Store the new sleep interval

MAIN.3:	SKIPE	MESSAGE			; Did we process a message?
	  JRST	MAIN.4			; Yes, don't sleep then
IFN FTDEBUG,<
	PUSHJ	P,CHKHNG		; See if anyone's hung
	  JRST	MAIN.4			; Yup.  Try to run him again >
	MOVE	S1,SLEEPT		; No, get the sleep time
	JUMPE	S1,MAIN.4		; Don't sleep if no sleep time specified
	SKIPG	S1			; Positive value, or default?
IFE FTDEBUG,SETZ S1,			; Default, set infinite sleep time
IFN FTDEBUG,MOVEI S1,HNGTIM*3		; (Unless debugging)
	PUSHJ	P,I%SLP			; Go wait

; Here if message have been processed.  Restart the scheduler

MAIN.4:	MOVE	P,[IOWD PDSIZE,PDL]	; Reset the stack pointer
	SETOM	SLEEPT			; Reset the sleep timer
	MOVSI	P1,-NFAL		; Reset the loop counter
	JRST	MAIN			; And restart the scan
	Subttl	Scheduler -- CHKHNG - Check for Hung Streams

;      Here if we just completed a scan of all streams and found nothing
; to run and no IPCF messages to play with.  This routine is called under
; the debug conditional to see if there are any streams that have been
; blocked for I/O for an undue length of time.  If we find such a stream,
; we'll send a warning to the operator, and clear the I/O wait bits, to
; see if the stream can continue (thus unblocking an unforseen race).

; Calling sequence:

;	PUSHJ	P,CHKHNG		; See if anything is hung
;	  returns non-skip if something was hung
;	returns skip if nothing hung

; Destroys S1, S2, T1-T4

IFN FTDEBUG,<
CHKHNG:	MOVSI	T4,-NFAL		; Setup an AOBJN pointer to the tables
	PUSHJ	P,I%NOW			; Go get the current date/time
	MOVE	T3,S1			; Get a safer copy of it
	MOVEI	T2,1			; Assume skip return

; Loop here for each task.  See if it's just blocked for I/O only.  If it
; is, see if it's been out for a long time.

CHKH.1:	SKIPN	FALACT(T4)		; Is this guy active?
	  JRST	CHKH.3			; No, skip it
	SKIPN	T1,FALSTW(T4)		; Yes, is it blocked?
	  JRST	CHKH.2			; No, but there's something to run now,
					;  so pretend we just unnblocked it
	TXNE	T1,^-PSF%IO		; Blocked for any non-I/O conditions?
	  JRST	CHKH.3			; Yes, leave this guy alone
	MOVE	S1,T3			; Get the current time
	SUB	S1,FALBLK(T4)		; Subtract the time we started waiting
	CAIGE	S1,HNGTIM*3		; Been too long?
	  JRST	CHKH.3			; No, skip over it

; Here if we got a task that's been waiting too long.  Just unblock any I/O
; wait and tell the operator about it.

	TXZ	T1,PSF%IO		; Clear any I/O block
	EXCH	T1,FALSTW(T4)		; Store the new hoked up status
	TXNE	T1,PSF%NI!PSF%NO	; Network wait?
	 SKIPA	T1,[[ASCIZ ~Network~]]	; Yes, say so
	  MOVEI	T1,[ASCIZ ~Disk~]	; No, say disk
	$WTOJ	(Error,<Restarting apparently hung ^T/@T1/ I/O>,@FALOBA(T4))

CHKH.2:	SETZ	T2,			; Say we want the non-skip return

CHKH.3:	AOBJN	T4,CHKH.1		; Loop if more streams to check
	ADDM	T2,(P)			; Adjust the return address
	POPJ	P,			; Return >
	Subttl	Scheduler -- CHKTIM - Routine to Check Wakeup Time

;    The purpose of this routine is to check and set the sleep time based
; on the current conditions.  The sleep time is checked based on the stream's
; wakeup time.  Whoever wants to wake up the earliest sets the sleep time.

; Calling sequence:

;	PUSHJ	P,CHKTIM		; Set the wakeup time
;	returns here, True if time to wake this stream

; Destroys S1, S2, T1

CHKTIM:	PUSHJ	P,I%NOW			; Get the current time into S1
	MOVE	T1,STREAM		; Get the stream number
	SKIPN	S2,FALWKT(T1)		; Get the wakeup time for this stream
	  $RETF				; No time set, nothing to do here
	SUB	S2,S1			; Calculate the number
	IDIVI	S2,3			;  of seconds to sleep
	JUMPLE	S2,CHKT.1		; Wake stream if it's wakeup time
	CAILE	S2,^D60			; Is it a full minute?
	  MOVEI	S2,^D60			; Yes, truncate to one minute
	SKIPL	SLEEPT			; Always set new time if none set
	 CAMGE	S2,SLEEPT		; Is this less than the previous?
	  MOVEM	S2,SLEEPT		; Yes, set new sleep time
	$RETF				; And say we're still asleep

; Here if it's time to run us

CHKT.1:	SETZM	SLEEPT			; Clear the sleep time
	MOVE	T1,STREAM		; Get the stream number back
	MOVX	S1,PSF%SL		; And clear the status
	ANDCAM	S1,FALSTW(T1)		;  flag for this stream
	SETZM	FALWKT(T1)		; Clear the wakeup time
	$RETT				; Return true and wake the stream
	Subttl	Scheduler -- DSCHD - Deschedule the Current Stream

;   This routine will descedule the current process, and return to the top
; level scheduling loop.

; Calling sequence:

;	J/	current per context storage pointer
;	MOVX	M0,<blocking status>
;	PUSHJ	P,DSCHD			; Block until condition satisfied
;	returns here when unblocked and rescheduled

; This routine makes the following assumptions:

; 1)	STREAM contains the current stream number and J points to the
;	per stream storage.

; 2)	We're currently in stream context.  If this is not the case, bad
;	things can happen.

; 3)	If called with an IPCF message currently in use, it is assumed
;	that the user has everything needed from the message, and the
;	message will be released.  This assumption is necessary to
;	prevent another message being received before the old message
;	is released.

; A stream context registers are preserved in the per stream memory
; Top level ACs S1, S2 and T1 are clobbered.

DSCHD::	MOVEM	0,J$RACS(J)		; Save the registers
	MOVEI	0,J$RACS+1(J)		;  with a BLT
	HRLI	0,1			;  ...
	BLT	0,J$RACS+17(J)		; Save them all

	MOVE	T1,STREAM		; Get the current stream number

; Store the blocking flags in the stream status

	HLLZ	S1,TF+J$RACS(J)		; Get the flags
	HRRZ	S2,TF+J$RACS(J)		; Get the sleep time
	IORM	S1,FALSTW(T1)		; Store the new blocking bits
IFN FTDEBUG,<
	PUSHJ	P,I%NOW			; Get the current time
	MOVEM	S1,FALBLK(T1)		; Store it for the hung checker >
	SETZ	S1,			; Get a zero
	EXCH	S1,FALWAK(T1)		; Clear the reasons why we should wake
	ANDCAM	S1,FALSTW(T1)		; Clear any sloppiness on our part
; Copy the WILD data back to the per stream area so it doesn't get
; wiped out.  This is a temporary solution to this problem until WILD
; learns about multithreaded operation.

	HRLZI	T2,.WILDZ##	; * Hack * Get the source of the data
	HRR	T2,J$SWLD(J)	; * Hack * Get the destination
	HRRZ	T3,T2		; * Hack * Copy the destination base
	BLT	T2,.WILDL##-1(T3)	; Copy the WILD data

	JUMPE	S2,DSCH.D		; If no sleep time given, go away
	PUSHJ	P,I%NOW			; Get the current time
	IMULI	S2,3			; Convert seconds to UDT ticks (sort of)
	ADD	S1,S2			; Build the wakeup time
	MOVEM	S1,FALWKT(T1)		; Save the wakeup time

; Make sure we're really in stream context.

DSCH.D:	HRRZ	S1,P			; Get the current stack address
	CAIL	S1,J$RPDL(J)		; Is it less than stream stack base?
	CAILE	S1,PDSIZE+J$RPDL(J)	; No, is it inside the stream stack?
	STOPCD (CDS,HALT,,Call to DSCHD while not in stream context)

	MOVE	P,[IOWD PDSIZE,PDL]	; Reset the scheduler stack pointer
	JRST	MAIN.1			; And re-enter the scheduler cycle
	Subttl	Scheduler -- CHKQUE - Receive and Schedule an IPCF Message

;     Here to receive and schedule an incoming IPCF message.

; Calling sequence:

;	PUSHJ	P,CHKQUE		; Process incoming IPCF messages
;	returns here always, no particular status

; Destroys S1, S2, T1-T4

CHKQUE:	SETZM	MESSAG			; Say no messages received yet
	PUSHJ	P,C%RECV		; Go try to get one
	JUMPF	.POPJ			; Nothing there, return
	SETOM	IMESS			; Say we got something
	SETZM	BLKADR			; Clear the IPCF message block address save area
	LOAD	S2,MDB.SI(S1)		; Get the special index word
	TXNN	S2,SI.FLG		; Is there an index there?
	  JRST	CHKQ.5			; No, ignore it
	ANDX	S2,SI.IDX		; AND out the index
	CAIE	S2,SP.OPR		; Is it from OPR?
	 CAIN	S2,SP.QSR		; No, is it from QUASAR?
	  SKIPA				; Yes, go on
	   JRST	CHKQ.5			; No, punt the message
	CAIN	S2,SP.QSR		;[23] So it's ok.  Was it from QUASAR?
	  PUSHJ	P,QSRBAK		;[23] Yes, go make sure we know it's there

; Here with something valid to do.

CHKQ.2:	LOAD	M,MDB.MS(S1),MD.ADR	; Get the message address
	MOVEM	M,MESSAG		; Save it away
	LOAD	S2,.MSTYP(M),MS.TYP	; Get the message type
	MOVSI	S1,-NMSGT		; Get an AOBJN pointer to the type table

CHKQ.3:	HRRZ	T1,MSGTAB(S1)		; Get a message type
	CAMN	S2,T1			; Is it our boy?
	  JRST	CHKQ.4			; Yes, go handle it
	AOBJN	S1,CHKQ.3		; No, try the next one
	JRST	CHKQ.5			; No match anywhere, punt it

CHKQ.4:	HLRZ	T2,MSGTAB(S1)		; Get the processing routine address
	MOVEM	T2,RUTINE		; Save the routine address
	PUSHJ	P,CHKOBJ		; Go find the object block
	JUMPF	CHKQ.5			; Not there, just delete it
	PUSHJ	P,@RUTINE		; Call the processor
	SKIPN	FALBTS			; Do we want to save the status bits?
	  MOVEM	S,J$RACS+S(J)		; Yes, save the status bits then
	SETZM	FALBTS			; Reset the default for saving flags

CHKQ.5:	SKIPE	IMESS			; Do we have a message allocated?
	  PUSHJ	P,C%REL			; Yes, release it
	SETZM	IMESS			; Say we don't have a message anymore
	POPJ	P,			; And return to the scheduler
; Table of message types and corresponding processor routine:

MSGTAB:	XWD	DSTATUS,.QORCK		; Checkpoint request
	XWD	SETUP,.QOSUP		; Setup/shutdown
	XWD	DEFINE,.QOODB		; Define (object data)
	XWD	CONTIN,.OMCON		; Operator continue request
	XWD	PAUSE,.OMPAU		; Operator pause/stop request
	XWD	KILL,.OMCAN		; Cancel transfer
	XWD	ACK,MT.TXT		;[25] Acknowledgement we hope

NMSGT==.-MSGTAB			; The number of message types we know about
	Subttl	Scheduler -- CHKOBJ - Validate the QUASAR/Orion/OPR Message Object Blocks

;    This routine is called on the receipt of an IPCF message to validate
; the message's object blocks.

; Calling sequence:

;	S1/	offset into MSGTAB
;	S2/	message type
;	PUSHJ	P,CHKOBJ		; Check the object blocks
;	  returns false if not valid
;	returns true with:
;	STREAM/	stream number
;	J/	database address
;	S/	status bits

; Destroys S1, S2, T1-T3

CHKOBJ:	CAIL	S2,MT.OFF		;[25] Is it a common message?
	  $RETT				;[25] Yes, no object to look for
	CAIL	S2,.OMOFF		; No, is this an OPR/Orion message?
	  JRST	CHKO.1			; Yes, go setup the object search
	XCT	MSGOBJ(S1)		; Get the object block address
	JRST	CHKO.2			; Continue below

; Here if an OPR/Orion message:

CHKO.1:	PUSHJ	P,GETBLK		; Get a message block
	JUMPF	.RETF			; No more, that's an error
	CAIE	T1,.OROBJ		; Is this the object block?
	  JRST	CHKO.1			; No, try the next one then
	MOVE	S1,T3			; Get the block data address

CHKO.2:	PUSHJ	P,FNDOBJ		; Go find the object block
	POPJ	P,			; Return and propogate T/F

; Here if .QOODB - find object type block

CHKO.3:	PUSHJ	P,GETBLK		;[22] Get the next block
	JUMPF	.RETF			;[22] No more.  That's an error
	CAIE	T1,.ORTYP		;[22] Is this an object type block?
	  JRST	CHKO.3			;[22] No, skip it
	MOVEI	T1,.OTFAL		;[22] Yes, get our object type
	CAME	T1,(T3)			;[22] Is it for us?
	  $RETF				;[22] No, punt it off
	$RETT				;[22] Yes, return happy

MSGOBJ:	MOVEI	S1,RCK.TY(M)		; Get the checkpoint message object address
	$RETT				;[22] Return happy if setup message
	JRST	CHKO.3			;[22] Look for object type block for .QOODB
	Subttl	Scheduler -- GETBLK - Break an IPCF Message into its Data Blocks

;     here to extract data blocks from an IPCF message.

; Calling sequence:

;	M/	message address
;	PUSHJ	P,GETBLK		; Get the next block from the message
;	  returns false if no more message blocks
;	returns true with message block:
;	T1/	block type
;	T2/	block length
;	T3/	block data pointer

; Destroys S1, T1-T3

GETBLK:	SOSGE	.OARGC(M)		; Subtract one from block count
	  $RETF				; No more.  Return in shame
	SKIPN	S1,BLKADR		; Get the previous block address
	  MOVEI	S1,.OHDRS+ARG.HD(M)	; None there, get the first block address
	LOAD	T1,ARG.HD(S1),AR.TYP	; Get the block type
	LOAD	T2,ARG.HD(S1),AR.LEN	; Get the block length
	MOVEI	T3,ARG.DA(S1)		; Point to the data block address
	ADD	S1,T2			; Point to the next block
	MOVEM	S1,BLKADR		; Save it for next time
	$RETT				; And return success
	Subttl	Program Restart -- RESTRT - Restart after a Fatal Error


;[50]	Here after a fatal error to restart the FAL job.

; Calling sequence:
;	S1/	address of ASCIZ text
;	PJRST	RESTRT
RESTRT::MOVE	P,[IOWD PDSIZE,PDL]	; Give GLXLIB a valid stack
	PJOB	S2,			; Get our job number
	$WTO	(<FAL job ^D/S2/ restarting>,<^T/(S1)/>,,$WTFLG(WT.SJI))
	JRST	FAL			; Restart this job
	Subttl	QUASAR Service Routines -- ACK - Process an ACK

;      Here when we receive a text message.  Normally, this should be an
; ACK, but it could be some sort of error.  Ignore acks, and attempt the
; appropriate action on a NAK.

; Calling sequence:

;	M/	message address
;	PUSHJ	P,ACK			; Process hopeful ACK
;	returns true always (unless we halt)

; Destroys S1, S2, T1-T4

ACK:	SETOM	FALBTS			;[25] Don't try to update S
	MOVX	S1,MF.FAT		;[25] Get the fatal error indicator
	TDNN	S1,.MSFLG(M)		;[25] Fatal error?
	  $RETT				;[25] No, just ignore the message
	LOAD	S1,.MSFLG(M),MF.SUF	;[25] Yes, get the suffix
	MOVSI	S2,-NAKLEN		;[25] Get the number of known errors

; Loop here throught a table of errors that needs to be processed specially

ACK.01:	HLRZ	T1,NAKTBL(S2)		;[25] Get an error prefix
	CAME	S1,T1			;[25] Is it a match?
	  AOBJN	S2,ACK.01		;[25] No, try the next one
	JUMPGE	S2,ACK.02		;[25] No match?  Go handle normally
	HRRZ	T1,NAKTBL(S2)		;[25] Got one, get the dispatch address
	PJRST	(T1)			;[25] Call the special processor

; Here if some unknown or normal error:

ACK.02:	PUSHJ	P,GETBLK		;[25] Go get the ASCII string if any
	  $RETT				;[25] None, just return
	CAIE	T1,.CMTXT		;[25] Text string?
	  JRST	ACK.02			;[25] No, try the next block
	PJOB	T1,			;[25] Get our job number
	$WTO	(<Error from QUASAR to FAL job ^D/T1/>,<^T/(T3)/>,DUMOBJ)
	$RETT				;[25] Just return after this

NAKTBL:	XWD	'IPE',NOPRIV		;[25] Not enough privs
	XWD	'SNY',NEWQSR		;[25] QUASAR gone away and come back?
	XWD	'WVN',BADVER		;[25] Bad version number
NAKLEN==.-NAKTBL			;[25] Length of this table

; Here if bad QSRMAC version number.  Just complain and exit.

BADVER:	PJOB	T1,			;[25] Get our job number
	$WTO	(<FAL job ^D/T1/ not starting>,<Built for wrong version of QUASAR>,DUMOBJ)
	JRST	STOPIT			;[25] All done, exit

; Here if QUASAR says we don't have enough privs to do this.  If this is the
; case, there's little chance that we're running from FRCLIN, so I suppose
; it's ok to OUTSTR a message:

NOPRIV:	OUTSTR	[ASCIZ ~?FALIPE	Insufficient privileges
~]					;[25] Type our complaint

STOPIT:	MONRT.				;[25] And exit
	JRST	STOPIT			;[25] (If we're continued)

; Here if we think QUASAR went away and came back again

NEWQSR:	PUSHJ	P,QSRGON		;[25] Say he's gone
	MOVEI	T1,HELLO		;[25] And try to send
	PJRST	SNDQSR			;[25]  a HELLO message
	Subttl	QUASAR Service Routines -- CONTIN, PAUSE - Continue or Pause a Stream

;      Here to continue a stream paused by OPR.

; Calling sequence:

;	STREAM/	current stream number
;	PUSHJ	P,CONTIN		; Continue processing on this stream
;	returns true always

; Destroys S1, S2

CONTIN:	MOVX	S2,PSF%ST		; Get the stopped but
	MOVE	S1,STREAM		; Get the current stream number
	ANDCAM	S2,FALSTW(S1)		; Clear the stop condition
	$ACK	(Continued,,@FALOBA(S1),.MSCOD(M)) ; Tell the operator
	SETZM	FALCHK(S1)		; Cause a status update
	$RETT				; Return happy

;      Same thing, but this time, stop the stream instead of continuing it.

; Calling sequence:

;	STREAM/	current stream number
;	PUSHJ	P,PAUSE			; Pause processing on this stream
;	returns true always

; Destroys S1, S2

PAUSE:	MOVE	S1,STREAM		; Get the current stream number
	MOVX	S2,PSF%ST		; Get the stopped bit
	IORM	S2,FALSTW(S1)		; Stop the stream
	$ACK	(Stopped,,@FALOBA(S1),.MSCOD(M)) ; Tell the operator
	SETZM	FALCHK(S1)		; Make a checkpoint happen
	$RETT				; And return happy
	Subttl	QUASAR Service Routines -- DEFINE - Set Object Data

;      This routine is called in response to an OPR DEFINE FILE-ACCESS
; command, and will process the object data sent.  The data to be set
; depends on the blocks we find in the message.  We assume that the .ORTYP
; block has already been checked to verify our object type, and that the
; next block is a valid data block.

; Calling sequence:

;	M/	message address
;	BLKADR/	previous block address
;	PUSHJ	P,DEFINE		; Go set the object data
;	returns true always

; Destroys S1, S2, T1-T4

DEFINE:	SETOM	FALBTS			; Make sure we don't update S
	PUSHJ	P,GETBLK		; Get the next block in the message
	  JUMPF	.RETT			; No more.  Just return
	MOVE	S2,[-DEFLEN,,DEFTYP]	; Get an AOBJN pointer

DEFI01:	HLRZ	S1,(S2)			; Get a block type
	CAME	T1,S1			; Is it our type?
	AOBJN	S2,DEFI01		; No, try the next type
	JUMPGE	S2,DEFINE		; Didn't find it?  Try next block
	HRRZ	S1,(S2)			; Got it.  Get the dispatch
	JRST	(S1)			; Call the appropriate processor

; Table of DEFINE block types:

DEFTYP:	XWD	.ORDPP,DEFPPN		; DEFINE FILE-ACCESS DEFAULT-PPN
	XWD	.ORREJ,DEFREJ		; DEFINE FILE-ACCESS REJECTION-LIST
DEFLEN==.-DEFTYP

; Here to set the default access PPN

DEFPPN:	MOVE	S1,(T3)			; Get the default access PPN
	MOVEM	S1,NETPPN##		; Store it
	JRST	DEFINE			; And go try for more blocks

; Here to set the rejection list:

DEFREJ:	SKIPN	S2,REJFIR##		; Is there any old rejection list?
	  JRST	DEFR01			; No, skip this
	MOVE	S1,REJLAS##		; Get the last one
	SUB	S1,S2			; Compute number of words to deallocate
	SETZM	REJFIR##		; Then, zero the pointers
	SETZM	REJLAS##		;  to the old list
	PUSHJ	P,.MMFWD		; Deallocate the old list
	  JRST	DEFINE			; Oh, punt!

DEFR01:	MOVEI	S1,-ARG.DA(T2)		; Get the number of words to allocate
	PUSHJ	P,.MMGWD		; Go allocate memory for the new list
	  JRST	DEFINE			; Oh well, try another block
	MOVE	T1,S2			; Copy the new block pointer
	HRL	T1,T3			; Point to the incoming data
	ADD	S1,S2			; Get BLT destination
	BLT	T1,-1(S1)		; Copy the list
IFN ARG.DA-1,SUBI S1,ARG.DA-1		; Compute REJLAS pointer
	MOVEM	S1,REJLAS##		; Store it
	MOVEM	S2,REJFIR##		; Store the new first pointer
	JRST	DEFINE			; And go try for another block
	Subttl	QUASAR Service Routines -- DSTATUS - Send Status Info

;      This routine provides a uniform means of handling checkpointing
; within a stream.  it decides whether to send status messages.

; CHKPNT is called based on FALCHK or elapsed time since the last CHKPNT.
; The time till the next checkpoint is set if called.  If FALCHK is 0,
; CHKPNT is always called.

; This is the only routine that should call CHKPNT.

; Calling sequence:

;	STREAM/	current stream number
;	J/	per stream storage pointer
;	PUSHJ	P,DSTATUS		; Send a statups update
;	returns here always, no particular status

; Destroys S1, S2, T1-T4

DSTATU:	$SAVE	<P1,P2,P3,P4,S>		; Save a couple of preserved registers
	MOVE	P1,STREAM		; Get the stream number
	MOVE	S,J$RACS+S(J)		; Get the stream's status

	SKIPN	FALACT(P1)		; Are we active?
	  $RET				; No.  Nothing to checkpoint then

	PUSHJ	P,I%NOW			; Get the current time
	MOVE	P2,S1			; Copy to a safer place
	SUB	S1,FALCHK(P1)		; Compute time to checkpoint
	SKIPGE	S1			; Is it time to checkpoint yet?
	  $RET				; No, just return now

	PUSHJ	P,CHKPNT		; Yes, do a checkpoint then
	ADDI	P2,CHKPTIM*3		; Get UDT (sort of) for next time
	MOVEM	P2,FALCHK(P1)		; Store the next checkpoint time

	$RET				; And return
	Subttl	QUASAR Service Routines -- CHKPNT - Checkpoint A Stream

;      We come here periodically to checkpoint the progress on a FAL stream.
; The checkpoint message we are about to send to QUASAR is not the normal
; QUASAR checkpoint, but rather one tailored for this application.  This
; routine should be called by DSTATUS only.

; Calling sequence:

;	J/	pointer to the stream's data pages
;	S/	current stream status bits
;	PUSHJ	P,CHKPNT		; Do a checkpoint
;	returns here always.  Aborts if error in send

; Destroys S1, S2, T1-T4

CHKPNT:	TXNE	S,S.QSRD		;[23] Is our QUASAR gone?
	  POPJ	P,			;[23] Yes.  Don't try to send anything
	MOVEI	T1,MSGBLK		; Point at the message storage

; Pre-zero the message block storage in case we're not copying a file:

	SETZM	MSGBLK			; Zero a word
	MOVE	S1,[MSGBLK,,MSGBLK+1]	; Make a BLT pointer
	BLT	S1,FAL.ST(T1)		; Clear up to the first string word

; Figure out what this stream's doing:

	MOVE	S2,FALSTW(P1)		; Get the blocked bits for this stream
	MOVX	S1,%IDLE		; Assume that we're idle
	TXNE	S2,PSF%ST		; Are we stopped?
	  MOVX	S1,%STOPD		; Yes, say so
	TXNE	S2,PSF%CR		; Did it crash?
	  MOVX	S1,%NAVAL		; Yes, say so
	CAIE	S1,%IDLE		; Get any status yet?
	  JRST	CHKP.0			; Yes, don't look any more
	MOVE	S2,FALPAG(P1)		; Get the per stream storage pointer
	MOVE	S2,J$RACS+S(S2)		; Get the stream's status word
	TXNE	S2,S.OPEN		; Do we have a file open?
	  MOVX	S1,%ACTIV		; Yes, say so
	TXNE	S2,S.CONN		; Did we just connect to someone?
	  MOVX	S1,%CNECT		; Yes, say so
	TXNE	S2,S.KILL		; Are we killing this connection?
	  MOVX	S1,%CNCLG		; Yes, tell him that

CHKP.0:	MOVEM	S1,STU.CD(T1)		; Store the status word
	HRLZ	S1,FALOBA(P1)		; Get the object block pointer
	HRRI	S1,STU.RB(T1)		; Point at the destination
	BLT	S1,STU.RB+OBJ.SZ-1(T1)	; Copy the object block into the message
; Store the network type and see if we're active.  If not, send a message
; minus the connect time, node names, bytes sent and status string

	MOVE	S1,J$FTYP(J)		; Get the network type
	CAXE	S1,IO.ANF		; ANF-10?
	 SKIPA	S1,[2]			; No, say it's DECnet
	  MOVEI	S1,1			; Yes, say it's ANF
	MOVEM	S1,FAL.PR+.OBNTY(T1)	; Store the network type
	MOVEI	S1,FAL.ST+1		; Assume this is a short message
	TXNN	S,S.OPEN		; Do we have a connection open?
	  JRST	CHKP.1			; No, send a short message

; Compute the connect time for this stream, and convert from UDT units
; to jiffies.

	PUSHJ	P,I%NOW			; Get the current date/time
	SUB	S1,J$RTIM(J)		; Compute the connect time
	MOVX	S2,%CNSTS		; Get the system status
	GETTAB	S2,			; So we can get cycles/second
	 SKIPA				; Error?  Assume 60Hz
	  TXNN	S2,ST%CYC		; Ok, is this 50 Hz?
	   SKIPA S2,[^D60]		; No, it's good ol' 60 Hz
	    MOVEI S2,^D50		; Yes, remember this
	IMUL	S1,S2			; Multiply by jiffies/sec
	IMULI	S1,^D60*^D60*^D24	; Convert from UDT fraction to seconds
	HLRZM	S1,FAL.PR+1(T1)	; * hack.OBCTM(T1)	; Store it
	MOVE	S1,J$SBYT(J)		; Get the number of bytes moved
	MOVEM	S1,FAL.PR+.OBBYT(T1)	; Store in the status message
	MOVE	S1,J$SNOD(J)		; Get the node name
	MOVEM	S1,FAL.PR+.OBNDN(T1)	; Store the node name

; Make a status string which says what's happening:

	MOVEI	S1,FAL.ST(T1)		; Point at the string storage
	HRLI	S1,(POINT 7,)		; Make it an ASCII byte pointer
	MOVEM	S1,TEXTBP		; Store for the following $TEXT call
	MOVEI	S1,<<MSBSIZ-FAL.ST>*5>-1 ;[21] Get the max string length
	MOVEM	S1,TEXTCT		;[21] Store as max byte count
	MOVE	T2,J$SACC(J)		; Get the file access type
	$TEXT (DEPBP,<^T/@CHKFNC(T2)/ ^F/J$STFD(J)/ for user ^T/J$SUSR(J)/^0>)
	HRRZ	S1,TEXTBP		; Get the ending byte pointer
	SUBI	S1,MSGBLK-1		; Compute the number of words filled

CHKP.1:	STORE	S1,.MSTYP(T1),MS.CNT	; Store the length of the message
	MOVX	S1,.QOFAS		; Get the function code
	STORE	S1,.MSTYP(T1),MS.TYP	; Store it
	PUSHJ	P,SNDQSR		; Go send this to QUASAR
	PUSHJ	P,I%NOW			; Get the current time and date
	MOVEM	S1,J$LCHK(J)		; Store as last checkpoint time
	$RETT				; And return happy
	PJRST	SNDQSR			; Send it and return

; Helper routine for storing $TEXT strings

DEPBP:	SOSL	TEXTCT			;[21] Skip if no more room
	IDPB	S1,TEXTBP		; Store the byte
	$RETT				; And return
	Subttl	QUASAR Service Routines -- KILL - Abort a Connection

;      Here to abort processing on a connection.  This routine is called
; by an operator command to tell a FAL stream to stop whatever it's doing.
; If it isn't doing anything, there's nothing to stop ...

; Calling sequence:

;	S/	current stream status word
;	PUSHJ	P,KILL			; Kill it off
;	returns true always

; Destroys no registers

KILL:	TXNN	S,S.OPEN		; Do we really have something going?
	  $RETT				; No, just punt it off
	TXO	S,S.KILL		; Yes, say we want to kill it
	MOVE	S1,STREAM		; Get the current stream number
	$WTOJ	(Abort,<Aborting due to operator command>,@FALOBA(S1))
	$RETT				; Return
	Subttl	QUASAR Service Routines -- SETUP - Handle Stream Setup

;     Here when we receive a setup stream message from QUASAR.  Decide
; whether it's a setup or shutdown, and dispatch to the appropriate
; processor.  If this is a setup, we will start and enter a stream context
; to perform the remainder of this call.  This will cause the stream context
; to be started.

; Calling sequence:

;	PUSHJ	P,SETUP			; Go handle SETUP/SHUTDOWN message
;	returns here, no particular status

; Destroys all registers

SETUP:	LOAD	S1,SUP.FL(M)		; Get the flags
	TXNE	S1,SUFSHT		; Is this really a shudown?
	  JRST	SHUTDN			; Yes, go to the other processor
	SETZ	T2,			; Initialize a loop counter

SETU.1:	SKIPN	FALPAG(T2)		; Do we have a free stream here?
	  JRST	SETU.2			; Yes, go use it
	CAIGE	T1,NFAL-1		; No, have we tried them all?
	  AOJA	T2,SETU.1		; No, go try another one then
	STOPCD	(TMS,HALT,,Too many setups)	; Yes, die

; Here if we have an idle stream:

SETU.2:	MOVEM	T2,STREAM		; Store as the current stream number
	MOVEI	S1,<J$$END+PAGSIZ-1>_-<WID(PAGSIZ-1)> ; Get the number of pages needed
	PUSHJ	P,M%AQNP		; Go allocate some pages
	  JUMPF	[STOPCD (NEM,HALT,,Not enough memory to start stream)]
	LSH	S1,WID(PAGSIZ-1)	; Convert page number to address
	MOVEM	S1,FALPAG(T2)		; Save the stream storage pointer
	MOVE	J,S1			; Copy the pointer to the traditional place
	MOVEI	S1,.WILDL##	; * Hack * Get the number of words required for WILD
	PUSHJ	P,.MMGWD	; * Hack * Go allocate it
	  STOPCD (CWD,HALT,,Cannot Allocate WILD data storage)
	MOVEM	S2,J$SWLD(J)	; * Hack * Store the memory pointer
	SETZM	FALSTW(T2)		; No reason why we can't run yet ...
	MOVEM	J,J$RACS+J(J)		; Save the storage address pointer
	MOVE	S2,T2			; Copy the stream number
	IMULI	T2,OBJ.SZ		; Get the offset of an object block
	ADDI	T2,FALOBJ		; Add in the table base
	MOVEM	T2,FALOBA(S2)		; Store the object block address
	MOVE	S1,T2			; Get a BLT destination pointer
	HRLI	S1,SUP.TY(M)		; Get the BLT source pointer
	BLT	S1,OBJ.SZ-1(T2)		; Copy the object block
	MOVE	S1,OBJ.ND(T2)		;[26] Get the processing node
	CAME	S1,.MYNNM##		;[26] Is it the local node?
	  JRST	[MOVX	S1,$FSNRM	  ;[26] No, say that's an error
		 PJRST	RSETUP]		  ;[26] Inform QUASAR and quit
	SETOM	FALCHN(S2)		; Say no channel number assigned yet
	MOVX	S1,%RSUOK		; Get the startup code
	PUSHJ	P,RSETUP		; Reply to the setup message
	MOVE	S2,STREAM		; Get the stream number back
	$WTO	(<Started>,,@FALOBA(S2)) ; Say we've started ok
	SETOM	FALACT(S2)		; Make the stream active
	SETZM	FALCHK(S2)		; Force a checkpoint/status update
	MOVE	S1,SUP.CN(M)		; Get the fake conditioning data
	MOVE	S1,[EXP IO.DCN,IO.ANF,IO.DCN](S1) ; Convert to our own flavor of expression
	MOVEM	S1,J$FTYP(J)		; Store as the network type
	MOVEI	S1,J$RPDL-1(J)		; Point at the beginning of the stack
	HRLI	S1,-PDSIZE		; Setup the stack length
	PUSH	S1,[EXP	FALEND]		; Last thing to call is final shutdown
	PUSH	S1,[EXP	FALL##]		; Store the start address
	MOVEM	S1,J$RACS+P(J)		; Save the initial stack pointer
	MOVX	S,S.RUN			; Get the running bit
	SETZM	FALBTS			; Say we want to update the status
	POPJ	P,			; And return to the scheduler
	Subttl	QUASAR Service Routines -- SHUTDN - Shutdown Processing on a Stream

;      SHUTDN will shut down processing on a stream.  This routine will just
; set a flag to the effect that we're supposed to drop everything, and assume
; that everyone else down the line will take care of things appropriately.

; Calling sequence:

;	S/	current stream status word
;	PUSHJ	P,SHUTDN		; Shut the stream down
;	returns true always

; Destroys S1, S2, T1-T4, modifies S

SHUTDN:	SETOM	FALBTS			;[24] Assume we don't want to update bits
	MOVEI	S1,SUP.TY(M)		; Get the object block address
	PUSHJ	P,FNDOBJ		; Find the matching stream
	JUMPF	.RETT			; Return if no such stream

SHUTIN::TXO	S,S.SHUT		; Mark this stream for shutdown
	SETZM	FALBTS			; Say we want the status stored
	MOVE	S2,STREAM		; Get the stream number
	MOVX	S1,PSF%CW		; If we're in connect wait
	ANDCAM	S1,FALSTW(S2)		;   we're not anymore
	SETZM	FALCHK(S2)		; Make sure we send a status update
	$RETT				; Return happily
	Subttl	QUASAR Service Routines -- FALEND - Process FAL Stream Termination

;      We come here when a FAL stream has shut down.  This routine will
; output the appropriate error message if the stream aborted due to
; unnatural causes, and in any case, clse the stream down.  This mostly
; consists of deallocating any per stream data that may be lying about.

; Calling sequence:

; (not formally called, other than being POPJed to by FALL)
;	S1/	shutdown/abort reason code

FALEND:	MOVE	P,[IOWD PDSIZE,PDL]	; Reset the stack pointer to scheduler context
	MOVE	T2,S1			; Copy the abort/shutdown reason
	MOVE	P1,STREAM		; Get the stream number
	SETOM	FALBTS			; Say no status update needed
	SKIPE	T2			; Abort reason given?
	$WTO	(<^T/@SETMSG(T2)/>,,@FALOBA(P1)) ; Yes, complain
	SETZM	FALACT(P1)		; Say the stream isn't active
	MOVE	S2,FALOBA(P1)		; Get the object block address
	MOVE	T1,S2			; Make another copy of this
	SETZM	(S2)			; Clear the first word
	HRL	S2,S2			; Make a BLT pointer
	ADDI	S2,1			; (Point at obj+1)
	BLT	S2,OBJ.SZ-1(T1)		; Clear the object block
	SKIPN	J,FALPAG(P1)		; Get any per stream storage pointer
	  JRST	MAIN.4			; Nothing.  Don't try to deallocate
	MOVX	S1,.WILDL##	; * Hack * Get the size of the WILD data
	SKIPE	S2,J$SWLD(J)	; * Hack * Get the pointer to it
	PUSHJ	P,.MMFWD	; * Hack * Release the memory
	  JFCL			; * Hack * Punt any error here
	SETZM	J$SWLD(J)	; * Hack * No more WILD data
	SETZM	FALPAG(P1)		; Say no more stream pages
	MOVEI	S1,<<J$$END+PAGSIZ-1>_-<WID(PAGSIZ-1)>> ; Get the number of pages to release
	MOVE	S2,J			; Copy the base address
	LSH	S2,-<WID(PAGSIZ-1)>	; Convert to a page number
	PUSHJ	P,M%RLNP		; Release a few pages
	PUSHJ	P,M%CLNC		; Get rid of unwanted pages
	JRST	MAIN.4			; And return to the scheduler
	Subttl	FALSWI Service -- SETCHN - Inform the World about a New Channel

;      Here when a FAL stream (running in FALSWI) opens a new network channel,
; usually just after a stream is started.  This routine is called to inform the
; scheduler about the existance of this new channel, and to setup the interrupt
; system.

; Calling sequence:

;	S1/	new channel number
;	J/	pointer to per stream storage area
;	S/	current stream flags word
;	PUSHJ	P,SETCHN		; Setup channel stuff
;	  returns non-skip if error in the PSI setup
;	returns skip on success.

; Destroys S1, S2, T1 (SWIL's T1-T3)

SETCHN::MOVE	T1,STREAM		; Get the current stream number
	MOVE	S2,J$FTYP(J)		; Get the stream type
	CAXN	S2,IO.ANF		; Is it an ANF-10 channel?
	  TXO	S1,FC%ANF		; Yes, remember this for later
	MOVEM	S1,FALCHN(T1)		; Store the channel number in our tables

	PUSHJ	P,INTCON		; Connect this guy to the interrupt system
	  POPJ	P,			; That's bad, pass it on
	JRST	.POPJ1			; Ok, return happily
	Subttl	IPCF Subroutines -- FNDOBJ - Find an Object Block in our Data Base

;      here when we've received an IPCF message refering to some object.  This
; routine will compare the object block given with those that we have tucked
; away in our stream tables, so that we can figure out which one of the streams
; this message is refering to.

; Calling sequence:

;	S1/	pointer the the object block in question.
;	PUSHJ	P,FNDOBJ		; Match this object block against ours
;	  returns false if we don't have this guy
;	returns true on success.  J contains the stream data pointer, status in S.

; Destroys S2, T1-T4, J, S

FNDOBJ:	MOVE	T1,.ROBTY(S1)		; Get the object type
	MOVE	T2,.ROBAT(S1)		; Get the unit number
	MOVE	T3,.ROBND(S1)		; Get the node number
	SETZ	T4,			; And init our loop counter

FNDO.1:	MOVE	S2,T4			; Copy the stream number
	IMULI	S2,OBJ.SZ		; Multiply by words per object block
	CAMN	T1,FALOBJ+.ROBTY(S2)	; Is it the right object type?
	 CAME	T2,FALOBJ+.ROBAT(S2)	; Yes, is it also the right unit number?
	  JRST	FNDO.2			; No, try the next one
	CAMN	T3,FALOBJ+.ROBND(S2)	; Yes, is it the right node number?
	  JRST	FNDO.3			; Yes, go do this one

; Here if this one doesn't match.  Try the next one.

FNDO.2:	ADDI	T4,1			; Bump to the next stream number
	CAIL	T4,NFAL			; HAve we done them all?
	  $RETF				; Yes, return error
	JRST	FNDO.1			; No, try this one

; We got a match.  Setup the stream data pointer and status, then return.

FNDO.3:	MOVEM	T4,STREAM		; Store the stream number
	SKIPN	J,FALPAG(T4)		; Get the stream data pointer
	  $RETF				; Nothing?  That's an error
	MOVE	S,J$RACS+S(J)		; Get the stream's status word
	$RETT				; And return happy
	Subttl	IPCF Subroutines -- RSETUP - Respond to a Setup Message

;      here when processing is complete on a SETUP message from QUASAR
; This routine is called to send the IPCF response.

; Calling sequence:

;	S1/	SETUP condition code
;	PUSHJ	P,RSETUP		; Respond to the SETUP
;	returns true always

; Destroys S1, S2, T1-T2

RSETUP:	MOVE	T2,S1			; Copy the setup condition code
	MOVX	S1,RSU.SZ		; Get the message length
	MOVEI	S2,MSGBLK		; And point to the message block
	PUSHJ	P,.ZCHNK		; Clear the message block
	MOVEI	T1,MSGBLK		; Point back at it
	MOVX	S1,RSU.SZ		; Get the message size again
	STORE	S1,.MSTYP(T1),MS.CNT	; Store the message size
	MOVX	S1,.QORSU		; Get "Response to SETUP" code
	STORE	S1,.MSTYP(T1),MS.TYP	; Store it
	MOVE	S1,STREAM		; Get the stream number
	MOVS	S1,FALOBA(S1)		; Get object addr,,0
	HRRI	S1,RSU.TY(T1)		; Get the place to move it to
	BLT	S1,RSU.TY+OBJ.SZ-1(T1)	; And move the object block
	SKIPE	S1,T2			;[26] Setup ok?
	  MOVX	S1,%RSUDE		;[26] No, say the device doesn't exist
	STORE	S1,RSU.CO(T1)		; Store the response code
	PUSHJ	P,SNDQSR		; Send it off to QUASAR
	SKIPN	S1,T2			;[26] Copy the response code back
	$RETT				;[26] No errors, just return
	PJRST	FALEND			;[26] Error, shut the stream
	Subttl	IPCF Subroutines -- SNDQSR - Send a Message to Quasar

; Routine to send an IPCF message to QUASAR.

; Calling sequence:

;	T1/	pointer to message to be sent
;	PUSHJ	P,SNDQSR		; Send the message
;	returns here if success, crashes on failure

; Preserves P1-P4

SNDQSR:	MOVX	S1,SP.QSR		; Get the QUASAR flag
	TXO	S1,SI.FLG		; Set the special index flag
	STORE	S1,SAB+SAB.SI		;  and store it
	SETZM	SAB+SAB.PD		; Clear the PID word
	LOAD	S1,.MSTYP(T1),MS.CNT	; Get the message length
	STORE	S1,SAB+SAB.LN		; Save the message address
	STORE	T1,SAB+SAB.MS		; Save the message address
	MOVEI	S1,SAB.SZ		; Load the message size
	MOVEI	S2,SAB			; And point at the message text
	PUSHJ	P,C%SEND		; Send the message
	JUMPT	QSRBAK			;[23] Make sure we know QUASAR's here
;	PJRST	QSRGON			;[23] Say QUASAR's gone away
	Subttl	IPCF Subroutines -- QSRGON - Flag that QUASAR has Gone Away

;      Here if we think QUASAR has gone away.  This can be because we couldn't
; send to QUASAR, or that QUASAR is insisting that our streams shouldn't be
; here.  Flag all the streams for possible shutdown.

; Calling sequence:

;	PUSHJ	P,QSRGON		; QUASAR has gone away
;	returns true always

; Destroys S1, S2, T1-T2

QSRGON:	SKIPE	QSRDIE			;[23] Already been here?
	  $RETT				;[23] Yes, just return now
	MOVSI	T1,-NFAL		;[23] No, setup an AOBJN pointer
	MOVX	S2,S.QSRD		;[23] Get the "QUASAR is DEAD" flag

; Loop here, flagging each stream as going away soon:

QSRG01:	SKIPE	FALACT(T1)		;[23] Is this stream active?
	 SKIPN	S1,FALPAG(T1)		;[23] Yes, any memory assigned?
	  JRST	QSRG02			;[23] No, skip this stream
	IORM	S2,J$RACS+S(S1)		;[23] Yes, lite the QUASAR gone bit
	SKIPE	S1,FALOBA(T1)		;[23] Any object block address?
	  SETZM	OBJ.TY(S1)		;[23] Yes, corrupt the object block

QSRG02:	AOBJN	T1,QSRG01		;[23] Loop for all possible streams
	TXO	S,S.QSRD		;[23] Make sure we set it for ourselves
	SETOM	QSRDIE			;[23] Flag for the world
	$RETT				;[23] And return sort of happy
	Subttl	IPCF Subroutines -- QSRBAK - Flag QUASAR is Back

;      Here when we either received or transmitted an IPCF message to QUASAR
; successfully.  We'll see if we thought it was gone, and if so, flag all the
; old stale streams for shutdown.

; Calling sequence:

;	QSRDIE/	non-zero if we thought QUASAR was dead
;	PUSHJ	P,QSRBAK		; Kill stale streams
;	returns true always

; Destroys S1, S2, T1

QSRBAK:	SKIPN	QSRDIE			;[23] Did we think QUASAR's dead?
	  $RETT				;[23] No, just return fdh
	SETZM	QSRDIE			;[23] Yes.  It ain't anymore
	$WTO	(Reset,<Shutting down stale FAL streams>,DUMOBJ)
	$SAVE	<P1,S,J,STREAM>		;[23] Save a bunch of registers
	MOVSI	P1,-NFAL		;[23] Setup an AOBJN pointer

; Loop here for each possible stream.  Flag each broken one we find for
; shutdown at end of job.

QSRD01:	SKIPE	FALACT(P1)		;[23] Is this stream active?
	 SKIPN	J,FALPAG(P1)		;[23] Maybe.  Is there memory assigned?
	  JRST	QSRD02			;[23] No, skip this one.
	MOVE	S,J$RACS+S(J)		;[23] Yes, get the status bits
	HRRZM	P1,STREAM		;[23] Store the stream number in a nice place
	PUSHJ	P,SHUTIN		;[23] Go shut the stream down
	MOVEM	S,J$RACS+S(J)		;[23] Put the new status back

QSRD02:	AOBJN	P1,QSRD01		;[23] Loop for all streams
	$RETT				;[23] And return happy
	Subttl	PSI Routines -- INTINI - Initialize the PSI System

;     Here on program startup to initialize the interrupt system.  This simply
; consists of putting the interrupt routine address in the vector block
; for each condition.  GLXLIB handles the rest.


; Calling sequence:

;	PUSHJ	P,INTINI		; Initialize the interrupt system
;	returns here always, no particular status

; Destroys S1, T1-T3

INTINI:	MOVEI	S1,IPCINT		; Get the address of the IPCF interrupt routine
	MOVEM	S1,IPCVEC+.PSVNP	; Store in the vector block
	MOVEI	S1,DECINT		; Get the DECnet interrupt vector
	MOVEM	S1,DECVEC+.PSVNP	; Store it

; Setup the ANF-10 interrupt vector blocks:

	SETZ	T1,			; Init the index/loop counter

INTI.1:	MOVEI	S1,INTANF(T1)		; Get the service routine address
	MOVEM	S1,ANFVEC+.PSVNP(T1)	; Store in the interrupt block
	ADDI	T1,ANHDSZ		; Bump the pointer
	CAIGE	T1,ANHDSZ*NANF10	; Done all of them?
	  JRST	INTI.1			; No, do another one

; Setup the disk interrupt vector blocks:

	SETZ	T1,			; Init the index again

INTI.2:	MOVEI	S1,INTDSK(T1)		; Get the service routine address
	MOVEM	S1,DSKVEC+.PSVNP(T1)	; Store in the interrupt block
	ADDI	T1,DSHDSZ		; Bump the pointer
	CAIGE	T1,DSHDSZ*NFAL		; Done them all?
	  JRST	INTI.2			; No, go do another one

	MOVX	S1,PS.FAC!T1		; Setup function and arg block pointer
	MOVX	T1,.PCNSP		; Set interrupts for NSP.
	MOVSI	T2,DECVEC-PSIVEC	; Get the PSI block offset
	SETZ	T3,			; No priority
	PISYS.	S1,			; Turn the condition on/off
	  $RETF				; Error, punt
	$RETT				; Ok, return happy
	POPJ	P,			; And return
	Subttl	PSI Routines -- INDCON - Connect a Disk Channel to the Interrupt System

;      Here from FALSWI when we've opened a new channel to disk.  This
; routine is called to  connect that stream to the interrupt system.

; Calling sequence:

;	S1/	channel number
;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INDCON		; Connect us to the interrupt system
;	  returns non-skip if errors
;	returns skip if success

; Destroys S1, S2 (SWIL's T1 and T2)

INDCON::$SAVE	<T1,T2,T3,T4>		; Save some temporaries
	MOVE	S2,STREAM		; Get the stream number
	MOVEM	S1,FALDSK(S2)		; Store the disk channel number
	IMULI	S2,.PSLEN		; Make an offset into the interrupt blocks
	ADDI	S2,DSKVEC-PSIVEC	; Add in the base PSI offset
	HRLZS	S2			; Put the offset in the left half
	TXO	S2,PS.RID!PS.ROD!PS.RDO!PS.ROL ; Get the interrupt enables
IFN <S2+1-T1>,<Printx ? Foo on AC assignments>
	SETZ	T1,			; No priority (as if it matters)
	MOVX	T2,PS.FAC!S1		; Say we want to add a condition
	PISYS.	T2,			; Tell the system about it
	  POPJ	P,			; Error, just punt
	TXO	S,S.PSID		; Ok.  Say we were here
	JRST	.POPJ1##		; And return happy
	Subttl	PSI Routines -- INDDIS - Disconnect a Disk Channel from the Interrupt System

;      Here from FALSWI when we're about to close a disk channel.  This
; routine will remove the channel from the interrupt system.

; Calling sequence:

;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INDDIS		; Disconnect us from the interrupt system
;	  returns here if error (not likely)
;	returns skip if success

; Destroys S1 and S2 (SWIL's T1 and T2)

INDDIS::$SAVE	<T1,T2,T3,T4>		; Save some registers
	MOVE	S2,STREAM		; Get the stream number
	SETO	S1,			; Get a null channel number
	EXCH	S1,FALDSK(S2)		; Get rid of our knowledge of this
	TXZE	S,S.PSID		; Were we enabled for PSI?
	 SKIPGE	S1			; Yes, was there a channel number?
	  JRST	INDD.1			;[17] No, skip this
	IMULI	S2,.PSLEN		; Multiply stream number by PSI block size
	ADDI	S2,DSKVEC-PSIVEC	; Add in the base PSI vector offset
	HRLZS	S2			; Put it in the left half
	TXO	S2,PS.RID!PS.ROD!PS.RDO!PS.ROL ; Get what we were enabled for
	SETZ	T1,			; No priority
	MOVX	T2,PS.FRC!S1		; Point at the arg block
	PISYS.	T2,			; Remove us from interruptions
	  JFCL				; Don't worry about errors here

INDD.1:	MOVX	S1,PSF%DI!PSF%DO!PSF%DF	;[17] Get the valid blocking reasons
	MOVE	S2,STREAM		;[17] Get the stream number back
	ANDCAM	S1,FALSTW(S2)		;[17] Clear any block from disk
	ANDCAM	S1,FALWAK(S2)		;[17] And clear any bogus pending wake
	JRST	.POPJ1##		; Just return happy
	Subttl	PSI Routines -- INTCON - Connect a Stream to the Interrupt System

;      Here from FALSWI when we've opened a new stream.  This routine is
; called to connect that stream to the interrupt system.

; Calling sequence:

;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INTCON		; Connect us to the interrupt system
;	  returns non-skip if errors
;	returns skip if success

; Destroys S1, S2 (SWIL's T1 and T2)

INTCON:	$SAVE	<T1,T2,T3,T4>		; Save some temporaries
	TXNE	S,S.PSIN		; Are we already enabled?
	  JRST	.POPJ1			; Yes, just return happy
	MOVE	S1,STREAM		; No, get the stream number
	MOVX	S2,PSF%NI!PSF%NO!PSF%CW	;[17] Get all the reasons we may be blocked
	ANDCAM	S2,FALSTW(S1)		;[17] Make sure we aren't blocked from these
	ANDCAM	S2,FALWAK(S1)		;[17]  and that we're not going to unblock
	MOVE	S2,FALCHN(S1)		; Get the channel number
	TXNN	S2,FC%ANF		; Is this an ANF-10 channel?
	  JRST	INTC.1			; No, try DECnet
	PUSHJ	P,INTCNA		; Yes, call the appropriate processor
	JRST	INTC.2			; Continue below

INTC.1:	PUSHJ	P,INTCND		; Connect to the DECnet interrupt system

INTC.2:	JUMPF	.POPJ			; Give error return if we failed
	TXO	S,S.PSIN		; Ok, say we're turned on
	JRST	.POPJ1			; And return happy
	Subttl	PSI Routines -- INTDIS - Disconnect a Stream from the Interrupt System

;      Here from FALSWI to disconnect a network channel from the interrupt
; system.

; Calling sequence:

;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INTDIS		; Disconnect from the interrupt system
;	  never gives error return
;	returns skip always

; Destroys S1 and S2 (SWIL's T1 and T2)

INTDIS::$SAVE	<T1,T2,T3,T4>		; Save some termporaries
	TXNN	S,S.PSIN		; Are we enabled?
	  JRST	INTD.2			; No.  Not much to do then.
	MOVE	S1,STREAM		; Get the stream number
	MOVE	S2,FALCHN(S1)		; Get the channel number
	TXNN	S2,FC%ANF		; Is this an ANF-10 channel?
	  JRST	INTD.1			; No, go do DECnet
	PUSHJ	P,INTDNA		; Yes, call the appropriate handler
	JRST	INTD.2			; Continue below

INTD.1:	PUSHJ	P,INTDND		; Disconnect from DECnet interrupts

INTD.2:	TXZ	S,S.PSIN		; Say we aren't enabled anymore
	MOVE	S2,STREAM		; Get the stream number back
	SETZM	FALCHN(S2)		; Clear to avoid interrupt confusion
	MOVX	S1,PSF%NI!PSF%NO!PSF%CW	;[17] Get all the reasons we may be blocked
	ANDCAM	S1,FALSTW(S2)		;[17] Make sure we aren't blocked from these
	ANDCAM	S1,FALWAK(S2)		;[17]  and that we're not going to unblock
	JRST	.POPJ1##		; And return
	Subttl	PSI Routines -- INTCNA, INTDNA - Connect an ANF-10 Channel to the Interrupt System

;      Here to add or remove a channel from the interrupt system.

; Calling sequence:

;	J/	pointer to the stream context data
;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INTCNA		; Connect the ANF channel to an interrupt
;	  or
;	PUSHJ	P,INTDNA		; Remove the ANF channel from the interrupt system
;	  returns false if errors
;	returns true on success

; Destroys S1, S2, T1-T3

INTCNA:	SKIPA	S1,[PS.FAC+T1]		; Say we want to add a condition

; Special entry to remove the channel from the interrupt system

INTDNA:	MOVX	S1,PS.FRC!T1		; Say we want to remove the condition
	MOVE	T2,STREAM		; Get the current stream number
	MOVE	T1,FALCHN(T2)		; Get the channel number
	TXNN	T1,FC%ANF		; Is this really an ANF-10 channel?
	STOPCD	(CDA,HALT,,Tried to connect DECnet channel to ANF-10 interrupt system)
	TLZ	T1,-1			; Get rid of junk.
	IMULI	T2,.PSLEN		; Multiply buy the PSI block length
	ADDI	T2,ANFVEC-PSIVEC	; Add in the block offset
	HRLZS	T2			; Make it offset,,0
	HRRI	T2,PS.RID!PS.ROD!PS.REF!PS.RDO!PS.ROL ; Get enable bits
	SETZ	T3,			; No particular priority
	PISYS.	S1,			; Add/remove the condition
	  $RETF				; Error, punt
	$RETT				; Ok, return happy
	Subttl	PSI Routines -- INTCND - Connect a DECnet Channel to the Interrupt System

;      Here when we open a new DECnet channel.  This routine will connect
; that channel to the interrupt system.

; Calling sequence:

;	J/	pointer to stream context data
;	S/	current stream status
;	STREAM/	current stream number
;	PUSHJ	P,INTCND		; Connect the channel to the DECnet interrupts
;	  returns false if error
;	returns true on success

; Destroys S1, T1-T3

INTCND:	TXNE	S,S.PSIN		; Are interrupts already enabled?
	  $RETT				; Yes, just punt this
	HRRZI	T3,-1			; Enable interrupts on all events
	JRST	INCD.1			; Continue in common code below

; Here if we want to disconnect:

INTDND:	TXNN	S,S.PSIN		; Were we enabled?
	  $RETT				; No, nothing to do here then
	SETZ	T3,			; Yes, disable everything

INCD.1:	MOVE	T1,[.NSFPI,,3]		; Get the function set set reason mask
	HRRZ	T2,STREAM		; Get the stream number
	MOVE	T2,FALCHN(T2)		; Get the DECnet channel number
	TXNE	T2,FC%ANF		; Is this really an ANF-10 channel?
	STOPCD	(CAD,HALT,,Tried to connect ANF channel to DECnet interrupt system)
	TLZ	T2,-1			; In any case, get rid of flags
	MOVEI	S1,T1			; Point at the argument block
	NSP.	S1,			; Tell the system about it
	  $RETF				; Error, punt
	$RETT				; And return happy
	Subttl	PSI Routines -- ANFINT - ANF-10 Interrupt Service

;      Here when ANF-10 I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found.  Note that most link failure interrupts
; will simply unblock the top level if it is waiting for I/O to complete, on
; the assumption that we'll get an error as soon as we try anything, and will
; therefore notice the event for ourselves.

; Calling sequence:

;	(none - this is an interrupt service routine)

; All registers are preserved

INTANF:			; Label for start of the headers
	ZZ==0			; Init the kludge counter
REPEAT	NANF10,<ANFINH(ZZ)	;; Generate an isr header
	ZZ==ZZ+1		;; Bump the kludge counter >

ANFINT:	MOVE	J,FALPAG(S1)		; Get the per stream storage pointer
	HRRZ	T1,.PSVFL(S2)		; Get the interrupt reason flags
	ANDCAM	T1,.PSVFL(S2)		; Clear them
	SETZ	T2,			; Init our wake conditions
	TXNE	T1,PS.ROL		; Did we just get a connect initiate?
	  TXO	T2,PSF%CW		; Yes, not in connect wait any longer
	TXNE	T1,PS.RID		; Input done?
	  TXO	T2,PSF%NI		; Yes, unblock if that's what we're waiting for
	TXNE	T1,PS.ROD		; Output done?
	  TXO	T2,PSF%NO		; Yes, clear the condition
	TXNE	T1,PS.RDO!PS.REF	; Connection drop or eof?
	  TXO	T2,PSF%NO!PSF%NI!PSF%CW	; Yes, unblock whatever we're doing
	ANDCAM	T2,FALSTW(S1)		; Clear any blocked bits
	IORM	T2,FALWAK(S1)		; And set wake bits to prevent race in DSCHD
	$DEBRK				; And return from the interrupt
	Subttl	PSI Routines -- DECINT - DECnet Interrupt Service

;      Here when DECnet I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found.  Note that most link failure interrupts
; will simply unblock the top level if it is waiting for I/O to complete, on
; the assumption that we'll get an error as soon as we try anything, and will
; therefore notice the event for ourselves.

; Calling sequence:

;	(none - this is an interrupt service routine)

; All registers are preserved

DECINT:	$BGINT	1			; Normal isr entry stuff
	HRRZ	S1,DECVEC+.PSVIS	; Get the interrupting channel number
	MOVSI	S2,-NFAL		; Setup an AOBJN counter to find the stream

; Loop here to find the stream number corresponding to this channel number:

DECI.1:	SKIPN	FALACT(S2)		; Is this stream active?
	  JRST	DECI.2			; No, skip it then
	MOVE	T1,FALCHN(S2)		; Yes, get the channel number
	TXNE	T1,FC%ANF		; Is this an ANF channel number?
	  JRST	DECI.2			; Yes, skip it
	CAIN	S1,(T1)			; No, is it the one we're looking for?
	  JRST	DECI.3			; Yes, go play with it then

DECI.2:	AOBJN	S2,DECI.1		; Loop if more streams to look at

; here if we got an interrupt from a channel that we don't have any matching
; stream for.  This really shouldn't happen.  I dunno, do sumthin'

	HRRZ	T2,S1			; Copy the channel number
	MOVEI	S1,T1			; Point at a temp argument block
	MOVX	T1,.NSFPI		; Say we want to set an interrupt mask
	SETZ	T3,			; Don't allow interrupts on this channel
	NSP.	S1,			; Tell the system about it
	  JFCL				; Oh well, punt it
	$DEBRK				; Return
; Here with the winning stream number in the right half of S2:

DECI.3:	HLLZ	S1,DECVEC+.PSVIS	; Get the channel status
	SETZ	T1,			; Init our reasons for waking
	TXNE	S1,NS.IDA!NS.IDR!NS.NDA!NS.NDR ; Anything we recognize?
	  JRST	DECI.4			; Yes, go unblock the right thing
	CAMN	S1,[.NSSCW,,0]		; No, are we just in connect wait?
	  JRST	DECI.5			; Yes, just exit the interrupt now
	TXO	T1,PSF%NI!PSF%NO!PSF%CW	; No.  Just unblock and hope the top
					;  level can figure out the link state
					;  change

DECI.4:	TXNE	S1,NS.NDA		; Input data available?
	  TXO	T1,PSF%NI		; Yes, unblock if waiting for input
	TXNE	S1,NS.NDR		; Can we do output now?
	  TXO	T1,PSF%NO		; Yes, unblock if waiting for output
	ANDCAM	T1,FALSTW(S2)		; Clear the appropriate blocks
	IORM	T1,FALWAK(S2)		; And set wake bits (prevent DSCHD racee)

DECI.5:	$DEBRK				; And return from this interrupt
	Subttl	PSI Routines -- DSKINT - Disk Interrupt Service

;      Here when disk I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found.  If we see the disk go offline, we'll
; block the stream until it comes back online.  Sometime, we should queue
; a message to the operator saying that this is happening.

; Calling sequence:

;	(none - this is an interrupt service routine)

; All registers are preserved

INTDSK:			; Label for start of the headers
	ZZ==0			; Init the kludge counter
REPEAT	NFAL,<DSKINH(ZZ)	;; Generate an isr header
	ZZ==ZZ+1		;; Bump the kludge counter >

DSKINT:	MOVE	J,FALPAG(S1)		; Get the per stream storage pointer
	HRRZ	T1,.PSVFL(S2)		; Get the interrupt reason flags
	ANDCAM	T1,.PSVFL(S2)		; Clear them
	SETZ	T2,			; Init our mask of wake reasons
;	TXNE	T1,PS.RDO		; Did the disk just go offline?
;	  TXO	T2,PSF%DF		; Yes, block the process
	TXNE	T1,PS.ROL		; Did the disk just come back on line?
	  TXO	T2,PSF%DF		; Yes, unblock the task
	TXNE	T1,PS.RID		; Input done?
	  TXO	T2,PSF%DI		; Yes, unblock if that's what we're waiting for
	TXNE	T1,PS.ROD		; Output done?
	  TXO	T2,PSF%DO		; Yes, clear the condition
	ANDCAM	T2,FALSTW(S1)		; Reset any blocking bits
	IORM	T2,FALWAK(S1)		; And prevent race in DSCHD
	$DEBRK				; And return from the interrupt
	Subttl	PSI Routines -- IPCINT - IPCF Message Available Interrupt Service Routine

;      Here on an IPCF message available PSI interrupt.  This handler will
; simply make the top level aware of the condition, and return from the
; interrupt.

; Calling sequence:

;	(none, this is an interrupt service routine)

; All registers preserved

IPCINT:	$BGINT	1			; Preserve registers, etc
	PUSHJ	P,C%INTR		; Tell the top level about this
	$DEBRK				; And return from the interrupt
	Subttl	SWIL Memory Manager -- .MMGWD - Get some Words of Memory

;     This routine replaces the routine of the same name in SWIL.  Since
; GLXLIB insists on being in charge of memory allocation, and since it
; does a better job than the default SWIL mechanism, we just intercept all
; calls to the default SWIL memory manager here, and forward them to the
; corresponding routine in GLXLIB.

; Calling sequence:

;	S1/	number of words to allocate (SWIL's T1)
;	PUSHJ	P,.MMGWD		; Get a chunk of memory
;	  returns non-skip if allocation failure
;	returns skip if success, pointer to block in S2 (SWIL's T2)

; Destroys S2 (SWIL's T2)

.MMGWD::PUSHJ	P,M%GMEM		; Call GLXLIB's memory manager
					; (which works just the way we want
					;  it to).
	JUMPT	.POPJ1			; Take the good return if success
	POPJ	P,			; Else take the non-skip return
	Subttl	SWIL Memory Manager -- .MMFWD - Deallocate a Chunk of Memory

;     This preforms the inverse of .MMGWD; that is it deallocates memory.

; Calling sequence:

;	S1/	size of chunk to be deallocated (SWIL's T1)
;	S2/	address of chunk to deallocate (SWIL's T2)
;	PUSHJ	P,.MMFWD		; Free some memory
;	  never returns non-skip
;	returns skip when done

; Destroys no registers

.MMFWD::PUSHJ	P,TSAV12##		; Save the registers we'll use
	PUSHJ	P,M%RMEM		; Go release the memory
	JRST	.POPJ1			; And return happily
	Subttl	Operator Messages -- BEGJOB - Begin a FAL Job

;      Here when a FAL stream has accepted a connection.  This routine is
; called to notify the operator that we're talking to someone.

; Calling sequence:

;	J/	pointer to the per stream storage
;	STREAM/	current stream number
;	J$SUSR/	username of accessing person
;	J$SNOD/	node we're talking to
;	PUSHJ	P,BEGJOB		; Tell the operator
;	returns non-skip always

; Destroys S1, S2 (SWIL's T1 and T2), updates J$RTIM

BEGJOB::TXNE	S,S.QSRD		;[23] Is QUASAR dead?
	  POPJ	P,			;[23] Yes, don't bother
	PUSHJ	P,I%NOW			; Get the current time
	MOVEM	S1,J$RTIM(J)		; Store for the checkpoints
	MOVE	S1,STREAM		; Get the stream number
	MOVE	S2,J$FTYP(J)		; Get the stream type
	CAXE	S2,IO.ANF		; ANF-10 node?
	 SKIPA	S2,[[ASCIZ \DECnet\]]	; No, say it's DECnet
	  MOVEI	S2,[ASCIZ \ANF-10\]	; Yes, say so
	$WTOJ	(Begin,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>,@FALOBA(S1))
	POPJ	P,			; Return
	Subttl	Operator Messages -- ENDJOB - End a FAL Job

;      Here when a FAL stream has closed a FAL session.  This routine is
; called to notify the operator that we're done talking to someone.

; Calling sequence:

;	J/	pointer to the per stream storage
;	STREAM/	current stream number
;	J$SUSR/	username of accessing person
;	J$SNOD/	node we're talking to
;	PUSHJ	P,ENDJOB		; Tell the operator
;	returns non-skip always

; Destroys S1, S2 (SWIL's T1 and T2)

ENDJOB::TXNE	S,S.QSRD		;[23] Is QUASAR dead?
	  POPJ	P,			;[23] Yes, don't bother
	MOVE	S1,STREAM		; Get the stream number
	SETZM	FALCHK(S1)		; Say we want the status updated
	MOVE	S2,J$FTYP(J)		; Get the stream type
	CAXE	S2,IO.ANF		; ANF-10 node?
	 SKIPA	S2,[[ASCIZ \DECnet\]]	; No, say it's DECnet
	  MOVEI	S2,[ASCIZ \ANF-10\]	; Yes, say so
	$WTOJ	(End,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>,@FALOBA(S1))
	POPJ	P,			; Return
	Subttl	DAP Status messages -- DAPERR -- Processor

; This routine is called by the BADDAP macro to type an error message and
; send a DAP status message to the remote task to inform it of the error.

; Calling sequence:

;	STREAM/	current stream number
;	J/	per stream storage pointer
;	PUSHJ	P,@[EXP	DAPERR		; Call the error processor
;         	    EXP MAC!MIC		; DAP status
;         	    EXP [ASCIZ ~TXT~]   ; Error text
;         	    EXP	DIE]		; Address to resume from
;	returns to DIE (defaults to call+1)

; Destroys no registers

	IO==11				; I/O CDB Address

DAPERR::$SAVE	<S1,S2,T1,T2,T3,T4,P1>	; Save some registers
	MOVE	P1,-11(P)		; Get the return address
	HRRZ	P1,-1(P1)		; Get the argument block address
	MOVE	S1,1(P1)		; Get the DAP status <MACCODE!MICCODE>
	LDB	S2,[POINT 6,1(P1),23]	; Get the MACCODE by itself
	CAIE	S2,MA.SYN		; MACCODE indicate DAP msg out of sync?
	JRST	DAPE.0			; No, full <MACCODE!MICCODE> is in S1
	HRRZ	S2,.IODIM(IO)		; Yes, get the MICCODE (i.e. msg type)
	DPB	S2,[POINT 12,S1,35]	; Now <MACCODE!MICCODE> is in S1

DAPE.0:	CLEAR	S2,			; No secondary status
	PUSHJ	P,FXSTS0##		; Send the status to the remote
	 JFCL				; Do not care here if link is gone
	TXNE	S,S.QSRD		; Is QUASAR dead?
	  JRST	DAPE.1			;  Yes, don't bother
	MOVE	S1,[POINT 7,J$SMSG(J)]	; Point at the message buffer
	MOVEM	S1,TEXTBP		; Can use this as the pointer storage
	MOVEI	S1,<100*5>-1		; Get the max string length
	MOVEM	S1,TEXTCT		; Store for DEPBP
	MOVEI	S1,DEPBP		; Get the address of the byte stuffer
	PUSHJ	P,.TYOCH##		; Swap SWIL's output routine
	PUSH	P,S1			; Save the old one
	HRRZ	S1,2(P1)		; Get the text string
	PUSHJ	P,.TSTRG##		; Copy to our storage
	SETZ	S1,			; Then, null terminate
	IDPB	S1,TEXTBP		;  the error string
	MOVE	T1,STREAM		; Get our stream number
	LDB	T3,[POINT 6,1(P1),23]	; Get the MACCODE
	$WTOJ	(<^T/@MACFLD(T3)/>,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error off

	POP	P,S1			; Restore SWIL's old output routine
	PUSHJ	P,.TYOCH##		; Put it back

DAPE.1:	MOVEI	S1,@3(P1)		; Get the return address
	MOVEM	S1,-11(P)		; Set it as our return
	POPJ	P,			; Restore our ACs and return

MACFLD:	[ASCIZ	~Pending~]
	[ASCIZ	~Successful~]
	[ASCIZ	~Unsupported~]
	[ASCIZ	~Reserved~]
	[ASCIZ	~File Open~]
	[ASCIZ	~Transfer Error~]
	[ASCIZ	~Transfer Warning~]
	[ASCIZ	~Access Termination~]
	[ASCIZ	~Format~]
	[ASCIZ	~Invalid~]
	[ASCIZ	~Sync~]
	Subttl	Operator Messages -- ERRMSG - STOPCD/ERROR/WARN/INFRM Processor

;      Here from FALSWI on execution of a STOPCD, ERROR, WARN or INFRM
; macro.  This routine is called by those macros to type an error message.
; In this case, typing an error message means sending a WTO to ORION so
; that everyone running OPR can see it.

; Calling sequence:

;	STREAM/	current stream number
;	J/	per stream storage pointer
;	PUSHJ	P,@[Z	ERRMSG		; Call the error processor
;		    XWD type,[ASCIZ ~TXT~] ; Message type and error text
;		    Z	RTN		; Additional output routine
;		    Z	ADR		; Additional data for output routine
;		    Z	DIE]		; Address to resume from
;	returns to DIE (defaults to call+1)

; Destroys no registers

ERRMSG::$SAVE	<S1,S2,T1,T2,T3,T4>	; Save some registers
	TXNE	S,S.QSRD		;[23] Is QUASAR dead?
	  JRST	ERRM.3			;[23] Yes, don't bother
	MOVE	T4,-10(P)		; Get the return address
	HRRZ	T4,-1(T4)		; Get the argument block address
	MOVE	S1,[POINT 7,J$SMSG(J)]	; Point at the message buffer
	MOVEM	S1,TEXTBP		; Can use this (I hope) as the pointer storage
	MOVEI	S1,<100*5>-1		;[21] Get the max string length
	MOVEM	S1,TEXTCT		;[21] Store for DEPBP
	MOVEI	S1,DEPBP		; Get the address of the byte stuffer
	PUSHJ	P,.TYOCH##		; Swap SWIL's output routine
	PUSH	P,S1			; Save the old one
	HLRZ	T3,1(T4)		; Get the message type
	SKIPL	T3			; Out of range?
	 CAILE	T3,.ETMAX		;  ...
	  JRST	ERRM.2			; Yes, just punt the WTO
	CAIE	T3,.ETREJ		; Is this a rejection message?
	  JRST	ERRM.0			; No, skip this mess
	MOVE	S1,STREAM		; Get the stream number
	MOVE	S2,J$FTYP(J)		; Get the stream type
	CAXE	S2,IO.ANF		; ANF-10 node?
	 SKIPA	S2,[[ASCIZ \DECnet\]]	; No, say it's DECnet
	  MOVEI	S2,[ASCIZ \ANF-10\]	; Yes, say so
	$TEXT	(DEPBP,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>)

ERRM.0:	HRRZ	S1,1(T4)		; Get the text string
	PUSHJ	P,.TSTRG##		; Copy to our storage
	SKIPN	S2,2(T4)		; Did he request a routine?
	  JRST	ERRM.1			; No, don't even bother
	SKIPE	S1,3(T4)		; Did he give an address
	MOVE	S1,@S1			; Yes, load the data
	PUSHJ	P,@S2			; Call the processor
ERRM.1:	SETZ	S1,			; Then, null terminate
	IDPB	S1,TEXTBP		;  the error string
	MOVE	T1,STREAM		; Get our stream number
	$WTOJ	(<^T/@MSGPFX(T3)/>,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error off

ERRM.2:	POP	P,S1			; Restore SWIL's old output routine
	PUSHJ	P,.TYOCH##		; Put it back

ERRM.3:	MOVEI	S1,@4(T4)		; Get the return address
	MOVEM	S1,-10(P)		; Set it as our return
	POPJ	P,			; Restore our ACs and return

; A table of message types:

MSGPFX:	[ASCIZ	~Information~]
	[ASCIZ	~Begin~]
	[ASCIZ	~End~]
	[ASCIZ	~Connect rejected~]
	[ASCIZ	~Warning~]
	[ASCIZ	~Error~]
	[ASCIZ	~Stream abort~]
	[ASCIZ	~Received DAP protocol error~]	;[21]
IFN FTDEBUG,[ASCIZ ~Diagnostic warning~]	;[21]
	Subttl	Operator Messages -- FRCCHK - Force a Checkpoint

;      Here when we've opened a new file to disk.  This routine is called
; to force a checkpoint on this stream.

; Calling sequence:

;	STREAM/	current stream number
;	PUSHJ	P,FRCCHK		; Force a checkpoint
;	returns non-skip always

; Destroys no registers

FRCCHK::$SAVE	<S1,S2>			; Save a couple of registers
	PUSHJ	P,I%NOW			; Get the current date and time
	MOVE	S2,J$LCHK(J)		; Get the last checkpoint time
	ADDI	S2,CHKMIN*3		; Compute minimum checkpoint interval
	CAMGE	S1,S2			; Have we passed that time yet?
	  MOVE	S1,S2			; Now, force the minimum interval
	MOVE	S2,STREAM		; Get the stream number
	MOVEM	S1,FALCHK(S2)		; Store the new checkpoint time
	POPJ	P,			; And return
	Subttl	Operator Messages -- NETERR - Report a Network Lossage Error

;     Here if FAL decides that the network has gone away, which is the
; usual reason for one of the SWIL routines to take the error return.
; This routine will redirect the SWIL output routines to our cannonical
; string in memory, call the SWIL error routine to decode the error
; string, then WTO the message to OPR.

; Calling sequence:

;	TF(M0)/	SWIL funny error number
;	P3(IO)/	SWIL funny CDB pointer for SWIERM
;	PUSHJ	P,NETERI		; Network input error
;	 or
;	PUSHJ	P,NETERO		; Network output error
;	returns non-skip always (what's the point of an error return here?)

; Destroys TF, S1, S2, T1, T2 (SWIL's M0, T1-T4)

NETERI::SKIPA	T1,[.ERISR##]		; Save the input error routine addr

NETERO::XMOVEI	T1,.EROSR##		; Get the output error routine addr
	TXNE	S,S.QSRD		;[23] Is QUASAR dead?
	  POPJ	P,			;[23] Yes, don't bother
	MOVE	S1,[POINT 7,J$SMSG(J)]	; Get the string pointer
	MOVEM	S1,TEXTBP		; Store in the proper place
	MOVEI	S1,<<100*5>-1>		; Get the max string length
	MOVEM	S1,TEXTCT		; Store for the char putter
	MOVEI	S1,DEPBP		; Get the address of the char putter
	PUSHJ	P,.TYOCH##		; Go reset the output routine address
	PUSH	P,S1			; Save the old routine address
	MOVE	S1,P3			; Copy the CDB pointer
	PUSHJ	P,(T1)			; Go call the processor
	SETZ	S1,			; Get a null
	IDPB	S1,TEXTBP		; Terminate the string
	MOVE	T1,STREAM		; Get the stream number
	$WTOJ	(Error,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error
	POP	P,S1			; Restore the old output routine addr
	PUSHJ	P,.TYOCH##		; Go restore it
	POPJ	P,			; And return
	Subttl	Operator Messages -- .STOPCD - Abort a Stream

;      Here when a stream decides that the best thing to do is to stop
; running.  This will just type a message to the operator and mark the
; stream as having crashed.

;	PUSHJ	P,.STOPCD		; Go away
;	never returns

.STOPCD::MOVE	T1,STREAM		; Get our stream number
	TXNN	S,S.QSRD		;[23] Is QUASAR dead?
	$WTOJ	(<Stream shutting down>,<Aborting stream>,@FALOBA(T1))
	SETZM	FALCHK(T1)		; Say we want the status updated
	MOVX	TF,PSF%CR		; Say we've crashed
	PUSHJ	P,DSCHD			; Deschedule this task
	JRST	.-2			; In the unlikely event that it returns
	Subttl	Dummy SWIL Routines -- .ASKYN, .ASKNY

;     A couple of dummy entries to satisfy some SWIL externals.  These
; will always give the non-skip (error return).

.ASKNY::				; Ask Yes or No
.ASKYN::				; Ask No or Yes
.DFLND::				; Ask for userid, password, etc.
ONERCK::				; /OKERR checker
	POPJ	P,			; Error return

; Some randy error messages:

ERRCDI::STOPCD	(CDI,HALT,,Can't initialize input CDB)
ERRCDO::STOPCD	(CDO,HALT,,Can't initialize output CDB)
	Subttl	End of FALQSR

	PRGEND
	TITLE	FAL	NFT File Access Listener module
	SUBTTL	Robert Houk/RDH

	SEARCH	JOBDAT,MACTEN,UUOSYM	;STANDARD DEFINITIONS
	SEARCH	FALUNV			;FAL DEFINITIONS
	SEARCH	SWIL			;SWIL PACKAGE DEFINITIONS
	SEARCH	ACTSYM			;GET SOME ACTDAE INTERFACE SYMBOLS

	SALL				;PRETTY LISTINGS
	.DIREC	FLBLST			;PRETTIER LISTINGS

	.TEXT	\REL:SWIL/S/EXCLUDE:.POPJ/INCLUDE:.ERROR/SEGMENT:LOW,REL:GLXLIB/SUPPRESS:(.SAVE1,.SAVE2,.SAVE3,.SAVE4)/S/INCLUDE:GLXINI\

	COMMENT	\

FAL  --  NFT "File Access Listener" module

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986.
ALL RIGHTS RESERVED.

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 TIS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

\
	SUBTTL	Definitions -- Accumulator Usage

; Define our accumulator usage here:

M0==0		;RETURNED STATUS
T1==1		;TEMPORARIES
T2==2
T3==3
T4==4
P1==5		;PRESERVED
P2==6
P3==7
P4==10
NM==7		;SWIL'S PLACE TO PUT A NUMBER
CH==10		;SWIL'S PLACE TO PUT A CHARACTER
IO==11		;CURRENT CDB
ID==12
CI==13		;INPUT CDB
CO==14		;OUTPUT CDB
J==15		;PER STREAM DATA STORAGE POINTER
S==16		;STATUS FLAGS WORD
P==17		;STACK POINTER

;NONPP - Routine to check for and disallow NETPPN access

NONPP1:	MOVE	M0,.IOPPN(CI)	;GET ACCESSING PPN
	CAME	M0,NETPPN	;IS IT NETPPN?
	JRST	.POPJ1##	;NO, NO PROBLEM
	MOVEI	M0,$EFPRT	;YES, DISALLOW WITH A "PRIVILEGE VIOLATION"
	POPJ	P,		;AND TELL CALLER TO FLICK THIS REQUEST IN
	SUBTTL	FAL initialization -- FALINI set FAL job parameters

;FALINI  --  INITIALIZE FAL JOB RUNTIME PARAMETERS
;Call is:
;
;	PUSHJ	P,FALINI
;	 error return
;	normal return
;
;FALINI sets up FAL's runtime job parameters so that FAL stands a chance
;of working:
;
;	1)	Set program name to "FAL-10" 'cuz it looks purty
;
;	2)	DSKFUL ERROR so that error codes returned to FAL rather
;		than stopping the job and barfing on the "user"
;
;	3)	LOCATE 0 so that batch/etc. submissions via QUEUE. UUO
;		work right (else batch jobs end up on a DN87's "processor"
;		queue! Amusing, but...)
;
;	4)	SPOOL ALL so that randoms from remote places can't tie up
;		real lineprinters or whatever. This is somewhat dubious,
;		but since DAP doesn't give the user choice of real or
;		spooled, this is the most "practical" choice . . .
;
;The error return is not exercised.
;
;Uses T1, T2.

FALINI::SETZM	BZFAL		;CLEAR OUT AND INITIALIZE IMPURE DATA
	MOVE	T1,[BZFAL,,BZFAL+1]  ;BLT POINTER TO
	BLT	T1,EZFAL-1	;CLEAN OUT DATA AREAS

;SET PROGRAM NAME TO "FAL-10"

	MOVE	T2,['FAL-10']	;TENTATIVE NAME
	SETNAM	T2,		;DECLARE MORE MEANINGFUL PROGRAM NAME

;SET THE JOB'S MESSAGE WATCH BITS TO FIRST, NO PREFIX

	HRROI	T1,.GTWCH	;[21] GET THIS JOB'S
	GETTAB	T1,		;[21]  WATCH BITS
	 SETZ	T1,		;[21] NONE?
	ANDX	T1,JW.WAL	;[21] GET RID OF THE OLD MESSAGE BITS
	TXO	T1,JW.WFL	;[21] SET FIRST ONLY
	HLRZS	T1		;[21] PUT IN A SETUUOABLE PLACE
	HRLI	T1,.STWTC	;[21] GET THE SET WATCH SETUUO FUNCTION
	SETUUO	T1,		;[21] RESET OUR WATCH BITS
	 JFCL			;[21] OH WELL, IT'S NOT THAT IMPORTANT

;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE

;SET DSKFUL ERROR SO GET ERRORS WE CAN RETURN TO REMOTE ACCESSOR

	MOVE	T1,[.STDFL,,.DFERR]  ;ARGUMENT TO SETUUO TO
	SETUUO	T1,		;SET DSKFUL ERROR
	 WARN	DFL,<Can't set DSKFUL ERROR>

;LOCATE TO CENTRAL HOST SO BATCH JOB SUBMISSION A LA QUEUE. UUO WORKS

	SETZ	T1,		;0 = CENTRAL HOST
	LOCATE	T1,		;PUT US THERE TO NOT CONFUSE GALAXY
	 WARN	LCS,<Can't LOCATE to central site>

;SET SPOOL ALL (IT'S A COP OUT, BUT DAP DOESN'T GIVE US PROPER CONTROL!)

	MOVE	T1,[.STSPL,,JS.PAL]  ;SETUUO ARGUMENT TO
	SETUUO	T1,		;SET SPOOL ALL
	 WARN	SPL,<Can't SET SPOOL ALL>

;INITIALIZE USERS.TXT FOR "USERID" NAME TO PPN TRANSLATION

IFN FTUTXT,<			;IF TRANSLATING NAMES TO PPNS, THEN
	PUSHJ	P,UTXINI	;INITIALIZE USERS.TXT TRANSLATION BUFFER
	 WARN	UTX,<Couldn't initialize USERS.TXT name<=>ppn translation>
> ;END IFN FTUTXT

;CALL .ISCAN SO'S TO INITIALIZE ALL THE GOOD STORAGE

	MOVE	T1,[ISLEN,,ISBLK] ;GET THE .ISCAN ARG BLOCK POINTER
	PUSHJ	P,.ISCAN##	;INITIALIZE SCAN/SWIL
	XMOVEI	T1,.POPJ##	;GET A NICE NULL ROUTINE
	PUSHJ	P,.TYOCH##	;MAKE SURE SPURIOUS SWIL OUPTUT GETS FLUSHED

	MOVX	T1,$NTPPN	;GET THE DEFAULT NETPPN
	MOVEM	T1,NETPPN	;STORE IT

	POPJ	P,		;RETURN
	SUBTTL	FAL initialization -- UTXINI initialize USERS.TXT buffer

;UTXINI  --  INITIALIZE USERS.TXT BUFFER
;Call is:
;
;	PUSHJ	P,UTXINI
;	return
;
;On return, UTXCTR and UTXPTR are the byte counter and pointer to the
;USERS.TXT name to ppn translation buffer, or 0 if no translation is to
;be performed.
;
;*** This routine needs much smartening . . .
;
;Uses T1 - T4, P1 - P4.

IFN FTUTXT,<

UTXINI:	OPEN	UTX,[.IODMP	;DUMP MODE I/O HERE FOR CONVENIENCE
		  'SYS   '	;FROM DEVICE SYS:
		  0,,0]		;WITH NO RING HEADERS
	 JRST	 UTXIE0		;NO, BOMB IT OUT
	MOVE	P1,.JBFF	;ADDRESS OF START OF BUFFER AREA
	MOVEI	T1,.RBSIZ+1(P1)	;END ADDRESS OF LOOKUP BLOCK
	CORE	T1,		;ALLOCATE MEMORY FOR LOOKUP BLOCK
	 JRST	UTXIE5		;CAN'T EVEN GET A LOOKUP BLOCK???
	MOVEI	T1,.RBSIZ+1	;EXTENDED LOOKUP BLOCK LENGTH
	MOVEM	T1,.RBCNT(P1)	;SET IN THE LOOKUP BLOCK
	SETZM	.RBPPN(P1)	;NO EXPLICIT PATH
	DMOVE	T1,[EXP 'USERS ','TXT   ']  ;USERS.TXT
	DMOVEM	T1,.RBNAM(P1)	;SET IN THE LOOKUP BLOCK
	LOOKUP	UTX,(P1)	;SEE IF THE FILE IS AVAILABLE
	 JRST	UTXIEL		;NO, BOMB IT OUT
	SKIPG	P2,.RBSIZ(P1)	;[12] SIZE OF FILE (DATA WORDS WRITTEN)
	JRST	UTXIEZ		;[12] EMPTY FILE, IGNORE IT.
	MOVE	T1,P1		;ADDRESS OF START OF BUFFER
	ADDI	T1,-1(P2)	;ADDRESS OF END OF BUFFER
	CORE	T1,		;MAKE SURE THE BUFFER WILL FIT
	 JRST	UTXIE5		;NO, BOMB IT OUT
	MOVN	T1,P2		;IOWDS WANT NEGATIVE LENGTH
	HRLZ	T1,T1		; IN THE LEFT HALF
	HRRI	T1,-1(P1)	;AND ADDRESS-1 IN THE RIGHT HALF
	SETZ	T2,		;TERMINATE THE I/O LIST
	IN	UTX,T1		;READ IN USERS.TXT
	CAIA			;BINGO!
	 JRST	UTXIE6		;NO, BOMB IT OUT
	RELEAS	UTX,		;WE ARE DONE WITH THE FILE NOW
	HRLI	P1,(POINT 7,)	;BYTE POINTER TO USERS.TXT BUFFER
	MOVEM	P1,UTXPTR	;REMEMBER USERS.TXT BUFFER POINTER
	IMULI	P2,5		;BYTE COUNTER FOR USERS.TXT BUFFER
	MOVE	P3,P1		;BYTE POINTER TO WRITE USERS.TXT

;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE

;STILL IFN FTUTXT

;USERS.TXT contains ASCII ppn<=>name correspondences of the form
;"dev:[p,pn],name" (this format is defined by the MS mail proggie).
;Internally, they will be compressed to just "[p,pn]name<LF>" form.

UTXIN2:	PUSHJ	P,UTXGT1	;GET ONE USERS.TXT CHARACTER
	 JRST	UTXIN9		;DONE, REMEMBER IT
	CAIE	T1,"["		;START OF PPN YET?
	JRST	UTXIN2		;NO, SKIP REST OF DEVICE PORTION
UTXIN3:	PUSHJ	P,UTXPT1	;YES, SAVE START OF PPN FIELD
	 JRST	UTXIE7		;NO, BOMB OUT
	PUSHJ	P,UTXGT1	;GET NEXT USERS.TXT CHARACTER
	 JRST	UTXIN9		;DONE
	CAIE	T1,"]"		;END OF PPN PART YET?
	JRST	UTXIN3		;NO, STILL PPN, SAVE IT
	PUSHJ	P,UTXPT1	;YES, CAP OFF PPN
	 JRST	UTXIE7		;BOMB IT OUT
	PUSHJ	P,UTXGT1	;NEXT INPUT CHARACTER
	 JRST	UTXIN9		;DONE
	CAIE	T1,","		;SHOULD BE A COMMA
	JRST	UTXIN2		;NO, JUST RESTART, JUNKING THIS ENTRY . . .
UTXIN5:	PUSHJ	P,UTXGT1	;GET NAME CHARACTER
	 JRST	UTXIN9		;DONE
	PUSHJ	P,UTXPT1	;AND SAVE IT TOO
	 JRST	UTXIE7		;DOMB IT OUT
	CAIE	T1,.CHLFD	;END OF PPN<=>NAME ENTRY?
	JRST	UTXIN5		;NO, FINISH OFF NAME
	JRST	UTXIN2		;YES, DO NEXT ENTRY

;Here when completed successfully

UTXIN9:	MOVEI	T1,.CHLFD	;A <LF> CHARACTER
	PUSHJ	P,UTXPT1	;ENSURE USERS.TXT BUFFER ENDS WITH A <LF>
	 JRST	UTXIE7		;HOW INCONVENIENT A PLACE TO BOMB
	TDZA	T1,T1		;A NULL CHARACTER
	IDPB	T1,P3		;STASH ANOTHER NULL
	TXNE	P3,74B5		;BYTE POINTER FILLED UP A WORD YET?
	JRST	.-2		;NO, ZERO-FILL THE WORD
	MOVEI	P1,1(P3)	;END ADDRESS+1 OF USERS.TXT BUFFER
	MOVE	T2,.JBFF	;START ADDRESS OF USERS.TXT BUFFER
	SUBM	P1,T2		;T2:=COUNT OF WORDS IN BUFFER
	IMULI	T2,5		;T2:=COUNT OF BYTES IN BUFFER
	MOVEM	T2,UTXCTR	;SAVE BYTE COUNTER FOR UTXPTR
	MOVEM	P1,.JBFF	;MARK THAT WE NOW OWN USERS.TXT BUFFER
	MOVEM	P1,CMDFF##	;TELL REST OF WORLD TOO
	MOVEM	P1,SAVFF##	;TELL REST OF THE UNIVERSE ALSO
	HRLM	P1,.JBSA	;*** FINALLY, TELL EVEN THE GODS . . .
	JRST	.POPJ1##	;HAPPY
;STILL IFN FTUTXT

;Here when error setting up USERS.TXT

UTXIEL:	HRRZ	T1,.RBEXT(P1)	;RETRIEVE LOOKUP ERROR CODE
	CAIN	T1,ERPRT%	;PROTECTION FAILURE?
	JRST	UTXIE1		;YES
	CAIN	T1,ERTRN%	;RIB/DIRECTORY ERROR?
	JRST	UTXIE2		;YES
	CAIE	T1,ERFNF%	;FILE NOT FOUND?
	JRST	UTXIE3		;RANDOM ERROR
	INFRM	UTM,<No SYS:USERS.TXT file, no names <=> ppn translation will be performed>
UTXIEZ:	AOS	(P)		;[12] TAKE HAPPY (ALBEIT FAILED IN THIS CASE) RETURN
	PJRST	UTXINE		;BLAST AWAY THE I/O CHANNEL

UTXIE0:	ERROR	UT0,<Can't OPEN device SYS: for SYS:USERS.TXT>,,,UTXINE
UTXIE1:	ERROR	UT1,<Protection failure reading file SYS:USERS.TXT>,,,UTXINE
UTXIE2:	ERROR	UT2,<RIB error reading file SYS:USERS.TXT>,,,UTXINE
UTXIE3:	ERROR	UT3,<Can't LOOKUP file SYS:USERS.TXT>,,,UTXINE
UTXIE5:	ERROR	UT5,<Can't get memory to read SYS:USERS.TXT>,,,UTXINE
UTXIE6:	ERROR	UT6,<Can't read file SYS:USERS.TXT>,,,UTXINE
UTXIE7:	ERROR	UT7,<Format error reading SYS:USERS.TXT>,,,UTXINE

UTXINE:	RELEAS	UTX,		;STOMP ON I/O CHANNEL
	SETZM	UTXPTR		;MARK NO USERS.TXT BUFFER
	MOVE	T1,.JBFF	;START OF BUFFER
	CORE	T1,		;DEALLOCATE NOW-USELESS BUFFER
	 JFCL			;HO HUM
	POPJ	P,		;AND THAT IS THAT
;STILL IFN FTUTXT

;UTXGT1 - GET ONE USERS.TXT CHARACTER

UTXGT1:	SOJL	P2,.POPJ##	;ERROR IF NO MORE
	ILDB	T1,P1		;NEXT INPUT CHARACTER
	JUMPE	T1,UTXGT1	;SUPPRESS NULLS
	CAIN	T1,.CHCRT	;<CR>?
	JRST	UTXGT1		;YES, JUST RETURN THE <LF>
	CAIE	T1," "		;SPACE?
	CAIN	T1,.CHTAB	; OR TAB?
	JRST	UTXGT1		;YES, SUPPRESS
	CAIE	T1,";"		;COMMENT?
	CAIN	T1,"!"		; ALTERNATE COMMENT?
	JRST	UTXGT3		;YES, EAT IT UP
	CAIL	T1,"a"		;LOWERCASE ALPHA?
	CAILE	T1,"z"		; . . .
	JRST	.POPJ1##	;NO, RETURN VALID CHARACTER
	SUBI	T1,"a"-"A"	;SHIFT TO UPPERCASE ALPHA
	JRST	.POPJ1##	;AND RETURN IT

UTXGT3:	SOJL	P2,.POPJ##	;ERROR IF NO MORE
	ILDB	T1,P1		;NEXT CHARACTER
	CAIN	T1,.CHLFD	;END OF LINE (COMMENT) YET?
	JRST	UTXGT3		;NO, KEEP EATING
	JRST	.POPJ1##	;YES, RETURN END OF LINE



;UTXPT1  --  WRITE ONE USERS.TXT CHARACTER

UTXPT1:	IDPB	T1,P3		;STASH VALID CHARACTER
	JRST	.POPJ1##	;ALL DONE!

> ;END IFN FTUTXT
	SUBTTL	Main FAL processing loop

FALL::	TXZ	S,S.CLR		;CLEAR THE PER CONNECTION BITS
	PUSHJ	P,FALLI		;INITIALIZE A FAL JOB PROCESS
	  JRST	FALL70		;CHECK OUR ERROR
	TXZE	S,S.KILL	;DID WE JUST ABORT A TRANSFER?
	 JRST	FALL		;YES, START A NEW ONE THEN
	TXNN	S,S.SHUT	;ARE WE SUPPOSED TO SHUT DOWN?
	 JRST	FALL		;NO, TRY FOR ANOTHER SESSION
	SETZ	T1,		;YES, SAY WE'RE SHUTTING DOWN NORMALLY
	POPJ	P,		;AND FINISH THIS STREAM OFF

;HERE ON ERROR FROM FALLI

FALL70:	TXZE	S,S.KILL	;DID WE JUST ABORT A TRANSFER?
	 JRST	FALL		;YES, START A NEW ONE THEN
	CAIE	M0,$EFUID	;DID WE REJECT THE USER ID?
	CAIN	M0,$EFUAC	;DID WE REJECT THE USER ACCOUNT DATA?
	JRST	FALL77		;YES, RETRY IMMEDIATELY
	CAIN	M0,$EINLA	;DID LINK "TERMINATE" NORMALLY?
	JRST	FALL77		;YES, RETRY IMMEDIATELY
	CAIN	M0,$EFNNS	;GOT ANY NETWORK SOFTWARE?
	  JRST	[MOVEI	T1,$FSNNS	;SAY NO NETWORK SOFTWARE
		 POPJ	P,]		;RETURN TO TOP LEVEL
	CAIN	M0,$EFPRV	;PRIVILEGE VIOLATION?
	  JRST	[MOVEI	T1,$FSISP	;SAY NO PRIVS
		 POPJ	P,]		;RETURN TO SETUP PROCESSOR

;LINK TERMINATED ABNORMALLY - USE SLIDING WAIT INTERVAL TO ALLOW
;THE WORLD TO CALM DOWN

	MOVE	M0,J$FSLP(J)	;GET THE SLEEPER VALUE
	SKIPN	M0		;ANY VALUE SET?
	MOVEI	M0,1		;NONE, START WITH 1
	LSH	M0,1		;DOUBLE THE INTERVAL
	CAILE	M0,^D64		;TIME GOTTEN TOO BIG?
	MOVEI	M0,^D64		;YES, PEG AT ABOUT ONE MINUTE WAITS
	MOVEM	M0,J$FSLP(J)	;SAVE FOR NEXT TIME
	TXO	M0,PSF%SL	;SAY WE'RE SLEEPING
	PUSHJ	P,DSCHD##	;DESCHEDULE FOR A WHILE
	TXNN	S,S.SHUT	;SHOULD WE SHUT DOWN?
	 JRST	FALL		;NO, NOW TRY AGAIN
	SETZ	T1,		;YES, GET THE REASON
	POPJ	P,		;AND RETURN

FALL77:	JRST	FALL		;JUST TRY AGAIN IMMEDIATELY
;INITIALIZE ONE FAL JOB PROCESS

FALLI:	MOVE	P1,J$FTYP(J)	;SELECT EITHER ANF (IO.ANF) OR DECNET (IO.DCN)
	SETZM	J$RTIM(J)	;FLAG THAT WE HAVEN'T DONE ANYTHING YET
	PUSHJ	P,FALJB		;FIRE UP A SINGLE FAL JOB STREAM
	 SKIPA	P1,M0		;SAVE ERROR CODE FROM FALJB
	SETZ	P1,		;FLAG NO ERROR
	TXZ	S,S.OPEN!S.CONN	;[16] NO FILES OPEN ANYMORE
	SKIPE	IO,CI		;[14] GET THE NETWORK CDB POINTER
	SKIPN	.IONCH(IO)	;[14] ANY CHANNEL OPEN HERE?
	JRST	FALLI1		;[14] NO, DON'T TRY TO CLOSE IT THEN
	MOVE	IO,CI		;[14] YES, GET THE CDB ADDRESS
	SETZ	T3,		;[14] NO OPTIONAL DATA ON ABORT
	PUSHJ	P,NTNAB1##	;[14] GO ABORT THIS CONNECTION
	 JFCL			;[14] NOT REAL FATAL IF ERROR HERE

FALLI1:	PUSHJ	P,INTDIS##	;DISCONNECT AND/OR CLEAR INTERRUPT ENABLES
	 JFCL			;ERROR IS MEANINGLESS HERE
	SKIPN	IO,CO		;[14] GET THE SLAVE CDB ADDRESS
	JRST	FALLI3		;[14] NO, DON'T TRY TO CLOSE IT THEN
	PUSHJ	P,IOZAP1##	;[37] KILL OFF ANYTHING THAT'S STILL AROUND
	 JFCL			;[37] DON'T WORRY ABOUT ERRORS

FALLI3:	PUSHJ	P,INDDIS##	;DISCONNECT FROM DISK INTERRUPTS
	 JFCL			;DON'T WORRY ABOUT ERRORS HERE
	SKIPE	J$RTIM(J)	;DID WE DO ANYTHING?
	 PUSHJ	P,ENDJOB##	;YES, SAY WE'RE DONE WITH THIS SESSION
FALLI2:	SKIPN	T2,CI		;PRIMARY CDB ADDRESS
	JRST	FALLI4		;NONE?
	SKIPN	T1,.IOXSZ(T2)	;SIZE OF CDB ALLOCATED
	MOVE	T1,.IOSIZ(T2)	;SIZE OF CDB ALLOCATED
	PUSHJ	P,.MMFWD##	;DEALLOCATE THE CDB
	 DEBUG	<Deallocation of primary CDB failed at FALLI2>
FALLI4:	SKIPN	T2,CO		;SLAVE CDB ADDRESS
	JRST	FALLI6		;NONE
	SKIPN	T1,.IOXSZ(T2)	;SIZE OF CDB ALLOCATED
	MOVE	T1,.IOSIZ(T2)	;SZIE OF CDB ALLOCATED
	PUSHJ	P,.MMFWD##	;DEALLOCATE THE CDB
	 DEBUG	<Deallocation of slave CDB failed at FALLI4>

FALLI6:	JUMPE	P1,.POPJ1##	;RETURN HAPPILY IF SUCCESSFUL
	MOVE	M0,P1		;RESTORE ERROR CODE TO STATUS REGISTER
	POPJ	P,		;AND PROPAGATE FALJB'S ERROR
	SUBTTL	FAL "JOB" process

;STARTUP A FAL PROCESS

FALJB:	SETZB	CI,CO		;NO CDB'S ALLOCATED YET

;ALLOCATE AND INITIALIZE PRIMARY CDB FOR THE NETWORK-BASED LINK

	MOVEI	T2,FALIV	;FAL'S INIT STUFF
	PUSHJ	P,.IOINA##	;ALLOCATE AND INITIALIZE PRIMARY CDB
	 JRST	ERRCDI##	;DUH?
	MOVE	CI,T1		;REMEMBER PRIMARY CDB ADDRESS

;FROM HERE ON FAL OPERATES IN A "NATIVE" MODE RE THE I/O PACKAGE, FREELY
;USING T1 - P4, AND IO AS THE I/O CDB INDEX.
;
;THIS SAVES OODLES OF AC PUSHING/SHOVING/POPPING!

	MOVE	IO,CI		;SELECT THE PRIMARY CDB
	IORM	P1,.IOCCF(IO)	;SELECT REQUESTED NETWORK PROTOCOL
	MOVEI	T1,SCHEDL	;GET THE SCHEDULER ADDRESS
	MOVEM	T1,.IOSCH(IO)	;STORE FOR SWIL

;SETUP THE DESTINATION (THAT'S US) PROCESS DESCRIPTOR BLOCK

FALOBJ:!MOVX	T3,<0,,21>	;GENERIC FAL FORMAT/OBJECT TYPE
	MOVEM	T3,.IONDF(IO)	;SET IN THE CDB
	SETZM	.IONDP(IO)	;NO PPN SPECIFIED
	SETZM	.IONDN(IO)	;NOR ANY SPECIFIC PROCESS NAME

;SETUP THE SOURCE (REMOTE NFT/ETC.) PROCESS DESCRIPTOR BLOCK

	MOVX	T3,<0,,-1>	;GENERIC ANYTHING FORMAT/OBJECT TYPE
	MOVEM	T3,.IONSF(IO)	;SOURCE FORMAT/OBJECT (DON'T CARE)
	SETZM	.IONSP(IO)	;SOURCE PPN (DON'T CARE)
	SETZM	.IONSN(IO)	;SOURCE NAME (DON'T CARE)
;NO OTHER RESTRICTIONS EITHER

	SETZM	.IONUS(IO)	;USER ID (DON'T CARE)
	SETZM	.IONPW(IO)	;USER PASSWORD (DON'T CARE)
	SETZM	.IONAC(IO)	;USER ACCOUNT STRING (DON'T CARE)
	SETZM	.IONUD(IO)	;USER DATA (DON'T CARE)

;TELL MONITOR WHAT WE'RE UP TO

FALJ20:	SETZ	T2,		;ANY NODE OK
	PUSHJ	P,NTNIP1##	;INITIALIZE A PASSIVE NETWORK CHANNEL
	 POPJ	P,		;OOPS - NETWORK NOT BEING COOPERATIVE
	MOVE	T1,.IONCH(IO)	;GET THE NETWORK CHANNEL NUMBER
	PUSHJ	P,SETCHN##	;SETUP INTERRUPTS ON THIS CHANNEL
	 JRST	[PUSHJ	P,NTFIN1##	;ERROR, BLOW OFF THIS CHANNEL
		  JFCL			;PUNT ANY ERRORS HERE
		 MOVEI	M0,$EEXXX	;GET A GENERIC ERROR CODE
		 POPJ	P,]		;AND BLOW US OFF

;NOW WAIT FOR SOMEONE, SOMEWHERE, SOMETIME, . . .

FALJ30:	MOVX	M0,PSF%CW	;SAY WE'RE WAITING FOR A CONNECTION
	PUSHJ	P,DSCHD##	;GO AWAY FOR A WHILE
	TXNE	S,S.SHUT!S.KILL	;ARE WE SHUTTING DOWN?
	 JRST	[PUSHJ	P,NTNRL1##	;YES, BLOW OFF THIS CHANNEL
		  JFCL			;PUNT ERROR RETURNS HERE
		 SETZ	M0,		;FLAG NORMAL SHUTDOWN
		 POPJ	P,]		;RETURN
	PUSHJ	P,NTNCW1##	;GO RECEIVE THE CONNECT INITIATE DATA
	 POPJ	P,		;HMMM - A RECALCITRANT NOTWORK
	TXO	S,S.CONN	;SAY WE'RE CONNECTING
	MOVE	T1,.ION6M(IO)	;GET THE SIXBIT NODE NAME
	MOVEM	T1,J$SNOD(J)	;LET FALGLX KNOW ABOUT IT TOO
	SETZM	J$SBYT(J)	;SAY NO BYTES MOVED YET
;WE HAVE A CONNECT, SEE IF WE ARE WILLING TO CONSIDER IT

FALJ32:	MOVX	T1,%CNSTS	;GETTAB POINTER TO
	GETTAB	T1,		;READ THE SYSTEM "STATES" FLAGS
	 SETZ	T1,		;DUH?
	TXNE	T1,ST%NRT!ST%NLG;DEBUGGING/ETC?
	JRST	FALJR0		;YES, REJECT "ABORT BY DIALOG PROCESS"
	MOVX	T1,%NSKTM	;GETTAB POINTER TO
	GETTAB	T1,		;READ THE KSYS TIMER VALUE
	 SETZ	T1,		;DUH?
	JUMPL	T1,FALJR1	;REJECT "NODE SHUTTING DOWN"
	XMOVEI	P1,.IONUS(IO)	;POINT AT THE ORIGINAL USERNAME STRING
	XMOVEI	T1,J$SUSR(J)	;POINT AT THE DESTINATION
	PUSHJ	P,F8BAZ		;CONVERT TO ASCIZ NAME STRING
	 JFCL			;DON'T WORRY ABOUT AN ERROR HERE
	XMOVEI	P1,.IONUS(IO)	;ADDRESS OF USER ID STRING
	HLRZ	T1,@P1		;GET USER ID STRING LENGTH (IF ANY)
	LDB	T2,[POINT 8,.IONUS+1(IO),7]  ;*** PEEK AT FIRST BYTE
	CAIN	T2,0		;*** ANYTHING THERE?
	SETZ	T1,		;*** NO - VAX SENDS 4 NULLS!!!!!
	JUMPE	T1,[SKIPN T1,NETPPN	;FETCH DEFAULT USER NETPPN
		JRST	FALJR2		;NONE, REJECT USERID
		MOVEM	T1,.IOPPN(IO)	;SET DEFAULT "ON-BEHALF-OF" PPN
		DMOVE	T1,[EXP 'NETWOR', 'K USER']  ;FAKE UP A USER NAME
		DMOVEM	T1,.IOQ6N(IO)	;SET DEFAULT USER NAME TOO
		DMOVE	T1,[ASCII ~Network us~] ;THEN, COPY THE
		DMOVEM	T1,J$SUSR(J)	;ASCII VERSION OF THAT
		MOVE	T1,[ASCIZ ~er~]	;TO THE PER STREAM
		MOVEM	T1,J$SUSR+2(J)	;STORAGE
		SETZM	.IOACT(IO)	;WITH NO ACCOUNT STRING
		JRST	FALJ34]		;AND ALLOW THE NETWORK CONNECTION
	PUSHJ	P,F8BUP		;CONVERT 8-BIT USERID STRING INTO PPN
	 JRST	FALJR2		;CAN'T MAKE A PPN, JUNK USER ID
	MOVEM	T1,.IOPPN(IO)	;STORE "ON-BEHALF-OF" PPN
	TXNE	S,S.PROF	;[31] DO WE HAVE THE USER'S PROFILE?
	JRST	FALJ33		;[31] YES, DON'T GET IT THEN
	XMOVEI	T4,J$ABLK-1(J)	;[31] POINT AT THE ARGUMENT BLOCK STORAGE
	PUSH	T4,[QF.RSP!.QUMAE] ;[31] SAY WE WANT TO TALK TO ACTDAE
	PUSH	T4,[-1]		;[31] SET THE NODE TO CENTRAL
	XMOVEI	T2,J$ARSP(J)	;[31] POINT AT THE RESPONSE STORAGE
	HRLI	T2,ARSPLN	;[31] GET THE NUMBER OF WORDS WE CAN PLAY WITH HERE
	PUSH	T4,T2		;[31] PUT IN THE ARG BLOCK
	PUSH	T4,[QA.IMM!<1,,.QBAFN>] ;[31] GET THE SUBFUNCTION ARGUMENT TYPE
	PUSH	T4,[EXP UGOUP$]	;[31] SAY WE WANT THE USER PROFILE
	PUSH	T4,[QA.IMM!<1,,.UGPPN>] ;[31] SAY WE'RE SUPPLYING THE PPN
	PUSH	T4,T1		;[31] STORE THE USER'S PPN
	ANDI	T4,-1		;[31] GET RID OF JUNK IN THE LEFT HALF
	SUBI	T4,J$ABLK-1(J)	;[31] COMPUTE THE NUMBER OF WORDS WE FILLED IN
	XMOVEI	T2,J$ABLK(J)	;[31] POINT AT THE ARGUMENT BLOCK
	HRL	T2,T4		;[31] COPY THE BLOCK LENGTH
	QUEUE.	T2,		;[31] ASK FOR THE PPN FOR THIS GUY
	SETZM	.AEACC+J$ARSP(J) ;[31,33] NO PROFILE?  ASSUME NO FAL PRIVS
FALJ33:	SKIPE	T2,.AEACC+J$ARSP(J) ;[31,33] GET THE JOB'S PROFILE BITS
	TXO	S,S.PROF	;[31] YES, REMEMBER THAT WE DID
	TXNE	S,S.PROF	;[31] DID WE GET A PROFILE?
	PUSHJ	P,NAM826	;[31] YES, STORE IT IN .IOQ6N
	TXNN	S,S.NPPN	;[31] IS THIS THE NETWORK ACCESS PPN?
	TXNE	T2,AE.FAL	;[31] NO, DO WE HAVE FILE ACCESS PRIVS?
	SKIPA			;[32] YES, GO ON
	JRST	FALJR6		;[32] NO, REJECT THE USERID
FALJ34:	PUSHJ	P,FALCR1	;SEE IF NODE/PPN REJECTED BY COMMAND
	 JRST	FALJR5		;[32] YES, REJECT USERID
	XMOVEI	P1,.IONAC(IO)	;ADDRESS OF USER ACCOUNT STRING
	XMOVEI	T1,.IOACT(IO)	;WHERE TO STORE ASCIZ STRING
	PUSHJ	P,F8BAZ		;COPY AND ASCIZIZE STRING
	 JRST	FALJR4		;JUNK ACCOUNT STRING
	MOVSI	T1,J$SPSW(J)	;[42] CLEAR THE OLD
	HRRI	T1,J$SPSW+1(J)	;[42]  PASSWORD STRING
	SETZM	J$SPSW(J)	;[42]  ...
	BLT	T1,J$SPSW+PSWDWD-1(J) ;[42]
	XMOVEI	P1,.IONPW(IO)	;ADDRESS OF USER ID PASSWORD
	XMOVEI	T1,J$SPSW(J)	;POINT TO THE PASSWORD STRING STORAGE
	PUSHJ	P,F8BAZ8	;[34] CONVERT 8-BIT STRING INTO 6-BIT WORD
	 JRST	FALJR4		;JUNK PASSWORD STRING

;VERIFY THE USERID/PASSWORD/ACCOUNT

FALJ37:	DMOVE	P1,.IOQ6N(IO)	;[32] SAVE THE USERNAME 'CAUSE SWIL STOMPS IT
	MOVE	T2,.IOPPN(IO)	;RETRIEVE COPY OF ACCESSING PPN
	CAMN	T2,NETPPN	;IS THIS THE DEFAULT USER PPN?
	JRST	FALJ40		;YES, THEN IT WORKS.
	XMOVEI	T3,J$SPSW(J)	;POINT TO THE PASSWORD IN T3
	MOVEI	T2,.QUMAE	;ACCESS VALIDATION
	PUSHJ	P,QUEOP0##	;[32] ASK ACTDAE IF USER IS A GOOD GUY
	 SKIPA	T2,M0		;CAN'T VALIDATE USERID/ETC.
	JRST	FALJ40		;USERID/ETC OK, USER NAME/ETC SETUP
	JSP	T4,.CDISP##	;DISPATCH BASED ON ERROR
		FALJR2,,$EQILP	;ILLEGAL PPN/USERID
		FALJR2,,$EQIPW	;INVALID PASSWORD
		FALJR3,,$EQIVA	;INVALID ACCOUNT STRING
		0		;NO OTHERS RETURN AN ERROR

;HERE WHEN CAN'T VALIDATE USERID/ETC., REJECT UNLESS DEBUGGING

FALJ3A:	CAIN	M0,$EQCNR	;"COMPONET NOT RUNNING"? (I.E., NO ACTDAE)
	ERROR	ANR,<ACTDAE not running, can't validate USERID/etc.>,,,FALJR4
	CAIE	M0,$EQPRA	;LACKING PRIVILEGES TO DO ACCOUNTING?
	DEBUG	<QUEUE. UUO failed for FALJ40>,,,FALJR4
	MOVE	T1,.MYPPN##	;GET MY JOB'S PPN
	CAME	T1,.PPFFA##	;AM I [OPR]?
	SKIPN	.JBDDT		;NO, ALLOW IF DEBUGGING
	JRST	FALJR4		;CALL FUNNY USERID/ETC ERROR
	INFRM	UAR,<Can't validate USERID/PASSWORD/ACCOUNT, continuing for DDT>,,,FALJ40
;VALID USER ID, ACCEPT NETWORK CONNECTION

FALJ40:	DMOVEM	P1,.IOQ6N(IO)	;[32] RESTORE THE USERNAME WORDS
	MOVE	T1,.IOPPN(IO)	;GET OUR PPN
	CAME	T1,NETPPN	;IS IT THE NETWORK PPN?
	 TXZA	S,S.NPPN	;NO, CLEAR ANY INDICATION OF THAT
	TXO	S,S.NPPN	;YES, REMEMBER THAT FOR LATER
	SETZB	T2,T3		;NO OPTIONAL CONNECT CONFIRM DATA
	PUSHJ	P,NTNCA1##	;SEND A CONNECT ACCEPT MESSAGE
	 POPJ	P,		;BUTTS
	PUSHJ	P,BEGJOB##	;GO NOTIFY THE OPERATOR THAT WE'RE STARTING

;BUILD BUFFERS FOR FURTHER "REAL" COMMUNICATIONS

FALJ45:	PUSHJ	P,NTINI1##	;BUILD BUFFERS ETC.
	 POPJ	P,		;BUTTS

;EXCHANGE CONFIGURATION MESSAGES WITH THE REMOTE DAP PROCESS

FALJ50:	PUSHJ	P,DPICM1##	;EXCHANGE CONFIGURATION MESSAGES
	 ERROR	FCM,<Error exchanging CONFIG messages with node >,.TSIXN,J$SNOD(J)
	SETZM	J$FSLP(J)	;GOOD CONNECT, RESET WAIT INTERVAL
	TXZ	S,S.CONN	;SAY WE'RE NO LONGER WAITING TO CONNECT
	TXO	S,S.OPEN	;SAY WE HAVE A CONNECTION OPEN
	PJRST	FJOB00		;ENTER FAL JOB MAIN LOOP
;SEE IF INCOMING CONNECT REQUEST IS REJECTED BY OPERATOR COMMAND

FALCR1:	SKIPN	P1,REJFIR	;GOT A REJECTION LIST?
	JRST	.POPJ1##	;NO, INCOMING CONNECT OK BY US

;LOOP CHECKING AGAINST THE REJECTION LIST, SPEC BY SPEC

FALCR2:	SKIPN	T1,RJ.NOD(P1)	;[22] GET REJECTED NODE SPEC
	JRST	FALCR5		;NO NODE, JUST CHECK THE PPN
;	XOR	T1,.ION6M(IO)	;COMPARE AGAINST CONNECTING NODE
; 	TDNE	T1,RJ.NDM(P1)	;[22] DOES THIS NODE MATCH THE REJECTION?
	CAME	T1,.ION6M	;[22] DOES THIS NODE MATCH THE REJECTION?
	JRST	FALCR9		;NO, SKIP TO NEXT SPEC THEN
FALCR5:	MOVE	T2,RJ.PPN(P1)	;[22] GET REJECTED PPN SPEC
	XOR	T2,.IOPPN(IO)	;COMPARE AGAINST CONNECTING USERID
	TDNN	T2,RJ.PPM(P1)	;[22] DOES THIS PPN MATCH THE REJECTION?
	POPJ	P,		;YES, USERID REJECTED
FALCR9:	ADDI	P1,RJ.MAX	;[22] DOESN'T MATCH THIS REJECTION SPEC, ADVANCE
	CAMGE	P1,REJLAS	;ANY MORE SPECS TO CHECK?
	JRST	FALCR2		;YES
	JRST	.POPJ1##	;NO, INCOMING CONNECT NOT REJECTED HERE
;CONNECT REJECTS COME HERE

FALJR0:	REJECT	BDP,<Rejected because system being debugged>
	MOVEI	T3,^D09		;REJECT "BY DIALOGE PROCESS"
	JRST	FALRJ1		;COMMON CODE

FALJR1:	REJECT	NSD,<Local node shutting down>
	MOVEI	T3,^D03		;REJECT "NODE SHUTTING DOWN"
	JRST	FALRJ1		;COMMON CODE

FALJR2:	REJECT	IPP,<Invalid userid or password>
	MOVEI	T3,^D34		;REJECT "INVALID PPN/PASSWORD"
	JRST	FALRJ1		;COMMON CODE

FALJR3:	REJECT	IAC,<Invalid account string>
	MOVEI	T3,^D36		;REJECT "INVALID ACCOUNT STRING"
	JRST	FALRJ1		;COMMON CODE

FALJR4:	REJECT	FFE,<Image field format error>
	MOVEI	T3,^D43		;REJECT GENERAL IMAGE FIELD FORMAT ERROR
	JRST	FALRJ1		;COMMON CODE

FALJR5:	REJECT	UNJ,<Userid or node rejected by operator command>
	MOVEI	T3,^D34		;[32] REJECT "INVALID PPN/PASSWORD"
	JRST	FALRJ1		;[32] COMMON CODE

FALJR6:	REJECT	NUP,<User does not have network file access privileges>
	MOVEI	T3,^D34		;[32] REJECT "INVALID PPN/PASSWORD"
;	JRST	FALRJ1		;[32] COMMON CODE

;ALL CONNECT REJECTS COME THROUGH HERE

FALRJ1:	TXZ	S,S.CONN!S.OPEN	;NOT CONNECTING ANYMORE
	PUSHJ	P,INTDIS##	;DISCONNECT THIS CHANNEL FROM THE INTERRUPT SYSTEM
	 JFCL			;PUNT ERRORS HERE
	SETZ	T2,		;NO OPTIONAL DISCONNECT DATA
	PUSHJ	P,NTNCR1##	;REJECT THE CONNECT
	 JFCL			;DUH???
	MOVEI	M0,$EFUID	;DECLARE THIS TERMINATION "USERID"
	POPJ	P,		;END OF THIS ACCESS
;TOP-LEVEL OR MAIN FAL "JOB" PROCESS IDLE LOOP - WAIT FOR SOMETHING TO DO

FJOB00:	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSHJ	P,RDMSG1##	;START UP FIRST DAP MESSAGE
	 JRST	.POPJ1##	;ASSUME ALL DONE

;WE HAVE SOMETHING TO DO, INITIALIZE THE SLAVE CDB AND GO DO IT

	JUMPN	CO,FJOB03	;JUST RESET SLAVE IF ALREADY ALLOCATED
	MOVEI	T2,FALIV	;FAL'S INIT STUFF
	PUSHJ	P,.IOINA##	;ALLOCATE AND INITIALIZE SLAVE CDB
	 JRST	ERRCDO##	;DUH?
	MOVE	CO,T1		;REMEMBER SLAVE CDB ADDRESS
	JRST	FJOB07		;CLEAR OUT COMMUNICATIONS AREAS

;HERE WHEN ALREADY HAVE A SLAVE CDB, AS AFTER AN ACCESS COMPLETE, WITH
;MORE ACCESS MESSAGES COMING UP

FJOB03:	MOVE	IO,CO		;SELECT SLAVE CDB
	SKIPN	.IOCHN(IO)	;GOT AN I/O CHANNEL?
	SKIPE	.IONCH(IO)	;OR A NETWORK CHANNEL?
	CAIA			;YES???
	JRST	FJOB05		;NO
IFN FTDEBUG,INFRM ASS,<Aborting stale slave CDB I/O>
	PUSHJ	P,IOABO1##	;ABORT WHATEVER IS THERE
	 JFCL			;HOHUM
FJOB05:	MOVE	T1,CO		;ADDRESS OF SLAVE CDB
	MOVEI	T2,FALIV	;FAL'S INIT STUFF
	PUSHJ	P,.IOINI##	;[RE-]INITIALIZE SLAVE CDB
				; IN PARTICULAR, CLEAR OUT OLD .IOFSB
				; AND RESET .IOXFF
	 JRST	ERRCDO##	;DUH?

;SETUP THE CDB FOR SLAVE USAGE BY REST OF FAL

FJOB07:	MOVX	T2,IO.SLV	;THE "SLAVE" BIT
	IORM	T2,.IOCCF(CO)	;MARK THE SLAVE CDB (E.G., FOR QUEOP)

;SET "ON-BEHALF-OF" STUFF IN THE SLAVE CDB (WHERE IT REALLY COUNTS)

	MOVE	T1,.IOPPN(CI)	;"ON-BEHALF-OF" PPN
	MOVEM	T1,.IOPPN(CO)	;COPY IT INTO THE SLAVE CDB
	MOVSI	T1,.IOACT(CI)	;"ON-BEHALF-OF" ACCOUNT STRING
	HRRI	T1,.IOACT(CO)	;WHERE WE WANT IT
	BLT	T1,.IOACT+7(CO)	;LEAVE IT FOR FILOP ETC. TO FIND
	DMOVE	T1,.IOQ6N(CI)	;"ON-BEHALF-OF" USER NAME
	DMOVEM	T1,.IOQ6N(CO)	;LEAVE IT FOR QUEOP ETC.

;CLEAR OUT INTERNAL "JOB" DATA BASE

;CLEAR OUT DAP COMMUNICATIONS REGION FOR A FRESH START

	MOVE	IO,CI		;REFRESH CDB ADDRESS (JUST IN CASE)
	MOVEI	T2,$DHACS	;ACCESS MESSAGE
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP MESSAGE AREA
	 STOPCD			;CAN'T HAPPEN
	MOVEI	T2,$DHATR	;MAIN ATTRIBUTES MESSAGE
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP MESSAGE AREA
	 STOPCD			;CAN'T HAPPEN
	MOVEI	T2,$DHALC	;ALLOCATION ATTRIBUTES MESSAGE
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP MESSAGE AREA
	 STOPCD			;CAN'T HAPPEN
	MOVEI	T2,$DHTIM	;DATE/TIME ATTRIBUTES MESSAGE
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP MESSAGE AREA
	 STOPCD			;CAN'T HAPPEN
	MOVEI	T2,$DHPRT	;PROTECTION ATTRIBUTES MESSAGE
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP MESSAGE AREA
	 STOPCD			;CAN'T HAPPEN
	SKIPG	T2,.IODIM(IO)	;GET PENDING DAP MESSAGE CODE
	STOPCD	<No DAP message pending in FJOB07>
	JRST	FJOB12		;DISPATCH ON DAP MESSAGE TYPE

;START UP NEW DAP INPUT MESSAGE

FJOB10:	PUSHJ	P,RDMSG1##	;GET A DAP MESSAGE HEADER
	 PJRST	NETERI##	;[21] ERROR (MAYBE DISCONNECT)

;HERE WITH DAP MESSAGE CODE IN T2

FJOB12:	JSP	T4,.CDISP##	;DISPATCH ON RECEIVED MESSAGE TYPE
		FJOB40,,$DHCFG	;[47] CONFIGURATION
		FJOB17,,$DHSTS	;STATUS (HUH?)
		FJOB20,,$DHATR	;MAIN ATTRIBUTES
		FJOB20,,$DHALC	;ALLOCATION ATTRIBUTES
		FJOB20,,$DHTIM	;DATE/TIME ATTRIBUTES
		FJOB20,,$DHPRT	;PROTECTION ATTRIBUTES
		FJOB30,,$DHUSR	;USER ID
		FJOB50,,$DHACS	;FILE ACCESS
		FJOB90,,$DHACM	;ACCESS COMPLETE
		0		;END OF TABLE
	JSP	T4,FEROS	;DAP MESSAGE RECEIVED OUT OF SEQUENCE


;RECEIVED STATUS - SHOULDN'T USUALLY HAPPEN!

FJOB17:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] NET DIED
	CAIE	M0,$EGOIP	;"OPERATION IN PROGRESS"?
	CAIN	M0,$EGAOK	;"A-OK"?
	JRST	FJOB10		;YES, JUST EAT IT

;***

	PUSHJ	P,ERMSX1##	;TYPE OUT STATUS MESSAGE
	 JRST	FJOB10		;KEEP ON CRUSIN'
	JRST	FJOB10		;KEEP ON CRUSIN'


;RECEIVED SOME FLAVOR OF FILE ATTRIBUTES

FJOB20:	PUSHJ	P,RDDAP1##	;READ IN THE REST OF THE DAP MESSAGE
	 JSP	T4,FERDP	;DAP ERROR
	JRST	FJOB10		;LOOP BACK FOR MORE


;RECEIVED USERID MESSAGE

FJOB30:	PUSHJ	P,RDDAP1##	;READ IN USERID MESSAGE
	 JSP	T4,FERDP	;DAP ERROR
	JRST	FJOB10		;*** IGNORE IT FOR NOW


;[47] RECEIVED CONFIGURATION MESSAGE

FJOB40:	PUSHJ	P,RDMSR1##	;[47] SAVE THE CURRENT MESSAGE
	  JSP	T4,FERDP	;[47] DAP ERROR
	PUSHJ	P,DPICM1##	;[47] EXCHANGE CONFIGURATION MESSAGES
	  JSP	T4,FERDP	;[47] DAP ERROR
	JRST	FJOB10		;[47] LOOP BACK FOR MORE


;RECEIVED FILE ACCESS MESSAGE - TIME TO GO DO SOMETHING USEFUL!

FJOB50:	PUSHJ	P,RDDAP1##	;READ IN THE ACCESS REQUEST
	 JSP	T4,FERDP	;DAP ERROR

;ALL ACCESS MESSAGES HAVE FILESPEC, SO READ IN AND SET THE SLAVE CDB
;WITH THE FILE SPEC(S) BLOCK(S)

	PUSHJ	P,FALIF0	;PARSE THE ACCESS MESSAGE FILE SPEC
	 JRST	FJOB55		;DAP "FILE SPEC SYNTAX ERROR"
FJOB54:	SKIPN	T1,.IOXFF(CO)	;OUTPUT AREA
	ERROR	NSC,<No "extra" space in slace CDB in FJOB54>
	ADDI	T1,.FXMAX	;LENGTH OF FILE SPEC BLOCK
	CAML	T1,.IOXSZ(CO)	;ROOM FOR THIS FSB?
	ERROR	NRS,<No room is slave CDB for FSB in FJOB54>
	EXCH	T1,.IOXFF(CO)	;ALLOCATE ONE FSB FROM "EXTRA" SPACE
	ADD	T1,CO		;CALCULATE REAL MEMORY ADDRESS
	SKIPN	.IOFSB(CO)	;THIS THE FIRST FILE SPEC?
	MOVEM	T1,.IOFSB(CO)	;YES
	MOVEM	T1,.IOFSL(CO)	;IT IS ALSO THE LAST FILE SPEC
	SKIPN	.IOFSB(CI)	;DUPLICATE FSB POINTERS
	MOVEM	T1,.IOFSB(CI)	; IN PRIMARY CDB
	MOVEM	T1,.IOFSL(CI)	;  FOR EASE OF ACCESS
	MOVEI	T2,.FXMAX	;LENGTH OF FILE SPEC BLOCK
	PUSHJ	P,.GTSPC##	;COPY OVER THE FILE SPEC
	MOVE	T3,.IOPPN(IO)	;ACCESSING ("ON-BEHALF-OF") PPN
	SETO	T4,		;NON-WILD
	SKIPN	.FXDIR(T1)	;DID FILESPEC HAVE AN EXPLICIT DIRECTORY?
	DMOVEM	T3,.FXDIR(T1)	;NO, USE ACCESSOR AS DIRECTORY
	LDB	T2,[POINTR .FXMOD(T1),FX.TRM]  ;GET SPEC TERMINATION
	JUMPE	T2,FJOB59	;DISPATCH ON ACCESS REQUEST

;RECEIVED A FILE EXPRESSION (E.G., A 'OR' B), MORE FILE SPECS COMING

	PUSHJ	P,FALIF1	;READ IN NEXT FILE SPEC
	 POPJ	P,		;NICE TRY
	JRST	FJOB54		;ACCUMULATE FSB'S

FJOB55:	MOVEI	T1,40000+$DSSYN	;DAP "FILE SPEC SYNTAX ERROR"
	SETZ	T2,		;NO SECONDARY STATUS
	SETZB	T3,T4		;NOTHING
	PUSHJ	P,FXSTS1	;SEND DAP ERROR STATUS TO REMOTE
	 POPJ	P,		;NET DIED?
	JRST	FJOB00		;LOOP BACK TO IDLE STATE
FJOB59:	PUSHJ	P,FAJA01	;VERIFY AND SETUP ATTRIBUTES/ET AL
	 DEBUG	<FAJA failed in FJOB59>,,,FJOB10
	MOVX	T2,DIRCNT	;GET THE FILE FAIRNESS COUNT
	MOVEM	T2,J$DCNT(J)	;INITIALIZE IT
	MOVD1	T2,AFC		;ACCESS FUNCTION REQUESTED
	MOVEM	T2,J$SACC(J)	;STORE THE FILE ACCESS FUNCTION
	JSP	T4,.CDISP##	;DISPATCH ON FUNCTION
		FRED00,,$DVARD	;OPEN FILE (FOR READ)
		FWRT00,,$DVAWR	;OPEN FILE (FOR WRITE)
		FREN00,,$DVARN	;RENAME
		FDEL00,,$DVADL	;DELETE
		FDIR00,,$DVADR	;DIRECTORY LIST
		FSUB00,,$DVASB	;SUBMIT AS COMMAND FILE
		FEXE00,,$DVAEC	;EXECUTE COMMAND FILE
		0		;NO MORE
	BADDAP	(MA.UNS,ACS!20,<Unknown ACCESS message function in FJOB59>,FJOB10)
;HERE ON ACCESS COMPLETE

FJOB90:	MOVE	IO,CI		;RESET PRIMARY CDB ADDRESS
	PUSHJ	P,RDDAP1##	;READ IN ACCESS COMPLETE
	 PJRST	NETERI##	;[21] NET ERROR?
	MOVD	T1,A2F		;GET ACCOMP FUNCTION
	CAIE	T1,$DVACL	;ACCOMP(CLOSE)?
	BADDAP	(MA.SYN,,<Access complete not ACCOMP(CLOSE) in FJOB90>)
FJOB93:	MOVE	IO,CI		;RESET PRIMARY CDB ADDRESS
	PUSHJ	P,XDARS1##	;SEND ACCOMP(RESPONSE)
	 PJRST	NETERO##	;[21] NET ERROR?
FJOB95:
;***
;***	JRST	.POPJ1##	;SHUT DOWN LINK NOW (DCPNSP LEAVES US DANGLING)
;***

	JRST	FJOB00		;BACK TO PROCESS NEXT ACCESS COMMAND
	SUBTTL	File read access

FRED00:

;FILE-LEVEL STARTUP
;
;LOOP FINDING INPUT FILES

FRDF00:	MOVEI	T1,SCHEDL	;GET THE ADDRESS OF THE SCHEDULER
	MOVEM	T1,.IOSCH(CO)	;SET IN THE DISK CDB
	MOVX	T1,IM.AIO	;GET THE ASYNCHRONOUS I/O BIT
	IORM	T1,.IOIOM(CO)	;SAY WE WANT NON-BLOCKING I/O
	PUSHJ	P,FIFIL1	;FIND NEXT POSSIBLY-WILD INPUT FILE
	  POPJ	P,		;(0) NET DIED OR OTHER FATAL ERROR
	 JRST	FRDZ90		;(1) INPUT FILE STREAM EXHAUSTED
	MOVE	T1,.IOIOC(CO)	;(2) CONTINUE WITH RETURNED FILE
	MOVE	T2,.IOIOC(CI)	;PRIMARY CDB I/O CONTROL
	TXNN	T1,IC.RFM	;RESULTANT FILE RECORD-FORMATTED?
	TXZA	T1,IC.RSI	;NO
	TXOA	T1,IC.RSI	;YES
	TXZA	T2,IC.RSI	;NO
	TXO	T2,IC.RSI	;YES
	MOVEM	T1,.IOIOC(CO)	;SET SLAVE FILE I/O CONTROL
	MOVEM	T2,.IOIOC(CI)	;AND PRIMARY FLAGS TOO
	MOVE	T1,.IOCHN(CO)	;GET THE CHANNEL NUMBER
	PUSHJ	P,INDCON##	;SETUP INTERRUPTS ON THIS DEVICE
	 ERROR	IFR,<Could not enable PSI for disk input at FRDF00>
	MOVEI	T1,IOSHUT	;GET THE SHUTDOWN ROUTINE
	MOVEM	T1,.IOISS(CO)	;SET AS THE INPUT SHUTDOWN ROUTINE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FRDF20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB

;FIRST HANDLE ANY NAME MESSAGES NEEDED BY WILDCARDING

	PUSHJ	P,FANTY1	;SEND NAME MESSAGES
	 POPJ	P,		;CAN'T HAPPEN

;NOW HANDLE FILE ATTRIBUTES

FRDF22:	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FRDF22>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	FJUMPN	P1,ADS,FRDF25	;GO IF ANYTHING SET
	TFO	P1,DMA		;DEFAULT TO MAIN ATTRIBUTES
FRDF25:	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FRDF20>,,,.POPJ##

;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE

;GO UNLESS GO/NOGO REQUESTED
;
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED

FRDG00:	PUSHJ	P,XDACK1##	;SEND AN ACK AFTER ALL ATTR/ET AL
	 PJRST	NETERO##	;[21] NET DIED?
	PUSHJ	P,XDFLS1##	;NOW FLUSH OUT ALL MESSAGES TO THE REMOTE
	 PJRST	NETERO##	;[21] NET DIED?
	MOVD	T1,AOP		;GET ACCESS OPTIONS
	TFNN	T1,GNG		;DID REMOTE SPECIFY GO/NOGO?
	JRST	FRDI00		;NO, INITIALIZE FOR I/O

;WAIT FOR REMOTE TO MAKE UP ITS MIND

FRDG10:	PUSHJ	P,RDMSG1##	;GET REMOTE'S GO/NOGO DECISION
	 PJRST	NETERI##	;[21] NET MUST HAVE DIED
FRDG11:	JSP	T4,.CDISP##	;DISPATCH BASED ON REMOTE'S DECISION
		FRDG20,,$DHSTS	;STATUS - SHOULDN'T HAPPEN
		FRDG30,,$DHCNT	;CONTINUE - RESPONSE FOR GO/NOGO
		FRDI90,,$DHACM	;ACCESS COMPLETE
		0		;NONE OTHER
	BADDAP	(MA.SYN,,<Unknown GO/NOGO response from remote at FRDG10>)


;RECEIVED STATUS

FRDG20:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	BADDAP	(MA.SYN,,<STATUS received in FRDG20>)


;RECEIVED CONTINUE

FRDG30:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,C2F		;CONTINUE FUNCTION CODE
	CAIN	T1,$DVCSK	;SKIP THIS FILE?
	JRST	FRDZ20		;YES, ADVANCE TO THE NEXT FILE
	CAIN	T1,$DVCRS	;RESUME PROCESSING?
	JRST	FRDI00		;YES, INITIALIZE FOR I/O
	BADDAP	(MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FRDG30>)
;INITIALIZE FOR I/O
;
;LOOP ON CONTROL MESSAGES

FRDI00:	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSHJ	P,RDMSG1##	;START UP NEXT INPUT MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
FRDI01:	JSP	T4,.CDISP##	;DISPATCH ON MESSAGE CODE
		FRDI10,,$DHCTL	;CONTROL
		FRDI90,,$DHACM	;ACCOMP?
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Received message not CONTROL nor ACCOMP in FRDT40>)


;RECEIVED CONTROL MESSAGE

FRDI10:	PUSHJ	P,RDDAP1##	;READ IN THE CONTROL MESSAGE
	 POPJ	P,		;ERROR
	MOVD1	T2,CFC		;CONTROL FUNCTION CODE
FRDI11:	JSP	T4,.CDISP##	;DISPATCH ON CONTROL CODE
		FRDI20,,$DVCON	;CONTROL(CONNECT), INITIALIZE I/O STREAM
		FRDI30,,$DVCGT	;CONTROL(GET), READ RECORD/FILE
		0		;NO OTHERS SUPPORTED
	BADDAP	(MA.SYN,,<CONTROL neither (CONNECT) nor (GET) in FRDI10>)


;HERE FOR CONTROL(CONNECT)

FRDI20:	MOVX	T1,IO.DCC	;THE DAP CONTROL(CONNECT) FLAG
	TDNE	T1,.IOCCF(IO)	;FIRST ONE?
	BADDAP	(MA.SYN,,<Multiple CONTROL(CONNECT)s in FRDI20>)
	IORM	T1,.IOCCF(IO)	;YES, FLAG I/O NOW ACTIVE
	PUSHJ	P,XDACK1##	;SEND AN ACK FOR THE CONTROL(CONNECT)
	 PJRST	NETERO##	;[21] NET DIED?
	PUSHJ	P,XDFLS1##	;FORCE IT OUT NOW
	 PJRST	NETERO##	;[21] NET DIED?
	JRST	FRDI00		;BACK TO STATE DISPATCH


;HERE FOR CONTROL(GET)

FRDI30:	MOVE	T1,.IOCCF(IO)	;GET CHANNEL CONTROL FLAGS
	TXNN	T1,IO.DCC	;HAVE WE SEEN A CONTROL(CONNECT)?
	BADDAP	(MA.SYN,,<No CONTROL(CONNECT) before CONTROL(GET) in FRDI30>)
	MOVD1	T2,RAC		;RECORD ACCESS CONTROL
	CAIN	T2,$DVCSF	;SEQUENTIAL FILE ACCESS?
	JRST	FRDL00		;JUST START FILE TRANSFER LOOP
	BADDAP	(MA.UNS,CTL!22,<Not Sequential-File-Access for CONTROL(GET) in FRDI30>)
;HERE ON ACCOMP RATHER THAN CONTROL MESSAGE

FRDI90:	PUSHJ	P,RDCLR1##	;CLEAR OUT POSSIBLY-STALE FIELDS (LIKE AFO)
	 STOPCD			;CAN'T HAPPEN
	SETOM	.IDCKS(IO)	;'CUZ ACCOMP HAS NO MENU!!
	PUSHJ	P,RDDAP1##	;READ IN ACCOMP MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	SKIPL	T1,.IDCKS(IO)	;DID ACCOMP INCLUDE A CRC VALUE?
	CAMN	T1,.IODOK(IO)	;YES, DOES IT MATCH OUR CALCULATION?
	JRST	FRDI93		;NO CRC, OR CRC MATCHES, ALL IS WELL
	MOVD	T2,AOP		;GET ORIGINAL FILE ACCESS OPTIONS
	TFNN	T2,ACK		;DID USER REQUEST CHECKSUMMING?
	JRST	FRDI93		;NO, THEN NOT A REAL ERROR
	MOVX	T2,IO.DCC	;THE "OPEN FOR I/O" FLAG
	TDNN	T2,.IOCCF(IO)	;IS FILE OPENED FOR I/O?
;***	JUMPE	T1,FRDI93	;IGNORE IF 0 (ASSUME REALLY A "BLANK" CRC)
	JRST	FRDI93		;*** VAX HAS TAKEN TO SENDING A CRC OF 177777
				;*** FOR FILE FOR WHICH NO READ WAS PERFORMED
				;*** AS IN "SUBMIT/REMOTE 10::FILE.CTL"
	MOVEI	T1,50000+$DSCKE	;DAP FILE TRANSFER CHECKSUM (CRC) ERROR STATUS
	SETZ	T2,		;NO SECONDARY STATUS
	SETZB	T3,T4		;NOTHING ELSE EITHER
	PUSHJ	P,FXSTS1	;SEND A STATUS MESSAGE
	 POPJ	P,		;NET DIED?
	JRST	FRDI00		;BACK TO FILE-OPEN IDLE LOOP FOR ANOTHER ACCOMP

;FILE DATA IS OK (AS BEST AS WE CAN TELL), CLOSE OFF THE FILE

FRDI93:	MOVX	T2,IO.DCC	;THE "FILE IS OPEN FOR I/O" BIT
	ANDCAM	T2,.IOCCF(IO)	;NOTE NO MORE I/O
	PUSHJ	P,FACL01	;CHECK FOR ACCOMP-TIME CLOSE OPTIONS
	 JRST	[PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
		 POPJ	P,		;NET DIED?
		JRST	FRDI00]		;BACK TO FILE-OPEN IDLE LOOP
FRDI95:	MOVD1	T2,A2F		;ACCOMP FUNCTION
	JSP	T4,.CDISP##	;DISPATCH ON MESSAGE TYPE
		FRDI97,,$DVAES	;END OF STREAM (DON'T CLOSE THE FILE)
		FRDZ00,,$DVACL	;CLOSE FILE (MIGHT IMPLY SKIP)
		FRDZ20,,$DVASK	;CLOSE AND SKIP FILE
		FRDZ30,,$DVACB	;CLOSE AND RENAME CURRENT FILE
		FRDZ50,,$DVAKL	;KILL/RESET CURRENT FILE
		FRDZ80,,$DVATR	;TERMINATE/ABORT ACCESS REQUEST
		0		;NONE OTHERS LEGAL
	BADDAP	(MA.UNS,ACM!20,<Unknown or illegal ACCOMP function in FRDI90>)


;HERE ON ACCOMP(EOS) - JUST MARK THE FILE NOT I/O-ACTIVE

FRDI97:	PUSHJ	P,XDARS1##	;SEND THE ACCOMP(RESPONSE)
	 PJRST	NETERO##	;[21] NET DIED
	JRST	FRDI00		;BACK INTO OPEN-BUT-NOT-I/O-ACTIVE IDLE LOOP
;LOOP READING FILE IN SEQUENTIAL FILE TRANSFER MODE
;
;HERE TO READ THE JUST-FOUND FILE

FRDL00:	XMOVEI	T1,.IOOIN##	;NET-LEVEL I/O INIT ROUTINE
	MOVEM	T1,.IOOSR(CI)	;FORCE PRIMARY TO RE-INIT OUTPUT ROUTINES
	MOVEI	T1,177777	;DAP CRC POLYNOMIAL "SEED"
	MOVEM	T1,.IODOK(CI)	;IN CASE FIRST .IOISR FAILS, AND THEN CLOSES
				; INPUT WITH CRC - SINCE OTHERWISE THE CRC
				; WON'T GET INITIALIZED UNTIL .IOOSR CALLED
	MOVE	T1,.IOIOC(CI)	;GET PRIMARY CDB I/O CONTROL
	TXNN	T1,IC.RSI	;RECORD-STRUCTURED I/O?
	JRST	FRDL09		;[36] NO, BYTE I/O, GO START IT UP
	MOVE	T1,.IORSZ(CI)	;GET PRIMARY RECORD SIZE
	CAIG	T1,0		;GOT A RECORD SIZE?
	MOVEI	T1,1234		;NO, HALLUCINATE ONE THEN
	MOVEM	T1,J$RLEN(J)	;SAVE FOR ISR CALLS
	ADDI	T1,3		;*** 8-BIT BYTES
	LSH	T1,-2		;*** 8-BIT BYTES
	PUSHJ	P,.MMGWD##	;ALLOCATE A RECORD-BUFFER
	 POPJ	P,		;NO MEMORY
	DMOVEM	T1,J$RALC(J)	;SAVE THE PAIR
	HRLI	T2,(POINT 8,)	;CONCOCT A RECORD-BUFFER BYTE POINTER
	MOVEM	T2,J$RBUF(J)	;SAVE FOR ISR CALLS
	JRST	FRDL19		;[36] GO START RECORD I/O
;LOOP READING BYTES FROM THE SLAVE FILE, WRITING TO THE REMOTE

FRDL09:	MOVX	T1,CHARFC	;[36] GET THE FAIRNESS COUNT FOR CHARS
	MOVEM	T1,J$SFC(J)	;[36] AND INIT THE LOOP COUNTER
FRDL10:	MOVE	T1,CO		;INPUT (SLAVE) CDB
	PUSHJ	P,@.IOISR(T1)	;READ NEXT INPUT BYTE
	 JRST	FRDL18		;[40] CHECK FOR LSN OR REAL ERROR
FRDL15:	MOVE	T1,CI		;OUTPUT (PRIMARY) CDB
	PUSHJ	P,@.IOOSR(T1)	;WRITE CURRENT BYTE TO THE REMOTE
	 JRST	FRDL60		;MAYBE ACCOMP
	AOS	J$SBYT(J)	;COUNT THIS BYTE
	SOSLE	J$SFC(J)	;[36] EXHAUSTED OUR QUANTUM YET?
	JRST	FRDL10		;[36] NO, GO COPY ANOTHER BYTE
	PUSHJ	P,SCHEDZ	;[36] YES, GIVE SOMEONE ELSE A CHANCE
	 POPJ	P,		;[36] MUST HAVE BEEN ABORTED
	JRST	FRDL09		;[36] CONTINUE WITH THE COPY


;CHECK OUT INPUT EXCEPTION RETURN

FRDL18:	CAIE	M0,$EILSN	;[40] READ A LINE SEQUENCE NUMBER?
	JRST	FRDL30		;[40] MAYBE EOF, TELL REMOTE IN ANY CASE
	MOVE	T3,T2		;[40] POSITION LSN
	MOVEI	T2,.FULSN	;[40] FUNCTION: WRITE LSN
	MOVE	T1,CI		;[40] SELECT PRIMARY CDB
	PUSHJ	P,.IOFUN##	;[40] WRITE LSN
	 JRST	FRDL60		;[40] CHECK OUT ERROR
	JRST	FRDL10		;[40] NOW GO BACK AND TRY FOR REAL DATA


;LOOP READING RECORDS FROM THE SLAVE FILE, WRITING TO THE REMOTE

FRDL19:	MOVX	T1,RECFC	;[36] GET THE FAIRNESS COUNT FOR RECORDS
	MOVEM	T1,J$SFC(J)	;[36] AND INIT THE LOOP COUNTER
FRDL20:	MOVE	T1,CO		;INPUT (SLAVE) CDB
	SETO	T2,		;NO PARTICULAR RECORD ADDRESS
	DMOVE	T3,J$RLEN(J)	;RECORD BUFFER COUNTER AND POINTER
	PUSHJ	P,@.IOISR(T1)	;READ NEXT INPUT RECORD
	 JRST	FRDL30		;MAYBE EOF, TELL REMOTE IN ANY CASE
FRDL25:	MOVE	P3,T3		;COPY THE RECORD LENGTH
	MOVE	T1,CI		;OUTPUT (PRIMARY) CDB
	PUSHJ	P,@.IOOSR(T1)	;WRITE CURRENT RECORD TO THE REMOTE
	 JRST	FRDL60		;MAYBE ACCOMP
	ADDM	P3,J$SBYT(J)	;COUNT THE NUMBER OF BYTES MOVED
	SOSLE	J$SFC(J)	;[36] EXHAUSTED OUR QUANTUM YET?
	JRST	FRDL20		;[36] NO, GO COPY ANOTHER RECORD
	PUSHJ	P,SCHEDZ	;[36] YES, GIVE SOMEONE ELSE A CHANCE
	 POPJ	P,		;[36] MUST HAVE BEEN ABORTED
	JRST	FRDL19		;[36] CONTINUE WITH THE COPY
;HERE ON EXCEPTION RETURN FROM INPUT BYTE

FRDL30:	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSH	P,M0		;HANG ONTO ERROR/EXCEPTION CODE
	PUSHJ	P,@.IOOSS(IO)	;CALL NETWORK OUTPUT SHUTDOWN ROUTINE
	 JFCL			;HO HUM
	POP	P,M0		;RETRIEVE ERROR/EXCEPTION CODE
	CAIE	M0,$EIEOF	;EOF ON INPUT (SLAVE) FILE?
	JRST	FRDL33		;NO, I/O EXCEPTION/ERROR
FRDL31:	MOVEI	T1,50000+$DSEOF	;DAP I/O-LEVEL EOF STATUS
	SETZ	T2,		;NO SECONDARY STATUS
	SETZB	T3,T4		;NOR ANYTHING ELSE
	PUSHJ	P,FXSTS1	;SEND DAP STATUS TO REMOTE
	 POPJ	P,		;NET DIED
	JRST	FRDI00		;WAIT FOR ACCOMP

;ERROR READING INPUT (SLAVE) FILE

FRDL33:	MOVE	T2,M0		;POSITION ERROR CODE
	MOVEI	T4,DS2EI##	;DAP STATUS TO I/O STATUS TRANSLATION TABLE
	PUSHJ	P,FFIND1	;CONVERT TO DAP I/O STATUS CODE
	 SKIPA	T1,$DSRER	;GENERIC READ ERROR, $E???? AS SECONDARY STATUS
	SETZ	T2,		;KNOWN ERROR, NO SECONDARY STATUS
	ADDI	T1,50000	;DAP I/O LEVEL ERROR STATUS
	SETZB	T3,T4		;NOTHING ELSE EITHER
	PUSHJ	P,FXSTS1	;SEND DAP STATUS
	 POPJ	P,		;NET DIED

;ERROR-STATE IDLE LOOP - WAIT FOR CONTINUE OR ABORT

FRDL40:	PUSHJ	P,RDMSG1##	;START NEW INPUT MESSAGE FROM REMOTE
	 PJRST	NETERI##	;[21] NET DIED
FRDL41:	JSP	T4,.CDISP##	;DISPATCH ON MESSAGE TYPE
		FRDL50,,$DHCNT	;CONTINUE
		FRDI90,,$DHACM	;ACCOMP
		0		;THAT'S IT
	BADDAP	(MA.SYN,,<Unknown/illegal DAP message in FRDL40>)

;HERE ON "CONTINUE" AFTER INPUT ERROR

FRDL50:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	MOVD1	T2,C2F		;GET CONTINUE "FUNCTION" TYPE
	JUMPE	T2,FRDL54	;IF NULL, ASSUME IGNORE ERROR
	JSP	T4,.CDISP##	;DISPATCH ON CONTINUE TYPE
		FRDL53,,$DVCTA	;TRY AGAIN
		FRDL54,,$DVCSK	;SKIP AND IGNORE ERROR
		0		;THAT'S ALL
	BADDAP	(MA.INV,CNT!20,<Unknown/illegal CONTINUE function in FRDL50>)

FRDL53:	TDZA	T2,T2		;TRY AGAIN
FRDL54:	MOVEI	T2,1		;IGNORE AND RESUME
	STOPCD	<Error-continuation not yet written in FRDL54>


;"EXCEPTION" WRITING OUTPUT FILE

FRDL60:	MOVE	IO,CI		;SELECT PRIMARY CDB
	CAIE	M0,$EINMP	;INPUT MESSAGE PENDING?
	JRST	FRDL63		;NO, NET ERROR?
	PUSHJ	P,RDMSG1##	;START UP DAP MESSAGE
	 PJRST	NETERI##	;[21] HMMMM
	CAIE	T2,$DHACM	;ACCESS COMPLETE?
	BADDAP	(MA.SYN,,<Received DAP message not ACCOMP in FRDL60>)
	JRST	FRDI90		;GO PROCESS ACCOMP

FRDL63:	POPJ	P,		;NET DIED? JUST ABORT THE JOB
;END OF FILE ACCESS

FRDZ00:	MOVE	T1,.IOCCF(CI)	;GET PRIMARY CHANNEL CONTROL FLAGS
	MOVE	T2,.IOIOM(CO)	;GET SLAVE I/O MODE CONTROL
	TXNN	T1,IO.DCC	;WAS A CONTROL(CONNECT) SEEN?
	TXNE	T2,IM.CXX	;NO, ANY CLOSE-TIME OPTIONS?
	JRST	FRDZ10		;NORMAL FILE CLOSE PROCESSING
	JRST	FRDZ20		;"SKIP" FILE CLOSE PROCESSING

;NORMAL CLOSE FILE

FRDZ10:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOCLO1##	;CLOSE THE INPUT FILE
	 SKIPA	T2,M0		;BUTTS - SOMETHING FAILED IN THE CLOSE
	JRST	FRDZ60		;END OF THIS FILE, BACK FOR THE NEXT ONE
FRDZ17:	MOVEI	T4,DS2EF##	;DAP STATUS TO FILE STATUS TABLE ADDRESS
	PUSHJ	P,FFIND1	;SEE IF KNOWN ERROR
	 SKIPA	T1,[$DSCCF]	;CANNOT CLOSE FILE, $E???? AS SECONDARY STATUS
	SETZ	T2,		;KNOWN ERROR, NO SECONDARY STATUS
	ADDI	T1,70000	;"CLOSE-TIME" ERROR
	SETZB	T3,T4		;NOTHING ELSE EITHER
	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSHJ	P,FXSTS1	;SEND ERROR STATUS TO REMOTE
	 POPJ	P,		;NET DIED
	JRST	FRDI00		;BACK TO FILE-IS-OPEN IDLE LOOP


;SKIP CURRENT FILE

FRDZ20:	MOVE	IO,CO		;SELECT SLAVE CDB
	MOVX	P1,IM.SAD	;THE SUPPRESS-ACCESS-DATE FLAG
	AND	P1,.IOIOM(IO)	;MAKE A COPY OF THE CURRENT SETTING
	MOVX	T1,IM.SAD	;THE BIT AGAIN
	IORM	T1,.IOIOM(IO)	;SUPPRESS THE ACCESS DATE
	PUSHJ	P,IOCLO0##	;CLOSE CURRENT INPUT FILE
	 TDZA	T1,T1		;OOPS
	SETO	T1,		;GOOD
	MOVX	T2,IM.SAD	;THE BIT YET AGAIN
	TDNN	T2,P1		;WAS IT SET BEFORE?
	ANDCAM	T2,.IOIOM(IO)	;NO, CLEAR IT OUT NOW
	JUMPL	T1,FRDZ60	;NOW ADVANCE TO NEXT FILE
	JRST	FRDZ17		;OOPS, ERROR, INFORM REMOTE
;RENAME CURRENT FILE

FRDZ30:	PUSHJ	P,FRDCB1	;READ IN NEW ATTRIBUTES/NAME MESSAGES
	 JRST	[CAIE	M0,$ECAUR	;ABORTED AT [REMOTE] USER'S REQUEST?
		POPJ	P,		;NO, LINK BLOWN AWAY
		CAIE	T2,$DVATR	;ACCOMP(TERMINATE)?
		BADDAP	(MA.SYN,,<Unknown/illegal ACCOMP message in FWRZ30>)
		PJRST	FRDZ80]		;YES, SEND ACCOMP(RESPONSE), GO IDLE
	SKIPN	.IOFS3(CO)	;*** DID WE RECEIVE A FILE SPEC?
	JRST	FRDZ10		;*** NO, JUST CLOSE THE FILE NORMALLY
	PUSHJ	P,FRDCE1	;DO THE REQUESTED RENAME OPERATION
	 JRST	FRDZ17		;OOPS - RENAME FAILED, INFORM THE REMOTE
	JRST	FRDZ60		;FILE CLOSED (BY IOFRN), SEE WHAT NEXT


;KILL/RESET CURRENT FILE

FRDZ50:	MOVE	IO,CO		;POINT TO SLAVE CDB
	PUSHJ	P,IOABO1##	;ABORT CURRENT FILE
	 DEBUG	<IOABO failed in FRDZ50>,,,.POPJ##
;	JRST	FRDZ60		;ADVANCE TO THE NEXT FILE (IF ANY)


;COMMON FILE-CLOSE, TRY FOR NEXT INPUT FILE

FRDZ60:	SKIPN	T1,J$RALC(J)	;GOT ANY RECORD-BUFFER LEFT OVER?
	JRST	FRDZ62		;NOPE
	MOVE	T2,J$RALC+1(J)	;YUP
	PUSHJ	P,.MMFWD##	;FREE UP RECORD BUFFER
	 JFCL			;HO HUM
	SETZM	J$RALC(J)	;NO LONGER HAVE A RECORD BUFFER
FRDZ62:	SKIPN	.WLDFL##	;*** WILDCARDED FILE ACCESS?
	JRST	FRDZ90		;*** NO, ACCESS IS COMPLETE
	JRST	FRDF00		;TRY FOR ANOTHER FILE


;TERMINATE ACCESS

FRDZ80:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOABO1##	;ABORT THE CURRENT READ
	 JFCL			;HO HUM

;ACCESS IS COMPLETED

FRDZ90:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
	SUBTTL	File read access -- Subroutines - RENAME option

;FRDCB - read in new name/attributes on ACCOMP(RENAME)

FRDCB1:	PUSHJ	P,FRENA1	;READ IN NEW ATTRIBUTES AND NAME
	 JRST	[CAIN	M0,$ECAUR	;RECEIVED AN ACCOMP BEFORE NAME MSG?
		CAIN	T2,$DVATR	;ACCOMP(TERMINATE)?
		POPJ	P,		;LET CALLER DEAL WITH IT
		CAIE	T2,$DVACE	;MUST BE ACCOMP(CHANGE-END)
		BADDAP	(MA.SYN,,<ACCOMP not CHANGE-END in FRDCB1>)
					;NO NAME MESSAGE, NO FILE SPEC, NOTHING
					;FOR SCWILD TO PLAY WITH. FOR THE TIME
					;BEING, JUST IGNORE THE ACCOMP(RENAME)
					;AND CLOSE THE FILE NORMALLY (YEAH, IF
					;ONLY A PROTECTION WAS SENT, IT IS LOST)
		JRST	.POPJ1##]	;QUIT FOR NOW
	MOVE	T1,.IOFS3(CO)	;ADDRESS OF "OUTPUT" FILE SPEC BLOCK
	DMOVE	T2,.FXCTL(T1)	;GET FSB CONTROL FLAGS
	TXOE	T3,FX.SCE	;SOMEONE SLIP IN /SCERROR CONTROL?
	JRST	FRDCB3		;YES, BIZARRE, ALLOW IT THEN
	MOVEI	T4,SCENEV##	;GET /SCERROR:NEVER VALUE %%%
	DPB	T4,[POINTR T2,FX.SCE]  ;AND SET IN CONTROL WORD
				; TO ALLOW WILDCARD READ, BUT SPECIFIC
				; FILENAME RENAME OPERATION (WHICH IS
				; THE USUAL CASE FOR ACCOMP(RENAME)...)
	DMOVEM	T2,.FXCTL(T1)	;SET VALUES IN FILE SPEC BLOCK
FRDCB3:	PUSHJ	P,RDMSG1##	;MUST NOW HAVE ACCOMP(CHANGE-END)
	 PJRST	NETERI##	;[21] NET DIED?
	CAIE	T2,$DHACM	;LOOKING AT AN ACCOMP?
	BADDAP	(MA.SYN,,<Not ACCOMP after ACCOMP(CHANGE-BEGIN) in FRDCB1>)
	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP AREA
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;PARSE THE ACCOMP
	 POPJ	P,		;BAD NEWS
	MOVD1	T2,A2F		;GET THE ACCOMP FUNCTION
	CAIN	T2,$DVATR	;ACCOMP(TERMINATE)?
	JRST	[MOVEI	M0,$ECAUR	;YES, FLAG ABORT AT USER'S REQUEST
		POPJ	P,]		;AND BREAK OFF THE OPERATION
	CAIE	T2,$DVACE	;MUST BE "CHANGE-END"
	BADDAP	(MA.SYN,,<ACCOMP not ACCOMP(CHANGE-END) in FRDCB1>)
	JRST	.POPJ1##	;READY FOR THE RENAME!


;FRDCE - Do the actual RENAME operation as setup by FRDCB

FRDCE1:	MOVE	IO,CO		;POINT TO SLAVE CDB
	PUSHJ	P,IOFRN1##	;DO THE REQUESTED RENAME OPERATION
	 TDZA	P1,P1		;ERROR
	SETO	P1,		;SUCCESS
	MOVNI	T1,.FXMAX	;LENGTH OF FSB
	ADDM	T1,.IOXFF(CO)	;DEALLOCATE THE "ANCILLIARY" FSB FROM FRENA1
	SETZM	.IOFS3(CO)	;REMOVE POINTER TO DEALLOCATED FSB
	SETZM	.IOCU3(CO)	; AND THE OTHER ONE TOO
	JUMPL	P1,.POPJ1##	;TRY FOR A SUCCESS RETURN
	POPJ	P,		;NOPE, TAKE ERROR RETURN
	SUBTTL	File write access

FWRT00:

;FILE-LEVEL STARTUP
;
;CREATE THE OUTPUT FILE

FWRF00:	MOVEI	T1,SCHEDL	;GET THE ADDRESS OF THE SCHEDULER
	MOVEM	T1,.IOSCH(CO)	;SET IN THE DISK CDB
	MOVX	T1,IM.AIO	;GET THE ASYNCHRONOUS I/O BIT
	IORM	T1,.IOIOM(CO)	;SAY WE WANT NON-BLOCKING I/O
	MOVE	IO,CO		;ADDRESS OF SLAVE CDB
	PUSHJ	P,FOFIL1	;GO CREATE THE SLAVE OUTPUT FILE
	  POPJ	P,		;(0) NET DIED
	 JRST	FWRZ50		;(1) ERROR, ABORT FILE, SEND ACCOMP(RESPONSE)
	MOVE	T1,.IOIOC(CO)	;(2) CONTINUE WITH NEWLY-CREATED FILE
	MOVE	T2,.IOIOC(CI)	;PRIMARY CDB I/O CONTROL
	TXNN	T1,IC.RFM	;RESULTANT FILE RECORD-FORMATTED?
	TXZA	T1,IC.RSI	;NO
	TXOA	T1,IC.RSI	;YES
	TXZA	T2,IC.RSI	;NO
	TXO	T2,IC.RSI	;YES
	MOVEM	T1,.IOIOC(CO)	;SET SLAVE FILE I/O CONTROL
	MOVEM	T2,.IOIOC(CI)	;AND PRIMARY FLAGS TOO
	MOVE	T1,.IOCHN(CO)	;GET THE DISK FILE CHANNEL NUMBER
	PUSHJ	P,INDCON##	;ENABLE INTERRUPTS ON THIS GUY
	 ERROR	IFW,<Failed to enable PSI for disk output at FWRF00>
	MOVEI	T1,IOSHUT	;GET OUR SHUTDOWN ROUTINE
	MOVEM	T1,.IOOSS(CO)	;SET AS THE OUTPUT SHUTDOWN ROUTINE
	MOVE	T1,.IOCCF(CO)	;SLAVE CHANNEL CONTROL FLAGS
	MOVE	T2,.IODCH(CO)	;GET FILE CHARACTERISTICS
	TXNN	T1,IO.NET	;IS THIS A NETWORKED (NON-LOCAL) FILE?
	TXNN	T2,IC.SPL	;THAT IS SPOOLED?
	JRST	FWRF20		;NOT A LOCAL SPOOLED FILE, NO NONSENSE
	PUSHJ	P,NONPP1	;DISALLOW NETPPN FROM USING THE LPT/ETC.
	 JRST	[PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
		 POPJ	P,		;NET DIED?
		JRST	FJOB95]		;BACK TO IDLE STATE
	PUSHJ	P,FWSP01	;GO WAVE OUR HANDS IN A FRENZIED FASHION
	 JRST	FWRZ50		;SO MUCH FOR THAT, BACK TO IDLE STATE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FWRF20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB
FWRF22:	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FWRF20>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	FJUMPN	P1,ADS,FWRF25	;GO IF ANYTHING SET
	TFO	P1,DMA		;DEFAULT TO MAIN ATTRIBUTES
FWRF25:	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FWRF20>,,,.POPJ##

;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE

;GO UNLESS GO/NOGO REQUESTED
;
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED

FWRG00:	PUSHJ	P,XDACK1##	;SEND AN ACK AFTER ALL ATTR/ET AL
	 PJRST	NETERO##	;[21] NET DIED?
	PUSHJ	P,XDFLS1##	;NOW FLUSH OUT ALL MESSAGES TO THE REMOTE
	 PJRST	NETERO##	;[21] NET DIED?
	MOVD	T1,AOP		;GET ACCESS OPTIONS
	TFNN	T1,GNG		;DID REMOTE SPECIFY GO/NOGO?
	JRST	FWRI00		;NO, INITIALIZE FOR I/O

;WAIT FOR REMOTE TO MAKE UP ITS MIND

FWRG10:	PUSHJ	P,RDMSG1##	;GET REMOTE'S GO/NOGO DECISION
	 PJRST	NETERI##	;[21] NET MUST HAVE DIED
FWRG11:	JSP	T4,.CDISP##	;DISPATCH BASED ON REMOTE'S DECISION
		FWRG20,,$DHSTS	;STATUS - SHOULDN'T HAPPEN
		FWRG30,,$DHCNT	;CONTINUE - RESPONSE FOR GO/NOGO
		FWRI90,,$DHACM	;ACCESS COMPLETE
		0		;NONE OTHER
	BADDAP	(MA.SYN,,<Unknown GO/NOGO response from remote at FWRG10>)


;RECEIVED STATUS

FWRG20:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	BADDAP	(MA.SYN,,<STATUS received in FWRG20>)


;RECEIVED CONTINUE

FWRG30:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,C2F		;CONTINUE FUNCTION CODE
	CAIN	T1,$DVCSK	;SKIP THIS FILE?
	JRST	FWRZ50		;YES, ABORT THE CREATE (IF POSSIBLE)
	CAIN	T1,$DVCRS	;RESUME PROCESSING?
	JRST	FWRI00		;YES, INITIALIZE FOR I/O
	BADDAP	(MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FWRG30>)
;INITIALIZE FOR I/O
;
;LOOP ON CONTROL MESSAGES

FWRI00:	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSHJ	P,RDMSG1##	;START UP NEXT INPUT MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
FWRI01:	JSP	T4,.CDISP##	;DISPATCH ON MESSAGE CODE
		FWRI10,,$DHCTL	;CONTROL
		FWRI90,,$DHACM	;ACCOMP?
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Received message not CONTROL nor ACCOMP in FWRT40>)


;RECEIVED CONTROL MESSAGE

FWRI10:	PUSHJ	P,RDDAP1##	;READ IN THE CONTROL MESSAGE
	 POPJ	P,		;ERROR
	MOVD1	T2,CFC		;CONTROL FUNCTION CODE
FWRI11:	JSP	T4,.CDISP##	;DISPATCH ON CONTROL CODE
		FWRI20,,$DVCON	;CONTROL(CONNECT), INITIALIZE I/O STREAM
		FWRI30,,$DVCPT	;CONTROL(PUT), WRITE RECORD/FILE
		0		;NO OTHERS SUPPORTED
	BADDAP	(MA.SYN,,<CONTROL neither (CONNECT) nor (PUT) in FWRI10>)


;HERE FOR CONTROL(CONNECT)

FWRI20:	MOVX	T1,IO.DCC	;THE DAP CONTROL(CONNECT) FLAG
	TDNE	T1,.IOCCF(IO)	;FIRST ONE?
	BADDAP	(MA.SYN,,<Multiple CONTROL(CONNECT)s in FWRI20>)
	IORM	T1,.IOCCF(IO)	;YES, FLAG I/O NOW ACTIVE
	PUSHJ	P,XDACK1##	;SEND AN ACK FOR THE CONTROL(CONNECT)
	 PJRST	NETERO##	;[21] NET DIED?
	PUSHJ	P,XDFLS1##	;FORCE IT OUT NOW
	 PJRST	NETERO##	;[21] NET DIED?
	JRST	FWRI00		;BACK TO STATE DISPATCH


;HERE FOR CONTROL(PUT)

FWRI30:	MOVE	T1,.IOCCF(IO)	;GET CHANNEL CONTROL FLAGS
	TXNN	T1,IO.DCC	;HAVE WE SEEN A CONTROL(CONNECT)?
	BADDAP	(MA.SYN,,<No CONTROL(CONNECT) before CONTROL(PUT) in FWRI30>)
	MOVD1	T2,RAC		;RECORD ACCESS CONTROL
	CAIN	T2,$DVCSF	;SEQUENTIAL FILE ACCESS?
	JRST	FWRL00		;JUST START FILE TRANSFER LOOP
	BADDAP	(MA.UNS,CTL!22,<Not Sequential-File-Access for CONTROL(PUT) in FWRI30>)
;HERE ON ACCOMP RATHER THAN CONTROL MESSAGE

FWRI90:	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP REGION
	 STOPCD			;CAN'T HAPPEN
	SETOM	.IDCKS(IO)	;'CUZ ACCOMP HAS NO MENU!!
	PUSHJ	P,RDDAP1##	;READ IN ACCOMP MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	SKIPL	T1,.IDCKS(IO)	;DID ACCOMP INCLUDE A CRC VALUE?
	CAMN	T1,.IODIK(IO)	;YES, DOES IT MATCH OUR CALCULATION?
	JRST	FWRI93		;NO CRC, OR CRC MATCHES, ALL IS WELL
	MOVD	T2,AOP		;GET ORIGINAL FILE ACCESS OPTIONS
	TFNN	T2,ACK		;DID USER REQUEST CHECKSUMMING?
	JRST	FWRI93		;NO, THEN NOT A REAL ERROR
	MOVX	T2,IO.DCC	;THE "OPEN FOR I/O" FLAG
	TDNN	T2,.IOCCF(IO)	;IS FILE OPENED FOR I/O?
	JUMPE	T1,FWRI93	;IGNORE IF 0 (ASSUME REALLY A "BLANK" CRC)
	MOVEI	T1,50000+$DSCKE	;DAP FILE TRANSFER CHECKSUM (CRC) ERROR STATUS
	SETZ	T2,		;NO SECONDARY STATUS
	SETZB	T3,T4		;NOTHING ELSE EITHER
	PUSHJ	P,FXSTS1	;SEND A STATUS MESSAGE
	 POPJ	P,		;NET DIED?
	JRST	FWRI00		;BACK TO FILE-OPEN IDLE LOOP FOR ANOTHER ACCOMP

;FILE DATA IS OK (AS BEST AS WE CAN TELL), CLOSE OFF THE FILE

FWRI93:	MOVX	T2,IO.DCC	;THE "FILE IS OPEN FOR I/O" BIT
	ANDCAM	T2,.IOCCF(IO)	;NOTE NO MORE I/O
	PUSHJ	P,FACL01	;CHECK FOR ACCOMP-TIME CLOSE OPTIONS
	 JRST	[PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
		 POPJ	P,		;NET DIED?
		JRST	FWRI00]		;BACK TO FILE-OPEN IDLE LOOP
FWRI95:	MOVD1	T2,A2F		;ACCOMP FUNCTION
	JSP	T4,.CDISP##	;DISPATCH ON MESSAGE TYPE
		FWRI97,,$DVAES	;END OF STREAM (DON'T CLOSE THE FILE)
		FWRZ00,,$DVACL	;CLOSE FILE
		FWRZ30,,$DVACB	;CLOSE AND RENAME CURRENT FILE
		FWRZ50,,$DVAKL	;KILL/RESET CURRENT FILE
		FWRZ50,,$DVATR	;TERMINATE/ABORT CURRENT ACCESS
		0		;NONE OTHERS LEGAL
	BADDAP	(MA.UNS,ACM!20,<Unknown or illegal ACCOMP function in FWRI90>)


;HERE ON ACCOMP(EOS) - JUST MARK THE FILE NOT I/O-ACTIVE

FWRI97:	PUSHJ	P,XDARS1##	;SEND THE ACCOMP(RESPONSE)
	 PJRST	NETERO##	;[21] NET DIED
	JRST	FWRI00		;BACK INTO OPEN-BUT-NOT-I/O-ACTIVE IDLE LOOP
;LOOP WRITING FILE IN SEQUENTIAL FILE TRANSFER MODE
;
;HERE TO WRITE THE NEWLY-CREATED FILE

FWRL00:	XMOVEI	T1,.IOIIN##	;INPUT INITIALIZATION ADDRESS
	MOVEM	T1,.IOISR(CI)	;FORCE INPUT INITIALIZATION
	MOVE	T1,.IOIOC(CI)	;GET PRIMARY CDB I/O CONTROL
	TXNN	T1,IC.RSI	;RECORD-STRUCTURED I/O?
	JRST	FWRL09		;[36] NO, BYTE I/O, GO START IT UP
	MOVE	T1,.IORSZ(CI)	;GET PRIMARY RECORD SIZE
	CAIG	T1,0		;GOT A RECORD SIZE?
	MOVEI	T1,1234		;NO, HALLUCINATE ONE THEN
	MOVEM	T1,J$RLEN(J)	;SAVE FOR ISR CALLS
	ADDI	T1,3		;*** 8-BIT BYTES
	LSH	T1,-2		;*** 8-BIT BYTES
	PUSHJ	P,.MMGWD##	;ALLOCATE A RECORD-BUFFER
	 POPJ	P,		;NO MEMORY
	DMOVEM	T1,J$RALC(J)	;SAVE THE PAIR
	HRLI	T2,(POINT 8,)	;CONCOCT A RECORD-BUFFER BYTE POINTER
	MOVEM	T2,J$RBUF(J)	;SAVE FOR ISR CALLS
	JRST	FWRL19		;[36] START UP RECORD I/O
;LOOP READING BYTES FROM THE REMOTE, WRITING TO THE SLAVE FILE

FWRL09:	MOVX	T1,CHARFC	;[36] GET THE FAIRNESS COUNT FOR CHARS
	MOVEM	T1,J$SFC(J)	;[36] AND INIT THE LOOP COUNTER
FWRL10:	MOVE	T1,CI		;INPUT (PRIMARY) CDB
	PUSHJ	P,@.IOISR(T1)	;READ NEXT INPUT BYTE
	 JRST	FWRL18		;[40] MAYBE LSN
FWRL15:	MOVE	T1,CO		;OUTPUT (SLAVE) CDB
	PUSHJ	P,@.IOOSR(T1)	;WRITE CURRENT BYTE TO THE SLAVE FILE
	 JRST	FWRL60		;ERROR, TELL REMOTE
	AOS	J$SBYT(J)	;COUNT THIS BYTE
	SOSLE	J$SFC(J)	;[36] EXHAUSTED OUR QUANTUM YET?
	JRST	FWRL10		;[36] NO, GO COPY ANOTHER BYTE
	PUSHJ	P,SCHEDZ	;[36] YES, GIVE SOMEONE ELSE A CHANCE
	 POPJ	P,		;[36] MUST HAVE BEEN ABORTED
	JRST	FWRL09		;[36] CONTINUE WITH THE COPY

FWRL18:	CAIE	M0,$EILSN	;[40] GOT A LINE SEQUENCE NUMBER?
	 JRST	FWRL30		;[40] MAYBE ACCOMP
	MOVE	T3,T2		;[40] POSITION LSN
	MOVEI	T2,.FULSN	;[40] FUNCTION: WRITE LSN
	MOVE	T1,CO		;[40] SELECT OUTPUT (SLAVE) CDB
	PUSHJ	P,.IOFUN##	;[40] WRITE THE LSN
	 JRST	FWRL60		;[40] CHECK OUT ERROR
	JRST	FWRL10		;[40] GO BACK AND TRY FOR REAL DATA


;LOOP READING RECORDS FROM THE REMOTE, WRITING TO THE SLAVE FILE

FWRL19:	MOVX	T1,RECFC	;[36] GET THE FAIRNESS COUNT FOR RECORDS
	MOVEM	T1,J$SFC(J)	;[36] AND INIT THE LOOP COUNTER
FWRL20:	MOVE	T1,CI		;INPUT (PRIMARY) CDB
	SETO	T2,		;NO PARTICULAR RECORD ADDRESS
	DMOVE	T3,J$RLEN(J)	;RECORD BUFFER COUNTER AND POINTER
	PUSHJ	P,@.IOISR(T1)	;READ NEXT INPUT RECORD
	 JRST	FWRL30		;MAYBE ACCOMP
FWRL25:	MOVE	P3,T3		;COPY THE RECORD LENGTH
	MOVE	T1,CO		;OUTPUT (SLAVE) CDB
	PUSHJ	P,@.IOOSR(T1)	;WRITE CURRENT RECORD TO THE SLAVE FILE
	 JRST	FWRL60		;ERROR, TELL REMOTE
	ADDM	P3,J$SBYT(J)	;COUNT HOW MANY WE COPIED
	SOSLE	J$SFC(J)	;[36] EXHAUSTED OUR QUANTUM YET?
	JRST	FWRL20		;[36] NO, GO COPY ANOTHER RECORD
	PUSHJ	P,SCHEDZ	;[36] YES, GIVE SOMEONE ELSE A CHANCE
	 POPJ	P,		;[36] MUST HAVE BEEN ABORTED
	JRST	FWRL19		;[36] CONTINUE WITH THE COPY
;HERE ON EXCEPTION RETURN FROM INPUT BYTE

FWRL30:	MOVE	IO,CI		;SELECT PRIMARY CDB
	CAIE	M0,$EINMP	;INPUT MESSAGE PENDING?
	 POPJ	P,		;[15] NO.  OTHER SIDE MUST HAVE GONE AWAY
	PUSHJ	P,RDMSG1##	;START UP DAP MESSAGE
	 PJRST	NETERI##	;[21] HMMMM
	CAIE	T2,$DHACM	;ACCESS COMPLETE?
	BADDAP	(MA.SYN,,<Received DAP message not DATA nor ACCOMP in FWRL10>)
	JRST	FWRI90		;GO HANDLE ACCOMP


;ERROR WRITING SLAVE OUTPUT FILE

FWRL60:	MOVE	IO,CI		;SELECT PRIMARY CDB
	MOVE	T2,M0		;POSITION RETURNED ERROR STATUS
	MOVEI	T4,DS2EI##	;DAP STATUS TO I/O STATUS TRANSLATION TABLE
	PUSHJ	P,FFIND1	;TRANSLATE TO DAP STATUS
	 SKIPA	T1,[$DSWER]	;GENERIC WRITE ERROR, $E???? AS SECONDARY STATUS
	SETZ	T2,		;KNOWN ERROR, NO SECONDARY STATUS
	ADDI	T1,50000	;DAP I/O LEVEL ERROR
	SETZB	T3,T4		;NOTHING ELSE EITHER
	PUSHJ	P,FXSTS1	;SEND ERROR STATUS TO REMOTE
	 POPJ	P,		;NET DIED
	PUSHJ	P,RDEAT1##	;EAT REST OF ANY CURRENT INPUT MESSAGE
	 POPJ	P,		;NET DIED

;ERROR STATE IDLE LOOP - WAIT FOR CONTINUE OR ABORT
;*** REALLY NEEDS INTERRUPT LEVEL MESSAGES!!!

FWRL70:	PUSHJ	P,RDMSG1##	;START NEXT DAP INPUT MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
FWRL71:	JSP	T4,.CDISP##	;DISPATCH ON DAP MESSAGE TYPE
		FWRL74,,$DHDAT	;DATA
		FWRL80,,$DHCNT	;CONTINUE
		FWRI90,,$DHACM	;ACCOMP
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Unknown/illegal DAP message type in FWRL70>)

;HERE ON DATA MESSAGE - EAT IT UP

FWRL74:	PUSHJ	P,RDDAT1##	;FIRE UP THE DATA MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	PUSHJ	P,RDEAT1##	;EAT THE DATA MESSAGE (UPDATING THE CRC)
	 POPJ	P,		;NET DIED
	JRST	FWRL70		;LOOP WAITING FOR CONTINUE


;HERE ON "CONTINUE" MESSAGE

FWRL80:	PUSHJ	P,RDDAP1##	;READ IN CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	MOVD1	T2,C2F		;CONTINUE TYPE
FWRL81:	JSP	T4,.CDISP##	;DISPATCH ON CONTINUATION TYPE
		FWRL83,,$DVCTA	;TRY AGAIN
		FWRL84,,$DVCSK	;SKIP AND IGNORE
		FWRL90,,$DVCAB	;ABORT FILE
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Unknown/illegal continue type in FWRL81>)

;HERE TO TRY TO CONTINUE THE I/O

FWRL83:	TDZA	T2,T2		;TRY AGAIN
FWRL84:	MOVEI	T2,1		;SKIP AND IGNORE
	STOPCD	<Error continuation not yet written in FWRL84>


;HERE TO ABORT FURTHER I/O - WAIT FOR ACCOMP OF SOME FLAVOR

FWRL90:	PUSHJ	P,RDMSG1##	;START UP NEXT DAP INPUT MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
FWRL91:	JSP	T4,.CDISP##	;DISPATCH ON RECEIVED MESSAGE TYPE
		FWRL94,,$DHDAT	;DATA
		FWRI90,,$DHACM	;ACCOMP
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Unknown/illegal message type in FWRL90>)

;HERE ON DATA MESSAGE, JUST EAT IT UP

FWRL94:	PUSHJ	P,RDDAT1##	;FIRE UP THE DATA MESSAGE
	 PJRST	NETERI##	;[21] NET DIED
	PUSHJ	P,RDEAT1##	;EAT THE DATA (UPDATING THE CRC)
	 POPJ	P,		;NET DIED
	JRST	FWRL90		;LOOP WAITING FOR ACCOMP
;END OF FILE ACCESS
;
;FILE IS DONE, CLOSE OUTPUT FILE

FWRZ00:
FWRZ10:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOCLO0##	;CLOSE THE OUTPUT FILE
	 CAIA			;ERROR
	JRST	FWRZ90		;CAP OFF WITH ACCOMP
FWRZ17:	PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
	 POPJ	P,		;NET MUST HAVE DIED
	JRST	FWRI00		;BACK TO IDLE LOOP WITH OUTPUT FILE STILL OPEN


;RENAME CURRENT FILE

FWRZ30:	PUSHJ	P,FRDCB1	;READ IN NEW ATTRIBUTES/NAME MESSAGES
	 JRST	[CAIE	M0,$ECAUR	;ABORTED AT [REMOTE] USER'S REQUEST?
		POPJ	P,		;NO, LINK BLOWN AWAY
		CAIE	T2,$DVATR	;ACCOMP(TERMINATE)?
		BADDAP	(MA.SYN,,<Unknown/illegal ACCOMP message in FWRZ30>)
		PJRST	FWRZ80]		;YES, SEND ACCOMP(RESPONSE), GO IDLE
	SKIPN	.IOFS3(CO)	;*** DID WE RECEIVE A FILE SPEC?
	JRST	FWRZ10		;*** NO, JUST CLOSE THE FILE NORMALLY
	PUSHJ	P,FRDCE1	;DO THE REQUESTED RENAME OPERATION
	 JRST	FWRZ17		;OOPS - RENAME FAILED, INFORM THE REMOTE
	JRST	FWRZ90		;FILE CLOSED (BY IOFRN), SEND ACCOMP(RESPONSE)


;ABORT THE CURRENT FILE

FWRZ50:


;TERMINATE ACCESS (SAME AS ABORT FOR THE WRITE-CASE)

FWRZ80:	MOVE	IO,CO		;POINT TO SLAVE CDB
	PUSHJ	P,IOABO1##	;ABORT THE CURRENT FILE, IF POSSIBLE
	 DEBUG	<IOABO failed in FWRZ50>,,,.POPJ##

;ACCESS IS COMPLETED

FWRZ90:	SKIPN	T1,J$RALC(J)	;GOT A RECORD BUFFER?
	JRST	FWRZ92		;NOPE
	MOVE	T2,J$RALC+1(J)	;YUP
	PUSHJ	P,.MMFWD##	;FREE IT UP
	 JFCL			;SHOULDN'T AUGHTA HAPPEN!
	SETZM	J$RALC(J)	;NO LONGER HAVE A RECORD BUFFER
FWRZ92:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
;FWSP01  --  HERE TO PROCESS A "SPOOLED" FILE
;
;Here if the created file is a local "spooled" file. In order to do it
;"right" FAL must go through some pretty amazing gyrations so that, comme
;par example, the remote user's name appears on the (e.g.,) printer banner.
;
;For this to work requires monitor version 70155 or later, previous
;monitors will not properly set up ppn, account string, and user name
;(as set here by the SPPRM.).

FWSP01:	SETO	T2,		;FLAG "SPOOLED" NONSENSE TO QUEOP
	PUSHJ	P,QUEOP0##	;AND LET QUEOP FIGURE IT ALL OUT
	 WARN	FWQ,<QUEOP to set spooling parameters didn't>
	JRST	.POPJ1##	;THAT TURNED OUT TO BE PRETTY EASY AFTER ALL...
;A stillborn method of handling the spooling stuff . . . included mostly
;for the reader's amusement . . .

REPEAT	0,<			;FOR PRE-70155 MONITORS, THIS ALMOST WORKS
	MOVE	P4,.IODCH(IO)	;STASH A COPY OF REAL SPOOLED CHARACTERISTICS
	HLRZ	T2,.I1DEV(IO)	;GET "REAL" DEVICE NAME
	MOVEI	T4,FWSPTQ	;TABLE OF DEVICE-TO-QUEUE CORRESPONDENCE
	PUSHJ	P,.CFIND##	;MATCH THE DEVICE TO A QUEUE
	 JRST	.POPJ1##	;FORGET IT
	MOVE	P3,T1		;SAVE THE QUEUE CODE FOR AWHILE
	LDB	T1,[POINTR .I1DEV(IO),<^O777700>]  ;NOMINAL NODE FIELD
	LDB	T2,[POINTR .I1DEV(IO),<^O000077>]  ;NOMINAL UNIT FIELD
	JUMPN	T2,FWSP06	;IF UNIT THEN NODE MUST PRECEDE
	JUMPN	T1,FWSP03	;NO UNIT, THEN ONLY ONE OF NODE OR UNIT

;HERE IF JUST GENERIC DEVICE (E.G., "LPT:")

	SETZB	T1,T2		;IF BLANK THEN NEITHER NODE NOR UNIT
	JRST	FWSP09		;SET NODE AND UNIT INFO

;HERE IF JUST NODE OR UNIT (E.G., "LPT1:" OR "LPT22:")

FWSP03:	TRNN	T1,000077	;ONE IF BY UNIT, TWO IF BY NODE
	JRST	FWSP05		;REALLY MEANT ONLY UNIT . . .
	LSHC	T1,-3		;LOW ORDER DIGIT OF NODE
	LSH	T1,-3		;STRIP OFF SIXBIT CHARACTER JUNK
	LSHC	T1,3		;RECOMBINE THE TWO-DIGIT NODE NUMBER
	ANDI	T1,77		;AND JUST THE TWO-DIGIT NODE NUMBER
	SETZ	T2,		;NO UNIT INFO
	JRST	FWSP09		;SET NODE AND UNIT INFO

;HERE IF BOTH NODE AND UNIT (E.G., "LPT221:")

FWSP05:	EXCH	T1,T2		;REPOSITION UNIT NUMBER, NULL NODE NUMBER
	LSH	T2,-6		;RIGHT-JUSTIFY UNIT NUMBER
FWSP06:	MOVEI	M0,-'0'(T2)	;SAVE UNIT NUMBER IN M0
	LSHC	T1,-3		;LOW ORDER DIGIT OF NODE
	LSH	T1,-3		;STRIP OFF SIXBIT JUNK
	LSHC	T1,3		;RECOMBINE THE TWO DIGIT NODE NUMBER
	ANDI	T1,77		;AND JUST THE TWO-DIGIT NODE NUMBER
	MOVE	T2,M0		;RETRIEVE THE UNIT NUMBER
	HRLI	T2,.QBUPH	;AND NOTE IT IS A PHYSICAL UNIT REQUEST
FWSP09:	MOVEM	T1,.IOQND(IO)	;SET /DESTINATION NODE NUMBER
	MOVEM	T2,.IOQUN(IO)	;SET /UNIT NUMBER, IF ANY

;NOW SET "JOB NAME" FROM USER-SPECIFIED FILE NAME (IF ANY)

FWSP10:	MOVE	T1,.I1LKP+.RBNAM(IO)  ;GET ENTER'ED FILE NAME
	MOVEM	T1,.IOQ6J(IO)	;AND SET THAT AS THE QUEUE REQUEST NAME

;CONTINUED ON NEXT PAGE
;STILL IN REPEAT 0

;CONTINUED FROM PREVIOUS PAGE

;ABORT THE AS-SPECIFIED-BY-USER FILE

FWSP30:	PUSHJ	P,IOABO0##	;ABORT THE FILE
	 JFCL			;CAN'T HAPPEN

;NOW SETUP OUR VERY OWN IMITATION SPOOL FILE SPL:FALnnn.SPL

FWSP40:	MOVE	P1,.IOFSB(IO)	;ADDRESS OF FILE SPEC BLOCK FOR OUTPUT
	SETO	T2,		;NON-WILD MASK
	MOVSI	T1,'SPL'	;DEVICE IS SYSTEM-SPOOL
	DMOVEM	T1,.FXDEV(P1)	;SET IN FILE SPEC BLOCK
	XMOVEI	T3,[ASCIZ\SPL\]	;ASCII STRING DEVICE NAME
	MOVEM	T3,.FSDEV(P1)	;SET IN FILE SPEC BLOCK
	SETZM	.FXDIR(P1)	;NO DIRECTORY
	SETZM	.FXDIR(P1)	; . . .
	SETZM	.FSDIR(P1)	; . . .
	MOVE	T1,['FAL001']	;FILE NAME
	DMOVEM	T1,.FXNAM(P1)	;SET IN FILE SPEC BLOCK
	XMOVEI	T3,[ASCIZ\FAL001\]  ;ASCII STRING FILE NAME
	MOVEM	T3,.FSNAM(P1)	;SET IN FILE SPEC BLOCK
	HRLOI	T1,'SPL'	;DEFAULT FILE TYPE
	MOVEM	T1,.FXEXT(P1)	;SET IN FILE SPEC BLOCK
	XMOVEI	T3,[ASCIZ\SPL\]	;ASCII STRING FILE TYPE
	MOVEM	T3,.FSEXT(P1)	;SET IN FILE SPEC BLOCK
	MOVX	T1,FX.SUP	;ALSO SPECIFY /ERSUPERSEDE
	IORM	T1,.FXMOD(P1)	;IN THE FILE SPEC BLOCK
	IORM	T1,.FXMOM(P1)	;AND MAKE IT STICKY TOO!

;NOW CREATE THE FILE, LOOPING ON THE 'nnn' UNTIL A FILE IS CREATED

FWSP50:	MOVX	T1,IM.UNQ	;THE CREATE-UNIQUE-NAME FLAG
	IORM	T1,.IOIOM(IO)	;TELL IOPOU . . .
	SETZ	T2,		;NO INPUT FILE FROM WHICH TO WILDCARD
	PUSHJ	P,IOPOU0##	;CREATE OUTPUT FILE
	 PJRST	[PUSHJ	P,FOFI01	;PROCESS UNEXPECTED FILE ERROR
		  POPJ	P,		;ERROR RETURN
		POPJ	P,]		;DIFFERENT ERROR RETURN

;FAKE SPOOL FILE ALL SET UP!

FWSP60:	MOVEM	P4,.IODCH(IO)	;RETURN FAKE SPOOL CHARACTERISTICS
	MOVEM	P3,FQUFNC	;*** SET SPOOLED FLAG
	JRST	.POPJ1##	;SUCCESSFUL INTERCEPTED RETURN
;STILL IN REPEAT 0

;TABLE OF DEVICE TYPE TO QUEUE CORRESPONDENCE

FWSPTQ:	.QUPRT,,'LPT'		;LINEPRINTERS
	.QUCDP,,'CDP'		;CARD PUNCH
	.QUPTP,,'PTP'		;PAPER TAPE PUNCH
	.QUPLT,,'PLT'		;PLOTTER
	0			;THAT'S ALL

> ;END OF REPEAT 0 FOR PRE-70155 MONITORS
	SUBTTL	File rename access

FREN00:	MOVE	IO,CI		;ADDRESS OF PRIMARY CDB

;READ IN SECONDARY NAME MESSAGE (NEW FILE SPECIFICATION)

FREN02:	PUSHJ	P,FRENA1	;READ IN ALL THE ANCILLIARY STUFF
	 JRST	[CAIE	M0,$ECAUR	;ABORTED AT [REMOTE] USER'S REQUEST?
		POPJ	P,		;NO, LINK BLOWN AWAY
		CAIN	T2,$DVATR	;YES, MUST BE ACCOMP(TERMINATE)
		PJRST	FJOB93		;SEND ACCOMP(RESPONSE), GO IDLE
		BADDAP	(MA.SYN,,<Illegal/unknown ACCOMP message in FREN02>)
		]

;LOOP FINDING FILES

FREN10:	PUSHJ	P,FIFIL1	;FIND NEXT POSSIBLY-WILD INPUT FILE
	  POPJ	P,		;(0) NET DIED OR OTHER FATAL ERROR
	 JRST	FREN90		;(1) INPUT FILE STREAM EXHAUSTED
				;(2) CONTINUE WITH RETURNED FILE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FREN20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB
	MOVD	T1,AOP		;ACCESS OPTIONS FIELD
	MOVD	P1,ADS		;ACCESS DISPLAY FIELD
	TFNN	T1,GNG		;IF NOT GO/NOGO
	FJUMPE	P1,ADS,FREN50	;AND NO DISPLAY THEN ALL DONE HERE

;HERE IF NEED TO SEND NAME/ATTRIBUTES

FREN22:	PUSHJ	P,FANTY1	;HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
	 POPJ	P,		;NET DIED
	MOVD	P1,ADS		;RETRIEVE ACCESS DISPLAY FIELD AGAIN
	FJUMPE	P1,ADS,FREN29	;CAP OFF WITH ACK IF NO DISPLAY REQUESTED
	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FREN20>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FREN20>,,,.POPJ##
FREN29:	PUSHJ	P,FX7ACK	;CAP OFF FILE NAME/ATTRIBUTES
	 POPJ	P,		;NET DIED?


;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED

FREN40:	MOVD	T1,AOP		;GET ACCESS OPTIONS
	TFNN	T1,GNG		;DID REMOTE SPECIFY GO/NOGO?
	JRST	FREN50		;NO, JUST RENAME THE FILE
	PUSHJ	P,XDFLS1##	;YES, FLUSH OUT ATTR/ET AL TO REMOTE
	 PJRST	NETERO##	;[21] NET DIED?

;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND

FREN41:	PUSHJ	P,RDMSG1##	;GET REMOTE'S GO/NOGO DECISION
	 PJRST	NETERI##	;[21] NET MUST HAVE DIED
FREN42:	JSP	T4,.CDISP##	;DISPATCH BASED ON REMOTE'S DECISION
		FREN43,,$DHSTS	;STATUS - SHOULDN'T HAPPEN
		FREN45,,$DHCNT	;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
		FREN48,,$DHACM	;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
		0		;NONE OTHER
	BADDAP	(MA.SYN,,<Unknown GO/NOGO response from remote at FREN42>)


;RECEIVED STATUS

FREN43:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	BADDAP	(MA.SYN,,<STATUS received in FREN40>)


;RECEIVED CONTINUE

FREN45:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,C2F		;CONTINUE FUNCTION CODE
	CAIN	T1,$DVCSK	;SKIP THIS FILE?
	JRST	FREN70		;YES, KEEP THIS FILE
	CAIN	T1,$DVCRS	;RESUME PROCESSING?
	JRST	FREN50		;YES, RENAME THIS FILE
	BADDAP	(MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FREN45>)


;RECEIVED ACCOMP

FREN48:	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP AREA
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;READ IN REST OF ACCESS COMPLETE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,A2F		;GET ACCESS COMPLETE FUNCTION
	CAIN	T1,$DVACL	;NORMAL FUNCTION TERMINATION?
	JRST	FREN50		;YES, RENAME THE FILE
	CAIN	T1,$DVASK	;WANT TO SKIP THIS FILE?
	JRST	FREN70		;YES, DON'T RENAME THE FILE
	CAIN	T1,$DVATR	;WANT TO TERMINATE/ABORT THIS ACCESS?
	JRST	FREN90		;YES
	BADDAP	(MA.INV,ACM!20,<Unknown ACCOMP function in FREN48>)


;HERE TO RENAME THE CURRENT FILE

FREN50:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOFRN1##	;RENAME CURRENT FILE
	 CAIA			;ERROR RETURN
	JRST	FREN60		;TIME FOR SECOND ATTRIBUTES/NAME

;HERE WHEN RENAME FAILS (NOTE NAME/ATTR ALREADY SENT . . .)

	PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
	 JRST	FREN90		;NET DIED?
	JRST	FREN10		;TRY FOR NEXT FILE


;NOW SEND RESULTANT NAME/ATTRIBUTES

FREN60:	MOVE	IO,CI		;SELECT PRIMARY CDB AGAIN
	MOVD	T1,AOP		;ACCESS OPTIONS FIELD
	MOVD	P1,ADS		;ACCESS DISPLAY FIELD
	TFNN	T1,GNG		;IF NOT GO/NOGO
	FJUMPE	P1,ADS,FREN10	;AND NO DISPLAY THEN ALL DONE HERE

;HERE IF NEED TO SEND SECOND SET OF NAME/ATTRIBUTES


FREN62:	PUSHJ	P,FSNTY1	;HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
	 POPJ	P,		;NET DIED
	MOVD	P1,ADS		;RETRIEVE ACCESS DISPLAY FIELD AGAIN
	FJUMPE	P1,ADS,FREN69	;CAP OFF WITH ACK IF NO DISPLAY REQUESTED
	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FREN60>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FREN60>,,,.POPJ##

FREN69:	PUSHJ	P,FX7ACK	;CAP OFF FILE NAME/ATTRIBUTES
	 POPJ	P,		;NET DIED?

	JRST	FREN10		;TRY FOR ANOTHER FILE


;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE

FREN70:	MOVE	IO,CO		;POINT TO SLAVE CDB
	MOVX	T1,IM.SAD	;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
	IORM	T1,.IOIOM(IO)	;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
	PUSHJ	P,IOCLO1##	;TOSS THE CURRENT FILE
	 JFCL			;DON'T CARE
	MOVX	T1,IM.SAD	;THE BIT AGAIN
	ANDCAM	T1,.IOIOM(IO)	;CLEAR BACK OUT OF THE CDB
	JRST	FREN10		;TRY FOR ANOTHER FILE


;ALL FILES PROCESSED, ACCESS IS COMPLETED

FREN90:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
;RENAME-class helper subroutines

;FRENA - Read in the "ancilliary" messages that follow the ACCESS(RENAME)
;
;Also used by ACCOMP(RENAME)

FRENA1:	PUSHJ	P,RDMSG1##	;START THE NEXT MESSAGE IN
	 PJRST	NETERI##	;NET DIED?
	JSP	T4,.CDISP##	;DISPATCH BASED ON MESSAGE TYPE
		FRENA4,,$DHATR	;MAIN ATTRIBUTES, SLURP IT UP
		FRENA4,,$DHALC	;ALLOCATION ATTRUBUTES
		FRENA4,,$DHTIM	;DATE/TIME ATTRIBUTES
		FRENA4,,$DHPRT	;PROTECTION ATTRIBUTES
		FRENA5,,$DHNAM	;NAME
		FRENA9,,$DHACM	;ACCOMP
		0		;NONE OTHERS


;RECEIVED ATTRIBUTES OF SOME FLAVOR, JUST SLURP THEM UP

FRENA4:	PUSHJ	P,RDDAP1##	;READ IN THE ATTRIBUTES MESSAGE
	 JSP	T4,FERDP	;ERROR IN ATTRIBUTES MESSAGE
	JRST	FRENA1		;LOOP WAITING FOR NAME MESSAGE


;RECEIVED NAME MESSAGE

FRENA5:	PUSHJ	P,RDDAP1##	;READ IN THE NAME MESSAGE BODY
	 PJRST	NETERI##	;[21] NET DIED?
	MOVD	T1,NTY		;NAME TYPE FIELD
	TFNN	T1,NFS		;CONTAIN A FILE SPECIFICATION?
	BADDAP	(MA.SYN,,<Not a file spec NAME message in FRENA5>)
	PUSHJ	P,DPRNN1##	;PARSE THE RECEIVED NAME FILE SPEC
	 STOPCD	<DPRNN failed in FRENA5>
	SKIPN	T1,.IOXFF(CO)	;SLAVE FREE SPACE
	ERROR	NES,<No "extra" space in slave CDB in FREN02>
	ADDI	T1,.FXMAX	;SIZE OF FILE SPEC BLOCK
	CAML	T1,.IOXSZ(CO)	;ROOM FOR TERTIARY FILE SPEC BLOCK?
	ERROR	NRI,<No room in slave CDB for tertiary FSB in FREN02>
	EXCH	T1,.IOXFF(CO)	;ALLOCATE ONE FSB FROM "EXTRA" SPACE
	ADD	T1,CO		;RELOCATE FSB ADDRESS INTO MEMORY
	MOVEM	T1,.IOFS3(CO)	;SET "OUTPUT" FILE SPEC BLOCK ADDRESS
	MOVEM	T1,.IOFS3(CI)	;SET PRIMARY TOO, JUST ON G.P.S
	MOVEI	T2,.FXMAX	;SIZE OF FILE SPEC BLOCK
	PUSHJ	P,.GTSPC##	;COPY OVER THE FILE SPEC BLOCK

;NOW COPY OVER ANY "NEW" ATTRIBUTES TOO

	MOVE	P3,.IOIOC(CO)	;CURRENT I/O CONTROL
	MOVE	P4,.IOIOM(CO)	;CURRENT I/O MODE FLAGS
	PUSHJ	P,FAJA10	;VERIFY ATTRIBUTES/ET AL
	 POPJ	P,		;OOPS

;THIS TERMINATES THE "ANCILLIARY" MESSAGES, TIME TO DO THE REAL WORK NOW!

	JRST	.POPJ1##	;SUCCESSFUL RETURN


;RECEIVED ACCOMP - REMOTE MUST WANT TO ABORT THE ACCESS

FRENA9:	PUSHJ	P,RDCLR1##	;CLEAR OUT THE DAP DATA
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;READ IN THE ACCOMP MESSAGE
	 POPJ	P,		;OH WELL
	MOVD	T2,A2F		;THE ACCOMP FUNCTION CODE
	MOVEI	M0,$ECAUR	;NOTE RECEIVED ACCOMP BEFORE NAME MESSAGE
	POPJ	P,		;LET CALLER FIGURE OUT WHAT TO DO
	SUBTTL	File delete access

FDEL00:

;LOOP FINDING FILES

FDEL10:	PUSHJ	P,FIFIL1	;FIND NEXT POSSIBLY-WILD INPUT FILE
	  POPJ	P,		;(0) NET DIED OR OTHER FATAL ERROR
	 JRST	FDEL90		;(1) INPUT FILE STREAM EXHAUSTED
				;(2) CONTINUE WITH RETURNED FILE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FDEL20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB
	MOVD	T1,AOP		;ACCESS OPTIONS FIELD
	MOVD	P1,ADS		;ACCESS DISPLAY FIELD
	TFNN	T1,GNG		;UNLESS GO/NOGO
	FJUMPE	P1,ADS,FDEL50	;THEN NO NAME/ATTR IF NO DISPLAY

;HERE IF NEED NAME AND/OR ATTRIBUTES MESSAGES

FDEL22:	PUSHJ	P,FANTY1	;SEND WILDCARDED NAMES AS NEEDED
	 POPJ	P,		;NET DIED?
	MOVD	P1,ADS		;RETRIEVE COPY OF ACCESS DISPLAY
	FJUMPE	P1,ADS,FDEL29	;IF NO DISPLAY, CAP OFF NAME WITH AN ACK
	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FDEL20>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FDEL20>,,,.POPJ##
FDEL29:	PUSHJ	P,FX7ACK	;CAP OFF NAME/ATTRIBUTES WITH AN ACK
	 POPJ	P,		;NET DIED?


;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED

FDEL40:	MOVD	T1,AOP		;GET ACCESS OPTIONS
	TFNN	T1,GNG		;DID REMOTE SPECIFY GO/NOGO?
	JRST	FDEL50		;NO, JUST DELETE THE FILE
	PUSHJ	P,XDFLS1##	;YES, FLUSH OUT ATTR/ET AL TO REMOTE
	 PJRST	NETERO##	;[21] NET DIED?

;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND

FDEL41:	PUSHJ	P,RDMSG1##	;GET REMOTE'S GO/NOGO DECISION
	 PJRST	NETERI##	;[21] NET MUST HAVE DIED
FDEL42:	JSP	T4,.CDISP##	;DISPATCH BASED ON REMOTE'S DECISION
		FDEL43,,$DHSTS	;STATUS - SHOULDN'T HAPPEN
		FDEL45,,$DHCNT	;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
		FDEL48,,$DHACM	;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
		0		;NONE OTHER
	BADDAP	(MA.SYN,,<Unknown GO/NOGO response from remote at FDEL42>)


;RECEIVED STATUS

FDEL43:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	BADDAP	(MA.SYN,,<STATUS received in FDEL40>)


;RECEIVED CONTINUE

FDEL45:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,C2F		;CONTINUE FUNCTION CODE
	CAIN	T1,$DVCSK	;SKIP THIS FILE?
	JRST	FDEL70		;YES, KEEP THIS FILE
	CAIN	T1,$DVCRS	;RESUME PROCESSING?
	JRST	FDEL50		;YES, DELETE THIS FILE
	BADDAP	(MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FDEL45>)


;RECEIVED ACCOMP

FDEL48:	PUSHJ	P,RDCLR1##	;CLEAR OUT STALE DAP FIELDS FIRST
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;READ IN REST OF ACCESS COMPLETE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,A2F		;GET ACCESS COMPLETE FUNCTION
	CAIN	T1,$DVACL	;NORMAL FILE TERMINATION?
	JRST	FDEL50		;YES, DELETE THE FILE
	CAIN	T1,$DVASK	;SKIP THIS FILE?
	JRST	FDEL70		;YES, KEEP THIS FILE
	CAIN	T1,$DVATR	;WANT TO TERMINATE/ABORT THIS ACCESS?
	JRST	FDEL90		;YES
	BADDAP	(MA.SYN,,<Unknown ACCOMP function in FDEL48>)


;HERE TO DELETE THE CURRENT FILE

FDEL50:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOFDL1##	;DELETE CURRENT FILE
	 CAIA			;ERROR RETURN
	JRST	FDEL10		;TRY FOR ANOTHER FILE

;HERE WHEN DELETE FAILS (NOTE NAME/ATTR ALREADY SENT . . .)

	PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
	 JRST	FDEL90		;NET DIED?
	JRST	FDEL10		;TRY FOR NEXT FILE


;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE

FDEL70:	MOVE	IO,CO		;POINT TO SLAVE CDB
	MOVX	T1,IM.SAD	;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
	IORM	T1,.IOIOM(IO)	;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
	PUSHJ	P,IOCLO1##	;TOSS THE CURRENT FILE
	 JFCL			;DON'T CARE
	MOVX	T1,IM.SAD	;THE BIT AGAIN
	ANDCAM	T1,.IOIOM(IO)	;CLEAR BACK OUT OF THE CDB
	JRST	FDEL10		;TRY FOR ANOTHER FILE


;ALL FILES PROCESSED, ACCESS IS COMPLETED

FDEL90:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
	SUBTTL	File directory-list access

;The multithreaded nature of this FAL will require a little high overhead
;handwaving here.  Since this directory listing is just going to LOOKUP
;files on disk, and since LOOKUPs always block, it's likely that we'll
;spend more time doing LOOKUPs than it will take the remote end to process
;our message.  If this is the case, this directory listing will run to the
;exclusion of all the other streams.  In addition, no status update messages
;will ever be sent to QUASAR, so SHOW STATUS FAL-STREAM would give an
;erroneous indication of Idle in our behalf.  What we're going to do here
;is deschedule the task after we've listed a few files, so that everyone
;else can get a chance.

FDIR00:

;LOOP FINDING FILES

FDIR10:	PUSHJ	P,FIFIL1	;FIND NEXT POSSIBLY-WILD INPUT FILE
	  POPJ	P,		;(0) NET DIED OR OTHER FATAL ERROR
	 JRST	FDIR90		;(1) INPUT FILE STREAM EXHAUSTED
				;(2) CONTINUE WITH RETURNED FILE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FDIR20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB
	PUSHJ	P,FANTY5	;[6] FORCE NAME MESSAGES FOR "DIRECTORY"
	 DEBUG	<FANTY failed in FDIR20>,,,.POPJ##

;COPY OVER AND SEND ANY FILE ATTRIBUTES REQUESTED

FDIR22:	MOVD	P1,ADS		;ACCESS DISPLAY FIELD
	FJUMPE	P1,ADS,FDIR29	;[11] IF NO DISPLAY ALL DONE HERE
	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FDIR22>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FDIR22>,,,.POPJ##
FDIR29:	PUSHJ	P,FX7ACK	;[11] SEPARATE FILES WITH ACK IF V7.0
	 POPJ	P,		;[11] NET DIED?


;END OF FILE INFORMATION.

FDIR40:				;NO FILE PROCESSING

;ADVANCE TO NEXT INPUT FILE

FDIR70:	MOVE	IO,CO		;POINT TO SLAVE CDB
	PUSHJ	P,IOCLO1##	;TOSS THE CURRENT FILE
	 JFCL			;DON'T CARE
	JRST	FDIR10		;TRY FOR ANOTHER FILE

;ALL FILES PROCESSED, ACCESS IS COMPLETED

FDIR90:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
	SUBTTL	File (BATCH) submission access

FSUB00:	BADDAP	(MA.UNS,ACS!20,<DAP "SUBMIT" operation not supported>)

FEXE00:	PUSHJ	P,NONPP1	;DISALLOW NETPPN HERE
	 JRST	[PUSHJ	P,FOFI01	;SEND ERROR STATUS TO REMOTE
		 POPJ	P,		;NET DIED?
		JRST	FJOB95]		;BACK TO IDLE STATE

;LOOP FINDING FILES

FEXE10:	PUSHJ	P,FIFIL1	;FIND NEXT POSSIBLY-WILD INPUT FILE
	  POPJ	P,		;(0) NET DIED OR OTHER FATAL ERROR
	 JRST	FEXE90		;(1) INPUT FILE STREAM EXHAUSTED
				;(2) CONTINUE WITH RETURNED FILE

;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)

FEXE20:	MOVE	IO,CI		;RE-SELECT PRIMARY CDB
	MOVD	T1,AOP		;ACCESS OPTIONS
	MOVD	P1,ADS		;ACCESS DISPLAY FIELD
	TFNN	T1,GNG		;UNLESS GO/NOGO SPECIFIED
	FJUMPE	P1,ADS,FEXE50	;THEN NO NAMES/ATTRIBUTES IF NO DISPLAY

;HERE WHEN MUST RETURN NAMES AND/OR ATTRIBUTES TO THE REMOTE ACCESSOR

FEXE22:	PUSHJ	P,FANTY1	;SEND BACK RESULTANT WILDCARDED NAMES
	 POPJ	P,		;NET DIED?
	MOVD	P1,ADS		;RETRIEVE ACCESS DISPLAY REQUEST
	FJUMPE	P1,ADS,FEXE29	;IF NO DISPLAY THEN CAP OFF NAMES WITH AN ACK
	PUSHJ	P,FFAD01	;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
	 DEBUG	<FFAD failed in FEXE20>,,,.POPJ##
	MOVD	P1,ADS		;RESTORE ACCESS DISPLAY FIELD
	PUSHJ	P,FXAT01	;SEND ATTRIBUTES MESSAGES
	 DEBUG	<FXAT failed in FEXE20>,,,.POPJ##
FEXE29:	PUSHJ	P,FX7ACK	;CAP OFF WITH AN ACK
	 POPJ	P,		;NET DIED?


;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED

FEXE40:	MOVD	T1,AOP		;GET ACCESS OPTIONS
	TFNN	T1,GNG		;DID REMOTE SPECIFY GO/NOGO?
	JRST	FEXE50		;NO, JUST SUBMIT THE FILE
	PUSHJ	P,XDFLS1##	;YES, FLUSH OUT ATTR/ET AL TO REMOTE
	 PJRST	NETERO##	;[21] NET DIED?

;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND

FEXE41:	PUSHJ	P,RDMSG1##	;GET REMOTE'S GO/NOGO DECISION
	 PJRST	NETERI##	;[21] NET MUST HAVE DIED
FEXE42:	JSP	T4,.CDISP##	;DISPATCH BASED ON REMOTE'S DECISION
		FEXE43,,$DHSTS	;STATUS - SHOULDN'T HAPPEN
		FEXE45,,$DHCNT	;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
		FEXE48,,$DHACM	;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
		0		;NONE OTHER
	BADDAP	(MA.SYN,,<Unknown GO/NOGO response from remote at FEXE42>)


;RECEIVED STATUS

FEXE43:	PUSHJ	P,RDSTS1##	;READ IN REST OF STATUS
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	BADDAP	(MA.SYN,,<STATUS received in FEXE40>)


;RECEIVED CONTINUE

FEXE45:	PUSHJ	P,RDDAP1##	;READ IN REST OF CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,C2F		;CONTINUE FUNCTION CODE
	CAIN	T1,$DVCSK	;SKIP THIS FILE?
	JRST	FEXE70		;YES, KEEP THIS FILE
	CAIN	T1,$DVCRS	;RESUME PROCESSING?
	JRST	FEXE50		;YES, SUBMIT THIS FILE
	BADDAP	(MA.SYN,,<Unknown or illegal CONTINUE function in FEXE45>)


;RECEIVED ACCOMP

FEXE48:	PUSHJ	P,RDCLR1##	;CLEAR OUT STALE DAP INFO
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;READ IN REST OF ACCESS COMPLETE
	 PJRST	NETERI##	;[21] SHOULDN'T HAPPEN
	MOVD1	T1,A2F		;GET ACCESS COMPLETE FUNCTION
	CAIN	T1,$DVACL	;NORMAL FILE TERMINATION?
	JRST	FEXE50		;YES, EXECUTE THIS FILE
	CAIN	T1,$DVASK	;SKIP THIS FILE?
	JRST	FEXE70		;YES, LEAVE THE BATCH SYSTEM ALONE
	CAIN	T1,$DVATR	;WANT TO TERMINATE/ABORT THIS ACCESS?
	JRST	FEXE90		;YES
	BADDAP	(MA.INV,ACM!20,<Unknown ACCOMP function in FEXE48>)


;HERE TO SUBMIT THE CURRENT FILE

FEXE50:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOFSU1##	;SUBMIT THE CURRENT OPEN FILE
	 CAIA			;OOPS - FAILURE
	JRST	FEXE73		;CLOSE THIS ONE AND TRY FOR ANOTHER FILE

;HERE WHEN THE SUBMIT REQUEST FAILS

	PUSHJ	P,FOFI01	;SEND STATUS MESSAGE TO REMOTE
	 JRST	FEXE90		;NET DIED? ABORT ACCESS
	JRST	FEXE73		;TRY FOR ANOTHER FILE


;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE

FEXE70:	MOVE	IO,CO		;POINT TO SLAVE CDB
	MOVX	T1,IM.SAD	;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
	IORM	T1,.IOIOM(IO)	;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
FEXE73:	PUSHJ	P,IOCLO1##	;TOSS THE CURRENT FILE
	 JFCL			;DON'T CARE
	MOVX	T1,IM.SAD	;THE BIT AGAIN
	ANDCAM	T1,.IOIOM(IO)	;CLEAR BACK OUT OF THE CDB
	JRST	FEXE10		;TRY FOR ANOTHER FILE


;ALL FILES PROCESSED, ACCESS IS COMPLETED

FEXE90:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IORLS1##	;WE ARE DONE WITH FILE-LEVEL OPERATIONS
	 JFCL			;DON'T CARE
	JRST	FJOB93		;SEND ACCOMP(RESPONSE)
	SUBTTL	General-purpose file-level subroutines

;HELPER TO PARSE FILE FROM ACCESS MESSAGE

FALIF0:	TDZA	T2,T2		;FLAG FIRST TIME IN
FALIF1:	MOVEI	T2,1		;FLAG CONTINUATION READ
	PUSHJ	P,.SAVE4##	;SCAN'S CH AND NM ARE OUR P3 AND P4 !!!
	MOVE	P2,T2		;PROTECT FLAG
	SETZM	.IOXTO(IO)	;USE IOXTO AS COUNTER/FLAG HERE
	XMOVEI	T1,FALIFI	;OUR VERY OWN INPUT TYPER
	PUSHJ	P,.XTYPI##	;INTERCEPT "COMMAND" INPUT
	XMOVEI	T1,FALIFO	;OUR VERY OWN OUTPUT TYPER
	PUSHJ	P,.XTYPO##	;INTERCEPT "COMMAND" OUTPUT
	XMOVEI	T1,FALIFE	;OUR VERY OWN ERROR PROCESSOR
	PUSHJ	P,FALERI	;[50] INTERCEPT FATAL SCAN ERRORS
	JUMPG	P2,FALIF3	;JUST CONTINUE IF NOT FIRST TIME
	MOVE	T1,[POINT 7,[0]];A DUMMY STRING
	MOVEM	T1,.IOXTI(IO)	;SET IN CASE .CLRTI NEEDS SOMETHING
	PUSHJ	P,.CLRTI##	;SETUP LOWLEVEL COMMAND INPUT ROUTINES
	MOVE	T1,[POINT 7,.IDFIL(IO)]  ;BYTE POINTER TO FILE SPEC
	MOVEM	T1,.IOXTI(IO)	;SET FOR FALIFI
	ILDB	T1,T1		;PEEK AT FIRST CHARACTER
	JUMPE	T1,.POPJ##	;IF NULL, NO FILESPEC, REJECT IT

;NOW PARSE THE FILE SPEC

FALIF3:	PUSHJ	P,.FILSP##	;LET SCAN DO ITS THING
	 JRST	FALIFE		;ERROR - DIE
	SKIPN	.IOXTO(IO)	;IT BETTER NOT HAVE COMPLAINED
	JRST	.POPJ1##	;RETURN WITH PARSED FILE IN F.BLK
FALIFE:
IFE FTDEBUG,POPJ P,		;JUST RETURN IF NOT DEBUGGING

IFN FTDEBUG,<		;ONLY COMPLAIN IF DEBUGGING
	DEBUG	<Error in parsing received NAME message in FALIF>,FALIFF,,.POPJ##

FALIFF:	MOVEI	T1,[ASCIZ\
	Bad name string = "\]
	PUSHJ	P,.TSTRG##	;IDENTIFY ERROR STRING
	PUSH	P,[POINT 7,.IDFIL(CI)]  ;[20] POINTER TO OFFENDING STRING
	SKIPA			;[20] GO GET THE FIRST CHAR
	PUSHJ	P,.TFCHR##	;TYPE POSSIBLY-FUNNY CHARACTER
	ILDB	T1,(P)		;[20] NEXT CHARACTER
	JUMPN	T1,.-2		;TYPE CHARACTERS UNTIL END OF STRING
	POP	P,T1		;[20] CLEAN THE STACK
	MOVEI	T1,[ASCIZ\" from node \]
	PUSHJ	P,.TSTRG##	;ANOTHER TEXT STRING
	MOVE	T1,.ION6M(IO)	;OFFENDING NODE
	PJRST	.TSIXN##	;FINK ON HIM >
;THE "COMMAND" INPUT ROUTINE

FALIFI:	ILDB	CH,.IOXTI(IO)	;GET NEXT CHARACTER FROM NAME STRING
	JUMPN	CH,.POPJ##	;RETURN USEFUL CHARACTER
	MOVEI	CH,.CHLFD	;END OF STRING, RETURN EOL TO SCAN
	POPJ	P,		;TERMINATE SCAN


;THE "COMMAND" OUTPUT ROUTINE

FALIFO:	OUTCHR	T1		;OH WELL
	AOS	.IOXTO(IO)	;COUNT OCCURENCES
	POPJ	P,		;RETURN TO SCAN
;FIFIL  --  FIND NEXT POSSIBLY-WILDCARDED INPUT FILE
;CALL IS:
;
;	PUSHJ	P,FIFIL
;	  fatal return
;	 exhausted return
;	normal return
;
;The "fatal" return is taken when, for example, the network has died,
;or any other fatal processing error has occurred; The "exhausted"
;return is taken when the input file stream is exhausted (i.e., there
;are no more input files); The "normal" return is taken with the next
;(presumably slave) input file setup ready for I/O.
;
;On file access errors the remote (primary CDB) is informed of the
;error automatically, with whatever name/etc. messages are necessary
;being sent as appropriate.
;
;When the "exhausted" return is taken the caller should send an
;ACCOMP(RESPONSE) to the remote.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.

FIFIL1:	MOVE	IO,CO		;SELECT SLAVE CDB
	PUSHJ	P,IOPIN1##	;ADVANCE TO NEXT INPUT FILE
	 JRST	FIFI01		;ERROR/EXCEPTION
	PUSHJ	P,COPSPC	;GO COPY THE FILE SPECIFICATION
	 POPJ	P,		;OOPS - ABORTED
CPOPJ2:	AOS	(P)		;SUCCESS HERE IS DOUBLE-
CPOPJ1:	AOS	(P)		; SKIP-
CPOPJ0:	POPJ	P,		;  RETURN
;INPUT FILE ACCESS EXCEPTION RETURN - FIGURE OUT WHAT HAPPENED

FIFI01:	CAIN	M0,$EFIXN	;INPUT FILE STREAM EXHAUSTED?
	JRST	.POPJ1##	;YES, TAKE "EXHAUSTED" RETURN
	CAIN	M0,$EFIXE	;INPUT FILE STREAM EXHAUSTED (REDUNDANTLY)?
	STOPCD	<IOPIN returned "redundantly" exhausted in FIFI00>

;RANDOM FILE ACCESS ERROR, CONVERT TO DAPESE AND PUNT TO REMOTE

	MOVE	IO,CI		;SELECT PRIMARY CDB
	PUSH	P,M0		;SAVE THE ERROR CODE
	PUSHJ	P,FANTY1	;SEND ANY NAME MESSAGES AS NEEDED
	 JRST	M0POPJ		;NET DIED - TAKE FATAL ERROR RETURN
	POP	P,T2		;RESTORE FILE ACCESS ERROR CODE
	MOVEI	T4,DS2EF##	;DAP-STATUS-TO-FILE-STATUS-TABLE ADDRESS
	PUSHJ	P,FFIND1	;SEE IF KNOWN ERROR
	 SKIPA	T1,[$DSACC]	;FILE ACCESS ERROR, $E???? AS SECONDARY STATUS
	SETZ	T2,		;KNOWN ERROR,  NO SECONDARY ERROR CODE
	ADDI	T1,40000	;DAP FILE ACCESS ERROR LEVEL
	SETZB	T3,T4		;NOTHING
	PUSHJ	P,FXSTS1	;SEND REMOTE DAP STATUS
	 POPJ	P,		;NET DIED - FATAL ERROR RETURN


;WE NOW WAIT FOR REMOTE TO MAKE UP ITS MIND AS TO ERROR RECOVERY

FIFI20:	PUSHJ	P,RDMSG1##	;START UP NEW DAP INPUT MESSAGE
	 PJRST	NETERI##	;[21] NET DIED

;DISPATCH ON RECEIVED DAP MESSAGE TYPE

FIFI21:	JSP	T4,.CDISP##	;DISPATCH ON DAP MESSAGE TYPE
		FIFI30,,$DHCNT	;CONTINUE
		FIFI40,,$DHACM	;ACCOMP
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Unknown/illegal DAP message in FIFI21>)


;HERE ON CONTINUE MESSAGE, MUST BE CONTINUATION OF SOME SORT

FIFI30:	PUSHJ	P,RDDAP1##	;READ IN CONTINUE MESSAGE
	 PJRST	NETERI##	;[21] NET DIED?
	MOVD1	T2,C2F		;GET CONTINUE TYPE
	CAIN	T2,$DVCSK	;"SKIP" TO NEXT FILE?
	JRST	FIFIL1		;YES, TRY FOR ANOTHER FILE
	BADDAP	(MA.INV,CNT!20,<Unknown/illegal CONTINUE type in FIFI30>)


;HERE ON ACCOMP MESSAGE, MAYBE CONTINUATION OR ABORT

FIFI40:	PUSHJ	P,RDCLR1##	;CLEAR OUT DAP REGION
	 STOPCD			;CAN'T HAPPEN
	PUSHJ	P,RDDAP1##	;READ IN ACCOMP MESSAGE
	 PJRST	NETERI##	;[21] NET DIED?
	MOVD1	T2,A2F		;GET ACCOMP TYPE
	JSP	T4,.CDISP##	;DISPATCH ON ACCOMP TYPE
		FIFIL1,,$DVACL	;CLOSE
		FIFIL1,,$DVAKL	;KILL
		FIFIL1,,$DVASK	;SKIP
		CPOPJ1,,$DVATR	;TERMINATE/ABORT
		0		;NONE OTHERS
	BADDAP	(MA.SYN,,<Unknown/illegal ACCOMP type in FIFI40>)
;FOFIL  --  CREATE OUTPUT FILE
;CALL IS:
;
;	PUSHJ	P,FOFIL
;	  fatal return
;	 exhausted return
;	normal return
;
;The "fatal" return is taken when, for example, the network has died,
;or any other fatal processing error has occurred; The "exhausted"
;return is taken when the output file create failed and the
;remote has been informed of the error; The "normal" return is taken
;with the slave output file setup ready for I/O.
;
;On file access errors the remote (primary CDB) is informed of the
;error automatically, with whatever name/etc. messages are necessary
;being sent as appropriate.
;
;When the "exhausted" return is taken the caller should return to
;the "pre-ACCESS" state.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.

FOFIL1:	MOVE	IO,CO		;SELECT SLAVE CDB
	SETZ	T2,		;NO INPUT FILE FROM WHICH TO WILDCARD
	PUSHJ	P,IOPOU1##	;CREATE OUTPUT FILE
	 JRST	FOFI01		;ERROR/EXCEPTION RETURN
	PUSHJ	P,COPSPC	;COPY THE FILESPEC FOR FALGLX
	 POPJ	P,		;ABORTED - RETURN
	JRST	CPOPJ2		;DOUBLE-SKIP RETURN FOR SUCCESS


;OUTPUT FILE CREATE ERROR - FIGURE OUT WHAT HAPPENED

FOFI01:	MOVE	IO,CI		;SELECT PRIMARY (REMOTE ACCESSOR) CDB
	MOVE	T2,M0		;POSITION ERROR CODE
	MOVEI	T4,DS2EF##	;DAP-STATUS-TO-FILE-STATUS-TABLE ADDRESS
	PUSHJ	P,FFIND1	;SEE IF KNOWN ERROR
	 SKIPA	T1,[$DSACC]	;FILE ACCESS ERROR, $E???? AS SECONDARY STATUS
	SETZ	T2,		;KNOWN ERROR, NO SECONDARY STATUS
	ADDI	T1,40000	;DAP FILE ACCESS ERROR LEVEL
	SETZB	T3,T4		;NOTHING ELSE
	PUSHJ	P,FXSTS1	;SEND DAP ERROR STATUS TO REMOTE
	 POPJ	P,		;NET DIED
	JRST	CPOPJ1		;SINGLE-SKIP "EXHAUSTED" RETURN
;FAJA  --  VERIFY AND PROCESS RECEIVED ATTIBUTES/ET AL
;CALL IS:
;
;	PUSHJ	P,FAJA
;	 error return
;	normal return
;
;FAJA reads and verifies the received attributes from the remote, and
;based on those attributes, and the access request, sets up the slave
;CDB for subsequent file access operations.
;
;FAJA expects the caller to have set up IO to the primary CDB, and CO
;to point to the slave CDB.
;
;On error return the remote requested an unsupported/illegal/etc.
;attribute/operation/etc., an error code is in M0.
;
;On normal return the slave CDB is ready for file access operations
;on behalf of the remote ACCESS message request.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.

FAJA01:	MOVE	P3,FALOVC	;PROTOTYPE I/O CONTROL
	MOVE	P4,FALOVM	;PROTOTYPE I/O MODE CONTROL

;CHECK OUT THE RECEIVED ACCESS MESSAGE

	SKIPN	.IDAFC(IO)	;WAS AN ACCESS FUNCTION RECEIVED?
	BADDAP	(MA.INV,ACS!20,<FAJA: No ACCESS function specified>)
	MOVD	T1,AOP		;GET ACCESS OPTIONS REQUESTED
	TFZ	T1,<GNG,ACK>	;CLEAR KNOWN/SUPPORTED STUFF
	TFZ	T1,<OKE>	;*** KEEP THE VAX HAPPY
	FJUMPE	T1,AOP,FAJA03	;OK IF NOTHING ELSE LEFT
	BADDAP	(MA.UNS,ACS!21,<FAJA: Unknown or unsupported AOP flags>)
FAJA03:	LDB	T1,[POINT 7,.IDFIL(IO),6]  ;FIRST BYTE OF FILE SPEC
	JUMPN	T1,FAJA04	;ENSURE RECEIVED A FILE SPEC
	BADDAP	(MA.UNS,ACS!22,<FAJA: No ACCESS filespec>)

FAJA04:	MOVD	T1,FAC		;FILE ACCESS REQUESTED
	TFZ	T1,<PUT,GET,DEL,UPD,TRN>  ;CLEAR OK STUFF
	FJUMPE	T1,FAC,FAJA06	;OK IF NOTHING LEFTOVER
	BADDAP	(MA.UNS,ACS!23,<FAJA: Unknown or unsupported FAC flags>)

FAJA06:	MOVD	T1,SHR		;SHARED FILE ACCESS
	TFZ	T1,<GET,NIL>	;[44] CLEAR OK STUFF
	FJUMPE	T1,SHR,FAJA07	;OK IF NOTHING LEFT OVER
	BADDAP	(MA.UNS,ACS!24,<FAJA: Unknown or unsupported SHR flags>)

FAJA07:	MOVD	T1,ADS		;ACCESS DISPLAY (RETURN ATTRIBUTES)
	TFZ	T1,<DMA,DAA,DDT,DFP,DNM,DN3>  ;CLEAR OK STUFF
	FJUMPE	T1,ADS,FAJA08	;OK IF NOTHING LEFT OVER
	BADDAP	(MA.UNS,ACS!25,<FAJA: Unknown or unsupported ADS flags>)

FAJA08:	LDB	T1,[POINT 7,.IDPSW(IO),6]  ;FIRST CHAR OF PASSWORD
	JUMPE	T1,FAJA10	;OK IF NO PASSWORD
	BADDAP	(MA.UNS,ACS!26,<FAJA: ACCESS password specified>)

;CHECK OUT MAIN ATTRIBUTES

FAJA10:	MOVD	P1,M02		;MAIN ATTRIBUTES MENU
	SETZ	T4,		;INITIALLY NO DATA TYPE SELECTED
	MOVD1	T2,AFC		;GET ACCESS TYPE (READ, WRITE, ETC)
	CAIN	T2,$DVAWR	;FILE CREATE OPERATION?
	JRST	FAJA15		;YES

;HERE FOR ALL READ-CLASS FILE ACCESS OPERATIONS

FAJA11:	TMNN	P1,DTY		;WAS A DATA-TYPE FIELD SUPPLIED?
	JRST	FAJA12		;NO
	PUSHJ	P,FAJAD1	;YES, PROCESS DATA-TYPE
	 POPJ	P,		;OOPS, ILLEGAL BITS SET
	JUMPN	T4,FAJA13	;GO WITH USER-SUPPLIED DATA-MODE
FAJA12:	TXO	P4,IM.SMD	;NO DATA-MODE, SELECT DEFAULT FROM FILE
FAJA13:	TMNN	P1,BSZ		;GOT A BYTE-SIZE FIELD?
	TDZA	T3,T3		;NO, GET IT FROM INPUT FILE THEN
	MOVD1	T3,BSZ		;YES, SELECT USER-SUPPLIED BYTE SIZE
	JRST	FAJA19		;DONE WITH READ-SPECIFIC

;HERE FOR WRITE-CLASS FILE ACCESS

FAJA15:	TMNN	P1,DTY		;DATA-TYPE GIVEN?
	JRST	FAJA16		;NO
	PUSHJ	P,FAJAD1	;YES, PROCESS USER-SPECIFIED DATA-TYPE
	 POPJ	P,		;ILLEGAL FLAGS
	JUMPN	T4,FAJA17	;GO WITH USER-SPECIFIED DATA-MODE
FAJA16:	MOVD1	T1,FST		;REMOTE FILE SYSTEM TYPE
	CAIN	T1,$DVFF1	;FCS-11?
	JRST	[MOVD	T1,DTY		;GET DATA TYPE FIELD
		TFO	T1,ASC		;ASSERT ASCII DATA TYPE
		MOVDM	T1,DTY		;SET BACK IN MEMORY
		MOVEI	T4,.ICASC	;FLAG ASCII FILE MODE
		JRST	FAJA17]		;CONTINUE ONWARDS
	BADDAP	(MA.INV,ATR!21,<FAJA: no data mode specified for file create>)
FAJA17:	TMNN	P1,BSZ		;GOT A BYTE SIZE?
	SKIPA	T3,[^D08]	;NO, THEN DAP SAYS 8-BIT BYTES
	MOVD1	T3,BSZ		;YES, GO WITH USER-SPECIFIED BYTE SIZE
FAJA19:	DPB	T4,[POINTR P3,IC.MOD]  ;SET FILE MODE
	CAIE	T3,^D00		;IF NO BYTE SIZE
	CAIN	T3,^D08		;OR 8-BIT BYTES
	CAIE	T4,.ICASC	;AND ASCII FILE MODE
	CAIA			; (NO TO ABOVE)
	MOVEI	T3,^D07		;THEN REALLY WANT 7-BIT BYTES (GRRR!!)
	HRRZM	T3,.IOBSZ(CO)	;SELECT LOGICAL DATA BYTE SIZE
	HRRZM	T3,.IOFSZ(CO)	;SELECT PHYSICAL FRAME BYTE SIZE
	HRRZM	T3,.IOUBS(CO)	;SELECT OVERRIDING BYTE SIZE

;CHECK "FILE ORGANIZATION"

FAJA20:	TMNN	P1,ORG		;FILE ORGANIZATION SET?
	JRST	FAJA22		;NO
	MOVD	T1,ORG		;YES
	CAIE	T1,$DVOSQ	;SEQUENTIAL FILE ORGANIZATION?
	BADDAP	(MA.UNS,ATR!22,<FAJA: Unknown or unsupported ORG type>)

;CHECK RECORD FORMAT

FAJA22:	TMNN	P1,RFM		;RECORD FORMAT SET?
	JRST	FAJA24		;NO
	MOVD	T1,RFM		;YES
	CAIE	T1,$DVFNR	;NO-FORMAT RECORD FORMAT?
	CAIN	T1,$DVFST	;ASCII-STREAM RECORD FORMAT?
	JRST	FAJA24		;YES
	CAIE	T1,$DVFVR	;VARIABLE-LENGTH RECORDS?
	CAIN	T1,$DVFVF	;VARIABLE-WITH-FIXED-HEADER RECORDS?
	JRST	FAJA24		;YES
	CAIN	T1,$DVFFX	;FIXED-LENGTH RECORDS?
	JRST	FAJA24		;YES
	BADDAP	(MA.UNS,ATR!23,<FAJA: Unknown or unsupported RFM type>)

;CHECK RECORD ATTRIBUTES

FAJA24:	TMNN	P1,RAT		;RECORD ATTRIBUTES SET?
	JRST	FAJA26		;NO
	MOVD	T1,RAT		;GET REQUESTED RECORD ATTRIBUTES
	TFZE	T1,MCY		;MACY11-FORMATTING?
	TXO	P3,IC.MCY	;YES, SET IN I/O CONTROL
	TFZE	T1,LSA		;LINE-SEQUENCED ASCII?
	TXO	P3,IC.LSN	;YES, SET IN I/O CONTROL
	TFZ	T1,<ILC,NSB,EFC>;CLEAR OUT IGNORABLE STUFF
	MOVD1	T3,AFC		;GET ACCESS FUNCTION
	CAIN	T3,$DVAWR	;IS THIS A FILE "CREATE"
	TFZ	T1,<CCC,FCC,PRN>;YES, IGNORE CARRIAGE-CONTROL FLAGS
				; (I.E., FAL WILL BE "READING" FROM REMOTE
				;  WHICH ISR SUPPORTS ALL THESE VARIATIONS
				;  WHEREAS ALL OTHER FILE ACCESSES APPEAR
				;  AS "WRITING" TO REMOTE, WHICH OSR DOESN'T
				;  SUPPORT THAT STUFF, SO FLAG IT ERROR)
	FJUMPE	T1,RAT,FAJA26	;ANYTHING LEFT OVER?
	BADDAP	(MA.UNS,ATR!24,<FAJA: Unknown or unsupported RAT bits>)

;CHECK FILE ACCESS OPTIONS

FAJA26:	TMNN	P1,FOP		;FILE ACCESS OPTIONS SET?
	JRST	FAJA40		;NO
	MOVD	T1,FOP		;GET REQUESTED OPTIONS
	TFZE	T1,SUP		;SUPERSEDE FILE?
	PUSHJ	P,[MOVX T3,FX.SUP	;YES, GET /ERSUPERSEDE
		MOVE	T4,.IOFSB(CO)	;ADDRESS OF OUTPUT FILE SPEC BLOCK
		ANDCAM	T3,.FXMOD(T4)	;CLEAR /ERSUPERSEDE
		IORM	T3,.FXMOM(T4)	;AND INDICATE /OKSUPERSEDE
		POPJ	P,]		;CONTINUE
	TFZE	T1,CTG		;CONTIGUOUS ALLOCATION?
	TXO	P4,IM.CTG	;YES
	TFZE	T1,CBT		;CONTIGUOUS BEST TRY?
	TXO	P4,IM.CBT	;YES
;***	TFZE	T1,SCF		;SUBMIT FILE ON CLOSE?
;***	TXO	P4,IM.CSU	;YES
;***	TFZE	T1,SPC		;PRINT FILE ON CLOSE?
;***	TXO	P4,IM.CPR	;YES
;***	TFZE	T1,DLT		;DELETE FILE ON CLOSE?
;***	TXO	P4,IM.CDL	;YES
	TFZ	T1,<SCF,SPC,DLT>;*** HANDLED BY FACL01 INSTEAD
	TFZ	T1,<CIF,SQO,MXV,TEF>  ;IGNORABLE FLAGS
	FJUMPE	T1,FOP,FAJA40	;OK IF NOTHING LEFT OVER
	BADDAP	(MA.UNS,ATR!35,<FAJA: Unknown or unsupported FOP bits>)

;FINISH REST OF MAIN ATTRIBUTES (LENGTH/ALLOCATION/ETC.)

FAJA40:	MOVEM	P3,.IOIOC(CO)	;SET I/O CONTROL
	MOVEM	P4,.IOIOM(CO)	;SET I/O MODE CONTROL
	MOVE	T1,.IOIOC(CI)	;[40] FETCH PRIMARY-CDB I/O CONTROL
	MOVX	T2,IC.LSN	;[40] THE LSN FLAG
	TDNE	P3,T2		;[40] LSN IN EFFECT?
	TDOA	T1,T2		;[40] YES
	TDZ	T1,T2		;[40] NO
	MOVEM	T1,.IOIOC(CI)	;[40] FORCE I/O CONTROL
	MOVD1	T3,BLS		;GET RETURNED DAP DATA BLOCK SIZE (IF ANY)
	MOVEM	T3,.IOBLS(CO)	;AND SET FILE PARAMETER
	MOVD1	T3,MRS		;GET RETURNED DAP RECORDSIZE (IF ANY)
	MOVEM	T3,.IORSZ(CO)	;AND SET FILE PARAMETER
	MOVD1	T1,ALQ		;GET RETURNED DAP ALLOCATION ("BLOCKS" - IF ANY)
	IMUL	T1,.IOBLS(CO)	;CONVERT TO DATA BYTES
	MOVEM	T1,.IOALB(CO)	;SET ALLOCATION IN BYTES FILE PARAMETER
	SKIPN	.IOBSZ(CO)	;GOT A BYTE SIZE?
	JRST	FAJA43		;NO (???)
	MOVEI	T2,^D36		;-10 WORD SIZE
	IDIV	T2,.IOBSZ(CO)	;T2:=BYTES PER -10 WORD
	IDIV	T1,T2		;T1:=FILE ALLOCATION IN -10 WORDS
	CAIE	T2,0		;EXACT FIT?
	ADDI	T1,1		;NO, NEED ONE MORE [PARTIAL] WORD
FAJA43:	MOVEM	T1,.IOALW(CO)	;SET ALLOCATION IN WORDS FILE PARAMETER


;HANDLE DATE/TIME ATTRIBUTES

FAJA50:	MOVD	P1,M13		;DATE/TIME ATTRIBUTES MENU
	TMNN	P1,CDT		;GOT A CREATION DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,CDT		;GET RETURNED LOGICAL CREATION DATE/TIME
	MOVEM	T1,.IOCDT(CO)	;SET FILE PARAMETER
	TMNN	P1,UDT		;GOT UPDATE DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,UDT		;GET RETURNED UPDATE DATE/TIME
	MOVEM	T1,.IOUDT(CO)	;SET UPDATE TIME FILE PARAMETER
	TMNN	P1,EDT		;GOT EXPIRATION DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,EDT		;GET RETURNED EXPIRATION DATE/TIME
	MOVEM	T1,.IOEDT(CO)	;SET EXPIRATION DATE/TIME FILE PARAMETER
	TMNN	P1,BDT		;GOT BACKUP DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,BDT		;GET BACKUP DATE/TIME
	MOVEM	T1,.IOBDT(CO)	;SET BACKUP DATE/TIME FILE PARAMETER
	TMNN	P1,PDT		;GOT PHYSICAL DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,PDT		;GET RETURNED PHYSICAL CREATION DATE/TIME
	MOVEM	T1,.IOPDT(CO)	;SET PHYSICAL CREATION DATE/TIME FILE PARM
	TMNN	P1,ADT		;GOT ACCESS DATE/TIME?
	TDZA	T1,T1		;NO, THEN BLANK THE FIELD
	MOVD1	T1,ADT		;GET ACCESS DATE/TIME
	MOVEM	T1,.IOADT(CO)	;SET ACCESS DATE/TIME FILE PARAMETER


;HANDLE PROTECTION ATTRIBUTES
;
;FAJA ASSUMES THAT THE PROTECTION FIELDS ARE ALL ONE WORD LONG. AS THIS
;IS NOT REALLY GUARANTEED, CAUSE ASSEMBLY ERROR IF IT EVER CHANGES

	IFN	$DLPSY-1,<PRINTX ?PSY field not one word long in FAJA60>
	IFN	$DLPOW-1,<PRINTX ?POW field not one word long in FAJA60>
	IFN	$DLPGR-1,<PRINTX ?PGR field not one word long in FAJA60>
	IFN	$DLPWL-1,<PRINTX ?PWL field not one word long in FAJA60>

FAJA60:	MOVD	P1,M14		;PROTECTION ATTRIBUTES MENU
	SETZB	T2,T3		;START OFF BLANK
	TMNN	P1,PWL		;GOT A "WORLD" PROTECTION?
	JRST	FAJA62		;NO
	MOVD	T1,PWL		;GET RETURNED "WORLD" PROTECTION
	PUSHJ	P,DPFPXL##	;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA62:	LSHC	T2,-3		;SAVE VALUE SO FAR
	SETZ	T2,		;MAKE ROOM FOR NEW
	TMNN	P1,PGR		;GOT A "GROUP" PROTECTION?
	JRST	FAJA64		;NO
	MOVD	T1,PGR		;GET RETURNED "GROUP" PROTECTION
	PUSHJ	P,DPFPXL##	;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA64:	LSHC	T2,-3		;ACCUMULATE THIS "GROUP" FIELD TOO
	SETZ	T2,		;MAKE ROOM FOR OWNER
	TMNN	P1,POW		;GOT "OWNER" PROTECTION?
	JRST	FAJA66		;NO
	MOVD	T1,POW		;GET RETURNED "OWNER" PROTECTION
	PUSHJ	P,DPFPXO##	;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA66:	LSHC	T2,6		;T2:=NINE-BIT TOPS-10 LEVEL-D DISK PROTECTION
	HRROM	T2,.IOPRT(CO)	;SET FOR FILE SERVICE


;FILE ATTRIBUTES/ETC. ALL SET, READY FOR FILE OPERATIONS

FAJA90:	JRST	.POPJ1##	;SUCCESSFUL RETURN
;FAJAD - HELPER TO FAJA TO PROCESS DATA-TYPE FIELD

FAJAD1:	MOVD	T1,DTY		;GET DATA TYPE FIELD

;FIRST CHECK EXTRANEOUS KRUFT

	TFZE	T1,ZOD		;DID REMOTE REQUEST ZERO-ON-DELETE?
	TXO	P4,IM.ZOD	;YES, FLAG IT

;NOW LOOK FOR A REAL DATA-TYPE

	MOVEI	T4,.ICASC	;ASCII FILE MODE
	TFZE	T1,ASC		;ASCII DATA?
	JRST	FAJAD7		;YES
	MOVEI	T4,.ICBIN	;BINARY FILE MODE
	TFZE	T1,IMG		;IMAGE DATA?
	JRST	FAJAD7		;YES
	SKIPN	T4,T1		;ALL BITS USED UP?
	JRST	.POPJ1##	;YES, NO FILE DATA MODE THEN
	BADDAP	(MA.UNS,ATR!21,<FAJAD: Unknown or unsupported DTY bits>)

FAJAD7:	TXO	P4,IM.CMD	;SET FORCED IC.MOD FLAG
	JUMPE	T1,.POPJ1##	;HAPPY IF NOTHING LEFT OVER
	BADDAP	(MA.UNS,ATR!21,<FAJAD: Conflicting, unknown, or unsupported DTY bits>)
;FANTY  --  HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
;CALL IS:
;
;	PUSHJ	P,FANTY

FANTY1:	MOVE	T1,.IODPV(CI)	;ACCESSOR'S PROTOCOL LEVEL
	CAIGE	T1,007000	;7.0 OR LATER?
	JRST	FANTY3		;NO, DO IT THE GUESS-HOW WAY
	MOVD	T1,ADS		;YES, REMOTE EXPLICITLY CONTROLS NAME MSGS
	TFNN	T1,DN3		;DOES REMOTE WANT 3-PART NAME MESSAGES?
	JRST	.POPJ1##	;NO, NO NAME MESSAGES HERE THEN
	JRST	FANTY5		;YES, FORCE 3-PART NAME MESSAGES

FANTY3:	SKIPN	.WLDFL##	;DOES WILD THINK THERE ARE ANY WILDCARDS?
	JRST	.POPJ1##	;NO, NOTHING TO DO HERE THEN
FANTY5:	PUSHJ	P,FGNTY1	;SEE WHAT NAME MESSAGES NEED TO BE SENT
	 STOPCD	<FGNTY failed in FANTY>
	PUSHJ	P,FXNA01	;SEND NAME MESSAGES (P1 SET FROM ABOVE)
	 DEBUG	<FXNA failed in FANTY>,,,.POPJ##
	JRST	.POPJ1##	;SUCCESSFUL RETURN


;FSNTY  --  HANDLE ANY NAME MESSAGES DUE TO WILDCARDING (SECOND SET)
;CALL IS:
;
;	PUSHJ	P,FSNTY

FSNTY1:	MOVE	T1,.IODPV(CI)	;ACCESSOR'S PROTOCOL LEVEL
	CAIGE	T1,007000	;7.0 OR LATER?
	JRST	FSNTY3		;NO, DO IT THE GUESS-HOW WAY
	MOVD	T1,ADS		;YES, REMOTE EXPLICITLY CONTROLS NAME MSGS
	TFNN	T1,DN3		;DOES REMOTE WANT 3-PART NAME MESSAGES?
	JRST	.POPJ1##	;NO, NO NAME MESSAGES HERE THEN
	JRST	FSNTY5		;YES, FORCE 3-PART NAME MESSAGES

FSNTY3:	SKIPN	.WLDFL##	;DOES WILD THINK THERE ARE ANY WILDCARDS?
	JRST	.POPJ1##	;NO, NOTHING TO DO HERE THEN
FSNTY5:	PUSHJ	P,FCNTY1	;SEE WHAT NAME MESSAGES NEED TO BE SENT
	 STOPCD	<FCNTY failed in FSNTY>
	DMOVE	T1,.IOF3D(CO)	;PUT  .IOF3D(CO), .IOF3V(CO)
	DMOVEM	T1,.IOFND(CO)	;INTO .IOFND(CO), .IOFDV(IO) FOR FXNA01
	DMOVE	T1,.IOF3R(CO)	;PUT  .IOF3R(CO), .IOF3M(CO)
	DMOVEM	T1,.IOFDR(CO)	;INTO .IOFDR(CO), .IOFNM(IO) FOR FXNA01
	DMOVE	T1,.IOF3X(CO)	;PUT  .IOF3X(CO), .IOF3N(CO)
	DMOVEM	T1,.IOFEX(CO)	;INTO .IOFEX(CO), .IOFGN(IO) FOR FXNA01
	PUSHJ	P,FXNA01	;SEND NAME MESSAGES (P1 SET FROM ABOVE)
	 DEBUG	<FXNA failed in FSNTY>,,,.POPJ##
	JRST	.POPJ1##	;SUCCESSFUL RETURN
REPEAT 0,<

;FCICO  --  SET SLAVE CDB FROM PRIMARY CDB
;CALL IS:
;
;	MOVX	CI,<SRC>
;	MOVX	CO,<DST>
;	PUSHJ	P,FCICO
;	 error return
;	normal return
;
;Where <SRC> is the source CDB address; and <DST> is the destination
;CDB address.
;
;FCICO is used to copy the various file-specific information from the
;primary (remote-driven to FAL) I/O CDB to the slave (FAL-driven on
;behalf of the remote) I/O CDB, usually in preparation for file-level
;operations via the slave CDB.
;
;The error return is not exercised.
;
;On normal return the file information from the <SRC> CDB has been
;copied into the <DST> CDB.
;
;Uses T1, T2, T3, T4.

FCICO:

;FIRST THE GENERIC FILE INFORMATION

FCICO1:	MOVSI	T3,.IOBZC(CI)	;SOURCE ADDRESS
	HRRI	T3,.IOBZC(CO)	;DESTINATION ADDRESS
	BLT	T3,.IOEZC-1(CO)	;COPY OVER GENERIC FILE INFO
	DMOVE	T3,.IOIOC(CI)	;GET PRIMARY I/O AND ERROR CONTROL
	DMOVEM	T3,.IOIOC(CO)	;SET IN THE SLAVE
	MOVE	T3,.IOIOM(CI)	;GET PRIMARY I/O MODE CONTROL
	MOVEM	T3,.IOIOM(CO)	;SET IN THE SLAVE
	MOVE	T3,.IOUBS(CI)	;GET OVER-RIDING BYTE SIZE
	MOVEM	T3,.IOUBS(CO)	;SET IN THE SLAVE

;NOW GET OPERATING-SYSTEM-SPECIFIC JUICIES

FCICO2:	MOVSI	T3,.IOB10(CI)	;SOURCE ADDRESS
	HRRI	T3,.IOB10(CO)	;DESTINATION ADDRESS
	BLT	T3,.IOE10-1(CO)	;COPY OVER TOPS-10 FILE INFO

REPEAT	0,<			;SIGH
FCICO3:	MOVSI	T3,.IOB20(CI)	;SOURCE ADDRESS
	HRRI	T3,.IOB20(CO)	;DESTINATION ADDRESS
	BLT	T3,.IOE20-1(CO)	;COPY OVER TOPS-20 FILE INFO
> ;END REPEAT 0 ;SIGH

	JRST	.POPJ1##	;SUCCESSFUL RETURN
> ;END REPEAT 0
REPEAT	0,<	;NOT NEEDED

;FCOCI  --  SET PRIMARY CDB FROM SLAVE CDB
;CALL IS:
;
;	MOVX	CI,<DST>
;	MOVX	CO,<SRC>
;	PUSHJ	P,FCOCI
;	 error return
;	normal return
;
;Where <SRC> is the source CDB address; and <DST> is the destination
;CDB address.
;
;FCOCI is used to copy the various file-specific information from the
;slave (FAL-driven on behalf of the remote) I/O CDB to the primary
;(remote-driven to FAL) I/O CDB, usually in preparation for returning
;attributes/et al to the remote.
;
;The error return is not exercised.
;
;On normal return the file information from the <SRC> CDB has been
;copied into the <DST> CDB.
;
;Uses T1, T2, T3, T4.

FCOCI:

;FIRST THE GENERIC FILE INFORMATION

FCOCI1:	MOVSI	T3,.IOBZC(CO)	;SOURCE ADDRESS
	HRRI	T3,.IOBZC(CI)	;DESTINATION ADDRESS
	BLT	T3,.IOEZC-1(CI)	;COPY OVER GENERIC FILE INFO
	DMOVE	T3,.IOIOC(CO)	;GET SLAVE I/O AND ERROR CONTROL
	DMOVEM	T3,.IOIOC(CI)	;COPY INTO THE PRIMARY CDB
	MOVE	T3,.IOIOM(CO)	;GET SLAVE I/O MODE CONTROL
	MOVEM	T3,.IOIOM(CI)	;COPY INTO THE PRIMARY CDB

;NOW GET OPERATING-SYSTEM-SPECIFIC JUICIES

FCOCI2:	MOVSI	T3,.IOB10(CO)	;SOURCE ADDRESS
	HRRI	T3,.IOB10(CI)	;DESTINATION ADDRESS
	BLT	T3,.IOE10-1(CI)	;COPY OVER TOPS-10 FILE INFO

REPEAT	0,<			;SIGH
FCOCI3:	MOVSI	T3,.IOB20(CO)	;SOURCE ADDRESS
	HRRI	T3,.IOB20(CI)	;DESTINATION ADDRESS
	BLT	T3,.IOE20-1(CI)	;COPY OVER TOPS-20 FILE INFO
> ;END REPEAT 0 ;SIGH

	JRST	.POPJ1##	;SUCCESSFUL RETURN

> ;END REPEAT 0
;FGNTY  --  DETERMINE NAME MESSAGES TO BE SENT TO REMOTE
;CALL IS:
;
;	PUSHJ	P,FGNTY
;	 error return
;	normal return
;
;FGNTY returns a NTY (see DAP field definitions) mask of the name
;messages (volume/device, directory, file name/type/generation)
;which should be sent to the remote based on a wildcard file access
;request.
;
;CI and IO should both point to the primary CDB, and CO should point
;to the slave CDB.
;
;The error return is not exercised.
;
;On normal return P1/P2 has the resultant NTY mask of name messages
;which should be sent.
;
;Uses T1, T2, T3, T4, P1, P2.

FGNTY1:	MOVDII	P1,NTY,NFN	;ALWAYS RETURN FILENAME NAME MESSAGE
	MOVE	T1,.I1DEV(CO)	;GET CURRENT INPUT DEVICE
	CAME	T1,.I1DEV(CI)	;SAME AS LAST TIME HERE?
	TFO	P1,NVN		;NO, NEED A VOLUME NAME TOO
	MOVEM	T1,.I1DEV(CI)	;SET NEW LAST DEVICE
	MOVE	T2,[-<.PTMAX-.PTPPN-1>,,.PTPPN]  ;PROTOTYPE AOBJN'ER
	MOVE	T3,T2		;NEED TWO OF 'EM
	ADDI	T2,.I1PT2(CO)	;THIS TIMES' PATH
	ADDI	T3,.I1PT2(CI)	;LAST TIMES' PATH
FGNTY3:	MOVE	T1,0(T2)	;CURRENT DIRECTORY
	CAME	T1,0(T3)	;SAME AS LAST TIME?
	TFO	P1,NDN		;NO, NEED DIRECTORY NAME TOO
	MOVEM	T1,0(T3)	;SET NEW LAST DIRECTORY
	JUMPE	T1,.POPJ1##	;EXIT AT END OF DIRECTORY PATH
	AOBJP	T2,.+1		;ADVANCE
	AOBJN	T3,FGNTY3	; TO NEXT DIRECTORY LEVEL
	JRST	.POPJ1##	;SUCCESSFUL RETURN
;FCNTY  --  DETERMINE NAME MESSAGES TO BE SENT TO REMOTE (SECOND SET)
;CALL IS:
;
;	PUSHJ	P,FCNTY
;	 error return
;	normal return
;
;FCNTY returns a NTY (see DAP field definitions) mask of the name
;messages (volume/device, directory, file name/type/generation)
;which should be sent to the remote based on a wildcard file access
;request.
;
;CI and IO should both point to the primary CDB, and CO should point
;to the slave CDB.
;
;The error return is not exercised.
;
;On normal return P1/P2 has the resultant NTY mask of name messages
;which should be sent.
;
;Uses T1, T2, T3, T4, P1, P2.

FCNTY1:	MOVDII	P1,NTY,NFN	;ALWAYS RETURN FILENAME NAME MESSAGE
	MOVE	T1,.I1LK3+.RBDEV(CO)  ;GET CURRENT INPUT DEVICE
	CAME	T1,.I1LK3+.RBDEV(CI)  ;SAME AS LAST TIME HERE?
	TFO	P1,NVN		;NO, NEED A VOLUME NAME TOO
	MOVEM	T1,.I1LK3+.RBDEV(CI)  ;SET NEW LAST DEVICE
	MOVE	T2,[-<.PTMAX-.PTPPN-1>,,.PTPPN]  ;PROTOTYPE AOBJN'ER
	MOVE	T3,T2		;NEED TWO OF 'EM
	ADDI	T2,.I1PT3(CO)	;THIS TIMES' PATH
	ADDI	T3,.I1PT3(CI)	;LAST TIMES' PATH
FCNTY3:	MOVE	T1,0(T2)	;CURRENT DIRECTORY
	CAME	T1,0(T3)	;SAME AS LAST TIME?
	TFO	P1,NDN		;NO, NEED DIRECTORY NAME TOO
	MOVEM	T1,0(T3)	;SET NEW LAST DIRECTORY
	JUMPE	T1,.POPJ1##	;EXIT AT END OF DIRECTORY PATH
	AOBJP	T2,.+1		;ADVANCE
	AOBJN	T3,FCNTY3	; TO NEXT DIRECTORY LEVEL
	JRST	.POPJ1##	;SUCCESSFUL RETURN
;FFAD  --  CONVERT FILE ATTRIBUTES INTO DAPESE
;CALL IS:
;
;	PUSHJ	P,FFAD
;	 error return
;	normal return
;
;FFAD sets the DAP attributes/etc. fields in the primary CDB from
;the generic and os-specific file information (excluding names) contained
;in the slave CDB, usually in preparation to shipping the file attributes
;to the remote in response to an ACCESS request.
;
;FFAD expects the caller to have setup both IO and CI to point to the
;primary CDB, and CO to point to the slave CDB. In addition, P1/P2 are
;expected to hold the original remote-specified main attributes menu.
;
;On error return some incompatibility exists (an error code is in M0).
;
;On normal return the DAP attributes are set up and ready to be sent to
;the remote (e.g., via FXAT).
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.

FFAD01:	MOVE	P3,.IOIOC(CO)	;I/O CONTROL
	MOVE	P4,.IOIOM(CO)	;I/O MODE

;MAIN ATTRIBUTES FIELDS

FFAD10:	MOVD	P1,M02		;PRELOAD WITH REMOTE'S MAIN ATTRIBUTES MENU
	LDB	T1,[POINTR P3,IC.MOD]  ;PICKUP INTERNAL DATA MODE
	SETZB	T3,T4		;INITIALIZE FLAGS
	CAIE	T1,.ICDEF	;NONE (?) - DEFAULT IS ASCII
	CAIN	T1,.ICASC	;7-BIT ASCII?
	TFO	T3,ASC		;YES
	CAIN	T1,.ICAS8	;8-BIT ASCII?
	TFO	T3,ASC		;YES
	CAIN	T1,.ICEBC	;EBCDIC?
	TFO	T3,EBC		;YES
	CAIE	T1,.ICPIM	;PACKED IMAGE?
	CAIN	T1,.ICIMG	;OR NORMAL IMAGE?
	TFO	T3,IMG		;YES
	CAIE	T1,.ICBYT	;BYTE MODE?
	CAIN	T1,.ICBIN	;OR BINARY MODE?
	TFO	T3,IMG		;YES
	TFNN	T3,<ASC,EBC,IMG>;HAS A MODE BEEN SELECTED?
	BADDAP	(MA.UNS,ATR!21,<No (or unknown) DAP file data mode in FFAD10>)
	TXNE	P4,IM.ZOD	;ZERO ON DELETE?
	TFO	T3,ZOD		;YES
	MOVDM	T3,DTY		;SET MAIN ATTR DATA TYPE FIELD

	MOVDII	T3,ORG,$DVOSQ	;ALL FILE ACCESSES ARE SEQUENTIAL
	MOVDM	T3,ORG		;SET MAIN ATTR FILE ORGANIZATION FIELD

	TMO	P1,<DTY,ORG>	;DATATYPE AND ORGANIZATION ARE ALWAYS SENT
	MOVD1	T1,OST		;REMOTE (NFT) OPERATING SYSTEM TYPE
	MOVD	T3,DTY		;RETRIEVE DATA TYPE
	TFNN	T3,ASC		;DEALING IN ASCII CHARACTER DATA?
	JRST	FFAD13		;NO, BINARY

;SELECT RECORD FORMAT AND ATTRIBUTES FOR ASCII DATA

	TMNN	P1,RFM		;DID REMOTE SUPPLY "FORMAT"
	SKIPA	T2,DARFTB##(T1)	;NO, ASCII, GET APPROPRIATE RECORD FORMAT
	MOVD1	T2,RFM		;YES, SELECT REMOTE'S ASCII FORMATTING
	SETZ	T4,		;OTHER HALF OF POTENTIAL WORDS
	TMNN	P1,RAT		;DID REMOTE SUPPLY RECORD ATTRIBUTES?
	SKIPA	T3,DARATB##(T1)	;NO, ASCII, GET APPROPRIATE RECORD ATTRIBUTES
	MOVD	T3,RAT		;YES, SELECT REMOTE'S ASCII RECORD ATTRIBUTES
	TXNE	P3,IC.LSN	;WANT LINE-SEQUENCED ASCII?
	TFO	T3,LSA		;YES, THE POOR DUMB FOOL
	TXNE	P3,IC.CCC	;COBOL CARRIAGE CONTROL?
	TFO	T3,CCC		;YES
	TXNE	P3,IC.FCC	;FORTRAN CARRIAGE CONTROL?
	TFO	T3,FCC		;YES
	JRST	FFAD19		;CONTINUE WITH REST OF MAIN ATTR

;SELECT RECORD FORMAT AND ATTRIBUTES FOR IMAGE (BINARY) DATA

FFAD13:	TMNN	P1,RFM		;DID REMOTE SPECIFY RECORD FORMAT?
	SKIPA	T2,DBRFTB##(T1)	;NO, BINARY, GET APPROPRIATE RECORD FORMAT
	MOVD1	T2,RFM		;YES, USE REMOTE'S FORMAT
	SETZ	T4,		;OTHER HALF OF POTENTIAL WORDS
	TMNN	P1,RAT		;DID REMOTE SPECIFY RECORD ATTRIBUTES?
	SKIPA	T3,DBRATB##(T1)	;NO, BINARY, GET APPROPRIATE RECORD ATTRIBUTES
	MOVD	T3,RAT		;YES, USE REMOTE'S RECORD ATTRIBUTES
FFAD19:	TXNE	P3,IC.MCY	;SLAVE FILE MACY11-PACKED?
	TFO	T3,MCY		;YES
	MOVD1M	T2,RFM		;SET MAIN ATTRIBUTES RECORD FORMAT FIELD
	MOVDM	T3,RAT		;SET MAIN ATTRIBUTES RECORD ATTRIBUTES FIELD
	TMO	P1,<RFM,RAT>	;AND FLAG THEM IN THE MENU TOO

FFAD20:	TMZ	P1,<BLS,MRS,ALQ>;CLEAR IN CASE DON'T HAVE ANYTHING TO SAY
	SKIPN	T3,.IOBSZ(CO)	;GET LOGICAL DATA BYTE SIZE
	BADDAP	(MA.UNS,ATR!36,<No byte size in FFAD20>)
	MOVD	T1,DTY		;***RETRIEVE COPY OF DATA TYPE
	TFNE	T1,ASC		;*** ASCII DATA?
	MOVEI	T3,^D08		;*** YES, TELL NET WE ARE SENDING 8-BIT DATA
	MOVD1M	T3,BSZ		;SET MAIN ATTR BYTE SIZE FIELD
	TMO	P1,BSZ		;AND FLAG IT IN THE MENU TOO

FFAD21:	SKIPN	T3,.IORSZ(CO)	;DO WE HAVE A RECORD SIZE VALUE?
	JRST	FFAD22		;NO
	MOVD1M	T3,MRS		;YES, SET MAIN ATTR RECORD SIZE FIELD
	TMO	P1,MRS		;AND FLAG IT IN THE MENU

FFAD22:	SKIPN	T3,.IOBLS(CO)	;DO WE HAVE A BLOCKSIZE VALUE?
	JRST	FFAD27		;NO
	MOVD1M	T3,BLS		;YES, SET MAIN ATTR BLOCKSIZE FIELD
	TMO	P1,BLS		;AND FLAG IT IN THE MENU

FFAD23:	SKIPN	T1,.IOALB(CO)	;GOT A TOTAL ALLOCATION QUANTITY?
	JRST	FFAD24		;NO
	IDIV	T1,.IOBLS(CO)	;CONVERT TO "BLOCK" ALLOCATION
	CAIE	T2,0		;EXACT FIT?
	ADDI	T1,1		;NO, ALLOW FOR PARTIAL LAST BLOCK
	MOVD1M	T1,ALQ		;SET MAIN ATTR ALLOCATION QUANTITY FIELD
	MOVD1M	T1,HBK		;ALSO CALL IT HIGHEST VIRTUAL BLOCK ALLOCATED
	TMO	P1,<ALQ,HBK>	;AND FLAG THEM IN THE MENU TOO

FFAD24:	SKIPN	T1,.IOLNB(CO)	;GOT A DATA LENGTH QUANTITY?
	JRST	FFAD27		;NO
	IDIV	T1,.IOBLS(CO)	;T1:=LENGTH OF FILE IN BLOCKS
	CAIE	T2,0		;EXACT FIT?
	ADDI	T1,1		;ALLOW FOR TRAILING PARTIAL BLOCK
	MOVD1M	T1,EBK		;SET END-OF-FILE VIRTUAL BLOCK NUMBER
	ADDI	T2,1		;T2:=FIRST FREE BYTE (MAY BE IN NEXT BLOCK)
	MOVD1M	T2,FFB		;SET FIRST FREE BYTE IN END OF FILE BLOCK
	TMO	P1,<EBK,FFB>	;NOTE EOF AND FFB FIELDS PRESENT

FFAD27:	MOVD1	T3,RFM		;RETRIEVE RECORD FORMAT
	CAIE	T3,$DVFVF	;VARIABLE WITH FIXED CONTROL?
	JRST	FFAD28		;NO
	MOVD	T3,RAT		;[40] RECORD ATTRIBUTES
	TFNN	T3,LSA		;[40] FVF LEGAL ONLY WITH LSA
	BADDAP	(MA.UNS,ATR!23,<Record format not supported at FFAD27>)

FFAD28:	TMO	P1,FOP		;[6] "ECHO" WHATEVER FOP THE REMOTE SENT TO US
	MOVD	T3,RAT		;[40] GET RECORD ATTRIBUTES
	TFNN	T3,LSA		;[40] DOING LSA?
	JRST	FFAD30		;[40] NO
	SKIPG	T2,.IDFSZ(CO)	;[40] FETCH INPUT "FIXED HEADER SIZE"
	MOVEI	T2,6		;[40] NONE (LOCAL), USE OUR VALUE
	MOVD1M	T2,FSZ		;[40] SET "FIXED CONTROL" SIZE
	TMO	P1,FSZ		;[40] AND FLAG FSZ IN THE MENU

FFAD30:	MOVE	T1,.IODCH(CO)	;GET THE SLAVE FILE/DEVICE CHARACTERISTICS
	PUSHJ	P,FFADC1	;CONVERT TO DAP "DEV" CHARACTERISTICS
	 JFCL			;HO HUM
	MOVDM	T2,DEV		;SET DAP FILE/DEVICE CHARACTERISTICS
	TMO	P1,DEV		;SET MAIN ATTR DEV CHAR FIELD

	MOVDM	P1,M02		;SET MAIN ATTRIBUTES MENU FIELD


;ALLOCATION ATTIBUTES

FFAD50:	SETZB	P1,P2		;INIT ALLOCATION ATTR MENU
	MOVD	T3,ALQ		;MAIN ATTR ALLOCATION QUANTITY
	MOVDM	T3,AAL		;COPY INTO ALLOC ATTR ALLOCATION QUANTITY
	MOVD	T3,M02		;MAIN ATTR MENU
	TMNN	T3,ALQ		;AN ALLOCATION QUANTITY?
	TMO	P1,AAL		;YES
	SETZB	T3,T4		;INIT FLAGS
	MOVD	T1,FOP		;MAIN ATTR FILE ACCESS OPTIONS
	TFNE	T1,CBT		;CONTIGUOUS BEST TRY?
	TFO	T3,ACB		;YES, MARK IN ALLOCATION OPTIONS
	TFNE	T1,CTG		;CONTIGUOUS ALLOCATION REQUIRED?
	TFO	T3,ACT		;YES, MARK IN ALLOCATION OPTIONS
	MOVDM	T3,ALP		;SET ALLOC ATTR ALLOCATION OPTIONS FIELD
	TFNE	T3,<ACB,ACT>	;ANYTHING IN OPTIONS?
	TMO	P1,ALP		;YES, MARK IT IN THE MENU
	SKIPN	T3,.I1LKP+.RBPOS(CO)  ;ALLOCATION ADDRESS SUPPLIED?
	JRST	FFAD56		;NO
	MOVD1M	T3,LOC		;SET ALLOC ATTR ALLOCATION ADDRESS FIELD
	MOVDII	T3,ALN,ALB	;THE ALIGN-TO-SPECIFIED-BLOCK BIT
	MOVDM	T3,ALN		;SET ALLOC ATTR ALIGNMENT CONTROL FIELD
	TMO	P1,<ALN,LOC>	;MARK FIELDS PRESENT IN MENU
FFAD56:	MOVDM	P1,M11		;SET ALLOCATION ATTRIBUTES MENU


;DATE/TIME ATTRIBUTES

FFAD70:	SETZB	P1,P2		;INITIALIZE MENU SELECTION
	MOVE	T4,.IODPV(IO)	;CARRY AROUND DAP PROTOCOL VERSION
FFAD71:	SKIPE	T3,.IOCDT(CO)	;DO WE HAVE A CREATION DATE/TIME?
	TMO	P1,CDT		;YES, FLAG THE MENU ACCORDINGLY
	MOVD1M	T3,CDT		;SET DATE/TIME ATTR CREATION FIELD
	SKIPE	T3,.IOUDT(CO)	;DO WE HAVE AN UPDATE DATE/TIME?
	TMO	P1,UDT		;YES, FLAG THE MENU ACCORDINGLY
	MOVD1M	T3,UDT		;SET DATE/TIME ATTR UPDATE FIELD
	SKIPE	T3,.IOEDT(CO)	;DO WE HAVE AN EXPIRATION DATE/TIME?
	TMO	P1,EDT		;YES, FLAG THE MENU TOO
	MOVD1M	T3,EDT		;SET DATE/TIME ATTR EXPIRATION FIELD
FFAD73:	CAIGE	T4,006000	;DAP 6.0 OR LATER?
	JRST	FFAD79		;NO, REST OF FIELDS UNKNOWN
	SKIPE	T3,.IOBDT(CO)	;DO WE HAVE AN BACKUP DATE/TIME?
	TMO	P1,BDT		;YES, FLAG THE MENU
	MOVD1M	T3,BDT		;SET DATE/TIME ATTR BACKUP FIELD
	SKIPE	T3,.IOPDT(CO)	;DO WE HAVE A PHYSICAL CREATE DATE/TIME?
	TMO	P1,PDT		;YES, FLAG THE MENU APPROPRIATELY
	MOVD1M	T3,PDT		;SET DATE/TIME ATTR PHYSICAL CREATE FIELD
	SKIPE	T3,.IOADT(CO)	;DO WE HAVE AN ACCESS DATE/TIME?
	TMO	P1,ADT		;YES, FLAG THE MENU
	MOVD1M	T3,ADT		;SET DATE/TIME ATTR ACCESS FIELD

FFAD79:	MOVDM	P1,M13		;SET DATE/TIME ATTRIBUTES MENU


;PROTECTION ATTRIBUTES
;
;FFAD8? ASSUMES PROTECTION FLAGS FIELDS ARE ONLY ONE WORD LONG. AS THIS
;IS NOT GUARANTEED, AT LEAST CAUSE ASSEMBLY ERROR IF IT EVER CHANGES

	IFN	$DLPSY-1,<PRINTX ?PSY field not one word long in FFAD80>
	IFN	$DLPOW-1,<PRINTX ?POW field not one word long in FFAD80>
	IFN	$DLPGR-1,<PRINTX ?PGR field not one word long in FFAD80>
	IFN	$DLPWL-1,<PRINTX ?PWL field not one word long in FFAD80>

FFAD80:	SETZB	P1,P2		;INITIAL MENU FLAGS
	SKIPN	T3,.IOPRT(CO)	;GET PROTECTION CODE
	JRST	FFAD88		;NONE
	LSHC	T3,-6		;REDUCE TO OWNER PROTECTION
	ANDI	T3,7		;AND ONLY OWNER PROTECTION
	MOVE	T2,FPDPTO##(T3)	;TRANSLATE TO DAPISH PROTECTION FLAGS
	MOVDM	T2,POW		;SET PROTECTION ATTR OWNER FIELD
	LSHC	T3,3		;GET GROUP CODE
	ANDI	T3,7		;AND ONLY THE GROUP CODE
	MOVE	T2,FPDPTB##(T3)	;TRANSLATE TO DAPISH PROTECTION FLAGS
	MOVDM	T2,PGR		;SET PROTECTION ATTR GROUP FIELD
	LSHC	T3,3		;GET WORLD ACCESS FIELD
	ANDI	T3,7		;AND ONLY WORLD ACCESS FIELD
	MOVE	T2,FPDPTB##(T3)	;TRANSLATE TO DAPISH PROTECTION FLAGS
	MOVDM	T2,PWL		;SET PROTECTION ATTR WORLD FIELD
	TMO	P1,<POW,PGR,PWL>;SELECT MENU FIELDS
FFAD88:	MOVDM	P1,M14		;SET PROTECTION ATTRIBUTES MENU FIELD

;ALL DONE CONVERTING FILE ATTRIBUTES TO DAP ATTRIBUTES

	JRST	.POPJ1##
;FFADC - HELPER TO CONVERT .IODCH INTO DAP "DEV" FIELD

FFADC1:	SETZB	T2,T3		;INITIALLY NO FLAGS
	TXZE	T1,IC.REC	;"RECORD-ORIENTED"?
	TFO	T2,REC		;YES
	TXZE	T1,IC.CCL	;CARRIAGE-CONTROL?
	TFO	T2,CCL		;YES
	TXZE	T1,IC.TRM	;TERMINAL?
	TFO	T2,TRM		;YES
	TXZE	T1,IC.MDI	;MULTIPLE DIRECTORIES?
	TFO	T2,MDI		;YES
	TXZE	T1,IC.SDI	;SINGLE-DIRECTORY?
	TFO	T2,SDI		;YES
	TXZE	T1,IC.SQD	;SEQUENTIAL BLOCK ORIENTED?
	TFO	T2,SQD		;YES
	TXZE	T1,IC.NUL	;NUL DEVICE?
	TFO	T2,NUL		;YES
	TXZE	T1,IC.FOD	;FILE-ORIENTED DEVICE?
	TFO	T2,FOD		;YES
	TXZE	T1,IC.DSH	;SHARABLE?
	TFO	T2,DSH		;YES
	TXZE	T1,IC.SPL	;SPOOLED DEVICE?
	TFO	T2,SPL		;YES
	TXZE	T1,IC.MNT	;MOUNTED?
	TFO	T2,MNT		;YES
	TXZE	T1,IC.DMT	;MARKED FOR DISMOUNT?
	TFO	T2,DMT		;YES
	TXZE	T1,IC.ALL	;DEVICE ALLOCATED?
	TFO	T2,ALL		;YES
	TXZE	T1,IC.IDV	;CAN DEVICE DO INPUT?
	TFO	T2,IDV		;YES
	TXZE	T1,IC.ODV	;CAN DEVICE DO OUTPUT?
	TFO	T2,ODV		;YES
	TXZE	T1,IC.SWL	;IS DEVICE SOWTWARE-WRITE-LOCKED?
	TFO	T2,SWL		;YES
	TXZE	T1,IC.AVL	;IS DEVICE AVAILABLE?
	TFO	T2,AVL		;YES
	TXZE	T1,IC.ELG	;ERROR-LOGGING ENABLED?
	TFO	T2,ELG		;YES
	TXZE	T1,IC.MBX	;A MAILBOX?
	TFO	T2,MBX		;YES
	TXZE	T1,IC.RTM	;REAL-TIME DEVICE?
	TFO	T2,RTM		;YES
	TXZE	T1,IC.RAD	;RANDOM-ACCESS?
	TFO	T2,RAD		;YES
	TXZE	T1,IC.DRC	;READ-CHECKING ENABLED?
	TFO	T2,DRC		;YES
	TXZE	T1,IC.DWC	;WRITE-CHECKING ENABLED?
	TFO	T2,DWC		;YES
	TXZE	T1,IC.FRN	;FOREIGN DEVICE?
	TFO	T2,FRN		;YES
	TXZE	T1,IC.NDV	;NETWORK DEVICE?
	TFO	T2,NDV		;YES
	TXZE	T1,IC.GDV	;GENERIC DEVICE?
	TFO	T2,GDV		;YES

	TXZ	T1,IC.CTG	;*** CLEAR OUT THE CONFIG FLAG
	CAIE	T1,0		;*** SHOULD HAVE NOTHING LEFT OVER
	STOPCD	<Leftover .IODCH bits in FFADC>  ;***

	JRST	.POPJ1##	;SUCCESSFUL RETURN
;FACL  --  HANDLE "ACCESS OPTIONS" SPECIFIED AT ACCOMP TIME
;CALL IS:
;
;	PUSHJ	P,FACL01
;	 error return
;	normal return
;
;At this time the error return is unused.
;
;On normal return the slave CDB has been set according to the received
;ACCOMP options (if none, the slave is left set as specifed by the FOP
;field of the originating main attributes message). Only the normal
;"CLOSE" operation is accepted, if the ACCOMP function is "SKIP", "ABORT",
;or the like the ACCOMP options are ignored.

FACL01:	MOVD1	T1,A2F		;GET ACCOMP FUNCTION-TYPE FIELD
	CAIE	T1,$DVACL	;"CLOSE" IS THE ONLY ONE TO TRUST
	JRST	.POPJ1##	;ALL OTHERS (SKIP, ABORT, ETC.) WE IGNORE HERE
	MOVE	T3,.IOIOM(CO)	;GET THE SLAVE I/O MODE CONTROL
	TXZ	T3,IM.CXX	;CLEAR CLOSE OPTIONS
	MOVD	T1,AFO		;GET ACCOMP "FOP" FIELD
	FJUMPN	T1,AFO,FACL03	;USE AFO IF SPECIFIED
	MOVD	T1,FOP		;OTHERWISE USE NORMAL "FOP" FIELD
FACL03:	TFNE	T1,DLT		;DELETE FILE ON CLOSE?
	TXO	T3,IM.CDL	;YES
	TFNE	T1,SPC		;PRINT FILE ON CLOSE?
	TXO	T3,IM.CPR	;YES
	TFNE	T1,SCF		;SUBMIT FILE ON CLOSE?
	TXO	T3,IM.CSU	;YES
	MOVEM	T3,.IOIOM(CO)	;SET UPDATED I/O MODE FOR SLAVE
	TXNN	T3,IM.CPR!IM.CSU;TRYING TO PRINT OR SUBMIT?
	JRST	.POPJ1##	;NO, ALL SET
	PUSHJ	P,NONPP1	;YES, DISALLOW IF NETPPN ACCESS
	 POPJ	P,		;PRINT/SUBMIT DISALLOWED
	JRST	.POPJ1##	;ALL OK
;FXAT  --  SHIP ATTRIBUTES MESSAGES
;CALL IS:
;
;	MOVX	P1,<ADS>
;	PUSHJ	P,FXAT00/FXAT01
;	 error return
;	normal return
;
;Where <ADS> is the "access display list" of attributes desired.
;
;FXAT will ship to the remote accessor various and sundry attributes
;messages as specified by the requested attributes in the "access
;display list" (see the ADS field definition in the DAP ACCESS
;message). The caller must set up the various attributes fields
;before calling FXAT!
;
;On error return the network died (error code in M0).
;
;On normal return all requested attributes messages have been given
;to network service (not guaranteed shipped yet).
;
;Uses T1, T2, T3, T4.

FXAT00:	PUSHJ	P,.SAVE4##	;SAVE THE P'S
FXAT01:

;MAIN ATTRIBUTES

FXAT10:	TFNN	P1,DMA		;REMOTE WANT MAIN ATTRIBUTES?
	JRST	FXAT15		;NO
	MOVEI	T2,$DHATR	;YES
	PUSHJ	P,XDDAP0##	;SEND MAIN ATTRIBUTES
	 PJRST	NETERO##	;[21] ERROR

;KEY DEFINITION ATTRIBUTES

FXAT15:;TFNN	P1,DKD		;REMOTE WANT KEY DEFINITIONS?
;	JRST	FXAT20		;NO
;	MOVEI	T2,$DHKYX	;YES
;	PUSHJ	P,XDDAP0##	;SEND KEY DEFINITION ATTRIBUTES
;	 PJRST	NETERO##	;[21] ERROR

;ALLOCATION ATTRIBUTES

FXAT20:	TFNN	P1,DAA		;REMOTE WANT ALLOCATION?
	JRST	FXAT25		;NO
	MOVEI	T2,$DHALC	;YES
	PUSHJ	P,XDDAP0##	;SEND ALLOCATION ATTRIBUTES
	 PJRST	NETERO##	;[21] ERROR

;SUMMARY ATTRIBUTES

FXAT25:;TFNN	P1,DSA		;REMOTE WANT SUMMARY?
;	JRST	FXAT30		;NO
;	MOVEI	T3,$DHSUM	;YES
;	PUSHJ	P,XDDAP0##	;SEND SUMMARY ATTRIBUTES
;	 PJRST	NETERO##	;[21] ERROR

;DATE/TIME ATTRIBUTES

FXAT30:	TFNN	P1,DDT		;REMOTE WANT DATE/TIME
	JRST	FXAT35		;NO
	MOVEI	T2,$DHTIM	;YES
	PUSHJ	P,XDDAP0##	;SEND DATE/TIME ATTRIBUTES
	 PJRST	NETERO##	;[21] ERROR

;PROTECTION ATTRIBUTES

FXAT35:	TFNN	P1,DFP		;REMOTE WANT PROTECTION?
	JRST	FXAT40		;NO
	MOVEI	T2,$DHPRT	;YES
	PUSHJ	P,XDDAP0##	;SEND PROTECTION ATTRIBUTES
	 PJRST	NETERO##	;[21] ERROR

;ACCESS CONTROL LIST

FXAT40:;TFNN	P1,FAC		;REMOTE WANT ACCESS CONTROL LIST?
;	JRST	FXAT90		;NO
;	MOVEI	T2,$DHACL	;YES
;	PUSHJ	P,XDDAP0##	;SEND ACCESS CONTROL LIST ATTRIBUTES
;	 PJRST	NETERO##	;[21] ERROR

;RESULTANT FILE SPECIFICATION (MUST BE DONE LAST)

FXAT90:	TFNN	P1,DNM		;REMOTE WANT FILE NAME?
	JRST	.POPJ1##	;NO
	MOVDII	P1,NTY,NFS	;YES
	PJRST	FXNA01		;SEND RESULTANT FILE SPEC NAME MESSAGE.
;FXNA  --  SEND NAME MESSAGES
;CALL IS:
;
;	MOVX	P1,<NTY>
;	PUSHJ	P,FXNA00/FXNA01
;	 error return
;	normal return
;
;Where <NTY> is the mask of name messages to be sent.
;
;FXNA sends name messages to the remote, based on the <NTY> mask
;passed by the caller. The name strings used come from the slave
;CDB (.IOFST, etc.).
;
;IO (and CI) have the address of the primary CDB, and CO has the
;address of the slave CDB.
;
;On error return the network died.
;
;On normal return the requested name messages have been sent.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.

FXNA01:	XMOVEI	T1,FXNXTO	;TYPER
	PUSHJ	P,.TYOCH##	;SET CHARACTER STUFFER
	MOVE	P3,T1		;REMEMBER PREVIOUS
	MOVE	P4,[POINT 7,.IDNMS(CI)]  ;PROTOTYPE BYTE STUFFER

;VOLUME (DEVICE) NAME

FXNA10:	TFNN	P1,NVN		;NEED A VOLUME NAME?
	JRST	FXNA20		;NO
	MOVEM	P4,.IOXTO(CI)	;YES
	SKIPN	T1,.IOFDV(CO)	;[SLAVE] ADDRESS OF DEVICE NAME STRING
	 DEBUG	<No device name string in FXNA10>,,,.POPJ##
	PUSHJ	P,.TSTRG##	;SET IT UP
	PUSHJ	P,.TCOLN##	;AND A ":" TO KEEP DAP HAPPY
	MOVDII	T1,NTY,NVN	;THIS IS A VOLUME NAME
	PUSHJ	P,FXNA90	;SEND NAME MESSAGE
	 JRST	FXNA80		;NET DIED

;DIRECTORY NAME

FXNA20:	TFNN	P1,NDN		;NEED A DIRECTORY NAME?
	JRST	FXNA30		;NO
	MOVEM	P4,.IOXTO(CI)	;YES
	PUSHJ	P,.TLBRK##	;SET "["
	SKIPE	T1,.IOFDR(CO)	;[SLAVE] ADDRESS OF DIRECTORY NAME STRING
	PUSHJ	P,.TSTRG##	;SET DIRECTORY (IF ANY)
	PUSHJ	P,.TRBRK##	;CLOSING "]"
	MOVDII	T1,NTY,NDN	;THIS IS A DIRECTORY NAME
	PUSHJ	P,FXNA90	;SEND NAME MESSAGE
	 JRST	FXNA80		;NET DIED

;FILE (AND EXTENSION (AND GENERATION)) NAME

FXNA30:	TFNN	P1,NFN		;WANT FILE (ETC.) NAME
	JRST	FXNA40		;NO
	MOVEM	P4,.IOXTO(CI)	;YES
	SKIPE	T1,.IOFNM(CO)	;GET FILE NAME (IF ANY)
	PUSHJ	P,.TSTRG##	;SET IT UP
	SKIPN	.IOFEX(CO)	;IF A FILE TYPE,
	SKIPE	.IOFGN(CO)	;OR A GENERATION
	CAIA			;THEN NEED A DOT
	JRST	FXNA33		;ALL DONE (NO .TYPE.GENERATION)
	PUSHJ	P,.TDOT##	;SEPARATE FROM EXTENSION
	SKIPE	T1,.IOFEX(CO)	;GET FILE TYPE (IF ANY)
	PUSHJ	P,.TSTRG##	;SET IT TOO
	SKIPN	.IOFGN(CO)	;GOT A GENERATION TOO?
	JRST	FXNA33		;NO
	PUSHJ	P,.TDOT##	;YES
	MOVE	T1,.IOFGN(CO)	;GENERATION STRING
	PUSHJ	P,.TSTRG##	;SET IT TOO
FXNA33:	MOVDII	T1,NTY,NFN	;FILE NAME
	PUSHJ	P,FXNA90	;SEND NAME MESSAGE
	 JRST	FXNA80		;DIED

;FULL FILE SPECIFICATION

FXNA40:	TFNN	P1,NFS		;WANT FULL FILE SPECIFICATION?
	JRST	FXNA50		;NO
	MOVEM	P4,.IOXTO(CI)	;YES
	MOVE	T1,CO		;SELECT SLAVE CDB FOR FILE NAME STRINGS
	PUSHJ	P,.TOCFL##	;TYPE OUT THE FILE SPECIFICATION STRING
	 WARN	TFF,<TOCFL failed in FXNA40>,,,.POPJ##
	MOVDII	T1,NTY,NFS	;FILE SPECIFICATION
	PUSHJ	P,FXNA90	;SEND NAME MESSAGE
	 JRST	FXNA80		;DIED

;DONE, RESTORE AND EXIT

FXNA50:	MOVE	T1,P3		;ORIGINAL OUTPUT ROUTINE
	PUSHJ	P,.TYOCH##	;RESTORE ORIGINAL
	JRST	.POPJ1##	;SUCCESSFUL RETURN


;ABORT NAME MESSAGES

FXNA80:	MOVE	T1,P3		;ORIGINAL OUTPUT ROUTINE
	PUSHJ	P,.TYOCH##	;[21] RESTORE ORIGINAL
	PJRST	NETERO##	;[21] ISSUE ERROR AND RETURN


;HELPER TO BUILD CHARACTER STRING

FXNA90:	MOVDM	T1,NTY		;SET NAME TYPE
	SETZ	T1,		;TERMINATING NULL
	MOVE	T2,.IOXTO(CI)	;BYTE STUFFER
	IDPB	T1,T2		;TERMINATE ASCIZ STRING
	TLNE	T2,760000	;ON A WORD BOUNDRY?
	JRST	.-2		;NOT YET
	MOVEI	T2,$DHNAM	;NAME MESSAGE CODE
	PUSHJ	P,XDDAP0##	;[21] SEND A NAME MESSAGE
	 PJRST	NETERO##	;[21] NET DIED?
	JRST	.POPJ1##	;[21] SUCCESS
;AUXILIARY HELPERS

FXNXTO:	IDPB	T1,.IOXTO(CI)	;STUFF THIS BYTE VIA THE PRIMARY CDB
	POPJ	P,		;RETURN TO SCAN
;FXSTS  --  SEND DAP STATUS MESSAGE
;CALL IS:
;
;	MOVX	T1,<STS>
;	MOVX	T2,<STV>
;	PUSHJ	P,FXSTS
;	 error return
;	normal return
;
;where <STS> is the 16-bit DAP status value; <STV> is the "secondary"
;status value.
;
;On error return the network died, error code is in M0.
;
;On normal return the specified status information has been encapsulated
;and sent to the remote "active" DAP process.
;
;Uses T1, T2, T3, T4.

FXSTS0::PUSHJ	P,.SAVE4##	;PRESERVE THE P'S HERE
FXSTS1::MOVD1M	T1,STC		;SET DAP STATUS CODE (MAJOR STATUS)
	MOVD1M	T2,STV		;SET DAP SECONDARY STATUS VALUE
	SETZB	T1,T2		;ZERO DAP VALUE
	MOVDM	T1,SRA		;CLEAR STATUS RECORD ADDRESS
	MOVDM	T1,SRN		;CLEAR STATUS RECORD NUMBER
	MOVDII	T1,M09,<STC,SRA,SRN,STV>  ;INVISIBLE MENU FOR ALL BUT TEXT
	MOVDM	T1,M09		;SET STATUS [INVISIBLE] MENU FIELD
	MOVEI	T2,$DHSTS	;STATUS MESSAGE TYPE
	PUSHJ	P,XDDAP1##	;SEND A DAP STATUS MESSAGE
	 PJRST	NETERO##	;[21] NET DIED?
	PUSHJ	P,XDFLS1##	;[21] FLUSH THE PIPE NOW
	 PJRST	NETERO##	;[21] NET DIED?
	JRST	.POPJ1##	;[21] SUCCESS
;FX7ACK  --  SEND DAP ACK IF PROTOCOL VERSION 7.0 OR LATER
;CALL ISL
;
;	PUSHJ	P,FX7ACK
;	 error return
;	normal return
;
;On error return the network has died.
;
;On normal return an ACK message has been built (but not necessarily
;transmitted) if the remote DAP process supports version 7.0 or later
;protocol.
;
;Uses T1, T2, T3, T4.

FX7ACK:	MOVE	T1,.IODPV(IO)	;GET THE DAP PROTOCOL VERSION
	CAIGE	T1,007000	;VERSION 7.0 OR LATER?
	JRST	.POPJ1##	;NO, JUST IGNORE
	PUSHJ	P,XDACK1##	;[21] YES, SEND AN ACK
	 PJRST	NETERO##	;[21] NET DIED?
	JRST	.POPJ1##	;[21] SUCCESS
	SUBTTL	General-purpose non-specific subroutines

;F8BAZ - COPY 8-BIT STRING INTO 7-BIT STRING
;Call is:
;
;	MOVX	T1,<DST>
;	MOVX	P1,<8BP>
;	PUSHJ	P,F8BAZ
;	 error return
;	normal return
;
;Where <DST> is the address for the resultant ASCIZ string; and <8BP>
;is the address of the 8-bit byte string

F8BAZ8:	HRLI	T1,(POINT 8,)	;[34] BYTE STUFFER
	SKIPA			;[34] JOIN COMMON CODE

F8BAZ:	HRLI	T1,(POINT 7,)	;[34] BYTE STUFFER
	HLRZ	P2,0(P1)	;[34] COUNT OF BYTES FOLLOWING
	JUMPLE	P2,[SETZM 0(T1)		;JUST CLEAR FIRST WORD
		JRST	.POPJ1##]	;AND LET IT GO AT THAT
	HRLI	P1,(POINT 8,)	;BYTE SNATCHER
	ADDI	P1,1		;POINT TO 8-BIT BYTE STRING

;LOOP COPYING BYTES

F8BAZ3:	ILDB	T2,P1		;GET NEXT BYTE
	IDPB	T2,T1		;AND STASH IT
	SOJG	P2,F8BAZ3	;LOOP FOR REST OF STRING
	SETZ	T2,		;DONE, A NULL
	IDPB	T2,T1		;TO ASCIZIZE THE STRING
	TLNE	T1,720000	;END OF WORD YET?
	JRST	.-2		;NO, CLEAR OUT REST OF WORD
	JRST	.POPJ1##	;YES, HAPPY
;F8BUP - CONVERT 8-BIT USERID STRING INTO PPN
;CALL IS:
;
;	MOVX	P1,<8BP>
;	PUSHJ	P,F8BUP
;	 error return
;	normal return
;
;Where <8BP> is the address of the 8-bit byte string.
;
;If the string is a regular ppn it is translated directly into a
;binary-form ppn; If the string is not a direct representation of
;a ppn (i.e., it doesn't start with either a "[" character or an
;octal digit) then the string is treated as a "name" which will
;be matched from SYS:USERS.TXT, and translated accordingly into a
;ppn.
;
;On normal return the ppn is in T1.

F8BUP:	HLRZ	P2,@P1		;GET BYTE COUNT
	JUMPLE	P2,.POPJ1##	;NULL STRING, NULL PPN
	HRLI	P1,(POINT 8,,32);BYTE SNATCHER
	MOVE	T4,P1		;COPY OF USERID STRING POINTER
	ILDB	T1,T4		;COPY OF FIRST USERID CHARACTER
	CAIE	T1,"<"		;> (MATCH ANGLE BRACKETS)
	CAIN	T1,"["		;LEADING "NOISE" CHARACTER?
	SOSA	P2		;YEAH, DISCOUNT THE "[" (OR WHATEVER)
	JRST	F8BUP5		;NO, TREAT USERID STRING AS IS
	IBP	P1		;SKIP LEADING NOISE CHARACTER
	MOVE	T4,P2		;REMAINING USERID STRING LENGTH
	ADJBP	T4,P1		;POINT TO LAST USERID CHARACTER
	LDB	T2,T4		;COPY OF LAST USERID CHARACTER
	CAIN	T2,2(T1)	;MATCHING TERMINATOR?
	SOS	P2		;YES, DISCOUNT TRAILING NOISE CHARACTER
F8BUP5:

IFN FTUTXT,<
	PUSHJ	P,F8BUN		;SEE IF NAME<=>PPN TRANSLATION APPLICABLE
	 POPJ	P,		;ERROR, NO SUCH NAME
> ;END IFN FTUTXT

;EXTRACT PROJECT NUMBER FIRST

	SETZ	T1,		;INITIALIZE T1
	PUSHJ	P,F8XOC		;EXTRACT THE OCTAL NUMBER
	 JUMPE	T2,[SETO  T1,		;ERROR, GET A MINUS 1
		    ADJBP T1,P1		;BACK UP TO THE BYTE WE ATE
		    MOVEI T2,1(P2)	;GET THE LENGTH OF THE STRING
		    PJRST F8BUNA]	;GO ASK ACTDAE ABOUT THE NAME
	HRLZ	T1,T2		;POSITION PROJECT NUMBER
	CAIN	T3,","		;BETTER BE COMMA SEPARATOR
	CAIG	P2,0		;WITH MORE CHARACTERS LEFT TO COME
	POPJ	P,		;NO! JUNK FORMAT PPN

;NOW READ IN THE PROGRAMMER NUMBER

	PUSHJ	P,F8XOC		;EXTRACT THE OCTAL PROGRAMMER
	JUMPE	T2,.POPJ##	;NULL IS ERROR HERE
	HRR	T1,T2		;POSITION PROGRAMMER
	JRST	.POPJ1##	;RETURN WITH PPN IN T1
;EXTRACT OCTAL NUMBER (HELPER FOR F8BUP)

F8XOC:	SETZ	T2,		;INITIALIZE NUMBER
F8XOC3:	ILDB	T3,P1		;NEXT BYTE
	CAIL	T3,"0"		;OCTAL
	CAILE	T3,"7"		; DIGIT?
	SOJA	P2,.POPJ##	;NO, END OF NUMBER
	ASH	T2,3		;MAKE ROOM AND
	ADDI	T2,-"0"(T3)	;ADD IN THIS OCTADE
	SOJG	P2,F8XOC3	;LOOP FOR MORE DIGITS
	SETO	T3,		;OOPS, RAN OUT, TERMINATE SCAN
	POPJ	P,		;RETURN
;F8BUN - TRANSLATE USERID NAME STRING INTO PPN STRING FROM USERS.TXT
;CALL IS:
;
;	MOVX	P1,<PTR>
;	MOVX	P2,<CTR>
;	PUSHJ	P,P8BUN
;	 error return
;	normal return
;
;Where <PTR> is the input byte pointer (presumed 8 bits, but not required);
;and <CTR> is the count of valid <PTR> bytes.
;
;On error return no name match could be found.
;
;On normal return, either the <PTR> string was not a name (in which case
;treat as ppn string) or the <PTR> string matched a name from USERS.TXT.
;In either case, P1/P2 contain a byte pointer and counter to a ppn string.
;
;Uses T1 - T4, P1 - P4

IFN FTUTXT,<
F8BUN:	DMOVE	T3,P1		;SAVE COPY OF ORIGINAL USER-ID STRING POINTER
	PUSHJ	P,TSAV14##	;NEED SOME SCRATCH SPACE
	PUSHJ	P,F8BUNC	;READ FIRST USERID CHARACTER
	 POPJ	P,		;THIS CAN'T HAPPEN . . .
	CAIL	T1,"0"		;OCTAL
	CAILE	T1,"7"		; DIGIT???
	JRST	F8BUN1		;NO, LOOK FOR A NAME STRING MATCH
	MOVE	P1,-T3(P)	;YES, PPN, RESTORE ORIGINAL <PTR>
	MOVE	P2,-T4(P)	;AND <CTR> FOR CALLER
	JRST	.POPJ1##	;PROCESS USERID<=>PPN
;STILL IFN FTUTXT

;HERE TO TRANSLATE NAME FROM USERS.TXT INTO CORRESPONDING PPN STRING

F8BUN1:	MOVE	P3,UTXPTR	;BYTE POINTER TO USERS.TXT
	MOVE	P4,UTXCTR	;COUNT OF VALID BYTES IN USERS.TXT
F8BUN2:	DMOVE	T3,P3		;SAVE COPY OF THIS USERS.TXT ENTRY
	MOVE	P1,-T3(P)	;FRESH POINTER AND
	MOVE	P2,-T4(P)	; COUNTER FOR USERID STRING
F8BUN3:	PUSHJ	P,F8BUNU	;READ NEXT CHARACTER FROM USERS.TXT
	 JRST	.POPJ##		;EXHAUSTED, NO MATCH, ERROR RETURN
	CAIE	T2,"]"		;END OF PPN PART OF "[P,PN]NAME" PAIR?
	JRST	F8BUN3		;NOT YET, KEEP GOING

;Note that UTXINI "compresses" USERS.TXT from "str:[p,pn],name<CR><LF>"
;entries into "[p,pn]name<LF>" entries . . .

F8BUN5:	PUSHJ	P,F8BUNU	;ANOTHER CHARACTER FROM USERS.TXT
	 JRST	.POPJ##		;EXHAUSTED, NO MATCH (<LF> GUARANTEED AT END)
	PUSHJ	P,F8BUNC	;ANOTHER CHARACTER FROM USERID
	 JRST	[CAIE	T2,.CHLFD	;DONE, AT END OF USERS.TXT NAME TOO?
		JRST	F8BUN7		;NO, SKIP NAME, CHECK NEXT ENTRY
		JRST	F8BUN9]		;YES, THEN THIS IS A MATCH
	CAIN	T2,.CHLFD	;STILL IN USERS.TXT NAME?
	JRST	F8BUN2		;NO, NO MATCH, CHECK NEXT NAME
	CAMN	T1,T2		;NAME CHARACTERS MATCH?
	JRST	F8BUN5		;YES, CHECK REST OF NAME
F8BUN7:	PUSHJ	P,F8BUNU	;NO, EAT THIS USERS.TXT NAME
	 JRST	.POPJ##		;DONE, NO MATCH AT ALL
	CAIE	T2,.CHLFD	;END OF USERS.TXT NAME ENTRY?
	JRST	F8BUN7		;NO, KEEP EATING
	JRST	F8BUN2		;CHECK NEXT USERS.TXT NAME ENTRY

;Here on successful match, return USERS.TXT ppn string in lieu of USERID

F8BUN9:	DMOVE	P1,T3		;USERS.TXT PPN STRING
	IBP	P1		;SKIP THE "[" CHARACTER
	JRST	.POPJ1##	;RETURN TO PROCESS PPN
;STILL IFN FTUTXT

;HELPERS FOR F8BUN

;F8BUNC  --  RETURN ONE USERID CHARACTER

F8BUNC:	SOJL	P2,.POPJ##	;ERROR RETURN IF NO MORE CHARACTERS
	ILDB	T1,P1		;NEXT USERID CHARACTER
	ANDI	T1,177		;MAKE 7-BIT ASCII
	JUMPE	T1,F8BUNC	;SUPPRESS NULLS
	CAIE	T1," "		;COMPRESS SPACES
	CAIN	T1,.CHTAB	; AND TABS
	JRST	F8BUNC		; . . .
	CAIL	T1,"a"		;LOWER CASE ALPHA?
	CAILE	T1,"z"		; . . .
	JRST	.POPJ1##	;NO, SUCCESSFUL RETURN WITH CHARACTER IN T1
	SUBI	T1,"a"-"A"	;YES, SHIFT TO UPPER CASE
	JRST	.POPJ1##	;AND RETURN



;F8BUNU  --  RETURN ONE USERS.TXT CHARACTER

F8BUNU:	SOJL	P4,.POPJ##	;ERROR IF NO MORE CHARACTERS LEFT
	ILDB	T2,P3		;FETCH NEXT CHARACTER
	JUMPN	T2,.POPJ1##	;RETURN CHARACTER
	JRST	F8BUNU		;EAT NULLS

> ;END IFN FTUTXT
;F8BUNA - TRANSLATE USERID NAME STRING INTO PPN FROM ACTDAE
;CALL IS:
;
;	MOVX	T1,<PTR>
;	MOVX	T2,<CTR>
;	PUSHJ	P,F8BUNA
;	 error return
;	normal return
;
;Where <PTR> is an eight bit byte pointer to the beginning of the username
;string (with any leading bracket trimmed), and <CTR> is the count of valid
;<PTR> bytes.
;
;On error return, no name match could be found, or <PTR> was no eight bit
;string.
;
;Since the username string we give to ACTDAE has to start on a word
;boundary, and since the remote end may have given us a username with
;[]s around it, we'll have to create a new username string, minus the
;brackets.
;
;On normal return, T1 will contain the ppn.

F8BUNA:	XMOVEI	T3,J$AUSR(J)	;POINT TO THE DESTINATION STORAGE
	HRLI	T3,(POINT 8,)	;MAKE A BYTE POINTER

;Loop here to copy the username string, minus the optional []s.

F8BU10:	ILDB	T4,T1		;GET A BYTE
	IDPB	T4,T3		;STORE THE BYTE
	SOJG	T2,F8BU10	;LOOP IF MORE BYTES IN THIS STRING
	SETZ	T4,		;GET A NULL
	IDPB	T4,T3		;TERMINATE THE STRING

	XMOVEI	T4,J$ABLK-1(J)	;POINT AT THE ARGUMENT BLOCK STORAGE
	PUSH	T4,[QF.RSP!.QUMAE] ;SAY WE WANT TO TALK TO ACTDAE
	PUSH	T4,[-1]		;SET THE NODE TO CENTRAL
	XMOVEI	T2,J$ARSP(J)	;POINT AT THE RESPONSE STORAGE
	HRLI	T2,ARSPLN	;GET THE NUMBER OF WORDS WE CAN PLAY WITH HERE
	PUSH	T4,T2		;PUT IN THE ARG BLOCK
	PUSH	T4,[QA.IMM!<1,,.QBAFN>] ;GET THE SUBFUNCTION ARGUMENT TYPE
	PUSH	T4,[EXP UGOUP$]	;SAY WE WANT THE USER PROFILE
	PUSH	T4,[^D10,,.UGUSR] ;STORE THE USERNAME DESCRIPTOR
	XMOVEI	T1,J$AUSR(J)	;POINT TO OUR NICER NAME STRING
	PUSH	T4,T1		;STORE THE USERNAME POINTER
	ANDI	T4,-1		;GET RID OF JUNK IN THE LEFT HALF
	SUBI	T4,J$ABLK-1(J)	;COMPUTE THE NUMBER OF WORDS WE FILLED IN
	XMOVEI	T1,J$ABLK(J)	;POINT AT THE ARGUMENT BLOCK
	HRL	T1,T4		;COPY THE BLOCK LENGTH
	QUEUE.	T1,		;ASK FOR THE PPN FOR THIS GUY
	 POPJ	P,		;WELL, WE GAVE OUR ALL
	MOVE	T1,J$ARSP+.AEPPN(J) ;GET THE PPN RETURNED
	TXO	S,S.PROF	;[31] SAY WE HAVE THE USER'S PROFILE
	JRST	.POPJ1##	;AND RETURN HAPPY
;NAM826 -- CONVERT EIGHT BIT ASCII NAME FROM USER PROFILE TO SIXBIT
;	   USER NAME AND STORE IN .IOQ6N
;Call is:
;
;	MOVX	IO,<CDB>
;	PUSHJ	P,NAM826
;	NORMAL RETURN
;
;Assumes user profile setup in J$ARSP(J), containing eight bit username at
;offset .AENAM.  On return, SIXBIT doubleword stored in .IOQ6N(IO)

NAM826:	PUSH	P,T1		;[31] SAVE A COUPLE
	PUSH	P,T2		;[31]  OF REGISTERS
	PUSH	P,[POINT 8,.AENAM+J$ARSP(J)] ;[31] INIT THE SOURCE BYTE POINTER
	PUSH	P,[POINT 6,.IOQ6N(IO)] ;[31] INIT DESTINATION BYTE POINTER
	SETZM	.IOQ6N(IO)	;[31] CLEAR BOTH OF THE
	SETZM	.IOQ6N+1(IO)	;[31]   DESTINATION WORDS
	MOVEI	T2,^D12		;[31] GET MAX NUMBER OF BYTES

NAM8.1:	ILDB	T1,-1(P)	;[31] GET THE NEXT BYTE
	JUMPE	T1,NAM8.2	;[31] RETURN NOW IF END OF STRING
	ANDI	T1,177		;[31] FORCIBLY MAKE IT 7 BIT ASCII (WELL ...)
	CAIL	T1,"a"		;[31] IS IT
	CAILE	T1,"z"		;[31]  LOWER CASE?
	SKIPA			;[31] NOPE
	SUBI	T1,"a"-"A"	;[31] YES, CONVERT TO UPPER
	SUBI	T1,"A"-'A'	;[31] CONVERT THE CHARACTER TO SIXBIT
	IDPB	T1,(P)		;[31] STORE THE SIXBIT CHARACTER
	SOJG	T2,NAM8.1	;[31] LOOP IF MORE BYTES TO DO

NAM8.2:	POP	P,(P)		;[31] GET RID OF THE COUNT
	POP	P,(P)		;[31] AND THE BYTE POINTER
	POP	P,T2		;[31] RESTORE THE
	POP	P,T1		;[31]  REGISTERS
	POPJ	P,		;[31] AND RETURN
;FFIND  --  FIND A SWAPPED CONTROL CODE IN A TABLE
;Call is:
;
;	MOVX	T2,<CODE>
;	MOVEI	T4,<TABL>
;	PUSHJ	P,FFIND
;	 ERROR RETURN
;	NORMAL RETURN
;
;Where <TABL> is a table a la CFIND (codes in right half of words,
;return value in left half of words, table terminated by a 0 word)
;and <CODE> is the code to match.
;
;On error return, <CODE> was not in the table.
;
;On normal return, T4 will point to the table entry that matched, and
;T1 will contain the matching value for <CODE>.
;
;Uses acs T1, T4.

FFIND1:	MOVE	T1,(T4)		;GET FIRST TABLE ENTRY
	JRST	FFIND4		;AND START LOOKING THERE
FFIND2:	SKIPN	T1,(T4)		;END OF TABLE YET?
	POPJ	P,		;YES, TAKE ERROR RETURN
FFIND4:	MOVS	T1,T1		;CODE TO MATCH IS IN LH
	CAIE	T2,(T1)		;CODES MATCH?
	AOJA	T4,FFIND2	;NO, SEARCH REST OF TABLE
	HRRZ	T1,(T4)		;GET RETURN VALUE
	JRST	.POPJ1##	;SUCCESSFUL RETURN
	SUBTTL	FALERI	Coroutine to process [SCAN] error interception


;[50]
;FALERI -- SET SCAN ERROR INTERCEPTION
;Call is:
;
;	MOVX	T1,<ADDR>
;	PUSHJ	P,FALERI
;	RETURN
;
;Where <ADDR> is the address of the routine to call on error detection.
;
;On normal return, the caller can call SCAN routines, and if any fatal
;syntax errors occur, the caller's specified routine will be called rather
;than aborting.  The specified error intercept routine will be entered
;with the stack "phased" to immediately after the caller's call to FALERI.
;
;This routine is identical to .XERRT in SWIMSC.  However, FAL cannot use
;.XERRT since NFTERP and NFTERT do not have a stream context.
;
;Uses ac T1.
FALERI:	PUSH	P,T1		;SAVE CALLER'S NEW ERROR INTERCEPT ROUTINE
	HRRZ	T1,P		;EXAMINE THE STACK POINTER
	CAIL	T1,J$RPDL(J)	;
	CAILE	T1,J$RPDL+PDSIZE(J) ;ARE J AND P IN SYNC?
	JRST	FALER2		;NO, RESTART THE FAL JOB
	PUSH	P,J$SERP(J)	;SAVE THE ERROR STACK POINTER
	PUSH	P,J$SERT(J)	;SAVE THE ERROR INTERCEPT ROUTINE
	PUSHJ	P,FALER0	;PSEUDOINCESTOUSLY CALL OURSELF
	 CAIA			;NON-SKIP RETURN
	AOS	-4(P)		;SKIP RETURN
	POP	P,J$SERT(J)	;RESTORE THE ERROR INTERCEPT ROUTINE
	POP	P,J$SERP(J)	;RESTORE THE ERROR STACK
	POP	P,(P)		;THROW AWAY THE CALLER'S INTERCEPT ROUTINE
	POP	P,(P)		;THROW AWAY THE RETURN FROM FALERI
	POPJ	P,		;RETURN FROM THE CALLING ROUTINE

; COME HERE TO CALL THE REST OF THE CALLER'S ROUTINE AS A SUBROUTINE.

FALER0:	MOVEM	P,J$SERP(J)	;SAVE THE PRE-INTERCEPT STACK
	XMOVEI	T1,FALER1	;PROVIDE AN INTERMEDIATE INTERCEPT ROUTINE
	MOVEM	T1,J$SERT(J)	; TO PROVIDE A VALID STACK POINTER
	PJRST	@-4(P)		;GET BACK TO THE CALLING ROUTINE

; COME HERE WHEN AN ERROR OCCURS TO RESTORE THE STACK POINTER.

FALER1:	MOVE	P,J$SERP(J)	;RESTORE THE STACK POINTER
	PJRST	@-3(P)		;CALL THE USER'S INTERCEPT ROUTINE

FALER2:	MOVEI	T1,[ASCIZ /FALERI called while not in stream context/]
	PJRST	RESTRT##	;RESTART THE FAL JOB
; COME HERE ON FATAL ERRORS IN PLACE OF A MONRT. UUO.

FALERT:	HRRZ	T1,P		;EXAMINE THE STACK POINTER
	CAIL	T1,J$RPDL(J)	;
	CAILE	T1,J$RPDL+PDSIZE(J) ;ARE J AND P IN SYNC?
	JRST	FALER3		;NO, RESTART THE FAL JOB
	SKIPE	J$SERT(J)	;IS THERE AN INTERCEPT ROUTINE
	PJRST	@J$SERT(J)	;YES, USE IT
	SKIPA	T1,[[ASCIZ /Fatal SCAN error/]]
FALER3:	MOVEI	T1,[ASCIZ /FALERT called while not in stream context/]
	PJRST	RESTRT##	;RESTART THE FAL JOB
;FAL ERRORS

FEROS:	ERROR	FDS,<FAL DAP message received out of sequence>

FERDP:	ERROR	FDR,<FAL DAP receive error>

FEXDP:	ERROR	FDX,<FAL DAP transmit error>



M0POPJ:	POP	P,M0		;ADJUST STACK
	POPJ	P,		;PROPAGATE ERROR RETURN
	SUBTTL	FALGLX Interface Routines

;COPSPC - Copy the SWIL filespec to a GLXLIB FD
;CALL IS:
;	PUSHJ	P,COPSPC	;COPY THE CURRENT SPEC
;	  returns error if aborted
;	normal return
;
;This will copy the file specification of the file currently being accessed
;into a GLXLIB FD style block in the per stream storage page.  This done,
;we'll force a new checkpoint message to be sent to keep the operator happy,
;and make sure we're not soaking up too much time if this is a directory
;or delete access.
;
;Destroys T1

COPSPC:	MOVE	T1,.FODEV+.I1FLP(CO)	;GET THE STRUCTURE NAME
	MOVEM	T1,.FDSTR+J$STFD(J)	;STORE IT IN THE FD
	MOVE	T1,.RBNAM+.I1LKP(CO)	;GET THE FILENAME
	MOVEM	T1,.FDNAM+J$STFD(J)	;STORE IN THE FD ALSO
	HLLZ	T1,.RBEXT+.I1LKP(CO)	;GET THE EXTENSION
	MOVEM	T1,.FDEXT+J$STFD(J)	;STORE
	HRLZI	T1,.PTPPN+.I1PT2(CO)	;POINT TO THE RETURNED PATCH
	HRRI	T1,.FDPPN+J$STFD(J)	;POINT TO THE DESTINATION
	BLT	T1,.FDPPN+.PTMAX-.PTPPN-2+J$STFD(J) ;COPY THE PATH
	MOVX	T1,FDXSIZ		;GET THE LENGTH OF THE FD
	HRLZM	T1,.FDLEN+J$STFD(J)	;STORE IT

	PUSHJ	P,FRCCHK##	;FORCE A CHECKPOINT MESSAGE MAYBE
	MOVE	T1,J$SACC(J)	;GET THE FILE ACCESS CODE
	CAXE	T1,$DVARD	;READING A FILE?
	CAXN	T1,$DVAWR	;NO, WRITING IT?
	JRST	.POPJ1##	;YES, JUST RETURN NOW

;If not reading or writing a file, make sure we're not running too much.

	PJRST	CNTFIL		;PERHAPS SLEEP BEFORE WE RETURN
;CNTFIL - Unblock if we're doing too many LOOKUPs in a row
;CALL IS:
;	PUSHJ	P,CNTFIL	;COUNT THIS FILE
;	  returns error if aborted
;	normal return
;
;This routine ensures that the DIRECTORY and DELETE class of access will
;not run to the exclusion of the other streams.  Since these commands will
;spend more time in LOOKUP/RENAME code than it takes the remote end to
;process our output, they may never block on network I/O until completion.
;This code implements a "fairness counter" which will deschedule the stream
;after DIRCNT files have been opened.
;
;Destroys no registers

CNTFIL:	SOSL	J$DCNT(J)	;HAVE WE DONE TOO MANY?
	JRST	.POPJ1##	;NO, JUST RETURN HAPPY
	PUSHJ	P,SCHEDZ	;YES, GO DESCHEDULE
	 POPJ	P,		;ABORTED, JUST RETURN NOW
	PUSH	P,[DIRCNT]	;WE'RE BACK, GET THE MAX FILES WE CAN DO
	POP	P,J$DCNT(J)	;RESET THE COUNTER
	JRST	.POPJ1##	;AND RETURN HAPPY
;SCHEDL - Call the FALGLX scheduler when I/O blocks
;CALL IS:
;	MOVX	M0,<block status>
;	PUSHJ	P,SCHEDL
;	   or
;	PUSHJ	P,SCHEDZ	;IF SIMPLY DESCHEDULING WITHOUT BLOCKING
;	  returns non-skip if aborted
;	returns skip if unblocked
;
;Where <block status> is one of the scheduler codes defined in SWIL.
;Will return as soon as the blocking condition has been satisfied.
;
;Destroys no registers

SCHEDZ:	PUSH	P,M0		;SAVE THE CONTENTS OF THIS JUST FOR KICKS
	SETZ	M0,		;SAY NO BLOCKING REASON
	JRST	SCHE.1		;CONTINUE IN COMMON CODE BELOW

SCHEDL:	PUSH	P,M0		;SAVE A TEMP REGISTER
	MOVE	M0,SCDBTS(T1)	;GET THE CORRECT BLOCKING BIT

SCHE.1:	PUSHJ	P,DSCHD##	;GO AWAY FOR A WHILE
	POP	P,M0		;RESTORE THIS REGISTER
	TXNN	S,S.KILL	;ARE WE SUPPOSED TO ABORT THIS?
	  JRST	.POPJ1##	;NO, JUST RETURN HAPPY
	MOVE	IO,CO		;YES, SELECT THE SLAVE CDB
	PUSHJ	P,IOABO1##	;ABORT THE CURRENT FILE
	 JFCL			;IGNORE ERRORS HERE
	PUSHJ	P,IORLS1##	;GET RID OF THE CHANNEL
	 JFCL			;DON'T CARE
	MOVE	IO,CI		;GET NETWORK CDB
	SETZ	T3,		;SAY NO OPTIONAL DATA
	PUSHJ	P,NTNAB1##	;ABORT THE CONNECTION
	 JFCL			;DON'T WORRY ABOUT ERRORS ON THE ABORT
	SKIPN	T1,J$RALC(J)	;ANY RECORD ALLOCATED?
	POPJ	P,		;NO, JUST RETURN ERROR NOW
	MOVE	T2,J$RALC+1(J)	;YES, GET THE RECORD LENGTH
	PUSHJ	P,.MMFWD##	;FREE THE MEMORY
	 JFCL			;PUNT ERRORS HERE
	SETZM	J$RALC(J)	;SAY NO MORE RECORD BUFFER
	POPJ	P,		;THEN GIVE THE ERROR RETURN

;Table to translate SWIL blocking reason to FALGLX blocking bit:

SCDBTS:	PSF%DI		;BLOCKED FOR LOCAL INPUT
	PSF%DO		;BLOCKED FOR LOCAL OUTPUT
	PSF%NI		;BLOCKED FOR NETWORK INPUT
	PSF%NO		;BLOCKED FOR NETWORK OUTPUT
	PSF%CW		;BLOCKED WAITING FOR INCOMING CONNECTION
;IOSHUT -- HERE DURING DISK I/O SHUTDOWN
;CALL IS:
;
;	MOVX	IO,<CDB>
;	PUSHJ	P,IOSHUT
;	  (never takes error return)
;	normal return
;
;Here when we close a disk channel.  This routine will be called
;by SWIL before actually closing the channel.  We will just turn
;off interrupts on this device and clear the scheduler pointer.
;
;Uses T1, T2

IOSHUT:	SETZM	.IOSCH(IO)	;ZERO THE SCHEDULER POINTER
	PUSHJ	P,INDDIS##	;REMOVE THIS FROM PSI SYSTEM
	  JFCL			;PUNT ERRORS
	JRST	.POPJ1##	;RETURN SUCCESS
	SUBTTL	CDB initialization vectors

;"FAL" INPUT (PRIMARY) CDB INITIALIZATION VECTOR

FALIV:	EXP	10		;COUNT OF WORDS FOLLOWING
	'NS',,102030		;VERSION WORD
	600			;"EXTRA" SIZE TO ALLOCATE
				; (ENOUGH FOR NETWORK BUFFERS)
	0			;DEFAULT BUFFERING
	0			;MAXIMUM BUFFERING
FALIVC:	0			;I/O CONTROL (DEFAULT = ASCII MODE)
FALIVE:	0			;I/O ERROR CONTROL
FALIVM:	IM.DQA			;I/O MODE
	0			;RETURN FILE PARAMETERS



;"FAL" OUTPUT (SLAVE) CDB INITIALIZATION VECTOR

FALOV:	EXP	10		;COUNT OF WORDS FOLLOWING
	'NS',,102030		;VERSION WORD
	600			;"EXTRA" SIZE TO ALLOCATE
				; (COUPLA FSB'S, 2 128(10)-WORD DISK BUFFERS)
	0			;DEFAULT BUFFERING
	0			;MAXIMUM BUFFERING
FALOVC:	0			;I/O CONTROL (DEFAULT = ASCII MODE)
FALOVE:	0			;I/O ERROR CONTROL
FALOVM:	IM.DQA			;I/O MODE
	0			;RETURN FILE PARAMETERS
	SUBTTL	SWIL Argument Blocks

; ISCAN argument block:

ISBLK:	XWD	    12,%%FXVE	;PROTOCOL VERSION WORD
	IOWD	     0,0	;IOWD OF LEGAL MONITOR COMMANDS
	XWD	   [0],'FAL'	;ADDRESS OF STARTING OFFSET, CCL NAME
	XWD	 .POPJ,.POPJ	;INPUT, OUTPUT ROUTINE ADDRESSES
	EXP	0		;INDIRECT FILE BLOCK POINTER
	XWD	 .POPJ,FALERT	;PROMPT ROUTINE, MONRET ROUTINE
	EXP	FS.IFI		;DISALLOW INDIRECT COMMAND FILES
	EXP	FALERT		;ERROR ROUTINE
ISLEN==.-ISBLK		;LENGTH OF THE ISCAN PARAMETER BLOCK
	SUBTTL	Impure data

	XLIST			;THE LITERALS
	LIT			;THE LITERALS
	LIST			;EVERYTHING AFTER THE LITERALS

;SOME IMPURE STORAGE

BZFAL:				;START OF TO-BE-ZEROED ON FAL STARTUP

IFN FTUTXT,<
UTXPTR:	BLOCK	1		;BYTE POINTER TO USERS.TXT BUFFER
UTXCTR:	BLOCK	1		;BYTE COUNTER TO ACCOMPANY UTXPTR
> ;END IFN FTUTXT

REJFIR::BLOCK	1		;FIRST "REJECT"ION SPEC
REJLAS::BLOCK	1		;LAST "REJECT"ION SPEC
NETPPN::BLOCK	1		;DEFAULT NETWORK ACCESS PPN

S.MOAN::BLOCK	1		;.GT. 0 THEN BITCH ABOUT MONITOR QUIRKS
NFTERT::BLOCK	1		;.NE. 0 THEN ADDRESS OF SCAN ERROR INTERCEPT
NFTERP::BLOCK	1		;       STACK POINTER FOR C(NFTERT)'S USE

EZFAL:				;END OF TO-BE-ZEROED ON FAL STARTUP
	END	FAL##