Trailing-Edge
-
PDP-10 Archives
-
BB-H241B-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