LDISTAP 
          IDENT  LDISTAP,110B 
          ABS 
          SST    CP,CSTM
          SYSCOM B1 
          ENTRY  LDISTAP
          ENTRY  TMSDIS 
          ENTRY  TMSOFF 
          ENTRY  TMSON
          ENTRY  RFL= 
          ENTRY  SSJ= 
*COMMENT  LDISTAP - TAPE MANAGEMENT UTILITY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  LDISTAP - TAPE MANAGEMENT UTILITY. 
 LDISTAP  SPACE  4,10 
***       LDISTAP - TAPE MANAGEMENT UTILITY.
* 
*         J. D. HOLMBECK     85/02/28.
          SPACE  4,10 
***       *TMSDIS* DISPLAYS THE STATUS OF THE TMS CATALOGS.  IT CAN 
*         CALLED FROM SYSTEM ORIGIN AS AN *L* DISPLAY UTILITY OR FROM 
*         NON-SYSTEM ORIGIN JOBS BY VALIDATED USERS.
          SPACE  4,10 
***       TMSDIS - COMMAND FORMAT.
* 
*         THE FORMAT OF THE ORDER DEPENDENT *TMSDIS* COMMAND IS - 
* 
*                TMSDIS,IDIS,MODE,LFN1,LFN2,TIME,NOBELL.
* 
*         THE FORMAT OF THE ORDER INDEPENDENT *TMSDIS* COMMAND IS - 
* 
*                TMSDIS,ID=IDIS,OP=MODE,I=LFN1,L=LFN2,WT=TIME,NOBELL. 
* 
*         WHERE - 
* 
*         IDIS   INITIAL DISPLAY.  VALID VALUES FOR *IDIS* ARE *HELP* 
*                OR *FAM*.  DEFAULT IS *HELP*.
* 
*         MODE   INPUT/OUTPUT OPTION.  VALID VALUES FOR *MODE* ARE -
* 
*                   L      - L-DISPLAY.  VALID ONLY FROM SYSTEM 
*                            ORIGIN.
* 
*                   LINE   - READ COMMANDS FROM INPUT FILE AND WRITE
*                            DISPLAYS TO OUTPUT FILE. 
* 
*                   SCREEN - READ COMMANDS FROM TERMINAL INPUT FILE AND 
*                            WRITE DISPLAYS TO TERMINAL OUTPUT FILE.
*                            DISPLAYS ARE REFRESHED WHILE WAITING FOR 
*                            INPUT.  INPUT CAN BE ENTERED AFTER 
*                            ENTERING USER BREAK ONE (THE *BREAK* KEY). 
*                            VALID ONLY FROM INTERACTIVE ORIGIN.
* 
*                DEFAULT IS *L* FOR SYSTEM ORIGIN AND *LINE* FOR
*                NON-SYSTEM ORIGIN. 
* 
*         LFN1   INPUT FILE NAME.  IGNORED FOR L-DISPLAY AND SCREEN 
*                MODES.  DEFAULT IS *INPUT*.
* 
*         LFN2   OUTPUT FILE NAME.  IGNORED FOR SCREEN MODE. DEFAULT IS 
*                *OUTPUT*.
* 
*         TIME   WAITING TIME IN SECONDS BEFORE A DISPLAY IS REFRESHED. 
*                IGNORED FOR LINE MODE.  A VALUE GREATER THAN 4095 IS 
*                CONVERTED TO 4095.  DEFAULT IS 2 FOR L-DISPLAY MODE
*                AND 10 FOR SCREEN MODE.
* 
*         NOBELL IGNORED FOR LINE AND L-DISPLAY MODES.  IF *NOBELL* IS
*                NOT SPECIFIED, A BELL WILL SOUND AT THE TERMINAL WHEN
*                THE SCREEN IS REFRESHED AND WHEN THERE ARE TAPE
*                CATALOGS WITH ERRORS OR NO SCRATCH VSN-S.
* 
*         TO USE *TMSDIS* FROM A NON-SYSTEM ORIGIN JOB, THE USER MUST 
*         BE VALIDATED TO USE THE TAPE FILE SUPERVISOR *TFSP*.
 DMESS    SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         FOLLOWING ARE THE DAYFILE MESSAGES THAT MAY BE ISSUED BY
*         TMSDIS -
* 
*         INCORRECT COMMAND.
*                A USER THAT IS NOT VALIDATED FOR *TFSP* ATTEMPTED TO 
*                USE *TMSDIS* FROM A NON-SYSTEM ORIGIN JOB. 
* 
*         INCORRECT VALUE FOR PP PARAMETER - VVVVVVV. 
*                THE VALUE *VVVVVVV* CANNOT BE USED FOR PARAMETER *PP*
*                ON THE *TMSDIS* COMMAND. 
* 
*         TMSDIS COMPLETE.
*                *TMSDIS* NORMAL TERMINATION. 
* 
*         L-DISPLAY NOT AVAILABLE.
*                *TMSDIS* CANNOT USE L-DISPLAY MODE AT THIS TIME
*                BECAUSE ANOTHER JOB HAS INTERLOCKED THE L-DISPLAY. 
* 
*         UNKNOWN PARAMETER - PP. 
*                THE PARAMETER *PP* CANNOT BE PROCESSED BY THE
*                *TMSDIS* COMMAND.
 DISPLAY  SPACE  4,13 
***       TMSDIS DISPLAYS.
* 
*         EACH *TMSDIS* DISPLAY INCLUDES A THREE LINE HEADER WITH *TMS* 
*         STATUS, DISPLAY NAME, PAGE NUMBER, THE NUMBER OF CATALOGS 
*         WITH ERRORS AND THE NUMBER OF CATALOGS WITH NO AVAILABLE
*         SCRATCH TAPES.
* 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* +                                                                   + 
* +  TMSDIS.                   TMS ENABLED.  FAM DISPLAY PAGE 1 OF 2. + 
* +  CATALOGS WITH ERRORS= 0.  CATALOGS WITH NO MT/NT SCRATCH= 2.     + 
* +  CATALOGS WITH NO CT SCRATCH= 2.  CATALOGS WITH NO AT SCRATCH= 2. + 
* +                                                                   + 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
 HELP     SPACE  4,10 
***       HELP DISPLAY. 
* 
*         THE HELP DISPLAY LISTS THE *TMSDIS* INPUT COMMANDS THAT CAN 
*         BE ENTERED.  THE HELP DISPLAY IS INITIATED BY THE *HELP*
*         COMMAND.  FOR EXAMPLE, PAGE 1 - 
* 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* +                                                                   + 
* +  HELP               DISPLAY VALID COMMANDS.                       + 
* +  FAM                DISPLAY *TMS* FAMILY TAPE CATALOG STATUSES.   + 
* +  COPY               COPY CURRENT DISPLAY TO OUTPUT FILE.          + 
* +  +                  TOGGLE PAGE FORWARD.                          + 
* +  +N                 TOGGLE *N* PAGES FORWARD.                     + 
* +  -                  TOGGLE PAGE BACKWARD.                         + 
* +  -N                 TOGGLE *N* PAGES BACKWARD.                    + 
* +  END                TERMINATE *TMSDIS*.                           + 
* +                                                                   + 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* 
*         FOR EXAMPLE, PAGE 2 - 
* 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* +                                                                   + 
* +  +                  TOGGLE PAGE FORWARD.                          + 
* +  -                  TOGGLE PAGE BACKWARD.                         + 
* +  END                TERMINATE *TMSDIS*.                           + 
* +                                                                   + 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
 FAM      SPACE  4,10 
***       FAMILY CATALOG DISPLAY. 
* 
*         THE FAMILY CATALOG DISPLAY LISTS THE STATUS OF THE *TMS* TAPE 
*         CATALOG FILE FOR EACH FAMILY ON THE SYSTEM.  THE FAMILY 
*         CATALOG DISPLAY IS INITIATED BY *FAM* COMMAND.  FOR EXAMPLE - 
* 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* +                                                                   + 
* +  FAMILY     MT/NT SCRATCH    CT SCRATCH      AT SCRATCH           + 
* +    STATUS   COUNT NXT-VSN   COUNT NXT-VSN   COUNT NXT-VSN         + 
* +                                                                   + 
* +  KCP          120 KCP055       20 CK0456       60 AK0459          + 
* +    CATALOG LINKAGE ERROR.                                         + 
* +  TFFAMLY        0 ------        0 ------        0 ------          + 
* +    NO SCRATCH TAPES.                                              + 
* +  KTJ           55 KTJ133        0 ------      231 AJ0319          + 
* +                                                                   + 
* +  FAMTWO *    2341 T03450       70 CF0021     1492 AF1221          + 
* +                                                                   + 
* +  NEWFAM         0 ------        0 ------        0 ------          + 
* +    CATALOG NOT FAST-ATTACHED.                                     + 
* +  PFFAMLY        0 ------        0 ------        0 ------          + 
* +    CATALOG NOT FOUND.                                             + 
* +                                                                   + 
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
* 
*         WHERE - 
* 
*         FAMILY - FAMILY NAME.  AN ASTERISK (*) WILL APPEAR AFTER THE
*                FAMILY NAME IF THE TAPE CATALOG IS BEING PROCESSED BY
*                *TMS* MEANING THAT THE INFORMATION DISPLAYED MAY NOT 
*                UP TO DATE.
* 
*         COUNT   - NUMBER OF SCRATCH VSNS OF THE SPECIFIED TAPE TYPE 
*                (MT/NT, CT OR AT) IN THE TAPE CATALOG.  THIS FIELD 
*                IS ZERO IF THE FAMILY DOES NOT HAVE A FAST-ATTACHED
*                TAPE CATALOG.
* 
*         NXT-VSN - THE NEXT SCRATCH VSN OF THE SPECIFIED TAPE TYPE 
*                (MT/NT, CT OR AT) IN THE TAPE CATALOG.  THIS FIELD IS
*                SIX HYPHENS (------) IF NO SCRATCH TAPES OF THE
*                SPECIFIED TYPE ARE IN THE TAPE CATALOG.  THIS FIELD
*                IS ALSO SIX HYPHENS IF THE FAMILY DOES NOT HAVE A
*                FAST-ATTACHED TAPE CATALOG.
* 
*         STATUS - STATUS MESSAGE FOR TAPE CATALOG.  THIS FIELD 
*                CONTAINS THE CONTENTS OF THE CATALOG MESSAGE BUFFER
*                IF THE TAPE CATALOG HAS AN ERROR CONDITION.  THIS
*                FIELD CONTAINS *NO SCRATCH VSNS* IF *COUNT* IS ZERO
*                FOR ALL TAPE TYPES.  THIS FIELD CONTAINS *CATALOG NOT
*                FAST-ATTACHED* IF THE TAPE CATALOG EXISTS BUT HAS NOT
*                BEEN FAST-ATTACHED.  THIS FIELD CONTAINS *CATALOG NOT
*                FOUND* IF THE TAPE CATALOG DOES NOT EXIST. 
* 
*         THE FAMILY CATALOGS ARE ORDERED IN THIS DISPLAY AS FOLLOWS -
* 
*                FAMILIES WITH CATALOG ERRORS 
*                FAMILIES WITH NO SCRATCH VSNS
*                FAMILIES WITH FAST-ATTACHED CATALOGS BUT NO ERRORS 
*                FAMILIES WITHOUT FAST-ATTACHED CATALOGS
*                FAMILIES WITHOUT CATALOGS
 COMMAND  SPACE  4,10 
***       *TMSDIS* INPUT COMMANDS.
* 
*         *TMSDIS* COMMANDS ARE ENTERED ONE COMMAND PER INPUT LINE. 
*         THE MAXIMUM NUMBER OF CHARACTERS PROCESSED FOR AN INPUT LINE
*         IS 77.  AN INPUT LINE CAN OPTIONALLY BE TERMINATED BY A 
*         PERIOD.  ANY CHARACTERS FOLLOWING THE PERIOD ARE IGNORED. IF
*         A PARAMETER REQUIRES SPECIAL CHARACTERS, THE PARAMETER CAN BE 
*         DOLLAR SIGN ($) DELIMITTED.  FOR EXAMPLE, SUPPOSE VSN A$BC+E
*         IS TO BE ASSIGNED TO THE TAPE ON EQUIPMENT 65 - 
* 
*                VSN,65,$A$$BC+E$.
* 
*         THE FOLLOWING ARE THE VALID *TMSDIS* INPUT COMMANDS - 
* 
*         HELP
*                INITIATES THE HELP DISPLAY.
* 
*         FAM 
*                INITIATES THE FAMILY TAPE CATALOG DISPLAY. 
* 
*         COPY
*                COPIES THE CURRENT DISPLAY TO THE OUTPUT FILE.  THIS 
*                COMMAND IS IGNORED FOR SCREEN MODE.
* 
*         +N
*                TOGGLE THE DISPLAY *N* PAGES FORWARD.  DEFAULT FOR *N* 
*                IS 1.
* 
*         -N
*                TOGGLE THE DISPLAY *N* PAGES BACKWARD.  DEFAULT FOR
*                *N* IS 1.
 CMESS    SPACE  4,10 
***       COMMAND STATUS MESSAGES.
* 
*         ONE OF THE FOLLOWING MESSAGES WILL APPEAR AT THE BOTTOM OF
*         THE DISPLAY PAGE.  THE IMAGE OF THE LAST INPUT COMMAND
*         ENTERED WILL APPEAR AFTER THE MESSAGE - 
* 
*         INCORRECT INCREMENT 
*                THE PAGE INCREMENT SPECIFIED WITH THE *+* OR *-* 
*                COMMAND WAS NOT A NUMBER.
* 
*         LAST COMMAND
*                INDICATES THE LAST COMMAND PROCESSED WITHOUT ERRORS. 
* 
*         PROCESSING
*                INDICATES THE CURRENT COMMAND BEING PROCESSED BY 
*                *TMSDIS*.
* 
*         TOO MANY PARAMETERS 
*                MORE PARAMETERS WERE SPECIFIED THAN THE COMMAND
*                ALLOWS.
* 
*         UNKNOWN COMMAND 
*                THE COMMAND SPECIFIED CANNOT BE PROCESSED BY 
*                *TMSDIS*.
 TMSON    SPACE  4,10 
***       *TMSON* CAN BE CALLED FROM SYSTEM ORIGIN JOBS TO TURN ON
*         *TMS* TAPE CATALOG FILES FOR FAMILIES ON THE SYSTEM.
 TMSON    SPACE  4,10 
***       TMSON - COMMAND FORMAT. 
* 
*         THE FORMAT OF THE *TMSON* COMMAND IS -
* 
*                TMSON,FM=FNAME,DEFTO=NOPT,DEFTOS=SOPT. 
* 
*         WHERE - 
* 
*         FNAME  FAMILY NAME OF *TMS* CATALOG TO TURN ON.  IF A 
*                SPECIFIC FAMILY NAME IS USED AND THE *TMS* CATALOG 
*                FOR THAT FAMILY CANNOT BE TURNED ON, *TMSON* WILL
*                ABORT.  IF AN ASTERISK (*) IS USED, *TMSON* WILL 
*                ATTEMPT TO TURN ON THE *TMS* CATALOGS ON ALL FAMILIES
*                OF THE SYSTEM.  AN INFORMATIVE MESSAGE WILL BE ISSUED
*                IF *TMSON* CANNOT TURN ON A *TMS* CATALOG FOR A
*                FAMILY.  IF THIS PARAMETER IS NOT SPECIFIED, *TMSON* 
*                WILL NOT TURN ON ANY *TMS* CATALOGS. 
* 
*         NOPT   IDENTIFIES THE DEFAULT TAPE OPTION (THE *TO* 
*                PARAMETER) FOR *LABEL* AND *REQUEST* COMMANDS FOR
*                NON-SYSTEM ORIGIN JOBS.  THIS PARAMETER CAN ONLY BE
*                SPECIFIED IF THE CALLING JOB IS RUNNING WITH THE 
*                SUBSYSTEM ID OF *MAGNET* (*MTSI*).  *NOPT* IS A STRING 
*                WITH ONE OR MORE OF THE FOLLOWING CHARACTERS - 
* 
*                    T     - SET THE DEFAULT TO *TO=T* (*TMS* 
*                            PROCESSING). 
* 
*                    F     - SET THE DEFAULT TO *TO=F* (NON-*TMS* 
*                            PROCESSING). 
* 
*                    C     - SET THE DEFAULT TO *TO=C* (CHECK FOR 
*                            CATALOG ERROR).
* 
*                    E     - SET THE DEFAULT TO *TO=E* (IGNORE CATALOG
*                            ERROR).
* 
*                IF THIS PARAMETER IS NOT SPECIFIED, *TMSON* WILL NOT 
*                CHANGE THE DEFAULT TAPE OPTION.  A USER CAN CHANGE THE 
*                DEFAULT TAPE OPTION FOR HIS OR HER JOB VIA THE 
*                *TMSDEF* COMMAND.
* 
*         SOPT   IDENTIFIES THE DEFAULT TAPE OPTION (THE *TO* 
*                PARAMETER) FOR *LABEL* AND *REQUEST* COMMANDS FOR
*                SYSTEM ORIGIN JOBS.  THIS PARAMETER CAN ONLY BE
*                SPECIFIED IF THE CALLING JOB IS RUNNING WITH THE 
*                SUBSYSTEM ID OF *MAGNET* (*MTSI*).  *NOPT* IS A STRING 
*                WITH ONE OR MORE OF THE FOLLOWING CHARACTERS - 
* 
*                    T     - SET THE DEFAULT TO *TO=T* (*TMS* 
*                            PROCESSING). 
* 
*                    F     - SET THE DEFAULT TO *TO=F* (NON-*TMS* 
*                            PROCESSING). 
* 
*                    C     - SET THE DEFAULT TO *TO=C* (CHECK FOR 
*                            CATALOG ERROR).
* 
*                    E     - SET THE DEFAULT TO *TO=E* (IGNORE CATALOG
*                            ERROR).
* 
*                IF THIS PARAMETER IS NOT SPECIFIED, *TMSON* WILL NOT 
*                CHANGE THE DEFAULT TAPE OPTION.  A USER CAN CHANGE THE 
*                DEFAULT TAPE OPTION FOR HIS OR HER JOB VIA THE 
*                *TMSDEF* COMMAND.
 TMSOFF   SPACE  4,10 
***       *TMSOFF* CAN BE CALLED FROM SYSTEM ORIGIN JOBS TO TURN OFF
*         *TMS* TAPE CATALOG FILES FOR FAMILIES ON THE SYSTEM.
 TMSOFF   SPACE  4,10 
***       TMSOFF - COMMAND FORMAT.
* 
*         THE FORMAT OF THE *TMSOFF* COMMAND IS - 
* 
*                TMSOFF,FM=FNAME. 
* 
*         WHERE - 
* 
*         FNAME  FAMILY NAME OF *TMS* CATALOG TO TURN OFF.  IF A
*                SPECIFIC FAMILY NAME IS USED AND THE *TMS* CATALOG 
*                FOR THAT FAMILY CANNOT BE TURNED OFF, *TMSOFF* WILL
*                ABORT.  IF AN ASTERISK (*) IS USED, *TMSOFF* WILL
*                ATTEMPT TO TURN OFF THE *TMS* CATALOGS ON ALL
*                FAMILIES OF THE SYSTEM.  AN INFORMATIVE MESSAGE WILL 
*                BE ISSUED IF *TMSOFF* CANNOT TURN OFF A *TMS* CATALOG
*                FOR A FAMILY.  IF THIS PARAMETER IS NOT SPECIFIED, 
*                *TMSOFF* WILL NOT TURN OFF ANY *TMS* CATALOGS. 
* 
*         *TMSOFF* REMOVES THE FAST-ATTACH STATUS OF A *TMS* CATALOG. 
*         *TMSON* WILL REINSTATE THE CATALOG AS FAST-ATTACHED.
 DMESS    SPACE  4,10 
