Trailing-Edge
-
PDP-10 Archives
-
k20v7b
-
decnet-sources/daplib.mac
There are 14 other files named daplib.mac in the archive. Click here to see a list.
TITLE DAPLIB Dap routines for TOPS20 DECNET
SUBTTL D. Oran - P.J. Taylor /POM/CLB/ 17-Nov-81
;
;
;
; COPYRIGHT (c) 1978,1979,1980 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;Get Galaxy symbols
PROLOG (DAPLIB) ;Declare our name
SEARCH QSRMAC ;Get symbols for submit/print
SEARCH DAPSYM ;Get DAP symbols
SALL ;SUPPRESS FULL EXPANSION
;Version Information
DAPVER==2 ;MAJOR VERSION OF DAP20
DAPMIN==0 ;MINOR VERSION OF DAP20
DAPEDT==171 ;EDIT LEVEL
DAPWHO==0 ;WHO LAST EDITED
GLOB DAPEDT ;Make edit number global
GLOB LEV1PC ;Interrupt PC from caller
VDAP20==VRSN.(DAP) ;GET THE VERSION LEVEL
SUBTTL Table of contents
COMMENT #
TABLE OF CONTENTS FOR DAPLIB
SECTION PAGE
1. Title Page.............................................. 1
2. Table of contents....................................... 2
3. Revision History........................................ 3
4. Symbol Definitions...................................... 4
5. IMPURE storage.......................................... 5
6. STORAGE allocated per logical link...................... 6
7. Version number and entry vector......................... 9
8. DAP message descriptor blocks........................... 10
9. DAP message argument types and processor table.......... 11
10. Local macro definitions................................. 12
11. $DEBUG Macro to display debugging message.............. 13
12. DEBUG and TYPER output routines......................... 14
13. $GODAP Macro to establish DAPLIB context............... 15
14. D$INIT Daplib initialization........................... 16
15. D$OPEN Establish a logical link........................ 17
16. D$INTR Interrupt processing routines................... 18
17. D$CLOS Routine to close logical link................... 18
18. D$STAT Display link status............................. 18
19. D$FUNC Daplib routine to perform a File function....... 19
20. SRVMSG Server initialization and tables................ 20
21. Server state initialization routines.................... 21
22. SRVMSG Server message processing loop.................. 22
23. SRVCFI Server routine to process Initial config message 23
24. SRVCFG Server routine to Process Config message........ 23
25. SRVACC Server routine to process an ACCESS message..... 23
26. SRVOPN Server routine to process ACCESS (Open)......... 24
27. SRVCRE Server routine to process ACCESS (Create)....... 26
28. SRVDEL Server routine to process Delete requests....... 27
29. EXPUNG Expunge deleted files........................... 28
30. SRVEXE Server routine to process submit requests....... 29
31. SRVDIR Server routine to process Directory requests.... 30
32. SRVCTL Server routine to process a CONTROL message..... 31
33. FILGET Server routine to send data messages............ 32
34. SRVACP Server routine to process Access complete mess.. 33
35. ENABLE/DISABL Routine to set or clear capabilities...... 34
36. HOOVER Routine to validate a users access to a file.... 35
37. PRINT/SUBMIT Server routine to queue galaxy requests.... 36
38. SNDQSR Routine to send message to quasar............... 37
39. DAPDCN Active Task function dispatch................... 38
40. Active Task message and State tables.................... 39
41. Active Task state initialization routines............... 40
42. DCNMSG Active Task message processing routine.......... 41
43. DCNCFG Routine to process Config message............... 42
44. DCNNAM Routine to process Name message................. 43
45. ATTACK Routine to process ACK for Attributes message... 43
46. CTLACK Routine to process ACK for Control message...... 43
47. DCNACP Routine to process Accomp (Resp)................ 43
48. DCNSTS Routine to process Status message............... 43
49. DCNATR Routine to call user with received attributes... 43
50. DCNREC Active Task routine to receive a file........... 44
51. DCNTYP Active task to type remote files................ 45
52. DCNSND Active task to send files....................... 46
53. DCNDEL ACTIVE TASK TO DELETE A FILE.................... 47
54. DCNEXE ACTIVE TASK TO EXECUTE A FILE................... 47
55. DCNDIR Active Task routine to process Directory request 48
56. DCN Unimplimented functions......................... 49
57. VALCFG Validate contents of a CONFIG message........... 50
58. VALATT Validate contents of an ATTRIBUTES message...... 51
59. VALDTI Validate DATE/TIME attributes extention mess.... 52
60. VALPRO Validate protection attributes message.......... 53
61. VALNAM Validate the contents of a NAME message......... 54
62. VALCRC Routine to validate the CRC .................... 54
63. SNDCFG Send CONFIG message............................. 55
64. SNDACC Send an ACCESS message.......................... 56
65. SNDCTC Send a CONTROL (CONNECT) message................ 56
66. SNDCTR Send a CONTROL (GET) message.................... 57
67. SNDCTS Send a CONTROL (PUT) message.................... 57
68. SNDCON Send a CONTROL TRANSFER (Skip) message ;[132].. 58
69. SNDACK Send an ACKNOWLEDGE message..................... 59
70. SNDEOF Send an EOF status message...................... 59
71. SNDSTS Routine to send a status message................ 59
72. SNDACP Send an ACCOMP (CLOSE) message.................. 59
73. SNDACA Send an Accomp (Resp) message................... 59
74. SNDWLD Routine to send required name mess's per WLDJFN. 60
75. SNDDSP Send requested ATTRIBUTES messages.............. 61
76. CONREM/RESREM Send file names in correct format......... 62
77. SNDATT Send an attributes message...................... 63
78. SNDPRO Send File Protection Attributes................. 64
79. SNDDTI Send Date/time attributes....................... 64
80. SNDNAM Send a Name message............................. 64
81. MSGTBL List of valid DAP messages...................... 65
82. GETMSG Routine to get next DAP message from Link....... 66
83. VALHDR Routine to validate standard dap message header. 69
84. NEWHDR Routine to create a new header only............. 69
85. VALMSG Routine to parse current DAP message............ 70
86. CLRMSG Routine to clear DAP message storage............ 71
87. GETFIX Routine to process DAP byte arguments........... 72
88. GETBYT Routine to return a single DAP message byte...... 72
89. GETVAR Routine to process DAP variable length arguments 73
90. GETINT Routine to process DAP integer arguments........ 74
91. GETPRO Routine to get Protection field from DAP message 75
92. GETEXF Routine to process DAP extensible fields........ 76
93. GETMNU Routine to process DAP extensible menu fields... 76
94. GETDTI Routine to process Date/time field in DAP mess.. 77
95. GETDAT Routine to process DATA field from DAP message.. 78
96. GETASC Routine to process ascii data in message........ 79
97. TSTPRN Routine to do final linefeed for print files.... 79
98. GETPRN Routine to process print file format (vax)...... 80
99. GETPAG Routine to get a file page from DAP message..... 81
100. GETIMG Routine to process image bit stream in data mess 82
101. GETBCT Routine to return bitstream from DAP message.... 83
102. GETDOS Routine to store MACY11 variable length files... 84
103. SNDQUE Routine to send all messages in the send queue.. 85
104. DELMSG Routine to delete current message in Send Queue. 85
105. PUTMSG Routine to build and force all messages out..... 86
106. QUEMSG Routine to block current message if possible.... 86
107. BLDMSG Routine to build a DAP message.................. 88
108. BLDHDR Routine to build header for current message..... 89
109. PUTFIX Routine to store 1-4 BYTE fields in DAP message. 90
110. PUTBYT Routine to store a character in current message. 90
111. PUTERR Routine to die on invalid argument.............. 90
112. PUTVAR Routine to store var length field in DAP message 91
113. PUTINT Routine to store variable length integer........ 92
114. PUTPRO Routine to store DAP protection argument........ 93
115. PUTEXF Routine to store extensible field in Dap message 94
116. PUTMNU Routine to store DAP extensible fields.......... 94
117. PUTDTI Routine to store date time field in DAP message. 95
118. PUTDAT Routine to store Data field in DAP message...... 96
119. DOCRC Routine to update cumulative CRC for data mess's 97
120. CRCTAB CRC TABLE DEFINITION............................ 98
121. PUTASC ROUTINE TO READ ASCII AND make A DAP MESSAGE.... 99
122. PUTPAG Routine to store file page in DAP message...... 100
123. PUTIMG Routine to store n-bit bytes in data message... 101
124. PUTBCT Store image bit stream in DAP message.......... 103
125. PUTDOS Process MACY11 assembler output................ 104
126. SETINP Setup for local file input..................... 105
127. SETOUT Setup for local file output.................... 106
128. OPNFIL Routine to open the local file................. 107
129. CLSFIL Routine to close local file and update FDB..... 108
130. CLSINP Routine to close input file.................... 109
131. DELFIL Routine to delete the local file............... 109
132. ABTFIL Routine to abort local file operation.......... 109
133. CHNGFD Routine to change a field in output files FDB.. 109
134. EOFCHK Routine to check for EOF in local file......... 110
135. INPBYT Routine to read a byte from file............... 110
136. OUTBYT Routine to write a byte to file................ 111
137. GETFDB Routine to read local file FDB and other info.. 112
138. GETDEV Routine to get device attributes............... 113
139. SETATT Set attributes from switches................... 114
140. SWLOOK Lookup switches and convert to DAP attriubtes.. 115
141. CHKMOD Routine to check for legal input to output mode 115
142. PICMOD [125]Pick default file mode by system type..... 116
143. File mode table definitions............................ 117
144. ATLOOK Routine to lookup attributes................... 118
145. Attributes list........................................ 119
146. SETMOD Routine to setup processor address and bytesize 120
147. TYPSTS Routine to expand DAP status codes............. 121
148. TERCVT Routine to convert 20 error code to dap status. 122
149. LLGJFN Routine to get JFN for logical link............ 123
150. LLGJFN Get a JFN for logical link..................... 123
151. QSOUT move asciz string and quote if required........ 124
152. LLOPEN Routine to OPEN logical link................... 125
153. LLWCON ROUTINE TO WAIT FOR LINK TO BE CONNECTED....... 126
154. LLCHK Routine to check logical link status........... 127
155. LLCLOS Routine to close or abort a logical link....... 128
156. LLRCD Read Connect-initiate Disconnect initiate data. 129
157. STOSTS Routine to store link status................... 130
158. LLSEND Routine to send messages across Link........... 131
159. LLRECV Routine to receive link messages............... 132
160. NEWBUF Routine to allocate a new buffer............... 133
161. Connect event interrupt service........................ 134
162. Interrupt message processing........................... 135
163. Table of NSP disconnect reasons...................... 136
164. PURE TABLES............................................ 137
165. TOPS20 TO DAP ERROR CONVERSION TABLE................... 138
#
SUBTTL Revision History
COMMENT \
Edit Comment
0020 First field test of DAPLIB
0021 Fix Daplib to default to Image mode if remote node is TOPS20
0022 Fix Daplib to Store output files DTI and PRO message info
0023 Fix bugs in blocked recieve code and SNDATT to allow ascii
transfers to/from RSX11
0024 Move Free <CRLF> for TTY output to DCNREC instead of OPNFIL
0025 Default directory name and extention to *.* for server.
Move Date/time info received from attributes into FDB
for directory function.
0026 Fixed a bug in SNDWLD that caused error in directory if
Filespec was not wild.
0027 Only do MTOPR and SIBE when required. Globalaize Status flags.
0030 Check for Device type DSK before updating FDB
0031 Impliment TYPE routine for DCN
Add wild logic to SRVOPN
0032 Remove code for unsupported message types
0033 Add blocking code to send logic and fix various bugs
0034 Fix bugs in send blocking code
0035 Redefined extensible field bits to begin with bit 35
and change GETEXF and PUTEXF to automatically lite the
extension bit when required. Effectively extend the
precesion for extensible fields to 70 information bits
(or 10 bytes)
0036 Defined message types via macros in DAPSYM and invoked
macros to declare local storage
0037 Further bugging for VAX communication
0040 Bug fixes for TYPE command and FAL
0041 Remove SY$APP from SYSCAP field since it's not supported
0042 Change GETINT to accept up to 9 byte integer fields
0043 Remove SY$RSS and SY$RSR from SYSCAP and add SY$CRC
and appropriate support code to generate and validate
CRC's
0044 Remedy several bugs to allow FAL to speak to VAX
0045 Disable capabilities upon reciept of CTL (PUT) to allow
overquota errors to occur. Also CRC changes.
0046 Add page mode transfer code so "holy" files may be transferred
between TOPS20 nodes
0047 Don't copy file protection attribute when creating files. This
will cause the directory default protection to be followed if
no protection is specified. Also, don't update reference counts
0050 Fix a bug in PUTASC which caused CRC error on 36 bit files when
transferred in ASCII mode.
0051 Fix an interrupt race which causes NFT and FAL to occasionally hang
0052 Add check to FAL to determine if directory is large enough to write
file before file is created.
0053 Fix several problems for speaking to RSTS Dap 4.0
0054 Fix problem causing invalid ATTEBK and remove code to support pre
5.3 FAL for TOPS20
*** Changes for DECnet-20 V3.0 begin here ***
0055 Fix PRINT routine to properly queue file for printing.
0056 Add CHKWLD routine to look for unsupported wild cards.
0057 Change primary output mode for ascii from ascii stream to
ascii variable to prevent the RSX FAL from hanging.
0060 Add code to break out of SOUT if an interrupt has occured.
0061 Ignore enable/disable requests if debugging.
0062 Remove obsolete hack to check for RSX Pseudo 5.3 FAL in
SNDACC routine. (Always request name if they support it)
0063 Don't send fancy fields in attributes message to none TOPS20
and TOPS10 on file create.
0064 Don't send attributes bytesize if it is the default (8).
0065 Check for delete access before deleting file via ACCOMP
options.
0066 Only do CRC validation for DCNSND and DCNREC routines.
0067 Add .DIACP function to D$INTR to force access complete.
0070 Add missing Data transfer error entry to MACTBL to prevent
nasty stopcode on message sequence errors.
0071 Add debugging typeout to LLSEND and LLRECV routines.
0072 Fix a race problem in setting and clearing MSGFLG.
0073 Call LLRECV from main routines DCNMSG and SRVMSG and expect
a false return if no messages are available.
0074 Wait for 30 CCTIME intervals during wait for connect confirm
and modify CCTIME to be 2 seconds.
0075 Modify SNDQUE to send all but the last message segment unless
the last segment is being forced out.
0076 Fix a bug in PUTASC which was causing CRC generation failure
for fixed length ascii records.
0077 Remember ATTMRS specified in initial attributes and use that
when FAL returns attributes. Do defaulting for MRS in DCN
routines instead of general file routines.
0100 Establish invalid default value for ACPCRC to determine if
it was sent at all. Don't validate CRC if this field was
not sent.
0101 Fix copy for Print and Fortran format files from VMS.
0102 Return unsupported for CTL with RB$VBN which implied random
access by VBN which is unsupported.
*** Engineering responsibility changed hands here ***
103 For TOPS-10 connections, if the file data mode is unspecified in
the ACCESS message sent by the 10 to read an existing file on
the 20, or create a new file on the 20, then default to ASCII
for files whose byte size is 7 or 36.
104 The macro which builds DAP messages used the wrong
radix in an arithmetic expression, causing some
DAP messages to be too large.
105 The symbol ATT$LN was multiply defined, but MACRO didn't
notice. This caused the saved attributes message to be
truncated and wild card copies to exhibit multiple
problems.
106 The maximum value of DPMXM was lowered to ^d1636 if the
user said /OSTYPE:VMS in SET DEFAULT. This is
the largest it can be and still allow VAX FALs to function
if the VAX users accounting file allows BYTLM to default
to 4K. If BYTLM is too small for DPMXM, then the VAX FAL
hangs. If all VAX users have BYTLM raised, then DPMXM can
also be raised. Doing this provides better performance.
Note that the next release of VMS fal should include a patch
to solve this problem. When NFT/FAL-20 is shipped with
DECnet-20 phase III this patch should be removed.
107 The table search for error conversion to DAP error codes
in TERCVT is one word off. The last error was never identified.
110 For non-TOPS-20 nodes, if a files byte size is zero make
it default to 7.
111 Non copy commands keep all generated messages in core until
the command is almost finished. Commands which process many files
(such as dir <*>*.*.*) can run out of core. Do a SNDQUE
every so often to regain the core.
112 A FAL serving a directory request will forget to send the
structure and directory name if the first file in a wildcarded
directory is not accessable, but other files are.
113 Logical link error messages are terrible.
Remote status error messages are not complete enough.
114 Allow zero length variable length image mode records
to be transmitted to remote nodes.
115 The code which sends IPCF packets to QUASAR failed to put
the message length into the message header. The length
field is required by Galaxy 4.1.
116 The DAP protection attributes message contains an owner field.
DAPLIB was interpreting this as a TOPS-20 author field. This
concept is incorrect. When the two are treated equivalently
it is possible to create a file on the 20 whose author field
contains a vax uic. Then when one attempts to copy the file to
a vax, the copy fails because of lack of privileges. The author
field should always contain the userid passed at CI time. TOPS-20
should not send the owner field, but let the owner default to
the user id passed at CI time to the VAX.
117 If a VAX user gives a file spec without quotes, VMS sends it
with a semicolon before the version number. TOPS-20 always
fails to find such a file. So, to make file transfer easier
for everyone always convert semi colons to periods in file
specs that come in to a TOPS-20 server in an ACCESS message
120 In certain cases, the CLOSF in LLCLOS fails when it shouldn't.
Since the file transfer would have already completed successfully,
don't make this an error, just set the abort bit and close again.
121 Add a subroutine to do poor mans routing. The routing info
is stored in SYSTEM:DECNET-HOSTS.TXT. This code is only
invoked if the value of PMRFLG is -1. NFT/FAL is
shiped with this value = 0.
122 Any date generated must be in the format specified by the
DAP spec. The day of the month is supossed to be DD not D.
123 If a bad message is received by FAL it will loop forever
sending the error status message. The bad message was never
deleted from the receive queue.
124 Force FAL to expunge each file that it deletes.
125 If file mode is not specified for destination file, pick
file mode by type of destination system. Always default to ASCII
This means that for all ASCII file transfers to any system,
if the user leaves out all the switches, NFT will default
to doing the right thing.
126 Allow copying of stream files and files with fortran carriage
control to TOPS-20 (fixed, variable, and vfc) from VMS.
127 Fix incorrect error message from FAL when VALMSG gets an
error.
130 Performance improvements. For non TOPS-20 transfers replace
BIN/BOUT with PMAP. This speeds things up by 75%.
131 Fix "File off-line" problem when doing wildcard copy.
When an error was found with a file being copied the
entire copy was aborted. Now just the current file is
aborted and the wildcarding process continues.
132 Fix abort of DIRECTORY command when a remote file is inaccessible.
This is the same wildcarding problem as the copy problem
above.
133 Fix the initialization of the checksum variable FILCRC. It is
not initialized for each file in a wildcarded transfer. Thus
the transfer of the second file always fails.
134 Add ^A command to show current status for NFT.
135 Allow a null DATATYPE field in an attributes message
received during a DIRECTORY command.
136 DAP arcitecture suggests that file names sent to other systems
be in the format required by the remote system. This edit
changes the period before the version to a semi colon if the
remote system requires it. If the octal/decimal version number
problem is resolved, this is where the fix should go.
137 The processing of the delete on close function (access complete)
is all wrong.
140 Fix obscure problem with interrupt system. It seems that
if an interrupt routine does a network JSYS when the mainline
code was interrupted out of a network JSYS, then odd things happen
to the logical link. This really needs to be fixed in the monitor,
but in the meantime, fix it here by prevent both paths from
doing network actions at the same time.
141 The algorithm in GETIMG for determining whether the residual
bit count was correct was wrong.
142 In PUTASC a buffer count was set up incorrectly.
This caused double CRLFs in some cases.
143 Improve error detection when a file name is used which is correct
if some of the trailing characters are ignored.
144 If FAL queues a file to be printed and its type is DAT then
it should be specified to be /FILE:FORTRAN.
145 Temporary patch to prevent NFT from hanging when running under
DECnet-20 V2.0 or V2.1. This should be removed when lost DC
problem is solved, or if supporting an RT system.
146 When printing remote files send the FOP bit in the attributes
message in addition to the access complete. Field image RSX
does not read the access complete FOP field.
147 Error messages concerning local files are not clear enough.
150 Strip nulls from files which are being converted from
line numbered files to non-line numbered files.
151 Following a fatal error files with pages mapped are left
open because the cleanup code does not unmap the pages.
Unmap them at cleanup time.
152 A file with an unusable byte size previously caused an error.
This edit prints a warning message and assumes a byte size of
7.
153 When copying to RSTS systems specify superceed always.
If this is not done, a copy to an existing file will fail.
154 The routine LLCHK was called too frequently, lowering performance.
remove the excessive calls.
155 The location of the RSX11-M+ entry in PMTAB was off - it assumed
that the OS code was 11. when it should be 12. This problem
caused the TYPE command to not work when going to M+ systems.
Also put in defensive coding to prevent references outside the
PMTAB table.
156 The TYPE command defaulted to /ascii. If the remote FAL didn't
understand ascii stream it converted it into something it did
understand. RMS-11 FAL does this, but the FCS-11 FAL doesn't.
This caused TYPE command to not work going to some RSX systems.
Changed the default so that it is based on the operating system
type and will get the right switches.
157 In CLSIN2, LOCJFN was not being zeroed after a JFN was released.
This caused FALSRV to still think it owned the JFN and resulted
in strange JFN-related errors.
160 In D$INIT, see if we are NFT. If we are, get the username and
the current account string and stash them away. Use these at
CLSFI1 when creating local files, not the switch values.
161 Remove edit 106 to DAPLIB which compensated for BYTLM being too
small on a VAX/VMS account prior to DECnet-VMS V.3.1 and VMS V3.4.
This eliminates "data overrun" errors seen when transfering files
from a -20 to VAX running VMS V3.4 or greater.
162 Fix D$CLOS to not zero LLSTAT if a fatal error occurs
163 In SRVNXT check for directory listing access if we are wildcarding
during an ACCESS (Open), and skip to the next file if such access
is denied. Return an error status if no files were successfully
accessed. Fix off by one errors on BLTs.
164 For non-TOPS20 transfers, release the scratch page used when
closing the local file. This prevents GLXMEM CFC crashes from
occuring when transfering a large number of files.
165 Fix access checking in SRVDEL to allow file deletion when we have
write access and to disallow deletion when the file is write
protected against the owner in a directory we can connect to.
*** Changes for TOPS-20 V. 6.0 begin here ***
166 Remove infinite loop from edit 152
167 Add unsupported hooks for Access Control Lists under feature
test ACL /Alec Carlson
170 change error from PMAPX1 to EOF in PAGINN when PA%PEX is off.
171 tweak unsupported PMR feature to work with Phase IV. Routing
is now always attempted if PMRFLG is non-zero. Routes need
only be specified for Phase II & and out-of-area Phase III
nodes; other nodes don't even need to be in DECNET-HOSTS.TXT.
\ ;end revision history
SUBTTL Symbol Definitions
DEFINE FTACL,<IFN ACL,> ;[167] Access control list feature test
ACL==0 ;[167] Turn off ACL support
FTACL <SEARCH ACCMAC > ;[167] If ACL support,,get symbols
; ACCUMULATOR DEFINITIONS
S==13 ;Global link Status AC
S%JERR==1B10 ;[127]A JSYS error has occured
S%LERR==1B11 ;Error status sent or received
S%INIT==1B12 ;State has just changed
S%RETN==1B13 ;Return to caller flag for DCN
S%PUT==1B14 ;Data ouptut
S%GET==1B15 ;Data input
S%EOF==1B16 ;EOF seen
S%ACP==1B17 ;Access complete
S%STAT==777777B35 ;Link state
.LLCFG==0 ;Awaiting Config
.LLACC==1 ;Awaiting Attributes or Access
.LLATT==2 ;Awaiting Ext Attr or Access
.LLCTL==3 ;Awaiting Control or Accomp
.LLDAT==4 ;Awaiting Data or Accomp
.LLACP==5 ;Awaiting Accomp
CP==14 ;Holds link data page address
DL==15 ;Address of current msg header
AP==16 ;Address of callers arguments
;CONSTANTS FOR COMPILATION
FP%SLF==77B23 ;Owner protection mask
FP%GRP==77B29 ;Group protection mask
FP%WLD==77B35 ;Wild protection mask
FFSPEC==<FLD(1,JS%DEV)+FLD(1,JS%DIR)+FLD(1,JS%NAM)+FLD(1,JS%TYP)+FLD(1,JS%GEN)+JS%PAF>
ND OURKON,25256 ;Hours constant worth of bits
ND CCTIME,2 ;Wait time for Connect confirm
ND MAXLNK,1 ;Maximum number of logical links
ND DPMXM,^D512/2*^D9+^D100 ;Maximum Dap message size
ND DPMXMV,^D512/2*^D6+^D100 ;MAX DAP MESSAGE SIZE FOR VMS HOST
ND DPMXH,^D8 ;Maximum Dap header size
ND LLMXF,^D40 ;MAX LENGTH OF FILESPEC STRING
ND FILMAX,^D40 ;[111]MAX NUM OF FILES TO PROCESS BEFORE
;[111]A SNDQUE IS DONE TO FREE CORE
IFE MAXLNK-1,<DEFINE MULINK <IFE -1,>>
IFG MAXLNK-1,<DEFINE MULINK <IFE 0,>>
;Contants for this implimentation
XP CAP1,SY$SEQ+SY$SQA+SY$BLK+SY$UBK+SY$LN2+SY$EXE+SY$DTI+SY$PRO+SY$BCT+SY$DIR+SY$SUB+SY$SPL+SY$DEL+SY$CRC+SY$VBN
XP CAP2,SY$WLD+SY$NAM
XP DAPVER,<BYTE (8) .DVMAJ,.DVMIN,.DVUSR,.DVSFT>
SUBTTL IMPURE storage
.PSECT DATA ;Load where FAL or NFT left off
DEFINE $DATA (NAME,SIZE<1>) <
NAME: BLOCK SIZE
..LOC==.>
$DATA DAPFRM,1 ;USER PDL FRAME
$DATA DAPFLG,1 ;DAP FLAGS FROM D$INIT
$DATA LGAPTR,1 ;[160]Pointer to account string
$DATA LGUPTR,1 ;[160]Pointer to username
$DATA LOGACT,10 ;[160]Current account string
$DATA LOGUSR,10 ;[160]Username
$DATA MSGDSG,1 ;DAP Message designator
$DATA LNKPGS,MAXLNK ;Per link storage address
MULINK <
..LOC==0 ;Start at offset 0
DEFINE $DATA (NAME,SIZE<1>) <
..DEF (NAME,\..LOC)
..LOC==..LOC+SIZE>
DEFINE ..DEF (NAME,OFFSET) <
DEFINE NAME <OFFSET(CP)>>
> ; End MULINK
SUBTTL STORAGE allocated per logical link
;This part of the per link data contains Logical Link variables
;If there is more than 1 link allowed then reference all variables
; by index register (cp) else allocate storage directly
$DATA LNKBEG,0 ;Start of per link storage
$DATA SAVPNT,1 ;[136]BYTE POINTER FOR NAME CONV
$DATA BUFFUL,1 ;[142]BUFFER FULL FLAG
$DATA DELFLG,1 ;[137]FILE DELETED FLAG
$DATA CONBLK,^D14 ;[121]CONNECT BLOCK FOR PMR
$DATA FILCNT,1 ;[111]COUNT OF FILES PROCESSED
$DATA WLDSAV ;[112]SAVE WILD BITS ARE DIR SERVER
$GDATA MESIN,1 ;[134]MESSAGES RECEIVED
$GDATA MESOUT,1 ;[134]MESSAGES SENT
$DATA INTHAP,1 ;[154]INTERRUPT HAS OCCURED
$DATA LLOPNB,.DOSIZ ;COPY OF LINK OPEN BLOCK
FTACL < $DATA NOACCT,1 ;[167] -1 remote user didn't send acct
$DATA ACLPID,1 > ;[167] Access Control process PID
$DATA CAPIBL,1 ;Enabled capiblities of FAL if enabled
$DATA DIRNUM,1 ;Directory number
$DATA USRNUM,1 ;User number
$DATA LLJFN ;JFN FOR LOGICAL LINK
$GDATA LLSTAT ;[134]Last link status from LLCHK
$DATA LNKSTS ;Link status and state from S
$DATA MSGFLG ;-1 says message awaiting processing
$DATA SNDFLG ;-1 says send in progress
$DATA INTFLG ;-1 says we have unprocess interrupt
$DATA LLDISC,20 ;Disconnect cause stored here
$DATA CLSBLK,2 ;Block for closing link
$DATA LLNAME,^D45 ;JFNS STRING FOR LL JFN
$DATA RCVLST ;Index for receive list
$DATA SNDLST ;Index for send list
;Send/Recieve Queue header offsets
.DPTYP==0 ;TYPE FIELD FROM MESSAGE
.DPFLG==1 ;DAP message HEADER flags
.DPLEN==2 ;Starting size of buffer
.DPSID==3 ;DAP message HEADER Stream ID field
.DPBCT==4 ;DAP message HEADER bit count field
.DPCNT==5 ;Number of bytes left in buffer
.DPBPT==6 ;Pointer to DAP message
.DPHDR==7 ;Two words in which to build header
.DPSIZ==11 ;Number of words in List header area
$DATA REMOST ;[106]Remote operating system type
$DATA DAPBEG,0 ;Start of area to clear before config
; messages have been exchanged on the
; logical link. The area begins here
; and continues until the end of the
; storage defined for the configuration
; message on the next page.
$DATA OURVER ;Mutually lowest DAP version supported
$DATA OURCAP,2 ;Mutual capabilities of both ends
$DATA OURDSP ;Mutual attributes display bits
$DATA OURMRS ;Mutual Maximum record size
$DATA OURSIZ ;Mutual maximum buffer size
;This part of the per link data contains the parsed fields
;from each DAP message.
;Field names will have the following format:
; MSGFLD Where:
; MSG is the three character message name (CFG for config,
; ATT for Attributes, etc)
; FLD is the three character field name (BSZ for bytesize,
; RCN for record number, etc)
;The DAP messages are defined in DAPSYM.MAC with the following field
;types
;Define macro to allocate storage for all DAP message fields.
DEFINE XX (MSG,VAL,NAME,FLAG) <
MSG'$ST==..LOC ;;Define start of message offset
MSG'$LN==0 ;;Define message storage length
MSG'$FC==0 ;;Define message argument count
DEFINE VV (VER) <> ;;Ignore version comparison this pass
DEFINE YY (FLD,TYP,SIZ,DEF) <
LN==1
IFIDN <TYP><MNU>,<LN==<SIZ*7>/^D36+1> ;;[104]Menu stored 35 bits per word
IFIDN <TYP><EXF>,<LN==<SIZ*7>/^D36+1> ;;[104]Exf stored 35 bits per word
IFIDN <TYP><BYT>,<LN==<SIZ*8>/^D33+1> ;;[104]Fix stored 4 bytes per word
IFIDN <TYP><VAR>,<LN==<SIZ*7>/^D35+1> ;;[104]Var stored 5 bytes per word
IFIDN <TYP><INT>,<LN==<SIZ*8>/^D33+1> ;;[104]Int stored 4 bytes per word
;;All else requires 1 word
MSG'$LN==MSG'$LN+LN ;;Accumulate message storage length
MSG'$FC==MSG'$FC+1 ;;Accumulate field count
$DATA MSG''FLD,LN>
> ;End of XX definition
;Allocate storage for all message arguments
XLIST
DOMSG
LIST
DAPSIZ==<ATTMNU>-<DAPBEG> ;Size of area to clear befor Config
; Message is exchanged
LNKSIZ==<ATTMNU>-<LNKBEG> ;Size of area to clear before Opening
; Logical link
;This section of per link storage contains storage for all DAP messages
; (except the CONFIG message) file variables and miscellaneous storage.
;Area to be cleared for each function
; Begins with Attributes message storage
; and continues thru end of this page
;Attributes message fields saved for FAL's wild ACCESS (Open)
$DATA ATTSAV,ATT$LN
;RAC field from control message saved for every CONTROL
$DATA RACSAV
;Data modes for this access
$DATA SRCMOD ;Mode of source file
$DATA DSTMOD ;Mode of destination file
;[163]Flag to signal if we have opened a file for this ACCESS
$DATA FILFLG,1 ;[163]
;Local file variables
$DATA PAGBP ;[130]BYTE POINTER INTO PMAP PAGE
$GDATA PAGNUM ;[130]NEXT FILE PAGE TO PMAP
$DATA PAGMEM ;[151]PAGE NUMBER OF MAPPED PG IN MEMORY
$DATA PFBSIZ ;[130]BYTE COUNT
$DATA EOFCNT ;[130]EOF BYTE NUMBER
$DATA LINNUM ;[130]LINE NUMBER CHARACTER FLAG
$DATA LINFLG ;[150]LINE NUMBERED FILE FLAG
$DATA PAG1 ;[130]MARKER TO LOCATE END OF PAGE
$DATA JFNBLK,20 ;GTJFN Block
$GDATA LOCJFN ;[134]JFN of local file + original flags
$DATA WLDJFN ;Wild card JFN to hold changed flags
$DATA LOCDEV ;Device characteristics for local file
$DATA OPNFLG ;Flags and BSZ for local file open
$GDATA PAGFLG ;[134]-1 if doing page mode I/O IN BLOCK MODE
;0 IF NO PMAPS
;1 IF PMAPS, BUT NOT BLOCK MODE
$DATA CRCFLG ;-1 if we are computing CRC
$DATA ACPFLG ;-1 says caller requested ACCOMP
$DATA FILCRC ;Computed CRC
$DATA FILFOP ;File options from attributes
$DATA LOCFDB,.FBLEN ;FDB Data for local file
;MACY11 format storage and flags
$DATA MCYIDX ;Non-zero if doing MACY11 mode
$DATA MCYDAT ;Last MACY11 word read
;Remote file variables
$DATA ATTFDB,.FBLEN ;FDB data from remote file (directory)
;Status text storage
$DATA STSTXT,20 ;Dap status text stored here
$DATA MSGJNK,10 ;Junk string field to dump stuff into
$DATA SNDSAB,SAB.SZ
$DATA MSGPTR,1 ;Pointer to log message char
$DATA MSGCNT,1 ;Remaining room in MSGTXT
;IPCF message area
$DATA MSGHDR,MSHSIZ ;Message header area
$DATA MSGARF ;Message argument flags
$DATA MSGARC ;Message argument count
$DATA MSGARH ;Message argument header
$DATA MSGTXT,200 ;Message body goes here
$DATA FNCEND,0 ;End of per function area
FNCSIZ==<FNCEND>-<ATTMNU> ;Size of per function storage
; Last word to be cleared per function
NLLPGS==<..LOC/1000>+1 ;Number of pages allocated for each
; Logical link
DATEND:: .ENDPS DATA ;End of impure storage
SUBTTL Version number and entry vector
;DECLARE VERSION AND ENTRY VECTOR
LOC 137 ;SET THE VERSION
RELOC
.JBVER: EXP VDAP20
PMRFLG:: 0 ;[121]NO PMR IN SUPPORTED VERSION
;ENTRY VECTOR DEFINITION
ENTVEC: EXP 0 ;NO START ADDRESS
EXP 0 ;NO REENTER ADDRESS
EXP VDAP20 ;VERSION OF DAP20 PROGRAM
SUBTTL DAP message descriptor blocks
;Each message descriptor fully describes the message format
;and storage for the various fields. All message types
;are defined here via the DOMSG macro in DAPSYM
;The Message Header values were obtained from the previous expansion of
;DOMSG to allocate storage for the message fields.
; =======================================
;MSGMSD:! .DMMSG ! [ASCIZ\Name\] ! (Message descriptor)
; !--------------------------------------
; ! MSG$LN ! MSG$ST !
; !--------------------------------------
; ! Message Flags ! MSG$FC !
; !=====================================!
; ! Flags! TYP ! SIZ ! Storage offset ! (Field descriptor)
; !--------------------------------------
; ! Version Check word if DA%VER was on !
; ! OR !
; ! Field default word if DA%DEF was on !
; !-------------------------------------!
; \ \
; \ Field descriptors for each field \
; \ \
; =======================================
;Message flag definitions
DA%NOZ==1B0 ;Dont zero message on recieve
;Field descriptor flag and field definitions
DA%VER==1B0 ;Version check word is present
DA%DEF==1B1 ;Field default word is present
DA%TYP==77B8 ;Argument type field
DA%SIZ==777B17 ;Maximum argument size in message bytes
DA%STG==777777B35 ;Argument storage offset
;Where .DMMSG numeric message type
; MSG$LN Length of message argument storage
; MSG$ST Starting offset of message argument storage
; MSG$FC Number of fields message may contain
;Define a macro to define version check word value to limit our
;menu for cantankerous implimentations...
DEFINE VV (VER) <%%VV(VER)>
DEFINE %%VV(VER,ECO,USR,SFT,OST) <
EXP DA%VER ;;Flag this is a version word
BYTE (8) VER,ECO,USR,SFT (4) OST>
;Define a macro to build message descriptor header
DEFINE XX (MSG,VAL,NAME,FLAGS<0>) <
MSG'MSD: XWD .DM'MSG,[ASCIZ\NAME\]
XWD MSG'$LN,MSG'$ST
EXP FLAGS+MSG'$FC
;;Define a macro to build argument descriptors
DEFINE YY (FIELD,TYP,SIZ,DEF) <
%%YY==FLD(.AR'TYP,DA%TYP)+FLD(SIZ,DA%SIZ)+FLD(MSG''FIELD,DA%STG)
IFB <DEF>,<
EXP %%YY>
IFNB <DEF>,<
EXP %%YY+DA%DEF
EXP DEF>
> ;End of YY definition
> ;End of XX definition
;Expand message descriptors for each defined message type
XLIST
DOMSG ;;Expand message descriptors
LIST
SUBTTL DAP message argument types and processor table
;DAP message argument types are described below.
;There are two processors associated with each argument type. The
;Argument processors are responsible for converting DAP format to
;internal format (GET) and from internal format to DAP format (PUT)
;MNU Field is a menu which determines which message fields follow
; Menu's are stored as extensible fields and cause 1 word of
; storage to be reserved for every 5 DAP bytes
;EXF Field is an extensible field which is generally used as a bit
; map of specific options requested or a menu of message fields
; which follow. Extensible fields have 7 information bits per
; DAP byte and are stored as 36 information bits per word.
; Bit 35 is the least significant bit of the extensible field.
;FIX Field is a Byte or group of Bytes. Dap Bytes are stored
; right justified 4 per 36 bit word.
;INT Field is a variable length unsigned integer. The DAP field
; is stored as a 36 bit integer value
;VAR Field is a variable length Ascii field. It is stored as an
; ASCIZ string of 7 bit bytes.
;PRO Field is a file protection field. Dap protection codes are
; translated to system protection mask.
;DTI Field is an 18 byte Date/time argument. This field is stored
; internally as a 36 bit quantity.
;IMA Field is an image field of a DATA message. This field is not
; stored, but is processed by the apporpriate data processor
;Define a macro to generate argument processor table entries
; and define values for argument type symbols
DEFINE XX (TYP,CNT) <
.AR'TYP==ZZ
ZZ==ZZ+1
XWD GET'TYP,PUT'TYP>
;Build the argument processor table
ZZ==0 ;Start with argument type 0
ARGTBL: XLIST
MSGARG ;Expand argument processor table
LIST
SUBTTL Local macro definitions
;MACRO TO GENERATE STATUS CODES
DEFINE $STATUS (MAC,MIC,MIC2) <
IFB <MIC2>,<MOVX S1,FLD(MAC,ER%MAC)+FLD(MIC,ER%MIC)>
IFNB <MIC2>,<MOVX S1,FLD(MAC,ER%MAC)+FLD(MIC,ER%TYP)+FLD(MIC2,ER%FLD)>
SETZM S2>
;MACRO TO GENERATE MESSAGE FORMAT ERRORS
DEFINE $MFERR (TYP,FLD) <
JRST [$STATUS ER$FMT,TYP,FLD
$RETF]>
;MACRO TO GENERATE MESSAGE SYNC ERRORS
DEFINE $MSERR (TYP) <
JRST [$STATUS ER$SNC,TYP
$RETF]>
;MACRO TO GENERATE MESSAGE FIELD ERRORS
DEFINE $MIERR (TYP,FLD) <
JRST [$STATUS ER$INV,TYP,FLD
$RETF]>
;MACRO TO GENERATE UNSUPPORTED MESSAGE FEATURES ERRORS
DEFINE $MUERR (TYP,FLD) <
JRST [$STATUS ER$USP,TYP,FLD
$RETF]>
;MACRO TO GENERATE TRANSFER STATUS ERROR MESSAGES
DEFINE $MTERR (TYP) <
JRST [$STATUS ER$TRN,TYP
$RETF]>
DEFINE $MOERR (TYP) <
JRST [$STATUS ER$OPN,TYP
$RETF]>
DEFINE $MCERR (TYP) <
JRST [$STATUS ER$TRM,TYP
$RETF]>
;MACRO TO CHANGE DAP STATE AND MESSAGE DISPATCH
DEFINE $STATE (VAL) <MOVX S,S%INIT+VAL>
;OPDEF TO RETURN FALSE IF FALSE
OPDEF $RETIF [JUMPF .POPJ]
;OPDEF TO RETURN TRUE IF TRUE
OPDEF $RETIT [JUMPT .POPJ]
;MACRO TO GENERATE POINTER TO TEXT
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
GETTER: MOVEI S1,.FHSLF ;Get my last JSYS error
GETER
ERJMP .+1
HRRZ S2,S2 ;Return code in S2
$RETT
SUBTTL $DEBUG Macro to display debugging message
DEFINE $DEBUG (MSG,ITXT,%L1) <
SKIPE MSGDSG
$CALL [$TEXT (DEBUG,<[^Q/%L1/ITXT]>)
$RET
%L1:! TXT<MSG>]
SUPPRESS %L1
> ;End of $DEBUG
DEFINE $FATAL (MSG,ITXT,%L1) <
$CALL [$TEXT (,<?^Q/%L1/ITXT>)
PJRST FATAL
%L1:! TXT<MSG>]
SUPPRESS %L1
> ;End of $FATAL
DEFINE $WARN (MSG,ITXT,%L1) <
$CALL [$TEXT (,<%^Q/%L1/ITXT>)
$RET
%L1:! TXT<MSG>]
SUPPRESS %L1
> ;End of $WARN
SUBTTL DEBUG and TYPER output routines
;DEBUG Text output routine for $DEBUG macro
DEBUG: MOVE S2,MSGDSG ;[154]
EXCH S1,S2 ;Setup for bout
BOUT
$RETT
;Routine to Type text and ITEXT
;Accepts S1/ Output designator
; S2/ Pointer to asciz text
; T1/ Address of ITEXT
; T2/ Prefix character
TYPER: TRVAR <TXTBP,<TMPTXT,^D30>> ;Save some space
EXCH T2,S2 ;Get prefix character
SKIPE S2 ;Any desired?
BOUT ;Yes..dump it
MOVE S2,T2 ;Restore text pointer
MOVE T2,[POINT 7,TMPTXT] ;Get a pointer
MOVEM T2,TXTBP ;Save for DEPBP
SKIPE T1 ;Any ITEXT?
$TEXT (DEPBP,<^Q/S2/^I/(T1)/>^0) ;Yes..get it
SKIPN T1 ;Any ITEXT?
$TEXT (DEPBP,<^Q/S2/>^0) ;No..just do string
HRROI S2,TMPTXT ;Get source designator
SETZM T1 ;Terminate on a null
SOUT
$RETT
DEPBP: IDPB S1,TXTBP ;Store per TEXT Byte Pointer
$RETT
SUBTTL $GODAP Macro to establish DAPLIB context
DEFINE $GODAP (SAVLST) <
LSTOF.
IFNB <SAVLST>,<$SAVE <S,SAVLST>>
IFB <SAVLST>,<$SAVE <S>>
LSTON.
JSP TF,GODAP>
MULINK <
DEFINE $GODAP (SAVLST) <
LSTOF.
IFNB <SAVLST>,<$SAVE <S,CP,SAVLST>> ;SAVE AC'S
IFB <SAVLST>,<$SAVE <S,CP>> ;JUST SAVE STATUS AND CP
LSTON.
JSP TF,GODAP>
> ;End MULINK
;GODAP is called upon entry to DAPLIB by the various routines
; It sets up CP and S which are used throughout DAPLIB
; to reference the logical link storage and status.
; All returns to the calling program go through GOUSR
; which preserves the contents of S which holds the
; last known link status.
;Accepts S1/ Link index
;Returns CP/ Address of link storage
; S/ Last known link status
GODAP: MOVEM P,DAPFRM ;Save frame for Error return
MOVEI S1,(S1) ;Get right half only
CAIL S1,1 ;CHECK ENTRY LIMITS
CAILE S1,MAXLNK
$FATAL (Invalid link index)
MULINK <
SKIPG CP,LNKPGS-1(S1) ;Point to per/link storage
$FATAL (Logial link not established)
>
MOVE S,LNKSTS ;Get proper link status flags
PUSH P,[GOUSR] ;Stack return address
MOVEM P,DAPFRM ;Save frame for error return
JRST @TF ;Back to our caller
GOUSR: MOVEM S,LNKSTS ;Save link status
$RET ;No..Return True/False per routine
FATAL: MOVEI S1,.DCX38 ;User abort
MOVX S2,TXT(Fatal error)
$CALL D$CLO1 ;Close the link
MOVE P,DAPFRM ;Restore frame
$RETF ;Back thru GOUSR
SUBTTL D$INIT Daplib initialization
;Accepts S1/ Size of initialization block
; S2/ Address of initialization blocl
D$INIT::$SAVE <P1> ;Preserve an AC
MOVEM P,DAPFRM ;Save in case of error
CAIE S1,.DISIZ ;Proper arg block size?
$FATAL (Invalid argument block length for D$INIT)
MOVE S1,.DIFLG(S2) ;Get flags
MOVEM S1,DAPFLG ;Save them
MOVE S1,.DIMSG(S2) ;GET message designator
MOVEM S1,MSGDSG ;Save it
LOAD S1,DAPFLG,DI%CNT ;Get count to allocate
CAILE S1,MAXLNK ;Check range
$FATAL (Too many links requested)
MOVNS S1 ;Negate count
HRLZ P1,S1 ;Put it in P1
MULINK <
D$INI1: MOVX S1,NLLPGS ;Get count of pages per link
$CALL M%AQNP ;Get them
PG2ADR S1 ;Convert to address
MOVEM S1,LNKPGS(P1) ;Store in proper place
AOBJN P1,D$INI1 ;Do all requested
> ;End MULINK
LOAD S1,DAPFLG,DI%PGM ;[160]Get program code
CAIE S1,%PGNFT ;[160]Are we NFT?
JRST D$INI2 ;[160]No, we don't need this info
SETO S1, ;[160]Yes. -1 is our job
MOVE S2,[POINT 7,LOGACT] ;[160]Point to account string buffer
MOVEM S2,LGAPTR ;[160]Save the pointer
GACCT ;[160]Get our current account
GJINF ;[160]Get our user number
MOVE S2,S1 ;[160]Prepare for DIRST call
MOVE S1,[POINT 7,LOGUSR] ;[160]Point to username buffer
MOVEM S1,LGUPTR ;[160]Save the pointer for later
DIRST ;[160]Translate user number to string
SETZM LGUPTR ;[160]Gag... forget about username
D$INI2:
$RETT
SUBTTL D$OPEN Establish a logical link
;Accepts S1/ Size of argument block (.DOSIZ)
; S2/ Address of Argument block
;Returns TRUE S1/ Link index
; FALSE S1/ Dap error code
D$OPEN::$SAVE <AP,CP>
MOVEM P,DAPFRM ;Save for error
MOVE AP,S2 ;Save argument address
CAIE S1,.DOSIZ ;SIZE MATCH?
$FATAL (Invalid argument block length for D$OPEN)
SKIPE PMRFLG ;[121]IF DOING PMR...
SETOM PMRFLG ;[121]...SET FLAG TO -1
LOAD S1,.DOFLG(S2),DO%LNK ;Get requested link index
D$OPN2: $GODAP <T1,T2,T3,T4> ;Get link context
MOVEI S1,LNKSIZ ;Clear Link area
MOVEI S2,LNKBEG ;...
$CALL .ZCHNK
MOVEI S1,LLOPNB ;Point to OPEN block
HRLI S1,(AP) ;Point to Argument
BLT S1,.DOSIZ-1+LLOPNB ;Copy calling argument
MOVEI AP,LLOPNB ;Point to our copy
FTACL < PUSHJ P,GETACL > ;[167] Get ACL's PID
MOVE S1,.DONOD(AP) ;[106]Address of the node block
ND$OST==3 ;[106]symbol local to NFT
HRRZ S1,ND$OST(S1) ;[106]OS type
MOVEM S1,REMOST ;[106]Save it for config mess
$CALL L%CLST ;Create receive list
JUMPE S1,.-1 ;Fudge if first list is 0
MOVEM S1,RCVLST ;Remember index
JUMPE S1,.-1 ;Should never happen
$CALL L%CLST ;Create send list
MOVEM S1,SNDLST ;Remember index
$CALL LLGJFN ;Go get proper JFN
$CALL LLOPEN ;Open and attach to PSI
MOVE S1,.DOFLG(AP) ;Get the flags
TXNE S1,DO%WCN ;Wait for a connection?
$CALL LLWCON ;Yes.. go wait for it.
$RETT
SUBTTL D$INTR Interrupt processing routines
;Accepts S1/ Link index
; S2/ Interrupt cause
D$INTR::$GODAP <DAPFRM> ;Save current frame
SETOM INTHAP ;[154]INTERRUPT HAS OCCURED
MOVX S1,PC%USR ;Get user mode bit
SKIPE SNDFLG ;In LLSEND routine?
IORM S1,LEV1PC ;Yes..interrupt SOUT(r)
SETOM INTFLG ;Say we've seen an interrupt
CAIN S2,.DICDN ;Connect interrupt?
PJRST CICON ;Yes..process it
CAIN S2,.DIINA ;Interrupt message?
PJRST PSIIM ;Yes..read the message
; CAIN S2,.DIDAV ;Data available?
; SETOM MSGFLG ;Yes..Flag it
CAIN S2,.DIACP ;Want to force ACCOMP?
SETOM ACPFLG ;Yes..Flag it
$RETT ;Return
SUBTTL D$CLOS Routine to close logical link
;Accepts S1/ Link index
; S2/ Address of reason block
;Reason block Length,,NSP disconnect code
; Pointer to optional data to be sent
;Returns TRUE Link has been closed
D$CLOS::$GODAP <T1,T2,T3,T4> ;Get link context
SKIPN LLJFN ;Have a JFN?
JRST FATAL ;[113]
MOVE S1,.DCCOD(S2) ;Get the reason code
TLNN S1,-2 ;Optional data specified?
TDZA S2,S2 ;No..clear pointer
MOVE S2,.DCPTR(S2) ;Yes..get the pointer
$CALL D$CLO1 ;[162]
SETZM LLSTAT ;[162][134]CLEAR LLSTAT FOR ^A DISPLAY
$RETT ;[162]
D$CLO1: SKIPE LLJFN ;Still have JFN?
$CALL LLCLOS ;Yes..Close the link
SKIPE S1,RCVLST ;Get receive list index
$CALL L%DLST ;Destroy it
SETZM RCVLST ;Mark it deleted
SKIPE S1,SNDLST ;Get send list index
$CALL L%DLST ;Destroy it
SETZM SNDLST ;Mark it deleted
SKIPE LOCJFN ;Still have JFN?
$CALL ABTFIL ;Yes..abort file operation
SKIPE LOCJFN ;Still have JFN?
$CALL RELJFN ;Yes..release it
$RETT
SUBTTL D$STAT Display link status
;Accepts S1/ Link index
;Returns TRUE S1/ Link status
; Link is open
; FALSE S1/ Link status
; Link is not open
D$STAT::$GODAP <S2,T1> ;Get link context
$CALL LLCHK ;Get the link status
$RET ;Return status to user
SUBTTL D$FUNC Daplib routine to perform a File function
;Accepts S1/ Function block size
; S2/ Address of function block
D$FUNC::MOVEM P,DAPFRM ;Save for errors
CAIE S1,.DFSIZ ;Proper size arg
$FATAL (Invalid argument block length for D$FUNC)
LOAD S1,.DFFLG(S2),DF%LNK ;Get reqested link
SKIPN S1 ;link specified?
SETO S1, ;No..use current
$GODAP <T1,T2,T3,T4,DL,AP> ;Set link context
MOVE AP,S2 ;Point to calling args
$CALL LLWCON ;No..wait for it
TXNE S1,MO%SRV ;Is it a server?
PJRST SRVMSG ;Yes..Process server messages
MOVEI S1,FNCSIZ ;Clear per function storage
MOVEI S2,ATTMNU ;...
$CALL .ZCHNK ;...
SKIPE S1,.DFLFA(AP) ;Get local file switches
$CALL SWLOOK ;Find them
JUMPF [$FATAL (Invalid switches for local file)]
MOVEM S1,SRCMOD ;Assume local node is Source.
SKIPE S1,.DFRFA(AP) ;Get remote file switches
$CALL SWLOOK ;Find them
JUMPF [$FATAL (Invalid switches for remote file)]
MOVE S2,SRCMOD ;Put local mode in S2
LOAD T1,.DFFLG(AP),DF%ACC ;Get our function
CAIN T1,AF$CRE ;Creating remote file?
EXCH S1,S2 ;Yes..S1=Local S2=Remote
MOVEM S1,SRCMOD ;Save source mode
MOVEM S2,DSTMOD ;Save destination mode
$CALL CHKMOD ;Check for valid mode
JUMPF [$FATAL (Can't do requested file format conversion)]
PJRST DAPDCN
SUBTTL SRVMSG Server initialization and tables
SRVMLS: SRVS00,,SRVI00 ;Server .LLCFG state
SRVS01,,SRVI01 ;Server .LLACC state
SRVS02,,0 ;Server .LLATT state
SRVS03,,0 ;Server .LLCTL state
SRVS04,,0 ;Server .LLDAT state
SRVS05,,SRVI05 ;Server .LLACP state
;Message dispatch for .LLCFG state
SRVS00: .DMCFG,,SRVCFI ;Accept only Config message
0
;Message dispatch for .LLACC state
SRVS01: .DMCFG,,SRVCFG ;Process Config
.DMACC,,SRVACC ;Process Access
.DMATT,,VALATT ;Process Attributes
0
;Message dispatch for .LLATT state
SRVS02: .DMDTI,,VALDTI ;Process Date/time Attributes
.DMPRO,,VALPRO ;Process Protection Attributes
.DMACC,,SRVACC ;Process Access
0
;Message dispatch for .LLCTL state
SRVS03: .DMCTL,,SRVCTL ;Process Control
.DMACP,,SRVACP ;Process ACCOMP
0
;Message dispatch for .LLDAT state
SRVS04: .DMDAT,,[$RETT] ;Processed by GETDAT
.DMACP,,SRVACP ;Process ACCOMP
0
;Message dispatch for .LLACP state
SRVS05: .DMACP,,SRVACP ;Process ACCOMP
0
SUBTTL Server state initialization routines
;Initialization for .LLCFG state
SRVI00: MOVEI S1,DAPSIZ ;Clear Config storage
MOVEI S2,DAPBEG ;...
$CALL .ZCHNK ;...
MOVEI S1,DPMXM ;Set default Max message size
MOVEM S1,OURSIZ ;Save for first message
$RETT
;Initialization for .LLACC state
SRVI01: SKIPE LOCJFN ;Clean up any previous file ops
$CALL ABTFIL
SKIPE LOCJFN
$CALL RELJFN
MOVEI S1,FNCSIZ ;Clear per function area
MOVEI S2,ATTMNU ;...
$CALL .ZCHNK
MOVX S1,TXT(PS) ;Set default device to PS:
MOVEM S1,.GJDEV+JFNBLK ;...
MOVE S1,.DOUSR+LLOPNB ;Set default directory to user
MOVEM S1,.GJDIR+JFNBLK ;...
MOVE S1,[.NULIO,,.NULIO] ;Set null string input
MOVEM S1,.GJSRC+JFNBLK ;...
$RETT
;Initialization for .LLACP state
SRVI05: TXZ S,S%EOF!S%GET!S%PUT ;Clear data flags
$RETT
SUBTTL SRVMSG Server message processing loop
SRVMSG: $CALL SNDQUE ;Dump the send queues
JUMPF [$CALL LLRECV ;Check for incomming message
JRST SRVMSG] ;Finish sending messages
TXZE S,S%RETN ;Time to return?
$RET ;Yes..return to caller
TXZN S,S%INIT ;State just change?
JRST SRVMS1 ;No..skip initialization
HRRZ S1,SRVMLS(S) ;Do state initialization
JUMPE S1,SRVMS1 ;If routine is present
$CALL 0(S1)
JRST SRVMSG ;Back to send again
SRVMS1: SKIPE MSGFLG ;[0130]If we have a message
JRST SRVMS2 ;[0130]Don't call LLCHK
TXNN S,S%GET ;[154]NEED A MESSAGE?
JRST SRVMS2 ;[154]YES, GET IT
SKIPE INTHAP ;[154]DID AN INTERRUPT OCCUR?
$CALL LLCHK ;Check link status
SKIPF MSGFLG ;[154]Message available
JRST SRVMS2 ;Yes..process a message
$CALL FILGET ;Get and send data record
JUMPF SRVMS3 ;Go send the status
TXNE S,S%EOF ;Did we see EOF?
$CALL SNDEOF ;Yes..send EOF status
JRST SRVMSG ;Back to send next message
SRVMS2: HLRZ S1,SRVMLS(S) ;Get proper message list address
$CALL GETMSG ;Get a message
JUMPF SRVMS3 ;Send failing status
JRST SRVMSG ;Process next message
SRVMS3: $CALL SNDSTS ;Send status from routine
$STATE .LLACC ;Back to initial Access state
$CALL ENABLE ;Make sure we are enabled
JRST SRVMSG
SUBTTL SRVCFI Server routine to process Initial config message
SRVCFI: $CALL SRVCFG ;Validate and return config
$RETIF ;Return failing status
$STATE .LLACC ;Move to access state
$RETT
SUBTTL SRVCFG Server routine to Process Config message
SRVCFG: $CALL VALCFG ;Validate the message
$RETIF ;Return failing status
$CALL SNDCFG ;Send our config message
$RETT
SUBTTL SRVACC Server routine to process an ACCESS message
SRVACC: $CALL ENABLE ;No..make sure we are wheel
MOVE S1,ACCFNC ;Get the Function field
CAIL S1,AF$OPN ;Is it valid
CAILE S1,AF$EXE
$MUERR .DMACC,20 ;No..return unsupported
HRRO S2,FNCTXT-AF$OPN(S1) ;
$TEXT (,<^Q/S2/>) ;
MOVX S1,POLINI ;Initilize CRC to -1
MOVEM S1,FILCRC
MOVE S1,ACCOPT ;Get the options
TXNE S1,AO$CRC ;Want to compute CRC
SETOM CRCFLG ;Yes..remember that for all data
TXNE S1,AO$RSS!AO$RSR!AO$GO ;Anything we don't support?
$MUERR .DMACC,21 ;Yes..return unsupported
MOVE S1,.DFLFS(AP) ;Point to user storage
HRROI S2,ACCFIL ;Point to Access filespec
$CALL CPYSTR ;Copy the name
MOVE S1,.DFLFS(AP) ;[117]POINT TO FILE NAME
MOVEI T1,"." ;[117]A PERIOD
SRVAC1: ILDB S2,S1 ;[117]GET A BYTE
JUMPE S2,SRVAC2 ;[117]END OF STRING?
CAIN S2,";" ;[117]A SEMI COLON?
DPB T1,S1 ;[117]CHANGE TO A PERIOD
JRST SRVAC1 ;[117]KEEP LOOKING
SRVAC2: LOAD S1,ACCFNC ;[117]Get desired access
JRST @ACCTBL-AF$OPN(S1) ;Dispatch to processor
ACCTBL: JRST SRVOPN ;Open existing files
JRST SRVCRE ;Create a new file
$MUERR .DMACC,20 ;Rename (Unsupported)
JRST SRVDEL ;Delete files
$MUERR .DMACC,20 ;Resrvd (Unsupported)
JRST SRVDIR ;Directory of files
JRST SRVSUB ;Submit file on close
JRST SRVEXE ;Execute files
FNCTXT: [ASCIZ /Opening an existing file/]
[ASCIZ /Creating a new file/]
[ASCIZ /Renaming a file (unsupported)/]
[ASCIZ /Deleting files/]
[ASCIZ /Reserved function (unsupported)/]
[ASCIZ /Directory list/]
[ASCIZ /Create new file then submit on close/]
[ASCIZ /Submit existing file/]
SUBTTL SRVOPN Server routine to process ACCESS (Open)
;SRVOPN is called while processing an Access(Open). It is
; responsible for ensuring that FAL can open the specified
; file in the mode requested by the attributes message.
; Since DAP file attributes are not stored as in integral
; part of the file header (FDB) it is up to the requestor
; to specify how the file is to be opened.
; The following rules apply to opening files:
; 1) If the requestor has sent an attributes message
; which specifies a non-native file access mode, the
; specified file will be opened in image mode using the
; actual file bytesize.
; 2) If the requestor has sent an attributes message
; which specifies a native file access mode the file
; will be opened using the bytesize demanded by that
; data mode. (Image mode allows the user to specify
; the bytesize to use when openning the file)
; 3) If the requestor has sent an attributes message
; which specifies Image mode but has excluded the bytesize
; attribute the actual file bytesize will be used for the
; open.
;In all cases the attributes returned to the requestor reflect the
;current openning of the file. (i.e if the requestor wants to see
;the file data as a 36 bit image data but the files bytesize is actually
;7 bits per byte, the attributes returned will say the file is a 36
;bit file since the data will be returned in this fasion.)
;DAP allows the user to use wild cards in the initial ACCESS (Open).
;In this case each file will be opened according to the initial
;attributes message if the requested mode is legal for that file. If
;the initial mode is not legal for a particular file (e.g the files
;bytesize does not match what is reqired for the data processor) the
;file will be opened in Image mode.
SRVOPN: $CALL SETINP ;Setup for file input
$RETIF
MOVE S1,ATTMNU ;Get menu bits
TXNN S1,AT$DAT ;Data mode specified?
SETZM ATTDAT ;No..clear bogus default
TXNN S1,AT$RFM ;Record format specified?
SETZM ATTRFM ;No..clear bogus default
TXNN S1,AT$BSZ ;Bytesize specified?
SETZM ATTBSZ ;No..clear bogus default
SKIPN WLDJFN ;Is this a wild open?
JRST SRVNXT ;[131]No..process the request
HRLI S1,ATTMNU ;Yes..Save original attributes
HRRI S1,ATTSAV
BLT S1,ATT$LN+ATTSAV-1 ;[163]
PJRST SRVNXT ;Fall into common wild open code
;[131] SRVNXT is the entry for an ACCESS (Open)
;[131] Delete one line at SRVNXT, rename label SRVNX1 to be SRVNXT
;SRVNXT: $CALL SNDWLD ;[131]Move WILD routine
SRVNXT: SKIPN WLDJFN ;[163]Are we wildcarding?
JRST SRVNX1 ;[163]No, check for read access
MOVEI S1,.CKADL ;[163]Directory listing access allowed?
$CALL JEDGAR ;[163]
JUMPF SRVNX2 ;[163]Try the next file (if it exists)
SRVNX1: MOVEI S1,.CKARD ;[163]Make sure requestor can read it
$CALL JEDGAR
$RETIF ;Return failing status
MOVX S1,POLINI ;[133]RESET...
MOVEM S1,FILCRC ;[133]...THE CRC
$CALL ATLOOK ;Lookup specified attributes
JUMPF [MOVE T1,REMOST ;Get remote system type
DMOVE S1,[EXP .MD1,.MD1] ;Assume image mode
CAIN T1,.OSTP20 ;[103]TOPS20?
JRST .+1 ;Yes..use image
LOAD T2,.FBBYV+LOCFDB,FB%BSZ ;[103]No..check bytesize
CAIE T1,.OSTP10 ;[103]TOPS10?
CAIE T2,^D36 ;[103]IF BYTE SIZE IS 36...
CAIN T2,^D7 ;[103]...OR 7
DMOVE S1,[EXP .MD8,.MD8] ;Assume ascii mode
JRST .+1]
MOVEM S1,SRCMOD ;Save local mode
MOVEM S2,DSTMOD ;Save destination mode
SKIPE S1,ATTBSZ ;User specified bytesize?
STORE S1,.FBBYV+LOCFDB,FB%BSZ ;Yes..use it for Open
PUSH P,ATTMRS ;Preserve calling MRS
MOVEI S1,ATTMSD ;Clear remaining attributes
$CALL CLRMSG
POP P,ATTMRS ;Restor calling MRS
$CALL SETMOD ;Check for proper mode
JUMPF [$MUERR .DMATT,21] ;Else return bad mode
MOVE T1,[POINT 4,MODTB2(S1)] ;Get pointer to destination mode
ILDB T1,T1 ;Get default destination mode
SKIPN T1 ;[125]IS THERE A DESTINATION MODE?
JRST [$CALL PICMOD ;[125]NO, GO PICK ONE
MOVE T1,S1 ;[125]SAVE IT IN T1
JRST .+1] ;[125]RETURN TO MAINLINE CODE
SKIPN DSTMOD
MOVEM T1,DSTMOD
MOVEM S2,ATTBSZ ;Save attributes bytesize
MOVX S1,AT$DAT+AT$RFM+AT$RAT+AT$BSZ
MOVEM S1,ATTMNU
$CALL OPNFIL ;Open the file for input
JUMPT SRVNX3 ;[131]Branch if OPENF succeeded
SKIPE WLDJFN ;[131]Wild JFN?
CAIE S2,OPNX31 ;[131]File off-line?
$RETF ;[163]No to both, failing return
SRVNX2: SKIPN WLDJFN ;[163]Are we wildcarding?
$RETF ;[163]No, return failure
$CALL NXTINP ;[163]Another file to do?
JUMPT SRVNXT ;[163]Yes
SKIPE FILFLG ;[163]No, have we opened any files?
JRST ACPACK ;[163]Yes, send ACCOMP message
$STATUS ER$FIL,ER$FNF ;[163]Return 'file not found' status
$RETF ;[163]Failing return
SRVNX3: SETOM FILFLG ;[163]Flag we opened at least one file
SKIPE WLDJFN ;[131]Wild-carded?
$CALL SNDWLD ;[131]Yes, send wild name messages
MOVE S1,DSTMOD ;Get destination mode
MOVE S2,ATTMRS ;Get MRS from original attributes
$CALL SETATT ;Setup proper attributes
SKIPN S1,ACCDSP ;Display requested?
MOVX S1,DI$ATT ;No..default is attributes
$CALL SNDDSP ;Send them off
$CALL SNDACK ;Send an ACK for this ACCESS
$STATE .LLCTL ;Wait for Control or Accomp
$RETT
SUBTTL SRVCRE Server routine to process ACCESS (Create)
;SRVCRE is called while processing an ACCESS (Create) message.
; It is responsible for opening the file in the mode specified
; by the initial attributes message.
; Since DAP file attributes are not stored as a part of the
; file header (FDB) it is up to the requestor to specify how
; the file is to be created.
; The following rules apply to creating files:
; 1) If the user specified that the file be created in a
; mode not native to our file system, an error will be returned.
; 2) If the user specified that the file be created in image
; mode and failed to specify a byte size, the file will be opened
; as an 8 bit file. (DAP default for bytesize is 8 bit bytes)
; 3) If the user specified image mode with a byte size of 0
; the file will be created as a 36 bit file.
; 4) If the user specified image mode with a byte size of 1 to 36
; the file will be created per the requestors wishes.
; 5) If the user specified ascii mode the file will be opened
; using a bytesize of 7 .
;In all cases the attributes returned will reflect the current opening
;of the file.
SRVSUB: MOVX S1,FB$SUB ;Get submit bit for close
IORM S1,ATTFOP ;Remember it
;Enter common create code
SRVCRE: $CALL ATLOOK ;Lookup incomming attributes
JUMPF [$MUERR .DMATT,21] ;Bad data mode
SKIPN MODTB7(S1) ;Legal mode for Create?
$MUERR .DMATT,21 ;No..bad data mode
MOVEM S1,SRCMOD ;Save our source mode
MOVEM S2,DSTMOD ;Save destination mode
$CALL SETOUT ;Setup to create a file
$RETIF ;Return failing status
MOVEI S1,.CKACF ;Check access for file creation
$CALL JEDGAR ;See if user can create
$RETIF ;Return failing status
SKIPN S1,ATTBSZ ;Bytesize equal 0?
MOVEI S1,^D36 ;Yes..make it 36 (if image mode)
STORE S1,.FBBYV+LOCFDB,FB%BSZ ;Save for SETMOD
$CALL SETMOD ;Setup the data mode
JUMPF [$MUERR .DMATT,21] ;Else return failing status
MOVEM S2,ATTBSZ ;Save bytesize for attributes
$CALL OPNFIL ;Open the file for output
$RETIF ;Return failing status
MOVX S1,AT$DAT+AT$RFM+AT$RAT+AT$DEV+AT$BSZ
MOVEM S1,ATTMNU ;Setup minimum attributes menu
SKIPN S1,ACCDSP ;Display field present?
MOVX S1,DI$ATT ;No..Default is attributes
$CALL SNDDSP ;Send them out
$CALL SNDACK ;SEND OUT AN ACK
$STATE .LLCTL ;Wait for Control or Accomp
$RETT ;AND RETURN SUCCESS
SUBTTL SRVDEL Server routine to process Delete requests
SRVDEL: MOVEI S1,FILMAX ;[111]SETUP MAX...
MOVEM S1,FILCNT ;[111]... FILE COUNT PER DAP MESS BUFFER
MOVEI S1,ATTMSD ;Clear attributes message
$CALL CLRMSG
MOVX S1,DT$IMA ;Set image mode
MOVEM S1,ATTDAT
MOVX S1,FB$UDF ;Undefined format
MOVEM S1,ATTRFM
MOVX S1,AT$DAT+AT$RFM+AT$BSZ+AT$DEV+AT$BSZ
MOVEM S1,ATTMNU ;Set minimum attributes menu
$CALL SETINP ;Setup to find existing file
$RETIF
SRVDE1: LOAD S1,.FBBYV+LOCFDB,FB%BSZ
MOVEM S1,ATTBSZ ;Store actual bytesize
MOVX S1,.CKAWR ;[165]Write access required
$CALL JEDGAR ;[165]Do we have it?
JUMPT SRVDE2 ;[165]Yes, go delete the file
MOVX S1,.CKACN ;Connect access required
$CALL JEDGAR ;CHECK THE ACCESS
$RETIF ;Return failing status
HRRZ S1,LOCJFN ;[165]We can connect to the directory
MOVE S2,[XWD 1,.FBPRT] ;[165]Now check the owner protection
MOVEI T1,T1 ;[165]
GTFDB ;[165]Get file protection in T1
TXNE T1,200000 ;[165]Write protected against owner?
JRST SRVDE2 ;[165]No, go delete the file
$STATUS ER$FIL,ER$PRV ;[165]Set DAP error status
MOVEI S2,DELFX1 ;[165]And JSYS error code
$RETF ;[165]Failing return
SRVDE2: SKIPE S1,ACCDSP ;[165]Want any attributes?
$CALL SNDDSP ;No..default is display none
$CALL DELFIL ;Delete the file
$RETIF ;Return on failure
SOSG FILCNT ;[111]IS DAP MESS BUFFER FILLING?
JRST [$CALL SNDQUE ;[111]YES, SEND CURRENT MESSAGES
MOVEI S1,FILMAX ;[111]RESET...
MOVEM S1,FILCNT ;[111]...THE MAX FILE COUNT
JRST .+1] ;[111]RETURN TO MAINLINE CODE
$CALL NXTINP ;Look for next file
JUMPT SRVDE1 ;Found it..go delete it
$CALL EXPUNG ;[124]EXPUNGE DELETED FILES
$CALL SNDACA ;Send ACCOMP (resp)
$STATE .LLACC+S%RETN ;Return to access state
$RETT
SUBTTL EXPUNG Expunge deleted files
EXPUNG: MOVX S1,GJ%DEL ;[124]LOOK FOR DELETED FILES
IORM S1,JFNBLK ;[124]THAT MATCH FILE SPEC FROM USER
EXP2: MOVEI S1,JFNBLK ;[124]GET LIST OF DELETED FILES
MOVE S2,.DFLFS(AP) ;[124]THE FILE SPEC
GTJFN ;[124]
JRST EXP4 ;[124]NONE LEFT
MOVE T2,S1 ;[124]SAVE THE JFN
EXP3: HRRZ S2,S1 ;[124]GET JFN WITHOUT FLAGS
HRROI S1,MSGTXT ;[124]STRING ADDRESS
SETZ T1, ;[124]
JFNS ;[124]GENERATE FILE SPEC
MOVX S1,GJ%SHT+GJ%DEL ;[124]NOW GET NEW JFN
HRROI S2,MSGTXT ;[124]
GTJFN ;[124]
JRST EXP4 ;[124]
PUSH P,S1 ;[124]SAVE NEW JFN
MOVE S1,T2 ;[124]GET OLD JFN
GNJFN ;[124]GET NEXT JFN
SETZ T2, ;[124]
POP P,S1 ;[124]GET SECOND JFN
HRLI S1,(DF%EXP) ;[124]
DELF ;[124]EXPUNGE THE FILE
JFCL ;[124]
MOVE S1,T2 ;[124]GET ORIGINAL JFN
JUMPN T2,EXP3 ;[124]KEEP GOING
EXP4: MOVX S1,GJ%DEL ;[124]
ANDCAM S1,JFNBLK ;[124]
$RETT
SUBTTL SRVEXE Server routine to process submit requests
SRVEXE: MOVEI S1,FILMAX ;[111]RESET...
MOVEM S1,FILCNT ;[111]...THE MAX FILE COUNT
HRROI S1,[ASCIZ/CTL/] ;Get default extention
MOVEM S1,.GJEXT+JFNBLK
MOVEI S1,ATTMSD ;Clear initial attributes
$CALL CLRMSG ;Clear it
MOVEI S1,.MD8 ;Set ascii stream attributes
SETZM S2 ;No MRS or other attributes
$CALL SETATT
$CALL SETINP ;Set up for file input
$RETIF ;Return failing status
SRVEX1: LOAD S1,.FBBYV+LOCFDB,FB%BSZ ;Get file bytesize
CAIE S1,^D7 ;Must be 7 or 36
CAIN S1,^D36
SKIPA ;Ok..submit it
$MOERR ER$BSZ ;Bad bytesize
MOVX S1,.CKARD ;Check read access
$CALL JEDGAR ;Check access and submit
$RETIF ;Return failing status
$CALL SUBMIT ;Submit the file
SKIPE S1,ACCDSP ;Want any attributes?
$CALL SNDDSP ;Yes..send them out
SOSG FILCNT ;[111]IS DAP MESS BUFFER FULL?
JRST [$CALL SNDQUE ;[111]YES, SEND CURRENT MESSAGES
MOVEI S1,FILMAX ;[111]RESET...
MOVEM S1,FILCNT ;[111]...THE MAX FILE COUNT
JRST .+1] ;[111]
$CALL NXTINP ;Get next file in the group
JUMPT SRVEX1 ;Back to submit next file
$CALL SNDACA ;Send ACCOMP (Resp)
$STATE .LLACC+S%RETN ;Return to Access state
$RETT
SUBTTL SRVDIR Server routine to process Directory requests
SRVDIR: MOVEI S1,FILMAX ;[111] MAX FILES TO PROC BEFORE SNDQUE
MOVEM S1,FILCNT ;[111] SET IT UP
HRROI S1,[ASCIZ/*/] ;Get some wild cards
MOVEM S1,.GJNAM+JFNBLK ;Set wild filename
MOVEM S1,.GJEXT+JFNBLK ;Set wild filetype
MOVEI S1,ATTMSD ;Clear attributes message
$CALL CLRMSG
MOVX S1,DT$IMA ;Attributes are image undefined
MOVEM S1,ATTDAT
MOVX S1,FB$UDF
MOVEM S1,ATTRFM
MOVX S1,AT$DAT+AT$RFM+AT$BSZ
MOVEM S1,ATTMNU ;Set minimum attributes menu
$CALL SETINP ;Set up for file input
$RETIF ;Return failing status
MOVE S1,WLDJFN ;[112]GET THE BITS
IOR S1,[GN%STR+GN%DIR] ;[112]INSURE VOL AND NAME MESS ARE
;[112]SENT FOR NON WILD DIR
MOVEM S1,WLDSAV ;[112]SAVE FOR SNDWLD
SRVDI1: LOAD S1,.FBBYV+LOCFDB,FB%BSZ
MOVEM S1,ATTBSZ ;Save actual file bytesize
MOVX S1,.CKADL ;Check directory list access
$CALL JEDGAR ; directory list for file
JUMPF SRVDI2 ;Failed - skip this file
MOVE S1,WLDSAV ;[112]GET THE SAVED WILD BITS
AND S1,[GN%STR+GN%DIR] ;[112]ISOLATE STR AND DIR
ORM S1,WLDJFN ;[112]SAVE FOR SNDWLD
MOVE S1,[GN%STR+GN%DIR] ;[112]
ANDCAM S1,WLDSAV ;[112]TURN THEM OFF NOW
$CALL SNDWLD ;Send off proper name messages
SKIPE S1,ACCDSP ;Want any attributes returned?
$CALL SNDDSP ;Send out requested attributes
SOSG FILCNT ;[111]COUNT ANOTHER FILE
JRST [$CALL SNDQUE ;[111]TOO MUCH CORE IN USE
MOVEI S1,FILMAX ;[111]SEND MESSES AND RESET
MOVEM S1,FILCNT ;[111]FILE COUNT
JRST .+1] ;[111]
SRVDI2: $CALL NXTINP ;Step to next file
MOVE S1,WLDJFN ;[112]GET WILD BITS
AND S1,[GN%STR+GN%DIR] ;[112]ISOLATE SR AND DIR
ORM S1,WLDSAV ;[112]SAVE FOR SNDWLD
JUMPT SRVDI1 ;Go back and process it
$CALL SNDACA ;Send ACCOMP (Resp)
$STATE .LLACC+S%RETN ;Return to Access state
$RETT ; And return success
SUBTTL SRVCTL Server routine to process a CONTROL message
SRVCTL: MOVE T1,CTLFNC ;Get desired function
CAIL T1,CF$GET ;Do we support it?
CAILE T1,CF$REW ;...
$MUERR .DMCTL,20 ;No..return unsupported
MOVE S1,CTLMNU ;Get the menu
MOVE S2,RACSAV ;Get old record access field
TXNN S1,CT$RAC ;RAC field present?
JRST SRVCT1 ;No..use the previous one
MOVE S2,CTLRAC ;Yes..get it and check it
CAIL S2,RB$SQF ;...
CAILE S2,RB$BKF ;...
$MUERR .DMCTL,22
CAIN S2,RB$VBN ;Random by VBN?
$MUERR .DMCTL,22 ;Yes..that's unsupported
MOVEM S2,RACSAV ;Save in case of null RAC field
SRVCT1: MOVEM S2,CTLRAC ;Save for this access
SKIPE CTLKRF ;Was KRF field specified?
$MUERR .DMCTL,24 ;Yes..return unsupported
SKIPE CTLROP ;Was ROP field specified?
$MUERR .DMCTL,25 ;Yes..return unsupported
SKIPE CTLHSH ;Was HSH field specified?
$MUERR .DMCTL,26 ;Yes..return unsupported
SKIPE CTLDSP ;Was display field specified?
$MUERR .DMCTL,27 ;Yes..return unsupported
PJRST @CTLTBL-CF$GET(T1) ;Yes..Dispatch to processor
CTLTBL: PJRST CTLGET ;Control (Get)
PJRST CTLCON ;Control (Connect)
$MUERR .DMCTL,20 ;Control (Update) unsupported
PJRST CTLPUT ;Control (Put)
$MUERR .DMCTL,20 ;Control (Delete) unsupported
$MUERR .DMCTL,20 ;Control (Rewind) unsupported
CTLCON: $CALL SNDACK ;Send ACK message
$RETT
CTLGET: $STATE .LLDAT+S%GET ;Getting file records
MOVE S1,CTLRAC ;Get access type
CAIE S1,RB$BKF ;Block mode file I/O?
$RETT ;No..just return
SETOM PAGFLG ;Yes..do page mode
MOVE S1,[GETPAG,,PUTPAG] ;Setup page mode processor
MOVEM S1,DATDAT
MOVE S1,CTLKEY ;Get the binary key
MOVEM S1,DATRCN ;Save it
$RETT
CTLPUT: $STATE .LLDAT+S%PUT ;Writing file records
$CALL DISABL ;Allow over quota checking
MOVE S1,CTLRAC
CAIE S1,RB$BKF ;Block mode file xfer?
$RETT ;No..just return
SETOM PAGFLG ;Yes..set page mode flag
MOVE S1,[GETPAG,,PUTPAG] ;Setup proper processor
MOVEM S1,DATDAT
$RETT
SUBTTL FILGET Server routine to send data messages
FILGET: SKIPGE PAGFLG ;Page mode
SKIPN S1,DATRCN ; and not FDB?
JRST FILGE1 ;No..just send the message
SUBI S1,1 ;Yes..convert VBN to page number
LSH S1,-^D2
HRL S1,LOCJFN
RPACS ;Get page accessibility
ERJMP TERCVT
FILGE1: MOVEI S1,DATMSD ;Point to data message
$CALL QUEMSG ;Build and send the message
$RETIF
SKIPL PAGFLG ;Page mode?
$RETT ;Return
SKIPN S1,DATRCN ;Yes..ready for next page
JRST FILGE2 ;If VBN was 0, start at page 0
SUBI S1,1 ;Convert to file page number
LSH S1,-^D2
ADDI S1,1 ;Step to next page
FILGE2: HRL S1,LOCJFN
FFUFP ;Find next used page
ERJMP [CAIE S1,FFUFX3 ;Eof?
PJRST TERCVT ;No..return the failure
TXO S,S%EOF ;Yes..mark the status
$RETT]
HRRZ S1,S1
LSH S1,^D2 ;Convert to VBN
ADDI S1,1
MOVEM S1,DATRCN ;Save for next data message
$RETT
SUBTTL SRVACP Server routine to process Access complete message
SRVACP: $CALL ENABLE ;Turn on wheel again
MOVE T1,ACPFNC ;Get the closing function
CAIL T1,AC$TRM ;Within range?
CAILE T1,AC$SKP
$MUERR .DMACP,20 ;No..Return unsupported
JRST @ACPTBL-AC$TRM(T1) ;Do the function
ACPTBL: PJRST ACPTRM ;ACCOMP (Close)
$MIERR .DMACP,20 ;Accomp (Resp) is illegal
PJRST ACPPUR ;ACCOMP (Purge)
PJRST ACPEOS ;ACCOMP (Eos)
PJRST ACPSKP ;ACCOMP (Skip)
ACPPUR: $CALL ABTFIL ;Abort current file operation
PJRST ACPSKP ;Step to next file
ACPTRM: $SAVE <P1> ;Preserve an AC
$CALL VALCRC ;Validate the CRC
$RETIF ;Return error on failure
SKIPN P1,ACPFOP ;Get completion file options
MOVE P1,FILFOP ;Else use options from attributes
TXNE P1,FB$SUB ;Want to submit file?
$CALL SUBMIT ;Yes..do the submit
TXNE P1,FB$SPL ;Want to spool the file
$CALL PRINT ;Yes..do the print
TXNE P1,FB$SPL+FB$SUB ;Spooling or printing?
JRST ACPCLS ;Yes..just close the file
TXNN P1,FB$DEL ;Want to delete the file?
JRST ACPCLS ;No..just close the file
MOVEI S1,.CKACN ;Connect access required
$CALL JEDGAR
$RETIF ;Return on failure
SETO S1, ;[137]DELETE THE FILE ON CLOSE
SETOM DELFLG ;[137]A FILE WAS DELETED
SKIPA ;[137]
ACPCLS: SETZ S1, ;[137]DON'T DELETE
$CALL CLSFIL ;Close current file normally
$RETIF ;Return failing status
ACPSKP: SKIPN WLDJFN ;Wild JFN?
JRST ACPACK ;No..send ACCOMP (Ack)
$CALL NXTINP ;Another file to do?
JUMPF ACPACK ;No..send ACCOMP (Ack)
HRLI S1,ATTSAV ;Yes..restore initial attributes
HRRI S1,ATTMNU ; before calling SRVNXT
BLT S1,ATT$LN+ATTMNU-1 ;[163]
SETZM SRCMOD ;Clear source and destination
SETZM DSTMOD ; Modes
PJRST SRVNXT ;Process the next file
ACPACK: SKIPE DELFLG ;[137]ANY FILES DELETED?
$CALL EXPUNG ;[137]YES, EXPUNGE THEM
SETZM DELFLG ;[137]RESET THE FLAG
$CALL SNDACA ;No..send Accomp (Resp)
$STATE .LLACC+S%RETN ;Back to initial access state
$RETT
ACPEOS: $CALL SNDACA ;Send Accomp (Resp)
$STATE .LLCTL ;Back to control state
$RETT
SUBTTL ENABLE/DISABL Routine to set or clear capabilities for server
ENABLE: SKIPN DEBUGW ;Are we debugging
SKIPE T1,CAPIBL ; or are we already enabled?
$RET ;Yes, just return
MOVEI S1,.FHSLF ;Get my fork handle
RPCAP ;Get my capabilites
TXON T1,SC%OPR+SC%WHL ;Enable operator and/or wheel
EPCAP ; if not already enabled
MOVEM T1,CAPIBL ;Save for upcomming disable
$RET
DISABL: SKIPN DEBUGW ;Are we debugging?
SKIPN T1,CAPIBL ; or are we already disabled?
$RET ;Yes, just return
MOVEI S1,.FHSLF ;Get my for handle
SETO S2,
TXZ T1,SC%OPR+SC%WHL ;Clear operator and wheel
EPCAP
SETZM CAPIBL ;Say no longer enabled
$RET
SUBTTL HOOVER Routine to validate a users access to a file
;Accepts S1/ Requested access
;Returns TRUE Access is allowed
; FALSE Access denied
JEDGAR: STKVAR <<CHKBLK,5>>
MOVEM S1,.CKAAC+CHKBLK ;Save requested access
HRRZ S1,LOCJFN ;Get file JFN
MOVEM S1,.CKAUD+CHKBLK ;Save the JFN
MOVE S1,DIRNUM ;Get directory number
MOVEM S1,.CKACD+CHKBLK ;Save as directory
MOVE S1,USRNUM ;Get user number
FTACL < CAMN S1,[-1] ;[167] Did ACL give us the OK ???
;[167] (for the original connect)
JRST [MOVE S1,.CKAAC+CHKBLK ;[167] Yes,,get requested access
CAXE S1,.CKADL ;[167] Doing a directory list?
CAXN S1,.CKARD ;[167] Doing a read ???
SKIPA ;[167] Some kind of legal function
JRST JEDGA0 ;[167] No,,fail the request for now
HRRZ S1,LOCJFN ;[167] Yes,,must ask for file ok too !
PUSHJ P,REQACL ;[167] Ask for permission
JUMPF JEDGA0 ;[167] Lose,,return priv failure
JRST JEDGA1 ] > ;[167] Win,,return success
MOVEM S1,.CKALD+CHKBLK ;Save as user
SETZM .CKAEC+CHKBLK ;Check with no privs
MOVX S1,CK%JFN+5 ;Set JFN flag and length
MOVEI S2,CHKBLK ;Point to args
CHKAC ;Check the access
TDZA TF,TF ;Jsys failed..return false
MOVE TF,S1 ;Return True/False per chkacc
JUMPT JEDGA1 ;Return success
JEDGA0: $STATUS ER$FIL,ER$PRV ;[167]Return privilege failure
MOVE S2,.CKAAC+CHKBLK ;Get requested access
MOVE S2,ACCERR(S2) ;Get proper extended error
$RETF ;Return the failure
JEDGA1: MOVE S1,.CKAAC+CHKBLK ;Get requested access
CAIE S1,.CKACF ;Was it create?
$RETT ;No..just return
SETZM S1 ;Yes..see if we have room
HRRZ S2,LOCJFN
RCDIR ;Get directory number
ERJMP TERCVT
MOVE S1,T1 ;Put directory number in S1
GTDAL ;Get directory allocation
ERJMP TERCVT
SUB S1,S2 ;Get remaining page count
LOAD S2,.FBBYV+ATTFDB,FB%PGC ;Get requested file page count
CAML S1,S2 ;Enough room?
$RETT ;Yes..return success
$STATUS ER$FIL,ER$FUL ;Report quota exceeded
$RETF
ACCERR: OPNX3 ;Read access required
OPNX4 ;Write access required
0
0
GJFX32 ;[163]No files match this specification
0
0
0
DELFX1 ;Delete access required
OPNX4 ;Write access required
SUBTTL PRINT/SUBMIT Server routine to queue galaxy requests
PRINT: SKIPA T1,[.OTLPT] ;Get Printer object type
SUBMIT: MOVEI T1,.OTBAT ;Get BATCH object type
MOVEI S1,.QOCQE ;Get Create message type
MOVEM S1,MSGHDR
SETZM .MSFLG+MSGHDR ;Clear the flags
SETZM .MSCOD+MSGHDR ;Clear the ack code
SETZM MSGARF ;Clear argument flags
MOVEI S1,4 ;Get minimum argument count
MOVEM S1,MSGARC ;Save it
MOVE S1,[2,,.QCQUE] ;Store que type argement header
MOVEM S1,2+MSGARF
MOVEM T1,3+MSGARF ;Store queue object type
MOVE S1,[2,,.QCOID] ;Store user-id header
MOVEM S1,4+MSGARF
MOVE S1,USRNUM ;Store user number
MOVEM S1,5+MSGARF
MOVEI S1,6+MSGARF ;Point to next header
CAIE T1,.OTBAT ;Submit?
JRST PRIN10 ;No..don't send log disposition
MOVE S2,[2,,.QCCDI] ;Store connected directory
MOVEM S2,0(S1)
MOVE S2,DIRNUM ;Use users directory
MOVEM S2,1(S1)
ADDI S1,2 ;Point to next header
AOS MSGARC ;Bump argument count
MOVE S2,[2,,.QCBLT] ;Store log file disposition
MOVEM S2,0(S1)
MOVEI S2,%BAPND ;Append logfile
MOVEM S2,1(S1)
ADDI S1,2 ;Point to next free arg
AOS MSGARC ;Bump argument count
PRIN10: MOVEI S2,.QCFIL ;Store file type
MOVEM S2,(S1)
HRROI S2,NAMFSP ;Point to file
$CALL STRARG ;Store it
PUSH P,S1 ;[144]SAVE S1
PUSH P,T1 ;[144]SAVE T1
SETZM LLNAME ;[144]FOR THE FILE TYPE
HRROI S1,LLNAME ;[144]STRING POINTER
HRRZ S2,LOCJFN ;[144]LOCAL FILE JFN
MOVX T1,1B11 ;[144]FILE TYPE ONLY
JFNS ;[144]GET THE FILE TYPE
POP P,T1 ;[144]RESTORE T1
POP P,S1 ;[144]RESTORE S1
MOVE S2,[ASCIZ /DAT/] ;[144]FORTRAN FILE TYPE
CAMN S2,LLNAME ;[144]TYPE WAS .DAT?
JRST [AOS MSGARC ;[144]YES,INCREMENT ARG COUNT
MOVE S2,[2,,.QCPTP] ;[144]FILE FORMAT HEADER
MOVEM S2,0(S1) ;[144]PUT IN MESSSAGE
ADDI S1,1 ;[144]BUMP POINTER
MOVEI S2,.FPFFO ;[144]/FILE:FORTRAN
MOVEM S2,0(S1) ;[144]PUT IN MESSAGE
ADDI S1,1 ;[144]BUMP POINTER
JRST .+1] ;[144]JOIN MAINLINE CODE
MOVEI S2,.QCNAM ;Get user string function
MOVEM S2,0(S1) ;Store user function
MOVE S2,.DOUSR+LLOPNB ;Point to user string
$CALL STRARG ;Store it
SKIPN .DOUSR+LLOPNB ;Account specified?
JRST PRIN20 ;No..send what we have
AOS MSGARC ;Yes..bump arg count
MOVEI S2,.QCACT ;Store account header
MOVEM S2,0(S1)
MOVE S2,.DOACT+LLOPNB ;Point to account string
$CALL STRARG ;Copy the string
PRIN20: SUBI S1,MSGHDR ;Get message length
HRLM S1,MSGHDR ;[0115]Message length
MOVEI S2,MSGHDR ;Get message address
PJRST SNDQSR ;Send it to QUASAR
STRARG: HRRZ T2,S1 ;Remember header address
HRROI S1,1(S1) ;Point to destination
SETZ T1, ;Terminate on null
SOUT
MOVEI S1,1(S1) ;Point S1 to next word
MOVE T1,S1
SUB T1,T2 ;Compute argument length
HRLM T1,0(T2) ;Save in header
$RETT ;Return
SUBTTL REQACL - Ask the Access Control process for authorization
;CALL: S1/ 0 - If requesting user authorization
; S1/ JFN - If requesting file authorization
;
;RET: True if access permitted, false otherwise
FTACL <
REQACL: PUSHJ P,.SAVE3 ;[167] Save P1 - P3
MOVE P1,S1 ;[167] Save the JFN if there is one
SETZM MSGHDR ;[167] Clear the first word of the msg
MOVE S1,[MSGHDR,,MSGHDR+1] ;[167] Clear the rest
BLT S1,MSGHDR+200 ;[167] of the message
SETZM SNDSAB ;[167] Clear the first word of the SAB
MOVE S1,[SNDSAB,,SNDSAB+1] ;[167] Clear the rest
BLT S1,SNDSAB+SAB.SZ-1 ;[167] of the SAB
MOVE S1,[.OHDRS,,.ACVAL] ;[167] Get the msg header
MOVEM S1,.MSTYP+MSGHDR ;[167] Save it
MOVSI P2,-4 ;[167] Do the asciz blocks first
MOVEI P3,.OHDRS+MSGHDR ;[167] Point to the first block
REQA.1: MOVE S2,[EXP .DONOD,.DOUSR,.DOACT,.DOPSW](P2) ;[167] Get the txt
CAIN S2,.DOACT ;[167] Is this the account string ???
SKIPN NOACCT ;[167] Yes,,is it really there ???
SKIPN S2,LLOPNB(S2) ;[167] Any text specified ???
JRST REQA.2 ;[167] No,,check next block
AOS .OARGC+MSGHDR ;[167] Bump the block count by 1
MOVE S1,[EXP .BLNOD,.BLUSR,.BLACC,.BLPSW](P2) ;[167] Get blk type
STORE S1,ARG.HD(P3),AR.TYP ;[167] Insert into block header
HRROI S1,ARG.DA(P3) ;[167] Point to the output area
SETZ T1, ;[167] Stop on a null
SOUT ;[167] Copy the text into the block
SUBI S1,-2(P3) ;[167] Calc the block len (pad a little)
HRRZS S1 ;[167] Get just the length
STORE S1,ARG.HD(P3),AR.LEN ;[167] Save it
ADDI P3,0(S1) ;[167] Point to the next block
MOVSS S1 ;[167] Get length,,0
ADDM S1,.MSTYP+MSGHDR ;[167] Bump message length
REQA.2: AOBJN P2,REQA.1 ;[167] Look at all blocks
JUMPE P1,REQA.3 ;[167] No JFN,,send what we have
MOVX S1,.BLFIL ;[167] Get the block type
MOVEM S1,ARG.HD(P3) ;[167] Save it
HRROI S1,ARG.DA(P3) ;[167] Point to the output area
MOVE S2,P1 ;[167] Get the JFN in S2
MOVX T1,FFSPEC ;[167] Want DEV:<DIR>FILE.EXT.GEN
JFNS ;[167] Get it
SUBI S1,-2(P3) ;[167] Calc the block len (pad a little)
HRLZS S1 ;[167] Get just the length,,0
ADDM S1,ARG.HD(P3) ;[167] Save block length
ADDM S1,.MSTYP+MSGHDR ;[167] And the message length
AOS .OARGC+MSGHDR ;[167] Bump the arg count by 1
REQA.3: MOVEI S1,MSGHDR ;[167] Get the message address
MOVEM S1,SNDSAB+SAB.MS ;[167] Save it
LOAD S1,.MSTYP+MSGHDR,MS.CNT ;[167] Get the message length
MOVEM S1,SNDSAB+SAB.LN ;[167] Save in the SAB
MOVE S1,ACLPID ;[167] Get ACL's PID
MOVEM S1,SNDSAB+SAB.PD ;[167] Save it
;[167] Continued on the next page
;[167] Continued from the previous page
MOVEI S1,SAB.SZ ;[167] Get the SAB length
MOVEI S2,SNDSAB ;[167] And the address
PUSHJ P,C%SEND ;[167] Send the request
JUMPF .RETF ;[167] Lose,,tough noogies !!!
REQA.4: PUSHJ P,C%BRCV ;[167] Wait for the response
MOVE S2,MDB.SP(S1) ;[167] Get the senders PID
CAME S2,ACLPID ;[167] Did we send to this guy ???
JRST [PUSHJ P,C%REL ;[167] No,,release the message
JRST REQA.4 ] ;[167] And try again
LOAD S1,MDB.MS(S1),MD.ADR ;[167] Get the response address
LOAD P1,.MSFLG(S1),MF.FAT ;[167] Get request failed status
PUSHJ P,C%REL ;[167] Release the IPCF message
JUMPE P1,.RETT ;[167] Request succeeded,,return OK
$RETF ;[167] Lose,,return failure
> ;[167] End REQACL routine
SUBTTL GETACL - Routine to get the Access Control process PID
;CALL: No Args
;
;RET: True Always - ALCPID/ 0 or the Access Control PID
FTACL <
GETACL: LOAD S1,LLOPNB+.DOFLG,DO%SRV ;[167] Get 'server' flag bit
JUMPE S1,.RETT ;[167] Return if not a server
MOVE S1,[103050,,.IPCIW] ;[167] Read Named PID
MOVEM S1,MSGHDR+.IPCI0 ;[167] Set it
SETZM MSGHDR+.IPCI1 ;[167] No aux PID
HRROI S1,MSGHDR+.IPCI2 ;[167] Get pointer to PID name
HRROI S2,[ASCIZ/FILE-ACCESS-CONTROL/] ;[167] Get source name
SETZ T1, ;[167] Stop on null
SOUT ;[167] Copy the name
SUBI S1,MSGHDR-1 ;[167] Calc msg length
HRRZM S1,SNDSAB+SAB.LN ;[167] Save it
MOVEI S1,MSGHDR ;[167] Get the message address
MOVEM S1,SNDSAB+SAB.MS ;[167] Save it
MOVX S1,SP.INF ;[167] Get [SYSTEM]INFO PID index
TXO S1,SI.FLG ;[167] Set special index flag
MOVEM S1,SNDSAB+SAB.SI ;[167] Set it
SETZM SNDSAB+SAB.PD ;[167] No PID
MOVEI S1,SAB.SZ ;[167] Get SAB length
MOVEI S2,SNDSAB ;[167] Get SAB address
$CALL C%SEND ;[167] Ask [SYSTEM]INFO for the PID
GETA.1: $CALL C%BRCV ;[167] Get the ack back
LOAD S1,MDB.MS(S1),MD.ADR ;[167] Get the response address
MOVE S2,.IPCI0(S1) ;[167] Get the header word
CAME S2,MSGHDR+.IPCI0 ;[167] Do headers match ???
JRST GETA.1 ;[167] No,,must wrong msg,,try again
MOVE S2,.IPCI1(S1) ;[167] Get the PID
MOVEM S2,ACLPID ;[167] Save it
$RETT ;[167] Return
> ;End GETACL routine
SUBTTL SNDQSR Routine to send message to quasar
;ACCEPTS S1/ Length of message
; S2/ Address of message
SNDQSR: MOVX T1,SP.QSR ;Get quasars index
TXO T1,SI.FLG ;Set special index flag
MOVEM T1,SAB.SI+SNDSAB
SETZM SAB.PD+SNDSAB ;Clear the pid
MOVX T1,MF.ACK ;Lite ack bit
IORM T1,.MSFLG(S2) ;Store in message
MOVEM S1,SAB.LN+SNDSAB ;Store the length
MOVEM S2,SAB.MS+SNDSAB ;Store the address
MOVEI S1,SAB.SZ
MOVEI S2,SNDSAB
$CALL C%SEND
$CALL C%BRCV ;Get the ack from QUASAR
$RET ;Return true/false per C%SEND
SUBTTL DAPDCN Active Task function dispatch
DAPDCN: $STATE .LLCFG ;Start at Config state
SKIPN CFGVER ;Exchanged config messages?
$CALL DCNMSG ;No..Exchange Config messages
$RETIF ;Return failing status
$STATE .LLACC ;Step to access state
MOVE S1,[.NULIO,,.NULIO] ;Set null string input
MOVEM S1,.GJSRC+JFNBLK ;...
HRROI S1,ACCFIL ;Store remote filespec
SKIPE S2,.DFRFS(AP) ;Pointer present?
$CALL CPYSTR ;Yes..store it
MOVE S1,.DFRFO(AP) ;Get remote file options
MOVEM S1,ACCOPT ;Save for access
LOAD S1,.DFFLG(AP),DF%ACC ;Get desired function
STORE S1,ACCFNC
CAIL S1,AF$OPN ;Actual DAP function?
CAILE S1,AF$EXE ;...
JRST DAPDC1 ;No..Check for special request
$CALL @DCNTBL-AF$OPN(S1) ;Process the request
JUMPF DCNABT ;Abort link on error
$RETT
DCNABT: HRROI T1,STSTXT ;Expand failing status
TXNN S,S%LERR ;Did we receive status?
$CALL TYPSTS ;No..expand our message
MOVX T1,TXT(Local status - ) ;[147]Assume local status error
TXNE S,S%LERR ;Unless we received status
MOVX T1,TXT(Remote status - );Get Remote status error
HRROI T2,STSTXT ;Point to expaned text
$FATAL (,^Q/T1/^Q/T2/) ;Display message and return
DCNTBL: JRST DCNREC ;AF$OPN - Recieve existing files
JRST DCNSND ;AF$CRE - Send existing file
JRST DCNREN ;AF$REN - Rename existing files
JRST DCNDEL ;AF$DEL - Delete existing files
JRST DAPDC2 ;Function 5 (reserved)
JRST DCNDIR ;AF$DIR - Directory of files
JRST DCNSUB ;AF$SUB - Send and execute file
JRST DCNEXE ;AF$EXE - Execute existing file
DAPDC1: CAIL S1,AF$TYP ;Special function?
CAILE S1,AF$PRN ;...
DAPDC2: $FATAL (Function not implimented)
$CALL @DCNTB1-AF$TYP(S1) ;Process the request
JUMPF DCNABT
$RETT
DCNTB1: JRST DCNTYP ;AF$TYP - Type remote files
JRST DCNPRN ;AF$PRN - Print remote files
SUBTTL Active Task message and State tables
DCNMLS: DCNS00,,DCNI00 ;DCN .LLCFG state
DCNS01,,0 ;DCN .LLACC state
DCNS02,,0 ;DCN .LLATT state
DCNS03,,0 ;DCN .LLCTL state
DCNS04,,0 ;DCN .LLDAT state
DCNS05,,DCNI05 ;DCN .LLACP state
;Message dispatch for .LLCFG state
DCNS00: .DMCFG,,DCNCFG
.DMSTS,,DCNSTS
0
;Message dispatch for .LLACC state
DCNS01: .DMACP,,DCNACP
.DMNAM,,DCNNAM
.DMATT,,VALATT
.DMSTS,,DCNSTS
0
;Message dispatch for .LLATT state
DCNS02: .DMDTI,,VALDTI
.DMPRO,,VALPRO
.DMNAM,,ATTNAM
.DMACK,,ATTACK
.DMACP,,ATTACP
.DMSTS,,DCNSTS
0
;Message dispatch for .LLCTL state
DCNS03: .DMACK,,CTLACK
.DMSTS,,DCNSTS
0
;Message dispatch for .LLDAT state
DCNS04: .DMDAT,,[$RETT] ;Processed by GETDAT
.DMSTS,,DCNSTS
0
;Message dispatch for .LLACP state
DCNS05: .DMACP,,DCNACP
.DMNAM,,ACPNAM
.DMSTS,,DCNSTS
.DMDAT,,[$RETT]
0
SUBTTL Active Task state initialization routines
;Active Task initialization for .LLCFG state
DCNI00: MOVEI S1,DAPSIZ ;Clear Config storage
MOVEI S2,DAPBEG ;...
$CALL .ZCHNK ;...
MOVEI S1,DPMXM ;Store maximum message size
MOVEM S1,OURSIZ
$CALL SNDCFG ;Send config message
$RETT
;Active Task initialization for .LLACP state
DCNI05: $CALL SNDACP ;Send an access complete
$RETT
SUBTTL DCNMSG Active Task message processing routine
DCNMSG: $CALL SNDQUE ;Dump the send queues
JUMPF [$CALL LLRECV ;Check for incomming messages
JRST DCNMSG] ;Finish sending what we started
TXZN S,S%INIT ;State just change?
JRST DCNMS1 ;No..check for messages
HRRZ S1,DCNMLS(S) ;Get initialization address
JUMPE S1,DCNMS1 ;State initialization routine?
$CALL 0(S1) ;Yes..Call it
JRST DCNMSG ;Back to send again
DCNMS1: SKIPE MSGFLG ;[0130]If there is a message
JRST DCNMS2 ;[0130]Don't call LLCHK
TXNN S,S%PUT ;[154]DO WE NEED A MESSAGE?
JRST DCNMS2 ;[154]YES, GO DO IT
SKIPE INTHAP ;[154]DID AN INTERRUPT OCCUR?
$CALL LLCHK ;Get link status
SKIPF MSGFLG ;[154]Message available?
JRST DCNMS2 ;Yes..go process the message
$CALL FILGET ;Send a record
$RETIF ;Else return the status
TXNN S,S%EOF ;Seen EOF?
JRST DCNMSG ;No..back to send next record
$RETT ;Yes..return to caller
DCNMS2: CAIE S,.LLDAT ;In data state?
JRST DCNMS3 ;No..dont check ACPFLG yet
AOSN ACPFLG ;Want early ACCOMP
$RETT ;Yes..return to send it
DCNMS3: HLRZ S1,DCNMLS(S) ;Get message list address
$CALL GETMSG ;Read the message
$RETIF ;Return failing status
TXZN S,S%RETN ;Return to caller?
JRST DCNMSG ;No..Back to get next message
$RETT
SUBTTL DCNCFG Routine to process Config message
DCNCFG: $CALL VALCFG ;Validate the Config
$RETIF ;Return failing status
$STATE .LLACC ;Move to next state
TXO S,S%RETN ;Return to caller
$RETT
SUBTTL DCNNAM Routine to process Name message
ATTNAM: $CALL VALNAM ;Validate the message
$RETIF ;Return failing status
TXNE S1,NA$FSP ;Filespec?
JRST DCNNA1 ;Yes..Call user with the message
$CALL DCNATR ;Call user with our attributes
ACPNAM: MOVNS .DPTYP(DL) ;Request Reparse of this message
TXO S,S%RETN ;Return to caller
$RETT
DCNNAM: $CALL VALNAM ;Validate the name
$RETIF ;Return failing status
DCNNA1: HRLZ S1,S1 ;Put flags in left half of S1
HRRI S1,.DMNAM ;Identify name message
$CALL DCNRTN ;Call user routine
$RETT ;Return success
SUBTTL ATTACK Routine to process ACK for Attributes message
SUBTTL CTLACK Routine to process ACK for Control message
ATTACK: MOVX S1,.DMACK ;Get ack message type
MOVEI S2,ATTFDB ;Point to FDB
$CALL DCNRTN ;Call user routine
CTLACK: TXO S,S%RETN ;Return to caller
$RETT ;Return success
SUBTTL DCNACP Routine to process Accomp (Resp)
ATTACP: $CALL DCNATR ;Call user with attributes
DCNACP: TXO S,S%ACP+S%RETN ;Set Accomp and return flags
MOVX S1,.DMACP ;Get message type
$CALL DCNRTN ;Call user routine
$RETT ;Return success
SUBTTL DCNSTS Routine to process Status message
DCNSTS: MOVE S1,STSCOD ;Get the status code
MOVE S2,STSSTV ;Get the extended status
CAXE S1,FLD(ER$TRN,ER%MAC)+FLD(ER$EOF,ER%MIC) ;EOF?
JRST DCNSTE ;No..return the status
TXO S,S%EOF+S%RETN ;Yes..Set EOF and return flags
$RETT
DCNSTE: HRROI T1,STSTXT ;Point to text storage
$CALL TYPSTS ;Expand this error
TXO S,S%LERR ;Set remote status error flag
$RETF
SUBTTL DCNATR Routine to call user with received attributes
DCNATR: MOVEI S1,.DMATT ;Say we have an attribute msg
MOVEI S2,ATTFDB ;Point to the fudged FDB
DCNRTN: SKIPE .DFRTN(AP) ;User routine specified?
$CALL @.DFRTN(AP) ;Yes..call it
$RET ;Return TF from user routine
SUBTTL DCNREC Active Task routine to receive a file
DCNREC: MOVEI S1,ATTMSD ;Clear initial attributes msg
$CALL CLRMSG
SKIPN S1,SRCMOD ;[125]Get our source mode
MOVEI S1,.MD8 ;[125]DEFAULT TO ASCII
MOVE S2,REMOST ;[125]GET OUR SYSTEM TYPE
CAIN S2,.OSTP20 ;[125]TOPS20?
JRST [SKIPN SRCMOD ;[125]YES, DEF FOR 20S IS IMAGE
SETZ S1, ;[125]
JRST .+1] ;[125]
MOVE S2,.DFRFA(AP) ;[125]GET REMOTE SWITCHES
TXNN S2,DF%MRS ;[125]was MRS specified?
IORX S2,<FLD(^D512,DF%MRS)> ;[125]No..default to 512
$CALL SETATT ;[125]Yes..setup requested mode
$CALL SNDATT ;Send of dummy attributes
MOVX S2,FB$GET ;Setup Access message
MOVEM S2,ACCFAC ; to allow shared reading
MOVE S1,OURDSP ;Setup access display
MOVEM S1,ACCDSP ; to request all attributes
SETOM CRCFLG ;Request CRC validation
$CALL SNDACC ;Send out file Access message
DCNR20: MOVX S1,POLINI ;[133]
MOVEM S1,FILCRC ;[133]INITIALIZE CRC
$STATE .LLACC ;Wait for file attributes
$CALL DCNMSG ;Get Servers response
$RETIF ;Return failing status
$CALL ATLOOK ;Lookup the attributes
JUMPF [SKIPN S1,SRCMOD ;Get source mode
$FATAL (Remote file attributes not supported)
$WARN (File attributes don't match processing mode)
PUSH P,ATTMOD(S1) ;Save default destination mode
MOVE S2,.DFRFA(AP) ;Setup specified attributes
TXNN S2,DF%MRS ;MRS specified?
IORX S2,<FLD(^D512,DF%MRS)> ;No..use nice default
$CALL SETATT ;Set the attributes
POP P,S2 ;Get default destination mode
JRST .+1] ;Proceed
SKIPE SRCMOD ;Have a source mode
JRST [CAME S1,SRCMOD ;Yes..see if it matches
$WARN (File attributes don't match processing mode)
JRST .+2] ;Proceed
MOVEM S1,SRCMOD ;No..store what we have
SKIPN DSTMOD ;Have a destination mode?
MOVEM S2,DSTMOD ;No..store our default
$CALL CHKMOD ;Make sure modes are legal
JUMPF [$FATAL (Illegal destination processing mode)]
$CALL SETOUT ;Setup for local file output
$RETIF ;[147]
MOVEI S1,.DMNAM ;Give caller expanded filespec
$CALL DCNRTN
MOVE S1,ATTBSZ ;Get attributes byte size
STORE S1,.FBBYV+LOCFDB,FB%BSZ ;Save for image mode
$CALL SETMOD ;Setup data mode
JUMPF [$FATAL (Can't establish requested mode for output)]
$CALL OPNFIL ;OPEN LOCAL FILE FOR OUTPUT
$RETIF ;[147]
$CALL SNDCTC ;START UP A DATA STREAM
$STATE .LLCTL ;Get response to control
$CALL DCNMSG ;GET ACK FROM SERVER
$RETIF ;Return failing status
$CALL SNDCTR ;Start record retrivial
LOAD S2,LOCDEV,DV%TYP ;GET DEVICE TYPE
CAIE S2,.DVTTY ;IS IT A TTY?
JRST DCNR30 ;NO -- GET FIRST MESSAGE
MOVX S1,.CHCRT ;YES - START WITH A <CRLF>
$CALL OUTBYT ;Write to terminal
$RETIF ;Return the failure on error
MOVX S1,.CHLFD ;...
$CALL OUTBYT ;Write to terminal
$RETIF
DCNR30: $STATE .LLDAT ;Accept Data or Status
$CALL DCNMSG ;Process Data until EOF Status
$RETIF ;Return failing status
$CALL TSTPRN ;Terminate print file format
$STATE .LLACP ;Wait for Accomp (Resp)
$CALL DCNMSG ;GET THE ACCOMP ACK
$RETIF ;Return failing status
SETZ S1, ;[137]DON'T DELETE
$CALL CLSFIL ;CLOSE OUT LOCAL FILE
$RETIF ;[147]
TXNE S,S%ACP ;Access complete?
$RETT ;Yes..just return
SKIPN .DFRFA(AP) ;Remote mode specified?
SETZM SRCMOD ;No..clear sorce mode
SKIPN .DFLFA(AP) ;Local mode specified?
SETZM DSTMOD ;No..clear destination mode
JRST DCNR20 ;Back for next file
SUBTTL DCNTYP Active task to type remote files
DCNTYP: MOVEI S1,ATTMSD ;Clear initial attributes
$CALL CLRMSG
$CALL PICMOD ;[156]Pick default file mode
;by system type
MOVX S2,<FLD(^D512,DF%MRS)> ;Default MRS
$CALL SETATT ;Set up dummy attributes message
$CALL SNDATT ;Send of dummy attributes
MOVEI S1,.PRIOU ;Output to terminal
MOVEM S1,LOCJFN
MOVX S1,AF$OPN ;Function is read existing file
MOVEM S1,ACCFNC
MOVX S1,FB$GET ;SET UP FAC FIELD
MOVEM S1,ACCFAC ;TO ALLOW SHARED READING
MOVX S1,DI$ATT+DI$NAM ;Display Attributes and name
MOVEM S1,ACCDSP
$CALL SNDACC ;Send out file Access message
DCNT20: MOVX S1,POLINI ;[133]
MOVEM S1,FILCRC ;[133]INITIALIZE CRC
$STATE .LLACC ;Get attributes and Ack
$CALL DCNMSG ;Get Servers response
$RETIF ;Return failing status
$CALL ATLOOK ;Find attributes
JUMPF [$FATAL (Remote file attributes not supported)]
MOVEM S1,SRCMOD ;Save the mode
MOVEM S2,DSTMOD ;Save default output mode
CAIE S2,.MD8 ;Destination mode must be ascii
$FATAL (File is not ASCII)
MOVE S1,MODTB3(S1) ;Get processor address
MOVEM S1,DATDAT ;Save it
$CALL SNDCTC ;START UP A DATA STREAM
$STATE .LLCTL ;Accept Ack from server
$CALL DCNMSG ;Get the Ack
$RETIF ;Return failing status
$CALL SNDCTR ;Start record retrivial
$STATE .LLDAT ;Accept Data or Status
$CALL DCNMSG
$RETIF ;Return failing status
$CALL TSTPRN ;Do CRLF if needed
$STATE .LLACP ;Wait for Access complete
$CALL DCNMSG ;GET THE ACCOMP ACK
$RETIF ;Return failing status
TXNN S,S%ACP ;Access complete
JRST DCNT20 ;No..process next file
$RETT ;ALL DONE!
SUBTTL DCNSND Active task to send files
;DCNSND Holds these truths to be self evident:
; 1) The default mode for reading files is /IMAGE if no switches
; are specified.
; 2) The local file will be read using the mode specified by the
; local file switches.
; 3) If the user specified any remote file switches the file will
; be created using specified mode.
; 4) If no remote switches are specified the remote file will be
; created using the mode of the input file. If the remote FAL
; cannot create files in that mode the following occurs:
; a) If the local input mode is /ASCII a second try will be made
; to create the file as if the user had specified /ASCII/VARIABLE
; on the remote file specification.
DCNSND: $SAVE <P1> ;Preserve an AC
$CALL SETINP ;Setup for local file input
$RETIF ;[147]
MOVEI S1,.DMNAM ;Signify name message type
$CALL DCNRTN ;Give expanded name to caller
SKIPN .DFLFA(AP) ;Local file mode specified?
JRST [SETZM SRCMOD ;No..clear requested mode
MOVE T1,REMOST ;Talking to TOPS20?
CAIN T1,.OSTP20 ;[103]
JRST .+1 ;Yes..use default mode
LOAD T2,.FBBYV+LOCFDB,FB%BSZ ;[103]No..get file bytesize
MOVEI S1,.MD1 ;Assume image mode
CAIE T1,.OSTP10 ;[103]TOPS10?
CAIE T2,^D36 ;[103]Unless bytesize is 7 or 36
CAIN T2,^D7 ;[103]
MOVEI S1,.MD8 ;Use ascii mode
MOVEM S1,SRCMOD
JRST .+1] ;Continue
$CALL SETMOD ;Setup proper data mode
JUMPF [$FATAL (Can't establish requested input mode)]
STORE S2,ATTBSZ ;Save bytesize for attributes
MOVX S1,AT$BSZ ;Set bitsize menu bit
IORM S1,ATTMNU
$CALL OPNFIL ;Open in requested mode
JUMPT DCNSN1 ;[131]Branch if OPENF succeeded
CAIE S2,OPNX31 ;[131]Off-line file?
$RETIF ;[147]
$RETT ;[131]Off-line, go on to next
DCNSN1: MOVE S1,SRCMOD ;[131]Get our source mode
HRLI P1,(POINT 4) ;Create default mode pointer
HRRI P1,MODTB2(S1) ; per source mode
SKIPN S1,DSTMOD ;Have a destination mode?
ILDB S1,P1 ;No..get default
DCNS10: SKIPN S1 ;[125]DO WE HAVE A DEST MODE?
$CALL PICMOD ;[125]NO, GO PICK ONE
MOVE S2,.DFRFA(AP) ;Get remote attributes
TXNN S2,DF%MRS ;MRS specified?
IORX S2,<FLD(^D512,DF%MRS)> ;No..use nice default
$CALL SETATT ;Yes..setup attributes
MOVE S1,REMOST ;[153]GET SYSTEM TYPE
CAIE S1,.OSRST ;[153]IS IT RSTS?
JRST DCNS11 ;[153]NO
MOVX S1,FB$SUP ;[153]SUPERCEED EXISTING FILE
IORM S1,ATTFOP ;[153]
MOVX S1,AT$FOP ;[153]MENU BIT FOR FOP FIELD
IORM S1,ATTMNU ;[153]SET IT
DCNS11: MOVE S1,OURDSP ;Send out all supported attribs
TXZ S1,DI$NAM ;Except name attributes
$CALL SNDDSP ;Send file attributes
MOVX S2,FB$PUT ;Setup ACCESS (Create)
MOVEM S2,ACCFAC
MOVX S1,DI$ATT+DI$NAM ;Request Attributes and name
MOVEM S1,ACCDSP
SETOM CRCFLG ;Request CRC validation
$CALL SNDACC ;Send off the Access message
$STATE .LLACC ;Accept Ack for Access
$CALL DCNMSG ;Get servers response
JUMPT DCNS20 ;Onward if we received ack
;Here to see if we can try a second default for remote file attributes
MOVE T1,S1 ;Get the error code
TXZ T1,ER%FLD ;Clear field type
CAXE T1,FLD(ER$USP,ER%MAC)+FLD(.DMATT,ER%TYP)
$RETF ;No..return the DAP status
SKIPE .DFRFA(AP) ;Remote switches specified?
$FATAL (Remote system does not support requested mode)
ILDB S1,P1 ;Get the next default
JUMPN S1,DCNS10 ;Yes..try it out
$FATAL (Remote system does not support default mode)
DCNS20: MOVX S1,POLINI ;[133]
MOVEM S1,FILCRC ;[133]INITIALIZE CRC
$CALL SNDCTC ;START UP A DATA STREAM
$STATE .LLCTL ;Get Ack for Contol
$CALL DCNMSG ;GET THE ACK
$RETIF ;Get failing status
$CALL SNDCTS ;Send ctl msg to start Xmission
$STATE .LLDAT+S%PUT ;We're doing a PUT
$CALL DCNMSG ;Send the data
$RETIF ;Get failing status
$STATE .LLACP ;Access complete state
$CALL DCNMSG ;Get the Accomp (Resp)
$RETIF ;Get failing status
SETZ S1, ;[137]DON'T DELETE
$CALL CLSFIL ;CLOSE OUT LOCAL FILE
$RETIF ;[147]
$RETT ;ALL DONE!
SUBTTL DCNDEL ACTIVE TASK TO DELETE A FILE
SUBTTL DCNEXE ACTIVE TASK TO EXECUTE A FILE
DCNEXE: MOVE S1,OURCAP ;Get capabilities
TXNN S1,SY$EXE ;Support submit?
$FATAL (Remote system does not support file submission)
DCNDEL: MOVX S1,DI$NAM ;Display file name
MOVEM S1,ACCDSP
$CALL SNDACC ;SEND ACCESS MESSAGE FOR DELETE
DCND70: MOVX S1,POLINI ;[133]
MOVEM S1,FILCRC ;[133]INITIALIZE CRC
$STATE .LLACC ;Get Name from Access or Accomp
$CALL DCNMSG ;GET THE SERVERS ACCOMP
$RETIF ;Get failing status
JUMPF .RETF
TXNN S,S%ACP ;Access complete?
JRST DCND70 ;No..back for next file
$RETT ;ALL DONE!
SUBTTL DCNDIR Active Task routine to process Directory request
DCNDIR: MOVE S1,OURCAP ;Get mutual capabilities
TXNN S1,SY$DIR ;Support directory?
JRST DCNPR1 ;No..try anyhow!
MOVE S1,OURDSP ;Get mutually supported display
TXZ S1,DI$NAM ;Get all except name
MOVEM S1,ACCDSP ;Display all
$CALL SNDACC ;Send ACCESS (DIRECTORY)
DCNDI1: MOVX S1,POLINI ;[133]RESET...
MOVEM S1,FILCRC ;[133]...THE CRC
$STATE .LLACC ;Get response from Access
SETZM ATTMNU ;Clear attributes menu
SETZM DTIMNU ;Clear date/time menu
SETZM PROMNU ;Clear protection menu
$CALL DCNMSG ;Process the server's responses
JUMPT DCNDI2 ;[132]Got valid message
TXNN S,S%LERR ;[132]STATUS MESS RECEIVED?
$RET ;[132]NO
MOVE S1,STSCOD ;[132]Get status
MOVE S2,STSSTV ;[132]
CAXN S1,FLD(ER$FIL,ER%MAC)+FLD(ER$FLK,ER%MIC) ;[132]FILE LOCKED?
JRST DCNDI0 ;[132]YES, CONTINUE
CAXN S1,FLD(ER$FIL,ER%MAC)+FLD(ER$PRV,ER%MIC) ;[132]PRIV VIOLATION?
JRST DCNDI0 ;[132]YES, CONTINUE
CAXN S1,FLD(ER$FIL,ER%MAC)+FLD(ER$ACC,ER%MIC) ;[132]CAN'T ACCESS?
JRST DCNDI0 ;[132]YES, CONTINUE
CAXN S1,FLD(ER$FIL,ER%MAC)+FLD(ER$ATR,ER%MIC) ;[132]ATT READ ERROR?
JRST DCNDI0 ;[132]YES, CONTINUE
$RET ;[132]DON'T CONTINUE
DCNDI0: HRROI T1,STSTXT ;[132]Storage for error status
$CALL TYPSTS ;[132]Store error text
$TEXT (,^T/NAMFNM/ Remote status - ^T/STSTXT/) ;[132]
$CALL SNDCON ;[132]Yes, send CONTROL(skip)
JRST DCNDI1 ;[132]Continue
DCNDI2: TXNN S,S%ACP ;[132]Access complete?
JRST DCNDI1 ;No..back for next file
$RETT
DCNPRN: MOVE S1,OURCAP ;Get mutual capabilities
TXNN S1,SY$SPL ;Support spooling?
$FATAL (Remote system does not support spooling option)
MOVX S1,FB$SPL ;Yes..save for Access complete
MOVEM S1,ACPFOP
DCNPR1: MOVEI S1,ATTMSD ;Point to attributes message
$CALL CLRMSG ;Clear it
MOVX S2,FB$SPL ;[146]FOP BIT FOR PRINTING
MOVEM S2,ATTFOP ;[146]SAVE IN ATTRIBUTES MESSAGE
MOVX S2,AT$FOP ;[146]FOP MENU BIT
MOVEM S2,ATTMNU ;[146]SET IN ATTRIBUTES MENU
$CALL QUEMSG ;Send it off
$RETIF
MOVX S1,AF$OPN ;Open the file
MOVEM S1,ACCFNC
MOVX S1,FB$GET ;SET UP FAC FIELD
MOVEM S1,ACCFAC ;TO ALLOW SHARED READING
MOVE S1,OURDSP ;Request all attributes
MOVEM S1,ACCDSP
$CALL SNDACC ;Send out file Access message
DCNPR2: MOVX S1,POLINI ;[133]RESET...
MOVEM S1,FILCRC ;[133]...THE CRC
$STATE .LLACC ;Wait for file attributes
$CALL DCNMSG ;Get Servers response
$RETIF ;Return failing status
$STATE .LLACP ;Wait for Accomp (Resp)
$CALL DCNMSG ;GET THE ACCOMP ACK
$RETIF ;Return failing status
TXNN S,S%ACP ;Access complete?
JRST DCNPR2 ;No..back for next file
$RETT
SUBTTL DCN Unimplimented functions
DCNREN: $FATAL (Function not implimented)
DCNSUB: $FATAL (Function not implimented)
SUBTTL VALCFG Validate contents of a CONFIG message
VALCFG: MOVX S1,DPMXM ;Get my maximum message size
;[161] MOVE S2,REMOST ;[106]
;[161] CAIN S2,.OSVAX ;[106]A VAX?
;[161] MOVEI S1,DPMXMV ;[106]YES
SKIPE CFGSIZ ;Use it if Config size is zero
CAMGE S1,CFGSIZ ;Is config size smallest?
MOVEM S1,CFGSIZ ;No..use my maximum size
MOVE S1,CFGSIZ ;Compute maximim record size
MOVEM S1,OURSIZ ;Save as maximum buffer size
SUBI S1,DPMXH-2 ; as buffer size minus maximum
MOVEM S1,OURMRS ; header size
SKIPN S1,CFGOST ;OSTYPE valid?
$MIERR .DMCFG,21 ;No..illegal field value
SKIPE REMOST ;[106]If remote type not specified..
CAMN S1,REMOST ;[106]..or specified correctly
SKIPA ;[106]Don't complain
$WARN (Remote OS type different from that specified with SET DEFAULT)
;[106]
MOVEM S1,REMOST ;Save remote OSTYPE
SKIPN CFGFST ;Filesys field valid?
$MIERR .DMCFG,22 ;No..illegal field value
MOVE S1,CFGVER ;Get Major DAP version
DPB S1,[POINT 8,T1,7] ;Assemble version info
MOVE S1,CFGECO ;Get minor DAP version
DPB S1,[POINT 8,T1,15]
MOVE S1,CFGUSR ;Get DAP user version
DPB S1,[POINT 8,T1,23]
MOVE S1,CFGSFT ;Get DAP software version
DPB S1,[POINT 8,T1,31]
MOVE S1,CFGUSS ;Get user software version
DPB S1,[POINT 4,T1,35]
CAXLE T1,DAPVER ;Use lowest version
MOVX T1,DAPVER
MOVEM T1,OURVER
DMOVE S1,CFGCAP ;Get system capabilities
AND S1,[CAP1] ;Get logical AND of capabilities
AND S2,[CAP2] ; ...
DMOVEM S1,OURCAP ;Save as our mutual capabilities
MOVX T2,DI$ATT ;Get attributes display bit
TXNE S1,SY$PRO ;Support protection attributes?
TXO T2,DI$PRO ;Yes..Dont request it's display
TXNE S1,SY$DTI ;Support date/time attributes?
TXO T2,DI$DTI ;Yes..Dont request it' display
TXNE S2,SY$NAM ;Support name message?
TXO T2,DI$NAM ;Yes..Dont request it's display
MOVEM T2,OURDSP ;Save mutual display bits
$RETT
SUBTTL VALATT Validate contents of an ATTRIBUTES message
VALATT: MOVE S1,ATTDAT ;Get DATATYPE field
LOAD S2,.DFFLG(AP),DF%ACC ;[135]GET FUNCTION
CAIN S2,AF$DIR ;[135]DIRECTORY?
JRST NODATC ;[135]YES, DON'T CHECK DAT
TXNN S1,DT$ASC!DT$IMA ;Ascii or image?
$MIERR .DMATT,21 ;No..illegal field
NODATC: TXNE S1,DT$EBC!DT$CMP ;[135]Ebcdic or compressed?
$MUERR .DMATT,21 ;Yes..unsupported attributes
MOVEI S1,.FBLEN ;Get the size of our FDB
MOVEI S2,ATTFDB ;Point to it
$CALL .ZCHNK ;Clear it
MOVE S1,ATTBSZ ;Save byte size from attributes
CAILE S1,^D36 ;Too large?
$MIERR .DMATT,36 ;Yes..return unsupported
STORE S1,.FBBYV+ATTFDB,FB%BSZ
MOVE T1,ATTMNU ;Get attributes menu
TXNN T1,AT$ALQ ;ALQ field present?
JRST VALAT1 ;No..skip it
MOVE S1,ATTALQ ;Number of blocks allocated
IDIVI S1,4 ; divided by 4
SKIPE S2 ; rounded up
ADDI S1,1 ; equals number of pages
STORE S1,.FBBYV+ATTFDB,FB%PGC
SKIPN S1,ATTBLS ;Block size given?
MOVEI S1,^D512 ;No..assume 512
IMUL S1,ATTALQ ;BLS * ALQ
STORE S1,.FBSIZ+ATTFDB ;Is approximate file byte count
VALAT1: TXC T1,AT$EBK+AT$BLS+AT$FFB ;Can we compute file byte count?
TXCE T1,AT$EBK+AT$BLS+AT$FFB
JRST VALAT3 ;No..skip it
MOVE S1,ATTEBK ;Yes..end of file block
SUBI S1,1 ; Converted to LBN
IMUL S1,ATTBLS ; times bytes per block
ADD S1,ATTFFB ; plus first free byte
STORE S1,.FBSIZ+ATTFDB ; equals file byte count
VALAT3: MOVE S1,ATTFOP ;Save attributes options
MOVEM S1,FILFOP
$STATE .LLATT ;Move to attributes state
$RETT
SUBTTL VALDTI Validate the contents of DATE/TIME attributes extention
VALDTI: SKIPN T1,DTIMNU ;Anything specified?
$RETT ;No..just return
MOVE S1,DTICDT ;Get creation date/time
TXNE T1,DA$CDT ;Was it given?
MOVEM S1,.FBCRV+ATTFDB ;Yes..store it
MOVE S1,DTIRDT ;Get last update date/time
TXNE T1,DA$RDT ;Was it specified?
MOVEM S1,.FBWRT+ATTFDB ;Yes..store it
$RETT
SUBTTL VALPRO Validate the contents of protection attributes message
VALPRO: SKIPN T1,PROMNU ;Get protection menu
$RETT ;Return if menu is null
;[116]deleted 3 lines here
SKIPE S1,PROSLF ;Get owners protection
STORE S1,.FBPRT+ATTFDB,FP%SLF
SKIPE S1,PROGRP ;Get group protection
STORE S1,.FBPRT+ATTFDB,FP%GRP
SKIPE S1,PROWLD ;Get wild protection
STORE S1,.FBPRT+ATTFDB,FP%WLD
$RETT
SUBTTL VALNAM Validate the contents of a NAME message
;Returns TRUE S1/ Flag from name message
; S2/ Pointer to string
VALNAM: SKIPN S1,NAMTYP ;Get the name menu flags
$MIERR .DMNAM,20 ;Invalid menu
TXNE S1,NA$DFS!NA$RFS ;Do we support it?
$MUERR .DMNAM,20 ;No..unsupported
TXNE S1,NA$FSP ;File spec?
HRROI S2,NAMFSP ;Yes..point to it
TXNE S1,NA$VOL ;Volume (or device)
HRROI S2,NAMVOL ;Yes..point to it
TXNE S1,NA$DIR ;Directory?
HRROI S2,NAMDIR ;Yes..point to it
TXNE S1,NA$FNM ;File name?
HRROI S2,NAMFNM ;Yes..point to it
$RETT
SUBTTL VALCRC Routine to validate the CRC
VALCRC: SKIPL ACPCRC ;Was CRC specified?
SKIPT CRCFLG ;Checking CRC?
$RETT ;No..always return true
MOVE S1,FILCRC ;Get computed CRC
CAME S1,ACPCRC ;Had better match
$MCERR (ER$CRC) ; else bad CRC
$RETT
SUBTTL SNDCFG Send CONFIG message
SNDCFG: MOVEI S1,DPMXM ;Store maximum buffer size
;[161] MOVE S2,REMOST ;[106]GET REMOTE SYSTEM TYPE
;[161] CAIN S2,.OSVAX ;[106]IS IT VMS?
;[161] MOVEI S1,DPMXMV ;[106]YES, USER THE VMS MAX MESS SIZE
MOVEM S1,CFGSIZ
MOVEI S1,.OSTP20 ;Store operating system type
MOVEM S1,CFGOST
MOVEI S1,.FST20 ;Store file system type
MOVEM S1,CFGFST
MOVEI S1,.DVMAJ ;Store DAP major version
MOVEM S1,CFGVER
MOVEI S1,.DVMIN ;Store DAP minor version
MOVEM S1,CFGECO
MOVEI S1,.DVUSR ;Store DAP user version
MOVEM S1,CFGUSR
MOVEI S1,.DVSFT ;Store DECnet version
MOVEM S1,CFGSFT
MOVEI S1,.DVUSF ;Store User DECnet version
MOVEM S1,CFGUSS
DMOVE S1,[EXP CAP1,CAP2] ;Store our capabilities
DMOVEM S1,CFGCAP
MOVEI S1,CFGMSD ;Build configuration message
$CALL PUTMSG ;Force it out
$RETT
SUBTTL SNDACC Send an ACCESS message
;Accepts ACCxxx setup by caller and DAPDCN
SNDACC: MOVE S1,OURVER ;Get version level check
;[133]delete 2 lines here
MOVX S1,AF$DIR ;Is this directory request?
CAME S1,ACCFNC
$CALL CHKWLD ;No..Check for unsupported wild cards
MOVE S1,OURCAP ;Get mutual capabilities
TXNN S1,SY$CRC ;Do we both support CRC?
SETZM CRCFLG ;No..don't ask for it
MOVX S1,AO$CRC ;Get bit to request CRC
SKIPE CRCFLG ;Want to do it?
IORM S1,ACCOPT ;Yes..then request it
MOVE S1,[POINT 7,ACCFIL] ;[136]
$CALL CONREM ;[136]MAKE SYNTAX CORRECT FOR REMOTE
MOVEI S1,ACCMSD ;Point to message descriptor
$CALL PUTMSG ;Force it out
$CALL RESREM ;[136]RESTORE THE FILE NAME
$RETT
CHKWLD: DMOVE S1,OURCAP ;Get mutual capabilities
TXNE S2,SY$WLD ;Support wild cards?
$RETT ;Yes..all is well
MOVE S1,[POINT 7,ACCFIL] ;Point to filespec
CHKWL1: ILDB S2,S1 ;Get a byte
JUMPE S2,.RETT ;Return on end of string
CAIE S2,"*" ;Wild card?
CAIN S2,"%"
JRST CHKWL2 ;Yes..we don't support it
CAIE S2,"?"
JRST CHKWL1 ;Back to check all characters
CHKWL2: $FATAL (Remote system does not support wild card operations)
SUBTTL SNDCTC Send a CONTROL (CONNECT) message
SNDCTC: MOVEI S1,CTLMSD ;Point to control message
$CALL CLRMSG ;Clear all fields
MOVX S2,CF$CON ;Function is start a data stream
MOVEM S2,CTLFNC
MOVX S2,CT$RAC ;Get Menu bits
MOVEM S2,CTLMNU
MOVX S2,RB$SQF ;Sequential file transfer
MOVEM S2,CTLRAC
$CALL PUTMSG ;Force it out
$RETT
SUBTTL SNDCTR Send a CONTROL (GET) message
SNDCTR: MOVEI S1,CTLMSD ;Point to control message
$CALL CLRMSG ;Clear it out
MOVX S2,CF$GET ;Get GET function
MOVEM S2,CTLFNC
MOVX S2,CT$RAC ;Get menu bits
MOVEM S2,CTLMNU
MOVX S2,RB$SQF ;Sequential transfer
MOVEM S2,CTLRAC ; for Record Access
PJRST SNDCTL ;Check to see if block mode ok.
$RETT
SUBTTL SNDCTS Send a CONTROL (PUT) message
SNDCTS: MOVEI S1,CTLMSD ;Point to control message
$CALL CLRMSG ;Clear it out
MOVX S2,CF$PUT ;PUT PUT function
MOVEM S2,CTLFNC
MOVX S2,CT$RAC ;Get menu bits
MOVEM S2,CTLMNU
MOVX S2,RB$SQF ;Sequential transfer
MOVEM S2,CTLRAC ; for Record Access
PJRST SNDCTL ;Check to if block mode ok.
SNDCTL: SKIPN .DFLFA(AP) ;User specified mode?
SKIPE .DFRFA(AP)
PJRST SNDCT1 ;Yes..don't do page mode
MOVE S1,REMOST
CAIE S1,.OSTP20 ;Talking to TOPS20?
JRST SNDCT1 ;No..don't do page mode
MOVE S1,OURCAP
TXNN S1,SY$VBN ;Remote FAL support block mode?
JRST SNDCT1
MOVE S1,ATTDEV
TXNN S1,FB$MDI ;Remote device DSK?
JRST SNDCT1
LOAD S1,LOCDEV,DV%TYP
CAIE S1,.DVDSK ;Local device DSK?
JRST SNDCT1
SETOM PAGFLG ;Great..use page mode
SETZM CTLKEY ;Start with VBN 0 (FDB)
MOVX S1,CT$KEY ;Set the menu bit
IORM S1,CTLMNU
MOVX S1,RB$BKF ;Request block mode
MOVEM S1,CTLRAC
MOVE S1,[GETPAG,,PUTPAG] ;Setup proper processor
MOVEM S1,DATDAT
SNDCT1: MOVEI S1,CTLMSD ;Point to the message
$CALL PUTMSG ;Send it off
$RETT
SUBTTL SNDCON Send a CONTROL TRANSFER (Skip) message ;[132]
SNDCON: MOVEI S1,CONMSD ;[132]Point to CONTRAN message
$CALL CLRMSG ;[132]Clear it
MOVX S2,CO$SKP ;[132]CONTROL(Skip)
MOVEM S2,CONFNC ;[132]
$CALL PUTMSG ;[132]Force it out
$RETT ;[132]
SUBTTL SNDACK Send an ACKNOWLEDGE message
SNDACK: MOVEI S1,ACKMSD ;Point to ACK message
$CALL PUTMSG ;Force it out
$RETT
SUBTTL SNDEOF Send an EOF status message
SNDEOF: $STATUS ER$TRN,ER$EOF ;EOF status
$CALL SNDSTS ;Send a status message
$STATE .LLACP ;Move to access complete state
$RETT
SUBTTL SNDSTS Routine to send a status message
;Accepts S1/ STATUS CODE
; S2/ SECONDARY STATUS
SNDSTS: DMOVE T1,S1 ;Save Calling args
MOVEI S1,STSMSD ;Point to status message
$CALL CLRMSG ;Clear it out
MOVEM T1,STSCOD ;Save status code
MOVEM T2,STSSTV ;Save extended status
$CALL PUTMSG ;Force it out
$RET
SUBTTL SNDACP Send an ACCOMP (CLOSE) message
SNDACP: MOVX S2,AC$TRM ;Get CLOSE function
MOVEM S2,ACPFNC
$CALL SNDCRC ;Put CRC into ACP message
MOVEI S1,ACPMSD ;Point to message descriptor
$CALL PUTMSG ;Force it out
$RET ;Return
SNDCRC: SKIPT CRCFLG ;Want to send CRC?
$RETT ;No..just ruturn
MOVE S1,FILCRC ;Yes..get what we computed
MOVEM S1,ACPCRC ;Store in the message
$RETT
SUBTTL SNDACA Send an Accomp (Resp) message
SNDACA: MOVEI S1,ACPMSD ;Ppoint to message descriptor
MOVX S2,AC$ACK ;Get ACK function
MOVEM S2,ACPFNC
$CALL PUTMSG ;Force it out
$RETT
SUBTTL SNDWLD Routine to send required name messages per WLDJFN
;Accepts WLDJFN and LOCJFN setup via SETINP
SNDWLD: $SAVE <P1>
MOVE P1,WLDJFN ;Get change flags
TXNN P1,GN%STR ;Structure change?
JRST SNDWL1 ;No..check directory
HRROI S1,NAMVOL
HRRZ S2,LOCJFN
MOVX T1,FLD(1,JS%DEV)+JS%PAF ;Send "DEV:"
JFNS
ERJMP TERCVT ;Return false if error
MOVX S1,NA$VOL ;Say it's a volume (structure)
MOVEM S1,NAMTYP ;Store Name type
$CALL SNDNAM ;Send it off
SNDWL1: TXNN P1,GN%DIR ;Directory change?
JRST SNDWL2 ;No..just send filename
HRROI S1,NAMDIR
HRRZ S2,LOCJFN
MOVX T1,FLD(1,JS%DIR)+JS%PAF ;Send "<Directory>"
JFNS
ERJMP TERCVT ;Return error if this fails
MOVX S1,NA$DIR ;Say its a directory
MOVEM S1,NAMTYP
$CALL SNDNAM ;Send of the directory
SNDWL2: HRROI S1,NAMFNM ;Point to name storage
HRRZ S2,LOCJFN
MOVX T1,FLD(1,JS%NAM)+FLD(1,JS%TYP)+FLD(1,JS%GEN)+JS%PAF
JFNS
ERJMP TERCVT
MOVX S2,NA$FNM ;Say its a filename
MOVEM S2,NAMTYP ;Store the name type
MOVE S1,[POINT 7,NAMFNM] ;[136]POINTER TO FILESPEC
$CALL CONREM ;[136]CONVERT NAME FOR REMOTE
$CALL SNDNAM ;Send it off
$CALL RESREM ;[136]RESTORE FILE NAME STRING
$RETT
SUBTTL SNDDSP Send requested ATTRIBUTES messages
;Accepts S1/ Display field from Access message
SNDDSP: MOVE S2,CFGVER ;Check for old FAL
CAIGE S2,^D5 ;Dap 5.1 or later?
JRST SNDATT ;No..just send attrubutes
$SAVE <P1> ;Preserve P1 for "menu"
SKIPN P1,S1 ;Put requested fields in P1
MOVX P1,DI$ATT ;Default is attributes
AND P1,OURDSP ;Clear impossible requests
TXNE P1,DI$ATT ;Return Main Attributes message?
$CALL SNDATT ;Yes - Send off main attributes
TXNE P1,DI$DTI ;Want DATE and Time message?
$CALL SNDDTI ;Yes - do it
TXNE P1,DI$PRO ;Send Protection message?
$CALL SNDPRO ;Yes - do it
TXNN P1,DI$NAM ;Want Name stuff?
$RETT ;No - then just return ok
MOVX S1,NA$FSP ;Will send whole filespec
MOVEM S1,NAMTYP ;Store argument type
MOVE S1,[POINT 7,NAMFSP] ;[136]
$CALL CONREM ;[136]CONVERT NAME FOR REMOTE SYS
$CALL SNDNAM
$CALL RESREM ;[136]RESTORE THE NAME
$RETT
SUBTTL CONREM/RESREM Send file names in correct format
;CONREM is called to edit a filspec to coorespond to the
; format required by the remote node. This is all
; EDIT [136].
;CONREM S1/ byte pointer to filespec
;RESREM no arguments
CONREM: SETZM SAVPNT ;ZERO THE OLD POINTER
MOVE S2,REMOST ;REMOTE SYSTEM TYPE
CAIE S2,.OSTP20 ;TOPS-20?
CAIN S2,.OSTP10 ;OR TOPS-10?
$RETT ;YES, DO NO CONVERSION
CONR1: ILDB S2,S1 ;GET A BYTE
SKIPN S2 ;END OF STRING?
$RETT ;YES
CAIE S2,"[" ;DIRECTORY?
CAIN S2,"<" ;
JRST CONR4 ;YES, EAT IT UP
CAIE S2,"." ;FOUND END OF FILE NAME?
JRST CONR1 ;NO, KEEP LOOKING
CONR2: ILDB S2,S1 ;LOOK FOR END OF FILE TYPE
SKIPN S2 ;END OF STRING?
$RETT ;YES
CAIE S2,"." ;FOUND END OF FILE TYPE?
JRST CONR2 ;NO, KEEP LOOKING
MOVEM S1,SAVPNT ;YES, SAVE POINTER TO "."
ILDB S2,S1 ;FIRST CHAR OF VERSION
CAIE S2,"-" ;NEGATIVE?
CAIN S2,"0" ;OR ZERO?
JRST CONR3 ;YES, BAD VERSION FOR REMOTE
MOVE S1,SAVPNT ;POINT TO THE PERIOD
MOVEI S2,";" ;REPLACE WITH A SEMICOLON
DPB S2,S1 ;DO IT
$RETT ;RETURN
CONR3: MOVE S1,SAVPNT ;POINT TO THE PERIOD
SETZ S2, ;ZERO
DPB S2,S1 ;END THE NAME AFTER FILE TYPE
$RETT
CONR4: ILDB S2,S1 ;GET A BYTE
SKIPN S2 ;END OF STRING?
$RETT ;YES
CAIE S2,"]" ;END OF DIR?
CAIN S2,">" ;?
JRST CONR1 ;YES
JRST CONR4 ;NO, KEEP EATING THE DIRECTORY
RESREM: SKIPN SAVPNT ;WAS ANYTHING CHANGED?
$RETT ;NO
MOVE S1,SAVPNT ;POINT TO CHANGED BYTE
MOVEI S2,"." ;CHANGE BACK TO A "."
DPB S2,S1 ;CHANGE IT
SETZM SAVPNT ;
$RETT
SUBTTL SNDATT Send an attributes message
;SNDATT is called to send file attributes per this openning of file.
; Datatype and record formats must be setup by SETBSZ.
;Accepts ATTxxx setup via GETFDB, SETBSZ and SETATT
SNDATT: MOVX S1,AT$BSZ ;Get menu bytesize bit
TDNN S1,ATTMNU ;Is it present?
JRST SNDAT2 ;No..assume we are all set
MOVE S2,ATTBSZ ;Get the bytesize
CAIN S2,^D8 ;Is it 8?
ANDCAM S1,ATTMNU ;Yes..no need to send it
LOAD S2,ACCFNC ;Get requested function
CAXE S2,AF$CRE ;Creating a file?
JRST SNDAT1 ;No..send what we have
MOVE S2,REMOST ;Get remote system type
CAXE S2,.OSTP20 ;To TOPS20?
CAXN S2,.OSTP10 ; or TOPS10?
JRST SNDAT1 ;Yes..send everything
MOVX S1,AT$BLS+AT$ALQ+AT$EBK+AT$FFB
ANDCAM S1,ATTMNU ; else don't send these
JRST SNDAT2
SNDAT1: LOAD S2,.FBBYV+LOCFDB,FB%PGC ;Get page count
IMULI S2,^D4 ;Compute block allocated
MOVEM S2,ATTALQ ;ATTALQ=Page_count/4
LOAD T2,.FBSIZ+LOCFDB ;Get actual file bytecnt
LOAD S1,.FBBYV+LOCFDB,FB%BSZ ;Get actual file bytesiz
MOVEI S2,^D36 ;
IDIV S2,S1 ;Compute bytes per word
IMULI S2,^D128 ;Compute bytes per block
MOVEM S2,ATTBLS ;ATTBLS=Bytes_per_word*128
IDIV T2,S2 ;Compute end block
ADDI T2,1 ;EBK begins at 1
MOVEM T2,ATTEBK ;ATTEBK=File_byte_count/ATTBLS+1
MOVEM T3,ATTFFB ;ATTFFB=REM(File_byte_count/ATTBLS)
MOVX S1,AT$BLS+AT$ALQ+AT$EBK+AT$FFB
IORM S1,ATTMNU ;Set proper menu bits
SNDAT2: MOVEI S1,ATTMSD ;Point to message
$CALL QUEMSG ;Send it out
$RET
SUBTTL SNDPRO Send File Protection Attributes
;Accepts LOCFDB setup via GETFDB
SNDPRO: SETZB T1,PROMNU ;Clear our menu
;[116]deleted 6 lines here
SKIPN S1,.FBPRT+LOCFDB ;Get file protection
JRST SNDPR1 ;Send null protection field
MOVEM S1,PROWLD ;Save wild protection
LSH S1,-6
MOVEM S1,PROGRP ;Save group protection
LSH S1,-6
MOVEM S1,PROSLF ;Save owner protection
TXO T1,PR$SLF+PR$GRP+PR$WLD ;Set the menu bits
SNDPR1: MOVEM T1,PROMNU
MOVEI S1,PROMSD ;Point to message descriptor
$CALL QUEMSG ;Send it off
$RET
SUBTTL SNDDTI Send Date/time attributes
;Accepts LOCFDB Setup via GETFDB
SNDDTI: MOVX S2,DA$CDT+DA$RDT ;Get menu bits
SKIPN S1,.FBCRV+LOCFDB ;Get local creation date/time
TXZ S2,DA$CDT ;Clear the menu bit
MOVEM S1,DTICDT
SKIPN S1,.FBWRT+LOCFDB ;Get last update date/time
TXZ S2,DA$RDT ;Clear the menu bit
MOVEM S1,DTIRDT
MOVEM S2,DTIMNU ;Setup the menu
MOVEI S1,DTIMSD ;Point to message descriptor
$CALL QUEMSG ;Send it out
$RET
SUBTTL SNDNAM Send a Name message
;Accepts NAMxxx setup via GETFDB or SNDWLD
SNDNAM: MOVEI S1,NAMMSD ;Point to message descriptor
$CALL QUEMSG ;Send it off
$RET
SUBTTL MSGTBL List of valid DAP messages
;Generate a message table for defined DAP message types
;GETMSG uses this list to accept or reject a specific DAP message type
;Each entry is of the form:
; Message Type,,Message descriptor address
;Message types are defined in the DOMSG macro of DAPSYM
;Define a macro to build the message table entry
DEFINE XX (MSG,VAL,NAME,FLAG) <
.DM'MSG,,MSG'MSD>
;Define a macro to ignore the specific message argument types and version
DEFINE VV (VER) <>
DEFINE YY (FLD,TYP,SIZ,DEF) <>
;Expand the list of valid messages
MSGTBL: DOMSG
MSG$LN==.-MSGTBL
SUBTTL GETMSG Routine to get next DAP message from Link
;Accepts S1/ Message list address
;Returns TRUE Message fields stored in respective storage cells
;
; S1/ Calling message list entry
; S2/ Parsed message type
;Returns FALSE S1/ Sync or Unsupported Error code
; S2/ Parsed message type
GETMSG: $SAVE <P2,P1> ;Preserve some AC's
MOVE P1,S1 ;Remember calling list address
MOVSI P2,-MSG$LN ;Get length of table
$CALL LLRECA ;[154]Get a message
MOVE DL,S1 ;Put message address in DL
$CALL VALHDR ;Validate the header
JUMPF [$SAVE <TF,S1,S2> ;[123]REMOVE BAD MESSAGE...
MOVE S1,RCVLST ;[123]...
$CALL L%DENT ;[123]...FROM RECEIVE QUEUE
$RET] ;[123]
GETMS1: HLRZ S2,MSGTBL(P2) ;Get the message type
CAMN S1,S2 ;Is it a match?
JRST GETMS2 ;Yes..process it
AOBJN P2,GETMS1 ;No..try the next
$STATUS ER$USP,0,ER$TYP ;Not found..unsupported message type
MOVE S2,.DPTYP(DL) ;Return the message type
STORE S2,S1,ER%TYP ;Save in Unsupported status
MOVE S1,RCVLST ;[123]REMOVE BAD MESS...
$CALL L%DENT ;[123]FROM RECEIVE QUEUE
$RETF
GETMS2: SKIPN S2,0(P1) ;Find message in calling list
JRST [$STATUS ER$SNC,0 ;Return SYNC error
MOVE S2,.DPTYP(DL) ;Return message type
STORE S2,S1,ER%MIC ;Save in DAP status
MOVE S1,RCVLST ;[123]REMOVE BAD MESS...
$CALL L%DENT ;[123]...FROM RECEIVE QUEUE
$RETF] ;Return the failure
HLRZ S2,S2 ;Get the list type
CAME S1,S2 ;Is it a match?
AOJA P1,GETMS2 ;No..try the next
HRRZ S1,MSGTBL(P2) ;Get message header address
$CALL VALMSG ;Validate the message
JUMPF [$SAVE <TF,S1,S2> ;Save status for return
MOVE S1,RCVLST
$CALL L%DENT ;Delete the bad message
$RET]
HRRZ S1,0(P1) ;Return calling list entry
HLRZ S2,0(P1) ;Return parsed message type
$CALL 0(S1) ;Call the routine
$SAVE <TF,S1,S2> ;Save staus for return
SKIPGE .DPTYP(DL) ;Want to reparse it?
JRST GETMS4 ;Yes..reset the pointers
MOVE S1,RCVLST ;Point to receive list
$CALL L%DENT ;Delete the entry
MOVE S1,RCVLST
$CALL L%FIRST
SKIPT
SETZM MSGFLG
$RETT
GETMS4: MOVE T1,.DPTYP(DL) ;Reset pointers if reparse wanted
MOVMM T1,.DPTYP(DL)
MOVE T1,.DPLEN(DL)
EXCH T1,.DPCNT(DL)
SUB T1,.DPLEN(DL)
ADJBP T1,.DPBPT(DL)
MOVEM T1,.DPBPT(DL)
HRRZ S1,0(P1) ;Return calling list entry
HLRZ S2,0(P1) ;Return parsed message type
$RETT
SUBTTL VALHDR Routine to validate standard dap message header
;Accepts DL/ Address of current message header
;Creates a new header for this message if more messages follow
;Returns TRUE S1/ Type field of received message
; FALSE S1/ Message format error status
VALHDR: SKIPLE S1,.DPTYP(DL) ;Reparse?
$RETT ;Yes..just return
$SAVE <P1,P2> ;P1 HOLDS FLAGS
SETZB P1,P2 ;P2 HOLDS LENGTH FIELD
$CALL GETBYT ;GET MESSAGE TYPE FIELD
JUMPF [$MFERR 0,10] ;BAD
MOVEM S1,.DPTYP(DL) ;STORE MESSAGE TYPE
MOVEI S1,5 ;Maximum flag size is 5
MOVEI S2,.DPFLG(DL) ;Store in DPFLG
$CALL GETEXF ;GET HEADER FLAGS
JUMPF [$MFERR 0,10] ;NULL - FAILED
MOVE P1,.DPFLG(DL) ;Put the flags in P1
TXNN P1,HD$SID ;STREAMID FIELD IN MESSAGE?
JRST VALHD1 ;NO
$CALL GETBYT ;YES..GET IT
JUMPF [$MFERR 0,11] ;FAILED
MOVEM S1,.DPSID(DL) ;SAVE IT
VALHD1: TXNN P1,HD$LEN ;LENGTH FIELD PRESENT?
JRST VALHD2 ;NO
$CALL GETBYT ;GET IT
JUMPF [$MFERR 0,12] ;FAILED
MOVE P2,S1 ;SAVE IN P2
TXNN P1,HD$LN2 ;LENGTH 256 BIT PRESENT?
JRST VALHD2 ;NO
$CALL GETBYT ;GET HIGH ORDER PART
JUMPF [$MFERR 0,13] ;BAD FORMAT
LSH S1,10 ;MAKE IT HIGH ORDER
ADD P2,S1 ;ADD TO LOW ORDER PART
VALHD2: TXNN P1,HD$BCT ;IS BIT COUNT PRESENT?
JRST VALHD3 ;NO
$CALL GETBYT ;YES..GET IT
JUMPF [$MFERR 0,14] ;BAD FORMAT
MOVEM S1,.DPBCT(DL) ;SAVE IT
CAILE S1,7 ;Within range?
$MIERR (0,14) ;No..return invalid field
MOVE S1,.DPTYP(DL) ;Get message type
CAIA S1,.DMDAT ;Data message ;**Skip for Kludge
$MIERR (0,14) ;No..return invalid field
VALHD3: TXNE P1,HD$SEG ;Segmented message?
$MUERR (0,15) ;Yes..return unsupported
TXNE P1,HD$LEN!HD$LN2 ;IS MESSAGE BLOCKED?
CAMN P2,.DPCNT(DL) ;YES..IS SIZE EXACT?
JRST VALHD5 ;YES..JUST RETURN
MOVE S1,RCVLST ;Message is blocked.
$CALL NEWHDR ;Create a new header
MOVEM P2,.DPCNT(DL) ;Save actual count
SUBM P2,.DPCNT(S2) ;Adjust next message count
MOVNS T1,.DPCNT(S2) ;Get positive count
MOVEM T1,.DPLEN(S2) ;Save actual length
ADJBP P2,.DPBPT(S2) ;Adjust next message pointer
MOVEM P2,.DPBPT(S2) ;Save for next parse
SETZM .DPTYP(S2) ;Clear next message type
SETZM .DPFLG(S2) ;Clear next message flags
SETZM .DPBCT(S2) ;Clear next message bitcnt
VALHD5: MOVE S1,.DPCNT(DL) ;Set length and count the same
MOVEM S1,.DPLEN(DL)
MOVE S1,.DPTYP(DL) ;Return current message type
$RETT
SUBTTL NEWHDR Routine to create a new header only
;Accepts S1/ Send of recieve list address
;Returns TRUE DL/ Address of new message header
; S2/ Address of old message header
; Old header copied to new header
NEWHDR: MOVEI S2,.DPSIZ ;Create header entry
$CALL L%CBFR ; Before current entry
HRL S1,DL ;Source is old header
HRR S1,S2 ;Dest is new header
BLT S1,.DPSIZ-1(S2) ;Copy old header
EXCH DL,S2 ;Make new header current
$RETT
SUBTTL VALMSG Routine to parse current DAP message
;VALMSG reads the message descriptor and parses each argument field
; described in the message descriptor. The message descriptor
; is defined using the DOMSG and xxxMSG macros that live in
; DAPSYM, thus to add another message or field to a message
; it is only necessary to add the definition to DAPSYM.
;VALMSG will ensure that the message information is parsed and stored
; in the appropriate local storage.
;Accepts S1/ Address of message descriptor
;Returns TRUE All message fields stored
; FALSE S1/ Message format error code
; S2/ Parsed message type
VALMSG: $SAVE <P1,P2,P3,P4>
MOVE P1,S1 ;P1 points to message descriptor
$DEBUG (Parsing ,<^Q/0(P1),RHMASK/ message>)
MOVE T1,2(P1) ;Get message flags and fld count
TXNN T1,DA%NOZ ;Clear message before recieve?
$CALL CLRMSG ;Yes..zero message storage
MOVX P3,FLD(ER$FMT,ER%MAC)+FLD(20,ER%FLD) ;Init format error
HLRZ S1,0(P1) ;Get message type
STORE S1,P3,ER%TYP ;Save message type in error code
HRLZ T1,T1 ;Get message field count
JUMPE T1,VALMS7 ;Exit if no message fields
MOVN T1,T1 ;Negate it to form AOBJN pointer
HRRI T1,3(P1) ;Point to first argument
MOVE P1,T1 ;Put pointer in P1
SETOM P2 ;Setup initial menu
VALMS1: MOVE T1,(P1) ;Get next field type
TXNN T1,DA%VER ;Want version check?
JRST VALMS2 ;No..see if default is present
ADDI P1,1 ;Yes..point past it
AOJA P1,VALMS1 ;Get the next field descriptor
VALMS2: LOAD S1,T1,DA%SIZ ;Get max size of argument
LOAD S2,T1,DA%STG ;Get storage offset for argument
MULINK< ADD S2,CP> ;Get actual storage address
LOAD P4,T1,DA%TYP ;Get argument type
TXNN T1,DA%DEF ;Default present?
JRST VALMS3 ;No..call the processor
ADDI P1,1 ;Yes..point to it
MOVE T1,0(P1) ;Get the default
MOVEM T1,(S2) ;Store it
;VALMSG Continued on next page
;VALMSG Continued from previous page
VALMS3: TXNN P2,1 ;Is field specified by menu?
JRST VALMS5 ;No..skip it
HLRZ T1,ARGTBL(P4) ;Yes..get processor address
CAIN P4,.ARDAT ;Message data field?
JRST VALMS4 ;Yes..always call the processor
SKIPG .DPCNT(DL) ;No..is field present?
TDZA S1,S1 ;No..clear possible menu result
VALMS4: $CALL 0(T1) ;Yes..call the processor
JUMPF VALMS6 ;Return format error if false
VALMS5: LSH P2,-1 ;Shift menu one place
CAIN P4,.ARMNU ;Argument type a menu?
AND P2,S1 ;Yes..Save selected menu bits
ADDI P3,1 ;Bump format error to next field
AOBJN P1,VALMS1 ;Do all fields
MOVE T1,.DPTYP(DL) ;Get message type
CAIE T1,.DMCFG ;Don't check length for config
CAIN T1,.DMDAT ; or data message
JRST VALMS7 ;Data will be processed later
SKIPG .DPCNT(DL) ;Finished..Everything parse?
JRST VALMS7 ;Yes..return success
MOVX S1,ER$USP ;No..specify Unsupported field
STORE S1,P3,ER%MAC
VALMS6: TXNE S,S%JERR ;[127]WAS IT A JSYS ERROR?
$RETF ;[127]YES RETURN IT
MOVE S1,P3 ;Get current field format error
LOAD S2,S1,ER%TYP ;Extract message type
$RETF ;Return the failure
VALMS7: $RETT
SUBTTL CLRMSG Routine to clear DAP message storage
;Accepts S1/ Message descriptor address
CLRMSG: $SAVE <S1,S2> ;Preserve scratch AC's
HRRZ S2,1(S1) ;Get starting offsett
HLRZ S1,1(S1) ;Get size of storage
MULINK< ADD S2,CP> ;Get storage address
$CALL .ZCHNK
$RETT
SUBTTL GETFIX Routine to process DAP byte arguments
;GETFIX Get 1 to 4 bytes from DAP message
;Accepts S1/ number of bytes to retrieve
; S2/ destination address
;Returns S1/ result (bytes stored right to left)
; S2/ destination address
GETFIX: CAIL S1,1 ;Check range
CAILE S1,4
$RETF ;Return failure
MOVE T1,S1 ;Save byte count
$CALL GETBYT ;Get byte from message
$RETIF ;Return on failure
MOVE T2,S1 ;Put byte in T2
SOJE T1,GETFI1 ;Exit if count is zero
$CALL GETBYT
$RETIF
DPB S1,[POINT 8,T2,27] ;Store next byte
SOJE T1,GETFI1 ;Exit if count is zero
$CALL GETBYT ;Get next byte
$RETIF ;Return on failure
DPB S1,[POINT 8,T2,19] ;Store next byte
SOJE T1,GETFI1 ;Exit if count is zero
$CALL GETBYT
$RETIF ;Return on failure
DPB S1,[POINT 8,T2,11] ;Store this byte
GETFI1: MOVEM T2,(S2) ;Store the result
MOVE S1,T2 ;Return answer in S1
$RETT
SUBTTL GETBYT Routine to return a single DAP message byte
;GETBYT is the lowest level routine called in message parsing
; It is called to return a single DAP message byte
;Returns TRUE S1/ 8 bit byte from message
; FALSE S1/ 0 (no more bytes in current message)
GETBYT: SOSGE .DPCNT(DL) ;Is byte available?
JRST [SETZM S1 ;No..Clear our answer
$RETF] ;Return a failure
ILDB S1,.DPBPT(DL) ;Yes..return the byte
$RETT
SUBTTL GETVAR Routine to process DAP variable length arguments
;GETVAR Get variable length ascii field from DAP message
; Field is stored as an Asciz string
;Accepts S1/ Maximum size of argument
; S2/ Storage address
;Returns S1/ Actual size of argument
; S2/ Storage address
GETVAR: MOVE T1,S1 ;Put count in T1
$CALL GETBYT ;Get the count byte
$RETIF ;Return on failure
CAMLE S1,T1 ;Check length of field
$RETF ;Argument to long
$SAVE <S1,S2> ;Save returning arguments
HRLI S2,(POINT 7) ;Point to destination
SKIPN T1,S1 ;Put actual count in T1
JRST GETVA2 ;Exit on null count
GETVA1: $CALL GETBYT ;Get a byte from message
$RETIF ;Return on failure
IDPB S1,S2 ;Store the byte in message
SOJG T1,GETVA1 ;Get all the bytes
GETVA2: IDPB T1,S2 ;Store a null
$RETT ;Return
SUBTTL GETINT Routine to process DAP integer arguments
;GETINT Get variable length integer field from DAP message
;Accepts S1/ Maximum size of field
; S2/ Storage address
;Returns S1/ Argument low order bits
; S2/ Argument high order bits
GETINT: HRR T4,S2 ;Save original address
HRL T4,S1 ;Save original count
SETZB T1,T2 ;Clear the result
$CALL GETBYT ;Get the count byte
$RETIF ;Return on failure
JUMPE S1,GETIN1 ;Exit on null count
CAIG S1,^D9 ;Argument length ok?
CAMLE S1,.DPCNT(DL) ;Enough bytes left?
$RETF ;No..return the error
MOVE T3,S1 ;Store the actual length
$CALL GETBYT ;Get the least significant byte
DPB S1,[POINT 8,T1,35] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T1,27] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T1,19] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T1,11] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 4,T1,3] ;Store 4 bits
LSH S1,-4 ;Get the next 4
DPB S1,[POINT 4,T2,35] ;Store them
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T2,31] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T2,23] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T2,15] ;Store it
SOJE T3,GETIN1 ;Exit if count is zero
$CALL GETBYT ;Get the next byte
DPB S1,[POINT 8,T2,7] ;Store it
GETIN1: DMOVE S1,T1 ;Return the result
MOVEM S1,0(T4) ;Save low order part
HLRZ T3,T4 ;Get argument length
CAIL T3,^D5 ;Want a high order part?
MOVEM S2,1(T4) ;Save high order part
$RET
SUBTTL GETPRO Routine to get Protection field from DAP message
;GETPRO Get 3 byte extensible protection field from message
; and store in internal format
;Accepts S1/ Size of protection field (3)
; S2/ Storage address
;Returns S1/ Internal protection right justified
; S2/ Storage address
GETPRO: PUSH P,S2 ;Save storage address
$CALL GETEXF ;Process as extensible field
MOVX S2,77 ;Assume full access allowed
TXNE S1,PR$DRA ;Allow read access?
TXZ S2,FP%RD ;No..then deny it
TXNE S1,PR$DWA ;Allow write access?
TXZ S2,FP%WR ;No..then deny it
TXNE S1,PR$DEA ;Allow execute access?
TXZ S2,FP%EX ;No..then deny it
TXNE S1,PR$DAA ;Allow append access?
TXZ S2,FP%APP ;No..then deny it
TXNE S1,PR$DLA ;Allow directory list access?
TXZ S2,FP%DIR ;No..then deny it
CAIE S2,77 ;Anything denied?
TXZ S2,1 ;Yes..clear LSB
MOVE S1,S2 ;Put internal protection in S1
POP P,S2 ;Restore storage address
MOVEM S1,(S2) ;Store the result
$RET ;Return True/false per result
; of GETEXF call
SUBTTL GETEXF Routine to process DAP extensible fields
SUBTTL GETMNU Routine to process DAP extensible menu fields
;GETEXF Reads an extensible field from DAP message
;Extensible fields are stored right justifed and may be up to
;70 information bits in length (10 dap bytes)
;The Extention bits are not stored in the extensible field
;Accepts S1/ Maximum size of field
; S2/ Storage address
;Returns S1/ Low order bits of extensible field
; S2/ High order bits of extensible field
GETMNU:
GETEXF: SETZB T1,T2 ;Clear result
SETZM T3 ;Clear counter
MOVE T4,S1 ;Save maximum size
GETEX1: $CALL GETBYT ;Get the low order byte
$RETIF ;Return on error
CAILE T3,^D10 ;Done too much?
$RETF ;Yes..return failure
DPB S1,EXFTBL(T3) ;Store the byte
CAIN T3,5 ;Doing 1 bit entry?
JRST GETEX2 ;Yes..store next 6 bits
TXNN S1,DP$EXF ;No..Extended?
JRST GETEX3 ;No..check the result
AOJA T3,GETEX1 ;Get next byte
GETEX2: ADDI T3,1 ;Get next pointer
LSH S1,-1 ;Get next 6 bits
DPB S1,EXFTBL(T3) ;Store them
TXNE S1,DP$EXF/2(T3) ;Extended?
AOJA T3,GETEX1 ;Yes..do the next byte
GETEX3: CAILE T3,1(T4) ;Done too many bytes?
$RETF ;Yes..return failure
MOVEM T1,0(S2) ;Store low order bits
CAILE T4,5 ;Double word value?
MOVEM T2,1(S2) ;Yes..store high order bits
DMOVE S1,T1 ;Return result in S1-S2
$RETT
EXFTBL: POINT 7,T1,35 ;Byte 0 (bits 1-7)
POINT 7,T1,28 ;Byte 1
POINT 7,T1,21 ;Byte 2
POINT 7,T1,14 ;Byte 3
POINT 7,T1,7 ;Byte 4
POINT 1,T1,0 ;Byte 5 (bit 7)
POINT 6,T2,35 ;Byte 5 (bits 1-6)
POINT 7,T2,29 ;Byte 6 (bits 1-7)
POINT 7,T2,22 ;Byte 7
POINT 7,T2,15 ;Byte 8
POINT 7,T2,8 ;Byte 9
POINT 2,T2,1 ;Byte 10 (Bits 6-7)
SUBTTL GETDTI Routine to process Date/time field in DAP message
;GETDTI Gets an 18 byte date time field stored as dd-mmm-yyyy hh:mm
; and stored the field in standard internal format
;Accepts S1/ Argument size (18)
; S2/ Storage address
;Returns S1/ Internal Date/time
; S2/ Storage address
GETDTI: CAMLE S1,.DPCNT(DL) ;Enough room in message?
$RETF ;No..return failure
PUSH P,S2 ;Save storage address
MOVEI S2,MSGJNK ;Point to temporary string
HRLI S2,(POINT 7) ;Generate pointer
MOVE T1,S1 ;Move count to T1
$CALL GETVA1 ;Extract bytes from message
JUMPF GETDT1 ;Return False on failure
HRROI S1,MSGJNK ;Point to string
MOVX S2,IT%NNM!IT%AIS!IT%AAC!IT%NTM!IT%NTZ
IDTIM ;Convert to internal form
MOVX TF,FALSE ;Indicate failure
MOVE S1,S2 ;Return result in S1
GETDT1: POP P,S2 ;Restore storage address
MOVEM S1,(S2) ;Store the result
$RET ;Return TF per results
SUBTTL GETDAT Routine to process DATA field from DAP message
GETDAT: MOVE S1,.DPBPT(DL) ;Point to the data
MOVE S2,.DPCNT(DL) ;Get the count
SKIPF CRCFLG ;Doing CRC?
$CALL DOCRC ;Yes, calculate it
HLRZ S1,DATDAT ;Get routine address
$CALL 0(S1) ;Call the routine
$RET ;Return per processing routine
SUBTTL GETASC Routine to process ascii data in message
GETASC: MOVE S1,SRCMOD ;Get source data mode
CAIN S1,.MD11 ;Print files?
PJRST GETPRN ;Yes..process it
CAIN S1,.MD12 ;Fortran files?
JFCL ;[126]STRIP THE FIXED CONTROL PART
MOVE S1,ATTRFM ;Get record format
CAXE S1,FB$VFC ;Variable with fixed control?
JRST GETAS1 ;No..standard ascii
SKIPN T1,ATTFSZ ;Yes..get fixed control size
JRST GETAS1 ;Null fixed size..ignore it
$CALL GETBYT ;Just strip the Line seq for now
JUMPF ILLREC ;Illegal record format
SOJG T1,.-2 ;Get entire fixed header
GETAS1: $CALL GETBYT ;Get byte from message
JUMPF GETAS2 ;Check for implied CR-LF
$CALL OUTBYT ;Write the byte
$RETIF ;Return the error on failure
JRST GETAS1 ;Get the next byte
GETAS2: MOVE S1,ATTRAT ;Get file attributes
TXNN S1,FB$CR ;Implied CR-LF?
TXNE S1,FB$FTN ;[126]OR FORTRAN CARRAIGE CONTROL?
SKIPA ;[126]
$RETT ;No..just return
LDB S1,.DPBPT(DL) ;Get terminating byte
MOVEI S2,1 ;Get a one bit
LSH S2,0(S1) ;Justify per character
TXNE S2,ASCBRK ;Was it a break character?
$RETT ;Yes..don't append CRLF
GETAS3: MOVEI S1,.CHCRT ;Get a CR
$CALL OUTBYT ;Write to file
$RETIF ;Return the error on failure
MOVEI S1,.CHLFD ;Get a LF
$CALL OUTBYT
$RETIF ;Return the error on failure
$RETT
ILLREC: $MTERR (ER$IRC) ;Illegal record format
SUBTTL TSTPRN Routine to do final linefeed for print files
TSTPRN: MOVE S1,ATTRAT ;Get record attributes
TXNE S1,FB$PRN+FB$FTN ;Print or Fortran format?
JRST GETAS3 ;Yes..do final <CRLF>
$RETT ;No..just return
SUBTTL GETPRN Routine to process print file format (vax)
GETPRN: $CALL GETBYT ;Get the first byte
JUMPF ILLREC ;Illegal record format
$CALL GETPR3 ;Write prefix
$RETIF ;Return the error on failure
$CALL GETBYT ;Get postfix byte
JUMPF ILLREC ;Illegal record format
MOVE T4,S1 ;Remember it
GETPR1: $CALL GETBYT ;Get byte from message
JUMPF GETPR2 ;Do post fixup
$CALL OUTBYT ;Write the byte
$RETIF ;Return the error on failure
JRST GETPR1 ;Get the next byte
GETPR2: MOVE S1,T4 ;Get post fixup character
GETPR3: SKIPN T1,S1 ;Put character in T1
JRST GETPR5 ;Ignore nulls
TXNE S1,200 ;Count of linefeeds?
TDZA T1,T1 ;No..clear the count
MOVEI S1,.CHLFD ;Get the character
TXZN S1,140 ;8 bit control character?
TXZ S1,200 ;No..clear MSB
GETPR4: $CALL OUTBYT ;No..just store the character
$RETIF ;Return the error on failure
SOJG T1,GETPR4 ;Repeat until finished
GETPR5: $RETT
SUBTTL GETPAG Routine to get a file page from DAP message
;GETPAG is called to create a filepage whose VBN is in DATRCN from
; the data in this message. Trailing zero words need not be
; part of the data message.
; If VBN is 0 the file FDB will be transferred. VBN is the LBN +1.
;
GETPAG: $SAVE <P1,P2,P3>
SETZM PAGNUM ;[134]RESET CURRENT FILE PAGE #
SKIPN P3,DATRCN ;Get Requested VBN
JRST GETPA3 ;Zero is special case for FDB
SUBI P3,1 ;Convert to file page number
LSH P3,-^D2
MOVEM P3,PAGNUM ;[134]STORE CURRENT FILE PAGE NUMBER
$CALL M%NXPG ;Get a page for the file
MOVE P2,S1 ;Remember page number
LSH S1,^D9 ;Convert to address
MOVE P1,S1 ;Save the address
HRLI P1,-PAGSIZ ;Build AOBJN pointer
SETZM 0(P1) ;Create the page
SETZM .DPBCT(DL) ;Clear starting bitcount
GETPA1: MOVEI S2,^D36 ;Get a word from the messagee
$CALL GETBCT
JUMPF GETPA2 ;Finished if zero words are missing
MOVEM S1,0(P1) ;Save the word for file
AOBJN P1,GETPA1 ;Finish the page
GETPA2: SKIPLE .DPCNT(DL) ;Make sure byte count is exausted
JRST ILLREC ;Else return illegal record format
MOVE S1,P2 ;Get page number
HRLI S1,.FHSLF ;Map from process to file
MOVE S2,P3 ;Get the file page number
HRL S2,LOCJFN
MOVX T1,PM%WR+PM%RD+PM%EX ;Set appropriate access bits
PMAP
ERJMP TERCVT ;Return the error
MOVE S1,P2 ;Release the page
$CALL M%RELP
$RETT
GETPA3: $SAVE <.FBAUT+ATTFDB> ;Save author if any from Attributes
;Replace rest of FDB from data message
MOVSI P1,-.FBLEN ;Get length of the FDB
HRRI P1,ATTFDB ;Point to it
SETZM .DPBCT(DL) ;Clear initial bit count
GETPA4: MOVEI S2,^D36 ;Get an FDB word
$CALL GETBCT
JUMPF GETPA5 ;Premature end of FDB
MOVEM S1,0(P1) ;Store the word
AOBJN P1,GETPA4 ;Get all the words
GETPA5: SETZM .DPCNT(DL) ;Ignore short or long FDB
$RETT ;Return
SUBTTL GETIMG Routine to process image bit stream in data message
;GETIMG Processes an image mode bit stream in the DAP message and
; turns it into a byte stream which is stored on disk. This
; routine is the standard routine called to Unpack n-bit
; bytes from the DAP message. The routine supports 4 record
; formats and stores the information on disk in the following
; manner:
; UDF <Data...Data>
; FIX <Data...Data>
; VAR <Cnt(LSB)><Cnt(MSB)><Data...Data>
; VFC <Hdr(LSB)..Hdr(MSB)><Cnt(LSB)><Cnt(MSB)><Data...Data>
;The actual bytesize of the image mode bit stream in the message
;is specified in the attributes message that proceeds the data.
GETIMG: $SAVE <P1,P2> ;Save some AC's
MOVE P2,ATTBSZ ;P2 gets size of bitstream
MOVE S1,.DPCNT(DL) ;Get remaining count
IMULI S1,^D8 ;Get number of bits
SUB S1,.DPBCT(DL) ;[141]COMPUTE TOTAL REAL BITS
IDIV S1,P2 ;Compute BYTEcount
SKIPE S2 ;[141]ANY LEFTOVER BITS?
$MFERR (.DMDAT,14) ;No..invalid format
MOVE P1,S1 ;P1 gets count of bytes
SETZM .DPBCT(DL) ;Bitcount must start at 0
MOVE S1,ATTRFM ;Get record format
CAIE S1,FB$FIX ;Fixed record format?
CAIN S1,FB$UDF ; or Undefined record format?
JRST GETIM3 ;Yes..just store the data
CAIN S1,FB$VAR ;Variable?
JRST [SKIPLE MCYIDX ;Yes..doing MACY11 mode?
$CALL ALNMCY ;Yes..align on even byte
JRST GETIM2] ;Process variable records
SKIPN S1,ATTFSZ ;Fixed header size?
JRST GETIM2 ;No..process as variable.
SUB P1,S1 ;Yes..subtract the fixed size
PUSH P,P1 ;Save variable portion count
MOVE P1,S1 ;Store the fixed part
GETIM1: MOVE S2,P2 ;Get the bytesize
$CALL GETBCT ;Get the first byte
JUMPF [POP P,P1 ;Restore the stack
$RET] ;Return the error
$CALL OUTBYT ;Write the byte
$RETIF ;Return the error on failure
SOJG P1,GETIM1 ;Finish the fixed part
POP P,P1 ;Restore variable count
GETIM2: MOVE S1,P1 ;Write the record count
$CALL OUTBYT
$RETIF ;Return the error on failure
CAIL P2,^D12 ;Small bytes?
JRST GETIM3 ;No..Don't write second byte
MOVN S2,P2 ;Yes..Get shift value
MOVE S1,P1 ;Get the record count
LSH S1,0(S2) ;get the second byte
$CALL OUTBYT ;Write the MSB of count
$RETIF ;Return the error on failure
GETIM3: SOJL P1,GETIM4 ;Finish when count expired
MOVE S2,P2 ;Get the Attributes byte size
$CALL GETBCT ;Get the bit stream
$RETIF ;Return the error
$CALL OUTBYT ;Write the byte to file
$RETIF ;Return the error on failure
JRST GETIM3 ;Get the next word
GETIM4: $RETT ;Return to caller
SUBTTL GETBCT Routine to return bitstream from DAP message
;Accepts S2/ Bytesize (1-36)
;Returns TRUE S1/ Byte right justified
GETBCT: CAIN S2,^D8 ;Nice bytesize?
JRST [$CALL GETBYT ;Yes, get one and return
$RETIT ; Success if one was found
JRST ILLREC] ;Else return failure
SETZ T4, ;Clear result
MOVE T3,[POINT 8,T4,35] ;Get pointer to result
SKIPN T1,.DPBCT(DL) ;Residual bit count?
JRST GETBC1 ;no..start at byte boundry
HLLZ T2,BCTTBL(T1) ;Get pointer adjustment
ADD T2,.DPBPT(DL) ;Get pointer to bits
LDB T4,T2 ;Put them in answer
DPB T1,[POINT 6,T3,5] ;Pos = Bitcount
SUB S2,T1 ;Get remaining bits
JUMPLE S2,GETBC4 ;None left to get
GETBC1: IDIVI S2,^D8 ;Get S2 bytcnt T1 Bitcnt
JUMPE S2,GETBC3 ;Any full bytes to do?
GETBC2: $CALL GETBYT ;Yes..Get a byte
JUMPF ILLREC ;Illegal record format
DPB S1,T3 ;Store in result
ADD T3,[100000,,0] ;Say we stored 8 bits
SOJG S2,GETBC2 ;Get next full byte
GETBC3: JUMPE T1,GETBC4 ;Any residual bits?
$CALL GETBYT ;Yes..get them
JUMPF ILLREC ;Illegal record format
DPB T1,[POINT 6,T3,11] ;Size = Bitcount
DPB S1,T3 ;Store the odd bytes
HRRE S2,BCTTBL(T1) ;Get residual bitcnt
GETBC4: MOVNM S2,.DPBCT(DL) ;Store it
MOVE S1,T4 ;Get the result
$RETT
SUBTTL GETDOS Routine to store MACY11 variable length files
GETDOS: $SAVE <P1,P2> ;Preserve some AC's
MOVEI S1,1 ;Write first sync frame
$CALL OUTBYT
$RETIF ;Return the error on failure
MOVEI S1,0 ;Write next sync frame
$CALL OUTBYT
$RETIF ;Return the error on failure
MOVE P1,.DPCNT(DL) ;Get the record count
MOVEI S1,4(P1) ;Get count to include header
MOVEI P2,1(S1) ;Initialize checksum
$CALL OUTBYT ;Store first count byte in file
$RETIF ;Return the error on failure
LSH S1,-^D8 ;Get High order byte
ADD P2,S1 ;Include in checksum
$CALL OUTBYT ;Store in file
$RETIF ;Return the error on failure
GETDO1: $CALL GETBYT ;Get a byte from the record
JUMPF ILLREC ;Illegal record format
ADD P2,S1 ;Tally the checksum
$CALL OUTBYT ;Write to file
$RETIF ;Return the error on failure
SOJG P1,GETDO1 ;Do all record bytes
MOVN S1,P2 ;Negate checsum
ANDX S1,377 ;Just write 8 bits
$CALL OUTBYT ;Store in file
$RETIF ;Return the error on failure
MOVEI P1,6 ;Store 6 null bytes
MOVEI S1,0
$CALL OUTBYT
$RETIF ;Return the error on failure
SOJG P1,.-2
$RETT
SUBTTL SNDQUE Routine to send all messages in the send queue
;This routine will cause all message on the SNDQUE to be sent
;to the remote system with the possible exception of the last
;message segment (to allow subsequent blocking)
SNDQUE: $SAVE <DL> ;Preserve an AC
SETZM DL ;Clear pointer to last message
MOVE S1,SNDLST ;Position to last entry
$CALL L%LAST
JUMPF SNDQU2 ;Return when finished
SKIPE .DPLEN(S2) ;Forcing last message out?
MOVE DL,S2 ;No..save pointer to last segment
SNDQU1: MOVE S1,SNDLST ;Point to send que
$CALL L%FIRST ;Get first message address
JUMPF SNDQU2 ;Return when finished
CAMN DL,S2 ;Want to retain last segment?
JRST SNDQU2 ;Yes..just return for now
$CALL LLSEND ;Send the message
$RETIF ;Return if error
$CALL DELMSG ;Delete current message
JRST SNDQU1 ;Send the rest
SNDQU2: $RETT ;The queues are empty!
;SUBTTL DELMSG Routine to delete current message in the Send Queue
DELMSG: MOVE S1,SNDLST ;Delete current send Queue entry
$CALL L%DENT
$RETT
SUBTTL PUTMSG Routine to build and force all messages out
;This routine will place a message at the end of the SNDQUE and then
;clear the remaining length to ensure that the message is sent on
;a subsequent call to SNDQUE
;Accepts S1/ Address of message descriptor
PUTMSG: $CALL QUEMSG ;Do header fixup
SETZM .DPLEN(DL) ;Clear to force message out
$RET ;Return per QUEMSG
SUBTTL QUEMSG Routine to block current message if possible
;This routine is called to block a message to the existing send queue
;if blocking is possible. A subsequent call to SNDQUE will cause all
;message segments to be sent with the possible exception of the last
;segment
;Accepts S1/ Address of message descriptor
QUEMSG: $CALL BLDMSG ;Build the message
JUMPF [$SAVE <TF,S1,S2> ;Save any errors for return
JRST .+1] ;Continue in line
SKIPG .DPTYP(DL) ;Valid message?
PJRST DELMSG ;No..delete it and return
$CALL BLDHDR ;Build the header
MOVE S1,SNDLST ;Get previous entry
$CALL L%PREV
JUMPF QUEMS1 ;No previous entry
MOVE S1,.DPLEN(S2) ;Get previous remaining length
SUB S1,.DPCNT(DL) ;May we block this message?
JUMPLE S1,[SETZM .DPLEN(S2) ;No..Clear previous length
JRST QUEMS1]
MOVEM S1,.DPLEN(DL) ;Save new remaining length
QUEMS1: MOVE S1,.DPLEN(DL)
MOVE S2,.DPFLG(DL)
CAIL S1,DPMXH ;May we block current message?
TXNN S2,HD$LEN ;...
SETZM .DPLEN(DL) ;No..mark end of message
$RETT ;Return
SUBTTL BLDMSG Routine to build a DAP message
;BLDMSG is called to construct a DAP message from the message descriptor
; storing all requested fields in the DAP message. BLDMSG checks
; the version check words from the message descriptor to ensure
; that extra fields known locally are not sent to a DAP implimen-
; tation that doesn't understand them
;Accepts S1/ Address of message descriptor
BLDMSG: $SAVE <P1,P2>
MOVE P1,S1 ;P1 points to message descriptor
$DEBUG (Building ,<^Q/0(P1),RHMASK/ message>)
MOVE S1,SNDLST ;Allocate a message buffer
MOVE S2,OURSIZ ; for largest message
SUBI S2,DPMXH-2 ;Subtract maximum header size
$CALL NEWBUF
MOVE DL,S1 ;Setup global message pointer
HLRZ S1,0(P1) ;Store message type
MOVEM S1,.DPTYP(DL) ; in message header
HRLZ T1,2(P1) ;Get field count
JUMPE T1,BLDMS7 ;Exit if no message fields
MOVN T1,T1 ;Make AOBJN pointer
HRRI T1,3(P1) ;Point to first argument
MOVE T2,OURVER ;Get our version for checking
TRZ T2,17 ;Clear user version level
MOVE P1,T1 ;Put pointer in P1
SETOM P2 ;Set initial menu to all fields
BLDMS1: MOVE S1,0(T1) ;Get first argument type
TXNN S1,DA%VER ;Version check word?
JRST BLDMS2 ;No..check next arg
ADDI T1,1 ;Yes..point to it
MOVE T3,0(T1) ;Get the check word
TXNE T3,17 ;OSTYPE specifed for check?
JRST [XOR T3,REMOST ;Yes..it must match.
TXNE T3,17 ;did they match?
AOJA T1,BLDMS1 ;No..skip this check
JRST .+1] ;Yes..check it
CAMLE T2,T3 ;Within our range?
AOJA T1,BLDMS1 ;Yes..on to get next field
JRST BLDMS3 ;No..terminate our menu
BLDMS2: TXNE S1,DA%DEF ;Default word presnt?
ADDI T1,1 ;Yes..bump past it
LSH P2,1 ;Mark a valid menu item
AOBJN T1,BLDMS1 ;On to finish all fields
BLDMS3: SETCAM P2,P2 ;Fixup our menu
BLDMS4: MOVE T1,0(P1) ;Get argument descriptor
TXNE T1,DA%VER ;Is there a version check field?
JRST [ADDI P1,1 ;Yes..ignore it
AOJA P1,BLDMS4] ;Get the next field
TXNE T1,DA%DEF ;Is there a default word?
ADDI P1,1 ;Yes..bump past it
TXNN P2,1 ;Is menu bit set?
JRST BLDMS5 ;No..try next field
LSH P2,-1 ;Yes..get next menu bit
LOAD S1,T1,DA%SIZ ;Get Maximum field len
LOAD S2,T1,DA%STG ;Get storage offset
MULINK< ADD S2,CP> ;Get actual storage address
LOAD T1,T1,DA%TYP ;Get the argument type
CAIN T1,.ARMNU ;Is argument a menu?
ANDB P2,0(S2) ;Yes..remember it
HRRZ T1,ARGTBL(T1) ;Get the processor address
$CALL 0(T1) ;Store the field
JUMPT BLDMS6 ;Do the next field
$SAVE <TF,S1,S2> ;Else save the error for return
JRST BLDMS6
BLDMS5: LSH P2,-1 ;Get next menu item
BLDMS6: AOBJN P1,BLDMS4 ;Back for next field
BLDMS7: $RETT
SUBTTL BLDHDR Routine to build header for current message
;Accepts DL/ Address of current message header
BLDHDR: MOVE S1,.DPFLG(DL) ;Get existing flags
MOVE S2,.DPCNT(DL) ;Get remaining count
SUB S2,.DPLEN(DL) ;Subtract original count
ADDM S2,.DPLEN(DL) ;Adjust remaining length
MOVM T2,S2 ;Remember operand length
MOVE T3,OURCAP ;Get mutual capabilities
SKIPE .DPBCT(DL) ;Bitcount present?
TXO S1,HD$BCT ;Yes..set the flag
SKIPE .DPSID(DL) ;Stream ID present?
TXO S1,HD$SID ;Yes..set the flag
CAIG T2,^D255 ;More than 255 bytes?
JRST [TXO S1,HD$LEN ;No..set length flag
JRST BLDHD1] ;Check blocking support
TXNE T3,SY$LN2 ;Yes..do we support Len 256?
TXO S1,HD$LEN+HD$LN2 ;Yes..set both flags
BLDHD1: TXNN T3,SY$BLK ;Do we support blocking?
TXZ S1,HD$LEN+HD$LN2 ;No..Don't send length fields
MOVEM S1,.DPFLG(DL) ;Save the flags
SUBI S2,2 ;Count message type and flags
TXNE S1,HD$SID ;Stream Id?
SUBI S2,1 ;Yes..count it
TXNE S1,HD$LEN ;Length field?
SUBI S2,1 ;Yes..count it
TXNE S1,HD$LN2 ;Length 256?
SUBI S2,1 ;Yes..count it
TXNE S1,HD$BCT ;Bit count?
SUBI S2,1 ;Yes..count it
MOVMM S2,.DPCNT(DL) ;Save count of bytes in message
ADJBP S2,.DPBPT(DL) ;Reset message pointer
MOVEM S2,.DPBPT(DL) ;Save for Sending message
MOVE T1,.DPTYP(DL) ;Get message type
IDPB T1,S2 ;Store the message type
IDPB S1,S2 ;Store the flag byte
MOVE T1,.DPSID(DL) ;Get Stream Id
TXNE S1,HD$SID ;Want it?
IDPB T1,S2 ;Yes..store it
TXNE S1,HD$LEN ;Want Length field?
IDPB T2,S2 ;Yes..store it
LDB T1,[POINT 8,T2,27] ;Get Length 256 field
TXNE S1,HD$LN2 ;Want it?
IDPB T1,S2 ;Yes..store it
MOVE T1,.DPBCT(DL) ;Get bitcount field
TXNE S1,HD$BCT ;Want it?
IDPB T1,S2 ;Yes..store it
$RETT
SUBTTL PUTFIX Routine to store 1 to 4 BYTE fields in DAP message
;Accepts S1/ Number of bytes to store (1 to 4)
; S2/ Address of word containing bytes (MSB thru LSB)
PUTFIX: CAIL S1,1 ;Check range
CAILE S1,4
$CALL PUTERR ;Die on error
CAMLE S1,.DPCNT(DL) ;Check for room
$CALL PUTERR ;Die on error
MOVE T1,S1 ;Save the count
MOVE S1,0(S2) ;Get the argument
PUTFI1: $CALL PUTBYT ;Store the byte
LSH S1,-^D8 ;Get the next byte
SOJG T1,PUTFI1 ;Do all bytes
$RETT
SUBTTL PUTBYT Routine to store a character in current message
;Accepts S1/ Character to store in message
PUTBYT: SOSGE .DPCNT(DL) ;Any room left in buffer?
$CALL PUTERR ;Die on error
IDPB S1,.DPBPT(DL) ;PUT BYTE IN MESSAGE
$RETT ;AND RETURN
SUBTTL PUTERR Routine to die on invalid argument
;PUTERR is called from PUT??? when bad arguments are encountered
; or the message buffer is out of room
PUTERR: $FATAL (Dap message buffer is full)
SUBTTL PUTVAR Routine to store a variable length field in DAP message
;Accepts S1/ Maximum size of field
; S2/ Address of ASCIZ string to store
PUTVAR: MOVE T4,S1 ;Remember maximum size
CAIG T4,^D255 ;Request too large
CAML T4,.DPCNT(DL) ;...
$CALL PUTERR ;Yes..return a failure
HRLI S2,(POINT 7)
MOVE T1,S2 ;Save pointer to source
SETZB T2,S1 ;Clear counts
$CALL PUTBYT ;Store null count for now
MOVE T3,.DPBPT(DL) ;Remember pointer to count
PUTVA1: ILDB S1,T1 ;Get source byte
JUMPE S1,PUTVA2 ;Exit on null
$CALL PUTBYT ;Store byte in message
AOJA T2,PUTVA1 ;Back for next
PUTVA2: MOVE S1,T1 ;Return updated pointer
DPB T2,T3 ;Store actual count
CAMLE T2,T4 ;Within requested size?
$CALL PUTERR ;No..return a failure
$RETT ;Return success
SUBTTL PUTINT Routine to store variable length integer
;Accepts S1/ Maximum size of field
; S2/ Address of integer to store in message
PUTINT: MOVE T4,S1 ;Remember maximum size
CAIG T4,^D9 ;Request too large?
CAML T4,.DPCNT(DL) ;...
$CALL PUTERR ;Yes..return a failure
$CALL PUTBYT ;Write a dummy count
MOVE T3,.DPBPT(DL) ;Save the pointer
MOVE T2,0(S2) ;Get low order part
CAIG T4,4 ;Hi order part?
TDZA T1,T1 ;No..clear holding reg
MOVE T1,1(S2) ;Yes..get it
MOVEI S2,1 ;Get a count of 1
PUTIN1: MOVE S1,T2 ;Get Least significant byte
$CALL PUTBYT ;Store byte from integer
LSHC T1,-^D8 ;Get next byte
SKIPN T1 ;Time to quit?
SKIPE T2 ;...
AOJA S2,PUTIN1 ;No..do the next byte
DPB S2,T3 ;Store actual count
CAMLE S2,T4 ;Within requested size?
$CALL PUTERR ;No..return a failure
$RETT ;Yes..return success
SUBTTL PUTPRO Routine to store DAP protection argument
;PUTPRO is called with internal protection code and converts
; it to DAP protection before sending off the argument
;Accepts S1/ Maximum size of field (3 bytes)
; S2/ Address of local protection code
PUTPRO: SETZM T1 ;Assume all access allowed
MOVE T2,0(S2) ;Get argument
TXNN T2,FP%RD ;Read access allowed?
TXO T1,PR$DRA ;No..deny it
TXNN T2,FP%WR ;Write access allowed?
TXO T1,PR$DWA!PR$DDA ;No..deny write and delete
TXNN T2,FP%EX ;Execute access allowed?
TXO T1,PR$DEA ;No..deny it
TXNN T2,FP%APP ;Append access allowed?
TXO T1,PR$DAA ;No..deny it
TXNN T2,FP%DIR ;Directory list access allowed?
TXO T1,PR$DLA ;No..deny it
MOVEI S2,T1 ;Point to extensible field
; PJRST PUTEXF ;Send the dap protection
SUBTTL PUTEXF Routine to store extensible field in Dap message
SUBTTL PUTMNU Routine to store DAP extensible fields
;Accepts S1/ Maximum size of field (1 to 10)
; S2/ Address of EXARG
;EXARG: Low order 36 bits of extensible field
; High order 36 bits of extensible field
PUTMNU:
PUTEXF: CAMLE S1,.DPCNT(DL) ;Enough room?
$CALL PUTERR ;No..die on error
MOVE T1,0(S2) ;Low order part to T1
CAIG S1,5 ;More than 5 bytes?
TDZA S2,S2 ;No..clear high order part
MOVE S2,1(S2) ;Yes..high order part to S2
PUTEX1: MOVEI S1,177 ;Get 7 bit mask
AND S1,T1 ;Get 7 bits from low order part
LSHC S2,-^D7 ;Get next 7 bytes
SKIPN S2 ;Have more to do after this?
SKIPE T1
TXO S1,DP$EXF ;Yes..set extension bit
$CALL PUTBYT ;Store in the message
TXNE S1,DP$EXF ;Anything left?
JRST PUTEX1 ;Yes..back for next byte
$RETT
SUBTTL PUTDTI Routine to store date time field in DAP message
;Accepts S1/ Message field size (18)
; S2/ Address of Date/time word
PUTDTI: CAIN S1,^D18 ;Proper size?
CAMLE S1,.DPCNT(DL) ; and enough room?
$CALL PUTERR ;No..return a failure
MOVE S2,0(S2) ;Put value in S2
HRROI S1,MSGJNK ;Point to temporary storage
SETZM T1 ;Standard options
ODTIM ;Generate the date string
MOVEI T1,MSGJNK ;Point to the string
HRLI T1,(POINT 7)
MOVEI T2,^D18 ;Store 18 bytes
ILDB S1,T1 ;[122]GET THE FIRST CHARACTER
CAIN S1," " ;[122]CONVERT BLANKS TO ZEROS
MOVEI S1,"0" ;[122]GET A LEADING 0
SKIPA ;[122]
PUTDT1: ILDB S1,T1 ;Get a byte
$CALL PUTBYT ;Store in message
SOJG T2,PUTDT1 ;Finish all bytes
$RETT
SUBTTL PUTDAT Routine to store Data field in DAP message
PUTDAT: $SAVE <P1,P2>
MOVE P1,.DPBPT(DL) ;Get pointer to data
MOVE P2,.DPCNT(DL) ;Preserve remaining count
HRRZ S1,DATDAT ;Get processor address
$CALL 0(S1) ;Call the processor
SKIPT ;Save status for return on error
$SAVE <TF,S1,S2>
SKIPN .DPTYP(DL) ;Was message deleted?
$RETT ;Yes..just return
DMOVE S1,P1 ;Restore starting pointer and count
SUB S2,.DPCNT(DL) ;Compute actual count
SKIPF CRCFLG ;Computing CRC?
$CALL DOCRC ;Compute the CRC
$RETT
SUBTTL DOCRC Routine to update cumulative CRC for data messages
;ACCEPTS S1/ Pointer to 8 bit data stream
; S2/ Byte count
; This routine is used to build the 16-bit CRC checksum character used
; to ensure DAP data integrity. The CRC is initialized to -1 when a
; file ACCESS is initiated. Both NFT and FAL compute the CRC on each
; data byte sent or recieved. When the file is closed the CRC's NFT
; sends the CRC it has generated to the remote system where it must
; match the CRC generated by FAL.
DOCRC: JUMPLE S2,.RETT ;Return on null count
MOVE T1,FILCRC ;Get current CRC
DOCR1: ILDB T2,S1 ;Get a byte from message
XORB T1,T2 ;Include byte in CRC
ANDI T2,377 ;Compute offset into table
LSH T1,-^D8 ;Xor remaining CRC from table
XOR T1,CRCTAB(T2) ;Compute new CRC
SOJG S2,DOCR1 ;Do the next
MOVEM T1,FILCRC ;Save computed CRC
$RETT
SUBTTL CRCTAB CRC TABLE DEFINITION
POLY==164405 ;X^16+X^15+X^13+X^7+X^4+X^2+X^1+1
POLINI==177777 ;Initial value of -1 (16 bits)
DEFINE BLDCRC <
LSTOF. XCREF
ZZ==0
REPEAT ^D256, <CRC (\ZZ)
ZZ==ZZ+1>
LSTON.
> ;End BLDCRC
DEFINE CRC (BYTE) <
.CRC=BYTE
REPEAT ^D8,<
.X=.CRC&1
IFN <.X>,<.CRC=.CRC_-1
.CRC=.CRC^!POLY>
IFE <.X>,<.CRC=.CRC_-1>>
EXP .CRC
> ;End CRC
CRCTAB: BLDCRC ;Generate the table
SUBTTL PUTASC ROUTINE TO READ ASCII DATA AND FORMAT AN OUTPUT DAP MESSAGE
;PUTASC breaks ascii stream text up into records for transmission.
;Break characters are: <ESC><^Z><DC1-4><DLE><FF><VT> and <LF>
ASCBRK==^B00001100000111110001110000000000
PUTASC: SETZ T1, ;[142]CHARACTER COUNT
MOVE T2,ATTRAT ;Get record attributes
TXNE T2,FB$CR ;[150]IMPLIED CRLF?
SETOM LINFLG ;[150]YES, STRIP NULLS
SKIPN T3,ATTMRS ;GET MAXIMUM RECORD SIZE
MOVE T3,.DPCNT(DL) ;No MRS..use remaining count
SETOM S1 ;Say Last character was -1
PUTAS1: SOSGE T3 ;Any room left?
JRST [SETOM BUFFUL ;[142]No, set buf full flag
JRST PUTAS5] ;[142]Output the record
MOVE T4,S1 ;Remember last character stored
PUTAS2: $CALL INPBYT ;Get a byte from file
JUMPF PUTAS3 ;Check for EOF
JUMPN S2,[SETOM LINFLG ;[150]LINE NUMBER SEEN, STRIP NULLS
JRST PUTAS2] ;[130]DISCARD LINE NUMBERS
SKIPE LINFLG ;[150]STRIP NULLS?
JUMPE S1,PUTAS2 ;Yes..then strip nulls
$CALL PUTBYT ;Store in the message
ADDI T1,1 ;[142]INCREMENT CHARACTER COUNT
CAIL S1,.CHLFD ;Possible break character?
CAILE S1,.CHESC
JRST PUTAS1 ;No..send next charcter
MOVEI S2,1 ;Yes..check it out
LSH S2,0(S1) ;Justify bit per charcter
TXNN S2,ASCBRK ;Break character?
JRST PUTAS1 ;Not a break..get next character
CAIN S1,.CHLFD ;<CRLF>?
CAIE T4,.CHCRT
JRST PUTAS5 ;No..send the record
TXNN T2,FB$CR ;Yes..Stripping <CRLF>?
JRST PUTAS5 ;No..send the record
MOVEI S1,2 ;Yes..Get 2
ADDM S1,.DPCNT(DL) ;Back up count by 2
MOVNI S1,2
ADJBP S1,.DPBPT(DL) ;Back up pointer by 2
MOVEM S1,.DPBPT(DL)
SKIPN BUFFUL ;[142]Last rec out no crlf?
JRST PUTAS5 ;[142]No, output this empty record
SETZM BUFFUL ;[142]Yes, reset flag
CAIN T1,2 ;[142]ONLY A CRLF?
JRST PUTASC ;[142]YES, IGNORE THE RECORD
PUTAS5: $RETT ;Return and send the record
PUTAS3: $CALL EOFCHK ;Check error for EOF
$RETIF ;Return False on error
SKIPGE T4 ;Stored any characters?
SETZM .DPTYP(DL) ;No..delete this message
$RETT
SUBTTL PUTPAG Routine to store file page in DAP message
;PUTPAG sends a file page whose VBN is in DATRCN. Trailing zero
;words in the file page are not sent.
PUTPAG: $SAVE <P1,P2,P3> ;Preserve some AC's
SETZM PAGNUM ;[134]RESET LOCAL PAGE #
SKIPN P1,DATRCN ;Get requested VBN.
JRST PUTP50 ;Zero is special case for FDB
SUBI P1,1 ;Convert to file page address
LSH P1,-^D2
MOVEM P1,PAGNUM ;[134]SAVE CURRENT PAGE NUMBER
$CALL M%NXPG ;Get non existant page
MOVEM S1,PAGMEM ;[151]REMEMBER PAGE IN MEM
MOVSI S2,.FHSLF ;Map file page to my process
HRR S2,S1
MOVE P3,S2 ;Remember for unmapping
EXCH S1,P1 ;Remember process page
HRL S1,LOCJFN ;Get JFN,,file page
MOVX T1,PM%RD+PM%PLD ;Preload page
PMAP
ERJMP TERCVT
LSH P1,^D9 ;Convert P1 to address
HRLI P1,-PAGSIZ ;Create AOBJN pointer
SETZ P2, ;Clear count of trailing nulls
PUTP10: SKIPN S1,0(P1) ;Get a word
AOJA P2,PUTP40 ;Count a null
JUMPE P2,PUTP30 ;Any zeros to write?
PUTP20: SETZ S1, ;Yes..write them
MOVEI S2,^D36
$CALL PUTBCT
SOJG P2,PUTP20
MOVE S1,0(P1) ;Reclaim data
PUTP30: MOVEI S2,^D36
$CALL PUTBCT ;Write it
PUTP40: AOBJN P1,PUTP10 ;Write the entire page
SETOM S1 ;Unmap the file page
MOVE S2,P3
SETZM T1
PMAP
ERJMP TERCVT
SETZM PAGMEM ;[151]FORGET PAGE NUMBER
MOVEI S1,-PAGSIZ(P1) ;Release our page
LSH S1,-^D9
$CALL M%RELP
$RETT
PUTP50: $CALL GETFDD ;Setup actual FDB
MOVSI P1,-.FBLEN
HRRI P1,LOCFDB
PUTP60: MOVE S1,0(P1) ;Send entire FDB
MOVEI S2,^D36
$CALL PUTBCT
AOBJN P1,PUTP60
$RETT
SUBTTL PUTIMG Routine to store n-bit bytes in data message
;This routine is the counterpart for GETIMG. It reads file bytes
;and stores them in the DAP message as a bitstream whose size is
;determined by the attributes bytesize.
PUTIMG: $SAVE <P1,P2,P3> ;Preserve some AC's
MOVE S1,ATTRFM ;Get record format
MOVE P2,ATTBSZ ;Get attributes bytesize
CAIN S1,FB$UDF ;Undefined record format?
JRST PUTIM4 ;Yes..calculate largest MRS
CAIN S1,FB$FIX ;Fixed length?
JRST PUTIM5 ;Yes..go process it
CAIE S1,FB$VAR ;Variable length records?
SKIPN P1,ATTFSZ ;No..Zero length VFC?
JRST PUTIM2 ;Yes..process variable length
PUTIM1: $CALL INPBYT ;Get a header byte
JUMPF PUTI10 ;See if it's EOF
MOVE S2,P2 ;Get attributes byte size
$CALL PUTBCT ;Store the bitstream
SOJG P1,PUTIM1 ;Store entire fixed header
JRST PUTIM3 ;Process the variable count
PUTIM2: SKIPLE MCYIDX ;Doing MACY11 file?
$CALL ALNMCY ;Yes..align on half-word
PUTIM3: $CALL INPBYT ;Get LSB of count
JUMPF PUTI10 ;See if it's EOF
MOVE P1,S1 ;Save it
CAIL P2,^D12 ;MSB of count present?
JRST PUTIM6 ;No..go check our count
$CALL INPBYT ;Get it
JUMPF PUTI10 ;Check for EOF
LSH S1,(P2) ;Position MSB of count
IOR P1,S1 ;Tally the total count
JUMPE P1,PUTIM8 ;[114]ZERO LENGTH RECORD?
JRST PUTIM6 ;Check count against MRS
PUTIM4: MOVE S1,.DPCNT(DL) ;Get remaining count
IMULI S1,^D8 ;Get number of remaining bits
IDIV S1,P2 ;Get bits/bytesize
MOVE P1,S1 ;Store computed maximum size
JRST PUTIM6 ;Check against actual maximum
PUTIM5: SKIPN P1,ATTMRS ;Get maximum record size
MOVE P1,OURMRS ;Use our maximum as default
PUTIM6: MOVE P3,P1 ;Save requested count
PUTIM7: $CALL INPBYT ;get a byte from file
JUMPF PUTIM9 ;Check for EOF
MOVE S2,P2 ;Get the attributes bytesize
$CALL PUTBCT ;Store the bit stream
SOJG P1,PUTIM7 ;Return when count exausted
PUTIM8: $RETT
;PUTIMG continued on next page
;PUTIMG continued from previous page
PUTIM9: $CALL EOFCHK ;EOF while fetching data?
$RETIF ;No..return the error
MOVE S1,ATTRFM ;Yes..get our record format
CAIE S1,FB$VAR ;Is it variable or VFC?
CAIN S1,FB$VFC
$MTERR ER$IRC ;Yes..then illegal record
CAMN P1,P3 ;Have we stored anything?
SETZM .DPTYP(DL) ;No..scratch this message
$RETT ;No..just return
PUTI10: $CALL EOFCHK ;EOF looking for Hdr or Cnt?
$RETIF ;No..return the faliure
SETZM .DPTYP(DL) ;Yes..scatch this message
$RETT
SUBTTL PUTBCT Store image bit stream in DAP message
;Accepts S1/ right justified byte
; S2/ byte size (1-36 bits)
PUTBCT: CAIN S2,^D8 ;Nice byte size?
PJRST PUTBYT ;Yes..putone and return
SKIPN T1,.DPBCT(DL) ;Any residual bitcount?
JRST PUTBC1 ;No..start at byte boundry
HLLZ T2,BCTTBL(T1) ;Yes..get pointer adjustment
ADD T2,.DPBPT(DL) ;Point to residual bits
DPB S1,T2 ;Store them
SUB S2,T1 ;Get bits remaining in S1
JUMPLE S2,PUTBC4 ;All done?
MOVN T1,T1 ;No..get shift right value
LSH S1,0(T1) ;Right justify remaining bits
PUTBC1: IDIVI S2,^D8 ;Get S2 bytecount T1 bitcount
JUMPE S2,PUTBC3 ;Any full bytes to send?
PUTBC2: $CALL PUTBYT ;Yes..store a byte
LSH S1,-^D8 ;Get next byte
SOJG S2,PUTBC2 ;Do them all
PUTBC3: JUMPE T1,PUTBC4 ;Any odd bits?
$CALL PUTBYT ;Yes..store them
HRRE S2,BCTTBL(T1) ;Get negitive bitcount
PUTBC4: MOVNM S2,.DPBCT(DL) ;Save the bitcount
$RETT ;All finished
BCTTBL: 000000,,0 ;Pointer adjust,,-bitcount
067100,,-7 ;Bytesize==1
057200,,-6 ;Bytesize==2 etc.
047300,,-5
037400,,-4
027500,,-3
017600,,-2
007700,,-1 ;Bytesize==7 Bitcnt==1
SUBTTL PUTDOS Process MACY11 assembler output
;PUTDOS Processes MACY11 assembler output files and stores
; them as variable length data. MACY11 assembler
; is equivalent in format to PDP21 style paper tape format
; as follows
;Byte 0 <1> sync byte
;Byte 1 <0> null follows sync
;Byte 2 <cnt> low order of (length of "Data" in bytes)+4=[n]
;Byte 3 <cnt> high order of (length of "Data in bytes)+4=[n]
;Byte 4 <data>
;Byte n (last byte of "Data")
;Byte n+1 Checksum byte (Two's complement add with carry ignored)
; Checksum includes all bytes in record including header
;6 Nulls followed by next record (The nulls are ignored)
PUTDOS: $SAVE <P1,P2> ;Save an AC for checksum
PUTDO1: $CALL INPBYT ;Get a byte
JUMPF [$CALL EOFCHK ;Check for EOF
$RETIF ;Return if not EOF
SETZM .DPTYP(DL) ;Else cancel this message
$RETT] ;And return
JUMPE S1,PUTDO1 ;Ignore leading nulls
CAIE S1,1 ;First byte is <1>
JRST PUTDO4 ; Else bad record format
MOVE P2,S1 ;Initialize checksum
$CALL INPBYT ;Get the next byte
JUMPF PUTDO3 ;Check EOF and return failure
JUMPN S1,PUTDO4 ;Second byte is <0>
$CALL INPBYT ;Third byte is L.O. count
JUMPF PUTDO3 ;Check EOF and return failure
ADD P2,S1 ;Tally Checksum
MOVE P1,S1 ;P1 will contain count
$CALL INPBYT ;Fourth byte is H.O. count
JUMPF PUTDO3 ;Check EOF and return failure
ADD P2,S1 ;Tally checksum
DPB S1,[POINT 8,P1,27] ;Store High order part of count
SUBI P1,4 ;Subtract four bytes for header
CAMLE P1,OURMRS ;Do we have enough room for it?
$MTERR (ER$RTB) ;Nope..record too big!
PUTDO2: $CALL INPBYT ;Get next byte
JUMPF PUTDO3 ;Check EOF and return failure
ADD P2,S1 ;Tally checksum
$CALL PUTBYT ;Store in message
SOJG P1,PUTDO2 ;Repeat until count exausted
$CALL INPBYT ;Last byte is checksum
JUMPF PUTDO3 ;Check EOF and return error
ADD P2,S1 ;Tally checksum
TXNE P2,377 ;Are all checksum bits zero?
JRST PUTDO4 ;No..Bad checksum
$RETT ;Hurray..We made it!
PUTDO3: $CALL EOFCHK ;Check for EOF
$RETIF ;Return if file error
PUTDO4: $MTERR ER$IRC ;Else return record format error
SUBTTL SETINP Setup for local file input
;Accepts AP/ Address of D$FUNC argument block
;Returns TRUE S1/ Wild JFN flags
; S2/ Pointer to expanded filespec
SETINP: MOVEI S1,JFNBLK ;Point to GTJFN block
MOVE T1,1+OURCAP ;Get second capability word
MOVX S2,GJ%OLD ;File must exist
MOVE T2,ACCFNC ;Get requested access
CAIE T2,AF$DIR ;Directory
TXNE T1,SY$WLD ; or do we support wild cards?
TXO S2,GJ%IFG+GJ%FLG ;Yes..allow them and get flags
MOVEM S2,.GJGEN(S1) ;Save for GTJFN
MOVE S2,.DFLFS(AP) ;Get pointer to local file spec
GTJFN
ERJMP TERCVT ;Convert error and fail
SKIPE S2 ;[143]IF FILENAME SPECIFIED
JRST [LDB S2,S2 ;[143]GET DELIMTING BYTE
SKIPN S2 ;[143]NULL?
JRST .+1 ;[143]YES, GOOD FILE NAME
MOVEI S2,GJFX4 ;[143]NO, BAD FILENAME
JRST TERCV0] ;[143]
MOVEM S1,LOCJFN ;Save JFN and flags
TXNN S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;Anything wild?
TDZA S1,S1 ;No..clear wild JFN
TXO S1,GN%STR+GN%DIR+GN%NAM+GN%EXT ;Mark change flags
MOVEM S1,WLDJFN ;Save for message generation
$CALL GETDEV ;Get device attributes
$RETIF ;Return if this fails
TXNN S2,DV%IN ;Can device do input?
PJRST DEVERR ;No..bad device
JRST NXTIN1 ;Continue after GNJFN
NXTINP: MOVE S1,LOCJFN ;Get original JFN
GNJFN ;Get the next file
ERJMP [$CALL RELJFN ;No file match..release JFN
$RETF] ;Return false
MOVEM S1,WLDJFN ;Save state change flags
NXTIN1: $CALL GETFDB ;Read FDB and Get byte size
MOVX S1,OF%RD ;Get read access bit for open
MOVEM S1,OPNFLG ;Save for open
MOVE S1,WLDJFN ;Return wild JFN and flags
HRROI S2,NAMFSP ;Point to full filespec
$RETT
SUBTTL SETOUT Setup for local file output
;Accepts AP/ Address of D$FUNC argment block
;Returns S1/ Local JFN
; S2/ Pointer to expanded filespec
SETOUT: MOVEI S1,JFNBLK ;Point to JFN block
MOVX S2,GJ%FOU ;File is for output
MOVEM S2,.GJGEN(S1) ;Save the flags
MOVE S2,.DFLFS(AP) ;Get pointer to local file spec
GTJFN ;Find the file
ERJMP TERCVT
SKIPE S2 ;[143]IF FILENAME SPECIFIED
JRST [LDB S2,S2 ;[143]GET THE DELIMITER BYTE
SKIPN S2 ;[143]NULL?
JRST .+1 ;[143]YES, ITS OK
MOVEI S2,GJFX4 ;[143]NO, ERROR IN FILE NAME
JRST TERCV0] ;[143]
MOVEM S1,LOCJFN ;Save the JFN
$CALL GETDEV ;Get device attributes
$RETIF ;Return if this fails
TXNN S2,DV%OUT ;Can device do output?
PJRST DEVERR ;No..then fail
$CALL GETFDB ;Get the FDB info
MOVX S1,OF%WR ;Get write access bit for open
MOVEM S1,OPNFLG ;Save for Open
MOVE S1,LOCJFN ;Return the JFN
HRROI S2,NAMFSP ;Point to full filespec
$RETT
SUBTTL OPNFIL Routine to open the local file
OPNFIL: HRRZ S1,LOCJFN ;Get local JFN
MOVE S2,OPNFLG ;Get our flags
OPENF ;Open the file
ERJMP TERCVT ;Return the error
SETZM BUFFUL ;[142]
SETZM LINFLG ;[150]
SETZM PAGBP ;[130]ZERO THE PMAP VARIABLES
SETZM PAGNUM ;[130]...
SETZM PFBSIZ ;[130]...
SETZM PAG1 ;[130]...
SETZM PAGMEM ;[151]
SETZM LINNUM ;[130]...
MOVEI S2,1 ;[130]INTIAL PAGFLG
LOAD S1,LOCDEV,DV%TYP ;[130]GET DEVICE TYPE
CAIE S1,.DVDSK ;[130]A DISK?
$RETT ;[130]NO
MOVEM S2,PAGFLG ;[130]YES
MOVE S1,OPNFLG ;[130]GET FLAGS
TXNE S1,OF%WR ;[130]WRITTING THE FILE?
$RETT ;[130]YES, DON'T COMPUTE EOF COUNT
HRRZ S1,LOCJFN ;[130]GET THE JFN
MOVE S2,[1,,.FBBYV] ;[130]GET THE file's BYTE SIZE
PUSH P,T1 ;[130]
PUSH P,T2 ;[130]
MOVEI T1,T2 ;[130]
GTFDB ;[130]
LSH T2,-^D24 ;[130]
ANDI T2,77 ;[130]
OPNFI0: MOVE T1,OPNFLG ;[152][130]GET BYTE SIZE USED IN OPENF
LSH T1,-^D30 ;[130]
CAIN T1,^D36 ;[130]36 BIT BYTE READ?
CAIE T2,^D18 ;[130]BUT 18 BIT BYTES?
SKIPA ;[130]
JRST [MOVEI T2,0 ;[130]YES, SET THE FLAG
JRST OPNFI1] ;[130]AND CONTINUE
IDIV T2,T1 ;[130]COMPUTE BYTES PER FILE BYTE
SKIPG T2 ;[130]BAD BYTE SIZE?
JRST [MOVE T2,REMOST ;[152]SYSTEM TYPE
CAIE T2,.OSTP20 ;[152]NO WARNING FOR TOPS20 NODES
$WARN (Byte size of local file is unusable - 7 assumed) ;[152]
MOVEI T2,^D7 ;[152]ASSUME 7 BIT BYTES
JRST OPNFI1] ;[152] [166]
OPNFI1: PUSH P,T2 ;[130]
MOVE S2,[1,,.FBSIZ] ;[130]
MOVEI T1,T2 ;[130]
GTFDB ;[130]GET FILES BYTE COUNT
POP P,T1 ;[130]
SKIPN T1 ;[130]36/18?
JRST [MOVE T1,T2 ;[130]
SETZ T2, ;[130]
LSHC T1,-1 ;[130]DIVIDE BY 2
SKIPE T2 ;[130]REMAINDER?
ADDI T1,1 ;[130]YES
JRST OPNFI2] ;[130]
IMUL T1,T2 ;[130]
OPNFI2: MOVEM T1,EOFCNT ;[130]REAL NUMBER OF BYTES IN FILE
POP P,T2 ;[130]
POP P,T1 ;[130]
$RETT ;Return success
SUBTTL CLSFIL Routine to close local file and update FDB
CLSFIL: $SAVE <P1> ;[137]
MOVE P1,S1 ;[137]SAVE THE DELETE ON CLOSE FLAG
LOAD S1,LOCDEV,DV%TYP ;Get device type
MOVE S2,OPNFLG ;Get file open flags
TXNE S2,OF%RD ;[130]READING THE FILE?
SKIPG PAGFLG ;[130]AND USING PMAPS TO DO IT?
SKIPA ;[130]NO
$CALL UNMAP ;[130]YES, UNMAP THE FILE PAGE
$RETIF ;[147]FAIL IF ERROR IN UNMAP
CAIN S1,.DVDSK ;Is it disk?
TXNN S2,OF%WR ; and writing file?
PJRST CLSINP ;No..just close it
SKIPLE MCYIDX ;Yes..Residual MACY11 byte?
$CALL OUTMCD ;Yes..write last word
SKIPGE PAGFLG ;[130]TOPS-20 PAGE MODE
JRST CLSFI0 ;[130]YES, DON'T DO THIS
MOVE S1,PAGBP ;[130]CURRENT PAGE BYTE POINTER
ADDI S1,1000 ;[130]
CAMN S1,PAG1 ;[130]IS THIS PAGE EMPTY?
JRST CLSFIN ;[130]YES
SKIPN PAG1 ;[130]NULL FILE?
JRST CLSFIN ;[130]YES
MOVE T1,PAGBP ;[164]Save original byte pointer
$CALL PAGOUT ;[130]NO, OUTPUT THE PARTIAL PAGE
JUMPF TERCVT ;[130]
MOVEM T1,PAGBP ;[164]Restore original byte pointer
CLSFIN: MOVE T1,PFBSIZ ;[130]
MOVEM T1,.FBSIZ+ATTFDB ;[130]THE BYTE COUNT
MOVE T1,OPNFLG ;[130]
LSH T1,-6 ;[130]
AND T1,[7700,,0] ;[130]
MOVEM T1,.FBBYV+ATTFDB ;[130]BYTE SIZE
CLSFI0: MOVX S1,CO%NRJ ;Don't release JFN
HRR S1,LOCJFN
CLOSF ;Close the file
ERJMP TERCVT
MOVX S1,CF%NUD+<.FBCRV>B17 ;Get offset
MOVX S2,FWMASK ;set all bits to change
SKIPE T1,.FBCRV+ATTFDB ;Get creation date/time
$CALL CHNGFD ;Change the FDB
MOVX S1,CF%NUD+<.FBWRT>B17 ;Get the offset
SKIPE T1,.FBWRT+ATTFDB ;Get last update date/time
$CALL CHNGFD ;Change the FDB
; MOVX S1,CF%NUD+<.FBPRT>B17 ;Get the offset
; MOVX S2,FP%SLF+FP%GRP+FP%WLD ;Get protection mask
; SKIPE T1,.FBPRT+ATTFDB ;Get file protection
; $CALL CHNGFD ;Change the FDB
MOVX S1,CF%NUD+<.FBSIZ>B17 ;Get offset for bytecount word
MOVX S2,FWMASK ;CHANGE ALL BITS
SKIPE T1,.FBSIZ+ATTFDB ;Get file byte count
$CALL CHNGFD ;CHANGE THE FDB
MOVX S1,CF%NUD+<.FBBYV>B17 ;Get offset for bytesize
MOVX S2,FB%BSZ ;Change bytesize
SKIPE T1,.FBBYV+ATTFDB ;Get file bytesize
$CALL CHNGFD ;CHANGE THE FDB
SKIPL PAGFLG ;Recieve entire FDB?
JRST CLSFI1 ;No..don't update remaining info
MOVX S1,CF%NUD+<.FBCTL>B17 ;Yes..update remaining INFO
MOVX S2,FB%FCF ;Get mask for countrol word
SKIPE T1,.FBCTL+ATTFDB
$CALL CHNGFD
MOVX S1,CF%NUD+<.FBBYV>B17 ;Update mode and bytesize
MOVX S2,FB%BSZ+FB%MOD
SKIPE T1,.FBBYV+ATTFDB
$CALL CHNGFD
MOVX S1,CF%NUD+<.FBCRE>B17 ;Update creation date if possible
MOVX S2,FWMASK
SKIPE T1,.FBCRE+ATTFDB
$CALL CHNGFD
MOVX S1,CF%NUD+<.FBREF>B17 ;Update last reference
MOVX S2,FWMASK
SKIPE T1,.FBREF+ATTFDB
$CALL CHNGFD
; MOVX S1,CF%NUD+<.FBCNT>B17 ;Update access counts if possible
; MOVX S2,FWMASK
; SKIPE T1,.FBCNT+ATTFDB
; $CALL CHNGFD
MOVX S1,CF%NUD+<.FBUSW>B17 ;Update user settable word
MOVX S2,FWMASK
SKIPE T1,.FBUSW+ATTFDB
$CALL CHNGFD
CLSFI1: HRRZ S1,LOCJFN ;Get file JFN
SKIPN S2,LGAPTR ;[160]Use current account if NFT
MOVE S2,.DOACT+LLOPNB ;Point to files account
SACTF ;SET FILE'S ACCOUNT DESIGNATOR
ERJMP CLSFI2 ;[137]Failed..Release JFN
HRLI S1,.SFAUT ;SET THE AUTHOR STRING
SKIPE S2,.FBAUT+ATTFDB ;[160]Author specified?
JRST CLSFI3 ;[160]Yes, use it
SKIPN S2,LGUPTR ;[160]Use username if we are NFT
MOVE S2,.DOUSR+LLOPNB ;Pickup pointer to user string
CLSFI3: SFUST ;[160]DO IT
ERJMP CLSFI2 ;[137]Failed..Release JFN
HRLI S1,.SFLWR ;SET LAST WRITER
SKIPN S2,LGUPTR ;[160]Use username if we are NFT
MOVE S2,.DOUSR+LLOPNB ;Pickup pointer to user string
SFUST ;DO IT
ERJMP CLSFI2 ;[137]Failed..Release JFN
CLSFI2: SKIPLE PAGFLG ;[164]TOPS-20 Page mode?
SKIPN S1,PAGBP ;[164]Did we ever allocate a page?
JRST CLSFI4 ;[164]No, skip the following
LSH S1,-11 ;[164]Shift to prepare for
ANDI S1,777 ;[164]The page number
$CALL M%RELP ;[164]Release the page
SETZM PAGBP ;[164]Zero the page pointer
CLSFI4: SKIPN P1 ;[137]DELETE THE FILE?
PJRST RELJFN ;Release output JFN
PJRST DELFIL ;[137]YES
UNMAP: $SAVE <S1,S2> ;[130]
SKIPN S2,PAGMEM ;[151][130]DID WE MAP A PAGE?
$RETT ;[130]NO
SETZM PAGMEM ;[151]
HRREI S1,-1 ;[130]YES, UNMAP IT
HRLI S2,.FHSLF ;[130]PROCESS ID
SETZ T1, ;[130]
PMAP ;[130]
ERJMP TERCVT ;[130]
$RETT ;[130]
SUBTTL CLSINP Routine to close input file
CLSINP: SKIPG PAGFLG ;[130]
JRST CLSIN1 ;[130]
MOVE S1,PAGBP ;[130]
JUMPE S1,CLSIN1 ;[130]NEVER ALLOCATED A PAGE
LSH S1,-11 ;[130]
ANDI S1,777 ;[130]THE PAGE NUMBER
$CALL M%RELP ;[130]RELEASE THE PAGE
SETZM PAGBP ;[151]
CLSIN1: SKIPN P1 ;[137]DELETE THE FILE?
JRST CLSIN2 ;[137]NO
HRRZ S1,LOCJFN ;[137]
TXO S1,DF%NRJ ;[137]
SETZ S2, ;[137]
DELF ;[137]
ERJMP TERCVT ;[137]
CLSIN2: HRRZ S1,LOCJFN ;[157]Close file, keep JFN
TXO S1,CO%NRJ ;[157]
CLOSF% ;[157]
ERJMP TERCVT ;[157]
MOVE S1,LOCJFN ;[157]Input JFN wild?
TXZE S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;[157]
$RETT ;[157]
RLJFN% ;[157]No wildcards, Release JFN
ERJMP TERCVT ;[157]
SETZM LOCJFN ;[157]Show we don't own it anymore
$RETT ;[157]
SUBTTL DELFIL Routine to delete the local file
DELFIL: HRRZ S1,LOCJFN ;Get the local JFN
TXO S1,DF%NRJ ;Don't release JFN
SETZ S2, ;Default number of generations
DELF ;Delete it
ERJMP TERCVT ;Convert the error and return
PJRST RLNJFN ;Release JFN if not wild
SUBTTL ABTFIL Routine to abort local file operation
ABTFIL: $CALL UNMAP ;[151]UNMAP MAPPED FILE PAGE
MOVE S1,PAGBP ;[151]
JUMPE S1,ABTFI1 ;[151]DID WE ALLOCATE A PAGE?
LSH S1,-11 ;[151]YES
ANDI S1,777 ;[151]
$CALL M%RELP ;[151]RELEASE THE PAGE
SETZM PAGBP ;[151]
ABTFI1: HRRZ S1,LOCJFN ;[151]GET JFN FOR LOCAL FILE
TXO S1,CZ%ABT!CO%NRJ ;ABORT OPERATIONS
CLOSF ;AND CLOSE THE FILE
ERJMP TERCVT ;Return failure
RLNJFN: MOVE S1,LOCJFN ;Get local JFN
TXNE S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
$RETT ;Don't release wild JFN
RELJFN: HRRZ S1,LOCJFN ;Get file JFN
RLJFN ;Release it
ERJMP [CAIE S1,DESX3 ;JFN not assigned?
PJRST TERCVT ;No..return failure
JRST .+1] ;Return in line
SETZM LOCJFN ;Clear file JFN
SETZM WLDJFN ;Clear wild JFN
$RETT
SUBTTL CHNGFD Routine to change a field in output files FDB
;Accepts S1/ Offset to FDB location,,0
; S2/ Mask for requested bits
; T1/ Requested bits
CHNGFD: HRR S1,LOCJFN ;Get file JFN
CHFDB ;Change FDB per S1-T1
ERJMP .RETF ;Pass back failure
$RETT ;Return success
SUBTTL EOFCHK Routine to check for EOF in local file
;Returns TRUE We are at EOF
; FALSE Some other file error occured
EOFCHK: SKIPE PAGFLG ;[130]PMAPS?
JRST EOFCH1 ;[130]YES
$CALL TERCVT ;Get the last error code
CAXE S1,FLD(ER$TRN,ER%MAC)+FLD(ER$EOF,ER%MIC) ;EOF?
$RETF ;No..give bad return
TXO S,S%EOF ;Yes..set EOF flag
EOFCH1: TXNE S,S%EOF ;[130]
$RETT ;[130]
$RETF ;[130]
SUBTTL INPBYT Routine to read a byte from file
;Returns TRUE S1/ Next byte in File
; FALSE Byte not available
INPBYT: SKIPE MCYIDX ;MACY11 mode?
JRST INPMCY ;Yes..get a byte
INPBYM: SKIPN PAGFLG ;[130]NON DISK DEVICE?
JRST [HRRZ S1,LOCJFN ;[130]YES
BIN ;[130]
ERJMP TERCVT ;[130]
MOVE S1,S2 ;[130]
SETZ S2, ;[130]
$RETT] ;[130]
MOVE S1,EOFCNT ;[130]EOF BYTE COUNT
CAMN S1,PFBSIZ ;[130]EOF?
JRST [MOVEI S2,IOX4 ;[130]EOF STATUS
TXO S,S%EOF ;[130]
JRST TERCV0] ;[130]SIMULATE IT
SKIPE PAGBP ;[130]FIRST TIME HERE?
JRST INPBY1 ;[130]
$CALL PAGIN ;[130]YES
JUMPF [$RET] ;[130]
INPBY1: MOVE S1,PAGBP ;[130]CURRENT BYTE POINTER
CAME S1,PAG1 ;[130]AT END OF PAGE?
JRST INPBY2 ;[130]
$CALL PAGINN ;[130]GET NEXT PAGE
JUMPF [$RET] ;[130]
INPBY2: ILDB S1,PAGBP ;[130]GET NEXT BYTE
AOS PFBSIZ ;[130]INCREMENT BYTE COUNT
HRRZ S2,PAGBP ;[130]ADR OF WORD WITH BYTE
MOVE S2,0(S2) ;[130]WORD WITH BYTE
ANDI S2,1 ;[130]ISOLATE LIN NUM FLAG
EXCH S2,LINNUM ;[130]SAVE IT
CAIN S2,1 ;[130]IS THIS THE TAB...
CAIE S1," " ;[130]AFTER A LINE NUM?
JRST [MOVE S2,LINNUM ;[130]NO
$RETT] ;[130]
MOVEI S2,1 ;[130]YES
$RETT
PAGIN: $CALL M%NXPG ;[130]GET A NON EXISTANT PAGE
LSH S1,11 ;[130]CONVERT TO AN ADDRESS
MOVE S2,OPNFLG ;[130]OPEN FLAGS
LSH S2,-6 ;[130]BYTE SIZE
AND S2,[7700,,0] ;[130]ISLOATE IT
ADD S1,S2 ;[130]
IOR S1,[440000,,0] ;[130]
ADDI S1,1000 ;[130]
IBP 0,S1 ;[130]POINT AT FIRST BYTE
HRREI S2,-1 ;[130]
ADJBP S2,S1 ;[130]
MOVEM S2,PAGBP ;[130]
MOVEM S2,PAG1 ;[130]MARKER FOR END OF PAGE
PAGINN: $SAVE <T1> ;[130]SAVE T1
MOVE S1,PAGNUM ;[130]FILE PAGE NUMBER
AOS PAGNUM ;[130]SET UP FOR NEXT PAGE
HRL S1,LOCJFN ;[130]FILES JFN
RPACS ;[130]
ERJMP TERCVT ;[130]
TXNN S2,PA%PEX ;[130]PAGE EXISTS?
JRST [ MOVEI S2,IOX4 ;[130][170] No.
TXO S,S%EOF ;[170] simulate
JRST TERCV0] ;[130] eof.
MOVE S2,PAGBP ;[130]GET BYTE POINTER
SUBI S2,1000 ;[130]SET UP NEW POINTER
MOVEM S2,PAGBP ;[130]
LSH S2,-11 ;[130]
ANDI S2,777 ;[130]PAGE NUMBER
ADDI S2,1 ;[130]
MOVEM S2,PAGMEM ;[151]
HRLI S2,.FHSLF ;[130]TO THIS PROCESS
MOVX T1,PM%RD+PM%PLD ;[130]PRELOAD THE PAGE
PMAP ;[130]
ERJMP TERCVT ;[130]AN ERROR?
$RETT ;[130]
INPMCY: AOSN S2,MCYIDX ;Increment byte index
JRST INPMC1 ;Read first word of file
CAIGE S2,5 ;Time for a new word?
JRST INPMC2 ;No..just return the byte
INPMC1: HRRZ S1,LOCJFN ;Yes..get a file word
$CALL INPBYM ;[130]
JUMPF [$RET] ;[130]
MOVEM S1,MCYDAT ;[130]Save the word
MOVEI S2,1 ;Index begins at 1 for byte 1
MOVEM S2,MCYIDX ;Save for next pass
INPMC2: LDB S1,MCYTBL-1(S2)
$RETT
MCYTBL: POINT 8,MCYDAT,17 ;MACY11 byte 1
POINT 8,MCYDAT,9 ;MACY11 byte 2
POINT 8,MCYDAT,35 ;MACY11 byte 3
POINT 8,MCYDAT,27 ;MACY11 byte 4
SUBTTL OUTBYT Routine to write a byte to file
;Accepts S1/ Byte to write to file
;Returns TRUE S1/ Byte that was written
; FALSE Byte could not be written
OUTBYT: SKIPE MCYIDX ;MACY11 mode?
JRST OUTMCY ;Yes..bumble it!
OUTBYM: SKIPN PAGFLG ;[130]DISK DEVICE?
JRST [MOVE S2,S1 ;[130]NO
MOVE S1,LOCJFN ;[130]
BOUT ;[130]
ERJMP TERCVT ;[130]
MOVE S1,S2 ;[130]
$RETT] ;[130]
SKIPN PAGBP ;[130]DOES THE PAGE EXIST?
$CALL NEWPAG ;[130]NO, MAKE A NEW ONE
IDPB S1,PAGBP ;[130]OUTPUT THE BYTE
AOS PFBSIZ ;[130]INCREMENT THE BYTE COUNT
MOVE S1,PAGBP ;[130]GET THE CURRENT POINTER
CAME S1,PAG1 ;[130]IS THE PAGE FULL?
$RETT ;[130]
$CALL PAGOUT ;[130]YES
JUMPF [$RET] ;[130]
$RETT
NEWPAG: $SAVE <S1> ;[130]
$CALL M%NXPG ;[130]GET A NON EXISTANT PAGE
LSH S1,11 ;[130]MAKE IT AN ADDRESS
MOVE S2,OPNFLG ;[130]
LSH S2,-6 ;[130]
AND S2,[7700,,0] ;[130]
ADD S2,S1 ;[130]THE BYTE POINTER
OR S2,[440000,,00] ;[130]
MOVEM S2,PAGBP ;[130]
IBP 0,S2 ;[130]
HRREI S1,-1 ;[130]
ADJBP S1,S2 ;[130]
ADDI S1,1000 ;[130]
MOVEM S1,PAG1 ;[130]MARKER TO FIND END OF PAGE
$RETT ;[130]
PAGOUT: $SAVE <T1> ;[130]
HRRZ S1,PAGBP ;[130]THE PAGE BYTE POINTER
LSH S1,-11 ;[130]
ANDI S1,777 ;[130]THE PROCESS PAGE NUMBER
HRLI S1,.FHSLF ;[130]PROCESS HANDLE
HRL S2,LOCJFN ;[130]JFN OF THE FILE
HRR S2,PAGNUM ;[130]
AOS PAGNUM ;[130]
MOVX T1,PM%WR+PM%RD+PM%EX ;[130]PROPER ACCESS BITS
PMAP ;[130]
ERJMP TERCVT ;[130]ERROR?
MOVE S1,PAGBP ;[130]
SUBI S1,1000 ;[130]
MOVEM S1,PAGBP ;[130]
$RETT ;[130]
OUTMCY: AOSN S2,MCYIDX ;Bump the byte index
AOS S2,MCYIDX ;Once more for first word
CAIGE S2,5 ;Ready to write word?
JRST OUTMC1 ;No..just store the byte
OUTMCD: PUSH P,S1 ;Yes..save our byte
MOVE S1,MCYDAT ;[130]Get our last word
$CALL OUTBYM ;[130]
JUMPF [POP P,S1 ;[130]
$RET] ;[130]
POP P,S1 ;Retrieve our byte
SETZM MCYDAT ;Clear our last word
MOVEI S2,1 ;Index begins at 1
MOVEM S2,MCYIDX
OUTMC1: DPB S1,MCYTBL-1(S2) ;Store the byte
$RETT
ALNMCY: MOVEI TF,1 ;Get a bit
TDNE TF,MCYIDX ;Even byte boundry?
AOS MCYIDX ;No..Align it
$RETT
SUBTTL GETFDB Routine to read local file FDB and other info
GETFDB: HRROI S1,NAMFSP ;Point to filespec storage
HRRZ S2,LOCJFN ;Expand this file name
MOVX T1,FFSPEC ;Dev:<directory>name.ext.gen
JFNS
ERJMP TERCVT ;Convert error and return
GETFDD: HRRZ S1,LOCJFN ;Get JFN
HRLZI S2,.FBLEN ;Read all words form FDB
MOVEI T1,LOCFDB ; into local copy
GTFDB
ERJMP [MOVEI S1,.FBLEN ;Get length of FDB
MOVEI S2,LOCFDB ;Point to it
$CALL .ZCHNK ;Clear it
JRST GETFD1] ;Just return
GETFD1: MOVE S2,REMOST ;[110]GET SYSTEM TYPE
CAIN S2,.OSTP20 ;[110]TOPS20?
$RETT ;[110]YES
MOVEI S2,7 ;[110]DEFAULT BYTE SIZE IS 7
LOAD S1,.FBBYV+LOCFDB,FB%BSZ ;[110]GET BYTE SIZE
SKIPN S1 ;[110]ZERO BYTE SIZE?
STORE S2,.FBBYV+LOCFDB,FB%BSZ ;[110]YES, USE DEFAULT
$RETT
SUBTTL GETDEV Routine to get device attributes
;Accepts LOCJFN setup by SETINP or SETOUT
;Returns TRUE S1/ DAP device word (Also stored in ATTDEV)
; S2/ Local device characteristics word
; FALSE S1/ DAP unsupported device error
GETDEV: HRRZ S1,LOCJFN ;Get device JFN
DVCHR ;Read device characteristics
ERJMP DEVERR ;Return unsupported device
MOVEM S2,LOCDEV ;Save device word
TXNN S2,DV%AV ;Available?
PJRST DEVERR ;No..return an error
MOVX S1,FB$AVL ;Device must be available
TXNE S2,DV%OUT ;Capable of output?
TXO S1,FB$ODV ;Yes..
TXNE S2,DV%IN ;Capable of input?
TXO S1,FB$IDV ;Yes..
TXNE S2,DV%DIR ;Have a directory?
TXO S1,FB$SDI ;Yes..assume single for now
TXNE S2,DV%MDD ;Multiple directories
TXO S1,FB$MDI ;Yes..
TXNE S2,DV%ASN ;Assigned?
TXO S1,FB$ALL ;Yes..
TXNE S2,DV%MNT ;Mounted?
TXO S1,FB$MNT ;Yes..
ANDX S2,DV%TYP ;Issolate device type
MOVEI T1,DEVTBL ;Point to devices
GETDE1: SKIPN T2,0(T1) ;Get table entry
JRST DEVERR ;Unsupported device
HRR S2,T2 ;Setup for equallity
CAME S2,T2 ;Does it match?
AOJA T1,GETDE1 ;No..try the next
IOR S1,(T2) ;Yes..set the bits
MOVEM S1,ATTDEV ;Save device attributes
MOVE S2,LOCDEV ;Return local device char word
$RETT
DEVERR: $STATUS ER$FIL,ER$DEV ;Bad device
$RETF
DEVTBL: .DVDSK,,[FB$MDI+FB$SHR+FB$RAD] ;Disk
.DVLPT,,[FB$REC+FB$SQD+FB$SPL] ;Line printer
.DVCDP,,[FB$REC+FB$SQD+FB$SPL] ;Card punch
.DVPLT,,[FB$REC+FB$SQD+FB$SPL] ;Plotter
.DVMTA,,[FB$FOD+FB$SQD] ;Magtape
.DVTTY,,[FB$TRM+FB$SQD] ;Terminal
.DVCDR,,[FB$REC+FB$SQD] ;Card reader
.DVNUL,,[FB$NUL] ;Null device
EXP 0 ;Terminate list
SUBTTL SETATT Set attributes from switches
;SETATT is called to setup the attributes message per S1
;Accepts S1/ Mode to setup in attributes
; S2/ extra file attributes and Max record size
;Returns with
; ATTMNU with appropriate bits set
; ATTDAT with appropriate datatype
; ATTRFM with appropriate record format
; ATTRAT with appropriate record attributes
; ATTMRS with calling value
SETATT: MOVX T2,AT$DAT+AT$RFM+AT$RAT+AT$MRS
ANDCAM T2,ATTMNU ;Clear the Menu bits
LOAD T1,S2,DF%MRS ;Get maximum record size
MOVEM T1,ATTMRS ;Save it
MOVE S1,MODTB1(S1) ;Get attributes per mode
LOAD T1,S1,DF%DAT ;Get Data type
MOVEM T1,ATTDAT ;Save it
LOAD T1,S1,DF%RFM ;Get record format
MOVEM T1,ATTRFM ;Save it
CAIN T1,FB$UDF ;Undefined record format?
TXZ T2,AT$MRS ;Yes..clear the MRS menu bit
LOAD T1,S1,DF%RAT ;Get record attributes
MOVEM T1,ATTRAT ;Save it
IORM T2,ATTMNU ;Set the menu bits
$RETT
SUBTTL SWLOOK Lookup user switches and convert to DAP attriubtes
;Accepts S1/ Data type - record format - record attributes
;Returns S1/ Data mode implied by switches
SWLOOK: ANDX S1,DF%DAT+DF%RFM+DF%RAT ;Keep interesting bits
MOVSI S2,-MOD$LN ;Get length of the table
JUMPE S1,SWLOO3 ;Establish default mode
TXNE S1,FLD(DT$IMA+DT$ASC,DF%DAT) ;Datatype specified?
JRST SWLOO1 ;Yes..see what we have
TXNN S1,FLD(FB$MCY,DF%RAT) ;No..Was MACY11 specified?
TXO S1,FLD(DT$IMA,DF%DAT) ;No..Datatype is image
SWLOO1: CAMN S1,MODTBL(S2) ;Match an entry?
JRST SWLOO3 ;Yes..finish up
AOBJN S2,SWLOO1 ;No..try the next
$RETF ;Return a failure
SWLOO3: HRRZ S1,S2 ;Return mode in S1
$RETT
SUBTTL CHKMOD Routine to check for legal input to output mode
CHKMOD: SKIPE S1,SRCMOD ;Unspecified source?
SKIPN S2,DSTMOD ;Unspecified destination?
$RETT ;Yes..can't check it yet!
MOVNS S2 ;Get right shift value for mode
MOVX T1,1B0 ;Get the bit for Mode (0)
LSH T1,0(S2) ;Get the bit for dest mode
TDNN T1,MODTBO(S1) ;Valid for source mode?
$RETF ;No..return the error
$RETT
SUBTTL [125] PICMOD - Pick default file mode by system type
PICMOD: MOVE S1,REMOST ;GET REMOTE HOST TYPE
CAIL S1,PMTLEN ;[155]IN RANGE OF TABLE?
SETZ S1, ;[155]NO, SO PICK SOME DEFAULT
MOVE S1,PMTAB(S1) ;GET DEF MODE FOR THAT HOST
$RETT ;RETURN
PMTAB: .MD8 ; 0. ?
.MD8 ; 1. RT
.MD8 ; 2. RSTS
.MD10 ; 3. RSX11S
.MD10 ; 4. RSX11M
.MD10 ; 5. RSX11D
.MD10 ; 6. IAS
.MD10 ; 7. VMS
.MD8 ; 8. TOPS-20
.MD8 ; 9. TOPS-10
.MD8 ;10. RT-8
.MD8 ;11. OS-8
.MD10 ;12. RSX11M-PLUS
PMTLEN=.-PMTAB ;[155]
SUBTTL File mode table definitions
;Define a macro to generate table entries
DEFINE XX (MOD,RFM<0>,RAT<0>) <
FLD(MOD,DF%DAT)+FLD(RFM,DF%RFM)+FLD(RAT,DF%RAT)>
;Define a macro to generate a bit mask
DEFINE XB (BIT) <
ZZ==0
IRP <BIT>,<ZZ==ZZ!1B<BIT>>
EXP ZZ>
;Define a macro to generate default mode word
DEFINE XM (MODES) <
BYTE (4) MODES>
.MD1==^D1 ;/IMAGE
.MD2==^D2 ;/IMAGE/FIXED
.MD3==^D3 ;/IMAGE/VARIABLE
.MD4==^D4 ;/IMAGE/MACY
.MD5==^D5 ;/MACY
.MD6==^D6 ;/MACY/FIXED
.MD7==^D7 ;/MACY/VARIABLE
.MD8==^D8 ;/ASCII
.MD9==^D9 ;/ASCII/FIXED
.MD10==^D10 ;/ASCII/VARIABLE
.MD11==^D11 ;Print file format
.MD12==^D12 ;Fortran format
;Table of valid calling switches
MODTBL: XX 0 ;Mode(0) unspecified
XX DT$IMA ;Mode(1) /IMAGE
XX DT$IMA,FB$FIX ;Mode(2) /IMAGE/FIXED
XX DT$IMA,FB$VAR ;Mode(3) /IMAGE/VARIABLE
XX DT$IMA, 0 ,FB$MCY ;Mode(4) /IMAGE/MACY11
XX 0 , 0 ,FB$MCY ;Mode(5) /MACY11
XX 0 ,FB$FIX,FB$MCY ;Mode(6) /MACY11/FIXED
XX 0 ,FB$VAR,FB$MCY ;Mode(7) /MACY11/VARIABLE
XX DT$ASC ;Mode(8) /ASCII
XX DT$ASC,FB$FIX ;Mode(9) /ASCII/FIXED
XX DT$ASC,FB$VAR ;Mode(10) /ASCII/VARIABLE
XX -1 ;Mode(11) Cant be specified
XX -1 ;Mode(12) Can't be specified
MOD$LN==.-MODTBL ;Compute length
;Table of valid output modes per input mode
MODTBO: 0
XB <.MD1>
XB <.MD1,.MD2,.MD6>
XB <.MD3,.MD5,.MD7>
XB <.MD1,.MD4>
XB <.MD3,.MD5,.MD7>
XB <.MD1,.MD2,.MD4,.MD6>
XB <.MD3,.MD5,.MD7>
XB <.MD8,.MD10>
XB <.MD8,.MD9>
XB <.MD8,.MD10>
XB <.MD8>
XB <.MD8>
;Table for DAP equivalent attributes
MODTB1: XX DT$IMA,FB$UDF ;unspecified
XX DT$IMA,FB$UDF ;/IMAGE
XX DT$IMA,FB$FIX ;/IMAGE/FIXED
XX DT$IMA,FB$VAR ;/IMAGE/VARIABLE
XX DT$IMA,FB$UDF,FB$MCY ;/IMAGE/MACY11
XX DT$IMA,FB$STM,FB$MCY ;/MACY (Dos Binary)
XX DT$IMA,FB$FIX,FB$MCY ;/MACY11/FIXED
XX DT$IMA,FB$VAR,FB$MCY ;/MACY11/VARIABLE
XX DT$ASC,FB$STM ;/ASCII
XX DT$ASC,FB$FIX,FB$CR ;/ASCII/FIXED
XX DT$ASC,FB$VAR,FB$CR ;/ASCII/VARIABLE
XX DT$ASC,FB$VFC,FB$PRN ;Print format is read only
XX DT$ASC,FB$VFC,FB$FTN ;Fortran format is read only
;Table of default output modes per source mode
MODTB2: 0
XM <.MD1> ;/IMAGE (TO) /IMAGE
XM <.MD2> ;/IMAGE/FIX (TO) /IMAGE/FIX
XM <.MD3> ;/IMAGE/VAR (TO) /IMAGE/VAR
XM <.MD1> ;/IMAGE/MAC (TO) /IMAGE
XM <.MD3> ;/MACY (TO) /IMAGE/VAR
XM <.MD2> ;/MACY/FIX (TO) /IMAGE/FIX
XM <.MD3> ;/MACY/VAR (TO) /IMAGE/VAR
XM <0,.MD8,.MD10> ;[125] PICK DEF BY SYSTEM TYPE
XM <0,.MD8,.MD10> ;[125] PICK DEF BY SYSTEM TYPE
XM <0,.MD8,.MD10> ;[125] PICK DEF BY SYSTEM TYPE
XM <.MD11> ;Print file to ascii stream
XM <.MD12> ;Fortran file to ascii stream
;Table of processor addresses for various modes
MODTB3: 0
XWD GETIMG,PUTIMG ;/IMAGE
XWD GETIMG,PUTIMG ;/IMAGE/FIXED
XWD GETIMG,PUTIMG ;/IMAGE/VARIABLE
XWD GETIMG,PUTIMG ;/MACY/IMAGE
XWD GETDOS,PUTDOS ;/MACY
XWD GETIMG,PUTIMG ;/MACY/FIXED
XWD GETIMG,PUTIMG ;/MACY/VARIABLE
XWD GETASC,PUTASC ;/ASCII
XWD GETASC,PUTASC ;/ASCII/FIXED
XWD GETASC,PUTASC ;/ASCII/VARIABLE
XWD GETASC,[PJRST .RETT] ;PRN format is read only
XWD GETASC,[PJRST .RETT] ;FTN format is read only
;Table of valid file bytesizes for mode
MODTB4: 0
EXP -1 ;1 to 36 for IMAGE
EXP -1
EXP -1
XB <18,0> ;18 or 36 for MACY
XB <18,0>
XB <18,0>
XB <18,0>
XB <7,8,0> ;7 8 or 36 for ASCII
XB <7,8,0>
XB <7,8,0>
XB <7> ;7 for print format
XB <7> ;7 for fortran format
;Table of file open bytesize for mode
MODTB5: 0
EXP 0 ;Actual file bytesize for IMAGE
EXP 0
EXP 0
EXP ^D36 ;36 for /MACY
EXP ^D36
EXP ^D36
EXP ^D36
EXP ^D7 ;7 for ASCII
EXP ^D7 ;7 for ASCII FIXED
EXP ^D7 ;7 for ASCII VARIABLE
EXP ^D7 ;7 for print format
EXP ^D7 ;7 for fortran format
;Table of attributes bytesize for mode
MODTB6: 0
EXP 0 ;Actual file bytesize for IMAGE
EXP 0
EXP 0
EXP ^D8 ;8 bit bytes for MACY11
EXP ^D8
EXP ^D8
EXP ^D8
EXP ^D8 ;8 bit bytes for ASCII
EXP ^D8
EXP ^D8
EXP ^D8 ;8 bit bytes for print format
EXP ^D8 ;8 bit bytes for fortran format
;Table of valid modes for FAL file create
MODTB7: 0
EXP -1 ;Image undefined Ok for FAL
0
0
EXP -1 ;Macy11 Ok for FAL
EXP -1
EXP -1
EXP -1
EXP -1 ;Ascii stream Ok for FAL
0
0 ;Can't create print files
0 ;Can't create print format
0 ;Can't create fortran format
SUBTTL ATLOOK Routine to lookup attributes
;ATLOOK is called after recieving an attributes message to return
; the data mode implied by the message and also the default
; output mode.
;Returns TRUE S1/ Source mode implied by attributes
; S2/ Default output mode implied by source mode
; FALSE S1/ Unsupported data type
ATLOOK: MOVE S1,ATTDAT ;Get data mode of attributes
STORE S1,S2,DF%DAT ;Store in proper field
MOVE S1,ATTRFM ;Get record format of attributes
STORE S1,S2,DF%RFM ;Store in proper field
MOVE S1,ATTRAT ;Get record attributes
TXZ S1,FB$BLK+FB$EBF ;[125]IGNORE BLOCKING&IMBED CC
STORE S1,S2,DF%RAT ;Store in proper field
ANDX S2,DF%DAT+DF%RFM+DF%RAT ;Keep interesting fields
TXZ S2,FLD(DT$EXE+DT$EXP+DT$SEN+100+,DF%DAT) ;ignored bits
MOVSI S1,-AT$$LN ;Get count of valid entries
ATLOO1: CAMN S2,ATTTBL(S1) ;Entry match?
JRST ATLOO2 ;Yes..process it
AOBJN S1,ATLOO1 ;No..try the next
$MUERR .DMATT,21 ;Not found..return unsupported
ATLOO2: HRRZ S2,ATTMOD(S1) ;Get default output mode
HLRZ S1,ATTMOD(S1) ;Get implied source mode
$RETT ;Return success
SUBTTL Attributes list
ATTTBL: XX DT$ASC,FB$STM ;Stream ascii
XX DT$ASC,FB$UDF ;Undefined ascii
XX DT$ASC,FB$STM,FB$EBF ;Stream ascii
XX DT$IMA,FB$UDF ;Undefined image
XX DT$IMA,FB$UDF,FB$MCY ;Macy image
XX DT$IMA,FB$FIX,FB$MCY ;Macy Fixed
XX DT$IMA,FB$VAR,FB$MCY ;Macy variable
XX DT$IMA,FB$STM,FB$MCY ;Macy stream (Assembler)
XX DT$ASC,FB$FIX ;Fixed ascii
XX DT$ASC,FB$FIX,FB$CR ;Fixed ascii
XX DT$ASC,FB$FIX,FB$EBF ;Fixed ascii
XX DT$ASC,FB$VAR ;Variable ascii
XX DT$ASC,FB$VAR,FB$CR ;Variable ascii
XX DT$ASC,FB$VAR,FB$EBF ;Variable ascii
XX DT$IMA,FB$FIX ;Fixed image
XX DT$IMA,FB$VAR ;Variable image
XX DT$IMA,FB$FIX,FB$CR ;Fixed image [ascii]
XX DT$IMA,FB$VAR,FB$CR ;Variable image [ascii]
XX DT$IMA,FB$VFC,FB$PRN ;Print file format
XX DT$IMA,FB$VFC,FB$CR ;Sos file format
XX DT$ASC,FB$VFC,FB$PRN ;Ascii print
XX DT$ASC,FB$VFC,FB$CR ;Ascii Sos
XX DT$IMA,FB$VFC,FB$FTN ;Fortran files
XX DT$ASC,FB$VFC,FB$FTN
XX DT$ASC,FB$VAR,FB$FTN ;[126]
XX DT$IMA,FB$VAR,FB$FTN ;[126]
XX DT$IMA,FB$FIX,FB$FTN ;[126]
XX DT$ASC,FB$FIX,FB$FTN ;[126]
XX DT$IMA,FB$STM ;Ascii stream from RSTS
XX DT$IMA,FB$STM,FB$CR ;[125]another RSTS oddity
XX DT$ASC,FB$STM,FB$CR ;[126]VMS STREAM FILES
XX DT$ASC,FB$VFC ;[125]
XX DT$IMA,FB$VFC ;[125]
AT$$LN==.-ATTTBL ;Number of valid attributes
ATTMOD: XWD .MD8,.MD8 ;Stream ascii (to) Stream ascii
XWD .MD8,.MD8 ;Undefined ascii (to) Stream ascii
XWD .MD8,.MD8 ;Stream ascii (to) Stream ascii
XWD .MD1,.MD1 ;Undefined image (to) Undefined image
XWD .MD4,.MD4 ;Macy image (to) Macy image
XWD .MD6,.MD6 ;Macy fixed (to) Macy fixed
XWD .MD7,.MD7 ;Macy variable (to) Macy variable
XWD .MD5,.MD5 ;Macy stream (to) Macy stream
XWD .MD9,.MD8 ;Fixed ascii (to) Stream ascii
XWD .MD9,.MD8 ;Fixed ascii (to) Stream ascii
XWD .MD9,.MD8 ;Fixed ascii (to) Stream ascii
XWD .MD10,.MD8 ;Variable ascii (to) Stream ascii
XWD .MD10,.MD8 ;Variable ascii (to) Stream ascii
XWD .MD10,.MD8 ;Variable ascii (to) Stream ascii
XWD .MD2,.MD2 ;Fixed image (to) Fixed image
XWD .MD3,.MD3 ;Variable image (to) Variable image
XWD .MD9,.MD8 ;Fixed image [ascii] (to) stream ascii
XWD .MD10,.MD8 ;Variable image [ascii] (to) Strm ascii
XWD .MD11,.MD8 ;Print format to stream ascii
XWD .MD10,.MD8 ;Sos to stream ascii
XWD .MD11,.MD8 ;Print format to stream ascii
XWD .MD10,.MD8 ;Sos to stream ascii
XWD .MD12,.MD8 ;Fortran files
XWD .MD12,.MD8 ;Fortran files
XWD .MD10,.MD8 ;[126]
XWD .MD10,.MD8 ;[126]
XWD .MD10,.MD8 ;[126]
XWD .MD10,.MD8 ;[126]
XWD .MD8,.MD8
XWD .MD8,.MD8 ;[125]
XWD .MD8,.MD8 ;[126]VMS STREAM
XWD .MD10,.MD8 ;[125]
XWD .MD10,.MD8 ;[125]
SUBTTL SETMOD Routine to setup processor address and bytesizes
;SETMOD is called after SETINP or SETOUT to establish proper mode
;Returns TRUE S1/ mode
; S2/ Attributes bytesize
SETMOD: MOVE S1,OPNFLG ;Get file open flags
TXNN S1,OF%RD ;Reading the file?
JRST [MOVE T1,DSTMOD ;Get destination mode
JRST SETMO2] ;Setup per destination
LOAD S1,.FBBYV+LOCFDB,FB%BSZ ;Yes..get file BSZ
MOVX S2,1B0 ;Get a bit to test
SKIPN T1,SRCMOD ;Get the source mode
JRST [MOVEI T1,.MD1 ;Assume image mode
CAIN S1,^D7 ;Unless bytesize is 7
MOVEI T1,.MD8 ;which means ascii
MOVEM T1,SRCMOD ;Remember it
JRST .+1] ;Continue
CAIN S1,^D36 ;Bytesize = 36?
JRST SETMO1 ;Yes..test with bit 0
MOVNS S1 ;Get -bytesize
LSH S2,0(S1) ;Shift to proper bit
SETMO1: TDNN S2,MODTB4(T1) ;OK for this mode?
$MIERR .DMATT,36 ;No..bad bytesize
SETMO2: SKIPN S1,MODTB5(T1) ;Get open BSZ
LOAD S1,.FBBYV+LOCFDB,FB%BSZ ;Use file BSZ
SKIPN S2,MODTB6(T1) ;Get BSZ for attributes
MOVE S2,S1 ;Use file open BSZ
STORE S1,OPNFLG,OF%BSZ ;Save for open
MOVE T2,MODTB3(T1) ;Get processor dispatch
MOVEM T2,DATDAT
MOVE T2,MODTB1(T1) ;Get DAP attributes
SETZM MCYIDX ;Clear MACY flag
TXNE T2,FLD(FB$MCY,DF%RAT) ;Unless wanted
SETOM MCYIDX
MOVE S1,T1 ;Return mode in S1
$RETT
SUBTTL TYPSTS Routine to expand DAP status codes
;Accepts S1/ Status code
; S2/ Extended status
; T1/ Output designator
; T1/ Updated designator
TYPSTS: $SAVE <S1,S2,P1,P2,P3,P4> ;Preserve some AC's
MOVE P1,T1 ;Save output designator
LOAD P2,S1,ER%MAC ;Get MACODE
LOAD P3,S1,ER%MIC ;Get MICODE
SKIPE P4,S2 ;Save extended status
JRST [CAIL P4,.ERBAS ;Check for valid error codes
CAILE P4,.ERBAS+.ERMAX
JRST .+1 ;Invalid code for our system
MOVE S1,P1 ;Get output designator
HRROI S2,[ASCIZ//] ;No text
MOVEI T1,[ITEXT<^E/P4/>] ;Only our error
JRST TYPST8] ;Display it
MOVSI S2,-MIC$LN ;Get length of table
CAIN P2,ER$USP ;Unsupported status error?
JRST TYPST1 ;Yes..do actual lookup
CAIL P2,ER$FMT ;Format, Invalid, or SYNC error?
CAILE P2,ER$SNC ;...
ANDX S1,ER%MIC ;No..do generic lookup
TYPST1: HRRZ T1,MICTBL(S2) ;Get the status code
CAMN S1,T1 ;Match what we have?
JRST TYPST2 ;Yes..display it
AOBJN S2,TYPST1 ;No..check the next
CAIN P2,ER$USP ;Unsupported status error?
JRST TYPST3 ;Yes..do name lookup
CAIL P2,ER$FMT ;Format, Invalid, or SYNC error?
CAILE P2,ER$SNC ;...
SKIPA S1,P1 ;No..get output designator
JRST TYPST3 ;Yes..do name lookup
JRST TYPST7 ;Display per ITEXT
TYPST2: MOVE S1,P1 ;Get output designator
HLRO S2,MICTBL(S2) ;Get pointer to string
SETZ T1, ;No ITEXT
JRST TYPST8 ;Store the status
TYPST3: MOVSI S2,-MSG$LN ;Get number of message types
MOVE S1,P3 ;Get MICODE
CAIE P2,ER$SNC ;SYNC error?
LSH S1,-6 ;No..get message type
TYPST4: HLRZ T1,MSGTBL(S2) ;Get Message type
CAMN S1,T1 ;Match what we have?
JRST TYPST5 ;Yes..get the name
AOBJN S2,TYPST4 ;No..try the next
HRROI T1,[ASCIZ/Unknown/]
JRST TYPST6
TYPST5: HRRZ S2,MSGTBL(S2) ;Get Message descriptor
HRRO T1,0(S2) ;Get pointer to name
TYPST6: EXCH P1,T1 ;Put pointer in P1
MOVE S1,T1 ;Put output designator in S1
TYPST7: HRROI S2,[ASCIZ//] ;Null string
MOVE T1,MACTBL(P2) ;Get proper ITEXT to expand
TYPST8: SETZ T2, ;Get null prefix character
$CALL TYPER ;Display the string
HRROI S2,[ASCIZ //] ;[113]
MOVEI T1,[ITEXT < (MAC:^O/P2/ MIC:^O/P3/ STV:^O/P4/)>] ;[113]
SETZ T2, ;[113]
$CALL TYPER ;[113] APPEND (MAC:MIC:EXTEND)
MOVE T1,S1 ;Return designator in T1
$RETT
SUBTTL TERCVT Routine to convert TOPS20 error code to dap status
;Returns S1/ Dap status code
; S2/ Last TOPS20 error code
TERCVT: $CALL GETTER ;Get last JSYS error in S2
TERCV0: MOVE T1,[IOWD S20DLN,S20DAP+1] ;Point to table
TERCV1: HLRZ S1,(T1) ;GET TOPS-20 ERROR FROM TABLE
CAMN S1,S2 ;MATCHING ENTRY?
JRST TERCVF ;YES!
AOBJN T1,TERCV1 ;NO MATCH - LOOP BACK FOR NEXT
TDZA S1,S1 ;Return unspecified error
TERCVF: HRRZ S1,(T1) ;GET CORRESPONDING DAP STATUS
MOVX T1,ER$FIL ;Assume file open error
TXNN S,S%GET+S%PUT+S%EOF ;Is it?
JRST TERCV2 ;yes
MOVX T1,ER$TRN ;No..Assume transfer error
TXNE S,S%EOF ;Is it?
MOVX T1,ER$TRM ;Termination error
TERCV2: STORE T1,S1,ER%MAC ;STUFF MACCODE INTO DAP STATUS
TXO S,S%JERR ;[127]FLAG A JSYS ERROR
$RETF ;Return calling failure
SUBTTL LLGJFN Routine to get JFN for logical link
SUBTTL LLGJFN Get a JFN for logical link
;Accepts CP/ Base of per link info
; AP/ Base of calling argument block
;Returns TRUE Link has a JFN
LLGJFN: MOVE T2,.DOFLG(AP) ;GET ARGUMENT BLOCK FLAGS
MOVE T4,[-DCNSIZ,,DCNPFX+1] ;ASSUME DCN
TXNE T2,DO%SRV ; UNLESS WE WANT TO BE A SERVER
JRST [$CALL ENABLE ;YES..MAKE SURE WE ARE WHEEL
MOVE T4,[-SRVSIZ,,SRVPFX+1] ;DEVICE IS SRV:
JRST LLGJF0] ;CONTINUE ON.
SETZM MESIN ;[134]
SETZM MESOUT ;[134]
SKIPN PMRFLG ;[121]DOING POOR MAN'S ROUTING?
JRST LLGJF0 ;[121]NO.
;[171] MOVEI S1,.NDVFY ;[121]
;[171] MOVEI S2,T1 ;[121]
;[171] MOVE T1,.DONOD(AP) ;[121]POINTER TO HOST NAME
;[171] SETZ T2, ;[121]
;[171] NODE ;[121]
;[171] TXNE T2,ND%EXM ;[121]EXACT MATCH?
;[171] JRST [MOVEI S1,1 ;[121]
;[171] MOVEM S1,PMRFLG ;[121]
;[171] JRST LLGJF0] ;[121]YES, DON'T DO PMR
MOVE S1,.DONOD(AP) ;[121]POINTER TO HOST NAME
MOVEM S1,CONBLK+DN.HST ;[121]SAVE IT
MOVEI S1,^D17 ;[121]FAL OBJECT TYPE
MOVEM S1,CONBLK+DN.ROB ;[121]SAVE IT
MOVEI S1,^D8 ;[121]BYTE SIZE
MOVEM S1,CONBLK+DN.BSZ ;[121]SAVE IT
MOVE S1,[POINT 7,MSGTXT] ;[121]
MOVE S2,.DOPSW(AP) ;[121]POINTER TO PASSWORD
SETZB T1,T2 ;[121]
$CALL QSOUT ;[121] COPY STRING AND QUOTE
HRROI S1,MSGTXT ;[121] POINTER TO TEMP PASSWORD
MOVEM S1,CONBLK+DN.PWD ;[121]
MOVE S1,[POINT 7,MSGTXT+12] ;[121]
MOVE S2,.DOACT(AP) ;[121]POINTER TO ACCOUNT NUMBER
$CALL QSOUT ;[121]
HRROI S1,MSGTXT+12 ;[121]
MOVEM S1,CONBLK+DN.ACN ;[121]
MOVE S1,[POINT 7,MSGTXT+24] ;[121]
MOVE S2,.DOUSR(AP) ;[121]POINTER TO USERID
$CALL QSOUT ;[121]
HRROI S1,MSGTXT+24 ;[121]
MOVEM S1,CONBLK+DN.USR ;[121]
MOVEI S1,.PRIOU ;[121]
MOVEM S1,CONBLK+DN.WRN ;[121]
MOVEM S1,CONBLK+DN.INF ;[121]
MOVEM S1,CONBLK+DN.ERR ;[121]
SETZ S2, ;[121]
MOVE S1,REMOST ;[121]
CAIN S1,.OSTP20 ;[121]
SETO S2, ;[121]
MOVEI S1,CONBLK ;[121]
$CALL .DNCON## ;[121]
JRST FATAL ;[121]
JRST LLGJF3 ;[121]
LLGJF0: HRRZ T3,-1(T4) ;GET OFFSET TO FIRST POINTER
ADDI T3,(AP) ;GET ACTUAL ADDRESS
HRROI S1,LLNAME ;POINT TO NAME AREA
LLGJF1: MOVX T1,177B6 ;Get first character mask
SKIPE T2,(T3) ;IS THIS field present
TDNN T1,(T2) ; AND NOT NULL?
JRST LLGJF2 ;NO..SKIP IT
MOVE S2,(T4) ;YES..DO PREFIX
SETZ T1,
SOUT
MOVE S2,T2 ;DO THE FIELD
$CALL QSOUT ;COPY STRING
LLGJF2: AOJ T3, ;NEXT FIELD
AOBJN T4,LLGJF1 ;DO ALL PRESENT
MOVX S1,GJ%NEW+GJ%SHT ;MUST NOT EXIST
HRROI S2,LLNAME ;POINT TO FILESPEC
GTJFN ;GO GET THE JFN
$FATAL (Can't get JFN for logical link - ,^E/[-2]/)
LLGJF3: MOVEM S1,LLJFN ;SAVE THE JFN
HRROI S1,LLNAME ;POINT TO NAME STRING STORAGE
HRRZ S2,LLJFN ;GET LL JFN
MOVX T1,FFSPEC ;Full file spec
JFNS ;SAVE OFF FULL FILESPEC STRING
$DEBUG <Network JFN Established, >,<^T/LLNAME/>
$RETT
DCNPFX: DCNSIZ,,.DONOD ;SIZE,,FIRST OFFSET
TXT(DCN:) ;PREFIX FOR NODE
TXT(-) ;PREFIX FOR OBJECT
TXT(-) ;PREFIX FOR DISCRIPTOR
TXT(.) ;PREFIX FOR TASKNAME
TXT(;USERID:) ;PREFIX FOR USERID
TXT(;PASSWORD:) ;PREFIX FOR PASSWORD
TXT(;CHARGE:) ;PREFIX FOR ACCOUNT
TXT(;DATA:) ;PREFIX FOR DATA
DCNSIZ==.-DCNPFX-1 ;SIZE OF TABLE
SRVPFX: SRVSIZ,,.DOOBJ ;SIZE,,FIRST OFFSET
TXT(SRV:) ;PREFIX FOR OBJECT
TXT(-) ;PREFIX FOR DESCRIPTOR
TXT(.) ;PREFIX FOR TASKNAME
SRVSIZ==.-SRVPFX-1 ;SIZE OF TABLE
SUBTTL QSOUT move asciz string and quote if required
QSOUT: $SAVE <T1,T2>
TLCE S2,-1
TLCN S2,-1
HRLI S2,(POINT 7,0)
QSOUT1: ILDB T1,S2 ;Get source byte
SKIPN T2,T1 ;Put byte in T2
JRST QSOUT3 ;Finished on null
CAIL T1,"0" ;Check numeric
CAILE T1,"9"
TRZA T2,40 ;Make upper case
JRST QSOUT2 ;Numeric..store it
CAIL T2,"A" ;Check alpha
CAILE T2,"Z"
SKIPA T2,[EXP "V"-100] ;Get quote character
JRST QSOUT2 ;Alpha..store it
CAIE T1,"." ;Allow period
CAIN T1,"-" ;Allow hyphen
JRST QSOUT2 ;Store it
IDPB T2,S1
QSOUT2: IDPB T1,S1 ;Store the character
JRST QSOUT1 ;Back for more
QSOUT3: MOVE T2,S1 ;Get dest pointer
IDPB T1,T2 ;Store null terminator
$RETT ;Return
CPYSTR: SETZM T1 ;Terminate on null
SOUT
$RETT
SUBTTL LLOPEN Routine to OPEN logical link
;LLOPEN Opens NETWORK JFN for DCN: or SRV:
;Accepts CP/ Base of per link data
; AP/ Base of D$OPEN argument block
;Returns TRUE LINK is open and attatched to interrupt system
; Although not necessarily connected
LLOPEN: $DEBUG <Attempting to Open Logical link>
SKIPL PMRFLG ;[121]
JRST LLOPN0 ;[121]
MOVE S1,.DOFLG(AP) ;[121]
TXNN S1,DO%SRV ;[121]A SERVER?
JRST LLOPN1 ;[121]NO, LINK ALREADY OPEN
LLOPN0: MOVE S1,LLJFN ;GET JFN OF LL TO OPEN
MOVE S2,[FLD(^D8,OF%BSZ)+OF%RD+OF%WR]
OPENF ;TRY TO OPEN LINK
ERJMP LLOPN5 ;RELEASE JFN AND RETURN
LLOPN1: MOVE S1,LLJFN ;GET JFN AGAIN
MOVEI S2,.MORTN ;GET TASK NAME FOR THIS LL
SKIPE T1,.DOTSK(AP) ;POINT TO TASK NAME
MTOPR ;DO MTOPR
ERJMP LLOPN4
MOVEI S2,.MORLS ;[140]
MTOPR ;[140]
ERJMP LLOPN4 ;[140]
MOVEM T1,LLSTAT ;[140]SAVE CURRENT NETWORK STATUS
MOVEI S2,.MOACN ;ENABLE FOR CONNECT INTERRUPTS
MOVE T1,.DOPSI(AP) ;GET PSI FLAGS
MOVX T4,DO%PSI ;GET PSI FLAG
TDNE T4,.DOFLG(AP) ;Want to be on PSI?
MTOPR ;yes..do MTOPR
ERJMP LLOPN4
$STATE .LLCFG ;Say link is waiting on Config
MOVE S2,.DOTSK(AP) ;Get task pointer
$RETT ;RETURN SUCCESS
;HERE WHEN LINK CAN'T BE OPENED
LLOPN4: MOVE S1,LLJFN ;GET THE JFN
TXO S1,CZ%ABT ;ABORT IT
CLOSF
ERJMP .+1
LLOPN5: SETZB S,LLJFN ;MARK NOT OPENED
$FATAL (Can't open logical link - ,^E/[-2]/)
SUBTTL LLWCON ROUTINE TO WAIT FOR LINK TO BE CONNECTED
;RETURN TRUE S1/ Link status from MTOPR
LLWCON: MOVEI T4,^D30 ;Wait for 30 CCTIME intervals
LLWC1: $CALL LLCHK ;CHECK LL STATUS
JUMPF LLWC3 ;Find out why we aborted
TXNE S1,MO%CON ;LINK CONNECTED?
$RETT ;Yes..give good return
TXNE S1,MO%SYN ;LINK CLOSED OUT BY OTHER END?
JRST LLWC3 ;Yes..Find out why
TXNE S1,MO%SRV ;IS THIS A SERVER?
JRST LLWC4 ;Yes..wait for interrupt
SOJG T4,LLWC2 ;Tried enough?
$CALL DIABT ;Cancel the link
$FATAL (Remote node is not responding)
LLWC4: TDZA S1,S1 ;Sleep for ever
LLWC2: MOVEI S1,CCTIME ;NO..GET WAIT TIME
$CALL I%SLP ;AND SNOOZE
JRST LLWC1 ;TRY AGAIN
;HERE WHEN LINK IS ABORTED
LLWC3: SKIPE LLJFN ;Still have a JFN?
$CALL DIABT ;Yes..respond to abort
HRRZ S1,LLSTAT ;Get last status
CAIE S1,.DCX34 ;Was it bad password?
CAIN S1,.DCX36 ;Or bad account?
$FATAL (Remote node refused connection - ,^T/LLDISC/)
$FATAL (Logical link was aborted during initial connection - ,^T/LLDISC/)
SUBTTL LLCHK Routine to check logical link status
;Accepts CP/ Base of per link data
;Returns TRUE S1/ Link status - link is active
; FALSE S1/ Link status - link is aborted
LLCHK: $SAVE <T1>
SETZM INTHAP ;[154]RESET INTERRUPT HAPPENED FLAG
MOVE S1,LLJFN ;Get link JFN
MOVEI S2,.MORLS ;READ LINK STATUS
MOVE T1,LLSTAT ;Return last status on failure
MTOPR
ERJMP [TXO T1,MO%ABT ;Say Abort status
JRST LLCHK1] ;Back in line
MOVEM T1,LLSTAT ;Save latest status
SIBE ;Is there something to read?
SETOM MSGFLG ;Yes..remember that
LLCHK1: MOVE S1,T1 ;Put MTOPR status in S1
TXNE S1,MO%ABT ;Link aborted?
$RETF ;Return false
$RETT ;No..return true
SUBTTL LLCLOS Routine to close or abort a logical link
;Accepts S1/ NSP disconnect code
; S2/ Pointer to optional data to be sent
LLCLOS: SKIPN LLJFN ;Is link open?
$FATAL (Logical link is not open in LLCLOS)
DMOVEM S1,CLSBLK ;Save our reason
SETZB T1,T2 ;Clear pointer and length
JUMPE S2,LLCLS2 ;Optional data?
TLCE S2,-1 ;Yes..make a real pointer
TLCN S2,-1
HRLI S2,(POINT 7) ;Ready to count the bytes
MOVE T1,S2 ;Save pointer for MTOPR
LLCLS1: ILDB S1,S2 ;Get the bytes
JUMPE S1,LLCLS2 ;Do the MTOPR
AOJA T2,LLCLS1 ;Count until null
CAILE T2,^D16 ;Enforce max of 16
MOVEI T2,^D16
LLCLS2: HRLZ S2,CLSBLK ;Put abort code in place
; SKIPN S2 ;[145]
; HRLZI S2,7 ;[145]ALWAYS USE NON ZERO ABORT CODE
HRRI S2,.MOCLZ ;Get the close function
MOVE S1,LLJFN ;Get the JFN
MTOPR
ERJMP LLCLS3 ;Abort if MTOPR fails
TLNN S2,-1 ;[120]Did we abort link?
JRST LLCLS4 ;[120]NO
LLCLS3: MOVE S1,LLJFN ;[120]GET THE JFN
TXO S1,CZ%ABT ;[120]Set bit for close
CLOSF ;[120]
$FATAL (Can't abort close logical link in LLCLOS - ,^E/[-2]/)
SETZB S,LLJFN ;[120]
$RETT ;[120]
LLCLS4: MOVE S1,LLJFN ;Pick up JFN
CLOSF
JRST LLCLS3 ;[120]
SETZB S,LLJFN ;Clear JFN word
$RETT
SUBTTL LLRCD Read Connect-initiate Disconnect initiate data
SUBTTL LLRCD ROUTINE TO READ INFORMATION FROM CI/DI MESSAGES
;Accepts CP/ Base of per link data
;Returns TRUE Data via pointers in LLOPNB
LLRCD: MOVE S1,LLJFN ;GET LINK JFN
MOVSI T4,-CDISIZ ;GET NUMBER OF REQUESTS
LLRCD1: HLRZ S2,CDITBL(T4) ;GET FUNCTION
HRRZ T1,CDITBL(T4) ;GET OFFSET TO ENTRY
ADDI T1,LLOPNB ;GET ACTUAL ADDRESS OF POINTER
SKIPN T1,(T1) ;NULL POINTER?
JRST LLRCD2 ;YES..ON TO NEXT FUNCTION
TLCE T1,-1
TLCN T1,-1 ;REAL BYTE POINTER?
HRLI T1,(POINT 7,0) ;NO..MAKE IT ASCII
MTOPR ;NO..DO IT
ERJMP .+1 ;IGNORE ERRORS
SETZ S2, ;GET A NULL
IDPB S2,T1 ;TERMINATE WITH NULL
LLRCD2: AOBJN T4,LLRCD1 ;BACK TO READ ALL ITEMS
MOVEM T2,.DOUIC+LLOPNB ;SAVE UIC IF ANY
MOVEI S2,.MORSS ;READ SEGMENT SIZE
SETZM T1
MTOPR
ERJMP .+1 ;IGNORE ERRORS
MOVEM T1,.DOSSZ+LLOPNB ;SAVE SEGMENT SIZE
MOVEI S2,.MORCN ;READ CONNECTED OBJECT
SETZ T1,
MTOPR
ERJMP .+1 ;IGNORE ERRORS
STORE T1,.DOFLG+LLOPNB,DO%OBJ ;SAVE ACCESS OBJECT TYPE
$RETT ;ALL DONE, RETURN
CDITBL: .MORHN,,.DONOD ;READ REMOTE HOST NAME
.MORTN,,.DOTSK ;READ TASK NAME
.MORUS,,.DOUSR ;READ USER
.MORPW,,.DOPSW ;READ PASSWORD
.MORAC,,.DOACT ;READ ACCOUNT
.MORDA,,.DOOPD ;READ DATA
;*** .MORDA MUST BE LAST ***
.MOROD,,.DODSC ;READ OBJECT-DESCRIPTOR
CDISIZ==.-CDITBL ;SIZE
SUBTTL STOSTS Routine to store link status
;Accepts S1/ Output designator
; S2/ Link status code
;Returns TRUE Reason code is stored
; FALSE Invalid reason code
STOSTS: HRRZ S2,S2 ;PUT STATUS CODE IN S2
SETZ T1, ;SET FOR SOUT AGAIN
CAILE S2,DSCMAX ;KNOWN REASON?
$RETF ;NO..JUST RETURN
HRRO S2,DSCTBL(S2) ;POINT TO DISCONNECT TEXT
SOUT
$RETT
SUBTTL LLSEND Routine to send messages across Link
;Accepts S2/ Header address of message to be sent
;Returns TRUE Message has been sent
; FALSE Part of the message remains to be sent
LLSEND: $SAVE <P1> ;Save an AC
MOVE P1,S2 ;Remember address of message
$CALL LLSDSP ;Display debugging info
MOVE S1,LLJFN ;Get link JFN
MOVE S2,.DPBPT(P1) ;Get the byte pointer
MOVN T1,.DPCNT(P1) ;Get byte count
MOVE T2,[SOUTR] ;Assume end of message
SKIPLE .DPLEN(P1) ;More to come?
MOVE T2,[SOUT] ;Yes..send partial message
SETOM SNDFLG ;Say we are about to send
AOSE INTFLG ;Any interrupts?
XCT T2 ;No..send the message
ERJMP LLSENE ;Die on failure
CAME T2,[SOUTR] ;[134]
JRST LLSE25 ;[134]
SKIPE INTFLG ;[134]
AOS MESOUT ;[134]
LLSE25: SETZM SNDFLG ;[134]Not sending any more!
JUMPN T1,LLSEN3 ;Were we interrupted?
$RETT ;No..return normally
LLSEN3: MOVEM S2,.DPBPT(P1) ;Save updated pointer
MOVNM T1,.DPCNT(P1) ;Zero if not interrupted
SKIPL .DPTYP(P1) ;Virgin message?
MOVNS .DPTYP(P1) ;No..mark as interrupted
$RETF ;Return to our caller
LLSENE: MOVE S1,LLJFN ;[0113]
MOVEI S2,.MORLS ;[0113]
MTOPR ;[0113]
HRRZ S2,T1 ;[0113]
HRRO T1,DSCTBL(S2) ;[0113]
CAILE S2,DSCMAX ;[113]ABORT REASON OUT OF RANGE?
HRROI T1,[ASCIZ /Abort code out of range/] ;[113]
$FATAL (,<Logical link transmission error - ^E/[-2]/^M^JLogical link abort reason(^D/S2/) - ^Q/T1/>)
LLSDSP: SKIPE MSGDSG ;Want send data displayed?
SKIPG S1,.DPTYP(S2) ;Already displayed?
$RETT
HRRZ S1,MSGTBL-1(S1) ;Make pointer to message name
HRRO S1,0(S1)
$DEBUG (Sending ,<^Q/S1/ message (Flg=^O/.DPFLG(S2)/ Cnt=^O/.DPCNT(S2)/ Rem=^O/.DPLEN(S2)/)>)
$RETT
SUBTTL LLRECV Routine to receive link messages
;Returns TRUE S1/ Address of message header
; FALSE No message is available
LLRECV: MOVE S1,RCVLST ;Point to recieve list
$CALL L%FIRST ;Point to first entry
JUMPF [SETZM MSGFLG ;Assume nothing available
$CALL LLCHK ;See if we are right
TXNE S1,MO%EOM ;Full message available?
JRST [$CALL LLRECM ;[154]YES, GO RECEIVE IT
JRST LLRECV] ;[154]
$RETF] ;No..return with nothing
MOVE T2,S2 ;Save message address
SETOM MSGFLG ;Remember we have a message
$CALL LLCHK ;See if we have a full message
TXNE S1,MO%EOM
JRST [$CALL LLRECM ;[154]YES, GO RECEIVE IT
JRST LLRECV] ;[154]
MOVE S1,T2 ;No..return first entry in list
$RETT
LLRECM: MOVE S1,RCVLST ;Get recieve list index
MOVE S2,OURSIZ ;Get size of a buffer
$CALL NEWBUF ;Allocate new buffer
MOVE T2,S1
MOVE S1,LLJFN
MOVE S2,.DPBPT(T2) ;Get pointer to buffer
MOVN T1,.DPCNT(T2) ;Get max count
SINR ;Read a logical message
ERJMP LLRECE ;Bad news
AOS MESIN ;[134]
ADDB T1,.DPCNT(T2) ;Save actual count
MOVEM T1,.DPLEN(T2) ;Save as length
$CALL LLRDSP ;Display what we have
$RETT ;[154]
LLRECE: $CALL GETTER ;Get my last error
CAIN S2,IOX4 ;End of file?
$FATAL (EOF detected on logical link)
MOVE S1,LLJFN ;[0113]
MOVEI S2,.MORLS ;[0113]
MTOPR ;[0113]
HRRZ S2,T1 ;[0113]
HRRO T1,DSCTBL(T1) ;[0113]
CAILE S2,DSCMAX ;[113]
HRROI T1,[ASCIZ /Abort code out of range/] ;[113]
$FATAL (,<Logical link reception error - ^E/[-2]/^M^JLogical link abort reason(^D/S2/) - ^Q/T1/>)
LLRECA: MOVE S1,RCVLST ;[154]
$CALL L%FIRST ;[154]
JUMPF [$CALL LLRECM ;[154]
JRST LLRECA] ;[154]
SETOM MSGFLG ;[154]
MOVE S1,S2 ;[154]
$RETT ;[154]
LLRDSP: SKIPN MSGDSG ;Want send data displayed?
$RETT
MOVE S2,.DPBPT(T2) ;Get the pointer
ILDB S1,S2 ;Get the type field
ILDB S2,S2 ;Get the flags
HRRZ S1,MSGTBL-1(S1) ;Make pointer to message name
HRRO S1,0(S1)
$DEBUG (Received ,<^Q/S1/ message segment (Flg=^O/S2/ Cnt=^O/T1/)>)
$RETT
SUBTTL NEWBUF Routine to allocate a new buffer
;Accepts S1/ Send or recieve list index
; S2/ Required byte count of buffer
;Returns TRUE S1/ Address of new message buffer header
NEWBUF: DMOVE T1,S1 ;Save list index and count
$CALL L%LAST ;Position to end of list
DMOVE S1,T1 ;Restore list index and count
TRZE S2,3 ;Spare word needed?
ADDI S2,4 ;Yes..account for it
LSH S2,-2 ;Compute word count
ADDI S2,.DPSIZ ;Add header size
$CALL L%CENT ;Create an entry
MOVE S1,S2 ;Return address in S1
MOVEI S2,.DPSIZ(S1) ;Point to message area
HRLI S2,(POINT 8)
MOVEM S2,.DPBPT(S1) ;Save in header
MOVEM T2,.DPCNT(S1) ;Save counts
MOVEM T2,.DPLEN(S1) ;Save length
$RETT
SUBTTL Connect event interrupt service
;HERE ON CI RECEIVED
CICON: $DEBUG (Connect interrupt received) ;[140]
MOVE S1,LLSTAT ;[140]GET LINK STATUS
TXNN S1,MO%SRV ;AM I A SERVER?
$RETT ;NO - DONE
$CALL LLCHK ;Get the link status
$CALL LLRCD ;READ CONNECT DATA
FTACL < SKIPE S1,.DOACT+LLOPNB ;[167] Was account string ptr there ?
JRST [ILDB S1,S1 ;[167] Yes,,get first byte
JUMPN S1,.+1 ;[167] Remote user specified,,continue
SETOM NOACCT ;[167] Not there,,set flag
JRST .+1 ] > ;[167] Continue
MOVE T1,.DOCID+LLOPNB ;Get address of check routine
$CALL 0(T1) ;Access check the user
FTACL < JUMPT CICO.1 ;[167] Succeed,,continue onward
SKIPN ACLPID ;[167] Is the access control task there
JRST LLCLOS ;[167] No,,abort the link
PUSH P,S1 ;[167] Save S1 (NSP error code)
PUSH P,S2 ;[167] and S2 (Ptr to reason string)
SETZM S1 ;[167] Yes,,ask ACL for permission
PUSHJ P,REQACL ;[167] to let this guy complete the link
POP P,S2 ;[167] Restore S2
POP P,S1 > ;[167] Restore S1
JUMPF LLCLOS ;This guy just can't win !!!
FTACL < SETOB S1,S2 > ;[167] Indicate ACL said OK
CICO.1: MOVEM S1,USRNUM ;Save user number
MOVEM S2,DIRNUM ;Save directory number
MOVE S1,LLJFN ;GET JFN FOR LL
MOVEI S2,.MOCC ;ACCEPT THE CONNECTION
SETZM T2 ;NO RETURN DATA
MTOPR
ERJMP .+1
$CALL LLCHK ;Get new link Status
$RET ;Return True/false per LLCHK
;Here to respond to DI and store reason for disconnect
DIABT: SKIPN S1,LLJFN ;Have a JFN?
JRST DIAB1 ;No..just store status
MOVX S2,.MORDA ;Yes..read optional data
HRROI T1,LLDISC ;Save disconnect cause
MTOPR
ERJMP DIAB1 ;Oops..just store staus
JUMPE T2,DIAB1 ;No data..just store status
SETZ S2, ;Get a null
IDPB S2,T1 ;Terminate with a null
CAIL T2,7 ;At least 7 characters?
JRST DIAB2 ;yes..Ignore status
DIAB1: HRROI S1,LLDISC ;Point to disconnect cause
MOVE S2,LLSTAT ;Get last known status
$CALL STOSTS ;Store the status String
DIAB2: MOVEI S1,.DCX42 ;Response to DI request
SETZ S2, ;No optional data
PJRST LLCLOS ;Close the link
SUBTTL Interrupt message processing
PSIIM: $WARN (Unexpected interrupt message received) ;[140]
MOVE S1,LLJFN ;Get links jfn
MOVEI S2,.MORIM ;Read the message
MOVEI T1,.NULIO ;Can it for now
MTOPR
ERJMP .RETF
$RETT
SUBTTL Table of NSP disconnect reasons
DEFINE DISCR <
ER (0,No error)
ER (1,Resource allocation failure)
ER (2,Target node does not exist)
ER (3,Node shutting down)
ER (4,Target task does not exist)
ER (5,Invalid name field)
ER (6,Target task queue overflow)
ER (7,Unspecified error condition)
ER (8,Third party aborted the logical link)
ER (9,<User abort (asynchronous disconnect)>)
ER (24,Flow control failure)
ER (32,Too many connections to node)
ER (33,Too many connections to target task)
ER (34,Access not permitted)
ER (35,Logical link Services mismatch)
ER (36,Invalid account)
ER (37,Segment size too small)
ER (38,<User aborted, timed out, or canceled link>)
ER (39,No path to target node)
ER (40,Flow control violation)
ER (41,No current link to target node)
ER (42,Confirmation of Disconnect Initiate)
ER (43,Image data field too long)
> ;END DISCR DEFINITION
DEFINE ER (VALUE,TXT) <
.DCX'VALUE==^D'VALUE
IFDEF %%CUR,<%%DIF==^D'VALUE-%%CUR-1>
IFNDEF %%CUR,<
%%CUR==0
%%DIF==^D'VALUE>
IFG %%DIF,<REPEAT %%DIF,<[ASCIZ\Unknown\]>>
[ASCIZ\TXT\]
%%CUR==^D'VALUE
> ;END OF ER DEFINITION
DSCTBL: DISCR ;GENERATE TABLE OF REASONS
DSCMAX==.-DSCTBL-1
PURGE %%CUR,%%DIF
SUBTTL PURE TABLES
DEFINE ER (NAME,VALUE,TEXT) <
ER$'NAME==VALUE
> ;End of ER definition
MACCOD ;Equate the error codes
MACTBL: [ITEXT <Operation in progress >]
[ITEXT <Operation successful >]
[ITEXT <Unsupported ^Q/P1/ message >]
[ITEXT <Reserved status message ^O/P2/ >]
[ITEXT <File open error >]
[ITEXT <Data transfer error >]
[ITEXT <Data transfer warning >]
[ITEXT <Access termination error >]
[ITEXT <^Q/P1/ message format error >]
[ITEXT <Invalid ^Q/P1/ message >]
[ITEXT <^Q/P1/ message received out of sequence >]
;Define macro to generate MICCODE error table
DEFINE ER (NAM,VALUE,TEXT) <
[ASCIZ\TEXT\],,VALUE
ER$'NAM==VALUE
> ;End of ER definition
MICTBL: MICCOD ;GENERATE MICCODE ERROR TEXT TABLE
MIC$LN==.-MICTBL ;Remember number of entries in table
SUBTTL TOPS 20 TO DAP ERROR CONVERSION TABLE
S20DAP: ;TABLE MUST BE SEARCHED - IN ASCENDING SEQ BY 20
XWD CACTX1,ER$PRV
XWD GJFX3,ER$CJF
XWD GJFX4,ER$FNM
XWD GJFX5,ER$FNM
XWD GJFX6,ER$DEV
XWD GJFX7,ER$DIR
XWD GJFX9,ER$FNM
XWD GJFX10,ER$FID
XWD GJFX11,ER$FID
XWD GJFX12,ER$FID
XWD GJFX13,ER$FID
XWD GJFX14,ER$FID
XWD GJFX16,ER$DEV
XWD GJFX17,ER$DNF
XWD GJFX18,ER$FNF
XWD GJFX19,ER$FNF
XWD GJFX20,ER$FNF
XWD GJFX21,ER$FNF
XWD GJFX22,ER$DME
XWD GJFX23,ER$FUL
XWD GJFX24,ER$FNF
XWD GJFX27,ER$FEX
XWD GJFX28,ER$DNR
XWD GJFX29,ER$DNR
XWD GJFX32,ER$FNF
XWD GJFX33,ER$FNM
XWD GJFX34,ER$FID
XWD GJFX35,ER$PRV
XWD OPNX1,ER$SYS
XWD OPNX2,ER$FNF
XWD OPNX3,ER$PRV
XWD OPNX4,ER$PRV
XWD OPNX5,ER$PRV
XWD OPNX6,ER$PRV
XWD OPNX7,ER$DNR
XWD OPNX8,ER$DNR
XWD OPNX9,ER$ACT
XWD OPNX10,ER$FUL
XWD OPNX12,ER$PRV
XWD OPNX13,ER$IOP
XWD OPNX14,ER$IOP
XWD OPNX15,ER$PRV
XWD OPNX16,ER$PLG
XWD OPNX17,ER$DME
XWD OPNX18,ER$DEV
XWD DESX1,ER$SYS
XWD DESX2,ER$DEV
XWD DESX3,ER$CJF
XWD DESX4,ER$SYS
XWD DESX5,ER$COF
XWD DESX6,ER$FNF
XWD CLSX1,ER$SYS
XWD CLSX2,ER$SYS
XWD DELFX1,ER$PRV
XWD SFBSX2,ER$BSZ
XWD IOX4,ER$EOF
XWD IOX5,ER$RER
XWD IOX6,ER$WER
XWD STADX1,ER$PRV
XWD STADX2,ER$PRM
XWD DEVX3,ER$DNR
XWD RNAMX1,ER$DEV
XWD RNAMX3,ER$PRV
XWD RNAMX4,ER$DME
XWD RNAMX8,ER$PRV
XWD RNMX12,ER$FID
XWD PMAPX6,ER$FUL
XWD OPNX23,ER$FUL
XWD GJFX38,ER$FNF
XWD IOX7,ER$DME
XWD IOX9,ER$IOP
XWD OPNX25,ER$WLK
XWD GJFX41,ER$FNM
XWD GJFX42,ER$FID
XWD DELFX2,ER$FEX ;
XWD DELFX3,ER$DME
XWD MTOX17,ER$DNR
XWD DESX9,ER$IOP
XWD IOX11,ER$FUL
XWD OPNX31,ER$FNF ;File is offline
S20DLN=.-S20DAP ;[107]
LSTOF. ;Do literal expansion
LIT
LSTON.
END