ASMB,R,Q,C
      HED DLGON 91750-1X066 REV 2013 * (C) HEWLETT-PACKARD CO.1980
      NAM DLGON,7 91750-1X066 REV.2013 800725 ALL 
      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 DLGON,DLGOF,DLGNS 
* 
      EXT #MAST,#NASR,#RSAX,#TBRN,RNRQ,$OPSY,#NODE
      EXT #NRVS,.ENTR,LUTRU,.MVW,PGMAD,#LDEF,.DRCT
      EXT #RQB,LOGLU,.LBT,#DFSN,#NEWX 
RQB   EQU #RQB
* 
      SUP 
* 
* NAME:   DLGON 
* SOURCE: 91750-18066 
* RELOC:  PART OF 91750-12014, -12015 
* PGMR:   JIM HARTSELL
* 
* USER CALLABLE NON-INTERACTIVE LOG-ON UTILITY. 
* 
* SUBROUTINE DLGON MUST BE CALLED BY A USER PROGRAM BEFORE
* ANY MASTER COMMUNICATION FUNCTIONS WITH A SPECIFIC SESSION
* MONITOR ACCOUNT AT A REMOTE HP 1000.  DLGON WILL LOG OFF PREVIOUS 
* SESSION, IF LEFT PENDING.  CALLS TO LOCAL NODE ARE ILLEGAL. 
* 
* CALLING SEQUENCES:
* 
*     LOGON:               LOGOFF:             NON-SESSION: 
* 
*        JSB DLGON            JSB DLGOF            JSB DLGNS
*        DEF *+5              DEF *+3              DEF *+5
*        DEF IERR             DEF IERR             DEF IERR 
*        DEF NODE             DEF NODE             DEF NODE 
*        DEF IACCT            .                    DEF JACCT
*        DEF LEN              .                    DEF LEN
*        .                    .                    .
*        . (A) = NAT          .                    . (A) = NAT
*        .  ENTRY #           .                    .  ENTRY # 
* 
* WHERE:
* 
*  IACCT ASC 16,USERNAMEXX[.GROUPNAMEX][/PASSWORDXX]
*  JACCT ASC 5,PASSWORDXX    (1ST CHAR = "/" IS OPTIONAL) 
* 
* 
* THE RETURNED IERR CAN BE EITHER -1 -> -7 FROM DLGON OR RSM ("RSXX"),
* -50 -> -59 FROM DS ("DSXX"), OR +1 -> +13 FROM LOGON ("SMXX").
* "DSERR" WILL DISPLAY THE ASCII VERSION, E.G. "RSXX".
      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 
* OPBLK-START 
* 
******************************************************************
*                                                                *
*      O P R E Q   B L O C K               REV 2013 791119       *
*                                                                *
*      OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY:      *
*                                                                *
*                   DMESS, OPERM, RQCNV, RPCNV                   *
*                   RSM,   DLGON, #MSSM, #UPSM                   *
******************************************************************
* 
* OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. 
* 
#CML  EQU #REQ      COMMAND LENGTH. 
#CMS  EQU #CML+1    COMMAND STRING. 
#LGC  EQU #CMS+1    LOGON REQUEST CODE
#LNL  EQU #LGC+1    LENGTH OF USER NAME 
#LUN  EQU #LNL+1    LOGON USER NAME 
* 
#RLN  EQU #REP      REPLY LENGTH. 
#MSG  EQU #RLN+1    REPLY MESSAGE.
* 
* MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. 
* 
#OLW  EQU #CMS+23     M A X I M U M   S I Z E   ! ! ! 
* 
* OPBLK-END 
      SKP 
* 
A     EQU 0 
B     EQU 1 
* 
DLGON NOP           ENTRY FOR LOG-ON. 
      LDA DLGON 
      CLB,INB         ICODE = 1.
      JMP PASAD 
* 
DLGOF NOP           ENTRY FOR LOG-OFF.
      LDA DLGOF 
      CLB             ICODE = 0.
      JMP PASAD 
* 
DLGNS NOP           ENTRY FOR NON-SESSION ACCESS. 
      LDA DLGNS 
      LDB B2          ICODE = 2.
* 
PASAD STA RETRN     SET UP FOR RETURN ADDRESS.
      STB ICODE     SAVE REQUEST CODE.
