          IDENT  MUJHELP
          TITLE  IIA$MUJHELP
          ENTRY  CIORD,CIOWR
          ENTRY  CONNCT,DISCON
          ENTRY  CALLMUJ,GETVEID
          ENTRY  PUT1QP,SAVEMSG
          ENTRY  SETUP,REQUEST
          ENTRY  SAVEMEM,DUMPEN
          ENTRY  CLFIELD
          EXT    ZSMRENT,ZSMRRET
*COPYC    DSA$CYBIL_IF_MACROS
          SPACE  3
*         THE COMPASS CODE CONTAINS CYBIL-CALLABLE PROCEDURES TO SUP=
*         PORT NOS/BE-PASSON. AS REQUIRED BY CYBIL THE PARAMETERS OR
*         POINTERS TO THEM ARE IN X-REGISTERS. NO PROGRAM HAS MORE THAN
*         FOUR PARAMETERS, SO REGISTERS X5 AND B5 ARE FREE FOR USE BY
*         THE PROCEDURES. ALL PROCEDURES HAVE TO CALL THE PROLOG BEFORE
*         THEY START THEIR PROCESSING,THE RETURN ADDRESS IS SAVED IN RE=
*         REGISTER B5. EXIT IS ALWAYS MADE THROUGH EPILOG. THE REGISTER
*         B1 IS SET TO 1 BY CYBIL.
          SPACE  3
***       CLEAR A FIELD
*
*--       A FIELD OF GIVEN LENGTH IS CLEAREWD TO ZERO, FWA AND
*         LENGTH ARE PARAMETERS SUPPLIED BY THE CALLER. IF THE
*         LENGTH IS ZERO OR NEGATIVE NOTHING IS DONE.
*
*--       PARAMETERS:
*
*         1. FWA OF THE FIELD
*         2. LENGTH OF THE FIELD
*
 CLFIELD  RJ     ZSMRENT     CALL PROLOG
          NG     X2,ZSMRRET  EXIT IF LENGTH .LT. 0
          ZR     X2,ZSMRRET  EXIT IF LENGTH .EQ. 0
          MX7    0
          SA7    X1          CLEAR THE FIRST WORD OF THE FIELD
          SB5    X2
          SB5    B5-B1       CHECK ONE WORD, EXIT IF SO
          ZR     B5,ZSMRRET
 +        SA7    A7+B1       CLEAR NEXT WORD
          SB5    B5-B1       STEP COUNTER
          NZ     B5,*        LOOP
          EQ     ZSMRRET
          SPACE  3
***       STOP THE PROGRAM
*
*--       THIS PROGRAM ABORTS PASSON BY CREATING A MODE 0 ERROR
*         THE SYSTEM CAN THEN DUMP THE FIELDLENGTH. TWO NUMBERS
*         MAY BE SUPPLIED BY THE CALLER TO IDENTIFY THE DUMP, THEY
*         ARE SAVED IN LOCATION 20B AND 21B.
*
*--       PARAMETERS:
*
*         1. FIRST IDENTIFIER
*         2. SECOND IDENTIFIER
*
 DUMPEN   RJ     ZSMRENT     CALL PROLOG
 DUMP1    BX6    X1
          BX7    X2
          SA6    20B         SAVE CHARACTERISTICS
          SA7    21B
          EQ     *+400000B
          SPACE  3
