Google
 

Trailing-Edge - PDP-10 Archives - BB-H240B-BM - decnet/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 9-Nov-79

;
;
;
;	    COPYRIGHT (c) 1978,1979 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==54			;EDIT LEVEL
	DAPWHO==0			;WHO LAST EDITED

	GLOB	DAPEDT			;Make edit number global

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

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

\ ;end revision history
; ACCUMULATOR DEFINITIONS

	S==13				;Global link Status AC

	  S%ERR==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

	DEFPRO==775200			;Default file protection

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

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

	ND	NETTMZ,0		;Network time zone (Not implimented)
	ND	OURKON,25256		;Hours constant worth of bits

	ND	CCTIME,5		;Wait time for Connect confirm
	ND	MAXLNK,1		;Maximum number of logical links
	ND	DPMXM,^D512/2*^D9+^D100	;Maximum Dap message size
	ND	DPMXH,^D8		;Maximum Dap header size
	ND	LLMXF,^D40		;MAX LENGTH OF FILESPEC STRING

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$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	MSGDSG,1			;DAP Message designator
$DATA	LNKPGS,MAXLNK			;Per link storage address
$DATA	NETTIM,1			;Adjustment for date time


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	LLOPNB,.DOSIZ			;COPY OF LINK OPEN BLOCK
$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
$DATA	LLSTAT				;Last link status from LLCHK
$DATA	LNKSTS				;Link status and state from S
$DATA	MSGFLG				;-1 says message available
$DATA	LLDISC,20			;Disconnect cause stored here
$DATA	CLSBLK,2			;Block for closing link
$DATA	LLNAME,20			;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 word in which to build header
	  .DPSIZ==11			;Number of words in List header area


$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	REMOST				;Remote operating system type
$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>/36+1> ;;Menu stored 35 bits per word
	IFIDN <TYP><EXF>,<LN==<SIZ*7>/36+1> ;;Exf stored 35 bits per word
	IFIDN <TYP><BYT>,<LN==<SIZ*8>/33+1> ;;Fix stored 4 bytes per word
	IFIDN <TYP><VAR>,<LN==<SIZ*7>/35+1> ;;Var stored 5 bytes per word
	IFIDN <TYP><INT>,<LN==<SIZ*8>/33+1> ;;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


;Local file variables

$DATA	JFNBLK,20			;GTJFN Block
$DATA	LOCJFN				;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
$DATA	PAGFLG				;-1 if doing page mode I/O
$DATA	CRCFLG				;-1 if we are computing CRC
$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
;DECLARE VERSION AND ENTRY VECTOR

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


;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) <
	$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:	SKIPN	S2,MSGDSG		;Get output designator
	$RETT
	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 length)
	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
	$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 length)
	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
	$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
	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
	$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?
	 $FATAL	(Logical link is not open)
	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
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 length)
	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,,FILPUT		;Process Data
	.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:	TXZE	S,S%RETN		;Time to return?
	$RET				;Yes..return to caller
	$CALL	SNDQUE			;Dump the send queues
	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)
SRVMS1:	TXNN	S,S%GET			;Getting file data?
	JRST	SRVMS2			;No..process a message
	SKIPGE	MSGFLG			;Message available interrupt?
	JRST	[$CALL	LLCHK			;Yes..Check link status
		 SKIPGE	MSGFLG			;Is there a message there?
		 JRST	SRVMS2			;Yes..go recieve it
		 JRST	.+1]			;No..continue
	$CALL	FILGET			;Get and send data record
	TXNE	S,S%EOF			;Did we see EOF?
	$CALL	SNDEOF			;Yes..send EOF status
	TXNN	S,S%INIT		;State change on this record?
	JRST	SRVMS1			;No..Get next record
	JRST	SRVMSG			;Yes..back to do state change