* 
      CLA 
      STA PRAMS     CLEAR OLD PARAM ADDRESSES.
      STA PRAMS+1 
      STA PRAMS+2 
      STA PRAMS+3 
      JMP ENTER 
* 
PRAMS NOP           ERROR CODE. 
      NOP           NODE NUMBER.
      NOP           ADDR OF ASCII USER-NAME.
      NOP           LENGTH OF USER-NAME (BYTES).
* 
RETRN NOP 
ENTER JSB .ENTR     GET PARAM ADDRESSES.
      DEF PRAMS 
* 
      LDA PRAMS+1,I BLOCK DLGON CALLS 
      CPA #NODE       TO LOCAL NODE 
      JMP LOCER         (ERROR -7). 
      CPA N1
      JMP LOCER 
* 
      JSB .DRCT     CLEAR OLD REQUEST.
      DEF RQB 
      STA TEMP
      LDB C#MXR 
      CMB,INB 
      CLA 
      STA TEMP,I
      ISZ TEMP
      INB,SZB 
      JMP *-3 
* 
      STA PRAMS,I   CLEAR USER ERROR CODE.
      STA OLDSN     CLEAR "OLD SESSION" FLAG. 
      LDA #NODE     INITIALIZE ERROR
      STA RQB+#ENO    REPORTING NODE NUMBER.
* 
* CHECK FOR MISSING PARAMETERS
* 
      LDB PRAMS+3   GET LAST PARAM ADDRESS. 
      LDA ICODE     GET REQUEST CODE. 
      STA RCODE     SAVE FOR RESTORE. 
      SZA,RSS       IF ZERO,
      LDB PRAMS+1     GET LOGOF LAST PARAM ADDRESS. 
      SZB,RSS       PARAMETERS SPECIFIED? 
      JMP ILLRQ     NO. ERROR.
* 
* CONVERT LU TO DESTINATION NODE. 
* 
      LDA PRAMS+1,I GET -LU/+NODE.
      STA TNODE     SAVE. 
      SSA,RSS 
      JMP VERFY     ALREADY +NODE.
* 
      JSB #NRVS 
      DEF *+6 
      DEF PRAMS+1,I -LU OF NEIGHBOR.
      DEF TEMP      DUMMY.
      DEF LEVEL     LEVEL # OF DEST. NODE.
      DEF TEMP      DUMMY.
      DEF TNODE     RETURNED NODE NUMBER. 
      JMP NSERR     ERROR RETURN. (B) = "04". 
* 
      LDA LEVEL     IF DESTINATION NODE 
      SZA,RSS         IS AN OLD NODE, 
      JMP OLDND       RETURN "RS04".
* 
VERFY JSB #NEWX     CHECK FOR NEW EXECUTION.
* 
* IF A LOG-OFF REQUEST, CHECK IF DESTINATION NODE IS NON-SESSION
* AND VERIFY THAT A SON IS NOT LOGGING OFF A FATHER'S SESSION (SON MUST 
* BE THE OWNER (CREATOR) OF THE REMOTE SESSION).
* 
      LDA ICODE     LOG-OFF REQUEST?
      SZA 
      JMP CKREQ     NO. 
* 
      LDA TNODE     YES. SEE IF DEST. NODE IS IN THE NAT. 
      JSB #NASR 
      SZB,RSS 
      JMP OFRET     NO. IGNORE THE LOG-OFF. 
      STA OFSID     YES. SAVE DEST. SESSION ID. 
      STB NATAD     SAVE NAT ENTRY ADDR.
      SZA             IF DESTINATION SESSION ID 
      CPA D254           IS 0 OR 254, 
      JMP RPNL           JUST RELEASE PNL & NAT ENTRIES.
* 
FACHK CLA 
      STA BUFR
      JSB PGMAD     GET ID SEG ADDR OF USER.
      DEF *+3 
      DEF BUFR
      DEF XEQT
* 
      LDB #LDEF     SEARCH PNL FOR ID SEG ADDR. 
      ADB N1
      LDB B,I       ADDR OF PNL HEADER. 