***       GET NOS/VE USER-ID
*
*--       THE PASSWORD FILE IS ATTACHED USING PP-PROGRAMS IPP, FSN AND
*         PFA; IF THE PASSWORD FILE IS BUSY HOWEVER, WE SET THE ERROR-
*         FLAG TO -1 AND EXIT.
*         IF NOT BUSY THE FIRST TWO RECORDS ARE SKIPPED. THE THIRD RE=
*         CORD CONTAINS THE RESTRICTED PASSWORD FILE ENTRIES, EACH ENTRY
*         CONSISTS OF FIVE CM-WORDS. THE THIRD BYTE OF THE THIRD WORD
*         CONTAINS THE USER-ID, WHICH IS ALSO GIVEN AS SECOND PARAMETER
*         TO THIS PROCEDURE. THE RECORD IS SEARCHED FOR THE USER-ID, IF
*         FOUND THE NOS/VE USERNAME IS EXTRACTED FROM THE FOURTH WORD OF
*         THE ENTRY AND PUT INTO THE LOCATION, TO WHICH THE FIRST PARA=
*         METER POINTS; THE ERRORFLAG IS SET TO ZERO.
*         IF THE USER-ID IS NOT FOUND IN THE THIRD RECORD THEN THE 4TH
*         ONE IS SERACHED. IT CONTAINS THE UNRESTRICTED PASSWORDS AND
*         THE ENTRIES CONSIST OF FOUR CM-WORDS. AGAIN THE THIRD BYTE OF
*         THE THIRD WORD CONTAINS THE USER-ID FOR WHICH THE RECORD IS
*         SEARCHED. THE FOURTH WORD CONTAINS THE NOS/VE USERNAME. IF THE
*         ID IS FOUND, THE NOS/VE-ID IS EXTRACTED AND SAVED; THE ERROR
*         FLAG IS CLEARED.
*         IF THE USER-ID IS NOT FOUND OR THE NOS/VE USER-NAME IS ZERO,
*         THEN THE ERROR FLAG IS SET TO 1.
*         THIS ROUTINE ALSO GIVES INSTALLATIONS A HOOK TO CHANGE THE
*         FAMILY NAME THE THE USER LOGS IN TO ON NOS/VE.  TO LOGIN TO
*         A FAMILY OTHER THAN THE DEFAULT FAMILY, THE VALUE IN THE CELL
*         *FAMILY* (DEFINED AT THE END OF THIS DECK) MAY BE CHANGED TO
*         ANY VALUE (7 CHARACTER, BLANK FILLED) THE SITE MAY WANT.  THIS
*         FAMILY WILL APPLY TO ALL USERS.  IF A SITE WANTS TO HAVE A
*         FLEXIBLE FAMILY NAME, THEN THAT FAMILY MUST BE CALULATED AND
*         EITHER RETURNED IN X2 OR STORED IN THE CELL *FAMILY* AND
*         GETVEID WILL RETURN IT IN X2.
*
*--       PARAMETERS:
*
*         1. POINTER TO LOCATION FOR NOS/VE USER-NAME
*         2. POINTER TO LOCATION FOR NOS/VE FAMILY
*         3. THE INTERCOM USER-ID, RIGHT JUSTIFIED AND ZERO FILLED
*         4. POINTER TO THE ERROR-FLAG
*
 GETVEID  RJ     ZSMRENT     CALL PROLOG
          BX6    X4          COPY TO ERROR FLAG
          SA6    ERRADDR     SAVE ERROR FLAG ADDRESS
 GETVE1   SX6    3RIPP       FORM IPP CALL WORD
          SX5    B1
          SX4    FDB         FWA OF FDB
          LX6    2
          BX6    X5+X6
          LX6    40
          BX6    X6+X4
          MX7    0           CLEAR READY BIT OF FDB
          SA7    X4
          RJ     RAP         CALL IPP
          SA4    FSN         LOAD FSN CALL WORD
          MX0    48
          SA5    FDB         LOAD POINTER WORD
          AX5    12          EXTRACT POINTER
          BX7    -X0*X5
          SX0    X7+FDB+4    FORM ADDRESS OF OUR FDB
          BX6    X4+X0
          SA4    X0
          MX7    -1
          BX7    X7*X4       CLEAR READY BIT IN FDB
          SA7    X0
          RJ     RAP         CALL FSN
          SA5    PFA
          BX6    X5+X0       FORM PFA CALL WORD
          SA4    X0
          BX7    X7*X4       CLEAR READY BIT IN FDB
          SA7    X0
          RJ     RAP         CALL PFA TO ATTACH PASSWORD-FILE
          SA5    X0
          MX7    -9          EXTRACT RETURN CODE
          LX5    8-17
          BX7    -X7*X5      CHECK FOR FILE BUSY
          SX7    X7-37B
          NZ     X7,GETVE2   JUMP IF FILE NOT BUSY
          MX7    -1
          EQ     GETVE15     GO INDICATE FILE BUSY
*
 GETVE2   SA5    X0          GET NAME OF LOCAL FILE
          MX0    42
          BX6    X0*X5       PUT NAME INTO FET FOR PASSWORDFILE
          SA6    PET
          SX6    12B         SKIP FIRST RECORD
          RJ     GETCIO
          SX6    12B         SKIP SECOND RECORD
          RJ     GETCIO
          SB7    FDB         POINTER TO FIRST PACKAGE
*
 GETVE3   SX6    12B         GET NEXT DATA OF 3RD RECORD
          RJ     GETCIO
          SA4    PETI        GET POINTER IN
          SX7    X4-FDB
          ZR     X7,GETVE8   JUMP IF EOR, USER NOT IN 3RD RECORD
          SB5    X4
          MX7    48
 GETVE4   SA5    B7+2
          SB7    B7+5
          GT     B7,B5,GETVE41 IF END OF BUFFER
          AX5    24          EXTRACT USER ID
          BX5    -X7*X5
          BX4    X5-X3
          ZR     X4,GETVE7   JUMP IF USER FOUND
          EQ     GETVE4      TRY AGAIN

 GETVE41  SX4    B5-FDBE+1
          PL     X4,GETVE45  IF NOT EOR
          AX5    24          EXTRACT LAST USER ID IN 3RD RECORD
          BX5    -X7*X5
          BX4    X5-X3
          ZR     X4,GETVE7   JUMP IF USER FOUND
          EQ     GETVE8      TO PROCESS 4TH RECORD
 GETVE45  SA6    FDB
          SB7    B7-5
          EQ     B5,B7,GETVE6   JUMP IF NO REST
 GETVE5   SA5    B5-B1
          BX6    X5          MOVE REST TO TOP OF BUFFER
          SA6    A6-B1
          SB5    A5
          NE  B5,B7,GETVE5   LOOP FOR NEXT WORD OF REST
 GETVE6   SB7    A6
          EQ     GETVE3      GO READ NEXT DATA