***       *TMSON* AND *TMSOFF* DAYFILE MESSAGES.
* 
*         FOLLOWING ARE THE DAYFILE MESSAGES THAT MAY BE ISSUED BY
*         *TMSON* OR *TMSOFF* - 
* 
*         FAMILY NOT FOUND. 
*                THE SPECIFIED FAMILY IS NOT ACTIVE ON THE SYSTEM.
* 
*         INCORRECT COMMAND.
*                *TMSON* OR *TMSOFF* WAS CALLED BY A NON-SYSTEM ORIGIN
*                JOB. 
* 
*         INCORRECT VALUE FOR PP PARAMETER - VVVVVVV. 
*                THE VALUE *VVVVVVV* CANNOT BE USED FOR PARAMETER *PP*
*                ON THE *TMSON* OR *TMSOFF* COMMAND.
* 
*         UNABLE TO TURN OFF *TMS* CATALOG FOR FFFFFFF. 
*                THE *TMS* CATALOG FOR FAMILY *FFFFFFF* CANNOT BE 
*                TURNED OFF AT THIS TIME. 
* 
*         UNABLE TO TURN ON *TMS* CATALOG FOR FFFFFFF.
*                THE *TMS* CATALOG FOR FAMILY *FFFFFFF* CANNOT BE 
*                TURNED ON AT THIS TIME.
* 
*         UNKNOWN PARAMETER - PP. 
*                THE PARAMETER *PP* CANNOT BE PROCESSED BY THE
*                *TMSON* OR *TMSOFF* COMMAND. 
          TITLE  PROGRAM MACROS AND EQUIVALENCES. 
 COMMON   SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMCDCM 
*CALL     COMSEVT 
*CALL     COMSPFM 
*CALL     COMSPRD 
*CALL     COMSRPV 
*CALL     COMSSFM 
*CALL     COMSSSD 
*CALL     COMSTCM 
          QUAL   TFM
*CALL     COMSTFM 
          QUAL   *
          QUAL   TFU
*CALL     COMSTFU 
          QUAL   *
          QUAL   MTX
*CALL     COMSMTX 
          QUAL   *
          TITLE  PROGRAM MACROS AND EQUIVALENCES. 
 ABTMSG   SPACE  4,15 
**        ABTMSG - ABORT PROGRAM WITH DAYFILE MESSAGE.
* 
*         ABTMSG MADD 
* 
*         ENTRY  MADD = ADDRESS OF DAYFILE MESSAGE. 
* 
*         EXIT   MESSAGE ISSUED TO SYSTEM AND USER DAYFILES.
*                PROGRAM ABORTED. 
* 
*         USES   X - 5. 
* 
*         CALLS  ABT. 
  
  
          PURGMAC  ABTMSG 
  
 ABTMSG   MACRO  MA 
          MACREF ABTMSG 
          R=     X5,MA
          EQ     ABT
 ABTMSG   ENDM
 CLEAR    SPACE  4,15 
**        CLEAR - CLEAR BUFFER. 
* 
*         CLEAR  BUFFER,LENGTH
* 
*         ENTRY  BUFFER = FWA OF BUFFER TO CLEAR. 
*                LENGTH = LENGTH OF BUFFER. 
* 
*         EXIT   BUFFER FILLED WITH ZERO WORDS. 
* 
*         USES   X - 6. 
*                A - 6. 
*                B - 7. 
  
  
          PURGMAC  CLEAR
  
 CLEAR    MACRO  BF,LN
          LOCAL  A,B
          MACREF CLEAR
          R=     B7,LN
          R=     X6,0 
 A        SB7    B7-B1
          NG     B7,B 
          SA6    B7+BF
          EQ     A
  
 B        BSS    0
 CLEAR    ENDM
 LDIS     SPACE  4,15 
**        LDIS - RESERVE L-DISPLAY ENTRY. 
* 
*TAG      LDIS   NCHAR,STRING 
* 
*         ENTRY  TAG - LOCATION TAG OF ENTRY. 
*                NCHAR - NUMBER OF CHARACTERS.
*                STRING - INITIAL CHARACTER STRING. 
*                CP - SET TO CURRENT CHARACTER POSITION - 1.
* 
*         EXIT   *TAG* DEFINED AT ADDRESS LOCATION. 
*                *TAGU* DEFINED AT BIT POSITION.
*                *TAGC* DEFINED AS BIT COUNT (NCHAR*6). 
*                CP - SET TO CURRENT CHARACTER POSITION - 1.
  
  
          PURGMAC  LDIS 
  
          MACRO  LDIS,TG,NC,ST
          LOCAL  BC,BP,CC,LC,SS,WC
 LC       EQU    *
 BP       EQU    *P-1 
 WC       SET    NC-1 
 WC       SET    WC/10
 CC       DECMIC 1
          DUP    WC 
 SS       MICRO  "CC",10,$ST$ 
          VFD    60/10H"SS" 
 CC       DECMIC "CC"+10
          ENDD
 SS       MICRO  "CC",,$ST$ 
 CC       DECMIC NC-WC*10 
 BC       DECMIC "CC"*6 
          VFD    "BC"/"CC"H"SS" 
 AA       IFC    NE,$TG$$ 
 TG       EQU    LC 
 TG_U     EQU    BP 
 WC       SET    NC 
 TG_C     EQU    WC*6 
 AA       ENDIF 
 CP       SET    CP+NC
 LDIS     ENDM
 LDISE    SPACE  4,10 
**        LDISE - END L-DISPLAY LINE. 
* 
*         LDISE 
* 
*         ENTRY  CP - SET TO CURRENT CHARACTER POSITION - 1.
* 
*         EXIT   LAST WORD OF L-DISPLAY LINE ZERO FILLED. 
  
  
          PURGMAC  LDISE
  
 LDISE    MACRO 
          LOCAL  BC 
 AA       IFLT   *P,60
 BC       DECMIC *P 
          VFD    "BC"/0 
 AA       ENDIF 
          ERRNG  64-CP       TOO MANY CHARACTERS IN LINE
 LDISE    ENDM
 LDISS    SPACE  4,10 
**        LDISS - START L-DISPLAY LINE. 
* 
*         LDISS  FC,LN
* 
*         ENTRY  FC - FIRST CHARACTER POSITION OF LINE. 
*                LN - LINE NUMBER.
* 
*         EXIT   K - SET TO LINE NUMBER PLUS ONE. 
*                CP - SET TO CURRENT CHARACTER POSITION - 1.
  
  
          PURGMAC  LDISS
  
 LDISS    MACRO  FC,LN
          LOCAL  LL,XX,YY 
 LL       EQU    *
 XX       EQU    FC-1 
 YY       EQU    LN 
          VFD    12/6000B+XX*8,12/7707B-YY*15 
 KDL      RMT 
          VFD    24/0,18/LL,18/7726B-YY*10
 KDL      RMT 
 K        SET    YY+1 
 CP       SET    XX 
 LDISS    ENDM
 MBSATA   SPACE  4,30 
