.TITLE INTERR - DECnet Management Interrogator .IDENT /Y01.00/ ; In-house version .NLIST BEX ; Don't list binary extensions .ENABL LC ; Enable lower case ; IIIIIIII ; IIIIIIII ; II tt ; II tt ; II nn nnnnnn tttttttttt eeeeeeee rr rrrrrr rr rrrrrr ; II nnnnnnnnnn tttttttttt eeeeeeeeee rrrrrrrrrr rrrrrrrrrr ; II nn nn tt ee ee rr rr rr rr ; II nn nn tt eeeeeeeeee rr rr rr rr ; II nn nn tt ee rr rr ; II nn nn tt ee ee rr rr ; IIIIIIII nn nn tt eeeeeeeeee rr rr ; IIIIIIII nn nn tt eeeeeeee rr rr .SBTTL Introduction ; ; INTERR - DECnet Network Management Listener Interrogation Task ; ; Prototype of network management task for starting nodes ; Author: ; Bruce R. Mitchell ; Source Site: ; Machine Intelligence and Industrial Magic ; PO Box 601, Hudson, WI 54016 ; Source Hardware and Operating System: ; DEC PDP-11/70 under RSX-11M-Plus V2.0 Autopatch A ; Target Site: ; Same ; Target Hardware and Operating System: ; Same ; Revision History: ; 11-Nov-82 First code ripped out of TIMREC ; 14-Mar-83 Include 3 bytes of version data for NICE CON$ request ; 14-Mar-83 Check for received data on CON$ successful completion ; 15-Jul-83 Do known nodes, decode returned messages to fill data block ; 18-Jul-83 Log message on console, include subnet support .PAGE .SBTTL .SBTTL INTERR Structure ; ; INTERR is simply structured. It opens the network and creates ; a connection to the host node. It then establishes a logical ; link to the network management utility (NICE/NML) and asks it ; for information regarding active nodes. ; ; .PAGE .SBTTL Caveats and Comments ; This task is EXPERIMENTAL and PRIVILEGED and may do any number of ; foul things to the operating system on which it resides, so don't ; come and bitch about anything it does or doesn't do. ; In order for this task to even remotely begin to work, the alias ; NETNML must be defined. NETNML is the node which INTERR will ; interrogate for data on node names and numbers, so NETNML must ; know about everybody in the network (or subnetwork in the case of ; a partitioned network). ; Many thanks to the unknown person(s) at DEC who answered the SPR ; on NICE not returning proper information in the connect block. .PAGE .SBTTL .SBTTL Macro Calls and Definitions ; ; Macros from LB:[1,1]NETLIB.MLB ; .MCALL CLSW$ ; Close the network and wait .MCALL CONB$$ ; Define a connect block .MCALL CONW$ ; Connect to object and wait .MCALL DSCW$ ; Disconnect from object and wait .MCALL NETDF$ ; Network definitions .MCALL OPNW$ ; Open network and wait .MCALL RECW$ ; Receive data and wait .MCALL SNDW$ ; Send data over link and wait NETDF$ ; Define the network symbols ; ; Macros from LB:[1,1]RSXMAC.SML ; .MCALL ALUN$ ; Assign logical unit number .MCALL ASTX$S ; Exit from AST .MCALL DIR$ ; Execute system directive .MCALL EXST$ ; Exit with status .MCALL GTIM$ ; Get system time and date .MCALL QIOW$ ; Queue I/O and wait .MCALL QIOSY$ ; Define QIO symbols .MCALL SPWN$ ; Spawn command to task .MCALL WTSE$ ; Wait for single event flag QIOSY$ ; Define the QIO symbols ; ; Local macro definitions ; ; Macro to load a print QIO DPB and execute the DPB .MACRO PRINT STRING ; Begin PRINT macro MOV #STRING, TIQBLK+Q.IOPL MOV #STRING'L, TIQBLK+Q.IOPL+2 DIR$ #TIQBLK .ENDM ; End PRINT macro .PAGE .SBTTL Local Definitions LUN1 = 1 ; Network mailbox LUN LUN2 = 2 ; Network logical link LUN TILUN = 3 ; Owning terminal LUN COLUN = 4 ; System console LUN EFN1 = 1 ; Network mailbox EFN EFN2 = 2 ; Network logical link EFN TIEFN = 3 ; Owning terminal EFN COEFN = 4 ; System console EFN SPNEFN = 5 ; Spawn completion EFN LF = 12 ; ASCII linefeed CR = 15 ; ASCII return BK = 40 ; ASCII space .PAGE .SBTTL .SBTTL Data .SBTTL .PSECT INDATA, RW, D .SBTTL Directive Parameter Blocks ; DPBs for assigning LUNs to the network ALUN1: ALUN$ LUN1, NS, 0 ; Assign LUN 1 to NS: unit 0 ALUN2: ALUN$ LUN2, NS, 0 ; Assign LUN 2 to NS: unit 0 ALUN3: ALUN$ TILUN, TI, 0 ; Assign LUN 3 to TI: unit 0 ALUN4: ALUN$ COLUN, CO, 0 ; Assign LUN 4 to CO: ; DPB for closing the network CLSNET: CLSW$ LUN1, EFN1 ; Close all activity on LUN 1 ; Waiting event flag is EFN 1 ; Connect block for connecting to network master and server object CONBLK: CONB$$ NETNML, 19., 0 ; Connect to node NETNML ; Connect to object type 19. ; Connect by object type ; DPB for connecting to server object on network master CONNET: CONW$ LUN2, EFN2, NSTBLK,, ; Connect to server on LUN 2 ; Waiting event flag is EFN 2 ; NSTBLK is the connect status block ; CONBLK is the connect block ; OUTDAT is version data for NICE ; Optional buffer is OUTLEN bytes ; CONRET is the optional buffer ; Optional buffer is CONLEN bytes ; DPB for disconnecting from server object on network master DISNET: DSCW$ LUN2, EFN2 ; Disconnect from server on LUN 2 ; Waiting event flag is EFN 2 ; DPB for exiting with status EXSTAT: EXST$ EX$SUC ; For exiting with success status EXSTER: EXST$ EX$ERR ; For exiting with error status EXSTWA: EXST$ EX$WAR ; For exiting with warning status ; Get system time and data GETTIM: GTIM$ TIMBUF ; DPB for opening the network OPENET: OPNW$ LUN1, EFN1, NSTBLK,, <1, 0> ; Open network on LUN 1 ; Waiting event flag is EFN 1 ; NSTBLK is the open status block ; Maximum of 1 logical link open ; Abort log. link on phys. link failure ; DPB for printing a message on the invoking terminal COQBLK: QIOW$ IO.WVB, COLUN, COEFN,,,, TIQBLK: QIOW$ IO.WBT, TILUN, TIEFN,,,, < , , 40> ; DPB for receiving data packet from NICE/NML RECBLK: RECW$ LUN2, EFN2, NSTBLK,, ; Receive on LUN 2 ; Waiting event flag is EFN2 ; NSTBLK is network status block ; RECBUF is the buffer ; RECLEN is the message length ; Spawn the MCR... CLI with an NCP SET etc. command line SPAWNN: SPWN$ MCR...,,,,, SPNEFN,, SPSTS, C1, C1L ; DPB for sending interrogation packet to NICE/NML SNDBLK: SNDW$ LUN2, EFN2, NSTBLK,, ; Send to on LUN 2 ; Waiting event flag is EFN2 ; NSTBLK is network status block ; SNDPRM is the message ; SNDLEN is the message length ; Wait for spawn event flag WAITSP: WTSE$ SPNEFN ; Wait for spawn flag .PAGE .SBTTL Message Storage S1: .ASCII \INT-F-NOF, Network open failed\ S1L = . - S1 S2: .ASCII \INT-F-NCF, Network connect to NETNML failed\ S2L = . - S2 S3: .ASCII \INT-F-ROU, NICE/NML not installed on remote node\ S3L = . - S3 S4: .ASCII \ I/O error code = \ S4A: .BLKB 3 .ASCII \, $DSW = \ S4B: .BLKB 3 S4L = . - S4 S5: .ASCII \INT-I-WND, Incorrect or no NICE/NML connect data returned\ S5L = . - S5 S6: .BLKB 8. ; 8 bytes for storing time .ASCII \ INTERR - DECnet node names set from NICE/NML on \ S6A: .BLKB 6 S6L = . - S6 S7: .ASCII \INT-F-UND, Unexpected NICE/NML error during data reception\ S7L = . - S7 S10: .ASCII \INT-F-NEF, NICE/NML enquiry send failed\ S10L = . - S10 S12: .ASCII \INT-F-NRF, NICE/NML response failed\ S12L = . - S12 S14: .ASCII \INT-F-NRE, NICE/NML rejected enquiry\ S14L = . - S14 S15: .ASCII \ Return code = \ S15A: .BLKB 3 .ASCII \, Error detail = \ S15B: .BLKB 6 S15L = . - S15 MESG16: .ASCII \ "\ S8: .BLKB 72. .BLKB 1 ; For potential terminating " MS16LN = . - MESG16 S20: .ASCII \INT-F-NSF, Spawn NCP command to MCR... failed\ S20L = . - S20 .EVEN .IF DF D$$BUG ; If debugging enabled ; ; Debugging messages ; D1: .ASCII \INT-D-NND, NICE/NML returned data on \ D1A: .BLKB 5 .ASCII \. nodes\ D1L = . - D1 D2: .ASCII \ Node \ D2A: .BLKB 5 .ASCII \. is named \ D2B: .BLKB 6 D2L = . - D2 D3: .ASCII \INT-D-NRI, NICE/NML returned node information\ D3L = . - D3 D4: .ASCII \INT-D-NOS, Network open succeeded\ D4L = . - D4 D6: .ASCII \INT-D-CLS, Connect to NICE/NML successful\ .ASCII \ Connected to version \ D6A: .BLKB 3 .ASCII \, DEC ECO \ D6B: .BLKB 3 .ASCII \, user ECO \ D6C: .BLKB 3 D6L = . - D6 D7: .ASCII \INT-D-NLC, Network link to NICE/NML on NETNML closed\ D7L = . - D7 D8: .ASCII \INT-D-NES, NICE/NML enquiry send succeeded\ D8L = . - D8 D9: .ASCII \INT-D-NSC, NCP command spawns are complete\ D9L = . - D9 D10: .ASCII \INT-D-ETE, Successful completion - exiting to RSX\ D10L = . - D10 D11: .ASCII \INT-D-NRS, NICE/NML responded successfully\ D11L = . - D11 D13: .ASCII \INT-D-NAE, NICE/NML accepted enquiry\ D13L = . - D13 .ENDC ; DF D$$BUG ; Inquiry message to NICE/NML on remote node to show known nodes SNDPRM: .BYTE 20. ; Read network data .BYTE <0*200>+<1*20>+0 ; Read volatile data, status, nodes .BYTE -1 ; Known nodes SNDLEN = . - SNDPRM .EVEN ; Spawn command to MCR... to have NCP set the node's name C1: .ASCII \NCP SET NODE \ C1A: .BLKB 5 .ASCII \ NAME \ C1B: .BLKB 6 C1L = . - C1 .PAGE .SBTTL Variable Storage ; Block variables NODLST: .REPT 255. ; Retrieved node data storage block .BLKB 2 ; Storage for node number .BLKB 1 ; Storage for length of node name .BLKB 6 ; Storage for node name .BYTE 0 ; Guard byte .ENDR NSTBLK: .BLKW 2 ; 2 words for network status block OUTDAT: .BYTE 3, 0, 0 ; Connect data - version data for NICE OUTLEN = . - OUTDAT ; Length of OUTDAT .EVEN CONRET: .BLKB 16. ; 16 bytes for connect data block CONLEN = . - CONRET ; Length of CONRET RECBUF: .BLKB 300. ; 300 bytes for returned information RECLEN = . - RECBUF ; Length of RECBUF SPSTS: .BLKW 8. ; Spawn status block TIMBUF: .BLKW 8. ; System time buffer block ; Single variables NNODES: .WORD 0 ; Number of nodes from NML data .PAGE .SBTTL .SBTTL Code .SBTTL .PSECT INCODE, RO, I .SBTTL INTERR Entry and Setup INTERR: DIR$ #ALUN1 ; Assign first network LUN DIR$ #ALUN2 ; Assign second network LUN DIR$ #ALUN3 ; Assign LUN to TI: DIR$ #ALUN4 ; Assign LUN to CO: ; Attempt to open the network DIR$ #OPENET ; Open the network CMPB NSTBLK, #IS.SUC ; Was the open successful? BNE 10$ ; If not, go hit the error routine .IF DF D$$BUG ; If debugging enabled ; Network opened successfully; print message PRINT D4 ; "INT-D-NOS" (network open succeeded) .ENDC ; DF D$$BUG BR CONATT ; Continue ; Network open failed; print message stating same and exit w/status 10$: PRINT S1 ; "INT-F-NOF" (network open failed) MOV NSTBLK, R5 ; Move I/O error code into R5 CALL ERREXT ; List error status DIR$ #EXSTER ; Exit with error status .PAGE .SBTTL CONATT Connect to NICE/NML ; Network opened successfully; try to connect to NICE/NML on NETNML CONATT: DIR$ #CONNET ; Try to connect to NICE/NML CMPB NSTBLK, #IS.SUC ; Was the connect successful? BNE 10$ ; If not, go hit the error routines .IF DF D$$BUG ; If debugging enabled ; Connect was successful; print debugging trace message MOV #D6A, R0 ; R0 points at the version field MOVB CONRET, R1 ; R1 now contains the source byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert byte to octal magnitude MOV #D6B, R0 ; R0 points at the DEC ECO field MOVB CONRET+1, R1 ; R1 now contains the source byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert byte to octal magnitude MOV #D6C, R0 ; R0 points at the user ECO field MOVB CONRET+2, R1 ; R1 now contains the source byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert byte to octal magnitude PRINT D6 ; "INT-D-CLS" (connected version info) .ENDC ; DF D$$BUG BR 40$ ; Continue ; Connect failed; see if it was because master node wasn't up 10$: CMPB NSTBLK, #IE.NRJ ; Failed because of DECnet reject? BEQ 30$ ; If so, continue ; Connect failed for obscure reason; print message stating same and exit 20$: PRINT S2 ; "INT-F-NCF" (connect to node failed) MOV NSTBLK, R5 ; Move I/O error code into R5 CALL ERREXT ; List error status DIR$ #CLSNET ; Close the network DIR$ #EXSTER ; Exit with error status ; Connect failed due to net rejection; see if because object not there 30$: CMPB NSTBLK+2, #NE$UOB ; Failed because object unknown? BNE 20$ ; If not, go print message and exit ; Connect failed because object unknown at remote node; exit PRINT S3 ; "INT-F-ROU" (NICE/NML isn't there) DIR$ #CLSNET ; Close the network DIR$ #EXSTER ; Exit with error status ; Determine if what was connected to was really NICE/NML 40$: CMPB #3, NSTBLK+2 ; Three bytes of data returned? BEQ SNDENQ ; If so, OK; continue ; Whatever was connected to, it wasn't NICE/NML; print message and exit PRINT S5 ; "INT-I-WND" (wrong data returned!) DIR$ #EXSTER ; Exit to RSX with error status .PAGE .SBTTL SNDENQ Send Enquiry to NICE/NML SNDENQ: DIR$ #SNDBLK ; Send the enquiry and wait CMPB NSTBLK, #IS.SUC ; Was the directive successful? BNE 10$ ; If not, hit the error routine .IF DF D$$BUG ; If debugging enabled ; Enquiry sent successfully; print debugging trace message PRINT D8 ; "INT-D-NES" (enquiry succeeded) .ENDC ; DF D$$BUG BR RECINF ; Continue ; Enquiry send failed; print message stating same and exit w/status 10$: PRINT S10 ; "INT-F-NEF" (enquiry send failed) MOV NSTBLK, R5 ; Move I/O error code into R5 CALL ERREXT ; List error status DIR$ #EXSTER ; Exit with error status .PAGE .SBTTL RECINF Receive Info from NICE/NML ; Enquiry sent successfully; try to receive first packet from NICE/NML RECINF: DIR$ #RECBLK ; Receive data CMPB NSTBLK, #IS.SUC ; Was the directive successful? BNE 10$ ; If not, go hit the error routine .IF DF D$$BUG ; If debugging enabled ; Response received successfully; print debugging trace message PRINT D11 ; "INT-D-NRS" (enquiry response OK) .ENDC ; DF D$$BUG BR ENQDET ; Continue ; Response receive failed; print message stating same and exit w/status 10$: PRINT S12 ; "INT-F-NEF" (response failed) MOV NSTBLK, R5 ; Move I/O error code into R5 CALL ERREXT ; List error status DIR$ #EXSTER ; Exit to RSX with error status .PAGE .SBTTL ENQDET Enquiry Success Determination ; Determine whether NICE/NML accepted the enquiry ENQDET: TSTB RECBUF ; Did NICE/NML accept the enquiry? BMI 10$ ; If not, go hit the error routine .IF DF D$$BUG ; If debugging enabled ; NICE accepted enquiry; print debugging trace message PRINT D13 ; "INT-D-NAE" (NICE accepted enquiry) .ENDC ; DF D$$BUG BR HAULIT ; Continue ; NICE/NML rejected enquiry; print message stating same and exit w/status 10$: PRINT S14 ; "INT-F-NRE" (NICE rejected enquiry) CALL NMLEXT ; List error status DIR$ #EXSTER ; Exit with error status .PAGE .SBTTL HAULIT Receive Info Messages HAULIT: CLR NNODES ; NNODES counts number of nodes MOV #NODLST, R1 ; R1 is index into NODLST for data ; Attempt to receive an information message from NICE/NML 10$: DIR$ #RECBLK ; Receive data CMPB NSTBLK, #IS.SUC ; Was the directive successful? BNE 20$ ; If not, go hit the error routine .IF DF D$$BUG ; If debugging enabled ; Response received successfully; print debugging trace message PRINT D11 ; "INT-D-NRS" (successful response) .ENDC ; DF D$$BUG BR 30$ ; Continue ; Response receive failed; print message stating same and exit w/status 20$: PRINT S12 ; "INT-F-NEF" (response failed) MOV NSTBLK, R5 ; Move I/O error code into R5 CALL ERREXT ; List error status DIR$ #EXSTER ; Exit with error status ; Response received; test for the last message from NICE/NML 30$: CMPB RECBUF, #-128. ; Is this the last returned messages? BEQ FINNET ; If so, continue elsewhere ; Not last message; check for validity TSTB RECBUF ; Was a NICE/NML error detected? BMI 40$ ; If so, go hit the error routine .IF DF D$$BUG ; If debugging enabled ; Valid data from NICE/NML on a node; print debugging trace message PRINT D3 ; "INT-D-NRI" (returned node info) .ENDC ; DF D$$BUG BR 50$ ; If not, continue ; NICE/NML error detected; print message stating same and exit w/status 40$: PRINT S7 ; "INT-F-UND" (unexpected NICE error) CALL NMLEXT ; List error status DIR$ #EXSTER ; Exit with error status ; Check to see if the returned data is for the NETNML executor 50$: BITB #200, RECBUF+6 ; Is this data for the NETNML executor? BEQ 51$ ; If not, proceed ; It's NETNML; store name for later printing, but don't store data on it MOV #RECBUF+7, R2 ; Load node name address in R0 MOV #S6A, R3 ; Load address of name storage in R1 MOV #6, R4 ; Copy all 6 bytes of the name 52$: MOVB (R2)+, (R3)+ ; Copy a byte from buffer to storage SOB R4, 52$ ; Loop until all copied BR 10$ ; Go get some data on unknown nodes ; Check to see if the returned data is on this node 51$: CMP RECBUF+4, #L$$NOD ; Is this data on us? BEQ 10$ ; If so, ignore; don't want to set us! .IF DF M$$XND ; If subnet partitioning supported ; Check to see if the number is larger than the subnet maximum CMP RECBUF+4, #M$$XND ; Is the node number too large? BGT 10$ ; If so, ignore it .ENDC ; DF M$$XND ; It's OK to store the returned data from NICE/NML in the data area MOV #RECBUF+4, R2 ; Load the data block address into R2 MOV #10., R3 ; Load the data block length into R2 60$: MOVB (R2)+, (R1)+ ; Store a byte of data SOB R3, 60$ ; Loop until all data stored INC NNODES ; Increment the number of nodes BR 10$ ; Go back and try for another node .PAGE .SBTTL FINNET Close Network ; Close the network, we have no further data needs from it FINNET: DIR$ #DISNET ; Disconnect from the server DIR$ #CLSNET ; Close the network .IF DF D$$BUG ; If debugging enabled ; Print network closing message PRINT D7 ; "INT-D-NLC" (closed network link) ; Print the number of nodes for which there are data MOV #D1A, R0 ; Load address of output field in R0 MOV NNODES, R1 ; Load number of nodes into R1 CLR R2 ; Suppress leading zeroes CALL $CBDMG ; Convert binary to decimal magnitude PRINT D1 ; "INT-I-NND" (number of nodes data) ; Do a node-by-node recap of the returned data MOV NNODES, R3 ; Load the number of nodes into R1 MOV #NODLST, R4 ; Load node data block address in R4 10$: MOV #D2A, R0 ; Load address of output field in R0 MOV (R4)+, R1 ; Load node number into R1 CLR R2 ; Suppress leading zeroes CALL $CBDMG ; Convert binary to decimal magnitude INC R4 ; Point now at the node name MOV #D2B, R0 ; Load node name field address in R0 MOV #6, R2 ; Load number of bytes to move into R1 20$: MOVB (R4)+, (R0)+ ; Transfer a name byte to output field SOB R2, 20$ ; And loop until all transferred INC R4 ; Point past guard byte PRINT D2 ; Print the message SOB R3, 10$ ; Loop until all node names printed .ENDC ; DF D$$BUG .PAGE .SBTTL SPAWNS Spawn NCP to Set Node Names ; Spawn an NCP command off to MCR... for each node name (except us) SPAWNS: MOV NNODES, R3 ; Load number of nodes into R3 MOV #NODLST, R4 ; Load node info list address into R4 ; Blank-fill the node name and node number fields in the spawn text 10$: MOV #6, R0 ; Blank-fill 5 bytes MOV #C1A, R1 ; Let R1 point at the node number field MOV #C1B, R2 ; Let R2 point at the node name field 20$: MOVB #BK, (R1)+ ; Load blank into node number field MOVB #BK, (R2)+ ; Load blank into node name field SOB R0, 20$ ; Loop until all filled ; Load the node number and node name fields into the spawn block MOV #C1A, R0 ; Load address of output field in R0 MOV (R4)+, R1 ; Load node number into R1 INC R2 ; Do not suppress leading zeroes CALL $CBDMG ; Convert binary to decimal magnitude MOVB (R4)+, R1 ; R1 is length of node name to copy MOV R1, R2 ; Save node name length in R2 MOV #C1B, R0 ; Load node name field address in R0 30$: MOVB (R4)+, (R0)+ ; Transfer a name byte to output field SOB R1, 30$ ; And loop until all transferred ADD #7, R4 ; Correct data block pointer by adding SUB R2, R4 ; 7, then subtracting node name length .IF DF P$$EKO ; If pseudoechoing enabled ; Print the spawn line on the terminal for documentation purposes PRINT C1 ; "NCP SET NODE xxxxx NAME xxxxxx" .ENDC ; DF P$$EKO ; Spawn the NCP SET NODE xxxxx NAME xxxxxx command off to MCR... DIR$ #SPAWNN ; Spawn NCP BCS 40$ ; If it failed, go err out DIR$ #WAITSP ; Wait for spawn to complete SOB R3, 10$ ; Loop until all nodes processed .IF DF D$$BUG ; If debugging enabled PRINT D9 ; "INT-D-NSC" (NCP spawns completed) .ENDC ; DF D$$BUG BR CONLOG ; Go log action on console and exit ; Spawn failure (reason unknown); print message and exit with error 40$: PRINT S20 ; "INT-F-NSF" (NCP spawn failure) MOVB SPSTS+1, R4 ; Move error code into R4 CALL ERREXT ; Call the error print routine DIR$ #EXSTER ; Exit to RSX with error status .PAGE .SBTTL CONLOG Log on Console and Exit ; Print a message logging the node sets on the system console CONLOG: DIR$ #GETTIM ; Get the current system time MOV #S6, R0 ; Load ASCII time field address in R0 MOV #TIMBUF+G.TIHR, R1 ; Load binary time field address in R1 MOV #3, R2 ; Specify HH:MM:SS format CALL $TIM ; Convert time to ASCII DIR$ #COQBLK ; Print the time set message .IF DF D$$BUG ; If debugging enabled PRINT D10 ; "INT-D-ETE" (Exiting to RSX) .ENDC ; DF D$$BUG DIR$ #EXSTAT ; Exit to RSX with success status .PAGE .SBTTL .SBTTL Subroutines .SBTTL .SBTTL ERREXT Print Error and Exit ; ; ERREXT - Print I/O Error, DSW Error, and Exit to RSX ; ; This subroutine prints the error codes resulting from a previous ; I/O operation which failed. ; ; Inputs: R5 - I/O error byte ; ; Outputs: None ; ; Register dispositions: All registers used are saved and restored ; ; Variable dispositions: None modified ; ERREXT: CALL $SAVAL ; Save registers 0 - 5 MOV $DSW, -(SP) ; Save the directive status word ; Print error message containing error codes MOV #S4A, R0 ; R0 points at the target storage area MOV R5, R1 ; R1 now contains the source byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert binary byte to octal magnitude MOV #S4B, R0 ; R0 points at the target storage area MOV (SP)+, R1 ; R1 contains the DSW byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert binary byte to octal magnitude PRINT S4 ; Print the error code details RETURN ; Return to the caller .PAGE .SBTTL NMLEXT Print NICE/NML Error ; ; NMLEXT - Print NML Error, Error Detail and Error Message ; ; This subroutine prints the error codes resulting from a NICE/NML ; operation which failed. ; ; Inputs: RECBUF - NICE/NML response block ; ; Outputs: None ; ; Register dispositions: All registers used are saved and restored ; ; Variable dispositions: None modified ; NMLEXT: CALL $SAVAL ; Save registers 0 - 5 ; Print first error message containing error codes MOV #RECBUF, R5 ; Load NICE/NML response address in R5 MOV #S15A, R0 ; R0 points at the target storage area MOVB (R5)+, R1 ; R1 now contains the return code byte CLR R2 ; Specify suppression of leading zeroes CALL $CBTMG ; Convert binary byte to octal magnitude MOV #S15B, R0 ; R0 points at the target storage area MOVB (R5)+, R1 ; R1 contains the first err detail byte SWAB R1 ; Move it into top byte MOVB (R5)+, R2 ; R2 contains second error detail byte BIC #177400, R2 ; Wipe off top byte of R2 BIS R2, R1 ; OR R2 into R1 SWAB R1 ; R1 now contains the error detail word CLR R2 ; Specify suppression of leading zeroes CALL $CBOMG ; Convert binary word to octal magnitude PRINT S15 ; Print the error detail ; Optionally print second error message containing text MOV #MESG16, TIQBLK+Q.IOPL ; Move status message address into DPB MOV #S8, R0 ; R0 points at the target storage area MOVB (R5)+, R1 ; R1 is now text message byte count BEQ 20$ ; If there is no text, don't print 10$: MOVB (R5)+, (R0)+ ; Copy text byte to output buffer SOB R1, 10$ ; Loop until all copied MOVB #'", (R5)+ ; Load terminating quote in buffer SUB #MESG16, R5 ; R5 now contains byte count MOV R5, TIQBLK+Q.IOPL+2 ; Move message length into DPB DIR$ #TIQBLK ; Print the error message 20$: RETURN ; Return to the caller .END INTERR