*
 GETVE7   SA5    B7-2        GET WORD WITH VE-ID
          LX5    3
          BX6    X0*X5       EXTRACT VE-ID
          SA6    X1
          ZR     X6,GETVE10  JUMP IF VE-ID ZERO
          MX7    0
          EQ     GETVE12     GO CLEAR ERROR FLAG
*
 GETVE8   SX6    12B         GET NEXT DATA OF 4TH RECORD
          RJ     GETCIO
          SA4    PETI        GET POINTER IN
          SX7    X4-FDB
          ZR     X7,GETVE10  JUMP ON EOR, USER-ID NOT FOUND
          SB5    X4
          SB7    FDB         SET POINTERS
          MX4    48
*
 GETVE9   SA5    B7+2        GET WORD WITH USER-ID
          LX5    -24
          BX7    -X4*X5      EXTRACT USER-ID
          BX7    X7-X3
          ZR     X7,GETVE11  JUMP IF USER FOUND
          SB7    B7+4
          LT  B7,B5,GETVE9   LOOP FOR NEXT PACKAGE
          SX7    B5-FDBE+1
          ZR     X7,GETVE8   GO READ NEXT DATA BLOCK
 GETVE10  SX7    B1
          EQ     GETVE14     GO INDICATE ERROR
*
 GETVE11  MX0    18          EXTRACT LOWER 3 CHARACTERS
          BX7    X0*X5
          LX7    -24
          LX5    24          REPOSITION VE-ID
          MX4    24
          BX6    X4*X5       UPPER MOST 4 CHARACTERS
          BX6    X7+X6
          SA6    X1          SAVE VE-ID
          SX7    B1
          ZR     X6,GETVE14  JUMP IF VE-ID ZERO
 GETVE12  SA5    SPACS
          MX0    42          LOAD MASKS AND SPACES
          MX7    54
          BX6    X0*X6       CLEAR TRAILING CHARACTERS
          LX7    -6
 GETVE13  BX4    X7*X6       CHECK END OF STRING
          AX7    6
          NZ     X4,GETVE13  LOOP
          LX7    6
          BX5    X7*X5       EXTRACT AND INSERT SPACES
          BX6    X6+X5
          BX6    X0*X6       CLEAR LAST 18 BIT
          MX7    0
          SA6    X1          SAVE NAME IN MEMORY
          SA5    FAMILY      GET DEFAULT FAMILY NAME
          BX6    X5
          SA6    X2          RETURN FAMILY NAME
*
 GETVE14  SX6    174B        RETURN PASSWORD FILE
          RJ     GETCIO
 GETVE15  SA4    ERRADDR     GET ERROR ADDRESS
          SA7    X4          SET ERROR FLAG
          SX6    3RIPP
          LX6    42
          RJ     RAP         CALL IPP TO CLEAR NO SWAP CONDITIONS
*
*         ERASE AND MARK PASSWORD BUFFER PLUS EXTENSION
*
          MX6    30          MARK TO EASE DUMP ANALYSIS
          SB7    FDBL+4      NUMBER OF WORDS TO MARK
          LX6    15          15/77777B,30/0,15/77777B
 GETVE16  SA6    FDB-4+B7    MARK THE BUFFER
          SB7    B7-B1       DECREMENT THE INDEX
          GE     B7,B0,GETVE16  LOOP UNTIL ALL WORDS HAVE BEEN MARKED
          EQ     ZSMRRET     RETURN TO CALLER
*
 GETCIO   DATA   0
          SA5    PET         GET FIRST WORD OF PET
          BX5    X0*X5
          BX6    X6+X5       INSERT CODE
          SA6    A5
          SX6    FDB         SET POINTERS IN AND OUT
          SA6    PETI
          SA6    A6+B1
          SA5    CIOCLL      GET CIO CALL WORD
          BX6    X5
          RJ     RAP         CALL CIO
          SA5    PET         LOAD CODE AND STATUS
          BX5    -X0*X5
          EQ     GETCIO      EXIT
          SPACE  3