**        MBSATA - MOVE BIT STRING FROM ADDRESS TO ADDRESS. 
* 
*         MBSATA SADD,DADD,BITC,SUPB,DUPB 
* 
*         ENTRY  SADD = ADDRESS OF SOURCE STRING. 
*                DADD = ADDRESS OF DESTINATION STRING.
*                       (DO NOT USE A1, X1.)
*                BITC = BIT COUNT OF STRING.
*                       (DO NOT USE A1, X1, A2, X2.)
*                SUPB = UPPER BIT POSITION OF SOURCE STRING.
*                       (DO NOT USE A1, X1, A2, X2, B4.)
*                DUPB = UPPER BIT POSITION OF DESTINATION STRING. 
*                       (DO NOT USE A1, X1, A2, X2, B4, B3.)
* 
*         EXIT   (A1) = ADDRESS OF REMAINDER OF SOURCE STRING.
*                (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING. 
*                (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
*                       STRING. 
*                (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE 
*                       STRING. 
*                (X1) = FIRST WORD OF REMAINDER OF SOURCE STRING. 
*                (X2) = FIRST WORD OF REMAINDER OF DESTINATION STRING.
* 
*         USES   B - 4. 
* 
*         CALLS  MBS. 
  
  
          PURGMAC  MBSATA 
  
 MBSATA   MACRO  SA,DA,BC,SU,DU 
          MACREF MBSATA 
          R=     A1,SA
          R=     A2,DA
          R=     B4,BC
          R=     B3,SU
          R=     B2,DU
          RJ     MBS
 MBSATA   ENDM
 MBSXTA   SPACE  4,30 
**        MBSXTA - MOVE BIT STRING FROM X-REGISTER TO ADDRESS.
* 
*         MBSXTA SX,DADD,BITC,SUPB,DUPB 
* 
*         ENTRY  SX = X-REGISTER WITH SOURCE STRING.
*                DADD = ADDRESS OF DESTINATION STRING.
*                       (DO NOT USE X1.)
*                BITC = BIT COUNT OF STRING.
*                       (DO NOT USE X1, A2, X2.)
*                SUPB = UPPER BIT POSITION OF SOURCE STRING.
*                       (DO NOT USE X1, A2, X2, B4.)
*                DUPB = UPPER BIT POSITION OF DESTINATION STRING. 
*                       (DO NOT USE X1, A2, X2, B4, B3.)
* 
*         EXIT   (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING. 
*                (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
*                       STRING. 
*                (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE 
*                       STRING. 
*                     .LT. 0 IF NO MORE BITS IN SOURCE STRING.
*                (B4) = NUMBER OF BITS NOT MOVED. 
*                (X1) = SOURCE STRING.
*                (X2) = FIRST WORD OF REMAINDER OF DESTINATION STRING.
* 
*         USES   B - 4. 
* 
*         CALLS  MBS. 
  
  
          PURGMAC  MBSXTA 
  
 MBSXTA   MACRO  SX,DA,BC,SU,DU 
          LOCAL  A
          MACREF MBSXTA 
 .A       IFC    NE,$X1$SX$ 
          X=     X1,SX
 .A       ENDIF 
          R=     A2,DA
          R=     B4,BC
          R=     B3,SU
          R=     B2,DU
          RJ     SBS
          NG     B3,A 
          PL     B2,A 
          R=     A6,A2
          R=     A2,A2+B1 
          R=     B2,59
          RJ     SBS
 A        R=     A6,A2
 MBSXTA   ENDM
 RDMEM    SPACE  4,20 
**        RDMEM - READ MEMORY INTO BUFFER.
* 
*         RDMEM  TYPE,ADD,COUNT,BUFF
* 
*         ENTRY  TYPE - *ABS* IF READ FROM ABSOLUTE ADDRESS.
*                     - *CPA* IF READ FROM CONTROL POINT ADDRESS. 
*                     - SUBSYSTEM IDENTIFIER IF READ FROM SUBSYSTEM 
*                       FIELD LENGTH. 
*                ADD - ADDRESS TO READ FROM.  (DO NOT USE X4.)
*                COUNT - NUMBER OF WORDS TO READ.  (DO NOT USE X2, X4.) 
*                BUFF - ADDRESS OF BUFFER TO RECEIVE DATA.  (DO NOT 
*                       USE X2, X3, X4.)
* 
*         EXIT   (X1) .LT. 0 IF READ IS SUCCESSFUL. 
* 
*         USES   X - 2, 3, 4. 
* 
*         CALLS  RDM. 
  
  
          PURGMAC  RDMEM
  
 RDMEM    MACRO  TY,AD,CT,BF
          MACREF RDMEM
 .A       IFC    EQ,$TY$ABS$
          R=     X4,0 
 .A       ELSE
 .B       IFC    EQ,$TY$CPA$
          R=     X4,-1
 .B       ELSE
          R=     X4,TY
 .B       ENDIF 
 .A       ENDIF 
          R=     X2,AD
          R=     X3,CT
          R=     X1,BF
          RJ     RDM
 RDMEM    ENDM
 RJM      SPACE  4,15 
**        RJM - RETURN JOB TO ADDRESS IN REGISTER.
* 
*         RJM    ADDR 
* 
*         ENTRY  ADDR = ADDRESS OF SUBROUTINE.
* 
*         EXIT   RETURN JUMP INTO SUBROUTINE. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2. 
  
  
          PURGMAC  RJM
  
 RJM      MACRO  AD 
          LOCAL  A,B
          MACREF RJM
          R=     B2,AD
          R=     A1,A 
          BX6    X1 
          R=     A6,B2
          JP     B2+1 
 A        EQ     B
 B        BSS    0
 RJM      ENDM
 SRCHTAB  SPACE  4,25 
**        SRCHTAB - SEARCH TABLE. 
* 
*         SRCHTAB  XR,TABADD,ENTADD,ENTLNG,TABLNG 
* 
*         ENTRY  (X0) = SEARCH MASK.
*                XR = X-REGISTER WITH VALUE TO SEARCH FOR.
*                TABADD = TABLE ADDRESS.
*                         (DO NOT USE X1.)
*                ENTADD = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY. 
*                         (DO NOT USE X1 OR B2.)
*                ENTLNG = LENGTH OF TABLE ENTRY.
*                         (DO NOT USE X1, B2, OR B6.) 
*                TABLNG = LENGTH OF TABLE IF SPECIFIED. 
*                         ZERO WORD TERMINATED TABLE IF NOT SPECIFIED.
*                         (DO NOT USE X1, B2, B6, OR B7.) 
* 
*         EXIT   (X6) = 0 IF VALUE FOUND IN TABLE.
*                (A2) = ADDRESS OF WORD WITH VALUE. 
*                (X2) = IMAGE OF WORD WITH VALUE. 
* 
*         USES   X - 1. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  STL, STZ.
  
  
          PURGMAC  SRCHTAB
  
 SRCHTAB  MACRO  XR,TA,EA,EL,TL 
          MACREF SRCHTAB
 .A       IFC    NE,$X1$XR$ 
          X=     X1,XR
 .A       ENDIF 
          R=     B2,TA
          R=     B6,EA
          R=     B7,EL
 .A       IFC    EQ,$TL$$ 
          RJ     STZ
 .A       ELSE
          R=     B3,TL
          RJ     STL
 .A       ENDIF 
 SRCHTAB  ENDM
 MISCEQU  SPACE  4,10 
**        MISCELLANEOUS EQUIVALENCES. 
  
  
 DEFRN    EQU    10          DEFAULT WAITING TIME FOR NON-SYSTEM ORIGIN 
 DEFRS    EQU    2           DEFAULT WAITING TIME FOR SYSTEM ORIGIN 
 SBCWL    EQU    /TFM/BWUN+1 CATALOG SYSTEM BLOCK CONTROL WORD LENGTH 
 SBUFE    EQU    SBCWL+/TFM/TSTL  CATALOG SYSTEM BLOCK LENGTH 
 SSJ=     EQU    0           SYSTEM PRIVILEGES DEFINITION 
 DISEQU   SPACE  4,10 
**        DISPLAY EQUIVALENCES. 
  
  
 LPEFC    EQU    2           FAMILY CATALOG LINES PER ENTRY 
 NLPDS    EQU    23          NUMBER OF LINES PER DISPLAY
 NLPTT    EQU    3           NUMBER OF LINES PER TITLE
 NLPMS    EQU    2           NUMBER OF LINES PER MESSAGE
 NLPHD    EQU    2           NUMBER OF LINES PER HEADER 
 NLPPG    EQU    NLPDS-NLPTT-NLPHD-NLPMS-1  NUMBER OF LINES PER PAGE
 MXNEL    SET    100B*LPEFC-1  MAXIMUM NUMBER OF ENTRY LINES
 NPGFD    EQU    MXNEL/NLPPG+1  NUMBER OF PAGES FOR FAMILY DISPLAY
 NPGHD    EQU    1           NUMBER OF PAGES FOR HELP DISPLAY 
 OPTLD    EQU    0           L-DISPLAY MODE 
 OPTLN    EQU    1           LINE MODE
 OPTSC    EQU    2           SCREEN MODE
 BUFFL    SPACE  4,10 
**        BUFFER LENGTHS. 
  
  
 CBUFL    EQU    LCOM        COMMAND BUFFER LENGTH
 DBUFL    EQU    LDSY        DISPLAY BUFFER LENGTH
 FBUFL    EQU    100B        FAMILY ORDINAL TABLE BUFFER LENGTH 
 IBUFL    EQU    1001B       INPUT FILE BUFFER LENGTH 
 LBUFL    EQU    1001B       OUTPUT FILE BUFFER LENGTH
 SBUFL    EQU    SBUFE*FBUFL CATALOG SYSTEM BLOCKS BUFFER LENGTH
 ZBUFL    EQU    101B        CATALOG FILE BUFFER LENGTH 
 LEQUIV   SPACE  4,10 
**        L-DISPLAY EQUIVALENCES. 
  
  
 NERR     EQU    0           NO ERROR 
 NBUF     EQU    1           NO L-DISPLAY BUFFER DEFINED IN CMR 
 NINL     EQU    2           L-DISPLAY BUFFER NOT INTERLOCKED 
 NDBF     EQU    3           DISPLAY BUFFER TOO LARGE 
 NCMD     EQU    4           NO COMMAND ENTERED 
 NCBF     EQU    5           COMMAND BUFFER TOO SMALL 
 MICROS   SPACE  4,10 
**        PROGRAM MICROS. 
  
  
 DEFRN    DECMIC DEFRN       DEFAULT WAITING TIME NON-SYSTEM ORIGIN 
 DEFRS    DECMIC DEFRS       DEFAULT WAITING TIME SYSTEM ORIGIN 
          TITLE  DATA AREA. 
          SPACE  4
          ORG    110B 
 FETS     SPACE  4,10 
**        FETS. 
  
  
 I        BSS    0           INPUT FILE 
 INPUT    FILEC  IBUF,IBUFL,(FET=8),EPR 
  
 L        BSS    0           OUTPUT FILE
 OUTPUT   FILEC  LBUF,LBUFL,(FET=8),EPR 
  
 P        BSS    0           CATALOG FILE 
 "TMFC"   FILEB  ZBUF,ZBUFL,(FET=16),EPR,(PFN="TMFC") 
 CSMS     SPACE  4,10 
**        COMMAND STATUS MESSAGES.
  
  
 CSII     DATA   30H           INCORRECT INCREMENT
 CSLC     DATA   30H                  LAST COMMAND
 CSPR     DATA   30H                    PROCESSING
 CSTM     DATA   30H           TOO MANY PARAMETERS
 CSUC     DATA   30H               UNKNOWN COMMAND
 DFES     SPACE  4,10 
**        DAYFILE MESSAGES. 
  
  
 DFFN     DATA   C* FAMILY NOT FOUND.*
 DFIC     DATA   C* INCORRECT COMMAND.* 
 DFIV     DATA   C* INCORRECT VALUE FOR ####### PARAMETER - $$$$$$$.* 
 DFLC     DATA   C* TMSDIS COMPLETE.* 
 DFLN     DATA   C* L-DISPLAY NOT AVAILABLE.* 
 DFUF     DATA   C$ UNABLE TO TURN OFF *TMS* CATALOG FOR #######.$
 DFUN     DATA   C$ UNABLE TO TURN ON *TMS* CATALOG FOR #######.$ 
 DFUP     DATA   C* UNKNOWN PARAMETER - $$$$$$$.* 
 TCOM     SPACE  4,10 
**        TCOM - TABLE OF INPUT COMMANDS. 
* 
*T,       42/ NAME, 18/ ADDRESS 
* 
*         ENTRY  NAME = LEFT JUSTIFIED, ZERO-FILLED COMMAND NAME. 
*                ADDRESS = PROCESSOR ADDRESS IF PROCESS AFTER SYSTEM
*                          STATUS.
*                        = (-1)*PROCESSOR ADDRESS IF PROCESS
*                          IMMEDIATELY. 
  
  
 TCOM     BSS    0           TABLE OF INPUT COMMANDS
          VFD    42/0LHELP,18/HEP  HELP DISPLAY 
          VFD    42/0LFAM,18/FAP  FAMILY CATALOG DISPLAY
          VFD    42/0LCOPY,18/COP  COPY DISPLAY TO OUTPUT FILE
          VFD    42/1L+,18/PCP  TOGGLE PAGE FORWARD 
          VFD    42/1L-,18/MCP  TOGGLE PAGE BACKWARD
          VFD    42/0LDROP,18/-DRO  TERMINATE *TMSDIS*
          VFD    42/0LEND,18/-DRO  TERMINATE *TMSDIS* 
 TCOML    EQU    *-TCOM      LENGTH OF TABLE
 TDPR     SPACE  4,10 
**        TDPR - TABLE OF DISPLAY PROCESSORS. 
  
  
 TDPR     BSS    0           TABLE OF DISPLAY PROCESSORS
          LOC    0
 DISHP    CON    HEL         *HELP* 
 DISFC    CON    FAM         *FAM*
          LOC    *O 
 TFCM     SPACE  4,10 
**        TFCM - TABLE OF FAMILY CATALOG MESSAGE ADDRESSES. 
  
  
 TFCM     BSS    0           TABLE OF FAMILY CATALOG MESSAGE ADDRESSES. 
          LOC    0
 CSCFA    CON    BLANKS      CATALOG FILE FAST-ATTACHED STATUS
 CSERR    CON    0           CATALOG FILE ERROR STATUS
 CSNSV    CON    =40H NO SCRATCH VSNS.
 CSCFN    CON    =40H CATALOG NOT FAST-ATTACHED.
 CSCNF    CON    =40H CATALOG NOT FOUND.
 CSCFB    CON    0           CATALOG FILE BUSY STATUS 
 CSFNF    CON    0           FAMILY NOT FOUND STATUS
          LOC    *O 
 TFCP     SPACE  4,10 
**        TFCP - TABLE OF FAMILY CATALOG PROCESSORS 
  
  
 TFCP     BSS    0           TABLE OF FAMILY CATALOG PROCESSORS 
          LOC    0
 CSCFA    CON    CCS         CATALOG FILE FAST-ATTACHED STATUS
 CSERR    CON    CCS         CATALOG FILE ERROR STATUS
 CSNSV    CON    CCS         NO SCRATCH VSNS STATUS 
 CSCFN    CON    CNF         CATALOG FILE NOT FAST-ATTACHED 
 CSCNF    CON    CCB         CATALOG FILE NOT FOUND STATUS
 CSCFB    CON    CCS         CATALOG FILE BUSY STATUS 
 CSFNF    CON    CCB         FAMILY NOT FOUND STATUS
 NFCST    EQU    *           NUMBER OF FAMILY CATALOG STATUSES
          LOC    *O 
 TNDP     SPACE  4,10 
**        TNDP - TABLE OF NUMBER OF DISPLAY PAGES.
  
  
 TNDP     BSS    0           TABLE OF NUMBER OF DISPLAY PAGES 
          LOC    0
 DISHP    CON    NPGHD       *HELP* 
 DISFC    CON    1           *FAM*
          LOC    *O 
 WORKING  SPACE  4,10 
**        WORKING STORAGE CELLS.
  
  
 BEL      CON    2R^*        BELL CHARACTER 
 BLANKS   DATA   64L
 CCE      CON    0           COUNT OF CATALOG ERRORS
 CIN      BSS    0           CLEAR INPUT LINE 
          VFD    12/2R"EM"   ASCII OUTPUT 
          VFD    48/8H          78 BLANK CHARACTERS 
          DUP    7
          VFD    60/10H 
          ENDD
          VFD    24/4H"CR""CB"  CARRIAGE RETURN/NO LINE FEED
          VFD    36/0        END OF LINE
 CLN      CON    0           CURRENT LINE NUMBER
 CMP      CON    0           COMMAND PROCESSOR ADDRESS
 CNSM     CON    0           COUNT OF CATALOGS WITH NO *MT/NT* SCRATCH
 CNSC     CON    0           COUNT OF CATALOGS WITH NO *CT* SCRATCH 
 CNSA     CON    0           COUNT OF CATALOGS WITH NO *AT* SCRATCH 
 COA      CON    0           COUNT OF JOBS REQUIRING OPERATOR ACTION
 COM      CON    0           COMMAND IMAGE
 CON      CON    0           CONSOLE STATUS 
 CPN      BSS    0           *CP=N,PG=N* LINE 
          VFD    12/2R:N     *NAM* OUTPUT 
          VFD    12/4107B    CURSOR POSITIONING 
          VFD    12/4000B    NO 
          VFD    12/4045B    PAGE WAITING 
          VFD    12/4000B    NO 
          VFD    60/0        END OF LINE
 CPY      BSS    0           *CP=Y* LINE
          VFD    12/2R:N     *NAM* OUTPUT 
          VFD    12/4107B    CURSOR POSITIONING 
          VFD    12/4001B    YES
          VFD    24/0        END OF LINE
 CSL      BSS    0           CLEAR SCREEN LINE
          VFD    12/2R"EM"   ASCII OUTPUT 
          VFD    12/2R^=     CLEAR SCREEN CHARACTER 
          VFD    24/4R"CR""ES"  CARRIAGE RETURN/NO LINE FEED
          VFD    12/0        END OF LINE
 DIS      CON    DISHP       CURRENT DISPLAY
 FFO      CON    0           FWA OF FAMILY ORDINAL TABLE
 HYPHENS  DATA   10H----------  TEN HYPHEN CHARACTERS 
 JOT      CON    0           JOB ORIGIN TYPE
 LDE      CON    0           L-DISPLAY ERROR FLAG 
 LIT      CON    0           LITERAL STATUS FOR *POP* (0=NO LITERALS) 
 LNS      CON    0           LINE MODE OUTPUT STATUS (0=NO OUTPUT)
 MXF      CON    0           MAXIMUM NUMBER OF FOT ENTRIES
 OFM      CON    0           ORIGINAL FAMILY NAME 
 OPT      CON    OPTLN       INPUT/OUTPUT MODE
 OUI      CON    0           ORIGINAL USER INDEX
 PAG      CON    1           CURRENT PAGE NUMBER
 PAR      CON    0           COMMAND PARAMETER ADDRESS
 PNO      CON    NPGHD       CURRENT NUMBER OF PAGES
 ROT      DATA   0           ROLLOUT TIME 
 SIA      CON    0           SCREEN INPUT AVAILABLE FLAG
 TIN      CON    0           TERMINAL INPUT STATUS (0=TERMINAL INPUT) 
 TMS      CON    0           *TMS* STATUS (0=ENABLED) 
 TOP      BSS    0           TOP OF PAGE CHARACTERS 
          VFD    12/2R"EM"   ASCII OUTPUT 
          VFD    12/2R       BELL CHARACTER 
          VFD    12/2R^?     TOP OF PAGE CHARACTER
          VFD    24/4R"CR""ES"  CARRIAGE RETURN/NO LINE FEED
          VFD    60/0        END OF LINE
 TOU      CON    0           TERMINAL OUTPUT STATUS (0=TERMINAL OUTPUT) 
 ZEROES   BSSZ   7           SEVEN WORDS OF ZEROES
          TITLE  TMSDIS MAIN PROGRAM. 
 LDI      SPACE  4,10 
**        TMSDIS - MAIN PROGRAM.
  
  
 TMSDIS   BSS    0           ENTRY
 LDISTAP  SB1    1           ENTRY
          RJ     PRS         PRESET PROGRAM 
          SA1    OPT
          SX1    X1-OPTLN 
          ZR     X1,LDI7     IF LINE MODE 
          SX1    X1-OPTSC+OPTLN 
          ZR     X1,LDI1     IF SCREEN MODE 
          SX6    B0          CLEAR DISPLAY
          SA6    DBUF+DBUFS 
          RJ     IDO         ISSUE DISPLAY OUTPUT 
          EQ     LDI3        GET SYSTEM STATUSES
  
 LDI1     WRITEC L,CPN       CLEAR PAGE WAIT/CURSOR POSITIONING 
          WRITEC L,CSL       CLEAR SCREEN 
          EQ     LDI3        GET SYSTEM STATUSES
  
 LDI2     SA1    ROT
          ZR     X1,LDI3     IF NO ROLLOUT TIME 
          ROLLOUT  ROT       ROLLOUT ON TIMED-EVENT 
 LDI3     RECALL
          RJ     GCS         GET CATALOG STATUS 
          SA1    CMP
          ZR     X1,LDI6     IF NO COMMAND PROCESSOR
 LDI4     RJM    X1          PROCESS COMMAND
          NZ     X5,LDI5     IF ERROR 
          MBSATA CSLC,DMMA,DMMAC,59,DMMAU  *LAST COMMMAND*
          EQ     LDI6        ISSUE OUTPUT 
  
 LDI5     MBSATA X5,DMMA,DMMAC,59,DMMAU  SET ERROR MESSAGE
          SA1    OPT         CHECK FOR LINE MODE
          SX1    X1-OPTLN 
          NZ     X1,LDI6     IF NOT LINE MODE 
          MBSATA DMMA,LDIA,64*6,DMMAU,53  ISSUE ERROR MESSAGE TO OUTPUT 
          WRITEC L,BLANKS 
          WRITEC L,LDIA 
 LDI6     RJ     CLS         CHECK LINE MODE OUTPUT STATUS
          NZ     X6,LDI7     IF NO LINE MODE OUTPUT 
          RJ     BDT         BUILD DISPLAY TITLE
          SA1    DIS         GET DISPLAY PROCESSOR ADDRESS
          SA1    X1+TDPR
          RJM    X1          PROCESS DISPLAY
          RJ     IOU         ISSUE OUTPUT 
 LDI7     RJ     GIN         GET INPUT
          SA1    CBUF+1 
          NZ     X1,LDI8     IF INPUT 
          SX6    B0          CLEAR COMMAND PROCESSOR
          SA6    CMP
          SX6    B1          FORCE LINE MODE OUTPUT 
          SA6    LNS
          EQ     LDI2        ROLLOUT JOB
  
 LDI8     SB2    7           BLANK FILL COMMAND 
 LDI9     NG     B2,LDI10    IF END OF COMMAND
          SA1    B2+CBUF+1
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          SA6    A1 
          SB2    B2-B1
          EQ     LDI9        CHECK NEXT COMMAND WORD
  
 LDI10    MX0    42          FORCE TERMINATOR INTO COMMAND
          SA1    CBUF+1+7 
          SX6    1R.
          BX1    X0*X1
          LX6    12 
          BX6    X1+X6
          SA6    A1 
          MBSATA CSPR,DMMA,DMMAC,59,DMMAU  *PROCESSING* 
          MBSATA CBUF+1,DMCM,DMCMC,59,DMCMU 
          SA1    OPT         CHECK OPTION 
          SX1    X1-OPTLD 
          NZ     X1,LDI11    IF NOT L-DISPLAY MODE
          RJ     IDO         ISSUE DISPLAY OUTPUT 
 LDI11    SB2    CBUF+1 
          RJ     USB         UNPACK STRING BUFFER 
          RJ     POP         PICK OUT PARAMETER 
          SB5    B5-B1
          SX5    CSUC        *UNKNOWN COMMAND.* 
          PL     B5,LDI5     IF COMMAND TOO LONG
          ZR     X6,LDI12    IF SPECIAL CHARACTER 
          MX0    42          CHECK COMMAND LENGTH 
          BX1    -X0*X6 
          NZ     X1,LDI5     IF COMMAND TOO LONG
          EQ     LDI13       SAVE COMMAND IMAGE 
  
 LDI12    LX1    54          POSITION COMMAND 
          BX6    X1 
 LDI13    SA6    COM         SAVE COMMAND IMAGE 
          SX6    B6          SAVE FIRST PARAMETER ADDRESS 
          SA6    PAR
          MX0    42          FIND COMMAND 
          SA1    COM
          SRCHTAB  X1,TCOM,0,1,TCOML
          SX5    CSUC        *UNKNOWN COMMAND.* 
          NZ     X6,LDI5     IF COMMAND NOT FOUND 
          SX6    X2          SAVE COMMAND PROCESSOR ADDRESS 
          SA6    CMP
          PL     X6,LDI3     IF DO NOT PROCESS IMMEDIATELY
          BX1    -X6
          EQ     LDI4        PROCESS COMMAND
  
 LDIA     DATA   65L
 ABT      SPACE  4,10 
**        ABT - ABORT PROGRAM.
* 
*         ENTRY  (X5) = ADDRESS OF DAYFILE MESSAGE. 
* 
*         EXIT   MESSAGE ISSUED TO SYSTEM AND USER DAYFILES.
*                PROGRAM ABORTED. 
* 
*         CALLS  CUP. 
* 
*         MACROS ABORT, MESSAGE.
  
  
 ABT      BSS    0           ENTRY
          RJ     CUP         CLEAN UP PROGRAM 
          MESSAGE  X5,0,R    ISSUE ERROR MESSAGE
          ABORT              ABORT PROGRAM
 END      SPACE  4,10 
**        END - TERMINATE PROGRAM.
* 
*         EXIT   PROGRAM TERMINATED.
* 
*         CALLS  CUP. 
* 
*         MACROS ENDRUN, MESSAGE. 
  
  
 END      BSS    0           ENTRY
          RJ     CUP         CLEAN UP PROGRAM 
          MESSAGE  DFLC,0,R  *TMSDIS COMPLETE.* 
          ENDRUN             TERMINATE PROGRAM
 RPV      SPACE  4,15 
**        RPV - REPRIEVE PROCESSOR. 
* 
*         EXIT   (SIA) = 1 AND PROGRAM RESUMED IF USER BREAK ONE AND
*                        TERMINAL INPUT/OUTPUT. 
*                PROGRAM CLEANED UP AND ERROR CONDITION RESET IF NOT
*                USER BREAK ONE OR NOT TERMINAL INPUT/OUTPUT. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  CUP. 
* 
*         MACROS REPRIEVE.
  
  
 RPV      BSS    0           ENTRY
          MX0    -12         CHECK ERROR FLAG 
          SA1    RPVA+/COMSRPV/OSEF 
          BX1    -X0*X1 
          SX1    X1-TIET
          NZ     X1,RPV2     IF NOT USER BREAK ONE
          SA1    TIN         CHECK FOR TERMINAL INPUT/OUTPUT
          SA2    TOU
          BX1    X1+X2
          NZ     X1,RPV2     IF NOT TERMINAL INPUT/OUTPUT 
          SX6    B1          FLAG SCREEN INPUT AVAILABLE
          SA6    SIA
          REPRIEVE  RPVA,RESUME,237B  RESUME PROGRAM EXECUTION
  
 RPV2     RJ     CUP         CLEAN UP PROGRAM 
          REPRIEVE  RPVA,RESET,000B  RESET ERROR CONDITION
  
 RPVA     RPVBLK RPV         REPRIEVE BLOCK 
          TITLE  COMMAND SUBROUTINES. 
 COP      SPACE  4,15 
**        COP - PROCESS *COPY* COMMAND. 
* 
*         COPY. 
* 
*         EXIT   CURRENT DISPLAY COPIED TO OUTPUT FILE IF L-DISPLAY OR
*                LINE MODE. 
*                (X5) = 0 IF NO PARAMETERS. 
*                     = CSTM IF TOO MANY PARAMETERS.
* 
*         USES   X - 1. 
*                A - 1. 
* 
*         CALLS  ILO, VNP.
  
  
 COP      SUBR               ENTRY/EXIT 
          RJ     VNP         VERIFY NO MORE PARAMETERS
          NZ     X5,COPX     IF TOO MANY PARAMETERS 
          SA1    OPT         CHECK INPUT/OUTPUT MODE
          SX1    X1-OPTSC 
          ZR     X1,COPX     IF SCREEN MODE 
          RJ     BDT         BUILD DISPLAY TITLE
          SA1    DIS         GET DISPLAY PROCESSOR ADDRESS
          SA1    X1+TDPR
          RJM    X1          PROCESS DISPLAY
          RJ     ILO         ISSUE LINE OUTPUT
          SX5    B0          FLAG NO ERROR
          EQ     COPX        RETURN 
 DRO      SPACE  4,10 
**        DRO - PROCESS *DROP* OR *END* COMMAND.
* 
*         END.
*         DROP. 
* 
*         EXIT   TO *END* TO TERMINATE PROGRAM. 
* 
*         ERROR  (X5) = CSTM IF TOO MANY PARAMETERS.
* 
*         CALLS  VNP. 
  
  
 DRO      SUBR               ENTRY/EXIT 
          RJ     VNP         VERIFY NO PARAMETERS 
          NZ     X5,DROX     IF TOO MANY PARAMETERS 
          EQ     END         TERMINATE PROGRAM
 FAP      SPACE  4,15 
**        FAP - PROCESS *FAM* COMMAND.
* 
*         FAM.
* 
*         EXIT   (DIS) = DISFC. 
*                (PAG) = 1. 
*                (X5) = 0 IF NO PARAMETERS. 
*                     = CSTM IF TOO MANY PARAMETERS.
* 
*         USES   X - 6. 
*                A - 6. 
* 
*         CALLS  VNP. 
  
  
 FAP      SUBR               ENTRY/EXIT 
          RJ     VNP         VERIFY NO MORE PARAMETERS
          NZ     X5,FAPX     IF TOO MANY PARAMETERS 
          SX6    B1          SET PAGE NUMBER
          SA6    PAG
          SX6    DISFC       SET DISPLAY TYPE 
          SA6    DIS
          SX6    B1          FORCE LINE MODE OUTPUT 
          SA6    LNS
          SX5    B0 
          EQ     FAPX        RETURN 
 HEP      SPACE  4,15 
**        HEP - PROCESS *HELP* COMMAND. 
* 
*         HELP. 
* 
*         EXIT   (DIS) = DISHP. 
*                (PAG) = 1. 
*                (X5) = 0 IF NO PARAMETERS. 
*                     = CSTM IF TOO MANY PARAMETERS.
* 
*         USES   X - 6. 
*                A - 6. 
* 
*         CALLS  VNP. 
  
  
 HEP      SUBR               ENTRY/EXIT 
          RJ     VNP         VERIFY NO MORE PARAMETERS
          NZ     X5,HEPX     IF TOO MANY PARAMETERS 
          SX6    B1          SET PAGE NUMBER
          SA6    PAG
          SX6    DISHP       SET DISPLAY TYPE 
          SA6    DIS
          SX6    B1          FORCE LINE MODE OUTPUT 
          SA6    LNS
          SX5    B0 
          EQ     HEPX        RETURN 
 MCP      SPACE  4,15 
**        MCP - PROCESS MINUS COMMAND.
* 
*         -.
*         -N. 
* 
*         EXIT   PAGE TOGGLED BACKWARD. 
*                (X5) = 0 IF NO PARAMETERS. 
*                     = ERROR MESSAGE ADDRESS IF INCORRECT INCREMENT. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
* 
*         CALLS  VIP, VNP.
  
  
 MCP      SUBR               ENTRY/EXIT 
          RJ     VIP         VERIFY INCREMENT PARAMETER 
          NZ     X5,MCPX     IF INCORRECT PARAMETER 
          SA6    MCPA        SAVE INCREMENT 
          RJ     VNP         VERIFY NO PARAMETERS 
          NZ     X5,MCPX     IF TOO MANY PARAMETERS 
          SA1    PAG         CHECK PAGE NUMBER
          SA2    MCPA 
          IX2    X2-X1
          BX6    -X2
          NG     X2,MCP1     IF NOT BEFORE FIRST PAGE 
          SA1    PNO         SET LAST PAGE
          SX6    X1 
 MCP1     SA6    PAG         SET NEW PAGE NUMBER
          SX6    B1          FORCE LINE MODE OUTPUT 
          SA6    LNS
          SX5    B0 
          EQ     MCPX        RETURN 
  
 MCPA     BSS    1           INCREMENT
 PCP      SPACE  4,15 
**        PCP - PROCESS PLUS COMMAND. 
* 
*         +.
*         +N. 
* 
*         EXIT   PAGE TOGGLED FORWARD.
*                (X5) = 0 IF NO PARAMETERS. 
*                     = ERROR MESSAGE ADDRESS IF INCORRECT INCREMENT. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
* 
*         CALLS  VIP, VNP.
  
  
 PCP      SUBR               ENTRY/EXIT 
          RJ     VIP         VERIFY INCREMENT PARAMETER 
          NZ     X5,PCPX     IF INCORRECT INCREMENT 
          SA6    PCPA        SAVE INCREMENT 
          RJ     VNP         VERIFY NO MORE PARAMETERS
          NZ     X5,PCPX     IF TOO MANY PARAMETERS 
          SA1    PAG         CHECK PAGE NUMBER
          SA2    PCPA 
          IX6    X1+X2
          SA1    PNO
          IX1    X1-X6
          PL     X1,PCP1     IF NOT AFTER LAST PAGE 
          SX6    B1          SET FIRST PAGE 
 PCP1     SA6    PAG         SET NEW PAGE NUMBER
          SX6    B1          FORCE LINE MODE OUTPUT 
          SA6    LNS
          SX5    B0 
          EQ     PCPX        RETURN 
  
 PCPA     BSS    1           INCREMENT
          TITLE  DISPLAY SUBROUTINES. 
 BDT      SPACE  4,10 
**        BDT - BUILD DISPLAY TITLE.
* 
*         EXIT   FIRST THREE LINES OF DISPLAY SET UP. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2.
* 
*         CALLS  CDD. 
* 
*         MACROS MBSATA, MBSXTA.
  
  
 BDT      SUBR               ENTRY/EXIT 
          SA1    TMS         GET *TMS* STATUS 
          SX6    BDTC 
          ZR     X1,BDT2     IF *TMS* ACTIVE
          SX6    BDTD 
 BDT2     MBSATA X6,DTTS,DTTSC,59,DTTSU  SET *TMS* STATUS 
          SA1    DIS         GET DISPLAY NAME 
          MBSATA X1+BDTE,DTDS,DTDSC,59,DTDSU  SET DISPLAY NAME
          SA1    DIS         GET NUMBER OF PAGES
          SA2    X1+TNDP
          NZ     X2,BDT3     IF ONE OR MORE PAGES 
          SX2    B1 
 BDT3     SX6    X2          SET NUMBER OF PAGES
          SA6    PNO
          SA1    PAG         GET CURRENT PAGE NUMBER
          IX6    X2-X1
          PL     X6,BDT4     IF NOT TOO MANY PAGES
          SX1    X2          RESET PAGE NUMBER
          SX6    X2 
          SA6    A1 
 BDT4     NZ     X1,BDT5     IF NON-ZERO
          SX1    B1          RESET PAGE NUMBER
          SX6    B1 
          SA6    A1 
 BDT5     RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTPN,DTPNC,DTPNC-1,DTPNU  SET CURRENT PAGE NUMBER 
          SA1    PNO         GET NUMBER OF PAGES
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTPC,DTPCC,DTPCC-1,DTPCU  SET CURRENT PAGE NUMBER 
          SA1    CCE         GET NUMBER OF CATALOGS WITH ERRORS 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTCE,DTCEC,DTCEC-1,DTCEU  SET CATALOG ERRORS
          SA1    CNSM        NUMBER OF CATALOGS WITH NO *MT/NT* SCRATCH 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTNM,DTNMC,DTNMC-1,DTNMU  SET NO SCRATCH COUNT
          SA1    CNSC        NUMBER OF CATALOGS WITH NO *CT* SCRATCH
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTNC,DTNCC,DTNCC-1,DTNCU  SET NO SCRATCH COUNT
          SA1    CNSA        NUMBER OF CATALOGS WITH NO *AT* SCRATCH
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DTNA,DTNAC,DTNAC-1,DTNAU  SET NO SCRATCH COUNT
          EQ     BDTX        RETURN 
  
  
 BDTC     DATA   14H TMS ENABLED. 
 BDTD     DATA   14HTMS DISABLED. 
 BDTE     BSS    0           DISPLAY NAMES
          LOC    0
 DISHP    DATA   4HHELP 
 DISFC    DATA   4H FAM 
          LOC    *O 
 FAM      SPACE  4,10 
**        FAM - BUILD *FAM* DISPLAY.
* 
*         EXIT   FAMILY CATALOG DISPLAY SET INTO *DBUF*.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 0, 1, 2, 6.
* 
*         CALLS  CDD, CLY, ZTB. 
* 
*         MACROS MBSATA, MBSXTA, MOVE.
  
  
 FAM3     SX6    B0          FLAG END OF DISPLAY BUFFER 
          SA6    X5 
  
 FAM      SUBR               ENTRY/EXIT 
          SX5    DBUF+DBUFS  SET START OF DISPLAY BUFFER
          MOVE   FAMAL,FAMA,X5  SET HEADER IN DISPLAY BUFFER
          SX5    X5+FAMAL 
          SA1    PNO
          ZR     X1,FAM3     IF NO PAGES FOR DISPLAY
          SA1    PAG         GET ADDRESS OF FIRST ENTRY FOR PAGE
          ZR     X1,FAM3     IF NO PAGES FOR DISPLAY
          SA1    X1+TFDP-1
          SX6    NLPTT+NLPHD+1  SET CURRENT LINE NUMBER 
          SA6    CLN
 FAM1     SX1    X1 
          ZR     X1,FAM3     IF NO MORE ENTRIES 
          SA0    X1 
          SA1    CLN         CHECK CURRENT LINE NUMBER
          SX6    X1+LPEFC-NLPHD-NLPTT-NLPPG-2 
          PL     X6,FAM3     IF NO MORE LINES IN DISPLAY
          SX6    X5+FAMBL-DBUF-DBUFL
          PL     X6,FAM3     IF NO MORE ROOM IN DISPLAY BUFFER
          SX0    FAMB        CALCULATE Y-COORDINATE FOR FIRST LINE
          SA1    CLN
          RJ     CLY         CONVERT LINE NUMBER TO Y-COORDINATE
          SX0    FAMB2       CALCULATE Y-COORDINATE FOR SECOND LINE 
          SA1    CLN
          SX1    X1+B1
          RJ     CLY         CONVERT LINE NUMBER TO Y-COORDINATE
  
*         SET *FAMILY*. 
  
          SA1    A0+SBCWL+/TFM/TMFM  GET FAMILY NAME
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          MBSXTA X6,DFFM,DFFMC,59,DFFMU  SET *FAMILY* 
  
*         SET BUSY FLAG.
  
          SA1    A0          CHECK CATALOG BUSY FLAG
          LX1    59-47
          SX6    1R 
          PL     X1,FAM2     IF CATALOG NOT BUSY
          SX6    1R*
 FAM2     MBSXTA X6,DFBS,DFBSC,DFBSC-1,DFBSU  SET BUSY FLAG 
  
*         SET *MT/NT* SCRATCH COUNT.
  
          MX0    -24         GET SCRATCH COUNT
          SA1    A0+SBCWL+/TFM/TMSM 
          BX1    -X0*X1 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DFSM,DFSMC,DFSMC-1,DFSMU  SET COUNT 
  
*         SET *MT/NT* NEXT SCRATCH VSN. 
  
          SA1    A0+SBCWL+/TFM/TMSM 
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          MBSXTA X6,DFNM,DFNMC,59,DFNMU  SET NEXT VSN 
  
*         SET *CT* SCRATCH COUNT. 
  
          MX0    -24         GET SCRATCH COUNT
          SA1    A0+SBCWL+/TFM/TMSC 
          BX1    -X0*X1 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DFSC,DFSCC,DFSCC-1,DFSCU  SET COUNT 
  
*         SET *CT* NEXT SCRATCH VSN.
  
          SA1    A0+SBCWL+/TFM/TMSC 
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          MBSXTA X6,DFNC,DFNCC,59,DFNCU  SET NEXT VSN 
  
*         SET *AT* SCRATCH COUNT. 
  
          MX0    -24         GET SCRATCH COUNT
          SA1    A0+SBCWL+/TFM/TMSA 
          BX1    -X0*X1 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MBSXTA X6,DFSA,DFSAC,DFSAC-1,DFSAU  SET COUNT 
  
*         SET *AT* NEXT SCRATCH VSN.
  
          SA1    A0+SBCWL+/TFM/TMSA 
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          MBSXTA X6,DFNA,DFNAC,59,DFNAU  SET NEXT VSN 
  
*         SET *STATUS*. 
  
          SA1    A0+SBCWL+/TFM/TMMB  GET STATUS MESSAGE 
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          SA6    A1 
          SA1    A1+B1
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          SA6    A1 
          SA1    A1+B1
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          SA6    A1 
          SA1    A1+B1
          RJ     ZTB         CONVERT ZEROES TO BLANKS 
          SA6    A1 
          MBSATA A0+SBCWL+/TFM/TMMB,DFST,DFSTC,59,DFSTU  SET *STATUS* 
          MOVE   FAMBL,FAMB,X5  SET ENTRY INTO BUFFER 
          SX5    X5+FAMBL    INCREMENT DISPLAY BUFFER ADDRESS 
          SA1    CLN         INCREMENT CURRENT LINE NUMBER
          SX6    X1+LPEFC 
          SA6    A1 
          SA1    A0          GET NEXT FAMILY CATALOG ADDRESS
          EQ     FAM1        CHECK ADDRESS
  
 FAMA     BSS    0           FAMILY CATALOG DISPLAY HEADER
          LDISS  1,NLPTT+1   HEADER LINE ONE
          LDIS   7,(FAMILY )
          LDIS   1,( )
          LDIS   16,(   MT/NT SCRATCH)
          LDIS   1,( )
          LDIS   16,(    CT SCRATCH  )
          LDIS   1,( )
          LDIS   16,(    AT SCRATCH  )
          LDISE 
          LDISS  1,K         HEADER LINE TWO
          LDIS   8,(  STATUS) 
          LDIS   8,(   COUNT) 
          LDIS   1,( )
          LDIS   7,(NXT-VSN)
          LDIS   1,( )
          LDIS   8,(   COUNT) 
          LDIS   1,( )
          LDIS   7,(NXT-VSN)
          LDIS   1,( )
          LDIS   8,(   COUNT) 
          LDIS   1,( )
          LDIS   7,(NXT-VSN)
          LDISE 
 FAMAL    EQU    *-FAMA      FAMILY CATALOG DISPLAY HEADER LENGTH 
  
 FAMB     BSS    0
          LDISS  1,K+1       FAMILY CATALOG ENTRY LINE ONE
 DFFM     LDIS   7,(FAMNAME) FAMILY NAME
 DFBS     LDIS   1,( )       BUSY FLAG
 DFSM     LDIS   8,(       0)  *MT/NT* SCRATCH COUNT
          LDIS   1,( )
 DFNM     LDIS   6,(------)  *MT/NT* NEXT SCRATCH VSN 
          LDIS   1,( )
 DFSC     LDIS   8,(       0)  *CT* SCRATCH COUNT 
          LDIS   1,( )
 DFNC     LDIS   6,(------)  *CT* NEXT SCRATCH VSN
          LDIS   1,( )
 DFSA     LDIS   8,(       0)  *AT* SCRATCH COUNT 
          LDIS   1,( )
 DFNA     LDIS   6,(------)  *AT* NEXT SCRATCH VSN
          LDISE 
 FAMB2    BSS    0
          LDISS  1,K         FAMILY CATALOG ENTRY LINE TWO
          LDIS   1,( )
 DFST     LDIS   40,(                                        )  STATUS
          LDISE 
 FAMBL    EQU    *-FAMB      FAMILY CATALOG ENTRY LINE LENGTH 
  
 NWIFD    EQU    FAMBL*NLPPG/LPEFC+FAMAL  NUMBER OF WORDS IN *FAM* DIS
 HEL      SPACE  4,10 
**        HEL - BUILD *HELP* DISPLAY. 
* 
*         EXIT   *HELP* DISPLAY SET INTO DISPLAY BUFFER.
* 
*         USES   X - 1, 2, 6. 
*                A - 1. 
* 
*         MACROS MOVE.
  
  
 HEL      SUBR               ENTRY/EXIT 
          SA1    PAG         GET PAGE NUMBER
          SA1    X1+HELA-1
          SX2    X1 
          AX1    18 
          MOVE   X1,X2,DBUF+DBUFS  SET *HELP* DISPLAY IN BUFFER 
          EQ     HELX        RETURN 
  
 HELA     BSS    0           LENGTHS AND POINTERS TO HELP DISPLAY PAGES 
          LOC    1
          VFD    24/0,18/HELBL,18/HELB  PAGE ONE
          LOC    *O 
  
 HELB     BSS    0           HELP DISPLAY PAGE ONE
          LDISS  1,NLPTT+2
          LDIS   4,(HELP) 
          LDISE 
          LDISS  20,K-1 
          LDIS   23,(DISPLAY VALID COMMANDS.) 
          LDISE 
          LDISS  1,K
          LDIS   3,(FAM)
          LDISE 
          LDISS  20,K-1 
          LDIS   43,(DISPLAY *TMS* FAMILY TAPE CATALOG STATUSES.) 
          LDISE 
          LDISS  1,K
          LDIS   4,(COPY) 
          LDISE 
          LDISS  20,K-1 
          LDIS   36,(COPY CURRENT DISPLAY TO OUTPUT FILE.)
          LDISE 
          LDISS  1,K
          LDIS   1,(+)
          LDISE 
          LDISS  20,K-1 
          LDIS   20,(TOGGLE PAGE FORWARD.)
          LDISE 
          LDISS  1,K
          LDIS   1,(-)
          LDISE 
          LDISS  20,K-1 
          LDIS   21,(TOGGLE PAGE BACKWARD.) 
          LDISE 
          LDISS  1,K
          LDIS   4,(END ) 
          LDISE 
          LDISS  20,K-1 
          LDIS   20,(TERMINATE *TMSDIS* .)
          LDISE 
          CON    0           END OF DISPLAY 
 HELBL    EQU    *-HELB      LENGTH OF HELP DISPLAY 
  
 NWIHD    EQU    HELBL       NUMBER OF WORDS IN *HELP* DISPLAY
          TITLE  SYSTEM STATUS SUBROUTINES. 
 CCB      SPACE  4,10 
**        CCB - CLEAR CATALOG BUFFER. 
* 
*         (A0) = ADDRESS OF CATALOG BUFFER. 
* 
*         EXIT   CATALOG BUFFER FIELDS SET TO ZERO. 
*                (TMSM) SET TO SIX HYPHENS. 
*                (TMSC) SET TO SIX HYPHENS. 
*                (TMSA) SET TO SIX HYPHENS. 
* 
*         MACROS CLEAR, MBSATA. 
  
  
 CCB      SUBR               ENTRY/EXIT 
          CLEAR  A0,SBUFE    CLEAR CATALOG BUFFER 
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSM,6*6,59,59  *MT/NT* SCRATCH
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSC,6*6,59,59  *CT* SCRATCH 
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSA,6*6,59,59  *AT* SCRATCH 
          EQ     CCBX        RETURN 
 CCS      SPACE  4,20 
**        CCS - CHECK CATALOG STATUS. 
* 
*         ENTRY  (A0) = ADDRESS OF CATALOG BUFFER.
*                (X4) = *CSCFA* IF CATALOG IS FAST-ATTACHED.
*                     = *CSCFB* IF CATALOG IS BUSY. 
* 
*         EXIT   ((A0)+0) = BIT 47 SET IF CATALOG IS BUSY.
*                (X4) = *CSERR* IF CATALOG ERROR. 
*                     = *CSNSV* IF NO SCRATCH VSNS OF ANY TYPE. 
*                     = *CSCFA* IF NO SPECIAL STATUS. 
*                (CCE) INCREMENTED IF CATALOG ERROR.
*                (CNSN) INCREMENTED IF NO *MT/NT* SCRATCH VSNS. 
*                (TMSM) SET TO SIX HYPHENS IF NO *MT/NT* SCRATCH VSNS.
*                (CNSC) INCREMENTED IF NO *CT* SCRATCH VSNS.
*                (TMSC) SET TO SIX HYPHENS IF NO *CT* SCRATCH VSNS. 
*                (CNSA) INCREMENTED IF NO *AT* SCRATCH VSNS.
*                (TMSA) SET TO SIX HYPHENS IF NO *AT* SCRATCH VSNS. 
* 
*         USES   X - 0, 1, 4, 6, 7. 
*                A - 1, 6.
* 
*         MACROS MBSATA, MBSXTA.
  
  
 CCS5     SA1    CCSB        CHECK TOTAL SCRATCH COUNT FOR FAMILY 
          NZ     X1,CCSX     IF SCRATCH VSN-S OF ANY TYPE FOUND 
          SX4    CSNSV       SET ERROR STATUS 
  
 CCS      SUBR               ENTRY/EXIT 
          SX6    X4-CSCFA 
          SX1    B0 
          ZR     X6,CCS1     IF CATALOG IS FAST-ATTACHED
          SX4    CSCFA
          SX1    B1+
 CCS1     MBSXTA X1,A0,1,0,47  SET/CLEAR CATALOG BUSY BIT 
          MX0    -24         CHECK *MT/NT* SCRATCH VSN COUNT
          SA1    A0+SBCWL+/TFM/TMSM 
          BX6    -X0*X1 
          SA6    CCSB 
          NZ     X6,CCS2     IF *MT/NT* SCRATCH VSNS
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSM,6*6,59,59  CLEAR VSN
          SA1    CNSM        COUNT OF FAMILIES WITH NO *MT/NT* SCRATCH
          SX6    X1+B1
          SA6    A1 
 CCS2     MX0    -24         CHECK *CT* SCRATCH VSN COUNT 
          SA1    A0+SBCWL+/TFM/TMSC 
          BX2    -X0*X1 
          SA1    CCSB        INCREMENT TOTAL SCRATCH COUNT
          IX6    X1+X2
          SA6    A1 
          NZ     X2,CCS3     IF *CT* SCRATCH VSNS 
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSC,6*6,59,59  CLEAR VSN
          SA1    CNSC        COUNT OF FAMILIES WITH NO *CT* SCRATCH 
          SX6    X1+B1
          SA6    A1 
 CCS3     MX0    -24         CHECK *AT* SCRATCH VSN COUNT 
          SA1    A0+SBCWL+/TFM/TMSA 
          BX2    -X0*X1 
          SA1    CCSB        INCREMENT TOTAL SCRATCH COUNT
          IX6    X1+X2
          SA6    A1 
          NZ     X2,CCS4     IF *AT* SCRATCH VSNS 
          MBSATA HYPHENS,A0+SBCWL+/TFM/TMSA,6*6,59,59  CLEAR VSN
          SA1    CNSA        COUNT OF FAMILIES WITH NO *AT* SCRATCH 
          SX6    X1+B1
          SA6    A1 
 CCS4     SX0    /TFM/FETS   CHECK FOR CATALOG ERROR
          SA1    A0+SBCWL+/TFM/TMFM 
          BX1    X0*X1
          ZR     X1,CCS5     IF NO CATALOG ERROR
          SA1    CCE         INCREMENT CATALOG ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          SX4    CSERR
          EQ     CCSX        RETURN 
  
  
 CCSB     CON    0           TOTAL SCRATCH COUNT FOR THIS FAMILY
 CNF      SPACE  4,10 
**        CNF - CHECK NON-FAST ATTACHED FILE STATUS.
* 
*         EXIT   CALL *CCS* IF CATALOG ERROR. 
*                CALL *CCB* IF NO CATALOG ERROR.
* 
*         USES   X - 0, 1.
*                A - 1. 
* 
*         CALLS  CCB, CCS.
  
  
 CNF1     RJ     CCB         CLEAR CATALOG BUFFER 
  
 CNF      SUBR               ENTRY/EXIT 
          SX0    /TFM/FETS   CHECK FOR CATALOG ERROR
          SA1    A0+SBCWL+/TFM/TMFM 
          BX1    X0*X1
          ZR     X1,CNF1     IF NO CATALOG ERROR
          SX4    CSCFA
          RJ     CCS         CHECK CATALOG STATUS 
          EQ     CNFX        RETURN 
 GCS      SPACE  4,20 
**        GCS - GET CATALOG STATUSES. 
* 
*         EXIT   CATALOG STATUS BUFFERS SET INTO *SBUF*.
*                FAMILY ORDINAL TABLE SET INTO *FBUF*.
*                FIRST CATALOG STATUS BUFFER ENTRY FOR EACH DISPLAY 
*                PAGE SET INTO *TFDP*.
*                WORD 0 OF EACH CATALOG STATUS BUFFER ENTRY SET - 
*T,       12/STATUS, 1/BUSY FLAG, 29/0, 18/ADDRESS OF NEXT ENTRY
*                (CCE) = NUMBER OF FAMILY CATALOGS WITH ERRORS. 
*                (CNS) = NUMBER OF FAMILY CATALOGS WITH NO SCRATCH. 
*                (TMS) = 0 IF *TMS* IS ACTIVE.
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 0, 1, 2, 4, 5, 6.
*                B - 2, 3.
* 
*         CALLS  ACF, SWP.
* 
*         MACROS CLEAR, MBSATA, MBSXTA, RDMEM, READ, READW, REWIND, 
*                RJM. 
  
  
 GCS13    SX6    B2          SET NUMBER OF PAGES
          SA6    TNDP+DISFC 
  
 GCS      SUBR               ENTRY/EXIT 
          CLEAR  TFCF,NFCST  PRESET POINTER TABLES
          CLEAR  TFCL,NFCST 
          CLEAR  TFDP,NPGFD  PRESET *TFDP*
          SX6    B0          CLEAR CATALOG STATUS COUNTS
          SA6    CCE
          SA6    CNSM 
          SA6    CNSC 
          SA6    CNSA 
          SA6    TNDP+DISFC 
          SYSTEM SFM,R,TMS,GTSF*100B  GET *TMS* STATUS
          MX0    1           SAVE *TMS* STATUS
          SA1    TMS
          BX1    X0*X1
          BX6    X0-X1
          SA6    TMS
          SA1    MXF         GET FAMILY ORDINAL TABLE 
          SA2    FFO
          RDMEM  ABS,X2,X1,FBUF 
          SA5    MXF         GET CATALOG SYSTEM BLOCKS
          SA0    SBUF 
 GCS1     SX5    X5-1 
          NG     X5,GCS5     IF END OF FAMILIES 
          MX0    42          GET FAMILY NAME
          SA1    X5+FBUF
          BX1    X0*X1
          SX4    CSFNF
          ZR     X1,GCS2     IF NO FAMILY NAME
          SX2    377777B
          RJ     SWP         SWAP TO FAMILY NAME AND USER INDEX 
          NZ     X4,GCS2     IF FAMILY NOT FOUND
          RJ     ACF         ATTACH CATALOG FILE
          NZ     X1,GCS2     IF CATALOG NOT ATTACHED
          SX6    X4          SAVE STATUS
          SA6    GCSB 
          REWIND P,R         GET SYSTEM BLOCK 
          READ   P,R
          MX0    -5          CHECK FOR ERROR
          SA1    P
          AX1    9
          BX1    -X0*X1 
          ZR     X1,GCS1.1   IF NO ERROR ON READ
          SX6    CSCNF       FLAG AS CATALOG FILE NOT FOUND 
          SA6    GCSB 
          EQ     GCS1.2      RETURN CATALOG FILE
  
 GCS1.1   READW  P,A0,SBUFE 
 GCS1.2   RETURN P
          SA4    GCSB        GET STATUS 
 GCS2     SA1    X4+TFCP
          RJM    X1          EXECUTE PROCESSOR FOR CATALOG STATUS 
          MBSATA X5+FBUF,A0+SBCWL+/TFM/TMFM,42,59,59  SET FAMILY NAME 
          MBSXTA X4,A0,12,11,59  SET CATALOG STATUS 
          MBSATA X4+TFCF,A0,18,17,17  LINK STATUS ENTRIES 
          SX1    A0 
          MBSXTA X1,X4+TFCF,18,17,17
          SA1    X4+TFCM
          ZR     X1,GCS3     IF USE MESSAGE BUFFER
          MBSATA X1,A0+SBCWL+/TFM/TMMB,/TFM/MBML*60,59,59  SET MESSAGE
 GCS3     SA1    X4+TFCL
          NZ     X1,GCS4     IF ALREADY A LAST ENTRY
          SX6    A0          SET LAST ENTRY 
          SA6    A1 
 GCS4     SA0    A0+SBUFE 
          EQ     GCS1        CHECK NEXT FAMILY
  
 GCS5     SA1    OFM         GET ORIGINAL FAMILY NAME 
          SA2    OUI
          RJ     SWP         SWAP TO FAMILY NAME AND USER INDEX 
          SA4    GCSA        LINK STATUS ENTRIES
 GCS6     ZR     X4,GCS10    IF END OF TABLE
          SA5    A4+B1
          SA2    X4 
          ZR     X2,GCS9     IF NO ENTRIES FOR THIS STATUS
          SA1    TFDP+0 
          NZ     X1,GCS7     IF FIRST ENTRY ALREADY SET 
          SA1    X4+TFCF-TFCL  SET FIRST ENTRY
          SX6    X1 
          SA6    TFDP+0 
 GCS7     ZR     X5,GCS10    IF END OF TABLE
          SA1    X5+TFCF-TFCL 
          NZ     X1,GCS8     IF ENTRIES FOR THIS STATUS 
          SA5    A5+B1
          EQ     GCS7        CHECK NEXT STATUS
  
 GCS8     MBSATA A1,X2,18,17,17  LINK STATUS ENTRIES
 GCS9     SA4    A5 
          EQ     GCS6        CHECK NEXT STATUS
  
 GCS10    SA5    TFDP+0      COUNT NUMBER FAMILY CATALOG ENTRIES
          SB2    B0          PRESET PAGE NUMBER 
          SB3    B0 
 GCS11    SX5    X5 
          ZR     X5,GCS13    IF END OF ENTRIES
          SB3    B3-LPEFC 
          PL     B3,GCS12    IF NOT END OF PAGE 
          SX6    X5          SET FIRST ENTRY OF PAGE
          SA6    B2+TFDP
          SB2    B2+B1       INCREMENT PAGE NUMBER
          SB3    NLPPG-1
 GCS12    SA5    X5 
          EQ     GCS11       CHECK NEXT ADDRESS 
  
 GCSA     BSS    0           TABLE OF CATALOG STATUS LINKS
          CON    CSERR+TFCL  CATALOG ERROR
          CON    CSNSV+TFCL  NO SCRATCH VSNS
          CON    CSCFA+TFCL  CATALOG FAST-ATTACHED
          CON    CSCFN+TFCL  CATALOG NOT FAST-ATTACHED
          CON    CSCNF+TFCL  CATALOG FILE NOT FOUND 
  
          CON    0           END OF TABLE 
  
 GCSB     CON    0           CATALOG STATUS 
          TITLE  INPUT/OUTPUT SUBROUTINES.
 GDI      SPACE  4,10 
**        GDI - GET *DISPLAY* INPUT.
* 
*         EXIT   (CBUF+1) = INPUT COMMAND.
* 
*         ERROR  ABORT WITH *L-DISPLAY NOT AVAILABLE*.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
* 
*         MACROS DSDINP, ABTMSG.
  
  
 GDI      SUBR               ENTRY/EXIT 
          SX6    CBUFL       SET BUFFER LENGTH
          LX6    48 
          SA6    CBUF 
          DSDINP A6          REQUEST L-DISPLAY INPUT
          SA1    CBUF        CHECK FOR ERRORS 
          SX2    X1-2*NERR-1
          ZR     X2,GDIX     IF NO ERROR
          SX2    X1-2*NCMD-1
          SX6    B0          PRESET COMMAND 
          SA6    CBUF+1 
          ZR     X2,GDIX     IF NO COMMAND ENTERED
          SX6    B1          FLAG L-DISPLAY ERROR 
          SA6    LDE
          ABTMSG DFLN        *L-DISPLAY NOT AVAILABLE.* 
 GIN      SPACE  4,10 
**        GIN - GET INPUT.
* 
*         ENTRY  (OPT) = INPUT OPTION.
* 
*         EXIT   INPUT PROCESSOR EXECUTED FOR OPTION. 
* 
*         USES   X - 1. 
*                A - 1. 
* 
*         MACROS RJM, WRITER. 
  
  
 GIN      SUBR               ENTRY/EXIT 
          SA1    TOU
          NZ     X1,GIN1     IF NOT TERMINAL OUTPUT 
          WRITER L,R         FLUSH BUFFER 
 GIN1     CLEAR  CBUF+1,CBUFL  CLEAR INPUT BUFFER 
          SA1    OPT         GET INPUT OPTION 
          SA1    X1+GINA
          RJM    X1          PROCESS INPUT
          EQ     GINX        RETURN 
  
 GINA     BSS    0           INPUT OPTION PROCESSORS
          LOC    0
 OPTLD    CON    GDI         DISPLAY
 OPTLN    CON    GLI         LINE 
 OPTSC    CON    GSI         SCREEN 
          LOC    *O 
 GLI      SPACE  4,10 
**        GLI - GET LINE INPUT. 
* 
*         EXIT   (CBUF+1) = INPUT COMMAND.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
* 
*         MACROS MBSATA, READC, REWIND. 
  
 GLI1     MBSATA ZEROES,I,15,17,17  CLEAR EOF 
  
 GLI      SUBR               ENTRY/EXIT 
          READC  I,CBUF+1,8  READ COMMAND LINE
          ZR     X1,GLIX     IF NOT EOR/EOF/EOI 
          SX6    B0          PRESET COMMAND 
          SA6    CBUF+1 
          SA1    TIN         CHECK FOR TERMINAL INPUT/OUTPUT
          SA2    TOU
          BX1    X1+X2
          ZR     X1,GLI1     IF BOTH TERMINAL INPUT AND OUTPUT
          SA1    =0LEND      SET TERMINATION COMMAND
          BX6    X1 
          SA6    CBUF+1 
          EQ     GLIX        RETURN 
 GSI      SPACE  4,10 
**        GSI - GET SCREEN INPUT. 
* 
*         EXIT   (CBUF+1) = INPUT COMMAND.
*                (SIA) = 0 IF INPUT REQUESTED.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
* 
*         CALLS  GLI. 
  
  
 GSI1     RJ     GLI         GET LINE INPUT 
          SX6    B0          CLEAR SCREEN INPUT AVAILABLE 
          SA6    SIA
  
 GSI      SUBR               ENTRY/EXIT 
          SA1    SIA
          NG     X1,GSI1     IF SCREEN INPUT AVAILABLE
          SX6    B0          SET NO COMMAND 
          SA6    CBUF+1 
          EQ     GSIX        RETURN 
 IDO      SPACE  4,10 
**        IDO - ISSUE *DISPLAY* OUTPUT. 
* 
*         EXIT   (DBUF) SENT TO L-DISPLAY.
* 
*         ERROR  ABORT WITH *L-DISPLAY NOT AVAILABLE*.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
* 
*         MACROS DSDOUT, ABTMSG.
  
  
 IDO      SUBR               ENTRY/EXIT 
          SX6    LDSY        SET BUFFER LENGTH
          LX6    48 
          SA6    DBUF 
          DSDOUT A6          REQUEST L-DISPLAY OUTPUT 
          SA1    DBUF        CHECK FOR ERRORS 
          SX2    X1-2*NERR-1
          ZR     X2,IDOX     IF NO ERROR
          SX6    B1          FLAG L-DISPLAY ERROR 
          SA6    LDE
          ABTMSG DFLN        *L-DISPLAY NOT AVAILABLE.* 
 ILO      SPACE  4,15 
**        ILO - ISSUE LINE OUTPUT.
* 
*         EXIT   (DBUF) COPIED TO OUTPUT FILE.
* 
*         USES   X - 1, 2.
*                A - 1. 
*                B - 6, 7.
* 
*         CALLS  CKD. 
* 
*         MACROS WRITEC.
  
  
 ILO      SUBR               ENTRY/EXIT 
          SA1    TOU         CHECK FOR TERMINAL OUTPUT
          SB7    B0 
          ZR     X1,ILO1     IF TERMINAL OUTPUT 
          WRITEC L,ILOA      DOUBLE SPACE 
          SB7    B1 
 ILO1     SX2    L           SET OUTPUT FILE ADDRESS
          SB6    DBUF 
          RJ     CKD         COPY K-DISPLAY TO OUTPUT FILE
          EQ     ILOX        RETURN 
  
 ILOA     DATA   C*0*        DOUBLE SPACE 
 IOU      SPACE  4,10 
**        IOU - ISSUE OUTPUT. 
* 
*         ENTRY  (OPT) = OUTPUT OPTION. 
* 
*         EXIT   OUTPUT PROCESSOR EXECUTED FOR OPTION.
* 
*         USES   X - 1. 
*                A - 1. 
* 
*         MACROS RJM. 
  
  
 IOU      SUBR               ENTRY/EXIT 
          SA1    OPT         GET OUTPUT OPTION
          SA1    X1+IOUA
          RJM    X1          PROCESS OUTPUT 
          EQ     IOUX        RETURN 
  
 IOUA     BSS    0           OUTPUT OPTION PROCESSORS 
          LOC    0
 DOPT     CON    IDO         DISPLAY
 LOPT     CON    ILO         LINE 
 SOPT     CON    ISO         SCREEN 
          LOC    *O 
 ISO      SPACE  4,10 
**        ISO - ISSUE SCREEN OUTPUT.
* 
*         EXIT   (DBUF) COPIED TO OUTPUT FILE.
* 
*         USES   X - 1, 2.
*                A - 1, 2.
* 
*         CALLS  ILO. 
* 
*         MACROS WRITEC.
  
  
 ISO      SUBR               ENTRY/EXIT 
          SA2    SIA
          SA1    ISOB 
          ZR     X2,ISO1     IF TERMINAL INPUT NOT AVAILABLE
          SX6    -B1         FLAG INPUT AVAILABLE 
          SA6    A2 
          SA1    ISOA 
 ISO1     MBSATA A1,DMIN,DMINC,59,DMINU  SET INPUT MESSAGE
          SA1    BEL         CHECK IF BELL IS REQUIRED
          SA2    CCE
          NZ     X2,ISO2     IF CATALOG ERRORS
          SA2    CNSM 
          NZ     X2,ISO2     IF CATALOGS WITH NO *MT/NT* SCRATCH
          SA2    CNSC 
          NZ     X2,ISO2     IF CATALOGS WITH NO *CT* SCRATCH 
          SA2    CNSA 
          NZ     X2,ISO2     IF CATALOGS WITH NO *AT* SCRATCH 
          SA2    COA
          NZ     X2,ISO2     IF JOBS REQUIRE OPERATOR ACTION
          SX1    2R 
 ISO2     MBSXTA X1,TOP,12,11,47  SET/CLEAR BELL
          WRITEC L,TOP       GO TO TOP OF SCREEN
          RJ     ILO         ISSUE LINE OUTPUT
          WRITEC L,CIN       CLEAR INPUT LINE 
          EQ     ISOX        RETURN 
  
 ISOA     DATA   50HENTER *HELP* FOR HELP.  ENTER *END* TO TERMINATE. 
 ISOB     DATA   50HISSUE *BREAK* TO ENTER INPUT. 
          TITLE  COMMON SUBROUTINES.
 ACF      SPACE  4,15 
**        ACF - ATTACH CATALOG FILE.
* 
*         EXIT   (X1) = 0 IF CATALOG ATTACHED.
*                     .NE. 0 IF CATALOG NOT ATTACHED. 
*                (X4) = CSCFA IF CATALOG FILE IS FAST-ATTACHED. 
*                     = CSCFB IF CATALOG FILE IS BUSY.
*                     = CSCFN IF CATALOG FILE IS NOT FAST-ATTACHED. 
*                     = CSCNF IF CATALOG FILE IS NOT FOUND. 
* 
*         USES   X - 0, 1, 6. 
*                A - 1, 6.
* 
*         MACROS ATTACH, CATLIST, MBSATA, SETFET. 
  
  
 ACF      SUBR               ENTRY/EXIT 
          SETFET P,(DTY=B0),(ERA=ACFB)  CLEAR DEVICE TYPE 
          MBSATA ZEROES,P,16,17,17  CLEAR ERROR CODE
          ATTACH P,,,,RM,,,IP,FA  ATTACH CATALOG FILE 
          MX0    -8          GET STATUS 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          SX4    CSCFA
          ZR     X1,ACFX     IF FILE ATTACHED 
          SX1    X1-/ERRMSG/FBS 
          SX4    CSCFB
          ZR     X1,ACF1     IF FILE BUSY 
          SX6    ZBUF        RESET BUFFER POINTERS
          SA6    P+2
          SA6    A6+B1
          MBSATA ZEROES,P,16,17,17  CLEAR ERROR CODE
          ATTACH P,,,,RM,,,IP,NF  ATTACH CATALOG FILE 
          MX0    -8          GET STATUS 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          SX4    CSCFN
          ZR     X1,ACFX     IF FILE FOUND
          SX1    X1-/ERRMSG/FBS  CHECK FOR FILE BUSY
          SX4    CSCFB
          ZR     X1,ACF1     IF FILE BUSY 
          SX4    CSCNF
 ACF1     SX1    B1          FLAG CATALOG NOT ATTACHED
          EQ     ACFX        RETURN 
  
 ACFB     BSS    4           *PFM* MESSAGE BUFFER 
 CLS      SPACE  4,15 
**        CLS - CHECK LINE MODE OUTPUT STATUS.
* 
*         ENTRY  (LNS) = 0 IF DO NOT FORCE LINE MODE OUTPUT.
*                      .NE. 0 IF FORCE LINE MODE OUTPUT.
* 
*         EXIT   (X6) = 0 IF FORCE OUTPUT.
*                     .NE. 0 IF DO NOT FORCE OUTPUT.
*                (LNS) = 0. 
* 
*         USES   X - 1. 
*                A - 1, 6.
  
  
 CLS      SUBR               ENTRY/EXIT 
          SA1    OPT         CHECK INPUT/OUTPUT OPTION
          SX1    X1-OPTLN 
          SX6    B0 
          NZ     X1,CLSX     IF NOT LINE MODE 
          SA1    LNS         GET LINE MODE OUTPUT STATUS
          SA6    A1 
          NZ     X1,CLSX     IF FORCE OUTPUT
          SX6    B1 
          EQ     CLSX        RETURN 
 CLY      SPACE  4,15 
**        CLY - CONVERT LINE NUMBER TO Y-COORDINATE.
* 
*         ENTRY  (X0) = FWA OF L-DISPLAY LINE.
*                (X1) = DISPLAY LINE NUMBER.
* 
*         EXIT   Y-COORDINATE SET INTO BYTE 1 OF L-DISPLAY LINE.
* 
*         USES   X - 2, 6.
*                A - 2. 
* 
*         MACROS MBSXTA.
  
  
 CLY      SUBR               ENTRY/EXIT 
          SX6    15          PRESET Y-COORDINATE INCREMENT
          SA2    CON
          ZR     X2,CLY1     IF NOT 721 CONSOLE 
          SX6    10          RESET Y-COORDINATE INCREMENT 
          SX2    7726B-7707B
 CLY1     SX2    X2+7707B 
          IX6    X1*X6       COMPUTE Y-COORDINATE 
          IX6    X2-X6
          MBSXTA X6,X0,12,11,47  SET Y-COORDINATE 
          EQ     CLYX        RETURN 
 CUP      SPACE  4,15 
**        CUP - CLEAN UP PROGRAM. 
* 
*         EXIT   TAPE CATALOG FILE RETURNED.
*                INPUT AND OUTPUT FILES RETURNED IF SCREEN MODE.
*                SWAPPED BACK TO ORIGINAL FAMILY NAME AND USER INDEX. 
*                L-DISPLAY CLEARED IF L-DISPLAY MODE. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  IDO, SWP.
* 
*         MACROS DSDINP, MBSATA, RETURN, WRITER.
  
  
 CUP      SUBR               ENTRY/EXIT 
          MBSATA (=1),P,1,0,0  RETURN TAPE CATALOG FILE 
          RETURN P,R
          SA1    OPT         CHECK FOR SCREEN MODE
          SX1    X1-OPTSC 
          NZ     X1,CUP1     IF NOT SCREEN MODE 
          MBSATA (=1),I,1,0,0  RETURN TERMINAL INPUT
          RETURN I
          MBSATA (=1),L,1,0,0  RESET CURSOR POSITIONING 
          WRITEC L,CPY
          WRITEC L,CSL       CLEAR SCREEN 
          WRITER L,R
          RETURN L           RETURN TERMINAL OUTPUT 
          EQ     CUP2        RETURN TO ORIGINAL FAMILY/USER INDEX 
  
 CUP1     WRITER L,R         FLUSH OUTPUT BUFFER
 CUP2     SA1    OFM         GET ORIGINAL FAMILY NAME 
          SA2    OUI
          RJ     SWP         SWAP TO FAMILY NAME AND USER INDEX 
          SA1    OPT         CHECK FOR L-DISPLAY
          SX1    X1-OPTLD 
          NZ     X1,CUPX     IF NOT L-DISPLAY MODE
          SA1    LDE
          NZ     X1,CUPX     IF L-DISPLAY ERROR 
          SX6    B0          CLEAR L-DISPLAY BUFFER 
          SA6    DBUF+1 
          RJ     IDO         ISSUE L-DISPLAY OUTPUT 
          SA1    LDE
          NZ     X1,CUPX     IF L-DISPLAY ERROR 
          SX6    CBUFL       SET BUFFER LENGTH
          LX6    48 
          SA6    CBUF 
          DSDINP A6,C        CLEAR L-DISPLAY INTERLOCK
          SA1    CBUF        CHECK FOR ERROR
          SX6    X1-2*NERR-1
          ZR     X6,CUPX     IF NO ERROR
          SA6    LDE         FLAG L-DISPLAY ERROR 
          EQ     CUPX        RETURN 
 RDM      SPACE  4,20 
**        RDM - READ MEMORY INTO BUFFER.
* 
*         ENTRY  (X1) = ADDRESS OF BUFFER TO RECEIVE DATA.
*                (X2) = ADDRESS TO READ DATA FROM.
*                (X3) = NUMBER OF WORDS TO READ.
*                (X4) = 0 IF READ FROM ABSOLUTE ADDRESS.
*                     .LT. 0 IF READ FROM CONTROL POINT ADDRESS.
*                     = SUBSYSTEM IDENTIFIER IF READ FROM SUBSYSTEM 
*                       FIELD LENGTH. 
* 
*         EXIT   (X1) .LT. 0 IF TRANSFER COMPLETE.
*                     .GE. 0 IF ERROR.
*                (X2) = CONTENTS OF FIRST WORD OF DATA. 
* 
*         USES   X - 4, 6.
*                A - 2, 6.
* 
*         CALLS  RSB=.
  
  
 RDM      SUBR               ENTRY/EXIT 
          SX6    X1          SAVE BUFFER ADDRESS
          SA6    RDMA 
          MX6    1           PRESET ABSOLUTE READ PARAMETERS
          PL     X4,RDM1     IF NOT CONTROL POINT READ
          SX4    B0          SET CONTROL POINT READ PARAMETERS
          SX6    X2 
 RDM1     SA6    X1          SET READ TYPE
          RJ     RSB=        READ SUBSYSTEM BLOCK 
          PL     X1,RDMX     IF TRANSFER ERROR
          SA2    RDMA        GET FIRST WORD OF DATA 
          SA2    X2 
          EQ     RDMX        RETURN 
  
 RDMA     BSS    1           ADDRESS OF BUFFER
 STL      SPACE  4,15 
**        STL - SEARCH TABLE WITH DEFINED LENGTH. 
* 
*         ENTRY  (B2) = FWA OF TABLE TO SEARCH. 
*                (B3) = LENGTH OF TABLE TO SEARCH.
*                (B6) = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY. 
*                (B7) = LENGTH OF TABLE ENTRY.
*                (X0) = SEARCH MASK.
*                (X1) = VALUE TO SEARCH FOR.
* 
*         EXIT   (X6) = 0 IF VALUE FOUND. 
*                (A2) = ADDRESS OF WORD WITH VALUE. 
*                (X2) = IMAGE OF WORD WITH VALUE. 
* 
*         USES   B - 2, 3.
  
  
 STL      SUBR               ENTRY/EXIT 
          SB3    B2+B3       SET LWA+1 OF TABLE 
          SX6    B1 
 STL1     GE     B2,B3,STLX  IF ENTRY NOT FOUND 
          SA2    B2+B6       COMPARE ENTRY WITH VALUE 
          BX6    X1-X2
          BX6    X0*X6
          ZR     X6,STLX     IF ENTRY FOUND 
          SB2    B2+B7
          EQ     STL1        CHECK NEXT ENTRY 
 STZ      SPACE  4,15 
**        STZ - SEARCH TABLE TERMINATED BY A ZERO WORD. 
* 
*         ENTRY  (B2) = FWA OF TABLE TO SEARCH. 
*                (B6) = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY. 
*                (B7) = LENGTH OF TABLE ENTRY.
*                (X0) = SEARCH MASK.
*                (X1) = VALUE TO SEARCH FOR.
* 
*         EXIT   (X6) = 0 IF VALUE FOUND. 
*                (A2) = ADDRESS OF WORD WITH VALUE. 
*                (X2) = IMAGE OF WORD WITH VALUE. 
* 
*         USES   B - 2. 
  
  
 STZ      SUBR               ENTRY/EXIT 
          SA2    B2          GET FIRST ENTRY
          SB2    B7-B6
          SX6    B1 
 STZ1     ZR     X2,STZX     IF ENTRY NOT FOUND 
          SA2    A2+B6       COMPARE ENTRY WITH VALUE 
          BX6    X1-X2
          BX6    X0*X6
          ZR     X6,STZX     IF ENTRY FOUND 
          SA2    A2+B2
          EQ     STZ1        CHECK NEXT ENTRY 
 SWP      SPACE  4,15 
**        SWP - SWAP FAMILY AND USER INDEX. 
* 
*         ENTRY  (X1) = FAMILY NAME TO SWAP TO. 
*                (X2) = USER INDEX TO SWAP TO.
* 
*         EXIT   (X4) = 0 IF FAMILY FOUND.
*                     = CSFNF IF FAMILY NOT FOUND.
* 
*         USES   X - 0, 1, 6. 
*                A - 1, 6.
* 
*         MACROS SETPFP 
  
  
 SWP      SUBR               ENTRY/EXIT 
          MX0    42          SET FAMILY NAME IN *SETPFP* BLOCK
          SX6    11B
          BX1    X0*X1
          BX6    X1+X6
          SA6    SWPA+0 
          BX6    -X0*X2      SET USER INDEX IN *SETPFP* BLOCK 
          SA6    SWPA+2 
          SETPFP SWPA        CHANGE FAMILY NAME AND USER INDEX
          MX0    -6          GET STATUS 
          SA1    SWPA+0 
          AX1    12 
          BX4    -X0*X1 
          ZR     X4,SWPX     IF SWAP COMPLETE 
          SX4    CSFNF
          EQ     SWPX        RETURN 
  
 SWPA     BSS    3           *SETPFP* BLOCK 
 VIP      SPACE  4,15 
**        VIP - VERIFY INCREMENT PARAMETER. 
* 
*         ENTRY  (PAR) = ADDRESS OF INCREMENT PARAMETER IN STRING 
*                        BUFFER.
* 
*         EXIT   (PAR) = ADDRESS OF NEXT PARAMETER IN STRING BUFFER.
*                (X6) = INCREMENT IF VALID. 
*                (X5) = 0 IF VALID INCREMENT. 
*                     = *CSII* IF INCORRECT INCREMENT.
* 
*         USES   X - 1, 7.
*                A - 1, 6, 7. 
*                B - 5, 6, 7. 
* 
*         CALLS  DXB, POP.
  
  
 VIP1     SX5    B0          FLAG VALID PARAMETER 
          NZ     X6,VIPX     IF NON-ZERO INCREMENT
          SX6    B1          RESET INCREMENT
  
 VIP      SUBR               ENTRY/EXIT 
          SA1    PAR
          SX5    CSII        *INCORRECT INCREMENT*
          ZR     X1,VIPX     IF NO NEXT PARAMETER 
          SB6    X1 
          RJ     POP         PICK OUT PARAMETER 
          SX7    B6          SAVE NEXT PARAMETER ADDRESS
          SA7    PAR
          SX5    CSII        *INCORRECT INCREMENT*
          NG     B5,VIPX     IF BUFFER EXHAUSTED
          SB5    B5-B1
          GE     B5,VIPX     IF PARAMETER TOO LARGE 
          ZR     X6,VIP1     IF NO INCREMENT
          BX5    X6 
          SB7    B1 
          RJ     DXB         CONVERT DISPLAY TO BINARY
          SX5    CSII        *INCORRECT INCREMENT*
          NZ     X4,VIPX     IF CONVERSION ERROR
          EQ     VIP1        FLAG VALID PARAMETER 
 VNP      SPACE  4,10 
**        VNP - VERIFY NO MORE PARAMETERS.
* 
*         ENTRY  (PAR) = ADDRESS OF NEXT PARAMETER IN STRING BUFFER.
* 
*         EXIT   (X5) = 0 IF NO MORE PARAMETERS.
*                     = *CSTM* IF MORE PARAMETERS.
* 
*         USES   X - 1. 
*                A - 1. 
  
  
 VNP      SUBR               ENTRY/EXIT 
          SA1    PAR         CHECK NEXT PARAMETER 
          SX5    CSTM        *TOO MANY PARAMETERS*
          NZ     X1,VNPX     IF MORE PARAMETERS 
          SX5    B0          FLAG NO PARAMETERS 
          EQ     VNPX        RETURN 
 COMMON   SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCOD 
*CALL     COMCCDD 
*CALL     COMCCIO 
 CCKD     BSS    0           STARTING ADDRESS OF *COMCCKD*
 CKDL$    EQU    NLPDS       MAXIMUM NUMBER OF LINES IN DISPLAY 
 CKDY$    EQU    7672B       DEFINE INITIAL Y-COORDINATE
*CALL     COMCCKD 
 CCKDL    EQU    *-CCKD      LENGTH OF *COMCCKD 
*CALL     COMCCPM 
*CALL     COMCDXB 
*CALL     COMCMBS 
*CALL     COMCMVE 
*CALL     COMCPFM 
*CALL     COMCPOP 
*CALL     COMCRDC 
*CALL     COMCRDW 
*CALL     COMCRSB 
*CALL     COMCSFN 
*CALL     COMCUSB 
*CALL     COMCSYS 
*CALL     COMCWTC 
*CALL     COMCWTH 
*CALL     COMCWTW 
*CALL     COMCZTB 
          TITLE  BUFFER AREA. 
 BUFFERS  SPACE  4,10 
**        BUFFERS THAT CANNOT OVERWRITE *PRESET*. 
  
  
          USE    BUFFERS     DEFINE LITERALS
  
 ZBUF     BSS    ZBUFL       TAPE CATALOG FILE BUFFER 
 DBUF     BSS    0           L-DISPLAY OUTPUT BUFFER
          VFD    12/DBUFL    BUFFER LENGTH
          VFD    1/0         SMALL CHARACTERS 
          VFD    1/0         PROGRAM FORMAT 
          VFD    1/0         SINGLE SPACING 
          VFD    45/0 
          LDISS  1,1         FIRST LINE OF TITLE
          LDIS   25,(TMSDIS.                  ) 
 DTTS     LDIS   14,( TMS ENABLED. )  *TMS* STATUS
 DTDS     LDIS   4,(HELP)    CURRENT DISPLAY
          LDIS   14,( DISPLAY PAGE )
 DTPN     LDIS   1,(1)       CURRENT PAGE NUMBER
          LDIS   4,( OF ) 
 DTPC     LDIS   1,(1)       PAGE COUNT 
          LDIS   1,(.)
          LDISE 
          LDISS  1,K         THIRD LINE OF TITLE
          LDIS   21,(CATALOGS WITH ERRORS=) 
 DTCE     LDIS   2,( 0)      NUMBER OF CATALOGS WITH ERRORS 
          LDIS   34,(.  CATALOGS WITH NO MT/NT SCRATCH=)
 DTNM     LDIS   2,( 0)      NUMBER OF CATALOGS WITH NO *MT/NT* SCRATCH 
          LDIS   1,(.)
          LDISE 
          LDISS  1,K         FOURTH LINE OF TITLE 
          LDIS   28,(CATALOGS WITH NO CT SCRATCH=)
 DTNC     LDIS   2,( 0)      NUMBER OF CATALOGS WITH NO *CT* SCRATCH
          LDIS   31,(.  CATALOGS WITH NO AT SCRATCH=) 
 DTNA     LDIS   2,( 0)      NUMBER OF CATALOGS WITH NO *AT* SCRATCH
          LDIS   1,(.)
          LDISE 
          LDISS  1,NLPDS+1-NLPMS  FIRST LINE OF MESSAGE 
 DMIN     LDIS   49,(ENTER *HELP* FOR HELP.  ENTER *END* TO TERMINATE.) 
          LDISE 
          LDISS  1,K         SECOND LINE OF MESSAGE 
 DMMA     LDIS   30,(                  LAST COMMAND)
          LDIS   3,( - )
 DMCM     LDIS   30,(                              )
          LDISE 
 DBUFS    EQU    *-DBUF      LENGTH OF START OF DISPLAY BUFFER
  
          ERRNG  DBUFL-DBUFS-NWIFD  *FAM* DISPLAY OVERFLOW
          ERRNG  DBUFL-DBUFS-NWIHD  *HELP* DISPLAY OVERFLOW 
  
 BUFF     BSS    0           FWA OF OVERWRITTEN BUFFER AREA 
          BSS    DBUFL-DBUFS REMAINDER OF DISPLAY BUFFER
  
          ERRNZ  *-DBUF-DBUFL  DISPLAY BUFFER MISMATCH
  
          CON    0           END OF DISPLAY BUFFER
 BUFFERS  SPACE  4,10 
**        BUFFERS THAT CAN OVERWRITE *PRESET*.
  
  
 CBUF     BSS    1           COMMAND BUFFER 
          BSS    CBUFL
 FBUF     BSS    FBUFL       FAMILY ORDINAL TABLE BUFFER
 IBUF     BSS    IBUFL       INPUT FILE BUFFER
 LBUF     BSS    LBUFL       OUTPUT FILE BUFFER 
 SBUF     BSS    SBUFL       CATALOG SYSTEM BLOCKS BUFFER 
 TFCF     BSS    NFCST       TABLE OF FAMILY CATALOG FIRST ENTRIES
 TFCL     BSS    NFCST       TABLE OF FAMILY CATALOG LAST ENTRIES 
 TFDP     BSS    NPGFD       TABLE OF FAMILY CATALOG DISPLAY PAGES
 BUFFL    EQU    *-BUFF      LENGTH OF BUFFER AREA
          TITLE  PRESET AREA. 
          SPACE  4
          ORG    BUFF 
 FETS     SPACE  4,10 
**        *STATUS* FET. 
  
  
 Z        BSS    0           *STATUS* FET 
 Z555555  FILEB  0,0,(FET=5)
 TARG     SPACE  4,10 
**        TARG - TABLE OF COMMAND ARGUMENTS.
  
  
 TARG     BSS    0           TABLE OF COMMAND ARGUMENTS 
 ID       ARG    ID,ID,400B  INITIAL DISPLAY
 OP       ARG    OP,OP,400B  INPUT/OUTPUT MODE
 I        ARG    I,I,400B    INPUT FILE 
 L        ARG    L,L,400B    OUTPUT FILE
 NOBELL   ARG    (-=2R  ),BEL  NO BELL OPTION 
 WT       ARG    WT,WT,400B  WAITING TIME 
          CON    0           END OF TABLE 
 TOPT     SPACE  4,10 
**        TOPT - TABLE OF VALID INPUT/OUTPUT OPTIONS. 
  
  
 TOPT     BSS    0           TABLE OF VALID INPUT/OUTPUT OPTIONS
          LOC    0
 OPTLD    VFD    42/0LL,18/OPTLD  L-DISPLAY MODE
 OPTLN    VFD    42/0LLINE,18/OPTLN  LINE MODE
 OPTSC    VFD    42/0LSCREEN,18/OPTSC  SCREEN MODE
          LOC    *O 
 TOPTL    EQU    *-TOPT      LENGTH OF TABLE
 TDIS     SPACE  4,10 
**        TDIS - TABLE OF VALID DISPLAY DIRECTIVES. 
  
  
 TDIS     BSS    0           TABLE OF VALID DISPLAY DIRECTIVES. 
          VFD    42/0LFAM,18/DISFC  FAMILY CATALOG DISPLAY
          VFD    42/0LHELP,18/DISHP  HELP DISPLAY 
 TDISL    EQU    *-TDIS      LENGTH OF TABLE
 TTSC     SPACE  4,10 
**        TTSC - TABLE OF TERMINAL SCREEN CHARACTERS. 
* 
*         ENTRY  ONE WORD PER TERMINAL TYPE.
*T,       VFD    24/ , 12/ BCHAR, 12/ CCHAR, 12/ TCHAR
* 
*                BCHAR = BELL CHARACTER 
*                CCHAR = CLEAR SCREEN CHARACTER.
*                TCHAR = TOP OF SCREEN CHARACTER. 
  
  
 TTSC     BSS    0           TABLE OF TOP OF SCREEN CHARACTERS
          LOC    0
          VFD    24/,12/2R^*,12/2R  ,12/2R    NO SCREEN MODE
          VFD    24/,12/2R  ,12/2R  ,12/2R    RESERVED
          VFD    24/,12/2R^*,12/2R^=,12/2R^?  CDC 721 
          VFD    24/,12/2R^*,12/2R^',12/2R    CDC 722 
          VFD    24/,12/2R^*,12/2R  ,12/2R    DEC VT100 
          VFD    24/,12/2R^*,12/2R  ,12/2R    Z19 OR H19
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          VFD    24/,12/2R  ,12/2R  ,12/2R    UNDEFINED 
          ERRNZ  *-40B       INCORRECT TABLE SIZE 
          LOC    *O 
 WORKING  SPACE  4,10 
**        PRESET WORKING STORAGE. 
  
  
 DF       DATA   C*"DEFRN"*  DEFAULT WAITING TIME NON-SYSTEM ORIGIN 
 GP       BSS    3           *GETPFP* BLOCK 
 ID       DATA   C*HELP*     INITIAL DISPLAY
 OP       DATA   C*L*        INPUT/OUTPUT MODE
 PI       BSS    1           PARAMETER IMAGE
 RT       CON    10          CATALOG ATTACH RETRY COUNT 
 WT       DATA   C*"DEFRS"*  WAITING TIME 
 PRS      SPACE  4,10 
**        PRS - PRESET PROGRAM. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          MX0    1           SET THE REAL-TIME BIT IN TAPE CATALOG FET
          SA1    P+1
          LX0    43-59+60 
          BX6    X0+X1
          SA6    A1 
          GETPFP GP          GET FAMILY NAME, USER NAME, AND USER INDEX 
          MX0    42          SAVE ORIGINAL FAMILY NAME
          SA1    GP+0 
          BX6    X0*X1
          SA6    OFM
          SA1    GP+2        SAVE ORIGINAL USER INDEX 
          BX6    -X0*X1 
          SA6    OUI
          RJ     GSF         GET SCRATCH FILE NAME
          SX1    3           SET LOCAL FILE NAME FOR CATALOG FILE 
          BX6    X6+X1
          SA6    P
          REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          MX0    -12         CHECK ORIGIN TYPE
          SA1    JOPR 
          AX1    24 
          BX6    -X0*X1 
          SA6    JOT
          SX6    X6-SYOT
          ZR     X6,PRS5     IF SYSTEM ORIGIN 
          SX6    X6+SYOT-IAOT 
          SX5    X6 
 PRS1     RJ     ACF         ATTACH CATALOG FILE
          SX4    X4-CSCFA 
          ZR     X4,PRS2     IF FILE ATTACHED 
          SX4    X4-CSCFB+CSCFA 
          NZ     X4,PRS3     IF NOT FILE BUSY 
          NZ     X5,PRS1.1   IF NOT INTERACTIVE ORIGIN
          SA1    RT          DECREMENT RETRY COUNT
          SX6    X1-1 
          SA6    A1 
          NG     X6,PRS3     IF RETRY COUNT EXHAUSTED 
 PRS1.1   ROLLOUT  =1 
          EQ     PRS1        RETRY ATTACH 
  
 PRS2     REWIND P,R         GET SYSTEM BLOCK 
          READ   P,R
          MX0    -5          CHECK FOR ERROR
          SA1    P
          AX1    9
          BX1    -X0*X1 
          NZ     X1,PRS3     IF ERROR ON READ 
          READW  P,PRSA,SBCWL+/TFM/TMUN+/TFM/UNCL 
          RETURN P,R
          MX0    42          CHECK FOR VALID USER NAME
          SA1    GP+2 
          SRCHTAB  X1,PRSA+SBCWL+/TFM/TMUN,0,1,/TFM/UNCL
          ZR     X6,PRS4     IF VALID USER NAME 
 PRS3     RETURN P,R
          ABTMSG DFIC        *INCORRECT COMMAND.* 
  
 PRS4     SX6    -1          DISABLE L-DISPLAY MODE 
          SA6    TOPT+OPTLD 
          SA1    TOPT+OPTLN  SWITCH TO LINE MODE DEFAULT
          BX6    X1 
          SA6    OP 
          SA1    DF          RESET DEFAULT WAITING TIME 
          BX6    X1 
          SA6    WT 
          SA1    JOT         CHECK ORIGIN TYPE
          SX1    X1-IAOT
          ZR     X1,PRS6     IF INTERACTIVE ORIGIN
 PRS5     SX6    -1          DISABLE SCREEN MODE
          SA6    TOPT+OPTSC 
 PRS6     RJ     GTC         GET TERMINAL CHARACTERISTICS 
          MX0    -12         GET ORDER DEPENDENT ARGUMENTS
          SA1    ACTR        GET ARGUMENT COUNT 
          SB4    X1 
          SA4    ARGR        GET FIRST ARGUMENT 
          SB5    TARG        GET FWA OF ARGUMENT TABLE
 PRS7     ZR     B4,PRS14    IF END OF ARGUMENTS
          SA2    B5          CHECK FOR EQUIVALENCED ARGUMENTS 
          LX2    59-47
          NG     X2,PRS12    IF END OF EQUIVALENCED ARGUMENTS 
          SX2    X4          CHECK FOR EQUIVALENCED ARGUMENT
          SX2    X2-1R= 
          ZR     X2,PRS12    IF END OF ORDER DEPENDENT ARGUMENTS
          SB4    B4-B1       DECREMENT ARGUMENT COUNT 
          SA2    B5          GET TABLE ENTRY
          ZR     X2,PRS13    IF END OF TABLE
          BX6    X0*X4       SAVE ARGUMENT
          SA4    A4+B1
          SB2    X2          GET ADDRESS TO RECEIVE ARGUMENT
          LX2    12          GET OPTION POINTER 
          BX3    -X0*X2 
          LX2    18          GET ASSUMED VALUE
          SB3    X2 
          LX2    12          GET *0* STATUS 
          BX2    -X0*X2 
          SX3    X3-77B      CHECK FOR TWO CHARACTER ARGUMENT 
          SB5    B5+B1
          NZ     X3,PRS8     IF TWO CHARACTER ARGUMENT
          SB5    B5+B1
 PRS8     NZ     X6,PRS9     IF ARGUMENT SPECIFIED
          SA1    B3          GET DEFAULT ARGUMENT 
          BX6    X1 
 PRS9     SX2    X2-4000B 
          ZR     X2,PRS10    IF DISPLAY *0* ALLOWED 
          SX1    1R0
          LX1    54 
          BX1    X6-X1
          NZ     X1,PRS10    IF NOT DISPLAY *0* 
          SX6    B0 
 PRS10    MX2    42 
          NZ     X6,PRS11    IF NON-ZERO ARGUMENT 
          MX2    60 
 PRS11    SA1    B2          SET VALUE FOR ARGUMENT 
          BX1    -X2*X1 
          BX6    X6+X1
          SA6    A1 
          EQ     PRS7        CHECK NEXT ARGUMENT
  
 PRS12    RJ     ARG         PROCESS ORDER INDENPENDENT ARGUMENTS 
          ZR     X1,PRS14    IF VALID ARGUMENTS 
 PRS13    MX0    42          SET INCORRECT PARAMETER IN MESSAGE 
          BX1    X0*X4
          SB2    1R$
          SB3    DFUP 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          ABTMSG DFUP        *UNKNOWN PARAMETER - PPPPPPP.* 
  
 PRS14    MX0    42          CHECK INITIAL DISPLAY PARAMETER
          SA1    ID 
          SRCHTAB  X1,TDIS,0,1,TDISL
          SX7    2RID 
          LX7    48 
          NZ     X6,PRS18    IF VALUE NOT FOUND 
          BX6    -X0*X2 
          SA6    DIS         SET INITIAL DISPLAY VALUE
          MX0    42          CHECK INPUT/OUTPUT MODE
          SA1    OP 
          SRCHTAB  X1,TOPT,0,1,TOPTL
          SX7    2ROP 
          LX7    48 
          NZ     X6,PRS18    IF VALUE NOT FOUND 
          BX6    -X0*X2 
          SA6    OPT         SET INPUT/OUTPUT MODE
          SA5    WT          CHECK WAITING TIME 
          SB7    -B1
          RJ     DXB         CONVERT DISPLAY TO BINARY
          SA1    WT 
          SX7    2RWT 
          LX7    48 
          NZ     X4,PRS18    IF INCORRECT WAITING TIME
          SX1    X6-10000B
          NG     X1,PRS16    IF LESS THAN THE MAXIMUM 
          SX6    7777B
 PRS16    SA1    OPT         CHECK FOR LINE MODE
          SX1    X1-OPTLN 
          NZ     X1,PRS17    IF NOT LINE MODE 
          SX6    B0 
 PRS17    SA6    ROT         SET ROLLOUT TIME 
          ZR     X6,PRS19    IF NO ROLLOUT TIME 
          SA1    OPT
          SX1    X1-OPTLD 
          NZ     X1,PRS19    IF NOT DISPLAY MODE
          SX1    LINE        SET EVENT DESCRIPTOR FOR ROLLOUT 
          MBSXTA X1,ROT,12,11,23
          EQ     PRS20       CHECK FOR TERMINAL INPUT 
  
 PRS18    SA7    PI          SAVE PARAMETER IMAGE 
          SB2    1R$         SET VALUE IMAGE IN MESSAGE 
          SB3    DFIV 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          SA1    PI          SET PARAMETER IMAGE IN MESSAGE 
          SB2    1R#
          SB3    DFIV 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          ABTMSG DFIV        *INCORRECT VALUE FOR PP PARAMETER - VVVV.* 
  
 PRS19    SA1    OPT         CHECK FOR SCREEN MODE
          SX1    X1-OPTSC 
          NZ     X1,PRS20    IF NOT SCREEN MODE 
          SX4    2RTT        SET DEVICE TYPE
          SETFET I,(DTY=X4) 
          RJ     GSF         GET SCRATCH FILE NAME
          SX1    B1          SET SCRATCH FILE NAME INTO INPUT FET 
          BX6    X6+X1
          SA6    I
          REQUEST  A6,TT,NOMSG  ASSIGN INPUT FILE TO TERMINAL 
          SX4    2RTT        SET DEVICE TYPE
          SETFET L,(DTY=X4) 
          RJ     GSF         GET SCRATCH FILE NAME
          SX1    B1          SET SCRATCH FILE NAME INTO OUTPUT FET
          BX6    X6+X1
          SA6    L
          REQUEST  A6,TT,NOMSG  ASSIGN OUTPUT FILE TO TERMINAL
 PRS20    SX2    I
          RJ     STF         SET TERMINAL FILE
          SA6    TIN         SAVE TERMINAL INPUT STATUS 
          SX2    L
          RJ     STF         SET TERMINAL FILE
          SA6    TOU         SAVE TERMINAL OUTPUT STATUS
          CSET   NORMAL      SET 6-BIT CHARACTER SET
          RDMEM  ABS,FOTP,1,FFO  GET FAMILY ORDINAL TABLE ADDRESS 
          MX0    -24
          LX2    24 
          BX6    -X0*X2 
          SA6    FFO
          MX0    -12         GET MAXIMUM FOT ENTRIES
          LX2    12 
          BX6    -X0*X2 
          SA6    MXF
          SA1    OPT         CHECK INPUT/OUTPUT MODE
          SX1    X1-OPTLD 
          NZ     X1,PRSX     IF NOT L-DISPLAY 
          CSTATUS  CON       GET CONSOLE TYPE 
          SA1    CON
          ZR     X1,PRSX     IF NOT 721 CONSOLE 
          MOVE   PRSBL,PRSB,CCKD  REWRITE COMMON DECK *COMCCKD* 
          SX3    KDL
          RJ     PRK         PROCESS K-DISPLAY
          EQ     PRSX        RETURN 
  
 PRSA     BSS    SBCWL+/TFM/TMUN+/TFM/UNCL  CATALOG WORKING BUFFER
 PRSB     BSS    0           IMAGE OF *COMCCKD* FOR 721 CONSOLE 
          LOC    CCKD 
          QUAL   PRSB 
 QUAL$    EQU    1           QUALIFY COMMON DECK
 CKDI$    EQU    10          DEFINE Y-COORDINATE INCREMENT
 CKDY$    EQU    7714B       DEFINE INITIAL Y-COORDINATE
*CALL     COMCCKD 
          QUAL   *
 PRSBL    EQU    *-CCKD      LENGTH OF *COMCCKD*
          LOC    *O 
          ERRNZ  CKD-/PRSB/CKD  COMMON DECK ENTRY MISMATCH
          ERRNZ  CCKDL-PRSBL COMMON DECK LENGTH MISMATCH
 GSF      SPACE  4,10 
**        GSF - GET SCRATCH FILE NAME.
* 
*         EXIT   (X6) = UNASSIGNED SCRATCH FILE NAME. 
* 
*         USES   X - 1, 4, 6. 
*                A - 1, 6.
* 
*         MACROS PDATE, STATUS. 
  
  
 GSF4     SX1    B1          SET FILE NAME IN FET 
          BX6    X6+X1
          SA6    Z
          STATUS Z           CHECK FILE STATUS
          SX6    7776B
          SA1    Z
          BX6    X6*X1
          NZ     X6,GSF1     IF FILE EXISTS 
          MX6    42          GET FILE NAME
          BX6    X6*X1
  
 GSF      SUBR               ENTRY/EXIT 
 GSF1     SA1    GSFA 
          NZ     X1,GSF2     IF BINARY NUMBER EXISTS
          SA1    GSFC        SET INITIAL BINARY 
          BX6    X1 
          SA6    GSFA 
          PDATE  GSFB        GET PACKED DATE AND TIME 
          MX6    -6          RANDOMIZE BINARY 
          SA1    GSFB 
          BX6    -X6*X1 
          LX6    15 
          SA1    GSFA 
          BX6    X1-X6
          SA6    A1 
          BX1    X6 
 GSF2     SX6    B1          RESET BINARY 
          IX6    X1-X6
          SA6    A1 
  
*         CONVERT BINARY TO FILE NAME.
  
          SX6    B0 
 GSF3     ZR     X1,GSF4     IF END OF BINARY 
          MX4    -5          CONVERT 5 BINARY BITS TO 6 BIT CHARACTER 
          BX4    -X4*X1 
          SX4    X4+B1
          BX6    X6+X4
          LX6    -6+60
          AX1    5
          EQ     GSF3        GET NEXT CHARACTER CODE
  
 GSFA     CON    0           BINARY NUMBER
 GSFB     CON    0           PACKED DATE AND TIME 
 GSFC     CON    317777777777B
 GTC      SPACE  4,10 
**        GTC - GET TERMINAL CHARACTERISTICS. 
* 
*         EXIT   (BEL) = BELL CHARACTER IN BITS 11 - 0. 
*                (CSL) = CLEAR SCREEN CHARACTER IN BITS 47 - 36.
*                (TOP) = TOP OF SCREEN CHARACTER IN BITS 35 - 24. 
* 
*         USES   X - 0, 1, 4. 
*                A - 1. 
* 
*         MACROS MBSATA, SETSLM.
  
  
 GTC      SUBR               ENTRY/EXIT 
          SA1    JOT         CHECK IF INTERACTIVE 
          SX1    X1-IAOT
          ZR     X1,GTCX     IF NOT INTERACTIVE ORIGIN TYPE 
          SETSLM GTCA        GET TERMINAL MODEL 
          MX0    -5 
          SA1    GTCA 
          BX4    -X0*X1 
          MBSATA X4+TTSC,BEL,12,35,11  SET BELL CHARACTER 
          MBSATA X4+TTSC,CSL,12,23,47  SET CLEAR SCREEN CHARACTER 
          MBSATA X4+TTSC,TOP,12,11,35  SET TOP OF SCREEN CHARACTER
          EQ     GTCX        RETURN 
  
 GTCA     BSS    1           TERMINAL MODEL WORD
 COMMON   SPACE  4,10 
**        PRESET COMMON DECKS.
  
  
*CALL     COMCARG 
*CALL     COMCDCP 
 KDL      BSS    0           TABLE OF L-DISPLAY LINES 
 KDL      HERE
 PRK      HERE
*CALL     COMCLFM 
*CALL     COMCSFM 
*CALL     COMCSNM 
*CALL     COMCSTF 
          TITLE  *TMSON* AND *TMSOFF* PROGRAM AREA. 
          SPACE  4,10 
          QUAL   TMSON
 FBUF     IFLT   *,FBUF+FBUFL 
          BSS    FBUF+FBUFL-*  PREVENT OVERWRITE BY FAMILY TABLE BUFFER 
 FBUF     ENDIF 
 FETS     SPACE  4,10 
**        FETS. 
  
  
 TF       BSS    0           *TMS* CATALOG FET FOR *TFM*
 "TMFC"   FILEB  0,0,(FET=16),EPR 
 TARG     SPACE  4,10 
**        TARG - TABLE OF COMMAND ARGUMENTS.
  
  
 TARG     BSS    0           TABLE OF COMMAND ARGUMENTS 
 FM       ARG    FM,FM,400B  FAMILY NAME
 TARGN    BSS    0
*         CON    0           END OF TABLE FOR *TMSOFF*
 DEFTO    ARG    DT,DT,400B  DEFAULT *TO* FOR NON-*SYOT*
 DEFTOS   ARG    DS,DS,400B  DEFAULT *TO* FOR *SYOT*
          CON    0           END OF TABLE 
 TDEF     SPACE  4,10 
**        TDEF - TABLE OF *TO* ARGUMENT OPTIONS.
  
  
 TDEF     BSS    0           TABLE OF *TO* ARGUMENT OPTIONS 
          VFD    18/58,12/0,30/1RF  BIT POSITION 0, CLEAR BIT, *TO=F* 
          VFD    18/58,12/1,30/1RT  BIT POSITION 0, SET BIT, *TO=T* 
          VFD    18/56,12/0,30/1RE  BIT POSITION 1, CLEAR BIT, *TO=E* 
          VFD    18/56,12/1,30/1RC  BIT POSITION 1, SET BIT, *TO=C* 
          CON    0           END OF TABLE 
 TDES     SPACE  4,10 
**        TDES - TABLE OF *TO* ARGUMENT OPTIONS FOR SYOT JOBS.
  
  
 TDES     BSS    0           TABLE OF *TO* ARGUMENT OPTIONS 
          VFD    18/57,12/0,30/1RF  BIT POSITION 0, CLEAR BIT, *TO=F* 
          VFD    18/57,12/1,30/1RT  BIT POSITION 0, SET BIT, *TO=T* 
          VFD    18/55,12/0,30/1RE  BIT POSITION 1, CLEAR BIT, *TO=E* 
          VFD    18/55,12/1,30/1RC  BIT POSITION 1, SET BIT, *TO=C* 
          CON    0           END OF TABLE 
 WORKING  SPACE  4,10 
**        WORKING STORAGE.
  
  
 DS       CON    0           *TO* FOR SYSTEM ORIGIN 
 DT       CON    0           *TO* FOR NON-SYSTEM ORIGIN 
 FM       CON    0           FAMILY NAME
 PPC      CON    0           PP CHECK FLAG FET ADDRESS
 PPS      CON    0           PP ERROR FLAG
 SSI      CON    0           SUBSYSTEM ID 
 TM       CON    0           *TMSON* FLAG 
 TMSOFF   SPACE  4,10 
**        TMSOFF - MAIN PROGRAM.
  
  
 TMSOFF   SB1    1           ENTRY
          SX6    B0          CLEAR *DEFTO* AND *DEFTOS* ARGUMENTS 
          SA6    TARGN
          RJ     PRS         PRESET PROGRAM 
          SA1    FM 
          ZR     X1,END      IF NO FAMILY CATALOGS TO DELETE
          SX6    X1-1 
          ZR     X6,TMF1     IF DELETE ALL FAMILY CATALOGS
          MX0    42          FIND FAMILY IN TABLE 
          SA5    MXF
          SRCHTAB  X1,FBUF,0,1,X5 
          RJ     DCF         DELETE FAMILY CATALOG
          ZR     X3,END      IF CATALOG DELETED 
          SX3    X3-2 
          SX5    DFFN        *FAMILY NOT FOUND.*
          ZR     X3,ABT      IF FAMILY NOT FOUND
          SX5    B0 
          EQ     ABT         ABORT PROGRAM
  
 TMF1     SA5    MXF         GET CATALOG SYSTEM BLOCKS
 TMF2     SX5    X5-1 
          NG     X5,END      IF END OF FAMILIES 
          MX0    42          GET FAMILY NAME
          SA1    X5+FBUF
          RJ     DCF         DELETE FAMILY CATALOG FILE 
          EQ     TMF2        CHECK NEXT FAMILY
 TMSON    SPACE  4,10 
**        TMSON - MAIN ROUTINE. 
  
  
 TMSON    SB1    1           ENTRY
          SX6    B1          FLAG *TMSON* 
          SA6    TM 
          RJ     PRS         PRESET PROGRAM 
          SA1    FM 
          ZR     X1,TMN3     IF NO FAMILY CATALOGS TO INITIALIZE
          SX6    X1-1 
          ZR     X6,TMN1     IF INITIALIZE ALL FAMILY CATALOGS
          MX0    42          FIND FAMILY IN TABLE 
          SA5    MXF
          SRCHTAB  X1,FBUF,0,1,X5 
          RJ     ICF         INITIALIZE FAMILY CATALOG FILE 
          ZR     X3,TMN3     IF CATALOG INITIALIZED 
          SX1    X3-2 
          SX5    DFFN        *FAMILY NOT FOUND.*
          ZR     X3,ABT      IF FAMILY NOT FOUND
          SX5    B0 
          EQ     ABT         ABORT PROGRAM
  
 TMN1     SA5    MXF         GET CATALOG SYSTEM BLOCKS
 TMN2     SX5    X5-1 
          NG     X5,TMN3     IF END OF FAMILIES 
          MX0    42          GET FAMILY NAME
          SA1    X5+FBUF
          RJ     ICF         INITIALIZE FAMILY CATALOG FILE 
          EQ     TMN2        CHECK NEXT FAMILY
  
 TMN3     SA1    SSI         CHECK SUBSYSTEM ID 
          SX1    X1-MTSI
          NZ     X1,END      IF NOT *MAGNET* SUBSYSTEM
          MX6    1           SET *TMS* SYSTEM STATUS BITS 
          SA1    TMS
          BX6    X6+X1
          SA6    TMS
          SYSTEM TFU,R,TMS,/TFU/STSF*100B  CALL *TFU* 
          EQ     END         TERMINATE PROGRAM
 ABT      SPACE  4,15 
**        ABT - ABORT PROGRAM.
* 
*         ENTRY  (X5) = ADDRESS OF DAYFILE MESSAGE. 
* 
*         EXIT   MESSAGE ISSUED TO USER AND SYSTEM DAYFILES.
*                PROGRAM ABORTED. 
* 
*         USES   X - 1, 2.
*                A - 1, 2.
* 
*         CALLS  SWP. 
* 
*         MACROS ABORT, MESSAGE, RETURN.
  
  
 ABT      BSS    0           ENTRY
          MBSATA (=3),P,18,17,17  SET FET COMPLETION BIT
          RETURN P,R         RETURN CATALOG FILE
          SA1    OFM         GET ORIGINAL FAMILY NAME/USER INDEX
          SA2    OUI
          RJ     SWP         SWAP TO FAMILY NAME/USER INDEX 
          ZR     X5,ABT1     IF NO DAYFILE MESSAGE
          MESSAGE  X5,0,R    ISSUE DAYFILE MESSAGE
 ABT1     ABORT              ABORT PROGRAM
 DCF      SPACE  4,20 
**        DCF - DELETE FAMILY CATALOG FILE. 
* 
*         ENTRY  (X1) = FAMILY NAME.
* 
*         EXIT   (X3) = 0 IF FILE IS DELETED. 
*                     = 1 IF FILE CANNOT BE DELETED.
*                     = 2 IF FAMILY NOT FOUND.
*                MESSAGE *DFUF* ISSUED TO DAYFILE IF (X3) = 1.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 3, 6, 7.
*                B - 2, 3, 5. 
* 
*         CALLS  SWP. 
* 
*         MACROS ATTACH, DFAT, MBSATA, MBSXTA, RETURN, SETFET.
  
  
 DCF2     RETURN P,R         RETURN FILE
          SA3    DCFB        GET STATUS 
  
 DCF      SUBR               ENTRY/EXIT 
          MX0    42          SAVE FAMILY NAME 
          BX6    X0*X1
          SA6    DCFA 
          SX3    B1+B1
          ZR     X6,DCFX     IF NO FAMILY NAME
          SX2    377777B
          RJ     SWP         SWAP TO FAMILY NAME AND USER INDEX 
          SX3    B1+B1
          NZ     X4,DCFX     IF FAMILY NOT FOUND
          SX6    B0          PRESET FILE STATUS 
          SA6    DCFB 
          MBSATA ZEROES,P,16,17,17  CLEAR ERROR CODE
          SETFET P,(DTY=B0),(ERA=ACFB)
          ATTACH P,,,,W,,,IP,FA  ATTACH SYSTEM FILE 
          MX0    -8          CHECK ERROR CODE 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          NZ     X1,DCF1     IF ERROR IN ACCESS 
          SX6    B0          CLEAR PP ERROR FLAG
          SA6    PPS
          SX6    P           SET PP CHECK FLAG
          SA6    PPC
          SX1    B1          SET IGNORE FAMILY ACTIVITY 
          MBSXTA X1,P,1,0,9 
          DFAT   P           DELETE FAST-ATTACHED STATUS
          SA3    PPS
          NZ     X3,DCF1     IF UNABLE TO DELETE FILE 
          EQ     DCF2        RETURN FILE
  
 DCF1     SX6    B1          FLAG UNABLE TO DELETE FILE 
          SA6    DCFB 
          SA1    DCFA        SET FAMILY NAME IN MESSAGE 
          SB2    1R#
          SB3    DCFC 
          SB5    -DFUF
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DCFC,0,R  *UNABLE TO TURN OFF *TMS* CATALOG* 
          EQ     DCF2        RETURN FILE
  
 DCFA     BSS    1           FAMILY NAME
 DCFB     CON    0           FILE STATUS
 DCFC     DATA   C$ UNABLE TO TURN OFF *TMS* CATALOG FOR #######.$
 END      SPACE  4,10 
**        END - TERMINATE PROGRAM.
* 
*         EXIT   PROGRAM TERMINATED.
* 
*         USES   X - 1, 2.
*                A - 1, 2.
* 
*         CALLS  SWP. 
* 
*         MACROS ENDRUN, RETURN.
  
  
 END      BSS    0           ENTRY
          RETURN P,R         RETURN CATALOG FILE
          SA1    OFM         GET ORIGINAL FAMILY NAME/USER INDEX
          SA2    OUI
          RJ     SWP         SWAP TO FAMILY NAME/USER INDEX 
          ENDRUN             TERMINATE PROGRAM
 ICF      SPACE  4,20 
**        ICF - INITIALIZE FAMILY CATALOG FILE. 
* 
*         ENTRY  (X1) = FAMILY NAME.
* 
*         EXIT   (X3) = 0 IF FILE IS INITIALIZED. 
*                     = 1 IF FILE CANNOT BE INITIALIZED.
*                     = 2 IF FAMILY NOT FOUND.
*                MESSAGE *DFUN* ISSUED IF (X3) = 1. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 3, 6, 7.
*                B - 2, 3, 5. 
* 
*         CALLS  SWP. 
* 
*         MACROS ATTACH, DFAT, ENFA, MBSATA, RETURN, SETFET, SYSTEM.
  
  
 ICF4     RETURN P,R         RETURN FILE
          SA3    ICFB        GET STATUS 
  
 ICF      SUBR               ENTRY/EXIT 
          MX0    42          SAVE FAMILY NAME 
          BX6    X0*X1
          SA6    ICFA 
          SX3    B1+B1
          ZR     X6,ICFX     IF NO FAMILY NAME
          SX2    377777B
          RJ     SWP         SWAP TO FAMILY NAME AND USER INDEX 
          SX3    B1+B1
          NZ     X4,ICFX     IF FAMILY NOT FOUND
 ICF0.1   BSS    0
          SX6    B0          PRESET FILE STATUS 
          SA6    ICFB 
          SX6    ICFC        SET *TFM* ERROR MESSAGE ADDRESS
          SA6    TF+/TFM/TFEA 
          MBSATA ZEROES,P,16,17,17  CLEAR ERROR CODE
          SETFET P,(DTY=B0),(ERA=ACFB)
          ATTACH P,,,,W,,,IP,NF  ATTACH SYSTEM FILE 
          MX0    -8          CHECK ERROR CODE 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          ZR     X1,ICF0.2   IF NO ERROR
          SX0    X1-/ERRMSG/PFA 
          NZ     X0,ICF1     IF NOT UTILITY ACTIVE
          ROLLOUT  =10       WAIT 10 SECONDS
          EQ     ICF0.1      RETRY ATTACH 
  
 ICF0.2   BSS    0
          SX1    /TFM/ISFS*10B+4  SET *TFM* SUBFUNCTION 
          MBSXTA X1,TF,9,8,8
          SX7    10000B      SET INITIALIZE VSNS
          SA7    TF+/TFM/TFES 
          SX6    B0          CLEAR PP ERROR FLAG
          SA6    PPS
          SX6    TF          SET PP CHECK FLAG
          SA6    PPC
          SYSTEM TFM,R,TF,/TFM/SSJF*100B  CALL *TFM* TO INTIALIZE FILE
          SA3    PPS
          NZ     X3,ICF3     IF ERROR FROM *TFM*
          MX0    -9          CHECK *TFM* ERROR CODE 
          SA1    TF 
          AX1    9
          BX1    -X0*X1 
          NZ     X1,ICF3     IF ERROR FROM *TFM*
          SX6    B0          CLEAR PP ERROR FLAG
          SA6    PPS
          SX6    P           SET PP CHECK FLAG
          SA6    PPC
          ENFA   P,GLOBAL    ENTER GLOBAL FAST ATTACH FILE
          SA3    PPS
          NZ     X3,ICF3     IF UNABLE TO ENTER FAST ATTACH FILE
          EQ     ICF4        RETURN FILE
  
 ICF1     SX1    X1-/ERRMSG/FBS 
          NZ     X1,ICF3     IF NOT *FILE BUSY* 
          ATTACH P,,,,W,,,IP,FA  ATTEMPT FAST ATTACH
          MX0    -8          CHECK ERROR CODE 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          ZR     X1,ICF4     IF ALREADY FAST ATTACHED ON THIS MACHINE 
          SX6    B0          CLEAR PP ERROR FLAG
          SA6    PPS
          SX6    P           SET PP CHECK FLAG
          SA6    PPC
          ENFA   P,LINK      LINK TO EXISTING FAST ATTACH 
          SA3    PPS
          NZ     X3,ICF3     IF UNABLE TO ENTER FAST ATTACH FILE
          ATTACH P,,,,W,,,IP,FA  ATTACH FILE
          MX0    -8          CHECK ERROR CODE 
          SA1    P
          AX1    10 
          BX1    -X0*X1 
          NZ     X1,ICF3     IF ERROR IN ACCESS 
          SX1    /TFM/ISFS*10B  SET FUNCTION CODE 
          MBSXTA X1,TF,9,8,8
          SX7    20000B      SET TO CLEAR CURRENT AND DOWN MACHINES 
          SA7    TF+/TFM/TFES 
          SX6    B0          CLEAR PP ERROR FLAG
          SA6    PPS
          SX6    TF          SET PP CHECK FLAG
          SA6    PPC
          SYSTEM TFM,R,TF,/TFM/SSJF*100B  CLEAN UP CATALOG
          SA3    PPS
          NZ     X3,ICF2     IF ERROR FROM *TFM*
          MX0    -9          CHECK *TFM* ERROR CODE 
          SA1    TF 
          AX1    9
          BX1    -X0*X1 
          ZR     X1,ICF4     IF NO ERROR FROM *TFM* 
 ICF2     SX6    P           SET PP CHECK FLAG
          SA6    PPC
          DFAT   P           DELETE FAST ATTACH CATALOG FILE
 ICF3     SX6    B1          FLAG UNABLE TO ATTACH FILE 
          SA6    ICFB 
          SA1    ICFA        SET FAMILY NAME IN MESSAGE 
          SB2    1R#
          SB3    ICFD 
          SB5    -DFUN
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  ICFD,0,R  *UNABLE TO TURN ON *TMS* CATALOG*
          EQ     ICF4        RETURN FILE
  
 ICFA     BSS    1           FAMILY NAME
 ICFB     CON    0           FILE STATUS
 ICFC     BSS    4           *TFM* ERROR MESSAGE BUFFER 
 ICFD     DATA   C$ UNABLE TO TURN ON *TMS* CATALOG FOR #######.$ 
 PRS      SPACE  4,10 
**        PRS - PRESET PROGRAM. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          MX0    1           SET THE REAL-TIME BIT IN TAPE CATALOG FET
          SA1    P+1
          LX0    43-59+60 
          BX6    X0+X1
          SA6    A1 
          GETPFP GP          GET FAMILY NAME, USER NAME, AND USER INDEX 
          MX0    42          SAVE ORIGINAL FAMILY NAME
          SA1    GP+0 
          BX6    X0*X1
          SA6    OFM
          SA1    GP+2        SAVE ORIGINAL USER INDEX 
          BX6    -X0*X1 
          SA6    OUI
          SA1    TF          SET FILE NAME
          BX6    X1 
          SA6    P
          MX0    -12         CHECK ORIGIN TYPE
          SA1    JOPR 
          AX1    24 
          BX6    -X0*X1 
          SX6    X6-SYOT
          SX5    DFIC        *INCORRECT COMMAND.* 
          NZ     X6,ABT      IF NOT SYSTEM ORIGIN 
          SYSTEM SFM,R,TMS,GTSF*100B  GET *TMS* STATUS
          GETSSID  SSI       GET SUBSYSTEM ID 
          SA1    SSI         CHECK FOR MAGNET SUBSYSTEM 
          SX1    X1-MTSI
          ZR     X1,PRS1     IF *MAGNET* SUBSYSTEM
          SA1    TM 
          ZR     X1,PRS1     IF *TMSOFF*
          SA1    TMS         CHECK IF *TMS* IS ENABLED
          SX5    DFIC        *INCORRECT COMMAND.* 
          PL     X1,ABT      IF *TMS* IS DISABLED 
          SX6    B0          CLEAR *DEFTO* AND *DEFTOS* ARGUMENTS 
          SA6    TARGN
 PRS1     SA1    ACTR        GET ARGUMENT COUNT 
          SB4    X1 
          ZR     B4,PRS5     IF NO ARGUMENTS
          SA4    ARGR        GET FIRST ARGUMENT 
          SB5    TARG 
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRS2     IF VALID ARGUMENTS 
          MX0    42          SET INCORRECT PARAMETER IN MESSAGE 
          BX1    X0*X4
          SB2    1R$
          SB3    DFUP 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          SX5    DFUP        *UNKNOWN PARAMETER - PPPPPPP.* 
          EQ     ABT         ABORT PROGRAM
  
 PRS2     SX6    B0          RESET *DEFTO* AND *DEFTOS* ARGUEMENTS
          SA6    TMS
          MX0    42          CHECK *DEFTO*
          SA1    DT 
          ZR     X1,PRS3     IF *DEFTO* NOT SPECIFIED 
          SB2    DT 
          RJ     USB         UNPACK STRING BUFFER 
          SX6    B0          FLAG LAST OPTION 
          SA6    B7+B1
          SA1    B6          GET FIRST COMMAND OPTION 
          MX0    -12
          SA3    TMS         GET DEFAULT OPTIONS
          BX7    X3 
 PRS2.1   ZR     X1,PRS2.4   IF NO MORE OPTIONS 
          SA2    TDEF        GET FIRST OPTION IN TABLE
 PRS2.2   ZR     X2,PRS2.5   IF UNKNOWN OPTION
          BX6    -X0*X2 
          BX6    X6-X1
          ZR     X6,PRS2.3   IF OPTIONS MATCH 
          SA2    A2+B1
          EQ     PRS2.2      CHECK NEXT OPTION IN TABLE 
  
 PRS2.3   LX2    18          GET SHIFT COUNT
          SB2    X2 
          LX2    12          GET SET/CLEAR STATUS 
          BX2    -X0*X2 
          SX6    B1 
          LX2    B2          SET/CLEAR DEFAULT OPTION 
          LX6    B2 
          BX7    -X6*X7 
          BX7    X7+X2
          SA1    A1+B1
          EQ     PRS2.1      CHECK NEXT OPTION ON COMMAND 
  
 PRS2.4   SA7    A3          SET DEFAULT TAPE OPTION
          EQ     PRS3        CHECK *DEFTOS* 
  
 PRS2.5   SA1    =0LDEFTO    GET PARAMETER IMAGE
          BX7    X1 
          SA1    DT 
          EQ     PRS4        ISSUE ERROR MESSAGE
  
 PRS3     MX0    42          CHECK *DEFTOS* 
          SA1    DS 
          ZR     X1,PRS5     IF *DEFTOS* NOT SPECIFIED
          SB2    DS 
          RJ     USB         UNPACK STRING BUFFER 
          SX6    B0          FLAG LAST OPTION 
          SA6    B7+B1
          SA1    B6          GET FIRST COMMAND OPTION 
          MX0    -12
          SA3    TMS         GET DEFAULT OPTIONS
          BX7    X3 
 PRS3.1   ZR     X1,PRS3.4   IF NO MORE OPTIONS 
          SA2    TDES        GET FIRST OPTION IN TABLE
 PRS3.2   ZR     X2,PRS3.5   IF UNKNOWN OPTION
          BX6    -X0*X2 
          BX6    X6-X1
          ZR     X6,PRS3.3   IF OPTIONS MATCH 
          SA2    A2+B1
          EQ     PRS3.2      CHECK NEXT OPTION IN TABLE 
  
 PRS3.3   LX2    18          GET SHIFT COUNT
          SB2    X2 
          LX2    12          GET SET/CLEAR STATUS 
          BX2    -X0*X2 
          SX6    B1 
          LX2    B2          SET/CLEAR DEFAULT OPTION 
          LX6    B2 
          BX7    -X6*X7 
          BX7    X7+X2
          SA1    A1+B1
          EQ     PRS3.1      CHECK NEXT OPTION ON COMMAND 
  
 PRS3.4   SA7    A3          SET DEFAULT TAPE OPTION
          EQ     PRS5        CHECK *FM* 
  
 PRS3.5   SA1    =0LDEFTOS   GET PARAMETER IMAGE
          BX7    X1 
          SA1    DS 
 PRS4     SA7    PI          SAVE PARAMETER IMAGE 
          SB2    1R$         SET VALUE IMAGE IN MESSAGE 
          SB3    DFIV 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          SA1    PI          SET PARAMETER IMAGE IN MESSAGE 
          SB2    1R#
          SB3    DFIV 
          SB5    -B3
          RJ     SNM         SET NAME IN MESSAGE
          SX5    DFIV        *INCORRECT VALUE FOR PP PARAMETER - VVVV.* 
          EQ     ABT         ABORT PROGRAM
  
 PRS5     SA1    FM          CHECK *FM* 
          SA2    =1L* 
          BX1    X1-X2
          NZ     X1,PRS6     IF NOT ALL FAMILIES
          SX6    B1          FLAG ALL FAMILIES
          SA6    A1 
 PRS6     RDMEM  ABS,FOTP,1,FFO  GET FAMILY ORDINAL TABLE ADDRESS 
          MX0    -24
          LX2    24 
          BX6    -X0*X2 
          SA6    FFO
          MX0    -12         GET MAXIMUM FOT ENTRIES
          LX2    12 
          BX7    -X0*X2 
          SA7    MXF
          RDMEM  ABS,X6,X7,FBUF  GET FAMILY ORDINAL TABLE 
          REPRIEVE  RPVA,SET,237B  SET EXTENDED REPRIEVE
          EQ     PRSX        RETURN 
 RPV      SPACE  4,15 
**        RPV - REPRIEVE PROCESSOR. 
* 
*         ENTRY  (PPC) = 0 IF ABORT ON PP ERROR.
*                      = FET ADDRESS IF DO NOT ABORT ON PP ERROR. 
* 
*         EXIT   (PPC) = 0. 
*                (PPS) .NE. IF PP ERROR.
*                COMPLETION BIT SET IN PP ERROR FET.
* 
*         USES   X - 0, 1, 5, 6.
*                A - 1, 6.
* 
*         CALLS  ABT. 
* 
*         MACROS REPRIEVE.
  
  
 RPV      BSS    0           ENTRY/EXIT 
          MX0    -12         CHECK ERROR FLAG 
          SA1    RPVA+/COMSRPV/OSEF 
          BX1    -X0*X1 
          SX1    X1-PPET
          SX5    B0 
          NZ     X1,ABT      IF NOT PP CALL ERROR 
          SA1    PPC
          ZR     X1,ABT      IF NOT PP CHECK
          SX6    B0          CLEAR PP CHECK FLAG
          SA6    A1 
          SX6    B1          SET PP ERROR FLAG
          SA6    PPS
          MX0    42          SET COMPLETION BIT IN FET
          SA1    X1 
          BX1    X0*X1
          SX6    3
          BX6    X1+X6
          SA6    A1 
          REPRIEVE  RPVA,RESUME,237B  RESUME PROGRAM EXECUTION
  
 RPVA     RPVBLK RPV         REPRIEVE BLOCK 
          SPACE  4,10 
          QUAL   *
 TMSOFF   EQU    /TMSON/TMSOFF  *TMSOFF* ENTRY POINT
 TMSON    EQU    /TMSON/TMSON  *TMSON* ENTRY POINT
          TITLE  FIELD LENGTH DEFINITIONS.
 RFL      SPACE  4,10 
**        FIELD LENTH DEFINITION. 
  
  
 RFL      IFGT   BUFF+BUFFL,* 
 RFL=     EQU    BUFF+BUFFL  PROGRAM FIELD LENGTH 
 RFL      ELSE
 RFL=     EQU    *           PROGRAM FIELD LENGTH 
 RFL      ENDIF 
          SPACE  4
          END 
