Trailing-Edge
-
PDP-10 Archives
-
BB-L014Y-BM_1990
-
galsrc/mountr.mac
There are 35 other files named mountr.mac in the archive. Click here to see a list.
TITLE MOUNTR
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
; Required UNV and REL files
SEARCH MTRMAC
SEARCH MONSYM,MACSYM,ACTSYM,SERCOD,GLXMAC,QSRMAC,ORNMAC,NEBMAC
.REQUIRE SYS:MACREL
SUBTTL Version Information
; Version Information
MTRVER==6 ;MAJOR VERSION #
MTRMIN==0 ;MINOR VERSION #
MTRMAN==6040 ;Maintenance edit level
MTRDEV==6032 ;Development edit level
MTRWHO==0 ;GROUP WHO LAST EDITED (0=DEC DEVELOPMENT)
VERSIN (MTR) ;Generate version number
EXTERNAL CFSMAN,CFSDEV,CFSEDT,USRMAN,USRDEV,USREDT
; Externals used from MTRDDB
EXTERNAL DSFINI ;Initialize disk data base
EXTERNAL DSFUDE ;Update disk entry
EXTERNAL DSFGET ;Get disk entry
EXTERNAL DSFGNX ;Get next entry of specific type
EXTERNAL DSFCRE ;Create disk entry
EXTERNAL DSFLOC ;Locate disk entry
EXTERNAL DSFNUP,DSFYUP ;Routines to stop/start updating of DDB
EXTERNAL DSFDLE ;Delete disk entry
EXTERNAL DSFE
EXTERNAL PRTINI,CFSCHK
MTRVER==<VRSN.(MTR)>+CFSEDT+USREDT+MACEDT
MTRVEC: BLDVEC (MOUNTR,MTR,L)
BLDVEC (MTRCFS,CFS)
BLDVEC (MTRUSR,USR)
BLDVEC (MTRMAC,MAC,L)
BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (QSRMAC,QMC,L)
EXTERN .JBOPS ;JOBDAT CELL COMMANDEERED FOR TEST FLAG
EXTERN .JBSA ;LH/ ADDR OF 1ST LOCATION AFTER PROGRAM
EXTERN .JBSYM ;POINTER TO SYMBOL TABLE FOR DDT
EXTERN .RLEND ;LAST LOCATION IN MACREL
SALL
.DIRECTIVE FLBLST ;SUPPRESS ASCIZ MACHINE CODE EXPANSION
SUBTTL Table of Contents
; Table of Contents for MOUNTR
;
;
; Section Page
; 1. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Version Information. . . . . . . . . . . . . . . . . . 2
; 3. Table of Contents. . . . . . . . . . . . . . . . . . . 3
; 4. Edit history . . . . . . . . . . . . . . . . . . . . . 4
; 5. PREFACE. . . . . . . . . . . . . . . . . . . . . . . . 5
; 6. MODIFYABLE DATA AREA . . . . . . . . . . . . . . . . . 9
; 7. STORAGE AREA FOR USAGE DATA. . . . . . . . . . . . . . 10
; 8. STATIC DATA AREA . . . . . . . . . . . . . . . . . . . 11
; 9. INITIALIZATION . . . . . . . . . . . . . . . . . . . . 17
; 10. SERVICE SCHEDULER (SS) . . . . . . . . . . . . . . . . 18
; 11. ACCOUNTING ROUTINES. . . . . . . . . . . . . . . . . . 21
; 12. AVR - AUTOMATIC VOLUME RECOGNITION . . . . . . . . . . 27
; 13. DECTAPE SUPPORT. . . . . . . . . . . . . . . . . . . . 36
; 14. IPCF SEND AND RECEIVE. . . . . . . . . . . . . . . . . 39
; 15. LABELED TAPE INITIALIZATION. . . . . . . . . . . . . . 47
; 16. OPERATOR INTERFACE . . . . . . . . . . . . . . . . . . 52
; 17. QUASAR INTERFACE . . . . . . . . . . . . . . . . . . . 85
; 18. STRUCTURE ROUTINES . . . . . . . . . . . . . . . . . . 95
; 19. Update all disks
; 19.1. Flow of update. . . . . . . . . . . . . . . . 96
; 19.2. DDSCIH - Update all disk drives . . . . . . . 97
; 19.3. DSTINI - Initialize MSTR block for scanning units 98
; 19.4. DSTNXT - Get status of the next disk. . . . . 98
; 19.5. DSTSRC - LOOK FOR THE DISK ENTRY MATCHING SPECIFIED CKU NUMBERS 99
; 19.6. DDSNEW - Add new disk to data bases . . . . . 100
; 19.7. DDSCHK - Check disk already existing. . . . . 101
; 19.8. DDSDEL - DELETE STRUCTURE INFORMATION ABOUT A DISK 102
; 19.9. DDSADD - ADD A DISK COMING ON-LINE. . . . . . 103
; 19.10. STRINF - Store/check structure information. . 104
; 19.11. STRGSB - GET STRUCTURE STATUS BLOCK (BUILD ONE IF NECESSARY) 107
; 19.12. STRDSM - Dismount structure data base . . . . 108
; 19.13. DDSMCH - MATCH USER REQUEST TO MOUNTS AND DISMOUNTS 109
; 19.14. DSTDDB - Delete STructure DDB . . . . . . . . 110
; 20. Disk Routines
; 20.1. DSKINI - Disk initialization routine. . . . . 111
; 20.2. DSTGIV - Get status for a given unit. . . . . 112
; 21. KSDK - Set disk-drive command from OPR . . . . . . . . 113
; 22. KDSM - PROCESS DISMOUNT STRUCTURE COMMAND FROM OPR . . 114
; 23. KSHD - SHOW DISK STATUS COMMAND FROM OPR . . . . . . . 115
; 24. - DSKDSP - Print any special messages. . . . . . . . . 116
; 25. KSHS - SHOW STATUS STRUCTURE command from OPR. . . . . 117
; 26. STRDSP - Print any special messages. . . . . . . . . . 118
; 27. SHSTR - Show status for a particular structure . . . . 119
; 28. SHSMAC - Adds a user who has mounted or connected or accessing a structure to the SHO STA STR FOO: command. 120
; 29. SHWSTR - Show status for a single structure. . . . . . 121
; 30. - SHWCON
; 30.1. Indicates structure status conflicts. . . . . 122
; 31. Process set structure (KSST)
; 31.1. Initialize processing of command. . . . . . . 123
; 31.2. Set the database (DDB). . . . . . . . . . . . 124
; 31.3. Set structure correctly in monitor. . . . . . 125
; 32. KSST
; 32.1. Data base for setable characteristics . . . . 126
; 33. STSTR - SeT STRucture. . . . . . . . . . . . . . . . . 127
; 34. KSUD - Undefine structure. . . . . . . . . . . . . . . 128
; 35. UPDSTR - Update structure. . . . . . . . . . . . . . . 129
; 36. Determine-new-string routine (NEWSTA)
; 36.1. Determine STRFLG based on MOUNTR and disk status 131
; 37. CHKAVA - Check SSB disk drives for available/unavailable 132
; 38. SSB routines
; 38.1. SSBINI - Initialize SSB data base . . . . . . 133
; 38.2. SSBCRE - Create a new SSB entry (zeroed). . . 133
; 38.3. SSBRET - Return SSB entry to free SSB pool. . 133
; 38.4. SSBNXT - Get next SSB . . . . . . . . . . . . 134
; 38.5. MATCHS - Match request to structure (old) . . 135
; 39. ISTDDB - Initialize structure DDB. . . . . . . . . . . 137
; 40. MESCHK - CHECK IF MESSAGE FOR STRUCTURE ALREADY SENT TO OPERATOR 138
; 41. MNTALL - MOUNT ALL STRUCTURES NOT ALREADY MOUNTED. . . 139
; 42. OPRSB - SET UP REQUEST BLOCK FOR OPR MOUNT OR DISMOUNT COMMAND 140
; 43. PSDR - PARSE OPERATOR RESPONSE TO DISMOUNT MESSAGE WHEN OTHER JOBS 141
; 44. SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT . . . 142
; 45. SIXSEV - ROUTINE TO CONVERT SIXBIT TO ASCIZ. . . . . . 142
; 46. STRDMT - DISMOUNT A STRUCTURE (OPR>DISMOUNT STRUCTURE FOO:) 143
; 47. STRUNA - SET STR UNAVAILABLE . . . . . . . . . . . . . 145
; 48. Operator Communication . . . . . . . . . . . . . . . . 146
; 49. STRMNT - MOUNT A STRUCTURE . . . . . . . . . . . . . . 147
; 50. WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE 154
; 51. - WOINI
; 51.1. Fills in the first five fields of the display 155
; 52. WOMDAV - TELL OPERATOR OF AVAILABILITY OF DISK DRIVE FOR SYSTEM USE 157
; 53. WOSM - TELL OPERATOR OF A STRUCTURE. . . . . . . . . . 158
; 54. USER TAPE MOUNT REQUEST. . . . . . . . . . . . . . . . 162
; 55. VOLUME/REQUEST ASSOCIATION LOGIC . . . . . . . . . . . 174
; 56. SUBROUTINES. . . . . . . . . . . . . . . . . . . . . . 185
; 57. STRSTT
; 57.1. Returns the structure status. . . . . . . . . 222
SUBTTL Edit history
Comment ^
***** Release 4.2 -- Begin Maintenance Edits *****
154 4.2.1537 12-jan-83
Add procedure procedure WTOCHK and calls to WTOCHK so that batch
jobs with /assistance:no will have any mount request requiring asistance
disallowed.
155 4.2.1538 12-jan-83
Increase number of requests allowed to 400
156 4.2.1539 13-jan-83
If the first mount request is canceled and the structure has not
been mounted, make sure OPR gets mount request message on awaiting request.
157 4.2.1540 27-Jan-83
Set or clear the correct bit in STRFLG(STR) when a change of structure
status occurs. Also if operator refuse to dismount a structure, restore the
structure status if there was no change.
160 4.2.1544 17-mar-83
Add check for bad HOME or BAT blocks and inform operator. Also check
for disk in use by on-line diagnostic program before mount.
161 4.2.1549 14-Jun-83
Change 1 line of edit 157 so that AC F will not get clobber if the
structure is to be set unavailable.
162 4.2.1569 15-Mar-84
Set the controller type field to zero in the usage records. Also set
the access type field to 1.
163 4.2.1575 3-May-84
Do not crash if SYSTEM:INFO is not running when sending an IPCF message
message .Instead, inform the operator, sleep for 30 seconds and then attempt to
send another message.
164 4.2.1577 10-May-84
When multiple tapes with numeric IDs are being initialized, cause
MOUNTR to increment the next ID without asking the operator.
165 4.2.1583 25-Jul-84
Do not abort tape mount requests if all the tape drives have been set
unavailable, instead queue the request and inform the operator that all the
tape drives are unavailable.
166 4.2.1588 21-Aug-84
Create left justified tape numeric volume i.d.s with the OPR SET TAPE
INITIALIZE command.
167 4.2.1595 26-Sep-84
Correct the way edit 163 searches and branches from table MTBL upon
an IPCF failure.
170 4.2.1600 10-Jan-85
If a tape is initialized with leading zeros in its volume i.d.,
do not suppress them.
171 4.2.1606 29-Jan-85
Do not reset the density of a tape drive when dismounting a tape.
172 4.2.1615 26-Apr-85
Do not crash immediately upon a MUTIL% JSYS error when attempting to
get a system PID, instead try up to NTRY times before crashing.
***** Release 5.0 -- Begin Development Edits *****
200 5.1000 3-jan-83
Move to new development area. Change to new edit history format.
Change edit level designations to conform to new Galaxy standard.
201 5.1001 4-jan-83
Support system/job default for tape drives instead of hardcoding a
default of 1600
202 5.1005 10-jan-83
Add version vector.
203 5.1015 4-MAR-83
Move macro and data definitions to MTRMAC. Add MTRCFS and MTRUSR to
version vector.
204 5.1018 16-mar-83
Move command table back to MOUNTR. Add disk types for Ra80, Ra81, Ra60
205 5.1020 29-mar-83
Due to increasing numbers of disks and tapes which are available to
TOPS-20, IPCF messages must be divided into packets with no more than wtomax
(defined on ornmac) words of text.
206 5.1020 4-apr-83
Need to count bytes of header as well as body of text when dividing
ipcf messages into packets.
207 5.1022 7-apr-83
Add check for CI port when outputting disk status display. Abbreviate
oprtions in disk status display.
210 5.1029 24-may-83
Add support for SET PORT command. Enlarge filed for unit display to 4.
Make several routine labels global.
211 5.1030 22-june-83
Modify structure dismount procedures for port operations.
212 5.1031 29-june-83
Add calls to CFS dismount routines.
213 5.1032 30-june-83
Add code to add or delete or replace a structure entry from the
device-status data base. MOUNTR will mount a structure based on status
obtained from the device-status data base.
214 5.1033 6-july-83
Add a call to routine CFSCHK in MTRCFS to see if we are in a CFS
system. The return value for CFSP is 0 for not CFS and 1 for CFS.
215 5.1040 30-Sep-83
Redesign and rewrite the dismount code so that a dismount operation
and a dismount via a port operation can both use the common code and have each
operation handle the possible results from the dismount accordingly.
216 5,1044 14-Oct-83
Add code to enforce the FORCE response from a port operation. Make
WOMDAV an external symbol. Make sure we do not touch AC0 accidentally.
217 5.1052 31-Oct-83
Add code to handle setting a structure exclusive.
220 5.1055 8-Nov-83
Add code to support REMOVE/NOREMOVE function in DISMOUNT command
221 5.1056 14-Nov-83
Fix code to handle setting a structure EXCLUSIVE while dismounting a
structure with REMOVAL in a CFS configuration and fix other bugs relating to
DISMOUNTING a structure in a CFS configuration (REMOVAL/NOREMOVAL and default)
222 5.1054 15-Nov-83
First change the above GCO# from 5.1054 to 5.1056. Add code to set a
structure exclusive.
223 5.1060 28-Nov-83
Do not use SETFLG to check whether a port operation is FORCE. Check
RSBIFL(RSB) bit R%REP. If R%REP is set, a FORCE action is to be taken.
224 5.1062 29-Nov-83
During start up, call a new routine, PRTINI, to check for port
unavailability.
225 5.1065 9-Dec-83
Fix bad test for exclusive in KSSER2.
226 5.1068 9-Dec-83
Remove DSFxxx routines and move them to MTRDDB. Since we
did that, a bad STOR instruction broke in PRTINI. Fix that as well.
227 5.1079 4-Feb-84
Lots of changes:
1. Change all references to DDB routines to use new DDB routines.
2. Add table of contents.
3. Redo SHOW STATUS DISK DISPLAY
4. Add SHOW STATUS STRUCTURE display.
5. Add SHOW STATUS STRUCTURE FOO: display.
6. Rearrange a number of the disk status update routines so they are together.
7. Disable write protecting code because that gets in the way a lot. We
need to have storage in other modules and that is impossible with the
current write protection scheme.
8. Instead of using MSTRBK everywhere and having things get confused, make
some additional locations to have MSTR argument blocks depending on the
action occuring.
9. For consistancy, make any bit referencing available 0 if available and 1 if
unavailable.
10. In the DDSxxx routines, rearrange the logic to take advantage of the new
DDB support. In addition, make MOUNTR able to detect changes instead of
simply accepting them, and correct some of them. In all cases, inform
the operator that the changes are occuring.
11. Change the management of the SSBs and create some routines to manage them:
SSBINI - Initialize the SSB data base
SSBCRE - Create a new SSB entry
SSBRET - Return SSB entry to the free pool.
SSBNXT - Get the next SSB entry.
12. Eliminate the old logic for ignore attribute. The attribute is now
included with the DDB entry for the structure.
13. Only mount all available structures during initialization if this is in
CFS.
14. Rearrange the whole way we manage the unavailable attribute. Besides a
device being unavailable due to its attribute set, it may also be
unavailable due to another object that may affect it.
15. Support for new $STOP macro.
Lots of little things as well. The above is the gist of things.
230 5.1081 6-Feb-84
Add support for undefine structure command.
231 5.1082 6-Feb-84
Use structure header instead of disk header for SHOW STATUS STRUCTURE.
232 5.1084 10-Feb-84
Reformat the SHOW STA STR FOO: display. Only print one user for each
usage of the structure. Include the disk information. The CKU is to be printed
in decimal. Include an asterisk for dual ported disks.
233 5.1085 10-Feb-84
Make sure the disk type field starts printing in colume 2.
234 5.1086 11-Feb-84
If we are switching disk ports, always defer adding the new port info
until after deleting old port info. Indicate need for second disk status pass
with flag AGAIN. Set DSKSSA to minus one to indicate such an event is in
progress for the disk and to prevent looping.
235 5.1087 11-Feb-84
Unfortunatly, ABTRET takes up more than one word. Skipping around
it doesn't make it. JRST to it as a literal @MNTNXT+1.
236 5.1088 11-Feb-84
Remove the code used to support MOUNTR.CMD.
237 5.1090 11-Feb-84
Clear the pointer to the structure status block when forgetting the
structure in DDSDEL.
240 5.1091 11-Feb-84
Add an extra CRLF to error message at DDSERR.
241 5.1096 14-Feb-84
Add a check for offline, free and mounted before we print the state
of a disk. Initialize TMCMSG before we print the "No disk available" message.
242 5.1097 14-Feb-84
Write two subroutines (STRDSP, DSKDSP) to print special messages.
243 5.1100 17-Feb-84
In routine WOMNT3 call DSFLOC to get the structure entry from the DDB.
244 5.1103 20-Feb-84
In routine STRFND if we find the DSB pointer in the SSB already set,
then check if it is set to the current DSK before assuming a problem.
245 5.1104 20-Feb-84
Clear STRPNT in DSTDDB. Remove routine STRDME. Call DSTDDB from
STRDMS.
246 5.1107 23-Feb-84
In routine SHW1, get the conflicting bits in T1 before checking for
status of structure.
247 5.1108 25-Feb-84
Remove special casing in the dismount code. Create and use ascii
string DSMHDR for dismount query. Move test for Ignore until after the
status has been updated. Remove confused code from WOVDS.
250 5.1109 27-Feb-84
Add more bad bits to check for at STRIN2. Add information to the
display to say which bad bits are set. Move STRIN7 label down some lines to
skip over code to set up DDB info for the structure.
251 5.1110 28-Feb-84
Add message to show status structure indicating structure
is exclusive due to port operation. Do the STR%EP check earlier
so a public structure's exclusive bit gets set correctly. Make MOVE
a MOVEI T1,.DVSTR.
252 5.1112 1-Mar-84
Add routine KSMT to handle MOUNT STRUCTURE command from OPR. Delete
all tabs at the beginning of the second line in the edit history. Show only
one dismount message when dismounting a structure via port operation. When
displaying structure status and structure is not mounted, it is still
possible get a SSB on a structure if that structure is being dismounted.
253 5.1113 5-Mar-84
Fix KSMT so that the MOUNT command will mount structures that are not
physically mounted first and clear STR%DT correctly. Clean up NEWSTA and
reject the mount request based on the requestor in routine STRMNT.
254 5.1115 12-Mar-84
Change references from CFSP to either CFSB or to a call to CHKCFS.
255 5.1117 15-Mar-84
Check for end of TMCMSG buffer and break up IPCF packets if necessary
at carriage returns and/or line feeds
256 5.1120 22-Mar-84
Add code to support the MOUNT command from OPR so that the correct
action and messages get to be printed. Change NEWSTA back to before edit 253.
257 5.1121 26-Mar-84
Remove path no longer exists message from SHOW STATUS DISK. Spell
DISMOUNT correctly. * indicates external path to drive, not simply dual
ported.
260 5.1122 28-Mar-84
Reject dismount request if structure is set IGNORED. Tell operator
that a structure is set IGNORED and the attributes for that structure are not
set as that of the DDB.
261 5.1123 30-Mar-84
Filter the "don't care bits" (MS%NTC) as well as the MS%EXC in routine
STSTR.
262 5.1125 2-Apr-84
Add processing of controller number to disk available/un command
processing.
263 5.1127 2-Apr-84
Change dismount message in routine WOVDS to be more clear.
264 5.1128 4-Apr-84
In routine %K: print the CKU in decimal. In routine SHWSTR add the open
file count to the structure display.
265 5.1129 4-Apr-84
In routine KVIRSB:+11 change the MOVEI to MOVE.
266 5.1130 5-Apr-84
Change the dismount no-removal message so that it is in relationship
to the command. In routine BT3:+2, change the SKIPE to SKIPLE so that it will
suppress warning messages as well as checking for text to be outputed.
267 5.1131 5-Apr-84
Fix the dismount messages to correspond to the dismount request.
270 5.1135 11-Apr-84
Add code in DDSCHK to check for MONITOR bug, i.e if a disk is online
there must be a structure on that disk. Also in routine DDSDEL, delete the SSB
if and only if DSKSSA is greater than zero.
271 5.1139 25-Apr-84
Cannot set primary public structure exclusive/shared. In routine
STSTR, only set the exclusive/shared attribute of the primary public structure.
272 5.1140 26-Apr-84
Change the CALL WOMNT to CALL WOFRE in routine WOVDS to print the
status of a disk as part of the dismount acknowledgement message to the
operator.
273 5.1141 30-Apr-84
In routine SCREQ2, restore MSTAL with correct structure alias.
274 5.1142 16-May-84
Change KVIRS to KVIR2.
Add code to handle the "in the process of being dismounted/removed" state of a
structure.
275 5.1143 25-May-84
Do not the the tape status header if no tape drives are on the system.
276 5.1145 30-May-84
Fix KSDKER to tell the operator why it cannot set a disk drive
unavailable if the primary public structure is mounted on that drive.
277 5.1147 7-Jun-84
In CHKAVA loop through all the STRADD based on number of units in that
structure.
300 5.1151 11-July-84
Replace the constant 777777 by the assembly runtime parameter DEFPRO
when supplying the default protection for a tape being initialized.
301 5.1153 27-July-84
Make NEWSTA and STSTR internal labels for MTRCFS.
302 5.1154 27-July-84
In routine DISFAL, check for error code MSTX21 and reject dismount
request if so.
303 5.1156 31-Aug-84
In routine STRINF, add code to detect errors on the disk when it comes
online. Change routine STRIN2 to CHKDSK and have CHKDSK return +1 errors
found, +2 no errors found. In DDSCHK call CHKDSK to see if the MONITOR is
returning bad data due to disk errors or due to bug.
304 5.1159 14-Sept-84
Delete all WTORs in regards to dismount queries for a dismounted
structure. Also, restore the alias in MSTAL in routine STRREF.
305 5.1161 20-Sept-84
Set STR%UD in routine STRSET rather in routine STREXC.
306 5.1163 21-Sept-84
Include account string in display.
307 5.1164 1-Oct-84
Create a new routine, DISREF, to handle the operator refusal to
dismount.
310 5.1165 3-Oct-84
Add code to display device type to SHOW STATUS TAPE/CHAR.
311 5.1178 8-Nov-84
Add message to disk and structure displays explain "Free" is relative
to this system and check other systems before attempting any removal.
312 5.1181 28-Nov-84
Check for structure unique code, if given, in MATCHS. In mount
routines check the return from MATCHS to determine ambiguous mount request or
legitimate mount request. Set RSBSTE to RST.WD to indicate RSB is waiting for
dismount instead of using RST.WM (waiting for mount).
313 5.1185 5-Dec-84
Edit 311 prints the "Free" message eveytime a disk display is done.
This message is meaningless if there are no free drives. Only print the "Free"
if there is a disk online.
314 5.1190 8-Jan-85
In routine STSTR+5 change ERJMP to JRST.
315 5.1192 9-Jan-85
Comment out the code pertaining to write protecting MOUNTR
316 5.1193 10-Jan-85
No structure name in SHOW STA STR FOO: display if FOO: has not
previously mounted and disk drive is set unavailable.
317 5.1201 4-Feb-85
Add code to skip MSTR if we are in debug mode.
320 5.1203 21-Feb-85
Add a SHOW CONFIGURATION (of) DISK-DRIVE command.
321 5.1203 21-Feb-85
More on SHOW CONFIG . . .
322 5.1205 18-Mar-85
Give the correct error message when attempting to dismount the primary
public structure.
323 5.1211 26-Mar-85
Check for RST.WD in DDSMCH.
324 5.1212 4-Apr-85 QAR 706407
If bit MS%OFL is on also check MS%IAC. If both bits are on then the
disk drive is not truely offline but rather force offline due to HOM checking
on behalf of a cluster change.
325 5.1213 30-Apr-85 QAR 838245, 838231
Add check for structure unique code change for an online structure in
routine DDSCHK.
326 5.1222 21-Jun-85 QAR 838449
In routine WONMT3: get the alias from the DSB.
***** Release 5.0 -- begin maintenance edits *****
330 Increment maintenance edit level for version 5 of GALAXY.
331 5.1228 Nov-15-85
In routine STMERR check for only one recoverable error from failure
to mount structure.
332 5.1230 Jan-10-85
In routine MTRLS, notify the operator that a mount request for a
volume of a multi-volume set is canceled due to a dismount.
333 4.2.1623 Feb-3-86
In routine UNLOAD, REWIND the tape before UNLOAD.
334 5.1239 May-28-86
In routime IOXCTR, increase the time out timer from 1 minute to 3
minutes.
335 5.1245 Dec-5-86
Remember how many dismounts are currently being performed on a
structure so that if a cancel for a dismount request is given and if there are
no more dismounts for that structure pending, MOUNTR can reset
the structure status back to its previous state prior to the dismount.
This edit must be accompanied by MTRMAC edit 41. MOUNTR must be rebuild.
336 5.1247 Oct-13-87
In routine STRFND: when MOUNTR detects a -1 for the address of a SSB in
the DSB, go to STRFN3 to find out why. There are three cases that this might
happen: if two identical structures are put online, if a disk drive switches
paths while the MONITOR is doing HOM block checking on that drive, and if two
structures with identical bad HOM blocks are put online. The first case MOUNTR
will create two structure status blocks for each structure. The second case,
MOUNTR will delete the path (DSB) that is doing the HOM block checking. The
third case will be treated like the first but the DSB will state that the disk
has bad HOM blocks. Since the MONITOR will no longer returns two accessible
paths to a disk drive, MOUNTR will no longer crash.
***** Release 6.0 -- begin development edits *****
6000 6.1037 26-Oct-87
Move sources from G5: to G6:
6001 6.1057 4-Nov-87
Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.
Include BS: and PS: information in disk and structure displays.
6002 6.1081 17-Nov-87
Add support to SET STRUCTUREs DUMPABLE/NONDUMPABLE.
6003 6.1081 18-Nov-87
Missing the "/" in CHRTBL.
6004 6.1081 19-Nov-87
In routine SHW4:, show whether the structure is dumpable.
6005 6.1081 20-NOV-87
In routine SHW.4:, use the alias name from DSFE because the structure
might not be online.
6006 6.1112 2-Dec-87
In routine SHW4:, add a check for MS%OFS and display the structure as
offline if MS%OFS is lit.
6007 6.1137 9-Dec-87
In routine STSTR: include MS%DMP as one of the bits that cab be set.
Report any conflicts regarding MS%DMP.
6010 6.1139 13-Dec-87
When sending a remote ACK/WTO always include the .WTNHD and .WTTYP
blocks.
6011 6.1147 17-Dec-87
Implement automation of DISMOUNT/REMOVAL and SET EXCLUSIVE. Add code
to handle remote MOUNTs.
6012 6.1148 18-Dec-87
Remote systems can't mount a structure after the local system has
remounted the structure after a DISMOUNT/REMOVAL.
6013 6.1149 18-Dec-87
MOUNTR crashes with PDL overflow when DISMOUNT/REMOVE is done in a
mix 6.1 and 7.0 TOPS-20 Cluster.
6014 6.1150 21-Dec-87
In routine KSST.6, If the SET EXCLUSIVE requires a RSB, save the
operator's PID in RSBPID so that the operator can be notified upon completion
of command. In KSSTEX: add code to JRST to the correct routines so that the
SET command terminates normally. In routine STRMN1: after the structure is
mounted, always release the structure lock.
6015 6.1151 22-Dec-87
Rewrite STRMN8: to following the same logic as DISMOUNT/REMOVAL and
SET EXCLUSIVE when MOUNTR tries to apply the EXCLUSIVE attribute of a structure
after it has been mounted.
6016 6.1152 23-Dec-87
In routine KSSTAB:, just return after calling UNSEXC. SCREQ3: will
have already imform the operator that the SET EXCLUSIVE was aborted. Also,
in routine KDSM: remember the remote node in RSBOBN and STROBN if the dismount
is a remote dismount.
6017 6.1165 7-Jan-88
In routine BT4:, store the remote node name in .WTNHD and not the
local node name. In CKGHDR: if the message is from NEBULA, save the remote
node name in RENODE. In PNEDC3:+1, change the AOJG to SOJG or else MOUNTR
will loop forever. In KSST: save the structure flag in STRFL2.
6020 6.1167 15-Jan-88
In routine STRMNT:, change the CAME to CAMN to correctly check for
a whether the remote request node name matches the remote node name who did
the dismount. In routine WHOEQC:, zero out the left half of TEMP so that the
user number is correctlt stored in the INFBLK:. In routine WHOENQ:, change the
message to indicate the command failed because the structure is being dismount
with removal or set exclusive a structure from another system.
6021 6.1199 29-Feb-88
In routine STRMNT:+4, change the MOVE to SKIPE so that remote mounts
on a structure that have not been dismount on behalf of works.
6022 6.1202 2-Mar-88
Extend the sign bit of the terminal line number in ACCLN because the
MONITOR doesn't like 0,,-1 for a deteched terminal line number.
6023 6.1216 5-Mar-88
Add missing RET in STRFND.
6024 6.1219 6-Mar-88
Add conditional for enabling/disabling CLUSTER GALAXY feature. In
routine START: add one line..SINGLE <SETOM ENQFLG> after the ENQ% call.
ENQFLG=-1 if not 7.0 MONITOR or CLUSTER GALAXY is disabled.
6025 6.1225 8-Mar-88
Update copyright notice.
6026 6.1228 9-Mar-88
Change message in WODSC1: to be more clear.
6027 6.1231 28-Mar-88
Edit 6022 is incorrect. ACCLN is a mask (0,,-1) and not a location
which contains the line number. Change ACCLN to ACCNO(ACC).
6030 6.1236 21-Apr-88
No need to check for additional pending RSBs in routine SCREQ3: because
they are already pending for a response to a WTOR. Also, the code to do the
checking was incorrect.
6031 6.1240 27-Apr-88
In routine NSACK: get the RSB status in AC 1 so that the check for
R%STA is correct. In routine FAILE: make sure that the error indicator bit is
set in .OFLAG. In routine STRDMT: set R%STA if the remote dismount fails
because the structure is set IGNORE and use ABTREQ macro to abort the request.
6032 6.1250 9-May-88
In error table NEBERR: add [ and ] for each error string so that FNDERR
can return the correct address of a NEBULA error.
6033 6.1265 29-Jun-88
At routine STRIN6:, if the call to ISTDDB returns +1 then disconnect
the link between the DDB and its SSB because that SSB is no longer valid.
6034 6.1268 11-Aug-88
MOUNTR does not return the correct information on structures that are
mounted by CHECKD. Also change the headers to be in mixed case instead of
upper case. (this will not have an edit # in the comment line).
6035 6.1269 18-Oct-88
Set the NEBULA message flag, NEBMSG, if we received a remote command
so that MOUNTR will return the response locally and remotely.
6036 6.1277 25-Apr-89
Move edit 6035 after checking for message from INFO. Apparently INFO
sends a message to MOUNTR after a @MOUNT command and the message contains
data that is of not interest. However, the second word of the message has bit
MF.NEB sent and MOUNTR erroronously sets NEBMSG for the next command.
6037 6.1279 30-Jun-89
In routine STRMNT: if there is no structure name use the alias. Also,
include an error code when rejecting the mount request.
6040 6.1280 22-Sept-89
Change the error messages when a MTA device is being used on another
system. This is in accordance with a patch to the MONITOR to make MTA devices
shareable in a TOPS-20 Cluster.
^ ;End of revision history
SUBTTL PREFACE
COMMENT ^
MOUNTR - THIS PROGRAM CONTOLS MAGNETIC TAPE AND STRUCTURE MOUNT
REQUEST QUEUEING AND PROCESSING UNDER TOPS-20. IT INTERFACES WITH
QUASAR, ORION, NON-PRIVILEGED USER-MODE PROGRAMS (TOPS-20 EXEC,
ET AL), AND THE SYSTEM OPERATOR.
ACCUMULATOR CONVENTIONS:
F, Q1-Q3, AND SPECIAL-PURPOSE AC'S (E.G. MTA) ARE PRESERVED BY
SUBROUTINES, WHILE T1-T4 AND CX MAY BE CLOBBERED. SOME MACROS USE
CX TO LINK TO DRIVERS, SO BE CAREFUL. F CONTAINS PROGRAM-WIDE
FLAGS THAT MAY BE MODIFIED AND TESTED BY ANY ROUTINE THAT NEEDS
THEM. MACRO DRIVERS GENERALLY PRESERVE T1-T4.
INTERRUPT-LEVEL OPERATION:
TO MINIMIZE THE POSSIBILITY OF TIMING BUGS, PROCESSING AT
INTERRUPT LEVEL WILL BE KEPT TO AN ABSOLUTE MINIMUM. INTERRUPTS
FROM SOURCES EXTERNAL TO THE PROGRAM ARE PROCESSED AT PRIORITY
LEVEL 3 (DEFINED BY "PRIEXT" EQUATE). TYPICALLY, THE ONLY ACTION
TAKEN IS TO REQUEST THAT THE SCHEDULER PASS CONTROL TO THE
APPROPRIATE EVENT PROCESSOR AT NON-INTERRUPT LEVEL (ALL EVENT
PROCESSOR TAGS END IN "IH"). DEBRK IS DONE EITHER TO THE
INTERRUPTED PC OR TO THE BEGINNING OF THE SCHEDULER, DEPENDING
UPON THE SETTING OF THE FLAG, IRETF. ALL PANIC-CHANNEL ACTIVITY
OCCURS AT LEVEL 1 (DEFINED BY "PRIPAN" EQUATE).
ASSOCIATED PROCESSES:
THIS PROGRAM RELIES UPON SEVERAL OTHER SYSTEM TASKS TO PERFORM
ITS FUNCTIONS. THESE ARE REFERRED TO AS "ASSOCIATED PROCESSES",
ABBREVIATED A/P. PARALLEL A/P TABLES ARE MAINTAINED IN CORE,
INDEXED BY THE A/P INDEX (A SMALL INTEGER ASSOCIATED WITH THE
PROCESS).
RESTARTABILITY:
IT IS INTENDED THAT MOUNTR BE RESTARTABLE WITH A MINOR IMPACT
UPON SYSTEM PERFORMANCE. SOME OF THE PROBLEMS CREATED BY
RESTARTING THE PROGRAM ARE:
1. ALL STRUCTURE-MOUNT AND ACCOUNTING INFORMATION IS LOST.
2. ALL ACCOUNTING INFORMATION FOR CURRENTLY-MOUNTED TAPES IS
LOST.
3. ALL TAPE-MOUNT REQUESTS THAT HAVE NOT BEEN ASSIGNED AN MT
DEVICE ARE LOST.
4. USERS WITH MT DEVICES MAY CONTINUE USING THEM, BUT ANY
ATTEMPT AT A VOLUME SWITCH WILL RECEIVE AN ERROR.
EXTENDED ADDRESSING:
THOUGH MOUNTR WILL NOT NORMALLY RUN IN A NON-ZERO SECTION, ITS
CODE SHOULD NOT PRECLUDE THAT POSSIBILITY. BECAUSE OF THE VARIETY
OF JSYS'S IT EXECUTES, MOUNTR CAN BE OF GREAT ASSISTANCE IN
TESTING THE USER-MODE EXTENDED ADDRESSING FEATURES OF THE MONITOR.
TEST MODE:
PLACING A NON-ZERO VALUE IN LOCATION 135 (.JBOPS) BEFORE STARTING
MOUNTR WILL CAUSE MOUNTR TO RUN IN A TESTING MODE (THIS
CONVENTION IS ADOPTED FROM THE GALAXY WORLD). THE ESSENTIAL
DIFFERENCES FROM LIVE MODE ARE THAT MOUNTR WILL TALK TO PRIVATE
GALAXY COMPONENTS, AND IT WILL REFRAIN FROM DOING THINGS (E.G.,
ASSIGNING MTA DEVICES) THAT WOULD INTERFERE WITH THE OPERATION OF
THE REAL MOUNTR.
^
; TABLE OF SUPPORTED DENSITIES
DENTAB:: DENLST ;GENERATE LIST OF DENSITIES
DENMAX==:.-DENTAB-1 ;MAXIMUM DENSITY INDEX
; POINTERS TO TEXT STRINGS INDEXED BY LABEL TYPE
LTTXT:: 0
[ASCIZ/Unlabeled/]
[ASCIZ/ANSI/]
[ASCIZ/EBCDIC/]
[ASCIZ/TOPS-20/]
MAXLT ;CODE NEEDED HERE IF NEW LABEL TYPE ADDED
; POINTERS TO TEXT STRINGS INDEXED BY DRIVE TYPE
DRVTXT:: 0
[ASCIZ/9-TRACK/]
[ASCIZ/7-TRACK/]
DVTTXT: DVTGEN <45,70,71,72,73,77,78>
DVTLEN==:.-DVTTXT
; ASCII-TO-EBCDIC TRANSLATION TABLE
; TABLE IS COMPOSED OF 128 8-BIT BYTES, INDEXED BY THE
; ASCII CHARACTER VALUE
AETT::
BYTE (8)000,001,002,003,067,055,056,057,026,005,045,013,014,015,016,017
BYTE (8)020,021,022,023,074,075,062,046,030,031,077,047,034,035,036,037
BYTE (8)100,117,177,173,133,154,120,175,115,135,134,116,153,140,113,141
BYTE (8)360,361,362,363,364,365,366,367,370,371,172,136,114,176,156,157
BYTE (8)174,301,302,303,304,305,306,307,310,311,321,322,323,324,325,326
BYTE (8)327,330,331,342,343,344,345,346,347,350,351,112,340,132,137,155
BYTE (8)171,201,202,203,204,205,206,207,210,211,221,222,223,224,225,226
BYTE (8)227,230,231,242,243,244,245,246,247,250,251,300,152,320,241,007
; EBCDIC-TO-ASCII TRANSLATION TABLE
; TABLE IS COMPOSED OF 256 7-BIT ASCII BYTES, INDEXED BY THE
; EBCDIC CHARACTER VALUE
XXX==.CHCNZ ;VALUE OF EBCDIC CHARS WITHOUT IMAGES (^Z=SUB)
EATT::
BYTE (7)000,001,002,003,XXX,011,XXX,177,XXX,XXX,XXX,013,014,015,016
BYTE (7)017,020,021,022,023,XXX,XXX,010,XXX,030,031,XXX,XXX,034,035
BYTE (7)036,037,XXX,XXX,XXX,XXX,XXX,012,027,033,XXX,XXX,XXX,XXX,XXX
BYTE (7)005,006,007,XXX,XXX,026,XXX,XXX,XXX,XXX,004,XXX,XXX,XXX,XXX
BYTE (7)024,025,XXX,032,040,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,133
BYTE (7)056,074,050,053,041,046,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)135,044,052,051,073,136,055,057,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,174,054,045,137,076,077,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,140,072,043,100,047,075,042,XXX,141,142,143,144,145,146
BYTE (7)147,150,151,XXX,XXX,XXX,XXX,XXX,XXX,XXX,152,153,154,155,156
BYTE (7)157,160,161,162,XXX,XXX,XXX,XXX,XXX,XXX,XXX,176,163,164,165
BYTE (7)166,167,170,171,172,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,173,101,102
BYTE (7)103,104,105,106,107,110,111,XXX,XXX,XXX,XXX,XXX,XXX,175,112
BYTE (7)113,114,115,116,117,120,121,122,XXX,XXX,XXX,XXX,XXX,XXX,134
BYTE (7)XXX,123,124,125,126,127,130,131,132,XXX,XXX,XXX,XXX,XXX,XXX
BYTE (7)060,061,062,063,064,065,066,067,070,071,XXX,XXX,XXX,XXX,XXX
BYTE (7)XXX,0,0,0,0
;DISPLAY MESSAGES FOR DISK STATUS
DSKHDR::ASCIZ "
DISK DRIVE INFORMATION DISK PACK INFORMATION
Chan-Cont Disk Mount Mount Usage
Type Drive Status Status Count Name Options
---- --------- -------- ------- ----- ------------ --------------------------
"
CFGHDR::ASCIZ "
Chan-Cont Mount
Type Drive Drive Serial Number Status Name
---- --------- --------------------- ------- ------------
"
FREHDR::ASCIZ "
FREE DRIVES
"
MNTHDR::ASCIZ "
MOUNTED DRIVES
"
;DISPLAY MESSAGES FOR STRUCTURE STATUS
STRHDR::ASCIZ "
Mount Mount File
Alias Name State Count Count Status Access Accounting
------ ------ ------- ----- ----- -------- -------------------- ---------------
"
FRESTR::ASCIZ"
UNMOUNTED STRUCTURES
"
MNTSTR::ASCIZ"
MOUNTED STRUCTURES
"
; Header for a particular structure
; Display messages for structure status change
STRCHD: ASCIZ "Structure Status Change Detected"
; Display message for conflicting bits
CONFLI: ASCIZ "* The attribute(s) for this structure are inconsistent with current status
"
; Trying to set a disk drive with PS: mounted on it
DSKPS: ASCIZ "**Warning - Primary public structure is mounted on disk drive **
"
DSMHDR:: ASCIZ "%IDismount of structure %3S: (Alias %2S:) requested.
Other jobs are currently using it. Should
dismount request be processed (Yes or No)?
%U"
FREEH:: ASCIZ /%7CDisk drives that are "Free" might be in use by other systems%_%7CCheck status of structure on other systems before attempting any removal/
;[6011]
RESHDR:: ASCIZ /If successful, respond PROCEED
If not successful, respond ABORT/
;[6011]
RESPRE:: BLOCK 1 ;RESPRE must be right before RESNAM
RESNAM:: ASCIZ/-DSKO'MJCLFGZAPKMSACPSCBR/ ;Resource name
;DISK UNIT TYPE TABLE
UNTYTB:! XWD .MSRP4,[ASCIZ/RP04/] ;1 - RP04
XWD .MSRP5,[ASCIZ/RP05/] ;5 - RP05
XWD .MSRP6,[ASCIZ/RP06/] ;6 - RP06
XWD .MSRP7,[ASCIZ/RP07/] ;7 - RP07
XWD .MSRM3,[ASCIZ/RM03/] ;11 - RM03
XWD .MSR20,[ASCIZ/RP20/] ;24 - RP20
xwd .msr80,[asciz/RA80/] ;27 - ra80
xwd .msr81,[asciz/RA81/] ;30 - ra81
xwd .msr60,[asciz/RA60/] ;31 - ra60
XWD -1,[ASCIZ/Unk /] ;ENTRY IN CASE NONE OF ABOVE
MXUTYP==:.-UNTYTB-1 ;NUMBER OF KNOWN ENTRIES
SUBTTL MODIFYABLE DATA AREA
; DEFINITION OF ASSOCIATED PROCESS INDICES
DEFINE APENT (X) <.AP'X==NEXT>
NEXT$==0 ;INITIALIZE VARIABLE
APTABL ;DEFINE SYMBOLS OF FORM .APxxx AS A/P INDICES
APNUM==NEXT$ ;# OF ASSOCIATED PROCESSES
; ALL DATA FROM ZROBGN TO ZROEND WILL BE SET TO ZEROS AT STARTUP
ZROBGN:: ;BEGINNING OF AUTOMATIC ZERO AREA
NSR:: BLOCK 1 ;# OF REQUESTS IN SCHEDULER QUEUE
TDSCF:: BLOCK 1 ;.GE. 0 SCHED REQUEST EXISTS FOR TDSCIR
MYPID:: BLOCK 1 ;SYSTEM MDA PID
MSGSIN:: BLOCK 1 ;# OF IPCF MESSAGES RECEIVED
SHORT:: BLOCK 1 ;MAXIMUM LENGTH OF NON-PAGE IPCF MESSAGE
MTAN:: BLOCK 1 ;NUMBER OF MTA DEVICES ON SYSTEM
MTN:: BLOCK 1 ;NUMBER OF MT DEVICES ON SYSTEM
PBACW:: BLOCK 1 ;GLOBAL ADDR OF ARGUMENT COUNT WORD
PBBPT:: BLOCK 1 ;ADDR OF NEXT BUILDING BLOCK TO BE BUILT
PBLFT:: BLOCK 1 ;Bytes positions left in orion message
MORTXT:: BLOCK 1 ;Byte pointer to remaining text
BTEXT:: BLOCK 1 ;ORION communication flags
FIRST:: BLOCK 1 ;Marker for wto/ack message type block
BUFLFT:: BLOCK 1 ;Number of words free in TMCMSG
TMCPTR:: BLOCK 1 ;BYTE POINTER INTO TMCMSG
TMCTSP:: BLOCK 1 ;TMCT0 ROUTINE SOURCE STRING POINTER
TMCWDS:: BLOCK 1 ;CURRENT LENGTH OF TMCMSG IN WORDS
WTRQDB:: BLOCK 1 ;QDB FOR OUTSTANDING WTOR REQUESTS
ARBQDB:: BLOCK 1 ;QDB FOR ACTIVE REQUEST STATUS BLOCKS
IRBQDB:: BLOCK 1 ;QDB FOR INACTIVE REQUEST STATUS BLOCKS
FVSQDB:: BLOCK 1 ;QDB FOR FREE VOLID SLOTS IN VOLP0
UNIQUE:: BLOCK 1 ;UNIQUE VALUE WORD (ACCESSED WITH AOS)
BTFLGS:: BLOCK 1 ;.OFLAG WORD FOR WTO'S AND ACK'S
TAPNAM:: BLOCK TPNMSZ/5+1 ;INSTALLATION-SUPPLIED NAME FOR VOL1
CRSHAC:: BLOCK 20 ;AC'S AT TIME OF CRASH
SSSDAT:: BLOCK 2 ;DATA AND ROUTINE ADDRESS FOR DEBUG
LSTERR:: BLOCK 1 ;LAST ERROR AT TIME OF CRASH
CHKDFG:: BLOCK 1 ;[6034]CHECKD flag
CSB:: BLOCK 12 ;STATE BLOCK FOR COMND JSYS
APPID:: BLOCK APNUM ;A/P PID TABLE
MRPDB:: BLOCK 10 ;PDB FOR MRECV OPERATIONS
TRPDB:: BLOCK 4 ;MSEND PDB
PDL:: BLOCK PDLEN+1 ;PUSH-DOWN STACK
PDL1:: BLOCK 4 ;ALTERNATE PDL - USED BY STOPP ROUTINE
BADP:: BLOCK 1 ;CONTENTS OF P WHEN STACK PROBLEM FOUND
SYRHDR:: BLOCK SYRHSZ+SYRMSZ ;SYSERR HEADER AND MESSAGE
SYRMSG==SYRHDR+SYRHSZ ;ADDRESS OF SYSERR MESSAGE
SAVEDP:: BLOCK 1 ;USED TO SAVE STACK POINTER FOR REPARSES
IABQDB:: BLOCK 1 ;QDB FOR INACTIVE ACCOUNT BLOCKS
AABQDB:: BLOCK 1 ;QDB FOR ACTIVE ACCOUNT BLOCKS
READCL:: BLOCK 2 ;DUMPI IOWD LIST FOR READING LABELS
LPC1:: BLOCK 2 ;PSI LEVEL 1 FLAGS & PC
LPC2:: BLOCK 2 ;PSI LEVEL 2 FLAGS & PC
LPC3:: BLOCK 2 ;PSI LEVEL 3 FLAGS & PC
DAEPC:: BLOCK 1 ;PC OF LAST DATA ERROR
DEFDEN:: BLOCK 1 ;Default Initialization Density
PRTRSB:: BLOCK 1 ;Storage for Port RSB
ANY:: BLOCK 1 ;Disk marker - SET PORT CI offline
PORTST:: BLOCK 1 ;Port status word . 1=unavailable 0=unavailable
AGAIN: BLOCK 1 ;Flag word to indicate redo of status loop
UNLD: BLOCK 1 ;Tape being unloaded flag
LCNODE: BLOCK 1 ;[6010]Local node name
RENODE: BLOCK 1 ;[6010]Remote node name
NEBMSG: BLOCK 1 ;[6010]Request from NEBULA flag. nonzero=NEBULA
WTNHDB: BLOCK 2 ;[6010]2 Word block for .WTNHD
WTTYPA: BLOCK 1 ;[6010]Address of .WTTYP
TEMPX: BLOCK 2 ;[6010]Temp storage
STNAM: BLOCK 1 ;[6011]Structure name from .STRNM from .NRDAK
NUMNOD: BLOCK 1 ;[6011]Number of nodes returned from .NRDAK
DFLAG: BLOCK 1 ;[6011]Remote dismount flag from .NRDAK
ADDRBK: BLOCK 1 ;[6011]Address of .STSBK block from .NRDAK
BADADR: BLOCK 1 ;[6013]Address of BADNOD
BADNOD: BLOCK 7 ;[6013]Nodes in the cluster that is pre 7
ZROEND==.-1 ;END OF AUTOMATIC ZERO AREA
; End of buffer flags used in TMCMSG and for IPCF packets
ENDBUF==MSGLEN-^D20 ;Nearing end of TMCMSG buffer
BYTEND==^D83 ;Nearing end of IPCF message buffer
; Data for SHOW CONFIGURATION DISK-DRIVE command
CFGFLG:: BLOCK 1 ;Used so SHO STA DISK knows it's a different display
; Data for user list for SHO STa STR FOO: command
USRSIZ==101 ;Max number of users on user list.
USRBIT==0 ;Offset to usage bits.
USRNUM==1 ;Offset to Job user number.
USRENT==2 ;User entry size.
DIRNAM:: BLOCK 15 ;User name who have mounted/access/connected
USRLST:: BLOCK USRSIZ ;User list for usage of structure
PNFLAG:: BLOCK 1 ;[6011]Routine PNEDAC's header flag
FNDRSB:: BLOCK 1 ;[6011]Routine PNEDAC's RSB flag
DSPFLG:: BLOCK 1 ;Display message flag, bits define in MTRMAC
; CDFLG - DEPOSIT 0 TO DISABLE ^D, DEPOSIT 1 TO ENABLE ^D
CDFLG:: EXP -1 ;CONTROL-D ENABLE/DISABLE SWITCH
CFSPEC:: ASCIZ/SPOOL:MOUNTR-CRASH.EXE/ ;[6001]CRASH FILESPEC
LBUF2:: BLOCK LB7WDS ;7-BIT ASCII REPRESENTATION OF LBUF1
OPRHSZ==12
OPRHDR:: BLOCK OPRHSZ ;TEMPORARY TEXT STORAGE
MSTRBK:: BLOCK 50 ;PLACE FOR MSTR DSK STATUS ARG BLOCK
MSTNM:: BLOCK 2 ;STRUCTURE NAME FOR MSTR IN 7-BIT ASCII
MSTAL:: BLOCK 2 ;STRUCTURE ALIAS FOR MSTR IN 7-BIT ASCII
CFSB:: BLOCK 1 ;0=NON CFS SYSTEM, -1=CFS SYSTEM
ENQFLG:: BLOCK 1 ;[6010]Cluster ENQ flag -1=Not cluster ENQ
ENQBLK:: BLOCK 6 ;[6010]ENQ block
ENQCBK:: Block 3 ;[6010]ENQC block
CNFSIZ==:30 ;[6010]CNFIG block size
NUMBLK:: BLOCK 31 ;[6010]CNFIG block for CI-node number
NAMBLK:: BLOCK 31 ;[6010]CNFIG block for CI-node name
INFBLK:: BLOCK 20 ;[6010]INFO block
; Argument blocks for various JSYSs
MSTRST: BLOCK .MSGSI+1 ;[6010]Block for structure status MSTR
MUTLBK: BLOCK 3 ;Block for MUTIL JSYS
TAPEBK: BLOCK .MOIWF+1 ;Block for getting info about tape drive MTOPR
; SSB data base management
SSBFPT: BLOCK 1 ;Pointer to SSB free entries (or 0 if none)
SSBTOP: BLOCK 1 ;Top of active SSB entries
; Points to next SSB entry available
SUBTTL STORAGE AREA FOR USAGE DATA
JOBNO:: BLOCK 1 ;JOB NUMBER
LINO:: BLOCK 1 ;LINE NUMBER
USRNAM:: BLOCK 10 ;ASCIZ USER NAME
ACOUNT:: BLOCK 10 ;ASCIZ ACCOUNT USTING
USTCRT:: ;DATE/TIME OF REQUEST CREATION
UMTCRT:: BLOCK 1 ;CREATION DATE/TIME OF REQUEST
USTSCD:: ;SCHEDULED TIME
UMTSCD:: BLOCK 1
USTSRV:: ;DATE/TIME WHEN SERVICED
UMTSRV:: BLOCK 1 ;SERVICED DATE/TIME
USTEUT:: ;ELAPSED USAGE TIME
UMTEUT:: BLOCK 1
USTDSP:: ;DISPOSITION OF REQUEST
UMTDSP:: BLOCK 1
USTTXT:: ;OPERATOR/SYSTEM TEXT
UMTTXT:: BLOCK 10
USGCSZ==.-JOBNO+1
USTNM:: ;STRUCTURE NAME
UMTVID:: BLOCK 1 ;MAGTAPE VOLUME IDENTIFIER
USTKTP:: ;CONTROLLER TYPE
UMTKTP:: BLOCK 1 ;CONTROLLER TYPE
USTDTP:: ;DEVICE TYPE
UMTLT:: BLOCK 1 ;LABEL TYPE
; 1 = UNLABELED, 2 = ANSI
; 3 = EBCDIC, 4 = DEC
USTSTP:: ;STRUCTURE TYPE (3=DOMESTIC,4=FOREIGN)
UMTLS:: BLOCK 1 ;LABEL STATUS
; 0 = UNLABLED VOLUME
; 1 = PRIVATE VOLUME
; 2 = SCRATCH VOLUME
; 3 = SCRATCH VOLUME ASSIGNED TO USER
; DURING THIS MOUNT
USTTNP:: ;NUMBER OF PACKS IN STRUCTURE
UMTMRD:: BLOCK 1 ;MAGTAPE READS
USTMC:: ;MOUNT COUNT BEFORE MOUNT
UMTMWR:: BLOCK 1 ;MAGTAPE WRITES
USTDC:: ;MOUNT COUNT AFTER MOUNT
UMTMRF:: BLOCK 1 ;THOUSANDS OF FRAMES READ OF MTA
USTATP:: ;ACCESS TYPE
UMTMWF:: BLOCK 1 ;THOUSANDS OF FRAMES WRITTEN
UMTFSI:: BLOCK 1 ;FILE SET IDENTIFIER
UMTSRE:: BLOCK 1 ;NUMBER OF SOFT READ ERRORS
UMTSWE:: BLOCK 1 ;NUMBER OF SOFT WRITE ERRORS
UMTHRE:: BLOCK 1 ;NUMBER OF HARD READ ERRORS
UMTHWE:: BLOCK 1 ;NUMBER OF HARD WRITE ERRORS
UMTVSN:: BLOCK 1 ;VISUAL SERIAL NUMBER
USGSIZ==.-JOBNO+1
SUBTTL STATIC DATA AREA
; BLOCK 1000 ;GET INTO A NEW PAGE
;PURE:: ;LOWEST LOCATION IN STATIC DATA AREA
; EVERYTHING BEYOND THIS POINT WILL BE WRITE-PROTECTED BY THE
; ROUTINE WRTP, WHICH IS CALLED IN THE INITIALIZATION PHASE
TSTF==:135 ;Galaxy mode flag: 0=live, 1=test
; SOFTWARE INTERRUPT SYSTEM DATA AREAS
; ------------------------------------
LEVTAB: LPC1
LPC2
LPC3
; MACRO TO DEFINE PANIC-CHANNEL INTERRUPT CHNTAB ENTRIES
DEFINE PANIC (PANHDL) <
INTMSK==INTMSK+1B<.-CHNTAB> ;;SET BIT IN CHANNEL MASK
XWD PRIPAN,PANHDL ;;GENERATE CHNTAB ENTRY
>
; MACRO TO DEFINE EXTERNAL INTERRUPT CHNTAB ENTRIES
DEFINE EXTPSI (ENAM,EADR) <
INTMSK==INTMSK+1B<.-CHNTAB> ;;SET BIT IN CHANNEL MASK
ENAM'CN==.-CHNTAB ;;DEFINE CHANNEL# SYMBOL
IFB <EADR>,<
XWD PRIEXT,[CALL EIHR ;;GENERATE CHNTAB ENTRY
EXP ENAM'IH] ;;ENTRY POINT FOR SCHEDULER
> ;;END IFB EADR
IFNB <EADR>,<
XWD PRIEXT,EADR ;;GENERATE CHNTAB ENTRY
> ;;END IFNB EADR
>
INTMSK==0 ;INITIAL VALUE OF INTRPT CHANNEL MASK
CHNTAB:
EXTPSI DDT ;0 - LOAD AND SCHEDULE DDT
0,,0 ;1 - ASSIGNABLE CHANNEL 1
0,,0 ;2 - ASSIGNABLE CHANNEL 2
0,,0 ;3 - ASSIGNABLE CHANNEL 3
0,,0 ;4 - ASSIGNABLE CHANNEL 4
0,,0 ;5 - ASSIGNABLE CHANNEL 5
0,,0 ;6 - ARITHMETIC OVERFLOW
0,,0 ;7 - FLOATING OVERFLOW
0,,0 ;8 - RESERVED
PANIC PANPOV ;9 - PDL OVERFLOW
0,,0 ;10 - END OF FILE
PANIC PANDAE ;11 - DATA ERROR
PANIC PANQTA ;12 - QUOTA EXCEEDED
0,,0 ;13 - RESERVED
0,,0 ;14 - TIME OF DAY (RESERVED)
PANIC PANILI ;15 - ILLEG INSTRUCTION
PANIC PANIRD ;16 - ILLEGAL READ
PANIC PANIWR ;17 - ILLEGAL WRITE
0,,0 ;18 - ILLEGAL EXECUTE (RESERVED)
0,,0 ;19 - INFERIOR FORK TERMINATION
PANIC PANMSE ;20 - MACHINE SIZE EXCEEDED
0,,0 ;21 - TRAP TO USER (RESERVED)
0,,0 ;22 - NONEXISTENT PAGE REFERENCED
0,,0 ;23 - ASSIGNABLE CHANNEL 23
EXTPSI MRCV ;24 - IPCF MESSAGE WAITING
EXTPSI TDSC,TDSCIH ;25 - MTA DEVICE STATUS CHANGE
EXTPSI JTO,JTOIH ;26 - JSYS TIMER EXPIRED
EXTPSI DDSC ;27 - DISK DEVICE STATUS CHANGE
0,,0 ;28 - ASSIGNABLE CHANNEL 28
0,,0 ;29 - ASSIGNABLE CHANNEL 29
0,,0 ;30 - ASSIGNABLE CHANNEL 30
0,,0 ;31 - ASSIGNABLE CHANNEL 31
0,,0 ;32 - ASSIGNABLE CHANNEL 32
0,,0 ;33 - ASSIGNABLE CHANNEL 33
0,,0 ;34 - ASSIGNABLE CHANNEL 34
0,,0 ;35 - ASSIGNABLE CHANNEL 35
; ENTRY VECTOR
ENTVEC: JRST START ;STARTING ADDRESS
JRST DEBUG ;REENTER ADDRESS
LVERS:: EXP mtrVER ;PROGRAM VERSION
ENTVSZ==.-ENTVEC
; TABLE OF INITIALIZATION ROUTINE ADDRESSES FOR ASSOCIATED PROCESSES;
; ROUTINE IS CALLED DURING PROGRAM INITIALIZATION, AND POSSIBLY
; BY THE RECOVERY ROUTINE IF THE PROCESS CRASHES.
DEFINE APENT (X) <IFIW!X'INI>
APINI: APTABL ;GENERATE LIST OF INIT ROUTINE ADDRS
; TABLE OF IPCF INPUT-MESSAGE PROCESSING ROUTINE ADDRESSES FOR A/P'S;
; ROUTINE IS CALLED WHEN AN IPCF MESSAGE IS RECEIVED FROM A PID THAT
; IS LISTED IN THE APPID TABLE
DEFINE APENT (X) <IFIW!X'MRC>
APMRC: APTABL ;GEN LIST OF IPCF-RECEIVE HANDLER ADDRS
; Table of error codes and corresponding processing addresses upon MSEND
; failure for IPCF Send and Receive routines
MTBL: IPCFX4,,TRAN1 ;Receiver's PID is invalid
IPCFX5,,TRAN1 ;Receiver's PID is disabled
IPCFX6,,TRAN6 ;Send quota is exceeded
IPCFX7,,TRAN5 ;Receiver's quota is exceeded
IPCFX8,,TRAN6 ;IPCF free space is exhausted
IPCF19,,TRAN7 ;No PID for SYSTEM INFO
MONX06,,TRAN6 ;No swappable free space
MLEN==.-MTBL ;Length of the table
SUBTTL TEMPLATES FOR USAGE JSYS
;STRUCTURE USE RECORD
USGSTR: USENT. (.UTMNT,1,1) ;STRUCTURE USAGE RECORD TYPE
USPNM. (<SIXBIT/MOUNTR/>,US%IMM) ;PROGRAM NAME
USPVR. (mtrver,US%IMM) ;VERSION NUMBER
USJNO. (JOBNO) ;JOB NUMBER
USLNO. (LINO) ;LINE NUMBER
USACT. (<-1,,ACOUNT>) ;ACCOUNT
USNM2. (<-1,,USRNAM>) ;USER NAME
USSSI. (USTNM) ;STRUCTURE NAME
USSTP. (USTSTP) ;STRUCTURE TYPE
USTNP. (USTTNP) ;TOTAL NUMBER OF PACKS IN FILE STRUCTURE
USKTP. (USTKTP) ;CONTROLLER TYPE (RH20)
USDTP. (USTDTP) ;DEVICE TYPE (RP04,ETC.)
USDSP. (USTDSP) ;DISPOSITION
USTXT. (<-1,,USTTXT>) ;SYSTEM/OPERATOR TEXT
USCRT. (USTCRT) ;CREATION DATE/TIME OF REQUEST
USSCD. (USTSCD) ;SCHEDULED TIME
USSRV. (USTSRV) ;SERVICED DATE/TIME
USMCT. (USTMC) ;MOUNT COUNT BEFORE MOUNT
USDCT. (USTDC) ;MOUNT COUNT AFTER DISMOUNT
USATP. (USTATP) ;ACCESS TYPE
USEUT. (USTEUT) ;ELAPSED TIME OF USAGE
0 ;END OF RECORD
;TAPE MOUNT RECORD
USGMTA: USENT. (.UTMMT,2,1) ;MAGTAPE USAGE RECORD TYPE
USPNM. (<SIXBIT/MOUNTR/>,US%IMM) ;PROGRAM NAME
USPVR. (mtrVER,US%IMM) ;VERSION NUMBER
USJNO. (JOBNO) ;JOB NUMBER
USLNO. (LINO) ;LINE NUMBER
USACT. (<-1,,ACOUNT>) ;ACCOUNT
USNM2. (<-1,,USRNAM>) ;USER NAME
USVID. (UMTVID) ;VOLUME IDENTIFIER IN VOL1 LABEL
USMRF. (UMTMRF) ;THOUSANDS OF FRAMES READ
USMWF. (UMTMWF) ;THOUSANDS OF FRAMES WRITTEN
USDSP. (UMTDSP) ;DISPOSITION
USTXT. (<-1,,UMTTXT>) ;SYSTEM/OPERATOR TEXT
USCRT. (UMTCRT) ;CREATION DATE/TIME
USSCD. (UMTSCD) ;SCHEDULED TIME
USSRV. (UMTSRV) ;SERVICED DATE/TIME
USKTP. (UMTKTP) ;CONTROLLER TYPE
USMLT. (UMTLT) ;LABEL TYPE
USMLS. (UMTLS) ;LABEL STATE
USMRD. (UMTMRD) ;NUMBER OF TAPE READS
USMWR. (UMTMWR) ;NUMBER OF TAPE WRITES
USFSI. (UMTFSI) ;FILE SET IDENTIFIER
USSRE. (UMTSRE) ;NUMBER OF SOFT READ ERRORS
USSWE. (UMTSWE) ;NUMBER OF SOFT WRITE ERRORS
USHRE. (UMTHRE) ;NUMBER OF HARD READ ERRORS
USHWE. (UMTHWE) ;NUMBER OF HARD WRITE ERRORS
USVSN. (UMTVSN) ;VISUAL SERIAL NUMBER
USEUT. (UMTEUT) ;ELAPSED TIME OF USAGE
0 ;END OF RECORD
SUBTTL INITIALIZATION
; PROGRAM EXECUTION BEGINS HERE
START: HLRZ T1,.JBSA ;GET UPPER BOUND OF PROGRAM
CAIL T1,ADLOW ;PROGRAM TOO BIG?
JRST [ TMSG <MOUNTR program overlaps ADLOW> ;YES, ERROR
HALTF] ;MAKE ADLOW HIGHER TO CORRECT PROBLEM
RESET ;CLOSE JFNS, CLEAR PSI, DUMP PIDS, ETC.
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK POINTER
MOVX F,INITF ;INITIALIZE FLAGS AC
MOVE T1,.JBOPS ;GET GALAXY STANDARD TEST FLAG
MOVEM T1,TSTF ;COPY TO WRITE-PROTECTED LOCATION
; ZERO OUT MODIFYABLE DATA AREA
SETZM ZROBGN ;CLEAR FIRST WORD OF ZERO AREA
MOVE T1,[ZROBGN,,ZROBGN+1] ;GET BLT POINTER
BLT T1,ZROEND ;CLEAR THE REST OF THE ZERO AREA
SETOM TDSCF ;SET NO SCHED REQUEST PRESENT FOR TDSCIR
; TURN ON INTERRUPT SYSTEM
MOVEI T1,.FHSLF ;THIS FORK
MOVE T2,[LEVTAB,,CHNTAB] ;TABLE ADDRESSES
SIR ;COMMUNICATE TABLE ADDR'S TO MNTR
EIR ;TURN ON INTERRUPT SYSTEM
MOVX T2,INTMSK
AIC ;ENABLE INTERRUPT CHANNELS
SETO T3,
EPCAP ;ENABLE ALL CAPABILITIES
; PERFORM VARIOUS INITIALIZATION OPERATIONS
; This is one way to find out if we are running Pre 7 monitor
; ENQFLG=0 Post 7 monitor and cluster GALAXY enabled.
; ENQFLG=-1 Pre 7 monitor and cluster GALAXY disabled.
; SINGLE= conditional flag for ENABLE/DISABLE CLUSTER GALAXY
SETZM ENQFLG ;[6010]Assume cluster ENQ and 7 MONITOR
SINGLE <SETOM ENQFLG> ;[6024]Not cluster GALAXY if SINGLE is defined
SKIPE ENQFLG ;[6024]Do we have Cluster GALAXY?
JRST START0 ;[6024]No, skip ENQ% call
MOVEI T1,.ENECL ;[6010]Enable cluster ENQ
ENQ% ;[6010]Do the JSYS
SETOM ENQFLG ;[6010]Not cluster ENQ
START0: CALL GCNFIG ;[6024]Get the local node name
MOVE T1,NAMBLK+1 ;[6010]Get pointer to local node name
MOVEI T2,LCNODE ;[6010]Put SIXBIT name in LCNODE
CALL SEVSIX ;[6010]Convert it
; CALL WRTP ;WRITE-PROTECT MY CODE
MOVEI T1,.SFMTA
TMON ;TAPE-DRIVE ALLOCATION ENABLED?
JUMPN T2,[TXO F,TALCF ;YES, SET FLAG
MOVEI T1,POLINT ;GET POLLING INTERVAL
MOVEI T2,POLLR ;GET ADDRESS OF POLLING ROUTINE
CALL SRAI ;SCHEDULE MAGTAPE POLLING TASK
JRST .+1]
CALL PIDINI ;CREATE SYSTEM MDA PID
CALL GTINAM ;GET INSTALLATION NAME
CALL INAP ;MAKE FRIENDS WITH ASSOCIATED PROCESSES
CALL DSFINI ;MAP DEVICE-STATUS FILE
CALL DSFNUP ;Say we want no update of DDB
SKIPN TSTF ;RUNNING LIVE?
JRST [ TXNE F,TALCF ;Yes, SKIP MTA ASSIGN IF ALLOCATION DISABLED
CALL ASMTA ;ASSIGN PHYSICAL MAGTAPES TO MYSELF
CALL ASMT ;PUT LOGICAL MAGTAPES IN ALLOC POOL
JRST .+1]
CALL GETDEN ;Get magtape density for Initialize default
CALL GETRSI ;INITIALIZE FREE RSB POOL
CALL PRTINI ;Check for CI availability
CALL DSKINI ;Initialize for disk change interrupts
CALL SSBINI ;Initialize SSB data base
CALL DDSCIH ;Set up DSK and STR DDB and status blocks
SKIPE TSTF ;Debugging?
JRST .+3 ;Yes, skip mount all
SKIPE CFSB ;Are we in CFS?
CALL MNTALL ;Yes, mount all structures possible
CALL DSFYUP ;We now want update of DDB
CALL VQSPIN ;INITIALIZE VOLID-SLOT POOL
CALL GETABI ;INITIALIZE FREE ACCOUNT BLOCK POOL
CALL TDSCIR ;REWIND TAPES, DO AVR, ETC.
TXZ F,INITF ;NOT INITIALIZING ANY MORE
JRST SSS ;ENTER SCHEDULER
SUBTTL SERVICE SCHEDULER (SS)
; SCHEDULER REQUEST QUEUE ENTRY EQUATES
FLDPTR==0
FLDDEF(RE.TIM,1) ;OFFSET TO ACTIVATION TIME
FLDDEF(RE.ENT,1) ;OFFSET TO GLOBAL ENTRY ADDRESS
FLDDEF(RE.ARG,1) ;OFFSET TO ARGUMENT
RE.LEN==FLDPTR ;LENGTH OF SCHEDULER ENTRY
; ONCE AGAIN INTO THE FRAY, DEAR FRIENDS
SSS: TXZ F,IRETF ;SET NOT INTERRUPTIBLE
CAME P,[IOWD PDLEN,PDL] ;STACK POINTER OK?
JSP CX,STOPP ;NO, CRASH
CALL DDCTLD ;CHECK FOR ENABLE/DISABLE ^D
TXO F,IRETF ;SET INTERRUPTIBLE
SKIPN NSR ;QUEUES EMPTY?
WAIT ;YES, REG TO SLEEP
GTAD ;GET CURRENT TIME & DATE IN T1
MOVE T2,SRQ+RE.TIM ;GET TIME/DATE OF EARLIEST REQUEST
SUB T2,T1 ;IS IT IN THE FUTURE?
JUMPLE T2,SSER ;NO, GET ON IT RIGHT AWAY
; SLEEP UNTIL WAKE-UP TIME OF EARLIEST REQUEST
MOVE T1,T2 ;COPY INTERNAL FORMAT SLEEP INTERVAL
MUL T1,[DAYSEC*^D1000] ;COMPUTE # OF MILLISECONDS
ASHC T1,^D17 ; TO SLEEP IN T1
DISMS ;SLEEP UNTIL NEEDED
JRST SSS ;ATTEMPT SCHEDULE AGAIN
; SCHEDULE THE FIRST REQUEST IN THE QUEUE
SSER: TXZ F,IRETF ;AIN'T IDLE NO MORE
MOVEI T1,.FHSLF
DIR ;INHIBIT INTERFERENCE
MOVE T4,SRQ+RE.ENT ;GET ROUTINE ENTRY ADDRESS
MOVE T3,SRQ+RE.ARG ;GET ARG FOR HANDLER ROUTINE
SOS T1,NSR ;GET # OF REQUESTS REMAINING
JUMPE T1,SSS1 ;IF NONE LEFT, DON'T BLT
IMULI T1,RE.LEN ;COMPUTE # OF WORDS TO BLT
MOVE T2,[SRQ+RE.LEN,,SRQ] ;GET BLT SOURCE,,DESTINATION
BLT T2,SRQ+RE.LEN-1(T1) ;DELETE HEAD OF QUEUE
SSS1: MOVEI T1,.FHSLF
EIR ;PERMIT INTERRUPTS
DMOVEM T3,SSSDAT ;STORE CALLED-ROUTINE INFO FOR DEBUG
CALL (T4) ;CALL USER ROUTINE WITH ARG IN T3
TXZE F,ABORTF ;WERE ANY REQUESTS ABORTED?
CALL PRQABT ;YES, PURGE THEM FROM REQUEST QUEUE
JRST SSS ;GO SEE IF MORE WORK TO DO
; SRA - ADD SCHEDULER REQUEST TO QUEUE (2 ENTRY POINTS)
; SRAA - ABSOLUTE INTERNAL-FORMAT TIME & DATE IN T1
; SRAI - INCREMENTAL FORM: # OF SECONDS FROM NOW IN T1
; SRAN - REQUEST IS TO BE SCHEDULED AS SOON AS POSSIBLE (T1 MEANINGLESS)
; T2/ ROUTINE ADDRESS IN RIGHT HALF
; T3/ ARGUMENT TO BE SUPPLIED TO ROUTINE IN T3 AT TIME OF CALL
; RETURNS +1: ALWAYS
SRAI: STAKT ;STACK T1-T4
MUL T1,[1,,0] ;CONVERT # OF SECONDS
DIVI T1,DAYSEC ; TO INCREMENTAL INTERNAL FORMAT
MOVE T2,T1 ;CLEAR OUT OF T1 FOR GTAD
GTAD ;GET CURRENT INTERNAL T/D
ADD T1,T2 ;ADD INCREMENT
JRST SRA1 ;SKIP OTHER ENTRY
SRAN: SETZ T1, ;IMMEDIATE FLAVOR - STUFF T1
SRAA: STAKT ;STACK T1-T4
; COMMON CODE FOR SRAx
SRA1: MOVE T4,T1 ;MOVE ACTIVATION TIME TO T4
MOVEI T1,.FHSLF
DIR ;INHIBIT INTERFERENCE
SETZ T2, ;INIT SCAN INDEX
MOVNI T3,RE.LEN ;INIT QUEUE POINTER
SRA2: ADDI T3,RE.LEN ;BUMP QUEUE POINTER
CAMGE T2,NSR ;ANY ENTRIES LEFT TO CHECK AGAINST?
JRST [ CAML T4,SRQ+RE.TIM(T3) ;YES, EARLIER THAN THIS ENTRY?
AOJA T2,SRA2 ;NO, CONTINUE SEARCH
JRST .+1] ;YES, GO INSERT IT HERE
SUB T2,NSR ;COMPUTE # OF
MOVNS T2 ; ENTRIES TO BE SHIFTED DOWN
IMULI T2,RE.LEN ;COMPUTE # OF WORDS TO SHIFT
MOVE T3,NSR
IMULI T3,RE.LEN ;SET UP LOAD/STORE INDEX AT TAIL
JUMPE T2,SRA3 ;IF NONE, SKIP SHIFTING STUFF
SRA4: MOVE T1,SRQ-1(T3) ;GET A WORD
MOVEM T1,SRQ+RE.LEN-1(T3) ;SHIFT IT DOWN
SOS T3 ;INDEX NEXT WORD
SOJG T2,SRA4 ;LOOP TILL ALL SHIFTING DONE
; INSTALL ENTRY IN NEWLY-CREATED SLOT
SRA3: MOVEM T4,SRQ+RE.TIM(T3) ;STUFF TIME/DATE
XMOVEI T1,20
HRR T1,CT2
MOVEM T1,SRQ+RE.ENT(T3) ;STUFF GLOBAL ENTRY ADDRESS
MOVE T1,CT3
MOVEM T1,SRQ+RE.ARG(T3) ;STUFF ARGUMENT
AOS NSR ;BUMP # OF ENTRIES IN QUEUE
MOVEI T1,.FHSLF
EIR ;PERMIT INTERRUPTS
RET
; EIHR - SUPPORT ROUTINE FOR EXTERNAL INTERRUPTS
EIHR: ADJSP P,5 ;CREATE ROOM ON STACK FOR T1-T4, CX
MOVEM CX,-4(P) ;SAVE CX
DMOVEM T1,-3(P) ;SAVE T1 & T2
DMOVEM T3,-1(P) ;SAVE T3 & T4
; REQUEST SCHEDULING AT INTERRUPT HANDLER ENTRY POINT
MOVE T2,@-5(P) ;GET ADDRESS OF ROUTINE
CALL SRAN ;SCHEDULE AT THIS ADDRESS IMMEDIATELY
; RESTORE AC'S AND EXIT TO INTERRUPTED PROGRAM OR SCHEDULER
MOVE CX,-4(P) ;RESTORE CX
DMOVE T1,-3(P) ;RESTORE T1 & T2
DMOVE T3,-1(P) ;RESTORE T3 & T4
ADJSP P,-6 ;DELETE TEMP SPACE FROM STACK
TXZN F,IRETF ;SCHED GOOFING OFF?
DEBRK ;NO, GO BACK TO INTERRUPTED CODE
MOVE CX,[PC%USR+SSS] ;YES, GET NEW PC
MOVEM CX,@LEVTAB+PRIEXT-1 ;STUFF IT
DEBRK ;EXIT TO SCHEDULER
SUBTTL ACCOUNTING ROUTINES
;ACCSTI - STRUCTURE COUNT BEING INCREMENTED. BUILD ACCOUNTING BLOCK FOR
; USER
ACCSTI: HRRZ T1,RBUF+4 ;GET STRUCTURE STATUS
TRNE T1,(MS%NRS) ;IS IT NON-REGULATED?
JRST ACCS3 ;YES, FORGET ENTRY AND DELETE OLD BLOCK
HLRZ T1,RBUF+2 ;GET JOB NUMBER
HRRZ T2,RBUF+3 ;GET DEVICE DESIGNATOR
HRLI T2,.DVDES+.DVDSK ;ADD DISK DESIGNATION
CALL FNDACC ;SEE IF THERE IS A BLOCK ALREADY
JRST ACCS1 ;NO
SKIPN ACCSVT(ACC) ;IS THERE A SERVICED TIME
JRST ACCS2 ;NO. SO STORE INFORMATION.
AOS ACCFRK(ACC) ;YES, INCREMENT FORK COUNT
RET ;FINISHED
ACCS1: CALL GETACC ;GET AN ACCOUNT BLOCK
CALLRET DELACC ;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
ACCS2: AOS ACCFRK(ACC) ;SET NUMBER OF FORKS USING STR TO 1
;STORE ACCOUNTING INFORMATION
HRRZ T1,RBUF+3 ;GET STRUCTURE UNIQUE CODE
HRLI T1,.DVDES+.DVDSK ;ADD DISK DESIGNATOR
MOVEM T1,ACCDD(ACC) ;STORE IN ACCOUNTING BLOCK
MOVE T1,RBUF+2 ;GET JOB #,,LINE #
MOVEM T1,ACCNO(ACC)
MOVE T2,RBUF+10 ;GET USER #
HRROI T1,ACCUSR(ACC)
DIRST ;TRANSLATE TO NAME
JFCL
MOVEI T1,ACCSTG(ACC) ;SET UP BLT POINTER
HRLI T1,RBUF+11
BLT T1,ACCSTG+7(ACC) ;STORE ACCOUNT STRING
MOVE T1,RBUF+7
SKIPN ACCSCD(ACC) ;IF NO TIME SCHEDULED
MOVEM T1,ACCSCD(ACC) ;TIME SCHEDULED
MOVEM T1,ACCSVT(ACC) ;AND SERVICED ARE THE SAME
MOVE T1,RBUF+6
MOVEM T1,ACCSTN(ACC) ;STORE STRUCTURE NAME
HLRZ T1,RBUF+4
STOR T1,ACCMB ;STORE MOUNT COUNT
HLRZ T1,RBUF+5
STOR T1,ACCNU ;STORE NUMBER OF UNITS
HRRZ T1,RBUF+5
STOR T1,ACCDT ;STORE DISK TYPE
HRRZ T1,RBUF+4 ;GET STRUCTURE STATUS
MOVEI T2,4 ;ASSUME STRUCTURE IS FOREIGN
TRNE T1,(MS%DOM) ;IS IT DOMESTIC?
MOVEI T2,3 ;YES, GET DOMESTIC CODE
STOR T2,ACCST ;STORE STRUCTURE TYPE
SETZRO ACCKT ;SET CONTROLLER TO ALL ONES
MOVE T1,[SIXBIT/NORMAL/] ;PRESET TO NORMAL DISPOSITION
MOVEM T1,ACCDSP(ACC) ; SAVE IT
RET
ACCS3: HLRZ T1,RBUF+2 ;GET JOB NUMBER
HRRZ T2,RBUF+3 ;GET DEVICE DESIGNATOR
HRLI T2,.DVDES+.DVDSK ;ADD DISK DESIGNATION
CALL FNDACC ;SEE IF THERE IS A BLOCK ALREADY
RET ;NO, JUST RETURN
SKIPE ACCSVT(ACC) ;IS IT LEFT OVER FROM A PHYSICAL MOUNT REQ?
RET ;NO, LEAVE IT ALONE
CALLRET DELACC ;YES, DELETE IT
;ACCSTD - STRUCTURE COUNT BEING DECREMENTED. MAKE USAGE ENTRY.
ACCSTD: HLRZ T1,RBUF+2 ;GET JOB NUMBER
MOVE T2,RBUF+3 ;GET DEVICE DESIGNATOR
HRLI T2,.DVDES+.DVDSK ;ADD DISK DESIGNATION
CALL FNDACC ;FIND ACCOUNT BLOCK
RET ;THERE WAS NONE
SOSE ACCFRK(ACC) ;ANY OTHER FORKS HAVE IT INCREMENTED?
RET ;YES, DON'T SEND ANY INFO, YET
CALL STOSTR ;STORE STR INFO FROM ACCOUNT BLOCK
HRRZ T1,RBUF+2 ;GET MOUNT COUNT
MOVEM T1,USTDC
MOVEI T1,.UTMNT ;THIS IS STRUCTURE MOUNT INFO
CALL SNDACC ;SEND USAGE INFO TO MONITOR
CALLRET DELACC ;DELETE ACCOUNT BLOCK
;ACCSTR - STRUCTURE BEING REMOVED. SEND ACCOUNT BLOCKS TO USAGE
ACCSTR: QSCANI AABQDB ;SET UP TO SCAN ACTIVE ACCOUNT BLOCKS
MOVE Q1,RBUF+3 ;GET DEVICE DESIGNATOR
HRLI Q1,.DVDES+.DVDSK ;ADD DISK DESIGNATION
ACCSR1: CALL QMSCAN ;GET ADDRESS OF NEXT ACC IN T2
RET ;NONE LEFT
MOVEI ACC,-ACCLNK(T2) ;LOAD ACC ADDRESS
CAME Q1,ACCDD(ACC) ;IS THIS THE STR BEING REMOVED
JRST ACCSR1 ;NO, GET NEXT ACCOUNT BLOCK
CALL STOSTR ;STORE STR INFO INTO USAGE BLOCK
MOVEI T1,.UTMNT ;THIS IS STRUCTURE MOUNT INFO
CALL SNDACC ;SEND USAGE INFO TO MONITOR
CALL DELACC ;DELETE ACCOUNT BLOCK
JRST ACCSR1 ;GET NEXT BLOCK
;ACCMTR - TAPE BEING REQUESTED. BUILD ACCOUNTING BLOCK FOR USER
ACCMTR: CALL GETACC ;GET ACCOUNT BLOCK
JRST DELACC ;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
MOVSI T1,RSBACT(RSB) ;BLT SOURCE
HRRI T1,ACCSTG(ACC) ;BLT DESTINATION
BLT T1,ACCSTG+7(ACC) ;MOVE USER'S ACCOUNT STRING TO ACC
GTAD ;STORE TIME SCHEDULED
MOVEM T1,ACCSCD(ACC) ;IN ACCOUNT BLOCK
LOAD T1,RSBJNO ;GET USER'S JOB NUMBER
STOR T1,ACCJN
CALL STONAM ;STORE USER'S NAME
JRST DELACC ;USER NOT AROUND, DELETE ACC BLOCK
MOVSI T1,.DVDES+.DVMTA ;GET DEVICE DESIGNATOR
MOVEM T1,ACCDD(ACC) ;STORE IN ACCOUNT BLOCK
MOVE T1,[SIXBIT/NORMAL/] ;PRESET TO NORMAL DISPOSITION
MOVEM T1,ACCDSP(ACC) ; SAVE IT
STOR ACC,RSBACC ;STORE ACCOUNT BLOCK ADDRESS INTO RSB
RETSKP
;ACCMTD - TAPE BEING DISMOUNTED. MAKE USAGE ENTRY FOR USER
;ACCEPTS: MT/ ADDRESS OF MT STATUS BLOCK
; MTA/ ADDRESS OF MTA STATUS BLOCK
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
ACCMTD: SAVEAC <ACC>
SETZM UMTKTP ;SET CONTROLLER TYPE TO ZERO
LOAD ACC,RSBACC ;RETRIEVE ACCOUNT BLOCK ADDRESS
MOVE T1,MTAVOL(MTA) ;GET VOLID
MOVEM T1,UMTVID
LOAD T1,MTALT ;GET LABEL TYPE
MOVEM T1,UMTLT ; INTO USAGE BLOCK
MOVEI T2,.LSUNL ;LABEL STATE, ASSUME UNLABELLED.
CAIE T1,.LTUNL ;IS IT REALLY UNLABELLED?
MOVEI T2,.LSPRI ;NO, MUST BE PRIVATE.
MOVE T1,MTAFLG(MTA) ;GET FLAGS
TXNE T1,MA%SCR ;IS IT SCRATCH?
MOVEI T2,.LSSCR ;YES, SAY SO
MOVEM T2,UMTLS ;LABEL STATE INTO USAGE BLOCK
CALL MTAGJF ;GET MAGTAPE JFN
MOVEI T2,.MOINF ;GET TAPE INFORMATION
MOVEI T3,.MOIWF ;GET LENGTH OF INFO BLOCK
MOVEM T3,TAPEBK
MOVEI T3,TAPEBK ;PUT ALL INFO INTO TAPEBK
MTOPR
CALL MTARJF ;RELEASE JFN
MOVE T1,TAPEBK+.MOIRD ;GET NUMBER OF PHYSICAL RECS READ
SUB T1,ACCPR(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTMRD
MOVE T1,TAPEBK+.MOIWT ;GET NUMBER OF PHYSICAL RECS WRITTEN
SUB T1,ACCPW(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTMWR
MOVE T1,TAPEBK+.MOIRF ;GET NUMBER OF FRAMES READ
IDIVI T1,^D1000 ;IN THOUSANDS
SUB T1,ACCFR(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTMRF
MOVE T1,TAPEBK+.MOIWF ;GET NUMBER OF FRAMES WRITTEN
IDIVI T1,^D1000 ;IN THOUDANDS
SUB T1,ACCFW(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTMWF
MOVE T1,TAPEBK+.MOISR ;GET NUMBER OF SOFT READ ERRORS
SUB T1,ACCSR(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTSRE
MOVE T1,TAPEBK+.MOISW ;GET NUMER OF SOFT WRITE ERRORS
SUB T1,ACCSW(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTSWE
MOVE T1,TAPEBK+.MOIHR ;GET NUMBER OF HARD READ ERRORS
SUB T1,ACCHR(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTHRE
MOVE T1,TAPEBK+.MOIHW ;GET NUMBER OF HARD WRITE ERRORS
SUB T1,ACCHW(ACC) ;SUBTRACT STARTING VALUE
MOVEM T1,UMTHWE
MOVE T1,RSBASN(RSB) ;GET VOLUME SET NAME
MOVEM T1,UMTFSI
MOVE T1,ACCDSP(ACC) ; GET DISPOSITION OF REQUEST
MOVEM T1,UMTDSP ; SAVE IT
MOVEI T1,.UTMMT ;THIS IS TAPE MOUNT INFO
CALLRET SNDACC ;SEND ACCOUNTING INFO TO MONITOR
;DELACC - DELETE ACCOUNT BLOCK FROM QUEUE
;ACCEPTS: ACC/ ADDRESS OF ACCOUNT BLOCK
;RETURNS: +1, NOTHING
DELACC: SETZM ACCDD(ACC) ;SET ACC INACTIVE
QSCANI AABQDB ;SET UP TO SCAN ACTIVE ACC QUEUE
SAVEAC <ACC>
; SEARCH ACCOUNT BLOCK QUEUE AND EXTRACT ABORTED REQUESTS
DELAC1: CALL QMSCAN ;GET ADDRESS OF NEXT ACC ON QUEUE
RET ;NONE LEFT, EXIT
MOVEI ACC,-ACCLNK(T2) ;LOAD ACC WITH ACC BLOCK ADDRESS
SKIPE ACCDD(ACC) ;IS REQUEST ABORTED?
JRST DELAC1 ;NO, SKIP IT
CALL QMDQS ;DEQUEUE ACC, GET LINKAGE ADDR IN T2
MOVEI T1,IABQDB ;GET QDB ADDRESS
CALL QMQH ;QUEUE ACC TO HEAD OF INACTIVE QUEUE
JRST DELAC1 ;CONTINUE SCAN
;FNDACC - FIND AN EXISTING ACCOUNT BLOCK
;ACCEPTS: T1/ JOB NUMBER
; T2/ DEVICE DESIGNATOR
;RETURNS: +1, FAILURE, COULD NOT FIND BLOCK
; +2, SUCCESS, ACC/ ADDRESS OF ACCOUNT BLOCK
FNDACC: SAVEQ
DMOVE Q1,T1
QSCANI AABQDB ;SET UP TO SCAN ACTIVE ACC QUEUE
FNDAC1: CALL QMSCAN ;GET ADDRESS OF NEXT ACC IN T2
RET ;NONE LEFT
MOVEI ACC,-ACCLNK(T2) ;LOAD ACC ADDRESS
CAME Q2,ACCDD(ACC) ;IS THIS THE RIGHT DEVICE DESIGNATOR?
JRST FNDAC1 ;NO, GET ANOTHER ACC
LOAD T1,ACCJN
CAME Q1,T1 ;IS THIS THE RIGHT JOB?
JRST FNDAC1 ;NO, TRY ANOTHER ACC
RETSKP ;SUCCESS
; GETABI - INITIALIZE FREE ACC POOL FOR GETACC
; RETURNS +1: ALWAYS
GETABI: SAVEQ
MOVEI Q1,ACC0 ;GET ADDRESS OF ACC POOL
MOVEI Q2,MAXACC+1 ;# OF ACCS IN POOL
GTABI1: MOVEI T1,IABQDB ;GET QDB ADDRESS
MOVEI T2,ACCLNK(Q1) ;GET ADDRESS OF ACC LINKAGE
CALL QMQT ;QUEUE ACC TO TAIL OF FREE QUEUE
ADDI Q1,ACCSIZ ;POINT Q1 AT NEXT ACC
SOJG Q2,GTABI1 ;LOOP THRU ALL ACCOUNT BLOCKS
RET
; GETACC - ALLOCATE AN ACCOUNT BLOCK
; RETURNS +1: ACCOUNT BLOCK ALLOCATED, BUT IT'S THE LAST ONE
; +2: ACCOUNT BLOCK ALLOCATED, MORE FREE ACC BLOCK'S LEFT
; ACC/ ADDR OF ACCOUNTING BLOCK
GETACC: MOVEI T1,IABQDB ;POINT TO INACTIVE ACC QUEUE
CALL QMDQH ;DEQUEUE HEAD OF QUEUE
CALL STOP ;QUEUE EMPTY, PROGRAM LOGIC ERROR
MOVEI ACC,-ACCLNK(T2) ;LOAD UP ACC AC
MOVSI T1,1(ACC) ;BLT SOURCE
HRRI T1,2(ACC) ;BLT DESTINATION
SETZM 1(ACC) ;CLEAR 2ND WORD OF ACC
BLT T1,ACCSIZ-1(ACC) ;CLEAR THE REST OF THE ACC
GTAD
MOVEM T1,ACCCRT(ACC) ;STORE TIME WHEN REQUEST WAS RECEIVED
MOVEI T2,ACCLNK(ACC) ;GET ADDRESS OF ACC LINKAGE WORD
SKIPN IABQDB ;WAS THIS THE LAST FREE ACC?
JRST [ MOVEI T1,IABQDB ;YES, CAN'T GIVE IT AWAY
CALLRET QMQH] ;PUT ON INACTIVE QUEUE AND TAKE +1
MOVEI T1,AABQDB ;NOT THE LAST FREE ONE
CALL QMQT ;QUEUE TO TAIL OF ACTIVE QUEUE
RETSKP
;SNDACC - SEND ACCOUNTING INFORMATION TO MONITOR
;ACCEPTS: T1/ TYPE OF ENTRY
; ACC/ ADDRESS OF ACCOUNT BLOCK
;RETURNS: +1, ALWAYS
SNDACC: MOVE T4,T1 ;SAVE TYPE OF ENTRY
GTAD ;GET CURRENT DATE AND TIME
SUB T1,ACCSVT(ACC) ;SUBTRACT SERVICED TIME GIVING DAYS,,FRACTION
MOVEM T1,ACCEUT(ACC) ; AND STORE. CHKPNT WILL CONVERT TO SECONDS.
MOVE T1,T4 ;RESTORE TYPE OF ENTRY
MOVEI T2,USRNAM ;MOVE COMMON INFO FROM ACCOUNT BLOCK
HRLI T2,ACCUSR(ACC) ; TO USAGE AREA
BLT T2,USRNAM+ACCCSZ-4
LOAD T2,ACCJN ;GET JOB NUMBER
MOVEM T2,JOBNO
HRRE T2,ACCNO(ACC) ;[6027]GET LINE # (use HRRE to extend sign bit)
MOVEM T2,LINO
MOVEI T2,USGSTR ;ASSUME STRUCTURE RECORD
CAIE T1,.UTMNT ;IS IT A STRUCTURE?
MOVEI T2,USGMTA ;NO, IT'S A MAGTAPE ENTRY
MOVEI T1,.USENT ;WRITE AN ENTRY INTO SYSTEM DATA FILE
SKIPN TSTF ;DON'T MAKE USAGE ENTRY IF TESTING
USAGE
ERCAL WOUSGF ;REPORT ERROR
SETZM JOBNO ;ZERO USAGE AREA
MOVE T1,[JOBNO,,JOBNO+1]
BLT T1,JOBNO+USGSIZ-2
RET
;STONAM - STORE USER'S NAME INTO ACCOUNT BLOCK
;ACCEPTS: T1/ USER NUMBER
;RETURNS: +1, FAILURE, COULD NOT FIND USER
; +2, SUCCESS
STONAM: MOVE T2,[-2,,Q1]
MOVEI T3,.JITNO ;GET TERMINAL AND USER NUMBERS
GETJI
RET ;USER NOT AROUND
SKIPN Q2 ;IS USER REALLY THERE?
RET ;NO
STOR Q1,ACCLN ;STORE LINE NUMBER
HRROI T1,ACCUSR(ACC) ;GET USER NAME
MOVE T2,Q2
DIRST
JFCL ;CAN'T GET NAME
RETSKP
;STOSTR - STORE STRUCTURE INFO INTO USAGE BLOCK
;ACCEPTS: ACC/ ADDRESS OF ACCOUNT BLOCK
;RETURNS: +1, ALWAYS
STOSTR: MOVE T1,ACCSTN(ACC) ;GET STRUCTURE NAME
MOVEM T1,USTNM
LOAD T1,ACCKT ;GET CONTROLLER TYPE
MOVEM T1,USTKTP
LOAD T1,ACCDT ;GET DEVICE TYPE
MOVEM T1,USTDTP
LOAD T1,ACCST ;GET STRUCTURE TYPE
MOVEM T1,USTSTP
LOAD T1,ACCNU ;GET NUMBER OF PACKS
MOVEM T1,USTTNP
LOAD T1,ACCMB ;GET MOUNT COUNT BEFORE MOUNTING
MOVEM T1,USTMC
MOVE T1,ACCDSP(ACC) ; GET DISPOSITION OF REQUEST
MOVEM T1,USTDSP ; SAVE IT
MOVEI T1,1 ;GET ACCESS TYPE
MOVEM T1,USTATP ;SAVE IT
RET
SUBTTL AVR - AUTOMATIC VOLUME RECOGNITION
; AVR - INITIATE AVR SEQUENCE FOR A TAPE DRIVE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
AVR: JN MTAJCT,,R ;EXIT IF I'M ALREADY PROCESSING
JN MTALT,,R ;EXIT IF VOLUME ALREADY RECOGNIZED
JN MTAMT,,[LOAD T1,MTASTE ;GET STATE
CAIE T1,S.INIT ;IN INIT MODE?
RET ;NO, EXIT
JRST .+1] ;YES, PROCEED
MOVE T1,MTAFLG(MTA) ;GET FLAGS
MOVEI T2,.LTUNL
TXNN T1,MA%AVS ;IS AVR SUPPORTED FOR THIS DRIVE?
STOR T2,MTALT ;NO, MUST CLASSIFY AS UNLABELED
TXNN T1,MA%AVE ;IS AVR ENABLED FOR THIS DRIVE?
JRST [ CALL REW ;NO, IS DRIVE LOADED?
RET ;NO
CALLRET WOTMD] ;YES, TELL OPERATOR ABOUT IT
MOVX T1,MA%UXV+MA%OPF
ANDCAM T1,MTAFLG(MTA) ;CLEAR LABEL-RELATED FLAGS
CALL MTAGJF ;GET JFN ON MTA DEVICE
MOVEI T1,DENMAX
STOR T1,MTADEN ;START AT HIGHEST DENSITY
; LOOP TO CHECK FOR LABEL AT ALL AVAILABLE DENSITIES
AVR2: LOAD T1,MTADEN ;GET DENSITY
CALL DRVDEN ;CAN THE DRIVE OPERATE AT THIS DENSITY?
JRST AVR2B ;NO, SKIP TO THE NEXT DENSITY
MOVEI T1,AVR2A ;ENTER AT AVR2A AFTER REWIND
CALL REWEA ;TRY TO REWIND
JRST AVR3 ;CAN'T REWIND, WRAP UP AVR
RET ;EXIT UNTIL REWIND COMPLETES
; END-ACTION FOR REWIND
AVR2A: CALL CHKLT ;CHECK LABEL TYPE OF THE TAPE
SKIPA ;CAN'T READ TAPE AT THIS DENSITY
JRST AVR3 ;TAPE WAS IDENTIFIFED AT THIS DENSITY
AVR2B: DECR MTADEN ;NEXT DENSITY
JN MTADEN,,AVR2 ;GO AROUND FOR ANOTHER TRY
; NOTHING CAN BE READ FROM THIS TAPE
MOVEI T1,.SFTDF
TMON ;GET TAPE-MOUNT CONTROLS SET BY SETSPD
JXN T2,MT%UUT,[CALL UNLOAD ;IF UNLOAD SET BY INSTALLATION, DO IT
CALL MTARJF ;DUMP JFN
CALL WOLRDX ;TELL OPERATOR
JRST AVR4] ;GO CHECK WAITING RSB'S
; MTA STATUS BLOCK NOW REFLECTS THE ATTRIBUTES OF THE AVR'ED VOLUME
AVR3: CALL MTARJF ;DUMP JFN
LOAD T1,MTASTE
CAIN T1,S.INIT ;DRIVE IN INITIALIZE MODE?
JRST [ CALLRET KVITAV] ;YES, SPECIAL EXIT
CALL CKMPAV ;DRIVE STILL AVAILABLE?
CALL DACMTA ;NO, HERE IS A GOOD PLACE TO DEACTIVATE
MOVE T1,MTAFLG(MTA)
JXE T1,MA%LOD,AVR4 ;WRAP UP IF DRIVE NOT LOADED
CALL WOTMD ;TELL OPERATOR TAPE IS MOUNTED
CALL WOCKSW ;IS THIS A WRITE-PROTECTED SCRATCH TAPE?
JRST AVR4 ;YES, DRIVE UNLOADED AND MESSAGE TYPED
SKIPN MTAVOL(MTA) ;HAS THE VOLUME BEEN IDENTIFIFED?
RET ;NO, MUST WAIT FOR KEYIN
CALL MATCHV ;YES, TRY FOR A MATCH
; CHECK IF NECESSARY TO TELL THE OPERATOR OF PENDING TAPE MOUNT REQUESTS
AVR4: QSCANI ARBQDB ;SET UP TO SCAN REQUEST QUEUE
AVR41: CALL NMTRSB ;GET NEXT TAPE REQUEST IN RSB AC
RET ;NONE LEFT
CALL WOVMT ;TELL OPERATOR IF NECESSARY
JRST AVR41 ;LOOP THRU ALL REQUESTS
; CHKLT - IDENTIFY LABEL TYPE OF A TAPE AND UPDATE MTA STATUS BLOCK
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: COULD NOT READ ANY INFORMATION FROM THE TAPE
; +2: TAPE WAS IDENTIFIED AT DENSITY IN MTADEN
CHKLT: SAVEQ
; Q1/ BIT 01 SET - VOL1 ACCESSIBILITY IS NOT BLANK
; BIT 02 SET - HDR1 ACCESSIBILITY IS NOT BLANK
; BIT 04 SET - OVERWRITE ACCESS DENIED - WORLD DP%CN IS RESET
; BIT 10 SET - OVERWRITE ACCESS DENIED - WORLD FP%WR IS RESET
; Q2/ 1 = READING CORE-DUMP MODE, 0 = READING INDUSTRY-COMPATIBLE MODE
; Q3/ CONTENTS OF MTAVOL AT TIME CHKLT WAS CALLED (USED TO RESTORE
; MTAVOL IF TAPE HAS A VOL1 BUT NO HDR1)
MOVE Q3,MTAVOL(MTA) ;REMEMBER CURRENT VOLID
SETZ Q1,
MOVEI T1,.LTUNL
STOR T1,MTALT ;SET UNLABELED INITIALLY FOR LBLICV
CALL MTAOPI ;OPEN MTA JFN
RETSKP ;OFFLINE
; CHECK FOR AND PROCESS VOL1 LABEL
; THE FIRST READ IS DONE IN CORE-DUMP MODE TO ALLOW FOR READING THE
; LARGEST POSSIBLE RECORD THAT TOPS-20 CAN WRITE (MOST LIKELY CASE
; SEEMS TO BE AN UNLABELED DUMPER TAPE WITH A LARGE BLOCKING FACTOR).
; BITS 0-31 OF THE FIRST WORD LOOK THE SAME IN CORE-DUMP AND I/C MODES,
; AND THAT'S THE FIRST 4 FRAMES OF THE RECORD (ALL I CARE ABOUT HERE).
; IF IT'S A VOL1, THEN REWIND AND READ IT AND ALL OTHER LABELS IN I/C
; MODE. IF IT'S NOT A VOL1, THEN JUST CLASSIFY THE TAPE AS UNLABELED.
MOVEI Q2,1 ;SETUP Q2 FOR LOOPING
CHKL1: CALL REW ;REWIND TO TEST IF DRIVE IS ONLINE
JRST [ CALL MTACLS ;OFFLINE, CLOSE JFN
RETSKP] ;PREVENT CHECKING OTHER DENSITIES
LOAD T1,MTAJFN ;GET JFN
MOVEI T2,.MOSDM ;MTOPR FUNCTION CODE
MOVE T3,[EXP .SJDM8,.SJDMC](Q2) ;GET DESIRED DATA MODE
MTOPR ;SET DATA MODE
CALL RDLBL ;TRY TO READ 1ST RECORD FROM TAPE
JRST [ JUMPLE T1,CHKLR1 ;TIMEOUT OR DATA ERROR
SKIPG Q2 ;SKIP IF CORE-DUMP READ
SETZM LBUF1 ;NON-LABEL READ SUCCESSFULLY
JRST .+1] ; SO FORCE CHKV1 TO SAY IT'S UNLABELED
SOJE Q2,[LOAD T1,MTAJFN ;FIRST READ ATTEMPT, GET JFN
MOVEI T2,.MORDN ;FUNCTION = READ DENSITY
MTOPR ;GET DENSITY THE TAPE WAS READ AT IN T3
STOR T3,MTADEN ;REMEMBER IT
CALL CHKV1A ;IS IT A VOL1?
JRST CHKLP ;NO, CLASSIFY AS UNLABELED
JRST CHKL1] ;YES, REWIND AND READ IN I/C MODE
CALL CHKV1 ;CHECK FOR VOL1, FILL IN STATUS BLOCK
JRST CHKLP ;NOT LABELED (SHOULD NEVER GET HERE)
CAIE T1," " ;VOL1 ACCESSIBILITY BLANK?
TRO Q1,1 ;NO, SET FLAG
SETZM MTASET(MTA) ;LABELED TAPE - CLEAR SETNAME
JUMPE T2,CHKL2 ;JUMP IF IT CAN'T BE A TOPS-20 TAPE
; CHECK FOR AND PROCESS VOL2 LABEL
CALL RDLBL ;YES, GET LABEL AFTER VOL1
JRST CHKLUN ;NO LABEL AFTER VOL1, IT'S UNLABELED
CALL CHKV2 ;IS IT A VOL2?
JRST CHKL3 ;NO
STOR T1,MA%SCR,MTAFLG(MTA) ;YES, STORE SCRATCH FLAG
TRNN T2,DP%CN ;WORLD DP%CN RESET?
TRO Q1,4 ;YES, SET DP%CN ACCESS-DENIED FLAG
MOVEI T1,.LTT20
STOR T1,MTALT ;SET LABEL-TYPE TO TOPS-20
; CHECK FOR AND PROCESS HDR1 LABEL
CHKL2: CALL RDLBL ;GET NEXT LABEL
JRST CHKLUN ;NO LABEL HERE, TAPE IS UNLABELED
CHKL3: MOVE T1,LBUF2 ;GET FIRST 5 CHARACTERS FROM RECORD
TRZ T1,77777 ;KEEP THE FIRST 3 CHARACTERS
CAME T1,[ASCIZ/VOL/] ;IS IT A VOL
CAMN T1,[ASCIZ/UVL/] ; OR A UVL?
JRST CHKL2 ;YES, CONTINUE SEARCH
CALL CKHDR1 ;IF HDR1, UPDATE STATUS BLOCK
JRST CHKLUN ;NOT HDR1, TAPE IS UNLABELED
CAIE T1," " ;HDR1 ACCESSIBILITY BLANK?
TRO Q1,2 ;NO, SET FLAG
; CHECK FOR AND PROCESS HDR2 LABEL
CALL RDLBL ;GET NEXT LABEL
JRST CHKLP ;NO LABEL
CALL CKHDR2 ;CHECK IF HDR2
JRST CHKLP ;NOT HDR2
TRNN T1,FP%WR ;WORLD WRITE-ACCESS ALLOWED TO FILE?
TRO Q1,10 ;NO, SET WRITE-ACCESS DENIED
CHKLP: CALL CHKLR1 ;REWIND AND CLOSE JFN
LOAD T1,MTALT ;GET LABEL TYPE
CAIN T1,.LTANS ;ANSI?
JRST [ TRNE Q1,1+2 ;YES, ANY NON-BLANK ACCESSIBILITIES?
JRST CHKLPS ;YES, SET PROTECTED
JRST CHKLPR] ;NO, RESET PROTECTED
CAIN T1,.LTT20 ;TOPS-20?
JRST [ TRNE Q1,4 ;YES, WORLD WRITE ACCESS DENIED TO VOL?
JRST CHKLPS ;YES, SET PROTECTED
TRNE Q1,2 ;RESET PROT IF FILE ACCESSIBILITY BLANK
TRNN Q1,10 ; OR IF WORLD WRITE ACCESS IS ALLOWED
JRST CHKLPR
JRST CHKLPS] ;NEITHER, SET PROTECTED
RETSKP
CHKLPS: SETONE MA%OPF,MTAFLG(MTA) ;SET OVERWRITE-PROTECTED FLAG
CHKLPR: JE MA%SCR,MTAFLG(MTA),RSKP ;RETURN IF NOT SCRATCH
MOVX T1,MA%OPF+MA%UXV ;IT'S A SCRATCH TAPE
ANDCAM T1,MTAFLG(MTA) ;TURN OFF OVERWRITE INHIBITORS
RETSKP
CHKLR1: CALL REW ;GET BACK TO BOT
JFCL ;OFFLINE, WILL BE CAUGHT BY AVR
CHKLID: CALL MTACLS ;CLOSE MTA
RET
; TAPE HAS A VOL1 BUT NO HDR1 - CLASSIFY IT AS UNLABELED
CHKLUN: MOVEI T1,.LTUNL
STOR T1,MTALT ;SET LABEL TYPE TO UNLABELED
MOVEM Q3,MTAVOL(MTA) ;REPLACE OLD VOLID
JRST CHKLP ;WRAP UP AND EXIT
; CHKV1 - IDENTIFY A VOLUME WHOSE FIRST RECORD IS IN LBUF1
; MTA/ ADDR OF MTA STATUS BLOCK
; LBUF1/ UNMODIFIED RECORD READ FROM TAPE
; RETURNS +1: VOLUME IS UNLABELED, MTALT UPDATED
; +2: VOLUME IS LABELED, MTALT AND MTAVOL UPDATED
; T1/ VOL1 ACCESSIBILITY CHARACTER
; T2/ 1 MEANS VOL1 MEETS NECESSARY CONDITIONS FOR
; CLASSIFICATION AS TOPS-20 LABEL TYPE, ELSE 0
; CHKV1A - DETERMINE IF RECORD IN LBUF1 (IN CORE-DUMP FORMAT) IS A VOL1
; LBUF1/ UNMODIFIED RECORD READ FROM TAPE IN CORE-DUMP MODE
; RETURNS +1: NOT A VOL1
; +2: IS A VOL1
CHKV1: TDZA T1,T1 ;REMEMBER CHKV1 ENTRY
CHKV1A: MOVEI T1,1 ;REMEMBER CHKV1A ENTRY
SAVET ;SET UP TO RETURN VALUES TO CALLER
SETZM CT2 ;SET NOT TOPS-20
MOVE T2,LBUF1 ;GET 1ST 4 FRAMES FROM TAPE
TRZ T2,17 ;B32-B35 MEANINGLESS, SO SET TO ZERO
CAMN T2,[713533,,237420] ;EBCDIC VOL1?
JRST [ MOVEI T1,.LTEBC ;YES, SET LABEL TYPE TO EBCDIC
JRST CHKV11] ;SKIP OTHER TESTS
TDZ T2,[1B0+1B8+1B16+1B24] ;CLEAR 8TH BITS FOR ASCII CHECK
CAMN T2,[BYTE(8) "V","O","L","1"] ;ASCII VOL1?
JRST [ MOVEI T1,.LTANS ;YES, IS EITHER ANSI OR TOPS-20
JRST CHKV11] ; BUT ASSUME ANSI FOR NOW...
CHKV12: MOVEI T1,.LTUNL
SKIPN CT1 ;DON'T STORE LABEL TYPE IF CHKV1A
STOR T1,MTALT ;SET LABEL TYPE = UNLABELED
RET ;+1 RETURN FOR UNLABELED
; VOL1 LABEL WAS FOUND
CHKV11: SKIPE CT1 ;CHKV1A ENTRY?
RETSKP ;YES, INDICATE RECORD WAS A VOL1
STOR T1,MTALT ;STORE LABEL TYPE IN MTA TABLE
CALL LBLICV ;CONVERT LABEL TO 7-BIT ASCII
MOVE T1,[ILPTR(V1VID)] ;ADDRESS VOLID FIELD IN VOL1
MOVEI T2,6 ;6-CHARACTER FIELD
CALL CVTA6 ;CONVERT VOLID TO SIXBIT
JRST CHKV12 ;BAD VOLID, SO ASSUME UNLABELED
; GIVE ERROR IF VOLID FROM "IDENTIFY" COMMAND DOESN'T MATCH THE
; ACTUAL VOLID THAT IS RECORDED ON THE TAPE
MOVEM T1,MTAVOL(MTA) ;STORE ACTUAL VOLID IN MTA STATUS BLOCK
SKIPE MTAIDV(MTA) ;DOES ALLEGED VOLID EXIST?
CAMN T1,MTAIDV(MTA) ;YES, ALLEGED VOLID MATCH ACTUAL VOLID?
SKIPA ;NO ALLEGED VOLID, OR IT MATCHES ACTUAL
CALL [ TMCT <%I%M Cannot Change Volid Of Labeled Tape>
MOVEI T3,TMCMSG ;POINT TO MESSAGE
CALLRET BTWTON] ;TELL OPERATOR HE BLEW IT
SETZM MTAIDV(MTA) ;CLEAR ALLEGED VOLID
; COPY VOL1 TO MTA STATUS BLOCK AND CHECK FOR TOPS-20 LABEL TYPE
MOVSI T1,LBUF1 ;BLT SOURCE
HRRI T1,MTAV1(MTA) ;BLT DESTINATION
BLT T1,MTAV1+LB8WDS-1(MTA) ;TRANSFER VOL1 LABEL TO STATUS BLOCK
LDB T1,[LPTR(V1ACS)] ;GET ACCESSIBILITY CHARACTER
MOVEM T1,CT1 ;RETURN ACCESSIBILTY TO CALLER
CAIE T1,"1" ;TOPS-20 PROTECTION?
RETSKP ;NO, WILL CLASSIFY AS ANSI TAPE
MOVE T1,[ILPTR(V1SCD)] ;GET POINTER TO SYS CODE IN VOL1
MOVE T2,[POINT 7,T20SCD] ;GET POINTER TO TOPS-20 SYS CODE
CHK201: ILDB T3,T1 ;GET CHAR FROM VOL1
ILDB T4,T2 ;GET CHAR FROM TOPS-20 SYS CODE
JUMPE T4,[AOS CT2 ;MATCH SUCCESSFUL, SET TOPS-20 VOL1
RETSKP]
CAMN T3,T4 ;MATCH SO FAR?
JRST CHK201 ;YES, CONTINUE SCAN
RETSKP ;RETURN, NON-TOPS-20 VOL1
; TOPS-20 SYSTEM CODE
T20SCD: ASCIZ /DECSYS20** /
; CHKV2 - EXAMINE LABEL BUFFER FOR VOL2 RECORD
; LBUF2/ RECORD TO BE EXAMINED
; RETURNS +1: RECORD IS NOT A VOL2
; +2: RECORD IS A VOL2
; T1/ 0=NON-SCRATCH 1=SCRATCH
; T2/ TOPS-20 VOLUME PROTECTION CODE
CHKV2: SAVET ;SET UP TO RETURN VALUES TO CALLER
SETZM CT1
MOVE T1,LBUF2 ;GET FIRST 5 CHARS OF LABEL
TRZ T1,377 ;MASK DOWN TO 4 CHARACTERS
CAME T1,[ASCII/VOL2/] ;IS IT A VOL2?
RET ;NO, RETURN +1
MOVSI T1,LBUF1 ;BLT SOURCE
HRRI T1,MTAV2(MTA) ;BLT DESTINATION
BLT T1,MTAV2+LB8WDS-1(MTA) ;TRANSFER VOL2 LABEL TO STATUS BLOCK
MOVE T1,[ILPTR(V2PRO)] ;GET POINTER TO PROTECTION FIELD
CALL PROTIN ;GET PROTECTION IN T1
MOVEI T1,777777 ;BAD PROTECTION, ASSUME ACCESSIBLE
MOVEM T1,CT2 ;RETURN PROTECTION CODE TO CALLER
MOVE T2,[ILPTR(V2OWN)] ;GET POINTER TO VOL2 OWNER-NAME FIELD
MOVEI T3,V2OWNL ;GET # OF CHARACTERS TO SCAN
CHKV21: ILDB T4,T2 ;GET A CHAR FROM OWNER'S NAME
CAIE T4," " ;SPACE?
RETSKP ;NO, NOT SCRATCH SO RETURN
SOJG T3,CHKV21 ;CONTINUE SCAN
AOS CT1 ;SCAN COMPLETE, IT'S A SCRATCH
RETSKP
; CKHDR1 - CHECK LBUF2 FOR HDR1 AND PROCESS HDR1 FIELDS
; LBUF2/ LABEL TO BE EXAMINED
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: NOT HDR1 LABEL
; +2: WAS HDR1 LABEL, INFORMATION STORED IN MTA STATUS BLOCK
; T1/ HDR1 ACCESSIBILITY CODE
CKHDR1: MOVE T1,LBUF2 ;GET FIRST 5 CHARS OF LABEL
TRZ T1,377 ;MASK DOWN TO 4 CHARACTERS
CAME T1,[ASCII/HDR1/] ;IS THIS A HDR1?
RET ;NO
MOVE T1,[ILPTR(H1SET)] ;YES, POINT TO SETNAME FIELD
MOVEI T2,6 ;6-CHARACTER FIELD
CALL CVTA6 ;CONVERT SETNAME TO SIXBIT
SETZ T1, ;BAD SETNAME, ASSUME NONE
MOVEM T1,MTASET(MTA) ;STORE SET NAME IN STATUS BLOCK
MOVE T1,[ILPTR(H1EXP)] ;POINT AT EXPIRATION-DATE FIELD
CALL LDATIN ;CONVERT THE DATE FROM THE LABEL
SETZ T1, ;BAD DATE, ASSUME EXPIRED
SETO T2, ;SPECIFY CURRENT DATE/TIME
MOVX T4,IC%JUD ;WANT JULIAN FORM
ODCNV ;GET T2/ YEAR,,JULIANDAY
MOVX T3,MA%UXV
CAMLE T1,T2 ;IS THE TAPE EXPIRED?
IORM T3,MTAFLG(MTA) ;NO, SET NOT-EXPIRED FLAG
LDB T1,[LPTR(H1ACS)] ;GET ACCESSIBILITY CODE FOR CALLER
RETSKP
; CKHDR2 - CHECK LBUF2 FOR HDR2 LABEL
; LBUF2/ LABEL TO BE EXAMINED
; RETURNS +1: NOT HDR2
; +2: HDR2, T1/ TOPS-20 FILE PROTECTION CODE
CKHDR2: MOVE T1,LBUF2 ;GET 5 CHARS
TRZ T1,377 ;MASK DOWN TO 4 CHARACTERS
CAME T1,[ASCII/HDR2/] ;HDR2?
RET ;NO
MOVE T1,[ILPTR(H2PRO)] ;GET POINTER TO PROTECTION CODE FIELD
CALL PROTIN ;GET PROTECTION
MOVEI T1,777777 ;ERROR, ASSUME UNPROTECTED
RETSKP
; LBLICV - CONVERT INDUSTRY-COMPATIBLE LABEL IN LBUF1 TO 7-BIT ASCII
; LABEL IN LBUF2, USING THE FOLLOWING RULES:
; NO CONVERSION PERFORMED FOR UNLABELED TAPES
; ANSI AND TOPS-20 LABEL TYPES ASSUMED TO BE 8-BIT ASCII
; EBCDIC LABEL TYPE ASSUMED TO BE 8-BIT EBCDIC
; LBUF1/ LABEL TO BE CONVERTED, 80 8-BIT BYTES
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, LBUF2/ 7-BIT ASCII EQUIVALENT OF LABEL IN LBUF1
LBLICV: SAVEQ
LOAD T1,MTALT ;GET LABEL TYPE IN T1
CAIN T1,.LTUNL ;UNLABELED?
RET ;YES, RETURN TAKING NO ACTION
DMOVE Q1,[POINT 8,LBUF1 ;GET LOAD POINTER IN Q1
POINT 7,LBUF2] ;GET GET STORE POINTER IN Q2
MOVEI T2,LBLSIZ ;GET # OF FRAMES TO PROCESS
LBLCV1: ILDB T3,Q1 ;GET A BYTE FROM LBUF1
CAIN T1,.LTEBC ;EBCDIC LABEL?
JRST [ ADJBP T3,[POINT 7,EATT,6] ;YES, POINT AT ASCII EQUIV.
LDB T3,T3 ;GET ASCII EQUIVALENT IN T3
JRST .+1]
IDPB T3,Q2 ;STORE CHARACTER IN LBUF2
SOJG T2,LBLCV1 ;LOOP THRU ENTIRE BUFFER
RET
; RDLBL - READ A LABEL FROM A TAPE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: T1/ -1 = READ I/O OPERATION TIMED OUT
; T1/ 0 = DEVICE OR DATA ERROR ON READ
; T1/ 1 = TAPE MARK OR RECORD .LT. 80 FRAMES READ
; +2: RECORD OF 80 BYTES OR LONGER READ SUCCESSFULLY INTO
; LBUF1 IN INDUSTRY-COMPATIBLE FORMAT; ASCII EQUIVALENT
; LABEL IN LBUF2
RDLBL: MOVE T1,[IOWD LBUF1W,LBUF1] ;GET IOWD FOR ENTIRE BUFFER
SKIPN READCL ;FIRST READ SINCE I STARTED?
MOVEM T1,READCL ;YES, SET UP TRIAL IOWD, EXPECT DUMPX3
RDLBL0: LOAD T1,MTAJFN
MOVEI T2,READCL ;GET ADDRESS OF COMMAND LIST
IOXCT DUMPI,RDLBL1,RDLBL2 ;EXECUTE AND TIME OUT DUMPI JSYS
JRST RDLBL3 ;SUCCESSFUL (PROBABLY VERY RARE)
; ERROR RETURN FROM DUMPI
RDLBL1: CALL CLRTAP ;CLEAR ERRORS AND GET ERROR INFO
JRST RDLBL2 ;TIMED OUT
CAIN T1,DUMPX3 ;RECORD SIZE TOO LARGE?
JRST [ MOVSI T1,1000 ;YES
ADDM T1,READCL ;REDUCE IT BY A PAGE
JRST RDLBL0] ;TRY IT AGAIN WITH SMALLER RECORD SIZE
CAIN T1,IOX4
JRST [ MOVEI T1,1 ;TAPE MARK, SET NON-LABEL
RET]
CAIE T1,IOX5 ;DEVICE OR DATA ERROR?
CALL STOP ;NO, I CAN'T HANDLE THIS ONE
TXNE T2,MT%DVE+MT%DAE ;DEVICE ERROR OR DATA ERROR?
JRST [ SETZ T1, ;YES
RET]
CAIGE T3,LBLSIZ ;IS THE RECORD LONG ENOUGH?
JRST [ MOVEI T1,1 ;NO
RET]
RDLBL3: CALL LBLICV ;GOOD LABEL, CONVERT IT
RETSKP ;SUCCESSFUL RETURN
; DUMPI DID NOT COMPLETE IN TIME
RDLBL2: CALL WOTIMO ;REPORT TIMEOUT TO OPERATOR
SETO T1, ;RETURN -1
RET
; POLLR - SELF-PERPETUATING PERIODIC MAGTAPE POLLING ROUTINE
; CHECKS FOR ONLINE-TO-OFFLINE AND OFFLINE-TO-ONLINE TRANSITIONS
; RETURNS +1: ALWAYS
POLLR: TXO F,POLLF ;CAUSE CHECKS FOR ONLINE-TO-OFFLINE
CALL TDSCIR ;PERFORM DRIVE SCAN
TXZ F,POLLF
MOVEI T1,POLINT ;GET INTERVAL BETWEEN POLLS
MOVEI T2,POLLR ;ROUTINE ADDRESS
CALLRET SRAI ;SCHEDULE NEXT POLL AND EXIT
; TDSCIH - CALLED AS A RESULT OF MTA STATUS CHANGE INTERRUPTS
TDSCIH: AOSE TDSCF ;SCHEDULING REQUEST PRESENT ALREADY?
DEBRK ;YES, EXIT
CALL EIHR ;NO, REQUEST SCHEDULING AT TDSCIR
EXP TDSCIR
; TDSCIR - CALLED BY SCHEDULER, REQUESTED BY TDSCIH
; RETURNS +1: ALWAYS
TDSCIR: SAVEQ
SAVEAC <MTA>
SETOM TDSCF ;SET NO SCHEDULER REQUESTS FOR TDSCIR
MOVE Q1,MTAN ;GET # OF MTA DEVICES ON SYSTEM
MOVEI MTA,MTA0-MTASZ ;INIT MTA STATUS BLOCK POINTER
; I DON'T KNOW WHICH DRIVE DID IT, SO I HAVE TO CHECK EVERY ONE
TDSCI1: SOJL Q1,R ;EXIT IF NO MTA DEVICES LEFT TO CHECK
ADDI MTA,MTASZ ;GET STATUS BLOCK ADDRESS
CALL TDSC1 ;CHECK IT FOR A STATUS CHANGE
JRST TDSCI1 ;LOOP THRU ALL DRIVES
; TDSC1 - CHECK TAPE DRIVE FOR ONLINE/OFFLINE/REWIND-COMPLETE TRANSITION
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
TDSC1: SAVEQ
LOAD T1,MTASTE ;GET STATE
JUMPE T1,R ;IGNORE IF NOT AVAILABLE
CAIE T1,S.INIT ;IN INIT MODE?
JRST [ JN MTAMT,,R ;NO, EXIT IF USER HAS THE DRIVE
JRST .+1]
CALL MTAGJF ;GET JFN NOW TO REDUCE GTJFN OVERHEAD
MOVE Q1,MTAFLG(MTA) ;Q1/ MTA FLAGS
CALL GMTADS
MOVE Q2,T1 ;Q2/ MTA STATUS BITS FROM MONITOR
JXN Q2,SJ%OFS,[TXZE Q1,MA%LOD ;IF OFFLINE, DID I THINK SO TOO?
CALL WOUNLW ;NO, ADMONISH OPERATOR
MOVEM Q1,MTAFLG(MTA) ;UPDATE FLAGS
JRST .+1]
LOAD Q3,MTAREA ;END-ACTION ADDRESS PRESENT?
JUMPN Q3,TDSC11 ;YES
TXNE Q1,MA%LOD ;PROCEED IF I THINK DRIVE IS UNLOADED
TXNE Q1,MA%ULP ;PROCEED IF UNLOAD PENDING
JRST TDSC11 ;ONE OF THE ABOVE WAS TRUE
TXNN F,POLLF ;POLLING?
JRST [ CALLRET MTARJF] ;NO, NO NEED FOR FURTHER ANALYSIS
TDSC11: LOAD T1,SJ%WLK,Q2 ;GET WRITE-LOCKED BIT
TRC T1,1 ;COMPLEMENT TO GET WRITE-ENABLED
STOR T1,MA%WEN,MTAFLG(MTA) ;STORE HERE FOR EASY REFERENCE
; CHECK FOR PENDING UNLOAD-REQUEST OR REWIND-ENDACTION
TXZE Q1,MA%ULP ;WAS AN UNLOAD-REQUEST PENDING?
JRST [ JXN Q2,SJ%REW,[CALLRET MTARJF] ;YES
MOVEM Q1,MTAFLG(MTA) ;RESET MA%ULP IN STATUS BLOCK
CALL UNLOAD ;UNLOAD THE DRIVE
JRST .+1]
JUMPN Q3,[JXN Q2,SJ%REW,[CALLRET MTARJF] ;EXIT IF REWINDING
SETZRO MTAREA ;CLEAR END-ACTION ADDRESS
CALL MTARJF ;DUMP JFN
CALLRET (Q3)] ;CALL END-ACTION ROUTINE AND RETURN
; DRIVE NOT UNDER USER CONTROL AND AVR SEQUENCE NOT IN PROGRESS
TXNN F,POLLF ;CHECK FOR ANY TRANSITION IF POLLING
TXNN Q1,MA%LOD ;EXIT IF I THINK THE DRIVE IS LOADED
CAIA ;POLLING OR DRIVE UNLOADED
JRST [ CALLRET MTARJF] ;NOT POLLING AND DRIVE LOADED
CALL REW ;IS IT LOADED NOW?
JRST [ TXNE Q1,MA%LOD ;NO, DID I THINK IT WAS LOADED?
CALL WOUNLW ;YES, ADMONISH OPERATOR
CALLRET MTARJF] ;DUMP JFN AND RETURN
CALL MTARJF ;YES, DUMP JFN SO AVR CAN OCCUR
TXNE Q1,MA%LOD ;HAS IT BEEN ONLINE ALL ALONG?
RET ;YES, TAKE NO ACTION
; DRIVE IS COMING ON-LINE
SETONE MA%LOD,MTAFLG(MTA) ;SET DRIVE-LOADED
MOVX T1,MA%SCR+MA%UXV+MA%OPF+MA%ULP+MA%VMG
ANDCAM T1,MTAFLG(MTA) ;CLEAR VARIOUS FLAGS
SETZB T1,MTAVOL(MTA) ;SET VOLUME NOT IDENTIFIED (YET)
SETZM MTAIDV(MTA) ;CLEAR OPERATOR-SUPPLIED VOLID
STOR T1,MTALT ;SET RECOGNITION NOT ATTEMPTED (YET)
LOAD T1,MTASTE
CAIN T1,S.INIT ;DRIVE IN INITIALIZE MODE?
JRST [ CALLRET KVITAV] ;YES, SPECIAL EXIT
CALLRET AVR ;PERFORM IDENTIFICATION SEQUENCE
NOSHIP,<
SUBTTL DECTAPE SUPPORT
; RLSDTA - PROCESS RELEASE OF ALLOC'ED DECTAPE DEVICE
; T1/ DEVICE DESIGNATOR
; RETURNS +1: ALWAYS
RLSDTA: SAVEQ
MOVE Q1,T1 ;SAVE DESIGNATOR
MOVE T2,T1 ;COPY DESIGNATOR TO T2 FOR ALLOC
MOVEI T1,.ALCAL ;ALLOC FUNCTION CODE
MOVNI T3,1 ;MAKE DTA AVAILABLE TO ALL USERS
ALLOC
JFCL ;IGNORE FAILURE
; FIND REQUEST THAT WAS USING THIS DECTAPE AND DELETE IT
TMCT <%I%5V Released>
QSCANI ARBQDB ;SET UP TO SCAN REQUEST QUEUE
RDTA1: CALL NXXRSB ;GET ADDRESS OF NEXT ACTIVE RSB
JRST RDTA2 ;NONE LEFT
LOAD T1,RSBTYP ;GET REQUEST TYPE
CAIE T1,.MNTDT ;IS IT A DECTAPE-MOUNT REQUEST?
JRST RDTA1 ;NO, SKIP IT
CAME Q1,RSBDTA(RSB) ;DOES THIS REQUEST OWN THE DECTAPE?
JRST RDTA1 ;NO
LOAD T1,RSBJNO ;GET OWNER'S JOB #
TMCT < by job %1D>
ABTREQ (ABRTNR) ;FOUND THE OWNER, DELETE REQUEST
RDTA2: MOVEI T3,TMCMSG ;GET ADDRESS OF MESSAGE
CALLRET BTWTON ;TELL OPR'S THAT DECTAPE WAS RELEASED
; TLUDT - BUILD BLOCKS FOR SUCCESSFUL DECTAPE-MOUNT RESPONSE
; (CALLED BY TELUSR)
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ FLAGS FOR GALAXY MSG HEADER
TLUDT: STKVAR <<DVBLK,3>>
CALL VQGCV ;GET VOLID IN T1
TMCT <%I[DECtape volume %1S mounted]%_>
MOVEI T1,TMCMSG ;GET ADDRESS OF TEXT
MOVEI T2,.MNRTX ;GET ARGUMENT TYPE
CALL PBTXT ;CREATE BUILDING BLOCK CONTAINING TEXT
MOVE T1,[FLD(3,AR.LEN)+FLD(.MNRDV,AR.TYP)] ;GET HEADER
MOVE T2,RSBSSN(RSB) ;GET SETNAME
DMOVEM T1,DVBLK ;STORE HEADER AND SETNAME
MOVE T1,RSBDTA(RSB) ;GET DECTAPE DEVICE DESIGNATOR
MOVEM T1,2+DVBLK ;STORE DESIGNATOR IN .MNRDV BLOCK
MOVEI T1,DVBLK ;GET ADDRESS OF BLOCK
CALL PBBLK ;INSTALL BLOCK IN MESSAGE
SETZ T1, ;NO FLAGS
RET
; UDTM - PROCESS USER DECTAPE-MOUNT REQUEST RECEIVED FROM QUASAR
; T1/ ADDRESS OF DECTAPE-MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
UDTM: MOVEI T2,[[ MOVX T1,TM%WEN ;ROUTINE TO PROCESS FLAGS
AND T1,.MEFLG(Q1)
MOVEM T1,RSBUFL(RSB)
RETSKP]
BTRSET ;SETNAME
BTRVLS ;VOLID LIST
BTRRMK ;REMARK
0]
CALL BTMRSB ;BUILD RSB
RET ;ABORTED, EXIT
MOVEI T1,1
STOR T1,RSBCV ;CURRENT VOLUME = 1
CALL PWATCH ;ABORT REQUEST IF USER DELETES PID
MOVEI T1,RST.WM
STOR T1,RSBSTE ;SET STATE = WAITING FOR MOUNT
; BUILD HEADER LINE
UDTM1: MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%IDECtape Mount Request # %1D>
CALL CPYHDR ;COPY HEADER TO OPRHDR
; BUILD BODY OF MESSAGE
CALL VQGCV ;GET CURRENT VOLID IN T1
TMCT <%IMount volume %1S%_%U>
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T1,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
TMCT <%_User's remark: %1A>
JRST .+1]
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <
RESPOND msg# DTAn:
or
DELETE MOUNT-REQUEST %1D /REASON:reason>
; SEND MESSAGE AND GET RESPONSE
MOVEI T2,RSBWTB(RSB) ;GET WTB ADDRESS
MOVEI T3,OPRHDR ;GET ADDRESS OF HEADER
JSP T1,BTWTOR ;SEND WTOR AND RECEIVE REPLY
; PROCESS RESPONSE
MOVEI RSB,-RSBWTB(T2) ;LOAD RSB AC
CALL COMNDI ;INIT FOR COMND PARSING
MOVEI T2,[FLDDB. .CMDEV]
CALL COMNDX ;PARSE DEVICE NAME
UDTM2: JRST [ MOVEI T3,[ASCIZ/Response Does Not Specify DECtape/]
CALL BTACK ;REJECT IT
JRST UDTM1] ;RE-ISSUE WTOR
LOAD T1,DV%TYP,T2 ;GET DEVICE TYPE
CAIE T1,.DVDTA ;DECTAPE?
JRST UDTM2 ;NO, REJECT
MOVEI T1,.ALCAL ;GET ALLOC FUNCTION CODE
LOAD T3,RSBJNO ;GET USER'S JOB #
ALLOC ;TRY TO ALLOC DTA TO USER
JRST UDTM3 ;FAILED
; ALLOCATION SUCCESSFUL
MOVEM T2,RSBDTA(RSB) ;STORE DEVICE DESIGNATOR
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%I%2V Allocated To Request # %1D>
MOVEI T3,TMCMSG
CALL BTACK ;ACKNOWLEDGE SUCCESSFUL ALLOCATION
MOVEI T1,RST.AC
STOR T1,RSBSTE ;SET STATE TO ACTIVE
CALL TELUSR ;TELL THE USER HE GOT IT
CALLRET TCKP ;TELL QUASAR
; ALLOCATION FAILED
UDTM3: CALL [ SAVET ;PRESERVE T1-T4
TMCT <%ICannot Allocate %2V> ;BUILD HEADER
CALLRET CPYHDR] ;SAVE HEADER IN OPRHDR
CAIE T1,ALCX5 ;SOMEONE ELSE HAS IT?
JRST [ TMCT <%IError from ALLOC JSYS: %1J>
JRST UDTM4]
MOVE T1,T2 ;ANOTHER JOB HAS IT
DVCHR ;GET OWNER'S JOB # IN LH(T3)
HLRZS T3 ;MOVE TO RIGHT HALF
TMCT <%IAlready in use by job %3D>
UDTM4: MOVEI T3,OPRHDR
CALL BTACKT ;TELL OPERATOR ABOUT ALLOC FAILURE
JRST UDTM1 ;SEND WTOR AGAIN
>;NOSHIP
SUBTTL IPCF SEND AND RECEIVE
; GSYSPD - DOES MUTIL TO GET PID FROM SYSTEM PID TABLE
; T1/ INDEX INTO SYSTEM PID TABLE
; RETURNS +1: PID COULD NOT BE OBTAINED
; +2: SUCCESS, PID IN T1
GSYSPD: SKIPE TSTF ;TESTING?
JRST GSYSPT ;YES, SPECIAL CODE
SAVEAC <Q1,Q2> ;Save 2 ACs
MOVE Q1,T1 ;Save T1 for possible later use
MOVNI Q2,NTRY ;The number of MUTIL% attempts
GSYSPA: MOVE T2,Q1 ;Copy index to T2 for XMUTIL
MOVEI T1,.MURSP ;Function = return system PID
CALL XMUTIL ;Get it
JRST GSYSPB ;Error, try again up to NTRY
MOVE T1,T3 ;Copy to T1 for return
RETSKP ;Successful return
GSYSPB: AOJE Q2,GSYSPC ;Try again?
MOVEI T1,^D2000 ;Yes, but ...
DISMS ;Wait awhile
JRST GSYSPA ;Now try it again
GSYSPC: CAIN T1,IPCF27 ;System PID table slot empty?
RET ;Yes, take error return
CALL STOP ;Unexpected error
GSYSPT: STAKT
MOVE T2,[[EXP IP%CPD,0,0,<20,,TBUF+4>,.IPCIW,0],,TBUF]
BLT T2,TBUF+5 ;MOVE PDB AND PART OF MESSAGE TO BUF
SKIPL SYPIDS(T1) ;WANT USERNAME PREFIX?
JRST [ HRROI T1,TBUF+6 ;NO, SET UP DESTINATION POINTER
JRST GSYSP1] ;COPY PID NAME SANS PREFIX INTO TMSG
GJINF ;GET USER# IN T1
MOVE T2,T1 ;COPY INTO T2
MOVE T1,[POINT 7,TBUF+6] ;GET POINTER
MOVEI T3,"["
IDPB T3,T1
DIRST ;ADD USER NAME
JSHLT
MOVEI T2,"]"
IDPB T2,T1
GSYSP1: MOVE T2,CT1 ;GET SYSTEM PID TABLE INDEX
HRRO T2,SYPIDS(T2) ;GET POINTER TO STRING
SETZ T3, ;STOP ON NULL
SOUT ;ADD PID NAME
MOVEI T1,4
MOVEI T2,TBUF
MSEND ;SHIP OFF QUESTION TO INFO
JSHLT
SETZM TBUF ;CLEAR FLAGS WORD FOR RECEIVE
MOVE T3,TBUF+1 ;GET MY PID SO I CAN RECEIVE
MOVE T4,[20,,TBUF+4] ;SIZE,,MSGADDR
DMOVEM T3,TBUF+2 ;SET WORDS 2 & 3 OF PDB
MRECV ;RECEIVE INFO'S REPLY
JSHLT
LOAD T4,IP%CFE,TBUF+.IPCFL ;ERROR FROM INFO?
JUMPN T4,[MOVEI T1,.MUDES ;YES, NO SUCH PID
MOVE T2,TBUF+2 ;GET THE PID WE PICKED UP
CALL XMUTIL ;LIQUIDATE IT
JSHLT ;COULDN'T
HRROI T1,TBUF+6 ;RETURN POINTER TO PID NAME
RET]
TMSG <% MOUNTR Found PID for >
HRROI T1,TBUF+6
PSOUT
TMSG <
>
MOVEI T1,.MUDES
MOVE T2,TBUF+2 ;GET THE PID I USED FOR THIS CRAP
CALL XMUTIL ;LIQUIDATE IT
JSHLT
MOVE T1,TBUF+5 ;GET PID FOR CALLER
RETSKP ;GIVE IT TO HIM
SYPIDS: 0
0
-1,,[ASCIZ/QUASAR/]
-1,,[ASCIZ/MOUNTR/]
-1,,[ASCIZ/ORION/]
; MRCVIH - ENTERED BY SCHEDULER WHEN INTERRUPT RECEIVED FROM PID
; RETURNS +1: ALWAYS
MRCVIH: TXO F,MRMSF+MRPGF ;EXPECTING PAGE-MODE MESSAGE
; RECEIVE THE HEAD MESSAGE FROM THE QUEUE
MRCVI1: TXZN F,MRMSF ;RECEIVE QUEUE EMPTY?
RET ;YES, EXIT TO SCHEDULER
TXCN F,MRPGF ;NON-PAGE-MODE MESSAGE COMING?
JRST [ MOVX T1,IP%CFB+IP%TTL ;YES, GET FLAGS
MOVE T2,[1000,,RBUF] ;SIZE,,ADDRESS
JRST MRCVI3] ;REJOIN
MOVX T1,IP%CFB+IP%TTL+IP%CFV ;DON'T BLOCK, TRUNCATE, PAGE MODE
MOVE T2,[1000,,RBUF_-9] ;SIZE,,PAGE#
MRCVI3: MOVEM T1,.IPCFL+MRPDB ;SET FLAGS
MOVEM T2,.IPCFP+MRPDB ;SET RECEIVER BUFFER LENGTH,,ADDRESS
MOVE T3,MYPID
MOVEM T3,.IPCFR+MRPDB ;SET RECEIVER'S PID
MOVEI T1,4 ;LENGTH OF PDB
MOVEI T2,MRPDB ;ADDRESS OF PDB
MRECV ;RECEIVE THE MESSAGE
JRST [ CAIN T1,IPCFX2 ;QUEUE EMPTY?
RET ;YES, EXIT TO SCHEDULER
TXO F,MRMSF ;SET DO-MRECV FLAG
CAIN T1,IPCF16 ;WRONG MODE?
JRST MRCVI1 ;YES, TRY OTHER MODE
CALL STOP] ;CAN'T HANDLE THIS ERROR
AOS MSGSIN ;COUNT # OF MESSAGES IN
JUMPN T1,[TXNE T1,IP%CFV ;THERE IS ANOTHER MSG, WHAT MODE?
TXO F,MRPGF ;PAGE-MODE
TXO F,MRMSF ;FORCE ANOTHER MRECV
JRST .+1]
TXNN F,INITF ;DISCARD MESSAGE IF INITIALIZING
CALL MRCVPM ;PROCESS MESSAGE
JRST MRCVI1 ;GO CHECK FOR MORE MESSAGES
; REFER THE MESSAGE TO THE APPROPRIATE PROCESSING ROUTINE
MRCVPM: JN IP%CFM,MRPDB+.IPCFL,R ;DISCARD UNDELIVERED MAIL
LOAD T1,IP%CFC,MRPDB+.IPCFL ;SENT BY <SYSTEM> ?
JUMPN T1,[CALLRET MRSYS] ;YES, PROCESS IT
;**;[6036]At MRCVPM:+1L move edit 6035 two lines down JYCW Oct-18-88
MOVE T1,RBUF+.MSFLG ;[6036]Get the message flag word
TXNE T1,MF.NEB ;[6036]From NEBULA
SETOM NEBMSG ;[6036]Yes
MOVE T1,MRPDB+.IPCFS ;GET SENDER'S PID
MOVEI T2,APNUM-1 ;# OF ASSOCIATED PROCESSES - 1
MRCVAP: CAMN T1,APPID(T2) ;FROM THIS A/P?
JRST [ CALLRET @APMRC(T2)] ;YES, GIVE IT TO HIS HANDLER
SOJGE T2,MRCVAP ;NO, CHECK THE OTHERS
RET ;I DON'T KNOW THE SENDER, SO PITCH IT
; MRSYS - PROCESS IPCF MESSAGE FROM SYSTEM TASK
; T1/ SYSTEM SENDER CODE FROM IP%CFC FIELD OF PDB
; MRPDB, RBUF/ PDB AND MESSAGE
; RETURNS +1: ALWAYS
MRSYS: CAIN T1,.IPCCF ;SENT BY INFO?
JRST [ LOAD T1,IP%CFE,MRPDB+.IPCFL ;YES, GET CODE
CAIN T1,.IPCKM ;WATCHED PID DELETED?
JRST [ CALLRET INFOK] ;YES, GO PROCESS IT
CAIE T1,.IPCBP ;BAD PID (RESPONSE TO .IPCIK) ?
RET ;I DON'T RECOGNIZE IT, SO PITCH IT
CALLRET PRQPID] ;BAD PID, CHECK REQUEST QUEUE
CAIE T1,.IPCCC ;SENT BY SYSTEM IPCF?
RET ;NO, PITCH IT
HLRZ T1,MRPDB+.IPCFP ;GET SIZE OF MESSAGE
JUMPE T1,R ;NO MESSAGE, NO WORK
MOVE T2,RBUF ;GET SYSTEM MESSAGE CODE
CAIN T2,.IPCSA
JRST [ CALLRET SALMSG] ;ALLOCATED DEVICE BEING RETURNED
CAIN T2,.IPCTR
JRST [ CALLRET SMTMSG] ;MESSAGE ABOUT MAGTAPES
CAIN T2,.IPCMS
JRST [ CALLRET ACCSTI] ;STRUCTURE COUNT BEING INCREMENTED
CAIN T2,.IPCDS
JRST [ CALLRET ACCSTD] ;STRUCTURE COUNT BEING DECREMENTED
CAIN T2,.IPCRS
JRST [ CALLRET ACCSTR] ;STRUCTURE BEING REMOVED
RET
; INFOK - PROCESS PID-KILLED MESSAGE FROM INFO
; RBUF/ PID THAT WAS KILLED
; RETURNS +1: ALWAYS
INFOK: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB>
INFOK1: CALL QMSCAN ;GET NEXT ENTRY FROM RSB QUEUE
RET ;NONE LEFT, SPLIT
MOVEI RSB,-RSBLNK(T2) ;GET RSB ADDRESS
MOVE T1,RSBPID(RSB) ;GET PID FROM RSB
CAMN T1,RBUF ;WAS IT KILLED?
CALL VALPID ;YES, ABORT REQUEST IF NECESSARY
JFCL
JRST INFOK1
; SALMSG - PROCESS ALLOCATED-DEVICES-RELEASED MESSAGE
; RETURNS +1: ALWAYS
SALMSG: SAVEQ
HLRZ Q1,MRPDB+.IPCFP ;GET # OF DEVICES PLUS 1
SALMS1: SOJLE Q1,[CALLRET MCHWMT] ;EXIT WHEN DEVICE LIST EXHAUSTED
MOVE T1,RBUF(Q1) ;GET DEVICE DESIGNATOR
NOSHIP,<
LOAD T2,DV%TYP,T1 ;GET DEVICE TYPE
CAIN T2,.DVDTA ;DECTAPE?
JRST [ CALL RLSDTA ;YES, CALL PROCESSOR
JRST SALMS1] ;GET NEXT DEVICE
>;NOSHIP
CALL DDMT ;CONVERT IT TO MT STATUS BLK ADDR IN MT
JRST SALMS1 ;NOT MT DEVICE, IGNORE IT
SETOM UNLD ;Tape being unloaded
CALL MTRLS ;PROCESS RELEASE OF MT DEVICE
JRST SALMS1 ;ON TO NEXT DEVICE IN IPCF MESSAGE
; SMTMSG - PROCESS IPCF MESSAGES FROM MONITOR TAPE SERVICE
; RETURNS +1: ALWAYS
SMTMSG: SAVEQ
MOVEI Q1,RBUF+1 ;GET ADDRESS OF .VMCOD WORD
SKIPL T1,.VSMTN(Q1) ;GET MT# AND CHECK IF LESS THAN 0
CAML T1,MTN ; OR TOO BIG
CALL STOP ;ILLEGAL MT# FROM MONITOR
IMULI T1,MTSZ ;EXPAND TO OFFSET
MOVEI MT,MT0(T1) ;LOAD MT WITH ADDR OF MT STATUS BLOCK
MOVE T1,.VMCOD(Q1) ;DISPATCH BY MESSAGE SUBCODE
CAIN T1,.VMVSM
JRST SMTVS ;VOLUME-SWITCH
CALL STOP ;CODE NOT RECOGNIZED
; PROCESS VOLUME-SWITCH
SMTVS: LOAD RSB,MTRSB ;GET REQUEST STATUS BUFFER ADDRESS
CAIN RSB,MTNAV ;DOES USER OWN MT AND NO RSB?
JRST [ MOVEI T1,.MTNVV ;YES
MOVE T2,MT ;COMPUTE MT #
SUBI T2,MT0
IDIVI T2,MTSZ
MOVEI T3,[EXP 3,MREQX8,0] ;GET ARGUMENT BLOCK
MTU% ;MOUNTR CRASHED, SO YOU CAN'T VOLSWITCH
RET]
SKIPN RSB ;DO I OWN THE MT?
CALL STOP ;YES, WHAT'S GOING ON HERE?
LOAD T2,VS%COD,.VSFLG(Q1) ;TYPE OF SWITCH
SKIPLE T2 ;VALIDATE TYPE
CAILE T2,4
CALL STOP ;UNKNOWN TYPE
LOAD T1,RSBCV ;GET CURRENT VOLID INDEX
XCT [ MOVE T1,.VSCNT(Q1) ;1 - MOUNT ABSOLUTE VOLUME #
MOVEI T1,1 ;2 - MOUNT FIRST VOLUME
CALL VQCNT ;3 - MOUNT LAST VOLUME
ADD T1,.VSCNT(Q1)]-1(T2) ;4- MOUNT RELATIVE VOLUME
LOAD T2,VS%WRT,.VSFLG(Q1) ;GET READ/WRITE FLAG
LOAD T3,RSBLT ;GET LABEL TYPE
CAIN T3,.LTUNL ;UNLABELED?
SETZ T2, ;YES, DON'T REWRITE VOLUME LABELS
STOR T2,R%WVL,RSBIFL(RSB) ;SET OR RESET FLAG IN RSB
CALLRET VOLSW ;PERFORM VOLUME-SWITCH
; PIDINI - GET AND INITIALIZE PID FOR COMMUNICATION WITH THE WORLD
; RETURNS +1: ALWAYS
PIDINI: SAVEQ
; SET JOB PID QUOTA TO A LARGE VALUE
MOVEI T1,.MUSPQ ;FUNCTION = SET JOB PID QUOTA
SETO T2, ;THIS JOB
MOVEI T3,777 ;NEW QUOTA
CALL XMUTIL
JFCL
; TRY TO USE THE PID IN THE SYSTEM PID TABLE (IF IT EXISTS)
; IF THIS IS NOT POSSIBLE, CREATE A NEW PID AND USE IT
; Q1/ 0 IF I CREATED THE PID, 1 IF THE PID IS RECYCLED
SETZ Q1, ;Q1/0 MEANS I CREATED THE PID
MOVEI T1,.SPMDA ;OFFSET INTO TABLE FOR MDA PID
CALL GSYSPD ;DOES MDA PID EXIST?
JRST PIN1 ;NO
MOVEM T1,MYPID ;YES, SAVE IT
AOJA Q1,PIN2 ;TRY TO RECYCLE IT
PIN1: MOVEI T1,.MUCRE ;FUNCTION = CREATE PID
MOVE T2,[IP%JWP+.FHSLF] ;JOB-WIDE
CALL XMUTIL ;CREATE PID
CALL STOP ;CAN'T WORK WITHOUT A PID
MOVEM T3,MYPID ;STORE MY PID
PIN2: MOVEI T1,.MUPIC ;FUNCTION = PUT PID ON INTERRUPT CHANNEL
MOVE T2,MYPID ;PID
MOVEI T3,MRCVCN ;CHANNEL #
CALL XMUTIL ;CAN PID BE PUT ON INT CHANNEL?
JRST [ SOJE Q1,PIN3 ;NO, REPORT ERROR IF NOT MY PID
CALL STOP] ;CAN'T PUT MY OWN PID ON INT CHANNEL
MOVEI T1,.MUSSQ ;FUNCTION = SET SEND AND RECEIVE QUOTAS
MOVE T2,MYPID ;PID
MOVEI T3,777100 ;SEND = 777, RECEIVE = 100
CALL XMUTIL ;SET SEND/RECEIVE QUOTAS
JFCL
SKIPE Q1 ;RECYCLING OLD MDA PID?
CALL MRCVIH ;YES, DISCARD ANY CURRENT MESSAGES
; IDENTIFY MYSELF TO THE WORLD
SKIPE TSTF ;TESTING?
JRST [ MOVE T2,[[EXP 0,0,0,<20,,TBUF+4>,.IPCII,0],,TBUF]
BLT T2,TBUF+5 ;MOVE PDB AND PART OF MESSAGE TO BUF
MOVE T1,MYPID
MOVEM T1,TBUF+.IPCFS ;SET SENDER'S PID
GJINF ;GET USER# IN T1
MOVE T2,T1 ;COPY INTO T2
MOVE T1,[POINT 7,TBUF+6] ;GET POINTER
MOVEI T3,"["
IDPB T3,T1
DIRST ;ADD USER NAME
JSHLT
MOVEI T2,"]"
IDPB T2,T1
HRROI T2,[ASCIZ/MDA/] ;[6011]Get pointer to string
SETZ T3, ;STOP ON NULL
SOUT ;ADD PID NAME
MOVEI T1,4
MOVEI T2,TBUF
MSEND
CALL STOP
TMSG <% MOUNTR Becoming >
HRROI T1,TBUF+6 ;INFORM USER WE HAVE GOT PID
PSOUT
TMSG <
>
JRST PIN4]
MOVEI T1,.MUSSP ;FUNCTION = SET VALUE IN SYS PID TABLE
MOVEI T2,.SPMDA ;OFFSET INTO TABLE
MOVE T3,MYPID ;PID
CALL XMUTIL ;SET MY PID AS SYSTEM MDA PID
CALL STOP
PIN4:
; OBTAIN AND REMEMBER MAXIMUM LENGTH OF NON-PAGE-MODE IPCF PACKETS
MOVEI T1,.MUMPS ;FUNCTION = RETURN MAX NON-PAGE PACKET
CALL XMUTIL
CALL STOP
MOVEM T2,SHORT ;SAVE IT
RET
; ERROR ENCOUNTERED WHILE ASSIGNING EXISTING MDA PID TO PSI CHANNEL
; THIS IMPLIES THAT ANOTHER MOUNTR IS RUNNING, SO DON'T INTERFERE
PIN3: TMSG <?MDA PID is already defined>
MOVEI T1,.MUFOJ
MOVE T2,MYPID ;GET THE PID
CALL XMUTIL ;GET JOB# OF PID'S OWNER
HALTF
TMSG < by job >
MOVEI T1,.PRIOU
MOVE T2,T3 ;COPY JOB#
MOVEI T3,12 ;BASE 10
NOUT ;DISPLAY JOB#
JFCL
HALTF
; PWATCH - TELL INFO TO WATCH THE PID IN RSBPID
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
PWATCH: MOVEI T1,.IPCIK
MOVEM T1,TBUF+.IPCI0 ;STORE INFO FUNCTION CODE
MOVE T1,RSBPID(RSB)
MOVEM T1,TBUF+.IPCI2 ;STORE PID TO BE WATCHED
SETZ T1, ;SENDING TO INFO
MOVEI T2,3 ;3 WORDS
CALLRET TRANM
; TRANG - TRANSMIT GALAXY IPCF MESSAGE TO ASSOCIATED PROCESS
; TRANU - TRANSMIT GALAXY IPCF MESSAGE TO USER PROCESS
; TRANM - TRANSMIT IPCF MESSAGE TO SPECIFIED PID
; T1/ ASSOCIATED-PROCESS INDEX (TRANG) OR PID (TRANM, TRANU)
; T2/ MESSAGE LENGTH IN WORDS (TRANM ONLY)
; TBUF/ MESSAGE TO BE TRANSMITTED
; RETURNS +1: ALWAYS
TRANG: MOVE T1,APPID(T1) ;GET PID OF ASSOCIATED PROCESS
TRANU: LOAD T2,MS.CNT,TBUF+.MSTYP ;GET SIZE FROM GALAXY HEADER
JUMPE T1,TRAN1 ;IF RECEIVER PID IS 0, DON'T BOTHER
TRANM: SAVEQ
MOVEI Q1,1 ;SET UP RETRY COUNTER
; BUILD PDB AND ATTEMPT TO TRANSMIT THE MESSAGE
SETZM TRPDB+.IPCFL ;CLEAR PDB FLAGS WORD
MOVE T4,MYPID
MOVEM T4,TRPDB+.IPCFS ;STORE SENDER'S PID IN PDB
MOVEM T1,TRPDB+.IPCFR ;STORE RECEIVER'S PID IN PDB
CAMG T2,SHORT ;CAN I SEND A SHORT MESSAGE?
JRST [ MOVSM T2,TRPDB+.IPCFP ;YES, SET SIZE IN PDB
MOVEI T2,TBUF
HRRM T2,TRPDB+.IPCFP ;INSTALL MSG ADDRESS IN PDB
JRST TRAN2] ;SKIP PAGE-MODE STUFF
MOVX T2,IP%CFV
IORM T2,TRPDB+.IPCFL ;SET PAGE-MODE IN PDB
MOVE T2,[1000,,TBUF_-9]
MOVEM T2,TRPDB+.IPCFP ;SET SIZE,,PAGE#
TRAN2: MOVEI T1,4 ;PDB LENGTH
MOVEI T2,TRPDB ;PDB ADDRESS
MSEND ;SEND THE MESSAGE
JRST TRAN3 ;FAILED
TRAN1: SETZM TBUF ;CLEAR 1ST WORD OF TBUF
MOVE T1,[TBUF,,TBUF+1] ;BLT SOURCE AND DESTINATION
BLT T1,TBUF+777 ;CLEAR TBUF FOR NEXT CALLER
RET
; IPCF TRANSMIT FAILED, FIND OUT WHY
TRAN3: MOVSI T2,-MLEN ;Get the length of the error table
TRAN4: HLRZ T4,MTBL(T2) ;Get the next error code
CAME T1,T4 ;Do we match?
AOBJN T2,TRAN4 ;No, try the next one
SKIPL T2 ;Found a match?
$STOP <MSEND Failure> ;This error can't be dealt with
HRRZ T4,MTBL(T2) ;Get the routine address
JRST 0(T4) ;Process the error
TRAN5: SOJL Q1,TRAN1 ;GIVE UP IF RETRY COUNT EXHAUSTED
TRAN6: MOVEI T1,^D1000 ;RETRYABLE FAILURE
DISMS ;DELAY
JRST TRAN2 ;TRY IT AGAIN
TRAN7: HRROI T1,[ASCIZ/SYSTEM INFO Is Not Running - MOUNTR Dismissing For 30 Seconds
/] ;The message to the operator
PSOUT ;Tell the operator
MOVEI T1,^D30000 ;Give the operator time to restart INFO
DISMS ;Sleep for 30 seconds
JRST TRAN2 ;Try again
SUBTTL LABELED TAPE INITIALIZATION
; LTINIT - CHECK IF LABELED TAPE MUST BE INITIALIZED, AND IF SO,
; WRITE VOLUME LABELS AND A DUMMY FILE ON THE TAPE
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, TAPE DISMOUNTED OR REQUEST ABORTED
; +2: SUCCESS, TAPE IS PROPERLY PREPARED
LTINIT: MOVX T1,R%WVL
TDNN T1,RSBIFL(RSB) ;SKIP IF LABELS MUST BE WRITTEN
RETSKP ;YES, SHOULDN'T WRITE LABELS!
CALL OWCHK ;OVERWRITE PERMITTED?
RET ;NO, REQUEST ABORTED
LOAD T1,RSBDEN ;GET DESIRED DENSITY
STOR T1,MTADEN ;OPEN MTA AT THAT DENSITY
LOAD T1,RSBLT ;GET LABEL TYPE
STOR T1,MTALT ;SET NEW LABEL TYPE OF TAPE
CALL MTAOPO ;OPEN MTA FOR OUTPUT
JRST [ CALLRET UNLOAD] ;WRITE PROTECTED OR OFFLINE ???
MOVEI T1,.MOREW
MOVEI T2,1
CALL XMTOPR ;REWIND TAPE (SHOULDN'T TAKE LONG)
JRST LTINI1
LOAD T1,RSBLT
CAIN T1,.LTUNL ;UNLABELED TAPE?
JRST [ SETZM LBUF1 ;YES
MOVE T1,[LBUF1,,LBUF1+1]
BLT T1,LBUF1+^D19 ;ZERO THE BUFFER
MOVEI T1,LBUF1 ;GET BUFFER ADDRESS
CALL WRTLBL ;WRITE A RECORD OF ZEROS
JRST LTINI2 ;ERROR
JRST LTINI0] ;SUCCESSFUL, GO WRAP UP
CALL BLDV1 ;BUILD VOL1 LABEL
MOVEI T1,MTAV1(MTA) ;GET ADDRESS OF VOL1
CALL WRTLBL ;WRITE VOL1
JRST LTINI2 ;ERROR
SETZM MTAV2(MTA) ;ZAP VOL2 BUFFER
LOAD T1,RSBLT ;GET LABEL TYPE
CAIN T1,.LTT20 ;IS THIS A TOPS-20 VOLUME?
JRST [ CALL BLDV2 ;YES, BUILD VOL2 LABEL
MOVEI T1,MTAV2(MTA) ;GET ADDRESS OF VOL2
CALL WRTLBL ;WRITE VOL2
JRST LTINI2 ;ERROR
JRST .+1]
; --- USER VOLUME LABELS WOULD BE WRITTEN HERE ---
CALL BLDH1 ;BUILD HDR1 FOR DUMMY FILE
MOVEI T1,LBUF1 ;GET ADDRESS OF HDR1
CALL WRTLBL ;WRITE HDR1
JRST LTINI2 ;ERROR
MOVEI T1,.MOEOF
MOVEI T2,2 ;REPEAT COUNT
CALL XMTOPR ;DOUBLE TAPE MARK FRAMING EMPTY FILE
JRST LTINI1
CALL BLDEF1 ;BUILD EOF1
MOVEI T1,LBUF1 ;GET ADDRESS OF EOF1
CALL WRTLBL ;WRITE EOF1
JRST LTINI2
LTINI0: MOVEI T1,.MOEOF
MOVEI T2,2 ;REPEAT COUNT
CALL XMTOPR ;WRITE DOUBLE TAPE MARK
JRST LTINI1
CALL REW ;REWIND TAPE
JRST LTINI2 ;OFFLINE ERROR
CALL MTACLS ;CLOSE TAPE
RETSKP ;I DID IT!!
; DEVICE ERROR OR TIMEOUT OCCURRED
LTINI1: CALL XMTREP ;TELL OPERATOR ABOUT ERROR OR TIMEOUT
LTINI2: CALL UNLOAD ;UNLOAD THE TAPE FROM THE DRIVE
CALL MTACLS ;CLOSE THE JFN
CALLRET WOLINF ;TELL OPERATOR LABEL INIT FAILED
; WRTLBL - WRITE A LABEL TO TAPE
; T1/ ADDRESS OF INDUSTRY-COMPATIBLE FORMAT LABEL
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: I/O ERROR OR DRIVE TIMED OUT
; +2: LABEL WRITTEN SUCCESSFULLY
WRTLBL: STKVAR <<WCLIST,2>>
SUBI T1,1 ;GET BUFFER ADDRESS MINUS 1
HRLI T1,-LBLSIZ/4 ;GET MINUS # OF WORDS TO WRITE
MOVEM T1,WCLIST ;STORE IOWD
SETZM 1+WCLIST ;FOLLOW IOWD WITH ZERO WORD
LOAD T1,MTAJFN ;GET JFN
MOVEI T2,WCLIST ;GET COMMAND LIST ADDRESS
IOXCT DUMPO,WRTLB1,WRTLB2 ;DO THE I/O
RETSKP ;SUCCESS
WRTLB1: CALL CLRTAP ;CLEAR ERRORS, GET ERROR CODE IN T1
JRST WRTLB2 ;TIMED OUT
CAIN T1,IOX5 ;DEVICE OR DATA ERROR?
RET ;YES, TELL CALLER
CALL STOP ;I CAN'T HANDLE THIS
WRTLB2: CALLRET WOTIMO ;TELL OPERATOR ABOUT TIMEOUT AND TAKE +1
; BLDV1 - BUILD VOL1 LABEL
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, VOL1 LABEL IN MTAV1 IN MTA STATUS BLOCK
BLDV1: DMOVE T1,[ASCII/VOL1 /]
DMOVEM T1,LBUF2 ;SET FIRST 2 WORDS OF VOL1
MOVE T1,[LBUF2+1,,LBUF2+2]
BLT T1,LBUF2+LB7WDS-1 ;SET THE REST TO BLANKS
MOVE T1,MTAVOL(MTA) ;GET VOLID
MOVE T2,[ILPTR(V1VID)] ;GET DESTINATION POINTER
CALL SIXASC ;PUT VOLID IN LABEL
LOAD T1,RSBLT ;GET LABEL TYPE
CAIN T1,.LTEBC ;EBCDIC?
JRST BLDV11 ;YES, SKIP ANSI/TOPS20 STUFF
CAIN T1,.LTT20 ;IS THIS A TOPS-20 VOLUME?
JRST [ MOVEI T1,"1" ;YES
DPB T1,[LPTR(V1ACS)] ;SET ACCESSIBILITY FIELD
HRROI T1,T20SCD
MOVE T2,[ILPTR(V1SCD)]
CALL MOVSTR ;PUT TOPS-20 SYSTEM CODE IN VOL1
JRST .+1]
HRROI T1,[ASCIZ/D%K/]
MOVE T2,[ILPTR(V1OWN)]
CALL MOVSTR ;PUT MACHINE CODE IN OWNER-ID FIELD
MOVEI T1,DECV
DPB T1,[LPTR(V1DECV)] ;STORE DEC STANDARD VERSION
MOVEI T1,ANSV
DPB T1,[LPTR(V1ANSV)] ;STORE ANSI STANDARD VERSION
SKIPA T2,[ILPTR(V1INAM)] ;GET POINTER TO ANSI/TOPS20 OWNER NAME
BLDV11: MOVE T2,[ILPTR(V1INME)] ;GET POINTER TO EBCDIC OWNER NAME
HRROI T1,TAPNAM ;POINT TO INSTALLATION NAME
CALL MOVSTR ;COPY INSTALLATION NAME INTO LABEL
MOVEI T1,MTAV1(MTA) ;GET DESTINATION ADDRESS
CALLRET LBLOCV ;CONVERT TO OUTPUT FORMAT AND RETURN
; BLDV2 - BUILD VOL2 LABEL
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, VOL2 LABEL IN MTAV2 IN MTA STATUS BLOCK
BLDV2: DMOVE T1,[ASCII/VOL2 /]
DMOVEM T1,LBUF2 ;SET FIRST 2 WORDS OF VOL2
MOVE T1,[LBUF2+1,,LBUF2+2]
BLT T1,LBUF2+LB7WDS-1 ;SET THE REST TO BLANKS
MOVE T1,[ILPTR(V2PRO)] ;GET POINTER TO ACCESS CODE FIELD
LOAD T2,RSBVPR ;GET PROTECTION CODE
TRO T2,770000 ;FORCE COMPLETE OWNER ACCESS
TRZ T2,007700 ;CLEAR WORLD ACCESS (NOT DEFINED YET)
MOVE T3,[6,,10] ;FIELD WIDTH,,RADIX
CALL FNOUT ;PUT NUMERIC FIELD IN LABEL
HRROI T1,[ASCIZ/000000000000/] ;DUMMY PPN
MOVE T2,[ILPTR(V2PPN)]
CALL MOVSTR ;INSTALL PPN
HRROI T1,MTAV2(MTA) ;USE MTAV2 TEMPORARILY
MOVE T2,RSBUNO(RSB) ;USER'S USER #
DIRST ;TRANSLATE USER # TO STRING
SETZM MTAV2(MTA)
HRROI T1,MTAV2(MTA) ;(ALL THIS FUDGING IS BECAUSE DIRST
MOVE T2,[ILPTR(V2OWN)] ; PUTS AN UNWANTED NULL AT THE END)
CALL MOVSTR ;TRANSFER OWNER'S NAME TO LABEL
MOVEI T1,MTAV2(MTA) ;GET DESTINATION ADDRESS
CALLRET LBLOCV ;CONVERT TO OUTPUT FORMAT AND RETURN
; BLDH1 - BUILD DUMMY HDR1 LABEL
; BLDEF1 - BUILD DUMMY EOF1 LABEL
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, LABEL IN LBUF1
BLDH1: SKIPA T1,[ASCII/HDR1D/]
BLDEF1: MOVE T1,[ASCII/EOF1D/]
MOVEM T1,LBUF2 ;SET FIRST WORD OF LABEL
MOVE T1,[SKEL1,,LBUF2+1]
BLT T1,LBUF2+LB7WDS-1 ;SUPPLY REMAINDER OF SKELETON
MOVE T1,MTAVOL(MTA) ;GET VOLID
MOVE T2,[ILPTR(H1SET)] ;GET DESTINATION POINTER
CALL SIXASC ;PUT VOLID IN FILE SET NAME FIELD
SETO T2, ;SPECIFY CURRENT DATE/TIME
MOVX T4,IC%JUD ;WANT JULIAN FORM
ODCNV ;GET T2/ YEAR,,JULIANDAY
HLRZ T1,T2 ;GET YEAR
SUBI T1,^D1900 ;DROP CENTURY PART
IMULI T1,^D1000 ;DECIMAL SHIFT
HRRZS T2 ;ISOLATE DAY IN T2
ADD T2,T1 ;GET T2/ YYDDD (DECIMAL)
MOVE T1,[ILPTR(H1CRE+1)] ;GET POINTER TO LABEL FIELD
MOVE T3,[5,,12] ;5 CHARS WIDE, BASE 10
CALL FNOUT ;EDIT CREATION DATE INTO LABEL
MOVEI T1,LBUF1 ;GET DESTINATION ADDRESS
CALLRET LBLOCV ;CONVERT TO OUTPUT FORMAT AND RETURN
SKEL1: ASCII /UMMY-FILE-0000 0001000100010/ ;CP 6-40
ASCII/0 00000 000000DECSYSTEM20 / ;CP 41-80
; LBLOCV - CONVERT 7-BIT ASCII LABEL IN LBUF2 TO 8-BIT ASCII OR EBCDIC
; T1/ ADDRESS OF DESTINATION LABEL
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
LBLOCV: SAVEQ
HRLI T1,(POINT 8,0) ;MAKE POINTER TO DESTINATION
MOVE T2,[POINT 7,LBUF2] ;GET POINTER TO SOURCE
MOVEI T3,LBLSIZ ;GET # OF BYTES IN LABEL
LOAD T4,RSBLT ;GET LABEL TYPE
LBLOC1: ILDB Q1,T2 ;GET SOURCE BYTE
CAIN T4,.LTEBC ;EBCDIC LABEL?
JRST [ ADJBP Q1,[POINT 8,AETT,7] ;YES, GET POINTER TO TABLE
LDB Q1,Q1 ;TRANSLATE ASCII TO EBCDIC
JRST .+1]
IDPB Q1,T1 ;STORE BYTE IN DESTINATION
SOJG T3,LBLOC1
RET
; OWCHK - CHECK IF USER MAY OVERWRITE TAPE VOLUME
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: OVERWRITE NOT PERMITTED, REQUEST ABORTED
; +2: OVERWRITE PERMITTED
OWCHK: JN R%PRIV,RSBIFL(RSB),RSKP ;PRIVILEGED USERS CAN DO ANYTHING
MOVE T1,MTAFLG(MTA) ;GET FLAGS
JXN T1,MA%UXV,[ABTRET (MREQ28)] ;ERROR IF FIRST FILE NOT EXPIRED
JXN T1,MA%SCR,RSKP ;OK IF IT'S A SCRATCH TAPE
LOAD T1,MTALT ;GET LABEL TYPE
LOAD T2,MA%OPF,MTAFLG(MTA) ;GET OVERWRITE-PROTECT FLAG
JRST @OWCDV(T1) ;DISPATCH ACCORDING TO LABEL TYPE
OWCDV: IFIW!RSKP ;LABEL TYPE NOT KNOWN YET
IFIW!RSKP ;UNLABELED
IFIW!OWCANS ;ANSI
IFIW!OWCPV ;EBCDIC (WRITE ACCESS NOT SUPPORTED)
IFIW!OWCT20 ;TOPS-20
MAXLT
OWCANS: JUMPE T2,RSKP ;OK IF FLAG IS RESET
OWCPV: ABTRET (MREQ29) ;OVERWRITE ACCESS VIOLATION, ABORT REQ
OWCT20: JUMPE T2,RSKP ;OK IF FLAG RESET
STKVAR <<OWNER,10>>
MOVEI T1,OWNER ;PROVIDE WORK AREA FOR GETVU
CALL GETVU ;GET TAPE-OWNER'S USER # IN T2
CAME T2,RSBUNO(RSB) ;TAPE USER # MATCH REQUESTOR USER # ?
JRST OWCPV ;NO, PROTECTION VIOLATION
RETSKP ;YES, YOU OWN IT, SO YOU CAN OVERWRITE
SUBTTL OPERATOR INTERFACE
; BADOM, BADQM BADNM - TYPE A MESSAGE ON CTY INDICATING THAT I RECEIVED A BAD
; IPCF MESSAGE FROM ORION OR QUASAR OR NEBULA. USES T4 AS A FLAG TO INDICATE
; WHO SEND THE MESSAGE.
; RETURNS +1: ALWAYS
BADOM: MOVEI T1,[ASCIZ/ORION/] ;From ORION
SETZRO T4 ;-1 is from ORION
JRST BADCOM ;Join common code
BADQM: MOVEI T1,[ASCIZ/QUASAR/] ;From QUASAR
SETO T4, ;0 is from QUASAR
JRST BADCOM ;Join common code
BADNM: MOVEI T1,[ASCIZ/NEBULA/] ;From NEBULA
MOVEI T4,1 ;1 is from NEBULA
BADCOM: MOVE T2,[RBUF,,BADMSG]
BLT T2,BADMSG+777 ;MAKE A COPY JUST FOR THE RECORD
TMCT <%IBad IPCF message received from %1A>
LOAD T1,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE
CAIN T1,MT.TXT ;IS THIS
SKIPE RBUF+.OARGC ;A NULL TEXT MESSAGE?
SKIPA ;NO
RET ;YES, RETURN
CAIN T1,MT.TXT ;TEXT MESSAGE?
CALL [ MOVEI T1,RBUF+.OHDRS+ARG.DA ;YES, POINT TO TEXT
TMCTR <%_TEXT MESSAGE: %1A>] ;DISPLAY IT
MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
CALL BTWTO ;[6011]Out to CTY and return
MOVE T1,RBUF+.MSFLG ;[6011]Get flag
TXNN T1,MF.WTO ;[6017]Return status via WTO?
TXNN T1,MF.NEB ;[6011]No, is this from NEBULA?
RET ;[6011]No, all done
; Have to send a dismount ACK back to NEBULA
MOVX T1,E%BADM ;[6011]Error code
SKIPGE T4 ;[6011]From ORION
IFSKP. ;[6011]No
SKIPE T4 ;[6011]From QUASAR
IFSKP.
TXO T1,FA%QER ;[6011]Yes
ELSE.
TXO T1,FA%NER ;[6011]Must be from NEBULA
ENDIF.
ELSE.
TXO T1,FA%OER ;[6011]Yes
ENDIF.
MOVE T2,RBUF+.MSCOD ;[6011]Remote ACK
CALLRET FAILE ;[6011]Remote, send failure
; TO CLEAR SOME OF THE CONFUSION HERE, AN "ACK" IS USED WHEN SENDING
; TEXT TO A PARTICULAR OPR (E.G. WHEN TELLING THE OPERATOR THAT
; HE MADE A BAD KEYIN), WHEREAS "WTO" AND "WTOR" MESSAGES ARE SEEN
; BY ALL USERS RUNNING OPR THE TIME THE MESSAGE IS RECEIVED BY ORION.
; ALL OF THE BTxxx ROUTINES RETURN +1 ALWAYS
; BTACK - BUILD AND TRANSMIT ACK MESSAGE WITHOUT TEXT
; RBUF+.MSCOD/ ID OF OPR WHO WILL RECEIVE ACK
; T3/ ADDRESS OF ASCIZ MESSAGE TYPE
; BTACKT - BUILD AND TRANSMIT ACK MESSAGE WITH TEXT
; TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
; T3/ ADDRESS OF ASCIZ MESSAGE TYPE
; BTWTO - BUILD AND TRANSMIT WTO MESSAGE
; TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
; T3/ ADDRESS OF ASCIZ MESSAGE TYPE
; BTWTOR - BUILD AND TRANSMIT WTOR MESSAGE
; TMCMSG/ ASCIZ MESSAGE TO BE TRANSMITTED
; T1/ 0 ,, ADDR OF ROUTINE TO BE SCHEDULED WHEN RESPONSE IS RECEIVED
; T2/ ADDRESS OF WTB
; T3/ ADDRESS OF ASCIZ MESSAGE TYPE
BTACK:: SKIPA T4,[1B0+.OMACK] ;ACK MESSAGE, NO TEXT BLOCK
BTACKT::MOVEI T4,.OMACK ;ACK MESSAGE WITH TEXT BLOCK
JRST BT1 ;ENTER COMMON CODE
BTWTON::MOVE T4,[1B0+.OMWTO] ;WTO MESSAGE WITHOUT TEXT BLOCK
JRST BT1
BTWTOR::SKIPA T4,[.OMWTR] ;WTOR MESSAGE
BTWTO:: MOVEI T4,.OMWTO ;WTO MESSAGE
BT1: MOVEM T4,BTEXT ;Save for text checking
STAKT ;STACK T1-T4
HRRZ T1,CT3 ;[6010]Get the header address
MOVEM T1,WTTYPA ;[6010]Save the .wttyp address
AOS FIRST ;First message packet
BT2: MOVEI T1,PBMAX ;Number of byte allowed in message
SUBI T1,BYTEND ;Last line in packet trigger
MOVEM T1,PBLFT ;Initialize # bytes left in message
SETZM BUFLFT ;Exhausted space in TMCMSG turned off
; CONSTRUCT BUILDING BLOCKS IN IPCF MESSAGE TO ORION
MOVX T1,WT.MOR ;Get more text flag
ANDCAM T1,BTFLGS ;Make sure it is not set
CALL PBINIT ;SET UP TO CREATE BUILDING BLOCKS
SKIPN FIRST ;Is it the first time
JRST BT3 ;No, check remote request
; Object type block
MOVEI T1,[2,,.WTOCD
.OTMNT]
CALL PBBLK ;INSERT MESSAGE CLASSIFICATION BLOCK
; Check to see whether the message is going to NEBULA or ORION or both
BT3: SKIPE NEBMSG ;[6010]Message in response to a NEBULA reqeust
IFSKP.
CAIN RSB,1 ;[6010]No RSB
JRST BT0 ;[6010]No WTNHD
MOVE T2,RSBIFL(RSB) ;Get the flag word
TXNN T2,R%WTO ;Nebula want WTO?
JRST BT0 ;No
MOVE T2,RSBOBN(RSB) ;[6017]Get Remote node name
MOVEM T2,RENODE ;[6017]Save it for .WTNHD
ENDIF.
MOVE T1,[2,,.WTNHD] ;[6010]Node name header block
MOVEM T1,WTNHDB ;[6010]Save it
MOVE T1,RENODE ;[6017]node name
MOVEM T1,WTNHDB+1 ;[6010]Save it
MOVEI T1,WTNHDB ;[6010]Address of arg block
CALL PBBLK ;[6010]Insert into message
JRST BT7 ;[6010]Must add .WTTYP block
BT0: SKIPN FIRST ;Is it the first time
JRST BT6 ;No, do text
BT7: MOVE T1,WTTYPA ;ADDR OF ASCIZ MESSAGE TYPE
MOVEI T2,.WTTYP ;TYPE CODE
CALL PBTXT ;INSTALL MESSAGE TYPE TEXT
SETZM FIRST ;Clear first flag
BT6: MOVEI T1,TMCMSG ;ADDR OF FORMATTED TEXT
MOVEI T2,.WTTXT ;TYPE CODE
SKIPLE BTEXT ;Text Present?
CALL PBTXT ;YES, INSTALL IT
SKIPG MORTXT ;Any text left?
SETZM BTEXT ;No, mark it so
; BUILD GALAXY HEADER AND SHIP THE MESSAGE OFF TO ORION
; Before calling GALHDR, T1,T2,T3 must be setup correctly with the first 3
; words of the standard GALAXY header.
BT4: HRRZ T1,CT4 ;GET MESSAGE TYPE
CAIE T1,.OMACK ;ACK MESSAGE?
AOSA T3,UNIQUE ;NO, GET A UNIQUE NUMBER
MOVE T3,RBUF+.MSCOD ;YES, GET OPR PID
MOVE T2,PBBPT
SUBI T2,TBUF ;COMPUTE SIZE OF IPCF MESSAGE
HRL T1,T2 ;GET LENGTH,,MSGTYPE
SKIPE NEBMSG ;[6010]Message in response to a NEBULA request
IFSKP.
CAIN RSB,1 ;[6010]No RSB
JRST BT5 ;[6010]No MF.WTO
MOVE T2,RSBIFL(RSB) ;Get the flag word
TXNN T2,R%WTO ;Nebula want WTO?
JRST BT5 ;No
MOVX T2,MF.WTO ;[6017]Yes set NEBULA WTO bit
MOVE T3,RSBPID(RSB) ;[6017]Get the remote operator pid
ENDIF.
; Remote message
MOVE T4,BTFLGS ;[6010]Get the more data flag
TXO T2,MF.NEB ;[6017]Set the NEBULA bit
TXNE T4,WT.MOR ;[6010]Any more data?
TXO T2,MF.MOR ;[6017]Yes, lite the more bit
SKIPA ;[6010]
BT5: SETZ T2, ;[6010]No flags
CALL GALHDR ;BUILD GALAXY MESSAGE HEADER IN TBUF
MOVE T1,BTFLGS ;GET CURRENT FLAGS
TXO T1,WT.SJI ;ALWAYS SUPPRESS JOB INFORMATION
MOVEM T1,TBUF+.OFLAG ;SET FLAGS WORD OF MESSAGE TO ORION
MOVEI T1,.APORN ;GOING TO ORION
CALL TRANG ;QUEUE IT UP FOR TRANSMISSION
MOVE T1,BTFLGS ;Get flags
TXNE T1,WT.MOR ;More text?
JRST BT2 ;Yes, process it
SETZM NEBMSG ;[6010]Clear NEBULA FLAG
SETZM BTFLGS ;No, clear message flags
HRRZ T1,CT4 ;GET FUNCTION CODE
CAIE T1,.OMWTR ;WHAT FUNCTION?
RET ;NOT WTOR - ALL DONE
; WTOR - MAKE ENTRY IN RESPONSE-EXPECTED QUEUE
MOVE T1,CT2 ;GET WTB ADDRESS
SKIPE WTBCOD(T1) ;MESSAGE OUTSTANDING?
CALL STOP ;YES, PROGRAM LOGIC ERROR
MOVE T2,UNIQUE
MOVEM T2,WTBCOD(T1) ;SAVE ACK CODE
XMOVEI T2,20
HRR T2,CT1
MOVEM T2,WTBENT(T1) ;SAVE CALLER'S GLOBAL ENTRY ADDRESS
MOVEI T2,WTBLNK(T1) ;GET ADDRESS OF PACKET LINKAGE WORD
MOVEI T1,WTRQDB ;GET QUEUE DESCRIPTOR BLOCK ADDRESS
CALLRET QMQT ;PUT PACKET ON EXPECTED-RESPONSE QUEUE
; BTJOB - REQUEST WT.JOB BE SET IN NEXT MESSAGE TO ORION
; BTNFO - REQUEST WT.NFO BE SET IN NEXT MESSAGE TO ORION
; RETURNS +1: ALWAYS
BTJOB:: SKIPA T1,[WT.JOB]
BTNFO:: MOVX T1,WT.NFO
IORM T1,BTFLGS ;SET APPROPRIATE FLAG
RET
; CANWTR - CANCEL AN OUTSTANDING WTOR MESSAGE
; T1/ ACK CODE FROM WTB
; RETURNS +1: ALWAYS
CANWTR: QSCANI WTRQDB ;SET UP TO SCAN OUTSTANDING WTOR QUEUE
STKVAR <CANCOD>
MOVEM T1,CANCOD ;SAVE ACK CODE
; SEARCH WTB QUEUE FOR THE WTB WITH THE SPECIFIED ACK CODE
CANWT1: CALL QMSCAN ;GET ADDRESS OF NEXT WTB ON CHAIN
CALL STOP ;END OF LIST, EXPECTED WTB MISSING
MOVE T3,WTBCOD(T2) ;GET ACK CODE FROM WTB
CAME T3,CANCOD ;IS THIS THE ONE THE CALLER WANTS?
JRST CANWT1 ;NO, CONTINUE SEARCH
; FOUND THE WTB FOR THE WTOR REQUEST THAT'S GOING TO BE CANCELED
; BUILD AND TRANSMIT CANCEL-WTOR MESSAGE TO ORION
CALL QMDQS ;DEQUEUE WTB
SUBI T2,WTBLNK ;GET WTB ADDRESS IN T2
SETZM WTBCOD(T2) ;MARK WTB AS INACTIVE
MOVE T1,[.OARGC+1,,.OMWTR] ;BUILD GALAXY HEADER
SETZ T2, ; FLAGS
MOVE T3,CANCOD ; ACK CODE
CALL GALHDR
MOVX T1,WT.KIL+WT.SJI ;GET FLAG FOR KILL-WTOR
MOVEM T1,TBUF+.OFLAG
SETZM TBUF+.OARGC ;NO ARGUMENTS
MOVEI T1,.APORN ;MESSAGE GOING TO ORION
CALLRET TRANG ;SEND CANCEL REQUEST TO ORION
; CMDCFM - PARSE END-OF-LINE
; CSB/ COMND STATE BLOCK
; RETURNS +1: ERROR, MESSAGE SENT TO OPERATOR
; +2: SUCCESS
CMDCFM: MOVEI T2,[FLDDB. .CMCFM]
CALL COMNDX ;PARSE IT
SKIPA ;ERROR
RETSKP ;SUCCESS
JSP T1,RSPERR
ASCIZ/Superfluous information at end of response/
; COMNDI - SET UP COMND STATE BLOCK FOR PARSING OPERATOR RESPONSE
; T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
; RETURNS +1: ALWAYS, CSB SET UP FOR PARSING
COMNDI::STAKT ;STACK T1-T4
TMCT <%I> ;INIT MESSAGE COMPOSER
MOVE T1,CT1 ;GET ADDRESS OF RESPONSE TEXT
CALL TMCRSP ;COPY TEXT TO THE WIDE OPEN SPACES
MOVX T3,CM%RAI+CM%XIF ;RAISE INPUT, NO INDIRECT FILE
MOVEM T3,CSB+.CMFLG
SETZM CSB+.CMIOJ ;SET BAD JFNS TO PREVENT TTY I/O
HRROI T3,[0]
MOVEM T3,CSB+.CMRTY ;CTRL/R BUFFER BYTE POINTER
HRROI T1,TMCMSG
MOVEM T1,CSB+.CMBFP ;BEGINNING OF INPUT
MOVEM T1,CSB+.CMPTR ;POINTER TO NEXT FIELD TO BE PARSED
MOVEI T2,5000
MOVEM T2,CSB+.CMCNT ;SIZE OF AREA AFTER .CMPTR
MOVEM T2,CSB+.CMINC ;# OF UNPARSED CHARS AFTER .CMPTR
HRROI T3,ATMBFR
MOVEM T3,CSB+.CMABP ;POINTER TO ATOM BUFFER
MOVEI T3,ATMSIZ*5
MOVEM T3,CSB+.CMABC ;SIZE OF ATOM BUFFER (CHARACTERS)
SETZM CSB+.CMGJB ;GTJFN BUFFER ADDRESS
RET
; COMNDX - EXECUTE COMND JSYS TO PARSE OPERATOR RESPONSE IN CORE
; T2/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK CHAIN
; CSB/ COMND JSYS STATE BLOCK SET UP BY COMNDI SUBROUTINE
; RETURNS +1: PARSE FAILED
; +2: PARSE SUCCEEDED, T2/ T2 RETURNED BY COMND JSYS
; T3/ ADDRESS OF FDB ACTUALLY USED
COMNDX::SAVEQ
MOVE T1,CSB+.CMINC ;GET # OF UNPARSED CHARACTERS
CAIN T1,5000 ;FIRST PARSE FOR THIS COMMAND LINE?
JRST [ MOVX Q1,FLD(.CMCFM,CM%FNC) ;YES
HRR Q1,T2 ;PREFIX CALLER'S FDB WITH CONFIRM FDB
MOVEI T2,Q1 ;SUBSTITUTE THE ADDRESS OF MY FDB
JRST .+1]
MOVEI T1,CSB ;GET ADDRESS OF COMND STATE BLOCK
COMND ;CALL MONITOR
ERJMP R ;JSYS FAILED, MAKE LIKE PARSE ERROR
HRRZS T3 ;GET ACTUAL FDB ADDRESS IN T3
TXNN T1,CM%NOP ;PARSE ERROR?
CAIN T3,Q1 ; OR NULL COMMAND LINE?
RET ;YES, RETURN +1, ERROR CODE IN T2
RETSKP
; COMNDV - PARSE A VOLID WITHIN OPERATOR RESPONSE
; CSB/ COMND JSYS STATE BLOCK
; RETURNS +1: BAD VOLID, ERROR MESSAGE SENT TO OPERATOR
; +2: SUCCESS, T1/ SIXBIT VOLID
COMNDV: MOVEI T2,[FLDDB.(.CMQST,,,,,[FLDDB.(.CMFLD)])]
CALL COMNDX ;PARSE QUOTED STRING OR FIELD
SETZM ATMBFR ;SYNTACTICAL ERROR
MOVEI T1,ATMBFR ;GET STRING ADDRESS
CALL ASCIZL ;GET LENGTH OF VOLID IN T2
JUMPE T2,[JSP T1,RSPERR ;ERROR IF NULL VOLID
ASCIZ/Syntactical error in volume-id/]
CAILE T2,6 ;TOO LONG?
JRST [ JSP T1,RSPERR ;YES
ASCIZ/Volume identifier longer than 6 characters/]
MOVE T1,[POINT 7,ATMBFR] ;GET POINTER TO ASCII VOLID
CALL CVTA6R ;CONVERT VOLID TO SIXBIT
JRST [ JSP T1,RSPERR ;ERROR
ASCIZ/Illegal volume identifier/]
RETSKP ;LOOKS GOOD, RETURN IT TO CALLER
; INWTOR - PROCESS INCOMING RESPONSE TO OUTSTANDING WTOR MESSAGE
; RBUF/ IPCF MESSAGE FROM ORION, MESSAGE TYPE = .OMRSP
; RETURNS +1: ALWAYS
INWTOR: QSCANI WTRQDB ;SET UP TO SCAN OUTSTANDING WTOR QUEUE
STKVAR <WTBAD>
; SCAN OUTSTANDING WTOR MESSAGE QUEUE FOR THE MESSAGE THAT
; MATCHES UP WITH THE RESPONSE I JUST GOT
INWTO1: CALL QMSCAN ;GET ADDR OF NEXT PACKET IN QUEUE
RET ;RACE - OPERATOR RESPONDED TO MESSAGE
;JUST BEFORE ORION GOT MY KILL ORDER
MOVE T3,WTBCOD-WTBLNK(T2) ;GET ACK CODE FROM ENTRY
CAME T3,RBUF+.MSCOD ;DOES IT MATCH CODE IN IPCF MESSAGE?
JRST INWTO1 ;NO, CONTINUE SCAN
; THE RESPONSE HAS BEEN IDENTIFIED - DEQUEUE THE WTB,
; LOAD AC'S FOR HANDLER, AND SCHEDULE IT
CALL QMDQS ;DEQUEUE THIS ENTRY, GET ADDR IN T2
SUBI T2,WTBLNK ;SUBTRACT LINKAGE WORD OFFSET
MOVEM T2,WTBAD ;SAVE ADDRESS OF WTB
SETZM WTBCOD(T2) ;MARK WTB AS INACTIVE
MOVEI T1,.ACKID
CALL ORNBLF ;LOOK UP OPR-IDENTIFIER BLOCK
SETZ T2, ;NOT THERE
JUMPE T2,[CALLRET BADOM] ;BLOCK NOT THERE OR TOO SHORT
MOVE T1,(T1) ;GET ID OF RESPONDING OPR
MOVEM T1,RBUF+.MSCOD ;SET IN CASE I WANT TO CALL BTACK
MOVEI T1,.CMTXT ;SPECIFY ARG TYPE I WANT
CALL ORNBLF ;SCAN ARG LIST FOR RESPONSE
JRST [ CALLRET BADOM] ;NO RESPONSE BLOCK, BAD MSG FROM ORION
HRLI T1,(POINT 7) ;CONSTRUCT POINTER TO RESPONSE TEXT
MOVE T2,WTBAD ;GET WTB ADDRESS IN T2
; ENTER RESPONSE PROCESSOR WITH THE FOLLOWING AC SETUP:
; T1/ BYTE POINTER TO ASCIZ RESPONSE FROM OPERATOR
; T2/ ADDRESS OF WTB
CALLRET @WTBENT(T2) ;CALL BTWTOR CLEANUP CODE
; KC ROUTINES - CHECK FOR VARIOUS TAPE DRIVE CONDITIONS
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: CONDITION NOT SATISFIED, ERROR MESSAGE SENT TO OPERATOR
; +2: CONDITION SATISFIED
; CHECK FOR DRIVE AVAILABLE TO USERS
KCAVL: LOAD T2,MTASTE ;GET STATE
CAIN T2,S.AV ;AVAILABLE?
RETSKP ;YES
MOVEI T1,[ASCIZ/Not Under Operator Control/]
JUMPE T2,KC1 ;JUMP IF DRIVE NOT ASSIGNED
JSP T1,KC1 ;ONLY OTHER CASE IS INITIALIZING
ASCIZ/In INITIALIZE Mode/
; CHECK IF DRIVE IS LOADED
KCLOAD: JN MA%LOD,MTAFLG(MTA),RSKP
JSP T1,KC1
ASCIZ/Not Loaded/
; CHECK IF DRIVE IS IN USE BY ME OR USER
KCUSE: SAVEAC <MT,RSB>
JN MTAJCT,,[TMCT <%I%M Is In Use By MOUNTR, Try Later>
MOVEI T3,TMCMSG
CALLRET BTACK] ;SEND REPLY AND RETURN +1
LOAD MT,MTAMT ;MT ASSOCIATED?
JUMPE MT,RSKP ;RETURN GOOD IF DRIVE NOT IN USE
LOAD RSB,MTRSB ;GET RSB ADDRESS
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%I%M Is In Use By Request # %1D> ;A USER HAS IT
MOVEI T3,TMCMSG
CALLRET BTACK ;TELL OPERATOR
; KC1 - T1/ ADDRESS OF ASCIZ ERROR MESSAGE
KC1: TMCT <%ITape Drive %M is %1A>
MOVEI T3,TMCMSG
CALLRET BTACK ;SEND ACK BACK TO OPR AND TAKE +1 RET
; KDMT - PROCESS DELETE MOUNT-REQUEST COMMAND FROM OPR
; RETURNS +1: ALWAYS
KDMT: SAVEQ
MOVEI T1,.ORREA
CALL ORNBLF ;LOOKUP REASON BLOCK
SETZ T2, ;NOT FOUND
SKIPE Q1,T2 ;REASON GIVEN?
JRST [ MOVSS T1 ;YES, GET BLT SOURCE
HRRI T1,ATMBFR ;BLT DESTINATION
BLT T1,ATMBFR-1(T2) ;COPY REASON TO ATMBFR FOR TELUSR
SETZM ATMBFR(T2) ;TIE IT OFF
JRST .+1]
MOVEI T1,.ORREQ
CALL ORNBLF ;LOOKUP REQUEST # BLOCK
JRST KDMT1 ;NOT THERE, TRY STRUCTURE FORM
; DELETING SPECIFIC MOUNT REQUEST
JUMPE T2,KBADM ;REJECT HEADER-ONLY ENTRY
MOVE T1,(T1) ;GET REQUEST #
CALL REQRSB ;TRANSLATE REQ# TO RSB ADDR
JRST KNXREQ ;REQUEST DOES NOT EXIST
LOAD T2,RSBSTE ;GET STATE OF REQUEST
CAIE T2,RST.WM ;WAITING FOR MOUNT?
CAIN T2,RST.WV ; OR WAITING FOR VOLID LIST KEYIN?
SKIPA ;IF EITHER, OK TO DELETE
JRST [ JSP T2,KACKRQ ;CAN'T DELETE THIS REQUEST
ASCIZ/Is Not Waiting/]
MOVEI T2,[ASCIZ/Canceled/]
CALL KACKRQ ;TELL OPERATOR I DELETED IT
MOVE Q2,RSBSTN(RSB) ;GET STR NAME
MOVE Q3,RSBSTA(RSB) ;GET STR ALIAS
JUMPN Q1,[ABTREQ (MREQ15,ABT%OP) ;ABORT WITH REASON
JRST KDMT0] ;AND CONTINUE
ABTREQ (MREQ15) ;ABORT WITHOUT REASON
KDMT0: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
KDMT0A: CALL NSTRSB ;GET ADDR OF NEXT RSB
JRST KDMT0B ;END OF QUEUE
CAMN Q2,RSBSTN(RSB) ;SAME STR NAME
CAME Q3,RSBSTA(RSB) ;SAME ALIAS
JRST KDMT0A ;NO, TRY NEXT RSB
MOVE T1,RSBIFL(RSB) ;YES, SEE IF OPR HAS BEEN NOTIFIED
TXNE T1,R%ONR ;
JRST KDMT0A ;OPR HAS SEEN THIS ONE, TRY NEXT
CALL WOVMS ;OPR HAS NOT SEEN IT YET --TELL OPR
KDMT0B: RET ;FINISHED
; DELETING ALL MOUNT REQUESTS FOR SPECIFIED STRUCTURE
KDMT1: MOVEI T1,.STRDV ;SPECIFY BLOCK TYPE
CALL KGTSTR ;GET STRUCTURE NAME
JRST KBADM ;NOT THERE, ERROR
MOVE Q2,T1 ;SAVE SIXBIT STRUCTURE NAME
QSCANI ARBQDB ;SET UP TO SCAN REQUEST QUEUE
SETZ Q3, ;SET ABORTED REQUEST COUNT TO ZERO
; SCAN REQUEST QUEUE ABORTING REQUESTS FOR THIS STRUCTURE
KDMT2: CALL NSTRSB ;GET NEXT RSB
JRST KDMT3 ;NONE LEFT
LOAD T1,RSBTYP ;GET TYPE
CAIE T1,.MNTST ;STRUCTURE MOUNT?
JRST KDMT2 ;NO, SKIP IT
SKIPN T1,RSBSTN(RSB) ;STRUCTURE NAME SPECIFIED?
MOVE T1,RSBSTA(RSB) ;NO, USE ALIAS
CAME Q2,T1 ;WANT TO CANCEL THIS REQUEST?
JRST KDMT2 ;NO, SKIP IT
JUMPN Q1,[ABTREQ (MREQ15,ABT%OP) ;ABORT WITH REASON
AOJA Q3,KDMT2] ;COUNT IT AND CONTINUE SCAN
ABTREQ (MREQ15) ;ABORT WITHOUT REASON
AOJA Q3,KDMT2 ;COUNT IT AND CONTINUE SCAN
; TELL THE OPERATOR HOW MANY REQUESTS WERE DELETED
KDMT3: JUMPE Q3,[TMCT <%INo>
JRST KDMT3A]
TMCT <%I%7D> ;DISPLAY # OF REQUESTS
KDMT3A: TMCT < Mount Request>
SOJN Q3,[TMCT <s> ;TACK ON S IF NOT 1 REQUEST
JRST .+1]
TMCT < Canceled>
MOVEI T3,TMCMSG ;GET ADDRESS OF MESSAGE
CALLRET BTACK ;RESPOND TO DELETE COMMAND
; KDIS/KENA - PROCESS ENABLE AND DISABLE COMMANDS FROM OPR
; RETURNS +1: ALWAYS
KDIS: SKIPA T1,[[LOAD T1,MTASTE
CAIE T1,S.AV
RET
MOVX T1,MA%AVE
ANDCAM T1,MTAFLG(MTA)
RET]] ;COROUTINE FOR DISABLE
KENA: MOVEI T1,[LOAD T1,MTASTE
CAIE T1,S.AV
RET
CALL AVRENA
CALLRET AVR] ;COROUTINE FOR ENABLE
JXE F,TALCF,KNALC ;REJECT IF ALLOCATION NOT ENABLED
STAKT
MOVEI T1,.AVREC ;CHECK FOR AVR KEYWORD
CALL ORNBLF ;IS IT THERE?
JRST KBADM ;NO
MOVE T1,CT1 ;GET ADDRESS OF COROUTINE
CALL KTXCT ;DO IT FOR SPECIFIED TAPE DRIVES
JRST KBADM ;BAD MESSAGE FROM QUASAR
RET
; KGBLK - LOOK UP SPECIFIED BLOCK TYPE IN MESSAGE
; T1/ BLOCK TYPE
; T2/ UPPER LIMIT OF ARGUMENT (LOWER LIMIT = 0)
; IF T2/ 0, NO LIMIT CHECKING IS DONE
; T3/ DEFAULT, APPLIED IF (T2).NE.0 AND VALUE=0
; OR IF ENTRY NOT PRESENT
; RETURNS +1: HEADER-ONLY ENTRY OR VALUE BEYOND LIMITS
; +2: T1/ VALUE (OR DEFAULT IF APPLICABLE)
KGBLK: STAKT ;SAVE ARGS
CALL ORNBLF ;LOOKUP ARGUMENT
JRST KGBLK1 ;NOT THERE, TAKE THE DEFAULT
JUMPE T2,R ;ERROR IF HEADER-ONLY
MOVE T1,(T1) ;GET ARGUMENT
SKIPN CT2 ;LIMIT CHECK REQUESTED?
RETSKP ;NO, JUST PASS IT BACK
CAMG T1,CT2 ;GREATER THAN UPPER LIMIT?
SKIPGE T1 ; OR BELOW 0 ?
RET ;YES, ERROR
SKIPN T1 ;IS IT 0 ?
KGBLK1: MOVE T1,CT3 ;YES, SUBSTITUTE THE DEFAULT
RETSKP
; KGTSTR - LOCATE AND EXTRACT STRUCTURE OR ALIAS NAME
; T1/ ENTRY TYPE CODE (.STRDV OR .STALS)
; RETURNS +1: ENTRY NOT FOUND
; +2: SUCCESS, T1/ SIXBIT STRUCTURE NAME T2,T3/ ASCIZ NAME
KGTSTR: CALL ORNBLF ;LOOKUP SPECIFIED BLOCK TYPE
JRST KGSTR1 ;NOT FOUND
SAVET ;SET UP TO RETURN VALUES TO CALLER
DMOVE T3,(T1) ;GET ASCIZ NAME FROM ENTRY
CAIG T2,1 ;ENTRY 1 WORD LONG?
SETZ T4, ;YES, ZAP SECOND WORD
DMOVEM T3,CT2 ;RETURN ASCIZ NAME IN T2,T3
MOVSI T1,(POINT 7)
HRRI T1,CT2 ;CONSTRUCT POINTER TO ASCIZ NAME
MOVEI T2,CT1 ;RETURN SIXBIT EQUIVALENT HERE
CALL SEVSIX ;CONVERT NAME TO SIXBIT
RETSKP
KGSTR1: TXNN F,PORTF ;Are we doing a port operation
RET ;No, return failure
SAVET ;
MOVE T1,DSKSTN(DSK) ;Get sixbit name from status block
MOVEM T1,CT1 ;Save it for return
MOVEI T1,CT1 ;Adress of sixbit for SIXSEV
MOVSI T2,(POINT 7)
HRRI T2,CT2 ;Construct pointer to ASCIZ name
CALL SIXSEV ;Convert name to ASCIZ
RETSKP
; KGTVOL - EXTRACT SIXBIT VOLID FROM .VOLID ENTRY
; RETURNS +1: ERROR, MESSAGE SENT TO OPR
; +2: T1/ 0 IF .VOLID ENTRY ABSENT, ELSE SIXBIT VOLID
KGTVOL: SAVEQ
STKVAR<TMPSIX> ;Later, to hold sixbit vol. i.d. value
MOVEI T1,.VOLID
CALL ORNBLF ;VOLID SPECIFIED?
JRST [ SETZ T1, ;NO, RETURN ZERO
SETOM RSBIVN(RSB) ;Consider as non-numeric
RETSKP]
JUMPE T2,KBADV ;MUST HAVE SOMETHING AFTER HEADER
MOVE Q1,T1 ;SAVE ADDRESS OF ASCIZ VOLID
CALL ASCIZL ;GET # OF CHARACTERS IN VOLID
SKIPE T2 ;NULL VOLID IS AN ERROR
CAILE T2,6 ;LONGER THAN 6 CHARACTERS?
JRST KBADV ;YES, ERROR
MOVE T1,Q1 ;FETCH ADDRESS OF VOLID
HRLI T1,(POINT 7) ;MAKE BYTE POINTER
CALL CVTA6R ;CONVERT TO SIXBIT
JRST KBADV ;NOT A LEGAL VOLID
MOVEM T1,TMPSIX ;Save for later use
MOVE T1,Q1 ;Address of vol. i.d. in ASCIZ
CALL ASCIZL ;(T2) = number characters in vol. i.d.
MOVE T1,Q1 ;Make T1 into a pointer to the volume
HRLI T1,(POINT 7) ;i.d. in ASCIZ
ILDB T3,T1 ;Get the 1st volume i.d. character
CAIN T3,"0" ;Is it a zero?
JRST NONUM ;Yes, so consider it as non-numeric
SETZM T4 ;T4 will contain the integer value
SKIPA ;Continue to check the first character
CHKNXT: ILDB T3,T1 ;Next volume i.d. character
CAIL T3,"0" ;Less than zero in value?
CAILE T3,"9" ;No, less or equal to nine?
JRST NONUM ;Not numeric
SUBI T3,"0" ;Change from ASCII to binary
ADD T4,T3 ;Add to the integer volume i.d.
SOSLE T2 ;Don't multiply the units contribution
IMULI T4,^D10 ;Multiply by base 10
JUMPG T2,CHKNXT ;Get the next character
MOVEM T4,RSBIVN(RSB) ;Store the integer value of the i.d.
SKIPA ;Numeric, so skip the next
NONUM: SETOM RSBIVN(RSB) ;Indicate that not numeric
MOVE T1,TMPSIX ;Restore the sixbit value of the i.d.
RETSKP
; KIDN - PROCESS IDENTIFY COMMAND FROM OPR
; RETURNS +1: ALWAYS
KIDN: SAVEQ
SAVEAC <MT,MTA,RSB>
STKVAR <<OWNER,10>> ;LOCAL WORK AREA FOR GETVU ROUTINE
; VALIDATE TAPE DRIVE
MOVEI T1,.TAPDV
CALL ORNBLF ;TAPE DRIVE SPECIFIED?
JRST KBADM ;NO, BAD MESSAGE FROM QUASAR
JXE F,TALCF,KNALC ;REJECT IF ALLOCATION IS NOT ENABLED
CALL STMTA ;CONVERT STRING TO MTA STATUS BLOCK ADDR
JRST KBADM ;NOT MTA DEVICE STRING
MOVEI T1,.ORREQ
CALL ORNBLF ;LOOKUP REQUEST # BLOCK
JRST KIDV ;NOT THERE, MAYBE ANOTHER FORM OF CMD
JUMPE T2,KBADM ;REJECT HEADER-ONLY ENTRY
MOVE Q3,(T1) ;GET REQUEST #
; PROCESS COMMAND: IDENTIFY drive REQUEST-ID n
MOVE T1,Q3 ;GET REQUEST #
CALL REQRSB ;GET RSB ADDRESS FOR THIS REQUEST
JRST KNXREQ ;REQUEST DOES NOT EXIST
HRROI T2,[ASCIZ/Not Waiting For Tape Mount/]
LOAD T3,RSBTYP
CAIE T3,.MNTTP ;TAPE REQUEST?
JRST KACKRQ ;NO, REJECT IT
LOAD T3,RSBSTE ;GET STATE
CAIN T3,RST.WV ;WAITING FOR KEYIN?
JRST [ JSP T2,KACKRQ ;YES, REJECT WITH APPROPRIATE MESSAGE
ASCIZ/Waiting For RESPOND Keyin/]
CAIE T3,RST.WM ;WAITING FOR TAPE MOUNT?
JRST KACKRQ ;NO
CALL VQGCV ;DOES USER WANT A SCRATCH TAPE?
JUMPE T1,KIDR1 ;YES, TAKE ALTERNATE PATH
MOVE Q1,T1 ;SPECIFIC VOLID, SAVE IT
MOVX T2,TM%BYP
TDNE T2,RSBUFL(RSB) ;BYPASS MODE?
SETZ T1, ;YES, KEEP KVAC FROM BARFING
SETZ T2, ;NOT SCRATCH
CALL KVAC ;OK TO SET NEW VOLID?
RET ;NO, ERROR MESSAGE SENT
MOVEM Q1,MTAIDV(MTA) ;SET ALLEGED VOLID
EXCH Q1,MTAVOL(MTA) ;SET NEW VOLID, SAVE OLD
CALL VRA ;TRY TO MATCH REQUEST TO VOLUME NOW
SKIPA ;DIDN'T MATCH
RET ;DID MATCH, ALL DONE
MOVEM Q1,MTAVOL(MTA) ;RESTORE OLD VOLID
CALL CHKAB ;REQUEST ABORTED?
JRST KIDR0 ;YES, CLEAN UP AND LEAVE
CALL VOLMNT ;STILL THERE, TRY TO MOUNT AGAIN
JN MTAJCT,,R ;RETURN IF AVR IN PROGRESS
KIDR0: SETZM MTAIDV(MTA) ;REQ ABORTED OR NOT DOING AVR
RET
; SAME AS ABOVE, BUT USER IS REQUESTING SCRATCH VOLUME
KIDR1: SETZ T1, ;NOT SETTING VOLID
MOVEI T2,1 ;SCRATCH
CALL KVAC ;OK TO SCRATCH THIS VOLUME?
RET ;NO, ERROR MESSAGE SENT
LOAD T1,MTALT
CAIN T1,.LTT20 ;TOPS-20 LABELED TAPE?
JRST [ JN MA%SCR,MTAFLG(MTA),.+1 ;YES, OK IF ALREADY SCRATCH
MOVEI T1,OWNER ;SUPPLY WORK AREA ADDRESS TO GETVU
CALL GETVU ;GET TAPE OWNER'S USER # IN T2
CAME T2,RSBUNO(RSB) ;OWNER AND REQUESTOR THE SAME?
JRST KNOSCR ;NO, REJECT KEYIN
JRST .+1] ;YES, PERMIT IT
MOVE Q1,MTAFLG(MTA) ;SAVE FLAGS
SETONE MA%SCR,MTAFLG(MTA) ;SET SCRATCH
SETZRO MA%OPF,MTAFLG(MTA) ;CLEAR OVERWRITE-PROTECTED
CALL VRA ;TRY TO MATCH REQUEST TO VOLUME
SKIPA ;DIDN'T MATCH
RET ;DID MATCH, ALL DONE
MOVX Q2,MA%SCR+MA%OPF ;RESTORE MA%SCR AND MA%OPF IN MTAFLG
AND Q1,Q2
ANDCAM Q2,MTAFLG(MTA)
IORM Q1,MTAFLG(MTA)
CALL CHKAB ;REQUEST ABORTED?
RET ;YES
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%I%M Tape Not Compatible With Request %1D>
MOVEI T3,TMCMSG
CALLRET BTACK ;SEND IT OFF
; PROCESS FOLLOWING FORMS OF IDENTIFY COMMAND:
; IDENTIFY drive VOLUME-ID volid
; IDENTIFY drive SCRATCH-TAPE
KIDV: CALL KGTVOL ;LOOKUP .VOLID ENTRY
RET ;SOME ERROR, OPERATOR NOTIFIED
MOVE Q1,T1 ;SAVE VOLID IN Q1
MOVEI T1,.SCRTP
MOVEI Q2,1 ;ASSUME SCRATCH SPECIFIED
CALL ORNBLF ;SCRATCH SPECIFIED?
JRST [ SETZ Q2, ;NO, SET NO SCRATCH
JUMPN Q1,.+1 ;ARE .SCRTP AND .VOLID BOTH ABSENT?
JRST KBADM] ;YES, BAD MESSAGE
JUMPN Q2,[MOVE T1,MTAFLG(MTA) ;IF SCRATCHING, GET FLAGS
LOAD T2,MTALT ;AND LABEL TYPE
TXNN T1,MA%SCR ;ALREADY SCRATCH?
CAIE T2,.LTT20 ;OR NOT TOPS-20 LABEL?
JRST .+1 ;YES TO EITHER, OK TO SCRATCH
JRST KNOSCR] ;CAN'T SCRATCH TOPS-20 TAPE WITH THE
;IDENTIFY COMMAND - MUST SET TAPE INIT
DMOVE T1,Q1 ;GET VOLID AND SCRATCH FLAG
CALL KVAC ;OK TO DO THIS TO THIS DRIVE?
RET ;NO, ERROR MESSAGE SENT
; EVERYTHING LOOKS LEGAL, NOW DO WHAT THE OPERATOR WANTS
SKIPE Q1 ;SETTING VOLID?
MOVEM Q1,MTAVOL(MTA) ;YES, DO IT
JUMPN Q2,[SETONE MA%SCR,MTAFLG(MTA) ;SETTING SCRATCH FLAG
SETZRO MA%OPF,MTAFLG(MTA) ;CLEAR OVERWRITE PROTECTION
JRST .+1]
CALLRET MATCHV ;TRY TO MATCH VOLUME WITH A REQUEST
; KSHT - PROCESS SHOW STATUS TAPE-DRIVE COMMAND FROM OPR
; ACCEPTS IPCF MESSAGE IN RBUF
; RETURNS +1: ALWAYS
KSHT: SAVEQ
JXE F,TALCF,KNALC ;REJECT IF ALLOCATION IS NOT ENABLED
TMCTN <%I
Drive State Volid Req# Job# User
----- ----- ------ ---- ---- ---->
MOVE T1,RBUF+.OFLAG ;GET FLAGS
TXNE T1,ST.AVA ;/FREE
TMCTN <%I
Drive State Avr Write Volid Scr Lbl Type Density
----- ----- --- ----- ------ --- -------- ------->
TXNE T1,ST.CHR ;CHARACTERISTICS
TMCTN <%I
Drive Type Supported Densities
----- --------------- ------------------->
TMCTO ;INSERT HEADING
MOVE Q1,TMCPTR ;GET CURRENT TEXT POINTER
MOVEI T1,KSHSCR ;GET COROUTINE ADDRESS
CALL KTXCT ;BUILD THE BODY OF THE DISPLAY
JRST KBADM ;BAD IPCF MESSAGE
CAME Q1,TMCPTR ;Anything displayed?
JRST [MOVEI T3,[ASCIZ/Tape Drive Status/] ;Yes
CALL BTNFO ;REQUEST NO FORMATTING
MOVE T4,RBUF+.MSFLG ;[6010]Get the message flag word
TXNE T4,MF.NEB ;[6010]From NEBULA
SETOM NEBMSG ;[6010]Yes
CALLRET BTACKT] ;SEND DISPLAY TO OPERATOR AND SPLIT
MOVEI T3,[ASCIZ/There Are No Free Tape Drives/] ;No, assume free drives
LOAD T2,ST.AVA,RBUF+.OFLAG ;Get the switch
SKIPN T2 ;Asking for free-drive display?
MOVEI T3,[ASCIZ/There Are No Tape Drives/] ;No
MOVE T4,RBUF+.MSFLG ;[6010]Get the message flag word
TXNE T4,MF.NEB ;[6010]From NEBULA
SETOM NEBMSG ;[6010]Yes
CALLRET BTACK
; COROUTINE FOR SHOW STATUS
KSHSCR: SAVEQ
SAVEAC <MT,RSB>
MOVE Q3,RBUF+.OFLAG ;GET MESSAGE FLAGS
JXN Q3,ST.AVA,KSHF ;/FREE
JXN Q3,ST.CHR,KSHC ;/CHARACTERISTICS
; SHOW STATUS TAPE-DRIVE [/ALL]
LOAD MT,MTAMT ;GET ADDRESS OF MT STATUS BLOCK
JE MTASTE,,[CALL GMTADD ;DRIVE UNAVAILABLE, GET DESIGNATOR
DVCHR ;GET LH(T3)/ OWNER'S JOB#
TLNN T3,-1 ;SHOW IF PHYSICAL DEVICE EXISTS
CALL CKMPAV ;SHOW IF SET UNAVAILABLE
JRST .+1
RET] ;DON'T SHOW
TMCT <%_%M%8C> ;DISPLAY DRIVE NAME
LOAD Q1,MTASTE
CAIE Q1,S.AV ;AVAILABLE TO USERS?
JRST [ JUMPE Q1,[TMCTR <Unavailable>] ;NO
TMCT <Initialize>
LOAD RSB,MTRSB ;GET RSB ADDRESS
SKIPN RSBWTB+WTBCOD(RSB) ;WAITING FOR OPER RESPONSE?
RET ;NO
TMCTR <, operator response wait>]
MOVE Q1,MTAFLG(MTA) ;GET MTA FLAGS
JXE Q1,MA%LOD,[TMCT <Unloaded>
JRST KSHN1]
MOVEI T1,[ASCIZ/Loaded/] ;ASSUME JUST LOADED
SKIPE MT ;RIGHT?
MOVEI T1,[ASCIZ/In Use/] ;NO, CHANGE TO IN USE
TMCT <%1A%18C> ;DISPLAY STATE
SKIPE T1,MTAVOL(MTA) ;DO I KNOW VOLID?
CALL [ TMCTR <%1S>] ;YES, DISPLAY IT
JUMPE MT,KSHN1 ;THAT'S ALL IF NO USER
LOAD RSB,MTRSB ;GET REQUEST STATUS BLOCK ADDRESS
CAIN RSB,MTNAV ;MT OWNED BY PHANTOM USER?
JRST KSHN1 ;YES, THAT'S ALL
MOVE T1,RSBITN(RSB) ;GET REQUEST #
LOAD T2,RSBJNO ;GET JOB #
MOVE T3,RSBUNO(RSB) ;GET USER #
TMCT <%26C%1D%32C%2D%38C%3U> ;SHOW USER INFO
KSHN1: JXE Q3,ST.ALL,R ;/ALL REQUESTED?
LOAD T1,MA%AVE,Q1 ;YES, GET AVR STATUS
TMCT <%_%8CAVR: %1Y> ;DISPLAY AVR STATE
JXE Q1,MA%LOD,R ;EXIT IF NOT LOADED
LOAD T1,MA%WEN,Q1 ;GET WRITE-ENABLED FLAG
TMCT <, Write: %1Y> ;DISPLAY IT
LOAD T1,MTALT ;GET LABEL TYPE
JUMPE T1,R ;NOT IDENTIFIED YET
MOVE T2,LTTXT(T1) ;GET LABEL-TYPE TEXT
MOVEI T3,[0] ;ASSUME UNLABELED
CAIE T1,.LTUNL
MOVEI T3,[ASCIZ/ labels/]
TXNE Q1,MA%SCR ;SCRATCH?
MOVEI T3,[ASCIZ/ scratch tape/]
TMCT <, %2A%3A> ;SHOW LABEL TYPE, SCRATCH
CAIN T1,.LTUNL ;UNLABELED?
RET ;YES
LOAD T2,MTADEN ;LABELED, SHOW DENSITY
MOVE T2,DENTAB(T2)
TMCTR <, %2D BPI>
; SHOW STATUS TAPE-DRIVE /FREE
KSHF: LOAD T1,MTASTE ;GET STATE
CAIE T1,S.AV ;AVAILABLE TO USERS?
RET ;NO, SKIP IT
JN MTAMT,,R ;DON'T SHOW IF A USER HAS IT
MOVE T1,MTAFLG(MTA) ;GET FLAGS
MOVEI T2,[ASCIZ/Unloaded/] ;ASSUME UNLOADED
TXNE T1,MA%LOD ;LOADED?
MOVEI T2,[ASCIZ/Loaded/] ;YES
LOAD T3,MA%AVE,T1 ;GET AVR FLAG
TMCT <%_%M%8C%2A%17C%3Y> ;DISPLAY DRIVE, STATE, AVR
JXE T1,MA%LOD,R ;END OF LINE IF DRIVE NOT LOADED
LOAD T2,MA%WEN,T1 ;GET WRITE-ENABLED FLAG
MOVE T3,MTAVOL(MTA) ;GET VOLID
LOAD T4,MA%SCR,T1 ;GET SCRATCH FLAG
TMCT <%23C%2Y%29C%3S%37C%4Y> ;DISPLAY WRITE, VOLID, SCRATCH
LOAD T1,MTALT ;GET LABEL TYPE
JUMPE T1,R ;UNKNOWN
MOVE T2,LTTXT(T1) ;GET POINTER TO TEXT
TMCT <%42C%2A> ;DISPLAY LABEL TYPE
CAIN T1,.LTUNL ;LABELED?
RET ;NO, DONE
LOAD T2,MTADEN ;YES, GET DENSITY CODE
MOVE T2,DENTAB(T2) ;GET DENSITY
TMCTR <%52C%2D> ;DISPLAY AND RETURN
; SHOW STATUS TAPE-DRIVE /CHARACTERISTICS
KSHC: JE MTASTE,,R ;DON'T SHOW DRIVE IF I DON'T CONTROL IT
LOAD T1,MTADRV ;GET DRIVE TYPE CODE
MOVE T1,DRVTXT(T1) ;GET ADDRESS OF TEXT
LOAD T2,MTADVT ;Get the device
MOVSI T3,-DVTLEN ;Get number of things in table
KSHCDV: HRRZ T4,DVTTXT(T3) ;Get te drive type from table
CAIN T4,(T2) ;Do they match?
JRST KSHCD2 ;Yes
AOBJN T3,KSHCDV ;Loop to check all of them
SKIPA T2,[EXP [ASCIZ/??/]]
KSHCD2: HLRZ T2,DVTTXT(T3) ;Point to drive type
TMCT <%_%M%8C%2A%15C%1A%25C> ;DISPLAY DRIVE, TYPE
MOVSI T1,-DENMAX-1 ;GET AOBJP POINTER
MOVSI T2,(1B0) ;SET UP INTERROGATION BIT
MOVEI T3,[0] ;NO ", " BEFORE FIRST DENSITY
KSHC1: AOBJP T1,R ;GET OUT OF LOOP IF DONE
LSH T2,-1 ;SHIFT BIT TO NEXT POSITION
TDNN T2,MTASDN(MTA) ;IS THIS DENSITY SUPPORTED?
JRST KSHC1 ;NO, TEST NEXT DENSITY
MOVE T4,DENTAB(T1) ;GET DENSITY
TMCT <%3A%4D> ;DISPLAY DENSITY
MOVEI T3,[ASCIZ/, /] ;SEPARATE SUBSEQUENT DENS WITH A COMMA
JRST KSHC1
; KSTP - PROCESS SET TAPE-DRIVE COMMAND FROM OPR
; RETURNS +1: ALWAYS
KSTP: SAVEQ
SAVEAC <MTA>
JXE F,TALCF,KNALC ;REJECT IF ALLOCATION IS NOT ENABLED
MOVEI T1,.TAPDV
CALL ORNBLF ;TAPE DRIVE SPECIFIED?
JRST KBADM ;NO
CALL STMTA ;CONVERT STRING TO MTA STATUS BLOCK ADDR
JRST KBADM ;BAD MTA STRING
SETZ Q1, ;ASSUME SETTING UNAVAILABLE
MOVEI T1,.DVUAV
CALL ORNBLF ;CHECK IF SETTING UNAVAILABLE
JRST [ MOVEI T1,.DVAVL ;NO
CALL ORNBLF ;SETTING AVAILABLE?
SKIPA ;NO
AOJA Q1,KSTPA ;SETTING AVAILABLE
MOVEI T1,.DVINI
CALL ORNBLF ;SETTING INITIALIZE MODE?
JRST KBADM ;NO, BAD MESSAGE
CALLRET KVI] ;YES, GO DO IT
; SETTING DRIVE UNAVAILABLE
MOVEI T1,.ORREA
CALL ORNBLF ;REASON BLOCK PRESENT?
JRST KBADM ;NO
MOVE Q2,T1 ;COPY ADDRESS OF REASON TEXT
CALL CKMPAV ;IS DRIVE ALREADY SET UNAVAILABLE?
KSTP1: JRST [ MOVE T1,[[ASCIZ/Unavailable/]
[ASCIZ/Available/]](Q1) ;GET TEXT POINTER
TMCT <%ITape Drive %M Is Already Set %1A>
MOVEI T3,TMCMSG
CALLRET BTACK] ;TELL OPRTR HIS COMMAND HAS NO EFFECT
LOAD T1,MTASTE
CAIN T1,S.INIT ;IN INITIALIZE MODE?
JRST [ CALL KVICU ;YES, CAN I GET OUT OF IT NOW?
RET ;NO
JRST .+1] ;YES, CONTINUE
MOVEI T1,CS%DDV ;GET CODE FOR DETACH-DEVICE
MOVE T2,Q2 ;GET ADDRESS OF ASCIZ REASON
CALL SYTSET ;LOG SYSERR ENTRY FOR DRIVE SET UNAVAIL
CALL DACMTA ;DEACTIVATE THE DRIVE IF POSSIBLE
MOVEI T1,1 ;GET 1 TO SET UNAVAILABLE
CALL SMPAV ;UPDATE DEVICE STATUS FILE
CALL WOTDAV ;TELL ALL OPERATORS WHAT HAPPENED
RET
; SETTING DRIVE AVAILABLE
KSTPA: LOAD T1,MTASTE ;GET CURRENT STATE
CAIN T1,S.INIT ;INITIALIZING VOLUMES?
JRST [ CALL KVICU ;YES, CLEAR INITIALIZE STUFF
RET ;CAN'T DO IT NOW
CALLRET KVIDAV] ;GET BACK TO AVAILABLE STATE
SETZ Q2, ;REMEMBER INITIAL SMPAV STATE IN Q2
SKIPE T1 ;OK IF DRIVE NOT BEING SCHEDULED
CALL CKMPAV ;OK IF DRIVE SET UNAVAILABLE
TDZA Q2,Q2 ;ONE OF THE ABOVE CONDITIONS WAS TRUE
JRST KSTP1 ;NEITHER TRUE, THAT'S AN ERROR
SETZ T1,
CALL SMPAV ;SET AVAILABLE IN STATUS FILE
MOVEI T1,S.AV ;GET DESIRED STATE
CALL ACTMTA ;TRY TO ACTIVATE THE MTA
JRST KSTP3 ;CAN'T, SO SEND DIAGNOSTIC TO OPR
CALL TDSC1 ;CHECK IF LOADED, DO AVR, ETC.
JUMPE Q2,[MOVEI T1,CS%ADV ;GET CODE FOR ATTACH-DEVICE
SETZ T2, ;NO REASON
CALL SYTSET ;LOG SYSERR ENTRY FOR DRIVE SET AVAIL
JRST .+1]
CALLRET WOTDAV ;TELL OPERATORS IT'S BACK
; Can't assign tape drive to us, T1/ job of assigner or error code
KSTP3: MOVE Q2,T1 ;SAVE JOB #
;**;[6040]At KSTP3:+1L replace 3 lines with 8 lines GAS
TMCT <%I%M > ;[6040] Start message with "MTAx: "
MOVE T1,Q2 ;[6040] Get job or error code back
JUMPE Q2,[TMCT <Unknown to this system> ;[6040] If job 0
JRST KSTP2] ;[6040] Tape drive not known yet
CAIL Q2,.ERBAS ;[6040] Is it some other error code?
JRST [ TMCT <%1J> ;[6040] Yes, print that error code
JRST KSTP2] ;[6040] and continue
TMCT <Assigned to Job %1D> ;[6040] Tape is assigned to another job
KSTP2: MOVEI T3,[ASCIZ/Cannot Set Tape Drive Available/]
CALLRET BTACKT ;TELL OPERATOR WHY I CAN'T SET AVAIL
; KSWI - PROCESS SWITCH COMMAND FROM OPR
; RETURNS +1: ALWAYS
; VALIDATE REQUEST NUMBER AND STATE
KSWI: SAVEQ
SAVEAC <MT,MTA,RSB>
MOVEI T1,.ORREQ
CALL ORNBLF ;LOOKUP REQUEST #
JRST KBADM ;NOT THERE
MOVE T1,(T1) ;GET REQ#
CALL REQRSB ;FIND RSB
JRST KNXREQ ;UNKNOWN REQUEST #
MOVEI T2,[ASCIZ/Not Using An Unlabeled Tape/]
LOAD T3,RSBTYP ;GET REQ TYPE
CAIE T3,.MNTTP ;TAPE-MOUNT REQUEST?
JRST KACKRQ ;NO, REJECT IT
LOAD T3,RSBSTE ;GET STATE
LOAD T4,RSBLT ;GET LABEL-TYPE
CAIN T3,RST.AC ;MUST BE ACTIVE
CAIE T4,.LTUNL ;MUST HAVE UNLABELED TAPE
JRST KACKRQ ;DOESN'T QUALIFY, REJECT IT
LOAD MT,RSBMT ;GET MT STATUS BLOCK ADDRESS
; VALIDATE VOLID
CALL KGTVOL ;LOOKUP VOLID
RET ;SCREWED-UP VOLID
SKIPN Q1,T1 ;WAS THERE A .VOLID ENTRY?
JRST KBADM ;NO, BAD NEWS
; CHECK IF TAPE DRIVE SPECIFIED
SETZ MTA, ;ASSUME NO DRIVE SPECIFIED
MOVEI T1,.TAPDV
CALL ORNBLF ;TAPE DRIVE SPECIFIED?
JRST KSWI1 ;NO
CALL STMTA ;YES, LOAD MTA AC FOR THIS DRIVE
JRST KBADM ;BAD DRIVE NAME FROM QUASAR
LOAD T1,MTMTA ;GET CURRENT DRIVE
CAMN T1,MTA ;SWITCHING TO SAME DRIVE?
JRST [ MOVEI T3,[ASCIZ/Cannot SWITCH To Same Drive/] ;YES
CALLRET BTACK]
MOVE T1,Q1 ;GET VOLID
SETZ T2, ;NOT SETTING SCRATCH
CALL KVAC ;CHECK IF I CAN USE THIS MTA
RET ;NO, ERROR MSG SENT
LOAD T1,MTALT
CAIE T1,.LTUNL ;UNLABELED TAPE?
JRST [ TMCT <%I%M Does Not Contain An Unlabeled Tape>
MOVEI T3,TMCMSG
CALLRET BTACK] ;TELL OPERATOR
KSWI1:
; COMMAND HAS BEEN VALIDATED, NOW PERFORM SPECIFIED TASKS
CALL GMTDD ;GET MT DEVICE DESIGNATOR IN T1
LDB T2,[POINT 9,T1,35] ;GET MT UNIT# IN T2
MOVEI T1,.MTCVV ;FUNCTION CODE = CLEAR VOLUME-VALID
MTU% ;YANK MT AND MTA APART IN MONITOR
ERJMP [MOVE T1,RSBITN(RSB) ;CAN'T DO IT, GET REQUEST #
TMCT <%ICannot SWITCH - Request %1D Has Tape Drive Open>
MOVEI T3,TMCMSG
CALLRET BTACK] ;TELL OPR THE BAD NEWS
MOVX T1,TM%NUL
MOVE Q2,RSBUFL(RSB) ;GET CURRENT SETTING OF UNLOAD FLAG
AND Q2,T1 ;EXTRACT TM%NUL FLAG
ANDCAM T1,RSBUFL(RSB) ;MAKE SURE TAPE GETS UNLOADED
CALL PLDISA ;DISASSOCIATE MT&MTA IN MY TABLES
IORM Q2,RSBUFL(RSB) ;RESTORE USER SETTING OF TM%NUL
LOAD T1,RSBCV ;GET CURRENT VOLUME #
MOVE T2,Q1 ;GET VOLID
CALL VQSET ;SET NEW VOLID IN USER REQUEST
CALL STOP ;VOLID LIST SCREWED UP
JUMPE MTA,[CALLRET VOLMNT] ;NO MTA SPECIFIED, REQUEST TAPE MOUNT
; TRY TO ASSOCIATE SPECIFIED DRIVE WITH USER REQUEST
MOVEI T1,RST.WM
STOR T1,RSBSTE ;SET REQUEST WAITING FOR MOUNT
EXCH Q1,MTAVOL(MTA) ;SET NEW VOLID
CALL VRA ;TRY TO ASSOCIATE REQUEST WITH DRIVE
SKIPA ;NO GO
RET ;ASSOCIATION DONE, EXIT
MOVEM Q1,MTAVOL(MTA) ;RESTORE OLD VOLID
CALL CHKAB ;REQUEST ABORTED?
RET ;YES
CALLRET VOLMNT ;NO, ASK FOR VOLUME
; KTXCT - IMPLEMENTS EXECUTION OF MTA FUNCTION FOR ONE OR ALL TAPE
; DRIVES, ACCORDING TO PRESENCE OF .TAPDV AND .ALTAP BLOCKS
; T1/ ADDRESS OF COROUTINE TO BE CALLED; COROUTINE RECEIVES MTA
; STATUS BLOCK ADDRESS IN MTA AC, AND RETURNS +1 ALWAYS
; RETURNS +1: ERROR IN COMMAND MESSAGE
; +2: SUCCESS
KTXCT: SAVEAC <MTA>
SAVEQ
MOVE Q2,T1 ;SAVE COROUTINE ADDRESS
MOVEI T1,.ALTAP
CALL ORNBLF ;LOOKUP ALL-TAPES BLOCK
TDZA MTA,MTA ;NOT THERE, CLEAR MTA
MOVEI MTA,MTA0 ;ALL TAPES, POINT AT MTA0 STATUS BLOCK
MOVEI T1,.TAPDV
CALL ORNBLF ;LOOKUP SPECIFIC-TAPE-DRIVE BLOCK
JRST [ JUMPE MTA,R ;NO TAPE INFO SPECIFIED, BAD MESSAGE
MOVE Q1,MTAN ;ALL DRIVES, GET # OF DRIVES
JRST KTXCT1] ;GO DO THEM
JUMPN MTA,R ;CAN'T HAVE BOTH!
CALL STMTA ;GET MTA STATUS BLK ADDR FROM STRING
RET ;STRING DOESN'T SPECIFY MTA DEVICE
MOVEI Q1,1 ;DOING 1 DRIVE
KTXCT1: CALL (Q2) ;CALL COROUTINE
ADDI MTA,MTASZ ;POINT AT NEXT MTA STATUS BLOCK
SOJG Q1,KTXCT1 ;LOOP THRU SPECIFIED # OF DRIVES
RETSKP
; KUNL - PROCESS UNLOAD COMMAND FROM OPR
; RETURNS +1: ALWAYS
KUNL: SAVEQ
SAVEAC <MTA>
MOVEI T1,.TAPDV
CALL ORNBLF ;TAPE DRIVE SPECIFIED?
JRST KBADM ;NO, REJECT MESSAGE
JXE F,TALCF,KNALC ;REJECT IF ALLOCATION IS NOT ENABLED
CALL STMTA ;CONVERT STRING TO MTA STATUS BLK ADDR
JRST KBADM ;ERROR, BAD MESSAGE
MOVE Q1,MTAFLG(MTA) ;GET FLAGS
CALL KCAVL ;DRIVE AVAILABLE TO USERS?
RET ;NO
JN MTAMT,,[CALL KCUSE ;GIVE ERROR IF A USER HAS THE DRIVE
JFCL ;SHOULD ALWAYS RETURN +1
RET]
JN MTAJCT,,[SETONE MA%ULP,MTAFLG(MTA) ;IN USE BY ME, SET UNLOAD
JRST KUNL1] ; PENDING
CALL UNLOAD ;NOT IN USE BY ME, UNLOAD IT
KUNL1: TXNN Q1,MA%LOD ;DID I THINK IT WAS LOADED?
SETZM MTAVOL(MTA) ;NO, SUPPRESS VOLID IN UNLOAD MESSAGE
CALLRET WOUNL ;TELL OPERATORS IT'S UNLOADED
; KVAC - CHECK IF LEGAL FOR OPERATOR TO CHANGE VOLUME ATTRIBUTES
; T1/ 0 IF NOT CHANGING VOLID, NON-ZERO IF CHANGING VOLID
; T2/ 0 IF NOT SETTING SCRATCH, NON-ZERO IF SETTING SCRATCH
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: FUNCTION ILLEGAL, ERRROR MESSAGE SENT TO OPERATOR
; +2: FUNCTION IS LEGAL
KVAC: SAVEQ
DMOVE Q1,T1 ;COPY ARGS TO A SAFE PLACE
CALL KCAVL ;DRIVE MUST BE AVAILABLE TO USERS
RET
CALL KCLOAD ;DRIVE MUST BE LOADED
RET
CALL KCUSE ;DRIVE MUST NOT BE IN USE
RET
LOAD Q3,MTALT ;GET LABEL TYPE
JUMPN Q1,[JUMPE Q3,.+1 ;VOLID OK IF AVR NOT PERFORMED YET
CAIN Q3,.LTUNL ;WHAT KIND OF TAPE?
JRST .+1 ;UNLABELED, VOLID OK HERE
JSP T1,KVAX ;CAN'T SPECIFY VOLID FOR LABELED TAPE
ASCIZ/Cannot Change Volid Of Labeled Tape/]
JUMPE Q2,RSKP ;OK IF NOT SETTING SCRATCH
MOVE T1,MTAFLG(MTA) ;GET FLAGS
JXN T1,MA%UXV,[JSP T1,KVAX ;CAN'T SCRATCH AN UNEXPIRED VOLUME
ASCIZ/Cannot Scratch - Volume Is Not Expired/]
JXE T1,MA%WEN,[JSP T1,KVAX ;CAN'T SCRATCH A WRITE-PROTECTED VOL
ASCIZ/Cannot Scratch - Drive Is Write-Protected/]
JUMPE Q3,[JSP T1,KVAX ;CAN'T SCRATCH UNTIL I'VE DONE AVR
ASCIZ/Cannot Scratch - AVR Not Enabled/]
RETSKP
; ERROR DETECTED, T1/ ADDR OF ERROR TEXT
KVAX: TMCT <%I%M %1A>
MOVEI T3,TMCMSG ;GET ADDRESS OF MESSAGE
CALLRET BTACK ;SEND ERROR MESSAGE AND RETURN +1
; KVI - SUPPORT VOLUME INITIALIZATION UNDER OPR CONTROL
; MTA/ ADDR OF MTA STATUS BLOCK
; RBUF/ "SET TAPE-DRIVE INIT" MESSAGE FROM OPR
; RETURNS +1: ALWAYS
KVI: JE MA%AVS,MTAFLG(MTA),[LOAD T1,MTADRV
MOVE T1,DRVTXT(T1)
TMCT <%ICommand Illegal For %1A Drives>
MOVEI T3,TMCMSG
CALLRET BTACK] ;BLAST THE OPERATOR
CALL KCAVL ;DRIVE IN S.AV STATE?
RET ;NO, CAN'T DO THIS
CALL KCUSE ;DRIVE IN USE?
RET ;YES, ERROR
CALL GORSB ;GET RSB FOR INITIALIZATION
RET ;RSB POOL EXHAUSTED, MESSAGE TYPED
MOVEI T1,.MNTTP
STOR T1,RSBTYP ;SET RSB TYPE = TAPE-MOUNT
MOVEI T1,RST.AC
STOR T1,RSBSTE ;SET RSB ACTIVE
CALL KVIRSB ;BUILD RSB FROM USER PARAMETERS
RET ;ERROR, RSB ABORTED, MESSAGE SENT TO OPR
MOVEI T1,S.INIT
STOR T1,MTASTE ;PUT TAPE DRIVE IN PROPER STATE
MOVEI MT,RSBIMT(RSB) ;GET PSEUDO-MT STATUS BLOCK ADDRESS
STOR RSB,MTRSB ;LINK MT TO RSB
STOR MT,RSBMT ;LINK RSB TO MT
STOR MTA,MTMTA ;LINK MT TO MTA
STOR MT,MTAMT ;LINK MTA TO MT
; GET VOLID OF VOLUME TO BE INITIALIZED
KVI0: LOAD T1,RSBLT
CAIE T1,.LTUNL ;UNLABELED?
SKIPE RSBIVL(RSB) ;OR DO I KNOW THE VOLID?
JRST KVI2A ;YES TO EITHER, PROCEED
KVI1: JSP T1,KVIMR1 ;NO, HAVE TO ASK OPERATOR
MOVEI RSB,-RSBWTB(T2) ;GET RSB ADDRESS
LOAD MT,RSBMT
LOAD MTA,MTMTA ;GET MTA STATUS BLOCK ADDR
CALL PINI ;PARSE RESPONSE
JRST KVI1 ;ERROR, TRY IT AGAIN JACK
KVI2: MOVEM T1,RSBIVL(RSB) ;REMEMBER VOLID
; MAKE SURE DRIVE IS READY, DO AVR IF NEEDED
KVI2A: JN MTAJCT,,R ;WAIT IF AVR OR REWIND IN PROGRESS
MOVE T1,MTAFLG(MTA) ;GET FLAGS
JXE T1,MA%LOD,KVIM1 ;IF TAPE NOT UP, SAY SO
TXNE T1,MA%AVE ;WANT TO CHECK IF EXPIRED?
JRST [ JE MTALT,,[CALLRET AVR] ;YES, DO AVR IF NOT DONE YET
JXE T1,MA%UXV,.+1 ;AVR DONE, OK IF EXPIRED
CALL KVIM4 ;TELL OPERATOR IT'S NOT EXPIRED
CALL UNLOAD ;UNLOAD IT
JRST KVIM1] ;ASK HIM TO DO IT AGAIN
CALL MTAGJF ;LOCK UP THE DRIVE
MOVEI T1,KVI2B ;GET REWIND END-ACTION ADDRESS
CALL REWEA ;REWIND
JRST KVI2B ;FAILED, MA%LOD CLEARED
RET ;EXIT UNTIL REWIND COMPLETES
; REWIND END-ACTION
KVI2B: CALL MTARJF ;RELEASE LOCK
LOAD MT,MTAMT
LOAD RSB,MTRSB ;RESTORE RSB ADDRESS
JE MA%LOD,MTAFLG(MTA),KVIM1 ;ASK FOR TAPE IF NOT LOADED
; WRITE LABELS TO TAPE
MOVE T1,RSBIVL(RSB) ;GET VOLID
MOVEM T1,MTAVOL(MTA) ;STUFF IT FOR LTINIT
SETONE R%WVL,RSBIFL(RSB) ;REQUEST LTINIT TO WRITE LABELS
CALL LTINIT ;WRITE LABELS TO TAPE
JRST KVIM1 ;ERROR, TELL OPERATOR TO MOUNT AGAIN
CALL KVIM2 ;TELL OPERATOR WHAT HAPPENED
MOVX T1,TM%NUL
TDNN T1,RSBUFL(RSB) ;UNLOAD REQUESTED?
CALL UNLOAD ;YES, DO IT
; CHECK IF MORE INITIALIZATIONS LEFT TO DO
SOSG RSBICT(RSB) ;ANY TAPES LEFT TO DO?
JRST [ CALL KVICU ;NO, CLEAR INITIALIZE STUFF
CALL STOP
CALLRET KVIDAV] ;GET BACK TO AVAILABLE STATE
SETZM RSBIVL(RSB) ;YES, CLEAR VOLID
SKIPN T1,RSBIVI(RSB) ;DOING NUMERIC VOLIDS?
JRST KVI0 ;NO, MUST ASK FOR NEXT VOLID
ADD T1,RSBIVN(RSB) ;YES, STEP TO NEXT VOLID
MOVEM T1,RSBIVN(RSB) ;RESTORE NUMERIC VOLID
CALL INT26L ;Convert to sixbit
JRST KVI2 ;GO GET IT MOUNTED
; KVICU - PROCESS REQUEST TO CANCEL INITIALIZATION SERIES
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE BUSY, OPERATOR TOLD ABOUT FAILURE
; +2: SUCCESS, TAPE DRIVE INITIALIZE STATE IS CLEARED
KVICU: SAVEAC <MT,RSB>
LOAD MT,MTAMT
LOAD RSB,MTRSB ;GET RSB ADDRESS
JN MTAJCT,,[JSP T1,KC1 ;ERROR IF DRIVE BUSY
ASCIZ/Busy/]
SETZRO MTAMT ;CLEAR MTA LINK TO MT
SETZRO RSBMT ;CLEAR RSB LINK TO MT
SETZRO MA%LOD,MTAFLG(MTA) ;CLEAR DRIVE-LOADED
ABTREQ (ABRTNR) ;DUMP THE RSB
RETSKP
; KVIDAV - EXIT FROM INITIALIZE MODE TO AVAILABLE MODE
KVIDAV: MOVEI T1,S.AV
STOR T1,MTASTE ;SET STATE BACK TO AVAILABLE
CALL AVRENA ;ENABLE AVR IF POSSIBLE
CALL KVIM3 ;TELL OPERATOR THE DRIVE IS AVAIL
CALLRET TDSC1 ;GO CHECK IF DRIVE OCCUPIEDPIPER
; KVITAV - REPORT TAPE DRIVE COMING ONLINE OR AVR COMPLETED
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
KVITAV: SAVEAC <MT,RSB>
LOAD MT,MTAMT
LOAD RSB,MTRSB ;GET RSB ADDRESS
JE MA%WEN,MTAFLG(MTA),[CALL UNLOAD ;WRITE-PROTECTED
TMCT <%I%M Write Protected, Unloading Volume>
MOVEI T3,TMCMSG ;GET ADDRESS OF TEXT
CALLRET BTWTON] ;TELL OPERATOR THE BAD NEWS
SKIPE RSBWTB+WTBCOD(RSB) ;WTOR OUTSTANDING?
RET ;YES, WAIT TILL IT COMES BACK
JN MA%LOD,MTAFLG(MTA),KVI0 ;IF TAPE IS READY, GET THINGS MOVING
RET ;OTHERWISE, STILL HAVE TO WAIT
; KVIM1 - TELL OPERATOR TO MOUNT TAPE TO BE INITIALIZED
KVIM1: TMCT <%IMount tape>
SKIPE T1,RSBIVL(RSB) ;KNOW VOLID?
JRST [ TMCT < volume %1S> ;YES
JRST .+1]
TMCT < for initialization on %M>
MOVEI T3,[ASCIZ/Mount Tape To Be Initialized/]
CALLRET BTWTO ;SEND MESSAGE TO OPERATOR
; KVIM2 - TELL OPERATOR TAPE WAS INITIALIZED SUCCESSFULLY
KVIM2: TMCT <%I%M> ;DISPLAY DRIVE NAME
LOAD T1,RSBLT
CAIN T1,.LTUNL ;UNLABELED TAPE?
JRST [ TMCT < Unlabeled Tape> ;YES, SAY SO
JRST .+2] ;DON'T TYPE VOLID
CALL TMCVOL ;DISPLAY VOLID
TMCT < Initialized>
CALL CPYHDR ;COPY HEADER TO A SAFE PLACE
LOAD T1,RSBLT ;GET LABEL TYPE
MOVE T1,LTTXT(T1) ;GET POINTER TO TEXT
LOAD T2,RSBDEN
MOVE T2,DENTAB(T2) ;GET DENSITY
TMCT <%ILabel type: %1A%25CDensity: %2D>
LOAD T1,RSBLT
CAIE T1,.LTT20 ;TOPS-20 TAPE?
JRST KVIM21 ;NO
TMCT <
Owner: > ;YES, MORE INFO
SKIPN T2,RSBUNO(RSB) ;GET OWNER USER #
JRST [ TMCT <Scratch> ;IF ZERO, IT'S A SCRATCH TAPE
JRST KVIM21]
TMCT <%2U%23C Protection: >
MOVE T1,TMCPTR
LOAD T2,RSBVPR ;GET PROTECTION CODE
MOVE T3,[NO%LFL+NO%ZRO+FLD(6,NO%COL)+10]
NOUT ;INSTALL IT
SKIPA
MOVEM T1,TMCPTR ;RESTORE UPDATED POINTER
CALL TMC1 ;STANDARD TMC CLEANUP
KVIM21: MOVEI T3,OPRHDR ;GET ADDRESS OF MESSAGE TYPE TEXT
CALLRET BTWTO ;TELL OPERATORS WHAT HAPPENED
; KVIM3 - TELL OPERATOR DRIVE IS NO LONGER INITIALIZING
KVIM3: TMCT <%I%M available for user tape requests>
MOVEI T3,[ASCIZ/INITIALIZE Completed/]
CALLRET BTWTO
; KVIM4 - TELL OPERATOR TAPE I CAN'T INITIALIZE - TAPE IS NOT EXPIRED
KVIM4: TMCT <%I>
CALL TMCVOL ;DISPLAY VOLID
TMCT < on drive %M is not expired, unloading>
MOVEI T3,[ASCIZ/Tape Volume Not Expired/]
CALLRET BTWTO
; KVIMR1 - ISSUE WTOR TO ASK OPERATOR FOR VOLID TO BE INITIALIZED
KVIMR1: STAKT
TMCT <%IWhat is the volume-id of the next tape to be
initialized on drive %M ?
Respond with:
RESPOND n volid>
MOVE T1,CT1 ;GET END-ACTION ADDRESS
MOVEI T2,RSBWTB(RSB) ;GET WTB ADDRESS
MOVEI T3,[ASCIZ/Key In Volume Identifier/]
CALLRET BTWTOR
; KVIRSB - SCAN "SET TAPE INITIALIZE" IPCF MESSAGE FROM OPR AND
; BUILD REQUEST STATUS BLOCK
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED, OPERATOR NOTIFIED, RSB ABORTED
; +2: SUCCESS, INFORMATION STORED IN RSB
KVIRSB: CALL KGTVOL ;GET VOLID
JRST KVIABT ;ERROR, MESSAGE SENT
MOVEM T1,RSBIVL(RSB) ;STORE VOLID OR 0 IF NONE
MOVE T1,RSBIVN(RSB) ;Get the integer volume i.d.
JUMPL T1,KVIR2 ;Don't increment if not an integer
CALL INT26L ;convert to sixbit
MOVEM T1,RSBIVL(RSB) ;set sixbit volid too
MOVEI T1,.SIINC ;code for numeric volid increment
SETZ T2, ;no limit
MOVEI T3,1 ;default = 1
CALL KGBLK ;lookup increment
JRST KVIBM ;error
MOVEM T1,RSBIVI(RSB) ;store increment
KVIR2: ;
MOVEI T1,.SILBT ;CODE FOR LABEL TYPE
MOVEI T2,.LTMAX ;LIMIT
MOVEI T3,.LTT20 ;DEFAULT
CALL KGBLK ;LOOKUP LABEL TYPE
JRST KVIBM ;ERROR
STOR T1,RSBLT ;STORE LABEL TYPE
MOVEI T1,.SIDEN ;CODE FOR DENSITY
MOVEI T2,DENMAX ;LIMIT
MOVE T3,DEFDEN ;DEFAULT
CALL KGBLK ;LOOKUP DENSITY
JRST KVIBM ;ERROR
STOR T1,RSBDEN ;STORE DENSITY
CALL DRVDEN ;CAN THE DRIVE OPERATE AT THIS DENSITY?
JRST [ LOAD T1,RSBDEN ;NO
MOVE T1,DENTAB(T1) ;GET NUMERIC DENSITY
TMCT <%I%1D BPI Is Not Supported On %M>
MOVEI T3,TMCMSG ;GET MESSAGE ADDRESS
CALL BTACK ;SEND ERROR MESSAGE
JRST KVIABT] ;ABORT REQUEST
MOVEI T1,.SICTR ;CODE FOR COUNT BLOCK
HRLOI T2,377777 ;LIMIT
MOVEI T3,1 ;DEFAULT
CALL KGBLK ;LOOKUP COUNT
JRST KVIBM ;ERROR
MOVEM T1,RSBICT(RSB) ;STORE COUNT
MOVEI T1,.SIHLD ;REQUESTED TO KEEP TAPE ON DRIVE?
CALL ORNBLF
SKIPA ;NO
JRST [ MOVE T1,RSBICT(RSB) ;YES, GET COUNT
MOVX T2,TM%NUL
CAIN T1,1 ;INITIALIZING 1 TAPE?
IORM T2,RSBUFL(RSB) ;YES, OK TO KEEP ON DRIVE
JRST .+1]
MOVEI T1,.SIOWN ;CODE FOR OWNER-ID
SETZB T2,T3 ;NO LIMIT, DEFAULT = 0 (SCRATCH)
CALL KGBLK ;LOOK OWNER-ID
JRST KVIBM ;ERROR
MOVEM T1,RSBUNO(RSB) ;STORE OWNER-ID
MOVEI T1,.SIPRO ;CODE FOR PROTECTION
SETZ T2, ;NO LIMIT
MOVEI T3,DEFPRO ;DEFAULT
CALL KGBLK ;LOOKUP PROTECTION
JRST KVIBM ;ERROR
STOR T1,RSBVPR ;STORE PROTECTION
MOVEI T1,.SIOVR ;OVERRIDE EXPIRATION-DATE CHECK?
CALL ORNBLF
SKIPA T1,[1] ;NO
SETZ T1, ;YES
STOR T1,MA%AVE,MTAFLG(MTA) ;STORE OVERRIDE FLAG
RETSKP
; ERROR CONDITIONS
KVIBM: CALL BADQM ;ERROR IN IPCF MESSAGE FROM QUASAR
KVIABT: ABTRET (ABRTNR) ;ABORT RSB AND RETURN +1
; ERROR HANDLERS FOR UNSOLICITED OPERATOR KEYINS ("K" ROUTINES)
; RET IS DONE THROUGH BTACK, GIVING ERROR MESSAGE TO OFFENDING OPR
KBADM: MOVE T1,RBUF+.MSFLG ;[6011]Get flag
TXNE T1,MF.NEB ;[6011]Is this from NEBULA?
CALLRET BADNM ;[6011]Yes
CALLRET BADQM ;ERROR IN MESSAGE RECEIVED FROM QUASAR
KNXREQ: MOVEI T2,[ASCIZ/Does Not Exist/]
KACKRQ: TMCT <%IMount Request %1D %2A> ;T1/ REQ#, T2/ ADDRESS OF TEXT
MOVEI T3,TMCMSG
CALLRET BTACK ;SEND IT OFF TO OPERATOR
KBADV: MOVEI T3,[ASCIZ/Illegal Volume Identifier/]
CALLRET BTACK
KNALC: TMCT <%I> ;Clear message buffer
MOVEI T3,[ASCIZ/Tape drive allocation is not enabled/]
CALLRET BTACK
;REJECT IDENTIFY KEYIN TO SCRATCH A TAPE
KNOSCR: STKVAR <<OWNER,10>>
TMCT <%ICannot Scratch %M> ;BUILD HEADING WITH DRIVE NAME
CALL CPYHDR ;SAVE MESSAGE HEADING
MOVEI T1,OWNER ;OWNER'S NAME GOES HERE
CALL GETVU ;GET POINTER TO OWNER'S NAME IN T1
MOVE T2,MTAVOL(MTA) ;GET VOLID
TMCT <%IVolume %2S owned by user %1A>
MOVEI T3,OPRHDR ;POINT TO HEADING
CALLRET BTACKT ;TELL OPERATOR I REJECTED IT
; ORNBCK - CHECK BUILDING BLOCK STRUCTURE OF ORION-STYLE IPCF MESSAGE
; IN RBUF (ASSUMES CKGHDR HAS BEEN CALLED)
; RETURNS +1: ERROR IN BLOCK STRUCTURE
; +2: BLOCK STRUCTURE OK
ORNBCK: MOVE T1,RBUF+.OARGC ;GET # OF ARGS
MOVEI T2,RBUF+.OHDRS ;GET ADDRESS OF 1ST ARG
LOAD T3,MS.CNT,RBUF+.MSTYP ;GET SIZE OF IPCF MESSAGE FROM HEADER
SUBI T3,.OHDRS ;COMPUTE SIZE OF BUILDING BLOCK AREA
CALLRET CKBSTR ;CHECK BLOCK STRUCTURE
; ORNBLF - FIND ARGUMENT BLOCK IN ORION-STYLE IPCF MESSAGE
; T1/ TYPE CODE OF DESIRED ARGUMENT
; RETURNS +1: NO ARGUMENTS OF REQUESTED TYPE FOUND
; +2: SUCCESS, T1/ ADDRESS OF FIRST WORD OF ARGUMENT
; T2/ LENGTH OF ARGUMENT (NOT COUNTING HEADER)
ORNBLF: MOVE T3,T1 ;COPY ARG TYPE TO T3 FOR BLKFND
MOVEI T1,RBUF+.OARGC ;GET ADDRESS OF ARG COUNT WORD
MOVEI T2,RBUF+.OHDRS ;GET ADDRESS OF 1ST BLOCK
CALLRET BLKFND ;CALL BLKFND TO DO LOOKUP
; ORNINI - ESTABLISH IPCF RAPPORT WITH ORION
; RETURNS +1: ALWAYS
ORNINI: STKVAR <TSTFLG> ;FLAG USED ONLY FOR DEBUGGING
SETOM TSTFLG ;INITIALIZE FLAG
ORNIN1: MOVEI T1,.SPOPR
CALL GSYSPD ;GET ORION'S PID FROM SYSTEM PID TABLE
JRST [ AOSN TSTFLG ;HAVE WE BEEN HERE BEFORE?
CALL TSTWAT ;NO, INFORM USER WE ARE WAITING
MOVEI T1,^D5000 ;NOT THERE YET
DISMS ;WAIT 5 SECONDS
JRST ORNIN1] ; AND TRY AGAIN
MOVEM T1,APPID+.APORN ;STUFF PID IN A/P TABLE
GTAD ;GET FAIRLY UNIQUE VALUE IN RH(T1)
HRLM T1,UNIQUE ;INSURE CODES UNIQUE TO SYSTEM STARTUP
RET
; TSTWAT - INFORMS USER WHO WE ARE WAITING FOR IF DEBUGGING
; REQUIRES PONTER TO ASCII PID NAME IN T1
; RETURNS +1: ALWAYS
TSTWAT: SKIPN TSTF ;ARE WE DEBUGGING
RET ;NO
PUSH P,T1 ;SAVE POINTER
TMSG <% MOUNTR Waiting for >
POP P,T1 ;POINTER TO PID NAME STRING
PSOUT ;TYPE IT TO TERMINAL
TMSG <
>
RET ;RETURN
; ORNMRC - PROCESS INCOMING IPCF MESSAGE FROM ORION
; RBUF/ INCOMING IPCF MESSAGE
; MRPDB/ PDB THAT WAS USED TO RECEIVE THE MESSAGE
; RETURNS +1: ALWAYS
ORNMRC: CALL CKGHDR ;GALAXY HEADER OK?
JRST [ CALLRET BADOM] ;NO
CALL ORNBCK ;BLOCK STRUCTURE OK?
JRST [ CALLRET BADOM] ;NO
LOAD T1,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE
CAIN T1,.OMRSP ;WHAT TYPE?
JRST [ CALLRET INWTOR] ;RESPONSE TO WTOR
CAIN T1,.NRDAK ;[6011]What type?
JRST [CALLRET PNEDAC] ;[6011]Remote dismount ACK
LOAD T2,MF.SUF,RBUF+.MSFLG ;GET SIXBIT SUFFIX
CAIN T1,MT.TXT ;TEXT MESSAGE?
JRST [ CAIE T2,'NMC' ;CHECK FOR - NO MESSAGE WITH THIS CODE
CAIN T2,'ODE' ;CHECK FOR - OPR DOESN'T EXIST
RET ;IGNORE THIS ERROR
JRST .+1] ;CAN'T HANDLE THIS TEXT MESSAGE
CALLRET BADOM ;BAD TEXT MESSAGE, REPORT IT
; PINI - PARSE OPERATOR RESPONSE TO REQUEST FOR VOLID TO BE INIT'ED
; T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
; RETURNS +1: ERROR, MESSAGE SENT TO OPERATOR
; +2: SUCCESS, T1/ SIXBIT VOLID
PINI: SAVET ;SETUP TO RETURN VALUE IN T1
CALL COMNDI
CALL COMNDV ;PARSE VOLID
RET ;FAILED
MOVEM T1,CT1 ;RETURN VOLID TO CALLER
CALLRET CMDCFM ;GET CONFIRMATION AND RETURN
; PMR - PARSE OPERATOR RESPONSE TO WTOR ASKING FOR VOLID LIST
; T1/ ADDRESS OF ASCIZ OPERATOR RESPONSE TEXT
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR NOTIFIED
; +2: SUCCESSFUL PARSE
; T1/ 0 - RSB AND VOLID LIST SET UP
; T1/ 1 - REQUEST ABORTED
PMR: CALL COMNDI ;INITIALIZE FOR COMND JSYS
MOVEI T2,[FLDDB.(.CMKEY,,PMRT1)] ;SET UP FOR KEYWORD PARSE
CALL COMNDX ;ISSUE COMND JSYS TO DO PARSE
JRST [ MOVEI T3,[ASCIZ/Syntactical Error In Response/]
CALLRET BTACK] ;HE BLEW THE KEYWORD
HRRZ T2,(T2) ;GET ADDRESS OF KEYWORD PROCESSOR
CALLRET (T2) ;DISPATCH TO KEYWORD PROCESSOR
PMRT1: PMRT1L,,PMRT1L ;KEYWORD TABLE
[ASCIZ/REFUSE/],,PMRREF ;REFUSE reason
[ASCIZ/VOLUMES/],,PMRVOL ;VOLUMES volid,...,volid
PMRT1L==.-PMRT1-1
PMRREF: CALL PREFUS ;PARSE REFUSAL
RET ;OPERATOR ERROR
ABTREQ (MREQ16,ABT%OP) ;ABORT REQUEST
MOVEI T1,1 ;SET T1 TO INDICATE ABORTION
RETSKP
; PREFUS - COMPLETE PARSING OF REFUSAL BY OPERATOR
; RETURNS +1: ERROR, OPERATOR NOTIFIED
; +2: SUCCESSFUL PARSE, ATMBFR/ ASCIZ REASON GIVEN BY OPERATOR
PREFUS: MOVEI T2,[FLDDB. .CMTXT] ;PARSE TEXT OUT TO CARRIAGE RETURN
CALL COMNDX
JRST PREFU1 ;ERROR
LDB T1,[POINT 7,ATMBFR,6] ;WAS THERE A REASON GIVEN?
JUMPN T1,RSKP ;YES, TAKE GOOD RETURN
PREFU1: JSP T1,RSPERR ;ERROR, TELL OPERATOR
ASCIZ/No reason given/
; PMRVOL - PARSE VOLID LIST FROM OPERATOR
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, T1/ ADDRESS OF ASCIZ ERROR MESSAGE FOR OPERATOR
; +2: T1/ 0 - RSB AND VOLID LIST SET UP
; T1/ 1 - REQUEST ABORTED
PMRVOL: CALL VQDEL ;DELETE VOLID LIST (IF ANY)
MOVEI T1,1
STOR T1,RSBCV ;SET CURRENT VOLUME # TO 1
PMRV1: CALL COMNDV ;PARSE VOLID
RET ;FAILED
CALL VQADD ;ADD VOLUME TO LIST
JRST [ MOVEI T1,1 ;OUT OF TABLE SPACE
RETSKP]
MOVEI T2,[FLDDB.(.CMCMA,,,,,[FLDDB.(.CMCFM)])]
CALL COMNDX ;PARSE COMMA OR CARRIAGE RETURN
JRST [ JSP T1,RSPERR ;PARSE FAILED
ASCIZ/Syntactical error in volume-id list/]
HRRZS T3 ;GET ADDRESS OF ACTUAL FDB
LOAD T3,CM%FNC,(T3) ;GET FUNCTION CODE FROM FDB
CAIN T3,.CMCMA ;WHAT DID I JUST PARSE?
JRST PMRV1 ;COMMA, GO GET ANOTHER VOLID
SETZ T1, ;CARRIAGE RETURN, CLEAR T1
RETSKP
; PNVR - PARSE OPERATOR RESPONSE TO "KEYIN NEXT VOLID" WTOR
; T1/ ADDR OF ASCIZ RESPONSE TEXT
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR, T1/ ADDRESS OF ASCIZ ERROR MESSAGE FOR OPERATOR
; +2: T1/ 0 - VOLID ADDED TO RSB VOLID LIST
; T1/ 1 - REQUEST ABORTED
PNVR: CALL COMNDI ;SET UP FOR PARSING WITH COMND
MOVEI T2,[FLDDB. .CMKEY,,PNVKT] ;GET FDB ADDRESS
CALL COMNDX ;PARSE KEYWORD
JRST [ JSP T1,RSPERR ;ERROR
ASCIZ/REFUSE or VOLUME keyword missing/]
HRRZ T2,(T2) ;GET HANDLER ADDRESS
CALLRET (T2) ;DISPATCH TO HANDLER
PNVKT: PNVKTL,,PNVKTL ;KEYWORD TABLE
[ASCIZ/REFUSE/],,PMRREF
[ASCIZ/VOLUME/],,PNVVOL
PNVKTL==.-PNVKT-1
PNVVOL: SAVEQ ;OPERATOR RESPONDED WITH A VOLID
CALL COMNDV ;PARSE VOLID
RET ;FAILED
MOVE Q1,T1 ;SAVE VOLID
CALL CMDCFM ;CHECK FOR EOL
RET ;NOT THERE
MOVE T1,Q1 ;GET VOLID
CALL VQADD ;TACK IT ON TO THE END OF THE LIST
JRST [ MOVEI T1,1 ;OUT OF TABLE SPACE
RETSKP]
SETZ T1, ;SET SUCCESSFUL COMPLETION
RETSKP
; PSMR - PARSE OPERATOR RESPONSE TO STRUCTURE MOUNT WTOR MESSAGE
; T1/ ADDRESS OF ASCIZ RESPONSE TEXT
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR NOTIFIED
; +2: SUCCESSFUL PARSE, REQUEST ABORTED
; ATMBFR/ ASCIZ REASON GIVEN BY OPERATOR
PSMR: CALL COMNDI ;INIIALIZE FOR COMND JSYS
MOVEI T2,[FLDDB.(.CMKEY,,PSMKT)] ;SET UP FOR KEYWORD PARSE
CALL COMNDX ;PARSE KEYWORD
JRST [ JSP T1,RSPERR ;BAD KEYWORD, GIVE ERROR
ASCIZ/Response must be of the form:
REFUSE reason/]
MOVX T2,R%OPR
TDNE T2,RSBIFL(RSB) ;IS THIS AN OPR REQUEST?
RETSKP ;YES, FORGET REASON
CALL PREFUS ;PARSE REMAINDER OF REFUSAL
RET ;OPERATOR ERROR
ABTREQ (MREQ15,ABT%OP) ;OPERATOR REFUSED TO MOUNT VOLUME
RETSKP
PSMKT: PSMKTL,,PSMKTL
[ASCIZ/REFUSE/],,0
PSMKTL==.-PSMKT-1
; RSPERR - TELL OPERATOR THAT THERE WAS AN ERROR IN HIS RESPONSE
; T1/ ADDRESS OF ASCIZ ERROR MESSAGE
; RETURNS +1: ALWAYS
RSPERR::TMCT <%I%1A>
MOVEI T3,[ASCIZ/Response Error/] ;GET MESSAGE TYPE
CALLRET BTACKT ;SEND IT OFF TO THE OPERATOR
; WOASO - TELL OPERATOR A TAPE HAS BEEN GIVEN TO A USER
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WOASO: MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%I%M Given To Request %1D>
CALL CPYHDR ;COPY HEADER TO OPRHDR
TMCT <%I>
CALL TMCVOL ;DISPLAY VOLID
TMCT < now in use by%_ %U>
MOVE T1,RSBIFL(RSB)
TXNN T1,R%ONR ;WAS OPERATOR TOLD TO MOUNT TAPE?
CALL BTJOB ;NO, MAKE THIS A JOB MESSAGE
MOVEI T3,OPRHDR ;POINT TO HEADING
CALLRET BTWTO ;SHIP IT OFF TO THE OPERATOR
; WOCKSW - IF A SCRATCH VOLUME IS WRITE-PROTECTED, DISMOUNT IT AND
; GIVE AN ERROR MESSAGE TO THE OPERATOR
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: WRITE-PROTECTED SCRATCH VOLUME UNLOADED
; +2: TAPE WAS NOT A WRITE-PROTECTED SCRATCH
WOCKSW: MOVE T1,MTAFLG(MTA) ;GET FLAGS
TXNE T1,MA%SCR ;TAKE +2 IF NOT SCRATCH
TXNE T1,MA%WEN ;TAKE +2 IF WRITE-ENABLED
RETSKP
TMCT <%IUnloading drive %M>
SKIPE MTAVOL(MTA) ;DO I KNOW ITS VOLID?
CALL TMCVOL ;YES, THROW IT IN THERE TOO
TMCT <
Remount scratch tape with write ring>
MOVEI T3,[ASCIZ/No Ring In Scratch Tape/]
CALL BTWTO ;TELL OPERATOR
CALLRET UNLOAD ;UNLOAD THE TAPE
; WODISA - TELL OPERATOR A USER HAS RELEASED A TAPE DRIVE
; T1/ ADDR OF ASCIZ DISPOSITION TEXT
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WODISA: STAKT
TMCT <%I%M>
SKIPN MTAVOL(MTA) ;TAPE HAVE A VOLID?
JRST [ TMCT < Tape> ;NO
JRST .+2]
CALL TMCVOL ;DISPLAY VOLID
MOVE T1,CT1 ;GET ADDRESS OF CALLER'S TEXT
TMCT < %1A>
CALL BTJOB ;THIS IS A JOB MESSAGE
MOVEI T3,[ASCIZ/Tape Drive Released By User/]
CALLRET BTWTO ;SEND IT OFF
; WOUSGF - TELL OPERATOR THAT USAGE JSYS FAILED.
;
; RETURNS +1: ALWAYS
WOUSGF: TMCT <%IAccount record not written. %U. Reason: %J>
MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
CALLRET BTWTO ;OUT TO OPERATOR
; WOLINF - TELL OPERATOR THAT I FAILED TO WRITE LABELS ON A TAPE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOLINF: TMCT <%IError writing labels on %M>
CALL TMCVOL ;DISPLAY VOLID
MOVEI T3,[ASCIZ/Tape Error Writing Labels/]
CALLRET BTWTO ;OUT TO OPERATOR
; WOLOCF - TELL OPERATOR THAT .MOLOC MTOPR FAILED
; MTA/ ADDR OF MTA STATUS BLOCK
; MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS
WOLOCF: TMCT <%IFailed to associate %M with %N%_Reason: %J>
MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
CALLRET BTWTO ;OUT TO OPERATOR
; WOLRDX - TELL OPERATOR I COULDN'T READ ANYTHING FROM THE TAPE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOLRDX: TMCT <%ITape on %M may be labeled at a density that
is not supported by this drive.
Tape has been unloaded.>
MOVEI T3,[ASCIZ/Cannot Read Tape/]
CALLRET BTWTO
; WORCAN - TELL OPERATOR A MOUNT REQUEST WAS CANCELED
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WORCAN: MOVE T1,RSBIFL(RSB) ;GET FLAGS
TXNN T1,R%ONR ;DID THE OPERATOR SEE THE MESSAGE?
RET ;NO, DON'T SAY ANYTHING WAS CANCELED
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%IMount Request # %1D Canceled>
MOVEI T3,TMCMSG ;GET ADDRESS OF TEXT
CALLRET BTWTON ;TELL ALL OPERATORS
; WOTDAV - TELL OPERATOR OF AVAILABILITY OF TAPE DRIVE FOR SYSTEM USE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOTDAV: SAVEQ
SAVEAC <MT,RSB>
MOVEI Q1,1 ;ASSUME AVAILABLE
CALL CKMPAV ;IS IT AVAILABLE?
SETZ Q1, ;NO, SET NOT AVAILABLE
TMCT <%I%M set >
JUMPE Q1,[TMCT <un>
JRST .+1]
TMCT <available for assignment by MOUNTR>
LOAD MT,MTAMT ;MT ASSOCIATED?
JUMPN MT,[LOAD RSB,MTRSB ;YES, GET RSB ADDRESS
TMCT <%_%%Drive is currently in use by %U>
JRST .+1]
MOVE T3,[[ASCIZ/Tape Drive Set Unavailable/]
[ASCIZ/Tape Drive Set Available/]](Q1) ;GET HEADER
CALLRET BTWTO ;GET MESSAGE OUT TO OPERATOR
; WOTIMO - REPORT MTA DEVICE TIMEOUT TO THE OPERATOR
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOTIMO: TMCT <%I%M operation timed out>
MOVEI T3,[ASCIZ/Tape Drive Timed Out/]
CALLRET BTWTO ;TELL THE OPERATOR
; WOTMD - TELL OPERATOR A TAPE HAS BEEN MOUNTED ON A DRIVE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOTMD: MOVX T1,MA%VMG
TDNE T1,MTAFLG(MTA) ;HAS THE OPERATOR BEEN TOLD ALREADY?
RET ;YES, NO ACTION THEN
IORM T1,MTAFLG(MTA) ;NO, SET MESSAGE-GIVEN
TMCT <%I%M>
SKIPE MTAVOL(MTA) ;DOES IT HAVE A VOLID?
JRST [ CALL TMCVOL ;YES, DISPLAY IT
TMCT <,>
JRST .+1]
LOAD T1,MTALT ;GET LABEL TYPE
JUMPE T1,WOTMD1 ;JUMP IF LT NOT KNOWN (AVR DISABLED)
MOVE T2,LTTXT(T1) ;GET ADDRESS OF TEXT
TMCT < %2A> ;SPEW OUT LABEL TYPE
CAIE T1,.LTUNL ;IS IT LABELED?
CALL [ TMCTR < labeled>] ;YES
WOTMD1: TMCT < tape mounted>
MOVEI T3,TMCMSG ;GET ADDRESS OF TEXT
CALLRET BTWTON ;BUILD AND TRANSMIT WTO MESSAGE
; WOUNL - TELL OPERATOR THAT A TAPE HAS BEEN UNLOADED
; WOUNLW - SAME AS WOUNL, EXCEPT WARNING MESSAGE IS GIVEN TOO
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOUNLW: SKIPA T1,[BTWTO] ;DISPLAY WARNING
WOUNL: MOVEI T1,BTWTON ;SUPPRESS WARNING
STAKT
TMCT <%I%M> ;DISPLAY DRIVE NAME
SKIPE MTAVOL(MTA) ;DO I KNOW THE VOLID?
CALL TMCVOL ;YES, DISPLAY IT
TMCT < unloaded>
CALL CPYHDR ;COPY HEADER TO OPRHDR
TMCT <%I%%Use the DISMOUNT TAPE command to unload tape drives>
MOVEI T3,OPRHDR ;GET ADDRESS OF HEADER
MOVE T1,CT1 ;GET ADDRESS OF ROUTINE TO CALL
CALLRET (T1) ;OUT TO OPERATOR AND RETURN
; WOVMT - TELL OPERATOR A TAPE VOLUME MUST BE MOUNTED
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WOVMT: SAVEQ
SAVEAC <MTA>
; IN THE EVENT THAT A USER IS REQUESTING A SPECIFIC VOLUME AND
; THAT VOLUME IS UNDERGOING AVR ON A TAPE DRIVE, WE WANT TO
; INHIBIT SENDING THE WTO TO REQUEST THE TAPE UNTIL THE AVR
; SEQUENCE COMPLETES. THIS CODE CHECKS FOR THIS CONDITION.
LOAD T1,RSBSTE ;GET REQUEST STATE
MOVE T2,RSBIFL(RSB) ;GET FLAGS
CAIN T1,RST.WM ;WAITING FOR MOUNT
TXNE T2,R%ONR ; AND OPERATOR NOT TOLD YET?
RET ;NOT BOTH, DON'T DO ANYTHING
CALL VQGCV ;GET CURRENT VOLID
JUMPE T1,WOV2 ;SCRATCH
MOVE T2,MTAN ;GET # OF MTA'S TO SCAN
MOVEI MTA,MTA0-MTASZ ;START HERE
WOV1: ADDI MTA,MTASZ ;POINT AT NEXT MTA
SOJL T2,WOV2 ;NONE LEFT, SEND MESSAGE
LOAD T3,MTASTE ;GET DRIVE STATE
CAIE T3,S.AV ;AVAILABLE TO USERS?
JRST WOV1 ;NO, SKIP IT
JE MTAJCT,,WOV1 ;SKIP IF AVR NOT IN PROGRESS
CAMN T1,MTAVOL(MTA) ;DRIVE & REQUEST VOLIDS MATCH?
RET ;YES, MESSAGE SUPPRESSED
JRST WOV1 ;NO, CONTINUE DRIVE SCAN
; MUST TELL THE OPERATOR TO MOUNT THE TAPE, START BUILDING MESSAGE
WOV2: SETONE R%ONR,RSBIFL(RSB) ;SET OPERATOR-NOTIFIED
CALL WTOCHK ;IS WTO DISABLED
RET ;YES
MOVE T1,RSBITN(RSB) ;GET REQUEST #
TMCT <%ITape Mount Request # %1D>
CALL CPYHDR ;COPY HEADER TO OPRHDR
; BUILD THE BODY OF THE MESSAGE
TMCT <%IMount >
CALL TRESCK ;Are any tape drives set to available
CALL [ TMCT <%INote: All tape drives are set unavailable
Mount > ;No, include in the mount request message
RET ] ;Return to in stream
CALL VQGCV ;GET VOLID IN T1
MOVE Q1,T1 ;COPY VOLID TO SAFE PLACE
LOAD T2,RSBLT ;LABEL TYPE KNOWN?
JUMPN T2,[MOVEI T1,[ASCIZ/Labeled/] ;YES
CAIE T2,.LTUNL
SKIPE Q1
MOVE T1,LTTXT(T2) ;UNLABELED OR NOT SCRATCH
MOVX T2,TM%BYP
TDNE T2,RSBUFL(RSB) ;BYPASS?
MOVEI T1,[ASCIZ/BYPASS/] ;YES, SAY SO
TMCT <%1A > ;DISPLAY LABEL TYPE
JRST .+1]
JUMPE Q1,[TMCT <scratch tape> ;SCRATCH TAPE, SAY SO
JRST .+1]
JUMPN Q1,[TMCT <volume %5S> ;DISPLAY SPECIFIC VOLUME
JRST .+1]
LOAD Q1,RSBDRV ;DRIVE TYPE KNOWN?
JUMPN Q1,[MOVE T1,DRVTXT(Q1) ;GET POINTER TO DRIVE TEXT
TMCT <, %1A> ;DISPLAY DRIVE TYPE
JRST .+1]
LOAD Q1,RSBDEN ;DENSITY KNOWN?
JUMPN Q1,[MOVE T1,DENTAB(Q1) ;YES, GET DENSITY
TMCT <, %1D BPI>
JRST .+1]
MOVEI T1,[ASCIZ/, READ-ONLY/] ;ASSUME READ-ONLY
MOVX T2,TM%WEN
TDNE T2,RSBUFL(RSB)
MOVEI T1,[ASCIZ/, WRITE-ENABLED/]
TMCT <%1A%_%U>
JE R%ONV,RSBIFL(RSB),[SETONE R%ONV,RSBIFL(RSB)
CALL VQCNT ;MORE THAN 1 VOLID IN SET?
SOJLE T1,.+1 ;NO
MOVE T1,RSBSSN(RSB) ;GET SETNAME
TMCT <
Volumes in set %1S: >
CALL TMCVLS ;DISPLAY VOLID LIST
JRST .+1]
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T1,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
TMCT <%_User's remark: %1A>
JRST .+1]
MOVEI T3,OPRHDR ;GET ADDRESS OF HEADING
CALLRET BTWTO ;SEND WTO OFF TO THE OPERATOR
; WOWDDR - REQUEST REMOUNT OF TAPE - DRIVE COULDN'T HANDLE DENSITY
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WOWDDR: TMCT <%I%M>
CALL TMCVOL ;DISPLAY VOLID
MOVE T1,MTAVOL(MTA) ;GET VOLID
LOAD T2,RSBDEN
MOVE T2,DENTAB(T2) ;GET NUMERIC DENSITY
TMCT < being unloaded
Remount volume %1S on %2D BPI drive>
MOVEI T3,[ASCIZ/Remount Tape Volume/]
CALLRET BTWTO
; WOWPE - TELL OPERATOR THAT WRITE RING SHOULD BE INSERTED OR REMOVED
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
WOWPE: TMCT <%I%M>
CALL TMCVOL ;DISPLAY VOLID
LOAD T1,MA%WEN,MTAFLG(MTA) ;GET CURRENT WRITE STATUS
MOVE T1,[[ASCIZ/Insert/]
[ASCIZ/Remove/]](T1) ;GET WHAT TO DO
TMCT <%_%1A write ring and remount tape>
MOVEI T3,[ASCIZ/Tape Write Protect Error/]
CALLRET BTWTO ;OUT TO OPERATOR
; WRNXTV - ASK OPERATOR FOR NEXT VOLUME OF VOLUME SET
; T1/ ADDR OF RESPONSE HANDLER THAT WILL BE CALLED BY INWTOR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WRNXTV: MOVE T2,RSBSSN(RSB)
TMCT <%ISupply next volume-id for tape set %2S%_%U
Respond with either of:
VOLUME volid
REFUSE reason>
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T2,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
TMCT <%_User's remark: %2A>
JRST .+1]
MOVEI T2,RSBWTB(RSB) ;GET WTB ADDRESS
MOVEI T3,[ASCIZ/Key In Next Volume Identifier/]
CALLRET BTWTOR ;SEND IT OFF
; WRUTR - TELL OPERATOR THAT A USER TAPE MOUNT REQUEST HAS BEEN
; RECEIVED AND ASK HIM TO KEY IN VOLID LIST
; T1/ ADDRESS OF RESPONSE HANDLER THAT WILL BE CALLED BY INWTOR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
WRUTR: MOVE T2,RSBSSN(RSB)
TMCT <%IVolume set %2S, %U
Respond with either of:
RESPOND n VOLUMES volid,volid,...
RESPOND n REFUSE reason>
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T2,RSBRMK(RSB) ;YES, GET ADDR OF REMARK
TMCT <%_User's remark: %2A>
JRST .+1]
MOVEI T2,RSBWTB(RSB) ;WTB ADDRESS
MOVEI T3,[ASCIZ/Tape Set Request/] ;MESSAGE TYPE
CALLRET BTWTOR ;SEND OFF WTOR
; TEXT MESSAGE COMPOSITION (TMC) SUBROUTINES
; ALL TMC SUBROUTINES RETURN +1 ALWAYS
TMC1: MOVE T1,TMCPTR ;GET BUFFER POINTER
SETZ T2,
IDPB T2,T1 ;PUT A NULL AT THE END OF THE BUFFER
SUBI T1,TMCMSG-1 ;COMPUTE BUFFER SIZE IN WORDS
HRRZM T1,TMCWDS ;STORE IT FOR CALLING ROUTINES
; CHECK FOR END OF BUFFER
HRRZ T1,T1 ;Size of the current message
CAIGE T1,ENDBUF ;Space for another line?
RET ;Yes
MOVE T1,[POINT 7,[ASCIZ/
Message Truncated - Buffer Space Exhausted
/]]
TMCLP: ILDB T2,T1 ;Pick up the next character of message
IDPB T2,TMCPTR ;Place into the TMCMSG buffer
SKIPE T2 ;End of the ASCIZ string?
JRST TMCLP ;No, go pick up the next character
SETOM BUFLFT ;Set flag to indicate exhausted buffer
MOVE T1,TMCPTR ;Get address of the end of the message
SUBI T1,TMCMSG-1 ;Calculate the message size
HRRZM T1,TMCWDS ;Store it for calling routines
RET
; TMCRSP - SPECIAL VERSION OF TMCASZ FOR INCOMING WTOR RESPONSES
; T1/ 0 ,, ADDRESS OF ASCIZ WTOR RESPONSE
TMCRSP: HRLI T1,(POINT 7) ;CONSTRUCT BYTE POINTER
TMCRS1: ILDB T2,T1 ;GET A BYTE FROM RESPONSE TEXT
JUMPE T2,[TMCTR <%_>] ;END, APPEND CRLF AND RETURN
CAIN T2,"F"-100
JRST TMCRS1 ;DON'T COPY CTRL/F
CAIN T2,.CHESC
JRST TMCRS1 ;DON'T COPY ESCAPE
CAIN T2,"?"
JRST TMCRS1 ;DON'T COPY QUESTION MARK
CAIN T2,.CHCRT
JRST TMCRS1 ;DON'T COPY CARRIAGE RETURN
CAIN T2,.CHLFD
MOVEI T2," " ;CHANGE LINE FEED TO BLANK
IDPB T2,TMCPTR ;PUT CHARACTER IN TMCMSG
JRST TMCRS1 ;LOOP UNTIL NULL
; CPYHDR - COPY CONTENTS OF TMCMSG TO OPRHDR
CPYHDR: MOVE T1,[TMCMSG,,OPRHDR] ;BLT SOURCE,,DESTINATION
BLT T1,OPRHDR+OPRHSZ-1
RET
; TMCVOL - DISPLAY THE TEXT " Volume " FOLLOWED BY THE MTA VOLID
; MTA/ ADDR OF MTA STATUS BLOCK
TMCVOL: SKIPN T1,MTAVOL(MTA) ;GET VOLID
JRST [ TMCTR < scratch tape>] ;ZERO, THEREFORE SCRATCH
TMCTR < Volume %1S> ;DISPLAY AND RETURN
; TMCVLS - DISPLAY THE VOLUME-ID LIST FOR A GIVEN USER REQUEST
; RSB/ ADDR OF REQUEST STATUS BLOCK
TMCVLS: SAVEQ
QSCANI <RSBVLS(RSB)> ;SET UP TO SCAN VOLID LIST
SETO Q1, ;INIT COUNTER
TMCVL1: CALL QMSCAN ;GET ADDRESS OF NEXT VOLID ENTRY IN T2
RET ;NONE LEFT, SPLIT
AOJG Q1,[TMCT <, > ;SEPARATE VOLIDS WITH COMMAS
JRST .+1]
SKIPN T1,1(T2) ;GET SIXBIT VOLID
JRST [ TMCT <scratch> ;HE'S DEAD, JIM
JRST TMCVL1]
TMCT <%1S> ;VOLID IS KNOWN
JRST TMCVL1 ;LOOP UNTIL ALL VOLIDS ARE DISPLAYED
; DRIVER FOR TMCT AND TMCTR MACROS
; CX/ ADDRESS OF FORMATTING STRING
TMCT0:: HRL CX,BUFLFT ;Load end of buffer flag
SKIPGE CX ;Any space left in TMCMSG?
RET ;No
HRLI CX,(POINT 7) ;MAKE BYTE POINTER TO SOURCE STRING
MOVEM CX,TMCTSP ;SAVE POINTER
SAVET ;ALL AC'S PRESERVED (EXCEPT 15,16)
TRVAR <TMCTAR,<TMCTAC,4>>
DMOVEM T1,TMCTAC ;SAVE T1-T4
DMOVEM T3,2+TMCTAC
TMCT1: ILDB T1,TMCTSP ;GET NEXT CHARACTER FROM STRING
JUMPE T1,TMC1 ;END OF STRING
CAIE T1,"%" ;TRIGGER CHARACTER?
JRST [ IDPB T1,TMCPTR ;NO, JUST COPY IT
JRST TMCT1] ;LOOP THRU STRING
TXZ F,ARGF ;SAY NO ARGUMENT (YET)
SETZM TMCTAR ;ZERO ARGUMENT ACCUMULATOR
TMCT2: ILDB T1,TMCTSP ;GET NEXT CHARACTER
CAIG T1,"9" ;NUMERIC?
CAIGE T1,"0"
JRST TMCT3 ;NO
SUBI T1,"0" ;YES, CONVERT ASCII TO INTEGER
MOVE T2,TMCTAR ;GET CURRENT ACCUMULATOR
IMULI T2,12 ;DECIMAL SHIFT
ADD T2,T1 ;ADD IN NEXT DIGIT
MOVEM T2,TMCTAR ;STORE UPDATED ACCUMULATOR
TXO F,ARGF ;SET ARG-SEEN
JRST TMCT2 ;CONTINUE ARGUMENT SCAN
TMCT3: MOVSI T2,-TMCDTL ;GET AOBJN POINTER TO DISPATCH TABLE
TMCT4: HLRZ T3,TMCDT(T2) ;GET CHARACTER FROM DISPATCH TABLE
CAME T1,T3 ;MATCH FUNCTION CHARACTER?
JRST [ AOBJN T2,TMCT4 ;NO, CONTINUE SCAN
JRST TMC1] ;NO MATCH??? ERROR IN FORMAT STRING
HRRZ T1,TMCDT(T2) ;FOUND IT, GET ROUTINE ADDRESS
CALL (T1) ;CALL HANDLER
MOVE T1,TMCPTR ;GET BUFFER POINTER
SETZ T2,
IDPB T2,T1 ;PUT A NULL AT THE END OF TEXT
SUBI T1,TMCMSG-1 ;COMPUTE TEXT SIZE IN WORDS
HRRZM T1,TMCWDS ;STORE IT FOR CALLERS
JRST TMCT1 ;FUNCTION DONE, CONTINUE STRING SCAN
; TMCT DISPATCH TABLE
TMCDT: "A",,%A ;ASCIZ STRING, ARG = AC CONTAINING ADDRESS
"C",,%C ;ADVANCE TO COLUMN, ARG = COLUMN#
"D",,%D ;DECIMAL #, ARG = AC CONTAINING #
"I",,%I ;INITIALIZE TMC FORMATTED STRING
"J",,%J ;JSYS ERROR MESSAGE, ARG = AC CONT. ERROR CODE
;NO ARG MEANS USE MOST RECENT MOUNTR ERROR
"K",,%K ;TYPE DRIVE NUMBERS, ARG = CKU NUMBER
"M",,%M ;DISPLAY "MTAn:" (NEEDS MTA AC)
"N",,%N ;DISPLAY "MTn:" (NEEDS MT AC)
"O",,%O ;OCTAL NUMBER, ARG = AC CONTAINING #
"S",,%S ;SIXBIT, ARG = AC CONTAINING SIXBIT VALUE
"U",,%U ;USER NAME, ARG = AC CONTAINING USER#
;NO ARG MEANS DO NAME/JOB/LINE FOR CURRENT RSB
"V",,%V ;DEVICE NAME, ARG = AC CONTAINING DESIGNATOR
"Y",,%Y ;ARG = AC CONTAINING NON-0 FOR Yes OR 0 FOR No
"%",,%% ;PERCENT SIGN
"_",,%CRLF ;CRLF
TMCDTL==.-TMCDT ;NUMBER OF ENTRIES IN TABLE
GETREG: JXE F,ARGF,[ADJSP P,-1 ;IF NO ARG PRESENT
RET] ;RETURN TO CALLER'S CALLER
MOVE T1,TMCTAR ;GET ARGUMENT
CAIG T1,T4 ;IN T1-T4?
ADDI T1,-1+TMCTAC ;YES, ADD OFFSET TO STORED AC'S
MOVE T1,(T1) ;GET CONTENTS OF REGISTER
RET
;Returns - +1 always
; T2/The current location of the message
; This routine clobbers T2
TMCNT: SAVEQ
MOVE Q1,[POINT 7,TMCMSG] ;GET POINTER TO EXISTING MESSAGE
TMCNT1: SETZ T2, ;# OF CHARACTERS SINCE LAST LINEFEED
TMCNT2: ILDB Q2,Q1 ;GET NEXT CHARACTER FROM MESSAGE
CAIN Q2,.CHLFD ;IS IT A LINEFEED?
JRST TMCNT1 ;YES, RESET COUNTER AND CONTINUE SCAN
SKIPE Q2 ;END OF STRING?
AOJA T2,TMCNT2 ;NO, COUNT CHARACTER AND LOOP
RET
%CRLF: SKIPA T1,[[ASCIZ/
/]]
%A: CALL GETREG ;GET ADDRESS OF TEXT
%A0: HRLI T1,(POINT 7) ;MAKE STRING POINTER
%A1: ILDB T2,T1 ;GET NEXT CHARACTER FROM STRING
JUMPE T2,R ;EXIT IF END OF STRING
IDPB T2,TMCPTR ;COPY CHARACTER TO OUTPUT STRING
JRST %A1 ;LOOP THRU INPUT
%C: CALL TMCNT ;Get the current location of pointer to msg
MOVE T1,TMCTAR ;GET DESIRED COLUMN POSITION
SUB T1,T2 ;GET # OF SPACES PLUS 1
MOVEI T2," " ;GET SPACE
TMCC3: SOJLE T1,TMC1 ;EXIT IF NO MORE SPACES NEEDED
IDPB T2,TMCPTR ;INSERT A SPACE
JRST TMCC3 ;LOOP UNTIL POSITION IS REACHED
%D: CALL GETREG ;GET NUMBER
MOVEI T3,12 ;BASE 10
JRST %DO ;MERGE
%O: CALL GETREG ;GET NUMBER
MOVEI T3,10 ;BASE 8
%DO: MOVE T2,T1 ;# TO T2 FOR NOUT
MOVE T1,TMCPTR ;GET DESTINATION STRING POINTER
NOUT ;OUTPUT NUMBER
SKIPA
MOVEM T1,TMCPTR ;STORE UPDATED POINTER
RET
%I: MOVE T1,[POINT 7,TMCMSG] ;GET PTR TO TEXT STRING
MOVEM T1,TMCPTR ;INITIALIZE IT
RET
%J: MOVEI T1,-1 ;ASSUME NO ARGUMENT
TXNE F,ARGF ;ARG PRESENT?
CALL GETREG ;YES, GET ERROR CODE FROM AC
MOVE T2,T1 ;CODE TO T2 FOR ERSTR
HRLI T2,.FHSLF ;FORK HANDLE ,, ERROR CODE
MOVE T1,TMCPTR ;DESTINATION STRING POINTER
SETZ T3, ;NO LIMIT ON LENGTH
ERSTR ;GET ERROR STRING
JFCL
JFCL
MOVEM T1,TMCPTR ;STORE UPDATED POINTER
RET
%K: CALL GETREG ;READ ARGUMENT
MOVE T4,T1 ;REMEMBER IT
MOVE T1,TMCPTR ;GET BYTE POINTER
HRROI T2,[ASCIZ/Channel /] ;TEXT
SETZ T3, ;ALL OF IT
SOUT ;TYPE IT
LOAD T2,DOP%C2,T4 ;GET CHANNEL
MOVEI T3,^D10 ;Decimal
NOUT ;TYPE IT
JFCL
TXC T4,DOP%K2 ;GET READY
TXCN T4,DOP%K2 ;ANY CONTROLLER TO TYPE?
JRST %K2 ;NO, SKIP ON
HRROI T2,[ASCIZ/ Controller /] ;YES
SETZ T3, ;ASCIZ
SOUT ;TYPE THIS
LOAD T2,DOP%K2,T4 ;GET CONTROLLER NUMBER
MOVEI T3,^D10 ;Decimal
NOUT ;TYPE IT
JFCL
%K2: HRROI T2,[ASCIZ/ Drive /] ;MORE TEXT
SETZ T3, ;ASCIZ
SOUT ;TYPE IT
LOAD T2,DOP%U2,T4 ;GET DRIVE NUMBER
MOVEI T3,^D10 ;Decimal AGAIN
NOUT ;TYPE IT
JFCL
MOVEM T1,TMCPTR ;REMEMBER NEW POINTER
RET ;DONE
%M: CALL GMTADD ;GET MTA DEVICE DESIGNATOR
SKIPA
%N: CALL GMTDD ;GET MT DEVICE DESIGNATOR
%V1: MOVE T2,T1 ;DESIGNATOR TO T2 FOR DEVST
MOVE T1,TMCPTR ;GET DEST STRG PTR
DEVST ;GET DEVICE NAME
CALL STOP
MOVEM T1,TMCPTR ;STORE UPDATED POINTER
MOVEI T1,":"
IDPB T1,TMCPTR ;PUT A COLON AT THE END
RET
%S: CALL GETREG ;GET SIXBIT QUANTITY
%S1: SETZ T2, ;CLEAR T2 FOR SHIFT
ROTC T1,6 ;GET NEXT CHARACTER IN T2
ADDI T2,40 ;CONVERT TO ASCII
IDPB T2,TMCPTR ;STORE IT
JUMPN T1,%S1 ;LOOP IF MORE NON-BLANKS REMAINING
RET
%U: JXE F,ARGF,%UNA ;JUMP IF NO ARGUMENT
CALL GETREG ;GET USER#
MOVE T2,T1 ;USER# TO T2 FOR DIRST
MOVE T1,TMCPTR ;GET DEST POINTER
DIRST ;GET USER NAME
SKIPA
MOVEM T1,TMCPTR ;STORE UPDATED POINTER
RET
%UNA: PUSH P,TMCTSP ;SAVE CURRENT INPUT POINTER
TMCT <User>
CAIN RSB,MTNAV ;RSB AVAILABLE?
JRST %U1 ;NO, THAT'S ALL
LOAD T1,RSBJNO ;GET JOB #
MOVE T2,RSBUNO(RSB) ;GET USER #
TMCT < %2U, Job %1D>
MOVSS T1 ;MOVE JOB # TO LEFT HALF
HRRI T1,.JOBTT ;GET TABLE # IN RIGHT HALF
GETAB ;GET LINE # FROM JOBTTY TABLE
CALL STOP
HLRES T1 ;DETACHED?
JUMPE T1,%U1 ;IF ZERO, USER PROBABLY LOGGED OUT
JUMPL T1,[TMCT <, DETACHED> ;IF DETACHED, SAY SO
JRST %U1]
TMCT <, Terminal %1O> ;SHOW LINE # AND RETURN
%U1: MOVEI T2,RSBACT(RSB) ;Get address of account string in mount request
MOVX T1,R%OPR ;Check for OPR request
TDNN T1,RSBIFL(RSB) ;Skip if OPR request
TMCT <, Account %2A> ;Indicate the account string
POP P,TMCTSP ;RESTORE PREVIOUS STRING POINTER
RET
%V: CALL GETREG ;GET DESIGNATOR IN T1
JRST %V1 ;GO DISPLAY IT
%Y: CALL GETREG ;GET ARG IN T1
JUMPN T1,[JSP T1,%A0 ;NON-ZERO, SAY YES
ASCIZ/Yes/]
JSP T1,%A0 ;ZERO, SAY NO
ASCIZ/No/
%%: MOVEI T1,"%"
IDPB T1,TMCPTR ;STORE PERCENT CHARACTER
RET
SUBTTL QUASAR INTERFACE
; GETRSB - ALLOCATE A REQUEST STATUS BLOCK
; RETURNS +1: RSB ALLOCATED, BUT IT'S THE LAST ONE
; +2: RSB ALLOCATED, MORE FREE RSB'S LEFT
; RSB/ ADDR OF REQUEST STATUS BLOCK
GETRSB: MOVEI T1,IRBQDB ;POINT TO INACTIVE RSB QUEUE
CALL QMDQH ;DEQUEUE HEAD OF QUEUE
CALL STOP ;QUEUE EMPTY, PROGRAM LOGIC ERROR
MOVEI RSB,-RSBLNK(T2) ;LOAD UP RSB AC
MOVS T1,RSB ;BLT SOURCE
HRRI T1,1(RSB) ;BLT DESTINATION
SETZM (RSB) ;CLEAR 1ST WORD OF RSB
BLT T1,RSBSIZ-1(RSB) ;CLEAR THE REST OF THE RSB
MOVEI T2,RSBLNK(RSB) ;GET ADDRESS OF RSB LINKAGE WORD
MOVEI T1,ARBQDB
CALL QMQT ;QUEUE TO TAIL OF ACTIVE QUEUE
SKIPN IRBQDB ;WAS THIS THE LAST FREE RSB?
RET ;YES, RETURN +1
RETSKP
; GETRSI - INITIALIZE FREE RSB POOL FOR GETRSB
; RETURNS +1: ALWAYS
GETRSI: SAVEQ
MOVEI Q1,RSB0 ;GET ADDRESS OF RSB POOL
MOVEI Q2,MAXMRQ+1 ;# OF RSBS IN POOL
GTRSI1: MOVEI T1,IRBQDB ;GET QDB ADDRESS
MOVEI T2,RSBLNK(Q1) ;GET ADDRESS OF RSB LINKAGE
CALL QMQT ;QUEUE RSB TO TAIL OF FREE QUEUE
ADDI Q1,RSBSIZ ;POINT Q1 AT NEXT RSB
SOJG Q2,GTRSI1 ;LOOP THRU ALL RSBS
RET
; GORSB - GET RSB FOR FUNCTION REQUESTED VIA OPR COMMAND
; T1/ REQUEST TYPE CODE
; RETURNS +1: RSB POOL EMPTY, ACK MESSAGE SENT TO OPERATOR
; +2: SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK
GORSB: STAKT
CALL GETRSB ;TRY TO ASSIGN RSB
TDZA T4,T4 ;SET SHORTAGE FLAG
MOVEI T4,1 ;SET NO SHORTAGE
MOVE T1,CT1
STOR T1,RSBTYP ;SET TYPE IN RSB
MOVX T1,R%OPR+R%PRIV ;SET FROM-OPERATOR AND PRIVILEGED
IORM T1,RSBIFL(RSB)
JUMPN T4,RSKP ;TAKE +2 IF NO FREESPACE SHORTAGE
ABTREQ (ABRTNR) ;SHORTAGE, ABORT REQUEST
CALL PRQABT ;PUT RSB BACK ON INACTIVE QUEUE
MOVEI T3,[ASCIZ/Space exhausted, try later/]
CALLRET BTACK ;TELL OPERATOR ABOUT BUMMER
; MATR - PROCESS USER REQUEST FOR ATTRIBUTES OF MOUNTED DEVICE
; (CURRENTLY VALID ONLY FOR TAPES)
; RBUF/ ATTRIBUTE-REQUEST MESSAGE
; T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS
MATR: SAVEQ
SAVEAC <MT,RSB>
CAIE T1,.MATQS ;CHECK SIZE
JRST [ CALLRET BADQM] ;NOT WHAT IT SHOULD BE
MOVE T1,RBUF+.MATDV ;GET DEVICE DESIGNATOR
CALL DDMT ;GET MT STATUS BLOCK ADDRESS
TDZA RSB,RSB ;BAD MT DEVICE, FORCE ERROR RETURN
LOAD RSB,MTRSB ;GET RSB ADDRESS
SKIPE RSB
CAIN RSB,MTNAV
JRST [ TMCT <%IInvalid device> ;BAD MT OR NO REQ ASSOCIATED
MOVE T1,RBUF+.MATPD ;GET USER'S PID
MOVX T2,MF.FAT ;GET FATAL-ERROR FLAG
MOVE T3,RBUF+.MSCOD ;GET USER'S ACK CODE
CALLRET TXTMSG] ;RESPOND TO USER WITH GLX TEXT MESSAGE
; CONSTRUCT RESPONSE, BUILDING-BLOCK STYLE
CALL PBINIT ;INITIALIZE BUILDING-BLOCK STRUCTURE
MOVE Q1,[2,,.MATDD] ;CONSTRUCT DEVICE-DESIGNATOR BLOCK
MOVE Q2,RBUF+.MATDV
MOVEI T1,Q1 ;GET ADDR OF SOURCE BLOCK
CALL PBBLK ;INSTALL IT
HRRI Q1,.TMSET ;GET SIZE AND TYPE FOR SETNAME
MOVE Q2,RSBSSN(RSB) ;GET SETNAME
MOVEI T1,Q1 ;GET ADDR OF SOURCE BLOCK
CALL PBBLK ;INSTALL IT
CALL VQCNT ;GET # OF VOLIDS
MOVSI Q1,1(T1) ;BLOCK LENGTH = # OF VOLIDS + 1
HRRI Q1,.TMVOL ;GET BLOCK TYPE
MOVEI T1,Q1 ;GET ADDR OF SOURCE BLOCK
HRRZ Q2,PBBPT ;GET ADDRESS OF DESTINATION BLK HEADER
CALL PBBLK ;INSTALL IT
HLRZS Q1 ;GET # OF VOLIDS + 1
MATR3: SOJG Q1,[AOBJN Q2, ;BUMP INDICES (NEVER JUMPS)
HLRZ T1,Q2 ;GET VOLID INDEX
CALL VQGET ;GET VOLID
JFCL ;SHOULD NEVER FAIL
MOVEM T1,(Q2) ;STORE VOLID INTO MESSAGE
JRST MATR3] ;LOOP THRU ALL VOLIDS
MOVE T1,PBBPT ;MESSAGE IS COMPLETE, GET HIGH ADDRESS
SUBI T1,TBUF ;COMPUTE LENGTH OF MESSAGE
MOVSS T1 ;TO LEFT HALF
HRRI T1,.QOMAR ;GET MESSAGE CODE
SETZ T2, ;NO FLAGS
MATR2: MOVE T3,RBUF+.MSCOD ;GET ACK CODE FOR USER
CALL GALHDR ;BUILD GALAXY HEADER IN MESSAGE
MOVE T1,RBUF+.MATPD ;GET USER'S PID
CALLRET TRANU ;SEND MESSAGE TO USER
; QMNT - PROCESS USER MOUNT REQUEST MESSAGE FROM QUASAR
; RBUF/ IPCF MOUNT MESSAGE
; T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS
QMNT: SAVEQ
CAIE T1,1000 ;DID I GET A PAGE OF DATA?
JRST [ CALLRET BADQM] ;NO, QUASAR BLEW IT
; GET RSB AND COPY USER-DESCRIPTOR INFORMATION INTO IT
SETZ Q2, ;ASSUME NO PROBLEMS WITH RSB POOL
CALL GETRSB ;ALLOCATE STATUS BLOCK FOR THIS REQUEST
SETO Q2, ;FREE RSB POOL IS NOW EMPTY
MOVE T1,RBUF+.MMNAM
MOVEM T1,RSBRNM(RSB) ;MOVE REQUEST NAME TO RSB
MOVE T1,RBUF+.MMITN
MOVEM T1,RSBITN(RSB) ;MOVE QUASAR INTERNAL TASK # TO RSB
MOVE T1,RBUF+.MMUCD
MOVEM T1,RSBCOD(RSB) ;MOVE USER'S ACK CODE TO RSB
MOVE T1,RBUF+.MMPID
MOVEM T1,RSBPID(RSB) ;MOVE USER'S PID TO RSB
LOAD T1,MD.PJB,RBUF+.MMCAP
STOR T1,RSBJNO ;MOVE USER'S JOB # TO RSB
MOVE T1,RBUF+.MMUNO
MOVEM T1,RSBUNO(RSB) ;MOVE USER'S USER # TO RSB
MOVX T1,MD.PWH+MD.POP
MOVX T2,R%PRIV
TDNE T1,RBUF+.MMCAP ;DOES USER HAVE WHEEL OR OPERATOR?
IORM T2,RSBIFL(RSB) ;YES, MARK HIM AS PRIVILEGED
MOVSI T1,RBUF+.MMACT ;BLT SOURCE
HRRI T1,RSBACT(RSB) ;BLT DESTINATION
BLT T1,RSBACT+7(RSB) ;MOVE USER'S ACCOUNT STRING TO RSB
; IDENTIFY REQUEST TYPE AND DISPATCH TO THE APPROPRIATE PROCESSOR
JUMPN Q2,[ABTREQ (MREQ31) ;ABORT IF RSB'S IN SHORT SUPPLY
TXZ F,ABORTF ;CLEAR ABORTED-REQUESTS-PRESENT
CALLRET PRQABT] ;MAKE SURE AT LEAST 1 FREE RSB IS LEFT
MOVE T1,RBUF+.MMARC ;GET ENTRY COUNT
CAIE T1,1 ;IS IT 1?
JRST MSERR ;NO, FORMAT ERROR
MOVEI T2,RBUF+.MMHSZ ;GET ADDRESS OF FIRST ENTRY
MOVE T3,RBUF+.MMUMS ;GET SIZE OF USER IPCF MESSAGE
SUBI T3,.MMHSZ ;COMPUTE SIZE OF MOUNT-ENTRY REGION
CALL CKBSTR ;CHECK BUILDING-BLOCK STRUCTURE
MSERR: JRST [ ABTRET (MREQ13)] ;STRUCTURAL ERROR IN MOUNT MESSAGE
MOVEI T1,RBUF+.MMHSZ ;GET ADDRESS OF FIRST ENTRY
LOAD T2,AR.TYP,(T1) ;GET TYPE OF ENTRY
STOR T2,RSBTYP ;STORE REQUEST TYPE IN RSB
CAIN T2,.MNTTP ;IS IT A USER TAPE MOUNT?
JRST [ CALLRET UTM] ;YES, GO PROCESS IT
CAIN T2,.MNTST ;USER STRUCTURE MOUNT?
JRST [ CALLRET USM] ;YES, GO PROCESS IT
CAIN T2,.DSMST ;DISMOUNT STRUCTURE?
JRST [ CALLRET USD] ;YES
NOSHIP,<
CAIN T2,.MNTDT ;DECTAPE MOUNT?
JRST [ CALLRET UDTM] ;YES
>;NOSHIP
ABTRET (MREQ21) ;I CAN'T HANDLE ANYTHING ELSE
; QSRINI - ESTABLISH IPCF RAPPORT WITH QUASAR
; RETURNS +1: ALWAYS
QSRINI: STKVAR <TSTFLG> ;FLAG USED ONLY FOR DEBUGGING
SETOM TSTFLG ;INITIALIZE FLAG
QSRIN1: MOVEI T1,.SPQSR
CALL GSYSPD ;GET QUASAR'S PID FROM SYSTEM PID TABLE
JRST [ AOSN TSTFLG ;HAVE WE BEEN HERE BEFORE?
CALL TSTWAT ;NO, INFORM USER WE ARE WAITING
MOVEI T1,^D5000 ;NOT THERE YET
DISMS ;WAIT 5 SECONDS
JRST QSRIN1] ; AND TRY AGAIN
MOVEM T1,APPID+.APQSR ;STUFF PID IN A/P TABLE
; BUILD AND TRANSMIT HELLO MESSAGE TO QUASAR
MOVE T1,[HEL.SZ,,.QOHEL] ;MESSAGE LENGTH ,, MESSAGE TYPE
SETZB T2,T3 ;NO FLAGS, NO ACK CODE
CALL GALHDR ;CONSTRUCT GALAXY HEADER IN TBUF
MOVE T1,[SIXBIT/MOUNTR/]
MOVEM T1,TBUF+HEL.NM ;MY NAME
MOVX T1,FLD(%%.QSR,HEFVER)
MOVEM T1,TBUF+HEL.FL ;QSRMAC VERSION #
MOVX T1,FLD(1,HENNOT)+FLD(HENMAX,HENMAX)
MOVEM T1,TBUF+HEL.NO ;# OF OBJ TYPES, MAX # OF JOBS
MOVX T1,.OTMNT
MOVEM T1,TBUF+HEL.OB ;I HANDLE MAGTAPE MOUNT REQUESTS
MOVEI T1,.APQSR ;GOING TO QUASAR
CALL TRANG ;TRANSMIT MESSAGE
RET
; QSRMRC - DISPATCH IPCF MESSAGES FROM QUASAR TO APPROPRIATE ROUTINES
; MRPDB, RBUF/ PDB AND MESSAGE
; RETURNS +1: ALWAYS
QSRMRC: SAVEQ
CALL CKGHDR ;CHECK OUT GALAXY HEADER
JRST [ CALLRET BADQM] ;BAD HEADER
; T1/ MESSAGE LENGTH (WORDS) T2/ MESSAGE TYPE
MOVSI T4,-QDTABL ;GET AOBJN POINTER
QSRMR1: HLRZ T3,QDTAB(T4) ;GET MESSAGE TYPE FROM TABLE
CAME T2,T3 ;DOES IT MATCH THE MESSAGE I JUST GOT?
JRST [ AOBJN T4,QSRMR1 ;NO, LOOP
CALLRET BADQM] ;DOESN'T MATCH ANYTHING IN THE TABLE
HRRZ T2,QDTAB(T4) ;GET ADDRESS OF DISPATCH WORD
MOVE T2,(T2) ;GET DISPATCH WORD
TLZE T2,1 ;HAVE TO CALL ORNBCK?
JRST [ DMOVE Q1,T1 ;YES, SAVE T1 & T2
CALL ORNBCK
JRST [ CALLRET BADQM] ;ERROR, REPORT IT AND RETURN
DMOVE T1,Q1 ;COPY 'EM BACK
JRST .+1]
CALLRET (T2) ;DISPATCH TO HANDLER, T1/ MSG LENGTH
; DISPATCH TABLE FOR MESSAGE TYPES RECEIVED FROM QUASAR
; 1 IN LEFT HALF OF LITERAL MEANS ORNBCK MUST BE CALLED BEFORE DISPATCH
QDTAB: .QOMNT,,[0,,QMNT] ;MOUNT REQUEST FROM USER
.QOMTA,,[0,,TCAN] ;TAPE MOUNT CANCEL
.QOMAT,,[0,,MATR] ;ATTRIBUTE REQUEST FROM USER
.ODDMT,,[1,,KDMT] ;OPR COMMAND - DELETE MOUNT-REQUEST
.ODENA,,[1,,KENA] ;OPR COMMAND - ENABLE
.ODDIS,,[1,,KDIS] ;OPR COMMAND - DISABLE
.ODDSM,,[1,,KDSM] ;OPR COMMAND - DISMOUNT
.ODSDK,,[1,,KSDK] ;OPR COMMAND - SET DISK-DRIVE
.ODIDN,,[1,,KIDN] ;OPR COMMAND - IDENTIFY
.ODSTP,,[1,,KSTP] ;OPR COMMAND - SET TAPE-DRIVE
.ODSHD,,[1,,KSHD] ;OPR COMMAND - SHOW STATUS DISK
.ODSHT,,[1,,KSHT] ;OPR COMMAND - SHOW STATUS TAPE
.ODSTR,,[1,,KSHS] ;OPR COMMAND - SHOW STATUS STRUCTURE
.ODSST,,[1,,KSST] ;OPR COMMAND - SET STRUCTURE
.ODSWI,,[1,,KSWI] ;OPR COMMAND - SWITCH
.ODUNL,,[1,,KUNL] ;OPR COMMAND - UNLOAD
.ODSPO,,[1,,KSPT##] ;OPR Command - Set Port
.ODUDS,,[1,,KSUD] ;OPR Command - Undefine Structure
.ODMTS,,[1,,KSMT] ;OPR command - Mount Structure
.ODSCD,,[1,,KSCD] ;OPR COMMAND - Show configuration disk
QDTABL==.-QDTAB
; REQRSB - TRANSLATE REQUEST NUMBER INTO RSB ADDRESS
; T1/ REQUEST NUMBER
; RETURNS +1: UNKNOWN REQUEST #, T1/ REQUEST #
; +2: SUCCESS, RSB/ RSB ADDR, T1/ REQUEST #
REQRSB: QSCANI ARBQDB ;SET UP TO SCAN RSB QUEUE
SAVET ;PRESERVE T1 AS ADVERTISED
REQR1: CALL QMSCAN ;GET NEXT RSB
RET ;NONE LEFT, REQUEST # UNKNOWN
MOVEI RSB,-RSBLNK(T2) ;LOAD RSB AC WITH ADDRESS OF RSB
MOVE T1,CT1 ;GET REQ# FROM RSB
CAME T1,RSBITN(RSB) ;DOES IT MATCH WHAT THE CALLER GAVE?
JRST REQR1 ;NO, CONTINUE SCAN
RETSKP ;YES, SUCCESS
; RLSMSG - SEND RELEASE MESSAGE TO QUASAR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
RLSMSG: MOVE T1,RSBITN(RSB) ;GET ITN
MOVEM T1,TBUF+REL.IT ;STORE IN MESSAGE
MOVE T1,[REL.SZ,,.QOMTR] ;GET GALAXY HEADER
SETZB T2,T3
CALL GALHDR ;BUILD HEADER
MOVEI T1,.APQSR
CALLRET TRANG ;SEND RELEASE MESSAGE TO QUASAR
; TCAN - PROCESS USER TAPE REQUEST CANCEL MESSAGE FROM QUASAR
; RBUF/ IPCF TAPE MOUNT CANCEL MESSAGE
; T1/ SIZE OF MESSAGE (WORDS)
; RETURNS +1: ALWAYS
TCAN: SAVEQ
MOVE T3,T1 ;COPY SIZE OF MESSAGE
SUBI T3,.OHDRS ;GET SIZE OF BLOCK REGION OF MESSAGE
JUMPLE T3,TCANQE ;NO BLOCK REGION, ERROR BY QUASAR
MOVE T1,RBUF+.OARGC ;GET # OF BLOCKS
MOVEI T2,RBUF+.OHDRS ;GET ADDRESS OF 1ST BLOCK
CALL CKBSTR ;CHECK BLOCK STRUCTURE
TCANQE: JRST [ CALLRET BADQM] ;BAD STRUCTURE, QUASAR GOOFED
DMOVE T1,[EXP RBUF+.OARGC,RBUF+.OHDRS]
MOVEI T3,.MTPID ;GET TYPE OF BLOCK BEING SOUGHT
CALL BLKFND ;LOOK UP USER'S PID
JRST TCANQE ;PID BLOCK NOT THERE
JUMPE T2,TCANQE ;MAKE SURE THERE'S ROOM FOR A PID
MOVE Q2,(T1) ;GET PID SO I CAN REPLY TO THE USER
DMOVE T1,[EXP RBUF+.OARGC,RBUF+.OHDRS]
MOVEI T3,.MTITN ;GET BLOCK TYPE
CALL BLKFND ;LOOK UP ITN LIST
JRST TCANQE ;NOT THERE
SETZ Q1, ;CLEAR COUNTER OF CANCELED REQUESTS
JUMPE T2,TCAN2 ;NO SCAN IF NOTHING TO CANCEL
MOVN Q3,T2 ;GET NEGATIVE NUMBER OF ITN'S
MOVSS Q3 ;OVER TO LEFT HALF FOR AOBJN
HRR Q3,T1 ;MAKE AOBJN POINTER TO ITN LIST
; LOOP THROUGH ITN LIST, TRYING TO CANCEL EACH ONE
TCAN1: MOVE T1,(Q3) ;GET AN ITN
CALL TCITN ;TRY TO CANCEL IT
SKIPA ;CAN'T CANCEL
AOS Q1 ;COUNT CANCELED REQUEST
AOBJN Q3,TCAN1 ;LOOP
; ..
; ..
; BUILD TEXT REPLY TO CANCEL MESSAGE IN TMCMSG
TCAN2: JUMPG Q1,[TMCT <%I%5D> ;AT LEAST 1 REQUEST CANCELED
JRST TCAN3]
TMCT <%INo> ;NO REQUESTS CANCELED
TCAN3: TMCT < mount request>
SOJN Q1,[TMCT <s> ;IF NOT 1 REQUEST, TACK ON AN "S"
JRST .+1]
TMCT < canceled>
; BUILD IPCF MESSAGE AND SEND IT TO THE CANCELER
MOVE T1,Q2 ;GET USER'S PID
SETZ T2, ;NO FLAGS
MOVE T3,RBUF+.MSCOD ;GET CANCELER'S ACK CODE
CALLRET TXTMSG ;RESPOND TO CANCEL WITH GLX TEXT MESSAGE
; TCKP - SEND A STATUS UPDATE FOR A MOUNT REQUEST TO QUASAR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
TCKP: SAVEQ
SAVEAC <MT,MTA>
MOVE T1,RSBITN(RSB)
MOVEM T1,TBUF+CHE.IT ;STORE ITN IN MESSAGE
SETZM TBUF+CHE.FL ;SET NO SPECIAL FLAGS
MOVEI Q1,TBUF+CHE.IN ;GET ADDR OF START OF CKPT INFO AREA
LOAD Q2,RSBTYP ;GET REQUEST TYPE
MOVEM Q2,.MTTYP(Q1) ;STORE IT
CAIE Q2,.MNTTP ;TAPE REQUEST?
CAIN Q2,.MNTDT ; OR DECTAPE REQUEST?
SKIPA ;YES
JRST TCKP0 ;NO, SKIP VOLID STUFF
CALL VQGCV ;GET VOLID OF CURRENT VOLUME IN T1
SKIPN T1 ;SCRATCH?
MOVEI T1,%VOLSC ;YES, GET 1 TO DISPLAY "Scratch"
LOAD T2,RSBSTE ;GET CURRENT STATE OF REQUEST
CAIGE T2,.ERBAS ;ABORTED OR
CAIN T2,RST.WV ; WAITING FOR VOLID LIST?
MOVEI T1,%VOLBL ;YES, DON'T DISPLAY ANYTHING
MOVEM T1,.MTVOL(Q1) ;STORE VOLID
TCKP0:
CAIN T2,RST.AC ;REQUEST HAVE MTA OR DTA?
JRST [ MOVE T1,RSBDTA(RSB) ;YES, ASSUME DECTAPE
CAIN Q2,.MNTDT ;DECTAPE?
JRST TCKP1 ;YES, T1/ DECTAPE DEVICE DESIGNATOR
LOAD MT,RSBMT ;MAGTAPE REQUEST
LOAD MTA,MTMTA ;LOAD MTA AC
CALL GMTADD ;GET MTA DESIGNATOR IN T1
JRST TCKP1] ;GO STORE IT
MOVEI T1,%STAWT ;ASSUME WAITING FOR SOMETHING
CAIL T2,.ERBAS ;ABORTED?
MOVEI T1,%STAAB ;YES, SAY SO THEN
TCKP1: MOVEM T1,.MTSTA(Q1) ;STORE STATE FIELD OF MESSAGE
MOVE T1,[CHE.IN+EQCKSZ,,.QOMTC] ;GET SIZE AND MESSAGE TYPE
SETZB T2,T3 ;NO FLAGS OR ACK CODE
CALL GALHDR ;BUILD GALAXY HEADER
MOVEI 1,.APQSR
CALLRET TRANG ;SEND CHECKPOINT MESSAGE TO QUASAR
; TXTMSG - SEND GALAXY IPCF TEXT-MESSAGE
; T1/ RECEIVER'S PID
; T2/ FLAGS FOR GALAXY MESSAGE HEADER
; T3/ ACK CODE FOR MESSAGE HEADER
; TMCMSG/ ASCIZ MESSAGE TO BE SENT
; RETURNS +1: ALWAYS
TXTMSG: STAKT
AOS TBUF+.OARGC ;SET ARGUMENT COUNT TO 1
MOVE T1,TMCWDS ;GET LENGTH OF MESSAGE (WORDS)
MOVSI T2,1(T1) ;CONSTRUCT
HRRI T2,.CMTXT ; ARGUMENT HEADER WORD
MOVEM T2,TBUF+.OHDRS ;STORE ARG HEADER
MOVE T2,[TMCMSG,,TBUF+.OHDRS+1] ;GET BLT SOURCE,,DESTINATION
BLT T2,TBUF+.OHDRS(T1) ;COPY TEXT INTO IPCF MESSAGE
MOVSI T1,.OHDRS+1(T1) ;GET SIZE OF ENTIRE MESSAGE
HRRI T1,MT.TXT ;BUILD SIZE,,TYPE
MOVE T2,CT2 ;GET FLAGS
MOVE T3,CT3 ;GET ACK CODE
CALL GALHDR ;BUILD GALAXY HEADER FOR MESSAGE
MOVE T1,CT1 ;GET RECEIVER'S PID
CALLRET TRANU ;TRANSMIT MESSAGE AND RETURN
SUBTTL STRUCTURE ROUTINES
;BSRALI - GET STRUCTURE ALIAS FROM QUASAR MSSG INTO RSB
;ACCEPTS: T1/ ADDRESS OF SUBENTRY COUNT WORD
; T2/ ADDRESS OF FIRST SUBENTRY
; RSB/ ADDR OF REQUEST STATUS BLOCK
;RETURNS: +1, FAILURE
; +2, SUCCESS
BSRALI: MOVEI T3,.SMALI ;GET STRUCTURE ALIAS CODE
CALL BLKFND ;LOOKUP ALIAS
JRST [ ABTRET(MREQ22)] ;ERROR, CAN'T MOUNT STR IF NO ALIAS
JUMPE T2,[ABTRET(MREQ22)] ;TREAT ZERO-LENGTH NAME LIKE NO NAME
MOVE T1,(T1) ;GET ALIAS IN T1
MOVEM T1,RSBSTA(RSB) ;STORE ALIAS IN RSB
RETSKP
;BSRNAM - GET STRUCTURE NAME FROM QUASAR MSSG INTO RSB
;ACCEPTS: T1/ ADDRESS OF SUBENTRY COUNT WORD
; T2/ ADDRESS OF FIRST SUBENTRY
; RSB/ ADDR OF REQUEST STATUS BLOCK
;RETURNS: +1, FAILURE
; +2, SUCCESS
BSRNAM: MOVEI T3,.SMNAM ;GET STRUCTURE NAME CODE
CALL BLKFND ;LOOKUP NAME
JRST BSRNA1 ;NAME NOT GIVEN
JUMPE T2,BSRNA1 ;TREAT ZERO-LENGTH NAME AS NO NAME
MOVE T1,(T1) ;GET NAME IN T1
CAME T1,RSBSTA(RSB) ;IS NAME SAME AS ALIAS
JRST [ MOVX T2,R%PRIV ;NO, IS USER PRIVILEGED?
TDNE T2,RSBIFL(RSB)
JRST .+1 ;YES, LET IT GO
ABTRET (CAPX1)] ;NOT PRIVLEGED, ABORT REQUEST
SKIPA
BSRNA1: SETZ T1, ;STORE ZERO IF NO NAME MENTIONED
MOVEM T1,RSBSTN(RSB) ;STORE NAME IN REQUEST BLOCK
RETSKP
SUBTTL Update all disks -- Flow of update
COMMENT %
+----------+
| DDSCIH |
+----------+
|
------------------------------------------------
| | | |
+----------+ +----------+ +----------+ +----------+
| DDSNXT | | DSTSRC | | DDSNEW | | DDSCHK | Add or check
+----------+ +----------+ +----------+ +----------+ DSK
Get next Search for | | |
CKU DSK with CKU ------------- |
(Also called | |
by KSDK) +----------+ +----------+
| DDSADD | | DDSDEL | Delete structure
Add disk +----------+ +----------+ info. about disk
| | |
+----------+ ---------
Store structure | STRINF | |
info. for disk +----------+ +----------+
| | DDSMCH | Match user requests
+----------+ +----------+ with disk change
Get/build SSB | STRGSB |
+----------+
% ; END OF COMMENT
SUBTTL Update all disks -- DDSCIH - Update all disk drives
;DDSCIH - ENTERED BY SCHEDULER WHEN PSI INTERRUPT RECEIVED
; INDICATING THAT A DISK STATUS CHANGE HAS OCCURRED
; Also called whenever disks need to be updated
;ACCEPTS: NOTHING
;RETURNS: +1, ALWAYS
DDSCIH::SAVEQ ;SAVE ACS
CALL DSFNUP ;Set no update
DDSC.0: CALL DSTINI ;INITIALIZE TO LOOP OVER ALL DISKS
DDSC.1: CALL DSTNXT ;GET STATUS OF NEXT DISK
JRST DDSC.2 ;Done go finish up
CALL DSTSRC ;LOOK FOR UNIT IN TABLES
JRST [ CALL DDSNEW ;Not found, go do a new disk drive
JRST DDSC.1] ;And continue
CALL DDSCHK ;Otherwise, go check on it
JRST DDSC.1 ;THEN LOOK AT NEXT ONE
DDSC.2: SKIPN AGAIN ;Do we need to do again?
JRST DDSC.3 ;No, go clean up
SETZM AGAIN ;Clear flag
JRST DDSC.0 ;Go try again
DDSC.3: CALL DSFYUP ;Want to update
RET ;And return
SUBTTL Update all disks -- DSTINI - Initialize MSTR block for scanning units
; Called only by DDSCIH
;ACCEPTS: NOTHING
;RETURNS: +1, ALWAYS
DSTINI: SETOM MSTRBK ;SET UP MSTR TO LOOK AT FIRST CHANNEL
SETOM MSTRBK+1 ; FOR FIRST CONTROLLER
SETOM MSTRBK+2 ; FOR FIRST DISK
RET ;DONE
SUBTTL Update all disks -- DSTNXT - Get status of the next disk
; Called only by DDSCIH
;ACCEPTS: MSTRBK BLOCK FOR MSTR JSYS
;RETURNS: +1, FAILURE
; +2, SUCCESS, STATUS RETURNED IN MSTRBK BLOCK
; T1/ CKU NUMBERS FOR UNIT
DSTNXT: MOVE T1,[POINT 7,MSTNM] ;GET POINTER TO STRUCTURE NAME
MOVEM T1,MSTRBK+.MSRSN ; AND STORE IN MSTR ARGUMENT BLOCK
MOVE T1,[POINT 7,MSTAL] ;DO SAME FOR STRUCTURE ALIAS
MOVEM T1,MSTRBK+.MSRSA
MOVE T1,[50,,.MSRNU] ;Set up call to monitor to get status
MOVEI T2,MSTRBK ;PUT STATUS IN MSTR BLOCK
SETZM MSTNM ;CLEAR NAME IN CASE NOT PART OF STRUCTURE
SETZM MSTAL ;CLEAR ALIAS ALSO
MSTR ;GET STATUS
ERJMP R ;END OF DISKS
SETZ T1, ;START WITH ZERO AC
MOVE T2,MSTRBK+.MSRCH ;GET CHANNEL NUMBER
STOR T2,DOP%C2,T1 ;STORE INTO AC
MOVE T2,MSTRBK+.MSRCT ;GET CONTROLLER NUMBER
STOR T2,DOP%K2,T1 ;STORE WITH CHANNEL
MOVE T3,MSTRBK+.MSRUN ;FINALLY GET UNIT NUMBER
STOR T3,DOP%U2,T1 ;STORE WITH REST
RETSKP ;DONE
SUBTTL Update all disks -- DSTSRC - LOOK FOR THE DISK ENTRY MATCHING SPECIFIED CKU NUMBERS
;ACCEPTS: T1/ CKU NUMBER (CHANNEL, CONTROLLER, UNIT NUMBERS)
;RETURNS: +1, UNIT WAS NOT IN TABLES
; DSK/ ADDRESS OF FIRST FREE SLOT OR ZERO IF NONE
; +2, UNIT FOUND
; DSK/ ADDRESS OF DISK STATUS BLOCK FOR UNIT
DSTSRC: MOVE DSK,[-MAXDSK,,DSKSTB] ;GET AOBJN POINTER READY
SETZ T2, ;NO FREE ENTRY FOUND YET
DSTSRL: SKIPN DSKFLG(DSK) ;THIS ENTRY IN USE?
JRST DSTSRF ;NO, GO REMEMBER FREE ENTRY
CAME T1,DSKCKU(DSK) ;IS THIS THE UNIT?
JRST DSTSRN ;NO, TRY NEXT ONE
ANDI DSK,-1 ;FOUND THE UNIT, REMOVE JUNK
RETSKP ;SUCCESSFUL RETURN
DSTSRF: SKIPN T2 ;HAVE FREE ENTRY REMEMBERED YET?
MOVE T2,DSK ;NO, THEN REMEMBER THIS ONE
DSTSRN: ADDI DSK,DSKSZ-1 ;MOVE TO NEXT ENTRY
AOBJN DSK,DSTSRL ;GO DO IT
HRRZ DSK,T2 ;UNIT NOT FOUND, GET FREE BLOCK IF ANY
RET ;AND RETURN IT
SUBTTL Update all disks -- DDSNEW - Add new disk to data bases
; Called only by DDSCIH
;HERE WHEN A NEW UNIT HAS TO BE ADDED TO THE DISK TABLES:
; DSK/ ADDRESS OF FREE ENTRY, OR ZERO IF NO MORE ROOM
; T1/ CKU NUMBERS FOR UNIT
DDSNEW: SKIPN DSK ;Room for the entry?
CALL STOP ;No, must be room
; Initialize the disk status block
MOVSI T2,0(DSK) ;SETUP BLT POINTER
IORI T2,1(DSK) ;TO CLEAR THE DISK STATUS BLOCK
SETZM (DSK) ;CLEAR FIRST WORD
BLT T2,DSKSZ-1(DSK) ;THEN THE REST
MOVEM T1,DSKCKU(DSK) ;REMEMBER CKU NUMBERS
MOVE Q2,MSTRBK+.MSRST ;GET STATUS OF DISK
MOVEM Q2,DSKFLG(DSK) ;REMEMBER IN BLOCK
MOVE T2,MSTRBK+.MSDSH ;Get serial number of disk (HIGH ORDER)
MOVEM T2,DSKSNH(DSK) ;Remember in block
MOVE T2,MSTRBK+.MSDSN ;Get serial number of disk (LOW ORDER)
MOVEM T2,DSKSNL(DSK) ;Remember in block
; Add/create DDB for entry
MOVEI T2,.DVDSK ;Get the disk type
MOVEM T2,DSFE+DSFTYP ;Save it
MOVEM T1,DSFE+DSFSPC ;Save the CKU
SETZM DSFE+DSFFLG ;Default to no flags
CALL DSFCRE ;Go create it
JRST DDSN.1 ;Skip this, it already exists
; Here check whether to set DSF%PO in the disk entry of the DDB base on PORTST
; PORTST=0 indicates port available, 1=unavailable, -1=No port
SKIPG PORTST ;Is the port available
JRST DDSN.1 ;Available, skip port stuff
MOVE T2,MSTRBK+.MSRCH ;Get the channel number
CAIE T2,CIPORT ;For now test for channel 7
TXNE Q2,MS%2PT ;Port unavailable, is it dual ported?
CALL [SETONE DSF%PO,DSFE+DSFFLG ;Set disk unavail due to port operation
RET]
DDSN.1: MOVEM DSK,DSFE+DSFPNT ;Save the DSB address
CALL DSFUDE ;Update the entry
$STOP <Update of previously known DDB with DSFUDE failed>
MOVEM T1,DSKPNT(DSK) ;Save address of DDB in DSB
TXNE Q2,MS%OFL ;Is pack off-line?
TXNE Q2,MS%IAC ;Yes, but is it due to HOM checking?
CALL DDSADD ;No, add structure information
RET ;DONE WITH UNIT
SUBTTL Update all disks -- DDSCHK - Check disk already existing
; Called only by DDSCIH
;HERE TO CHECK ON A DISK WHICH WAS ALREADY IN OUR TABLES. UPDATE
;THE DATA FOR IT.
; DSK/ ADDRESS OF THIS DRIVE'S DATA
DDSCHK: MOVE Q2,MSTRBK+.MSRST ;Get status of disk unit
MOVE Q1,Q2 ;Make copy of status
XOR Q1,DSKFLG(DSK) ;Get changed bits
MOVEM Q2,DSKFLG(DSK) ;Save new state in any case
; First, if online, check the name of the structure with the old name.
; If different, then delete the old and set the new structure information.
TXNE Q2,MS%OFL!MS%IAC ;Offline?
JRST DDSCH1 ;Yes, skip the name test
; Online, make sure we have a structure
SKIPN MSTNM ;Do we have a structure
JRST [CALL CHKDSK ;[336]Is it due to disk errors?
RET ;[336]Yes, bad data on disk drive
LOAD STR,DSKSSA,(DSK) ;[336]No structure,
JUMPE STR,R ;[336]If no pointer forget about this disk
MOVE T1,DSKCKU(DSK) ;No errors, MONITOR bug, get the CKU
TMCT <%IWarning disk (%1K) is online
but can not find structure on disk%_>
MOVEI T3,[ASCIZ/Disk Problem/]
CALLRET BTWTO] ;Online, but no structure!!!!
MOVE T1,MSTRBK+.MSMID ;Get the unique code
CAME T1,DSKUNQ(DSK) ;Is it the same
JRST DDSCH0 ;No, must be a new structure
MOVE T1,[POINT 7,MSTNM] ;Online, get pointer to name
MOVEI T2,Q3 ;Want to put it in Q3
CALL SEVSIX ;Convert name to sixbit
CAME Q3,DSKSTN(DSK) ;Same as before?
;**;[6034]At DDSCHK:+16L add 6 lines JYCW 11-Aug-88
JRST DDSCH0 ;[6034]No, go update
MOVE T1,[POINT 7,MSTAL] ;[6034]Online, get pointer to name
MOVEI T2,Q3 ;[6034]Want to put it in Q3
CALL SEVSIX ;[6034]Convert name to sixbit
CAMN Q3,DSKSTA(DSK) ;[6034]Same as before?
JRST DDSCH1 ;[6034]Yes, go check on other things
; The name (disk) has changed
DDSCH0: CALL DDSDEL ;Delete old structure information
CALL DDSADD ;Add new structure information
RET ;Nothing else to do this time
; The name is the same or don't care. Any reason to check further?
DDSCH1: LOAD T1,DSKSSA,(DSK) ;Get the structure address field
CAIN T1,-1 ;Is it special, indicating a need to add?
JRST DDSADD ;Yes, go do it
SKIPN Q1 ;Anything changed in status?
JRST [TXNN Q2,MS%MNT ;No, is it mounted?
RET ;No, nothing further to check
LOAD STR,DSKSSA,(DSK) ;Get the SSB address
SKIPN STR ;Is there one?
RET ;No. done
SKIPE T1,STRPNT(STR) ;Get the DDB address
CALL UPDSTR ;Go try to update it
RET] ;Done
; If the offline status has changed we either need to add or delete
TXNE Q1,MS%OFL ;Offline status change?
JRST [TXNE Q2,MS%IAC ;Yes, but is it HOM checking?
RET ;Yes, no need to do anything
TXNE Q2,MS%OFL ;How did the offline status change?
JRST DDSDEL ; became offline
JRST DDSADD] ; became online
; If the mount status changed, add structure again
; Also, if on f the error status changed, then also add structure again.
TXNE Q1,MS%MNT!MS%WLK!MS%HBB!MS%BBB!MS%DIA ;Mount or error change?
JRST DDSADD ;Yes.
RET ;Whatever changed, we don't understand...
SUBTTL Update all disks -- DDSDEL - DELETE STRUCTURE INFORMATION ABOUT A DISK
; Called only by DDSCHK
;ACCEPTS: DSK/ DISK NUMBER
;RETURNS: +1, ALWAYS
DDSDEL: LOAD STR,DSKSSA,(DSK) ;Get structure block address
JUMPLE STR,DDSDE2 ;If no STR then return after zeroing dsk entry
CALL STRDSM ;Dismount structure data base if needed
LOAD T1,STRMCT,(STR) ;Get number of disks mounted in structure
SOJN T1,[STOR T1,STRMCT,(STR) ;If still more, save the number left
LOAD T1,DSKLUN,(DSK) ;Get disk logical number
ADD T1,STR ;Add base
SETZM STRADD(T1) ;Clear this entry
JRST DDSDE2] ;Continue to clear disk entry
QSCANI ARBQDB ;Setup to scan active RSB queue
SAVEAC <RSB,DSK>
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
MOVX T1,R%DSM ;CHECK DISMOUNT QUEUES
CALL DDSMCH ;MATCH AND FINISH ACTIVE RSB'S
MOVE T1,STRFL1(STR) ;[6011]Get flag
TXNN T1,STR%LE+STR%LD ;[6011]Locked?
IFSKP.
TXNN T1,STR%MT ;[6011]Yes, is it still mounted?
CALL RELLOC ;[6011]No, have to unlock structure
ENDIF.
CALL SSBRET ;Return the SSB
DDSDE2: SETZM DSKSTN(DSK) ;ZERO STRUCTURE NAME
SETZM DSKSTA(DSK) ;ZERO STRUCTURE ALIAS
SETZM DSKNS(DSK) ;Zero structure unit information
SETZM DSKP2(DSK) ;Clear pointer to SSB (zeros DSKSSA)
RET
SUBTTL Update all disks -- DDSADD - ADD A DISK COMING ON-LINE
; Called only by DDSNEW and DDSCHK
;ACCEPTS: DSK/ Address of Disk Status Block
;RETURNS: +1, ALWAYS
DDSADD: CALL STRINF ; YES, STORE STRUCTURE INFORMATION
RET ;Do not want to continue right now
LOAD T1,STRUNI,(STR) ;GET NUMBER OF DISKS IN STR
LOAD T2,STRMCT,(STR) ;GET NUMBER OF DISKS MOUNTED IN STR
CAME T1,T2 ;ARE ALL DISK PACKS MOUNTED?
RET ;NO, RETURN
;TRY TO MATCH STRUCTURE COMING ON-LINE TO USER REQUEST
QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB,DSK>
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
MOVE Q2,DSKFLG(DSK) ;GET DISK STATUS
TXNE Q2,MS%MNT ;IS IT MOUNTED ALREADY?
JRST [ CALLRET DDSMC0] ;YES, CHECK MOUNT QUEUES
DDSAD1: CALL NSTRSB ;GET ADDRESS OF NEXT RSB
RET ;NONE LEFT
LOAD T1,RSBSTE ;GET STATE OF REQUEST
CAIE T1,RST.WM ;IS USER WAITING FOR STRUCTURE
JRST DDSAD1 ;NO, TRY NEXT REQUEST
SKIPN T1,RSBSTN(RSB) ;GET STRUCTURE NAME IN REQUEST
MOVE T1,RSBSTA(RSB) ;THERE IS NONE, GET ALIAS FOR NAME
CAME T1,STRNAM(STR) ;IS IT SAME AS STRUCTURE COMING ON-LINE
JRST DDSAD1 ;NO, TRY NEXT REQUEST
CALL STRMNT ;MOUNT THE STRUCTURE
JRST DDSAD2 ;ERROR IN MOUNTING STRUCTURE
SETZ T1, ;CHECK MOUNT REQUESTS
CALLRET DDSMCH ;STRUCTURE IS NOW READY FOR USERS. TELL THEM
;DDSAD2 - Return according to request. If it was a MOUNT command from OPR
; go to KSMTE2 for error message.
DDSAD2: SKIPGE RSBITN(RSB) ;Is it from operator
CALLRET KSMTE2 ;Yes, let KSMTE2 handle the error
RET ;No, STRMNT should have given the error message
SUBTTL Update all disks -- STRINF - Store/check structure information
; Called only by DDSADD
;ACCEPTS: Q2/ STATUS OF UNIT
; DSK/ Address of Disk Status Block
; MSTRBK/ BLOCK FROM MSTR CALL
;RETURNS: +1 if processing requires second pass
; +2 if ok.
STRINF: MOVE T1,[POINT 7,MSTNM] ;GET POINTER TO STRUCTURE NAME
MOVEI T2,DSKSTN(DSK) ;GET WORD IN WHICH TO STORE NAME
CALL SEVSIX ; CONVERT FROM 7-BIT TO 6-BIT
TXNN Q2,MS%MNT ;DOES DRIVE HAVE MOUNTED STRUCTURE
JRST STRIN1 ;NO, STORE REST OF INFORMATION
MOVE T1,[POINT 7,MSTAL] ;GET POINTER TO ALIAS NAME
MOVEI T2,DSKSTA(DSK) ;GET WORD IN WHICH TO STORE ALIAS
CALL SEVSIX ;CONVERT FROM 7-BIT TO 6-BIT
STRIN1: MOVE T3,MSTRBK+.MSRNS ;GET LOGICAL UNIT,,NUMBER OF UNITS
MOVEM T3,DSKNS(DSK) ; AND STORE
MOVE T4,MSTRBK+.MSMID ;Get the unique code
MOVEM T4,DSKUNQ(DSK) ;Save it in DSB
MOVE T1,DSKSTA(DSK) ;GET STRUCTURE ALIAS IN SIXBIT
MOVE T2,DSKSTN(DSK) ;GET STRUCTURE NAME
CALL STRGSB ;BUILD STR STATUS TABLE & GET STR ADDR
RET ;Done for now
STOR STR,DSKSSA,(DSK) ;STORE STR STATUS BLOCK ADDRESS
; If the structure is not mounted, was it previously, and if so, clean
; some stuff up.
TXNE Q2,MS%MNT ;Is disk part of a mounted structure?
JRST [CALL CHKDSK ;Is the disk error free
JRST STRIN6 ;No
JRST STRIN3] ;Yes, no errors found
CALL CHKDSK ;Disk is not mounted, any errors
SKIP
CALL STRDSM ;Dismount structure data base if needed
RETSKP ;And done
; Continued on next page
;Continued from previous page
; Since there are no error bits, are there any to clear?
STRIN3: MOVE T1,STRFL1(STR) ;Get the flags
TXZN T1,STR%DE ;Any device errors previous? (And clear bit)
JRST STRIN6 ;No, skip this
; Want to loop on all the disks to verify that the bit should still be set.
LOAD T2,STRUNI,(STR) ;Get the number of units
MOVNS T2 ;Set number of units negative
MOVSS T2 ;Switch halves
HRRI T2,STRADD(STR) ;Get start of pack list
; Beginning of loop
STRIN4: MOVE T3,(T2) ;Get address of DSB
MOVE T3,DSKFLG(T3) ;Get the flags for this one
TXNE T3,MS%WLK+MS%HBB+MS%BBB+MS%DIA+MS%ERR+MS%16B ;Any bad bits set?
JRST STRIN6 ;Yes, cannot clear bit at this time
AOBJN T2,STRIN4 ;Go try for more
; End of loop
MOVEM T1,STRFL1(STR) ;We win! Clear the bit
MOVE T2,DSKSTA(DSK) ;Get Alias
TMCT <%IDevice error cleared%_Structure %2S: can be used>
MOVEI T3,STRCHD ;Get general purpose structure header
CALL BTWTO ;Tell everyone
; Continued on next page
;Continued from previous page
; Structure is mounted.
; Check to see if SSB knows about all of the disks of the structure.
STRIN6: LOAD T1,STRUNI,(STR) ;Get number of units in structure
LOAD T2,STRMCT,(STR) ;Get the number found so far
CAME T1,T2 ;The whole thing mounted?
RETSKP ;No, don't do anything else for now
; All the packs are mounted. Build/find DDB entry.
MOVE T1,STRFL1(STR) ;Get the other structure flags
TXNE T1,STR%MT ;Was it previously mounted?
JRST STRIN7 ;Yes, skip this stuff
MOVEI T2,MSTAL ;Get the structure alias ascii
TMCT <%IPreviously mounted structure %2A: detected>
MOVEI T3,STRCHD ;Get header
CALL BTWTO
MOVX T2,STR%MT ;Get mounted bit
IORM T2,STRFL1(STR) ;Say it is so
MOVE T1,DSKSTA(DSK) ;Get the structure alias
MOVEM T1,STRALI(STR) ;Save it
SKIPA ;Don't need to get alias again
MOVE T1,STRALI(STR) ;Get the alias
CALL ISTDDB ;Go build/find DDB
;**;[6033]At STRIN6:+22L (within literal) change 2 lines JYCW 6/28/88
CALL [SKIPE T2,DSFE+DSFPNT ;[6033]Already exists?
SETZM STRPNT(T2) ;[6033]Yes, old pointer no longer valid
RET] ;Rejoin code
HRRM STR,DSFE+DSFPNT ;Save SSB address as pointer
CALL DSFUDE ;Update DDB entry
$STOP <Update of previously known DDB with DSFUDE failed>
MOVEM T1,STRPNT(STR) ;Save DDB pointer
; Now want to UPDATE structure if needed including telling everyone
; about what happened.
STRIN7: MOVE T1,STRPNT(STR) ;Get pointer to DDB back
CALL UPDSTR ;Go update structure
RETSKP ;And done
SUBTTL Update all disks -- STRGSB - GET STRUCTURE STATUS BLOCK (BUILD ONE IF NECESSARY)
; Called only by STRINF
;ACCEPTS: T1 SIXBIT STRUCTURE ALIAS
; T2 SIXBIT STRUCTURE NAME
; T3 LOGICAL UNIT # OF CURRENT DISK,,# OF UNITS IN STRUCTURE
; T4 Structure Unique Code
; DSK DISK STATUS BLOCK ADDRESS
;RETURNS: +1 if processing requires 2nd pass
; +2 if ok.
; STR/ CURRENT STRUCTURE BLOCK ADDRESS
STRGSB: STAKT
CALL MATCHS ;DOES THIS STRUCTURE EXIST?
SKIPA ;NO
JRST STRFND ;YES, DON'T NEED TO BUILD NEW BLOCK
STRGS0: CALL SSBCRE ;[336]Get a new SSB entry
MOVE T2,CT2 ;RESTORE STR NAME
MOVEM T2,STRNAM(STR) ;SAVE STR NAME
HRRZ T2,CT3 ;GET NUMBER OF UNITS
STOR T2,STRUNI,(STR) ;AND STORE
MOVE T1,DSKUNQ(DSK) ;Get unique code
MOVEM T1,STRUNQ(STR) ;Save it
;STORE DISK STATUS BLOCK ADDRESS
STRFND: HLRZ T3,CT3 ;GET UNIT NUMBER
ADD T3,STR ;GET OFFSET TO
SKIPN T2,STRADD(T3) ;[6023]Do we have a previous address?
IFSKP. ;[336][6023]Change to IFSKP
CAMN T2,DSK ;[336]Yes, is it the same as this one?
JRST STRFN0 ;Yes, still ok.
LOAD T1,DSKSSA,(DSK) ;Get the disk structure address
CAIN T1,-1 ;Have we already been here?
JRST STRFN3 ;[336]Yes, go do some analyz
SETONE DSKSSA,(DSK) ;Set the case
SETOM AGAIN ;Say we should try again
RET ;[6023]Add missing RET from [336]
ENDIF. ;[336]
STRFN0: HRRZM DSK,STRADD(T3) ; SAVE DISK STATUS BLOCK ADDRESS
LOAD T2,STRUNI,(STR) ;Get the number of units
MOVNS T2 ;Set number of units negative
MOVSS T2 ;Switch halves
HRRI T2,STRADD(STR) ;GET START OF PACK LIST
SETZ T4, ;LOOP THRU TO GET # OF PACKS
STRFN1: SKIPE (T2) ;IS THIS A PACK
AOS T4 ;YES, COUNT IT
AOBJN T2,STRFN1 ;LOOK FOR ALL OF THEM
STOR T4,STRMCT,(STR) ; AND STORE
RETSKP
;[336] STRFN3 - Find out why we have a -1 in DSKSSA.
;Accepts T2/disk status block
; DSK/disk status block with -1 for SSB address.
; STR/SSB
STRFN3: MOVE T1,DSKFLG(DSK) ;[336]Get status flag of coming online disk
TXNE T1,MS%IAC+MS%OFL ;[336]HOM block checking?
IFNSK.
MOVE T2,DSK ;[336]Move DSB into AC T2
JRST STRFN5 ;[336]Delete DSB
ENDIF.
MOVE T3,DSKFLG(T2) ;[336]Get disk status flag of existing disk
TXNE T3,MS%IAC+MS%OFL ;[336]HOM block checking?
JRST STRFN5 ;[336]Yes, delete DSB
; Not result from a force offline due to HOM block checking
; Is it due to bad HOM block informaton
TXNN T1,MS%HBB ;[336]Bad HOM block?
IFSKP. ;[336]Yes
SETZM DSKP2(DSK) ;[336]Clear pointer to SSB (zeros DSKSSA)
RET ;[336]Yes, no need to add SSB
ENDIF.
; Not result from bad HOM block
; Must be identical structures coming online
JRST STRGS0 ;[336]Go create a new SSB
;T2/DSB address
STRFN5: SETZM DSKSTN(T2) ;[336]Zero structure name
SETZM DSKSTA(T2) ;[336]Zero structure alias
SETZM DSKNS(T2) ;[336]Zero structure unit information
SETZM DSKP2(T2) ;[336]Clear pointer to SSB (zeros DSKSSA)
RET
SUBTTL Update all disks -- STRDSM - Dismount structure data base
; Called only by STRINF and DDSDEL
; This routine checks the mount bit for the structure and if lit, then
; delete DDB, clear the mount bit, and clear the alias. It also sends
; an error message because the dismount is not normal
; Accepts: STR / address of SSB
; Returns: +1 always
STRDSM: MOVE T1,STRFL1(STR) ;No, get the structure flags
TXNN T1,STR%MT ;Was the structure previously mounted?
RET ;No, all done
CALL DSTDDB ;Get rid of DDB entry
MOVE T1,STRALI(STR) ;Get the old structure alias
TMCT <%IPreviously mounted structure %1S: no longer mounted>
MOVEI T3,STRCHD ;Get general purpose structure header
CALL BTWTO ;Tell everyone
SETZM STRALI(STR) ;Alias only has meaning if structure mounted
RET ;All to do with this structure
SUBTTL Disk status check -- CHKDSK -- Check for disk errors
; Disk is online, check out if any error bits are set
; accepts Q2/disk status
; STR/structure status block
; DSK/disk status block
; return +1 found error
; +2 no error found
CHKDSK: TXNN Q2,MS%WLK+MS%HBB+MS%BBB+MS%DIA+MS%ERR+MS%16B ;Any bad bits set?
RETSKP ;No, skip setting the problem
MOVE T1,DSKCKU(DSK) ;Get CKU
TMCT <%IDevice error on %1K%_Drive cannot be used>
TXNE Q2,MS%WLK ;Write locked?
CALL [TMCT <%_Unit is write locked>
RET] ;And return
TXNE Q2,MS%HBB ;Home block problem?
CALL [TMCT <%_Unit has bad home block>
RET] ;And return
TXNE Q2,MS%BBB ;Bad bit block problem?
CALL [TMCT <%_Unit has bad bat block>
RET] ;And return
TXNE Q2,MS%DIA ;Diagnostics?
CALL [TMCT <%_Unit currently in use by on-line diagnostic>
RET] ;And return
TXNE Q2,MS%ERR ;Device error?
CALL [TMCT <%_Error reading this unit>
RET] ;And return
TXNE Q2,MS%16B ;16 Bit format?
CALL [TMCT <%_Unit written in 16 bit mode>
RET] ;And return
MOVEI T3,STRCHD ;Get general purpose structure header
CALL BTWTO ;Tell everyone
LOAD STR,DSKSSA,(DSK) ;[336]No structure,
JUMPE STR,R ;[336]If no pointer forget about this disk
SETONE STR%DE,STRFL1(STR) ;[336]Yes, set the disk error flag
RET ;Error return
SUBTTL Update all disks - DDSMCH - MATCH USER REQUEST TO MOUNTS AND DISMOUNTS
; Called only by DDSADD and DDSDEL
;ACCEPTS: T1/ 0=LOOK AT MOUNT REQUESTS
; R%DSM=LOOK AT DISMOUNT REQUESTS
; QSB/ ADDRESS OF QUEUE SCAN BLOCK
; STR/ ADDRESS OF STRUCTURE BLOCK
;RETURNS: +1, ALWAYS
DDSMC0: SAVEQ ;ALTERNATE ENTRY FOR MOUNT REQUESTS
SETZ Q1,
JRST DDSMC1
DDSMCH: SAVEQ
MOVE Q1,T1
JUMPE Q1,DDSMC2 ;GO TO DDSMC2 FOR MOUNT REQUESTS
DDSMC1: CALL NSTRSB ;GET NEXT USER REQUEST
RET ;NONE LEFT
LOAD T1,RSBSTE ;GET STATE OF REQUEST
CAIE T1,RST.WM ;Is user waiting for mount?
JRST [CAIE T1,RST.WD ;No, is user waiting for dismount?
JRST DDSMC1 ;Neither, try next request
JRST .+1] ;Waiting for dismount
MOVE T1,RSBSTA(RSB) ;GET STRUCTURE ALIAS
CAME T1,STRALI(STR) ;IS IT SAME AS THIS ONE
JRST DDSMC1 ;NO, TRY NEXT REQUEST
SKIPN T1,RSBSTN(RSB) ;GET STRUCTURE NAME
JRST DDSMC2 ;NONE SPECIFIED. ALLOW THIS MOUNT
CAME T1,STRNAM(STR) ;IS THIS THE SAME AS CURRENT STR
JRST DDSMC1 ;NO, GET NEXT REQUEST
DDSMC2: MOVE T1,RSBIFL(RSB) ;GET INTERNAL FLAGS
XOR T1,Q1 ;ARE WE LOOKING AT RIGHT REQUEST TYPE
TXNE T1,R%DSM
JRST DDSMC1 ;NO
LOAD ACC,RSBACC ;GET ACC IF ANY ASSOCIATED.
JUMPE ACC,DDSMC3 ;NO ASSOCIATED ACC
SETZRO RSBACC ;DELINK ACC AND RSB
MOVEI T1,RSBSTA(RSB) ;POINT TO SIXBIT ALIAS
MOVE T2,[POINT 7,MSTAL] ;ASCII GOES HERE
CALL SIXSEV ;CONVERT ALIAS TO ASCII
HRROI T1,MSTAL ;POINT TO ASCII ALIAS
STDEV ;GET DEVICE DESIGNATOR
CALL STOP ;ERROR NO SUCH DEVICE?
JRST [ HLRZ T1,T2 ;GET LEFT HALF OF DESIGNATOR
CAIE T1,.DVDES+.DVDSK ;IS IT A DISK?
CALL STOP ;NOT A DISK?
MOVEM T2,ACCDD(ACC) ;SAVE IT FOR FNDACC.
JRST .+1 ]
DDSMC3: MOVX T1,R%OPR
TDNN T1,RSBIFL(RSB) ;DID OPERATOR REQUEST THIS?
CALL TELUSR ;NO, LET USER KNOW HE HAS STRUCTURE
ABTREQ (ABRTNR) ;ABORT RSB WITH NO REPLY TO USER
JRST DDSMC1
SUBTTL Update all disks -- DSTDDB - Delete STructure DDB
; Called only by STRDSM and STRDMS
; This routine deletes the structure DDB and sets the STR as dismounted.
; Accepts: STR / address of SSB
; Returns +1 always
DSTDDB: SKIPN T1,STRPNT(STR) ;Do we have DDB entry?
JRST DSTDD0 ;No, skip this
; Delete DDB entry and mark the structure as not mounted
CALL DSFGET ;Yes, go get it
SKIPA ;Shouldn't happen
CAME STR,DSFE+DSFPNT ;Does pointer match SSB address?
$STOP <Incorrect DDB pointer detected in SSB>
SETZM DSFE+DSFPNT ;Get rid of pointer
CALL DSFUDE ;Update entry
$STOP <Update of previously known DDB with DSFUDE failed>
SETZM STRPNT(STR) ;Clear pointer
DSTDD0: SETZRO STR%MT,STRFL1(STR) ;Clear structure mounted flag
RET
SUBTTL Disk Routines -- DSKINI - Disk initialization routine
;ACCEPTS: NOTHING
;RETURNS: +1, ALWAYS
DSKINI:
; Turn on interrupts for disk status changes
MOVEI T1,33 ;GET INTERRUPT CHANNEL FOR DISK
MOVEM T1,T3 ; STATUS CHANGE
MOVE T1,[1,,.MSOFL] ;TELL MONITOR TO INTERRUPT US IF
MOVEI T2,T3 ; THERE IS DISK CHANGE
SKIPN TSTF ;DON'T DO MSTR IF TESTING
MSTR
ERCAL STOP ;Should not fail
RET
SUBTTL Disk Routines -- DSTGIV - Get status for a given unit
; Called only by STRMNT
;DSTGIV - GET STATUS FOR GIVEN DISK UNIT
;ACCEPTS: DSK/ ADDRESS OF DISK STATUS BLOCK
;RETURNS: +1 ERROR, INVALID UNIT
; +2 SUCCESS, STATUS IN MSTRBK BLOCK
; T1 / Unit status returned by MSTR
DSTGIV: LOAD T1,DSKCTR,(DSK) ;GET CONTROLLER NUMBER
LOAD T2,DSKCHN,(DSK) ;GET CHANNEL NUMBER
LOAD T3,DSKDRV,(DSK) ;GET UNIT NUMBER
CAIN T1,<.RTJST(-1,DOP%K2)> ;ALL ONES?
SETO T1, ;YES, MAKE IT A FULL WORD
MOVEM T1,MSTRBK+.MSRCT
MOVEM T2,MSTRBK+.MSRCH
MOVEM T3,MSTRBK+.MSRUN ;STORE VALUES FOR MSTR JSYS
MOVE T1,[.MSRST+1,,.MSRUS] ;RETURN STATUS OF THE GIVEN UNIT
MOVEI T2,MSTRBK ;GIVE ADDRESS OF ARGUMENT BLOCK
MSTR
ERJMP R ;FAILURE RETURN
MOVE T1,MSTRBK+.MSRST ;Get flags
RETSKP
SUBTTL KSDK - Set disk-drive command from OPR
;KSDK - PROCESS SET DISK-DRIVE COMMAND FROM OPR
;*** NOTICE: THIS CANNOT HANDLE RP20'S UNTIL GALAXY REDEFINES
;*** THEIR ARGUMENT BLOCK TO INCLUDE CONTROLLER NUMBERS
;Local AC use
; Q1/New disk state. 1=unavailable 0=available
; Q2/CKU,,Channel
; Q3/
;RETURNS +1, ALWAYS
KSDK: SAVEQ
SAVEAC <DSK>
STKVAR <REASON>
; Check for valid arguments
MOVEI T1,.DSKDV
CALL ORNBLF ;DISK DRIVE SPECIFIED?
JRST KBADM ;NO
MOVE T2,0(T1) ;GET CHANNEL NUMBER
DPB T2,[POINTR Q2,DOP%C2] ;PUT INTO AC
MOVE T2,1(T1) ;Get controller number
DPB T2,[POINTR Q2,DOP%K2] ;Put into AC
MOVE T2,2(T1) ;GET DRIVE NUMBER
DPB T2,[POINTR Q2,DOP%U2] ;STORE ALSO
CALL DDSCIH ;MAKE SURE TABLES UP-TO-DATE
MOVE T1,Q2 ;COPY CKU NUMBER TO RIGHT AC
CALL DSTSRC ;FIND THIS DISK DRIVE
JRST [ TMCT <%ICommand ignored. Unknown %1K> ;NOT FOUND, COMPLAIN
MOVEI T3,TMCMSG
CALLRET BTACK] ;TELL OPERATOR NO SUCH DRIVE
; Q1 contains the state of the disk to be changed. unavailable=1 available=0
MOVEI Q1,1 ;ASSUME SETTING UNAVAILABLE
MOVEI T1,.DVUAV
CALL ORNBLF ;CHECK IF SETTING UNAVAILABLE
JRST [ MOVEI T1,.DVAVL ;NO
CALL ORNBLF ;SETTING AVAILABLE?
JRST KBADM ;NO
SOJA Q1,KSDK0] ;Yes, make Q1 zero and join common code
; We are setting the disk to unavailable, get the reason block
MOVEI T1,.ORREA
CALL ORNBLF ;REASON BLOCK PRESENT
JRST KBADM ;No, bad message
MOVEM T1,REASON ;Save the reason
; If a structure is mounted on this disk, set up to set the correct str bits
KSDK0: TMCT <%I>
MOVE T1,DSKFLG(DSK) ;GET DISK STATUS
TXNN T1,MS%MNT ;IS IT LOGICALLY MOUNTED?
JRST KSDK1 ;No, skip setup stuff for set structure status
LOAD STR,DSKSSA,(DSK) ;Get str status block address for disk drive
; Check to see if primary PS: is mounted on this disk
LOAD T1,MS%PPS,STRFLG(STR) ;Get the PS: bit
JUMPN T1,KSDKER ;Error if PS:
MOVEI T1,STRALI(STR) ;Get alias
MOVE T2,[POINT 7,MSTAL] ;Alias goes here
CALL SIXSEV ;Convert to asciz
SKIPE T1,STRPNT(STR) ;Get address of DDB
CALL DSFGET ;Get it
CALL STOP ;Not there, someone else must have mounted it
; We have a structure, now see if the status is consistent with monitor
CALL UPDSTR ;Update status
; Find the disk entry in DDB
KSDK1: MOVE T1,DSKPNT(DSK) ;Get the dsk pointer to DDB
CALL DSFGET ;Go look for it
CALL STOP ;Not there,SHOULDN'T HAPPEN
; T2 contains previous DSF%AV. on if unavailable, of if unavailable
LOAD T2,DSF%AV,DSFE+DSFFLG ;Load the available unavailable bit
CAMN Q1,T2 ;See if we have to change status?
JRST KSDKA ;No, no need to update DDB
STOR Q1,DSF%AV,DSFE+DSFFLG ;store the bit
MOVE T1,DSKPNT(DSK) ;Get pointer to DDB entry
CALL DSFUDE ;Go update
$STOP <Update of previously known DDB with DSFUDE failed>
MOVEM T1,DSKPNT(DSK) ;In case it is updated
; If Q1 is 0 log SYSERR for available else log for unavailable
JUMPE Q1,[MOVEI T1,CS%ADV ;GET CODE FOR ATTACH-DEVICE
SETZ T2, ;NO REASON
JRST KSDK2] ;Go log it
MOVEI T1,CS%DDV ;Get code for detach-device
MOVE T2,REASON ;Get adrress of ASCIZ reason
; SYSSET should be called after DDB has been updated
KSDK2: CALL SYMSET ;LOG SYSERR ENTRY FOR DRIVE SET UNAVAIL
CALL WOMDAV ;TELL ALL OPERATORS WHAT HAPPENED
; Check to see if a structure is mounted on this disk
MOVE T1,DSKFLG(DSK) ;GET DISK STATUS
TXNN T1,MS%MNT ;IS IT LOGICALLY MOUNTED?
RET ;NO
; Here we want to determine what we would like STRFLG to be. Compare that
; with the current STRFLG value. If they are equal, nothing to do but clean
; up and exit. If they are unequal, we would like to set the structure
; to the new value and then set STRFLG appropriatly. If we fail, analyze
; the error.
TMCT <%I >
MOVE T1,STRPNT(STR) ;Get address of DDB
CALL DSFGET ;Get it
CALL STOP ;Should not happen
CALL NEWSTA ;Determine a new proposed STRFLG
JFCL ;Do not care if unmounted
CAMN T1,STRFLG(STR) ;Is the proposed STRFLG anything new?
RET ;No. Done.
; Set the new strflg
CALL STSTR ;Try to set the new strflg
SKIPA ;Error need to do some more
JRST KSDK4 ;All done.
; Failed to set the new strflg characteristics. T1 contains the attempt.
MOVE T2,STRALI(STR) ;Get structure alias
TMCT <Unable to change structure %2S: status as part of disk operation>
JRST KSDK5 ;Send the message
KSDK4: MOVE T2,STRALI(STR) ;Get structure alias
JUMPN Q1,[TMCT <Structure %2S: UNAVAILABLE due to disk operation>
JRST KSDK5]
TMCT <Structure %2S: is AVAILABLE due to disk operation>
KSDK5: MOVEI T3,[ASCIZ/Structure status changed due to disk operation/]
CALLRET BTWTO
; Exit routine for setting a disk that already has that characteristic.
KSDKA: MOVE T1,[[ASCIZ/Available/]
[ASCIZ/Unavailable/]](Q1) ;GET TEXT POINTER
MOVE T2,DSKCKU(DSK) ;GET UNIT ADDRESS
TMCT <%I%2K Is Already Set %1A>
MOVEI T3,TMCMSG
CALLRET BTACK ;TELL OPRTR COMMAND HAS NO EFFECT
; Exit routine for trying to set a disk drive with PS: mounted on it
KSDKER: MOVEI T1,DSKPS ;Get error message
TMCT <%8C%1A>
MOVEI T3,[ASCIZ/Set disk drive command failed/]
CALL BTNFO ;Ask for no formatting
CALLRET BTACKT ;TELL OPRTR COMMAND HAS NO EFFECT
SUBTTL KDSM - PROCESS DISMOUNT STRUCTURE COMMAND FROM OPR
;RBUF/
;RETURNS +1, ALWAYS
KDSM: CALL DDSCIH ;MAKE SURE TABLES UP-TO-DATE
MOVEI T1,.DSMST ;GET RSB TYPE
CALL OPRSB ;SET UP RSB FOR THIS OPR REQUEST
JRST KNORSB ;[6011]No RSB available
MOVX T2,R%RNR ;Get the bit
MOVE T1,RBUF+.OFLAG ;Get the REMOVE/NOREMOVE bit
TXNE T1,.DMNRV ;Noremove specified ?
JRST KDSM.1 ;Do not have to set the bit
TXNE T1,.DMRMV ;Remove specified ?
JRST [ IORM T2,RSBIFL(RSB) ;Yes, set it
JRST KDSM.1] ;Skip default
CALL CFSCHK ;Check on CFS status
SKIPA ;Not cfs
JRST KDSM.1 ;CFS system, default to NOREMOVE
MOVX T1,R%RNR ;Get the bit
IORM T1,RSBIFL(RSB) ;Set it
KDSM.1: MOVX T1,R%DSM ;GET DISMOUNT FLAG
IORM T1,RSBIFL(RSB) ;AND SET INTO RSB
SETZM RSBSTN(RSB) ;ZERO STRUCTURE NAME FOR MATCHS
MOVEI T1,RST.WD
STOR T1,RSBSTE ;SET STATE TO WAITING FOR DISMOUNT
MOVE T1,RSBSTA(RSB) ;GET STRUCTURE ALIAS
MOVE T2,RSBSTN(RSB) ;GET STRUCTURE NAME
SETZ T4, ;No unique code
CALL MATCHS ;MATCH REQUEST TO STRUCTURE
JRST KDSM.2 ;[6011]Structure not mounted. nothing to do.
STOR STR,RSBSS ;STORE THE STRUCTURE ADDR INTO RSB
SKIPG STR ;IS STRUCTURE MOUNTED?
IFSKP.
SKIPN T1,RSBOBN(RSB) ;[6016]Get node name
IFSKP.
MOVEM T1,STROBN(STR) ;[6011]Save it
SETONE STR%OB,STRFL1(STR) ;[6011]Set bit in STRFL1
ENDIF.
MOVEI T1,RSBSTA(RSB) ;YES, DISMOUNT IT
MOVE T2,[POINT 7,MSTAL]
CALL SIXSEV
CALLRET STRDMT ;Dismount the structure
ENDIF.
KDSM.2: CALL NSACK ;[6011]Tell Nebula or not
MOVE T2,RSBSTA(RSB) ;Get the name
TMCT <%IStructure %2S: is not mounted%_> ;Build common message
MOVEI T3,[ASCIZ/Dismount Structure Status/] ;Default case
LOAD T1,R%LOR,RSBIFL(RSB) ;[6011]Get the status bit
SKIPE T1 ;[6011]Local request, use local header
KDSM.3: MOVEI T3,[ASCIZ/Remote Dismount Structure Status/] ;Else use remote
KDSM.4: CALL BTWTO ;Tell the operator
ABTRET (ABRTNR) ;Delete RSB and return
;[6011]
;Error routine for KDSM when MOUNTR runs out of RSBs. It will inform the
;operator of the error. If the request is remote then a DISMOUNT
;ACK (failure ACK) is sent to NEBULA via ORION. The content of AC RSB will
;determine whether the error is no RSB or somthing else.
;RSB/1 no RSB.
;RBUF/MESSAGE
KNORSB: CAIE RSB,1 ;[6014]We have a RSB
RET ;[6011]No, just return
MOVE T2,RBUF+.MSFLG ;[6011]Get the Galaxy flag word
TXNE T2,MF.NEB ;[6011]Remote or local
TXNN T2,MF.WTO ;[6011]Direct or indirect request
JRST KNORS1 ;[6011]Local/Indirect no need to send ACK
MOVX T1,E%NRSB ;[6011]Error code
TXO T1,FA%MER ;[6011]MOUNTR error type
MOVE T2,RBUF+.MSCOD ;[6011]Remote ACK
CALL FAILE ;[6011]Remote, send failure
MOVEI T1,.STRDV ;[6011]Get block type code
CALL KGTSTR ;[6011]Get structure name
JRST KBADM ;[6011]Not there, reject message
MOVE T3,T1 ;[6011]Save the name
MOVEI T1,.NDENM ;[6011]Want node name
CALL ORNBLF ;[6011]Look for it in RBUF
JFCL ;[6011]None
MOVE T4,(T1) ;[6011]Get the node name
TMCT <%IInsufficient MOUNTR resources needed to dismount
structure%3S: for node %4S::%_>
MOVEI T3,[ASCIZ/Remote Dismount Structure Failed/]
CALLRET BTWTO ;[6011]Tell the operator
KNORS1: TMCT <%IInsufficient MOUNTR resources needed to dismount
structure%3S:>
MOVEI T3,[ASCIZ/Dismount Structure Failed/] ;
CALLRET BTWTO ;[6011]Tell the operator
;[6011]
;MOUNTR must send a dismount ACK back to Nebula for a remote dismount
;Checks R%LOR for local or remote request.
;If the request is a remote request then this routine will check bit R%STA
;in RSBIFL and send a success or failure dismount ACK back to Nebula.
;RSB/ request status block
NSACK: MOVE T1,RSBIFL(RSB) ;[6031]Get the status
TXNN T1,R%LOR ;[6031]Local request?
RET ;[6031]Yes, no need to tell NEBULA
MOVE T2,RSBRAC(RSB) ;[6011]Get remote ACK
TXNN T1,R%STA ;[6011]Success or failure?
IFNSK.
CALL SUCCE ;[6011]Success
ELSE.
MOVE T1,RSBERR(RSB) ;[6011]Get error type,, error code
CALL FAILE ;[6011]Fail
ENDIF.
RET
;SUCCE builds the success ACK
;Accepts T2/ACK code
SUCCE: MOVE T1,[.OARGC+1,,.NFDAK] ;[6011]BUILD GALAXY HEADER
MOVE T3,T2 ;[6011]ACK code
MOVX T2,MF.NEB ;[6011]Nebula message
CALL GALHDR ;[6011]Build the Galaxy header
SETONE SU%NOE,TBUF+.OFLAG ;[6011]Set the success bit
SETZM TBUF+.OARGC ;[6011]NO ARGUMENTS
MOVEI T1,.APORN ;[6011]MESSAGE GOING TO ORION
CALLRET TRANG ;[6011]SEND CANCEL REQUEST TO ORION
;FAILE builds the failure ACK
;Accepts T1/error type,,error code
; T2/ACK Code
;Returns +1 always
FAILE: CALL PBINIT ;[6011]Set up for creating building blocks
MOVE T3,T2 ;[6011]Ack code in T3
HRRZM T1,T2 ;[6011]Save error code for later
HLLM T1,TBUF+.OFLAG ;[6031]Error indicator goes here
MOVE T1,[.ERRSZ,,.ERRBK] ;[6011]length,, error block
DMOVEM T1,TEMPX ;[6011]Goes here
MOVE T1,[.OARGC+3,,.NFDAK] ;[6011]BUILD GALAXY HEADER
MOVX T2,MF.NEB ;[6011]Nebula message
CALL GALHDR ;[6011]Build the Galaxy header
MOVEI T1,TEMPX ;[6011]Address of .ERRBK
CALL PBBLK ;[6011]Add it
MOVEI T1,1
MOVEM T1,TBUF+.OARGC ;[6011]for this message
MOVEI T1,.APORN ;[6011]MESSAGE GOING TO ORION
CALLRET TRANG ;[6011]SEND CANCEL REQUEST TO ORION
E%NRSB==1B0
E%BADM==1B1
MTRERR: [ASCIZ/Insufficient MOUNTR resources/]
[ASCIZ/Bad IPCF message/]
SUBTTL KSCD - SHOW CONFIGURATION DISK-DRIVE COMMAND FROM OPR
;RETURN: +1, ALWAYS
KSCD: SETOM CFGFLG ;Set CONFIG command flag
CALLRET KSHD ;Use SHOW STATUS DISK code checking for flag
SUBTTL KSHD - SHOW DISK STATUS COMMAND FROM OPR
;RETURN: +1, ALWAYS
KSHD: SAVEQ
SETZM DSPFLG ;Start of clean, no special messages yet
CALL DDSCIH ;MAKE SURE TABLES UP-TO-DATE
TMCT <%I>
; Q3 is a flag which indicates the kind of display
; -1=all disk drives. 0=free disk drives. 1=mounted disk drives.
SETO Q3, ;Say it is for all drives, for now
MOVE Q1,RBUF+.OFLAG ;GET COMMAND TYPE
CAMN Q1,[ST.MNT] ;IS IT ASKING FOR MOUNTED DISKS?
JRST [CALL KSHDM ;Yes, print the mounted header
MOVEI Q3,1 ;Say it is for mounted drives
JRST KSHDA] ;Go join common stuff for STATUS
CAMN Q1,[ST.AVA] ;WERE WE ASKED ONLY FOR FREE DRIVES?
JRST [CALL KSHDF ;Yes, print the free header
SETZ Q3, ;Say it is for free drives
JRST KSHDA] ;Go join common stuff for STATUS
KSHDA: MOVEI T1,DSKHDR ;Get common header for STATUS
SKIPE CFGFLG ;Unless it is from CONFIG...
MOVEI T1,CFGHDR ;Get common header for CONFIG
TMCT <%1A>
; Loop through all disk drives in DDB
KSHDA1: MOVEI T1,.DVDSK ;Get the disk type
MOVEM T1,DSFE+DSFTYP ;Save it in DSFE
SETZ T1, ;Go for the first
KSHDA2: CALL DSFGNX ;Go get an entry
JRST KSHDE ;No more, go do mounted disk if needed
PUSH P,T1 ;Save pointer
SKIPN DSK,DSFE+DSFPNT ;Get disk status block address
JRST KSHDA4 ;Not there, not in use, skip this entry
LOAD T1,MS%MNT,DSKFLG(DSK) ;Get mount bit
SKIPN T1 ;Is it mounted?
JRST [SKIPG Q3 ;No, are we asking for mounted drives only?
CALL WOFRE ;No, display the unit's status.
JRST KSHDA4] ;Get the next disk drive.
SKIPE Q3 ;Are we asking for free drives?
CALL WOMNT ;No
; Before we get the next disk make sure that DSFE contains the correct type
KSHDA4: MOVEI T1,.DVDSK ;Get the disk type
MOVEM T1,DSFE+DSFTYP ;Save it in DSFE
POP P,T1 ;Get the pointer back
JRST KSHDA2 ;Get the next
KSHDE: CALL DSKDSP ;Print any special messages
KSHDEX: MOVEI T3,[ASCIZ/Disk Drive Status/]
SKIPE CFGFLG
MOVEI T3,[ASCIZ/Disk Drive Configuration/]
SETZM CFGFLG ;Re-set CONFIG command flag
CALL BTNFO ;ASK FOR NO FORMATTING
MOVE T4,RBUF+.MSFLG ;[6010]Get the message flag word
TXNE T4,MF.NEB ;[6010]From NEBULA
SETOM NEBMSG ;[6010]Yes
CALLRET BTACKT ;END OF DISKS, SEND STATUS TO OPR
KSHDM: MOVEI T1,MNTHDR ;Get header for mounted drives
SKIPA ;Only wanted mounted header
KSHDF: MOVEI T1,FREHDR ;GET HEADER FOR MOUNTED DRIVES
TMCT <%1A>
RET
SUBTTL - DSKDSP - Print any special messages
;Accepts - Nothing
;Returns +1 always
DSKDSP::MOVE T1,DSPFLG ;Get the display message flag
TXNN T1,MSG%AN ;Any disk to print
JRST [TMCT <%I%15CCurrently there are no free disk drives%_>
JRST DSKDEX] ;No
TXNE T1,MSG%CI ;Any channel 7 CI disks?;
CALL [TMCT <%7CNOTE: Channel 7 indicates CI channel%_>
RET]
TXNE T1,MSG%DU ;Any dual ported disks
CALL [TMCT <%7C(*) indicates potential external port%_>
RET]
TXNE T1,MSG%FR ;Any free drives
CALL [TMCTI <FREEH>
RET]
DSKDEX: RET
SUBTTL KSHS - SHOW STATUS STRUCTURE command from OPR
; Returns: +1 always
KSHS: SAVEQ
CALL DDSCIH ;First go update things
SETZM DSPFLG ;Clear display flags
TMCT <%I>
MOVEI T1,.STRDV ;GET BLOCK TYPE CODE
CALL KGTSTR ;GET STRUCTURE NAME
SKIPA ;Not there, go do all purpose display
JRST SHSTR ;Go display the particular structure and skip
; this stuff
; Q3 is a flag which indicates the kind of display
; -1=all disk drives. 0=free disk drives. 1=mounted disk drives.
SETO Q3, ;Say it is for all drives, for now
MOVE Q1,RBUF+.OFLAG ;GET COMMAND TYPE
CAMN Q1,[ST.MNT] ;IS IT ASKING FOR MOUNTED DISKS?
JRST [CALL KSHSM ;Yes, print the mounted header
MOVEI Q3,1 ;Say it is for mounted structure
JRST KSHSA] ;Go join common stuff
CAMN Q1,[ST.AVA] ;WERE WE ASKED ONLY FOR FREE DRIVES?
JRST [CALL KSHSF ;Yes, print the free header
SETZ Q3, ;Say it is for dismounted structure
JRST KSHSA] ;Go to join common code
KSHSA: MOVEI T1,STRHDR
TMCT <%1A>
SETZ T1, ;Go for the first one
MOVEI T2,.DVSTR ;Get structure type
MOVEM T2,DSFE+DSFTYP ;Set it
KSHS.0: CALL DSFGNX ;Go get an entry
JRST KSHS.9 ;Done
PUSH P,T1 ;Save the pointer
; What do we want to print out
SKIPN STR,DSFE+DSFPNT ;Structure mounted?
JRST [SKIPG Q3 ;No, are we asking for mounted drives only?
CALL SHWSTR ;No, display the unit's status.
JRST KSHS8] ;Yes, get the next
SKIPE Q3 ;Yes, Can this drive be printed
CALL SHWSTR ;Yes, output structure status
KSHS8: MOVEI T2,.DVSTR ;Get structure type
MOVEM T2,DSFE+DSFTYP ;Set it
POP P,T1 ;Get back the pointer
JRST KSHS.0 ;Go for another
KSHS.9: CALL STRDSP ;Go print any special messages
KSHSEX: MOVEI T3,[ASCIZ/Structure Status/]
CALL BTNFO ;No formatting
MOVE T4,RBUF+.MSFLG ;[6010]Get the message flag word
TXNE T4,MF.NEB ;[6010]From NEBULA
SETOM NEBMSG ;[6010]Yes
CALL BTACKT ;Send status
RET ;And done
SUBTTL STRDSP - Print any special messages
;Accepts - nothing
STRDSP: MOVE T1,DSPFLG ;Get the display message flag
TXNN T1,MSG%AN ;Any disk to print
JRST [TMCT <%I%15CCurrently there are no unmounted structures%_>
JRST STRDEX] ;No
TXNE T1,MSG%CO ;Conflict messge?
CALL [MOVEI T2,CONFLI ;Get the message
TMCT <%2C%2A> ;Print it
RET]
STRDEX: RET
SUBTTL SHSTR - Show status for a particular structure
;Accepts - T1/Structure name in sixbit
; - T2 and T3/Structure name in ASCIZ
SHSTR: SAVEQ
DMOVEM T2,MSTAL ;Save the ASCIZ structure name
MOVEM T1,DSFE+DSFSPC ;Save the SIXBIT structure name
MOVEI T1,.DVSTR ;Get structure type
MOVEM T1,DSFE+DSFTYP
CALL DSFLOC
JRST [MOVEI T1,MSTAL ;No entry, must not be mounted
TMCT <%20CNo such Structure %1A:%_>
JRST SHEX] ;Go to common exit
; Print the structure information on this structure
MOVEI T1,STRHDR ;Get all purpose header
TMCT <%1A> ;Add it to display
CALL SHWSTR ;Print structure information first
CALL STRDSP ;Go print any special messages
; Print the disk information on this structure
JUMPE STR,[TMCT <%_Structure is not mounted on a disk drive%_>
JRST SHEX] ;If structure is not mounted, all done
CALL [TMCT <%_%10CDisk information pertaining to mounted structure>
RET]
MOVEI T1,DSKHDR ;Get all purpose disk header
TMCT <%1A> ;Add it to the display
; Loop through all the disks on which this structure is mounted on.
LOAD Q3,STRUNI,(STR) ;Get the number of units
MOVNS Q3 ;Negate number of units
MOVSS Q3 ;And switch halves
HRRI Q3,STRADD(STR) ;Setup address of first disk status block
SHS.0: MOVE DSK,(Q3) ;Get the disk address
JUMPE DSK,SHS.01 ;No DSB, try next
MOVE T1,DSKFLG(DSK) ;Get the status of the disk
TXNE T1,MS%MNT ;Is it mounted?
JRST [CALL WOMNT ;Yes, display the unit's status.
JRST SHS.01] ;Get the next.
CALL WOFRE ;No, display the unit's status.
SHS.01: AOBJN Q3,SHS.0 ;Get the next disk
SHS.02: CALL DSKDSP ;Print any special messages
JUMPLE STR,SHEX ;Structure is not mounted
; Get list of users on structure
MOVE T1,[POINT 7,MSTAL]
MOVEM T1,MSTRBK+.MSUAL ;Put alias in mstr block
MOVX T1,MS%GTA+MS%GTM+MS%GTC ;We want all users
MOVEM T1,MSTRBK+.MSUFL ;Put it in mstr block
MOVE T1,[50,,.MSGSU] ;
MOVEI T2,MSTRBK
MSTR
ERJMP SHSERR
HRRZ Q1,MSTRBK+.MSUFL ;Get number of users currently using this str
JUMPE Q1,[TMCT <There are currently no users using this structure%_>
JRST SHEX] ;No users all done
; Initialize some things
SETZM USRLST
MOVE T1,[USRLST,,USRLST+1] ;Zero out the user list
BLT T1,USRLST+USRSIZ-1
MOVEI Q3,USRLST+1 ;Get the beginning of the user list
MOVEI Q2,MSTRBK+.MSUJ1 ;Get the address of first user
; Get ready to do GETJI and add users on to the list.
SHS.1: HRRZ T1,(Q2) ;Get the job number
MOVE T2,[-1,T4] ;Lets save the job user number in T4
MOVEI T3,.JIUNO ;We only want the job user number
GETJI
ERJMP SHSERR
MOVEI T1,1 ;Looking at the first user entry
MOVEI T3,1 ;Use T3 as an index to the current user list
; Loop through user list to see if user already exist.
SHS.2: CAMLE T1,USRLST ;Are we at the end of the list
JRST SHS.3 ;Yes
CAMN T4,USRLST+USRNUM(T3) ;Is it in the table?
JRST SHS.4 ;Yes, get the next
AOS T1 ;Increment counter
ADDI T3,USRENT ;Go to the next entry
JRST SHS.2
; User is not on list, add user
SHS.3: HLLZ T2,(Q2) ;Get the mounted/connected/access bit
MOVEM T2,USRBIT(Q3) ;Save it in the first word
MOVEM T4,USRNUM(Q3) ;Save the job user number in the second word
ADDI Q3,USRENT ;Now the next entry
AOS USRLST ;One more user using this structure
JRST SHS.5 ;Next
; Same user but is it the same usage
SHS.4: LOAD T2,MS%GTM,(Q2) ;Get the mounted bit
SKIPE T2 ;Not mounted
STOR T2,MS%GTM,USRLST+USRBIT(T3) ;Mounted, include it for this user
LOAD T2,MS%GTC,(Q2) ;Get the connected bit
SKIPE T2 ;Not connected
STOR T2,MS%GTC,USRLST+USRBIT(T3) ;Connected, include it for this user
LOAD T2,MS%GTA,(Q2) ;Get the connected bit
SKIPE T2 ;Not access
STOR T2,MS%GTA,USRLST+USRBIT(T3) ;Access, include it for this user
SHS.5: AOS Q2 ;Point to the next user
SOJG Q1,SHS.1 ;Jump if more
; Check each user to see what their usages are.
TMCT <%_Users who have MOUNTed this structure:%_>
MOVX T3,MS%GTM ;Show users who have mounted this structure
CALL SHSMAC ;Add users to message
CALL [TMCT <None.%_>
RET]
TMCT <%_Users who are ACCESSing this structure:%_>
MOVX T3,MS%GTA ;Show users who are connected to this structure
CALL SHSMAC ;Add users to message
CALL [TMCT <None.%_>
RET]
TMCT <%_Users who are CONNECTed to this structure:%_>
MOVX T3,MS%GTC ;Show users who are connected to this structure
CALL SHSMAC ;Add users to message
CALL [TMCT <None.%_>
RET]
SHEX: JRST KSHSEX ;All done
; Error routine for JSYS when doing SHSTR
;**;[6034]At SHSERR:+0L add 1 line JYSW 11-Aug-88
SHSERR: CALL CHECKD ;[6034]CHECKD has anything to do with this
TMCT <%_Can't determine users using this structure because of the following error: %_%J>
JRST SHEX ;Go to common exit
SUBTTL SHSMAC - Adds a user who has mounted or connected or accessing a structure to the SHO STA STR FOO: command.
;Accepts - T3/Usage bit (MS%GMT,MS%GTA,MS%GTC)
;Returns - +1 No users
; - +2 with users added on to display
SHSMAC: MOVE Q2,USRLST ;Get the number of users using this structure
MOVEI Q3,USRLST+1 ;Get the address of user list
SETO T4, ;Flag to indicate whether we have a user
SHSM.1: HLLZ T2,USRBIT(Q3) ;Get the user's usage of structure.
AND T2,T3 ;Get the bit that we are interested in
SKIPN T2 ;If set, user belongs to this list
JRST SHSM.6 ;User does not belong to this list
MOVE T2,USRNUM(Q3) ;Get the job user number
HRROI T1,DIRNAM ;Put the string here
DIRST
ERJMP SHSMEX
CALL TMCNT ;Get the current location in the line
MOVE Q1,[POINT 7,DIRNAM] ;Pointer to user name
SHSM.2: ILDB T1,Q1 ;Get the character
SKIPN T1 ;End of string
JRST SHSM.3 ;Yes, all done
AOS T2 ;Add another character
JRST SHSM.2 ;Get the next character
SHSM.3: MOVEI T1,DIRNAM ;Get the user name
CAIL T2,^D78 ;Can we add it to this line (78 , and space)
JRST [TMCT <,%_%1A> ;No, start at new line
JRST SHSM.6] ;and continue
SKIPE T4 ;The first user?
JRST [TMCT <%1A> ;Yes
SETZ T4, ;Say we have at least one user therefore
JRST SHSM.6] ; The next user should have a , and a space
TMCT <, %1A> ;No, lets add a comma and a space to message
SHSM.6: ADDI Q3,USRENT ;Point to the next user
SOJG Q2,SHSM.1 ;If we have more
SHSMEX: SKIPE T4 ;Do we have at least one user?
RET ;No
TMCT <.%_> ;Finish off the line
RETSKP ;We have at least one user
SUBTTL SHWSTR - Show status for a single structure
; Accepts: DSFE containing DDB for structure
SHWSTR: SAVEQ
; Q2 contains the structure status from DDB
MOVE Q2,DSFE+DSFFLG ;Save the status flag
MOVX T2,MSG%AN ;Get bit to say we have at least one
IORM T2,DSPFLG ;Say we have one
MOVE T1,DSFE+DSFSPC ;Get the alias
TMCT <%1S >
SKIPN STR,DSFE+DSFPNT ;Do we have SSB?
JRST SHW0 ;No, continue
MOVE T1,STRNAM(STR) ;Get name
TMCT <%8C%1S >
JRST SHW0.1 ;skip this if DDB has a SSB
; Structure might have SSB but no DDB link.
SHW0: SETZ T2, ;Don't have structure name. T1 has the alias
SETZ T4, ;Don't have unique code
CALL MATCHS ;Do we have a SSB for this structure
JFCL ;No, STR should be zero
; If STR/0 structure is not mounted, STR/less than 0 means structure is
; spinning or being dismounted, STR/ greater than 0 means mounted.
SHW0.1: SKIPG STR ;Again do we have SSB?
JRST SHW1 ;No, not mounted
MOVE Q1,STRFL1(STR) ;Get flags
TXNN Q1,STR%MT ;Mounted?
JRST SHW1 ;No, not mounted
TMCT <%15CMounted >
; Print the mount count
MOVE T2,[POINT 7,MSTAL];SET UP POINTER FOR ALIAS
MOVEI T1,STRALI(STR)
CALL SIXSEV ;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
MOVEI T1,MSTAL ;Get address of alias
CALL STRSTT ;Go get the status
;**;[6034]At SHW0.1:+13L change 1 line JYCW 11-Aug-88
JRST SHWSE1 ;[6034]NO STRUCTURE?
TMCT <%24C%3D> ;Print the mount count
; Open file count field
TMCT <%30C%4D> ;Print the open file count
SHW1: TMCT <%35C>
SKIPG STR ;Mounted?
JRST SHW2 ;No, no need to check for conflicting status
CALL NEWSTA ;Get the real status
JFCL ;Shouldn't really happen
XOR T1,STRFLG(STR) ;Get the changed bits
; T1 contains the conflicting bits if structure is mounted, else there is no
; check for conflict.
TXZ T1,MS%NTC ;Get rid of don't care bits
SHW2: TXNE Q2,DSF%IG ;Ignored for real?
JRST [TMCT <Ignored> ;Assume ignored
JRST SHW3] ;Skip avail/unavailable
TXNE Q2,DSF%AV ;Unavailable for real?
JRST [TMCT <Unavail> ;Assumption
JRST SHW2.1]
TMCT <Avail> ;No
SHW2.1: SKIPG STR ;Mounted?
JRST SHW3 ;No
TXNE T1,MS%DIS ;Is the available/unavailable bit in conflict?
CALL SHWCON ;Yes print * and set bit in display flag word
SHW3: TXNE Q2,DSF%EX ;Exclusive for real?
JRST [TMCT <%44CExclusive> ;Assume exclusive
JRST SHW3.1]
TMCT <%44CShared>
SHW3.1: SKIPG STR ;Mounted?
JRST SHW3.2 ;No
TXNE T1,MS%EXC ;Is the exclusive/shared bit in conflict?
CALL SHWCON ;Yes print * and set bit in display flag word
SHW3.2: SKIPG STR ;Mounted?
JRST SHW3.3 ;No
MOVE T2,STRFLG(STR) ;Get flags
TXNN T2,MS%PS!MS%BS ;[6001]Is either bit lit?
JRST SHW3.3 ;[6001]No.
TXNE T2,MS%PS ;[6001]At least one lit. Is MS%PS lit
TXNN T2,MS%BS ;[6001] along with MS%BS?
IFSKP. ;[6001]If both are lit...
TMCT <%55C## Primary Public Str. ##> ;[6001]Both. Old message
ELSE. ;[6001]If only one..
TXNN T2,MS%PS ;[6001]Is MS%PS lit?
IFSKP. ;[6001]If yes...
TMCT <%55C## Login Structure ##> ;[6001]Login Structure
ELSE. ;[6001]Then must be MS%BS
TMCT <%55C## Boot Structure ##> ;[6001]Boot structure
ENDIF. ;[6001]
ENDIF. ;[6001]
JRST SHW4 ;[6001]Go to common exit
SHW3.3: TXNE Q2,DSF%DO ;Domestic for real?
JRST [TMCT <%55CDomestic> ;Assume domestic
JRST SHW3.4]
TMCT <%55CForeign>
SHW3.4: SKIPG STR ;Mounted?
JRST SHW3.5 ;No, no need to check for conflict
TXNE T1,MS%DOM ;Is the domestic/foreign bit in conflict?
CALL SHWCON ;Yes print * and set bit in display flag word
SHW3.5: TXNE Q2,DSF%RG ;Regulated for real?
JRST [TMCT <%65CUnregulated> ;Assume regulated
JRST SHW3.6]
TMCT <%65CRegulated>
SHW3.6: SKIPG STR ;Mounted?
JRST SHW4 ;No
TXNE T1,MS%NRS ;Is the regulated/unregulated bit in conflict?
CALL SHWCON ;Yes print * and set bit in display flag word
; Before we check for disk status, make sure there is a SSB
SHW4: TMCT <%_> ;End the line
TXNE Q2,DSF%DP ;[6007]DUMPABLE?
CALL [TMCT <%4CStructure is Dumpable%_> ;[6007]Yes
RET] ;[6007]
JUMPE STR,SHWSEX ;No SSB means all done
MOVE Q1,STRFL1(STR) ;Get mount state
TXNE Q1,STR%DT ;Is structure being dismounted
CALL [MOVE T1,STRALI(STR) ;Get the alias
TMCT <%4CCan't use structure %1S: - structure being dismounted%_>
RET]
TXNE Q1,STR%UD ;[335]Is structure unavail due to dismount?
TMCT <%4CStructure is set unavailable due to dismount%_> ;[335]
TXNE Q1,STR%EP ;[335]Is str exclusive due to port operation?
TMCT <%4CStructure is exclusive due to port operation%_> ;[335]
TXNE Q1,STR%OB ;[6011]Dismount on behalf of another node?
CALL [MOVE T1,STROBN(STR) ;[6011]Get "on behalf node name"
TMCT <%4CStructure is dismounted on behalf of %1S::%_>
RET]
MOVE T1,STR ;Get the SSB address
CALL CHKAVA ;Is the disk available/unavailable
CALL [SKIPN T1,STRALI(STR) ;Structure might not be mounted
MOVE T1,STRNAM(STR) ;Use structure name
TMCT <%4CCan't use structure %1S: - drive is unavailable for system use%_>
RET]
MOVE T1,STRFLG(STR) ;[6006]Get the structure flag
TXNE T1,MS%OFS ;[6006]Offline due to outstanding IORB?
CALL [MOVE T1,STRALI(STR) ;[6006]Get the alias
TMCT <%4CCan't use structure %1S: - structure is offline%_>
RET]
SHWSEX:
RET
;**;[6034]At SHWSEX:+2L add routine SHWSE1:
SHWSE1: CALL CHECKD ;[6034]Is it mounted by CHECKD
JRST SHW1 ;[6034]No, go back and finish display
HLRZ T1,T3 ;[6034]Get the job #
MOVEI T2,DEVX2 ;[6034]Yes, get correct error code
TMCT <%4C * %2J, Job %1O *> ;[6034]
RET ;[6034]All done
SUBTTL - SHWCON -- Indicates structure status conflicts
;Accepts nothing
;Returns +1 always
SHWCON: SAVET
TMCT <*> ;Yes
MOVX T1,MSG%CO ;Get the CONFLICT MESSAGE BIT
IORM T1,DSPFLG ;Set it so it can be printed
RET
; Routine to print the correct header
KSHSM: MOVEI T1,MNTSTR ;Get the mounted structure header
SKIPA ;We want mounted header not free header
KSHSF: MOVEI T1,FRESTR ;Get the free structure header
TMCT <%1A>
RET
SUBTTL Process set structure (KSST) -- Initialize processing of command
;ACCEPTS: MRPDB, RBUF/ PDB AND MESSAGE FROM OPR
; +1, ALWAYS
KSST:
; Do some initial validation
CALL DDSCIH ;MAKE SURE TABLES UP TO DATE
MOVEI T1,.STRDV ;GET BLOCK TYPE CODE
CALL KGTSTR ;GET STRUCTURE NAME
JRST KBADM ;NOT THERE, REJECT MESSAGE
; wrong routine, calling BADOM probably better
MOVEM T1,DSFE+DSFSPC ;Save the sixbit structure name
DMOVEM T2,MSTAL ;STORE ASCII STRUCTURE NAME
MOVEI T1,.STCHR
CALL ORNBLF ;WAS A CHARACTERISTIC SPECIFIED?
JRST KBADM ;NO, REJECT MESSAGE
MOVE Q3,(T1) ;Save the characteristic for later
; Lets see what we have in the DDB for this structure
MOVE T1,DSFE+DSFSPC ;Get the alias back
CALL ISTDDB ;Go try to create DDB entry based on alias
JFCL ;What a suprise, we already have it!
; DSFE now contains the correct stuff
MOVE Q1,T1 ;Save the pointer to the DDB for later
; Update status of structure if needed
CALL UPDSTR ;Go do it
; Find the characteristic.
HRLZI Q2,-CHRTL ;Form index into CHRTBL
KSST.1: HLRZ T1,CHRTBL(Q2) ;Get characteristic
CAMN Q3,T1 ;Found characteristic?
JRST KSST.2 ;Yes, go process characteristic
AOBJN Q2,KSST.1 ;No, go try next
JRST KBADM ;NO SUCH CHARACTERISTIC, REJECT MESSAGE
; wrong routine, calling BADOM probably better
; Continued on next page
SUBTTL Process set structure (KSST) -- Set the database (DDB)
; Continued from preceeding page
KSST.2: STKVAR <SAVPNT> ;[6011]Save DDB pointer
TMCT <%I > ;Initialize the operator message
; Found characteristic to be set. Check the attributes of the set with
; existing attributes.
MOVE T1,Q1 ;Get pointer to DDB
CALL DSFGET ;Get DDB
CALL STOP ;Should not happen
MOVEM T1,SAVPNT ;Save DDB pointer
HRRZ Q2,CHRTBL(Q2) ;Get address of attributes
MOVE T1,(Q2) ;Get the bit
AND T1,DSFE+DSFFLG ;Get rid of everything but the bit in question
HLRZ T2,1(Q2) ;Get on/off flag
SKIPE T1 ;Equal to zero?
MOVEI T1,1 ;No, bit is set
CAME T1,T2 ;Compare for both on or off
JRST KSST.3 ;Not equal, need to do some setting
; Here the characteristic is already correctly set in DDB.
; Add error message.
CAIE Q3,S.SHAR ;[6017]Shared?
IFSKP.
MOVE T1,DSFE+DSFFLG ;[6017]Get the flag word again
MOVEM T1,STRFL2(STR) ;[6017]Save IT
JRST KSST.S ;[6017]Yes, have to do some work
ENDIF. ;[6017]
MOVEI T1,MSTAL ;Get structure alias
HRRZ T2,1(Q2) ;Get ASCII attribute
TMCT <Structure %1A already set %2A%_>
JRST KSSEN1 ;Go and finish up
; Set new characteristic in DSFFLG, but don't write it back on disk until
; the characteristic is set.
KSST.3: MOVE T1,DSFE+DSFFLG ;Get the flag word again
SKIPE T2 ;Want to set the bit?
TDOA T1,(Q2) ;Yes, do it and skip next
TDZ T1,(Q2) ;No, clear the bit
MOVEM T1,DSFE+DSFFLG ;Put value back
; Continued from previous page
; Now want to determine the correct structure status block
TXNE T1,DSF%IG ;Is it IGNORED?
JRST [TMCT <Structure is currently set IGNORED.%_>
TMCT <Attributes will be applied when
structure is set to ACKNOWLEDGED.%_>
JRST KSSEND] ;Yes
SKIPG STR,DSFE+DSFPNT ;Do we have SSB?
JRST KSSEND ;No. Done.
MOVE T1,STRFL1(STR) ;Get other structure flags
TXNN T1,STR%MT ;Structure mounted?
JRST KSSEND ;No. Done.
MOVE T2,DSFE+DSFFLG ;[6011]Get value back
MOVEM T2,STRFL2(STR) ;[6011]Save IT
TXNN T1,STR%UD ;Structure unavailable due to dismount?
JRST KSST.6 ;No
; Structure is in the process of being dismounted
CAIN Q3,S.AVAL ;Setting available?
JRST KSSEN2 ;Yes, cannot do it right now
; Set the new strflg
KSST.6: CALL NEWSTA ;Get the proposed STRFLG
JRST KSST.4 ;Not mounted
CALL STSTR ;Try to set the new strflg
JRST KSSERR ;Failed. find out if it was set exclusive
JRST KSST.4 ;[6011]No
; Setting a structure from exclusive to shared
;tbd This might not ever happened
KSST.S: CALL UNSEXC ;Unlock the structure
;Get RSB
;[6011]
QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
KSST.7: CALL QMSCAN ;GET ADDRESS OF NEXT RSB
JRST KSST.4 ;No more all done
MOVEI RSB,-RSBLNK(T2) ;Load RSB ac
LOAD T1,RSBTYP ;Get type
CAIE T1,.DSEXC ;Exclusive
JRST KSST.7 ;No,, continue scan
MOVE T1,RSBSTA(RSB) ;Get the alias
CAME T1,STRALI(STR) ;Are they the same
JRST KSST.7 ;No, get the next
MOVE T1,RSBIFL(RSB) ;Get request status flag
MOVE T2,STRFL1(STR) ;Get structure status flag
TXNN T1,R%SDM ;Did this request send a remote dismount?
IFSKP. ;Yes,
TXNN T2,STR%LD ;Are there any pending dismount/remove request
CALL NEBCAN ;No, tell Nebula to cancel
ENDIF.
ABTREQ (ABRTNR) ;Delete RSB and return
KSST.4: MOVE T1,Q1 ;Get the pointer to the structure entry in DDB
CALL DSFGET ;Get the entry
$STOP <Structure entry not in DDB>
MOVE T1,STRFL2(STR) ;[6011]Get the new STRFLG
MOVEM T1,DSFE+DSFFLG ;Put it the status word
SUBTTL Process set structure (KSST) -- Set structure correctly in monitor
; All is done write DDB back on disk and tell operator of success.
KSSEND: MOVE T1,Q1 ;Get pointer to DDB back
CALL DSFUDE ;Update entry
$STOP <Update of previously known DDB with DSFUDE failed>
HRRZ T1,1(Q2) ;Get address of string indicating change
MOVEI T2,MSTAL
TMCT <Structure %2A: set %1A>
; Here we want to output messages.
KSSEN1: MOVEI T3,[ASCIZ/Set Structure Command/] ;Header line for message
CALL BTACKT ;Send the message we built with TMCT
RET
SUBTTL SET Structure EXCLUSIVE failure. Send remote dismount
;[6011]
; Failed to set the new strflg characteristics. T1 contains the attempt.
; Check to see if the failure was due to a SET EXCLUSIVE. If so, we have
; to send a remote dismount to all the systems that have the structure mounted
;
;Accepts T1/error type
KSSERR: CAIE T1,-1 ;Is the error exclusive?
JRST KSSER ;No
MOVEI T1,.DSEXC ;Set up exclusive switch request
CALL OPRSB ;Get RSB
JRST [TMCT <%IFailed to acquire RSB for exclusive procedure>
MOVEI T3,[ASCIZ/Set Structure Command/]
CALLRET BTACKT] ;Error abort
MOVE T1,RBUF+.MSCOD ;[6014]Get operator's PID
MOVEM T1,RSBPID(RSB) ;[6014]Save it for later
STOR STR,RSBSS ;[6011]Save SSB address in RSB
SKIPE ENQFLG ;[6011]Cluster ENQ enabled?
JRST KSSER ;No
KSSER1: CALL GETLOC ;[6011]Lock the structure
JRST [CALL WHOENQ ;[6011]Failed, find out who has it
JRST KSSER1 ;[6011]No one lets try again
MOVEI T3,[ASCIZ/Set Structure Command/]
CALLRET BTACKT] ;[6011]failed
MOVEI T1,KSSTEX ;[6011]Get continue address for success
MOVEM T1,RSBCON(RSB) ;[6011]Save it
MOVEI T1,KSSTAB ;[6014]Get continue address for abort
MOVEM T1,RSBABO(RSB) ;[6011]Save it
JRST SCREQ1 ;[6011]Failed get cfs compliance
;Upon receiving the dismount ACK, KSSTEX will setup MOUNTR in the correct
;context. DSFE must be setup with the correct structure DDB, Q1 must have
;the pointer to the DDB, Q2/EXCLUSIVE entry in CHRTBL, RBUF+.MSCOD contains
;the operator PID.
;Accepts RSB and STR
KSSTEX: TMCT <%I> ;[6014]Initialize TMCMSG
MOVE T1,RSBPID(RSB) ;[6014]Get the operator PID
MOVEM T1,RBUF+.MSCOD ;[6014]Save it
MOVE Q1,STRPNT(STR) ;[6014]Get address of DDB
SKIPE T1,Q1 ;[6014]Get address of DDB
CALL DSFGET ;Setup DSFE
JRST KSSTE1 ;[6014]Not here, must have been deleted
; Set up Q2 to contain CHRTBL attributes
HRR Q2,CHRTBL+3 ;[6014]Get the ASCIZ for EXCLUSIVE
;RSB,STR and DSFE must be setup
CALL NEWSTA ;Get status
JRST KSSTE1 ;[6014]Not mounted, clean up
TXO T1,MS%EXC ;[6014]Lite the EXCLUSIVE bit
CALL STSTR ;Try to set the new strflg
JRST [CAIN T1,-1 ;Failed. find out if it was set exclusive
CALLRET KSSER1 ;Yes, try again
JRST KSSER] ;[6014]No clean up
; Finaly, we set the structure exclusive.
CALL UNSEXC ;[6014]Unlock
HRR Q2,CHRTBL+3 ;[6014]Get the entry for EXCLUSIVE
JRST KSST.4 ;[6014]Go join common success exit
KSSTE1: CALL UNSEXC ;[6014]Unlock
JRST KSST.4 ;[6014]All done
KSSTAB: CALL UNSEXC ;[6014]Unlock
RET ;[6016]Just return
SUBTTL Error handler for SET EXCLUSIVE
KSSER: MOVEI T2,MSTAL ;Get the alias
HRRZ T3,1(Q2) ;Get the characteristic that failed
TMCT <Can't set structure %2A: %3A%_>
CALL GETERR ;Get the last error
TMCT <- error - %1J>
JRST KSSEN1 ;Go send the message
KSSEN2: TMCT <Dismounted currently in progress.%_>
HRRZ T1,1(Q2) ;Get address of string indicating change
TMCT <Structure attribute %1A will be applied
at completion of dismount.%_>
JRST KSST.4 ;[6014]Join common routine
SUBTTL KSST -- Data base for setable characteristics
COMMENT /
CHRTBL contains characteristic to be changed in the left half and address
of attributes in the right half. The first attribute is the bit in the
structure DDB flag word. The left half of the second word indicates whether
the bit is on or off. Finally the right half of the second attribute word
contains a pointer to the ASCIZ string describing the characteristic.
/
CHRTBL: S.ACKN,,[DSF%IG
0,,[ASCIZ/ACKNOWLEDGED/] ]
S.AVAL,,[DSF%AV
0,,[ASCIZ/AVAILABLE/] ]
S.DOMS,,[DSF%DO
1,,[ASCIZ/DOMESTIC/] ]
S.EXCL,,[DSF%EX
1,,[ASCIZ/EXCLUSIVE/] ]
S.FORN,,[DSF%DO
0,,[ASCIZ/FOREIGN/] ]
S.IGNO,,[DSF%IG
1,,[ASCIZ/IGNORED/] ]
S.REGU,,[DSF%RG
0,,[ASCIZ/REGULATED/] ]
S.SHAR,,[DSF%EX
0,,[ASCIZ/SHARED/] ]
S.UAVL,,[DSF%AV
1,,[ASCIZ/UNAVAILABLE/] ]
S.UREG,,[DSF%RG
1,,[ASCIZ/UNREGULATED/] ]
S.DUMP,,[DSF%DP ;[6002]
1,,[ASCIZ/DUMPABLE/] ] ;[6002]
S.NODP,,[DSF%DP ;[6002]
0,,[ASCIZ/NONDUMPABLE/] ] ;[6002][6003]
CHRTL==.-CHRTBL
;UNSEXC - Unlock structure due to reversing SET EXCLUSIVE
UNSEXC: MOVE T1,STRFL1(STR) ;[6011]Get flag
TXZN T1,STR%LE ;[6011]Is it locked for set exclusive?
IFSKP.
TXNN T1,STR%LD ;[6011]Yes, how about for dismount?
CALL RELLOC ;[6011]No, time to unlock
ENDIF.
MOVEM T1,STRFL1(STR) ;[6011]Restore flag
RET
;UNDREM - Call to only unlock a structure due to dismount/remove
UNDREM: LOAD T2,STRDLK,STRELC(STR) ;[6011]Get the # of locks for this structure
JUMPE T2,R ;[6014]No lock! just return
SOJG T2,UNDRE0 ;[6014]One less, any more dismount pending?
MOVE T1,STRFL1(STR) ;[6011]No, Get flag
TXZN T1,STR%LD ;[6011]Is it locked for dismount?
IFSKP.
TXNN T1,STR%LE ;[6011]Yes, how about for set exclusive?
CALL RELLOC ;[6011]No, time to unlock
ENDIF.
MOVEM T1,STRFL1(STR) ;[6011]Update the flag word
; no need to unlock because the are outstanding dismount/removals pending.
UNDRE0: STOR T2,STRDLK,STRELC(STR) ;[6011]Update lock counter
UNDRE1: RET
SUBTTL STSTR - SeT STRucture
; This routine sets the new structure characteristics based on T1.
; Accepts: T1 / New STRFLG value
; STR / Pointer to SSB.
; MSTAL / Two words containing structure name in ASCII
; Uses: MSTRST for the MSTRs needed
; Returns: STRFLG updated in STR data base to correct state
; +1 on error T1/-1 for exclusive failure
; +2 on success
; First we need to determine if exclusive or shared is to be set because
; that is not set in a normal way.
STSTR:: TRVAR <NEWSTF,STRERR> ;NEWSTF - Saved T1, new structure flags
;STRERR - Error flag. 0 if no error encounter
SETZM STRERR ;No errors yet
MOVEM T1,NEWSTF ;Save the new STRFLG to be
; Do set for domestic/regulated/dismounted, but first check if it is PS:
MOVEI T1,MSTAL ;Get address of alias
CALL STRSTT ;Go get the status
JRST [SETOM STRERR ;Set the error code
;Would like to set error message
JRST STSTR2] ;And skip success setting
TXNE T1,MS%PPS ;[6001]Is this the primary public structure?
JRST STSTR1 ;Yes, only can set exclusive/share
MOVE T1,NEWSTF ;Restore the new STRFLG to be
TXZ T1,MS%EXC+MS%NTC ;Forget about exclusive and other bits for now
HRROI T2,MSTAL ;Build pointer to alias
MOVEM T2,MSTRST+.MSSSN ;Save it
MOVEM T1,MSTRST+.MSSST ;Save the new state
MOVX T2,MS%DIS+MS%DOM+MS%NRS+MS%DMP ;[6007]The bits that can be set
MOVEM T2,MSTRST+.MSSMW ;Save the bits being changed
MOVE T1,[3,,.MSSSS] ;Get block size,,function code
MOVEI T2,MSTRST ;Get the argument block
SKIPN TSTF ;Don't set if debugging
MSTR
ERJMP [SETOM STRERR ;Set the error code
;Would like to set error message
JRST STSTR1] ;And try to set exclusive/shared
; Since we have just set some bits, lets say so in STRFLG
LOAD T1,MS%DIS,NEWSTF ;Get the new unavail/avail bit
STOR T1,MS%DIS,STRFLG(STR) ;And save it
LOAD T1,MS%DOM,NEWSTF ;Get the new domestic/foreign bit
STOR T1,MS%DOM,STRFLG(STR) ;And save it
LOAD T1,MS%NRS,NEWSTF ;Get the new unregulated/regulated bit
STOR T1,MS%NRS,STRFLG(STR) ;And save it
; Now to set EXCLUSIVE/SHARED
STSTR1: MOVE T1,NEWSTF ;Get the new strflg back
SETZ T4, ;Assume shared
TXNE T1,MS%EXC ;Clear exclusive bit, was it set?
MOVX T4,MS%EXC ;Yes, say we want exclusive
HRROI T3,MSTAL ;Build pointer to alias
MOVE T1,[2,,.MSCSM] ;Say we want to set exclusive/shared
MOVEI T2,T3 ;And where the arguments are
SKIPN TSTF ;Don't set if debugging
MSTR ;Try to set it
ERJMP [SETOM STRERR ;[6014]Set the error flag
CALL GETERR ;[6014]Get error
CAIE T1,MSTX48 ;[6011]CFS error?
JRST STSTR2 ;[6014]No
TXNE T4,MS%EXC ;Were we doing exclusive?
MOVEI T1,-1 ;[6011]Yes, set error for exclusive failure
JRST STSTR2] ;And skip success setting
; Set STRFLG to indicate change
LOAD T1,MS%EXC,NEWSTF ;Get the exclusive stuff
STOR T1,MS%EXC,STRFLG(STR) ;Update STRFLG
; Here to do cleanup and analysis.
STSTR2: SKIPE STRERR ;Any errors?
RET ;Yes. return telling the world
RETSKP ;All done.
SUBTTL KSUD - Undefine structure
; This routine processes the UNDEFINE STRUCTURE command from OPR.
KSUD:
; Do some initial validation
CALL DDSCIH ;Make certain tables up to date
MOVEI T1,.STRDV ;Get block type code
CALL KGTSTR ;Get structure name
JRST KBADM ;Not there, reject message
DMOVEM T2,MSTAL ;Save the ascii name
MOVEI T2,MSTAL ;Get the address
TMCT <%IStructure %2A: > ;Start the message
MOVEM T1,DSFE+DSFSPC ;Save SIXBIT structure name
MOVEI T1,.DVSTR ;Get the structure type
MOVEM T1,DSFE+DSFTYP ;Save it
CALL DSFLOC ;Go try to locate this one
JRST [TMCT <is currently not defined> ;Not there
JRST KSUD.9] ;Go to the cleanup
SKIPE DSFE+DSFPNT ;Do we have an SSB currently?
JRST [TMCT <cannot be undefined%_The structure is currently in use.>
JRST KSUD.9] ;Yes, go to the cleanup
CALL DSFDLE ;Delete the entry
$STOP <Deletion of previously known DDB with DSFDLE failed>
TMCT <deleted from data base> ;Tell of success
KSUD.9: MOVEI T3,[ASCIZ/Undefine Structure Command/] ;Header for message
CALL BTACKT ;Send the message we built with TMCT
RET ;And fini
SUBTTL KSMT - Mount Structure x:/Structure-id:z: command from OPR
;KSMT - Mount a structure if possible else allow the structure to be mounted if
; possible.
;Accepts MRPDB, RBUF/ PDB AND MESSAGE
KSMT: CALL DDSCIH ;Update disk table
MOVEI T1,.MNTST ;We want mount RSB
CALL OPRSB ;Get mount RSB
JRST KSMTNR ;[6011]No RSB, no mount
MOVE T1,RSBIFL(RSB) ;[6011]Get flag word
TXNN T1,R%LOR ;[6011]Remote or local?
JRST KSMT0 ;[6011]Local
MOVEI T1,.NDENM ;[6011]Want node name block
CALL ORNBLF ;[6011]Is there one?
JRST KBADM ;[6011]No, bad remote mount messge
MOVE T4,0(T1) ;[6011]Get the node name
MOVEM T4,RSBOBN(RSB) ;[6011]Save it
MOVE T1,RBUF+.MSCOD ;[6017]Get operator's PID
MOVEM T1,RSBPID(RSB) ;[6017]Save it for later
KSMT0: SETOM RSBITN(RSB) ;[6011]Indicate request is from operator
MOVEI T1,RST.WM
STOR T1,RSBSTE ;Set state to waiting for mount
MOVE T1,RSBSTA(RSB) ;Alias name in T1
MOVE T2,RSBSTN(RSB) ;Structure name in T2
SETZ T4, ;For now no unique code
CALL MATCHS ;Go find SSB
JRST [JUMPE T1,KSMTE1 ;Not there, go ask to be mounted
JRST DUPSTA] ;More than one found
SKIPE T2,STRPNT(STR) ;Do we have a pointer to DDB
JRST [TMCT <%IStructure %1S: is already mounted%_>
JRST KSMTEX] ;No need to do anything but tell operator
SETZRO STR%DT,STRFL1(STR) ;Clear the being dismount bit
LOAD T1,STRUNI,(STR) ;No, get # of disks in str
LOAD T2,STRMCT,(STR) ;Get # of disk on-line in str
CAME T1,T2 ;Are all disks on-line?
JRST KSMTE1 ;No, ask operator
CALL STRMNT ;Go mount the structure
JRST KSMTE2 ;Can't mount structure
RET
KSMTE: MOVE T1,RSBSTA(RSB) ;Alias name in T1
MOVE T2,RSBSTN(RSB) ;Structure name in T2
TMCT <%IStructure %2S: mounted as alias %1S:%_>
KSMTEX: ABTREQ (ABRTNR) ;Get rid of RSB
MOVEI T3,[ASCIZ/Mount request by operator completed/]
CALLRET BTWTO ;Tell operator
; Exit routines for KSMT
KSMTE1: CALLRET WOVMS ;TELL OPERATOR TO MOUNT STRUCTURE
KSMTE2: MOVE T3,RSBSTA(RSB) ;Alias name in T1
MOVE T2,RSBSTN(RSB) ;Structure name in T2
TMCT <%ICan't mount structure %2S: (alias %3S:)
Check status of structure and disk drive.%_>
MOVEI T3,[ASCIZ/Mount request by operator failed/]
CALLRET BTWTO ;Tell operator of failure
;[6011]
;No RSB. from KSMT
;RSB/1
;RBUF/MESSAGE
KSMTNR: CAIE RSB,1 ;[6014]We have a RSB
RET ;[6011]NO, just return
MOVEI T1,.STALS
CALL KGTSTR ;[6011]an alias specified?
JRST KBADM ;[6011]Reject message
MOVE T2,T1 ;[6011]Save alias
MOVE T3,T2 ;[6011]Structure name same as alias for now
MOVEI T1,.STRDV ;[6011]Get block type
CALL KGTSTR ;[6011]Get structure name
SKIPA ;[6011]No name use alias
MOVE T3,T1 ;[6011]Save name
MOVEI T1,.NDENM ;[6011]Want node name
CALL ORNBLF ;[6011]Look for it
JRST KBADM ;[6011]No there
MOVE T4,0(T1) ;[6011]Save it
MOVE T1,RBUF+.MSFLG ;[6011]Get the Galaxy flag word
TXNN T1,MF.NEB ;[6011]Remote or local
JRST KSMTN1 ;[6011]Local
TMCT <%IInsufficient MOUNTR resources needed to mount
structure%3S: (Alias %2S:) for node %4S::%_>
MOVEI T3,[ASCIZ/Remote Mount Structure Failed/]
CALLRET BTWTO ;[6011]Tell the operator
KSMTN1:
TMCT <%IInsufficient MOUNTR resources needed to mount
structure%3S: (Alias %2S:) %_%U%_>
MOVEI T3,[ASCIZ/Mount Structure Failed/]
CALLRET BTWTO ;[6011]Tell the operator
; Found two structures with same structure name. Need operator help.
DUPSTA: SKIPN T1,RSBSTN(RSB) ;Use structure name if there is one
MOVE T1,RSBSTA(RSB) ;else use alias
TMCT <%ICan not satisfy mount request because
there is more than one structure with
the name %1S: online.
Structures are online on disk drives%_>
SETZ STR, ;Start at the beginning
DUPST1: CALL SSBNXT ;Go get the next one
JRST DUPST7 ;All done go send message
MOVE T3,STRFL1(STR) ;Get structure state flags
TXNE T3,STR%MT ;Is the structure mounted?
JRST DUPST1 ;Already mounted, go get next
CAME T1,STRNAM(STR) ;Is this the one we want
JRST DUPST1 ;no, get next
LOAD T3,STRUNI,(STR) ;Get number of disks in structure
MOVNS T3
HRRI T3,STRADD(STR) ;Setup address of first disk status block
DUPST2: HRRZ T4,(T3) ;Get the DSB
JUMPE T4,DUPST3 ;Get next if zero
MOVE T2,DSKCKU(T4) ;Get the CKU
TMCT <%7C%2K%_> ;Add it to message
DUPST3: AOBJN T3,DUPST2 ;Increment pointer
JRST DUPST1 ;Next structure
DUPST7: TMCT <Mount request >
MOVE T1,RSBITN(RSB) ;Get request #
SKIPL T1 ;No request ID must be from operator
CALL [TMCT < # %1D >
RET]
TMCT <rejected.
Please spin down conflicting structure(s)
and resubmit the mount request%_>
MOVEI T3,[ASCIZ/Ambiguous Mount Request Detected/]
CALL BTWTO ;Tell operator
MOVE T2,RSBIFL(RSB) ;GET INTERNAL REQUEST FLAGS
TXNE T2,R%OPR ;DON'T REPLY TO OPR-ORIGINATED REQUEST
JRST [ABTRET (ABRTNR)] ;and abort
ABTRET (NPXAMB) ;But do tell user
SUBTTL UPDSTR - Update structure
; This routine updates the status of a structure by comparing the state
; of the structure as determined from the DDB and STRFLG with the state
; of the structure determined from the monitor.
; Accepts T1 / pointer for DDB containing structure
; MSTAL / ascii alias contained in DSFE
; Uses MSTRBK for MSTR call
UPDSTR: STKVAR <INIPNT,STRSTA> ;Some locals
;INIPNT - place to save pointer
;STRSTA - place to save prop. structure status
MOVEM T1,INIPNT ;Save argument
CALL DSFGET ;Go get DDB
CALL STOP ;Someone lied
SKIPN STR,DSFE+DSFPNT ;Get pointer to SSB, is there one?
JRST UPDSEX ;No, cannot need updating
; Now get the monitor state for the structure
MOVEI T1,MSTAL ;Get pointer to alias
CALL STRSTT ;Go get the state
JRST [CALL GETERR ;Get the error
CAIN T1,MSTX21 ;Was it not mounted?
JRST UPDSEX ;Yes, just return for now
MOVEI T2,MSTAL ;Get structure name
TMCT <%IError in structure status for structure %2A, error is %1J>
JRST UPDS.9] ;Send to all OPRs
MOVEM T1,STRFLG(STR) ;Save the status from the MONITOR
MOVE T1,DSFE+DSFFLG ;Get the flags
TXNN T1,DSF%IG ;Is it ignore?
CALL NEWSTA ;Go check on current status
JRST UPDSEX ;Not mounted, don't need updating
; Continued on next page
; Continued from previous page
; Now, do we match?
MOVE T2,STRFL1(STR) ;Get the other structure flag
TXNE T2,STR%UD+STR%ME ;[6011]Is it unavail due to dismount and
;[6011]failure to exclusive as part of mount?
TXO T1,MS%DIS ;Yes, it must be unavailable
MOVEM T1,STRSTA ;Save the proposed structure status for a bit
XOR T1,STRFLG(STR) ;Get the changed bits
TXZ T1,MS%NTC ;Get rid of don't care bits
SKIPN T1 ;Has it changed?
JRST UPDSEX ;No, all done
MOVEI T2,MSTAL ;Get structure name
TMCT <%IStructure state for structure %2A is incorrect%_>
TXZE T1,MS%DOM ;Domestic bit set incorrectly?
CALL [TMCT < DOMESTIC/FOREIGN attribute set incorrectly%_>
RET]
TXZE T1,MS%NRS ;Regulated bit set incorrectly?
CALL [TMCT < REGULATED attribute set incorrectly%_>
RET]
TXZE T1,MS%EXC ;Exclusive bit set incorrectly?
CALL [TMCT < EXCLUSIVE/SHARED attribute set incorrectly%_>
RET]
TXZE T1,MS%DIS ;Dismount bit set incorrectly?
CALL [TMCT < Available status is set incorrectly%_>
RET]
TXZE T1,MS%DMP ;[6007]Dumpable bit set incorrectly?
CALL [TMCT < Dumpable status is set incorrectly%_>
RET]
SKIPE T1 ;Cleared everything?
CALL [TMCT < Unknown status -- word is - %1O%_> ; No
RET]
MOVE T1,STRSTA ;Get new STRFLG based on DDB and disk
CALL STSTR ;Try to update things
CALL [TMCT <Unable to update structure status correctly%_> ;Thing bad
RET]
; Tell operator what bits were set or not set.
MOVEI T1,MSTAL ;Get alias
TMCT <Status of structure %1A: is set:%_>
CALL STRSTT ;Go get the state
JRST [ MOVEI T1,MSTAL ;Get alias
TMCT <Error in getting structure status for structure %1A:
error is %J%_>
JRST UPDS.9] ;Send to all OPRs
TXNE T1,MS%DOM ;Foreign or domestic?
JRST [TMCT <Domestic>
JRST UPD1]
TMCT <Foreign>
UPD1: TXNE T1,MS%NRS ;Regulated on unregulated
JRST [TMCT <, Unregulated>
JRST UPD2]
TMCT <, Regulated>
UPD2: TXNE T1,MS%EXC ;Exclusive or shared?
JRST [TMCT <, Exclusive>
JRST UPD3]
TMCT <, Shared>
UPD3: TXNE T1,MS%DIS ;Available or unavailable?
JRST [TMCT <, Unavailable> ;[6007]
JRST UPD4] ;[6007]
TMCT <, Available> ;[6007]
UPD4: TXNE T1,MS%DMP ;[6007]
JRST [TMCT <, Dumpable%_> ;[6007]
JRST UPDS.9] ;[6007]
TMCT <, Nondumpable%_> ;[6007]
; Structure check message output
UPDS.9: MOVEI T3,STRCHD ;Get structure error header
CALL BTWTO ;Tell the operator
UPDSEX: RET ;All done
SUBTTL Determine-new-string routine (NEWSTA) -- Determine STRFLG based on MOUNTR and disk status
;This routine determines new STRFLG(STR) based on DDB, disk drive status used
;by this structure and structure mount status.
;Accepts - DSFE / structure DDB (will NOT be preserved!)
;Returns - always with T1 containing the new structure status flags.
; +1 if structure is not mounted
; +2 if structure is mounted
NEWSTA::SAVEAC <Q1> ;Save some ACs
SETZ Q1, ;Q1 contains the building STRFLG
; Structure status DSFE+DSFFLG, lets set the corresponding bits in STRFLG
LOAD T1,DSF%EX,DSFFLG+DSFE ;Get the share/exclusive bit
; This bit counts if the structure is primary PS.
MOVE T2,DSFE+DSFPNT ;Is there a pointer to the SSB?
JUMPE T2,NEWST0 ;If no pointer, continue normal stuff
LOAD T3,STR%EP,STRFL1(T2) ;Get exclusive due to port bit
SKIPE T3 ;Is it?
MOVE T1,T3 ;Yes, set for exclusive anyway
MOVE T3,STRFLG(T2) ;Get the structure flags
TXNN T3,MS%PPS ;Is it primary PS?
JRST NEWST0 ;No, continue normal stuff
STOR T1,MS%EXC,T3 ;Store the share/exclusive bit with
; STRFLG since nothing else changable
MOVE T1,T3 ;Move the new STRFLG over
RETSKP ;And return only the PS case
NEWST0: STOR T1,MS%EXC,Q1 ;Save it
LOAD T1,DSF%DO,DSFFLG+DSFE ;Get the foreign/domestic bit
STOR T1,MS%DOM,Q1 ;Save it
LOAD T1,DSF%RG,DSFFLG+DSFE ;Get the regulate/unregulate bit
STOR T1,MS%NRS,Q1 ;Save it
LOAD T1,DSF%AV,DSFFLG+DSFE ;Get the available/unavailable bit
STOR T1,MS%DIS,Q1 ;Save it
LOAD T1,DSF%DP,DSFFLG+DSFE ;[6002]DOB Get the dumpable/nondumpable
STOR T1,MS%DMP,Q1 ;[6002]Save it
SKIPG T2,DSFE+DSFPNT ;SSB?
JRST NEWEX ;No, Can't have anything else to do
PUSH P,T2 ;Save the SSB
MOVE T1,STRFL1(T2) ;Get other structure bits
TXNE T1,STR%DT+STR%DE ;Structure being dismounted or error
JRST NEWST1 ;Yes, set structure as unavailable
MOVE T1,T2 ;Move over the SSB address
CALL CHKAVA ;Go check on status based on disks
SKIPA ;Skip if want unavailable
JRST NEWST2 ;Otherwise go to finish
NEWST1: SETONE MS%DIS,Q1 ;Set things unavailable
NEWST2: MOVE T1,Q1 ;Get the new strflg in any case
POP P,T2 ;Get the SSB
MOVE T2,STRFL1(T2) ;Get the internal status flags
TXNE T2,STR%MT ;Structure mounted?
RETSKP ;Yes
SKIPA ;Don't need to set strflg again
NEWEX: MOVE T1,Q1 ;Get the STRFLG
RET ;And return unmounted.
SUBTTL CHKAVA - Check SSB disk drives for available/unavailable
; Accepts: T1 / Address of SSB
; Returns: +1 Structure is on a disk drive unavailable
; +2 Structure can be available
CHKAVA: SAVEQ
MOVE Q1,T1 ;Get address of SSB
; Set according to the disk which this structure is mounted.
LOAD Q3,STRUNI,(Q1) ;Get the number of units
MOVNS Q3 ;Negate number of units
MOVSS Q3 ;And switch halves
HRRI Q3,STRADD(Q1) ;Setup address of first disk status block
; Loop through all disks belonging to this structure
CHKAV1: MOVE T2,(Q3) ;Get the disk status block address
JUMPE T2,CHKAV2 ;No address, go try the next
MOVE T1,DSKPNT(T2) ;Get pointer to disk DDB
CALL DSFGET ;Get DSFE for disk
CALL STOP ;Should never happen
MOVE T2,DSFE+DSFFLG ;Get the flag bits
TXNE T2,DSF%AV+DSF%PO ;Any reason to be unavailable?
RET ;Yes, return unavailable
CHKAV2: AOBJN Q3,CHKAV1 ;Get the next disk address and loop back
; End of loop
RETSKP ;Must be ok
SUBTTL SSB routines -- SSBINI - Initialize SSB data base
; Returns +1 always
SSBINI: SETZM SSBFPT ;No free entries
MOVEI T1,STRSTB ;The bottom is the top
MOVEM T1,SSBTOP ;And remember it
RET
SUBTTL SSB routines -- SSBCRE - Create a new SSB entry (zeroed)
; Returns +1 always
; STR / address of new entry
SSBCRE: SKIPE STR,SSBFPT ;Any already existing free entries?
JRST [MOVE T1,STRALI(STR) ;Yes, get pointer to next free entry
MOVEM T1,SSBFPT ;Set it as address of free entry list
JRST SSBC.5] ;go to finish up
MOVE STR,SSBTOP ;Get top as new entry
MOVE T1,STR ;Copy of new entry address
ADDI T1,STRSZ ;Bump to the new limit
CAIL T1,MAXSSB ;Room for more?
CALL STOP ;No. Too bad
MOVEM T1,SSBTOP ;Save the new next entry
; Clear new entry
SSBC.5: MOVSI T1,0(STR) ;Setup BLT pointer
IORI T1,1(STR) ; to clear Structure status block
SETZM (STR) ;Clear first word
BLT T1,STRSZ-1(STR) ;And the rest
RET
SUBTTL SSB routines -- SSBRET - Return SSB entry to free SSB pool
; Accepts: STR / Address of entry to be returned to free
; Returns +1 always
SSBRET: MOVE T1,SSBFPT ;Get pointer to first entry
MOVEM T1,STRALI(STR) ;Save it
MOVEM STR,SSBFPT ;Save new pointer to new first entry
SETZM STRNAM(STR) ;Say entry is free
SETZ STR, ;Clear the SSB pointer just in case
; someone tries to use it
RET
SUBTTL SSB routines -- SSBNXT - Get next SSB
; Accepts: STR / Address of the current SSB or 0 if initializing search
; Returns: +1 if no more SSBs
; +2 if successful
; STR / Address of next SSB
SSBNXT: SKIPE STR ;Do we have a previous?
JRST SSBN.2 ;Yes, go to bump to the next one
MOVEI STR,STRSTB ;No. Initialize
SSBN.1: SKIPE STRNAM(STR) ;Is this one in use?
RETSKP ;Yes, done
SSBN.2: ADDI STR,STRSZ ;Bump to the next one
CAMGE STR,SSBTOP ;Any more to look at?
JRST SSBN.1 ;Yes, go try this one
RET ;No, no more
SUBTTL SSB routines -- MATCHS - Match request to structure (old)
; The caller determines what to match by passing arguements in T ACs.
; Accepts: T1 / SIXBIT structure alias
; T2 / SIXBIT structure name
; T4 / Unique Code
; +1 Unsuccessful in finding a match
; STR / 0
; T1 / 0 if structure not found
; T1 / -1 if ambiguity found
; +2 Structure spinning
; STR / -1,,SSB address if not mounted
; STR / 0,,SSB address if mounted
; Caller should check return
MATCHS:: SAVEQ ;Save the Q acs
;Q1 will have structure Alias
;Q2 will have structure name
;Q3 will have successful unmounted name match
STKVAR <UNQCOD> ;Storage for unique code
SETZ Q3, ;No name matchs
DMOVE Q1,T1 ;Save the arguments
MOVEM T4,UNQCOD ;Save the unique code
SETZ STR, ;Starting place
; Loop on all structure entries till match or run out
MATC.1: CALL SSBNXT ;Get the next entry
JRST MATC.8 ;No more entries
; Want to check for match with the following logic:
; If the structure is mounted, alias matching is required.
; if the alias matches, then so must the unique code,
; or the request cannot be satisfied. (ambiguous)
; If the structure is not mounted name matching and unique code matching
; is acceptable (The alias in SSB is invalid and should be 0)
; But matching with a mounted structure is preferred.
MOVE T4,STRFL1(STR) ;Get structure flags with mount flag
TXNN T4,STR%MT ;Is this structure mounted?
JRST MATC.3 ;No, go try for match another way
; Here if mounted
CAME Q1,STRALI(STR) ;Match the alias
JRST MATC.1 ;No, go try for another
SKIPN T2,UNQCOD ;Unique code provided
JRST MATC.2 ;No, check structure name
CAME T2,STRUNQ(STR) ;Yes, do they match
JRST MATC.1 ;No, get the next
MATC.2: SKIPE Q2 ;Name provided
CAMN Q2,STRNAM(STR) ;Yes, does it match
JRST MATC.9 ;Yes, go tell of success
JRST MATC.7 ;No, give up on this one
; (indicates ambiguity)
; Loop continued on next page
; Loop continued from previous page
; Here if structure being examined is not mounted
MATC.3: SKIPN T4,Q2 ;Skip if structure name given
MOVE T4,Q1 ;Otherwise, match on alias against name
CAME T4,STRNAM(STR) ;Do we have a match
JRST MATC.1 ;No, go try for another
SKIPN T2,UNQCOD ;Unique code given?
JRST MATC.4 ;No, skip this check.
CAME T2,STRUNQ(STR) ;Yes, do they match?
JRST MATC.7 ;Unique code doesn't match, ambiguity
MATC.4: JUMPN Q3,MATC.7 ;If already have a name match, then go bad
; (Indicates ambiguity)
SETO Q3, ;Remember this one
HRRI Q3,(STR) ; unmounted as it is
JRST MATC.1 ; and continue to look for something better
; End of loop
; Returns:
; Here on ambiguous return
MATC.7: SETO T1, ;Set the problem
SETZ STR, ;Clear the pointer
RET
; Here on exhausted loop
MATC.8: SETZ T1, ;Say at least not bad
SKIPN STR,Q3 ;Any non-mount match?
RET ;No.
; For whatever reason, we think we succeeded
MATC.9: RETSKP
SUBTTL ISTDDB - Initialize structure DDB
; Accepts: T1 / Structure alias in sixbit
; Returns: T1 / Pointer for found/created entry
; DSFE containing found/created entry
; +1 if alias already exists
; +2 if entry created
; DSFE containing entry
ISTDDB: MOVEM T1,DSFE+DSFSPC ;Save the alias
MOVEI T1,.DVSTR ;Get structure type
MOVEM T1,DSFE+DSFTYP ;Set it
SETZM DSFE+DSFPNT ;No pointer yet
SETZM DSFE+DSFFLG ;Set for default flags
CALL DSFCRE ;Go create
RET ;Already exists, what a suprise
RETSKP ;Successfully created!
SUBTTL MESCHK - CHECK IF MESSAGE FOR STRUCTURE ALREADY SENT TO OPERATOR
;ACCEPTS: RSB/ ADDRESS OF RSB
;RETURNS: +1, OPERATOR ALREADY NOTIFIED OF STRUCTURE
; +2, OPERATOR NOT NOTIFIED
MESCHK: SAVEQ
MOVE Q1,RSBSTN(RSB) ;GET STRUCTURE NAME
MOVE Q2,RSBSTA(RSB) ;GET STRUCTURE ALIAS
MOVE Q3,RSB ;SAVE ADDRESS OF RSB
QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB>
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
MESCH1: CALL NSTRSB ;GET ADDRESS OF NEXT RSB
RETSKP ;NONE LEFT
CAMN Q3,RSB ;IS THIS THE CURRENT RSB?
JRST MESCH1 ;YES, FORGET IT
CAMN Q1,RSBSTN(RSB) ;SAME STRUCTURE NAME?
CAME Q2,RSBSTA(RSB) ;YES, SAME ALIAS?
JRST MESCH1 ;NO, TRY NEXT RSB
MOVE T1,RSBIFL(RSB) ;SEE IF OPR TOLD ABOUT THIS ONE
TXNN T1,R%ONR ;
JRST MESCH1 ;NO, DO NOT STOP HERE
RET ;SAME NAME AND ALIAS
SUBTTL MNTALL - MOUNT ALL STRUCTURES NOT ALREADY MOUNTED
;ACCEPTS: NOTHING
;RETURNS: +1, ALWAYS
MNTALL: CALL GORSB ;Create a fake RSB since everything else
; depends on it
JFCL ;Got the last one
; loop on all the structures around
SETZ STR, ;Start at the beginning
MNTNXT: CALL SSBNXT ;Go get the next one
JRST [ABTRET (ABRTNR)] ;No more. Get rid of RSB and return
MOVE T1,STRFL1(STR) ;Get structure state flags
TXNE T1,STR%MT ;Is the structure mounted?
JRST MNTNXT ;Already mounted, go get next
MOVE T1,STRFLG(STR) ;Get the structure flags
TXNE T1,MS%PPS ;Public structure?
JRST MNTNXT ;Public structure, go get next
LOAD T1,STRUNI,(STR) ;Get number of disks in structure
LOAD T2,STRMCT,(STR) ;Get number of disks on-line
CAME T1,T2 ;Is it all there?
JRST MNTNXT ;No, go get next one
PUSH P,STR ;Save the SSB we are working at
SETZ T1, ;No alias
MOVE T2,STRNAM(STR) ;Get structure name
MOVEM T2,RSBSTA(RSB) ;Alias of structure will be physical name
SETZ T4, ;No unique code
CALL MATCHS ;Find SSB
JRST MNTNX2 ;Skip mount if more than one str with that name
CALL STRMNT ;Mount the structure
JFCL ;Failed for some reason, who cares
MNTNX2: POP P,STR ;Restore the SSB
JRST MNTNXT ;Go try for the next one
SUBTTL OPRSB - SET UP REQUEST BLOCK FOR OPR MOUNT OR DISMOUNT COMMAND
;ACCEPTS: T1/ REQUEST TYPE (.MNTST,.DSMST, .PTSET, .SETST)
; MRPDB, RBUF/ PDB AND MESSAGE FROM OPR IPCF REQUEST
;RETURNS: +1, FAILURE. RSB/1
; +2, SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK
OPRSB:: CALL GORSB ;GET A STATUS BLOCK FOR REQUEST
JRST [MOVEI RSB,1 ;[6011]No RSB's available, set RSB to 1
RET] ;[6011]Take error return
MOVE T1,RBUF+.MSFLG ;[6011]Get the Galaxy header flag word
TXNN T1,MF.NEB ;[6011]Is the request from Nebula (remote)?
JRST OPRSB0 ;[6011]No need to get node name
; Remote request must have a node block
SETONE R%LOR,RSBIFL(RSB);[6011]Yes, say so in the RSB
TXNE T1,MF.WTO ;Want WTO?
SETONE R%WTO,RSBIFL(RSB) ;Yes, remember to send WTO to NEBULA
MOVE T1,RBUF+.MSCOD ;[6011]Get the ACK code
MOVEM T1,RSBRAC(RSB) ;[6011]Store it for return message
MOVEI T1,.NDENM ;[6011]Want node name block
CALL ORNBLF ;[6011]Is there one?
JRST OPRSBE ;[6011]No go to error routine
MOVE T4,0(T1) ;[6011]Get the node name
MOVEM T4,RSBOBN(RSB) ;Save it
OPRSB0: MOVEI T1,.STRDV ;GET BLOCK TYPE
CALL KGTSTR ;GET STRUCTURE NAME
SKIPA ;Not there, lets try alias
MOVEM T1,RSBSTN(RSB) ;STORE SIXBIT STRUCTURE NAME IN RSB
MOVEI T1,.STALS
CALL KGTSTR ;WAS AN ALIAS SPECIFIED?
JRST [ SKIPE T1,RSBSTN(RSB) ;No alias, how about structure name?
JRST OPRSB1 ;We have a structure name but no alias
JRST OPRSBE] ;[6011]Bad message from NEBULA
SKIPN RSBSTN(RSB) ;Do we have a structure name?
MOVEM T1,RSBSTN(RSB) ;No, lets use the alias
OPRSB1: MOVEM T1,RSBSTA(RSB) ;YES, STORE IT IN RSB
MOVE T1,MRPDB+.IPCFS ;GET PID OF SENDER
MOVEM T1,RSBPID(RSB) ;STORE IN RSB
MOVEM T1,MUTLBK+1
MOVEI T1,.MUFOJ ;GET SENDER'S JOB NUMBER
MOVEM T1,MUTLBK
MOVEI T1,3 ;3 WORDS IN ARGUMENT BLOCK
MOVEI T2,MUTLBK ; WHICH IS MUTLBK
MUTIL
JRST [ ABTRET (ABRTNR)] ;SOMETHING HAPPENED TO REQUESTER
MOVE T1,MUTLBK+2 ;GET JOB NUMBER
STOR T1,RSBJNO
MOVE T2,[-1,,T4] ;GET USER NUMBER
MOVEI T3,.JIUNO
GETJI
JRST [ ABTRET (ABRTNR)] ;SOMETHING HAPPENED TO REQUESTER
MOVEM T4,RSBUNO(RSB) ;STORE USER NUMBER
RETSKP
; Error routine when MOUNTR receives a bad message from NEBULA
OPRSBE: ABTREQ (ABRTNR) ;[6011]No, abort the request
MOVX T1,E%NEB ;[6011]Error code=NEBULA error
TXO T1,FA%NER ;[6011]Set bit NEBULA error
MOVE T2,RSBRAC(RSB) ;[6011]Need ACK code
MOVE T3,RSBIFL(RSB) ;[6011]Get flag
TXNN T3,R%WTO ;[6011]Just send WTO?
CALL FAILE ;[6011]No, send ACK first
JRST KBADM ;[6011]Then tell local operator
SUBTTL PSDR - PARSE OPERATOR RESPONSE TO DISMOUNT MESSAGE WHEN OTHER JOBS
; USING STRUCTURE
;ACCEPTS: T1/ ADDRESS OF ASCIZ RESPONSE TEXT
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1, ERROR DETECTED WHILE PARSING RESPONSE, OPERATOR TOLD
; +2, SUCCESSFUL PARSE
; IF ANSWER IS YES, T1/ 0
; IF ANSWER IS NO, T1/ -1
PSDR:: CALL COMNDI ;INITIALIZE FOR COMND JSYS
MOVEI T2,[FLDDB.(.CMKEY,,PSDKT)] ;SETUP FOR KEYWORD PARSE
CALL COMNDX ;PARSE KEYWORD
JRST [ MOVEI T1,[ASCIZ/Response must be YES or NO/]
CALLRET RSPERR] ;DIDN'T SAY YES OR NO, GIVE ERROR
HRRZ T1,(T2) ;GET 0 FOR NO, 1 FOR YES
SOJA T1,RSKP ;RETURN -1 FOR NO, 0 FOR YES
PSDKT: PSDKTL,,PSDKTL
[ASCIZ/NO/],,0
[ASCIZ/YES/],,1
PSDKTL==.-PSDKT-1
SUBTTL SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT
;ACCEPTS: T1 POINTER TO ASCIZ STRING
; T2 ADDRESS OF WORD IN WHICH TO STORE 6-BIT STRING
;RETURNS: +1, ALWAYS
SEVSIX: SAVET ;[6010]Save T ACs
HRLI T2,(POINT 6,0) ;SET UP SIXBIT POINTER
SETZM (T2) ;CLEAR THE DESTINATION WORD
MOVEI T4,6 ;MAXIMUM OF 6 CHARACTERS
;LOOP OVER CHARACTERS
SEVLOP: ILDB T3,T1 ;GET 7-BIT CHARACTER
JUMPE T3,R ;RETURN IF END OF STRING
CAIL T3,"a" ;IS IT LOWER CASE?
TRZ T3,40 ;MAKE SURE IT IS UPPER CASE
SUBI T3,40 ;CONVERT TO 6-BIT
IDPB T3,T2 ;STORE CHARACTER
SOJG T4,SEVLOP ;JUMP IF MORE CHARACTERS
RET
SUBTTL SIXSEV - ROUTINE TO CONVERT SIXBIT TO ASCIZ
;ACCEPTS: T1 ADDRESS OF WORD CONTAINING SIXBIT CHARACTERS
; T2 POINTER TO WORDS FOR STORING ASCIZ STRING (2 WORDS)
;RETURNS: +1, ALWAYS
SIXSEV::SAVET ;[6010]Save T ACs
HRLI T1,(POINT 6) ;SET UP BYTE POINTER FOR SIXBIT WORD
MOVEI T4,6 ;MAXIMUM OF 6 CHARACTERS
;LOOP OVER CHARACTERS
SIXLOP: ILDB T3,T1 ;GET CHARACTER
JUMPE T3,SIXEND ;IF ZERO, THEN END OF STRING
ADDI T3,40 ;MAKE 7-BIT
IDPB T3,T2 ;STORE WORD
SOJG T4,SIXLOP ;JUMP IF MORE CHARACTERS
SIXEND: ADDI T4,4 ;ZERO OUT REST OF WORD(S)
SETZ T3,
IDPB T3,T2 ;DEPOSIT ZERO
SOJG T4,.-1 ;JUMP BACK IF MORE CHARACTERS
RET
SUBTTL STRDMT - DISMOUNT A STRUCTURE (OPR>DISMOUNT STRUCTURE FOO:)
; This is the superior dismount routine. It calls the appropriate
; routines to do the task.
;ACCEPTS: RSB/ ADDR OF REQUEST STATUS BLOCK
; MSTAL/ ASCIZ ALIAS OF STRUCTURE
; STR/ STRUCTURE STATUS BLOCK
;RETURNS: +1, ALWAYS
STRDMT:
; First, make sure we are allowed to dismount structure.
MOVE T1,STRPNT(STR) ;Get the pointer to the DDB
CALL DSFGET ;Go find it
$STOP <TRYING TO DISMOUNT A STR THAT DOESN'T HAVE A STRUCTURE ENTRY IN DDB>
MOVE T1,DSFE+DSFFLG ;Get the status flag
TXNE T1,DSF%IG ;Is it IGNORED?
JRST [MOVEI Q1,MREQ27 ;Yes, get the error code
MOVE T1,STRALI(STR) ;Get the alias
TMCT <%ICan't dismount structure %1S:-%5J%_%U%_>
MOVEI T3,[ASCIZ/Dismount Structure Failed/]
CALL BTWTO ;SEND MSSG TO OPERATORS
ABTREQ (MREQ27) ;[6031]Abort the dismount request
TXO Q1,FA%TER ;[6011]Monitor error
MOVEM Q1,RSBERR(RSB) ;[6011]Save it
SETONE R%STA,RSBIFL(RSB) ;[6031]Set status of request as fail
JRST STREXT] ;[6011]Go to common failure exit
; Are we in the middle of a dismount for this structure and is it from OPR
MOVE T2,RSBIFL(RSB) ;Get the request status flag
TXNN T2,R%LOR ;[6011]From Nebula?
TXNN T2,R%OPR ;No, local OPR request?
JRST STRDM0 ;From Nebula, go do the dismount
MOVE T1,STRFL1(STR) ;Get the structure status
TXNN T1,STR%UD ;Are we already dismounting?
JRST STRDM0 ;No, go dismount structure
; Tell operator we are already dismounting this structure
MOVE T1,STRALI(STR) ;Get the alias
TMCT <%IStructure %1S: is already in the process of being dismounted%_%U%_>
MOVEI T3,[ASCIZ/Dismount Structure Aborted/]
CALL BTACKT ;Send message to operator
ABTREQ (ABRTNR) ;[6011]Abort rsb with no reply to operator
JRST STREXT ;[6011]Common exit
; Start procedures for dismount.
STRDM0: CALL STRSET ;Set up for dismount
JRST STRER1 ;An error or some one connected to str
STREX0: MOVE T1,RSBIFL(RSB) ;Get the flag word
TXNE T1,R%RNR ;Is it remove
SKIPA ;yes, but is it CFS?
JRST STRDMC ;No remove specified go to dismount
SKIPN CFSB ;Is it CFS system?
JRST STRDMC ;No, just go dismount str
SKIPE ENQFLG ;[6011]Yes, but is Cluster ENQ enabled?
JRST STREX2 ;[6011]No, do it the old way
STREX1: CALL GETLOC ;[6011]Lock the structure
JRST [CALL WHOENQ ;Failed, find out who has it
JRST STREX1 ;No one lets try again
MOVEI T3,[ASCIZ/Dismount Status/]
CALL BTWTO
CALL STSTBK
JRST STREXT] ;[6011]failed
STREX2: MOVE T3,[POINT 7,MSTAL] ;Get pointer to alias of str
MOVX T4,MS%EXC ;say we want it exclusive
MOVE T1,[2,,.MSCSM] ;Get length,,function
MOVEI T2,T3 ;Get the address of the arguments
SKIPN TSTF ;Skip if debugging
MSTR ;Go try to set exclusive
ERJMP [CALL GETERR ;[6011]Get the error
CAIE T1,MSTX48 ;[6011]CFS access error?
JRST STEXER ;[6011]No, abort the dismount
MOVEI T1,STREX2 ;[6012]Get continue address for success
MOVEI T2,STREXT ;[6011]Get continue address for abort
MOVEM T1,RSBCON(RSB) ;[6011]Save it
MOVEM T2,RSBABO(RSB) ;[6011]Save it
JRST SCREQ1] ;[6011]Failed get cfs compliance
STRDMC: CALL STRDMS ;Dismount the str
CALLRET DISFAL ;An error, tell operator what happened
CALL NSACK ;[6011]Tell NEBULA or not?
CALL WOVDS ;Tell operator to remove or not to remove
SETZM STRNDM(STR) ;Set number of pending dismounts to zero
; Just dismounted a structure, Do we have any more dismount queries for this
; structure. Loop through all RSB and kill outstanding WTORs
QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB,DSK>
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
STRDRB: CALL NSTRSB ;GET ADDRESS OF NEXT RSB
RET ;NONE LEFT
SKIPE T1,RSBSUP(RSB) ;Is this a dismount due to port operation
JRST STRDR2 ;Yes, leave it alone!!
LOAD T1,RSBTYP ;Get the type
CAIE T1,.DSMST ;Is it a dismount?
JRST STRDR2 ;No
MOVE T1,RSBSTA(RSB) ;Yes, get alias in request
CAME T1,STRALI(STR) ;Is it same as dismounted structure?
JRST STRDR2 ;No
SKIPN T2,RSBSTN(RSB) ;Yes, do we have a structure-id?
JRST STRDR1 ;No, one more check
CAME T2,STRNAM(STR) ;Yes, is it the same as dismounted structure?
JRST STRDR2 ;No
STRDR1: SKIPE T1,RSBWTB+WTBCOD(RSB) ;Do we have ack code?
CALL CANWTR ;Yes, Get rid of WTOR for this RSB
STRDR2: JRST STRDRB ;Get the next one
;STEXER - Routine to handle set exclusive error when doing a dismount/removal
;that is not MSTX48.
STEXER: CALL SAVERR ;[6011]Report the error
CALL STSTBK ;[6011]Set the structure back
CALLRET DISFAL ;[6011]Abort the dismount
SUBTTL GETLOC - Obtain a structure lock for dismount/removal or set/exec
;[6011]
;GETLOC - Routine to lock the structure for setting a structure exclusive due
;to the SET or DISMOUNT/REMOVE commands. This routine only locks a structure
;once and updates STRFL1 (bits STR%LE and STR%LD) to indicate why it is locked.
;Also, STRDLK is incremented for DISMOUNT/REMOVE to indicate how many dismounts
;are pending.
;The resource name is the structure unique code
;plus an arbitrary ASCIZ string. Cluster ENQ at this point must be enabled.
;If cluster ENQFLG is set (cluster ENQ is disabled) then there means that we
;are running a pre 7 monitor.
;Accepts RSB and STR
;T4 is only used as a counter for the number of locks in this routine. Do not
;use T4 for anything else.
;Returns ENQBLK
; +1 failed to lock. Error code in T1
; +2 Success
GETLOC: LOAD T4,STRDLK,STRELC(STR) ;[6011]Get the number of locks
MOVE T1,STRFL1(STR) ;[6011]Get flag
SKIPG T4 ;No need to lock if already locked for dismount
TXNE T1,STR%LE ;or lock for set exclusive
JRST GETLO1 ;No need to lock
;Build header
MOVE T1,[20001,,6] ;Header length,# resource block,,length
MOVEM T1,ENQBLK+.ENQLN ;Into arg block
SETZM ENQBLK+.ENQID ;No PSI and no ID
;Build request block
MOVX T1,EN%BLN+EN%NST ;Ignore level number and allow nesting
HRRI T1,-2 ;Only allow locking by this job
MOVEM T1,ENQBLK+.ENQLV ;Say so in arg block
MOVE T1,STRUNQ(STR) ;Structure unique code
MOVEM T1,RESPRE ;Resources prefix
HRROI T1,RESPRE ;Make it a pointer
MOVEM T1,ENQBLK+.ENQUC ;Add it to arg block
SETZM ENQBLK+.ENQRS ;Only one resource
SETZM ENQBLK+.ENQMS ;Save it
MOVEI T1,.ENQAA ;Get function code
MOVEI T2,ENQBLK ;Address of argument block
SKIPN TSTF ;Debugging?
ENQ% ;No, get the lock
ERJMP R ;Error
GETLO1: SETONE R%LOC,RSBIFL(RSB) ;This request locked the structure
LOAD T1,RSBTYP ;Get the type
CAIE T1,.DSMST ;Dismount?
IFSKP.
SETONE STR%LD,STRFL1(STR) ;Lock for dismount
AOS T4 ;Add one more
STOR T4,STRDLK,STRELC(STR) ;Store it
ELSE.
SETONE STR%LE,STRFL1(STR) ;No, then it must be exclusive
ENDIF.
RETSKP ;Got it
;RELLOC - Release the structure lock
;RELLOC is called when:
;A structure goes offline and is not mounted.
;A structure is set from exclusive to shared.
;A dismount/remove is canceled.
;Operator aborts a dismount/remove request.
;
;Accepts STR/
;Return +1 always
RELLOC: SAVET ;Save T ACs
;Build header
MOVE T1,[20001,,6] ;Header length,# resource block,,length
MOVEM T1,ENQBLK+.ENQLN ;Into arg block
SETZM ENQBLK+.ENQID ;No PSI and no ID
;Build request block
MOVX T1,EN%BLN+EN%NST ;Ignore level number and allow nesting
HRRI T1,-2 ;Only allow locking by this job
MOVEM T1,ENQBLK+.ENQLV ;Say so in arg block
MOVE T1,STRUNQ(STR) ;Structure unique code
MOVEM T1,RESPRE ;Resources prefix
HRROI T1,RESPRE ;Make it a pointer
MOVEM T1,ENQBLK+.ENQUC ;Add it to arg block
SETZM ENQBLK+.ENQRS ;Only one resource
SETZM ENQBLK+.ENQMS ;No mask
MOVEI T1,.DEQDR ;Get function code
MOVEI T2,ENQBLK ;Address of argument block
SKIPN TSTF ;Debugging?
DEQ% ;No, get the lock
ERCAL RELOC1 ;Error
SETZRO STR%LE+STR%LD,STRFL1(STR) ;Clear lock for dismount/set exclusive
RET ;All done
;Error handling routine for RELLOC
;T1/DEQ error code
RELOC1: CAIE T1,ENQX7 ;No ENQ on this lock
$STOP <DEQ error in RELLOC >
RET
;WHOENQ - Called when an ENQ (function .ENQAA) fails to lock a structure
;resource. WHOENQ Checks for error code ENQX6 to see if it is already locked
;by another system then calls WHOEQC to find the node that has the lock.
;WHOEQC returns in T1 the SIXBIT node name
;WHOENQ builds the message why it couldn't lock the structure
;Accepts T1/ERROR CODE
; STR/structure status block
;returns +1 No one has it locked
; +2 Someone has it or some other ENQ error.
WHOENQ: CAIE T1,ENQX6 ;Already locked?
JRST [MOVE T2,STRALI(STR);Some other error. Get the structure name
TMCT <%IUnable to lock structure %2$:%_Reason - %1J%_>
JRST WHOEN3] ;Add header
CALL WHOEQC ;Who has it
RET ;No one
SETONE R%STA,RSBIFL(RSB) ;Set status of request as fail
MOVE T2,STRALI(STR) ;Get the name
TMCT <%IUnable to lock structure %2S:
Structure %2S: is in the process of being DISMOUNTED with REMOVAL or
SET EXCLUSIVE by node %1S::%_> ;[6020]T1 contains node name from WHOEQC
WHOEN3: RETSKP ;No one has it
;WHOEQC - Routine to find out which system in the cluster has locked a
;particular structure resource via the ENQC JSYS. Since the ENQC JSYS only
;returns the job number, WHOEQC will call GCNFIG to get the CI node number of
;each system in the cluster and do a INFO (function GETJI) on each node to find
;out if the job number belongs to this node. If it is found WHOEQC returns
;back to the caller the node name in T1.
;Accepts STR
; ENQBLK set up
;Returns +1 no one has it
; +2 T1/sixbit node name
WHOEQC: STKVAR <TEMP> ;Allocate space for job number and node name
;Build header
MOVE T1,[20001,,6] ;Header length,# resource block,,length
MOVEM T1,ENQBLK+.ENQLN ;Into arg block
SETZM ENQBLK+.ENQID ;No PSI and no ID
;Build request block
MOVX T1,EN%BLN+EN%NST ;Ignore level number and allow nesting
HRRI T1,-2 ;Only allow locking by this job
MOVEM T1,ENQBLK+.ENQLV ;Say so in arg block
MOVE T1,STRUNQ(STR) ;Structure unique code
MOVEM T1,RESPRE ;Resources prefix
HRROI T1,RESPRE ;Make it a pointer
MOVEM T1,ENQBLK+.ENQUC ;Add it to arg block
SETZM ENQBLK+.ENQRS ;Only one resource
SETZM ENQBLK+.ENQMS
;Do ENQC
MOVEI T1,.ENQCS ;Function code
MOVEI T2,ENQBLK ;Arg block
MOVEI T3,ENQCBK ;Return Info goes here
ENQC% ;Get the node that has the structure locked
ERJMP STOP ;(tbd)
MOVE T1,ENQCBK ;Get the flag and job number
TXNN T1,EN%QCE ;Any errors?
IFSKP. ;Yes
HRRZS T1 ;Get error code
CAIE T1,ENQX7 ;No ENQ on this lock?
$STOP <ENQC JSYS failed at WHOEQC:>
RET ;No one has it
ELSE.
CAIN T1,-1 ;Lock is not owned?
RET ;That's right
HRR T1,ENQCBK ;Get the job number
HRRZM T1,TEMP ;[6020]Save job number
ENDIF.
CALL GCNFIG ;Get node and CI number
SOJLE T3,R ;No one has it
; Who has it. Use INFO% (GETJI) to find out who has it.
MOVEI T4,2 ;Start at the second CI-node number
WHOEQ1: HLRZ T1,NUMBLK(T4) ;Get the CI-node number
MOVEM T1,INFBLK+.INCID ;Store it in INFO arg block
MOVE T1,[.INGJI,,.INAC3+2] ;Function,,Length
MOVEM T1,INFBLK+.INFUN ;Store it
MOVE T1,TEMP ;job number
MOVEM T1,INFBLK+.INAC1 ;Store it in INFO block
MOVE T1,[-2,,TEMPX] ;Just want to see if its there
MOVEM T1,INFBLK+.INAC2 ;Address goes here
SETZM INFBLK+.INAC3 ;Start at the beginning
MOVEI T1,INFBLK ;
INFO%
ERJMP [AOS T4 ;Not this node
SOJN T3,WHOEQ1 ;Get the next node
RET] ;No one has it
TXNN T1,IN%RER ;INFO% encounter a remote error?
SKIPGE TEMPX ;Does the job belong to this node?
JRST WHOEQ2 ;Get the next node
MOVE T1,NAMBLK(T4) ;Yes, get pointer to node
MOVEI T2,TEMP ;Store node name here
CALL SEVSIX ;Convert to SIXBIT
MOVE T1,TEMP ;Return it in T1
RETSKP
WHOEQ2: AOS T4 ;Not this node
SOJN T3,WHOEQ1 ;Get the next node
RET
;Failure exit point
;Accepts RSB
STREXT: CALL UNDREM ;[6011]UNLOCK?
CALL NSACK ;Remote, tell Nebula
RET ;Lets continue
;STRSET - Set up for dismount.
; This routine sets the status of a structure and indicates whether
; an error has occurred.
; For local dismounts:
; If the structure is in used, a dismount query will be sent to the operator.
; For remote dismounts:
; It will not check for structure use
;ACCEPTS RSB and STR already setup
;RETURNS +1 If error occurs LSTERR contains error code
; or LSTERR is zero indicates user is connected or files open.
; +2 Ready to continue to dismount.
STRSET::SETZM LSTERR
MOVEI T1,MSTAL ;Get address of alias string
CALL STRSTT ;Try to get the status
;**;[6034]At STRSET:+4L change 1 line JYCW 11-Aug-88
JRST STRSE1 ;[6034]Couldn't get status, why??
TXNE T1,MS%PPS ;Is this the primary public str?
JRST [ MOVEI T1,MSTX24 ;Say it is a ps:
MOVEM T1,LSTERR ;Save the error
RET]
SETZ T2, ;Clear
TXNE T1,MS%DIS ;Is this str unavailable
MOVEI T2,1 ;Yes, set the bit
STOR T2,MS%DIS,STRFLG(STR) ;Store it
CALL STRUNA ;Set it unavailable
CALLRET SAVERR ;Error return back
MOVEI T1,MSTAL ;Get address of alias string again
CALL STRSTT ;Get the status again
JRST SAVERR ;Go get the error
SETONE STR%UD,STRFL1(STR) ;Say it is unavailable due to dismount
MOVE T1,RSBIFL(RSB) ;[6011]Get Local or remote bit
TXNE T1,R%LOR ;[6011]Remote?
RETSKP ;[6011]Yes, no need to query the operator
AOS STRNDM(STR) ;[335]Up the # of dismount requests
SKIPN T3 ;Has anyone mounted this str?
SKIPE T4 ;No, are any files open?
SKIPA ;Yes
RETSKP ;No one connected & no files open
; WHILE WE WAIT FOR OPERATOR RESPONSE ALLOW OTHERS TO USE STRUCTURE
MOVE T1,STRFLG(STR) ;Get the previous status
TXNE T1,MS%DIS ;Was it unavailable
RET ;Yes leave it unavailable
CALL STRAVA ;Set it available
CALLRET SAVERR ;Error in LSTERR
RET ;No errors but someone is connected.
;**;[6034]At STRER1:-1L add routine STRSE1
;STRSE1 is called from STRSET to see whether the call to STRSTT failed due
;to MSTX21. If it is then CHECKD might have mounted it behind MOUNTR's back.
STRSE1: CALL GETERR ;[6034]Get the last error
MOVEM T1,LSTERR ;[6034]Save the error
CAIE T1,MSTX21 ;[6034]Is it str not mounted?
JRST SAVERR ;[6034]No, give error
CALL CHECKD ;[6034]yes, Who has it?
JRST SAVERR ;[6034]No one.
HLRZ T4,T3 ;[6034]Get job #
MOVEI T3,DEVX2 ;[6034]Get correct error code
MOVE T1,STRNAM(STR) ;[6034]Get the structure name
MOVE T2,STRALI(STR) ;[6034]Get the structure alias
TMCT <%IProblem with structure %1S: (Alias %2S:)%_%3J, Job %4O>
MOVEI T3,[ASCIZ/Dismount Structure Failed/]
CALLRET BTWTO ;[6034]Send mssg to operators
;**;[6034]Add routine CHECKD
;check whether if a structure is mounted by CHECKD or not
;Calls with MSTAL/structure alias name in ASCIZ
;returns +1 not assign to another job
; +2 assigned to another job probably running CHECKD
; Ac 3 /job #,,-1
CHECKD: HRROI T1,MSTAL ;[6034]Point to ASCII alias
STDEV ;[6034]Get device designator
ERJMP R ;[6034]Error no such device?
MOVE T1,T2 ;[6034]device designator in T1
DVCHR ;[6034]Get the characteristic
ERJMP R ;[6034]Error, no such device
HRRZ T1,T3 ;[6034]Get the right half
CAIE T1,-1 ;[6034]Is it already assign to another job?
RET ;[6034]No, return no one has it
RETSKP ;[6034]Yes, someone has it
;STRER1 - Check to see if we have an error
; or if we need to ask operator what to do
STRER1: SKIPE LSTERR ;Any errors
CALLRET DISFAL ;Yes, tell operator what happened
STRER2: MOVEI T1,STRER3 ;Get end-action address
CALLRET WRDSC ;Ask operator if ok to process request
STRER3: MOVEI RSB,-RSBWTB(T2) ;Load rsb ac
LOAD STR,RSBSS ;Get structure status block again
CALL PSDR ;Parse operator response
JRST STRER2 ;Bad response, try it again
JUMPN T1,STRREF ;Operator refused
CALL STRDM2 ;No, set str unavailable
CALLRET DISFAL ;Can not set str unavailable
JRST STREX0 ;Str unavailable, now check to see EXCLUSIVE
;;STRDM2 - Set str unavailable
;RETURNS +1 Any errors will be saved in LSTERR
; +2 O.K
STRDM2::MOVEI T1,RSBSTA(RSB) ;Get alias again
MOVE T2,[POINT 7,MSTAL]
CALL SIXSEV ;Convert to asciz
CALL STRUNA ;Set str unavailable
CALLRET SAVERR ;Structure is gone!!!!
RETSKP ;Back to caller
;STRDMS - Dismount the structure
; Accepts: MSTAL / name of structure in ASCII
; RETURNS +1 On error, error code in LSTERR
; +2 On success
STRDMS:: HRROI T3,MSTAL ;Set pointer to structure name
MOVE T1,[1,,.MSDIS] ;Dismount structure
MOVEI T2,T3 ;Get address of only argument
SKIPN TSTF ;Skip if debugging
MSTR
ERJMP SAVERR ;Save the error and tell operator
CALL DSTDDB ;Clear structure DDB info
SETONE STR%DT,STRFL1(STR) ;Say unavailable due to dismount
SETZRO STR%UD,STRFL1(STR) ;Say all done with dismount
TXNE F,PORTF ;Are we engaged in a port operation
JRST STRDM1 ;Yes, tell operator and return skip
MOVEI T1,STRNAM(STR) ;Get sixbit structure name and
MOVE T2,[POINT 7,MSTNM] ; And convert to asciz
CALL SIXSEV
CALL WOSDM ;Tell operator of dismount
RETSKP ;Have to check for removal/no removal
STRDM1: MOVE T1,STRNAM(STR) ;Get the structure name
MOVE T2,STRALI(STR) ;Get the structure alias name
TMCT <%IStructure %1S: (alias %2S:) dismounted %_%U%_>
MOVEI T3,[ASCIZ/Dismount Structure Succeeded As Part Of Port Operation/]
CALL BTWTO ;SEND MSSG TO OPERATORS
RETSKP ;All done back to who ever called STRDMS
;STRREF - Operator refuses to dismount structure
;Accepts STR/SSB address
; RSB/Request status block address
;Returns +1 always through STSTBK
STRREF::MOVE T1,STRALI(STR) ;Get the structure alias name
MOVE T2,STRNAM(STR) ;Get the structure name
TMCT <%IOperator refused to dismount structure %2S: (Alias %1S:)%_ for %U%_>
MOVEI T3,[ASCIZ/Dismount Structure Failed/]
CALL BTWTO ;SEND MSSG TO OPERATORS
CALL STSTBK ;[335]Set structure back to previous state
ABTRET (MREQ23,ABT%OP) ;[335] and abort the request
;**;[335]At DISREF:+0 rename the routine to STSTBK
SUBTTL STSTBK - Set STR back to previous state, before the DISMOUNT.
;Accepts STR/structure status block address
;Returns +1 always
STSTBK: SOSLE STRNDM(STR) ;[335]One less, any more dismounts?
JRST STSTB1 ;[335]Yes, better not set it back yet.
SETZRO STR%UD,STRFL1(STR) ;[335]Say all done with dismount
MOVEI T1,RSBSTA(RSB) ;[335]Get SIXBIT alias
MOVE T2,[POINT 7,MSTAL] ;[335]This is place to store 7-bit
CALL SIXSEV ;[335]CONVERT IT
MOVE T1,STRFLG(STR) ;[335]Get structure status
TXNN T1,MS%DIS ;[335]Was it originally unavailable?
JRST STSTB2 ;[335]It was available so set it
CALL STRUNA ;[335]Set str unavailable
CALL DISFA1 ;[335]Can not set structure unavailable
STSTB1: RET ;[335]Common exit point
STSTB2: CALL STRAVA ;[335]Set it available
CALL DISFA1 ;[335]Can not set structure unavailable
CALLRET STSTB1 ;[335]Back to previous, join common exit
SUBTTL STRUNA - SET STR UNAVAILABLE
;RETURNS +1 On error
; +2 Ok
STRUNA::MOVE T1,[POINT 7,MSTAL] ;Get pointer to structure alias
MOVEM T1,MSTRST+.MSSSN
MOVX T1,MS%DIS
MOVEM T1,MSTRST+.MSSST ;Change only the bit to say the str
MOVEM T1,MSTRST+.MSSMW ;Is being dismounted
MOVE T1,[3,,.MSSSS] ;Changing structure status
MOVEI T2,MSTRST
SKIPN TSTF ;Skip if debugging
MSTR
ERJMP R ;Get error in lsterr
RETSKP
;STRAVA - SET STR AVAILABLE
;RETURNS +1 On error
; +2 Ok
STRAVA::MOVE T1,[POINT 7,MSTAL] ;Get pointer to structure alias
MOVEM T1,MSTRST+.MSSSN
MOVX T1,MS%DIS
MOVEM T1,MSTRST+.MSSMW ;Change only the bit to say the str
SETZM MSTRST+.MSSST ;Is being dismounted
MOVE T1,[3,,.MSSSS] ;Changing structure status
MOVEI T2,MSTRST
SKIPN TSTF ;Skip if debugging
MSTR
ERJMP R ;Get error in lsterr
RETSKP
;STDERR - RECOVER FROM AN ERROR WHEN TRYING TO DISMOUNT A STRUCTURE
STDERR: MOVEI T1,MSTNM
TMCT <%IProblem with structure %1A: %J%_%U>
MOVEI T3,[ASCIZ/Dismount Problem/]
CALLRET BTWTO ;SEND MESSAGE TO OPERATOR
;SAVERR - Error routine, reports the error to the operator
; and saves the error in LSTERR.
;RETURNS +1 Always
SAVERR::MOVE T1,STRNAM(STR) ;Get the structure name
MOVE T2,STRALI(STR) ;Get the structure alias
;**;[6034]Change 1 line at SAVERR:+2L JYCW 11-Aug
TMCT <%IProblem with structure %1S: (Alias %2S:) %J%_%U> ;[6034]
MOVEI T3,[ASCIZ/Dismount Structure Failed/]
CALL BTWTO ;SEND MSSG TO OPERATORS
CALL GETERR ;Get the error
MOVEM T1,LSTERR ;Save the error
RET ;After saving the error we return
;DISFAL - Tell the operators that a dismount structure failed and abort
DISFAL::MOVE T1,LSTERR ;Get the last error
CAIN T1,MSTX21 ;Was it structure no longer mounted
JRST DISFA0 ;[6011]Go to common exit
CAIN T1,MSTX24 ;Trying to dismount PS:?
JRST [MOVE T2,STRALI(STR) ;Yes, get the alias
TMCT <%I%1J %2S:%_%U>
MOVEI T3,[ASCIZ/Dismount Structure Failed/]
CALL BTWTO ;Send msg to operators
JRST .+1] ;[6011]Set it back to previous state
TXO T1,FA%TER ;[6011]MONITOR error type
MOVEM T1,RSBERR(RSB) ;[6011]Save error type,,code
MOVE T1,STRPNT(STR) ;Get the pointer to the DDB
CALL DSFGET ;Go find it
$STOP <STRUCTURE NOT FOUND IN DDB..DISFAL::+2>
MOVE T1,DSFE+DSFFLG ;Get the status
TXNE T1,DSF%AV ;Should we set it available/unavailable
JRST [CALL STRUNA ;Unavailable
CALL DISFA1 ;On error say so
SETONE MS%DIS,STRFLG(STR) ;Should be unavailable
JRST DISFA] ;Just continue
CALL STRAVA ;Set it available
CALL DISFA1 ;On error say so
SETZRO MS%DIS,STRFLG(STR) ;Should be available
DISFA: SETZRO STR%UD,STRFL1(STR) ;No longer unavailable due to dismount
SETONE R%STA,RSBIFL(RSB) ;[6011]Set failure bit
MOVE T1,RSBIFL(RSB) ;[6011]Get lock bit
TXZE T1,R%LOC ;[6011]Did this request locked the structure
CALL UNDREM ;[6011]Go unlock
DISFA0: ABTREQ (LSTERR,ABT%IN) ;[6011]Abort the dsk request
JRST STREXT ;[6011]
; Only called when the resulting error is due to a local event
DISFA1: MOVE T1,STRNAM(STR) ;Get the structure name
MOVE T2,STRALI(STR) ;Get the structure alias
TMCT <%IProblem with structure %1S: (Alias %2S:) %J%_%U>
MOVEI T3,[ASCIZ/Cannot Set Structure To Original State/]
CALLRET BTWTO ;SEND MSSG TO OPERATORS
SUBTTL Operator Communication When set EXCLUSIVE fails
; SCREQ1 - SCS Request - dismount structure on all processors
; Until this procedure is set, the following
; temporary local operator request will be the request mechanism
;Must have a continue address in RSBCON
SCREQ1::MOVEI T1,SCREQ2 ;get end action request
CALLRET WODSCI ;Notify operator
SCREQ2: MOVEI RSB,-RSBWTB(T2) ;Load RSB ac
LOAD STR,RSBSS ;Get str status block
CALL RSDR ;Parse answer
JRST SCREQ1 ;Error, try again
JUMPN T1,SCREQ3 ;[6011]Refused
MOVEI T1,RSBSTA(RSB) ;Get SIXBIT alias
MOVE T2,[POINT 7,MSTAL] ;This is the place to store 7-bit
CALL SIXSEV ;Convert it
SKIPE ENQFLG ;[6011]Cluster ENQ enabled?
JRST @RSBCON(RSB) ;[6011]No, do it the old way
JRST SENNEB ;[6011]Send remote dismount message to NEBULA
; Operator refused to continue with dismount
SCREQ3: MOVE T1,STRALI(STR) ;Get the structure alias name
MOVE T2,STRNAM(STR) ;Get the structure name
TMCT <%IOperator refused to dismount structure %2S: (Alias %1S:)
from the other system for %_%U%_>
MOVEI T3,[ASCIZ/Cannot Set Structure Exclusive/]
CALL BTWTO ;SEND MSSG TO OPERATORS
CALL STSTBK ;[335] Abort the disk request and return
ABTREQ (MREQ23,ABT%OP) ;[335][6011] and abort the request
SKIPE ENQFLG ;[6011]Pre 7 MONITOR?
RET ;[6011]Yes, just return
SETONE R%STA,RSBIFL(RSB) ;[6011]Set failure bit
MOVE T1,RSBIFL(RSB) ;[6011]Get status
TXZN T1,R%LOC ;[6011]Did this request locked the structure
JRST SCREQ4 ;[6011]No
MOVE T2,STRFL1(STR) ;[6011]Get the status
LOAD T3,RSBTYP ;[6011]Get the type
CAIN T3,.DSMST ;Dismount?
CALL RELLOC ;[6011]Unlock
SCREQ4: CALLRET @RSBABO(RSB) ;[6030]Continue at failure address and return
SUBTTL Send a DISMOUNT Message to NEBULA
;[6011]SENNEB Send dismount message to Nebula. Send only one remote dismount
;message.
;Accepts RSB and STR
;Returns back to scheduler
SENNEB: MOVE T1,STRFL1(STR) ;Get the flag word
TXNE T1,STR%SN ;Did we send a dismount message?
JRST SCSNE0 ;Yes, no need to send another
;Build Structure name block
STKVAR <<DVBLK,3>>
CALL PBINIT ;Set up for creating building blocks
MOVE T1,[3,,.STRDV] ;length,, structure name block
MOVEM T1,DVBLK ;Save it in the message
MOVE T2,[POINT 7,MSTAL];Set up pointer for alias
MOVEI T1,STRALI(STR)
CALL SIXSEV ;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
DMOVE T1,MSTAL ;Get the ASCIZ name
MOVEM T1,1+DVBLK ;Put it in the message
MOVEM T2,2+DVBLK ;Put it in the message
MOVEI T1,DVBLK ;Get address of the structure name block
CALL PBBLK ;Add it
;Build Node name block
;Get node name from RSB
LOAD T4,RSBNSM ;Get the number of nodes
MOVEI T1,RSBRND(RSB) ;Start at the beginning
SCSNE: MOVE T2,[.NDESZ,,.NDENM] ;Size,,node block
MOVE T3,(T1) ;Get the node name
DMOVEM T2,TEMPX ;Goes here
PUSH P,T1 ;Save address of node name
MOVEI T1,TEMPX ;Add it to the node block
CALL PBBLK
POP P,T1 ;Restore address
ADDI T1,2 ;Go to the next node
SOJG T4,SCSNE ;Get the next node
;Build Galaxy header
MOVE T2,PBBPT ;Get the end of the message
SUBI T2,TBUF ;Compute size of IPCF message
HRL T1,T2 ;Get length,,msgtype
HRRI T1,.NRDSM ;
MOVX T2,MF.NEB ;Nebula message
AOS T3,UNIQUE ;ACK code
CALL GALHDR ;Build the Galaxy header
MOVX T1,.DMDIS ;Assume it is for dismount
LOAD T2,RSBTYP ;Get the type
CAIN T2,.DSMST ;Dismount?
SKIPA
MOVX T1,.DMSEX ;Set exclusive
MOVEM T1,TBUF+.OFLAG ;Save it
MOVEI T1,.APORN ;ORION'S PID
PUSH P,T3 ;Save the ACK code
CALL TRANG ;Send it
POP P,T3 ;Restore ACK code
SETONE STR%SN,STRFL1(STR) ;Say we have send a dismount message
SCSNE0: MOVEM T3,RSBRAC(RSB) ;Save ACK code in RSB
LOAD T1,STRSEN,STRSMN(STR) ;Get the number of dismount msg sent
AOS T1 ;Add one more
STOR T1,STRSEN,STRSMN(STR) ;Save it
RET
SUBTTL Build and Send a Cancel Remote Dismount Message to NEBULA
;[6011]
;Build and send cancel remote dismount message
;Accepts T1/Type of cancel (NC%CDM or NC%CSE) and RSB
NEBCAN: MOVEM T1,TBUF+.OFLAG ;Set the cancel type
MOVE T1,[.OARGC+1,,.NCDSM] ;BUILD GALAXY HEADER
MOVX T2,MF.NEB ;Nebula message
MOVE T3,RSBRAC(RSB) ;Get remote ACK
CALL GALHDR ;Build the Galaxy header
SETZM TBUF+.OARGC ;No arg count word
MOVEI T1,.APORN ;MESSAGE GOING TO ORION
CALLRET TRANG ;SEND CANCEL REQUEST TO ORION
SUBTTL Process NEBULA Dismount ACK
;[6011]
; PNEDAC - Process DISMOUNT ACK from NEBULA.
;The ACK can be in response to a SET EXCLUSIVE or a DISMOUNT/REMOVE command.
;PNEDAC translates the ACK to an ASCIZ text and informs the operator what the
;results of the remote dismounts were. If there was a failure, a QUERY will be
;sent to the operator. If all the remotes are successful
;or the operator RESPOND with PROCEED, PNEDAC will continue processing at
;@RSBCON on success and at RSBABO on abort.
; RBUF/ IPCF MESSAGE FROM NEBULA via ORION, MESSAGE TYPE = .NTDAK
; RETURNS +1: ALWAYS
;Build status WTO about remote dismounts
PNEDAC: SETZM PNFLAG ;Clear PNEDAC FLAG
MOVEI T1,.STRNM ;Get the structure name block
CALL ORNBLF ;
JRST KBADM ;Bad message from NEBULA (BUG)
MOVE T2,0(T1) ;Get the structure name
MOVEM T2,STNAM ;Save it
MOVEI T1,.STSBK ;Get node name
CALL ORNBLF
JRST KBADM ;No node block, bad message from NEBULA (BUG)
; Uses T2/the arg block length and T1/address of block
MOVEM T1,ADDRBK ;Save address of block
IDIVI T2,2 ;Two words/entry
MOVEM T2,NUMNOD ;Save number of nodes
MOVE T4,RBUF+.OFLAG ;Get the flag
MOVEM T4,DFLAG ;Save it
SETZM FNDRSB ;Initialize found RSB flag
; Continued on next page
;Continued from previous page
; Get exclusive pending RSB
PNEDA: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
CALL PRQPID ;CLEAN UP REQUEST QUEUE FIRST
PNEDA0: CALL QMSCAN ;GET ADDRESS OF NEXT RSB
JRST [SETOM FNDRSB ;No RSB found
SKIPE PNFLAG ;First time through?
JRST PNEDER ;No, all done
JRST PNEDA7] ; must have been canceled
MOVEI RSB,-RSBLNK(T2) ;Get RSB adddress
MOVE T3,RSBRAC(RSB) ;Get ACK code from entry
CAME T3,RBUF+.MSCOD ;Does it match code in IPCF message?
JRST PNEDA0 ;No,, continue scan
LOAD STR,RSBSS ;Get str status block
HRL T3,ADDRBK ;Get the source
HRRI T3,RSBRND(RSB) ;Destination
BLT T3,RSBRND+15(RSB) ;Do the transfer
LOAD T1,STRSEN,STRSMN(STR) ;[6011](TBD)Get message sent counter
SOS T1 ;[6011]One less
STOR T1,STRSEN,STRSMN(STR) ;Put it back
SETZRO STR%SN,STRFL1(STR) ;Clear send dismount message to NEBULA
JRST PNEDA1
;Print the success nodes first
PNEDA7: MOVE T1,ADDRBK ;Get the nodes status block
SKIPA
PNEDA1: MOVEI T1,RSBRND(RSB) ;Point to remote node status
MOVEM T1,ADDRBK ;Save it for later
SETZM PNFLAG ;Clear the header flag
MOVE T2,NUMNOD ;Get the number of nodes in message
TMCT <%I> ;Initialize TMCMSG buffer
PNEDA2: MOVE T4,.STNST(T1) ;Get status word
TXNN T4,ST%SSD ;Success?
JRST PNEDA3 ;No
SKIPE PNFLAG ;Did we print the header?
IFSKP. ;No
MOVE T3,STNAM ;Get the structure name
TMCT <Structure %3S: dismounted from >
SETOM PNFLAG ;Set the header flag
ELSE.
TMCT <, >
ENDIF.
MOVE T3,.STNNE(T1) ;Yes, get the node name
TMCT <%3S::> ;Add it to the message
PNEDA3: ADDI T1,.STRLN ;Go to the next block
SOJN T2,PNEDA2 ;Get the next block if there is one
TMCT <%_>
; Continued on next page
;Continued from previous page
MOVE T1,DFLAG ;Get status flag word
TXNE T1,DS%SUC ;All success?
JRST PNEDA6 ;Yes no need to send WTOR
;Print the failure nodes
MOVE T1,ADDRBK ;Get the nodes status block
MOVE T2,NUMNOD ;Get number of nodes
PNEDA4: MOVE T4,.STNST(T1) ;Get status word
TXNE T4,ST%SSD ;Success?
JRST PNEDA5 ;Yes, get the next node
MOVE T3,STNAM ;Get the structure name
MOVE T4,.STNNE(T1) ;Yes, get the node name
TMCT <Structure %3S: failed to be dismounted from %4S::%_Error - >
MOVE T3,.STNST(T1) ;Get the error word
TXZN T3,ST%TER ;From MONITOR
IFSKP. ;Yes
TMCT <%3J>
ELSE.
CALL FNDERR ;Find the address of the error string
TMCTI <T3>
ENDIF.
SKIPN FNDRSB ;No RSB means request canceled
TMCT <%_Correct the problem indicated on %4S::%_>
PNEDA5: ADDI T1,.STRLN ;Go to the next block
SOJN T2,PNEDA4 ;Get the next block
MOVE T1,RBUF+.OFLAG ;Get the flag
TXNN T1,DS%SUC ;Dismount from all?
SKIPE FNDRSB ;Don't have a request
JRST PNEDA6 ;No need for WTOR
TMCTI <RESHDR> ;Add tail of message
MOVEI T3,[ASCIZ/Dismount Query/]
TXNE T1,DS%SEX ;Is this a dismount ACK via SET EXCLUSIVE?
MOVEI T3,[ASCIZ/Set Structure Query/] ;Yes
MOVEI T1,PNERSP ;Continue here
MOVEI T2,RSBWTB(RSB) ;Get WTB address
CALLRET BTWTOR ;Send WTOR
; Continued on next page
;Continued from previous page
;Here there is no need to send a WTOR because either the request was canceled
;or all the remote dismounts were successful
PNEDA6: MOVEI T3,[ASCIZ/Remote Dismount Status/]
CALL BTWTO ;Tell the operator
SKIPN FNDRSB ;Do we have a request for this ACK
JRST PNEDEX ;Yes, continue with the request
;Tell operator to remotely mount the structure that just got remotely
;dismounted.
MOVE T1,ADDRBK ;Get the address of structure block
MOVE T2,NUMNOD ;Get number of nodes
MOVE T3,STNAM ;Get the structure name
TMCT <%IDismount request has been canceled.
However, structure %3S: has been dismounted from nodes:%_>
PNEDC1: MOVE T4,.STNST(T1) ;Get status word
TXNN T4,ST%SSD ;Success?
JRST PNEDC3 ;No, get the next node
MOVE T3,.STNNE(T1) ;Yes, get the node name
TMCT <%3S:: > ;Add it
PNEDC3: ADDI T1,.STRLN ;Next
SOJG T2,PNEDC1 ;[6017]
MOVEI T3,[ASCIZ/Dismount Status/]
CALLRET BTWTO
; Continue with the request. Could be a set exclusive command or a dismount
; with removal.
PNEDEX: LOAD STR,RSBSS ;Get str status block
MOVEI T1,RSBSTA(RSB) ;Get SIXBIT alias
MOVE T2,[POINT 7,MSTAL] ;This is the place to store 7-bit
CALL SIXSEV ;Convert it
CALL @RSBCON(RSB) ;Yes, continue from where we left of
PNEDER: RET
;Parse response from operator
PNERSP: MOVEI RSB,-RSBWTB(T2) ;Load RSB ac
LOAD STR,RSBSS ;Get str status block
SETZM FNDRSB ;We have a request
CALL RSDR ;Parse answer
JRST PNEDA1 ;Error, try again
JUMPN T1,SCREQ3 ;Abort
MOVEI T1,RSBSTA(RSB) ;Get SIXBIT alias
MOVE T2,[POINT 7,MSTAL] ;This is place to store 7-bit
CALL SIXSEV ;Convert it
JRST PNEDEX ;Go to common code
SUBTTL Process NEBULA Remote Dismount Errors
;[6011]
;Accepts T3/error bit
;Returns T3/address of error text string
FNDERR: SAVET ;Save T ACs
JFFO T3,.+1 ;Pickup displacement into error table
CAIL T4,STLOW ;Check for legal error
CAILE T4,STHIGH ;Check for legal error
SETZ T4,
MOVE T3,NEBERR(T4) ;[6032]Return address of error string in T3
RET
NEBERR: [ASCIZ/Unknown error/]
[ASCIZ/STRUCTURE SUCCESSFULLY DISMOUNTED/]
[ASCIZ/SENDER WAITING FOR A HELLO RESPONSE/]
[ASCIZ/LISTENER HAS NOT RECEIVED HELLO MSG/]
[ASCIZ/SENDER LISTENER ARE CRASHED/]
[ASCIZ/NO SUCH NODE/]
[ASCIZ/PRE-7 MONITOR/]
[ASCIZ/NO DECNET IN MONITOR/]
[ASCIZ/SCS% DETECTED NODE LEFT THE CLUSTER/]
[ASCIZ/INFO% UNABLE TO OBTAIN SOFTWARE ENVMEN/]
[ASCIZ/DISMOUNT CANCELLED IN TIME/]
[ASCIZ/MONITOR ERROR DISMOUNTING STRUCTURE/]
[ASCIZ/ORION ERROR/]
[ASCIZ/QUASAR ERROR/]
[ASCIZ/NEBULA ERROR/]
[ASCIZ/MOUNTR ERROR/]
; WODSCI - Tell Operator to find all other processors having
; the specified structure mounted so that they can dismount it.
;RSB and STR
WODSCI: STKVAR <CONADR,TRSB> ;Allocate room for continue address, RSB
MOVEM T1,CONADR ;Save continue address for CALL BTWTOR
MOVEM RSB,TRSB ;[6011]Save RSB
MOVE T2,STRNAM(STR) ;Get structure name
MOVE T3,STRALI(STR) ;Get structure alias
TMCT <%IStructure %2S: (Alias %3S:) is in use by%_>
SKIPN ENQFLG ;[6011]Cluster ENQ enabled?
IFSKP. ;[6011]No, must be a pre 7 release
TMCT <another processor in the cluster>
JRST WODSC1 ;[6011]Go finish of WTOR message text
ENDIF.
CALL GETNOD ;[6011]Get the systems which have it mounted
JRST WODSC2 ;[6013]No one has it????
LOAD T2,RSBNSM ;Get number of nodes which has it mounted
SKIPN T2 ;If no node
JRST STREX2 ;[6013]Try to set it exclusive again
WODSC0: MOVE T1,RSBRND(RSB) ;Get the node name
TMCT <%1S::> ;Add it to the message
SOJLE T2,WODSC1 ;Any more?
TMCT <, > ;Yes, add a comma
ADDI RSB,2 ;Next node
JRST WODSC0 ;Get the next node
WODSC2: SETZ T1, ;[6013]Start at the beginning
SKIPE T2,BADNOD(T1) ;[6013]Do we have a bad node?
IFSKP.
TMCT <another processor in the cluster>
JRST WODSC1 ;[6013]No one
ENDIF.
TMCT <the following nodes which were unreachable for structure
information:%_>
WODSC4: TMCT <%2S::> ;[6013]Display BAD node
AOS T1 ;[6013]Next BAD node
SKIPN T2,BADNOD(T1) ;[6013]Do we have one?
IFSKP. ;[6013]Yes
TMCT <, >
JRST WODSC4
ENDIF.
WODSC1: TMCT <%_and can't be removed from the cluster unless it's dismounted
with NO-REMOVAL from the systems.
Respond with PROCEED to dismount the structure from the
above systems or
Respond with ABORT to terminate the dismount request%_ > ;[6026]
MOVE RSB,TRSB ;Get back RSB
MOVEI T2,RSBWTB(RSB) ;Get WTB address
LOAD T3,RSBTYP ;Get the type
CAIE T3,.DSMST ;Dismount?
IFSKP.
MOVEI T3,[ASCIZ/Dismount Query/]
ELSE.
MOVEI T3,[ASCIZ/Set Structure Command Query/]
ENDIF.
MOVE T1,CONADR ;Get the continue address
CALL BTWTOR ;Query the operator
RET
SUBTTL Find Out Which Node(s) in the Cluster has the Structure Mounted
;[6011]
;Do config%
;Accepts STR
; RSB
;Returns +1 on failure
; BADNOD/Nodes in the Cluster that might have the structure mounted
; but we don't know
;Returns +2 on success
; NAMBLK/ASCIZ node name
; NUMBLK/CI-node number
; RSBRND+n/SIXBIT node names
; RSBNNM/number of node
; +2 on success
GETNOD: STKVAR <NCOUNT,TRSB> ;Allocate space for which node mounted the str
;and RSB.
SETZM NCOUNT ;Make sure we start at zero
MOVEM RSB,TRSB ;Save RSB
SETZM BADNOD ;[6013]Clear BAD node block
MOVE T1,[BADNOD,,BADNOD+1] ;[6013]Get source,,destination
BLT T1,BADNOD+6 ;[6013]Clear it
SETZM RSBNNM(RSB) ;No one has it mounted yet
CALL GCNFIG ;Get the node and their CI node number
SOJLE T3,RSKP ;We are the only one, set it exclusive
STOR T3,RSBNO1 ;Remember how many node in cluster
MOVEI T4,BADNOD ;[6013]Get address of BAD nodes in the cluster
MOVEM T4,BADADR ;[6013]Save it
;Can't use T3. T3 must be perserved when routines are called from this routine
;Check which systems have the structure mounted. RSB is saved in TRSB because
;it gets trashed. Make sure RSB is strored before leaving this routine
MOVEI T4,2 ;Start at the second CI-node number
GETNO1: HLRZ T1,NUMBLK(T4) ;Get the CI-node number
MOVEM T1,INFBLK+.INCID ;Store it in INFO arg block
MOVE T1,[.INMSR,,.INAC2+2] ;Function,,Length
MOVEM T1,INFBLK+.INFUN ;Store it
MOVE T1,[.MSGSI+1,,.MSGSS] ;Get length,,function
MOVEM T1,INFBLK+.INAC1 ;Store it in INFO block
MOVEI T1,MSTRST ;MSTR block
MOVEM T1,INFBLK+.INAC2 ;Address goes here
MOVEI T1,STRALI(STR) ;Make pointer to alias
MOVE T2,[POINT 7,MSTAL] ;DO SAME FOR STRUCTURE ALIAS
MOVEM T2,MSTRST+.MSGSN ;Store it in MSTR block
CALL SIXSEV ;Convert into ASCIZ
MOVEI T1,INFBLK ;Get the INFO arg block
INFO%
ERJMP GETNO3 ;Local error, get the next node
TXZE T1,IN%RER ;[6013]Any remote error?
JRST GETNO4 ;Yes, skip this and onward
MOVE T1,NAMBLK(T4) ;Get pointer to node
MOVEI T2,RSBRND(RSB) ;Store name here
CALL SEVSIX ;Convert to SIXBIT
MOVE T1,NCOUNT ;Get counter for who has it mounted
AOS T1 ;Increment it
MOVEM T1,NCOUNT ;Store it back
ADDI RSB,2 ;Next RSBNNM
GETNO2: AOS T4 ;Next node number
SOJG T3,GETNO1 ;Next node name
MOVE RSB,TRSB ;Get RSB
MOVE T1,NCOUNT ;Get who has it mounted counter
STOR T1,RSBNSM ;Store it in RSB
SKIPG T1 ;[6013]Do we have at least one node
RET ;[6013]No
RETSKP ;No more all done
; Detected that a node in the Cluster is running a 7 Monitor. Save the SIXBIT
; node name in BADNOD and display them in WODSCI:
GETNO4: CAIN T1,MSTX21 ;[6013]Structure is not mounted?
JRST GETNO2 ;[6013]Yes, no need to add this node
GETNO3: MOVE T2,BADADR ;[6013]Get address of BAD nodes
MOVE T1,NAMBLK(T4) ;Get pointer to node
MOVEI T2,(T2) ;Store name here
CALL SEVSIX ;Convert to SIXBIT
AOS T2 ;[6013]Increment to next word
MOVEM T2,BADADR ;[6013]Save it
JRST GETNO2 ;[6013]Get the next node
SUBTTL Get The Cluster Node Name and CI Node Number
;[6010]
;GCNFIG - returns the number of nodes in the cluster.
;Returns +1 Success T3/number of nodes in the cluster
; NAMBLK/Node name block
; NUMBLK/CI node number block
GCNFIG: MOVEI T1,CNFSIZ ;Size of CNFIG block
MOVEM T1,NAMBLK+.CFNND ;Store it in the arg block
MOVEI T1,.CFCND ;Get function code
MOVEI T2,NAMBLK ;Get the arg address
CNFIG% ;Get the node name
ERJMP STOP ;Shouldn't fail
MOVEI T1,CNFSIZ ;Size of CNFIG block
MOVEM T1,NUMBLK+.CFLEN ;Store it in the arg block
MOVEI T1,.CFCSE ;Get function code
MOVEI T2,NUMBLK ;Get the arg address
CNFIG% ;Get the node number
ERJMP STOP ;Shouldn't fail
HLRZ T2,NUMBLK ;Get number of words returned
SOS T2 ;Don't count the first word
HLRZ T3,NAMBLK ;Get number of node in the cluster
CAME T3,T2 ;Are the number and name the same?
JRST GCNFIG ;No, try again
RET
;RSDR - Parse operator response to request for other processor dismount
;
RSDR: CALL COMNDI ;Initialize for COMND jsys
MOVEI T2,[FLDDB. .CMKEY,,RSDRKS] ;Setup keyword parse
CALL COMNDX ;Parse keyword
JRST [ MOVEI T1,[ASCIZ/Response must be PROCEED or ABORT/]
CALLRET RSPERR] ;Incorrect response, give error
HRRZ T2,(T2) ;Get address of keyword processr
CALLRET (T2) ;Dispatch
RSDRKS: RSDRSE,,RSDRSE
[ASCIZ/ABORT/],,RSDRNO
[ASCIZ/PROCEED/],,RSDRSI
RSDRSE==.-RSDRKS-1
RSDRNO::SETO T1,
RETSKP
RSDRSI::SETZ T1,
RETSKP
SUBTTL STRMNT - MOUNT A STRUCTURE
;ACCEPTS: RSB/ CURRENT REQUEST BLOCK
; STR/ STRUCTURE TO MOUNT
;RETURNS: +1/ FAILURE
; +2/ SUCCESS
; It is assumed the structure specified is not logically mounted...
STRMNT: SKIPE ENQFLG ;[6011]Pre 7 monitor?
JRST STRMN ;[6011]Yes, no need to check locking
; Check to see if we are doing a remote mount. If we are, the mount request
; must be from the same node that did the remote dismount.
MOVE T1,RSBIFL(RSB) ;[6011]Get flag
TXNN T1,R%LOR ;[6011]Local or remote
IFSKP. ;[6011]Remote
SKIPE T1,STROBN(STR) ;[6021]No need to check if no node name
CAMN T1,RSBOBN(RSB) ;[6020]Is the node we are doing the remote
;mount the same as the node we did a remote
;dismount
JRST STRMN ;Yes, by pass locking check
SKIPN T2,RSBSTN(RSB) ;Get the structure name
MOVE T2,RSBSTA(RSB) ;No name, use the alias
MOVE T3,RSBSTA(RSB) ;and alias
TMCT <%IUnable to mount structure %2S: (Alias %3S:)
Structure %2S: (Alias %3S:) is currently being dismounted
with removal by node %1S::>
MOVEI T3,[ASCIZ/Mount Status/]
CALLRET BTWTO ;[6011]Inform operator
ENDIF.
; Check and see if it is reasonable to mount this structure
MOVE T1,STRFL1(STR) ;[6011]Get status
TXNE T1,STR%LE+STR%LD ;[6011]Do we have it locked?
JRST STRMN ;[6011]Yes, no need to check who has it locked
CALL WHOEQC ;[6011]Anyone has it locked
JRST STRMN ;[6011]No one has it
SKIPN T2,RSBSTN(RSB) ;Get the structure name
;**;[6037]At STRMNT:+27L change 1 line
MOVE T2,RSBSTA(RSB) ;[6037]Use the alias
MOVE T3,RSBSTA(RSB) ;and alias
TMCT <%IUnable to mount structure %2S: (Alias %3S:)
Structure %2S: is locked by node %1S::>
MOVEI T3,[ASCIZ/Mount Status/]
CALL BTWTO ;[6011]Inform operator
;**;[6037]At STRMNT:+34L change 1 line
MOVEI Q1,MSTX33 ;[6037]Get the error code
JRST STRMEX
STRMN: MOVE T1,RSBSTA(RSB) ;Get alias in request
MOVEM T1,DSFE+DSFSPC ;Set it in test DDB
MOVEI T1,.DVSTR ;Get structure type
MOVEM T1,DSFE+DSFTYP ;Set it
CALL DSFLOC ;Go look for it
JRST STRMN0 ;Don't have DDB. Have no reason not to mount
MOVE T2,DSFE+DSFFLG ;Get the flags
TXNE T2,DSF%IG ;Is it ignore?
JRST [MOVEI Q1,MREQ27 ;Get the error code
JRST STRMEX] ;Yes, reject request based on caller
SKIPE DSFE+DSFPNT ;Get address of SSB for structure
JRST [ABTRET (ABRTNR)] ;Already mounted, reject the request
CALL NEWSTA ;Get new status of the structure based on DDB
JFCL ;Not mounted
TXNE T1,MS%DIS ;Is this structure available to be mounted?
JRST [MOVEI Q1,MSTX33 ;Get the error code
JRST STRMEX] ;No, reject request based on caller
MOVE T1,STRFL1(STR) ;Get the other status word
TXNE T1,STR%DT ;Is it being dismounted?
JRST [MOVEI Q1,MSTX33 ;Yes, get the error code
JRST STRMEX] ;Reject request based on requestor
STRMN0: MOVE T1,STR ;Get the address of the SSB
CALL CHKAVA ;Check availability status of the SSB
JRST [MOVEI Q1,MSTX33 ;Get the error code
JRST STRMEX] ;Not available, reject request based on caller
; Now we want to set up the MSTR to mount the structure
; First argument word is to contain pointer to ASCIZ string for structure name
MOVE T2,[POINT 7,MSTNM] ;GET PTR TO CONVERT STR NAME TO ASCIZ
MOVEM T2,MSTRBK+.MSTNM ;STORE POINTER FOR LATER MSTR CALL
MOVEI T1,RSBSTN(RSB)
SKIPN (T1) ;IF NO PHYSICAL NAME WAS SPECIFIED,
MOVEI T1,RSBSTA(RSB) ; USE ALIAS
CALL SIXSEV
; Second argument word is pointer to ASCIZ string for structure alias
MOVE T2,[POINT 7,MSTAL] ;DO SAME FOR STRUCTURE ALIAS
MOVEM T2,MSTRBK+.MSTAL
MOVEI T1,RSBSTA(RSB)
CALL SIXSEV
; Third argument word is to contain number of units in structure
LOAD T1,STRUNI,(STR) ;GET NUMBER OF UNITS IN STRUCTURE
HRRZM T1,MSTRBK+.MSTFL ; AND DON'T SET ANY SPECIAL ACTION FLAGS
; Beginning with the 4th argument word build three word blocks, one block for
; each disk in the structure. The three word block contains the CKU for the
; disk drive.
; For this loop, T1 pointers to the current STRADD and controls the loop
; T2 points to the destination in the MSTR block for the CKU.
MOVNS T1 ;NEGATE NUMBER OF UNITS
MOVSS T1 ;SET UP INDEX FOR DISK ADDRESS
HRRI T1,STRADD(STR) ;Point to the first disk drive status block
MOVEI T2,MSTRBK+.MSTUI ;SET UP INDEX FOR STORING DISK INFO
STRMN1: MOVE DSK,(T1) ;GET ADDRESS OF DISK STATUS BLOCK
LOAD T3,DSKCHN,(DSK) ;GET DISK CHANNEL
MOVEM T3,.MSTCH(T2) ;STORE FOR MSTR CALL
LOAD T3,DSKCTR,(DSK) ;GET CONTROLLER
CAIN T3,<.RTJST(-1,DOP%K2)> ;ALL ONES?
SETO T3, ;YES, MAKE FULL-WORD
MOVEM T3,.MSTCT(T2) ;STORE IT
LOAD T3,DSKDRV,(DSK) ;Get drive unit number
MOVEM T3,.MSTUN(T2) ;Store for MSTR call
ADDI T2,1+.MSTUN ;Increment destination for next try
AOBJN T1,STRMN1 ;Go for another disk drive if any
SUBI T2,MSTRBK ;GET LENGTH OF ARGUMENT BLOCK
MOVEI T1,.MSMNT ;Get MSTR function type (mount a structure)
HRL T1,T2 ;Get length
MOVEI T2,MSTRBK ;GET ADDRESS OF ARGUMENT BLOCK
MSTR ;FINALLY, MOUNT IT
ERJMP STMERR ; SOMETHING WENT WRONG
CALL RELLOC ;[6014]Unlock the structure
SETZM STRELC(STR) ;[6012]No longer locked for dismount
SETZRO STR%LD+STR%OB,STRFL1(STR) ;[6016]Clear lock bit
MOVE T1,RSBSTA(RSB) ;GET STRUCTURE ALIAS
MOVEM T1,STRALI(STR) ; AND STORE
; We should also create a str entry in DDB for this structure
CALL ISTDDB ;Go try to create
CALL [SKIPE DSFE+DSFPNT ;Already have one, already pointing at SSB?
$STOP <Detected previously set pointer in DDB during STR mount>
RET] ;No, continue
HRRZM STR,DSFE+DSFPNT ;Need to update pointer
CALL DSFUDE ;Update the entry pointer
$STOP <Update of previously known DDB with DSFUDE failed>
SKIPE STRPNT(STR) ;Already pointing at DDB?
$STOP <Detected previously set pointer in SSB during STR mount> ;Yes
MOVEM T1,STRPNT(STR) ;Save the pointer to the DDB
SETONE STR%MT,STRFL1(STR) ;Set structure mounted
STRMN3: LOAD T4,STRMCT,(STR) ;GET NUMBER OF DISKS IN STRUCTURE
MOVNS T4
HLRZS T4
HRRI T4,STRADD(STR)
STRMN4: MOVE DSK,(T4)
CALL DSTGIV ;GET STATUS OF GIVEN UNIT
CALL STOP ;THERE IS AN INCONSISTENCY
MOVEM T1,DSKFLG(DSK) ;STORE STATUS OF UNIT
MOVE T1,STRALI(STR) ;GET ALIAS
MOVEM T1,DSKSTA(DSK) ; AND STORE
AOBJN T4,STRMN4
SKIPGE RSBITN(RSB) ;Is the MOUNT from operator?
IFSKP.
CALL WOSMT ;[6015]Tell operator of success
ELSE.
CALL KSMTE ;[6015]Let KSMT handle the message
ENDIF.
STRMN5: CALL NEWSTA ;Get the new status
JFCL ;Don't care
CALL STSTR ;Set the structure
JRST [CAIE T1,-1 ;[6011]Couldn't set exclusive
JRST STRMNE ;[6015]No
SETONE STR%ME,STRFL1(STR) ;[6011]Set bit in flag word
JRST STRMN6]
STRMNE: RETSKP ;[6015]Common exit point
SUBTTL Apply Structure Exclusive Attribute after it mounted
;[6011] Fail to set the structure exclusive attribute.
; We get here only if we can't set the structure exclusive as part of the
; mount.
; At this point there is no RSB for the set exclusive.
STRMN6: SKIPE CFSB ;CFS?
SKIPE ENQFLG ;[6011]Cluster ENQ enabled?
JRST STRMNE ;[6015]No
MOVEI T1,.DSEXC ;[6015]Set up exclusive switch request
CALL OPRSB ;[6015]Get RSB
JRST [TMCT <%IFailed to acquire RSB for exclusive procedure>
MOVEI T3,[ASCIZ/Applying Structure Attribute Status/]
CALLRET BTACKT] ;Error abort
MOVE T1,RBUF+.MSCOD ;[6014]Get operator's PID
MOVEM T1,RSBPID(RSB) ;[6014]Save it for later
STOR STR,RSBSS ;[6011]Save SSB address in RSB
STRMN7: CALL GETLOC ;Lock the structure
JRST [CALL WHOENQ ;Failed, find out who has it
JRST STRMN7 ;No one lets try again
MOVEI T3,[ASCIZ/Applying Structure Attribute Status/]
CALL BTACKT ;[6011]Tell operator
ABTREQ (ABRTNR) ;[6015]Get rid of RSB
JRST STRMNE] ;[6011]failed
MOVEI T1,STRMNP ;[6015]Get continue routine address
MOVEM T1,RSBCON(RSB) ;[6011]Save it
MOVEI T1,STRMNA ;[6015]Get abort routine address
MOVEM T1,RSBABO(RSB) ;[6011]
CALL SCREQ1 ;[6015]Failed get cfs compliance
JRST STRMNE ;[6015]Go to common exit
; STRMNP continue with setting the structure exclusive after receiving the
; dismount ACK.
; Accepts RSB and STR.
; Returns via STRMN3.
STRMNP: SKIPE T1,STRPNT(STR) ;Get address of DDB
CALL DSFGET ;Get it
JRST STRMNA ;[6015]Not here, must have been UNDEFINE
CALL NEWSTA ;Get the new status
JFCL ;Don't care
CALL STSTR ;Set the structure
JRST [CAIE T1,-1 ;[6011]Couldn't set exclusive
JRST .+1 ;[6011]No
SETONE STR%ME,STRFL1(STR) ;[6011]Set bit in flag word
JRST STRMN6]
; Finally, we have applied the structure's exclusive attribute.
; Now, lets see if we can unlock the structure.
STRMNA: SETZRO STR%ME,STRFL1(STR) ;[6015]Clear can't set exclusive bit
CALL UNDREM ;[6011]Unlock if we can
ABTRET (ABRTNR) ;[6015]Get rid of RSB
;STMERR - ERROR IN MOUNTING A STRUCTURE
STMERR: SAVEQ
MOVEI T1,.FHSLF ;GET THE ERROR
GETER
HRRZS T2 ;GET ERROR ONLY
MOVE Q1,T2 ;[331] Copy error code to safe place
CALL DDSERR ;[331] Tell operator of problem
CAIN Q1,MSTRX5 ;[331] Is error drive offline?
RET ;[331] Yes, don't abort the request
; STRMEX - Exit routine for STRMNT for a structure which can't be mounted
; because of its disk or structure attributes. The purpose of this
; routine is to reject the request based on the caller i.e from user
; or operator.
;Accepts - RSB/Request status block
; Q1/error code.
;Returns - +1 to caller of STRMNT. Indicates failure
STRMEX: SKIPL RSBITN(RSB) ;Is it from operator
JRST [ABTRET (Q1,ABT%IN)] ;No, must be from user, reject the request
RET ;Yes, let KSMT handle the error
;DDSERR - RECOVER FROM AN ERROR WHEN TRYING TO MOUNT A STRUCTURE
DDSERR: MOVEI T1,MSTNM
TMCT <%IProblem with structure %1A:%_%J%_%U>
MOVEI T3,[ASCIZ/Mount Problem/]
CALLRET BTWTO ;SEDN MESSAGE TO OPERATOR
;SUBTTL SYMSET - BUILD AND LOG SYSERR ENTRY FOR DISK DRIVE STATUS CHANGE
;ACCEPTS: T1/ FUNCTION CODE (CS%ADV = SET AVAILABLE, CS%DDV = SET UNAVAILABLE)
; T2/ ADDRESS OF ASCIZ REASON, OR 0 IF NO REASON GIVEN
; Q2/ CHANNEL,,DRIVE
; DSK/ ADDR OF DISK STATUS BLOCK
;RETURNS: +1, ALWAYS
SYMSET: SAVEQ
SETZM SYRMSG ;ZERO OUT SYSERR MESSAGE AREA
MOVE T4,[SYRMSG,,SYRMSG+1]
BLT T4,SYRMSG+SYRMSZ-1
; TRANSFER OPERATION CODE AND REASON TO MESSAGE
STOR T1,CS%OPR,SYRMSG+CS%OPW ;STORE OPERATION CODE INTO MESSAGE
MOVEI Q1,SYRHSZ+CS%SIZ ;ASSUME NO REASON GIVEN
SKIPN T1,T2 ;REASON GIVEN?
JRST SYMSE1 ;NO
MOVS Q3,T1 ;YES, COPY ADDRESS OF STRING FOR BLT
CALL ASCIZL ;GET # OF CHARACTERS
IDIVI T2,5 ;GET # OF WORDS MINUS 1
CAIL T2,SYRMSZ ;TOO LONG?
MOVEI T2,SYRMSZ-1 ;YES, TRUNCATE
MOVEI Q1,SYRHSZ+CS%SIZ+1(T2) ;SAVE SIZE OF ENTIRE MESSAGE
HRRI Q3,SYRMSG+CS%SIZ ;GET BLT DESTINATION
BLT Q3,SYRMSG+CS%SIZ(T2) ;TRANSFER STRING TO MESSAGE
MOVEI T1,CS%SIZ
STOR T1,CS%RSN,SYRMSG+CS%RSW ;STORE POINTER TO REASON
SYMSE1: MOVEI T1,SEC%CS ;GET CONFIGURATION STATUS CHANGE CODE
DPB T1,[POINT 9,SYRHDR,8] ;STORE INTO SYSERR ENTRY HEADER
;BUILD AND STORE SIXBIT DEVICE NAME
MOVE T1,[SIXBIT/DP000 /]
MOVE T2,[POINT 6,1,11]
HLRZ T3,Q2 ;GET CHANNEL
ADDI T3,20 ;MAKE IT A SIXBIT NUMBER
IDPB T3,T2 ;SET CHANNEL INTO NAME
HRRZ T3,Q2 ;GET DRIVE NUMBER
ADDI T3,20
IDPB T3,T2 ;SET DRIVE INTO NAME
MOVEM T1,SYRMSG+CS%DNM ;STORE SIXBIT DEVICE NAME
SETZM SYRMSG+CS%ADS ;CAN'T GET THE SERIAL NUMBER
LOAD T1,DSKTYP,(DSK) ;GET DISK TYPE
STOR T1,CS%UTP,SYRMSG+CS%HTP
;LOG THE MESSAGE
MOVEI T1,SYRHDR ;GET ADDRESS OF SYSERR MESSAGE
MOVE T2,Q1 ;GET # OF WORDS IN MESSAGE
SKIPN TSTF ;DON'T LOG SYSERRS IF TESTING
SYERR ;LOG IT
ERJMP R ;IGNORE ERRORS
RET
;TLUSR - BUILD BLOCK FOR SUCCESSFUL STRUCTURE REMOVAL RESPONSE
;ACCEPTS: RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
TLUSR: MOVE T1,RSBSTA(RSB) ;GET STRUCTURE NAME
TMCT <%IStructure %1S: removed
>
MOVEI T1,TMCMSG ;GET ADDRESS OF ASCIZ TEXT
MOVEI T2,.MNRTX ;GET ARGUMENT TYPE
CALL PBTXT ;CREATE TEXT BUILDING BLOCK
SETZ T1, ;SET NO FLAGS IN GALAXY HEADER
RET
;TLUSS - BUILD BLOCKS FOR SUCCESSFUL STRUCTURE MOUNT RESPONSE
;ACCEPTS: RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1: ALWAYS
TLUSS: STKVAR <<DVBLK,2>>
TMCT <%I> ;NEED THIS?
MOVE T1,[FLD(2,AR.LEN)+FLD(.MNSDV,AR.TYP)] ;GET HEADER
MOVE T2,RSBSTA(RSB) ;GET STRUCTURE ALIAS
DMOVEM T1,DVBLK ;STORE HEADER AND STRUNCTURE NAME
MOVEI T1,DVBLK ;GET ADDRESS OF DEVICE BLOCK
CALL PBBLK ;ADD IT TO BUILDING BLOCK LIST
SETZ T1, ;SET NO FLAGS IN GALAXY HEADER
RET
;USD - PROCESS USER STRUCTURE DISMOUNT REQUEST RECEIVED THRU QUASAR
;ACCEPTS: T1/ ADDR OF STRUCTURE MOUNT ENTRY IN IPCF MSSG FROM QUASAR
; RSB/ ADDR OF REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
USD: SAVEQ
MOVEI T2,BSRRTA ;SET UP ANALYSIS TABLE FOR BTMRSB
CALL BTMRSB ;BUILD RSB FROM QUASAR MESSAGE
RET ;REQUEST ABORTED, EXIT
MOVX T1,R%DSM+R%RNR ;GET DISMOUNT and REMOVAL FLAG
IORM T1,RSBIFL(RSB) ;AND SET INTO RSB
CALL DDSCIH ;MAKE SURE TABLES UP-TO-DATE
CALL CHKAB ;REQUEST ABORTED?
RET ;YES, MADE UNCORRECTABLE MOUNT ERROR
MOVE T1,RSBSTA(RSB) ;GET STRUCTURE ALIAS
MOVE T2,RSBSTN(RSB) ;GET STRUCTURE NAME
SETZ T4, ;No unique code
CALL MATCHS ;MATCH REQUEST TO STRUCTURE
JRST [ABTRET(MREQ25)] ;STRUCTURE NOT FOUND
STOR STR,RSBSS ;STORE STRUCTURE STATUS BLOCK ADDR
;MAKE SURE USER ISN'T CONNECTED TO STRUCTURE TO DISMOUNT
LOAD T1,RSBJNO ;GET USER'S JOB NUMBER
MOVE T2,[-1,,Q1] ;GET USER'S CONNECTED DIRECTORY
MOVEI T3,.JIDNO ; INTO Q1
GETJI
RET ;INVALID JOB, ABORT REQUEST
HRROI T1,TMCMSG ;POINT TO PLACE TO PUT NAME OF CONN DIR
MOVE T2,Q1 ;GET CONNECTED DIRECTORY
DIRST
JRST USD1 ;FORGET CONNECTED STR
HRROI T1,TMCMSG ;GET DESIGNATOR OF CONNECTED STR
STDEV
USD1: SETZ T2, ;FORGET CONNECTED STR
MOVE Q1,T2 ;STORE DESIGNATOR IN T3
MOVEI T1,RSBSTA(RSB) ;GET SIXBIT ALIAS
MOVE T2,[POINT 7,MSTAL] ;THIS IS PLACE TO STORE 7-BIT
CALL SIXSEV ;CONVERT IT
HRROI T1,MSTAL ;POINT TO ALIAS
STDEV ;GET ITS DESIGNATOR
JRST [ JUMPN STR,[MOVEI T1,RST.WD ;STR SPINNING,BUT NOT MOUNTED?
STOR T1,RSBSTE ;SET STATE TO WAITING
JRST WOVDS]
ABTRET (MREQ25)] ;STR IS NOT TO BE FOUND
CAMN Q1,T2 ;IS USER CONNECTED TO STR BEING REMOVED?
JRST [ ABTRET (MREQ24)] ;YES, ILLEGAL
;USER ISN'T CONNECTED TO STRUCTURE. PREPARE TO DISMOUNT IT.
MOVEI T1,RST.WD
STOR T1,RSBSTE ;SET STATE TO WAITING FOR DISMOUNT
MOVEI T1,RSBSTN(RSB) ;CONVERT SIXBIT NAME TO 7-BIT
MOVE T2,[POINT 7,MSTNM]
CALL SIXSEV
CALL TCKP ;UPDATE QUASAR'S QUEUES FOR "INFO MOUNT"
CALLRET STRDMT ;DISMOUNT STRUCTURE
;USM - PROCESS USER STRUCTURE MOUNT REQUEST RECEIVED THROUGH QUASAR
;ACCEPTS: T1/ ADDR OF STRUCTURE MOUNT ENTRY IN IPCF MSSG FROM QUASAR
; RSB/ ADDR OR REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
USM: MOVEI T2,BSRRTA ;SET UP ANALYSIS TABLE FOR BTMRSB
CALL BTMRSB ;BUILD RSB FROM QUASAR MESSAGE
RET ;REQUEST ABORTED, EXIT
MOVEI T1,RSBSTA(RSB) ;POINT TO SIXBIT ALIAS
MOVE T2,[POINT 7,MSTAL] ;ASCII GOES HERE
CALL SIXSEV ;CONVERT ALIAS TO ASCII
HRROI T1,MSTAL ;POINT TO ASCII ALIAS
STDEV ;IS THIS A TTY: OR OTHER ILLEGAL DEVICE
SKIPA ;ERROR, MUST BE OKAY
JRST [ HLRZS T2 ;GET LEFT HALF OF DESIGNATOR
CAIN T2,.DVDES+.DVDSK ;IS IT A DISK?
JRST [ CALL TELUSR ;YES, AND ALREADY MOUNTED
ABTRET (ABRTNR)]
MOVEI Q1,MSTRX7 ;GET ERROR MESSAGE
ABTRET (Q1,ABT%IN)] ;ILLEGAL DEVICE FOR MOUNT
MOVEI T1,RST.WM
STOR T1,RSBSTE ;SET STATE TO WAITING FOR MOUNT
CALL DDSCIH ;MAKE SURE TABLES UP-TO-DATE
CALL CHKAB ;REQUEST ABORTED?
RET ;YES, MADE UNCORRECTABLE MOUNT ERROR
MOVE T1,RSBSTA(RSB) ;GET STRUCTURE ALIAS
MOVE T2,RSBSTN(RSB) ;GET STRUCTURE NAME
SETZ T4, ;No unique code
CALL MATCHS ;MATCH REQUEST TO STRUCTURE
JRST [JUMPE T1,USM1 ;Not found, go ask to be mounted
JRST DUPSTA] ;Duplicate state
SKIPG STR ;IS STRUCTURE MOUNTED?
JRST [ LOAD T1,STRUNI,(STR) ;NO, GET # OF DISKS IN STR
LOAD T2,STRMCT,(STR) ;GET # OF DISK ON-LINE IN STR
CAME T1,T2 ;ARE ALL DISKS ON-LINE?
JRST USM1 ;NO, ASK OPERATOR
CALL STRMNT ;PACK IS SPINNING. MOUNT IT
JRST USM1 ;PROBLEM IN MOUNTING,CHECK WITH OPERATOR
JRST USM0]
USM0: CALL TELUSR ;LET USER KNOW HE HAS STRUCTURE
ABTRET (ABRTNR) ;DUMP THE RSB AND RETURN TO CALLER
;STRUCTURE IS NOT PHYSICALLY OR LOGICALLY MOUNTED, GO TELL OPERATOR TO MOUNT IT
USM1: CALL CHKAB ;REQUEST ABORTED?
RET ;YES, DON'T TALK TO OPERATOR
SKIPN T1,RSBSTN(RSB) ;GET SIXBIT STRUCTURE NAME
MOVE T1,RSBSTA(RSB) ;NONE SPECIFIED,GET ALIAS AS NAME
CALL TCKP ;UPDATE QUASAR'S QUEUES FOR "INFO MOUNT"
CALL PWATCH ;WATCH FOR USER DELETING HIS PID
CALL GETACC ;GET AN ACCOUNT BLOCK
JRST [ CALL DELACC ;ABORT SINCE ACC BLOCKS IN SHORT SUPPLY
ABTRET (MREQ31)] ;AND KILL REQUEST.
SETOM ACCDD(ACC) ;FLAG ACCOUNT BLOCK NOT DELETABLE
GTAD ;GET NOW
MOVEM T1,ACCSCD(ACC) ;AS SCHEDULED TIME
LOAD T1,RSBJNO ;GET USER'S JOB NUMBER
STOR T1,ACCJN ;SAVE IN RSB
STOR ACC,RSBACC ;ASSOCIATE ACC WITH REQUEST
CALLRET WOVMS ;TELL OPERATOR TO MOUNT STRUCTURE
SUBTTL CFDIS - SET UP STRING CONTAINING INFORMATION FOR SHOW CONFIG DISK
;ACCEPTS DSK/ CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1, ALWAYS
CFDIS:: SAVEQ
MOVE Q1,DSKFLG(DSK) ;GET STATUS WORD
; The DSN field
CFDIS1: MOVE T1,DSKSNH(DSK) ;Get serial number
TMCT <%17C%1D > ;Disk drive serial number (HIGH ORDER)
MOVE T1,DSKSNL(DSK) ;Get serial number
TMCT <%27C%1D> ;Disk drive serial number (LOW ORDER)
; The mount status field
CFDIS2: TXNE Q1,MS%MNT ;Is it mounted
JRST [TMCT <%40CMounted> ;Yes, say it is mounted
JRST CFDIS3] ; and add mount count field
TXNE Q1,MS%OFL ; OFF LINE
JRST [TMCT <%40COffline > ;Display offline
JRST CFDIS3] ;
TMCT <%40CFree> ;Display free
MOVX T1,MSG%FR ;Get free message bit
IORM T1,DSPFLG ;Set free message flag
; The structure name field
CFDIS3: MOVE T1,DSKSTN(DSK) ;GET STRUCTURE NAME
JUMPE T1,CFNEX ;No name all done
TMCT <%49C%1S%56C(> ;Add name
; Add number of disks in structure
LOAD T2,DSKNOU,(DSK) ;GET NUMBER OF UNITS IN STR
LOAD T1,DSKLUN,(DSK)
MOVE T3,T1 ;SAVE UNIT NUMBER
AOS T1 ;CHANGE UNIT NUMBER TO ORDINAL
TMCT <%1D/%2D)> ;UNIT# / # OF UNITS
CFNEX: RET
SUBTTL WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE
;WOFRE - SET UP STRING CONTAINING INFORMATION ON FREE DRIVE
;ACCEPTS DSK/ CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1, ALWAYS
WOFRE:: SAVEQ
MOVX T1,MSG%AN ;Get the any bit
IORM T1,DSPFLG ;Say we have one
MOVE Q1,DSKFLG(DSK) ;GET STATUS WORD
CALL WOINI ;Go fill out the first five fields
SKIPE CFGFLG ;For the CONFIG command?
JRST WOFRE1 ;Already have structure name
; The structure name field
MOVE T1,DSKSTN(DSK) ;GET STRUCTURE NAME
JUMPE T1,WOFREX ;No name all done
TMCT <%42C%1S%49C(>
LOAD T1,DSKLUN,(DSK)
AOS T1 ;CHANGE UNIT NUMBER TO ORDINAL
TMCT <%1D/>
LOAD T1,DSKNOU,(DSK) ;GET # OF UNITS IN STRUCTURE
TMCT <%1D)>
; Do we have any bad disk errors?
WOFRE1: TXNE Q1,MS%BBB ; BAD BAT BLOCKS?
CALL [ TMCTR <%_Bad BAT blocks >] ; DISPLAY MESSAGE
TXNE Q1,MS%WLK ; IS UNIT WRITE LOCKED?
CALL [ TMCTR <%_Unit is write locked >] ; DISPLAY MESSAGE
TXNE Q1,MS%HBB ; BAD HOME BLOCKS?
CALL [ TMCTR <%_Bad HOME blocks >] ; DISPLAY MESSAGE
TXNE Q1,MS%DIA ; IN MAINTENANCE MODE?
CALL [ TMCTR <%_Maintenance mode >] ; DISPLAY MESSAGE
TXNE Q1,MS%ERR ;Error while reading?
CALL [ TMCTR <%_Error reading this unit>] ;Display message
TXNE Q2,MS%16B ;16 Bit format?
CALL [TMCTR <%_Unit written in 16 bit mode>] ;Display message
WOFREX: TMCT <%_>
; Is the disk on offline CI port
MOVE T1,DSFE+DSFFLG ;Get the disk status
TXNE T1,DSF%PO ;Is it unavailable due to port operation?
CALL [TMCT <%5CCan't use disk drive - Port unavailable%_>
RET]
RET
SUBTTL - WOINI -- Fills in the first five fields of the display
;Accepts - DSK/disk status block
;Returns - DSFE disk entry
WOINI: SAVEQ
MOVE Q1,DSKFLG(DSK) ;GET STATUS WORD
; The # of port field
TXNN Q1,MS%2PT ;Dual ported?
JRST WOINI0 ;No, skip indication
TMCT <*> ;Add a asterisk
MOVX T1,MSG%DU ;Get the display flag word
IORM T1,DSPFLG ;Dual ported drive message is to be printed
; The disk type field
WOINI0: LOAD T1,MS%TYP,Q1
MOVSI T2,-MXUTYP ;GET READY FOR SEARCH
HLRZ T3,UNTYTB(T2) ;GRAB NEXT TYPE FROM TABLE
CAME T1,T3 ;IS THIS IT?
AOBJN T2,.-2 ;NO, KEEP GOING
HRRZ T1,UNTYTB(T2) ;GET POINTER TO DISK TYPE STRING
TMCT <%2C%1A> ;Type it
; The CKU field
LOAD T1,DSKCHN,(DSK) ;GET CHANNEL NUMBER
TMCT <%7C%1D,> ;Type it and palce the pointer in the 10 col
CAIE T1,CIPORT ;Is it channel 7?
JRST WOINI1 ;No, skip setting special message bit
MOVX T1,MSG%CI ;Get the channel 7 bit
IORM T1,DSPFLG ;Set it in display falg to say channel 7
WOINI1: LOAD T1,DSKCTR,(DSK) ;GET CONTROLLER NUMBER
CAIN T1,<.RTJST(-1,DOP%K2)> ;IS THERE ONE?
JRST [TMCT < ,>
JRST WOINI2] ;NO, put two spaces
CAIGE T1,12 ;Is it double digit?
CALL [TMCT <0> ;No, add a zero
RET]
TMCT <%1D,> ;YES, TYPE IT
WOINI2: LOAD T1,DSKDRV,(DSK) ;GET UNIT NUMBER
TMCT <%1D> ;Type it
; Get the disk entry from DDB
WOINI3: MOVE T1,DSKPNT(DSK) ;Get the pointer to DDB
CALL DSFGET ;Go get the entry
$STOP <Disk entry not in DDB...WOINI2:+3>
SKIPE CFGFLG ;For the CONFIG command?
CALLRET CFDIS ;Yes, finish the display.
; The disk status field
MOVE T1,DSFE+DSFFLG ;Get the flag word
TXNE T1,DSF%AV ;Is it available?
JRST [TMCT <%17CUnavail> ;No, Say it is unavailable
JRST WOINI4]
TMCT <%17CAvail> ;Say it is available for now
; The mount status field
WOINI4: TXNE Q1,MS%MNT ;Is it mounted
JRST [TMCT <%26CMounted> ;Yes, say it is mounted
JRST WOINEX] ; and add mount count field
TXNE Q1,MS%OFL ; OFF LINE
JRST [TMCT <%26COffline > ;Display offline
JRST WOINEX] ;
TMCT <%26CFree> ;Display free
MOVX T1,MSG%FR ;Get free message bit
IORM T1,DSPFLG ;Set free message flag
WOINEX: RET
;WOMNT - SET UP STRING CONTAINING INFORMATION ON MOUNTED DRIVE
;ACCEPTS DSK/ CURRENT DISK STATUS BLOCK ADDRESS
;RETURNS +1, ALWAYS
WOMNT:: SAVEQ
;**;[6034]At WOMNT:+1L add 1 line JYCW 11-Aug-88
SETZM CHKDFG ;[6034]Clear the CHECKD flag
MOVX T2,MSG%AN ;Get any bit
IORM T2,DSPFLG ;Say we have one
MOVE Q1,DSKFLG(DSK) ;GET STATUS WORD
CALL WOINI ;Go fill out the first six fields
MOVE Q2,DSFE+DSFFLG ;Save the disk status
SKIPE CFGFLG ;For the CONFIG command?
JRST WOMNEX ;Finish off line
; The mount count field, only for mounted disks
MOVE T2,[POINT 7,MSTAL];SET UP POINTER FOR ALIAS
MOVEI T1,DSKSTA(DSK) ;Get the alias
CALL SIXSEV ;CONVERT SIXBIT ALIAS TO NEEDED 7-BIT
MOVEI T1,MSTAL ;Get address of alias
CALL STRSTT ;Go get the status
;**;[6034]At WOMNT:+15L replace 1 line with 2 JYCW 11-Aug-88
JRST [SETOM CHKDFG ;[6034]Set the flag
JRST WOMNT6] ;[6034]NO STRUCTURE?
MOVEM T1,Q3 ;Save the status
TMCT <%34C%3D> ;Output mount count
; The structure name field
WOMNT6: MOVE T1,DSKSTN(DSK) ;GET STRUCTURE NAME
JUMPE T1,WOMNEX ;No name all done
TMCT <%42C%1S%49C(> ;Add name
; Add number of disks in structure
LOAD T2,DSKNOU,(DSK) ;GET NUMBER OF UNITS IN STR
LOAD T1,DSKLUN,(DSK)
MOVE T3,T1 ;SAVE UNIT NUMBER
AOS T1 ;CHANGE UNIT NUMBER TO ORDINAL
TMCT <%1D/%2D)> ;UNIT# / # OF UNITS
SOJE T2,WOMNT3 ;JUMP IF ONLY ONE UNIT
SKIPE T3 ;IS THIS FIRST UNIT OF STRUCTURE?
JRST WOMNEX ;NO, HAVE ALREADY OUTPUT INFORMATION
; The usage option field
WOMNT3: TMCT <%55C> ;Go to the usage option colume
; Q3 should still contain the status
TXNE Q3,MS%EXC ;Is it?
CALL [TMCT <Excl > ;Assume exclusive
RET]
TXNE Q3,MS%DIS ;IS IT
CALL [TMCT <Unavail > ;Assume available
RET]
; Set up for ignore
MOVEI T1,.DVSTR ;Get the type
MOVEM T1,DSFE+DSFTYP ;Save it
MOVE T1,DSKSTA(DSK) ;Get the alias
MOVEM T1,DSFE+DSFSPC ;Save it
CALL DSFLOC ;Go find the entry
$STOP <Can't find structure entry in DDB.>
; This is for ignored case
MOVE T1,DSFE+DSFFLG ;Get the structure status flag word
TXNE T1,DSF%IG ;Is it ignored
CALL [TMCT <Ignored > ;Yes
RET]
; The alias field
MOVE T2,DSKSTA(DSK) ;Get structure name
CAMN T2,DSKSTN(DSK) ;ARE NAME AND ALIAS THE SAME?
JRST WOMNEX ;YES
TMCT <(Alias %2S)> ;Output name
WOMNEX: TMCT <%_> ;Finish the line off
; Is the disk on offline CI port
TXNE Q2,DSF%PO ;Is it unavailable due to port operation?
CALL [TMCT <%5CCan't use disk drive- Port unavailable%_>
RET]
;**;[6034]At WOMNEX:+3L add 6 lines JYCW 11-Aug-88
SKIPE CHKDFG ;[6034]Did we get an STRSTT error
CALL CHECKD ;[6034]Check whether CHECKD has it
RET ;[6034]No all done
HLRZ T1,T3 ;[6034]Get the job number
MOVEI T2,DEVX2 ;[6034]Yes, get correct error code
TMCT <* %2J, Job %1O *%_>;[6034]
RET
SUBTTL WOMDAV - TELL OPERATOR OF AVAILABILITY OF DISK DRIVE FOR SYSTEM USE
;ACCEPTS: Q1/ 1 IF UNAVAILABLE, 0 IF AVAILABLE
; Q2/ CKU NUMBER
;RETURNS: +1, ALWAYS
WOMDAV::MOVE T1,Q2 ;COPY FOR CALL
TMCT <%I%1K set > ;TYPE UNIT ADDRESS
JUMPN Q1,[TMCT <un>
JRST .+1]
TMCT <available for mounting by MOUNTR>
MOVE T3,[[ASCIZ/Disk Drive Set Available/]
[ASCIZ/Disk Drive Set Unavailable/]](Q1) ;GET HEADER
CALLRET BTWTO ;GET MESSAGE OUT TO OPERATOR
SUBTTL WOSM - TELL OPERATOR OF A STRUCTURE
WOSM: MOVEI T1,MSTNM ;GET STRUCTURE NAME
TMCT <%IStructure %1A>
MOVE T1,MSTNM ;ARE ALIAS AND NAME THE SAME
CAME T1,MSTAL
JRST WOS1 ;NO, PRINT THE ALIAS
MOVE T1,MSTNM+1
CAMN T1,MSTAL+1
RET ;YES, FORGET THE ALIAS
WOS1: MOVEI T1,MSTAL ;POINT TO ALIAS
TMCTR <: (Alias: %1A)>
;WOSDM - TELL OPERATOR OF A STRUCTURE DISMOUNT
WOSDM: CALL WOSM ;SET UP STRUCTURE NAMES
TMCT < dismounted>
MOVEI T3,[ASCIZ/Structure Dismounted/]
CALLRET BTWTO ;TELL OPERATOR
;WOSMT - TELL OPERATOR OF A STRUCTURE MOUNT
WOSMT: CALL WOSM ;SET UP STRUCTURE NAMES
TMCT < mounted>
MOVEI T3,[ASCIZ/Structure Mounted/]
CALLRET BTWTO ;TELL OPERATOR
;WOSSC - TELL OPERATOR STATUS OF STRUCTURE AFTER STATUS CHANGE
WOSSC: STAKT
MOVEI T2,MSTAL ;GET STRUCTURE NAME
TMCT <%I%2A: set %1A for use by system>
MOVEI T3,[ASCIZ/Structure Status Set/]
CALL BTWTO ;GET MESSAGE TO OPERATOR
CAIE Q3,S.EXCL ;Is it exclusive
CAIN Q3,S.SHAR ;or share
JRST [ ABTRET (ABRTNR)] ;Yes, abort the request
RET ;Else return
;WRDSC - ASK OPERATOR IF STRUCTURE SHOULD BE REMOVED, EVEN THOUGH THERE
; ARE USERS ON IT
;ACCEPTS: T1/ ADDRESS OF RESPONSE HANDLER CALLED BY INWTOR
; STR/ ADDRESS OF STRUCTURE STATUS BLOCK
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
WRDSC:: MOVE T3,STRNAM(STR) ;GET STRUCTURE NAME
MOVE T2,STRALI(STR) ;GET ALIAS
CALL WTOCHK ;IS WTO DIASABLED
RET ;YES
TMCTI <DSMHDR> ;Build dismount message
MOVEI T2,RSBWTB(RSB) ;GET WTB ADDRESS
MOVEI T3,[ASCIZ/Dismount Query/]
CALLRET BTWTOR ;SEND WTOR OFF TO THE OPERATOR
;WOVDS - TELL OPERATOR A STRUCTURE MUST BE DISMOUNTED AND ACCEPT A
; POSSIBLE REFUSAL
;ACCEPTS: STR/ ADDRESS OF STRUCTURE STATUS BLOCK
; RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
WOVDS: MOVE T1,STRNAM(STR) ;GET SIXBIT STRUCTURE NAME
MOVE T2,RSBSTA(RSB) ;GET SIXBIT STRUCTURE ALIAS
CALL WTOCHK ;IS WTO DISABLED?
RET ;YES
MOVE T3,RSBIFL(RSB) ;Get the remove noremove bit
TXNE T3,R%RNR ;To remove?
JRST [ TMCT <%IRemove %1S: (alias %2S:)%_%U%_>
JRST .+2]
TMCT <%IDo not remove %1S: (alias %2S:)%_%U%_>
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T1,RSBRMK(RSB) ;YES, GET ADDRESS OF ASCIZ REMARK
TMCT <User's remark: %1A%_>
JRST .+1]
SKIPE T1,RSBOBN(RSB) ;[6011]Get "on behalf node name"
TMCT <Structure is dismounted on behalf of %1S::%_>
MOVEI T1,DSKHDR ;GET STATUS HEADER TEXT
TMCT <%1A>
LOAD Q1,STRUNI,(STR) ;GET NUMBER OF UNITS IN STRUCTURE
MOVNS Q1 ;SET UP INDEX
HRLZ Q1,Q1
MOVE T1,STR
ADDI T1,STRADD ;GET INDEX TO START OF DISK ADDRESSES
HRR Q1,T1 ;GET ADDRESS FOR DISK
WOVD1: MOVE DSK,(Q1) ;GET DISK BLOCK ADDRESS
JUMPE DSK,WOVD2 ;JUMP IF PACK GONE
MOVX T1,MS%MNT ;MAKE SURE DISK IS NOT MOUNTED
ANDCAM T1,DSKFLG(DSK)
CALL WOFRE ;DISPLAY UNIT
WOVD2: AOBJN Q1,WOVD1 ;IF MORE PACKS, DISPLAY THEM
MOVE T3,RSBIFL(RSB) ;Get the remove noremove bit
TXNE T3,R%RNR ;To remove?
JRST [TMCT <Structure cannot be mounted again unless MOUNTed via OPR or until removed%_>
JRST .+2]
TMCT <Structure cannot be mounted unless MOUNTed via OPR%_>
MOVEI T2,RSBWTB(RSB) ;GET WTB ADDRESS
MOVEI T3,[ASCIZ/Dismount Structure/]
CALL BTNFO ;No formatting
CALLRET BTWTO ;SEND WTO OFF TO THE OPERATOR
;WOVMS - TELL OPERATOR A STRUCTURE MUST BE MOUNTED
;ACCEPTS: RSB/ ADDRESS OF REQUEST STATUS BLOCK
;RETURNS: +1, ALWAYS
WOVMS: CALL MESCHK ;HAVE WE ALREADY NOTIFIED OPR OF STR?
RET ;YES, FORGET THIS
CALL WTOCHK ;IS WTO DISABLED
RET ;YES
SKIPGE T1,RSBITN(RSB) ;GET REQUEST # if not from operator
JRST [TMCT <%IStructure Mount Request made by operator>
JRST WOVM0]
TMCT <%IStructure Mount Request # %1D>
SETONE R%ONR,RSBIFL(RSB) ;SET OPERATOR-NOTIFIED
WOVM0: CALL CPYHDR ;COPY HEADER TO OPRHDR
SKIPN T1,RSBSTN(RSB) ;GET SIXBIT STRUCTURE NAME
MOVE T1,RSBSTA(RSB) ;NONE SPECIFIED, GET ALIAS AS NAME
MOVE T2,RSBSTA(RSB) ;GET SIXBIT STRUCTURE ALIAS
TMCT <%IMount %1S: (alias %2S:)%_%U%_>
SKIPE RSBRMK(RSB) ;DID THE USER SUPPLY A REMARK?
JRST [ MOVEI T1,RSBRMK(RSB) ;YES, GET ADDRESS OF REMARK
TMCT <User's remark: %1A%_>
JRST .+1]
CALL KSHDF ;Displace the headers
MOVEI T1,DSKHDR
TMCT <%1A>
; Loop through all disks
MOVEI T1,.DVDSK ;Get the disk type
MOVEM T1,DSFE+DSFTYP ;Save it in DSFE
SETZ T1, ;Go for the first
SETZ Q1, ;SET FLAG TO SAY NO AVAILABLE DRIVES
WOVM1: CALL DSFGNX ;Go get an entry
JRST WOVM3 ;No more
PUSH P,T1 ;Save pointer
SKIPN DSK,DSFE+DSFPNT ;Get disk status block address
JRST WOVM2 ;No disk status block, get the next disk
MOVE T1,DSKFLG(DSK) ;Get te status flag
TXNN T1,MS%MNT ;IS THIS DISK MOUNTED?
TXNE T1,MS%DIA ;NO, IS IT IN MAINT MODE?
JRST WOVM2 ;YES, SKIP THIS DISK
CALL WOFRE ;DISPLAY STATUS OF THIS DRIVE
SETO Q1, ;SET FLAG TO SAY WE HAVE A DRIVE
WOVM2: MOVEI T1,.DVDSK ;Get the disk type
MOVEM T1,DSFE+DSFTYP ;Save it in DSFE
POP P,T1 ;Get the pointer back
JRST WOVM1 ;Get the next
WOVM3: JUMPE Q1,[TMCT <%INo drives available>
JRST .+1]
MOVEI T3,OPRHDR ;GET ADDRESS OF HEADER TEXT
CALL BTNFO ;No formatting
CALLRET BTWTO ;SEND WTO OFF TO THE OPERATOR
SUBTTL USER TAPE MOUNT REQUEST
; BTMRSB - EXTRACT INFORMATION FROM USER MOUNT REQUEST AND
; TRANSFER IT TO THE REQUEST STATUS BUFFER
; T1/ ADDRESS OF MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
; T2/ ADDRESS OF TABLE MOUNT REQUEST ANALYSIS ROUTINE ADRESSES
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: FAILURE, MOUNT REQUEST ABORTED
; +2: SUCCESS, INFORMATION TRANSFERRED TO RSB
BTMRSB: SAVEQ
DMOVE Q1,T1 ;COPY ADDRESSES TO A SAFE PLACE
; PERFORM STRUCTURAL VALIDATION OF MOUNT ENTRY
MOVE T1,.MECNT(Q1) ;GET SUBENTRY COUNT
MOVEI T2,.MEHSZ(Q1) ;GET ADDRESS OF FIRST SUBENTRY
LOAD T3,AR.LEN,.MEHDR(Q1) ;GET LENGTH OF SUBENTRY
SUBI T3,.MEHSZ ;COMPUTE SIZE OF SUBENTRY AREA
SKIPL T3 ;ERROR IF HEADER IS INCOMPLETE
CALL CKBSTR ;CHECK STRUCTURE OF MOUNT REQUEST
JRST [ ABTRET (MREQ20)] ;STRUCTURE ERROR IN MOUNT ENTRY
; PERFORM SEMANTIC ANALYSIS OF MOUNT ENTRY
BTMR1: MOVEI T1,.MECNT(Q1) ;ADDRESS OF SUBENTRY COUNT WORD
MOVEI T2,.MEHSZ(Q1) ;ADDRESS OF FIRST SUBENTRY
SKIPN (Q2) ;FINISHED WITH ANALYSIS ROUTINES?
RETSKP ;YES, GO HOME
CALL @(Q2) ;CALL ANALYSIS ROUTINE
RET ;ERROR DETECTED, PASS IT TO CALLER
AOJA Q2,BTMR1 ;LOOP THRU ALL ANALYSIS ROUTINES
; TABLE OF TAPE MOUNT REQUEST ANALYSIS ROUTINE ADDRESSES
; WARNING:
; DO NOT CHANGE THE ORDER OF THE ROUTINES IN THIS TABLE - SOME
; DEPEND UPON RSB FIELDS SET UP BY THEIR PREDECESSORS
BTRRTA: IFIW!BTRFLG ;BIT FLAGS
IFIW!BTRDEN ;DENSITY
IFIW!BTRDRV ;DRIVE-TYPE
IFIW!BTRLT ;LABEL TYPE
IFIW!BTRSET ;SET NAME
IFIW!BTRRMK ;REMARK
IFIW!BTRVLS ;VOLID LIST
IFIW!BTRSTV ;STARTING VOLID NUMBER
IFIW!BTRVPR ;VOLUME PROTECTION
0 ;END OF ROUTINES
;TABLE OF STRUCTURE MOUNT REQUEST ANALYSIS ROUTINE ADDRESSES
; WARNING:
; BSRALI MUST BE AFTER BSRNAM IN THE TABLE
BSRRTA: IFIW!BSRALI ;ALIAS OF STRUCTURE
IFIW!BSRNAM ;NAME OF STRUCTURE
IFIW!BTRRMK ;REMARK
0 ;END OF ROUTINES
; ROUTINES FOR PROCESSING SUBENTRIES OF TAPE MOUNT REQUEST
; T1/ ADDRESS OF SUBENTRY COUNT WORD
; T2/ ADDRESS OF FIRST SUBENTRY
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST ABORTED
; +2: SUBENTRY PROCESSED SUCCESSFULLY
; DENSITY
BTRDEN: MOVEI T3,.TMDEN
MOVEI T4,DENMAX ;GET MAXIMUM
CALL BTRG1 ;LOOKUP DENSITY PARAMETER
JRST [ ABTRET (MREQX3)] ;DENSITY ILLEGAL
STOR T1,RSBDEN ;STORE DENSITY IN RSB
RETSKP
; DRIVE TYPE
BTRDRV: MOVEI T3,.TMDRV
MOVEI T4,.TMDMX ;GET MAXIMUM
CALL BTRG1 ;LOOKUP DRIVE PARAMETER
JRST [ ABTRET (MREQX4)] ;DRIVE TYPE ILLEGAL
STOR T1,RSBDRV ;STORE DRIVE TYPE IN RSB
RETSKP
; BIT FLAGS
BTRFLG: MOVE T1,.MEFLG(Q1) ;GET USER-SUPPLIED FLAGS
TXNE T1,TM%BYP ;DOES HE WANT BYPASS?
JRST [ MOVX T2,R%PRIV ;YES
TDNE T2,RSBIFL(RSB) ;IS HE PRIVILEGED?
JRST .+1 ;YES, LET HIM DO IT
ABTRET (CAPX1)] ;NOT PRIVILEGED, ABORT REQUEST
TXNE T1,TM%SCR
JRST [ TXO T1,TM%NEW+TM%WEN ;FLAGS IMPLIED BY TM%SCR
TXZ T1,TM%OSV+TM%VFY
JRST .+1]
TXNE T1,TM%NEW
JRST [ TXO T1,TM%WEN ;FLAGS IMPLIED BY TM%NEW
TXZ T1,TM%VFY
MOVX T2,R%WVL
IORM T2,RSBIFL(RSB)
JRST .+1]
MOVEM T1,RSBUFL(RSB) ;MOVE USER REQUEST FLAGS TO RSB
RETSKP
; LABEL TYPE (MUST BE CALLED AFTER BTRDRV)
BTRLT: MOVEI T3,.TMLT
MOVEI T4,.LTMAX ;GET MAXIMUM
CALL BTRG1 ;LOOKUP DRIVE-TYPE PARAMETER
JRST [ ABTRET (MREQX5)] ;LABEL TYPE ILLEGAL
MOVX T2,TM%BYP
TDNE T2,RSBUFL(RSB) ;BYPASS?
MOVEI T1,.LTUNL ;YES, FORCE LABEL TYPE = UNLABELED
CAIE T1,.LTUNL ;LABELED TAPE?
JUMPN T1,[LOAD T2,RSBDRV ;YES, GET DRIVE TYPE
CAIE T2,.TMDR7 ;7-TRACK?
JRST .+1 ;NO
ABTRET (MREQX2)] ;YES, 7-TRACK LABELS NOT SUPPORTED
STOR T1,RSBLT ;STORE LABEL TYPE IN RSB
RETSKP
; REMARK
BTRRMK: MOVEI T3,.TMRMK
CALL BLKFND ;LOOKUP REMARK
RETSKP ;NO REMARK
JUMPE T2,RSKP ;TREAT ZERO-LENGTH REMARK LIKE NO REMARK
CAILE T2,RMKLEN ;IS REMARK TOO LONG?
MOVEI T2,RMKLEN ;YES, TRUNCATE
MOVSS T1 ;BLT SOURCE
HRRI T1,RSBRMK(RSB) ;BLT DESTINATION
ADDI T2,RSBRMK-1(RSB) ;LAST WORD OF DESTINATION
BLT T1,(T2) ;BLT REMARK INTO RSB
MOVEI T1,377
ANDCAM T1,(T2) ;MAKE SURE REMARK ENDS WITH A NULL
RETSKP
; SETNAME
BTRSET: MOVEI T3,.TMSET
CALL BLKFND ;LOOKUP SETNAME
JRST BTRSE1 ;SETNAME MISSING
JUMPE T2,BTRSE1 ;ERROR IF HEADER-ONLY SUBENTRY
MOVE T1,(T1) ;GET SETNAME IN T1 FOR CHKID
CALL CHKID ;IS IT A LEGAL SETNAME?
BTRSE1: JRST [ ABTRET (MREQX6)] ;SETNAME ILLEGAL OR MISSING
MOVEM T1,RSBSSN(RSB) ;STORE USER-SUPPLIED SETNAME IN RSB
MOVX T2,TM%NEW
TDNE T2,RSBUFL(RSB) ;USER CREATING NEW VOLUME SET?
MOVEM T1,RSBASN(RSB) ;YES, HIS SETNAME GOES IN THE LABELS
RETSKP
; STARTING VOLID NUMBER (MUST BE CALLED AFTER BTRVLS)
BTRSTV: SAVEQ
MOVEI T3,1
STOR T3,RSBCV ;DEFAULT CURRENT VOLID # IS 1
MOVEI T3,.TMSTV
CALL BLKFND ;STARTING VOLID ENTRY PRESENT?
RETSKP ;NO, DEFAULT WILL BE USED
JUMPE T2,BTRSTI ;ERROR IF HEADER-ONLY SUBENTRY
MOVX T3,TM%OSV+TM%NEW
TDNE T3,RSBUFL(RSB) ;ANY BITS SET?
JRST BTRSTI ;YES, USER CAN'T SPECIFY THIS PARAMETER
SKIPE Q1,(T1) ;SPECIFYING NUMBER OR VOLID?
JRST [ CALL VQCNT ;NUMBER, GET # OF VOLIDS IN REQUEST
CAMG Q1,T1 ;ERROR IF SPECIFIED VALUE .GT. MAX
SKIPG Q1 ;ERROR IF STARTING VOLID NOT POSITIVE
JRST BTRSTI
STOR Q1,RSBCV ;OFFSET IS LEGAL, STORE IT
RETSKP]
CAIGE T2,2 ;SPECIFYING VOLID, IS ENTRY LONG ENOUGH?
JRST BTRSTI ;NO
MOVE Q1,1(T1) ;GET VOLID
MOVEI Q2,1 ;GET COUNTER
QSCANI <RSBVLS(RSB)> ;SET UP TO SCAN VOLID LIST
BTRST1: CALL QMSCAN ;LOOK AT NEXT VOLID FOR THIS REQUEST
BTRSTI: JRST [ ABTRET (MREQX7)] ;ABORT REQUEST - ILLEGAL STARTING VOLID
CAME Q1,1(T2) ;IS THIS THE ONE?
AOJA Q2,BTRST1 ;NO, BUMP COUNTER & CONTINUE SEARCH
STOR Q2,RSBCV ;FOUND IT, STORE ORDINAL VOLID #
RETSKP
; VOLID LIST
BTRVLS: SAVEQ
MOVX T3,TM%OSV+TM%SCR
TDNE T3,RSBUFL(RSB) ;IS USER PERMITTED TO SPECIFY VOLIDS?
RETSKP ;NO, IGNORE VOLID LIST IF PRESENT
MOVEI T3,.TMVOL
CALL BLKFND ;LOOKUP VOLID LIST
SETZ T2, ;NO VOLID LIST
JUMPE T2,[MOVX T2,TM%OSV+TM%NEW ;ZERO-LENGTH IS LIKE NO LIST
TDNE T2,RSBUFL(RSB) ;IS VOLID LIST REQUIRED?
RETSKP ;NO, LET HIM BY
ABTRET (MREQ17)] ;YOU FORGOT TO LIST YOUR VOLIDS FELLA
MOVN Q1,T2 ;GET -#VOLIDS IN Q1
MOVSS Q1 ;CONSTRUCT LEFT HALF OF AOBJN POINTER
HRR Q1,T1 ;VOLID SOURCE ADDRESS IN RIGHT HALF
BTRVL1: MOVE T1,(Q1) ;GET A VOLID FROM SUBENTRY
CALL CHKID ;IS IT A LEGAL VOLID?
JRST [ ABTRET (MREQX9)] ;NO, ABORT REQUEST
CALL VQADD ;ADD VOLID TO END OF LIST
RET ;POOL EXHAUSTED, REQUEST ABORTED
AOBJN Q1,BTRVL1 ;LOOP TO TRANSFER ALL VOLIDS
RETSKP
; VOLUME PROTECTION
BTRVPR: MOVEI T3,.TMVPR
CALL BLKFND ;SEARCH FOR VOLUME-PROTECTION ENTRY
SETZ T2, ;NONE FOUND
MOVE T1,(T1) ;GET ARG IF THERE
SKIPN T2 ;SKIP IF ARGUMENT PRESENT
MOVEI T1,777777 ;USE DEFAULT
STOR T1,RSBVPR ;STORE VOLUME-PROTECTION CODE
RETSKP
; BTRG1 - GET A NUMERIC ARGUMENT FROM A BUILDING-BLOCK LIST
; IF NO VALUE SPECIFIED, RETURN 0
; IF VALUE SUPPLIED, VERIFY THAT 0 .LE. VALUE .LE. MAXIMUM
; T1-T3/ ARGUMENTS FOR BLKFND
; T4/ MAXIMUM VALUE
; RETURNS +1: ENTRY CONTAINS HEADER ONLY OR ARG LIES OUTSIDE LIMITS
; +2: ARGUMENT VALID, T1/ VALUE
BTRG1: STAKT
CALL BLKFND ;SEARCH FOR ENTRY
JRST [ SETZ T1, ;ENTRY NOT THERE, RETURN ZERO
RETSKP]
JUMPE T2,R ;ERROR IF HEADER-ONLY
SKIPGE T1,(T1) ;GET ARGUMENT
RET ;CAN'T BE LESS THAN ZERO
CAMLE T1,CT4
RET ;.GT. UPPER LIMIT
RETSKP
; TCITN - CANCEL A TAPE MOUNT REQUEST WITH A SPECIFIED ITN
; T1/ INTERNAL TASK NAME (ITN) OF REQUEST TO BE CANCELED
; RETURNS +1: ITN NOT FOUND OR REQUEST COULD NOT BE CANCELED
; +2: REQUEST CANCELED
TCITN: QSCANI ARBQDB ;SET UP TO SCAN TAPE REQUEST QUEUE
SAVEAC <RSB>
SAVEQ
MOVE Q1,T1 ;SAVE ITN
TCITN1: CALL QMSCAN ;GET ADDR OF NEXT RSB IN T2
RET ;NONE LEFT, EXIT
MOVEI RSB,-RSBLNK(T2) ;GET ADDRESS OF RSB INTO RSB AC
CAME Q1,RSBITN(RSB) ;IS THIS THE RIGHT REQUEST?
JRST TCITN1 ;NO, CONTINUE SEARCH
LOAD T1,RSBTYP
CAIN T1,.MNTTP ;TAPE REQUEST?
JRST [ JE RSBMT,,.+1 ;YES, CANCEL ONLY IF MT NOT ASSIGNED YET
RET] ;MT ASSIGNED, CAN'T CANCEL IT
CALL CHKAB ;REQUEST ABORTED?
RET ;YES, CAN'T CANCEL
CALL CHKDSM ;[335]Check to see if we a doing a str dismount
ABTREQ (MREQX1) ;OK, KILL TI
CALL WORCAN ;TELL OPERATOR REQUEST WAS CANCELED
RETSKP
;**;[335]At TELMON:-1L add 8 lines JYCW 12/5/86
;CHKDSM - Call only by TCITN to set the structure back to its previous
; state if we are canceling a dismount request.
;Accepts RSB/Request Status Block
;Returns +1 always
CHKDSM: LOAD T1,RSBTYP ;[335]Get the request type
CAIE T1,.DSMST ;[335]Dismount str request?
JRST CHKDS1 ;[335]No, all done
MOVE T1,RSBSTA(RSB) ;[335]Get structure alias
MOVE T2,RSBSTN(RSB) ;[335]Get structure name
SETZ T4, ;[335]No unique code
CALL MATCHS ;[335]Get SSB in STR
SKIPA ;[335]Not there
CALL STSTBK ;[335]Set str back to its previous state
CHKDS1: RET
; TELMON - TELL THE MONITOR A TAPE VOLUME SWITCH WAS NOT PERFORMED
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
MTUABS==3 ;SIZE OF ARGUMENT BLOCK
TELMON: STKVAR <<MTUAB,MTUABS>>
MOVEI T1,MTUABS
MOVEM T1,.MTCNT+MTUAB ;SET COUNT IN ARGUMENT BLOCK
LOAD T1,RSBSTE ;GET ERROR CODE
MOVEM T1,.MTCOD+MTUAB ;SET ERROR CODE IN ARG BLOCK
SETZ T1, ;ASSUME NO ERROR MESSAGE
MOVX T2,R%ORES
TDNE T2,RSBIFL(RSB) ;IS THERE AN OPERATOR RESPONSE?
HRROI T1,ATMBFR ;YES, GET POINTER TO RESPONSE STRING
MOVEM T1,.MTPTR+MTUAB ;SET STRING POINTER OR 0 IN ARG BLOCK
; ARGUMENT BLOCK IS SET UP, NOW LOAD THE AC'S AND ISSUE THE CALL
MOVEI T1,.MTNVV ;GET MTU FUNCTION CODE
LOAD T2,RSBMT ;GET MT STATUS BLOCK ADDRESS
SUBI T2,MT0 ;COMPUTE DISPLACEMENT FROM 0TH BLOCK
IDIVI T2,MTSZ ;COMPUTE MT#
MOVEI T3,MTUAB ;GET ARGUMENT BLOCK ADDRESS
MTU% ;TELL MONITOR
RET
; TELUSR - BUILD AND SEND IPCF MESSAGE TO USER TO NOTIFY HIM OF THE
; DISPOSITION OF A MOUNT REQUEST
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
TELUSR: SAVEQ
SETZM TBUF+.OFLAG ;CLEAR FLAGS WORD
CALL PBINIT ;SET UP FOR CREATING BUILDING BLOCKS
MOVE Q1,[2,,.MNRNM] ;BUILD BLOCK CONTAINING REQUEST NAME
MOVE Q2,RSBRNM(RSB)
MOVEI T1,Q1
CALL PBBLK
LOAD T1,RSBSTE ;GET REQUEST STATE
CAIN T1,ABRTNR ;SHOULD USER GET A RESPONSE?
RET ;NO, EXIT
CAIL T1,.ERBAS ;IS THE REQUEST ABORTED?
JRST [ CALL TLUAB ;YES, BUILD MESSAGE FOR ABORT
JRST TELUS1]
LOAD T1,RSBTYP ;GET REQUEST TYPE
MOVEI T2,STOP ;IN CASE NO MATCH IS FOUND
CAIN T1,.MNTTP ;TAPE-MOUNT?
MOVEI T2,TLUTS ;YES
CAIN T1,.MNTST ;STRUCTURE MOUNT?
MOVEI T2,TLUSS ;YES
CAIN T1,.DSMST ;DISMOUNT STRUCTURE?
MOVEI T2,TLUSR ;YES
NOSHIP,<
CAIN T1,.MNTDT ;DECTAPE-MOUNT?
MOVEI T2,TLUDT ;YES
>;NOSHIP
CALL (T2) ;CALL APPROPRIATE TELL-ROUTINE
; TELUS1 - T1/ GALAXY HEADER FLAGS
TELUS1: MOVE T2,T1 ;COPY FLAGS TO T2 FOR GALHDR
MOVE T1,PBBPT ;GET POINTER AFTER LAST BLOCK
SUBI T1,TBUF ;COMPUTE LENGTH OF MESSAGE
MOVSS T1 ;MOVE TO LH OF T1
HRRI T1,.QOMNA ;PUT MESSAGE TYPE IN RIGHT HALF
MOVE T3,RSBCOD(RSB) ;GET USER'S ACK CODE
CALL GALHDR ;BUILD GALAXY HEADER FOR USER
MOVE T1,RSBPID(RSB) ;GET USER'S PID
CALLRET TRANU ;SEND THE MESSAGE AND RETURN TO CALLER
; TLUTS - BUILD BLOCKS FOR SUCCESSFUL TAPE MOUNT RESPONSE
TLUTS: STKVAR <<DVBLK,3>,SAVMT>
CALL VQGCV ;GET CURRENT VOLID IN T1
MOVE T2,RSBSSN(RSB) ;GET SETNAME
JUMPE T1,[TMCT <%I[Tape set %2S, scratch tape mounted]%_>
JRST TLUTS1]
TMCT <%I[Tape set %2S, volume %1S mounted]%_>
TLUTS1: JN TM%OSV,RSBUFL(RSB),[TMCT <[Volume identifiers: >
CALL TMCVLS ;DISPLAY VOLID LIST
TMCT <]
>
JRST .+1]
MOVEI T1,TMCMSG ;GET ADDR OF ASCIZ TEXT
MOVEI T2,.MNRTX ;GET ARGUMENT TYPE
CALL PBTXT ;CREATE TEXT BUILDING BLOCK
MOVE T1,[FLD(3,AR.LEN)+FLD(.MNRDV,AR.TYP)] ;GET HEADER
MOVE T2,RSBSSN(RSB) ;GET SETNAME
DMOVEM T1,DVBLK ;STORE HEADER AND SETNAME
MOVEM MT,SAVMT ;PRESERVE MT AC
LOAD MT,RSBMT ;GET ADDR OF MT STATUS BLOCK
CALL GMTDD ;GET MT DEVICE DESIGNATOR IN T1
MOVE MT,SAVMT ;RESTORE MT AC
MOVEM T1,2+DVBLK ;STORE MT DESIGNATOR IN .MNRDV BLOCK
MOVEI T1,DVBLK ;GET ADDRESS OF .MNRDV BLOCK
CALL PBBLK ;ADD IT TO BUILDING BLOCK LIST
SETZ T1, ;SET NO FLAGS IN GALAXY HEADER
RET
; TLUAB - BUILD BLOCKS FOR UNSUCCESSFUL MOUNT-REQUEST RESPONSE
TLUAB: SAVEQ
MOVE Q1,[FLD(2,AR.LEN)+FLD(.MNREC,AR.TYP)] ;GET HEADER
LOAD Q2,RSBSTE ;GET ERROR CODE
MOVEI T1,Q1 ;POINT AT ERROR CODE BLOCK
CALL PBBLK ;PUT BLOCK IN MESSAGE
JN R%ORES,RSBIFL(RSB),[MOVEI T1,ATMBFR ;POINT TO REASON
TMCT <%IReason given by operator: %1A>
MOVEI T1,TMCMSG ;GET ADDRESS OF ASCIZ TEXT
MOVEI T2,.MNRTX ;GET ENTRY TYPE
CALL PBTXT ;INSTALL TEXT BUILDING BLOCK
JRST .+1]
MOVX T1,MF.FAT ;GET FATAL-ERROR FLAG
RET
; TRESCK - CHECK IF THE SYSTEM HAS AT LEAST ONE OF THE TYPE OF
; TAPE DRIVE REQUESTED BY THE USER JOB
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST CANNOT BE HANDLED BY THE SYSTEM
; +2: REQUEST CAN BE HANDLED BY THE SYSTEM
TRESCK: SAVEAC <MTA>
SAVEQ
SKIPE TSTF ;TEST MODE?
RETSKP ;YES, ALWAYS SUCCEED
MOVE Q1,MTAN ;GET # OF MTA DEVICES ON SYSTEM
MOVEI MTA,MTA0-MTASZ ;INIT MTA AC FOR STATUS BLOCK SCAN
LOAD Q2,RSBDRV ;GET REQUESTED DRIVE TYPE
; SCAN AVAILABLE TAPE DRIVES FOR ONE THAT CAN POTENTIALLY
; SATISFY THE USER TAPE MOUNT REQUEST
TRES1: SOJL Q1,R ;TAKE +1 RETURN IF NONE LEFT TO CHECK
ADDI MTA,MTASZ ;POINT AT NEXT MTA STATUS BLOCK
JE MTASTE,,TRES1 ;SKIP DRIVE IF NOT ASSIGNED TO ME
JUMPN Q2,[LOAD T1,MTADRV ;GET TYPE OF DRIVE
CAME T1,Q2 ;DOES IT MATCH WHAT THE USER WANTS?
JRST TRES1 ;NO, SKIP IT
JRST .+1]
LOAD T1,RSBDEN ;GET REQUESTED DENSITY
JUMPE T1,RSKP ;OK IF NOT PARTICULAR ABOUT DENSITY
CALL DRVDEN ;CAN THE DRIVE OPERATE AT THIS DENSITY?
JRST TRES1 ;NO, SKIP IT
RETSKP ;OK, AT LEAST 1 DRIVE CAN DO IT
; UTM - PROCESS USER TAPE MOUNT REQUEST RECEIVED THROUGH QUASAR
; 1 - ANALYZE BUILDING-BLOCK REQUEST AND BUILD RSB
; 2 - GET VOLID LIST FROM OPERATOR (IF TM%OSV SET)
; 3 - GET THE FIRST REQUESTED VOLUME MOUNTED
; T1/ ADDRESS OF TAPE MOUNT ENTRY IN IPCF MESSAGE FROM QUASAR
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
UTM: MOVEI T2,BTRRTA ;TABLE OF TAPE MOUNT SUBENTRY PROCESSORS
CALL BTMRSB ;BUILD RSB FROM QUASAR MESSAGE
RET ;REQUEST ABORTED, EXIT
JXE F,TALCF,[ABTRET (MREQ26)] ;MUST HAVE ALLOCATION ENABLED
CALL ACCMTR ;CREATE ACCOUNT BLOCK
JRST [ ABTRET (MREQ31)] ;ABORT REQUEST, NO BLOCKS AVAILABLE
CALL PWATCH ;TELL INFO TO WATCH USER'S PID
MOVX T1,TM%OSV
TDNN T1,RSBUFL(RSB) ;WHO IS SUPPLYING THE VOLIDS?
JRST [ CALLRET VOLMNT] ;USER, GO GET THE FIRST VOLUME MOUNTED
; GET THE VOLID LIST FROM THE OPERATOR
MOVEI T1,RST.WV ;OPERATOR IS SUPPLYING VOLIDS
STOR T1,RSBSTE ;SET STATE TO WAITING FOR VOLID KEYIN
CALL TCKP ;SEND STATUS UPDATE TO QUASAR
UTM1: JSP T1,WRUTR ;ASK OPERATOR TO KEY IN VOLID LIST
MOVEI RSB,-RSBWTB(T2) ;LOAD UP ADDR OF REQUEST STATUS BLOCK
CALL PMR ;PARSE RESPONSE TO VOLID REQUEST
JRST UTM1 ;BAD RESPONSE, TRY IT AGAIN
JUMPN T1,R ;RETURN IF REQUEST ABORTED
CALLRET VOLMNT ;GET 1ST VOLUME MOUNTED AND RETURN
SUBTTL VOLUME/REQUEST ASSOCIATION LOGIC
; MATCHR - TRY TO MATCH USER REQUEST TO TAPE VOLUME
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
MATCHR: SAVEAC <MTA,Q1>
MOVE Q1,MTAN ;GET # OF MTA DEVICES ON SYSTEM
MOVEI MTA,MTA0-MTASZ ;INIT MTA AC FOR SCAN
; SCAN MTA STATUS BLOCKS FOR VOLUMES THAT CAN SATISFY THE REQUEST
MCHR1: ADDI MTA,MTASZ ;POINT AT NEXT MTA STATUS BLOCK
SOJL Q1,R ;NONE LEFT, SO SPLIT
CALL VRA ;TRY TO MATCH REQUEST TO VOLUME
JRST MCHR1 ;CAN'T, SO CONTINUE SEARCH
RET
; MATCHV - TRY TO MATCH TAPE VOLUME TO USER REQUEST
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
MATCHV: SAVEQ
SAVEAC <RSB>
; PROBLEM: IF THE VOLUME IS A SCRATCH TAPE WITH A VOLID, I WANT TO
; ENSURE THAT ANY USER REQUESTING THE TAPE BY ITS VOLID GETS PRIORITY
; OVER ANY USER REQUESTING A RANDOM SCRATCH TAPE.
; SOLUTION: IMPLEMENT THE HAIRY CODE BELOW THAT PERFORMS A 2-PASS
; SEARCH OF THE RSB QUEUE WHEN THE VOLUME IS A SCRATCH TAPE. THE FIRST
; PASS (Q1/1) CHECKS ONLY RSB'S THAT ARE REQUESTING SPECIFIC (I.E.,
; NON-SCRATCH) VOLUMES. THE SECOND PASS (Q1/0) WILL CHECK ALL RSB'S. IF
; THE TAPE IS NOT A SCRATCH TAPE, ONLY THE SECOND PASS IS EXECUTED.
LOAD Q1,MA%SCR,MTAFLG(MTA) ;GET 1 IFF VOLUME IS A SCRATCH
MATV1: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
MATV2: CALL NMTRSB ;GET NEXT RSB
JRST [ SOJGE Q1,MATV1 ;MAKE 2ND PASS IF NEEDED
RET] ;ELSE RETURN
CALL VQGCV ;THIS USER WANT A SCRATCH TAPE?
SKIPN T1 ;NO
JUMPG Q1,MATV2 ;YES, BYPASS IF IN NON-SCRATCH PASS
CALL VRA ;TRY TO MATCH REQUEST TO VOLUME
JRST MATV2 ;CAN'T DO IT, CONTINUE SEARCH
RET ;REQUEST MATCHED TO VOLUME, EXIT
; MCHWMT - THIS ROUTINE IS CALLED WHEN MT DEVICES ARE FREED BY USER
; JOBS. ITS PURPOSE IS TO SCAN THE REQUEST QUEUE FOR REQUESTS
; THAT COULD NOT BE SATISFIED BECAUSE NO MT'S WERE AVAILABLE.
; RETURNS +1: ALWAYS
MCHWMT: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB>
TXZN F,NOMTF ;DOES AN MT SHORTAGE EXIST?
RET ;NO, NOTHING TO DO
; SCAN REQUEST QUEUE FOR REQUESTS THAT NEED MT DEVICES
MCHWM1: TXNN F,NOMTF ;EXIT IF MT SHORTAGE EXISTS
CALL NMTRSB ;GET NEXT RSB
RET ;NOTHING MORE TO DO
JN RSBMT,,MCHWM1 ;BYPASS IF HE'S GOT AN MT ALREADY
LOAD T1,RSBSTE ;GET STATE OF REQUEST
CAIE T1,RST.WM ;WAITING FOR TAPE MOUNT?
JRST MCHWM1 ;NO, DOESN'T NEED MT
CALL MATCHR ;TRY TO FIND A MATE FOR THIS REQUEST
JRST MCHWM1 ;GO ON TO NEXT REQUEST
; MOLOC - PERFORM .MOLOC MTOPR FUNCTION
; MT/ ADDR OF MT STATUS BLOCK
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
MOLASZ==10 ;SIZE OF .MOLOC ARG BLOCK
MOLOC: STKVAR <<MOLARG,MOLASZ>>
; SET UP ARGUMENT BLOCK FOR MTOPR
MOVEI T1,MOLASZ ;SET SIZE OF ARG BLOCK
MOVEM T1,.MOCNT+MOLARG
MOVE T1,MT ;GET MT STATUS BLOCK ADDR
SUBI T1,MT0 ;SUBTRACT BASE ADDRESS
IDIVI T1,MTSZ ;COMPUTE MT UNIT#
MOVEM T1,.MOMTN+MOLARG ;SET MT UNIT #
LOAD T1,RSBDEN
MOVEM T1,.MODNS+MOLARG ;SET DENSITY
MOVEI T1,MTAV1(MTA)
MOVEM T1,.MOAVL+MOLARG ;SET LABEL ADDRESS
LOAD T1,RSBCV
MOVEM T1,.MOCVN+MOLARG ;SET CURRENT VOLUME #
MOVE T1,RSBASN(RSB)
MOVEM T1,.MOVSN+MOLARG ;SET SIXBIT FILE SET IDENTIFIER
LOAD T1,RSBLT
MOVEM T1,.MOLBT+MOLARG ;SET LABEL TYPE
MOVEI T2,1 ;ASSUME EBCDIC OR ANSI
CAIN T1,.LTUNL
MOVEI T2,0 ;UNLABELED
CAIN T1,.LTT20
MOVEI T2,2 ;TOPS-20
MOVEM T2,.MONVL+MOLARG ;SET LABEL COUNT
; NOW PASS ALL THIS STUFF ON DOWN TO THE MONITOR
CALL MTAGJF ;GET JFN FOR MTOPR
MOVEI T2,.MOLOC ;GET MTOPR FUNCTION CODE
MOVEI T3,MOLARG ;ADDRESS OF ARGUMENT BLOCK
MTOPR ;PERFORM REQUESTED FUNCTION
ERCAL WOLOCF ;ERROR, DISPLAY TO OPERATOR
LOAD T1,MTAJFN ;GET JFN
MOVEI T2,.MOSID ;FUNCTION = SET VOLUME-ID
MOVE T3,MTAVOL(MTA) ;GET VOLID
MTOPR ;MAKE VOLID AVAILABLE TO USER VIA .MOINF
CALLRET MTARJF ;RELEASE JFN AND RETURN
; MTALC - ALLOC MT DEVICE TO A USER JOB
; MT/ ADDR OF MT STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: FAILED, USER JOB DISAPPEARED
; +2: SUCCESS, MT AND RSB LINKED TO EACH OTHER
MTALC: CALL GMTDD ;GET MT DEVICE DESIGNATOR IN T1
MOVE T2,T1 ;MOVE IT TO T2 FOR ALLOC JSYS
MOVEI T1,.ALCAL ;ALLOC FUNCTION CODE
LOAD T3,RSBJNO ;GET USER'S JOB #
ALLOC ;ALLOCATE MT DEVICE TO USER JOB
JRST [ CAIE T1,ALCX4 ;INVALID JOB #?
CALL STOP ;NO, I CAN'T HANDLE THIS ERROR
ABTRET (ABRTNR)] ;ABORT - USER WENT AWAY
STOR MT,RSBMT ;STORE MT STATUS BLOCK ADDR IN RSB
STOR RSB,MTRSB ;STORE RSB ADDR IN MT STATUS BLOCK
RETSKP ;SUCCESSFUL COMPLETION
; MTGET - LOCATE A FREE MT DEVICE
; RETURNS +1: NO FREE MT'S AVAILABLE
; +2: FREE MT FOUND, MT/ ADDR OF MT STATUS BLOCK
MTGET: MOVEI MT,MT0-MTSZ ;INIT MT AC FOR STATUS BLOCK SEARCH
MOVE T1,MTN ;GET # OF MT DEVICES ON SYSTEM
MTGET1: ADDI MT,MTSZ ;POINT AT NEXT MT STATUS BLOCK
SOJL T1,[TXO F,NOMTF ;NONE LEFT, SET NONE-LEFT FLAG
RET] ;ERROR RETURN
JN MTRSB,,MTGET1 ;SKIP THIS ONE IF IT'S IN USE
RETSKP ;FREE MT FOUND
; MTRLS - PROCESS RELEASE OF MT DEVICE BY USER
; MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS
MTRLS: SAVEAC <RSB>
LOAD RSB,MTRSB ;GET RSB ADDRESS
JUMPE RSB,R ;EXIT IF NO RSB ASSOCIATED
CALL PLDISA ;DISASSOCIATE MT FROM MTA
SETZRO MTRSB ;CLEAR OWNER-OF-MT FIELD
CAIN RSB,MTNAV ;WAS THERE AN RSB?
RET ;NO, BYPASS RSB PROCESSING
SETZRO RSBMT ;CLEAR POINTER TO MT IN RSB
LOAD T1,RSBSTE ;[332]Get the status
CAIN T1,RST.WM ;[332]Waiting for next volume?
CALL WORCAN ;[332]Yes, Tell OPR of cancelation
SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR OUTSTANDING?
CALL CANWTR ;YES, CANCEL IT
TXO F,ABORTF ;FORCE A SCAN TO DUMP THE RSB
ABTRET (ABRTNR) ;GET THE REQUEST OUT OF MY QUEUES
; PLDISA - DISASSOCIATE PHYSICAL AND LOGICAL TAPE DEVICES
; MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS
; NOTE - IF MOUNTR CRASHES AND GETS RESTARTED, THE CURRENT MT-MTA
; ASSOCIATIONS ARE RESTORED FROM MONITOR TABLES (ASMT ROUTINE)
; BUT MTRSB WILL CONTAIN MTNAV (HENCE PLDISA CHECKS FOR THIS)
PLDISA: SAVEAC <MTA,RSB>
LOAD MTA,MTMTA ;GET MTA STATUS BLOCK ADDRESS
JUMPE MTA,R ;EXIT IF NO MTA ASSOCIATED WITH MT
LOAD RSB,MTRSB ;GET REQUEST STATUS BLOCK ADDRESS
SETZRO MTAMT ;CLEAR MTA-TO-MT LINK
SETZRO MTMTA ;CLEAR MT-TO-MTA LINK
CALL SCIENA ;GET STATUS INTERRUPTS FOR THIS DRIVE
CAIN RSB,MTNAV ;RSB ASSOCIATED?
JRST PLDISU ;NO, UNLOAD DRIVE TO PLAY IT SAFE
CALL ACCMTD ;SEND ACCOUNT INFO TO MONITOR
CALL CKMPAV ;DID OPERATOR SET MTA UNAVAILABLE?
JRST PLDISU ;YES, UNLOAD IT
JE TM%NUL,RSBUFL(RSB),PLDISU ;JUMP IF USER WANTS VOLUME UNLOADED
CALL REW ;IS MTA OFFLINE?
JRST PLDISU ;YES, NO HOPE FOR RE-USE
MOVEI T1,[ASCIZ/Remaining mounted on drive/]
CALL WODISA ;TELL OPERATOR THAT USER RELEASED TAPE
LOAD T1,MTALT ;GET LABEL TYPE
CAIE T1,.LTUNL ;UNLABELLED?
JRST PLDSA1 ;NO, DON'T TOUCH VOLID
SETZM MTAVOL(MTA) ;CLEAR VOLID
SETZM MTAIDV(MTA) ;AND OPERATOR KEYIN
PLDSA1: JE MA%AVS,MTAFLG(MTA),[CALLRET MATCHV] ;TRY MATCHUP IF NON-AVR
MOVX T1,MA%UXV+MA%OPF+MA%SCR
ANDCAM T1,MTAFLG(MTA) ;CLEAR SOME FLAGS
SETZRO MTALT ;CLEAR MTALT SO AVR WILL WORK
CALLRET AVR ;INITIATE AVR SEQUENCE FOR DRIVE
; AVR SEQUENCE MAY NOT BE PERFORMED UPON TAPE
PLDISU: LOAD T1,MTALT ;GET LABEL TYPE
CAIN T1,.LTUNL ;UNLABELLED?
JRST [SETZM MTAVOL(MTA) ;YES, CLEAR VOLID
SETZM MTAIDV(MTA) ;AND OPERATOR KEYIN
JRST .+1] ;CONTINUE
CALL UNLOAD ;UNLOAD THE DRIVE
MOVEI T1,[ASCIZ/Being unloaded/]
CAIE RSB,MTNAV ;IF NO RSB, DON'T GIVE MESSAGE
CALL WODISA ;TELL OPERATOR THAT USER RELEASED TAPE
CALL CKMPAV ;DID OPERATOR SET MTA NOT-AVAILABLE?
CALL DACMTA ;YES, DEACTIVATE MTA
RET ;NO
; PRQABT - PURGE ABORTED REQUESTS FROM MOUNT REQUEST QUEUE
; RETURNS +1: ALWAYS
PRQABT::SAVEAC <T1> ;Save T1
QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB>
; SEARCH MOUNT REQUEST QUEUE AND EXTRACT ABORTED REQUESTS
PRQAB1: CALL QMSCAN ;GET ADDRESS OF NEXT RSB ON QUEUE
RET ;NONE LEFT, EXIT
MOVEI RSB,-RSBLNK(T2) ;LOAD RSB AC WITH RSB ADDRESS
CALL CHKAB ;REQUEST ABORTED?
SKIPA ;YES
JRST PRQAB1 ;NO, SKIP IT
LOAD T1,RSBTYP ;GET TYPE OF REQUEST
CAIN T1,.MNTTP ;TAPE MOUNT?
JRST [ JN RSBMT,,PRQAB1 ;YES, SKIP IF USER STILL HAS MT DEVICE
CALL VQDEL ;RELEASE VOLID LIST
JRST .+1] ;CONTINUE DELETION LOGIC
; DEQUEUE AND DISCARD ABORTED RSB
SKIPE RSBWTB+WTBCOD(RSB) ;IS WTB ACTIVE?
CALL STOP ;YES, CRASH!!!
MOVX T1,R%OPR
TDNN T1,RSBIFL(RSB) ;WAS THIS REQUEST FROM OPR?
CALL RLSMSG ;NO, TELL QUASAR TO RELEASE THIS ITN
CALL QMDQS ;DEQUEUE RSB, GET LINKAGE ADDR IN T2
MOVEI T1,IRBQDB ;GET QDB ADDRESS
CALL QMQH ;QUEUE RSB TO HEAD OF INACTIVE QUEUE
JRST PRQAB1 ;CONTINUE SCAN OF RSB QUEUE
; PRQPID - PURGE REQUESTS FROM MOUNT REQUEST QUEUE WHOSE OWNERS
; HAVE DELETED THEIR PIDS BEFORE THE FIRST VOLUME WAS MOUNTED
; RETURNS +1: ALWAYS
PRQPID: QSCANI ARBQDB ;SET UP TO SCAN ACTIVE RSB QUEUE
SAVEAC <RSB>
PURGR1: CALL QMSCAN ;GET ADDR OF NEXT RSB IN T2
RET ;END OF RSB QUEUE, EXIT
MOVEI RSB,-RSBLNK(T2) ;COPY RSB ADDRESS TO RSB AC
CALL CHKAB ;REQUEST ABORTED?
JRST PURGR1 ;YES, SKIP IT
CALL VALPID ;CHECK PID
JFCL ;REQUEST ABORTED
JRST PURGR1 ;CONTINUE SEARCH
; VALPID - ABORT REQUEST IF PID IS DELETED
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST ABORTED BECAUSE USER PID WAS DELETED
; +2: REQUEST NOT ABORTED
VALPID: LOAD T1,RSBTYP
CAIN T1,.MNTTP ;TAPE REQUEST?
JRST [ JE RSBMT,,.+1 ;YES, DOES THE USER HAVE AN MT?
RETSKP] ;YES, DON'T DO PID CHECK
CAIN T1,.MNTDT ;DECTAPE-MOUNT REQUEST?
SKIPN RSBDTA(RSB) ;DOES USER HAVE THE DTA?
SKIPA ;NO TO EITHER
RETSKP ;USER HAS DECTAPE, PRESERVE REQUEST
MOVEI T1,.MUFOJ
MOVE T2,RSBPID(RSB) ;GET USER'S PID
CALL XMUTIL ;IS IT STILL VALID?
JRST [ CALL WORCAN ;NO, TELL OPERATOR REQ WAS CANCELED
ABTRET (ABRTNR)] ;ABORT REQUEST
RETSKP ;PID STILL GOOD
; VOLMNT - ATTEMPT TO MATCH REQUEST WITH MOUNTED VOLUME; IF THIS IS
; NOT POSSIBLE, THE OPERATOR IS TOLD TO MOUNT THE VOLUME
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
VOLMNT: CALL VQCNT ;GET # OF VOLUMES IN SET IN T1
LOAD T2,RSBCV ;GET CURRENT VOLUME #
MOVX T3,R%WVL
TDNN T3,RSBIFL(RSB) ;NEED TO ASK OPERATOR FOR NEXT VOLID?
CAMG T2,T1
SKIPA T1,[RST.WM] ;NO
JRST [ MOVEI T1,RST.WV ;YES
STOR T1,RSBSTE ;SET STATE TO WAITING FOR VOLID KEYIN
CALL TCKP ;TELL QUASAR
MOVEI T1,VOLMT2 ;GET END-ACTION ADDRESS
CALLRET WRNXTV] ;GO ASK FOR NEXT VOLID
STOR T1,RSBSTE ;SET STATE TO WAITING FOR TAPE MOUNT
SETZRO R%ONR,RSBIFL(RSB) ;CLEAR OPERATOR-NOTIFIED FLAG
CALL TCKP ;SEND CHECKPOINT MESSAGE TO QUASAR
CALL MATCHR ;MATCH REQUEST TO VOLUME
CALL CHKAB ;REQUEST ABORTED?
RET ;YES, BACK TO CALLER
LOAD T1,RSBSTE ;GET STATE TO SEE WHAT MATCHR DID
CAIE T1,RST.WM ;STILL WAITING FOR A MOUNT?
RET ;NO, EXIT
CALLRET WOVMT ;TELL OPERATOR TO MOUNT VOLUME
; PROCESS RESPONSE TO WTOR ASKING OPERATOR TO SUPPLY NEXT VOLID
VOLMT2: MOVEI RSB,-RSBWTB(T2) ;LOAD RSB AC
CALL PNVR ;PARSE RESPONSE
JRST [ MOVEI T1,VOLMT2 ;BAD RESPONSE, GET END-ACTION ADDRESS
CALLRET WRNXTV] ;LET HIM TRY IT AGAIN
JUMPN T1,R ;RETURN NOW IF REQUEST ABORTED
JRST VOLMNT ;GOT THE VOLID, NOW GO GET IT MOUNTED
; VOLSW - PERFORM TAPE VOLUME-SWITCH
; T1/ ABSOLUTE VOLUME NUMBER TO SWITCH TO
; MT/ ADDR OF MT STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
VOLSW: SAVEAC <MTA,ACC>
STAKT
LOAD T2,RSBCV ;GET CURRENT VOLUME #
CAMN T1,T2 ;SWITCHING TO SAME VOLUME?
JRST [ LOAD MTA,MTMTA ;YES, GET MTA STATUS BLK ADDR
CALLRET MOLOC] ;HOOK UP MT&MTA AGAIN
CALL PLDISA ;DISASSOCIATE MTA FROM MT
LOAD ACC,RSBACC ;GET ACC
GTAD ;GET TIME
MOVEM T1,ACCSCD(ACC) ;SAVE IN ACCOUNT BLOCK AS SCHEDULED TIME
CALL VQCNT ;GET # OF VOLUMES IN SET
ADDI T1,1 ;ADD 1 IN CASE EXPANDING VOLUME SET
SKIPLE T2,CT1 ;ERROR IF GOING TO VOLUME BEFORE FIRST
CAMLE T2,T1 ;ERROR IF GOING BEYOND END OF SET
JRST [ ABTRET (MREQX8)] ;ATTEMPT TO SWITCH TO VOL OUTSIDE SET
STOR T2,RSBCV ;SET CURRENT VOLUME # IN RSB
CALLRET VOLMNT ;GET THE REQUESTED VOLUME MOUNTED
; VRA - ASSOCIATE USER REQUEST AND TAPE VOLUME (IF POSSIBLE)
; MTA/ ADDR OF MTA STATUS BLOCK OF DRIVE TO BE CHECKED
; RSB/ ADDR OF USER REQUEST STATUS BLOCK
; RETURNS +1: FAILED, REQUEST MAY BE ABORTED
; +2: SUCCESS, MT/ ADDR OF MT STATUS BLOCK
VRA: SAVEQ
MOVE T1,MTAFLG(MTA)
LOAD T2,MTASTE
CAIN T2,S.AV ;INELIGIBLE IF DRIVE NOT AVAIL TO USERS
TXNN T1,MA%LOD ;INELIGIBLE IF DRIVE NOT LOADED
RET
SKIPN MTAVOL(MTA) ;IS VOLUME IDENTIFIED?
TXNE T1,MA%SCR ; OR SCRATCH?
SKIPA ;YES TO EITHER, PROCEED
RET ;BOTH NO
JN MTAJCT,,R ;INELIGIBLE IF AVR IN PROGRESS
JN MTAMT,,R ;INELIGIBLE IF DRIVE IN USE
LOAD T1,RSBSTE ;GET STATE OF REQUEST
CAIE T1,RST.WM ;WAITING FOR VOLUME TO BE MOUNTED?
RET ;NO
; REQUEST AND DRIVE ARE IN THE PROPER STATES... A GOOD SIGN
MOVEI Q1,VRACCN ;ASSUME NOT REQUESTING SCRATCH
CALL VQGCV ;GET CURRENT VOLID IN T1
SKIPN T1 ;WANT SCRATCH VOLUME?
MOVEI Q1,VRACCS ;YES, CALL SCRATCH ROUTINE
CALL (Q1) ;CALL APPROPRIATE ROUTINE
RET ;WRONG VOLUME OR REQUEST ABORTED
; MISCELLANEOUS CHECKS BEFORE I ASSIGN AN MT TO THE USER
CALL VALPID ;CHECK FOR DELETED PID
RET ;REQUEST ABORTED
CALL REW ;CHECK IF DRIVE IS REALLY LOADED
RET ;NO, DON'T ASSIGN
LOAD T1,MA%WEN,MTAFLG(MTA) ;GET DRIVE WRITE STATUS
LOAD T2,TM%WEN,RSBUFL(RSB) ;GET REQUESTED WRITE STATUS
CAME T1,T2 ;DO DRIVE AND USER AGREE?
JRST [ CALL UNLOAD ;NO, UNLOAD THE DRIVE
CALLRET WOWPE] ;TELL THE OPERATOR TO FIX IT
; GET MT DEVICE FOR THIS REQUEST IF IT DOESN'T ALREADY HAVE ONE
LOAD MT,RSBMT ;GET MT STATUS BLOCK ADDRESS
JUMPE MT,[CALL MTGET ;NO MT YET, ANY MT'S AVAILABLE?
RET ;NO, FAILED
JRST .+1] ;MT AC LOADED (NOT ALLOC'ED YET)
CALL VQCNT ;GET # OF VOLIDS IN REQUEST
LOAD T2,RSBCV ;GET CURRENT VOLUME #
CAMGE T1,T2 ;ASSIGNING SCRATCH TAPE TO USER?
JRST [ MOVE T1,MTAVOL(MTA) ;YES, GET VOLID OF TAPE
CALL VQADD ;TACK VOLID ON THE END OF LIST
RET ;REQUEST ABORTED (RESOURCES EXHAUSTED)
JRST .+1]
; PUT VALUES IN DEFAULTED RSB FIELDS (DENSITY, DRIVE-TYPE, LABEL-TYPE)
LOAD T1,MTADRV ;DRIVE-TYPE
LOAD T2,RSBDRV
SKIPN T2
STOR T1,RSBDRV
LOAD T1,MTALT ;LABEL-TYPE
LOAD T2,RSBLT
SKIPN T2
STOR T1,RSBLT
LOAD T1,RSBLT ;DENSITY
CAIE T1,.LTUNL ;LABELED?
JRST [ LOAD T1,MTADEN ;YES
LOAD T2,RSBDEN
SKIPN T2
STOR T1,RSBDEN
MOVX T1,MA%SCR
MOVX T2,R%WVL
TDNE T1,MTAFLG(MTA) ;SCRATCH TAPE?
IORM T2,RSBIFL(RSB) ;YES, INSURE LABELS GET REWRITTEN
CALL LTINIT ;WRITE LABELS IF NECESSARY
RET ;ERROR
JRST .+1]
; ALLOC THE MT TO THE USER (HAPPENS WHEN MOUNTING THE FIRST TAPE OF SET)
LOAD Q1,RSBMT ;HAVE I ALLOC'ED THE MT TO THE USER YET?
JUMPE Q1,[CALL MTALC ;NO, ALLOC MT TO USER
RET ;ALLOC FAILED (USER DISAPPEARED)
JRST .+1] ;MT DEVICE ALLOC'ED TO USER JOB
; MT DEVICE ASSIGNED TO USER JOB - ASSOCIATE MTA WITH MT
MOVE T1,MTASET(MTA) ;GET SETNAME FROM TAPE
SKIPN RSBASN(RSB) ;DOES THIS REQUEST HAVE A SETNAME YET?
MOVEM T1,RSBASN(RSB) ;NO, USE SETNAME FROM HDR1 ON TAPE
CALL MTAGJF ;GET MAGTAPE JFN
MOVEI T2,.MOINF ;GET TAPE INFO
MOVEI T3,.MOIWF ;LENGTH OF INFO BLOCK
MOVEM T3,TAPEBK
MOVEI T3,TAPEBK ;INFO INTO TAPEBK
MTOPR ;GET IT
CALL MTARJF ;RELEASE JFN
MOVE T1,TAPEBK+.MOIRD ;Number of physical records read
MOVEM T1,ACCPR(ACC)
MOVE T1,TAPEBK+.MOIWT ;Number of physical records written
MOVEM T1,ACCPW(ACC)
MOVE T1,TAPEBK+.MOIRF ;GET FRAMES READ
IDIVI T1,^D1000 ;IN THOUSANDS
MOVEM T1,ACCFR(ACC)
MOVE T1,TAPEBK+.MOIWF ;GET FRAMES WRITTEN
IDIVI T1,^D1000 ;IN THOUSANDS
MOVEM T1,ACCFW(ACC)
MOVE T1,TAPEBK+.MOISR ;GET NUMBER OF SOFT READ ERRORS
MOVEM T1,ACCSR(ACC)
MOVE T1,TAPEBK+.MOISW ;GET NUMBER OF SOFT WRITE ERRORS
MOVEM T1,ACCSW(ACC)
MOVE T1,TAPEBK+.MOIHR ;GET NUMBER OF HARD READ ERRORS
MOVEM T1,ACCHR(ACC)
MOVE T1,TAPEBK+.MOIHW ;GET NUMBER OF HARD WRITE ERRORS
MOVEM T1,ACCHW(ACC)
CALL MOLOC ;ISSUE JSYS TO ASSOCIATE MT WITH MTA
CALL SCIDIS ;DON'T TAKE INTERRUPTS FROM THIS MTA
SKIPN Q1 ;WAS MT DEVICE JUST GIVEN TO USER?
CALL TELUSR ;YES, SEND IPCF CONFIRMATION MSG TO USER
; PERFORM MISCELLANEOUS POST-ASSOCIATION TASKS
GTAD
LOAD ACC,RSBACC ;GET ADDRESS OF ACCOUNT BLOCK
MOVEM T1,ACCSVT(ACC) ;STORE SERVICED-TIME
SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR MESSAGE OUTSTANDING?
CALL CANWTR ;YES, CANCEL IT
MOVEI T1,RST.AC
STOR T1,RSBSTE ;SET STATE TO ACTIVE
STOR MT,MTAMT ;PUT MT STATUS BLK ADDR IN MTA STAT BLK
STOR MTA,MTMTA ;PUT MTA STATUS BLK ADDR IN MT STAT BLK
CALL TCKP ;TELL QUASAR ABOUT STATE CHANGE
MOVX T1,MA%SCR
ANDCAM T1,MTAFLG(MTA) ;NOT SCRATCH AFTER I GIVE IT TO USER
CALL WOASO ;TELL OPERATOR ABOUT ASSOCIATION
RETSKP
; VRACCN - CHECK COMPATIBILITY OF NON-SCRATCH REQUEST AND TAPE VOLUME
; T1/ SIXBIT VOLID BEING REQUESTED
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NOT COMPATIBLE OR REQUEST ABORTED
; +2: COMPATIBLE
VRACCN: SAVEQ
CAME T1,MTAVOL(MTA) ;DO I HAVE THE RIGHT VOLUME?
RET ;NO
LOAD T1,RSBDRV ;DID USER SPECIFY A DRIVE TYPE?
JUMPN T1,[LOAD T2,MTADRV ;YES, GET ACTUAL DRIVE TYPE
CAMN T1,T2 ;DO THEY MATCH?
JRST .+1 ;YES
ABTRET (MREQ11)] ;NO, ABORT REQUEST
JN TM%BYP,RSBUFL(RSB),VRACN3 ;IF BYPASS, JUST CHECK DENSITY
JE MTALT,,[LOAD Q1,MA%AVE,MTAFLG(MTA) ;TAPE NOT AVR'ED YET
SETONE MA%AVE,MTAFLG(MTA) ;FORCE AVR
CALL AVR ;INITIATE AVR SEQUENCE
STOR Q1,MA%AVE,MTAFLG(MTA) ;RESTORE AVR-ENABLED FLAG
RET] ;YOU HAVE TO WAIT UNTIL AVR IS DONE
JN R%WVL,RSBIFL(RSB),VRACN2 ;SPECIAL CASE IF WRITING VOL LABELS
LOAD T1,RSBLT ;CHECK LABEL TYPES
LOAD T2,MTALT
JUMPN T1,[CAMN T1,T2 ;USER SPECIFIED LT, DOES IT MATCH TAPE?
JRST .+1 ;YES, PROCEED
ABTRET (MREQ12)] ;NO, LABEL TYPE MISMATCH
CAIN T2,.LTUNL ;WHAT KIND OF REQUEST?
JRST VRACN3 ;UNLABELED, CHECK DRIVE CAPABILITIES
LOAD T1,RSBDEN ;DID USER SPECIFY DENSITY?
JUMPN T1,[LOAD T2,MTADEN ;YES, GET DENSITY OF TAPE
CAMN T1,T2 ;DO REQUEST AND TAPE DENSITIES MATCH?
JRST .+1 ;YES, PROCEED
ABTRET (MREQ10)] ;MISMATCHED DENSITY
MOVX T1,TM%VFY
TDNE T1,RSBUFL(RSB) ;CHECKING SETNAME OF LABELED TAPE?
JRST [ MOVE T1,RSBSSN(RSB) ;YES, GET SETNAME FROM RSB
CAMN T1,MTASET(MTA) ;DOES IT MATCH SETNAME OF VOLUME?
JRST .+1 ;YES
ABTRET (MREQ14)] ;MISMATCHED SET NAME
RETSKP
; REWRITING VOLUME LABELS
VRACN2: CALL VRWLT ;LABEL TYPES COMPATIBLE?
JRST [ ABTRET (MREQ12)] ;NO, LABEL TYPE MISMATCH
; MAKE SURE THE DRIVE WILL HANDLE THE REQUESTED DENSITY
VRACN3: LOAD T1,RSBDEN ;ANY DENSITY SPECIFIED?
JUMPE T1,RSKP ;NO, IT'S OK
CALL DRVDEN ;WILL THE DRIVE HANDLE IT?
JRST [ CALL UNLOAD ;NO, UNLOAD IT
CALLRET WOWDDR] ;TELL OPERATOR AND POSTPONE REQUEST
RETSKP ;DRIVE CAN HANDLE THE DENSITY, OK
; VRACCS - CHECK COMPATIBILITY OF SCRATCH REQUEST AND TAPE VOLUME
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NOT COMPATIBLE
; +2: COMPATIBLE
VRACCS: JE MA%SCR,MTAFLG(MTA),R ;REJECT VOLUME IF NOT A SCRATCH
LOAD T1,RSBDRV ;GET REQUESTED DRIVE TYPE
JUMPN T1,[LOAD T2,MTADRV ;GET DRIVE-TYPE OF DRIVE
CAME T1,T2 ;SAME DRIVE TYPE?
RET ;NO
JRST .+1]
LOAD T1,RSBDEN ;GET REQUESTED DENSITY
JUMPN T1,[CALL DRVDEN ;CAN THE DRIVE OPERATE AT THIS DENSITY?
RET ;NO, THIS SCRATCH WON'T WORK
JRST .+1]
CALLRET VRWLT ;CHECK IF LABEL TYPES ARE COMPATIBLE
; VRWLT - TAPE VOLUME LABELS WILL BE REWRITTEN - CHECK IF LABEL TYPES
; OF REQUEST AND VOLUME ARE COMPATIBLE
; MTA/ ADDR OF MTA STATUS BLOCK
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: LABELED-UNLABELED OR UNLABELED-LABELED
; +2: UNLABELED-UNLABELED OR LABELED-LABELED
VRWLT: LOAD T1,RSBLT ;GET REQUESTED LABEL TYPE
JUMPE T1,RSKP ;NOT PARTICULAR, THIS ONE WILL DO
LOAD T2,MTALT ;GET LABEL TYPE OF TAPE
MOVE T3,[CAIE T2,.LTUNL] ;ASSUME HE WANTS UNLABELED SCRATCH
CAIE T1,.LTUNL ;RIGHT?
HRLI T3,(CAIN T2,) ;NO, WANTS LABELED
XCT T3 ;COMPARE REQUEST AND VOLUME
RET ;UNLABELED-LABELED OR LABELED-UNLABELED
RETSKP ;LABELED-LABELED OR UNLABELED-UNLABELED
SUBTTL SUBROUTINES
; ACTMTA - ACTIVATE AN MTA DEVICE (INITIALIZE STATUS BLOCK, ETC.)
; MTA/ ADDR OF MTA STATUS BLOCK
; T1/ MTA STATE CODE
; RETURNS +1: T1/ owning job if assigned to another job or error code
; +2: SUCCESS, MTA ACTIVATED
ACTMTA: STKVAR <ACTCOD,<MTOBLK,MOSTAL>>
MOVEM T1,ACTCOD ;SAVE STATE CODE
JN MTASTE,,RSKP ;RETURN GOOD IF ALREADY ACTIVATED
; ASSIGN MTA TO MY JOB
CALL GMTADD ;GET DEVICE DESIGNATOR
ASND ;TRY TO ASSIGN DEVICE TO MY JOB
;**;[6040]At ACTMTA:+5L add 2 lines GAS
JRST [ CAIE T1,DEVX2 ;[6040] Assigned to another job?
RET ;[6040] Nope, return T1/ error code
CALL GMTADD ;GET DESIGNATOR
DVCHR
HLRZ T1,T3 ;GET T1/ OWNER'S JOB#
RET]
; TRY TO OPEN DRIVE. IF THIS FAILS ANOTHER PROCESS IN THIS JOB IS USING
; THE DRIVE.
CALL MTAGJF ;GET JFN ON MTA
MOVX T2,FLD(17,OF%MOD)+FLD(10,OF%BSZ)+OF%OFL+OF%RD
OPENF ;TRY TO OPEN
JRST [ CAIE T1,OPNX9 ;SOMEONE ELSE HAS THE DRIVE?
JRST .+1 ;NO IT IS OK
CALL MTARJF ;YES, DUMP JFN
SETZM T1 ;SET SPECIAL JOB FLAG
RET ] ;EXIT SADLY
SETONE MA%OPN,MTAFLG(MTA) ;SET OPEN JFN FLAG
CALL MTACLS ;CLOSE MTA
; INITIALIZE MTA STATUS BLOCK AND ENABLE FOR STATUS-CHANGE INTERRUPT
SETZM (MTA) ;ZERO 1ST WORD OF STATUS BLOCK
MOVS T1,MTA ;BLT SOURCE
HRRI T1,1(MTA) ;BLT DESTINATION
BLT T1,MTASZ-1(MTA) ;CLEAR ENTIRE STATUS BLOCK
MOVE T1,ACTCOD
STOR T1,MTASTE ;SET STATE
CALL SCIENA ;RECEIVE STATUS CHANGE INTERRUPTS
MOVEI T1,MTOBLK ;GET MOSTA ARG BLOCK ADDRESS
CALL MOSTA ;GET MTA STATUS & CHARACTERISTICS
MOVE T1,.MODVT+MTOBLK ;Get drive type
STOR T1,MTADVT ;Save as device type
MOVE T1,.MODDN+MTOBLK ;GET SUPPORTED DENSITIES
HLLM T1,MTASDN(MTA) ;STORE SUPPORTED DENSITIES
LOAD T1,SJ%7TR,.MOTRK+MTOBLK ;GET 7-TRACK FLAG
MOVE T2,[EXP .TMDR9,.TMDR7](T1) ;GET DRIVE TYPE CODE
STOR T2,MTADRV ;STORE DRIVE TYPE IN STATUS BLOCK
TRC T1,1 ;GET 0 FOR 7-TRACK, 1 FOR 9-TRACK
STOR T1,MA%AVS,MTAFLG(MTA) ;STORE AVR-SUPPORTED FLAG
CALL AVRENA ;ENABLE AVR (IF LEGAL)
RETSKP
; AREQ - DRIVER FOR ABTREQ MACRO, ABORTS USER REQUEST
; ARET - DRIVER FOR ABTRET MACRO, ABORTS REQUEST AND DOES RET
; RSB/ ADDR OF REQUEST STATUS BLOCK
; CALL: ABTREQ (abortcode,flags)
; OR
; ABTRET (abortcode,flags)
AREQ:: SKIPA T2,[AOS (P)] ;GET AREQ INSTRUCTION
ARET:: MOVE T2,[ADJSP P,-1] ;GET ARET INSTRUCTION
MOVE T1,@(P) ;GET FLAGS AND CODE
XCT T2 ;EXECUTE INSTRUCTION BASED ON ENTRY
SAVEAC <MT,ACC>
HRRZ T2,T1 ;GET CODE
TXNE T1,ABT%IN ;INDIRECT?
MOVE T2,(T2) ;YES, GET CODE FROM LOCATION
LOAD T3,RSBSTE ;GET CURRENT STATE OF REQUEST
CAIE T2,ABRTNR ;FORCE STORE IF NO-REPLY ABORT
CAIGE T3,.ERBAS ;STORE IF REQUEST NOT ABORTED YET
JRST [ STOR T2,RSBSTE ;STORE CODE INTO RSB STATE FIELD
LOAD T2,ABT%OP,T1 ;GET OPERATOR-RESPONSE-PRESENT FLAG
STOR T2,R%ORES,RSBIFL(RSB) ;COPY FLAG TO RSB
LOAD T1,RSBTYP ;GET REQUEST TYPE
CAIE T1,.MNTTP ;TAPE-MOUNT?
JRST .+1 ;NO
JE RSBMT,,.+1 ;DON'T UPDATE STATUS IF RSB GOING AWAY
CALL TCKP ;UPDATE QUASAR QUEUE DISPLAY
JRST .+1]
SKIPE T1,RSBWTB+WTBCOD(RSB) ;WTOR MESSAGE OUTSTANDING?
CALL CANWTR ;YES, CANCEL IT
LOAD ACC,RSBACC ;CHECK FOR ACCOUNT BLOCK PRESENT.
SKIPE ACC ;IS THERE AN ACCOUNT BLOCK?
CALL DELACC ;YES, DELETE IT.
TXO F,ABORTF ;FORCE PURGE UPON RETURN TO SCHEDULER
LOAD T1,RSBSTE ;GET REQUEST STATE
MOVE T2,RSBIFL(RSB) ;GET INTERNAL REQUEST FLAGS
TXNN T2,R%OPR ;DON'T REPLY TO OPR-ORIGINATED REQUEST
CAIN T1,ABRTNR ;DON'T REPLY IF NO-REPLY REQUESTED
RET
LOAD T1,RSBTYP
CAIE T1,.MNTTP ;TAPE RSB?
JRST [ CALLRET TELUSR] ;NO, TELL USER VIA IPCF
JE RSBMT,,[CALLRET TELUSR] ;TELL USER ON 1ST VOLUME
CALLRET TELMON ;OTHERWISE TELL MONITOR TO TELL USER
; ASMT - PLACE MT DEVICES IN THE DEVICE ALLOCATOR'S POOL
; CALLED DURING INITIALIZATION
; RETURNS +1: ALWAYS
ASMT: SAVEQ
SAVEAC <MT,MTA>
MOVSI Q1,-MAXMT ;RH(Q1)/ MT UNIT NUMBER
MOVEI MT,MT0 ;ADDRESS OF FIRST MT STATUS BLOCK
; LOOP TO PLACE ALL MT DEVICES IN THE DEVICE ALLOCATOR'S POOL
ASMT1: SETZM (MT) ;CLEAR FIRST WORD OF MT STATUS BLOCK
IFG MTSZ-1,<
MOVS T1,MT ;BLT SOURCE
HRRI T1,1(MT) ;BLT DESTINATION
BLT T1,MTSZ-1(MT) ;CLEAR REMAINDER OF MT STATUS BLOCK
>
CALL GMTDD ;GET MT DEVICE DESIGNATOR IN T1
DVCHR ;IS THIS A VALID DESIGNATOR?
ERJMP ASMT2 ;NO, SKIP NON-DEVICE
HRRZM Q1,MTN ;SET HIGHEST MT UNIT NUMBER
MOVE T2,T1 ;MOVE DESIGNATOR TO T2 FOR ALLOC
MOVEI T1,.ALCAL ;GET ALLOC FUNCTION CODE
MOVNI T3,1 ;RELEASE DEVICE TO FREE POOL
ALLOC ;TRY TO FREE UP THE DEVICE
MOVEI T1,.ALCAL ;IGNORE ERROR, RESTORE T1
MOVNI T3,2 ;ASSIGN MT TO ALLOCATOR'S POOL
ALLOC ;TRY TO ASSIGN TO ALLOCATOR
SKIPA ;FAILED
JRST ASMT2 ;ASSIGNED TO ALLOCATOR, GO DO NEXT MT
; CANNOT PUT MT IN ALLOCATOR'S POOL, SO THIS IS PROBABLY A RESTART
; AND THE MT IS STILL IN A USER'S POSSESSION. THE LOGIC HERE FINDS
; OUT WHAT MTA DEVICE IS ASSOCIATED WITH THE MT, LINKS THEM UP, AND
; BUSYS THEM OUT UNTIL THE USER RELEASES THE MT.
MOVEI T1,MTNAV ;CAN'T GET CONTROL OF MT
STOR T1,MTRSB ;RSB ADDR NON-0 TO PREVENT ALLOCATION
MOVEI T1,.MTASI ;GET MTU FUNCTION CODE
HRRZ T2,Q1 ;GET MT UNIT #
MOVEI T3,Q2 ;GET ARGUMENT BLOCK ADDRESS (Q2,Q3)
MOVEI Q2,2 ;SET LENGTH IN ARG BLOCK
MTU% ;ASK MONITOR FOR ASSIGNMENT INFO
CAIN Q3,.MTNUL ;ANY MTA ASSIGNED TO THIS MT?
JRST ASMT2 ;NO
MOVE T1,Q3 ;GET MTA UNIT #
HRLI T1,.DVDES+.DVMTA ;MAKE DESIGNATOR
CALL DDMTA ;GET MTA STATUS BLOCK ADDRESS IN MTA
CALL STOP ;BAD MTA UNIT # FROM MONITOR
MOVEI T1,S.AV ;GET AVAILABLE-TO-USER STATE
CALL ACTMTA ;ACTIVATE MTA IF POSSIBLE
JRST ASMT2 ;CAN'T, SO DON'T CROSS-LINK
STOR MT,MTAMT ;ASSOCIATE MT WITH MTA
STOR MTA,MTMTA ;...
SETONE MA%LOD,MTAFLG(MTA) ;SET DRIVE-LOADED FOR KSHS
ASMT2: ADDI MT,MTSZ ;POINT AT NEXT MT STATUS BLOCK
AOBJN Q1,ASMT1 ;LOOP THRU ALL POSSIBLE MT'S
AOS MTN ;CONVERT HIGHEST UNIT# TO # OF DEVICES
RET
; ASMTA - ASSIGN MTA DEVICES TO THIS JOB
; CALLED DURING INITIALIZATION
; RETURNS +1: ALWAYS
ASMTA: SAVEAC <MTA,Q1>
MOVSI Q1,-MAXMTA ;# OF MTA DEVICES I CAN HANDLE
MOVEI MTA,MTA0 ;ADDRESS OF MTA0: STATUS BLOCK
; LOOP TO CHECK AND POSSIBLY ACTIVATE EVERY MTA DEVICE ON THE SYSTEM
ASMTA1: SETZRO MTASTE ;SET DRIVE NOT ASSIGNED
CALL GMTADD ;GET MTA DEVICE DESIGNATOR IN T1
DVCHR ;IS THIS A VALID DESIGNATOR?
ERJMP ASMTA2 ;NO, SKIP NON-DEVICE
HRRZM Q1,MTAN ;STORE HIGHEST MTA UNIT #
CALL CKMPAV ;IS THIS DRIVE SET AVAILABLE?
JRST ASMTA2 ;NO, DON'T ASSIGN IT
MOVEI T1,S.AV ;GET AVAILABLE-TO-USER STATE
CALL ACTMTA ;ACTIVATE THE MTA
JFCL ;DON'T CARE IF I CAN'T ASND
ASMTA2: ADDI MTA,MTASZ ;POINT AT NEXT MTA STATUS BLOCK
AOBJN Q1,ASMTA1 ;LOOP THROUGH ENTIRE DEVICE TABLE
AOS MTAN ;CONVERT HIGHEST UNIT# TO # OF DEVICES
RET
; ASCIZL - COMPUTE THE LENGTH OF AN ASCIZ STRING (NOT COUNTING NULL)
; T1/ ADDRESS OF STRING
; RETURNS +1: ALWAYS, WITH LENGTH IN BYTES IN T2
ASCIZL: HRLI T1,(POINT 7) ;CONSTRUCT BYTE POINTER
SETZ T2, ;CLEAR COUNTER
ASCIL1: ILDB T3,T1 ;LOAD A BYTE
JUMPE T3,R ;EXIT IF END OF STRING
AOJA T2,ASCIL1 ;OTHERWISE, COUNT IT AND LOOP
; AVRENA - ENABLE AVR FOR DRIVE (IF AVR SUPPORTED FOR THIS DRIVE TYPE)
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
AVRENA: MOVX T1,MA%AVS
TDNN T1,MTAFLG(MTA) ;AVR SUPPORTED FOR THIS DRIVE?
RET ;NO
MOVX T1,MA%AVE
IORM T1,MTAFLG(MTA) ;SET AVR-ENABLED
RET
; BLKFND - SEARCH A GALAXY-STYLE BUILDING BLOCK ARGUMENT LIST FOR
; THE LAST OCCURRENCE OF A SPECIFIED ARGUMENT TYPE
; T1/ ADDRESS OF ARGUMENT COUNT WORD
; T2/ ADDRESS OF FIRST ARGUMENT BLOCK
; T3/ TYPE CODE OF DESIRED ARGUMENT
; RETURNS +1: NO ARGUMENTS OF REQUESTED TYPE FOUND
; +2: SUCCESS, T1/ ADDRESS OF FIRST WORD OF ARGUMENT
; T2/ LENGTH OF ARGUMENT (NOT COUNTING HEADER)
BLKFND: STKVAR <GETLA>
SETZM GETLA ;CLEAR ADDRESS OF LAST MATCHING HDR
SKIPG T1,(T1) ;GET # OF ARGUMENTS
RET ;NONE ???
BLKFN1: LOAD T4,AR.TYP,(T2) ;GET ARGUMENT TYPE CODE
CAMN T3,T4 ;DOES IT MATCH THE ONE I WANT?
MOVEM T2,GETLA ;YES, SAVE ITS ADDRESS
LOAD T4,AR.LEN,(T2) ;GET LENGTH OF THIS ENTRY
ADD T2,T4 ;COMPUTE ADDRESS OF NEXT ENTRY
SOJG T1,BLKFN1 ;LOOP UNTIL ARG COUNT EXHAUSTED
SKIPN T1,GETLA ;SCAN COMPLETE, ANY MATCHES?
RET ;NO
LOAD T2,AR.LEN,(T1) ;YES, GET SIZE OF ENTRY & HDR
SOS T2 ;SUBTRACT SIZE OF HEADER
AOJA T1,RSKP ;POINT T1 AT 1ST DATA WORD & RETURN
; CHKAB - CHECK IF MOUNT REQUEST IS ABORTED
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: REQUEST IS ABORTED
; +2: REQUEST IS NOT ABORTED
CHKAB: LOAD T1,RSBSTE ;GET STATE
CAIL T1,.ERBAS ;ABORTED?
RET ;YES
RETSKP ;NO
; CHKID - DETERMINE IF A WORD QUALIFIES AS A LEGAL SIXBIT VOLID/SETNAME
; T1/ WORD TO BE TESTED
; RETURNS +1: NOT A LEGAL VOLID/SETNAME
; +2: LEGAL VOLID SETNAME T1/ PRESERVED
CHKID: SKIPN T2,T1 ;COPY WORD TO PRESERVE T1
RET ;ALL BLANKS - ILLEGAL
CHKID1: SETZ T3, ;CLEAR T3 FOR ROTATING
ROTC T2,6 ;MOVE A CHARACTER FROM T2 INTO T3
ADJBP T3,[POINT 1,CHKCHR,0] ;GET BYTE POINTER TO BIT
LDB T3,T3 ;IS THIS A LEGAL CHARACTER?
JUMPE T3,R ;NO, ERROR RETURN
JUMPN T2,CHKID1 ;LOOP IF MORE CHARACTERS LEFT IN T2
RETSKP ;LOOKS OK TO ME
; TABLE OF LEGAL CHARACTERS FOR VOLIDS AND SETNAMES
CHKCHR: ^B111001111111111111111111111111110111 ;40-103
^B111111111111111111111110000000000000 ;104-147
; CKBSTR - CHECK GALAXY BUILDING BLOCK STRUCTURE TO VERIFY THAT ALL
; BUILDING BLOCKS LIE WITHIN THE STRUCTURE
; T1/ ENTRY COUNT
; T2/ ADDRESS OF FIRST ENTRY
; T3/ SIZE OF STRUCTURE
; RETURNS +1: ERROR WAS DETECTED
; +2: NO ERROR DETECTED
CKBSTR: JUMPL T1,R ;NEGATIVE ENTRY COUNT IS AN ERROR
JUMPL T3,R ;NEGATIVE STRUCTURE SIZE ALSO AN ERROR
JUMPE T1,RSKP ;ZERO ENTRY COUNT IS OK
CKBST1: LOAD T4,AR.LEN,(T2) ;GET SIZE OF THIS ENTRY
JUMPE T4,R ;ENTRY MUST HAVE A NON-ZERO SIZE
SUB T3,T4 ;SUBTRACT FROM REMAINING STRUCTURE SIZE
JUMPL T3,R ;ERROR IF BLOCK EXTENDS BEYOND END
ADD T2,T4 ;POINT T2 AT NEXT BLOCK
SOJG T1,CKBST1 ;LOOP THROUGH ALL BLOCKS
RETSKP ;LOOKS OK TO ME
; CKGHDR - PERFORM BASIC CONSISTENCY CHECK ON INCOMING GALAXY MESSAGE
; CKGHDR also checks whether the message is local or remote. If remote,
; the remote node name will be stored in RENODE.
; RBUF, MRPDB/ MESSAGE AND PDB
; RETURNS +1: ERROR IN HEADER
; +2: HEADER OK, T1/ SIZE OF MESSAGE IN WORDS
; T2/ MESSAGE TYPE
; RENODE/ Remote node name or zero
; RSB/ 1, no RSB at this point
CKGHDR: SETZM RENODE ;[6017]Assume local message
HLRZ T2,MRPDB+.IPCFP ;GET ACTUAL SIZE OF MESSAGE FROM PDB
LOAD T1,MS.CNT,RBUF+.MSTYP ;GET SIZE OF MESSAGE FROM GLX HEADER
CAIL T1,MSHSIZ ;CRASH IF MSG DOESN'T CONTAIN FULL HDR
CAMGE T2,T1 ;IS MSG AS BIG AS ITS HEADER CLAIMS?
RET ;NO, ERROR IN HEADER
LOAD T2,MS.TYP,RBUF+.MSTYP ;GET MESSAGE TYPE FOR CALLER
MOVE T3,RBUF+.MSFLG ;[6010]Get the message flag word
TXNN T3,MF.NEB ;[6017]From NEBULA
IFSKP.
PUSH P,T1 ;[6017]Save T1
PUSH P,T2 ;[6017]And T2
MOVEI T1,.NDENM ;[6017]Want node name
CALL ORNBLF ;[6017]Look for it
RET ;[6017]No there
MOVE T1,0(T1) ;[6017]Get remote node name from message
MOVEM T1,RENODE ;[6017]Save it
POP P,T2 ;[6017]Restore T2
POP P,T1 ;[6017]Restore T1
ENDIF.
MOVEI RSB,1 ;[6010]NO RSB
RETSKP
; CKMPAV - TEST IF TAPE DRIVE IS AVAILABLE FOR USE BY SYSTEM
; BY CHECKING STATUS BIT IN DEVICE-STATUS FILE ENTRY
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE NOT AVAILABLE
; +2: DRIVE AVAILABLE
CKMPAV: CALL GMTADD ;GET T1/ MTA DEVICE DESIGNATOR
MOVEM T1,DSFE+DSFSPC ;Save it as specification
MOVEI T2,.DVMTA ;Get the device type
MOVEM T2,DSFE+DSFTYP ;Save it
CALL DSFLOC ;Go look for it
RETSKP ;Not represented, default to available
MOVE T1,DSFE+DSFFLG ;Get the flags
TXNE T1,DSF%AV ;Is it available?
RET ;No
RETSKP ;Yes
; CLRTAP - ISSUE MTOPR TO CLEAR ERRORS IN MTA DEVICE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: GDSTS TIMED OUT
; +2: SUCCESS, AC'S SET UP:
; T1/ LAST ERROR CODE ENCOUNTERED BY PROCESS
; T2/ GDSTS T2
; T3/ # OF BYTES TRANSFERRED (LH OF GDSTS T3)
CLRTAP: SAVET ;SET UP RETURN VALUES IN STACK
CALL GETERR ;GET LAST ERROR CODE
MOVEM T1,CT1 ;GIVE TO CALLER
LOAD T1,MTAJFN ;GET JFN
IOXCT GDSTS,R,R ;GET STATUS IN T2,T3
MOVEM T2,CT2 ;GIVE T2 TO CALLER VERBATIM
HLRZM T3,CT3 ;PUT # OF BYTES XFERRED IN CALLER'S T3
MOVEI T2,.MOCLE ;GET CLEAR-ERRORS FUNCTION
MTOPR ;CLEAR ANY ERROR FLAGS
ERCAL STOP
RETSKP ;RETURN PULLING T1-T4 FROM STACK
; CTIMER - CANCEL ALL TIMER JSYS REQUESTS FOR THIS FORK
; RETURNS +1: ALWAYS
CTIMER: MOVE T1,[.FHSLF,,.TIMAL] ;FORK,,FUNCTION
SETZB T2,T3 ;PROPITIATE TIMER JSYS
TIMER ;CANCEL ALL REQUESTS FOR THIS FORK
CALL STOP
RET
; CVTA6 - CONVERT CONTIGUOUS ASCII CHARACTERS TO SIXBIT
; CVTA6R - SAME AS CVTA6, BUT INTERPRET LOWER CASE LETTERS AS UPPER CASE
; T1/ BYTE POINTER TO FIRST ASCII CHARACTER
; T2/ NUMBER OF CHARACTERS TO PROCESS
; RETURNS +1: FIELD WAS NOT A LEGAL VOLID OR SETNAME
; +2: FIELD WAS A LEGAL VOLID OR SETNAME, T1/ SIXBIT RESULT
CVTA6: TDZA T3,T3 ;REMEMBER NO-RAISE ENTRY
CVTA6R: MOVEI T3,1 ;REMEMBER RAISE ENTRY
STAKT
SETZ T1, ;CLEAR RESULT REGISTER
MOVE T4,[POINT 6,T1] ;GET BYTE POINTER FOR BUILDING RESULT
CVTA61: ILDB T3,CT1 ;GET NEXT CHARACTER FROM FIELD
CAIL T3,"a"
CAILE T3,"z" ;LOWER CASE?
JRST CVTA62 ;NO
SKIPE CT3 ;RAISING LOWER CASE?
SUBI T3,40 ;YES, DO IT
CVTA62: SUBI T3,40 ;CONVERT TO SIXBIT REPRESENTATION
TRNE T3,777700 ;OUT OF RANGE?
RET ;YES, RETURN ERROR
IDPB T3,T4 ;PACK IT INTO T1
SOJG T2,CVTA61 ;LOOP THRU ALL CHARS IN FIELD
CALLRET CHKID ;PASS JUDGMENT UPON CONVERTED VALUE
; DACMTA - UNDO THE EFFECTS OF ACTMTA (I.E. DEACTIVATE MTA DEVICE)
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
DACMTA: JE MTASTE,,R ;RETURN IF ALREADY DONE
JN MTAJCT,,R ;CAN'T DO IT IF I'M USING THE DRIVE
JN MTAMT,,R ;CAN'T DO IT IF A USER HAS THE DRIVE
CALL SCIDIS ;DON'T TAKE INTERRUPTS FROM THIS MTA
CALL GMTADD ;GET DEVICE DESIGNATOR
RELD ;RELEASE CONTROL OF DEVICE
CALL STOP
SETZRO MTASTE ;SET MTA NOT ASSIGNED
RET
; DDMT - CONVERT MT DEVICE DESIGNATOR TO STATUS BLOCK ADDRESS
; T1/ DEVICE DESIGNATOR
; RETURNS +1: FAILED, NOT A VALID MT DEVICE DESIGNATOR
; +2: SUCCESS, MT/ ADDRESS OF MT STATUS BLOCK
DDMT: HLRZ T2,T1 ;GET LEFT HALF OF DESIGNATOR
CAIN T2,.DVDES+.DVMTA ;CHECK LEFT HALF
TRZN T1,400000 ;CHECK RIGHT HALF
RET ;SOMETHING'S ROTTEN
HRRZ MT,T1 ;GET UNIT# PART OF DESIGNATOR
CAML MT,MTN ;DO I KNOW ABOUT IT?
RET ;NO, ERROR
IMULI MT,MTSZ ;COMPUTE ADDRESS
ADDI MT,MT0 ; OF STATUS BLOCK
RETSKP ;SUCCESS
; DDMTA - CONVERT MTA DEVICE DESIGNATOR TO STATUS BLOCK ADDRESS
; T1/ DEVICE DESIGNATOR
; RETURNS +1: FAILED, NOT A VALID MTA DEVICE DESIGNATOR
; +2: SUCCESS, MTA/ ADDRESS OF MTA STATUS BLOCK
DDMTA: HLRZ T2,T1 ;GET LEFT HALF OF DESIGNATOR
CAIE T2,.DVDES+.DVMTA ;IS IT AN MTA DEVICE?
RET ;NO, ERROR
HRRZ MTA,T1 ;GET RIGHT HALF OF DESIGNATOR
CAML MTA,MTAN ;DO I KNOW ABOUT IT?
RET ;NO, ERROR
IMULI MTA,MTASZ ;COMPUTE ADDRESS
ADDI MTA,MTA0 ; OF STATUS BLOCK
RETSKP ;SUCCESS
; DRVDEN - DETERMINE IF DRIVE CAN OPERATE AT A GIVEN DENSITY
; T1/ DENSITY CODE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DRIVE CANNOT OPERATE AT THIS DENSITY
; +2: DRIVE CAN OPERATE AT THIS DENSITY
DRVDEN: MOVNS T1 ;NEGATE FOR RIGHT SHIFT
MOVSI T2,(1B0)
LSH T2,(T1) ;POSITION BIT FOR INTERROGATION
TDNN T2,MTASDN(MTA) ;CAN THE DRIVE WORK AT THIS DENSITY?
RET ;NO
RETSKP ;YES
; DDCTLD - CHECK FOR REQUEST TO ENABLE OR DISABLE ^D INTERCEPT
; RETURNS +1: ALWAYS
DDCTLD: SKIPGE T1,CDFLG ;HAS A REQUEST BEEN MADE?
RET ;NO
SETOM CDFLG ;YES, CLEAR IT
JUMPE T1,[MOVEI T1,.TICCD ;REQUEST TO DISABLE ^D
DTI
TXZ F,CDENF ;RESET ^D-ENABLED
RET]
MOVX T1,<.TICCD,,DDTCN> ;REQUEST TO ENABLE ^D
ATI
TXO F,CDENF ;SET ^D-ENABLED
RET
; DDT INTERRUPT PROCESSOR
DDTIH: CALL DDTLOD ;TRY TO LOAD DDT
SKIPA ;NO CAN DO
CALL 770000 ;CALL DDT - RETURN IS R$G
MOVEI T1,.FHSUP
MOVX T2,1B0
TXNN F,CDENF ;DON'T INTERRUPT IF CALLED BY ^D
IIC ;TRIGGER CHANNEL-0 INTERRUPT UPSTAIRS
RET ;EXIT TO SCHED
; DDTLOD - LOADS DDT INTO MY ADDRESS SPACE IF NOT ALREADY THERE
; RETURNS +1: ERROR LOADING DDT
; +2: DDT LOADED SUCCESSFULLY
DDTLOD: MOVE T1,[.FHSLF,,770]
RPACS ;IS DDT LOADED ALREADY?
JXN T2,PA%PEX,RSKP ;YES, RETURN +2
MOVX T1,GJ%OLD+GJ%SHT
HRROI T2,[ASCIZ/SYS:UDDT.EXE/]
GTJFN
DDTLDX: JRST [ TMSG <% MOUNTR Can't find or get DDT>
JRST JSERR0] ;TYPE MESSAGE AND RETURN +1
HRLI T1,.FHSLF
GET
ERJMP DDTLDX
MOVE T1,.JBSYM ;GET ADDRESS OF SYMBOL TABLE
HRRZ T2,770001 ;GET ADDRESS OF WHERE TO STUFF IT
MOVEM T1,(T2) ;POINT DDT AT MY SYMBOL TABLE
RETSKP
; REENTER ADDRESS
DEBUG: MOVE P,[IOWD PDLEN,PDL] ;NEED STACK POINTER FOR CALL
CALL DDTLOD ;LOAD DDT
HALTF ;CAN'T
JRST 770000 ;GO RIGHT TO DDT
; ELOGOF - INHIBIT ERROR LOGGING FOR MAGTAPE
; ELOGON - RESTORE ERROR LOGGING FOR MAGTAPE
; MTA/ ADDR OF MTA STATUS BLOCK (MTA MUST BE OPEN)
; RETURNS +1: ALWAYS, REQUESTED FUNCTION PERFORMED
ELOGON: TDZA T3,T3 ;ENABLE ERROR LOGGING
ELOGOF: MOVEI T3,1 ;INHIBIT ERROR LOGGING
LOAD T1,MTAJFN ;GET JFN
MOVEI T2,.MOIEL ;FUNCTION = CONTROL ERROR LOGGING
IOXCT MTOPR,R,R ;SET DESIRED STATE
RET
; FNOUT - TRANSLATE A NUMBER INTO RIGHT-JUSTIFIED, ZERO-FILLED ASCII
; T1/ BYTE POINTER TO FIELD
; T2/ NUMBER
; T3/ FIELD SIZE ,, RADIX
; RETURNS +1: ALWAYS
FNOUT: HLRZ T4,T3 ;GET FIELD SIZE
ADJBP T4,T1 ;GET POINTER TO BYTE AFTER FIELD
ILDB T4,T4 ;GET BYTE FOLLOWING FIELD
TXO T3,NO%LFL+NO%ZRO ;TURN ON FLAGS
NOUT ;OUTPUT NUMBER
JFCL
IDPB T4,T1 ;FIX UP STUPID NULL LEFT BY NOUT
RET
; GALHDR - CONSTRUCT STANDARD GALAXY HEADER IN TBUF
; T1/ LENGTH OF MESSAGE (WORDS) ,, MESSAGE TYPE CODE
; T2/ MESSAGE FLAGS ,, SIXBIT SUFFIX
; T3/ ACKNOWLEDGMENT CODE
; RETURNS +1: ALWAYS, WITH GALAXY HEADER BUILT IN BEGINNING OF TBUF
; NOTE: THIS IS THE ONLY PLACE WHERE THE GALAXY HEADER IS BUILT
; IN THE ENTIRE MODULE
GALHDR: MOVEM T1,TBUF+.MSTYP
MOVEM T2,TBUF+.MSFLG
MOVEM T3,TBUF+.MSCOD
RET
; GETDEN - Get system default magtape density
; Returns +1: Always, with density in DEFDEN
GETDEN: SETO T1, ;Use value for current job
HRROI T2,DEFDEN ;Get just one word
MOVEI T3,.JIDEN ;System/job default density
GETJI
ERJMP [ MOVEI T1,.SJD16 ;Failed use 1600 BPI
MOVEM T1,DEFDEN ;as default density
JRST .+1]
RET
; GETERR - RETURN THE MOST RECENT ERROR CODE FOR THIS FORK
; RETURNS +1: ALWAYS, WITH ERROR CODE IN T1
GETERR: MOVEI T1,.FHSLF
GETER ;GET MOST RECENT ERROR IN RH OF T2
ERJMP .+1
HRRZ T1,T2 ;MOVE TO T1 STRIPPING LEFT HALF
RET
; GETVU - TRANSFER USER NAME FROM VOL2 LABEL TO CALLER'S STRING AND
; RETURN USER NUMBER CORRESPONDING TO THE USER NAME
; T1/ ADDRESS OF 8-WORD AREA TO RECEIVE ASCIZ USER NAME
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: T1/ BYTE POINTER TO CALLER'S ASCIZ USER NAME STRING
; T2/ USER # CORRESPONDING TO NAME OR 0 IF THE USER DOESN'T
; EXIST ON THE SYSTEM
GETVU: HRLI T1,(POINT 7) ;CREATE BYTE POINTER TO CALLER'S AREA
SAVET ;RETURN IT TO CALLER IN T1
MOVEI T2,V2OWN-1
ADJBP T2,[POINT 8,MTAV2(MTA)] ;GET BYTE PTR TO VOL2 USER NAME
MOVEI T3,V2OWNL ;GET MAX LENGTH OF USER NAME
GETVU1: ILDB T4,T2 ;GET CHARACTER FROM VOL2
TRZ T4,200 ;MASK OFF TRASH
CAIN T4," " ;END OF NAME?
GETVU2: SETZ T4, ;YES, TIE IT OFF WITH A NULL
IDPB T4,T1 ;COPY CHARACTER TO CALLER'S AREA
JUMPN T4,[SOJG T3,GETVU1 ;LOOP IF MORE LEFT IN VOL2 LABEL
JRST GETVU2] ;OTHERWISE WRAP UP
; NOW TRY TO IDENTIFY THE USER WITH RCUSR
SETZM CT2 ;RETURN 0 IN T2 IF RCUSR FAILS
MOVX T1,RC%EMO ;REQUEST EXACT MATCH
MOVE T2,CT1 ;GET POINTER TO CALLER'S STRING
RCUSR ;TRY TO RECOGNIZE USER NAME
ERJMP R ;FAILED
TXNN T1,RC%NOM ;GOT A MATCH?
MOVEM T3,CT2 ;YES, RETURN USER # IN T2
RET
; GMTADD - GET MTA DEVICE DESIGNATOR
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH DEVICE DESIGNATOR IN T1
GMTADD: MOVE T1,MTA ;COPY STATUS BLK ADDR
SUBI T1,MTA0 ;COMPUTE OFFSET FROM START OF BLOCKS
IDIVI T1,MTASZ ;COMPUTE MTA UNIT #
HRLI T1,.DVDES+.DVMTA ;ADD LEFT HALF OF DEVICE DESIGNATOR
RET
; GMTADS - ISSUE MTOPR AND RETURN MTA DEVICE STATUS
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ .MOSTA STATUS WORD .MOCST
GMTADS: STKVAR <<MTOBLK,MOSTAL>>
MOVEI T1,MTOBLK ;GET ARG BLOCK ADDRESS
CALL MOSTA ;GET STATUS & CHARACTERISTICS
MOVE T1,.MOCST+MTOBLK ;GET STATUS INFO FOR CALLER
TXNE T1,SJ%OFS ;OFFLINE?
TXZ T1,SJ%REW ;YES, CAN'T BE REWINDING THEN
RET
; GMTDD - GET MT DEVICE DESIGNATOR
; MT/ ADDR OF MT STATUS BLOCK
; RETURNS +1: ALWAYS, WITH DEVICE DESIGNATOR IN T1
GMTDD: MOVE T1,MT ;COPY STATUS BLK ADDR
SUBI T1,MT0 ;COMPUTE OFFSET FROM START OF BLOCKS
IDIVI T1,MTSZ ;COMPUTE MT UNIT #
TDO T1,[.DVDES+.DVMTA,,400000] ;ADD THE FRILLS
RET
; GTINAM - GET INSTALLATION NAME FROM FILE
; RETURNS +1: ALWAYS, ASCIZ INSTALLATION NAME IN TAPNAM
GTINAM: MOVX T1,GJ%SHT+GJ%ACC+GJ%OLD
HRROI T2,[ASCIZ/SYSTEM:TAPNAM.TXT/]
GTJFN ;GET JFN ON FILE
RET ;NO JFN, NO ARBEIT
MOVE T4,T1 ;SAVE JFN
MOVX T2,FLD(7,OF%BSZ)+OF%RD
OPENF ;OPEN FILE FOR READ ACCESS
JRST [ MOVE T1,T4 ;OPEN FAILED, GET JFN
RLJFN ;DUMP IT
JFCL
RET]
HRROI T2,TAPNAM ;GET ADDRESS OF TEXT IN CORE
MOVNI T3,TPNMSZ ;GET MAX # OF BYTES TO READ
SIN ;READ 'EM IN
ERJMP .+1 ;IGNORE ERRORS
CLOSF ;CLOSE FILE, DUMP JFN
JFCL
MOVE T1,[POINT 7,TAPNAM] ;GET POINTER TO TEXT
GTINM1: ILDB T2,T1 ;GET A BYTE
JUMPE T2,R ;EXIT IF END OF STRING
CAIE T2,.CHCRT ;CARRIAGE-RETURN?
JRST GTINM1 ;NO, CONTINUE SCAN
SETZ T2, ;YES
DPB T2,T1 ;DELETE C/R AND EVERYTHING AFTER IT
RET
; INAP - PERFORM INITIALIZATION RELATED TO ASSOCIATED PROCESSES
; RETURNS +1: ALWAYS
INAP: SAVEQ
MOVEI Q1,APNUM ;GET # OF A/P'S
INAP1: SOJL Q1,R ;EXIT IF NONE LEFT
CALL @APINI(Q1) ;CALL A/P INIT ROUTINE
JRST INAP1 ;LOOP THRU ALL A/P TABLE ENTRIES
; INT26 - CONVERT INTEGER TO SIXBIT, RIGHT-JUSTIFIED ZERO-FILLED
; T1/ INTEGER
; RETURNS +1: ALWAYS, T1/ SIXBIT RESULT
INT26: MOVM T2,T1 ;GET ABSOLUTE VALUE
IDIV T2,[^D1000000] ;GET NUMBER MOD 1000000 IN T3
MOVE T1,[EXP 0] ;INIT RESULT
MOVE T2,[POINT 6,T1,35] ;GET POINTER TO RESULT
INT261: IDIVI T3,12 ;PEEL OFF A DIGIT
ADDI T4,20 ;CONVERT INTEGER TO SIXBIT
DPB T4,T2 ;STORE INTO T1
ADD T2,[6B5] ;BACK UP BYTE POINTER
JUMPN T3,INT261 ;LOOP IF MORE TO DO
RET
;INT26L - CONVERT INTEGER TO SIXBIT, LEFT-JUSTIFIED ZERO-FILLED
;T1/ INTEGER
;RETURNS +1: ALWAYS, T1/SIXBIT RESULT
INT26L: MOVM T2,T1 ;Get absolute value
IDIV T2,[^D1000000] ;Get number MOD 1000000 in T3
MOVE T2,[POINT 6,T1] ;Set up a pointer
SETZ T1, ;Initialize the sixbit value
I26LOP: IDIVI T3,^D10 ;Convert the number
PUSH P,T4 ;Save the digit
SKIPE T3 ;Check if completed
CALL I26LOP ;Standard recursive algorithm
POP P,T4 ;Restore the digit
ADDI T4,20 ;Convert to sixbit
IDPB T4,T2 ;Store the digit
RET ;And return
; IOXCTR - DRIVER FOR IOXCT MACRO; EXECUTES AND TIMES OUT A JSYS
; T1-T4/ ARGUMENTS FOR JSYS
; CALL: IOXCT <JSYS,ERJMP ADDRESS,TIMEOUT ADDRESS>
; RETURNS TO ERJMP ADDRESS IF JSYS ERJMP'ED
; TO TIMEOUT ADDRESS IF JSYS TIMED OUT
; TO INSTRUCTION AFTER IOXCT MACRO IF JSYS SUCCEEDED
; ALL RETURNS: T1-T4 CONTAINING VALUES RETURNED BY JSYS
; CAUTION - IN ORDER TO PICK UP THE ARGUMENTS THAT FOLLOW THE CALL,
; THIS ROUTINE DOES SOME SHADY THINGS WITH THE STACK
IOXCTR:: CALL [ SAVET ;PRESERVE AC'S FOR JSYS
MOVE T1,[14,,.SYSTA]
GETAB ;GET CURRENT LOAD AVERAGE
CALL STOP ;SHOULD NEVER FAIL
FIXR T2,T1 ;CONVERT TO AN INTEGER
IMULI T2,3 ;TIMES 3
CAIGE T2,^D180 ;[334]Wait at least 3 minutes
MOVEI T2,^D180 ;[334]
MOVE T1,[.FHSLF,,.TIMEL] ;FORK,,FUNCTION
IMULI T2,^D1000 ;CONVERT SECONDS TO MILLISECONDS
MOVEI T3,JTOCN ;GET INTERRUPT CHANNEL #
TIMER ;SET UP FOR INTERRUPT
JFCL
RET]
TXO F,JTOAF ;SET JSYS-TIMEOUT-ARMED
XCT @(P) ;EXECUTE JSYS
ERJMP [TXZ F,JTOAF ;DISARM TIMER
CALL [ SAVET
CALLRET CTIMER] ;CANCEL TIMER
POP P,CX ;GET ADDRESS OF CALL+1
HLRZ CX,1(CX) ;GET ERJMP ADDRESS
JRST (CX)] ;RETURN TO ERJMP ADDRESS
TXZ F,JTOAF ;DISARM TIMER
CALL [ SAVET
CALLRET CTIMER] ;CANCEL TIMER
AOS (P) ;RETURN TO
RETSKP ; CALL+3
; INTERRUPT HANDLER FOR TIMER JSYS INTERRUPT
JTOIH: TXZN F,JTOAF ;TIMER STILL ARMED?
DEBRK ;NO, DON'T DO ANYTHING
MOVEM T1,@LEVTAB+PRIEXT-1 ;SAVE T1
MOVE T1,[PC%USR+IOXCT1] ;GET NEW PC
EXCH T1,@LEVTAB+PRIEXT-1 ;RESTORE T1, SET NEW PC
DEBRK ;DEBREAK TO IOXCT1
IOXCT1: POP P,CX ;TIMEOUT OCCURRED, GET ADDR OF CALL+1
HRRZ CX,1(CX) ;GET TIMEOUT-HANDLER ADDRESS
JRST (CX) ;EXIT TO CALLER'S TIMEOUT HANDLER
; LDATIN - PARSE AND RETURN DATE FROM TAPE LABEL (IN FORM " YYDDD")
; T1/ ILDB POINTER TO FIRST CHARACTER OF DATE FIELD
; RETURNS +1: DATE CONTAINED NON-NUMERIC CHARACTERS OR WAS ILLEGAL
; +2: DATE PARSED SUCCESSFULLY,
; T1/ YEAR,,JULIANDAY OR 0 (IF DATE WAS " 00000")
LDATIN: SAVEQ
IBP T1 ;SKIP OVER THE SPACE
MOVE Q1,T1 ;MOVE POINTER TO ANOTHER PLACE
SETO Q2, ;SET FOR 1ST PASS
LDAT1: MOVEI T4,3(Q2) ;COMPUTE # OF DIGITS TO SCAN
SETZ T2, ;CLEAR ACCUMULATOR
LDAT2: ILDB T3,Q1 ;GET NEXT CHARACTER
CAIL T3,"0" ;ERROR IF .LT. 0
CAILE T3,"9" ; OR .GT. 9
RET
IMULI T2,^D10 ;SHIFT CONTENTS OF ACCUMULATOR
ADDI T2,-"0"(T3) ;ADD IN NEW DIGIT
SOJG T4,LDAT2 ;LOOP
AOJE Q2,[MOVS T1,T2 ;DOING YEAR, GET T1/ YEAR-1900,,0
JRST LDAT1] ;NOW GO BACK AND DO THE DAY
JUMPE T2,[JUMPE T1,RSKP ;IF YEAR=DAY=0, RETURN GOOD WITH T1/ 0
RET] ;IF DAY=0 BUT YEAR.NE.0, ERROR
CAILE T2,^D366 ;IS DAY TOO LARGE?
RET ;YES, ERROR
HRR T1,T2 ;GET YEAR-1900,,JULIANDAY
ADD T1,[^D1900,,0] ;ADD IN THE 1900
RETSKP
; MOSTA - ISSUE .MOSTA MTOPR TO GET TAPE DRIVE CHARACTERISTICS AND STATUS
; NOTE - THIS MTOPR FUNCTION MUST BE GUARANTEED NOT TO BLOCK
; T1/ ADDRESS OF BLOCK TO RECEIVE INFORMATION (MOSTAL WORDS LONG)
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH INFORMATION IN ARGUMENT BLOCK
MOSTA: STAKT
CALL MTAGJF ;GET JFN FOR MTOPR IN T1
MOVEI T2,.MOSTA ;MTOPR FUNCTION CODE
MOVE T3,CT1 ;GET ADDR OF ARGUMENT BLOCK
MOVEI T4,MOSTAL
MOVEM T4,(T3) ;PUT LENGTH IN FIRST WORD OF BLOCK
MTOPR ;GET STATUS INFO INTO ARG BLOCK
CALLRET MTARJF ;RELEASE JFN AND RETURN
; MOVSTR - MOVE ASCIZ STRING (TRAILING NULL IS NOT MOVED)
; T1/ SOURCE STRING POINTER
; T2/ DESTINATION STRING POINTER
; STRING POINTERS MAY BE OF THE FORM: -1,,ADDRESS
; RETURNS +1: ALWAYS
MOVSTR: TLC T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
TLC T2,-1
TLCN T2,-1
HRLI T2,(POINT 7)
MOVST1: ILDB T3,T1
JUMPE T3,R
IDPB T3,T2
JRST MOVST1
; MTAGJF - GET A JFN ON MTA DEVICE
; MTA/ MTA STATUS BLOCK
; RETURNS +1: ALWAYS, WITH JFN IN MTAJFN AND T1
MTAGJF: JN MTAJCT,,MTAGJ1 ;JFN EXISTS ALREADY, USE IT
STKVAR <<GJFTXT,2>>
CALL GMTADD ;GET DEVICE DESIGNATOR IN T1
MOVE T2,T1 ;MOVE TO T2 FOR DEVST
HRROI T1,GJFTXT ;GET ADDRESS OF TEXT BUFFER
DEVST ;BEGIN JFN STRING WITH "MTAn"
CALL STOP
MOVEI T2,":"
IDPB T2,T1 ;TACK ON A COLON
SETZ T2,
IDPB T2,T1 ;TERMINATE WITH A NULL
MOVX T1,GJ%SHT+GJ%ACC ;GTJFN FLAGS
HRROI T2,GJFTXT ;POINTER TO STRING
GTJFN ;GET JFN ON MTA DEVICE
CALL STOP
STOR T1,MTAJFN ;STORE JFN IN TABLE
MTAGJ1: INCR MTAJCT ;INCREMENT JFN-IN-USE COUNT
LOAD T1,MTAJFN ;GET JFN FOR CALLER
RET
; MTARJF - RELEASE MTA JFN OBTAINED WITH MTAGJF
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
MTARJF: LOAD T1,MTAJCT ;GET JFN-IN-USE COUNT
SOSGE T1 ;GOING NEGATIVE?
CALL STOP ;YES, PROGRAM LOGIC ERROR
STOR T1,MTAJCT ;STORE NEW COUNT
JUMPG T1,R ;EXIT IF JFN STILL IN USE
LOAD T1,MTAJFN ;GET JFN
RLJFN ;DISCARD IT
CALL STOP
SETZRO MTAJFN ;CLEAR JFN JUST TO PLAY IT SAFE
RET
; MTAOPI - GET A JFN OPEN FOR READ ON AN MTA DEVICE
; MTAOPO - GET A JFN OPEN FOR WRITE ON AN MTA DEVICE
; MTA/ ADDR OF MTA STATUS BLOCK (DENSITY SET FROM MTADEN)
; RETURNS +1: FAILED, DRIVE OFFLINE OR WRITE-LOCKED
; +2: SUCCESS, JFN IN MTAJFN AND T1
MTAOPI: SKIPA T1,[OF%RD] ;OPEN FOR READ ACCESS
MTAOPO: MOVX T1,OF%WR ;OPEN FOR WRITE ACCESS
SAVEQ
MOVE Q1,T1 ;SAVE MODE
MOVE T1,MTAFLG(MTA) ;GET MTA FLAGS
TXNE T1,MA%OPN ;JFN OPEN ALREADY?
CALL STOP ;YES, PROGRAM FAILURE
CALL MTAGJF ;GET JFN ON MTA
MOVX T2,FLD(17,OF%MOD)+FLD(10,OF%BSZ)
TDO T2,Q1 ;SET MODE BIT
OPENF ;OPEN THE JFN
JRST [ CAIN T1,OPNX8 ;DEVICE OFFLINE?
JRST [ SETZRO MA%LOD,MTAFLG(MTA) ;YES, UPDATE STATUS
CALLRET MTARJF] ;DUMP JFN AND TAKE +1
CAIE T1,OPNX25 ;DEVICE WRITE PROTECTED?
CALL STOP ;NO, CAN'T HACK THIS ONE
CALLRET MTARJF] ;YES, DUMP JFN AND TAKE +1
SETONE MA%OPN,MTAFLG(MTA) ;SET JFN-OPEN FLAG
MOVEI T2,.MOSDM
MOVEI T3,.SJDM8 ;SPECIFY INDUSTRY-COMPATIBLE MODE
MTOPR ;SET DATA MODE OF DRIVE
SKIPE UNLD ;Skip if the tape is not being unloaded
JRST [ SETZM UNLD ;Reset tape unloading flag
RETSKP ] ;Return +2, T1/ JFN
MOVEI T2,.MOSDN
LOAD T3,MTADEN ;GET DESIRED DENSITY CODE
MTOPR ;SET DENSITY
RETSKP ;RETURN +2, T1/ JFN
; MTACLS - CLOSE MTA JFN
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
MTACLS: MOVX T1,MA%OPN
TDNN T1,MTAFLG(MTA) ;IS THE JFN OPEN?
CALL STOP ;NO, PROGRAM FAILURE
ANDCAM T1,MTAFLG(MTA) ;IT'LL BE CLOSED WHEN I GET DONE
LOAD T1,MTAJFN ;GET MTA JFN
LOAD T2,MTAJCT ;GET JFN-IN-USE COUNT
SOSGE T2 ;GOING NEGATIVE?
CALL STOP ;YES, PROGRAM LOGIC ERROR
STOR T2,MTAJCT ;STORE NEW COUNT
SKIPE T2 ;DOES SOMEONE ELSE NEED THE JFN?
TXO T1,CO%NRJ ;YES, DON'T DUMP JFN, JUST CLOSE IT
TXO T1,CZ%ABT ;CLOSE WITHOUT BLOCKING
CLOSF ;CLOSE (AND POSSIBLY DISCARD) JFN
CALL STOP
JUMPN T2,R ;EXIT IF JFN STILL IN USE
SETZRO MTAJFN ;CLEAR JFN JUST TO PLAY IT SAFE
RET
; NMTRSB - GET ADDRESS OF NEXT MAGTAPE MOUNT RSB
; NSTRSB - GET ADDRESS OF NEXT STRUCTURE MOUNT OR DISMOUNT RSB
; NXXRSB - GET ADDRESS OF NEXT ACTIVE RSB
; QSB/ ADDR OF QUEUE SCAN BLOCK FOR ARBQDB
; RETURNS +1: NO RSB'S LEFT
; +2: SUCCESS, RSB/ ADDR OF REQUEST STATUS BLOCK
NMTRSB: SAVEQ
JSP Q1,NRSB1 ;SETUP COROUTINE ADDRESS IN Q1
CAIE T1,.MNTTP ;COROUTINE FOR TAPE MOUNT
JRST NRSB1
RETSKP
NSTRSB: SAVEQ
JSP Q1,NRSB1 ;SETUP COROUTINE ADDRESS IN Q1
CAIE T1,.MNTST ;COROUTINE FOR STRUCTURE MNT/DSMNT
CAIN T1,.DSMST
RETSKP
JRST NRSB1
NXXRSB: SAVEQ
JSP Q1,NRSB1 ;SETUP COROUTINE ADDRESS IN Q1
RETSKP ;COROUTINE TO SUCCEED FOR ANY RSB
; CHECK NEXT RSB TO SEE IF IT QUALIFIES
NRSB1: CALL QMSCAN ;GET ADDRESS OF RSB LINKAGE IN T2
RET ;END OF RSB LIST
MOVEI RSB,-RSBLNK(T2) ;LOAD RSB AC
CALL CHKAB ;REQUEST ABORTED?
JRST NRSB1 ;YES, SKIP IT
LOAD T1,RSBTYP ;LIVE RSB, GET TYPE FOR COROUTINE
JRST (Q1) ;DISPATCH TO COROUTINE
; PB ROUTINES - CONSTRUCT GALAXY-STYLE BUILDING-BLOCK LIST IN TBUF
; PBINIT - SET UP DATABASE FOR CALLS TO OTHER PB ROUTINES
; RETURNS +1: ALWAYS
PBINIT: SAVET ;[6010]Save T ACs
XMOVEI T1,TBUF+.OARGC ;GET ADDRESS OF ARGUMENT COUNT WORD
MOVEI T2,TBUF+.OHDRS ;GET ADDRESS OF FIRST BUILDING BLOCK
MOVEM T1,PBACW ;SAVE ADDR OF ARGUMENT COUNT WORD
SETZM (T1) ;ZERO THE ARGUMENT COUNT
MOVEM T2,PBBPT ;SAVE ADDR OF 1ST BUILDING BLOCK
RET
; PBBLK - ADD PREFORMATTED BUILDING BLOCK TO LIST
; T1/ ADDRESS OF BUILDING BLOCK WITH HEADER
; RETURNS +1: ALWAYS
PBBLK: SAVET ;[6010]Save T ACs
LOAD T2,AR.LEN,(T1) ;GET LENGTH OF BLOCK
MOVE T3,T2 ;Get length in words
IMULI T3,5 ;Turn it to bytes
EXCH T3,PBLFT ;flop them for sub
SUBB T3,PBLFT ;number of bytes left in tbuf
MOVSS T1 ;BLT SOURCE
HRR T1,PBBPT ;BLT DESTINATION
ADDB T2,PBBPT ;COMPUTE ADDR OF NEXT BLOCK
BLT T1,-1(T2) ;MOVE BLOCK INTO LIST
AOS @PBACW ;BUMP ARG COUNT
RET
; PBTXT - CONSTRUCT ASCIZ TEXT BUILDING BLOCK
; T1/ ADDRESS OF ASCIZ TEXT
; T2/ ARGUMENT TYPE CODE
; RETURNS +1: ALWAYS
PBTXT: MOVE T4,PBBPT ;GET ADDR OF BLOCK HEADER
STOR T2,AR.TYP,(T4) ;STORE TYPE CODE IN HEADER
HRLI T1,(POINT 7) ;Get default byte pointer to source
CAIN T2,.WTTYP ;[6010]Is it the header?
JRST PBTXT0 ;[6010]Yes, use what is in T1
SKIPLE MORTXT ;Is this a continuation
MOVE T1,MORTXT ;Yes, restore byte pointer
SETZM MORTXT ;Clear text continuation byte pointer
PBTXT0: MOVEI T2,1(T4) ;[6010]COMPUTE ADDRESS OF TEXT IN BLOCK
HRLI T2,(POINT 7) ;GET BYTE POINTER TO DESTINATION
PBTXT1: ILDB T3,T1 ;GET BYTE
IDPB T3,T2 ;TRANSFER IT
JUMPE T3,PBTXT7 ;End of this message
SOSLE PBLFT ;Can orion handle more text
JRST PBTXT1 ;Yes, pick up next character
MOVEI T3,BYTEND ;Pick up number of bytes left in the buffer
MOVEM T3,PBLFT ;Store in byte count left
PBTXT2: ILDB T3,T1 ;Pick up the next character
IDPB T3,T2 ;Place into the buffer
JUMPE T3,PBTXT7 ;End of the ASCIZ string
SOSG PBLFT ;Update the number of bytes left in the buffer
JRST PBTXT6 ;This should never happen, no more space
CAIN T3,.CHCRT ;Is this a carriage return?
JRST PBTXT3 ;Yes, go do end of message processing
CAIE T3,.CHLFD ;No, is this a line feed?
JRST PBTXT2 ;No, pick up the next character
;A carriage return or line feed has been found. Pick up any more if room
PBTXT3: MOVE T4,T1 ;Save the pointer
PBTXT4: ILDB T3,T1 ;Pick up the next character
SKIPN T3 ;End of the ASCIZ string?
JRST [ IDPB T3,T2 ;Yes, place the null in the buffer
MOVE T4,PBBPT ;Restore block pointer address
JRST PBTXT7] ;Finish processing this packet
CAIN T3,.CHCRT ;Carriage return?
JRST PBTXT5 ;Yes, include it in this packet
CAIN T3,.CHLFD ;No, is it a line feed?
JRST PBTXT5 ;Yes, include it in this packet
MOVE T1,T4 ;No,restore the pointer to TMCMSG
JRST PBTXT6 ;Finish processing this packet
PBTXT5: IDPB T3,T2 ;Include the CR or LF in this packet
SOSLE PBLFT ;Update the amount of space left
JRST PBTXT4 ;Go pick up the next character
PBTXT6: MOVX T4,WT.MOR ;More message for next time
IORM T4,BTFLGS ;Save it
MOVE T4,PBBPT ;Addr of block header
SKIPE T3 ;Was last byte a nul
MOVEM T1,MORTXT ;No, save byte pointer of next text
PBTXT7: MOVEI T2,1(T2) ;GET ADDR OF WORD AFTER LAST TEXT WORD
MOVEM T2,PBBPT ;UPDATE BLOCK POINTER
SUB T2,T4 ;COMPUTE LENGTH OF BLOCK
STOR T2,AR.LEN,(T4) ;PUT LENGTH IN HEADER
AOS @PBACW ;BUMP ARG COUNT
RET
; PROTIN - CONVERT 6-DIGIT ASCII PROTECTION CODE TO FIXED-POINT INTEGER
; T1/ BYTE POINTER TO PROTECTION CODE
; RETURNS +1: CODE CONTAINED AT LEAST 1 NON-OCTAL DIGIT
; +2: SUCCESS, T1/ CODE
PROTIN: MOVE T4,T1 ;COPY POINTER TO T4
SETZ T1, ;INIT VALUE AC
MOVEI T2,6
PROT1: ILDB T3,T4 ;GET ASCII CHAR
SUBI T3,"0"
TRNE T3,777770 ;LEGAL OCTAL DIGIT?
RET ;NO
LSH T1,3 ;YES, SHIFT TO MAKE ROOM
ADD T1,T3 ;ADD IN THIS DIGIT
SOJG T2,PROT1 ;LOOP
RETSKP
; QUEUE-MANAGING ROUTINES
; ADD AND REMOVE PACKETS FROM QUEUES; QUEUES ARE DEFINED BY A
; 1-WORD QUEUE DESCRIPTOR WITH ADDRESS OF HEAD PACKET IN LEFT
; HALF AND ADDRESS OF TAIL IN RIGHT. IF ZERO, QUEUE IS EMPTY.
; QMDQH - DEQUEUE THE HEAD PACKET OF A QUEUE
; T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
; RETURNS +1: QUEUE WAS EMPTY
; +2: SUCCESS, T2/ ADDRESS OF DEQUEUED HEAD PACKET
QMDQH: HLRZ T2,(T1) ;GET ADDRESS OF HEAD PACKET
JUMPE T2,R ;IF EMPTY, QUIT NOW
SKIPN T3,(T2) ;QUEUE GOING TO BE EMPTY?
SETZM (T1) ;YES, CLEAR DESCRIPTOR BLOCK
HRLM T3,(T1) ;SET NEW HEAD POINTER IN QDB
RETSKP
; QMQH - ADD A PACKET TO THE HEAD OF A QUEUE
; T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
; T2/ ADDRESS OF PACKET TO BE ADDED TO HEAD OF QUEUE
; RETURNS +1: ALWAYS
QMQH: HLRZ T3,(T1) ;GET ADDRESS OF CURRENT HEAD
HRLM T2,(T1) ;SET ADDRESS OF NEW HEAD IN QDB
JUMPE T3,[HRRM T2,(T1) ;QUEUE WAS EMPTY, SET NEW TAIL
SETZM (T2) ;CLEAR LINKAGE IN ONLY ENTRY
RET]
MOVEM T3,(T2) ;POINT NEW HEAD AT OLD HEAD
RET
; QMQT - ADD A PACKET TO THE TAIL OF A QUEUE
; T1/ ADDRESS OF QUEUE DESCRIPTOR BLOCK
; T2/ ADDRESS OF PACKET TO BE ADDED TO TAIL OF QUEUE
; RETURNS +1: ALWAYS
QMQT: SETZM (T2) ;CLEAR LINKAGE IN NEW TAIL
HRRZ T3,(T1) ;GET CURRENT TAIL ADDRESS
HRRM T2,(T1) ;SET NEW TAIL
JUMPE T3,[HRLM T2,(T1) ;QUEUE WAS EMPTY, SET NEW HEAD
RET]
MOVEM T2,(T3) ;POINT OLD TAIL AT NEW TAIL
RET
; ROUTINES ON THIS PAGE ARE USED FOR SCANNING A QUEUE, POSSIBLY
; WITH THE INTENT OF DEQUEUEING ONE OF ITS ENTRIES.
; QUEUE-SCAN-BLOCK (QSB) OFFSETS:
QSB.QB==0 ;OFFSET TO QUEUE DESCRIPTOR BLOCK
QSB.LE==1 ;OFFSET TO LAST ENTRY SCANNED
QSB.LP==2 ;OFFSET TO ENTRY BEFORE LAST ENTRY
; QSCNIR - DRIVER FOR QSCANI MACRO
; CALL: QSCANI qdb-address
QSCNIR::PUSH P,QSB ;SAVE QSB AC
MOVEI QSB,1(P) ;GET ADDRESS OF QSB IN STACK
PUSH P,(CX) ;QSB.QB - QDB ADDRESS
PUSH P,[0] ;QSB.LE - ADDRESS OF LAST ENTRY SCANNED
PUSH P,[0] ;QSB.LP - ADDRESS OF ENTRY BEFORE THAT
CALL 1(CX) ;BACK TO CALLER FOR A WHILE
TRNA ;NON-SKIP RETURN
AOS -4(P) ;SKIP RETURN
ADJSP P,-3 ;DELETE QSB FROM STACK
POP P,QSB ;RESTORE QSB AC
RET ;TAKE +1 OR +2
; QMSCAN - RETURN ADDRESS OF NEXT ENTRY IN QUEUE
; QSB/ ADDRESS OF QUEUE SCAN BLOCK
; RETURNS +1: NO ENTRIES REMAINING IN QUEUE
; +2: SUCCESS, T2/ ADDRESS OF NEXT ENTRY IN QUEUE
QMSCAN: SKIPN T2,QSB.LE(QSB) ;FIRST CALL FOR THIS QUEUE SCAN?
JRST [ SETZM QSB.LP(QSB) ;YES, CLEAR OLD-LAST ADDRESS
HLRZ T2,@QSB.QB(QSB) ;GET ADDRESS OF HEAD PACKET
JRST QMS1]
MOVEM T2,QSB.LP(QSB) ;NOT FIRST TIME, SET OLD-LAST
MOVE T2,(T2) ;GET ADDRESS OF NEXT PACKET
QMS1: MOVEM T2,QSB.LE(QSB) ;SET NEW-LAST
JUMPN T2,RSKP ;TAKE +2 IF I FOUND SOMETHING
RET ;OTHERWISE +1
; QMDQS - DEQUEUE LAST PACKET RETURNED BY QMSCAN
; QSB/ ADDRESS OF QUEUE SCAN BLOCK
; RETURNS +1: ALWAYS, T2/ ADDRESS OF DEQUEUED PACKET
QMDQS: MOVE T2,QSB.LE(QSB) ;GET ADDRESS OF ENTRY TO BE DEQUEUED
MOVE T3,QSB.LP(QSB) ;GET ADDRESS OF PREVIOUS ENTRY
MOVEM T3,QSB.LE(QSB) ;FIX LE IN CASE QMSCAN IS CALLED AGAIN
SKIPN T4,(T2) ;GET ADDR OF FOLLOWING ENTRY
HRRM T3,@QSB.QB(QSB) ;IF DEQING TAIL, SET NEW TAIL IN QDB
JUMPE T3,[HRLM T4,@QSB.QB(QSB) ;DEQING HEAD, SET NEW HEAD IN QDB
RET]
MOVEM T4,(T3) ;NOT HEAD, FIX LINKAGE IN PREDECESSOR
RET
; REW - INITIATES A REWIND OPERATION ON AN MTA
; REWEA - LIKE REW, BUT ALSO SCHEDULES A CALLER-SPECIFIED ROUTINE
; WHEN THE REWIND IS COMPLETE
; T1/ ADDRESS OF END-ACTION ROUTINE THAT WILL BE ENTERED WHEN
; REWIND OPERATION IS COMPLETE (REWEA ONLY)
; MTA/ ADDR OF STATUS BLOCK
; RETURNS +1: DEVICE OFFLINE OR TIMED OUT
; +2: REWIND OPERATION INITIATED
; CONTROL IS GIVEN TO END-ACTION ROUTINE WHEN REWIND
; COMPLETES. MTA AC WILL HAVE ADDR OF MTA STATUS BLK.
; NOTE: SINCE NOT ALL THE MAGTAPE HARDWARE IS CONSCIENTIOUS ABOUT
; REPORTING STATUS CHANGES, THIS PROGRAM RELIES HEAVILY UPON
; DEVICE OPERATIONS (IN PARTICULAR, REWIND) TO DETERMINE THE
; LOADED/UNLOADED STATUS OF A TAPE DRIVE. THE BASIC LINE OF
; REASONING IS: IF SJ%OFS IS SET THEN BELIEVE IT; IF IT IS
; RESET, CHECK FOR ONLINE/OFFLINE BY ISSUING A REWIND MTOPR.
REW: SETZ T1,
REWEA: SAVEQ
MOVEI Q3,1 ;SET UP FOR SUCCESSFUL RETURN
MOVE Q2,T1 ;SAVE END-ACTION ADDRESS
LOAD T1,MTAREA
SKIPE T1 ;END-ACTION ALREADY REQUESTED?
CALL STOP ;YES, PROGRAM LOGIC FAILURE
CALL MTAGJF ;GET JFN NOW TO LIMIT GTJFN CALLS
CALL GMTADS ;GET MTA DEVICE STATUS
JXN T1,SJ%OFS,[SETZRO MA%LOD,MTAFLG(MTA) ;OFFLINE, SAY SO
CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
JXN T1,SJ%REW,[CALL MTARJF ;REWINDING ALREADY, DUMP JFN
STOR Q2,MTAREA ;SET END-ACTION ADDRESS
RETSKP] ;TAKE SUCCESSFUL RETURN
LOAD Q1,MA%OPN,MTAFLG(MTA) ;IS MTA JFN OPEN ALREADY?
JUMPE Q1,[CALL MTAOPI ;NO, OPEN IT
SKIPA ;OFFLINE
JRST .+1 ;OPENED
CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
CALL MTARJF ;UN-NEST PRIOR MTAGJF
CALL ELOGOF ;DON'T LOG ERRORS
MOVEI T1,.MOREW
MOVEI T2,1 ;REPEAT COUNT
CALL XMTOPR ;INITIATE REWIND
SETZ Q3, ;OFFLINE OR TIMED OUT, SET +1 RETURN
CALL ELOGON ;RESTORE ERROR LOGGING
STOR Q3,MA%LOD,MTAFLG(MTA) ;SET STATE (LOADED/UNLOADED)
SKIPN Q1 ;SKIP IF I DIDN'T OPEN MTA
CALL MTACLS ;I OPENED IT, SO I'LL CLOSE IT
JUMPE Q3,R ;TAKE ERROR RETURN IF INDICATED
STOR Q2,MTAREA ;GOOD RETURN, SET END-ACTION ADDR
RETSKP
; SCIDIS - DISABLE STATUS-CHANGE INTERRUPTS FROM MTA DEVICE
; SCIENA - ENABLE STATUS-CHANGE INTERRUPTS FROM MTA DEVICE
; WHEN A TAPE DRIVE IS ENABLED FOR STATUS-CHANGE INTERRUPTS, THE
; FOLLOWING EVENTS CAUSE A PSI INTERRUPT ON CHANNEL "TDSCCN":
; TRANSITION TO ONLINE, TRANSITION TO OFFLINE, REWIND COMPLETE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
SCIDIS: SKIPA T2,[0,,-1]
SCIENA: MOVEI T2,TDSCCN
MOVEI T1,2 ;BUILD ARG BLOCK IN CT1 AND CT2
STAKT
CALL MTAGJF ;GET JFN ON MTA
MOVEI T2,.MOOFL ;MTOPR FUNCTION CODE
MOVEI T3,CT1 ;GET ADDRESS OF ARG BLOCK
MTOPR ;ENABLE OR DISABLE
CALLRET MTARJF ;DUMP JFN AND EXIT
; SIXASC - CONVERT SIXBIT WORD TO ASCII STRING
; T1/ SIXBIT WORD
; T2/ BYTE POINTER TO ASCII DESTINATION STRING
; RETURNS +1: ALWAYS, 6 CHARACTERS PLACED IN DESTINATION STRING
SIXASC: MOVE T4,T2 ;MOVE POINTER OUT OF T2
MOVEI T3,6
SIXAS1: SETZ T2, ;CLEAR FOR SHIFT
ROTC T1,6 ;GET A SIXBIT CHARACTER
ADDI T2,40 ;CONVERT TO ASCII
IDPB T2,T4 ;STORE CHARACTER
SOJG T3,SIXAS1
RET
; SAVEQR - DRIVER FOR SAVEQ MACRO
SAVEQR::ADJSP P,3 ;CREATE ROOM ON STACK FOR Q1-Q3
DMOVEM Q1,-2(P) ;STACK Q1 & Q2
MOVEM Q3,0(P) ;STACK Q3
CALL (CX) ;BACK TO CALLER
TRNA ;NON-SKIP RETURN
AOS -3(P) ;SKIP RETURN
DMOVE Q1,-2(P) ;RESTORE Q1 & Q2
MOVE Q3,0(P) ;RESTORE Q3
ADJSP P,-3 ;DELETE TEMP SPACE FROM STACK
RET ;BACK TO CALLER'S CALLER +1 OR +2
; SAVETR - DRIVER FOR SAVET MACRO
SAVETR::ADJSP P,4 ;CREATE ROOM ON STACK FOR T1-T4
DMOVEM T1,-3(P) ;STACK T1 & T2
DMOVEM T3,-1(P) ;STACK T3 & T4
CALL (CX) ;BACK TO CALLER
TRNA ;NON-SKIP RETURN
AOS -4(P) ;SKIP RETURN
DMOVE T1,-3(P) ;RESTORE T1 & T2
DMOVE T3,-1(P) ; T3 & T4
ADJSP P,-4 ;DELETE TEMP SPACE FROM STACK
RET ;BACK TO CALLER'S CALLER +1 OR +2
; STAKTR - DRIVER FOR STAKT MACRO
STAKTR::ADJSP P,4 ;CREATE ROOM ON STACK FOR T1-T4
DMOVEM T1,-3(P) ;STACK T1 & T2
DMOVEM T3,-1(P) ;STACK T3 & T4
CALL (CX) ;BACK TO CALLER
TRNA ;NON-SKIP RETURN
AOS -4(P) ;SKIP RETURN
ADJSP P,-4 ;DELETE TEMP SPACE FROM STACK
RET ;BACK TO CALLER'S CALLER +1 OR +2
; SMPAV - SET AVAILABLE STATUS OF TAPE DRIVE
; T1/ 0 TO SET DRIVE UNAVAILABLE, 1 TO SET DRIVE AVAILABLE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
SMPAV: STAKT
SKIPE T1,MTAPNT(MTA) ;Do we have a DDB?
JRST [CALL DSFGET ;Yes, go get DDB
$STOP <Invalid DDB pointer in magtape status block>
JRST SMPA.1] ;Continue with common code
CALL GMTADD ;Get designator
MOVEM T1,DSFE+DSFSPC ;Save it as specification
MOVEI T1,.DVMTA ;Get type
MOVEM T1,DSFE+DSFTYP ;Save it
SETZM DSFE+DSFFLG ;Default flags
CALL DSFCRE ;Try to create
JFCL ;Don't care if already exists
; Now have DDB in DSFE
SMPA.1: MOVE T2,CT1 ;GET AVAILABLE OR UNAVAILABLE FLAG
STOR T2,DSF%AV,DSFE+DSFFLG ;STORE FLAG
CALL DSFUDE ;Update entry
$STOP <Update of previously known DDB with DSFUDE failed>
RET ;And done
; STMTA - CONVERT AN ASCIZ STRING TO AN MTA STATUS BLOCK ADDRESS
; T1/ ADDRESS OF ASCIZ STRING FOR MTA (IN FORM SUITABLE FOR STDEV JSYS)
; RETURNS +1: STRING DOES NOT SPECIFY MTA DEVICE
; +2: MTA/ ADDR OF MTA STATUS BLOCK
STMTA: HRLI T1,-1 ;GET STRING POINTER TO ASCIZ DEVNAME
STDEV ;TRANSLATE STRING TO DEV DESIGNATOR
RET ;NOT A DEVICE
MOVE T1,T2 ;GET DESIGNATOR
CALLRET DDMTA ;CONVERT TO MTA STATUS BLOCK ADDR IN MTA
; STOPNW - Same as STOP but a message is supplied.
; Invoked by:
; $STOP <message>
STPHLP: BLOCK 1 ;Local storage location
STOPNW:: ;New stop with message
SETOM STPHLP ;Say we came in here
SKIPA ;Don't execute first instruction in STOP
; STOP - A FATAL ERROR WAS DETECTED; PROGRAM MUST HALT
; INVOKED BY:
; CALL STOP
STOP:: SETZM STPHLP ;Say we came in here
MOVEM 17,CRSHAC+17 ;SAVE AC'S FROM CRASH
MOVEI 17,CRSHAC
BLT 17,CRSHAC+16
MOVEI T1,.FHSLF
SETZ T2,
GETER ;GET MOST RECENT ERROR
ERJMP .+1
HRRZM T2,LSTERR ;STORE IT FOR ANALYSIS
DIR ;DISABLE ALL INTERRUPTS
TMSG <
?MOUNTR crashing, PC = >
MOVEI T1,.PRIOU
HRRZ T2,CRSHAC+P ;GET TOP-OF-STACK ADDRESS
HRRZ T2,(T2) ;GET ADDRESS OF CALL + 1
SOS T2 ;GET ADDRESS OF CALL
MOVE T3,[NO%ZRO+NO%LFL+FLD(6,NO%COL)+10]
NOUT ;TYPE PC
JFCL
TMSG <
> ;Add a CRLF after number of crash PC
SKIPE STPHLP ;Do we want a message?
JRST [AOS T2 ;Yes, point to it
HRRO T1,(T2) ;Setup pointer to error message
PSOUT ;Print it
ERJMP STOP0 ;Don't believe/care about errors
TMSG <
> ;Add a CRLF after message
JRST STOP0] ;Continue on
STOP0: SKIPE TSTF ;TESTING?
JRST [ TMSG <Test flag set, not saving MOUNTR core image>
;YES, DON'T SAVE CORE IMAGE
JRST STOP1]
; SAVE CORE IMAGE IN CRASH FILE
MOVX T1,GJ%SHT+GJ%FOU+GJ%ACC
HRROI T2,CFSPEC ;GET POINTER TO FILESPEC
GTJFN ;GET JFN ON CRASH FILE
JRST STOP2
MOVE Q2,T1 ;COPY JFN TO A SAFE PLACE
TMSG <Saving MOUNTR core image on file >
MOVEI T1,.PRIOU
MOVE T2,Q2 ;JFN
SETZ T3,
JFNS ;DISPLAY FILESPEC
ERJMP STOP2
MOVSI T1,.FHSLF
HRR T1,Q2 ;FORK HANDLE,,JFN
MOVE T2,[-1000,,SS%CPY] ;ALL PAGES OF PROCESS, COPY-ON-WRITE
SETZ T3,
SSAVE ;SAVE CORE IMAGE
ERJMP STOP2
JRST STOP1 ;SKIP AROUND FAILURE-PROCESSOR
; ERROR SAVING CORE IMAGE, REPORT IT
STOP2: TMSG <
?Cannot save MOUNTR core image: >
MOVEI T1,.PRIOU
HRLOI T2,.FHSLF ;FORK HANDLE ,, -1 (MOST RECENT ERROR)
SETZ T3, ;NO LIMIT
ERSTR ;SHOW WHY SAVE FAILED
JFCL
JFCL
STOP1: MOVSI 17,CRSHAC ;GET BLT SOURCE,,DESTINATION
BLT 17,17 ;RESTORE AC'S TO CRASH STATE
HALTF
; STOPP - STOP BECAUSE OF SOME KIND OF STACK PROBLEM
; INVOKED BY:
; JSP CX,STOPP
STOPP: MOVEM P,BADP ;SAVE BAD P
MOVE P,[IOWD 4,PDL1] ;GET NEW P SO PDL IS PRESERVED
CALL STOP ;NOW CRASH
; PANIC INTERRUPT HANDLERS - PROGRAM IS CRASHING
; DATA ERROR IS NON FATAL AND IS REPORTED
PANPOV: JSP CX,STOPP ;PDL OVERFLOW
PANDAE: EXCH T1,@LEVTAB+PRIPAN-1 ;GET RETURN PC
MOVEM T1,DAEPC ;SAVE IT
EXCH T1,@LEVTAB+PRIPAN-1 ;RESTORE T1 AND PC
SOS DAEPC ;PC OF INTERRUPT
CALL EIHR ;SCHEDULE
EXP DAEIH ;ROUTINE TO SCHEDULE
PANQTA: CALL STOP ;QUOTA EXCEEDED
PANILI: CALL STOP ;ILLEGAL INSTRUCTION
PANIRD: CALL STOP ;ILLEGAL READ
PANIWR: CALL STOP ;ILLEGAL WRITE
PANMSE: CALL STOP ;MACHINE SIZE EXCEEDED
; DAEIH - INFORM OPERATOR OF A DATA ERROR.
; RETURNS +1 ALWAYS
DAEIH: MOVE T1,DAEPC ;GET PC OF ERROR
TMCT <%IData Error encountered. PC= %1O Last Error: %J>
MOVEI T3,[ASCIZ/MOUNTR System Task Error/]
CALLRET BTWTO ;TELL OPERATOR
; SYTSET - BUILD AND LOG SYSERR ENTRY FOR TAPE DRIVE STATUS CHANGE
; T1/ FUNCTION CODE (CS%ADV = SET AVAILABLE, CS%DDV = SET UNAVAILABLE)
; T2/ ADDRESS OF ASCIZ REASON, OR 0 IF NO REASON GIVEN
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
SYTSET: SAVEQ
STKVAR <<SYTA,.MOISN+1>>
SETZM SYRMSG ;ZERO OUT SYSERR MESSAGE AREA
MOVE T4,[SYRMSG,,SYRMSG+1]
BLT T4,SYRMSG+SYRMSZ-1
; TRANSFER OPERATION CODE AND REASON TO MESSAGE
STOR T1,CS%OPR,SYRMSG+CS%OPW ;STORE OPERATION CODE INTO MESSAGE
MOVEI Q1,SYRHSZ+CS%SIZ ;ASSUME NO REASON GIVEN
SKIPN T1,T2 ;REASON GIVEN?
JRST SYTSE1 ;NO
MOVS Q2,T1 ;YES, COPY ADDRESS OF STRING FOR BLT
CALL ASCIZL ;GET # OF CHARACTERS
IDIVI T2,5 ;GET # OF WORDS MINUS 1
CAIL T2,SYRMSZ ;TOO LONG?
MOVEI T2,SYRMSZ-1 ;YES, TRUNCATE
MOVEI Q1,SYRHSZ+CS%SIZ+1(T2) ;SAVE SIZE OF ENTIRE MESSAGE
HRRI Q2,SYRMSG+CS%SIZ ;GET BLT DESTINATION
BLT Q2,SYRMSG+CS%SIZ(T2) ;TRANSFER STRING TO MESSAGE
MOVEI T1,CS%SIZ
STOR T1,CS%RSN,SYRMSG+CS%RSW ;STORE POINTER TO REASON
SYTSE1: MOVEI T1,SEC%CS ;GET CONFIGURATION STATUS CHANGE CODE
DPB T1,[POINT 9,SYRHDR,8] ;STORE INTO SYSERR ENTRY HEADER
; BUILD AND STORE SIXBIT DEVICE NAME (E.G. MTA0)
; (CAN'T STORE CHANNEL TYPE BECAUSE I DON'T KNOW IT)
CALL GMTADD ;GET MTA DEVICE DESIGNATOR
MOVE T2,T1 ;TO T2 FOR DEVST
HRROI T1,SYTA ;GET ADDR OF STRING AREA
DEVST ;GET ASCIZ DEVICE NAME (E.G. MTA0)
SETZM SYTA ;SHOULD NEVER FAIL
MOVEI T1,SYTA ;GET ADDR OF STRING
CALL ASCIZL ;GET LENGTH OF STRING FOR CVTA6
MOVSI T1,(POINT 7)
HRRI T1,SYTA ;GET POINTER TO STRING
CALL CVTA6 ;GET SIXBIT DEVICE NAME IN T1
SETZ T1, ;SHOULDN'T FAIL
MOVEM T1,SYRMSG+CS%DNM ;STORE SIXBIT DEVICE NAME
; GET DEVICE ADDRESS AND SERIAL#
JE MTASTE,,R ;DON'T BOTHER IF DEVICE NOT ASSIGNED
MOVEI T1,.MOISN
MOVEM T1,.MOICT+SYTA ;SET ARG BLOCK LENGTH IN ARG BLOCK
CALL MTAGJF ;GET MTA JFN IN T1
MOVEI T2,.MOINF ;GET MTOPR FUNCTION CODE
MOVEI T3,SYTA ;GET ADDRESS OF ARG BLOCK
MTOPR ;GET MTA INFO FROM MONITOR
CALL MTARJF ;DUMP JFN
MOVE T1,.MOISN+SYTA ;GET UNIT ADDRESS AND SERIAL#
MOVEM T1,SYRMSG+CS%ADS ;STORE IN SYSERR MESSAGE
MOVE T1,.MOITP+SYTA ;GET DRIVE TYPE CODE
STOR T1,CS%UTP,SYRMSG+CS%HTP ;STUFF IT
; LOG THE MESSAGE
MOVEI T1,SYRHDR ;GET ADDRESS OF SYSERR MESSAGE
MOVE T2,Q1 ;GET # OF WORDS IN MESSAGE
SKIPN TSTF ;DON'T LOG SYSERRS IF TESTING
SYERR ;LOG IT
ERJMP R ;IGNORE ERRORS
RET
; UNLOAD - UNLOAD A VOLUME FROM AN MTA DEVICE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
UNLOAD: SAVEQ
CALL MTAGJF ;GET JFN NOW TO LIMIT GTJFN CALLS
CALL GMTADS ;GET DEVICE STATUS IN T1
JXN T1,SJ%OFS,[SETZRO MA%LOD,MTAFLG(MTA) ;OFFLINE, SAY SO
CALLRET MTARJF] ;DUMP JFN AND RETURN
JXN T1,SJ%REW,[SETONE MA%ULP,MTAFLG(MTA) ;SET UNLOAD-PENDING
CALLRET MTARJF] ;DUMP JFN AND RETURN
SETZRO MA%LOD,MTAFLG(MTA) ;SET STATUS TO UNLOADED
LOAD Q1,MA%OPN,MTAFLG(MTA) ;IS MTA JFN OPEN ALREADY?
JUMPE Q1,[CALL MTAOPI ;NO, OPEN IT
SKIPA ;OFFLINE
JRST .+1 ;OPENED
CALLRET MTARJF] ;DUMP JFN AND GIVE ERROR RETURN
CALL MTARJF ;UN-NEST PRIOR MTAGJF
CALL ELOGOF ;DON'T LOG ERRORS
MOVEI T1,.MOREW ;[333]Get the rewind function
MOVEI T2,1 ;[333]Repeat count
CALL XMTOPR ;[333]Rewind before we unload (TM03)
JRST .+1 ;[333]Don't care if it fails
MOVEI T1,.MORUL
MOVEI T2,1 ;REPEAT COUNT
CALL XMTOPR ;INITIATE REWIND-AND-UNLOAD
CALL XMTREP ;REPORT UNLOAD ERROR
CALL ELOGON ;RESUME LOGGING ERRORS
JUMPN Q1,R ;EXIT IF I DIDN'T OPEN MTA
CALLRET MTACLS ;I OPENED IT, SO I'LL CLOSE IT
; VQADD - APPEND A NEW VOLID TO THE END OF THE RSB VOLID LIST
; T1/ SIXBIT VOLID
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: NO SLOTS LEFT IN VOLID POOL, REQUEST ABORTED
; +2: SUCCESS
VQADD: STAKT
MOVEI T1,FVSQDB ;POINT TO FREE POOL QDB
CALL QMDQH ;DEQUEUE HEAD OF FREE CHAIN
JRST [ ABTRET (MREQ31)] ;NO FREE SLOTS, ABORT REQUEST
MOVE T1,CT1 ;T2/ SLOT ADDR, GET VOLID
MOVEM T1,1(T2) ;STORE VOLID IN SLOT
MOVEI T1,RSBVLS(RSB) ;GET ADDR OF RSB VOLID LIST QDB
CALL QMQT ;ADD NEW VOLID TO END OF RSB VOLID QUEUE
RETSKP
; VQCNT - RETURN THE LENGTH OF THE RSB VOLID LIST
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ LENGTH OF VOLID LIST
VQCNT: SETZ T1, ;CLEAR COUNTER
HLRZ T2,RSBVLS(RSB) ;GET HEAD OF QUEUE
VQCNT1: JUMPE T2,R ;END OF QUEUE, RETURN
MOVE T2,(T2) ;NOT THE END, GET ADDR OF NEXT ENTRY
AOJA T1,VQCNT1 ;COUNT THIS ENTRY AND LOOP
; VQDEL - RETURN RSB VOLID QUEUE TO FREE VOLID SLOT POOL
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS
VQDEL: SKIPN T1,RSBVLS(RSB) ;IS QUEUE EMPTY?
RET ;YES, NOTHING TO DO
SETZM RSBVLS(RSB) ;CLEAR QDB IN RSB
HRRZ T2,FVSQDB ;GET CURRENT FREE POOL TAIL
JUMPE T2,[MOVEM T1,FVSQDB ;NO FREE POOL, SO CREATE IT
RET]
HLRZM T1,(T2) ;POINT CURRENT TAIL AT RSB LIST HEAD
HRRM T1,FVSQDB ;SET TAIL OF FREE POOL TO RSB TAIL
RET
; VQGCV - GET CURRENT VOLID FOR TAPE MOUNT REQUEST
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: ALWAYS, T1/ 0 IF SCRATCH TAPE, ELSE SIXBIT VOLID
VQGCV: LOAD T1,RSBCV ;GET CURRENT VOLUME #
CALL VQGET ;GET VOLID IN T1
SETZ T1, ;BAD INDEX, MUST BE A SCRATCH
RET
; VQGET - RETURN A VOLID FROM RSB VOLID LIST
; VQSET - STORE A VOLID INTO RSB VOLID LIST
; T1/ ORDINAL NUMBER OF VOLID TO BE RETURNED
; T2/ SIXBIT VOLID TO BE STORED (VQSET ONLY)
; RSB/ ADDR OF REQUEST STATUS BLOCK
; RETURNS +1: VOLID NUMBER OUT OF RANGE
; +2: SUCCESS, T1/ SIXBIT VOLID
VQGET: SKIPA T3,[MOVE T1,1(T2)]
VQSET: MOVE T3,[MOVEM T1,1(T2)]
JUMPLE T1,R ;CHECK FOR FUNNY INPUT
QSCANI <RSBVLS(RSB)> ;SET UP TO SCAN RSB VOLID LIST
STAKT
VQGET1: CALL QMSCAN ;GET NEXT VOLID IN LIST
RET ;NONE LEFT, FAILED
SOSLE CT1 ;IS THIS THE ONE THE CALLER WANTED?
JRST VQGET1 ;NO, CONTINUE SCAN
MOVE T1,CT2 ;GET VOLID IN CASE OF VQSET
XCT CT3 ;LOAD OR STORE VOLID AS REQUESTED
RETSKP
; VQSPIN - INITIALIZE FREE POOL OF VOLID SLOTS
; RETURNS +1: ALWAYS
VQSPIN: SAVEQ
SETZM FVSQDB ;SET QUEUE EMPTY INITIALLY
MOVEI Q1,VOLP0 ;GET ADDRESS OF 1ST SLOT IN POOL
MOVEI Q2,VOLPN ;GET # OF SLOTS IN POOL
VQSPI1: MOVEI T1,FVSQDB ;GET QDB ADDRESS
MOVE T2,Q1 ;GET ADDRESS OF NEXT SLOT
CALL QMQT ;ADD SLOT TO TAIL OF FREE LIST
ADDI Q1,2 ;POINT TO NEXT SLOT
SOJG Q2,VQSPI1 ;LOOP
RET
; WRTP - WRITE-PROTECT MOUNTR'S CODE TO CATCH STRAY STORES
; RETURNS +1: ALWAYS
Comment /
WRTP: MOVEI T1,PURE ;COMPUTE PAGE # OF FIRST
LSH T1,-11 ; PAGE OF NON-MODIFYABLE MEMORY
HRLI T1,.FHSLF ;GET FORK HANDLE ,, PAGE#
MOVX T2,PA%RD+PA%EX ;REQUEST READ AND EXECUTE ACCESS
MOVEI T3,.RLEND ;COMPUTE PAGE # OF LAST READ-ONLY
LSH T3,-11 ; PAGE PLUS 1
WRTP1: CAIG T3,(T1) ;ALL DONE?
RET ;YES
SPACS ;SET PAGE TO READ & EXECUTE
AOJA T1,WRTP1 ;INCREMENT PAGE # AND LOOP
/
;WTOCHK CHECKS TO SEE IF WTOR FUNCTION IS DISABLED IN BATCH JOB
;RETURNS +1 IF DISABLED
;RETURNS +2 IF NOT DISABLED
;ABTRET WITH ERROR MESSAGE IF DISABLED
WTOCHK: SAVET ;SAVE T1-T4
LOAD T1,RSBJNO ;GET JOBNUMBER
SETO T2, ;JUST ONE ITEM
HRRI T2,T3 ;INTO T3
MOVEI T3,.JIBCH ;GET BATCH FLAGS
GETJI ;
SETZ T3, ;UNLIKELY
LOAD T3,OB%WTO,T3 ;CHECK FOR WTO ENABLED
CAIE T3,.OBALL ;ARE MESSAGES ALLOWED?
JRST [ ABTRET (MREQ15)] ;NO, ABORT WITH MESSAGE
RETSKP ;YES, RETURN +2
; XMTOPR - EXECUTE MAGTAPE MTOPR FUNCTION A GIVEN NUMBER OF TIMES
; T1/ MTOPR FUNCTION CODE
; T2/ NUMBER OF TIMES TO EXECUTE
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: DEVICE FAILURE, T1/ 0=ERROR 1=TIMEOUT
; +2: SUCCESS
XMTOPR: SAVEQ
DMOVE Q1,T1 ;SAVE FUNCTION CODE AND REPEAT COUNT
XMTOP1: LOAD T1,MTAJFN ;GET JFN
MOVE T2,Q1 ;GET MTOPR FUNCTION CODE
IOXCT MTOPR,XMTOP2,XMTOP3 ;START POSITIONING OPERATION
MOVEI T2,.MONOP
IOXCT MTOPR,XMTOP2,XMTOP3 ;WAIT TILL OPERATION COMPLETES
CALL CLRTAP ;CLEAR ERRORS
JRST XMTOP3 ;TIMED OUT
TXNE T2,MT%DVE+MT%DAE ;ANY SERIOUS PROBLEMS?
JRST XMTOP2 ;YES
SOJG Q2,XMTOP1 ;LOOP TILL DONE
RETSKP ;SUCCESS
XMTOP2: TDZA T1,T1 ;ERROR, PUT 0 IN T1
XMTOP3: MOVEI T1,1 ;TIMEOUT, PUT 1 IN T1
RET ;TAKE ERROR RETURN
; XMTREP - REPORT MTA DEVICE FAILURE TO OPERATOR
; T1/ 0 TO REPORT DEVICE ERROR, 1 TO REPORT DEVICE TIMEOUT
; MTA/ ADDR OF MTA STATUS BLOCK
; RETURNS +1: ALWAYS
XMTREP: JUMPN T1,[CALLRET WOTIMO] ;TIMEOUT, RETURN THROUGH TIMEOUT CODE
TMCT <%I%M positioning operation failed. Last Error: %J>
MOVEI T3,[ASCIZ/Tape Positioning Error/]
CALLRET BTWTO ;TELL OPERATOR AND RETURN
; XMUTIL - EXECUTE MUTIL FOR CALLER
; T1-T4/ ARGUMENT BLOCK WORDS 0-3
; RETURNS +1: ERROR ON MUTIL CALL, CODE IN T1
; +2: SUCCESS, WITH COPY OF ARG BLOCK IN T1-T4
XMUTIL: SAVET ;SAVE CALLER'S AC'S ON STACK
MOVEI T1,4 ;ARGUMENT BLOCK LENGTH
MOVEI T2,CT1 ;ADDRESS OF ARGUMENT BLOCK
MUTIL ;DO MUTIL (ARG BLOCK IS IN STACK)
JRST [ MOVEM T1,CT1 ;ERROR, SUPPLY ERROR TO CALLER
RET] ;TAKE ERROR RETURN
RETSKP ;GOOD RETURN, T1-T4 COME OFF STACK
SUBTTL STRSTT -- Returns the structure status
; Accepts: T1 / Address of name (alias) of structure
; Returns: +1 if failed to get status for structure
; +2 with status
; T1 / Status flags
; T2 / Number of units in structure
; T3 / Mount count for structure
; T4 / Open file count for structure
STRSTT: HRRO T1,T1 ;Set pointer for alias
MOVEM T1,MSTRST+.MSGSN ;Save it
MOVE T1,[.MSGFC+1,,.MSGSS] ;Get length,,function
MOVEI T2,MSTRST ;Get the address of argument block
MSTR ;Try for the status
ERJMP R ;Just return
DMOVE T1,MSTRST+.MSGST ;Get the flags and the number of units
DMOVE T3,MSTRST+.MSGMC ;Get the mount count and the open file count
RETSKP ;And return
LIT: ;ADDRESS OF START OF LITERAL POOL
END <ENTVSZ,,ENTVEC>