***       CALL PP-PROGRAM MUJ
*
*--       PP-PROGRAM "MUJ" IS CALLED TO CONNECT OR DISCONNECT THE PP-
*         PROGRAM "1QP" TO VEIAF. IF THE PARAMETER IS POSITIVE, THEN
*         A CONNECT IS REQUESTED, OTHERWISE, A DISCONNECT IS WANTED.
*         IN THE LATTER CASE "MUJ" IS CALLED WITH A ZERO PARAMETER.
*
*--       PARAMETERS:
*         1. FWA OF TERMIN/TERMOUT AREA
*
 CALLMUJ  RJ     ZSMRENT     CALL PROLOG
 CALL1    SA2    X1          CHECK ZERO-PARM, JUMP IF NOT
          PL     X2,CALL2
          MX1    0           CLEAR PARAMETER ADDRESS
 CALL2    SX6    3RMUJ
          LX6    42          FORM MUJ CALL WORD
          BX6    X6+X1
          RJ     RAP         CALL MUJ
          EQ     ZSMRRET
          SPACE  3
***       READ WITH CIO
*
*--       CIO IS CALLED TO READ ONE LINE FROM THE TYERMINAL; A 6-WORD
*         FET MUST BE USED. THE SIXTH WORD IS SET UP BY THE CALLING
*         PROGRAM, THE SECOND PARAMETER IS A POINTER TO THAT WORD. THE
*         FIRST PARAMETER POINTS TO THE HEADERWORD OF THE INPUT BLOCK,
*         DATA STARTS AT THE FOLLOWING WORD. A FET IS SET UP WITH CODE
*         12B AND IN=OUT=HDR+1; THEN CIO IS CALLED WITH AUTORECALL. THE
*         NUMBER OF CM-WORDS READ IS CALCULATED AND SENT TO THE CALLER;
*         THE ERROR CODE IS EXTRACTED AND ALSO SENT.
*
*--       PARAMETERS:
*         1. POINTER TO HEADER WORD
*         2. POINTER TO 6TH WORD OF FET
*         3. POINTER TO LOCATION FOR LENGTH
*         4. POINTER TO LOCATION FOR ERROR CODE
*
 CIORD    RJ     ZSMRENT     CALL PROLOG
 CRD1     SA5    HDR         GET FILENAME AND READ-CODE
          SA2    X2          GET INTERCOM WORD
          SX1    X1+B1       GET FWA OF DATA BLOCK
          BX6    X5
          BX7    X2
          SA6    FET         SET FILENAME AND CODE OF FET
          SA7    FET+5       SET INTERCOM WORD
          SX0    A6
          SA5    A6-B1       GET WORD FIRST
          SX7    X1+408
          BX6    X5+X1
          SA7    A7-B1       SET LIMIT
          SA6    A6+B1       SET FIRST
          SX6    X1
          SA6    A6+B1       SET IN
          SA6    A6+B1       SET OUT
          SX7    4*3RCIO+1
          LX7    40          FORM CIO COMMAND
          BX6    X7+X0
          RJ     RAP         CALL CIO
          SA2    FET+2
          SA5    A2+B1       LOAD POINTERS IN AND OUT
          IX6    X2-X5
          SA6    X3          SAVE NUMBER OF WORDS READ
          EQ     CWR2
          SPACE  3
***       WRITE WITH CIO
*
*--       CIO IS CALLED TO SEND THE CONTENTS OF THE MESSAGE BUFFER TO THE
*         TERMINAL; A SIX WORD FET MUST BE USED. THE SIXTH WORD IS SET UP
*         THE CALLER, THE 2ND PARAMETER IS A POINTER TO THAT WORD. THE
*         FIRST PARAMETER IS THE FWA OF THE INPUT BUFFER, THE FIRST WORD
*         OF WHICH CONTAINS THE MESSAGE HEADER; DATA STARTS WITH THE FOL=
*         LOWING WORD. A FET IS SET UP WITH CODE 26B, POINTERS FIRST AND
*         OUT ARE THE ADDRESS OF THE HEADER, THE VALUE OF POINTER IN IS
*         CALCULATED FROM FIRST AND LENGTH, WHICH IS THE THIRD PARAMETER.
*         CIO IS CALLED WITH AUTO RECALL; AN EVENTUAL ERROR CODE IS SENT
*         TO A WORD TO WHICH THE FOURTH PARAMETER POINTS. IF NO ERROR,
*         THIS LOCATION IS CLEARED.
*
*--       PARAMETERS:
*         1. POINTER TO HEADER WORD
*         2. POINTER TO 6TH WORD OF FET
*         3. LENGTH OF DATA IN CM-WORDS
*         4. POINTER TO LOCATION FOR ERROR CODE
*
 CIOWR    RJ     ZSMRENT     CALL PROLOG
 CWR1     SA5    HDR+1       GET FILENAME AND WRITE-CODE
          SA2    X2          GET INTERCOM WORD
          SX1    X1+B1       GET FWA OF DATA BLOCK
          BX6    X5
          BX7    X2
          SA6    FET         SET FILENAME AND CODE OF FET
          SA7    FET+5       SET INTERCOM WORD
          SX0    A6
          SA5    A6-B1       GET WORD FIRST
          SX7    X1+412
          BX6    X5+X1
          SA7    A7-B1       SET LIMIT
          SA6    A6+B1       SET FIRST
          SX6    X1
          IX7    X1+X3
          SA7    A6+B1       SET IN
          SA6    A7+B1       SET OUT
          SX7    4*3RCIO+1
          LX7    40          FORM CIO COMMAND
          BX6    X7+X0
          RJ     RAP         CALL CIO
 CWR2     SA1    FET         LOAD HEADER
          MX0    -5
          SX5    X1
          AX1    9           EXTRACT ERROR CODE
          BX7    -X0*X1
          SA7    X4          SAVE ERROR CODE
          EQ     ZSMRRET     RETURN
          SPACE  3