PNLST JSB LODWD     (CROSS) LOAD ADDR OF NEXT PNL ENTRY.
      SZA,RSS       (A) = ADDR OF NEXT ENTRY. 
      JMP SONOF     NOT FOUND. ERROR. 
* 
      LDB A         POINT TO 5TH WORD IN PNL ENTRY. 
      ADB B4
      JSB LODWD     (CROSS) LOAD 5TH WORD.
      CPA XEQT      OUR ID SEGMENT ADDRESS? 
      JMP BUILD     YES. PROCEED WITH LOG-OFF.
      ADB N4        NO (ALSO NO MATCH IF "BAD ENTRY"
      JMP PNLST       BIT IS SET IN PNL ENTRY). 
* 
* DETERMINE IF REQUESTING NON-SESSION ACCESS OR LOGGING ON TO A 
* NODE THAT STILL HAS AN ACTIVE SESSION OR NON-SESSION "PERMIT" FOR 
* THIS USER OR HAS ALREADY BEEN LOGGED AS A NON-SESSION-MONITOR NODE. 
* 
CKREQ LDA ICODE     CHECK REQUEST CODE. 
      CPA B2
      JMP CKRQ1       NON-SESSION.
      CPA B1
      RSS             LOG-ON. 
      JMP ILLRQ       ILLEGAL REQUEST CODE. 
* 
CKRQ1 LDA TNODE     GET DEST. NODE. 
      JSB #NASR     SEARCH NETWORK ACCOUNT TABLE. 
      SZB,RSS         (A) = DEST SID (CAN BE 0 OR 254). 
      JMP SONCK     NO ENTRY (NO PRIOR SESSION).
* 
      STA OFSID     SAVE DESTINATION SESSION ID.
      STB NATAD     SAVE ADDR OF NAT ENTRY. 
      CLB,INB       SET FLAG TO LOG OFF OLD SESSION BEFORE
      STB OLDSN      LOG ON OR NON-SESSION ACCESS.
      SZA           IF PRIOR WAS LOGGED AS NON-SM NODE, 
      CPA D254      OR IF PRIOR WAS A NON-SESSION ACCESS, 
      JMP RPNL       JUST GO RELEASE PNL AND NAT. 
* 
      CLA           PRIOR SESSION: DUMMY THE REQUEST CODE 
      STA ICODE      TO "LOGOF" FOR THE TIME BEING. 
      JMP FACHK     MAKE SURE WE OWN THE SESSION! 
* 
* VERIFY THAT A PROGRAM IS NOT TRYING TO LOG ON OR GET NON-SESSION
* ACCESS TO A NODE WHERE ANOTHER PROGRAM IN THIS "PROCESS" (SAME
* SCHEDULING LU)  ALREADY HAS A SESSION.
* 
SONCK CLA,INA       INIT SCHEDULING SYSTEM LU 
      STA REALU       FOR PNL ENTRY.
* 
      JSB LOGLU     GET SCHEDULING LU.
      DEF *+2 
      DEF TEMP      (DUMMY PARAM) 
* 
      SZA,RSS 
      JMP NAT       IF ZERO, USE REALU = 1 FOR PNL. 
      STA TEMP      SAVE SCHEDULING LU. 
* 
      JSB LUTRU     MAKE SURE ITS A SYSTEM LU.
      DEF *+3 
      DEF TEMP
      DEF REALU     (USE FOR PNL ENTRY LATER) 
* 
      LDB #LDEF     SEARCH PNL. 
      ADB N1
      LDB B,I       ADDR OF PNL HEADER. 
PNLSR JSB LODWD     GET ADDR OF NEXT PNL ENTRY. 
      SZA,RSS 
      JMP NAT       NOT FOUND. ALL CLEAR TO PROCEED.
* 
      LDB A         POINT TO WORD 3 OF PNL ENTRY. 
      ADB B2
      JSB LODWD     GET REMOTE NODE #.
      CPA TNODE     SAME AS USER'S DESTINATION? 
      JMP *+3       YES. GO CHECK TERMINAL LU.
      ADB N2        NO. GO TO NEXT PNL ENTRY. 
      JMP PNLSR 
      INB           POINT TO LOCAL TERMINAL LU. 
      JSB LODWD     GET TERMINAL LU.
      AND B377
      CPA REALU     SAME AS OUR SCHEDULING LU?
      RSS 
      JMP PNLNX     NO. GO CHECK NEXT PNL ENTRY.
      INB           YES. BAD ID SEGMENT?
      JSB LODWD 
      SSA,RSS 
      JMP SONOF     NO. ERROR "RS06". 
      ADB N1        YES. IGNORE PNL.