SRVMS2:	HLRZ	S1,SRVMLS(S)		;Get proper message list address
	$CALL	GETMSG			;Get a message
	 JUMPF	SRVMS3			;Send failing status
	$CALL	0(S1)			;Call message processing routine
	 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			;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
	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

	LOAD	S1,ACCFNC		;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
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	SRVNX1			;No..process the request
	HRLI	S1,ATTMNU		;Yes..Save original attributes
	HRRI	S1,ATTSAV
	BLT	S1,ATT$LN+ATTSAV
	PJRST	SRVNXT			;Fall into common wild open code
;SRVNXT	is called from Access complete function for each additional
;	wild file in a wild ACCESS (Open)

;SRVNX1	is the entry for a non wild ACCESS (Open)


SRVNXT:	$CALL	SNDWLD			;Send of wild name messages
SRVNX1:	MOVEI	S1,.CKARD		;Make sure requestor can read it
	$CALL	JEDGAR
	 $RETIF				;Return failing status
	$CALL	ATLOOK			;Lookup specified attributes
	 JUMPF	[MOVE T1,REMOST		;Get remote system type
		 DMOVE S1,[EXP .MD1,.MD1]	;Assume image mode
		 CAIE T1,.OSTP20		;TOPS20 or TOPS10?
		 CAIN T1,.OSTP10
		  JRST .+1			;Yes..use image
		 LOAD T1,.FBBYV+LOCFDB,FB%BSZ	;No..check bytesize
		 CAIE T1,^D7			;
		 CAIN T1,^D36
		 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
	MOVEI	S1,ATTMSD		;Clear remaining attributes
	$CALL	CLRMSG
	$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	DSTMOD
	MOVEM	T1,DSTMOD
SRVNX2:	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
	 $RETIF				;Return failing status
	MOVE	S1,DSTMOD		;Get destination mode
	SETZ	S2,			;Clear extra 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

SRVCR1:	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,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,.CKACF		;Must be able to create file
	$CALL	JEDGAR			;CHECK THE ACCESS
	 $RETIF				;Return failing status
	SKIPE	S1,ACCDSP		;Want any attributes?
	$CALL	SNDDSP			;No..default is display none
	$CALL	DELFIL			;Delete the file
	$CALL	NXTINP			;Look for next file
	 JUMPT	SRVDE1			;Found it..go delete it
	$CALL	SNDACA			;Send ACCOMP (Resp)
	$STATE	.LLACC+S%RETN		;Return to Access state
	$RETT
SUBTTL	SRVEXE	Server routine to process submit requests

SRVEXE:	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
	$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:	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
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
	$CALL	SNDWLD			;Send off proper name messages
	SKIPE	S1,ACCDSP		;Want any attributes returned?
	$CALL	SNDDSP			;Send out requested attributes
SRVDI2:	$CALL	NXTINP			;Step to next file
	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
	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:	SKIPF	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
	SKIPT	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
	
FILPUT:	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	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
	TXNE	P1,FB$DEL		;Want to delete the file?
	 $CALL	DELFIL			;Yes..delete it now
ACPCLS:	$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
	SETZM	SRCMOD			;Clear source and destination
	SETZM	DSTMOD			; Modes
	PJRST	SRVNXT			;Process the next file

ACPACK:	$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:	SKIPE	T1,CAPIBL		;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	T1,CAPIBL		;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
	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
	$STATUS	ER$FIL,ER$PRV		;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
	0
	0
	0
	0
	DELFX1				;Delete access required
	OPNX4				;Write access required

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,6			;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
	MOVE	S1,[2,,.QCCDI]		;Store connected directory
	MOVEM	S1,6+MSGARF
	MOVE	S1,DIRNUM		;Use users directory
	MOVEM	S1,7+MSGARF
	MOVE	S1,[2,,.QCBLT]		;Store log file disposition
	MOVEM	S1,10+MSGARF
	MOVEI	S1,%BAPND		;Append logfile
	MOVEM	S1,11+MSGARF
	MOVEI	S1,12+MSGARF		;Point to file header
	MOVEI	S2,.QCFIL		;Store file type
	MOVEM	S2,(S1)
	HRROI	S2,NAMFSP		;Point to file
	$CALL	STRARG			;Store it
	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	SUBM10			;No..submit 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
SUBM10:	SUBI	S1,MSGHDR		;Get 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	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%ERR			;Did we receive status?
	$CALL	TYPSTS			;No..expand our message
	MOVX	T1,TXT()		;Assume local status error
	TXNE	S,S%ERR			;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$SND - 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,,0			;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,,FILPUT		;Process data messages (share server routine)
	.DMSTS,,DCNSTS
	 0

;Message dispatch for .LLACP state

DCNS05:	.DMACP,,DCNACP
	.DMNAM,,ACPNAM
	.DMSTS,,DCNSTS
	 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
SUBTTL	DCNMSG	Active Task message processing routine

DCNMSG:	$CALL	SNDQUE			;Dump the send queues
	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

DCNMS1:	TXNN	S,S%PUT			;Doing a PUT?
	JRST	DCNMS2			;No..wait for message
	SKIPGE	MSGFLG			;Have I recieved a message?
	JRST	[$CALL	LLCHK			;Yes..Check link status
		 SKIPGE MSGFLG			;Is there a message there?
		 JRST	DCNMS2			;Yes..go recieve it
		 JRST	.+1]			;No..continue in line
	$CALL	FILGET			;Send a record
	 $RETIF				;Return failing status
	TXNN	S,S%EOF			;Seen EOF?
	JRST	DCNMS1			;No..send the next record
	$RETT				;Yes..return to caller

DCNMS2:	HLRZ	S1,DCNMLS(S)		;Get message list address
	$CALL	GETMSG			;Read the message
	 $RETIF				;Return failing status
	$CALL	0(S1)			;Call message processor
	 $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%ERR			;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
	MOVE	S1,SRCMOD		;Get our source mode
	SKIPE	S2,.DFRFA(AP)		;Remote switches specified
	$CALL	SETATT			;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
	$CALL	SNDACC			;Send out file Access message
DCNR20:	$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 (Unsupported remote file attributes)
		 $WARN	(File attributes don't match processing mode)
		 PUSH P,ATTMOD(S1)	;Save default destination mode
		 MOVE S2,.DFRFA(AP)	;Setup specified attributes
		 $CALL SETATT
		 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
	 JUMPF	[$FATAL (,^E/[-2]/)]
	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
	 JUMPF	[$FATAL (,^E/[-2]/)]
	$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
	$STATE	.LLDAT			;Accept Data or Status
	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:	$CALL	DCNMSG			;Process Data until EOF Status
	 $RETIF				;Return failing status
	$CALL	SNDACP			;SEND AN ACCESS COMPLETE MESSAGE
	$STATE	.LLACP			;Wait for Accomp (Resp)
	$CALL	DCNMSG			;GET THE ACCOMP ACK
	 $RETIF				;Return failing status
	$CALL	CLSFIL			;CLOSE OUT LOCAL FILE
	 JUMPF	[$FATAL (,^E/[-2]/)]
	TXNE	S,S%ACP			;Access complete?
	$RETT
	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
	MOVEI	S1,.MD8			;Pretend user typed /ASCII
	SETZM	S2			;No other attributes
	$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:	$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
	$CALL	SNDACP			;SEND AN ACCESS COMPLETE MESSAGE
	$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
	 JUMPF	[$FATAL (,^E/[-2]/)]
	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 or TOPS10?
		 CAIE T1,.OSTP20
		 CAIN T1,.OSTP10
		 JRST	.+1		;Yes..use default mode
		 LOAD T1,.FBBYV+LOCFDB,FB%BSZ	;No..get file bytesize
		 MOVEI S1,.MD1		;Assume image mode
		 CAIE T1,^D7		;Unless bytesize is 7 or 36
		 CAIN T1,^D36
		 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
	 JUMPF	[$FATAL (,^E/[-2]/)]
	MOVE	S1,SRCMOD		;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:	MOVE	S2,.DFRFA(AP)		;Get remote attributes
	$CALL	SETATT			;Yes..setup attributes
	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
	$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:	$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	.LLACP+S%PUT		;We're doing a PUT
	$CALL	DCNMSG			;Send the data
	 $RETIF				;Get failing status

DCNS50:	$CALL	SNDACP			;SEND AN ACCESS COMPLETE
DCNS70:	$STATE	.LLACP			;Access complete state
	$CALL	DCNMSG			;Get the Accomp (Resp)
	 $RETIF				;Get failing status
	$CALL	CLSFIL			;CLOSE OUT LOCAL FILE
	 JUMPF	[$FATAL	(^E/[-2]/)]
	$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:	$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	DCNDI2			;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:	$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
	 $RETIF				;Get failing status
	TXNN	S,S%ACP			;Access complete?
	JRST	DCNDI1			;No..back for next file
	$RETT


;Get attributes by Opening file

DCNDI2:	MOVEI	S1,ATTMSD		;Point to attributes message
	$CALL	CLRMSG			;Clear it
	$CALL	QUEMSG			;Send it off
	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
DCNDI3:	$STATE	.LLACC			;Wait for file attributes
	$CALL	DCNMSG			;Get Servers response
	 $RETIF				;Return failing status
	$CALL	SNDACP			;SEND AN ACCESS COMPLETE MESSAGE
	$STATE	.LLACP			;Wait for Accomp (Resp)
	$CALL	DCNMSG			;GET THE ACCOMP ACK
	 $RETIF				;Return failing status
	TXNN	S,S%ACP			;Access complete?
	JRST	DCNDI3			;No..back for next file
	$RETT
SUBTTL	DCN	Unimplimented functions

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

VALCFG:	MOVX	S1,DPMXM		;Get my maximum message size
	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
	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
	TXNN	S1,DT$ASC!DT$IMA	;Ascii or image?
	$MIERR	.DMATT,21		;No..illegal field
	TXNE	S1,DT$EBC!DT$CMP	;Ebcdic or compressed?
	$MUERR	.DMATT,21		;Yes..unsupported attributes
	MOVE	S1,ATTORG		;Get ORG field
	MOVE	S1,ATTRAT		;Get RAT field
	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
	HRROI	S1,PROOWN		;Point to owner field
	TXNE	T1,PR$OWN		;Specified?
	MOVEM	S1,.FBAUT+ATTFDB	;Yes..save as author
	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%GRP
	$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:	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
	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
	MOVX	S2,DI$NAM		;Get bit for name display
	CAMN	S1,[BYTE (8) 4,1,0,2]	;RSX Pseudo 5.3 fal?
	ANDCAM	S2,ACCDSP		;Yes..clear name display bit
	MOVX	S1,POLINI		;Initialize CRC
	MOVEM	S1,FILCRC
	MOVE	S1,OURCAP		;Get mutual capabilities
	MOVX	S2,AO$CRC		;Get bit to request CRC
	TXNE	S1,SY$CRC		;Do we both support CRC?
	 JRST	[SETOM CRCFLG		;Yes..remember to generate it
		 IORM S2,ACCOPT		;Ask FAL to do the same
		 JRST .+1]		;Continue
	MOVEI	S1,ACCMSD		;Point to message descriptor
	$CALL	PUTMSG			;Force it out
	$RETT


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	SNDACK	Send and 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	QUEMSG			;Send it out
	$RETT


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
	$RETT				;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
	$CALL	SNDNAM			;Send it off
	$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
	$CALL	SNDNAM
	$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:	MOVE	S1,ATTMNU		;Get the calling menu
	TXNN	S1,AT$BSZ		;Is BSZ field present?
	JRST	SNDAT2			;No..skip these fields
	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$BSZ+AT$EBK+AT$FFB
	IORM	S1,ATTMNU		;Set proper menu bits
SNDAT2:	MOVEI	S1,ATTMSD		;Point to message
	$CALL	QUEMSG			;Send it out
	$RETT
SUBTTL	SNDPRO	Send File Protection Attributes

;Accepts	LOCFDB setup via GETFDB

SNDPRO:	SETZB	T1,PROMNU		;Clear our menu
	HRRZ	S1,LOCJFN		;Get file JFN
	HRLI	S1,.GFAUT		;Get the file author (Owner)
	HRROI	S2,PROOWN		;Point to storage
	GFUST
	 ERJMP	SNDPR1			;Send null protection
	TXO	T1,PR$OWN		;Set the menu bits
	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
	$RETT


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
	$RETT


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
	$RETT
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	LLRECV			;Recieve a message
	$CALL	VALHDR			;Validate the header
	 $RETIF				;Return failure if header is bad
	
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
	$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
		 $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

GETMS3:	HRRZ	S1,MSGTBL(P2)		;Get message header address
	$CALL	VALMSG			;Validate the message
	 $RETIF				;Return on failure
	HRRZ	S1,0(P1)		;Return calling list entry
	HLRZ	S2,0(P1)		;Return parsed message type
	$RETT				;Return success
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
VALHD4:	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	(Received ,<^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:	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
CLRMS1:	$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

;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
REPEAT 0,<

GETDAT:	MOVE	S1,.DPBPT(DL)		;Point to the data
	MOVE	S2,.DPCNT(DL)		;Get remaining count
	SKIPF	CRCFLG			;Computing CRC?
	$CALL	DOCRC			;Yes..process it
	HLRZ	S1,DATDAT		;Get dispatch address
	$CALL	0(S1)			;Call the processor
	$RET	
>
GETDAT:	$RETT				;Data will be processed by
					;  FILPUT
SUBTTL	GETASC	Routine to process ascii data in message

GETASC:	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?
	$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	GETPR4			;Just write a null
	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
	$RETT
SUBTTL	GETFTN	Routine to process fortran file format (vax)

GETFTN:	$CALL	GETBYT			;Get the first byte
	 JUMPF	ILLREC			;Illegal record format
	$CALL	GETFT3			;Write prefix
	 $RETIF
	$CALL	GETBYT			;Get postfix byte
	 JUMPF	ILLREC			;Illegal record format
	MOVE	T4,S1			;Remember it
GETFT1:	$CALL	GETBYT			;Get byte from message
	 JUMPF	GETFT2			;Do post fixup
	$CALL	OUTBYT			;Write the byte
	 $RETIF				;Return the error on failure
	JRST	GETFT1			;Get the next byte
GETFT2:	MOVE	S1,T4			;Get post fixup character
GETFT3:	SKIPN	T1,S1			;Put character in T1
	JRST	GETFT4			;Just write a null
	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
GETFT4:	$CALL	OUTBYT			;No..just store the character
	 $RETIF				;Return the error on failure
	SOJG	T1,GETFT4		;Repeat until finished
	$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>
	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	
	$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
	IDIV	S1,P2			;Compute bitcount
	CAME	S2,.DPBCT(DL)		;Is it correct?
	 $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
	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	PUTMSG	Routine to build and force a message out

;PUTMSG	Is called to block a message to the end of the existing
;	message queue and then force all messages to be sent

;Accepts	S1/ Address of message descriptor

PUTMSG:	$CALL	QUEMSG			;Do header fixup
	PJRST	SNDQUE			;Empty the queue!


SUBTTL	SNDQUE	Routine to send all messages in the send queue

SNDQUE:	MOVE	S1,SNDLST		;Position to last entry
	$CALL	L%LAST
	 JUMPF	SNDQU2			;Return when finished
	SETZM	.DPLEN(S2)		;Clear to force message out

SNDQU1:	MOVE	S1,SNDLST		;Point to send que
	$CALL	L%FIRST			;Get first message address
	 JUMPF	SNDQU2			;Return when finished
	$CALL	LLSEND			;Send the message
	$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	QUEMSG	Routine to block current message if possible

;QUEMSG	is called to block a message to the existing message queue
;	if possible and then send all but the final message in the
;	message queue

;Accepts	S1/ Address of message descriptor

QUEMSG:	$CALL	BLDMSG			;Build the message
	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		;...
	SETZB	DL,.DPLEN(DL)		;No..send all messages
QUEMS2:	MOVE	S1,SNDLST		;Yes..send all but current
	$CALL	L%FIRST
	 JUMPF	QUEMS3			;All have been sent!
	CAMN	S2,DL			;Current message?
	JRST	QUEMS3			;All but the last has been sent!
	$CALL	LLSEND			;No..send this message
	$CALL	DELMSG			; Then delete it
	JRST	QUEMS2			;Do all except last message

QUEMS3:	$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
	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
	JRST	BLDMS6			;Do the next field
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
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
	 $RETIF				;Return error on failure
	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:	MOVE	T1,ATTRFM		;Get record format
	MOVE	T2,ATTRAT		;Get record attributes
	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	PUTAS4			;No..Check for MRS
	MOVE	T4,S1			;Remember last character stored
PUTAS2:	$CALL	INPBYT			;Get a byte from file
	 JUMPF	PUTAS3			;Check for EOF
	TXNE	T2,FB$CR		;Implied CRLF envelope?
	JUMPE	S1,PUTAS2		;Yes..then strip nulls
	$CALL	PUTBYT			;Store in the message
	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)
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


PUTAS4:	SKIPE	ATTMRS			;Max record size given?
	$MTERR	ER$IRC			;Yes..bad record format
	$RETT				;No..send the record
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
	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
	$CALL	M%NXPG			;Get non existant page
	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
	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
	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 4 <cnt>	high order of (length of "Data in bytes)+4=[n]
;Byte 5	<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
	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
	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
	$RETT				;Return success
SUBTTL	CLSFIL	Routine to close local file and update FDB

CLSFIL:	LOAD	S1,LOCDEV,DV%TYP	;Get device type
	MOVE	S2,OPNFLG		;Get file open flags
	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
	MOVX	S1,CO%NRJ		;Don't release JFN
	HRR	S1,LOCJFN
	CLOSF				;Close the file
	 ERJMP	TERCVT
FIXFDB:	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
	SKIPT	PAGFLG			;Doing page I/O?
	JRST	CLSFI1			;No..don't change bytecount
	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
	SKIPT	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
	MOVE	S2,.DOACT+LLOPNB	;Point to files account
	SACTF				;SET FILE'S ACCOUNT DESIGNATOR
	 ERJMP	RELJFN			;Failed..Release JFN
	HRLI	S1,.SFAUT		;SET THE AUTHOR STRING
	SKIPN	S2,.FBAUT+ATTFDB	;Author specified?
	MOVE	S2,.DOUSR+LLOPNB	;Pickup pointer to user string
	SFUST				;DO IT
	 ERJMP	RELJFN			;Failed..Release JFN
	HRLI	S1,.SFLWR		;SET LAST WRITER
	MOVE	S2,.DOUSR+LLOPNB	;Pickup pointer to user string
	SFUST				;DO IT
	 ERJMP	RELJFN			;Failed..Release JFN
	PJRST	RELJFN			;Release output JFN
SUBTTL	CLSINP	Routine to close input file

CLSINP:	MOVE	S1,LOCJFN		;Input JFN wild?
	TXZE	S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
	TXO	S1,CO%NRJ		;Yes..don't release JFN
	CLOSF				;Always close the file
	 ERJMP	TERCVT
	$RETT

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:	HRRZ	S1,LOCJFN		;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		;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:	$CALL	TERCVT			;Get 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
	$RETT				;Return true

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
	HRRZ	S1,LOCJFN		;No..get a byte
	BIN
	 ERJMP	TERCVT			;Return failing status
	MOVE	S1,S2			;Return the byte in S1
	$RETT

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
	BIN
	 ERJMP	TERCVT
	MOVEM	S2,MCYDAT		;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!
	MOVE	S2,S1			;Get the byte to be written
OUTBY1:	MOVE	S1,LOCJFN		;Get the file JFN
	BOUT				;Write the byte
	 ERJMP	TERCVT			;Return if failure
	MOVE	S1,S2			;Restore the byte
	$RETT

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,LOCJFN		;Get the file JFN
	MOVE	S2,MCYDAT		;Get our last word
	BOUT				;Write it
	 ERJMP	[POP P,S1		;Fixup the stack
		 PJRST TERCVT]		;And return the failure
	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:	$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 swithces

;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 arg or default of 512

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
	SKIPN	T1			;Anything specified?
	MOVEI	T1,^D512		;No..use nice default
	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
SWLOO2:	$RETF				;Return a failure

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

;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
;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		;/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 <.MD8,.MD10>			;/ASCII (TO) /ASCII [/VARIABLE]
	XM <.MD8>			;/ASCII/FIX (TO) /ASCII
	XM <.MD8,.MD10>			;/ASCII/VAR (TO) /ASCII [/VARIABLE]
	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 GETPRN,[PJRST .RETT]	;PRN format is read only
	XWD GETFTN,[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
	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,-ATT$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$IMA,FB$STM		;Ascii stream from RSTS
		ATT$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	.MD8,.MD8
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
	ANDX	P3,ER%FLD		;Clear all but field from error
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
	MOVE	T1,S1			;Return designator in T1
	$RETT
SUBTTL	TYPDVR	ROUTINE TO TYPE OUT DAP VERSION MESSAGE

TYPDVR:	$DEBUG <DAP version >,<^O/[.DVMAJ]/.^O/[.DVMIN]/>
	$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
	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
	$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 .+1]		;CONTINUE ON.
	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]/)
	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
LLGDC3:	$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
	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>
	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,.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

;HERE WHEN LINK IS OPEN AND MTOPRS DONE
LLOPN2:	$STATE	.LLCFG			;Say link is waiting on Config
	MOVE	S2,.DOTSK(AP)		;Get task pointer
	$DEBUG	<Logical link open>
	$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,^D5			;Wait for 5 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 - ,^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:	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
	AOSE	MSGFLG			;Message interrupt recieved?
	JRST	LLCHK1			;No..just return status in S1
	SIBE				;Yes..make sure we have one
	SETOM	MSGFLG			;Flag message available
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)
	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
	HRRI	S2,.MOCLZ		;Get the close function
	MOVE	S1,LLJFN		;Get the JFN
	MTOPR
	 ERJMP	LLCLS3			;Abort if MTOPR fails
	TLNE	S2,-1			;Did we abort link?