***       CONNECT FILE ZZZZZSG
*
*--       THE FILE ZZZZZSG IS CONNECTED TO THE TERMINAL BY CALLING THE
*         PP-PROGRAM "CON". IF ANY ERROR IS REPORTED THE PROGRAM IS
*         ABORTED.
*
*--       PARAMETERS: NO PARAMETERS
*
 CONNCT   RJ     ZSMRENT     CALL PROLOGS
 CON1     SA5    CON         LOAD FILE NAME
          MX7    0
 CON2     SX6    4*3RCON+1   CON COMMAND WITH AUTO-RECALL
          LX6    22
          BX6    X7+X6       INSERT CONNECT/DISCONNECT BIT
          LX6    18
          BX7    X5
          SA7    A5+B1       SET FILE NAME FOR CONNECT
          SX5    A7
          BX6    X6+X5
          RJ     RAP         CALL CON
          SA5    A7
          SX0    B1          CHECK FOR ERRORS
          LX0    1
          BX5    X0*X5
          BX7    -X7*X7
          ZR     X5,CON3     JUMP IF NO ERROR
          SX6    3RABT
          LX6    42          FORM ABT COMMAND
          RJ     RAP         CALL ABT
          EQ     *+400000B

 CON3     SA7    X1          INDICATE ERROR STATE
          EQ     ZSMRRET
          SPACE  3
***       DISCONNECT FILE ZZZZZSG
*
*--       THE FILE ZZZZZSG IS DISCONNECTED FROM THE TERMINAL BY CALLING
*         THE PP-PROGRAM "CON". IF ANY ERROR IS REPORTED THE PROGRAM IS
*         ABORTED.
*
*--       PARAMETERS: NO PARAMETERS
*
 DISCON   RJ     ZSMRENT     CALL PROLOG
 DIS1     SA5    CON         LOAD FILE NAME
          SX7    B1
          LX7    8           POSITION DISCONNECT BIT
          EQ     CON2        GO DISCONNECT
          SPACE  3
***       SEND 1QP-REQUEST TO TERMOUT
*
*--       A TERMOUT REQUEST IS FORMED FROM THE PARAMETERS 2 TO 4
*         THIS REQUEST IS PUT INTO TABLE TERMOUT, PARAMETER 1 IS
*         A POINTER TO THE RELATED LOCATION
*
*--       PARAMETERS:
*
*         1. POINTER TO TERMOUT-ENTRY
*         2. POINTER TO CONNECTION-CURRENCY
*         3. USER-ID
*         4. REQUEST
*
 PUT1QP   RJ     ZSMRENT     CALL PROLOG
 PUT1     SX6    X4-10       CHECK TERM-CHAR, JUMP IF SO
          PL     X6,PUT2
          MX2    0           CLEAR ADDRESS
 PUT2     LX2    12
          LX3    -12         POSITION USER-ID
          BX6    X2+X4
          BX6    X6+X3       FORM 1QP-REQUEST
          SA6    X1
          EQ     ZSMRRET     PLACE REQUEST AND EXIT
          SPACE  3
***       SAVE THE MESSAGES
*
*--       THE ROUTINE DUMPS DATA AND SUPERVISORY MESSAGES OF PASSON TO A
*         FILE ZZZDMP0. EACH MESSAGE IS PRECEDED BY A HEADER CONTAINING
*         LENGTH AND TYPE OF THE MESSAGE, LENGTH AND TYPE ARE PARAMETERS
*         OF THE PROCEDURE. IF THE LENGTH IS NEGATIVE THE DUMPFILE IS
*         CLOSED BY DUMPING THE BUFFER WITH EOR AND THEN IT IS MADE PER=
*         MANENT.
*
*--       PARAMETERS:
*
*         1. POINTER TO FWA OF MESSAGE
*         2. LENGTH OF MESSAGE IN CM-WORDS
*         3. TYPE OF MESSAGE
*
 SAVEMSG  RJ     ZSMRENT     CALL PROLOG
 SAVE1    PL     X2,SAVE2    JUMP IF NOT CLOSE
          SA3    SFET
          SX6    26B
          RJ     MSDMP       DUMP ALL CONTENTS OF BUFFER
          SA3    SFET
          SX1    1R0
          RJ     PERM        MAKE FILE PERMANENT AND EXIT
          EQ     ZSMRRET
