ASMB,R,Q,C,Z
      IFZ 
      HED #RMSM 91750-1X026 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM #RMSM,7 91750-1X026 REV.2013 800725 RTE-IVB W/S.M.
      XIF 
      IFN 
      HED #RMSM 91750-1X210 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM #RMSM,7 91750-1X210 REV.2013 800725 ALL, W/O S.M. 
      XIF 
* 
* "Z" OPTION FOR SESSION MONITOR NODE, "N" OPTION IF NON-SESSION NODE.
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 1 
      ENT #RMSM 
* 
      EXT DLGON,DLGOF,DLGNS,#NODE,DSERR 
      EXT #RQB,REIO,.ENTR,#NAT,#NASR
      EXT .LBT,.SBT,.SFB,.MBT,.MVW
RQB   EQU #RQB
      IFZ 
      EXT PGMAD,SESSN,ISMVE,.UNAM,$SMD# 
      XIF 
* 
      SUP 
* 
* NAME:   #RMSM 
* SOURCE: 91750-18026 
* RELOC:  PART OF 91750-12014 ("Z"), -12015 ("N") 
* PGMR:   JIM HARTSELL
* 
* SUBROUTINES TO PERFORM OPTIONAL SESSION-MONITOR PROCESSING
* FOR THE DS/1000 REMAT MODULE. 
* 
*  CALLING SEQUENCES: 
* 
*  PROCESSOR FOR REMAT COMMAND "AT" (ATTACH): 
* 
*        JSB #RMSM
*        DEF *+7
*        DEF B1        REQUEST CODE.
*        DEF INBUF     "AT" COMMAND STRING ADDR.
*        DEF INCNT     LENGTH OF STRING IN WORDS. 
*        DEF NODE1     REMAT "NODE1" VARIABLE.
*        DEF NODE2     REMAT "NODE2" VARIABLE.
*        DEF LOGLU     REMAT LOGGING LU.
* 
* 
*  PROCESSOR FOR REMAT COMMAND "DE" (DETACH): 
* 
*        JSB #RMSM
*        DEF *+7
*        DEF B2        REQUEST CODE.
*        DEF CP1       PARAM 1 FLAG (PARSE BUFFER). 
*        DEF CP2       PARAM 2 FLAG (PARSE BUFFER). 
*        DEF NODE1
*        DEF NODE2
*        DEF LOGLU
* 
* 
*  PRE-PROCESSOR FOR REMAT "SW" COMMAND NODE-SWITCH.  REMOVE (& SAVE) 
*  ACCOUNT-NAME QUALIFIERS FROM THE SW COMMAND STRING AND PACK FOR
*  RE-PARSE.
* 
*        JSB #RMSM
*        DEF *+7
*        DEF B3        REQUEST CODE.
*        DEF INBUF     COMMAND BUFFER.
*        DEF INCNT     COMMAND LEN, +WORDS, ADJUSTED ON RETURN. 
*        DEF NODE1
*        DEF NODE2
*        DEF LOGLU
* 
*        SZA           IF NECESSARY,
*        JSB $PARS       RE-PARSE CONVERTED SW COMMAND. 
* 
* 
*  SUPPLEMENTARY POST-PROCESSOR FOR "SW" COMMAND NODAL DISPLAY.  DISPLAY
*  ACCOUNT NAMES FOR CURRENT SESSION (IF ANY) AT NODE1 AND NODE2. 
* 
*        JSB #RMSM
*        DEF *+7
*        DEF N1        REQUEST CODE.
*        DEF DUMMY
*        DEF DUMMY
*        DEF NODE1
*        DEF NODE2
*        DEF LOGLU
* 
* 
*  SUPPLEMENTARY POST-PROCESSOR FOR "SW" COMMAND.  LOG ON TO ACCOUNT
*  NAMES GIVEN IN ORIGINAL SW COMMAND QUALIFIERS FROM "REQ CODE 3" CALL 
*  TO #RMSM.
* 
*        JSB #RMSM
*        DEF *+2
*        DEF N2        REQUEST CODE.
* 
* 
*  SUPPLEMENTARY POST-PROCESSOR FOR "EX" COMMAND.  LOG OFF ALL REMAINING
*  ACTIVE REMOTE SESSIONS.
* 
*        JSB #RMSM
*        DEF *+2
*        DEF B0        REQUEST CODE.
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
* 
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
A     EQU 0 
B     EQU 1 
* 
RCODE NOP           #RMSM REQUEST CODE. 
BUFAD NOP           BUFFER ADDRESS. 
LEN   NOP           LENGTH OF BUFFER (+WORDS).
NODE1 NOP 
NODE2 NOP 
LOGLU NOP           LOGGING LU. 
* 
CP1A  EQU BUFAD     PARAMETER 1 FLAG. 
CP2A  EQU LEN       PARAMETER 2 FLAG. 
* 
#RMSM NOP 
      JSB .ENTR 
      DEF RCODE 