LLCLS3:	TXOA	S1,CZ%ABT		;Yes..set bit for close
LLCLS4:	MOVE	S1,LLJFN		;Pick up JFN
	CLOSF
	 $FATAL	(Can't close logical link - ,^E/[-2]/)
	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

LLSEND:	MOVE	S1,LLJFN		;Get link JFN
	MOVN	T1,.DPCNT(S2)		;Get byte count
	SKIPLE	.DPLEN(S2)		;More to come?
	JRST	LLSEN1			;Yes..send with SOUT
	MOVE	S2,.DPBPT(S2)		;Get the byte pointer
	SOUTR				;No..Send with end of message
	 ERJMP	LLSENE			;Die on failure
	$RETT

LLSEN1:	MOVE	S2,.DPBPT(S2)		;Get the pointer
	SOUT				;Send of part of a record
	 ERJMP	LLSENE			;Die on failure
	$RETT


LLSENE:	$FATAL	(Logical link transmission error - ,^E/[-2]/)
SUBTTL	LLRECV	Routine to receive link messages

;Returns TRUE	DL/ Address of message header

LLRECV:	MOVE	S1,RCVLST		;Point to recieve list
	$CALL	L%FIRST			;Point to first entry
	JUMPF	LLREC3			;Anything there?
	SKIPL	T1,.DPTYP(S2)		;Yes..want to reparse it?
	JRST	LLREC1			;No..delete it
	MOVNM	T1,.DPTYP(S2)		;Yes..fix the type
	MOVE	T1,.DPLEN(S2)		;Yes..Get original length
	EXCH	T1,.DPCNT(S2)		;Reset message count
	SUB	T1,.DPLEN(S2)		;Get characters parsed
	ADJBP	T1,.DPBPT(S2)		;Reset message pointer
	MOVEM	T1,.DPBPT(S2)
	JRST	LLREC2			;On to receive next message

LLREC1:	$CALL	L%DENT			;Delete first list entry
LLREC2:	MOVE	S1,RCVLST		;Point to first message in list
	$CALL	L%FIRST
	JUMPF	LLREC3
	MOVE	DL,S2			;Point to our entry
	SETOM	MSGFLG			;Force SIBE check in LLCHK
	$CALL	LLCHK			;Get link status and SET/CLEAR MSGFLG
	TXNN	S1,MO%EOM		;Do we have a full message ready?
	$RETT				;No..return with first message in list

LLREC3:	MOVE	S1,RCVLST		;Get recieve list index
	MOVE	S2,OURSIZ		;Get size of a buffer
	$CALL	NEWBUF			;Allocate new buffer
	MOVE	S1,LLJFN
	MOVE	S2,.DPBPT(DL)		;Get pointer to buffer
	MOVN	T1,.DPCNT(DL)		;Get max count
	SINR				;Read a logical message
	 ERJMP	LLRECE			;Bad news
	ADDB	T1,.DPCNT(DL)		;Save actual count
	MOVEM	T1,.DPLEN(DL)		;Save as length
	JRST	LLREC2			;Back to check for next message

LLRECE:	$CALL	GETTER			;Get my last error
	CAIN	S2,IOX4			;End of file?
	$FATAL	(Logical link was terminated)
	$FATAL	(Logical link reception error - ,^E/[-2]/)
SUBTTL	NEWBUF	Routine to allocate a new buffer

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

;Returns TRUE	DL/ Address of new message buffer

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	DL,S2			;Point to it
	MOVEI	S2,.DPSIZ(S2)		;Point to message area
	HRLI	S2,(POINT 8)
	MOVEM	S2,.DPBPT(DL)		;Save in header
	MOVEM	T2,.DPCNT(DL)		;Save counts
	MOVEM	T2,.DPLEN(DL)		;Save length
	$RETT
SUBTTL	Connect	event interrupt service


;HERE ON CI RECEIVED
CICON:	$CALL	LLCHK			;Get link status
	TXNN	S1,MO%SRV		;AM I A SERVER?
	 $RETT				;NO - DONE
	$CALL	LLRCD			;READ CONNECT DATA


;HERE TO CHECK FOR VALID CONNECT PARAMETERS
CICHK:	MOVEI	S1,.DCX34		;Assume no access
	SETZ	S2,			;No optional text
	SKIPE	T1,.DOCID+LLOPNB	;GET ADDRESS OF CHECK ROUTINE
	$CALL	0(T1)			;CALL IT
	 JUMPF	LLCLOS			;abort link on failure
	MOVEM	S1,USRNUM		;Save user number
	MOVEM	S2,DIRNUM		;Save directory number
CIACC:	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:	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 violation)
	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
	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 (^O/P3/)>]
	[ITEXT	<Operation successful (^O/P3/)>]
	[ITEXT	<Unsupported ^Q/P1/ message (^O/P3/)>]
	[ITEXT	<Reserved status message ^O/P2/(^O/P3/)>]
	[ITEXT	<File open error (^O/P3/)>]
	[ITEXT	<Data transfer warning (^O/P3/)>]
	[ITEXT	<Access termination error (^O/P3/)>]
	[ITEXT	<^Q/P1/ message format error (^O/P3/)>]
	[ITEXT	<Invalid ^Q/P1/ message (^O/P3/)>]
	[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	DELFX3,ER$DME
	XWD	MTOX17,ER$DNR
	XWD	DESX9,ER$IOP
	XWD	IOX11,ER$FUL
	XWD	OPNX31,ER$FNF		;File is offline
	S20DLN=.-S20DAP-1

	LSTOF.				;Do literal expansion
	LIT
	LSTON.


	END