*
 SAVE2    SA4    SIN         LOAD POINTERS IN AND OUT
          SA5    A4+2
          LX3    18          COMBINE TYPE AND LENGTH
          BX7    X3+X2
          SA7    X4          SAVE TYPE AND LENGTH
          SX5    X5-1
          SX4    X4+B1
          IX6    X5-X4       ADVANCE POINTER IN AND CHECK
          NZ     X6,SAVE3
          BX7    X4
          SA7    SIN         PUT POINTER IN INTO FET
          SA3    SFET
          SX6    16B
          RJ     MSDMP       DUMP FULL BUFFER
          SX2    X2
          ZR     X2,ZSMRRET  EXIT IF NO DATA
 SAVE3    SA1    X1-1
          SX2    X2          INITIALIZE LOOP
          ZR     X2,SAVE6    JUMP IF NO DATA
*
 SAVE4    SA1    A1+B1       MOVE NEXT WORD OF DATA
          BX7    X1
          SA7    X4
          SX4    X4+B1       ADVANCE IN AND CHECK
          IX6    X5-X4
          NZ     X6,SAVE5    JUMP IF IN .NE. LIMIT
          BX7    X4
          SA7    SIN         PUT POINTER IN INTO FET
          SA3    SFET
          SX6    16B
          RJ     MSDMP       DUMP FULL BUFFER
 SAVE5    SX2    X2-1
          NZ     X2,SAVE4    LOOP IF NOT ALL MOVED
 SAVE6    BX7    X4
          SA7    SIN         PUT POINTER IN INTO FET
          EQ     ZSMRRET
          SPACE  3
***       ISSUE A CIO-REQUEST FOR OUTPUT
*
*--       A CIO-REQUEST IS FORMATTED AND PUT INTO RA+1, THE RELATED
*         FET MUST BE SETUP BY THE CALLER. AFTER RETURN THE POINTERS
*         OF THE FET ARE RESET.
*
*--       ENTRY CONDITION, REGISTER CONTENTS
*
*         REGISTER X3: NAME OF FILE, RIGHTJUSTIFIED
*         REGISTER X6: CODE FOR CIO, LEFTJUSTIFIED AND ZERO FILLED
*         REGISTER A3: ADDRESS OF FET HEADER
*         REGISTER B1: CONSTAT 1
*
 MSDMP    DATA   0
          MX7    42          PUT NEW CODE INTO HEADERWORD
          BX7    X7*X3
          BX7    X7+X6
          SX6    4*3RCIO+1   FORM CIO COMMAND
          SX3    A3
          LX6    40
          SA7    A3          RESET HEADERWORD
          BX6    X3+X6
          RJ     RAP         CALL CIO
          SA4    A3+1
          SX4    X4          LOAD POINTERS FIRST AND LIMIT
          SA5    A4+3
          SX5    X5-1
          BX7    X4          RESET POINTERS IN AND OUT IN FET
          SA7    A4+B1
          SA7    A7+B1
          EQ     MSDMP       EXIT
          SPACE  3
***       GET ANALYST AND PERM-FILE ID
*
*--       THE PROCEDURE FETCHES THE USER-ID OF THE ANALYST FROM LOCATION
*         RA+2 IF PASSON WAS CALLED BY A PROCEDURE; THE LOWER 18 BIT OF
*         WORD 64B CONTAIN THE NUMBER OF PARAMETERS. IF MORE THAN ONE PA=
*         RAMETER IS SUPPLYED, THEN THE PERMFILE-ID IS ALSO FETCHED FROM
*         WORD RA+3 OR FROM WORDS RA+3 AND RA+4. AS HELP FOR DEBUGGING THE
*         FWA'S OF SOME TABLES ARE SAVED IN LOW CORE.
*
*--       PARAMETERS:
*
*         1. POINTER TO USER-ID OF ANALYST
*         2. INDICATOR FOR RESULT
*         3. POINTER TO MESSAGE BUFFER "MSG"
*         4. POINTER TO TABLE "CONNECTION_CURRENCY"
*         5. POINTER TO 1QP-TABLES TERMIN/TERMOUT
*
 SETUP    RJ     ZSMRENT     CALL PROLOG
          BX7    X3
          BX6    X4          SAVE THE ADDRESSES
          SA7    30B
          SA6    A7+B1
          BX7    X5
          SA7    A6+B1
          SA5    64B
          SB5    X5          GET NUMBER OF PARAMETERS
          NZ     B5,SETUP1   JUMP IF NOT ZERO
          MX7    0
          SA7    X2          SIGNAL NO DUMP AND EXIT
          EQ     ZSMRRET
*
 SETUP1   SA3    B1+B1       GET ANALYST ID AND SPACES
          SA5    SPACS
          MX0    42          CLEAR DELIMITER OF PARAMETER
          BX3    X0*X3
          LX0    -6