* 
      LDA RCODE,I   CHECK REQUEST CODE. 
      SZA,RSS 
      JMP EXSUP       "EX" SUPPLEMENTARY PROCESSING.
      SSA 
      JMP SWSUP       "SW" SUPPLEMENTARY PROCESSING.
* 
* "REMOTE SESSION" COMMAND "AT", "DE", OR "SW".  REMOVE ALL IMBEDDED
* BLANKS FROM THE COMMAND STRING (IN REMAT'S INPUT BUFFER). 
* 
      CPA B2
      JMP PROC      "DE" COMMAND. 
* 
      LDA LEN,I     LENGTH OF STRING IN WORDS.
      ALS 
      CMA,INA 
      STA CNTR      NEGATIVE # BYTES IN STRING. 
* 
      LDA BUFAD     FWA COMMAND STRING. 
      RAL 
      STA SRCE      SOURCE BYTE ADDRESS.
      STA DEST      DESTINATION BYTE ADDRESS. 
* 
LOOP  LDB SRCE      GET NEXT BYTE IN STRING.
      JSB .LBT
      STB SRCE
* 
      CPA B40       TEST THE CHARACTER. 
      JMP NEXT      SKIP OVER IF BLANK. 
* 
      LDB DEST      STORE IF NON-BLANK. 
      JSB .SBT
      STB DEST
* 
NEXT  ISZ CNTR      GO TO NEXT CHARACTER. 
      JMP LOOP      LOOP TILL DONE. 
* 
      LDA B40       END OF COMMAND STRING.
      ISZ SRCE      GUARANTEE 1 TRAILING BLANK. 
      LDB DEST      FILL OUT WITH TRAILING BLANKS 
FILL  JSB .SBT        UP TO AND INCLUDING 
      CPB SRCE        THE SOURCE BYTE POINTER 
      RSS             (REMAT BUFFER IS LONGER THAN
      JMP FILL        LONGEST ALLOWED COMMAND STRING).
* 
* GO TO REQUIRED PROCESSOR. 
* 
PROC  LDA RCODE,I 
      ADA JMPTB 
      LDA A,I 
      JMP A,I 
* 
JMPTB DEF * 
      DEF PR.AT     "ATTACH" COMMAND. 
      DEF PR.DE     "DETACH" COMMAND. 
      DEF PR.SW     "SWITCH" COMMAND. 
      SKP 
* 
* PROCESSOR FOR "AT" COMMAND:  CREATE NON-INTERACTIVE SESSION AT
* NODE1 OR NODE2 OR BOTH. 
* 
*  #AT,USER1NAMEX.GROUPNAMEX/PASSWORDXX,USER2NAMEX.GROUPNAMEX/PASSWORDXX
*  #AT,/PASSWORD1X,/PASSWORD2X
* 
PR.AT CLA           CLEAR "NO 2ND PARAM" FLAG.
      STA NO2ND 
* 
      LDA COMMA     SCAN FOR FIRST COMMA (START 
      LDB BUFAD      OF USER NAME FOR NODE1). 
      RBL           BYTE ADDRESS. 
      JSB .SFB        TERMINATE ON BLANK. 
      RSS           FOUND: B=BYTE ADDR OF COMMA.
      JMP #RMSM,I   NOT FOUND. RETURN.
* 
      INB 
      STB FIRST     BYTE ADDR 1ST CHAR OF USER-NAME.
* 
      JSB .SFB      SCAN FOR SECOND COMMA (END OF NAME).
      JMP AT1       FOUND.
      ADB N1        NOT FOUND. BACK UP FOR "LAST".
      CLA,INA         SET FLAG FOR "NO 2ND PARAM".
      STA NO2ND 
AT1   STB LAST      BYTE ADDR OF LAST CHAR +1.
* 
      LDA FIRST     IS THE FIRST USER NAME NULL?
      CMA,INA 
      ADA LAST
      SZA,RSS 
      JMP AT2       YES.
* 
      LDA NODE1,I   NO. LOG ON AT NODE1.
      JSB LOGON 
* 
AT2   LDA NO2ND     ALREADY KNOW NO 2ND USER-NAME?
      SZA 
      JMP #RMSM,I   YES. RETURN NOW.
* 
      LDB LAST      NO. SET "FIRST" TO BYTE ADDR OF 
      INB            CHAR FOLLOWING SECOND COMMA. 
      STB FIRST 
      LDA COMMA     SET TEST & TERM BYTES.
      JSB .SFB      SCAN FOR END OF USER-NAME.
      RSS           FOUND A COMMA.
      ADB N1        FOUND A BLANK.
      STB LAST      BYTE ADDR OF LAST CHAR + 1. 
* 
      LDA FIRST     IS 2ND USER-NAME NULL?
      CMA,INA 
      ADA LAST
      SZA,RSS 
      JMP #RMSM,I   YES. RETURN NOW.
* 
      LDA NODE2,I   NO. LOG ON AT NODE2.
      JSB LOGON 
* 
      JMP #RMSM,I   RETURN. 
      SKP 
* 
* PROCESSOR FOR "SW" COMMAND:  FIND ACCOUNT NAME QUALIFIERS (IF ANY)
* FOR THE NODE1 AND NODE2 PARAMETERS, SAVE IN ANOTHER AREA, REMOVE FROM 
* COMMAND STRING, REPACK COMMAND STRING, AND SIGNAL REMAT TO CALL $PARS 
* TO RE-PARSE THE SW COMMAND STRING.
* 
*  #SW,NODE1:USER.GROUP/PASSWORD,NODE2:USER.GROUP/PASSWORD,SECURITY 
*  #SW,NODE1:/PASSWORD,NODE2:/PASSWORD,SECURITY 
* 
PR.SW LDB BLANK     BLANK OUT STORAGE AREA
      LDA UNAM1      FOR ACCOUNT-NAME QUALIFIERS. 
      STB A,I 
      LDB A 
      INB 
      JSB .MVW
      DEF D33      (ONE EXTRA WORD PER NAME)
      NOP 
* 
      CLA 
      STA XTRCT     RESET "EXTRACTION FLAG".
* 
      LDA COMMA     SCAN TO 1ST COMMA,
      LDB BUFAD       TERMINATE ON BLANK. 
      RBL           BYTE ADDR OF SW COMMAND STRING. 
      JSB .SFB
      RSS           FOUND: B = BYTE ADDR OF COMMA.
      JMP EXIT      NOT FOUND. RETURN.
      INB 
      STB FIRST     SAVE ADDR OF NODE PARAM.
* 
      LDB BUFAD     STORE 2 COMMAS AT END OF STRING.
      ADB LEN,I 
      RBL 
      LDA COMMA 
      JSB .SBT
      JSB .SBT
* 
      LDA UNAM1     POINT TO AREA FOR NODE1 QUALIFIER.
      LDB FIRST     STARTING BYTE ADDR FOR SCAN.
      JSB FNAME     EXTRACT NODE1 QUALIFIER (IF ANY). 
* 
      LDA UNAM2     POINT TO AREA FOR NODE2 QUALIFIER.
      JSB FNAME     EXTRACT NODE2 QUALIFIER (IF ANY). 
* 
      LDA XTRCT     FOR EXIT, SET A = EXTRACTION FLAG.
      RSS 
EXIT  CLA 
* 
      JMP #RMSM,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO EXTRACT USER-NAME QUALIFIER (IF ANY). 
*     (A) = STORAGE AREA ADDR FOR QUALIFIER.
*     (B) = STARTING BYTE ADDR IN STRING FOR SCAN.
*     JSB FNAME 
* 
FNAME NOP 
      RAL 
      STA DEST      BYTE ADDR FOR STORING NAME. 
* 
      LDA COLON     SCAN FOR 1ST COLON, 
      JSB .SFB        TERMINATE ON COMMA. 
      RSS           FOUND.
      JMP FNAME,I   NOT FOUND. RETURN.
* 
      INB 
      STB FIRST     BYTE ADDR OF USER NAME. 
* 
      LDA COMA2     SCAN FOR COMMA, 
      JSB .SFB        TERMINATE ON COMMA. 
      NOP           WILL ALWAYS BE FOUND. 
      STB LAST      "FOUND". SAVE ADDR OF COMMA.
* 
      LDA FIRST 
      CMA,INA 
      ADA LAST
      STA BYTLN     # BYTES (+) IN USER-NAME. 
      INA 
      STA CNTR      # BYTES (+) TO DELETE FROM STRING.
      CPA B1
      JMP DELET     NONE TO MOVE. 
* 
      LDA FIRST     MOVE USER-NAME QUALIFIER. 
      LDB DEST
      JSB .MBT
      DEF BYTLN 
      NOP 
* 
DELET LDB BUFAD     COMPUTE # CHAR TO MOVE TO 
      ADB LEN,I       REPACK THE SW COMMAND STRING. 
      RBL 
      LDA LAST
      CMA,INA 
      ADA B 
      INA 
      STA TEMP
* 
      LDA LAST      DELETE QUALIFIER FROM COMMAND STRING. 
      LDB FIRST 
      ADB N1
      JSB .MBT
      DEF TEMP
      NOP 
* 
      LDA CNTR      BLANK OUT THE RESIDUE.
      CMA,INA       ((B) = ADDR OF FIRST BYTE.) 
      STA TEMP
      LDA B40 
CLEAR JSB .SBT
      ISZ TEMP
      JMP CLEAR 
* 
      LDA CNTR      ADJUST TOTAL SW COMMAND 
      ARS             LENGTH FOR REMAT. 
      CMA,INA 
      ADA LEN,I 
      STA LEN,I     (WORDS) 
* 
      ISZ XTRCT    FLAG THAT EXTRACTION WAS PERFORMED.
      LDB CNTR     BACK UP STRING POINTER, SINCE
      CMB,INB        QUALIFIER WAS DELETED FROM STRING. 
      ADB LAST
      INB 
      JMP FNAME,I  EXIT. B = ADDR FOR NEXT SCAN.
      SKP 
* 
* PROCESSOR FOR "DE" COMMAND:  DETACH FROM AND RELEASE SESSION
* AT NODE1 AND/OR NODE2.
* 
*  #DE          BOTH NODE1 & NODE2. 
*  #DE,N1       NODE1 ONLY. 
*  #DE,N2       NODE2 ONLY. 
*  #DE,N1,N2    BOTH NODE1 & NODE2. 
* 
PR.DE LDA CP1A,I     PARAMETER GIVEN? 
      SZA 
      JMP WHICH     YES.
      LDA NODE1,I   NO. DETACH FOR BOTH NODES.
      JSB LOGOF 
      LDA NODE2,I 
      JSB LOGOF 
      JMP #RMSM,I   RETURN. 
* 
WHICH LDB CP1A      GET PARAMETER P1. 
      INB 
      LDB B,I 
      LDA NODE1,I 
      CPB "N1"      IF NODE1, 
      JSB LOGOF       LOG OFF FOR NODE1.
      LDA NODE2,I 
      CPB "N2"      IF NODE2, 
      JSB LOGOF       LOG OFF FOR NODE2.
* 
      LDA CP2A,I    SECOND PARAMETER GIVEN? 
      SZA,RSS 
      JMP #RMSM,I   NO. 
* 
      LDB CP2A      YES. GET PARAMTER P2. 
      INB 
      LDB B,I 
      LDA NODE1,I 
      CPB "N1"      IF NODE1, 
      JSB LOGOF       LOG OFF FOR NODE1.
      CPB "N2"      IF NODE2, 
      JSB LOGOF       LOG OFF FOR NODE2.
* 
      JMP #RMSM,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO RELEASE NON-INTERACTIVE SESSION AND CLEAR LOCAL 
* NATX ENTRY. 
* IF THIS IS A NEW EXECUTION AND THE NAT HAS OLD INFO, IT WILL BE 
* CLEARED BY THE DLGOF ROUTINE AND THE LOGOFF WILL BE IGNORED.
* 
LOGOF NOP 
      STA NODE      SAVE DEST. NODE NUMBER. 
      CPA #NODE 
      JMP LOGOF,I   SKIP IT IF LOCAL NODE NUMBER. 
* 
      JSB DLGOF     LOG OFF.
      DEF *+3 
      DEF IERR
      DEF NODE
* 
      LDB IERR      CHECK FOR ERROR.
      SZB,RSS 
      JMP LOGOF,I   NO ERROR. RETURN. 
* 
      LDA "OF"      SET FOR LOGOF ERROR MESSAGE.
      STA EMSG+2
      JSB ERROR     DISPLAY ERROR MESSAGE.
* 
      JMP LOGOF,I   RETURN. 
      SPC 5 
      SKP 
* 
* SUBROUTINE TO MOVE USER NAME TO NETWORK ACCOUNT TABLE EXTENSION (NATX)
* WITH ALIGNMENT ON WORD BOUNDARY, AND LOG ON.  SET POINTER IN THE
* NETWORK ACCOUNT TABLE (NAT) TO THE LOCAL NATX ENTRY.
* NOTE -- IF THE DESTINATION NODE DOES NOT HAVE SESSION MONITOR, THE
*         NATX ENTRY WILL STILL BE FILLED WITH THE SPECIFIED USER-NAME, 
*         BUT THE "SW" DISPLAY WILL SHOW "(NONE)".
* 
LOGON NOP 
      STA NODE      SAVE DESTINATION NODE NUMBER. 
* 
      LDA FIRST     COMPUTE BYTE LENGTH OF NAME.
      CMA,INA 
      ADA LAST
      STA BYTLN     NEG # BYTES TO MOVE.
      CMA           SEE IF WITHIN RANGE.
      ADA D33       (MAX IS 32 BYTES) 
      SSA,RSS 
      JMP LXX       OK. 
      DLD "SM04     NG. GIVE "NO SUCH USER" ERROR.
      JMP LYY 
* 
LXX   LDA NATX#     FIND AVAILABLE NATX ENTRY.
      STA CNTR
      LDB DNATX     ADDR OF NATX 1ST ENTRY. 
LOOP1 LDA B,I       GET NEXT ENTRY WORD 1.
      SZA,RSS 
      JMP DESTP     FOUND AN AVAILABLE ENTRY. 
      ADB D11       GO TO NEXT ENTRY. 
      ISZ CNTR
      JMP LOOP1     LOOP TILL DONE. 
      DLD "RS03     NONE AVAILABLE. 
LYY   DST RQB+#EC1    DISPLAY LOGON ERROR "RS03"
      LDA #NODE       (NODE LIMIT EXCEEDED).
      IOR BIT15 
      STA RQB+#ENO
      LDA RQB+#ECQ
      AND NOTQ
      STA RQB+#ECQ
      LDA "ON"
      STA EMSG+2
      JSB ERROR 
      JMP #RMSM,I 
* 
DESTP STB UNAME     SAVE ADDR OF NATX ENTRY.
      RBL           DESTINATION BYTE POINTER. 
      LDA FIRST     SOURCE BYTE POINTER.
* 
      JSB .MBT      MOVE BYTES. IF PASSWORD ONLY, 
      DEF BYTLN       FIRST CHARACTER IS A "/". 
      NOP 
* 
      LDA BYTLN     BLANK OUT THE REST OF THE FIELD.
      STA TEMP      (B) = ADDR OF NEXT BYTE.
LOOP2 LDA TEMP
      CPA D33       (32 BYTES IS MAX SIZE)
      JMP PRIME 
      LDA B40 
      JSB .SBT
      ISZ TEMP
      JMP LOOP2 
* 
PRIME LDA BYTLN     SET # WORDS.
      INA 
      ARS 
      STA TEMP
* 
      LDB FIRST     CHECK IF THIS IS NON-SESSION REQ. 
      JSB .LBT
      CPA SLASH 
      JMP N.S.      YES (PASSWORD ONLY WAS SPECIFIED).
* 
      JSB DLGON     DO NON-INTERACTIVE LOG-ON.
      DEF *+5        ON RETURN, (A) = NAT ENTRY ADDR. 
      DEF IERR       CALL COULD RESULT IN LOG-OFF 
      DEF NODE       OF PRIOR SESSION BEFORE LOG-ON.
UNAME NOP 
      DEF TEMP
      JMP CKERR     GO CHECK FOR ERROR. 
* 
N.S.  JSB DLGNS     REQUEST NON-SESSION ACCESS. 
      DEF *+5        ON RETURN, (A) = NAT ENTRY ADDR. 
      DEF IERR       CALL COULD RESULT IN LOG-OFF 
      DEF NODE       OF PRIOR SESSION (IF ANY). 
      DEF UNAME,I   PASSWORD. 
      DEF TEMP
* 
CKERR LDB IERR      CHECK FOR ERRORS. 
      SZB 
      JMP ERRLG     GO PROCESS ERROR. 
* 
      ADA B2        POINT TO 3RD WORD OF NAT ENTRY. 
      LDB UNAME     STORE ADDRESS OF NATX 
      STB A,I         IN THE NAT ENTRY. 
      JMP LOGON,I   RETURN. 
* 
ERRLG LDA "ON"      SET FOR LOGON ERROR MESSAGE.
      STA EMSG+2
      JSB ERROR     DISPLAY ERROR MESSAGE.
* 
      CLA           CLEAR NATX ENTRY. 
      STA UNAME,I 
* 
      JMP LOGON,I   RETURN. 
      SKP 
* 
* SUBROUTINE CALL "DSERR" AND PRINT ERROR MSG.
* 
ERROR NOP 
* 
      JSB DSERR     CALL ROUTINE TO RETURN
      DEF *+2         DS ERROR PARAMETERS.
      DEF EMSG+4
* 
      JSB REIO      DISPLAY ERROR MESSAGE:
      DEF *+5         "RS01" -> "RS08"  FROM DLGON, 
      DEF ICD2        "DS01" -> "DS09"  FROM DS, OR 
      DEF LOGLU,I     "SM01" -> "SM13"  FROM LOGON. 
      DEF EMSG
      DEF D28 
      NOP           ERROR RETURN. 
* 
      JMP ERROR,I   RETURN. 
* 
EMSG  ASC 4,/LOGON: 
      BSS 24        BUFFER FOR "DSERR". 
      SKP 
* 
* SUPPLEMENTARY PROCESSING FOR "SW" COMMAND.
* 
SWSUP CPA N1        IF RCODE = -1,
      JMP DSPLY       GO DISPLAY ACCOUNT NAMES. 
      CPA N2        IF RCODE = -2,
      JMP LGON        GO LOG ON TO NODE1 AND/OR NODE2.
      JMP #RMSM,I   BAD RCODE.
* 
* DISPLAY ACCOUNT NAMES FOR CURRENT SESSION (IF ANY) AT NODE1 AND NODE2.
* 
DSPLY LDB BLANK     BLANK OUT LINE. 
      LDA UNAM1 
      STB A,I 
      LDB A 
      INB 
      JSB .MVW
      DEF D33 
      NOP 
* 
      LDA NODE1,I   IF SESSION AT NODE1,
      LDB UNAM1       MOVE NAME TO PRINT LINE.
      JSB GTNAM 
* 
      LDA NODE2,I   IF SESSION AT NODE2,
      LDB UNAM1 
      ADB D11 
      JSB GTNAM       MOVE NAME TO PRINT LINE.
* 
      JSB REIO      DISPLAY "ACCOUNT NAME = " 
      DEF *+5 
      DEF ICD2
      DEF LOGLU,I 
      DEF LINE1 
      DEF D18 
      NOP           ERROR RETURN. 
* 
      JSB REIO      DISPLAY ACCOUNT NAMES OR "(NONE)".
      DEF *+5         (ALSO "(NONE)" FOR SPECIAL
      DEF ICD2         NON-SESSION ACCESS.) 
      DEF LOGLU,I 
      DEF UN1 
      DEF D22 
      NOP           ERROR RETURN. 
* 
      JMP #RMSM,I   RETURN. 
* 
NONAD DEF DFLT
DFLT  ASC 4,(NONE)/ 
LINE1 ASC 18,ACCOUNT NAME =        ACCOUNT NAME = 
      SPC 3 
* 
* SUBROUTINE TO RETRIEVE ASCII USER NAME OF SESSION AT A NODE.
*  (A) = NODE NUMBER
*  (B) = DEST ADDR IN PRINT LINE FOR USER NAME. 
* 
GTNAM NOP 
      STB DEST      SAVE PRINT LINE ADDR. 
* 
      IFZ 
      CPA #NODE     IS IT THE LOCAL NODE? 
      RSS 
      JMP SNODE     NO. REMOTE NODE.
* 
      CLA 
      STA BUFR
* 
      JSB PGMAD     YES. GET USER'S ID SEGMENT ADDR.
      DEF *+3 
      DEF BUFR
      DEF XEQT
* 
      JSB SESSN     IS USER RUNNING UNDER A SESSION?
      DEF *+2 
      DEF XEQT
* 
      SEZ 
      JMP NONE      NO.  NO USER NAME TO DISPLAY. 
* 
      STB TEMP      YES. SAVE SCB POINTER.
* 
      JSB ISMVE     MOVE DATA FROM THE SCB. 
      DEF *+5 
      DEF TEMP        SESSION WORD FROM ID SEGMENT. 
      DEF $SMD#       POINT TO DIRECTORY ENTRY NUMBER.
      DEF CNTR        LOCATION TO BE FILLED.
      DEF B1          NUMBER OF WORDS TO FETCH. 
* 
      LDA CNTR      GET USER NAME CORRESPONDING 
      LDB RBUFA       TO DIRECTORY ENTRY # OF 
      JSB .UNAM         CURRENT LOCAL SESSION.
      DEF ERBUF 
      SZA 
      JMP NONE      ERROR.
* 
      LDA RBUF      ISOLATE BYTE LEN OF USER NAME.
      SZA,RSS 
      JMP NONE      NO NAME.
      ALF,ALF 
      AND B377
      STA CNTR      BYTE LEN OF USER NAME PORTION.
      LDA RBUF      GET BYTE LEN OF GROUP NAME
      AND B377        AND SAVE TEMPORARILY. 
      STA TEMP1 
* 
      LDB RBUFA     SET DEST BYTE POINTER FOR MOVE. 
      RBL 
      STB TEMP      SAVE FOR FINAL MOVE TO PRINT LINE.
      LDA B         SET SOURCE BYTE POINTER FOR MOVE. 
      ADA B2
      JSB .MBT      LEFT JUSTIFY USER NAME PORTION. 
      DEF CNTR
      NOP           ((B) WILL POINT TO LOC. OF PERIOD.) 
* 
      LDA TEMP1     ANY GROUP NAME? 
      SZA,RSS 
      JMP BFILL     NO. GO DO TRAILING BLANK FILL.
      ADA CNTR      YES. ADD TO TOTAL BYTE LEN. 
      INA           ACCOUNT FOR INSERTED PERIOD.
      STA CNTR
* 
      LDA DOT       STORE PERIOD OF "USER.GROUP". 
      JSB .SBT
* 
      LDA RBUFA     POINT TO GROUP NAME (BYTE ADDR).
      ADA B6
      RAL             SOURCE POINTER ((B) = DEST PTR).
      JSB .MBT      MOVE GROUP NAME.
      DEF TEMP1 
      NOP           ((B) WILL POINT TO 1ST BYTE TO FILL.) 
* 
BFILL LDA CNTR      COMPUTE # BYTES TO BLANK OUT. 
      CMA,INA 
      ADA D21 
      SZA,RSS 
      JMP MVNAM     NONE. GO DISPLAY (TEMP & CNTR ARE SET). 
* 
      STA BYTLN     + # BLANK BYTES NEEDED, -1. 
      LDA BLANK     STORE FIRST BLANK BYTE. 
      JSB .SBT
      LDA B         BLANK FILL. 
      ADA N1
      JSB .MBT
      DEF BYTLN 
      NOP 
* 
      JMP MVNAM     GO DISPLAY (TEMP & CNTR ARE SET). 
      XIF 
* 
SNODE JSB #NASR     SEARCH FOR NODE # GIVEN IN (A). 
      SZB,RSS 
      JMP NONE      NOT FOUND.
* 
      ADB B2        FOUND. (B) = NAT ENTRY ADDR, (A) = SID. 
      LDB B,I       ADDR OF ASCII USER NAME IN NATX.
      SZB,RSS 
      JMP NONE      NO USER NAME. 
* 
      AND B377      IF NO DESTINATION SESSION ID, 
      SZA,RSS         I.E. NO SESSION MONITOR, ETC.,
      LDB NONAD       CHANGE DISPLAY TO SHOW "(NONE)".
      RBL           BYTE ADDR OF USER NAME IN NATX. 
      STB TEMP
      LDA N22       MAXIMUM # BYTES UP TO A SLASH.
      STA CNTR
* 
LOOP3 JSB .LBT      LOOK FOR A SLASH (START OF PASSWORD). 
      CPA SLASH 
      JMP OUTP
      ISZ CNTR
      JMP LOOP3 
* 
OUTP  LDA CNTR      MOVE BYTES UP TO SLASH (PASSWORD) 
      ADA D22         TO PRINT LINE.
      STA CNTR
      SZA           ANYTHING TO MOVE? 
      JMP MVNAM     YES.
* 
NONE  LDA B6        NO. MOVE "(NONE)" TO DISPLAY. 
      STA CNTR
      LDA NONAD 
      RAL 
      RSS 
MVNAM LDA TEMP        (IF PASSWORD ONLY,
      LDB DEST         DISPLAY WILL BE "(NONE)".) 
      RBL 
      JSB .MBT
      DEF CNTR
      NOP 
* 
      JMP GTNAM,I   RETURN. 
      SKP 
* 
* LOG ON TO ACCOUNT NAMES (IF ANY) SPECIFIED IN THE SW COMMAND
* NODE QUALIFIERS.
* 
LGON  LDA UN1       QUALIFIER FOR NODE1?
      CPA BLANK 
      JMP LGON2     NO. 
* 
      LDB UNAM1     YES. SET UP "FIRST" & "LAST". 
      JSB SETUP 
      LDA NODE1,I   LOG ON AT NODE1.
      JSB LOGON 
* 
LGON2 LDA UN2       QUALIFIER FOR NODE2?
      CPA BLANK 
      JMP #RMSM,I   NO. 
* 
      LDB UNAM2     YES. SET UP "FIRST" & "LAST". 
      JSB SETUP 
      LDA NODE2,I   LOG ON AT NODE2.
      JSB LOGON 
* 
      JMP #RMSM,I   RETURN. 
      SKP 
* 
* SUPPLEMENTARY PROCESSING FOR "EX" COMMAND.
* LOG OFF ALL REMOTE "SESSIONS" STILL ACTIVE - THIS INCLUDES CALLING
* DLGOF FOR NON-SESSION-MONITOR NODES AND NON-SESSION ACCESS TO SESSION-
* MONITOR NODES TO RELEASE PNL AND NAT ENTRIES. 
* IF THIS IS A NEW EXECUTION AND THE NAT HAS OLD INFO, THE NAT WILL BE
* CLEARED BY THE DLGOF ROUTINE AND THE LOGOFF WILL BE IGNORED.
* 
EXSUP LDA #NAT      FWA NETWORK ACCOUNT TABLE.
      STA DEST
      LDA NAT#      SET FOR # ENTRIES.
      STA CNTR
* 
SCAN  LDA DEST,I    GET NODE # FROM NEXT ENTRY. 
      SZA,RSS 
      JMP NEXT1     NOT IN USE. 
* 
      JSB LOGOF     LOG OFF SESSION AT NODE IN (A). 
* 
NEXT1 LDA DEST      ADVANCE TO NEXT NAT ENTRY.
      ADA B4
      STA DEST
      ISZ CNTR
      JMP SCAN      LOOP TILL DONE. 
* 
      JMP #RMSM,I   RETURN. 
      SPC 5 
* 
* SUBROUTINE TO FIND END OF EXTRACTED & SAVED USER NAME, AND
* SET UP "FIRST" & "LAST" BYTE POINTERS.
* 
SETUP NOP 
      RBL 
      STB FIRST     BYTE ADDR OF USER NAME. 
      LDA BLANK     SCAN FOR END OF NAME. 
      JSB .SFB
      NOP           WILL ALWAYS BE FOUND. 
      STB LAST      SET "LAST" POINTER. 
      JMP SETUP,I   RETURN. 
      SKP 
* 
* CONSTANTS AND STORAGE.
* 
B1    OCT 1 
B2    OCT 2 
B4    OCT 4 
B6    OCT 6 
B40   OCT 40
B377  OCT 377 
BIT15 OCT 100000
NOTQ  OCT 177417
D11   DEC 11
D18   DEC 18
D21   DEC 21
D22   DEC 22
D28   DEC 28
D33   DEC 33
N1    DEC -1
N2    DEC -2
N22   DEC -22 
ICD2  OCT 100002
BLANK OCT 20040     BLANK,BLANK 
COMMA OCT 20054     BLANK,COMMA 
COLON OCT 26072     COMMA,COLON 
COMA2 OCT 26054     COMMA,COMMA 
SLASH OCT 57
"N1"  ASC 1,N1
"N2"  ASC 1,N2
"ON"  ASC 1,ON
"OF"  ASC 1,OF
"RS03 ASC 2,RS03
"SM04 ASC 2,SM04
SRCE  NOP 
DEST  NOP 
CNTR  NOP 
NO2ND NOP 
FIRST NOP 
LAST  NOP 
NODE  NOP 
BYTLN NOP 
TEMP  NOP 
IERR  NOP 
XTRCT NOP 
BUFR  BSS 3 
UNAM1 DEF UN1 
UNAM2 DEF UN2 
UN1   BSS 17        (ONE EXTRA WORD)
UN2   BSS 17        (ONE EXTRA WORD)
* 
      IFZ 
XEQT  NOP 
DOT   OCT 56        ASCII PERIOD. 
TEMP1 NOP 
RBUFA DEF RBUF
RBUF  BSS 11
ERBUF BSS 128 
      XIF 
      SPC 5 
NAT#  DEC -16       NEG. # NAT ENTRIES. 
NATX# DEC -16       NEG. # NATX ENTRIES.
* 
DNATX DEF *+1       NETWORK ACCOUNT TABLE EXTENSION 
      REP 256       (NATX) FOR 16 16-WORD USER-NAMES. 
      OCT 0 
* 
      BSS 0         SIZE OF #RMSM.
* 
      END 
                                                                                                                                                                                                                                        