Google
 

Trailing-Edge - PDP-10 Archives - BB-H240E-BM_1985 - decnet-sources/daplib.mac
There are 14 other files named daplib.mac in the archive. Click here to see a list.
TITLE	DAPLIB	Dap routines for TOPS20 DECNET
SUBTTL	D. Oran - P.J. Taylor /POM/CLB/ 17-Nov-81

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



	SEARCH	GLXMAC			;Get Galaxy symbols
	PROLOG	(DAPLIB)		;Declare our name

	SEARCH	QSRMAC			;Get symbols for submit/print
	SEARCH	DAPSYM			;Get DAP symbols

	SALL				;SUPPRESS FULL EXPANSION

;Version Information

	DAPVER==2			;MAJOR VERSION OF DAP20
	DAPMIN==0			;MINOR VERSION OF DAP20
	DAPEDT==171			;EDIT LEVEL
	DAPWHO==0			;WHO LAST EDITED

	GLOB	DAPEDT			;Make edit number global
	GLOB	LEV1PC			;Interrupt PC from caller

	VDAP20==VRSN.(DAP)		;GET THE VERSION LEVEL
SUBTTL	Table of contents

COMMENT #
                TABLE OF CONTENTS FOR DAPLIB


                         SECTION                                       PAGE
	1.	Title Page.............................................. 1
	2.	Table of contents....................................... 2
	3.	Revision History........................................ 3
	4.	Symbol Definitions...................................... 4
	5.	IMPURE storage.......................................... 5
	6.	STORAGE	allocated per logical link...................... 6
	7.	Version number and entry vector......................... 9
	8.	DAP message descriptor blocks........................... 10
	9.	DAP message argument types and processor table.......... 11
	10.	Local macro definitions................................. 12
	11.	$DEBUG	Macro to display debugging message.............. 13
	12.	DEBUG and TYPER output routines......................... 14
	13.	$GODAP	Macro to establish DAPLIB context............... 15
	14.	D$INIT	Daplib initialization........................... 16
	15.	D$OPEN	Establish a logical link........................ 17
	16.	D$INTR	Interrupt processing routines................... 18
	17.	D$CLOS	Routine to close logical link................... 18
	18.	D$STAT	Display link status............................. 18
	19.	D$FUNC	Daplib routine to perform a File function....... 19
	20.	SRVMSG	Server initialization and tables................ 20
	21.	Server state initialization routines.................... 21
	22.	SRVMSG	Server message processing loop.................. 22
	23.	SRVCFI	Server routine to process Initial config message 23
	24.	SRVCFG	Server routine to Process Config message........ 23
	25.	SRVACC	Server routine to process an ACCESS message..... 23
	26.	SRVOPN	Server routine to process ACCESS (Open)......... 24
	27.	SRVCRE	Server routine to process ACCESS (Create)....... 26
	28.	SRVDEL	Server routine to process Delete requests....... 27
	29.	EXPUNG  Expunge deleted files........................... 28
	30.	SRVEXE	Server routine to process submit requests....... 29
	31.	SRVDIR	Server routine to process Directory requests.... 30
	32.	SRVCTL	Server routine to process a CONTROL message..... 31
	33.	FILGET	Server routine to send data messages............ 32
	34.	SRVACP	Server routine to process Access complete mess.. 33
	35.	ENABLE/DISABL Routine to set or clear capabilities...... 34
	36.	HOOVER	Routine to validate a users access to a file.... 35
	37.	PRINT/SUBMIT Server routine to queue galaxy requests.... 36
	38.	SNDQSR	Routine to send message to quasar............... 37
	39.	DAPDCN	Active Task function dispatch................... 38
	40.	Active Task message and State tables.................... 39
	41.	Active Task state initialization routines............... 40
	42.	DCNMSG	Active Task message processing routine.......... 41
	43.	DCNCFG	Routine to process Config message............... 42
	44.	DCNNAM	Routine to process Name message................. 43
	45.	ATTACK	Routine to process ACK for Attributes message... 43
	46.	CTLACK	Routine to process ACK for Control message...... 43
	47.	DCNACP	Routine to process Accomp (Resp)................ 43
	48.	DCNSTS	Routine to process Status message............... 43
	49.	DCNATR	Routine to call user with received attributes... 43
	50.	DCNREC	Active Task routine to receive a file........... 44
	51.	DCNTYP	Active task to type remote files................ 45
	52.	DCNSND	Active task to send files....................... 46
	53.	DCNDEL  ACTIVE TASK TO DELETE A FILE.................... 47
	54.	DCNEXE	ACTIVE TASK TO EXECUTE A FILE................... 47
	55.	DCNDIR	Active Task routine to process Directory request 48
	56.	DCN	Unimplimented functions......................... 49
	57.	VALCFG	Validate contents of a CONFIG message........... 50
	58.	VALATT	Validate contents of an ATTRIBUTES message...... 51
	59.	VALDTI	Validate DATE/TIME attributes extention mess.... 52
	60.	VALPRO	Validate protection attributes message.......... 53
	61.	VALNAM	Validate the contents of a NAME message......... 54
	62.	VALCRC	Routine to validate the CRC .................... 54
	63.	SNDCFG	Send CONFIG message............................. 55
	64.	SNDACC	Send an ACCESS message.......................... 56
	65.	SNDCTC	Send a CONTROL (CONNECT) message................ 56
	66.	SNDCTR	Send a CONTROL (GET) message.................... 57
	67.	SNDCTS	Send a CONTROL (PUT) message.................... 57
	68.	SNDCON	Send a CONTROL TRANSFER (Skip) message	;[132].. 58
	69.	SNDACK	Send an ACKNOWLEDGE message..................... 59
	70.	SNDEOF	Send an EOF status message...................... 59
	71.	SNDSTS	Routine to send a status message................ 59
	72.	SNDACP	Send an ACCOMP (CLOSE) message.................. 59
	73.	SNDACA	Send an Accomp (Resp) message................... 59
	74.	SNDWLD	Routine to send required name mess's per WLDJFN. 60
	75.	SNDDSP	Send requested ATTRIBUTES messages.............. 61
	76.	CONREM/RESREM Send file names in correct format......... 62
	77.	SNDATT	Send an attributes message...................... 63
	78.	SNDPRO	Send File Protection Attributes................. 64
	79.	SNDDTI	Send Date/time attributes....................... 64
	80.	SNDNAM	Send a Name message............................. 64
	81.	MSGTBL	List of valid DAP messages...................... 65
	82.	GETMSG	Routine to get next DAP message from Link....... 66
	83.	VALHDR	Routine to validate standard dap message header. 69
	84.	NEWHDR	Routine to create a new header only............. 69
	85.	VALMSG	Routine to parse current DAP message............ 70
	86.	CLRMSG	Routine to clear DAP message storage............ 71
	87.	GETFIX	Routine to process DAP byte arguments........... 72
	88.	GETBYT Routine to return a single DAP message byte...... 72
	89.	GETVAR	Routine to process DAP variable length arguments 73
	90.	GETINT	Routine to process DAP integer arguments........ 74
	91.	GETPRO	Routine to get Protection field from DAP message 75
	92.	GETEXF	Routine to process DAP extensible fields........ 76
	93.	GETMNU	Routine to process DAP extensible menu fields... 76
	94.	GETDTI	Routine to process Date/time field in DAP mess.. 77
	95.	GETDAT	Routine to process DATA field from DAP message.. 78
	96.	GETASC	Routine to process ascii data in message........ 79
	97.	TSTPRN	Routine to do final linefeed for print files.... 79
	98.	GETPRN	Routine to process print file format (vax)...... 80
	99.	GETPAG	Routine to get a file page from DAP message..... 81
	100.	GETIMG	Routine to process image bit stream in data mess 82
	101.	GETBCT	Routine to return bitstream from DAP message.... 83
	102.	GETDOS	Routine to store MACY11 variable length files... 84
	103.	SNDQUE	Routine to send all messages in the send queue.. 85
	104.	DELMSG	Routine to delete current message in Send Queue. 85
	105.	PUTMSG	Routine to build and force all messages out..... 86
	106.	QUEMSG	Routine to block current message if possible.... 86
	107.	BLDMSG	Routine to build a DAP message.................. 88
	108.	BLDHDR	Routine to build header for current message..... 89
	109.	PUTFIX	Routine to store 1-4 BYTE fields in DAP message. 90
	110.	PUTBYT	Routine to store a character in current message. 90
	111.	PUTERR	Routine to die on invalid argument.............. 90
	112.	PUTVAR	Routine to store var length field in DAP message 91
	113.	PUTINT	Routine to store variable length integer........ 92
	114.	PUTPRO	Routine to store DAP protection argument........ 93
	115.	PUTEXF	Routine to store extensible field in Dap message 94
	116.	PUTMNU	Routine to store DAP extensible fields.......... 94
	117.	PUTDTI	Routine to store date time field in DAP message. 95
	118.	PUTDAT	Routine to store Data field in DAP message...... 96
	119.	DOCRC	Routine to update cumulative CRC for data mess's 97
	120.	CRCTAB	CRC TABLE DEFINITION............................ 98
	121.	PUTASC	ROUTINE TO READ ASCII AND make A DAP MESSAGE.... 99
	122.	PUTPAG	Routine to store file page in DAP message...... 100
	123.	PUTIMG	Routine to store n-bit bytes in data message... 101
	124.	PUTBCT	Store image bit stream in DAP message.......... 103
	125.	PUTDOS	Process MACY11 assembler output................ 104
	126.	SETINP	Setup for local file input..................... 105
	127.	SETOUT	Setup for local file output.................... 106
	128.	OPNFIL	Routine to open the local file................. 107
	129.	CLSFIL	Routine to close local file and update FDB..... 108
	130.	CLSINP	Routine to close input file.................... 109
	131.	DELFIL	Routine to delete the local file............... 109
	132.	ABTFIL	Routine to abort local file operation.......... 109
	133.	CHNGFD	Routine to change a field in output files FDB.. 109
	134.	EOFCHK	Routine to check for EOF in local file......... 110
	135.	INPBYT	Routine to read a byte from file............... 110
	136.	OUTBYT	Routine to write a byte to file................ 111
	137.	GETFDB	Routine to read local file FDB and other info.. 112
	138.	GETDEV	Routine to get device attributes............... 113
	139.	SETATT	Set attributes from switches................... 114
	140.	SWLOOK	Lookup switches and convert to DAP attriubtes.. 115
	141.	CHKMOD  Routine to check for legal input to output mode 115
	142.	PICMOD  [125]Pick default file mode by system type..... 116
	143.	File mode table definitions............................ 117
	144.	ATLOOK	Routine to lookup attributes................... 118
	145.	Attributes list........................................ 119
	146.	SETMOD	Routine to setup processor address and bytesize 120
	147.	TYPSTS	Routine to expand DAP status codes............. 121
	148.	TERCVT	Routine to convert 20 error code to dap status. 122
	149.	LLGJFN	Routine to get JFN for logical link............ 123
	150.	LLGJFN	Get a JFN for logical link..................... 123
	151.	QSOUT	move asciz string and quote if required........ 124
	152.	LLOPEN	Routine to OPEN logical link................... 125
	153.	LLWCON	ROUTINE TO WAIT FOR LINK TO BE CONNECTED....... 126
	154.	LLCHK	Routine to check logical link status........... 127
	155.	LLCLOS	Routine to close or abort a logical link....... 128
	156.	LLRCD	Read Connect-initiate Disconnect initiate data. 129
	157.	STOSTS	Routine to store link status................... 130
	158.	LLSEND	Routine to send messages across Link........... 131
	159.	LLRECV	Routine to receive link messages............... 132
	160.	NEWBUF	Routine to allocate a new buffer............... 133
	161.	Connect	event interrupt service........................ 134
	162.	Interrupt message processing........................... 135
	163.	Table	of NSP disconnect reasons...................... 136
	164.	PURE TABLES............................................ 137
	165.	TOPS20 TO DAP ERROR CONVERSION TABLE................... 138
#
SUBTTL	Revision History

COMMENT \

Edit	Comment

0020	First field test of DAPLIB

0021	Fix Daplib to default to Image mode if remote node is TOPS20

0022	Fix Daplib to Store output files DTI and PRO message info

0023	Fix bugs in blocked recieve code and SNDATT to allow ascii
	transfers to/from RSX11

0024	Move Free <CRLF> for TTY output to DCNREC instead of OPNFIL

0025	Default directory name and extention to *.* for server.
	Move Date/time info received from attributes into FDB
	for directory function.

0026	Fixed a bug in SNDWLD that caused error in directory if
	Filespec was not wild.

0027	Only do MTOPR and SIBE when required.  Globalaize Status flags.

0030	Check for Device type DSK before updating FDB

0031	Impliment TYPE routine for DCN
	Add wild logic to SRVOPN

0032	Remove code for unsupported message types

0033	Add blocking code to send logic and fix various bugs

0034	Fix bugs in send blocking code

0035	Redefined extensible field bits to begin with bit 35
	and change GETEXF and PUTEXF to automatically lite the
	extension bit when required.  Effectively extend the
	precesion for extensible fields to 70 information bits
	(or 10 bytes)

0036	Defined message types via macros in DAPSYM and invoked
	macros to declare local storage

0037	Further bugging for VAX communication

0040	Bug fixes for TYPE command and FAL

0041	Remove SY$APP from SYSCAP field since it's not supported

0042	Change GETINT to accept up to 9 byte integer fields

0043	Remove SY$RSS and SY$RSR from SYSCAP and add SY$CRC
	and appropriate support code to generate and validate
	CRC's

0044	Remedy several bugs to allow FAL to speak to VAX

0045	Disable capabilities upon reciept of CTL (PUT) to allow
	overquota errors to occur.  Also CRC changes.

0046	Add page mode transfer code so "holy" files may be transferred
	between TOPS20 nodes

0047	Don't copy file protection attribute when creating files.  This
	will cause the directory default protection to be followed if
	no protection is specified.  Also, don't update reference counts

0050	Fix a bug in PUTASC which caused CRC error on 36 bit files when
	transferred in ASCII mode.

0051	Fix an interrupt race which causes NFT and FAL to occasionally hang

0052	Add check to FAL to determine if directory is large enough to write
	file before file is created.

0053	Fix several problems for speaking to RSTS Dap 4.0

0054	Fix problem causing invalid ATTEBK and remove code to support pre
	5.3 FAL for TOPS20

*** Changes for DECnet-20 V3.0 begin here ***

0055	Fix PRINT routine to properly queue file for printing.

0056	Add CHKWLD routine to look for unsupported wild cards.

0057	Change primary output mode for ascii from ascii stream to
	ascii variable to prevent the RSX FAL from hanging.

0060	Add code to break out of SOUT if an interrupt has occured.

0061	Ignore enable/disable requests if debugging.

0062	Remove obsolete hack to check for RSX Pseudo 5.3 FAL in
	SNDACC routine.  (Always request name if they support it)

0063	Don't send fancy fields in attributes message to none TOPS20
	and TOPS10 on file create.

0064	Don't send attributes bytesize if it is the default (8).

0065	Check for delete access before deleting file via ACCOMP
	options.

0066	Only do CRC validation for DCNSND and DCNREC routines.

0067	Add .DIACP function to D$INTR to force access complete.

0070	Add missing Data transfer error entry to MACTBL to prevent
	nasty stopcode on message sequence errors.

0071	Add debugging typeout to LLSEND and LLRECV routines.

0072	Fix a race problem in setting and clearing MSGFLG.

0073	Call LLRECV from main routines DCNMSG and SRVMSG and expect
	a false return if no messages are available.

0074	Wait for 30 CCTIME intervals during wait for connect confirm
	and modify CCTIME to be 2 seconds.

0075	Modify SNDQUE to send all but the last message segment unless
	the last segment is being forced out.

0076	Fix a bug in PUTASC which was causing CRC generation failure
	for fixed length ascii records.

0077	Remember ATTMRS specified in initial attributes and use that
	when FAL returns attributes.  Do defaulting for MRS in DCN
	routines instead of general file routines.

0100	Establish invalid default value for ACPCRC to determine if
	it was sent at all.  Don't validate CRC if this field was
	not sent.

0101	Fix copy for Print and Fortran format files from VMS.

0102	Return unsupported for CTL with RB$VBN which implied random
	access by VBN which is unsupported.

*** Engineering responsibility changed hands here ***

103	For TOPS-10 connections, if the file data mode is unspecified in
	the ACCESS message sent by the 10 to read an existing file on
	the 20, or create a new file on the 20, then default to ASCII
	for files whose byte size is 7 or 36.

104	The macro which builds DAP messages used the wrong
	radix in an arithmetic expression, causing some
	DAP messages to be too large.

105	The symbol ATT$LN was multiply defined, but MACRO didn't
	notice. This caused the saved attributes message to be
	truncated and wild card copies to exhibit multiple
	problems.

106	The maximum value of DPMXM was lowered to ^d1636 if the
	user said /OSTYPE:VMS in SET DEFAULT. This is
	the largest it can be and still allow VAX FALs to function
	if the VAX users accounting file allows BYTLM to default
	to 4K. If BYTLM is too small for DPMXM, then the VAX FAL
	hangs. If all VAX users have BYTLM raised, then DPMXM can
	also be raised. Doing this provides better performance.
	Note that the next release of VMS fal should include a patch
	to solve this problem. When NFT/FAL-20 is shipped with
	DECnet-20 phase III this patch should be removed.

107	The table search for error conversion to DAP error codes
	in TERCVT is one word off. The last error was never identified.

110	For non-TOPS-20 nodes, if a files byte size is zero make
	it default to 7.

111	Non copy commands keep all generated messages in core until
	the command is almost finished. Commands which process many files
	(such as dir <*>*.*.*) can run out of core. Do a SNDQUE
	every so often to regain the core.

112	A FAL serving a directory request will forget to send the
	structure and directory name if the first file in a wildcarded
	directory is not accessable, but other files are.

113	Logical link error messages are terrible.
	Remote status error messages are not complete enough.

114	Allow zero length variable length image mode records
	to be transmitted to remote nodes.

115	The code which sends IPCF packets to QUASAR failed to put
	the message length into the message header. The length
	field is required by Galaxy 4.1.

116	The DAP protection attributes message contains an owner field.
	DAPLIB was interpreting this as a TOPS-20 author field. This
	concept is incorrect. When the two are treated equivalently
	it is possible to create a file on the 20 whose author field
	contains a vax uic. Then when one attempts to copy the file to
	a vax, the copy fails because of lack of privileges. The author
	field should always contain the userid passed at CI time. TOPS-20
	should not send the owner field, but let the owner default to
	the user id passed at CI time to the VAX.

117	If a VAX user gives a file spec without quotes, VMS sends it
	with a semicolon before the version number. TOPS-20 always
	fails to find such a file. So, to make file transfer easier
	for everyone always convert semi colons to periods in file
	specs that come in to a TOPS-20 server in an ACCESS message

120	In certain cases, the CLOSF in LLCLOS fails when it shouldn't.
	Since the file transfer would have already completed successfully,
	don't make this an error, just set the abort bit and close again.

121	Add a subroutine to do poor mans routing. The routing info
	is stored in SYSTEM:DECNET-HOSTS.TXT. This code is only
	invoked if the value of PMRFLG is -1. NFT/FAL is
	shiped with this value = 0.

122	Any date generated must be in the format specified by the
	DAP spec. The day of the month is supossed to be DD not D.

123	If a bad message is received by FAL it will loop forever
	sending the error status message. The bad message was never
	deleted from the receive queue.

124	Force FAL to expunge each file that it deletes.

125	If file mode is not specified for destination file, pick
	file mode by type of destination system. Always default to ASCII
	This means that for all ASCII file transfers to any system,
	if the user leaves out all the switches, NFT will default
	to doing the right thing.

126	Allow copying of stream files and files with fortran carriage
	control to TOPS-20 (fixed, variable, and vfc) from VMS.

127	Fix incorrect error message from FAL when VALMSG gets an
	error.

130	Performance improvements. For non TOPS-20 transfers replace
	BIN/BOUT with PMAP. This speeds things up by 75%.

131	Fix "File off-line" problem when doing wildcard copy.
	When an error was found with a file being copied the
	entire copy was aborted. Now just the current file is
	aborted and the wildcarding process continues.

132	Fix abort of DIRECTORY command when a remote file is inaccessible.
	This is the same wildcarding problem as the copy problem
	above.

133	Fix the initialization of the checksum variable FILCRC. It is
	not initialized for each file in a wildcarded transfer. Thus
	the transfer of the second file always fails.

134	Add ^A command to show current status for NFT.

135	Allow a null DATATYPE field in an attributes message
	received during a DIRECTORY command.

136	DAP arcitecture suggests that file names sent to other systems
	be in the format required by the remote system. This edit
	changes the period before the version to a semi colon if the
	remote system requires it. If the octal/decimal version number
	problem is resolved, this is where the fix should go.

137	The processing of the delete on close function (access complete)
	is all wrong.

140	Fix obscure problem with interrupt system. It seems that
	if an interrupt routine does a network JSYS when the mainline
	code was interrupted out of a network JSYS, then odd things happen
	to the logical link. This really needs to be fixed in the monitor,
	but in the meantime, fix it here by prevent both paths from
	doing network actions at the same time.

141	The algorithm in GETIMG for determining whether the residual
	bit count was correct was wrong.

142	In PUTASC a buffer count was set up incorrectly.
	This caused double CRLFs in some cases.

143	Improve error detection when a file name is used which is correct
	if some of the trailing characters are ignored.

144	If FAL queues a file to be printed and its type is DAT then
	it should be specified to be /FILE:FORTRAN.

145	Temporary patch to prevent NFT from hanging when running under
	DECnet-20 V2.0 or V2.1. This should be removed when lost DC
	problem is solved, or if supporting an RT system.

146	When printing remote files send the FOP bit in the attributes
	message in addition to the access complete. Field image RSX
	does not read the access complete FOP field.

147	Error messages concerning local files are not clear enough.

150	Strip nulls from files which are being converted from
	line numbered files to non-line numbered files.

151	Following a fatal error files with pages mapped are left
	open because the cleanup code does not unmap the pages.
	Unmap them at cleanup time.

152	A file with an unusable byte size previously caused an error.
	This edit prints a warning message and assumes a byte size of
	7.

153	When copying to RSTS systems specify superceed always.
	If this is not done, a copy to an existing file will fail.

154	The routine LLCHK was called too frequently, lowering performance.
	remove the excessive calls.

155	The location of the RSX11-M+ entry in PMTAB was off - it assumed
	that the OS code was 11. when it should be 12.  This problem
	caused the TYPE command to not work when going to M+ systems.
	Also put in defensive coding to prevent references outside the
	PMTAB table.

156	The TYPE command defaulted to /ascii.  If the remote FAL didn't
	understand ascii stream it converted it into something it did
	understand.  RMS-11 FAL does this, but the FCS-11 FAL doesn't.
	This caused TYPE command to not work going to some RSX systems.
	Changed the default so that it is based on the operating system
	type and will get the right switches.

157	In CLSIN2, LOCJFN was not being zeroed after a JFN was released.
	This caused FALSRV to still think it owned the JFN and resulted
	in strange JFN-related errors.

160	In D$INIT, see if we are NFT.  If we are, get the username and
	the current account string and stash them away.  Use these at
	CLSFI1 when creating local files, not the switch values.

161	Remove edit 106 to DAPLIB which compensated for BYTLM being too
	small on a VAX/VMS account prior to DECnet-VMS V.3.1 and VMS V3.4.
	This eliminates "data overrun" errors seen when transfering files
	from a -20 to VAX running VMS V3.4 or greater.

162	Fix D$CLOS to not zero LLSTAT if a fatal error occurs

163	In SRVNXT check for directory listing access if we are wildcarding
	during an ACCESS (Open), and skip to the next file if such access
	is denied.  Return an error status if no files were successfully
	accessed.  Fix off by one errors on BLTs.

164	For non-TOPS20 transfers, release the scratch page used when
	closing the local file.  This prevents GLXMEM CFC crashes from
	occuring when transfering a large number of files.

165	Fix access checking in SRVDEL to allow file deletion when we have
	write access and to disallow deletion when the file is write
	protected against the owner in a directory we can connect to.

*** Changes for TOPS-20 V. 6.0 begin here ***

166	Remove infinite loop from edit 152

167	Add unsupported hooks for Access Control Lists under feature
	test ACL /Alec Carlson

170	change error from PMAPX1 to EOF in PAGINN when PA%PEX is off.

171	tweak unsupported PMR feature to work with Phase IV.  Routing
	is now always attempted if PMRFLG is non-zero.  Routes need
	only be specified for Phase II & and out-of-area Phase III
	nodes; other nodes don't even need to be in DECNET-HOSTS.TXT.

\ 	;end revision history
SUBTTL Symbol Definitions

	DEFINE	FTACL,<IFN ACL,>	;[167] Access control list feature test

	ACL==0				;[167] Turn off ACL support

FTACL	<SEARCH	ACCMAC   >		;[167] If ACL support,,get symbols


; ACCUMULATOR DEFINITIONS

	S==13				;Global link Status AC

	  S%JERR==1B10			;[127]A JSYS error has occured
	  S%LERR==1B11			;Error status sent or received
	  S%INIT==1B12			;State has just changed
	  S%RETN==1B13			;Return to caller flag for DCN
	  S%PUT==1B14			;Data ouptut
	  S%GET==1B15			;Data input
	  S%EOF==1B16			;EOF seen
	  S%ACP==1B17			;Access complete

	  S%STAT==777777B35		;Link state
	    .LLCFG==0			;Awaiting Config
	    .LLACC==1			;Awaiting Attributes or Access
	    .LLATT==2			;Awaiting Ext Attr or Access
	    .LLCTL==3			;Awaiting Control or Accomp
	    .LLDAT==4			;Awaiting Data or Accomp
	    .LLACP==5			;Awaiting Accomp


	CP==14				;Holds link data page address
	DL==15				;Address of current msg header
	AP==16				;Address of callers arguments

;CONSTANTS FOR COMPILATION

	FP%SLF==77B23			;Owner protection mask
	FP%GRP==77B29			;Group protection mask
	FP%WLD==77B35			;Wild protection mask

	FFSPEC==<FLD(1,JS%DEV)+FLD(1,JS%DIR)+FLD(1,JS%NAM)+FLD(1,JS%TYP)+FLD(1,JS%GEN)+JS%PAF>

	ND	OURKON,25256		;Hours constant worth of bits

	ND	CCTIME,2		;Wait time for Connect confirm
	ND	MAXLNK,1		;Maximum number of logical links
	ND	DPMXM,^D512/2*^D9+^D100	;Maximum Dap message size
	ND	DPMXMV,^D512/2*^D6+^D100 ;MAX DAP MESSAGE SIZE FOR VMS HOST
	ND	DPMXH,^D8		;Maximum Dap header size
	ND	LLMXF,^D40		;MAX LENGTH OF FILESPEC STRING
	ND	FILMAX,^D40		;[111]MAX NUM OF FILES TO PROCESS BEFORE
					;[111]A SNDQUE IS DONE TO FREE CORE

IFE MAXLNK-1,<DEFINE MULINK <IFE -1,>>
IFG MAXLNK-1,<DEFINE MULINK <IFE  0,>>


;Contants for this implimentation

	XP	CAP1,SY$SEQ+SY$SQA+SY$BLK+SY$UBK+SY$LN2+SY$EXE+SY$DTI+SY$PRO+SY$BCT+SY$DIR+SY$SUB+SY$SPL+SY$DEL+SY$CRC+SY$VBN
	XP	CAP2,SY$WLD+SY$NAM

	XP	DAPVER,<BYTE (8) .DVMAJ,.DVMIN,.DVUSR,.DVSFT>
SUBTTL	IMPURE storage


	.PSECT	DATA			;Load where FAL or NFT left off

DEFINE	$DATA (NAME,SIZE<1>) <
 NAME:	BLOCK SIZE
	 ..LOC==.>

$DATA	DAPFRM,1			;USER PDL FRAME
$DATA	DAPFLG,1			;DAP FLAGS FROM D$INIT
$DATA	LGAPTR,1			;[160]Pointer to account string
$DATA	LGUPTR,1			;[160]Pointer to username
$DATA	LOGACT,10			;[160]Current account string
$DATA	LOGUSR,10			;[160]Username
$DATA	MSGDSG,1			;DAP Message designator
$DATA	LNKPGS,MAXLNK			;Per link storage address


MULINK <
	 ..LOC==0			;Start at offset 0
DEFINE	$DATA (NAME,SIZE<1>) <
	 ..DEF (NAME,\..LOC)
	  ..LOC==..LOC+SIZE>

	DEFINE ..DEF (NAME,OFFSET) <
	  DEFINE NAME <OFFSET(CP)>>
> ; End MULINK
SUBTTL	STORAGE	allocated per logical link

;This part of the per link data contains Logical Link variables

;If there is more than 1 link allowed then reference all variables
; by index register (cp) else allocate storage directly


$DATA	LNKBEG,0			;Start of per link storage

$DATA	SAVPNT,1			;[136]BYTE POINTER FOR NAME CONV
$DATA	BUFFUL,1			;[142]BUFFER FULL FLAG
$DATA	DELFLG,1			;[137]FILE DELETED FLAG
$DATA	CONBLK,^D14			;[121]CONNECT BLOCK FOR PMR
$DATA	FILCNT,1			;[111]COUNT OF FILES PROCESSED
$DATA	WLDSAV				;[112]SAVE WILD BITS ARE DIR SERVER
$GDATA	MESIN,1				;[134]MESSAGES RECEIVED
$GDATA	MESOUT,1			;[134]MESSAGES SENT
$DATA	INTHAP,1			;[154]INTERRUPT HAS OCCURED
$DATA	LLOPNB,.DOSIZ			;COPY OF LINK OPEN BLOCK
FTACL <	$DATA	NOACCT,1		;[167] -1 remote user didn't send acct
	$DATA	ACLPID,1  >		;[167] Access Control process PID
$DATA	CAPIBL,1			;Enabled capiblities of FAL if enabled
$DATA	DIRNUM,1			;Directory number
$DATA	USRNUM,1			;User number
$DATA	LLJFN				;JFN FOR LOGICAL LINK
$GDATA	LLSTAT				;[134]Last link status from LLCHK
$DATA	LNKSTS				;Link status and state from S
$DATA	MSGFLG				;-1 says message awaiting processing
$DATA	SNDFLG				;-1 says send in progress
$DATA	INTFLG				;-1 says we have unprocess interrupt
$DATA	LLDISC,20			;Disconnect cause stored here
$DATA	CLSBLK,2			;Block for closing link
$DATA	LLNAME,^D45			;JFNS STRING FOR LL JFN


$DATA	RCVLST				;Index for receive list
$DATA	SNDLST				;Index for send list

;Send/Recieve Queue header offsets

	.DPTYP==0			;TYPE FIELD FROM MESSAGE
	.DPFLG==1			;DAP message HEADER flags
	.DPLEN==2			;Starting size of buffer
	.DPSID==3			;DAP message HEADER Stream ID field
	.DPBCT==4			;DAP message HEADER bit count field
	.DPCNT==5			;Number of bytes left in buffer
	.DPBPT==6			;Pointer to DAP message
	.DPHDR==7			;Two words in which to build header
	  .DPSIZ==11			;Number of words in List header area


$DATA	REMOST				;[106]Remote operating system type
$DATA	DAPBEG,0			;Start of area to clear before config
					; messages have been exchanged on the
					; logical link.  The area begins here
					; and continues until the end of the
					; storage defined for the configuration
					; message on the next page.

$DATA	OURVER				;Mutually lowest DAP version supported
$DATA	OURCAP,2			;Mutual capabilities of both ends
$DATA	OURDSP				;Mutual attributes display bits
$DATA	OURMRS				;Mutual Maximum record size
$DATA	OURSIZ				;Mutual maximum buffer size
;This part of the per link data contains the parsed fields
;from each DAP message.

;Field names will have the following format:

;	MSGFLD	Where:

;	MSG	is the three character message name (CFG for config,
;		ATT for Attributes, etc)

;	FLD	is the three character field name (BSZ for bytesize,
;		RCN for record number, etc)

;The DAP messages are defined in DAPSYM.MAC with the following field
;types

;Define macro to allocate storage for all DAP message fields.

DEFINE	XX (MSG,VAL,NAME,FLAG) <

MSG'$ST==..LOC				;;Define start of message offset
MSG'$LN==0				;;Define message storage length
MSG'$FC==0				;;Define message argument count

    DEFINE VV (VER) <>			;;Ignore version comparison this pass
    DEFINE YY (FLD,TYP,SIZ,DEF) <

     LN==1
     IFIDN <TYP><MNU>,<LN==<SIZ*7>/^D36+1> ;;[104]Menu stored 35 bits per word
     IFIDN <TYP><EXF>,<LN==<SIZ*7>/^D36+1> ;;[104]Exf stored 35 bits per word
     IFIDN <TYP><BYT>,<LN==<SIZ*8>/^D33+1> ;;[104]Fix stored 4 bytes per word
     IFIDN <TYP><VAR>,<LN==<SIZ*7>/^D35+1> ;;[104]Var stored 5 bytes per word
     IFIDN <TYP><INT>,<LN==<SIZ*8>/^D33+1> ;;[104]Int stored 4 bytes per word
					    ;;All else requires 1 word

	MSG'$LN==MSG'$LN+LN		;;Accumulate message storage length
	MSG'$FC==MSG'$FC+1		;;Accumulate field count

$DATA	MSG''FLD,LN>

> ;End of XX definition


;Allocate storage for all message arguments

	XLIST
	DOMSG
	LIST
DAPSIZ==<ATTMNU>-<DAPBEG>		;Size of area to clear befor Config
					; Message is exchanged

LNKSIZ==<ATTMNU>-<LNKBEG>		;Size of area to clear before Opening
					; Logical link


;This section of per link storage contains storage for all DAP messages
; (except the CONFIG message) file variables and miscellaneous storage.

					;Area to be cleared for each function
					; Begins with Attributes message storage
					; and continues thru end of this page

;Attributes message fields saved for FAL's wild ACCESS (Open)

$DATA	ATTSAV,ATT$LN

;RAC field from control message saved for every CONTROL

$DATA	RACSAV

;Data modes for this access

$DATA	SRCMOD				;Mode of source file
$DATA	DSTMOD				;Mode of destination file

;[163]Flag to signal if we have opened a file for this ACCESS

$DATA	FILFLG,1			;[163]


;Local file variables

$DATA	PAGBP				;[130]BYTE POINTER INTO PMAP PAGE
$GDATA	PAGNUM				;[130]NEXT FILE PAGE TO PMAP
$DATA	PAGMEM				;[151]PAGE NUMBER OF MAPPED PG IN MEMORY
$DATA	PFBSIZ				;[130]BYTE COUNT
$DATA	EOFCNT				;[130]EOF BYTE NUMBER
$DATA	LINNUM				;[130]LINE NUMBER CHARACTER FLAG
$DATA	LINFLG				;[150]LINE NUMBERED FILE FLAG
$DATA	PAG1				;[130]MARKER TO LOCATE END OF PAGE
$DATA	JFNBLK,20			;GTJFN Block
$GDATA	LOCJFN				;[134]JFN of local file + original flags
$DATA	WLDJFN				;Wild card JFN to hold changed flags
$DATA	LOCDEV				;Device characteristics for local file
$DATA	OPNFLG				;Flags and BSZ for local file open
$GDATA	PAGFLG				;[134]-1 if doing page mode I/O IN BLOCK MODE
					;0 IF NO PMAPS
					;1 IF PMAPS, BUT NOT BLOCK MODE
$DATA	CRCFLG				;-1 if we are computing CRC
$DATA	ACPFLG				;-1 says caller requested ACCOMP
$DATA	FILCRC				;Computed CRC
$DATA	FILFOP				;File options from attributes
$DATA	LOCFDB,.FBLEN			;FDB Data for local file

;MACY11 format storage and flags

$DATA	MCYIDX				;Non-zero if doing MACY11 mode
$DATA	MCYDAT				;Last MACY11 word read

;Remote file variables

$DATA	ATTFDB,.FBLEN			;FDB data from remote file (directory)

;Status text storage

$DATA	STSTXT,20			;Dap status text stored here
$DATA	MSGJNK,10			;Junk string field to dump stuff into

$DATA	SNDSAB,SAB.SZ
$DATA	MSGPTR,1			;Pointer to log message char
$DATA	MSGCNT,1			;Remaining room in MSGTXT

;IPCF message area

$DATA	MSGHDR,MSHSIZ			;Message header area
$DATA	MSGARF				;Message argument flags
$DATA	MSGARC				;Message argument count
$DATA	MSGARH				;Message argument header
$DATA	MSGTXT,200			;Message body goes here

$DATA	FNCEND,0			;End of per function area

FNCSIZ==<FNCEND>-<ATTMNU>		;Size of per function storage
					; Last word to be cleared per function

	NLLPGS==<..LOC/1000>+1		;Number of pages allocated for each
					; Logical link



DATEND::	.ENDPS	DATA		;End of impure storage
SUBTTL Version number and entry vector
;DECLARE VERSION AND ENTRY VECTOR

	LOC	137			;SET THE VERSION
	RELOC
.JBVER:	EXP	VDAP20


PMRFLG::	0			;[121]NO PMR IN SUPPORTED VERSION
;ENTRY VECTOR DEFINITION

ENTVEC:	EXP	0			;NO START ADDRESS
	EXP	0			;NO REENTER ADDRESS
	EXP VDAP20			;VERSION OF DAP20 PROGRAM
SUBTTL	DAP message descriptor blocks

;Each message descriptor fully describes the message format
;and storage for the various fields.  All message types
;are defined here via the DOMSG macro in DAPSYM

;The Message Header values were obtained from the previous expansion of
;DOMSG to allocate storage for the message fields.


;	=======================================
;MSGMSD:!      .DMMSG      !  [ASCIZ\Name\]   ! (Message descriptor)
;	!--------------------------------------
;	!      MSG$LN      !      MSG$ST      !
;	!--------------------------------------
;	!  Message Flags   !      MSG$FC      !
;	!=====================================!
;	! Flags! TYP ! SIZ !  Storage offset  !	(Field descriptor)
;	!--------------------------------------
;	! Version Check word if DA%VER was on !
;	!                OR                   !
;	! Field default word if DA%DEF was on !
;	!-------------------------------------!
;	\				      \
;	\   Field descriptors for each field  \
;	\				      \
;	=======================================

;Message flag definitions

	DA%NOZ==1B0			;Dont zero message on recieve

;Field descriptor flag and field definitions

	DA%VER==1B0			;Version check word is present
	DA%DEF==1B1			;Field default word is present
	DA%TYP==77B8			;Argument type field
	DA%SIZ==777B17			;Maximum argument size in message bytes
	DA%STG==777777B35		;Argument storage offset

;Where	.DMMSG		numeric message type
;	MSG$LN		Length of message argument storage
;	MSG$ST		Starting offset of message argument storage
;	MSG$FC		Number of fields message may contain


;Define a macro to define version check word value to limit our
;menu for cantankerous implimentations...

    DEFINE VV (VER) <%%VV(VER)>
	DEFINE %%VV(VER,ECO,USR,SFT,OST) <
	    EXP DA%VER			;;Flag this is a version word
	    BYTE (8) VER,ECO,USR,SFT (4) OST>

;Define a macro to build message descriptor header

DEFINE	XX (MSG,VAL,NAME,FLAGS<0>) <

MSG'MSD: XWD .DM'MSG,[ASCIZ\NAME\]
	 XWD MSG'$LN,MSG'$ST
	 EXP FLAGS+MSG'$FC

;;Define a macro to build argument descriptors

    DEFINE YY (FIELD,TYP,SIZ,DEF) <
	%%YY==FLD(.AR'TYP,DA%TYP)+FLD(SIZ,DA%SIZ)+FLD(MSG''FIELD,DA%STG)
      IFB  <DEF>,<
	EXP	%%YY>
      IFNB <DEF>,<
	EXP	%%YY+DA%DEF
	EXP	DEF>

    > ;End of YY definition
> ;End of XX definition

;Expand message descriptors for each defined message type


	XLIST
	DOMSG				;;Expand message descriptors
	LIST
SUBTTL	DAP message argument types and processor table

;DAP message argument types are described below.
;There are two processors associated with each argument type.  The
;Argument processors are responsible for converting DAP format to
;internal format (GET) and from internal format to DAP format (PUT)


;MNU	Field is a menu which determines which message fields follow
;	Menu's are stored as extensible fields and cause 1 word of
;	storage to be reserved for every 5 DAP bytes

;EXF	Field is an extensible field which is generally used as a bit
;	map of specific options requested or a menu of message fields
;	which follow.  Extensible fields have 7 information bits per
;	DAP byte and are stored as 36 information bits per word.
;	Bit 35 is the least significant bit of the extensible field.

;FIX	Field is a Byte or group of Bytes.  Dap Bytes are stored
;	right justified 4 per 36 bit word.

;INT	Field is a variable length unsigned integer.  The DAP field
;	is stored as a 36 bit integer value

;VAR	Field is a variable length Ascii field.  It is stored as an
;	ASCIZ string of 7 bit bytes.


;PRO	Field is a file protection field.  Dap protection codes are
;	translated to system protection mask.
;DTI	Field is an 18 byte Date/time argument.  This field is stored
;	internally as a 36 bit quantity.

;IMA	Field is an image field of a DATA message.  This field is not
;	stored, but is processed by the apporpriate data processor


;Define a macro to generate argument processor table entries
; and define values for argument type symbols

DEFINE XX (TYP,CNT) <
	.AR'TYP==ZZ
	ZZ==ZZ+1
	XWD GET'TYP,PUT'TYP>


;Build the argument processor table

	ZZ==0				;Start with argument type 0

ARGTBL:	XLIST
	MSGARG				;Expand argument processor table
	LIST
SUBTTL	Local macro definitions

;MACRO TO GENERATE STATUS CODES
DEFINE	$STATUS (MAC,MIC,MIC2) <
  IFB  <MIC2>,<MOVX S1,FLD(MAC,ER%MAC)+FLD(MIC,ER%MIC)>
  IFNB <MIC2>,<MOVX S1,FLD(MAC,ER%MAC)+FLD(MIC,ER%TYP)+FLD(MIC2,ER%FLD)>
	       SETZM S2>

;MACRO TO GENERATE MESSAGE FORMAT ERRORS
DEFINE	$MFERR (TYP,FLD)	<
		JRST [$STATUS ER$FMT,TYP,FLD
		      $RETF]>

;MACRO TO GENERATE MESSAGE SYNC ERRORS
DEFINE	$MSERR (TYP) <
		JRST [$STATUS ER$SNC,TYP
			 $RETF]>

;MACRO TO GENERATE MESSAGE FIELD ERRORS
DEFINE	$MIERR (TYP,FLD) <
		JRST [$STATUS ER$INV,TYP,FLD
		      $RETF]>

;MACRO TO GENERATE UNSUPPORTED MESSAGE FEATURES ERRORS
DEFINE	$MUERR (TYP,FLD) <
		JRST [$STATUS ER$USP,TYP,FLD
		      $RETF]>

;MACRO TO GENERATE TRANSFER STATUS ERROR MESSAGES
DEFINE	$MTERR (TYP) <
		JRST [$STATUS ER$TRN,TYP
			$RETF]>

DEFINE	$MOERR (TYP) <
		JRST [$STATUS ER$OPN,TYP
			$RETF]>


DEFINE	$MCERR (TYP) <
		JRST [$STATUS ER$TRM,TYP
			$RETF]>


;MACRO TO CHANGE DAP STATE AND MESSAGE DISPATCH
DEFINE	$STATE	(VAL)	<MOVX	S,S%INIT+VAL>

;OPDEF TO RETURN FALSE IF FALSE
OPDEF	$RETIF	[JUMPF	.POPJ]

;OPDEF TO RETURN TRUE IF TRUE
OPDEF	$RETIT	[JUMPT	.POPJ]

;MACRO TO GENERATE POINTER TO TEXT
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
GETTER:	MOVEI	S1,.FHSLF		;Get my last JSYS error
	GETER
	 ERJMP	.+1
	HRRZ	S2,S2			;Return code in S2
	$RETT


SUBTTL	$DEBUG	Macro to display debugging message

DEFINE	$DEBUG	(MSG,ITXT,%L1) <
	SKIPE	MSGDSG
	$CALL	[$TEXT (DEBUG,<[^Q/%L1/ITXT]>)
		 $RET
	%L1:!	 TXT<MSG>]
	SUPPRESS %L1
> ;End of $DEBUG


DEFINE	$FATAL	(MSG,ITXT,%L1) <
	$CALL	[$TEXT (,<?^Q/%L1/ITXT>)
		 PJRST FATAL
	%L1:!	 TXT<MSG>]
	SUPPRESS %L1
> ;End of $FATAL


DEFINE	$WARN	(MSG,ITXT,%L1) <
	$CALL	[$TEXT (,<%^Q/%L1/ITXT>)
		 $RET
	%L1:!	 TXT<MSG>]
	SUPPRESS %L1
> ;End of $WARN
SUBTTL	DEBUG and TYPER output routines

;DEBUG	Text output routine for $DEBUG macro

DEBUG:	MOVE	S2,MSGDSG		;[154]
	EXCH	S1,S2			;Setup for bout
	BOUT
	$RETT

;Routine to Type text and ITEXT

;Accepts	S1/ Output designator
;		S2/ Pointer to asciz text
;		T1/ Address of ITEXT
;		T2/ Prefix character

TYPER:	TRVAR	<TXTBP,<TMPTXT,^D30>> ;Save some space
	EXCH	T2,S2			;Get prefix character
	SKIPE	S2			;Any desired?
	BOUT				;Yes..dump it
	MOVE	S2,T2			;Restore text pointer
	MOVE	T2,[POINT 7,TMPTXT]	;Get a pointer
	MOVEM	T2,TXTBP		;Save for DEPBP
	SKIPE	T1			;Any ITEXT?
	$TEXT	(DEPBP,<^Q/S2/^I/(T1)/>^0)	;Yes..get it
	SKIPN	T1			;Any ITEXT?
	$TEXT	(DEPBP,<^Q/S2/>^0)	;No..just do string
	HRROI	S2,TMPTXT		;Get source designator
	SETZM	T1			;Terminate on a null
	SOUT
	$RETT

DEPBP:	IDPB	S1,TXTBP		;Store per TEXT Byte Pointer
	$RETT
SUBTTL	$GODAP	Macro to establish DAPLIB context

DEFINE	$GODAP (SAVLST) <
	LSTOF.
IFNB <SAVLST>,<$SAVE <S,SAVLST>>
IFB  <SAVLST>,<$SAVE <S>>
	LSTON.
	JSP TF,GODAP>

MULINK <
DEFINE	$GODAP (SAVLST) <
	LSTOF.
IFNB <SAVLST>,<$SAVE <S,CP,SAVLST>>	;SAVE AC'S
IFB  <SAVLST>,<$SAVE <S,CP>>		;JUST SAVE STATUS AND CP
	LSTON.
	JSP	TF,GODAP>
> ;End MULINK


;GODAP	is called upon entry to DAPLIB by the various routines
;	It sets up CP and S which are used throughout DAPLIB
;	to reference the logical link storage and status.

;	All returns to the calling program go through GOUSR
;	which preserves the contents of S which holds the
;	last known link status.

;Accepts	S1/	Link index

;Returns	CP/	Address of link storage
;		S/	Last known link status


GODAP:	MOVEM	P,DAPFRM		;Save frame for Error return
	MOVEI	S1,(S1)			;Get right half only
	CAIL	S1,1			;CHECK ENTRY LIMITS
	CAILE	S1,MAXLNK
	 $FATAL	(Invalid link index)
MULINK <
	SKIPG	CP,LNKPGS-1(S1)		;Point to per/link storage
	 $FATAL (Logial link not established)
>
	MOVE	S,LNKSTS		;Get proper link status flags
	PUSH	P,[GOUSR]		;Stack return address
	MOVEM	P,DAPFRM		;Save frame for error return
	JRST	@TF			;Back to our caller
GOUSR:	MOVEM	S,LNKSTS		;Save link status
	$RET				;No..Return True/False per routine

FATAL:	MOVEI	S1,.DCX38		;User abort
	MOVX	S2,TXT(Fatal error)
	$CALL	D$CLO1			;Close the link
	MOVE	P,DAPFRM		;Restore frame
	$RETF				;Back thru GOUSR
SUBTTL	D$INIT	Daplib initialization

;Accepts	S1/	Size of initialization block
;		S2/	Address of initialization blocl

D$INIT::$SAVE	<P1>			;Preserve an AC
	MOVEM	P,DAPFRM		;Save in case of error
	CAIE	S1,.DISIZ		;Proper arg block size?
	 $FATAL	(Invalid argument block length for D$INIT)
	MOVE	S1,.DIFLG(S2)		;Get flags
	MOVEM	S1,DAPFLG		;Save them
	MOVE	S1,.DIMSG(S2)		;GET message designator
	MOVEM	S1,MSGDSG		;Save it
	LOAD	S1,DAPFLG,DI%CNT	;Get count to allocate
	CAILE	S1,MAXLNK		;Check range
	 $FATAL	(Too many links requested)
	MOVNS	S1			;Negate count
	HRLZ	P1,S1			;Put it in P1
MULINK <
D$INI1:	MOVX	S1,NLLPGS		;Get count of pages per link
	$CALL	M%AQNP			;Get them
	PG2ADR	S1			;Convert to address
	MOVEM	S1,LNKPGS(P1)		;Store in proper place
	AOBJN	P1,D$INI1		;Do all requested
> ;End MULINK

	LOAD	S1,DAPFLG,DI%PGM	;[160]Get program code
	CAIE	S1,%PGNFT		;[160]Are we NFT?
	JRST	D$INI2			;[160]No, we don't need this info
	SETO	S1,			;[160]Yes. -1 is our job
	MOVE	S2,[POINT 7,LOGACT]	;[160]Point to account string buffer
	MOVEM	S2,LGAPTR		;[160]Save the pointer
	GACCT				;[160]Get our current account
	GJINF				;[160]Get our user number
	MOVE	S2,S1			;[160]Prepare for DIRST call
	MOVE	S1,[POINT 7,LOGUSR]	;[160]Point to username buffer
	MOVEM	S1,LGUPTR		;[160]Save the pointer for later
	DIRST				;[160]Translate user number to string
	 SETZM	LGUPTR			;[160]Gag... forget about username
D$INI2:
	$RETT
SUBTTL	D$OPEN	Establish a logical link

;Accepts	S1/ Size of argument block (.DOSIZ)
;		S2/ Address of Argument block

;Returns TRUE	S1/ Link index
;	 FALSE	S1/ Dap error code

D$OPEN::$SAVE	<AP,CP>
	MOVEM	P,DAPFRM		;Save for error
	MOVE	AP,S2			;Save argument address
	CAIE	S1,.DOSIZ		;SIZE MATCH?
	 $FATAL	(Invalid argument block length for D$OPEN)
	SKIPE	PMRFLG			;[121]IF DOING PMR...
	SETOM	PMRFLG			;[121]...SET FLAG TO -1
	LOAD	S1,.DOFLG(S2),DO%LNK	;Get requested link index
D$OPN2:	$GODAP	<T1,T2,T3,T4>		;Get link context
	MOVEI	S1,LNKSIZ		;Clear Link area
	MOVEI	S2,LNKBEG		;...
	$CALL	.ZCHNK
	MOVEI	S1,LLOPNB		;Point to OPEN block
	HRLI	S1,(AP)			;Point to Argument
	BLT	S1,.DOSIZ-1+LLOPNB	;Copy calling argument
	MOVEI	AP,LLOPNB		;Point to our copy
FTACL <	PUSHJ	P,GETACL  >		;[167] Get ACL's PID
	MOVE	S1,.DONOD(AP)		;[106]Address of the node block
	ND$OST==3			;[106]symbol local to NFT
	HRRZ	S1,ND$OST(S1)		;[106]OS type
	MOVEM	S1,REMOST		;[106]Save it for config mess
	$CALL	L%CLST			;Create receive list
	 JUMPE	S1,.-1			;Fudge if first list is 0
	MOVEM	S1,RCVLST		;Remember index
	 JUMPE	S1,.-1			;Should never happen
	$CALL	L%CLST			;Create send list
	MOVEM	S1,SNDLST		;Remember index
	$CALL	LLGJFN			;Go get proper JFN
	$CALL	LLOPEN			;Open and attach to PSI
	MOVE	S1,.DOFLG(AP)		;Get the flags
	TXNE	S1,DO%WCN		;Wait for a connection?
	$CALL	LLWCON			;Yes.. go wait for it.
	$RETT
SUBTTL	D$INTR	Interrupt processing routines

;Accepts	S1/ Link index
;		S2/ Interrupt cause


D$INTR::$GODAP	<DAPFRM>		;Save current frame
	SETOM	INTHAP			;[154]INTERRUPT HAS OCCURED
	MOVX	S1,PC%USR		;Get user mode bit
	SKIPE	SNDFLG			;In LLSEND routine?
	IORM	S1,LEV1PC		;Yes..interrupt SOUT(r)
	SETOM	INTFLG			;Say we've seen an interrupt
	CAIN	S2,.DICDN		;Connect interrupt?
	PJRST	CICON			;Yes..process it
	CAIN	S2,.DIINA		;Interrupt message?
	PJRST	PSIIM			;Yes..read the message
;	CAIN	S2,.DIDAV		;Data available?
;	SETOM	MSGFLG			;Yes..Flag it
	CAIN	S2,.DIACP		;Want to force ACCOMP?
	SETOM	ACPFLG			;Yes..Flag it
	$RETT				;Return

SUBTTL	D$CLOS	Routine to close logical link

;Accepts	S1/	Link index
;		S2/	Address of reason block

;Reason block	Length,,NSP disconnect code
;		Pointer to optional data to be sent

;Returns TRUE	Link has been closed

D$CLOS::$GODAP	<T1,T2,T3,T4>		;Get link context
	SKIPN	LLJFN			;Have a JFN?
	 JRST	FATAL			;[113]
	MOVE	S1,.DCCOD(S2)		;Get the reason code
	TLNN	S1,-2			;Optional data specified?
	TDZA	S2,S2			;No..clear pointer
	MOVE	S2,.DCPTR(S2)		;Yes..get the pointer
	$CALL	D$CLO1			;[162]
 	SETZM	LLSTAT			;[162][134]CLEAR LLSTAT FOR ^A DISPLAY
	$RETT				;[162]

D$CLO1:	SKIPE	LLJFN			;Still have JFN?
	$CALL	LLCLOS			;Yes..Close the link
	SKIPE	S1,RCVLST		;Get receive list index
	$CALL	L%DLST			;Destroy it
	SETZM	RCVLST			;Mark it deleted
	SKIPE	S1,SNDLST		;Get send list index
	$CALL	L%DLST			;Destroy it
	SETZM	SNDLST			;Mark it deleted
	SKIPE	LOCJFN			;Still have JFN?
	$CALL	ABTFIL			;Yes..abort file operation
	SKIPE	LOCJFN			;Still have JFN?
	$CALL	RELJFN			;Yes..release it
	$RETT

SUBTTL	D$STAT	Display link status

;Accepts	S1/ Link index

;Returns TRUE	S1/ Link status
;		    Link is open

;	 FALSE	S1/ Link status
;		    Link is not open

D$STAT::$GODAP	<S2,T1>			;Get link context
	$CALL	LLCHK			;Get the link status
	$RET				;Return status to user
SUBTTL	D$FUNC	Daplib routine to perform a File function

;Accepts	S1/	Function block size
;		S2/	Address of function block

D$FUNC::MOVEM	P,DAPFRM		;Save for errors
	CAIE	S1,.DFSIZ		;Proper size arg
	 $FATAL	(Invalid argument block length for D$FUNC)
	LOAD	S1,.DFFLG(S2),DF%LNK	;Get reqested link
	SKIPN	S1			;link specified?
	SETO	S1,			;No..use current
	$GODAP	<T1,T2,T3,T4,DL,AP>	;Set link context
	MOVE	AP,S2			;Point to calling args
	$CALL	LLWCON			;No..wait for it
	TXNE	S1,MO%SRV		;Is it a server?
	PJRST	SRVMSG			;Yes..Process server messages
	MOVEI	S1,FNCSIZ		;Clear per function storage
	MOVEI	S2,ATTMNU		;...
	$CALL	.ZCHNK			;...
	SKIPE	S1,.DFLFA(AP)		;Get local file switches
	$CALL	SWLOOK			;Find them
	 JUMPF	[$FATAL (Invalid switches for local file)]
	MOVEM	S1,SRCMOD		;Assume local node is Source.
	SKIPE	S1,.DFRFA(AP)		;Get remote file switches
	$CALL	SWLOOK			;Find them
	 JUMPF	[$FATAL (Invalid switches for remote file)]
	MOVE	S2,SRCMOD		;Put local mode in S2
	LOAD	T1,.DFFLG(AP),DF%ACC	;Get our function
	CAIN	T1,AF$CRE		;Creating remote file?
	EXCH	S1,S2			;Yes..S1=Local S2=Remote
	MOVEM	S1,SRCMOD		;Save source mode
	MOVEM	S2,DSTMOD		;Save destination mode
	$CALL	CHKMOD			;Check for valid mode
	 JUMPF	[$FATAL (Can't do requested file format conversion)]
	PJRST	DAPDCN
SUBTTL	SRVMSG	Server initialization and tables

SRVMLS:	SRVS00,,SRVI00			;Server .LLCFG state
	SRVS01,,SRVI01			;Server .LLACC state
	SRVS02,,0			;Server .LLATT state
	SRVS03,,0			;Server .LLCTL state
	SRVS04,,0			;Server .LLDAT state
	SRVS05,,SRVI05			;Server .LLACP state


;Message dispatch for .LLCFG state

SRVS00:	.DMCFG,,SRVCFI			;Accept only Config message
	 0


;Message dispatch for .LLACC state

SRVS01:	.DMCFG,,SRVCFG			;Process Config
	.DMACC,,SRVACC			;Process Access
	.DMATT,,VALATT			;Process Attributes
	 0


;Message dispatch for .LLATT state

SRVS02:	.DMDTI,,VALDTI			;Process Date/time Attributes
	.DMPRO,,VALPRO			;Process Protection Attributes
	.DMACC,,SRVACC			;Process Access
	 0


;Message dispatch for .LLCTL state

SRVS03:	.DMCTL,,SRVCTL			;Process Control
	.DMACP,,SRVACP			;Process ACCOMP
	 0


;Message dispatch for .LLDAT state

SRVS04:	.DMDAT,,[$RETT]			;Processed by GETDAT
	.DMACP,,SRVACP			;Process ACCOMP
	 0

;Message dispatch for .LLACP state

SRVS05:	.DMACP,,SRVACP			;Process ACCOMP
	 0
SUBTTL	Server state initialization routines

;Initialization for .LLCFG state

SRVI00:	MOVEI	S1,DAPSIZ		;Clear Config storage
	MOVEI	S2,DAPBEG		;...
	$CALL	.ZCHNK			;...
	MOVEI	S1,DPMXM		;Set default Max message size
	MOVEM	S1,OURSIZ		;Save for first message
	$RETT

;Initialization for .LLACC state

SRVI01:	SKIPE	LOCJFN			;Clean up any previous file ops
	$CALL	ABTFIL
	SKIPE	LOCJFN
	$CALL	RELJFN
	MOVEI	S1,FNCSIZ		;Clear per function area
	MOVEI	S2,ATTMNU		;...
	$CALL	.ZCHNK
	MOVX	S1,TXT(PS)		;Set default device to PS:
	MOVEM	S1,.GJDEV+JFNBLK	;...
	MOVE	S1,.DOUSR+LLOPNB	;Set default directory to user
	MOVEM	S1,.GJDIR+JFNBLK	;...
	MOVE	S1,[.NULIO,,.NULIO]	;Set null string input
	MOVEM	S1,.GJSRC+JFNBLK	;...
	$RETT

;Initialization for .LLACP state

SRVI05:	TXZ	S,S%EOF!S%GET!S%PUT	;Clear data flags
	$RETT
SUBTTL	SRVMSG	Server message processing loop

SRVMSG:	$CALL	SNDQUE			;Dump the send queues
	 JUMPF	[$CALL	LLRECV		;Check for incomming message
		 JRST	SRVMSG]		;Finish sending messages
	TXZE	S,S%RETN		;Time to return?
	$RET				;Yes..return to caller
	TXZN	S,S%INIT		;State just change?
	JRST	SRVMS1			;No..skip initialization
	HRRZ	S1,SRVMLS(S)		;Do state initialization
	JUMPE	S1,SRVMS1		;If routine is present
	$CALL	0(S1)
	JRST	SRVMSG			;Back to send again

SRVMS1:	SKIPE	MSGFLG			;[0130]If we have a message
	JRST	SRVMS2			;[0130]Don't call LLCHK
	TXNN	S,S%GET			;[154]NEED A MESSAGE?
	JRST	SRVMS2			;[154]YES, GET IT
	SKIPE	INTHAP			;[154]DID AN INTERRUPT OCCUR?
	$CALL	LLCHK			;Check link status
	SKIPF	MSGFLG			;[154]Message available
	JRST	SRVMS2			;Yes..process a message
	$CALL	FILGET			;Get and send data record
	 JUMPF	SRVMS3			;Go send the status
	TXNE	S,S%EOF			;Did we see EOF?
	$CALL	SNDEOF			;Yes..send EOF status
	JRST	SRVMSG			;Back to send next message

SRVMS2:	HLRZ	S1,SRVMLS(S)		;Get proper message list address
	$CALL	GETMSG			;Get a message
	 JUMPF	SRVMS3			;Send failing status
	JRST	SRVMSG			;Process next message

SRVMS3:	$CALL	SNDSTS			;Send status from routine
	$STATE	.LLACC			;Back to initial Access state
	$CALL	ENABLE			;Make sure we are enabled
	JRST	SRVMSG
SUBTTL	SRVCFI	Server routine to process Initial config message

SRVCFI:	$CALL	SRVCFG			;Validate and return config
	 $RETIF				;Return failing status
	$STATE	.LLACC			;Move to access state
	$RETT


SUBTTL	SRVCFG	Server routine to Process Config message

SRVCFG:	$CALL	VALCFG			;Validate the message
	 $RETIF				;Return failing status
	$CALL	SNDCFG			;Send our config message
	$RETT


SUBTTL	SRVACC	Server routine to process an ACCESS message

SRVACC:	$CALL	ENABLE			;No..make sure we are wheel
	MOVE	S1,ACCFNC		;Get the Function field
	CAIL	S1,AF$OPN		;Is it valid
	CAILE	S1,AF$EXE
	$MUERR	.DMACC,20		;No..return unsupported
	HRRO	S2,FNCTXT-AF$OPN(S1)	;
	$TEXT	(,<^Q/S2/>)		;
	MOVX	S1,POLINI		;Initilize CRC to -1
	MOVEM	S1,FILCRC
	MOVE	S1,ACCOPT		;Get the options
	TXNE	S1,AO$CRC		;Want to compute CRC
	SETOM	CRCFLG			;Yes..remember that for all data
	TXNE	S1,AO$RSS!AO$RSR!AO$GO	;Anything we don't support?
	$MUERR	.DMACC,21		;Yes..return unsupported
	MOVE	S1,.DFLFS(AP)		;Point to user storage
	HRROI	S2,ACCFIL		;Point to Access filespec
	$CALL	CPYSTR			;Copy the name
	MOVE	S1,.DFLFS(AP)		;[117]POINT TO FILE NAME
	MOVEI	T1,"."			;[117]A PERIOD
SRVAC1:	ILDB	S2,S1			;[117]GET A BYTE
	JUMPE	S2,SRVAC2		;[117]END OF STRING?
	CAIN	S2,";"			;[117]A SEMI COLON?
	DPB	T1,S1			;[117]CHANGE TO A PERIOD
	JRST	SRVAC1			;[117]KEEP LOOKING

SRVAC2:	LOAD	S1,ACCFNC		;[117]Get desired access
	JRST	@ACCTBL-AF$OPN(S1)	;Dispatch to processor

ACCTBL:	JRST	SRVOPN			;Open existing files
	JRST	SRVCRE			;Create a new file
	$MUERR	.DMACC,20		;Rename (Unsupported)
	JRST	SRVDEL			;Delete files
	$MUERR	.DMACC,20		;Resrvd (Unsupported)
	JRST	SRVDIR			;Directory of files
	JRST	SRVSUB			;Submit file on close
	JRST	SRVEXE			;Execute files

FNCTXT:	[ASCIZ /Opening an existing file/]
	[ASCIZ /Creating a new file/]
	[ASCIZ /Renaming a file (unsupported)/]
	[ASCIZ /Deleting files/]
	[ASCIZ /Reserved function (unsupported)/]
	[ASCIZ /Directory list/]
	[ASCIZ /Create new file then submit on close/]
	[ASCIZ /Submit existing file/]
SUBTTL	SRVOPN	Server routine to process ACCESS (Open)

;SRVOPN	is called while processing an Access(Open).  It is
;	responsible for ensuring that FAL can open the specified
;	file in the mode requested by the attributes message.
;	Since DAP file attributes are not stored as in integral
;	part of the file header (FDB) it is up to the requestor
;	to specify how the file is to be opened.

;	The following rules apply to opening files:
;	1)  If the requestor has sent an attributes message
;	which specifies a non-native file access mode, the
;	specified file will be opened in image mode using the
;	actual file bytesize.
;	2)  If the requestor has sent an attributes message
;	which specifies a native file access mode the file
;	will be opened using the bytesize demanded by that
;	data mode.  (Image mode allows the user to specify
;	the bytesize to use when openning the file)
;	3)  If the requestor has sent an attributes message
;	which specifies Image mode but has excluded the bytesize
;	attribute the actual file bytesize will be used for the
;	open.

;In all cases the attributes returned to the requestor reflect the
;current openning of the file.  (i.e if the requestor wants to see
;the file data as a 36 bit image data but the files bytesize is actually
;7 bits per byte, the attributes returned will say the file is a 36
;bit file since the data will be returned in this fasion.)

;DAP allows the user to use wild cards in the initial ACCESS (Open).
;In this case each file will be opened according to the initial
;attributes message if the requested mode is legal for that file.  If
;the initial mode is not legal for a particular file (e.g the files
;bytesize does not match what is reqired for the data processor) the
;file will be opened in Image mode.


SRVOPN:	$CALL	SETINP			;Setup for file input
	 $RETIF
	MOVE	S1,ATTMNU		;Get menu bits
	TXNN	S1,AT$DAT		;Data mode specified?
	SETZM	ATTDAT			;No..clear bogus default
	TXNN	S1,AT$RFM		;Record format specified?
	SETZM	ATTRFM			;No..clear bogus default
	TXNN	S1,AT$BSZ		;Bytesize specified?
	SETZM	ATTBSZ			;No..clear bogus default
	SKIPN	WLDJFN			;Is this a wild open?
	 JRST	SRVNXT			;[131]No..process the request
	HRLI	S1,ATTMNU		;Yes..Save original attributes
	HRRI	S1,ATTSAV
	BLT	S1,ATT$LN+ATTSAV-1	;[163]
	PJRST	SRVNXT			;Fall into common wild open code
;[131]	SRVNXT	is the entry for an ACCESS (Open)

;[131]	Delete one line at SRVNXT, rename label SRVNX1 to be SRVNXT
;SRVNXT: $CALL	SNDWLD			;[131]Move WILD routine
SRVNXT:	SKIPN	WLDJFN			;[163]Are we wildcarding?
	JRST	SRVNX1			;[163]No, check for read access
	MOVEI	S1,.CKADL		;[163]Directory listing access allowed?
	$CALL	JEDGAR			;[163]
	 JUMPF	SRVNX2			;[163]Try the next file (if it exists)
SRVNX1:	MOVEI	S1,.CKARD		;[163]Make sure requestor can read it
	$CALL	JEDGAR
	 $RETIF				;Return failing status
	MOVX	S1,POLINI		;[133]RESET...
	MOVEM	S1,FILCRC		;[133]...THE CRC
	$CALL	ATLOOK			;Lookup specified attributes
	 JUMPF	[MOVE T1,REMOST		;Get remote system type
		 DMOVE S1,[EXP .MD1,.MD1]	;Assume image mode
		 CAIN T1,.OSTP20		;[103]TOPS20?
		  JRST .+1			;Yes..use image
		 LOAD T2,.FBBYV+LOCFDB,FB%BSZ	;[103]No..check bytesize
		 CAIE T1,.OSTP10		;[103]TOPS10?
		 CAIE T2,^D36			;[103]IF BYTE SIZE IS 36...
		 CAIN T2,^D7			;[103]...OR 7
		 DMOVE S1,[EXP .MD8,.MD8]	;Assume ascii mode
		 JRST .+1]
	MOVEM	S1,SRCMOD		;Save local mode
	MOVEM	S2,DSTMOD		;Save destination mode
	SKIPE	S1,ATTBSZ		;User specified bytesize?
	STORE	S1,.FBBYV+LOCFDB,FB%BSZ	;Yes..use it for Open
	PUSH	P,ATTMRS		;Preserve calling MRS
	MOVEI	S1,ATTMSD		;Clear remaining attributes
	$CALL	CLRMSG
	POP	P,ATTMRS		;Restor calling MRS
	$CALL	SETMOD			;Check for proper mode
	 JUMPF	[$MUERR .DMATT,21]	;Else return bad mode
	MOVE	T1,[POINT 4,MODTB2(S1)]	;Get pointer to destination mode
	ILDB	T1,T1			;Get default destination mode
	SKIPN	T1			;[125]IS THERE A DESTINATION MODE?
	JRST	[$CALL	PICMOD		;[125]NO, GO PICK ONE
		MOVE T1,S1		;[125]SAVE IT IN T1
		JRST .+1]		;[125]RETURN TO MAINLINE CODE
	SKIPN	DSTMOD
	MOVEM	T1,DSTMOD
	MOVEM	S2,ATTBSZ		;Save attributes bytesize
	MOVX	S1,AT$DAT+AT$RFM+AT$RAT+AT$BSZ
	MOVEM	S1,ATTMNU
	$CALL	OPNFIL			;Open the file for input
	 JUMPT	SRVNX3			;[131]Branch if OPENF succeeded
	SKIPE	WLDJFN			;[131]Wild JFN?
	CAIE	S2,OPNX31		;[131]File off-line?
	 $RETF				;[163]No to both, failing return
SRVNX2:	SKIPN	WLDJFN			;[163]Are we wildcarding?
	 $RETF				;[163]No, return failure
	$CALL	NXTINP			;[163]Another file to do?
	JUMPT	SRVNXT			;[163]Yes
	SKIPE	FILFLG			;[163]No, have we opened any files?
	JRST	ACPACK			;[163]Yes, send ACCOMP message
	$STATUS	ER$FIL,ER$FNF		;[163]Return 'file not found' status
	 $RETF				;[163]Failing return

SRVNX3:	SETOM	FILFLG			;[163]Flag we opened at least one file
	SKIPE	WLDJFN			;[131]Wild-carded?
	$CALL	SNDWLD			;[131]Yes, send wild name messages
	MOVE	S1,DSTMOD		;Get destination mode
	MOVE	S2,ATTMRS		;Get MRS from original attributes
	$CALL	SETATT			;Setup proper attributes
	SKIPN	S1,ACCDSP		;Display requested?
	MOVX	S1,DI$ATT		;No..default is attributes
	$CALL	SNDDSP			;Send them off
	$CALL	SNDACK			;Send an ACK for this ACCESS
	$STATE	.LLCTL			;Wait for Control or Accomp
	$RETT
SUBTTL	SRVCRE	Server routine to process ACCESS (Create)

;SRVCRE	is called while processing an ACCESS (Create) message.
;	It is responsible for opening the file in the mode specified
;	by the initial attributes message.

;	Since DAP file attributes are not stored as a part of the
;	file header (FDB) it is up to the requestor to specify how
;	the file is to be created.

;	The following rules apply to creating files:

;	1)  If the user specified that the file be created in a
;	mode not native to our file system, an error will be returned.

;	2)  If the user specified that the file be created in image
;	mode and failed to specify a byte size, the file will be opened
;	as an 8 bit file.  (DAP default for bytesize is 8 bit bytes)

;	3)  If the user specified image mode with a byte size of 0
;	the file will be created as a 36 bit file.

;	4)  If the user specified image mode with a byte size of 1 to 36
;	the file will be created per the requestors wishes.

;	5)  If the user specified ascii mode the file will be opened
;	using a bytesize of 7 .

;In all cases the attributes returned will reflect the current opening
;of the file.

SRVSUB:	MOVX	S1,FB$SUB		;Get submit bit for close
	IORM	S1,ATTFOP		;Remember it
					;Enter common create code

SRVCRE:	$CALL	ATLOOK			;Lookup incomming attributes
	 JUMPF	[$MUERR .DMATT,21]	;Bad data mode
	SKIPN	MODTB7(S1)		;Legal mode for Create?
	 $MUERR	.DMATT,21		;No..bad data mode
	MOVEM	S1,SRCMOD		;Save our source mode
	MOVEM	S2,DSTMOD		;Save destination mode
	$CALL	SETOUT			;Setup to create a file
	 $RETIF				;Return failing status
	MOVEI	S1,.CKACF		;Check access for file creation
	$CALL	JEDGAR			;See if user can create
	 $RETIF				;Return failing status
	SKIPN	S1,ATTBSZ		;Bytesize equal 0?
	MOVEI	S1,^D36			;Yes..make it 36 (if image mode)
	STORE	S1,.FBBYV+LOCFDB,FB%BSZ	;Save for SETMOD
	$CALL	SETMOD			;Setup the data mode
	 JUMPF	[$MUERR	.DMATT,21]	;Else return failing status
	MOVEM	S2,ATTBSZ		;Save bytesize for attributes
	$CALL	OPNFIL			;Open the file for output
	 $RETIF				;Return failing status
	MOVX	S1,AT$DAT+AT$RFM+AT$RAT+AT$DEV+AT$BSZ
	MOVEM	S1,ATTMNU		;Setup minimum attributes menu
	SKIPN	S1,ACCDSP		;Display field present?
	MOVX	S1,DI$ATT		;No..Default is attributes
	$CALL	SNDDSP			;Send them out
	$CALL	SNDACK			;SEND OUT AN ACK
	$STATE	.LLCTL			;Wait for Control or Accomp
	$RETT				;AND RETURN SUCCESS
SUBTTL	SRVDEL	Server routine to process Delete requests

SRVDEL:	MOVEI S1,FILMAX			;[111]SETUP MAX...
	MOVEM S1,FILCNT			;[111]... FILE COUNT PER DAP MESS BUFFER
	MOVEI	S1,ATTMSD		;Clear attributes message
	$CALL	CLRMSG
	MOVX	S1,DT$IMA		;Set image mode
	MOVEM	S1,ATTDAT
	MOVX	S1,FB$UDF		;Undefined format
	MOVEM	S1,ATTRFM
	MOVX	S1,AT$DAT+AT$RFM+AT$BSZ+AT$DEV+AT$BSZ
	MOVEM	S1,ATTMNU		;Set minimum attributes menu
	$CALL	SETINP			;Setup to find existing file
	 $RETIF
SRVDE1:	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ
	MOVEM	S1,ATTBSZ		;Store actual bytesize
	MOVX	S1,.CKAWR		;[165]Write access required
	$CALL	JEDGAR			;[165]Do we have it?
	 JUMPT	SRVDE2			;[165]Yes, go delete the file
	MOVX	S1,.CKACN		;Connect access required
	$CALL	JEDGAR			;CHECK THE ACCESS
	 $RETIF				;Return failing status
	HRRZ	S1,LOCJFN		;[165]We can connect to the directory
	MOVE	S2,[XWD 1,.FBPRT]	;[165]Now check the owner protection
	MOVEI	T1,T1			;[165]
	GTFDB				;[165]Get file protection in T1
	TXNE	T1,200000		;[165]Write protected against owner?
	 JRST	SRVDE2			;[165]No, go delete the file
	$STATUS	ER$FIL,ER$PRV		;[165]Set DAP error status
	MOVEI	S2,DELFX1		;[165]And JSYS error code
	 $RETF				;[165]Failing return
SRVDE2:	SKIPE	S1,ACCDSP		;[165]Want any attributes?
	$CALL	SNDDSP			;No..default is display none
	$CALL	DELFIL			;Delete the file
	 $RETIF				;Return on failure
	SOSG	FILCNT			;[111]IS DAP MESS BUFFER FILLING?
	JRST	[$CALL SNDQUE		;[111]YES, SEND CURRENT MESSAGES
		 MOVEI S1,FILMAX	;[111]RESET...
		 MOVEM S1,FILCNT	;[111]...THE MAX FILE COUNT
		 JRST .+1]		;[111]RETURN TO MAINLINE CODE
	$CALL	NXTINP			;Look for next file
	 JUMPT	SRVDE1			;Found it..go delete it
	$CALL	EXPUNG			;[124]EXPUNGE DELETED FILES
	$CALL	SNDACA			;Send ACCOMP (resp)
	$STATE	.LLACC+S%RETN		;Return to access state
	$RETT
SUBTTL EXPUNG Expunge deleted files

EXPUNG:	MOVX	S1,GJ%DEL		;[124]LOOK FOR DELETED FILES
	IORM	S1,JFNBLK		;[124]THAT MATCH FILE SPEC FROM USER
EXP2:	MOVEI	S1,JFNBLK		;[124]GET LIST OF DELETED FILES
	MOVE	S2,.DFLFS(AP)		;[124]THE FILE SPEC
	GTJFN				;[124]
	 JRST	EXP4			;[124]NONE LEFT
	MOVE	T2,S1			;[124]SAVE THE JFN
EXP3:	HRRZ	S2,S1			;[124]GET JFN WITHOUT FLAGS
	HRROI	S1,MSGTXT		;[124]STRING ADDRESS
	SETZ	T1,			;[124]
	JFNS				;[124]GENERATE FILE SPEC
	MOVX	S1,GJ%SHT+GJ%DEL	;[124]NOW GET NEW JFN
	HRROI	S2,MSGTXT		;[124]
	GTJFN				;[124]
	 JRST EXP4			;[124]
	PUSH	P,S1			;[124]SAVE NEW JFN
	MOVE	S1,T2			;[124]GET OLD JFN
	GNJFN				;[124]GET NEXT JFN
	 SETZ	T2,			;[124]
	POP	P,S1			;[124]GET SECOND JFN
	HRLI	S1,(DF%EXP)		;[124]
	DELF				;[124]EXPUNGE THE FILE
	 JFCL				;[124]
	MOVE	S1,T2			;[124]GET ORIGINAL JFN
	JUMPN	T2,EXP3			;[124]KEEP GOING
EXP4:	MOVX	S1,GJ%DEL		;[124]
	ANDCAM	S1,JFNBLK		;[124]
	$RETT
SUBTTL	SRVEXE	Server routine to process submit requests

SRVEXE:	MOVEI	S1,FILMAX		;[111]RESET...
	MOVEM	S1,FILCNT		;[111]...THE MAX FILE COUNT
	HRROI	S1,[ASCIZ/CTL/]		;Get default extention
	MOVEM	S1,.GJEXT+JFNBLK
	MOVEI	S1,ATTMSD		;Clear initial attributes
	$CALL	CLRMSG			;Clear it
	MOVEI	S1,.MD8			;Set ascii stream attributes
	SETZM	S2			;No MRS or other attributes
	$CALL	SETATT
	$CALL	SETINP			;Set up for file input
	 $RETIF				;Return failing status
SRVEX1:	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ	;Get file bytesize
	CAIE	S1,^D7			;Must be 7 or 36
	CAIN	S1,^D36
	SKIPA				;Ok..submit it
	 $MOERR	ER$BSZ			;Bad bytesize
	MOVX	S1,.CKARD		;Check read access
	$CALL	JEDGAR			;Check access and submit
	 $RETIF				;Return failing status
	$CALL	SUBMIT			;Submit the file
	SKIPE	S1,ACCDSP		;Want any attributes?
	$CALL	SNDDSP			;Yes..send them out
	SOSG	FILCNT			;[111]IS DAP MESS BUFFER FULL?
	JRST	[$CALL SNDQUE		;[111]YES, SEND CURRENT MESSAGES
		 MOVEI S1,FILMAX	;[111]RESET...
		 MOVEM S1,FILCNT	;[111]...THE MAX FILE COUNT
		 JRST .+1]		;[111]
	$CALL	NXTINP			;Get next file in the group
	 JUMPT	SRVEX1			;Back to submit next file
	$CALL	SNDACA			;Send ACCOMP (Resp)
	$STATE	.LLACC+S%RETN		;Return to Access state
	$RETT
SUBTTL	SRVDIR	Server routine to process Directory requests

SRVDIR:	MOVEI	S1,FILMAX		;[111] MAX FILES TO PROC BEFORE SNDQUE
	MOVEM	S1,FILCNT		;[111] SET IT UP
	HRROI	S1,[ASCIZ/*/]		;Get some wild cards
	MOVEM	S1,.GJNAM+JFNBLK	;Set wild filename
	MOVEM	S1,.GJEXT+JFNBLK	;Set wild filetype
	MOVEI	S1,ATTMSD		;Clear attributes message
	$CALL	CLRMSG
	MOVX	S1,DT$IMA		;Attributes are image undefined
	MOVEM	S1,ATTDAT
	MOVX	S1,FB$UDF
	MOVEM	S1,ATTRFM
	MOVX	S1,AT$DAT+AT$RFM+AT$BSZ
	MOVEM	S1,ATTMNU		;Set minimum attributes menu
	$CALL	SETINP			;Set up for file input
	 $RETIF				;Return failing status
	MOVE	S1,WLDJFN		;[112]GET THE BITS
	IOR	S1,[GN%STR+GN%DIR]	;[112]INSURE VOL AND NAME MESS ARE
					;[112]SENT FOR NON WILD DIR
	MOVEM	S1,WLDSAV		;[112]SAVE FOR SNDWLD
SRVDI1:	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ
	MOVEM	S1,ATTBSZ		;Save actual file bytesize
	MOVX	S1,.CKADL		;Check directory list access
	$CALL	JEDGAR			; directory list for file
	 JUMPF	SRVDI2			;Failed - skip this file
	MOVE	S1,WLDSAV		;[112]GET THE SAVED WILD BITS
	AND	S1,[GN%STR+GN%DIR]	;[112]ISOLATE STR AND DIR
	ORM	S1,WLDJFN		;[112]SAVE FOR SNDWLD
	MOVE	S1,[GN%STR+GN%DIR]	;[112]
	ANDCAM	S1,WLDSAV		;[112]TURN THEM OFF NOW
	$CALL	SNDWLD			;Send off proper name messages
	SKIPE	S1,ACCDSP		;Want any attributes returned?
	$CALL	SNDDSP			;Send out requested attributes
	SOSG	FILCNT			;[111]COUNT ANOTHER FILE
	JRST	[$CALL SNDQUE		;[111]TOO MUCH CORE IN USE
		 MOVEI S1,FILMAX	;[111]SEND MESSES AND RESET
		 MOVEM S1,FILCNT	;[111]FILE COUNT
		 JRST .+1]		;[111]
SRVDI2:	$CALL	NXTINP			;Step to next file
	MOVE	S1,WLDJFN		;[112]GET WILD BITS
	AND	S1,[GN%STR+GN%DIR]	;[112]ISOLATE SR AND DIR
	ORM	S1,WLDSAV		;[112]SAVE FOR SNDWLD
	JUMPT	SRVDI1			;Go back and process it
	$CALL	SNDACA			;Send ACCOMP (Resp)
	$STATE	.LLACC+S%RETN		;Return to Access state
	$RETT				; And return success
SUBTTL	SRVCTL	Server routine to process a CONTROL message

SRVCTL:	MOVE	T1,CTLFNC		;Get desired function
	CAIL	T1,CF$GET		;Do we support it?
	CAILE	T1,CF$REW		;...
	 $MUERR	.DMCTL,20		;No..return unsupported
	MOVE	S1,CTLMNU		;Get the menu
	MOVE	S2,RACSAV		;Get old record access field
	TXNN	S1,CT$RAC		;RAC field present?
	JRST	SRVCT1			;No..use the previous one
	MOVE	S2,CTLRAC		;Yes..get it and check it
	CAIL	S2,RB$SQF		;...
	CAILE	S2,RB$BKF		;...
	 $MUERR	.DMCTL,22
	CAIN	S2,RB$VBN		;Random by VBN?
	 $MUERR	.DMCTL,22		;Yes..that's unsupported
	MOVEM	S2,RACSAV		;Save in case of null RAC field
SRVCT1:	MOVEM	S2,CTLRAC		;Save for this access
	SKIPE	CTLKRF			;Was KRF field specified?
	$MUERR	.DMCTL,24		;Yes..return unsupported
	SKIPE	CTLROP			;Was ROP field specified?
	$MUERR	.DMCTL,25		;Yes..return unsupported
	SKIPE	CTLHSH			;Was HSH field specified?
	$MUERR	.DMCTL,26		;Yes..return unsupported
	SKIPE	CTLDSP			;Was display field specified?
	$MUERR	.DMCTL,27		;Yes..return unsupported
	PJRST	@CTLTBL-CF$GET(T1)	;Yes..Dispatch to processor


CTLTBL:	PJRST	CTLGET			;Control (Get)
	PJRST	CTLCON			;Control (Connect)
	$MUERR	.DMCTL,20		;Control (Update) unsupported
	PJRST	CTLPUT			;Control (Put)
	$MUERR	.DMCTL,20		;Control (Delete) unsupported
	$MUERR	.DMCTL,20		;Control (Rewind) unsupported

CTLCON:	$CALL	SNDACK			;Send ACK message
	$RETT

CTLGET:	$STATE	.LLDAT+S%GET		;Getting file records
	MOVE	S1,CTLRAC		;Get access type
	CAIE	S1,RB$BKF		;Block mode file I/O?
	$RETT				;No..just return
	SETOM	PAGFLG			;Yes..do page mode
	MOVE	S1,[GETPAG,,PUTPAG]	;Setup page mode processor
	MOVEM	S1,DATDAT
	MOVE	S1,CTLKEY		;Get the binary key
	MOVEM	S1,DATRCN		;Save it
	$RETT

CTLPUT:	$STATE	.LLDAT+S%PUT		;Writing file records
	$CALL	DISABL			;Allow over quota checking
	MOVE	S1,CTLRAC
	CAIE	S1,RB$BKF		;Block mode file xfer?
	$RETT				;No..just return
	SETOM	PAGFLG			;Yes..set page mode flag
	MOVE	S1,[GETPAG,,PUTPAG]	;Setup proper processor
	MOVEM	S1,DATDAT
	$RETT
SUBTTL	FILGET	Server routine to send data messages

FILGET:	SKIPGE	PAGFLG			;Page mode
	SKIPN	S1,DATRCN		; and not FDB?
	JRST	FILGE1			;No..just send the message
	SUBI	S1,1			;Yes..convert VBN to page number
	LSH	S1,-^D2
	HRL	S1,LOCJFN
	RPACS				;Get page accessibility
	 ERJMP	TERCVT
FILGE1:	MOVEI	S1,DATMSD		;Point to data message
	$CALL	QUEMSG			;Build and send the message
	 $RETIF
	SKIPL	PAGFLG			;Page mode?
	$RETT				;Return
	SKIPN	S1,DATRCN		;Yes..ready for next page
	JRST	FILGE2			;If VBN was 0, start at page 0
	SUBI	S1,1			;Convert to file page number
	LSH	S1,-^D2
	ADDI	S1,1			;Step to next page
FILGE2:	HRL	S1,LOCJFN
	FFUFP				;Find next used page
	 ERJMP	[CAIE S1,FFUFX3		;Eof?
		 PJRST TERCVT		;No..return the failure
		 TXO S,S%EOF		;Yes..mark the status
		 $RETT]
	HRRZ	S1,S1
	LSH	S1,^D2			;Convert to VBN
	ADDI	S1,1
	MOVEM	S1,DATRCN		;Save for next data message
	$RETT
SUBTTL	SRVACP	Server routine to process Access complete message

SRVACP:	$CALL	ENABLE			;Turn on wheel again
	MOVE	T1,ACPFNC		;Get the closing function
	CAIL	T1,AC$TRM		;Within range?
	CAILE	T1,AC$SKP
	 $MUERR	.DMACP,20		;No..Return unsupported
	JRST	@ACPTBL-AC$TRM(T1)	;Do the function

ACPTBL:	PJRST	ACPTRM			;ACCOMP (Close)
	$MIERR	.DMACP,20		;Accomp (Resp) is illegal
	PJRST	ACPPUR			;ACCOMP (Purge)
	PJRST	ACPEOS			;ACCOMP (Eos)
	PJRST	ACPSKP			;ACCOMP (Skip)

ACPPUR:	$CALL	ABTFIL			;Abort current file operation
	PJRST	ACPSKP			;Step to next file
ACPTRM:	$SAVE	<P1>			;Preserve an AC
	$CALL	VALCRC			;Validate the CRC
	 $RETIF				;Return error on failure
	SKIPN	P1,ACPFOP		;Get completion file options
	MOVE	P1,FILFOP		;Else use options from attributes
	TXNE	P1,FB$SUB		;Want to submit file?
	 $CALL	SUBMIT			;Yes..do the submit
	TXNE	P1,FB$SPL		;Want to spool the file
	 $CALL	PRINT			;Yes..do the print
	TXNE	P1,FB$SPL+FB$SUB	;Spooling or printing?
	 JRST	ACPCLS			;Yes..just close the file
	TXNN	P1,FB$DEL		;Want to delete the file?
	JRST	ACPCLS			;No..just close the file
	MOVEI	S1,.CKACN		;Connect access required
	$CALL	JEDGAR
	 $RETIF				;Return on failure
	SETO	S1,			;[137]DELETE THE FILE ON CLOSE
	SETOM	DELFLG			;[137]A FILE WAS DELETED
	SKIPA				;[137]
ACPCLS:	SETZ	S1,			;[137]DON'T DELETE
	$CALL	CLSFIL			;Close current file normally
	 $RETIF				;Return failing status
ACPSKP:	SKIPN	WLDJFN			;Wild JFN?
	JRST	ACPACK			;No..send ACCOMP (Ack)
	$CALL	NXTINP			;Another file to do?
	 JUMPF	ACPACK			;No..send ACCOMP (Ack)
	HRLI	S1,ATTSAV		;Yes..restore initial attributes
	HRRI	S1,ATTMNU		; before calling SRVNXT
	BLT	S1,ATT$LN+ATTMNU-1	;[163]
	SETZM	SRCMOD			;Clear source and destination
	SETZM	DSTMOD			; Modes
	PJRST	SRVNXT			;Process the next file

ACPACK:	SKIPE	DELFLG			;[137]ANY FILES DELETED?
	$CALL	EXPUNG			;[137]YES, EXPUNGE THEM
	SETZM	DELFLG			;[137]RESET THE FLAG
	$CALL	SNDACA			;No..send Accomp (Resp)
	$STATE	.LLACC+S%RETN		;Back to initial access state
	$RETT

ACPEOS:	$CALL	SNDACA			;Send Accomp (Resp)
	$STATE	.LLCTL			;Back to control state
	$RETT
SUBTTL	ENABLE/DISABL Routine to set or clear capabilities for server


ENABLE:	SKIPN	DEBUGW			;Are we debugging
	SKIPE	T1,CAPIBL		; or are we already enabled?
	$RET				;Yes, just return
	MOVEI	S1,.FHSLF		;Get my fork handle
	RPCAP				;Get my capabilites
	TXON	T1,SC%OPR+SC%WHL	;Enable operator and/or wheel
	EPCAP				; if not already enabled
	MOVEM	T1,CAPIBL		;Save for upcomming disable
	$RET

DISABL:	SKIPN	DEBUGW			;Are we debugging?
	SKIPN	T1,CAPIBL		; or are we already disabled?
	$RET				;Yes, just return
	MOVEI	S1,.FHSLF		;Get my for handle
	SETO	S2,
	TXZ	T1,SC%OPR+SC%WHL	;Clear operator and wheel
	EPCAP
	SETZM	CAPIBL			;Say no longer enabled
	$RET
SUBTTL	HOOVER	Routine to validate a users access to a file

;Accepts	S1/ Requested access

;Returns TRUE	Access is allowed
;	 FALSE	Access denied

JEDGAR:	STKVAR	<<CHKBLK,5>>
	MOVEM	S1,.CKAAC+CHKBLK	;Save requested access
	HRRZ	S1,LOCJFN		;Get file JFN
	MOVEM	S1,.CKAUD+CHKBLK	;Save the JFN
	MOVE	S1,DIRNUM		;Get directory number
	MOVEM	S1,.CKACD+CHKBLK	;Save as directory
	MOVE	S1,USRNUM		;Get user number
FTACL <	CAMN	S1,[-1]			;[167] Did ACL give us the OK ???
					;[167] (for the original connect)
	JRST	[MOVE  S1,.CKAAC+CHKBLK	;[167] Yes,,get requested access
		 CAXE  S1,.CKADL	;[167] Doing a directory list?
		 CAXN  S1,.CKARD	;[167] Doing a read ???
		 SKIPA			;[167] Some kind of legal function
		 JRST  JEDGA0		;[167] No,,fail the request for now
		 HRRZ  S1,LOCJFN	;[167] Yes,,must ask for file ok too !
		 PUSHJ P,REQACL		;[167] Ask for permission
		 JUMPF JEDGA0		;[167] Lose,,return priv failure
		 JRST  JEDGA1   ]  >	;[167] Win,,return success

	MOVEM	S1,.CKALD+CHKBLK	;Save as user
	SETZM	.CKAEC+CHKBLK		;Check with no privs
	MOVX	S1,CK%JFN+5		;Set JFN flag and length
	MOVEI	S2,CHKBLK		;Point to args
	CHKAC				;Check the access
	 TDZA	TF,TF			;Jsys failed..return false
	MOVE	TF,S1			;Return True/False per chkacc
	JUMPT	JEDGA1			;Return success
JEDGA0:	$STATUS	ER$FIL,ER$PRV		;[167]Return privilege failure
	MOVE	S2,.CKAAC+CHKBLK	;Get requested access
	MOVE	S2,ACCERR(S2)		;Get proper extended error
	$RETF				;Return the failure

JEDGA1:	MOVE	S1,.CKAAC+CHKBLK	;Get requested access
	CAIE	S1,.CKACF		;Was it create?
	$RETT				;No..just return
	SETZM	S1			;Yes..see if we have room
	HRRZ	S2,LOCJFN
	RCDIR				;Get directory number
	 ERJMP	TERCVT
	MOVE	S1,T1			;Put directory number in S1
	GTDAL				;Get directory allocation
	 ERJMP	TERCVT
	SUB	S1,S2			;Get remaining page count
	LOAD	S2,.FBBYV+ATTFDB,FB%PGC	;Get requested file page count
	CAML	S1,S2			;Enough room?
	$RETT				;Yes..return success
	$STATUS	ER$FIL,ER$FUL		;Report quota exceeded
	$RETF

ACCERR:	OPNX3				;Read access required
	OPNX4				;Write access required
	0
	0
	GJFX32				;[163]No files match this specification
	0
	0
	0
	DELFX1				;Delete access required
	OPNX4				;Write access required
SUBTTL PRINT/SUBMIT Server routine to queue galaxy requests

PRINT:	SKIPA	T1,[.OTLPT]		;Get Printer object type
SUBMIT:	MOVEI	T1,.OTBAT		;Get BATCH object type
	MOVEI	S1,.QOCQE		;Get Create message type
	MOVEM	S1,MSGHDR
	SETZM	.MSFLG+MSGHDR		;Clear the flags
	SETZM	.MSCOD+MSGHDR		;Clear the ack code
	SETZM	MSGARF			;Clear argument flags
	MOVEI	S1,4			;Get minimum argument count
	MOVEM	S1,MSGARC		;Save it
	MOVE	S1,[2,,.QCQUE]		;Store que type argement header
	MOVEM	S1,2+MSGARF
	MOVEM	T1,3+MSGARF		;Store queue object type
	MOVE	S1,[2,,.QCOID]		;Store user-id header
	MOVEM	S1,4+MSGARF
	MOVE	S1,USRNUM		;Store user number
	MOVEM	S1,5+MSGARF
	MOVEI	S1,6+MSGARF		;Point to next header
	CAIE	T1,.OTBAT		;Submit?
	JRST	PRIN10			;No..don't send log disposition
	MOVE	S2,[2,,.QCCDI]		;Store connected directory
	MOVEM	S2,0(S1)
	MOVE	S2,DIRNUM		;Use users directory
	MOVEM	S2,1(S1)
	ADDI	S1,2			;Point to next header
	AOS	MSGARC			;Bump argument count
	MOVE	S2,[2,,.QCBLT]		;Store log file disposition
	MOVEM	S2,0(S1)
	MOVEI	S2,%BAPND		;Append logfile
	MOVEM	S2,1(S1)
	ADDI	S1,2			;Point to next free arg
	AOS	MSGARC			;Bump argument count
PRIN10:	MOVEI	S2,.QCFIL		;Store file type
	MOVEM	S2,(S1)
	HRROI	S2,NAMFSP		;Point to file
	$CALL	STRARG			;Store it
	PUSH	P,S1			;[144]SAVE S1
	PUSH	P,T1			;[144]SAVE T1
	SETZM	LLNAME			;[144]FOR THE FILE TYPE
	HRROI	S1,LLNAME		;[144]STRING POINTER
	HRRZ	S2,LOCJFN		;[144]LOCAL FILE JFN
	MOVX	T1,1B11			;[144]FILE TYPE ONLY
	JFNS				;[144]GET THE FILE TYPE
	POP	P,T1			;[144]RESTORE T1
	POP	P,S1			;[144]RESTORE S1
	MOVE	S2,[ASCIZ /DAT/]	;[144]FORTRAN FILE TYPE
	CAMN	S2,LLNAME		;[144]TYPE WAS .DAT?
	JRST	[AOS MSGARC		;[144]YES,INCREMENT ARG COUNT
		MOVE S2,[2,,.QCPTP]	;[144]FILE FORMAT HEADER
		MOVEM S2,0(S1)		;[144]PUT IN MESSSAGE
		ADDI S1,1		;[144]BUMP POINTER
		MOVEI S2,.FPFFO		;[144]/FILE:FORTRAN
		MOVEM S2,0(S1)		;[144]PUT IN MESSAGE
		ADDI S1,1		;[144]BUMP POINTER
		JRST .+1]		;[144]JOIN MAINLINE CODE
	MOVEI	S2,.QCNAM		;Get user string function
	MOVEM	S2,0(S1)		;Store user function
	MOVE	S2,.DOUSR+LLOPNB	;Point to user string
	$CALL	STRARG			;Store it
	SKIPN	.DOUSR+LLOPNB		;Account specified?
	JRST	PRIN20			;No..send what we have
	AOS	MSGARC			;Yes..bump arg count
	MOVEI	S2,.QCACT		;Store account header
	MOVEM	S2,0(S1)
	MOVE	S2,.DOACT+LLOPNB	;Point to account string
	$CALL	STRARG			;Copy the string
PRIN20:	SUBI	S1,MSGHDR		;Get message length
	HRLM	S1,MSGHDR		;[0115]Message length
	MOVEI	S2,MSGHDR		;Get message address
	PJRST	SNDQSR			;Send it to QUASAR

STRARG:	HRRZ	T2,S1			;Remember header address
	HRROI	S1,1(S1)		;Point to destination
	SETZ	T1,			;Terminate on null
	SOUT
	MOVEI	S1,1(S1)		;Point S1 to next word
	MOVE	T1,S1
	SUB	T1,T2			;Compute argument length
	HRLM	T1,0(T2)		;Save in header
	$RETT				;Return
	SUBTTL	REQACL - Ask the Access Control process for authorization

	;CALL:	S1/ 0	- If requesting user authorization
	;	S1/ JFN - If requesting file authorization
	;
	;RET:	True if access permitted, false otherwise

FTACL <
REQACL:	PUSHJ	P,.SAVE3		;[167] Save P1 - P3
	MOVE	P1,S1			;[167] Save the JFN if there is one
	SETZM	MSGHDR			;[167] Clear the first word of the msg
	MOVE	S1,[MSGHDR,,MSGHDR+1]	;[167] Clear the rest
	BLT	S1,MSGHDR+200		;[167]    of the message
	SETZM	SNDSAB			;[167] Clear the first word of the SAB
	MOVE	S1,[SNDSAB,,SNDSAB+1]	;[167] Clear the rest
	BLT	S1,SNDSAB+SAB.SZ-1	;[167]    of the SAB
	MOVE	S1,[.OHDRS,,.ACVAL]	;[167] Get the msg header
	MOVEM	S1,.MSTYP+MSGHDR	;[167] Save it
	MOVSI	P2,-4			;[167] Do the asciz blocks first
	MOVEI	P3,.OHDRS+MSGHDR	;[167] Point to the first block
REQA.1:	MOVE	S2,[EXP .DONOD,.DOUSR,.DOACT,.DOPSW](P2) ;[167] Get the txt
	CAIN	S2,.DOACT		;[167] Is this the account string ???
	SKIPN	NOACCT			;[167] Yes,,is it really there ???
	SKIPN	S2,LLOPNB(S2)		;[167] Any text specified ???
	JRST	REQA.2			;[167] No,,check next block
	AOS	.OARGC+MSGHDR		;[167] Bump the block count by 1
	MOVE	S1,[EXP .BLNOD,.BLUSR,.BLACC,.BLPSW](P2) ;[167] Get blk type
	STORE	S1,ARG.HD(P3),AR.TYP	;[167] Insert into block header
	HRROI	S1,ARG.DA(P3)		;[167] Point to the output area
	SETZ	T1,			;[167] Stop on a null
	SOUT				;[167] Copy the text into the block
	SUBI	S1,-2(P3)		;[167] Calc the block len (pad a little)
	HRRZS	S1			;[167] Get just the length
	STORE	S1,ARG.HD(P3),AR.LEN	;[167] Save it
	ADDI	P3,0(S1)		;[167] Point to the next block
	MOVSS	S1			;[167] Get length,,0
	ADDM	S1,.MSTYP+MSGHDR	;[167] Bump message length
REQA.2:	AOBJN	P2,REQA.1		;[167] Look at all blocks
	JUMPE	P1,REQA.3		;[167] No JFN,,send what we have
	MOVX	S1,.BLFIL		;[167] Get the block type
	MOVEM	S1,ARG.HD(P3)		;[167] Save it
	HRROI	S1,ARG.DA(P3)		;[167] Point to the output area
	MOVE	S2,P1			;[167] Get the JFN in S2
	MOVX	T1,FFSPEC		;[167] Want DEV:<DIR>FILE.EXT.GEN
	JFNS				;[167] Get it
	SUBI	S1,-2(P3)		;[167] Calc the block len (pad a little)
	HRLZS	S1			;[167] Get just the length,,0
	ADDM	S1,ARG.HD(P3)		;[167] Save block length
	ADDM	S1,.MSTYP+MSGHDR	;[167] And the message length
	AOS	.OARGC+MSGHDR		;[167] Bump the arg count by 1

REQA.3:	MOVEI	S1,MSGHDR		;[167] Get the message address
	MOVEM	S1,SNDSAB+SAB.MS	;[167] Save it
	LOAD	S1,.MSTYP+MSGHDR,MS.CNT	;[167] Get the message length
	MOVEM	S1,SNDSAB+SAB.LN	;[167] Save in the SAB
	MOVE	S1,ACLPID		;[167] Get ACL's PID
	MOVEM	S1,SNDSAB+SAB.PD	;[167] Save it

	;[167] Continued on the next page
	;[167] Continued from the previous page

	MOVEI	S1,SAB.SZ		;[167] Get the SAB length
	MOVEI	S2,SNDSAB		;[167] And the address
	PUSHJ	P,C%SEND		;[167] Send the request
	JUMPF	.RETF			;[167] Lose,,tough noogies !!!
REQA.4:	PUSHJ	P,C%BRCV		;[167] Wait for the response
	MOVE	S2,MDB.SP(S1)		;[167] Get the senders PID
	CAME	S2,ACLPID		;[167] Did we send to this guy ???
	JRST	[PUSHJ P,C%REL		;[167] No,,release the message
		 JRST  REQA.4 ]		;[167] And try again
	LOAD	S1,MDB.MS(S1),MD.ADR	;[167] Get the response address
	LOAD	P1,.MSFLG(S1),MF.FAT	;[167] Get request failed status
	PUSHJ	P,C%REL			;[167] Release the IPCF message
	JUMPE	P1,.RETT		;[167] Request succeeded,,return OK
	$RETF				;[167] Lose,,return failure
> ;[167] End REQACL routine
	SUBTTL	GETACL - Routine to get the Access Control process PID

	;CALL:	No Args
	;
	;RET:	True Always - ALCPID/ 0 or the Access Control PID

FTACL <
GETACL:	LOAD	S1,LLOPNB+.DOFLG,DO%SRV	;[167] Get 'server' flag bit
	JUMPE	S1,.RETT		;[167] Return if not a server
	MOVE	S1,[103050,,.IPCIW]	;[167] Read Named PID
	MOVEM	S1,MSGHDR+.IPCI0	;[167] Set it
	SETZM	MSGHDR+.IPCI1		;[167] No aux PID
	HRROI	S1,MSGHDR+.IPCI2	;[167] Get pointer to PID name
	HRROI	S2,[ASCIZ/FILE-ACCESS-CONTROL/] ;[167] Get source name
	SETZ	T1,			;[167] Stop on null
	SOUT				;[167] Copy the name
	SUBI	S1,MSGHDR-1		;[167] Calc msg length
	HRRZM	S1,SNDSAB+SAB.LN	;[167] Save it
	MOVEI	S1,MSGHDR		;[167] Get the message address
	MOVEM	S1,SNDSAB+SAB.MS	;[167] Save it
	MOVX	S1,SP.INF		;[167] Get [SYSTEM]INFO PID index
	TXO	S1,SI.FLG		;[167] Set special index flag
	MOVEM	S1,SNDSAB+SAB.SI	;[167] Set it
	SETZM	SNDSAB+SAB.PD		;[167] No PID
	MOVEI	S1,SAB.SZ		;[167] Get SAB length
	MOVEI	S2,SNDSAB		;[167] Get SAB address
	$CALL	C%SEND			;[167] Ask [SYSTEM]INFO for the PID
GETA.1:	$CALL	C%BRCV			;[167] Get the ack back
	LOAD	S1,MDB.MS(S1),MD.ADR	;[167] Get the response address
	MOVE	S2,.IPCI0(S1)		;[167] Get the header word
	CAME	S2,MSGHDR+.IPCI0	;[167] Do headers match ???
	JRST	GETA.1			;[167] No,,must wrong msg,,try again
	MOVE	S2,.IPCI1(S1)		;[167] Get the PID
	MOVEM	S2,ACLPID		;[167] Save it
	$RETT				;[167] Return
> ;End GETACL routine
SUBTTL	SNDQSR	Routine to send message to quasar

;ACCEPTS	S1/ Length of message
;		S2/ Address of message

SNDQSR:	MOVX	T1,SP.QSR		;Get quasars index
	TXO	T1,SI.FLG		;Set special index flag
	MOVEM	T1,SAB.SI+SNDSAB
	SETZM	SAB.PD+SNDSAB		;Clear the pid
	MOVX	T1,MF.ACK		;Lite ack bit
	IORM	T1,.MSFLG(S2)		;Store in message
	MOVEM	S1,SAB.LN+SNDSAB	;Store the length
	MOVEM	S2,SAB.MS+SNDSAB	;Store the address
	MOVEI	S1,SAB.SZ
	MOVEI	S2,SNDSAB
	$CALL	C%SEND
	$CALL	C%BRCV			;Get the ack from QUASAR
	$RET				;Return true/false per C%SEND
SUBTTL	DAPDCN	Active Task function dispatch

DAPDCN:	$STATE	.LLCFG			;Start at Config state
	SKIPN	CFGVER			;Exchanged config messages?
	$CALL	DCNMSG			;No..Exchange Config messages
	 $RETIF				;Return failing status

	$STATE	.LLACC			;Step to access state
	MOVE	S1,[.NULIO,,.NULIO]	;Set null string input
	MOVEM	S1,.GJSRC+JFNBLK	;...
	HRROI	S1,ACCFIL		;Store remote filespec
	SKIPE	S2,.DFRFS(AP)		;Pointer present?
	$CALL	CPYSTR			;Yes..store it
	MOVE	S1,.DFRFO(AP)		;Get remote file options
	MOVEM	S1,ACCOPT		;Save for access
	LOAD	S1,.DFFLG(AP),DF%ACC	;Get desired function
	STORE	S1,ACCFNC
	CAIL	S1,AF$OPN		;Actual DAP function?
	CAILE	S1,AF$EXE		;...
	JRST	DAPDC1			;No..Check for special request
	$CALL	@DCNTBL-AF$OPN(S1)	;Process the request
	JUMPF	DCNABT			;Abort link on error
	$RETT

DCNABT:	HRROI	T1,STSTXT		;Expand failing status
	TXNN	S,S%LERR		;Did we receive status?
	$CALL	TYPSTS			;No..expand our message
	MOVX	T1,TXT(Local status - ) ;[147]Assume local status error
	TXNE	S,S%LERR		;Unless we received status
	MOVX	T1,TXT(Remote status - );Get Remote status error
	HRROI	T2,STSTXT		;Point to expaned text
	$FATAL	(,^Q/T1/^Q/T2/)		;Display message and return


DCNTBL:	JRST	DCNREC			;AF$OPN - Recieve existing files
	JRST	DCNSND			;AF$CRE - Send existing file
	JRST	DCNREN			;AF$REN - Rename existing files
	JRST	DCNDEL			;AF$DEL - Delete existing files
	JRST	DAPDC2			;Function 5 (reserved)
	JRST	DCNDIR			;AF$DIR - Directory of files
	JRST	DCNSUB			;AF$SUB - Send and execute file
	JRST	DCNEXE			;AF$EXE - Execute existing file

DAPDC1:	CAIL	S1,AF$TYP		;Special function?
	CAILE	S1,AF$PRN		;...
DAPDC2:	$FATAL	(Function not implimented)
	$CALL	@DCNTB1-AF$TYP(S1)	;Process the request
	JUMPF	DCNABT
	$RETT

DCNTB1:	JRST	DCNTYP			;AF$TYP - Type remote files
	JRST	DCNPRN			;AF$PRN	- Print remote files
SUBTTL	Active Task message and State tables

DCNMLS:	DCNS00,,DCNI00			;DCN .LLCFG state
	DCNS01,,0			;DCN .LLACC state
	DCNS02,,0			;DCN .LLATT state
	DCNS03,,0			;DCN .LLCTL state
	DCNS04,,0			;DCN .LLDAT state
	DCNS05,,DCNI05			;DCN .LLACP state


;Message dispatch for .LLCFG state

DCNS00:	.DMCFG,,DCNCFG
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLACC state

DCNS01:	.DMACP,,DCNACP
	.DMNAM,,DCNNAM
	.DMATT,,VALATT
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLATT state

DCNS02:	.DMDTI,,VALDTI
	.DMPRO,,VALPRO
	.DMNAM,,ATTNAM
	.DMACK,,ATTACK
	.DMACP,,ATTACP
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLCTL state

DCNS03:	.DMACK,,CTLACK
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLDAT state

DCNS04:	.DMDAT,,[$RETT]			;Processed by GETDAT
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLACP state

DCNS05:	.DMACP,,DCNACP
	.DMNAM,,ACPNAM
	.DMSTS,,DCNSTS
	.DMDAT,,[$RETT]
	 0
SUBTTL	Active Task state initialization routines

;Active Task initialization for .LLCFG state

DCNI00:	MOVEI	S1,DAPSIZ		;Clear Config storage
	MOVEI	S2,DAPBEG		;...
	$CALL	.ZCHNK			;...
	MOVEI	S1,DPMXM		;Store maximum message size
	MOVEM	S1,OURSIZ
	$CALL	SNDCFG			;Send config message
	$RETT



;Active Task initialization for .LLACP state

DCNI05:	$CALL	SNDACP			;Send an access complete
	$RETT
SUBTTL	DCNMSG	Active Task message processing routine

DCNMSG:	$CALL	SNDQUE			;Dump the send queues
	 JUMPF	[$CALL	LLRECV		;Check for incomming messages
		 JRST	DCNMSG]		;Finish sending what we started
	TXZN	S,S%INIT		;State just change?
	JRST	DCNMS1			;No..check for messages
	HRRZ	S1,DCNMLS(S)		;Get initialization address
	JUMPE	S1,DCNMS1		;State initialization routine?
	$CALL	0(S1)			;Yes..Call it
	JRST	DCNMSG			;Back to send again

DCNMS1:	SKIPE	MSGFLG			;[0130]If there is a message
	JRST	DCNMS2			;[0130]Don't call LLCHK
	TXNN	S,S%PUT			;[154]DO WE NEED A MESSAGE?
	JRST	DCNMS2			;[154]YES, GO DO IT
	SKIPE	INTHAP			;[154]DID AN INTERRUPT OCCUR?
	$CALL	LLCHK			;Get link status
	SKIPF	MSGFLG			;[154]Message available?
	JRST	DCNMS2			;Yes..go process the message
	$CALL	FILGET			;Send a record
	 $RETIF				;Else return the status
	TXNN	S,S%EOF			;Seen EOF?
	JRST	DCNMSG			;No..back to send next record
	$RETT				;Yes..return to caller

DCNMS2:	CAIE	S,.LLDAT		;In data state?
	JRST	DCNMS3			;No..dont check ACPFLG yet
	AOSN	ACPFLG			;Want early ACCOMP
	$RETT				;Yes..return to send it
DCNMS3:	HLRZ	S1,DCNMLS(S)		;Get message list address
	$CALL	GETMSG			;Read the message
	 $RETIF				;Return failing status
	TXZN	S,S%RETN		;Return to caller?
	JRST	DCNMSG			;No..Back to get next message
	$RETT
SUBTTL	DCNCFG	Routine to process Config message

DCNCFG:	$CALL	VALCFG			;Validate the Config
	 $RETIF				;Return failing status
	$STATE	.LLACC			;Move to next state
	TXO	S,S%RETN		;Return to caller
	$RETT
SUBTTL	DCNNAM	Routine to process Name message


ATTNAM:	$CALL	VALNAM			;Validate the message
	 $RETIF				;Return failing status
	TXNE	S1,NA$FSP		;Filespec?
	JRST	DCNNA1			;Yes..Call user with the message
	$CALL	DCNATR			;Call user with our attributes
ACPNAM:	MOVNS	.DPTYP(DL)		;Request Reparse of this message
	TXO	S,S%RETN		;Return to caller
	$RETT

DCNNAM:	$CALL	VALNAM			;Validate the name
	 $RETIF				;Return failing status
DCNNA1:	HRLZ	S1,S1			;Put flags in left half of S1
	HRRI	S1,.DMNAM		;Identify name message
	$CALL	DCNRTN			;Call user routine
	$RETT				;Return success

SUBTTL	ATTACK	Routine to process ACK for Attributes message
SUBTTL	CTLACK	Routine to process ACK for Control message

ATTACK:	MOVX	S1,.DMACK		;Get ack message type
	MOVEI	S2,ATTFDB		;Point to FDB
	$CALL	DCNRTN			;Call user routine
CTLACK:	TXO	S,S%RETN		;Return to caller
	$RETT				;Return success



SUBTTL	DCNACP	Routine to process Accomp (Resp)

ATTACP:	$CALL	DCNATR			;Call user with attributes
DCNACP:	TXO	S,S%ACP+S%RETN		;Set Accomp and return flags
	MOVX	S1,.DMACP		;Get message type
	$CALL	DCNRTN			;Call user routine
	$RETT				;Return success


SUBTTL	DCNSTS	Routine to process Status message

DCNSTS:	MOVE	S1,STSCOD		;Get the status code
	MOVE	S2,STSSTV		;Get the extended status
	CAXE	S1,FLD(ER$TRN,ER%MAC)+FLD(ER$EOF,ER%MIC)	;EOF?
	 JRST	DCNSTE			;No..return the status
	TXO	S,S%EOF+S%RETN		;Yes..Set EOF and return flags
	$RETT

DCNSTE:	HRROI	T1,STSTXT		;Point to text storage
	$CALL	TYPSTS			;Expand this error
	TXO	S,S%LERR			;Set remote status error flag
	$RETF

SUBTTL	DCNATR	Routine to call user with received attributes

DCNATR:	MOVEI	S1,.DMATT		;Say we have an attribute msg
	MOVEI	S2,ATTFDB		;Point to the fudged FDB
DCNRTN:	SKIPE	.DFRTN(AP)		;User routine specified?
	$CALL	@.DFRTN(AP)		;Yes..call it
	$RET				;Return TF from user routine
SUBTTL	DCNREC	Active Task routine to receive a file

DCNREC:	MOVEI	S1,ATTMSD		;Clear initial attributes msg
	$CALL	CLRMSG
	SKIPN	S1,SRCMOD		;[125]Get our source mode
	MOVEI	S1,.MD8			;[125]DEFAULT TO ASCII
	MOVE	S2,REMOST		;[125]GET OUR SYSTEM TYPE
	CAIN	S2,.OSTP20		;[125]TOPS20?
	JRST	[SKIPN SRCMOD		;[125]YES, DEF FOR 20S IS IMAGE
		SETZ S1,		;[125]
		JRST .+1]		;[125]
	MOVE	S2,.DFRFA(AP)		;[125]GET REMOTE SWITCHES
	TXNN	S2,DF%MRS		;[125]was MRS specified?
	IORX	S2,<FLD(^D512,DF%MRS)>	;[125]No..default to 512
	$CALL	SETATT			;[125]Yes..setup requested mode
	$CALL	SNDATT			;Send of dummy attributes
	MOVX	S2,FB$GET		;Setup Access message
	MOVEM	S2,ACCFAC		; to allow shared reading
	MOVE	S1,OURDSP		;Setup access display
	MOVEM	S1,ACCDSP		; to request all attributes
	SETOM	CRCFLG			;Request CRC validation
	$CALL	SNDACC			;Send out file Access message
DCNR20:	MOVX	S1,POLINI		;[133]
	MOVEM	S1,FILCRC		;[133]INITIALIZE CRC
	$STATE	.LLACC			;Wait for file attributes
	$CALL	DCNMSG			;Get Servers response
	 $RETIF				;Return failing status

	$CALL	ATLOOK			;Lookup the attributes
	 JUMPF	[SKIPN S1,SRCMOD		;Get source mode
		 $FATAL (Remote file attributes not supported)
		 $WARN	(File attributes don't match processing mode)
		 PUSH P,ATTMOD(S1)		;Save default destination mode
		 MOVE S2,.DFRFA(AP)		;Setup specified attributes
		 TXNN	S2,DF%MRS		;MRS specified?
		 IORX	S2,<FLD(^D512,DF%MRS)>	;No..use nice default
		 $CALL SETATT			;Set the attributes
		 POP	P,S2		;Get default destination mode
		 JRST .+1]		;Proceed
	SKIPE	SRCMOD			;Have a source mode
	 JRST	[CAME	S1,SRCMOD	;Yes..see if it matches
		 $WARN	(File attributes don't match processing mode)
		 JRST .+2]		;Proceed
	MOVEM	S1,SRCMOD		;No..store what we have
	SKIPN	DSTMOD			;Have a destination mode?
	MOVEM	S2,DSTMOD		;No..store our default
	$CALL	CHKMOD			;Make sure modes are legal
	 JUMPF	[$FATAL	(Illegal destination processing mode)]
	$CALL	SETOUT			;Setup for local file output
	 $RETIF				;[147]
	MOVEI	S1,.DMNAM		;Give caller expanded filespec
	$CALL	DCNRTN
	MOVE	S1,ATTBSZ		;Get attributes byte size
	STORE	S1,.FBBYV+LOCFDB,FB%BSZ	;Save for image mode
	$CALL	SETMOD			;Setup data mode
	 JUMPF	[$FATAL	(Can't establish requested mode for output)]
	$CALL	OPNFIL			;OPEN LOCAL FILE FOR OUTPUT
	 $RETIF				;[147]
	$CALL	SNDCTC			;START UP A DATA STREAM
	$STATE	.LLCTL			;Get response to control
	$CALL	DCNMSG			;GET ACK FROM SERVER
	 $RETIF				;Return failing status
	$CALL	SNDCTR			;Start record retrivial
	LOAD	S2,LOCDEV,DV%TYP	;GET DEVICE TYPE
	CAIE	S2,.DVTTY		;IS IT A TTY?
	JRST	DCNR30			;NO -- GET FIRST MESSAGE
	MOVX	S1,.CHCRT		;YES - START WITH A <CRLF>
	$CALL	OUTBYT			;Write to terminal
	 $RETIF				;Return the failure on error
	MOVX	S1,.CHLFD		;...
	$CALL	OUTBYT			;Write to terminal
	 $RETIF
DCNR30:	$STATE	.LLDAT			;Accept Data or Status
	$CALL	DCNMSG			;Process Data until EOF Status
	 $RETIF				;Return failing status
	$CALL	TSTPRN			;Terminate print file format
	$STATE	.LLACP			;Wait for Accomp (Resp)
	$CALL	DCNMSG			;GET THE ACCOMP ACK
	 $RETIF				;Return failing status
	SETZ	S1,			;[137]DON'T DELETE
	$CALL	CLSFIL			;CLOSE OUT LOCAL FILE
	 $RETIF				;[147]
	TXNE	S,S%ACP			;Access complete?
	$RETT				;Yes..just return
	SKIPN	.DFRFA(AP)		;Remote mode specified?
	SETZM	SRCMOD			;No..clear sorce mode
	SKIPN	.DFLFA(AP)		;Local mode specified?
	SETZM	DSTMOD			;No..clear destination mode
	JRST	DCNR20			;Back for next file
SUBTTL	DCNTYP	Active task to type remote files

DCNTYP:	MOVEI	S1,ATTMSD		;Clear initial attributes
	$CALL	CLRMSG
	$CALL	PICMOD			;[156]Pick default file mode
					;by system type
	MOVX	S2,<FLD(^D512,DF%MRS)>	;Default MRS
	$CALL	SETATT			;Set up dummy attributes message
	$CALL	SNDATT			;Send of dummy attributes
	MOVEI	S1,.PRIOU		;Output to terminal
	MOVEM	S1,LOCJFN
	MOVX	S1,AF$OPN		;Function is read existing file
	MOVEM	S1,ACCFNC
	MOVX	S1,FB$GET		;SET UP FAC FIELD
	MOVEM	S1,ACCFAC		;TO ALLOW SHARED READING
	MOVX	S1,DI$ATT+DI$NAM	;Display Attributes and name
	MOVEM	S1,ACCDSP
	$CALL	SNDACC			;Send out file Access message
DCNT20:	MOVX	S1,POLINI		;[133]
	MOVEM	S1,FILCRC		;[133]INITIALIZE CRC
	$STATE	.LLACC			;Get attributes and Ack
	$CALL	DCNMSG			;Get Servers response
	 $RETIF				;Return failing status
	$CALL	ATLOOK			;Find attributes
	 JUMPF	[$FATAL	(Remote file attributes not supported)]
	MOVEM	S1,SRCMOD		;Save the mode
	MOVEM	S2,DSTMOD		;Save default output mode
	CAIE	S2,.MD8			;Destination mode must be ascii
	 $FATAL	(File is not ASCII)
	MOVE	S1,MODTB3(S1)		;Get processor address
	MOVEM	S1,DATDAT		;Save it
	$CALL	SNDCTC			;START UP A DATA STREAM
	$STATE	.LLCTL			;Accept Ack from server
	$CALL	DCNMSG			;Get the Ack
	 $RETIF				;Return failing status
	$CALL	SNDCTR			;Start record retrivial
	$STATE	.LLDAT			;Accept Data or Status
	$CALL	DCNMSG
	 $RETIF				;Return failing status
	$CALL	TSTPRN			;Do CRLF if needed
	$STATE	.LLACP			;Wait for Access complete
	$CALL	DCNMSG			;GET THE ACCOMP ACK
	 $RETIF				;Return failing status
	TXNN	S,S%ACP			;Access complete
	JRST	DCNT20			;No..process next file
	$RETT				;ALL DONE!
SUBTTL	DCNSND	Active task to send files

;DCNSND	Holds these truths to be self evident:

;   1)	The default mode for reading files is /IMAGE if no switches
;	are specified.

;   2)	The local file will be read using the mode specified by the
;	local file switches.

;   3)	If the user specified any remote file switches the file will
;	be created using specified mode.

;   4)	If no remote switches are specified the remote file will be
;	created using the mode of the input file.  If the remote FAL
;	cannot create files in that mode the following occurs:

;	a)  If the local input mode is /ASCII a second try will be made
;	to create the file as if the user had specified /ASCII/VARIABLE
;	on the remote file specification.


DCNSND:	$SAVE	<P1>			;Preserve an AC
	$CALL	SETINP			;Setup for local file input
	 $RETIF				;[147]
	MOVEI	S1,.DMNAM		;Signify name message type
	$CALL	DCNRTN			;Give expanded name to caller
	SKIPN	.DFLFA(AP)		;Local file mode specified?
	 JRST	[SETZM SRCMOD		;No..clear requested mode
		 MOVE T1,REMOST		;Talking to TOPS20?
		 CAIN T1,.OSTP20	;[103]
		 JRST	.+1		;Yes..use default mode
		 LOAD T2,.FBBYV+LOCFDB,FB%BSZ	;[103]No..get file bytesize
		 MOVEI S1,.MD1		;Assume image mode
		 CAIE T1,.OSTP10	;[103]TOPS10?
		 CAIE T2,^D36		;[103]Unless bytesize is 7 or 36
		 CAIN T2,^D7		;[103]
		 MOVEI S1,.MD8		;Use ascii mode
		 MOVEM S1,SRCMOD
		 JRST	.+1]		;Continue
	$CALL	SETMOD			;Setup proper data mode
	 JUMPF	[$FATAL	(Can't establish requested input mode)]
	STORE	S2,ATTBSZ		;Save bytesize for attributes
	MOVX	S1,AT$BSZ		;Set bitsize menu bit
	IORM	S1,ATTMNU
	$CALL	OPNFIL			;Open in requested mode
	 JUMPT	DCNSN1			;[131]Branch if OPENF succeeded
	CAIE	S2,OPNX31		;[131]Off-line file?
	 $RETIF				;[147]
	$RETT				;[131]Off-line, go on to next
DCNSN1:	MOVE	S1,SRCMOD		;[131]Get our source mode
	HRLI	P1,(POINT 4)		;Create default mode pointer
	HRRI	P1,MODTB2(S1)		; per source mode
	SKIPN	S1,DSTMOD		;Have a destination mode?
	ILDB	S1,P1			;No..get default
DCNS10:	SKIPN	S1			;[125]DO WE HAVE A DEST MODE?
	$CALL	PICMOD			;[125]NO, GO PICK ONE
	MOVE	S2,.DFRFA(AP)		;Get remote attributes
	TXNN	S2,DF%MRS		;MRS specified?
	IORX	S2,<FLD(^D512,DF%MRS)>	;No..use nice default
	$CALL	SETATT			;Yes..setup attributes
	MOVE	S1,REMOST		;[153]GET SYSTEM TYPE
	CAIE	S1,.OSRST		;[153]IS IT RSTS?
	JRST	DCNS11			;[153]NO
	MOVX	S1,FB$SUP		;[153]SUPERCEED EXISTING FILE
	IORM	S1,ATTFOP		;[153]
	MOVX	S1,AT$FOP		;[153]MENU BIT FOR FOP FIELD
	IORM	S1,ATTMNU		;[153]SET IT
DCNS11:	MOVE	S1,OURDSP		;Send out all supported attribs
	TXZ	S1,DI$NAM		;Except name attributes
	$CALL	SNDDSP			;Send file attributes
	MOVX	S2,FB$PUT		;Setup ACCESS (Create)
	MOVEM	S2,ACCFAC
	MOVX	S1,DI$ATT+DI$NAM	;Request Attributes and name
	MOVEM	S1,ACCDSP
	SETOM	CRCFLG			;Request CRC validation
	$CALL	SNDACC			;Send off the Access message
	$STATE	.LLACC			;Accept Ack for Access
	$CALL	DCNMSG			;Get servers response
	JUMPT	DCNS20			;Onward if we received ack

;Here to see if we can try a second default for remote file attributes

	MOVE	T1,S1			;Get the error code
	TXZ	T1,ER%FLD		;Clear field type
	CAXE	T1,FLD(ER$USP,ER%MAC)+FLD(.DMATT,ER%TYP)
	$RETF				;No..return the DAP status
	SKIPE	.DFRFA(AP)		;Remote switches specified?
	 $FATAL	(Remote system does not support requested mode)
	ILDB	S1,P1			;Get the next default
	JUMPN	S1,DCNS10		;Yes..try it out
	 $FATAL	(Remote system does not support default mode)

DCNS20:	MOVX	S1,POLINI		;[133]
	MOVEM	S1,FILCRC		;[133]INITIALIZE CRC
	$CALL	SNDCTC			;START UP A DATA STREAM
	$STATE	.LLCTL			;Get Ack for Contol
	$CALL	DCNMSG			;GET THE ACK
	 $RETIF				;Get failing status
	$CALL	SNDCTS			;Send ctl msg to start Xmission
	$STATE	.LLDAT+S%PUT		;We're doing a PUT
	$CALL	DCNMSG			;Send the data
	 $RETIF				;Get failing status
	$STATE	.LLACP			;Access complete state
	$CALL	DCNMSG			;Get the Accomp (Resp)
	 $RETIF				;Get failing status
	SETZ	S1,			;[137]DON'T DELETE
	$CALL	CLSFIL			;CLOSE OUT LOCAL FILE
	 $RETIF				;[147]
	$RETT				;ALL DONE!
SUBTTL	DCNDEL  ACTIVE TASK TO DELETE A FILE
SUBTTL	DCNEXE	ACTIVE TASK TO EXECUTE A FILE

DCNEXE:	MOVE	S1,OURCAP		;Get capabilities
	TXNN	S1,SY$EXE		;Support submit?
	 $FATAL	(Remote system does not support file submission)
DCNDEL:	MOVX	S1,DI$NAM		;Display file name
	MOVEM	S1,ACCDSP
	$CALL	SNDACC			;SEND ACCESS MESSAGE FOR DELETE
DCND70:	MOVX	S1,POLINI		;[133]
	MOVEM	S1,FILCRC		;[133]INITIALIZE CRC
	$STATE	.LLACC			;Get Name from Access or Accomp
	$CALL	DCNMSG			;GET THE SERVERS ACCOMP
	 $RETIF				;Get failing status
	 JUMPF	.RETF
	TXNN	S,S%ACP			;Access complete?
	JRST	DCND70			;No..back for next file
	$RETT				;ALL DONE!
SUBTTL	DCNDIR	Active Task routine to process Directory request

DCNDIR:	MOVE	S1,OURCAP		;Get mutual capabilities
	TXNN	S1,SY$DIR		;Support directory?
	JRST	DCNPR1			;No..try anyhow!
	MOVE	S1,OURDSP		;Get mutually supported display
	TXZ	S1,DI$NAM		;Get all except name
	MOVEM	S1,ACCDSP		;Display all
	$CALL	SNDACC			;Send ACCESS (DIRECTORY)
DCNDI1:	MOVX	S1,POLINI		;[133]RESET...
	MOVEM	S1,FILCRC		;[133]...THE CRC
	$STATE	.LLACC			;Get response from Access
	SETZM	ATTMNU			;Clear attributes menu
	SETZM	DTIMNU			;Clear date/time menu
	SETZM	PROMNU			;Clear protection menu
	$CALL	DCNMSG			;Process the server's responses
	 JUMPT	DCNDI2			;[132]Got valid message
	TXNN	S,S%LERR		;[132]STATUS MESS RECEIVED?
	$RET				;[132]NO
	MOVE	S1,STSCOD		;[132]Get status
	MOVE	S2,STSSTV		;[132]
	CAXN	S1,FLD(ER$FIL,ER%MAC)+FLD(ER$FLK,ER%MIC) ;[132]FILE LOCKED?
	JRST	DCNDI0			;[132]YES, CONTINUE
	CAXN	S1,FLD(ER$FIL,ER%MAC)+FLD(ER$PRV,ER%MIC) ;[132]PRIV VIOLATION?
	JRST	DCNDI0			;[132]YES, CONTINUE
	CAXN	S1,FLD(ER$FIL,ER%MAC)+FLD(ER$ACC,ER%MIC) ;[132]CAN'T ACCESS?
	JRST	DCNDI0			;[132]YES, CONTINUE
	CAXN	S1,FLD(ER$FIL,ER%MAC)+FLD(ER$ATR,ER%MIC) ;[132]ATT READ ERROR?
	JRST	DCNDI0			;[132]YES, CONTINUE
	$RET				;[132]DON'T CONTINUE
DCNDI0:	HRROI	T1,STSTXT		;[132]Storage for error status
	$CALL	TYPSTS			;[132]Store error text
	$TEXT	(,^T/NAMFNM/   Remote status - ^T/STSTXT/) ;[132]
	$CALL	SNDCON			;[132]Yes, send CONTROL(skip)
	JRST	DCNDI1			;[132]Continue

DCNDI2:	TXNN	S,S%ACP			;[132]Access complete?
	JRST	DCNDI1			;No..back for next file
	$RETT


DCNPRN:	MOVE	S1,OURCAP		;Get mutual capabilities
	TXNN	S1,SY$SPL		;Support spooling?
	 $FATAL	(Remote system does not support spooling option)
	MOVX	S1,FB$SPL		;Yes..save for Access complete
	MOVEM	S1,ACPFOP

DCNPR1:	MOVEI	S1,ATTMSD		;Point to attributes message
	$CALL	CLRMSG			;Clear it
	MOVX	S2,FB$SPL		;[146]FOP BIT FOR PRINTING
	MOVEM	S2,ATTFOP		;[146]SAVE IN ATTRIBUTES MESSAGE
	MOVX	S2,AT$FOP		;[146]FOP MENU BIT
	MOVEM	S2,ATTMNU		;[146]SET IN ATTRIBUTES MENU
	$CALL	QUEMSG			;Send it off
	 $RETIF
	MOVX	S1,AF$OPN		;Open the file
	MOVEM	S1,ACCFNC
	MOVX	S1,FB$GET		;SET UP FAC FIELD
	MOVEM	S1,ACCFAC		;TO ALLOW SHARED READING
	MOVE	S1,OURDSP		;Request all attributes
	MOVEM	S1,ACCDSP
	$CALL	SNDACC			;Send out file Access message
DCNPR2:	MOVX	S1,POLINI		;[133]RESET...
	MOVEM	S1,FILCRC		;[133]...THE CRC
	$STATE	.LLACC			;Wait for file attributes
	$CALL	DCNMSG			;Get Servers response
	 $RETIF				;Return failing status
	$STATE	.LLACP			;Wait for Accomp (Resp)
	$CALL	DCNMSG			;GET THE ACCOMP ACK
	 $RETIF				;Return failing status
	TXNN	S,S%ACP			;Access complete?
	JRST	DCNPR2			;No..back for next file
	$RETT
SUBTTL	DCN	Unimplimented functions

DCNREN:	$FATAL	(Function not implimented)
DCNSUB:	$FATAL	(Function not implimented)
SUBTTL	VALCFG	Validate contents of a CONFIG message

VALCFG:	MOVX	S1,DPMXM		;Get my maximum message size
;[161]	MOVE	S2,REMOST		;[106]
;[161]	CAIN	S2,.OSVAX		;[106]A VAX?
;[161]	MOVEI	S1,DPMXMV		;[106]YES
	SKIPE	CFGSIZ			;Use it if Config size is zero
	CAMGE	S1,CFGSIZ		;Is config size smallest?
	MOVEM	S1,CFGSIZ		;No..use my maximum size
	MOVE	S1,CFGSIZ		;Compute maximim record size
	MOVEM	S1,OURSIZ		;Save as maximum buffer size
	SUBI	S1,DPMXH-2		; as buffer size minus maximum
	MOVEM	S1,OURMRS		; header size
	SKIPN	S1,CFGOST		;OSTYPE valid?
	$MIERR	.DMCFG,21		;No..illegal field value
	SKIPE REMOST			;[106]If remote type not specified..
	CAMN S1,REMOST			;[106]..or specified correctly
	SKIPA				;[106]Don't complain
	$WARN (Remote OS type different from that specified with SET DEFAULT)
					;[106]
	MOVEM	S1,REMOST		;Save remote OSTYPE
	SKIPN	CFGFST			;Filesys field valid?
	$MIERR	.DMCFG,22		;No..illegal field value
	MOVE	S1,CFGVER		;Get Major DAP version
	DPB	S1,[POINT 8,T1,7]	;Assemble version info
	MOVE	S1,CFGECO		;Get minor DAP version
	DPB	S1,[POINT 8,T1,15]
	MOVE	S1,CFGUSR		;Get DAP user version
	DPB	S1,[POINT 8,T1,23]
	MOVE	S1,CFGSFT		;Get DAP software version
	DPB	S1,[POINT 8,T1,31]
	MOVE	S1,CFGUSS		;Get user software version
	DPB	S1,[POINT 4,T1,35]
	CAXLE	T1,DAPVER		;Use lowest version
	MOVX	T1,DAPVER
	MOVEM	T1,OURVER
	DMOVE	S1,CFGCAP		;Get system capabilities
	AND	S1,[CAP1]		;Get logical AND of capabilities
	AND	S2,[CAP2]		; ...
	DMOVEM	S1,OURCAP		;Save as our mutual capabilities
	MOVX	T2,DI$ATT		;Get attributes display bit
	TXNE	S1,SY$PRO		;Support protection attributes?
	TXO	T2,DI$PRO		;Yes..Dont request it's display
	TXNE	S1,SY$DTI		;Support date/time attributes?
	TXO	T2,DI$DTI		;Yes..Dont request it' display
	TXNE	S2,SY$NAM		;Support name message?
	TXO	T2,DI$NAM		;Yes..Dont request it's display
	MOVEM	T2,OURDSP		;Save mutual display bits
	$RETT
SUBTTL	VALATT	Validate contents of an ATTRIBUTES message

VALATT:	MOVE	S1,ATTDAT		;Get DATATYPE field
	LOAD	S2,.DFFLG(AP),DF%ACC	;[135]GET FUNCTION
	CAIN	S2,AF$DIR		;[135]DIRECTORY?
	JRST	NODATC			;[135]YES, DON'T CHECK DAT
	TXNN	S1,DT$ASC!DT$IMA	;Ascii or image?
	$MIERR	.DMATT,21		;No..illegal field
NODATC:	TXNE	S1,DT$EBC!DT$CMP	;[135]Ebcdic or compressed?
	$MUERR	.DMATT,21		;Yes..unsupported attributes
	MOVEI	S1,.FBLEN		;Get the size of our FDB
	MOVEI	S2,ATTFDB		;Point to it
	$CALL	.ZCHNK			;Clear it
	MOVE	S1,ATTBSZ		;Save byte size from attributes
	CAILE	S1,^D36			;Too large?
	$MIERR	.DMATT,36		;Yes..return unsupported
	STORE	S1,.FBBYV+ATTFDB,FB%BSZ
	MOVE	T1,ATTMNU		;Get attributes menu
	TXNN	T1,AT$ALQ		;ALQ field present?
	JRST	VALAT1			;No..skip it
	MOVE	S1,ATTALQ		;Number of blocks allocated
	IDIVI	S1,4			; divided by 4
	SKIPE	S2			; rounded up
	ADDI	S1,1			; equals number of pages
	STORE	S1,.FBBYV+ATTFDB,FB%PGC
	SKIPN	S1,ATTBLS		;Block size given?
	MOVEI	S1,^D512		;No..assume 512
	IMUL	S1,ATTALQ		;BLS * ALQ
	STORE	S1,.FBSIZ+ATTFDB	;Is approximate file byte count
VALAT1:	TXC	T1,AT$EBK+AT$BLS+AT$FFB	;Can we compute file byte count?
	TXCE	T1,AT$EBK+AT$BLS+AT$FFB
	JRST	VALAT3			;No..skip it
	MOVE	S1,ATTEBK		;Yes..end of file block
	SUBI	S1,1			; Converted to LBN
	IMUL	S1,ATTBLS		; times bytes per block
	ADD	S1,ATTFFB		; plus first free byte
	STORE	S1,.FBSIZ+ATTFDB	; equals file byte count
VALAT3:	MOVE	S1,ATTFOP		;Save attributes options
	MOVEM	S1,FILFOP
	$STATE	.LLATT			;Move to attributes state
	$RETT
SUBTTL	VALDTI	Validate the contents of DATE/TIME attributes extention

VALDTI:	SKIPN	T1,DTIMNU		;Anything specified?
	$RETT				;No..just return
	MOVE	S1,DTICDT		;Get creation date/time
	TXNE	T1,DA$CDT		;Was it given?
	MOVEM	S1,.FBCRV+ATTFDB	;Yes..store it
	MOVE	S1,DTIRDT		;Get last update date/time
	TXNE	T1,DA$RDT		;Was it specified?
	MOVEM	S1,.FBWRT+ATTFDB	;Yes..store it
	$RETT
SUBTTL	VALPRO	Validate the contents of protection attributes message

VALPRO:	SKIPN	T1,PROMNU		;Get protection menu
	$RETT				;Return if menu is null
					;[116]deleted 3 lines here
	SKIPE	S1,PROSLF		;Get owners protection
	STORE	S1,.FBPRT+ATTFDB,FP%SLF
	SKIPE	S1,PROGRP		;Get group protection
	STORE	S1,.FBPRT+ATTFDB,FP%GRP
	SKIPE	S1,PROWLD		;Get wild protection
	STORE	S1,.FBPRT+ATTFDB,FP%WLD
	$RETT
SUBTTL	VALNAM	Validate the contents of a NAME message

;Returns TRUE	S1/ Flag from name message
;		S2/ Pointer to string

VALNAM:	SKIPN	S1,NAMTYP		;Get the name menu flags
	$MIERR	.DMNAM,20		;Invalid menu
	TXNE	S1,NA$DFS!NA$RFS	;Do we support it?
	$MUERR	.DMNAM,20		;No..unsupported
	TXNE	S1,NA$FSP		;File spec?
	HRROI	S2,NAMFSP		;Yes..point to it
	TXNE	S1,NA$VOL		;Volume (or device)
	HRROI	S2,NAMVOL		;Yes..point to it
	TXNE	S1,NA$DIR		;Directory?
	HRROI	S2,NAMDIR		;Yes..point to it
	TXNE	S1,NA$FNM		;File name?
	HRROI	S2,NAMFNM		;Yes..point to it
	$RETT


SUBTTL	VALCRC	Routine to validate the CRC

VALCRC:	SKIPL	ACPCRC			;Was CRC specified?
	SKIPT	CRCFLG			;Checking CRC?
	 $RETT				;No..always return true
	MOVE	S1,FILCRC		;Get computed CRC
	CAME	S1,ACPCRC		;Had better match
	$MCERR	(ER$CRC)		; else bad CRC
	$RETT
SUBTTL	SNDCFG	Send CONFIG message

SNDCFG:	MOVEI	S1,DPMXM		;Store maximum buffer size
;[161]	MOVE	S2,REMOST		;[106]GET REMOTE SYSTEM TYPE
;[161]	CAIN	S2,.OSVAX		;[106]IS IT VMS?
;[161]	MOVEI	S1,DPMXMV		;[106]YES, USER THE VMS MAX MESS SIZE
	MOVEM	S1,CFGSIZ
	MOVEI	S1,.OSTP20		;Store operating system type
	MOVEM	S1,CFGOST
	MOVEI	S1,.FST20		;Store file system type
	MOVEM	S1,CFGFST
	MOVEI	S1,.DVMAJ		;Store DAP major version
	MOVEM	S1,CFGVER
	MOVEI	S1,.DVMIN		;Store DAP minor version
	MOVEM	S1,CFGECO
	MOVEI	S1,.DVUSR		;Store DAP user version
	MOVEM	S1,CFGUSR
	MOVEI	S1,.DVSFT		;Store DECnet version
	MOVEM	S1,CFGSFT
	MOVEI	S1,.DVUSF		;Store User DECnet version
	MOVEM	S1,CFGUSS
	DMOVE	S1,[EXP CAP1,CAP2]	;Store our capabilities
	DMOVEM	S1,CFGCAP
	MOVEI	S1,CFGMSD		;Build configuration message
	$CALL	PUTMSG			;Force it out
	$RETT
SUBTTL	SNDACC	Send an ACCESS message

;Accepts	ACCxxx setup by caller and DAPDCN

SNDACC:	MOVE	S1,OURVER		;Get version level check
					;[133]delete 2 lines here
	MOVX	S1,AF$DIR		;Is this directory request?
	CAME	S1,ACCFNC
	$CALL	CHKWLD			;No..Check for unsupported wild cards
	MOVE	S1,OURCAP		;Get mutual capabilities
	TXNN	S1,SY$CRC		;Do we both support CRC?
	SETZM	CRCFLG			;No..don't ask for it
	MOVX	S1,AO$CRC		;Get bit to request CRC
	SKIPE	CRCFLG			;Want to do it?
	IORM	S1,ACCOPT		;Yes..then request it
	MOVE	S1,[POINT 7,ACCFIL]	;[136]
	$CALL	CONREM			;[136]MAKE SYNTAX CORRECT FOR REMOTE
	MOVEI	S1,ACCMSD		;Point to message descriptor
	$CALL	PUTMSG			;Force it out
	$CALL	RESREM			;[136]RESTORE THE FILE NAME
	$RETT


CHKWLD:	DMOVE	S1,OURCAP		;Get mutual capabilities
	TXNE	S2,SY$WLD		;Support wild cards?
	 $RETT				;Yes..all is well
	MOVE	S1,[POINT 7,ACCFIL]	;Point to filespec
CHKWL1:	ILDB	S2,S1			;Get a byte
	JUMPE	S2,.RETT		;Return on end of string
	CAIE	S2,"*"			;Wild card?
	CAIN	S2,"%"
	 JRST	CHKWL2			;Yes..we don't support it
	CAIE	S2,"?"
	JRST	CHKWL1			;Back to check all characters
CHKWL2:	$FATAL	(Remote system does not support wild card operations)


SUBTTL	SNDCTC	Send a CONTROL (CONNECT) message

SNDCTC:	MOVEI	S1,CTLMSD		;Point to control message
	$CALL	CLRMSG			;Clear all fields
	MOVX	S2,CF$CON		;Function is start a data stream
	MOVEM	S2,CTLFNC
	MOVX	S2,CT$RAC		;Get Menu bits
	MOVEM	S2,CTLMNU
	MOVX	S2,RB$SQF		;Sequential file transfer
	MOVEM	S2,CTLRAC
	$CALL	PUTMSG			;Force it out
	$RETT
SUBTTL	SNDCTR	Send a CONTROL (GET) message

SNDCTR:	MOVEI	S1,CTLMSD		;Point to control message
	$CALL	CLRMSG			;Clear it out
	MOVX	S2,CF$GET		;Get GET function
	MOVEM	S2,CTLFNC
	MOVX	S2,CT$RAC		;Get menu bits
	MOVEM	S2,CTLMNU
	MOVX	S2,RB$SQF		;Sequential transfer
	MOVEM	S2,CTLRAC		; for Record Access
	PJRST	SNDCTL			;Check to see if block mode ok.
	$RETT


SUBTTL	SNDCTS	Send a CONTROL (PUT) message

SNDCTS:	MOVEI	S1,CTLMSD		;Point to control message
	$CALL	CLRMSG			;Clear it out
	MOVX	S2,CF$PUT		;PUT PUT function
	MOVEM	S2,CTLFNC
	MOVX	S2,CT$RAC		;Get menu bits
	MOVEM	S2,CTLMNU
	MOVX	S2,RB$SQF		;Sequential transfer
	MOVEM	S2,CTLRAC		; for Record Access
	PJRST	SNDCTL			;Check to if block mode ok.

SNDCTL:	SKIPN	.DFLFA(AP)		;User specified mode?
	SKIPE	.DFRFA(AP)
	 PJRST	SNDCT1			;Yes..don't do page mode
	MOVE	S1,REMOST
	CAIE	S1,.OSTP20		;Talking to TOPS20?
	 JRST	SNDCT1			;No..don't do page mode
	MOVE	S1,OURCAP
	TXNN	S1,SY$VBN		;Remote FAL support block mode?
	 JRST	SNDCT1
	MOVE	S1,ATTDEV
	TXNN	S1,FB$MDI		;Remote device DSK?
	 JRST	SNDCT1
	LOAD	S1,LOCDEV,DV%TYP
	CAIE	S1,.DVDSK		;Local device DSK?
	 JRST	SNDCT1
	SETOM	PAGFLG			;Great..use page mode
	SETZM	CTLKEY			;Start with VBN 0 (FDB)
	MOVX	S1,CT$KEY		;Set the menu bit
	IORM	S1,CTLMNU
	MOVX	S1,RB$BKF		;Request block mode
	MOVEM	S1,CTLRAC
	MOVE	S1,[GETPAG,,PUTPAG]	;Setup proper processor
	MOVEM	S1,DATDAT
SNDCT1:	MOVEI	S1,CTLMSD		;Point to the message
	$CALL	PUTMSG			;Send it off
	$RETT
SUBTTL	SNDCON	Send a CONTROL TRANSFER (Skip) message	;[132]

SNDCON:	MOVEI	S1,CONMSD		;[132]Point to CONTRAN message
	$CALL	CLRMSG			;[132]Clear it
	MOVX	S2,CO$SKP		;[132]CONTROL(Skip)
	MOVEM	S2,CONFNC		;[132]
	$CALL	PUTMSG			;[132]Force it out
	$RETT				;[132]
SUBTTL	SNDACK	Send an ACKNOWLEDGE message

SNDACK:	MOVEI	S1,ACKMSD		;Point to ACK message
	$CALL	PUTMSG			;Force it out
	$RETT


SUBTTL	SNDEOF	Send an EOF status message

SNDEOF:	$STATUS	ER$TRN,ER$EOF		;EOF status
	$CALL	SNDSTS			;Send a status message
	$STATE	.LLACP			;Move to access complete state
	$RETT


SUBTTL	SNDSTS	Routine to send a status message

;Accepts	S1/ STATUS CODE
;		S2/ SECONDARY STATUS

SNDSTS:	DMOVE	T1,S1			;Save Calling args
	MOVEI	S1,STSMSD		;Point to status message
	$CALL	CLRMSG			;Clear it out
	MOVEM	T1,STSCOD		;Save status code
	MOVEM	T2,STSSTV		;Save extended status
	$CALL	PUTMSG			;Force it out
	$RET


SUBTTL	SNDACP	Send an ACCOMP (CLOSE) message


SNDACP:	MOVX	S2,AC$TRM		;Get CLOSE function
	MOVEM	S2,ACPFNC
	$CALL	SNDCRC			;Put CRC into ACP message
	MOVEI	S1,ACPMSD		;Point to message descriptor
	$CALL	PUTMSG			;Force it out
	$RET				;Return

SNDCRC:	SKIPT	CRCFLG			;Want to send CRC?
	 $RETT				;No..just ruturn
	MOVE	S1,FILCRC		;Yes..get what we computed
	MOVEM	S1,ACPCRC		;Store in the message
	$RETT

SUBTTL	SNDACA	Send an Accomp (Resp) message

SNDACA:	MOVEI	S1,ACPMSD		;Ppoint to message descriptor
	MOVX	S2,AC$ACK		;Get ACK function
	MOVEM	S2,ACPFNC
	$CALL	PUTMSG			;Force it out
	$RETT
SUBTTL	SNDWLD	Routine to send required name messages per WLDJFN

;Accepts	WLDJFN and LOCJFN setup via SETINP

SNDWLD:	$SAVE	<P1>
	MOVE	P1,WLDJFN		;Get change flags
	TXNN	P1,GN%STR		;Structure change?
	 JRST	SNDWL1			;No..check directory
	HRROI	S1,NAMVOL
	HRRZ	S2,LOCJFN
	MOVX	T1,FLD(1,JS%DEV)+JS%PAF	;Send "DEV:"
	JFNS
	 ERJMP	TERCVT			;Return false if error
	MOVX	S1,NA$VOL		;Say it's a volume (structure)
	MOVEM	S1,NAMTYP		;Store Name type
	$CALL	SNDNAM			;Send it off
SNDWL1:	TXNN	P1,GN%DIR		;Directory change?
	JRST	SNDWL2			;No..just send filename
	HRROI	S1,NAMDIR
	HRRZ	S2,LOCJFN
	MOVX	T1,FLD(1,JS%DIR)+JS%PAF	;Send "<Directory>"
	JFNS
	 ERJMP	TERCVT			;Return error if this fails
	MOVX	S1,NA$DIR		;Say its a directory
	MOVEM	S1,NAMTYP
	$CALL	SNDNAM			;Send of the directory
SNDWL2:	HRROI	S1,NAMFNM		;Point to name storage
	HRRZ	S2,LOCJFN
	MOVX	T1,FLD(1,JS%NAM)+FLD(1,JS%TYP)+FLD(1,JS%GEN)+JS%PAF
	JFNS
	 ERJMP	TERCVT
	MOVX	S2,NA$FNM		;Say its a filename
	MOVEM	S2,NAMTYP		;Store the name type
	MOVE	S1,[POINT 7,NAMFNM]	;[136]POINTER TO FILESPEC
	$CALL	CONREM			;[136]CONVERT NAME FOR REMOTE
	$CALL	SNDNAM			;Send it off
	$CALL	RESREM			;[136]RESTORE FILE NAME STRING
	$RETT
SUBTTL	SNDDSP	Send requested ATTRIBUTES messages

;Accepts	S1/ Display field from Access message

SNDDSP:	MOVE	S2,CFGVER		;Check for old FAL
	CAIGE	S2,^D5			;Dap 5.1 or later?
	JRST	SNDATT			;No..just send attrubutes
	$SAVE	<P1>			;Preserve P1 for "menu"
	SKIPN	P1,S1			;Put requested fields in P1
	MOVX	P1,DI$ATT		;Default is attributes
	AND	P1,OURDSP		;Clear impossible requests
	TXNE	P1,DI$ATT		;Return Main Attributes message?
	$CALL	SNDATT			;Yes - Send off main attributes
	TXNE	P1,DI$DTI		;Want DATE and Time message?
	$CALL	SNDDTI			;Yes - do it
	TXNE	P1,DI$PRO		;Send Protection message?
	$CALL	SNDPRO			;Yes - do it
	TXNN	P1,DI$NAM		;Want Name stuff?
	$RETT				;No - then just return ok
	MOVX	S1,NA$FSP		;Will send whole filespec
	MOVEM	S1,NAMTYP		;Store argument type
	MOVE	S1,[POINT 7,NAMFSP]	;[136]
	$CALL	CONREM			;[136]CONVERT NAME FOR REMOTE SYS
	$CALL	SNDNAM
	$CALL	RESREM			;[136]RESTORE THE NAME
	$RETT
SUBTTL	CONREM/RESREM Send file names in correct format

;CONREM is called to edit a filspec to coorespond to the
;	format required by the remote node. This is all
;	EDIT [136].

;CONREM	S1/	byte pointer to filespec

;RESREM		no arguments

CONREM:	SETZM	SAVPNT			;ZERO THE OLD POINTER
	MOVE	S2,REMOST		;REMOTE SYSTEM TYPE
	CAIE	S2,.OSTP20		;TOPS-20?
	CAIN	S2,.OSTP10		;OR TOPS-10?
	$RETT				;YES, DO NO CONVERSION
CONR1:	ILDB	S2,S1			;GET A BYTE
	SKIPN	S2			;END OF STRING?
	$RETT				;YES
	CAIE	S2,"["			;DIRECTORY?
	CAIN	S2,"<"			;
	JRST	CONR4			;YES, EAT IT UP
	CAIE	S2,"."			;FOUND END OF FILE NAME?
	JRST	CONR1			;NO, KEEP LOOKING
CONR2:	ILDB	S2,S1			;LOOK FOR END OF FILE TYPE
	SKIPN	S2			;END OF STRING?
	$RETT				;YES
	CAIE	S2,"."			;FOUND END OF FILE TYPE?
	JRST	CONR2			;NO, KEEP LOOKING
	MOVEM	S1,SAVPNT		;YES, SAVE POINTER TO "."
	ILDB	S2,S1			;FIRST CHAR OF VERSION
	CAIE	S2,"-"			;NEGATIVE?
	CAIN	S2,"0"			;OR ZERO?
	JRST	CONR3			;YES, BAD VERSION FOR REMOTE
	MOVE	S1,SAVPNT		;POINT TO THE PERIOD
	MOVEI	S2,";"			;REPLACE WITH A SEMICOLON
	DPB	S2,S1			;DO IT
	$RETT				;RETURN
CONR3:	MOVE	S1,SAVPNT		;POINT TO THE PERIOD
	SETZ	S2,			;ZERO
	DPB	S2,S1			;END THE NAME AFTER FILE TYPE
	$RETT
CONR4:	ILDB	S2,S1			;GET A BYTE
	SKIPN	S2			;END OF STRING?
	$RETT				;YES
	CAIE	S2,"]"			;END OF DIR?
	CAIN	S2,">"			;?
	JRST	CONR1			;YES
	JRST	CONR4			;NO, KEEP EATING THE DIRECTORY

RESREM:	SKIPN	SAVPNT			;WAS ANYTHING CHANGED?
	$RETT				;NO
	MOVE	S1,SAVPNT		;POINT TO CHANGED BYTE
	MOVEI	S2,"."			;CHANGE BACK TO A "."
	DPB	S2,S1			;CHANGE IT
	SETZM	SAVPNT			;
	$RETT
SUBTTL	SNDATT	Send an attributes message

;SNDATT	is called to send file attributes per this openning of file.
;	Datatype and record formats must be setup by SETBSZ.

;Accepts	ATTxxx setup via GETFDB, SETBSZ and SETATT

SNDATT:	MOVX	S1,AT$BSZ		;Get menu bytesize bit
	TDNN	S1,ATTMNU		;Is it present?
	JRST	SNDAT2			;No..assume we are all set
	MOVE	S2,ATTBSZ		;Get the bytesize
	CAIN	S2,^D8			;Is it 8?
	ANDCAM	S1,ATTMNU		;Yes..no need to send it
	LOAD	S2,ACCFNC		;Get requested function
	CAXE	S2,AF$CRE		;Creating a file?
	JRST	SNDAT1			;No..send what we have
	MOVE	S2,REMOST		;Get remote system type
	CAXE	S2,.OSTP20		;To TOPS20?
	CAXN	S2,.OSTP10		;  or TOPS10?
	JRST	SNDAT1			;Yes..send everything
	MOVX	S1,AT$BLS+AT$ALQ+AT$EBK+AT$FFB
	ANDCAM	S1,ATTMNU		; else don't send these
	JRST	SNDAT2

SNDAT1:	LOAD	S2,.FBBYV+LOCFDB,FB%PGC	;Get page count
	IMULI	S2,^D4			;Compute block allocated
	MOVEM	S2,ATTALQ		;ATTALQ=Page_count/4
	LOAD	T2,.FBSIZ+LOCFDB	;Get actual file bytecnt
	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ	;Get actual file bytesiz
	MOVEI	S2,^D36			;
	IDIV	S2,S1			;Compute bytes per word
	IMULI	S2,^D128		;Compute bytes per block
	MOVEM	S2,ATTBLS		;ATTBLS=Bytes_per_word*128
	IDIV	T2,S2			;Compute end block
	ADDI	T2,1			;EBK begins at 1
	MOVEM	T2,ATTEBK		;ATTEBK=File_byte_count/ATTBLS+1
	MOVEM	T3,ATTFFB		;ATTFFB=REM(File_byte_count/ATTBLS)
	MOVX	S1,AT$BLS+AT$ALQ+AT$EBK+AT$FFB
	IORM	S1,ATTMNU		;Set proper menu bits
SNDAT2:	MOVEI	S1,ATTMSD		;Point to message
	$CALL	QUEMSG			;Send it out
	$RET
SUBTTL	SNDPRO	Send File Protection Attributes

;Accepts	LOCFDB setup via GETFDB

SNDPRO:	SETZB	T1,PROMNU		;Clear our menu
					;[116]deleted 6 lines here
	SKIPN	S1,.FBPRT+LOCFDB	;Get file protection
	JRST	SNDPR1			;Send null protection field
	MOVEM	S1,PROWLD		;Save wild protection
	LSH	S1,-6
	MOVEM	S1,PROGRP		;Save group protection
	LSH	S1,-6
	MOVEM	S1,PROSLF		;Save owner protection
	TXO	T1,PR$SLF+PR$GRP+PR$WLD	;Set the menu bits
SNDPR1:	MOVEM	T1,PROMNU
	MOVEI	S1,PROMSD		;Point to message descriptor
	$CALL	QUEMSG			;Send it off
	$RET


SUBTTL	SNDDTI	Send Date/time attributes

;Accepts	LOCFDB Setup via GETFDB

SNDDTI:	MOVX	S2,DA$CDT+DA$RDT	;Get menu bits
	SKIPN	S1,.FBCRV+LOCFDB	;Get local creation date/time
	TXZ	S2,DA$CDT		;Clear the menu bit
	MOVEM	S1,DTICDT
	SKIPN	S1,.FBWRT+LOCFDB	;Get last update date/time
	TXZ	S2,DA$RDT		;Clear the menu bit
	MOVEM	S1,DTIRDT
	MOVEM	S2,DTIMNU		;Setup the menu
	MOVEI	S1,DTIMSD		;Point to message descriptor
	$CALL	QUEMSG			;Send it out
	$RET


SUBTTL	SNDNAM	Send a Name message

;Accepts	NAMxxx setup via GETFDB or SNDWLD

SNDNAM:	MOVEI	S1,NAMMSD		;Point to message descriptor
	$CALL	QUEMSG			;Send it off
	$RET
SUBTTL	MSGTBL	List of valid DAP messages

;Generate a message table for defined DAP message types
;GETMSG uses this list to accept or reject a specific DAP message type

;Each entry is of the form:

;	Message Type,,Message descriptor address

;Message types are defined in the DOMSG macro of DAPSYM


;Define a macro to build the message table entry
DEFINE	XX (MSG,VAL,NAME,FLAG) <
	.DM'MSG,,MSG'MSD>

;Define a macro to ignore the specific message argument types and version
DEFINE	VV (VER) <>
DEFINE	YY (FLD,TYP,SIZ,DEF) <>

;Expand the list of valid messages

MSGTBL:	DOMSG
	MSG$LN==.-MSGTBL
SUBTTL	GETMSG	Routine to get next DAP message from Link

;Accepts	S1/ Message list address

;Returns TRUE	Message fields stored in respective storage cells
;
;		S1/ Calling message list entry
;		S2/ Parsed message type


;Returns FALSE	S1/ Sync or Unsupported Error code
;		S2/ Parsed message type

GETMSG:	$SAVE	<P2,P1>			;Preserve some AC's
	MOVE	P1,S1			;Remember calling list address
	MOVSI	P2,-MSG$LN		;Get length of table
	$CALL	LLRECA			;[154]Get a message
	MOVE	DL,S1			;Put message address in DL
	$CALL	VALHDR			;Validate the header
	 JUMPF	[$SAVE <TF,S1,S2>	;[123]REMOVE BAD MESSAGE...
		MOVE S1,RCVLST		;[123]...
		$CALL L%DENT		;[123]...FROM RECEIVE QUEUE
		$RET]			;[123]
GETMS1:	HLRZ	S2,MSGTBL(P2)		;Get the message type
	CAMN	S1,S2			;Is it a match?
	JRST	GETMS2			;Yes..process it
	AOBJN	P2,GETMS1		;No..try the next
	$STATUS	ER$USP,0,ER$TYP		;Not found..unsupported message type
	MOVE	S2,.DPTYP(DL)		;Return the message type
	STORE	S2,S1,ER%TYP		;Save in Unsupported status
	MOVE	S1,RCVLST		;[123]REMOVE BAD MESS...
	$CALL	L%DENT			;[123]FROM RECEIVE QUEUE
	$RETF

GETMS2:	SKIPN	S2,0(P1)		;Find message in calling list
	 JRST	[$STATUS ER$SNC,0	;Return SYNC error
		 MOVE S2,.DPTYP(DL)	;Return message type
		 STORE S2,S1,ER%MIC	;Save in DAP status
		MOVE S1,RCVLST		;[123]REMOVE BAD MESS...
		$CALL L%DENT		;[123]...FROM RECEIVE QUEUE
		 $RETF]			;Return the failure
	HLRZ	S2,S2			;Get the list type
	CAME	S1,S2			;Is it a match?
	AOJA	P1,GETMS2		;No..try the next
	HRRZ	S1,MSGTBL(P2)		;Get message header address
	$CALL	VALMSG			;Validate the message
	 JUMPF	[$SAVE	<TF,S1,S2>	;Save status for return
		 MOVE	S1,RCVLST
		 $CALL	L%DENT		;Delete the bad message
		 $RET]
	HRRZ	S1,0(P1)		;Return calling list entry
	HLRZ	S2,0(P1)		;Return parsed message type
	$CALL	0(S1)			;Call the routine
	$SAVE	<TF,S1,S2>		;Save staus for return
	SKIPGE	.DPTYP(DL)		;Want to reparse it?
	JRST	GETMS4			;Yes..reset the pointers
	MOVE	S1,RCVLST		;Point to receive list
	$CALL	L%DENT			;Delete the entry
	MOVE	S1,RCVLST
	$CALL	L%FIRST
	SKIPT
	SETZM	MSGFLG
	$RETT

GETMS4:	MOVE	T1,.DPTYP(DL)		;Reset pointers if reparse wanted
	MOVMM	T1,.DPTYP(DL)
	MOVE	T1,.DPLEN(DL)
	EXCH	T1,.DPCNT(DL)
	SUB	T1,.DPLEN(DL)
	ADJBP	T1,.DPBPT(DL)
	MOVEM	T1,.DPBPT(DL)
	HRRZ	S1,0(P1)		;Return calling list entry
	HLRZ	S2,0(P1)		;Return parsed message type
	$RETT
SUBTTL	VALHDR	Routine to validate standard dap message header

;Accepts	DL/ Address of current message header

;Creates a new header for this message if more messages follow


;Returns TRUE	S1/ Type field of received message

;	 FALSE	S1/ Message format error status

VALHDR:	SKIPLE	S1,.DPTYP(DL)		;Reparse?
	$RETT				;Yes..just return
	$SAVE	<P1,P2>			;P1 HOLDS FLAGS
	SETZB	P1,P2			;P2 HOLDS LENGTH FIELD
	$CALL	GETBYT			;GET MESSAGE TYPE FIELD
	 JUMPF	[$MFERR 0,10]		;BAD
	MOVEM	S1,.DPTYP(DL)		;STORE MESSAGE TYPE
	MOVEI	S1,5			;Maximum flag size is 5
	MOVEI	S2,.DPFLG(DL)		;Store in DPFLG
	$CALL	GETEXF			;GET HEADER FLAGS
	 JUMPF	[$MFERR 0,10]		;NULL - FAILED
	MOVE	P1,.DPFLG(DL)		;Put the flags in P1
	TXNN	P1,HD$SID		;STREAMID FIELD IN MESSAGE?
	JRST	VALHD1			;NO
	$CALL	GETBYT			;YES..GET IT
	 JUMPF	[$MFERR 0,11]		;FAILED
	MOVEM	S1,.DPSID(DL)		;SAVE IT
VALHD1:	TXNN	P1,HD$LEN		;LENGTH FIELD PRESENT?
	JRST	VALHD2			;NO
	$CALL	GETBYT			;GET IT
	 JUMPF	[$MFERR 0,12]		;FAILED
	MOVE	P2,S1			;SAVE IN P2
	TXNN	P1,HD$LN2		;LENGTH 256 BIT PRESENT?
	JRST	VALHD2			;NO
	$CALL	GETBYT			;GET HIGH ORDER PART
	 JUMPF	[$MFERR 0,13]		;BAD FORMAT
	LSH	S1,10			;MAKE IT HIGH ORDER
	ADD	P2,S1			;ADD TO LOW ORDER PART
VALHD2:	TXNN	P1,HD$BCT		;IS BIT COUNT PRESENT?
	JRST	VALHD3			;NO
	$CALL	GETBYT			;YES..GET IT
	 JUMPF	[$MFERR 0,14]		;BAD FORMAT
	MOVEM	S1,.DPBCT(DL)		;SAVE IT
	CAILE	S1,7			;Within range?
	 $MIERR	(0,14)			;No..return invalid field
	MOVE	S1,.DPTYP(DL)		;Get message type
	CAIA	S1,.DMDAT		;Data message ;**Skip for Kludge
	 $MIERR	(0,14)			;No..return invalid field
VALHD3:	TXNE	P1,HD$SEG		;Segmented message?
	 $MUERR	(0,15)			;Yes..return unsupported
	TXNE	P1,HD$LEN!HD$LN2	;IS MESSAGE BLOCKED?
	CAMN	P2,.DPCNT(DL)		;YES..IS SIZE EXACT?
	JRST	VALHD5			;YES..JUST RETURN
	MOVE	S1,RCVLST		;Message is blocked.
	$CALL	NEWHDR			;Create a new header
	MOVEM	P2,.DPCNT(DL)		;Save actual count
	SUBM	P2,.DPCNT(S2)		;Adjust next message count
	MOVNS	T1,.DPCNT(S2)		;Get positive count
	MOVEM	T1,.DPLEN(S2)		;Save actual length
	ADJBP	P2,.DPBPT(S2)		;Adjust next message pointer
	MOVEM	P2,.DPBPT(S2)		;Save for next parse
	SETZM	.DPTYP(S2)		;Clear next message type
	SETZM	.DPFLG(S2)		;Clear next message flags
	SETZM	.DPBCT(S2)		;Clear next message bitcnt
VALHD5:	MOVE	S1,.DPCNT(DL)		;Set length and count the same
	MOVEM	S1,.DPLEN(DL)
	MOVE	S1,.DPTYP(DL)		;Return current message type
	$RETT

SUBTTL	NEWHDR	Routine to create a new header only

;Accepts	S1/ Send of recieve list address

;Returns TRUE	DL/ Address of new message header
;		S2/ Address of old message header
;		Old header copied to new header

NEWHDR:	MOVEI	S2,.DPSIZ		;Create header entry
	$CALL	L%CBFR			; Before current entry
	HRL	S1,DL			;Source is old header
	HRR	S1,S2			;Dest is new header
	BLT	S1,.DPSIZ-1(S2)		;Copy old header
	EXCH	DL,S2			;Make new header current
	$RETT
SUBTTL	VALMSG	Routine to parse current DAP message

;VALMSG	reads the message descriptor and parses each argument field
;	described in the message descriptor.  The message descriptor
;	is defined using the DOMSG and xxxMSG macros that live in
;	DAPSYM, thus to add another message or field to a message
;	it is only necessary to add the definition to DAPSYM.

;VALMSG	will ensure that the message information is parsed and stored
;	in the appropriate local storage.

;Accepts	S1/ Address of message descriptor

;Returns TRUE	    All message fields stored

;	 FALSE	S1/ Message format error code
;		S2/ Parsed message type

VALMSG:	$SAVE	<P1,P2,P3,P4>
	MOVE	P1,S1			;P1 points to message descriptor
	$DEBUG	(Parsing ,<^Q/0(P1),RHMASK/ message>)
	MOVE	T1,2(P1)		;Get message flags and fld count
	TXNN	T1,DA%NOZ		;Clear message before recieve?
	$CALL	CLRMSG			;Yes..zero message storage
	MOVX	P3,FLD(ER$FMT,ER%MAC)+FLD(20,ER%FLD) ;Init format error
	HLRZ	S1,0(P1)		;Get message type
	STORE	S1,P3,ER%TYP		;Save message type in error code
	HRLZ	T1,T1			;Get message field count
	JUMPE	T1,VALMS7		;Exit if no message fields
	MOVN	T1,T1			;Negate it to form AOBJN pointer
	HRRI	T1,3(P1)		;Point to first argument
	MOVE	P1,T1			;Put pointer in P1
	SETOM	P2			;Setup initial menu
VALMS1:	MOVE	T1,(P1)			;Get next field type
	TXNN	T1,DA%VER		;Want version check?
	JRST	VALMS2			;No..see if default is present
	ADDI	P1,1			;Yes..point past it
	AOJA	P1,VALMS1		;Get the next field descriptor
VALMS2:	LOAD	S1,T1,DA%SIZ		;Get max size of argument
	LOAD	S2,T1,DA%STG		;Get storage offset for argument
MULINK<	ADD	S2,CP>			;Get actual storage address
	LOAD	P4,T1,DA%TYP		;Get argument type
	TXNN	T1,DA%DEF		;Default present?
	JRST	VALMS3			;No..call the processor
	ADDI	P1,1			;Yes..point to it
	MOVE	T1,0(P1)		;Get the default
	MOVEM	T1,(S2)			;Store it

;VALMSG Continued on next page
;VALMSG Continued from previous page

VALMS3:	TXNN	P2,1			;Is field specified by menu?
	JRST	VALMS5			;No..skip it
	HLRZ	T1,ARGTBL(P4)		;Yes..get processor address
	CAIN	P4,.ARDAT		;Message data field?
	 JRST	VALMS4			;Yes..always call the processor
	SKIPG	.DPCNT(DL)		;No..is field present?
	 TDZA	S1,S1			;No..clear possible menu result
VALMS4:	$CALL	0(T1)			;Yes..call the processor
	 JUMPF	VALMS6			;Return format error if false
VALMS5:	LSH	P2,-1			;Shift menu one place
	CAIN	P4,.ARMNU		;Argument type a menu?
	AND	P2,S1			;Yes..Save selected menu bits
	ADDI	P3,1			;Bump format error to next field
	AOBJN	P1,VALMS1		;Do all fields
	MOVE	T1,.DPTYP(DL)		;Get message type
	CAIE	T1,.DMCFG		;Don't check length for config
	CAIN	T1,.DMDAT		; or data message
	 JRST	VALMS7			;Data will be processed later
	SKIPG	.DPCNT(DL)		;Finished..Everything parse?
	JRST	VALMS7			;Yes..return success
	MOVX	S1,ER$USP		;No..specify Unsupported field
	STORE	S1,P3,ER%MAC
VALMS6:	TXNE	S,S%JERR		;[127]WAS IT A JSYS ERROR?
	$RETF				;[127]YES RETURN IT
	MOVE	S1,P3			;Get current field format error
	LOAD	S2,S1,ER%TYP		;Extract message type
	$RETF				;Return the failure

VALMS7:	$RETT


SUBTTL	CLRMSG	Routine to clear DAP message storage

;Accepts	S1/ Message descriptor address

CLRMSG:	$SAVE	<S1,S2>			;Preserve scratch AC's
	HRRZ	S2,1(S1)		;Get starting offsett
	HLRZ	S1,1(S1)		;Get size of storage
MULINK<	ADD	S2,CP>			;Get storage address
	$CALL	.ZCHNK
	$RETT
SUBTTL	GETFIX	Routine to process DAP byte arguments

;GETFIX	Get 1 to 4 bytes from DAP message

;Accepts	S1/ number of bytes to retrieve
;		S2/ destination address

;Returns	S1/ result (bytes stored right to left)
;		S2/ destination address

GETFIX:	CAIL	S1,1			;Check range
	CAILE	S1,4
	 $RETF				;Return failure
	MOVE	T1,S1			;Save byte count
	$CALL	GETBYT			;Get byte from message
	 $RETIF				;Return on failure
	MOVE	T2,S1			;Put byte in T2
	SOJE	T1,GETFI1		;Exit if count is zero
	$CALL	GETBYT
	 $RETIF
	DPB	S1,[POINT 8,T2,27]	;Store next byte
	SOJE	T1,GETFI1		;Exit if count is zero
	$CALL	GETBYT			;Get next byte
	 $RETIF				;Return on failure
	DPB	S1,[POINT 8,T2,19]	;Store next byte
	SOJE	T1,GETFI1		;Exit if count is zero
	$CALL	GETBYT
	 $RETIF				;Return on failure
	DPB	S1,[POINT 8,T2,11]	;Store this byte
GETFI1:	MOVEM	T2,(S2)			;Store the result
	MOVE	S1,T2			;Return answer in S1
	$RETT

SUBTTL GETBYT Routine to return a single DAP message byte
;GETBYT	is the lowest level routine called in message parsing
;	It is called to return a single DAP message byte

;Returns TRUE	S1/ 8 bit byte from message

;	 FALSE	S1/ 0 (no more bytes in current message)

GETBYT:	SOSGE	.DPCNT(DL)		;Is byte available?
	 JRST	[SETZM S1		;No..Clear our answer
		 $RETF]			;Return a failure
	ILDB	S1,.DPBPT(DL)		;Yes..return the byte
	$RETT
SUBTTL	GETVAR	Routine to process DAP variable length arguments

;GETVAR	Get variable length ascii field from DAP message
;	Field is stored as an Asciz string

;Accepts	S1/ Maximum size of argument
;		S2/ Storage address

;Returns	S1/ Actual size of argument
;		S2/ Storage address

GETVAR:	MOVE	T1,S1			;Put count in T1
	$CALL	GETBYT			;Get the count byte
	 $RETIF				;Return on failure
	CAMLE	S1,T1			;Check length of field
	$RETF				;Argument to long
	$SAVE	<S1,S2>			;Save returning arguments
	HRLI	S2,(POINT 7)		;Point to destination
	SKIPN	T1,S1			;Put actual count in T1
	JRST	GETVA2			;Exit on null count
GETVA1:	$CALL	GETBYT			;Get a byte from message
	 $RETIF				;Return on failure
	IDPB	S1,S2			;Store the byte in message
	SOJG	T1,GETVA1		;Get all the bytes
GETVA2:	IDPB	T1,S2			;Store a null
	$RETT				;Return
SUBTTL	GETINT	Routine to process DAP integer arguments

;GETINT	Get variable length integer field from DAP message

;Accepts	S1/ Maximum size of field
;		S2/ Storage address

;Returns	S1/ Argument low order bits
;		S2/ Argument high order bits

GETINT:	HRR	T4,S2			;Save original address
	HRL	T4,S1			;Save original count
	SETZB	T1,T2			;Clear the result
	$CALL	GETBYT			;Get the count byte
	 $RETIF				;Return on failure
	JUMPE	S1,GETIN1		;Exit on null count
	CAIG	S1,^D9			;Argument length ok?
	CAMLE	S1,.DPCNT(DL)		;Enough bytes left?
	$RETF				;No..return the error
	MOVE	T3,S1			;Store the actual length
	$CALL	GETBYT			;Get the least significant byte
	DPB	S1,[POINT 8,T1,35]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T1,27]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T1,19]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T1,11]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 4,T1,3]	;Store 4 bits
	LSH	S1,-4			;Get the next 4
	DPB	S1,[POINT 4,T2,35]	;Store them
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T2,31]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T2,23]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T2,15]	;Store it
	SOJE	T3,GETIN1		;Exit if count is zero
	$CALL	GETBYT			;Get the next byte
	DPB	S1,[POINT 8,T2,7]	;Store it
GETIN1:	DMOVE	S1,T1			;Return the result
	MOVEM	S1,0(T4)		;Save low order part
	HLRZ	T3,T4			;Get argument length
	CAIL	T3,^D5			;Want a high order part?
	MOVEM	S2,1(T4)		;Save high order part
	$RET
SUBTTL	GETPRO	Routine to get Protection field from DAP message

;GETPRO	Get 3 byte extensible protection field from message
;	and store in internal format

;Accepts	S1/ Size of protection field (3)
;		S2/ Storage address

;Returns	S1/ Internal protection right justified
;		S2/ Storage address


GETPRO:	PUSH	P,S2			;Save storage address
	$CALL	GETEXF			;Process as extensible field
	MOVX	S2,77			;Assume full access allowed
	TXNE	S1,PR$DRA		;Allow read access?
	TXZ	S2,FP%RD		;No..then deny it
	TXNE	S1,PR$DWA		;Allow write access?
	TXZ	S2,FP%WR		;No..then deny it
	TXNE	S1,PR$DEA		;Allow execute access?
	TXZ	S2,FP%EX		;No..then deny it
	TXNE	S1,PR$DAA		;Allow append access?
	TXZ	S2,FP%APP		;No..then deny it
	TXNE	S1,PR$DLA		;Allow directory list access?
	TXZ	S2,FP%DIR		;No..then deny it
	CAIE	S2,77			;Anything denied?
	TXZ	S2,1			;Yes..clear LSB
	MOVE	S1,S2			;Put internal protection in S1
	POP	P,S2			;Restore storage address
	MOVEM	S1,(S2)			;Store the result
	$RET				;Return True/false per result
					; of GETEXF call
SUBTTL	GETEXF	Routine to process DAP extensible fields
SUBTTL	GETMNU	Routine to process DAP extensible menu fields

;GETEXF	Reads an extensible field from DAP message
;Extensible fields are stored right justifed and may be up to
;70 information bits in length (10 dap bytes)
;The Extention bits are not stored in the extensible field

;Accepts	S1/ Maximum size of field
;		S2/ Storage address

;Returns	S1/ Low order bits of extensible field
;		S2/ High order bits of extensible field

GETMNU:
GETEXF:	SETZB	T1,T2			;Clear result
	SETZM	T3			;Clear counter
	MOVE	T4,S1			;Save maximum size
GETEX1:	$CALL	GETBYT			;Get the low order byte
	 $RETIF				;Return on error
	CAILE	T3,^D10			;Done too much?
	 $RETF				;Yes..return failure
	DPB	S1,EXFTBL(T3)		;Store the byte
	CAIN	T3,5			;Doing 1 bit entry?
	JRST	GETEX2			;Yes..store next 6 bits
	TXNN	S1,DP$EXF		;No..Extended?
	JRST	GETEX3			;No..check the result
	AOJA	T3,GETEX1		;Get next byte

GETEX2:	ADDI	T3,1			;Get next pointer
	LSH	S1,-1			;Get next 6 bits
	DPB	S1,EXFTBL(T3)		;Store them
	TXNE	S1,DP$EXF/2(T3)		;Extended?
	AOJA	T3,GETEX1		;Yes..do the next byte

GETEX3:	CAILE	T3,1(T4)		;Done too many bytes?
	$RETF				;Yes..return failure
	MOVEM	T1,0(S2)		;Store low order bits
	CAILE	T4,5			;Double word value?
	MOVEM	T2,1(S2)		;Yes..store high order bits
	DMOVE	S1,T1			;Return result in S1-S2
	$RETT

EXFTBL:	POINT 7,T1,35			;Byte 0 (bits 1-7)
	POINT 7,T1,28			;Byte 1
	POINT 7,T1,21			;Byte 2
	POINT 7,T1,14			;Byte 3
	POINT 7,T1,7			;Byte 4
	POINT 1,T1,0			;Byte 5 (bit 7)
	POINT 6,T2,35			;Byte 5 (bits 1-6)
	POINT 7,T2,29			;Byte 6 (bits 1-7)
	POINT 7,T2,22			;Byte 7
	POINT 7,T2,15			;Byte 8
	POINT 7,T2,8			;Byte 9
	POINT 2,T2,1			;Byte 10 (Bits 6-7)
SUBTTL	GETDTI	Routine to process Date/time field in DAP message

;GETDTI	Gets an 18 byte date time field stored as dd-mmm-yyyy hh:mm
;	and stored the field in standard internal format

;Accepts	S1/ Argument size (18)
;		S2/ Storage address

;Returns	S1/ Internal Date/time
;		S2/ Storage address

GETDTI:	CAMLE	S1,.DPCNT(DL)		;Enough room in message?
	$RETF				;No..return failure
	PUSH	P,S2			;Save storage address
	MOVEI	S2,MSGJNK		;Point to temporary string
	HRLI	S2,(POINT 7)		;Generate pointer
	MOVE	T1,S1			;Move count to T1
	$CALL	GETVA1			;Extract bytes from message
	 JUMPF	GETDT1			;Return False on failure
	HRROI	S1,MSGJNK		;Point to string
	MOVX	S2,IT%NNM!IT%AIS!IT%AAC!IT%NTM!IT%NTZ
	IDTIM				;Convert to internal form
	 MOVX	TF,FALSE		;Indicate failure
	MOVE	S1,S2			;Return result in S1
GETDT1:	POP	P,S2			;Restore storage address
	MOVEM	S1,(S2)			;Store the result
	$RET				;Return TF per results
SUBTTL	GETDAT	Routine to process DATA field from DAP message


GETDAT:	MOVE	S1,.DPBPT(DL)		;Point to the data
	MOVE	S2,.DPCNT(DL)		;Get the count
	SKIPF	CRCFLG			;Doing CRC?
	$CALL	DOCRC			;Yes, calculate it
	HLRZ	S1,DATDAT		;Get routine address
	$CALL	0(S1)			;Call the routine
	$RET				;Return per processing routine
SUBTTL	GETASC	Routine to process ascii data in message

GETASC:	MOVE	S1,SRCMOD		;Get source data mode
	CAIN	S1,.MD11		;Print files?
	PJRST	GETPRN			;Yes..process it
	CAIN	S1,.MD12		;Fortran files?
	 JFCL				;[126]STRIP THE FIXED CONTROL PART
	MOVE	S1,ATTRFM		;Get record format
	CAXE	S1,FB$VFC		;Variable with fixed control?
	JRST	GETAS1			;No..standard ascii
	SKIPN	T1,ATTFSZ		;Yes..get fixed control size
	 JRST	GETAS1			;Null fixed size..ignore it
	$CALL	GETBYT			;Just strip the Line seq for now
	 JUMPF	ILLREC			;Illegal record format
	SOJG	T1,.-2			;Get entire fixed header
GETAS1:	$CALL	GETBYT			;Get byte from message
	 JUMPF	GETAS2			;Check for implied CR-LF
	$CALL	OUTBYT			;Write the byte
	 $RETIF				;Return the error on failure
	JRST	GETAS1			;Get the next byte

GETAS2:	MOVE	S1,ATTRAT		;Get file attributes
	TXNN	S1,FB$CR		;Implied CR-LF?
	TXNE	S1,FB$FTN		;[126]OR FORTRAN CARRAIGE CONTROL?
	SKIPA				;[126]
	$RETT				;No..just return
	LDB	S1,.DPBPT(DL)		;Get terminating byte
	MOVEI	S2,1			;Get a one bit
	LSH	S2,0(S1)		;Justify per character
	TXNE	S2,ASCBRK		;Was it a break character?
	$RETT				;Yes..don't append CRLF
GETAS3:	MOVEI	S1,.CHCRT		;Get a CR
	$CALL	OUTBYT			;Write to file
	 $RETIF				;Return the error on failure
	MOVEI	S1,.CHLFD		;Get a LF
	$CALL	OUTBYT
	 $RETIF				;Return the error on failure
	$RETT

ILLREC:	$MTERR	(ER$IRC)		;Illegal record format
SUBTTL	TSTPRN	Routine to do final linefeed for print files

TSTPRN:	MOVE	S1,ATTRAT		;Get record attributes
	TXNE	S1,FB$PRN+FB$FTN	;Print or Fortran format?
	JRST	GETAS3			;Yes..do final <CRLF>
	$RETT				;No..just return
SUBTTL	GETPRN	Routine to process print file format (vax)

GETPRN:	$CALL	GETBYT			;Get the first byte
	 JUMPF	ILLREC			;Illegal record format
	$CALL	GETPR3			;Write prefix
	 $RETIF				;Return the error on failure
	$CALL	GETBYT			;Get postfix byte
	 JUMPF	ILLREC			;Illegal record format
	MOVE	T4,S1			;Remember it
GETPR1:	$CALL	GETBYT			;Get byte from message
	 JUMPF	GETPR2			;Do post fixup
	$CALL	OUTBYT			;Write the byte
	 $RETIF				;Return the error on failure
	JRST	GETPR1			;Get the next byte
GETPR2:	MOVE	S1,T4			;Get post fixup character
GETPR3:	SKIPN	T1,S1			;Put character in T1
	JRST	GETPR5			;Ignore nulls
	TXNE	S1,200			;Count of linefeeds?
	TDZA	T1,T1			;No..clear the count
	MOVEI	S1,.CHLFD		;Get the character
	TXZN	S1,140			;8 bit control character?
	TXZ	S1,200			;No..clear MSB
GETPR4:	$CALL	OUTBYT			;No..just store the character
	 $RETIF				;Return the error on failure
	SOJG	T1,GETPR4		;Repeat until finished
GETPR5:	$RETT
SUBTTL	GETPAG	Routine to get a file page from DAP message

;GETPAG is called to create a filepage whose VBN is in DATRCN from
;	the data in this message.  Trailing zero words need not be
;	part of the data message.

; If VBN is 0 the file FDB will be transferred.  VBN is the LBN +1.
;

GETPAG:	$SAVE	<P1,P2,P3>
	SETZM	PAGNUM			;[134]RESET CURRENT FILE PAGE #
	SKIPN	P3,DATRCN		;Get Requested VBN
	JRST	GETPA3			;Zero is special case for FDB
	SUBI	P3,1			;Convert to file page number
	LSH	P3,-^D2
	MOVEM	P3,PAGNUM		;[134]STORE CURRENT FILE PAGE NUMBER
	$CALL	M%NXPG			;Get a page for the file
	MOVE	P2,S1			;Remember page number
	LSH	S1,^D9			;Convert to address
	MOVE	P1,S1			;Save the address
	HRLI	P1,-PAGSIZ		;Build AOBJN pointer
	SETZM	0(P1)			;Create the page
	SETZM	.DPBCT(DL)		;Clear starting bitcount
GETPA1:	MOVEI	S2,^D36			;Get a word from the messagee
	$CALL	GETBCT
	 JUMPF	GETPA2			;Finished if zero words are missing
	MOVEM	S1,0(P1)		;Save the word for file
	AOBJN	P1,GETPA1		;Finish the page
GETPA2:	SKIPLE	.DPCNT(DL)		;Make sure byte count is exausted
	 JRST	ILLREC			;Else return illegal record format
	MOVE	S1,P2			;Get page number
	HRLI	S1,.FHSLF		;Map from process to file
	MOVE	S2,P3			;Get the file page number
	HRL	S2,LOCJFN
	MOVX	T1,PM%WR+PM%RD+PM%EX	;Set appropriate access bits
	PMAP
	 ERJMP	TERCVT			;Return the error
	MOVE	S1,P2			;Release the page
	$CALL	M%RELP
	$RETT

GETPA3:	$SAVE	<.FBAUT+ATTFDB>		;Save author if any from Attributes
					;Replace rest of FDB from data message
	MOVSI	P1,-.FBLEN		;Get length of the FDB
	HRRI	P1,ATTFDB		;Point to it
	SETZM	.DPBCT(DL)		;Clear initial bit count
GETPA4:	MOVEI	S2,^D36			;Get an FDB word
	$CALL	GETBCT
	 JUMPF	GETPA5			;Premature end of FDB
	MOVEM	S1,0(P1)		;Store the word
	AOBJN	P1,GETPA4		;Get all the words
GETPA5:	SETZM	.DPCNT(DL)		;Ignore short or long FDB
	$RETT				;Return
SUBTTL	GETIMG	Routine to process image bit stream in data message

;GETIMG	Processes an image mode bit stream in the DAP message and
;	turns it into a byte stream which is stored on disk.  This
;	routine is the standard routine called to Unpack n-bit
;	bytes from the DAP  message.  The routine supports 4 record
;	formats and stores the information on disk in the following
;	manner:

; UDF	<Data...Data>
; FIX	<Data...Data>
; VAR	<Cnt(LSB)><Cnt(MSB)><Data...Data>
; VFC	<Hdr(LSB)..Hdr(MSB)><Cnt(LSB)><Cnt(MSB)><Data...Data>

;The actual bytesize of the image mode bit stream in the message
;is specified in the attributes message that proceeds the data.

GETIMG:	$SAVE	<P1,P2>			;Save some AC's
	MOVE	P2,ATTBSZ		;P2 gets size of bitstream
	MOVE	S1,.DPCNT(DL)		;Get remaining count
	IMULI	S1,^D8			;Get number of bits
	SUB	S1,.DPBCT(DL)		;[141]COMPUTE TOTAL REAL BITS
	IDIV	S1,P2			;Compute BYTEcount
	SKIPE	S2			;[141]ANY LEFTOVER BITS?
	 $MFERR	(.DMDAT,14)		;No..invalid format
	MOVE	P1,S1			;P1 gets count of bytes
	SETZM	.DPBCT(DL)		;Bitcount must start at 0
	MOVE	S1,ATTRFM		;Get record format
	CAIE	S1,FB$FIX		;Fixed record format?
	CAIN	S1,FB$UDF		; or Undefined record format?
	JRST	GETIM3			;Yes..just store the data
	CAIN	S1,FB$VAR		;Variable?
	JRST	[SKIPLE MCYIDX		;Yes..doing MACY11 mode?
		 $CALL ALNMCY		;Yes..align on even byte
		 JRST GETIM2]		;Process variable records
	SKIPN	S1,ATTFSZ		;Fixed header size?
	JRST	GETIM2			;No..process as variable.
	SUB	P1,S1			;Yes..subtract the fixed size
	PUSH	P,P1			;Save variable portion count
	MOVE	P1,S1			;Store the fixed part
GETIM1:	MOVE	S2,P2			;Get the bytesize
	$CALL	GETBCT			;Get the first byte
	 JUMPF	[POP P,P1		;Restore the stack
		 $RET]			;Return the error
	$CALL	OUTBYT			;Write the byte
	 $RETIF				;Return the error on failure
	SOJG	P1,GETIM1		;Finish the fixed part
	POP	P,P1			;Restore variable count
GETIM2:	MOVE	S1,P1			;Write the record count
	$CALL	OUTBYT
	 $RETIF				;Return the error on failure
	CAIL	P2,^D12			;Small bytes?
	JRST	GETIM3			;No..Don't write second byte
	MOVN	S2,P2			;Yes..Get shift value
	MOVE	S1,P1			;Get the record count
	LSH	S1,0(S2)		;get the second byte
	$CALL	OUTBYT			;Write the MSB of count
	 $RETIF				;Return the error on failure
GETIM3:	SOJL	P1,GETIM4		;Finish when count expired
	MOVE	S2,P2			;Get the Attributes byte size
	$CALL	GETBCT			;Get the bit stream
	 $RETIF				;Return the error
	$CALL	OUTBYT			;Write the byte to file
	 $RETIF				;Return the error on failure
	JRST	GETIM3			;Get the next word

GETIM4:	$RETT				;Return to caller
SUBTTL	GETBCT	Routine to return bitstream from DAP message

;Accepts	S2/ Bytesize (1-36)

;Returns TRUE	S1/ Byte right justified

GETBCT:	CAIN	S2,^D8			;Nice bytesize?
	JRST	[$CALL	GETBYT		;Yes, get one and return
		 $RETIT			; Success if one was found
		 JRST	ILLREC]		;Else return failure
	SETZ	T4,			;Clear result
	MOVE	T3,[POINT 8,T4,35]	;Get pointer to result
	SKIPN	T1,.DPBCT(DL)		;Residual bit count?
	JRST	GETBC1			;no..start at byte boundry
	HLLZ	T2,BCTTBL(T1)		;Get pointer adjustment
	ADD	T2,.DPBPT(DL)		;Get pointer to bits
	LDB	T4,T2			;Put them in answer
	DPB	T1,[POINT 6,T3,5]	;Pos = Bitcount
	SUB	S2,T1			;Get remaining bits
	JUMPLE	S2,GETBC4		;None left to get
GETBC1:	IDIVI	S2,^D8			;Get S2 bytcnt T1 Bitcnt
	JUMPE	S2,GETBC3		;Any full bytes to do?
GETBC2:	$CALL	GETBYT			;Yes..Get a byte
	 JUMPF	ILLREC			;Illegal record format
	DPB	S1,T3			;Store in result
	ADD	T3,[100000,,0]		;Say we stored 8 bits
	SOJG	S2,GETBC2		;Get next full byte
GETBC3:	JUMPE	T1,GETBC4		;Any residual bits?
	$CALL	GETBYT			;Yes..get them
	 JUMPF	ILLREC			;Illegal record format
	DPB	T1,[POINT 6,T3,11]	;Size = Bitcount
	DPB	S1,T3			;Store the odd bytes
	HRRE	S2,BCTTBL(T1)		;Get residual bitcnt
GETBC4:	MOVNM	S2,.DPBCT(DL)		;Store it
	MOVE	S1,T4			;Get the result
	$RETT
SUBTTL	GETDOS	Routine to store MACY11 variable length files

GETDOS:	$SAVE	<P1,P2>			;Preserve some AC's
	MOVEI	S1,1			;Write first sync frame
	$CALL	OUTBYT
	 $RETIF				;Return the error on failure
	MOVEI	S1,0			;Write next sync frame
	$CALL	OUTBYT
	 $RETIF				;Return the error on failure
	MOVE	P1,.DPCNT(DL)		;Get the record count
	MOVEI	S1,4(P1)		;Get count to include header
	MOVEI	P2,1(S1)		;Initialize checksum
	$CALL	OUTBYT			;Store first count byte in file
	 $RETIF				;Return the error on failure
	LSH	S1,-^D8			;Get High order byte
	ADD	P2,S1			;Include in checksum
	$CALL	OUTBYT			;Store in file
	 $RETIF				;Return the error on failure
GETDO1:	$CALL	GETBYT			;Get a byte from the record
	 JUMPF	ILLREC			;Illegal record format
	ADD	P2,S1			;Tally the checksum
	$CALL	OUTBYT			;Write to file
	 $RETIF				;Return the error on failure
	SOJG	P1,GETDO1		;Do all record bytes
	MOVN	S1,P2			;Negate checsum
	ANDX	S1,377			;Just write 8 bits
	$CALL	OUTBYT			;Store in file
	 $RETIF				;Return the error on failure
	MOVEI	P1,6			;Store 6 null bytes
	MOVEI	S1,0
	$CALL	OUTBYT
	 $RETIF				;Return the error on failure
	SOJG	P1,.-2
	$RETT
SUBTTL	SNDQUE	Routine to send all messages in the send queue

;This routine will cause all message on the SNDQUE to be sent
;to the remote system with the possible exception of the last
;message segment (to allow subsequent blocking)

SNDQUE:	$SAVE	<DL>			;Preserve an AC
	SETZM	DL			;Clear pointer to last message
	MOVE	S1,SNDLST		;Position to last entry
	$CALL	L%LAST
	 JUMPF	SNDQU2			;Return when finished
	SKIPE	.DPLEN(S2)		;Forcing last message out?
	MOVE	DL,S2			;No..save pointer to last segment

SNDQU1:	MOVE	S1,SNDLST		;Point to send que
	$CALL	L%FIRST			;Get first message address
	 JUMPF	SNDQU2			;Return when finished
	CAMN	DL,S2			;Want to retain last segment?
	JRST	SNDQU2			;Yes..just return for now
	$CALL	LLSEND			;Send the message
	 $RETIF				;Return if error
	$CALL	DELMSG			;Delete current message
	JRST	SNDQU1			;Send the rest

SNDQU2:	$RETT				;The queues are empty!

;SUBTTL	DELMSG	Routine to delete current message in the Send Queue

DELMSG:	MOVE	S1,SNDLST		;Delete current send Queue entry
	$CALL	L%DENT
	$RETT
SUBTTL	PUTMSG	Routine to build and force all messages out

;This routine will place a message at the end of the SNDQUE and then
;clear the remaining length to ensure that the message is sent on
;a subsequent call to SNDQUE

;Accepts	S1/ Address of message descriptor

PUTMSG:	$CALL	QUEMSG			;Do header fixup
	SETZM	.DPLEN(DL)		;Clear to force message out
	$RET				;Return per QUEMSG


SUBTTL	QUEMSG	Routine to block current message if possible

;This routine is called to block a message to the existing send queue
;if blocking is possible.  A subsequent call to SNDQUE will cause all
;message segments to be sent with the possible exception of the last
;segment

;Accepts	S1/ Address of message descriptor


QUEMSG:	$CALL	BLDMSG			;Build the message
	JUMPF	[$SAVE	<TF,S1,S2>	;Save any errors for return
		 JRST	.+1]		;Continue in line
	SKIPG	.DPTYP(DL)		;Valid message?
	 PJRST	DELMSG			;No..delete it and return
	$CALL	BLDHDR			;Build the header
	MOVE	S1,SNDLST		;Get previous entry
	$CALL	L%PREV
	 JUMPF	QUEMS1			;No previous entry
	MOVE	S1,.DPLEN(S2)		;Get previous remaining length
	SUB	S1,.DPCNT(DL)		;May we block this message?
	JUMPLE	S1,[SETZM .DPLEN(S2)	;No..Clear previous length
		    JRST QUEMS1]
	MOVEM	S1,.DPLEN(DL)		;Save new remaining length
QUEMS1:	MOVE	S1,.DPLEN(DL)
	MOVE	S2,.DPFLG(DL)
	CAIL	S1,DPMXH		;May we block current message?
	TXNN	S2,HD$LEN		;...
	SETZM	.DPLEN(DL)		;No..mark end of message
	$RETT				;Return
SUBTTL	BLDMSG	Routine to build a DAP message

;BLDMSG	is called to construct a DAP message from the message descriptor
;	storing all requested fields in the DAP message.  BLDMSG checks
;	the version check words from the message descriptor to ensure
;	that extra fields known locally are not sent to a DAP implimen-
;	tation that doesn't understand them

;Accepts	S1/ Address of message descriptor

BLDMSG:	$SAVE	<P1,P2>
	MOVE	P1,S1			;P1 points to message descriptor
	$DEBUG	(Building ,<^Q/0(P1),RHMASK/ message>)
	MOVE	S1,SNDLST		;Allocate a message buffer
	MOVE	S2,OURSIZ		; for largest message
	SUBI	S2,DPMXH-2		;Subtract maximum header size
	$CALL	NEWBUF
	MOVE	DL,S1			;Setup global message pointer
	HLRZ	S1,0(P1)		;Store message type
	MOVEM	S1,.DPTYP(DL)		; in message header
	HRLZ	T1,2(P1)		;Get field count
	JUMPE	T1,BLDMS7		;Exit if no message fields
	MOVN	T1,T1			;Make AOBJN pointer
	HRRI	T1,3(P1)		;Point to first argument
	MOVE	T2,OURVER		;Get our version for checking
	TRZ	T2,17			;Clear user version level
	MOVE	P1,T1			;Put pointer in P1
	SETOM	P2			;Set initial menu to all fields
BLDMS1:	MOVE	S1,0(T1)		;Get first argument type
	TXNN	S1,DA%VER		;Version check word?
	JRST	BLDMS2			;No..check next arg
	ADDI	T1,1			;Yes..point to it
	MOVE	T3,0(T1)		;Get the check word
	TXNE	T3,17			;OSTYPE specifed for check?
	 JRST	[XOR T3,REMOST		;Yes..it must match.
		 TXNE T3,17		;did they match?
		 AOJA T1,BLDMS1		;No..skip this check
		 JRST .+1]		;Yes..check it
	CAMLE	T2,T3			;Within our range?
	AOJA	T1,BLDMS1		;Yes..on to get next field
	JRST	BLDMS3			;No..terminate our menu
BLDMS2:	TXNE	S1,DA%DEF		;Default word presnt?
	ADDI	T1,1			;Yes..bump past it
	LSH	P2,1			;Mark a valid menu item
	AOBJN	T1,BLDMS1		;On to finish all fields
BLDMS3:	SETCAM	P2,P2			;Fixup our menu
BLDMS4:	MOVE	T1,0(P1)		;Get argument descriptor
	TXNE	T1,DA%VER		;Is there a version check field?
	JRST	[ADDI P1,1		;Yes..ignore it
		 AOJA P1,BLDMS4]	;Get the next field
	TXNE	T1,DA%DEF		;Is there a default word?
	ADDI	P1,1			;Yes..bump past it
	TXNN	P2,1			;Is menu bit set?
	JRST	BLDMS5			;No..try next field
	LSH	P2,-1			;Yes..get next menu bit
	LOAD	S1,T1,DA%SIZ		;Get Maximum field len
	LOAD	S2,T1,DA%STG		;Get storage offset
MULINK<	ADD	S2,CP>			;Get actual storage address
	LOAD	T1,T1,DA%TYP		;Get the argument type
	CAIN	T1,.ARMNU		;Is argument a menu?
	ANDB	P2,0(S2)		;Yes..remember it
	HRRZ	T1,ARGTBL(T1)		;Get the processor address
	$CALL	0(T1)			;Store the field
	JUMPT	BLDMS6			;Do the next field
	$SAVE	<TF,S1,S2>		;Else save the error for return
	JRST	BLDMS6
BLDMS5:	LSH	P2,-1			;Get next menu item
BLDMS6:	AOBJN	P1,BLDMS4		;Back for next field
BLDMS7:	$RETT
SUBTTL	BLDHDR	Routine to build header for current message

;Accepts	DL/ Address of current message header

BLDHDR:	MOVE	S1,.DPFLG(DL)		;Get existing flags
	MOVE	S2,.DPCNT(DL)		;Get remaining count
	SUB	S2,.DPLEN(DL)		;Subtract original count
	ADDM	S2,.DPLEN(DL)		;Adjust remaining length
	MOVM	T2,S2			;Remember operand length
	MOVE	T3,OURCAP		;Get mutual capabilities
	SKIPE	.DPBCT(DL)		;Bitcount present?
	TXO	S1,HD$BCT		;Yes..set the flag
	SKIPE	.DPSID(DL)		;Stream ID present?
	TXO	S1,HD$SID		;Yes..set the flag
	CAIG	T2,^D255		;More than 255 bytes?
	JRST	[TXO S1,HD$LEN		;No..set length flag
		 JRST BLDHD1]		;Check blocking support
	TXNE	T3,SY$LN2		;Yes..do we support Len 256?
	TXO	S1,HD$LEN+HD$LN2	;Yes..set both flags
BLDHD1:	TXNN	T3,SY$BLK		;Do we support blocking?
	TXZ	S1,HD$LEN+HD$LN2	;No..Don't send length fields
	MOVEM	S1,.DPFLG(DL)		;Save the flags
	SUBI	S2,2			;Count message type and flags
	TXNE	S1,HD$SID		;Stream Id?
	SUBI	S2,1			;Yes..count it
	TXNE	S1,HD$LEN		;Length field?
	SUBI	S2,1			;Yes..count it
	TXNE	S1,HD$LN2		;Length 256?
	SUBI	S2,1			;Yes..count it
	TXNE	S1,HD$BCT		;Bit count?
	SUBI	S2,1			;Yes..count it
	MOVMM	S2,.DPCNT(DL)		;Save count of bytes in message
	ADJBP	S2,.DPBPT(DL)		;Reset message pointer
	MOVEM	S2,.DPBPT(DL)		;Save for Sending message
	MOVE	T1,.DPTYP(DL)		;Get message type
	IDPB	T1,S2			;Store the message type
	IDPB	S1,S2			;Store the flag byte
	MOVE	T1,.DPSID(DL)		;Get Stream Id
	TXNE	S1,HD$SID		;Want it?
	IDPB	T1,S2			;Yes..store it
	TXNE	S1,HD$LEN		;Want Length field?
	IDPB	T2,S2			;Yes..store it
	LDB	T1,[POINT 8,T2,27]	;Get Length 256 field
	TXNE	S1,HD$LN2		;Want it?
	IDPB	T1,S2			;Yes..store it
	MOVE	T1,.DPBCT(DL)		;Get bitcount field
	TXNE	S1,HD$BCT		;Want it?
	IDPB	T1,S2			;Yes..store it
	$RETT
SUBTTL	PUTFIX	Routine to store 1 to 4 BYTE fields in DAP message

;Accepts	S1/ Number of bytes to store (1 to 4)
;		S2/ Address of word containing bytes (MSB thru LSB)

PUTFIX:	CAIL	S1,1			;Check range
	CAILE	S1,4
	 $CALL	PUTERR			;Die on error
	CAMLE	S1,.DPCNT(DL)		;Check for room
	 $CALL	PUTERR			;Die on error
	MOVE	T1,S1			;Save the count
	MOVE	S1,0(S2)		;Get the argument
PUTFI1:	$CALL	PUTBYT			;Store the byte
	LSH	S1,-^D8			;Get the next byte
	SOJG	T1,PUTFI1		;Do all bytes
	$RETT


SUBTTL	PUTBYT	Routine to store a character in current message

;Accepts	S1/ Character to store in message

PUTBYT:	SOSGE	.DPCNT(DL)		;Any room left in buffer?
	 $CALL	PUTERR			;Die on error
	IDPB	S1,.DPBPT(DL)		;PUT BYTE IN MESSAGE
	$RETT				;AND RETURN

SUBTTL	PUTERR	Routine to die on invalid argument

;PUTERR	is called from PUT??? when bad arguments are encountered
;	or the message buffer is out of room

PUTERR:	$FATAL	(Dap message buffer is full)
SUBTTL	PUTVAR	Routine to store a variable length field in DAP message

;Accepts	S1/ Maximum size of field
;		S2/ Address of ASCIZ string to store

PUTVAR:	MOVE	T4,S1			;Remember maximum size
	CAIG	T4,^D255		;Request too large
	CAML	T4,.DPCNT(DL)		;...
	$CALL	PUTERR			;Yes..return a failure
	HRLI	S2,(POINT 7)
	MOVE	T1,S2			;Save pointer to source
	SETZB	T2,S1			;Clear counts
	$CALL	PUTBYT			;Store null count for now
	MOVE	T3,.DPBPT(DL)		;Remember pointer to count
PUTVA1:	ILDB	S1,T1			;Get source byte
	JUMPE	S1,PUTVA2		;Exit on null
	$CALL	PUTBYT			;Store byte in message
	AOJA	T2,PUTVA1		;Back for next
PUTVA2:	MOVE	S1,T1			;Return updated pointer
	DPB	T2,T3			;Store actual count
	CAMLE	T2,T4			;Within requested size?
	$CALL	PUTERR			;No..return a failure
	$RETT				;Return success
SUBTTL	PUTINT	Routine to store variable length integer

;Accepts	S1/ Maximum size of field
;		S2/ Address of integer to store in message

PUTINT:	MOVE	T4,S1			;Remember maximum size
	CAIG	T4,^D9			;Request too large?
	CAML	T4,.DPCNT(DL)		;...
	$CALL	PUTERR			;Yes..return a failure
	$CALL	PUTBYT			;Write a dummy count
	MOVE	T3,.DPBPT(DL)		;Save the pointer
	MOVE	T2,0(S2)		;Get low order part
	CAIG	T4,4			;Hi order part?
	TDZA	T1,T1			;No..clear holding reg
	MOVE	T1,1(S2)		;Yes..get it
	MOVEI	S2,1			;Get a count of 1
PUTIN1:	MOVE	S1,T2			;Get Least significant byte
	$CALL	PUTBYT			;Store byte from integer
	LSHC	T1,-^D8			;Get next byte
	SKIPN	T1			;Time to quit?
	SKIPE	T2			;...
	AOJA	S2,PUTIN1		;No..do the next byte
	DPB	S2,T3			;Store actual count
	CAMLE	S2,T4			;Within requested size?
	$CALL	PUTERR			;No..return a failure
	$RETT				;Yes..return success
SUBTTL	PUTPRO	Routine to store DAP protection argument

;PUTPRO is called with internal protection code and converts
;	it to DAP protection before sending off the argument

;Accepts	S1/ Maximum size of field (3 bytes)
;		S2/ Address of local protection code

PUTPRO:	SETZM	T1			;Assume all access allowed
	MOVE	T2,0(S2)		;Get argument
	TXNN	T2,FP%RD		;Read access allowed?
	TXO	T1,PR$DRA		;No..deny it
	TXNN	T2,FP%WR		;Write access allowed?
	TXO	T1,PR$DWA!PR$DDA	;No..deny write and delete
	TXNN	T2,FP%EX		;Execute access allowed?
	TXO	T1,PR$DEA		;No..deny it
	TXNN	T2,FP%APP		;Append access allowed?
	TXO	T1,PR$DAA		;No..deny it
	TXNN	T2,FP%DIR		;Directory list access allowed?
	TXO	T1,PR$DLA		;No..deny it
	MOVEI	S2,T1			;Point to extensible field
;	PJRST	PUTEXF			;Send the dap protection
SUBTTL	PUTEXF	Routine to store extensible field in Dap message
SUBTTL	PUTMNU	Routine to store DAP extensible fields

;Accepts	S1/ Maximum size of field (1 to 10)
;		S2/ Address of EXARG

;EXARG:	Low order 36 bits of extensible field
;	High order 36 bits of extensible field


PUTMNU:
PUTEXF:	CAMLE	S1,.DPCNT(DL)		;Enough room?
	 $CALL	PUTERR			;No..die on error
	MOVE	T1,0(S2)		;Low order part to T1
	CAIG	S1,5			;More than 5 bytes?
	TDZA	S2,S2			;No..clear high order part
	MOVE	S2,1(S2)		;Yes..high order part to S2
PUTEX1:	MOVEI	S1,177			;Get 7 bit mask
	AND	S1,T1			;Get 7 bits from low order part
	LSHC	S2,-^D7			;Get next 7 bytes
	SKIPN	S2			;Have more to do after this?
	SKIPE	T1
	TXO	S1,DP$EXF		;Yes..set extension bit
	$CALL	PUTBYT			;Store in the message
	TXNE	S1,DP$EXF		;Anything left?
	JRST	PUTEX1			;Yes..back for next byte
	$RETT
SUBTTL	PUTDTI	Routine to store date time field in DAP message

;Accepts	S1/ Message field size (18)
;		S2/ Address of Date/time word

PUTDTI:	CAIN	S1,^D18			;Proper size?
	CAMLE	S1,.DPCNT(DL)		; and enough room?
	$CALL	PUTERR			;No..return a failure
	MOVE	S2,0(S2)		;Put value in S2
	HRROI	S1,MSGJNK		;Point to temporary storage
	SETZM	T1			;Standard options
	ODTIM				;Generate the date string
	MOVEI	T1,MSGJNK		;Point to the string
	HRLI	T1,(POINT 7)
	MOVEI	T2,^D18			;Store 18 bytes
	ILDB	S1,T1			;[122]GET THE FIRST CHARACTER
	CAIN	S1," "			;[122]CONVERT BLANKS TO ZEROS
	MOVEI	S1,"0"			;[122]GET A LEADING 0
	SKIPA				;[122]
PUTDT1:	ILDB	S1,T1			;Get a byte
	$CALL	PUTBYT			;Store in message
	SOJG	T2,PUTDT1		;Finish all bytes
	$RETT
SUBTTL	PUTDAT	Routine to store Data field in DAP message

PUTDAT:	$SAVE	<P1,P2>
	MOVE	P1,.DPBPT(DL)		;Get pointer to data
	MOVE	P2,.DPCNT(DL)		;Preserve remaining count
	HRRZ	S1,DATDAT		;Get processor address
	$CALL	0(S1)			;Call the processor
	SKIPT				;Save status for return on error
	$SAVE	<TF,S1,S2>
	SKIPN	.DPTYP(DL)		;Was message deleted?
	$RETT				;Yes..just return
	DMOVE	S1,P1			;Restore starting pointer and count
	SUB	S2,.DPCNT(DL)		;Compute actual count
	SKIPF	CRCFLG			;Computing CRC?
	$CALL	DOCRC			;Compute the CRC
	$RETT
SUBTTL	DOCRC	Routine to update cumulative CRC for data messages

;ACCEPTS	S1/ Pointer to 8 bit data stream
;		S2/ Byte count


; This routine is used to build the 16-bit CRC checksum character used
; to ensure DAP data integrity.  The CRC is initialized to -1 when a
; file ACCESS is initiated.  Both NFT and FAL compute the CRC on each
; data byte sent or recieved.  When the file is closed the CRC's NFT
; sends the CRC it has generated to the remote system where it must
; match the CRC generated by FAL.

DOCRC:	JUMPLE	S2,.RETT		;Return on null count
	MOVE	T1,FILCRC		;Get current CRC
DOCR1:	ILDB	T2,S1			;Get a byte from message
	XORB	T1,T2			;Include byte in CRC
	ANDI	T2,377			;Compute offset into table
	LSH	T1,-^D8			;Xor remaining CRC from table
	XOR	T1,CRCTAB(T2)		;Compute new CRC
	SOJG	S2,DOCR1		;Do the next
	MOVEM	T1,FILCRC		;Save computed CRC
	$RETT
SUBTTL	CRCTAB	CRC TABLE DEFINITION


	POLY==164405		;X^16+X^15+X^13+X^7+X^4+X^2+X^1+1

	POLINI==177777		;Initial value of -1 (16 bits)


DEFINE BLDCRC <
	LSTOF. XCREF
	ZZ==0
  REPEAT ^D256, <CRC (\ZZ)
		 ZZ==ZZ+1>
	LSTON.
> ;End BLDCRC


DEFINE CRC (BYTE) <
	.CRC=BYTE
REPEAT ^D8,<
	  .X=.CRC&1
	  IFN <.X>,<.CRC=.CRC_-1
		    .CRC=.CRC^!POLY>
	  IFE <.X>,<.CRC=.CRC_-1>>
	EXP .CRC
> ;End CRC


CRCTAB:	BLDCRC			;Generate the table
SUBTTL	PUTASC	ROUTINE TO READ ASCII DATA AND FORMAT AN OUTPUT DAP MESSAGE

;PUTASC	breaks ascii stream text up into records for transmission.
;Break characters are: <ESC><^Z><DC1-4><DLE><FF><VT> and <LF>

	ASCBRK==^B00001100000111110001110000000000

PUTASC:	SETZ	T1,			;[142]CHARACTER COUNT
	MOVE	T2,ATTRAT		;Get record attributes
	TXNE	T2,FB$CR		;[150]IMPLIED CRLF?
	SETOM	LINFLG			;[150]YES, STRIP NULLS
	SKIPN	T3,ATTMRS		;GET MAXIMUM RECORD SIZE
	MOVE	T3,.DPCNT(DL)		;No MRS..use remaining count
	SETOM	S1			;Say Last character was -1
PUTAS1:	SOSGE	T3			;Any room left?
	JRST	[SETOM BUFFUL		;[142]No, set buf full flag
		JRST PUTAS5]		;[142]Output the record
	MOVE	T4,S1			;Remember last character stored
PUTAS2:	$CALL	INPBYT			;Get a byte from file
	 JUMPF	PUTAS3			;Check for EOF
	JUMPN	S2,[SETOM LINFLG	;[150]LINE NUMBER SEEN, STRIP NULLS
		JRST PUTAS2]		;[130]DISCARD LINE NUMBERS
	SKIPE	LINFLG			;[150]STRIP NULLS?
	JUMPE	S1,PUTAS2		;Yes..then strip nulls
	$CALL	PUTBYT			;Store in the message
	ADDI	T1,1			;[142]INCREMENT CHARACTER COUNT
	CAIL	S1,.CHLFD		;Possible break character?
	CAILE	S1,.CHESC
	JRST	PUTAS1			;No..send next charcter
	MOVEI	S2,1			;Yes..check it out
	LSH	S2,0(S1)		;Justify bit per charcter
	TXNN	S2,ASCBRK		;Break character?
	JRST	PUTAS1			;Not a break..get next character
	CAIN	S1,.CHLFD		;<CRLF>?
	CAIE	T4,.CHCRT
	JRST	PUTAS5			;No..send the record
	TXNN	T2,FB$CR		;Yes..Stripping <CRLF>?
	JRST	PUTAS5			;No..send the record
	MOVEI	S1,2			;Yes..Get 2
	ADDM	S1,.DPCNT(DL)		;Back up count by 2
	MOVNI	S1,2
	ADJBP	S1,.DPBPT(DL)		;Back up pointer by 2
	MOVEM	S1,.DPBPT(DL)
	SKIPN	BUFFUL			;[142]Last rec out no crlf?
	JRST	PUTAS5			;[142]No, output this empty record
	SETZM	BUFFUL			;[142]Yes, reset flag
	CAIN	T1,2			;[142]ONLY A CRLF?
	JRST	PUTASC			;[142]YES, IGNORE THE RECORD
PUTAS5:	$RETT				;Return and send the record

PUTAS3:	$CALL	EOFCHK			;Check error for EOF
	 $RETIF				;Return False on error
	SKIPGE	T4			;Stored any characters?
	SETZM	.DPTYP(DL)		;No..delete this message
	$RETT
SUBTTL	PUTPAG	Routine to store file page in DAP message

;PUTPAG sends a file page whose VBN is in DATRCN.  Trailing zero
;words in the file page are not sent.

PUTPAG:	$SAVE	<P1,P2,P3>		;Preserve some AC's
	SETZM	PAGNUM			;[134]RESET LOCAL PAGE #
	SKIPN	P1,DATRCN		;Get requested VBN.
	JRST	PUTP50			;Zero is special case for FDB
	SUBI	P1,1			;Convert to file page address
	LSH	P1,-^D2
	MOVEM	P1,PAGNUM		;[134]SAVE CURRENT PAGE NUMBER
	$CALL	M%NXPG			;Get non existant page
	MOVEM	S1,PAGMEM		;[151]REMEMBER PAGE IN MEM
	MOVSI	S2,.FHSLF		;Map file page to my process
	HRR	S2,S1
	MOVE	P3,S2			;Remember for unmapping
	EXCH	S1,P1			;Remember process page
	HRL	S1,LOCJFN		;Get JFN,,file page
	MOVX	T1,PM%RD+PM%PLD		;Preload page
	PMAP
	 ERJMP	TERCVT
	LSH	P1,^D9			;Convert P1 to address
	HRLI	P1,-PAGSIZ		;Create AOBJN pointer
	SETZ	P2,			;Clear count of trailing nulls
PUTP10:	SKIPN	S1,0(P1)		;Get a word
	AOJA	P2,PUTP40		;Count a null
	JUMPE	P2,PUTP30		;Any zeros to write?
PUTP20:	SETZ	S1,			;Yes..write them
	MOVEI	S2,^D36
	$CALL	PUTBCT
	SOJG	P2,PUTP20
	MOVE	S1,0(P1)		;Reclaim data
PUTP30:	MOVEI	S2,^D36
	$CALL	PUTBCT			;Write it
PUTP40:	AOBJN	P1,PUTP10		;Write the entire page
	SETOM	S1			;Unmap the file page
	MOVE	S2,P3
	SETZM	T1
	PMAP
	 ERJMP	TERCVT
	SETZM	PAGMEM			;[151]FORGET PAGE NUMBER
	MOVEI	S1,-PAGSIZ(P1)		;Release our page
	LSH	S1,-^D9
	$CALL	M%RELP
	$RETT

PUTP50:	$CALL	GETFDD			;Setup actual FDB
	MOVSI	P1,-.FBLEN
	HRRI	P1,LOCFDB
PUTP60:	MOVE	S1,0(P1)		;Send entire FDB
	MOVEI	S2,^D36
	$CALL	PUTBCT
	AOBJN	P1,PUTP60
	$RETT
SUBTTL	PUTIMG	Routine to store n-bit bytes in data message

;This routine is the counterpart for GETIMG.  It reads file bytes
;and stores them in the DAP message as a bitstream whose size is
;determined by the attributes bytesize.

PUTIMG:	$SAVE	<P1,P2,P3>		;Preserve some AC's
	MOVE	S1,ATTRFM		;Get record format
	MOVE	P2,ATTBSZ		;Get attributes bytesize
	CAIN	S1,FB$UDF		;Undefined record format?
	JRST	PUTIM4			;Yes..calculate largest MRS
	CAIN	S1,FB$FIX		;Fixed length?
	JRST	PUTIM5			;Yes..go process it
	CAIE	S1,FB$VAR		;Variable length records?
	SKIPN	P1,ATTFSZ		;No..Zero length VFC?
	JRST	PUTIM2			;Yes..process variable length
PUTIM1:	$CALL	INPBYT			;Get a header byte
	 JUMPF	PUTI10			;See if it's EOF
	MOVE	S2,P2			;Get attributes byte size
	$CALL	PUTBCT			;Store the bitstream
	SOJG	P1,PUTIM1		;Store entire fixed header
	JRST	PUTIM3			;Process the variable count
PUTIM2:	SKIPLE	MCYIDX			;Doing MACY11 file?
	$CALL	ALNMCY			;Yes..align on half-word
PUTIM3:	$CALL	INPBYT			;Get LSB of count
	 JUMPF	PUTI10			;See if it's EOF
	MOVE	P1,S1			;Save it
	CAIL	P2,^D12			;MSB of count present?
	JRST	PUTIM6			;No..go check our count
	$CALL	INPBYT			;Get it
	 JUMPF	PUTI10			;Check for EOF
	LSH	S1,(P2)			;Position MSB of count
	IOR	P1,S1			;Tally the total count
	JUMPE	P1,PUTIM8		;[114]ZERO LENGTH RECORD?
	JRST	PUTIM6			;Check count against MRS
PUTIM4:	MOVE	S1,.DPCNT(DL)		;Get remaining count
	IMULI	S1,^D8			;Get number of remaining bits
	IDIV	S1,P2			;Get bits/bytesize
	MOVE	P1,S1			;Store computed maximum size
	JRST	PUTIM6			;Check against actual maximum
PUTIM5:	SKIPN	P1,ATTMRS		;Get maximum record size
	MOVE	P1,OURMRS		;Use our maximum as default
PUTIM6:	MOVE	P3,P1			;Save requested count
PUTIM7:	$CALL	INPBYT			;get a byte from file
	 JUMPF	PUTIM9			;Check for EOF
	MOVE	S2,P2			;Get the attributes bytesize
	$CALL	PUTBCT			;Store the bit stream
	SOJG	P1,PUTIM7		;Return when count exausted
PUTIM8:	$RETT

;PUTIMG continued on next page
;PUTIMG continued from previous page

PUTIM9:	$CALL	EOFCHK			;EOF while fetching data?
	 $RETIF				;No..return the error
	MOVE	S1,ATTRFM		;Yes..get our record format
	CAIE	S1,FB$VAR		;Is it variable or VFC?
	CAIN	S1,FB$VFC
	 $MTERR	ER$IRC			;Yes..then illegal record
	CAMN	P1,P3			;Have we stored anything?
	SETZM	.DPTYP(DL)		;No..scratch this message
	$RETT				;No..just return

PUTI10:	$CALL	EOFCHK			;EOF looking for Hdr or Cnt?
	 $RETIF				;No..return the faliure
	SETZM	.DPTYP(DL)		;Yes..scatch this message
	$RETT
SUBTTL	PUTBCT	Store image bit stream in DAP message

;Accepts	S1/ right justified byte
;		S2/ byte size (1-36 bits)

PUTBCT:	CAIN	S2,^D8			;Nice byte size?
	PJRST	PUTBYT			;Yes..putone and return
	SKIPN	T1,.DPBCT(DL)		;Any residual bitcount?
	JRST	PUTBC1			;No..start at byte boundry
	HLLZ	T2,BCTTBL(T1)		;Yes..get pointer adjustment
	ADD	T2,.DPBPT(DL)		;Point to residual bits
	DPB	S1,T2			;Store them
	SUB	S2,T1			;Get bits remaining in S1
	JUMPLE	S2,PUTBC4		;All done?
	MOVN	T1,T1			;No..get shift right value
	LSH	S1,0(T1)		;Right justify remaining bits
PUTBC1:	IDIVI	S2,^D8			;Get S2 bytecount T1 bitcount
	JUMPE	S2,PUTBC3		;Any full bytes to send?
PUTBC2:	$CALL	PUTBYT			;Yes..store a byte
	LSH	S1,-^D8			;Get next byte
	SOJG	S2,PUTBC2		;Do them all
PUTBC3:	JUMPE	T1,PUTBC4		;Any odd bits?
	$CALL	PUTBYT			;Yes..store them
	HRRE	S2,BCTTBL(T1)		;Get negitive bitcount
PUTBC4:	MOVNM	S2,.DPBCT(DL)		;Save the bitcount
	$RETT				;All finished

BCTTBL:	000000,,0			;Pointer adjust,,-bitcount
	067100,,-7			;Bytesize==1
	057200,,-6			;Bytesize==2 etc.
	047300,,-5
	037400,,-4
	027500,,-3
	017600,,-2
	007700,,-1			;Bytesize==7 Bitcnt==1
SUBTTL	PUTDOS	Process MACY11 assembler output

;PUTDOS	Processes MACY11 assembler output files and stores
;	them as variable length data.  MACY11 assembler
;	is equivalent in format to PDP21 style paper tape format
;	as follows

;Byte 0	<1>	sync byte
;Byte 1 <0>	null follows sync
;Byte 2 <cnt>	low order of (length of "Data" in bytes)+4=[n]
;Byte 3 <cnt>	high order of (length of "Data in bytes)+4=[n]
;Byte 4	<data>
;Byte n		(last byte of "Data")
;Byte n+1	Checksum byte (Two's complement add with carry ignored)
;		Checksum includes all bytes in record including header

;6 Nulls followed by next record (The nulls are ignored)


PUTDOS:	$SAVE	<P1,P2>			;Save an AC for checksum
PUTDO1:	$CALL	INPBYT			;Get a byte
	 JUMPF	[$CALL EOFCHK		;Check for EOF
		  $RETIF		;Return if not EOF
		 SETZM .DPTYP(DL)	;Else cancel this message
		 $RETT]			;And return
	JUMPE	S1,PUTDO1		;Ignore leading nulls
	CAIE	S1,1			;First byte is <1>
	 JRST	PUTDO4			; Else bad record format
	MOVE	P2,S1			;Initialize checksum
	$CALL	INPBYT			;Get the next byte
	 JUMPF	PUTDO3			;Check EOF and return failure
	JUMPN	S1,PUTDO4		;Second byte is <0>
	$CALL	INPBYT			;Third byte is L.O. count
	 JUMPF	PUTDO3			;Check EOF and return failure
	ADD	P2,S1			;Tally Checksum
	MOVE	P1,S1			;P1 will contain count
	$CALL	INPBYT			;Fourth byte is H.O. count
	 JUMPF	PUTDO3			;Check EOF and return failure
	ADD	P2,S1			;Tally checksum
	DPB	S1,[POINT 8,P1,27]	;Store High order part of count
	SUBI	P1,4			;Subtract four bytes for header
	CAMLE	P1,OURMRS		;Do we have enough room for it?
	 $MTERR	(ER$RTB)		;Nope..record too big!
PUTDO2:	$CALL	INPBYT			;Get next byte
	 JUMPF	PUTDO3			;Check EOF and return failure
	ADD	P2,S1			;Tally checksum
	$CALL	PUTBYT			;Store in message
	SOJG	P1,PUTDO2		;Repeat until count exausted
	$CALL	INPBYT			;Last byte is checksum
	 JUMPF	PUTDO3			;Check EOF and return error
	ADD	P2,S1			;Tally checksum
	TXNE	P2,377			;Are all checksum bits zero?
	JRST	PUTDO4			;No..Bad checksum
	$RETT				;Hurray..We made it!

PUTDO3:	$CALL	EOFCHK			;Check for EOF
	 $RETIF				;Return if file error
PUTDO4:	$MTERR	ER$IRC			;Else return record format error
SUBTTL	SETINP	Setup for local file input

;Accepts	AP/ Address of D$FUNC argument block

;Returns TRUE	S1/ Wild JFN flags
;		S2/ Pointer to expanded filespec


SETINP:	MOVEI	S1,JFNBLK		;Point to GTJFN block
	MOVE	T1,1+OURCAP		;Get second capability word
	MOVX	S2,GJ%OLD		;File must exist
	MOVE	T2,ACCFNC		;Get requested access
	CAIE	T2,AF$DIR		;Directory
	TXNE	T1,SY$WLD		; or do we support wild cards?
	TXO	S2,GJ%IFG+GJ%FLG	;Yes..allow them and get flags
	MOVEM	S2,.GJGEN(S1)		;Save for GTJFN
	MOVE	S2,.DFLFS(AP)		;Get pointer to local file spec
	GTJFN
	 ERJMP	TERCVT			;Convert error and fail
	SKIPE	S2			;[143]IF FILENAME SPECIFIED
	JRST	[LDB S2,S2		;[143]GET DELIMTING BYTE
		SKIPN S2		;[143]NULL?
		JRST .+1		;[143]YES, GOOD FILE NAME
		MOVEI S2,GJFX4		;[143]NO, BAD FILENAME
		JRST TERCV0]		;[143]
	MOVEM	S1,LOCJFN		;Save JFN and flags
	TXNN	S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;Anything wild?
	TDZA	S1,S1			;No..clear wild JFN
	TXO	S1,GN%STR+GN%DIR+GN%NAM+GN%EXT	;Mark change flags
	MOVEM	S1,WLDJFN		;Save for message generation
	$CALL	GETDEV			;Get device attributes
	 $RETIF				;Return if this fails
	TXNN	S2,DV%IN		;Can device do input?
	 PJRST	DEVERR			;No..bad device
	JRST	NXTIN1			;Continue after GNJFN

NXTINP:	MOVE	S1,LOCJFN		;Get original JFN
	GNJFN				;Get the next file
	 ERJMP	[$CALL	RELJFN		;No file match..release JFN
		 $RETF]			;Return false
	MOVEM	S1,WLDJFN		;Save state change flags
NXTIN1:	$CALL	GETFDB			;Read FDB and Get byte size
	MOVX	S1,OF%RD		;Get read access bit for open
	MOVEM	S1,OPNFLG		;Save for open
	MOVE	S1,WLDJFN		;Return wild JFN and flags
	HRROI	S2,NAMFSP		;Point to full filespec
	$RETT
SUBTTL	SETOUT	Setup for local file output

;Accepts	AP/ Address of D$FUNC argment block

;Returns	S1/ Local JFN
;		S2/ Pointer to expanded filespec

SETOUT:	MOVEI	S1,JFNBLK		;Point to JFN block
	MOVX	S2,GJ%FOU		;File is for output
	MOVEM	S2,.GJGEN(S1)		;Save the flags
	MOVE	S2,.DFLFS(AP)		;Get pointer to local file spec
	GTJFN				;Find the file
	 ERJMP	TERCVT
	SKIPE	S2			;[143]IF FILENAME SPECIFIED
	JRST	[LDB S2,S2		;[143]GET THE DELIMITER BYTE
		SKIPN S2		;[143]NULL?
		JRST .+1		;[143]YES, ITS OK
		MOVEI S2,GJFX4		;[143]NO, ERROR IN FILE NAME
		JRST TERCV0]		;[143]
	MOVEM	S1,LOCJFN		;Save the JFN
	$CALL	GETDEV			;Get device attributes
	 $RETIF				;Return if this fails
	TXNN	S2,DV%OUT		;Can device do output?
	 PJRST	DEVERR			;No..then fail
	$CALL	GETFDB			;Get the FDB info
	MOVX	S1,OF%WR		;Get write access bit for open
	MOVEM	S1,OPNFLG		;Save for Open
	MOVE	S1,LOCJFN		;Return the JFN
	HRROI	S2,NAMFSP		;Point to full filespec
	$RETT
SUBTTL	OPNFIL	Routine to open the local file


OPNFIL:	HRRZ	S1,LOCJFN		;Get local JFN
	MOVE	S2,OPNFLG		;Get our flags
	OPENF				;Open the file
	 ERJMP	TERCVT			;Return the error
	SETZM	BUFFUL			;[142]
	SETZM	LINFLG			;[150]
	SETZM	PAGBP			;[130]ZERO THE PMAP VARIABLES
	SETZM	PAGNUM			;[130]...
	SETZM	PFBSIZ			;[130]...
	SETZM	PAG1			;[130]...
	SETZM	PAGMEM			;[151]
	SETZM	LINNUM			;[130]...
	MOVEI	S2,1			;[130]INTIAL PAGFLG
	LOAD	S1,LOCDEV,DV%TYP	;[130]GET DEVICE TYPE
	CAIE	S1,.DVDSK		;[130]A DISK?
	$RETT				;[130]NO
	MOVEM	S2,PAGFLG		;[130]YES
	MOVE	S1,OPNFLG		;[130]GET FLAGS
	TXNE	S1,OF%WR		;[130]WRITTING THE FILE?
	$RETT				;[130]YES, DON'T COMPUTE EOF COUNT
	HRRZ	S1,LOCJFN		;[130]GET THE JFN
	MOVE	S2,[1,,.FBBYV]		;[130]GET THE file's BYTE SIZE
	PUSH	P,T1			;[130]
	PUSH	P,T2			;[130]
	MOVEI	T1,T2			;[130]
	GTFDB				;[130]
	LSH	T2,-^D24		;[130]
	ANDI	T2,77			;[130]
OPNFI0:	MOVE	T1,OPNFLG		;[152][130]GET BYTE SIZE USED IN OPENF
	LSH	T1,-^D30		;[130]
	CAIN	T1,^D36			;[130]36 BIT BYTE READ?
	CAIE	T2,^D18			;[130]BUT 18 BIT BYTES?
	SKIPA				;[130]
	JRST	[MOVEI T2,0		;[130]YES, SET THE FLAG
		JRST OPNFI1]		;[130]AND CONTINUE
	IDIV	T2,T1			;[130]COMPUTE BYTES PER FILE BYTE
	SKIPG	T2			;[130]BAD BYTE SIZE?
	JRST	[MOVE T2,REMOST		;[152]SYSTEM TYPE
		CAIE T2,.OSTP20		;[152]NO WARNING FOR TOPS20 NODES
		$WARN (Byte size of local file is unusable - 7 assumed) ;[152]
		MOVEI T2,^D7		;[152]ASSUME 7 BIT BYTES
		JRST OPNFI1]		;[152] [166]
OPNFI1:	PUSH	P,T2			;[130]
	MOVE	S2,[1,,.FBSIZ]		;[130]
	MOVEI	T1,T2			;[130]
	GTFDB				;[130]GET FILES BYTE COUNT
	POP	P,T1			;[130]
	SKIPN	T1			;[130]36/18?
	JRST	[MOVE T1,T2		;[130]
		SETZ T2,		;[130]
		LSHC T1,-1		;[130]DIVIDE BY 2
		SKIPE T2		;[130]REMAINDER?
		ADDI T1,1		;[130]YES
		JRST OPNFI2]		;[130]
	IMUL	T1,T2			;[130]
OPNFI2:	MOVEM	T1,EOFCNT		;[130]REAL NUMBER OF BYTES IN FILE
	POP	P,T2			;[130]
	POP	P,T1			;[130]
	$RETT				;Return success
SUBTTL	CLSFIL	Routine to close local file and update FDB

CLSFIL:	$SAVE	<P1>			;[137]
	MOVE	P1,S1			;[137]SAVE THE DELETE ON CLOSE FLAG
	LOAD	S1,LOCDEV,DV%TYP	;Get device type
	MOVE	S2,OPNFLG		;Get file open flags
	TXNE	S2,OF%RD		;[130]READING THE FILE?
	SKIPG	PAGFLG			;[130]AND USING PMAPS TO DO IT?
	SKIPA				;[130]NO
	$CALL	UNMAP			;[130]YES, UNMAP THE FILE PAGE
	 $RETIF				;[147]FAIL IF ERROR IN UNMAP
	CAIN	S1,.DVDSK		;Is it disk?
	TXNN	S2,OF%WR		; and writing file?
	PJRST	CLSINP			;No..just close it
	SKIPLE	MCYIDX			;Yes..Residual MACY11 byte?
	$CALL	OUTMCD			;Yes..write last word
	SKIPGE	PAGFLG			;[130]TOPS-20 PAGE MODE
	JRST	CLSFI0			;[130]YES, DON'T DO THIS
	MOVE	S1,PAGBP		;[130]CURRENT PAGE BYTE POINTER
	ADDI	S1,1000			;[130]
	CAMN	S1,PAG1			;[130]IS THIS PAGE EMPTY?
	JRST	CLSFIN			;[130]YES
	SKIPN	PAG1			;[130]NULL FILE?
	JRST	CLSFIN			;[130]YES
	MOVE	T1,PAGBP		;[164]Save original byte pointer
	$CALL	PAGOUT			;[130]NO, OUTPUT THE PARTIAL PAGE
	 JUMPF	TERCVT			;[130]
	MOVEM	T1,PAGBP		;[164]Restore original byte pointer
CLSFIN:	MOVE	T1,PFBSIZ		;[130]
	MOVEM	T1,.FBSIZ+ATTFDB	;[130]THE BYTE COUNT
	MOVE	T1,OPNFLG		;[130]
	LSH	T1,-6			;[130]
	AND	T1,[7700,,0]		;[130]
	MOVEM	T1,.FBBYV+ATTFDB	;[130]BYTE SIZE
CLSFI0:	MOVX	S1,CO%NRJ		;Don't release JFN
	HRR	S1,LOCJFN
	CLOSF				;Close the file
	 ERJMP	TERCVT
	MOVX	S1,CF%NUD+<.FBCRV>B17	;Get offset
	MOVX	S2,FWMASK		;set all bits to change
	SKIPE	T1,.FBCRV+ATTFDB	;Get creation date/time
	$CALL	CHNGFD			;Change the FDB
	MOVX	S1,CF%NUD+<.FBWRT>B17	;Get the offset
	SKIPE	T1,.FBWRT+ATTFDB	;Get last update date/time
	$CALL	CHNGFD			;Change the FDB
;	MOVX	S1,CF%NUD+<.FBPRT>B17	;Get the offset
;	MOVX	S2,FP%SLF+FP%GRP+FP%WLD	;Get protection mask
;	SKIPE	T1,.FBPRT+ATTFDB	;Get file protection
;	$CALL	CHNGFD			;Change the FDB
	MOVX	S1,CF%NUD+<.FBSIZ>B17	;Get offset for bytecount word
	MOVX	S2,FWMASK		;CHANGE ALL BITS
	SKIPE	T1,.FBSIZ+ATTFDB	;Get file byte count
	$CALL	CHNGFD			;CHANGE THE FDB
	MOVX	S1,CF%NUD+<.FBBYV>B17	;Get offset for bytesize
	MOVX	S2,FB%BSZ		;Change bytesize
	SKIPE	T1,.FBBYV+ATTFDB	;Get file bytesize
	$CALL	CHNGFD			;CHANGE THE FDB
	SKIPL	PAGFLG			;Recieve entire FDB?
	JRST	CLSFI1			;No..don't update remaining info
	MOVX	S1,CF%NUD+<.FBCTL>B17	;Yes..update remaining INFO
	MOVX	S2,FB%FCF		;Get mask for countrol word
	SKIPE	T1,.FBCTL+ATTFDB
	$CALL	CHNGFD
	MOVX	S1,CF%NUD+<.FBBYV>B17	;Update mode and bytesize
	MOVX	S2,FB%BSZ+FB%MOD
	SKIPE	T1,.FBBYV+ATTFDB
	$CALL	CHNGFD
	MOVX	S1,CF%NUD+<.FBCRE>B17	;Update creation date if possible
	MOVX	S2,FWMASK
	SKIPE	T1,.FBCRE+ATTFDB
	$CALL	CHNGFD
	MOVX	S1,CF%NUD+<.FBREF>B17	;Update last reference
	MOVX	S2,FWMASK
	SKIPE	T1,.FBREF+ATTFDB
	$CALL	CHNGFD
;	MOVX	S1,CF%NUD+<.FBCNT>B17	;Update access counts if possible
;	MOVX	S2,FWMASK
;	SKIPE	T1,.FBCNT+ATTFDB
;	$CALL	CHNGFD
	MOVX	S1,CF%NUD+<.FBUSW>B17	;Update user settable word
	MOVX	S2,FWMASK
	SKIPE	T1,.FBUSW+ATTFDB
	$CALL	CHNGFD
CLSFI1:	HRRZ	S1,LOCJFN		;Get file JFN
	SKIPN	S2,LGAPTR		;[160]Use current account if NFT
	MOVE	S2,.DOACT+LLOPNB	;Point to files account
	SACTF				;SET FILE'S ACCOUNT DESIGNATOR
	 ERJMP	CLSFI2			;[137]Failed..Release JFN
	HRLI	S1,.SFAUT		;SET THE AUTHOR STRING
	SKIPE	S2,.FBAUT+ATTFDB	;[160]Author specified?
	JRST	CLSFI3			;[160]Yes, use it
	SKIPN	S2,LGUPTR		;[160]Use username if we are NFT
	MOVE	S2,.DOUSR+LLOPNB	;Pickup pointer to user string
CLSFI3:	SFUST				;[160]DO IT
	 ERJMP	CLSFI2			;[137]Failed..Release JFN
	HRLI	S1,.SFLWR		;SET LAST WRITER
	SKIPN	S2,LGUPTR		;[160]Use username if we are NFT
	MOVE	S2,.DOUSR+LLOPNB	;Pickup pointer to user string
	SFUST				;DO IT
	 ERJMP	CLSFI2			;[137]Failed..Release JFN
CLSFI2:	SKIPLE	PAGFLG			;[164]TOPS-20 Page mode?
	SKIPN	S1,PAGBP		;[164]Did we ever allocate a page?
	JRST	CLSFI4			;[164]No, skip the following
	LSH	S1,-11			;[164]Shift to prepare for
	ANDI	S1,777			;[164]The page number
	$CALL	M%RELP			;[164]Release the page
	SETZM	PAGBP			;[164]Zero the page pointer
CLSFI4:	SKIPN	P1			;[137]DELETE THE FILE?
	PJRST	RELJFN			;Release output JFN
	PJRST	DELFIL			;[137]YES

UNMAP:	$SAVE <S1,S2>			;[130]
	SKIPN	S2,PAGMEM		;[151][130]DID WE MAP A PAGE?
	$RETT				;[130]NO
	SETZM	PAGMEM			;[151]
	HRREI	S1,-1			;[130]YES, UNMAP IT
	HRLI	S2,.FHSLF		;[130]PROCESS ID
	SETZ	T1,			;[130]
	PMAP				;[130]
	 ERJMP TERCVT			;[130]
	$RETT				;[130]
SUBTTL	CLSINP	Routine to close input file

CLSINP:	SKIPG	PAGFLG			;[130]
	JRST	CLSIN1			;[130]
	MOVE	S1,PAGBP		;[130]
	JUMPE	S1,CLSIN1		;[130]NEVER ALLOCATED A PAGE
	LSH	S1,-11			;[130]
	ANDI	S1,777			;[130]THE PAGE NUMBER
	$CALL	M%RELP			;[130]RELEASE THE PAGE
	SETZM	PAGBP			;[151]
CLSIN1:	SKIPN	P1			;[137]DELETE THE FILE?
	JRST	CLSIN2			;[137]NO
	HRRZ	S1,LOCJFN		;[137]
	TXO	S1,DF%NRJ		;[137]
	SETZ	S2,			;[137]
	DELF				;[137]
	 ERJMP	TERCVT			;[137]
CLSIN2:	HRRZ	S1,LOCJFN		;[157]Close file, keep JFN
	TXO	S1,CO%NRJ		;[157]
	CLOSF%				;[157]
	 ERJMP	TERCVT			;[157]

	MOVE	S1,LOCJFN		;[157]Input JFN wild?
	TXZE	S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER	;[157]
	 $RETT				;[157]
	RLJFN%				;[157]No wildcards, Release JFN
	 ERJMP	TERCVT			;[157]
	SETZM	LOCJFN			;[157]Show we don't own it anymore
	$RETT				;[157]

SUBTTL	DELFIL	Routine to delete the local file

DELFIL:	HRRZ	S1,LOCJFN		;Get the local JFN
	TXO	S1,DF%NRJ		;Don't release JFN
	SETZ	S2,			;Default number of generations
	DELF				;Delete it
	 ERJMP	TERCVT			;Convert the error and return
	PJRST	RLNJFN			;Release JFN if not wild

SUBTTL	ABTFIL	Routine to abort local file operation

ABTFIL:	$CALL	UNMAP			;[151]UNMAP MAPPED FILE PAGE
	MOVE	S1,PAGBP		;[151]
	JUMPE	S1,ABTFI1		;[151]DID WE ALLOCATE A PAGE?
	LSH	S1,-11			;[151]YES
	ANDI	S1,777			;[151]
	$CALL	M%RELP			;[151]RELEASE THE PAGE
	SETZM	PAGBP			;[151]
ABTFI1:	HRRZ	S1,LOCJFN		;[151]GET JFN FOR LOCAL FILE
	TXO	S1,CZ%ABT!CO%NRJ	;ABORT OPERATIONS
	CLOSF				;AND CLOSE THE FILE
	 ERJMP	TERCVT			;Return failure
RLNJFN:	MOVE	S1,LOCJFN		;Get local JFN
	TXNE	S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
	$RETT				;Don't release wild JFN
RELJFN:	HRRZ	S1,LOCJFN		;Get file JFN
	RLJFN				;Release it
	 ERJMP	[CAIE	S1,DESX3	;JFN not assigned?
		 PJRST	TERCVT		;No..return failure
		 JRST	.+1]		;Return in line
	SETZM	LOCJFN			;Clear file JFN
	SETZM	WLDJFN			;Clear wild JFN
	$RETT

SUBTTL	CHNGFD	Routine to change a field in output files FDB

;Accepts	S1/ Offset to FDB location,,0
;		S2/ Mask for requested bits
;		T1/ Requested bits

CHNGFD:	HRR	S1,LOCJFN		;Get file JFN
	CHFDB				;Change FDB per S1-T1
	 ERJMP	.RETF			;Pass back failure
	$RETT				;Return success
SUBTTL	EOFCHK	Routine to check for EOF in local file

;Returns TRUE	We are at EOF
;	 FALSE	Some other file error occured

EOFCHK:	SKIPE	PAGFLG			;[130]PMAPS?
	JRST	EOFCH1			;[130]YES
	$CALL	TERCVT			;Get the last error code
	CAXE	S1,FLD(ER$TRN,ER%MAC)+FLD(ER$EOF,ER%MIC)	;EOF?
	 $RETF				;No..give bad return
	TXO	S,S%EOF			;Yes..set EOF flag
EOFCH1:	TXNE	S,S%EOF			;[130]
	$RETT				;[130]
	$RETF				;[130]

SUBTTL	INPBYT	Routine to read a byte from file

;Returns TRUE	S1/ Next byte in File
;	 FALSE	    Byte not available

INPBYT:	SKIPE	MCYIDX			;MACY11 mode?
	JRST	INPMCY			;Yes..get a byte
INPBYM:	SKIPN	PAGFLG			;[130]NON DISK DEVICE?
	JRST	[HRRZ S1,LOCJFN		;[130]YES
		BIN			;[130]
		 ERJMP TERCVT		;[130]
		MOVE S1,S2		;[130]
		SETZ S2,		;[130]
		$RETT]			;[130]
	MOVE	S1,EOFCNT		;[130]EOF BYTE COUNT
	CAMN	S1,PFBSIZ		;[130]EOF?
	JRST	[MOVEI S2,IOX4		;[130]EOF STATUS
		TXO S,S%EOF		;[130]
		JRST TERCV0]		;[130]SIMULATE IT
	SKIPE	PAGBP			;[130]FIRST TIME HERE?
	JRST	INPBY1			;[130]
	$CALL	PAGIN			;[130]YES
	 JUMPF [$RET]			;[130]
INPBY1:	MOVE	S1,PAGBP		;[130]CURRENT BYTE POINTER
	CAME	S1,PAG1			;[130]AT END OF PAGE?
	JRST	INPBY2			;[130]
	$CALL	PAGINN			;[130]GET NEXT PAGE
	 JUMPF [$RET]			;[130]
INPBY2:	ILDB	S1,PAGBP		;[130]GET NEXT BYTE
	AOS	PFBSIZ			;[130]INCREMENT BYTE COUNT
	HRRZ	S2,PAGBP		;[130]ADR OF WORD WITH BYTE
	MOVE	S2,0(S2)		;[130]WORD WITH BYTE
	ANDI	S2,1			;[130]ISOLATE LIN NUM FLAG
	EXCH	S2,LINNUM		;[130]SAVE IT
	CAIN	S2,1			;[130]IS THIS THE TAB...
	CAIE	S1,"	"		;[130]AFTER A LINE NUM?
	JRST	[MOVE S2,LINNUM		;[130]NO
		$RETT]			;[130]
	MOVEI	S2,1			;[130]YES
	$RETT

PAGIN:	$CALL	M%NXPG			;[130]GET A NON EXISTANT PAGE
	LSH	S1,11			;[130]CONVERT TO AN ADDRESS
	MOVE	S2,OPNFLG		;[130]OPEN FLAGS
	LSH	S2,-6			;[130]BYTE SIZE
	AND	S2,[7700,,0]		;[130]ISLOATE IT
	ADD	S1,S2			;[130]
	IOR	S1,[440000,,0]		;[130]
	ADDI	S1,1000			;[130]
	IBP	0,S1			;[130]POINT AT FIRST BYTE
	HRREI	S2,-1			;[130]
	ADJBP	S2,S1			;[130]
	MOVEM	S2,PAGBP		;[130]
	MOVEM	S2,PAG1			;[130]MARKER FOR END OF PAGE

PAGINN:	$SAVE	<T1>			;[130]SAVE T1
	MOVE	S1,PAGNUM		;[130]FILE PAGE NUMBER
	AOS	PAGNUM			;[130]SET UP FOR NEXT PAGE
	HRL	S1,LOCJFN		;[130]FILES JFN
	RPACS				;[130]
	 ERJMP	TERCVT			;[130]
	TXNN	S2,PA%PEX			;[130]PAGE EXISTS?
	 JRST [ MOVEI S2,IOX4		;[130][170] No.
		TXO S,S%EOF		;[170] simulate
		JRST TERCV0]		;[130] eof.
	MOVE	S2,PAGBP		;[130]GET BYTE POINTER
	SUBI	S2,1000			;[130]SET UP NEW POINTER
	MOVEM	S2,PAGBP		;[130]
	LSH	S2,-11			;[130]
	ANDI	S2,777			;[130]PAGE NUMBER
	ADDI	S2,1			;[130]
	MOVEM	S2,PAGMEM		;[151]
	HRLI	S2,.FHSLF		;[130]TO THIS PROCESS
	MOVX	T1,PM%RD+PM%PLD		;[130]PRELOAD THE PAGE
	PMAP				;[130]
	 ERJMP TERCVT			;[130]AN ERROR?
	$RETT				;[130]

INPMCY:	AOSN	S2,MCYIDX		;Increment byte index
	JRST	INPMC1			;Read first word of file
	CAIGE	S2,5			;Time for a new word?
	JRST	INPMC2			;No..just return the byte
INPMC1:	HRRZ	S1,LOCJFN		;Yes..get a file word
	$CALL	INPBYM			;[130]
	 JUMPF	[$RET]			;[130]
	MOVEM	S1,MCYDAT		;[130]Save the word
	MOVEI	S2,1			;Index begins at 1 for byte 1
	MOVEM	S2,MCYIDX		;Save for next pass
INPMC2:	LDB	S1,MCYTBL-1(S2)
	$RETT


MCYTBL:	POINT	8,MCYDAT,17		;MACY11 byte 1
	POINT	8,MCYDAT,9		;MACY11 byte 2
	POINT	8,MCYDAT,35		;MACY11 byte 3
	POINT	8,MCYDAT,27		;MACY11 byte 4
SUBTTL	OUTBYT	Routine to write a byte to file

;Accepts	S1/ Byte to write to file

;Returns TRUE	S1/ Byte that was written
;	 FALSE	    Byte could not be written

OUTBYT:	SKIPE	MCYIDX			;MACY11 mode?
	 JRST	OUTMCY			;Yes..bumble it!
OUTBYM:	SKIPN	PAGFLG			;[130]DISK DEVICE?
	JRST	[MOVE S2,S1		;[130]NO
		MOVE S1,LOCJFN		;[130]
		BOUT			;[130]
		 ERJMP TERCVT		;[130]
		MOVE S1,S2		;[130]
		$RETT]			;[130]
	SKIPN	PAGBP			;[130]DOES THE PAGE EXIST?
	$CALL	NEWPAG			;[130]NO, MAKE A NEW ONE
	IDPB	S1,PAGBP		;[130]OUTPUT THE BYTE
	AOS	PFBSIZ			;[130]INCREMENT THE BYTE COUNT
	MOVE	S1,PAGBP		;[130]GET THE CURRENT POINTER
	CAME	S1,PAG1			;[130]IS THE PAGE FULL?
	$RETT				;[130]
	$CALL	PAGOUT			;[130]YES
	 JUMPF [$RET]			;[130]
	$RETT

NEWPAG:	$SAVE <S1>			;[130]
	$CALL	M%NXPG			;[130]GET A NON EXISTANT PAGE
	LSH	S1,11			;[130]MAKE IT AN ADDRESS
	MOVE	S2,OPNFLG		;[130]
	LSH	S2,-6			;[130]
	AND	S2,[7700,,0]		;[130]
	ADD	S2,S1			;[130]THE BYTE POINTER
	OR	S2,[440000,,00]		;[130]
	MOVEM	S2,PAGBP		;[130]
	IBP	0,S2			;[130]
	HRREI	S1,-1			;[130]
	ADJBP	S1,S2			;[130]
	ADDI	S1,1000			;[130]
	MOVEM	S1,PAG1			;[130]MARKER TO FIND END OF PAGE
	$RETT				;[130]

PAGOUT:	$SAVE <T1>			;[130]
	HRRZ	S1,PAGBP		;[130]THE PAGE BYTE POINTER
	LSH	S1,-11			;[130]
	ANDI	S1,777			;[130]THE PROCESS PAGE NUMBER
	HRLI	S1,.FHSLF		;[130]PROCESS HANDLE
	HRL	S2,LOCJFN		;[130]JFN OF THE FILE
	HRR	S2,PAGNUM		;[130]
	AOS	PAGNUM			;[130]
	MOVX	T1,PM%WR+PM%RD+PM%EX	;[130]PROPER ACCESS BITS
	PMAP				;[130]
	 ERJMP TERCVT			;[130]ERROR?
	MOVE	S1,PAGBP		;[130]
	SUBI	S1,1000			;[130]
	MOVEM	S1,PAGBP		;[130]
	$RETT				;[130]

OUTMCY:	AOSN	S2,MCYIDX		;Bump the byte index
	 AOS	S2,MCYIDX		;Once more for first word
	CAIGE	S2,5			;Ready to write word?
	JRST	OUTMC1			;No..just store the byte
OUTMCD:	PUSH	P,S1			;Yes..save our byte
	MOVE	S1,MCYDAT		;[130]Get our last word
	$CALL	OUTBYM			;[130]
	 JUMPF	[POP P,S1		;[130]
		$RET]			;[130]
	POP	P,S1			;Retrieve our byte
	SETZM	MCYDAT			;Clear our last word
	MOVEI	S2,1			;Index begins at 1
	MOVEM	S2,MCYIDX
OUTMC1:	DPB	S1,MCYTBL-1(S2)		;Store the byte
	$RETT


ALNMCY:	MOVEI	TF,1			;Get a bit
	TDNE	TF,MCYIDX		;Even byte boundry?
	AOS	MCYIDX			;No..Align it
	$RETT
SUBTTL	GETFDB	Routine to read local file FDB and other info

GETFDB:	HRROI	S1,NAMFSP		;Point to filespec storage
	HRRZ	S2,LOCJFN		;Expand this file name
	MOVX	T1,FFSPEC		;Dev:<directory>name.ext.gen
	JFNS
	 ERJMP	TERCVT			;Convert error and return
GETFDD:	HRRZ	S1,LOCJFN		;Get JFN
	HRLZI	S2,.FBLEN		;Read all words form FDB
	MOVEI	T1,LOCFDB		; into local copy
	GTFDB
	 ERJMP	[MOVEI S1,.FBLEN	;Get length of FDB
		 MOVEI	S2,LOCFDB	;Point to it
		 $CALL	.ZCHNK		;Clear it
		 JRST	GETFD1]		;Just return
GETFD1:	MOVE	S2,REMOST		;[110]GET SYSTEM TYPE
	CAIN	S2,.OSTP20		;[110]TOPS20?
	$RETT				;[110]YES
	MOVEI S2,7			;[110]DEFAULT BYTE SIZE IS 7
	LOAD S1,.FBBYV+LOCFDB,FB%BSZ	;[110]GET BYTE SIZE
	SKIPN S1			;[110]ZERO BYTE SIZE?
	STORE S2,.FBBYV+LOCFDB,FB%BSZ	;[110]YES, USE DEFAULT
	$RETT
SUBTTL	GETDEV	Routine to get device attributes

;Accepts	LOCJFN setup by SETINP or SETOUT

;Returns TRUE	S1/ DAP device word (Also stored in ATTDEV)
;		S2/ Local device characteristics word

;	 FALSE	S1/ DAP unsupported device error

GETDEV:	HRRZ	S1,LOCJFN		;Get device JFN
	DVCHR				;Read device characteristics
	 ERJMP	DEVERR			;Return unsupported device
	MOVEM	S2,LOCDEV		;Save device word
	TXNN	S2,DV%AV		;Available?
	 PJRST	DEVERR			;No..return an error
	MOVX	S1,FB$AVL		;Device must be available
	TXNE	S2,DV%OUT		;Capable of output?
	TXO	S1,FB$ODV		;Yes..
	TXNE	S2,DV%IN		;Capable of input?
	TXO	S1,FB$IDV		;Yes..
	TXNE	S2,DV%DIR		;Have a directory?
	TXO	S1,FB$SDI		;Yes..assume single for now
	TXNE	S2,DV%MDD		;Multiple directories
	TXO	S1,FB$MDI		;Yes..
	TXNE	S2,DV%ASN		;Assigned?
	TXO	S1,FB$ALL		;Yes..
	TXNE	S2,DV%MNT		;Mounted?
	TXO	S1,FB$MNT		;Yes..
	ANDX	S2,DV%TYP		;Issolate device type
	MOVEI	T1,DEVTBL		;Point to devices
GETDE1:	SKIPN	T2,0(T1)		;Get table entry
	 JRST	DEVERR			;Unsupported device
	HRR	S2,T2			;Setup for equallity
	CAME	S2,T2			;Does it match?
	AOJA	T1,GETDE1		;No..try the next
	IOR	S1,(T2)			;Yes..set the bits
	MOVEM	S1,ATTDEV		;Save device attributes
	MOVE	S2,LOCDEV		;Return local device char word
	$RETT

DEVERR:	$STATUS	ER$FIL,ER$DEV		;Bad device
	$RETF


DEVTBL:	.DVDSK,,[FB$MDI+FB$SHR+FB$RAD]	;Disk
	.DVLPT,,[FB$REC+FB$SQD+FB$SPL]	;Line printer
	.DVCDP,,[FB$REC+FB$SQD+FB$SPL]	;Card punch
	.DVPLT,,[FB$REC+FB$SQD+FB$SPL]	;Plotter
	.DVMTA,,[FB$FOD+FB$SQD]		;Magtape
	.DVTTY,,[FB$TRM+FB$SQD]		;Terminal
	.DVCDR,,[FB$REC+FB$SQD]		;Card reader
	.DVNUL,,[FB$NUL]		;Null device
	 EXP 0				;Terminate list
SUBTTL	SETATT	Set attributes from switches

;SETATT	is called to setup the attributes message per S1

;Accepts	S1/ Mode to setup in attributes
;		S2/ extra file attributes and Max record size


;Returns with
;		ATTMNU with appropriate bits set
;		ATTDAT with appropriate datatype
;		ATTRFM with appropriate record format
;		ATTRAT with appropriate record attributes
;		ATTMRS with calling value

SETATT:	MOVX	T2,AT$DAT+AT$RFM+AT$RAT+AT$MRS
	ANDCAM	T2,ATTMNU		;Clear the Menu bits
	LOAD	T1,S2,DF%MRS		;Get maximum record size
	MOVEM	T1,ATTMRS		;Save it
	MOVE	S1,MODTB1(S1)		;Get attributes per mode
	LOAD	T1,S1,DF%DAT		;Get Data type
	MOVEM	T1,ATTDAT		;Save it
	LOAD	T1,S1,DF%RFM		;Get record format
	MOVEM	T1,ATTRFM		;Save it
	CAIN	T1,FB$UDF		;Undefined record format?
	TXZ	T2,AT$MRS		;Yes..clear the MRS menu bit
	LOAD	T1,S1,DF%RAT		;Get record attributes
	MOVEM	T1,ATTRAT		;Save it
	IORM	T2,ATTMNU		;Set the menu bits
	$RETT
SUBTTL	SWLOOK	Lookup user switches and convert to DAP attriubtes

;Accepts	S1/ Data type - record format - record attributes

;Returns	S1/ Data mode implied by switches

SWLOOK:	ANDX	S1,DF%DAT+DF%RFM+DF%RAT	;Keep interesting bits
	MOVSI	S2,-MOD$LN		;Get length of the table
	JUMPE	S1,SWLOO3		;Establish default mode
	TXNE	S1,FLD(DT$IMA+DT$ASC,DF%DAT) ;Datatype specified?
	 JRST	SWLOO1			;Yes..see what we have
	TXNN	S1,FLD(FB$MCY,DF%RAT)	;No..Was MACY11 specified?
	 TXO 	S1,FLD(DT$IMA,DF%DAT)	;No..Datatype is image
SWLOO1:	CAMN	S1,MODTBL(S2)		;Match an entry?
	JRST	SWLOO3			;Yes..finish up
	AOBJN	S2,SWLOO1		;No..try the next
	$RETF				;Return a failure

SWLOO3:	HRRZ	S1,S2			;Return mode in S1
	$RETT

SUBTTL CHKMOD	Routine to check for legal input to output mode


CHKMOD:	SKIPE	S1,SRCMOD		;Unspecified source?
	SKIPN	S2,DSTMOD		;Unspecified destination?
	 $RETT				;Yes..can't check it yet!
	MOVNS	S2			;Get right shift value for mode
	MOVX	T1,1B0			;Get the bit for Mode (0)
	LSH	T1,0(S2)		;Get the bit for dest mode
	TDNN	T1,MODTBO(S1)		;Valid for source mode?
	 $RETF				;No..return the error
	$RETT
SUBTTL  [125] PICMOD - Pick default file mode by system type

PICMOD:	MOVE	S1,REMOST		;GET REMOTE HOST TYPE
	CAIL	S1,PMTLEN		;[155]IN RANGE OF TABLE?
	SETZ	S1,			;[155]NO, SO PICK SOME DEFAULT
	MOVE	S1,PMTAB(S1)		;GET DEF MODE FOR THAT HOST
	$RETT				;RETURN

PMTAB:	.MD8				; 0. ?
	.MD8				; 1. RT
	.MD8				; 2. RSTS
	.MD10				; 3. RSX11S
	.MD10				; 4. RSX11M
	.MD10				; 5. RSX11D
	.MD10				; 6. IAS
	.MD10				; 7. VMS
	.MD8				; 8. TOPS-20
	.MD8				; 9. TOPS-10
	.MD8				;10. RT-8
	.MD8				;11. OS-8
	.MD10				;12. RSX11M-PLUS
	PMTLEN=.-PMTAB			;[155]
SUBTTL File mode table definitions

;Define a macro to generate table entries

DEFINE XX (MOD,RFM<0>,RAT<0>) <
	FLD(MOD,DF%DAT)+FLD(RFM,DF%RFM)+FLD(RAT,DF%RAT)>

;Define a macro to generate a bit mask

DEFINE XB (BIT) <
	ZZ==0
   IRP <BIT>,<ZZ==ZZ!1B<BIT>>
	EXP ZZ>

;Define a macro to generate default mode word

DEFINE XM (MODES) <
	BYTE (4) MODES>

	.MD1==^D1			;/IMAGE
	.MD2==^D2			;/IMAGE/FIXED
	.MD3==^D3			;/IMAGE/VARIABLE
	.MD4==^D4			;/IMAGE/MACY
	.MD5==^D5			;/MACY
	.MD6==^D6			;/MACY/FIXED
	.MD7==^D7			;/MACY/VARIABLE
	.MD8==^D8			;/ASCII
	.MD9==^D9			;/ASCII/FIXED
	.MD10==^D10			;/ASCII/VARIABLE
	.MD11==^D11			;Print file format
	.MD12==^D12			;Fortran format


;Table of valid calling switches

MODTBL:	XX 0				;Mode(0) unspecified
	XX DT$IMA			;Mode(1) /IMAGE
	XX DT$IMA,FB$FIX		;Mode(2) /IMAGE/FIXED
	XX DT$IMA,FB$VAR		;Mode(3) /IMAGE/VARIABLE
	XX DT$IMA,  0   ,FB$MCY		;Mode(4) /IMAGE/MACY11
	XX   0   ,  0   ,FB$MCY		;Mode(5) /MACY11
	XX   0   ,FB$FIX,FB$MCY		;Mode(6) /MACY11/FIXED
	XX   0   ,FB$VAR,FB$MCY		;Mode(7) /MACY11/VARIABLE
	XX DT$ASC			;Mode(8) /ASCII
	XX DT$ASC,FB$FIX		;Mode(9) /ASCII/FIXED
	XX DT$ASC,FB$VAR		;Mode(10) /ASCII/VARIABLE
	XX -1				;Mode(11) Cant be specified
	XX -1				;Mode(12) Can't be specified

	MOD$LN==.-MODTBL		;Compute length

;Table of valid output modes per input mode

MODTBO:	0
	XB <.MD1>
	XB <.MD1,.MD2,.MD6>
	XB <.MD3,.MD5,.MD7>
	XB <.MD1,.MD4>
	XB <.MD3,.MD5,.MD7>
	XB <.MD1,.MD2,.MD4,.MD6>
	XB <.MD3,.MD5,.MD7>
	XB <.MD8,.MD10>
	XB <.MD8,.MD9>
	XB <.MD8,.MD10>
	XB <.MD8>
	XB <.MD8>

;Table for DAP equivalent attributes

MODTB1:	XX DT$IMA,FB$UDF		;unspecified
	XX DT$IMA,FB$UDF		;/IMAGE
	XX DT$IMA,FB$FIX		;/IMAGE/FIXED
	XX DT$IMA,FB$VAR		;/IMAGE/VARIABLE
	XX DT$IMA,FB$UDF,FB$MCY		;/IMAGE/MACY11
	XX DT$IMA,FB$STM,FB$MCY		;/MACY (Dos Binary)
	XX DT$IMA,FB$FIX,FB$MCY		;/MACY11/FIXED
	XX DT$IMA,FB$VAR,FB$MCY		;/MACY11/VARIABLE
	XX DT$ASC,FB$STM		;/ASCII
	XX DT$ASC,FB$FIX,FB$CR		;/ASCII/FIXED
	XX DT$ASC,FB$VAR,FB$CR		;/ASCII/VARIABLE
	XX DT$ASC,FB$VFC,FB$PRN		;Print format is read only
	XX DT$ASC,FB$VFC,FB$FTN		;Fortran format is read only

;Table of default output modes per source mode

MODTB2:	0
	XM <.MD1>			;/IMAGE (TO) /IMAGE
	XM <.MD2>			;/IMAGE/FIX (TO) /IMAGE/FIX
	XM <.MD3>			;/IMAGE/VAR (TO) /IMAGE/VAR
	XM <.MD1>			;/IMAGE/MAC (TO) /IMAGE
	XM <.MD3>			;/MACY (TO) /IMAGE/VAR
	XM <.MD2>			;/MACY/FIX (TO) /IMAGE/FIX
	XM <.MD3>			;/MACY/VAR (TO) /IMAGE/VAR
	XM <0,.MD8,.MD10>		;[125] PICK DEF BY SYSTEM TYPE
	XM <0,.MD8,.MD10>		;[125] PICK DEF BY SYSTEM TYPE
	XM <0,.MD8,.MD10>		;[125] PICK DEF BY SYSTEM TYPE
	XM <.MD11>			;Print file to ascii stream
	XM <.MD12>			;Fortran file to ascii stream

;Table of processor addresses for various modes

MODTB3:	0
	XWD GETIMG,PUTIMG		;/IMAGE
	XWD GETIMG,PUTIMG		;/IMAGE/FIXED
	XWD GETIMG,PUTIMG		;/IMAGE/VARIABLE
	XWD GETIMG,PUTIMG		;/MACY/IMAGE
	XWD GETDOS,PUTDOS		;/MACY
	XWD GETIMG,PUTIMG		;/MACY/FIXED
	XWD GETIMG,PUTIMG		;/MACY/VARIABLE
	XWD GETASC,PUTASC		;/ASCII
	XWD GETASC,PUTASC		;/ASCII/FIXED
	XWD GETASC,PUTASC		;/ASCII/VARIABLE
	XWD GETASC,[PJRST .RETT]	;PRN format is read only
	XWD GETASC,[PJRST .RETT]	;FTN format is read only

;Table of valid file bytesizes for mode

MODTB4:	0
	EXP -1				;1 to 36 for IMAGE
	EXP -1
	EXP -1
	XB <18,0>			;18 or 36 for MACY
	XB <18,0>
	XB <18,0>
	XB <18,0>
	XB <7,8,0>			;7 8 or 36 for ASCII
	XB <7,8,0>
	XB <7,8,0>
	XB <7>				;7 for print format
	XB <7>				;7 for fortran format

;Table of file open bytesize for mode

MODTB5:	0
	EXP 0				;Actual file bytesize for IMAGE
	EXP 0
	EXP 0
	EXP ^D36			;36 for /MACY
	EXP ^D36
	EXP ^D36
	EXP ^D36
	EXP ^D7				;7 for ASCII
	EXP ^D7				;7 for ASCII FIXED
	EXP ^D7				;7 for ASCII VARIABLE
	EXP ^D7				;7 for print format
	EXP ^D7				;7 for fortran format

;Table of attributes bytesize for mode

MODTB6:	0
	EXP 0				;Actual file bytesize for IMAGE
	EXP 0
	EXP 0
	EXP ^D8				;8 bit bytes for MACY11
	EXP ^D8
	EXP ^D8
	EXP ^D8
	EXP ^D8				;8 bit bytes for ASCII
	EXP ^D8
	EXP ^D8
	EXP ^D8				;8 bit bytes for print format
	EXP ^D8				;8 bit bytes for fortran format

;Table of valid modes for FAL file create

MODTB7:	0
	EXP -1				;Image undefined Ok for FAL
	0
	0
	EXP -1				;Macy11 Ok for FAL
	EXP -1
	EXP -1
	EXP -1
	EXP -1				;Ascii stream Ok for FAL
	0
	0				;Can't create print files
	0				;Can't create print format
	0				;Can't create fortran format
SUBTTL	ATLOOK	Routine to lookup attributes

;ATLOOK	is called after recieving an attributes message to return
;	the data mode implied by the message and also the default
;	output mode.

;Returns TRUE	S1/ Source mode implied by attributes
;		S2/ Default output mode implied by source mode

;	 FALSE	S1/ Unsupported data type

ATLOOK:	MOVE	S1,ATTDAT		;Get data mode of attributes
	STORE	S1,S2,DF%DAT		;Store in proper field
	MOVE	S1,ATTRFM		;Get record format of attributes
	STORE	S1,S2,DF%RFM		;Store in proper field
	MOVE	S1,ATTRAT		;Get record attributes
	TXZ	S1,FB$BLK+FB$EBF	;[125]IGNORE BLOCKING&IMBED CC
	STORE	S1,S2,DF%RAT		;Store in proper field
	ANDX	S2,DF%DAT+DF%RFM+DF%RAT	;Keep interesting fields
	TXZ	S2,FLD(DT$EXE+DT$EXP+DT$SEN+100+,DF%DAT) ;ignored bits
	MOVSI	S1,-AT$$LN		;Get count of valid entries
ATLOO1:	CAMN	S2,ATTTBL(S1)		;Entry match?
	JRST	ATLOO2			;Yes..process it
	AOBJN	S1,ATLOO1		;No..try the next
	$MUERR	.DMATT,21		;Not found..return unsupported

ATLOO2:	HRRZ	S2,ATTMOD(S1)		;Get default output mode
	HLRZ	S1,ATTMOD(S1)		;Get implied source mode
	$RETT				;Return success
SUBTTL	Attributes list

ATTTBL:	XX	DT$ASC,FB$STM		;Stream ascii
	XX	DT$ASC,FB$UDF		;Undefined ascii
	XX	DT$ASC,FB$STM,FB$EBF	;Stream ascii
	XX	DT$IMA,FB$UDF		;Undefined image
	XX	DT$IMA,FB$UDF,FB$MCY	;Macy image
	XX	DT$IMA,FB$FIX,FB$MCY	;Macy Fixed
	XX	DT$IMA,FB$VAR,FB$MCY	;Macy variable
	XX	DT$IMA,FB$STM,FB$MCY	;Macy stream (Assembler)
	XX	DT$ASC,FB$FIX		;Fixed ascii
	XX	DT$ASC,FB$FIX,FB$CR	;Fixed ascii
	XX	DT$ASC,FB$FIX,FB$EBF	;Fixed ascii
	XX	DT$ASC,FB$VAR		;Variable ascii
	XX	DT$ASC,FB$VAR,FB$CR	;Variable ascii
	XX	DT$ASC,FB$VAR,FB$EBF	;Variable ascii
	XX	DT$IMA,FB$FIX		;Fixed image
	XX	DT$IMA,FB$VAR		;Variable image
	XX	DT$IMA,FB$FIX,FB$CR	;Fixed image [ascii]
	XX	DT$IMA,FB$VAR,FB$CR	;Variable image [ascii]
	XX	DT$IMA,FB$VFC,FB$PRN	;Print file format
	XX	DT$IMA,FB$VFC,FB$CR	;Sos file format
	XX	DT$ASC,FB$VFC,FB$PRN	;Ascii print
	XX	DT$ASC,FB$VFC,FB$CR	;Ascii Sos
	XX	DT$IMA,FB$VFC,FB$FTN	;Fortran files
	XX	DT$ASC,FB$VFC,FB$FTN
	XX	DT$ASC,FB$VAR,FB$FTN	;[126]
	XX	DT$IMA,FB$VAR,FB$FTN	;[126]
	XX	DT$IMA,FB$FIX,FB$FTN	;[126]
	XX	DT$ASC,FB$FIX,FB$FTN	;[126]
	XX	DT$IMA,FB$STM		;Ascii stream from RSTS
	XX	DT$IMA,FB$STM,FB$CR	;[125]another RSTS oddity
	XX	DT$ASC,FB$STM,FB$CR	;[126]VMS STREAM FILES
	XX	DT$ASC,FB$VFC		;[125]
	XX	DT$IMA,FB$VFC		;[125]
		AT$$LN==.-ATTTBL	;Number of valid attributes

ATTMOD:	XWD	.MD8,.MD8		;Stream ascii (to) Stream ascii
	XWD	.MD8,.MD8		;Undefined ascii (to) Stream ascii
	XWD	.MD8,.MD8		;Stream ascii (to) Stream ascii
	XWD	.MD1,.MD1		;Undefined image (to) Undefined image
	XWD	.MD4,.MD4		;Macy image (to) Macy image
	XWD	.MD6,.MD6		;Macy fixed (to) Macy fixed
	XWD	.MD7,.MD7		;Macy variable (to) Macy variable
	XWD	.MD5,.MD5		;Macy stream (to) Macy stream
	XWD	.MD9,.MD8		;Fixed ascii (to) Stream ascii
	XWD	.MD9,.MD8		;Fixed ascii (to) Stream ascii
	XWD	.MD9,.MD8		;Fixed ascii (to) Stream ascii
	XWD	.MD10,.MD8		;Variable ascii (to) Stream ascii
	XWD	.MD10,.MD8		;Variable ascii (to) Stream ascii
	XWD	.MD10,.MD8		;Variable ascii (to) Stream ascii
	XWD	.MD2,.MD2		;Fixed image (to) Fixed image
	XWD	.MD3,.MD3		;Variable image (to) Variable image
	XWD	.MD9,.MD8		;Fixed image [ascii] (to) stream ascii
	XWD	.MD10,.MD8		;Variable image [ascii] (to) Strm ascii
	XWD	.MD11,.MD8		;Print format to stream ascii
	XWD	.MD10,.MD8		;Sos to stream ascii
	XWD	.MD11,.MD8		;Print format to stream ascii
	XWD	.MD10,.MD8		;Sos to stream ascii
	XWD	.MD12,.MD8		;Fortran files
	XWD	.MD12,.MD8		;Fortran files
	XWD	.MD10,.MD8		;[126]
	XWD	.MD10,.MD8		;[126]
	XWD	.MD10,.MD8		;[126]
	XWD	.MD10,.MD8		;[126]
	XWD	.MD8,.MD8
	XWD	.MD8,.MD8		;[125]
	XWD	.MD8,.MD8		;[126]VMS STREAM
	XWD	.MD10,.MD8		;[125]
	XWD	.MD10,.MD8		;[125]
SUBTTL	SETMOD	Routine to setup processor address and bytesizes

;SETMOD	is called after SETINP or SETOUT to establish proper mode

;Returns TRUE	S1/ mode
;		S2/ Attributes bytesize


SETMOD:	MOVE	S1,OPNFLG		;Get file open flags
	TXNN	S1,OF%RD		;Reading the file?
	 JRST	[MOVE T1,DSTMOD		;Get destination mode
		 JRST SETMO2]		;Setup per destination
	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ	;Yes..get file BSZ
	MOVX	S2,1B0			;Get a bit to test
	SKIPN	T1,SRCMOD		;Get the source mode
	 JRST	[MOVEI T1,.MD1		;Assume image mode
		 CAIN S1,^D7		;Unless bytesize is 7
		 MOVEI T1,.MD8		;which means ascii
		 MOVEM T1,SRCMOD	;Remember it
		 JRST .+1]		;Continue
	CAIN	S1,^D36			;Bytesize = 36?
	JRST	SETMO1			;Yes..test with bit 0
	MOVNS	S1			;Get -bytesize
	LSH	S2,0(S1)		;Shift to proper bit
SETMO1:	TDNN	S2,MODTB4(T1)		;OK for this mode?
	 $MIERR	.DMATT,36		;No..bad bytesize
SETMO2:	SKIPN	S1,MODTB5(T1)		;Get open BSZ
	LOAD	S1,.FBBYV+LOCFDB,FB%BSZ	;Use file BSZ
	SKIPN	S2,MODTB6(T1)		;Get BSZ for attributes
	MOVE	S2,S1			;Use file open BSZ
	STORE	S1,OPNFLG,OF%BSZ	;Save for open
	MOVE	T2,MODTB3(T1)		;Get processor dispatch
	MOVEM	T2,DATDAT
	MOVE	T2,MODTB1(T1)		;Get DAP attributes
	SETZM	MCYIDX			;Clear MACY flag
	TXNE	T2,FLD(FB$MCY,DF%RAT)	;Unless wanted
	SETOM	MCYIDX
	MOVE	S1,T1			;Return mode in S1
	$RETT
SUBTTL	TYPSTS	Routine to expand DAP status codes

;Accepts	S1/ Status code
;		S2/ Extended status
;		T1/ Output designator

;		T1/ Updated designator

TYPSTS:	$SAVE	<S1,S2,P1,P2,P3,P4>	;Preserve some AC's
	MOVE	P1,T1			;Save output designator
	LOAD	P2,S1,ER%MAC		;Get MACODE
	LOAD	P3,S1,ER%MIC		;Get MICODE
	SKIPE	P4,S2			;Save extended status
	 JRST	[CAIL	P4,.ERBAS	;Check for valid error codes
		 CAILE	P4,.ERBAS+.ERMAX
		 JRST .+1		;Invalid code for our system
		 MOVE S1,P1		;Get output designator
		 HRROI S2,[ASCIZ//]	;No text
		 MOVEI T1,[ITEXT<^E/P4/>]	;Only our error
		 JRST TYPST8]		;Display it
	MOVSI	S2,-MIC$LN		;Get length of table
	CAIN	P2,ER$USP		;Unsupported status error?
	 JRST	TYPST1			;Yes..do actual lookup
	CAIL	P2,ER$FMT		;Format, Invalid, or SYNC error?
	CAILE	P2,ER$SNC		;...
	 ANDX	S1,ER%MIC		;No..do generic lookup
TYPST1:	HRRZ	T1,MICTBL(S2)		;Get the status code
	CAMN	S1,T1			;Match what we have?
	 JRST	TYPST2			;Yes..display it
	AOBJN	S2,TYPST1		;No..check the next
	CAIN	P2,ER$USP		;Unsupported status error?
	 JRST	TYPST3			;Yes..do name lookup
	CAIL	P2,ER$FMT		;Format, Invalid, or SYNC error?
	CAILE	P2,ER$SNC		;...
	SKIPA	S1,P1			;No..get output designator
	JRST	TYPST3			;Yes..do name lookup
	JRST	TYPST7			;Display per ITEXT

TYPST2:	MOVE	S1,P1			;Get output designator
	HLRO	S2,MICTBL(S2)		;Get pointer to string
	SETZ	T1,			;No ITEXT
	JRST	TYPST8			;Store the status
TYPST3:	MOVSI	S2,-MSG$LN		;Get number of message types
	MOVE	S1,P3			;Get MICODE
	CAIE	P2,ER$SNC		;SYNC error?
	LSH	S1,-6			;No..get message type
TYPST4:	HLRZ	T1,MSGTBL(S2)		;Get Message type
	CAMN	S1,T1			;Match what we have?
	JRST	TYPST5			;Yes..get the name
	AOBJN	S2,TYPST4		;No..try the next
	HRROI	T1,[ASCIZ/Unknown/]
	JRST	TYPST6
TYPST5:	HRRZ	S2,MSGTBL(S2)		;Get Message descriptor
	HRRO	T1,0(S2)		;Get pointer to name
TYPST6:	EXCH	P1,T1			;Put pointer in P1
	MOVE	S1,T1			;Put output designator in S1
TYPST7:	HRROI	S2,[ASCIZ//]		;Null string
	MOVE	T1,MACTBL(P2)		;Get proper ITEXT to expand
TYPST8:	SETZ	T2,			;Get null prefix character
	$CALL	TYPER			;Display the string
	HRROI	S2,[ASCIZ //]		;[113]
	MOVEI	T1,[ITEXT < (MAC:^O/P2/ MIC:^O/P3/ STV:^O/P4/)>]	;[113]
	SETZ	T2,			;[113]
	$CALL	TYPER			;[113] APPEND (MAC:MIC:EXTEND)
	MOVE	T1,S1			;Return designator in T1
	$RETT
SUBTTL	TERCVT	Routine to convert TOPS20 error code to dap status

;Returns	S1/ Dap status code
;		S2/ Last TOPS20 error code

TERCVT:	$CALL	GETTER			;Get last JSYS error in S2
TERCV0:	MOVE	T1,[IOWD S20DLN,S20DAP+1]	;Point to table
TERCV1:	HLRZ	S1,(T1)			;GET TOPS-20 ERROR FROM TABLE
	CAMN	S1,S2			;MATCHING ENTRY?
	JRST	TERCVF			;YES!
	AOBJN	T1,TERCV1		;NO MATCH - LOOP BACK FOR NEXT
	TDZA	S1,S1			;Return unspecified error
TERCVF:	HRRZ	S1,(T1)			;GET CORRESPONDING DAP STATUS
	MOVX	T1,ER$FIL		;Assume file open error
	TXNN	S,S%GET+S%PUT+S%EOF	;Is it?
	JRST	TERCV2			;yes
	MOVX	T1,ER$TRN		;No..Assume transfer error
	TXNE	S,S%EOF			;Is it?
	MOVX	T1,ER$TRM		;Termination error
TERCV2:	STORE	T1,S1,ER%MAC		;STUFF MACCODE INTO DAP STATUS
	TXO	S,S%JERR		;[127]FLAG A JSYS ERROR
	$RETF				;Return calling failure
SUBTTL	LLGJFN	Routine to get JFN for logical link

SUBTTL	LLGJFN	Get a JFN for logical link
;Accepts	CP/ Base of per link info
;		AP/ Base of calling argument block

;Returns TRUE	Link has a JFN

LLGJFN:	MOVE	T2,.DOFLG(AP)		;GET ARGUMENT BLOCK FLAGS
	MOVE	T4,[-DCNSIZ,,DCNPFX+1]	;ASSUME DCN
	TXNE	T2,DO%SRV		; UNLESS WE WANT TO BE A SERVER
	JRST	[$CALL ENABLE		;YES..MAKE SURE WE ARE WHEEL
		 MOVE T4,[-SRVSIZ,,SRVPFX+1]	;DEVICE IS SRV:
		 JRST LLGJF0]		;CONTINUE ON.
	SETZM	MESIN			;[134]
	SETZM	MESOUT			;[134]
	SKIPN	PMRFLG			;[121]DOING POOR MAN'S ROUTING?
	JRST LLGJF0			;[121]NO.
;[171]	MOVEI	S1,.NDVFY		;[121]
;[171]	MOVEI	S2,T1			;[121]
;[171]	MOVE	T1,.DONOD(AP)		;[121]POINTER TO HOST NAME
;[171]	SETZ	T2,			;[121]
;[171]	NODE				;[121]
;[171]	TXNE	T2,ND%EXM		;[121]EXACT MATCH?
;[171]	JRST	[MOVEI S1,1		;[121]
;[171]		MOVEM S1,PMRFLG		;[121]
;[171]		JRST LLGJF0]		;[121]YES, DON'T DO PMR
	MOVE	S1,.DONOD(AP)		;[121]POINTER TO HOST NAME
	MOVEM	S1,CONBLK+DN.HST	;[121]SAVE IT
	MOVEI	S1,^D17			;[121]FAL OBJECT TYPE
	MOVEM	S1,CONBLK+DN.ROB	;[121]SAVE IT
	MOVEI	S1,^D8			;[121]BYTE SIZE
	MOVEM	S1,CONBLK+DN.BSZ	;[121]SAVE IT
	MOVE	S1,[POINT 7,MSGTXT]	;[121]
	MOVE	S2,.DOPSW(AP)		;[121]POINTER TO PASSWORD
	SETZB	T1,T2			;[121]
	$CALL	QSOUT			;[121] COPY STRING AND QUOTE
	HRROI	S1,MSGTXT		;[121] POINTER TO TEMP PASSWORD
	MOVEM	S1,CONBLK+DN.PWD	;[121]
	MOVE	S1,[POINT 7,MSGTXT+12]	;[121]
	MOVE	S2,.DOACT(AP)		;[121]POINTER TO ACCOUNT NUMBER
	$CALL	QSOUT			;[121]
	HRROI	S1,MSGTXT+12		;[121]
	MOVEM	S1,CONBLK+DN.ACN	;[121]
	MOVE	S1,[POINT 7,MSGTXT+24]	;[121]
	MOVE	S2,.DOUSR(AP)		;[121]POINTER TO USERID
	$CALL	QSOUT			;[121]
	HRROI	S1,MSGTXT+24		;[121]
	MOVEM	S1,CONBLK+DN.USR	;[121]
	MOVEI	S1,.PRIOU		;[121]
	MOVEM	S1,CONBLK+DN.WRN	;[121]
	MOVEM	S1,CONBLK+DN.INF	;[121]
	MOVEM	S1,CONBLK+DN.ERR	;[121]
	SETZ	S2,			;[121]
	MOVE	S1,REMOST		;[121]
	CAIN	S1,.OSTP20		;[121]
	SETO	S2,			;[121]
	MOVEI	S1,CONBLK		;[121]
	$CALL	.DNCON##		;[121]
	 JRST FATAL			;[121]
	JRST	LLGJF3			;[121]
LLGJF0:	HRRZ	T3,-1(T4)		;GET OFFSET TO FIRST POINTER
	ADDI	T3,(AP)			;GET ACTUAL ADDRESS
	HRROI	S1,LLNAME		;POINT TO NAME AREA
LLGJF1:	MOVX	T1,177B6		;Get first character mask
	SKIPE	T2,(T3)			;IS THIS field present
	TDNN	T1,(T2)			; AND NOT NULL?
	JRST	LLGJF2			;NO..SKIP IT
	MOVE	S2,(T4)			;YES..DO PREFIX
	SETZ	T1,
	SOUT
	MOVE	S2,T2			;DO THE FIELD
	$CALL	QSOUT			;COPY STRING
LLGJF2:	AOJ	T3,			;NEXT FIELD
	AOBJN	T4,LLGJF1		;DO ALL PRESENT

	MOVX	S1,GJ%NEW+GJ%SHT	;MUST NOT EXIST
	HRROI	S2,LLNAME		;POINT TO FILESPEC
	GTJFN				;GO GET THE JFN
	 $FATAL	(Can't get JFN for logical link - ,^E/[-2]/)
LLGJF3:	MOVEM	S1,LLJFN		;SAVE THE JFN
	HRROI	S1,LLNAME		;POINT TO NAME STRING STORAGE
	HRRZ	S2,LLJFN		;GET LL JFN
	MOVX	T1,FFSPEC		;Full file spec
	JFNS				;SAVE OFF FULL FILESPEC STRING
	$DEBUG <Network JFN Established, >,<^T/LLNAME/>
	$RETT
DCNPFX:	DCNSIZ,,.DONOD			;SIZE,,FIRST OFFSET
	TXT(DCN:)			;PREFIX FOR NODE
	TXT(-)				;PREFIX FOR OBJECT
	TXT(-)				;PREFIX FOR DISCRIPTOR
	TXT(.)				;PREFIX FOR TASKNAME
	TXT(;USERID:)			;PREFIX FOR USERID
	TXT(;PASSWORD:)			;PREFIX FOR PASSWORD
	TXT(;CHARGE:)			;PREFIX FOR ACCOUNT
	TXT(;DATA:)			;PREFIX FOR DATA
	DCNSIZ==.-DCNPFX-1		;SIZE OF TABLE

SRVPFX:	SRVSIZ,,.DOOBJ			;SIZE,,FIRST OFFSET
	TXT(SRV:)			;PREFIX FOR OBJECT
	TXT(-)				;PREFIX FOR DESCRIPTOR
	TXT(.)				;PREFIX FOR TASKNAME
	SRVSIZ==.-SRVPFX-1		;SIZE OF TABLE

SUBTTL	QSOUT	move asciz string and quote if required

QSOUT:	$SAVE	<T1,T2>
	TLCE	S2,-1
	TLCN	S2,-1
	 HRLI	S2,(POINT 7,0)
QSOUT1:	ILDB	T1,S2			;Get source byte
	SKIPN	T2,T1			;Put byte in T2
	JRST	QSOUT3			;Finished on null
	CAIL	T1,"0"			;Check numeric
	CAILE	T1,"9"
	 TRZA	T2,40			;Make upper case
	JRST	QSOUT2			;Numeric..store it
	CAIL	T2,"A"			;Check alpha
	CAILE	T2,"Z"
	 SKIPA	T2,[EXP "V"-100]	;Get quote character
	JRST	QSOUT2			;Alpha..store it
	CAIE	T1,"."			;Allow period
	CAIN	T1,"-"			;Allow hyphen
	JRST	QSOUT2			;Store it
	IDPB	T2,S1
QSOUT2:	IDPB	T1,S1			;Store the character
	JRST	QSOUT1			;Back for more

QSOUT3:	MOVE	T2,S1			;Get dest pointer
	IDPB	T1,T2			;Store null terminator
	$RETT				;Return

CPYSTR:	SETZM	T1			;Terminate on null
	SOUT
	$RETT
SUBTTL	LLOPEN	Routine to OPEN logical link

;LLOPEN		Opens NETWORK JFN for DCN: or SRV:
;Accepts	CP/ Base of per link data
;		AP/ Base of D$OPEN argument block

;Returns TRUE	LINK is open and attatched to interrupt system
;	 	Although not necessarily connected

LLOPEN:	$DEBUG <Attempting to Open Logical link>
	SKIPL	PMRFLG			;[121]
	JRST	LLOPN0			;[121]
	MOVE	S1,.DOFLG(AP)		;[121]
	TXNN	S1,DO%SRV		;[121]A SERVER?
	 JRST LLOPN1			;[121]NO, LINK ALREADY OPEN
LLOPN0:	MOVE	S1,LLJFN		;GET JFN OF LL TO OPEN
	MOVE	S2,[FLD(^D8,OF%BSZ)+OF%RD+OF%WR]
	OPENF				;TRY TO OPEN LINK
	 ERJMP	LLOPN5			;RELEASE JFN AND RETURN
LLOPN1:	MOVE	S1,LLJFN		;GET JFN AGAIN
	MOVEI	S2,.MORTN		;GET TASK NAME FOR THIS LL
	SKIPE	T1,.DOTSK(AP)		;POINT TO TASK NAME
	MTOPR				;DO MTOPR
	 ERJMP	LLOPN4
	MOVEI	S2,.MORLS		;[140]
	MTOPR				;[140]
	 ERJMP	LLOPN4			;[140]
	MOVEM	T1,LLSTAT		;[140]SAVE CURRENT NETWORK STATUS
	MOVEI	S2,.MOACN		;ENABLE FOR CONNECT INTERRUPTS
	MOVE	T1,.DOPSI(AP)		;GET PSI FLAGS
	MOVX	T4,DO%PSI		;GET PSI FLAG
	TDNE	T4,.DOFLG(AP)		;Want to be on PSI?
	MTOPR				;yes..do MTOPR
	 ERJMP	LLOPN4
	$STATE	.LLCFG			;Say link is waiting on Config
	MOVE	S2,.DOTSK(AP)		;Get task pointer
	$RETT				;RETURN SUCCESS

;HERE WHEN LINK CAN'T BE OPENED
LLOPN4:	MOVE	S1,LLJFN		;GET THE JFN
	TXO	S1,CZ%ABT		;ABORT IT
	CLOSF
	 ERJMP	.+1
LLOPN5:	SETZB	S,LLJFN			;MARK NOT OPENED
	 $FATAL	(Can't open logical link - ,^E/[-2]/)
SUBTTL	LLWCON	ROUTINE TO WAIT FOR LINK TO BE CONNECTED

;RETURN TRUE		S1/ Link status from MTOPR

LLWCON:	MOVEI	T4,^D30			;Wait for 30 CCTIME intervals
LLWC1:	$CALL	LLCHK			;CHECK LL STATUS
	 JUMPF	LLWC3			;Find out why we aborted
	TXNE	S1,MO%CON		;LINK CONNECTED?
	$RETT				;Yes..give good return
	TXNE	S1,MO%SYN		;LINK CLOSED OUT BY OTHER END?
	 JRST	LLWC3			;Yes..Find out why
	TXNE	S1,MO%SRV		;IS THIS A SERVER?
	JRST	LLWC4			;Yes..wait for interrupt
	SOJG	T4,LLWC2		;Tried enough?
	$CALL	DIABT			;Cancel the link
	$FATAL	(Remote node is not responding)

LLWC4:	TDZA	S1,S1			;Sleep for ever
LLWC2:	MOVEI	S1,CCTIME		;NO..GET WAIT TIME
	$CALL	I%SLP			;AND SNOOZE
	JRST	LLWC1			;TRY AGAIN

;HERE WHEN LINK IS ABORTED
LLWC3:	SKIPE	LLJFN			;Still have a JFN?
	$CALL	DIABT			;Yes..respond to abort
	HRRZ	S1,LLSTAT		;Get last status
	CAIE	S1,.DCX34		;Was it bad password?
	CAIN	S1,.DCX36		;Or bad account?
	$FATAL	(Remote node refused connection - ,^T/LLDISC/)
	$FATAL	(Logical link was aborted during initial connection - ,^T/LLDISC/)
SUBTTL	LLCHK	Routine to check logical link status

;Accepts	CP/ Base of per link data

;Returns TRUE	S1/	Link status - link is active
;	 FALSE	S1/	Link status - link is aborted

LLCHK:	$SAVE	<T1>
	SETZM	INTHAP			;[154]RESET INTERRUPT HAPPENED FLAG
	MOVE	S1,LLJFN		;Get link JFN
	MOVEI	S2,.MORLS		;READ LINK STATUS
	MOVE	T1,LLSTAT		;Return last status on failure
	MTOPR
	 ERJMP	[TXO T1,MO%ABT		;Say Abort status
		 JRST LLCHK1]		;Back in line
	MOVEM	T1,LLSTAT		;Save latest status
	SIBE				;Is there something to read?
	SETOM	MSGFLG			;Yes..remember that
LLCHK1:	MOVE	S1,T1			;Put MTOPR status in S1
	TXNE	S1,MO%ABT		;Link aborted?
	 $RETF				;Return false
	$RETT				;No..return true
SUBTTL	LLCLOS	Routine to close or abort a logical link


;Accepts	S1/ NSP disconnect code
;		S2/ Pointer to optional data to be sent

LLCLOS:	SKIPN	LLJFN			;Is link open?
	 $FATAL	(Logical link is not open in LLCLOS)
	DMOVEM	S1,CLSBLK		;Save our reason
	SETZB	T1,T2			;Clear pointer and length
	JUMPE	S2,LLCLS2		;Optional data?
	TLCE	S2,-1			;Yes..make a real pointer
	TLCN	S2,-1
	 HRLI	S2,(POINT 7)		;Ready to count the bytes
	MOVE	T1,S2			;Save pointer for MTOPR
LLCLS1:	ILDB	S1,S2			;Get the bytes
	JUMPE	S1,LLCLS2		;Do the MTOPR
	AOJA	T2,LLCLS1		;Count until null
	CAILE	T2,^D16			;Enforce max of 16
	MOVEI	T2,^D16
LLCLS2:	HRLZ	S2,CLSBLK		;Put abort code in place
;	SKIPN	S2			;[145]
;	HRLZI	S2,7			;[145]ALWAYS USE NON ZERO ABORT CODE
	HRRI	S2,.MOCLZ		;Get the close function
	MOVE	S1,LLJFN		;Get the JFN
	MTOPR
	 ERJMP	LLCLS3			;Abort if MTOPR fails
	TLNN	S2,-1			;[120]Did we abort link?
	JRST	LLCLS4			;[120]NO
LLCLS3:	MOVE	S1,LLJFN		;[120]GET THE JFN
	TXO	S1,CZ%ABT		;[120]Set bit for close
	CLOSF				;[120]
	 $FATAL (Can't abort close logical link in LLCLOS - ,^E/[-2]/)
	SETZB	S,LLJFN			;[120]
	$RETT				;[120]
LLCLS4:	MOVE	S1,LLJFN		;Pick up JFN
	CLOSF
	 JRST LLCLS3			;[120]
	SETZB	S,LLJFN			;Clear JFN word
	$RETT
SUBTTL	LLRCD	Read Connect-initiate Disconnect initiate data

SUBTTL	LLRCD	ROUTINE TO READ INFORMATION FROM CI/DI MESSAGES
;Accepts	CP/ Base of per link data

;Returns TRUE	Data via pointers in LLOPNB

LLRCD:	MOVE	S1,LLJFN		;GET LINK JFN
	MOVSI	T4,-CDISIZ		;GET NUMBER OF REQUESTS
LLRCD1:	HLRZ	S2,CDITBL(T4)		;GET FUNCTION
	HRRZ	T1,CDITBL(T4)		;GET OFFSET TO ENTRY
	ADDI	T1,LLOPNB		;GET ACTUAL ADDRESS OF POINTER
	SKIPN	T1,(T1)			;NULL POINTER?
	 JRST	LLRCD2			;YES..ON TO NEXT FUNCTION
	TLCE	T1,-1
	TLCN	T1,-1			;REAL BYTE POINTER?
	 HRLI	T1,(POINT 7,0)		;NO..MAKE IT ASCII
	MTOPR				;NO..DO IT
	 ERJMP	.+1			;IGNORE ERRORS
	SETZ	S2,			;GET A NULL
	IDPB	S2,T1			;TERMINATE WITH NULL
LLRCD2:	AOBJN	T4,LLRCD1		;BACK TO READ ALL ITEMS
	MOVEM	T2,.DOUIC+LLOPNB	;SAVE UIC IF ANY

	MOVEI	S2,.MORSS		;READ SEGMENT SIZE
	SETZM	T1
	MTOPR
	 ERJMP	.+1			;IGNORE ERRORS
	MOVEM	T1,.DOSSZ+LLOPNB	;SAVE SEGMENT SIZE

	MOVEI	S2,.MORCN		;READ CONNECTED OBJECT
	SETZ	T1,
	MTOPR
	 ERJMP	.+1			;IGNORE ERRORS
	STORE	T1,.DOFLG+LLOPNB,DO%OBJ ;SAVE ACCESS OBJECT TYPE
	$RETT				;ALL DONE, RETURN


CDITBL:	.MORHN,,.DONOD			;READ REMOTE HOST NAME
	.MORTN,,.DOTSK			;READ TASK NAME
	.MORUS,,.DOUSR			;READ USER
	.MORPW,,.DOPSW			;READ PASSWORD
	.MORAC,,.DOACT			;READ ACCOUNT
	.MORDA,,.DOOPD			;READ DATA
					;*** .MORDA MUST BE LAST ***
	.MOROD,,.DODSC			;READ OBJECT-DESCRIPTOR
	CDISIZ==.-CDITBL		;SIZE
SUBTTL	STOSTS	Routine to store link status

;Accepts	S1/ Output designator
;		S2/ Link status code

;Returns TRUE	Reason code is stored
;	 FALSE	Invalid reason code

STOSTS:	HRRZ	S2,S2			;PUT STATUS CODE IN S2
	SETZ	T1,			;SET FOR SOUT AGAIN
	CAILE	S2,DSCMAX		;KNOWN REASON?
	$RETF				;NO..JUST RETURN
	HRRO	S2,DSCTBL(S2)		;POINT TO DISCONNECT TEXT
	SOUT
	$RETT
SUBTTL	LLSEND	Routine to send messages across Link

;Accepts	S2/ Header address of message to be sent

;Returns TRUE	Message has been sent
;	 FALSE	Part of the message remains to be sent

LLSEND:	$SAVE	<P1>			;Save an AC
	MOVE	P1,S2			;Remember address of message
	$CALL	LLSDSP			;Display debugging info
	MOVE	S1,LLJFN		;Get link JFN
	MOVE	S2,.DPBPT(P1)		;Get the byte pointer
	MOVN	T1,.DPCNT(P1)		;Get byte count
	MOVE	T2,[SOUTR]		;Assume end of message
	SKIPLE	.DPLEN(P1)		;More to come?
	MOVE	T2,[SOUT]		;Yes..send partial message
	SETOM	SNDFLG			;Say we are about to send
	AOSE	INTFLG			;Any interrupts?
	XCT	T2			;No..send the message
	 ERJMP	LLSENE			;Die on failure
	CAME	T2,[SOUTR]		;[134]
	JRST	LLSE25			;[134]
	SKIPE	INTFLG			;[134]
	AOS	MESOUT			;[134]
LLSE25:	SETZM	SNDFLG			;[134]Not sending any more!
	JUMPN	T1,LLSEN3		;Were we interrupted?
	$RETT				;No..return normally

LLSEN3:	MOVEM	S2,.DPBPT(P1)		;Save updated pointer
	MOVNM	T1,.DPCNT(P1)		;Zero if not interrupted
	SKIPL	.DPTYP(P1)		;Virgin message?
	MOVNS	.DPTYP(P1)		;No..mark as interrupted
	$RETF				;Return to our caller

LLSENE:	MOVE S1,LLJFN			;[0113]
	MOVEI S2,.MORLS			;[0113]
	MTOPR				;[0113]
	HRRZ S2,T1			;[0113]
	HRRO T1,DSCTBL(S2)		;[0113]
	CAILE	S2,DSCMAX		;[113]ABORT REASON OUT OF RANGE?
	HRROI	T1,[ASCIZ /Abort code out of range/] ;[113]
	$FATAL (,<Logical link transmission error - ^E/[-2]/^M^JLogical link abort reason(^D/S2/) - ^Q/T1/>)

LLSDSP:	SKIPE	MSGDSG			;Want send data displayed?
	SKIPG	S1,.DPTYP(S2)		;Already displayed?
	$RETT
	HRRZ	S1,MSGTBL-1(S1)		;Make pointer to message name
	HRRO	S1,0(S1)
	$DEBUG	(Sending ,<^Q/S1/ message (Flg=^O/.DPFLG(S2)/ Cnt=^O/.DPCNT(S2)/ Rem=^O/.DPLEN(S2)/)>)
	$RETT
SUBTTL	LLRECV	Routine to receive link messages

;Returns TRUE	S1/ Address of message header

;	 FALSE	No message is available


LLRECV:	MOVE	S1,RCVLST		;Point to recieve list
	$CALL	L%FIRST			;Point to first entry
	JUMPF	[SETZM	MSGFLG		;Assume nothing available
		 $CALL	LLCHK		;See if we are right
		 TXNE	S1,MO%EOM	;Full message available?
		JRST [$CALL LLRECM	;[154]YES, GO RECEIVE IT
			JRST LLRECV]	;[154]
		 $RETF]			;No..return with nothing
	MOVE	T2,S2			;Save message address
	SETOM	MSGFLG			;Remember we have a message
	$CALL	LLCHK			;See if we have a full message
	TXNE	S1,MO%EOM
	JRST	[$CALL LLRECM		;[154]YES, GO RECEIVE IT
		JRST LLRECV]		;[154]
	MOVE	S1,T2			;No..return first entry in list
	$RETT

LLRECM:	MOVE	S1,RCVLST		;Get recieve list index
	MOVE	S2,OURSIZ		;Get size of a buffer
	$CALL	NEWBUF			;Allocate new buffer
	MOVE	T2,S1
	MOVE	S1,LLJFN
	MOVE	S2,.DPBPT(T2)		;Get pointer to buffer
	MOVN	T1,.DPCNT(T2)		;Get max count
	SINR				;Read a logical message
	 ERJMP	LLRECE			;Bad news
	AOS	MESIN			;[134]
	ADDB	T1,.DPCNT(T2)		;Save actual count
	MOVEM	T1,.DPLEN(T2)		;Save as length
	$CALL	LLRDSP			;Display what we have
	$RETT				;[154]

LLRECE:	$CALL	GETTER			;Get my last error
	CAIN	S2,IOX4			;End of file?
	$FATAL	(EOF detected on logical link)
	MOVE S1,LLJFN			;[0113]
	MOVEI S2,.MORLS			;[0113]
	MTOPR				;[0113]
	HRRZ S2,T1			;[0113]
	HRRO T1,DSCTBL(T1)		;[0113]
	CAILE S2,DSCMAX			;[113]
	HRROI T1,[ASCIZ /Abort code out of range/] ;[113]
	$FATAL (,<Logical link reception error - ^E/[-2]/^M^JLogical link abort reason(^D/S2/) - ^Q/T1/>)

LLRECA:	MOVE	S1,RCVLST		;[154]
	$CALL	L%FIRST			;[154]
	 JUMPF	[$CALL LLRECM		;[154]
		JRST LLRECA]		;[154]
	SETOM	MSGFLG			;[154]
	MOVE	S1,S2			;[154]
	$RETT				;[154]

LLRDSP:	SKIPN	MSGDSG			;Want send data displayed?
	$RETT
	MOVE	S2,.DPBPT(T2)		;Get the pointer
	ILDB	S1,S2			;Get the type field
	ILDB	S2,S2			;Get the flags
	HRRZ	S1,MSGTBL-1(S1)		;Make pointer to message name
	HRRO	S1,0(S1)
	$DEBUG	(Received ,<^Q/S1/ message segment (Flg=^O/S2/ Cnt=^O/T1/)>)
	$RETT
SUBTTL	NEWBUF	Routine to allocate a new buffer

;Accepts	S1/ Send or recieve list index
;		S2/ Required byte count of buffer

;Returns TRUE	S1/ Address of new message buffer header

NEWBUF:	DMOVE	T1,S1			;Save list index and count
	$CALL	L%LAST			;Position to end of list
	DMOVE	S1,T1			;Restore list index and count
	TRZE	S2,3			;Spare word needed?
	ADDI	S2,4			;Yes..account for it
	LSH	S2,-2			;Compute word count
	ADDI	S2,.DPSIZ		;Add header size
	$CALL	L%CENT			;Create an entry
	MOVE	S1,S2			;Return address in S1
	MOVEI	S2,.DPSIZ(S1)		;Point to message area
	HRLI	S2,(POINT 8)
	MOVEM	S2,.DPBPT(S1)		;Save in header
	MOVEM	T2,.DPCNT(S1)		;Save counts
	MOVEM	T2,.DPLEN(S1)		;Save length
	$RETT
SUBTTL	Connect	event interrupt service


;HERE ON CI RECEIVED
CICON:	$DEBUG	(Connect interrupt received) ;[140]
	MOVE	S1,LLSTAT		;[140]GET LINK STATUS
	TXNN	S1,MO%SRV		;AM I A SERVER?
	 $RETT				;NO - DONE
	$CALL	LLCHK			;Get the link status
	$CALL	LLRCD			;READ CONNECT DATA
FTACL <	SKIPE	S1,.DOACT+LLOPNB	;[167] Was account string ptr there ?
	JRST	[ILDB  S1,S1		;[167] Yes,,get first byte
		 JUMPN S1,.+1		;[167] Remote user specified,,continue
		 SETOM NOACCT		;[167] Not there,,set flag
		 JRST  .+1 ]  >		;[167] Continue
	MOVE	T1,.DOCID+LLOPNB	;Get address of check routine
	$CALL	0(T1)			;Access check the user
FTACL <	JUMPT	CICO.1			;[167] Succeed,,continue onward
	SKIPN	ACLPID	 		;[167] Is the access control task there
	JRST	LLCLOS			;[167] No,,abort the link
	PUSH	P,S1			;[167] Save S1 (NSP error code)
	PUSH	P,S2			;[167]  and S2 (Ptr to reason string)
	SETZM	S1			;[167] Yes,,ask ACL for permission
	PUSHJ	P,REQACL		;[167] to let this guy complete the link
	POP	P,S2			;[167] Restore S2
	POP	P,S1  >			;[167] Restore S1
	JUMPF	LLCLOS			;This guy just can't win !!!
FTACL <	SETOB	S1,S2  >		;[167] Indicate ACL said OK
CICO.1:	MOVEM	S1,USRNUM		;Save user number
	MOVEM	S2,DIRNUM		;Save directory number
	MOVE	S1,LLJFN		;GET JFN FOR LL
	MOVEI	S2,.MOCC		;ACCEPT THE CONNECTION
	SETZM	T2			;NO RETURN DATA
	MTOPR
	 ERJMP	.+1
	$CALL	LLCHK			;Get new link Status
	$RET				;Return True/false per LLCHK

;Here to respond to DI and store reason for disconnect

DIABT:	SKIPN	S1,LLJFN		;Have a JFN?
	JRST	DIAB1			;No..just store status
	MOVX	S2,.MORDA		;Yes..read optional data
	HRROI	T1,LLDISC		;Save disconnect cause
	MTOPR
	 ERJMP	DIAB1			;Oops..just store staus
	JUMPE	T2,DIAB1		;No data..just store status
	SETZ	S2,			;Get a null
	IDPB	S2,T1			;Terminate with a null
	CAIL	T2,7			;At least 7 characters?
	JRST	DIAB2			;yes..Ignore status

DIAB1:	HRROI	S1,LLDISC		;Point to disconnect cause
	MOVE	S2,LLSTAT		;Get last known status
	$CALL	STOSTS			;Store the status String
DIAB2:	MOVEI	S1,.DCX42		;Response to DI request
	SETZ	S2,			;No optional data
	PJRST	LLCLOS			;Close the link
SUBTTL	Interrupt message processing

PSIIM:	$WARN	(Unexpected interrupt message received) ;[140]
	MOVE	S1,LLJFN		;Get links jfn
	MOVEI	S2,.MORIM		;Read the message
	MOVEI	T1,.NULIO		;Can it for now
	MTOPR
	 ERJMP .RETF
	$RETT
SUBTTL	Table	of NSP disconnect reasons

DEFINE DISCR <
	ER	(0,No error)
	ER	(1,Resource allocation failure)
	ER	(2,Target node does not exist)
	ER	(3,Node shutting down)
	ER	(4,Target task does not exist)
	ER	(5,Invalid name field)
	ER	(6,Target task queue overflow)
	ER	(7,Unspecified error condition)
	ER	(8,Third party aborted the logical link)
	ER	(9,<User abort (asynchronous disconnect)>)
	ER	(24,Flow control failure)
	ER	(32,Too many connections to node)
	ER	(33,Too many connections to target task)
	ER	(34,Access not permitted)
	ER	(35,Logical link Services mismatch)
	ER	(36,Invalid account)
	ER	(37,Segment size too small)
	ER	(38,<User aborted, timed out, or canceled link>)
	ER	(39,No path to target node)
	ER	(40,Flow control violation)
	ER	(41,No current link to target node)
	ER	(42,Confirmation of Disconnect Initiate)
	ER	(43,Image data field too long)
> ;END DISCR DEFINITION

DEFINE ER (VALUE,TXT) <
	.DCX'VALUE==^D'VALUE
	IFDEF %%CUR,<%%DIF==^D'VALUE-%%CUR-1>
	IFNDEF %%CUR,<
		%%CUR==0
		%%DIF==^D'VALUE>
	IFG %%DIF,<REPEAT %%DIF,<[ASCIZ\Unknown\]>>
	[ASCIZ\TXT\]
	%%CUR==^D'VALUE
> ;END OF ER DEFINITION

DSCTBL:	DISCR				;GENERATE TABLE OF REASONS
	DSCMAX==.-DSCTBL-1
	PURGE	%%CUR,%%DIF
SUBTTL	PURE	TABLES

DEFINE	ER (NAME,VALUE,TEXT) <
	 ER$'NAME==VALUE
> ;End of ER definition

	MACCOD				;Equate the error codes

MACTBL:	[ITEXT	<Operation in progress >]
	[ITEXT	<Operation successful >]
	[ITEXT	<Unsupported ^Q/P1/ message >]
	[ITEXT	<Reserved status message ^O/P2/ >]
	[ITEXT	<File open error >]
	[ITEXT	<Data transfer error >]
	[ITEXT	<Data transfer warning >]
	[ITEXT	<Access termination error >]
	[ITEXT	<^Q/P1/ message format error >]
	[ITEXT	<Invalid ^Q/P1/ message >]
	[ITEXT	<^Q/P1/ message received out of sequence >]


;Define macro to generate MICCODE error table

DEFINE ER (NAM,VALUE,TEXT) <
		[ASCIZ\TEXT\],,VALUE
		 ER$'NAM==VALUE
> ;End of ER definition


MICTBL:	MICCOD				;GENERATE MICCODE ERROR TEXT TABLE
	MIC$LN==.-MICTBL		;Remember number of entries in table
SUBTTL	TOPS	20 TO DAP ERROR CONVERSION TABLE

S20DAP:					;TABLE MUST BE SEARCHED - IN ASCENDING SEQ BY 20
	XWD	CACTX1,ER$PRV
	XWD	GJFX3,ER$CJF
	XWD	GJFX4,ER$FNM
	XWD	GJFX5,ER$FNM
	XWD	GJFX6,ER$DEV
	XWD	GJFX7,ER$DIR
	XWD	GJFX9,ER$FNM
	XWD	GJFX10,ER$FID
	XWD	GJFX11,ER$FID
	XWD	GJFX12,ER$FID
	XWD	GJFX13,ER$FID
	XWD	GJFX14,ER$FID
	XWD	GJFX16,ER$DEV
	XWD	GJFX17,ER$DNF
	XWD	GJFX18,ER$FNF
	XWD	GJFX19,ER$FNF
	XWD	GJFX20,ER$FNF
	XWD	GJFX21,ER$FNF
	XWD	GJFX22,ER$DME
	XWD	GJFX23,ER$FUL
	XWD	GJFX24,ER$FNF
	XWD	GJFX27,ER$FEX
	XWD	GJFX28,ER$DNR
	XWD	GJFX29,ER$DNR
	XWD	GJFX32,ER$FNF
	XWD	GJFX33,ER$FNM
	XWD	GJFX34,ER$FID
	XWD	GJFX35,ER$PRV
	XWD	OPNX1,ER$SYS
	XWD	OPNX2,ER$FNF
	XWD	OPNX3,ER$PRV
	XWD	OPNX4,ER$PRV
	XWD	OPNX5,ER$PRV
	XWD	OPNX6,ER$PRV
	XWD	OPNX7,ER$DNR
	XWD	OPNX8,ER$DNR
	XWD	OPNX9,ER$ACT
	XWD	OPNX10,ER$FUL
	XWD	OPNX12,ER$PRV
	XWD	OPNX13,ER$IOP
	XWD	OPNX14,ER$IOP
	XWD	OPNX15,ER$PRV
	XWD	OPNX16,ER$PLG
	XWD	OPNX17,ER$DME
	XWD	OPNX18,ER$DEV
	XWD	DESX1,ER$SYS
	XWD	DESX2,ER$DEV
	XWD	DESX3,ER$CJF
	XWD	DESX4,ER$SYS
	XWD	DESX5,ER$COF
	XWD	DESX6,ER$FNF
	XWD	CLSX1,ER$SYS
	XWD	CLSX2,ER$SYS
	XWD	DELFX1,ER$PRV
	XWD	SFBSX2,ER$BSZ
	XWD	IOX4,ER$EOF
	XWD	IOX5,ER$RER
	XWD	IOX6,ER$WER
	XWD	STADX1,ER$PRV
	XWD	STADX2,ER$PRM
	XWD	DEVX3,ER$DNR
	XWD	RNAMX1,ER$DEV
	XWD	RNAMX3,ER$PRV
	XWD	RNAMX4,ER$DME
	XWD	RNAMX8,ER$PRV
	XWD	RNMX12,ER$FID
	XWD	PMAPX6,ER$FUL
	XWD	OPNX23,ER$FUL
	XWD	GJFX38,ER$FNF
	XWD	IOX7,ER$DME
	XWD	IOX9,ER$IOP
	XWD	OPNX25,ER$WLK
	XWD	GJFX41,ER$FNM
	XWD	GJFX42,ER$FID
	XWD	DELFX2,ER$FEX		;
	XWD	DELFX3,ER$DME
	XWD	MTOX17,ER$DNR
	XWD	DESX9,ER$IOP
	XWD	IOX11,ER$FUL
	XWD	OPNX31,ER$FNF		;File is offline
	S20DLN=.-S20DAP			;[107]

	LSTOF.				;Do literal expansion
	LIT
	LSTON.


	END