*
 SETUP2   BX6    X0*X3       CHECK TRAILING CHARACTERS FOR ZERO
          AX0    6
          NZ     X6,SETUP2   LOOP IF NOT
          LX0    6
          BX5    X0*X5       EXTRACT SPACES
          BX6    X5+X3
          SA6    X1          SAVE NAME WITH TRAILING BLANKS
          SB5    B5-B1
          ZR     B5,SETUP5   JUMP IF NO PERM-FILE ID
          SA3    A3+B1
          MX6    42          EXTRACT UPPER 7 CHARACTERS
          BX6    X6*X3
          SB5    B5-B1
          ZR     B5,SETUP3   JUMP IF NOT MORE CHARACTERS
          SA3    A3+B1
          MX0    12          GET NEXT CHARACTERS
          BX3    X0*X3
          LX3    -18
 SETUP3   BX6    X6+X3       COMBINE CHARACTERSTRINGS
          ZR     X6,SETUP5
          MX3    6
          LX3    -12
 SETUP4   BX7    X3*X6       REMOVE TRAILING ZEROES
          LX6    -6
          ZR     X7,SETUP4
          LX6    6           REPOSITION
          SX7    14B
          BX6    X6+X7       INSERT KEY FOR USER ID AND SAVE
          SA6    FDBD+1
 SETUP5   SX7    B1          INDICATE NAMES PRESENT
          SA7    X2
          EQ     ZSMRRET     EXIT
          SPACE  3
***       REQUEST PERMANENT FILE
*
*--       FOR THE FILE WITH NAME ZZZDMPN A PERMFILE DEVICE IS REQUESTED
*         USING PP-PROGRAM "REQ". THE LAST CHARACTER OF THE FILE NAME IS
*         ONE OF THE DIGITS 0 TO 9.
*
*--       PARAMETERS: ONLY ONE, THE DIGIT N
*
 REQUEST  RJ     ZSMRENT     CALL PROLOG
          SA5    REQPRM      GET NAME OF FILE
          MX6    36
          BX6    X6*X5       CLEAR STATUS
          LX1    18
          BX6    X6+X1       INSERT LOWER CHARACTER
          SA6    A5
          SX7    B1          SET UP 2ND WORD
          LX7    31
          SA7    A5+B1
          SX6    3RREQ       FORM REQ-CALL
          SX7    B1
          LX6    2           INSERT RECALL BIT
          BX6    X7+X6
          SX5    A5
          LX6    40          INSERT PARAMETER ADDRESS
          BX6    X6+X5
          RJ     RAP         CALL REQ
          EQ     ZSMRRET     EXIT
          SPACE  3
***       DUMP VARIABLES FOR DEBUGGING
*
*--       THE PROCEDURE IS CALLED BY THE SYSTEM ANALYST TO DUMP THE ME=
*         MORY OF PASSON TO A FILE "ZZZDMPN", WHERE N IS A DIGIT 1 TO 9.
*         THIS FILE IS THEN MADE PERMANENT.
*
*--       PARAMETERS:
*
*         1. FILE NUMBER N = 1,2 ... 9
*         2. POINTER TO MESSAGE BUFFER "MSG"
*         3. POINTER TO TABLE "CONNECTION_CURRENCY"
*         4. POINTER TO 1QP-TABLES TERMIN/TERMOUT
*
 SAVEMEM  RJ     ZSMRENT     CALL PROLOG
          BX7    X2
          BX6    X3          SAVE THE ADDRESSES
          SA7    30B
          SA6    A7+B1
          BX7    X4
          SA7    A6+B1
          MX7    0
          SA7    MEMREQ      CLEAR REQUESTWORD FOR MEM
          SX7    3RMEM
          LX7    2           FORM MEM COMMAND
          SX6    B1
          BX7    X7+X6       INSERT RECALL FLAG
          LX7    40
          SX6    A7          INSERT ADDRESS
          BX6    X7+X6
          RJ     RAP         CALL MEM
          SA3    MEMREQ
          LX3    30          GET FIELDLENGTH
          SX7    X3
          SA7    SDLIM       SET POINTER LIM OF FET
          MX6    0
          SX7    1000B
          SA6    A7-B1       SET POINTER OUT
          SA7    A6-B1       SET POINTER IN
          SA6    A7-B1       SET POINTER FIRST
          SA3    SDFET       GET HEADER OF FET
          MX6    36
          BX3    X6*X3       CLEAR LOWER 24 BIT
          LX1    18
          BX3    X3+X1       INSERT COUNTER
          SX6    16B
          RJ     MSDMP       DUMP LOWER MEMORY
          MX6    0
          SX7    1000B
          SA6    SDIN        SET POINTER IN
          SA7    A6+B1       SET POINTER OUT
          SA3    SDFET       GET HEADER OF FET
          SX6    26B
          RJ     MSDMP       DUMP REST OF MEMORY
          LX1    -18
          SA3    SDFET
          RJ     PERM        CATALOG FILE
          EQ     ZSMRRET     EXIT
          SPACE  3