PNLNX ADB N3        GO CHECK NEXT PNL ENTRY 
      JMP PNLSR       (COULD BE GOOD ONE AFTER THIS ONE). 
* 
* IF REQUEST IS FOR LOG-ON OR NON-SESSION ACCESS, FIND AN 
* AVAILABLE ENTRY IN THE NETWORK ACCOUNT TABLE (D$NAT). 
* 
NAT   CLA 
      JSB #NASR     SEARCH. 
      SZB,RSS 
      JMP NROOM     NONE AVAILABLE. ERROR.
      STB NATAD     OK. SAVE ENTRY ADDRESS. 
* 
* BUILD LOGON/LOGOFF/NON-SESSION REQUEST. 
* 
BUILD LDA B7        STORE OPREQ STREAM. 
      STA RQB+#STR
      LDA PRAMS+1,I STORE DESTINATION NODE. 
      STA RQB+#DST
* 
      LDA B2        SET COMMAND LEN = 2 BYTES.
      STA RQB+#CML
      LDA "XX"      STORE COMMAND STRING. 
      STA RQB+#CMS
      LDA ICODE     STORE REQUEST CODE. 
      STA RQB+#LGC
* 
      SZA           IS THIS A LOG OFF?
      JMP BLDMO     NO. GO CONTINUE BUILDING. 
* 
      LDA L#LNL     YES. SET REQUEST LENGTH.
      STA RQLEN 
* 
      LDA TNODE     GET NAT INFO (AGAIN). 
      JSB #NASR 
      STB NATAD 
      AND B377      STORE SESSION ID
      STA RQB+#LNL    IN LOGOFF REQUEST BUFFER. 
      JMP SEND      GO SEND LOGOFF REQUEST. 
* 
* 
* STORE USER NAME AND/OR PASSWORD IN REQUEST BUFFER.
* 
BLDMO LDA PRAMS+3,I LENGTH IN +WORDS OR -BYTES. 
      SZA,RSS 
      JMP ILLRQ     ERROR IF LENGTH = 0.
      SSA           MAKE + BYTES. 
      CMA,INA,RSS 
      ALS 
      STA RQB+#LNL  STORE LENGTH IN REQUEST.
      CMA           IF OVER 32 BYTES, 
      ADA K33 
      SSA 
      JMP NSUCH       NAME IS TOO LONG. 
* 
LOOP  LDB PRAMS+2   GET BYTE ADDR OF LAST CHAR. 
      RBL 
      ADB RQB+#LNL
      ADB N1
      JSB .LBT      IF LAST CHAR = BLANK, 
      CPA B40 
      RSS 
      JMP CORCT 
      LDA RQB+#LNL    DECREMENT BYTE LEN IN REQ.
      ADA N1
      STA RQB+#LNL
      JMP LOOP      GO CHECK FOR ANOTHER BLANK. 
* 
CORCT LDA RQB+#LNL  GET CORRECTED CHAR. COUNT.
      INA           MAKE WORDS. 
      ARS 
      STA TEMP      SAVE AS WORD COUNT. 
      ADA L#LNL     SET REQUEST LENGTH. 
      STA RQLEN 
* 
      LDA PRAMS+2   STORE NAME IN REQUEST.
      LDB D#LUN 
      JSB .MVW
      DEF TEMP
      NOP 
* 
* SEND REQUEST TO THE DESTINATION HP 1000.
* 
SEND  JSB #MAST     SHIP THE REQUEST BUFFER.
      DEF *+7 
      DEF CONWD     NO-ABORT BIT SET IN CONWD.
      DEF RQLEN     REQUEST LENGTH. 
      DEF B0
      DEF B0
      DEF B0
      DEF L#REP     MAX ALLOWED REPLY LEN.
      JMP DSER      ERROR RETURN ("DSXX", "RSXX", "SMXX", ETC.).