***       MAKE A FILE PERMANENT
*
*--       A FILE WITH NAME ZZZDMPN, WHERE N IS A DIGIT 0 TO 9, IS MADE
*         PERMANENT BY USE OF PP-PROGRAM "PFC". AFTER THAT THE FILE IS
*         RETURNED. THE FILE MUST RESIDE ON A PERMFILE DEVICE, PROCEDURE
*         "PERM" MUST HAVE BEEN CALLED FOR THIS FILE. ANY REPORTED ER=
*         RORS ARE IGNORED.
*
*--       ENTRY CONDITIONS, REGISTER CONTENTS
*
*         REGISTER X1: NUMBER N AS DISPLAY CHARACTER, RIGHTJUSTIFIED
*                      AND ZERO FILLED
*         REGISTER X3: FILE NAME, LEFTJUSTIFIED
*         REGISTER A3: ADDRESS OF FET HEADER
*         REGISTER B1: CONSTANT 1
*
 PERM     DATA   0
          SA5    FDBD        GET NAME OF LOGICAL FILE
          MX6    36
          LX1    18
          BX6    X6*X5       CLEAR LAST CHARACTER AND STATUS
          BX6    X6+X1
          SA6    A5-4        INSERT NAME INTO FDB
          SA6    A5
          SX7    3RPFC       FORM PFC CALL
          SX6    B1
          LX7    2           INSERT RECALL BIT
          BX7    X7+X6
          LX7    40
          SX6    A5          INSERT FDB-ADDRESS
          BX6    X7+X6
          RJ     RAP         CALL PFC
          SX6    170B
          RJ     MSDMP       RETURN FILE
          EQ     PERM
          SPACE  3
***       PROCESS AN RA + 1 REQUEST
*
*--       PLACE A REQUEST IN RA+1 AND EXCHANGE TO CENTRAL MONITOR.
*
*--       PARAMETERS
*
*         X6 CONTAINS THE RA + 1 REQUEST WITH THE AUTORECALL BIT SET.
*
 RAP      DATA   0           ENTRY
 RAP1     SA5    B1          WAIT RA+1 CLEAR
          NZ     X5,RAP1
          SA6    B1
          XJ                 EXCHANGE TO CP MTR
          EQ     RAP
          SPACE  3
***       CONSTANTS AND WS
*
 MEMREQ   VFD    60/0
          VFD    42/7LZZZDMP0,18/0
          VFD    60/0,60/0,60/0
 FDBD     VFD    42/7HZZZDMP0,18/0
          VFD    54/9HPASSONDMP,6/14B
          VFD    60/0
 REQPRM   VFD    42/7HZZZDMP0,18/0
          VFD    30/2,30/0
 SPACS    VFD    42/7H       ,18/0
 CIOCLL   VFD    18/3RCIO,2/1,22/0,18/PET
 FSN      VFD    18/3RFSN,2/1,16/1,6/0,18/0
 PFA      VFD    18/3RPFA,2/1,22/0,18/0
 CON      VFD    42/7HZZZZZSG,18/0,60/0
 HDR      VFD    42/7HZZZZZSG,18/12B
          VFD    42/7HZZZZZSG,18/26B
          VFD    18/1,24/1,18/0
 FET      VFD    60/0,60/0,60/0,60/0,60/0,60/0
 PET      VFD    42/7HZZZZZII,18/0
          VFD    42/0,18/FDB
 PETI     VFD    42/0,18/FDB
 PETO     VFD    42/0,18/FDB
          VFD    42/0,18/FDBE
 SFET     VFD    42/7HZZZDMP0,18/1
          VFD    42/0,18/SBUF
 SIN      VFD    42/0,18/SBUF
          VFD    42/0,18/SBUF
          VFD    42/0,18/SBUFE
 SDFET    VFD    42/7HZZZDMP0,18/1
          VFD    42/0,18/0
 SDIN     VFD    42/0,18/0
          VFD    42/0,18/0
 SDLIM    VFD    42/0,18/0
*
 FDBL     EQU    129         LENGTH OF THE FDB BUFFER
          BSSZ   4
 FDB      BSSZ   FDBL        BUFFER FOR CIO AND PFA
 FDBE     EQU    *
 BUFLNG   EQU    8*64+1      LENGTH OF BUFFER FOR DUMP
          BSSZ   1
 SBUF     BSSZ   BUFLNG      BUFFER TO DUMP DEBUG DATA
 SBUFE    BSSZ   1

 ERRADDR  BSSZ   1           SAVE AREA FOR RETURN ADDRESS FOR GETVEID
 FAMILY   VFD    42/0,18/0   DEFAULT FAMILY TO BE USED BY GETVEID
*                            TO CHANGE THE DEFAULT FAMILY, CHANGE THE
*                            FAMILY VARIABLE SUCH THAT THE NEW FAMILY
*                            IS A LEFT JUSTIFIED BLANK FILLED 7 CHAR
*                            FIELD E.G. FAMILY   VFD  42/7LXXX    ,18/0
*
          END