* 
      LDA ICODE     LOG-OFF?
      SZA,RSS 
      JMP RPNL      YES. GO RELEASE PNL ENTRY.
* 
* BUILD PROCESS NUMBER LIST ENTRY IN "RES" FOR LOG-ON AND NON-SESSION.
* 
      JSB RNRQ      WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE.
      DEF *+4 
      DEF LGW       LOCK GLOBAL RN/WAIT/NO ABORT. 
      DEF #TBRN     TABLE-ACCESS RN.
      DEF TEMP      DUMMY.
      JMP TBLER     ** RTE ERROR. 
* 
      LDA RQB+#SID  ISOLATE RETURNED DEST SESSION ID. 
      AND B377
      STA TEMP
* 
      JSB #RSAX     ADD PROCESS # LIST ENTRY. 
      DEF *+6 
      DEF K8
      DEF REALU      LOGGING LU.
      DEF TEMP       DEST. SESSION ID.
      DEF TNODE      DEST. NODE.
      DEF B0         MPE/RTE BIT = RTE. 
* 
      SSB           ANY ERRORS? 
      JMP TBLER     YES.
* 
* COMPLETE THE ENTRY IN THE NETWORK ACCOUNT TABLE (D$NAT) FOR 
* LOG-ON AND NON-SESSION ACCESS.
* 
      LDB NATAD     ENTRY ADDRESS.
      LDA TNODE 
      STA B,I       STORE NODE NUMBER.
      INB 
      LDA RQB+#SID
      AND B377
      STA B,I       STORE RETURNED DEST SESSION ID. 
      INB             (CAN BE 0 OR 254) 
      CLA 
      STA B,I       CLEAR ADDR OF ASCII USER NAME.
      INB 
      STA B,I       CLEAR EXECW SEQ #.
* 
      LDA NATAD     LOAD UP NAT ENTRY NUMBER FOR REMAT. 
      JMP RETRN,I   RETURN TO THE USER. 
* 
* REMOVE AN ENTRY FROM THE PROCESS # LIST IN "RES". 
* 
RPNL  JSB #RSAX 
      DEF *+4 
      DEF K10       REMOVE AN ENTRY.
      DEF OFSID     DEST SESSION ID.
      DEF TNODE     DEST NODE NUMBER. 
* 
* DELETE ENTRY IN NETWORK ACCOUNT TABLE.
* 
      LDB NATAD     GET POINTER TO NATX 
      ADB B2         ENTRY (IF ANY) IN
      LDB B,I        REMAT'S #RMSM ROUTINE. 
      SZB,RSS 
      JMP OLNEW      NO NATX. 
      CPB #DFSN 
      JMP OLNEW      (SKIP "DEFAULT SESSION") 
      CLA           CLEAR NATX ENTRY
      STA B,I        (ASCII ACCOUNT NAME FOR
      LDA B           THIS REMOTE SESSION). 
      INB 
      JSB .MVW
      DEF K10 
      NOP 
* 
OLNEW LDA OLDSN     WAS THIS AN OLD SESSION 
      SZA             OR NON-SESSION ACCESS?
      JMP GOBAK     YES. STILL NEED TO LOG-ON.
* 
      LDB NATAD     NO. GET NAT ENTRY ADDRESS.
      CLA           RELEASE THE ENTRY.
      STA B,I 
      LDA B 
      INB 
      JSB .MVW
      DEF B4
      NOP 
* 
OFRET CLA 
      JMP RETRN,I   RETURN TO THE USER. 
* 
GOBAK CLA           RELEASE ENTRY, BUT USE IT FOR 
      STA NATAD,I     LOG-ON OR NON-SESSION "PERMIT". 
      STA OLDSN     CLEAR "OLD SESSION" FLAG. 
      LDA RCODE     RESTORE ORIGINAL REQUEST CODE 
      STA ICODE       (LOG-ON OR NON-SESSION REQUEST).
      JMP SONCK     GO DO LOG-ON. 
* 
NSUCH DLD "SM04     ACCOUNT NAME IS TOO LONG. 
      JMP NGOOD 
NROOM DLD "RS03     LIMIT REACHED ON # SESSIONS.
      JMP NGOOD 
OLDND DLD "RS04     NO S.M. AT OLD NODES. 
      JMP NGOOD 
SONOF DLD "RS06     SON PROG ATTEMPTED LOGON OR LOGOFF. 
      JMP NGOOD 
LOCER DLD "RS07     LOG-ON/OFF TO LOCAL NODE. 
      JMP NGOOD 
NSERR DLD "DS04     INVALID NODE/LU.
      JMP NGOOD 
TBLER DLD "DS07     "RES" TABLE ACCESS ERROR. 
      JMP NGOOD 
ILLRQ DLD "DS09     ILLEGAL REQ CODE, OR MISSING PARAM. 
* 
NGOOD DST RQB+#EC1  KEEP "DSERR" HAPPY BY STUFFING
      LDA #NODE       ERROR INFO IN REPLY BUFFER. 
      IOR BIT15 
      STA RQB+#ENO
      LDA RQB+#ECQ
      AND NOTQ
      STA RQB+#ECQ
* 
DSER  LDA RQB+#EC2  GET ERROR NUMBER. 
      LDB RQB+#ENO  ASCII?
      SSB,RSS 
      JMP DSER1     NO. 
      CLB           YES. CONVERT TO BINARY. 
      RRR 4              GET LEAST SIGNIFICANT DIGIT. 
      BLF 
      STB TEMP           SAVE IT TEMPORARILY. 
      RRR 4              GET TENS DIGIT.
      AND B17 
      MPY K10            MULTIPLY BY TEN. 
      ADA TEMP           ADD UNITS DIGIT. 
* 
DSER1 LDB RQB+#EC1
      CPB "DS"      IF "DSXX",
      ADA K50         ADD 50. 
      CPB "SM"      IF NOT "SMXX",
      RSS             (I.E. DSXX/RSXX), 
      CMA,INA         NEGATE. 
      SZA           IF 0 (RS00/SM00), 
      JMP DSER2 
      DLD "RS04 
      DST RQB+#EC1
      LDA N4          MAP TO -4.
      JMP RTERR 
* 
DSER2 CPB "DS"      IF NOT "DS",
      JMP RTERR         OR
      CPB "SM"             "SM",
      JMP RTERR         OR
      CPB "RS"             "RS",
      JMP RTERR         THEN
      LDA N59           USE -59 CATCH-ALL.
* 
RTERR STA PRAMS,I   RETURN ERROR CODE.
* 
      CLA 
      JMP RETRN,I   RETURN TO CALLER. 
* 
* LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS. 
* 
LODWD NOP 
      LDA $OPSY     OPERATING SYSTEM TYPE.
      RAR,SLA       SKIP IF NON-DMS.
      JMP *+3 
      LDA B,I       NON-DMS.
      JMP LODWD,I 
      XLA B,I       DMS CROSS-LOAD. 
      JMP LODWD,I 
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
B0    OCT 0 
B1    OCT 1 
B2    OCT 2 
B4    OCT 4 
B7    OCT 7 
B17   OCT 17
B40   OCT 40
B377  OCT 377 
BIT15 OCT 100000
NOTQ  OCT 177417
D254  DEC 254 
K8    DEC 8 
K10   DEC 10
K33   DEC 33
K50   DEC 50
N1    DEC -1
N2    DEC -2
N3    DEC -3
N4    DEC -4
N59   DEC -59 
"XX"  ASC 1,XX
"SM"  ASC 1,SM
"RS"  ASC 1,RS
"DS"  ASC 1,DS
"SM04 ASC 2,SM04
"RS03 ASC 2,RS03
"RS04 ASC 2,RS04
"RS06 ASC 2,RS06
"RS07 ASC 2,RS07
"DS04 ASC 2,DS04
"DS07 ASC 2,DS07
"DS09 ASC 2,DS09
BUFR  BSS 3 
D#LUN DEF RQB+#LUN
OFSID NOP 
NATAD NOP 
ICODE NOP 
RCODE NOP 
TNODE NOP 
LEVEL NOP 
TEMP  NOP 
XEQT  NOP 
OLDSN NOP 
CONWD OCT 100000
LGW   OCT 40002 
REALU NOP 
RQLEN NOP 
L#LNL ABS #LNL+1
L#REP ABS #REP+1
C#MXR ABS #MXR
* 
      BSS 0         SIZE OF DLGON.
* 
      END