IDENT  TAF,TFWA,PRE
          ABS
          SST    CMBL,CPAL,FNTL,PSTP,TSSC,SSJN
          SYSCOM B1
*COMMENT  TAFNAM - TRANSACTION EXECUTIVE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 
          LIST   X
*CALL COMKTAF
          LIST   -X
          TITLE  "PROD" - TRANSACTION EXECUTIVE - VER "VERT".
 
***       TAF - TRANSACTION FACILITY.
*
*         J. R. HOGUE.       1971.      *TRANEX*.
*         F. R. SUTTON.      74/04/26.  TASK ROLLOUT FEATURES.
*         J. R. HOGUE.       74/04/26.
*         L. A. BOELTER.     75/01/26.  *TOTAL* DATA MANAGER INTERFACE.
*         G. W. PROPP.       75/06/01.  TIME/EVENT ROLL ENHANCEMENT.
*         G. W. PROPP.       75/10/01.  *TAF*.
*         J. R. HOGUE.       75/10/01.
*         M. M. CHEN.        77/04/01.  INTERACTIVE VIRTUAL TERMINAL.
*         G. W. PROPP.       78/10/11.  *CRM* DATA MANAGER INTERFACE.
*         M. M. CHEN.        80/01/01.  *CDCS* DATA MANAGER INTERFACE.
*         S. M. KEEFER.      80/03/01.  POTENTIALLY BLOCKED TASKS.
*         G. W. PROPP.       80/05/15.  *TAF* AUTOMATIC RECOVERY.
*         S. M. KEEFER.      80/06/01.  TRANSACTION UNIT PROCESSING.
*         D. A. BONDE.       80/06/10.  BATCH CONCURRENCY.
          SPACE  4,10
***       TAF.
*
*         TAF PROVIDES FOR THE ORDERLY CONTROL AND EXECUTION OF
*         TASKS WITHIN THE NETWORK OPERATING SYSTEM.
*
*         TRANSACTIONS IN TAF ARE PROCESSED BY APPLICATION
*         PROGRAMS (TASKS) RUNNING AT SUBCONTROL POINTS,
*         CONTAINED WITHIN TAF-S FIELD LENGTH.
*         A TRANSACTION IS A STRING (GROUP) OF CHARACTERS RECEIVED
*         FROM THE COMMUNICATION EXECUTIVE VIA AN INTER CONTROL POINT
*         TRANSFER. THE TRANSACTION DATA IS EXTRACTED FROM A
*         RECEIVING BUFFER, AND PLACED IN A MESSAGE BLOCK. THIS BLOCK
*         IS THE PHYSICAL REPRESENTATION OF THE TRANSACTION AND
*         REMAINS ASSOCIATED WITH THE TRANSACTION THROUGHOUT ITS
*         LIFE IN THE SYSTEM. WHEN THE TRANSACTION IS COMPLETED THE
*         BLOCK IS FREED FOR USE BY OTHER TRANSACTIONS.
*             A TASK IS THE ABSOLUTE BINARY CODE GENERATED FROM AN
*         APPLICATION PROGRAM. EACH TASK RUNS WITH ITS OWN EXCHANGE
*         PACKAGE, REFERENCE ADDRESS (RELATIVE TO TRANEX), AND
*         FIELD LENGTH (A SUBSET OF TRANEX-S FIELD LENGTH). THUS IT
*         CAN RESIDE IN ANY CONTIGUOUS SEGMENT WITHIN TRANEX-S FIELD
*         LENGTH. TASK CORE IS ALLOCATED IN 100B WORD BLOCKS LOCATED
*         ON EVEN 100B WORD BOUNDARIES (EG. 32100 TO 32200). A SUB
*         CONTROL POINT CONSISTS OF 1 100B BLOCK OF CORE FOR SYSTEM USE
*         FOLLOWED BY SUFFICIENT 100B BLOCKS TO CONTAIN AN ENTIRE TASK.
*             TRANEX CAN RUN UP TO 31 SUB CONTROL POINTS SIMULTANEOUSLY
*         WITH THE CPU BEING ASSIGNED TO THE SUB CONTROL POINT WITH
*         THE HIGHEST CPU PRIORITY. TRANEX REGAINS CONTROL OF THE CPU
*         IF THE TASK EXECUTES A CENTRAL EXCHANGE JUMP, IF THE HARDWARE
*         DETECTS A CPU MODE ERROR, OR IF THE TASK EXECUTES LONGER
*         THAN A TRANEX DEFINED CPU JOB SWITCHING TIME SPAN.
*             AS A TASK RUNS, IT MAKES REQUESTS FOR EXTERNAL ACTION
*         BY PLACING A REQUEST CONTROL WORD INTO ITS SYSTEM REQUEST
*         AND EXECUTING A CENTRAL EXCHANGE JUMP. TRANEX WILL REGAIN
*         CONTROL OF THE CPU, EXAMINE THE REQUEST WORD, AND INITIATE
*         A SEQUENCE OF CODE TO PROCESS THE REQUEST. THERE ARE FIVE
*         GENERAL CATAGORIES OF REQUESTS   (1) SCHEDULING, (2) KTS
*         DATA MANAGER, (3) TOTAL DATA MANAGER, (4) TRANEX INTERFACE,
*         AND (5) SYSTEM TYPE.
*             THE MESSAGE BLOCK (COMMUNICATION BLOCK) IS SCHEDULED
*         FIRST FOR A SPECIAL CORE RESIDENT TASK (INITIAL TASK) WHICH
*         DETERMINES FROM THE TRANSACTION CODES IN THE INPUT DATA THE
*         TASK(S) TO BE SCHEDULED TO PROCESS THE TRANSACTION. INITIAL
*         TASK THEN MAKES A SCHEDULING REQUEST.
*             UPON RECEIPT OF A SCHEDULING REQUEST, TRANEX WILL MAKE
*         AN ENTRY INTO ITS REQUESTED TASK LIST FOR THE FIRST TASK
*         SPECIFIED BY THE REQUEST. AT SOME LATER TIME, THE TRANEX
*         SCHEDULER WILL SELECT THIS TASK, RESERVE CORE FOR IT, AND
*         INITIATE LOADING. WHEN THE LOAD IS COMPLETE, THE CPU REQUEST
*         BIT IS SET FOR THE SUB CONTROL POINT AT WHICH THE TASK
*         RESIDES. SOONER OR LATER THE CPU WILL BE ASSIGNED TO THE
*         SUB CONTROL POINT AND THE TASK WILL START EXECUTING.
*             ONE OR MORE TASKS MAY BE SCHEDULED SERIALLY TO PROCESS A
*         TRANSACTION. THE COMMUNICATION METHOD ALONG A TASK CHAIN IS
*         THE COMMUNICATION BLOCK. IT IS MOVED FROM TASK TO TASK AND
*         MAY BE USED TO PASS PARAMETERS AND/OR DATA.
*
*              TRANEX IS STRUCTURED AROUND TWO CONTROL LOOPS. AN OUTER
*         LOOP INITIATES TIME DEPENDENT PROCESSING, WHILE AN INNER LOOP
*         CONTROLS THE REQUEST PROCEESING TO SERVICE EXECUTING TASKS.
*         THE INNER LOOP EXECUTES UNTIL NO TASK CPU ACTIVITY IS
*         REQUESTED OR UNTIL A SPECIFIED TIME SPAN (40 MILLISECONDS)
*         HAS ELAPSED SINCE THE OUTER LOOP EXECUTED. THE OUTER LOOP
*         CHECKS FOR UNPROCESSED INPUT THEN CHECKS THE ELSPSED TIME
*         SINCE EACH TIME DEPENDENT ROUTINE WAS LAST EXECUTED. THESE
*         ROUTINES ARE EXECUTED WHEN THEIR TIME SPAN ELAPSES. AT THE
*         END OF THE TIME CHECKS THE INNER LOOP IS CALLED.
*             TRANEX TIME DEPENDENT PROCESSING INCLUDES - TASK
*         SCHEDULING, TASK REACTIVATION AFTER A RESOURCE CONFLICT CAUSED
*         TRANEX TO PLACE THE TASK IN RECALL, K-DISPLAY UPDATING AND
*         COMMAND PROCESSING, CORE USAGE CHECKS (INCLUDES ROLLOUT IF
*         TRANEX IDLE), TASK ACTIVITY CHECKING, AND PERIODIC JOURNALING
*         OF TERMINAL TRANSACTION COUNTS.
          SPACE  4,10
***       OPERATOR ACTION.
*
*         AFTER ASSIGNING A TAPE WITH THE K-DISPLAY THE OPERATOR
*         SHOULD WATCH THE CONSOLE FOR TAPE STATUS MESSAGES LIKE
*         *MT50 NT RDY* ETC. TRANEX WILL REWIND THE TAPE AND WRITE A
*         SMALL LABEL RECORD ON IT IMMEDIATELY AFTER ASSIGNMENT. AT
*         THIS POINT A NOT READY TAPE OR A TAPE WITH NO WRITE ENABLE
*         CAN HANG TRANEX WAITING FOR OPERATOR ACTION.
*         THE OPERATOR SHOULD REMEDY THE PROBLEM AS FAST AS POSSIBLE.
          SPACE  4,10
***       EXTERNAL DECISION KEYS.
*
*         SENSE SWITCH 4 - IF SET, THE TRANSACTION EXECUTIVE WILL
*         AUTOMATICALLY RESTART AFTER A RECOVERY.
*
*         SENSE SWITCH 5 - IF SET, THE TRANSACTION EXECUTIVE WILL
*         CALL *DMP* TO ISSUE A FIELD LENGTH DUMP.
          SPACE  4,10
***       MODIFY OPTIONS.
*
*         *DEFINE DEBUG - CAUSES TAF TO ASSEMBLE IN DEBUG MODE.
*                ALL NETWORK MESSAGES WILL BE LOGGED ON THE TRACE FILE,
*                ZZZZZDN.  THE TRACE OPTION CAN BE TURNED ON/OFF AT
*                RUN TIME BY OPERATOR K-DISPLAY COMMANDS -
*                *K.DEBUG.*/*K.NODEBUG.*.
          SPACE  4,10
**        REGISTER CONVENTIONS (CAREFUL USAGE ADVISED).
*
*         (B2) = START OF SYSTEM AREA FOR TASK CURRENTLY SELECTED FOR
*                CPU ASSIGNMENT.
*         (B7) = START OF SUBCONTROL POINT AREA FOR TASK CURRENTLY
*                SELECTED FOR CPU ASSIGNMENT.
          SPACE  4,10
**        DOCUMENTATION CONVENTIONS.
*
*         1. IF NO REGISTER USES SPECIFIED, NO REGISTERS ARE SAVED
*         2. IF NO ENTRY/EXIT CONDITIONS SPECIFIED, NONE EXIST
*         3. THE FOLLOWING ABBREVIATIONS ARE USED -
*
*         AAM    ADVANCED ACCESS METHOD OF *CYBER* RECORD MANAGER.
*         AIP    APPLICATION INTERFACE PROGRAM FOR NETWORKS.
*         ATL    ACTIVE TRANSACTION LIST.
*         BCT    BATCH COMMUNICATION TABLE.
*         C.B.   COMMUNICATION BLOCK.
*         CMM    CYBER MEMORY MANAGER.
*         D.M.   DATA MANAGER.
*         EDT    ELEMENT DESCRIPTION TABLE.
*         NAM    NETWORK ACCESS METHOD.
*         RA(S)  RA OF THE SUBCONTROL POINT.
*         ROLT   ROLLOUT TABLE.
*         RTL    REQUEST TASK LIST.
*         SUBCP  SUBCONTROL POINT.
*         TIF    *TAF* INITIALIZATION FILE.
*         TLD    TASK LIBRARY DIRECTORY.
*         TRD    TRANSACTION DIRECTORY.
*         CRF    COMMUNICATIONS RECOVERY FILE.
*         TST    TERMINAL STATUS TABLE.
          SPACE  4,10
*IF       DEF,DEBUG
 TFWA     EQU    7000B       FWA OF TAF EXECUTIVE
 DBUG     EQU    0           DEBUG IS ON FOR *AIP*
*ELSE
 TFWA     EQU    2300B       FWA OF TAF EXECUTIVE
 DBUG     EQU    1           DEBUG IS OFF FOR *AIP*
*ENDIF
          SPACE  4,10
          ORG    TFWA        *TAF* FWA
 MACROS   TITLE  MACROS.
 ALLOC    SPACE  4,10
**        ALLOC - GENERATE A BIT RESERVATION MAP.
*
*         THE LOWER 47 BITS OF EACH WORD ARE SET TO INDICATE *NOT
*         RESERVED*.  THE LAST WORD OF THE TABLE IS DENOTED BY
*         CLEARING BIT ZERO OF THAT WORD.
*
*         ALLOC  NUMBER,BIT
*
*         NUMBER - NUMBER OF ENTRIES FOR ALLOCATION MAP.
*         BIT    - NUMBER OF BITS/WORD TO USE.
 
 
          PURGMAC  ALLOC
 
 ALLOC    MACRO  NUMBER,BIT
          LOCAL  AA,BB,CC
          MACREF ALLOC
          ERRPL  BIT-48      NO MORE THAN 47 BITS/WORD
 AA       SET    NUMBER-1
 CC       SET    47-BIT
 BB       DUP    AA/BIT
          VFD    12/2222B,BIT/-0,CC/0,1/1
 AA       SET    AA-BIT
 BB       ENDD
 AA       SET    AA+1
 CC       SET    48-AA
          VFD    12/2222B,AA/-0,CC/0
          ENDM
 BCF      SPACE  4,15
**        BCF -  BATCH CONCURRENCY *CRM* FUNCTION TABLE.
*
*         DEFINE A FUNCTION TABLE ENTRY WITH INFORMATION
*         ON EACH BATCH/CRM REQUEST CODE.
*
*         BCF    TSW,KA,KN,WS,FL
*
*         TSW    INDEX TO *TAF* STATUS WORD.
*         KA     INDEX TO KEYAREA WORD.
*         KN     INDEX TO KEYNAME WORD.
*         WS     INDEX TO WORKING STORAGE AREA WORD.
*         FL     FUNCTION LIST.
 
 
          PURGMAC  BCF
 
 BCF      MACRO  TSW,KA,KN,WS,FL
          VFD    3/TSW,6/KA,6/KN,6/WS,9/FL
          ENDM
 CKT      SPACE  4,10
**        CKT - CREATE KEYWORD TABLE.
*
*         CKT    KEYWORD,ROUTINE
*
*         ENTRY  *KEYWORD* = KEYWORD FOR REQUEST.
*                          = *END* IF LAST KEYWORD.
*                *ROUTINE* = FWA OF ROUTINE TO PROCESS *KEYWORD*.
*
*         EXIT   KEYWORD PROCESSING TABLE IS CREATED.
 
 
          PURGMAC  CKT
 
 CKT      MACRO  KEYWORD,ROUTINE
          MACREF CKT
 .A       IFC    NE,*KEYWORD*END*
          VFD    42/0H_KEYWORD_,18/ROUTINE
 .A       ELSE
          CON    0
 .A       ENDIF
          ENDM
 DSL      SPACE  4,10
**        DSL - DEFINE A DISPLAY LINE.
*
*         DSL    X,Y,A
*
*         WHERE  X = X COORDINATE.
*                Y = Y COORDINATE.
*                A = CONSTANT TO BE DISPLAYED.
 
 
          PURGMAC DSL
 
 DSL      MACRO  X,Y,A
          MACREF DSL
 B        MICRO  1,6,$A$
 C        MICRO  7,,$A$
          VFD    12/6000B+X*10,12/7756B-Y*10,36/6H"B"
          DATA   H$"C"$
          ENDM
 ENDOVL   SPACE  4,10
**        ENDOVL - TERMINATE OVERLAY.
*
*         ENDOVL
 
 
          PURGMAC  ENDOVL
 
 ENDOVL   MACRO
          LOCAL  A,AL
          MACREF ENDOVL
          QUAL
 L.D      MAX    L.,L.D
 A        BSS    0
          QUAL   "PROD""M."
 TINST    HERE
          QUAL
 AL       BSS    0
 OREL     RMT
          VFD    24/0,18/AL-A,18/A
 OREL     RMT
          ENDM
 ENTRY    SPACE  4,10
**        ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*         ENTRY  NAME,K
*
*         ENTRY  NAME = NAME OF ENTRY POINT.
*                K  IF PRESENT, DEFINES ENTRY POINT NAME AS A
*                K-DISPLAY COMMAND.
*
*         CALLS  ENTRY1 TO PASS CURRENT OVERLAY SUFFIX CHARACTER.
 
 
          PURGMAC ENTRY
 
 ENTRY    MACRO  NAME,K
          MACREF ENTRY
          ENTRY1 NAME,K,"M."
          ENDM
 ERROR    SPACE  4,10
**        ERROR - SET AN ERROR CODE AND BRANCH TO ERROR PROCESSOR.
*
*         ERROR  N
*
*                N = ERROR CODE.
 
 
          PURGMAC  ERROR
 
 ERROR    MACRO  N
          MACREF ERROR
          SX1    N
          EQ     TERP        BRANCH TO ERROR PROCESSOR
          ENDM
 KCMND    SPACE  4,10
**        KCMND - DECLARE A *K*-DISPLAY COMMAND FOR INITIALIZATION.
*
*         KCMND  COM,PRC
*
*         COM    3 - CHARACTER LONG COMMAND.
*         PRC    ADDRESS OF COMMAND PROCESSOR.
 
 
          PURGMAC  KCMND
 
 KCMND    MACRO  COM,PRC
          MACREF KCMND
          VFD    18/PRC,24/0,18/0L_COM
          ENDM
 OVLN     SPACE  4,10
**        OVLN - GENERATE OVERLAY NAME.
*
*         OVLN
*
*         EXIT   (N.) = LAST CHARACTER OF OVERLAY NAME.
 
 
          PURGMAC  OVLN
 
 OVLN     MACRO
          MACREF OVLN
 P.       MICRO  N.+1,1, ABCDEFGHIJKLMNOPQ
 M.       MICRO  1,1, "P."
 N.       SET    N.+1
          ENDM
 SYMBOLS  SPACE  4,10
**        OVERLAY GENERATION SYMBOLS.
 
 
          NOREF  N.,M.,L.,L.D
 N.       SET    0           OVERLAY COUNTER
 L.       SET    0           OVERLAY LENGTH
 L.D      SET    0           MAXIMUM OVERLAY LENGTH
 QTWCALL  SPACE  4,10
**        QTWCALL - QUEUE CALL MACRO.
*
*         QTWCALL  EVBIT,TYPE,POS
*
*         ENTRY  *EVBIT* = EVENT COMPLETE BIT.
*                *TYPE*  = EVENT TYPE.
*                *POS*   = IF *FIRST*, PUT EVENT AT BEGINNING OF QUEUE.
*                          OTHERWISE PUT EVENT AT END OF QUEUE.
*
*         EXIT   TO *TSSC*.
*
*         USES   X - 2, 4, 6.
*                B - 4.
*
*         CALLS  QTW.
 
 
          PURGMAC  QTWCALL
 
 QTWCALL  MACRO  EVBIT,TYPE,POS
          LOCAL  B
          MACREF QTWCALL
 .A       IFC    EQ,*POS*FIRST*
          SB4    B1
 .A       ELSE
          SB4    B0
 .A       ENDIF
          SX2    59-EVBIT
          SX4    TYPE
          SX6    B
          RJ     QTW         QUEUE *TAF* WORK
          EQ     TSSC        TIME SLICE SUBCP
 B        BSS    0
 QTWCALL  ENDM
 RDSB     SPACE  4,10
**        RDSB - READ SUBSYSTEM BLOCK.
*
*         RDSB   QUEUE,WC,FROM,TO,STAT
*
*                QUEUE = QUEUE PRIORITY OF DESIRED SUBSYSTEM
*                WC    = WORD COUNT TO READ
*                FROM  = ADDRESS IN SUB-SYSTEM TO READ
*                TO    = ADDRESS IN PROGRAM TO READ TO
*                STAT  = ADDRESS TO PLACE STATUS OF READ
 
 
          PURGMAC  RDSB
 
 RDSB     MACRO  Q,W,F,T,S
          MACREF RDSB
          R= X5,W
          R= X6,T
          LX5 36
          R= X7,F
          BX6 X6+X5
          LX7 18
          SX2 Q
          BX7 X7+X6
          LX2 18
          SX6 S
          SA7 X6
          BX6 X6+X2
          SX7 3RRSB
          PX7 X7
          LX7 42
          BX6 X6+X7
          RJ =XSYS=
          ENDM
 SBITS    SPACE  4,10
**        SBITS - SPECIFY BITS TO SET IN A WORD.
*
*         SBITS  (A,B,C,...N)
*         BITS A, B, ..., N ARE SET SUCH THAT A LEFT SHIFT EQUAL TO
*         THEIR VALUE RESULTS IN A NEGATIVE *X* REGISTER.
*
 
 
          PURGMAC  SBITS
 
 SBITS    MACRO  A
          MACREF SBITS
          IRP    A
          POS    60-A
          VFD    1/1
          IRP
          POS    0
          BSS    0
          ENDM
 
 ENTRY1   MACRO  NAME,K,OV
          MACREF ENTRY1
 DISPLAY  RMT
          VFD    42/0L_NAME
          IFC    EQ,*K**
          VFD    6/1R_OV
          ELSE   1
          VFD    6/40B+1R_OV
          VFD    12/NAME-TROVL
 DISPLAY  RMT
          ENDIF
          QUAL
 _NAME    EQU    /"PROD""M."/_NAME
          QUAL   "PROD""M."
          ENDM
 TRANOVL  SPACE  4,10
**        TRANOVL - DEFINE OVERLAY.
*
*         TRANOVL (SUBTITLE)
*
*         ENTRY  (SUBTITLE) = TEXT OF SUBTITLE.
*         EXIT   (M.) = 1 CHARACTER MICRO FOR OVERLAY NAME.
*                (L.D) = MAXIMUM DISPLAY OVERLAY LENGTH.
 
 
          PURGMAC  TRANOVL
 
          MACRO  TRANOVL,A,SUBTITLE
          MACREF TRANOVL
          OVLN
          TTL    "PROD""M." - SUBTITLE
          TITLE
 L.       SET    *
          IDENT  "PROD""M.",TROVL,TROVL,1,0      SUBTITLE
*COMMENT  "PROD" - SUBTITLE
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          QUAL   "PROD""M."
          ORG    TROVL
          ENDM
          TITLE  SYSTEM DEFINITIONS.
          SPACE  4,10
**        SYSTEM COMMON DECKS.
*CALL     COMCMAC
*CALL     COMSNCD
 EQUATES  TITLE  EQUATES.
*CALL     COMSPFM
*CALL     COMSPRD
*CALL     COMSIOQ
*CALL     COMSDSP
*CALL     COMSJIO
*CALL     COMSMSC
          QUAL   COMSMTX
*CALL     COMSMTX
          QUAL   BIO
*CALL     COMSBIO
          QUAL   *
          QUAL   COMSSCP
*CALL     COMSSCP
          QUAL
*CALL     COMSSSJ
*CALL     COMSSSD
          LIST   X
*CALL     COMSTRX
          LIST   -X
          ORG    TFWA        SET TAF FWA
 MACROS   TITLE  MACROS.
*CALL     COMCCMD
*CALL     COMCDCM
*CALL     COMCDCP
*CALL     COMCECM
          LIST   X
*CALL COMKFLD
*CALL     COMKIPR
          TITLE  *TAF* TABLE AND INTERFACE DEFINITIONS.
          SPACE  4,10
**        *TAF* COMMON DECKS.
 
*         SOME OF THE FOLLOWING COMMON DECKS USE *BSS* TO ASSIGN
*         LOCATIONS TO SYMBOLS.  *TAF* DOES NOT WANT TO ALLOCATE
*         STORAGE FOR THESE SYMBOLS SO THE CURRENT ORIGIN COUNTER
*         IS SAVED BY *BEGN* AND RESTORED AFTER THE COMMON DECKS
*         ARE PROCESSED.
 
*CALL     COMKBRD
 
 BEGINT   BSS    0           DO NOT RESERVE SPACE
*CALL     COMKCBD
          LIST   -X
          QUAL   COMKCRM
*CALL     COMKCRM
          QUAL   *
          LIST   X
*CALL     COMKKIM
*CALL     COMKNWF
*CALL     COMKOPD
*CALL     COMKRRD
*CALL     COMKSCD
*CALL     COMKSTC
*CALL     COMKTDM
*CALL     COMKTLD
*CALL     COMKTRF
*CALL     COMKTSA
*CALL     COMKTSC
*CALL     COMKTST
          LIST  -X
          ORG    BEGINT      RESET COUNTER
 RTL      SPACE  4,25
**        RTL - REQUESTED TASK LIST.
*
*T  W1    12/   NAME,18/    FL,6/  CP,6/  MP,18/    L
*T, W2    18/      CR,18/      1S,18/ ,1/S,1/D,1/C,1/E,2/
*T, W2    18/      CR,18/      1S,6/  ,18/      RE
*
*         WORD 1.
*            NAME - TASK DIRECTORY INDEX.
*            FL   - FIELD LENGTH.
*            CP   - CURRENT PRIORTY.
*            MP   - MAXIMUM PRIORTY (FUTURE USE).
*            L    - QUEUE LENGTH LIMIT.
*
*         WORD 2 (IF NOT FOR TASK ROLLIN REQUEST).
*            CR   - CURRENT *ATL* ENTRY.
*            1S   - FIRST *ATL* ENTRY.
*            S    - SYSTEM TASK.
*            D    - NON DESTRUCTIVE CODE.
*            C    - CM RESIDENT.
*            E    - EXTENDED MEMORY RESIDENT.
*
*         WORD 2 (IF FOR A TASK ROLLIN REQUEST).
*            CR   - CURRENT *ATL* ENTRY.
*            1S   - FIRST *ATL* ENTRY.
*            RE   - ROLLOUT TABLE ENTRY ADDRESS OF TASK TO ROLL IN.
 
 
 RTLLE    EQU    2           LENGTH OF A *RTL* ENTRY
 NRTL     EQU    40          NUMBER OF *RTL* ENTRIES (MUST BE .LE. 47).
 
 RTLW     ALLOC  NRTL,47     RESERVATION WORD FOR *RTL*
 RTL      BSSZ   NRTL*RTLLE  *RTL* ENTRIES
 RTLL     EQU    *-RTL       LENGTH OF *RTL*
 ATL      SPACE  4,10
**        ATL - ACTIVE TRANSACTION LIST.
*
*T        12/    NT,12/     PT,6/    ,30/        CBA
*
*         NT     - NEXT TASK IN QUEUE CHAIN (BIASED BY +1).
*         PT     - PREVIOUS TASK IN QUEUE CHAIN (BIASED BY +1).
*         CBA    - ADDRESS OF COMMUNICATIONS BLOCK.
 
 
 ATLL     EQU    1           WORDS PER *ATL* ENTRY
 TLS      SPACE  4,15
**        TLS - TASK LOAD STACK.
*
*T  W1    1/R,5/  ,18/      USN,18/      TFL,18/      SCP
*T, W2    30/      TLN ,30/      RDA
*
*         WORD 1.
*            R    - 1, IF TASK ROLLIN.
*            USN  - ADDRESS (-2) OF USER NAME FOR TASK LIBRARY.
*            TFL  - TASK FIELD LENGTH.
*            SCP  - FWA OF SUBCP TABLE ENTRY.
*
*         WORD 2.
*            TLN  - ADDRESS OF TASK LIBRARY NAME.
*            RDA  - RANDOM DISK ADDRESS OF TASK.
 
 
 CCC      BSSZ   5*2+1       FIVE ENTRIES + ZERO WORD TERMINATOR
 LTLRE    EQU    *-3         FWA OF LAST TASK LOAD REQUEST STACK ENTRY
 ROLT     SPACE  4,35
**        ROLT - ROLLOUT TABLE.
*
*T  W1    1/C,1/W,1/T,1/D,1/R,1/L,36/  ID,18/ FET
*T, W2    18/     FL,6/   CP,6/   MP,30/      RDA
*T, W3    12/IDT,1/C,1/A,4/0,6/SCP,36/ ED
*
*         WORD 1.
*            C      - 1, IF ROLLOUT COMPLETE.
*            W      - 1, IF WAIT FOR TERMINAL INPUT.
*            T      - 1, IF TIMED ROLLOUT.
*            D      - 1, IF DATA MANAGER REQUESTED ROLLOUT.
*            R      - 1, IF DO NOT RELOAD COMMUNICATION BLOCK.
*            L      - 1, IF RESTART TASK AT RECALL ENTRY POINT.
*            ID     - EVENT DESCRIPTOR.
*                     24/C.B. ADDRESS,12/0   FOR CALLRTN ROLL.
*                     24/TIME,12/TST ORDINAL FOR WAITINP ROLL.
*                     18/0,18/ROLLIN FL      FOR MEMORY REQUEST ROLL.
*                     24/TIME,12/C.B. INDEX  FOR WAIT ROLL.
*            FET    - FET ADDRESS OF ROLLOUT FILE.
*
*         WORD 2.
*            RDA    - DISK ADDRESS OF ROLLOUT FILE.
*            FL     - FIELD LENGTH REQUIRED FOR ROLLIN.
*            CP     - CURRENT PRIORITY.
*            MP     - MAXIMUM PRIORITY (FUTURE USE).
*
*         WORD 3.
*            IDT    - IDENTIFICATION OF TYPE OF EVENT.
*            C      - *CDCS* CONNECTED FLAG.
*            A      - ABORT TASK FLAG. (*CDCS* DOWN)
*            SCP    - SUBCONTROL POINT NUMBER.
*            ED     - EVENT DESCRIPTOR.
*                    18/0,18/FWA OF REQUEST FOR D.M. ROLL.
*                    18/ACN,18/ABN   FOR SEND IN *TAFNAM*.
*                    12/0,24/SEQ   FOR WAIT INPUT.
*                    18/0,18/FL   FOR MEMORY REQUEST.
 
 
 TROLE    EQU    3           LENGTH OF A ROLLOUT TABLE ENTRY
 NROL     EQU    50          NUMBER OF ROLLOUT TABLE ENTRIES
 
 TROM     ALLOC  NROL,47     ROLLOUT TABLE ALLOCATION MAP
 
 TROL     BSSZ   TROLE*NROL  ROLLOUT TABLE
 
*            SHIFT COUNTS FOR *ROLT* FIELDS.
 
 RTBWI    EQU    58          WAIT FOR TERMINAL INPUT
 RTBTR    EQU    57          TIMED ROLLOUT
 RTBDM    EQU    56          DATA MANAGER ROLLOUT
 RTBID    EQU    53          ROLLOUT ID
 RTBCB    EQU    35          ROLLOUT CONTROL BLOCK INDEX
 RTBCP    EQU    23          SUBCP
 
 RTTL     FIELD  0,53,30     ROLLOUT TIME IN SECONDS
 RTCD     FIELD  2,47,47     *CDCS* CONNECTED FLAG
 RTAB     FIELD  2,46,46     ABORT TASK FLAG
 RTTS     FIELD  2,23,0      SEQUENCE NUMBER FOR *WAITINP*
 
*         WORD DEFINITIONS FOR *ROLT*.
 
 RTWEV    EQU    2           ROLT EVENT WORD
 
*         *ROLT* ID TYPES.
 
 EVDM     EQU    1           DATA MANAGER LOCKED RECORD EVENT
 EVTO     EQU    2           TERMINAL OUTPUT THRESHOLD ROLLOUT
 EVCR     EQU    3           CALL TASK WITH RETURN ROLLOUT
 EVWD     EQU    4           WAITING TO USE THE DATA MANAGER
 EVWI     EQU    5           WAIT FOR TERMINAL INPUT
 EVRL     EQU    6           REQUEST FIELD LENGTH
 
*         BCFT - BATCH CONCURRENCY *CRM* FUNCTION TABLE.
 
 BCFT     BCF    TSDF,NOKA,NOKN,NOWS,FLDF  CLOSE
          BCF    TSDF,NOKA,KNDE,NOWS,FLDF  DELETE
          BCF    TSDF,NOKA,KNLC,NOWS,FLDF  LOCK
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  FLOCK
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  OPEN
          BCF    TSDF,KARD,KNRD,WSRD,FLRD  READ
          BCF    TSDF,KARL,KNRL,WSRL,FLRD  READL
          BCF    TSDF,KARM,KNRM,WSRM,FLRD  READM
          BCF    TSDF,KARN,NOKN,WSRN,FLRD  READN
          BCF    TSDF,KARO,NOKN,WSRO,FLRD  READNL
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  REWIND
          BCF    TSDF,NOKA,KNRW,WSRW,FLWR  REWRITE
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  SKIPBL
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  SKIPFL
          BCF    TSDF,NOKA,KNUC,NOWS,FLDF  UNLOCK
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  UNFLOCK
          BCF    TSDF,KAWR,KNWR,WSWR,FLWR  WRITE
          BCF    TSDF,NOKA,KNST,NOWS,FLDF  START
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  DBEGIN
          BCF    TSCF,NOKA,NOKN,NOWS,FLDC  DBCOMIT
          BCF    TSCF,NOKA,NOKN,NOWS,FLDC  DBFREE
          BCF    TSDF,NOKA,NOKN,NOWS,FLDF  DBSTAT
 
*         FIELDS FOR BATCH *CRM* FUNCTION TABLE.
 
 BFUE     FIELD  0,59,30     UPPER TABLE ENTRY
 BFFL     FIELD  0,08,00     FUNCTION LIST
 BFWS     FIELD  0,14,09     WORKING STORAGE AREA INDEX
 BFKN     FIELD  0,20,15     KEYNAME AREA INDEX
 BFKA     FIELD  0,26,21     KEYAREA INDEX
 BFTS     FIELD  0,29,27     *TAF* STATUS WORD INDEX
 
 BCTF     BSSZ   1           BATCH CONTINUATION FLAG
 ITTP     SPACE  4,25
**        ITTP - INTERNAL TASK TRACE PACKET.
*
*T W1     12/    TEF,12/    TID,18/    (B2),18/    (B7)
*T,W2     60/    SYSTEM REQUEST
*T,W3     60/    CB1W
*T,W4     60/    SCPW
*
*         WORD 1.
*            TEF   - 2000B+ERROR FLAG RETURNED FROM SUBCP ACTIVATION.
*            TID   - TASK TRACE PACKET IDENTIFIER (SET TO ZERO).
*            (B2)  - START OF SYSTEM AREA PRECEDING THE RA OF THE TASK.
*            (B7)  - ADDRESS OF SUBCP TABLE.
*
*         WORD 2.
*            RA+1  - CONTENTS OF SYSTEM REQUEST IN THE TASK FL.
*
*         WORD 3.
*            CB1W  - FIRST WORD OF C.B. KEPT IN THE SYSTEM AREA
*                    PRECEDING THE RA OF THE TASK.
*
*         WORD 4.
*            SCPW  - THIRD WORD OF SUBCP TABLE.
*                    (SEE DEFINITION IN *COMKSCD*.)
 
 
 ITTPL    EQU    4           LENGTH OF AN INTERNAL TASK TRACE PACKET
          ERRNG  ITTPL-4     TRACE PACKET SIZE REDEFINED TO LESS THAN 4
 
*         FIELDS FOR TRANSACTION INPUT.
 
 INST     FIELD  0,59,59     STATUS, 0 = DATA, 1 = STATUS
 INCT     FIELD  0,58,58     1 IF MORE DATA BLOCKS OF INPUT
 INBT     FIELD  0,56,56     BATCH TRANSACTION
 INSO     FIELD  0,48,48     SYSTEM ORIGIN TRANSACTION
 INAT     FIELD  0,47,45     APPLICATION CHARACTER TYPE
 INTO     FIELD  0,35,18     TERMINAL ORDINAL
 INLC     FIELD  0,17,0      MESSAGE LENGTH IN WORDS
 TSB      SPACE  4,10
**        TSB - *TAF* STORAGE BUFFER.
*
*         USED BY PROCESSES THAT REQUIRE A BLOCK OF TEMPORARY STORAGE.
*         ACCESSED BY ROUTINES *GTS* AND *RTS*.
 
 
 TSBLE    EQU    4           LENGTH OF *TAF* STORAGE BUFFER ENTRY
 NTSB     EQU    50          NUMBER OF *TAF* STORAGE BUFFER ENTRIES
 
 TSBM     ALLOC  NTSB,47     *TAF* STORAGE BUFFER RESERVATION MAP
 
 TSB      BSS    TSBLE*NTSB  *TAF* STORAGE BUFFER
          SPACE  4,10
 INFC     FIELD  1,17,0      *ITASK* FUNCTION CODE
 
 
*         FIELDS FOR TAF-CDCS REQUEST BLOCK.
 
 CDHD     FIELD  0,59,14     HEADING
 CDRT     FIELD  0,13,12     RETURN CONTROL
 CDES     FIELD  0,11,1      ERROR AND STATUS
 CDRC     FIELD  0,11,6      REASON CODE
 CDSF     FIELD  0,5,1       STATUS FLAG
 CDCB     FIELD  0,0,0       COMPLETION FLAG
 CDBF     FIELD  1,59,42     ERROR BUFFER ADDRESS
 CDFC     FIELD  1,5,0       FUNCTION CODE
 CDRA     FIELD  2,59,42     RA OF TASK
 CDFL     FIELD  2,41,24     FIELD LENGTH OF TASK
 CDTS     FIELD  2,23,0      TRANSACTION SEQUENCE NUMBER
 
*         *TAF* QUEUE WORK ENTRY FIELD DEFINITIONS.
 
 QWNS     FIELD  0,59,54     SUBCP OF NEXT ENTRY IN QUEUE
 QWNA     FIELD  0,53,36     FWA OF NEXT ENTRY RELATIVE TO NEXT SUBCP
 QWNT     FIELD  0,59,36     NEXT QUEUE ENTRY
 QWTY     FIELD  0,35,30     QUEUE TYPE
 QWSP     FIELD  0,29,24     SUBCP THAT NEEDS RESOURCE
 QWSH     FIELD  0,23,18     SHIFT TO POSITION COMPLETE BIT TO BIT 59
 QWEV     FIELD  0,17,0      FWA OF RESOURCE EVENT
 QWTM     FIELD  1,53,18     MILLISECONDS FOR EVENT TO COMPLETE
 QWPR     FIELD  1,17,0      QUEUE COMPLETE PROCESSOR
 
*         *TAF* AUTOMATIC RECOVERY QUEUE ENTRY DEFINITIONS.
 
 QRQ1     FIELD  0,59,0      *TAF* QUEUE WORD 1
 QRQ2     FIELD  1,59,0      *TAF* QUEUE WORD 2
 QRTC     FIELD  2,59,59     RECOVERY PROCESSING COMPLETE
 QRST     FIELD  2,58,58     RECOVERY STARTED COMPLETE
 QRTO     FIELD  2,17,0      TERMINAL ORDINAL FOR RECOVERY PROCESSING
 QREC     FIELD  3,59,0      RECOVERY REQUEST
 
*         CDCS FUNCTION CODES.
 
 CDIN     EQU    13B         INVOKE
 CDNT     EQU    15B         NORMAL TERMINATION
 CDAT     EQU    17B         ABNORMAL TERMINATION
 
*         SUBSYSTEM ERROR STATUS.
 
 SSNP     EQU    /COMSSCP/ES1/2  SUBSYSTEM NOT PRESENT
 SSBZ     EQU    /COMSSCP/ES2/2  SUBSYSTEM BUSY
 SSND     EQU    /COMSSCP/ES3/2  SUBSYSTEM NOT DEFINED
 
*         *CDCS* ERROR CODE.
 
 CDNF     EQU    21B         NON-FATAL ERROR
 CDER     EQU    22B         FATAL ERROR
 
*         CDCS STATUS WORD.
 
 CDST     BSSZ   1           1, IF CDCS ABORTED
 
*         CDCS   TERMINATE REQUEST PARAMETER BLOCK.
 
 CDPA     VFD    24/4LCD22,12/0,6/2,4/0,2/3,6/0,5/0,1/0
          VFD    18/INDB+3,9/0,27/0,6/0
          VFD    18/0,18/0,24/1
 CDPB     VFD    24/4LCD22,12/0,6/2,4/0,2/3,6/0,5/0,1/0
          VFD    18/3LSSC,6/0,18/CDSI,18/CDPA
 
 
*         *TAF* INPUT RECEIVING BUFFERS.  *INRB* IS USED TO RECEIVE
*         *LIBTASK* ON-LINE LIBRARY UPDATE REQUESTS.
 
*         *CDCS* RELATED GLOBAL SYMBOLS.
 
 CMPF     BSSZ   1           MEMORY PAUSE FLAG
 
 
 INRBL    EQU    1+63        MAXIMUM BLOCK SIZE TO RECEIVE
 INRB     BSSZ   INRBL       INTER CONTROL POINT RECEIVING BUFFER
 
 INRB1L   EQU    31          MAXIMUM BLOCK SIZE FOR BATCH TRANSACTION
 INRB1    BSSZ   INRB1L      BATCH TRANSACTION RECEIVING BUFFER
 
*         *TAF* FETS.
 
 TDI      BSS    0           *TOTAL* INPUT FET
 TDMIQ    FILEC  TDIBF,TDIBFL,FET=5
 
 TDO      BSS    0           *TOTAL* OUTPUT FET
 TDMOQ    FILEC  TDOBF,TDOBFL,FET=5
 
 TL       BSS    0
 TASKLIB  RFILEB OBUF,OBUFL,FET=14,EPR  TASK LIBRARY FILE
 
 O        BSS    0
 OUTPUT   FILEB  OBUF,OBUFL,FET=14
 
 SF       BSS    0           RANDOM SCRATCH FILE
 ZZZZZG3  RFILEB OBUF,OBUFL
 
 SCR      BSS    0
 SCR      FILEB  OBUF,OBUFL,EPR,FET=14 SCRATCH FILE FOR TAPE ASSIGNMENT
 
 SCR1     BSS    0
 SCR1     FILEB  OBUF,OBUFL,EPR,FET=14 SCRATCH FILE FOR TAPE ASSIGNMENT
 
 PJRNL    BSS    0
 JOUR0    FILEB  JBUF0,JBUFL,FET=15     FOURNAL FILE FET
 
 RO       BSS    0
 KTSROLL  RFILEB OBUF,OBUFL,(FET=8)  TASK ROLLOUT FILE
 
 INT      BSS    0
 INTRACE  FILEB  PBUF,PBUFL  INTERNAL TRACE BUFFER FET
 
*         THE FOLLOWING STATISTICS ARE MAINTAINED FOR TUNING PURPOSES.
 
 STAT1    BSSZ   1           NUMBER OF TIMES A TASK WAS RELOADED
 STAT2    BSSZ   1           NUMBER OF TIMES INITIAL TASK WAS RELOADED
 STAT4    BSSZ   1           NUMBER OF STORAGE MOVES OF TASKS
 STAT5    BSSZ   1           NUMBER OF TIMES A TASK ABORT OCCURRED
 STAT6    BSSZ   1           NUMBER OF TIMES *TAF* FL WAS INCREASED
 STAT9    BSSZ   1           RECALLS FOR *NAM* OUTPUT BLOCK LIMIT
 STAT10   BSSZ   1           NUMBER OF TIMES NO FL FOR TASK LOAD
 STAT11   BSSZ   1           NUMBER OF TIMES NO AVAILABLE SUBCP
 STAT12   BSSZ   1           TIMES NO COMMUNICATION BLOCKS AVAILABLE
 STAT13   BSSZ   1           NUMBER OF TASK ROLLOUT COMPLETES
 STAT14   BSSZ   1           NUMBER OF ROLLOUT INITIATIONS FOR TASKS
 STAT15   BSSZ   1           NUMBER OF TIMES TASK IN RECALL
 STAT16   BSSZ   1           NUMBER OF ACTIVE SUBCONTROL POINTS
          BSSZ   1           NUMBER OF SAMPLES
 STAT17   BSSZ   1           NUMBER OF OUTSTANDING *CDCS* REQUESTS
 STAT18   BSSZ   1           NUMBER OF *CDCS* REJECTS FOR *MAXR*
 STAT19   BSSZ   1           NUMBER OF *CDCS* REQUESTS REJECTS FOR BUSY
 STAT20   BSSZ   1           NUMBER OF *CDCS* TASK REQUESTS
 
*         *TAF* TIMERS.  THE FOLLOWING TIMERS ARE USED TO SCHEDULE
*         PROCESSES IN *TAF*.
 
*         ASSEMBLY CONSTANTS FOR TIMED LOOPS.
 
 TMDTL    EQU    100B        MILLISECONDS BETWEEN TIME DEPENDENT CALL
 RCLTL    EQU    20B         MILLISECONDS FOR TASK RECALL
 SCHTL    EQU    20B         MILLISECONDS BETWEEN TIMED SCHEDULER RUNS
 SICTL    EQU    4           MINIMUM MILLISECONDS BETWEEN *SIC* CALLS
 SFCTL    EQU    1*1000      MILLISECONDS BETWEEN STATUS REQUESTS
 
*         THE FOLLOWING MILLISECOND COUNTS MAY EXCEED 131,000 AND
*         THEREFORE REQUIRE A FULL WORD TO CONTAIN THEIR VALUE.
 
 TACTL    CON    2*60*1000   MIILISECONDS BETWEEN ACTIVITY CHECKS
 SJTTL    CON    20*60*1000  MILLISECONDS BETWEEN PERIODIC JOURNALING
 ITRTL    CON    1500D       MILLISECONDS TO IDLE BEFORE ROLLING OUT
 TROTL    CON    10*60*1000  MILLISECOND DURATION OF ROLLOUT
 RFRTL    EQU    5*1000      MILLISECONDS BETWEEN SCREEN REFRESHING
*                            BY TASK DRIVING *K-DISPLAY*
 
 BTIME    BSS    1           REAL TIME CLOCK AT LAST REJECTED *SIC*
 CTIME    CON    0           MILLISECONDS OF ACCUMULATED CPU TIME
 DTIME    BSS    1           REAL TIME CLOCK AT LAST DATA MANAGER CYCLE
 ETIME    BSS    1           REAL TIME CLOCK AT LAST TASK RELEASE
 ITIME    BSS    1           REAL TIME CLOCK AT LAST INPUT PROCESSING
 JTIME    BSS    1           REAL TIME CLOCK AT LAST PERIODIC JOURNAL
 LTIME    BSS    1           REAL TIME CLOCK AT START OF INNER LOOP
 MTIME    BSS    1           REAL TIME CLOCK AT LAST FL REDUCTION
 OTIME    BSS    1           REAL TIME CLOCK AT LAST 1 SECOND INTERVAL
 PTIME    BSS    1           REAL TIME CLOCK AT START OF PROGRAM
 RTIME    BSS    1           REAL TIME CLOCK AT LAST RECALL PROCESSING
 STIME    BSS    1           REAL TIME CLOCK AT LAST SCHEDULER RUN
 TTIME    BSS    1           REAL TIME CLOCK AT LAST ACTIVITY CHECK
 UTIME    BSS    1           REAL TIME CLOCK AT LAST CORE USAGE CHECK
 
*         SUBCP SCHEDULING VARIABLES.  *CR* INDICATES THE SUBCP-S
*         THAT ARE CANDIDATES FOR EXECUTION.  *RCR* INDICATES THE
*         SUBCP-S THAT ARE IN RECALL.  *SREG* INDICATES THE CURRENTLY
*         ACTIVE SUBCP.  BIT 46 OF *CR/RCR* CORRESPONDS TO SUBCP ONE,
*         BIT 45 TO SUBCP TWO, AND SO ON.
 
 CR       CON    0           SUBCP CPU REQUEST WORD
          CON    0           SUBCP CPU REQUEST WORD MASK
 
 RCR      CON    0           RECALL REQUEST WORD
 
 
*T SREG   24/0,18/ SA,18/ SCP
*         SA  - FWA OF TASK SYSTEM AREA.
*         SCP - FWA OF SUBCP TABLE ENTRY FOR TASK.
 
 SREG     CON    0
 
*         MEMORY MANAGEMENT CONTROL.
*         THE FOLLOWING CONSTANTS CONTROL THE AMOUNT OF FIELD LENGTH
*         INCREASE OR DECREASE AND THE TIME PERIODS
*         BETWEEN FIELD LENGTH CHANGES.
 
 RFLTL    EQU    100         MILLISECONDS BEFORE INCREASE
 FCMFL    EQU    100B        MINIMUM FL TO RETAIN
 REDFL    EQU    30000B      MAXIMUM FL FOR ONE REDUCTION
 INCFL    EQU    12000B      MINIMUM FL FOR ONE INCREMENT
 
 AVAILCM  CON    0           AVAILABLE CENTRAL MEMORY
 CMRFL    BSS    1           SUM OF CM RESIDENT INITIAL FL + NUAPL
 CMRPF    BSS    1           SUM OF CM RESIDENT POTENTIAL FL
 CURFL    BSS    1           CURRENT FIELD LENGTH
 MAXTTA   BSS    1           MAXIMUM SIZE OF TOTAL TASK AREA
 MFL      BSS    1           MAXIMUM FIELD LENGTH
 MINTTA   BSS    1           MINIMUM SIZE OF TOTAL TASK AREA
 MINXT    BSS    1           MINIMUM SIZE OF TRANSIENT TASK AREA
 MRSW     BSSZ   1           MEMORY REQUEST STATUS WORD
 
 TPLW     CON    0           STATUS WORD FOR OUTSTANDING PPU REQUESTS
 DAYB     BSSZ   5           BUFFER FOR DAYFILE MESSAGES
 TSEQ     CON    0           TRANSACTION SEQUENCE NUMBER
 PDATE    BSS    1           LATEST PACKED TIME
 RSCH     BSS    1           REQUEST TASK SCHEDULER
 
*         *STIN* CONTROLS START OF COMMUNICATIONS WITH JOBS,
*         SUBSYSTEMS, AND TERMINALS.  IF *STIN* EQUALS ZERO,
*         COMMUNICATIONS SHOULD NOT BEGIN BECAUSE RECOVERY
*         PROCEDURES HAVE NOT FINISHED.  IF *STIN* EQUALS 1
*         COMMUNICATIONS MAY BEGIN.  IF *STIN* IS LESS THAN ZERO,
*         COMMUNICATIONS HAVE BEEN ENABLED.
 
 STIN     CON    0
 
*         *TAF* USES EVENT QUEUING TO PROCESS SOME OF ITS WORK.
*         THE FOLLOWING VARIABLES AND DEFINITIONS ARE USED FOR QUEUING.
 
*T  TAFQ  12/ ,6/LSUBCP,18/LAST,6/FSUBCP,18/FIRST
*
*         LSUBCP - LAST SUBCP ENTRY IN QUEUE.
*                  THIS IS ZERO IF NO SUBCP IS ASSOCAITED WITH *LAST*.
*         LAST   - FWA OF LAST ENTRY IN QUEUE.
*         FSUBCP - FIRST SUBCP IN QUEUE.
*                  THIS IS ZERO IF NO SUBCP IS ASSOCIATED WITH *FIRST*.
*         FIRST  - FWA OF NEXT ENTRY IN QUEUE.
 
 TAFQ     CON    0           *TAF* QUEUE POINTERS
 
*         EACH ENTRY IN THE QUEUE HAS THE FOLLOWING FORMAT -
*
*T        6/NSUBCP ,18/NEXT,6/TYPE,6/SUBCP,6/SHIFT,18/EVENT
*         6/ ,36/TIME,18/RETURN
*
*         NSUBCP - SUBCP OF NEXT ENTRY IN QUEUE.  ZERO IF NO
*                  SUBCP FOR *NEXT*.
*         NEXT   - FWA OF NEXT ENTRY IN QUEUE.  THIS IS ZERO FOR
*                  LAST ENTRY OF QUEUE.
*         TYPE   - TYPE OF EVENT.
*         SUBCP  - SUBCP OF QUEUED EVENT.  SUBCP IS ZERO IF NO
*                  SUBCP IS INVOLVED.
*         SHIFT -  SHIFT TO MOVE COMPLETE BIT TO BIT 59.
*                  A 1 INDICATES A COMPLETE EVENT.
*         EVENT  - FWA OF EVENT.
*         TIME   - TIME FOR EVENT TO COMPLETE IN MILLISECONDS.
*         RETURN - FWA OF PROCESSOR TO CALL WHEN EVENT IS COMPLETE.
 
*         QUEUE TYPES.
 
 QTEV     EQU    0           QUEUE TYPE IS EVENT ONLY
 QTET     EQU    1           QUEUE TYPE IS EVENT OR TIME.
 
*         GLOBAL EVENT COMPLETE WORDS.
 
 EVCB     VFD    1/1,59/0    BIT 59 = 1 IF COMMUNICATIONS BLOCKS FREE
 EVIT     VFD    1/1,59/0    BIT 59 = 1 IF *ITASK* MAY BE SCHEDULED
 
 
 SSRP     BSSZ   1           SYSTEM OR USER CONTROL POINT STORAGE
 SSJN     BSSZ   1           *UCP* SEQUENCE NUMBER AND *FST* ORDINAL
 SSUH     BSSZ   1           CALLSS HEADER WORD
 SSUP     BSSZ   50B         *UCP* PARAMETERS
 SSRPL    EQU    *-SSRP      LENGTH OF BUFFER
 TAID     VFD    42/3LTAF,18/TRSI  TAF IDENTIFICATION
 BFPT     VFD    1/0,1/0,4/0,18/0,1/1,17/SSRPL,18/SSRP  BUFFER POINTER
 
 ZWORD    BSSZ   1           ZERO WORD
 
*         TASKS FOR SPECIAL PROCESSING.
 
 TLIST    BSS    0
 ABAS     DATA   L*MSABT*    ABORT PROCESSING
 BTAS     DATA   L*BTASK*    *BTRAN* RECOVERY PROCESSING
 CTAS     DATA   L*CTASK*    *CRM* RECOVERY PROCESSING
 ITAS     DATA   L*ITASK*    INITIAL INPUT PROCESSING
 KTAS     DATA   L*KDIS*     COMMAND DISPLAY PROCESSING
 OTAS     DATA   L*OFFTASK*  OFF TASK PROCESSING
 RCTAS    DATA   L*RCTASK*   RECOVER CDCS TASK
 RTAS     DATA   L*RTASK*    TERMINAL RECOVERY PROCESSING
 SMTAS    DATA   L*STASK*    SEND MESSAGE TO TERMINAL
 STAS     DATA   L*SYSMSG*   SYSTEM MESSAGE PROCESSING
          CON    0           END OF LIST
 
 QUAL$    EQU    0           PROGRAM WILL HANDLE QUAL
 
*         THE FOLLOWING DEFINE *CALLRTN* AND ROLLOUT FILE PARAMETERS.
 
 ROLBL    EQU    6000B       ROLLOUT BLOCK SIZE
 NPRBL    EQU    ROLBL/64    NUMBER OF PRUS PER ROLLOUT BLOCK
 RFOVL    EQU    4*NPRBL     NUMBER OF PRUS TO LEAVE ON END OF FILE
 NESTL    EQU    16          NEST LIMIT FOR CALL TASK WITH RETURN
 RTDNL    EQU    2*1000      CORE TIME SLICE ALLOWED AFTER A *CALLRTN*
 RLATL    EQU    5           ROLLOUT FILE ALLOCATION AREA SIZE
 MINTL    EQU    4           MINIMUM TIME BEFORE *WAIT* CAUSES ROLLOUT
 DWITL    EQU    8*60        DELAY TIME OUT FOR WAIT FOR INPUT TASKS
 DMRTL    EQU    2           DURATION ON DATA MANAGER REQUESTED ROLLOUT
 DRLTL    EQU    10          DURATION OF MEMORY ROLLOUT
 
 
 DCPPR    EQU    2003B       DEFAULT TASK CPU PRIORITY
 DTSTL    EQU    16          DEFAULT NUMBER OF TIME SLICES FOR A TASK
 MAXSM    EQU    300000B     MAXIMUM AMOUNT OF CORE TO STORAGE MOVE
 NAMTP    EQU    1           FLAG FOR *TAFNAM* TELE-PROCESSOR
 
*         *SEND* REQUEST OUTPUT FLOW PARAMETERS FOR TASK ROLLING.
 
 ROLTO    EQU    40          NUMBER OF WORDS TO CAUSE ROLLOUT
 DTCPS    EQU    30          DIAL-UP TERMINAL CHARACTERS PER SECOND
 PTCPS    EQU    15          POLLED TERMINAL CHARACTERS PER SECOND
 DTRTL    EQU    1           DELAY IN SECONDS ADDED TO *SEND* TIME
 
 MAXJL    EQU    2500        MAXIMUM NUMBER OF WORDS TO JOURNAL
 MAXBW    EQU    3           MAXIMUM TASK BRANCH COUNT
 MAXRA    EQU    500B        NUMBER OF LEGAL SYSTEM REQUESTS
 MOFFC    EQU    2           TRANSACTION TERMINAL MESSAGE LIGHT OFF
 MONFC    EQU    3           TRANSACTION TERMINAL MESSAGE LIGHT ON
 LOGFC    EQU    13B         LOG OFF FUNCTION CODE
 
*         FET DESCRIPTION.
 
 FELN     FIELD  0,59,18     LOCAL FILE NAME
 FEAT     FIELD  0,13,10     ERROR STATUS
 FECO     FIELD  0,8,2       REQUEST CODE
 FEFT     FIELD  0,1,1       FILE TYPE
 FECL     FIELD  0,0,0       COMPLETION FLAG
 FERM     FIELD  1,47,47     RANDOM ACCESS FILE FLAG
 FEFR     FIELD  1,17,0      FIRST
 FEIN     FIELD  2,17,0      IN
 FEOU     FIELD  3,17,0      OUT
 FELI     FIELD  4,17,0      LIMIT
 FERR     FIELD  6,28,0      RANDOM REQUEST
 FEMG     FIELD  7,59,59     MAGNET TAPE
 FEOO     FIELD  13,17,0     OLD OUT POINTER
 FECR     FIELD  14,28,0     CURRENT EOI RANDOM INDEX
 
 JFETL    EQU    FECRW+1     LENGTH OF JOURNAL FET
 
*         DATA MANAGER CONSTANTS.
 
 TFEN     EQU    2           LENGTH OF TOTAL FILE ENTRY IN EDT
 TIMDM    EQU    10          MAXIMUM TASKS USING TOTAL
 TMAXDB   EQU    31          MAXIMUM TOTAL DATA BASES
 TMAXFIL  EQU    100         MAXIMUM FILES PER TOTAL DATA BASE
 
***       DATA MANAGER INITIALIZATION FLAGS.
*
*         IF EQUATED TO 0 LOAD CORRESPONDING DATA MANAGER.
*         IF EQUATED TO 1 AND FILE IS NOT PRESENT ABORT TRANEX.
*         IF EQUATED TO -1 DO NOT LOAD THE DATA MANAGER.
 
 CDBIDF   EQU    0           LOAD AAM IF *CDBID* PRESENT
 TDBIDF   EQU    0           LOAD TOTAL IF TDBID PRESENT
 
*         TLD RELATED CONSTANTS USED BY *TAF*.
*
*         MAXAQ = MAXIMUM NUMBER OF ACTIVE COPIES OF A TASK WITH THE
*                Q-ATTRIBUTE SPECIFIED.
 
 MAXAQ    EQU    7
 TLTANM   DECMIC TLTAN
 
 
 DEVT     VFD    48/0,12/0L"DTYM"     DEFAULT DEVICE TYPE
 
*         TASK DUMP DEFAULTS.
 
 DFWA     EQU    0           DEFAULT FWA OF TASK DUMP
 DFWAM    OCTMIC DFWA
 DLWA     EQU    100000B     DEFAULT LWA OF TASK DUMP
 DLWAM    OCTMIC DLWA
 DEXP     EQU    1           DEFAULT EXCHANGE PACKAGE DUMP
 DEXPM    OCTMIC DEXP
 DDMB     EQU    0           DEFAULT DATA MANAGER BUFFER DUMP
 DDMBM    OCTMIC DDMB
 DORT     EQU    0           DEFAULT ORIGIN TYPE FOR TASK
 DORTM    MICRO  1,2,/BC/
 DORC     EQU    BCOT        DEFAULT ORIGIN CODE
 DQDS     EQU    0           DEFAULT QUEUE DESTINATION VALUE
 DQDSM    OCTMIC DQDS        PRINTER ID
 
 DSMNFL   EQU    12          MINIMUM *DSDUMP* FL
 DSQID    EQU    0           DEFAULT *SUBMT* OUTPUT QUEUE ID
 
 
 DTSE     VFD    1/1,1/DEXP,1/DDMB,1/0,1/0,7/0,18/DLWA,12/0,18/DFWA
          VFD    42/0,1/1,1/0,1/0,3/DORC,12/DORT
 
 DTSG     BSS    1           DUMP CALLED FROM ADDRESS
 
*         TRANSACTION FACILITY DUMP DEFAULTS.
 
 GTDL     VFD    1/0,59/0    GLOBAL TASK DUMP FLAG AND LIMIT
 DRID     EQU    0           PRINTER ID FOR *K.DUMP* ROUTE
          SPACE  4,10
*         *DSP* FLAG BIT EQUIVALENCES.
 
 
 FRTI     EQU    4           *TID* OR FM/UN
 FRDC     EQU    20B         DISPOSITION CODE
 FRER     EQU    10000B      RETURN ERROR CODE
 
 
*         *DSP* ERROR CODES FOR THE *SUBMT* REQUEST.
 
 
 JBCE     EQU    32B         JOB STATEMENT ERROR
 USCE     EQU    34B         INCORRECT USER STATEMENT
 TDSP     SPACE  4,10
**        *DSP* PARAMETER BLOCK FOR KTSDMP JOBS (TASK ABORT/DUMP),
*                *K.DUMP*, *SUBMT*, AND *ROUTE* REQUESTS.
*                THE FIRST WORD IS USED AS AN INTERLOCK TO PREVENT
*                SIMULTANEOUS REQUESTS.
 
 
 TDSP     CON    0           FILE NAME / INTERLOCK
          VFD    12/,12/,12/0LNO,6/,18/FRER+FRDC+FRTI
          VFD    36/,24/DSQID
          BSSZ   4
          SPACE  4,10
*         TAF ERROR CODES FOR THE *ROUTE* REQUEST.
 
 
 EC100    EQU    100D        FWA OF DATA NOT SPECIFIED
 EC101    EQU    101D        LENGTH PARAMETER IN ERROR
 EC102    EQU    102D        STATUS RETURN ADDRESS NOT SPECIFIED
 EC103    EQU    103D        INCORRECT *DSP* PARAMETER
 EC104    EQU    104D        PARAMETER VALUE REQUIRED
 EC105    EQU    105D        FORMS CODE SPECIFIED ON INPUT DISPOSITION
 EC106    EQU    106D        DEFERRED ROUTING NOT ALLOWED
 EC107    EQU    107D        INCORRECT EXTERNAL CHARACTERISTIC
 EC108    EQU    108D        INCORRECT *DEF* PARAMETER
 EC109    EQU    109D        INCORRECT OUTPUT MAINFRAME LOGICAL ID
 EC110    EQU    110D        INCORRECT FORMS CODE
 EC111    EQU    111D        *TID* AND *FM/UN* CONFLICT
 EC112    EQU    112D        *TID/FM/UN* AND *ID* CONFLICT
 EC113    EQU    113D        INCORRECT INTERNAL CHARACTERISTIC
 EC114    EQU    114D        INCORRECT LOCAL DEVICE ID
 EC115    EQU    115D        JSN NOT ALLOWED
 EC116    EQU    116D        INCORRECT JSN VALUE
 EC117    EQU    117D        JOB NOT SYSTEM ORIGIN
 EC118    EQU    118D        INCORRECT ORIGIN TYPE
 EC119    EQU    119D        INCORRECT PRINT TRAIN IMAGE
 EC120    EQU    120D        INCORRECT REPEAT COUNT
 EC121    EQU    121D        INCORRECT SPACING CODE
 EC122    EQU    122D        INCORRECT DESTINATION LOGICAL ID
 EC123    EQU    123D        INCORRECT SERVICE CLASS
 TROU     SPACE  4,10
**        TROU - *DSP* PARAMETER BLOCK FOR THE *ROUTE* REQUEST.
*
*T  W0    42/ FILE NAME,6/ E,1/ F,4/ ,6/ OT,1/ C
*T, W1    12/ ,12/ FC,12/ DC,3/ EC,1/ S,2/ IC,18/ FLAGS
*T, W2    18/ SLID,18/ DLID,24/ TID
*T, W3    42/ UJN,18/ JP
*T, W4    2/ 0,1/ P,3/ PI,6/ SC,12/ SCL,12/ AC,7/ ,5/ RC,12/
*T, W5    60/
*T, W6    60/
*
*         E  - ERROR RETURN CODE.
*         F  - FORCE ORIGIN TYPE FLAG.
*         OT - DESIRED ORIGIN TYPE.
*         C  - COMPLETION BIT.
*         FC - FORMS CODE.
*         DC - DISPOSITION CODE.
*         EC - EXTERNAL CHARACTERISTIC.
*         S - FORCED SERVICE CLASS FLAG.
*         IC - INTERNAL CHARACTERISTIC.
*         FLAGS - SEE *DSP* DECK.
*         SLID - LOGICAL IDENTIFIER OF THE SOURCE MAINFRAME FOR THE
*                FILE.
*         DLID - LOGICAL IDENTIFIER OF THE DESTINATION MAINFRAME FOR
*                THE FILE.
*         TID - COMPLEMENT OF THE ADDRESS OF THE *FAMILY NAME - USER
*               NAME* TWO-WORD BLOCK.  CONTAINS 77777777B IF TO USE THE
*               FAMILY AND USER NAME OF THE CALLING JOB.
*         JP - JOB PRIORITY.
*         P - PRINT IMAGE FLAG (INDICATES PRINT IMAGE CODE PRESENT).
*         PI - PRINT IMAGE CODE (0-7) IF PRINT IMAGE FLAG SET.
*         SC - SPACING CODE.
*         SCL - SERVICE CLASS.
*         AC - ABORT CODE.
*         RC - REPEAT COUNT.
 
 
 TROU     EQU    TDSP        USE THE *SUBMT* *DSP* PARAMETER BLOCK
 TFUN     SPACE  4,10
**        TFUN - *DSP* FAMILY NAME AND USER NAME TABLE.
*
*T  W0    42/ FAMILY NAME,18/
*T, W1    42/ USER NAME,18/
 
 
 TFUN     BSSZ   2           FAMILY NAME - USER NAME
          SPACE  4,10
*         *DSP* INTERNAL FLAGS.
 
 PTID     CON    0           *TID* PROCESSED
 PFUN     CON    0           FAMILY NAME AND USER NAME PROCESSED
 PDID     CON    0           DEVICE ID PROCESSED
 PDEF     CON    0           *DEF* PROCESSED
 PJSN     CON    0           JSN PROCESSED
 PUJN     CON    0           UJN PROCESSED
 PDCT     CON    0           DISPOSITION CODE TYPE
 PECT     CON    0           EXTERNAL CHARACTERISTIC TYPE
 PJOT     CON    0           JOB ORIGIN
          LIST   X
*CALL     COMTDSP
          LIST   -X
 KOPTS    SPACE  4,10
 HDRL     EQU    7           LENGTH OF EDT HEADER
 
 
 IFL=     EQU    200000B     TAF INITIALIZATION FWA
 AFWA     EQU    VLOCL2      FWA FOR *AIP*
 ALWA     EQU    IFL=-1      LWA FOR LOADU AREA
 ECSXFR   EQU    1000B       EXTENDED MEMORY BLOCK TRANSFER
 MAXR     EQU    /COMSSCP/MAXR         MAXIMUM OUTSTANDING SSC REQUESTS
          SPACE  4,10
**        ASSEMBLY TIME ERROR CHECKS.
 
 
          ERRNG  1S"TLTANM"-1-MAXAQ  VALUE MUST BE .LE. 2**TLTAN-1
          ERRNG  MAXAQ-1     VALUE MUST BE .GE. 1
          ERRNZ  VSIW-/COMSSCP/SSIW  *VSIW* MUST EQUAL *SSIW*
          ERRNZ  VSCR-/COMSSCP/SSCR  *VSCR* MUST EQUAL *SSCR*
          ERRNZ  VLWP-LWPR   MEMORY MANAGEMENT NOT LOCATED AT *LWPR*
          ERRNZ  VHHA-104B   *CMM* HIGHEST ADDRESS NOT AT 104B
          ERRNG  MAXMFL-SCMFL  SCMFL MUST BE .LE. MAXMFL
          ERRNG  DLWA-DFWA-DSMNFL  NUMBER OF WORDS TO BE DUMPED TOO FEW
          ERRNG  DSMNFL-12   MINIMUM *DSDUMP* FL IS 12
 VERM     DATA   C*VERSION "VERT".*
 TMDC     TITLE  TIME DEPENDENT ROUTINE CONTROL.
**        TMDC   CHECK ELAPSED TIME SINCE PROCESSING FOR ALL TRANEX
*                TIME DEPENDENT ROUTINES. IF THE TIME LIMIT FOR A
*                ROUTINE HAS BEEN EXCEEDED, CALL THAT ROUTINE.
 
 
 TMDC     RTIME  ITIME       UPDATE CURRENT TIMD LOOP TIME
          SA1    VSCR
          NG     X1,CSI      IF SUBSYSTEM MESSAGE RECEIVED
          SA4    INRB        CHECK TRANSACTION INPUT
          ZR     X4,TMDC1    IF NO TRANSACTION INPUT
          RJ     PRIN        PROCESS TRANSACTION INPUT
 TMDC1    RJ     NGL         PROCESS TRANSACTION INPUT
 TMDC2    SX7    SCHTL       SCHEDULER TIME SPAN
          SA3    STIME       LAST SCHEDULER RUN
          MX2    -36
          SA4    ITIME       CURRENT TIME
          IX1    X4-X3
          BX6    -X2*X1      MILLISECONDS SINCE LAST SCHEDULER RUN
          IX3    X7-X6
          PL     X3,TMDC3    IF NOT TIME FOR SCHEDULER
          BX7    X4
          SA7    A3          NEW SCHEDULER TIME
          RJ     SCHD        RUN SCHEDULER
 TMDC3    SX7    RCLTL       TASK RECALL TIME SPAN
          SA3    RTIME       LAST RECALL PROCESSING TIME
          MX2    -36
          SA4    ITIME       CURRENT TIME
          IX1    X4-X3
          BX6    -X2*X1      MILLISECONDS SINCE LAST RECALL PROCESSING
          IX3    X7-X6
          PL     X3,TMDC5    IF NOT TIME FOR PROCESSING RECALL
          BX7    X4
          SA1    RCR         RECALL REQUEST WORD
          SA7    A3          SET NEW RECALL TIME
          ZR     X1,TMDC5    IF NO TASK IN RECALL
          SA2    CR          CPU REQUEST WORD
          SX6    B0
          BX7    X1+X2       SET CPU REQUEST BIT FOR RECALLED TASKS
          SA6    A1          ZERO OUT RECALL REQUEST WORD
          SA7    A2
 TMDC4    NZ     X2,TMDC5    IF CPU CURRENTLY IN DEMAND
          SA1    CR
          MX0    1           CIRCUMVENT *DCPT* TRAP CHECK
          LX0    -12
          BX7    X1+X0       SET CPU REQUEST BIT
          SA7    A1
          TB7    -CPAL,VCPA
          RJ     DCPT        FORCE CPU TASK SELECTION
          EQ     TSSC        TIME SLICE SUBCP
 
*         ONE SECOND INTERVAL TIME CHECKS.
 
 TMDC5    SX7    1000        ONE SECOND
          SA3    OTIME       LAST ONE SECOND INTERVAL TIME
          SA4    ITIME       CURRENT TIME
          MX2    -36
          IX3    X4-X3
          BX3    -X2*X3      MILLISECONDS SINCE LAST ONE SECOND CHECKS
          IX3    X7-X3
          PL     X3,TMDC10   IF ONE SECOND NOT ELAPSED
          BX7    X4
          SA7    A3
 
*         IF COMMUNICATIONS MAY BE ENABLED AFTER RECOVERY PROCEDURES,
*         ENABLE *SIC* TRANSFERS, TERMINAL COMMUNICATIONS, AND
*         SYSTEM CONTROL POINT TRANSFERS.
 
          SA1    STIN        START INPUT STATUS
          NG     X1,TMDC5.2  IF INPUT ENABLED
          ZR     X1,TMDC5.2  IF INPUT MAY NOT BE ENABLED
          MX7    1           SET INPUT ENABLED
          SA7    A1
          SA2    TMDCC
          NZ     X2,TMDC5.2  IF *SIC* AND *SCP* ENABLED
          SX7    B1
          SA7    A2
          SETICC TDMCD       ENABLE *SIC* TRANSFERS
          RJ     NON         ENABLE TERMINAL COMMUNICATIONS
          SA1    BFPT        MESSAGE POINTER
          SA2    TAID        ENABLE *SCP* COMMUNICATIONS
          BX6    X1
          BX7    X2
          SA6    VSCR
          SA7    VSIW
          CALLSS 0,TMDCB     INITIALIZE TAF AS A *SCP*
 TMDC5.2  SA1    CR          GET NUMBER OF ACTIVE SUBCP
          SA2    RCR
          CX3    X1
          CX4    X2          NUMBER OF SUBCP IN RECALL
          IX5    X3+X4
          SX7    B1
          ZR     B2,TMDC5.3  IF NO ACTIVE SUBCP
          IX5    X5+X7
 TMDC5.3  SA1    STAT16      TOTAL ACTIVE TASKS
          IX6    X1+X5
          SA2    A1+B1
          IX7    X2+X7       UPDATE NUMBER OF SAMPLE
          SA6    A1
          SA7    A2
          SA1    STAT17      GET TOTAL NUMBER OF OUTSTAND *SSC* REQUEST
          SA2    SSCC        GET OUTSTANDING REQUEST COUNT
          IX7    X1+X2
          SA7    A1          UPDATE NUMBER OF OUTSTANDING *SSC* REQUEST
          RJ     KDIS        UPDATE K-DISPLAY
          RJ     SRL         CHECK ROLLOUT TABLE FOR TIMED OUT ENTRIES
          RJ     AIQ         AGE INPUT QUEUE PRIORITIES
          RJ     CCS         CHECK CDCS STATUS
          SX7    CORTL       CORE USAGE CHECK TIME
          SA3    UTIME       LAST CORE USAGE CHECK
          SA4    ITIME       CURRENT TIME
          MX2    -36
          IX1    X4-X3
          BX6    -X2*X1      MILLISECONDS SINCE LAST CHECK
          IX3    X7-X6
          PL     X3,TMDC7    IF NOT TIME FOR CORE USAGE CHECK
          BX7    X4
          SA7    A3          SET NEW CHECK TIME
          RJ     CORU        CHECK CORE USAGE
 TMDC7    SA2    TACTL       ITASK ACTIVATION TIME CHECK
          SA3    TTIME       LAST ACTIVATION CHECK TIME
          SA4    ITIME       CURRENT TIME
          MX7    -36
          IX1    X4-X3
          BX6    -X7*X1      MILLISECONDS SINCE LAST CHECK
          IX3    X2-X6
          PL     X3,TMDC8    IF NOT TIME FOR INITIAL TASK CALL
          BX7    X4
          SA7    A3          SET NEW ACTIVATION CHECK TIME
          SA4    ITAS        INITIAL TASKS NAME
          SX5    CIACT       ITASK ACTIVATION CODE
          SB3    B0          NO BUFFER INPUT
          SX7    B0          SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         GENERATE A SYSTEM ORIGIN TRANSACTION
          NZ     X0,TMDC8    IF TRANSACTION SCHEDULED
          SX7    B0+         RETRY NEXT PASS THROUGH LOOP
          SA7    TTIME
 TMDC8    SA2    SJTTL       STATISTIC JOURNAL TIME
          SA3    JTIME       LAST JOURNAL TIME
          SA4    ITIME       CURRENT TIME
          MX7    -36
          IX1    X4-X3
          BX6    -X7*X1      MILLISECONDS SINCE LAST JOURNAL
          IX3    X2-X6
          PL     X3,TMDC9    IF NOT TIME FOR JOURNAL
          BX7    X4
          SA7    A3          SET NEW JOURNAL TIME
          RJ     JSTS        WRITE STATISTICS TO JOURNAL FILE
 TMDC9    SA1    B0          CHECK RA+0
          LX1    59-15
          PL     X1,TMDC10   IF NO IDLE DOWN
          BX6    X6-X6       CLEAR RA+0
          SA6    B0
          RJ     IDL         SET IDLE DOWN FLAG
 TMDC10   NZ     B7,TMDC11   IF AT LEAST ONE SUBCP ACTIVE
          RECALL             ** GIVE UP CP **
          EQ     TSSC        TIME SLICE SUB CPS
 
 TMDC11   SA1    CR          ADVANCE CPU SWITCHING MASK
          SA2    A1+B1
          MX7    13
          TX3    B7+CPAL,-VCPA  EXTEND MASK TO ACTIVE SUB CP
          BX2    -X2*X1
          AX3    SCPAL
          ZR     X2,TMDC12   IF MASK EXTENDS TO HIGHEST ACTIVE SUBCP
          SB3    X3
          AX7    X7,B3
 TMDC12   SA7    A2          SET NEW MASK
          BX2    X2-X2
          EQ     TMDC4       FORCE RESELECTION OF SUBCP
 
 TMDCB    BSSZ   1           PARAMETER ADDRESS FOR INITIAL *CALLSS*
 TMDCC    BSSZ   1           1 IF *BTASK* SCHEDULED ONCE
 
 TDMCD    BSS    0           *SIC* CALL BUFFER POINTERS
          VFD    12/0,6/INRBL-1,18/INRB,6/INRB1L-1,18/INRB1
          VFD    12/0,6/0,18/0,6/0,18/0
 CCS      SPACE  4,20
**        CCS - CHECK CDCS STATUS.
*
*         ENTRY  (CDST) = 0, IF NORMAL CONDITION.
*                         1, IF CDCS ABORTED.
*                         -1, IF CDCS TERMINATE REQUEST NOT COMPLETED.
*                         2, IF *RCTASK* NOT SCHEDULED.
*
*         EXIT   (CDST) UPDATED ACCORDINGLY.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 7.
*                B - 3.
*
*         CALLS  SYS=, TRN, TRO.
 
 
 CCS      SUBR               ENTRY/EXIT
          SA1    CDST
          SB3    X1+
          ZR     X1,CCSX     IF NORMAL - RETURN
          NG     X1,CCS2     IF TERMINATE REQUEST ISSUED
          GT     B3,B1,CCS3  IF *RCTASK* NOT SCHEDULED
 
*         ISSUE FAKE CDCS TERMINATE REQUEST.
*         THIS IS USED ONLY TO DETERMINE CDCS-STATUS.
 
 CCS1     SA2    CDPB
          BX7    X2
          SA3    A2+B1       FWA OF CDCS REQUEST WORD
          SA7    CDPA        FWA OF REQUEST WORD
          BX6    X3
          SX7    -B1         INDICATE CDCS REQUEST ISSUED
          SA7    CDST
          RJ     SYS=        ISSUE CDCS REQUEST
 
*         CHECK RETURN STATUS.
 
 CCS2     SA2    CDPA        FWA OF REQUEST
          LX2    59-CDCBS
          SX7    B1          INDICATE CDCS ABORTED
          PL     X2,CCSX     IF REQUEST NOT COMPLETE
          SA7    CDST
          MX0    -CDSFN      GET ERROR CODE
          LX2    CDSFN-1-CDSFS-59+CDCBS
          SX3    SSNP        CDCS NOT AVAILABLE
          BX7    -X0*X2
          IX4    X7-X3
          PL     X4,CCSX     IF CDCS NOT AVAILABLE
 
*         WHEN CDCS IS UP, SCHEDULE *RCTASK*.
 
 CCS3     SA1    TROA        TAF ROLLOUT STATUS
          ZR     X1,CCS4     IF TAF IS ROLLED IN
          RJ     TRI         ROLL TAF IN
 CCS4     BX5    X5-X5
          SB3    B0
          SA4    RCTAS       *RCTASK*
          SX7    B0
          RJ     TRN         SCHEDULE *RCTASK*
          SX7    B1+B1
          ZR     X0,CCS5     IF *RCTASK* NOT SCHEDULED
          BX7    X7-X7
 CCS5     SA7    CDST
          EQ     CCSX        RETURN
 CSI      SPACE  4,15
**        CSI - CONTROL SUBSYSTEM INTERFACE.
*
*         ENTRY  (SSRP) = SUBSYSTEM REQUEST BUFFER.
*                (TROA) = 0, IF *TAF* NOT ROLLED OUT.
*
*         EXIT   TO *PBC*,  IF BATCH/CRM REQUEST.
*                TO *PBT*,  IF BATCH TRANSACTION REQUEST.
*                TO *PBE*,  IF INCORRECT BATCH REQUEST.
*                TO *TSSC*, IF SYSTEM GENERATED MESSAGE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 6.
*                B - 3, 4.
*
*         CALLS  BJT, RAC, RAN, TRI.
 
 
 CSI      SA3    TROA
          ZR     X3,CSI1     IF *TAF* NOT ROLLED OUT
          RJ     TRI         ROLL *TAF* IN
          RTIME  ITIME       UPDATE CURRENT TIME
 CSI1     MX0    -6
          SA2    SSRP
          LX2    5-23        RIGHT JUSTIFY STATUS FIELD
          BX4    -X0*X2
          SA1    SSJN        FETCH QUEUE PRIORITY FOR SUBSYSTEM ABORT
          NZ     X4,CSI2     IF NOT A *UCP* REQUEST
          SA2    SSUH        FIRST WORD OF *UCP* PARAMETERS
          LX2    5-23        RIGHT JUSTIFY WORD COUNT
          SA1    SSUP        SECOND WORD OF *UCP* PARAMETERS
          UX1    B3          GET FUNCTION CODE
          SX5    JSFC        ERROR RETURN CODE
          SB4    CSIB        NUMBER OF LEGAL FUNCTIONS
          GT     B3,B4,PBE   IF INCORRECT FUNCTION CODE
          SA1    B3+CSIA
          SB4    X1          REQUEST PROCESSOR ADDRESS
          BX2    -X0*X2      NUMBER OF PARAMETER WORDS PASSED
          AX1    18          EXPECTED WORD COUNT
          BX1    X1-X2
          NZ     X1,PBE      IF ERROR IN WORD COUNT
          JP     B4          BRANCH TO REQUEST PROCESSOR
 
 CSI2     SX3    X4-4
          ZR     X3,CSI3     IF A SUBSYSTEM ABORT MESSAGE
          RJ     BJT         PROCESS BATCH JOB TEMINATION
          EQ     CSI5        GO ACKNOWLEDGE REQUEST
 
 CSI3     SX2    X1-CDSI
          NZ     X2,CSI4     IF NOT *CDCS* ABORT
          RJ     RAC         RECOVER FROM ABORT OF *CDCS*
          SX2    X1-NMSI
          EQ     CSI5        ACKNOWLEDGE REQUEST
 
 CSI4     SX2    X1-NMSI
          NZ     X2,CSI5     IF NOT *NAM* ABORT
          RJ     RAN         RECOVER FROM ABORT OF *NAM*
 CSI5     SA1    BFPT
          BX6    X1
          SA6    VSCR        ACKNOWLEDGE REQUEST
          EQ     TSSC        EXIT TO TASK TIME SLICING
 
 CSIA     BSS    0           BATCH REQUEST JUMP TABLE
          VFD    36/0,6/BCWC,18/PBC  FC=0 - BATCH/CRM REQUEST
          VFD    36/0,6/BTWC,18/PBT  FC=1 - BATCH TRANSACTION
 CSIB     EQU    *-CSIA-1
 EXIT     SPACE  4,10
**        EXIT - PROGRAM STOP.
*
*         *TAF* HAS SEVERAL PLACES WHERE IT CAN DETECT AN INTERNAL
*         SOFTWARE ERROR OF FATAL PORPORTIONS.  IF THIS HAPPENS,
*         *TAF* BRANCHES TO *EXIT*.
 
 
 EXIT     SUBR               ENTRY
          PS                 PROGRAM STOP
 EXI      SPACE  4,15
**        EXI - REPRIEVE PROCESSOR.
*
*
*         ENTRY  (TROA) = *TAF* ROLL STATUS.
*                (EXIA) = REPRIEVE PARAMETER BLOCK.
*
*         EXIT   ABORT, IF INTERNAL ERROR OR OPERATOR DROP.
*                TERMINATE, IF OPERATOR IDLE DOWN.
*
*         CALLS  LOVL, NOF, TRI.
*
*         MACROS ABORT, ENDRUN, MESSAGE, REPRIEVE.
 
 
 EXI      BSS    0           ENTRY POINT FOR *REPRIEVE*
          SA1    EXIT
          NZ     X1,EXI3     IF TAF INTERNAL ERROR
          SA1    TROA        *TAF* ROLLOUT STATUS
          ZR     X1,EXI1     IF *TAF* IS ROLLED IN
          RJ     TRI         ROLL *TAF* IN
 EXI1     SA1    CURFL       RESET CURRENT FL
          SETRFL X1
          SA1    EXIA+7
          MX0    -12
          BX3    -X0*X1      ERROR CODE
          SX5    X3-ORET
          ZR     X5,EXI4     IF OVERRIDE ERROR CONDITION
 EXI2     SYSTEM DMD,R       DUMP EXCHANGE PACKAGE TO OUTPUT
          ONSW   10B         SET SENSE SWITCH 4 FOR TAF RESTART
          RJ     NOF         NETOFF
          REPRIEVE  EXIA,RESET,77B
 
*         TAF DETECTED AN INTERNAL ERROR.
 
 EXI3     SA1    CURFL       RESET CURRENT FL
          SETRFL X1
          MESSAGE  EXIB      * TAF INTERNAL ERROR.*
          EQ     EXI2        ABORT
 
*         OPERATOR OVERRIDE
 
 EXI4     MESSAGE  EXIC      * OPERATOR OVERRIDE.*
          ENDRUN             TERMINATE
 
 EXIA     VFD    36/0,12/25,2/0,9/1,1/0  REPRIEVE PARAMETER BLOCK
          VFD    30/0,30/EXI
          BSSZ   23
 EXIB     DATA   C* TAF INTERNAL ERROR.*
 EXIC     DATA   C* OPERATOR OVERRIDE.*
 PRIN     TITLE  PROCESS TRANSACTION INPUT.
**        PRIN   PRIN TRANSFERS TRANSACTION INPUT FROM THE RECEIVING
*                BUFFER TO COMMUNICATION BLOCKS, AND QUEUES THEM UP
*                FOR INITIAL TASK TO PROCESS.
*
*         ENTRY  (A4) = ADDRESS OF INPUT BUFFER.
*                (X0) = COMMUNICATION BLOCK ADDRESS, IF IN *NAM* MODE.
*
*         EXIT   (X0) = 0, IF INPUT NOT PROCESSED.
*                     = COMMUNICATION BLOCK ADDRESS, OTHERWISE.
*                (PRINA) = COMMUNICATION BLOCK ADDRESS, IF *ITASK* BUSY.
*                        = NEGATIVE, IF COMMUNICATION BLOCK OVERFLOW.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3, 5, 6.
*                X - ALL.
*
*         CALLS  RCPT, RDCB, TRI.
 
 
 PRIN     SUBR               ENTRY/EXIT
          SA4    A4
          LX4    59-55
          NG     X4,PRIN3    IF COMMUNICATE WITH NAM
          SX5    B0          CLEAR PRIOR OVERFLOW FLAG
          BX6    X6-X6
          SA2    PRINA       CHECK FOR PRIOR UNPROCESSED INPUT
          SA3    TROA        ROLL STATUS
          NZ     X2,PRIN6    IF AN OVERFLOW CONDITION EXISTS
 PRIN1    ZR     X4,PRINX    IF NO INPUT TO PROCESS
          ZR     X3,PRIN2    IF NOT ROLLED OUT
          RJ     TRI         ROLLIN TRANEX
 PRIN2    SA4    A4+
          PL     X4,CSM      IF COMMAND/STATUS
          RJ     RDCB        TRANSFER DATA TO A COMMUNICATION BLOCK
          NG     X0,PRIN     IF INPUT WAS FOR INTERACTIVE TASK
          NZ     X0,PRIN3    IF COMMUNICATION BLOCK AVAILABLE
          SX6    400000B
          SA6    PRINA       SET C.B. OVERFLOW FLAG
          EQ     PRINX       RETURN
 
*         SET UP TRANSACTION TO BE PROCESSED BT INTIAL TASK.
 
 PRIN2.1  ZR     X3,PRIN3    IF NOT ROLLED OUT
          RJ     TRI         ROLL IN *TAF*
 PRIN3    TA1    CPAHL,VCPA  INITIAL TASK C. B. CONTROL WORD
          SB6    A1+CPACL-1  END OF COMMUNICATION BLOCKS FOR TASK
 PRIN4    ZR     X1,PRIN5    IF CONTROL WORD OPEN
          SB5    A1
          SA1    A1+B1
          NE     B5,B6,PRIN4 IF NOT END OF CONTROL WORDS
          SX7    X0          COMMUNICATION BLOCK ADDRESS
          BX0    X0-X0
          SX6    B0+         INDICATE *ITASK* BUSY EVENT
          SA7    PRINA       SET OVERFLOW FLAG - NOTE IT IS C.B. ADDR
          SA6    EVIT        INDICATE *ITASK* BUSY EVENT
          EQ     PRINX       RETURN - ITASK BUSY
 
 PRIN5    MX2    1
          TA4    1,VCPA      CONTROL POINT WORD
          MX3    1
          SX0    X0          COMMUNICATION BLOCK ADDRESS
          LX2    -5          INITIAL LOAD BIT
          BX2    X2+X3       SET WAITING FOR CPU BIT
          LX3    1+36
          BX7    X2+X0
          SA7    A1          SET ENTRY FOR INITIAL TASK
          IX6    X4+X3       INCREMENT COMMUNICATION BLOCK COUNT
          SB6    A4-B1
          SB3    X4
          SA6    A4
          NZ     B3,PRINX    IF *ITASK* ACTIVE - RETURN
          SA4    VFSCP       FWA OF SUB-CONTROL POINTS
          SB3    PRIN        RETURN ADDRESS AFTER REQUESTING CPU
          AX4    24
          EQ     RCPT        REQUEST CPU FOR INITIAL TASK
 
*         PROCESS INPUT OVERFLOW CONDITIONS.
 
 PRIN6    SA6    A2          CLEAR OVERFLOW INDICATOR
          BX0    X2
          PL     X2,PRIN2.1  IF OVERFLOW DUE TO A BUSY ITASK
          SX5    B1          SET PRIOR OVERFLOW FLAG
          EQ     PRIN1
 
 PRINA    CON    0           INPUT OVERFLOW FLAG
          TITLE  CORE RESIDENT ROUTINES.
 RAC      SPACE  4,10
**        RAC - RECOVER FROM ABORT OF *CDCS*.
*
*         *RAC* WILL ABORT THOSE TASKS WAITING FOR THE COMPLETION
*         OF A *CDCS* REQUEST.
*
*         ENTRY  (VCPA) = FWA OF SUBCP TABLE.
*
*         EXIT   (CDST) = 1.
*                CDCS ABORT FLAG SET IN SCP TABLE OR ROLLOUT TABLE
*                IF TERMINAL WAS WAITING FOR CDCS RESPONSE OR CONNECTED
*                TO CDCS AND ROLLED OUT, RESPECTIVELY.
*
*         USES   X - ALL.
*                A - 2, 4, 5, 7.
*                B - 5.
*
*         CALLS  SRO, SSM.
*
*         MACRO  MESSAGE.
 
 
 RAC5     RJ     SSM         SUBSYSTEM MESSAGE
 
 RAC      SUBR               ENTRY/EXIT
          SX7    B1+
          SA7    CDST        INDICATE CDCS IS ABORTED
          MESSAGE  RACA      * CDCS ABORT.*
          MX0    -18
          SB5    B0
          TA2    0,VCPA      FIRST SUBCONTROL POINT TABLE ENTRY
          MX3    1           SET CDCS ABORTED FLAG
          LX3    SCCDS-59
          SX6    SSC5
 RAC2     BX4    X2
          SA5    A2+B1
          SA2    A5+B1       NEXT SUBCONTROL POINT TABLE ENTRY
          LX5    59-SCRCS
          PL     X5,RAC3     IF TASK NOT IN RECALL STATUS
          SA4    X4-NUAPL+RCL  GET RETURN ADDRESS
          BX1    -X0*X4
          IX7    X1-X6
          NZ     X7,RAC3     IF NOT WAITING FOR *CDCS* RESPONSE
          LX5    59-59-59+SCRCS
          BX7    X3+X5       SET CDCS ABORTED FLAG
          SA7    A5
 RAC3     SX7    X2          NEXT SUBCONTROL POINT TABLE ENTRY
          SA2    X2
          NZ     X7,RAC2     IF MORE SUBCP TO SEARCH
 RAC4     RJ     SRO         SEARCH ROLLOUT TABLE
          ZR     B5,RAC5     IF ROLLOUT TABLE SEARCH COMPLETED
          SA2    B5+2        GET WORD 2 OF ROLLOUT TABLE
          BX3    X2
          LX2    59-RTCDS
          PL     X2,RAC4     IF TASK IS NOT CONNECTED TO *CDCS*
          MX7    1           SET ABORT FLAG
          LX7    RTABS-59
          BX7    X3+X7
          SA7    A2
          EQ     RAC4        CONTINUE TO SEARCH THE ROLLOUT TABLE
 
 RACA     DATA   C* ABORT OF CDCS DETECTED.*
 RSP      SPACE  4,15
**        RSP - RESTORE SUBCONTROL POINT REGISTERS.
*
*         ENTRY  (SREG) = 24/0,18/SA,18/SCP
*                SA  = FWA OF ACTIVE TASK SYSTEM AREA.
*                SCP = FWA OF ACTIVE TASK SUBCONTROL POINT TABLE.
*
*         EXIT   (B2) = FWA OF ACTIVE TASK SYSTEM AREA.
*                (B7) = FWA OF ACTIVE TASK SUBCONTROL POINT TABLE.
*
*         USES   A - 1.
*                B - 2, 7.
*                X - 1.
 
 
 RSP      SUBR               ENTRY/EXIT
          SA1    SREG        FWA OF TASK SYSTEM AREA AND SUBCP
          SB7    X1
          AX1    18
          SB2    X1
          EQ     RSPX        RETURN
 SRO      SPACE  4,15
**        SRO - SEARCH ROLLOUT TABLE.
*
*         ENTRY  (B5) = 0 IF INITIAL CALL.
*                A1/X1/B3/B6 = LAST EXIT VALUES IF NOT INITIAL CALL.
*
*         EXIT   (B5) = ADDRESS OF RESERVED ROLLOUT TABLE ENTRY.
*                (B5) = 0 IF NO MORE RESERVED ENTRIES.
*                (B6) = CURRENT SEARCH POSITION.
*                (B3) = WORD OVERFLOW COUNTER.
*                (A1/X1) = CURRENT ROLLOUT TABLE WORD BEING SEARCHED.
*
*         USES   A - 1.
*                B - 3, 5, 6.
*                X - 1, 2, 7.
 
 
 SRO      SUBR               ENTRY/EXIT
          MX7    1
          NZ     B5,SRO1     IF NOT INITIAL CALL
          SB3    B0
          SA1    TROM        ROLLOUT TABLE MAP ALLOCATION
          SB6    B1
          BX1    X1+X7       SEARCHING FOR ZERO BITS
 SRO1     NX1,B5 X1
          SB6    B6+B5       ADVANCE POSITION
          SB5    B6-NROL-1
          NZ     X1,SRO2     IF NOT AT END OF WORD
          SA1    A1+1
          SB3    B3+47
          SB6    B3+B1
          BX1    X1+X7
          EQ     SRO1        CONTINUE WITH NEXT WORD
 
 SRO2     ZR     B5,SROX     IF END OF SEARCH
          LX7    -12
          BX1    X1+X7
          SX7    TROLE       LENGTH OF ROLLOUT TABLE ENTRY
          SX2    B6
          IX2    X2*X7
          SB5    X2-TROLE+TROL  FWA OF ROLLOUT TABLE ENTRY
          EQ     SROX        RETURN
          TITLE  ROLLIN AND ROLLOUT ROUTINES.
 TRO      SPACE  4,20
**        TRO - ROLLOUT.
*
*                WHEN NO TRANSACTIONS ARE IN PROCESS OR HAVE
*                BEEN RECEIVED FOR N MILLESECONDS, THE TRANSACTION
*                SUBSYSTEM ROLLS MOST OF ITS FIELD LENGTH
*                TO A FILE, REDUCES ITS FIELD LENGTH,
*                AND IDLES UNTIL A TRANSACTION OR A K-DISPLAY COMMAND
*                IS RECEIVED.
*
*         EXIT   TO *TMDC*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 3, 4, 5, 6, 7.
*                B - 5.
*
*         CALLS  NGL, PBT, PRIN, SRO, TRI.
*
*         MACROS CONSOLE, MEMORY, MESSAGE, RECALL, REWIND, RTIME,
*                WRITER.
 
 
 TRO      SX7    0
          SA1    VTST        O-DISPLAY CONTROL WORD
          SA7    A1          SET O-DISPLAY INACTIVE
          BX6    X1
          SA6    TROD        SAVE TST ADDRESS POINTERS
          SA1    TROB+1      FIRST
          SX7    X1
          SA7    A1+B1       IN
          SA7    A7+B1       OUT
          SX7    X7+100B
          SA7    A7+B1       LIMIT
          REWIND TROB,R      REWIND ROLLOUT FILE
          SX6    TRFL        IDLE FIELD LENGTH
          SA1    CURFL       CURRENT FIELD LENGTH
          LX6    30
          BX7    X1
          SA7    TROB+4      LIMIT
          SA6    TROC
          SX7    X7-1
          SA7    TROB+2      IN
          WRITER TROB,R      WRITE OUT FILED LENGTH TO DISK
          CONSOLE KIDL       SWITCH TO IDLE K DISPLAY
          MEMORY CM,MRSW,R,TRFL  REDUCE FL
          RTIME  TROA        REAL TIME CLOCK AT START OF ROLLOUT
          MESSAGE  TROE,1    * TAF IDLE.*
          MESSAGE  ZWORD,2
 
*         IDLE UNTIL INPUT IS AVAILABLE.
 
 TRO2     SA1    TROA
          ZR     X1,TMDC     RESUME NORMAL PROCESSING
          RECALL
          SA1    B0          CHECK RA+0
          LX1    59-15
          PL     X1,TRO2.1   IF NO IDLE DOWN
          BX6    X6-X6       CLEAR RA+0
          SA6    B0
          RJ     TRI         ROLL IN TAF
          RJ     IDL         SET IDLE DOWN FLAG
          EQ     TMDC        ENTER MAIN LOOP
 
 TRO2.1   RTIME LTIME        REAL TIME CLOCK
          SA4    LTIME
          SA3    TROA        TIME AT ROLLOUT
          MX2    -36
          SA5    TROTL
          IX1    X4-X3
          BX6    -X2*X1      TIME SINCE ROLLOUT
          IX3    X5-X6
          PL     X3,TRO4     IF NOT TIME FOR ROLLIN
 TRO3     SA1    TROA
          ZR     X1,TMDC     IF ALREADY ROLLED IN
          RJ     TRI         ROLL IN
          EQ     TMDC        ENTER MAIN LOOP
 
 TRO4     SA1    VSCR
          NG     X1,CSI      IF SUBSYSTEM MESSAGE RECEIVED
          SA4    INRB
          RJ     PRIN        CHECK FOR INPUT
          RJ     NGL         GET INPUT FROM NAM
          SA1    KBUF
          NZ     X1,TRO3     IF ACTIVITY, ROLLIN *TAF*
          RJ     CCS         CHECK CDCS STATUS
          SB5    B0+
 
*         IF ANY ROLLOUT ENTRIES HAVE TIMED OUT, ROLLIN *TAF*.
 
 TRO6     RJ     SRO         SEARCH ROLLOUT TABLE
          ZR     B5,TRO2     IF NO ROLLOUT ENTRIES TIMED OUT
          SA5    B5          ROLLOUT ENTRY
          LX5    59-RTBTR
          PL     X5,TRO6     IF NOT TIMED ROLLOUT
          SA4    LTIME
          LX5    59-RTBID+24-59+RTBTR
          MX7    -24
          LX4    24
          BX4    -X7*X4      CURRENT TIME IN SECONDS
          BX3    -X7*X5      ROLLIN TIME IN SECONDS
          IX4    X3-X4
          PL     X4,TRO6     IF TIME NOT EXPIRED
          EQ     TRO3        ROLL *TAF* IN
 
 TROA     BSSZ   1           ROLLOUT FLAG WORD
 TROB     FILEB  TRFL,TRFL   ROLLOUT FET
 TROC     BSS    1           STATUS WORD FOR MEMORY REQUESTS
 TROD     BSS    1           SAVE TST POINTERS
 TROE     DATA   C* TAF IDLE.*
 TROF     CON    0           ROLLOUT INHIBIT FLAG
 TRI      SPACE  4,15
**        TRI - ROLLIN FIELD LENGTH.
*
*         TO RESUME PROCESSING AFTER A ROLLOUT, THIS ROUTINE
*         REQUESTS FIELD LENGTH AND READS THE ROLLOUT FILE
*         BACK OVER THE NEW FIELD LENGTH.
*
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 4, 6, 7.
*
*         CALLS  EXIT.
*
*         MACROS CONSOLE, MEMORY, MESSAGE, READSKP, REWIND.
 
 
 TRI      SUBR               ENTRY/EXIT
 TRI1     SA1    CURFL       FL REQUIRED FOR ROLLIN
          MEMORY CM,MRSW,R,X1  REQUEST FL
          SA2    MRSW        GET STATUS WORD
          MX4    30
          BX6    X4*X2       NEW FL
          SA1    CURFL       REQUEST FL
          LX6    30
          IX2    X6-X1
          NG     X2,TRI1     IF FL NOT GRANTED
          REWIND TROB        ROLLOUT FILE
          READSKP TROB,,R    READ IN FIELD LENGTH
          CONSOLE KCTRL1     SWITCH TO MAIN K DISPLAY
          MESSAGE  VERM,1    * VERSION NUMBER.*
          MESSAGE  ZWORD,2
          SA1    TROD        RESTORE TST ADDRESS POINTERS
          BX7    X7-X7
          BX6    X1
          SA7    TROA        CLEAR ROLLOUT FLAG
          SA6    VTST        SET O-DISPLAY ACTIVE
          EQ     TRIX        RETURN
 
 
*         DEFINE ERP$ FOR COMCCIO ERROR RETURN.
 
 ERP$     BSS    0           ENTRY FROM COMCCIO FOR ERRORS
          SA1    TROA
          ZR     X1,ERP      IF TRANEX NOT ROLLED OUT
          RJ     EXIT        FORCE ABORT IF ROLLED OUT
          SPACE  4
*         IDLE K DISPLAY.
 
 KIDL     VFD    24/KBUF,18/0,18/KIBF
 KIBF     CON    2
          KDL    28,T,(TAF STATUS)
 KSEQ     KDL    35,,(                )
          KDL    15,K,(TRANSACTION SEQUENCE NUMBER)
 K        SET    K+5
          KDL    29,K,(- IDLE -)
          CON    0
 KBUF     BSSZ   5           K-DISPLAY KEYBOARD BUFFER
          DATA   1L.         ALLOW COMMANDS WITH MISSING TERMINATOR
 
*         COMMON DECKS USED BY ROLLIN PROCESSOR
 
*CALL COMCCIO
*CALL     COMCCPM
*CALL COMCSYS
          LIST   X
*CALL     COMKNWC
          LIST   -X
 
 
 .1       SET    *+77B
 TRFL     EQU    .1/100B*100B  ROLLOUT FIELD LENGTH
 TSSC     TITLE  TIME SLICE SUBCONTROL POINTS.
**        TSSC - TIME SLICE SUBCONTROL POINTS.
*
*         *TSSC* ACTIVATES SUBCP-S WHICH ARE REQUESTING THE CPU.
*         IF THERE ARE ANY OUTSTANDING DATA MANAGER REQUESTS, *TSSC*
*         BRANCHES TO THE DATA MANAGER BEFORE ACTIVATING A SUBCP.
*         *TSSC* MONITORS PPU COMPLETION BITS AND REINITIATES ROUTINES
*         WHEN THEIR PPU CALL IS COMPLETE.
*         AT ABSOLUTE TIME INTERVALS, CONTROL IS PASSED BACK TO THE
*         MAIN LOOP FOR TIME DEPENDENT AND RECALL DEPENDENT ROUTINES.
*
*         ENTRY  (DTIME) = TIME AT LAST DATA MANAGER CALL.
*                (TDBAA) = *TOTAL* D.M. STATUS WORD.
*                (TPLW) = STATUS WORD FOR OUTSTANDING PPU REQUESTS.
*                (BTIME) = REAL TIME CLOCK AT LAST REJECTED *SIC*.
*                (RSCH) = TASK SCHEDULER REQUEST WORD.
*                (ITIME) = REAL TIME CLOCK AT LAST INPUT PROCESSING.
*                (PBCA) = NUMBER OF OUTSTANDING *BATCH/CRM* REQUESTS.
*
*         EXIT   TO *TMDC* IF NO SUBCP REQUESTING THE CPU OR IF TIME
*                          FOR TIME DEPENDENT ROUTINE.
*                TO *TERR23* IF *TOTAL* D.M. REQUESTED TASK ABORTED.
*                TO *TERR16* IF OPERATOR DROP OR D.M. ABORT.
*                TO *TRCL1* IF TASK RESTART AFTER RECALL.
*                TO *BRC* IF ACTIVE *BATCH/CRM* REQUEST.
*                TO ACTIVATE THE SUBCP WITH RETURN TO *SRTN*,
*                          IF NONE OF THE ABOVE CONDITIONS EXIST.
*                (LTIME) = CURRENT REAL TIME CLOCK.
*                (B1), (B2) AND (B7) ARE RESTORED.
*
*         USES   X - ALL.
*                A - ALL.
*                B - ALL.
*
*         CALLS  CLJF, /DBM/DMGR, EXIT, MVE=, PDMR,
*                PRIN, RSP, SCHD, SNS, TOTAL,
*                NGL (*TAFNAM* ONLY).
*
*         MACROS RTIME, XCHNGE.
 
 
 TSSC     RTIME  LTIME       CURRENT TIME
          RJ     ATW         ADVANCE *TAF* WORK
          RJ     RSP         RESTORE SUBCP REGISTERS
          SX7    DMMTL       MINIMUM TIME BETWEEN DATA MANAGER RUNS
          SA3    DTIME       LAST DATA MANAGER CALLED TIME
          SA4    LTIME       CURRENT TIME
          MX2    -36
          IX3    X4-X3
          BX3    -X2*X3      MILLISECONDS SINCE LAST DATA MANAGER RUN
          IX3    X7-X3
          PL     X3,TSSC3    IF MINIMUM TIME NOT ELAPSED
          BX6    X4
          SA6    A3
          SA1    TDBAA       TOTAL D.M. STATUS
          SX2    X1+         NUMBER OF OUTSTANDING *TOTAL* REQUESTS
          ZR     X2,TSSC1    IF NO OUTSTANDING TOTAL REQUESTS
 TSSCA    RJ     EXIT        CALL *TOTAL* - MODIFIED BY *PRE*
*         RJ     =XTOTAL     (PROCESS *TOTAL* DATA MANAGER REQUEST)
          SB1    1
          RJ     RSP         RESTORE SUBCONTROL POINT REGISTERS
          RJ     PDMR        PROCESS DATA MANAGER REPLIES
 TSSC1    SA1    AAMA        AAM STATUS WORD
          SX2    X1          NUMBER OF OUTSTANDING AAM REQUESTS
          ZR     X2,TSSC3    IF NO AAM REQUESTS
 TSSCB    RJ     0           MODIFIED BY *PRE*
*         RJ     =XAMI       (CALL ADVANCED METHODS INTERFACE)
          SB1    1
          RJ     RSP         RESTORE SUBCONTROL POINT REGISTERS
          ZR     B2,TSSC2    IF NO ACTIVE TASK
          SA1    B7
          SX7    B7
          SB2    X1-NUAPL    RA OF ACTIVE TASK
          SX1    B2          UPDATE (SREG)
          LX1    18
          BX7    X1+X7
          SA7    SREG
 TSSC2    RJ     PDMR        PROCESS DATA MANAGER REPLIES
 TSSC3    SA1    VSCR
          NG     X1,CSI      IF SUBSYSTEM MESSAGE RECEIVED
          SA1    TPLW
          ZR     X1,TSSC5    IF NO OUTSTANDING PPU REQUESTS
          SB4    X1
          BX7    X7-X7
          ZR     B4,TSSC4    IF NOT A TASK LOAD
          SA2    B4
          LX2    -1
          PL     X2,TSSC4    IF TASK LOAD NOT COMPLETED
          SB4    TSSC4       RETURN ADDRESS
          SA2    TL+5
          ZR     X2,SCHD12   IF NOT WAITING ON INTERLOCK
          EQ     SCHD15      RECHECK INTERLOCK
 
 TSSC4    SA1    TPLW
          LX1    -18
          SB4    X1
          ZR     B4,TSSC5    IF NO ONE WAITING ON DATA FILE
          SA3    BTIME       LAST *SIC* ATTEMPT
          SX7    SICTL-1     MINIMUM TIME BETWEEN *SIC* RETRYS
          SA4    LTIME       CURRENT TIME
          MX2    -36
          IX3    X4-X3
          BX3    -X2*X3      MILLISECONDS SINCE LAST *SIC* ATTEMPT
          IX3    X7-X3
          SB3    TSSC5       RETURN ADDRESS
          NG     X3,SNS      IF TIME TO RETRY *SIC*
 TSSC5    RJ     CLJF        CHECK NON BUFFERED JOURNALS FOR COMPLETION
          SA1    RSCH
          ZR     X1,TSSC6    IF SCHEDULER NOT REQUESTED
          BX7    X7-X7
          SA7    A1
          RJ     SCHD        ACTIVATE THE TASK SCHEDULER
 TSSC6    SA1    PBCA        BATCH CONCURRENCY STATUS
          ZR     X1,TSSC7    IF NO BATCH CONCURRENCY REQUESTS
          SA1    BCTF        TOGGLE BATCH CONCURRENCY FLAG
          MX0    1
          BX6    X0-X1
          SA6    A1
          NG     X1,TSSC7    IF NOT SECOND PASS THROUGH TSSC
          SB6    B0          NO *BCT* ADDRESS
          EQ     BRC         PROCESS CONTINUATION OF REQUEST
 
 TSSC7    ZR     B2,TMDC     IF NO SUBCP REQUESTING THE CPU
          SA2    ITIME
          SX7    TMDTL
          SA3    LTIME
          MX6    -36
          IX4    X3-X2       TIME SINCE LAST *TMDC* EXECUTION
          BX6    -X6*X4      MILLISECONDS SINCE LAST SERVICING
          IX2    X7-X6
          NG     X2,TMDC     IF TIME FOR TIME DEPENDENT ROUTINE
          SA4    INRB
          ZR     X4,TSSC8    IF NO TRANSACTION INPUT RECEIVED
          RJ     PRIN        PROCESS INPUT
 TSSC8    SA5    B7+B1
          ZR     B7,TMDC     IF NO TASK SELECTED
          MX7    60-SCTMN-SCCDN  CLEAR TERMINATION AND CDCS ABORT FLAG
          ERRNZ  SCTMS-SCCDS-1  *SCTM* AND*SCCD* MUST BE ADJACENT
          LX7    SCTMS-SCTMN-SCCDN+1
          BX7    X7*X5
          LX5    59-SCTMS
          SA7    A5
          NG     X5,SCT8     IF TASK IS TO BE TERMINATED
          LX5    59-SCCDS-59+SCTMS
          NG     X5,SSC13    IF CDCS ABORTED
          LX5    59-SCTAS-59+SCCDS
          PL     X5,TSSC9    IF ABORT FLAG NOT SET
          SA2    B2+DMEC     DATA MANAGER ERROR CODE
          NG     X2,TERR23   IF DATA MANAGER REQUESTED TASK ABORT
          EQ     TERR16      OPERATOR DROP OR D.M. ABORT OCCURRED
 
 TSSC9    LX5    59-SCRCS-59+SCTAS
          NG     X5,TRCL1    IF TASK RESTART AFTER RECALL
          LX5    59-SCDRS-59+SCRCS
          BX2    X5
          LX5    59-SCTAS-59+SCDRS
          NG     X2,TERR16   IF DROPPED BY OPERATOR
          LX5    59-59-59+SCTAS
          SB4    X5
          ZR     B4,TSSC10   IF NO C.B. LOADED FOR TASK
          SA2    X5+
          NG     X2,TSSC18   IF RESIDENT C.B. REQUESTING CPU
          RJ     EXIT        FATAL ERROR IF THIS POINT REACHED
 
*         FIND COMMUNICATION BLOCK REQUESTING THE CPU.
 
 TSSC10   SB6    B7+CPAHL+CPACL
          SA1    B7+CPAHL    START OF STATUS WORDS
 TSSC11   NG     X1,TSSC12   IF AN ENTRY FOUND
          SA1    A1+B1
          SB5    A1-B6
          NZ     B5,TSSC11   IF NOT AT END OF LIST
          RJ     EXIT        FATAL ERROR IF THIS POINT REACHED
 
*         MOVE COMMUNICATION BLOCK TO TASK.
 
 TSSC12   SA5    X1
          SX2    X1+CMBHL    COMMUNICATIONS BLOCK ADDRESS
          BX6    X5
          SA3    A5+B1       TRANSFER FIRST TWO WORDS OF C.B.
          SX1    CMBL-CMBHL  NUMBER OF WORDS ACCESSABLE TO TASK
          MX0    -18
          MX7    -CBTSN      MASK FOR SEQUENCE NUMBER
          SA4    B7+B1       WORD WITH CURRENT CM RESIDENT C.B. POINTER
          SA6    B2+CB1C
          LX6    CBTSN-1-CBTSS  RIGHT JUSTIFY SEQUENCE NUMBER
          BX7    -X7*X6
          SA7    B2+TRID     SET DEFAULT TRANSACTION IDENTIFIER
          BX7    X3
          SX6    A1
          SX3    B2+NUAPL+SUAC  START OF COMMUNICATION BLOCK IN TASK
          BX0    X0*X4       MASK OUT OLD C.B. POINTER
          SA7    A6+B1
          IX6    X0+X6       ADD IN NEW STATUS WORD POINTER
          SA6    A4
          SX0    X3+
          SA4    B7          READ SUBCP HEADER TABLE
          LX4    59-57
          NG     X4,TSSC13   IF SOLICITED COMMUNICATION BLOCK LOAD
          PL     X6,TSSC13   IF NOT A SYSTEM TASK
          SA7    B2+NUAPL+100B
          BX6    X5          MOVE FIRST TWO WORDS OF C.B. TO USER AREA
          SA6    A7-B1
 TSSC13   SA5    A1
          LX5    5           POSITION INITIAL LOAD BIT
          NG     X4,TSSC16   IF SOLICITED COMMUNICATION BLOCK LOAD
          SA4    X2-CMBHL+CBITW
          LX4    59-CBITS
          MX7    -CBWCN
          PL     X4,TSSC15   IF NOT INITIAL TRANSFER TO C.B.
          SA4    X2-CMBHL+CBWCW  GET COUNT OF WORDS TO MOVE
          BX1    -X7*X4      ONLY MOVE INPUT DATA IN C.B.
          SB4    X1-CBDL-CBUL
          SB5    -B4         CLEAR REST OF TASK C.B. AREA
          BX7    X7-X7       CLEAR USER AREA IN C.B.
          SB6    B2+NUAPL+SUAC+CMBL-CMBHL-CBTL-1
          SA7    B6          LWA OF USER C.B. AREA
 TSSC14   SB5    B5-B1
          SA7    A7-B1
          NZ     B5,TSSC14   IF ENTIRE USER AREA NOT CLEAR
          SA4    PDATE
          BX6    X4
          SX1    X1+CMBRL
          SA6    B6+CBTL     PUT DATE/TIME IN C.B.
 TSSC15   RJ     MVE=        MOVE C.B. TO SUBCP
 TSSC16   PL     X5,TSSC18   IF NOT AN INITIAL TASK LOAD
 
*         PROCESS INITIAL TASK LOAD BY INITIALIZING EXCHANGE PACKAGE
*         AND COMMUNICATION AREA AS THE PRODUCT SET OBJECT
*         ROUTINES EXPECT FROM EITHER *1AJ* OR THE *CYBER* LOADER.
 
          SA1    B7+B1
          MX3    18
          SA2    B7
          LX1    24
          BX6    X3*X1       ENTRY POINT
          SX7    X2          RA
          LX2    24
          BX4    X3*X2       FL
          LX6    -6
          LX4    -24
          BX6    X6+X4       SET P AND A0=FL
          LX4    18
          SA6    B2
          LX7    36
          SA7    B2+B1       SET RA
          BX6    X4
          SA6    A7+B1       SET FL
          MX1    1
 .EM      SX7    EEMC        SET DEFAULT ERROR EXIT MODE
          LX7    59-11
          BX6    -X1*X5      MASK OFF INITIAL LOAD BIT
          LX6    -5
          SA7    A6+B1       EXIT MODE
          SX7    DTSTL       DEFAULT TIME SLICE LIMIT
          SA6    A5
          LX7    30          POSITION TIME SLICE LIMIT
          BX6    X6-X6
          SA6    A7+B1       ZERO OUT REST OF EXCHANGE PACKAGE
          SA7    B2+TSAC     TIME SLICE CONTROL WORD
          SA6    A6+B1
          SA6    A6+B1
 .CEJ     SA1    X0          GET DATA BASE NAME
          SA6    B2+ERXC     ERROR RETRY ADDRESS
          MX7    1           ** POSITION DEPENDENT INSTRUCTION
          SX6    TROT        SET TRANSACTION ORIGIN TYPE IN *JOPR*
          LX6    24
          BX7    X7+X6
          SA7    B2+NUAPL+XJPR  SET CEJ/MEJ PRESENT STATUS
          SA6    B2+TOWC     CLEAR TERMINAL OUTPUT COUNT
          SX7    B0+
          SA7    B2+ROWC     CLEAR ROLLOUT WORD COUNT FOR TERMINAL
 .CMU     MX4    -12
          SX6    MAXRA       DEFAULT SYSTEM REQUEST COUNT
          MX7    1           ** POSITION DEPENDENT INSTRUCTION
          SA2    B7          GET TASK FL
          LX2    SCFLN-SCFLS-1
          SX5    X2
          BX7    X5+X7       ADD TASK FL
          SA7    B2+NUAPL+104B  SET FL IN WORD 104B
          SA7    B2+NUAPL+LWPR  SET CMU PRESENT STATUS
          LX6    30
          BX7    X7-X7
          SA6    B2+RA1C     COUNT OF NUMBER OF RA(S)+1 CALLS
          SA7    B2+NUAPL    RA(S)
          LX1    -48
          BX6    X6-X6
          SA6    A7+B1       RA(S)+1
          BX7    -X4*X1
          SA6    A6+1        RA(S)+2 = 0 IMPLIES NO PARAMETERS
          SA7    B2+DBNC     DATA BASE NAME TASK IS VALIDATED FOR
          SA5    B2+NUAPL+100B-20B+2  READ TASK NAME FROM *77-TABLE*
          SA6    B2+BWCC     BRANCH COUNT
          SA6    B2+WICB+3   CLEAR ROLLOUT TABLE ADDRESS
          MX7    42
          SA6    B2+DMEC     CLEAR DATA MANAGER ERROR CODE
          BX7    X7*X5
          SA6    B2+TOTC     *TOTAL* DATA MANAGER REQUEST COUNT
          SA6    B2+TSQN     CLEAR QUARTER NANO-UNIT COUNT
          SA7    B2+NUAPL+PGNR  SET TASK NAME INTO *PGNR*
          SA6    B2+SECR     CLEAR *SECURE* REQUEST
          SA6    B2+RERU     CLEAR *RERUN* REQUEST
 TSSC17   SA1    B2+CB2C     GET COMMUNICATION BLOCK ADDRESS
          SA4    X1+CBITW
          LX4    59-CBITS
          MX6    -59
          BX6    -X6*X4      CLEAR INITIAL TRANSFER BIT
          LX6    CBITS-59
          SA6    A4
          SA3    X1+CBRTW
          BX4    X3
          LX3    59-CBRTS
          LX4    59-CBLCS
          SX7    TSSC17      RETURN ADDRESS
          PL     X3,TSSC18   IF NOT RECOVERABLE TRANSACTION
          PL     X4,TRCL2    IF INPUT NOT LOGGED
 
*         ACTIVATE THE SUBCP.
 
 TSSC18   XCHNGE B2,TSKTL
 
 SRTN     TITLE  PROCESS RETURN FROM SUBCP.
**        SRTN - PROCESS RETURN FROM SUBCP.
*
*         *SRTN* CHECKS ERROR EXIT FLAGS AND SYSTEM REQUESTS FROM THE
*         SUBCP.  IF AN SYSTEM REQUEST IS PRESENT AND NO FATAL ERROR
*         OCCURRED, CONTROL WILL BE GIVEN TO THAT REQUEST PROCESSOR.
*
*         ENTRY  (X6) = 12/2000B+ERROR FLAG,30/0,18/RA OF SUBCP.
*                (X7) = 60/QUARTER NANO-UNITS USED BY TASK.
*
*         EXIT   (A5) = ADDRESS OF TASK SYSTEM REQUEST.
*                (X1) = TASK FL.
*                (X5) = SYSTEM REQUEST.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B3) = (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCP TABLE ENTRY.
*                TO SYSTEM REQUEST PROCESSOR IF REQUEST PRESENT AND NO
*                        FATAL ERROR OCCURRED.
*                TO *TERR15* IF TASK TIME LIMIT EXCEEDED.
*                TO *TERP* IF ERROR FLAG INDICATES A NON-TIME-LIMIT
*                          ERROR AND NO ERROR RETRY ADDRESS IS PRESENT.
*                TO *TERR14* IF NUMBER OF RA+1 CALLS EXCEEDS LIMIT.
*                TO *TERR4* IF ILLEGAL RA+1 REQUEST.
*                TO *TSSC* IF NO RA+1 REQUEST IS PRESENT AND NO
*                          FATAL ERROR OCCURRED OR IF AN ERROR
*                          OCCURRED AND AN ERROR RETRY ADDRESS
*                          IS PRESENT.
*
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 1, 3, 4, 5, 6, 7.
*                B - 3, 4, 5.
*
*         CALLS  TXT.
 
 
 SRTN     SA1    B2+TSQN     UPDATE TASK QUARTER NANO-UNIT COUNTER
          UX6,B4 X6          EXIT FLAG
          IX7    X1+X7
          SA5    X6+B1       READ SYSTEM REQUEST
          SA7    A1
          NZ     B4,SRTN1    IF TASK ERROR
          SB3    X6+         RA
          NZ     X5,SRTN4    IF SYSTEM REQUEST PRESENT
          EQ     TSSC        RESUME SUBCP PROCESSING
 
*         CHECK EXIT CONDITIONS.
 
 SRTN1    SX6    B4-TLET
          NZ     X6,SRTN3    IF TIME-SLICE NOT EXCEEDED
          SA4    B2+TSAC
          SX6    B1+
          IX7    X4+X6       INCREMENT TIME COUNT
          AX4    30          RIGHT JUSTIFY TIME LIMIT
          SX6    X7          CLEAR UPPER 42 BITS
          IX4    X4-X6       LIMIT-COUNT
          SA7    A4+         RESET TIME COUNT
          NG     X4,SRTN2    IF TASK TIME LIMIT EXCEEDED
          NZ     X5,SRTN4    IF SYSTEM REQUEST PRESENT
          EQ     TSSC        RESUME SUBCP PROCESSING
 
 SRTN2    RJ     TXT         SET UP AND STORE INTERNAL TRACE PACKET
          EQ     TERR15      TASK TIME LIMIT EXCEEDED
 
 SRTN3    RJ     TXT         SET UP AND STORE INTERNAL TRACE PACKET
          SA4    B2+ERXC     ERROR RETRY ADDRESS
          LX4    -18
          SX1    X4
          ZR     X1,TERP     IF NO ERROR EXIT ADDRESS
          BX7    X7-X7
          MX6    24
          SA7    A4
          SA4    B2          GET P
          LX1    36
          BX6    -X6*X4      CLEAR P
          IX7    X6+X1
          SA7    B2          RESET P
          EQ     TSSC        RESUME SUBCP PROCESSING
 
*         PROCESS SYSTEM REQUEST.
 
 SRTN4    RJ     TXT         SET UP AND STORE INTERNAL TRACE PACKET
          SX7    B0+
          SA3    B2+RA1C
          BX6    X5          SAVE IMAGE OF RA + 1 REQUEST
          SA7    A5          CLEAR SYSTEM REQUEST
          SA6    B2+LRA1
          SX6    B1
          MX4    -18
          IX6    X6+X3       INCREMENT COUNT OF NUMBER OF RA+1 CALLS
          AX3    30          RIGHT JUSTIFY LIMIT
          BX4    -X4*X6
          SA6    A3          RESET COUNT
          IX3    X4-X3
          PL     X3,TERR14   IF EXCEEDS LIMIT
 
*         RE-ENTER HERE FROM RECALL.
 
 SRTN4.1  SA1    B7+SCRAW    SET RA AND FL
          SA3    B2+LRA1     GET REQUEST
          SA5    X1+B1       RA + 1
          SB3    X1          RA
          LX1    SCFLN-1-SCFLS
          BX5    X3
          LX5    18          SET REQUEST
          SX7    X5
          LX5    -18
          SB5    B3          RA
          BX6    X5
          SX1    X1
          SB4    X7-3RMSG    USED IN TREE SEARCH
          SA6    B2+LRA1     SAVE IMAGE OF RA + 1 REQUEST
 
*         IDENTIFY THE REQUEST BY USING A TREE SEARCH AND
*         THEN EXIT TO PROCESS THE REQUEST.
 
          ZR     B4,MSG      IF *MSG*
          PL     B4,SRTN5    IF SEARCH DOWN GREATER THAN BRANCH OF TREE
          SB4    X7-3REND
          ZR     B4,SCT      IF *END* REQUEST
          SB4    X7-3RD00
          ZR     B4,D00      IF *D00* REQUEST
          SB4    X7-3RCTI
          ZR     B4,CTI      IF *CTI*
          SB4    X7-3RCPM
          ZR     B4,CPM      IF *CPM* REQUEST
          SB4    X7-3RABT
          ZR     B4,SCT36    IF *ABT* REQUEST
          SB4    X7-3RAAM
          ZR     B4,AAM      IF *AAM*
          SB4    X7-3RMEM
          ZR     B4,MEM      IF *MEM* REQUEST
          EQ     TERR4       INCORRECT REQUEST
 
 
 
 SRTN5    SB4    X7-3RSCT
          ZR     B4,SCT      IF *SCT*
          SB4    X7-3RREC
          ZR     B4,RRP      IF *REC* REQUEST
          SB4    X7-3RRFL
          ZR     B4,RFL      IF *RFL* REQUEST
          SB4    X7-3RTOT
          ZR     B4,TOT      IF *TOT*
          SB4    X7-3RTIM
          ZR     B4,TIM      IF *TIM*
          SB4    X7-3RTMS
          ZR     B4,TMS      IF *TMS* REQUEST
          SB4    X7-3RSSC
          ZR     B4,SSC      IF *SSC* REQUEST
          EQ     TERR4       INCORRECT REQUEST
 
 SCHD     TITLE  TASK SCHEDULER.
**        SCHD   SCHD SEARCHES THE REQUESTED TASK LIST FOR THE HIGHEST
*                PRIORITY TASK, REQUESTS ENOUGH CORE TO RUN THE TASK,
*                AND IF THE CORE IS AVAILABLE INITIATES LOADING OF THE
*                TASK.
*
 
 
 SCHD35   SA1    STAT10      NUMBER OF TIMES NO FL FOR TASK LOAD
          SX6    B1
          IX6    X1+X6
          SA6    A1+
 
 SCHD     PS                 ENTRY/EXIT
 SCHD1    MX7    -6
          SA1    LTLRE
          MX0    1
          NZ     X1,SCHD     IF REQUESTED TASK LOAD LIST FULL
          SA1    RTLW        RTL RESERVATION WORD
          SB5    B0
          IX1    X1+X0       LOOKING FOR ZERO BITS
          SB3    370000B
          SB6    B0
          LX0    -12
          MX5    -12
 SCHD2    NX1    B4,X1       FIND AN RTL ENTRY
          SB4    B4+B4       TWO WORDS / ENTRY
          IX1    X1+X0
          SB5    B5+B4
          SB4    B5-RTLL
          PL     B4,SCHD3    IF END OF LIST
          SA2    B5+RTL      CHECK AN ENTRY
          LX2    5-29
          BX3    -X7*X2      CURRENT PRIORITY
          LX2    11-59-5+29
          SB4    X3+
          BX3    -X5*X2      TASK DIRECTORY INDEX
          LT     B4,B6,SCHD2 IF PRIORITY .LT. CURRENTLY SELECTED TASK
          TA3    X3+1,VTLD   GET TASK CHARACTERISTICS
          LX3    59-57
          NG     X3,SCHD2    IF REQUEST FOR CM RESIDENT TASK
          LX3    59-TLQUS-59+57
          PL     X3,SCHD2.1  IF NOT Q-TYPE OF TASK
          MX4    -TLTAN
          LX3    TLTAN-1-TLTAS-59+TLQUS
          BX4    -X4*X3
          ZR     X4,SCHD2.1  IF NO COPIES OF TASK ARE ACTIVE
          SX4    X4-MAXAQ
          ZR     X4,SCHD2    IF NUMBER OF COPIES AT LIMIT
          LX2    17-17-11+59
          MX4    -18         CHECK IF RTL ENTRY AT *QL* LIMIT
          BX4    -X4*X2
          LX2    11-59-17+17
          NZ     X4,SCHD2    IF ENTRY NOT AT *QL* LIMIT
 SCHD2.1  EQ     B4,B6,SCHD2.2  IF TASK PRIORITIES ARE EQUAL
          SB6    B4          NEW HIGHEST PRIORITY
          SX6    A2          RTL ADDRESS OF TASK WITH HIGHEST PRIORITY
          LX2    17-47-11+59 GET TASK FL
          SB3    X2
          JP     SCHD2
 
 SCHD2.2  LX2    17-47-11+59
          SB4    X2
          GE     B4,B3,SCHD2 IF FL GREATER THAN CURRENTLY SELECTED TASK
          SB3    X2          NEW LOWEST FL VALUE
          SX6    A2
          JP     SCHD2
 
 SCHD3    ZR     B6,SCHD     *EXIT - NO TASKS IN REQUESTED TASK LIST
          SA5    SCHDA
          ZR     X5,SCHD6    NO REUSABLE PROGRAMS IN CORE
          SA2    X6
          PX4    X5
          BX3    X3-X3
          MX5    12
          SB3    B0
          MX0    1
          BX2    X5*X2       TASK ID
          LX0    -12
          SB5    SCPAL
          EQ     SCHD5       ENTER LOOP
 
*         CHECK REUSABLE PROGRAMS FOR REQUESTED TASK MATCH
 
 SCHD4    SX3    X3+B6
          LX7    X3,B5
          TA1    X7-CPAL+2,VCPA
          BX1    X5*X1       TASK ID
          IX1    X1-X2
          ZR     X1,SCHD21   MATCH FOUND
 SCHD5    BX1    -X0*X4
          NX4,B6 X1          FIND NEXT SET BIT
          NZ     X4,SCHD4    ENTRIES LEFT TO CHECK
 
*         REQUEST FIELD LENGTH FOR PROGRAM TO BE SCHEDULED
 
 SCHD6    SA2    X6
          SA6    SCHDB       SAVE RTL ADDRESS
          LX2    -30
          SX0    X2+NUAPL    FL REQUIRED TO RUN TASK
          RJ     RCP         REQUEST SUBCONTROL POINT
          ZR     X5,SCHD35   IF NO FL CURRENTLY AVAILABLE
 
*         SET UP SUB CONTROL POINT AREA FOR NEW TASK
 
          SA2    SCHDB       RTL ADDRESS OF TASK TO LOAD
          SX3    B4
          LX0    18
          BX0    X0+X3       SUB CP ADDRESS AND FL
          SA1    X2          FIRST WORD OF RTL ENTRY
          MX5    12
          SB5    X2
          SA2    B5+1        SECOND WORD OF RTL ENTRY
          MX6    -2
          BX5    X5*X1       TASK ID
          SB4    B4+CPAHL
          MX7    30
          BX4    X4-X4
          ZR     X5,SCHD8.1  IF TASK ROLL IN
          SA3    B4-CPAHL+2
          LX6    4
          IX7    X5+X3
          LX5    12
          BX6    -X6*X2      DESTRUCTIVE CODE AND SYSTEM TASK FLAG
          TA1    X5-1,VTLD   1ST WORD OF TLD
          MX4    30
          SA5    A1+B1
          SX1    X1          ENTRY POINT
          BX5    X4*X5       DISK ADDRESS OF TASK
          LX6    60-6
          LX1    18
          SA7    A3          SET NAME AND TIME SLICE LIMIT
          BX1    X1+X6       ENTRY POINT AND DESTRUCTIVE CODE FLAG
          SA3    A5+TLTAW-TLDAW  TASK ATTRIBUTES AND STATUS
          SX6    1
          LX3    59-TLQUS
          LX5    30          POSITION DISK ADDRESS FOR TASK LOAD
          PL     X3,SCHD6.1  IF Q-ATTRIBUTE NOT SPECIFIED
          RJ     ITA         INCREMENT TASK ACTIVE COUNT
 SCHD6.1  BX4    X1
 
*         DETERMINE WHICH TASK LIBRARY FILE TO USE
 
          SX6    A1+B1       ADDRESS OF TLD ENTRY
          SB3    VUSN-2      SYSTEM LIBRARY USER NAME
          SB6    VTFL        SYSTEM TASK LIBRARY NAME
          TA3    0,VEDT
          SA1    A3+4
          SX3    X3          LINK TO NEXT EDT
          LX1    -18
 SCHD7    SX7    X1
          ZR     X7,SCHD8    NO DIRECTORY FOR DATA BASE
          IX7    X7-X6
          PL     X7,SCHD8.2  IF ENTRY IN PREVIOUS TLD
          SB3    A3+         EDT ADDRESS
          SB6    X1-1
 SCHD8    ZR     X3,SCHD8.2  IF AT END OF EDTS
          SA1    X3+4
          SB3    A3
          SA3    X3
          LX1    -18
          SX3    X3          NEXT EDT
          EQ     SCHD7       LOOP
 
 SCHD8.1  MX6    1
          SA1    X2
          SB3    B0
          SA3    A1+B1
          BX0    X6+X0       SET ROLL IN FLAG
          SB6    X1+         ROLLOUT FILE FET ADDRESS
          BX5    -X7*X3      DISK ADDRESS OF ROLLED OUT TASK
 SCHD8.2  SX1    B6          ADDRESS OF NAME OF TASK LIBRARY
          SX6    B3          ADDRESS OF USER NAME FIELD FOR LIBRARY
          LX1    30
          BX5    X5+X1
          LX6    36
          SB3    SCHD11      CONTINUATION ADDRESS
          BX0    X0+X6
          NG     X0,SCHD9    IF TASK ROLL IN
          BX3    X2          WORD 2 OF RTL
          LX3    59-2
          PL     X3,SCHD9    IF NOT EXTENDED MEMORY RESIDENT
          SB3    SCHD31      RETURN ADDRESS FOR EXTENDED MEMORY LOADING
 
*         ENTRY  (B3) = RETURN ADDRESS
*                (B4) = 1ST C.B. STATUS WORD AT SELECTED SUB CP
*                (B5) = RTL ADDRESS OF REQUESTED TASK
*                (X4) = SUB CP STATUS WORD 2
*                (X2) = 2ND WORD OF RTL ENTRY
 
 SCHD9    MX7    1
          SA3    RTLW        RTL RESERVATION WORD
          LX7    -12
          SX1    B5-RTL      RTL ENTRY
          SB6    B0
          AX1    1           TWO WORDS PER RTL ENTRY
          LX2    36
          SB5    X1
          TX2    X2+1,-VATL  RELATIVE ADDRESS OF FIRST ATL ENTRY
          LX7    -B5,X7      POSITION BIT TO RELEASE RTL ENTRY
          IX6    X7+X3
          MX1    -12
          SA6    A3          RESET RTL RESERVATION WORD
 
*         SEARCH THE ATL AND SET POINTERS TO THE QUEUED TASKS C.B.S
 
 SCHD10   MX7    1
          TA3    X2-1,VATL
          MX2    1
          SX6    X3          CONTEXT BLOCK ADDRESS
          LX2    -5          INITIAL LOAD BIT
          BX2    X2+X7       SET REQUEST CPU BIT
          IX7    X6+X2
          LX3    12
          SA7    B4+B6       INDICATE TASK IN CORE AND WAITING FOR CPU
          BX2    -X1*X3
          SB6    B6+B1       INCREMENT ATL ENTRY COUNT
          NZ     X2,SCHD10   MORE ATL ENTRIES
          SX1    B6
          BX7    X0
          LX1    36
          IX6    X4+X1       SET NUMBER OF CONTEXT BLOCKS AT SUB CP
          SA6    B4-CPAHL+1
          SB4    SCHD1
          JP     B3          *EXIT
 
*         LOAD TASK CODE AT THE SUB CP
 
 SCHD11   SA3    CCC
          ZR     X3,SCHD18   NO TASK BEING LOADED NOW
          SA1    TL+5
          SA2    TL
          LX2    -1
          ZR     X1,SCHD11.1 IF NOT WAITING FOR INTERLOCK
          BX2    X2-X2
 SCHD11.1 NG     X2,SCHD12   IF PRIOR TASK LOAD REQUEST IS FINISHED
 
*         STACK UP TASK LOAD REQUEST
 
          SA3    A3+2
 SCHD11.2 ZR     X3,SCHD17   IF UNUSED STACK ENTRY
          SA3    A3+2
          EQ     SCHD11.2    TRY NEXT ENTRY
 
*         A TASK IS LOADED - ADVANCE STACK AND REQUEST CPU
 
 SCHD12   SA2    CCC         STACK ENTRY FOR TASK THAT WAS LOADED
          SA3    A2+B1
          SA4    A3+B1
          SA1    X2          FWA OF SUBCP TABLE ENTRY
          ZR     X4,SCHD14   NO TASK WAITING TO BE LOADED
          SA2    A4
 SCHD13   BX6    X2
          SA6    A3-B1       MOVE ENTRY TOWARD TOP OF STACK
          SA3    A2+B1
          SA2    A3+B1       NEXT STACK ENTRY
          BX6    X3
          SA6    A6+B1
          NZ     X2,SCHD13   MORE ENTRIES TO MOVE
 SCHD14   SX4    X1-NUAPL
          BX6    X5
          SA7    A3-B1       NEW STACK ENTRY - OR ZERO TERMINATOR
          SB3    SCHD15      RETURN ADDRESS
          SA3    A1+SCNMW
          MX5    SCNMN
          SA6    A7+B1       DISK ADDRESS OF REQUESTED TASK
          SX2    B1
          MX6    1
 SCHD14.1 BX5    X5*X3       TASK DIRECTORY INDEX
          LX2    42
          BX6    -X6*X1      CLEAR STORAGE MOVE LOCK OUT
          LX5    12
          SB6    A1          SUBCP TABLE ENTRY FOR THIS TASK
          SA6    A1
          ZR     X5,SCHD23   IF TASK ROLL IN
          SX7    DCPPR       SET DEFAULT CPU PRIORITY
          TA3    X5+1,VTLD
          LX7    -12         TASK PRIORITY
          LX3    59-TLTLS
          SA7    X4+CB1C     TASK PRIORITY UNTIL A C.B. IS LOADED
          IX6    X3+X2       BUMP TIMES LOADED COUNT
          LX6    TLTLS-59
          SA6    A3
          LX6    59-TLSCS    GET SOLICITED C.B. FLAG
          PL     X6,RCPU     IF NOT SOLICITED COMMUNICATION BLOCK TASK
          MX6    1           SET SOLICITED COMMUNICATION BLOCK FLAG
          LX6    57-59
          SA3    B6          SUBCP TABLE FOR THIS TASK
          BX6    X3+X6
          SA6    A3
          EQ     RCPU        REQUEST CPU FOR NEWLY LOADED TASK
 
*         IF STACK ENTRY PRESENT, INITIATE LOAD OF REQUESTED TASK
 
 SCHD15   SA1    CCC
          ZR     X1,SCHD16   NO TASK WAITING TO BE LOADED
          SA5    A1+B1
          SA2    X1
          SX6    X2+77B-16B  FWA FOR TASK LOAD
          BX7    X5
          SX0    X2          TASK RA
          SA7    TL+6
          LX2    -18
          LX5    30
          SB5    X5          ROLLOUT FILE FET ADDRESS
          SX7    X5
          SB6    X2+16B-77B
          SA3    TL+1        FET+1 OF TASK LIBRARY FILE
          PL     X1,SCHD15.1 IF NOT TASK ROLL IN
          SA1    B5+5
          NZ     X1,SCHD15.2 IF ROLLOUT FILE INTERLOCKED
          SX6    A2
          SA6    A1          INTERLOCK ROLLOUT FILE
          SX6    X0-NUAPL    START OF SUB CONTROL POINT AREA
          SB6    X2+NUAPL    FL TO ROLL IN
 SCHD15.1 BX7    X7-X7
          MX4    -18
          SA7    A7-B1       CLEAR WAITING FOR INTERLOCK STATUS
          BX3    X4*X3
          BX7    X3+X6
          SA7    A3          SET FIRST
          MX2    1
          SA6    A7+B1       SET IN = FIRST
          SA6    A6+B1       SET OUT = FIRST
          SX7    B6+X6
          SA3    A6+B1
          BX3    X4*X3
          SA4    B5          TASK LIBRARY FILE NAME
          BX7    X3+X7
          BX6    X4
          SA7    A6+B1       SET LIMIT = LWA OF SUB CP TASK AREA
          SA6    TL
          SA1    A2
          BX7    X2+X1       SET STORAGE MOVE LOCK OUT BIT
          SA7    A1
          READSKP A6         INITIATE LOAD OF TASK
          JP     B4          *EXIT
 
 SCHD15.2 SX7    A1
          SA7    A7-B1       SET WAITING FOR INTERLOCK STATUS
          JP     B4          *EXIT
 
*         CLEAR LOCK ON LIBRARY FILE
 
 SCHD16   SA2    TPLW        STATUS WORD FOR RECALL COMPLETION CHECKS
          MX3    -18
          BX6    X3*X2       MASK OUT TASK BEING LOADED STATUS
          SA6    A2
          JP     B4          *EXIT
 
*         ENTER LOAD REQUEST INTO STACK
 
 SCHD17   BX6    X5
          SA7    A3          STORE STACK ENTRY
          SA6    A3+1        RANDOM ADDRESS
          JP     B4          *EXIT
 SCHD18   SX2    TL
          SA1    TPLW        STATUS WORD FOR RECALL COMPLETION CHECKS
          BX6    X1+X2
          SA7    CCC         STORE STACK ENTRY
          SA6    A1          SET TASK BEING LOADED STATUS
          BX7    X5
          SA7    A7+B1
          EQ     SCHD15      LOAD REQUESTED TASK
 
*         SET UP TO QUEUE ENTRIES AT TASK ALREADY RESIDENT IN CM
 
 SCHD21   SB6    X3          SHIFT COUNT FOR SUB CP
          SB5    X6
          LX2    12          POSITION TASK ID
          SX6    B1
          TA3    X2+TLTAW-TLDAW,VTLD  TASK ATTRIBUTES AND STATUS
          SA2    A5+         LIST OF REUSABLE TASKS IN CM
          LX3    59-TLQUS
          PL     X3,SCHD21.1 IF Q-ATTRIBUTE NOT SPECIFIED
          RJ     ITA         INCREMENT TASK ACTIVE COUNT
 SCHD21.1 LX0    X0,-B6      POSITION BIT TO RELEASE SUBCP FROM LIST
          BX7    -X0*X2      CLEAR BIT
          SA4    A1-1        SUBCONTROL POINT STATUS WORD 2
          SA5    AVAILCM
          MX1    1
          SA3    A4-B1       SUB CP STATUS WORD 1
          LX1    -1
          SA7    A2+
          BX6    -X1*X3      CLEAR RELEASEABLE BIT FOR SUB CP
          SX0    X3-NUAPL    START OF SUB CP FL
          SA6    A3
          LX3    -18
          SA2    B5+B1
          SX3    X3+NUAPL    CORE USED BY TASK
          SB4    A1+B1       1ST C.B. STATUS WORD AT SUB CP
          IX7    X5-X3
          SB3    SCHD22
          SX5    A3          SUB CP AREA
          SA7    A5          DECREMENT AVAILABLE CORE COUNT
          EQ     SCHD9       LOAD TASK QUEUE FOR EXECUTION
 
 SCHD22   SB6    X5          SUB CP AREA
          SX4    X0          START OF SUB CP FL
          SB3    SCHD1       RETURN ADDRESS
          EQ     RCPT        REQUEST CPU FOR TASK
 
*         PROCESS ROLLIN COMPLETE.
 
 SCHD23   SB5    X4          SUB CONTROL POINT AREA OF TASK
          SX1    X1          TASK RA
          MX7    24
          SA3    X4+B1
          LX1    36
          BX7    -X7*X3      CLEAR OLD RA FROM EXCHANGE PACKAGE
          SA5    X4+ROSC
          BX7    X7+X1
          SA7    A3
          SA3    B5+RSCC
          BX6    X6-X6
          MX4    12
          SA2    X5          FIRST WORD OF ROLLOUT TABLE ENTRY
          SX0    B6
          SA1    A3+B1
          SA6    X2+5        RELEASE INTERLOCK ON ROLLOUT FILE
          BX4    X4*X1       TASK INDEX
          SA2    B6+2        RESTORE TASK INDEX
          SX7    X3
          BX6    X4+X2
          SA6    A2
          ZR     X7,SCHD25   IF C.B. NOT RESERVED DURING ROLLOUT
          IX7    X3+X0       REBIAS STATUS WORD POINTER
          SX1    CPACL
          SA7    B6+B1
          SA4    A2+B1       SAVE CORRECT ACTIVE C.B.
          BX7    X4
          SA7    SCHDC
          SX2    A1+B1       RELOAD ACTIVE TASK STATUS WORDS
          SX3    B6+CPAHL
          RJ     MVE=
          SA1    X0+B1       ACTIVE C.B. POINTER IN SUBCP TABLE
          SA2    X1
          MX3    42
          BX7    X3*X2
          SA1    SCHDC
          BX1    -X3*X1
          BX7    X1+X7
          SA7    A2+         REPLACE ACTIVE C.B. ADDRESS
 SCHD24   SX4    X5          ROLLOUT TABLE ENTRY
          SA1    X0
          SB6    X0+         SUB CONTROL POINT ADDRESS
          SB5    X1-NUAPL    SUB CONTROL POINT AREA
          SB3    SCHD26      RETURN ADDRESS
          JP     ROL16       RELEASE ROLLOUT FILE SPACE
 
 SCHD25   SA1    B6+CPAHL
          SX7    B1          CLEAR INITIAL CALL BIT
          SX6    A1
          LX7    54
          IX6    X6+X3       SET C.B. STATUS WORD POINTER
          BX7    -X7*X1
          SA7    A1
          SA6    B6+SCCCW    ACTIVE C.B. FOR THIS TASK
          EQ     SCHD24      CONTINUE
 
 SCHD26   LX6    59-54
          PL     X6,SCHD26.1 IF NOT RECALL RESTART TASK
          MX0    1
          SA1    B5+SCRC     TASK RECALL STATUS WORD
          SA3    LTIME
          MX7    -5
          SA2    A1+B1
          LX7    18
          BX6    X3
          SA6    A1
          BX6    X1
          TX4    B6+CPAL,-VCPA
          SA6    B5+RCL
          BX7    X7*X2       CLEAR OLD SUB CP NUMBER
          AX4    SCPAL
          SX5    B1
          LX4    18
          BX7    X7+X4
          LX4    -18
          SA7    A6+B1
          LX0    -12
          SA1    RCR         RECALL REQUEST WORD
          LX5    56
          SA2    B6+B1       STATUS WORD TWO OF SUB CP AREA
          SB5    X4
          BX6    X5+X2       SET TASK RECALL REQUEST BIT
          AX4    X0,B5
          IX7    X1+X4
          SA6    B6+B1
          SA7    A1          SET TASK RECALL REQUEST WORD
          SA1    STAT15      NUMBER OF TIMES TASK IN RECALL
          SX6    B1
          IX6    X1+X6
          SA6    A1
          JP     SCHD15
 
 SCHD26.1 SA1    B5+CB1C     CHECK RECALL STATUS
          SX4    B5
          LX1    59-46
          NG     X1,SCHD15   IF TASK IN RECALL ALL STATUS
          SB3    SCHD15
          JP     RCPU        REQUEST CPU FOR TASK JUST LOADED
 
 
*         INITIATE LOAD OF REQUESTED TASK FROM EXTENDED MEMORY.  THE
*         INTERPRETIVE EXTENDED MEMORY READ MACROS AND RELATED ROUTINES
*         IN *COMCECS* ARE USED TO HELP PROVIDE A CONTROLLED USAGE OF
*         EXTENDED MEMORY.
*
*                (X7) =  1/EPC,5/,18/EDT,18/TFL,18/SCP
*                (X5) =  30/ TLN ,30/RDA
*
*                        EPC - ERROR PROCESSOR CALL.
*                        EDT - ELEMENT DESCRIPTOR TABLE ADDRESS.
*                        TFL - TASK FIELD LENGTH.
*                        SCP - START OF SUB CP TABLE.
*                        TLN - ADDRESS OF TASK LIBRARY NAME.
*                        RDA - RANDOM DISK/ECS ADDRESS OF TASK.
 
 SCHD31   SA1    X7          TASK RA
          SA0    X1+77B-16B  FWA FOR TASK LOAD
          MX0    -24
          BX0    -X0*X5      EXTENDED MEMORY FWA
          LX7    -18
          SB3    X7+16B-77B-NUAPL  TASK FIELD LENGTH - FWA FOR LOAD
          LX7    18
          RE     B3          READ TASK FROM EXTENDED MEMORY
          EQ     ECR         PROCESS EXTENDED MEMORY READ ERROR
 
 SCHD34   NG     X7,TERP19   IF ERROR PROCESSOR CALL
          SB3    SCHD1       RETURN ADDRESS
          MX6    1           SET MASK TO REQUEST CPU
          BX2    X7
          SA1    X2
          BX3    X5
          SX4    X1-NUAPL
          SA3    A1+2
          SX2    B1
          MX5    12
          EQ     SCHD14.1    CONTINUE SCHEDULING THIS TASK
 
 SCHDA    BSSZ   1           REUSABLE TASKS CURRENTLY CM RESIDENT
 SCHDB    BSS    1           RTL ADDRESS OF TASK TO LOAD
 SCHDC    CON    0           CURRENT C.B. ADDRESS
          TITLE  RA(S)+1 REQUEST PROCESSORS.
          SPACE  4
***       SUBCONTROL POINT PROGRAM REQUEST.
*
*         SUBCONTROL POINT PROGRAM REQUESTS ARE PASSED
*         THROUGH RELATIVE ADDRESS 1. THE FORMAT IS AS FOLLOWS -
*
*T        18/   NAME,6/ R,36/   ARG
*
*         NAME   REQUEST NAME.
*         R      20B IF AUTO RECALL DESIRED.
*         ARG    ARGUMENTS.
*
*         THE RECALL PARAMETER IS OF USE ONLY ON DATA MANAGER
*         REQUESTS, AS ALL OTHER TYPES ARE REQUESTS ARE ANSWERED
*         IMMEDIATELY.
*
*         IF THE FORMAT OF THE REQUEST IS INCORRECT, THE TASK IS
*         ABORTED.
 SCT      SPACE  4,50
***       SCT - SCHEDULE TASK.
*
*         THIS PROCESSOR PERFORMS THE FUNCTIONS RELATING TO TASK
*         SCHEDULING.  THE FORMAT OF THE REQUEST IS -
*
*T        24/ 3LSCT,18/ FNC,18/ ADDR
*
*         FNC    SCHEDULE FUNCTION CODE.
*         ADDR   PARAMETER ADDRESS.
*
*         FNC    SCHEDULE TYPE
*
*         0      CEASE    - END CURRENT TASK.
*         1      NEWTRAN  - START A NEW TRANSACTION.
*         2      CALLTSK  - CALL TASK WITH CEASE.
*         3      CALLTSK  - CALL TASK WITHOUT CEASE.
*         4      CALLRTN  - CALL TASK WITH RETURN.
*         5      WAITINP  - WAIT FOR TERMINAL INPUT.
*         6      WAIT     - WAIT FOR SPECIFIED TIME PERIOD.
*         7      CHKON    - SET *TOTAL* INTERLOCK FLAG.
*         8      CHKOFF   - CLEAR *TOTAL* INTERLOCK FLAG.
*         9      BWAITINP - BUFFER WAIT FOR TERMINAL INPUT.
*         10     CALLTRN  - CALL TRANSACTION.
*
*         ENTRY  (X1) = TASK FL.
*                (X5) = SYSTEM REQUEST.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCP TABLE ENTRY.
*
*         EXIT   TO *TERR1*  IF REQUESTED ABORT.
*                TO *TERR2*  IF ADDRESS OUT OF BOUNDS.
*                TO *TERR3*  IF INCORRECT FUNCTION CODE.
*                TO *TERR5*  IF MORE THAN FIVE TASKS IN TASK CHAIN.
*                TO *TERR6*  IF INCORRECT TASK NAME.
*                TO *TERR10* IF TASK CEASE WITH OUTSTANDING DATA
*                            MANAGER REQUEST.
*                TO *TERR11* IF TASK NOT VALIDATED FOR REQUEST.
*                TO *TERR12* IF TASK BRANCH LIMIT EXCEEDED.
*                TO *TERR18* IF NEST-LEVEL LIMIT EXCEEDED.
*                TO *TERR19* IF SCHEDULING REQUEST WITH DATA
*                            MANAGER REQUEST OUTSTANDING.
*                TO *TERR20* IF INCORRECT WAIT FOR INPUT.
*                TO *TERR21* IF MORE THAN ONE TRANSACTION USING TASK
*                            CONTAINING A *WAITINP* REQUEST.
*                TO *TERR22* IF NOT CALLED FROM SYSTEM TASK LIBRARY.
*                TO *TERR40* IF TRANSACTION NAME UNKNOWN.
*                TO *TSSC* WHEN PROCESSING COMPLETE.
 
 
 SCT      SB4    X5+         ADDRESS OF PARAMETERS
          LX5    -18
          SB4    -B4
          SX0    X5          FUNCTION CODE
          SX5    B2+CB1C     C.B. HEADER BLOCK LOCATION
          LX0    -1
          ZR     X0,SCT1     IF CEASE
          SB3    X0
          SX7    X1+B4
          GT     B4,TERR2    ADDRESS WORD OUT OF BOUNDS
          SX6    B3-SCTJTL
          NG     X7,TERR2    ADDRESS WORD OUT OF BOUNDS
          PL     X6,TERR3    IF INCORRECT FUNCTION CODE
          JP     B3+SCTJT    JUMP THRU TABLE TO PROCESS CALL
 
*         JUMP TABLE TO HANDLE *SCT* CALL.
 
 SCTJT    PL     X0,SCT1     CEASE
          EQ     SCT32       NEWTRAN
          PL     X0,SCT14    IF CALL TASK WITH CEASE
          EQ     SCT23       CALL TASK WITHOUT CEASE
          PL     X0,SCT37    IF CALL TASK WITH RETURN
          JP     SCT51       WAIT FOR TERMINAL INPUT
          PL     X0,SCT57    IF TIMED ROLLOUT
          JP     SCT60       CHKON
          PL     X0,SCT61    IF CHKOFF
          EQ     SCT51       BUFFER WAIT FOR TERMINAL INPUT
          PL     X0,SCT62    IF CALL TRANSACTION
          EQ     TERR3       IF INCORRECT SUBFUNCTION CODE
 
 SCTJTL   EQU    *-SCTJT     LENGTH OF SCT JUMP TABLE
 
*         CEASE - PROCESS A TASK CEASE.
*
*         ENTRY  (B5) = TASK RA.
*                (B4) = NEGATIVE VALUE OF PARAMETER, PARAMETER
*                       VALUES AND DESCRIPTIONS FOR THE *CEASE*
*                       REQUEST FOLLOW -
*                            .LT. -1 RESERVED FOR CDC.
*                            = -1 IF NORMAL CEASE AND TERMINAL
*                               IS NOT TO BE UNLOCKED.
*                            = 0 IF NORMAL CEASE.
*                            = 1 IF ABNORMAL CEASE WITHOUT DUMP.
*                            .GT. 1 IF ABNORMAL CEASE WITH DUMP.
 
 
 
 SCT1     SA1    KDISB
          ZR     X1,SCT2     IF NO TASK *K-DISPLAY* ACTIVE
          MX6    42
          SB3    X1          C.B. ADDRESS
          SA2    B2+CB2C     CURRENT C.B. WORD TWO
          SB5    X2          C.B. ADDRESS
          SX7    B3-B5
          NZ     X7,SCT2     IF ANOTHER TASK HAS *K-DISPLAY*
          SX1    KFRM        SWITCH *K-DISPLAY* TO *TAF*
          SA2    KCTRL1
          BX6    X6*X2
          SA7    A1          CLEAR INTERLOCK *KDISB*
          BX6    X6+X1
          SA6    A2
          CONSOLE KCTRL1
          MESSAGE ZWORD,2
 SCT2     ZR     B4,SCT3     IF NO PARAMETER
          NG     B4,SCT36    IF CEASE WITH ABORT
          SB4    B4-B1
          NZ     B4,SCT36    IF CEASE WITH ABORT
          MX7    1
          LX7    CBLKS-59
          SA1    B2+CB1C
          BX7    X1+X7
          SA7    A1+
 SCT3     SA1    B2+CB2C     COMMUNICATION BLOCK WORD 2
          MX6    12
          SX0    X1          FWA OF COMMUNICATION BLOCK
          SB3    SCT11       RETURN ADDRESS
          SA3    X0+CBTLW    TASK LIST
          BX6    -X6*X3
          LX6    12
          SA6    A3+
          NZ     X6,SCT17    IF MORE TASKS TO SCHEDULE FOR C. B.
          SA2    X0+CBCR     CHECK *CALLRTN* TASKS
          LX2    59-CBRFS
          NG     X2,SCT45    IF TASK WAS INITIATED BY A *CALLRTN*
          LX1    17-CBTAS
          SX3    X1          TST ADDRESS
          SA4    X0+CMBHL+1
          ZR     X3,SCT8     IF TAF ORIGIN TRANSACTION
          LX4    59-CBBTS
          MX6    60-TSAUN
          NG     X4,SCT7     IF BATCH TRANSACTION
 .A       IFEQ   IPTAR,1     IF AUTOMATIC RECOVERY INSTALLED
 
*         IF *SECURE* REQUEST WAS ISSUED, SEND MESSAGE TO TERMINAL.
 
          SB5    B2+NUAPL    FWA OF TASK RA
          SA4    B2+SECR     SEND PARAMETERS FOR *SECURE*
          ZR     X4,SCT6     IF NO *SECURE* MESSAGE
          SA2    B2+SECH     APPLICATION BLOCK HEADER
          MX0    -AHCTN      MASK FOR CHARACTER TYPE
          LX2    AHCTN-1-AHCTS  RIGHT JUSTIFY CHARACTER TYPE
          SA3    B2+CB1C     INDICATE TRANSACTION SEND
          MX7    1
          LX7    CBSDS-59
          BX7    X3+X7
          SA7    A3+
          BX4    -X0*X2      CHARACTER TYPE
          SX3    X4-4
          NZ     X3,SCT4     IF NOT DISPLAY CHARACTER TYPE
          LX2    AHCTS-AHCTN+1
          BX7    X2
          MX5    -AHLCN
          BX3    -X5*X2      LENGTH OF MESSAGE
          ERRNZ  AHLCS-AHLCN+1  IF LENGTH NOT RIGHT JUSTIFIED
          RJ     CML         COMPUTE MESSAGE LENGTH
          SA2    B2+SECR     *SEND* REQUEST FOR *SECURE*
          SB6    X6+         REMAINDER OF MESSAGE OVER WORD BOUNDARY
          LX2    17-47       FWA OF MESSAGE RELATIVE TO TASK
          SX3    X2+B5       FWA OF MESSAGE RELATIVE TO *TAF*
          RJ     SEL         SET END OF LINE BYTE
          MX0    60-AHLCN
          SX3    10          COMPUTE MESSAGE LENGTH
          BX7    X0*X7
          IX6    X1*X3
          BX7    X6+X7
          SA7    B2+SECH
          SA2    B2+SECR     FIRST WORD OF *SEND* REQUEST
          MX4    60-18
          BX2    X4*X2       CLEAR OLD MESSAGE WORD COUNT
          BX2    X2+X1       NEW MESSAGE WORD COUNT
          BX7    X2
          SA7    B2+SECR
 SCT4     SA2    B2+SECR     FIRST WORD OF *SEND* REQUEST
          SB3    X2          WORD COUNT OF MESSAGE
          LX2    17-47       FWA OF MESSAGE RELATIVE TO TASK
          SB6    X2
          SB6    -B6+B1
          SA1    B2+CB2C     FWA OF TERMINAL
          LX1    17-CBTAS
          SA4    X1          FIRST WORD OF TERMINAL ENTRY
          SX7    SCT5        RETURN ADDRESS
          SA7    B2+SCRC+1
          LX4    59-TSLIS
          EQ     SND         SEND MESSAGE
 
 SCT5     SA1    B2+SECH
          SA2    B2+SECR
          RJ     REM         RESTORE END OF MESSAGE
          EQ     SCT8        CONTINUE CEASE PROCESS
 .A       ENDIF
 
*         SEND LAST MESSAGE BLOCK IF IT IS NOT SENT YET.
 
 SCT6     SA2    B2+CB1C     COMMUNICATION BLOCK WORD ONE
          LX2    59-CBLKS
          NG     X2,SCT8     IF NOT TO UNLOCK TERMINAL
          SA3    X1+
          SA4    X1+B1       WORD TWO OF TST
          LX3    59-TSLIS
          PL     X3,SCT8     IF TERMINAL NOT LOGGED IN
          LX4    59-TSMSS
          SX7    SCT8        RETURN ADDRESS
          MX0    -59
          BX6    -X0*X4
          LX6    TSMSS-59
          SA6    A4+
          NG     X4,SCT8     IF LAST MESSAGE ISSUED
          RJ     SLB         SEND LAST MESSAGE BLOCK
 
*         CLEAR BATCH TRANSACTION USER ACTIVE FLAG.
 
 SCT7     LX6    TSAUS-0
          SA4    X3          TST WORD ONE
          SX5    CSCE        CEASE/JOB END *STEP*
          SX3    SCT8        RETURN ADDRESS
          BX6    X6*X4
          SA6    A4
          SA2    B2+CB2C     WORD TWO OF C.B.
          SA2    X2+CBRTW    CHECK IF RECOVERABLE TRANSACTION
          LX2    59-CBRTS
          PL     X2,SCT8     IF NOT RECOVERABLE
          RJ     WTS         WRITE TERMINATION *STEP*
 
*         ENTRY POINT FROM *TSSC* FOR TRANSACTION TERMINATION.
 
 SCT8     SA2    B2+CB2C
          SA3    X2+CBTRW    CHECK IF RESTART
          MX7    -60+CBTRN   CLEAR RESTARTED FLAG
          LX3    59-CBTRS
          PL     X3,SCT9     IF NOT RESTART
          BX7    -X7*X3
          LX7    CBTRS-59
          SA7    A3+
          SX3    SCT9        RETURN ADDRESS
          RJ     CID         CLEAR *NEWID* ON *CRF*
 SCT9     SA2    B2+CB2C
          LX2    CBTAN-1-CBTAS  GET *TST* ADDRESS
          SX7    X2
          LX2    CBTAS-CBTAS-CBTAN+1+CBTAS
          ZR     X7,SCT10    IF NOT *TST* ADDRESS
          SA3    X7          CLEAR RECOVERABLE TRANSACTION FLAG
          MX7    60-TSNRN
          LX7    TSNRS-TSNRN+1
          BX7    X7*X3
          SA7    A3
 SCT10    SA3    B2+CB1C     CLEAR NEXT C.B. LINK IN *CB1C*
          MX6    60-CBNCN
          BX6    X6*X3
          SA6    A3
          RJ     RSC         RELEASE SECONDARY COMMUNICATION BLOCKS
          SX0    DMCC        DATA MANAGER CEASE CODE
          RJ     PCDM        PROCESS CEASE FOR DATA MANAGER
          SB3    SCT11       RETURN ADDRESS
          NG     X5,SCT11    IF DATA MANAGER REQUESTS OUTSTANDING
          SA1    B2+CB2C     FWA OF COMMUNICATION BLOCK
          SX2    X1
          RJ     RLC         RELEASE COMMUNICATION BLOCK
 SCT11    MX6    -18
          SA1    B7+B1
          SX2    B1
          BX6    X6*X1       MASK OFF CURRENT C.B. POINTER
          LX6    -36
          SB5    X6+
          IX7    X6-X2       DECREMENT C.B. COUNT
          BX6    X6-X6
          LX7    36+2
          SA6    X1+         ZERO OUT C.B. STATUS WORD
          NG     X7,SCT13    IF CM RESIDENT TASK
          EQ     B5,B1,ESCP  NO MORE C.B. TO RUN
 SCT12    LX7    -2
          SA7    A1
          NE     B5,B1,TSSC  IF MORE COMMUNICATION BLOCKS
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
*         REDUCE CM RESIDENT TASK FL.
 
 SCT13    MX0    -SCNMN
          SA2    A1+B1       WORD 3 OF SUBCP TABLE
          LX2    SCNMN-SCNMS-1
          BX6    -X0*X2      TASK INDEX
          TA3    X6+1,VTLD   TLD WORD 3
          LX3    59-TLRES
          PL     X3,SCT28    IF REDUCE TASK FL NOT SELECTED
          SA2    A3-2        FWA OF TLD ENTRY
          MX0    -TLFLN      GET TASK ORIGINAL FL
          LX2    TLFLN-TLFLS-1
          SA3    B7
          MX6    -SCFLN
          BX0    -X0*X2
          LX3    SCFLN-SCFLS-1  GET TASK CURRENT FL
          BX4    -X6*X3
          LX0    6
          BX3    X6*X3       CLEAR OLD FL
          BX3    X0+X3
          IX0    X4-X0
          NG     X0,SCT28    IF FL DOES NOT NEED TO BE REDUCED
          SA2    AVAILCM     UPDATE FREE CORE COUNT
          IX6    X2+X0
          LX0    SCFCS-SCFCN+1
          SA6    A2
          LX3    SCFCS-SCFCN+1-SCFLN+SCFLS+1
          IX6    X0+X3       UPDATE FREE CORE AFTER SUBCP
          SA6    B7
          EQ     SCT28       SEARCH FOR ADDITIONAL TASKS
 
*         CALLTSK - SCHEDULE A TASK WITH CEASE.
 
 SCT14    SA2    X5+B1       GET COMMUNICATION BLOCK ADDRESS
          SB3    SCT11       RETURN ADDRESS
          SX6    X3
          SX0    X2
 SCT15    SA2    B5-B4       TASK LIST
          BX6    X6-X6
          SX4    60
 SCT16    SX4    X4-12
          NG     X4,TERR5    MORE THAN 5 TASKS IN LIST
          SA3    B2+DBNC     D.B. OF THIS TASK
          SB4    0           DETECT *OFF* STATUS
          SB5    0           TASK SEARCH
          RJ     LTT         LOCATE TASK
          ZR     X6,TERR6    TASK NOT FOUND
          SA2    A2+B1       NEXT TASK IN LIST
          LX6    12
          NZ     X2,SCT16    IF MORE TASKS IN LIST
          SB4    X4          SHIFT COUNTER
          LX6    X6,B4       LEFT JUSTIFY ACCUMULATOR
 SCT17    SA3    B7+B1
          BX4    X4-X4
          SA6    X0+CBTLW    STORE CHAIN IN C.B.
          PL     X3,SCT18    IF NOT A SYSTEM PRIVILEGE TASK
          SX4    CMBRL
 
*         SCHEDULE A TASK AND CEASE ONCE THE TASK BIAS HAS BEEN
*         DETERMINED.  ENTRY IS FROM THE *CALLTRN* PROCESSOR.
*
*         ENTRY  (B3) = RETURN ADDRESS FOR ROUTINE *ETSQ*.
*                (X0) = COMMUNICATION BLOCK ADDRESS.
*                (X4) = 0, IF NOT SYSTEM PRIVILEGED TASK.
*                     = *CMBRL* OTHERWISE.
*                (X5) = ADDRESS OF *CB1C* WORD.
 
 SCT18    SA2    X5
          SX1    X4+CMBL-CMBHL-CMBRL
          SA3    X5+B1       TRANSFER C.B. HEADER WORDS
          BX6    X2
          LX7    X3
          MX2    -48         RESET CPU PRIORITY TO DEFAULT
          BX6    -X2*X6
          SX3    DCPPR       SET DEFAULT CPU PRIORITY
          LX3    48
          BX6    X3+X6
          SX2    B2+NUAPL+SUAC+CMBRL
          SA5    B7          SUBCP TABLE HEADER
          LX5    59-57
          PL     X5,SCT19    IF NOT SOLICITED COMMUNICATION BLOCK
          SA5    A5+B1       CURRENT COMMUNICATION BLOCK ADDRESS
          SA5    X5          COMMUNICATION BLOCK POINTER
          LX5    17-35
          SX2    X5+         (X2) = FWA C.B. IN TASK AREA
 SCT19    SA6    X0
          SA7    X0+B1
          SX3    X0+CMBHL+CMBRL
          IX2    X2-X4       BIAS COUNT IF PRIVELDGED TASK
          IX3    X3-X4
          RJ     MVE=        MOVE C.B. BACK TO STORAGE AREA
 SCT20    RJ     ETSQ        ENTER TASK INTO SCHEDULING QUEUE
          ZR     X6,SCT21    IF THE RTL IS FULL
          JP     B3          EXIT
 
*         THE RTL IS FULL, SO PLACE TASK IN RECALL.
 
 SCT21    SX1    B3+
          SX7    SCT22       RETURN ADDRESS
          LX1    18
          BX7    X1+X7
          SA7    B2+RCL
          EQ     TRCL        PLACE TASK ON RECALL
 
 SCT22    SA2    B2+CB2C     RESTORE C.B. ADDRESS
          LX1    -18
          SB3    X1          RESET EXIT ADDRESS
          SX0    X2
          EQ     SCT20       TRY TO ENTER REQUEST INTO RTL AGAIN
 
*         CALLTSK - SCHEDULE A TASK WITHOUT CEASE.
 
 SCT23    SA1    X5+B1       C.B. HEADER WORD
          SA4    B2+BWCC     TASK BRANCH COUNT
          BX6    X1
          SX2    X4-MAXBW
          SX7    X4+B1       BUMP BRANCH COUNT
          SA7    A4
          PL     X2,TERR12   TASK BRANCH LIMIT EXCEEDED
          SA3    X5
          BX7    X3
          SA7    B2+SCRC     SAVE C.B. HEADER WORDS
          SB6    B4
          SA6    A7+B1
 SCT24    SX0    1           SYSTEM REQUEST
          RJ     FFCB        GET A COMMUNICATION BLOCK
          ZR     X0,SCT26    IF NO COMMUNICATION BLOCK
          SA4    A3+B1       GET TERMINAL ORDINAL
          SA3    X1+CMBHL+1
          BX7    X3
          MX3    -18
          SA7    X0+CMBHL+1
          SA2    A3-B1       SET UP TASK ACCESSABLE C.B. HEADER
          MX7    -24
          BX6    X3*X1       CLEAR OLD C.B. ADDRESS
          BX6    X6+X0
          SA6    A1          SET NEW C.B. ADDRESS INTO C.B. HEADER
          MX6    -CBTON
          LX4    CBTON-CBTOS-1
          BX1    -X6*X4      TERMINAL ORDINAL
          BX4    X7*X2       CLEAR TASK SEQUENCE NUMBER
          SB3    B6          SAVE FWA OF TASK NAME
          RJ     ASN         GET SEQUENCE NUMBER
          BX7    X4+X6       ADD SEQUENCE NUMBER
          SA7    A7-B1
          SX2    20031B      CREATE NEW C.B. HEADER WORD ONE
          LX6    18
          LX2    -15
          BX6    X6+X2       SEQ NUMBER + PRIORITY + MESSAGE SENT
          SA6    X5
          SB4    B3+         FWA OF TASK NAME
          SB3    SCT25       RETURN ADDRESS
          EQ     SCT15       SCHEDULE TASK
 
 SCT25    SA1    B2+SCRC     RESTORE C.B. HEADER WORDS
          SA2    A1+B1
          MX7    CBLKN       SET LOCK TERMINAL FLAG
          LX7    CBLKS-59
          BX7    X1+X7
          LX6    X2
          SA7    B2+CB1C
          SA6    A7+B1
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         PLACE TASK ON RECALL - NO AVAILABLE C.B.
 
 SCT26    SX1    B6          SAVE IMPORTANT REGISTERS
          BX7    -X1
          SX4    SCT27       RETURN ADDRESS
          LX7    18
          BX7    X7+X4
          EQ     TRCL2       PLACE TASK ON RECALL
 
 SCT27    LX1    -18
          SX5    B2+CB1C     C.B. HEADER WORD ADDRESS
          SB6    X1
          SB6    -B6
          SA3    X5          GET COMMUNICATION BLOCK ADDRESS
          SB5    B2+NUAPL    TASK RA
          SA1    X5+B1
          EQ     SCT24       TRY TO BRANCH AGAIN
 
*         FIND TASKS SCHEDULED FOR CORE RESIDENT TASK NOW ENDING.
 
 SCT28    NE     B5,B1,SCT12 IF MORE TASKS TO PROCESS
          SA2    RTLW        RTL RESERVATION WORD
          TB4    B7,-VCPA
          ZR     B4,SCT31    IF *ITASK*, DO NOT CHECK REQUEST TASK LIST
          LX7    -2
          SB5    0
          MX0    12
          SA3    A1+1        SUB CP STATUS WORD 3
          MX1    1
          BX2    X1+X2       LOOKING FOR ZERO BITS
          SA7    A1
          SX6    B2          SAVE FWA OF TASK SYSTEM AREA
          SA6    SCTD
          SB2    B0
          MX7    -6
          BX3    X0*X3       TASK NAME
          LX1    -12
 SCT29    NX2    B4,X2       FIND A ZERO BIT
          SB4    B4+B4       2 WORDS / ENTRY
          IX2    X2+X1       CLEAR ZERO BIT
          SB5    B5+B4
          SB3    B5-RTLL
          PL     B3,SCT29.1  IF END OF LIST
          SA4    B5+RTL      RTL ENTRY
          BX6    X0*X4       TASK NAME
          IX6    X6-X3
          NZ     X6,SCT29    IF NOT THE SAME TASK
          LX4    5-29
          BX6    -X7*X4      CURRENT PRIORITY
          SB6    X6
          LE     B6,B2,SCT29 IF PRIORITY .LE. SELECTED
          SB2    B6          NEW HIGHEST PRIORITY
          SX5    A4+         NEW SELECTED RTL ADDRESS
          EQ     SCT29       CONTINUE PROCESSING
 
 SCT29.1  SA2    SCTD        FWA OF TASK SYSTEM AREA
          SX4    B2          SELECTED HIGHEST PRIORITY
          SB2    X2          RESTORE (B2)
          ZR     X4,SCT30    IF NO MATCH FOUND
          SB5    X5          GET SELECTED TASK
          SA4    A7          STATUS WORD 2
          SB4    B7+CPAHL
          SA2    B5+1        WORD 2 OF RTL ENTRY
          SB3    TSSC        RETURN ADDRESS
          EQ     SCHD9       QUEUE THE C.B.S FOR EXECUTION
 
 SCT30    RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 SCT31    MX6    1           *ITASK* MAY ACCEPT MORE TRANSACTIONS
          SA6    EVIT
          EQ     SCT12       CHECK FOR MORE WORK FOR TASK
 
*         NEWTRAN - START A NEW TRANSACTION CHAIN.
 
 SCT32    RJ     VTO         VERIFY TASK ORIGIN
          NG     X6,TERR11   TASK NOT VALIDATED FOR REQUEST
          SB6    B4+
 SCT33    SX0    1           SYSTEM REQUEST
          RJ     FFCB        GET A COMMUNICATION BLOCK
          ZR     X0,SCT34    IF NO C.B. AVAILABLE
          SA1    B2+CB1C
          SA2    A1+B1
          BX6    X1          SAVE OLD C.B. HEADER WORDS
          SA6    B2+SCRC
          LX7    X2
          SA7    A6+B1
          SA1    TSEQ
          SB4    B6
          SX4    DCPPR       SET DEFAULT CPU PRIORITY
          SX6    B1
          LX4    -12
          SX3    66B         READ/UPDATE SECURITY LEVELS
          IX6    X6+X1
          BX7    X7-X7
          SA6    X0+CMBHL    USER ACCESABLE C.B. HEADER
          LX3    36
          SA7    A6+B1
          SB3    SCT25       RETURN ADDRESS
          SA6    A1          RESET ADVANCED SEQUENCE NUMBER
          SA6    B5-B4
          BX7    X3+X0
          LX6    18
          SB4    B4-B1
          IX6    X6+X4
          SA7    X5+B1
          SA6    X5+
          EQ     SCT15       SCHEDULE TASK
 
*         PLACE TASK ON RECALL - NO AVAILABLE C.B.
 
 SCT34    SX7    B6          SAVE LIST ADDRESS
          BX7    -X7
          SX3    SCT35       RETURN ADDRESS
          LX7    18
          BX6    X3+X7
          SA6    B2+RCL
          EQ     TRCL        PLACE TASK ON RECALL
 
 SCT35    LX1    -18         RESTORE IMPORTANT REGISTERS
          SX5    B2+CB1C     C.B. HEADER WORD ADDRESS
          SB6    X1
          SB6    -B6
          SB5    B2+NUAPL    TASK RA
          EQ     SCT33       TRY AGAIN
 
*         DUMP TASK FIELD LENGTH.
 
 SCT36    SB3    -B4
          EQ     B3,B1,TERR1 ABNORMAL CEASE WITHOUT DUMP
          BX6    X6-X6
          SA3    TDSP        CHECK *DSP* INTERLOCK
          SX7    SRTN4.1
          NZ     X3,TRCL2    IF A ROUTE IS IN PROGRESS
          SA3    B2+CB2C
          SA6    DTSG        USE *P* AS CALLED FROM ADDRESS
          SX0    X3+         COMMUNICATION BLOCK ADDRESS
          SB3    X3+3        TASK DUMP CONTROL WORDS
          SA1    LOVC
          RJ     LOVL        LOAD/EXECUTE DUMP TASK OVERLAY
          EQ     TERR1       ABORT TASK
 
*         CALLRTN - SCHEDULE A TASK WITH RETURN.
 
 SCT37    MX4    CBNLN
          SA5    X5+B1
          SA3    X5+CBCR     GET CURRENT NEST LEVEL
          MX0    -60+CBNLN
          BX6    X4*X3
          LX6    6
          SB3    X6          NEST LEVEL COUNT
          SX6    X6+B1       INCREMENT NEST LEVEL COUNT
          BX4    -X0*X3
          SX0    X6-NESTL-1
          LX6    -6
          BX7    X6+X4
          PL     X0,TERR18   IF NEST LEVEL LIMIT EXCEEDED
          GT     B3,B1,SCT38 IF NEST LEVEL IS GREATER THAN ONE
          SA1    X5+2        SAVE REQUESTED TASK STRING
          BX6    X1
          SA6    B2+RTSC
 SCT38    SB3    SCT41       RETURN ADDRESS
          SX0    X5
          SA7    A3          UPDATE *CBCR* WORD
          SX5    B2+CB1C
          EQ     SCT15       SCHEDULE TASK(S)
 
*         SET TASK ELIGIBLE FOR ROLLOUT AFTER *RTNDL* MILLESECONDS.
 
 SCT41    RJ     FFR         RESERVE A ROLLOUT TABLE ENTRY
          ZR     X0,SCT43    IF ROLLOUT TABLE ENTRY NOT AVAILABLE
          SA3    B2+CB2C     GET C.B. ADDRESS
          SX2    B1          SET *CALLRTN* FLAG IN *CBCR* WORD
          SA1    X3+CBCR
          LX2    CBRFS
          BX7    X1+X2
          SA7    A1
 SCT42    SX5    RTDNL       TIME ALLOWED BEFORE ROLLOUT
          SX1    X3+         C.B. ADDRESS
          SX4    0500B       ROLLIN BASED ON SCHEDULING PRIORITY + 5
          LX1    30
          BX1    X1+X4
          SB4    EVCR        ROLLOUT TYPE
          BX6    X6-X6
          PX6    X6,B4
          JP     ROL3        SET TASK ELIGIBLE FOR ROLLOUT
 
*         PLACE TASK IN RECALL.
 
 SCT43    SX7    SCT41       RETURN ADDRESS
          JP     TRCL2       PLACE TASK IN RECALL
 
 
*         PROCESS CEASE FROM A *CALLRTN* INITIATED TASK.
 
 SCT45    SA5    X0+CBCR
          SA2    B2+CB1C     TRANSFER C.B. HEADER WORD 1
          BX6    X2
          MX3    -6
          SB3    X5          ROLLOUT TABLE ADDRESS
          LX5    12
          BX5    -X3*X5      SUB CONTROL POINT NUMBER OF CALLER
          SA6    X0
          SA3    A2+B1       TRANSFER C.B. HEADER WORD 2
          BX6    X3
          SA6    X0+B1
          LX5    SCPAL
          TX5    X5-CPAL,VCPA  SUB CONTROL POINT OF CALLER
          SX1    CMBL-CMBHL-CMBRL
          SX2    B2+NUAPL+SUAC+CMBRL
          SA4    B7          SET SUBCP TABLE WORD 1
          LX4    59-57
          PL     X4,SCT47    IF NOT SOLICITED C.B. LOAD
          SA4    A4+B1       SET STATUS POINTER WORD
          SA4    X4          SET COMMUNICATION BLOCK WORD
          LX4    17-35
          SX2    X4          SET FWA OF USER SPECIFIED BUFFER
 SCT47    SX3    X0+CMBHL+CMBRL
          RJ     MVE=        RECOPY COMMUNICATION BLOCK
          SA2    B3
          NG     X2,SCT48    IF CALLERS ROLLOUT COMPLETE
          SA4    X5
          SX4    X4-NUAPL    SUB CONTROL POINT AREA OF CALLER
          SA4    X4+ROSC
          MX7    1
          BX7    X7+X4       SET FINISHED DURING ROLLOUT FLAG
          SA7    A4+
          SA4    X5+SCCCW    GET ACTIVE C.B.
          MX7    42
          SA4    X4          RESET NEW C.B. ADDRESS
          BX7    X7*X4
          BX7    X7+X0
          SA7    A4+
          JP     SCT11       CONTINUE CEASE PROCESSING
 
*         REQUEST ROLL IN OF CALLER.
 
 SCT48    SA4    B3
          SX3    X4
          NZ     X3,SCT50    IF NOT CALLED BY CORE RESIDENT TASK
          SA5    X5+SCCCW    RESET NEW C.B. ADDRESS
          MX7    42
          SA5    X5
          BX7    X7*X5
          BX7    X7+X0
          SA7    A5
          LX4    -18
          SA5    X4          SUB CONTROL POINT ADDRESS OF TASK
          SB5    X5-NUAPL    CONTROL POINT AREA OF CORE RESIDENT TASK
          SB6    X4
          SX4    B3          ROLLOUT TABLE ADDRESS
          SB3    SCT49
          JP     ROL16       RELOAD C.B. AND RESTORE OLD ROLLOUT WORDS
 
 SCT49    SB3    SCT11       CONTINUE CEASE PROCESSING
          SX4    B5+
          JP     RCPU        REQUEST CPU FOR CORE RESIDENT TASK
 
 SCT50    SX5    B3
          RJ     MSQ         MAKE SCHEDULER ENTRY FOR ROLL IN
          JP     SCT11       CONTINUE CEASE PROCESSING
 
*         WAITINP - WAIT FOR TERMINAL INPUT.
*         BWAITINP - BUFFERED WAIT FOR TERMINAL INPUT.
 
 SCT51    SA3    B2+CB1C     COMMUNICATION BLOCK WORD 1
          BX4    X3
          SA1    B7+B1
          MX7    1           PRESET ERROR CODE
          SA2    B2+CB2C     COMMUNICATION BLOCK WORD 2
          LX4    59-CBSDS    LEFT JUSTIFY SEND FLAG
          LX1    2
          NG     X1,TERR20   IF CM RESIDENT TASK
          PL     X4,TERR28   IF NO SEND PRIOR TO WAIT INPUT
          LX1    -2-36
          SX3    X1-1
          LX2    CBTAN-1-CBTAS  RIGHT JUSTIFY TERMINAL ADDRESS
          SX6    X2          TERMINAL STATUS TABLE ADDRESS
          NZ     X3,TERR21   IF MORE THAN ONE TRANSACTION USING TASK
          ZR     X6,TERR20   IF NO ORIGINATING TERMINAL
          SA3    X6+TSIWW    INPUT WANTED STATUS FOR TERMINAL
          LX3    59-TSIWS
          ZR     X3,SCT56    IF TERMINAL IN INPUT WANTED STATE
          SX7    SCT52       RETURN ADDRESS
          RJ     SLB         SEND LAST BLOCK
 SCT52    MX4    TSIWN       SET INPUT WANTED FLAG
          SA3    B2+CB2C     GET TST ADDRESS
          LX4    CBITS-59
          SA2    X3+CBITW    SET INITIAL TRANSFER BIT
          LX3    CBTAN-1-CBTAS
          ERRNZ  TSIWN-CBITN INPUT WANTED .NE. INITIAL TRANSFER
          BX6    X4+X2
          SA6    A2+
          SA2    X3+TSIWW    GET TST WORD 2
          LX4    TSIWS-59-CBITS+59
          BX6    X2+X4       ADD INPUT WANTED FLAG
          SA6    A2          UPDATE TST WORD 2
          LX3    17-CBFWS-CBTAN+1+CBTAS
          SX2    X3
          MX7    CBTON
          BX7    X7*X3       TERMINAL ORDINAL
          ERRNZ  CBTOS-59    IF TERMINAL ORDINAL NOT LEFT JUSTIFIED
          LX7    35-59
          SA7    B2+RCLA
          SA3    X2+CBTLW    SAVE W3 - W6 OF C.B. SYSTEM HEADER
          SA4    A3+B1       WORD 4
          BX6    X3
          SA5    A4+B1       WORD 5
          BX7    X4
          SA6    B2+WICB
          SA3    A5+B1       WORD 6
          SA7    A6+B1
          BX6    X5
          BX7    X3
          SA6    A7+B1
          SA7    A6+B1
          RJ     RLC         RELEASE COMMUNICATION BLOCK
 SCT53    SX7    SCT53
          RJ     FFR         RESERVE A ROLLOUT TABLE ENTRY
          ZR     X0,TRCL2    IF ROLLOUT TABLE FULL
          SA1    B7+B1
          SX3    B7
          MX6    42
          BX6    X6*X1       CLEAR SUB CP C.B. STATUS WORD POINTER
          SA2    B2+CB1C+1
          BX6    X6+X3
          LX2    -42
          SX1    30B         WAITING FOR INPUT AND TIMED ROLLOUT
          SX2    X2          TERMINAL ORDINAL
          SA6    A1
          LX2    18
          SX7    B1
          LX1    54
          SA3    B2+LRA1     RETRIEVE PARAMETER ADDRESS
          BX1    X1+X2
          SB3    B2+NUAPL    TASK RA
          SA4    SCTA        READ BUFFER-*WAITINP* REQUEST
          MX2    42
          BX5    X2*X3
          BX5    X5-X4
          MX2    -11
          NZ     X5,SCT54    IF NOT BUFFER *WAITINP* REQUEST
          MX5    1           SET RECALL BIT IN *LRA1*
          LX5    40-59
          BX6    X5+X3
          SX4    DWITL       (X4) = DEFAULT *WAITINP* TIMEOUT LIMIT
          SA6    A3
          EQ     SCT55       CONTINUE PROCESSING BUFFER *WAITINP*
 
 SCT54    SA4    X3+B3       READ TASK SUPPLIED TIME-OUT VALUE
          SA7    A4          SET ROLLOUT COMPLETE FLAG FOR TASK
          BX4    -X2*X4      USER DESIRED TIME OUT ON WAIT FOR INPUT
          MX7    -RTTLN      MASK SECONDS
          NZ     X4,SCT55    IF USER SPECIFIED TIME OUT
          SX4    DWITL       DEFAULT TIME OUT FOR WAIT ON INPUT
 SCT55    SA2    LTIME       CURRENT TIME
          BX5    X5-X5
          AX2    36
          BX2    -X7*X2
          IX2    X2+X4       TIME TO TIME OUT TASK WAITING FOR INPUT
          LX2    30
          BX1    X2+X1
          SB4    EVWI        ROLLOUT TYPE
          SA2    B2+CB1C
          MX3    -CBTSN      MASK TRANSACTION SEQUENCE NUMBER
          LX2    CBTSN-CBTSS-1  RIGHT JUSTIFY SEQUENCE NUMBER
          BX6    -X3*X2
          LX6    RTTSS-RTTSN+1
          SA3    B2+WICB+3   GET *CDCS* CONNECTION FLAG
          MX7    1
          LX3    59-CDDM
          BX2    X7*X3
          LX2    RTCDS-59
          BX6    X2+X6       ADD *CDCS* CONNECTION FLAG
          PX6    X6,B4
          EQ     ROL3        ROLLOUT TASK UNTIL INPUT RECEIVED
 
 SCT56    SA7    B2+16B      SET STATUS IN TASK X6
          EQ     TSSC        ENTER MAIN LOOP
 
*         WAIT - ROLL TASK OUT FOR SPECIFIED TIME PERIOD.
 
 SCT57    SA3    X5
          SA4    B5-B4       PARAMETER WORD
          MX6    -12
          SA1    B7+B1       GET WORD 2 OF SUBCP TABLE ENTRY
          SA3    LTIME
          MX7    24
          BX6    -X6*X4      USER REQUESTED ROLLOUT TIME (IN SECONDS)
          SX5    X6-MINTL    MINIMUM TIME TO STAY IN CORE
          BX7    X7*X3       CURRENT SECOND COUNT FROM REAL TIME CLOCK
          LX6    36
          SX4    12B
          IX6    X6+X7       TIME AT WHICH TO ROLLIN TASK
          LX6    -6
          LX1    59-SCCRS    POSITION CM RESIDENT BIT
          LX4    54
          NG     X1,SCT58    IF CM RESIDENT TASK
          NG     X5,SCT58    IF DELAY PERIOD IS LESS THAN *MINTL*
          SX5    B0
          BX1    X4+X6       EVENT DESCRIPTOR
          JP     ROLL        ROLLOUT TASK
 
*         PUT TASK INTO RECALL.
 
 SCT58    SX7    SCT59       RETURN ADDRESS
          LX6    6           POSITION BACK
          IX7    X6+X7
          EQ     TRCL2       PUT TASK INTO RECALL
 
*         PROCESS TASK AFTER RECALL.
 
 SCT59    MX3    24          CHECK IF REAL TIME ELAPSED
          SA2    LTIME
          BX4    X3*X1       TASK ACTIVATION TIME
          BX5    X3*X2       REAL TIME
          IX6    X4-X5
          PL     X6,TRCL     IF NOT TIME TO ACTIVATE TASK
          EQ     TSSC        ENTER MAIN LOOP
 
*         CHKON - SET *TOTAL* INTERLOCK FLAG.
 
 SCT60    SA1    B2+DBNC     DATA BASE NAME
          RJ     VTO         VERIFY TASK ORIGIN
          SA3    TOTLCK      TOTAL INTERLOCK FLAG
          NG     X6,TERR26   IF TASK ORIGIN NOT TASKLIB
          SA2    B2+CB1C     SEQUENCE NUMBER
          NZ     X3,TERR26   IF INTERLOCK ALREADY SET
          MX3    24
          LX2    18
          SX1    X1          TASK ID
          BX6    X3*X2       SEQUENCE NUMBER
          BX6    X6+X1
          SA6    A3          SET TOTAL INTERLOCK FLAG
          EQ     TSSC        REQUEST COMPLETE - REENTER SWITCHING LOOP
 
*         CHKOFF - CLEAR *TOTAL* INTERLOCK FLAG.
 
 SCT61    SA1    B2+CB1C     TASK SEQUENCE NUMBER
          RJ     VTO         VERIFY TASK ORIGIN
          SA2    TOTLCK      TOTAL INTERLOCK FLAG
          NG     X6,TERR26   IF TASK ORIGIN NOT TASKLIB
          ZR     X2,TERR26   IF INTERLOCK NOT SET
          MX3    24
          LX1    18
          BX2    X3*X2
          BX1    X3*X1
          IX6    X1-X2       VERIFY SEQUENCE NUMBER OF TASK
          NZ     X6,TERR26   IF NOT THE SAME TASK AS THE SETTING TASK
          SA6    TOTLCK      CLEAR TOTAL INTERLOCK FLAG
          EQ     TSSC        REQUEST COMPLETE - REENTER SWITCHING LOOP
 
*         CALLTRN - SCHEDULE A TRANSACTION.
 
 SCT62    RJ     VTO         VALIDATE TERMINAL ORIGIN
          NG     X6,TERR11   IF NOT SYSTEM ORIGIN TASK
          SA2    B5-B4       PARAMETER WORD
          SA3    B2+DBNC     GET DATA BASE NAME
          SB5    B1          TRANSACTION SEARCH
          RJ     LTT         LOCATE TRANSACTION
          ZR     X6,TERR40   IF TRANSACTION NAME UNKNOWN
          SA4    A1+B1       WORD TWO OF TRD ENTRY
          BX6    X4
          SA4    B2+CB2C     SYSTEM C.B. HEADER
          SA6    X4+CBTLW    PUT TASK LIST IN C.B.
          SB3    X4          FWA OF C.B.
          SA4    X4+CBCSW
          SA2    A1          WORD ONE OF TRD ENTRY
          MX6    -1
          BX3    -X6*X2
          LX3    CBRTS-0
          BX4    X4+X3       ADD RECOVERABLE TRANSACTION FLAG
          MX6    -2
          LX6    TDDCS-TDRMS
          BX3    -X6*X2
          LX3    CBCSS-TDDCS
          BX6    X4+X3       ADD DATA MANAGERS ALLOWED FLAG
          SA6    A4
          ERRNZ  TDDCS-TDRMS-1  BITS MUST BE ADJACENT
          ERRNZ  CBCSS-CBRMS-1  BITS MUST BE ADJACENT
          RJ     RTI         RECOVER TERMINAL INPUT
          SX5    B2+CB1C
          BX4    X4-X4
          SA2    X5+B1       GET COMMUNICATION BLOCK ADDRESS
          SX0    X2+         FWA OF C.B.
          SB3    SCT11       RETURN ADDRESS AFTER TASK IS SCHEDULED
          EQ     SCT18       SCHEDULE FIRST TASK
 
 SCTA     VFD    24/4LSCTP,6/0,12/9,18/0  FORM OF BUFFER-*WAITINP*
 SCTB     BSS    1           BIAS OF *OFFTASK*
 SCTC     BSS    1           BIAS OF *CTASK*
 SCTD     CON    0           FWA OF TASK SYSTEM AREA
 AAM      SPACE  4,30
**        AAM - ADVANCED ACCESS METHODS REQUEST PROCESSOR.
*               AAM ENTERS REQUEST INTO *AMIQ* INPUT QUEUE.
*
*         ENTRY  (X5) = 24/3LAAM,18/FNC,18/ADR
*                       FNC - FUNCTION CODE FOR REQUEST.
*                       ADR - ADDRESS OF PARAMENTER LIST.
*
*         EXIT   TO *DCPT* IF NO ERRORS AND RECALL REQUESTED.
*                TO *TERR2* IF INCORRECT PARAMETER ADDRESS.
*                TO *TERR3* IF INCORRECT FUNCTION CODE.
*                TO *TERR39* IF AAM USAGE NOT SELECTED
*                TO *TERR30* IF *CRM* DATA MANAGER NOT LOADED.
*                TO *TRCL* IF NO MORE TRANSACTIONS CAN MAKE REQUESTS.
*                TO *TRCL2* IF INPUT QUEUE IS FULL.
*                TO *TSSC* IF NO ERRORS AND NO RECALL REQUESTED.
*
*                *AMIQ* CONTAINS QUEUE ENTRY -
*
*         24/ TS,6/0,6/ FC,1/R,5/ SN,18/ ADR
*                TS - TRANSACTION SEQUENCE NUMBER
*                FC - REQUEST FUNCTION CODE.
*                R - RECALL FLAG, ALWAYS = 1 FOR RECALL.
*                SN - SUB-CONTROL POINT NUMBER.
*                ADR - FWA OF REQUEST PARAMETERS.
*
*         USES   X - ALL.
*                A - 1, 3, 4, 5, 7.
*                B - 3, 4, 5.
*
*         CALLS  PDIF.
 
 
 AAM      TX3    0,VAAM,LWA  AAM  INITIALIZATION FLAG
          SB4    X5+          ADDRESS OF PARAMETERS
          ZR     X3,TERR30   IF *CRM* DATA MANAGER NOT LOADED
          ZR     B4,TERR2    IF PARAMETER ADDRESS ZERO
          LX5    -18
          SB4    -B4
          SX0    X5          FUNCTION CODE
          SX6    X1+B4
          NG     X6,TERR2    IF PARAMETER ADDRESS OUT OF BOUNDS
          PL     B4,TERR2    IF PARAMETER ADDRESS OUT OF BOUNDS
          SX6    X5-100B
          PL     X6,TERR3    IF FUNCTION CODE GREATER THAN 6 BITS
          SX3    X0-DMCC
          ZR     X3,TERR3    IF TASK USED DATA MANAGER CEASE CODE
 
*         BUILD INPUT QUEUE REQUEST.
 
          LX0    30-6        FUNCTION CODE
          SX4    -B4         ADDRESS OF PARMETER LIST
          SB3    AAM6        RETURN ADDRESS
          SA2    B2+CB2C     COMMUNICATION BLOCK ADDRESS
          SA3    X2+CBSOW
          LX3    59-CBSOS
          NG     X3,AAM1     IF SYSTEM TASK
          SX1    X5
          SX2    X1-TRSR
          PL     X2,TERR3    IF TASK USED SYSTEM REQUEST
 
*         ENTRY POINT FOR TASK CEASE.
 
 AAM1     TX2    B7+CPAL,-VCPA  COMPUTE SUBCP NUMBER
          SA3    B2+TRID     TRANSACTION IDENTIFIER
          IX4    X4+X0       ADD FUNCTION CODE
          MX0    1
          LX0    23-59       FORCE RECALL
          AX2    SCPAL
          BX4    X4+X0       ADD RECALL BIT
          LX2    23-5        SUB-CONTROL POINT NUMBER
          BX4    X4+X2       ADD SUB CONTROL POINT NUMBER
          LX3    59-23       POSITION TRANSACTION IDENTIFIER
          SA5    AAMA        AAM STATUS WORD
          SX1    B1
          BX6    X4+X3       ADD TRANSACTION IDENTIFIER
          SA3    B2+CB2C     FWA OF COMMUNICATION BLOCK
          SX0    X3+
          SA3    X3+CBCR
          LX3    59-AAMDM
          MX7    1
          NG     X3,AAM3     IF TRANSACTION MADE A PREVIOUS REQUEST
 
*         IF TRANSACTION RECOVERABLE AND AAM REQUEST NOT ALLOWED,
*         ABORT TASK.
 
          SA4    X0+CBRTW
          LX4    59-CBRTS
          PL     X4,AAM2.1   IF NOT A RECOVERABLE TRANSACTION
          ERRNZ  CBRTW-CBRMW RECOVERABLE TRANSACTION BIT NOT IN SAME
                             WORD AS *CRM* ALLOWED BIT
          LX4    59-CBRMS-59+CBRTS
          PL     X4,TERR39   IF AAM USAGE NOT SELECTED
 
*         CHECK IF ANOTHER TRANSACTION CAN MAKE REQUEST.
 
 AAM2.1   LX5    17-35       FUNCTION
          SB4    X5
          BX7    X7+X3       ALLOW TRANSACTION TO USE AAM
          LX7    AAMDM-59
          SA7    A3+
          ZR     B4,AAM9     IF AAM CANNOT ACCEPT CALLS
          IX5    X5-X1       DECREMENT AAM TRANSACTION COUNT
          LX5    18
          BX7    X5
          SA7    A5
 
*         ENTER REQUEST INTO INPUT QUEUE.
 
 AAM3     TB5    0,VAAQ      FWA OF INPUT QUEUE FET
          SX4    B3+         SAVE RETURN ADDRESS
 AAM4     RJ     PDIF        PUT ENTRY IN INPUT QUEUE
          SB3    X4          RESTORE RETURN ADDRESS
          ZR     X7,AAM7     IF INPUT QUEUE FULL
          MX1    -6
          BX7    X7-X7       INSURE THAT *AMI* WILL BE CALLED
          LX6    -24
          SA7    DTIME
          BX1    -X1*X6
          SX3    B1
          SX1    X1-DMCC
          IX7    X5+X3       ADVANCE OUTSTANDING REQUESTS
          SA7    A5
          ZR     X1,AAM5     IF TASK CEASE REQUEST
          SA1    B2+AAMC     AAM STATUS WORD
          IX6    X1+X3       AAM OUTSTANDING REQUEST COUNT
          SA6    A1
 AAM5     JP     B3          RETURN
 
 AAM6     RJ     DCPT        DROP THE CPU FOR THE TASK
          EQ     TSSC        TIME SLICE SUBCP
 
*         PLACE TASK IN RECALL BECAUSE QUEUE IS FULL.
 
 AAM7     SX7    AAM8        RESTART ADDRESS FOR TASK RECALL
          SX2    B3+         RETURN ADDRESS AFTER TASK MAKES REQUEST
          LX2    18
          BX7    X7+X2       SAVE RETURN ADDRESS
          SA6    B2+RCLA
          EQ     TRCL2       PLACE TASK ON RECALL
 
*         TASK HAS COME OUT OF RECALL.  TRY PUTTING REQUEST
*         IN QUEUE AGAIN.
 
 AAM8     AX1    18
          SA4    A1+B1       AAM INPUT QUEUE ENTRY
          SA5    AAMA        AAM STATUS WORD
          SB3    X1          RETURN ADDRESS
          BX6    X4          SET  INPUT QUEUE ENTRY
          EQ     AAM3        TRY TO PLACE IN QUEUE AGAIN
 
*         PLACE TASK ON RECALL BECAUSE NO MORE TRANSACTIONS
*         MAY USE DATA MANAGER AT THIS TIME.
 
 AAM9     SX7    AAM10       RETURN ADDRESS FROM RECALL
          SX2    B3+         RETURN ADDRESS AFTER PLACING IN QUEUE
          LX2    18
          BX7    X7+X2
          SA6    B2+RCLA     SAVE QUEUE ENTRY
          SA7    B2+RCL
          EQ     TRCL        PLACE TASK ON RECALL
 
*         TASK HAS COME OUT OF RECALL.  CHECK TO SEE IF DATA
*         MANAGER CAN NOW HANDLE NEW TRANSACTION.
 
 AAM10    SA5    AAMA        AAM STATUS WORD
          SX3    B1
          LX5    -18
          SB4    X5
          ZR     B4,TRCL     IF STILL UNABLE TO START TRANSACTION
          IX7    X5-X3       DECREMENT TRANSACTIONS MAKING REQUESTS
          LX7    18
          SA7    A5
          EQ     AAM8        SET UP QUEUE REQUEST
 
*T        AAMA   24/0,18/ ANS,18/ ANO
*
*                ANS - MAXIMUM TRANSACTIONS MAKING *CRM* REQUESTS.
*                ANO - NUMBER OF OUTSTANDING TRANSACTIONS.
 AAMA     VFD    24/0,18/0,18/0
 CPM      SPACE  4,25
**        CPM - CONTROL POINT MANAGER.
*
*         FUNCTION PROCESSOR FOR *CPM* FUNCTIONS 27B - GET JOB ORIGIN
*         AND 137B - GET CONSOLE TYPE.  IN ORDER FOR SOME PRODUCT SET
*         BINARIES TO MAKE RUN-TIME DETERMINATION AS TO WHETHER OR NOT
*         THE CODE SEGMENT IS EXECUTING IN THE TRANSACTION ENVIRONMENT,
*         THE *GETJO* FUNCTION OF *CPM* IS SUPPORTED.
*
*T        18/ CPM, 6/ R, 12/ FUNC, 24/ ADDR.
*
*         ADDR - ADDRESS TO RETURN JOB ORIGIN.
*
*         ENTRY  (X1) = TASK FL.
*                (X5) = SYSTEM REQUEST.
*                (B3) = TASK RA.
*
*         EXIT   TO *TERR2* IF INCORRECT PARAMETER ADDRESS.
*                TO *TERR3* IF INCORRECT *CPM* FUNCTION CODE.
*                TO *TSSC* UPON COMPLETION.
*
*         USES   A - 7.
*                X - 0, 6, 7.
*                B - 4, 6.
*
*         MACROS CSTATUS.
 
 
 CPM      SB6    X1+         (B6) = FL
          SB4    X5          (B4) = ADDRESS OF PARAMETERS
          SX6    B4-B6
          PL     X6,TERR2    IF ADDRESS OUT OF BOUNDS
          LE     B4,B1,TERR2 IF ADDRESS OUT OF BOUNDS
          MX0    -12         EXTRACT *CPM* FUNCTION CODE
          BX6    X5
          LX6    11-35
          BX6    -X0*X6
          SX6    X6-137B
          SX7    TROT        SET TRANSACTION ORIGIN
          ZR     X6,CPM2     IF CONSOLE TYPE REQUESTED
          SX6    X6-27B+137B
          NZ     X6,TERR3    IF UNSUPPORTED FUNCTION CODE REQUESTED
 
*         PROCESS 27B REQUEST BY RETURNING TRANSACTION ORIGIN TO TASK.
 
          SA7    X5+B3
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 
*         PROCESS 137B REQUEST BY RETURNING CONSOLE TYPE TO TASK.
 
 CPM2     CSTATUS  B3+B4
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 D00      SPACE  4,40
**        D00 - DIAGNOSTIC FUNCTION PROCESSOR.
*
*         *D00* IS CALLED BY THE COBOL DIAGNOSTIC ROUTINES TO
*         RETRIEVE MESSAGE TEXTS FROM *STEXT* TYPE RECORDS WHICH
*         RESIDE ON THE SYSTEM FILE.
*
*T        18/ D00, 6/ R, 18/ 0, 18/ ADDR.
*
*         ADDR  12/ FUNC, 12/ MESS NUM, 12/ BUF LEN, 18/ BUF, 6/ 0.
*
*         WHERE - FUNC = DIRECTIVES TO *DOO* FOR MESSAGE DESTINATION.
*                 MESS NUM = MESSAGE NUMBER TO BE RETRIEVED.
*                 BUF LEN = LENGTH OF MESSAGE BUFFER.
*                 BUF = FWA OF BUFFER.
*
*         RESPONSE -
*
*T        ADDR   36/ 0, 12/ WORD COUNT, 12/ 1
*
*         WORD COUNT = LENGTH OF THE TRANSFERRED CHARACTER STRING.
*                    = 7777B - IF AN ERROR STATUS FOR EITHER
*                      NON-EXISTENT ERROR NUMBERS OR *STEXTS*.
*
*         *D00* WILL NOT ABORT THE EXECUTIVE FOR SUCH ERRORS.
*         THEREFORE, ERROR CHECKING SHOULD BE PERFORMED BY THE
*         EXECUTIVE PRIOR TO RETURN TO THE SUB-CONTROL POINT.
*
*         USES   A - 1, 7.
*                X - 0, 1, 4, 6, 7.
*                B - 4, 6.
*
*         EXITS  TO *TERR2*, IF PARAMETER ADDRESS INCORRECT.
*                TO *TERR3*, IF ERROR DETECTED BY *D00* ON CALL.
*                TO *TSSC*,  UPON COMPLETION OF REQUEST.
*
*         CALLS  SYS=.
 
 
 D00      SB6    X1          (B6) = FL
          SB4    X5          (B4) = ADDRESS OF PARAMETERS
          SX6    B4-B6
          MX0    -18
          PL     X6,TERR2    IF ADDRESS OUT OF BOUNDS
          SA1    X5+B3       READ REQUEST WORD
          LE     B4,B1,TERR2 IF ADDRESS OUT OF BOUNDS
 
*         VALIDATE AND RELAVITIZE ADDRESS IN PARAMETER BLOCK.
 
          LX1    17-23
          BX6    -X0*X1
          MX0    -12         EXTRACT BUFFER LENGTH FOR BOUNDS CHECKING
          LX1    11-29
          BX7    -X0*X1
          IX6    X6+X7
          SX4    B6          (X4) = SUBCP FL
          SX7    B3          (X7) = RA(S)
          IX6    X6-X4
          LX7    6
          PL     X6,TERR2    IF ADDRESS OUT OF BOUNDS
          LX1    35-11
          IX7    X7+X1       (X7) = BIASED *D00* HEADER
          BX6    X7          TEST FOR UNSUPPORTED SUB-FUNCTION CODE
          LX6    59-58
          NG     X6,TERR3    IF UNSUPPORTED FUNCTION CODE
          SA7    A1
 
*         RELAVATIVE ADDRESS POINTER IN REQUEST WORD.
 
          SX7    B3+
          MX4    1           SET RECALL UNCONDITIONALLY
          BX6    X5
          LX4    40-59
          IX6    X6+X7
          BX6    X6+X4
          RJ     SYS=        RE-ISSUE REQUEST TO SYSTEM
 
*         CHECK FOR RETURNED ERROR STATUS FROM *D00*.
 
          SA1    X6          READ REQUEST WORD
          LX1    59-23
          NG     X1,TERR3    IF ERROR STATUS RETURNED
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 SSC      SPACE  4,50
**        SSC - SYSTEM CONTROL POINT REQUEST.
*
*         THIS PROCESSOR ACCEPTS THE TASK REQUEST, ADDS TASK-S RA, FL,
*         AND SEQUENCE NUMBER TO WORD 2 OF REQUEST BLOCK AND ISSUES
*         THE *SSC* REQUEST WITHOUT RECALL. THE FORMAT OF REQUEST IS
*
*T W0     24/RCDS,12/RIN,6/WC,4/RCDC,2/RT,6/RC,5/SF,1/CB
*T,W1     18/EBUF,9/ENUM,27/ ,6/FC
*T,W2     18/RA,18/FL,24/TS
*
*         RT -   RETURN CONTROL FLAG.
*         RC -   REASON CODE RETURNED BY *CDCS*.
*         SF -   ERROR STATUS.
*         CB -   COMPLETE BIT.
*         EBUF - ERROR MESSAGE BUFFER.
*         FC -   FUNCTION CODE.
*         RA -   RA OF TASK.
*         FL -   FL OF TASK.
*         TS -   TRANSACTION SEQUENCE NUMBER.
*
*         1.  VERIFY THAT THE REQUEST BLOCK IS IN THE TASK-S FL AND
*             THAT THE REQUEST IS FOR *CDCS*.
*         2.  IF A TERMINATION REQUEST IS NOT THE LAST TASK OF THE
*             TRANSACTION, RETURN WITH THE COMPLETION BIT SET TO 1.
*         3.  SET THE RETURN CONTROL FLAG IN FWA OF THE REQUEST BLOCK.
*         4.  SET THE TASK-S RA, FL, AND SEQUENCE NUMBER IN WORD 2.
*         5.  ISSUE THE REQUEST WITHOUT RECALL.
*         6.  IF THE REQUEST IS NOT COMPLETE, PUT THE TASK IN RECALL.
*         7.  IF *CDCS* IS NOT PRESENT, ABORT THE TASK.
*         8.  IF *CDCS* IS BUSY, PUT THE TASK IN RECALL AND TRY TO
*             REISSUE THE REQUEST LATER.
*         9.  IF A FATAL ERROR OCCURS, MOVE THE FATAL CDCS MESSAGE
*             TO THE LAST 14 WORDS OF TASK COMMUNICATION BLOCK (*MSABT*
*             WILL SEND THIS MESSAGE TO THE ORIGINATING TERMINAL).
*             JOURNAL THE ERROR MESSAGE AND ABORT THE TASK.
*         10.  RETURN TO CALLER.
*
*         ENTRY  (X1) = TASK FL.
*                (X5) = 24/4LSSCP,18/SS,18/FWA PARAMETER BLOCK.
*                       SS = SUBSYSTEM PRIORITY.
*                (B2) = FWA OF SYSTEM AREA.
*                (B7) = FWA OF SUBCONTROL POINT TABLE.
*                (B5) = TASK RA.
*
*         EXIT   TO *TERR31* IF *CDCS* NOT PRESENT.
*                TO *TERR32* IF FATAL ERROR.
*                TO *TERR39* IF *CDCS* USAGE NOT SELECTED.
*                TO *TSSC* OR *PCDMX* IF NO ERROR.
*                WORD *CBCR* BIT *CDCSDM* OF C.B. UPDATED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  SSM, SYS=, TRCL.
 
 
 SSC      SB3    TSSC        RETURN ADDRESS
          SA2    CDST
          NZ     X2,SSC13.1  IF CDCS ABORTED
          MX0    -CDFCN
          SB4    X5          FWA OF PARAMETER BLOCK
          SX2    X5+B1
          IX2    X1-X2
          LE     B4,B1,TERR2 IF ADDRESS OUT OF RANGE
          NG     X2,TERR2    IF ADDRESS OUT OF RANGE
          MX7    -12         MASK SUBSYSTEM PRIORITY
          LX5    0-18
          SX2    CDSI        *CDCS* SUBSYSTEM ID
          BX7    -X7*X5
          IX3    X2-X7
          NZ     X3,TERR4    IF INCORRECT SYSTEM REQUEST
          SB4    B4+B5       FWA OF PARAMETER BLOCK
          LX5    18-0
          SA2    B4+B1       FETCH FUNCTION CODE
          MX6    6
          SX4    CDNT        NORMAL TERMINATION FUNCTION CODE
          BX2    -X0*X2
          IX0    X2-X4
          NZ     X0,SSC1     IF NOT TERMINATION REQUEST
          SA2    B2+CB2C
          SA3    X2+CBCR
          SX0    B1
          BX7    X6*X3
          SA4    X2+2        GET TASK LIST
          BX4    X7+X4
          ZR     X4,SSC1     IF LAST TASK IN CHAIN
          SA3    B4
          BX6    X3+X0       SET COMPLETE BIT
          SA6    B4
          EQ     TSSC        ENTER MAIN LOOP
 
*         ENTRY POINT FROM *PCDM*.
*
*         (B2) = FWA OF TASK SYSTEM AREA.
*         (B3) = RETURN ADDRESS.
*         (B4) = FWA OF PARAMETER BLOCK.
*         (B5) = TASK RA.
*         (B7) = FWA OF TASK SUBCONTROL POINT TABLE.
*         (X1) = TASK FL.
*         (X5) = 24/4LSSCP,18/,18/FWA OF PARAMETER BLOCK.
 
 SSC1     MX7    -59         CLEAR RECALL FLAG
          SX4    B5          TASK RA
          SA2    CDST
          NZ     X2,SSC13.1  IF CDCS ABORTED
          SA2    STAT20      UPDATE NUMBER OF *SSC* REQUESTS FOR TASKS
          SX6    B1
          IX6    X2+X6
          SA6    A2
          MX0    CDRTN       ADD RETURN CONTROL FLAG
          SA2    B2+CB1C     GET TRANSACTION SEQUENCE NUMBER
          SA3    B2+CB2C     GET FWA OF COMMUNICATION BLOCK
          SA3    X3+CBRTW
          LX3    59-CBRTS
          PL     X3,SSC1.1   IF NOT RECOVERABLE TRANSACTION
          ERRNZ  CBRTW-CBCSW RECOVERABLE TRANSACTION BIT NOT IN SAME
                             WORD AS *CDCS* ALLOWED BIT
          LX3    59-CBCSS-59+CBRTS
          PL     X3,TERR39   IF *CDCS* USAGE NOT ALLOWED
 SSC1.1   LX7    40-59
          BX6    -X7*X5      DELETE RECALL FLAG
          SA3    B4          FIRST WORD OF PARAMETER BLOCK
          LX2    CDTSS-CBTSS
          SA6    B2+CDFN     SAVE REQUEST WORD
          LX0    CDRTS-59
          LX1    CDFLS-17
          IX6    X6+X4       ADD TASK RA TO REQUEST WORD
          MX7    CDHDN
          BX3    X7*X3       CLEAR RC, SF, AND CB FIELD
          LX4    CDRAS-17
          BX7    X3+X0       ADD RETURN CONTROL FLAG
          SA7    B4
          BX4    X4+X1       ADD RA AND FL
          MX0    -CDTSN
          BX3    -X0*X2      MASK TRANSACTION SEQUENCE NUMBER
          BX7    X3+X4
          SA1    CMPF        GET PAUSE FLAG
          SA7    B4+CDRAW
          NZ     X1,SSC2     IF PAUSE FLAG SET
          SA5    SSCC        GET OUTSTANDING REQUEST COUNT
          SX7    X5-MAXR
          NG     X7,SSC4     IF OUTSTANDING REQUESTS LESS THAN MAXR
 SSC1.5   SA2    STAT18      UPDATE NUMBER OF *SSC* REJECTS FOR *MAXR*
          SX6    B1+
          IX6    X2+X6
          SA6    A2+
 
*         PUT TASK INTO RECALL.
 
 SSC2     SX7    SSC3        RETURN ADDRESS
          SB5    B2+NUAPL    SUBCP RA
          SX3    B4-B5       SAVE PARAMETERS FOR RECALL
          SX2    B3
          LX3    18
          LX2    -18
          BX7    X3+X7
          BX7    X2+X7       (X7) = 18/ADDR,6/0,18/FWA OF PAR,18/SSC3
          EQ     TRCL2       PUT TASK INTO RECALL
 
*         RETURN FROM RECALL.
 
 SSC3     LX1    -18         RESET PARAMETERS
          SA3    CMPF        GET PAUSE FLAG
          SB4    X1          FWA OF PARAMETER BLOCK
          NZ     X3,TRCL     IF PAUSE STILL SET
          SA5    SSCC        GET OUTSTANDING REQUEST COUNT
          SX6    X5-MAXR
          SA2    B2+CDFN     GET REQUEST WORD
          LX1    -24
          SB3    X1          RETURN ADDRESS
          SB5    B2+NUAPL    TASK RA
          SX4    B5          TASK RA
          SB4    B4+B5
          PL     X6,SSC1.5   IF OUTSTANDING REQUESTS .GE. LIMIT
          IX6    X2+X4       ADD TASK TO REQUEST WORD
          MX0    CDHDN+CDRTN
          LX4    CDRAS-17
          SA1    B4          FWA OF PARAMETERS
          SA2    B4+CDRAW    WORD 2 OF PARAMETERS
          BX7    X0*X1       CLEAR RC, SF, AND CB FIELD
          SA7    A1
          MX0    CDRAN       CLEAR RA FIELD
          BX2    -X0*X2
          IX7    X2+X4       ADD NEW TASK RA
          SA7    A2
 
*         RE-ISSUE REQUEST TO SYSTEM CONTROL POINT.
 
 SSC4     SX7    X5+B1       INCREMENT OUTSTANDING REQUEST COUNTER
          SA7    A5
          RJ     SYS=        ISSUE REQUEST TO SYSTEM
          SX7    SSC5
          SA2    B4          FIRST WORD OF PARAMETER BLOCK
          LX2    59-CDCBS
          NG     X2,SSC6     IF OPERATION ALREADY COMPLETE
          MX0    1           SET STORAGE MOVE NOT ALLOWED
          SA1    B7
          SX2    B3          SET RECALL PARAMETER
          SX3    B4
          BX6    X0+X1
          LX2    -18
          LX3    18
          BX7    X2+X7       ADD FINAL RETURN ADDRESS
          SA6    B7
          BX7    X3+X7       ADD FWA OF PARAMETER BLOCK
          EQ     TRCL2       PLACE TASK INTO RECALL
 
*         PROCESS RETURN FROM RECALL.
 
 SSC5     LX1    -18
          SA2    X1          FIRST WORD OF PARAMETER BLOCK
          LX2    59-CDCBS
          MX0    -59         CLEAR STORAGE MOVE NOT ALLOWED FLAG
          PL     X2,TRCL     IF REQUEST NOT COMPLETE YET
          SA3    B7
          SB4    X1
          BX6    -X0*X3
          LX1    -24
          SB3    X1          RETURN ADDRESS
          SA6    B7
 SSC6     MX0    -CDESN      GET ERROR CODE
          BX6    -X0*X2
          SA5    SSCC        DECREMENT OUTSTANDING REQUEST COUNT
          SX7    X5-1
          SA2    B4+B1       GET FUNCTION CODE
          MX0    -CDFCN
          SX4    CDNT
          BX2    -X0*X2
          IX0    X2-X4
          SA3    B2+CB2C
          SX4    CDAT
          SA7    A5
          MX1    -59
          SA5    X3+CBCR     WORD CBCR OF C.B. SYSTEM AREA
          LX1    CDDM-59
          BX7    -X1*X5
          ZR     X0,SSC7     IF NORMAL TERMINATION
          IX0    X2-X4
          ZR     X0,SSC7     IF ABNORMAL TERMINATION
          BX7    X1+X5       SET CONNECTION FLAG
 SSC7     SA7    A5+
          NZ     X6,SSC8     IF ERROR OCCURRED
 SSC7.1   RJ     SSM         ISSUE SUBSYSTEM MESSAGE
 SSCA     EQU    SSC7.1      UPDATED BY ROUTINE *SSM*
*         JP     B3          (CDCS CONNECTION ESTABLISHED - RETURN)
 
*         PROCESS ERROR CONDITIONS.
 
 SSC8     MX4    -CDSFN
          SX3    SSNP        *CDCS* NOT AVAILABLE
          BX7    -X4*X6
          IX4    X3-X7
          AX6    CDSFN       RIGHT JUSTIFY REASON CODE
          SX3    CDER
          IX0    X3-X6       CHECK FATAL ERROR
          SX3    SSBZ        *CDCS* BUSY
          IX3    X3-X7
          ZR     X3,SSC10    IF *CDCS* BUSY
          SX3    CDIN        INVOKE FUNCTION CODE
          ZR     X4,SSC13.1  IF CDCS NOT PRESENT
          SX4    CDNF        NON-FATAL ERROR
          ZR     X0,SSC9     IF FATAL ERROR
          IX3    X2-X3
          IX4    X4-X6
          NZ     X3,SSC8.1   IF NOT INVOKE
          ZR     X4,SSC12    IF NON-FATAL ERROR ON INVOKE
 SSC8.1   RJ     SSM         ISSUE SUBSYSTEM MESSAGE
 SSCB     EQU    SSC8.1      UPDATED BY ROUTINE *SSM*
*         JP     B3          (CDCS CONNECTION ESTABLISHED - RETURN)
 
*         PROCESS TASK FATAL ERROR.
*
*         ENTRY  (B4) = FWA OF PARAMETER BLOCK.
*                (B2) = FWA OF TASK SYSTEM AREA.
 
 SSC9     SB3    TERR32      JOURNAL ERROR MESSAGE
          BX7    -X1*X5      CLEAR *CDCS* CONNECTION FLAG
          SA7    A5          WORD CBCR OF C.B. SYSTEM AREA
          SA1    B2+CB2C
          SA2    B4+CDBFW    GET FWA OF MESSAGE
          SX0    X1          COMMUNICATION BLOCK ADDRESS
          MX1    -CDBFN
          LX2    CDBFN-CDBFS-1
          BX5    -X1*X2
          SX6    12
          LX6    18
          SB5    B2+NUAPL    TASK RA
          SX5    X5+B5
          SA3    X5          FWA OF CDCS FATAL ERROR MESSAGE
          SB5    12          LENGTH OF MESSAGE
          SB6    B1+B1
          BX7    X3
          SA7    B2+NUAPL+TIMD-14  WORD 61 OF C.B. OF TASK
 SSC9.1   SA3    A3+B1
          ZR     X3,SSC9.2   IF END OF MESSAGE
          BX7    X3
          SA7    A7+B1       MOVE TO C.B.
          SB6    B6+B1
          LE     B6,B5,SSC9.1  IF NOT DONE MOVING MESSAGE
          EQ     SSC9.3      JOURNAL MESSAGE
 
 SSC9.2   BX7    X7-X7
          SA7    A7+B1       CLEAR NEXT WORD
          SB6    B6+B1
          LE     B6,B5,SSC9.2  IF NOT DONE CLEARING REMAINING WORDS
 SSC9.3   BX5    X5+X6       ADD MESSAGE LENGTH
          SB4    11B         ORIGIN CODE
          SB5    PJRNL       JOURNAL FILE
          EQ     JRNL        JOURNAL MESSAGE
 
*         UPDATE *CDCS* BUSY COUNTER.
 
 SSC10    SX7    B1          UPDATE *CDCS* BUSY COUNTER
          SA3    STAT19
          IX7    X3+X7
          SA7    A3
          EQ     SSC2        PUT TASK INTO RECALL
 
*         INVOKE FAILURE, CLEAR *CDCS* CONNECTION FLAG.
 
 SSC12    BX7    -X1*X5      CLEAR *CDCS* CONNECTION FLAG
          SA7    A5          WORD CBCR OF C.B. SYSTEM AREA
          EQ     TERR38      ABORT TASK WITH INVOKE FAILURE
 
*         CDCS ABORTED, TERMINATE TRANSACTION.
*         ENTRY  (B2) = FWA OF TASK SYSTEM AREA.
 
 SSC13    SA1    SSCC        DECREMENT OUTSTANDING REQUEST COUNT
          SX7    X1-1
          SA7    A1+
 SSC13.1  MX0    CBTON       MASK TERMINAL ORDINAL
          SA1    B2+CB2C     GET COMMUNICATION BLOCK ADDRESS
          MX7    60-CBCSN    CLEAR CDCS DATA MANAGER USAGE FLAG
          BX4    X0*X1
          ERRNZ  CBTOS-59    TERMINAL ORDINAL NOT LEFT JUSTIFIED
          SA2    X1+CBRTW
          LX7    CDDM-0
          LX2    59-CBRTS
          SA1    X1+CBCR
          BX7    X7*X1
          SA7    A1
.A        IFEQ   IPTAR,1
          PL     X2,TERR31   IF NOT A RECOVERABLE TRANSACTION
          MX7    SCTMN       SET TRANSACTION TO BE TERMINATED FLAG
          LX7    SCTMS-59
          SA1    B7+SCTMW
          BX7    X1+X7
          SA7    A1
          SX5    CSCD        CDCS DOWN *STEP*
          SX3    TSSC        RETURN ADDRESS
          RJ     WTS         WRITE TERMINATION *STEP*
.A        ELSE
          EQ     TERR31      ABORT TASK
.A        ENDIF
 
 SSCC     BSSZ   1           OUTSTANDING REQUEST COUNTER
 SSM      SPACE  4,15
**        SSM - SUBSYSTEM MESSAGE.
*
*         THIS ROUTINE UPDATES THE LOCATION OF *SSCA* AND *SSCB*
*         AND ISSUES THE DAYFILE MESSAGE WHEN *CDCS* CONNECTION
*         IS ESTABLISHED.
*
*         ENTRY  (B3) - RETURN ADDRESS IF CALLED BY *SSC*.
*
*         EXIT   (SSCA) AND (SSCB) UPDATED.
*                TO (B3) IF CALLED BY *SSC*.
*
*         USES   A - 1, 2, 3, 7.
*                X - 1, 2, 3, 4, 7.
*
*         MACRO  MESSAGE.
 
 
 SSM      SUBR               ENTRY/EXIT
          SA1    SSCA        CHECK FOR FIRST CALL
          SA2    SSMA
          SA3    SSMB
          IX4    X1-X2
          ZR     X4,SSM1     IF FIRST CALL
          BX7    X2
          SA7    A1
          SA7    SSCB
          EQ     SSMX        EXIT
 
 SSM1     BX7    X3
          SA7    A1
          SA7    SSCB
          MESSAGE  SSMC      * CDCS CONNECTION ESTABLISHED.*
          JP     B3          EXIT
 
 SSMA     RJ     SSM         FIRST CALL
 SSMB     JP     B3          NORMAL OPERATION
 SSMC     DATA   C* CDCS CONNECTION ESTABLISHED.*
 TOT      SPACE  4,10
**        TOT -  ENTER A REQUEST INTO THE TOTAL DATA MANAGER QUEUE.
*
*T        24/ 3LTOT,18/ FNC,18/ ADDR.
*
*                FNC = TOTAL DATA MANAGER FUNCTION CODE.
*                ADDR = PARAMETER LIST ADDRESS.
 
 
 TOT      TX3    0,VTOT,LWA  TOTAL DATA MANAGER INITIALIZATION FLAG
          SB4    X5+         ADDRESS OF PARAMETERS
          ZR     X3,TERR25   IF TOTAL DATA MANAGER NOT LOADED
          ZR     B4,TERR2    IF PARAMETER ADDRESS ZERO
          LX5    -18
          SB4    -B4
          SX0    X5          FUNCTION CODE
          SX6    X1+B4
          NG     X6,TERR2    IF PARAMETER ADDRESS OUT OF BOUNDS
          PL     B4,TERR2    IF PARAMETER ADDRESS OUT OF BOUNDS
          SX6    X5-100B
          PL     X6,TERR3    IF FUNCTION CODE GREATER THAN 6 BITS
 
 
**        BUILD A TOTAL INPUT QUEUE REQUEST OF THE FOLLOWING FORMAT.
*
*T        24/     TS,6/  SC,6/  FC,1/R,5/  SN,18/   ADDR
*
*         TS     TASK SEQUENCE NUMBER.
*         SC     TASK READ/WRITE SECUITY.
*         FC     FUNCTION CODE FOR TOTAL.
*         R      RECALL REQUEST BIT.
*         SN     SUB CONTROL POINT NUMBER.
*         ADDR   ADDRESS OF PARAMETER AREA.
 
          SX3    X0-DMCC
          ZR     X3,TERR3    IF TASK USED DATA MANAGER CEASE CODE
          LX0    24          FUNCTION CODE
          SX4    -B4         ADDRESS OF PARAMETER LIST
          SB3    TOT5        RETURN ADDRESS
 
*         ENTRY POINT FROM CEASE CALL FROM TASK.
 
 TOT1     MX7    -6
          LX7    36
          SA3    B2+TRID     TRANSACTION IDENTIFIER
          TX2    B7+CPAL,-VCPA  COMPUTE SUBCP NUMBER
          SA1    B2+CB2C     COMMUNICATION BLOCK WORD 2
          IX4    X4+X0       ADD FUNCTION CODE
          MX0    1           FORCE RECALL FOR TOTAL
          LX0    1+23
          BX7    -X7*X1      SECURITY LEVELS
          AX2    SCPAL
          BX4    X4+X0       ADD RECALL BIT
          LX2    18          SUB CONTROL POINT NUMBER
          BX4    X4+X2       ADD SUB CP NUMBER
          SA5    TDBAA       TOTAL STATUS WORD
          LX7    -6
          IX4    X4+X7       ADD SECURITY LEVELS
          LX3    59-23       POSITION TRANSACTION IDENTIFIER
          SX1    B1+
          BX4    X4+X3       ADD TRANSACTION IDENTIFIER
          SA3    B2+CB2C     COMMUNICATION BLOCK WORD 2
          SA3    X3+CBCR
          LX3    59-TOTDM
          NG     X3,TOT2     IF OK TO MAKE REQUEST
 
*         CHECK IF SUB CP CAN MAKE REQUEST.
 
          LX5    -18
          SB4    X5
          MX7    1
          BX7    X7+X3       SET TOTAL REQUESTS OK
          LX7    TOTDM-59
          SA7    A3+         ENABLE TOTAL REQUESTS FOR TRANSACTION
          ZR     B4,TOT8     IF CANNOT MAKE TOTAL CALLS NOW
          IX5    X5-X1
          LX5    18
 
*         ENTER REQUEST IN TOTAL INPUT QUEUE.
 
 TOT2     SB5    TDI         TOTAL INPUT QUEUE FET
          SA2    TOTLCK      READ QUEUE LOCK FLAG
          BX6    X4          TOTAL REQUEST
          SX4    B3          RETURN ADDRESS
          ZR     X2,TOT3     IF INPUT QUEUE IS NOT LOCKED
 
*         CHECK IF TASK CAN STILL MAKE TOTAL REQUEST.
 
          SA3    B2+DBNC     TRANSACTION DATA BASE ID
          SX3    X3
          SX1    X2          NAME OF LOCKED TOTAL DATA BASE
          BX3    X1-X3
          NZ     X3,TOT6     IF NO MATCH ON DATA BASE NAMES
          MX1    24
          BX2    X6-X2
          BX2    X1*X2
          NZ     X2,TOT6     IF NOT THE SAME SEQUENCE NUMBER
 TOT3     RJ     PDIF        PUT ENTRY INTO INPUT QUEUE
          SB3    X4
          ZR     X7,TOT6     IF THE INPUT QUEUE IS FULL
          MX1    -6
          SX7    B0
          SA7    DTIME       INSURE TOTAL WILL BE CALLED ON NEXT PASS
          LX6    -24
          BX1    -X1*X6
          SX1    X1-DMCC
          SX3    B1
          IX7    X5+X3       ADVANCE TOTAL CALL COUNT
          SA7    A5
          ZR     X1,TOT4     IF TASK CEASE REQUEST
          SA1    B2+TOTC
          IX6    X1+X3       TOTAL OUTSTANDING REQUEST COUNT
          SA6    A1
 TOT4     JP     B3          RETURN
 
 TOT5     ZR     X0,TSSC     IF RECALL NOT REQUESTED
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
*         TOTAL QUEUE IS FULL - PLACE THE TASK ON RECALL.
 
 TOT6     SX7    TOT7        RESTART ADDRESS FOR TASK RECALL
          AX0    23
          LX0    -2
          SX2    B3          RETURN ADDRESS AFTER TASK MAKES REQUEST
          BX7    X7+X0       RECALL STATUS OF REQUEST
          LX2    18
          BX7    X7+X2       SAVE RETURN ADDRESS
          SA6    B2+RCLA
          JP     TRCL2       PLACE TASK ON RECALL
 
*         RETRY TOTAL QUEUE ENTRY AFTER QUEUE WAS FULL.
 
 TOT7     AX1    18
          SA4    A1+B1       TOTAL INPUT QUEUE ENTRY
          SB3    X1+         RETURN ADDRESS
          SA5    TDBAA       TOTAL STATUS WORD
          AX1    40
          SX0    X1          RECALL STATUS
          LX0    23
          EQ     TOT2        TRY TO PLACE IN QUEUE AGAIN
 
*         PLACE TASK ON RECALL.
 
 TOT8     SX7    TOT9        RETURN ADDRESS FROM RECALL
          AX0    23
          BX6    X4          TOTAL INPUT QUEUE ENTRY
          LX0    -2
          SX2    B3          RETURN ADDRESS AFTER PLACING IN QUEUE
          IX7    X7+X0
          LX2    18
          BX7    X7+X2
          SA6    B2+RCLA     SAVE QUEUE ENTRY
          SA7    A6-B1
          JP     TRCL        PLACE TASK ON RECALL
 
*         RETURN FROM RECALL TRY TO MAKE REQUEST AGAIN.
 
 TOT9     SA5    TDBAA       TOTAL STATUS WORD
          SX3    B1
          LX5    -18
          SB4    X5
          ZR     B4,TRCL     IF STILL UNABLE TO ENTER QUEUE
          IX7    X5-X3
          LX7    18
          SA7    A5          UPDATE TOTAL STATUS
          EQ     TOT7        OK TO MAKE REQUESTS
 
*T  TDBAA 24/  ,18/    TNS,18/    TNO
*
*         TNS    NUMBER OF TASKS TO RUN WHICH MAKE TOTAL TASKS.
*         TNO    NUMBER OF OUTSTANDING TOTAL REQUESTS.
 
 TDBAA    VFD    24/0,18/TIMDM,18/0
 TOTLCK   CON    0           QUEUE ENTRY LOCK FLAG
 CTI      SPACE  4,60
***       CTI - CALL TRANSACTION INTERFACE.
*
*         THIS PROCESSOR PERFORMS THE FUNCTIONS RELATING TO TASK
*         CONTROL.  THE FORMAT OF THE REQUEST IS -
*
*T        24/    3LCTI,18/    FNC,18/    ADDR
*
*         FNC    REQUEST CODE.
*         ADDR   ADDRESS OF PARAMETER LIST.
*
*         FNC    REQUEST TYPE
*
*         0      SEND     - SEND MESSAGE TO TERMINAL.
*         1      JOURNL   - MAKE JOURNAL FILE ENTRY.
*         2      TRANCHK  - CHECK TRANSACTION ACTIVITY.
*         3      TARO     - TERMINAL ARGUMENT OPERATION.
*         4      CMDUMP   - DUMP TASK FIELD LENGTH.
*         5      DSDUMP   - CHANGE DEFAULT DUMP PARAMETERS.
*         6      TSIM     - RETURN TERMINAL STATUS.
*         7      KPOINT   - TERMINAL *K-DISPLAY* REQUEST.
*         8      KDIS     - *K-DISPLAY* REQUEST.
*         9      RESERVED
*         10     SUBMT    - SUBMIT BATCH TRANSACTION.
*         11     ITL      - INCREASE TASK TIME LIMIT.
*         12     IIO      - INCREASE TASK I/O LIMIT.
*         13     LOGT     - LOG OUT TRANSACTION TERMINAL.
*         14     LOADCB   - LOAD ADDITIONAL INPUT TO USER BUFFER.
*         15     RELSCB   - RELEASE SECONDARY C.B.-S.
*         16     SETCHT   - SET TERMINAL CHARACTER TYPE.
*         17     TERMDEF  - DEFINE TERMINAL CHARACTERISTICS.
*         18     GETABH   - GET APPLICATION BLOCK HEADER.
*         19     ARGERR   - ABORT TASK FOR SOFTWARE ERROR.
*         20     TPSTAT   - RETURN TELEPROCESSOR IDENTITY.
*         21     BEGIN    - TRANSFER C.B. TO TASK.
*         22     TSTAT    - OBTAIN *TAF* ENVIRONMENT STATUS FROM *CRF*.
*         23     WSTAT    - WRITE *TAF* ENVIRONMENT STATUS TO *CRF*.
*         24     ROUTE    - ROUTE FILE TO INPUT/OUTPUT QUEUES.
*
*         ENTRY  (X1) = TASK FL.
*                (X5) = SYSTEM REQUEST.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCP TABLE ENTRY.
*
*         EXIT   TO *TERR2*  IF ADDRESS OUT OF RANGE.
*                TO *TERR3*  IF INCORRECT FUNCTION CODE.
*                TO *TERR4*  IF SYSTEM REQUEST CALL ERROR.
*                TO *TERR7*  IF TERMINAL NOT FOUND.
*                TO *TERR9*  IF TOO MANY WORDS TO JOURNAL.
*                TO *TERR11* IF NOT VALIDATED FOR REQUEST.
*                TO *TERR13* IF INCORRECT RA(S)+1 CALL PARAMETER.
*                TO *TERR17* IF ERROR IN *SUBMIT* FILE.
*                TO *TERR34* IF INCORRECT *CMM* REQUEST.
*                TO *TSSC*   TO CONTINUE PROCESSING.
 
 
 CTI      SB4    X5+         ADDRESS OF PARAMETERS
          LX5    -18
          SB4    -B4
          SX0    X5+         FUNCTION CODE
          SX6    X1+B4
          LX0    -1
          SB6    B2+CB1C     START OF C.B. HEADER
          NG     X6,TERR2    PARAMETER LIST OUT OF BOUNDS
          SX6    X0-CTIJTL
          PL     X6,TERR3    IF INCORRECT FUNCTION CODE
          GT     B4,TERR2    ADDRESS WORD OUT OF BOUNDS
          SB3    X0+
          JP     B3+CTIJT    JUMP THRU TABLE
 
 CTIJT    PL     X0,CTS      SEND TERMINAL OUTPUT
          EQ     CTI1        JOURNAL REQUEST
          PL     X0,CTI5     TRANCHK
          JP     CTI7        PROCESS TERMINAL ARGUMENT OPERATION
          PL     X0,CTI19    CMDUMP REQUEST
          JP     CTI30       DSDUMP REQUEST
          PL     X0,CTI12    RETURN TERMINAL STATUS
          EQ     CTI31       CRASS TERMINAL K-DISPLAY COMMAND
          PL     X0,CTI40    K-DISPLAY REQUEST
          EQ     TERR3       NOT USED
          PL     X0,CTI41    SUBMIT BATCH JOB
          EQ     CTI43       INCREASE TIME LIMIT
          PL     X0,CTI45    INCREASE I/O LIMIT
          EQ     TLO         LOG OUT DIAL-IN TRANSACTION TERMINAL
          PL     X0,CTI46    READ MULTIPLE INPUT COMMUNICATION BLOCKS
          EQ     CTI51       RELEASE MULITIPLE COMMUNICATION BLOCKS
          PL     X0,CTA      SET CHARACTER INPUT TYPE
          EQ     CTD         DEFINE TERMINAL CHARACTERISTICS
          PL     X0,CTH      GET APPLICATION BLOCK HEADER
          EQ     TERR28      ABORT TASK DUE TO ARGUMENT ERROR
          PL     X0,CTI52    RETURN ACTIVE TELEPROCESSOR IDENTITY
          EQ     CTI53       PROCESS BEGIN REQUEST
          PL     X0,TFP      IF *TSTATUS* FUNCTION
          EQ     WFP         *WSTATUS* FUNCTION
          PL     X0,ROU      IF ROUTE REQUEST
          EQ     TERR3       NOT USED
 
 CTIJTL   EQU    *-CTIJT     LENGTH OF CTI JUMP TABLE
 
 
**        TASK JOURNAL REQUEST.
*
*T  ADDR  6/  ,18/      JN,18/      NUM,18/      MSG
*
*         MSG - FWA OF BLOCK TO BE JOURNALED
*         NUM - NUMBER OF WORDS TO WRITE TO JOURNAL FILE
*         JN  - JOURNAL FILE NUMBER
 
 
 CTI1     SA2    B5-B4       PARAMETER WORD
          SA4    B2+CB2C
          SB6    X2          FWA OF JOURNAL MESSAGE
          LX2    -18
          SX3    X2-MAXJL
          SX5    X2          NUMBER OF WORDS TO JOURNAL
          LX2    -18
          PL     X3,TERR9    IF TOO MANY WORDS REQUESTED TO JOURNAL
          SX7    X2          JOURNAL FILE NUMBER
          NG     X5,TERR2    IF NEGATIVE NUMBER OF WORDS TO JOURNAL
          NG     X7,TERR2    IF NEGATIVE JOURNAL FILE NUMBER
          SX0    X4          C.B. ADDRESS
          LX5    18
          NG     B6,TERR2    IF NEGATIVE JOURNAL MESSAGE ADDRESS
          SB5    PJRNL
          SX3    B6+NUAPL    START OF JOURNAL BLOCK
          SB6    -B6+B1
          BX5    X5+X3
          SX1    X1+B6       CHECK FOR MESSAGE OUTSIDE TASK FL
          SB4    B0
          NG     X1,TERR2    IF JOURNAL MESSAGE OUTSIDE TASK FL
          ZR     X7,CTI4     IF JOUR0
          SA4    B2+DBNC     D.B. FOR THIS TASK
          TA2    0,VEDT      EDT HEADER
          MX3    12
          SX4    X4+
          LX4    -12
 CTI2     BX6    X3*X2       DATA BASE NAME FROM EDT
          IX6    X6-X4
          ZR     X6,CTI3     IF MATCH FOUND
          SB3    X2
          SA2    X2          LINK TO NEXT EDT
          NZ     B3,CTI2     IF MORE EDT-S REMAIN TO BE SEARCHED
          EQ     TERR9       DATA BASE NOT FOUND
 
 CTI3     SA1    A2+B1       SECOND WORD OF EDT
          MX6    6
          BX6    X6*X1       NUMBER OF JOURNAL FILES FOR THIS DATA BASE
          LX6    6
          IX6    X6-X7
          NG     X6,TERR9    IF INCORRECT JOURNAL FILE NUMBER
          LX1    -18
          SB4    X1-JFETL
          SX2    JFETL
          IX1    X2*X7
          SB5    X1+B4
          SB4    0
 CTI4     SB3    TSSC        RETURN ADDRESS
          EQ     JRNL        JOURNAL ENTRY
 
 
**        CHECK FOR TASK CHAIN IN SYSTEM
*
*T  ADDR  18/   ,24/       SEQ,18/    STAT
*
*         SEQ  - SEQUENCE NUMBER OF TRANSACTION
*         STAT - SET STAT TO ZERO IF TRANSACTION NOT IN SYSTEM
 
 
 CTI5     SA2    B5-B4       PARAMETER WORD
          BX6    X6-X6
          MX5    -24
          SB3    X2          STATUS WORD ADDRESS
          SB3    -B3
          SX7    X1+B3
          PL     B3,TERR2    IF STATUS WORD OUT OF BOUNDS
          SB3    B5-B3       STATUS WORD ABSOLUTE ADDRESS
          SB5    B0
          NG     X7,TERR2    IF STATUS WORD OUT OF BOUNDS
          SA6    B3+         CLEAR STATUS WORD
          LX2    -18
          BX0    -X5*X2      SEQUENCE NUMBER TO CHECK FOR
 CTI6     RJ     SCB         GET NEXT RESERVED COMMUNICATION BLOCK
          ZR     B5,TSSC     IF END OF RESERVED C.B.S
          SA2    B5
          LX2    -18
          BX3    -X5*X2      SEQUENCE NUMBER
          BX2    X3-X0
          NZ     X2,CTI6     IF NO MATCH ON SEQUENCE NUMBER
          SX6    B1
          SA6    A6          SET TASKS STATUS WORD TO 1
          JP     TSSC        ENTER SWITCHING LOOP
 
 
**        REQUEST CODE 3 - TERMINAL ARGUMENT OPERATION.
*
*T ADDR   42/  TERMINAL NAME,18/ RETURN ADDRESS
*T        30/  VALUE,30/  MASK
*
*         TERMINAL NAME IDENTIFIES TERMINAL TO BE OPERATED UPON.
*           IF ZERO, ORIGINATING TERMINAL IS ASSUMED.
*         RETURN ADDRESS = LOCATION TO PLACE RESULT OF OPERATOIN
*           (IN ADDITION TO TERMINAL TABLE). ZERO IF NO RETURN DESIRED.
*         VALUE= A VALUE TO BE USED TO ALTER TERMINAL ARGUMENTS.
*         MASK= A 24 BIT MASK.
*
*         OPERATION -
*         THE *USER ARGUMENT* AREA (24 BITS IN EACH TERMINAL TABLE
*         ENTRY) IS OPERATED UPON AS FOLLOWS -
*         RETURN=USER ARG=(USER ARG.AND.MASK).XOR.VALUE
*
*         NON-SYSTEM TASKS MAY ONLY ALTER TERMINAL ARGUMENTS FOR THOSE
*         TERMINALS THAT SHARE THE ORIGINATING TERMINAL DATA BASE.
 
 
 CTI7     SA4    B5-B4       READ TERMINAL NAME
          SB3    X1+B4       CHECK ALL WORDS IN BOUNDS
          MX0    42
          SX5    X4          RETURN ADDRESS
          EQ     B3,B1,TERR2 IF SECOND WORD AT FL
          SA2    B6+B1       TST ENTRY FOR ORIGINATING TERMINAL
          BX4    X0*X4       TERMINAL NAME
          LX2    -18
          IX7    X5-X1
          SA1    X2          READ ORIGINATING TERMINAL TST ENTRY
          MX0    -24
          ZR     X5,CTI8     IF NO RETURN DESIRED
          PL     X7,TERR2    IF RETURN ADDRESS OUT OF BOUNDS
 CTI8     ZR     X4,CTI10    IF TERMINAL NAME NOT GIVEN
 
*         SEARCH FOR GIVEN TERMINAL NAME.
 
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          ZR     X3,TERR7    IF TERMINAL NOT FOUND
          SA1    A3-1        READ TST ENTRY
 
*         UPDATE USER ARGUMENTS.
 
 CTI10    SA2    B2+DBNC     DATA BASE OF ORIGINATING TERMINAL
          MX6    -12
          LX1    -24
          SX4    X2
          BX6    -X6*X1      DATA BASE OF TERMINAL BEING OPERATED ON
          LX1    24
          BX4    X4-X6
          ZR     X4,CTI11    IF SAME DATA BASE
          NG     X2,CTI11    IF TERMINAL VALIDATED FOR ALL DATA BASES
          SX2    X2-2RSY
          NZ     X2,TERR11   IF NOT VALIDATED FOR SYSTEM DATA BASE
 CTI11    SA4    A4+B1       READ VALUE AND MASK
          BX3    -X0*X1      EXTRACT USER ARGUMENTS
          BX6    -X0*X4      EXTRACT MASK
          LX4    30          EXTRACT VALUE
          BX7    X0*X1       REMOVE OLD USER ARGUMENT
          BX4    -X0*X4
          BX1    X6*X3       MASK ARGUMENTS
          BX6    X4-X1       INSERT VALUE
          IX7    X7+X6       REPLACE USER ARGUMENTS
          SA7    A1
          ZR     X5,TSSC     IF NO RETURN DESIRED
          SA6    B5+X5       RETURN UPDATED USER ARGUMENTS
          JP     TSSC
 
 
**        REQUEST CODE 6 - RETURN TERMINAL STATUS.
*
*T ADDR   6/ ,6/ CODE,18/  LIST,12/  LENG,18/  RETURN
*T        60/  MASK
*T        60/  CRIT
*         CODE   =0 IF DATA BASE NAME FIELD IS TO BE SEARCHED.
*                =1 IF USER ARGUMENT FIELD IS TO BE SEARCHED.
*                =2 IF COMMUNICATION LINE FIELD IS TO BE SEARCHED.
*                =3 IF TERMINAL NAME FIELD IS TO BE SEARCHED.
*         CRIT   CRITERION VALUE FOR SEARCH.
*         LENG   NUMBER OF WORDS THAT LIST CAN HOLD.
*         LIST   FWA OF LIST OF RETURNED TERMINAL ENTRIES. IF ZERO,
*                NO LIST IS RETURNED, BUT THE NUMBER OF FOUND ENTRIES
*                WILL BE RETURNED AS SPECIFIED BELOW.
*         MASK   A VALUE TAKEN AS A BINARY MASK.
*         RETURN ADDRESS IN WHICH TO PLACE THE NUMBER OF ENTRIES FOUND.
*
*         OPERATION -
*         THE FIELD SPECIFIED BY *CODE* IS EXAMINED IN EACH TERMINAL
*         TABLE ENTRY BY TAKING THE LOGICAL PRODUCT OF THE FIELD AND
*         *MASK* AND THEN TAKING THE LOGICAL DIFFERENCE OF THIS PRODUCT
*         AND *CRIT*. IF THIS RESULT IS ZERO, THE TERMINAL ENTRY IS
*         PLACED INTO *LIST* AND THE NUMBER OF FOUND ENTRIES IS
*         INCREMENTED.  IF THE TASK DATA BASE IS NOT THE SAME AS
*         THE ONE BEING INTEROGATED, THEN THE REQUEST WILL BE IGNORED.
*         FURTHER, IF THE MASK, I. E. THE DATA BASE, OR THE CRITERION
*         IS ZERO, THIS IS CONSIDERED AN AUTOMATIC FAILURE CASE, AND
*         THE REQUEST IS IGNORED.
 
 
*         DIAGNOSE CALL ERRORS.
 
 CTI12    SX6    X1+B4       CHECK ALL ARGUMENT WORDS IN BOUNDS
          SA2    B5-B4       READ (ADDR)
          SX6    X6-3
          MX7    -6
          NG     X6,TERR2    IF ARGUMENTS EXTEND PAST FL
          SX6    X2          SAVE RETURN ADDRESS
          LX2    -48
          NG     X6,TERR2    IF RETURN ADDRESS OUT OF BOUNDS
          BX4    -X7*X2
          SA6    CTIB
          IX6    X6-X1
          LX2    18
          PL     X6,TERR2    IF RETURN ADDRESS OUT OF BOUNDS
          SB3    X4-CTIAL
          SX4    X2          LIST ADDRESS
          PL     B3,TERR4    IF CODE .GT. 3
          LX2    12
          NG     X4,TERR2    IF LIST ADDRESS OUT OF BOUNDS
          BX7    X7-X7
          ZR     X4,CTI13    IF NO LIST DESIRED
          IX6    X4-X1
          MX7    -12
          PL     X6,TERR2    IF LIST FWA OUT OF BOUNDS
          BX7    -X7*X2      LENGTH
          IX7    X4+X7       LWA+1
          IX6    X1-X7
          NG     X6,TERR2    IF LIST EXTENDS PAST FL
 
*         PREPARE FOR TST SEARCH.
 
 CTI13    SA1    CTIA+4+B3   READ SEARCH INFORMATION
          SA5    A2+B1       READ MASK
          UX0,B6 X1          B6= SHIFT TO RIGHT JUSTIFY FIELD, X0= WORD
          TB3    0,VTST      SET TST FWA ENTRY
          TB4    0,VTST,LWA  SET TST LWA
          SA2    A5+1        READ CRITERION
          SX4    X4+B5       BIAS ADDRESSES BY TASK RA
          SX7    X7+B5
          ZR     X2,CTI18    IF MASK .EQ. ZERO
          SA3    B2+DBNC     TASK DATA BASE NAME
          ZR     X5,CTI18    IF CRITERION .EQ. ZERO
 
*         SEARCH TST.
 
 CTI14    SB3    B3+TSTLLE   ADVANCE TST ENTRY ADDRESS
          GT     B3,B4,CTI18 IF END OF TST
          SA1    B3+X0       READ TST ENTRY WORD
          AX1    X1,B6       RIGHT JUSTIFY SEARCH FIELD
          BX6    X5*X1       MASK FIELD
          BX6    X6-X2       COMPARE
          NZ     X6,CTI14    IF NOT MATCH
 
*         MOVE TST ENTRY INTO LIST.
 
          SX6    X4+TSTLLE   ADVANCE LIST ADDRESS
          IX6    X7-X6
          SA1    B3          ENTER TERMINAL ENTRY INTO LIST
          NG     X6,CTI17    IF LIST FULL
          MX6    -12
          AX1    24
          BX6    -X6*X1
          LX1    24
          BX6    X3-X6
          ZR     X6,CTI15    IF SAME DATA BASE
          SX6    X3-2RSY
          NZ     X6,CTI14    IF NOT VALIDATED FOR SYSTEM DATA BASE
 CTI15    BX6    X1          RETURN TST ENTRY
          SA6    X4
          SX4    -TSTLLE+1
 CTI16    SA1    A1+B1       READ NEXT WORD FROM TST
          SX4    X4+B1
          BX6    X1
          SA6    A6+B1       ENTER TST ENTRY INTO LIST
          NZ     X4,CTI16    IF NOT END OF TST ENTRY
          SX4    A6+B1       NEXT LIST ADDRESS AVAILABLE
          IX6    X7-X4
          NZ     X6,CTI14    IF NOT END OF LIST
          ZR     X3,CTI18    IF NO COUNT DESIRED
 
*         RETURN NUMBER OF FOUND ENTRIES.
 
 CTI17    SX6    B5
          IX6    X6-X7
          NZ     X6,CTI18    IF COUNT NOT DESIRED
          SX4    X4+TSTLLE   UPDATE TABLE LOCATION
          EQ     CTI14       CONTINUE COUNTING
 CTI18    SA1    A2-2        COMPUTE NUMBER OF ENTRIES FOUND
          SA3    CTIB        RESTORE RETURN ADDRESS
          SX2    TSTLLE
          LX1    -30
          SX1    X1+B5
          IX6    X4-X1       NUMBER OF WORDS ENTERED
          PX6    X6
          NX6    X6          COMPUTE NUMBER OF ENTRIES
          PX2    X2
          NX2    X2
          FX7    X6/X2
          UX7    X7,B3
          LX7    X7,B3
          SA7    B5+X3       STORE NUMBER OF ENTRIES RETURNED
          JP     TSSC
 
 CTIA     BSS    0           TERMINAL TABLE SEARCH INFORMATION
          LOC    0
          VFD    12/2000B+24,48/0 CODE 0 - DATA BASE NAME
          VFD    12/2000B+00,48/0 CODE 1 - USER ARGUMENTS
          VFD    12/2000B+42,48/0 CODE 2 - COMMUNICATION LINE
          VFD    12/2000B+18,48/1 CODE 3 - TERMINAL NAME
 CTIAL    BSS    0
          LOC    *O
 
CTIB      CON    1           STORAGE FOR RETURN ADDRESS
 
**        CMDUMP
*
*T  ADDR   1/E,1/D,1/A,1/B,8/ ,18/     LWA,12/ ,18/     FWA
*T, ADDR+1 42/      QD,18/      OQ
*T, ADDR+2 12/ ,18/     AD,26/ ,4/ NF
*T, ADDR+N 24/     FN,36/
*
*         E      DUMP EXCHANGE PACKAGE.
*         D      DUMP DATA MANAGER BUFFERS.
*         A      USE DEFAULT EXCHANGE PACKAGE PARAMETER.
*         B      USE DEFAULT DATA MANAGER PARAMETER.
*         LWA    LAST WORD ADDRESS OF TASK TO DUMP.
*         FWA    FIRST WORD ADDRESS OF TASK TO DUMP.
*         QD     QUEUE DESTINATION.
*         OQ     OUTPUT QUEUE.
*         AD     ADDRESS USER CALLED FROM.
*         NF     NUMBER OF SPECIFIED FILES.
*         FN     SPECIFIED FILE NAME.
*
*         TASK WILL BE PUT INTO RECALL IF LAST *DSP* REQUEST IS NOT
*         COMPLETE.
 
 
 CTI19    SA3    TDSP        CHECK *DSP* INTERLOCK
          SX7    SRTN4.1
          NZ     X3,TRCL2    IF A ROUTE IS IN PROGRESS
          SA3    B6+B1
          SA2    B5-B4       FIRST PARAMETER WORD
          SB3    CTI28       EXIT ADDRESS
          SB4    2
          SA4    X3+3        DSDUMP CONTROL
          NG     X4,CTI20    IF PRIOR VALID *DSDUMP* PARAMETERS PRESENT
          SA4    DTSE        SYSTEM DEFAULT VALUES
 
*         ASSEMBLE TASK DUMP CONTROL WORDS
*         (B3) = RETURN ADDRESS
*         (B4) = LOCTATION TO STORE CONTROL WORDS
*         (A2/X2) = 1ST PARAMETER WORD
*         (A4/X4) = 1ST DEFAULT CONTROL WORD
 
 CTI20    MX5    2
          SX7    X2          FWA
          LX2    -30
          SX0    X2          LWA
          LX2    30-1
          PL     X7,CTI21    IF SPECIFIED FWA IS TO BE USED
          SX7    X4          DEFAULT FWA
 CTI21    LX4    -30
          PL     X0,CTI23    IF SPECIFIED LWA IS TO BE USED
          SX0    X4          DEFAULT LWA
 CTI23    IX6    X7-X0
          NG     X6,CTI24    IF FWA .LT. LWA
          SX0    X7
 CTI24    SX1    DSMNFL
          IX6    X0-X7
          ZR     X6,CTI25    IF NO FL DUMP SELECTED
          IX6    X6-X1
          PL     X6,CTI25    IF LWA-FWA .GE. DSMNFL
          SX0    X4          USE DEFAULT LWA
          LX4    30
          SX7    X4+         USE DEFAULT FWA
 CTI25    LX5    -3
          BX6    X5*X2       DEFAULT EP AND DB FLAGS
          LX5    2
          LX0    30
          BX2    X5*X2       EP AND DB FIELD
          LX6    2
          IX7    X7+X0       FWA + LWA
          LX4    30
          BX4    X6*X4       DEFAULT EP AND DB VALUES
          MX0    1
          IX5    X4+X2       SPECIFIED AND DEFAULT VALUES
          BX7    X7+X0
          SA4    A4+B1
          SA2    A2+B1
          MX6    42
          BX1    X6*X2
          SX0    X2
          PL     X2,CTI26    IF SPECIFIED QD IS TO BE USED
          MX0    1           FORCE DEFAULT FOR BOTH PARAMETERS
 CTI26    BX7    X7+X5       FWA + LWA + DB + EP
          MX5    -12
          SA7    B4+         DUMP CONTROL WORD 1
          PL     X0,CTI27    IF SPECIFIED OUTPUT QUEUE IS TO BE USED
          BX1    X6*X4       DEFAULT QUEUE DESTINATION
          BX0    -X5*X4
 CTI27    SX6    X0-CTICL
          PL     X6,CTI29    IF ERROR IN VALUE
          NG     X0,CTI29    IF ERROR IN VALUE
          SA5    X0+CTIC     CONVERT OUTPUT QUEUE TO SYSTEM FORMAT
          BX6    X1+X5       QD + OQ
          SA6    A7+B1       DUMP CONTROL WORD 2
          JP     B3          EXIT - CONTROL WORDS BUILT
 
 CTI28    SA5    A2+B1       GET ADDRESS CALLED FROM
          MX2    -4
          SB3    A7
          SX7    A5          ADDRESS - 1 OF FILE NAME LIST
          BX2    -X2*X5      FILE COUNT
          LX5    -30
          LX2    18
          SX5    X5          CALLED FROM ADDRESS
          SX0    X3          COMMUNICATION BLOCK ADDRESS
          BX5    X5+X2
          LX5    24
          BX7    X7+X5
          SA7    DTSG
          SA1    LOVC
          RJ     LOVL        DUMP THE TASK
          EQ     TSSC        ENTER SWITCHING LOOP
 
 CTI29    BX0    -X5*X4      IF ERROR - USE DEFAULT OUTPUT QUEUE VALUE
          EQ     CTI27       RESUME PROCESSING
 
 CTIC     BSS    0           OUTPUT QUEUE EQUIVELENCE TABLE
          LOC    0
          VFD    42/0,3/0,3/BCOT,12/*
          VFD    42/0,3/0,3/EIOT,12/*
          VFD    42/0,3/0,3/BCOT,12/*
 CTICL    BSS    0
          LOC    *O
 
**        DSDUMP
*
*T  ADDR   1/E,1/D,1/A,1/B,8/ ,18/     LWA,12/ ,18/     FWA
*T, ADDR+1 42/      QD,18/      OQ
*
*         E      DUMP EXCHANGE PACKAGE.
*         D      DUMP DATA MANAGER BUFFERS.
*         A      USE DEFAULT EXCHANGE PACKAGE PARAMETER.
*         B      USE DEFAULT DATA MANAGER PARAMETER.
*         LWA    LAST WORD ADDRESS OF TASK TO DUMP.
*         FWA    FIRST WORD ADDRESS OF TASK TO DUMP.
*         QD     QUEUE DESTINATION.
*         OQ     OUTPUT QUEUE.
 
 
 CTI30    SB3    TSSC        RETURN ADDRESS
          SA3    B6+B1
          SA2    B5-B4       FIRST PARAMETER WORD
          SB4    X3+3        PLACE ASSEMBLED CONTROL WORDS INTO C.B.
          SA4    DTSE        SYSTEM DEFAULT CMDUMP PARAMETER WORDS
          EQ     CTI20       ASSEMBLE CONTROL WORDS
 
 
**        TERMINAL K-DISPLAY COMMAND.
*
*T ADDR   60/  FIRST WORD OF A K-DISPLAY COMMAND.
 
 
 CTI31    SB3    B5-B4       PARAMETER LIST ADDRESS
          SB5    X1+B5       TASK FL
          SX7    B3+
          MX3    1
          SB6    -B1         INDICATE SEARCH FOR DUMP
          SA7    PCMDC
          SX2    4           CHARACTER COUNTER
          SX4    8           WORD COUNTER
          SX0    PCMDA       COMMAND BUFFER
          SX6    B0+
 CTI32    PL     X3,CTI33    IF NOT THE END OF A WORD
          ZR     X4,TERR13   IF PARAMETER LIST LENGTH .GT. 8 WORDS
          EQ     B3,B5,TERR13  IF PARAMETER LIST EXTENDS BEYOND FL
          SA5    B3+         LOAD A PARAMETER WORD
          BX7    X5
          SB3    B3+B1
          SA7    X0+         SAVE COMMAND IN BUFFER
          SX4    X4-1        DECREMENT WORD COUNTER
          SX0    X0+1
 CTI33    LX5    6
          MX1    -6
          BX7    -X1*X5      EXTRACT A CHARACTER
          LX3    6           MOVE CHARACTER COUNTER
          SB4    X7-1R
          ZR     B4,CTI32    IF CHARACTER IS A SPACE
          ZR     B6,CTI35    IF SEARCHING FOR 5TH NON-BLANK CHARACTER
 
*         TEST FOR A TERMINATOR.
 
 CTI34    SX1    X7-1R)
          SB4    X7-1R.
          ZR     X1,CTI36    IF TERMINATOR = *)*
          ZR     B4,CTI36    IF TERMINATOR = *.*
          GE     B6,B1,CTI32 IF SEARCHING FOR A TERMINATOR
 
*         SEARCH FOR *DUMP*.
 
          LX6    6
          BX6    X6+X7       SAVE CHARACTER TO TEST LATER
          SX2    X2-1        DECREMENT CHARACTER COUNT FOR *DUMP*
          NZ     X2,CTI32    IF 4 NON-BLANK CHARACTERS NOT FOUND
          SA1    CTIG        4RDUMP
          SB6    B1+         DO NOT SEARCH FOR 5TH NON-BLANK CHARACTER
          BX6    X6-X1
          NZ     X6,CTI32    IF PARAMETER IS NOT *DUMP*
          SB6    B0
          EQ     CTI32       SEARCH FOR FIFTH NON-BLANK CHARACTER
 
*         TEST 5TH NON-BLANK CHARACTER.
 
 CTI35    SB6    1           INDICATE SEARCH FOR A TERMINATOR
          SB4    X7-1R9
          SX6    X7-1R*
 
*         IF THE 5TH NON-BLANK CHARACTER IS ALPHANUMERIC, DISPLAY
*         ZERO OR +*+, THE COMMAND IS NOT *DUMP*.
 
          LT     B4,B1,CTI32 IF ALPHANUMERIC, COMMAND NOT *DUMP*
          ZR     X6,CTI32    IF CHARACTER = +*+, COMMAND NOT *DUMP*
          SB6    2           INDICATE *DUMP* COMMAND IS RECOGNIZED
          EQ     CTI34       SEARCH FOR TERMINATOR
 
 CTI36    LE     B6,B1,CTI38 IF PARAMETER IS NOT *DUMP*
          SA1    GTDL        GLOBAL TASK DUMP LIMIT
          NZ     X1,CTI37    IF *GTDL* VALUE IS NOT ZERO
          MX6    1
          SA6    A1          SET DUMP FLAG
          MESSAGE  CTIE,0    * GLOBAL TASK DUMP LIMIT EXHAUSTED.*
          EQ     TSSC        EXIT, DO NOT PROCESS DUMP
 
 CTI37    NG     X1,TSSC     IF NOT FIRST TO REACH LIMIT
 
*         IF GLOBAL TASK DUMP LIMIT IS GREATER THAN ZERO.
 
          SX6    B1+
          IX6    X1-X6       DECREMENT *GTDL*
          SA6    A1          REPLACE *GTDL*
          EQ     CTI39       DO NOT CHECK TASK ORIGIN
 
 CTI38    RJ     VTO         CHECK TASK ORIGIN
          NG     X6,TERR11   IF TASK NOT VALIDATED FOR REQUEST
 
*         SAVE TERMINAL ORDINAL, B2, AND B7.
 
 CTI39    SX7    B2
          SA3    B2+CB2C     C.B. SYSTEM HEADER WORD 2
          SX6    B7
          LX3    18
          LX7    18
          SX3    X3          TERMINAL ORDINAL
          BX7    X7+X6
          LX3    36
          BX7    X7+X3
          SA5    PCMDA       FIRST WORD OF COMMAND
          SA7    PCMDB       SAVE TERMINAL ORDINAL, B2, AND B7
          EQ     PCMD        EXIT, PROCESS COMMAND
 
CTIE      DATA   C/ GLOBAL TASK DUMP LIMIT EXHAUSTED./
CTIG      DATA   4RDUMP
 
 
**        SET K-DISPLAY TO RUN FROM A TASK
*
*T  ADDR  60/    KCW
*
*         KCW    K-DISPLAY CONTROL WORD
 
 
 CTI40    SA1    KCTRL1      K-DISPLAY CONTROL WORD
          RJ     VTO         CHECK TASK ORIGIN
          NG     X6,TERR11   IF TASK NOT VALIDATED FOR REQUEST
          SA2    KDISB
          PL     X2,CTI40.1  IF TASK ALREADY EXECUTING
          SA3    B7+2
          MX0    12
          BX3    X0*X3       TASK LIBRARY DIRECTORY INDEX
          MX0    42
          LX3    12
          TA4    X3-1,VTLD   TASK NAME
          SA3    KDISE
          BX4    X0*X4
          BX6    X3-X4
          NZ     X6,TERR11   IF TASK NOT REQUESTED
          EQ     CTI40.2     CLEAR *KDISB* BITS
 
 CTI40.1  SB6    X2
          SA3    B2+CB2C     CURRENT TASK C.B. WORD TWO
          MX6    -42
          SB3    X3
          NE     B3,B6,TERR11  IF SCREEN NOT ASSIGNED TO THIS TASK
          LX6    35-59       CLEAR MESSAGE ADDRESS
          BX2    -X6*X2
 CTI40.2  MX6    2
          BX7    -X6*X2      CLEAR *TASK REQUESTED*+*INPUT READY* BITS
          SX2    B5-B4       START OF TASK K-DISPLAY BUFFER
          MX6    42
          BX6    X6*X1
          SX3    -B4         FWA OF MESSAGE
          BX6    X6+X2
          LX3    35-17
          BX7    X3+X7       ADD FWA OF MESSAGE
          SA6    A1
          SA7    A2
          SX6    B7          SAVE SUBCP ADDRESS
          SA6    KDISG
          SA1    ITIME
          BX6    X1
          SA6    KDISF       SAVE TIME OF THE REQUEST
          CONSOLE KCTRL1     DEFINE NEW K-DISPLAY
          MESSAGE ZWORD,2    ZERO OUT REQUEST K-DISPLAY MESSAGE
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 
**        SUBMIT JOB TO BATCH
*
*T  ADDR  6/  ,18/PRU,12/  ,24/BYTE COUNT
*         CONTENTS OF ADDR IS THE FIRST CONTROL WORD FOR
*         THE OUTPUT JOB DATA.
*         PRU - NUMBER OF 60 BIT WORDS IN EACH PRU ON DEVICE
*         BYTE COUNT - NUMBER OF DATA BYTES IN THIS PRU
*         THE BLOCK OF INFORMATION STARTING AT ADDR IS SET
*         UP IN CONTROL WORD FORMAT
*
*         TASK WILL BE PUT INTO RECALL IF LAST *DSP* REQUEST IS NOT
*         COMPLETE.
 
 
 CTI41    SA2    TDSP        CHECK INTERLOCK
          SX7    SRTN4.1     RECALL RETURN ADDRESS
          NZ     X2,TRCL2    IF PREVIOUS REQUEST NOT COMPLETED
          SB4    -B4
          SX3    100B        PRU SIZE
          SB3    B4
          SX7    17B         END OF JOB FILE FLAG
          SX0    5           NUMBER OF BYTES PER CM WORD
          SA2    B5+B4       FETCH FIRST HEADER WORD
          SX2    X2
          ZR     X2,TERR17   IF FIRST HEADER IS BAD
 
 CTI42    SA2    B5+B4       LOAD NEXT CONTROL WORD
          MX6    36
          BX4    X6*X2       GET TOP 36 BITS OF HEADER WORD
          SB6    B7          SAVE B7
          LX4    -36
          BX6    -X6*X2      USERS NUMBER OF BYTES OF DATA
          IX4    X4-X3       CHECK FOR CORRECT CONTENTS OF HEADER WORD
          BX2    X6
          NZ     X4,TERR17   IF BAD HEADER WORD
          LX4    X0          NUMBER OF BYTES PER CM WORD
          IX6    X6/X4       NUMBER OF CM WORDS OF DATA
          SB7    B6          RESTORE B7
          IX4    X6*X0
          SB6    X6+B1       NUMBER OF DATA WORDS + HEADER WORD
          IX2    X2-X4
          SB4    B6+B4
          MX4    -48
          NZ     X2,TERR17   IF NUMBER OF BYTES NOT A MULTIPLE OF 5
          IX6    X3-X6
          SB6    X1          FIELD LENGTH
          NG     X6,TERR17   IF LENGTH OF DATA GREATER THAN 1 PRU
          SB6    B4-B6
          SA2    B5+B4       TRAILER CONTROL WORD
          PL     B6,TERR17   IF DATA GOES BEYOND LWA
          BX4    -X4*X2
          AX2    48
          NZ     X4,TERR17   IF BAD TRAILER WORD
          SB4    B4+1        ADD TRAILER WORD TO CURRENT POSITION
          NG     X2,TERR17   IF INCORRECT LEVEL NUMBER
          IX6    X2-X7
          NG     X6,CTI42    IF LEVEL NUMBER IS IN THE RANGE (0-16B)
          NZ     X6,TERR17   IF BAD CONTROL CHARACTER IN TRAILER WORD
 
          SX7    B5+B3
          SB3    B4-B3       FIND LENGTH OF JOB
          SX6    A2+B1       SET END OF JOB + 1
          SB4    X6
          NG     B3,TERR17   IF LESS THAN FIRST
          SA3    SF+1        FETCH FIRST POINTER
          MX0    42
          BX3    X0*X3
          SA4    SF+4        FETCH LIMIT POINTER
          BX7    X3+X7       INSERT BEGGINING ADDRESS OF JOB
          SX6    X6+B1       CALCULATE NEW LIMIT POINTER
          SA7    A3          STORE FIRST POINTER
          BX4    X0*X4
          BX6    X4+X6       INSERT NEW LIMIT POINTER
          SA6    A4          STORE LIMIT
          REWIND SF,R
          SX6    B4+
          SA6    SF+2        RESTORE IN
          WRITECW SF,R
          MX0    42
          SA3    SF+1        FETCH FIRST POINTER
          SX6    OBUF
          SA6    A3+B1       RESTORE IN POINTER
          SA6    A6+B1       RESTORE OUT POINTER
          BX3    X0*X3
          SA4    A6+B1       FETCH LIMIT POINTER
          BX6    X3+X6
          SX7    OBUF+OBUFL
          BX4    X0*X4
          SA6    A3          RESTORE FIRST POINTER
          BX7    X4+X7
          SA7    A4          RESTORE LIMIT POINTER
          SA1    SF
          BX7    X0*X1
          SA7    TDSP        SET FILE NAME
          SA1    CTIF        SET PARAMETERS
          SA3    A1+B1       STATUS PROCESSOR INFORMATION
          SA4    A3+B1       ERROR MESSAGE - *K SUBMIT.*
          EQ     RFQ         ROUTE FILE TO QUEUE
 
 
 CTIF     VFD    12/,12/,12/0LNO,3/,1/0,2/,18/FRER+FRDC+FRTI
          VFD    6/,18/TERR17,18/TSSC,18/RFQ4
          DATA   L*K SUBMIT.*
 
 
 
 
**        ITL - INCREASE TIME LIMIT.
*
*T  ADDR  48/  ,12/TL
*         TL     NEW TIME LIMIT IN XJ TIME UNITS
*         EACH CALL TO THIS FUNCTION DECREMENTS THE CPU
*         PRIORITY OF THE TASK UNTIL ZERO IS REACHED. SUBSEQUENT
*         CALLS DO NOT AFFECT THE CPU PRIORITY.
 
 
 CTI43    SA3    B2+TSAC     GET ACCUMULATED TIME
          SA2    B2+CB1C     GET C.B. HEADER
          MX6    -12
          BX3    -X6*X3      MASK OFF TIME COUNT
          SA5    B5-B4       GET NEW TIME LIMIT
          UX2,B4 X2          CPU PRIORITY TO B4
          BX7    -X6*X5      GET 12 BIT NEW TIME LIMIT
          LX7    30          POSITION TIME LIMIT
          IX7    X7+X3       COMBINE LIMIT AND COUNT
          SB4    B4-B1       DECREMENT CPU PRIORITY
          ZR     B4,CTI44    IF CPU PRIORITY AT ONE
          PX6    B4,X2
          SA6    A2          SET NEW CPU PRIORITY
 CTI44    SA7    B2+TSAC     STORE NEW TIME LIMIT
          EQ     TSSC        ENTER SWITCHING LOOP
 
 
**        IIO - INCREASE I/O LIMIT.
*
*T  ADDR  42/  ,18/IO
*         IO     NEW I/O LIMIT IN RA + 1 CALLS
 
 
 CTI45    MX6    -18
          SA5    B5-B4       GET NEW I/O LIMIT
          SA2    B2+RA1C     GET RA + 1 COUNT
          BX2    -X6*X2
          BX6    -X6*X5      GET NEW LIMIT
          LX6    30
          IX6    X6+X2       STORE NEW LIMIT IN
          SA6    A2+         UPPER 30 BITS OF RA1C
          EQ     TSSC        ENTER SWITCHING LOOP
 
 
**        READ MULTIPLE COMMUNICATION BLOCK INPUT.
*
*T  ADDR  1/R,11/   ,18/    LEN,12/   ,18/     BUF
*
*         R      RELEASE EXTRA COMMUNICATION BLOCK(S) AFTER TRANSFER.
*         LEN    LENGTH OF BUFFER IN TASK TO RECEIVE DATA.
*         BUF    FWA OF BUFFER IN TASK TO RECEIVE DATA.
 
 
 CTI46    SA5    B5-B4       READ PARAMETER WORD
          MX2    -24
          SA3    B6+
          SB3    X5          FWA OF USER BUFFER AREA
          LX5    -30
          NG     B3,TERR2    IF INCORRECT BUFFER ADDRESS
          LX3    -18
          SB4    X5          LENGTH OF USER BUFFER
          SX5    B5+B3       ABSOLUTE FWA OF USER BUFFER
          BX0    -X2*X3      TRANSACTION SEQUENCE NUMBER OF REQUESTOR
          SB5    B3+B4
          SX7    X5+B4       ABSOLUTE LWA OF USER BUFFER PLUS ONE
          SB5    -B5
          SX3    X5
          NG     B4,TERR2    IF INCORRECT LENGTH PARAMETER
          LX5    18
          SX6    X1+B5
          SB5    B0+
          BX7    X5+X7
          LX7    18
          NG     X6,TERR2    IF BUFFER + LENGTH OUTSIDE OF TASK FL
          BX5    X7+X3
          SA2    B2+CB2C     GET CB ADDRESS
          SB5    X2          CURRENT CB ADDRESS
 CTI47    SA3    B5+CBNCW    POINTER TO NEXT CB IN CHAIN
          SB5    X3+
          ZR     B5,CTI49    IF NO MORE COMMUNICATION BLOCKS
          SA2    B5+CMBHL+1
          MX4    -12
          SX6    B5
          BX4    -X4*X2      NUMBER OF DATA WORDS IN COMMUNICATION BLOCK
          SX1    X4          NUMBER OF WORDS TO TRANSFER
          SX3    X5          FWA OF AREA TO TRANSFER TO
          LX5    -18
          IX7    X3+X1
          SX4    X5          MAXIMUM LWA OF USER BUFFER AREA
          IX2    X7-X4
          LX5    18
          NG     X2,CTI48    IF ENOUGH ROOM IN BUFFER
          IX1    X1-X2
          BX0    X0-X0       SET BUFFER FULL FLAG
 CTI48    MX4    -18
          SX2    X6+CMBHL+CMBRL
          BX5    X4*X5       CLEAR OLD CURRENT POSITION
          BX5    X5+X7
          MOVE   X1,X2,X3    LOAD DATA INTO TASK
          NZ     X0,CTI47    IF BUFFER NOT FULL
 
*         RETURN DATA TRANSFERED COUNT TO TASK
 
 CTI49    SX7    X5          LAST WORD WRITTEN
          LX5    -36
          SX4    X5          FWA OF USER BUFFER
          IX7    X7-X4
 CTI50    SA5    A5+         USER PARAMETER WORD
          SA7    B2+16B      SET STATUS IN TASKS X6 REGISTER
          SB6    B2+CB1C
          PL     X5,TSSC     IF NOT TO RELEASE EXTRA C.B.
*         EQ     CTI51       RELEASE REMAINING COMMUNICATION BLOCKS
 
 
**        RELEASE EXTRA COMMUNICTION BLOCKS CONTAINING LONG INPUT DATA.
*
 
 
 CTI51    SA3    B6+B1
          SX2    X3          COMMUNICATION BLOCK ADDRESS
          SA3    B2+CB1C     CLEAR NEXT C.B. LINK IN *CB1C*
          MX6    60-CBNCN
          BX6    X6*X3
          SA6    A3
          RJ     RSC         RELEASE SECONDARY COMMUNICATION BLOCKS
          JP     TSSC        ENTER SWITCHING LOOP
 
**        RETURN NAM COMMUNICATIONS MODE TO TASK.
*
*T  ADDR  48/ 0,12/  TPSTAT.
*
*         (ADDR) = NAMTP = 1 - IF *TAF* INSTALLED WITH *COMKNWC*.
 
 
 CTI52    SX6    NAMTP       SET NAM COMMUNICATION MODE
          SB5    B5-B4       TASK PARAMETER ADDRESS
          SA6    B5
          EQ     TSSC        ENTER TO SWITCHING LOOP
          SPACE  4
**        PROCESS BEGIN REQUEST - TRANSFER ZERO-LEVEL COMMUNICATION
*         BLOCK TO TASK SPECIFIED LOCATION.
*
*  ADDR   42/   , 18/  BUF
*
*         BUF    FWA OF BUFFER IN TASK TO RECEIVE COMMUNICATION BLOCK.
*
*         EXIT   COMMUNICATION BLOCK MOVED TO (BUF - BUF+CMBL).
*                TO *TSSC* - WHEN OPERATION COMPLETE.
*
*         USES   A - 1, 2, 6.
*                X - 0, 1, 2, 3, 5, 6.
*                B - 3, 4, 6.
*
*         CALLS  MVE=.
 
 
 CTI53    SB4    X1-CMBL     FL - COMMUNICATION BLOCK LENGTH
          LX5    18
          SB3    X5          (B3) = PARAMETER ADDRESS
          MX0    -18
          NG     B3,TERR2    IF PARAMETER .LT. ZERO
          SB4    B3+B5
          SB6    B3
          GE     B3,B4,TERR2 IF PARAMETER ADDRESS .GT. FL
          BX5    -X0*X5
          LX5    35-17
 
*         SET TASK SPECIFIED COMMUNICATION BLOCK IN SUB-CONTROL
*         POINT TABLE.
 
          SA1    B7+B1       UPDATE SUBCP TABLE WORD,N
          SA2    X1          READ CURRENT COMMUNICATION BLOCK ADDRESS
          LX0    18
          BX6    X0*X2
          BX6    X6+X5
          SA6    A2
          SX3    B2+B3       SET FWA OF USER SPECIFIED BUFFER
          SX2    X2+CMBHL    SET FWA OF COMMUNICATIONS BLOCK ADDRESS
          SX1    CMBL-CMBHL  SET WORD COUNT
          SX3    X3+NUAPL
          RJ     MVE=        MOVE COMMUNICATION BLOCK TO SUBCP
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 TFP      SPACE  4,20
**        TFP - *TSTAT* FUNCTION PROCESSING.
*
*         ENTRY  (X1) = FL OF SUBCP.
*                (X5) = SYSTEM REQUEST.
*                (X7) = TERMINAL ORDINAL, IF (B5) EQUALS ZERO.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B3) = FWA OF QUEUE ENTRY, IF (B5) EQUALS ZERO.
*                (B5) = SUBCP RA.
*                (B7) = FWA OF SUBCP TABLE ENTRY.
*
*         EXIT   TO *TSSC*.
*                TO *TERR2*, IF INCORRECT PARAMETERS.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  CFA, CRS, DCPT, EXIT, FIO, GSD, GRP, PTK, RCPU,
*                RSP, STF, VUP.
*
*         MACROS QTWCALL.
 
 
 TFP      NZ     B5,TFP1     IF NOT AN INTERNAL *TAF* REQUEST
 
*         REQUEST IS INTERNAL REQUEST OF *TAF*.
 
          SX6    B0
          LX5     59-59-17+35
          SA6    TFPB        SUBCP
          SA7    TFPA        TERMINAL ORDINAL
          BX6    X5          REQUEST
          SX7    B3          FWA OF QUEUE ENTRY
          SA6    TFPC
          SA7    TFPD        FWA OF QUEUE ENTRY RELATIVE TO SUBCP
          SA7    TFPE        FWA OF QUEUE ENTRY RELATIVE TO *TAF*
          EQ     TFP2        PROCESS *TSTAT* KEYWORDS
 
 TFP1     SB6    B1          REQUIRED NUMBER OF PARAMETERS
          LX5    59-59-17+35
          SB3    PTKBL*2+1   MAXIMUN NUMBER OF PARAMETERS
          RJ     VUP         VALIDATE USER PARAMETERS
          NZ     X6,TERR2    IF INCORRECT PARAMETER
          BX6    X5          SAVE SYSTEM REQUEST
          MX3    -CBTON
          SA4    B5-NUAPL+CB2C  GET DEFAULT TERMINAL ORDINAL
          SA6    TFPC
          LX4    CBTON-1-CBTOS  RIGHT JUSTIFY TERMINAL ORDINAL
          BX7    -X3*X4
          SA7    TFPA
          TX6    B7+CPAL,-VCPA  COMPUTE SUBCP
          AX6    SCPAL
          SA6    TFPB
          SX6    RCL         FWA OF QUEUE ENTRY RELATIVE TO SUBCP
          SA6    TFPD
          SX6    B5-NUAPL+RCL  FWA OF QUEUE RELATIVE TO *TAF*
          SA6    TFPE
 
*         SOME KEYWORDS MAY NOT NEED TO ACCESS THE RECOVERY FILE.
*         OTHER KEYWORDS MAY SPECIFIY THE USER/TERMINAL NAME WHICH
*         WILL DETERMINE THE RECOVERY FILE TO BE LOCKED.
 
 TFP2     SX2    B5          COMPUTE REQUEST ADDRESS RELATIVE TO *TAF*
          IX5    X5+X2
          RJ     PTK         PROCESS *TSTAT* KEYWORDS
          NG     X6,TERR11   IF TASK NOT VALIDATED FOR REQUEST
          NZ     X6,TFP3     IF BAD KEYWORD
          SX6    TSNE        RECOVERY STATUS NO ERRORS
          ZR     X0,TFP3     IF NO KEYWORDS REQUIRE RECOVERY FILE
          ZR     X7,TFP5     IF *TSTAT* DID NOT SPECIFY TERMINAL
          SA7    TFPA
          EQ     TFP5        PROCESS RECOVERY KEYWORDS
 
*         RETURN STATUS TO TASK.
 
 TFP3     SA2    X5          FWA OF *TSTAT* STATUS
          SA6    X2+B5
          NZ     B5,TSSC     IF NOT INTERNAL *TAF* REQUEST
 
*         SET *TSTAT* PROCESSING COMPLETE TO ALLOW WAITING
*         PROCESS TO CONTINUE.
 
 TFP4     MX7    QRTCN
          LX7    QRTCS-59
          SA1    TFPE        FWA OF QUEUE ENTRY RELATIVE TO *TAF*
          SA4    X1+QRTCW    FUNCTION COMPLETE
          BX6    X4+X7
          SA6    A4
          EQ     TSSC        TIME SLICE SUBC
 
 .A       IFEQ   IPTAR
 TFP5     RJ     EXIT        PROGRAM ERROR
 .A       ELSE
 TFP5     ZR     B5,TFP6     IF AN INTERNAL *TAF* REQUEST
 
*         DROP CPU FOR TASK.  THE CPU WILL BE REQUESTED FOR THE SUBCP
*         WHEN THE *TSTAT* FUNCTION COMPLETES.
 
          RJ     DCPT        DROP CPU FOR TASK
 TFP6     SA1    TFPA        TERMINAL STATUS TABLE ORDINAL
          SA2    TFPC        REQUEST
          SA3    TFPE        FWA OF QUEUE ENTRY
          SX7    X1          SAVE TERMINAL STATUS TABLE ORDINAL
          BX6    X2          SAVE REQUEST IN QUEUE
          SA7    X3+QRTOW
          SA6    X3+QRECW
 
*         DETERMINE RECOVERY FILE FOR TERMINAL.
*         SEVERAL RECOVERY FILES MAY BE USED TO SUPPORT
*         MULTI-MAINFRAME RECOVERY AND HIGHER PERFORMANCE.
 
 TFP7     RJ     STF         SEARCH TERMINAL FILES FOR TERMINAL ORDINAL
 
*         IF RECOVERY FILE IS NOT LOCKED, LOCK RECOVERY FILE
*         AND START PROCESSING FUNCTION.  IF RECOVERY FILE IS LOCKED,
*         QUEUE THE REQUEST.
 
          SA4    B4+TTLKW    LOCK STATUS
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          NG     X4,TFP10    IF FILE IS LOCKED
          MX7    -60+TTLKN   SET RECOVERY FILE LOCKED
          ERRNZ  TTLKS-59    IF LOCK FIELD NOT IN BIT 59
          BX6    X4+X7
          LX7    TTEVS-59
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    -X7*X6      CLEAR FILE RELEASE EVENT
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          SA6    A4
 
*         READ STATUS FROM RECOVERY FILE.
 
          SX1    MSST        MESSAGE SOURCE IS STATUS
          BX2    X3          TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS FOR STATUS
          SX5    B4+TTFTW    FWA OF FET
          SX2    TRUPL       LENGTH OF RECOVERY STATUS IN PRUS
          SX1    CIORD       *CIO* READ FUNCTION
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         INPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF INPUT COMPLETE EVENT
          SA3    TFPB        SUBCP
          SA4    TFPD        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SX7    B6+         FWA OF QUEUE ENTRY RELATIVE TO *TAF*
          SA6    TFPB        SAVE SUBCP
          SA7    TFPE
          RJ     STF         SEACH TERMINAL FILE TABLE FOR ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
 
*         PROCESS *TSTAT* KEYWORDS.
 
          RJ     GSD         GET STATUS DATA
          NZ     X6,TFP8     IF ERRORS, RECOVERY FUNCTION COMPLETE
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 TFP8     SA2    X5          FWA OF *TSTAT* STATUS
          SA6    X2+B5       RETURN STATUS TO TASK
 
*         UNLOCK RECOVERY FILE
 
          SA4    B4+TTLKW    LOCK STATUS
          MX7    -59
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          BX6    -X7*X4      CLEAR LOCK
          ERRNZ  TTLKW-TTEVW IF LOCK AN LOCK EVENT NOT IN SAME WORD
          LX7    TTEVS-59
          BX6    X7+X6       SET FILE RELEASE EVENT
          SA6    A4
          SA2    TFPB        SUBCP
          ZR     X2,TFP4     IF NOT A SUBCP REQUEST
 
*         REQUEST CPU FOR SUBCP.
 
          LX2    SCPAL       COMPUTE SUBCP TABLE ADDRESS
          TA4    X2-CPAL,VCPA
          SB6    A4          FWA OF SUBCP TABLE ENTRY
          SX4    X4-NUAPL    FWA OF TASK SYSTEM AREA
          SB3    TSSC        RETURN ADDRESS AFTER REQUESTING CPU
          RJ     RSP         RESTORE SUBCP REGISTERS
          EQ     RCPU        REQUEST CPU FOR TASK
 
*         RECOVERY FILE IS LOCKED, SO QUEUE REQUEST.
 
 TFP10    SX1    B4+TTEVW    FWA OF LOCK RELEASE EVENT
          SA3    TFPB        SUBCP
          SA4    TFPD        FWA OF QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  TTEVS,QTEV  WAIT UNTIL LOCK IS RELEASED
          RJ     GRP         GET REQUEST PARAMETERS
          SA6    TFPB        SAVE SUBCP
          SX6    B3+         SAVE FWA OF QUEUE ENTRY
          SA6    TFPD
          EQ     TFP7        DETERMINE RECOVERY FILE
 
 .A       ENDIF
 TFPA     BSS    1           TERMINAL STATUS TABLE ORDINAL
 TFPB     BSS    1           SUBCP
 TFPC     BSS    1           REQUEST
 TFPD     BSS    1           FWA OF QUEUE ENTRY RELATIVE TO SUBCP
 TFPE     BSS    1           FWA OF QUEUE ENTRY RELATIVE TO *TAF*
 .A       IFGE   IPTAR,1
 GSD      SPACE  4,15
**        GSD - GET STATUS DATA.
*
*         ENTRY  (X5) = FWA OF REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*
*         EXIT   (X6) = 0, IF NO ERRORS.
*                      *RSBK*, IF BAD KEYWORD.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 2, 6, 7.
 
 
 GSD      SUBR               ENTRY/EXIT
          SB2    X5+B1        FWA OF FIRST KEYWORD
          SB7    B0+         COUNT OF KEYWORDS PROCESSED
 GSD1     SA1    B2          FWA OF USER KEYWORD
          SX6    B0          NO ERRORS
          ZR     X1,GSDX     IF END OF USER KEYWORDS
          MX7    -18
          SB7    B7+B1       UPDATE NUMBER OF KEY WORDS PROCESSED
          SA2    GSDB        FIRST KEY WORD
          SX3    3H          BLANKS
          BX3    -X7*X3
          SA1    X1+B5       KEYWORD
 
*         DETERMINE ROUTINE TO PROCESS KEYWORD.
 
 GSD2     ZR     X2,GSD4     IF BAD KEYWORD
          SB6    X2          ROUTINE TO PROCESS KEYWORD
          BX2    X7*X2
          BX2    X2+X3       BLANK FILL KEYWORD FROM TABLE
          BX4    X2-X1
          SA2    A2+1        NEXT KEYWORD FROM TABLE
          NZ     X4,GSD2     IF NOT DESIRED KEYWORD
          SB2    B2+2        NEXT KEYWORD
          JP     B6          PROCESS KEYWORD
 
*         RETURN KEYWORD VALUE TO TASK.
 
 GSD3     SA1    B2-1        FWA OF VALUE IN TASK
          BX7    -X2*X4      VALUE
          SA7    X1+B5       RETURN VALUE TO TASK
          EQ     GSD1        PROCESS NEXT KEYWORD
 
*         RETURN BAD KEY STATUS TO TASK.
 
 GSD4     SX7    B7          POSITION OF BAD KEYWORD
          SX6    TSBK        RECOVERY STATUS BAD KEYWORD
          IX6    X7+X6
          SA1    X5          FWA OF STATUS
          SA6    X1+B5       RETURN STATUS
          EQ     GSDX        RETURN
 
*         GET *CDCS* KEYWORD VALUE.
 
 GSD5     SA4    B4+TTBFW+TRCCW  *CDCS* VALUE
          MX2    -TRCCN      MASK FOR *CDCS*
          LX4    TRCCN-1-TRCCS  RIGHT JUSTIFY *CDCS* VALUE
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *CRM* KEYWORD VALUE.
 
 GSD6     SA4    B4+TTBFW+TRCRW  *CRM* VALUE
          MX2    -TRCRN      MASK FOR *CRM*
          LX4    TRCRN-1-TRCRS  RIGHT JUSTIFY *CRM*
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *NEWID* KEYWORD VALUE.
 
 GSD7     SA4    B4+TTBFW+TRNIW  *NEWID* VALUE
          MX2    -TRNIN
          LX4    TRNIN-1-TRNIS  RIGHT JUSTIFY *NEWID*
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *OLDID* KEYWORD VALUE.
 
 GSD8     SA4    B4+TTBFW+TROIW  *OLDID* VALUE
          MX2    -TROIN
          LX4    TROIN-1-TROIS  RIGHT JUSTIFY *OLDID*
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *SEQ* KEYWORD VALUE.
 
 GSD9     SA4    B4+TTBFW+TRCNW  *SEQ* VALUE
          MX2    -TRCNN      MASK FOR *SEQ*
          LX4    TRCNN-1-TRCNS  RIGHT JUSTIFY *SEQ* FIELD
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *STEP* KEYWORD VALUE.
 
 GSD10    SA4    B4+TTBFW+TRCSW  *STEP* VALUE
          MX2    -TRCSN      MASK FOR *STEP*
          LX4    TRCSN-1-TRCSS  RIGHT JUSTIFY *STEP*
          EQ     GSD3        RETURN VALUE TO TASK
 
*         GET *TRAN* KEYWORD VALUE.
 
 GSD11    SA4    B4+TTBFW+TRTYW  *TRAN* VALUE
          MX2    -TRTYN      MASK FOR *TRAN*
          LX4    TRTYN-1-TRTYS  RIGHT JUSIFY *TRAN*
          EQ     GSD3        RETURN VALUE TO TASK
 
*         KEYWORDS AND ASSOCIATED PROCESSING ROUTINES.
 
 GSDB     CKT    CDCS,GSD5
          CKT    CRM,GSD6
          CKT    NEWID,GSD7
          CKT    NEXT,GSD1
          CKT    OLDID,GSD8
          CKT    RESTART,GSD1
          CKT    SEQ,GSD9
          CKT    STEP,GSD10
          CKT    TRAN,GSD11
          CKT    USER,GSD1
          CKT    END
 .A       ENDIF
 PTK      SPACE  4,20
**        PTK - PROCESS *TSTAT* KEYWORDS.
*
*         ENTRY  (X5) = FWA OF REQUEST.
*                (B5) = SUBCP RA.
*                (B7) = FWA OF SUBCP TABLE ENTRY.
*
*         EXIT   (X0) = 0, IF NO KEYWORDS ACCESS RECOVERY FILE.
*                (X6) = 0, IF NO KEYWORD ERRORS.
*                       *RSBK*, IF BAD KEYWORD.
*                       *TSRU*, IF RECOVERY UNAVAILABLE.
*                       NEGATIVE, IF TASK NOT VALIDATED FOR KEYWORDS.
*                (X7) = TERMINAL STATUS TABLE ORDINAL, IF NON-ZERO.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 2, 3, 4, 6.
*
*         CALLS  STST, VTO, ZFN, ZTB.
 
 
 PTK12    SX6    B0+         NO ERRORS
          SA1    PTKC        TERMINAL STATUS TABLE ORDINAL
          SX7    X1+
          ZR     X1,PTKX     IF TERMINAL NOT SPECIFIED
          ZR     B5,PTKX     IF INTERNAL *TAF* REQUEST
          RJ     VTO         VALIDATE TASK ORIGIN
          BX2    X6
          SX6    B0          NO ERRORS
          PL     X2,PTKX     IF TASK ON SYSTEM LIBRARY
          MX6    1
 
 PTK      SUBR               ENTRY/EXIT
          SB2    X5+B1       FWA OF KEYWORDS
          SX0    B0          NO KEYWORDS ACCESS RECOVERY FILE
          SX6    B0          CLEAR TERMINAL ORDINAL
          SB3    B0+         COUNT OF KEYWORDS PROCESSED
          SA6    PTKC
 PTK1     SA1    B2          FWA OF KEYWORD
          ZR     X1,PTK12    IF END OF KEYWORDS
          SB3    B3+B1       UPDATE COUNT OF KEYWORDS PROCESSED
          MX7    -18
          SX3    3H          BLANKS
          BX3    -X7*X3
          SA1    X1+B5       KEYWORD
 
*         DETERMINE ROUTINE TO PROCESS KEYWORD.
 
          SA2    PTKB        TABLE OF KEY WORDS
 PTK2     ZR     X2,PTK4     IF KEYWORD NOT FOUND
          SB6    X2          ROUTINE TO PROCESS KEYWORD
          BX2    X7*X2
          BX2    X2+X3       FILL KEY WORD WITH BLANKS
          BX4    X1-X2
          SA2    A2+B1       NEXT KEYWORD
          NZ     X4,PTK2     IF NOT DESIRED KEY WORD
          SB2    B2+2        NEXT KEYWORD
          JP     B6          PROCESS KEYWORD
 
*         RETURN KEYWORD VALUE TO TASK.
 
 PTK3     SA1    B2-1        FWA OF VALUE IN TASK
          BX7    -X2*X4      VALUE
          SA7    X1+B5       RETURN VALUE TO TASK
          EQ     PTK1        PROCESS NEXT KEYWORD
 
*         RETURN BAD KEY STATUS TO TASK.
 
 PTK4     SX1    B3          COUNT OF KEYWORDS PROCESSED
          SX6    TSBK        RECOVERY STATUS BAD KEYWORD
          IX6    X6+X1       STATUS CODE
 PTK5     SA2    X5          FWA OF STATUS
          SA6    X2+B5
          EQ     PTKX        RETURN
 
*         IF RECOVERY IS INSTALLED, INDICATE KEYWORD NEEDS
*         RECOVERY FILE.  IF RECOVERY IS NOT INSTALLED, RETURN
*         RECOVERY NOT INSTALLED STATUS TO TASK.
 
.A        IFGE   IPTAR,1
 PTK6     SX0    B1          INDICATE KEYWORD NEEDS RECOVERY FILE
          EQ     PTK1        GET NEXT KEYWORD
 .A       ELSE
 PTK6     SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          EQ     PTKX        RETURN
 .A       ENDIF
 
*         DETERMINE TERMINAL ORDINAL FOR KEYWORD *NEXT*.
 
 PTK7     SA1    B2-B1       FWA OF VALUE FOR *NEXT* KEYWORD
          SA2    PTKA        SPACES
          SA1    X1+B5       VALUE FOR *NEXT*
          BX6    X1-X2
          SX7    B1          INITIAL TERMINAL ORDINAL
          TB4    TSTLLE+1,VTST  FWA OF FIRST TERMINAL
          NZ     X6,PTK9     IF NOT FIRST CALL OF *NEXT* USER
 PTK8     SA4    B4          TERMINAL/USER
          SA7    PTKC
          MX0    TSTNN       MASK FOR TERMINAL NAME
          ERRNZ  TSTNS-59    IF TERMINAL NAME NOT LEFT JUSTIFIED
          BX1    X0*X4       TERMINAL NAME
          RJ     ZTB         CHANGE ZEROS TO BLANKS IN TERMINAL NAME
          SA6    A1          RETURN TERMINAL/USER TO TASK
          EQ     PTK1        PROCESS NEXT KEYWORD
 
 PTK9     RJ     ZFN         ZERO FILE NAME
          BX4    X1          FIND NAME IN TERMINAL STATUS TABLE
          RJ     STST        SEARCH *TST* FOR USER
          SX6    TSUU        RECOVERY STATUS END OF NEXT
          ZR     X3,PTK5     IF TERMINAL/USER NOT FOUND
          SX7    X3+1        TERMINAL ORDINAL FOR *NEXT*
          SB4    A3+TSTLLE   FWA OF NEXT TERMINAL/USER
          TB6    2,VTST,LWA  LWA OF TERMINAL STATUS TABLE
          SX6    TSEN        RECOVERY STATUS END OF *NEXT* PROCESSING
          GE     B4,B6,PTK5  IF END OF TERMINAL STATUS TABLE
          EQ     PTK8        RETURN TERMINAL TO TASK
 
*         IF RECOVERY IS INSTALLED, EXTRACT VALUE FOR *RESTART*
*         KEYWORD.  IF RECOVERY IS NOT INSTALLED, RETURN RECOVERY
*         NOT INSTALLED STATUS TO TASK.
 
 .A       IFGE   IPTAR,1
 PTK10    SA4    B5-NUAPL+CB2C  FWA OF COMMUNICATION BLOCK
          SA4    X4+CBTRW    RESTART ATTRIBUTE
          MX2    -CBTRN      MASK FOR RESTART FIELD
          LX4    CBTRN-1-CBTRS  RIGHT JUSTIFY RESTART FIELD
          EQ     PTK3        RETURN VALUE TO TASK
 .A       ELSE
 PTK10    SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          EQ     PTKX        RETURN
 .A       ENDIF
 
*         DETERMINE TERMINAL ORDINAL FOR *USER* KEYWORD.
 
 PTK11    SA1    B2-B1       FWA OF VALUE FOR *USER*
          SA1    X1+B5       TERMINAL NAME
          RJ     ZFN         ZERO FILL TERMINAL NAME
          BX4    X1
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          SX6    TSUU        RECOVERY STATUS USER UNKNOWN
          ZR     X3,PTK5     IF TERMINAL/USER NOT FOUND
          SX7    X3+
          SA7    PTKC
          EQ     PTK1        PROCESS NEXT KEYWORD
 
 PTKA     DATA   10H
 
*         KEYWORDS AND THEIR ASSOCIATED PROCESSING ROUTINES.
 
 PTKB     CKT    CDCS,PTK6
          CKT    CRM,PTK6
          CKT    NEWID,PTK6
          CKT    NEXT,PTK7
          CKT    OLDID,PTK6
          CKT    RESTART,PTK10
          CKT    SEQ,PTK6
          CKT    STEP,PTK6
          CKT    TRAN,PTK6
          CKT    USER,PTK11
 PTKBL    EQU    *-PTKB      NUMBER OF KEYWORDS
          CKT    END
 
 PTKC     BSS    1           TERMINAL STATUS TABLE ORDINAL
 WFP      SPACE  4,20
**        WFP - *WSTAT* FUNCTION PROCESSOR.
*
*         ENTRY  (X1) = SUBCP FL.
*                (X5) = SYSTEM REQUEST.
*                (X7) = TERMINAL STATUS TABLE TERMINAL ORDINAL.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF SUBCP TABLE ENTRY.
*
*         EXIT   TO *TSSC*.
*                TO *TERR11*, IF TASK NOT ON SYSTEM LIBRARY.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 5, 6.
*
*         CALLS  CFA, CRS, DCPT, EXIT, FIO, GRP, IRU, PSD,
*                RCPU, STF, VTO, VUP.
*
*         MACROS QTWCALL.
 
 
 WFP      ZR     B5,WFP1     IF AN INTERNAL REQUEST
          RJ     VTO         VALIDATE TASK ORIGIN
          NG     X6,TERR11   IF TASK NOT ON SYSTEM LIBRARY
          SB6    B1          REQUIRED NUMBER OF PARAMETERS
          LX5    59-59-17+35
          SX7    TSSC        SET RETURN ADDRESS
          SA7    B2+RWTS
 
*         ENTRY FROM *WTS*.
 
 WFP0     SB3    PWKBL*2+1
          RJ     VUP         VALIDATE USER PARAMETERS
          NZ     X6,TERR2    IF INCORRECT PARAMETER
          BX6    X5          SAVE SYSTEM REQUEST
          MX3    -CBTON
          SA4    B5-NUAPL+CB2C  GET DEFAULT TERMINAL ORDINAL
          SA6    WFPC
          LX4    CBTON-1-CBTOS  RIGHT JUSTIFY TERMINAL ORDINAL
          BX7    -X3*X4
          SA7    WFPA
          TX6    B7+CPAL,-VCPA  COMPUTE SUBCP
          AX6    SCPAL
          SA6    WFPB
          SX6    RCL         FWA OF QUEUE RELATIVE TO SUBCP
          SA6    WFPD
          SX6    B5-NUAPL+RCL  FWA OF QUEUE RELATIVE TO *TAF*
          SA6    WFPE
          EQ     WFP2        PROCESS *WSTAT* KEYWORDS
 
 WFP1     SX6    B0          NO SUBCP
          LX5    59-59-17+35
          SA6    WFPB
          SA7    WFPA        TERMINAL ORDINAL
          SX7    B3          FWA TO QUEUE WORK
          SA7    WFPD
          SA7    WFPE
          BX6    X5          SAVE REQUEST
          SA6    WFPC
 WFP2     SX2    B5          COMPUTE ADDRESS RELATIVE TO *TAF*
          IX5    X5+X2
          RJ     PWK         PROCESS *WSTAT* KEYWORDS
          NZ     X6,WFP3     IF ERROR IN KEYWORDS
          SX6    TSNE        RECOVERY STATUS NO ERRORS
          ZR     X0,WFP3     IF RECOVERY FILE NOT NEEDED
          ZR     X7,WFP5     IF TERMINAL NOT SPECIFIED BY KEYWORDS
          SA7    WFPA
          EQ     WFP5        SET UP QUEUE ENTRY
 
*         RETURN STATUS TO TASK AND COMPLETE *WSTAT* PROCESSING.
 
 WFP3     SA1    X5          FWA OF STATUS
          SA6    X1+B5
          NZ     B5,TSSC     IF NOT AN INTERNAL *TAF* REQUEST
 
*         SET *WSTAT* PROCESSING COMPLETE TO ALLOW WAITING
*         PROCESS TO CONTINUE.
 
 WFP4     MX7    QRTCN
          LX7    QRTCS-59
          SA3    WFPE        FWA OF QUEUE ENTRY
          SA4    X3+QRTCW    FUNCTION COMPLETE
          BX6    X4+X7
          SA6    A4
          EQ     TSSC        TIME SLICE SUBCP
 
 .A       IFEQ   IPTAR
 WFP5     RJ     EXIT        PROGRAM ERROR
 .A       ELSE
 WFP5     ZR     B5,WFP6     IF AN INTERNAL *TAF* REQUEST
 
*         DROP CPU FOR TASK.  THE CPU WILL BE REQUESTED FOR THE SUBCP
*         WHEN THE *WSTAT* FUNCTION COMPLETES.
 
          SB5    B7+         SAVE FWA OF SUBCP TABLE ENTRY
          RJ     DCPT        DROP CPU FOR TASK
          SA1    B5+SCRAW    TASK RA
          SB5    X1
          SX3    X1
          SA5    B5-NUAPL+LRA1  SYSTEM REQUEST
          IX5    X5+X3       REQUEST ADDRESS RELATIVE TO *TAF*
 
*         SAVE PARAMETERS FOR RECOVERY PROCESSING IN THE QUEUE ENTRY.
 
 WFP6     SA1    WFPA        *TST* ORDINAL
          SA2    WFPC        REQUEST
          SA3    WFPE        FWA TO QUEUE REQUEST
          SX7    X1          SAVE TERMINAL STATUS TABLE ORDINAL
          BX6    X2          SAVE REQUEST IN QUEUE
          SA7    X3+QRTOW
          SA6    X3+QRECW
 
*         DETERMINE RECOVERY FILE FOR TERMINAL.
 
 WFP8     RJ     STF         SEARCH TERMINAL FILES FOR TERMINAL ORDINAL
 
*         IF RECOVERY FILE IS NOT LOCKED, LOCK RECOVERY FILE AND
*         START PROCESSING.  IF RECOVERY FILE IS LOCKED,
*         QUEUE THE REQUEST.
 
          SA4    B4+TTLKW    LOCK STATUS
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          NG     X4,WFP10    IF FILE IS LOCKED
          MX7    TTLKN       SET RECOVERY FILE LOCKED
          BX6    X4+X7
          LX7    TTEVS-59
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    -X7*X6      CLEAR FILE RELEASE EVENT
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          SX0    TSTLLE      TERMINAL STATUS TABLE ENTRY LENGTH
          SA6    A4+
 
*         READ STATUS FROM RECOVERY FILE.
 
          SX1    MSST        MESSAGE SOURCE IS STATUS
          BX2    X3          TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS FOR STATUS
          SX5    B4+TTFTW    FWA OF FET
          SX2    TRUPL       LENGTH OF RECOVERY STATUS IN PRUS
          SX1    CIORD       *CIO* READ FUNCTION
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         INPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF INPUT COMPLETE EVENT
          SA3    WFPB        SUBCP
          SA4    WFPD        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SA6    WFPB        SAVE SUBCP
          SX7    B6          FWA OF QUEUE ENTRY RELATIVE TO TAF
          SX6    B3          FWA OF QUEUE ENTRY RELATIVE TO TASK
          SA7    WFPE
          SA6    WFPD
          RJ     STF         SEACH TERMINAL FILE TABLE FOR ORDINAL
          SX7    X3+         RECOVERY FILE TERMINAL ORDINAL
          SA7    WFPF
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
          RJ     PSD         PUT STATUS DATA
          NZ     X6,WFP9     IF ERRORS, RECOVERY FUNCTION COMPLETE
 
*         WRITE *WSTAT* DATA TO RECOVERY FILE.
 
          SX1    MSST        MESSAGE SOURCE IS STATUS
          SA2    WFPF        TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS FOR *WSTAT*
          SX5    B4+TTFTW    FWA OF FET
          SX2    TRUPL       LENGTH TO WRITE IN PRUS
          SX1    CIORW       *CIO* REWRITE
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         OUTPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF EVENT COMPLETE IS FET
          SA3    WFPB        SUBCP OF EVENT
          SA4    WFPD        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT ON BIT 0 OF FET TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SX7    B6+         FWA OF QUEUE RELATIVE TO *TAF*
          SA6    WFPB        SAVE SUBCP
          SA7    WFPE
          RJ     STF         SEARCH TERMINAL FILE FOR ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
 
*         RETURN STATUS TO TASK.
 
          SX6    TSNE        RECOVERY STATUS NO ERRORS
          SA4    X5          FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
 
*         UNLOCK RECOVERY FILE.
 
 WFP9     SA4    B4+TTLKW    LOCK STATUS
          MX7    -60+TTLKN
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          BX6    -X7*X4      CLEAR LOCK
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          LX7    TTEVS-59
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    X7+X6       SET FILE RELEASE EVENT
          SA6    A4
          SA2    WFPB        SUBCP
          ZR     X2,WFP4     IF AN INTERNAL *TAF* REQUEST
 
*         REQUEST CPU FOR SUBCP.
 
          LX2    SCPAL       COMPUTE SUBCP TABLE ADDRESS
          TA4    X2-CPAL,VCPA
          SB6    A4          FWA OF SUBCP TABLE ENTRY
          SX4    X4-NUAPL    FWA OF TASK SYSTEM AREA
          SA3    X4+RWTS     GET RETURN ADDRESS
          SB3    TSSC
          SX6    X3+
          SA6    X4+RCL      RETURN AFTER RECALL
          SA5    B6+SCRCW    SET RECALL FLAG
          MX6    SCRCN
          LX6    SCRCS-59
          BX6    X6+X5
          SA6    A5
          RJ     RSP         RESTORE SUBCP REGISTERS
          EQ     RCPU        REQUEST CPU FOR TASK
 
*         RECOVERY FILE IS LOCKED, SO QUEUE REQUEST.
 
 WFP10    SX1    B4+TTEVW    FWA OF LOCK RELEASE EVENT
          SA3    WFPB        SUBCP
          SA4    WFPD        FWA OF QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIMEOUT ON EVENT
          QTWCALL  TTEVS,QTEV  WAIT UNIT LOCK IS RELEASED
          RJ     GRP         GET REQUEST PARAMETERS
          SA6    WFPB        SAVE SUBCP
          SX6    B3+         SAVE FWA OF QUEUE ENTRY
          SA6    WFPD
          EQ     WFP8        DETERMINE RECOVERY FILE
 
 .A       ENDIF
 WFPA     BSS    1           TERMINAL STATUS TABLE ORDINAL
 WFPB     BSS    1           SUBCP
 WFPC     BSS    1           REQUEST
 WFPD     BSS    1           FWA OF QUEUE ENTRY TO SUBCP
 WFPE     BSS    1           FWA OF QUEUE ENTRY RELATIVE TO *TAF*
 WFPF     BSS    1           RECOVERY FILE TERMINAL ORDINAL
 .A       IFGE   IPTAR,1
 PSD      SPACE  4,15
**        PSD - PUT STATUS DATA.
*
*         ENTRY  (X5) = RA REQUEST.
*                (B5) = SUBCP RA.
*
*         EXIT   (X6) = 0, IF NO KEYWORD ERRORS.
*                       *RSBK*, IF BAD KEYWORD.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 2, 6, 7.
 
 
 PSD      SUBR               ENTRY/EXIT
          SB2    X5+B1       FWA OF KEYWORDS
          SB7    B0+         COUNT OF KEYWORDS PROCESSED
 PSD1     SA1    B2          FWA OF KEYWORD
          SX6    B0          NO ERRORS
          ZR     X1,PSDX     IF END OF KEYWORDS
          SB7    B7+B1       UPDATE COUNT OF KEYWORDS PROCESSED
          MX7    -18
 
*         DETERMINE ROUTINE TO PROCESS KEYWORD.
 
          SA2    PSDB        FIRST *WSTAT* KEYWORD
          SX3    3H          BLANKS
          BX3    -X7*X3
          SA1    X1+B5       KEYWORD
 PSD2     ZR     X2,PSD3     IF BAD KEYWORD
          SB6    X2          ROUTINE TO PROCESS KEYWORD
          BX2    X7*X2
          BX2    X2+X3       BLANK FILL KEYWORD
          BX4    X1-X2
          SA2    A2+1        NEXT KEYWORD
          NZ     X4,PSD2     IF NOT DESIRED KEYWORD
          SA1    B2+B1       FWA OF VALUE FOR KEYWORD
          SA1    X1+B5       VALUE FOR KEYWORD
          SB2    B2+2        NEXT KEYWORD
          JP     B6          PROCESS KEYWORD
 
*         PROCESS BAD KEYWORD.
 
 PSD3     SX7    B7          BAD KEYWORD POSITION
          SX6    TSBK        RECOVERY STATUS BAD KEYWORD
          IX6    X6+X7
 PSD4     SA1    X5          FWA OF STATUS
          SA6    X1+B5       RETURN STATUS TO TASK
          EQ     PSDX        RETURN
 
*         PUT *CDCS* KEYWORD VALUE IN BUFFER.
 
 PSD5     SA4    B4+TTBFW+TRCCW  *CDCS* VALUE
          MX2    60-TRCCN
          LX4    TRCCN-1-TRCCS  RIGHT JUSTIFY *CDCS* FIELD
          BX7    X2*X4
          BX7    X7+X1
          LX7    TRCCS-TRCCN+1  POSITION *CDCS* FIELD
          SA7    A4
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         PUT *CRM* KEYWORD VALUE IN BUFFER.
 
 PSD6     SA4    B4+TTBFW+TRCRW *CRM* FIELD
          MX2    60-TRCRN
          LX4    TRCRN-1-TRCRS  RIGHT JUSTIFY *CRM* FIELD
          BX7    X2*X4
          BX7    X1+X7       NEW *CRM* VALUE
          LX7    TRCRS-TRCRN+1  POSITION *CRM* FIELD
          SA7    A4
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         PUT *NEWID* KEYWORD VALUE IN BUFFER.
 
 PSD7     BX7    X1
          ERRNZ  TRNIN-60    IF FIELD DOES NOT OCCUPY FULL WORD
          SA7    B4+TTBFW+TRNIW
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         PUT *OLDID* KEYWORD VALUE IN BUFFER.
 
 PSD8     BX7    X1
          ERRNZ  TROIN-60
          SA7    B4+TTBFW+TROIW
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         PUT *SEQ* KEYWORD VALUE IN BUFFER.
 
 PSD9     SA4    B4+TTBFW+TRCNW  *SEQ* FIELD
          LX4    TRCNN-1-TRCNS  RIGHT JUSTIFY *SEQ* FIELD
          MX2    60-TRCNN
          BX7    X2*X4
          BX7    X7+X1       SET NEW *SEQ* VALUE
          LX7    TRCNS-TRCNN+1  POSITION *SEQ* FIELD
          SA7    A4
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         PUT *STEP* KEYWORD VALUE IN BUFFER.
 
 
 PSD10    SX4    X1-CSTT
          ZR     X4,PSD1     IF START INPUT REQUEST
          SA4    B4+TTBFW+TRCSW  *STEP* FIELD
          MX2    60-TRCSN
          LX4    TRCSN-1-TRCSS  RIGHT JUSTIFY *STEP*
          BX7    X2*X4
          BX7    X7+X1       NEW STEP FIELD
          LX7    TRCSS-TRCSN+1  POSITION *STEP* FIELD
          SA7    A4
          EQ     PSD1        PROCESS NEXT KEYWORD
 
 
*         PUT *TRAN* KEYWORD VALUE IN BUFFER.
 
 PSD11    SA4    B4+TTBFW+TRTYW  *TRAN* FIELD
          MX2    60-TRTYN
          LX4    TRTYN-1-TRTYS  RIGHT JUSTIFY *TRAN*
          BX7    X2*X4
          BX7    X7+X1       NEW *TRAN* VALUE
          LX7    TRTYS-TRTYN+1  POSITION *TRAN* FIELD
          SA7    A4
          EQ     PSD1        PROCESS NEXT KEYWORD
 
*         KEYWORDS AND THEIR ASSOCIATED PROCESSING ROUTINE.
 
 PSDB     CKT    CDCS,PSD5
          CKT    CRM,PSD6
          CKT    NEWID,PSD7
          CKT    NEXT,PSD3
          CKT    OLDID,PSD8
          CKT    RESTART,PSD3
          CKT    SEQ,PSD9
          CKT    STEP,PSD10
          CKT    TRAN,PSD11
          CKT    USER,PSD1
          CKT    END
 .A       ENDIF
 PWK      SPACE  4,20
**        PWK - PROCESS *WSTAT* KEYWORDS.
*
*         ENTRY  (X5) = FWA OF REQUEST.
*                (B5) = SUBCP RA.
*
*         EXIT   (X0) = 0, IF NO KEYWORDS ACCESS RECOVERY FILE.
*                (X6) = 0, IF NO KEYWORD ERRORS.
*                       *RSBK*, IF BAD KEYWORD.
*                (X7) = TERMINAL STATUS TABLE ORDINAL, IF NON-ZERO.
*                (STIN) = 1, IF COMMUNICATIONS ENABLED, OTHERWISE 0.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 6.
*
*         CALLS  STST, ZFN.
*
*         MACROS ABORT, MESSAGE.
 
 
 PWK11    SX6    B0+         NO ERRORS
          SA1    PWKD        TERMINAL STATUS TABLE ORDINAL
          SX7    X1+
 
 PWK      SUBR               ENTRY/EXIT
          SB2    X5+B1       FWA OF KEYWORDS
          SX0    B0          NO KEYWORDS ACCESS RECOVERY FILE
          SX6    B0          CLEAR TERMINAL ORDINAL
          SB3    B0+         COUNT OF KEYWORDS PROCESSED
          SA6    PWKD
 PWK1     SA1    B2          FWA OF KEYWORD
          ZR     X1,PWK11    IF END OF KEYWORDS
          SB3    B3+B1       UPDATE COUNT OF KEYWORDS
          MX7    -18
          SX3    3H          BLANKS TO FILL KEYWORD
          BX3    -X7*X3
 
*         DETERMINE ROUTINE TO PROCESS KEYWORD.
 
          SA2    PWKB        FIRST KEYWORD
          SA1    X1+B5       USER KEYWORD
 PWK2     ZR     X2,PWK3     IF BAD KEYWORD
          SB6    X2          ROUTINE TO PROCESS KEYWORD
          BX2    X7*X2
          BX2    X2+X3       BLANK FILL KEYWORD
          BX4    X2-X1
          SA2    A2+B1       NEXT KEYWORD
          NZ     X4,PWK2     IF NOT USER TASK KEYWORD
          SA1    B2+B1       FWA OF VALUE FOR KEYWORD
          SA1    X1+B5       VALUE FOR KEYWORD
          SB2    B2+2        NEXT KEYWORD
          JP     B6          PROCESS KEYWORD
 
*         PROCESS BAD KEYWORD.
 
 PWK3     SX7    B3          BAD KEYWORD POSITION
          SX6    TSBK        RECOVERY STATUS BAD KEYWORD
          IX6    X6+X7
 PWK4     SA1    X5          FWA OF STATUS
          SA6    X1+B5       RETURN STATUS TO TASK
          EQ     PWKX        RETURN
 
*         IF RECOVERY IS INSTALLED, INDICATE KEYWORD NEEDS RECOVERY
*         FILE.  IF RECOVERY IS NOT INSTALLED, RETURN RECOVERY NOT
*         INSTALLED STATUS TO TASK.
 
 .A       IFGE   IPTAR,1
 PWK5     SX0    B1          INDICATE KEYWORD NEEDS RECOVERY FILE
          EQ     PWK1        PROCESS NEXT KEYWORD
 .A       ELSE
 PWK5     SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          EQ     PWKX        RETURN
 .A       ENDIF
 
*         PROCESS *STEP* KEYWORD.  IF *STEP* VALUE EQUALS *CSTT*
*         ABORT *TAF*.  IF *STEP* VALUE EQUALS *CSST* TELL *TAF*
*         TO ALLOW TRANSACTION INPUT.
 
 
 PWK7     SX2    X1-CSTT
          ZR     X2,PWK8     IF TERMINATE *TAF*
          SX2    X1-CSST
          ZR     X2,PWK9     IF START TERMINAL/JOB INPUT
          EQ     PWK5        INDICATE KEYWORD NEEDS RECOVERY FILE
 
 PWK8     MESSAGE PWKC       * RECOVERY NOT SUCCESSFUL.*
          ABORT
 
 PWK9     SX7    B1+         START INPUT FOR TERMINALS/JOBS
          SA7    STIN
          SA4    B5-NUAPL+CB2C  GET *TST* ADDRESS
          LX4    CBTAN-CBTAS-1
          SX4    X4
          ZR     X4,PWK1     IF SYSTEM ORIGIN TRANSACTION
          MX6    TSCPN-60
          LX6    TSCPS-59    CLEAR CONNECTION POSTPONE FLAG
          SA4    X4+B1       WORD 2 OF *TST*
          BX6    -X6*X4
          SA6    A4+         UPDATE WORD 2 OF *TST*
          EQ     PWK1        PROCESS NEXT KEYWORD
 
*         PROCESS *USER* KEYWORD.  SEARCH TERMINAL STATUS TABLE FOR
*         SPECIFIED USER NAME AND DETERMINE TERMINAL ORDINAL.
 
 PWK10    RJ     ZFN         ZERO FILL NAME
          BX4    X1
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          SX6    TSUU        RECOVERY STATUS USER UNKNOWN
          ZR     X3,PWK4     IF TERMINAL NAME NOT FOUND
          SX7    X3+         SAVE TERMINAL ORDINAL
          SA7    PWKD
          EQ     PWK1        PROCESS NEXT KEYWORD
 
*         KEYWORDS AND THEIR ASSOCIATED PROCESSING ROUTINES.
 
 PWKB     CKT    CDCS,PWK5
          CKT    CRM,PWK5
          CKT    NEWID,PWK5
          CKT    NEXT,PWK3
          CKT    OLDID,PWK5
          CKT    RESTART,PWK3
          CKT    SEQ,PWK5
          CKT    STEP,PWK7
          CKT    TRAN,PWK5
          CKT    USER,PWK10
 PWKBL    EQU    *-PWKB      NUMBER OF KEYWORDS
          CKT    END
 
 PWKC     DATA   C* RECOVERY NOT SUCCESSFUL.*
 PWKD     BSS    1           TERMINAL STATUS TABLE ORDINAL
 ROU      SPACE  4,10
**        ROU - *ROUTE* PROCESSOR.
*
*         ENTRY  (X1) = TASK FL.
*                (B4) = COMPLEMENT OF FWA OF PARAMETER LIST.
*                (B5) = TASK RA.
*
*         EXIT   TO *TSSC*, IF ERROR ENCOUNTERED.
*                TO *TRCL2*, IF LAST DSP REQUEST NOT COMPLETED.
*                TO *RFQ*, IF FILE IS TO BE ROUTED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 3, 5, 6.
*
*         CALLS  KDC, KDE, KDO, KEC, KFC, KFM, KIC, KID, KJS, KOT, KPI,
*                KPR, KRE, KSC, KST, KSV, KTD, KUJ, KUN, RSP, ZFN.
*
*         MACROS REWIND, WRITE, WRITER.
 
 
 ROU      BSS    0           ENTRY
          SA2    TDSP        CHECK INTERLOCK
          SX7    SRTN4.1     RECALL RETURN ADDRESS
          NZ     X2,TRCL2    IF LAST DSP REQUEST NOT COMPLETED
          SX6    B5          SAVE TASK RA
          SA6    ROUB
          MX7    0           CLEAR INTERNAL FLAGS
          SA7    PTID
          SA7    A7+B1       CLEAR *PFUN*
          SA7    A7+B1       CLEAR *PDID*
          SA7    A7+B1       CLEAR *PDEF*
          SA7    A7+B1       CLEAR *PJSN*
          SA7    A7+B1       CLEAR *PUJN*
          SA7    A7+B1       CLEAR *PDCT*
          SA7    A7+B1       CLEAR *PECT*
          SA7    A7+B1       CLEAR *PJOT*
 
*         INITIALIZE *DSP* PARAMETER BLOCK.
 
          SA2    SF          SET FILE NAME IN *TROU*
          MX0    42
          BX6    X0*X2
          SA6    TROU
          SX2    FRER+FRFN   INITIALIZE *TROU+1*
          BX6    -X0*X2
          SA6    A6+B1
          MX2    -24         INITIALIZE *TROU+2*
          BX6    -X2
          SA6    A6+B1
          BX6    X6-X6       INITIALIZE REST OF PARAMETER BLOCK
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+1
          SA6    A6+B1
 
*         GET FWA OF DATA.
 
          SA2    B5-B4       FWA OF PARAMETER LIST
          MX0    -18
          BX7    -X0*X2
          SX6    EC100
          ZR     X7,ROU8     IF NO DATA TO ROUTE
          SA3    SF+1
          SX7    B5+X7       FWA OF DATA (RELATIVE TO TAF)
          BX7    -X0*X7
          BX3    X0*X3
          BX7    X3+X7
          SA7    A3+         STORE *FIRST*
 
*         GET LENGTH (IN CM WORDS).
 
          SA2    A2+B1       GET FWA OF LENGTH
          BX2    -X0*X2
          SX6    EC101
          ZR     X2,ROU8     IF LENGTH NOT SPECIFIED
          SA3    X2+B5
          IX4    X1-X3
          ZR     X3,ROU8     IF NO DATA TO ROUTE (LENGTH = 0)
          NG     X4,ROU8     IF LENGTH OF DATA EXCEEDS TASK FL
          IX6    X7+X3       LWA+1 OF DATA (RELATIVE TO TAF)
          SA3    SF+4
          BX6    -X0*X6
          SX6    X6+1
          SA2    A2+B1       FWA OF STATUS WORD
          BX3    X0*X3
          BX6    X3+X6
          SA6    A3+         SET *LIMIT*
 
*         GET FWA OF STATUS WORD.
 
          BX2    -X0*X2
          SX6    EC102
          ZR     X2,ROU8     IF NO STATUS RETURN ADDRESS SPECIFIED
          SX6    X2          SAVE STATUS RETURN ADDRESS
          SB6    A2+B1       POINT TO NEXT PARAMETER
          SA6    ROUA
 
*         RETURN HERE FROM PARAMETER PROCESSOR.
*         (B6) = ADDRESS OF NEXT PARAMETER.
 
*         PROCESS NEXT PARAMETER.
 
 ROU1     SA1    ROUB        GET TASK RA
          SB5    X1
          SA1    B6          GET FWA OF NEXT PARAMETER
          ZR     X1,ROU3     IF END OF PARAMETERS
          SA1    X1+B5       ACTUAL PARAMETER
          RJ     ZFN         ZERO FILL ACTUAL PARAMETER
          SA3    B6+B1       FWA OF PARAMETER VALUE
          SB6    B6+2
 
*         SEARCH FOR PARAMETER PROCESSOR.
 
          MX0    36
          SA2    TKEY-1
 ROU2     SA2    A2+B1
          BX7    X1-X2       COMPARE PARAMETER
          BX7    X0*X7
          SB3    X2          SET PARAMETER PROCESSOR ADDRESS
          SX6    EC103
          ZR     X2,ROU8     IF PARAMETER NOT FOUND IN TABLE
          NZ     X7,ROU2     IF NOT THIS PARAMETER
          SX6    EC104
          ZR     X3,ROU8     IF NO PARAMETER VALUE SPECIFIED
          SA1    X3+B5
          RJ     ZFN         ZERO FILL PARAMETER VALUE
          BX3    X1
          JP     B3          EXECUTE PARAMETER PROCESSOR
 
*         MAKE *DSP* CALL.
 
 ROU3     SA1    TROU+1      *DSP* PARAMETER BLOCK WORD 1
          MX0    -12
          BX2    X1
          AX1    24
          BX7    -X0*X1      DISPOSITION CODE
          SB3    B0          INITIALIZE POINTER FOR *ROUC* TABLE
          AX1    12
          BX1    -X0*X1      FORMS CODE
          SX3    X7-2RSC
          ZR     X3,ROU5     IF *DC=SC*
 ROU4     SA3    ROUC+B3     GET INPUT MNEMONIC
          ZR     X3,ROU5     IF END OF TABLE
          IX3    X7-X3
          SB3    B3+B1       GET NEXT MNEMONIC
          NZ     X3,ROU4     IF NO MATCH
          SX6    EC105
          NZ     X1,ROU8     IF *FC* SPECIFIED ON INPUT DISPOSITION
          SA1    PDEF        CHECK FOR *DEF* PARAMETER
          SX6    EC106
          NZ     X1,ROU8     IF DEFERRED INPUT FILE
 ROU5     SA1    PFUN
          SA3    PTID
          SX4    FRTI
          BX6    X3+X1
          BX7    X4+X2
          ZR     X6,ROU6     IF NOT REMOTE ROUTING
          SA7    TROU+1      SET *TID* FLAG BIT
          SA1    TFUN
          SA2    A1+B1
          BX2    X2+X1
          ZR     X2,ROU6     IF IMPLICIT REMOTE ROUTING
          SA2    TROU+2
          SX3    A1          SET ADDRESS OF FAMILY/USER NAME BLOCK
          MX0    36
          BX3    -X3
          BX6    -X0*X3
          BX2    X0*X2
          BX6    X2+X6
          SA6    TROU+2
 ROU6     MX0    -3
          SA1    PDCT
          LX0    3
          SA2    PECT
          BX1    -X0*X1      GET *DC* TYPE
          BX2    -X0*X2      GET *EC* TYPE
          ZR     X1,ROU7     IF NO *DC* TYPE
          ZR     X2,ROU7     IF NO *EC* TYPE
          BX1    X1-X2
          ZR     X1,ROU7     IF TYPES COMPARE
          SX6    EC107
          EQ     ROU8        RETURN ERROR CODE
 
*         ROUTE DATA AND GET STATUS.
 
 ROU7     REWIND SF,R
          SA2    SF+4        SET *IN* TO *LIMIT-1*
          MX0    -18
          BX6    -X0*X2
          SX3    B1
          IX6    X6-X3
          SA6    A2-2
          WRITER SF,R        WRITE DATA TO SCRATCH FILE
          SA1    SF+1        *FIRST*
          SX6    OBUF
          MX0    42
          SA6    A1+B1       RESTORE *IN*
          SA6    A6+B1       RESTORE *OUT*
          BX1    X0*X1
          SA2    A6+B1       *LIMIT*
          BX6    X1+X6
          SX7    OBUF+OBUFL
          BX2    X0*X2
          SA6    A1          RESTORE *FIRST*
          BX7    X2+X7
          SA7    A2          RESTORE *LIMIT*
          RJ     RSP         RESTORE B2 AND B7
          SA1    TROU+1      GET PARAMETER FLAGS
          SA3    ROUA        GET STATUS RETURN ADDRESS
          SX6    RFQ3        *ROUTE* REQUEST STATUS PROCESSOR
          LX3    18
          BX3    X3+X6       24/, 18/ STATUS ADDR, 18/ STATUS PROC-R
          EQ     RFQ         ROUTE FILE TO QUEUE
 
 
*         RETURN HERE IF TAF DETECTS A *ROUTE* PARAMETER VALUE ERROR.
*         (X6) = ERROR CODE.
 
 ROU8     SA3    ROUA        RETURN STATUS ADDRESS
          SA1    ROUB
          IX3    X3+X1
          SA6    X3          STORE ERROR CODE
          EQ     TSSC        ENTER SWITCH LOOP
 
 
 ROUA     BSSZ   1           RETURN STATUS ADDRESS
 ROUB     BSSZ   1           TEMPORARY STORAGE FOR TASK RA
 
*         INPUT DISPOSITION CODE TABLE.
 
 ROUC     DATA   2RIN        *DC=IN*
          DATA   2RNO        *DC=NO*
          DATA   2RTO        *DC=TO*
          DATA   0
          SPACE  4,10
**        ALL OF THE FOLLOWING ROUTINES (*KDC* THROUGH *KUN*) HAVE THE
*         FOLLOWING COMMON ENTRY AND EXIT CONDITIONS.  REFER TO THE
*         INDIVIDUAL ROUTINES FOR SPECIFIC CONDITIONS.
*
*         ENTRY  (X3) = PARAMETER VALUE WHEN *PARAMETER = PARAMETER
*                       VALUE* IS THE FORMAT.
*                (X3) = 0 IF *PARAMETER* IS THE FORMAT.
*
*         EXIT   TO *ROU1* IF NO ERROR.
*                ENTRIES MADE IN *DSP* PARAMETER BLOCK *TROU*.
*                (B6) = ENTRY VALUE.
 KDC      SPACE  4,10
**        KDC - PROCESS *DC=XX* (DISPOSITION CODE).
*
*         ENTRY  (X3) = DISPOSITION CODE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *DC* FIELD IN *TROU+1* = DISPOSITION CODE.
*                DISPOSITION CODE FLAG SET IN *TROU+1*.
*                (PDCT) = DISPOSITION CODE TYPE.
*                (B6) = ENTRY VALUE.
*
*         USES   X - 0, 1, 3, 7.
*                A - 1, 7.
 
 
 KDC      BSS    0           ENTRY
          SA1    TDCC-1
          MX0    12
 
*         FIND CODE IN TABLE.
 
 KDC1     SA1    A1+1
          BX7    X1-X3       COMPARE CODES
          BX7    X0*X7
          ZR     X1,KDC2     IF END OF TABLE
          NZ     X7,KDC1     IF NO MATCH
 KDC2     BX7    X1
          SA7    PDCT        SET TYPE PROCESSED
          LX3    -24         POSITION PARAMETER
          SA1    TROU+1
          SX7    FRDC
          LX0    -24         POSITION MASK
          BX3    X0*X3
          BX1    -X0*X1
          BX3    X1+X3       ENTER *DC* PARAMETER
          BX7    X3+X7       ENTER FLAG BIT
          SA7    A1
          EQ     ROU1        RETURN
 KDE      SPACE  4,10
**        KDE - PROCESS *DEF* (DEFERRED ROUTE).
*
*         EXIT   TO *ROU1*.
*                DEFERRED ROUTE FLAG SET IN *TROU+1*.
*                (PDEF) = NON-ZERO.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *DEF* PARAMETER.
*
*         USES   X - 1, 6, 7.
*                A - 1, 7.
 
 
 KDE      BSS    0           ENTRY
          NZ     X3,KDE1     IF EQUIVALENCED PARAMETER
          SA1    TROU+1
          SX7    FRDR
          SA7    PDEF        SET *DEF* PARAMETER ENTERED FLAG
          BX7    X1+X7       ENTER FLAG
          SA7    A1
          EQ     ROU1        RETURN
 
 KDE1     SX6    EC108       INCORRECT *DEF* PARAMETER
          EQ     ROU8        RETURN ERROR CODE
 KDO      SPACE  4,10
**        KDO - PROCESS *DO=XXX* (DESTINATION OUTPUT MAINFRAME).
*
*         ENTRY  (X3) = OUTPUT MAINFRAME *LID*, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *SLID* FIELD IN *TROU+2* = OUTPUT MAINFRAME *LID*.
*                *SLID/DLID* FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *DO* VALUE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 5, 6.
 
 
 KDO      BSS    0           ENTRY
          MX0    18
          BX2    -X0*X3
          AX2    18
          NZ     X2,KDO2     IF *LID* GREATER THAN THREE CHARACTERS
          BX6    X0*X3       EXTRACT OUTPUT MAINFRAME *LID*
          SX5    1R*         CHECK FOR ASTERISK
          LX5    17-5
          R=     X4,LCPD     SET *SLID* TO *PID*
          LX6    18
          IX3    X4-X6
          PL     X3,KDO2     IF .LE. SPECIAL *SLID* VALUES
          BX5    X5-X6
          NZ     X5,KDO1     IF NOT ASTERISK
          BX6    X4          SET *SLID*=*PID*
 KDO1     SA2    TROU+2      SET *SLID* IN *TROU*
          BX2    -X0*X2
          LX6    42
          BX6    X2+X6
          SA6    A2
          SX6    FRLD
          SA1    A2-B1       SET *SLID/DLID* FLAG
          BX6    X1+X6
          SA6    A1+         STORE FLAG
          EQ     ROU1        RETURN
 
 KDO2     SX6    EC109       INCORRECT *DO* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KEC      SPACE  4,10
**        KEC - PROCESS *EC=XX* (EXTERNAL CHARACTERISTIC).
*
*         ENTRY  (X3) = EXTERNAL CHARACTERISTIC, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *EC* FIELD IN *TROU+1* = EXTERNAL CHARACTERISTIC.
*                EXTERNAL CHARACTERISTIC FLAG SET IN *TROU+1*.
*                (PECT) = EXTERNAL CHARACTERISTIC TYPE.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *EC* VALUE.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6.
 
 
 KEC      BSS    0           ENTRY
          MX0    36
          MX7    -3
          SA1    TECC-1
          SA2    TROU+1
 KEC1     SA1    A1+B1
          ZR     X1,KEC2     IF EXTERNAL CHARACTERISTIC NOT FOUND
          BX6    X3-X1
          BX6    X0*X6
          NZ     X6,KEC1     IF NOT CORRECT EXTERNAL CHARACTERISTIC
          BX6    X1
          SA6    PECT        SET TYPE PROCESSED
          LX7    23-2        POSITION MASK
          LX1    23-2        POSITION ENTRY FROM *EC* TABLE
          SX6    FREC
          BX2    X7*X2
          BX1    -X7*X1
          BX6    X2+X6       ENTER FLAG BIT
          BX6    X1+X6       ENTER *EC* CODE
          SA6    A2+
          EQ     ROU1        RETURN
 
 KEC2     SX6    EC107       INCORRECT *EC* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KFC      SPACE  4,10
**        KFC - PROCESS *FC=XX* (FORMS CODE).
*
*         ENTRY  (X3) = FORMS CODE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *FC* FIELD IN *TROU+1* = FORMS CODE.
*                FORMS CODE FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF FORMS CODE GREATER THAN TWO CHARACTERS.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 6.
 
 
 KFC      BSS    0           ENTRY
          SA1    TROU+1
          MX0    -48
          BX2    -X0*X3
          LX3    -12
          NZ     X2,KFC1     IF FORMS CODE GREATER THAN TWO CHARACTERS
          LX0    -12
          SX6    FRFC
          BX1    X1+X6       ENTER FLAG BIT
          BX3    X0*X3
          BX6    X1+X3       ENTER FORMS CODE
          SA6    A1
          EQ     ROU1        RETURN
 
 KFC1     SX6    EC110       INCORRECT *FC* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KFM      SPACE  4,10
**        KFM - PROCESS *FM=XXXXXXX* (FAMILY NAME).
*
*         ENTRY  (X3) = FAMILY NAME, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                (TFUN) = FAMILY NAME.
*                (PFUN) = NON-ZERO.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF *TID/FM/UN* - *ID* CONFLICT OR *TID* -
*                *FM/UN* CONFLICT.
*
*         USES   X - 0, 1, 6, 7.
*                A - 1, 7.
 
 
 KFM      BSS    0           ENTRY
          SA1    PDID
          NZ     X1,KFM2     IF *FM* AND *ID* CONFLICT
          SA1    PTID
          SX7    FRTI
          NZ     X1,KFM1     IF *TID* PROCESSED
          SA7    PFUN        SET *FM-UN* FLAG
          ZR     X3,ROU1     IF IMPLICIT REMOTE ROUTING
          MX0    42
          BX7    X0*X3
          SA7    TFUN        STORE FAMILY NAME IN *TFUN*
          EQ     ROU1        RETURN
 
 KFM1     SX6    EC111       *TID* AND *FM/UN* CONFLICT
          EQ     ROU8        RETURN ERROR CODE
 
 KFM2     SX6    EC112       *TID/FM/UN* AND *ID* CONFLICT
          EQ     ROU8        RETURN ERROR CODE
 KIC      SPACE  4,10
**        KIC - PROCESS *IC=XX* (INTERNAL CHARACTERISTIC).
*
*         ENTRY  (X3) = INTERNAL CHARACTERISTIC, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *IC* FIELD IN *TROU+1* = INTERNAL CHARACTERISTIC.
*                INTERNAL CHARACTERISTIC FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *IC* VALUE.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6.
 
 
 KIC      BSS    0           ENTRY
          SA1    TROU+1
          SA2    TICC-1
          SX6    FRIC
          MX7    -2
          MX0    36
          LX7    19-1        POSITION MASK
          BX6    X1+X6       ENTER FLAG BIT
 KIC1     SA2    A2+B1
          ZR     X2,KIC2     IF UNKNOWN *IC* CODE
          BX1    X3-X2
          BX1    X0*X1
          NZ     X1,KIC1     IF NOT FOUND
          LX2    19-1
          BX6    X7*X6
          BX2    -X7*X2
          BX6    X6+X2       ENTER *IC* CODE
          SA6    A1
          EQ     ROU1        RETURN
 
 KIC2     SX6    EC113       INCORRECT *IC* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KID      SPACE  4,10
**        KID - PROCESS *ID=NN* (LOCAL DEVICE ID).
*
*         ENTRY  (X3) = LOCAL DEVICE ID, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *TID* FIELD IN *TROU+2* = LOCAL DEVICE ID.
*                *TID* FLAG SET IN *TROU+1*.
*                *PDID* SET IF *PTID* AND *PFUN* ARE ZERO.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *ID* VALUE.
*                TO *KFM2* IF *ID* - *TID/FM/UN* CONFLICT.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 7.
*
*         CALLS  DXB.
 
 
 KID      BSS    0           ENTRY
          SA1    PTID
          SA2    PFUN
          SX7    B1
          BX1    X1+X2
          NZ     X1,KFM2     IF *ID* - *TID/FM/UN* CONFLICT
          SA7    PDID
          ZR     X3,KID1     IF NON-EQUIVALENCED PARAMETER
          SB7    B0          SET OCTAL CONVERSION DEFAULT
          BX5    X3
          RJ     =XDXB
          NZ     X4,KID2     IF CONVERSION ERROR
          SA1    TROU+2
          MX0    36
          SX2    X6-IDLM
          BX7    X0*X1
          PL     X2,KID2     IF *ID* .GE. *IDLM*
          BX7    X7+X6
          SA7    A1
          SX3    FRTI
 KID1     SA2    TROU+1
          SX6    FRCS
          BX6    X2+X6       SET CENTRAL SITE ROUTING FLAG
          BX6    X3+X6       OPTIONALLY SET *TID* FLAG
          SA6    A2+
          EQ     ROU1        RETURN
 
 KID2     SX6    EC114       INCORRECT *ID* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KJS      SPACE  4,10
**        KJS - PROCESS *JSN=XXX* (UNIQUE JSN).
*
*         ENTRY  (X3) = JSN, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                FORCED JSN FIELD IN *TROU+6* = JSN.
*                FORCED JSN FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT JSN OR JSN NOT ALLOWED.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
 
 
 KJS      BSS    0           ENTRY
          ZR     X3,KJS1     IF NULL PARAMETER
          SX6    B1+
          SA6    PJSN
          SA1    JOPR        CHECK JOB ORIGIN TYPE
          MX0    -12
          LX1    0-24
          BX1    -X0*X1
          MX0    42
          IFNE   SYOT,0,1
          SX1    X1-SYOT
          SX6    EC115
          NZ     X1,ROU8     IF NOT SYSTEM ORIGIN JOB
          LX3    18
          BX1    X0*X3
          NZ     X1,KJS1     IF JSN TOO LONG
          MX7    -6
          BX1    -X7*X3
          ZR     X1,KJS1     IF JSN TOO SHORT
          SA1    TROU+6
          SA2    TROU+1
          BX6    X0*X1
          BX6    X6+X3       SET JSN IN FORCED JSN FIELD
          SX7    FRFJ
          BX7    X2+X7       SET FORCED JSN FLAG
          SA6    A1
          SA7    A2+
          EQ     ROU1        RETURN
 
 KJS1     SX6    EC116       INCORRECT JSN VALUE
          EQ     ROU8        RETURN ERROR CODE
 KOT      SPACE  4,10
**        KOT - PROCESS *OT=XXXX* (ORIGIN TYPE).
*
*         ENTRY  (X3) = ORIGIN TYPE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *OT* FIELD IN *TROU* = ORIGIN TYPE.
*                ORIGIN TYPE FLAG SET IN *TROU*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF JOB NOT SYSTEM ORIGIN OR INCORRECT *OT*
*                VALUE.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 7.
 
 
 KOT      BSS    0           ENTRY
          SA1    JOPR        CHECK JOB ORIGIN TYPE
          MX0    -12
          LX1    11-35
          BX1    -X0*X1
          MX0    30
          SA2    TLOT-1
          SX1    X1-SYOT
          SX6    EC117       JOB NOT SYSTEM ORIGIN
          NZ     X1,ROU8     IF NOT *SYOT* JOB ORIGIN
 KOT1     SA2    A2+1
          BX6    X3-X2
          BX6    X0*X6
          ZR     X2,KOT2     IF END OF TABLE
          NZ     X6,KOT1     IF NOT A MATCH
          MX0    -7
          SA1    TROU
          BX2    -X0*X2      EXTRACT ORIGIN VALUE
          SX2    X2+4000B    SET FLAG BIT
          BX1    X0*X1
          BX7    X1+X2       ENTER ORIGIN VALUE
          SA7    TROU
          EQ     ROU1        RETURN
 
 KOT2     SX6    EC118       INCORRECT *OT* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KPI      SPACE  4,10
**        KPI - PROCESS *PI=NNNNNNN* (PRINT IMAGE).
*
*         ENTRY  (X3) = PRINT TRAIN IMAGE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *PI* FIELD IN *TROU+4* = PRINT TRAIN IMAGE.
*                *PI* FLAG SET IN *TROU+4*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *PI* VALUE.
*                TO *ROU1* IF NO *PI* VALUE.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 7.
*                B - 4.
 
 
 KPI      BSS    0           ENTRY
          ZR     X3,ROU1     IF NULL PARAMETER
          SA1    TPIN-1
          MX0    1
 
*         CHECK FOR VALID PRINT IMAGE NAME.
 
 KPI1     SA1    A1+B1       CHECK NEXT ENTRY
          ZR     X1,KPI2     IF END OF TABLE
          SX6    X1          ISOLATE MASK SIZE
          BX7    X1-X3
          AX6    6
          SB4    X6+
          AX6    X0,B4       FORM MASK
          BX2    X6*X7
          NZ     X2,KPI1     IF NO MATCH
          SA2    TROU+4
          MX0    -6          ISOLATE PRINT IMAGE ORDINAL
          LX2    6
          BX6    -X0*X1
          BX7    X0*X2
          SX6    X6+10B      SET PRINT IMAGE FLAG
          BX7    X6+X7       SET PRINT IMAGE CODE INTO PARAMETER BLOCK
          LX7    -6
          SA7    A2+
          EQ     ROU1        RETURN
 
 KPI2     SX6    EC119       INCORRECT *PI* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KPR      SPACE  4,10
**        KPR - PROCESS *PRI=NNNN* (PRIORITY).
*
*         THE *PRI* PARAMETER IS IGNORED BY NOS.  THIS ROUTINE PROVIDES
*         UPWARD COMPATIBILITY FROM NOS/BE.
*
*         ENTRY  (X3) = FILE PRIORITY, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                (B6) = ENTRY VALUE.
 
 
 KPR      BSS    0           ENTRY
          EQ     ROU1        IGNORE PARAMETER *PRI*
 KRE      SPACE  4,10
**        KRE - PROCESS *REP=NN* (REPEAT COUNT).
*
*         ENTRY  (X3) = REPEAT COUNT, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *RC* FIELD IN *TROU+4* = REPEAT COUNT.
*                REPEAT COUNT FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *REP* VALUE.
*                TO *ROU1* IF *REP* VALUE .GT. 77B.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 7.
*
*         CALLS  DXB.
 
 
 KRE      BSS    0           ENTRY
          SB7    B1          SET DECIMAL CONVERSION
          BX5    X3
          RJ     =XDXB       CONVERT VALUE
          NZ     X4,KRE1     IF CONVERSION ERROR
          SA1    TROU+1
          MX0    -6
          BX2    X0*X6
          NZ     X2,ROU1     IF VALUE .GT. 63D (77B)
          SA2    TROU+4
          SX7    FRRC
          LX0    12          POSITION MASK
          LX6    12          POSITION VALUE
          BX2    X0*X2
          BX7    X1+X7       SET FLAG BIT
          SA7    A1
          BX6    X6+X2       ENTER REPEAT COUNT
          SA6    A2+
          EQ     ROU1        RETURN
 
 KRE1     SX6    EC120       INCORRECT *REP* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KSC      SPACE  4,10
**        KSC - PROCESS *SC=XX* (SPACING CODE).
*
*         ENTRY  (X3) = SPACING CODE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *SPACING* FIELD IN *TROU+4* = SPACING CODE.
*                SPACING CODE FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *SC* VALUE.
*
*         USES   X - 0, 1, 3, 5, 6.
*                A - 1, 6.
*                B - 7.
*
*         CALLS  DXB.
 
 
 KSC      BSS    0           ENTRY
          SB7    B0          SET OCTAL CONVERSION
          BX5    X3
          RJ     =XDXB       CONVERT VALUE
          NZ     X4,KSC1     IF CONVERSION ERROR
          MX0    -6          ENTER SPACING CODE
          BX3    -X0*X6
          BX1    X0*X6
          ZR     X1,KSC2     IF *SC* .LE. 77B
 KSC1     SX6    EC121       INCORRECT *SC* VALUE
          EQ     ROU8        RETURN ERROR CODE
 
 KSC2     SA1    TROU+4
          LX0    48
          BX1    X0*X1
          LX3    48
          BX6    X1+X3
          SA6    A1+
          SA1    TROU+1      SET SPACING CODE FLAG
          SX6    FRSC
          BX6    X6+X1
          SA6    A1
          EQ     ROU1        RETURN
 KST      SPACE  4,10
**        KST - PROCESS *ST=XXX* (DESTINATION MAINFRAME LOGICAL ID).
*
*         ENTRY  (X3) = DESTINATION LOGICAL ID, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *DLID* FIELD IN *TROU+2* = DESTINATION LOGICAL ID.
*                *SLID/DLID* FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *ROU8* IF INCORRECT *ST* VALUE OR IF *DLID* IS LESS
*                THAN *PID*.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 2, 5, 6.
 
 
 KST      BSS    0           ENTRY
          MX0    18
          BX2    -X0*X3
          AX2    18
          NZ     X2,KST2     IF *LID* GREATER THAN THREE CHARACTERS
          BX6    X0*X3
          SX5    1R*         CHECK FOR ASTERISK
          LX5    17-5
          R=     X4,LCPD     SET *DLID* TO *PID*
          LX6    18
          IX3    X4-X6
          PL     X3,KST2     IF .LE. SPECIAL *DLID* VALUES
          BX5    X5-X6
          NZ     X5,KST1     IF NOT ASTERISK
          BX6    X4          SET *DLID*=*PID*
 KST1     LX6    24
          SA2    TROU+2      SET *DLID* IN *TROU*
          LX0    -18
          BX2    -X0*X2
          BX6    X6+X2
          SX1    FRLD        SET *SLID/DLID* FLAG
          SA6    A2
          SA2    A2-B1
          BX6    X2+X1
          SA6    A2          STORE FLAG
          EQ     ROU1        RETURN
 
 KST2     SX6    EC122       INCORRECT *ST* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KSV      SPACE  4,10
**        KSV -  PROCESS *SCL=XX* (SERVICE CLASS).
*
*         ENTRY  (X3) = SERVICE CLASS, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *SERVICE CLASS* FIELD IN *TROU+4* = SERVICE CLASS.
*                FORCED SERVICE CLASS FLAG SET IN *TROU+1*.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *KSV2* IF INCORRECT *SCL* VALUE.
*
*         USES   X - 0, 1, 6, 7.
*                A - 1, 7.
 
 
 KSV      BSS    0           ENTRY
          SA1    TSCT-1
 
*         CHECK FOR VALID SERVICE CLASS.
 
 KSV1     SA1    A1+B1
          ZR     X1,KSV2     IF END OF TABLE
          BX7    X1-X3
          NZ     X7,KSV1     IF NO MATCH
          SA1    TROU+4
          MX0    12
          BX7    X0*X3       SET SERVICE CLASS INTO PARAMETER BLOCK
          LX7    -12
          BX7    X7+X1
          SA7    A1
          SA1    TROU+1      SET FORCED SERVICE CLASS FLAG
          MX0    -1
          LX0    20
          BX7    -X0+X1
          SA7    A1+
          EQ     ROU1        RETURN
 
 KSV2     SX6    EC123       INCORRECT *SCL* VALUE
          EQ     ROU8        RETURN ERROR CODE
 KTD      SPACE  4,10
**        KTD - PROCESS *TID=XX* (TERMINAL ID).
*
*         ENTRY  (X3) = *TID* VALUE, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                TO *KID* IF *TID=C* (ROUTE TO CENTRAL SITE).
*                TO *KUN* IF *TID=XX* (SAME AS *UN* PARAMETER).
*                (PTID) = NON-ZERO IF IMPLICIT REMOTE ROUTING.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *KFM2* IF *TID* - *ID* CONFLICT.
*                TO *KFM1* IF *TID* - *FM/UN* CONFLICT.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 7.
 
 
 KTD      BSS    0           ENTRY
          SX6    1RC
          LX6    59-5
          BX6    X6-X3
          ZR     X6,KTD1     IF *TID=C* - ROUTE TO CENTRAL SITE
          SA1    PDID
          NZ     X1,KFM2     IF *TID* - *ID* CONFLICT
          SA1    PFUN
          NZ     X1,KFM1     IF *TID* - *FM/UN* CONFLICT
          PL     X3,KUN      IF *TID=XX*
          SX7    FRTI
          SA7    PTID
          EQ     ROU1        RETURN
 
 KTD1     SX3    0
          EQ     KID         PROCESS AS *ID*
 KUJ      SPACE  4,10
**        KUJ - PROCESS *UJN=XXXXXXX* (USER JOB NAME).
*
*         ENTRY  (X3) = USER JOB NAME, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                *UJN* FIELD IN *TROU+3* = USER JOB NAME.
*                *UJN* FLAG SET IN *TROU+1*.
*                (PUJN) = NON-ZERO.
*                (B6) = ENTRY VALUE.
*
*         USES   X - 1, 6, 7.
*                A - 1, 6, 7.
 
 
 KUJ      BSS    0           ENTRY
          SX6    B1+
          SA6    PUJN
          SA1    TROU+1      ENTER FLAG BIT
          SX7    FRUJ
          BX7    X1+X7
          SA7    A1
          SA1    TROU+3      ENTER *UJN* PARAMETER
          BX1    -X0*X1
          BX6    X1+X3
          SA6    A1+
          EQ     ROU1        RETURN
 KUN      SPACE  4,10
**        KUN - PROCESS *UN=XXXXXXX* (USER NAME).
*
*         ENTRY  (X3) = USER NAME, LEFT JUSTIFIED.
*
*         EXIT   TO *ROU1*.
*                (TFUN+1) = USER NAME IF NOT IMPLICIT REMOTE ROUTING.
*                (PFUN) = NON-ZERO.
*                (B6) = ENTRY VALUE.
*
*         ERROR  TO *KFM1* IF *FM/UN* - *TID* CONFLICT.
*                TO *KFM2* IF *UN* - *ID* CONFLICT.
*
*         USES   X - 0, 1, 6, 7.
*                A - 1, 6, 7.
 
 
 KUN      BSS    0           ENTRY
          SA1    PDID
          NZ     X1,KFM2     IF *UN* - *ID* CONFLICT
          SA1    PTID
          SX7    FRTI
          NZ     X1,KFM1     IF *FM/UN* - *TID* CONFLICT
          SA7    PFUN
          ZR     X3,ROU1     IF IMPLICIT REMOTE ROUTING
          MX0    42
          BX6    X0*X3
          SA6    TFUN+1      STORE USER NAME
          EQ     ROU1        RETURN
 MEM      SPACE  4,30
**        MEM - MEMORY REQUEST.
*
*         ENTRY  (B2) = FWA OF TASK SYSTEM AREA.
*                (B7) = FWA OF TASK SUBCP TABLE.
*                (B5) = TASK RA.
*                (X1) = TASK FL.
*                (X5) = 18/3LMEM,6/,18/TYPE,18/ADDR.
*                       TYPE = 0 REQUEST CM ABORT IF NOT AVAILABLE.
*                            = 1 REQUEST ECS ABORT IF NOT AVAILABLE.
*                            = 2 REQUEST CM DO NOT ABORT.
*                            = 3 REQUEST EXTENDED MEMORY DO NOT ABORT.
*                       ADDR = ADDRESS OF STATUS WORD.
*                       (ADDR) = 30/VAL,26/,1/R,1/C,1/,1/0.
*                       VAL    = 0, IF CURRENT FL DESIRED.
*                              -1, IF MAXIMUM FL DESIRED.
*                            .GT. 0, IF (VAL) = REQUEST FL.
*                       R      = CLEAR *CMM* STATUS.
*                       C      = *CMM* TYPE REQUEST.
*
*         EXIT   TO *TERR2* IF ADDRESS OUT OF RANGE.
*                TO *TERR33* IF INCORRECT EXTENDED MEMORY REQUEST.
*                TO *TERR34* IF INCORRECT CMM MEMORY REQUEST.
*                TO *TERR35* IF RFL EXCEEDED MFL.
*                TO *TERR36* IFINCORRECT REDUCTION OF FL.
*                TO *TSSC* IF NO OTHER ERROR.
*
*         USES   A - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  MCP, MTU, RCP, SFS, TRCL.
 
 
 MEM      SA0    B7          SAVE B7 AND B2
          SB3    X5          REQUEST ADDRESS
          MX4    -2          EXTRACT *R* AND *C* BITS
          SB4    X1          TASK FL
          BX7    X5          SAVE REQUEST WORD
          SA3    B7          FWA OF SUBCP TABLE
          GE     B3,B4,TERR2 IF ADDRESS GREATER THAN FL
          LX5    -18
          LE     B3,B1,TERR2 IF ADDRESS OUT OF RANGE
          SA2    B5+B3       READ STATUS WORD
          AX2    2
          BX4    -X4*X2
          SB6    X5-1        REQUEST TYPE
          ZR     B6,TERR33   IF REQUEST EXTENDED MEMORY
          GT     B6,B1,TERR33  IF REQUEST EXTENDED MEMORY
          SB6    X4-1
          LX4    59-0
          LX3    59-SCCMS
          SA7    MEMB        SAVE REQUEST WORD
          LT     B6,B1,MEM1  IF NOT TO CLEAR CMM FLAG
          EQ     B6,B1,TERR34  IF NOT A CMM TYPE REQUEST
          PL     X3,TERR34   IF CMM FLAG NOT SET ON CLEAR
          EQ     MEM3        CLEAR CMM STATUS
 
 MEM1     NZ     B6,MEM2     IF CMM FIELD IS 0
          MX6    1           SET CMM STATUS FLAG
          BX6    X6+X3
          LX6    SCCMS-59
          SA6    A3
          EQ     MEM4        CONTINUE MEMORY REQUEST
 
*         CHECK NON-CMM REQUEST.
 
 MEM2     PL     X3,MEM4     IF NOT IN CMM STEP
          BX4    X2
          AX4    28          GET FL REQUEST
          SX3    X4+
          NG     X3,MEM4     IF ENQUIRE FOR MFL
          ZR     X3,MEM4     IF ENQUIRE FOR CURRENT FL
          EQ     TERR34      SET MEMORY REQUEST IN CMM STATUS
 
*         CLEAR CMM STATUS.
 
 MEM3     MX6    -59         CLEAR CMM STATUS FLAG
          BX6    -X6*X3
          LX6    SCCMS-59
          SA6    A3
 MEM4     AX2    28
          SA4    B7+SCNMW    GET TASK ID
          MX3    -SCNMN
          SX2    X2          REQUEST FL
          LX4    SCNMN-SCNMS-1
          BX7    -X3*X4
          IX0    X2-X1       AMOUNT OF INCREASE
          TA4    X7,VTLD     WORD 2 OF TLD ENTRY
          MX6    -TLFLN
          LX4    TLFLN-TLFLS-1
          BX7    -X6*X4
          LX4    TLEFN-TLEFS-1-TLFLN+TLFLS+1
          BX3    -X6*X4      EXPANDABLE FL
          IX7    X3+X7       MAXIMUM FL
          SX6    B1
          LX7    6
          ZR     X0,MEM5     IF ENQUIRE FL
 
*         RETURN MAXIMUM FL.
 
          PL     X2,MEM5     IF NOT MFL REQUEST
          LX7    30
          BX7    X6+X7
          SA7    B5+B3       RETURN MFL
          EQ     TSSC        RETURN
 
*         RETURN CURRENT FL.
 
 MEM5     SX3    X2          REQUEST FL
          LX1    30          RETURN CURRENT FL
          BX6    X1+X6       SET COMPLETION FLAG
          SA6    B5+B3
          ZR     X2,TSSC     IF ENQUIRE FL
          SX6    B1
          LX1    30          CURRENT FL
 
*         CHECK FOR OUTSTANDING DATA MANAGER REQUESTS.
 
 MEM6     SA4    B2+CB1C     C.B. HEADER WORD
          SB6    X4+
          NZ     B6,TERR37   IF DATA MANAGER REQUEST OUTSTANDING
 
*         SEARCH FOR FREE SPACE.
 
          IX4    X7-X3
          LX3    30
          SB6    TERR35      ERROR CODE FOR RFL EXCEED MFL
          IX2    X2-X1       CHECK IF REQUEST .LT. TASK FL
          BX6    X6+X3
          NG     X4,MEM19    IF REQUESTED FL .GT. MFL
          NG     X2,MEM16    IF REDUCE FL
          SX0    X2          AMOUNT OF INCREASE
          SA6    B5+B3       RETURN FL REQUEST
          SA3    AVAILCM     SPACE CURRENTLY AVAILABLE
          SX6    B3          SAVE PARAMETERS
          LX0    18
          LX6    -18
          BX6    X1+X6       ADD CURRENT FL
          BX6    X0+X6
          SA6    MEMA
          IX7    X3-X2
          PL     X7,MEM7     IF SPACE AVAILABLE
          RJ     RMF         REQUEST MORE MEMORY
          ZR     X5,MEM12    IF MEMORY NOT AVAILABLE
          SA1    MEMA
          LX1    -18
          SX2    X1          REQUESTED FL INCREASE
 
*         TRY FL AFTER SUBCP.
 
 MEM7     SA4    B7          GET FREE SPACE AFTER SUBCP
          LX4    SCFCN-SCFCS-1
          SX0    X4          AVAILABLE FL
          IX7    X0-X2
          PL     X7,MEM14    IF FL AVAILABLE
 
*         TRY NEXT SUBCP.
 
          SA2    B7+2        GET NEXT SUBCP
          BX0    -X7         SPACE REQUIRED
          SX2    X2
          RJ     SFS         SEARCH FOR FREE SPACE AFTER SUBCP
          SB3    X7+B1
          SA1    MEMA
          SX3    X1          TASK FL
          NG     B3,MEM8     IF NO FL AVAILABLE
          IX7    X6-X3
          SA0    B7          ACTIVE SUBCP
          PL     X7,MEM8     IF MORE MEMORY TO MOVE
          RJ     MTD         MOVE TASK TOWARD HIGH MEMORY LOCATION
          EQ     MEM14       CLEAR ASSIGNED AREA
 
*         TRY PREVIOUS SUBCP FREE SPACE.
 
 MEM8     SA4    B7+SCLSW    LAST SUBCP
          LX4    SCLSN-SCLSS-1
          LX1    -18
          SB5    X1          REQUEST INCREASE FL
          SA2    X4          FWA OF LAST SUBCP TABLE
          SA1    B7          FWA OF CURRENT SUBCP
          LX2    SCFCN-SCFCS-1
          LX1    SCFCN-SCFCS-1
          SB3    X2
          SB3    X1+B3       TOTAL FREE SPACE AVAILABLE IF STORAGE MOVE
          LT     B3,B5,MEM9  IF NOT ENOUGH FL AFTER LAST SUBCP
          SB4    B7
          SX4    X2          FREE SPACE
          SB6    B0
          LX2    SCFCS-SCFCN+1
          RJ     MTK         MOVE TASK TOWARD LOW MEMORY LOCATION
          EQ     MEM14       CLEAR ASSIGN AREA
 
*         TRY SOMEWHERE ELSE.
 
 MEM9     SX0    X3+B5       TOTAL FL REQUIRED
          RJ     RCP         LOOKING FOR NEW SUBCP
          ZR     X5,MEM12    IF NO SPACE AVAILABLE
          MX0    6           UPDATE NEW SUBCP TABLE
          SA1    B7          FIRST WORD
          SA2    B4
          BX6    X0*X1
          BX6    X6+X2
          SA6    A2          NEW FIRST WORD
          SA2    B7+B1       WORD 2 OF SUBCP TABLE
          SX7    X2          GET CC FIELD IN WORD 2
          SA3    A2+B1       WORD 3 OF SUBCP TABLE
          SB3    B4-B7       GET DIFFERENT
          MX0    60-18       CLEAR CC FIELD
          SX7    X7+B3
          BX2    X0*X2       CLEAR CC FIELD
          BX7    X2+X7       ADD NEW CC FIELD
          SA7    B4+B1       NEW WORD 2 OF SUBCP TABLE
          MX0    12
          SA4    A7+B1       GET LS AND NS FIELD
          BX6    X0*X3       GET TASK ID
          BX6    X4+X6
          SA6    A4          NEW WORD 3 OF SUBCP TABLE
          SB6    B4
          SB4    B7
          SA0    B6+         NEW ACTIVE SUBCP
          SB3    5
 MEM10    SA3    A3+B1       MOVE WORD 4 TO 8
          BX6    X3
          SB3    B3-B1
          SA6    A6+B1
          NZ     B3,MEM10    IF NOT YET FINISHED
          SB3    MEM11       RETURN ADDRESS
          SX4    X5          FWA OF SUBCP AREA
          EQ     RCPU        REQUEST CPU ON NEW SUBCP
 
 MEM11    SB6    X5          DESTINATION TO MOVE
          BX4    X4-X4
          RJ     MTK         MOVE TASK TO ASSIGN AREA
          SB3    MEM14       RETURN ADDRESS AFTER RELEASING SUBCP
          SB6    B4          SUBCP TO RELEASE
          SB7    A0          ACTIVE SUBCP
          MX6    1           SET FLAG - NOT TO UPDATE FL IN SUBCP TABLE
          SA3    MEMA
          LX6    41-59
          BX6    X3+X6
          SA6    A3
          EQ     ESCP1       RELEASE CURRENT SUBCP
 
*         SINCE NO SPACE IS AVAILABLE, PUT TASK INTO RECALL
*         OR ROLLOUT IT OUT OF MEMORY.
 
 MEM12    SA4    B7+B1       CM RESIDENT TASK WORD IN SUBCP TABLE
          SA1    MEMA        RESTORE PARAMETERS
          LX4    59-57
          BX6    X1
          SX7    MEM13       RETURN ADDRESS AFTER RECALL
          SA6    B2+RCLA     SAVE PARAMETERS
          NG     X4,TRCL2    IF CM RESIDENT TASK
          RJ     FFR         RESERVE ROLLOUT TABLE
          ZR     X0,TRCL2    IF ROLLOUT TABLE FULL
          SB4    EVRL        MEMORY REQUEST EVENT
          SX2    X1          TASK FL
          LX1    -18         REQUESTED FL INCREASE
          SX3    X1
          IX2    X2+X3
          SA4    LTIME       CURRENT TIME
          AX4    36
          MX7    -18
          BX4    -X7*X4
          SX4    X4+DRLTL    ROLLOUT TASK FOR *DRLTL* SECOND
          SX3    13B         SET TIMED ROLLOUT FLAG
          LX3    54
          LX4    30
          BX1    X3+X4
          PX6    B4,X2       ROLLOUT EVENT - FL
          SA6    MEMC
          BX5    X5-X5       NO DELAY REQUIRED
          EQ     ROL3        ROLLOUT TASK
 
*         PROCESS RETURN FROM RECALL.
 
 MEM13    SA1    B2+RCLA
          BX6    X1          SAVE PARAMETERS
          LX1    -18
          SX2    X1          REQUESTED FL INCREASE
          SA4    AVAILCM     AVAILABLE SPACE
          LX1    -24
          SB3    X1
          IX7    X2-X4
          NG     X7,TRCL     IF SPACE STILL IS NOT AVAILABLE
          SA0    B7+         SAVE (B7)
          SA6    MEMA
          EQ     MEM7        TRY AGAIN
 
*         CLEAR ASSIGNED AREA.
 
 MEM14    SB7    A0          RESTORE B2 AND B7
          SA2    A0          FWA OF SUBCP TABLE
          SB2    X2-NUAPL
          SX1    B2          RESTORE *SREG*
          SX7    B7
          LX1    18
          BX7    X1+X7
          SA7    SREG
          SA1    MEMA
          BX5    X1
          SX3    X1
          LX1    -18
          SX2    X1          REQUEST INCREASE FL
          IX7    X2+X3       FL AFTER REQUEST
          LX1    59-0
          SB4    X7-1
          BX7    X7-X7
          BX6    X6-X6
          SB5    B2+NUAPL    TASK SYSTEM REQUEST
          SB3    2
          SB6    B5+X3       FWA OF REQUEST FL
          SB4    B4+B5       LWA OF TASK
 MEM15    SA6    B6+
          SA7    B6+B1
          SB6    B6+B3
          LT     B6,B4,MEM15 IF NOT YET FINISHED
          LX5    59-41
          PL     X1,MEM16    IF EVEN FL REQUEST
          SA7    A7+1
 MEM16    SA1    B7          FWA OF SUBCP TABLE
          LX1    SCFLN-SCFLS-1
          SX3    X1          CURRENT FL
          IX4    X3+X2       UPDATE FL
          NG     X5,MEM18    IF NOT TO UPDATE FL IN SUBCP TABLE
          SB6    TERR36      ERROR CODE FOR INCORRECT REDUCE FL
          SX5    X4-CMBL-111B
          NG     X5,MEM19    IF INCORRECT REDUCTION OF FL
          MX0    60-SCFLN    UPDATE FL IN SUBCP TABLE
          BX5    X0*X1
          BX7    X4+X5
          LX7    SCFCN-SCFCS-1+SCFLS-SCFLN+1
          BX6    -X0*X7      FL AVAILABLE AFTER TASK
          IX3    X6-X2
          BX6    X0*X7
          NG     X3,MEM17    IF NO AVAILABLE FL AFTER TASK
          BX6    X3+X6
 MEM17    LX6    SCFCS-SCFCN+1
          SA6    B7
          SA4    AVAILCM     UPDATE TOTAL AVAILABLE CM
          IX7    X4-X2
          SA7    A4
 MEM18    MX7    -36         UPDATE FL IN EXCHANGE PACKAGE
          SA1    B2+2
          SA2    B7
          BX7    -X7*X1      CLEAR OLD FL
          LX2    SCFLN-SCFLS-1  GET CURRENT FL
          SX6    X2
          LX6    36
          BX7    X6+X7
          SA7    A1
          RJ     RKP         RESTORE K-DISPLAY POINTER
          EQ     TSSC        RETURN
 
 MEM19    SA1    MEMB        LAST SYSTEM REQUEST
          LX1    59-19
          NG     X1,TSSC     IF NOT TO ABORT TASK
          JP     B6          ABORT TASK
 
 MEMA     BSSZ   1           18/ADDR,1/F,5/0,18/FL INCREASE,18/TASK FL
 MEMB     BSSZ   1           REQUEST WORD
 MSG      SPACE  4,20
**        MSG - PLACE MESSAGE ON LINE ONE OF CONSOLE *B-DISPLAY*.
*
*         ENTRY  (X1) = TASK FIELD LENGTH.
*                (X5) = 24/3LMSG,12/FNC,6/ ,18/ADDR.
*                       WHERE ADDR = ADDRESS OF MESSAGE TO DISPLAY.
*                       ALTERNATE FORM.
*                       (ADDR) = 12/0,18/ADDR1,30/0.
*                       ADDR1 = ADDRESS OF MESSAGE TO BE DISPLAYED.
*                       FNC = *MSG* FUNCTION CODE.
*                            VALUES PERMITTED FOR FNC ARE ZERO AND ONE.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCONTROL POINT TABLE.
*
*         EXIT   TO *TSSC* IF NO ERRORS.
*                TO *TERR3* IF FUNCTION CODE ERROR.
*
*         USES   A - 2.
*                X - 0, 2, 5, 6.
*                B - 3, 4, 6.
*
*         CALLS PMA.
*
*         MACROS MESSAGE.
 
 
 MSG      RJ     PMA         PROCESS MESSAGE ADDRESS
          LX0    -1
          SB3    X0
          SX3    B3-MSGJTL
          PL     X3,TERR3    IF INCORRECT FUNCTION CODE
          JP     B3+MSGJT    JUMP TO PROCESSOR
 
 MSGJT    PL     X0,MSG3     JOURNAL MESSAGE
          EQ     MSG6        DISPLAY MESSAGE ON LINE ONE
 
 MSGJTL   EQU    *-MSGJT     LENGTH OF *MSGJT* JUMP TABLE
 
*         SEND MESSAGE TO JOUR0 FILE.
 
 MSG3     SA2    B5+B6       FWA OF MESSAGE
          MX6    12
          SB3    B0+         BIT COUNT
          SX0    B1+         WORD COUNT
          SB4    60          WORD SIZE
 
*         CHECK WORD FOR ZERO BYTE.
 
 MSG4     BX3    X6*X2
          ZR     X3,MSG5     IF END OF MESSAGE
          LX6    12          SHIFT TO CHECK NEXT BYTE
          SB3    B3+12       INCREMENT BIT COUNT
          NE     B4,B3,MSG4  IF NOT DONE WITH WORD
          SX0    X0+B1       INCREMENT WORD COUNT
          SA2    A2+B1       GET NEXT WORD OF MESSAGE
          SB4    A2          CHECK FOR MAXIMUM LENGTH
          SB3    B5+B6
          SB3    B3+7
          GT     B4,B3,MSG5  IF MORE THAN 80 CHARACTERS
          SB3    B0+
          SB4    60
          EQ     MSG4        CHECK NEXT WORD
 
*         SET UP JOURNAL CALL.
 
 MSG5     SX5    B5+B6       GET MESSAGE ADDRESS WITH RESPECT TO TAF
          LX0    18
          BX5    X0+X5
          SB4    12B         SET ORIGIN CODE
          SB3    TSSC        RETURN ADDRESS
          SB5    JOUR0       FET FOR JOURNAL ENTRY
          SA2    B2+CB2C
          SX0    X2+
          EQ     JRNL        JOURNAL MESSAGE
 
*         DISPLAY MESSAGE ON LINE-1.
 
 MSG6     MESSAGE  B5+B6,1
          EQ     TSSC        ENTER SWITCHING LOOP
 PMA      SPACE  4,20
**        PMA - PROCESS MESSAGE ADDRESS.
*
*         ENTRY  (X1) = TASK FIELD LENGTH.
*                (X5) = 24/3LTMS OR MSG,12/FNC,6/ ,18/ADDR.
*                       WHERE ADDR = ADDRESS OF MESSAGE TO DISPLAY.
*                       ALTERNATE FORM.
*                       (ADDR) = 12/0,18/ADDR1,30/0.
*                       ADDR1 = ADDRESS OF MESSAGE TO BE DISPLAYED.
*                       FNC = *TMS* OR *MSG* FUNCTION CODE.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCONTROL POINT TABLE.
*
*         EXIT   (X0) = FUNCTION CODE.
*                (B5) = TASK RA.
*                (B6) = ADDRESS OF MESSAGE.
*
*         USES   A - 2.
*                X - 0, 2, 3, 5, 6, 7.
*                B - 3, 4, 6.
 
 
 PMA      SUBR               ENTRY/EXIT
          MX3    -12
          SB6    X5          ADDRESS OF MESSAGE
          LX5    11-35
          BX0    -X3*X5      (X0) = *MSG* FUNCTION CODE
          LE     B6,B1,TERR2 IF ADDRESS .LE. 1
          SB3    X1
          MX6    12
          GE     B6,B3,TERR2 IF ADDRESS .GE. FL
          SA2    B5+B6       READ FWA OF MESSAGE
          BX7    X6*X2
          ZR     X2,PMA1     IF NULL MESSAGE
          NZ     X7,PMA1     IF MESSAGE PRESENT
 
*         CONVERT INDIRECT ADDRESS FORM OF
*         *MSG* REQUEST TO DIRECT ADDRESS FORM.
 
          AX2    47-17
          SB6    X2          FWA OF MESSAGE
          LE     B6,B1,TERR2 IF ADDRESS .LE. 1
 PMA1     SB4    B6+5
          GT     B4,B3,TERR13  IF ADDRESS+5 .GT. FL
          EQ     PMAX        RETURN
 MEMC     VFD    60/0LMEMFL  ROLLOUT EVENT - FL
 RFL      SPACE  4,25
**        RFL - REQUEST FIELD LENGTH.
*
*         ENTRY  (X1) = TASK FIELD LENGTH.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B7) = FWA OF TASK SUBCP TABLE.
*                (B5) = TASK RA.
*                (X5) = 18/3ARFL,6/,18/ADDR,1/N,17/FL.
*                       ADDR = STATUS RESPONSE ADDRESS.
*                       N    = NO REDUCE OVERRIDE.
*                       FL   = FIELD LENGTH REQUIRED.
*
*         EXIT   TO *TERR34* IF INCORRECT REQUEST.
*                TO *MEM* IF NO ERROR.
*                (ADDR) = 12/0,18/FL,30/1.
*                         IF FL = 0, THE CURRENT FL WILL BE RETURNED.
*
*         USES   A - 3, 7.
*                B - 3, 4.
*                X - 3, 5, 6, 7.
*
*         CALLS  MEM.
 
 
 RFL      MX6    -17         EXTRACT FL
          BX7    -X6*X5
          SA3    B7          CHECK CMM STATUS
          AX5    18
          LX3    59-SCCMS
          SB3    X5          SET STATUS ADDRESS
          LX7    30
          SB4    X1
          NG     X3,TERR34   IF CMM STATUS SET
          GT     B3,B4,TERR2 IF ADDRESS GREATER THAN FL
          LE     B3,B1,TERR2 IF ADDRESS OUT OF RANGE
          SA7    B5+B3
          SX5    X5          REQUEST FL
          EQ     MEM         REQUEST MEMORY
 TIM      SPACE  4,10
***       *TIM*.
*         REQUEST SYSTEM TIME.
*
*T        18/  *TIM*,6/,12/  OP,6/,18/  ADDR
*         OP     TIME OPTION
*         ADDR   ADDRESS FOR RESPONSE
*
*
*         OP     RESPONSE
*
*         0      ACCUMULATED CPU TIME
*T ADDR   3/2,45/  SECONDS,12/  MILISEC.
*
*         1      DATE
*T ADDR   60/  * YY/MM/DD.*
*
*         2      CLOCK
*T ADDR   60/  * HH.MM.SS.*
*
*         3      JULIAN DATE
*T ADDR   24/  0,36/  * YYDDD*
*
*         4      SCOPE FORMAT REAL TIME (NOT SUPPORTED)
*T ADDR   3/2,45/  SECONDS,12/  MILISEC.
*
*         5      REAL TIME
*T ADDR   24/  SECONDS,36/  MILLISECONDS
*
*         6      PACKED DATE/TIME
*T ADDR   24/  0,6/ Y-70,6/  MM,6/ DD,6/  HH,6/  MM,6/  SS
 
 
 TIM      MX3    -12
          SB4    X5          ADDRESS FOR REPLY
          LX5    -24
          SB4    -B4
          BX0    -X3*X5      FUNCTION CODE
          PL     B4,TERR2    IF ADDRESS OUT OF BOUNDS
          LX0    -1
          SX7    X1+B4
          SB3    X0
          NG     X7,TERR2    IF ADDRESS OUT OF BOUNDS
          SX3    B3-TIMJTL
          PL     X3,TERR3    IF INCORRECT FUNCTION CODE
          JP     B3+TIMJT    JUMP TO FUNCTION PROCESSOR
 
 TIMJT    PL     X0,TIM1     TIME
          EQ     TIM2        DATE
          PL     X0,TIM3     CLOCK
          EQ     TIM4        JULIAN DATE
          PL     X0,TERR3    SCOPE FORMAT REAL TIME(NOT SUPPORTED)
          EQ     TIM5        REAL TIME
          PL     X0,TIM6     PACKED DATE/TIME
          EQ     TERR3       NOT USED
 TIMJTL   EQU    *-TIMJT     LENGTH OF TIM JUMP TABLE
 
*         TIME
 
 TIM1     TIME   B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         DATE
 
 TIM2     DATE   B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         CLOCK
 
 TIM3     CLOCK  B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         JULIAN DATE
 
 TIM4     JDATE  B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         RTIME
 
 TIM5     RTIME  B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 
*         PACKED DATE/TIME
 
 TIM6     SA2    PDATE
          BX6    X2
          SA6    B5-B4
          EQ     TSSC        ENTER SWITCHING LOOP
 TMS      SPACE  4,20
**        TMS - TAF MESSAGE TO DAYFILE.
*
*         ENTRY  (X1) = TASK FIELD LENGTH.
*                (X5) = 24/3LTMS,12/FNC,6/ ,18/ADDR.
*                       WHERE ADDR = ADDRESS OF MESSAGE TO DISPLAY.
*                       ALTERNATE FORM.
*                       (ADDR) = 12/0,18/ADDR1,30/0.
*                       ADDR1 = ADDRESS OF MESSAGE TO BE DISPLAYED.
*                       FNC = *TMS*FUNCTION CODE.
*                             ONLY FNC = ZERO IS ALLOWED.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = TASK RA.
*                (B7) = FWA OF TASK SUBCONTROL POINT TABLE.
*
*         EXIT   TO *TSSC* IF NO ERRORS.
*                TO *TERR3* IF FUNCTION CODE ERROR.
*
*         USES   X - 0, 3.
*                B - 3.
*
*         CALLS  PMA, VTO.
*
*         MACROS MESSAGE.
 
 
 TMS      RJ     VTO         VERIFY TASK ORIGIN
          NG     X6,TERR11   IF TASK NOT VALIDATED FOR REQUEST
          RJ     PMA         PROCESS MESSAGE ADDRESS
          LX0    -1
          SB3    X0
          SX3    B3-TMSJTL
          PL     X3,TERR3    IF INCORRECT FUNCTION CODE
          JP     B3+TMSJT    JUMP TO PROCESSOR
 
 TMSJT    PL     X0,TMS1     IF FUNCTION CODE ZERO
          EQ     TERR3       IF INCORRECT FUNCTION CODE
 
 TMSJTL   EQU    *-TMSJT     LENGTH OF *TMSJT* JUMP TABLE
 
*         PLACE MESSAGE IN THE USER AND SYSTEM DAYFILE AND
*         ALSO DISPLAY IT AT LINE 1 OF THE CONTROL POINT.
 
 TMS1     MESSAGE  B5+B6,0
          EQ     TSSC        ENTER SWITCHING LOOP
          TITLE  *REC* SYSTEM REQUEST PROCESSOR.
 RFP      SPACE  4,15
**        RFP - RECOVERY FUNCTION PROCESSORS.
*
*         RFP    SY,FC,MP,RP,PR
*
*         ENTRY  *SY*     = IF *SYSTEM* SPECIFIED, REQUEST IS
*                           RESTRICTED TO SYSTEM TASKS.
*                *FC*     = FUNCTION CODE FOR RECOVERY REQUEST.
*                *MP*     = MAXIMUM PARAMETERS FOR REQUEST.
*                *RP*     = REQUIRED PARAMETERS FOR REQUEST.
*                *PR*     = PROCESSING ROUTINE FOR REQUEST.
*
*         EXIT   REMOTE CODE *CRFP*.
 
 
          PURGMAC RFP
 
 RFP      MACRO  SY,FC,MP,RP,PR
          LOCAL  A
          MACREF RFP
 .A       IFC    EQ,*SY*SYSTEM*
 A        SET    1
 .A       ELSE
 A        SET    0
 .A       ENDIF
 CRFP     RMT
          ORG    CRFC+FC
          VFD    1/A,23/0,6/MP,6/RP,6/0,18/PR
 CRFP     RMT
 RFP      ENDM
 
          SPACE  4,10
 CRFC     BSS    0           TABLE OF RECOVERY FUNCTION CODES
 
          RFP    SYSTEM,RFCA,0,0,CIL  *CALLTRN* INPUT LOGGING
          RFP    USER,RFRE,TREPL,TRERL,RUN  *RERUN*
          RFP    USER,RFRG,TRGPL,TRGRL,GET  *RGET*
          RFP    USER,RFRP,TRGPL,TRGRL,PUT  *RPUT*
          RFP    USER,RFRS,TSEPL,TRSEL,RSE  *RSECURE*
          RFP    USER,RFSE,TSEPL,TSERL,SEC  *SECURE*
          RFP    SYSTEM,RFSR,TSRPL,TSRRL,SRE  *SRERUN*
          RFP    SYSTEM,RFTI,TTIPL,TTIRL,TIN  *TINVOKE*
 CRFP     HERE
 RRP      SPACE  4,20
**        RRP - *REC* SYSTEM REQUEST PROCESSOR.
*
*         ENTRY  (X1) = SUBCP FL.
*                (X5) = SYSTEM REQUEST.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B5) = SUBCP RA.
*                (B7) = FWA OF SUBCP TABLE ENTRY.
*
*         EXIT   TO *TSSC*, IF RECOVERY NOT INSTALLED.
*                TO *TERR2*, IF INCORRECT PARAMETER LIST.
*                TO *TERR3*, IF INCORRECT FUNCTION.
*                TO *TERR11*, IF TASK NOT VALIDATED FOR REQUEST.
*                TO *RFB*, IF PROCESSING OF REQUEST SHOULD CONTINUE.
*
*         CALLS  DCPT, VTO, VUP.
*
*         USES   X - ALL.
*                A - 1, 2, 4.
*                B - 2, 3, 5, 6.
 
 
 RRP      LX5    17-35       RIGHT JUSTIFY FUNCTION CODE
          MX0    -6
 
*         IF ANY OF THE FOLLOWING ERRORS OCCUR THE TASK IS ABORTED -
*
*                1. INCORRECT FUNCTION
*                2. INCORRECT NUMBER OF PARAMETERS
*                3. PARAMETERS OUTSIDE RA AND FL
*                4. INCORRECT FUNCTION FOR TASK ORIGIN
 
          SX6    X5-TRECL
          PL     X6,TERR3    IF FUNCTION NOT IN TABLE, ABORT TASK
          SX6    X5-RFCA
          ZR     X6,TERR3    IF *CALLTRN* FUNCTION, ABORT TASK
          SA2    X5+CRFC     REQUEST SPECIFICATIONS
          AX2    24          REQUIRED NUMBER OF PARAMETERS
          BX6    -X0*X2
          SB6    X6
          AX2    6           MAXIMUM NUMBER OF PARAMETERS
          BX3    -X0*X2
          SB3    X3+
          LX5    59-59-17+35
          RJ     VUP         VALIDATE USER PARAMETERS
          SB6    B2+         NUMBER OF PARAMETERS PRESENT
          SB2    B5-NUAPL    SET TO TASK SYSTEM AREA
          NZ     X6,TERR2    IF INCORRECT PARAMETERS
          RJ     VTO         FIND TASK ORIGIN
          LX5    17-35       RIGHT JUSTIFY FUNCTION
          SA1    X5+CRFC     TASK ORIGIN ATTRIBUTE FOR REQUEST
          PL     X1,RRP1     IF REQUEST MAY BE USED BY ANY TASK
          NG     X6,TERR11   IF TASK NOT VALIDATED FOR REQUEST
 RRP1     SX3    X5          FUNCTION
          LX5    59-59-17+35
          SX0    X3-RFSR
          ZR     X0,RRP3     IF *SRERUN* FUNCTION
 
*         DROP CPU FOR SUBCP.  THE CPU WILL BE REQUESTED FOR SUBCP
*         WHEN THE RECOVERY FUNCTION COMPLETES.
 
 RRP2     SB5    B7          SAVE FWA OF SUBCP TABLE ENTRY
          RJ     DCPT        DROP CPU FOR TASK
          TX6    B5+CPAL,-VCPA  COMPUTE SUBCP
          AX6    SCPAL
          MX3    -CBTON
          SA1    B5+SCRAW    TASK RA
          SB5    X1+
          ERRNZ  SCRAS-17    IF RA NOT IN BITS 0-17
          SA4    B5-NUAPL+CB2C  TERMINAL ORDINAL
          LX4    CBTON-1-CBTOS  RIGHT JUSTIFY TERMINAL ORDINAL
          BX7    -X3*X4
          SB3    RCL         FWA TO QUEUE WORK FOR TASK
          SA5    B5-NUAPL+LRA1  RA REQUEST
          EQ     RFB         RECOVERY FUNCTION BEGIN PROCESSING
 
*         IF *SRERUN* SPECIFIES USERNAME AND TASK NOT ON SYSTEM LIBRARY
*         ABORT TASK.
 
 RRP3     PL     X6,RRP2     IF REQUEST FROM SYSTEM TASK
          GT     B6,B1,TERR11 IF USERNAME SPECIFIED
          ERRNZ  SRUS-1      USERNAME NOT SECOND PARAMETER
          EQ     RRP2        DROP CPU FOR TASK
 
 RTI      SPACE  4,20
**        RTI - RECOVER TERMINAL INPUT.
*
*         ENTRY  (B3)    = FWA OF FIRST COMMUNICATION BLOCK.
*                (CBTR)  = 1, IF TRANSACTION RESTARTED.
*                (CBRT)  = 1, IF TRANSACTION RECOVERABLE, OTHERWIZE 0.
*                (TSNR)  = 0, IF NON RECOVERABLE TRANSACTION RUN.
*                (CBTA)  = FWA OF TERMINAL IN *TST*.
*                (CBTO)  = TERMINAL ORDINAL IN *TST*.
*
*         EXIT   (CBLC) = 1, IF RECOVERY PROCESSING COMPLETE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 3, 4, 6, 7.
*                B - 3, 4.
*
*         CALLS  QTW.
 
 
 .A       IFGE   IPTAR,1
 RTI      SUBR               ENTRY/EXIT
 
*         IF TRANSACTION IS BEING RESTARTED DO NOT LOG INPUT
*         TO RECOVERY FILE.
 
          SA1    B3+CBTRW    TRANSACTION RESTART
          BX2    X1
          LX1    59-CBTRS
          NG     X1,RTI3     IF RESTARTED
          ERRNZ  CBTRW-CBRTW IF FIELDS IN DIFFERENT WORDS
          LX1    59-CBRTS-59+CBTRS
          PL     X1,RTI2     IF NON-RECOVERABLE
 
*         QUEUE TERMINAL LOGGING FOR LATER PROCESSING.
 
 RTI1     SX6    3RREC       SETUP RECOVERY REQUEST
          LX6    59-17
          SX2    RFCA        *CALLTRN* FUNCTION
          LX2    35-17
          BX6    X6+X2
          SX3    B3          FWA OF COMMUNICATION BLOCK
          BX6    X6+X3
          SA6    B3+CBQ1W+QRECW
          SA1    B3+CBTOW    TERMINAL ORDINAL
          MX4    CBTON
          ERRNZ  59-CBTOS    IF TERMINAL ORDINAL NOT LEFT JUSTIFIED
          BX7    X4*X1
          LX7    CBTON-1-CBTOS  RIGHT JUSTIFY TERMINAL ORDINAL
          MX1    1           SET RECOVERY STARTED COMPLETE
          LX1    QRSTS-59
          BX7    X1+X7
          SA7    B3+CBQ1W+QRTOW
          SX1    A7          RECOVERY LOGGING EVENT ADDRESS
          SX2    59-QRSTS    RECOVERY STARTED COMPLETION BIT
          BX3    X3-X3       NO SUBCP FOR EVENT
          BX5    X5-X5       NO TIME OUT FOR EVENT
          SB3    B3+CBQ1W    FWA OF STORAGE FOR EVENT QUEUING
          SX6    RFR         RETURN AT RECOVERY FUNCTION RESTART
          SX4    QTEV        QUEUE ON EVENT ONLY
          SB4    B0          QUEUE AT END OF QUEUE
          RJ     QTW         QUEUE *TAF* WORK
          EQ     RTIX        RETURN
 
*         SET NON-RECOVERABLE BIT IN TST.
 
 RTI2     SA3    B3+CBTAW    TERMINAL ADDRESS
          LX3    17-CBTAS
          ERRNZ  CBTAN-18    IF TERMINAL ADDRESS NOT 18 BITS
          SA4    X3+TSNRW    INDICATE NON-RECOVERABLE
          MX7    60-TSNRN
          LX7    TSNRS-TSNRN+1
          BX7    X7*X4
          SA7    A4          RESET TST WORD TSNRW
          EQ     RTIX        RETURN
 
*         INDICATE RECOVERY PROCESSING COMPLETE.
 
 RTI3     MX7    CBLCN
          LX7    CBLCS-59
          BX7    X7+X2
          SA7    A1
          ERRNZ  CBTRW-CBLCW IF RESTART AND LOGGING NOT IN SAME WORD
          EQ     RTIX        RETURN
 .A       ELSE
 RTI      SUBR               ENTRY/EXIT
 
*         WHEN RECOVERY IS NOT INSTALLED, INDICATE RECOVERY PROCESSING
*         IS COMPLETE.
 
          SA1    B3+CBLCW    RECOVERY LOGGING STATUS
          MX7    CBLCN
          LX7    CBLCS-59
          BX7    X7+X1       SET RECOVERY COMPLETE
          SA7    A1
          EQ     RTIX        RETURN
 .A       ENDIF
 RFB      SPACE  4,20
**        RFB - RECOVERY FUNCTION BEGIN PROCESSOR.
*
*         ENTRY  (X5) = RECOVERY REQUEST.
*                (X6) = SUBCP.
*                (X7) = TERMINAL STATUS TABLE ORDINAL.
*                (B3) = FWA TO QUEUE WORK FOR FUNCTION
*                       RELATIVE TO SUBCP.
*                (B5) = SUBCP RA.
*
*         EXIT   TO RECOVERY FUNCTION PROCESSOR.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 6.
*
*         CALLS  GRP, STF, STST, ZFN.
*
*         MACROS QTWCALL.
 
 RFB      SA6    RFBB        SAVE SUBCP
          SA7    RFBA        TERMINAL ORDINAL
          BX6    X5          SAVE SYSTEM REQUEST
          LX5    17-35       RIGHT JUSTIFY FUNCTION
          SA6    RFBC
          SX3    X5          FUNCTION
          LX5    59-59-17+35
          SX7    B3+         SAVE FWA OF QUEUE ENTRY
          SA7    RFBF
          SX2    B5          COMPUTE REQUEST ADDRESS RELATIVE TO *TAF*
          IX5    X5+X2
          SX0    X3-RFTI
          ZR     X0,RFB4     IF *TINVOKE* FUNCTION
          SX0    X3-RFSR
          ZR     X0,RFB6     IF *SRERUN* FUNCTION
 
*         SAVE RECOVERY PROCESSING PARAMETERS IN QUEUE ENTRY.
 
 RFB1     SA1    RFBA        TERMINAL STATUS TABLE ORDINAL
          SA2    RFBC        REQUEST
          SB6    B3+         FWA OF QUEUE ENTRY FOR NO SUBCP
          BX7    X1          SAVE TERMINAL STATUS TABLE ORDINAL
          BX6    X2          SAVE REQUEST IN QUEUE
          ZR     B5,RFB2     IF NO SUBCP
          SB6    B5-NUAPL    FWA OF TASK SYSTEM AREA
          SB6    B6+B3       FWA OF QUEUE ENTRY RELATIVE TO *TAF*
 RFB2     SA7    B6+QRTOW
          SA6    B6+QRECW
 .A       IFGE   IPTAR,1
 
*         DETERMINE RECOVERY FILE FOR TERMINAL.
*         SEVERAL RECOVERY FILES MAY BE USED TO SUPPORT
*         MULTI-MAINFRAME RECOVERY AND HIGHER PERFORMANCE.
 
 RFB3     RJ     STF         SEARCH TERMINAL FILES FOR TERMINAL ORDINAL
          SX6    X3+         TERMINAL ORDINAL RELATIVE TO RECOVERY FILE
          SA6    RFBD
 
*         IF RECOVERY FILE NOT LOCKED, LOCK RECOVERY FILE
*         AND START PROCESSING FUNCTION.
*         IF RECOVERY FILE LOCKED, QUEUE THE REQUEST.
 
          SA4    B4+TTLKW    LOCK STATUS
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          NG     X4,RFB5     IF FILE LOCKED
          MX7    TTLKN       SET RECOVERY FILE LOCKED
          BX6    X4+X7
          LX7    TTEVS-59
          ERRNZ  TTEVN-TTLKN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    -X7*X6      CLEAR FILE RELEASE EVENT
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          SA6    A4
 .A       ENDIF
 
*         PROCESS SPECIFIED FUNCTION.  ALL PROCESSORS RETURN
*         TO *RFC* WHEN COMPLETE.
 
 RFB4     SA5    RFBC        REQUEST
          LX5    17-35       FUNCTION
          SA1    X5+CRFC     RECOVERY FUNCTION PROCESSOR
          LX5    59-59-17+35
          SX2    B5          COMPUTE REQUEST ADDRESS RELATIVE TO *TAF*
          IX5    X5+X2
          SB6    X1
          JP     B6          PROCESS FUNCTION
 .A       IFGE   IPTAR,1
 
*         RECOVERY FILE IS LOCKED, SO QUEUE REQUEST.
 
RFB5      SX1    B4+TTEVW    FWA OF LOCK RELEASED EVENT
          SA3    RFBB        SUPCP
          SA4    RFBF        FWA OF QUEUE ENTRY
          SB3    X4
          SX5    B0          NO EVENT TIME OUT
          QTWCALL  TTEVS,QTEV  WAIT UNTIL LOCK IS RELEASED
          RJ     GRP         GET REQUEST PARAMETERS
          SA7    RFBA        TERMINAL ORDINAL IN TERMINAL STATUS TABLE
          SA6    RFBB        SUBCP
          SX3    B5
          IX6    X5-X3
          SA6    RFBC        REQUEST
          SX7    B3+
          SA7    RFBF        FWA OF QUEUE ENTRY RELATIVE TO SUBCP
          EQ     RFB3        SEARCH TERMINAL FILES
 .A       ENDIF
 
*         IF *SRERUN* HAS SPECIFIED A USER, DETERMINE TERMINAL STATUS
*         TABLE ORDINAL FOR USER.
 
 RFB6     SA1    X5+SRUS     FWA OF USER
          SA2    RFBE        BLANKS
          ZR     X1,RFB1     IF NO USER SPECIFIED
          SA1    X1+B5       USER
          BX3    X1-X2
          ZR     X3,RFB1     IF NO USER SPECIFIED
          RJ     ZFN         ZERO FILL USER NAME
          BX4    X1
          RJ     STST        SEARCH TERMINAL STATUS TABLE FOR USER
          SX6    TSUU        RECOVERY STATUS USER UNKNOWN
          ZR     X3,RFB7     IF USER UNKNOWN
          SX7    X3+         SAVE NEW TERMINAL STATUS TABLE ORDINAL
          ERRNZ  QRTOS-17    IF TERMINAL ORDINAL NOT IN BITS 17-0
          SA7    RFBA
          EQ     RFB1        DETERMINE RECOVERY FILE FOR TERMINAL
 
 RFB7     SA1    X5+SRST     FWA OF STATUS
          SA6    X1+B5       RETURN STATUS
          SB4    B0          DO NOT UNLOCK RECOVERY FILE
          EQ     RFC         PROCESS RECOVERY FUNCTION COMPLETE
 
 RFBA     BSS    1           TERMINAL ORDINAL IN TERMINAL STATUS TABLE
 RFBB     BSS    1           SUBCP
 RFBC     BSS    1           SYSTEM REQUEST
 RFBD     BSS    1           TERMINAL ORDINAL IN RECOVERY FILE
 RFBE     DATA   H
 RFBF     BSS    1           FWA OF QUEUE ENTRY FOR RECOVERY
 
 PFC      SPACE  4,15
**        RFC - RECOVERY FUNCTION COMPLETE PROCESSOR.
*
*         ENTRY  (B3) = FWA OF QUEUE ENTRY RELATIVE TO SUBCP.
*                (B4) = 0, IF RECOVERY FILE SHOULD NOT BE UNLOCKED.
*                     = FWA OF RECOVERY FILE ENTRY, IF FILE
*                       SHOULD BE UNLOCKED.
*                (RFBB) = SUBCP.
*
*         EXIT   TO *TSSC*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 6.
*
*         CALLS  RCPU, RSP.
 
 
 RFC      BSS    0
 .A       IFGE   IPTAR,1
          ZR     B4,RFC1     IF RECOVERY FILE SHOULD NOT BE UNLOCKED
 
*         UNLOCK RECOVERY FILE.
 
          SA4    B4          LOCK STATUS
          ERRNZ  TTLKW       IF LOCK FIELD NOT IN WORD ZERO
          MX7    -60+TTLKN
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          BX6    -X7*X4      CLEAR LOCK
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          LX7    TTEVS-59
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    X7+X6       SET FILE RELEASE EVENT
          SA6    A4
 RFC1     BSS    0
 .A       ENDIF
          SA2    RFBB        SUBCP
          ZR     X2,RFC2     IF NOT A SUBCP REQUEST
 
*         REQUEST CPU FOR SUBCP.
 
          LX2    SCPAL       COMPUTE SUBCP TABLE ADDRESS
          TA4    X2-CPAL,VCPA
          SB6    A4          FWA OF SUBCP TABLE ENTRY
          SX4    X4-NUAPL    FWA OF TASK SYSTEM AREA
          SB3    TSSC        RETURN ADDRESS AFTER REQUESTING CPU
          RJ     RSP         RESTORE SUBCP REGISTERS
          EQ     RCPU        REQUEST CPU FOR TASK
 
*         SET RECOVERY PROCESSING COMPLETE TO ALLOW WAITING
*         PROCESS TO CONTINUE.
 
 RFC2     MX7    QRTCN
          SA3    B3-CBQ1W+CBLCW  LOGGING COMPLETE STATUS
          LX7    CBLCS-59    SET LOGGING COMPLETE
          BX7    X7+X3
          SA7    A3
          EQ     TSSC        TIME SLICE SUBCP
 
 .A       IFGE   IPTAR,1
 PFR      SPACE  4,10
**         RFR - RECOVERY FUNCTION RESTART.
*
*         ENTRY  (B3) = FWA OF QUEUE ENTRY RELATIVE TO SUBCP.
*                (X2) = FIRST WORD OF QUEUE ENTRY.
*
*         EXIT   TO *RFB*.
*
*         USES    X - 1, 5.
*
*         CALLS  GRP.
 
 
 RFR      RJ     GRP         GET REQUEST PARAMETERS
          SX1    B5          COMPUTE REQUEST ADDRESS RELATIVE TO SUBCP
          IX5    X5-X1
          EQ     RFB         RECOVERY FUNCTION BEGIN PROCESSING
 .A       ENDIF
 CIL      SPACE  4,20
**        CIL - *CALLTRN* INPUT LOGGING.
*
*         ENTRY  (X5) = REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF QUEUE ENTRY FOR RECOVERY.
*
*         EXIT   TO *RFC*.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (RFBB) = SUBCP.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 5, 6.
*
*         CALLS  CFA, CRS, EXIT, FIO, FMH, GRP, IRU, MVE=, SCB, STF.
*
*         MACROS QTWCALL.
 
 
 .A       IFGE   IPTAR,1
 CIL      SA2    X5+CBTAW    FWA OF TERMINAL/USER
          LX2    17-CBTAS    RIGHT JUSTIFY TERMINAL ADDRESS
          ERRNZ  CBTAN-18    TERMINAL ADDRESS NOT 18 BITS
          MX0    TSTNN
          ERRNZ  TSTNS-59    TERMINAL NAME DOES NOT START AT BIT 59
          SA4    X2+TSTNW    TERMINAL NAME
          BX3    X0*X4
          RJ     IRU         INITIALIZE RECOVERY UNIT
          SX6    B0          INITIALIZE TO NO *SECURE* MESSAGE
          SA6    B4+TTBFW+TRUWL+MRIWL+TRMSW
 
*         LOG RECOVERABLE TRANSACTION INPUT TO RECOVERY FILE.
 
          SX6    B4+TTBFW+TRUWL+TRMWL  FWA OF COMMUNICATION BLOCKS
          SA6    CILC
 
*         FIND ALL COMMUNICATION BLOCKS FOR TRANSACTION.
 
          SX2    X5          FWA  OF COMMUNICATION BLOCK
 CIL1     ZR     X2,CIL2     IF END OF COMMUNICATION BLOCKS
          SA3    X2+CBNCW    FWA OF NEXT COMMUNICATION BLOCK
          ERRNZ  CBNCS-CBNCN+1  NEXT C. B. ADDRESS NOT RIGHT JUSTIFIED
          SX6    X3+         SAVE NEXT COMMUNICATION BLOCK ADDRESS
          SA6    CILA
 
*         MOVE COMMUNICATION BLOCK TO RECOVERY FILE BUFFER.
 
          SA3    CILC        DESTINATION OF MOVE
          SX1    CMBL        WORD COUNT OF MOVE
          IX6    X3+X1       COMPUTE NEXT MOVE DESTINATION
          SA6    A3
          RJ     MVE=
          SA2    CILA        FWA OF NEXT COMMUNICATION BLOCK
          EQ     CIL1        CONTINUE SEARCH OF COMMUNICATION BLOCKS
 
*         FORMAT RECOVERY UNIT STATUS INFORMATION.
 
 CIL2     SA2    X5+CBCSW    *CDCS* STATUS
          MX0    -CBCSN
          LX2    CBCSN-1-CBCSS  *CDCS* STATUS
          BX6    -X0*X2
          LX6    TRCCS-TRCCN+1  POSITION *CDCS* STATUS
          ERRNZ  CBCSW-CBRMW *CDCS* AND *CRM* NOT IN SAME WORD
          LX2    CBRMN-1-CBRMS-CBCSN+1+CBCSS  RIGHT JUSTIFY *CRM*
          BX3    -X0*X2
          ERRNZ  CBCSN-CBRMN *CDCS* AND *CRM* NOT THE SAME SIZE
          LX3    TRCRS-TRCRN+1  POSITION *CRM* STATUS
          ERRNZ  TRCRW-TRCCW *CRM* AND *CDCS* NOT IN SAME WORD
          BX6    X6+X3
          SX4    CSTI        STATUS IS RECOVERABLE INPUT
          LX4    TRCSS-TRCSN+1  POSITION *STEP* FIELD
          ERRNZ  TRCRW-TRCSW *CRM* AND *STEP* NOT IN SAME WORD
          BX6    X6+X4
          LX2    59-CBSBS-CBRMN+1+CBRMS
          ERRNZ  CBSBW-CBRMW *BRTAN* AND *CRM* NOT IN SAME WORD
          SX3    TYIT        TYPE IS INTERACTIVE TERMINAL
          NG     X2,CIL5     IF *BTRAN* TRANSACTION
          ERRNZ  TRCSW-TRTYW *STEP* AND *TRAN* NOT IN SAME WORD
 CIL3     LX3    TRTYS-TRTYN+1  POSITION *TRAN* FIELD
          BX6    X6+X3
          SA6    B4+TTBFW+TRTYW
          SA1    X5+CBTSW    TRANSACTION SEQUENCE NUMBER
          MX0    -CBTSN      MASK FOR SEQUENCE NUMBER
          LX1    CBTSN-1-CBTSS  RIGHT JUSTIFY SEQUENCE NUMBER
          BX7    -X0*X1
          SA7    B4+TTBFW+TRCNW
 
*         FORMAT MESSAGE HEADER FOR TRANSACTION INPUT.
 
          MX0    -TSCNN      GET APPLICATION BLOCK HEADER
          SA1    X5+CBTAW    TERMINAL ADDRESS
          AX1    CBTAS-17
          SA2    X1+TSCNW    APPLICATION CONNECTION NUMBER
          LX2    TSCNN-1-TSCNS  RIGHT JUSTIFY CONNECTION NUMBER
          BX2    -X0*X2
          SX7    B0+         SET NO APPLICATION BLOCK HEADER
          ZR     X2,CIL4     IF NO CONNECTION NUMBER
          SX3    TNCTL       NETWORK COMMUNICATION TABLE ENTRY LENGTH
          IX4    X2*X3
          SX4    X4+TNAHW
          TX3    X4,VNCT
          SA4    X3          APPLICATION BLOCK HEADER
          BX7    X4
 CIL4     SA1    CILC        COMPUTE MESSAGE LENGTH
          SX2    B4+TTBFW+TRUWL+TRMWL
          IX1    X1-X2
          SX3    MSTM        MESSAGE SOURCE IS TRANSACTION MESSAGE
          SX4    B1          MESSAGE UNIT IS WORDS
          SB6    B4+TTBFW+TRUWL  FWA OF MESSAGE HEADER
          RJ     FMH         FORMAT MESSAGE HEADER
 
*         WRITE RECOVERY UNIT TO RECOVERY FILE.  THE *TSTAT* AND
*         *SECURE* DATA ARE INITIALIZED.
 
          SX1    MSST        MESSAGE SOURCE IS STATUS
          SA2    RFBD        TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS FOR STATUS
          SX2    TRUPL+MRIPL+TRMPL  LENGTH IN PRUS TO WRITE
          SX5    B4+TTFTW    FWA OF FET
          SX1    CIORW       *CIO* REWRITE
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         OUTPUT IS COMPLETE.
 
          SA3    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X3+
          SX1    B4+TTFTW    FWA OF OUTPUT COMPLETE EVENT
          SX3    B0          NO SUBCP
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT FOR OUTPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS FOR *CALLTRN*
          SA6    RFBB        SAVE SUBCP
          RJ     STF         SEARCH TERMINAL FILES FOR TERMINAL ORDINAL
          SX2    TSTLLE      TST ENTRY LENGTH
          IX4    X2*X1       OFFSET INTO TST
          TA2    X4+TSNRW,VTST  INDICATE RECOVERABLE
          MX0    -TSNRN
          LX0    TSNRS-TSNRN+1
          BX6    -X0+X2
          SA6    A2          RESET TST WORD TSNRW
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
          EQ     RFC         RECOVERY FUNCTION COMPLETE PROCESSING
 
 CIL5     SX3    TYBT        *BTRAN* TRANSACTION
          EQ     CIL3        PUT TRANSACTION TYPE IN RECOVERY UNIT
 
 CILA     BSS    1           FWA OF NEXT COMMUNICATION BLOCK
 CILC     BSS    1           FWA FOR INPUT IN RECOVERY BUFFER
 .A       ELSE
 CIL      RJ     EXIT        ERROR IF ROUTINE IS CALLED
 .A       ENDIF
 GET      SPACE  4,20
**        GET - *RGET* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*
*         EXIT   TO *RFC*.
*                (RFBB) = SUBCP.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3.
*
*         CALLS  CFA, CML, CMU, CRS, CRU, CTF, FIO, GRP, MVD, STF.
*
*         MACROS QTWCALL.
 
 
 .A       IFGE   IPTAR,1
 GET      RJ     CRU         CHECK RECOVERY UNIT FOR LEGAL RANGE
          NZ     X6,GET2     IF INCORRECT RECOVERY UNIT INDEX
 
*         READ USER *RPUT* MESSAGE FROM RECOVERY FILE.
 
          SA2    RFBD        TERMINAL ORDINAL FOR RECOVERY FILE
          SX1    MSRM        MESSAGE SOURCE IS *RPUT* MESSAGE
          RJ     CFA         COMPUTE FILE ADDRESS
          SX5    B4+TTFTW    FWA OF FET
          SA4    B4+TTNPW    PRUS IN USER MESSAGE
          SX1    CIORD       *CIO* READ FUNCTION
          MX0    -TTNPN      MASK FOR PRUS IN USER MESSAGE
          LX4    TTNPN-1-TTNPS  RIGHT JUSTIFY PRUS
          BX2    -X0*X4
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         INPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF INPUT COMPLETE EVENT
          SA3    RFBB        SUBCP
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER RESTART
          SA6    RFBB        SAVE SUBCP
          RJ     STF         SEARCH TERMINAL FILES FOR ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
 
*         IF NO MESSAGE WAS RECORDED BY *RPUT*, RETURN NO MESSAGE
*         STATUS TO TASK.
 
          SX6    TSNM        RECOVERY STATUS NO MESSAGE
          SA2    B4+TTBFW+TRMSW  MESSAGE SOURCE
          MX0    -TRMSN
          ERRNZ  TRMSN-TRMUN IF MESSAGE SOURCE .NE. UNITS FIELD LENGTH
          LX2    TRMSN-1-TRMSS  RIGHT JUSTIFY MESSAGE SOURCE
          BX3    -X0*X2
          ZR     X3,GET2     IF NO MESSAGE
 
*         IF *RGET* MESSAGE UNIT IS  NOT EQUAL TO *RPUT* MESSAGE
*         UNIT, RETURN MESSAGE UNIT CONFLICT STATUS TO TASK.
 
          ERRNZ  TRMUW-TRMSW IF MESSAGE SOURCE .NE. UNITS FIELD WORD
          LX2    TRMUN-1-TRMUS+TRMSS-TRMSN+1  MESSAGE UNITS
          BX7    -X0*X2
          SA1    X5+RGMU     FWA OF USER MESSAGE UNITS
          ZR     X1,GET1     IF PARAMETER NOT SPECIFIED
          SA1    X1+B5       USER MESSAGE UNIT
 GET1     RJ     CMU         CHECK MESSAGE UNIT
          NZ     X6,GET2     IF INCORRECT MESSAGE UNIT
          IX7    X4-X7       USER UNITS - FILE UNITS
          SX6    TSPG        RECOVERY STATUS MESSAGE CONFLICT
          NZ     X7,GET2     IF USER UNITS .NE. FILE UNITS
 
*         IF MESSAGE FROM RECOVERY FILE WILL NOT FIT IN USER
*         AREA OR TASK FL RETURN MESSAGE WILL NOT FIT STATUS
*         TO TASK.
 
          MX0    -TRMLN      MASK FOR MESSAGE LENGTH
          LX2    TRMLN-1-TRMLS+TRMUS-TRMUN+1
          SA1    X5+RGML     FWA OF USER MESSAGE LENGTH
          SA1    X1+B5       USER MESSAGE LENGTH
          BX7    -X0*X2
          SX6    TSMU        RECOVERY STATUS MESSAGE .GR. USER AREA
          SA7    A1          RETURN LENGTH TO USER
          IX0    X1-X7       USER LENGTH - FILE LENGTH
          BX3    X7          FILE MESSAGE LENGTH
          NG     X0,GET2     IF FILE LENGTH .GR. USER AREA
          RJ     CML         COMPUTE MESSAGE LENGTH IN WORDS
          SA2    RFBB        SUBCP
          SA3    X5+RGMA     FWA OF MESSAGE RELATIVE TO TASK
          SX3    X3
          BX4    X6          SAVE REMAINDER OVER WORD
          RJ     CTF         CHECK TASK FIT FOR MESSAGE
          NZ     X6,GET2     IF MESSAGE DOES NOT FIT IN FL
          BX6    X4          RESTORE REMAINDER OVER WORD BOUNDARY
 
*         MOVE MESSAGE TO TASK.
 
          SX3    B5+X3       FWA OF MESSAGE RELATIVE TO *TAF*
          SX2    B4+TTBFW+TRMWL  FWA OF MESSAGE ORIGIN
          RJ     MVD         MOVE MESSAGE TO TASK
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 
*         RETURN STATUS TO TASK.
 
 GET2     SA4    X5+RGST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         COMPLETE PROCESSING FOR RECOVERY FUNCTION
 .A       ELSE
 GET      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+RGST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         COMPLETE PROCESSING FOR RECOVERY FUNCTION
 .A       ENDIF
 RPUT     SPACE  4,20
**        PUT - *RPUT* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBB) = SUBCP.
*                (RFBF) = FWA OF RECOVERY FILE QUEUE ENTRY.
*
*         EXIT   TO *RFC*.
*                (RFBB) = SUBCP.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  CFA, CMF, CML, CMU, CRS, CRU, FIO, FMH, GRP, MVE=,
*                STF.
*
*         MACROS QTWCALL.
 
 
 .A       IFGE   IPTAR,1
 PUT      RJ     CRU         CHECK RECOVERY UNIT FOR LEGAL RANGE
 
*         CHECK *RPUT* FOR VALID -
*
*                1.  INDEX
*                2.  MESSAGE UNIT
*                3.  MESSAGE SIZE.
*
*         IF ANY OF THE ABOVE PARAMETERS ARE INCORRECT
*         RETURN STATUS TO TASK.
 
          NZ     X6,PUT2     IF INCORRECT RECOVERY UNIT INDEX
          SA1    X5+RGMU     FWA OF MESSAGE UNITS
          ZR     X1,PUT1     IF MESSAGE UNIT NOT SPECIFIED
          SA1    X1+B5       MESSAGE UNITS
 PUT1     RJ     CMU         CHECK MESSAGE UNIT
          NZ     X6,PUT2     IF INCORRECT MESSAGE UNIT
          SA2    X5+RGML     FWA OF MESSAGE LENGTH
          SA3    X2+B5       MESSAGE LENGTH
          RJ     CML         COMPUTE MESSAGE LENGTH
          BX7    X1          SAVE MESSAGE LENGTH IN WORDS
          SA7    PUTA
          RJ     CMF         CHECK MESSAGE FIT IN RECOVERY FILE
          NZ     X6,PUT2     IF USER MESSAGE DOES NOT FIT IN FILE
 
*         MOVE USER MESSAGE TO RECOVERY FILE BUFFER.
 
          SX7    B0          NO APPLICATION BLOCK HEADER
          SX1    X3          LENGTH IN MESSAGE UNITS
          SX3    MSRM        MESSAGE SOURCE IS *RPUT* MESSAGE
          SB6    B4+TTBFW    FWA OF MESSAGE HEADER
          RJ     FMH         FORMAT MESSAGE HEADER
          SA2    X5+RGMA     FWA OF MESSAGE RELATIVE TO TASK
          SX2    X2+B5       FWA OF ORIGIN RELATIVE TO *TAF*
          SX3    B4+TTBFW+TRMWL  FWA OF DESTINATION
          SA1    PUTA        MESSAGE LENGTH IN WORDS
          RJ     MVE=        MOVE USER MESSAGE TO RECOVERY BUFFER
 
*         WRITE *RPUT* MESSAGE TO RECOVERY FILE.
 
          SX1    MSRM        MESSAGE SOURCE IS *RPUT* MESSAGE
          SA2    RFBD        TERMINAL ORDINAL FOR RECOVERY FILE
          SA4    X5+RGIN     FWA OF USER RECOVERY UNIT INDEX
          SA3    X4+B5       RECOVERY UNIT INDEX
          RJ     CFA         COMPUTE FILE ADDRESS
          SX5    B4+TTFTW    FWA OF FET
          SA2    PUTA        COMPUTE MESSAGE LENGTH IN PRUS
          SX2    X2+77B+TRMWL  ROUND UP 1 PRU + MESSAGE HEADER
          SX1    CIORW       *CIO* REWRITE REQUEST
          AX2    6
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         OUTPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF EVENT
          SA3    RFBB        SUBCP
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT ON BIT 0 OF FET
          RJ     GRP         GET REQUEST PARAMETERS
          SA6    RFBB        SAVE SUBCP
          RJ     STF         SEARCH TERMINAL FILE FOR TERMINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 
*         RETURN STATUS TO TASK.
 
 PUT2     SA4    X5+RGST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         COMPLETE PROCESSING FOR RECOVERY FUNCTION
 
 PUTA     BSS    1           LENGTH OF MESSAGE IN WORDS
 .A       ELSE
 PUT      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+RGST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         COMPLETE PROCESSING FOR RECOVERY FUNCTION
 
 .A       ENDIF
 RSE     SPACE  4,20
**        RSE - *RSECURE* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF RECOVER FILE QUEUE ENTRY.
*
*         EXIT   TO *RFC*.
*                (RFBB) = SUBCP.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  CFA, CML, CMU, CRS, CTF, FIO, GRP, MVD, STF.
*
*         MACROS QTWCALL.
 
 
 .A       IFGE   IPTAR,1
 RSE      SX1    MSSM        MESSAGE SOURCE IS *SECURE* MESSAGE
 
*         READ *RSECURE* MESSAGE FROM RECOVERY FILE.
 
          SA2    RFBD        TERMINAL ORDINAL FOR RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS
          SX5    B4+TTFTW    FWA OF FET
          SA4    B4+TTNPW    PRUS IN *SECURE* MESSAGE
          SX1    CIORD       *CIO* READ FUNCTION
          MX0    -TTNPN      MASK FOR PRUS
          LX4    TTNPN-1-TTNPS  RIGHT JUSTIFY PRUS
          BX2    -X0*X4
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         INPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF EVENT FOR INPUT COMPLETE
          SA3    RFBB        SUBCP
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SA6    RFBB        SAVE SUBCP
          RJ     STF         SEARCH TERMINAL FILES FOR ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
 
*         RETURN MESSAGE LENGTH, UNIT, FORMAT EFFECTOR, AND
*         TRANSPARENT MODE TO TASK.
 
          SX6    TSNM        RECOVERY STATUS NO MESSAGE
          SA4    B4+TTBFW+TRMSW  MESSAGE SOURCE
          MX0    -TRMSN
          LX4    TRMSN-1-TRMSS  RIGHT JUSTIFY MESSAGE SOURCE
          BX3    -X0*X4
          ZR     X3,RSE1     IF NO MESSAGE
          ERRNZ  TRMSW-TRMLW IF SOURCE AND LENGTH NOT IN SAME WORD
          ERRNZ  TRMLW-TRMUW IF LENGTH AND UNIT NOT IN SAME WORD
          LX4    TRMLN-1-TRMLS+TRMSS-TRMSN+1
          MX0    -TRMLN      MASK FOR MESSAGE LENGTH
          BX6    -X0*X4      MESSAGE LENGTH
          SA1    X5+SEML     FWA OF TASK MESSAGE LENGTH
          SA3    X1+B5       USER MESSAGE LENGTH
          SA6    X1+B5       RETURN MESSAGE LENGTH
          SA6    RSEA
          BX7    X3          SAVE USER MESSAGE LENGTH
          LX4    TRMUN-1-TRMUS+TRMLS-TRMLN+1  MESSAGE UNITS
          MX3    -TRMUN      MASK FOR MESSAGE UNITS
          SA7    RSEB
          BX7    -X3*X4      MESSAGE UNITS
          SA2    X5+SEMU     FWA OF TASK MESSAGE UNITS
          SA1    X2+B5       USER MESSAGE UNITS
          RJ     CMU         CHECK MESSAGE UNITS
          NZ     X6,RSE1     IF INCORRECT MESSAGE UNITS
          SA7    X2+B5       RETURN MESSAGE UNITS
          SA7    RSEC
          BX6    X4          SAVE USER MESSAGE UNITS
          SA6    RSED
          SA4    B4+TTBFW+TRMHW  APPLICATION BLOCK HEADER
          MX0    -AHNFN
          ERRNZ  AHNFN-AHPTN IF FORMAT AND TRANSPARENT FIELDS UNEQUAL
          LX4    AHNFN-1-AHNFS  RIGHT JUSTIFY FORMAT EFFECTOR
          BX6    -X0*X4      FORMAT EFFECTOR
          SA2    X5+SEFE     FWA OF TASK FORMAT EFFECTOR
          SA6    X2+B5       RETURN FORMAT EFFECTOR TO TASK
          LX4    AHPTN-1-AHPTS+AHNFS-AHNFN+1  RIGHT JUSTIFY MODE
          BX7    -X0*X4      TRANSPARENT MODE
          SA3    X5+SETM     FWA OF TASK TRANSPARENT MODE
          SA7    X3+B5       RETURN TRANSPARENT MODE
 
*         IF MESSAGE DOES NOT FIT IN TASK USER AREA OR TASK
*         FL RETURN MESSAGE DOES NOT FIT STATUS TO TASK.
 
          SA3    RSEB        USER MESSAGE LENGTH
          SA4    RSED        USER MESSAGE UNITS
          MX0    -6
          SX4    X4-2        COMPUTE BITS IN USER MESSAGE
          SX1    6
          IX1    X4*X1
          SB6    X1
          SX2    61410B      BITS PER MESSAGE UNIT
          AX2    B6
          BX2    -X0*X2
          IX1    X2*X3       NUMBER OF BITS FOR USER AREA
          SA3    RSEA        FILE MESSAGE LENGTH
          SA4    RSEC        FILE MESSAGE UNIT
          SX6    X4-2        COMPUTE BITS IN FILE MESSAGE
          SX2    6
          IX2    X6*X2
          SB6    X2
          SX2    61410B      BITS PER MESSAGE UNIT
          AX2    B6
          BX2    -X0*X2
          IX0    X2*X3       NUMBER OF BITS IN *RSECURE* MESSAGE
          IX7    X1-X0       USER LENGTH - MESSAGE LENGTH
          SX6    TSMU        RECOVERY STATUS MESSAGE .GR. USER AREA
          NG     X7,RSE1     IF MESSAGE DOES NOT FIT IN USER AREA
          RJ     CML         COMPUTE FILE MESSAGE LENGTH IN WORDS
          SA2    RFBB        SUBCP
          SA3    X5+SEMA     FWA OF MESSAGE
          BX4    X6
          SX3    X3
          RJ     CTF         CHECK MESSAGE FIT IN TASK FL
          NZ     X6,RSE1     IF MESSAGE DOES NOT FIT IN TASK FL
          BX6    X4          RESTORE REMAINDER OVER WORD
 
 
*         MOVE *SECURE* MESSAGE TO TASK.
 
          SX2    B4+TTBFW+TRMWL  FWA OF MESSAGE ORIGIN
          SX3    B5+X3       DESTINATION RELATIVE TO *TAF*
          RJ     MVD         MOVE MESSAGE TO TASK
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 
*         RETURN STATUS TO TASK.
 
 RSE1     SA4    X5+SEST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS TO TASK
          EQ     RFC         RECOVERY FUNCTION COMPLETE PROCESSING
 
 RSEA     BSS    1           FILE MESSAGE LENGTH IN MESSAGE UNITS
 RSEB     BSS    1           USER MESSAGE LENGTH IN MESSAGE UNITS
 RSEC     BSS    1           FILE MESSAGE UNIT
 RSED     BSS    1           USER MESSAGE UNIT
 .A       ELSE
 RSE      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+SEST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS TO TASK
          EQ     RFC         RECOVERY FUNCTION COMPLETE PROCESSING
 .A       ENDIF
 RUN      SPACE  4,20
**        RUN - *RERUN* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBA) = TERMINAL ORDINAL.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF RECOVERY QUEUE ENTRY.
*                EVCB = FWA OF COMMUNICATION BLOCK EVENT.
*
*         EXIT   TO *RFC* IF UNABLE TO RERUN.
*                TO *TSSC OTHERWISE.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         USES   A - 1, 2, 3, 6.
*                X - 1, 2, 3, 6.
*                B - 5, 6.
*
*         CALLS  ASN, PSU, RSC.
 
 
 .A       IFGE   IPTAR,1
 RUN      BSS    0           ENTRY
          SA2    B5-NUAPL+CB2C  CHECK FOR RECOVERABLE TRANSACTION
          SA2    X2+CBRTW
          LX2    59-CBRTS
          PL     X2,RUN1     IF NOT RECOVERABLE
          SX6    B4+         FWA OF RECOVERY FILE ENTRY
          SA6    PSUA
          SA1    RFBA        GET TERMINAL ORDINAL
          RJ     ASN         ASSIGN SEQUENCE NUMBER
          SA2    B5-NUAPL+TRID
          SA6    A2
          BX6    X2
          SA6    RUNB        SAVE OLD ID
          SA2    B5-NUAPL+CB2C
          SX6    B5          SAVE SUBCP
          SX2    X2
          SA6    RUNA
          RJ     RSC         RELEASE SECONDARY C.B.
          SA2    RUNA
          SB5    X2          RESTORE SUBCP RA
          SB6    NCBC-1      NUMBER OF C.B.-S TO RESERVE
          RJ     PSU         PROCESS USER *RERUN* FUNCTION
          SA3    RUNB        RESTORE OLD ID
          SA2    RUNA
          BX6    X3
          SA6    X2-NUAPL+TRID
          NZ     X1,RFC      IF UNABLE TO RERUN
          SA2    RFBB        SUBCP NUMBER
          LX2    SCPAL
          MX3    SCTMN
          TA2    X2-CPAL+SCTMW,VCPA
          LX3    SCTMS-59
          BX6    X3+X2
          SA6    A2          UPDATE SUBCP TABLE WORD TWO
          EQ     RFC         COMPLETE PROCESSING
 
 RUN1     SX6    TSNO        NOT RERUNNABLE STATUS
          SA1    X5+REST
          SA6    X1+B5       SAVE STATUS
          EQ     RFC         COMPLETE PROCESSING
 
 RUNA     BSS    1           (B5) SUBCP RA
 RUNB     BSS    1           SUBCP SEQUENCE NUMBER.
 .A       ELSE
 RUN      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+REST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         RECOVERY PROCESSING COMPLETE
 .A       ENDIF
 SEC     SPACE  4,20
**        SEC - *SECURE* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF RECOVERY QUEUE ENTRY.
*
*         EXIT   TO *RFC*.
*                (RFBB) = SUBCP.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         EXIT   TO *RFC*.
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  CFA, CMF, CML, CMU, CRS, FIO, FMH, GRP, MVE=,
*                REM, SEL, STF.
*
*         MACROS QTWCALL.
 
 
 .A       IFGE   IPTAR,1
 SEC      SA1    X5+SEMU     FWA OF *SECURE* MESSAGE UNIT
          SX0    X1+
          ZR     X1,SEC1     IF NO MESSAGE UNIT SPECIFIED
 
*         IF INCORRECT MESSAGE UNIT, RETURN INCORRECT MESSAGE UNIT
*         STATUS TO TASK.
 
          SA1    X1+B5       MESSAGE UNIT
 SEC1     RJ     CMU         CHECK MESSAGE UNIT
          NZ     X6,SEC5     IF INCORRECT MESSAGE UNITS
          SA1    X5+SEML     FWA OF MESSAGE LENGTH
          SX2    B0          DEFAULT IS NON-TRANSPARENT MODE
          SA1    X1+B5       MESSAGE LENGTH
 
*         BUILD *NAM* APPLICATION BLOCK HEADER.
*         THE TASK REQUEST MAY SUPPLY FORMAT EFFECTOR AND
*         TRANSPARENT MODE PARAMETERS.  IF INCORRECT PARAMETERS
*         RETURN STATUS TO TASK.
 
          BX7    X1
          MX3    60-AHLCN
          LX7    AHLCS-AHLCN+1  POSITION MESSAGE LENGTH
          SX6    TSLS        RECOVERY STATUS LENGTH EXCEEDS *SEND*
          BX3    X3*X7
          NZ     X3,SEC6     IF MESSAGE LENGTH EXCEEDS 12 BITS
          SX3    B1+         DEFAULT IS NO FORMAT EFFECTOR
          ZR     X0,SEC3     IF NO MESSAGE UNIT SPECIFIED
          SA1    X5+SEFE     FWA OF FORMAT EFFECTOR
          ZR     X1,SEC3     IF NO FORMAT EFFECTOR SPECIFIED
          SA3    X1+B5       FORMAT EFFECTOR
          ZR     X3,SEC2     IF FORMAT EFFECTOR
          SX0    X3-1
          SX6    TSIM        RECOVERY STATUS INCORRECT FORMAT EFFECTOR
          NZ     X0,SEC5     IF INCORRECT FORMAT EFFECTOR
 SEC2     SA1    X5+SETM     FWA OF TRANSPARENT MODE
          ZR     X1,SEC3     IF TRANSPARENT MODE NOT SPECIFIED
          SA2    X1+B5       TRANSPARENT MODE
          ZR     X2,SEC3     IF NON TRANSPARENT MODE
          SX0    X2-1
          SX6    TSIT        RECOVERY STATUS INCORRECT TRANSPARENT MODE
          NZ     X0,SEC5     IF INCORRECT TRANSPARENT MODE
 SEC3     LX2    AHPTS-0     POSITION TRANSPARENT MODE
          BX7    X7+X2
          LX3    AHNFS-0     POSITION FORMAT EFFECTOR
          BX7    X7+X3
          LX4    AHCTS-AHCTN+1  POSITION APPLICATION CHARACTER TYPE
          BX7    X7+X4
          SX3    BTMS        SET MESSAGE BLOCK TYPE
          LX3    AHBTS-AHBTN+1  POSITION BLOCK TYPE
          BX7    X7+X3       APPLICATION BLOCK HEADER
          SA7    B5-NUAPL+SECH
 
*         COMPUTE MESSAGE LENGTH IN WORDS.  IF MESSAGE UNIT IS DISPLAY
*         COMPLETE MESSAGE WITH AN END OF LINE BYTE.
 
          MX0    -AHLCN
          LX4    59-59-AHCTS+AHCTN-1
          BX3    -X0*X7      LENGTH OF MESSAGE IN MESSAGE UNITS
          SB3    X3
          ERRNZ  AHLCS-AHLCN+1  IF LENGTH NOT RIGHT JUSTIFIED
          RJ     CML         COMPUTE MESSAGE LENGTH IN WORDS AND BITS
          SX0    X4-4
          SA3    X5+SEMA     FWA OF MESSAGE
          SA2    SECA        *SEND* REQUEST WORD 1
          LX3    47-17       POSITION MESSAGE FWA
          SB6    X6          REMAINDER OF MESSAGE OVER WORD BOUNDARY
          BX6    X3+X2
          LX3    59-59-47+17
          BX6    X6+X1       ADD LENGTH OF MESSAGE
          SA6    B5-NUAPL+SECR  SAVE *SEND* REQUEST WORD 1
          NZ     X0,SEC4     IF NOT DISPLAY MESSAGE UNIT
          SX3    X3+B5       FWA OF MESSAGE RELATIVE TO *TAF*
          RJ     SEL         SET END LINE
          MX0    60-AHLCN    COMPUTE NEW MESSAGE LENGTH
          SX3    10          10 CHARACTERS PER WORD
          BX7    X0*X7       CLEAR OLD MESSAGE LENGTH
          IX6    X1*X3       NEW LENGTH
          BX7    X6+X7
 
*         IF MESSAGE CANNOT BE SENT, RETURN MESSAGE CANNOT BE SENT
*         STATUS TO TASK.
 
 SEC4     SX6    TSLS        RECOVERY STATUS LENGTH EXCEEDS *SEND*
          SX0    X1-MAXWS
          PL     X0,SEC6     IF MESSAGE CANNOT BE SENT
          SX6    TSTM        RECOVERY STATUS LENGTH EXCEEDS TRANSACTION
          SA3    B5-NUAPL+TOWC  TOTAL OUTPUT WORD COUNT
          IX0    X1+X3       ADD NEW MESSAGE
          SX3    X0-MAXTO
          PL     X3,SEC6     IF LENGTH EXCEEDS TRANSACTION MAXIMUM
          RJ     CMF         CHECK MESSAGE FIT IN RECOVERY FILE
          NZ     X6,SEC6     IF MESSAGE DOES NOT FIT IN FILE
          SB6    B4+TTBFW    FWA OF MESSAGE HEADER IN BUFFER
          SX6    X1          SAVE MESSAGE LENGTH IN WORDS
          SX1    B3          MESSAGE LENGTH IN SPECIFIED UNITS
          SA6    SECB
          SX3    MSSM        MESSAGE SOURCE IS *SECURE* MESSAGE
          RJ     FMH         FORMAT MESSAGE HEADER
 
*         MOVE *SECURE* MESSAGE TO RECOVERY FILE BUFFER.
 
          SA4    X5+SEMA     FWA OF *SECURE* MESSAGE
          SX2    X4+B5       FWA OF MESSAGE RELATIVE TO *TAF*
          SX3    B4+TTBFW+TRMWL  FWA OF DESTINATION
          SA1    SECB        MESSAGE LENGTH IN WORDS
          RJ     MVE=        MOVE MESSAGE
 
*         WRITE *SECURE* MESSAGE TO RECOVERY FILE.
 
          SX1    MSSM        MESSAGE SOURCE IS *SECURE* MESSAGE
          SA2    RFBD        TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS
          SX5    B4+TTFTW    FWA OF FET
          SA2    SECB        COMPUTE MESSAGE LENGTH IN PRUS
          SX1    CIORW       *CIO* REWRITE
          SX2    X2+77B
          AX2    6
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         OUTPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF EVENT IS FET
          SA3    RFBB        SUBCP OF EVENT
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  0,QTEV    WAIT ON BIT 0 OF FET
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SA6    RFBB        SAVE SUBCP
          RJ     STF         SEARCH TERMINAL FILE FOR ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 
*         IF MESSAGE USES DISPLAY MESSAGE UNITS, RESTORE CHARACTERS
*         USED BY END OF LINE BYTE.
 
          SA1    B5-NUAPL+SECH  APPLICATION BLOCK HEADER
          SA2    B5-NUAPL+SECR  *SEND* REQUEST FOR *SECURE*
          RJ     REM         RESTORE END OF MESSAGE
 
*         SET MESSAGE SENT FLAG IN TASK SYSTEM AREA.
 
          SA1    B5+CB1C     INDICATE TRANSACTION SEND
          MX7    CBSDN
          LX7    CBSDS-59
          BX7    X1+X7
          SA7    A1
 
*         RETURN STATUS TO TASK.
 
 SEC5     SA4    X5+SEST     FWA OF *SECURE* STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         COMPLETE PROCESSING FOR RECOVERY FUNCTION
 
 SEC6     SX7    B0+         CLEAR *SECURE* REQUEST PRESENT
          SA7    B5-NUAPL+SECR
          EQ     SEC5        RETURN STATUS TO TASK
 
*         WORD 1 OF *SEND* REQUEST FOR *SECURE* MESSAGE.
*         THE *SEND* IS DONE WITH FINAL BLOCK FLAG SET AND AN *ABH*
*         SPECIFIED.  THE *SEND* WILL BE DONE DURING
*         TRANSACTION CEASE PROCESSING.
 
 SECA     VFD    1/0,1/1,3/0,1/1,1/1,5/0,18/0,18/0,12/0
 SECB     BSS    1           MESSAGE LENGTH IN WORDS
 .A       ELSE
 SEC      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+SEST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS TO TASK
          EQ     RFC         RECOVERY FUNCTION COMPLETE
 .A       ENDIF
 SRE     SPACE  4,20
**        SRE - *RERUN* FUNCTION PROCESSING.
*
*         ENTRY  (X5) = SYSTEM REQUEST.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF RECOVERY QUEUE ENTRY.
*                EVCB = FWA OF COMMUNICATION BLOCK EVENT.
*
*         EXIT   TO *RFC*, IF RECOVERY FUNCTION COMPLETE.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (RFBB) = SUBCP.
*
*         USES   X - 0, 4, 6.
*                A - 4, 6.
*                B - 6.
*
*         CALLS  PSU, RFC.
 
 
 .A       IFGE   IPTAR,1
 SRE      BSS    0           ENTRY
          MX6    CBLKN       SET TERMINAL LOCK FLAG
          SA4    B5-NUAPL+CB1C
          LX6    CBLKS-59
          BX6    X4+X6
          SA6    A4
          SX6    B4+         SAVE FWA OF RECOVERY FILE ENTRY
          SA6    PSUA
          SB6    -NCBC+1     COMPLEMENT OF NUMBER OF C.B.-S TO RESERVE
          RJ     PSU         PROCESS SYSTEM *RERUN*
          EQ     RFC         RECOVERY FUNCTION COMPLETE
 
 .A       ELSE
 SRE      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+REST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         RECOVERY PROCESSING COMPLETE
 .A       ENDIF
 TIN      SPACE  4,15
**        TIN - *TINVOKE* FUNCTION PROCESSING.
*
*         USES  X - 0, 1, 4, 6.
*                A - 1, 4, 6.
*                B - 4.
*
*         EXIT   TO *RFC*.
*                (B4) = 0.
*
*         CALLS  ASN.
 
 
 .A       IFGE   IPTAR,1
 TIN      SA1    X5+TIOI     FWA OF OLD IDENTIFIER
          ZR     X1,TIN2     IF OLD IDENTIFIER NOT SPECIFIED
          SA4    X1+B5       OLD IDENTIFIER
 
*         IF NO OLD IDENTIFIER ASSIGN A NEW IDENTIFIER, ELSE
*         ASSIGN OLD IDENTIFIER TO TRANSACTION.
 
          BX6    X4          SET NEW IDENTIFER .EQ. OLD IDENTIFER
 TIN1     SA1    X5+TINI     FWA OF NEW IDENTIFIER
          SA6    X1+B5       RETURN NEW IDENTIFIER TO TASK
          SA6    B5-NUAPL+TRID  SET IDENTIFIER IN TASK SYSTEM AREA
 
*         RETURN STATUS TO TASK.
 
          SX6    TSNE        RECOVERY STATUS NO ERRORS
          SA1    X5+TIST     FWA OF STATUS
          SA6    X1+B5       RETURN STATUS TO TASK
          SB4    B0          DO NOT UNLOCK RECOVERY FILE
          EQ     RFC         RECOVERY FUNCTION COMPLETE
 
*         ASSIGN A NEW SEQUENCE NUMBER.
 
 TIN2     SA4    B5-NUAPL+CB2C  GET TERMINAL ORDINAL
          MX0    -CBTON      MASK FOR TERMINAL ORDINAL
          LX4    CBTON-1-CBTOS  RIGHT JUSTIFY TERMINAL ORDINAL
          BX1    -X0*X4
          RJ     ASN         ASSIGN SEQUENCE NUMBER
          EQ     TIN1        CHANGE SEQUENCE NUMBER FOR TRANSACTION
 
 .A       ELSE
 TIN      SX6    TSRU        RECOVERY STATUS RECOVERY UNAVAILABLE
          SA4    X5+TIST     FWA OF STATUS
          SA6    X4+B5       RETURN STATUS
          EQ     RFC         RECOVERY FUNCTION COMPLETE
 
 .A       ENDIF
 .A       IFGE   IPTAR,1
          TITLE  RECOVERY SUPPORTING ROUTINES.
 CFA      SPACE  4,15
**        CFA - COMPUTE FILE ADDRESS.
*
*
*         ENTRY  (X1) = MESSAGE SOURCE.
*                (X2) = TERMINAL ORDINAL RELATIVE TO RECOVERY FILE.
*                (X3) = INDEX, IF MESSAGE SOURCE EQUALS *MSRM*.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*
*         EXIT   (X6) = FILE PRU ADDRESS.
*
*         USES   X - 0, 3, 4, 6, 7.
*                A - 4.
 
 
 CFA      SUBR               ENTRY/EXIT
 
*         COMPUTE SIZE OF RECOVERY FILE IN PRUS PRECEDING THE
*         DESIRED TERMINAL ORDINAL.
 
          SX2    X2-1
          ERRNZ  TTNPN-TTNMN IF SIZE AND NUMBER ARE NOT EQUAL
          SA4    B4+TTNPW    GET NUMBER AND SIZE OF RECOVERY UNITS
          MX0    -TTNPN      MASK FOR SIZE AND NUMBER OF USER DATA
          ERRNZ  TTNPN-TTNMN IF SIZE AND NUMBER ARE NOT EQUAL
          ERRNZ  TTNPW-TTNMW IF NUMBER AND SIZE NOT IN SAME WORD
          LX4    TTNPN-1-TTNPS  RIGHT JUSTIFY NUMBER OF PRUS
          BX7    -X0*X4      USER AREA SIZE IN PRUS
          LX4    TTNMN-1-TTNMS-TTNPN+1+TTNPS
          BX4    -X0*X4      NUMBER OF USER MESSAGES
          SX4    X4+1        ADD ONE MESSAGE FOR *SECURE*
          IX4    X7*X4       SIZE OF USER AREA FOR RECOVERY UNIT
          SX6    TRUPL+MRIPL+X4  ADD STATUS AND TRANSACTION INPUT
          IX6    X2*X6       TOTAL SIZE FOR RECOVERY UNITS
          SX6    X6+TRHPL+1  ADD RECOVERY FILE HEADER
 
*         (X6) CONTAINS THE PRU ADDRESS FOR RECOVERABLE
*         *TSTAT/WSTAT* DATA.
*         DETERMINE MESSAGE SOURCE AND COMPUTE RECOVERY FILE
*         ADDRESS INTO TERMINAL ORDINAL-S RECOVERY UNIT.
 
          SX0    X1-MSTM
          ZR     X0,CFA1     IF TRANSACTION MESSAGE
          SX0    X1-MSSM
          ZR     X0,CFA2     IF *SECURE* MESSAGE
          SX0    X1-MSST
          ZR     X0,CFAX     IF *TSTAT/*WSTAT* MESSAGE
 
*         COMPUTE ADDRESS FOR *RPUT* MESSAGE.
 
          IX3    X3*X7       USER INDEX * USER DATA SIZE
          SX7    X3+TRUPL+MRIPL  ADD STATUS AND TRANSACTION SIZE
          IX6    X7+X6       ADD SIZE FOR PREVIOUS RECOVERY UNITS
          EQ     CFAX        RETURN
 
*         COMPUTE ADDRESS FOR TRANSACTION MESSAGE.
 
 CFA1     SX6    X6+TRUPL    ADD STATUS AREA SIZE
          EQ     CFAX        RETURN
 
*         COMPUTE ADDRESS FOR *SECURE* MESSAGE.
 
 CFA2     SX6    X6+TRUPL+MRIPL  ADD STATUS AND TRANSACTION SIZE
          EQ     CFAX        RETURN
 .A       ENDIF
 CID      SPACE  4,10
**        CID - CLEAR *NEWID* IDENTIFIER.
*
*         ENTRY  (B2) = FWA OF TASK SYSTEM AREA.
*                (B7) = SUBCP ADDRESS.
*                (X3) = RETURN ADDRESS UPON COMPLETION.
*
*         EXIT   TO *WFP0* IF RECOVERY INSTALLED.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 3, 5, 6.
 
 
 CID      SUBR               ENTRY/EXIT
 .A       IFEQ   IPTAR,1     IF AUTOMATIC RECOVERY INSTALLED
          BX7    X3          SAVE RETURN ADDRESS
          SA1    CIDA        PREPARE *WSTAT* REQUEST
          SA2    A1+B1
          SA7    B2+RWTS
          SX7    SUAC+CBCH+5
          BX6    X1
          SB3    X7
          SA6    B2+LRA1     FAKE SYSTEM REQUEST
          SA6    B2+NUAPL+SUAC+CBCH  *WSTAT* REQUEST BLOCK
          SA7    A6+B1       ADDRESS OF STATUS
          SA1    B7          PREPARE ENTRY CONDITIONS FOR *WFP0*
          SB5    X1          TASK RA
          SX6    X7+B1
          SX7    X6+B1
          SA6    A7+B1       ADDRESS OF *NEWID* PARAMETER
          SA7    A6+B1       ADDRESS OF *NEWID* VALUE
          BX6    X6-X6
          SA6    A7+B1       PARAMETER TERMINATION WORD
          SA7    B5+B3       STATUS
          BX7    X2          *NEWID*
          SA7    A7+B1
          SA6    A7+1
          MX0    -SCFLN
          SA3    B2+CB2C     GET TERMINAL ORDINAL
          LX1    SCFLN-1-SCFLS
          LX3    CBTON-1-CBTOS
          SA5    B2+LRA1     SYSTEM REQUEST
          BX1    -X0*X1      TASK FL
          SX7    X3
          SB6    B1          NUMBER OF PARAMETERS REQUIRED
          EQ     WFP0        CLEAR *NEWID* ON *CRF*
 
 CIDA     VFD    24/3LCTI,18/RFWS,18/SUAC+CBCH+1
          DATA   5HNEWID
 .A       ELSE
          EQ     CIDX        RETURN
 .A       ENDIF
 .A       IFEQ   IPTAR,1 IF AUTOMATIC RECOVERY INSTALLED
 CMF      SPACE  4,10
**        CMF - CHECK MESSAGE FIT.
*
*         ENTRY  (B4) = FWA OF RECOVERY FILE.
*                (X1) = USER MESSAGE LENGTH IN WORDS.
*
*         EXIT   (X6) = 0, IF MESSAGE FITS IN RECOVERY FILE.
*                       *TSMR*, IF MESSAGE DOES NOT FIT.
*
*         USES   X - 0, 2, 6.
*                A - 2.
 
 
 CMF      SUBR               ENTRY/EXIT
          SX6    B0          INITIALIZE TO MESSAGE FITS
          MX0    -TTNWN      MASK FOR RECOVERY MESSAGE SIZE
          SA2    B4+TTNWW    RECOVERY MESSAGE SIZE IN WORDS
          LX2    TTNWN-1-TTNWS  RIGHT JUSTIFY RECOVERY MESSAGE SIZE
          BX0    -X0*X2
          IX0    X0-X1       RECOVERY FILE MESSAGE SIZE - USER SIZE
          PL     X0,CMFX     IF USER MESSAGE FITS IN RECOVERY FILE
          SX6    TSMR        USER MESSAGE .GT. RECOVERY RECORD
          EQ     CMFX        RETURN
 CMU      SPACE  4,10
**        CMU - CHECK MESAGE UNITS.
*
*         ENTRY  (X1) = MESSAGE UNIT.
*
*         EXIT   (X6) = 0, IF MESSAGE UNIT VALID.
*                       *RSIU*, IF MESSAGE UNIT INCORRECT.
*                (X4) = MESSAGE UNIT.
*
*         USES   X - 3, 4, 6.
 
 
 CMU1     SX6    TSIL        RECOVERY STATUS INCORRECT UNIT
 
 CMU      SUBR               ENTRY/EXIT
          SX6    B0+         INITIALIZE TO VALID UNIT
          SX4    4           SET TO DISPLAY MESSAGE UNIT
 
*         IF MESSAGE UNIT IS NOT SPECIFIED, USE DISPLAY CODE.
 
          ZR     X1,CMUX     IF NO MESSAGE UNIT GIVEN
 
*         MESSAGE UNIT MUST BE IN THE RANGE OF 2 - 4.
 
          SX3    X1-5
          PL     X3,CMU1     IF MESSAGE UNIT TOO LARGE
          SX3    X1-2
          NG     X2,CMU1     IF MESSAGE UNITS TOO SMALL
          SX4    X1+
          EQ     CMUX        RETURN
 CRS      SPACE  4,15
**        CRS - CHECK RECOVERY STATUS.
*
*         ENTRY  (B4) = FWA OF COMMUNICATIONS RECOVERY FILE ENTRY.
*
*         EXIT   *TAF* ABORTS IF ERROR OCCURRED ON RECOVERY FILE.
*
*         USES   X - 0, 1, 4.
*                A - 4.
*                B - 2, 5.
*
*         CALLS  SNM.
*
*         MACROS ABORT, MESSAGE.
 
 
 CRS      SUBR               ENTRY/EXIT
 
*         CHECK FOR RECOVERY FILE ERRORS.
 
          SA4    B4+TTFTW    FIRST WORD OF GET
          MX0    -8
          LX4    7-17        RIGHT JUSTIFY STATUS
          BX1    -X0*X4
          ZR     X1,CRSX     IF NO ERRORS, RETURN
 
*         ABORT *TAF* ON RECOVERY FILE ERRORS.
 
          MX0    42
          LX4    59-59-7+17
          BX1    X0*X4       FILE NAME
          SB2    1RX         REPLACEMENT CHARACTER IN MESSAGE
          SB5    CRSA        FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE CRSA       * CRF RECOVERY UNIT ERROR - XXXXXXX.*
          ABORT
 
 CRSA     DATA   C* CRF RECOVERY UNIT ERROR - XXXXXXX.*
 CRU      SPACE  4,15
**        CRU - CHECK RECOVERY UNIT.
*
*         ENTRY  (X5) = FWA OF TASK REQUEST PARAMETERS.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = FWA OF TASK RA.
*
*         EXIT   (X3) = USER RECOVERY UNIT INDEX.
*                (X6) = 0, IF NO ERRORS.
*                       *TSII*, IF INCORRECT INDEX.
*
*         USES   X - 0, 3, 4, 6.
*                A - 3, 4.
 
 
 CRU1     SX6    TSII        INCORRECT INDEX
 
 CRU      SUBR               ENTRY/EXIT
          MX0    -TTNMN      MASK OF NUMBER OF USER MESSAGES
          BX6    X6-X6       NO ERROR
 
*         THE TASK RECOVERY UNIT INDEX MUST -
*                1. NOT BE EQUAL TO ZERO
*                2. NOT BE LESS THAN ZERO
*                3. BE .LE. TO MAXIMUM NUMBER OF MESSAGES ALLOWED.
 
          SA3    X5+RGIN     FWA OF TASK RECOVERY UNIT INDEX
          SA4    B4+TTNMW    NUMBER OF USER MESSAGES
          SA3    X3+B5       TASK RECOVERY UNIT INDEX
          ZR     X3,CRU1     IF INDEX ERROR
          NG     X3,CRU1     IF INDEX ERROR
          LX4    TTNMN-1-TTNMS  RIGHT JUSTIFY MAXIMUM MESSAGES
          BX0    -X0*X4
          IX0    X0-X3
          NG     X0,CRU1     IF MORE THAN MAXIMUM NUMBER OF MESSAGES
          EQ     CRUX        RETURN WITH NO ERRORS
 CTF      SPACE  4,15
**        CTF - CHECK TASK FIT.
*
*         ENTRY  (X1) = MESSAGE SIZE IN WORDS.
*                (X2) = SUBCP.
*                (X3) = FWA OF MESSAGE.
*
*         EXIT   (X6) = 0, IF MESSAGE FITS IN SUBCP FL.
*                       *RSMU*, IF MESSAGE DOES NOT FIT IN SUBCP FL.
*
*         USES   X - 0, 2, 6, 7.
*                A - 2.
 
 
 CTF      SUBR               ENTRY/EXIT
          SX6    B0          INITIALIZE TO MESSAGE FITS IN SUBCP
          LX2    SCPAL
          TA2    X2-CPAL,VCPA  GET SUBCP FL
          LX2    SCFLN-1-SCFLS  RIGHT JUSTIFY FL
          ERRNZ  SCFLN-18    IF NOT 18 BIT FIELD
          SX0    X2          FL
          IX7    X1+X3       END OF MESSAGE IN SUBCP
          IX7    X0-X7       FL - END OF MESSAGE
          PL     X7,CTFX     IF MESSAGE FITS IN SUBCP
          SX6    TSMU        RECOVERY STATUS MESSAGE .GR. USER AREA
          EQ     CTFX        RETURN
 FMH      SPACE  4,20
**        FMH - FORMAT MESSAGE HEADER.
*
*         ENTRY  (X1) = MESSAGE LENGTH.
*                (X3) = MESSAGE SOURCE.
*                (X4) = MESSAGE UNIT.
*                (X7) = APPLICATION BLOCK HEADER.
*                (B6) = FWA OF MESSAGE HEADER.
*
*         EXIT   MESSAGE HEADER IN RECOVERY UNIT IS FORMATTED.
*                (X1) = MESSAGE LENGTH ON ENTRY.
*                (X4) = MESSAGE UNIT ON ENTRY.
*
*         USES   X - 3, 4, 6, 7.
*                A - 7.
*
*         MACROS CLOCK, DATE.
 
 
 FMH      SUBR               ENTRY/EXIT
          LX3    TRMSS-TRMSN+1  POSITION MESSAGE SOURCE
          LX4    TRMUS-TRMUN+1  POSITION MESSAGE UNIT
          SA7    B6+TRMHW    SAVE APPLICATION BLOCK HEADER
          BX6    X3+X4
          LX4    59-59-TRMUS+TRMUN-1
          ERRNZ  TRMLS-TRMLN+1  IF MESSAGE LENGTH NOT RIGHT JUSTIFIED
          BX7    X1+X6
          SA7    B6+TRMSW
          ERRNZ  TRMSW-TRMLW IF SOURCE AND LENGTH NOT IN SAME WORD
          ERRNZ  TRMLW-TRMUW IF LENGTH AND UNITS NOT IN SAME WORD
          DATE   B6+TRMDW    PUT DATE IN MESSAGE HEADER
          CLOCK  B6+TRMTW    PUT TIME IN MESSAGE HEADER
          EQ     FMHX        RETURN
 GRP      SPACE  4,20
**        GRP - GET REQUEST PARAMETERS.
*
*         ENTRY  (X2) = FIRST WORD OF QUEUE ENTRY.
*                (B3) = FWA OF QUEUE ENTRY RELATIVE TO SUBCP.
*                (B5) = FWA OF QUEUE ENTRY RELATIVE TO *TAF*.
*
*         EXIT   (X5) = SYSTEM REQUEST.
*                       THE ADDRESS PORTION OF THE REQUEST IN
*                       BITS 17-0 IS RELATIVE TO THE RA OF *TAF*.
*                (X6) = SUBCP.
*                (X7) = TERMINAL ORDINAL.
*                (X1) = TERMINAL STATUS TABLE ORDINAL.
*                (B5) = RA OF SUBCP.
*                (B6) = FWA OF QUEUE ENTRY RELATIVE TO *TAF*
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 3, 5.
*                B - 5, 6.
 
 
 GRP      SUBR               ENTRY/EXIT
          MX0    -QWSPN      MASK FOR SUBCP
          LX2    QWSPN-1-QWSPS  RIGHT JUSTIFY SUBCP
          BX6    -X0*X2
          LX6    SCPAL       COMPUTE TASK SYSTEM AREA FWA
          SB6    B5          FWA OF QUEUE ENTRY
          SB5    B0          RA FOR NO SUBCP
          ZR     X6,GRP1     IF NOT SUBCP REQUEST
          TA3    X6-CPAL,VCPA
          ERRNZ  SCRAS-17    IF RA NOT IN BITS 0-17
          AX6    SCPAL
          SB5    X3          SUBCP RA
 GRP1     SA5    B6+QRECW    RECOVERY REQUEST
          SX3    B5          COMPUTE REQUEST ADDRESS RELATIVE TO *TAF*
          IX5    X5+X3
          SA1    B6+QRTOW    GET TERMINAL FOR RECOVERY REQUEST
          ERRNZ  QRTOS-17    IF TERMINAL ORDINAL NOT IN 17-0
          SX7    X1+
          EQ     GRPX        RETURN
 IRU      SPACE  4,15
**        IRU - INITIALIZE RECOVERY UNIT.
*
*         ENTRY  (X3) = RECOVERY UNIT NAME.
*                (B4) = FWA OF RECOVERY UNIT ENTRY.
*
*         EXIT   RECOVERY UNIT INITIALIZED.
*
*         USES   X - 6, 7.
*                A - 6, 7.
*
*         MACROS CLOCK, DATE.
 
 
 IRU      SUBR               ENTRY/EXIT
          BX7    X3          PUT NAME IN RECOVERY UNIT
          SX6    B0
          SA7    B4+TTBFW+TRUNW
          SA6    B4+TTBFW+TRCSW  CLEAR STEP, TYPE AND DATA MANAGERS
          SA6    B4+TTBFW+TRCNW  CLEAR SEQUENCE NUMBER
          SA6    B4+TTBFW+TROIW  CLEAR OLDID
          SA6    B4+TTBFW+TRNIW  CLEAR NEWID
          DATE   B4+TTBFW+TRCDW  PUT DATE IN RECOVERY UNIT
          CLOCK  B4+TTBFW+TRCTW  PUT TIME IN RECOVERY UNIT
          EQ     IRUX        RETURN
PSU      SPACE  4,20
**        PSU - PROCESS SYSTEM AND USER *RERUN* FUNCTION.
*
*         ENTRY  (X0) = FWA OF COMMUNICATION BLOCK.
*                (X5) = FWA OF RECOVERY FILE ENTRY.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (B5) = SUBCP RA.
*                (B6) = NUMBER OF C.B.-S TO REQUEST FOR RERUN.
*                (RFBB) = SUBCP.
*                (RFBD) = RECOVERY FILE TERMINAL ORDINAL.
*                (RFBF) = FWA OF RECOVERY QUEUE ENTRY.
*                EVCB = FWA OF COMMUNICATION BLOCK EVENT.
*
*         EXIT   TO *RFB*, IF WAITING FOR COMMUNICATION BLOCKS.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                (X1) = 0, IF INPUT PROCESSED.
*                     .NE. ZERO OTHERWISE.
*                (RFBB) = SUBCP.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4, 6.
*
*         CALLS  CFA, CRS, FFCB, FIO, FNC, GRP, MVE=, PRIN, RLC,
*                RSP, STF.
*
*         MACROS QTWCALL.
 
 
 
 PSU      SUBR               ENTRY/EXIT
          SX0    B0+
          RJ     FFCB        GET A COMMUNICATION BLOCK
          ZR     X0,PSU1     IF NO COMMUNICATION BLOCK
          SX6    X0
          SA1    X0
          SA6    PSUF        FWA OF CHAIN OF COMMUNICATION BLOCKS
          SA6    B5-NUAPL+RERU
          SA6    PSUB        FWA OF CURRENT COMMUNICATION BLOCK
          RJ     FNC         FIND AND CHAIN COMMUNICATION BLOCKS
          ZR     B6,PSU2     IF ALL COMMUNICATION BLOCKS AVAILABLE
 
*         IF ALL COMMUNICATION BLOCKS ARE NOT AVAILABLE RELEASE
*         RESERVED COMMUNICATION BLOCKS AND RELEASE RECOVERY FILE LOCK.
 
          SA2    PSUF        FWA OF CHAINED COMMUNICATION BLOCKS
          RJ     RLC         RELEASE CHAINED COMMUNICATION BLOCKS
          SX6    B0+         CLEAR EVCB
          SA6    EVCB        INDICATE NO C.B. AVAILABLE
 PSU1     SA1    PSUA        FWA OF RECOVERY FILE ENTRY
          SA4    X1+TTLKW    RECOVERY FILE LOCK
          MX7    -60+TTLKN
          ERRNZ  TTLKS-59    IF LOCK FIELD NOT IN BIT 59
          BX6    -X7*X4      CLEAR LOCK
          ERRNZ  TTEVW-TTLKW IF LOCK AND EVENT NOT IN SAME WORD
          LX7    TTEVS-TTLKS
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    X7+X6       SET RELEASE FILE EVENT
          SA6    A4
 
*         QUEUE WAITING FOR COMMUNICATION BLOCKS.
 
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          SX1    EVCB        FWA OF EVENT FOR COMMUNICATION BLOCKS
          SA3    RFBB        SUBCP
          SX5    B0          NO TIME OUT ON EVENT
          QTWCALL  59,QTEV   WAIT FOR FREE COMMUNICATION BLOCK EVENT
          RJ     GRP         GET REQUEST PARAMETERS
          SX1    B5
          IX5    X5-X1
          EQ     RFB         RECOVERY BEGIN PROCESSING
 
*         READ RECOVERY FILE TO OBTAIN TRANSACTION RECOVERY
*         UNIT AND STATUS.
 
 PSU2     SX1    MSST        MESSAGE SOURCE IS *TSTAT*
          SA3    PSUA        FWA OF RECOVERY FILE ENTRY
          SA2    RFBD        TERMINAL IN RECOVERY FILE ORDINAL
          SB4    X3
          RJ     CFA         COMPUTE FILE ADDRESS FOR *TSTAT* DATA
          SX5    B4+TTFTW    FWA OF FET
          SX2    TRUPL+MRIPL NUMBER OF PRUS TO READ
          SX1    CIORD       *CIO* READ
          RJ     FIO         DO FILE INPUT/OUTPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         INPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF INPUT COMPLETE EVENT
          SA3    RFBB        SUBCP
          SX5    B0          NO TIME OUT ON EVENT
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SA7    RFBA        SAVE TERMINAL ORDINAL
          SA6    RFBB        SAVE SUBCP
          SX7    B3+         SAVE FWA OF QUEUE ENTRY
          SA7    RFBF
          RJ     STF         SEARCH TERMINAL FILE FOR TERMINAL ORDINAL
          SX7    X3+
          SA7    PSUG        RECOVERY FILE TERMINAL ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
 
*         IF TRANSACTION IS NOT RECOVERABLE RETURN TRANSACTION
*         IS NOT RECOVERABLE STATUS TO TASK.
 
          SX6    B4+
          SA6    PSUA        FWA OF RECOVERY FILE ENTRY
          SA1    B4+TTBFW+TRCSW  TRANSACTION *STEP*
          MX0    -TRCSN
          ERRNZ  TRCSS-TRCSN+1  IF *STEP* NOT RIGHT JUSTIFIED
          BX2    -X0*X1      *STEP*
          SX6    TSNO        RECOVERY STATUS NOT RERUNNABLE
          SX0    X2-CSNR
          ZR     X0,PSU8     IF TRANSACTION NOT RERUNNABLE
          SX0    X2-CSCE
          ZR     X0,PSU8     IF CEASE/JOB END
          SX0    X2-CSTA
          ZR     X0,PSU8     IF TRANSACTION ABORTED
          SX0    X2-CSTN
          ZR     X0,PSU8     IF TRANSACTION NO LONGER RERUNNABLE
 
*         MOVE TRANSACTION INPUT FROM RECOVERY FILE TO COMMUNICATION
*         BLOCKS.
 
          SX7    B4+TTBFW+TRUWL+TRMWL  FWA OF INPUT IN RECOVERY FILE
          SA7    PSUC
          SA1    B4+TTBFW+TRUWL+TRMLW  WORDS OF TRANSACTION INPUT
          ERRNZ  TRMLS-TRMLN+1   IF FIELD NOT RIGHT JUSTIFIED
          MX0    -TRMLN
          BX4    -X0*X1
          ZR     X4,PSU8     IF NO TRANSACTION INPUT
          SX2    X7
          IX6    X2+X4       END OF INPUT IN RECOVERY BUFFER
          SA6    PSUD
          SA1    B5-NUAPL+RERU  RESTORE C.B. ADDRESS
          BX7    X1
          SA7    PSUB
 PSU3     SX1    CMBL        LENGTH TO MOVE IN WORDS
          SA3    PSUB        FWA OF COMMUNICATION BLOCK
          SA4    X3          SAVE C.B. LINK
          SX7    X4
          SA7    PSUF
          RJ     MVE=        MOVE INPUT TO COMMUNICATION BLOCK
 
*         UPDATE TRANSACTION SEQUENCE NUMBER IN COMMUNICATION BLOCK.
 
          SA1    PSUB        FWA OF COMMUNICATION BLOCK
          SA4    X1+CBTSW    SEQUENCE NUMBER IN SYSTEM HEADER
          SA2    B5-NUAPL+TRID  CURRENT IDENTIFIER
          MX0    60-CBTSN-CBNCN
          BX7    X0*X4       CLEAR SEQUENCE NUMBER AND C.B. LINK
          LX2    CBTSS-CBTSN+1
          BX7    X7+X2       INSERT NEW SEQUENCE NUMBER
          SA3    X1+CMBHL+TRSQ-SUAC
          SA7    A4          UPDATE FWA OF C.B.
          BX6    X0*X3
          BX6    X6+X2
          SX0    TSTLLE      LENGTH OF TST ENTRY
          SA6    A3
 
*         INDICATE TRANSACTION IS BEING RESTARTED.
 
          SA2    X1+CBTRW    RESTART ATTRIBUTE
          MX6    CBTRN
          LX6    CBTRS-59
          BX7    X2+X6
          LX6    CBLCS-59-CBTRS+59
          BX7    X6+X7       SET INPUT LOGGED COMPLETE
          SA7    A2
 
*         UPDATE TERMINAL ORDINAL AND TERMINAL STATUS TABLE
*         ADDRESS IN COMMUNICATION BLOCK.
 
          SA2    RFBA        TST ORDINAL
          IX3    X0*X2
          TX4    X3,VTST     FWA OF TERMINAL STATUS TABLE ENTRY
          LX2    CBTOS-CBTON+1  POSITION TERMINAL ORDINAL
          LX4    CBTAS-CBTAN+1  POSITION TERMINAL ADDRESS
          BX2    X2+X4
          SA1    PSUB
          SA3    X1+CBFWW    FWA OF COMMUNICATION BLOCK
          BX6    X2+X1
          MX0    CBRSN+CBUSN READ AND UPDATE SECURITY
          LX0    CBRSS-59
          BX4    X0*X3       SAVE READ AND UPDATE SECURITY
          BX6    X6+X4
          SA6    A3
          SA2    PSUC        CURRENT ADDRESS IN RECOVERY BUFFER
          SA3    PSUD        ADDRESS OF EOI
          SX7    X2+CMBL     NEXT ADDRESS IN RECOVERY BUFFER
          IX6    X3-X7
          SA7    A2
          SX2    X7
          SA3    PSUF        FWA OF CHAINED COMMUNICATION BLOCKS
          SX7    X3
          SA7    PSUB        CURRENT COMMUNICATION BLOCK
          ZR     X6,PSU4     IF NO MORE RECOVERY INPUT
          SA4    A4          GET FWA OF LAST C.B.
          BX7    X4+X7       ADD C.B. LINK
          SA7    A4+
          EQ     PSU3        CONTINUE TRANSFER INPUT TO NEXT C.B.
 
*         RETURN APPLICATION BLOCK HEADER TO NETWORK COMMUNICATION
*         TABLE.
 
 PSU4     MX0    -TSCNN      GET ABH
          ERRNZ  TSARW-TSCNW IF FIELDS IN DIFFERENT WORDS
          LX6    TSCNN-1-TSCNS  RIGHT JUSTIFY CONNECTION NUMBER
          BX2    -X0*X6
          ZR     X2,PSU5     IF NO NETWORK CONNECTION
          SX3    TNCTL       NETWORK COMMUNICATION TABLE ENTRY LENGTH
          IX4    X2*X3
          SX4    X4+TNAHW
          TX3    X4,VNCT
          SA1    B4+TTBFW+TRUWL+TRMHW  APPLICATION BLOCK HEADER
          BX7    X1
          SA7    X3          APPLICATION BLOCK HEADER
 PSU5     BSS    0
          SX6    TSNE        RECOVERY STATUS NO ERRORS
 
*         RETURN STATUS TO TASK AND RELEASE UNUSED COMMUNICATION
*         BLOCKS.
 
          SA1    X5+REST     FWA OF STATUS
          SA6    X1+B5       RETURN STATUS
          SA2    PSUF        FWA OF CHAIN OF COMMUNICATION BLOCKS
          RJ     RLC         RELEASE COMMUNICATION BLOCKS
 
*         UPDATE THE TRANSACTION SEQUENCE NUMBER IN THE *CRF*.
 
          SA2    B5-NUAPL+TRID  CURRENT SEQUENCE NUMBER
          SA4    PSUA        FWA OF RECOVERY FILE ENTRY
          BX7    X2
          SB4    X4
          SA7    B4+TTBFW+TRCNW
          SX1    MSST        MESSAGE SOURCE IS STATUS
          SA2    PSUG        TERMINAL ORDINAL IN RECOVERY FILE
          RJ     CFA         COMPUTE FILE ADDRESS
          SX5    B4+TTFTW    FWA OF FET
          SX2    TRUPL       LENGTH TO WRITE IN PRU-S
          SX1    CIORW       *CIO* REWRITE
          RJ     FIO         DO FILE INPUT/OUPUT
 
*         QUEUE REQUEST TO LET *TAF* DO OTHER WORK UNTIL
*         OUTPUT IS COMPLETE.
 
          SX1    B4+TTFTW    FWA OF INPUT COMPLETE EVENT
          SA3    RFBB        SUBCP
          SX5    B0          NO TIME OUT ON EVENT
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SB3    X4
          QTWCALL  0,QTEV    WAIT FOR INPUT TO COMPLETE
          RJ     GRP         GET REQUEST PARAMETERS AFTER WAIT
          SA7    RFBA        SAVE TERMINAL ORDINAL
          SA6    RFBB        SAVE SUBCP
          SX7    B3+         SAVE FWA OF QUEUE ENTRY
          SA7    RFBF
          RJ     STF         SEARCH TERMINAL FILE FOR TERMINAL ORDINAL
          RJ     CRS         CHECK RECOVERY STATUS FOR ERRORS
          SX6    B4+
          SA6    PSUA        FWA OF RECOVERY FILE ENTRY
 
*         ON *SRERUN*, SET USER ACTIVE IN TST.
 
          SA1    B5-NUAPL+LRA1  CHECK LAST SYSTEM REQUEST
          SX2    RFSR        *SRERUN* FUNCTION CODE
          LX1    17-35
          MX0    -18
          BX2    X2-X1
          BX2    -X0*X2
          NZ     X2,PSU5.1   IF NOT *SRERUN*
          SA3    RFBA        TERMINAL ORDINAL IN TST
          R=     X0,TSTLLE   *TST* ENTRY LENGTH
          IX3    X0*X3
          MX0    TSAUN
          LX0    TSAUS-59
          TA4    X3+TSAUW,VTST  GET USER ACTIVE WORD OF TST ENTRY
          BX6    X0+X4
          SA6    A4          SET USER ACTIVE
 
*         UNLOCK RECOVERY FILE BECAUSE TRANSACTION MAY HAVE TO WAIT
*         FOR *ITASK*.
 
 PSU5.1   SA1    PSUA        FWA OF RECOVERY ENTRY
          SA4    X1+TTLKW    LOCK STATUS
          ERRNZ  TTLKS-59    IF LOCK NOT IN BIT 59
          MX7    -60+TTLKN
          BX6    -X7*X4      UNLOCK RECOVERY FILE
          LX7    TTEVS-59
          ERRNZ  TTLKN-TTEVN IF EVENT AND LOCK FIELDS NOT EQUAL
          BX6    X7+X6       SET FILE RELEASE EVENT
          ERRNZ  TTLKW-TTEVW IF LOCK AND LOCK EVENT NOT IN SAME WORD
          SA6    A4
 
*         SCHEDULE TRANSACTION.
 
 PSU6     SA2    PRINA       PROCESS INPUT AVAVALABLE STATUS
          NZ     X2,PSU7     IF INPUT CANNOT BE PROCESSED
          RJ     RSP         RESTORE SUBCP REGISTERS
          MX7    1           NO COMMUNICATION BLOCK REQUIRED
          LX7    55-59
          SA2    B5-NUAPL+RERU  FWA OF COMMUNICATION BLOCK
          SX0    X2
          SA7    PSUE        INPUT WORD FOR *PRIN*
          SA4    A7
          RJ     PRIN        PROCESS INPUT
          SB4    B0          DO NOT UNLOCK RECOVERY FILE
          SX6    B0          CLEAR *ITASK* BUSY STATUS
          SA1    PRINA       PROCESS INPUT STATUS
          ZR     X1,PSUX     IF INPUT PROCESSED
          SA6    A1+
 
*         QUEUE COMMUNICATION BLOCK UNTIL *ITASK-S* QUEUE IS NOT FULL.
 
 PSU7     SX1    EVIT        FWA OF EVENT FOR *ITASK*
          SA4    RFBF        FWA OF RECOVERY QUEUE ENTRY
          SX5    B0          NO TIME OUT ON EVENT
          SB3    X4
          SA3    RFBB        SUBCP
          QTWCALL  59,QTEV   WAIT FOR *ITASK*
          RJ     GRP         GET REQUEST PARAMETERS
          SA6    RFBB        SAVE SUBCP
          SX7    B3          SAVE FWA OF QUEUE ENTRY
          SA7    RFBF
          EQ     PSU6        SCHEDULE TRANSACTION
 
*         NOT ABLE TO RERUN, RETURN STATUS.
 
 PSU8     SA1    X5+REST     FWA OF STATUS
          SA6    X1+B5       RETURN STATUS
          SA2    PSUF        FWA OF CHAIN OF COMMUNICATION BLOCKS
          RJ     RLC         RELEASE COMMUNICATION BLOCKS
          SA1    PSUA        FWA OF RECOVERY FILE ENTRY
          SB4    X1
          EQ     RFC         RECOVERY FUNCTION COMPLETE
 
 PSUA     BSS    1           FWA OF RECOVERY FILE ENTRY
 PSUB     BSS    1           CURRENT COMMUNICATION BLOCK FWA
 PSUC     BSS    1           CURRENT FWA IN RECOVERY FILE BUFFER
 PSUD     BSS    1           LWA TO PROCESS IN RECOVERY FILE BUFFER
 PSUE     BSS    1           *PRIN* INPUT WORD
 PSUF     BSS    1           FWA OF CHAIN OF COMMUNICATION BLOCKS
 PSUG     BSS    1           TERMINAL ORDINAL IN RECOVERY FILE
 REM      SPACE  4,15
**        REM - RESTORE END OF MESSAGE.
*
*         ENTRY  (X1) = APPLICATION BLOCK HEADER.
*                (X2) = FIRST WORD OF *SEND* REQUEST.
*                (B5) = SUBCP RA.
*                (SML1) = LAST WORD OF MESSAGE.
*                (SML2) = LAST WORD PLUS ONE OF MESSAGE.
*
*         EXIT   TASK AREA AT END OF MESSAGE RESTORED.
*
*         USES   X - 0, 1, 3, 4, 7.
*                A - 3, 7.
 
 
 REM      SUBR               ENTRY/EXIT
 
*         IF MESSAGE USES DISPLAY MESSAGE UNITS, RESTORE CHARACTERS
*         IN TASK USED BY END OF MESSAGE LINE BYTE.  THE CHARACTERS
*         MUST BE RESTORED TO KEEP THE TASK REUSEABLE.
 
          MX0    -AHCTN      MASK FOR MESSAGE UNIT
          LX1    AHCTN-1-AHCTS  RIGHT JUSTIFY MESSAGE UNIT
          BX1    -X0*X1      MESSAGE UNIT
          LX2    17-47       FWA OF MESSAGE
          SX0    X1-4
          NZ     X0,REMX     IF NOT DISPLAY MESSAGE, RETURN
          SA3    B5-NUAPL+SML3  LENGTH OF MESSAGE IN WORDS
          SX4    X3-1        LENGTH OF MESSAGE MINUS ONE
          SX0    X2
          IX4    X2+X4       LWA OF MESSAGE
          SA3    B5-NUAPL+SML1
          BX7    X3
          SA7    X4+B5
          SA3    B5-NUAPL+SML2
          BX7    X3
          SA7    A7+B1
          EQ     REMX        RETURN
 SEL      SPACE  4,15
**        SEL - SET END OF LINE.
*
*         ENTRY  (X3) = FWA OF MESSAGE.
*                (X1) = LENGTH OF MESSAGE IN WORDS.
*                (B5) = SUBCP RA.
*                (B6) = REMAINDER OF MESSAGE IN BITS OVER LAST WORD.
*
*         EXIT   (X1) = NEW LENGTH OF MESSAGE INCLUDING END OF LINE.
*                (SML1) = LAST WORD OF MESSAGE.
*                (SML2) = LAST WORD OF MESSAGE PLUS ONE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 2, 3, 6.
*                B - 6.
 
 
 SEL      SUBR               ENTRY/EXIT
          IX3    X1+X3       FWA OF END OF MESSAGE PLUS ONE
          SA3    X3-1        SAVE LAST WORD OF MESSAGE
          SA2    A3+B1       SAVE LAST WORD OF MESSAGE PLUS ONE
          BX6    X3
          SA6    B5-NUAPL+SML1
          BX6    X2
          SA6    B5-NUAPL+SML2
          SX6    X1+
          SA6    B5-NUAPL+SML3  SAVE MESSAGE LENGTH IN WORDS
          ZR     B6,SEL1     IF MESSAGE ENDS OF WORD BOUNDARY
 
*         FORM END OF LINE IN LAST WORD OF MESSAGE.
*         FOR MESSAGES IN DISPLAY CODE THE MESSAGE MUST HAVE AN
*         AN END OF LINE BYTE OF 12 TO 60 BITS OF ZEROS.
 
          MX0    1
          SB6    B6-B1
          AX0    B6
          BX6    X0*X3       ZERO UNUSED MESSAGE BITS
          SA6    A3
          BX3    X6
 
*         IF LAST WORD OF MESSAGE DOES NOT CONTAIN 12 BITS OF ZERO,
*         ADD ONE WORD OF ZEROS TO FORM COMPLETE END OF LINE BYTE.
 
 SEL1     MX0    -12
          BX6    -X0*X3
          ZR     X6,SELX     IF LAST WORD HAS END OF LINE
          SX6    B0
          SX1    X1+B1       ADD ONE TO LENGTH OF MESSAGE
          SA6    A2+
          EQ     SELX        RETURN
 .A       ENDIF
 WTS      SPACE  4,20
**        WTS - WRITE TERMINATION *STEP* TO *CRF*.
*
*         ENTRY  - (X5) = VALUE OF *STEP* TO WRITE.
*                  (X3) = RETURN ADDRESS UPON COMPLETION.
*                  (B7) = SUBCP ADDRESS
*                  (B2) = TASK SYSTEM AREA ADDRESS
*
*         EXIT   TO *WFP0*.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 3, 5, 6.
 
 
 WTS      SUBR               ENTRY/EXIT
 .B       IFGE   IPTAR,1
          BX7    X3          SAVE RETURN ADDRESS
          SA1    WTSA        PREPARE *WSTAT* REQUEST
          SA2    A1+B1
          SA7    B2+RWTS
          BX6    X1
          SX7    SUAC+CBCH+5
          SB3    X7+
          SA6    B2+LRA1     FAKE SYSTEM REQUEST
          SA6    B2+NUAPL+SUAC+CBCH  *WSTAT* REQUEST BLOCK
          SA7    A6+B1       ADDRESS OF STATUS
          SA1    B7          PREPARE ENTRY CONDITIONS FOR *WFP0*
          SB5    X1          TASK RA
          SX6    X7+B1
          SX7    X6+B1
          SA6    A7+B1       ADDRESS OF *STEP* PARAMETER
          SA7    A6+B1       ADDRESS OF *STEP* VALUE
          BX6    X6-X6
          SA6    A7+B1       PARAMETER TERMINATION WORD
          SA7    B5+B3       STATUS
          BX6    X2          *STEP*
          BX7    X5
          SA6    A7+B1
          SA7    A6+B1
          MX0    -SCFLN
          SA3    B2+CB2C     GET TERMINAL ORDINAL
          LX1    SCFLN-1-SCFLS
          LX3    CBTON-1-CBTOS
          SA5    B2+LRA1     SYSTEM REQUEST
          BX1    -X0*X1      TASK FL
          SX7    X3
          SB6    B1          NUMBER OF PARAMETERS REQUIRED
          EQ     WFP0        WRITE *STEP* TO *CRF*
 
 WTSA     VFD    24/3LCTI,18/RFWS,18/SUAC+CBCH+1
          DATA   10HSTEP
 .B       ELSE
          EQ     WTSX        RETURN
 .B       ENDIF
 
 STF      SPACE  4,15
**        STF - SEARCH TERMINAL FILE TABLE.
*
*         ENTRY  (X1) = TERMINAL STATUS TABLE TERMINAL ORDINAL.
*
*         EXIT   (X2) = TERMINAL FILE ENTRY.
*                (B4) = FWA OF RECOVERY FILE ENTRY.
*                     = 0, IF NO ENTRY FOUND.
*                (X3) = TERMINAL ORDINAL IN RECOVERY FILE.
*
*         USES   X - 2, 3, 6, 7.
*                A - 2.
*                B - 4, 6.
 
 
 STF2     LX2    59-59-TFHON+1+TFHOS
          SB4    X2+         FWA OF RECOVERY FILE ENTRY
          ERRNZ  TFTPS-17    IF FWA OF RECOVERY FILE ENTRY NOT IN 17-0
 
 STF      SUBR               ENTRY/EXIT
          SX3    B0          STARTING ORDINAL WITH RESPECT TO FILE
          MX6    -TFHON      MASK FOR TERMINAL ORDINAL
          SB4    B0+         SET ENTRY NOT FOUND
          SB6    TTFTL-1     END OF ENTRIES
          TA2    -TTFTL,VTST FIRST TERMINAL FILE ENTRY
 STF1     ZR     X2,STFX     IF ENTRY NOT FOUND
          LX2    TFHON-1-TFHOS  RIGHT JUSTIFY HIGHEST ORDINAL
          BX7    -X6*X2      HIGHEST ORDINAL
          IX6    X7-X1
          IX3    X1-X3       TERMINAL ORDINAL WITH RESPECT TO FILE
          PL     X6,STF2     IF ENTRY CONTAINS TERMINAL
          LE     B6,B0,STFX  IF ENTRY NOT FOUND
          SA2    A2+TTFTE    GET NEXT ENTRY
          SX3    X7+         SAVE LOWEST ORDINAL MINUS 1 OF NEXT FILE
          SB6    B6-B1
          MX6    -TFHON
          EQ     STF1        CHECK NEXT TERMINAL FILE ENTRY
 
 ENDR     EQU    *           END OF SYSTEM REQUEST PROCESSORS
          TITLE  BATCH CONCURRENCY SUPPORTING ROUTINES.
 BAM      SPACE  4,15
**        BAM -  ENTER BATCH *CRM* REQUEST IN *AMI* QUEUE.
*
*         ENTRY  (X4) = COMPLETION ADDRESS.
*                (X5) = *TAF/CRM* FUNCTION CODE.
*                (B3) = *TAF* STORAGE AREA ADDRESS.
*                (B6) = *BCT* ADDRESS.
*
*         EXIT   (X7) = 0, IF REQUEST NOT ACCEPTED.
*                (X7) = 1, IF REQUEST ENTERED IN QUEUE.
*                (DTIME) = 0, TO INSURE *AMI* WILL BE CALLED.
*
*         USES   X - ALL.
*                A - 1, 3, 5, 7.
*                B - 3, 4, 5.
*
*         CALLS  PDIF, QTW.
 
 
 BAM      SUBR               ENTRY/EXIT
 
*         BUILD *AAM* INPUT QUEUE ENTRY.
 
          SA1    B6+BCSNW    *BCT* SUBCP WORD
          LX1    BCSNN-1-BCSNS
          MX0    -BCSNN
          BX1    -X0*X1      SUBCP NUMBER
          SA3    B6+BCTSW    TRANSACTION SEQUENCE NUMBER
          MX0    TFIDN+TFTSN
          BX6    X0*X3
          LX5    30-6        POSITION FUNCTION CODE
          BX6    X6+X5       ADD TO REQUEST
          LX1    23-5        POSITION SUBCP NUMBER
          BX6    X6+X1       ADD TO REQUEST
          SX1    BSAR
          BX6    X6+X1       ADD REQUEST ADDRESS
          SX7    B0
          SA5    AAMA        *AAM* STATUS WORD
          LX5    17-35       POSITION TRANSACTION COUNT
          SB3    X5+
          TB5    0,VAAQ      *AAM* INPUT QUEUE FET ADDRESS
          SA1    B6+BCAMW    *AAM* STATUS FLAG
          LX1    59-BCAMS
          MX0    1           SET *AAM* STATUS FLAG
          NG     X1,BAM1     IF *AAM* PREVIOUSLY CALLED
          ZR     B3,BAMX     IF *AAM* CANNOT ACCEPT CALLS
          BX7    X0+X1
          LX7    BCAMS-59
          SX1    B1+
          SA7    A1+
          IX5    X5-X1       DECREMENT *AAM* TRANSACTION COUNT
 
*         IF *AAM* CAN ACCEPT MORE TRANSACTIONS, PUT REQUEST IN QUEUE.
 
 BAM1     LX5    18
          RJ     PDIF        PUT ENTRY IN INPUT QUEUE
          ZR     X7,BAMX     IF INPUT QUEUE FULL
          SX1    B1
          IX7    X5+X1       ADVANCE OUTSTANDING REQUESTS
          SA7    A5
          BX7    X7-X7
          SA7    DTIME       INSURE *AMI* WILL BE CALLED
 
*         QUEUE *BATCH/CRM* REQUEST UNTIL *AAM* REQUEST COMPLETE.
 
          SA1    B6+BCSAW
          ERRNZ  BCSAS-17    TEMPORARY STORAGE ADDRESS NOT IN BIT 17
          SB3    X1          *TAF* STORAGE AREA ADDRESS
          BX3    X3-X3       SUBCP NUMBER
          SX1    B6+BCSFW
          SX2    59          SHIFT FOR COMPLETE BIT
          SX6    X4          COMPLETION ADDRESS
          SX4    QTEV        EVENT TYPE
          SB5    B0          NOT A TIMED EVENT
          SB4    B0          QUEUE AT END OF QUEUE
          BX5    X5-X5       NOT A TIMED EVENT
          RJ     QTW         QUEUE REQUEST
          SX7    B1          INDICATE REQUEST ACCEPTED
          EQ     BAMX        RETURN
 BRC      SPACE  4,45
**        BRC    BATCH REQUEST CONTINUATION.
*
*            *BRC* IS CALLED WHENEVER A BATCH CONCURRENCY REQUEST
*         IS DETECTED IN THE SUBSYSTEM REQUEST BUFFER OR PERIODICALLY
*         FROM THE TASK SWITCHING ROUTINE *TSSC*.  *BRC* ATTEMPTS TO
*         COMPLETE ALL REQUESTS IN THE BATCH CONCURRENCY TABLE, *BCT*,
*         BEFORE EXITING TO *TSSC*.  THE STEPS PERFORMED ARE:
*
*          1. SEARCH *BCT* FOR ACTIVE ENTRIES. IF NONE, EXIT TO *TSSC*.
*
*          2. BRANCH TO SUBPROCESSOR ACCORDING TO FUNCTION LIST.
*
*          3. VALIDATE BATCH JOB CAN ACCESS *TAF/CRM*.
*
*          4. REQUEST A SUBCP AREA FOR REQUEST. IF RECOVERY IS
*             REQUIRED ISSUE A *RSTDBI* REQUEST.
*
*          5. FOR WRITE REQUESTS GET RECORD FROM *UCP*.
*
*          6. CREATE *CRM* REQUEST IN SUBCP AREA AND QUEUE TO
*             *AAM* INPUT QUEUE.
*
*          7. FOR READ REQUESTS RETURN RECORD TO *UCP*.
*
*          8. FOR DBCOMIT REQUESTS WRITE RECOVERY INFORMATION
*             TO *CRF*.
*
*          9. RETURN REQUEST STATUS TO *UCP* AND ALLOW *UCP*
*             TO EXECUTE.
*
*          10. CLEAR LONG TERM CONNECT WITH *UCP*, RELEASE
*              SUBCP, AND RELEASE *BCT* ENTRY.
*
*         ENTRY  (B6) = 0, IF ENTERED FROM *TSSC*.
*                (B6) = *BCT* ADDRESS IF ENTERED FROM *PBC*.
*                (VBCT) = *BCT* ADDRESS.
*                (VNBCT) = NUMBER OF *BCT* ENTRIES.
*
*         EXIT   TO *TSSC*.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  ASN, BAM, GRA, GTS, MVE=, QTW, RTS, SCC,
*                SFL, SFR, VBA.
 
 
 BRC      TX6    0,VBCT      *BCT* ADDRESS
          SX7    B0+
          SA6    BRCA        INITIALIZE SEARCH LOOP FWA
          SA7    BRCB        NUMBER OF *BCT* ENTRIES PROCESSED
          NZ     B6,BRC2     IF ENTERED FROM PBC
 BRC1     SA1    BRCA        NEXT *BCT* ENTRY ADDRESS
          SA2    BRCB        NUMBER OF ENTRIES PROCESSED
          SB6    X1
          SA3    VNBCT
          SX3    X3
          IX3    X2-X3
          PL     X3,TSSC     IF NO MORE ACTIVITY TO PROCESS
          SX6    X2+B1
          SA6    BRCB        INCREMENT NUMBER OF ENTRIES
          SX2    BCTL        *BCT* ENTRY LENGTH
          SX6    X2+B6
          SA6    BRCA        NEXT *BCT* ENTRY ADDRESS
          SA1    B6
          ERRNZ  BCRAW       IF REQUEST ACTIVE NOT IN WORD ZERO
          LX1    59-BCRAS
          PL     X1,BRC1     IF REQUEST NOT ACTIVE
          MX0    BCCNN       CONSTRAINT BIT
          SA1    B6+BCCNW
          LX1    59-BCCNS
          PL     X1,BRC1     IF REQUEST NOT CONSTRAINED
          BX6    -X0*X1      CLEAR CONSTRAINT BIT
          LX6    -59+BCCNS   REPOSITION CONSTRAINT WORD
          SA6    A1          STORE IN *BCT*
          MX0    -BCCTN
          LX6    BCCTN-1-BCCTS
          BX7    -X0*X6      CONSTRAINT CODE
 BRC2     SA5    B6+BCFLW
          NX4,B3 X5          EXTRACT FUNCTION FROM LIST
          SX4    B3
          LX4    -1
          SB3    X4          BRANCH TABLE INDEX
          SA0    B6
          SX6    B6          SAVE *BCT* ENTRY ADDRESS
          SA6    BRCF
          SA1    B6+BCSAW
          ERRNZ  BCSAS-17    TEMPORARY STORAGE ADDRESS NOT IN BIT 17
          SB5    X1+         *TAF* STORAGE AREA ADDRESS
          SB6    B6+BCSFW    SFCALL AREA ADDRESS
          JP     B3+BRCJT    BRANCH TO PROCESS FUNCTION
 
*         JUMP TABLE TO HANDLE *BCT* FUNCTION LIST.
 
 BRCJT    PL     X4,BRC3     IF VALIDATE BATCH ACCESS
          EQ     BRC9        REQUEST SUBCONTROL POINT
          PL     X4,BRC13    IF READ RECORD FROM *UCP*
          EQ     BRC14       QUEUE REQUEST TO *AAM* INPUT QUEUE
          PL     X4,BRC21    IF WRITE RECORD TO *UCP*
          EQ     BRC22       WRITE *CRF* RECOVERY FILE
          PL     X4,BRC25    IF COMPLETE TASK
          EQ     BRC28       CLEAR LONG TERM CONNECT
          PL     X4,BRC34    IF REQUEST COMPLETE
          RJ     EXIT        FATAL ERROR
 
*         VALIDATE BATCH ACCESS.
 
 BRC3     RJ     GTS         GET TEMPORARY STORAGE
          SA4    BRCF
          SB6    X4+         RESTORE *BCT* ADDRESS
          NZ     B3,BRC4     IF STORAGE AVAILABLE
          SX1    BCNTS       WAITING FOR STORAGE CONSTRAINT CODE
          RJ     SCC         SET REQUEST CONSTRAINED
          EQ     BRC1        CHECK NEXT ENTRY
 
 BRC4     SA1    B6+BCSAW    *BCT* STORAGE AREA ADDRESS
          MX0    -BCSAN
          BX6    X0*X1
          ERRNZ  BCSAN-18    TEMPORARY STORAGE ADDRESS NOT 18 BITS
          SX1    B3          SAVE *TAF* STORAGE AREA ADDRESS
          ERRNZ  BCSAS-17    TEMPORARY STORAGE ADDRESS NOT IN BIT 17
          BX6    X6+X1
          SA6    A1
          SB5    B3
          SB6    B6+BCSFW
 
*         GET USER NAME OF BATCH JOB.
 
 BRC5     SX6    B6+BCKAW-BCSFW  USE KEYAREA FOR JOB ID
          SX1    /COMSSCP/CPID  SFCALL FUNCTION CODE
          LX6    6           POSITION *SCP* ADDRESS
          BX6    X6+X1
          SA6    B6+         SET SFCALL PARAMETERS IN *BCT*
          SX2    BRC5        RETRY ADDRESS IF JOB SWAPPED OUT
          RJ     SFR         ISSUE SF.CPID FUNCTION
 
*         CHECK USER NAME AGAINST *TAF* VALIDATION RULES.
 
          SB6    B6+BCKAW-BCSFW  RECOVERY REQUEST AREA
          SA4    B6+1        USER NAME FROM CPID FUNCTION
          SX1    TYRM        BATCH/CRM VALIDATION
          SX5    BRC6        RETURN ADDRESS
          EQ     VBA         VALIDATE BATCH ACCESS
 
 BRC6     SA1    B6+BRTAW    *TST* ADDRESS
          SB6    B6-BCKAW+BCSFW  SFCALL AREA ADDRESS
          ERRNZ  BRTAS-17    *TST* ADDRESS DOES NOT START IN BIT 17
          SX6    X1
          SA1    B6+BCTAW-BCSFW
          MX0    60-BCSPN-BCTAN
          BX1    X0*X1       CLEAR *TST* AND SUBCP ADDRESSES
          LX6    BCTAS-BCTAN+1  POSITION *TST* ADDRESS
          BX6    X6+X1
          SA6    A1          STORE *TST* ADDRESS IN *BCT*
          SX1    X3-JSRC
          ZR     X1,BRC8     IF ACCESS VALID
          SB6    B6-BCSFW    *BCT* ADDRESS
 
*         RETURN ERROR STATUS.
 
 BRC7     SA1    B6+BCUPW    USER ERROR STATUS WORD
          MX0    48
          BX6    X0*X1
          BX6    X6+X3
          SA6    A1          SET ERROR STATUS IN USER PARAMETERS
          MX0    BCERN
          LX0    BCERS-59
          SA1    B6+BCERW    VALIDATION ERROR FLAG
          BX6    X1+X0
          SA6    A1          SET ERROR FLAG IN *BCT*
          SX2    CTFN+CLFN+ENFN  COMPLETE TASK AND CLEAR CONNECT
          RJ     SFL         SET BITS IN FUNCTION LIST
          EQ     BRC2        PROCESS NEXT FUNCTION
 
*         USER IS VALID.  SET LONG TERM CONNECTION.
 
 BRC8     SX6    /COMSSCP/SLTC  SET LONG TERM CONNECT FUNCTION
          SA6    B6+
          SX2    BRC8        RETRY ADDRESS
          RJ     SFR         ISSUE LONG TERM CONNECT FUNCTION
          SX3    X5          RETURN CODE
          SB6    B6-BCSFW    *BCT* ADDRESS
          SX4    B6          SAVE *BCT* ADDRESS
          NZ     X5,BRC7     IF SFCALL ERROR
          SA2    B6+BCKAW+BRTOW  GET *TST* ORDINAL
          MX0    -BRTON
          LX2    BRTON-BRTOS-1
          BX1    -X0*X2
          RJ     ASN         ASSIGN SEQUENCE NUMBER
          SB6    X4          RESTORE *BCT* ADDRESS
          LX6    BCTSS-BCTSN+1  POSITION SEQUENCE NUMBER
          SA6    B6+BCTSW    SET SEQUENCE NUMBER IN *BCT*
          SX6    VLFN        VALIDATE ACCESS FUNCTION
          EQ     BRC35       FUNCTION COMPLETE
 
*         REQUEST SUBCONTROL POINT.
 
 BRC9     RJ     RSP         RESTORE SUBCP REGISTERS
          SA1    VBCT        BATCH SUBCP LENGTH
          SX0    X1+
          RJ     RCP         REQUEST SUBCP
          SA1    BRCF
          SB6    X1+         *BCT* ADDRESS
          NZ     X5,BRC10    IF SUBCP AVAILABLE
          SX1    BCNSC       WAITING FOR SUBCP
          RJ     SCC         SET CONSTRAINT CODE IN *BCT*
          EQ     BRC1        CHECK NEXT *BCT* ENTRY
 
 BRC10    SB5    X5+NUAPL    RA OF SUBCP
          MX0    SCBCN
          LX0    SCBCS-59    INDICATE SUBCP FOR BATCH CONCURRENCY
          SA1    B4
          ERRNZ  SCBCW       BATCH CONCURRENCY FLAG NOT IN WORD ZERO
          ERRNZ  SCBCW       IF BATCH FLAG NOT IN WORD ZERO
          SX6    B6
          SA6    X5+BCTA     STORE *BCT* ADDRESS IN SYSTEM AREA
          BX6    X1+X0
          SA6    B4          SET BATCH CONCURRENCY BIT IN SUBCP
          TX3    B4+CPAL,-VCPA  COMPUTE SUBCP NUMBER
          AX3    SCPAL
          SX6    B4
          SA1    B6          *BCT* FIRST WORD
          ERRNZ  BCSPW       IF SUBCP ADDRESS NOT IN WORD ZERO
          BX6    X1+X6       ADD SUBCP TABLE ADDRESS
          SA6    B6          STORE IN *BCT*
          SA1    B6+BCSNW
          SB3    X1          *TAF* STORAGE AREA ADDRESS
          ERRNZ  BCSNS-53    SUBCP NUMBER DOES NOT START IN BIT 53
          LX3    BCSNS-BCSNN+1  POSITION SUBCP NUMBER
          BX6    X1+X3
          SA6    A1          SAVE SUBCP NUMBER IN *BCT*
          SA1    B6          *BCT* FIRST WORD
          ERRNZ  BCTAW       IF *TST* ADDRESS NOT IN WORD ZERO
          MX0    -BCTAN
          LX1    BCTAN-1-BCTAS  RIGHT JUSTIFY *TST* ADDRESS
          SA1    X1          *TST* ENTRY
          BX2    X1
          LX2    TSDBN-1-TSDBS  RIGHT JUSTIFY DATA BASE NAME
          MX0    -TSDBN
          BX6    -X0*X2
          LX1    59-TSARS    POSITION RECOVERY REQUIRED BIT
          SA6    X5+DBNC     SET DATA BASE NAME IN SUBCP SYSTEM AREA
          SX6    2RBC        GENERATE TASK NAME FOR BATCH JOB
          SA2    B6+BCJNW    JOB HASH
          MX0    24
          BX2    X0*X2       JOB HASH + *BC*
          BX6    X6+X2
          LX6    59-11       LEFT JUSTIFY TASK NAME
          SA6    X5+BCTN     SET NAME IN SUBCP SYSTEM AREA
          SX6    RSFN        REQUEST SUBCP FUNCTION LIST BIT
          PL     X1,BRC35    IF RECOVERY NOT REQUIRED
 
*         BUILD RESTORE DATA BASE ID REQUEST.
 
          SB2    B5+BSAR     ADDRESS OF ARGUMENT ARRAY
          SX6    B5+BSUP     ADDRESS OF ARGUMENTS
          SB3    B5+BSRE     LWA OF ARGUMENT ARRAY
 BRC11    SA6    B2          STORE ARGUMENT ADDRESS
          SB2    B2+B1
          SX6    X6+1        INCREMENT ARGUMENT ADDRESS
          LE     B2,B3,BRC11  IF MORE ARGUMENTS
          SX6    B0
          SA6    B2          ZERO TERMINATES ARRAY
          SA1    B6+BRNIW
          SA2    B6+BROIW
          BX6    X1
          SA6    B5+BSNI     CURRENT BEGIN ID
          BX6    X2
          SA6    B5+BSOI     OLD BEGIN ID
          SX4    BRC12       COMPLETION ADDRESS
          SX5    /COMKCRM/TRRI  RESTORE DATA BASE FUNCTION CODE
          RJ     BAM         PUT REQUEST IN INPUT QUEUE
          NZ     X7,BRC1     IF REQUEST QUEUED
          SX1    BCRDI       WAITING TO QUEUE REQUEST
          RJ     SCC         SET REQUEST CONSTRAINED
          EQ     BRC1        CHECK NEXT *BCT* ENTRY
 
*         DATA BASE ID HAS BEEN RESTORED.
 
 BRC12    SB6    X2-BCSFW    *BCT* FWA
          SX6    RSFN        REQUEST SUBCP FUNCTION LIST BIT
          EQ     BRC35       FUNCTION COMPLETE
 
*         READ RECORD FROM USER CONTROL POINT.
 
 BRC13    SA1    B6+BCSNW-BCSFW
          LX1    BCSNN-1-BCSNS  RIGHT JUSTIFY SUBCP
          MX0    -BCSNN
          BX1    -X0*X1      SUBCP NUMBER
          SX6    B0
          RJ     GRA         GET RA OF SUBCP
          SX6    X6+BSRB     RECORD AREA WITHIN SUBCP
          SA1    B6+BCWSW-BCSFW  WORKING STORAGE AREA WITHIN *UCP*
          LX1    24
          BX6    X6+X1       ADD *SCP* ADDRESS
          SA6    B6+BCEUW-BCSFW  MOVE TO *BCT* SFCALL AREA
          SA1    B6+BCWLW-BCSFW  RECORD LENGTH IN CHARACTERS
          SX1    X1+9        INSURE LAST WORD IS READ
          SX2    10          CHARACTERS PER WORD
          IX6    X1/X2       RECORD LENGTH IN WORDS
          LX6    53-11       POSITION TO FP AREA
          SX1    /COMSSCP/XRED  EXTENDED READ FUNCTION
          BX6    X6+X1
          SX2    BRC13       RETRY ADDRESS
          SA1    B6+BCSAW-BCSFW
          SA6    B6          STORE SFCALL PARAMETERS
          SB5    X1          *TAF* STORAGE AREA ADDRESS
          RJ     SFR         ISSUE SFCALL EXTENDED READ
          SB6    B6-BCSFW    RESTORE *BCT* ADDRESS
          SX6    RRFN        READ RECORD FUNCTION LIST BIT
          SX1    X5-/COMSSCP/RC43
          SX3    JSFL        ERROR RETURN CODE
          ZR     X1,BRC7     IF *UCP* ADDRESS NOT WITHIN FL
          EQ     BRC35       REQUEST COMPLETE
 
*         CONSTRUCT *CRM* REQUEST.
 
 BRC14    SB6    A0          *BCT* FWA
          SA1    B6+BCSNW
          LX1    BCSNN-1-BCSNS  RIGHT JUSTIFY SUBCP
          MX0    -BCSNN
          BX1    -X0*X1      SUBCP NUMBER
          SX6    B0+
          RJ     GRA         GET RA OF SUBCP
          SB5    X6          SAVE SUBCP RA
          BX7    X7-X7
          SA7    B5+DMEC-NUAPL  CLEAR FATAL D.M. ERROR CODE
          SX1    BCUPL       NUMBER OF WORDS TO MOVE
          SX2    B6+BCUPW    SOURCE ADDRESS IN *BCT*
          SX3    X6+BSUP     DESTINATION ADDRESS IN SUBCP
          RJ     MVE=        MOVE PARAMETERS TO SUBCP
          SA1    BRCF        *BCT* ADDRESS
          SB4    B5+BSCE     LWA+1 OF ARGUMENT ARRAY
          SX6    BSUP+1      FWA OF USER PARAMETERS
          SB2    B5+BSAR     FWA OF ARGUMENT ARRAY
 BRC15    SA6    B2          STORE ADDRESS OF PARAMETERS
          SB2    B2+B1       INCREMENT ARRAY ADDRESS
          SX6    X6+1        INCREMENT PARAMETER ADDRESS
          LT     B2,B4,BRC15 IF MORE PARAMETERS
          SB6    X1          RESTORE *BCT* ADDRESS
          MX0    -6
          SA1    B6+BCUPW    USER PARAMETERS
          LX1    -18
          BX4    -X0*X1      EXTRACT ARGUMENT COUNT
          LX1    -6
          BX5    -X0*X1      EXTRACT TAF/CRM FUNCTION CODE
          BX1    X5
          LX1    59-0
          SA3    X1+BCFT     FUNCTION TABLE ENTRY
          NG     X1,BRC16    IF LOWER ENTRY IN TABLE
          LX3    BFUEN-1-BFUES  RIGHT JUSTIFY UPPER ENTRY
 BRC16    LX3    BFWSN-1-BFWSS  RIGHT JUSTIFY WSA INDEX
          SB2    B5+BSAR     ARGUMENT ARRAY ADDRESS
          MX0    -BFWSN
          BX1    -X0*X3      WORKING STORAGE AREA WORD
          ZR     X1,BRC17    IF FUNCTION DOES NOT USE WSA
          SX6    BSWS        WORKING STORAGE AREA ADDRESS
          SA6    X1+B2       STORE ADDRESS IN ARGUMENT ARRAY
 BRC17    LX3    BFKNN-1-BFKNS+BFWSS-BFWSN+1  KEYNAME INDEX
          BX1    -X0*X3      KEYNAME WORD
          SX6    BSKN        KEYNAME AREA ADDRESS
          ZR     X1,BRC18    IF FUNCTION DOES NOT USE KEYNAME
          SA6    X1+B2       STORE KEYNAME ADDRESS IN ARRAY
 BRC18    LX3    BFKAN-1-BFKAS+BFKNS-BFKNN+1  KEYAREA INDEX
          BX1    -X0*X3      KEYAREA WORD
          SX6    BSKA        KEYAREA ADDRESS
          MX0    -BFTSN
          ZR     X1,BRC19    IF FUNCTION DOES NOT USE KEYAREA
          SA6    X1+B2       STORE KEYAREA ADDRESS IN ARRAY
 BRC19    BX6    X6-X6
          SA6    X4+B2       STORE END OF ARGUMENT ARRAY
          LX3    BFTSN-1-BFTSS+BFKAS-BFKAN+1  *TAF* STATUS AREA INDEX
          BX6    -X0*X3
          SA6    B5+DMEC-NUAPL  SAVE FOR FATAL D.M. ERROR
          SX4    BRC20       COMPLETION ADDRESS
          RJ     BAM         PUT REQUEST IN INPUT QUEUE
          NZ     X7,BRC1     IF REQUEST QUEUED
          SX1    BCAMC       WAITING TO QUEUE REQUEST
          RJ     SCC         SET REQUEST CONSTRAINED
          EQ     BRC1        CHECK NEXT *BCT* ENTRY
 
 BRC20    SB6    X2-BCSFW    *BCT* ADDRESS
          SX6    QRFN        QUEUE REQUEST FUNCTION LIST BIT
          EQ     BRC35       FUNCTION COMPLETE
 
*         WRITE RECORD TO USER CONTROL POINT.
 
 BRC21    SA1    B6+BCSNW-BCSFW
          LX1    BCSNN-1-BCSNS  RIGHT JUSTIFY SUBCP
          MX0    -BCSNN
          BX1    -X0*X1      SUBCP NUMBER
          SX6    B0
          RJ     GRA         GET RA OF SUBCP
          SB4    X6+         RA OF SUBCP
          SX6    X6+BSRB     RECORD AREA WITHIN SUBCP
          SA1    B6+BCWSW-BCSFW  WORKING STORAGE AREA WITHIN *UCP*
          LX1    24
          BX6    X6+X1       ADD *SCP* ADDRESS
          SA6    B6+BCEUW-BCSFW  MOVE TO *BCT* SFCALL AREA
          SA1    B4+BSRL     RECORD LENGTH IN CHARACTERS
          SX1    X1+9        INSURE LAST WORD IS WRITTEN
          SX2    10          CHARACTERS PER WORD
          IX6    X1/X2       RECORD LENGTH IN WORDS
          SX1    /COMSSCP/XWRT  EXTENDED WRITE FUNCTION
          LX6    53-11       POSITION RECORD LENGTH TO FP AREA
          BX6    X6+X1
          SX2    BRC21       RETRY ADDRESS
          SA6    B6          SFCALL PARAMETERS
          SA1    B6+BCSAW-BCSFW
          SB5    X1          *TAF* STORAGE AREA ADDRESS
          RJ     SFR         ISSUE SFCALL EXTENDED WRITE
          SB6    B6-BCSFW    RESTORE *BCT* ADDRESS
          SX6    WRFN        WRITE RECORD FUNCTION LIST BIT
          SX1    X5-/COMSSCP/RC43
          SX3    JSFL        ERROR RETURN CODE
          ZR     X1,BRC7     IF *UCP* ADDRESS NOT WITHIN FL
          EQ     BRC35       FUNCTION COMPLETE
 
*         WRITE COMMIT HISTORY TO *CRF*.
 
 BRC22    SB6    A0          *BCT* FWA
          SA1    B6+BCTSW    TRANSACTION SEQUENCE NUMBER
          BX6    X1
          LX6    BCTSN-1-BCTSS  RIGHT JUSTIFY SEQUENCE NUMBER
          SA6    B6+BCWPW+1  *WSTAT* PARAMETER AREA IN *BCT*
          SX7    TYRM
          SA7    A6+1        STORE TRANSACTION TYPE IN AREA
          SX6    CSBC
          SA6    A7+B1       STORE RECOVERABLE TRAN STEP IN AREA
          SX7    B1
          SA7    A6+1        INDICATE *CRM* DATA MANAGER
          SX6    BRCC        FWA OF *WSTAT* KEYWORDS
          SX7    B6+BCWPW    FWA OF PARAMETER AREA
          SX5    B6+BCWAW    FWA OF ARGUMENT ARRAY
 BRC23    SA7    X5          STORE PARAMETER ADDRESS IN ARRAY
          SA6    A7+1        STORE KEYWORD ADDRESS IN ARRAY
          SX5    A6+B1       INCREMENT ARRAY ADDRESS
          SX6    X6+B1       INCREMENT KEYWORD ADDRESS
          SX7    X7+B1       INCREMENT PARAMETER ADDRESS
          SX2    X6-BRCD
          NZ     X2,BRC23    IF NOT END OF ARGUMENT ARRAY
          SX6    B0
          SA6    A6          STORE END OF ARRAY
 
*         QUEUE RECOVERY REQUEST.
 
          SX4    QTEV        EVENT TYPE
          SB3    B6+BCWQW    QUEUEING AREA IN *BCT*
          SX6    B0
          SA6    B5+QRTCW    CLEAR COMPLETE BIT
          SX1    A6          EVENT ADDRESS
          SX2    B0          SHIFT COUNT FOR COMPLETE BIT
          BX3    X3-X3       SUBCP NUMBER
          SX5    B0          NOT A TIMED EVENT
          SB4    B0          QUEUE AT END OF QUEUE
          SX6    BRC24       EVENT COMPLETE ADDRESS
          RJ     QTW         QUEUE *TAF* WORK
 
*         WRITE RECOVERY INFORMATION TO *CRF*.
 
          SA5    BRCE        *REC* SYSTEM REQUEST
          SX1    B6+BCWAW
          BX5    X5+X1       ADD ARGUMENT ARRAY ADDRESS
          SA1    B6+BCTAW    GET TERMINAL STATUS WORD
          ERRNZ  BCSPW       IF SUBCP ADDRESS NOT IN WORD ZERO
          LX1    BCTAN-1-BCTAS  RIGHT JUSTIFY *TST* ADDRESS
          MX0    -BCTAN
          TX2    0,VTST      *TST* FWA
          BX1    -X0*X1
          IX7    X1-X2
          SX0    TSTLLE
          IX7    X7/X0       *TST* ORDINAL
          SB5    B0          SUBCP RA
          BX6    X6-X6       SUBCP NUMBER
          LX5    -18         POSITION REQUEST FOR CALL TO *WFP*
          SA1    B6+BCSAW    *TAF* STORAGE AREA ADDRESS
          SB3    X1
          EQ     WFP         *WSTAT* RECOVERY REQUEST
 
 BRC24    SX6    WTFN        WRITE *CRF* FUNCTION
          SB6    B3-BCWQW    *BCT* FWA
          EQ     BRC35       FUNCTION COMPLETE
 
*         RETURN STATUS INFORMATION TO UCP.
 
 BRC25    SA1    B6+BCSNW-BCSFW
          LX1    BCSNN-1-BCSNS  RIGHT JUSTIFY SUBCP
          MX0    -BCSNN
          BX1    -X0*X1      SUBCP NUMBER
          SX6    B0
          RJ     GRA         GET RA OF SUBCP
          SX2    X6+BSUP     SCPA ADDRESS IN SUBCP
          SA1    B6+BCPAW-BCSFW  *UCP* ADDRESS IN *BCT*
          LX1    BCPAN-1-BCPAS  RIGHT JUSTIFY *UCP* ADDRESS
          SX1    X1+B1
          SX6    BCUPL       NUMBER OF WORDS TO RETURN
          SA3    B6+BCERW-BCSFW  VALIDATION STATUS WORD
          LX3    59-BCERS
          SX0    B1          COMPLETE BIT
          PL     X3,BRC26    IF NOT VALIDATION ERROR
          SX6    B1+         ONE WORD OF STATUS RETURNED
          SX2    B6+BCUPW-BCSFW  RETURN STATUS FROM *BCT*
 BRC26    LX6    18
          BX6    X6+X1       ADD *UCP* ADDRESS
          LX6    18
          BX6    X6+X2       ADD SCPA ADDRESS IN SUBCP
          SA3    X2          *UCP* STATUS WORD
          BX7    X0+X3       SET COMPLETE BIT
          SA7    X2
          LX6    6
          SX1    /COMSSCP/WRIT  ADD SF.WRIT FUNCTION CODE
          BX6    X6+X1
          SA6    B6          STORE SFCALL PARAMETERS
          SX2    BRC25       RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL WRITE REQUEST
 
*         ISSUE END TASK FUNCTION TO UCP.
 
 BRC27    SA1    B6+BCPAW-BCSFW  *BCT* FIRST WORD
          LX1    BCPAN-1-BCPAS  RIGHT JUSTIFY PARAMETER ADDRESS
          SX6    X1
          LX6    24
          SX1    /COMSSCP/ENDT  ADD ENDTASK FUNCTION CODE
          BX6    X6+X1
          SA6    B6+         STORE SFCALL PARAMETERS
          SX2    BRC27       RETRY ADDRESS IF FUNCTION REJECT
          RJ     SFR         ISSUE SF.ENDT FUNCTION
          SB6    B6-BCSFW    RESTORE *BCT* FWA
          SX6    CTFN        COMPLETE TASK FUNCTION
          EQ     BRC35       PROCESS NEXT FUNCTION
 
*         CLEAR LONG TERM CONNECT WITH UCP.
 
 BRC28    SX7    X7-BCCSC
          ZR     X7,BRC30.1  IF RETRY OF DATA MANAGER CEASE
          SA1    A0+BCABW    CHECK FOR *UCP* ABORT
          LX1    59-BCABS
          PL     X1,BRC29    IF NOT *UCP* ABORT
 BRC28.1  MX1    17          CLEAR ALL OUTSTANDING REQUESTS
          SX6    /COMSSCP/ENDT  END TASK FUNCTION CODE
          LX1    41-59       POSITION *UCPA*
          BX6    X6+X1
          SA6    B6          SAVE SFCALL PARAMETERS
          SX2    BRC28.1     RETRY ADDRESS
          RJ     SFR         ISSUE SF.ENDT FUNCTION
          EQ     BRC30       WRITE *STEP* TO *CRF*
 
 BRC29    SA1    A0+BCERW    *BCT* FIRST WORD
          SX6    /COMSSCP/CLTC  CLEAR LONG TERM CONNECT FUNCTION
          SX1    X1          SUBCP TABLE ADDRESS
          ZR     X1,BRC33    IF NO SUBCP ASSIGNED
          SA6    B6          STORE SFCALL PARAMETERS
          SX2    BRC29       RETRY ADDRESS IF FUNCTION REJECT
          RJ     SFR         ISSUE SF.CLTC FUNCTION
 
*         BUILD *WSTAT* REQUEST TO LOG TERMINATION *STEP* TO *CRF*.
 
 BRC30    SB6    B6-BCSFW    *BCT* ADDRESS
          SX6    CSCE        BATCH CEASE/JOB END *STEP*
          SA6    B6+BCWPW+1  *WSTAT* PARAMETER AREA IN BCT
          SX7    B6+BCWPW    FWA OF PARAMETER AREA
          SX5    B6+BCWAW    FWA OF ARGUMENT ARRAY
          SX6    BRCC+2      *STEP* KEYWORD
          SA7    X5          STORE PARAMETER ADDRESS IN ARRAY
          SA6    A7+1        STORE KEYWORD ADDRESS
          SX7    X7+1        STORE KEYWORD VALUE ADDRESS
          SA7    A6+B1
          BX6    X6-X6
          SA6    A7+B1       STORE END OF ARRAY
 
*         QUEUE RECOVERY REQUEST.
 
          SX4    QTEV        EVENT TYPE
          SB3    B6+BCWQW    QUEUEING AREA IN *BCT*
          SX6    B0
          SA6    B5+QRTCW    CLEAR COMPLETE BIT
          SX1    A6          EVENT ADDRESS
          SX2    B0          SHIFT COUNT FOR COMPLETE BIT
          BX3    X3-X3       SUBCP NUMBER
          SX5    B0          NOT A TIMED EVENT
          SB4    B0          QUEUE AT END OF QUEUE
          SX6    BRC30.1     EVENT COMPLETE ADDRESS
          RJ     QTW         QUEUE *TAF* WORK
 
*         WRITE RECOVERY INFORMATION TO *CRF*.
 
          SA5    BRCE        *REC* SYSTEM REQUEST
          SX1    B6+BCWAW
          BX5    X5+X1       ADD ARGUMENT ARRAY ADDRESS
          SA1    B6+BCTAW    GET TERMINAL STATUS WORD
          ERRNZ  BCSPW       SUBCP ADDRESS NOT IN WORD ZERO
          LX1    BCTAN-1-BCTAS  RIGHT JUSTIFY *TST* ADDRESS
          MX0    -BCTAN
          TX2    0,VTST      *TST* FWA
          BX1    -X0*X1
          IX7    X1-X2
          SX0    TSTLLE
          IX7    X7/X0       *TST* ORDINAL
          SB5    B0          SUBCP RA
          BX6    X6-X6       SUBCP NUMBER
          LX5    -18         POSITION REQUEST FOR CALL TO *WFP*
          SA1    B6+BCSAW    *TAF* STORAGE AREA ADDRESS
          SB3    X1
          EQ     WFP         *WSTAT* RECOVERY REQUEST
 
*         ISSUE DATA MANAGER CEASE.
 
 BRC30.1  SB6    B3-BCWQW    *BCT* ADDRESS
          SX5    DMCC        D.M. CEASE FUNCTION CODE
          SX4    BRC31       COMPLETION ADDRESS
          RJ     BAM         PUT REQUEST IN INPUT QUEUE
          NZ     X7,BRC1     IF REQUEST QUEUED
          SX1    BCCSC       WAITING TO QUEUE REQUEST
          RJ     SCC         SET REQUEST CONSTRAINED
          EQ     BRC1        CHECK NEXT *BCT* ADDRESS
 
*         RELEASE SUBCONTROL POINT.
 
 BRC31    SA0    X2-BCSFW    *BCT* ADDRESS
          SB3    BRC32       RETURN ADDRESS FROM *ESCP1*
          SA1    A0
          ERRNZ  BCSPW       IF SUBCP ADDRESS NOT IN WORD ZERO
          SB6    X1          SUBCP TO RELEASE
          ERRNZ  BCSPS-17    SUBCP ADDRESS DOES NOT START IN BIT 17
          MX0    SCBCN       CLEAR BATCH CONCURRENCY BIT IN SUBCP
          LX0    SCBCS-59
          SA1    B6
          ERRNZ  SCBCW       IF BATCH FLAG NOT IN WORD ZERO
          BX6    -X0*X1
          SA6    B6+
          EQ     ESCP1       RELEASE SUBCP
 
*         SET USER INACTIVE AND RELEASE *BCT* ENTRY.
 
 BRC32    SA1    AVAILCM     UPDATE AVAILABLE CM
          SA2    VBCT
          SX2    X2
          IX6    X1+X2
          SA6    A1
          SA1    A0          FIRST WORD OF *BCT*
          ERRNZ  BCTAW       IF *TST* ADDRESS NOT IN WORD ZERO
          LX1    BCTAN-1-BCTAS
          MX0    TSAUN
          LX0    TSAUS-59
          SA1    X1          *TST* ENTRY
          ERRNZ  TSAUW       USER ACTIVE NOT IN WORD ZERO OF *TST*
          BX6    -X0*X1      CLEAR USER ACTIVE IN *TST*
          SA6    A1
 BRC33    SA2    A0+BCSAW
          SB3    X2          *TAF* STORAGE ADDRESS
          SX6    B0
          SA6    A0          RELEASE *BCT* ENTRY
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          RJ     RTS         RELEASE TEMPORARY STORAGE
 
*         BATCH *CRM* REQUEST IS COMPLETE.
 
 BRC34    MX0    BCACN+BCRAN+BCABN+BCERN
          SA1    A0          FIRST WORD OF *BCT*
          ERRNZ  BCACW+BCRAW+BCABW+BCERW  IF ALL FIELDS NOT IN WORD 0
          ERRNZ  59-BCACS    FIELD NOT IN BIT 59
          ERRNZ  BCACS-BCACN-BCRAS  FIELDS NOT ADJACENT
          ERRNZ  BCACW       FIELD NOT IN WORD ZERO
          ERRNZ  BCACW-BCRAW FIELDS NOT IN SAME WORD
          ERRNZ  BCRAW-BCABW FIELDS NOT IN SAME WORD
          ERRNZ  BCABW-BCERW FIELDS NOT IN SAME WORD
          BX6    -X0*X1      CLEAR ACTIVE BITS
          SA6    A0
          SA1    PBCA        REQUEST COUNT
          SX2    B1
          IX6    X1-X2       DECREMENT OUSTANDING REQUESTS
          SA6    A1+
          NZ     X6,BRC1     IF MORE REQUESTS TO PROCESS
          EQ     TSSC        TIME SLICE SUBCP
 
*         FUNCTION COMPLETE.
 
 BRC35    LX6    BCFLS-BCFLN+1  POSITION FUNCTION COMPLETE BIT
          SA1    B6+BCFLW    FUNCTION LIST WORD
          BX6    -X6*X1      CLEAR BIT IN FUNCTION LIST
          SA6    A1
          EQ     BRC2        PROCESS NEXT FUNCTION
 
 BRCA     BSSZ   1           *BCT* FIRST WORD ADDRESS
 BRCB     BSSZ   1           NUMBER OF *BCT* ENTRIES
 BRCC     DATA   10HSEQ        *WSTAT* KEYWORDS
          DATA   10HTRAN
          DATA   10HSTEP
          DATA   10HCRM
          BSSZ   1
 BRCD     EQU    *           END OF KEYWORDS
 BRCE     VFD    24/3LCTI,18/RFWS,18/0  *REC* SYSTEM REQUEST
 BRCF     BSSZ   1           CURRENT *BCT* ADDRESS
 BJT      SPACE  4,15
**        BJT -  BATCH JOB TERMINATION.
*
*         ENTRY  (X4) = STATUS FIELD FROM *SCP* BUFFER.
*
*         EXIT   (BCACS) = 1.
*                (BCRAS) = 1.
*                (BCABS) = 1, IF BATCH JOB ABORTED.
*                (BCFLS) = CLFN, CLEAR LONG TERM CONNECT.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 3, 5, 6, 7.
*
*         CALLS  SBC, SCC, SFL.
 
 
 BJT      SUBR               ENTRY/ EXIT
          SA5    SSJN        JOB SEQUENCE NUMBER AND *FST*
          RJ     SBC         SEARCH FOR *BCT* ENTRY
          ZR     B6,BJTX     IF NOT FOUND, RETURN
          SA3    B6+B1       CHECK TERMINATION FLAG
          LX3    59-BCTES
          NG     X3,BJTX     IF ALREADY RECEIVED TERMINATION REQUEST
          MX6    BCTEN       SET TERMINATION FLAG
          BX6    X6+X3
          LX6    BCTES-59    SHIFT BACK
          SA6    A3
          SX1    X4-1        TEST MESSAGE TYPE
          MX0    BCACN+BCRAN
          ZR     X1,BJT1     IF NORMAL JOB TERMINATION
          MX0    BCACN+BCRAN+BCABN
          ERRNZ  BCACW       NOT IN WORD ZERO
          ERRNZ  BCACW-BCRAW FIELDS NOT IN SAME WORD
          ERRNZ  BCABW-BCRAW FIELD NOT IN SAME WORD
 BJT1     SA3    B6          *BCT* ENTRY
          ERRNZ  BCACW+BCRAW+BCABW  IF ALL FIELDS NOT IN WORD ZERO
          BX6    X0+X3
          SA6    B6+         SET REQUEST ACTIVE IN *BCT*
          SX2    CLFN+ENFN   CLEAR LONG TERM CONNECT FUNCTION
          RJ     SFL         SET FUNCTION LIST
          NG     X3,BJTX     IF REQUEST ALREADY ACTIVE
          SA1    PBCA        REQUEST COUNT
          SX2    B1
          IX6    X1+X2       ADVANCE OUTSTANDING REQUESTS
          SA6    A1+
          SX1    BCTRC       TERMINATE CONSTRAINT CODE
          RJ     SCC         SET CONSTRAINT CODE IN *BCT*
          SA1    ITIME       REAL TIME CLOCK
          BX7    X1
          SA7    RDCBD       SET CLOCK AT LAST BATCH REQUEST
          EQ     BJTX        RETURN
 PBC      SPACE  4,20
**        PBC -  PROCESS BATCH CONCURRENCY REQUEST.
*
*         ENTRY  (SSRP) = SUBSYSTEM REQUEST BUFFER.
*                (VNBCT) = NUMBER OF BATCH *CRM* REQUESTS.
*                (ITIME) = CURRENT TIME.
*
*         EXIT   BRC, IF VALID TAF/CRM REQUEST.
*                PBE, IF INCORRECT BATCH REQUEST.
*
*         USES   X - ALL.
*                A - 1, 2, 5, 6, 7.
*                B - 3, 4, 6.
*
*         CALLS  MVE, SBC.
 
 
 PBC      SX5    JSDC        ERROR RETURN CODE
          SA2    VNBCT       NUMBER OF REQUESTS ALLOWED
          ZR     X2,PBE      IF BATCH CONCURRENCY DISABLED
          SX5    JSNC        ERROR RETURN CODE
          SA2    VAAM        AAM FILE MANAGER INITIALIIZATION FLAG
          ZR     X2,PBE      IF TAF/CRM DATA MANAGER NOT LOADED
          SA5    SSJN        JOB SEQUENCE NUMBER AND *FST*
          RJ     SBC         SEARCH FOR *BCT* ENTRY
          ZR     B6,PBC1     IF *BCT* ENTRY NOT FOUND
          SA1    B6          *BCT* ENTRY
          ERRNZ  BCRAW       IF ACTIVE FLAG NOT IN WORD ZERO
          LX1    59-BCRAS    POSITION ACTIVE BIT
          SX5    JSOR        ERROR RETURN CODE
          NG     X1,PBE      IF REQUEST ALREADY ACTIVE
          EQ     PBC2        *BCT* ENTRY EXISTS
 
 PBC1     BX5    X5-X5
          RJ     SBC         SEARCH *BCT* FOR EMPTY ENTRY
          SX5    JSTB        ERROR RETURN CODE
          ZR     B6,PBE      IF NO *BCT* ENTRIES AVAILABLE
          SA1    PBCA        NUMBER OF REQUESTS OUTSTANDING
          SA2    VNBCT
          LX2    -30
          SX2    X2+         NUMBER OF REQUESTS ALLOWED
          IX1    X1-X2
          PL     X1,PBE      IF REQUEST CANNOT BE PROCESSED
          SA5    SSJN        *UCP* JOB IDENTIFIER
          BX6    X5
          SA6    B6+BCJNW    MOVE JOB IDENTIFIER TO *BCT*
          SX6    VLFN+RSFN   VALIDATE AND REQUEST SUBCP FUNCTIONS
          LX6    BCFLS-BCFLN+1
          SA6    B6+BCFLW    SET  BITS IN FUNCTION LIST
 PBC2     SA2    ITIME       REAL TIME CLOCK
          BX7    X2
          SA7    RDCBD       SET CLOCK AT LAST BATCH REQUEST
          SA1    SSRP
          SX1    X1          *UCP* PARAMETER AREA ADDRESS
          SA2    B6          FIRST WORD OF *BCT*
          ERRNZ  BCPAW       IF PARAMETER ADDRESS NOT IN WORD ZERO
          MX0    -BCPAN
          LX0    BCPAS-BCPAN+1  POSITION PARAMETER ADDRESS MASK
          BX2    X0*X2
          LX1    BCPAS-BCPAN+1
          BX2    X1+X2       ADD PARAMETER AREA ADDRESS
          MX0    BCACN+BCRAN
          ERRNZ  59-BCACS    FIELD NOT IN BIT 59
          ERRNZ  BCACS-BCACN-BCRAS  FIELDS NOT ADJACENT
          BX6    X0+X2       ADD *BCT* ACTIVE AND REQUEST ACTIVE BITS
          SA6    A2
          SA1    SSUP
          LX1    -24         RIGHT JUSTIFY *TAF/CRM* FUNCTION
          MX0    -6
          BX1    -X0*X1
          LX1    59-0
          SA2    X1+BCFT     FUNCTION TABLE ENTRY
          NG     X1,PBC3     IF LOWER ENTRY IN TABLE
          LX2    BFUEN-1-BFUES  RIGHT JUSTIFY UPPER ENTRY
 PBC3     MX6    -BCFLN
          BX6    -X6*X2      FUNCTION LIST FOR REQUEST
          LX6    BCFLS-BCFLN+1
          SA1    B6+B1
          ERRNZ  BCFLW-1     FIELD NOT IN WORD ONE
          BX6    X1+X6       ADD TO PREVIOUS FUNCTIONS
          SA6    A1          SET FUNCTION LIST IN *BCT*
          SX1    BCUPL       NUMBER OF WORDS TO MOVE
          SX2    SSUP        SOURCE ADDRESS IN *SCP* BUFFER
          SX3    B6+BCUPW    DESTINATION ADDRESS IN *BCT*
          SX5    B6          SAVE *BCT* ADDRESS
          RJ     MVE=        MOVE PARAMETERS TO *BCT*
          SB6    X5          RESTORE *BCT* ADDRESS
          SA1    BFPT
          BX6    X1
          SA6    VSCR        ACKNOWLEDGE *SCP* REQUEST
          SA1    PBCA        REQUEST COUNT
          SX2    B1
          IX6    X1+X2       ADVANCE OUTSTANDING REQUESTS
          SA6    A1
          EQ     BRC         EXIT TO BRC
 
 PBCA     BSSZ   1           OUTSTANDING BATCH CONCURRENCY REQUESTS
 
 SBC      SPACE  4,15
**        SBC -  SEARCH BATCH COMMUNICATION TABLE.
*
*         ENTRY  (X5) = JOB SEQUENCE NUMBER AND *FST* ORDINAL.
*                (X5) = 0 TO FIND AN EMPTY ENTRY.
*
*         EXIT   (B6) = *BCT* ADDRESS.
*                (B6) = 0 IF JOB IDENTIFIER NOT FOUND.
*
*         USES   X - 1, 2, 3.
*                A - 1, 2, 3.
*                B - 3, 6.
 
 
 SBC      SUBR               ENTRY/EXIT
          SA1    VNBCT       NUMBER OF *BCT* ENTRIES
          SB6    X1
          TX2    0,VBCT      *BCT* ADDRESS
          SB3    BCTL        *BCT* ENTRY LENGTH
 SBC1     ZR     B6,SBCX     IF JOB NOT IN *BCT*
          SA3    X2+BCJNW    JOB SEQUENCE NUMBER AND *FST*
          SB6    B6-B1       DECREMENT NUMBER OF ENTRIES
          BX3    X3-X5
          ZR     X3,SBC2     IF CORRECT ENTRY
          SX2    X2+B3       NEXT ENTRY ADDRESS
          EQ     SBC1        CHECK NEXT ENTRY
 
 SBC2     SB6    X2          *BCT* ADDRESS
          EQ     SBCX        RETURN
SCC       SPACE  4,10
**        SCC - SET CONSTRAINT CODE.
*
*         ENTRY  (X1) = CONSTRAINT CODE.
*                (B6) = *BCT* ADDRESS.
*
*         EXIT   CONSTRAINT CODE AND CONSTRAINT BIT SET IN *BCT* ENTRY.
*
*         USES   X - 0, 1, 5, 6.
*                A - 5, 6.
 
 
 SCC      SUBR               ENTRY/EXIT
          MX0    BCCNN
          LX0    BCCNS-59    POSITION CONSTRAINT BIT
          SA5    B6+BCCTW    CONSTRAINT WORD IN *BCT*
          LX1    BCCTS-BCCTN+1  POSITION CONSTRAINT CODE
          BX6    X0+X5
          BX6    X6+X1
          SA6    A5          SET REQUEST UNDER CONSTRAINT
          EQ     SCCX        RETURN
SFL       SPACE  4,10
**        SFL - SET FUNCTION LIST IN BCT.
*
*         ENTRY  (X2) = FUNCTION LIST RIGHT JUSTIFIED.
*                (B6) = *BCT* ADDRESS.
*
*         EXIT   FUNCTION LIST SET IN BCT.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 6.
 
 
 SFL      SUBR               ENTRY/EXIT
          MX0    -BCFLN      FUNCTION LIST MASK
          LX0    BCFLS-BCFLN+1  POSITION MASK
          LX2    BCFLS-BCFLN+1  POSITION FUNCTION LIST
          SA1    B6+BCFLW
          BX1    X0*X1       SAVE OTHER FIELDS
          BX6    X1+X2       ADD NEW FUNCTION LIST
          SA6    A1          STORE IN *BCT*
          EQ     SFLX        RETURN
 PBE      SPACE  4,40
**        PBE - PROCESS ERROR IN *UCP* REQUEST TO *TAF*.
*
*         ENTRY  (X5) = ERROR CODE TO RETURN TO *UCP*.
*
*                (SSRP) = 12/RIN,24/RSY,6/STAT,18/ADDR.
*                RIN    = RESERVED FOR INSTALLATION.
*                RSY    = RESERVED FOR SYSTEM.
*                STAT   = STATUS (TYPE OF MESSAGE).
*                ADDR   = ADDRESS WITHIN *UCP* OF PARAMETER BLOCK.
*
*                (SSJN) = *UCP* JOB SEQUENCE NUMBER AND *FST* ORDINAL.
*                (SSUP) = SECOND WORD OF *UCP* PARAMETER BLOCK.
*                (BFPT) = SUBSYSTEM REQUEST BUFFER POINTER.
*
*         EXIT   TO *TSSC*.
*
*         USES   X - 0, 1, 2, 6, 7.
*                B - 3, 5, 6.
*                A - 1, 6, 7.
*
*         CALLS  GTS, RTS, SFR.
*
*         NOTES  THE CONTENTS OF THE SFCALL PARAMETER AREA ARE
*
*                WORD 1 - 6/RC, 12/FP, 18/UCPA, 18/SCPA, 6/FC
*                         WHERE RC = RETURN CODE.
*                               FP = FUNCTION PARAMETER.
*                               UCPA = *UCP* ADDRESS.
*                               SCPA = *SCP* ADDRESS.
*                               FC = FUNCTION CODE.
*
*                WORD 2 - *UCP* JOB SEQUENCE NUMBER AND *FST* ORDINAL.
*
*                WORD 3 - 12/FC, 12/0, 12/SFC, 6/AC, 6/0, 12/(X5)
*                         WHERE FC = BATCH FUNCTION CODE.
*                               SFC = SUB FUNCTION CODE.
*                               AC = ARGUMENT COUNT.
*                               (X5) = ERROR CODE TO RETURN TO *UCP*.
*
*                WORD 4 - ADDRESS WITHIN USER CONTROL POINT OF
*                         BATCH/CRM OR BTRAN REQUEST PACKET.
 
 
 PBE      RJ     GTS         GET TEMPORARY STORAGE
          ZR     B3,TSSC     IF STORAGE NOT AVAILABLE, PROCESS LATER
          SB5    B3+         SAVE STORAGE ADDRESS
          RJ     GTS         GET SFCALL PARAMETER AREA
          NZ     B3,PBE1     IF STORAGE AVAILABLE
          SB3    B5+
          RJ     RTS         RELEASE TEMPORARY STORAGE
          EQ     TSSC        PROCESS REQUEST LATER
 
*         MOVE *UCP* PARAMETERS TO SFCALL AREA.
 
 PBE1     SB6    B3
          SA1    SSRP
          SX7    X1          *UCP* PARAMETER ADDRESS
          SA7    B6+BEPAW    SAVE IN TEMPORARY STORAGE
          SA1    SSUP        SECOND WORD OF *UCP* PARAMETERS
          MX0    42
          BX7    X0*X1
          BX7    X7+X5       ADD ERROR RETURN CODE
          SA7    A7-B1       SAVE WORD TO RETURN TO *UCP*
          SA1    SSJN
          BX7    X1
          SA7    A7-B1       MOVE JOB IDENTIFIER TO SFCALL AREA
          SA1    BFPT
          BX7    X1
          SA7    VSCR        ACKNOWLEDGE *UCP* REQUEST
 
*         RETURN ERROR STATUS TO *UCP*.
 
 PBE2     SA1    B6+BEPAW
          SX2    B1+
          LX2    18          NUMBER OF WORDS
          SX6    X1+B1       *UCP* PARAMETER AREA ADDRESS
          BX6    X6+X2
          LX6    18
          SX1    B6+BEESW    *SCP* RETURN CODE ADDRESS
          BX6    X6+X1
          LX6    6
          SX1    /COMSSCP/WRIT  ADD IN SF.WRIT FUNCTION CODE
          BX6    X6+X1
          SA6    B6          STORE SFCALL PARAMETERS
          SX2    PBE2        RETRY ADDRESS
          RJ     SFR         ISSUE SF.WRIT FUNCTION
          NZ     X5,PBE5     IF SFCALL ERROR RETURN
 
*         ABORT *UCP* IF INCORRECT REQUEST.
 
          SA1    B6+BEESW    ERROR RETURN CODE
          SX1    X1-JSFC
          NZ     X1,PBE4     IF NOT INCORRECT REQUEST
 PBE3     SA1    PBEB        REGRETS SFCALL PARAMETERS
          BX6    X1
          SA6    B6          STORE SFCALL PARAMETERS
          SX2    PBE3        RETRY ADDRESS IF JOB SWAPPED OUT
          RJ     SFR         ISSUE SF.REGR FUNCTION
 
*         INDICATE END OF TASK TO *UCP*.
 
 PBE4     SA1    B6+BEPAW
          SX6    X1          *UCP* PARAMETER ADDRESS
          LX6    41-17
          SX1    /COMSSCP/ENDT  ADD END TASK FUNCTION CODE
          BX6    X6+X1
          SA6    B6          STORE SFCALL PARAMETERS
          SX2    PBE4        RETRY ADDRESS IF JOB SWAPPED OUT
          RJ     SFR         ISSUE SF.ENDT FUNCTION
 PBE5     SB3    B6
          RJ     RTS         RELEASE SFCALL PARAMETER STORAGE
          SB3    B5
          RJ     RTS         RELEASE QUEUEING STORAGE
          EQ     TSSC        EXIT TO TIME SLICING
 
 PBEA     DATA   C* TAF FUNCTION CODE NOT VALID.*
 PBEB     VFD    6/0,12/0,18/1,18/PBEA,6//COMSSCP/REGR
SFR       SPACE  4,50
**        SFR - ISSUE SFCALL REQUEST.
*
*         ENTRY  (X2) = RETRY ADDRESS.
*                (B5) = *TAF* STORAGE AREA ADDRESS.
*                (B6) = SFCALL PARAMETER AREA ADDRESS.
*
*         EXIT   (X5) = 0 IF FUNCTION SUCCESSFUL.
*                     .NE. 0 IS SFCALL RETURN CODE.
*                TO RETRY ADDRESS IF FUNCTION REJECTED
*                     BECAUSE JOB WAS SWAPPED OUT.
*                (B5) = *TAF* STORAGE AREA ADDRESS.
*                (B6) = SFCALL PARAMETER ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 6.
*                B - 2, 3, 4, 5.
*
*         CALLS  COD, QTW, SNM.
*
*         MACROS MESSAGE, SFCALL.
*
*         NOTES  THE SFCALL PARAMETER AREA MUST BE FORMATTED
*                AS FOLLOWS.
*
*                WORD 1 - 6/RC, 12/FP, 18/UCPA, 18/SCPA, 6/FC
*                         WHERE RC = RETURN CODE.
*                               FP = FUNCTION PARAMETER.
*                               UCPA = *UCP* ADDRESS.
*                               SCPA = *SCP* ADDRESS.
*                               FC = FUNCTION CODE.
*                WORD 2 - *UCP* JOB SEQUENCE NUMBER AND *FST* ORDINAL.
*                WORD 3 - 1/U, 1/S, 10/RES, 24/EUCPA, 24/ESCPA
*                         WHERE U = 1, IF EUCPA IS ECS ADDRESS.
*                               S = 1, IF ESCPA IS ECS ADDRESS.
*                               RES = RESERVED.
*                               EUCPA = EXTENDED *UCP* CM OR ECS
*                                       ADDRESS.
*                               ESCPA = EXTENDED *SCP* CM OR ECS
*                                       ADDRESS.
*
*                THE *TAF* STORAGE AREA IS USED AS FOLLOWS.
*
*                WORDS 1-2 - QUEUEING AREA USED BY *QTW*.
*
*                WORD 3 - 24/ , 18/SA, 18/RA
*                         WHERE SA = SFCALL AREA ADDRESS.
*                               RA = RETURN ADDRESS.
 
 
 SFR      SUBR               ENTRY/EXIT
          SX6    B6+         SFCALL PARAMETER ADDRESS
          LX6    18
          BX6    X2+X6       ADD IN RETRY ADDRESS
          SA6    B5+2        SAVE PARAMETERS IN *TAF* STORAGE AREA
 SFR1     SFCALL B6          MAKE SUBSYSTEM FUNCTION REQUEST
          SA2    B6          SFCALL PARAMETERS
          MX0    59          CLEAR COMPLETE BIT
          BX6    X0*X2
          SA6    B6
          MX0    6
          BX5    X0*X6       EXTRACT RETURN CODE
          LX5    6
          MX0    -6
          BX1    -X0*X6      EXTRACT FUNCTION CODE
          MX0    -12
          NZ     X5,SFR3     IF ERROR RETURN CODE
          SX4    X1-/COMSSCP/XRED
          ZR     X4,SFR2     IF EXTENDED READ REQUEST
          SX4    X1-/COMSSCP/XWRT
          NZ     X4,SFRX     IF NOT EXTENDED WRITE
 SFR2     LX2    -42
          BX3    -X0*X2      EXTRACT FP (WORD COUNT) FIELD
          NZ     X3,SFR1     IF MORE TO READ OR WRITE
          EQ     SFRX        EXTENDED READ/WRITE COMPLETE
 
 SFR3     SX4    X5-/COMSSCP/RC44
          SX6    B0+
          SA6    SFRC
          ZR     X4,SFR4     IF USER JOB SWAPPED OUT
          SX4    X5-/COMSSCP/RC43
          ZR     X4,SFRX     IF *UCP* ADDRESS NOT WITHIN *UCP* FL
          RJ     COD         CONVERT FUNCTION TO DISPLAY CODE
          BX1    X4
          SB2    1RX         REPLACEMENT CHARACTER
          SB3    DAYB
          SB5    -SFRA
          RJ     SNM         SET FUNCTION CODE IN ERROR MESSAGE
          BX1    X5
          RJ     COD         CONVERT RETURN CODE
          BX1    X4
          SB2    1RY         REPLACEMENT CHARACTER
          SB5    DAYB
          RJ     SNM         SET RETURN CODE IN ERROR MESSAGE
          SA1    B6+B1
          BX1    X0*X1
          SB2    1RZ         REPLACEMENT CHARACTER
          SB5    DAYB
          RJ     SNM         SET JOB SEQUENCE NUMBER IN ERROR MESSAGE
          MESSAGE  DAYB      ISSUE DAYFILE MESSAGE
          EQ     SFRX        RETURN WITH ERROR INDICATION
 
*         ISSUE REQUEST TO SWAP JOB IN.
 
 SFR4     SX6    /COMSSCP/SWPI  BUILD SFCALL REQUEST
          SA6    B6
          SFCALL B6          REQUEST JOB TO BE SWAPPED IN
 SFR5     SA1    B6          SFCALL PARAMETERS
          MX0    59          CLEAR COMPLETE BIT
          BX6    X0*X1
          SA6    B6
          MX0    6
          BX5    X0*X1       EXTRACT RETURN CODE
          LX5    6
          LX1    59-0        POSITION COMPLETE BIT
          PL     X1,SFR8     IF REQUEST NOT COMPLETE
          NZ     X5,SFR6     IF ERROR RETURN CODE
          SA1    B5+2        SAVED RETRY ADDRESS
          BX6    X6-X6
          SB4    X1
          SA6    SFRC
          JP     B4          EXIT TO RETRY ADDRESS
 
 SFR6     SX4    X5-/COMSSCP/RC44
          NZ     X4,SFR3     IF USER JOB NOT SWAPPED OUT
 
*         WAIT FOR JOB SWAPIN WHEN ERROR WAS RETURNED.
 
          SX1    B6          *BCT* SFCALL AREA ADDRESS
          SX2    59-0        SHIFT COUNT
          BX3    X3-X3       SUBCP NUMBER
          SX4    QTET        TIMED EVENT
          SA5    LTIME       GET REAL TIME
          MX0    -QWTMN      MASK FOR TIME
          BX5    -X0*X5
          SX0    SFCTL       TIMEOUT VALUE IN MILLISECONDS
          IX5    X5+X0       TIME OF EVENT COMPLETE
          SB4    B0          QUEUE AT END OF QUEUE
          SB3    B5          *TAF* STORAGE AREA ADDRESS
          SX6    SFR7        EVENT COMPLETE ADDRESS
          SA6    SFRC        INHIBIT TAF FROM ROLLOUT
          RJ     QTW         QUEUE *TAF* WORK
          EQ     TSSC        EXIT UNTIL EVENT COMPLETE
 
*         TIME FOR JOB SWAPIN EXPIRED.  CHECK JOB STATUS.
 
 SFR7     SB5    B3          RESTORE *TAF* STORAGE AREA ADDRESS
          SA2    B5+2        PARAMETER SAVE AREA
          SB4    X2          RESTORE RETRY ADDRESS
          LX2    -18
          SB6    X2          RESTORE SFCALL AREA ADDRESS
          SX6    /COMSSCP/STAT  BUILD SFCALL STATUS REQUEST
          SA6    B6          STORE IN SFCALL AREA
          SFCALL B6          REQUEST *UCP* STATUS
          EQ     SFR5        CHECK RETURN CODE
 
*         WAIT FOR SWAPIN EVENT.
 
 SFR8     SX1    B6          FWA OF SWAPIN REQUEST
          SX2    59-0        SHIFT COUNT FOR COMPLETE BIT
          BX3    X3-X3       SUBCONTROL POINT NUMBER
          SX4    QTEV        EVENT TYPE
          BX5    X5-X5       NOT A TIMED EVENT
          SB4    B0          QUEUE AT END OF QUEUE
          SB3    B5          *TAF* STORAGE AREA ADDRESS
          SX6    SFR9        EVENT COMPLETE ADDRESS
          SA6    SFRC        INHIBIT TAF FROM ROLLOUT
          RJ     QTW         QUEUE *TAF* WORK
          EQ     TSSC        EXIT UNTIL EVENT COMPLETE
 
*         SWAPIN COMPLETE.
 
 SFR9     SB5    B3          RESTORE *TAF* STORAGE AREA ADDRESS
          SA2    B5+2        PARAMETER SAVE AREA
          SB4    X2          RESTORE RETRY ADDRESS
          LX2    -18
          SB6    X2          RESTORE SFCALL AREA ADDRESS
          EQ     SFR5        CHECK RETURN CODE OF SWAPIN REQUEST
 
 SFRA     DATA   C* SSF FUNCTION XX RECEIVED ERROR YY FOR ZZZZ.*
 SFRC     BSSZ   1           NON-ZERO IF *SFCALL* REQUEST OUTSTANDING
VBA       SPACE  4,40
**        VBA - VALIDATE BATCH ACCESS.
*
*         ENTRY  (IDLA) = 0, IF *TAF* NOT TO BE IDLED.
*                (X1) = TYBT, IF BTRAN USER.
*                       TYRM, IF BATCH/CRM USER.
*                (X4) = BATCH USER NAME.
*                (X5) = RETURN ADDRESS.
*                (B5) = *TAF* STORAGE AREA ADDRESS.
*                (B6) = ADDRESS OF RECOVERY REQUEST AREA.
*
*         EXIT   (X3) = VALIDATION STATUS.
*                (B5) = *TAF* STORAGE AREA ADDRESS.
*                (B6) = RECOVERY REQUEST AREA ADDRESS FORMATTED
*                       AS FOLLOWS.
*
*                       WORDS 1-2 - QUEUEING AREA FOR *CTI* RECOVERY
*                                   ROUTINE.
*
*                       WORD 3 - 24/ , 18/*TST* ORDINAL,
*                                18/*TST* ADDRESS
*
*                       WORD 4 - 18/ , 6/BI, 18/TS, 18/RA
*                                WHERE BI = TYPE OF BATCH ACCESS.
*                                      TS = *TAF* STORAGE AREA ADDRESS.
*                                      RA = RETURN ADDRESS.
*
*                       WORD 5 - RECOVERY REQUEST STATUS.
*
*                       WORD 7 - OLDID.
*
*                       WORD 9 - NEWID.
*
*                       WORD 11 - TRANSACTION TYPE.
*
*                       WORD 13 - STEP.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4.
*
*         CALLS  COD, QTW, RFB, SNM, STST.
*
*         MACROS MESSAGE.
 
*         IF *TAF* HAS BEEN IDLED DO NOT ALLOW ACCESS
*         AND RETURN IDLE STATUS.
 
 
 VBA      SA3    IDLA
          ZR     X3,VBA1     IF *TAF* IS NOT TO BE IDLED
          SX3    JSTI
          SB3    X5          RETURN ADDRESS
          JP     B3          RETURN WITH *TAF* IDLE STATUS
 
*         FIND USER IN TERMINAL STATUS TABLE.
 
 VBA1     SX6    B6          SAVE RECOVERY REQUEST AREA ADDRESS
          RJ     STST        SEARCH *TST* FOR TERMINAL/USER NAME
 VBA2     SB3    X5          RETURN ADDRESS
          SB6    X6          RESTORE RECOVERY REQUEST AREA ADDRESS
          NZ     X3,VBA3     IF USER NAME IN *TST*
          SX3    JSNV
          JP     B3          RETURN WITH USER NOT VALID STATUS
 
*         IF ANOTHER USER ACTIVE, RETURN USER ACTIVE STATUS.
 
 VBA3     BX6    X3          *TST* ORDINAL
          SX2    A3-TSTNW    *TST* ENTRY ADDRESS
          LX6    BRTOS-17
          BX6    X6+X2
          SA6    B6+BRTOW    SAVE *TST* ORDINAL AND ADDRESS
          SA3    X2          *TST* ENTRY
          ERRNZ  TSAUW       IF USER ACTIVE FLAG NOT IN WORD ZERO
          LX3    59-TSAUS
          PL     X3,VBA4     IF USER NOT ACTIVE
          SX3    JSUA
          JP     B3          RETURN WITH USER ACTIVE STATUS
 
 VBA4     LX3    59-TSARS-59+TSAUS
          PL     X3,VBA8     IF RECOVERY NOT REQUIRED
 
*         BUILD RECOVERY REQUEST.
 
          LX1    BRBIS-5     BATCH-CRM/BTRAN INDICATOR
          SX2    B5
          LX2    BRTSS-17
          BX1    X1+X2       ADD *TAF* STORAGE AREA ADDRESS
          SX2    B3
          BX6    X1+X2       ADD RETURN ADDRESS
          SA6    B6+BRBIW    SAVE INPUT PARAMETERS
          ERRNZ  BRBIW-BRTSW FIELDS NOT IN SAME WORD
          ERRNZ  BRTSW-BRRAW FIELDS NOT IN SAME WORD
          SX6    VBAA        FWA OF *TSTAT* KEYWORDS
          SX7    B6+BRRSW    VALUE RETURN LOCATION
 VBA5     SA7    X7          RETURN VALUE IN ARGUMENT ARRAY
          SA6    A7+B1       ADDRESS OF KEYWORD
          SX6    X6+B1       INCREMENT KEYWORD LOCATION
          SX7    A6+B1       INCREMENT VALUE LOCATION
          SX2    X6-VBAB
          NZ     X2,VBA5     IF NOT END OF ARGUMENT ARRAY
          SX6    B0
          SA6    A6          STORE END OF ARRAY
 
*         QUEUE RECOVERY REQUEST.
 
          SX6    B0
          SA6    B5+QRTCW    CLEAR COMPLETE BIT
          SX1    A6          EVENT ADDRESS
          SB3    B6          QUEUEING AREA ADDRESS
          SX2    B0          SHIFT COUNT FOR COMPLETE BIT
          BX3    X3-X3       SUBCONTROL POINT NUMBER
          SX4    QTEV        EVENT TYPE
          BX5    X5-X5       NOT A TIMED EVENT
          SB4    B0          QUEUE AT END OF QUEUE
          SX6    VBA6        EVENT COMPLETE ADDRESS
          RJ     QTW         QUEUE *TAF* WORK
 
*         REQUEST RECOVERY INFORMATION.
 
          SA1    B6+BRTSW    *TAF* STORAGE AREA ADDRESS
          LX1    BRTSN-1-BRTSS
          SB3    X1
          SA5    VBAC        *REC* SYSTEM REQUEST
          SX1    B6+BRRSW
          BX5    X5+X1       ADD ARGUMENT ARRAY ADDRESS
          SX6    B0          SUBCONTROL POINT NUMBER
          SA1    B6+BRTOW
          LX5    -18         POSITION REQUEST FOR CALL TO *TFP*
          LX1    BRTON-1-BRTOS
          SX7    X1          *TST* ORDINAL
          ERRNZ  BRTON-18    *TST* ORDINAL NOT 18 BITS
          SB5    B0          SUBCONTROL POINT RA
          EQ     TFP         *TSTATUS* RECOVERY REQUEST
 
*         RECOVERY REQUEST COMPLETE.
 
 VBA6     SB6    B3
          SA1    B6+BRRAW
          ERRNZ  BRRAS-17    RETURN ADDRESS DOES NOT START IN BIT 17
          SB3    X1          RESTORE RETURN ADDRESS
          LX1    BRTSN-1-BRTSS
          SB5    X1          RESTORE *TAF* STORAGE AREA ADDRESS
          ERRNZ  BRTSN-18    *TAF* STORAGE ADDRESS NOT 18 BITS
          ERRNZ  BRTSW-BRRAW FIELDS NOT IN SAME WORD
          LX1    BRBIN-1-BRBIS-BRTSN+1+BRTSS  RESTORE ACCESS TYPE
          SA2    A1+B1       RECOVERY REQUEST STATUS
          ERRNZ  BRRAW-BRRSW+1  FIELDS NOT ADJACENT
          ERRNZ  BRRAW-BRRSW+1  IF STATUS NOT IN NEXT WORD
          SX2    X2-TSNE
          ZR     X2,VBA7     IF COMPLETE WITH NO ERROR
          SX1    X2
          RJ     COD         CONVERT ERROR TO DISPLAY CODE
          BX1    X4
          SB2    1RX         REPLACEMENT CHARACTER
          SB3    DAYB
          SB5    -VBAD
          RJ     SNM         MOVE ERROR CODE TO MESSAGE
          SA1    B6+BRTAW
          SA1    X1+TSTNW    TERMINAL/USER NAME
          MX0    TSTNN
          BX1    X0*X1
          SB2    1RY         REPLACEMENT CHARACTER
          SB5    DAYB
          RJ     SNM         MOVE USER NAME TO MESSAGE
          MESSAGE  DAYB      ISSUE DAYFILE MESSAGE
          SA1    B6+BRRAW
          ERRNZ  BRRAS-17    RETURN ADDRESS DOES NOT START IN BIT 17
          SB3    X1          RESTORE RETURN ADDRESS
          LX1    BRTSN-1-BRTSS
          SB5    X1          RESTORE *TAF* STORAGE AREA ADDRESS
          ERRNZ  BRTSN-18    *TAF* STORAGE ADDRESS NOT 18 BITS
          SX3    JSRE
          JP     B3          RETURN WITH REQUEST ERROR STATUS
 
*         IF A BATCH *CRM* USER IS NOT CURRENTLY
*         ACCESSING USERNAME, RETURN ACCESS ERROR.
 
 VBA7     MX3    -BRBIN
          SA2    B6+BRTRW    TRANSACTION TYPE
          BX1    -X3*X1
          BX2    X2-X1
          ZR     X2,VBA8     IF SAME TYPE OF ACCESS
          SX3    JSAT
          JP     B3          RETURN WITH DIFFERENT ACCESS ERROR
 
*         SET USER ACTIVE IN *TST*.
 
 VBA8     SA2    B6+BRTAW    SAVED *TST* INFORMATION
          SB2    X2          *TST* ADDRESS
          ERRNZ  BRTAS-17    *TST* ADDRESS DOES NOT START IN BIT 17
          MX1    TSAUN
          LX1    TSAUS-59
          SA2    B2          *TST* ENTRY
          ERRNZ  TSAUW       USER ACTIVE NOT IN WORD ZERO OF *TST*
          ERRNZ  TSAUW       IF USER ACTIVE NOT IN WORD ZERO
          BX6    X1+X2       SET USER ACTIVE IN *TST*
          SA6    A2
          SX3    JSRC        USER VALID STATUS
          JP     B3          RETURN
 
 VBAA     DATA   10HOLDID      *TSTAT* KEYWORDS
          DATA   10HNEWID
          DATA   10HTRAN
          DATA   10HSTEP
          BSSZ   1
 VBAB     EQU    *
 VBAC     VFD    24/3LCTI,18/RFTS,18/0  *REC* SYSTEM REQUEST
 VBAD     DATA   C* TSTAT REQUEST RECEIVED ERROR XXX FOR YYYYYYY.*
          TITLE  MISCELLANEOUS ROUTINES.
 AIQ      SPACE  4,10
**        AIQ - AGE INPUT QUEUE PRIORITIES.
 
 
 AIQ      SUBR               ENTRY/EXIT
          SA1    RTLW        SEARCH REQUESTED TASK LIST (INPUT QUEUE)
          MX4    1
          SB5    B0
          IX1    X1+X4       LOOKING FOR ZERO BITS
          LX4    -12
 
 AIQ1     NX1    B4,X1       FIND A RESERVED RTL ENTRY
          SB4    B4+B4       TWO WORDS PER ENTRY
          IX1    X4+X1
          SB5    B5+B4
          SB3    B5-RTLL
          PL     B3,AIQX     IF END OF QUEUE
 
*         INCREMENT INPUT QUEUE PRIORITY BY ONE.
 
          SA2    B5+RTL
          MX6    -6
          LX2    -18
          BX3    -X6*X2      MAXIMUM PRIORITY
          LX2    -6
          BX5    -X6*X2      CURRENT PRIORITY
          BX7    X5-X3
          ZR     X7,AIQ1     IF MAXIMUM = CURRENT PRIORITY
          BX2    X6*X2       CLEAR OLD CURRENT PRIORITY
          SX7    X5+B1       INCREMENT OLD PRIORITY BY ONE
          BX7    -X6*X7
          BX6    X2+X7       NEW CURRENT PRIORITY
          LX6    24
          SA6    A2
          JP     AIQ1        LOOP
 ASN      SPACE  4,10
**        ASN - ASSIGN SEQUENCE NUMBER.
*
*         ENTRY  (X1) = *TST* TERMINAL ORDINAL.
*
*         EXIT   (X6) = ASSIGNED SEQUENCE NUMBER.
*
*         USES   X - 2, 3, 6, 7.
*                A - 2, 6.
*
*         CALLS  EXIT, STF.
 
 
 ASN2     MX7    -TFIDN-TFTSN  USER SEQUENCE NUMBER MASK
          BX6    -X7*X6
 
 ASN      SUBR               ENTRY/EXIT
          SA2    TSEQ        UPDATE NUMBER OF TRANSACTIONS
          SX7    B1
          IX6    X2+X7
          SA6    TSEQ
 
*         IF RECOVERY IS NOT INSTALLED, THE NUMBER OF TRANSACTIONS
*         EQUALS THE TRANSACTION SEQUENCE NUMBER.  IF RECOVERY IS
*         INSTALLED OBTAIN THE SEQUENCE NUMBER FROM THE TERMINAL
*         NETWORK FILE.
 
.A        IFGE   IPTAR,1     IF RECOVERY INSTALLED
          RJ     STF         SEARCH TERMINAL FILE FOR TERMINAL ORDINAL
          ZR     B4,ASN1     IF TERMINAL NOT FOUND
          SA2    A2+TFTSW    SEQUENCE NUMBER
          SX7    B1          UPDATE SEQUENCE NUMBER
          IX6    X2+X7
          BX3    X6
          LX3    59-TFTSS    LEFT JUSTIFY SEQUENCE NUMBER
          SA6    A2+
          PL     X3,ASN2     IF NO OVERFLOW, RETURN SEQUENCE NUMBER
 
*         ON SEQUENCE NUMBER OVERFLOW, SET SEQUENCE NUMBER TO ONE.
 
          MX7    59-TFTSS
          ERRNZ  TFTSN-1-TFTSS  IF NUMBER NOT LEFT JUSTIFIED
          BX6    X7*X2       CLEAR OLD SEQUENCE NUMBER
          SX1    B1
          IX6    X6+X1
          SA6    A2+
          EQ     ASN2        RETURN SEQUENCE NUMBER
 
 ASN1     RJ     EXIT        *TAF* INTERNAL ERROR
 .A       ELSE
          EQ     ASN2        RETURN SEQUENCE NUMBER
 .A       ENDIF
 CIC      SPACE  4,10
**        CIC    EXTRACT WORD(S) FROM NON MASS STORAGE ASSOCIATED
*                CIRCULAR BUFFER, AND PLACE INTO A WORKING BUFFER.
*
*         ENTRY  B5 = FET FOR BUFFER
*                B6 = ADDRESS OF WORKING BUFFER
*                B4 = WORDS / ENTRY
*
*         EXIT   (X1) = LAST WORD TRANSFERED
*
*         USES   X - 1, 2, 3, 6, 7
*                A - 1, 2, 3, 6
*                B - 3, 4, 5, 6
 
 
 CIC      PS                 ENTRY/EXIT
          SX7    -B4         COMPLEMENT OF WORDS TO PICK UP
          SA3    B5+B1       FIRST
          SA1    A3+B1       IN
          SA2    A1+B1       OUT
          SB3    X1
          SA1    A2+B1       LIMIT
          SB4    X2
          SB5    X1
 CIC1     EQ     B4,B3,CIC3  OUT = IN, END OF BUFFER INFO
          SA1    B4          READ FIRST WORD
          BX6    X1
          SB4    B4+B1       (OUT + 1)
          NE     B4,B5,CIC2  IF (OUT + 1) .NE. LIMIT
          SB4    X3          (OUT + 1) = FIRST
 CIC2     SA6    B6          STORE WORD
          SX7    X7+1
          SB6    B6+B1       ADVANCE WORKING BUFFER
          NZ     X7,CIC1     LOOP TO FILL WORKING BUFFER
          SX6    B4
          SA6    A2          STORE OUT
          EQ     CIC         *RETURN
 CIC3     SX6    B4
          SA6    A2          SET OUT
          EQ     CIC         *RETURN
 CLJF     SPACE  4
**        CLJF   CHECK FOR COMPLETION OF ANY NON BUFFERED JOURNAL FILE
*                WRITES.
*
*         USES   X - 1, 2, 3, 4, 6, 7
*                A - 1, 2, 3, 6, 7
*                B - 6
 
 
 CLJF     PS
 CLJF1    SA1    JRNLB       WORD CONTAINING JOURNAL FILE LOCKS
          ZR     X1,CLJF     *RETURN - NO LOCKS OUTSTANDING
          MX3    -18
          SB6    X1
          ZR     B6,CLJF2    IF NO ONE USING JOURNAL FILE
          SA2    B6
          LX2    -1
          PL     X2,CLJF2    IF FILE STILL BUSY
          BX6    X3*X1
          SA6    A1          CLEAR LOCK ON FILE
          EQ     CLJF5       CLEAR LOCK OUT ON STORAGE MOVE
 
 CLJF2    LX1    -18
          SB6    X1
          ZR     B6,CLJF3    IF NO ONE USING JOURNAL FILE
          SA2    B6
          LX2    -1
          NG     X2,CLJF4    IF FILE NOT BUSY - CLEAR LOCK OUT
 CLJF3    LX1    -18
          SB6    X1
          ZR     B6,CLJF     *RETURN
          SA2    B6
          LX2    -1
          PL     X2,CLJF     *RETURN - FILE STILL BUSY
          BX6    X3*X1       CLEAR LOCK OUT ON JOURNAL FILE
          LX6    18+18
          SA6    A1+
          EQ     CLJF5       CLEAR LOCK OUT ON STORAGE MOVE
 
 CLJF4    BX6    X3*X1       CLEAR LOCK OUT ON JOURNAL FILE
          LX6    18
          SA6    A1+
 
*         CLEAR LOCK OUT ON STORAGE MOVE FOR SUB CONTROL POINT
 
 CLJF5    SA2    B6+5
          SX7    B1
          MX1    1
          SB6    X2          SUP CP USING FILE
          BX6    X3*X2
          SA3    B6          CONTROL WORD 1 OF SUB CP
          BX7    X6+X7
          SX4    X3-NUAPL    START OF TASK CONTROL AREA
          SA7    A2          CLEAR SUB CP ADDRESS
          BX6    -X1*X3
          SA1    X4+JTSC     RESTORE WORDS DESTROYED BY HEADER
          SA6    B6          CLEAR STORAGE MOVE LOCK OUT
          IX2    X1+X4
          SA1    A1+B1       WORD FROM FWA-1 OF JOURNAL DATA
          SA3    A1+B1
          BX6    X1
          LX7    X3
          SA6    X2-1        RESTORE 1ST WORD
          SA1    A3+B1
          SA7    A6-B1
          BX6    X1
          SA6    A7-B1       RESTORE 3RD WORD
          SB3    CLJF6
          SX3    B5
          JP     RCPU        REQUEST CPU FOR SUB CONTROL POINT
 
 CLJF6    SB5    X3          RESTORE (B5)
          JP     CLJF1       CHECK FURTHER JOURNAL FILES FOR COMPLETION
 CML      SPACE  4,10
**        CML - COMPUTE MESSAGE LENGTH.
*
*         ENTRY  (X3) = NUMBER OF MESSAGE UNITS.
*                (X4) = MESSAGE UNIT.
*
*         EXIT   (X1) = MESSAGE LENGTH IN WORDS.
*                (X6) = REMAINDER IN BITS OF MESSAGE OVER LAST WORD.
*
*         USES   X - 0, 1, 2, 6.
*                B - 6.
 
 
CML       SUBR               ENTRY/EXIT
          MX0    -6
          SX6    X4-2        MESSAGE UNITS 0 AND 1 ARE NOT USED
          SX2    6
          IX6    X2*X6       COMPUTE SHIFT COUNT FOR BITS PER UNIT
          SB6    X6
 
*         (X2) CONTAINS THE BITS PER MESSAGE UNIT FOR EACH TYPE OF
*         MESSAGE UNIT.  MESSAGE UNIT 4 HAS 6 BITS PER UNIT.
*         MESSAGE UNIT 3 HAS 12 BITS PER UNIT.  MESSAGE UNIT 2
*         HAS 8 BITS PER UNIT.
 
          SX2    61410B
          AX2    B6
          BX0    -X0*X2      BITS PER MESSAGE UNIT
          SX6    60          60 BITS PER WORD
          IX2    X0*X3       MESSAGE LENGTH IN BITS
          PX6    X6
          SX0    X2
          PX0    X0
          NX6    X6
          FX6    X0/X6       MESSAGE LENGTH IN WORDS
          UX6,B6 X6
          LX1    B6,X6
          PX0    X1          COMPUTE REMAINDER
          SX6    60
          PX6    X6
          DX0    X6*X0
          UX6    X0
          IX6    X2-X6       REMAINDER
          ZR     X6,CMLX     IF REMAINDER .EQ. ZERO, RETURN
          SX1    X1+1
          EQ     CMLX        RETURN
 CORU     SPACE  4
*         CORU - IF THERE IS MORE THAN *FCMFL* FIELD LENGTH NOT IN USE
*         CORU WILL RELEASE UP TO *REDFL* FROM THE LAST SUB CONTROL
*         POINT. CORU ALSO WILL RELEASE THE REUSEABLE TASK WITH THE
*         HIGHEST RA EVERY *RRTTL* MILLESECONDS.
 
 
 CORU     PS
          SA1    AVAILCM     CURRENT FREE CORE
          SX7    X1-FCMFL
          TB6    0,VCPA      FIRST SUB CONTROL POINT
          NG     X7,CORU3    IF NOT ABOVE THRESHOLD
 
*         FIND THE LAST SUB CONTROL POINT AND RELEASE SOME FIELD LENGTH.
 
 CORU1    SA2    B6+2        SUB CP STATUS WORD 3
          SB6    X2+         NEXT SUB CP
          NZ     B6,CORU1    LOOP TILL END OF CHAIN REACHED
          SA1    A2-2        SUB CP STATUS WORD 1
          LX1    -36
          SX2    X1          FREE CORE COUNT
          SX4    REDFL       AMOUNT OF MEMORY TO RELEASE
          IX3    X2-X4
          PL     X3,CORU2    IF AT LEAST *REDFL* AVAILABLE AT LAST SUB
          SX4    X2          RELEASE ALL FREE CORE AFTER SUB CP
 CORU2    ZR     X4,CORU3    NO FREE CORE TO DROP
          SB6    A1+         SUB CP STATUS WORD 1
          SA1    CURFL
          IX7    X1-X4       DECREMENT TRANEX FIELD LENGTH STATUS WORD
          MEMORY CM,MRSW,R,X7  REDUCE TAF FL
          SA1    AVAILCM     AVAILABLE CM
          SA2    MRSW        GET STATUS WORD
          MX3    30
          BX6    X3*X2       NEW FL
          SA4    CURFL       COMPUTE INCREMENT OF FL
          LX6    30
          IX4    X6-X4
          IX7    X1+X4       NEW AVAILABLE CM
          SA6    A4          SAVE *CURFL*
          SA7    A1+         UPDATED AVAILABLE CM
          SA1    B6          SUB CP STATUS WORD 1
          LX1    SCFCN-1-SCFCS
          IX7    X1+X4
          LX7    59-59-SCFCN+1+SCFCS
          SA7    A1+         DECREMENT FREE COUNT
          SA1    MTIME       TIME OF LAST FIELD LENGTH REDUCTION
          SA2    ITIME
          NZ     X1,CORU3    IF NO FL INCREASE SINCE LAST DECREASE
          BX6    X2
          SA6    A1
 
*         CHECK IF TIME TO ARBITRARILY GET RID OF A REUSABLE TASK
 
 CORU3    SX7    RRTTL       TIME INTERVAL TO EVICT A RELEASEABLE TASK
          SA1    ITIME       CURRENT TIME
          SA2    ETIME       LAST TIME A TASK WAS ARBITRARILY RELEASED
          MX3    -36
          IX2    X1-X2
          BX2    -X3*X2      MILLESECONDS SINCE LAST TASK RELEASE
          IX3    X7-X2
          TB5    0,VCPA      FIRST SUB CONTROL POINT
          SB4    B1
          BX5    X5-X5       SUB CONTROL POINT ACTIVE FLAG
          PL     X3,CORU4    IF NOT TIME TO CHECK REUSEABLE TASKS
          BX7    X1
          SB4    B0
          SA7    A2
          SB6    B0
 
*         EVICT RELEASEABLE TASK WITH THE LARGEST RA.
 
 CORU4    SA1    B5
          SA2    B5+B1
          LX1    59-58
          SA3    A2+B1       LINK WORDS TO NEXT SUB CONTROL POINT
          LX2    -36
          PL     X1,CORU5    IF NOT A RELEASEABLE TASK
          SB6    B5
 CORU5    SX2    X2
          ZR     X2,CORU6    IF SUB CONTROL POINT NOT ACTIVE
          SX5    B1
 CORU6    SB5    X3+         NEXT SUB CONTROL POINT
          NZ     B5,CORU4    IF NOT AT END OF SUB CONTROL POINTS
          EQ     B4,B1,CORU7 IF NOT TIME TO RELEASE TASK
          ZR     B6,CORU7    IF NO RELEASEABLE SUB CONTROL POINTS
          SB3    CORU        RETURN ADDRESS
          JP     ESCP1       RELEASE TASK
 
*         CHECK IF TRANEX IDLE AND TIME TO ROLLOUT.
 
 CORU7    NZ     X5,CORU     IF SUB CONTROL POINT(S) ACTIVE
          SA1    TROF
          NZ     X1,CORU     IF ROLLOUT IS PROHIBITED
          SA2    PBCA
          NZ     X2,CORU     IF BATCH CONCURRENCY JOB ACTIVE
          SA1    SFRC
          NZ     X1,CORU     IF *SFCALL* REQUEST OUTSTANDING
          SA2    TAFQ
          SX2    X2+
          NZ     X2,CORU     IF JOBS TO PROCESS IN *TAFQ*
          SA3    RDCBD       LAST INPUT TIME
          SA4    ITIME       CURRENT TIME
          SA5    ITRTL
          MX2    -36
          IX1    X4-X3
          BX6    -X2*X1      TIME SINCE LAST INPUT
          IX3    X5-X6
          PL     X3,CORU     NOT TIME TO ROLLOUT
          SA1    RTLW        RTL RESERVATION WORD
          MX2    12
          BX1    -X2*X1      GET RESERVATION BITS
          CX1    X1
          SX1    X1-NRTL
          NZ     X1,CORU     DONT ROLLOUT - TASK(S) SCHEDULED
          SA1    IDLA
          ZR     X1,TRO      IF NOT TO IDLE DOWN
          SB5    B0+
          RJ     SRO         SEARCH ROLLOUT TABLE
          NZ     B5,TRO      IF ROLLOUT TABLE RESERVED
          TX5    0,VNCMB     NUMBER OF COMMUNICATION BLOCKS
          MX7    12
          TA2    0,VCBRT     C.B. BIT MAP
          BX7    -X7*X2
          CX3    X7
          IX4    X3-X5
          NZ     X4,TRO      IF COMMUNICATION BLOCK RESERVED
 CORU8    SX2    CORU8       RETRY ADDRESS
          SB6    CORUA       FWA OF PARAMETER
          SB5    B6+2        FWA OF TAF STORAGE
          RJ     SFR         ISSUE *SFCALL* REQUEST
          RJ     NOF         ISSUE *NETOFF* REQUEST
 
*         IDLE DOWN TAF.
 
          SA1    CURFL       SET RFL TO CURRENT FL
          SETRFL X1
          ENDRUN
 
*         *SFCALL* *SF.EXIT* PARAMETERS.
 
 CORUA    VFD    6/0,12/0,18/0,18/0,6//COMSSCP/EXIT
          BSSZ   4           *SFCALL* PARAMETERS
 CSM      SPACE  4,10
**        CSM - PROCESS COMMAND/STATUS MESSAGES.
*
*         *CSM* PROCESSES COMMAND/STATUS MESSAGES RECEIVED FROM
*         *LIBTASK* AND *DMREC*.
*
*         ENTRY  (X4) = FIRST WORD OF STATUS MESSAGE.
*                (A4) = FWA OF STATUS MESSAGE.
*
*         EXIT   TO *TSSC* IF PROCESSING COMPLETE.
*
*         USES   A - 1, 2, 4, 7.
*                B - 3, 4, 5.
*                X - 0, 1, 2, 3, 4, 5, 7.
*
*         CALLS  JRNL, LOVL.
*
*         MACROS MESSAGE.
 
 
 CSM      UX2,B3 X4          GET FUNCTION CODE
          SX3    B3
          LX3    -1
          LX4    17-35
          SB4    X3-CSMJTL
          PL     B4,CSM1     IF INCORRECT FUNCTION
          SB3    X3          JUMP TABLE INDEX
          BX7    X7-X7
          JP     B3+CSMJT    JUMP THRU TABLE TO FUNCTION PROCESSOR
 
*         CSM JUMP TABLE.
 
 CSMJT    PL     X3,CSM3     IF TRANSACTION SUBSYSTEM PRESENT
          EQ     CSM1        INCORRECT FUNCTION
          PL     X3,CSM4     IF LIBTASK(TT) DIRECTORY UPDATE REQUEST
          EQ     CSM1        INCORRECT FUNCTION
          PL     X3,CSM1     IF INCORRECT FUNCTION
          EQ     CSM5        COMMUNICATION SUBSYSTEM INITIALIZATION
          PL     X3,CSM1     IF INCORRECT FUNCTION
          EQ     CSM6        IF *CRM* BATCH RECOVERY RESPONSE
 CSMJTL   EQU    *-CSMJT     LENGTH OF TABLE
 
*         PROCESS INCORRECT *SIC* REQUEST.
 
 CSM1     LX4    18
          SB3    CSM2        RETURN ADDRESS
          SX3    X4          LENGTH OF MESSAGE
          SB4    7           INDICATES POSSIBLE MALICIOUS USER
          SB5    PJRNL
          SX5    A4          FWA OF MESSAGE
          LX3    35-17
          SX7    A4+         SAVE BUFFER ADDRESS
          BX0    X0-X0       NO COMMUNICATION BLOCK
          BX5    X5+X3       SET BUFFER ADDRESS AND LENGTH
          SA7    CSMB
          EQ     JRNL        PROCESS JOURNAL ENTRY
 
 CSM2     MESSAGE  CSMA      NOTE THAT A BAD COMMAND WAS RECEIVED
          SA2    CSMB        RESTORE BUFFER ADDRESS
          BX7    X7-X7       CLEAR INTER-CONTROL POINT BUFFER
          SA7    X2
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 
*         PROCESS CHECK ON STATUS OF TRANSACTION EXECUTIVE.
 
 CSM3     SA7    A4          CLEAR INTER-CONTROL POINT BUFFER
          EQ     TSSC        TIME SLICE TASKS
 
*         PROCESS REQUEST FOR TASK DIRECTORY UPDATE.
 
 CSM4     SA1    LOVF        OVERLAY ENTRY POINT NAME
          RJ     LOVL        LOAD/EXECUTE OVERLAY
 
*         A COMMUNICATION SUBSYSTEM INITIALIZATION HAS TAKEN PLACE.
 
 CSM5     SA7    A4+         CLEAR INTER-CONTROL POINT BUFFER
          SA1    LOVG
          RJ     LOVL        LOAD/EXECUTE OVERLAY
          EQ     TSSC
 
*         PROCESS RESPONSE FROM *CRM* BATCH RECOVERY PROGRAM.
 
 CSM6     SX7    A4          SAVE INPUT BUFFER ADDRESS
          SA7    CSMB
          MX0    -18
          SA1    A4+
          BX1    -X0*X1
          SB3    X1          MESSAGE LENGTH
          SB4    B3-CSMDL
          SB5    B3-B1
          SX5    B0          FUNCTION CODE
          NG     B5,CSM2     IF MESSAGE TOO LONG
 CSM7     SA1    A4+B5
          BX7    X1
          SA7    CSMD+B5     MOVE MESSAGE TO TEMPORARY BUFFER
          SB5    B5-B1
          PL     B5,CSM7     IF NOT ENTIRE MESSAGE MOVED
          SX2    B3
          SA1    CSME        PROTOTYPE HEADER
          BX7    X1+X2
          SA7    A7
          SB3    A7+
          SA4    CSMC        TASK NAME
          RJ     TRN         SCHEDULE TASK
          SA1    CSMB
          ZR     X0,TSSC     IF TASK NOT SCHEDULED
          SX7    B0
          SA7    X1          CLEAR THE ORIGINAL INPUT BUFFER
          EQ     TSSC        EXIT
 
 CSMA     DATA   C* CSM - INCORRECT COMMUNICATION FUNCTION.*
 CSMB     CON    0           STORAGE FOR BUFFER ADDRESS
 CSMC     DATA   7LCRMTASK
 CSMD     BSS    4           TEMPORARY BUFFER FOR *SIC* MESSAGE
 CSMDL    EQU    *-CSMD
 CSME     VFD    1/1,2/0,1/1,7/0,1/1,12/0,18/0,18/0
 
 DCPT     SPACE  4,10
**        DCPT - DROP CPU FOR TASK.
*
*         ENTRY  (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   (B2) = FWA OF TASK SYSTEM AREA.
*                (B7) = FWA OF TASK SUBCP TABLE.
*                (SREG) = 24/0,18/(B2)/18/(B7).
*
*         USES   A - 1, 2, 6, 7.
*                B - 2, 3, 4, 6, 7.
*                X - ALL.
*
*         CALLS  EXIT.
 
 
 DCPT     SUBR               ENTRY/EXIT
          MX0    1
          TX2    B7+CPAL,-VCPA  CONTROL POINT ADDRESS
          LX0    -12
          SA1    CR          CPU SWITCHING WORD
          AX2    SCPAL
          SB4    X2          CONTROL POINT NUMBER
          AX3    X0,B4
          BX7    -X3*X1      MASK OFF REQUEST CPU STATUS
          SA7    A1
          BX2    X3*X1
          NZ     X2,DCPT1    IF CPU SELECTED FOR THIS SUBCP
          RJ     EXIT
 DCPT1    ZR     X7,DCPT4    IF IDLE
 
*         SEARCH CPU REQUEST WORD FOR NEXT SUBCP.
 
          SA2    A1+B1       SWITCH MASK
          BX3    X3-X3
          SB3    B0
          BX6    -X2*X7      SET LOWER CONTROL POINTS
          SB7    SCPAL
          PX4    X6
          BX5    X5-X5
          EQ     DCPT3       ENTER LOOP
 
 DCPT2    SX3    X3+B6       SET CP ADDRESS
          LX6    X3,B7
          TA1    X6-CPAL,VCPA
          NO
          SA1    X1-NUAPL+CB1C      C.B. HEADER WORD 1
          UX1,B4 X1          CHECK PRIORITY
          LE     B4,B3,DCPT3 IF PREVIOUS JOB NOT HIGHER
          BX5    X6          SET NEW JOB
          SB3    B4
 DCPT3    BX1    -X0*X4      REMOVE JOB FROM STACK
          NX4,B6 X1          SET NEXT JOB
          NZ     X4,DCPT2    IF MORE JOBS IN STACK
          SX3    B0          SET UPPER CONTROL BITS
          BX1    X2*X7
          PX4    X1
          SX2    B0
          NZ     X1,DCPT3    IF MORE JOBS REMAIN TO BE EXAMINED
 
*         BEGIN A NEW SUBCP.
 
          TA2    X5-CPAL,VCPA
          SB7    A2
          SX7    A2
          SB2    X2-NUAPL    SUB CP RA
          SX2    B2+
          LX2    18
          BX7    X2+X7
          SA7    SREG
          NZ     B3,DCPTX    IF TASK FOUND, RETURN
 
*         IDLE CPU.
 
 DCPT4    BX6    X6-X6       CLEAR TASK POINTERS
          SB2    B0
          SA6    SREG
          SB7    B0
          EQ     DCPTX       RETURN
 ECET     SPACE  4,10
**        ECR - PROCESS EXTENDED MEMORY ERROR WHILE LOADING TASK.
*
*         ENTRY - SEE OVERLAY ROUTINE *ECE*.
 
 
 ECR      SA1    LOVD        OVERLAY ENTRY POINT
          SA7    ECRA        PARAMETERS FOR ECS ERROR OVERLAY
          RJ     LOVL        LOAD/EXECUTE ECS TASK READ ERROR OVERLAY
 
*         RE-ENTRY POINT IF ATTACH ERROR ON TASK LIBRARY.
 
 ECR1     SX7    ECR2        RETURN ADDRESS
          SX6    25          DELAY COUNT
          LX6    18
          BX7    X6+X7
          EQ     TRCL2       RECALL TASK FOR DELAY COUNT
 
 ECR2     LX1    -18
          SX6    X1-1
          MX7    -18
          ZR     X6,ECR3     IF DELAY COUNT EXPIRED
          BX7    X7*X1       CLEAR OLD COUNT VALUE
          BX7    X7+X6
          LX7    18
          EQ     TRCL2       DELAY
 
 ECR3     SA1    LOVD        ENTRY POINT NAME
          SX2    B1          NO EXECUTE FLAG
          BX1    X1+X2
          RJ     LOVL        LOAD ECS TASK READ ERROR OVERLAY
          EQ     ECE9        PROCESS ECS READ ERROR
 
 ECRA     BSS    1           6/ ,18/EDT,18/FL,18/SCP
 ESCP     SPACE  4,10
**        ESCP - END SUBCONTROL POINT PROGRAM.
*                REMOVE SUB CP FROM ACTIVE CHAIN AND PLACE INTO FREE
*                SUBCP CHAIN.  ALSO UPDATE CORE USAGE POINTERS.
*
*         ENTRY  (B7) = SUB CONTROL POINT ADDRESS
*                (B6) .NE. (B7) IF RETURN DESIRED
*                (B3) = RETURN ADDRESS
*                (A1) = ADDRESS OF SUBCP WORD TWO.
*                (X7) = STATUS WORD 2 OF SUB CP
*
*         EXIT   TO DCPT IF RETURN NOT REQUESTED
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7
*                A - 1, 2, 3, 4, 5, 6, 7
*                B - 6
 
 
 ESCP     SA3    B7+2        GET TASK ATTRIBUTES AND STATUS
          MX6    -12
          LX3    12
          SA2    B7          CONTROL WORD ONE OF SUBCP
          BX3    -X6*X3
          SA5    AVAILCM
          TA3    X3+TLTAW-TLDAW,VTLD  TASK ATTRIBUTES AND STATUS
          SX6    -B1
          LX3    59-TLQUS
          BX1    X7
          PL     X3,ESCP0.1  IF Q-ATTRIBUTE NOT SPECIFIED
          RJ     ITA         DECREMENT TASK ACTIVE COUNT
 ESCP0.1  BX7    X1
          LX7    -1
          SB6    B7          SUB CONTROL POINT ADDRESS
          LX2    -18
          SX3    X2+NUAPL    CORE USED BY SUB CP
          IX6    X5+X3       ADD TO AVAILABLE CORE COUNT
          SA6    A5
          PL     X7,ESCP1    DO NOT REUSE TASK
          LX7    -1
          SX3    B1
          LX2    18
          SA7    A1+         SUBCONTROL POINT CONTROL WORD 2
          LX3    59-1
          TX6    B7+CPAL,-VCPA
          BX7    X2+X3
          AX6    SCPAL
          SA4    SCHDA       REUSABLE TASK STATUS WORD
          LX3    1-12        POSITION AT BIT 47
          SB6    X6
          SA7    B7          SET REUSABLE BIT IN CONTROL WORD 1
          AX3    X3,B6
          BX6    X3+X4
          SX7    B1          REQUEST TASK SCHEDULER
          SA6    A4+         BIT SET IN REUSABLE TASK STATUS WORD
          SA7    RSCH
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
*         RELEASE SUB CONTROL POINT AND ITS CORE
*         ENTRY  (B6) = SUB CONTROL POINT TO RELEASE
 
 ESCP1    TX6    B6+CPAL,-VCPA
          SA4    SCHDA       CLEAR BIT IN REUSEABLE TASK LIST
          AX6    SCPAL
          SX3    B1+
          LX3    -1-12       POSITION AT BIT 47
          SB1    X6+         SHIFT COUNT
          AX3    X3,B1
          BX6    -X3*X4      MASK OUT BIT - IF SET
          SB1    1
          SA6    A4+
          SX7    B6
          TA2    0,VNACP     NEXT FREE SUB CONTROL POINT
          BX6    X2
          SA3    B6
          SA7    A2          ADD RELEASED SUB CP TO START OF CHAIN
          LX3    -18
          SA6    B6          SET CHAIN POINTER IN CONTROL POINT AREA
          SX7    X3+NUAPL    TOTAL FL RELEASED
          LX3    -18
          SX2    X3          FREE CORE AFTER RELEASED SUB CP
          IX4    X2+X7       TOTAL CONTIGOUS CORE
 
*         FIND PREVIOUS SUB CP AND INCREMENT ITS FREE CORE COUNT.
 
          SA2    B6+2        THIRD STATUS WORD OF SUB CP BEING DROPPED
          MX5    -18
          LX2    -18
          SA3    X2+2        THIRD STATUS WORD OF PREVIOUS SUB CP
          LX2    18
          BX7    X5*X3       REMOVE NEXT SUB CP POINTER
          BX6    -X5*X2
          IX7    X7+X6       NEW NEXT SUB CP POINTER
          SA7    A3
          ZR     X6,ESCP2    DROPPING AT END OF CHAIN
          SA1    X6+2
          LX1    -18
          BX6    X5*X1       MASK OFF BACKWARD POINTER
          SX1    A3-2
          BX6    X1+X6       ADD NEW BACKWARD POINTER
          LX6    18
          SA6    A1+
 ESCP2    LX2    -18
          SA2    X2+         FIRST STATUS WORD OF PREVIOUS SUB CP
          LX2    -36
          IX6    X4+X2       ADD IN CORE RELEASED BY DROPPING SUB CP
          LX6    36
          SX7    B1          REQUEST TASK SCHEDULER
          SA6    A2
          SA7    RSCH
          EQ     B6,B7,ESCP3 IF DROP CPU FOR TASK
          JP     B3          RETURN TO CALLING ROUTINE
 
 ESCP3    RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 ETSQ     SPACE  4
**        ETSQ   ENTER A TASK INTO THE SCHEDULER QUEUE
*
*         ENTRY  (X0) = START OF COMMUNICATIONS BLOCK
*                (B3) = ALTERNATE EXIT ADDRESS
*
*         EXIT   (X6) = 0 IF RTL FULL
*
*         USES   X - 1, 2, 3, 4, 6, 7
*                A - 1, 2, 3, 4, 6, 7
*                B - 4, 5, 6
 
 
 ETSQ     PS                 ENTRY/EXIT
          TX4    X0,-VCBSA
          SA1    X0+2        TASK LIST WORD
          MX7    12
          SX6    CMBL
          BX2    X7*X1       TASK TO BE SCHEDULED
          PX4    X4
          SX1    B1
          LX2    12
          LX1    42
          TA3    X2+1,VTLD   TLD DIRECTORY WORD 3
          BX7    X3
          LX7    59-TLTOS
          PL     X7,ETSQ0    IF TASK NOT TURNED OFF
          SA2    SCTB        GET INDEX FOR *OFFTASK*
          LX2    12
          TA3    X2+1,VTLD   TLD DIRECTORY WORD 3
 ETSQ0    NX4    X4
          PX6    X6
          LX3    24
          IX7    X3+X1       BUMP TIMES CALLED COUNT
          LX2    -12         REPOSITION TASK ID
          LX7    -24
          SA7    A3
          LX3    -24+2
          PL     X3,ETSQ4    NOT A CORE RESIDENT TASK
          TA1    -3,VTLD
          TB6    0,VCPA      FIRST SUB CONTROL POINT
          SB5    X1+         NUMBER OF CORE RESIDENT TASKS
          SA1    B6+2        INITIAL TASK STATUS WORD 3
          MX3    12
          SB5    B5-B1
          SB6    B6+CPAL     ADVANCE POINTER TO NEXT SUB CP
          BX3    X3*X1       NAME OF CORE RESIDENT TASK
          IX3    X3-X2
          NZ     X3,ETSQ3    NOT A CALL TO INITIAL TASK
          TA1    CPAHL,VCPA
          SB6    A1+CPACL-1  END OF COMMUNICATION BLOCKS FOR TASK
 ETSQ1    ZR     X1,ETSQ2    OPEN ENTRY FOUND
          SB5    A1
          SA1    A1+B1
          NE     B5,B6,ETSQ1 CHECK NEXT ENTRY
          BX6    X6-X6       SET RTL FULL CONDITION TO FORCE TASK RECALL
          EQ     ETSQ        *EXIT - TRY SCHEDULING LATER
 
*         SET UP C.B. TO BE PROCESSED BY INITIAL TASK
 
 ETSQ2    MX2    1
          TA4    1,VCPA      CONTROL WORD
          MX3    1
          SX6    B1
          LX2    -5          INITIAL LOAD BIT
          BX2    X2+X3       SET WAITING FOR CPU BIT
          LX4    -36
          BX7    X2+X0
          SA7    A1          C.B. STATUS WORD
          IX6    X4+X6       BUMP C.B. COUNT FOR INITIAL TASK
          SB6    A4-B1
          LX6    36
          SX4    X4          OLD C.B. COUNT
          SA6    A4+
          NZ     X4,ETSQ     IF ITASK ACTIVE
          SA4    VFSCP       FWA OF SUB-CONTROL POINTS
          AX4    24
          EQ     RCPU        REQUEST CPU FOR INITIAL TASK
 
*         SEARCH CORE RESIDENT TASKS FOR MATCH TO REQUESTED TASK
 
 ETSQ3    ZR     B5,ETSQ4    END OF SEARCH
          SA1    B6+B1       SUB CP STATUS WORD 2
          SB5    B5-B1
          SB6    B6+CPAL
          LX1    -36
          SX3    X1          C.B.S WAITING FOR TASK
          NZ     X3,ETSQ3    AT LEAST ONE IS WAITING
          SA1    A1+B1
          MX7    12
          BX3    X7*X1       ID OF CORE RESIDENT TASK
          IX3    X3-X2
          NZ     X3,ETSQ3    NOT SAME TASK
          SA4    A1-B1
          SX3    B1
          SX1    41B         WAITING FOR CPU AND INITIAL LOAD BITS
          LX4    -36
          SX7    X0          COMMUNICATION BLOCK ADDRESS
          BX6    X4+X3       SET C.B. COUNT FOR SUB CP
          LX1    -6
          SA2    A4-1        FIRST WORD OF SUB CP AREA
          LX6    36
          BX7    X1+X7
          SX4    X2-NUAPL    START OF TASK CORE
          SA6    A4
          SA7    A1+B1
          SB6    B6-CPAL
          EQ     RCPU        REQUEST CPU FOR TASK
 ETSQ4    NX6    X6
          SA1    RTLW        RTL RESERVATION WORD
          FX3    X4/X6       DIVIDE BY C.B. LENGTH
          UX6    B4,X3
          SB5    0
          MX3    1
          LX6    B4,X6       C.B. NUMBER
          BX1    X1+X3       LOOKING FOR ZERO BITS
          SB6    X6
          MX7    12
 
*         LOOK FOR SIMILAR TASK ALREADY IN RTL
 
 ETSQ5    NX1    B4,X1
          SB4    B4+B4       TWO WORDS PER RTL ENTRY
          SB5    B5+B4
          SB4    B5-RTLL
          PL     B4,ETSQ7    NO FURTHER ENTRIES TO CHECK
          SA4    B5+RTL      READ AN RTL ENTRY
          BX6    X7*X4       MASK OFF NAME
          SX3    B1
          IX6    X6-X2       COMPARE TASK ID
          NZ     X6,ETSQ6    NOT SIMILAR TASK REQUEST
          SX6    X4
          ZR     X6,ETSQ6    QUEUE LIMIT ALREADY REACHED
          SA2    A4+B1       UPDATE ATL POINTERS
          IX6    X4-X3
          MX7    18
          TX4    B6,VATL
          BX1    -X7*X2      MASK OFF CURRENT ATL POINTER
          SA6    A4          DECREMENT QUEUE COUNT
          SA3    X4          ATL ENTRY FOR C.B.
          LX4    42
          BX6    X1+X4       NEW CURRENT C.B. POINTER
          MX7    36
          SA6    A2
          LX2    18
          SX1    B6+B1
          BX3    -X7*X3      MASK OFF ANY OLD ATL LINKS
          LX1    48
          SA4    X2
          BX6    X4+X1       SET NEXT ATL POINTER FOR LAST ATL ENTRY
          TX7    X2+1,-VATL
          LX7    36
          SA6    A4
          BX6    X3+X7       SET PRIOR ATL POINTER FOR CURRENT ATL ENTRY
          SA6    A3
          EQ     ETSQ        *RETURN
 ETSQ6    LX3    47
          BX1    X3+X1
          EQ     ETSQ5       CHECK ANOTHER RTL ENTRY
 
*         CREATE A NEW RTL ENTRY
 
 ETSQ7    SA1    A1          RTL RESERVATION WORD
          BX6    X6-X6
          SX3    B1
          NX4    X1,B4       FIND A NONRESERVED ENTRY
          SB5    B4-RTLL/RTLLE
          GE     B5,B0,ETSQ  RTL IS FULL
          LX3    -13
          LX3    X3,-B4
          BX6    -X3*X1      RESERVE THE ENTRY
          SB4    B4+B4
          LX2    12          TLD BIAS FOR REQUESTED TASK
          SA6    A1+
          MX6    -TLMPN
          TA4    X2,VTLD     GET SCHEDULING INFORMATION FROM TLD
          BX7    -X6*X4      GET MAXIMUM PRIORITY
          SA3    A4+B1
          LX6    TLBPS-TLBPN+1
          BX1    -X6*X3      GET BASE PRIORITY
          BX7    X1+X7
          MX6    6
          LX4    TLFLN-TLFLS-1  GET FIELD LENGTH
          MX1    -TLFLN
          BX6    X6*X3       RESIDENCE  /  DESTRUCTIVENESS/ PRIVELEDGES
          LX7    18
          BX4    -X1*X4
          LX4    6
          LX6    6
          MX1    -TLQLN      SET QUEUE LIMIT
          BX3    -X1*X3
          SX1    X3-1        QUEUE LIMIT
          LX2    -12
          BX7    X7+X1
          LX4    30
          BX7    X7+X2       ADD TLD BIAS
          TX1    B6,VATL     ATL ADDRESS
          BX7    X7+X4
          SA2    X1          READ ATL ENTRY
          MX4    24
          LX1    42
          SA7    RTL+B4      1ST WORD OF RTL ENTRY
          BX6    X6+X1
          LX1    -18
          BX6    X6+X1       ADD POINTERS TO ATL ENTRIES
          SA6    A7+B1       2ND WORD OF RTL ENTRY
          BX7    -X4*X2
          SA7    A2          CLEAR ANY OLD ATL LINKS
          EQ     ETSQ        *RETURN
 EVS      SPACE  4,15
**        EVS - ACTIVATE A TASK ON AN EVENT.
*
*         ENTRY  (X7) = EVENT.
*
*         EXIT   (B4) = ROLT ENTRY IF TASK ACTIVATED.
*                     = 0 IF NO TASK ACTIVATED.
*
*                (B5) = 0 IF TASK SCHEDULED FOR ROLLIN.
*                     = NON ZERO IF TASK INTERRUPTED IN ROLLOUT.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*                X - ALL.
*
*         CALLS  MSQ, SRO.
 
 
 EVS      SUBR               ENTRY/EXIT
          MX3    RTTLN
          LX3    RTBID-59    MASK FOR ROLT WAIT TIME
          BX6    X3          INITIALIZE LONGEST WAIT FOR TASK
          SB4    B0          FWA OF TASK WAITING THE LONGEST IF ANY
          BX0    X7
          SB5    B0+         BEGIN SEARCH OF ROLLOUT TABLE
 EVS1     RJ     SRO         GET FIRST/NEXT ROLLOUT ENTRY
          ZR     B5,EVS3     IF END OF ROLT
          SA5    B5+RTWEV    ROLLED EVENT
          MX2    -48
          LX2    -12
          SA4    B5          ROLT ENTRY
          BX5    X0-X5
          BX5    -X2*X5
          NZ     X5,EVS1     IF NOT REQUIRED EVENT
          NG     X4,EVS2     IF ROLLOUT COMPLETE
 
*         INTERUPT ROLLOUT PROCESS.
*         CHOOSE TASK IN ROLLOUT PROCESS RATHER THAN TASK WAITING
*         LONGEST FOR EVENT TO MINIMIZE OVERHEAD.
 
          MX6    -6
          SA4    B5+RTWEV    GET SUBCP NUMBER
          LX4    -36
          BX1    -X6*X4      SUB CONTROL POINT OF UNROLLED TASK
          LX1    SCPAL
          TA2    X1-CPAL,VCPA  SUB CONTROL POINT ADDRESS
          MX5    1
          SA4    X2-NUAPL+ROSC
          BX6    X5+X4       SET ROLLOUT INTERUPTED FLAG
          SA6    A4
          SB4    B5          ROLLOUT ENTRY SELECTED
          JP     EVS4
 
*         SAVE TASK THAT HAS WAITED THE LONGEST FOR BST.
*         TIME IN ROLT IS TIME THAT TASK IS SCHEDULED FOR ROLLIN.
*         TASK WITH LEAST VALUE OF TIME IS TASK THAT HAS WAITED THE
*         LONGEST.
 
 EVS2     BX5    X3*X4       ROLLIN TIME FOR ROLT TASK
          IX4    X5-X6
          PL     X4,EVS1     IF TASK HAS NOT WAITED THE LONGEST
          BX6    X5          SAVE LONGEST WAIT ON EVENT
          SB4    B5          SAVE ADDRESS OF ROLT ENTRY
          JP     EVS1        GET NEXT ROLT ENTRY
 
 EVS3     ZR     B4,EVSX     IF NO TASKS IN ROLT WAITING FOR EVENT
          SA5    B4          ROLLOUT ENTRY WAITING THE LONGEST
          LX5    -18         GET C.B. INDEX
          MX6    -12
          BX4    -X6*X5      COMMUNICATION BLOCK INDEX
          SX5    B4          ADDRESS OF ROLLOUT TABLE ENTRY
          TX0    X4,VCBSA    COMMUNICATION BLOCK ADDRESS
          RJ     MSQ         PLACE TASK IN SCHEDULING QUEUE
          SA1    B4          ROLLOUT TABLE ENTRY
          MX7    2           CLEAR TIME AND WAIT FLAGS
          LX7    RTBWI-59
          BX7    -X7*X1
          SA7    A1+
 EVS4     MX6    24          CLEAR EVENT ID
          SA1    B4+RTWEV
          BX6    X6*X1
          SA6    A1
          EQ     EVSX        RETURN
 FCB      SPACE  4,35
**        FCB - FORMAT COMMUNICATION BLOCK.
*
*         ENTRY  (X4) = 1/X,1/X,1/0,1/B,7/0,1/S,12/0,18/X,18/LENG.
*                X = FIELD IS NOT USED BY THIS ROUTINE BUT
*                    IT MAY CONTAIN DATA.
*                B = 1 IF BATCH INPUT.
*                S = 1 IF SYSTEM ORIGIN.
*                LENG = MESSAGE LENGTH IN WORDS + 1.
*                (A5)/(X5)  = TST W2.
*                (X0) = ADDRESS OF COMMUNICATION BLOCK.
*                (X3) = TERMINAL ORDINAL.
*                (B4) = INPUT BLOCK COUNT.
*                (X7) = SEQUENCE NUMBER IF (B4).NE.1.
*
*         EXIT   COMMUNICATION BLOCK.
*                (W1) = 12/CP,6/ ,24/CBTS,18/ .
*                (W2) = 18/CBTO,3/RS,3/US,18/CBTA,18/CBFW.
*                (W3) = 60/0.
*                (W4) = 60/0.
*                (W5) = 60/0.
*                (W6) = 14/ ,1/I,16/ ,1/O,5/ ,1/B,22/ .
*
*                USER HEADER.
*                (W1) = 12/DB,24/UA,24/SEQ.
*                (W2) = 42/TN,1/S,1/P,1/B,1/C,1/I,1/M,12/WC.
*
*                SEE *COMKCBD* FOR EXPLANATION OF SYMBOLS.
*                A BLANK FIELD MEANS NO DATA WAS ADDED.
*
*         USES   A - 1, 2, 6, 7.
*                B - 3, 6.
*                X - 1, 2, 3, 5, 6, 7.
*
*         CALLS  ASN, RTK.
 
 
 FCB      SUBR               ENTRY/EXIT
          BX6    X6-X6
          ZR     B4,FCB1     IF ONLY INPUT BLOCK
          SX6    B1          MULTIPLE BLOCK FLAG
 FCB1     MX2    1
          SA7    FCBA        SAVE TRANSACTION SEQUENCE NUMBER
          MX1    1
          LX6    12
          LX2    INSOS-59
          LX1    INBTS-59
          BX2    X2*X4       MASK SYSTEM ORIGIN BIT
          BX1    X1*X4       MASK BATCH TRANSACTION FLAG
          LX1    CBSBS-INBTS
          LX2    CBSOS-INSOS
          SX7    B1
          LX7    CBITS-0     INITIAL TRANSFER TO C.B.
          BX7    X1+X7
          BX7    X2+X7
          LX2    CBSYS-CBSOS
          BX6    X2+X6
          SA7    X0+CBSBW    WORD SIX OF C.B.
          LX1    CBBTS-CBSBS
          MX2    TSTNN       MASK TERMINAL NAME
          BX6    X1+X6
          SX1    X4-1        MESSAGE LENGTH IN WORD
          BX2    X2*X5       TERMINAL NAME
          BX1    X2+X1       TERMINAL NAME + WORD COUNT
          BX6    X1+X6       TERMINAL NAME + S + B + M + WORD COUNT
          MX2    TSCDN
          SA1    IDLA
          LX2    TSCDS-59
          LX1    CBIDS-59
          BX6    X6+X1       TN + S + B + I + M + WC
          BX2    X2*X5       GET CDCS ABORT FLAG
          LX2    CBCDS-TSCDS
          BX6    X6+X2       TN + S + B + C + I + M + WC
          SA2    A5-B1       TST ENTRY
          SA6    X0+CMBHL+1  WORD TWO OF USER HEADER
          MX1    -6
          LX2    -36
          BX2    -X1*X2      UPDATE SECURITIES
          LX3    -18         TERMINAL ORDINAL
          SX1    A2          TST ENTRY
          LX1    18
          BX6    X3+X1       TERMINAL ORDINAL + TST
          LX2    36
          BX6    X6+X2       TERMINAL ORDINAL + SECURITIES + TST
          SX1    X0          COMMUNICATION BLOCK ADDRESS
          BX7    X6+X1       ADD COMMUNICATION BLOCK ADDRESS
          LX3    18
          BX6    X6-X6
          SA7    X0+B1       SECOND WORD OF COMMUNICATION BLOCK
          SX7    B4
          SA6    A7+B1       ZERO OUT WORD 3 OF COMMUNICATION BLOCK
          LX7    48
          SA7    A6+B1       WORD 4 OF COMMUNICATION BLOCK
          SA6    A7+B1       ZERO OUT WORD 5 OF COMMUNICATION BLOCK
          SA1    FCBA        GET TRANSACTION SEQUENCE NUMBER
          BX6    X1
          GT     B4,B1,FCB3  IF NOT FIRST BLOCK
          SA1    A5          INPUT WANTED
          ERRNZ  TSIWW-1     IF INPUT WANTED NOT IN WORD 1 OF *TST*
          LX1    59-TSIWS
          PL     X1,FCB2     IF NOT IN WAIT INPUT STATE
          SB3    B0
          RJ     RTK         SEARCH FOR SEQUENCE NUMBER
          EQ     FCB3        CONTINUE PROCESS
 
 FCB2     BX1    X3          TERMINAL ORDINAL
          RJ     ASN         GET SEQUENCE NUMBER
 FCB3     SA2    A5-B1       TST ENTRY
          MX7    -36
          SB3    DCPPR-2000B SET DEFAULT CPU PRIORITY
          BX7    -X7*X2      DATA BASE + USER AREA
          LX7    24
          BX7    X6+X7       ADD SEQUENCE NUMBER
          LX6    18
          SA7    X0+CMBHL    WORD ONE OF USER HEADER AREA
          SA2    X0
          PX6    B3,X6       ADD CPU PRIORITY
          BX6    X6+X2       ADD FWA OF NEXT C.B.
          SA6    X0          FIRST WORD OF C.B. SYSTEM HEADER
          EQ     FCBX        RETURN
 
 FCBA     BSS    1           TRANSACTION SEQUENCE NUMBER
 FFCB     SPACE  4
**        FFCB - FIND A FREE COMMUNICATION BLOCK.
*
*         ENTRY  (X0) = 0, IF NON-SYSTEM REQUEST, NON-ZERO OTHERWISE.
*
*         EXIT   (X0) = ADDRESS OF ASSIGNED COMMUNICATION BLOCK.
*                (X0) = 0, IF NO COMMUNICATION BLOCK IS AVAILABLE.
*                (X7) = INDEX OF COMMUNICATION BLOCK + 1.
*
*         USES   X - 0, 2, 3, 6, 7.
*                A - 2, 6, 7.
*                B - 3, 4.
 
 
 FFCB3    SA2    STAT12      NUMBER OF TIMES NO C.B. AVAILABLE
          SX7    B1
          IX7    X2+X7
          SA7    A2+
          BX7    X7-X7
          SA7    EVCB        INDICATE NO COMMUNICATION BLOCKS
 
 FFCB     SUBR               ENTRY/EXIT
          SB4    47
          TA2    0,VCBRT
          NZ     X0,FFCB1    IF SYSTEM REQUEST
          MX7    12
          BX7    -X7*X2
          CX3    X7          FREE COMMUNICATION BLOCKS LEFT
          BX7    X7-X7
          SX3    X3-RSCMB-1
          NG     X3,FFCB3    IF NO COMMUNICATION BLOCK
 FFCB1    NX0    B3,X2       DETERMINE POSITION OF FIRST UNSET BIT
          ZR     X0,FFCB3    IF AT END OF TABLE
          SB4    B4-B3
          NZ     B4,FFCB2    C.B. AVAILABLE
          SA2    A2+1
          SB4    47
          EQ     FFCB1       NO FREE BITS IN WORD TRY NEXT WORD
 
 FFCB2    SX3    B1
          LX3    B4,X3       POSITION BIT AT FREE ENTRY
          BX7    -X3*X2      UNSET BIT TO RESERVE ENTRY
          SA7    A2          REPLACE WORD
 
*         CALCULATE ADDRESS OF COMMUNICATION BLOCK.
 
          TX3    A2,-VCBRT   NTH WORD IN TABLE
          SX0    47
          SX2    CMBL        LENGTH OF COMMUNICATION BLOCK
          IX3    X3*X0       NTH WORD COMMUNICATION BLOCK BIAS
          SX7    X3+B3       INDEX OF COMMNICATION BLOCK
          IX3    X7*X2
          TX0    X3,VCBSA    ADDRESS OF COMMUNICATION BLOCK
          SX7    X7+B1
          SB4    CMBHL+CMBRL CLEAR C.B. HEADERS AND STATUS WORD
          BX6    X6-X6
          SA6    X0
 FFCB2.1  ZR     B4,FFCBX    IF DONE CLEARING C.B. HEADER
          SA6    A6+B1
          SB4    B4-B1       DECREMENT COUNTER
          EQ     FFCB2.1     CONTINUE TO CLEAR C.B. HEADER
 FFR      SPACE  4,10
**        FRR - FIND A FREE ROLLOUT TABLE ENTRY.
*
*         EXIT   (X0) = ADDRESS OF RESERVED ROLLOUT TABLE ENTRY.
*                (X0) = 0, IF ROLLOUT TABLE FULL.
*
*         USES   A - 2, 6.
*                B - 3, 6.
*                X - 0, 2, 3, 6.
 
 
 FFR      SUBR               ENTRY/EXIT
          SB6    47          RESERVE A ROLLOUT TABLE ENTRY
          SA2    TROM        ROLLOUT TABLE ALLOCATION MAP
 FFR1     NX0,B3 X2          LOCATE A FREE ROLLOUT TABLE ENTRY
          ZR     X0,FFRX     IF END OF TABLE
          SB6    B6-B3
          NZ     B6,FFR2     IF ENTRY AVAILABLE
          SA2    A2+1
          SB6    47
          EQ     FFR1        TRY NEXT RESERVATION WORD
 
 FFR2     SX3    B1
          LX3    X3,B6       POSITION TO LOCATED ENTRY
          BX6    -X3*X2      RESERVE ENTRY
          SA6    A2
          SX3    A2-TROM     COMPUTE WORD IN ROLLOUT MAP
          SX2    47*TROLE
          IX3    X3*X2
          SX6    B3          NTH BIT IN WORD
          SX2    TROLE
          IX2    X2*X6
          IX6    X2+X3       TABLE BIAS OF RESERVED ENTRY
          SX0    X6+TROL     FWA OF ROLLOUT TABLE ENTRY
          BX6    X6-X6
          SA6    X0          CLEAR FIRST WORD OF ENTRY
          SA6    X0+RTWEV    CLEAR EVENT WORD
          EQ     FFRX        RETURN
 GTS      SPACE  4,15
**        GTS - GET *TAF* STORAGE.
*
*         RESERVE A BLOCK OF STORAGE BY CLEARING A BIT IN THE
*         RESERVATION MAP.
*
*         EXIT   (B3) = FWA OF STORAGE.
*                     = 0 IF NO STORAGE AVAILABLE.
*
*         USES   A - 2.
*                X - 2, 3.
*                B - 3, 6.
*
*         CALLS  RSV.
 
 
 GTS      SUBR               ENTRY/EXIT
          SB6    47
          SA2    TSBM        ADDRESS OF BIT MAP
          RJ     RSV         RESERVE AN ENTRY
          NZ     X0,GTS1     IF ENTRY AVAILABLE
          SB3    0
          EQ     GTSX        RETURN
 
 GTS1     SX2    B3
          SX3    TSBLE
          IX2    X2*X3
          SB3    X2+TSB      ADDRESS OF STORAGE AREA
          EQ     GTSX        RETURN
 FNC      SPACE  4,15
**        FNC - FIND AND CHAIN COMMUNICATION BLOCKS.
*
*         ENTRY  (B6) = NUMBER OF COMMUNICATION BLOCKS NEEDED.
*                       POSITIVE IF NOT ALLOWED TO USE C.B.-S RESERVED
*                       FOR SMALL INPUT USERS.
*                       NEGATIVE IF ALLOWED TO USED C.B.-S RESERVED
*                       FOR SMALL INPUT USERS.
*                (A1) = PRIMARY COMMUNICATION BLOCK ADDRESS.
*
*         EXIT   (B6) = NUMBER OF COMMUNICATION BLOCKS NOT OBTAINED.
*
*         USES   X - 0, 1, 3, 6.
*                A - 1, 3, 6.
*                B - 3, 6.
*
*         CALLS  FFCB.
*
*         NOTE - PROBLEMS WITH DEADLOCK MAY BE ENCOUNTERED
*                IF (B6) IS NEGATIVE AT ENTRY AND CARE SHOULD BE
*                USED TO ENSURE THAT DEADLOCK DOES NOT OCCUR.
 
 
 FNC2     SX6    B0+         ZERO END OF CHAIN
          SA6    A1+
 
 FNC      SUBR               ENTRY/EXIT
          MX0    12
          SB3    B6
          PL     B3,FNC.1    IF NOT TO USE SMALL INPUT C.B.-S
          SB6    -B6
          EQ     FNC1        USE ALL BUT SYSTEM C.B.-S
 
 FNC.1    TA3    0,VCBRT     COMMUNICATION BLOCK ALLOCATION MAP
          BX6    -X0*X3
          CX3    X6
          TB3    0,-VNSIN    NUMBER OF C.B.-S RESERVED FOR SMALL INPUT
          SB3    X3+B3
          LT     B3,B6,FNCX  IF NOT ENOUGH COMMUNICATION BLOCKS
 FNC1     ZR     B6,FNC2     IF ALL COMMUNICATION BLOCKS AVAILABLE
          SX0    B0+         DO NOT USE SYSTEM COMMUNICATION BLOCKS
          RJ     FFCB        RESERVE COMMUNICATION BLOCK
          SX6    X0
          SA6    A1
          ZR     X0,FNCX     IF NO COMMUNICATION BLOCK AVAILABLE
          SB6    B6-B1
          SA1    X0
          EQ     FNC1        GET NEXT COMMUNICATION BLOCK
 IDL      SPACE  4
**        IDL - SET IDLE DOWN FLAGS.
*
*         IDLE DOWN INFORMS INITIAL TASK THAT AN IDLE DOWN WAS REQUESTED
*         AND SETS THE IDLE DOWN FLAG. IT IS INITIAL TASKS
*         RESPONSIBLITY TO CEASE PASSING TASKS THRU TO THE SYSTEM FOR
*         PROCESSING.
 
 
 IDL      SUBR               ENTRY/EXIT
          MX7    1
          SA4    ITAS        INITIAL TASKS NAME
          SA7    IDLA        IDLE DOWN FLAG
          SX5    CIIDL       ITASK IDLE DOWN CODE
          SB3    B0          NO BUFFER INPUT
          SX7    B0          SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         CALL INITIAL TASK TO INFORM OF IDLE DOWN
          NZ     X0,IDLX     IF *ITASK* SCHEDULED - RETURN
 
*         PROCESS SITUATION WHERE NO COMMUNICATION BLOCK AVAILABLE.
 
          SA1    KDISA
          MX6    -18
          SX2    1           SET INCOMPLETE IDLE DOWN FLAG
          BX6    X6*X1
          BX6    X6+X2
          SA6    A1
          EQ     IDLX        RETURN
 
 IDLA     CON    0           IDLE DOWN FLAG
 ITA      SPACE  4,15
**        ITA - INCREMENT/DECREMENT TASK ACTIVE COUNT.
*
*         ENTRY  (A3) = FWA+2 OF TLD ENTRY.
*                (X3) = WORD THREE OF TLD ENTRY SHIFTED LEFT BY
*                       59-TLQUS.
*                (X6) = INCREMENT/DECREMENT VALUE.
*
*         EXIT   COUNT UPDATED.
*
*         USES   X - 3, 4, 7.
*                A - 7.
 
 
 ITA      SUBR               ENTRY/EXIT
          MX4    -TLTAN
          LX3    TLTAN-1-TLTAS-59+TLQUS
          BX7    -X4*X3
          IX7    X6+X7
          BX3    X4*X3
          BX7    -X4*X7
          BX7    X3+X7
          LX7    59-TLSTS-TLTAN+1+TLTAS
          SA7    A3
          EQ     ITAX        RETURN
 JOL      SPACE 4,10
**        JOL - JOURNAL TRANSACTION INPUT.
*
*         ENTRY  (X0) = ADDRESS OF COMMUNICATION BLOCK.
*                (X4) = INPUT BLOCK LENGTH.
*
*         USES   A - 1, 6, 7.
*                B - 3, 4, 5.
*                X - 1, 3, 5, 6, 7.
*
*         CALLS  JRNL.
*
 
 
 JOL2     SA1    JOLA        RESTORE (X0)
          BX0    X1
 
 JOL      SUBR               ENTRY/EXIT
          SB5    PJRNL       JOURNAL FILE
          BX6    X0
          SX3    X4-1        INPUT BLOCK LENGTH
          SB4    B1
          LX4    1
          SX5    X0+CMBHL+CMBRL  START OF MESSAGE
          PL     X0,JOL1     IF NEITHER INTERACTIVE OR MULIT BLOCK
          SB4    6
          PL     X4,JOL1     IF LAST BLOCK OF TRANSACTION
          SB4    5
 JOL1     LX3    18
          SA6    JOLA        SAVE X0
          BX5    X5+X3       ADD LENGTH OF MESSAGE
          SB3    JOL2        RETURN ADDRESS
          EQ     JRNL        MAKE A JOURNAL ENTRY
 
 JOLA     BSS    1           TEMPORARY STORAGE FOR X0
 
 
 JSTS     SPACE  4
**        JSTS - WRITE PERIODIC ENTRIES TO JOURNAL FILE.
*
 
 
 JSTS     SUBR               ENTRY/EXIT
 
*         WRITE COPY OF TST TO JOURNAL FILE
 
          SB3    JSTS        RETURN ADDRESS
          SB4    3           STATISTICAL DATA ORIGIN CODE
          TX5    TSTLLE,VTST FWA OF TERMINAL STATUS TABLE
          TX2    1,VTST,LWA  LWA+1 OF TST
          IX1    X2-X5       LENGTH OF TST
          SB5    PJRNL       JOURNAL FILE FET
          LX1    18
          BX0    X0-X0       NO COMMUNICATION BLOCK
          IX5    X5+X1
          EQ     JRNL        JOURNAL THE INFORMATION
 LTT      SPACE  4,25
**        LTT - LOCATE A TASK OR TRANSACTION.
*
*         LOOK FOR THE NAMED TASK OR TRANSACTION ASSOCIATED WITH THE
*         SPECIFIED DATA BASE.
*
*         ENTRY  (X2) = LEFT JUSTIFIED TASK OR TRANSACTION NAME.
*                (X3) = RIGHT JUSTIFIED DATA BASE NAME OF TASK LIBRARY.
*                     = 0 IF SYSTEM TASK LIBRARY.
*                (X6) = TASK LIST ACCUMULATOR IF (B5)=0.
*                (B4) = 1 IF *OFF* STATUS TO BE IGNORED, IF (B5)=0.
*                     = 0 IF *OFF* STATUS DETECTED, IF (B5)=0.
*                (B5) = 0 IF TASK SEARCH.
*                     .NE. 0 IF TRANSACTION SEARCH.
*
*         EXIT   (A0) = ADDRESS OF TLD ENTRY IF TASK TURNED OFF.
*                (A1) = FWA OF TLD/TRD ENTRY MATCHED.
*                (X0) = RESTORED.
*                (X6) = TASK BIAS ADDED TO PRIOR CONTENTS IF (B5)=0.
*                     = 0 IF TASK OR TRANSACTION NOT FOUND.
*                (B3) = RESTORED.
*
*         USES   A - 0, 1, 3, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  STD.
 
 
 LTT10    SA3    LTTE        RESTORE (B3) AND (X0)
          SB3    X3+
          LX3    -18
          SX0    X3+
 
 LTT      SUBR               ENTRY/EXIT
          LX0    18          SAVE (X0) AND (B3)
          SX7    B3+
          BX7    X0+X7
          SA7    LTTE
          SX7    B4+
          SA7    LTTC        *OFF*-TEST FLAG
          SX7    B5+
          SA7    LTTD        SEARCH FLAG
          BX7    X3
          SA7    LTTA
          SA6    LTTB
          SB3    TLDLE       LENGTH OF TLD ENTRY
          ZR     X3,LTT4     IF NO DATA BASE SPECIFIED
          TA3    0,VEDT
          LX7    -12
          LX3    17-35
          SB4    X3          EDT COUNT
          LX3    35-17
          ZR     B4,LTT1.1   IF NO EDT-S TO SEARCH
 LTT1     MX6    12
          BX6    X6*X3       EDT DATA BASE NAME
          IX6    X6-X7
          SB4    B4-B1
          ZR     X6,LTT2     IF DATA BASE NAME FOUND
          SA3    X3+         LINK TO NEXT EDT
          NZ     B4,LTT1     IF ANOTHER EDT TO CHECK
 LTT1.1   SX7    B0+
          SA7    LTTA        CLEAR DATA BASE FLAG
          EQ     LTT4        SEARCH SYSTEM TASK LIBRARY
 
*         SEARCH USER TASK/TRANSACTION DIRECTORY.
 
 LTT2     SA1    A3+4        FWA OF FIRST TLD ENTRY
          ZR     X1,LTT1.1   IF NO DATA BASE TASK LIBRARY
          ZR     B5,LTT3     IF TASK SEARCH
          LX1    -18
          SA1    X1+TRFWW    FWA OF TLD HEADER
          LX1    TRFWN
          SB5    X1          FWA OF FIRST TRD ENTRY
          SB3    TRDLE2      LENGTH OF TRD ENTRY
          SA1    X1+TDLDW
          SB6    X1-TRDLE2+1 FWA OF LAST TRD ENTRY
          EQ     LTT6        LOOK FOR TRANSACTION
 
 LTT3     SB6    X1+         LWA OF TLD
          BX7    X1
          LX1    17-35
          SB5    X1+         FWA OF TLD
          SB6    B6-TLDLE+1  LWA IN TLD TO SEARCH
          SA7    LTTA
          EQ     LTT6        LOOK FOR TASK
 
*         SEARCH SYSTEM TASK/TRANSACTION DIRECTORY.
 
 LTT4     NZ     B5,LTT5     IF TRANSACTION SEARCH
          TB5    0,VTLD      START OF TLD
          TB6    -TLDLE+1,VTLD,LWA  LWA OF SYSTEM TLD FOR SEARCH
          EQ     LTT6        LOOK FOR TASK
 
 LTT5     TX1    0,VTLD
          SA1    X1+TRFWW
          LX1    TRFWN
          SB3    TRDLE2      LENGTH OF TRD ENTRY
          SB5    X1          FWA OF FIRST TRD ENTRY
          SA1    X1+TDLDW
          SB6    X1-TRDLE2+1 FWA OF LAST TRD ENTRY
 LTT6     RJ     STD         SEARCH TASK/TRANSACTION DIRECTORY
          NZ     X1,LTT9     IF ENTRY NOT FOUND
 
*         TASK/TRANSACTION FOUND.
 
          SA3    LTTD        SEARCH FLAG
          SX6    1
          NZ     X3,LTT10    IF TRANSACTION FOUND
          TX7    A1+1,-VTLD  ADD ONE TO RELATIVE ADDRESS TO AVOID ZERO
          SA3    LTTC        GET *OFF* FLAG
          SB5    X3
          SA3    A1+TLTOW
          LX3    59-TLTOS    *OFF* FLAG
          NZ     B5,LTT7     IF IGNORE *OFF* STATUS
          NG     X3,LTT8     IF TASK TURNED OFF
 LTT7     LX3    59-TLDLS-59+TLTOS
          NG     X3,LTT9     IF TASK DELETED
          LX7    48
          SA3    LTTB        TASK LIST ACCUMULATOR
          BX6    X3+X7
          EQ     LTT10       RESTORE REGISTERS
 
*         CALL A DEFAULT TASK IN PLACE OF A TASK THAT HAS BEEN
*         TURNED OFF.
 
 LTT8     SA1    OTAS        DEFAULT TASK NAME
          SA0    A3          ADDRESS OF TURNED-OFF TASK
          BX2    X1
          SA3    LTTA
          ZR     X3,LTT5     IF NO DATA BASE TASK LIBRARY
          SB6    X3-TLDLE+1
          LX3    -18
          SB5    X3
          EQ     LTT6        SEARCH *DBTASKL* FOR DEFAULT TASK
 
*         TASK OR TRANSACTION NOT FOUND.
 
 LTT9     SA1    LTTA
          BX6    X6-X6
          SA6    A1
          ZR     X1,LTT10    IF ENTRY NOT FOUND AND NO *DBTASKL*
          SB5    B3-TLDLE
          EQ     LTT4        NOW SEARCH SYSTEM TLD FOR DESIRED ENTRY
 
 LTTA     BSS    1           DATA BASE FLAG
 LTTB     BSS    1           TASK LIST ACCUMULATOR
 LTTC     BSS    1           *OFF*-TEST FLAG
 LTTD     BSS    1           SEARCH FLAG
 LTTE     BSS    1           24/0,18/(X0),18/(B3)
 MSQ      SPACE  4,10
**        MSQ - MAKE A SCHEDULER QUEUE ENTRY TO ROLL IN A TASK.
*
*         ENTRY  (X0) = COMMUNICATION BLOCK ADDRESS.
*                (X5) = ROLLOUT TABLE ADDRESS OF TASK TO ROLL IN.
*
*         USES   A - 2, 3, 6, 7.
*                B - 3, 6.
*                X - 2, 3, 4, 6, 7.
 
 
 MSQ      SUBR               ENYRY/EXIT
          SA2    RTLW        RTL RESERVATION WORD
          SX3    B1
          NX6    X2,B3       FIND A NONRESERVED ENTRY
          LX3    -13
          LX3    X3,-B3
          BX6    -X3*X2      RESERVE THE ENTRY
          SB3    B3+B3
          TX4    X0,-VCBSA
          SA6    A2
          SB6    B7
          SX7    CMBL        COMPUTE THE C.B. NUMBER
          IX7    X4/X7
          SB7    B6
          TX2    X7,VATL     ATL ADDRESS
          SA3    X2
          MX7    30
          BX6    -X7*X3      CLEAR ATL LINKS
          SA6    A3
          SA3    X5+B1
          BX7    X7*X3       FL + PRIORITIES
          LX2    42
          LX7    -12
          BX6    X2
          LX2    -18
          BX6    X6+X2
          SA7    B3+RTL      FIRST WORD OF RTL ENTRY
          BX6    X6+X5
          SA6    A7+B1       SECOND WORD OF RTL ENTRY
          EQ     MSQX        RETURN
 MVD      SPACE  4,15
**        MVD - MOVE DATA TO TASK.
*
*         ENTRY  (X1) = LENGTH TO MOVE IN WORDS.
*                (X2) = ORIGIN FWA.
*                (X3) = DESTINATION FWA.
*                (X6) = NUMBER OF BITS OVER WORD BOUNDARY.
*
*         EXIT   DATA IS MOVED FROM ORIGIN TO DESTINATION.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 6.
*
*         CALLS  MVE=
 
 
 MVD      SUBR               ENTRY/EXIT
          SA6    MVDA        REMAINDER OF BITS OVER LAST WORD
          NZ     X6,MVD2     IF DATA DOES NOT END ON WORD BOUNDARY
 MVD1     RJ     MVE=        MOVE DATA
          SA1    MVDA
          ZR     X1,MVDX     IF DATA ENDS ON WORD BOUNDARY
 
*         RESTORE USER BITS IN LAST WORD.
 
          SA2    MVDB        LWA OF DESTINATION
          SA1    MVDC        OLD LAST WORD OF DESTINATION
          SA3    X2          NEW LAST WORD OF DESTINATION
          SA4    MVDA        MASK FOR SAVING NEW BITS IN LAST WORD
          BX3    X4*X3       SAVE NEW BITS IN LAST WORD
          BX4    -X4*X1      SAVE OLD BITS IN LAST WORD
          BX7    X4+X3       MERGE OLD AND NEW
          SA7    A3
          EQ     MVDX        RETURN
 
*         SAVE LAST WORD OF DESTINATION.
 
 MVD2     IX7    X3+X1
          SA4    X7-1
          SX7    A4          LWA OF DESTINATION
          SB6    X6-1
          BX6    X4
          SA7    MVDB
          SA6    MVDC
          MX7    1           MASK TO SAVE NEW BITS IN LAST WORD
          AX7    B6
          SA7    MVDA
          EQ     MVD1        MOVE DATA
 
 MVDA     BSS    1           MASK FOR SAVE NEW BITS
 MVDB     BSS    1           LWA OF DESTINATION
 MVDC     BSS    1           LAST WORD OF DESTINATION
 PBT      SPACE  4,65
**        PBT - PREPARE BATCH TRANSACTION.
*
*         ENTRY  (SSRP) = SUBSYSTEM REQUEST BUFFER.
*
*         EXIT   TO *TSSC*
*                IF POSSIBLE *ITASK* HAS BEEN SCHEDULED WITH THE
*                TRANSACTION INPUT.  IF AN ERROR OCCURRED THE PROPER
*                STATUS WAS RETURNED TO THE USER.
*
*         USES   X - XLL.
*                A - ALL.
*                B - 3, 4, 5, 6.
*
*         CALLS  FCB, FFCB, GTS, JOL, PRIN, RTS, SFR, VBA.
*
*         NOTES  *PBT* USES PART OF THE COMMUNICATION BLOCK FOR
*                TEMPORARY STORAGE.  BEFORE *FCB* FORMATS THE
*                COMMUNICATION BLOCK, THE FORMAT IS -
*
*T  W1    6/RC,12/FP,18/UCPA,18/SCPA,6/FC
*T, W2    35/JOBSN,12/0,12/FSTA
*T, W3    60/0
*T, W4    60/(SSRP)
*T, W5    35/JOBSN,12/0,12/FSTA
*T, W6    24/0,18/LENGTH,18/ATRAN
*T, W7    24/0,18/TSTO,18/TSTA
*T, W8    60/SCR
*
*         WORD 1 THRU 3 CONTAIN THE *SFCALL* PARAMETER BLOCK.
*
*         WORD 1.
*            RC  - REPLY CODE.
*            FP  - FUNCTION PARAMETER.
*            UCPA- RELATIVE CM ADDRESS WITHIN UCP.
*            SCPA- RELATIVE CM ADDRESS WITHIN SUBSYSTEM.
*            FC  - FUNCTION CODE.
*
*         WORD 2.
*            JOBSN - JOB SEQUENCE NUMBER.
*            FSTA  - FST ADDRESS.
*
*         WORD 3.
*            (NOT USED) PARAMETER FOR EXTENDED READ AND WRITE
*            *SFCALL* FUNCTION.
*
*         WORDS 4 THRU 7 ARE TEMPORARY STORAGE FOR DATA NEEDED FOR
*         PROCESSING BATCH TRANSACTIONS.
*
*         WORD 4.
*            (SSRP) - CONTENTS OF SSRP WORD.
*
*         WORD 5.
*            JOBSN - JOB SEQUENCE NUMBER.
*            FSTA  - FST ADDRESS.
*
*         WORD 6.
*            LENGTH - LENGTH OF TRANACTION INPUT IN WORDS.
*            ATRAN  - ADDRESS OF TRANSACTION.
*
*         WORD 7.
*            TSTO - TST ORDINAL.
*            TSTA - TST ADDRESS.
*
*         WORD 8.
*            SCR - SCRATCH STORAGE.
 
 
 PBT      SA2    PBTD
          NZ     X2,PBT12    IF LAST *BTRAN* INPUT NOT PROCESSED
          RJ     GTS         GET TAF STORAGE
          ZR     B3,TSSC     IF NO TAF STORAGE
          SB5    B3          FWA OF STORAGE
          SX0    B0          INDICATE NON-SYSTEM C.B.
          RJ     FFCB        FIND FREE C.B.
          SX5    JSTB        TAF BUSY ERROR CODE
          NZ     X0,PBT1     IF C.B. AVAILABLE
          SB3    B5
          RJ     RTS         RETURN TAF STORAGE
          EQ     PBE         PROCESS BATCH ERROR
 
 PBT1     SB6    X0          SAVE C.B. ADDRESS
 
*         MOVE SCP BUFFER INTO HEADER AREA OF C.B.
 
          SA2    SSRP        TAF RECEIVING BUFFER
          BX6    X2
          SA6    B6+3        SAVE (SSRP) PARAMETER AREA
          SA2    SSJN        JOB SEQUENCE NUMBER AND FST ORDINAL
          BX6    X2
          SA6    A6+B1
          SA2    SSUP+1      LENGTH AND ADDRESS OF TRANSACTION INPUT
          MX6    -36
          BX6    -X6*X2
          SA6    A6+1
 
*         INDICATE REQUEST RECEIVED.
 
          SA2    VSCR        TAF RECEIVING BUFFER (SSCR)
          MX3    -59
          BX6    -X3*X2
          SA6    A2+
 
*         GET USER NAME AND VALIDATE.
 
 PBT2     SX6    B6+CMBHL+CMBRL
          SX1    /COMSSCP/CPID  SFCALL FUNCTION CODE
          LX6    6           POSITION SCP ADDRESS
          BX6    X6+X1
          SA6    B6+
          SA2    B6+4        GET JOB SEQUENCE NUMBER AND FST ORDINAL
          BX6    X2
          SA6    A6+B1
          SX2    PBT2        RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL REQUEST
          NZ     X5,PBT9     IF SFCALL ERROR
          SB6    B6+CMBHL+CMBRL
          SA4    B6+1        USER NAME FROM CPID FUNCTION
          SX1    TYBT        INDICATE *BTRAN* TRANSACTION.
          SX5    PBT3        RETURN ADDRESS
          EQ     VBA         VALIDATE BATCH ACCESS
 
 PBT3     SB4    X3
          BX7    X7-X7
          SA2    B6+BRTOW    SAVE TST ORDINAL AND ADDRESS
          BX6    X2
          SA7    A2          CLEAR TST ORDINAL FROM BODY OF C.B.
          SB3    JSRC        REQUEST COMPLETE CODE
          SA7    A2-1        CLEAR TERMINAL NAME FROM C.B.
          SB6    B6-CMBHL-CMBRL
          SA6    B6+6
          EQ     B3,B4,PBT5  IF REQUEST COMPLETE
          SB3    JSNV        USER NOT VALID
          NE     B3,B4,PBT6  IF USER VALID
 PBT4     SX3    B1          SET NORMAL SUBSYSTEM (FSET) ERROR FLAG
          SX6    B0          SCP ADDRESS
          SX1    /COMSSCP/REGR  SFCALL FUNCTION CODE
          LX6    6           POSITION SCP ADDRESS
          BX6    X6+X1
          LX3    41-17
          BX6    X6+X3       ADD UCP ADDRESS
          SA6    B6+         SFCALL PARAMETER WORD ONE
          SX2    PBT4        RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL REQUEST
          SX3    JSNV        USER NOT VALID
          EQ     PBT6        RETURN STATUS TO USER
 
*         CHECK LENGTH OF TRANSACTION INPUT DATA, IF VALID LENGTH
*         THEN READ THE TRANSACTION INPUT DATA.
 
 PBT5     SX6    B6+CMBHL+CMBRL-1  SCP ADDRESS
          SA2    B6+5        LENGTH AND ADDRESS OF TRANSACTION INPUT
          LX2    17-35
          SX2    X2-62-1     LENGTH - MAXIMUM INPUT LENGTH
          SX3    JSSB        BLOCK TOO LONG ERROR CODE
          PL     X2,PBT6     IF TRANSACTION INPUT .GT. MAXIMUM ALLOWED
          SX1    /COMSSCP/READ  SFCALL FUNCTION CODE
          LX6    6           POSITION SCP ADDRESS
          BX6    X6+X1
          SA3    B6+5        WORD 2 OF USER PARAMETERS
          LX3    53-29       POSITION WORD COUNT AND UCP ADDRESS
          BX6    X6+X3
          SA6    B6+         SFCALL PARAMETER WORD ONE
          SX2    PBT5        RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL REQUEST
          SX3    JSRC        REQUEST COMPLETE CODE
          ZR     X5,PBT6     IF NO CALL ERROR
          SX3    JSFL        DATA NOT WITHIN UCP FL CODE
 
*         RETURN STATUS TO USER JOB.
*         (X3) = STATUS CODE.
 
 PBT6     SA2    PBTC        SET UP FIRST USER PARAMETER
          BX6    X3+X2       ADD NEW STATUS
          SA6    B6+7
 PBT7     SA3    B6+3        GET UCP PARAMETER AREA ADDRESS
          SX6    B6+7        SCP ADDRESS
          SX1    /COMSSCP/WRIT  SFCALL FUNCTION CODE
          LX6    6           POSITION SCP ADDRESS
          BX6    X6+X1
          SX3    X3+B1
          LX3    41-17       POSITION UCP ADDRESS
          BX6    X6+X3       ADD UCP ADDRESS
          SX2    B1          WORDS TO WRITE TO UCP
          LX2    53-11       ADD WORD COUNT
          BX6    X6+X2
          SA6    B6+
          SX2    PBT7        RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL REQUEST
 
*         TERMINATE CONNECTION WITH UCP.
 
 PBT8     SA3    B6+3        GET UCP PARAMETER AREA ADDRESS
          SX6    /COMSSCP/ENDT  SFCALL FUNCTION CODE
          SX3    X3
          LX3    41-17
          BX6    X6+X3
          SA6    B6          FIRST WORD OF SFCALL PARAMETERS
          SX2    PBT8        RETRY ADDRESS
          RJ     SFR         ISSUE SFCALL REQUEST
          SA5    B6+7        GET STATUS RETURNED TO USER
 PBT9     SB3    X5+
          SB4    JSRC        REQUEST COMPLETE STATUS CODE
          EQ     B3,B4,PBT11 IF NO ERRORS
          SA5    B6+6        GET TST ADDRESS
          MX3    -60+TSAUN   CLEAR USER ACTIVE BIT
          SA4    X5+
          ERRNZ  TSAUW       USER ACTIVE BIT NOT IN WORD ZERO
          ERRNZ  59-TSAUS    USER ACTIVE BIT NOT LEFT JUSTIFIED
          BX6    -X3*X4
          SA6    A4+
 PBT10    SX2    B6
          BX7    X7-X7       CLEAR NEXT C.B. FIELD
          SA7    B6+
          RJ     RLC         RELEASE COMMUNICATION BLOCK
          ZR     B5,TSSC     IF NO TEMPORARY STORAGE
          SB3    B5+
          RJ     RTS         RELEASE TEMPORARY STORAGE
          EQ     TSSC        CONTINUE PROCESSING
 
 PBT11    SB3    B5
          SX4    B6
          RJ     RTS         RELEASE TEMPORARY STORAGE
          SB6    X4
 
*         FORMAT COMMUNICATION BLOCK.
 
          SX6    B6          SAVE FWA OF C.B.
          SA4    PBTA
          SA3    B6+5
          LX3    17-35
          SB4    B0          INPUT BLOCK COUNT
          SA6    PBTD
          SX3    X3+1
          SX7    B0          ZERO OUT WORD ONE OF C.B.
          SA2    B6+6        GET TST ORDINAL AND ADDRESS
          BX4    X4+X3
          SA7    X6
          SA5    X2+B1       GET WORD TWO OF TST
          LX2    17-35       POSITION TST ORDINAL
          SX3    X2          TST ORDINAL
          SX0    B6+         FWA OF C.B.
          RJ     FCB         FORMAT COMMUNICATION BLOCK
 
*         JOURNAL TRANSACTION INPUT.
 
          SA1    PBTD        FWA OF C.B.
          SX0    X1+
          SA4    X1+CMBHL+1  USER HEADER WORD TWO
          MX6    -12
          BX4    -X6*X4      WORDS TO JOURNAL
          RJ     JOL         JOURNAL TRANSACTION INPUT
 
*         SCHEDULE *ITASK*.
 
 PBT12    SA1    PRINA       CHECK IF *ITASK* BUSY
          NZ     X1,TSSC     IF *ITASK* BUSY RETURN AND TRY LATER
          SA1    PBTD        FWA OF C.B.
          MX7    1           INDICATE C.B. ALREADY PRESENT
          SX0    X1
          LX7    55-59
          SA7    PBTB
          SA4    A7
          RJ     PRIN        PROCESS TRANSACTION INPUT
          ZR     X0,TSSC     IF ITASK NOT SCHEDULED
          BX6    X6-X6       INDICATE *ITASK* SCHEDULED
          SA6    PBTD
          EQ     TSSC        CONTINUE PROCESSING
 
 PBTA     VFD    1/0,1/0,1/0,1/1,7/0,1/0,12/0,18/0,18/0
 PBTB     BSS    1           *PRIN* INPUT WORD
 PBTC     VFD    12/2001B,12/0,12/0,6/0,18/0  USER PARAMETER ONE
 PBTD     BSS    1           FWA OF COMMUNICATION BLOCK
 PCDM     SPACE  4,10
**        PCDM   PCDM DOES HOUSEKEEPING FOR TRANSACTION END PROCESSING.
*                IF THE TRANSACTION HAS MADE DATA MANAGER REQUESTS
*                A DATA MANAGER CEASE REQUEST IS CREATED, ELSE THE
*                END OF TRANSACTION MESSAGE IS JOURNALED.
*
*         ENTRY  (X0) = DATA MANAGER CODE
*
*         EXIT   (X5) .GE. 0 IF NO DATA MANAGER REQUEST WERE MADE.
 
 
 PCDM     SUBR               ENTRY/EXIT
          SA1    B2+CB2C
          SA4    B2+CB1C
          SA3    X1+CBSOW    SYSTEM ORIGIN TRANSACTION
          ERRNZ  CBSOW-CBSBW IF *BTRAN* AND SYSTEM NOT IN SAME WORD
          LX3    59-CBSOS
          LX4    59-CBSDS
          NG     X3,PCDM1    IF SYSTEM ORIGIN TRANSACTION
          LX3    59-CBSBS-59+CBSOS
          SA1    B7+B1
          LX1    59-SCTMS
          NG     X1,PCDM1    IF TASK IS TO BE TERMINATED
          NG     X3,PCDM1    IF *BTRAN*
          PL     X4,TERR22   IF NOT AT LEAST ONE SEND
 
 PCDM1    SA1    B2+CB2C
          SA2    X1+CBCR     CHECK IF DATA MANAGER USED BY TASK
          LX2    59-CDDM
          PL     X2,PCDM3    IF *CDCS* IS NOT CONNECTED
          SA3    X1          FWA OF COMMUNICATION BLOCK
          LX3    59-CBABS
          SA4    PCDMA
          BX7    X4
          SA5    A4+1
          SA7    B2+NUAPL+SUAC+CBCH
          SB4    A7+         FWA OF PARAMETER BLOCK
          SX2    CDAT        ABNORMAL TERMINATION FUNCTION CODE
          NG     X3,PCDM2    IF TAF ABORT FLAG SET
          LX3    59-CBRCS-59+CBABS
          NG     X3,PCDM2    IF TERMINAL OR NETWORK FAILURE
          SX2    CDNT        NORMAL TERMINATION FUNCTION CODE
 PCDM2    BX7    X2+X5       ADD FUNCTION CODE
          SB3    PCDM3       RETURN ADDRESS
          SA7    A7+B1
          SA5    A5+B1       REQUEST
          SA1    B7          SET FL
          SB5    B2+NUAPL    TASK RA
          AX1    18
          SX1    X1          TASK FL
          EQ     SSC1        PROCESS TERMINATOR TO *CDCS* REQUEST
 
 PCDM3    SA1    B2+CB2C
          SA2    X1+CBCR     CHECK FOR DATA MANAGER CALLS MADE
          LX2    59-TOTDM
          PL     X2,PCDM5    IF TOTAL DATA MANAGER NOT USED
          SB3    PCDM7       RETURN ADDRESS
          SA4    B2+CB1C     COMMUNICATION BLOCK WORD 1
          BX5    X5-X5
          SX0    DMCC        CEASE FUNCTION CODE
          LX0    24
          SX1    X1          C.B. ADDRESS
          LX4    59-CBABS
          AX4    59
          BX1    X1-X4       SET ERROR FLAG FOR DATA MANAGER
          MX4    -18
          BX4    -X4*X1
          EQ     TOT1        SEND CEASE CODE TO TOTAL DATA MANAGER
 
 PCDM5    SA1    B2+CB2C
          SA2    X1+CBCR     CHECK FOR DATA MANAGER CALLS MADE
          LX2    59-AAMDM
          PL     X2,PCDM7    IF AAM FILE MANAGER NOT USED
          SB3    PCDM7       RETURN ADDRESS
          SA4    B2+CB1C     COMMUNICATION BLOCK WORD 1
          BX5    X5-X5
          SX0    DMCC        CEASE FUNCTION CODE
          LX0    24
          SX1    X1          COMMUNICATION BLOCK ADDRESS
          LX4    59-CBABS
          AX4    59
          BX1    X1-X4       SET ERROR FLAG FOR DATA MANAGER
          MX4    -18
          BX4    -X4*X1
          EQ     AAM1        SEND CEASE CODE TO AAM FILE MANAGER
 
 PCDM7    SA1    B2+CB2C     GET COMMUNICATION BLOCK ADDRESS
          SA2    X1+CBCR
          MX5    -4
          SX0    X1          COMMUNICATION BLOCK ADDRESS
          LX2    -18
          BX2    -X5*X2
          ZR     X2,PCDM8    IF NO DATA MANAGER USED BY TASK
          EQ     PCDMX       X5 IS NEGATIVE
 
*         WRITE JOURNAL FILE ENTRY TO INDICATE TRANSACTION CEASE
 
 PCDM8    SB3    PCDM9       RETURN ADDRESS
          SA1    B2+CB2C     SET COMMUNICATION BLOCK ADDRESS
          SX5    SBUF+4      USE WORKING STORAGE BUFFER AS ADDRESS
          SB4    4           END OF TRANSACTION INDICATOR
          SX0    X1+
          SB5    PJRNL
          EQ     JRNL        JOURNAL MESSAGE
 
 PCDM9    SA2    B2+CB2C
          SX5    A2-B1
          SX2    X2          C.B. ADDRESS
          EQ     PCDMX       RETURN
 
 PCDMA    VFD    24/4LCD22,12/0,6/2,4/0,2/3,6/0,5/0,1/0  PARAMETER
          VFD    18/SUAC+CBCH+3,9/0,27/0,6/0  PARAMETER BLOCK WORD 2
          VFD    18/3LSSC,24/CDSI,18/SUAC+CBCH  FUNCTION REQUEST
 PDIF     SPACE  4
**        PDIF - PLACE ENTRY INTO A FET.
*
*         ENTRY  (B5) = ADDRESS OF FET
*                (X6) = WORD TO PLACE INTO FET
*
*         EXIT   (X7) = 0 IF FET FULL
*
*         USES   X - 1, 2, 3, 7
*                A - 1, 2, 3, 6, 7
*                B - 3, 4, 5
 
 
 PDIF     SUBR               ENTRY/EXIT
          SA3    B5+3        OUT
          BX7    X7-X7
          SA2    A3-B1       IN
          SB5    X3
          SA3    A3+B1       LIMIT
          SB3    X2+B1       (IN +1)
          SB4    X3
          NE     B3,B4,PDIF1 IF NOT WRAP-AROUND
          SA1    A2-B1       FIRST
          SB3    X1
 PDIF1    EQ     B3,B5,PDIFX IF BUFFER FULL - RETURN
          SX7    B3
          SA6    X2          STORE WORD
          SA7    A2          ADVANCE IN
          EQ     PDIFX       RETURN
 PDMR     SPACE  4,20
**        PDMR   PROCESS D.M. OUTPUT QUEUE. IF A REPLY TO A TASK CEASE
*                IS DETECTED, THE END OF TRANSACTION MESSAGE IS
*                JOURNALED.
*                IF A REPLY TO A *DBA* REQUEST WITH RECALL IS DETECTED,
*                THE CPU IS REQUESTED FOR THE TASK.
*
*         ENTRY  (A5) = ADDRESS OF DBA STATUS WORD
*                (X5) = DBA STATUS WORD
*
*T        6/  ,18/     EC,6/  ,6/  ,1/R,5/  SN,18/    AD
*
*         EC - ERROR CODE
*         R  - IF REQUEST WAS MADE WITH RECALL
*         SN - SUB CONTROL POINT OF REQUESTOR
*         AD - ADDRESS OF REQUEST PARAMETERS.  WHEN A *DMCC* IS ISSUED
*              FOR A *TAF* TASK THIS IS EITHER THE ADDRESS OF THE
*              TASK-S COMMUNICATION BLOCK OR ITS COMPLEMENT.  WHEN A
*              *DMCC* IS ISSUED FOR A BATCH TASK, THIS IS THE LOCATION
*              *BSAR*.  THESE CONVENTIONS ARE ASSUMED BY THE CODE AT
*              *PDMR2*.
 
 
 PDMR     PS
 
 
*         CHECK AAM OUTPUT QUEUE.
 
 PDMR0    TB5    0,VAAQ,LWA  FWA OF AAM OUTPUT QUEUE
          ZR     B5,PDMR1    IF AAM NOT LOADED
          SA1    B5+2        FWA OF INPUT FOR OUTPUT QUEUE
          SA2    A1+B1       OUT
          IX3    X1-X2
          ZR     X3,PDMR1    IF NO QUEUE ENTRY
          SB6    PDMRA       LOCATION TO RETURN RESULT
          SB4    B1+         WORD COUNT TO RETURN
          SX0    AAMC
          RJ     CIC         READ ONE OUTPUT QUEUE ENTRY
          SA1    PDMRA
          MX2    -6
          LX1    -24
          BX2    -X2*X1      FUNCTION CODE
          LX1    24
          SX3    X2-DMCC
          SB4    AAMDM
          SA5    AAMA        AAM STATUS WORD
 PDMR0.1  NZ     X3,PDMR6    IF NOT A REPLY TO A CEASE CODE
          EQ     PDMR2       UPDATE REQUEST COUNT
 
*         CHECK TOTAL DATA MANAGER OUTPUT QUEUE.
 
 PDMR1    SA1    TDO+2       CHECK TOTAL OUTPUT QUEUE
          SA2    A1+B1       OUT
          IX3    X1-X2
          ZR     X3,PDMR     IF NO QUEUE ENTRY
          SB5    TDO         FET FOR TOTAL OUTPUT QUEUE
          SB6    PDMRA       LOCATION TO RETURN ENTRY TO
          SB4    B1+         WORD COUNT TO RETURN
          SX0    TOTC
          RJ     CIC         READ ONE OUTPUT QUEUE ENTRY
          SA1    PDMRA       READ ENTRY
          MX2    -6
          LX1    -24
          BX2    -X2*X1      FUNCTION CODE
          LX1    24
          SX3    X2-DMCC
          SB4    TOTDM
          SA5    TDBAA       TOTAL STATUS WORD
 PDMR2    NZ     X3,PDMR6    IF NOT A REPLY TO CEASE CODE
          SX7    B1
          IX5    X5-X7       DECREMENT OUTSTANDING REQUEST COUNT
          LX7    18
          IX7    X5+X7       INCREASE COUNT OF TOTAL ALLOWABLE TASKS
          SA7    A5
          SX6    X1          COMMUNICATION BLOCK ADDRESS
          AX6    17          GET ABSOLUTE VALUE OF THE CB ADDRESS
          BX6    X1-X6
          BX3    X1
          LX3    -18
          MX2    -5
          BX3    -X2*X3      SUBCP NUMBER
          LX3    SCPAL
          TA4    X3-CPAL,VCPA  STATUS WORD 1 OF SUBCP
          SX4    X4-NUAPL
          SB6    A4          ADDRESS OF SUBCP AREA
          SX5    B0          CLEAR ERROR CODE
          SX2    X6-BSAR     CHECK FOR BATCH CONCURRENCY
          ZR     X2,PDMR6.1  IF BATCH CONCURRENCY TASK
          SA1    X6+CBCR
          SX4    B1
          BX2    X6          COMMUNICATION BLOCK ADDRESS
          LX4    B4
          MX6    -4
          LX6    18
          BX7    -X4*X1      CLEAR DATA MANAGER FLAG
          SA7    A1
          BX6    -X6*X7
          NZ     X6,PDMR0    IF DATA MANAGER REQUEST ACTIVE
 
*         WRITE A JOURNAL FILE ENTRY TO INDICATE TRANSACTION COMPLETE.
 
          SB3    PDMR5       RETURN ADDRESS
          SB4    4           END OF TRANSACTION INDICATOR
          SB5    PJRNL       JOURNAL FILE NUMBER
          SX5    JRNLA+3     DUMMY ADDRESS FOR JOURNAL FILE WRITE
          SX0    X2          C.B. ADDRESS
          BX7    X2
          SA7    PDMRB       C.B. ADDRESS
          EQ     JRNL        JOURNAL ENTRY
 
 PDMR5    SA2    PDMRB       C.B. ADDRESS
          RJ     RLC         RELEASE COMMUNICATION BLOCKS
          EQ     PDMR0       CHECK NEXT ENTRY
 
*         PROCESS DATA MANAGER OUTPUT QUEUE ENTRY.
 
 PDMR6    SA1    PDMRA       ENTRY JUST READ
          SX7    B1
          MX2    -5
          IX7    X5-X7       DECREMENT OUTSTANDING REQUEST COUNT
          SX3    B1
          SA7    A5
          LX1    -18
          BX2    -X2*X1      SUB CP NUMBER
          LX1    -5
          SB3    X0
          LX2    SCPAL
          BX0    X3*X1       RECALL BIT
          TA4    X2-CPAL,VCPA  STATUS WORD 1 OF SUB CP
          LX1    -13
          SX4    X4-NUAPL    START OF ALLOCATED CORE FOR SUB CP
          SB6    A4          ADDRESS OF SUB CP CONTROL POINT AREA
          SX5    X1          ERROR CODE
          SA1    X4+B3       DATA MANAGER OUTSTANDING REQUEST WORD
          LX2    59-46
          SX7    B1
          IX7    X1-X7       DECREMENT COUNT
          SA7    A1
          SA1    B6          STATUS WORD 1 OF SUBCP TABLE
          ERRNZ  SCBCW       IF BATCH FLAG NOT IN WORD ZERO
          LX1    59-SCBCS
          PL     X1,PDMR6.2  IF NOT IN USE BY BATCH CONCURRENCY
 
*         INDICATE COMPLETION OF BATCH *CRM* REQUEST.
 
 PDMR6.1  SA1    X4+BCTA     *BCT* FWA
          SA1    X1+BCSFW    COMPLETE BIT WORD IN *BCT*
          MX0    -1
          BX6    -X0+X1      SET REQUEST COMPLETE
          SA6    A1
          SX6    X5          ERROR CODE
          ZR     X5,PDMR0    IF NOT FATAL DATA MANAGER ERROR
          SA1    X4+DMEC     INDEX TO *TAF* STATUS WORD
          SB3    X1+BSTS+NUAPL
          SA6    X4+B3       SET ERROR CODE IN REQUEST
          EQ     PDMR0       PROCESS NEXT QUEUE ENTRY
 
 PDMR6.2  NZ     X5,PDMR8    IF FATAL DATA MANAGER ERROR
          NG     X2,PDMR7    IF RECALL ON ALL BIT IS SET
          ZR     X0,PDMR0    IF NO RECALL
          SB3    PDMR0       RETURN ADDRESS
          EQ     RCPU        REQUEST CPU FOR TASK
 
 PDMR7    SX1    X6          NUMBER OF REQUESTS LEFT OUTSTANDING
          NZ     X1,PDMR0    IF MORE REQUESTS LEFT TO RETURN
          SX2    B1
          LX2    46
          BX6    -X2*X6      CLEAR RECALL ALL BIT
          SB3    PDMR0       RETURN ADDRESS
          SA6    A2          RESET C.B. STATUS INFORMATION
          EQ     RCPU        REQUEST CPU FOR TASK
 
*         PROCESS FATAL D.M. ERROR
 
 PDMR8    SA2    B6+B1       C.B. STATUS WORD TWO
          SX3    B1
          MX1    1
          LX3    55-0        SET ABORT FLAG
          SX6    X5          ERROR CODE
          BX7    X2+X3
          BX6    X6+X1
          SA7    A2
          SA6    X4+DMEC     SAVE ERROR CODE
          SB3    PDMR0       RETURN ADDRESS
          EQ     RCPU        REQUEST CPU FOR TASK
 
 PDMRA    BSS    1
 PDMRB    BSS    1           C.B. ADDRESS
 RCPT     SPACE  4
**        RCPT   REQUEST CPU FOR A TASK
*
*         ENTRY  (X4) = START OF SUB CP AREA
*                (B6) = CONTROL POINT ADDRESS
*                (B3) = RETURN ADDRESS
*
*         USES   X - 0, 1, 2, 3, 6, 7
*                A - 1, 2, 3, 7
*                B - 4, 5
 
 
 RCPT     MX0    1
          TX6    B6+CPAL,-VCPA
          LX0    -12
          SA1    CR          CPU REQUEST SWITCHING WORD
          AX6    SCPAL
          SB5    X6          CONTROL POINT NUMBER OF REQUESTOR
          AX6    X0,B5
          BX7    X1+X6       ADD IN REQUEST BIT
          SA7    A1+
          ZR     B2,BNT      NO ONE HAS THE CPU
          SA2    B2+CB1C     COMPARE PRIORITIES WITH CURRENT JOB
          UX7,B4 X2
          SA3    X4+CB1C     PRIORITY OF REQUESTOR
          UX0,B5 X3
          GE     B5,B4,BNT   IF CURRENT JOB LOWER PRIORTY
          JP     B3          *EXIT
 RCPU     SPACE  4
**        RCPU   REQUEST CPU WITHOUT CHANGING CURRENT ASSIGNMENT
*                UNLESS NO TASK HAS THE CPU
*
*         ENTRY  (X4) = START OF SUB CP AREA
*                (B6) = CONTROL POINT ADDRESS
*                (B3) = RETURN ADDRESS
*
*         USES   X - 1, 6, 7
*                A - 1, 7
*                B - 5
 
 
 RCPU     MX7    1
          TX6    B6+CPAL,-VCPA
          LX7    -12
          SA1    CR          CPU REQUEST SWITCHING WORD
          AX6    SCPAL
          SB5    X6          CONTROL POINT NUMBER OF REQUESTOR
          AX6    X7,B5
          BX7    X1+X6       ADD IN REQUEST BIT
          SA7    A1+
          ZR     B2,BNT      NO ONE HAS THE CPU
          JP     B3          *RETURN
 BNT      SPACE  4
**        BNT    ASSIGN CPU TO A DIFFERENT SUB CONTROL POINT
*
*         ENTRY  (B6) = CONTROL POINT ADDRESS
*                (X4) = START OF SUB CP AREA
*                (B3) = EXIT ADDRESS
 
 
 BNT      SB2    X4
          SB7    B6          SET POINTERS
          SX6    B7+
          LX4    18
          BX6    X4+X6
          SA6    SREG        (B2) + (B7)
          JP     B3          *EXIT
 RDCB     SPACE  4
**        RDCB - TRANSFER TRANSACTION INPUT FROM THE
*                RECEIVING BUFFER TO A COMMUNICATION BLOCK.
*
*         ENTRY  (A4) = FWA OF INPUT BLOCK.
*                (X4) = 1/D,1/M,1/0,1/B,7/0,1/S,12/0,18/TERN,18/LENG
*                D = 1 IF INPUT IS A DATA MESSAGE , 0 FOR COMMAND.
*                M = 1 IF MORE BLOCKS.
*                B = 1 IF BATCH INPUT.
*                S = 1 IF SYSTEM ORIGIN.
*                TERN = TERMINAL NUMBER.
*                LENG = MESSAGE LENGTH IN WORDS + 1.
*
*         EXIT   (X0) = COMMUNICATION BLOCK ADDRESS.
*                (X0) = 0, IF NO COMMUNICATION BLOCK AVAILABLE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  FCB, FFCB, JOL, RSC, RTK, SCB.
 
 
 RDCB     SUBR               ENTRY/EXIT
          SX7    A4+
          SA7    RDCBC       FWA OF INPUT BUFFER
          SA2    ITIME       REAL TIME CLOCK
          MX0    1           MASK SYSTEM ORIGIN
          BX7    X2
          SA7    RDCBD       CLOCK AT LAST INPUT
          LX0    48-59
          BX0    X0*X4
          RJ     FFCB        GET A COMMUNICATIONS BLOCK
          LX4    -18
          ZR     X0,RDCBX    IF NO COMMUNICATION BLOCK
          SX1    X4
          SB3    X1+         SAVE TERMINAL NUMBER
          TX6    X4-1,-VNTST
          NG     X1,RDC17    IF NEGATIVE TERMINAL NUMBER
          PL     X6,RDC17    IF INCORRECT TERMINAL NUMBER
          SX7    TSTLLE      LENGTH OF A TST ENTRY
          IX1    X1*X7       BIAS OF TST ENTRY
          MX2    42
          TA5    X1+1,VTST   TERMINAL STATUS TABLE ENTRY
          SB4    B0
          LX5    59-17
          BX6    X4
          LX6    59+18-48
          NG     X6,RDC4     IF SYSTEM ORIGIN TRANSACTION
          ZR     B3,RDC17    IF TERN=0 AND NOT A SYSTEM-ORIGIN
          PL     X5,RDC4     IF FIRST BLOCK OF TRANSACTION DATA
          SB5    B0
          SX6    A5-B1
 
*         FIND LAST COMMUNICATION BLOCK IN CHAIN.
 
 RDC1     RJ     SCB         FIND A C.B. CONTAINING PREVIOUS DATA
          ZR     B5,RDC3     IF END OF RESERVED COMMUNICATION BLOCKS
          SA3    B5+CBMCW    WORD *CBMCW* OF COMMUNICATION BLOCK
          MX2    -CBMCN      GET BLOCK ORDINAL
          LX3    CBMCN-CBMCS-1
          BX2    -X2*X3      BLOCK COUNT OF COMMUNICATION BLOCK
          SX3    X2+B1       CHECK THE HIGHEST BLOCK COUNT
          SX7    B4          CURRENT BLOCK COUNT
          IX3    X7-X3
          SX7    X2-1        CHECK FOR THE FIRST BLOCK
          NZ     X7,RDC2     IF NOT FIRST C.B. OF LINKED CHAIN
          SX7    B5          FIRST COMMUNICATION BLOCK ADDRESS
          LX7    18
          BX0    X0+X7
 RDC2     PL     X3,RDC1     IF BLOCK COUNT NOT GREATER THAN PRIOR COUNT
          SB4    X2+1        NEW HIGHEST BLOCK COUNT
          EQ     RDC1        LOOP
 
 RDC3     SB3    B4-NCBC-1   INPUT LIMIT
          NG     B3,RDC3.2   IF WITHIN LIMIT
          BX3    X4
          LX3    59-58+18    LEFT JUSTIFY BLOCK FLAG
          NG     X3,RDC17    IF MORE INPUT
          BX2    X0
          AX2    18          (X2) = PRIMARY COMMUNICATION BLOCK ADDRESS
          RJ     RSC         RELEASE SECONDARY COMMUNICATION BLOCK
          SX2    X0+         (X2) = CURRENT COMMUNICATION BLOCK ADDRESS
          RJ     RLC         RELEASE COMMUNICATION BLOCK
 RDC3.1   BX6    X6-X6
          SX7    CIINL       INPUT TOO LARGE REASON CODE
          SA6    A4          FREE INPUT BUFFER FOR FURTHER TRANSFER
          AX0    18          (X0) = PRIMARY COMMUNICATION BLOCK ADDRESS
          SX2    B1
          SA3    X0+CMBHL+1  WORD TWO OF USER AREA
          MX4    48
          BX4    X4*X3       CLEAR WORD COUNT
          SA7    A3+B1       REASON CODE FOR *ITASK*
          BX4    X4+X2       UPDATE WORD COUNT
          LX2    CBSYS-CBSYN+1
          BX7    X4+X2       ADD SYSTEM ORIGIN FLAG
          SA6    A7+B1
          SA7    A3
          EQ     RDCB        RETURN
 
 RDC3.2   SA3    A3+CMBHL-3  WORD ONE OF USER AREA
          MX7    -24
          BX7    -X7*X3      SEQUENCE NUMBER OF TRANSACTION
 
*         CHECK FOR FIRST OR LAST INPUT BLOCK.
 
 RDC4     SX3    X4          TERMINAL ORDINAL
          MX6    1
          LX4    18+1
          BX1    X6*X4       LAST INPUT BLOCK FLAG
          BX5    -X6*X5
          LX4    -1
          BX5    X5+X1
          BX0    X0+X1       BYPASS SCHEDULER IF NOT LAST INPUT BLOCK
          LX5    17-59
          SX6    B1
          ZR     X1,RDC5     IF LAST INPUT BLOCK
          BX6    X5
          SA6    A5
          NZ     B4,RDC6     IF NOT FIRST OF A MULTI BLOCK INPUT
          SB4    B1
          EQ     RDC6        DO NOT BUMP TERMINAL TRANSACTION COUNT
 
*         FORMAT COMMUNICATIONS BLOCK.
 
 RDC5     IX6    X6+X5       INCREMENT TERMINAL TRANSACTION COUNT
          LX6    59-TSIWS
          NG     X6,RDC6     IF TERMINAL IN INPUT WANTED STATE
          LX6    59-59-59+TSIWS
          MX1    -TSTCN
          SA6    A5
          BX6    -X1*X6
          NZ     X6,RDC6     IF NOT FIELD OVERFLOW
          BX6    X1*X5       RESET TERMINAL TRANSACTION COUNT TO ZERO
          SA6    A5
 RDC6     SB6    X0          COMMUNICATION BLOCK ADDRESS
          RJ     FCB
          SA4    RDCBC
          SA4    X4          FWA OF INPUT BUFFER
          SX7    X4-1        WORDS TO MOVE TO COMMUNICATION BLOCK
          SA5    A4+
          SB6    X0+CMBHL+CMBRL
 
*         TRANSFER TERMINAL INPUT TO COMMUNICATION BLOCK.
 
          ZR     X7,RDC9     ZERO LENGTH MESSAGE
 RDC8     SA5    A5+B1       INPUT WORD
          SB6    B6+B1
          SX7    X7-1
          BX6    X5          MOVE WORD TO COMMUNICATION BLOCK
          SA6    B6-B1
          NZ     X7,RDC8     IF NOT END OF INPUT TRANSFER
 RDC9     SA7    A4+         FREE INPUT BUFFER FOR FURTHER TRANSFER
          BX1    X4
          LX1    59-48
          NG     X1,RDCBX    IF SYSTEM ORIGIN TRANSACTION
          SA2    X0+CBTAW    GET *TST* ADDRESS
          LX2    CBTAN-1-CBTAS
          SA5    X2+TSIWW
          ERRNZ  TSIWW-1     INPUT WANTED NOT IN WORD 2 OF *TST*
          LX5    59-TSIWS
          PL     X5,RDC14    IF NOT INPUT WANTED
          BX7    X0          COMMUNICATION BLOCK ADDRESS
          NG     X0,RDC14    IF NOT LAST INPUT BLOCK
 
*         REQUEST ROLLIN OF TASK WAITING FOR INPUT.
 
          SB5    X0+         FIRST COMMUNICATION BLOCK ADDRESS
          SA7    RDCBB
          SB4    X4+
          AX0    18
          NZ     X0,RDC10.1  IF MULTIPLE BLOCK INPUT
          SX0    B5          RESTORE FIRST BLOCK ADDRESS
          SB5    B0          SET SINGLE BLOCK INPUT FLAG
 RDC10.1  SB3    B1
          RJ     RTK         ROLL IN TASK WAITING FOR INPUT
          MX3    1
          SA4    RDCBB
          BX0    X3+X4       SET WAIT FOR INPUT PROCESSED FLAG
          SX4    B4+
 
*         JOURNAL THE TRANSACTION INPUT.
 
 RDC14    RJ     JOL         JOURNAL TRANSACTION
          LX1    -18
          SX1    X1
          ZR     X1,RDCBX    IF FIRST BLOCK OF INPUT
          MX2    -18
          BX0    X2*X0       CLEAR LAST BLOCK
          BX0    X0+X1       FIRST BLOCK OF INPUT
          EQ     RDCBX       RETURN
 
*         PROCESS ERROR CONDITIONS.
 
 RDC17    SA1    RDCBA       NUMBER OF TIMES INPUT THROWN AWAY
          BX6    X6-X6
          SX2    X0
          SX7    X1+B1       INCREMENT COUNT
          SA6    A4          FREE INPUT BLOCK FOR FURTHER TRANSFERS
          BX0    X0-X0
          SA7    A1
          RJ     RLC         RELEASE COMMUNICATION BLOCK
          EQ     RDCBX       RETURN
 
 RDCBA    BSSZ   1           NUMBER OF TIMES INPUT WAS THROWN AWAY
 RDCBB    BSS    1           COMMUNICATION BLOCK ADDRESS
 RDCBC    BSS    1           FWA OF INPUT BUFFER
 RDCBD    BSS    1           REAL TIME CLOCK AT LAST INPUT
 RDCBE    BSS    1           COMMUNICATION BLOCK ADDRESS
 RFQ      SPACE  4,25
**        RFQ - ROUTE FILE TO QUEUE.
*
*         *RFQ* SETS UP THE SECOND AND FIFTH WORDS OF THE *DSP*
*         PARAMETER BLOCK AND ISSUES THE *ROUTE* REQUEST WITHOUT
*         RECALL.  IT THEN CHECKS THE COMPLETE BIT AND PUTS THE TASK
*         IN RECALL UNTIL IT SETS.
*
*         ENTRY  (X1) = SECOND WORD OF DSP BLOCK (FC / DC / FLAGS).
*                (X3) = 42/STATUS PROC-R PARAMS, 18/STATUS PROC-R ADDR.
*                (X4) = ERROR MESSAGE WORD, FOR *SUBMT* OR *KTSDMP*.
*
*         EXIT   TO *TSSC* TO ENTER MAIN LOOP AFTER *ROUTE*.
*                TO EXIT ADDRESS IN OTHER CASES.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  COD, SNM, TRCL.
*
*         MACROS MESSAGE, RETURN, ROUTE.
 
 
 RFQ      BSS    0           ENTRY
          BX6    X1          COMPLETE THE *DSP* PARAMETER BLOCK
          SA6    TDSP+1
          SA1    SF          GET THE FILE NAME
          BX7    X3          SAVE THE STATUS PROCESSOR INFORMATION
          MX2    42
          SA7    B2+RCLA
          BX7    X4
          SA7    RFQA+3
          BX6    X2*X1       FILE NAME
          SA6    A6-B1
          ROUTE  A6          ROUTE THE FILE
 
 RFQ1     SA2    TDSP        CHECK FOR COMPLETION
          SX7    RFQ1        RECALL RETURN ADDRESS
          LX2    59-0
          PL     X2,TRCL2    IF ROUTE NOT COMPLETE
 
          BX7    X7-X7       CLEAR FILE NAME / INTERLOCK
          SA7    A2
          SA5    A1+B1       GET STATUS PROCESSOR INFORMATION
          ERRNZ  RCL+1-RCLA  CODE ASSUMES RELATIONSHIP
          SX6    DSQID       RESTORE ORIGINAL TID
          SA6    TDSP+2
          SA7    A6+B1       CLEAR PARAMETER WORDS 3 - 6
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          MX6    -6          GET ERROR CODE
          LX2    -12-59+0+60
          BX6    -X6*X2
          SB4    X5          STATUS PROCESSOR ADDRESS
          SB5    B2+NUAPL    TASK RA
          AX5    18          STATUS PROCESSOR PARAMETERS
          JP     B4          EXECUTE STATUS PROCESSOR
 
 RFQ2     BSS    0           *KTSDUMP* STATUS PROCESSOR
          ZR     X6,RFQ7     IF NO ERRORS
          EQ     RFQ5        REPORT ERROR
 
 RFQ3     BSS    0           *ROUTE* STATUS PROCESSOR
          SA6    B5+X5       RETURN STATUS TO CALLER
          EQ     TSSC        ENTER MAIN LOOP
 
 RFQ4     BSS    0           *SUBMIT* STATUS PROCESSOR
          ZR     X6,TSSC     IF NO ERROR
          SX1    X6-JBCE
          ZR     X1,RFQ6     IF JOB STATEMENT ERROR
          SX1    X6-USCE
          ZR     X1,RFQ6     IF INCORRECT USER STATEMENT
          AX5    18          ERROR EXIT ADDRESS
 
 RFQ5     BX1    X6
          SB6    B2          SAVE (B2)
          RJ     COD         CONVERT TO DISPLAY CODE
          MX1    -12
          BX1    -X1*X6
          LX1    59-11
          SB2    1RX         SEARCH CHARACTER
          SB3    DAYB        ASSEMBLY AREA
          SB5    -RFQA       MESSAGE FORMAT
          RJ     SNM         SET NAME IN MESSAGE
          SB2    B6          RESTORE (B2)
          MESSAGE  DAYB      INFORM OPERATOR ABOUT POSSIBLE PROBLEM
 RFQ6     RETURN SF,R
 RFQ7     SB4    X5
          JP     B4          EXIT TO ERROR EXIT ADDRESS
 
 
 RFQA     DATA   C* DSP ERROR XXB RETURNED ON TASK SUBMIT.*
 RLC      SPACE  4,10
**        RLC - RELEASE EXCESS COMMUNICATION BLOCKS.
*
*         ENTRY  (X2) = FWA OF FIRST COMMUNICATION BLOCK TO RELEASE.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 3, 5, 6.
*                B - 4.
 
 
 RLC      SUBR               ENTRY/EXIT
          SA5    X2+         LINK TO NEXT COMMUNICATION BLOCK
 RLC1     ZR     X2,RLCX     IF NO MORE COMMUNICATION BLOCKS
          SX3    47*CMBL
          TX6    X2,-VCBSA   RELATIVE C.B. ADDRESS
          NG     X6,RLCX     IF TRYING TO RELEASE A FAKE C.B.
          SB4    -1
          SA6    X2+1        CLEAR TST DATA FROM WORD ONE
 RLC2     IX6    X6-X3
          SB4    B4+B1
          PL     X6,RLC2     IF C.B. BIT IN THE NEXT WORD
          IX6    X6+X3
          SX1    CMBL
          PX6    X6          DIVIDE BY C.B. LENGTH TO GET BIT POSITION
          TA3    B4,VCBRT
          NX6    X6
          PX1    X1          C.B. LENGTH
          NX1    X1
          FX4    X6/X1
          UX4,B4 X4
          LX1    X4,B4       RESULT OF DIVISION
          SX6    B1
          BX1    -X1
          SB4    X1+47       SHIFT COUNT FOR BIT POSITION
          LX6    B4,X6
          BX6    X6+X3
          SA6    A3          RESET COMMUNICATION BLOCK BIT MAP
          BX6    X6-X6
          SA6    X2          CLEAR FIRST  WORD OF USER AREA
          MX6    1           INDICATE COMMUNICATION BLOCKS AVAILABLE
          SA6    EVCB
          SX2    X5
          SA5    X5          NEXT COMMUNICATION BLOCK TO RELEASE
          EQ     RLC1        CONTINUE TO RELEASE C.B.
 RSC      SPACE  4,10
**        RSC    RELEASE SECONDARY COMMUNICATION BLOCKS.
*
*         ENTRY  (X2) = ADDRESS OF PRIMARY COMMUNICATION BLOCK.
*
*         USES   X - 2, 6.
*                A - 2, 6.
*                B - 5.
*
*         EXIT   (X2) = ADDRESS OF PRIMARY COMMUNICATION BLOCK.
*
*         CALLS  RLC.
 
 
 RSC      SUBR
          SB5    X2          SAVE C.B. ADDRESS
          MX6    60-CBNCN    CLEAR NEXT C.B. LINK
          SA2    X2
          BX6    X6*X2
          SA6    A2
          SX2    X2          SECONDARY C.B. ADDRESS
          RJ     RLC         RELEASE COMMUNICATION BLOCKS
          SX2    B5+
          EQ     RSCX        RETURN
 RLR      SPACE  4,10
**        RLR - RELEASE A ROLLOUT TABLE ENTRY.
*
*         ENTRY  (X0) = ROLLOUT TABLE ADDRESS.
*                (B5) = SUB CONTROL POINT AREA OF TASK.
*
*         USES   X - 1, 3, 6.
*                A - 3, 6.
*                B - 4.
 
 
 RLR      SUBR               ENTRY/EXIT
          ZR     X0,RLRX     IF NO ROLLOUT TABLE ENTRY TO RELEASE
          SX3    47*TROLE
          SX6    X0-TROL
          SB4    -1
 RLR1     IX6    X6-X3
          SB4    B4+B1
          PL     X6,RLR1     IF ADVANCE BLOCK COUNT
          IX6    X6+X3
          SA3    B4+TROM     ROLLOUT TABLE MAP ALLOCATION
          SB4    B7
          SX1    TROLE       ROLLOUT TABLE ENTRY LENGTH
          IX1    X6/X1
          SB7    B4
          SX6    B1
          BX1    -X1
          SB4    X1+47       SHIFT COUNT FOR BIT POSITION
          LX6    B4,X6
          BX6    X6+X3
          SA6    A3          RELEASE ENTRY
          SA3    B5+CB2C     GET C.B. ADDRESS
          MX6    42
          SA3    X3+CBCR     GET ROLLOUT TABLE ADDRESS
          SX4    X3
          IX1    X0-X4
          NZ     X1,RLRX     IF NOT TO CLEAR ROLLOUT TABLE ADDRESS
          BX6    X6*X3       CLEAR ROLLOUT TABLE ADDRESS
          SA6    A3
          EQ     RLRX        *RETURN
 RLS      SPACE  4,15
**        RLS - RELEASE AN ENTRY IN A BIT RESERVATION MAP.
*
*         ENTRY  (A2) = ADDRESS OF BIT MAP.
*                (X0) = ADDRESS OF ENTRY TO RELEASE.
*                (X1) = LENGTH OF ENTRY.
*                (X2) = FIRST WORD OF BIT MAP.
*                (X3) = FWA OF TABLE.
*                (B6) = NUMBER OF RESERVATION BITS PER WORD.
*
*         USES   A - 2, 6.
*                X - 0, 2, 3, 6.
*                B - 3, 6.
 
 
 RLS      SUBR               ENTRY/EXIT
          IX3    X0-X3
          SB3    B7
          IX3    X3/X1       ENTRY ORDINAL
          SB7    B3
          SB3    -1
          SX0    B6
 RLS1     SB3    B3+B1       COMPUTE RESERVATION WORD INDEX
          IX3    X3-X0
          PL     X3,RLS1     IF ADVANCE WORD COUNT
          SA2    A2+B3       RESERVATION WORD
          IX3    X3+X0       BIT INDEX
          SX6    B1
          BX3    -X3
          SB3    B6+X3
          LX6    B3,X6
          BX6    X6+X2
          SA6    A2          RELEASE ENTRY
          EQ     RLSX        RETURN
 ROLL     SPACE  4,10
**        ROLL   SET TASK ELIGIBLE FOR ROLLOUT.
*
*         ENTRY  (X1) = ROLLOUT PARAMETERS.
*                (X5) = TIME TO LEAVE TASK IN CORE BEFORE ROLLOUT.
*
*T  (X1)  36/  ROLLOUT EVENT ID,12/    ,12/   PRIORITY BIAS
 
 
 ROLL     SX7    ROL1
          RJ     FFR         RESERVE A ROLLOUT TABLE ENTRY
          NZ     X0,ROL2     IF ROLLOUT TABLE ENTRY RESERVED
          LX5    18
          BX7    X7+X5
          SA7    B2+RCL
          BX6    X1          ROLLOUT REQUEST TYPE
          SA6    A7+B1
          SX7    0
          SA7    B2+ROSC
          JP     TRCL        ROLLOUT TABLE FULL - PUT TASK ON RECALL
 ROL1     SA4    B2+ROSC
          AX1    18
          BX5    X1
          SA1    A1+1        RESET ROLLOUT REQUEST TYPE
          NG     X4,TSSC     IF ROLLOUT INTERUPTED
          JP     ROLL        TRY AGAIN
 
*         ENTRY POINT IF ROLLOUT TABLE ENTRY PRERESERVED.
*         (X0) = ROLLOUT TABLE ENTRY ADDRESS.
 
 ROL2     SX6    B0+         CLEAR ROLL EVENT
 
*         ENTRY POINT FOR EVENTS.
*         (X6) = EVENT.
 
 ROL3     TX4    B7+CPAL,-VCPA  GET SUBCP NUMBER
          SX7    X0
          LX4    36-SCPAL
          BX6    X4+X6       ADD SUBCP NUMBER
          SA6    X0+RTWEV    UPDATE SECOND WORD OF ROLLOUT TABLE
          SX4    B1
          SA2    B2+CB2C     GET COMMUNICATION BLOCK ADDRESS
          SA3    X2+CBCR
          BX6    X3
          SA6    B2+WICB+3
          SA2    ROLB        ADD SUBCP NUMBER AND ROLLOUT TABLE ADDRESS
          BX6    X2*X6
          TX3    B7+CPAL,-VCPA  CALCULATE SUBCP NUMBER
          LX3    48-SCPAL
          BX6    X6+X0
          BX6    X3+X6
          SA6    A3+         UPDATE *CBCR* WORD
          SA2    B7+B1       CHECK *CM* RESIDENT TASK
          LX2    59-SCCRS
          PL     X2,ROL3.1   IF NOT CM RESIDENT TASK
          MX7    1           ASSUME ROLLOUT COMPLETE
          SX6    B7
          LX6    18
          BX7    X6+X7
          SA7    X0
          RJ     DCPT        DROP SUBCP
          EQ     TSSC        TIME SLICE SUBCP
 
 ROL3.1   SA2    STAT14      NUMBER OF TASK ROLLOUT STARTS
          IX6    X2+X4
          SA6    A2
          MX6    42
          SA7    B2+ROSC     ROLLOUT TABLE ENTRY ADDRESS
          MX3    -12
          BX7    X6*X1       ROLLOUT EVENT ID
          BX6    -X3*X1      PRIORITY BIAS
          SA7    X0
          LX6    30
          SA6    X0+B1
 
*         WAIT FOR DELAY TIME TO EXPIRE BEFORE CONTINUING ROLLOUT.
 
          ZR     X5,ROL5     IF NO DELAY TIME
          SX6    ROL4
          SA2    LTIME       LATEST REAL TIME CLOCK READING
          MX7    -36
          SA6    B2+RCL
          BX2    -X7*X2
          IX7    X5+X2       SET TIME TO RESUME ROLLOUT PROCESSING
          SA7    A6+B1
          JP     TRCL        WAIT FOR DELAY TIME TO EXPIRE
 ROL4     SA4    B2+ROSC
          SA3    LTIME       REAL TIME CLOCK
          NG     X4,ROL15    IF ROLLOUT WAS INTERUPTED
          SA2    A1+B1
          MX7    -36
          BX3    -X7*X3
          IX3    X2-X3
          PL     X3,TRCL     IF TIME NOT YET ELASPED
 
*         INTERLOCK ROLLOUT FILE.
 
 ROL5     SA1    RO+5
          ZR     X1,ROL6     IF FILE NOT RESERVED
          SX7    ROL5
          SA4    B2+ROSC
          NG     X4,ROL15    IF ROLLOUT TO BE TERMINATED
          JP     TRCL2       PLACE TASK ON RECALL
 
*         RESERVE ROLLOUT FILE SPACE FOR SUB CP.
 
 ROL6     SX3    A1-5        FET ADDRESS OF ROLLOUT FILE
          SA4    B2+ROSC
          NG     X4,ROL15    IF ROLLOUT WAS INTERUPTED
          SX0    X4          RESTORE ROLLOUT TABLE ENTRY ADDRESS
          SA4    X4          ROLLOUT TABLE ENTRY
          SX7    B7
          SA7    A1          SET ROLLOUT FILE INTERLOCK
          SA0    A4
          BX6    X4+X3
          SA6    A4
          SX5    ROLBL       ROLLOUT BLOCK LENGTH
          SA3    B7
          SB5    X6          ROLLOUT FILE FET ADDRESS
          LX3    -18
          MX7    -48         GET ROLLOUT FL
          SA4    X0+RTWEV    CHECK IF MEMORY REQUEST ROLLOUT
          LX7    -12
          BX4    -X7*X4
          SA2    MEMC
          IX7    X2-X4
          NZ     X7,ROL6.1   IF NOT MEMORY REQUEST ROLLOUT
          UX3,B3 X4
 ROL6.1   MX4    1
          SX2    X3+NUAPL    TOTAL FIELD LENGTH TO ROLL
          SB6    B7
          IX7    X2/X5
          SB7    B6
          BX6    X6-X6
          SB3    60
          SB6    X7+         NUMBER OF ROLLOUT BLOCKS NEEDED
          SB3    B3-B6
          AX2    X4,B6
          SB4    RLATL
          TA1    0,VRLAT     FIRST WORD OF ROLLOUT FILE ALLOCATION MAP
 ROL7     BX3    X2*X1
          ZR     X3,ROL9     IF HOLE OR END OF FILE
          LX1    1
          SB3    B3-B1
          NZ     B3,ROL7     IF NOT END OF SEARCH
          SB4    B4-B1
          ZR     B4,ROL8     IF FILE FULL
          SB3    60
          SA1    A1+B1       NEXT ALLOCATION WORD
          SB3    B3-B6
          EQ     ROL7        CONTINUE SEARCH
 
 ROL8     SX7    ROL5
          SA7    B2+RCL
          SA2    A0          ROLLOUT TABLE ENTRY
          MX3    42
          SA6    X2+5        CLEAR INTERLOCK ON ROLLOUT FILE
          BX7    X3*X2
          SA7    A2          CLEAR FET POINTER
          JP     TRCL        ROLLOUT FILE FULL - PLACE TASK ON RECALL
 
 ROL9     SB4    60
          BX7    X2+X1       SET RESERVATION BITS
          SB3    B3+B6
          LX6    X2,B3       SAVE A COPY OF RESERVATION BITS
          SA6    B2+RRSC
          LX7    X7,B3       JUSTIFY RESERVATION WORD
          SX2    B4+
          SA7    A1
          SX6    A1
          TX3    A1,-VRLAT   NTH WORD IN TABLE
          SA6    B2+RRSC+1
          SB4    B4-B3
          IX3    X3*X2
          SX4    NPRBL
          SX3    X3+B4       ADD BIT POSITION IN WORD
          IX7    X4*X3       DISK ADDRESS OF START OF ROLLOUT BLOCK
 
*         COMPUTE SCHEDULING PRIORITY.
 
          SA1    B7+2
          MX3    -12
          SA4    A0+B1       GET PRIORITY BIAS VALUE
          LX1    12
          BX2    -X3*X1
          LX4    -30
          TA2    X2,VTLD     GET ORIGINAL TASK PRIORITY
          BX1    -X3*X2
          SA7    B5+6        SET DISK ADDRESS INTO FET
          BX2    -X3*X4
          IX1    X2+X1       SET SCHEDULING PRIORITY
          BX3    -X3*X1      IN CASE OF OVERFLOW
          SA1    B7
          LX3    30
          LX1    -18
          SX5    X1+         FL OF TASK
          BX6    X7+X3
          LX5    42
          BX6    X6+X5       FL / PRIORITY / DISK ADDRESS
          SA6    A0+1
          SA2    A7+B1       COMPARE WRITE ADDRESS TO CURRENT EOI
          IX3    X2-X7
          PL     X3,ROL11    IF ADDRESS NOT BEYOND EOI
 
*         EXTEND FILE TO DESIRED WRITE ADDRESS.
 
          BX3    -X3
          SX1    64
          BX6    X2
          IX2    X1*X3       NUMBER OF WORDS TO ENTEND FILE
          SA1    B5+B1
          MX3    42
          SA6    B5+6        CURRENT EOI ADDRESS
          BX3    X3*X1
          SX4    100B        USE START OF TRANEX FOR FIRST
          IX7    X4+X2
          SA7    B5+4        LIMIT
          BX6    X3+X4
          SA6    A1          FIRST
          SX7    X7-1
          SA7    A6+B1       IN = LIMIT -1
          SX6    X6
          SA6    A7+B1       OUT = IN
          SX5    ROL10       RETURN ADDRESS
          REWRITER B5        EXTEND FILE
          LX2    18
          BX7    X5+X2       ADD FET ADDRESS
          JP     TRCL2       WAIT FOR WRITE TO COMPLETE
 ROL10    LX1    -18
          SA2    X1          ROLLOUT FILE FET
          SB5    X1
          LX2    59
          PL     X2,TRCL     IF FILE BUSY
          SA4    B2+ROSC
          PL     X4,ROL11    IF ROLLOUT NOT INTERUPTED
          SX7    B0+
          SA7    B5+5        CLEAR INTERLOCK
          JP     ROL15       CLEAN UP ROLLOUT
 
*         SET UP FET FOR ROLLOUT.
 
 ROL11    SA1    B7
          MX4    42
          SX5    X1-NUAPL-1  START OF AREA TO ROLL - 1
          SA2    B5+B1       FIRST
          LX1    -18
          SX6    X5+B1
          BX2    X4*X2
          SX1    X1+NUAPL    LENGTH OF AREA TO ROLL
          SA6    B5+3        OUT
          SA3    A6+B1
          BX7    X2+X5
          IX1    X6+X1
          SA7    A2          FIRST
          BX4    X4*X3
          BX7    X4+X1
          SA7    A3          LIMIT
          SX7    X5
          SA7    A6-B1       IN
 
*         SAVE SUB CONTROL POINT TABLE INFORMATION IN ROLLOUT BLOCK.
 
          SA1    B7+B1
          SA3    A1+B1
          MX6    12
          SX4    B7
          IX7    X1-X4       UNBIAS ABSOLUTE STATUS WORD POINTER
          SA7    B2+RSCC
          BX6    X6*X3       TASK INDEX
          SA6    A7+B1
          SX1    CPACL       SAVE SUB CP ACTIVE TASK STATUS WORDS
          SX2    A3+B1
          SA4    B7
          MX7    1           SET STORAGE MOVE LOCK OUT
          SX3    A6+B1
          BX7    X7+X4
          SA7    A4
          RJ     MVE=        TRANSFER STATUS WORDS
          REWRITER B5+       INITIATE WRITE
          LX2    18
          SX7    ROL12
          BX7    X7+X2
          JP     TRCL2       WAIT FOR WRITE TO COMPLETE
 ROL12    LX1    -18
          SA2    X1          ROLLOUT FILE FET
          BX6    X6-X6
          LX2    59
          PL     X2,TRCL     IF FILE BUSY
          SA3    A2+6
          SA1    A3+B1       COMPARE CURRENT POSITION TO EOI
          AX3    30
          IX2    X1-X3
          SA1    B7
          PL     X2,ROL13    IF WRITE DID NOT EXTEND EOI
          BX7    X3
          SA7    A3+B1       SET NEW EOI
 
*         RELEASE SUB CONTROL POINT AND FIELD LENGTH.
 
 ROL13    MX3    1
          SA4    B2+ROSC
          BX7    -X3*X1      CLEAR STORAGE MOVE INTERLOCK
          SA6    A2+5        RELEASE INTERLOCK ON ROLLOUT FILE
          SA7    A1
          SA2    X4
          NG     X4,ROL15    IF ROLLOUT WAS INTERUPTED
          BX7    X3+X2
          SA7    A2          SET ROLLOUT COMPLETE
          LX1    -18
          SB6    B7
          SX1    X1+NUAPL    AMOUNT OF CORE BEING RELEASED
          SA2    AVAILCM
          IX7    X1+X2
          SA7    A2          UPDATE AVAILABLE CORE COUNT
          SB4    CPACL-1
          SA6    B7+CPAHL
 ROL14    SA6    A6+B1
          SB4    B4-B1
          NZ     B4,ROL14    IF ANOTHER STATUS WORD TO CLEAR
          SA4    STAT13      NUMBER OF TASK ROLLOUT COMPLETES
          SX6    B1
          IX6    X4+X6
          SA6    A4
          EQ     ESCP1       RELEASE SUBCONTROL POINT
 
*         RELEASE ROLLOUT FILE SPACE AND TABLE ENTRY.
 
 ROL15    SB3    TSSC        RESUME PROCESSING AFTER CLEAN UP
          SB5    B2
          SA3    X4
          SB6    B7
          LX3    59-RTBDM
          PL     X3,ROL16    IF NOT DATA MANAGER ROLL
          SB3    ROL31       EXIT ADDRESS
 
*         ROLLIN PROCESSING.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (B5) = SUB CONTROL POINT AREA.
*                (B6) = SUB CONTROL POINT ADDRESS.
*                (X4) = ADDRESS OF ROLLOUT TABLE ENTRY.
*         EXIT   (X6) = FIRST WORD OF ROLLOUT TABLE ENTRY.
 
 ROL16    SA1    X4
          BX6    X1
          SA2    X4+2        WORD 2 OF ROLLOUT TABLE
          LX2    59-RTABS
          PL     X2,ROL16.1  IF NOT TO ABORT TASK
          MX3    SCCDN       SET CDCS ABORTED FLAG
          SA2    B6+B1       GET WORD 2 OF SUBCP TABLE
          LX3    SCCDS-59
          BX7    X2+X3
          SA7    A2
 ROL16.1  SX0    X4
          SX2    X1          ROLLOUT FILE FET ADDRESS
          SA6    ROLA        SAVE FIRST WORD OF ROLLOUT TABLE ENTRY
          ZR     X2,ROL17    IF NO FILE SPACE ASSIGNED
          SA3    B5+RRSC+1
          SA4    X3          ROLLOUT FILE RESERVATION WORD
          SA2    A3-B1
          BX6    -X2*X4      RELEASE ROLLOUT FILE RESERVATION SPACE
          SA6    A4
 ROL17    SA4    B6+B1       RESTORE C.B. HEADER WORDS
          LX1    59-55
          SA4    X4
          SA0    B6
          SA5    B5+WICB+3   RESTORE PREVIOUS ROLLOUT TABLE ADDRESS
          SA2    X4+CBCR
          SA3    ROLC        MASK ABORT AND *DT* FLAGS
          BX7    X3*X2
          BX7    X5+X7
          SA7    A2          UPDATE *CBCR* WORD
          MX6    -6
          NG     X1,ROL20    IF NO RESTORE OF C.B. AFTER ROLLIN
          SA1    X0+RTWEV    GET ROLLOUT EVENT
          LX1    12
          BX6    -X6*X1
          SX1    X6-EVWI
          NZ     X1,ROL17.1  IF NOT *WAITINP* ROLL
          SA2    B5+WICB     RESTORE W3 - W5 OF C.B. SYSTEM HEADER
          BX6    X2
          SA6    X4+CBTLW
          SA2    A2+B1
          SA1    X4+3        NEW MC FIELD
          LX7    56-8
          BX7    X7*X2       CLEAR OLD MC FIELD
          BX7    X1+X7
          SA2    A2+B1
          SA7    A1
          BX6    X2
          SA6    A7+1
 
*         MOVE COMMUNICATION BLOCK TO TASK AFTER FIRST DETERMINING
*         IF A *WAITINP* TO A USER-DECLARED BUFFER IS ACTIVE.
 
 ROL17.1  MX7    42
          SA1    B5+LRA1     READ LAST SYSTEM REQUEST
          SA2    SCTA        READ BUFFER-*WAITINP* REQUEST
          BX6    X7*X1
          BX6    X2-X6
          SX3    B5+NUAPL+SUAC
          NZ     X6,ROL18    IF NOT BUFFER-*WAITINP* REQUEST
          SX3    B5+NUAPL
          SX1    X1
          IX3    X3+X1       (X3) = FWA OF USER-DECLARED BUFFER
 ROL18    ZR     X6,ROL19    IF BUFFER-*WAITINP*
          SA2    B6
          LX2    59-57
          NG     X2,ROL20    IF SOLICITED COMMUNICATION BLOCK TASK
 ROL19    SA1    X4          RESTORE TASK-S CB1C
          SA2    X4+B1
          BX6    X1
          BX7    X2
          SX1    CMBL-CMBHL
          SX2    X4+CMBHL
          SA6    B5+CB1C
          SA7    B5+CB2C
          SA4    X2-CMBHL+CBITW
          LX4    59-CBITS
          MX6    -59
          PL     X4,ROL19.2  IF NOT INITIAL TRANSFER TO C.B.
          BX6    -X6*X4      CLEAR INITIAL TRANSFER BIT
          LX6    CBITS-59
          SA6    A4
          MX7    -CBWCN
          SA4    X2-CMBHL+CBWCW  GET COUNT OF WORDS TO MOVE
          BX1    -X7*X4
          SX4    B4          SAVE (B4)
          SB6    B5+NUAPL+SUAC+CMBL-CMBHL-CBTL-1
          SX6    B2+         SAVE (B2)
          SB4    X1-CBDL-CBUL
          SB2    -B4         CLEAR REST OF USER AREA IN C.B
          BX7    X7-X7
          SA7    B6+
 ROL19.0  SB2    B2-B1
          SA7    A7-B1
          NZ     B2,ROL19.0  IF NOT END OF USER AREA
          SB4    X4          RESTORE (B4)
          SB2    X6          RESOTRE (B2)
          NZ     X1,ROL19.1  IF TERMINAL INPUT
          SA4    X2+CMBRL    STATUS WORD OF C.B.
          SX1    B1
          IX4    X1-X4
          ZR     X4,ROL19.1  IF TERMINAL *WAITINP* TIMED OUT
          SX1    B0+
 ROL19.1  SX1    X1+CMBRL
 ROL19.2  RJ     MVE=        MOVE C.B. INTO TASK FL
 ROL20    LX5    12
          SB6    A0          RESTORE B6
          PL     X5,ROL21    IF CALLRTN TASK DID NOT ABORT
          SA2    B6+B1
          SX3    B1
          LX3    55
          BX7    X2+X3       SET ABORT FLAG
          SA7    A2+
 ROL21    MX6    -CBNLN
          SA4    X0+RTWEV    CHECK ROLLOUT EVENT
          LX4    12
          BX4    -X6*X4
          SX4    X4-EVCR
          NZ     X4,ROL23    IF NOT *CALLRTN* ROLL
          SA4    B5+CB2C     GET C.B. ADDRESS
          SA5    X4+CBCR     DECREMENT NEST LEVEL
          LX5    CBNLN-1-CBNLS
          BX3    -X6*X5
          SX3    X3-1
          BX6    X6*X5
          BX7    X6+X3
          LX7    CBNLS-CBNLN+1
          SA7    A5
          NZ     X3,ROL23    IF NOT INITIAL TASK IN *CALLRTN* CHAIN
          SA1    B5+RTSC     RESTORE TASK CHAIN
          BX6    X1
          MX2    60-CBRFN
          SA6    X4+CBTLW
          LX2    CBRFS-0
          BX7    X2*X7
          SA7    A5+
 ROL23    SX2    B4+
          RJ     RLR         RELEASE ROLLOUT TABLE ENTRY
          SB4    X2          RESTORE B4
          SA1    ROLA        FIRST WORD OF ROLLOUT TABLE ENTRY
          BX6    X1
          JP     B3          RETURN
 
 ROL31    RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 ROLA     BSS    1           FIRST WORD OF ROLLOUT TABLE ENTRY
 ROLB     VFD    6/77B,6/0,30/7777777777B,18/0  *CBCR* MASK WORD
 ROLC     VFD    6/0,6/0,1/1,25/0,4/17B,18/0  *CBCR* MASK WORD
 RSV      SPACE  4,15
**        RSV - RESERVE AN ENTRY IN A BIT RESERVATION MAP.
*
*         ENTRY  (A2) = ADDRESS OF BIT MAP.
*                (X2) = FIRST WORD OF BIT MAP.
*                (B6) = NUMBER OF RESERVATION BITS PER WORD.
*
*         EXIT   (A2) = ADDRESS OF WORD IN MAP CONTAINING THE BIT SET.
*                (X0) = 0 IF NO ENTRY AVAILABLE.
*                (B3) = ORDINAL OF RESERVED ENTRY.
*
*         USES   A - 2, 6.
*                X - 0, 2, 3, 6.
*                B - 3, 6.
 
 
 RSV      SUBR               ENTRY/EXIT
 
*         LOCATE A FREE ENTRY.
 
          SX3    B6+
 RSV1     NX0,B3 X2
          ZR     X0,RSVX     IF NO ENTRIES AVAILABLE
          SB6    B6-B3
          NZ     B6,RSV2     IF ENTRY AVAILABLE
          SA2    A2+1
          SB6    X3+         RESTORE ENTRIES PER WORD
          EQ     RSV1        TRY NEXT WORD
 
*         RESERVE ENTRY.
 
 RSV2     SX3    1
          LX3    X3,B6       POSITION TO LOCATED ENTRY
          BX6    -X3*X2      RESERVE ENTRY
          SA6    A2+
          EQ     RSVX        RETURN
 RTK      SPACE  4,10
**        RTK - ROLLIN TASK WAITING FOR INPUT.
*
*         ENTRY  (X0) = FWA OF COMMUNICATION BLOCK.
*                (A5) = SECOND WORD OF TST ENTRY.
*                (B3) .EQ. 0 IF SEARCH SEQUENCE NUMBER ONLY.
*                     .NE. 0 ROLL IN TASK WAITING FOR INPUT.
*         EXIT   (X6) = SEQUENCE NUMBER IF (B3) .EQ. 0.
*
*         USES   A - 1, 2, 3, 5, 6, 7.
*                B - 5.
*                X - 1, 2, 3, 5, 6, 7.
*
*         CALLS  EXIT, MSQ, SRO.
 
 
 RTK6     MX7    60-TSIWN
          SA1    A5+
          ERRNZ  TSIWW-1     IF INPUT WANTED NOT IN WORD 1
          LX7    TSIWS-TSIWN+1
          BX7    X7*X1       CLEAR WANT INPUT FLAG
          SA7    A1+
 
 RTK      SUBR               ENTRY/EXIT
          SB5    B0          INITIAL CALL FOR ROUTINE *SRO*
          MX6    12
          SX7    B3+
          SA2    X0+B1       SECOND WORD OF COMMUNICATION BLOCK
          LX6    -30
          SA7    RTKB
          LX2    -24
          BX5    X6*X2       GET TERMINAL ORDINAL
 RTK1     RJ     SRO         SEARCH ROLLOUT TABLE
          NZ     B5,RTK4     IF ROLLOUT ENTRY FOUND
          SA3    RTKA        *WAITINP* REQUEST
          TX1    B0,VCPA     FWA OF SUBCONTROL POINT TABLE
          MX7    42
          BX6    X3
 RTK2     SA2    X1          TASK RA
          SA3    X2-NUAPL+LRA1  RA REQUEST
          BX1    X7*X3
          SA3    X2-NUAPL+RCLA  TERMINAL ORDINAL
          BX2    X1-X6
          BX3    X5-X3
          NZ     X2,RTK3     IF NOT *WAITINP*
*
          NZ     X3,RTK3     IF NOT FOR SAME TERMINAL
          SA3    A2+B1       WORD 2 OF SUBCONTROL POINT TABLE
          MX5    1           COMMUNICATION BLOCK AT SUBCONTROL POINT
          BX6    X5+X0
          SA6    A2+CPAHL
          BX7    X7*X3       CLEAR OLD FWA OF COMMUNICATION BLOCK
          SA7    A3
          SX6    TSSC        RECALL ADDRESS
          SA6    X2-NUAPL+RCL
          SA3    X2+CB1C     GET SEQUENCE NUMBER
          MX7    -CBTSN
          LX3    CBTSN-CBTSS-1
          BX7    -X7*X3
          EQ     RTKX        RETURN
 
 RTK3     SA3    A2+2        FWA OF NEXT SUBCONTROL POINT
          SX1    X3+
          NZ     X1,RTK2     IF MORE SUBCONTROL POINTS
          RJ     EXIT        ROLLOUT TABLE ENTRY LOST
 RTK4     SA2    B5
          LX2    59-58
          PL     X2,RTK1     IF NOT WAIT FOR INPUT ROLLOUT ENTRY
          LX2    58-59
          BX3    X6*X2
          BX3    X3-X5
          NZ     X3,RTK1     IF NO MATCH ON TERMINAL ORDINAL
          SA3    B5+RTWEV    GET SEQUENCE NUMBER
          MX5    -RTTSN
          LX3    RTTSN-RTTSS-1
          BX6    -X5*X3      SEQUENCE NUMBER
          SX5    B5
          SA3    RTKB
          ZR     X3,RTKX     IF SEARCH FOR SEQUENCE NUMBER ONLY
          NG     X2,RTK5     IF ROLLOUT COMPLETED
          SA2    B5+2        WORD 2 OF ROLLOUT TABLE ENTRY
          MX1    -6
          LX2    -36         RIGHT JUSTIFY SUBCP NUMBER
          BX1    -X1*X2      SUBCP NUMBER
          LX1    SCPAL
          TA2    X1-CPAL,VCPA  SUB CONTROL POINT ADDRESS
          MX7    42
          SA3    A2+B1       WORD 2 OF SUB CONTROL POINT TABLE ENTRY
          MX5    1
          BX6    X5+X0       SET C.B. IS PRESENT AT SUB CONTROL POINT
          BX7    X7*X3       MASK TERMINAL NAME
          SA6    A2+CPAHL
          SA2    X2-NUAPL+ROSC
          SX1    A6
          BX7    X7+X1       COMMUNICATION BLOCK STATUS
          BX6    X5+X2       SET INTERRUPT ROLLOUT FLAG
          SA7    A3
          SA6    A2
          EQ     RTK6        CLEAR WAIT INPUT FLAG
 
 RTK5     SA2    X5          ROLLOUT ENTRY
          MX7    2           CLEAR WAIT INPUT AND TIMED FLAG
          LX7    58-59
          BX7    -X7*X2
          SA7    A2
          RJ     MSQ         REQUEST ROLLIN OF TASK TO PROCESS INPUT
          EQ     RTK6        CLEAR WAIT INPUT FLAG
 
RTKA      VFD    24/4LSCTP,18/5,18/0
 RTKB     BSSZ   1           (B3)
 RTS      SPACE  4,15
**        RTS - RETURN *TAF* STORAGE.
*
*         RETURN A BLOCK OF STORAGE BY SETTING A BIT IN THE
*         RESERVATION WORD.
*
*         ENTRY  (B3) = FWA OF STORAGE.
*
*         USES   A - 2.
*                X - 0, 1, 2, 3.
*                B - 6.
*
*         CALLS  RLS.
 
 
 RTS      SUBR               ENTRY/EXIT
          SB6    47          NUMBER OF RESERVATION BITS PER WORD
          SX0    B3          ADDRESS OF ENTRY TO RETURN
          SX3    TSB         FWA OF TABLE
          SA2    TSBM        ADDRESS OF BIT MAP
          SX1    TSBLE       LENGTH OF STORAGE ENTRY
          RJ     RLS         RELEASE AN ENTRY
          EQ     RTSX        RETURN
 SCB      SPACE  4,10
**        SCB    SEARCH COMMUNICATION BLOCKS.
*
*         ENTRY  (B5) = 0 IF INITIAL CALL.
*                A1/X1/B3/B6 = LAST EXIT VALUES IF NOT INITIAL CALL.
*                (X6) = TERMINAL STATUS TABLE ADDRESS COMPARATOR.
*                (X6) = 0 IF NO TST COMPARISONS TO BE MADE.
*
*         USES   A - 1, 2.
*                B - 3, 5, 6.
*                X - 1, 2, 3.
*
*         EXIT   (B5) = ADDRESS OF RESERVED COMMUNICATION BLOCK.
*                (B5) = 0 IF NO MORE RESERVED ENTRIES.
*                (B6) = CURRENT SEARCH POINTER.
*                (B3) = WORD OVERFLOW COUNTER.
*                (A1/X1) = CURRENT C.B. ALLOCATION WORD BEING SEARCHED.
 
 
 SCB      SUBR
          MX3    1
          NZ     B5,SCB1     IF NOT INITIAL CALL
          SB3    B0
          TA1    0,VCBRT
          SB6    B1
          BX1    X3+X1       SEARCHING FOR ZERO BITS
 SCB1     NX1,B5 X1
          SB6    B6+B5       ADVANCE POSITION
          TB5    B6-1,-VNCMB
          NZ     X1,SCB2     IF NOT AT END OF WORD
          SA1    A1+B1
          MX3    1
          SB3    B3+47
          SB6    B3          CURRENT POSITION
          BX1    X3+X1
          EQ     SCB1        CONTINUE WITH NEXT WORD
 
 SCB2     ZR     B5,SCBX     IF END OF SEARCH
          SX3    1
          SX2    CMBL        LENGTH OF A C.B.
          LX3    47
          BX1    X1+X3       SET RESERVED BIT SO WE DONT FIND IT AGAIN
          SX3    B6
          IX2    X2*X3
          TB5    X2-CMBL,VCBSA  ADDRESS OF COMMUNICATION BLOCK
          ZR     X6,SCBX     IF NO TST ADDRESS GIVEN
          SA2    B5+B1
          LX2    -18
          SX2    X2          TST ADDRESS FROM COMMUNICATION BLOCK
          BX2    X2-X6
          ZR     X2,SCBX     IF MATCH ON TERMINAL STATUS TABLE ADDRESS
          EQ     SCB1        CHECK NEXT COMMUNICATION BLOCK
 SLB      SPACE  4,15
**        SLB - SEND LAST MESSAGE BLOCK.
*
*         ENTRY  (X7) = RETURN ADDRESS.
*                (B2) = FWA OF TASK SYSTEM AREA.
*
*         EXIT   TO *SND*.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 3, 5, 6.
*
*         CALLS  SND.
 
 
 SLB      SUBR               ENTRY
          SA7    B2+SCRC+1   SAVE RETURN ADDRESS
          SA1    SLBA        GET *SEND* BLOCK HEADER
          BX6    X1
          SA6    B2+NUAPL+SUAC+CBCH
          SB5    B2+NUAPL    TASK RA
          SB6    SUAC+CBCH
          SB6    -B6+B1
          SA2    A6          FWA OF REQUEST PARAMETERS
          SX6    B0
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SB3    B0          WORD COUNT
          LX2    30
          SA1    B2+CB2C     FWA OF TERMINAL IN TST
          LX1    -18         RIGHT JUSTIFY TST ADDRESS
          SA4    X1
          LX4    59-58
          EQ     SND         SEND MESSAGE
 
 SLBA     VFD    1/0,1/1,4/0,1/1,5/0,18/SUAC+CBCH,18/0
 SRL      SPACE  4,10
**        SRL - SCAN ROLLOUT LIST FOR TIMED OUT ENTRIES.
 
 
 SRL      SUBR               ENTRY/EXIT
 SRL0     SB5    B0+         INITIALIZE,SEARCH
 SRL1     RJ     SRO         GET NEXT RESERVED ROLLOUT TABLE ENTRY
          ZR     B5,SRLX     IF END OF SEARCH
          SA5    B5
          MX4    5
          PL     X5,SRL1     IF ROLLOUT NOT COMPLETE
          LX4    -1
          BX2    X4*X5
          ZR     X2,SRL1     IF NO SPECIAL PROCESSING REQUIRED
          LX2    2
          MX7    RTTLN
          NG     X2,SRL2     IF TIMED ROLLOUT
          JP     SRL1        CONTINUE SEARCH
 
*         CHECKED TIMED ROLLOUT ENTRIES.
 
 SRL2     SA4    ITIME       CURRENT TIME
          LX4    -6
          LX7    -6
          BX4    X7*X4       TIME IN SECONDS
          BX3    X7*X5       ROLLIN TIME
          MX6    -12
          IX4    X3-X4
          LX5    -18         GET C.B. INDEX
          PL     X4,SRL1     IF TIME NOT EXPIRED
          LX2    -1
          BX4    -X6*X5
          NG     X2,SRL3     IF WAIT ON INPUT TIME OUT
 SRL2.1   BSS    0
 
*         REQUEST ROLLIN OF TIMED OUT TASK.
 
          TX0    X4,VCBSA    COMMUNICATION BLOCK ADDRESS
          SX5    A5          ROLLOUT TABLE ADDRESS
          RJ     MSQ         PLACE TASK IN SCHEDULING QUEUE
          SA1    X5          CLEAR TIME AND WAIT INPUT FLAGS
          MX7    2
          LX7    -1
          BX7    -X7*X1
          SA7    A1
          BX6    X6-X6
          SA6    X5+RTWEV    CLEAR EVENT IN ROLLOUT
          JP     SRL0
 
*         REQUEST ROLLIN OF WAIT ON INPUT TASK.
 
 SRL3     SX7    1
          LX4    18          TERMINAL ORDINAL
          BX7    X4+X7       FORMAT A FAKE TRANSACTION INPUT WORD
          SX6    B5          ROLLOUT TABLE ADDRESS
          SA6    SRLC        SAVE ROLLOUT TABLE ADDRESS
          MX6    1
          BX7    X6+X7
          SA7    SRLA
          SA4    SRLA
          RJ     RDCB        FORCE ROLLIN OF TASK
          ZR     X0,SRLX     IF NO COMMUNICATION BLOCK AVAILABLE
          SA1    SRLC        GET ROLLOUT TABLE ADDRESS
          SA2    X1          FWA OF ROLLOUT TABLE ENTRY
          MX7    -59         CLEAR TIME EVENT FLAG
          LX7    57-59
          BX7    -X7*X2
          SA7    A2          UPDATE FWA OF ROLLOUT TABLE ENTRY
          SX7    1
          SA7    X0+CMBHL+CMBRL  SET FLAG FOR USER
          EQ     SRLX        RETURN
 
 SRLA     BSS    1
 SRLB     BSS    1           DELAY COUNT
 SRLC     BSS    1           ROLLOUT TABLE ADDRESS
          SPACE  4,20
**        STD - SEARCH TASK/TRANSACTION DIRECTORY.
*
*         PERFORM A BINARY SEARCH OF A TASK OR TRANSACTION DIRECTORY
*         FOR THE SPECIFIED TASK OR TRANSACTION NAME.
*
*         ENTRY  (X2) = LEFT JUSTIFIED TASK/TRANSACTION NAME.
*                (B3) = LENGTH OF ENTRY.
*                (B5) = START OF DIRECTORY.
*                (B6) = END OF DIRECTORY.
*
*         EXIT   (A1) = FWA OF ENTRY IF FOUND.
*                (X1) = 0 IF ENTRY FOUND.
*                (X1) .NE. 0 IF ENTRY NOT IN DIRECTORY.
*                (X4) = RESTORED.
*                (B7) = RESTORED.
*
*         USES   A - 1, 3, 4, 7.
*                X - 0, 1, 3, 4, 7.
*                B - 5, 6, 7.
 
 
 STD      SUBR               ENTRY/EXIT
          SX1    STD
          GT     B5,B6,STDX  IF SEARCH NOT NECESSARY
          SX7    B7
          SA7    STDB        SAVE (B7)
          BX7    X4
          BX0    X2
          SA7    STDC        SAVE (X4)
          LX0    42          SHIFT SO NO SIGN BIT
          SX7    B6+B3       LWA+1 OF BASE TLD
          SA7    STDA
          SB7    59
          MX7    42          MASK FOR TASKS/TRANSACTIONS
          SX3    1
          EQ     STD2        ENTER LOOP
 
 STD1     SB5    A1+B3       SET NEW LOW LIMIT
          GT     B5,B6,STD5  IF SEARCH DONE IN BASE
 STD2     ZR     X3,STD5     IF END OF BASE DIRECTORY
          SX3    B6-B5       FIND MIDDLE
          SX1    B3
          LX1    X1,B7       59-0
          PL     X1,STD3     IF EVEN NUMBER OF WORDS PER ENTRY
          LX4    X3,B7       59-0
          PL     X4,STD4     IF ODD NUMBER OF ENTRIES REMAIN
          SX3    X3+B3
          EQ     STD4        CONTINUE PROCESSING
 
 STD3     LX4    X3,-B1      DIVIDE BY TWO
          LX4    X4,B7       59-0
          PL     X4,STD4     IF ODD NUMBER OF ENTRIES REMAIN
          SX3    X3+B3
 STD4     AX3    1
          SA1    B5+X3       READ AN ENTRY
          BX4    X7*X1
          LX4    42          SHIFT SO NO SIGN BIT
          IX1    X4-X0
          ZR     X1,STD7     IF FOUND
          NG     X1,STD1     IF TOO LOW IN TABLE
          SB6    A1-B3       SET NEW HIGH LIMIT
          GE     B6,B5,STD2  IF FIND NEXT ENTRY
 
*         ENTRIES ADDED ON A NONCREATION RUN ARE PLACED SEQUENTIALLY
*         AT THE END OF THE TLD.
 
 STD5     SX3    B3-TLDLE
          NZ     X3,STD7     IF TRANSACTION SEARCH
          SA3    STDA        LWA+1 OF BASE TLD
          ZR     X3,STD7     IF END OF DIRECTORY
          SB6    B3-TLDLE
          NZ     B6,STD7     IF TRANSACTION SEARCH
          SB6    X3+
          SB5    TLDLE       LENGTH OF TLD
 STD6     SA3    B6
          SB6    B6+B5
          ZR     X3,STD7     IF END OF TLD
          BX3    X7*X3
          LX3    42          SHIFT SO NO SIGN BIT
          IX3    X3-X0
          NZ     X3,STD6     IF TASK NAME DID NOT MATCH
          SA1    A3
          BX1    X1-X1
 
*         SEARCH COMPLETE.
 
 STD7     SA3    STDB        RESTORE (B7)
          SB7    X3+
          SA4    STDC        RESTORE (X4)
          EQ     STDX        RETURN
 
 STDA     BSS    1           LWA+1 OF BASE TLD
 STDB     BSS    1           (B7)
 STDC     BSS    1           (X4)
 STST     SPACE  4,15
**        STST   SEARCH TERMINAL STATUS TABLE FOR TERMINAL NAME
*
*         ENTRY  (X4) = LEFT JUSTIFIED TERMINAL NAME
*
*         EXIT   (X3) = TST ORDINAL OF TERMINAL
*                (X3) = 0 IF TERMINAL NAME NOT FOUND
*                (A3) = TST ADDRESS + 1 OF TERMINAL
*
*         USES   X - 3, 4, 7
*                A - 3
*                B - 4, 6
 
 
 STST     SUBR               ENTRY/EXIT
          TB4    TSTLLE+1,VTST  START OF *TST*
          TB6    2,VTST,LWA  END OF TST
          MX7    42
          BX4    X7*X4
 STST1    EQ     B4,B6,STST2 TERMINAL NAME NOT IN TST
          SA3    B4+
          SB4    B4+TSTLLE
          BX3    X7*X3       TERMINAL NAME
          IX3    X3-X4
          NZ     X3,STST1    CHECK ANOTHER ENTRY
          SX4    TSTLLE
          TX3    A3-1,-VTST  TST BIAS
          PX4    X4
          PX3    X3          DIVIDE TO GET TERMINAL NUMBER
          NX4    X4
          NX3    X3
          FX4    X3/X4
          UX4    X4,B6
          LX3    X4,B6       TERMINAL NUMBER
          EQ     STSTX       RETURN
 
 STST2    BX3    X3-X3
          EQ     STSTX       RETURN
 TRCL     SPACE  4,15
**        TRCL - TASK RECALL.
*
*         PLACE A TASK INTO A TIME-DELAY RECALL.  AFTER AN
*         INSTALLATION-DEFINED TIME PERIOD, ALL TASKS IN RECALL
*         ARE ACTIVATED.
*
*         ENTRY  (X7) = RETURN ADDRESS AFTER RECALL.
*                (B2) = FWA OF TASK SYSTEM AREA.
*                (B7) = FWA OF TASK SUBCP TABLE ENTRY.
*
*         EXIT   TO *TSSC* AFTER PROCESSING.
*
*         CALLS  DCPT.
 
 
 TRCL2    SA7    B2+RCL      SET RETURN ADDRESS
 
 TRCL     MX0    1
          TX4    B7+CPAL,-VCPA
          SX6    B1
          LX0    -12
          SA1    RCR         RECALL REQUEST WORD
          LX6    -4
          SA2    B7+B1       STATUS WORD 2 OF SUB CP AREA
          AX4    SCPAL
          SB5    X4
          BX6    X6+X2       SET TASK RECALL REQUEST BIT
          AX4    X0,B5
          IX7    X1+X4
          SA6    B7+B1
          SA7    A1          SET TASK RECALL REQUEST WORD
          SA1    STAT15      NUMBER OF TIMES TASK IN RECALL
          SX7    B1
          IX7    X1+X7
          SA7    A1
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 
*         JUMP TO RECALL PROCESSING ROUTINE
 
 TRCL1    SA1    B2+RCL
          MX3    1
          SA2    B7+B1       STATUS WORD 2
          LX3    -3
          SB3    X1
          BX7    -X3*X2      CLEAR RECALL BIT
          SA7    A2
          JP     B3          EXIT TO RECALL PROCESSING ROUTINE
 TRN      SPACE  4,28
**        TRN - GENERATE A SYSTEM ORIGIN TRANSACTION.
*
*         ENTRY  (X4) = TASK NAME TO SCHEDULE.
*                (X5) = MESSAGE CODE.
*                (X7) = DATA BASE OF TASK LIBRARY.
*                       0, IF SYSTEM TASK LIBRARY REQUIRED.
*                (B3) = FWA OF BUFFER INPUT, ZERO IF NO INPUT.
*                            FORM IS - 12/4001B,12/,18/TO,18/WC.
*                                      TO = TERMINAL ORDINAL.
*                                      WC = WORD COUNT.
*
*         EXIT   (X0) = 0 IF TASK NOT SCHEDULED.
*                     = FWA OF COMMUNICATION BLOCK.
*                (X7) = 0, IF NO COMMUNICATION BLOCK.
*                       1, IF TASK NOT FOUND.
*                       2, IF TASK NOT SCHEDULED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 4, 6, 7.
*                B - 3.
*
*         CALLS  ETSQ, FFCB, LTT, RDCB, RLC.
*
*         MACROS MESSAGE.
 
 
 TRN      SUBR               ENTRY/EXIT
          SA7    TRNB        DATA BASE LIBRARY
          ZR     B3,TRN1     IF NO BUFFER INPUT
          BX7    X4          SAVE TASK NAME
          SA4    B3+         MESSAGE BUFFER FWA
          SA7    TRNA
          RJ     RDCB        READ COMMUNICATIONS BLOCK
          ZR     X0,TRNX     IF NO C.B. AVAILABLE
          SX2    77B         READ AND UPDATE SECURITY
          SA1    X0+B1
          LX2    41-5
          BX6    X1+X2
          SA6    A1
          SA4    TRNA        TASK NAME
          EQ     TRN2        SCHEDULE TASK
 
 TRN1     SX0    1           SYSTEM REQUEST
          RJ     FFCB        GET A COMMUNICATION BLOCK
          SX7    B0+         NO COMMUNICATION BLOCK
          ZR     X0,TRNX     IF NO COMMUNICATIONS BLOCK AVAILABLE
 
*         FORMAT COMMUNICATIONS BLOCK.
 
          BX1    X1-X1
          RJ     ASN         GET SEQUENCE NUMBER
          SX7    DCPPR       SET DEFAULT CPU PRIORITY
          LX7    59-11
          LX6    18
          BX7    X6+X7       ADD SEQUENCE NUMBER
          SX6    X0          COMMUNICATION BLOCK ADDRESS
          SX2    77B         READ SECURITY + UPDATE SECURITY
          SA7    X0
          LX2    41-5
          BX6    X6+X2
          SA6    X0+B1       C.B. HEADER WORD 2
          SX7    B1          MESSAGE WORD COUNT OF ONE
          SA7    X0+CMBHL+1  SECOND WORD OF C.B. USER HEADER
          SX6    2RSY        DATA BASE
          LX6    -12
          SA6    A7-B1       FIRST WORD OF C.B. USER HEADER
          SX7    X5+         MESSAGE CODE
          SA7    A7+B1
          SA1    PDATE
          BX7    X1
          SA7    X0+CMBHL+TIMD-TRSQ
 
*         SCHEDULE TASK.
 
 TRN2     BX2    X4          SEARCH TASK LIBRARY DIRECTORY FOR NAME
          MX7    1
          SA3    X0+CMBHL+1  SECOND WORD OF C.B. USER AREA
          LX7    17-59
          BX6    X3+X7
          SA6    A3
          SA1    X0+CBSOW    SYSTEM ORIGIN IN HEADER
          LX7    CBSOS-59-17+59
          BX7    X1+X7       SET SYSTEM ORIGIN IN HEADER
          SA7    A1
          SX6    B0          NO TASK LIST
          SA3    TRNB        DATA BASE LIBRARY FOR TASK
          SB4    B0          DETECT *OFF* STATUS
          SB5    B0          TASK SEARCH
          RJ     LTT         LOCATE TASK
          ZR     X6,TRN4     IF TASK NOT IN DIRECTORY
          SA6    X0+2        TASK TO SCHEDULE LIST IN C.B.
          SB3    TRNX        ALTERNATE RETURN ADDRESS
          RJ     ETSQ        SCHEDULE TASK
 TRN3     NZ     X6,TRNX     IF SCHEDULED
          SX2    X0          RETURN C.B.
          BX0    X0-X0
          SX7    2           SET TASK NOT SCHEDULED
          RJ     RLC         RELEASE COMMUNICATION BLOCK
          EQ     TRNX        RETURN
 
 TRN4     SX2    X0+         FWA OF COMMUNICATION BLOCK
          SX7    B1          SET TASK NOT FOUND
          SX0    B0          TASK NOT SCHEDULED
          RJ     RLC         RELEASE COMMUNICATION BLOCK
          EQ     TRNX        RETURN
 
 TRNA     BSSZ   1           TEMP
 TRNB     BSS    1           DATA BASE
 TXT      SPACE  4,70
**        TXT - TRACE XJP-S OF A TASK.
*
*         ON RETURN FROM SELECTED SUBCP ACTIVATIONS, THE CONTENTS OF
*         SEVERAL REGISTERS WHICH CONTAIN INFORMATION CONCERNING THE
*         TASK ARE SAVED IN A CIRCULAR BUFFER.  THIS INFORMATION CAN
*         BE USEFUL IN DEBUGGING A PROBLEM IF *TAF* ABORTS AS A
*         RESULT OF A TASK SYSTEM REQUEST CALL.
*
*         ENTRY  (B4) = ERROR FLAG RETURNED FROM SUBCP ACTIVATION.
*                (B2) = START OF SYSTEM AREA PRECEDING RA OF THE TASK.
*                (B7) = ADDRESS OF SUBCP TABLE.
*                (X5) = CONTENTS OF SYSTEM REQUEST IN THE TASK FL.
*                (A5) = SYSTEM REQUEST.
*                (B3) = RA.
*
*         EXIT   ENTRY CONDITIONS PRESERVED.
*                TASK TRACE PACKET ENTERED INTO CIRCULAR BUFFER.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6.
*                B - 5, 6.
*
*         NOTES  THE CONTENTS OF A TASK TRACE PACKET IS
*
*                WORD 1 - 12/TEF, 12/TID, 18/(B2), 18/(B7)
*                         WHERE TEF = 2000B+ERROR FLAG RETURNED FROM
*                                     SUBCP ACTIVATION.
*                               TID = TASK TRACE PACKET IDENTIFIER (SET
*                                     TO ZERO).
*                               (B2) = START OF SYSTEM AREA PRECEDING
*                                      THE RA OF THE TASK.
*                               (B7) = ADDRESS OF SUBCP TABLE.
*
*                WORD 2 - CONTENTS OF SYSTEM REQUEST IN TASK FL.
*
*                WORD 3 - FIRST WORD OF C.B. KEPT IN THE SYSTEM AREA
*                         PRECEDING THE RA OF THE TASK.
*
*                WORD 4 - THIRD WORD OF SUBCP TABLE.
*                         (SEE DEFINITION OF SUBCP TABLE IN THE
*                         *TABLES* SECTION.)
*
*
*                THE FOLLOWING ARE PROVIDED AS GUIDELINES SHOULD
*                AN INSTALLATION WISH TO MAKE MODIFICATIONS TO
*                *TXT*.  *TXT* IS BASED UPON THESE GUIDELINES AND
*                NOT FOLLOWING THEM MAY CAUSE *TXT* NOT TO WORK
*                PROPERLY.
*                1.  SINCE *TXT* IS EXECUTED FREQUENTLY, THE CODE
*                    SHOULD BE SIMPLE AND FAST, ESSENTIALLY
*                    STRAIGHTLINE.
*                2.  THE SIZE OF THE BUFFER USED TO STORE TRACE
*                    PACKETS, *PBUFL*, MUST BE DEFINED AS THE TOTAL
*                    NUMBER OF PACKETS THAT CAN BE STORED IN THE
*                    BUFFER AT ONCE MULTIPLIED BY *ITTPL*, THE PACKET
*                    SIZE.
*                3.  IF THE PACKET LENGTH IS CHANGED, *ITTPL* MUST
*                    BE REDEFINED.  ONLY LENGTHS OF FOUR OR MORE
*                    WORDS ARE ACCEPTABLE.
*
*                IF TRACE PACKETS ARE PRODUCED FOR PURPOSES OTHER
*                THAN TASK XJP TRACE, *TXT* CAN BE USED AS A GUIDE
*                FOR THE INSTALLATION CODE.  THE FOLLOWING SHOULD
*                BE NOTED IN ADDITION TO THE ABOVE GUIDELINES.
*                1.  IN ORDER TO IDENTIFY THE TYPE OF EVENT BEING
*                    TRACED, A UNIQUE *TID* SHOULD BE ASSIGNED FOR
*                    EACH EVENT AND BE STORED INTO BITS 47 - 36
*                    OF THE FIRST WORD OF THE PACKET.
*                2.  IN ORDER TO INSURE THE CIRCULARITY OF THE BUFFER,
*                    THE *IN* POINTER OF THE *INTRACE* FET SHOULD BE
*                    UPDATED IN THE SAME MANNER AS *TXT* UPDATES IT.
*                    *TXT* CALCULATES THE VALUE OF THE *IN* POINTER FOR
*                    STORING THE NEXT PACKET BY TAKING THE VALUE OF THE
*                    *IN* POINTER FOR STORING THE FIRST WORD OF THE
*                    CURRENT PACKET AND ADDING *ITTPL* TO IT.  IF THE
*                    VALUE FOR THE *IN* POINTER IS GREATER THAN OR
*                    EQUAL TO *LIMIT*, SET THE *IN* POINTER EQUAL TO
*                    *FIRST*.
 
 
 TXT      SUBR               ENTRY/EXIT
 
*         SET UP AND STORE THE CONTENTS OF ONE TRACE PACKET.
 
          SX3    B2+         GET START OF SYSTEM AREA PRIOR TO TASK RA
          SX2    B7          GET ADDRESS OF SUBCP TABLE
          LX3    18
          SA1    INT+2       GET *IN* POINTER FROM FET
          BX2    X2+X3
          PX6    X2,B4
          SA6    X1+         STORE FIRST WORD OF PACKET
          BX6    X5          STORE (SYSTEM REQUEST) OF THE TASK FL
          SA6    A6+B1
          SA2    B2+CB1C     STORE FIRST WORD OF C.B.
          BX6    X2
          SA6    A6+B1
          SA2    B7+2        STORE THIRD WORD OF SUBCP TABLE
          BX6    X2
          SA6    A6+B1
 
*         DETERMINE THE VALUE OF THE *IN* POINTER FOR STORING THE
*         NEXT PACKET INTO THE TRACE BUFFER.
 
          SA2    A1+2        GET VALUE OF *LIMIT* FROM FET
          SB5    X1+ITTPL    GET NEXT VALUE FOR *IN* POINTER
          SB6    X2+
          LT     B5,B6,TXT1  IF *IN* .LT. *LIMIT*
          SA2    INT+1       GET VALUE OF *FIRST* FROM FET
          SB5    X2+
 TXT1     SX6    B5          STORE *IN* POINTER INTO FET
          SA6    A1
          EQ     TXTX        RETURN
 VTO      SPACE  4
**        VTO - VERIFY TASK ORIGIN.
*
*                DETERMINE IF A TASK IS FROM THE SYSTEM TASK LIBRARY.
*
*         EXIT   (X6) .GE.0, IF FROM A SYSTEM TASK LIBRARY.
*                (X6) .LT. 0, IF FROM A USER TASK LIBRARY.
*
*         USES   A - 2.
*                X - 2, 6.
 
 
 VTO      SUBR               ENTRY/EXIT
          SA2    B7+2
          MX6    12
          BX6    X6*X2       DIRECTORY INDEX FOR TASK
          TA2    -4,VTLD     LENGTH OF SYSTEM TASK DIRECTORY
          SX2    X2-4
          LX6    12
          IX6    X2-X6
          EQ     VTOX        RETURN
 VUP      SPACE  4,20
**        VUP - VALIDATE USER PARAMETERS.
*
*         ENTRY  (X1) = FL.
*                (X5) = RA REQUEST.
*                (B3) = MAXIMUM NUMBER OF PARAMETERS ALLOWED.
*                (B5) = SUBCP RA.
*                (B6) = REQUIRED NUMBER OF PARAMETERS.
*
*         EXIT   (X6) = 0, IF NO ERRORS.
*                       1, IF TOO MANY PARAMETERS OR
*                          IF REQUIRED PARAMETERS NOT PRESENT, OR
*                          IF PARAMETERS OUTSIDE RA AND FL.
*                (B2) = NUMBER OF PARAMETERS PRESENT.
*
*         USES   X- 2, 3, 6, 7.
*                A - 2.
*                B - 2, 4.
 
 
 VUP      SUBR               ENTRY/EXIT
          SB2    B0          COUNT OF PARAMETERS PRESENT
          SB4    X5          ADDRESS OF PARAMETERS
          SB4    -B4
          SX6    X1+B4
          NG     X6,VUP3     IF PARAMETER FWA GREATER THAN FL
          PL     B4,VUP3     IF PARAMETERS FWA LESS THAN RA
          SX6    B0+         NO ERRORS
          SX7    X5+B5       PARAMETER ADDRESS RELATIVE TO *TAF*
 VUP1     GT     B2,B3,VUP3  IF TOO MANY PARAMETETERS
          SA2    X7+B2       PARAMETER ADDRESS
          SB4    X2
          ZR     X2,VUP2     IF END OF PARAMETERS
          SB4    -B4
          SX3    X1+B4
          NG     X3,VUP3     IF PARAMETER .GE. FL
          PL     B4,VUP3     IF PARAMETER LESS THAN RA
          SB2    B2+B1
          EQ     VUP1        GET NEXT PARAMETER
 
 VUP2     GE     B2,B6,VUPX  IF REQUIRED PARAMETERS PRESENT, RETURN
 VUP3     SX6    B1          INCORRECT PARAMETER LIST
          EQ     VUPX        RETURN
          SEG
          TITLE  TOTAL INTERFACE ROUTINES.
 EOQ      SPACE  4,10
**        EOQ - ENTER OUTPUT QUEUE.
*
*         PLACE AN ENTRY INTO THE TOTAL OUTPUT QUEUE.
*
*         ENTRY  (X6) = QUEUE ENTRY.
*
*         EXIT   (X7) .NE. 0 - ENTRY IN QUEUE.
*                (X7) = 0 - QUEUE IS FULL.
*
*         USES   B - 1, 5.
*
*         CALLS  PDIF.
 
 
 EOQ      SUBR               ENTRY/EXIT
          SB5    TDO         TOTAL OUTPUT QUEUE FET
          SB1    1
          RJ     PDIF        MAKE QUEUE ENTRY
          EQ     EOQX        RETURN
 FAR      SPACE  4,10
**        FAR - FILE ATTACH ROUTINE.
*
*         ATTACH FILES FOR TOTAL.
*         THE EDT IS SEARCHED FOR THE FILE NAME AND THE ATTACH
*         INFORMATION IS PLACED INTO THE FET.
*         IF THE FILE DOES NOT EXIST OR IS NOT IN THE EDT LIST
*         AN ERROR STATUS IS RETURNED.  IF THE FILE IS XXTLOG AND DOES
*         NOT EXIST IT IS DEFINED.  THE XXTLOG FILE IS POSITIONED
*         AT EOI.
*
*         ENTRY  (X2) = ADDRESS OF FILE TO ATTACH.
*
*         EXIT   (X6) = 0 ATTACH OK.
*                (X6) .NE. 0 IS ERROR CODE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 3, 4, 6.
*                B - 1, 4, 7.
*
*         CALLS  PFM=.
 
 
 FAR5     SB7    X6+         SAVE ERROR CODE
          SA1    VUSN        TAF USER NAME
          SX6    TRUI        TAF USER INDEX
          MX0    42
          BX6    X1+X6
          SA6    FARC+2
          SA1    VFMN        TAF FAMILY NAME
          SX2    13B         FLAGS FOR *SETPFP*
          BX6    X0*X1
          BX6    X2+X6
          SA6    FARC
          SETPFP FARC        SET PERMANENT FILE PARAMETERS
          SX6    B7+         RESTORE ERROR CODE FOR TOTAL
 
 FAR      SUBR               ENTRY/EXIT
          SA1    X2          READ FILE NAME TO ATTACH
          SB1    1
          MX0    42
          SX6    B1
          BX2    X0*X1
          MX0    12
          BX6    X2+X6
          SA6    FARB        STORE IN FET
 
*         FIND THE USER INDEX FOR THIS DATA BASE.
 
          TA3    0,VEDT      FIRST EDT
          BX4    X0*X1       DATA BASE NAME
          LX3    -18
          SB4    X3          NUMBER OF EDTS
          LX3    18
 FAR1     BX6    X0*X3       EDT DATA BASE NAME
          BX6    X6-X4
          ZR     X6,FAR2     IF CORRECT EDT
          SB4    B4-B1
          SA3    X3          NEXT EDT
          NZ     B4,FAR1     IF MORE EDTS
          EQ     FARX        RETURN UNABLE TO FIND EDT
 
*         CORRECT EDT FOUND.
 
 FAR2     SA5    A3+2        USER INDEX WORD
          SA4    A3+1        GET JOURNAL FILE COUNT
          SX6    JFETL
          AX4    54          JOURNAL FILE COUNT
          IX6    X4*X6       LENGTH OF JOURNAL FILE FETS
          SB4    X6+HDRL     OFFSET OF FIRST FILE NAME IN EDT
 
*         FIND THE PRIVATE PACK INFORMATION FOR THE FILE TO ATTACH.
 
          SA4    B4+A3       FIRST FILE NAME
 FAR3     ZR     X4,FARX     IF FILE NAME NOT FOUND
          BX6    X4-X2
          SA4    A4+TFEN     NEXT FILE NAME
          NZ     X6,FAR3     IF FILE NOT FOUND
          SA1    A4-B1       GET PACKNAME AND UNIT FOR FILE
          MX7    48
          LX7    6
          BX6    X7*X1
          SA6    FARB+CFPK   PACKNAME AND UNIT INTO FET
          LX1    -6
          MX4    -12
          BX4    -X4*X1      DEVICE TYPE
          SA2    FARB+1
          MX7    -48
          LX4    -12
          BX2    -X7*X2
          IX6    X2+X4
          SA6    A2          DEVICE TYPE TO FET
          BX6    X5
          SA6    FARC+2
          SA1    A5+4        FAMILY NAME
          SX2    13B         SET FLAGS FOR *SETPFP*
          BX6    X1+X2
          SA6    FARC
          SETPFP FARC        SET PERMANENT FILE PARAMETERS
          STATUS FARB        CHECK IF FILE EXISTS
          SA1    FARB
          MX6    11
          LX1    59-11
          BX3    X6*X1
          BX6    X6-X6
          NZ     X3,FAR5     IF FILE EXISTS
          ATTACH FARB,,,,M
          SA3    X2          CHECK FOR ATTACH ERROR
          MX7    24
 
*         CHECK FOR THE FILE BEING XXTLOG.
 
          SA4    FARA
          LX3    12
          MX0    -6
          BX7    X7*X3
          LX3    -12-10
          BX4    X7-X4
          BX6    -X0*X3      ERROR CODE
          NZ     X4,FAR5     IF NOT XXTLOG FILE
 
*         ATTACH XXTLOG FILE IN WRITE MODE.
 
          ATTACH FARB,,,,W
          SA3    FARB
          LX3    -10
          BX6    -X0*X3
          NZ     X6,FAR4     IF ERROR ON ATTACH
          SKIPEI FARB,R      POSITION XXTLOG AT EOI
          BX6    X6-X6       INDICATE NO ERRORS
          EQ     FAR5
 
 FAR4     SX7    X6-2
          NZ     X7,FAR5     IF NOT *FILE NOT FOUND*
          DEFINE FARB
          SA4    FARB        GET STATUS FROM DEFINE OF XXTLOG
          AX4    10
          BX6    -X0*X4
          EQ     FAR5
 
 FARA     VFD    60/0LTLOG
 FARB     FILEB  OBUF,OBUFL,FET=13,EPR
 
*         CALL BLOCK FOR *SETPFP*.
 
 FARC     CON    0           42/ FAMILY NAME, 14/ , 4/ FLAGS
          CON    0           42/ PACK NAME, 18/ PACK TYPE
          CON    0           42/ USER NAME, 18/ USER INDEX
 GRA      SPACE  4,10
**        GRA - GET REFERENCE ADDRESS.
*
*         RETURN THE RA, FL AND DATA BASE ID OF THE SUB CONTROL POINT.
*
*         ENTRY  (X1) = SUB CONTROL POINT NUMBER.
*                (X6) = 1 IF CALLED BY *TOTAL*.
*                       0 OTHERWISE.
*
*         EXIT   (X2) = 42/USER NAME,18/0.
*                (X4) = 42/TASK NAME,18/0.
*                (X5) = DATA BASE ID - RIGHT JUSTIFIED.
*                (X6) = RA OF SUB CONTROL POINT.
*                (X7) = FL OF SUB CONTROL POINT.
*
*         USES   X - 2, 4, 5, 6, 7.
*                A - 4, 5.
 
 
 GRA      SUBR               ENTRY/EXIT
          SX2    IFL=        FIELD LENGTH OF TRANEX1
          SX4    B0+
          BX5    X5-X5
          LX1    SCPAL
          ZR     X1,GRA1     IF SUB CP 0 (TRANEX)
          TA4    X1-CPAL,VCPA  USER FL/RA
          MX7    -6
          BX2    X4
          SA5    X4-NUAPL+DBNC  DATA BASE NAME
          LX2    -18
          SX5    X5          DATA BASE ID
          ZR     X6,GRA1     IF NOT CALLED BY *TOTAL*
          BX6    -X7*X5      CHECK SECOND CHARACTER FOR *S*
          SX6    X6-1RS
          BX7    X7*X5
          NZ     X6,GRA1     IF SECOND CHARACTER NOT AN *S*
          SX5    X7+1RT      CONVERT SECOND CHARACTER TO A *T*
 GRA1     SX6    X4          SUB CP RA
          SX7    X2          SUB CP FL
          BX4    X4-X4       TASK NAME = 0, IF SUBCP = 0
          MX2    12
          ZR     X1,GRAX     IF SUBCP = 0
          SA4    A4          STATUS WORD 1 OF SUBCP TABLE
          LX4    59-SCBCS
          PL     X4,GRA2     IF SUBCP NOT FOR BATCH CONCURRENCY
          SA4    X6-NUAPL+BCTN  BATCH CONCURRENT TASK NAME
          SA2    X6-NUAPL+BCTA  GET FWA OF *BCT* ENTRY
          SA2    X2          GET *TST* ADDRESS
          LX2    BCTAN-1-BCTAS
          SA2    X2+TSTNW    *TST* WORD TWO
          MX1    TSTNN
          BX2    X1*X2
          EQ     GRAX        RETURN
 
 GRA2     SA4    A4+2        WORD 3 OF SUBCP
          BX4    X2*X4       TASK LIBRARY DIRECTORY INDEX
          LX4    12
          TA4    X4-1,VTLD   GET TASK NAME
          MX2    42
          BX4    X2*X4
          SA2    X6-NUAPL+CB2C  GET *TST* ADDRESS
          LX2    CBTAN-1-CBTAS
          SA2    X2+TSTNW
          MX1    TSTNN
          BX2    X1*X2
          EQ     GRAX        RETURN
 RIQ      SPACE  4,10
**        RIQ - READ INPUT QUEUE.
*
*         REMOVE AN ENTRY FROM THE TOTAL INPUT QUEUE.
*
*         EXIT.  (X6) = 0 - QUEUE IS EMPTY.
*                (X6) = QUEUE ENTRY.
*
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 1.
 
 
 RIQ      SUBR               ENTRY/EXIT
          SB1    1
          SA1    TDI+2       IN
          SA2    A1+B1       OUT
          IX6    X1-X2
          ZR     X6,RIQX     IF QUEUE IS EMPTY
          SA5    X2          READ QUEUE ENTRY
          SA3    A2+B1       LIMIT
          SX7    X2+B1       INCREASE OUT
          BX3    X7-X3
          NZ     X3,RIQ1     IF NOT AT LIMIT
          SA3    A1-B1       FIRST
          BX7    X3
 RIQ1     SA7    A2          ADVANCE OUT
          BX6    X5          QUEUE ENTRY
          EQ     RIQX        RETURN
 TCM      SPACE  4,20
**        TCM - TAF *CMM* INTERFACE.
*
*         ENTRY  (X7) = FIELD LENGTH CHANGE, NEGATIVE IF DECREASE.
*                (VFSCP) = FWA OF SUB-CONTROL POINTS.
*                (VCPA) = FWA OF SUB-CONTROL POINT TABLE.
*
*         EXIT   (X1) = FL GRANTED.
*                (X2) = ZERO IF FIELD LENGTH GRANTED.
*                       .NE. ZERO, IF FIELD LENGTH NOT GRANTED.
*
*         USES   A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 6.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  MTD, MTK, RMF, RKP.
 
 
 TCM5     SA3    VFSCP       UPDATE FWA OF TASK SUBCP
          SA1    TCMA
          AX3    24
          IX6    X3+X1
          SA4    AVAILCM     UPDATE AVAILABLE CM COUNT
          IX7    X4-X1
          LX6    24
          SA6    A3
          SA7    A4
 
 TCM      SUBR               ENTRY/EXIT
          TX1    B0,VCPA     FWA OF SUBCP TABLE
          SA0    B7+         ACTIVE SUBCP
          SA7    TCMA        SAVE FL REQUEST
          NG     X7,TCM4     IF REDUCE FL
          SA7    CMPF        SET PAUSE FLAG
          SA2    AVAILCM     AVAILABLE FL
          SX0    X7
          IX7    X2-X7
          PL     X7,TCM1     IF SPACE AVAILABLE
          RJ     RMF         REQUEST MORE FL
          SX2    TCM         SET X2 TO NONZERO
          ZR     X5,TCMX     IF NO SPACE AVAILABLE
 TCM1     TX2    B0,VCPA     FWA OF SUBCP TABLE
          RJ     SFS         SEARCH FOR FREE SPACE
          SB3    X7+B1
          NG     B3,TCM3     IF NO SPACE AVAILABLE
          SB4    A3          SUBCP TO MOVE
          EQ     B4,B5,TCM2  IF MOVE FIRST SUBCP - ITASK
          SA2    B5+2        GET NEXT SUBCP
          SB5    X2
          RJ     MTD         MOVE TASK TOWARD HIGH MEMORY LOCATION
 
*         MOVE FIRST SUBCP - ITASK.
 
 TCM2     TA2    B0,VCPA     FWA OF FIRST SUBCP
          SA1    TCMA        REQUEST FL
          SB4    A2          SUBCP TO MOVE
          BX4    -X1         AMOUNT OF FL TO REDUCE
          SB3    X2-NUAPL    TASK FWA
          SB6    B3+X1       DESTINATION
          RJ     MTK         MOVE TASK TOWARD HIGH MEMORY LOCATION
          RJ     RKP         RESET K-DISPLAY POINTER
          BX7    X7-X7
          BX2    X2-X2
          SA7    CMPF        CLEAR PAUSE FLAG
          EQ     TCM5        UPDATE FWA OF TASK SUBCP
 
*         UNABLE TO FIND A SPACE, SET PAUSE FLAG.
 
 TCM3     SX2    TCM3        SET X2 TO NONZERO
          SA7    CMPF        BLOCK ALL TASKS MAKING *SSC* REQUEST
          EQ     TCMX        FL NOT GRANTED
 
*         PROCESS REDUCE FL.
 
 TCM4     SB4    X1          SUBCP TO MOVE
          SA2    X1          GET FWA OF TASK
          SB3    X2-NUAPL    FWA OF TASK
          SB6    B3+X7       DESTINATION
          BX4    -X7         ADDITIONAL SPACE AFTER MOVE
          RJ     MTK         MOVE FIRST SUBCP UP
          BX2    X2-X2
          EQ     TCM5        UPDATE FWA OF TASK SUBCP
 
 TCMA     BSSZ   1           REQUEST FIELD LENGTH
 RCP      TITLE  MEMORY MANAGEMENT.
 RCP      SPACE  4,20
**        RCP - REQUEST FOR SUBCONTROL POINT.
*                RCP  WILL TRY TO FIND A CONTIGUOUS BLOCK OF SPACE TO
*                SATISFY THE REQUEST. A STORAGE MOVE (COMPACTION) OF
*                SPACE WILL BE MADE IF THE REQUEST CAN BE SATISFIED BY
*                COMBINING SEVERAL HOLES BETWEEN TWO OR MORE SUBCPS.
*
*         ENTRY  (X0) = FL REQUIRED.
*
*         EXIT   (X5) = START OF ASSIGNED AREA.
*                     = 0 IF FL NOT AVAILABLE.
*                (B4) = ASSIGNED SUBCONTROL POINT TABLE ADDRESS.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  ESCP, RKP, RMF, SFS.
 
 
 RCP14    SA1    STAT11      NUMBER OF TIMES NO SUBCONTROL POINTS
          SX6    B1
          IX6    X1+X6
          SB7    A0          RESET (B2) AND (B7)
          SB2    A5
          BX5    X5-X5
          SA6    A1
 
 RCP      SUBR
          SA1    AVAILCM     SPACE CURRENTLY AVAILABLE
          BX5    X5-X5
          IX7    X1-X0
          PL     X7,RCP1     IF NOT ENOUGH SPACE AVAILABLE
          RJ     RMF         REQUEST MORE FIELD LENGTH
          ZR     X5,RCPX     IF NO SPACE AVAILABLE
 RCP1     BX6    X6-X6
          TA2    0,VNACP     NEXT FREE CONTROL POINT
          SB6    B0
          SA5    B2          SAVE B2
          SA0    B7          SAVE B7
          NZ     X2,RCP1.1   IF SUBCP AVAILABLE
          SA3    SCHDA
          ZR     X3,RCP14    IF NO RELEASABLE TASKS
          SX7    B0+
          SA7    ETIME       TIME TO EVICT RELEASABLE TASK
          RJ     CORU        RELEASE A RELEASABLE TASK
 RCP1.1   TX2    0,VCPA      FIRST SUBCONTROL POINT AREA
          SB7    X2          FIRST SUBCP
          SX3    X2          FWA OF SUBCP
          SX5    377770B
          BX7    X7-X7
          SB4    B0
 RCP2     RJ     SFS         SEARCH FOR FREE SPACE
          PL     X7,RCP11    IF ENOUGH FL AFTER SUBCP
          SX7    X7+B1
          IX1    X6-X5
          ZR     X2,RCP5     IF LAST SUBCP
          ZR     X7,RCP3     IF SPACE AVAILABLE
          SB7    X2          TRY NEW BLOCK
          EQ     RCP2        SEARCH FOR FREE SPACE
 
 RCP3     IX1    X6-X5
          PL     X1,RCP4     IF PREVIOUS AMOUNT WAS A BETTER CHOICE
          BX5    X6          SWITCH POINTER
          SB4    B5
          SX7    B5          SAVE POINTER
          SA7    RCPA
 RCP4     SA2    B7+2        GET NEXT SUBCP
          SX2    X2
          SB7    X2
          NZ     B7,RCP2     IF NOT LAST SUBCP
 
 RCP5     SX5    B0+
          NZ     B4,RCP6     IF SPACE AVAILABLE
          SB7    A0          RESET (B2) AND (B7)
          SB2    A5
          EQ     RCPX        RETURN
 
*         PERFORM STORAGE MOVE TO COMPACT ALLOCATABLE SPACE.
 
 RCP6     SB3    RCP7        RETURN ADDRESS IF DROPING A SUBCP
          SB7    B0+
 RCP7     SA3    B4          FWA OF SUBCP TABLE
          LX3    SCFCN-SCFCS-1  GET FREE SPACE
          SX1    X3          FREE SPACE AFTER SUBCP
          IX5    X1-X0
          PL     X5,RCP11    IF SPACE AVAILABLE AFTER SUBCP
          SA4    B4+SCLSW    GET LAST SUBCP
          LX3    59-SCRLS-SCFCN+SCFCS+1
          SB6    B4          SUBCP TO RELEASE
          PL     X3,RCP10    IF SUBCP NOT RELEASABLE
          LX4    SCLSN-SCLSS-1  GET LAST SUBCP
          SB4    X4
          EQ     ESCP1       RELEASE SUBCP
 
 RCP10    SB4    X4          NEXT SUBCP
          ZR     X1,RCP7     IF NO FREE SPACE AFTER SUBCONTROL POINT
          SA2    X4
          LX2    59-SCRLS
          SB4    A3
          SB6    X4+         SUBCP TO RELEASE
          NG     X2,ESCP1    IF SUBCP RELEASABLE
          SB4    X4          SUBCP TO MOVE
          SA2    A3          FWA OF LAST SUBCP TABLE
          SX4    X1          FREE SPACE OF SUBCP
          SB6    B0
          RJ     MTK         MOVE TASK TOWARD LOW MEMORY LOACTION
          EQ     RCP6        CONTINUE COMPACTING SUBCP
 
*         ASSIGN SPACE TO A NEW SUBCONTROL POINT AND EXIT.
*         (A3)/(X3) = FWA OF SUBCP TABLE.
 
 RCP11    MX6    42
          BX7    X6*X3       MASK OUT FREE SPACE COUNT
          LX7    36
          SA7    A3
          SB6    B1+B1       CONSTANT 2
          TA4    0,VNACP     NEXT FREE SUBCONTROL POINT
          SA2    A3+B6
          BX1    X6*X2       MASK OUT POINTER TO NEXT SUBCONTROL POINT
          IX7    X1+X4       NEW POINTER
          SA7    A2
          SA1    X4          NEXT FREE SUBCP
          BX7    X1
          SA7    A4          RESET NEXT FREE SUBCP POINTER
          LX3    18
          SX1    X3          FL OF CURRENT SUBCP
          LX3    18
          SX7    X3          RA OF CURRENT SUBCP
          IX5    X7+X1       START OF NEW SUBCP SPACE
          LX3    24
          SX3    X3          FREE SPACE PRESENT BEFORE ASSIGNMENT
          IX6    X3-X0       FREE SPACE PRESENT AFTER ASSIGNMENT
          SX1    X0-NUAPL
          LX6    18
          SB4    X4
          BX6    X6+X1       FL AT NEW SUBCP
          LX6    18
          SX3    X5+NUAPL
          BX6    X6+X3       RA OF NEW SUBCP
          SA6    X4          STATUS WORD ONE OF SUBCP AREA
          SX7    A3          LAST SUBCP
          SX2    X2
          LX7    18
          BX7    X7+X2
          SA7    A6+2        STATUS WORD TWO
          SA1    AVAILCM     UPDATE AVAILABLE CM
          IX6    X1-X0
          SA6    A1
          ZR     X2,RCP12    IF ADDING TO END OF CHAIN
          SA1    X2+B6
          MX6    42
          SX3    B4          POINT NEXT SUBCP BACK TO NEW ONE
          LX1    -18
          BX6    X6*X1       MASK OFF OLD BACK POINTER
          IX6    X6+X3
          LX6    18
          SA6    A1
 RCP12    SB2    A5          RESTORE B2
          SB7    A0          RESTORE B7
          RJ     RKP         RESTORE K-DISPLAY POINTER
          SX1    B2          UPDATE (SREG)
          SX7    B7
          LX1    18
          BX7    X1+X7
          SA7    SREG
          EQ     RCPX        RETURN
 
 RCPA     BSSZ   1           SUBCP TO START COMPACTION WITH
 MTD      SPACE  4,10
**        MTD - MOVE TASKS DOWN (TOWARD HIGH MEMORY LOCATION).
*
*         ENTRY  (B5) = FWA OF SUBCP TABLE - LAST TO MOVE.
*                (A3) = FWA OF SUBCP TABLE - FIRST TO MOVE.
*
*         USES   A - 1, 2, 3, 7.
*                B - 3, 4, 5, 6.
*                X - ALL.
*
*         CALLS  ESCP, MTK.
 
 
 MTD      SUBR               ENTRY/EXIT
          ZR     B5,MTDX     IF NOTHING TO MOVE
          SA2    B5+SCLSW    GET TERMINATOR
          SB4    A3          SUBCP TO MOVE
          LX2    SCLSN-SCLSS-1
          SX0    X2+         FWA OF SUBCP TABLE - TERMINATOR
 MTD1     SB3    X0
          EQ     B3,B4,MTDX  IF DONE WITH TASK MOVE
          SA2    B4          GET FWA OF SUBCP
          LX2    59-SCRLS
          PL     X2,MTD3     IF SPACE NOT RELEASABLE
          SB6    B4          SUBCP TO RELEASE
          SA3    B4+2        GET PRIVIOUS SUBCP
          LX3    SCLSN-SCLSS-1
          SB4    X3          PRIVIOUS SUBCP
          SB3    MTD1        RETURN ADDRESS
          EQ     ESCP1       RELEASE SUBCP
 
 MTD3     SA3    B4          TASK SUBCP
          SB6    X3-NUAPL    FWA OF SUBCP
          LX3    SCFCN-SCFCS-1
          SB6    X3+B6       DESTINATION
          SX6    X3          FREE SPACE AFTER  CURRENT SUBCP
          SA2    B4+SCLSW    GET PREVIOUS SUBCP
          BX4    -X6
          LX2    SCLSN-SCLSS-1
          SB5    X2          PRIVIOUS SUBCP
          SA1    X2          PREVIOUS SUBCP
          LX1    SCFCN-SCFCS-1
          SX2    X1          FREE SPACE AFTER PREVIOUS SUBCP
          MX7    60-SCFCN
          IX6    X2+X6       UPDATE FREE SPACE COUNT
          BX5    X7*X1
          BX7    X5+X6
          LX7    SCFCS-SCFCN+1
          SA7    A1
          RJ     MTK         MOVE TASK TOWARD HIGH MEMORY LOCATION
          SB4    B5          NEXT TASK TO MOVE
          EQ     MTD1        MOVE NEXT SUBCP
 MTK      SPACE  4,20
**        MTK - MOVE TASK.
*
*         ENTRY  (A0) = FWA OF ACTIVE TASK SUBCP TABLE.
*                (B4) = FWA OF SUBCP TO BE MOVE.
*                (A2)/(X2) = FWA OF LAST SUBCP TABLE IF (B6) .EQ. 0.
*                (X4) = FREE SPACE OF CURRENT SUBCP.
*                (B6) = 0, IF TASK MOVED UPWARD.
*                       ADDRESS TO MOVE TO, OTHERWISE.
*
*         EXIT   (A5) = ACTIVE TASK NEW RA.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 6.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  MVE=.
*
*         NOTE - MOVE TASK UP IMPLIES MOVE TOWARD TAF RA.
 
 
 MTK      SUBR               ENTRY/EXIT
          NZ     B6,MTK1     IF TASK MOVED DOWNWARD
          MX7    18
          SB6    X2          RA OF LAST SUBCONTROL POINT
          LX7    -6
          BX7    -X7*X2      ZERO OUT FREE SPACE COUNT
          LX2    SCFLN-SCFLS-1
          SB6    X2+B6       NEW FWA OF TASK
          NO
          SA7    A2+         RESET STATUS WORD ONE
 MTK1     SA3    B4          STATUS WORD 1 OF SUBCP BEING MOVED
          LX3    SCFCN-SCFCS-1
          SX6    X3
          IX6    X6+X4
          NG     X6,MTK2     IF NEGATIVE FREE SPACE COUNT
          MX7    60-SCFCN
          BX5    X7*X3
          BX6    X5+X6
          LX3    SCFLN-SCFLS-1+SCFCS-SCFCN+1
          SX1    X3+NUAPL    TOTAL MEMORY BEING MOVED
          MX4    -18
          SX3    B6          DESTINATION
          SX2    B6+NUAPL    NEW RA
          LX6    SCFCS-SCFCN+1
          BX7    X4*X6       MASK OFF OLD RA
          SX5    X6-NUAPL    START OF MEMORY TO BE MOVED
          IX6    X7+X2
          SA6    A3          RESET STATUS WORD
          SA4    STAT4
          SX2    X5          SOURCE
          SX6    B1
          IX6    X4+X6       BUMP STORAGE MOVE COUNT
          SA6    A4
          RJ     MVE=        MOVE TASK
          SB3    A0
          SA1    B4
          SA2    X1-NUAPL+1  EXCHANGE PACKAGE WORD WITH RA
          MX7    24
          SX3    X1          NEW RA
          BX7    -X7*X2
          LX3    36
          BX7    X7+X3       SET NEW RA INTO EXCHANGE PACKAGE
          SA7    A2
          NE     B3,B4,MTKX  IF ACTIVE SUBCP NOT MOVED
          SA5    A2-B1       NEW RA
          EQ     MTKX        RETURN
 
 MTK2     RJ     EXIT        INCORRECT SUBCP TABLE
 RMF      SPACE  4,15
**        RMF - REQUEST MORE FIELD LENGTH.
*
*         ENTRY  (X7) = COMPLIMENT OF REQUEST FIELD LENGTH.
*
*         EXIT   (X5) = 0  IF FIELD LENGTH NOT AVAILABLE.
*                (X5) = -1 IF FIELD LENGTH AVAILABLE.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         MACROS MEMORY.
 
 
 RMF5     SX5    B0+         MEMORY NOT AVAILABLE
 
 RMF      SUBR               ENTRY/EXIT
          SA3    MTIME       LAST FL REDUCTION TIME
          SA2    LTIME       CURRENT TIME
          ZR     X3,RMF1     IF NO REDUCTION SINCE LAST INCREASE
          IX3    X2-X3
          MX6    -36
          SX4    RFLTL
          BX6    -X6*X3      TIME ELAPSED SINCE LAST REDUCTION
          IX4    X6-X4
          NG     X4,RMF5     IF MINIMUM TIME NOT ELAPSED
          BX6    X6-X6
          SA6    A3
 RMF1     SA2    MFL         MAXIMUM FIELD LENGTH ALLOWED
          SA3    CURFL       CURRENT TAF FIELD LENGTH
          IX6    X2-X3
          ZR     X6,RMF5     IF ALREADY AT MAXIMUM FIELD LENGTH
          IX4    X6+X7
          NG     X4,RMF5     IF REQUESTING MORE FL WILL NOT HELP
          SX1    X7+INCFL
          BX4    -X7
          NG     X1,RMF2     IF REQUEST GREATER THAN MINIMUM REQUEST
          IX4    X4+X1       REQUEST MINIMUM AMOUNT
          IX7    X6-X4
          PL     X7,RMF2     IF REQUESTED WILL NOT EXCEED MAXIMUM
          SX4    X6          REQUEST UP TO THE MAXIMUM ALLOWED
 RMF2     NG     X6,RMF5     IF CURRENTLY HAVE MORE THAN MAXIMUM
          IX7    X3+X4       FIELD LENGTH DESIRED
          SA7    RMFA        SAVE REQUEST FL
          MEMORY CM,MRSW,R,X7  REQUEST FL
          SA1    AVAILCM     AVAILABLE CM
          SA2    MRSW        GET STATUS WORD
          MX3    30
          BX6    X3*X2       NEW FL
          SA3    RMFA        REQUEST FL
          LX6    30
          IX2    X6-X3
          SA4    CURFL       COMPUTE INCREMENT OF FL
          IX4    X6-X4
          NG     X2,RMF5     IF FL NOT GRANTED
          IX7    X1+X4       UPDATE AVAILABLE SPACE COUNT
          SA7    A1          NEW AVAILABLE SPACE COUNT
          TB3    0,VCPA      FIRST SUBCONTROL POINT AREA
          SA6    CURFL       NEW TAF FIELD LENGTH
          SX6    B1+
          SA1    STAT6
          IX6    X6+X1       INCREMENT MEMORY INCREASE COUNT
          SA6    A1+
 RMF3     ZR     B3,RMF4     IF AT END OF SUBCONTROL POINTS
          SA1    B3+2
          SB4    B3          NEXT ACTIVE SUBCONTROL POINT
          SB3    X1
          EQ     RMF3        LOOP TO END OF CHAIN
 
 RMF4     SA1    B4          STATUS WORD ONE OF LAST ACTIVE SUBCP
          LX1    -36
          IX7    X1+X4       ADD FL INCREASED AMOUNT
          LX7    36
          SA7    A1
          SX5    -B1         FIELD LENGTH AVAILABLE
          EQ     RMFX        RETURN
 
 RMFA     BSSZ   1           REQUEST FL
 SFS      SPACE  4,20
**        SFS - SEARCH FOR FREE SPACE.
*
*         ENTRY  (X2) = FWA OF SUBCP TABLE TO START WITH.
*                (X0) = FIELD LENGTH REQUIRED.
*
*         EXIT   (X7) .GE. 0 IF FL AVAILABLE AFTER SUBCP.
*                (X7) = -1 IF STORAGE MOVE IS REQUIRE TO GET FL.
*                (X7) = -2 IF NO FIELD LENGTH AVAILABLE.
*                (B3) = TOTAL FREE SPACE AVAILABLE.
*                (B5) = FWA OF SUBCP TABLE.
*                (X6) = AMOUNT OF SPACE TO MOVE.
*                (X2) = NEXT SUBCP TO SEARCH.
*                (A3)/(X3) = FWA OF LAST SUBCP TABLE IF (X7) .GE. -1
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 3.
*                B - 3, 5, 6.
 
 
 SFS3     SX7    -2          SPACE NOT AVAILABLE
          SX6    377777B     SET MAXIMUM SPACE TO MOVE
 
 SFS      SUBR               ENTRY/EXIT
          SB5    X2          FWA OF SUBCP TABLE
          SB6    X0          FL REQUIRED
          SB3    B0
          BX6    X6-X6
 SFS1     ZR     X2,SFS3     IF DONE EVALUATING SUBCP
          SA3    X2
          BX1    X3
          LX3    SCFCN-SCFCS-1  RIGHT JUSTIFY FREE SPACE AFTER SUBCP
          SX2    X3          AVAILABLE FL AFTER SUBCP
          LX1    SCFLN-SCFLS-1
          SX4    X1          SUBCP FL
          SX4    X4+NUAPL    TOTAL FL OF SUBCP
          LX1    59-SCRLS+SCFLS-SCFLN+1
          IX7    X2-X0
          PL     X7,SFSX     IF ENOUGH SPACE AFTER SUBCP
          SA3    A3+2
          SX7    X2          FREE SPACE AFTER SUBCP
          PL     X1,SFS2     IF SUBCP IS NOT RELEASEABLE
          IX7    X2+X4       AVAILABLE SPACE
          BX4    X4-X4
 SFS2     SA1    X3
          SX2    X3          NEXT SUBCP TO SEARCH
          NG     X1,SFS3     IF SUBCP LOCKED AGAINST STORAGE MOVE
          IX6    X4+X6       TOTAL SPACE TO STORAGE MOVE
          SB3    B3+X7       SPACE AVAILABLE IF STORAGE MOVE
          LT     B3,B6,SFS1  IF NOT ENOUGH SPACE AVAILABLE
          SA3    A3-2        CURRENT SUBCP
          SX4    X6-MAXSM
          PL     X4,SFS3     IF TOO MUCH SPACE TO MOVE
          SX2    A3
          SX7    -B1         SPACE AVAILABLE
          EQ     SFSX        RETURN
          TITLE  QUEUE MANAGEMENT.
 ATW      SPACE  4,15
**        ATW - ADVANCE *TAF* WORK.
*
*         ENTRY  (TAFQ) = POINTERS TO QUEUED WORK.
*
*         EXIT   TO COMPLETE PROCESSOR, IF EVENT COMPLETE.
*                (B3) = FWA OF QUEUED ENTRY RELATIVE TO TASK
*                       SUBCP SYSTEM AREA.
*                (B5) = FWA OF QUEUED ENTRY RELATIVE TO *TAF*.
*                (X2) = FIRST WORD OF QUEUE ENTRY.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  CRA.
 
 
 ATW      SUBR               ENTRY/EXIT
          SB4    B0          FWA OF PRIOR QUEUE ENTRY
          MX0    -QWNSN      MASK FOR SUBCP
          SA1    TAFQ        POINTERS TO WORK
          SX6    X1          FWA OF FIRST QUEUED ENTRY
          ZR     X6,ATWX     IF NO WORK, RETURN
          LX1    5-23        RIGHT JUSTIFY FIRST SUBCP
          BX5    X5-X5       CLEAR PREVIOUS ENTRY
          BX3    -X0*X1      SUBCP OF QUEUE ENTRY
          LX1    59-59-5+23  FWA OF FIRST QUEUE ENTRY
 
*         EXAMINE QUEUE FOR COMPLETED WORK.
 
 ATW1     RJ     CRA         COMPUTE REAL ADDRESS
          SA2    B5          QUEUED WORK ENTRY
          SB5    X3+         SAVE SUBCP
          SA3    X2          EVENT COMPLETE WORD
          LX2    QWSHN-1-QWSHS  RIGHT JUSTIFY EVENT COMPLETE SHIFT
          BX7    -X0*X2
          ERRNZ  QWNSN-QWSHN IF SUBCP .NE. SHIFT FIELD
          SB3    X7
          LX3    B3          SHIFT EVENT COMPLETE TO BIT 59
          SB3    X1
          LX2    QWNAN-1-QWNAS-QWSHN+1+QWSHS
          SX6    X2          NEXT ENTRY IN QUEUE
          LX2    QWTYN-1-QWTYS-QWNAN+1+QWNAS  QUEUE TYPE
          ERRNZ  QWTYN-QWNSN IF TYPE LENGTH .NE. SUBCP LENGTH
          BX7    -X0*X2
          LX2    59-59-QWTYN+1+QWTYS
          NG     X3,ATW3     IF EVENT COMPLETE
          NZ     X7,ATW8     IF TIMED EVENT
 ATW2     SB4    A2          PREVIOUS ENTRY FWA
          SX4    X1          PREVIOUS FWA WITH RESPECT TO SUBCP
          SB6    B5+         PREVIOUS SUBCP
          BX5    X2          PREVIOUS ENTRY
          LX2    QWNSN-1-QWNSS  RIGHT JUSTIFY NEXT SUBCP
          BX3    -X0*X2      SUBCP
          SX1    X6          FWA OF QUEUE ENTRY RELATIVE TO SUBCP
          NZ     X6,ATW1     IF MORE WORK, EXAMINE NEXT QUEUE ENTRY
          EQ     ATWX        RETURN
 
*         EVENT OCCURRED OR TIMED OUT.
 
 ATW3     ZR     X6,ATW6     IF END OF QUEUE
          ZR     B4,ATW9     IF NO PREVIOUS ENTRY IN QUEUE
          BX3    X2
 
*         SET PREVIOUS QUEUE ENTRY TO NEXT.
 
 ATW4     MX0    60-QWNTN
          LX5    QWNTN-1-QWNTS  RIGHT JUSTIFY NEXT
          BX5    X0*X5       CLEAR PREVIOUS ENTRY NEXT POINTER
          LX3    QWNTN-1-QWNTS
          BX7    -X0*X3      SAVE SUBCP AND FWA OF NEXT ENTRY
          BX7    X5+X7       UPDATE NEXT IN PREVIOUS ENTRY
          LX7    59-59-QWNTN+1+QWNTS
          SA7    B4
 
*         RETURN TO COMPLETE PROCESSOR.
 
 ATW5     SA5    A2+B1       COMPLETE PROCESSOR
          ERRNZ  QWPRW-1     IF COMPLETE PROCESSOR NOT IN WORD 1
          ERRNZ  QWPRS-17    IF COMPLETE PROCESSOR NOT IN BITS 17-0
          SB4    X5          RETURN PROCESSOR ADDRESS
          SB5    A2+         FWA OF ENTRY RELATIVE TO TAF
          JP     B4          RETURN TO COMPLETE PROCESSOR
 
*         WHEN LAST ENTRY IS REMOVED FROM QUEUE, UPDATE LAST IN
*         *TAF* WORK POINTER.
 
 ATW6     ZR     B4,ATW7     IF NO PREVIOUS QUEUE ENTRY
          SA1    TAFQ        POINTER TO FIRST AND LAST WORK
          MX0    -24         MASK FOR FIRST ENTRY IN QUEUE
          SX7    B6          GET SUBCP OF PREVIOUS ENTRY
          LX7    47-5
          SX3    X4          FWA WITH RESPECT TO SUBCP
          BX1    -X0*X1
          LX3    41-17
          BX7    X7+X3       NEW LAST ENTRY
          BX7    X1+X7       ADD NEW LAST ENTRY
          SA7    A1
          SX3    B0          CLEAR NEXT IN PREVIOUS ENTRY
          EQ     ATW4        UPDATE QUEUE  POINTERS
 
*         WHEN NO PREVIOUS ENTRY EXISTS,
*         INITIALIZE *TAF* QUEUE LAST AND FIRST TO ZERO.
 
 ATW7     SA6    TAFQ
          EQ     ATW5        RETURN TO WAITING PROCESSOR
 
*         CHECK FOR EVENT TIME OUT.  IF EVENT TIMED OUT REMOVE
*         ENTRY FROM QUEUE, ELSE CHECK NEXT QUEUE ENTRY.
 
 ATW8     SA3    LTIME       GET REAL TIME
          MX7    -QWTMN      MASK FOR TIME
          BX0    -X7*X3
          SA3    A2+QWTMW
          LX3    QWTMN-1-QWTMS  RIGHT JUSTIFY TIME
          BX3    -X7*X3
          IX3    X0-X3
          MX0    -QWNSN      RESTORE SUBCP MASK
          PL     X3,ATW3     IF EVENT TIMED OUT
          EQ     ATW2        CHECK NEXT QUEUED ENTRY
 
*         UPDATE FIRST WHEN FIRST ENTRY REMOVED FROM QUEUE.
 
 ATW9     SA1    TAFQ        POINTERS TO FIRST AND LAST WORK
          MX5    36
          BX1    X5*X1       CLEAR OLD FIRST POINTER
          LX2    23-59       RIGHT JUSTIFY NEXT IN CURRENT ENTRY
          BX7    -X5*X2      SAVE POINTERS TO NEXT ENTRY
          BX7    X7+X1       UPDATE FIRST
          SA7    A1
          LX2    59-59-23+59
          EQ     ATW5        RETURN TO WAITING PROCESSOR
 QTW      SPACE  4,15
**        QTW - QUEUE *TAF* WORK.
*
*         ENTRY  (X1) = FWA OF EVENT.
*                (X2) = SHIFT TO PLACE EVENT BIT IN BIT 59.
*                (X3) = SUBCP.
*                (X4) = EVENT TYPE.
*                (X5) = EVENT TIMEOUT IN MILLISECONDS.
*                (X6) = RETURN ADDRESS TO PROCESS COMPLETE EVENT.
*                (B3) = FWA TO SAVE WORK PARAMETERS.
*                (B4) = 0, IF QUEUE AT END OF QUEUE.
*                     = 1, IF QUEUE AT BEGINNING OF QUEUE.
*                (TAFQ) = POINTERS TO QUEUED WORK.
*
*         EXIT   (TAFQ) QUEUE POINTERS UPDATED.
*
*         USES   X - ALL.
*                A - 3, 5, 6, 7.
*
*         CALLS  CRA.
 
 
 QTW      SUBR               ENTRY/EXIT
 
*         FORMAT QUEUE ENTRY.
 
          LX5    QWTMS-QWTMN+1  POSITION TIME
          BX7    X5+X6       TIME + RETURN ADDRESS
          ERRNZ  QWTMW-QWPRW IF TIME AND RETURN NOT IN SAME WORD
          LX2    QWSHS-QWSHN+1  POSITION SHIFT
          BX6    X2+X1       SHIFT + EVENT
          ERRNZ  QWSHW-QWEVW IF SHIFT AND EVENT NOT IN SAME WORD
          SX1    B3          FWA TO SAVE WORK POINTERS
          RJ     CRA         COMPUTE REAL ADDRESS FOR WORK QUEUING
          LX3    QWSPS-QWSPN+1  POSITION SUBCP
          BX6    X6+X3
          ERRNZ  QWEVW-QWSPW IF EVENT AND SUBCP NOT IN SAME WORD
          SA7    B5+QWPRW
          LX4    QWTYS-QWTYN+1  POSITION TYPE
          BX6    X4+X6       ADD TYPE
          ERRNZ  QWSPW-QWTYW IF SUBCP AND TYPE NOT IN SAME WORD
          SA5    TAFQ        POINTERS TO FIRST AND LAST QUEUED WORK
          LX5    17-41       RIGHT JUSTIFY LAST POINTERS
          SX1    X5          FWA OF LAST
          SX2    B3+
          LX3    -QWSPS+QWSPN-1  RIGHT JUSTIFY SUBCP
          MX0    -QWNSN
          ZR     X1,QTW1     IF NO PRIOR ENTRIES IN QUEUE
          NZ     B4,QTW2     IF QUEUE AT BEGINNING OF QUEUE
 
*         PUT NEW ENTRY AT END OF QUEUE.
 
          SA6    B5          NEXT QUEUE ENTRY EQUALS ZERO
          LX5    5-47-17+41  POSITION SUBCP
          BX4    X3
          BX3    -X0*X5      SUBCP
          RJ     CRA         COMPUTE REAL ADDRESS USING SUBCP
          SA3    B5          UPDATE PRIOR QUEUE LINK
          LX4    QWNSS-QWNSN+1  POSITION NEXT SUBCP
          SX2    B3          FWA OF NEXT QUEUE ENTRY
          LX2    QWNAS-QWNAN+1  NEXT QUEUE FWA
          BX6    X3+X4       ADD NEXT SUBCP
          BX6    X6+X2       ADD NEXT QUEUE FWA
          SA6    A3
          MX0    -24         UPDATE *TAFQ* LAST
          LX5    -5+47        RESTORE *TAFQ*
          BX6    -X0*X5      SAVE NEXT POINTERS
          LX4    47-5-QWNSS+QWNSN-1  POSITION NEXT SUBCP IN *TAFQ*
          BX6    X6+X4
          LX2    41-17-QWNAS+QWNAN-1  POSITION NEXT QUEUE FWA
          BX6    X2+X6
          SA6    A5
          EQ     QTWX        RETURN
 
*         WHEN NO WORK EXISTS IN QUEUE, SET FIRST EQUAL TO LAST.
 
 QTW1     LX3    23-5        POSITION SUBCP
          BX1    X3+X2       SUBCP + FWA OF QUEUE ENTRY
          SA6    B5+QWEVW    FIRST WORD OF QUEUED EVENT
          BX6    X1
          LX6    47-23       LAST
          BX6    X1+X6       FIRST + LAST
          SA6    A5
          EQ     QTWX        RETURN
 
*         PUT NEW ENTRY AT BEGINNING OF QUEUE.
 
 QTW2     LX5    41-17       UPDATE *TAFQ* FIRST
          LX3    23-5        POSITION SUBCP
          MX0    36
          BX7    X3+X2       SUBCP + FWA OF NEW QUEUE ENTRY
          BX4    X0*X5
          BX7    X4+X7
          SA7    A5
          BX4    -X0*X5
          LX4    QWNTS-QWNTN+1  POSITION NEW ENTRY NEXT POINTERS
          BX6    X4+X6       ADD NEXT POINTERS TO NEW ENTRY
          SA6    B5+QWEVW
          EQ     QTWX        RETURN
 CRA      SPACE  4,15
**        CRA - COMPUTE REAL ADDRESS.
*
*         ENTRY  (X1) = FWA WITH RESPECT TO SUBCP.
*                (X3) = SUBCP.
*
*         EXIT   (B5) = FWA WITH RESPECT TO *TAF*.
*                (X3) = SUBCP.
*
*         USES   X - 2, 3
*                A - 2.
*                B - 5.
 
 
 CRA      SUBR               ENTRY/EXIT
          SB5    X1          ADDRESS WITH RESPECT TO SUBCP
          LX3    SCPAL       LENGTH OF SUBCP ENTRY
          TA2    X3-CPAL,VCPA  FWA OF SUBCP
          ZR     X3,CRAX     IF NO SUBCP, ADDRESS IS RELATIVE TO *TAF*
          SB5    X2-NUAPL    ADDRESS OF TASK SYSTEM AREA
          SB5    B5+X1
          AX3    SCPAL
          EQ     CRAX        RETURN
          TITLE  JOURNAL FILE PROCESSING.
 JRNL     SPACE  4,10
**        JRNL   WRITE A JOURNAL FILE ENTRY.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (B4) = ORIGIN CODE.
*                (B5) = JOURNAL FILE FET ADDRESS.
*                (X0) = C.B. ADDRESS, IF TASK AFFILIATED.
*                     = 0, OTHERWISE.
*                (X5) = START OF JOURNAL MESSAGE (+NUAPL) AND LENGTH.
*                     = 24/ 0, 18/ LENGTH, 18/ FWA OF MESSAGE.
*
*         EXIT   TO *DCPT*, IF NON-BUFFERED JOURNAL FILE.
*                TO *TERR9*, IF TOO MANY WORDS TO JOURNAL.
*                (B2) = FWA OF ACTIVE TASK SYSTEM AREA.
*                (B7) = FWA OF ACTIVE TASK SUBCP TABLE.
*
*         JOURNAL FILE ENTRY HEADERS.
*
*T  W1    24/      SEQ,6/  OR,12/  ,18/      LN
*T, W2    42/     TASK NAME,18/     PT
*T, W3    42/            TN,18/
*
*         WORD 1
*
*         SEQ - SEQUENCE NUMBER IF TASK AFFILIATED.
*         OR  - ORIGIN CODE.
*                0 = TASK ORIGIN.
*                1 = TRANEX ORIGIN.
*                2 = DATA MANAGER ORIGIN (NOT USED).
*                3 = TRANEX RECOVERY/STATISTICAL DATA.
*                4 = END OF TRANSACTION INDICATOR.
*                5 = INCOMPLETE BLOCK OF TERMINAL INPUT DATA.
*                6 = TERMINAL INPUT FOR AN INTERACTIVE TASK.
*                7 = INCORRECT INTER-CONTROL POINT COMMUNICATION.
*                10B = ON-LINE TASK LIBRARY UPDATE.
*                11B = TASK FATAL ERROR (*CDCS* REQUEST).
*                12B = MESSAGE REQUEST WITH ZERO FUNCTION CODE.
*         LN  - LENGTH OF JOURNAL ENTRY (INCLUDING HEADER).
*
*         WORD 2
*
*         TASK NAME - ONLY FOR TASK AFFILIATED MESSAGES.
*         PT  - PACKED TIME  HR/MIN/SEC.
*
*         WORD 3
*
*         TN  - TERMINAL NAME.
*
*         JOURNAL FILE LABEL RECORDS.
*
*T  W1    48/   *TRANEX*,12/
*T, W2    60/   PDATE
*T, W3    42/   FILE NAME,18/
*
*         USES   A - 0, 1, 2, 3, 4, 6, 7.
*                B - 3, 4, 5, 6.
*                X - ALL.
*
*         CALLS  CLJF, ERP, RSP, TRCL.
*
*         MACROS WRITER, WRITEW.
 
 
 JRNL     SA3    B5+7
          SX2    B5          JOURNAL FET ADDRESS
          SX1    X3
 JRNL1    ZR     X1,JRNL14   IF BUFFERED JOURNAL FILE
          SA1    B5
          LX1    59-0
          NG     X1,JRNL4    IF FILE NOT BUSY
 
*         PLACE SUB CONTROL POINT IN RECALL.
 
 JRNL2    SX4    B4
          LX0    36
          SX7    JRNL3       RETURN ADDRESS
          SX3    B5
          BX6    X5+X0
          LX3    18
          IX7    X7+X3       ADD JOURNAL FILE BIAS
          LX4    36
          SA6    B2+RCLA     RECALL STATUS WORD 2
          BX7    X7+X4
          SA7    A6-B1       RECALL STAUS WORD 1
          EQ     TRCL        PLACE SUB CP ON RECALL
 
*         PROCESS SUB CP RETURN FROM RECALL ON JOURNAL REQUEST.
 
 JRNL3    LX1    -18
          SA2    A1+B1       RECALL STATUS WORD 2
          MX3    24
          SB5    X1          JOURNAL FILE FET
          LX1    -18
          BX5    -X3*X2      START OF MESSAGE AREA AND LENGTH
          SB3    TSSC
          SB4    X1          ORIGIN CODE
          LX2    -36
          SX0    X2          C.B. IF TASK AFFILIATED
          SX2    B5
          EQ     JRNL1       TRY JOURNAL REQUEST AGAIN
 
*         PROCESS ANY TAPE ERRORS/END OF TAPE CONDITIONS.
 
 JRNL4    SA1    X2          CHECK FOR ERROR CODES
          MX6    -4
          LX1    -10
          BX6    -X6*X1
          ZR     X6,JRNL6    IF NO ERROR CODES
          SX6    B3
          BX7    X7-X7
          SA0    JRNL5       RETURN ADDRESS
          SA6    B2+RCL
          SB6    B0
          EQ     ERP         PROCESS ERROR CONDITION
 
 JRNL5    SA1    B2+RCL
          SB5    X2          JOURNAL FILE FET ADDRESS
          SB3    X1          RETURN ADDRESS
 
*         SET HEADER AND WRITE UNIT RECORD JOURNAL FILE ENTRY.
 
 JRNL6    RJ     CLJF        CLEAR LOCKS ON JOURNAL FILES
          SB6    X5
          NZ     B4,JRNL7    IF REQUEST NOT FROM A SUB CP
          SB6    X5+B2       ABSOLUTE FWA OF JOURNAL DATA
          SX7    X5+
          SA7    B2+JTSC     SAVE RELATIVE ADDRESS
 JRNL7    SA1    B6-B1
          SA2    A1-B1       SAVE PRIOR 3 WORDS
          BX6    X1
          LX7    X2
          SA6    B2+JTSC+1   SAVE IN SYSTEM AREA IN FRONT OF TASK
          SA3    A2-B1
          SA7    A6+B1
          BX6    X3
          SA6    A7+1
          MX3    -18
          SA2    PDATE       PACKED TIME
          BX2    -X3*X2
          SX6    B0
          SX1    B6+         SAVE (B6)
          SB6    12B
          EQ     B4,B6,JRNL7.1  IF MESSAGE ORIGIN CODE
          NZ     B4,JRNL8    IF NOT TASK AFFILIATED
 JRNL7.1  SA4    B7+2        GET TASK INDEX
          MX7    12
          BX4    X7*X4       TASK INDEX
          SX6    377777B
          LX4    12
          TA3    X4-1,VTLD   GET TASK NAME
          BX6    -X6*X3
 JRNL8    BX6    X6+X2
          SB6    X1          RESTORE (B6)
          SA6    B6-2        TASK NAME + PACKED TIME
          BX4    X4-X4
          SX7    B0
          ZR     X0,JRNL9    IF NOT TASK AFFILIATED
          MX7    -24
          SA3    X0+CMBHL    TRANSACTION SEQUENCE NUMBER
          SA4    A3+B1       TERMINAL NAME
          BX7    -X7*X3
 JRNL9    LX7    -24
          SX3    B4          ORIGIN CODE
          LX5    -18
          LX3    30
          SX2    X5+3        LENGTH OF JOURNAL ENTRY
          MX6    42
          IX7    X7+X2
          BX6    X6*X4       TERMINAL NAME
          IX7    X7+X3
          SA7    B6-3
          SA6    A6+B1
          NZ     B4,JRNL13   IF NOT FROM A SUB CONTROL POINT
          LX5    18
 
*         SET LOCK OUT ON STORAGE MOVE AND FILE FOR DURATION OF WRITE.
 
          SA1    JRNLB       GET STATUS OF NON BUFFERED JOURNAL FILES
          SX7    B5          JOURNAL FILE FET ADDRESS
          SX6    X1
          NZ     X6,JRNL10   IF FIELD IN USE - TRY NEXT FIELD
          BX6    X1+X7
          MX4    1
          EQ     JRNL12      SET LOCK OUT
 
 JRNL10   LX1    -18
          SX2    X1
          SX7    B5          JOURNAL FILE FET ADDRESS
          BX6    X1+X7
          NZ     X2,JRNL11   IF FIELD IN USE - TRY NEXT FIELD
          LX6    18
          MX4    1
          EQ     JRNL12      SET LOCK OUT
 
 JRNL11   LX1    -18
          SX2    X1+
          BX6    X1+X7
          NZ     X4,JRNL2    IF ALL FIELDS IN USE - PLACE TASK ON RECALL
          LX6    18+18
          MX4    1
 JRNL12   SA3    B7          SUB CP CONTROL WORD 1
          SA6    A1          SET FILE LOCK OUT
          BX7    X4+X3
          SA7    B7          SET STORAGE MOVE LOCK OUT
          SA1    B5+5
          MX4    -18
          SX3    B7          SUB CONTROL POINT AREA
          BX7    X4*X1
          BX7    X7+X3
          LX5    -18
          SA7    A1          SET FLAG TELLING WHICH SUB CP USING FILE
 
*         SET UP FET FOR WRITE.
 
 JRNL13   SA1    B5+B1       FIRST
          SA2    B5+FEMGW
          BX3    X3-X3
          MX4    60-FEFRN
          SX7    B6-3
          NG     X2,JRNL13.1 IF TAPE
          SX6    B5+FECRW    SET RETURN RANDOM INDEX ADDRESS
          SA6    B5+FERRW
          SX3    B1
          BX6    X6-X6
          SA6    B5+FECRW    CLEAR OLD RANDOM INDEX
          SA7    B5+FEOOW
 JRNL13.1 LX3    FERMS-0     ADD RANDOM ACCESS FLAG
          BX6    X4*X1       MASK OFF OLD FIRST ADDRESS
          SA7    A1+2        OUT
          BX6    X6+X7
          BX6    X3+X6
          SB6    X5+3        NUMBER OF WORDS TO JOURNAL
          SX7    X7+B6
          SA7    A7-B1       IN
          SA3    B5+4        LIMIT
          SA6    A1
          BX4    X4*X3
          SX7    X7+1
          BX7    X7+X4
          SA7    A3
          SX3    B6-MAXJL-1
          PL     X3,TERR9    IF TOO MANY WORDS TO JOURNAL
          WRITER B5+         INITIATE WRITE ON JOURNAL FILE
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 
*         PROCESS BUFFERED JOURNAL FILE ENTRIES.
 
 JRNL14   SX2    X5          START OF MESSAGE
          NZ     B4,JRNL15   IF NOT TASK AFFILIATED
          SX2    X2+B2       ADD SUB CONTROL POINT BIAS
 JRNL15   LX5    -18
          SA1    X2-1        SAVE THREE WORDS PRIOR TO JOURNAL MESSAGE
          SA4    A1-B1       SECOND WORD TO SAVE
          BX6    X1
          SA6    JRNLA       STORAGE AREA FOR WORDS SAVED
          BX7    X4
          SA3    A4-B1       THIRD WORD TO SAVE
          SA7    A6+B1
          BX6    X3
          SA6    A7+B1
          MX3    -18
          SA1    PDATE       PACKED TIME
          MX7    12
          BX1    -X3*X1
          SX6    B0
          SB6    12B
          EQ     B4,B6,JRNL15.1  IF MESSAGE ORIGIN CODE
          NZ     B4,JRNL16   IF NOT TASK AFFILIATED
 JRNL15.1 SA4    B7+2        GET TASK INDEX
          MX6    42
          BX4    X7*X4       TASK INDEX
          LX4    12
          TA3    X4-1,VTLD   GET TASK NAME
          BX6    X6*X3
 JRNL16   BX6    X6+X1       TASK NAME + PACKED TIME
          SX3    X5+3        LENGTH OF JOURNAL ENTRY
          BX4    X4-X4
          SX7    B0
          ZR     X0,JRNL17   IF NOT TASK AFFILIATED
          MX7    -24
          SA1    X0+CMBHL    TRANSACTION SEQUENCE NUMBER
          SA4    A1+B1       TERMINAL NAME
          BX7    -X7*X1
 JRNL17   SA6    X2-2        STORE TASK NAME
          LX7    -24
          SX5    B4          ORIGIN CODE
          LX5    30
          BX7    X7+X3       SEQUENCE NUMBER AND LENGTH
          MX1    42
          IX7    X7+X5       ADD ORIGIN CODE
          BX6    X1*X4       TERMINAL NAME
          SA7    A6-B1
          SA6    A6+B1
          SX5    A7          ADDRESS OF FIRST WORD OF JOURNAL MESSAGE
          SX1    X3-MAXJL-1
          PL     X1,TERR9    IF TOO MANY WORDS TO JOURNAL
          SA0    B3          SAVE RETURN ADDRESS
          SA1    B5+FEMGW
          LX1    59-FEMGS
          NG     X1,JRNL18   IF TAPE
          RJ     JSC         JOURNAL STATUS CHECK
          SX7    B1          SET RANDOM ACCESS FLAG
          SA2    B5+FERMW
          LX7    FERMS-0
          BX7    X2+X7
          SA7    A2
          BX6    X6-X6       CLEAR CURRENT EOI RANDOM INDEX
          SA1    B5+FEOUW    SAVE OLD OUT POINTER
          SA6    B5+FECRW
          SX7    A6
          BX6    X1
          SA7    B5+FERRW    SET RETURN EOI INDEX ADDRESS
          SA6    B5+FEOOW
 JRNL18   WRITEW B5,X5,X3    WRITE JOURNAL FILE
          RJ     RSP         RESTORE (B2) AND (B7)
          SA1    JRNLA       RESTORE HEADER WORDS
          SA2    A1+B1
          SA3    A2+B1
          BX6    X2
          SB3    A0+         RESTORE RETURN ADDRESS
          BX7    X1
          SA6    X5+B1       SECOND WORD OF HEADER
          SA7    A6+B1       THIRD WORD
          BX7    X3
          SA7    A6-B1       FIRST WORD
          JP     B3          RETURN
 
 JRNLA    BSS    3           STORAGE AREA FOR WORDS DESTROYED BY JOURNAL
                             FILE HEADER
 
 JRNLB    BSSZ   1           WORD FOR NON BUFFERED JOURNAL FILE LOCKS
 JSC      SPACE  4,15
**        JSC - JOURNAL FILE STATUS CHECK.
*
*         ENTRY  (B5) = FWA OF FET.
*                (X3) = LENGTH OF DATA IN WORDS TO JOURNAL.
*
*         EXIT   FILE IS READY TO JOURNAL.
*
*         USES   X - 1, 2, 4.
*                A - 1, 2, 4.
*                B - 3, 4, 6.
*
*         MACROS RECALL.
 
 
 JSC      SUBR               ENTRY/EXIT
          SA1    B5          CHECK COMPLETION FLAG
          LX1    59-FECLS
          SA2    B5+FEINW    GET IN
          NG     X1,JSCX     IF PREVIOUS REQUEST COMPLETED
          SA1    B5+FEOUW    GET OUT
          SX2    X2
          SX1    X1
          SB4    X2
          SB6    X1
          EQ     B4,B6,JSCX  IF BUFFER EMPTY
          GT     B6,B4,JSC2  IF OUT IS GREATER THAN IN
          SB3    X3
          SA4    B5+FEFRW    GET FIRST
          SX4    X4
          IX1    X1-X4       SPACE BETWEEN FIRST AND OUT
          SA4    B5+FELIW    GET LIMIT
          SX4    X4
          IX2    X4-X2       SPACE BETWEEN IN AND LIMIT
          IX1    X1+X2
          SB6    X1-1        AVAILABLE SPACE
          GE     B6,B3,JSCX  IF ENOUGH SPACE
 JSC1     RECALL B5
          EQ     JSCX        RETURN
 
 JSC2     SB4    B6-B4
          SB3    X3
          GE     B4,B3,JSCX  IF ENOUGH SPACE
          EQ     JSC1        RECALL
 ERP      SPACE  4,10
**        ERP    PROCESS READ/WRITE FILE ERRORS.
*
*         ENTRY  (A0) = RETURN ADDRESS (POSITIVE IF JOURNAL FILE).
*                (X2) = FET ADDRESS.
*                (X7) = CIO FUNCTION CODE (NEGATIVE IF WITH AUTO RECALL)
*                     = 0 IF RETURN TO (A0) AFTER ERROR PROCESSING.
*                (B6) = FWA ADDRESS WORKING BUFFER.
*                (B7) = NUMBER OF WORDS LEFT TO TRANSFER.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3.
 
 
 ERP5     SB3    A0
          JP     B3          RETURN
 
 ERP      SA1    X2          GET ERROR CODE
          MX6    -5
          SB3    A0          CHECK FOR NON JOURNAL FILE ERROR
          LX6    10
          BX4    -X6*X1
          BX6    X6*X1       CLEAR OUT ERROR CODE
          PL     B3,ERP1     IF ERROR ON JOURNAL FILE WRITE
          SB3    -B3
          SX3    X4          ERROR CODE
          BX4    X4-X4
          SA0    B3          ERROR RETURN ADDRESS
 ERP1     SA6    A1
          ZR     X4,ERP5     IF NO ABNORMAL CONDITIONS
          SX3    B6
          SA5    A1+1
          PL     X5,ERP5     IF NOT A TAPE FILE
          SX6    B7
          SA7    ERPA+1      SAVE X7
          LX3    18
          SX1    6000B
          BX6    X3+X6       SAVE B6 AND B7
          BX1    -X1*X4
          NZ     X1,ERP5     IF OTHER THAN PARITY/END OF REEL ERROR
          SA6    ERPA
          SA1    X2+B1       FIRST
          SA3    A1+B1       SAVE IN AND OUT POINTERS
          SX6    X1
          SA4    A3+B1
          LX3    18
          SA6    A3          SET OUT = IN = FIRST
          BX7    X3+X4
          SA6    A4
          SA7    ERPB
          SA4    CIO=        CIO= RETURN ADDRESS
          CLOSER X2,UNLOAD,R CLOSE OUT TAPE FILE
          SA1    ASEQ
          BX7    X4
          MX6    36
          SA7    CIO=        RESTORE CIO= RETURN ADDRESS
          NZ     X1,ERP3     IF TAPE(S) PREASSIGNED
          SA1    X2
          SX3    100B+1RT
          LX3    -6          REASSIGN *TXXJORN* TO *XXJORN*
          BX6    X6*X1
          LX6    -6
          BX6    X6+X3       *TXXJORN*
          SA6    A1
          RENAME X2,X1       RENAME DISK JOURNAL FILE TO *XXJORN*
 ERP2     SA1    ERPB        RESTORE IN AND OUT
          SX6    X1
          LX1    -18
          SA6    X2+3        OUT
          SX7    X1
          SA7    A6-B1       IN
          SA4    CIO=
          WRITER X2,R        EMPTY BUFFER WITH EOR WRITE
          BX7    X4
          SA7    A4          RESTORE ORIGINAL CIO= EXIT ADDRESS
          SA1    ERPA
          SB7    X1+         RESTORE B6 AND B7
          SA3    A1+B1
          LX1    -18
          SB6    X1
          BX7    X3          RESTORE X7
          ZR     X3,ERP5     IF NOT CALLED BY CIO=
          JP     CIO=+1      RESTART CIO=
 
*         ASSIGN NEW TAPE TO FILE.
 
 ERP3     SX3    X1
          NZ     X3,ERP4     IF FET ADDRESS IN LOWER FIELD
          AX1    18
 ERP4     SA3    X1
          AX1    18          CLEAR FET ADDRESS
          BX7    X1
          SA1    X2          *XXJORN* FILE NAME
          BX6    X3
          SA7    ASEQ
          SA6    X2
          RENAME X2,X1       RENAME SCATCH TAPE FILE TO JOURNAL FILE
          JP     ERP2        CONTINUE WRITE ON NEW TAPE
 
 ERPA     BSS    2           STORAGE FOR B6/B7 AND X7 ENTRY PARAMETERS
 ERPB     BSS    1           STORAGE FOR IN AND OUT FET POINTERS
          TITLE  UPDATE K-DISPLAY.
 KDIS     SPACE  4,10
**        KDIS - UPDATE OPERATOR *K-DISPLAY*.
*
*         KDIS IS PERIODICALLY CALLED TO UPDATE THE OPERATOR
*         *K-DISPLAY*.  IF PREVIOUSLY ENTERED COMMANDS ARE INCOMPLETED,
*         THEN THE PARAMETERS ARE RESTORED AND THE ROUTINE ENTERED
*         FOR COMPLETION.
*
*         ENTRY  (KBUF) .NE. 0 - IF OPERATOR COMMAND TO BE EXECUTED.
*                (KDISA) .NE. 0 - IF RETRY OF  INCOMPLETED COMMAND.
*
*         EXIT   TO *IDL1* - IF RETRY OF *ITASK* IDLE DOWN REQUEST.
*                TO *PCMD* - IF *K-DISPLAY* COMMAND PRESENT.
*                TO *ULD0* - IF RETRY OF TASK LIBRARY DIRECTORY UPDATE.
*                (SBUF - SBUF+1) UPDATED - IF TRANSFER TO *ULD0*.
*
*         USES   A - 1, 3, 4, 6, 7.
*                X - 1, 2, 3, 4, 5, 6, 7.
*                B - 3.
*
*         CALLS  CDD, COD, LOVL, RCPU, RSP.
*
*         MACROS PDATE.
 
 
 KDIS     SUBR               ENTRY/EXIT
          SA5    KBUF
          SX7    A5+
          SA7    PCMDC
          NZ     X5,PCMD     IF *K-DISPLAY* COMMAND PRESENT
 
*         UPDATE K-DISPLAY.
 
 KDIS1    SA1    AVAILCM     UNUSED FIELD LENGTH
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          SA6    KUNSF+3     UNUSED FIELD LENGTH
          SA1    MFL         MAXIMUM REQUESTABLE FIELD LENGTH
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          SA6    KMXMF+3
          SA1    TSEQ        TRANSACTION SEQUENCE NUMBER
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          SA6    KCRSN+1
          SA6    KSEQ+1      SET IDLE *K-DISPLAY*
          SA1    GTDL        GLOBAL TASK DUMP LIMIT
          SA4    KDISD       *DUMPS LOST*
          BX6    X4
          NG     X1,KDIS2    IF GLOBAL TASK DUMP FLAG SET
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
 KDIS2    SA6    KGTDL+3     *GTDL* INTO  K-DISPLAY
          RJ     RSP         RESTORE SUBCONTROL POINT REGISTERS
          PDATE  PDATE       UPDATE PACKED DATE/TIME
 
*         CHECK FOR TIME DELAYED ROUTINE RESTARTS.
 
          SA1    KDISA       TIME DELAY STATUS WORD
          ZR     X1,KDIS4    IF NO RETRIES
          MX2    42
          SB3    X1          RETRY IDLE DOWN FLAG
          BX7    X2*X1
          SA7    A1          CLEAR STATUS
          ZR     B3,KDIS3    IF NOT IDLE DOWN RESTART
          SA1    LOVE
          RJ     LOVL        LOAD OVERLAY
          EQ     IDL1        RETRY IDLE DOWN *ITASK* REQUEST
 
*         PROCESS RETRY OF *LIBTASK,TT* REQUEST.
 
 KDIS3    BX7    X7-X7       CLEAR STATUS
          MX6    42
          SA7    A1
          BX6    X6*X1       USER NAME
          SA6    SBUF+1
          SA1    LOVF        LOAD OVERLAY
          SA3    KDISC       READ TASK LIBRARY NAME
          SX2    B1
          BX6    X3
          BX1    X1+X2
          SA6    A6+B1
          SA7    A7+1
          RJ     LOVL        LOAD OVERLAY
          SA4    SBUF
          EQ     ULD0        RETRY TASK LIBRARY UPDATE
 
*         CHECK FOR TASK NEEDING SCREEN REFRESH.
 
 KDIS4    SA1    KDISB
          BX2    X1          C. B. ADDRESS OF DISPLAY TASK
          LX1    59-56
          NG     X2,KDISX    IF NO K-DISPLAY TASK ACTIVE
          PL     X1,KDISX    IF NO SCREEN REFRESHING NEEDED
          SA1    KDISF       TIME OF THE LAST *CTI8* REQUEST
          SA2    ITIME
          SX3    RFRTL
          MX6    24
          IX1    X2-X1       TIME SINCE LAST DISPLAY
          BX1    -X6*X1
          IX3    X1-X3
          NG     X3,KDISX    IF NOT ENOUGH TIME ELAPSED
          SB2    B0
          SA2    KDISG
          SA4    X2
          SB3    KDISX       EXIT ADDRESS
          MX6    -18
          BX4    -X6*X4      TASK RA
          SX4    X4-NUAPL
          SB6    X2+
          EQ     RCPU        REQUEST CPU FOR THE TASK
 
 KDISA    BSS    1           RESTART ROUTINE AFTER TIME DELAY
 
*         KDISB - TASK *K-DISPLAY* INTERLOCK WORD.
*
*T        1/R,1/I,1/K,1/P,20/,18/MADDR,18/CBADDR
*
*         R = DISPLAY TASK HAS BEEN SCHEDULED BUT
*             HAS NOT YET ACQUIRED THE SCREEN(SCPT=0).
*         I = DISPLAY TASK INPUT READY.
*         K = *KDIS* IS ASSIGNED TO THE *K-DISPLAY*.
*         P = THE TASK IS PERIODICALLY RECALLED TO REFRESH *K-DISPLAY,
*             EVEN IF THERE IS NO INPUT(SEE *RFRTL*).
*         MADDR = FWA OF MESSAGE WITHIN TASK FL.
*         CBADDR = C.B. ADDRESS OF THE DISPLAY TASK
 
 KDISB    BSS    1           TASK *K-DISPLAY* INTERLOCK WORD.
 KDISC    BSS    1           PARAMETER FOR RESTART ROUTINE
 KDISD    DATA   H*DUMPS LOST*
 KDISE    BSS    1           NAME OF TASK DRIVING *K-DISPLAY*
 KDISF    BSS    1           TIME OF LAST *CTI8* REQUEST BY
 KDISG    BSS    1           SUBCP ADDRESS
*                            DISPLAY-DRIVING TASK.
 ASEQ     BSSZ   1           ASSIGNED EQUIPMENT
 PCMD     SPACE  4,20
**        PCMD   PROCESS OPERATOR K-DISPLAY COMMAND.
*
*                PCMD USES UPC TO UNPACK THE COMMAND, SO ANY LEGAL
*                COMMAND FORMAT CAN BE USED IN DELIMITING A
*                K-DISPLAY COMMAND.
*
*         ENTRY  (X5) = FIRST WORD OF COMMAND.
*                (A5) = ADDRESS OF FIRST WORD.
*                (KBUF - KBUF+4) = K-DISPLAY COMMAND IF FROM CONSOLE.
*                (PCMDA - PCMDA+7) = K-DISPLAY COMMAND IF FROM TASK.
*                (PCMDB) = IF TASK INITIATED, 6/0,18/TO,18/SA,18/SCPA.
*                        = IF FROM CONSOLE, 60/0.
*                          TO = TERMINAL ORDINAL.
*                          SA = START OF SYSTEM AREA FOR TASK.
*                          SCPA = SUB-CONTROL POINT AREA FOR TASK.
*                (PCMDC) = ADDRESS OF COMMAND BUFFER.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 2, 3, 7.
*
*         CALLS  DSDM, LOVL, PTK, UPC, ZTB.
*
*         MACROS MOVE.
 
 
 PCMD     SA1    PCMDB
          NZ     X1,PCMD0    IF TASK INITIATED
          MOVE   5,KBUF,KINP+1  ECHO *DSD* INPUT TO K-DISPLAY
          SA1    KDISB
          ZR     X1,PCMD0    IF K-DISPLAY NOT ASSIGNED TO ANY TASK
          NG     X1,PCMD4    IF SUBCP ADDRESS NOT IN *KDISG*
          LX1    59-57
          NG     X1,PCMD0    IF *KDIS* HAS THE SCREEN
          SA2    KDISG       SUBCP ADDRESS
          SA4    X2+         FIRST WORD OF SUBCP ENTRY
          MOVE   5,KBUF,X4+TDUA  ECHO PACKED INPUT TO C. B.
 PCMD0    SA1    KBUF        ALLOW MISSING TERMINATOR
          SB3    5
          SB2    B0+
 PCMD0.1  RJ     ZTB         CONVERT TRAILING ZEROES TO BLANKS
          SA6    A1
          SB2    B2+B1
          SA1    A1+1
          LT     B2,B3,PCMD0.1  IF NOT END OF INPUT BUFFER
          SA5    A5+
          SX6    B0+
          SB7    SBUF        ADDRESS TO PLACE FIRST PARAMETER
          SA6    B7+         CLEAR FIRST WORD OF BUFFER
          RJ     UPC         UNPACK K-DISPLAY COMMAND
          RJ     PTD         PROCESS TASK K-DISPLAY, IF ANY
          NZ     X6,PCMD3    IF ERROR IN COMMAND FORMAT
          SA1    SBUF        K-DISPLAY COMMAND
          SX2    B1
          LX2    17
          BX1    X2+X1
          MX6    24
          SA2    KILL        BLANK OUT ERROR MESSAGE LINE
          SA4    PCMDI
          BX7    X4
          BX2    X6*X2       SAVE COORDINATES
          BX6    -X6*X4      EXTRACT TRAILING BLANKS
          BX6    X2+X6
          SA7    A2+1
          SB2    B6+
          SA6    A2+
          RJ     LOVL        LOAD OVERLAY AND PROCESS COMMAND
 
 PCMD1    SX7    KDM1
          EQ     DSDM        ISSUE *INCORRECT STATEMENT.* MESSAGE
 
 PCMD2    SX7    KDM2
          EQ     DSDM        ISSUE *DROP IGNORED.* MESSAGE
 
 PCMD3    SX7    KDM3
          EQ     DSDM        ISSUE *FORMAT MESSAGE.* MESSAGE
 
 PCMD4    SX7    KDM4
          EQ     DSDM        ISSUE *SYSTEM BUSY.* MESSAGE
 
 PCMD6    SX7    KDM6
          EQ     DSDM        ISSUE *NOT AVAILABLE.* MESSAGE
 
 
 
*         COMMON RETURN ADDRESS FOR COMMAND PROCESSORS.
 
 PCMDX    SA1    PCMDB
          BX7    X7-X7
          SA7    A1
          SA7    KBUF        REMOVE ENTRY FROM BUFFER
          ZR     X1,KDIS1    IF COMMAND NOT FROM A TASK
          SB7    X1
          LX1    -18         RESTORE B2 AND B7
          SB2    X1+
          EQ     TSSC        ENTER TASK SWITCHING LOOP
 
*         ENTRY POINT FOR POST LIBTASK TT REQUEST.
 
 PCMD7    SB3    PCMD8       RETURN ADDRESS FROM *ESCP*
          SA1    PCMDD       SUBCONTROL POINT ADDRESS
          SB6    X1
          BX7    X7-X7       CLEAR SUBCP ADDRESS AND LIBTASK ACTIVE
          SA7    A1+
          SA7    PCMDF
          EQ     ESCP1       RELEASE MEMORY AND SUBCONTROL POINT
 
*         TASK LIBRARY UPDATE COMPLETE.
 
 PCMD8    SB5    -PCMDE      COMPLEMENT OF FWA OF MESSAGE
          RJ     PNM         PUT NAME IN MESSAGE
          EQ     TSSC        EXIT TO SWITCHING LOOP
 
*         TASK LIBRARY UPDATE FAILED.
 
 PCMD9    SA1    PCMDD       SUBCONTROL POINT ADDRESS
          BX7    X7-X7       CLEAR SUBCP ADDRESS AND LIBTASK ACTIVE
          SA7    A1+
          SA7    PCMDF
          ZR     X1,TSSC     IF NO SUBCP PRESENT
          SB3    TSSC        RETURN ADDRESS
          SB6    X1          SUBCP ADDRESS
          EQ     ESCP1       RELEASE MEMORY AND SUBCONTROL POINT
 
 PCMDA    BSS    8           TASK INITIATED K-DISPLAY COMMAND BUFFER
 PCMDB    BSSZ   1           TASK INITIATED K-DISPLAY SAVE AREA
 PCMDC    BSS    1           ADDRESS OF COMMAND BUFFER
 PCMDD    BSSZ   1           STORAGE FOR SUBCONTROL POINT ADDRESS
 PCMDE    DATA   C* LIBRARY UPDATED - XXXXXXX, +++++++.*
 PCMDF    BSSZ   1           LIBTASK ACTIVE FLAG
 PCMDG    BSSZ   1           USER NAME
 PCMDH    BSSZ   1           TASK LIBRARY NAME
 PCMDI    DATA   10H
 PNM      SPACE  4,20
**        PNM - PUT NAME IN MESSAGE.
*
*         ENTRY  (B5) = COMPLEMENT OF FWA OF MESSAGE.
*                (PCMDG) = USER NAME.
*                (PCMDH) = TASK LIBRARY NAME.
*
*         EXIT   (B2) = FWA OF ACTIVE TASK SYSTEM AREA.
*                (B7) = FWA OF ACTIVE TASK SUBCP TABLE.
*
*         USES   X - 1.
*                B - 2, 3, 5.
*                A - 1.
*
*         CALLS  RSP, SNM.
*
*         MACROS MESSAGE.
 
 
 PNM      SUBR               ENTRY/EXIT
          SB2    1RX         REPLACEMENT CHARACTER
          SA1    PCMDH       TASK LIBRARY NAME
          SB3    DAYB        ALTERNATIVE ASSEMBLY AREA
          RJ     SNM         SET NAME IN MESSAGE
          SB5    DAYB        FWA OF MESSAGE
          SA1    PCMDG       USER NAME
          SB2    1R+         REPLACEMENT CHARACTER
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE DAYB,3     DISPLAY DAYFILE MESSAGE
          MESSAGE VERM,1     VERSION NUMBER
          RJ     RSP         RESTORE SUBCP REGISTERS
          EQ     PNMX        RETURN
          SPACE  4,25
**        PTD - PROCESS TASK *K-DISPLAY* INPUT.
*
*         THIS SUBROUTINE WILL MOVE THE TASK INPUT FROM *SBUF*
*         TO TASK FIELD LENGTH, PLACING IT IN ITS COMMUNICATION
*         BLOCK.  THE CPU FOR THE TASK WILL THEN BE REQUESTED.
*
*         ENTRY  (X6) = 0 IF NO ERROR FROM *UPC*.
*                (B6) = NUMBER OF WORDS IN *SBUF*.
*                (SBUF) = UNPACKED TASK INPUT, IF NO ERROR FROM *UPC*.
*
*         EXIT   (X6) = ENTRY VALUE, IF *K-DISPLAY* NOT ASSIGNED TO ANY
*                TASK OR IF *KDIS* HAS THE SCREEN.
*                (KDISB) = BIT 58 SET, IF INPUT MOVED TO TASK FL.
*                TO *PCMD4*, IF PREVIOUS INPUT NOT YET PROCESSED
*                            BY THE TASK.
*                TO *PCMDX*, IF CPU FOR THE TASK REQUESTED.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  RCPU.
 
 
 PTD      SUBR               ENTRY/EXIT
          SA1    KDISB
          ZR     X1,PTDX     IF *K-DISPLAY* NOT ASSIGNED TO ANY TASK
          MX7    1
          LX1    59-57
          NG     X1,PTDX     IF *KDIS* HAS THE SCREEN
          LX1    59-58-59+57
          NG     X1,PCMD4    IF PREVIOUS INPUT NOT PROCESSED
          BX7    X1+X7       SET *INPUT READY* BIT
          SA2    KDISG       SUBCP ADDRESS
          LX7    58-59
          SA7    A1+
          SA1    X2+         FIRST WORD OF SUBCP ENTRY
          ZR     X6,PTD2     IF NO ERROR FROM *UPC*
          SA4    PCMDI
          SB3    SBUF+1
          SB6    4
          BX6    X4
          SA6    B3-1        SUBSTITUTE BLANK WORD FOR ILLEGAL COMMAND
          BX6    X6-X6
 PTD1     SA6    B3          CLEAR REST OF BUFFER
          SB6    B6-B1
          SB3    B3+1
          NZ     B6,PTD1     IF NOT END OF BUFFER
          SB6    1           SET WORD COUNT TO REFLECT THE BLANK WORD
 PTD2     SB3    B6          SAVE LENGTH OF UNPACKED MESSAGE IN WORDS
          SB6    B6-1
          SA1    X1+TNAM+1   FIRST WORD OF DATA INPUT AREA IN C. B.
 PTD3     SA2    SBUF+B6     MOVE MSG TO COMMUNICATION BLOCK
          BX6    X2
          SA6    A1+B6
          SB6    B6-B1
          PL     B6,PTD3     IF NOT ENTIRE MESSAGE MOVED
          BX6    X6-X6
 PTD4     SB6    B3-CBDL
          SB6    -B6         NUMBER OF WORDS TO ZERO OUT IN INPUT AREA
          NG     B6,PTD5     IF MESSAGE COMPLETELY FILLS THE INPUT AREA
          ZR     B6,PTD5     IF MESSAGE COMPLETELY FILLS THE INPUT AREA
          SA6    A1+B3       CLEAR DATA INPUT AREA
          SB3    B3+B1
          EQ     PTD4        CLEAR REST OF DATA INPUT AREA
 
 PTD5     MX6    -18
          SA4    KDISG
          SB6    X4
          SA4    X4          SUBCP ADDRESS
          BX4    -X6*X4      TASK RA
          SB3    PCMDX
          SB2    B0          CLEAR RESIDUE FROM *UPC*
          SX4    X4-NUAPL
          EQ     RCPU        REQUEST CPU FOR THE TASK
 KSC1     SPACE  4
 KCTRL1   VFD    1/0,1/1,4/0,18/KBUF,18/0,18/KFRM
 KFRM     VFD    12/0,36/0,12/2
          KDL    28,T,(TAF STATUS)
 KCRSN    KDL    35,,(                )
          KDL    15,K,(TRANSACTION SEQUENCE NUMBER)
 KUNSF    KDL    15,K,(UNUSED FIELD LENGTH                 )
 KMXMF    KDL    15,K,(MAXIMUM FIELD LENGTH                )
 KGTDL    KDL    15,H,(GLOBAL TASK DUMP LIMIT              )
          KDL    19,H,(CMDUMP/DSDUMP DEFAULT VALUES)
          KDL    7,H,(OPTION                      DESCRIPTION)
 KDFWA    KDL    3,,( FW = "DFWAM")
          KDL    22,K,(FWA OF TASK MEMORY TO BE DUMPED.)
 KDLWA    KDL    3,,( LW = "DLWAM")
          KDL    22,K,(LWA OF TASK MEMORY TO BE DUMPED.)
 KDEXP    KDL    3,,( EP = "DEXPM")
          KDL    22,K,(IF EP=1, DUMP EXCHANGE PACKAGE.)
          KDL    22,K,(IF EP=0, DO NOT DUMP EXCHANGE PACKAGE.)
 KDORT    KDL    3,,( OQ = "DORTM")
          KDL    22,K,(OUTPUT QUEUE.)
 KDQDS    KDL    3,,( QD = "DQDSM")
          KDL    22,K,(QUEUE DESTINATION.)
 KILL     KDL    7,M,(                )
 KINP     KDL    1,I,(
,      )
          BSSZ   1
          SPACE  4,25
**        DSDM   DISPLAY DIAGNOSTIC K-DISPLAY MESSAGE.
*
*         IF THE K-DISPLAY COMMAND ORIGINATED FROM THE CONSOLE,
*         THE DIAGNOSTIC MESSAGE WILL BE DISPLAYED ON THE K-DISPLAY.
*         IF THE K-DISPLAY COMMAND ORIGINATED FROM A TASK, THE
*         DIAGNOSTIC MESSAGE WILL BE DISPLAYED AT THE ORIGINATING
*         TERMINAL.  THIS IS DONE BY SCHEDULING THE SYSTEM TASK,
*         *SYSMSG*.  IF THE REQUEST TO SCHEDULE *SYSMSG* IS UNSUC-
*         CESSFUL, THE ORIGINATING TASK IS RECALLED.  UPON RETURN,
*         AN ATTEMPT IS MADE TO SCHEDULE *SYSMSG* AGAIN.  THIS
*         REPEATS UNTIL *SYSMSG* IS SCHEDULED.
*
*         ENTRY  (X7) = K-DISPLAY MESSAGE CODE.
*                (SBUF) = FIRST WORD OF THE ATTEMPTED K-DISPLAY
*                         COMMAND OR ZERO.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 7.
*
*         CALLS  TRN, TRCL2.
*
*         MACROS MOVE.
 
 
 DSDM     SA2    PCMDB
          NZ     X2,DSDM1    IF COMMAND IS FROM A TASK
 
*         SEND A DIAGNOSTIC MESSAGE TO THE CONSOLE.
 
          SA1    KILL
          SX7    X7-1
          SX4    2
          IX4    X4*X7
          MX3    24
          SA2    X4+DSDMA    FIRST WORD OF MESSAGE
          BX1    X3*X1       EXTRACT DISPLAY COORDINATES
          BX2    -X3*X2
          BX7    X1+X2       ADD COORDINATES TO THE MESSAGE
          SA7    A2
          MOVE   2,A2,KILL   MOVE MESSAGE TO DISPLAY BUFFER
          EQ     PCMDX       RETURN
 
*         SEND A DIAGNOSTIC MESSAGE TO A TERMINAL.
 
 DSDM1    LX2    -36
          SA5    SBUF        FIRST WORD OF ATTEMPTED COMMAND
          SX2    X2          TERMINAL ORDINAL
          ZR     X2,PCMDX    IF TASK NOT OF TERMINAL ORIGIN
          LX2    18
 DSDM2    SX6    4001B       BUFFER FUNCTION CODE
          SA7    DSDMD       SAVE THE MESSAGE CODE IN BUFFER
          LX6    48
          BX6    X6+X2
          SX4    3           WORD COUNT
          BX6    X6+X4
          SA6    DSDMC       BUFFER CONTROL WORD
          BX7    X5
          SA7    DSDME       SAVE FIRST WORD OF ATTEMPTED COMMAND
          SB3    DSDMC       FIRST WORD OF THE BUFFER
          SA4    DSDMB       TASK NAME TO SCHEDULE
          SX5    CSMSG       SYSTEM MESSAGE CODE
          SX7    B0+         SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         SCHEDULE *SYSMSG*
          NZ     X0,PCMDX    IF *SYSMSG* WAS SCHEDULED
 
*         RECALL THE ORIGINATING TASK AND ATTEMPT SCHEDULING LATER.
 
          SA2    PCMDB       RESTORE B2 AND B7
          SB7    X2
          AX2    18
          SA3    DSDMD       MESSAGE CODE
          SB2    X2
          LX3    18
          SA4    DSDME       FIRST WORD OF ATTEMPTED COMMAND
          SX5    DSDM3
          BX7    X5+X3
          BX6    X4
          SA6    B2+RCLA     SAVE ATTEMPTED COMMAND
          EQ     TRCL2       RECALL TASK
 
*         RESTORE THE REGISTERS AND TRY TO SCHEDULE *SYSMSG* AGAIN.
 
 DSDM3    SA2    B2+CB2C     SYSTEM AREA WORD 2
          AX1    18          RESTORE MESSAGE CODE
          SX6    B2          SAVE (B2)
          SX3    B7          SAVE (B7)
          LX6    18
          SX7    X1
          AX2    42          TERMINAL ORDINAL
          BX6    X6+X3
          SA5    B2+RCLA     FIRST WORD OF ATTEMPTED COMMAND
          LX2    18
          SA6    PCMDB       SAVE B2 AND B7
          EQ     DSDM2       TRY TO SCHEDULE *SYSMSG* AGAIN
 
*         THE FOLLOWING IS A TABLE OF K-DISPLAY COMMAND DIAGNOSTIC
*         MESSAGES WHICH IS ORDER DEPENDENT.  A TABLE ENTRY
*         MUST BE 2 WORDS LONG INCLUDING 4 LEADING BLANKS.
 
 DSDMA    DATA   H*    "KDM1M".*
          DATA   H*    "KDM2M".*
          DATA   H*    "KDM3M".*
          DATA   H*    "KDM4M".*
          DATA   H*    "KDM6M".*
 DSDMB    VFD    42/6LSYSMSG,18/0
 DSDMC    VFD    24/0,18/0,18/0  BUFFER CONTROL WORD
 DSDMD    BSS    1           K-DISPLAY COMMAND MESSAGE CODE
 DSDME    BSS    1           FIRST WORD OF ATTEMPTED COMMAND
 RKP      SPACE  4,15
**        RKP - RESTORE K-DISPLAY POINTER.
*
*         ENTRY  (KDISB) = 24/0,18/FWA OF MESSAGE,18/SUBCP ADDRESS.
*
*         EXIT   (KCTRL1) UPDATED.
*                (X1) AND (X2) RESTORED.
*
*         USES   A - 3, 4, 6.
*                B - 5.
*                X - 1, 2, 3, 4, 6, 7.
*
*         CALLS  NONE.
*
*         MACROS CONSOLE, MESSAGE.
 
 
 RKP      SUBR               ENTRY/EXIT
          MX7    42
          SA3    KDISG       SUBCP ADDRESS
          SA3    X3
          SA4    KDISB
          ZR     X4,RKPX     IF NO TASK DISPLAY REQUEST
          NG     X4,RKPX     IF K-DISPLAY TASK SCHEDULED, BUT NOT ACTIVE
          LX4    17-35
          SB5    X3          TASK RA
          SA3    KCTRL1
          SX4    X4+B5       ABSOLUTE K-DISPLAY ADDRESS
          BX6    X7*X3       CLEAR OLD ADDRESS
          BX6    X4+X6       UPDATE FWA OF MESSAGE
          SA6    A3
          BX3    X1          SAVE (X1) AND (X2)
          BX4    X2
          CONSOLE  KCTRL1    ISSUE K-DISPLAY
          MESSAGE  VERM,1    * VERSION NUMBER.*
          MESSAGE  ZWORD,2
          BX1    X3          RESTORE (X1) AND (X2)
          BX2    X4
          EQ     RKPX        RETURN
          TITLE  OVERLAY PROCESSING.
 LOVL     SPACE  4,10
**        LOVL - LOAD AND EXECUTE OVERLAY.
*
*         ENTRY  (X1) = ENTRY POINT NAME.
*
*T  (X1)  42/  ENTRY POINT NAME,1/K,17/    RT
*         K      SET IF K-DISPLAY COMMAND.
*         RT     IF SET RETURN TO CALLER - DO NOT EXECUTE OVERLAY.
*
*         USES   A - 1, 2, 3, 4, 7.
*                B - 4, 6.
*         USES   X - 1, 2, 3, 4, 6, 7.
*
*         CALLS  SETA, OVL=.
 
 
 LOVL     SUBR               ENTRY/EXIT
          MX6    43
          TA4    -1,VOEP     START OF OVERLAY ENTRY POINT NAMES
          BX7    -X6*X1      EXECUTE / NO EXECUTE FLAG
 
 LOV1     SA4    A4+B1
          ZR     X4,LOVLX    IF ENTRY POINT NAME NOT FOUND
          BX3    X1-X4
          BX3    X6*X3
          NZ     X3,LOV1     IF NO MATCH ON NAME
          LX4    -12
          SA3    LOVA        CURRENT OVERLAY IN CORE
          MX6    -4
          BX6    -X6*X4      OVERLAY ORDINAL
          BX3    X3-X6
          SA6    A3          SET NEW OVERLAY NAME
          ZR     X3,LOV2     IF OVERLAY IN CORE
 
*         LOAD AND PRESET OVERLAY.
 
          SA1    LOVB
          SA2    LWPR        SAVE FOR *CMM*
          LX6    59-PRODL*6-5 SHIFT DEPENDS ON PRODUCT NAME
          BX6    X6+X1       OVERLAY NAME
          SA6    TROVL
          BX6    X2
          SA6    LOVH
          OVERLAY TROVL,100B,S,TROVL-1  LOAD OVERLAY
          SA3    LOVH        (LWPR)
          SA1    LOVA
          TA2    X1-1,VOREL  START OF RELOCATION ADDRESSES
          SB4    X2
          BX6    X3
          LX2    -18
          SA6    LWPR
          SB6    X2-1
          NG     B6,LOV2     IF NO INSTRUCTIONS TO RELOCATE
          RJ     SETA        RELOCATE INSTRUCTIONS
 
 LOV2     NZ     X7,LOVLX    IF RETURN TO CALLER REQUESTED
          SA4    A4          CONTROL WORD
          MX7    -12
          BX7    -X7*X4      ENTRY BIAS
          SB6    X7
          JP     B6+TROVL
 
 LOVA     CON    0           CURRENT OVERLAY IN CORE
 
 LOVB     VFD    42/0L"PROD",18/0
 
 LOVC     VFD    42/0LDTS,18/0  TASK DUMP PROCESSOR
 LOVD     VFD    42/0LECE,18/0  ECS TASK LIBRARY READ ERROR PROCESSOR
 LOVE     VFD    42/0LIDLE,1/1,17/1  IDLE DOWN
 LOVF     VFD    42/0LULD,18/0  UPDATE TASK LIBRARY DIRECTORY
 LOVG     VFD    42/0LCIN,18/0  COMMUNICATION SUBSYSTEM INITIALIZATION
 LOVH     BSS    1           (LWPR)
 SETA     SPACE  4,10
**        SETA   SET ADDRESSES IN TRANEX INSTRUCTIONS (ADAPTED FROM
*         TELEX - USED WITH INMOD MACRO).
*
*         ENTRY  (B4) = START OF RELOCATION CONTROL TABLE.
*                (B6) = LENGTH OF RELOCATION CONTROL TABLE.
*
*         USES   A - 1, 2, 6.
*                B - 5, 6.
*                X - 1, 2, 3, 4, 6.
 
 
 SETA     SUBR               ENTRY/EXIT
 SET1     SA1    B4+B6       READ THE NEXT RELOCATION WORD
          SB6    B6-B1
          UX4,B5 X1          SET POSITION IN WORD
          SA2    X1          GET WORD
          AX1    18
          SX1    X1
          MX6    -18
          SX3    X1
          PL     X1,SET2     IF POSITIVE VAUE WANTED
          BX1    -X1
 SET2     SA1    X1
          PL     X3,SET3     IF COMPLEMENT OF ADDRESS WANTED
          BX1    -X1
 SET3     LX4    59-47
          NG     X4,SET4     IF LWA WANTED
          AX1    24          GET FWA
 SET4     BX1    -X6*X1
          SX4    B5
          SB5    B5-60
          AX2    X2,B5       POSITION ADDRESS
          BX3    -X6*X2      GET ADDRESS
          BX2    X6*X2       MASK OUT ADDRESS
          SX3    X3
          IX3    X3+X1       GENERATE NEW ADDRESS
          BX3    -X6*X3
          BX2    X2+X3       MERGE ADDRESS
          SB5    X4
          LX6    X2,B5       REPOSITION INSTRUCTION
          SA6    A2
          PL     B6,SET1     IF STILL MORE INSTRUCTIONS TO MODIFY
          EQ     SETAX       RETURN
 TERR     TITLE  ERROR PROCESSING.
*         TERR   FATAL TASK ERROR LIST.
*
 
 
 TERR1    ERROR  1           TASK CEASE WITH REQUESTED ABORT
 
 TERR2    ERROR  2           RA+1 CALL PARAMETER ADDRESS OUTSIDE FL
 
 TERR3    ERROR  3           RA+1 CALL WITH ILLEGAL FUNCTION CODE
 
 TERR4    ERROR  4           SYSTEM REQUEST CALL ERROR
 
 TERR5    ERROR  5           MORE THAN 5 TASKS IN TASK CHAIN
 
 TERR6    ERROR  6           INCORRECT TASK NAME
 
 TERR7    ERROR  7           TERMINAL NAME DOE NOT EXIST
 
 TERR8    ERROR  8           OUTPUT MESSAGE TOO LONG
 
 TERR9    ERROR  9           INCORRECT JOURNAL FILE REQUEST
 
 TERR10   ERROR  10          TASK CEASE WITH OUTSTANDING D.M. REQUESTS
 
 TERR11   ERROR  11          TASK NOT VALIDATED FOR REQUEST
 
 TERR12   ERROR  12          TASK BRANCH LIMIT EXCEEDED
 
 TERR13   ERROR  13          INCORRECT RA(S)+1 CALL PARAMETER
 
 TERR14   ERROR  14          TOO MANY SYSTEM REQUEST CALLS
 
 TERR15   ERROR  15          TASK TIME LIMIT EXCEEDED
 
 TERR16   MX6    1
          BX2    -X6*X5      CLEAR ABORT FLAG
          LX2    59-SCDRS-59+SCTAS
          BX6    -X6*X2      CLEAR DROP FLAG
          LX6    59-59-59+SCDRS
          SA6    A5
          ERROR  16          ABORT FLAG SET
 
 TERR17   ERROR  17          ERROR IN SUBMIT FILE
 
 TERR18   ERROR  18          *CALLRTN* NESTED CALL LIMIT EXCEEDED
 
 TERR19   ERROR  19          SCHEDULING REQUEST WITH D.M. REQUESTS OUT
 
 TERR20   ERROR  20          INCORRECT WAIT FOR INPUT REQUEST
 
 TERR21   ERROR  21          *WAITINP* FROM MULTI QUEUED TASK
 
 TERR22   MX6    1           SET SEND BIT
          BX5    X6+X4
          LX5    59-14-44    CLEAR ABORT BIT
          BX6    -X6*X5
          LX6    45-15-45
          SA6    A4
          ERROR  22          APPLICATION ERROR - NO TERMINAL OUTPUT
 
 TERR23   MX6    1           CLEAR ABORT FLAG
          BX6    -X6*X5
          LX6    -4
          SA6    A5
          ERROR  23          TOTAL DATA MANAGER ERROR
 
*         ERROR  24          RESERVED
 
 TERR25   ERROR  25          TOTAL DATA MANAGER NOT LOADED
 
 TERR26   ERROR  26          INCORRECT TOTAL INTERLOCK REQUEST
 
 TERR27   ERROR  27          A SEND TO TERMINAL NOT LOGGED IN
 
 TERR28   ERROR  28          ABORT TASK FOR ARGUMENT ERROR
 
 TERR29   ERROR  29          NETWORK REQUEST NOT SUPPORTED
 
 TERR30   ERROR  30          *CRM* DATA MANAGER NOT LOADED
 
 TERR31   ERROR  31          *CDCS* NOT AVAILABLE
 
 TERR32   ERROR  32          *CDCS* REQUEST ABORT
 
 TERR33   ERROR  33          MEMORY REQUEST FOR ECS NOT ALLOWED
 
 TERR34   ERROR  34          INCORRECT COMMON MEMORY MANAGER REQUEST
 
 TERR35   ERROR  35          FL REQUEST BEYOND MFL (CM)
 
 TERR36   ERROR  36          INCORRECT REDUCE FL
 
 TERR37   ERROR  37          MEMORY REQUEST WITH DM REQUEST OUTST.
 
 TERR38   ERROR  38          CDCS INVOKE FAILURE
 
 TERR39   ERROR  39          DATA MANAGER USAGE NOT SELECTED
 
 TERR40   ERROR  40          TAF TRANSACTION NAME UNKNOWN
 TERP     SPACE  4,15
**        TERP - TASK FATAL ERROR PROCESSOR.
*
*         THIS ROUTINE MAKES A JOURNAL FILE ENTRY TO FLAG THE TASK
*         ERROR, PRODUCES A TASK DUMP IF NECESSARY, AND SCHEDULES
*         TASK *MSABT* TO SEND AN ERROR MESSAGE TO THE ORIGINATING
*         TERMINAL.  IF MORE TRANSACTIONS ARE QUEUED TO BE EXECUTED
*         BY THE TASK OR IF THE TASK IS *INITIAL TASK*, THE TASK
*         CODE IS RELOADED.
*
*         ENTRY  (X1) = ERROR CODE.
*                (STAT5) = ERROR COUNT.
 
 
 TERP     SX7    X1+         ERROR CODE
          RJ     RSP         RESTORE SUBCP REGISTERS
          SA4    STAT5       ERROR COUNT
          SA2    B2+ERRC
          SX6    B1+
          MX3    -18
          IX6    X6+X4
          BX3    X3*X2       CLEAR OLD ERROR CODE
          SA6    A4          BUMP ERROR COUNT
          IX7    X7+X3
          SA7    A2          SET ERROR CODE IN TASK CONTROL AREA
          SX6    B0          DO NOT SEND *SECURE*
          SX5    B2
          SA6    B2+SECR
          SX1    X7+         ERROR CODE
          RJ     CDD         CONVERT TO DECIMAL DISLAY
          SB2    X5
          BX6    X4
          SB5    PJRNL       PRIMARY JOURNAL FILE
          SA6    TERPM1      SET ERROR CODE IN JOURNAL MESSAGE
          SX3    TERPML      LENGTH OF MESSAGE
          SX5    TERPM       START OF FATAL ERROR MESSAGE
          SA2    B2+CB2C
          LX3    18
          SB3    TERP1       RETURN ADDRESS
          BX5    X5+X3       START AND LENGTH OF MESSAGE
          SX0    X2          CONTEXT BLOCK ADDRESS
          SB4    B1          TRANEX ORIGIN
          EQ     JRNL        JOURNAL THE ERROR MESSAGE
 
 TERP1    SA1    KDISB
          ZR     X1,TERP1.1  IF NO TASK HAS K-DISPLAY ACTIVE
          MX6    42
          SB5    X1+         C.B. ADDRESS
          BX7    X7-X7
          SX1    KFRM
          SA2    B2+CB2C     CURRENT C.B. WORD 2
          SB4    X2+         C.B. ADDRESS
          NE     B4,B5,TERP1.1  IF ANOTHER TASK HAS *K-DISPLAY*
 TERP1.0  SA2    KCTRL1
          BX6    X6*X2
          SA7    A1          CLEAR *KDISB* INTERLOCK
          BX6    X6+X1       SWITCH K-DISPLAY TO TAF
          SA6    A2
          CONSOLE KCTRL1
          MESSAGE ZWORD,2
 TERP1.1  SA2    B2+CB2C     GET C. B. ADDRESS
          SA2    X2+CBCR     GET ROLLOUT TABLE ADDRESS
          MX4    6
          SX0    X2          ROLLOUT TABLE ADDRESS
          BX1    X4*X2
          ZR     X1,TERP3    IF NOT A CALLRTN TASK
          SX7    B1          SET CALLRTN ABORT BIT
          LX7    47
          BX7    X7+X2
          SA7    A2
 TERP3    SA1    B2+ERRC     CHECK FOR SPECIAL CASE ERRORS
          SX2    X1-1
          NZ     X2,TERP4    IF NOT CEASE WITH ABORT
          SA3    B2+CB1C
          SX4    B1
          LX4    -1-15
          BX7    X4+X3       SET PRIOR ABORT BIT TO BYPASS ERROR TASK
          SA7    A3
          EQ     TERP9       DONT PRODUCE TASK DUMP
 
*         PROCESS CALLTSK/CALLRTN/CALLTRN ERRORS.
 
 TERP4    SX2    X1-40
          ZR     X2,TERP7    IF CALLTRN
          SB4    X1-5
          SA1    B2+LRA1     CHECK FOR CALLTSK W/O CEASE OR NEWTRAN
          ZR     B4,TERP5    IF TASK LIST TOO LONG
          NE     B4,B1,TERP8 IF NOT AN INCORRECT SCHEDULING REQUEST
 TERP5    LX1    59-18
          PL     X1,TERP7    IF NOT NEWTRAN OR CALLTASK WITHOUT CEASE
          SA2    B2+CB2C     GET COMMUNICATION BLOCK ADDRESS
          RJ     RLC         RELEASE COMMUNICATION BLOCK
 TERP6    SA1    B2+SCRC
          SA2    A1+B1       RESTORE OLD COMMUNICATION BLOCK HEADER
          BX6    X1
          LX7    X2
          SA6    B2+CB1C
          SA7    A6+B1
 
*         DO NOT PRODUCE A DUMP FOR SYSTEM TASKS.
 
 TERP7    MX7    -SCNMN      GET TASK DIRECTORY INDEX
          SA1    B7+SCNMW
          LX1    SCNMN-SCNMS-1
          BX7    -X7*X1
          TA2    X7-1,VTLD   TASK NAME
          MX7    42
          SA1    TERPA       LIST OF TASKS NOT TO DUMP
 TERP7.1  ZR     X1,TERP8    IF END OF LIST
          BX2    X7*X2
          IX1    X1-X2
          ZR     X1,TERP9    IF NO DUMP WANTED
          SA1    A1+B1
          EQ     TERP7.1     NEXT TASK IN LIST
 TERP8    SA2    TDSP        CHECK INTERLOCK
          SX7    TERP8       RECALL RETURN ADDRESS
          NZ     X2,TRCL2    IF LAST DSP REQUEST NOT COMPLETED
          SA1    B2+CB2C     GET CB ADDRESS
          MX7    0
          SX0    X1          (X0) = COM. BLK. ADDRESS
          SB3    X1+3        DUMP CONTROL WORDS
          SA7    DTSG        USE *P* AS CALLED FROM ADDRESS
          SA1    LOVC        TASK DUMP PROCESSING OVERLAY NAME
          RJ     LOVL        LOAD/EXECUTE DUMP TASK OVERLAY
 
*         TEST IF *MSABT* HAS BEEN RUN ONCE AGAINST THIS TASK.
 
 TERP9    SA1    B2+ERRC     ERROR CODE
          BX6    X6-X6
          SX7    X1
          SA6    B2+NUAPL+TIMD-1   TRANEX ORIGIN INDICATOR FOR MSABT
          SA7    B2+NUAPL+TIMD     ERROR CODE FOR MSABT
          SA4    B2+CB1C
          MX3    1
          LX3    -15
          BX7    X4+X3
          SX6    B0
          LX4    15
          SA7    A4          SET INTO C.B. HEADER
          SA1    A4+B1
          SA2    ABAS        ABORT TASK
          SX0    X1          C.B. ADDRESS FOR TRANSACTION
          NG     X4,TERP10   IF NOT TO SCHEDULE MSABT AGAIN
          SA3    X0+CBSBW    CHECK *BTRAN* TRANSACTION
          LX3    59-CBSBS
          NG     X3,TERP10   IF *BTRAN* TRANSACTION
          SA3    B2+DBNC     D.B. OF THIS TASK
          SB4    B0          DETECT *OFF* STATUS
          SB5    B0          TASK SEARCH
          RJ     LTT         LOCATE TASK
 TERP10   LX6    -12
          SA5    X0+CBRTW    CHECK IF RECOVERABLE TRANSACTION
          LX5    59-CBRTS
          SA6    X0+2        SCHEDULE ERROR TASK NEXT
          SA6    B2+RTSC
          PL     X5,TERP11   IF NOT RECOVERABLE
          SX5    CSTA        TASK ABORT *STEP*
          SX3    TERP11      RETURN ADDRESS
          RJ     WTS         WRITE TERMINATION *STEP*
 
 TERP11   TX1    B7+CPAL,-VCPA  RELATIVE SUBCP NUMBER
          SA2    RCR
          AX1    SCPAL
          MX3    1
          SB4    X1
          LX3    -12
          AX1    X3,B4
          BX7    -X1*X2      CLEAR RECALL BIT
          SA7    A2+
 
*         CHECK FOR TOTAL INTERLOCK FLAG SET.
 
 TERP12   SA2    TOTLCK      INTERLOCK FLAG
          ZR     X2,TERP13   IF TOTAL INTERLOCK FLAG NOT SET
          SA1    B2+CB1C     TASK SEQUENCE NUMBER
          MX3    24
          LX1    18
          BX2    X3*X2       SEQUENCE NUMBER OF SETTING TASK
          BX1    X3*X1       ABORTING TASK SEQUENCE NUMBER
          IX6    X1-X2
          NZ     X6,TERP13   IF ABORTING TASK DID NOT SET INTERLOCK
          SA6    TOTLCK      CLEAR TOTAL INTERLOCK FLAG
 
*         RELOAD TASK IF IT IS TO BE USED AGAIN
 
 TERP13   SA1    B7+B1       SUB CONTROL POINT CONTROL WORD TWO
          TB4    B7,-VCPA
          LX1    -36
          ZR     B4,TERP21   IF ITASK BOMBED
          BX6    X1
          MX7    -SCNCN
          BX7    -X7*X6
          SB5    X7+         NUMBER OF C.B.-S WAITING FOR TASK
          LX1    36+2
          NE     B5,B1,TERP14
          NG     X1,TERP14   IF CM RESIDENT TASK
          SX2    B1+
          BX6    -X2*X1      CLEAR REUSABLE CODE BIT
          SB4    B0
          SX5    B2+CB1C
          LX6    -2
          SA6    A1
          EQ     SCT1        DO A CEASE ON THE TASK
 
*         WRITE COMMUNICATION BLOCK.
 
 TERP14   SX7    TERP13
          SA3    LTLRE
          NZ     X3,TRCL2    IF TASK LOAD REQUEST STACK IS FULL
          LX1    -2
          SA4    X1          TASK CONTROL WORD
          SX1    CMBL-CMBHL-CMBRL
          SX2    B2+NUAPL+SUAC+CMBRL
          SA5    B7          SUBCP TABLE WORD 1
          LX5    59-57
          PL     X5,TERP14.1 IF NO USER SPECIFIED BUFFER
          SA5    B7+B1
          LX5    17-35
          SX2    X5
 TERP14.1 SA5    B2+CB1C     COMMUNICATIONS BLOCK HEADER WORD
          SX3    X4+CMBHL+CMBRL
          SB5    A1
          BX7    X5
          SA7    X4
          RJ     MVE=        WRITE COMMUNICATON BLOCK
          SA1    B5+B1       SUB CP CONTROL WORD 3
          MX2    12
          MX6    30
          SX4    B7
          BX2    X2*X1       TASK ID
          LX2    12
          TA2    X2,VTLD     GET TASK DISK ADDRESS
          SA1    B7+
          BX5    X6*X2
          LX1    -18
          SX1    X1+NUAPL    TASK FL
          LX5    30          POSITION TASK DISK INDEX
          LX1    18
          BX7    X1+X4
          SX6    A2          ADDRESS OF TLD ENTRY
          SB6    VTFL        SYSTEM TASK LIBRARY NAME
          TA3    0,VEDT
          SA1    A3+4
          SA2    A2+B1       WORD 3 OF TLD
          SX3    X3          LINK TO NEXT EDT
          LX1    -18
          LX2    3           POSITION TO EXTENDED MEMORY RESIDENT BIT
 TERP15   SX4    X1
          ZR     X4,TERP16   IF NO DIRECTORY FOR DATA BASE
          IX4    X4-X6
          PL     X4,TERP17   IF ENTRY IN PREVIOUS TLD
          SB6    X1-1
 TERP16   ZR     X3,TERP17   IF AT END OF EDTS
          SA1    X3+4
          SA3    X3
          LX1    -18
          SX3    X3+         NEXT EDT
          EQ     TERP15      LOOP
 
 TERP17   SX1    B6
          SX0    A3          ADDRESS OF EDT
          LX1    30          ADDRESS OF NAME OF TASK LIBRARY FILE
          BX5    X5+X1
          LX0    36
          SB4    TERP18
          BX7    X0+X7
          PL     X2,SCHD11   IF NOT EXTENDED MEMORY RESIDENT LOAD
          MX0    1           INDICATE TO SCHEDULER ERROR CALL
          BX7    X0+X7
          JP     SCHD31      RELOAD EXTENDED MEMORY RESIDENT TASK
 
*         SET RECALL BIT AND RECALL RETURN ADDRESS, THEN DROP THE CPU
*         FOR THE TASK. WHEN THE LOAD IS COMPLETE, CONTINUE NORMAL TASK
*         PROCESSING.
 
 TERP18   SA2    B7+B1       SUB CP CONTROL WORD 2
          SX1    B1
          SX7    TERP19      *RECALL* RETURN ADDRESS
          LX1    59-3        TASK RECALL BIT
          BX6    X1+X2
          SA7    B2+RCL
          SA6    A2
          RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 
*         TASK HAS BEEN RELOADED - CONTINUE PROCESSING
 
 TERP19   SA1    B7+B1
          SX3    B2+NUAPL+SUAC
          SA2    B7          SUBCP TABLE WORD 1
          LX2    59-57
          PL     X2,TERP19.1 IF NO USER SPECIFIED BUFFER
          SA2    X1
          LX2    17-35
          SX3    X2          (X3) = FWA OF USER SPECIFIED BUFFER
 TERP19.1 SA2    X1          RELOAD COMMUNICATIONS BLOCK FOR TASK
          SX1    CMBL-CMBHL
          SA5    X2          C.B. HEADER WORD 1
          BX7    X5
          SX2    X2+CMBHL
          SA7    B2+CB1C     RESTORE HEADER WORD
          RJ     MVE=        READ C.B.
          SX7    B1+
          SA1    STAT1       NUMBER OF TASKS WHICH HAVE BEEN RELOADED
          IX7    X7+X1
          SA7    A1+
 TERP20   SX5    B2+CB1C
          SB4    0
          EQ     SCT1        EXECUTE A CEASE ON THE C.B. THAT CAUSED
                             THE FATAL ERROR.
 
*         RELOAD *INITIAL TASK*.
 
 TERP21   SA1    B2+ERRC     CHECK ERROR CODE
          SX7    X1-6
          ZR     X7,TERP20   IF NO RELOAD FOR NONEXISTANT TASK
          SA1    B7+B1
          SA4    X1          TASK CONTROL WORD
          SX1    CMBL-CMBHL-CMBRL
          SX2    B2+NUAPL+SUAC+CMBRL
          SX3    X4+CMBHL+CMBRL
          SB5    A1+
          RJ     MVE=        WRITE COMMUNICATON BLOCK
          SA1    B5+B1       SUB CP CONTROL WORD 3
          MX2    12
          BX2    X2*X1       TASK INDEX
          LX2    12
          TA3    X2,VTLD
          MX7    30
          BX7    X7*X3       TASK DISK INDEX
          SA5    B7          SUB CP CONTROL WORD 1
          LX7    30
          RECALL TL          WAIT FOR TASK LIBRARY TO GO NON BUSY
 
*         SET FET FOR RELOAD OF *INITIAL TASK*.
 
          SA1    VTFL
          SA4    TL+1        FIRST
          BX6    X1          SYSTEM TASK LIBRARY NAME
          SA6    A4-B1
          SX6    X5+77B-16B  FWA FOR TASK LOAD
          MX2    -18
          SA7    TL+6        RANDOM TASK INDEX
          BX7    X2*X4
          LX5    -18
          BX7    X7+X6
          SA6    A4+B1       IN
          SA7    A4          FIRST
          SA6    A6+B1       OUT
          SA4    A6+B1       LIMIT
          SX1    X5+16B-77B  TASK FL (MINUS LOAD BIAS)
          BX7    X2*X4
          IX1    X1+X6
          BX7    X7+X1       LIMIT
          SA7    A4
          READSKP  TL,,R     RELOAD INITIAL TASK
          SX7    B1
          SA1    STAT2
          IX7    X7+X1       NUMBER OF TIMES INITIAL TASK RELOADED
          SA7    A1
          EQ     TERP19      RESUME NORMAL PROCESSING
 
 TERPA    BSS    0           LIST OF TASKS NOT TO DUMP
          VFD    42/0LCTASK,18/0
          VFD    42/0LITASK,18/0
          VFD    42/0LRTASK,18/0
          VFD    42/0LXTASK,18/0
          DATA   0           END OF LIST
 
 TERPB    VFD    60/0LMSABT  NAME OF ERROR PROCESSING TASK
 
 TERPM    CON    10HFATAL ERRO
          CON    10HR
 TERPM1   BSSZ   2
 TERPML   EQU    *-TERPM
 CTEXT    TITLE  COMMON DECKS.
*CALL COMCARG
*CALL COMCCDD
*CALL COMCCOD
*CALL COMCDXB
*CALL     COMCECS
*CALL COMCLFM
*CALL COMCOVL
**        *MODIFIED* MVE     *** WARNING ***
*
*         USES B6 INSTEAD OF B7
          CTEXT  COMCMVE - MOVE BLOCK OF DATA.
 MVE      SPACE  4
          IF     -DEF,QUAL$,1
          QUAL   COMCMVE
          BASE   D
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 MVE      SPACE  4
***       MVE - MOVE BLOCK OF DATA.
*         G. R. MANSFIELD.   70/10/09.
*         R. E. TATE.        73/11/04.
 MVE      SPACE  4
***              MVE MOVES A BLOCK OF DATA.
*
*         NOTE-  UPWARD MOVE MEANS TOWARD RA.
*
*         ENTRY  (X1) = WORD COUNT.
*                (X2) = SOURCE ADDRESS.
*                (X3) = DESTINATION ADDRESS.
*                (B1) = 1
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 6.
*                A - 2, 4, 6, 7.
 
 
*         COMPARE MOVE UNIT BUFFER AREA/PRESET.
*         MVEB IS READ UP AND THEN RETURN JUMPED TO IN ORDER TO VOID
*         THE INSTRUCTION STACK.  LATER MVEB IS USED FOR THE CMU
*         DESCRIPTOR WORD.
 
 MVE11    BSS    0           ENTRY FOR PRESET
 MVEB     IX4    X2-X3       CHECK DIRECTION OF MOVE  (NO CMU)
          MX7    59
          JP     MVE13
 
 MVEC     BX7    X2          CHECK IF CMU AVAILABLE (BUFFER AREA FWA)
          SA2    CMUR
          PL     X2,MVE12    IF NO CMU
          SA4    MVED
 MVE12    BX6    X4
          LX2    X7          RESTORE X2
          SA6    MVEA
          JP     MVE1        RESTART LOOP
 
 MVED     IX4    X2-X3       CHECK DIRECTION OF MOVE (CMU)
          BX7    X1          SET WORD COUNT
          BX1    X0          SAVE X0
          LX2    30
 
*         DETERMINE MOVE DIRECTION.
 
 MVE13    BX6    -X7*X1
          IX1    X1-X6       REDUCE WORD COUNT TO EVEN NUMBER
          PL     X4,MVE15    IF MOVE UP
 
*         BEGIN DOWNWARD MOVE.
 
          ZR     X6,MVE14    IF WORD COUNT EVEN
          SB6    X1
          SA4    X2+B6       MOVE INITIAL WORD
          BX6    X4
          SA6    X3+B6
 MVE14    IX2    X2+X1
          IX3    X3+X1
          SB6    -2
          EQ     MVE16
 
*         BEGIN UPWARD MOVE.
 
 MVE15    SB6    -2          UPWARD MOVE
          SX2    X2+B6
          SX3    X3+B6
          SB6    B1+B1
          ZR     X6,MVE16    IF WORD COUNT EVEN
          SA4    X2+B6       MOVE INITIAL WORD
          IX2    X2+X6
          BX7    X4
          SA7    X3+B6
          IX3    X3+X6
 
*         INITIALIZE MOVE LOOP.
 
 MVE16    ZR     X1,MVE=     IF MOVE COMPLETE
          SA2    X2+B6       MOVE FIRST 2 WORDS
          SA4    A2+B1
          BX6    X2
          LX7    X4
          SA6    X3+B6
          SA7    A6+B1
          SX3    B1+B1
          IX1    X1-X3
          ZR     X1,MVE=     IF MOVE COMPLETE
          SA2    A2+B6       NEXT 2 WORDS
          SA4    A4+B6
 
*         MOVE LOOP.
 
 MVE17    BX6    X2
          SA2    A2+B6
          LX7    X4
          SA4    A4+B6
          IX1    X1-X3
          NO
          SA6    A6+B6
          SA7    A7+B6
          NZ     X1,MVE17
 
 MVEE     BSS    0           END OF CMU BUFFER AREA
 MVELL    EQU    MVEE-MVEC   NUMBER OF WORDS IN BUFFER
 
 MVE=     PS                 ENTRY/EXIT
 MVEA     BSS    0
 MVE1     SA4    MVEB        INITIALIZE FOR CMU
          RJ     MVE11
*         IX4    X2-X3       CHECK DIRECTION OF MOVE (NO CMU)
*         MX7    59          (NO CMU)
*         JP     MVE13       (NO CMU)
*
*         IX4    X2-X3       CHECK DIRECTION OF MOVE (CMU)
*         BX7    X1          (CMU)
*         BX1    X0          SAVE X0 (CMU)
*         LX2    30          (CMU)
 
*         MOVE DATA WITH CMU.
 
          ZR     X7,MVE=     IF NO DATA TO MOVE
          SX6    X7-819
          BX0    X4
          NG     X4,MVE2     IF MOVE DOWNWARD
          BX0    -X4
 MVE2     IX0    X0+X7
          BX6    X0*X6
          PL     X6,MVE3     IF BLOCK TOO LONG FOR 1 MOVE OR BLOCKS LAP
          BX0    X7          SET UP FOR 1 MOVE
          BX2    X2+X3
          BX7    X7-X7       SET TO FORCE EXIT
          MX4    -4
          SB6    MVE9
          JP     MVE10
 
 MVE3     SX6    MVEC        SET INTERMEDIATE BUFFER ADDRESS
          NG     X4,MVE6     IF MOVE DOWNWARD
 
*         MOVE UPWARD.
 
          BX2    X2+X6
          LX6    30
          BX3    X3+X6
 MVE4     BX0    X7
          SX7    X7-MVELL    DECREMENT WORD COUNT
          MX4    -4
          NG     X7,MVE5     IF LAST BLOCK TO MOVE
          SX0    MVELL
 MVE5     SB6    *+1         SET TO RETURN HERE
          JP     MVE10
          IM     MVEB
          SB6    X7
          BX0    X1          RESTORE X0
          LT     B6,B1,MVE=  IF MOVE COMPLETE
          SX4    -MVELL      UPDATE ADDRESSES
          IX3    X3-X4
          LX4    30
          IX2    X2-X4
          JP     MVE4
 
*         MOVE DOWNWARD.
 
 MVE6     LX6    30          SET LAST WORD ADDRESSES OF DATA AREAS
          BX6    X7+X6
          IX3    X3+X6
          LX6    30
          IX2    X2+X6
 MVE7     SX6    MVELL
          SX0    X7
          IX7    X7-X6
          MX4    -4
          NG     X7,MVE8     IF LAST BLOCK TO MOVE
          BX0    X6
 MVE8     BX6    X0          ADJUST DESTINATION AND SOURCE ADDRESSES
          IX3    X3-X0
          LX6    30
          IX2    X2-X6
          SB6    *+1         SET TO RETURN HERE
          JP     MVE10
          IM     MVEB        MOVE DATA TO DESTINATION BUFFER
 MVE9     SB6    X7
          BX0    X1          RESTORE X0
          LT     B6,B1,MVE=  IF MOVE COMPLETE
          JP     MVE7        LOOP
 
*         SETUP MOVE WORD.
*         (X0) = NUMBER OF WORDS TO MOVE.
*         (X4) = 56 BIT MASK.
 
 MVE10    LX6    X0,B1       10 * WORD COUNT = CHARACTER COUNT
          LX0    3
          IX6    X0+X6
          BX0    -X4*X6      EXTRACT LOWER PORTION
          BX4    X4*X6       EXTRACT UPPER PORTION
          LX0    26
          LX4    48-4
          BX0    X4+X0
          BX6    X2+X0
          SA6    MVEB        STORE FIRST DESCRIPTOR WORD
          BX6    X3+X0
          IM     MVEB        MOVE DATA TO INTERMEDIATE BUFFER
          SA6    A6          STORE SECOND DESCRIPTOR WORD
          JP     B6
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$
          QUAL   *
 MVE=     EQU    /COMCMVE/MVE=
 QUAL$    ENDIF
          ENDX
*CALL COMCPFM
*CALL COMCQFM
*CALL COMCRDW
*CALL COMCSFN
*CALL     COMCSNM
*CALL COMCUPC
*CALL COMCWTW
*CALL     COMCZTB
*CALL     COMKFIO
*CALL     COMKZFN
 ENDT     BSS    0           END OF RUN TIME CODE
 PRE      TITLE  "PROD" PRESET.
**        PRE - *TAF* PRESET.
*
*         THIS ROUTINE MODIFIES THE RETURN JUMP INSTRUCTIONS FOR
*         *TOTAL* AND *CRM* IF THEY ARE TO BE LOADED.  IT ALSO SETS
*         THE VARIABLE ADDRESSES IN INITIALIZATION DEPENDENT
*         INSTRUCTIONS AND VERIFIES THAT ALL SYSTEM TASKS ARE PRESENT.
 
 
 PRE      BSS    0           ENTRY
          SB1    1
          SX3    PREH        FWA OF Y-COORDINATE TABLE
          RJ     PRK         PRESET K-DISPLAY BUFFER
 
*         INITIALIZE *RJ* FOR CALLING *CRM*, IF LOADED.
 
          SA2    VAAM        AAM INITIALIZATION FLAG
          ZR     X2,PRE1     IF *AAMI* NOT LOADED
          SA3    PREA        SETUP CALL TO INITIALIZATION
          SB3    AAMA        FWA OF MAXIMUM TRANSACTIONS USING *CRM*
          BX6    X2+X3
          SA6    A3
          SA6    PREB        CALL *IAM*, IF RECOVERY
          RJ     *           BREAK INSTRUCTION STACK
          LX2    30
          SB5    B1          SET UP ENTRY POINT CALL TO *IAM*
          SA1    TSSCB       SETUP CALL TO *AMI*
          BX6    X2+X1
          SA6    A1
          SB2    PREC        FWA OF EXTERNAL ROUTINES
 PREA     RJ     0           MODIFIED BY *PRE*
*         RJ     =XIAM       INITIALIZE EXTERNALS
          RJ     SETA        LINK *AAMI* EXTERNAL ROUTINES
 
*         INITIALIZE *RJ* FOR CALLING *TOTAL*, IF LOADED.
 
 PRE1     SA2    VTOT        TOTAL INITIALIZATION FLAG
          ZR     X2,PRE2     IF TOTAL DATA MANAGER NOT LOADED
          MX0    1
          LX2    30          POSITION ADDRESS OF TOTAL ENTRY POINT
          LX0    -5
          BX6    X0+X2       RJ INSTRUCTION
          SA6    TSSCA       MODIFY CALL FOR TOTAL
 PRE2     SB6    TINSTL-1    SET ADDRESSES OF VARIABLE TABLE REFERENCES
          SB4    TINST
          RJ     SETA
 PRE3     RJ     PVV         SET VARIABLE VALUES
          SA2    TLIST       INSURE EXISTENCE OF SYSTEM TASKS
 PRE3.1   ZR     X2,PRE3.5   IF NO MORE TASKS IN LIST
          BX0    X2
          SB4    B0          DETECT *OFF* STATUS
          SB5    B0+         TASK SEARCH
          BX3    X3-X3       SEARCH SYSTEM TASK LIBRARY
          BX6    X6-X6
          RJ     LTT         LOCATE TASK
          ZR     X6,PRE3.4   IF TASK NOT FOUND
          SA4    ITAS
          IX4    X4-X2
          NZ     X4,PRE3.2   IF NOT *ITASK*
          SX7    A1          FWA OF TLD ENTRY
          SA6    LITA        *ITASK* BIAS
          SA7    LITC
 PRE3.2   SA4    OTAS
          IX4    X4-X2
          NZ     X4,PRE3.3   IF NOT *OFFTASK*
          SA6    SCTB        *OFFTASK* BIAS
 PRE3.3   SA2    A2+B1
          EQ     PRE3.1      CHECK NEXT TASK IN LIST
 
 PRE3.4   SX6    B1
          SA1    A2          GET TASK NAME
          SA6    PREG
          SB5    -PREF       FWA OF MESSAGE
          SB2    1RX         REPLACEMENT CHARACTER
          SB3    DAYB        SET ALTERNATE ASSEMBLY AREA
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB      SYSTEM TASK LIBRARY MISSING TASK, XXXXXXX.
          SA2    A2+B1
          EQ     PRE3.1      CHECK NEXT TASK IN LIST
 
 PRE3.5   SA4    PREG        ERROR FLAG
          ZR     X4,PRE3.6   IF ALL SYSTEM TASKS PRESENT
          ABORT
 
 PRE3.6   SB2    B1          SET BIT IN TLD ONLY
          RJ     LIT         SET CORE RESIDENT BIT IN TLD
          RJ     PBI         LOOK FOR POTENTIALLY BLOCKED TASKS
          SB2    B0          SET FOR NORMAL CALL
          RJ     LIT         LOAD INITIAL TASK
          RJ     LCT         LOAD CORE RESIDENT TASKS
          RJ     LEC         LOAD EXTENDED MEMORY RESIDENT TASKS
          RJ     IJF         INITIALIZE JOURNAL FILES
          REWIND RO,R        REWIND ROLLOUT FILE
          WRITEW X2,TMDC,ROLBL  WRITE ONE BLOCK TO ROLLOUT FILE
          WRITER X2,R
          SA1    X2+6        GET RANDOM ADDRESS
          MX6    30
          BX6    X6*X1
          LX6    30
          SA6    X2+7        CURRENT EOI
          MX7    1
          SB2    B0          INITIALIZE ACTIVE TASK SYSTEM AREA FWA
          BX6    X6-X6       INITIALIZE ACTIVE TASK POINTERS
          SB7    B0+         INITIALIZE ACTIVE TASK SUBCP FWA
          SA6    SREG
          TA7    0,VRLAT
          TX1    0,VREC
          AX1    24
          SX1    X1          USER RECOVERY
          ZR     X1,PRE4     IF NOT A RECOVERY
          RJ     CAS         CHECK FOR ASSIGNED EQUIPMENT
          SX5    CIREC       RECOVERY CODE
          SA4    ITAS        INITIAL TASKS NAME
          SB3    B0          NO BUFFER INPUT
          SX7    B0          SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         GENERATE A SYSTEM ORIGIN TRANSACTION
          TB7    0,VCPA
          TB2    0,VFSCP
 PRE4     GETMC  PREE        GET MACHINE CHARACTERISTICS
          SA1    PREE
          MX2    -2          MODEL 176 MASK
          LX1    1-19
          BX2    -X2*X1      EXTRACT MACHINE MODEL
          ZR     X2,PRE4.1   IF NOT MODEL 176
          SA1    .EM         GET DEFAULT ERROR EXIT MODE
          MX2    59
          LX2    30-0
          BX6    X2*X1       DESELECT UNDERFLOW
          SA6    .EM
 PRE4.1   SA1    XJPR        CHECK CEJ/MEJ STATUS
          SA2    .CEJ
          MX7    1
          BX7    X7*X1       PRESENT/NOT PRESENT BIT
          MX6    -1
          LX7    1
          BX6    X6*X2
          BX6    X6+X7       INSTRUCTION SETTING CEJ/MEJ FOR SUB CPS
          SA6    .CEJ
          SA1    CMUR        CHECK CMU STATUS
          SA2    .CMU
          MX7    1
          BX7    X7*X1       PRESENT/NOT PRESENT BIT
          MX6    -1
          LX7    1
          BX6    X6*X2
          BX6    X6+X7       INSTRUCTION SETTING CMU FOR SUB CPS
          SA6    .CMU
          PDATE  PDATE       PACKED DATE/TIME
          RTIME  PTIME       REAL TIME CLOCK AT START OF PROGRAM
          TIME   CTIME
          MX2    -12
          SA4    CTIME       ACCUMULATED CPU TIME
          BX5    -X2*X4      MSECS ACCUMULATED
          LX4    60-12
          BX3    -X2*X4      SECS ACCUMULATED
          SX0    1000
          IX2    X0*X3       MULTIPLY BY 1000
          IX6    X2+X5       TOTAL MSECS ACCUMULATED
          SA6    CTIME
          SX7    B0
          SA7    B0          CLEAR RA
          SA1    PTIME
          BX7    X1
          SA7    RDCBD
          MX7    42
          SX1    DORC-BCOT
          NZ     X1,PRE5     IF NOT DEFAULT BATCH OUTPUT QUEUE
          SX2    DQDS        OUTPUT QUEUE DESTINATION
          SA1    DTSE+1
          LX2    18          SET PRINTER IDENTIFICATION
          BX7    -X7*X1
          BX7    X7+X2
          SA7    A1
 PRE5     CONSOLE  KCTRL1,R  SET MAIN DISPLAY CONTROL WORD
          MESSAGE ZWORD,2    CLEAR MESSAGE LINE 2
          MESSAGE VERM       SEND VERSION NUMBER TO DAYFILE
          SX7    B1+         SET NETWORKS DOWN
          SA7    VNON
          SA1    VREC
          MX3    1
          BX1    X3*X1       *CRM* RECOVERY BIT
          ZR     X1,PRE5.1   IF NOT A RECOVERY SITUATION
          SB5    7           ROLL BACK D.B. FUNCTION
 PREB     RJ     0           SET UP BY *PRE*
*         RJ     =XIAM       *AAMI* CALL IF RECOVERY
          ZR     X6,PRE5.1   IF CRM DATA BASE RECOVERED
          ABORT
 
*         SCHEDULE *CRM* DATA BASE RECOVERY TASK.  IF TASK NOT
*         SCHEDULED ABORT *TAF*.
 
 PRE5.1   SA4    VAAM
          ZR     X4,PRE5.2   IF TAF/CRM DATA MANAGER NOT LOADED
          SA1    VREC        ADD CRM RECOVERY FLAG
          MX7    1
          BX7    X7+X1
          SA7    A1
 PRE5.2   SB3    B0          NO BUFFER INPUT
          IFEQ   IPTAR,1     IF AUTOMATIC RECOVERY INSTALLED
          SX7    B0          SCHEDULE ONLY FROM SYSTEM LIBRARY
          SA4    CTAS        SCHEDULE *CTASK*
          SX5    TYRM        TRANSACTION TYPE IS RECORD MANAGER
          RJ     TRN         GENERATE SYSTEM TRANSACTION
          ZR     X0,PRE6     IF *CTASK* NOT SCHEDULED
          SA1    VREC        GET RECOVERY FLAG
          MX3    59
          LX3    24-0
          SA2    X0+CBTLW    GET BIAS OF *CTASK*
          BX7    X2
          SA7    SCTC        SAVE *CTASK* BIAS
          BX6    X3*X1
          SA6    X0+CMBHL+CMBRL+1  STORE IN WORD TWO OF MESSAGE AREA
          ELSE               IF AUTOMATIC RECOVERY NOT INSTALLED
          SX7    B1          START INPUT FOR TERMINAL JOBS
          SA7    STIN
          ENDIF
          REPRIEVE  EXIA,SET,77B
          EQ     TMDC        BEGIN PROCESSING
 
 PRE6     MESSAGE  PRED      * NO C.B. AVAILABLE TO SCHEDULE CTASK.*
          ABORT
*         ENTRY POINTS FOR ROUTINES USED BY *AAMI*.
 
 PREC     VFD    42/0,18/MVE=
          VFD    42/0,18/GRA
          VFD    42/0,18/TCM
          VFD    60/0
 
 PRED     DATA   C* NO C.B. AVAILABLE TO SCHEDULE CTASK.*
 
 PREE     BSS    1           MACHINE CHARACTERISTICS
 
 PREF     DATA   C* SYSTEM TASK LIBRARY MISSING TASK, XXXXXXX.*
 PREG     BSSZ   1           ERROR FLAG
 
*         Y-COORDINATE TABLE.
 
 PREH     KDL    *
          SPACE  4,10
 PRK      HERE               REMOTE BLOCK FROM *COMCDCP*
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCCVL
          LIST   X
*CALL     COMKDPB
          LIST   -X
          TITLE  PRESET ROUTINES.
 CAS      SPACE  4,15
**        CAS - CHECK FOR ASSIGNED EQUIPMENT.
*
*         IF ONE OR MORE TAPE UNITS HAVE BEEN ASSIGNED VIA THE
*         *K* DISPLAY AS A POOL UNIT FOR JOURNAL FILES, RESET THE
*         ASSIGNED EQUIPMENT WORD.
*
*         EXIT   (ASEQ) = 22/0,18/TA,18/TB.
*                TA = INFORMATION IF ONE TAPE UNIT IS ASSIGNED.
*                TB = INFORMATION IF TWO TAPE UNITS ARE ASSIGNED.
*
*         USES   A - 1, 6.
*                X - 1, 4, 6.
*
*         MACROS REWIND.
 
 
 CAS      SUBR               ENTRY/EXIT
          REWIND SCR,R       SCRATCH FILE NO. 1
          SA1    X2+4
          BX4    X4-X4
          MX6    12
          BX6    X6*X1
          ZR     X6,CAS1     IF FILE NOT PRESENT
          SX4    X2
 CAS1     REWIND SCR1,R      CHECK SCRATCH FILE NO. 2
          SA1    X2+4
          MX6    12
          BX6    X6*X1
          ZR     X6,CAS2     IF FILE NOT PRESENT
          LX4    18
          BX4    X4+X2
 CAS2     BX6    X4
          SA6    ASEQ        ASSIGNED EQUIPMENT WORD
          EQ     CASX        RETURN
 IJF      SPACE  4,15
**        IJF - INITIALIZE JOURNAL FILES.
*
*         POSITION EACH JOURNAL FILE TO THE END OF INFORMATION
*         AND WRITE A LABEL CONTAINING THE CURRENT DATE.
*
*         ENTRY  *JOUR0*, JOURNAL FILE ZERO.
*                *XXJORN*, DATA BASE JOURNAL FILES, IF THEY EXIST.
*
*         USES   A - 0, 1, 4, 5, 6, 7.
*                X - 0, 1, 2, 4, 5, 6, 7.
*                B - 4.
*
*         CALLS  PFE.
*
*         MACROS PDATE, WRITEF, WRITER, WRITEW.
 
 
 IJF      SUBR               ENTRY/EXIT
          PDATE  IJFC        SET PACKED DATE FOR JOURNAL LABEL
          TA5    0,VEDT
          LX5    -18
          SX0    X5          EDT COUNT
          SA0    JOUR0       JOURNAL FILE ZERO
          SX5    1
          EQ     IJF2        INITIALIZE JOURNAL FILE ZERO
 
 IJF1     ZR     X0,IJFX     IF NO MORE JOURNAL FILES, RETURN
          SA5    A5
          SA4    X5          NEXT EDT
          SA1    A5+1        EDT HEADER WORD WITH JOURNAL FILE INFO
          MX7    6
          BX7    X7*X1       JOURNAL FILE COUNT FOR DATA BASE
          LX1    -18
          SX0    X0-1        DECREMENT EDT COUNT
          SA0    X1          ADDRESS OF FIRST JOURNAL FET
          LX7    6
          SA5    A4+
          SX5    X7          JOURNAL COUNT FOR THIS EDT
 IJF2     ZR     X5,IJF1     NO MORE JOURNAL FILES FOR THIS EDT
          SA1    A0
          BX6    X1
          MX2    42
          BX7    X2*X1
          SA6    JF
          SA7    IJFD
          SB4    A6+
          RJ     PFE         POSITION TO EOI
          ZR     X6,IJF3     FILE TERMINATED BY EOF
          WRITEF JF,R        WRITE A FILE MARK
 
*         WRITE A LABEL TO JOURNAL FILE
 
 IJF3     WRITEW JF,IJFB,IJFBL     WRITE LABEL RECORD TO FILE
          WRITER JF,R
          SX5    X5-1        DECREMENT JOURNAL FILE COUNT
          SA0    A0+JFETL    BUMP FET POINTER FOR NEXT JOURNAL FILE
          EQ     IJF2
 
 JF       BSS    0
 IJFA     FILEB  OBUF,OBUFL  JOURNAL FILE INITIALIZATION FET
 
 IJFB     DIS    ,/*TRANEX*/
 
 IJFC     BSS    1           FOR PACKED DATE
 
 IJFD     BSS    1           JOURNAL FILE NAME
 
 IJFBL    EQU    *-IJFB      LENGTH OF LABEL RECORED FOR JOURNAL FILE
 PFE      SPACE  4,15
**        PFE    POSITION FILE TO END OF INFORMATION.
*
*         ENTRY  (B4) = FWA OF FET.
*
*         EXIT   (X6) .EQ. ZERO IF EOF TERMINATES FILE.
*                (X6) .GT. ZERO IF EOI TERMINATES FILE.
*                (X6) .LT. ZERO IF EOR TERMINATES FILE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         MACROS BKSP, READSKP, SKIPEI.
 
 
 PFE      SUBR               ENTRY/EXIT
          SKIPEI B4+         SKIP TO EOI
          BKSP   X2
          READSKP X2,,R      POSITION TO END OF DATA
          SA1    B4
          SX6    1775B
          BX6    X6*X1       *CIO* STATUS
          SX4    X6-31B
          SA1    B4+B1       RESET FET POINTERS
          MX6    -18
          BX6    -X6*X1
          SA6    A1+B1       IN  = FIRST
          SA6    A6+B1       OUT = FIRST
          SKIPEI X2          POSITION TO END OF DATA
          SX6    X4
          EQ     PFEX        RETURN
 LEC      SPACE  4,15
**        LEC - LOAD ECS RESIDENT TASKS INTO EXTENDED MEMORY.
*
*         LOAD ECS RESIDENT TASKS FROM MASS STORAGE INTO ECS.
*         INTERPRATIVE ECS MODE IS USED TO TRANSFER ECS BLOCKS TO
*         STORAGE.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2, 3, 4, 5, 7.
*
*         CALLS  CDD, SNM.
*
*         MACROS ABORT, MESSAGE, READ, READW.
 
 
 LEC      SUBR               ENTRY/EXIT
          TA5    -1,VTLD     FWA-1 OF TLD
          SA1    VECSC       CURRENT ECS ADDRESS
          BX7    X5          TASK LIBRARY FILE NAME
          BX0    X1
          SA0    ESBUF       BUFFER FWA
          SA7    TL
 LEC1     SA2    A5+B1       READ TASK NAME
          SA5    A5+TLDLE    WORD 3 OF THE DIRECTORY
          LX5    59-56       POSITION TO EXTENDED MEMORY RESIDENT BIT
          ZR     X2,LEC10    IF END OF CURRENT DIRECTORY
          PL     X5,LEC1     IF TASK NOT EXTENDED MEMORY RESIDENT
 LEC2     SA2    A5-B1       WORD 2 OF DIRECTORY
          LX2    TLFLN-TLFLS-1  GET TASK FIELD LENGTH
          MX1    -TLFLN
          BX5    -X1*X2
          SA2    VECS        READ REMAINING ECS
          LX5    6
          IX3    X5+X0
          IX4    X2-X3
          PL     X4,LEC3     IF SPACE REMAINING TO LOAD THIS TASK
 
*         PROCESS TASK NOT LOADED INTO EXTENDED MEMORY.
 
          SA2    A5
          MX1    -1
          LX1    56-0
          BX6    X1*X2
          SA6    A5          CLEAR EXTENDED MEMORY BIT
          SX3    B1
          SA2    LECB
          IX6    X3+X2       INCREMENT TASKS-NOT-LOADED COUNT
          SA6    A2+
          EQ     LEC1        CONTINUE PROCESSING DIRECTORY
 
*         SET UP FET FOR READING TASK TO MEMORY.
 
 LEC3     SA1    A5-2        TASK NAME
          MX6    42
          BX1    X6*X1
          SB2    1R+         REPLACEMENT CHARACTER
          SB3    DAYB        ALTERNATE BUFFER
          SB5    -LECH
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB,1    * LOADING EXTENDED MEMORY TASK - +++++++.*
          SX7    EBUF
          SA3    TL+1
          MX1    42
          BX2    X1*X3
          BX6    X2+X7
          SA7    A3+B1       IN
          SA6    A3          FIRST
          SA7    A7+B1       OUT
          SA2    A7+B1
          BX1    X1*X2
          SX6    X6+EBUFL
          BX7    X1+X6
          SA7    A2          LIMIT
          SA2    A5-B1       WORD 2 OF DIRECTORY
          LX2    30          DISK ADDRESS
          MX1    -30
          BX6    -X1*X2
          SA6    A7+2        RANDOM ADDRESS
          LX2    18          TASK FL
          SX5    X2
          AX5    6
          LX5    6
          READ   TL          INITIATE READ
 
*         TRANSFER TASK TO EXTENDED MEMORY.
 
          SX2    B2+
          LX2    59-29
          BX6    X2+X0
          SA6    LECA        SAVE (B2) AND (X0)
 LEC4     SB7    ESBUFL
          READW  TL,A0,B7    READ PART OF TASK
          SB4    ESBUFL
          ZR     X1,LEC5     IF NOT EOR/EOF/EOI
          NG     X1,LEC9     IF EOF/EOI - *LIBRARY STRUCTURE ERROR*
          SB2    A0
          SB4    B6-B2
          ZR     B4,LEC7     IF BUFFER EMPTY
 LEC5     SX2    B4
          IX5    X5-X2
          NG     X5,LEC9     IF RECORD GREATER THAN FL *LIBRARY ERROR*
 
*         TRANSFER BLOCK TO EXTENDED MEMORY.
 
 LEC6     WE     B4
          JP     LEC8        IF EXTENDED MEMORY WRITE ERROR
 
          SX2    B4
          IX0    X2+X0       INCREMENT EXTENDED MEMORY ADDRESS
          SX2    B4-ESBUFL
          ZR     X2,LEC4     IF NOT EOR
 
*         TRANSFER COMPLETE.
 
 LEC7     BX6    X0
          SA6    VECSC       CURRENT NEXT AVAILABLE ECS ADDRESS
          SA2    A5-B1       WORD 2 OF DIRECTORY
          MX1    -30
          BX3    -X1*X2
          SA4    LECA        GET EXTENDED MEMORY FWA
          LX4    59-29
          SB2    X4          RESTORE (B2)
          BX4    X1*X4
          BX6    X4+X3
          SA6    A2+         PUT EXTENDED MEMORY ADDRESS IN DIRECTORY
          EQ     LEC1        CONTINUE PROCESSING DIRECTORY
 
*         ERROR PROCESSING.
 
 LEC8     MESSAGE  LECE,3,R  * ECS WRITE PARITY ERROR ENCOUNTERED.*
          SA2    LECA
          LX2    59-29
          SB2    X2          RESTORE (B2)
          SX1    ESBUFL
          IX0    X0+X1       INCREMENT PAST ERROR
          EQ     LEC2        RETRY LOAD
 
*         ERROR IN READING TASK LIBRARY.
 
 LEC9     MX0    42          READ TASK LIBRARY NAME
          SA1    TL
          BX1    X0*X1
          SB2    1R+         REPLACEMENT CHARACTER
          SB3    DAYB        ALTERNATIVE BUFFER
          SB5    -LECF
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB,3,R  *ERROR IN READING TASK LIBRARY - +++++++.*
          ABORT
 
*         SEARCH FOR NEXT TLD.
 
 LEC10    SA1    LECC
          NZ     X1,LEC11    IF NOT FIRST DATA BASE LIBRARY SEARCH
          SA1    VEDT        START OF EDTS
          LX1    -24
          SA3    X1
          LX3    -18
          SX7    X3          COUNT OF EDTS TO CHECK FOR *DBTASKL*
          SA7    LECD
 LEC11    SA2    LECD
          ZR     X2,LEC12    IF NO MORE TLD-S TO SEARCH
          SA1    X1          NEXT EDT
          SA3    A1+4        *DBTASKL* FWA,LWA IF PRESENT FOR THIS D.B.
          SB2    X3          LWA OF TLD
          LX3    -18
          SX6    X2-1        DECREMENT COUNT OF EDTS
          SA6    A2
          ZR     X3,LEC11    IF NO LIBRARY FOR THIS DATA BASE
          BX7    X1
          SB3    X3          FWA OF TLD
          SA7    LECC
          SA5    B3-B1
          BX7    X5          TASK LIBRARY FILE NAME
          SA7    TL
          EQ     LEC1        SEARCH *DBTASKL* FOR ECS RESIDENT TASKS
 
*         END PROCESSING.
 
 LEC12    SA1    LECB        TASKS NOT LOADED COUNT
          ZR     X1,LECX     IF ALL TASKS LOADED INTO EXTENDED MEMORY
          RJ     CDD         CONVERT CONSTANT TO DECIMAL DISPLAY
          BX1    X4
          SB2    1R+         REPLACEMENT CHARACTER
          SB3    DAYB        ALTERNATIVE BUFFER
          SB5    -LECG       FWA OF FORMATTED TEXT
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB,3,R  * +++ TASK(S) NOT LOADED INTO EXT. MEM.*
          EQ     LECX        RETURN
 
 LECA     BSSZ   1
 LECB     BSSZ   1
 LECC     DATA   0           *DBTASKL*FWA,LWA POINTERS
 LECD     DATA   0           COUNT OF EDTS
 LECE     DATA   C* EXTENDED MEMORY WRITE PARITY ERROR ENCOUNTERED.*
 LECF     DATA   C* ERROR IN READING TASK LIBRARY - +++++++.*
 LECG     DATA   C* +++ TASK(S) NOT LOADED INTO EXTENDED MEMORY.*
 LECH     DATA   C* LOADING EXTENDED MEMORY TASK - +++++++.*
 
 
*         THE FOLLOWING TEMPORARY BUFFER AREAS ARE USED BY *LEC*
*         IN THE LOADING OF EXTENDED MEMORY RESIDENT TASKS.  THE
*         BUFFERS OVERLAY *TAF* PRESET CODE THAT HAS BEEN PREVIOUSLY
*         EXECUTED AND THE FIXED LENGTH BUFFER AREAS.
 
 
 EBUF     BSS    0           SCRATCH BUFFER FOR EXTENDED MEMORY LOAD
 EBUFL    EQU    401B        BUFFER LENGTH
 ESBUF    EQU    EBUF+EBUFL  WORKING STORAGE AREA FOR ECS LOAD
 ESBUFL   EQU    400B        WORKING STORAGE BUFFER LENGTH
 
          ERRNG  LAST-ESBUF-ESBUFL IF BUFFER OVERFLOW THEN ERROR
 LCT      SPACE  4,10
**        LCT - LOAD CM RESIDENT TASKS.
*
*         THIS ROUTINE SCANS THE TASK LIBRARY DIRECTORIES AND LOADS
*         ONE COPY OF EACH CM RESIDENT TASK AT A SUBCONTROL POINT.
*         LOGICALLY DELETED TASKS ARE IGNORED.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                X - ALL.
*                B - 2, 3, 4, 6, 7.
*
*         MACROS READSKP.
 
 
 LCT      SUBR               ENTRY/EXIT
          TB2    0,VTLD      START OF TLD
          TB3    -1,VTLD,LWA END OF TLD
          TB7    0,VCPA      FIRST SUB CONTROL POINT
          SB6    TLDLE
 LCT1     SA4    B2+2
          ZR     X4,LCT5     IF NO MORE TASKS TO CHECK IN THIS TLD
          SB2    B2+B6
          LX4    59-TLCMS
          PL     X4,LCT1     NOT A CM RESIDENT TASK
          LX4    59-TLDLS-59+TLCMS
          NG     X4,LCT1     IF TASK LOGICALLY DELETED
          SA2    A4-2        TASK NAME
          SA3    ITAS        INITIAL TASKS NAME
          MX1    42
          BX2    X1*X2
          IX3    X2-X3
          SA1    B7
          ZR     X3,LCT1     DONT LOAD INITIAL TASK AGAIN
          TX6    A4-1,-VTLD  TLD BIAS
          SA2    A4-B1
          SX5    X1          RA OF PREVIOUS SUB CP
          LX1    -18
          SX3    X1          FL OF PREVIOUS SUB CP
          LX6    -12
          IX0    X5+X3       START OF THIS SUB CP
          SX5    B7+         LAST SUBCP
          SX0    X0+NUAPL    RA OF THIS SUB CP
          SA1    A2-B1
          LX5    18
          SA3    AVAILCM
          BX6    X6+X5       TASK ID PLUS LAST SUB CP
          MX4    -TLFLN      GET TASK FIELD LENGTH
          LX2    TLFLN-TLFLS-1
          BX4    -X4*X2
          LX4    6
          SX1    X1          ENTRY POINT
          SX5    X4+NUAPL    TOTAL TASK FIELD LENGTH
          SB4    X4-77B+16B
          IX7    X3-X5
          TA5    0,VNACP     FIRST FREE SUB CONTROL POINT
          SA7    A3
          LX4    18
          SA3    X5          NEXT FREE SUB CONTROL POINT
          SB7    X5
          LX7    36
          BX4    X7+X4       FREE CORE COUNT AND FIELD LENGTH
          LX2    TLDAN-TLDAS-1-TLFLN+TLFLS+1
          BX7    X3
          LX1    18
          SA7    A5          RESET FREE SUB CONTROL POINT LINK
          SX3    3           CORE RESIDENT AND REUSEABLE INDICATORS
          BX7    X4+X0
          LX3    -3
          SA7    X5          1ST WORD OF SUB CP TABLE
          SX4    100         TIME SLICE LIMIT
          BX7    X3+X1
          LX4    36
          SA7    X5+B1       2ND WORD OF SUB CP TABLE
          BX6    X4+X6
          MX3    30
          SA6    A7+B1       3RD WORD OF SUB CP TABLE
          SX1    X0+77B-16B  START FOR TASK LOAD
          BX6    -X3*X2      RANDOM DISK INDEX FOR TASK
          SA2    TL+1        FIRST
          MX4    -18
          BX7    X4*X2
          SA6    TL+6        RANDOM DISK INDEX
          BX7    X7+X1
          SA7    A2
          SX6    X1+B4
          SX7    X1
          SA7    A7+B1       IN
          SA7    A7+B1       OUT
          SA6    A7+1        LIMIT
          READSKP  TL,,R     LOAD TASK INTO CENTRAL MEMORY
          SA1    B7-CPAL+2
          SX7    B7
          BX7    X1+X7       SET FORWARD LINK IN PREVIOUS SUB CP
          SA2    LCTA
          SA7    A1
          BX6    X2
          SA6    X0-NUAPL+CB1C SET TASK PRIORITY
          SA1    B7-CPAL
          MX3    24
          BX7    -X3*X1      SET FREE CORE COUNT TO ZERO
          SA7    A1+
          EQ     LCT1        CHECK FOR MORE CM RESIDENT TASKS
 
 LCT5     SA1    LCTD
          NZ     X1,LCT6     IF NOT FIRST *DBTASKL* SEARCH
          SA1    VEDT        START OF EDTS
          LX1    -24
          SA3    X1
          LX3    -18
          SX7    X3          COUNT OF EDTS TO CHECK FOR *DBTASKL*
          SA7    LCTE
 LCT6     SA2    LCTE
          ZR     X2,LCTX     IF LAST TLD SEARCHED, RETURN
          SA1    X1          NEXT EDT
          SA3    A1+4        *DBTASKL* FWA,LWA IF PRESENT FOR THIS D.B.
          SB3    X3          LWA OF TLD
          LX3    -18
          SX6    X2-1        DECREMENT COUNT OF EDTS
          SA6    A2
          ZR     X3,LCT6     IF NO *DBTASKL* FOR THIS DATA BASE
          BX7    X1
          SB2    X3          FWA OF TLD
          SA7    LCTD
          SA1    B2-B1
          BX7    X1          TASK LIBRARY FILE NAME
          SA7    TL
          EQ     LCT1        SEARCH THIS *DBTASKL* FOR CORE RES. TASKS
 
 LCTA     VFD    12/DCPPR+1,48/0  HIGHER THAN DEFAULT CPU PRIORITY
 
 LCTB     BSSZ   1           CORE RESIDENT TASK COUNT
 
 LCTD     DATA   0           *DBTASKL* FWA,LWA POINTERS
 LCTE     DATA   0           COUNT OF EDTS
 LIT      SPACE  4,15
**        LIT - LOAD INITIAL TASK.
*
*         LOAD THE INITIAL TASK FROM THE SYSTEM TASK LIBRARY TO
*         SUBCONTROL POINT ONE.  THE INITIAL TASK REMAINS AT
*         THIS SUBCONTROL POINT AS LONG AS THE TRANSACTION
*         EXECUTIVE IS RUNNING.
*
*         ENTRY  (B2) = 1, SET CORE RESIDENT BIT FOR INITIAL TASK.
*                     = 0, DO NOT SET CORE RESIDENT BIT.
*                (LITA) = *ITASK* BIAS.
*                (LITC) = FWA OF *ITASK* TLD ENTRY.
*
*         USES   A - 1, 2, 3, 5, 6, 7.
*                X - ALL.
*                B - 2.
*
*         MACROS READSKP, RECALL.
 
 
 LIT      SUBR               ENTRY/EXIT
          RECALL TL
          SA2    LITA        SET *ITASK* BIAS
          SA1    LITC        GET FWA OF *ITASK* TLD ENTRY
          BX6    X2
          SA2    X1+B1       WORD TWO OF TLD ENTRY
          SA1    X1+
          ZR     B2,LIT1     IF CORE RESIDENT BIT NOT TO BE SET
          MX7    1           SET CORE RESIDENT BIT FOR INITIAL TASK
          SA3    A2+B1
          LX7    TLCMS-59
          BX7    X7+X3
          SA7    A3+
          EQ     LITX        RETURN
 
 LIT1     MX4    -TLFLN      GET TASK FIELD LENGTH
          TX0    NUAPL,VFSCP RA FOR INITIAL TASK
          SA3    AVAILCM
          LX2    TLFLN-TLFLS-1
          BX4    -X4*X2
          LX4    6
          SX1    X1          ENTRY POINT
          SX5    X4+NUAPL    TOTAL TASK FIELD LENGTH
          SB2    X4-77B+16B
          IX7    X3-X5
          TA5    0,VNACP     FIRST FREE SUB CONTROL POINT
          SA7    A3
          LX4    18
          SA3    X5          NEXT FREE SUB CONTROL POINT
          LX7    36
          BX4    X7+X4       FREE CORE COUNT AND FIELD LENGTH
          LX2    TLDAN-TLDAS-1-TLFLN+TLFLS+1
          BX7    X3
          LX1    18
          SA7    A5          RESET FREE SUB CONTROL POINT LINK
          SX3    7           SYSTEM TASK AND CORE RESIDENT
          BX7    X4+X0
          LX3    -3
          SA7    X5          1ST WORD OF SUB CP TABLE
          SX4    100         TIME SLICE LIMIT
          BX7    X3+X1
          LX4    36
          SA7    X5+B1       2ND WORD OF SUB CP TABLE
          BX6    X4+X6
          MX3    30
          SA6    A7+B1       3RD WORD OF SUB CP TABLE
          TX1    NUAPL+77B-16B,VFSCP  START FOR LOAD
          BX6    -X3*X2      RANDOM DISK INDEX FOR INITIAL TASK
          SA2    TL+1        FIRST
          MX4    -18
          BX7    X4*X2
          SA6    TL+6        RANDOM DISK INDEX
          BX7    X7+X1
          SA7    A2
          SX6    X1+B2
          SX7    X1
          SA7    A7+B1       IN
          SA7    A7+B1       OUT
          SA6    A7+B1       LIMIT
          READSKP  TL,,R     LOAD INITIAL TASK
          SA1    LITB
          BX7    X1
          TA7    CB1C,VFSCP
          EQ     LITX        RETURN
 
 LITA     BSS    1           *ITASK* BIAS FROM *PRE*
 LITB     VFD    12/DCPPR,48/0  DEFAULT TASK PRIORITY
 LITC     BSS    1           FWA OF *ITASK* ENTRY IN TLD FROM *PRE*
 PBI      SPACE  4,20
**        PBI - POTENTIALLY BLOCKED TASKS DURING INITIALIZATION.
*
*         THIS ROUTINE MAKES THE CALCULATIONS NECESSARY TO DETECT
*         A POTENTIALLY BLOCKED TASK AT INITIALIZATION AND INSURES
*         THAT ENOUGH SUBCONTROL POINTS EXIST BEFORE CM RESIDENT
*         TASKS ARE LOADED.
*
*         EXIT   (AVAILCM) = AVAILABLE CENTRAL MEMORY.
*                (CURFL) = CURRENT FIELD LENGTH.
*                ABORT - IF INSUFFICIENT SUBCONTROL POINTS.
*                ABORT - IF BLOCKED TASKS DETECTED.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                X - ALL.
*                B - 2, 3, 5.
*
*         CALLS  CDD, DBC, DBN, RTD, SNM.
*
*         MACROS ABORT, MEMORY, MESSAGE.
 
 
 PBI      SUBR               ENTRY/EXIT
          BX6    X6-X6
          SB5    B0          INITIALIZE TASK COUNTER
          SA6    CMRFL       INITIALIZE ACCUMULATOR
          SA6    CMRPF       INITIALIZE ACCUMULATOR
          SA6    DPBK        SET FOR INITIALIZATION
 
*         FIRST PASS THROUGH TASK LIBRARY DIRECTORIES.
 
          SB3    -1          READ ALL TLD ENTRIES
          TA5    0,VTLD      EXAMINE SYSTEM TLD
          RJ     RTD         RETURN TASK LIBRARY DATA
          TA4    0,VEDT      GET ADDRESS OF FIRST TLD
          BX0    X4          CHECK EDT COUNT
          LX0    -18
          SX0    X0+
          ZR     X0,PBI3     IF NO MORE EDT-S
 PBI1     SX0    X4          SAVE LINK TO NEXT HEADER
          SA5    A4+4        GET FWA OF TLD IN WORD 5
          AX5    18
          ZR     X5,PBI2     IF LIBRARY NOT ATTACHED
          SA5    X5          SET UP SEARCH ADDRESS
          SB3    -B1         READ ALL TLD ENTRIES
          RJ     RTD         RETURN TASK LIBRARY DATA
 PBI2     ZR     X0,PBI3     IF NO MORE DIRECTORIES
          SA4    X0+         RESTORE LINK TO NEXT HEADER
          EQ     PBI1        PROCESS NEXT TLD
 
*         CHECK IF ENOUGH SUBCONTROL POINTS EXIST.
 
 PBI3     TB2    0,VNSCP     GET NUMBER OF SUBCP INITIALIZED
          SA3    RTDA        CHECK EXISTENCE OF NON CM RESIDENT TASKS
          ZR     X3,PBI4     IF NO NON CM RESIDENT TASKS EXIST
          SB6    B5+1
 PBI4     LT     B2,B6,PBI5  IF NOT ENOUGH SUBCONTROL POINTS
 
*         SET CORE RESIDENT TASK COUNT.
 
          SX2    B5+         GET CM RESIDENT TASK COUNT
          TA1    -3,VTLD     WORD 2 OF TLD HEADER
          MX3    42
          BX6    X3*X1
          BX6    X6+X2       PUT CM RESIDENT TASK COUNT IN HEADER
          SA6    A1
          SA1    MFL         MFL OF TAF
          BX6    X1
          SA6    DPBJ
 
*         LOOK FOR POTENTIAL BLOCKS.
 
          RJ     DBC         DETECT BLOCKS IN CM RESIDENT TASKS
          RJ     DBN         DETECT BLOCKS IN NON CM RESIDENT TASKS
          NE     B7,PBI6     IF BLOCKED TASKS DETECTED
 
*         COMPUTE THE *RFL* NEEDED FOR *TAF* TO LOAD CM RESIDENT TASKS.
 
          SA1    CMRFL
          TX2    0,VFSCP     FWA OF ALLOCATABLE TAF FL
          IX6    X1+X2       FL TO BE REQUESTED
          LX6    30
          SA6    PBIB
          MEMORY CM,PBIB,R   REQUEST FIELD LENGTH FOR TAF
          SA2    PBIB
          LX2    30
          SX6    X2          FL REQUESTED
          SA6    CURFL       CURRENT FIELD LENGTH
          SA1    CMRFL
          BX7    X1
          SA7    AVAILCM     AVAILABLE CENTRAL MEMORY
          EQ     PBIX        RETURN
 
 PBI5     SX1    B6+
          RJ     CDD         CONSTANT TO DECIMAL DISPLAY CODE
          SB2    1RX         SET REPLACEMENT CHARACTER
          SB5    PBIA        FWA OF MESSAGE
          BX1    X6
          LX1    48
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  PBIA      INSUFFICIENT SUBCONTROL POINTS
          ABORT
 
 PBI6     MESSAGE  PBIC      * POTENTIALLY BLOCKED TASKS DETECTED.*
          ABORT
 
 PBIA     DATA   C* NEED AT LEAST XX SUBCONTROL POINTS.*
 
 PBIB     BSS    1           STATUS RETURN FOR MEMORY MACRO
 PBIC     DATA   C* POTENTIALLY BLOCKED TASKS DETECTED.*
 PVV      SPACE  4,15
**        PVV - SET INITIALIZATION DETERMINED VALUES.
*
*         EXIT   (DBAA) = *DBA* STATUS WORD.
*                (DTSE+1) = USER NAME ADDED TO DEFAULT DUMP PARAMETERS.
*                (MFL) = MAXIMUM FL ALLOWED.
*                (TL) = TASK LIBRARY NAME IN FET.
*
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 6, 7.
*
*         MACROS MEMORY, RECALL.
 
 
 PVV      SUBR               ENTRY/EXIT
          SA1    VMFL
          BX6    X1          MAXIMUM FIELD LENGTH
          SA6    MFL
          SA2    VUSN        TAF USER NAME
          SA1    VTFL        TASK LIBRARY FILE NAME
          BX6    X1
          SA1    DTSE+1      ADD DEFAULT USER NAME
          SA6    TL
          BX6    X1+X2
          SA6    A1
          EQ     PVVX        RETURN
 
 PVV1     RECALL             DEBUGING AID
          SA1    B0
          LX1    -1
          PL     X1,PVV1     LOOP UNTIL GIVEN GO AHEAD
          EQ     PVVX        RETURN
 
 PVVA     CON    0           MEMORY STATUS WORD
 
*         REMOTE CODE CONTAINING THE VARIABLE TABLE/BUFFER REFERENCES
 
 TINST    BSS    0
 TINST    HERE
 TINSTL   EQU    *-TINST
          ERRNG  LAST-*      PRESET OVERFLOW INTO TABLES
 BUFFERS  TITLE  BUFFERS AND SUBCP-S.
*         FIXED LENGTH BUFFERS.
 
 JBUFL    EQU    1201B
 JBUF0    EQU    ENDT
 
 TDIBFL   EQU    TIMDM       LENGTH OF TOTAL INPUT BUFFER
 TDIBF    EQU    JBUF0+JBUFL TOTAL D.M. INPUT BUFFER
 
 TDOBFL   EQU    30B         LENGTH OF TOTAL OUTPUT BUFFER
 TDOBF    EQU    TDIBF+TDIBFL TOTAL OUTPUT BUFFER
 
 OBUFL    EQU    401B
 
 OBUF     EQU    TDOBF+TDOBFL OUTPUT BUFFER
 
 SBUFL    EQU    100B
 SBUF     EQU    OBUF+OBUFL  SCRATCH WORKING BUFFER
 
 PBUFL    EQU    30*ITTPL    SPACE FOR 30 INTERNAL TRACE PACKETS
 PBUF     EQU    SBUF+SBUFL  INTERNAL TRACE BUFFER
 
 LASTF    EQU    PBUF+PBUFL  LAST ADDRESS OF FIXED FIELD LENGTH
 TROVL    EQU    LASTF+1
 
          TRANOVL (PROCESS TASK DUMP.)
 DTS      SPACE  4,10
**        DTS - DUMP A TASKS FIELD LENGTH AND ASSOCIATED CONTROL AREAS.
*
*         DTS FORMATS A JOB FILE CONTAINING THE TASK DUMP AREAS AND
*         CONTROL BLOCKS AND SUBMITS THIS FILE TO THE SYSTEM FOR BATCH
*         PROCESSING.
*
*         REFERENCE *KTSDMP* FOR FURTHER DOCUMENTATION OF DUMP FILE
*         FORMAT AND SUBSEQUENT PROCESSING.
*
*         ENTRY  (B2) = SUB CONTROL POINT AREA OF TASK.
*                (B3) = DUMP CONTROL WORDS.
*                (X0) = COMMUNICATION BLOCK ADDRESS.
*
*         CALLS  COD, GPW, RSP, SFN, SNM, ZTB.
*
*         MACROS CLOCK, DATE, MESSAGE, RETURN, REWIND, ROUTE, SUBMIT,
*                WRITER, WRITEW.
 
 
 DTS      BSS    0
          ENTRY  DTS
 
          SA2    B3          DSDUMP/CMDUMP CONTROL INFORMATION
          SX7    B0
          SA0    A2
          NG     X2,DTS1     IF TASK SUPPLIED DSDUMP PARAMETERS
          SA0    DTSE        SYSTEM DEFAULT DUMP PARAMETERS
 
*         FORMAT *ACCOUNT* COMMAND.
 
 DTS1     SA7    SF+6        CLEAR JOBNAME FROM FET+6
          REWIND SF,R        REWIND DUMP FILE
          SA1    X0+CMBHL    FIRST WORD OF COMMUNICATION BLOCK
          MX3    12
          BX3    X3*X1       DATA BASE NAME
          TB3    0,VEDT      EDT HEADER WORD
 DTS2     SA4    B3+
          BX1    X3*X4       EDT DATA BASE NAME
          BX1    X1-X3
          SB3    X4+
          ZR     X1,DTS3     IF DATA BASE MATCH FOUND
          NZ     B3,DTS2     IF NO MATCH
          RJ     GPW         GET TAF PASSWORD
          SA4    VUSN-2      USE DEFAULT SYSTEM USER NAME/PASSWORD
 DTS3     SA1    A4+2        USER NAME
          MX0    42
          SA5    A1+B1       PASSWORD
          BX7    X7-X7
          SA7    VPWD        CLEAR TAF PASSWORD
          BX1    X0*X1
          BX5    X0*X5
          RJ     SFN         SPACE FILL NAME
          BX4    X0*X6       SPACE FILLED USER NAME
          BX1    X5
          RJ     SFN         SPACE FILL NAME
          SA1    DTSB        ACCOUNT COMMAND
          BX2    X0*X6       SPACE FILLED PASSWORD
          MX6    48
          BX7    X6*X1       MERGE USER NUMBER/PASSWORD INTO CARD IMAGE
          LX4    12
          BX1    -X6*X4
          LX2    24
          SX3    1R,
          BX7    X7+X1
          SA7    A1          FIRST LINE
          MX0    -24
          BX6    X6*X4
          LX3    24
          BX7    -X0*X2
          IX6    X6+X3
          BX7    X7+X6       SECOND LINE
          SX1    1R.
          SA7    A7+B1
          BX6    X0*X2
          LX1    36
          BX7    X1+X6       THIRD LINE
          SA7    A7+B1
 
*         FORMAT *ROUTE* COMMAND.
 
          SA3    A0+B1
          MX0    -12
          BX5    -X0*X3      ORIGIN TYPE
          MX6    42
          SX7    X5-2
          BX3    X6*X3       DESTINATION PARAMETER
          ZR     X7,DTS6     IF USER PERMANENT FILE OPTION SPECIFIED
          ZR     X5,DTS4     IF ROUTE TO LOCAL PRINTER (BATCH QUEUE)
          SX2    3RUN=
          LX2    42
          AX3    18
          BX1    X2+X3
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA6    DTSD+2      COMPLETE *ROUTE* COMMAND
          EQ     DTS5        WRITE COMMANDS
 
 DTS4     MX7    -6
          MX0    -42
          AX3    18
          BX1    -X7*X3      PRINTER IDENTIFICATION FOR BATCH
          RJ     COD         CONVERT OCTAL TO DISPLAY
          AX4    18
          SX2    3RID=
          LX2    42
          BX4    -X0*X6
          BX6    X2+X4
          SA6    DTSD+2      COMPLETE *ROUTE* COMMAND
 
*         WRITE COMMANDS FOR BATCH OR *E/I* DUMP MODE.
 
 DTS5     WRITEW SF,DTSA,DTSA2L
          WRITER SF,R        WRITE COMMANDS
          EQ     DTS7        CONTINUE
 
*         SET UP COMMANDS FOR PERMANENT FILE DUMP OPTION.
 
 DTS6     SX4    2R,,
          SA1    DTSC        *KTSDMP* COMMAND
          MX7    36
          LX4    12
          BX1    X7*X1       KTSDMP
          MX0    48
          IX1    X1+X4       KTSDMP,,
          LX3    12
          SA4    DTSH        *,P.*
          BX6    -X0*X3
          BX6    X6+X1       KTSDMP,,FI
          SA6    A1
          BX1    X0*X3
          RJ     SFN         SPACE FILL USER NAME
          MX0    30
          BX7    X0*X6       LENAM
          BX7    X7+X4       LENAM,P.
          SA7    A6+B1
          WRITEW SF,DTSA,DTSA1L
          WRITER SF,R        WRITE COMMANDS
          SA1    DTSI        RESTORE *KTSDMP* COMMAND
          SX7    B0
          BX6    X1
          SA7    DTSC+1
          SA6    DTSC        *KTSDMP.*
 
*         FORMAT GENERAL INFORMATION SECTION.
 
 DTS7     SA1    SREG
          MX5    1
          AX1    18          POINTER TO TASK SYSTEM AREA
          SA1    X1+CB1C
          MX7    -24
          LX1    -18
          BX1    -X7*X1      TASK SEQUENCE NUMBER
          RJ     COD         CONVERT TO DISPLAY CODE
          SX6    2000B       GENERAL INFORMATION HEADER
          SB3    B2-B1
          AX7    X5,B3       DELETE TRAILING BLANKS
          BX7    X7*X4
          LX6    48
          SA7    DTSF-1      USE SEQUENCE NUMBER FOR DUMP RECORD NAME
          SA6    A7+B1
          SA1    SREG
          BX5    X1          EXCHANGE PACKAGE ADDRESS
          LX5    -18         RIGHT JUSTIFY FWA OF TASK SYSTEM AREA
          SA1    X1+2
          MX2    -12
          LX1    12          TASK LIBRARY INDEX
          BX1    -X2*X1
          TA2    X1-1,VTLD   TASK NAME
          MX6    42
          BX1    X6*X2       USE TASK NAME AS LABEL
          RJ     SFN         SPACE FILL NAME
          SA6    DTSF+1
          DATE   DTSF+2      DATE
          CLOCK  DTSF+3      CURRENT TIME
          WRITEW SF,DTSF-1,DTSFL+1  GENERAL INFORMATION BLOCK
 
*         FORMAT EXCHANGE PACKAGE SECTION.
 
          SA1    A0
          LX1    1
          PL     X1,DTS8     IF NO DUMP OF EXCHANGE PACKAGE DESIRED
          SX7    2002B       EXCHANGE PACKAGE DUMP HEADER
          SX2    NUAPL       LENGTH OF TASK SUB CP AREA
          LX7    48
          BX7    X7+X2
          SA7    DTSF
          WRITEW SF,DTSF,DTSFL  WRITE EXCHANGE PACKAGE CONTROL BLOCK
          WRITEW SF,X5,NUAPL WRITE TASK SUBCP AREA
 
*         FORMAT COMMUNICATION BLOCK SECTION.
 
 DTS8     LX5    18          RIGHT JUSTIFY FWA OF TASK SUBCP TABLE
          SA2    X5+B1       COMMUNICATION BLOCK ADDRESS
          LX5    -18         RIGHT JUSTIFY FWA OF TASK SYSTEM AREA
          SA3    X2
          SA1    X3+CMBHL    FIRST WORD OF COMMUNICATION BLOCK
          MX2    -24
          BX7    -X2*X1      TRANSACTION SEQUENCE NUMBER
          SA3    DTSG
          SA1    X5
          LX3    -24
          NZ     X3,DTS9     IF CALLED FROM ADDRESS GIVEN
          LX1    24
          BX3    -X2*X1      *P* ADDRESS OF SUB CONTROL POINT
 DTS9     SX1    2003B       COMMUNICATION BLOCK DUMP HEADER
          SA7    DTSF+2
          SX2    CMBL-CMBHL+3  LENGTH OF COMMUNICATION BLOCK + 3
          SX7    X3
          SA7    A7+B1       CALLED FROM ADDRESS
          LX1    48
          BX6    X2+X1
          SA6    DTSF
          WRITEW SF,DTSF,DTSFL  COMMUNICATION BLOCK CONTROL HEADER
          WRITEW SF,X5+NUAPL+SUAC,CMBL-CMBHL+3  WRITE C.B.
 
*         FORMAT TASK MEMORY DUMP SECTION.
 
          SA1    A0
          SX7    X1+         FWA OF TASK TO DUMP
          LX1    -30
          SX6    X1          LWA OF TASK TO DUMP
          IX0    X6-X7
          ZR     X0,DTS17    IF NO FIELD LENGTH TO DUMP
          SA1    X5+2
          LX1    24
          SX2    X1          TASK FL
          IX4    X2-X6
          PL     X4,DTS10    IF TASK FL .GE. LWA
          SX6    X2
          SX3    DSMNFL
          IX0    X6-X7
          IX4    X0-X3
          PL     X4,DTS10    IF LWA-FWA .GE. DSMNFL
          BX7    X7-X7
          IX0    X6-X7
 DTS10    SA7    DTSF+1
          SX5    X5+NUAPL    TASK RA
          SA6    A7+1
          SX3    2001B
          SX0    X0-1
          LX3    48
          BX6    X3+X0
          SA6    A7-B1       SET TOTAL AMOUNT OF MEMORY TO DUMP
          IX5    X5+X7
          WRITEW SF,DTSF,DTSFL  MEMORY BLOCK HEADER
          WRITEW SF,X5,X0-11B TASK MEMORY (COMPENSATE FOR *WRITEW*)
          IX5    X5+X0
          WRITEW SF,X5-11B,6 WRITE LAST 11B WORDS IN 2 BLOCKS
          WRITEW SF,X5-3,3
 
*         SUBMIT DUMP FILE TO INPUT QUEUE FOR PROCESSING.
 
 DTS17    WRITER SF,R        FLUSH BUFFER
          SA2    SF          SET FILE NAME
          MX0    42
          BX7    X0*X2
          SA7    TDSP
          SX6    B0+         CLEAR JOB ID
          SA6    TDSP+2
          SA1    A0+B1
          MX2    -3
          LX1    -12
          BX6    -X2*X1      ORIGIN CODE
          SX3    X6-BCOT
          ZR     X3,DTS18    IF BATCH ORIGIN
          MX0    -24         SET *TID* FOR IMPLICIT *EIOT* ROUTE
          BX6    -X0
          SA6    TDSP+2
 DTS18    RJ     RSP         RESTORE B2 AND B7
          SA1    DTSP        DSP PARAMETERS
          SA3    A1+B1
          SA4    LOVLX       GET RETURN ADDRESS
          LX4    -30+18
          BX3    X3+X4
          SA4    A3+B1
          EQ     RFQ         ROUTE FILE TO QUEUE
 
 
 DTSA     DIS    ,*DUMP.*
 DTSB     DIS    ,*ACCOUNT,USERNUM,PASSWOR.*
          IFC    NE,$"CGNM"$$
          DATA   C*CHARGE,"CGNM","PJNM".*
          ENDIF
 DTSC     DIS    ,*KTSDMP.       *
 DTSA1L   EQU    *-DTSA      LENGTH OF COMMAND BLOCK FOR PF
 DTSD     DIS    ,*ROUTE,OUTPUT,DC=PR, UN=USERNUM.*
 DTSA2L   EQU    *-DTSA      LENGTH OF COMMAND BLOCK FOR BC AND IE
 
 DTSFL    EQU    5           LENGTH OF A DUMP CONTROL BLOCK
          BSS    1
 DTSF     BSS    DTSFL       DUMP CONTROL BLOCK STORAGE
 
 DTSH     VFD    30/0,18/3R,P.,12/0
 DTSI     VFD    60/10HKTSDMP.
 
 
 DTSM     DATA   C* DSP ERROR XXB RETURNED ON JOB ROUTE.*
 
*         *DSP* PARAMETERS FOR KTSDMP OF TASK.
 
 DTSP     VFD    12/,12/,12/0LNO,6/,18/FRER+FRDC+FRTI
          VFD    24/,18/**,18/RFQ2  STATUS PROCESSOR INFORMATION
          DATA   L*K KTSDUMP.*
 GPW      SPACE  4,10
**        GPW - GET PASSWORD.
*
*         GET TAF PASSWORD FROM TAF CONFIGURATION FILE.
*
*         EXIT   (VPWD) = TAF PASSWORD.
*                (A0) = ENTRY VALUE.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 7.
*                A - 1, 4, 5, 7.
*                B - 7.
*
*         CALLS  UPC.
*
*         MACROS ABORT, MESSAGE, READ, READC, REWIND.
 
 
 GPW      SUBR               ENTRY/EXIT
          REWIND TCF,R
          READ   TCF
 
*         READ AND UNPACK *TCF* STATEMENT.
 
 GPW1     READC  TCF,GPWB,GPWBL  READ *TCF* STATEMENT
          NZ     X1,GPW3     IF NO MORE STATEMENTS IN THE *TCF*
          SA5    GPWB        FIRST WORD TO UNPACK
          SB7    GPWC        FWA TO UNPACK INTO
          RJ     UPC         UNPACK STATEMENT
          NZ     X6,GPW4     IF UNPACK ERROR
          MX0    42
          SA1    GPWC
          SA4    GPWA        FWA OF STATEMENT TABLE
 
*         SEARCH FOR STATEMENT IN TABLE.
 
 GPW2     ZR     X4,GPW1     IF END OF TABLE
          BX5    X1-X4
          BX2    X0*X5
          SA4    A4+B1
          NZ     X2,GPW2     IF NO MATCH
 
*         GET TAF PASSWORD FROM STATEMENT.
 
          MX3    42
          SA1    A1+2
          BX7    X3*X1       PASSWORD
          SA7    VPWD
          BX7    X7-X7       CLEAR PASSWORD STORAGE AREA
          SA7    A1
          EQ     GPWX        RETURN
 
 GPW3     SX1    GPWD        *NO USER OR ACCOUNT STATEMENT IN THE TCF*
          EQ     GPW5        ISSUE MESSAGE
 
 GPW4     SX1    GPWE        *INCORRECT TCF ENTRY*
 GPW5     MESSAGE  X1,0,R    ISSUE MESSAGE
          ABORT
 
*         RELEVANT *TCF* STATEMENT TABLE.
 
 GPWA     VFD    42/0LACCOUNT,18/0  *ACCOUNT* STATEMENT
          VFD    42/0LUSER,18/0  *USER* STATEMENT
          CON    0           TABLE TERMINATOR
 
 GPWB     BSSZ   16          BUFFER FOR *TCF* STATEMENT
 GPWBL    EQU    *-GPWB      BUFFER LENGTH
 GPWC     BSSZ   80          BUFFER FOR UNPACKED *TCF* STATEMENT
 
 GPWD     DATA   C* NO USER OR ACCOUNT STATEMENT IN THE TCF.*
 GPWE     DATA   C* INCORRECT TCF ENTRY.*
          SPACE  4,10
*CALL     COMCRDC
          SPACE  4,10
*         *TCF* FET.
 
 TCF      BSS    0           TAF CONFIGURATION FILE
 TCF      FILEC  TCBUF,TCBUFL,FET=13,EPR
 
*         *TCF* BUFFER.
 
 TCBUFL   EQU    2*64+1
 TCBUF    BSS    TCBUFL      BUFFER FOR *TCF*
          ENDOVL
          TRANOVL (EXTENDED MEMORY ERROR PROCESSING.)
 ECE      SPACE  4
**        ECE - PROCESS EXTENDED MEMORY READ ERROR FROM TASK LIBRARY.
*
*         ENTRY  (ECRA) = 6/,18/EDT,18/TFL,18/SCP
*                (X5) = 30/TLN, 30/RDA
*
*                EDT - ELEMENT DESCRIPTOR TABLE ADDRESS.
*                TFL - TASK FIELD LENGTH.
*                SCP - START OF SUB CP TABLE.
*                TLN - ADDRESS OF TASK LIBRARY NAME.
*                RDA - RANDOM DISK/EXTENDED MEMORY ADDRESS OF TASK.
*
*         EXIT   TO *SCHD11* - (X7) AND (X5) RETURNED FOR DISK LOADING.
*
*         USES   A - ALL.
*                X - ALL.
*                B - 3, 4, 5, 7.
*
*
*         CALLS  COD, SNM.
*
*         MACROS ATTACH, ENTRY, MESSAGE, READ, READW, RECALL, SKIPB,
*                SKIPEI.
 
 
 ECE      BSS    0
          ENTRY  ECE
 
          SB4    SCHD1       SET SCHEDULAR LOADER EXIT
          SA1    ECRA        PARAMETERS FOR ECS ERROR PROCESSING
          BX7    X1
          MESSAGE  ECEE,3,R  * EXTENDED MEMORY READ ERROR.*
 ECE1     BX6    X5          SAVE X5 AND X7
          SA6    ECEA
          BX0    X7
          SX6    B2          SAVE B2, B4 AND B7
          LX6    18
          SX4    B7
          BX6    X6+X4
          LX6    18
          SX4    B4
          BX6    X6+X4
          SA6    A6+B1
 
*         ATTACH LIBRARY FILE IN MODIFY MODE.
 
          RECALL TL          WAIT FOR LIBRARY FILE IDLE
          LX0    -36         EDT ADDRESS
          MX2    42          USER NAME
          SA3    X0+2
          BX3    X2*X3
          BX7    X7-X7       CLEAR PACKNAME FROM FET
          SA7    TL+CFPK
          MX6    -48
          SA4    VUSN        SYSTEM USER NAME
          BX1    X3-X4
          ZR     X1,ECE2     IF SYSTEM TASK LIBRARY
          SA4    X0+5        PACK NAME AND DEVICE TYPE TO FET
          MX2    -12
          LX2    6
          BX7    X2*X4
          LX4    59-17
          SA1    TL+1
          SA7    A7
          BX7    -X6*X1
          BX4    X6*X4
          BX7    X7+X4
          SA7    A1+
 ECE2     LX5    30          SET LIBRARY NAME IN FET
          SA2    X5+
          BX6    X2
          SA6    TL
          MX2    1           SET *EPR* FOR THIS ATTACH
          LX2    44-59
          SA5    A6+1
          BX6    X2+X5
          SA6    A5
          ATTACH TL,,X3,,M   ATTACH LIBRARY FILE IN MODIFY MODE
          SA1    X2          CHECK STATUS
          BX7    X5          CLEAR *EPR*
          MX2    -4
          SA7    A5
          LX1    -10
          BX2    -X2*X1
          NZ     X2,ECE7     IF ATTACH ERROR
 
*         READ LIBRARY DIRECTORY.
 
          SX6    OBUF
          SA1    TL+1        SET FET BUFFER ADDRESSES
          MX2    42
          BX7    X2*X1
          BX7    X7+X6
          SA6    A1+B1       IN
          SA7    A1          FIRST
          SA6    A6+B1       OUT
          SA3    A6+B1       LIMIT
          BX7    X2*X3
          SX6    X6+OBUFL
          BX7    X7+X6
          SA7    A3
          SKIPEI TL          SKIP TO EOI
          SKIPB  TL,2        BACKSPACE TO POSITION AT DIRECTORY
          READ   TL          START READ OF DIRECTORY
 
*         FIND ENTRY ON LIBRARY DIRECTORY FOR TASK.
 
          LX0    36          SCP ADDRESS
          SA1    X0          SET BUFFER AT SUBCONTROL POINT RA+100B-4
          SA0    X1+100B-TLDLH
          SA2    A1+2        TASK DIRECTORY INDEX
          MX3    12
          BX4    X3*X2
          LX4    12
          TA5    X4-1,VTLD   FIRST WORD OF TLD ENTRY
          MX2    42
          BX5    X2*X5       TASK NAME
          SB7    TLDLH+TLDLE*10  BUFFER LENGTH (HEADER + 10 ENTRIES)
          READW  TL,A0,B7    READ DIRECTORY
          NG     X1,ECE6     IF DIRECTORY EMPTY
          SA0    A0+TLDLH
          SB4    A0+
 ECE3     SB5    X1
          MX3    42
          NZ     X1,ECE4     IF EOR
          SB5    A0+10*TLDLE
 ECE4     SA2    B4+         LOOK FOR MATCHING ENTRIES
          BX4    X3*X2
          IX6    X5-X4
          ZR     X6,ECE5     IF ENTRIES MATCH
          SB4    A2+TLDLE
          LT     B4,B5,ECE4  IF MORE IN BUFFER
          NZ     X1,ECE6     IF SEARCH COMPLETE
          SB7    10*TLDLE    BUFFER LENGTH IS 10 ENTRIES
          READW  TL,A0,B7
          NG     X1,ECE6     IF EOF/EOI
          SB4    A0+
          EQ     ECE3        CONTINUE READING DIRECTORY ENTRIES
 
*         REPLACE OLD TLD ENTRY AND CLEAR EXTENDED MEMORY BIT.
 
 ECE5     BX7    X2
          SA7    A5
          SA5    A2+B1
          BX7    X5
          SA7    A7+B1
          SA2    A5+B1
          SX3    B1
          LX3    56
          BX7    -X3*X2
          SX4    12B         REPLACE USAGE AND CORE RESIDENT/OFF BITS
          LX4    -6
          MX6    36
          LX6    -6
          BX6    X4+X6
          SA4    A7+B1
          BX6    X6*X4
          BX7    X7+X6
          SA7    A7+B1
 
*         ISSUE DAYFILE MESSAGE.
 
          SA2    A5-B1
          MX3    42
          BX1    X3*X2
          SB2    1R+         REPLACEMENT CHARACTER
          SB5    -ECED       FWA OF FORMATTED TEXT
          SB3    DAYB        ALTERNATIVE BUFFER
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB,3,R  * ECS TASK +++++++ NOW MS RESIDENT.*
 
*         RE-ATTACH LIBRARY IN READ/MODIFY MODE.
 
          LX0    -36
          MX1    42
          SA3    X0+2        USER NAME
          BX3    X1*X3
          ATTACH TL,,X3,,RM  RE-ATTACH FILE
 
*         PUT DISK ADDRESS IN LOAD STACK ENTRY.
 
          SA3    ECEA        RE-LOAD (X5) AND RESTORE DISK ADDRESS
          MX1    30
          BX2    X1*X3
          LX5    30
          BX4    -X1*X5
          BX5    X2+X4
          LX0    36
          SA2    ECEB        RESTORE (B2), (B4), (B7) AND (X7)
          SB4    X2
          LX2    -18
          SB7    X2
          LX2    -18
          SB2    X2
          BX7    X0
          MX3    1
          PL     X7,SCHD11   IF NOT ENTERED FROM ERROR PROCESSING
          BX7    -X3*X7      CLEAR ERROR BIT FOR DISK LOAD
          SB4    TERP18      SET RETURN ADDRESS
          EQ     SCHD11      LOAD TASK FROM DISK
 
*         CANNOT LOAD TASK FROM DISK OR EXTENDED MEMORY.
 
 ECE6     SA1    X0+B1       SET PROGRAM STOP AT TASK ENTRY POINT
          LX1    -18         ENTRY POINT ADDRESS
          SA2    X0          TASK RA
          BX6    X6-X6
          SB3    X2
          SA6    X1+B3
          SA2    A1+B1       TURN TASK OFF
          MX3    12
          BX4    X3*X2
          LX4    12
          TA5    X4-1+2,VTLD WORD 3 OF DIRECTORY
          MX3    1
          LX3    55-59       OFF BIT
          BX7    X3+X5
          SA7    A5
 
*         ISSUE DAYFILE MESSAGE.
 
          SA2    A5-2        READ TASK NAME
          SB3    DAYB        ALTERNATIVE BUFFER
          MX4    42
          BX1    X4*X2
          SB2    1RX         REPLACMENT CHARACTER
          SB5    -ECEC       FWA OF MESSAGE TEXT
          RJ     SNM         SET NAME IN MESSAGE
          SA5    ECEA
          LX5    30
          SA2    X5          READ DATA BASE LIBRARY NAME
          BX1    X4*X2
          LX5    30
          SB2    1R+         REPLACEMENT CHARACTER
          SB5    DAYB        FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE DAYB,3     * OFF TASK XXXXXXX - LIBRARY +++++++.*
          SB3    SCHD34      RE-START ADDRESS
          EQ     ECE8        INITIATE TASK
 
*         CANNOT ATTACH TASK LIBRARY - PUT TASK IN RECALL.
 
 ECE7     LX0    36          SET RECALL BIT IN TASK SCP TABLE
          SA1    X0+B1
          MX2    1
          LX2    56-59
          BX7    X2+X1
          SA7    A1+
          SA1    X0          SAVE (X0) AND (X5) IN TASK SYSTEM AREA
          SA5    ECEA
          BX7    X0
          BX6    X5
          SA6    X1-NUAPL+16B
          SA7    A6+1
          SX7    DCPPR-2     SET LOWER CPU PRIORITY
          LX7    48
          SA7    X1-NUAPL+CB1C
          SX6    ECR1        RETURN ADDRESS
          SB3    SCHD34      SCHEDULER RETURN ADDRESS
          SA6    X1-NUAPL+RCL
          PL     X0,ECE8     IF CALL FROM SCHEDULER
          SB3    ECE10       RETURN ADDRESS
 ECE8     LX0    -36         RE-ATTACH LIBRARY IN READ/MODIFY MODE
          SA3    X0+2
          MX1    42
          BX3    X1*X3
          ATTACH TL,,X3,,RM
          SA2    ECEB        RESTORE (B2), (B4), (B7) AND (X7)
          SB4    X2
          LX2    -18
          SB7    X2
          LX2    -18
          SB2    X2
          LX0    36
          BX7    X0
          JP     B3          EXIT
 
 ECE9     SA5    B2+16B      RESTORE (X5) AND (X7)
          SA2    A5+B1
          BX7    X2
          SB4    ECE10       RETURN ADDRESS
          EQ     ECE1        RE-TRY ATTACH
 
ECE10     RJ     DCPT        DROP CPU FOR TASK
          EQ     TSSC        TIME SLICE SUBCP
 
 ECEA     BSS    1           STORAGE FOR (X5)
 ECEB     BSS    1           STORAGE FOR (B2), (B4) AND (B7)
 ECEC     DATA   C* OFF TASK XXXXXXX - LIBRARY +++++++.*
 ECED     DATA   C* EXTENDED MEMORY TASK +++++++ NOW MS RESIDENT.*
 ECEE     DATA   C* EXTENDED MEMORY READ ERROR.*
 
          ENDOVL
 
 ECE9     EQU    /"PROD""M."/ECE9
          TRANOVL (TAPE ASSIGNMENT.)
          SPACE  4
***                       K - D I S P L A Y  C O M M A N D S
 PASN     SPACE  4
***       K.ASSIGN,EQ. OR K.ASSIGN,EQ,XX,N.
*
*         ASSIGN TAPE EQUIPMENT -EQ- TO A *FREE* POOL OF UNITS FOR USE
*         BY ANY JOURNAL FILE, OR ASSIGN TAPE EQUIPMENT -EQ- TO JOURNAL
*         FILE -N- OF DATA BASE -XX- IF THE FILE HAS BEEN FORCED TO
*         DISK BECAUSE IT NEEDED A TAPE UNIT WHEN NONE WAS AVAILABLE.
*         A JOURNAL FILE MUST BE PREDEFINED AS A TAPE FILE TO ASSIGN
*         IT A TAPE.
*         ONLY TWO TAPES MAY BE ASSIGNED TO THE *FREE* POOL.
*
*         EQ = EST ORDINAL OF TAPE UNIT.
*         XX = DATA BASE NAME.
*         N  = JOURNAL FILE NUMBER (1-3)
 
 
 ASSIGN   BSS    0
          ENTRY  ASSIGN,K
 
          SA5    SBUF+1      EQ PARAMETER
          SB7    B0          ASSUME OCTAL BASE
          SB6    B2-B1
          RJ     DXB         CONVERT EQ TO BINARY NUMBER
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          SA6    PASA        SAVE EST ORDINAL
          EQ     B6,B1,PAS3  IF POOL ASSIGNMENT
          SB3    3
          NE     B6,B3,PCMD3 IF INCORRECT PARAMETER COUNT
 
*         TAPE ASSIGNED TO SPECIFIC JOURNAL FILE
 
          SA5    A5+2        JOURNAL FILE NUMBER
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          TA2    0,VEDT      EDT HEADER
          ZR     X6,PCMD3    IF INCORRECT JOURNAL FILE NUMBER
          SA5    A5-B1       DATA BASE NAME
          SB3    X2
          MX7    12
          EQ     PAS2        ENTER LOOP
 
 PAS1     SB3    X2          LINK TO NEXT EDT
          ZR     B3,PCMD3    IF UNKNOWN DATA BASE NAME
          SA2    B3
 PAS2     BX3    X7*X2       DATA BASE NAME OF CURRENT EDT
          BX3    X3-X5
          NZ     X3,PAS1     IF NO MATCH ON DATA BASE NAME
          SA2    A2+B1
          AX2    18
          SX0    X2          ADDRESS OF FIRST DATA BASE JOURNAL FILE
          AX2    36
          ZR     X2,PCMD3    IF NO JOURNAL FILES FOR THIS DATA BASE
          SX3    X2+B1
          IX3    X6-X3
          PL     X3,PCMD3    IF INCORRECT JOURNAL FILE NUMBER
          SX3    JFETL
          SX6    X6-1
          IX3    X3*X6       JOURNAL FILE FET BIAS
          IX0    X0+X3       FET ADDRESS
          SA0    X0+
          SA2    X0+7
          PL     X2,PCMD3    IF NOT A TAPE JOURNAL FILE
          SX0    O           USE OUTPUT FILE FOR SCRATCH
          RETURN O,R         RETURN WHATEVER IS THERE
          SB4    PAS6
          SB3    PAS9
          JP     PAS4        ASSIGN TAPE TO JOURNAL FILE
 
*         TAPE ASSIGNED TO *POOL*
 
 PAS3     SB3    PAS8
          SA4    ASEQ        ASSIGNED EQUIPMENT STATUS WORD
          SX0    SCR
          SB4    PAS6
          ZR     X4,PAS4     NO CURRENTLY ASSIGNED EQUIPMENT
          SX6    X4
          AX4    18
          ZR     X6,PAS4     ASSIGN TAPE TO SCR
          SX0    SCR1
          LX6    18
          NZ     X4,PCMD3    IF ALREADY 2 TAPES ASSIGNED TO *POOL*
          SA6    A4
 
*         CHECK STATUS OF TAPE
 
 PAS4     RDSB   MTSI,1,/COMSMTX/UBUF,2,3  READ UDT POINTER
          SA5    2
          SB2    X5          FWA OF UDT
          LX5    -24
          SB6    X5+         LWA + 1 OF UDT
          SA4    PASA        EST ORDINAL
 PAS5     EQ     B2,B6,PCMD3 IF EQUIPMENT NOT PRESENT
          RDSB   MTSI,/COMSMTX/UNITL,B2,OBUF,2  READ ONE UDT
          SB2    B2+/COMSMTX/UNITL
          SA1    2
          PL     X1,PCMD3    IF ERROR ON READ
          SA1    OBUF+/COMSMTX/UST1
          MX6    -12
          LX1    0-24
          BX6    -X6*X1      EST ORDINAL FROM UDT
          BX6    X6-X4
          NZ     X6,PAS5     IF NO MATCH ON EST ORDINAL
          SA2    OBUF+/COMSMTX/UVSN
          MX6    36
          BX6    X6*X2
          LX2    59-23
          ZR     X6,PCMD3    IF NO TAPE MOUNTED
          NG     X2,PCMD3    IF LABEL CHECK IN PROGRESS
          LX1    59-2-0+24-60
          LX2    59-14-59+23
          PL     X2,PCMD3    IF NOT DEFAULT VSN
          PL     X1,PCMD3    IF NO WRITE ENABLE
          JP     B4          EXIT
 
*         ASSIGN TAPE TO FILE
 
 PAS6     SA1    PASE        CREATE A FILE NAME FOR TAPE ASSIGNMENT
          MX6    -5
          BX2    X6*X1       1+*SCR*
          SX1    X1+B1       ADVANCE POSTFIX CHARACTER
          BX1    -X6*X1      USE ONLY 5 BITS (0-37)
          BX7    X2+X1
          LX1    35          APPEND CHARACTER TO FILE NAME
          SA7    A1
          BX6    X2+X1
          LX6    1           SCR*X* + 1
          SA6    X0
          SA1    OBUF+/COMSMTX/UVRI
          SA3    PASB
          NZ     X1,PCMD3    IF TAPE ASSIGNED TO ANOTHER JOB
          MX6    -3
          BX2    -X6*X4      CONVERT EST ORDINAL TO DISPLAY CODE
          SA1    OBUF+/COMSMTX/UVSN  CHECK VSN OF TAPE
          AX4    3
          BX7    -X6*X4
          LX7    6
          BX6    X6*X4
          LX6    9
          IX7    X6+X7
          BX6    X7+X2
          MX2    36
          IX6    X6+X3       CREATE VSN OF ***NNN
          BX1    X2*X1
          LX6    24
          BX1    X1-X6
          NZ     X1,PCMD3    IF INCORRECT VSN
          SA5    OBUF+/COMSMTX/UST4
          SA6    X0+9
          MX7    -2
          LX7    55-0
          BX7    -X7*X5      SET TAPE DEVICE TYPE
          SA7    A6-B1
          MESSAGE VERM,1     CLEAR LABEL MESSAGE
          SB4    PAS7
          JP     PAS4        RECHECK STATUS OF TAPE
 
 PAS7     JP     B3
 
*         SET ASSIGNED EQUIPMENT WORD TO REFLECT TAPE ASSIGNMENT
 
 PAS8     SA2    OBUF+/COMSMTX/UVRI
          ZR     X2,PCMD3    IF TAPE NOT ASSIGNED
          SA1    ASEQ        ASSIGNED EQUIPMENT WORD
          BX7    X1+X0
          SA7    A1
          JP     PCMDX       *RETURN
 
*         COPY DISK JOURNAL FILE TO THE ASSIGNED TAPE
 
 PAS9     SA4    A0+7
          SX0    A0          JOURNAL FILE FET ADDRESS
          SX4    X4
          NZ     X4,PAS10    IF FILE NON BUFFERED
          WRITER A0+,R       FLUSH JOURNAL FILE
          JP     PAS12       WRITE LABEL RECORD
 
 PAS10    SB2    A0
          RECALL X0          WAIT JOURNAL FILE IDLE
          SX0    2100B
          RJ     RCP         REQUEST SUBCONTROL POINT
          NZ     X5,PAS11    IF CORE WAS AVAILABLE
          RETURN O,R         RETURN ASSIGNED EQUIPMENT
          EQ     PCMD4       *SYSTEM BUSY* MESSAGE
 
 PAS11    SX0    B2+
          SA2    B2+B1       FIRST
          MX3    -18
          SX7    X5+         START OF ALLOCATED CORE
          BX6    X3*X2
          SA7    A2+B1       IN
          BX6    X6+X5
          SA7    A7+B1       OUT
          SA6    A2+
          SX5    B4          SUB CONTROL POINT ASSIGNED WITH CORE
          SX7    X7+2101B
          SA7    A7+B1       LIMIT
 
*         WRITE LABEL RECORD TO TAPE
 
 PAS12    SA1    X0+5
          SA2    PDATE       SET CURRENT PDATE INTO LABEL
          SX3    B1
          BX6    X2
          LX3    18          UPDATE REEL COUNT
          IX7    X3+X1
          SA6    PASC+1
          SA4    X0          SET JOURNAL FILE NAME INTO LABEL
          SA7    A1
          MX6    42
          BX6    X6*X4
          AX7    18
          SX7    X7          REEL COUNT
          BX7    X6+X7
          SA7    A6+B1
          WRITEW O,PASC,3    3 WORD LABEL RECORD
          WRITER X2,R
 
*         SWITCH FETS AND SET UP FOR DISK TO TAPE COPY
 
          SA1    X0          SWITCH FETS TO GIVE TAPE FILE THE LARGER
          SA2    O
          BX6    X1
          LX7    X2
          SA6    A2
          SA7    A1
          SA0    -PAS17      ERROR RETURN ADDRESS
          REWIND O,R
 PAS13    READ   O           INITIATE READ ON DISK FILE
 
*         COPY DISK FILE TO TAPE FILE
 
 PAS14    READW  O,SBUF,SBUFL
          NZ     X1,PAS15    IF EOR/EOF/EOI
          WRITEW X0,SBUF,SBUFL
          EQ     PAS14       LOOP
 
 PAS15    SX4    X1+1
          ZR     X4,PAS16    IF EOF
          NG     X4,PAS18    IF EOI
          SX4    X1-SBUF     NUMBER OF WORDS READ
          WRITEW X0,SBUF,X4
          WRITER X2,R        FLUSH BUFFER TO TAPE
          JP     PAS13       COPY ALL RECORDS OVER TO TAPE
 
 PAS16    WRITEF X0,R
          JP     PAS13       COPY ALL FILES OVER TO TAPE
 
*         ERROR ENCOUNTERED ON COPY
 
 PAS17    RETURN X0,R        RETURN TAPE
          SA1    X0+B1
          SX7    X1          SET FIRST = IN = OUT
          SA7    A1+B1
          SA7    A7+B1
          RECALL O
          SA1    O           RESTORE JOURNAL FILE NAME
          SA4    X0
          BX6    X1
          SA6    X0
          SKIPEI X0,R        POSITION JOURNAL FILE TO EOI
          MESSAGE  PASD      * UNABLE TO USE TAPE.*
          JP     PAS19       RELEASE CORE IF NECESSARY
 
*         COPY COMPLETE
 
 PAS18    WRITER X0,R        FLUSH BUFFER TO TAPE
          REWIND O           REWIND DISK FILE
          WRITER O           PURGE DATA FROM FILE
          SX2    100B+1RT
          SA3    O
          MX6    36
          BX6    X6*X3       ADD *T* TO FRONT OF JOURNAL FILE NAME
          LX6    -6
          LX2    -6
          BX1    X6+X2       *TXXJORN*
          RENAME O,X1        RENAME PERMANENT FILE
          BX1    X3
          SA4    X0
          RENAME X0,X1       SET PROPER NAME FOR TAPE FILE
 PAS19    SA1    X0+7
          BX6    X4
          SX2    X1
          SA6    O           RESTORE OUTPUT FILE NAME
          ZR     X2,PCMDX    IF NO BUFFER TO RETURN
          SB6    X5          SUB CONTROL POINT ASSIGNED WITH CORE
          SB7    B0
          SA1    AVAILCM
          SX7    X1+2100B    CORE USED TO COPY TAPE
          SA7    A1+
          SB3    PCMDX       RETURN ADDRESS
          JP     ESCP1       RELEASE CORE
 
 PASA     CON    0           EST ORDINAL
 PASB     VFD    24/0,36/6L***000
 
 PASC     DATA   C/*TRANEX*/ 3 WORD JOURNAL FILE LABEL RECORD
          BSS    1           PDATE
          BSS    1           FILE NAME AND REEL NUMBER
 
 PASD     DATA   C* UNABLE TO USE TAPE.*
 
 PASE     VFD    1/1,18/3LSCR,41/0  1 + *SCR*
 
          ENDOVL
          TRANOVL (K-DISPLAY COMMANDS *1*.)
 DEBUG    SPACE  4,10
***       K.DEBUG.
*
*         TURN ON *AIP* DEBUG OPTION.
 
 
 DEBUG    BSS    0
          ENTRY  DEBUG,K
 
 .B       IFEQ   DBUG,0
          SX6    B0+
          RJ     NDS         TURN ON *AIP* DEBUG OPTION
          EQ     PCMDX       RETURN
 .B       ELSE
          EQ     PCMD6       *NOT AVAILABLE.*
 .B       ENDIF
 DROP     SPACE  4,10
***       K.DROP,N.
*
*         SET THE ABORT FLAG FOR SUB CONTROL POINT *N*. CAUTION IS
*         ADVISED WHEN USING THIS COMMAND, BECAUSE OF THE DELAY BETWEEN
*         THE TIME THE COMMAND IS ENTERED AND THE TIME IT IS PROCESSED.
 
 
 DROP     BSS    0
          ENTRY  DROP,K
 
          SB2    B2-B1
          NE     B2,B1,PCMD3 IF TOO MANY PARAMETERS
          SB7    B0          ASSUME OCTAL BASE
          SA5    SBUF+1      SUB CONTROL POINT NUMBER
          RJ     DXB         CONVERT TO BINARY FORM
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          TX1    1,VNSCP     NUMBER OF SUB CONTROL POINTS
          ZR     X6,PCMD3    IF SUB CONTROL POINT ZERO
          IX1    X6-X1
          LX6    SCPAL
          PL     X1,PCMD3    IF INCORRECT SUB CONTROL POINT NUMBER
          TA3    X6-CPAL,VCPA  1ST WORD OF SUB CONTROL POINT TABLE
          TX6    X3-1,-VCBRT SET RELATIVE ADDRESS DIFFERENCE
          NG     X6,PCMD3    IF SUB CONTROL POINT NOT ACTIVE
          SA1    A3+B1
          SX7    B1
          LX7    55
          BX7    X7+X1       SET ABORT FLAG
          LX1    59-SCRCS
          NG     X1,DRO2     IF SUBCP IN RECALL
          SA2    X3+B1       CHECK SYSTEM REQUEST OF TASK
          LX2    18
          SX2    X2-3RSIC
          ZR     X2,PCMD2    IF *SEND* REQUEST OUTSTANDING
          SA2    A3+CPAHL    COM. BLK. IN EXECUTION
          LX2    59-54
          NG     X2,PCMD2    IF INITIAL LOAD BIT SET
          BX6    X6-X6
          SA7    A1+
          SA6    X3-NUAPL+DMEC  CLEAR DATA MANAGER ERROR CODE
 DRO2     MX7    SCDRN       SET TASK DROPPED FLAG
          LX1    59-59-59+SCRCS
          LX7    59-59-59+SCDRS
          BX7    X1+X7
          SA7    A1
          EQ     PCMDX       EXIT
 PDSD     SPACE  4,10
***       K.DSDUMP,FW=ADDRESS,LW=ADDRESS,EP=N,DB=N,OQ=AA,QD=VALUE.
*
*              CHANGE THE SYSTEM DEFAULT DUMP PARAMETERS FOR TASKS
*         RUNNING UNDER CONTROL OF TRANEX. THE PARAMETERS MAY BE GIVEN
*         IN ANY ORDER AND ONLY THOSE PARAMETERS TO BE CHANGED NEED BE
*         GIVEN.
*              *FW* IS THE DEFAULT FIRST WORD ADDRESS FOR TASK DUMPS,
*         AND *LW* IS THE LAST WORD ADDRESS. *FW* IS ROUNDED DOWN TO
*         THE NEAREST MULTIPLE OF 4 AND MUST BE LESS THAN *LW*.
*              *EP* IS THE EXCHANGE PACKAGE DUMP FLAG. IF IT IS NONZERO
*         THE EXCHANGE PCKAGE WILL BE DUMPED ON DEFAULT DUMPS.
*              *DB* IS THE DATA MANAGER BUFFER DUMP FLAG. IF IT IS
*         NONZERO ALL DATA MANAGER BUFFERS ASSOCIATED WITH THE TASK
*         WILL BE DUMPED.
*              *OQ* SIGNIFIES THE OUTPUT QUEUE FOR A DEFAULT DUMP, AND
*         *QD* DEFINES A DESTINATION FOR THE DUMP. THE FOLLOWING TABLE
*         SHOWS THEIR RELATIONSHIP.
*
*            ORIGIN TYPE             QUEUE DESTINATION FIELD
*         BC   =    LOCAL BATCH           PRINTER ID
*         EI   =    E/I 200               USER NAME
*         PF   =    USER PERMANENT FILE   PERMANENT FILE NAME
*         RB   =    REMOTE BATCH          USER NAME
 
 
 DSDUMP   BSS    0
          ENTRY  DSDUMP,K
 
          SB4    B2-B1       ARGUMENT COUNT
          SA4    SBUF+1      FIRST ARGUMENT FOR COMCARG
          SB7    B0
          SB5    PDSA        ARGUMENT TABLE
          RJ     ARG         PROCESS COMMAND ARGUMENTS
          NZ     X1,PDS9     IF ERROR IN ARGUMENTS
          SX6    B0+         CLEAR LWA/FWA PROCESSED FLAG
          SA6    PDSC
 
*         PROCESS FIRST WORD ADDRESS
 
          SA5    PFW
          ZR     X5,PDS1     NO FIRST WORD ADDRESS SPECIFIED
          RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PDS9     IF ERROR IN VALUE
          SA1    DTSE
          MX2    -18
          BX6    -X2*X6
          BX2    X2*X1       CLEAR OLD SYSTEM DEFAULT FWA
          AX6    2
          LX6    2           ROUND DOWN TO NEAREST EVEN MULTIPLE OF 4
          SX1    X6
          NG     X1,PDS9     IF FWA TOO LARGE
          BX7    X2+X6
          SA7    PDSD
          SX6    B1          SET FWA FLAG
          SA6    PDSC
          RJ     COD         CONVERT TO OCTAL FOR K-DISPLAY
          BX6    X4
          SA6    PFW
 
*         PROCESS LAST WORD ADDRESS
 
 PDS1     SA5    PLW
          ZR     X5,PDS1.2   IF NO LWA SPECIFIED
          RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PDS9     IF ERROR IN VALUE
          SA1    DTSE
          SA2    PDSC
          ZR     X2,PDS1.1   IF FWA NOT PROCESSED
          SA1    PDSD
 PDS1.1   MX2    -18
          LX2    30
          BX2    X2*X1       CLEAR OLD SYSTEM DEFAULT LWA
          SX6    X6          TRUNCATE IF NECESSARY
          NG     X6,PDS9     IF VALUE TOO LARGE
          BX1    X6
          LX6    30
          BX7    X2+X6
          SA7    PDSD
          SX6    B1+B1       SET LWA FLAG
          SA2    PDSC
          BX6    X6+X2
          SA6    A2
          RJ     COD         CONVERT TO OCTAL FOR K-DISPLAY
          BX6    X4
          SA6    PLW
 PDS1.2   SA4    PDSC
          ZR     X4,PDS2     IF NEITHER FWA/LWA CHANGED
          SA1    PDSD        POTENTIAL NEW *DTSE*
          SX2    X1          FWA
          LX1    -30
          SX6    DSMNFL
          SX3    X1+         LWA
          IX7    X3-X2
          NG     X7,PDS9     IF FWA .GT. LWA
          LX1    30
          ZR     X7,PDS1.3   IF NO DUMP SELECTED
          IX7    X7-X6
          NG     X7,PDS9     IF LWA-FWA .LT. DSMNFL
 PDS1.3   SA2    PFW         UPDATE K-DISPLAY VALUES
          SA3    PLW
          BX6    X1
          SA6    DTSE
          BX6    X2
          LX7    X3
          LX4    59-0
          PL     X4,PDS1.4   IF FWA NOT CHANGED
          SA6    KDFWA+1
 PDS1.4   LX4    59-1-59+0
          PL     X4,PDS2     IF LWA NOT CHANGED
          SA7    KDLWA+1
 
*         PROCESS EXCHANGE PACKAGE
 
 PDS2     SX3    1R0         DISPLAY CODE 1
          SA1    PEP
          SX2    B1
          NZ     X1,PDS3     TURN ON EXCHANGE PACKAGE DUMP
          BX2    X2-X2
 PDS3     SX7    3
          SA1    DTSE
          LX7    57
          IX6    X3+X2       *0* OR *1* DEPENDING WHETHER PEP IS NONZERO
          LX2    58
          BX1    -X7*X1      CLEAR EXCHANGE PACKAGE / DATA BASE FLAGS
          LX6    54
          BX7    X2+X1       EXCHANGE PACKAGE DUMP FLAG
          SA6    KDEXP+1
          SA7    A1+
 
*         PROCESS DATA BASE
 
          SA1    PDB
          SX2    B1
          NZ     X1,PDS4     TURN ON EXCHANGE PACKAGE DUMP
          BX2    X2-X2
 PDS4     SA1    DTSE
          LX2    57
          BX7    X2+X1       DATA MANAGER BUFFERS DUMP FLAG
          SA7    A1
 
*         PROCESS OUTPUT QUEUE
 
          BX5    X5-X5
          SA1    POT
          MX2    12
          ZR     X1,PDS6     OUTPUT QUEUE NOT SPECIFIED
          BX1    X2*X1       OUTPUT QUEUE
          SA4    DTSE+1
          LX1    12
          MX6    -12
          SX2    X1-2RBC
          SX3    BCOT
          ZR     X2,PDS5     *BC* FOR LOCAL BATCH
          SX2    X1-2RPF
          SX5    B1+B1
          ZR     X2,PDS5     *PF* FOR PERMANENT FILE
          SX5    B1
          SX3    RBOT
          SX2    X1-2RRB
          ZR     X2,PDS5     *RB* FOR REMOTE BATCH
          SX3    EIOT
          SX2    X1-2REI
          ZR     X2,PDS5     *EI* FOR E/I 200
          EQ     PDS9        INCORRECT ORIGIN TYPE
 
 PDS5     MX2    3
          BX6    X6*X4
          LX2    12+3
          BX6    -X2*X6      CLEAR ORIGIN CODE
          LX3    12
          LX7    X1
          BX6    X6+X5       SET NEW ORIGIN TYPE
          LX7    48
          BX6    X6+X3
          SA6    A4
          SA7    KDORT+1
 
*         PROCESS QUEUE DESTINATION
 
 PDS6     SB3    PCMDX       RETURN ADDRESS
          SA5    PQD
          ZR     X5,PDS8     IF QUEUE DESTINATION NOT SPECIFIED
          SA1    DTSE+1
          MX2    -12
          BX2    -X2*X1      ORIGIN TYPE
          ZR     X2,PDS7     IF BATCH DESTINATION TYPE
          MX7    42
          BX7    -X7*X1      CLEAR OLD USER NAME / PERMANENT FILE NAME
          LX6    X5
          BX7    X7+X5       SET NEW USER NAME / PERMANENT FILE NAME
          SA6    KDQDS+1
          SA7    A1+
          EQ     PDS8        COMPLETE PROCESSING
 
 PDS7     RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PDS9     IF ERROR IN PRINTER ID
          SA1    DTSE+1
          MX7    42
          SA5    PQD
          BX1    -X7*X1      CLEAR OLD PRINTER ID
          LX6    18
          BX7    X5
          BX6    X1+X6       SET NEW PRINTER ID
          SA6    A1
          SB3    PCMDX       RETURN ADDRESS
          SA7    KDQDS+1
 
*         CLEAR ARGUMENTS FOR NEXT COMMAND
 
 PDS8     BX6    X6-X6
          SA6    PFW         START OF LIST
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          JP     B3          *RETURN
 
 PDS9     SB3    PCMD3       *FORMAT ERROR* EXIT ADDRESS
          EQ     PDS8        CLEAR PARAMETER LIST
 
 PDSA     BSS    0
 FW       ARG    PDSB,PFW,400B
 LW       ARG    PDSB,PLW,400B
 EP       ARG    PDSB,PEP
 OQ       ARG    PDSB,POT
 QD       ARG    PDSB,PQD,400B
 DB       ARG    PDSB,PDB
 PDSB     CON    0
 
 PFW      BSSZ   1           FIRST WORD ADDRESS
 PLW      BSSZ   1           LAST WORD ADDRESS
 POT      BSSZ   1           ORIGIN TYPE
 PQD      BSSZ   1           QUEUE DESTINATION
 PEP      CON    DEXP        EXCHANGE PACKAGE
 PDB      CON    DDMB        DATA MANAGER BUFFERS
 PDSC     BSS    1           LWA/FWA FLAG
 PDSD     BSS    1           POTENTIAL NEW *DTSE*
 PDMP     SPACE  4,10
***       K.IDLE.
*
*         FORCES TRANEX TO IDLE DOWN THE TRANSACTION SUBSYSTEM.
*         ALL TRANSACTIONS CURRENTLY RUNNING ARE COMPLETED
*         UNTIL NO MORE ACTIVITY EXISTS, NO NEW TRANSACTIONS ARE
*         ACCEPTED. THIS IS ACCOMPLISHED BY INFORMING INITIAL TASK OF
*         IDLE DOWN. INITIAL TASK WILL THEN TURN AROUND ALL INCOMING
*         TRANSACTIONS INSTEAD OF PASSING THEM ON FOR PROCESSING.
 
 
 IDLE     BSS    0
          ENTRY  IDLE,K
          SX7    B0+         SET INITIAL TRY
          SA7    IDLA
 
          NE     B2,B1,PCMD3 IF INCORRECT PARAMETER COUNT
          RJ     IDL         SET IDLE FLAGS
          ZR     X0,IDL2     IF NO COMMUNICATION BLOCK AVAILABLE
          SA3    SREG
          TX1    0,VFSCP
          SB3    X3
          LX1    18
          TX2    0,VCPA      SET NEW B2/B7 TO REPLECT INITIAL TASK
          SB7    X2
          BX7    X1+X2
          EQ     B3,B7,PCMDX CPU ASSIGNMENT NOT CHANGED BY IDL
          SA7    SREG        SET NEW CPU ASSIGNMENT
          EQ     PCMDX       *RETURN
 
 IDL1     SX6    B1          SET RETRY FLAG
          SB2    B1
          SA6    IDLA
          EQ     IDLE        GO THRU IDLE DOWN AGAIN
 
 IDL2     SA1    IDLA
          ZR     X1,PCMDX    IF NOT A RETRY
          RJ     RSP         RESTORE SUBCONTROL POINT REGISTERS
          BX6    X6-X6       CLEAR TASK K-DISPLAY INTERLOCK
          EQ     KDISX
 
 IDLA     BSS    1           RETRY FLAG
 PJND     SPACE  4
***       K.JEND,XX,N.
*
*         FORCE END OF REEL PROCESSING ON JOURNAL FILE -N- OF
*         DATA BASE -XX-. JOURNALLING WILL CONTINUE FOR THIS FILE
*         ON DISK UNTIL A NEW TAPE IS ASSIGNED.
*         IF -N- IS NOT A TAPE FILE, THE COMMAND WILL BE IGNORED.
 
 
 JEND     BSS    0
          ENTRY  JEND,K
 
          SB3    3
          NE     B2,B3,PCMD3 IF INCORRECT PARAMETER COUNT
          SA5    SBUF+2
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          TA2    0,VEDT      EDT HEADER
          ZR     X6,PCMD3    IF INCORRECT JOURNAL FILE NUMBER
          SA5    A5-B1       DATA BASE NAME
          SB3    X2
          MX7    12
          EQ     PJN2        ENTER LOOP
 PJN1     SB3    X2          LINK TO NEXT EDT
          ZR     B3,PCMD3    IF UNKNOWN DATA BASE NAME
          SA2    B3
 PJN2     BX3    X7*X2       DATA BASE NAME OF CURRENT EDT
          BX3    X3-X5
          NZ     X3,PJN1     IF NO MATCH ON DATA BASE NAME
          SA2    A2+B1
          AX2    18
          SX0    X2          ADDRESS OF FIRST DATA BASE JOURNAL FILE
          AX2    36
          ZR     X2,PCMD3    IF NO JOURNAL FILES FOR THIS DATA BASE
          SX3    X2+B1
          IX3    X6-X3
          PL     X3,PCMD3    IF INCORRECT JOURNAL FILE NUMBER
          SX3    JFETL
          SX6    X6-1
          IX3    X3*X6       JOURNAL FILE FET BIAS
          IX0    X0+X3       JOURNAL FILE FET ADDRESS
          RECALL X0          RECALL ON JOURNAL FILE
          SA1    X2+B1
          SX6    OBUF        SET FET POINTERS
          MX4    42
          SA6    A1+B1       IN
          BX7    X4*X1
          BX7    X7+X6
          SA6    A6+B1       OUT
          SA7    A1          FIRST
          SX6    OBUF+OBUFL
          SA1    X2
          SA6    X2+4        LIMIT
          SX3    B1
          LX3    10
          BX6    X3+X1       SET END OF REEL FLAG
          SA6    A1
          SA0    PCMDX       RETURN ADDRESS
          WRITER X2,R        FORCE END OF REEL PROCESSING
          JP     PCMDX       *RETURN
 MAXFL    SPACE  4,10
***       K.MAXFL,NNNNNN.
*
*         CHANGE THE MAXIMUM AMOUNT OF FIELD LENGTH THAT *TAF* USES.
*         IF THE AMOUNT IS LESS THAN THE CURRENT FIELD LENGTH, *TAF*
*         WILL NOT MAKE AN EFFORT TO REDUCE. NORMAL FIELD LENGTH
*         REDUCTIONS WILL CONTINUE, WITH THE FIELD LENGTH EVENTUALLY
*         FALLING BELOW THE NEW MAXIMUM.
 
 
 MAXFL    BSS    0
          ENTRY  MAXFL,K
 
          SB2    B2-B1
          NE     B2,B1,PCMD3 IF INCORRECT PARAMETER COUNT
          SB7    B0
          SA5    SBUF+1      MAXIMUM FIELD LENGTH VALUE
          RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          SX5    MAXMFL      MAXIMUM RFL OF TAF
          IX5    X5-X6
          NG     X5,PCMD1    IF OUT OF RANGE
          BX1    X6
          SA6    DPBJ        SAVE REQUESTED MFL
          RJ     COD         CONSTANT TO OCTAL DISPLAY
          SB2    1R+         REPLACEMENT CHARACTER
          SB3    DAYB        ALTERNATE ASSEMBLY AREA
          SB5    -MAXA       FWA OF MESSAGE
          BX1    X6
          LX1    24
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB      *  K.MAXFL,NNNNNNB.*
          SA1    MFL         CURRENT MFL
          SA2    DPBJ        REQUESTED MFL
          IX2    X2-X1
          PL     X2,MAX1     IF MFL NOT DECREASING
 
*         CHECK FOR POTENTIALLY BLOCKED TASKS.
 
          RJ     DBC         DETECT BLOCKS IN CM RESIDENT TASKS
          RJ     DBN         DETECT BLOCKS IN NON CM RESIDENT TASKS
          ZR     B7,MAX1     IF NO BLOCKED TASKS DETECTED
          MESSAGE  MAXB      * K.MAXFL REJECTED.*
          EQ     PCMDX       RETURN
 
*         SET REQUESTED MFL.
 
 MAX1     SA1    DPBJ        GET REQUESTED MFL
          BX6    X1
          SA6    MFL
          EQ     PCMDX       RETURN
 
 MAXA     DATA   C*  K.MAXFL,++++++B.*
 MAXB     DATA   C* K.MAXFL REJECTED.*
 
 NODEBUG  SPACE  4,10
***       K.NODEBUG.
*
*         TURN OFF *AIP* DEBUG OPTION.
 
 
 NODEBUG  BSS    0
          ENTRY  NODEBUG,K
 
 
 .B       IFEQ   DBUG,0
          SX6    B1+
          RJ     NDS         TURN OFF *AIP* DEBUG OPTION
          EQ     PCMDX       RETURN
 .B       ELSE
          EQ     PCMD6       *NOT AVAILABLE.*
 .B       ENDIF
 OFFTASK  SPACE  4,10
***       K.OFFTASK,AAAAAAA,DB.
*
*         DISABLE THE TASK NAMED -AAAAAAA- OF DATA BASE -DB-.
 
 
 OFFTASK  BSS    0
          ENTRY  OFFTASK,K
 
          SA2    SBUF+1      TASK NAME
          SA3    LTTA        *OFFTASK* TASK NAME
          SB2    B2-B1
          SB3    B1+B1
          BX6    X6-X6
          IX3    X3-X2
          GT     B2,B3,PCMD3 IF INCORRECT PARAMETER COUNT
          ZR     X3,PCMD3    IF TURN OFF THE *OFFTASK* TASK
          EQ     B2,B3,OFT1  IF D.B. SPECIFIED
          BX6    X6-X6
          SA6    A2+B1       CLEAR D.B. AREA
 OFT1     SA0    0
          SA3    A2+B1       DATA BASE NAME (IF=0 IMPLIES *TASKLIB*)
          LX3    12
          SB4    B0          DETECT *OFF* STATUS
          SB5    B0          TASK SEARCH
          RJ     LTT         LOCATE TASK
          ZR     X6,PCMD3    IF INCORRECT TASK NAME
          SX4    A0
          MX6    1
          NZ     X4,PCMD3    IF TASK ALREADY TURNED OFF
          SA3    A1+TLTOW
          LX6    -4
          BX6    X6+X3       SET OFF BIT
          SA6    A3+
          EQ     PCMDX       *RETURN
 ONTASK   SPACE  4,10
***       K.ONTASK,AAAAAAA,DB.
*
*         ENABLE THE TASK NAMED -AAAAAAA- OF DATA BASE -DB-. (DISABLED
*         BY A PRIOR OFFTASK COMMAND.)
 
 
 ONTASK   BSS    0
          ENTRY  ONTASK,K
 
          SA2    SBUF+1      TASK NAME
          SB2    B2-B1
          BX6    X6-X6
          SB3    B1+B1
          EQ     B2,B3,ONT1  IF D.B. SPECIFIED
          SA6    A2+B1
 ONT1     SA0    0
          SA3    A2+B1       DATA BASE NAME (IF=0 IMPLIES *TASKLIB*)
          LX3    12
          SB4    B0          DETECT *OFF* STATUS
          SB5    B0          TASK SEARCH
          RJ     LTT         LOCATE TASK
          SX4    A0
          SA3    A0          TLD WORD 2 OF TASK
          ZR     X4,PCMD3    IF TASK WAS NOT TURNED OFF
          MX1    1
          LX1    -4
          BX7    -X1*X3      CLEAR OFF BIT
          SA7    A3
          EQ     PCMDX       *RETURN
 SWITCH   SPACE  4,10
***       K.SWITCH.
*
*         TOGGLE TRANEX K-DISPLAY WITH TASK *KDIS* K-DISPLAY. *KDIS*
*         CONTAINS A LIST OF ALL TRANEX K-DISPLAY COMMANDS.
*E
 
 
 
 SWITCH   BSS    0
          ENTRY  SWITCH,K
 
          SA2    KDISB
          SA1    KCTRL1      K-DISPLAY CONTROL WORD
          NG     X2,PCMD4    IF K-DISPLAY TASK SCHEDULED, BUT NOT ACTIVE
          SA4    KTAS        COMMAND DISPLAY TASK
          SX2    X1-KFRM
          NZ     X2,SWI1     CURRENTLY DISPLAYING FROM A TASK
          BX5    X5-X5       CLEAR CODE FOR TRN
          SB3    B0          NO BUFFER INPUT FOR TASK SCHEDULING
          SX7    B0+         SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         GENERATE A SYSTEM ORIGIN TRANSACTION
          SX7    5           *TASK SCHEDULED* + *KDIS HAS SCREEN* BITS
          ZR     X0,PCMD4    IF TASK NOT SCHEDULED
          SA4    KTAS
          LX7    59-2
          LX6    X4
          BX7    X7+X0       MOVE C.B. ADDRESS INTO *KDISB*
          SA6    KDISE
          SA7    KDISB
          EQ     PCMDX       *RETURN
 
*         SET K-DISPLAY BACK TO TRANEX.
 
 SWI1     MX6    42
          SX2    KFRM
          BX6    X6*X1       MASK OFF TASKS DISPLAY LOCATION
          SA3    KDISG
          BX6    X6+X2       DISPLAY FROM TRANEX PROGRAM BUFFER
          SA6    A1
          SA2    X3
          SB6    X3          SUB CONTROL POINT WITH DISPLAY
          SX4    X2-NUAPL    START OF SUB CONTROL POINT
          LX4    18
          BX7    X4+X3
          SA7    SREG
          SX6    B0          CLEAR TASK K-DISPLAY INTERLOCK
          LX4    -18
          SA6    KDISB
          CONSOLE KCTRL1     DEFINE TRANEX K-DISPLAY
          MESSAGE ZWORD,2    ZERO OUT REQUEST K-DISPLAY MESSAGE
          SB3    PCMDX
          EQ     RCPU        REQUEST CPU FOR TASK WITH K-DISPALAY
 ROLLTIM  SPACE  4,10
***       K.ROLLTIM,NNNNNN.
*
*             CHANGE THE AMOUNT OF TIME FOR TRANEX TO RETAIN ITS FIELD
*         LENGTH BETWEEN COMMUNICATION INPUT BLOCKS.
 
 
 ROLLTIM  BSS    0
          ENTRY  ROLLTIM,K
 
          SB2    B2-B1
          NE     B2,B1,PCMD3 IF INCORRECT PARAMETER COUNT
          SB7    B1          SELECT DECIMAL CONVERSION
          SA5    SBUF+1      TIME INTERVAL TO WAIT BETWEEN INPUTS
          RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          SA6    ITRTL       INTERVAL BETWEEN TRANEX INACTIVE ROLLOUTS
          EQ     PCMDX       *RETURN
 TBCON    SPACE  4,20
***       K.TBCON,NN.
*
*         CHANGE THE NUMBER OF BATCH/CRM USERS.
 
 
 TBCON    BSS    0
          ENTRY  TBCON,K
 
          SA5    SBUF+1      NUMBER OF *BCT* ENTRIES
          RJ     DXB         CONVERT TO BINARY VALUE
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
          SA1    VNBCT       MAXIMUM NUMBER ALLOWED
          MX0    -30
          BX1    -X0*X1
          IX2    X1-X6       SUBTRACT NUMBER SPECIFIED
          NG     X2,PCMD1    IF MORE THAN MAXIMUM
          LX6    30          POSITION NUMBER SPECIFIED
          BX6    X6+X1
          SA6    A1          STORE NEW VALUE
          EQ     PCMDX       *RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMKDPB
 
          ENDOVL
 
 IDL1     EQU    /"PROD""M."/IDL1
          TRANOVL (K-DISPLAY COMMANDS *2*.)
 PMSG     SPACE  4
***       K.MESSAGE,TN=TERMINAL NAME.-MESSAGE-
*
*         SEND A MESSAGE TO TERMINAL -TN-.
*         MESSAGES ARE SENT AS UNSOLICITED OUTPUT, AND AS SUCH SHOULD
*         BE USED WITH CARE BECAUSE OF THE PROBABILITY OF PRINTING
*         OUT ON A FORM.
 
 
 MESSAGE  BSS    0
          ENTRY  MESSAGE,K
 
          RJ     TARG        PROCESS ARGUMENTS
          ZR     X3,PCMD3    IF NO TERMINAL SPECIFIED
          LX3    18
          BX5    X3          SAVE TST ORDINAL
          SX7    3777B       SET DISASSEMBLY COUNTER
 
*         ASSEMBLE MESSAGE TO BE SENT.
 
          SA1    PCMDC       COMMAND BUFFER ADDRESS
          SA1    X1+1        SCAN COMMAND TO TERMINATOR
          SB5    PMSGC       ASSEMBLY AREA
          SA2    PMSGD       TERMINATOR CHARACTER MASK
          MX3    60-6        CHARACTER MASK
          LX1    6
          EQ     PMSG2       ENTER SCAN LOOP
 
 PMSG1    SA1    A1+B1       READ NEXT WORD
          SX7    3777B       RESET INPUT CHARACTER COUNT
          LX1    6
 PMSG2    AX7    1           COUNT CHARACTER
          BX4    -X3*X1      PICK CHARACTER
          ZR     X7,PMSG1    IF INPUT WORD EXHAUSTED
          SB6    X4+         CHECK TERMINATOR
          LX1    6           SHIFT DISASSEMBLY
          LX6    X2,B6
          PL     X6,PMSG2    IF NOT TERMINATOR
          SA2    PMSGA       PRESET FIRST PART OF MESSAGE
          SB6    60-36       OUTPUT CHARACTER POSITION
          SB7    6
          BX6    X2
          EQ     PMSG4       ENTER ASSEMBLY LOOP
 
 PMSG3    SA1    A1+B1       READ NEXT WORD
          SX7    3777B       RESET INPUT CHARACTER COUNT
          LX1    6
 PMSG4    AX7    1           COUNT CHARACTER
          BX4    -X3*X1      PICK CHARACTER
          ZR     X7,PMSG3    IF INPUT WORD EXHAUSTED
          ZR     X4,PMSG5    IF END OF LINE
          LX4    X4,B6       POSITION CHARACTER
          SB6    B6-B7       ADVANCE ASSEMBLY POSITION
          LX1    6           SHIFT ASSEMBLY
          BX6    X6+X4       INSERT CHARACTER
          PL     B6,PMSG4    IF ASSEMBLY NOT FULL
          SA6    B5          STORE ASSEMBLY WORD
          SB5    B5+1
          BX6    X6-X6       CLEAR ASSEMBLY WORD
          SB6    60-6        RESET ASSEMBLY POSITION
          EQ     PMSG4       LOOP TO END OF LINE
 
 PMSG5    SA6    B5          TERMINATE MESSAGE
          BX7    X7-X7
          SA7    A6+1
          SX2    A7-PMSGB    MESSAGE LENGTH
          SX1    4001B       BUFFER FUNCTION CODE
          LX1    59-11
          BX6    X1+X2
          BX6    X6+X5       SET TERMINAL ORDINAL
          SA6    PMSGB       BUFFER CONTROL WORD
 
*         SET UP CALL TO TRN TO CALL SYSMSG.
 
          SA4    STAS        SYSTEM MESSAGE TASK
          SX5    CSMSG       SYSTEM MESSAGE CODE
          SB3    PMSGB       FWA OF BUFFER
          SX7    B0          SCHEDULE ONLY FROM SYSTEM LIBRARY
          RJ     TRN         SCHEDULE SYSMSG TASK
          NZ     X0,PCMDX    IF TASK SCHEDULED
          EQ     PCMD4       ISSUE *SYSTEM BUSY* MESSAGE
 
 PMSGA    DATA   5L.SYS      HEADER FOR SYSTEM ORIGIN MESSAGES
 PMSGB    VFD    24/0,18/0,18/0  BUFFER CONTROL WORD
          CON    KDM0        NULL K-DISPLAY MESSAGE CODE
 PMSGC    BSS    8           MESSAGE SPACE
 PMSGD    BSS    0           COMMAND TERMINATOR CHARACTER MASK
          VFD    1/1
          POS    60-1R.
          VFD    1/1
          BSS    0
 PTST     SPACE  4,10
***       K.TST,TN=TERMINAL NAME,DB=AA,RS=N,US=N,UU=NNNN,UL=NNNN,
*                NN=NEW TERMINAL NAME.
*
*         CHANGE TERMINAL STATUS TABLE. THE PARAMETERS MAY BE GIVEN
*         IN ANY ORDER, *TN* PARAMETER MUST BE GIVEN BUT THE OTHERS
*         NEED ONLY BE GIVEN IF DESIRED.
*         *TN* IS THE NAME OF TERMINAL WHOSE TERMINAL STATUS TABLE
*         ENTRY IS TO BE CHANGED.
*         *DB* IS THE NEW DATA BASE NAME FOR TERMINAL TN.
*         *RS* IS THE NEW READ SECURITY FOR TERMINAL TN.
*         *US* IS THE NEW UPDATE SECURITY FOR TERMINAL TN.
*         *UU* IS THE NEW VALUE OF THE UPPER 24 BITS OF THE USER
*         ARGUMENT AREA FOR TERMINAL TN.
*         *UL* IS THE NEW VALUE OF THE LOWER 24 BITS OF THE USER
*         ARGUMENT AREA FOR TERMINAL TN.
*         *NN* IS THE NEW NAME TO BE GIVEN TO TERMINAL TN.
*
*E
 
 
 TST      BSS    0
          ENTRY  TST,K
 
          SB4    B2-B1       ARGUMENT COUNT
          SA4    SBUF+1      FIRST ARGUMENT FOR COMCARG
          SB7    B0
          SB5    PTSTA       ARGUMENT TABLE
          RJ     ARG         PROCESS COMMAND ARGUMENTS
          NZ     X1,PTST12   IF ERROR IN ARGUMENTS
 
*         SEARCH TERMINAL STATUS TABLE FOR TERMINAL NAME.
 
          SA4    PTSTTN      TERMINAL NAME
          BX3    X3-X3
          MX6    -14
          ZR     X4,PTST12   IF NO TERMINAL NAME IN COMMAND
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          ZR     X3,PTST12   IF TERMINAL NOT FOUND
          SX7    NAM
          SA2    A3-B1       WORD 1 OF TERMINAL STATUS TABLE (TST)
          SX6    X3+         TST ORDINAL OF TERMINAL
          LX2    59-TSTOS
          ZR     X7,PTST2    IF NOT TAFNAM MODE
          PL     X2,PTST12   IF TERMINAL ON
 PTST2    SA6    PTSTC
 
*         PROCESS DATA BASE PARAMETER  *DB*
 
          SA1    PTSTDB      DATA BASE NAME
          MX6    -48
          ZR     X1,PTST3    IF NO *DB* PARAMETER IN COMMAND
          BX2    -X6*X1
          NZ     X2,PTST12   IF GREATER THEN 2 CHARACTERS
          SA2    A3-B1       WORD 1 OF TERMINAL STATUS TABLE
          LX6    36
          BX7    -X6*X2
          LX1    36
          BX7    X7+X1       MASK IN NEW DATA BASE NAME
          SA7    A2
 
*         PROCESS READ SECURITY PARAMETER  *RS*
 
 PTST3    SA5    PTSTRS      READ SECURITY VALUE
          ZR     X5,PTST4    IF NO *RS* PARAMETER IN COMMAND
          SB7    B0
          RJ     DXB         CONVERT TO BINARY NUMBER
          NZ     X4,PTST12   IF CONVERSION ERROR
          MX1    -3
          BX2    X1*X6
          NZ     X2,PTST12   IF RS GREATER THAN 7
          LX1    42-3
          SA2    A3-B1       WORD ONE OF TST
          LX6    42-3
          BX2    X1*X2
          BX7    X2+X6       PLACE NEW RS IN TST
          SA7    A2
 
*         PROCESS UPDATE SECURITY PARAMETER  *US*
 
 PTST4    SA5    PTSTUS      UPDATE SECURITY VALUE
          ZR     X5,PTST5    IF NO *US* PARAMETER IN COMMAND
          SB7    B0
          RJ     DXB         CONVERT TO BINARY NUMBER
          NZ     X4,PTST12   IF CONVERSION ERROR
          MX1    -3
          BX2    X1*X6
          NZ     X2,PTST12   IF US GREATER THAN 7
          LX1    39-3
          SA2    A3-B1       WORD ONE OF TST
          LX6    39-3
          BX2    X1*X2
          BX7    X2+X6       PLACE NEW US IN TST
          SA7    A2
 
*         PROCESS USER AREA UPPER PARAMETER  *UU*
 
 PTST5    SA5    PTSTUU      UPPER USER AREA VALUE
          ZR     X5,PTST6    IF NO *UU* PARAMETER IN COMMAND
          SB7    B0
          RJ     DXB         CONVERT TO BINARY NUMBER
          NZ     X4,PTST12   IF CONVERSION ERROR
          MX1    -12
          BX2    X1*X6
          NZ     X2,PTST12   IF UU GREATER THAN  2**12-1
          LX1    24-12
          LX6    24-12
          SA2    A3-B1       WORD 1 OF TST
          BX7    X1*X2
          BX7    X7+X6       PLACE NEW UU IN TST
          SA7    A2
 
*         PROCESS USER AREA LOWER PARAMETER  *UL*
 
 PTST6    SA5    PTSTUL      LOWER USER AREA VALUE
          ZR     X5,PTST7    IF NO *UL* PARAMETER IN COMMAND
          SB7    B0
          RJ     DXB         CONVERT TO BINARY NUMBER
          NZ     X4,PTST12   IF CONVERSION ERROR
          MX1    -12
          BX2    X1*X6
          NZ     X2,PTST12   IF UL GREATER THAN  2**12-1
          MX1    12
          LX1    12
          SA2    A3-B1       WORD 1 OF TST
          BX7    -X1*X2
          BX7    X7+X6       PLACE NEW UL IN TST
          SA7    A2
 
*         PROCESS NEW TERMINAL NAME  *NN*
 
 PTST7    SA4    PTSTNN      NEW TERMINAL NAME
          ZR     X4,PTST9    IF NO *NN* PARAMETER IN COMMAND
          SB5    A3+         SAVE TST ADDRESS
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          NZ     X3,PTST12   IF TERMINAL FOUND
          SA2    B5          SECOND WORD OF TST
          MX1    -12
          BX6    -X1*X2
          BX6    X6+X4       NEW NAME TO TST
          SA6    A2+
 PTST9    SB3    PCMDX
 
*         CLEAR ARGUMENTS FOR NEXT COMMAND
 
 PTST10   BX6    X6-X6
          SA6    PTSTTN
          SB2    PTSTNN
 PTST11   SA6    A6+B1
          SB4    A6
          LT     B4,B2,PTST11  IF NOT END OF TABLE
          JP     B3          RETURN
 
 PTST12   SB3    PCMD3       *FORMAT ERROR* EXIT ADDRESS
          EQ     PTST10      CLEAR PARAMETER LIST
 
 PTSTA    BSS    0
 TN       ARG    PTSTB,PTSTTN
 DB       ARG    PTSTB,PTSTDB
 RS       ARG    PTSTB,PTSTRS,400B
 US       ARG    PTSTB,PTSTUS,400B
 UL       ARG    PTSTB,PTSTUL,400B
 UU       ARG    PTSTB,PTSTUU,400B
 NN       ARG    PTSTB,PTSTNN
 PTSTB    CON    0
 PTSTC    BSS    1           TST ORDINAL FOR TERMINAL
 
 PTSTTN   BSSZ   1           TERMINAL NAME
 PTSTDB   BSSZ   1           DATA BASE NAME
 PTSTRS   BSSZ   1           READ SECURITY
 PTSTUS   BSSZ   1           UPDATE SECURITY
 PTSTUL   BSSZ   1           USER AREA LOWER
 PTSTUU   BSSZ   1           USER AREA UPPER
 PTSTNN   BSSZ   1           NEW TERMINAL NAME
 TARG     SPACE  4
**        TARG   TERMINAL COMMAND ARGUMENT CRACKER
*
*         ENTRY  (B2) = ARGUMENT COUNT
*
*         EXIT   (X3) = TST ORDINAL OF TERMINAL SPECIFIED IN COMMAND
*                (A3) = TST ADDRESS OF TERMINAL SPECIFIED IN COMMAND
 
 
 TARG     PS
          SB4    B2-1        ARGUMENT COUNT
          SA4    SBUF+1      FIRST ARGUMENT FOR COMCARG
          SB5    TARGA       ARGUMENT TABLE
          RJ     ARG         PROCESS COMMAND ARGUMENTS
          NZ     X1,PCMD3    IF ERROR IN ARGUMENTS
          SA4    TN          TERMINAL NAME
          BX3    X3-X3
          MX6    -14
          ZR     X4,TARG3    NO TERMINAL NAME IN COMMAND
          RJ     STST        SEARCH TERMINAL STATUS TABLE
          ZR     X3,PCMD3    IF INCORRECT USER/TERMINAL
 
*         CLEAR ARGUMENTS FOR NEXT COMMAND
 
 TARG3    BX6    X6-X6
          SA6    TN          TERMINAL NAME
          EQ     TARG        *RETURN
 
 TARGA    BSS    0
 TN       ARG    TARGB,TN    TERMINAL NAME
 TARGB    CON    0
 
 TN       BSS    1           TERMINAL NAME
          ENDOVL
          TRANOVL  (K-DISPLAY COMMANDS *3*.)
 DIS      SPACE  4,35
***       K.DIS,TASKNAME,P1,P2,P3,P4,P5,P6.
*
*         THE NAMED TASK WILL BE SCHEDULED FOR EXECUTION
*         VIA SUBROUTINE *TRN*. THE OPTIONAL PARAMETERS WILL BE
*         MOVED TO THE TEMPORARY AREA *DISC*. THIS AREA WILL BE
*         SUBMITTED TO *TRN* AS INPUT AND EVENTUALLY END UP IN THE
*         TASK-S COMMUNICATION BLOCK.
 
*         NOTE THAT IF NO OPTIONAL PARAMETERS ARE PRESENT,
*         TASK RECEIVES ONLY THE COMMUNICATION BLOCK HEADER.
*         *SYSTEM BUSY* MESSAGE WILL APPEAR ON *K-DISPLAY* IF ANOTHER
*         TASK HAS THE *K-DISPLAY* AT THIS TIME.
*
*         ENTRY  (B2) = NUMBER OF PARAMETERS IN *SBUF*.
*                (SBUF+0) = DIS.
*                (SBUF+1) = TASK NAME.
*                (SBUF+2)...(SBUF+7) = OPTIONAL PARAMETERS.
*                (KDISB) = BIT 59 SET TO 1, IF ANOTHER TASK
*                          HAS THE *K-DISPLAY*.
*
*         EXIT   (KDISB) = BITS 53-59 SET ACCORDING TO THE BIT
*                          MASK IN *BM* FIELD OF *DISA* TABLE ENTRY.
*                TO *PCMDX*, IF TASK SCHEDULED.
*                TO *PCMD1*, IF INCORRECT TASK OR TOO MANY PARAMETERS.
*                TO *PCMD4*, IF ANOTHER TASK HAS THE DISPLAY OR
*                            IF NO COMMUNICATION BLOCK AVAILABLE.
*
*         USES   X - 0, 2, 3, 4, 5, 6.
*                A - 2, 3, 4, 6.
*                B - 2, 3, 4, 6.
*
*         CALLS  TRN.
 
 
 DIS      BSS    0
          ENTRY  DIS,K
 
          SA2    KDISB
          NZ     X2,PCMD4    IF ANOTHER TASK HAS THE *K-DISPLAY*
          SA4    SBUF+1
          SB4    DISAL-1
          MX0    42
          SA2    DISA
          SX5    B0          MESSAGE CODE FOR *TRN*
 DIS1     SA3    A2+B4       VERIFY TASK NAME
          BX6    X0*X3
          BX6    X6-X4
          SB4    B4-B1
          ZR     X6,DIS2     IF TASK FOUND
          PL     B4,DIS1     IF NOT ALL NAMES EXAMINED
          EQ     PCMD1       INCORRECT TASK NAME
 
 DIS2     SA2    DISD        PICK UP THE MODEL HEADER
          SB6    B2+         NUMBER OF PARAMETERS IN *SBUF*
          MX0    -12
          BX3    -X0*X3      NUMBER OF PARAMETERS ALLOWED THIS TASK
          SB6    B6-2        NUMBER OF OPTIONAL PARAMETERS
          SX6    B6
          SA6    DISF        SAVE NUMBER OF OPTIONAL PARAMETERS
          SB3    X3
          SX6    A3+
          SA6    DISE        SAVE *DISA* ENTRY ADDRESS
          SX6    B6+B1
          BX6    X6+X2
          LT     B3,B6,PCMD1 IF TOO MANY PARAMETERS
          SA6    DISB        BUFFER HEADER
          SB3    DISB
          LE     B6,DIS4     IF NO PARAMETERS TO MOVE
          SB4    DISC-1
 DIS3     SA2    SBUF+1+B6   MOVE PARAMETERS
          BX6    X2
          SA6    B4+B6
          SB6    B6-1
          NE     B6,DIS3     IF NOT ALL PARAMETERS MOVED
 DIS4     RJ     TRN         SCHEDULE TASK
          ZR     X0,PCMD4    IF NO COMMUNICATION BLOCK AVAILABLE
          SA2    DISF
          SB4    X2-CBDL
          SB4    -B4         NUMBER OF WORDS TO ZERO OUT
          BX6    X6-X6       CLEAR REST OF DATA INPUT AREA IN C.B.
          SX3    X0+CMBHL+CMBRL+CBDL  *TDUA*
          SB3    X3-1        LWA OF DATA INPUT AREA
 DIS5     SA6    B3+
          SB3    B3-B1
          SB4    B4-B1
          NZ     B4,DIS5     IF REST OF DATA INPUT AREA NOT CLEAR
          SX4    CBDL+5      RESET MESSAGE WORD COUNT IN C.B.
          SA2    X0+CMBHL+1
          MX6    48
          BX6    X6*X2
          BX6    X6+X4
          SA6    A2
          MOVE   5,KBUF,X3   MOVE INPUT TO USER DEFINED AREA OF C.B.
          SA2    DISE        ADDRESS OF THE TASK ENTRY
          MX6    42
          MX3    6
          SA2    X2+
          BX6    X6*X2       TASK NAME
          LX2    59-17
          SA6    KDISE
          BX6    X3*X2
          BX6    X6+X0       MOVE C.B. ADDRESS INTO *KDISB*
          SA6    KDISB
          EQ     PCMDX       RETURN
 
**        DISA - TASKS THAT CAN BE INVOKED BY *K-COMMAND*.
*
*T        42/TN,6/BM,12/NO
*
*         TN = TASK NAME.
*         BM = BIT MASK TO INSERT IN *KDISB* BITS 53-59.
*         NO = MAXIMUM NO. OF PARAMETERS (INCL. TASK NAME).
 
 DISA     BSS    0
          VFD    42/7LCRMTASK,6/64B,12/3
 DISAL    EQU    *-DISA
 
 DISB     BSS    1           HEADER WORD
 DISC     BSS    7           MESSAGE BUFFER
 DISD     VFD    12/4001B,12/0,18/0,18/0 PROTOTYPE HEADER
 DISE     BSS    1
 DISF     BSS    1           LENGTH OF UNPACKED INPUT IN WORDS
 DUMP     SPACE  4,20
***       K.DUMP,FWA,LWA.  OR  K.DUMP,LWA.  OR  K.DUMP.
*
*         DUMP THE TRANSACTION EXECUTIVE FIELD LENGTH, WHERE FWA IS
*         THE FIRST WORD OF MEMORY TO DUMP AND LWA IS THE LAST WORD
*         OF MEMORY TO DUMP.  THE DUMP WILL BE ROUTED TO A PRINTER
*         WITH AN *ID* OF *DRID*.
*
*         ENTRY  (B2) = THE NUMBER OF PARAMETERS.
*                (SBUF - SBUF+2) = PARAMETERS.
*
*         EXIT   TAF FIELD LENGTH DUMP COMPLETE.
*                TO *PCMD3* IF ERROR ENCOUNTERED.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 6, 7.
*
*         CALLS  DXB.
*
*         MACROS CLOCK, DATE, MESSAGE, ROUTE, SYSTEM, WRITER, WRITEW.
 
 
 DUMP     BSS    0
          ENTRY  DUMP,K
 
          SB7    3
          GT     B2,B7,PCMD3 IF INCORRECT PARAMETER COUNT
          SB6    B2
          SB7    B0+         ASSUME OCTAL FOR PARAMETER CONVERSION
 
*         SET THE DEFAULT FWA AND LWA VALUES.
 
          BX6    X6-X6
          SX7    377777B
          SA6    DUMQ        ASSUME FWA = 0
          SA7    DUMR        ASSUME LWA = 377777B
 
*         OBTAIN THE FIRST AND LAST ADDRESS OF THE DUMP
*         FROM THE PARAMETERS.
 
          EQ     B6,B1,DUM2  IF FORM OF COMMAND IS *DUMP.*
          SA5    SBUF+1      SECOND PARAMETER
          RJ     DXB         CONVERT SECOND PARAMETER TO BINARY
          NZ     X4,PCMD3    IF ERROR IN CONVERSION OF NUMBER
          SB7    3
          EQ     B6,B7,DUM1  IF FORM OF COMMAND IS *DUMP,FWA,LWA.*
          SA6    DUMR        USE SECOND PARAMETER AS LWA FOR DUMP
          EQ     DUM2        CHECK FOR ADDITIONAL ERRORS
 
 DUM1     SB7    0
          SA6    DUMQ        USE SECOND PARAMETER AS FWA FOR DUMP
          SA5    SBUF+2      THIRD PARAMETER
          RJ     DXB         CONVERT THIRD PARAMETER TO BINARY
          NZ     X4,PCMD3    IF ERROR IN CONVERSION OF NUMBER
          SA6    DUMR        USE THIRD PARAMETER AS LWA
 
*         CHECK FOR MORE ERRORS IN THE PARAMETERS.
 
 DUM2     SA4    DUMQ        FWA OF DUMP
          SA5    DUMR        LWA OF DUMP
          IX6    X5-X4
          SA3    DUMT        MAXIMUM FL FOR A CONTROL POINT
          IX3    X5-X3
          PL     X3,PCMD3    IF LWA .GE. MAXIMUM FL FOR A CONTROL POINT
          NG     X6,PCMD3    IF FWA .GE. LWA+1
 
*         SET VARIABLE FIELDS IN THE HEADER PAGE.
 
          SA2    DUMS
          SA3    PCMDB
          BX6    X2
          ZR     X3,DUM3     IF OPERATOR INITIATED
          MX4    12
          SA3    X3+2        WORD 3 OF SUBCONTROL POINT TABLE
          BX3    X3*X4
          LX3    12          TASK DIRECTORY INDEX
          TA3    X3-1,VTLD   TASK LIBRARY DIRECTORY ENTRY
          MX4    42
          BX6    X4*X3       TASK NAME LEFT JUSTIFIED, ZERO FILLED
 DUM3     SA6    DUMJ        MERGE TASK NAME INTO MESSAGE
          DATE   DUMD        MERGE DATE INTO MESSAGE
          CLOCK  DUME        MERGE TIME INTO MESSAGE
 
*         WRITE THE HEADER PAGE.
 
          SX5    DUMU
 DUM4     WRITEW O,DUMA,DUMB SECURE MESSAGE
          SX5    X5-1
          NZ     X5,DUM4     IF MORE MESSAGE
          SX5    DUMV
 DUM5     WRITEW X2,DUML,DUMM  CARRIAGE CONTROL TO SKIP LINE
          SX5    X5-1
          NZ     X5,DUM5     IF MORE MESSAGE
          WRITEW X2,DUMC,DUMF  DATE AND TIME
          WRITEW X2,DUMG,DUMH  DESCRIPTIVE MESSAGE
          WRITEW X2,DUMI,DUMK  ORIGINATOR OF DUMP
          SX5    DUMV
 DUM6     WRITEW X2,DUML,DUMM  CARRIAGE CONTROL TO SKIP LINE
          SX5    X5-1
          NZ     X5,DUM6     IF MORE LINES TO SKIP
          SX5    DUMU
 DUM7     WRITEW X2,DUMA,DUMB  SECURE MESSAGE
          SX5    X5-1
          NZ     X5,DUM7     IF MORE MESSAGE
          WRITER X2,R        COMPLETE WRITING THE HEADER PAGE
 
*         COMPLETE THE DUMP OPERATION.
 
          SA4    DUMQ        FWA OF DUMP
          SA5    DUMR        LWA OF DUMP
          SYSTEM DMD,R,X5,X4 REQUEST DUMP
          ROUTE  DUMN,R      DISPOSE DUMP TO PRINT QUEUE
          MESSAGE  DUMO,0    MESSAGE TO DAYFILE
          SA1    DUMN        CLEAR ROUTE COMPLETION BIT
          MX2    59
          BX6    X2*X1
          SA6    DUMN
          EQ     PCMDX       EXIT
 
 DUMA     DATA   40L * * * * * * * * * * * * * * * * * *  SE
          DATA   40LCURE, GIVE TO CENTRAL SITE TAF SYSTEMS A
          DATA   48CNALYST ONLY. * * * * * * * * * * * * * * * * * *
 DUMB     EQU    *-DUMA      MESSAGE LENGTH
 DUMC     DATA   50L
 DUMD     DATA   10H YY/MM/DD.  DATE OF DUMP
 DUME     DATA   10H HH.MM.SS.  TIME OF DUMP
          CON    0           END OF LINE
 DUMF     EQU    *-DUMC      MESSAGE LENGTH
 DUMG     DATA   50L                                      THE FOLLOWIN
          DATA   40CG IS A DUMP OF THE FIELD LENGTH OF TAF.
 DUMH     EQU    *-DUMG      MESSAGE LENGTH
 DUMI     DATA   50L
          DATA   20L DUMP INITIATED BY
 DUMJ     BSS    1           ORIGINATOR OF DUMP
 DUMK     EQU    *-DUMI      MESSAGE LENGTH
 DUML     VFD    60/1C-
 DUMM     EQU    *-DUML
 DUMN     VFD    42/6LOUTPUT,18/0  ROUTE PARAMETER BLOCK
          VFD    24/0,12/2LLP,24/00000026B
          VFD    36/0,24/DRID
          BSSZ   2
 DUMO     DATA   32C TAF FIELD LENGTH DUMP RELEASED.
 DUMQ     BSS    1           FWA OF DUMP
 DUMR     BSS    1           LWA OF DUMP
 DUMS     DATA   8COPERATOR
 DUMT     CON    FLMAX       MAXIMUM FL FOR A CONTROL POINT
 
*         HEADER PAGE REPEAT COUNT DEFINITIONS.
 
 DUMU     EQU    15          SECURE MESSAGE REPEAT COUNT
 DUMV     EQU    5           LINE FEED REPEAT COUNT
 DUMPLIM  SPACE  4,20
***       K.DUMPLIM,N.  OR  K.DUMPLIM.
*
*         SET THE GLOBAL TASK DUMP LIMIT TO THE VALUE SPECIFIED BY
*         THE PARAMETER.  IF NO PARAMETER IS SPECIFIED THE LIMIT IS
*         SET TO ZERO.  THE GLOBAL TASK DUMP FLAG IS CLEARED.
*
*         ENTRY  (B2) = NUMBER OF PARAMETERS.
*                (SBUF - SBUF+1) = PARAMETERS.
*
*         EXIT   GLOBAL TASK DUMP LIMIT IS SET TO VALUE SPECIFIED.
*                GLOBAL TASK DUMP FLAG IS CLEARED.
*                TO *PCMD3* IF ERROR ENCOUNTERED.
*
*         USES   X - 5, 6.
*                A - 5, 6.
*                B - 3, 7.
*
*         CALLS  DXB.
 
 
 DUMPLIM  BSS    0
          ENTRY  DUMPLIM,K
 
          SX6    B0+
          EQ     B2,B1,DML1  IF *N* IS NOT SPECIFIED
          SB3    B1+B1
          SB7    B1          DECIMAL BASE ASSUMED
          GT     B2,B3,PCMD3 IF INCORRECT PARAMETER COUNT
          SA5    SBUF+1      NEW GLOBAL TASK DUMP LIMIT
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,PCMD3    IF ERROR IN CONVERSION
 DML1     SA6    GTDL        SAVE GLOBAL TASK DUMP LIMIT
          EQ     PCMDX       EXIT
 
          ENDOVL
          TRANOVL (UPDATE A TASK LIBRARY.)
 ULD      SPACE  4,35
**        ULD - UPDATE CORE COPY OF A TASK LIBRARY DIRECTORY.
*
*         UPDATE LIBRARY DIRECTORY IS EXECUTED IN RESPONSE TO A
*         *LIBTASK,TT* REQUEST FOR AN ON-LINE TASK LIBRARY UPDATE BY
*         PASSING THE USER NAME AND LIBRARY NAME TO THE TRANSACTION
*         EXECUTIVE VIA A *SIC* REQUEST.  IF THE USER NAME AND
*         LIBRARY NAME DO NOT MATCH, A POSSIBLE BREACH OF SECURITY IS
*         ASSUMED AND THE USER NAME AND LIBRARY NAME ARE JOURNALLED
*         AND NO UPDATES ARE ATTEMPTED.  OTHERWISE, MEMORY FOR THE
*         UPDATE IS REQUESTED FROM *RCP* AND THE DIRECTORY READ INTO
*         MEMORY.  IF THE FORMAT OF THE NEW DIRECTORY IS CORRECT AND
*         THE UPDATE DOES NOT RESULT IN A SITUATION WHERE ENOUGH FL
*         CANNOT OR MIGHT NOT BE OBTAINED, THE NEW DIRECTORY REPLACES
*         THE OLD ONE.
*
*         ENTRY  TO *ULD* IF FIRST ATTEMPT.
*                (INRB) = LIBRARY UPDATE REQUEST.
*                (PCMDF) = 0 IF NO LIBTASK REQUEST ACTIVE.
*                TO *ULD0* IF RETRY ATTEMPT.
*                (X4) = FIRST WORD OF LIBRARY REQUEST.
*                (A4) = FWA OF LIBRARY REQUEST.
*
*         EXIT   TO *TSSC*.
*                (KDISA) = USER NAME IF  UPDATE MUST BE RETRIED.
*                (KDISB) = TASK LIBRARY IF UPDATE MUST BE RETRIED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  ESCP1, JRNL, PBL, PNM, RCP.
*
*         MACROS ATTACH, MOVE, READSKP, RECALL, RENAME, RETURN,
*                SKIPB, SKIPEI.
 
 
 ULD      BSS    0
          ENTRY  ULD
          SA4    PCMDF       LIBTASK ACTIVE FLAG
          NZ     X4,TSSC     IF LAST LIBTASK NOT COMPLETE
          SX6    B1          SET LIBTASK ACTIVE
          SA6    A4
          SA4    INRB        INTERCONTROL POINT RECEIVING BUFFER 0
 
 ULD0     RECALL TL          WAIT FOR LIBRARY FILE IDLE
          SA4    A4+B1
          BX6    X4          SAVE USER NAME
          SA6    PCMDG
          BX7    X7-X7       CLEAR INTERCONTROL POINT RECEIVING BUFFER
          MX6    42
          SA5    A4+B1       READ TASK LIBRARY NAME
          BX0    X6*X5       (X0) = LIBRARY NAME
          BX1    X6*X4       USER NAME OF LIBTASK SUBMITTER
          SA7    A4-B1
          BX6    X0
          MX4    42
          SA6    PCMDH
          SA5    TL+B1
          MX3    -48
          BX6    -X3*X5      CLEAR DEVICE TYPE FROM FET
          SA3    DEVT        DEFAULT DEVICE TYPE
          BX7    X7-X7
          LX3    -12
          BX6    X6+X3
          SA6    A5
          SA7    TL+CFPK     CLEAR PACK NAME FROM FET
          SA3    VUSN        USER NAME FOR LIBRARY FILE
          SA2    VTFL        SYSTEM TASK LIBRARY NAME
          BX7    X1-X3
          LX6    X2
          NZ     X7,ULD0.1   IF NOT TAF-S USER NAME
          BX7    X6-X0
          BX4    X4*X7
          TX7    0,VTLD
          ZR     X4,ULD3     IF SYSTEM TASK LIBRARY
 ULD0.1   TA4    0,VEDT      READ *EDT* HEADER
          SB5    B1+B1
          MX6    42
          EQ     ULD2        ENTER USER NAME VALIDITY SEARCH
 
*         SEARCH *EDT* HEADERS FOR MATCHING USER NAME.
 
 ULD1     ZR     X4,ULD15    IF INCORRECT USER NAME
          SA4    X4+
 ULD2     SX4    X4
          SA3    A4+B5
          BX3    X6*X3
          IX7    X3-X1
          NZ     X7,ULD1     IF NO MATCH ON USER NAME
 
*         CHECK LIBRARY NAME FOR USER NAME.
 
          SA5    A3+B5       (A5) = FWA OF FIRST TASK
          LX5    17-35
          ZR     X5,ULD15    IF LIBRARY NOT ATTACHED
          SA5    X5-1        READ TASK LIBRARY NAME
          BX7    X6*X5
          BX5    X7-X0
          NZ     X5,ULD1     IF NO MATCH ON LIBRARY NAME
          BX6    X1          SAVE USER NAME
          SA6    PCMDG
          MX5    12
          SA1    A4          FWA OF *EDT* HEADER
          SA4    A3+B5       FWA OF XXTASKL FROM EDT HEADER + 4
          BX7    X4
          MX6    48
          ZR     X4,TSSC     IF TASK LIBRARY NOT AT CONTROL POINT
 
*         DETERMINE DEVICE ATTRIBUTES OF LIBRARY FILE RESIDENCE AND
*         ATTACH FILE.
 
          SA4    A4+B1       PACK NAME FROM EDT HEADER + 5
          LX6    6
          BX6    X6*X4
          LX4    -18
          BX4    X5*X4       DEVICE TYPE
          AX7    18
          SA5    TL+1
          SA6    TL+CFPK     PACK NAME AND UNIT INTO TASKLIB FET
          MX6    -48
          BX5    -X6*X5
          IX6    X4+X5
          SA6    A5          DEVICE TYPE INTO FET
 ULD3     SA1    ULDE        LOCAL FILE NAME
          BX6    X1
          SA6    TL          STORE FILE NAME
          MX2    1
          SA5    A6+B1
          SA7    ULDD        FWA FOR *DBTASKL*
          LX2    44-59       SET *EP* BIT TO CHECK FOR ATTACH ERROR
          BX7    X2+X5
          SA7    A5
          ATTACH TL,PCMDH,X3,,M  ATTACH,ZZZZZTL=DBTASKL/M=W
          SA1    X2          FIRST WORD OF FET
          BX7    X5
          MX2    52
          SA7    A5          CLEAR *EP* BIT FROM FET
          LX2    10-0
          BX7    X2*X1       CLEAR ERROR STATUS
          SA7    A1
          BX2    -X2*X1      ABNORMAL STATUS CODES
          NZ     X2,ULD14    IF ERROR ON ATTACH
          SA1    ULDD        FWA OF *DBTASKL*
          SA2    X1-4
 
*         REQUEST MEMORY FROM *RCP* AND READ DIRECTORY INTO
*         PROVIDED SPACE.
 
          SX0    X2+77B      AMOUNT OF CORE TO REQUEST
          AX0    6
          LX0    6
          BX6    X0          SAVE *TLD* LENGTH
          LX2    TRFWN-1-TRFWS  GET FWA OF *TRD*
          SA1    X2-3
          SX3    TRDLE1*TRDMN  EXPANSION AREA OF *TRD*
          LX1    TDLDN-1-TDLDS
          SX1    X1          LENGTH OF DIRECTORY IN *TRD* HEADER
          ERRNZ  TDLDN-18    *TDLDN* NOT 18 BITS
          IX3    X1+X3       SPACE NEEDED TO READ IN THE *TRD*
          SX3    X3+177B     ROUND TO NEAREST 200B
          AX3    6
          LX3    6
          IX0    X3+X6       AMOUNT OF SPACE TO REQUEST
          LX3    18
          BX6    X3+X6
          SA6    ULDK        SAVE SPACE REQUIRED
          RJ     RCP         REQUEST SUBCONTROL POINT
          ZR     X5,ULD13    IF MEMORY NOT AVAILABLE
          SX6    B4+         SAVE SUBCP ADDRESS
          SA6    PCMDD
          SA1    TL+1        SET FET TO READ IN DIRECTORY
          MX2    -18
          SX6    X5          START OF CORE TO READ DIRECTORY TO
          BX7    X2*X1
          BX7    X7+X6
          SA6    A1+B1       IN
          SA7    A1          FIRST
          SA6    A6+B1       OUT
          SA3    A6+B1       LIMIT
          BX7    X2*X3
          BX7    X7+X6
          SA1    ULDK
          SX0    X1+         LIMIT FOR *TLD*
          IX7    X7+X0
          SA7    A3          LIMIT
          SKIPEI TL,R        SKIP TO EOI
          SKIPB  TL,2,R      BACKSPACE TO POSITION AT DIRECTORY
          READSKP TL,,R      READ IN DIRECTORY
          SA1    ULDD
          SA3    X1-4
          SA4    TL+2        IN
          SA2    A4+B1       OUT
          IX6    X4-X2       (X6) = NUMBER OF WORDS IN NEW *TLD*
          SX0    X3
          IX6    X0-X6
          NG     X6,ULD18    IF *TLD* ENLARGED PAST EXPANSION AREA
 
*         CHECK NEW DIRECTORY HEADER FOR LEGALITY.
 
 ULD6     SB4    B1+B1
          SB5    X1          FWA OF OLD *TLD*
          SA1    X1-3        OLD HEADER
          SA2    X5+B1       NEW HEADER
          SA4    ULDJ        MASK FOR OLD DIRECTORY ENTRY EXTRACTION
          MX3    42
          BX7    X7-X7
          LX6    X4
          BX1    X3*X1       COMPARE UPPER 42 BITS ONLY
          BX2    X3*X2
          IX3    X2-X1       COMPARE
          NZ     X3,ULD17    IF NOT SAME TASK
          SA3    TL+2        IN
          SB3    X3+
          SA4    TL+4        LIMIT
          SB6    X4
          SA2    B5
 ULD8.1   SA7    B3          ZERO OUT TO END OF BUFFER
          SB3    B3+B1
          NE     B3,B6,ULD8.1 IF NOT END OF BUFFER
          MX4    59
          SB3    TLDLE
          MX3    59
          LX4    57-0
          LX3    TLQUS-0
          SB6    X5+4        FWA OF NEW *TLD*
          BX4    X3*X4       MASK FOR NEW ATTRIBUTES TO IGNORE
 
*         ADD USAGE COUNTERS FROM CURRENT DIRECTORY.
 
 ULD9     MX1    TLTNN       MASK TASK NAME
          SA3    B6          FWA OF NEW DIRECTORY ENTRY
          BX7    X2-X3
          BX7    X1*X7
          NZ     X7,ULD13.1  IF NO MATCH ON TASK NAME
          SA3    A3+B4       THIRD WORD OF *TLD*
          SA2    A2+B4
          SB5    B5+B3
          BX7    X6*X2       USAGE COUNTERS AND TASK STATUS
          SB6    B6+B3
          BX3    X4*X3       IGNORE NEW CM RESIDENT FIELD
          BX7    X7+X3       ADD TO NEW DIRECTORY WORD
          LX3    59-56       CHECK EXTENDED MEMORY BIT IN NEW ENTRY
          PL     X3,ULD11    IF NOT EXTENDED MEMORY RESIDENT
          LX2    59-56       CHECK EXTENDED MEMORY BIT IN OLD ENTRY
          PL     X2,ULD10    IF NOT EXTENDED MEMORY RESIDENT
          SA2    A2-2        REPLACE NEW ENTRY WITH OLD
          BX7    X2
          SA2    A2+B1
          SA7    A3-2
          BX7    X2
          SA7    A7+B1
          SA2    A2+B1
          BX7    X2
          EQ     ULD11       CHECK END OF DIRECTORY
 
 ULD10    SX2    1           CLEAR EXTENDED MEMORY BIT IN NEW ENTRY
          LX2    56
          BX7    -X2*X7
 ULD11    SA7    A3
          SA2    B5
          NZ     X2,ULD9     IF NOT FINISHED PROCESSING DIRECTORY
 ULD11.1  SA3    B6+         NEXT *TLD* ENTRY IN NEW DIRECTORY
          ZR     X3,ULD11.2  IF FINISHED PROCESSING NEW INSERTIONS
          SA3    A3+B4       THIRD WORD OF *TLD*
          SB6    B6+B3       NEXT *TLD* ENTRY
          LX3    59-TLECS    CHECK EXTENDED MEMORY BIT IN NEW ENTRY
          MX2    TLECN
          PL     X3,ULD11.1  IF NOT EXTENDED MEMORY RESIDENT
          BX7    -X2*X3      CLEAR EXTENDED MEMORY BIT IN NEW ENTRY
          LX7    TLECS-59
          SA7    A3+
          EQ     ULD11.1     CHECK NEXT *TLD* ENTRY
 
 
*         CHECK FOR POTENTIALLY BLOCKED TASKS.
 
 ULD11.2  RJ     PBL         POTENTIAL BLOCKS DURING LIBRARY UPDATE
          ZR     B7,ULD11.3  IF NO BLOCKED TASKS DETECTED
          EQ     ULD13.1     BLOCKED TASKS DETECTED
 
*         READ *TRD* FROM TASK LIBRARY.
 
 ULD11.3  SX2    X5+TLDLH    SAVE START OF NEW *TLD*
          SA1    ULDD        START OF OLD DIRECTORY
          IX4    X2-X1       OFFSET OF DIRECTORY
          LX2    18
          BX6    X1+X2
          SA6    ULDL
          SX2    X0-TLDLH    NUMBER OF WORDS TO MOVE
          LX2    36
          BX6    X2+X6
          SA6    ULDM        SAVE MOVE INFORMATION
          RJ     URD         UPDATE *TRD*
          ZR     B3,ULD13.1  IF UPDATE *TRD* UNSUCCESSFUL
 
*         REPLACE OLD TASK DIRECTORY.
 
          SX7    B3+         LWA OF NEW *TRD*
          SA7    ULDN
          SA1    ULDM        GET MOVE INFORMATION
          SX3    X1          FWA OF OLD *TLD*
          LX1    -18
          SX2    X1          FWA OF NEW *TLD*
          LX1    -18
          SX1    X1+         NUMBER OF WORDS TO MOVE
          MOVE   X1,X2,X3
 
*         REPLACE OLD TRANSACTION DIRECTORY.
 
          SA1    ULDL        GET FWA OF *TLD*
          SA2    X1+TRFWW    GET FWA OF OLD *TRD*
          LX2    TRFWN-1-TRFWS
          SX0    B1
          SX3    X2-4        FWA OF OLD *TRD*
          SA1    TL+1        GET FWA OF NEW *TRD*
          SX2    X1+
          SA4    ULDN        LWA OF NEW *TRD*
          SX6    X4-1
          ZR     X6,ULD12    IF NO *TRD* TO UPDATE
          IX1    X4-X2       NUMBER OF WORDS TO MOVE
          IX6    X3+X1       NEW LWA OF DIRECTORY
          SA4    X2+B1       UPDATE LWA OF DIRECTORY IN HEADER
          IX6    X6-X0
          MX0    60-TDLWN
          BX4    X0*X4
          BX6    X4+X6       LWA OF DIRECTORY IN HEADER
          SA6    A4
          MOVE   X1,X2,X3
 
*         RELEASE CORE USED FOR NEW DIRECTORIES.
 
 ULD12    SA3    ULDK        SPACE FOR DIRECTORIES
          SX0    X3+
          AX3    18
          SA1    AVAILCM
          IX0    X0+X3
          IX6    X1+X0
          SA6    A1          ADD CORE TO FREE CORE COUNT
          SA3    PCMDG
          ATTACH TL,,X3,,RM  REATTACH FILE IN READ MODE
          RENAME TL,PCMDH    RENAME TASK LIBRARY
          BX0    X0-X0       NO COMMUNICATION BLOCK
          SB4    8           8 = ON-LINE LIBTASK UPDATE
          SX6    B1+B1       (X6) = NUMBER OF WORDS TO JOURNAL
          SB3    PCMD7       RETURN ADDRESS
          SB5    PJRNL       (B5) = PRIMARY JOURNAL FILE FET
          SX5    PCMDG
          LX6    35-17
          BX5    X6+X5       (X5) = LENGTH + FWA OF MESSAGE
          EQ     JRNL        JOURNAL MESSAGE
 
*         CAN NOT READ DIRECTORY - SET STATUS FOR LATER RETRY.
 
 ULD13    SA3    PCMDG
          RETURN TL,R        RETURN LOCAL FILE
          SA1    KDISA       SET UP FOR REATTEMPT
          SA3    PCMDG
          SA2    PCMDH       READ TASK LIBRARY NAME
          BX6    X1+X3       SET USER NAME
          BX7    X2
          SA6    A1+
          SA7    KDISC
          EQ     TSSC        EXIT TO SWITCHING LOOP
 
*         INCORRECT LIBTASK ATTEMPT.
*         - INCORRECT USER.
*         - LIBRARY FILE NOT ATTACHED.
*         - BLOCKED TASKS DETECTED.
*         - *TRD* UPDATE UNSUCCESSFUL.
 
*         RELEASE CORE USED FOR NEW DIRECTORIES.
 
 ULD13.1  SA3    ULDK        SPACE FOR DIRECTORIES
          SX0    X3+
          AX3    18
          SA1    AVAILCM
          IX0    X0+X3
          IX6    X1+X0
          SA6    A1          ADD CORE TO FREE CORE COUNT
          SB5    B5-ULDB
          ZR     B5,ULD16    IF LIBRARY FILE HEADER IS DIFFERENT
 
 ULD14    RETURN TL,R        RETURN NEW LIBRARY FILE
 
 ULD15    SB5    -ULDA       COMPLEMENT OF FWA OF MESSAGE
          RJ     PNM         PUT NAME IN MESSAGE
 ULD16    SB4    7           INCORRECT INTER-CONTROL POINT TRANSFER
          SB3    PCMD9       (B3) = RETURN ADDRESS FROM *JRNL*
          SB5    PJRNL       (B5) = PRIMARY JOURNAL FILE FET
          SX6    2           (X6) = NUMBER OF WORDS TO MOVE
          SX5    PCMDG
          LX6    35-17
          BX5    X5+X6
          BX0    X0-X0       NO COMMUNICATION BLOCK
          EQ     JRNL        JOURNAL MESSAGE AND EXIT
 
*         LIBRARY FILE HEADER IS DIFFERENT - ERROR.
 
 ULD17    RETURN TL,R        RETURN NEW LIBRARY FILE
          SB5    -ULDB       COMPLEMENT OF FWA OF MESSAGE
          RJ     PNM         PUT NAME IN MESSAGE
          SB5    ULDB
          EQ     ULD13.1     ISSUE MESSAGE
 
*         LIBTASK OVERFLOW MESSAGE.
 
 ULD18    SB5    -ULDC       COMPLEMENT OF FWA OF MESSAGE
          RJ     PNM         PUT NAME IN MESSAGE
          SA1    ULDD
          EQ     ULD6        CONTINUE PROCESSING
 
 
 ULDA     DATA   C* INCORRECT LIBTASK ATTEMPT - XXXXXXX, +++++++.*
 ULDB     DATA   C* CHANGED TLD DETECTED - XXXXXXX, +++++++.*
 ULDC     DATA   C* TLD OVERFLOW - XXXXXXX, +++++++.*
 ULDD     BSSZ   1           FWA OF OLD DIRECTORY
 ULDE     VFD    42/0LZZZZZTL,18/1  LOCAL FILE NAME
 ULDJ     VFD    TLSTN/0     MASK FOR OLD DIRECTORY ENTRY EXTRACTION
          VFD    TLNDN/0
          VFD    TLCMN/1     CM RESIDENT
          VFD    TLECN/0
          VFD    TLTON/1     TASK ON/OFF
          VFD    TLDLN/0
          VFD    TLTLN/777777B  NUMBER OF TIMES TASK LOADED
          VFD    TLTCN/777777B  NUMBER OF TIMES TASK CALLED
          VFD    TLSCN/0
          VFD    TLQUN/1     QUEUING CONTROL
          VFD    TLREN/1     REDUCE FIELD LENGTH
          VFD    TLX1N/0
          VFD    TLBPN/0     BASE PRIORITY
          VFD    TLTAN/7     TASK ACTIVE STATUS
          VFD    TLQLN/0
 ULDK     BSS    1           SPACE FOR *TRD* AND *TLD*
 ULDL     BSS    1           FWA OF NEW AND OLD *TLD*
 ULDM     BSS    1           MOVE INFORMATION FOR *TLD*
 ULDN     BSS    1           LWA OF NEW *TRD*
 URD      SPACE  4,20
**        URD - UPDATE TRANSACTION DIRECTORY.
*
*         ENTRY  (X4) = DIFFERENCE BETWEEN NEW AND OLD DIRECTORY.
*                (X5) = FWA OF NEW *TLD*.
*                (ULDK) = SPACE REQUIRED TO READ IN *TRD*.
*
*         EXIT   (B3) = LWA OF NEW *TRD*.
*                     = 0, IF UPDATE UNSUCCESSFUL.
*                     = 1, IF NO *TRD* TO UPDATE.
*                     = (B2) AND (B7) RESTORED.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  LTT, RSP, SNM, STD.
*
*         MACROS MESSAGE, READ.
 
 
 URD      SUBR               ENTRY/EXIT
          SB3    B1+
          MX0    -TLTRN
          SA1    X5          GET *TRD* PRU
          BX6    -X0*X1
          ZR     X6,URDX     IF NO PRU
          BX7    X4          DIFFERENCE BETWEEN NEW AND OLD DIRECTORY
          SA7    URDD
          SA6    TL+6        PUT PRU IN FET
          SA1    TL+1        FIRST
          SA2    TL+4        LIMIT
          MX0    42
          SA3    ULDK        GET SPACE NEEDED FOR *TRD*
          SX7    X2
          BX6    X0*X1
          BX6    X6+X7
          SA6    A1          UPDATE FIRST
          SX5    X7
          SA7    A6+1        UPDATE IN
          SA7    A7+1        UPDATE OUT
          BX0    X0*X2
          LX3    -18
          SX6    X3
          IX7    X6+X7
          BX7    X0+X7
          SA7    A7+B1       UPDATE LIMIT
 
*         READ TRANSACTION DIRECTORY.
 
          READ   TL,R        READ IN DIRECTORY
          SB3    B1
          SA1    TL+2        IN
          SA2    A1+B1       OUT
          IX6    X1-X2       NUMBER OF WORDS IN *TRD*
          ZR     X6,URDX     IF *TRD* EMPTY
          SA1    A2+B1       LIMIT
          SX1    X1+
          IX1    X1-X2
          IX6    X1-X6
          NG     X6,URD6     IF DIRECTORY TOO LONG
          SA2    URDA        VALIDATE *TRD* HEADER
          MX6    TDDNN
          SA1    X5+B1
          BX3    X6*X1
          IX7    X2-X3
          SB3    X5+4
          NZ     X7,URD7     IF INCORRECT *TRD* HEADER WORD
          LX1    TDLDN-1-TDLDS  GET *TRD* LENGTH
          SB5    X1
          ZR     B5,URDX     IF *TRD* LENGTH IS ZERO
          BX7    X7-X7
          SA7    B3+B5       MAKE SURE LAST WORD IS ZERO
          SB2    B3+
 
*         CONVERT TASK TO INDEX.
*
*         (B2) = POINTER TO CURRENT TRANSACTION TASK.
*         (B3) = POINTER TO CURRENT TRANSACTION NAME.
*         (URDD) = DIFFERENCE BETWEEN NEW AND OLD DIRECTORY.
 
 URD1     SA1    B3+TDTNW    GET TRANSACTION NAME
          ZR     X1,URD4     IF NO TRANSACTION NAME
          BX7    X1          PUT TRANSACTION NAME IN FWA OF *TRD*
          SB3    B3+B1
          SA7    B2+
          SB2    B2+B1       INCREMENT POINTER
          BX5    X5-X5
          SB7    5
 URD2     SA2    B3          GET TASK NAME
          SB3    B3+1
          BX6    X6-X6
          ZR     X2,URD3     IF NO TASK NAME
          SB4    B3+         SAVE POINTER
          SA1    ULDL        GET FWA OF NEW *TLD*
          SB3    TLDLE       LENGTH OF ENTRY
          LX1    -18
          SB5    X1          START OF DIRECTORY
          SA1    X1-3
          LX1    -18
          SB6    X1+B5       END OF DIRECTORY
          SB6    B6-TLDLE
          RJ     STD         SEARCH TASK
          SB3    A1+B1
          TB5    0,VTLD
          SX6    B3-B5
          SA4    URDD        GET DIFFERENCE
          SB3    B4          RESTORE B3
          IX6    X6-X4       INDEX
          ZR     X1,URD3     IF TASK FOUND
          BX3    X3-X3       SERCH SYSTEM LIBRARY
          BX6    X6-X6
          SB4    B0
          SB5    B0
          RJ     LTT         LOCATE TASK
          ZR     X6,URD5     IF TASK NOT FOUND
          LX6    12          RIGHT JUSTIFY BIAS
 URD3     LX5    12
          BX5    X5+X6
          SB7    B7-1        DECREMENT COUNTER
          NZ     B7,URD2     IF NOT END OF CONVERSION
          BX6    X5
          SA6    B2          PUT TASK ORDINAL INTO *TRD*
          SB2    B2+1        INCREMENT POINTER
          EQ     URD1        PROCESS NEXT TRANSACTION
 
 URD4     SX7    B0+
          SA7    B2+         ZERO OUT LAST WORD
          SB3    B2+
          RJ     RSP         RESTORE REGISTERS B2 AND B7
          EQ     URDX        RETURN
 
 URD5     SB3    B0+         TASK NOT FOUND
          RJ     RSP         RESTORE REGISTERS B2 AND B7
          EQ     URDX        RETURN
 
*         DIRECTORY TOO LONG.
 
 URD6     SB5    URDB
          EQ     URD8        ISSUE DAYFILE MESSAGE
 
*         INCORRECT *TRD* HEADER.
 
 URD7     SB5    URDC
 
*         ISSUE DAYFILE MESSAGE.
 
 URD8     SB2    1RZ         DISPLAY CODE SEARCH CHARACTER
          SA1    TL
          MX0    42
          BX1    X0*X1       LIBRARY NAME TO INSERT
          SB3    DAYB
          SB5    -B5
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB      ISSUE DAYFILE MESSAGE
          SB3    B0+
          RJ     RSP         RESTORE REGISTERS B2 AND B7
          EQ     URDX        RETURN
 
 URDA     VFD    60/0LTRD    *TRD* HEADER
 URDB     DATA   C* TRANSACTION DIRECTORY TOO LONG - ZZZZZZZ.*
 URDC     DATA   C* INCORRECT TRANSACTION DIRECTORY HEADER - ZZZZZZZ.*
 URDD     BSS    1           DIFFERENCE BETWEEN NEW AND OLD DIRECTORY
 PBL      SPACE  4,20
**        PBL - POTENTIALLY BLOCKED TASKS DURING LIBRARY UPDATE.
*
*         THIS ROUTINE DETECTS POTENTIALLY BLOCKED TASKS DURING
*         A LIBRARY UPDATE.  IF A BLOCK IS DETECTED, THE UPDATE IS
*         REJECTED.
*
*         ENTRY  (X5) = FWA OF NEW DIRECTORY, INCLUDING HEADER.
*                (PCMDH) = NAME OF NEW DIRECTORY.
*
*         EXIT   (B7) = 0, IF NO BLOCKED TASKS DETECTED.
*                     = 1, IF BLOCKED TASKS DETECTED.
*                (X0) = RESTORED.
*                (X5) = SAME AS ENTRY.
*                (MINXT) = MINIMUM SIZE OF TRANSIENT TASK AREA.
*
*         USES   A - 1, 3, 4, 5, 6, 7.
*                X - ALL.
*                B - 3, 5.
*
*         CALLS  DBC, DBN, RTD.
 
 
 PBL      SUBR               ENTRY/EXIT
          BX6    X5          SAVE REGISTERS
          BX7    X0
          SA6    PBLA
          SA7    PBLB
          SX7    X5+4
          SA7    DPBK        FWA OF NEW DIRECTORY
          SA1    CMRFL       SAVE VALUES OF OLD ACCUMULATORS
          BX7    X1
          BX6    X6-X6
          SA7    PBLC
          SA1    CMRPF
          BX7    X1
          SB5    B0          INITIALIZE TASK COUNTER
          SA7    PBLD
          SA6    CMRFL       INITIALIZE ACCUMULATOR
          SA6    CMRPF       INITIALIZE ACCUMULATOR
          SA1    MFL         MFL OF TAF
          BX6    X1
          SA6    DPBJ
 
*         FIRST PASS THROUGH TASK LIBRARY DIRECTORIES.
 
          SA1    VTFL        NAME OF SYSTEM TASK LIBRARY
          MX2    42
          BX6    X2*X1
          SB3    -1          READ ALL TLD ENTRIES
          TA5    0,VTLD      EXAMINE SYSTEM TLD
          SA1    DPBK        FWA OF NEW DIRECTORY
          SA3    PCMDH       NAME OF UPDATED LIBRARY
          IX2    X3-X6
          NZ     X2,PBL1     IF LIBRARY NOT UPDATED
          BX6    X3
          SA6    DPBL        NAME OF UPDATED LIBRARY
          SA5    X1+
 PBL1     RJ     RTD         RETURN TASK LIBRARY DATA
          TA4    0,VEDT      GET ADDRESS OF FIRST TLD
          BX0    X4          CHECK EDT COUNT
          LX0    -18
          SX0    X0+
          ZR     X0,PBL5     IF NO MORE EDT-S
 PBL2     SX0    X4          SAVE LINK TO NEXT HEADER
          SA5    A4+4        GET FWA OF TLD IN WORD 5
          AX5    18
          ZR     X5,PBL4     IF LIBRARY NOT ATTACHED
          SA5    X5+         SET UP SEARCH ADDRESS
          SA3    A5-1
          MX2    42
          BX6    X2*X3
          SA1    DPBK        FWA OF NEW DIRECTORY
          SA3    PCMDH       NAME OF UPDATED LIBRARY
          IX2    X3-X6
          NZ     X2,PBL3     IF LIBRARY NOT UPDATED
          BX6    X3
          SA6    DPBL        NAME OF UPDATED LIBRARY
          SA5    X1+
 PBL3     SB3    -1          READ ALL TLD ENTRIES
          RJ     RTD         RETURN TASK LIBRARY DATA
 PBL4     ZR     X0,PBL5     IF NO MORE DIRECTORIES
          SA4    X0+         RESTORE LINK TO NEXT HEADER
          EQ     PBL2        PROCESS NEXT TLD
 
*         LOOK FOR POTENTIAL BLOCKS.
 
 PBL5     RJ     DBC         DETECT BLOCKS IN CM RESIDENT TASKS
          RJ     DBN         DETECT BLOCKS IN NON CM RESIDENT TASKS
          NZ     B7,PBL6     IF BLOCKED TASKS DETECTED
          SA5    PBLA        RESTORE REGISTERS
          SA4    PBLB
          BX0    X4
          EQ     PBLX        RETURN
 
*         RESTORE ACCUMULATORS IF ERROR AND RETURN.
 
 PBL6     SA1    PBLC        RESTORE CMRFL
          SA3    PBLD        RESTORE CMRPF
          BX6    X1
          BX7    X3
          SA6    CMRFL
          SA7    CMRPF
          EQ     PBLX        RETURN
 
 PBLA     BSS    1           (X5)
 PBLB     BSS    1           (X0)
 PBLC     BSS    1           OLD (CMRFL)
 PBLD     BSS    1           OLD (CMRPF)
          SPACE  4,10
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMKDPB
 
          ENDOVL
 
 ULD0     EQU    /"PROD""M."/ULD0
          TRANOVL (TERMINAL INITIALIZATION.)
 CIN      SPACE  4,10
**        CIN - COMMUNICATION SUBSYSTEM INITIALIZATION.
 
 
 CIN      BSS    0
          ENTRY  CIN
 
          TX7    0,VTST      START OF TERMINAL STATUS TABLE
          SA7    CINA
 
*         EXAMINE THE STATUS OF EACH TERMINAL AND REINTIALIZE FOR ANY
*         TERMINAL IN A STATE OF DEPENDENCY FOR ACTION BY THE
*         COMMUNICATION SUBSYSTEM.
 
 CIN1     SA1    CINA
          TB5    X1+TSTLLE-1,-VTST,LWA
          ZR     B5,LOVL     IF ALL ENTRIES PROCESSED
          SX6    X1+TSTLLE   NEXT TERMINAL TO PROCESS
          SA6    CINA
          SX2    B1
          SA5    X6          FIRST WORD OF TERMINAL STATUS TABLE ENTRY
          LX2    TSRBS-0
          MX4    1
          LX5    59-TSLIS
          PL     X5,CIN1     IF TERMINAL NOT LOGGED IN
          BX5    -X4*X5      CLEAR LOGGED IN BIT
          LX5    TSLIS-59
          LX4    TSAUS-59
          BX5    -X4*X5      CLEAR USER ACTIVE FIELD
          BX6    X5
          SA6    A5
 
*         SET THE RECOVERY BIT FOR ALL LOGGED IN TERMINALS AND FOR ALL
*         POLLED TERMINALS.
 
 CIN2     BX7    X5+X2       SET USER RECOVERY BIT
 .A       IFEQ   IPTAR,1     IF AUTOMATIC RECOVERY INSTALLED
          BX3    X5          CHECK FOR RECOVERABLE TRANSACTION
          LX4    TSARS-59-TSAUS+59
          LX3    59-TSNRS
          PL     X3,CIN2.1   IF NO RECOVERABLE TRANSACTION RUNNING
          LX3    59-59-59+TSNRS  SET RECOVERY REQUIRED
          BX7    X4+X3
          SA3    A5+B1       WORD 2 OF *TST* ENTRY
          LX4    TSCPS-59-TSARS+59
          BX6    X3+X4
          SA6    A3          SET CONNECTION POSTPONE FLAG
 CIN2.1   BX7    X7+X2
 .A       ENDIF
          TX1    A5,-VTST    COMPUTE TERMINAL ORDINAL
          SA7    A5
          SX2    TSTLLE
          SB3    B7
          IX0    X1/X2
          SB7    B3
          SB5    B0
          MX6    12
          SA4    A5+TSIWW    INPUT WANTED STATUS
          MX3    TSIWN
          LX4    59-TSIWS
          PL     X4,CIN1     IF NOT IN INPUT WANTED STATE
 
*         FOR ALL TERMINALS WITH TASKS WAITING FOR INPUT, CLEAR THE
*         TERMINAL WAITING FOR INPUT STATUS AND SET THE ROLLIN DELAY
*         TIME TO ZERO.
 
          BX7    -X3*X4      CLEAR WAIT INPUT STATUS
          LX7    59-59-59+TSIWS
          LX6    -30
          SA7    A4
          LX5    18
 CIN3     RJ     SRO         SEARCH ROLLOUT TABLE
          ZR     B5,CIN1     IF END OF TABLE
          SA2    B5
          BX3    X6*X2
          LX2    59-58
          PL     X2,CIN3     IF NOT A WAIT FOR INPUT ROLLOUT ENTRY
          BX3    X3-X5
          LX2    58-59
          NZ     X3,CIN3     IF NO MATCH ON TERMINAL ORDINAL
          MX7    RTTLN
          LX7    -6
          BX7    -X7*X2      CLEAR ROLLIN TIME TO FORCE A ROLLIN
          SA7    A2+
          EQ     CIN3
 
 CINA     BSS    1           CURRENT TERMINAL TABLE ENTRY
 
          ENDOVL
 
 L.       SET    *           END OF LAST OVERLAY
 L.D      MAX    L.,L.D
 
 LAST     EQU    L.D         LWA+1 OF TRANEX OVERLAY LOAD AREA
 "PROD"1  TTL    "PROD"1 - INITIALIZATION - VER "VERT".
          EJECT
          QUAL   "PROD"1
          IDENT  "PROD"1,INIT,INIT,0,0        INITIALIZATION.
*COMMENT  TAFNAM - EXECUTIVE INITIALIZATION.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       *TAF1* - TRANSACTION FACILITY EXECUTIVE INITIALIZATION.
*         J. R. HOGUE  CSDD  1972
*         L. A. BOELTER ASD 75/01/20. TOTAL DATA MANAGER INITIALIZATION.
*         G. W. PROPP / J. R. HOGUE 75/10/01. TAF.
*         M. M. CHEN.  TAF/CDCS.  80/01/01.
          SPACE  4
***       *TAF1* IS CALLED AFTER *TAFREC* COMPLETES EXECUTION.
*         IT INITIALIZES POINTERS, BUILDS TABLES AND ALLOCATES
*         BUFFERS USED BY *TAF* AND ITS DATA MANAGERS. IT ALSO
*         ATTACHES FILES REQUIRED BY *TAF* AND ITS DATA MANAGERS.
*         WHEN COMPLETE THE MAIN *TAF* OVERLAY IS LOADED AND EXECUTED.
*
*         *TAF1* DETERMINES WHICH DATA MANAGERS ARE TO BE LOADED
*         FROM THE *DMS* STATEMENTS IN THE TAF CONFIGURATION FILE.
*
*         *TAF1* LOADS THE APPLICATION INTERFACE PROGRAM (AIP).
*
*         *TAF1* BUILDS AN *INITL* CALL TO *TOTAL* FOR EACH DATA BASE
*         SPECIFIED ON A *DMS(TOTAL,ON,...)* STATEMENT AND PLACE
*         THE INFORMATION FROM THE XXJ FILE INTO THE ASSOCIATED *EDT*.
*
*         IF OVERFLOW OF THE INITIALIZATION CODE OCCURS,
*         THE MESSAGE * OVERFLOW DURING INITIALIZATION.*
*         IS ISSUED AND THE INITIALIZATION IS ABORTED.  CURRENTLY,
*         *IFL=* IS AN ASSEMBLY OPTION, AND WILL HAVE TO BE INCREASED
*         IF INITIALIZATIONS ARE ABORTED AFTER ADDING NEW DATA BASES
*         TO THE *DMS* STATEMENT IN *TCF*.
 
 
*CALL,COMKIPR
          SPACE  4,10
          LIST   X
*CALL     COMKTIF
          LIST   -X
 INIT     TITLE  INITIALIZATION.
          ORG    IFL=
 INIT     SB1    1
          BX7    X7-X7
          SA7    B0
          GETJCR  ATTB
          PDATE  PDATE       SET PACKED TIME AND DATE
          GETPFP STIA        GET CURRENT FAMILY
          SA1    STIA
          BX6    X1
          SA6    INITQ       SAVE CURRENT FAMILY NAME
          MEMORY CM,,R,FFL=  SET INITIAL FL
 
*         LOAD INITIALIZED LOW CM VALUES FROM TIF.
 
          READ   TIF         INITIATE READ
          READO  TIF         READ INITIALIZATION STATUSES
          SA6    INITA
          READW  TIF,VLOCS,VLOCL  LOAD LOW CM VALUES
          SA1    INITA
          LX1    59-TIRFS
          NG     X1,INIT3    IF RESTART
          LX1    59-TICRS-59+TIRFS
          NG     X1,INIT2    IF TO INITIALIZE *CRM* RECOVERY FILES
          SA2    VREC        SET *CRM* RECOVERY FLAG
          MX7    1
          BX7    X7+X2
          SA7    A2+
 
*         SET UP INITIAL VALUES, VARIABLE TABLES AND BUFFERS.
 
 INIT2    SX6    STAT1       FWA OF TAF STATISTICS
          SA6    VSTAT1
          SX6    RTLW        REQUESTED TASK LIST
          SA6    VRTLW
          MX7    0
          SA7    VINT        CLEAR INITIALIZATION FLAGS
          SA7    VTOT
          SA7    VSND        CLEAR NAM APPLICATION BLOCK NUMBER
          SA7    VAAM        CLEAR ADVANCED ACCESS METHODS
          SA7    VAMB        CLEAR POINTER TO AAM BUFFER
          SA7    VAAQ        CLEAR POINTERS TO *AAM* QUEUES
          SA7    VBCT        CLEAR ADDRESS OF BATCH CONCURRENCY TABLE
          SA7    VNBCT       CLEAR NUMBER OF ENTRIES
 INIT3    RJ     PTF         PROCESS *TAF* CONFIGURATION FILE
 
*         REQUEST EXTENDED MEMORY FIELD LENGTH.
 
          SA2    VECS
          ZR     X2,INIT7    IF NO EXTENDED MEMORY REQUESTED
          LX2    59-29       SET EXTENDED MEMORY FIELD LENGTH
          BX6    X2
          SA6    OBUF        STATUS WORD
          MEMORY ECS,OBUF,R,,NABORT
          SA1    VECS        READ OPERATOR REQUEST
          SA2    OBUF        READ RESPONSE
          MX0    30
          LX1    59-29
          BX2    X0*X2
          IX6    X1-X2
          ZR     X6,INIT7    IF EXTENDED MEMORY REQUEST WAS ASSIGNED
          MESSAGE  INITH     * REQUESTED EXTENDED MEMORY NOT AVAILABLE*
          ABORT
 
 INIT7    SX7    LAST
          SA7    VNACP
 
*         LOAD APPLICATIONS INTERFACE PROGRAM.
 
          LOADER INITO       LOAD NAM *AIP*
          MX0    2
          SA1    INITO+2
          BX2    X0*X1
          SB1    1
          SA1    LWPR        LAST WORD OF *AIP* LOAD
          NZ     X2,DIE23    IF ERROR ON LOAD
          SX1    X1-AFWA
          RJ     COD         CONVERT OCTAL TO DISPLAY
          SB2    1RX         REPLACEMENT CHARACTER
          SB5    MSGAG       FWA OF MESSAGE
          BX1    X4
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  MSGAG,3   * XXXXXX WORDS REQUIRED FOR AIP LOADING*
          SA1    LWPR        LWA OF LOAD
          SX7    X1-TFWA
          PL     X7,DIE25    IF *AIP* TOO LARGE FOR LOADING
          MESSAGE  MSGAH,3   *AIP* SUCCESSFULLY LOADED.*
          SA1    TDBID
          NG     X1,INIT14   IF NOT TO LOAD *TOTAL*
 
*         ATTACH TOTAL BINARIES.
 
 INIT10   ATTACH TOTALF
          RJ     CER         CHECK FOR ATTACH ERROR
          NZ     X1,DIE18    IF ERROR ON ATTACH
 
*         GET DATA BASE NAMES FOR TOTAL.
 
          SB3    INITK+2     START OF LDREQS FOR DBMODS
 INIT11   SA1    TDBID+3     OUT
          SA2    A1-B1       IN
          SA3    X1          DBMOD NAME
          BX4    X1-X2
          SX6    X1+B1       ADVANCE OUT
          ZR     X4,INIT12   IF BUFFER IS EMPTY
          SA6    A1
          SX4    1
          BX6    X3+X4       FILE TO ATTACH
          SA6    TOTFILE
          ATTACH TOTFILE
          RJ     CER         CHECK FOR ATTACH ERROR
          NZ     X1,DIE19    IF ERROR ON ATTACH OF DBMOD
 
*         BUILD LDREQ TABLE FOR DATA BASE NAMES.
 
          SA1    TOTFILE     DBMOD NAME
          MX0    42
          SX2    3
          BX1    X0*X1
          BX7    X1+X2       LDREQ WORD
          SA2    INITK       INCREASE WORD COUNT OF TABLE
          SA7    B3          STORE NAME IN LIST
          SX6    B1
          SB3    B3+B1       NEXT ADDRESS IN LDREQ TABLE
          LX6    36
          IX6    X2+X6
          SA6    A2
          EQ     INIT11      CONTINUE
 
*         LOAD TOTAL AND TOTAL DATA BASE DESCRIPTOR BINARIES.
 
 INIT12   SA1    VNACP       START ADDRESS FOR LOAD
          SA2    INITJ       START OF LIST FOR LOADU
          MX0    18
          LX1    30
          LX0    -12
          BX2    -X0*X2
          BX6    X1+X2
          SA1    TDBID+1     RESET OUT
          SX7    X1
          SA7    TDBID+3
          SA1    INITL       MOVE LDREQ FOR SATISFY
          SA6    A2
          SA2    A1+B1
          BX6    X1
          BX7    X2
          SA6    B3
          SA7    B3+B1
          LOADER INITJ
 
*         CHECK FOR LOADU ERRORS.
 
          SA1    INITJ+2
          SB1    1
          MX0    2
          BX2    X0*X1
          NZ     X2,DIE20    IF LOADU ERRORS
 
*         MODIFY CALLS TO *INTOT.*
 
          MX0    -18
          BX6    -X0*X1      TRANSFER ADDRESS
          SX7    B1
          LX6    30
          LX7    -6
          BX6    X6+X7       RJ INSTRUCTION
          SA6    INITU
          SA1    INITM       PARAMETER LIST FOR INTOT.
          SA6    INIT17
          RJ     *           VOID THE INSTRUCTION STACK
 INITU    RJ     *           INITIALIZE *INTOT.* FOR *TAF1*
*         RJ     =XINTOT.    (CALL INTOT.)
 
*         MODIFY THE RJ TO TOTAL INSTRUCTION.
 
          SB1    1
          SA6    VTOT        TOTAL ENTRY POINT ADDRESS FROM INTOT.
          SA1    XXJ24
          MX0    18
          LX6    30
          LX0    -12
          BX1    -X0*X1
          BX6    X1+X6
          SA6    A1
 
*         RESET START OF EXECUTIVE-S TABLE ADDRESS.
 
          SA1    LWPR        LAST WORD ADDRESS OF PREVIOUS LOAD
          SX6    X1+         LWA+1 OF LOAD
          SA6    VNACP
          MESSAGE  MSGBC,3   * TOTAL DATA MANAGER SUCCESSFULLY LOADED.*
 
*         CHECK IF *AAMI* IS TO BE LOADED.
 
 INIT14   MX3    1
          SA2    VREC        GET RECOVERY FLAG
          BX4    X3*X2
          BX6    -X3*X2      CLEAR *CRM* RECOVERY BIT
          SA1    CDBID
          SA6    A2
          NG     X1,INIT16   IF NOT TO LOAD *CRM*
          PL     X4,INIT15   IF NO *CRM* RECOVERY
          BX6    X6+X3       RESTORE *CRM* RECOVERY BIT
          SA6    A2
 INIT15   SA1    VNACP       START OF ADDRESS FOR LOAD
          SA2    INITS       START OF LIST FOR LOADU
          MX0    18
          LX1    30
          LX0    -12
          BX2    -X0*X2
          BX6    X1+X2
          SA6    A2
          LOADER INITS
 
*         CHECK FOR LOADU ERRORS.
 
          SB1    1
          SA1    INITS+2
          MX0    2
          BX2    X0*X1
          NZ     X2,DIE28    IF LOADU ERRORS
          SA1    INITT+1     ENTRY POINT FOR *IAM*
          SA2    CRMA        RJ TO *IAM*
          LX1    30
          BX6    X1+X2
          SA6    CRMA
          SA2    A1+B1       *AMI* ENTRY POINT
          BX6    X1+X2
          SX7    IFL=        LWA OF MEMORY FOR TABLES
          SA6    VAAM
          SA2    A2+B1       *AMIQ* ENTRY POINT
          LX2    24
          SA3    A2+B1       *AMOQ* ENTRY POINT
          BX6    X2+X3
          SA6    VAAQ
          SA7    TTIP+TILW
          SA1    LWPR
          SX6    X1+
          SA6    VNACP
          MESSAGE  MSGBD,3   * CRM DATA MANAGER SUCCESSFULLY LOADED.*
 
*         LOCATE VARIABLE TABLES AND BUFFERS SET BY INITIALIZATION.
 
 INIT16   RJ     SETL        DETERMINE VARIABLE BUFFER/TABLE LOCATIONS
          SA1    INITN       PARAMETER LIST FOR INTOT.
 INIT17   RJ     INIT17      INITIALIZE INTOT. FOR TAF
*         RJ     =XINTOT.    (CALL INTOT.)
          SX7    1
          SB1    1
          SA7    VINT        TRANEX1 COMPLETE FLAG
          REWIND TIF,R
          WRITEW TIF,INITA,1 WRITE STATUS WORD
          WRITEW TIF,VLOCS,VLOCL  WRITE LOW CM POINTERS TO *TIF*
          WRITER TIF,R       FLUSH BUFFER
          RETURN TOTALF,R
          SA1    INITA
          MX7    -TIRFN
          BX6    -X7*X1      RESTART BIT
          SA2    VREC
          BX3    -X7*X2
          MX7    1
          BX6    X3+X6
          SX1    IPTAR       TAF AUTOMATIC RECOVERY FLAG
          BX2    X7*X2       MASK OFF *CRM* RECOVERY BIT
          LX6    24
          BX2    X2+X1
          BX6    X6+X2       RECOVERY FLAG FOR MAIN PROGRAM
          SA6    A2
          OVERLAY INITC,,S   LOAD MAIN PROGRAM
 
 
 INITA    CON    0           *TIF* INITIALIZATION STATUSES
 
 INITB    CON    0           INITIALIZATION FIELD LENGTH
 
 INITC    VFD    60/0L"PROD"
 
 INITG    BSS    0           JOURNAL FILE 0 INITIALIZATION FET
 JOUR0    FILEB  IBUF,IBUFL,FET=10,EPR
 
 INITH    DIS    ,* REQUESTED EXTENDED MEMORY NOT AVAILABLE.*
 
 INITI    VFD    60/0L"PROD"0
 
*         PARAMETER LIST FOR LOADU FOR LOADING TOTAL.
 
 INITJ    LDREQ  BEGIN,LAST,IFL=,0,0
          LDREQ  MAP,N
 INITK    BSS    0           START OF FILE LIST
          LDREQ  LOAD,(TOTALE/R)
          BSSZ   TMAXDB+1
 INITL    LDREQ  SATISFY,(TRANLIB)
 
*         PARAMETER LIST FOR *INTOT.* FOR *TAF1*.
 
 INITM    VFD    60/IEOQ     ENTER OUTPUT QUEUE
          VFD    60/IFAR     ATTACH FILE
          VFD    60/IGRA     RETURN RA, FL AND DB ID OF TAFXXX1
          VFD    60/IRIQ     RETURN QUEUE ENTRY
 
*         PARAMETER LIST FOR *INTOT.* FOR TAF.
 
 INITN    VFD    60/EOQ      ENTER TOTAL OUTPUT QUEUE
          VFD    60/FAR      ATTACH FILE
          VFD    60/GRA      GET RA, FL AND DATA BASE IDENTIFIER
          VFD    60/RIQ      READ TOTAL INPUT QUEUE
 
*         PARAMETER LIST FOR LOADU FOR LOADING NAM AIP.
 
 INITO    LDREQ  BEGIN,AFWA,ALWA
          LDREQ  OMIT,(PRINT,LIST,ENDL)
          LDREQ  MAP,N
 .C       IFEQ   DBUG,0
          LDREQ  LIBLOAD,NETIOD,(NETCHEK,NETDBG,NETGET,NETGETF,NETGETL,N
,ETOFF,NETON,NETPUT,NETSETP)
          LDREQ  SATISFY,(NETIOD)
 .C       ELSE
          LDREQ  LIBLOAD,NETIO,(NETCHEK,NETGET,NETGETF,NETGETL,NETOFF,NE
,TON,NETPUT,NETSETP)
          LDREQ  SATISFY,(NETIO)
 .C       ENDIF
          LDREQ  SATISFY
 INITP    BSS    0           START OF ENTRY POINTS
 .D       IFEQ   DBUG,0
          LDREQ  ENTRY,(NETCHEK,NETDBG,NETGET,NETGETF,NETGETL,NETOFF,NET
,ON,NETPUT,NETSETP)
 .D       ELSE
          LDREQ  ENTRY,(NETCHEK,NETGET,NETGETF,NETGETL,NETOFF,NETON,NETP
,UT,NETSETP)
 .D       ENDIF
 INITPLE  EQU    *-INITP-1   NUMBER OF ENTRY POINTS
          ERRNG  NCTL-INITPLE NCT MUST HAVE ENOUGH ROOM FOR NAM
*                            ENTRY POINTS.
          LDREQ  END
 INITQ    CON    0           RUNNING FAMILY NAME
 INITS    LDREQ  BEGIN,LAST,IFL=,0,0
          LDREQ  MAP,BSEX,MAP
          LDREQ  SUBST,(CMM.MEM-CMM,RM$SYS=-RM$TSYS,SETUP.-TSE)
          LDREQ  LIBLOAD,TRANLIB,(IAM,AMI,AMIQ,AMOQ)
          LDREQ  SATISFY,(AAMLIB,BAMLIB)
          LDREQ  SATISFY
 INITT    BSS    0           START OF ENTRY POINTS
          LDREQ  ENTRY,(IAM,AMI,AMIQ,AMOQ)
          LDREQ  END
 EDT      SPACE  4,69
**        EDT - ELEMENT DESCRIPTION TABLE.
*
*T VEDT1  12/  DB,12/    ,18/EDTCNT,18/  LINK
*T,VEDT2  6/JORCNT,18/      ,18/JORADR,18/TRCADR
*T,VEDT3  42/        USERNM,18/USINDX
*T,VEDT4  42/        PASSWD,18/
*T,VEDT5  24/0,18/TLDFWA,18/TLDLWA
*T,VEDT6  42/ PACNAM,12/ DEV,6/ UN
*T,VEDT7  42/FAMILY,18/
*
*         WORD 1.
*            DB     - DATA BASE NAME.
*            EDTCNT - NUMBER OF EDT-S (PRESENT ONLY IN FIRST HEADER).
*            LINK   - POINTER TO NEXT EDT.
*
*         WORD 2.
*            JORCNT - NUMBER OF JOURNAL FILES (MAXIMUM OF 3 PER DB).
*            JORADR - ADDRESS OF FIRST JOURNAL FILE FET.
*            TRCADR - ADDRESS OF TRACE FILE FET.
*
*         WORD 3.
*            USERNM - USER NAME (USED TO ATTACH MULTIPLE TLD-S).
*            USINDX - USER INDEX (TO ATTACH JOURNAL AND
*                                 DATA BASE FILES).
*
*         WORD 4.
*            PASSWD - PASSWORD.
*
*         WORD 5.
*            TLDFWA - FWA OF DBTASKL (NAME OF PARTICULAR TLD).
*            TLDLWA - LWA OF DBTASKL.
*
*         WORD 6.
*            PACNAM - PACK NAME OF AUXILIARY DEVICE ON WHICH THE
*                     TASK LIBRARY RESIDES.
*            DEV    - DEVICE TYPE THE FILE WILL BE RESIDING
*                     ON (DI,DJ,...,).
*            UN     - NUMBER OF UNITS OF THE TYPE SPECIFIED IN THE
*                     DEVICE TYPE FIELD.
*
*         WORD7.
*            FAMILY - USER FAMILY NAME.
 
 
*         BUFFER SPACE FOR ELEMENT DESCRIPTION TABLE.
 
 DB       FILEC  DBBF,DBBFL  EDT FILE FET
 DBBF     EQU    *
 DBBFL    EQU    101B
          BSS    DBBFL
 DBBF1    EQU    *
 DBBF2    BSS    14
 EDFL     EQU    13          EDT FET LENGTH
 
 JFLG     CON    0           JOURNAL FLAG
 INTD     BSS    1           CURRENT EDT ADDRESS
          TITLE  TCF PROCESSOR.
 PTF      SPACE  4,35
**        PTF - PROCESS TAF CONFIGURATION FILE (*TCF*).
*
*         PTF READS THE *TCF* AND FOR EACH DIRECTIVE CALLS AN
*         APPROPRIATE SUBPROCESSOR TO HANDLE THE DIRECTIVE.  THE
*         *TCF* HAS ALREADY BEEN PROCESSED IN *TAFREC*, SO ONLY THOSE
*         DIRECTIVES NOT FULLY PROCESSED IN *TAFREC* ARE PROCESSED
*         HERE.
*
*         ENTRY  NONE.
*
*         EXIT   TO *DIE15* IF INCORRECT *TCF* ENTRY.
*                TO *DIE16* IF TCF/DM LOAD FLAG CONFLICT.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5, 6.
*                X - ALL.
*
*         MACROS ABORT, MESSAGE, READ, READC, REWIND.
 
 
 PTF      SUBR               ENTRY/EXIT
          REWIND  TCF,R
          READ   TCF         INITIATE READ
          SX6    -B1         INITIALIZE DATA MANAGER LOAD FLAG
          SA6    CDBID
          SA6    TDBID
 
*         PROCESS TCF.
 
 PTF1     READC  TCF,PTFC,PTFCL READ STATEMENT IMAGE
          NZ     X1,PTF5     IF NO MORE ENTRIES
          SB7    PTFD        FWA TO UNPACK STATEMENT
          SA5    PTFC        FIRST WORD TO UNPACK
          RJ     UPC         UNPACK STATEMENT IMAGE
          NZ     X6,DIE15    IF ERROR ON TCF
          MX3    42          MASK KEY WORD
          SA1    PTFD
          SA4    PTFA        FWA OF KEY WORD TABLE
 PTF2     ZR     X4,DIE15    IF INCORRECT TCF ENTRY
          BX5    X1-X4
          BX2    X3*X5
          SB3    X4
          SA4    A4+B1
          NZ     X2,PTF2     IF NO MATCH
          JP     B3          PROCESS CORRESPOUNDING KEY WORDS
 
*         PROCESS *DMS* STATEMENT.
 
 PTF4     RJ     DMS         PROCESS *DMS* STATEMENT
          EQ     PTF1        READ NEXT STATEMENT
 
*         CHECK FOR DUPLICATE DATA BASE NAME.
 
 PTF5     SA1    TDBID+3     FIRST DATA BASE NAME TO CHECK
          SA2    OTHER+2     LAST
          SB3    X1
          SB6    B0          ASSUME NO DUPLICATE
          SB5    X2+B1
 PTF6     EQ     B3,B5,PTF8  IF DONE CHECKING
          SA1    B3
          SB4    B3+B1       NEXT
          SB3    B3+B1
          ZR     X1,PTF6     IF NO ENTRY
 PTF7     EQ     B4,B5,PTF6  IF DONE CHECKING FOR ONE DATA BASE
          SA2    B4          NEXT
          SB4    B4+B1       ADVANCE POINTER
          ZR     X2,PTF7     IF NO ENTRY
          IX3    X1-X2
          NZ     X3,PTF7     IF NOT THE SAME NAME
          SA3    MSGBE+3     PUT DATA BASE NAME IN MESSAGE
          MX6    -48
          BX4    -X6*X3      CLEAR OLD NAME
          BX7    X4+X1
          SA7    A3
          MESSAGE  MSGBE,3   * DUPLICATE DATA BASE IN TCF - XX.*
          SB6    B1          SET FLAG INDICATE DUPLICATE DATA BASE
          SB3    B3+B1       CHECK NEXT DATA BASE
          EQ     PTF6        CONTINUE CHECKING
 
 PTF8     ZR     B6,PTFX     IF NO DUPLICATE DATA BASE NAME
          ABORT
 
*         KEY WORD TABLE.
*         PROCESS *DISPLAY*, *NETWORK*, *RECOVER*, *K-COMMANDS*
*         AS NO-OPS.
 
 PTF9     EQ     PTF1        READ NEXT STATEMENT
 
 PTF10    SA5    PTFD+B1     NUMBER OF BATCH CONCURRENT JOBS ALLOWED
          RJ     DXB         CONVERT NUMBER TO BINARY
          NZ     X4,DIE15    IF ERRORS IN CONVERSION
          SA6    VNBCT       NUMBER OF BATCH CONCURRENT JOBS
          EQ     PTF1        READ NEXT STATEMENT
 
 PTF11    SA1    VFMN
          SX5    10B         *SETPFP* FLAGS
          BX6    X1+X5
          SA6    STIA        *SETPFP* CALL BLOCK
          SETPFP STIA        SET FAMILY
          EQ     PTF1        PROCESS NEXT COMMAND
 
 
 PTFA     VFD    42/0LDMS,18/PTF4  DATA MANAGER STATUS
          VFD    42/0LDISPLAY,18/PTF9
          VFD    42/0LNETWORK,18/PTF9
          VFD    42/0LRECOVER,18/PTF9
          VFD    42/0LTBCON,18/PTF10
          VFD    42/0LK,18/PTF9
          VFD    42/0LACCOUNT,18/PTF11  *ACCOUNT* COMMAND
          VFD    42/0LUSER,18/PTF11  *USER* COMMAND
 PTFB     BSSZ   1           TABLE TERMINATOR
 PTFC     BSSZ   16          BUFFER FOR STATEMENT IMAGE
 PTFCL    EQU    *-PTFC      LENGTH OF BUFFER
          VFD    60/0L.      DUMMY TERMINATOR
 PTFD     BSSZ   80          BUFFER FOR UNPACK STATEMENT
 DMS      SPACE  4,25
**        DMS - PROCESS *DMS* STATEMENT.
*
*         THE *DMS* STATEMENT IS USED TO INDICATE WHICH DATA
*         MANAGERS ARE TO BE LOADED.  FOR EACH DATA MANAGER LOADED, A
*         RELATIONSHIP IS DEFINED BETWEEN THE DATA MANAGER AND THE
*         DATA BASES THAT CAN USE IT.
*
*         DMS(DM,SW,DB1,DB2,...,DBN)
*
*                WHERE  DM = CRM, TOTAL, OR OTHER.
*                       SW = *ON* OR *OFF*.
*                       DBI = DATA BASE NAMES.
*
*         CRM MEANS *CYBER RECORD MANAGER*.
*         TOTAL IS *TOTAL* DATA MANAGER AND *OTHER* MEANS
*         THAT THE APPLICATION WILL USE THE *CDCS* DATA MANAGER OR
*         ELSE NO DATA MANAGER.
*
*         *ON* MEANS THE DATA BASE NAMES ON THE *DMS* STATEMENT ARE
*         TO BE PUT IN THE DATA BASE BUFFER.  *OFF* IMPLIES THE *DMS*
*         WILL BE TREATED AS A COMMENT STATEMENT.
*         THERE IS NO RESTRICTION ON THE NUMBER OF STATEMENTS
*         FOR A DATA MANAGER.
*
*         ENTRY  (A1) = FWA OF PARAMETER TO CHECK.
*
*         EXIT   TO *DIE4* IF NO DATA BASE ID FOR DATA MANAGER.
*                TO *DIE5* IF TOO MANY DATA BASE NAMES.
*                TO *DIE15* IF INCORRECT TCF ENTRY.
*                TO *DIE24* IF INCORRECT DATA BASE NAME.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 3, 5, 6.
*                X - ALL.
 
 
 DMS      SUBR               ENTRY/EXIT
          MX3    42          MASK PARAMETER
          SA1    A1+B1       FIRST PARAMETER
          SA2    DMSA        CHECK DATA MANAGERS
 DMS1     SB3    X2          ADDRESS TO JUMP TO
          BX4    X1-X2
          SA2    A2+B1
          BX5    X3*X4
          ZR     B3,DIE15    IF INCORRECT *DMS* PARAMETER
          NZ     X5,DMS1     IF NO MATCH
          JP     B3          PROCESS TRANSFERS
 
*         PROCESS CYBER RECORD MANAGER.
 
 DMS3     SB5    CDBID       FIRST
          EQ     DMS6        PROCESS TRANSFER
 
*         PROCESS *TOTAL* DATA MANAGER.
 
 DMS4     SB5    TDBID       FIRST
          EQ     DMS6        PROCESS TRANSFER
 
*         PROCESS *OTHER* PARAMETER.
 
 DMS5     SB5    OTHER       FIRST
 
*         TRANSFER DATA BASE NAMES.
 
 DMS6     SA2    PTFD+2      SECOND WORD OF PARAMETERS
          MX0    42
          SA3    DMSB        CHECK *ON* OR *OFF*
          BX4    X2-X3
          BX5    X0*X4
          ZR     X5,DMSX     IF *OFF* - DO NOT TRANSFER DATA BASE NAMES
          SA3    A3+B1       CHECK IF *ON*
          BX4    X2-X3
          BX5    X0*X4
          SX7    B1
          NZ     X5,DIE15    IF NOT *ON*
          SA1    B5+2        IN
          SA2    B5+4        LIMIT
          SA3    PTFD+3      FIRST DATA BASE
          SX6    X1+
          SA7    B5          SET DATA MANAGER LOAD FLAG
          ZR     X3,DIE4     IF NO DATA BASE ID FOR DATA MANAGER
          MX0    -48
          MX5    48
          LX5    59-11
          SB6    TDBID
          NE     B5,B6,DMS7  IF NOT *TOTAL*
          MX5    12
 DMS7     ZR     X3,DMS8     IF AT END OF PARAMETERS
          BX7    -X0*X3      CHECK FOR INCORRECT DATA BASE NAME
          BX7    X5*X7
          NZ     X7,DIE24    IF INCORRECT DATA BASE NAME
          IX4    X6-X2
          BX7    X3
          PL     X4,DIE5     IF TOO MANY DATA BASES
          SA7    X6
          SA3    A3+B1       NEXT
          SX6    X6+B1       INCREMENT POINTER
          EQ     DMS7        CONTINUE TO TRANSFER DATA BASE NAMES
 
 DMS8     SA6    A1
          EQ     DMSX        RETURN
 
*         DATA MANAGER TABLE.
 
 DMSA     VFD    42/0LCRM,18/DMS3
          VFD    42/0LTOTAL,18/DMS4
          VFD    42/0LOTHER,18/DMS5
 
*         DATA MANAGER STATUS SWITCH.
 
 DMSB     VFD    42/0LOFF,18/0  OFF
          VFD    42/0LON,18/0   ON
          SPACE  4
 SETL     TITLE  DETERMINE AND SET VARIABLE TABLES/BUFFERS.
**        SETL   DETERMINE LOCATION OF VARIABLE TABLES/BUFFERS AND DO
*                ANY NECESSARY HOUSEKEEPING FOR THESE TABLES/BUFFERS.
*
 
 
 SETL     SUBR               ENTRY/EXIT
          SA1    VNACP       START OF TABLE ADDRESSES
          SB7    X1+1
          BX7    X1
          LX7    24
          SA7    A1
          SX7    X1+1
          SA7    X1
          LX7    24
          BX6    X6-X6
          SA7    VCPA        ADDRESS OF FIRST SUB CONTROL POINT
          LX7    -24
          SB6    IFL=        INITIALIZATION FIELD LENGTH
          SB5    B7-B6
          PL     B5,DIE26    IF OVERFLOW DURING INITIALIZATION
 
*         ZERO CORE TO START OF INITIALIZATION CODE.
 
+         SA6    B7
          SB7    B7+B1
          NE     B6,B7,*     LOOP TILL FINISH
 
*         SET UP SUB-CONTROL POINT LINKED CHAIN.
 
          SA1    VNSCP       NUMBER OF SUB CONTROL POINTS
          LX1    -24
          SB2    X1
 SETL1    SB2    B2-1
          ZR     B2,SETL2    FINISHED CHAINING SUB CONTROL POINT AREAS
          SX7    X7+CPAL     ADDRESS OF NEXT SUB CONTROL POINT AREA
          SA7    X7-CPAL
          EQ     SETL1       LOOP
 
*         SET COMMUNICATIONS BLOCK ALLOCATION MAP.
 
 SETL2    SX6    X7
          LX6    24
          SA6    VLSP        LAST SUB CONTROL POINT AREA
          SB2    47
          SA1    VNCMB       NUMBER TO ALLOCATE
          MX2    1
          SX3    B1
          SX4    2222B       FOR USE WITH TABLE ASSIGNMENT
          LX1    -24
          SB3    X1-1
          LX4    48
          SB4    A7+CPAL+CPAL+1   FIRST WORD OF BIT MAP TABLE
          SX7    B4
          LX7    24
          SX5    1
          SA7    VCBRT       SAVE ADDRESS
 SETL3    SB3    B3-B2       USE 47 BITS/WORD
          LE     B3,SETL4    IF ALL COMMUNICATION BLOCKS ALLOCATED
          AX3    X2,B2       SET ONE BIT PER ENTRY
          LX3    -12
          BX7    X4+X3
          BX7    X7+X5       SET BIT 0
          SA7    B4          STORE INTO BIT MAP
          SB4    B4+B1
          EQ     SETL3       LOOP
 
 SETL4    SB3    B3+B2
          AX3    X2,B3       SET ONE BIT PER ENTRY
          LX3    -12
          BX7    X4+X3
          SA7    B4          SET INTO BIT MAP TABLE
 
*         RESERVE COMMUNICATIONS BLOCK AREA.
 
          SX7    B4+B1       START OF COMMUNICATIONS BLOCKS
          SA2    VNCMB       NUMBER OF COMMUNICATIONS BLOCKS
          SX6    X7-CMBL
          LX2    -24
          LX7    24
          SA7    VCBSA       SAVE ADDRESS
          SX1    CMBL        LENGTH OF ONE C.B.
          IX3    X1*X2
          SB4    B4+B1
          SB4    B4+X3       START OF NEXT TABLE
 
*         RESERVE ACTIVE TRANSACTION LIST AREA.
 
          SA1    VNCMB       NUMBER OF C.B.
          LX1    -24
          SX2    ATLL        LENGTH OF ATL ENTRY
          SX7    B4
          SB5    X1          NUMBER OF ATL ENTRIES
          LX7    24
          SA7    VATL        SAVE ADDRESS
          SB6    B4
          IX3    X1*X2
          SB4    B4+X3       START OF NEXT TABLE AREA
 
*         ENTER COMMUNICATION BLOCK ADDRESS POINTER
*         FOR EACH ACTIVE TRANSACTION LIST ENTRY.
 
 SETL5    EQ     B6,B4,SETL6 THRU SETTING POINTERS
          SX6    X6+CMBL
          SA6    B6          SET POINTER
          SB6    B6+B1
          EQ     SETL5
 
*         READ TERMINAL STATUS TABLE FROM *TIF*.
 
 SETL6    SB5    B4-IFL=
          SA0    B4+
          PL     B5,DIE26    IF OVERFLOW DURING INITIALIZATION
          SX7    B4+TTFTL
          LX7    24          SAVE START ADDRESS OF TST
          SA7    VTST
          LX1    TSLIS-0
          LX1    TSAUS-0-TSLIS+0
          BX7    X7+X1       SET USER ACTIVE
          LX2    TSRBS-0
          READO  TIF         LENGTH OF *TST* TO X6
          READW  TIF,A0,X6   READ *TST* TO MEMORY
          SA1    VTST
          SB4    B6+         NEXT FREE WORD
          SX7    B4-IFL=
          PL     X7,DIE26    IF OVERFLOW DURING INITIALIZATION
          SX2    B4-B1
          BX7    X1+X2       SET LWA OF TST
          SA7    VTST
          LX1    -24
          IX7    X2-X1       LENGTH OF TST
          SX2    TSTLLE
          IX7    X7/X2       NUMBER OF TST ENTRIES
          SB3    X7
          LX7    24
          SB3    B3+B1       NUMBER OF NCT ENTRIES
          SA7    VNTST
 
*         SET UP BATCH CONCURRENCY TABLES.
 
          SA1    VNBCT       NUMBER OF BATCH CONCURRENCY ENTRIES
          SX2    X1
          LX2    47-17       POSITION FOR ALLOWED VALUE
          BX6    X1+X2
          SA6    A1          SET ALLOWED AND MAXIMUM VALUES
          ZR     X1,SETL6.1  IF NO ENTRIES
          SX7    B4          CURRENT ADDRESS
          SX2    BCTL        LENGTH OF EACH BATCH CONCURRENT TABLE
          LX7    24
          SA7    VBCT        STARTING ADDRESS OF BATCH CONCURRENT
          LX7    -24
          IX6    X2*X1       LENGTH OF TABLE
          IX6    X7+X6       NEXT FREE WORD FOR MEMORY ALLOCATION
          SB4    X6
          SX7    B4-IFL=
          PL     X7,DIE26    IF OVERFLOW DURING INITIALIZATION
 
*         SET UP NAM COMMUNICATION TABLE (NCT).
 
 SETL6.1  SX1    NAM
          ZR     X1,SETL15   IF NOT IN NAM COMMUNICATION MODE
          SX3    B3-NCTL     NETWORK FILE TERMINALS - NCT MAXIMUM SIZE
          NG     X3,SETL13   IF NETWORK TERMINALS LESS THAN NCT
          SB3    NCTL+1      MAXIMUM SIZE FOR NCT ALLOCATION
 SETL13   SX7    B4          NEXT FREE WORD FOR MEMORY ALLOCATION
          SX6    B3
          SX2    TNCTL       LENGTH OF NCT ENTRY
          LX7    41-17
          IX3    X2*X6       SIZE OF NCT
          SX0    X3-NETL
          PL     X0,SETL13.1 IF ENOUGH SPACE FOR *AIP* ENTRY POINTS
          SX3    NETL        MINIMUM SPACE FOR *AIP* ENTRY POINTS
 SETL13.1 SB5    B4
          SB4    X3+B4       NEXT FREE WORD FOR MEMORY ALLOCATION
          BX7    X7+X6       FWA OF NCT + NUMBER OF NCT ENTRIES
          MX3    1
          SA7    VNCT
 
*         SAVE NAM AIP ENTRY POINTS.
 
          LX3    -5
          MX0    -18         MASK FOR ENTRY POINTS
          SB3    INITPLE     NUMBER OF ENTRY POINTS
 SETL14   SA2    INITP+B3    GET ENTRY POINT FROM LOADER
          BX6    -X0*X2      ENTRY POINT ADDRESS
          ZR     X6,DIE23    IF NO ENTRY POINT NOTE LOADER ERROR
          LX6    30
          BX6    X3+X6       RJ TO ENTRY POINT
          SB3    B3-B1
          SA6    B5+B3       SAVE ENTRY POINT
          NZ     B3,SETL14   IF MORE ENTRY POINTS
 
*         ATTACH JOURNAL FILE 0.
 
 SETL15   SX0    B4
          BX6    X6-X6       ATTACH MODE FLAG
          SB4    INITG       ADDRESS OF JOURNAL 0 FET
          RJ     ATT         ATTACH FILE
          SB4    X0
 
*         RESERVE ROLLOUT FILE ALLOCATION WORDS.
 
          SX7    B4
          SX6    RLATL       LENGTH OF ROLLOUT FILE ALLOCATION AREA
          LX7    24
          SB4    X6+B4
          SA7    VRLAT       FWA OF ROLLOUT FILE ALLOCATION AREA
 
*         SET UP OVERLAY ENTRY POINT TABLE.
 
          SX7    B4          START OF ENTRY POINT LIST
          LX7    24
          SA7    VOEP
          MOVE   SETLGL,SETLG,B4
          SB4    B4+SETLGL
 
*         SET UP OVERLAY RELOCATION CONTROL TABLE.
 
          SX7    B4          START OF RELOCATION CONTROL
          SX6    B4+SETLHL
          LX7    24
          BX7    X7+X6
          SA7    VOREL
          MOVE   SETLHL,SETLH,B4
          SB4    B4+SETLHL
 
*         SET UP *CRF* TABLES, FETS AND BUFFERS.
 
          SX1    IPTAR
          ZR     X1,IDM0     IF AUTOMATIC RECOVERY DISABLED
          SA1    VTST
          LX1    -24
          SB2    X1-TTFTL    FWA OF *TST* HEADER
          SB6    B0
          SB3    8           NUMBER OF HEADER ENTRIES
          SB5    TTFTE       ENTRY LENGTH
          SA3    B2-B5
 SETL18   SA3    A3+B5       NEXT ENTRY
          SB3    B3-B1
          NZ     X3,SETL19   IF A *CRF* FOR THIS ID
          SB6    B6+1
          NE     B3,SETL18   IF MORE ENTRIES
          EQ     SETL21      PACK DOWN ENTRIES
 
*         FORMAT *TAF* RGCOVERY TABLE.
 
 SETL19   SX4    B4          FWA OF *TAF* RECOVERY TABLE.
          BX6    X3+X4
          SA6    A3+
          SA1    SETLE
          SX2    B6+1R0      BINARY TO DISPLAY
          LX2    29-5
          BX6    X1+X2       FORM FILE NAME
          SX2    CIORD       *CIO* FUNCTION CODE
          BX6    X6+X2
          SA6    TL          STORE IN FET
          SX7    IBUF        RESET BUFFER POINTERS
          SA7    TL+2        IN
          SYSTEM CIO,R,A6    READ *CRF* HEADER
          SA1    IBUF+TRNWW
          MX0    TRRSN
          BX6    -X0*X1      REMOVE SHUTDOWN STATUS
          MX0    -TRNWN
          LX1    TRNWN-1-TRNWS
          BX2    -X0*X1      WORDS IN USER MESSAGE
          SX4    X2+77B
          AX4    6           PRU-S IN USER MESSAGE
          LX4    TTNPS-TTNPN+1
          BX6    X6+X4
          ERRNZ  TTNRS-TRNRS RECOVERY UNITS NOT IN SAME FIELD
          SA6    B4          FIRST WORD OF *CRF* TABLE
          SA1    TL
          BX6    X1
          SA6    A6+TTFTW    FIRST WORD OF FET
          SX6    11B
          LX6    47-3        POSITION RANDOM AND USER PROCESSING BITS
          SX5    TTBFW-TTFTW-5  FET LENGTH-5
          LX5    18
          BX6    X6+X5
          SX5    B4+TTBFW    FIRST
          BX6    X6+X5
          SA6    A6+B1
          BX6    X5
          SA6    A6+B1       IN
          SA6    A6+B1       OUT
          LX4    60-TTNPS+TTNPN-1+6  CONVERT PRU-S TO WORDS
          SX2    TRUWL+MRIWL+TRMRL  BUFFER SIZE FOR SYSTEM
          IX1    X2-X4       DETERMINE LARGER
          BX6    X4
          NG     X1,SETL20   IF USER MESSAGE LARGER
          BX6    X2
 SETL20   SX1    B1+B1
          IX6    X6+X1       BUFFER SIZE
          IX6    X6+X5       LWA OF BUFFER
          SA6    A6+B1       LIMIT
          SB6    B6+B1
          SB4    X6+         NEXT FREE WORD
          SX6    B4-IFL=
          PL     X6,DIE26    IF OVERFLOW DURING INITIALIZATION
          NE     B3,SETL18   IF MORE *TST* HEADER ENTRIES
 
*         COMPACT TERMINAL FILE TABLE.
 
 SETL21   SB3    8           MAXIMUM *TST* HEADER ENTRIES
          SB7    B2+
 SETL22   SA1    B7+
          NZ     X1,SETL24   IF THERE IS A *CRF * FOR THIS ID
 SETL23   SB3    B3-B1       DECREASE NUMBER OF ENTRIES LEFT
          SB7    B7+B5       NEXT ENTRY ADDRESS
          NE     B3,SETL22   IF MORE ENTRIES
          EQ     SETL27      SET END OF*TST*
 
 SETL24   SB6    B7-B2
          NE     B6,SETL25   IF WORDS TO MOVE
          SB2    B7+B5
          EQ     SETL23      NEXT ENTRY
 
 SETL25   SX1    B3
          SX2    B5
          IX2    X2*X1       WORDS TO MOVE
          SB6    B2
 SETL26   SA1    B7          MOVE DATA DOWN
          BX6    X1
          SA6    B6
          SB7    B7+B1
          SB6    B6+B1
          SX2    X2-1
          NZ     X2,SETL26   IF MORE TO MOVE
          SB3    B3-B1
          SB2    B2+B5
          SB7    B2
          NE     B3,SETL22   IF MORE ID-S TO PROCESS
 SETL27   SA1    VTST
          LX1    -24
          SB2    X1
          SX7    IBUF        RESET *IN* POINTER
          SA7    TL+2
          EQ     B2,B7,IDM0  IF ALL ID-S USED
          BX6    X6-X6
          SA6    B7          INDICATE END OF DATA IN HEADER
 IDM      TITLE  INITIALIZE DATA MANAGER.
*         INITIALIZE DATA MANAGER
 
 IDM0     SB4    B4+B1
          SX7    B4
          SA7    CCP         CURRENT CORE POSITION
          LX7    24
          SA7    VEDT        START OF EDTS
 
*         INITIAL TOTAL XXJ FILES.
 
 IDM4     SA1    VTOT        TOTAL LOADED FLAG
          SX6    B1
          ZR     X1,IDM6     IF TOTAL IS NOT LOADED
          SA6    TFLAG       FLAG FOR XXJ FILE BEING FOR TOTAL
 IDM5     SA2    TDBID+3     GET FET POINTERS AND DBMOD NAME
          SA1    A2-B1
          SA5    X2          DBMOD NAME
          SX0    B1
          BX6    X5
          BX7    X0+X5
          BX1    X1-X2
          SA6    XXJK        SAVE FOR XXJ PROCESSING
          SA7    TOTFILE     FILE NAME TO RETURN
          MX0    12
          BX6    X0*X5
          SA6    XXJN        SAVE DATA BASE ID
          SX6    X2+B1
          MX2    12
          ZR     X1,IDM6     IF NO MORE DBMODS
          SA1    DBID+5      ADVANCE NUMBER OF EDTS
          SA6    A2          ADVANCE OUT
          SX6    X1+B1
          SA6    A1
          BX5    X2*X5       DATA BASE ID
          RJ     XXJ         GET XXJ FILE AND BEGIN PROCESSING
          SA3    CCP         CURRENT CORE LOCATION
          SX4    IFL=        INITIALIZATION FIELD LENGTH
          SB4    X3          CURRENT EDT ADDRESS
          SA2    TL
          MX0    12
          BX6    X0*X2       DATA BASE NAME
          SX7    B4
          SA6    B4+         FIRST WORD OF EDT
          SA7    INTD        CURRENT EDT ADDRESS
          SB4    B4+HDRL
          BX5    X5-X5       FLAG FOR SECOND PASS IN XXJ
          RJ     XXJ         CONTINUE XXJ FILE PROCESSING
          SX7    B4+
          SA7    CCP         CURRENT CORE LOCATION
          RETURN TOTFILE,R   RETURN DBMOD BINARIES
          RETURN TL,R        RETURN XXJ FILE
          EQ     IDM5        GET NEXT DBMOD
 
 
*         PROCESS AAM XXJ FILE.
 
 IDM6     SX6    B1+         NOT TAF DATA MANAGER
          SA1    VAAM        AAM LOAD FLAG
          ZR     X1,IDM8     IF AAM NOT LOADED
          SA6    TFLAG
          SB2    ZZZZZDG
          STATUS B2          CHECK IF ZZZZZDG IS LOCAL
          SA1    B2
          MX6    11
          LX1    59-11
          BX6    X6*X1
          ZR     X6,IDM7     IF FILE NOT AT C.P.
          RETURN ZZZZZDG
 IDM7     SA2    CDBID+3     OUT
          SA1    A2-B1       IN
          SA5    X2          DATA BASE NAME
          SX6    X2+B1       ADVANCE OUT
          BX1    X1-X2
          SA6    A2
          BX7    X5
          ZR     X1,IDM8     IF NO MORE DATA BASES
          ZR     X5,IDM7     IF NO ENTRY
          SA1    DBID+5      ADVANCE DATA BASES INITIALIZED
          SX7    X1+B1
          MX2    12
          SA7    A1
          BX5    X2*X5       DATA BASE
          BX6    X5
          SX7    B4
          SA6    B4          FIRST WORD OF EDT
          SB4    B4+HDRL
          SA7    INTD        CURRENT EDT ADDRESS
          RJ     XXJ         PROCESS XXJ FILE - INITIAL CALL
          BX5    X5-X5       SECOND PASS OF XXJ FILE
          RJ     XXJ         CONTINUE XXJ PROCESSING
          SX7    B4+
          SA7    CCP         CURRENT CORE POSITION
          RETURN TL          RETURN XXJ FILE
          EQ     IDM7        PROCESS NEXT DATA BASE
 
 
*         PROCESS XXJ FILES FOR OTHER DATA BASES.
 
 IDM8     SA2    OTHER+3     OUT
          SA1    A2-B1       IN
          SA5    X2          DATA BASE NAME
          SX6    X2+B1       ADVANCE OUT
          BX1    X1-X2
          SA6    A2
          BX7    X5
          ZR     X1,IDM8.1   IF NO MORE DATA BASES
          ZR     X5,IDM8     IF NO DATA BASE NAME
          SA1    DBID+5      ADVANCE DATA BASES INITIALIZED
          SX7    X1+B1
          MX2    12
          SA7    A1
          BX5    X2*X5       DATA BASE
          RJ     XXJ         PROCESS XXJ FILE
          SX4    IFL=        AVAILABLE MEMORY FOR TABLES
          SA3    CCP
          SB4    X3          CURRENT EDT ADDRESS
          MX0    12
          SA2    TL          DATA BASE
          BX6    X0*X2       DATA BASE NAME
          SX7    B4
          SA6    B4+         FIRST WORD OF EDT
          SB4    B4+HDRL
          SA7    INTD        CURRENT EDT ADDRESS
          BX5    X5-X5       SECOND PASS OF XXJ FILE
          RJ     XXJ         CONTINUE XXJ PROCESSING
          SX7    B4
          SA7    CCP         CURRENT CORE POSITION
          RETURN TL          RETURN XXJ FILE
          EQ     IDM8        PROCESS NEXT DATA BASE
 
IDM8.1    BX6    X6-X6
          SA6    B4
          SA1    VEDT
          SA3    DBID+5      EDT COUNT
          LX1    -24
          SA2    X1
          SX4    X3
          LX3    18
          BX6    X2+X3
          SA6    A2          UPDATE COUNT IN FIRST EDT HEADER
 IDM9     SX4    X4-1
          ZR     X4,IDM10    IF NO MORE EDTS
          SA2    X2
          BX6    X2
          EQ     IDM9        LOOP
 
 IDM10    MX7    -18
          BX7    X7*X6       CLEAR POINTER TO NEXT EDT
          SA7    A2
          RJ     ABJ         ALLOCATE BUFFERS FOR JOURNAL FILES
          RJ     LTL         LOAD TASK LIBRARY DIRECTORIES
          SA1    TL+1
          SX7    B1
          LX7    44          CLEAR EPR BIT FROM TASK LIBRARY FET
          BX7    -X7*X1
          SA7    A1
          SA1    VTLD
          SX6    B4          ADDRESS OF LAST WORD OF LAST TLD
          LX1    -24
          SA2    X1-4        FIRST WORD OF TLD HEADER
          LX6    24
          BX6    X2+X6
          SA6    A2          UPDATE FIRST TLD FOR K-DISPLAY
          RJ     LTR         LOAD TRANSACTION DIRECTORY
          SB4    B4+B1
 
 
*         ALLOCATE SPACE FOR CMM.
 
 IDM11    SA1    VAAM        AAM LOAD FLAG
          ZR     X1,IDM13    IF *AAM* NOT INITIALIZED
          SB5    5           ALLOCATE BUFFER SPACE
          SX6    B4+         FWA OF AVAILABLE MEMORY
          SA6    TTIP+TIAM
          SB2    TTIP        FWA OF PARAMETERS
          SA1    VCMM        GET CMM FL
          SA3    CRMI        BIT MAP OF FILE ORGANIZATIONS
          BX6    X1
          BX7    X3
          RJ     CRM         ALLOCATE RECORD SPACE
          RJ     RBL         REPORT *BFL* INFORMATION
          SA1    VREC
          MX2    1
          BX1    X2*X1       *CRM* RECOVERY BIT
          NZ     X1,IDM12    IF RECOVERY SITUATION
          SB5    6
          RJ     CRM         INITIALIZE *AAMI* RECOVERY FILES
 IDM12    SA4    TTIP+TIAM   FWA OF AVAILABLE MEMORY
          SB4    X4+
 
*         SET START OF SUB CP AREA.
 
 IDM13    SX7    B4+77B      ROUND UP TO NEAREST 100B
          AX7    6
          LX7    24+6
          SA7    VFSCP
          SB5    B4-IFL=
          PL     B5,DIE26    IF OVERFLOW DURING INITIALIZATION
          EQ     SETLX       RETURN
 ABJ      SPACE  4,10
**        ABJ - ALLOCATE BUFFERS FOR JOURNAL FILES.
*
*                THIS ROUTINE DYNAMICALLY ALLOCATES BUFFER SPACE
*                IN HIGH CORE FOR BUFFERED JOURNAL FILES.
*
*         ENTRY  (B4) = BEGINNING OF BUFFER AREA RETURNED BY *COMBINT*.
*                (VEDT) = START OF EDTS.
*
*         EXIT   (B4) = END OF BUFFER ALLOCATION AREA.
*                ALL BUFFERS HAVE BEEN INITIALIZED.
*
*         USES   A - 0, 1, 2, 3, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7.
*                B - 4, 5.
 
 
 ABJ      SUBR               ENTRY/EXIT
          SA1    VEDT
          LX1    -24
          SA2    X1          EDT HEADER WORD 1
          LX2    -18
          SX4    X1+B1       ADDRESS OF EDT HEADER WORD 2
          SB4    B4+B1
          SX0    X2
 ABJ1     SA3    X4          EDT HEADER WORD 2
          ZR     X0,ABJX     IF COMPLETE - RETURN
          AX3    18
          SX0    X0-1        DECREMENT EDT COUNT
          SA0    X3-JFETL    ADDRESS OF FIRST JOURNAL FILE FET - JFETL
          AX3    36          POSITION JOURNAL BUFFER COUNT
          SB5    X3          JOURNAL COUNT FOR THIS EDT
          SA1    A3-B1       FIRST WORD OF EDT HEADER
          SX4    X1+B1       ADDRESS OF EDT HEADER WORD 2
 ABJ2     ZR     B5,ABJ1     IF NO MORE JOURNAL FILES FOR THIS EDT
          SA0    A0+JFETL    BUMP INDEX TO NEXT JOURNAL FET
          SA1    A0+7
          LX1    -1
          SB5    B5-B1       DECREMENT JOURNAL COUNT
          NG     X1,ABJ2     NOT BUFFERED JOURNAL FILE
          SX7    B4
          LX1    1
          SX6    TAPL+1      BLOCK SIZE FOR *MT,B*
          NG     X1,ABJ3     IF *MT,B*
          SX6    DSKL+1      BLOCK SIZE FOR *MS,B*
 ABJ3     SB4    X6+B4       INCREMENT BUFFER POINTER
          MX1    42
          SA2    A0+B1
          BX2    X1*X2
          SA7    A2+B1       IN
          SA7    A7+B1       OUT
          IX6    X6+X7
          SA6    A7+B1
          BX7    X2+X7
          SA7    A2          FIRST
          SX6    B4-IFL=
          PL     X6,DIE26    IF OVERFLOW DURING INITIALIZATION
          EQ     ABJ2        LOOP
 LTL      SPACE  4,25
**        LTL - LOAD TASK LIBRARY DIRECTORIES.
*
*         LOAD THE SYSTEM TASK LIBRARY DIRECTORY, *TASKLIB*, AND AN
*         *XXTASKL (XX=DATA BASE) LIBRARY DIRECTORY FOR EACH DATA BASE.
*
*         ENTRY  (B4) = BEGINNING OF DIRECTORY AREA.
*                (DBNT) = LIST OF DATA BASE NAMES AND ACCOUNT NUMBERS
*                         ASSOCIATED WITH THAT DATA BASE.
*
*         EXIT   (B4) = LWA+1 OF DIRECTORY AREA.
*                (VTLD-4) - (VTLD-1) = TASK LIBRARY HEADER.
*                TO *DIE12* IF ERROR ON *ATTACH*.
*                TO *DIE26* IF MEMORY OVERFLOW.
*                ABORT IF TLD ERROR.
*                ABORT IF TLD TOO LONG.
*
*         USES   A - ALL.
*                X - ALL.
*                B - 2, 3, 4, 5.
*
*         CALLS  CER, SNM.
*
*         MACROS ABORT, ATTACH, MESSAGE, READ, READW, SKIPB, SKIPEI.
 
 
 LTL      SUBR               ENTRY/EXIT
          RJ     STI         SET TAF INDEX
          RJ     SFD         SET FAMILY TO DEFAULT
          SX6    HBUF        INITIALIZE IN AND OUT IN DBID
          SA6    DBID+3      OUT
          RECALL TL          WAIT FOR COMPLETION OF *CIO* REQUEST
          SA1    VTFL        SYSTEM TASK LIBRARY NAME
          SX7    B0
          BX6    X1
          SA7    TL+8        CLEAR PERMANENT FILE NAME FROM FET
          SA6    TL
          SA0    B4          (A0) = CURRENT INITIALIZATION POINTER
          MX4    -18
          SX7    IBUF
          SA1    A6+B1       TL FET +1
          BX6    X4*X1       SET UP TASK LIBRARY FET
          BX6    X6+X7
          SA7    A1+B1       IN
          SA6    A1          FIRST
          SA7    A7+B1       OUT
          SA2    A7+B1
          SX6    X6+IBUFL
          BX7    X4*X2
          BX7    X7+X6
          SA7    A2          LIMIT
          ATTACH TL,,,,M     ATTACH LIBRARY FILE IN WRITE MODE
          RJ     CER         CHECK ERROR STATUS
          NZ     X1,DIE12    IF ERROR ON ATTACH
          SKIPEI TL
          SKIPB  TL,2        BACKSPACE TO POSITION AT DIRECTORY
          READ   TL          INITIATE READ
          READW  TL,A0,TLDMS
          NG     X1,LTL6     IF DIRECTORY EMPTY
          ZR     X1,LTL8     IF DIRECTORY TOO LONG
          SX6    A0
          IX4    X1-X6       NUMBER OF WORDS IN DIRECTORY
          ZR     X4,LTL6     IF DIRECTORY EMPTY
          SA2    SETLC       COPY OF DIRECTORY HEADER WORD
          MX6    18
          SA3    A0+B1       HEADER WORD ON DIRECTORY
          BX4    X6*X3
          IX7    X2-X4
          NZ     X7,LTL9     IF INCORRECT DIRECTORY HEADER WORD
          SA5    TL
          MX7    42
          SX6    B1
          BX7    X7*X5       NAME OF LIBRARY FILE
          BX7    X7+X6
          SA7    A0+3
          SA7    HBUF        SAVE LIBRARY NAME
          SA2    A0          GET PRU OF *TRD*
          SX6    A0          FWA OF *TLD*
          MX0    -30
          BX0    -X0*X2
          LX0    59-29
          BX6    X0+X6       *TRD* PRU + FWA OF *TLD*
          SA6    A7+B1
          SX6    A6+B1
          SA6    DBID+2      UPDATE DBID IN
          SX7    A0+4        FWA OF DIRECTORY
          LX7    24
          LX3    -18
          SB5    X3+3        SIZE OF BASE DIRECTORY + HEADER WORDS
          SX2    X1+TLDL+TLDLE  DIRECTORY+EXPANSION AREA+TERMINATOR
          SX6    A0+B5       LWA OF BASE DIRECTORY
          BX7    X7+X6
          SX3    A0          START OF TLD
          IX6    X2-X3       TOTAL LENGTH OF TLD
          SA6    A0          TOTAL LENGTH OF TLD TO TLD HEADER
          SA0    X2          SAVE CURRENT POSITION
          SA7    VTLD
          SA4    LTLE
          IX7    X4+X6
          SA7    A4
          SX1    X7-TLDMX    CHECK FOR GREATER THAN 12-BIT OFFSET
          PL     X1,LTL9.1   IF TLD-S TAKE UP TOO MUCH SPACE
          ATTACH TL,,,,RM    ATTACH SYSTEM TASK LIBRARY FILE - READ MODE
 
*         ATTACH XXTASKL FILES (XX=DATA BASE NAME) FOR EACH DATA BASE.
 
          SA5    VEDT
          LX5    -24
          SA2    X5          EDT HEADER WORD 1
          LX2    -18
          SB4    A0+         NEXT AVAILABLE DIRECTORY LOCATION
          SX0    X2          COUNT OF EDTS
 LTL1     ZR     X0,LTLX     IF NO MORE EDT-S
          MX1    12
          SA4    X5          FIRST WORD OF EDT
          BX3    X1*X4       DATA BASE
          SA2    LTLA        *00TASKL*
          BX6    X3+X2
          SX7    IBUF
          SA3    TL+1
          MX1    -18
          SX4    B1
          BX6    X6+X4       ADD ON COMPLETION BIT
          SA6    A3-B1       *DBTASKL*
          BX2    X1*X3
          LX4    44          ERROR PROCESSING BIT
          BX6    X2+X7
          SA7    A3+B1       IN
          BX6    X6+X4
          SA6    A3          FIRST
          SA7    A7+B1       OUT
          SA2    A7+B1
          SX6    X6+IBUFL
          BX1    X1*X2
          BX7    X1+X6
          SB2    FETL-5
          SA7    A2          LIMIT
          BX7    X7-X7
 LTL2     SA7    A7+B1       CLEAR OUT REMAINDER OF FET
          SB2    B2-B1
          NZ     B2,LTL2     IF NOT FINISHED WITH FET
          MX1    42
          SA3    X5+2        USER NAME
          BX7    X1*X3       USER NAME
          SA4    X5+6        FAMILY IN *EDT* HEADER WORD 7
          BX6    X1*X4
          SA1    A4-B1       *EDT* HEADER WORD 6
          SA7    LTLC        SAVE USER NAME FOR *ATTACH*
          SA6    LTLD        SAVE USER FAMILY
          MX7    48
          LX7    6
          BX6    X7*X1
          SA6    TL+CFPK     PACKNAME AND UNIT INTO FET
          LX1    -6
          MX4    -12
          BX4    -X4*X1      DEVICE TYPE
          SA2    TL+1
          NZ     X4,LTL3     IF DEVICE TYPE SPECIFIED
          SA4    ATTA        DEFAULT DEVICE
 LTL3     MX7    -48
          LX4    -12
          BX2    -X7*X2
          IX6    X2+X4
          SA6    A2          DEVICE TYPE TO FET
          SA1    LTLD
          SX2    10B         *SETPFP* FLAGS
          BX6    X2+X1
          SA6    STIA        *SETPFP* CALL BLOCK
          SETPFP STIA        SWITCH TO USERS FAMILY
          SA1    STIA
          LX1    59-12
          NG     X1,LTL10    IF *SETPFP* ERRORS
          ATTACH TL,,LTLC,,M ATTACH LIBRARY IN WRITE MODE
          RJ     CER         CHECK ERROR STATUS
          NZ     X1,LTL5     IF *DBTASK* NOT AVAILABLE
          SKIPEI TL
          SKIPB  TL,2        BACKSPACE TO POSITION AT DIRECTORY
          READ   TL          INITIATE READ
          READW  TL,A0,TLDMS
          SA2    TL
          MX7    42
          SX6    B1
          BX7    X7*X2       NAME OF LIBRARY FILE
          BX7    X7+X6
          SA7    A0+3
          BX3    X1
          NG     X3,LTL6     IF DIRECTORY EMPTY
          ZR     X3,LTL8     IF DIRECTORY TOO LONG
          SA2    DBID+2      GET IN
          SB4    X2
          SA7    X2          SAVE LIBRARY NAME
          SA2    A0          GET PRU OF *TRD*
          MX6    -30
          BX6    -X6*X2
          LX6    59-29
          SX2    A0          FWA OF *TLD*
          BX6    X6+X2       *TRD* PRU + FWA OF *TLD*
          SA6    A7+B1
          SX6    A6+B1
          SA6    DBID+2      UPDATE DBID IN
          SX6    A0
          IX4    X3-X6       NUMBER OF WORDS IN DIRECTORY
          ZR     X4,LTL6     IF DIRECTORY EMPTY
          SA2    SETLC       COPY OF DIRECTORY HEADER WORD
          MX6    18
          SA1    A0+B1       HEADER WORD IN DIRECTORY
          BX4    X6*X1
          IX7    X2-X4
          NZ     X7,LTL9     IF INCORRECT DIRECTORY HEADER WORD
          SX7    A0+4        FWA OF DIRECTORY
          LX7    18
          LX1    -18
          SB5    X1+3        SIZE OF DIRECTORY + HEADER WORDS
          SX2    X3+TLDL+TLDLE  DIRECTORY+EXPANSION AREA+TERMINATOR
          SX6    A0+B5       LWA OF BASE DIRECTORY
          MX1    42
          BX7    X7+X6
          SX3    A0          START OF TLD
          IX6    X2-X3       TOTAL LENGTH OF TLD
          SA6    A0          LENGTH OF TLD TO TLD HEADER
          SA3    X5+2        USER NAME, PASSWORD
          SA0    X2          SAVE CURRENT POSITION
          SA7    X5+4        FWA,LWA OF *DBTASKL*
          BX3    X1*X3       USER NAME
          SA4    LTLE
          IX7    X4+X6
          SA7    A4
          SX1    X7-TLDMX    CHECK FOR GREATER THAN 12-BIT OFFSET
          PL     X1,LTL9.1   IF TLD-S TAKE UP TOO MUCH SPACE
          ATTACH TL,,LTLC,,RM ATTACH LIBRARY IN READ MODE
 LTL4     SA5    X5          GET POINTER TO NEXT EDT
          SB4    A0          NEXT AVAILABLE DIRECTORY LOCATION
          SX0    X0-1        DECREMENT EDT COUNT
          SX1    B4-IFL=
          PL     X1,DIE26    IF MEMORY OVERFLOW
          RJ     SFD         REVERT TO DEFAULT FAMILY
          EQ     LTL1        LOOP TO NEXT EDT HEADER
 
 LTL5     SX7    0
          SA7    X5+4        CLEAR FWA,LWA IN EDT HEADER
          SA1    TL
          MX6    42
          BX1    X6*X1
          SB2    1RX         REPLACEMENT CHARACTER IN MESSAGE
          SB5    -MSGK       * ATTACH ERROR ON - XXXXXXX.*
          SB3    MSGAY       ASSEMBLY AREA FOR MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  MSGAY
          EQ     LTL4        PROCESS NEXT DATA BASE
 
*         COMPLETE MESSAGE, ISSUE IT AND ABORT.
 
 LTL6     SB5    SETLA       * LIBRARY DIRECTORY EMPTY - ZZZZZZZ.*
 LTL7     SA1    TL          GET FILE NAME ASSOCIATED WITH ERROR
          SB2    1RZ         DISPLAY CODE SEARCH CHARACTER
          MX5    42
          BX1    X1*X5       DISPLAY CODE NAME TO INSERT
          RJ     SNM         SET NAME IN MESSAGE
 LTL7.1   MESSAGE  B5
          RJ     SFD         REVERT TO DEFAULT FAMILY
          ABORT
 
 LTL8     SB5    SETLB       * LIBRARY DIRECTORY TOO LONG - ZZZZZZZ.*
          EQ     LTL7        COMPLETE MESSAGE, ISSUE IT, ABORT
 
 LTL9     SB5    SETLD       * LIBRARY DIRECTORY ERROR - ZZZZZZZ.*
          EQ     LTL7        COMPLETE MESSAGE, ISSUE IT, ABORT
 
 LTL9.1   SB5    SETLI       * LIBRARY DIRECTORY SPACE TOO LARGE. *
          EQ     LTL7.1      ISSUE MESSAGE AND ABORT
 
 LTL10    SA1    LTLC        USER NAME
          SB2    1RX
          SB5    MSGAI
          RJ     SNM
          SA1    LTLD        FAMILY
          SB2    1RY
          SB5    MSGAI+2
          RJ     SNM
          MESSAGE MSGAI
          RJ     SFD         REVERT TO DEFAULT FAMILY
          ABORT
 LTLA     VFD    12/0,30/5LTASKL,18/0
 LTLC     BSS    1           USER NAME FROM *EDT*
 LTLD     BSS    1           USER FAMILY FROM *EDT*
 LTLE     BSSZ   1           NUMBER OF WORDS READ FROM TLD-S
 LTR      SPACE  4,25
**        LTR - LOAD TRANSACTION DIRECTORIVES.
*
*         ENTRY  (B4) = FWA OF TRANSACTION DIRECTORY AREA.
*
*         EXIT   TRANSACTION DIRECTORIVES LOADED WITH EXPANDABLE
*                SPACE + 1 AT THE END OF EVERY *TRD*.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2, 3, 4, 5, 7.
*
*         CALLS  STLD.
*
*         MACROS MESSAGE, READ, READW.
 
 
 LTR11    SA1    LTRD        GET TRANSACTION COUNT
          NZ     X1,LTRX     IF COUNT NOT ZERO
          MESSAGE  LTRE
 
 LTR      SUBR               ENTRY/EXIT
 LTR1     SA1    DBID+2      GET IN
          SA2    DBID+3      OUT
          IX3    X1-X2
          ZR     X3,LTR11    IF LOADING COMPLETE
 
*         DETERMINE LIBRARY NAME AND *TRD* ADDRESS.
 
          SA0    B4          FWA OF *TRD*
          SX6    X2+2        UPDATE OUT
          SA6    A2
          SA1    X2          GET LIBRARY NAME
          SA2    A1+B1       GET *TRD* PRU + FWA OF *TLD*
          SA3    X2          GET FWA OF *TLD*
          SX6    A0+4        PUT FWA OF *TRD* IN FWA OF *TLD*
          BX5    X6
          LX6    59-17
          BX6    X6+X3       ADD FWA OF *TRD*
          SA6    A3          UPDATE FWA OF *TLD*
          MX0    30
          BX6    X0*X2       *TRD* PRU
          ZR     X6,LTR6     IF NO PRU
          LX6    30
          SA6    TL+6        PUT PRU IN FET
          MX0    42          PUT LIBRARY NAME IN FET
          BX7    X1
          SA7    TL
          SX6    THBUF
          SA1    A7+B1
          BX1    X0*X1
          BX7    X6+X1
          SA7    A7+B1       FIRST
          SA6    A7+B1       IN
          SA6    A6+B1       OUT
          SX7    X6+IBUFL
          SA1    A6+B1
          BX1    X0*X1
          BX7    X1+X7
          SA7    A1          LIMIT
 
*         READ TRANSACTION DIRECTORY.
 
          READ   TL          INITIATE READ
          READW  TL,A0,TRDMS
          BX3    X1
 
*         VALIDATE TRANSACTION DIRECTORY.
 
          SX4    A0
          NG     X1,LTR6     IF DIRECTORY EMPTY
          ZR     X1,LTR7     IF DIRECTORY TOO LONG
          IX4    X3-X4       NUMBER OF WORDS IN DIRECTORY
          MX6    18
          ZR     X4,LTR6     IF DIRECTORY EMPTY
          SA2    LTRD        INCREMENT TRANSACTION DIRECTORY COUNT
          SX7    X2+1
          SA7    LTRD
          SA2    LTRA        VALIDATE *TRD* HEADER
          SA1    A0+B1       HEADER WORD IN DIRECTORY
          BX4    X6*X1
          IX7    X2-X4
          SB3    X5          FWA OF *TRD*
          NZ     X7,LTR8     IF INCORRECT *TRD* HEADER WORD
          SA3    HBUF        GET DATA BASE NAME
          SA2    TL
          BX0    X0-X0
          IX4    X2-X3
          MX6    42
          BX6    X6*X4
          SB4    A0+TRDLH    FWA OF FIRST TRANSACTION
          ZR     X6,LTR2     IF SYSTEM LIBRARY
          MX0    12
          BX0    X0*X2       DATA BASE NAME
          LX0    12
 LTR2     LX1    -18         GET *TRD* LENGTH
          SB7    5           LENGTH OF *TRD* ENTRY
          SB5    X1
          ZR     B5,LTR6     IF *TRD* LENGTH IS ZERO
          BX7    X7-X7
          SA7    B4+B5       MAKE SURE LAST WORD IS ZERO
 
*         CREATE INDEX TO TASKS FOR TRANSACTIONS.
 
 LTR3     SA1    B3          GET TRANSACTION NAME
          ZR     X1,LTR6     IF NO TRANSACTION NAME
          BX7    X1          PUT TRANSACTION NAME IN WORD ONE OF *TRD*
          SB3    B3+B1
          SA7    X5
          BX6    X6-X6
          SX5    X5+B1       INCREMENT POINTER
 LTR4     BX3    X0          DATA BASE NAME
          SA2    B3+         TASK NAME
          SB3    B3+B1
          ZR     X2,LTR5     IF NO TASK NAME
          RJ     STLD        SEARCH FOR TASK NAME
 LTR5     SB7    B7-B1
          LX6    12
          NZ     B7,LTR4     IF NOT END OF CONVERSION
          SB7    5
          SA6    X5          PUT TASK ORDINAL INTO *TRD* WORD TWO
          SX5    X5+B1       INCREMENT POINTER
          EQ     LTR3        PROCESS NEXT TRANSACTION
 
 LTR6     SB4    X5+TRDL     NEXT AVAILABLE SPACE
          BX7    X7-X7
          SA7    X5          CLEAR LAST WORD
          EQ     LTR10       PROCESS NEXT LIBRARY
 
 LTR7     SB5    LTRB        * TRANSACTION DIRECTORY TOO LONG *
          EQ     LTR10       PROCESS NEXT LIBRARY
 
 LTR8     SB5    LTRC        * INCORRECT TRANSACTION DIRECTORY HEADER *
 
*         ISSUE DAYFILE MESSAGE.
 
 LTR9     SB2    1RZ         DISPLAY CODE SEARCH CHARACTER
          SA1    TL          GET FILE NAME ASSOCIATED WITH ERROR
          MX0    42
          BX1    X0*X1       LIBRARY NAME TO INSERT
          SB3    DAYB        ALTERNATE ASSEMBLY AREA
          SB5    -B5
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB      ISSUE DAYFILE MESSAGE
 
*         PUT LWA OF *TRD* IN *TRD* HEADER.
 
 LTR10    MX0    42
          SX6    X5-1        LWA OF *TRD*
          SA1    A0+B1       *TRD* HEADER
          BX2    X0*X1
          BX6    X2+X6
          SA6    A1+
          EQ     LTR1        PROCESS NEXT LIBRARY
 
 LTRA     VFD    60/0LTRD    *TRD* HEADER
 LTRB     DATA   C* TRANSACTION DIRECTORY TOO LONG - ZZZZZZZ.*
 LTRC     DATA   C* INCORRECT TRANSACTION DIRECTORY HEADER - ZZZZZZZ.*
 LTRD     BSSZ   1           TRANSACTION DIRECTORY COUNTER
 LTRE     DATA   C* NO TRANSACTION NAME IS DEFINED IN TASK LIBRARY.*
 STLD     SPACE  4
**        STLD   SEARCH THE TASK LIBRARY DIRECTORY
*
*         ENTRY  (X2) = LEFT JUSTIFIED TASK NAME
*                (X6) = TASK LIST ACCUMULATOR
*                (X3) = DATA BASE NAME OF TASK LIBRARY
*                     = 0 IF SYSTEM TASK LIBRARY
*
*         EXIT   (X6) = TASK BIAS ADDED TO PRIOR CONTENTS
*                (A1) = ADDRESS OF 1ST WORD FOR *TLD* ENTRY MATCHED
*                ABORT *TAF* IF *OFFTASK* NOT FOUND
*
*         USES   X - 1, 2, 3, 6, 7
*                A - 1, 3, 6, 7
*                B - 4, 5, 6
*
*         MACROS ABORT.
 
 
 STLD     PS                 ENTRY/EXIT
          BX7    X3
          SA7    STLDB
          SA6    A7+B1
          ZR     X3,STLD3    IF NO DATA BASE SPECIFIED
          SA1    VEDT        GET FWA OF EDT
          LX1    -24
          LX7    -12
          SA3    X1+         FWA OF EDT
          LX3    -18
          SB4    X3          EDT COUNT
          LX3    18
          ZR     B4,STLD13   IF NO EDTS TO SEARCH
 STLD1    MX6    12
          BX6    X6*X3       EDT DATA BASE NAME
          IX6    X6-X7
          SB4    B4-B1
          ZR     X6,STLD2    IF DATA BASE NAME MATCH
          SA3    X3+         LINK TO NEXT EDT
          NZ     B4,STLD1    IF MORE EDTS
          EQ     STLD13      NO DATA DASE TASK LIBRARY
 STLD2    SA1    A3+4        EDT HEADER + 4
          SB6    X1
          BX7    X1
          LX1    -18
          SB5    X1
          SB6    B6-TLDLE+1
          SA7    STLDB
          NZ     X1,STLD4    IF NO DATA BASE TASK LIBRARY
 STLD3    SA3    VTLD        START OF *TLD*
          SB6    X3-TLDLE+1  LWA OF SYSTEM *TLD*
          LX3    -24
          SB5    X3          FWA OF *TLD*
 STLD4    MX7    42          MASK FOR TASK NAME
          SX3    B1
          SB4    59
 STLD5    ZR     X3,STLD7    IF NO TASK FOUND
          SX3    B6-B5
          LX1    X3,B4
          PL     X1,STLD6    IF ODD NUMBER OF ENTRIES REMAIN
          SX3    X3+TLDLE
 STLD6    AX3    1
          SA1    B5+X3       NEXT ENTRY
          BX1    X7*X1
          IX1    X1-X2
          NG     X1,STLD11   IF TO RAISE LOWER LIMIT
          ZR     X1,STLD10   IF TASK FOUND
          SB6    A1-TLDLE    LOWER UPPER LIMIT
          GE     B6,B5,STLD5 IF NOT DONE SEARCHING
 
*         SEARCH *TLD* TRAILING ENTRIES (ENTRIES ADDED DYNAMICALLY BY
*         LIBTASK ARE PLACED AT END OF REGULAR DIRECTORY)
 
 STLD7    SA1    STLDB
          ZR     X1,STLD8    IF NO D.B. SPECIFIED
          SB6    X1+B1       LWA OF SPECIFIED D.B.
          SA1    B6
          EQ     STLD9       SEARCH *TLD*
 
 STLD8    SA1    VTLD        GET LAST WORD ADDRESS OF REGULAR *TLD*
          SB6    X1+B1
          SA1    B6
 STLD9    ZR     X1,STLD13   IF END OF LIST
          BX1    X7*X1
          IX1    X1-X2       COMPARE TASK NAMES
          ZR     X1,STLD10   IF TASK FOUND
          SA1    A1+TLDLE
          EQ     STLD9       CONTINUE SEARCH
 
*         TASK FOUND
 
 STLD10   SA3    VTLD        GET TASK BIAS
          LX3    -24
          SB6    X3-1
          SX7    A1-B6
          SA3    A1+2
          LX3    59-55       LEFT JUSTIFY ON/OFF FLAG
          NG     X3,STLD12   IF TASK TURNED OFF
          LX3    59-54-59+55 LEFT JUSTIFY DELETE FLAG
          NG     X3,STLD13   IF TASK DELETED
          SA3    STLDB+1     TASK LIST ACCUMULATOR
          LX7    48
          BX6    X3+X7
          EQ     STLD        *RETURN
 
 STLD11   SB5    A1+TLDLE
          LE     B5,B6,STLD5 IF NOT DONE SEARCHING
          EQ     STLD7       NO TASK WITH REQUESTED NAME FOUND
 
*         CALL A DEFAULT TASK IN PLACE OF TURNED OFF TASK
 
 STLD12   SA1    STLDA       DEFAULT TASK NAME
          BX3    X1-X2       CHECK FOR DEFAULT TASK NAME
          BX2    X1
          ZR     X3,STLD14   IF DEFAULT TASK NOT FOUND
          SA3    STLDB
          ZR     X3,STLD3    IF SEARCH SYSTEM *TLD* FOR DEFAULT TASK
          SB6    X3-TLDLE+1
          LX3    -18
          SB5    X3
          EQ     STLD4       SEARCH *DBTASKL* FOR DEFAULT TASK
 
*         TASK   MATCH NOT FOUND
 
 STLD13   SA1    STLDB       IF *DBTASKL* PRESENT
          BX6    X6-X6
          SA6    A1
          ZR     X1,STLD12   IF TASK NOT FOUND
          EQ     STLD3       NOW SEARCH SYSTEM *TLD* FOR DESIRED TASK
 
*         DEFAULT TASK NOT AVAILABLE.
 
 STLD14   MESSAGE  STLDC,0,R * OFFTASK OFF OR UNDEFINED.*
          ABORT              ERROR ABORT
 
 STLDA    VFD    42/0LOFFTASK,18/0     TASK TO PROCESS TURNED OFF TASKS
 STLDB    BSS    1           DATA BASE FLAG
          BSS    1           TASK LIST ACCUMULATOR
 STLDC    DATA   C* OFFTASK OFF OR UNDEFINED.*
 ATT      SPACE  4,10
          TITLE  INITIALIZE DATA MANAGER FILES.
 ATT      SPACE  4,30
**        ATT -  ATTACH POOL, TRACE, AND JOURNAL FILES.
*
*         THIS ROUTINE FIRST CHECKS IF A POOL, TRACE OR JOURNAL
*         FILE IS LOCAL TO THE CONTROL POINT.  IF NOT, AN *ATTACH*
*         IS ATTEMPTED ON THE FILE IN THE MODE SPECIFIED.  AN
*         EXCEPTION TO THIS IS A DISK FILE ASSOCIATED WITH TAPE
*         JOURNALIZING, WHICH IS ATTACHED IN *WRITE* MODE.  IF THE
*         FILE CANNOT BE FOUND, A DIRECT ACCESS PERMANENT FILE IS
*         CREATED IN *WRITE* MODE AND LEFT ATTACHED TO THE
*         CONTROL POINT.
*
*         ENTRY  (B4) = ADDRESS OF CURRENT FET.
*                (X6) = 0 IF ATTACH MODE IS MODIFY.
*                     = 1 IF ATTACH MODE IS WRITE.
*                     = 2 IF ATTACH DISK JOURNAL FILE ASSOCIATED
*                         WITH TAPE JOURNAL.
*                     = .LT. 0 IF TAPE JOURNAL FILE.
*                (X0) = NAME OF TAPE JOURNAL FILE IF (X6) IS .LT. 0
*                (X0) = NAME OF TAPE JOURNAL FILE IF (X6) IS NEGATIVE
*                       OR = 2.
*
*         EXIT   (X2) .NE. 0 IF FILE ALREADY ATTACHED.
*                TO *DIE12* IF ATTACH ERRORS.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 1, 2, 3, 6.
*                B - 3, 5.
*
*         MACROS ATTACH, DEFINE, SKIPEI, STATUS.
 
 
 ATT      SUBR               ENTRY/EXIT
          SA6    ATTB        SAVE ATTACH MODE FLAG
          STATUS B4
          SA1    B4
          MX6    11
          LX1    59-11
          BX6    X6*X1       CHECK IF FILE EXISTS
          SA6    ATTC
          RJ     CER         CLEAR ERROR STATUS BITS
          NZ     X6,ATT3     IF FILE ALREADY AT CONTROL POINT
 ATT1     SA3    ATTB        ATTACH MODE
          NZ     X3,ATT4     IF ATTACH MODE IS WRITE
          ATTACH B4,,,,M
 ATT2     RJ     CER         CHECK ERROR STATUS
          SB3    X1-2        TEST FOR FILE NOT FOUND
          NZ     X1,ATT6     IF ERROR ON ATTACH
 ATT3     SKIPEI B4,R
          SA2    ATTC        ATTACH FLAG
          EQ     ATTX        RETURN
 
 ATT4     SA2    B4
          MX4    42
          SB5    X3-2
          BX1    X4*X2
          NZ     B5,ATT5     IF NOT TAPE/DISK JOURNAL FILE PROCESSING
          BX1    X4*X0
 ATT5     ATTACH B4,X1,,,W
          EQ     ATT2        CHECK FOR ERRORS
 
 ATT6     NZ     B3,DIE12    IF FILE NOT FOUND
          SA3    ATTB
          SA2    B4
          MX4    42
          SB5    X3-2
          BX1    X4*X2       PERMANENT FILE NAME
          NZ     B5,ATT7     IF NOT TAPE/DISK JOURNAL FILE PROCESSING
          BX1    X4*X0
 ATT7     DEFINE B4,X1,,,ATTA
          EQ     ATT2        CHECK FOR ERRORS
 
 ATTA     VFD    48/0,12/0L"DTYM"     DEFAULT DEVICE TYPE
 ATTB     CON    0           FLAG FOR ATTACH MODE
 ATTC     CON    0           FILE ALREADY AT CONTROL POINT FLAG
 CER      SPACE  4,15
**        CER -  CHECK ERROR STATUS.
*
*         THIS ROUTINE EXAMINES THE ERROR STATUS IN THE FET.
*         IT THEN CLEARS THE STATUS IN THE FET AND RETURNS.
*
*         ENTRY  (X2) = FET FWA.
*
*         EXIT   (X1) = STATUS.
*
*         USES   A - 1, 7.
*                X - 1, 7.
 
 
 CER      SUBR               ENTRY/EXIT
          MX7    42
          SA1    X2
          MX3    -8
          BX7    X7*X1
          AX1    10
          BX1    -X3*X1      ERROR STATUS BITS
          SX3    B1
          IX7    X7+X3
          SA7    A1          CLEAR ERROR STATUS IN FET
          EQ     CERX        RETURN
 RBL      SPACE  4,20
***       RBL - REPORT BFL INFORMATION.
*
*         ENTRY  (X6) = EXIT CONDITION.
*                (VCMM) = 6/0, 18/TFL, 18/EFL, 18/BFL.
*                (B2) = BFL-(FSTT+FIT+CMMCAP).
*
*         EXIT   MESSAGE ISSUED TO TAF-S DAYFILE STATING BFL
*                INFORMATION.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
*                B - 2, 3, 4, 5.
*
*         CALLS   COD, SNM.
*
*         MACROS   MESSAGE.
 
 RBL      SUBR                ENTRY/EXIT
          SA1    VCMM        GET BFL
          SB4    -B2
          SX1    X1+B4
          RJ     COD         CONVERT OCTAL TO DISPLAY
          MX0    1
          SB3    B2-B1
          AX0    B3
          BX1    X0*X4
          SB2    1RX         REPLACEMENT CHARACTER
          SB5    RBLA        MESSAGE ADDRESS
          RJ     SNM         SET NAME IN MESSAGE
          SA1    VCMM
          SX1    X1+
          RJ     COD         CONVERT OCTAL TO DISPLAY
          MX0    1
          SB3    B2-B1
          AX0    B3
          BX1    X0*X4
          SB2    1RZ         REPLACEMENT CHARACTER
          SB5    RBLA        MESSAGE ADDRESS
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  RBLA,3    ISSUE DAYFILE MESSAGE
          EQ     RBLX        EXIT
 
 
 RBLA     DATA   C* BFL = ZZZZZZB, MINIMUM REQUIRED = XXXXXXB.*
 SFD      SPACE  4
**        SFD - SET FAMILY TO DEFAULT.
*
*         EXIT   DEFAULT FAMILY SET.
*
*         USES   X - 6.
*                A - 6.
*
*         MACROS SETPFP.
 
 
 
 SFD      SUBR               ENTRY/EXIT
          SX6    10B         *SETPFP* FLAGS
          SA6    STIA        *SETPFP* CALL BLOCK
          SETPFP STIA        SET DEFAULT FAMILY
          EQ     SFDX        RETURN
 STI      SPACE  4,15
**        STI - SET TAF INDEX.
*
*         ENTRY  (VUSN) = TAF USER NAME.
*                (VFMN) = TAF FAMILY NAME.
*                TRUI = TAF USER INDEX.
*
*         EXIT   TAF USER VALIDATIONS SET.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
*
*         MACROS SETPFP.
 
 
 STI      SUBR               ENTRY/EXIT
          SA1    VUSN        TAF USER NAME
          SX6    TRUI        TAF USER INDEX
          MX0    42
          BX6    X1+X6
          SA6    STIA+2
          SA1    VFMN        TAF FAMILY NAME
          SX2    13B         FLAG SETUP FOR *SETPFP*
          BX6    X0*X1
          BX6    X2+X6
          SA6    STIA
          SETPFP STIA
          EQ     STIX        RETURN
 
 
*         CALL BLOCK FOR *SETPFP*.
 
 
 STIA     CON    0           42/ FAMILY NAME, 14/ , 4/ FLAGS
          CON    0           42/ PACK NAME, 18/ PACK TYPE
          CON    0           42/ USER NAME, 18/ USER INDEX
 UPK      SPACE  4,15
**        UPK -  UNPACK AUXILIARY DEVICE INFORMATION FROM *XXJ* FILE.
*
*         ENTRY  (B4) - ARGUMENT COUNT.
*                (B5) - ARGUMENT TABLE.
*                (B7) - LOW CORE AREA USED FOR UNPACKING.
*
*         EXIT   (DEV) - 42/PACKNAME,12/DEVICE TYPE,6/UNIT.
*                (X6) = (DEV)
*
*         USES   A - 1, 3, 4, 6.
*                X - 1, 3, 4, 6, 7.
*                X - 1, 3, 4, 6, 7.
*
*         CALLS  ARG.
 
 
 UPK      SUBR               ENTRY/EXIT
          SA4    B7+B1       FIRST ARGUMENT TO PROCESS
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,DIE11    IF ARGUMENT ERROR
          SA3    DEV
          NZ     X3,UPK2     IF DEVICE TYPE SPECIFIED
          SA1    ATTA        DEFAULT DEVICE TYPE
          BX3    X1
 UPK1     SA1    PAC         PACKNAME
          LX3    6
          BX6    X3+X1
          SA6    A3
          EQ     UPKX        RETURN
 
 UPK2     LX3    12
          MX4    6
          SX1    1R0
          LX1    -6
          BX7    X4*X3       NUMBER OF UNITS
          IX1    X7-X1       UNIT NUMBER
          ZR     X7,UPK1     IF NO UNIT SPECIFIED
          SX6    X3          DEVICE TYPE
          IX3    X1+X6
          EQ     UPK1        SET PACKNAME
 VUN      SPACE  4,20
**        VUN - VALIDATE USER NAME.
*
*         VALIDATE USER NAME SO THAT *TAF* MAY EXECUTE IN A
*         MULTI-FAMILY ENVIRONMENT.  USE OF INCORRECT USER NAMES OR
*         USER NAMES NOT VALID FOR A GIVEN FAMILY MAY RESULT IN
*         *TAF*-S ABORTING WHILE SUBMITTING A TASK DUMP FOR *BATCH*
*         PROCESSING.
*
*         ENTRY  (XXJD - XXJD+5) = USER NAME, PASSWORD AND FAMILY NAME.
*
*         EXIT   (XXJD - XXJD+5) IS VALIDATED.
*                (X6) = UI - IF VALID USER NAME.
*                (X6) = 0 - IF INCORRECT USER NAME ON SPECIFIED FAMILY.
*
*         USES   A - 1.
*                X - 1, 6.
*
*         MACROS SYSTEM.
 
 
 VUN      SUBR               ENTRY/EXIT
          SYSTEM CPM,R,XXJD,56B*100B
          SA1    XXJD+2      GET USER INDEX
          SX6    X1+
          EQ     VUNX        RETURN
 XXJ      SPACE  4,10
**        XXJ - INITIALIZE *XXJ* FILES.  (XX=DATA BASE)
*
*         THIS ROUTINE GETS THE *XXJ* FILES (XX=DATA BASE) FROM *TAF*-S
*         USER INDEX FOR EACH DATA BASE SPECIFIED IN THE *TCF* FILE.
*         INFORMATION FORM THE STATEMENTS IN THE *XXJ* FILES IS
*         PROCESSED AND PLACED INTO AN *EDT* FOR THE DATA BASE.
*
*         AN *INITL* CALL TO *TOTAL* IS GENERATED FOR EACH *TOTAL*
*         DATA BASE.
*
*         THE FORMAT OF THE *XXJ* FILE FOR A *CRM* DATA BASE IS -
*
*                XXJ
*                USER,USERN,PASSWD,FAMILY.  (*USER* OR *ACCOUNT*)
*                BRF,N.
*                XXJOR1,DT,F.
*                XXJOR2,DT,F.
*                XXJOR3,DT,F.
*                XXTASKL,PN=PACKNAM,R=DEV.  (OPTIONAL).
*                CRM(XXPF,TY,MODE,USERS,LOCKS,MRL,KL,HASH,
*                    REC,FWI,PACKNAM,DEV)
*                (FOLLOWING ONLY FOR MIP FILES)
*                IXN(XXPF,NKY,PACKNAM,DEV)
*                AKY(KN,KO,KL)   (ONE PER ALTERNATE KEY)
*                RMKDEF(XXPF,RKW,RKP,KL,O,KF,KS,KG,KC,NL,IE,CH)
*                            (ONE PER ALTERNATE KEY)
*
*         THE FORMAT OF THE *XXJ* FILE FOR A *TOTAL* DATA BASE IS -
*
*                XXJ
*                THE NEXT STATEMENT IS *ACCOUNT* OR *USER* IN THE FORM
*                ACCOUNT,USERN,PASSWD,FAMILY.  OR
*                USER,USERN,PASSWD,FAMILY.
*                XXJOR1,DT,F.
*                XXJOR2,DT,F.
*                XXJOR3,DT,F.
*                XXTASKL,PN=PACKNAM,R=DEV.  (OPTIONAL)
*                NL -OR- LG -OR- AI -OR- BA -OR- UL
*                   -OR- LG,PN=PACKNAM,R=DEV.
*                   -OR- AI,PN=PACKNAM,R=DEV.
*                   -OR- BA,PN=PACKNAM,R=DEV.
*                   -OR- UL,PN=PACKNAM,R=DEV.
*                AAAA. -OR- AAAA,PN=PACKNAM,R=DEV.
*                ...
*                ...
*                ZZZZ. -OR- ZZZZ,PN=PACKNAM,R=DEV.
*
*                WHERE XX = DATA BASE NAME.
*                      USERN = USER NAME.
*                      PASSWD = BATCH PASSWORD.
*                      FAMILY = DESIRED FAMILY.  (IF OMITTED,
*                               DEFAULT FAMILY IS USED.)
*                N = NO. OF BRF FILES FOR THIS D.B. (N IS OPTIONAL).
*                            PACKNAM = PACK NAME OF AUXILIARY DEVICE ON
*                                      WHICH XXTASKL MAY RESIDE.
*                            DEV     = DEVICE TYPE THE FILE WILL BE
*                                      RESIDENT ON (DI,MD,...).
*                            DT      = MT (SEVEN TRACK TAPE).
*                                      MS (MASS STORAGE).
*                                      NT (NINE TRACK TAPE).
*                            F  = B (BLOCKED)
*                                 R (RECORD)
*                NL = NO LOGGING FOR TOTAL DATA BASE.
*                LG = BEFORE IMAGE LOGGING (LOG RECORD IMAGE BEFORE
*                     UPDATING).
*                AI = AFTER IMAGE LOGGING (LOG RECORD IMAGE AFTER
*                     UPDATING).
*                BA = BEFORE AND AFTER IMAGE LOGGING.
*                UL = USER LOGGING (USER SUPPLIES ROUTINE *TUSRLG*).
*                AAAA = FOUR CHARACTER DATA BASE FILE NAME FOR TOTAL.
*
*                XXPF = PERMANENT FILE NAME FOR *CRM*.
*                (DATA FILE ON *CRM* OR INDEX FILE ON *IXN* STATEMENT).
*                TY = FILE TYPE, *IS* FOR INDEX SEQUENTIAL
*                                OR *DA* FOR DIRECT ACCESS
*                                OR *AK* FOR ACTUAL KEY.
*                MODE = ATTACH MODE FOR FILE.
*                USER = NUMBER OF USERS THAT MAY OPEN FILE
*                       CONCURRENTLY.
*                LOCKS = NUMBER OF RECORDS THAT MAY BE LOCKED
*                        CONCURRENTLY.
*                MRL = MAXIMUM RECORD LENGTH IN CHARACTERS.
*                KL = KEY LENGTH IN CHARACTERS.
*                HASH = INDIRECT FILE NAME FOR HASHING ROUTINE.
*                REC - FILE RECOVERABILITY INDICATOR.
*                    = R, FILE IS TO BE RECOVERED.
*                    = N, FILE IS NOT TO BE RECOVERED.
*                FWI - CRM FILE FORCED WRITE INDICATOR.
*                    = Y, WRITE IN FORCED MODE.
*                    = N, NON-FORCED WRITE MODE.
*                NKY = NUMBER OF ALTERNATE KEYS.
*                KN = ALTERNATE KEY NUMBER (STARTING FROM 1).
*                KO = ALTERNATE KEY OFFSET (STARTING FROM 1).  THIS IS
*                     THE BEGINNING CHARACTER POSITION OF THE KEY.
*                RKW = RELATIVE WORD IN THE RECORD IN WHICH THE
*                      ALTERNATE KEY BEGINS, COUNTING FROM 0.
*                RKP = RELATIVE BEGINNING CHARACTER POSITION.
*                0 = REQUIRED TO MARK POSITION FOR RESERVED FIELD.
*                KF = KEY FORMAT,
*                     0 OR S - SYMBOLIC.
*                     1 OR I - INTEGER.
*                     2 OR U - UNCOLLATED SYMBOLIC.
*                     3 OR P - PURGE ALTERNATE KEY FROM INDEX.
*                KS = SUBSTRUCTURE FOR EACH PRIMARY KEY LIST IN
*                     THE INDEX; (OPTIONAL)
*                     U - UNIQUE (DEFAULT).
*                     I - INDEXED SEQUENTIAL.
*                     F - FIRST-IN  FIRST-OUT.
*                KG = LENGTH IN CHARACTERS OF THE REPEATING GROUP
*                     IN WHICH THE KEY RESIDES.
*                KC = NUMBER OF OCCURRENCES OF THE REPEATING GROUP.
*                NL = NULL SUPPRESSION; A NULL VALUE IS ALL SPACES
*                     (SYMBOLIC KEY) OR ALL ZEROS (INTEGER KEY):
*                     0 - NULL VALUES ARE INDEXED (DEFAULT).
*                     N - NULL VALUES ARE NOT INDEXED.
*                IE = INCLUDE/EXCLUDE SPARCE CONTROL CHARACTER:
*                     I - INCLUDE SPARCE CONTROL CHARACTER.
*                     E - EXCLUDE SPARSE CONTROL CHARACTER.
*                CH = CHARACTERS THAT QUALIFY AS SPARCE CONTROL
*                     CHARACTERS.
*         NOTE - *XXJORN* FILES ARE DEFINED SEQUENTIALLY, THAT IS
*                XXJOR3 IMPLIES A PREVIOUS DEFINITION FOR XXJOR2 AND
*                XXJOR1.
*                WHEN THE PN= OR R= PARAMETER IS USED ON A STATEMENT,
*                ONE OR BOTH MAYBE USED.
*
*         ENTRY  (B4) = ADDRESS OF FET.
*                (X5) = DATA BASE NAME.
*                (X5) = ZERO, IF NOT INITIAL CALL.
*
*         EXIT   (B4) = ADDRESS OF FET.
*                TO *DIE6* IF NO *USER* OR *ACCOUNT* STATEMENT IN *XXJ*
*                          FILE.
*                TO *DIE8* IF JOURNAL FILE LIMIT EXCEEDED.
*                TO *DIE9* IF NO HEADER ON *XXJ* FILE.
*                TO *DIE10* IF INCORRECT DATA BASE NAME IN FILE.
*                TO *DIE11* IF ERROR ON *XXJ* FILE ARGUMENTS.
*                TO *DIE13* IF JOURNAL FILE TYPE DOES NOT MATCH *XXJ*
*                           FILE.
*                TO *DIE21* IF TOO MANY FILES IN DATA BASE.
*                TO *DIE26* IF OVERFLOW OCCURRED DURING INITIALIZATION.
*                TO *DIE27* IF INCORRECT USER.
*                TO *DIE46* IF NO *AKY* STATEMENT PRESENT FOR MIP-FILE.
*                TO *DIE51* IF INCORRECT *BRF* PARAMETER.
*                TO *DIE52* IF NO *BRF* STATEMENT AT ALL.
*                TO *DIE40* IF *CRM* D.M. IS NOT LOADED AND
*                     *CRM* D.M. RELATED STATEMENT IS SPECIFIED.
*                TO *DIE42* IF *TOTAL* D.M. IS NOT LOADED AND
*                     *TOTAL* D.M. RELATED STATEMENT IS SPECIFIED.
*                INITIALIZATION ALSO ABORTED IF *XXJ* FILE NOT FOUND.
*
*         USES   X - ALL.
*                A - ALL.
*                B - ALL.
*
*         CALLS  ACL, ARG, ATT, CRM, RMK, =TOTAL, UPC, UPK, VUN, ZFN.
*
*         MACROS ABORT, GET, MESSAGE, READ, READC, REWIND,
*         RECALL, SETUI, WRITER.
 
 
 XXJ30    SA1    INTD
          SA2    XXJE        NUMBER OF JOURNAL FILES
          SA3    X1+B1       SECOND WORD OF EDT HEADER
          SB4    A0
          LX2    54
          SA5    X1          FIRST WORD OF EDT HEADER
          SX7    B4
          SA7    CCP         UPDATE PLACE TO READ IN NEXT EDT
          BX6    X3+X2
          BX7    X7+X5
          SA6    A3+
          SA7    A5          UPDATE LINK WORD IN EDT HEADER
 
 XXJ      SUBR   0           ENTRY/EXIT
          ZR     X5,XXJ6     IF NOT FIRST CALL FOR THIS DATA BASE
          SX1    1RJ
          BX6    X5          DATA BASE NAME
          LX1    -18
          SA6    TTIP+TIDB
          SX7    B4+         NEXT AVAILABLE MEMORY LOCATION
          SA7    TTIP+TIAM
          SX6    B1+
          IX5    X5+X1       XXJ (WHERE XX=DATA BASE NAME)
          BX7    X5+X6
          SA7    TL          XXJ NAME TO FET
          LX6    44          ERROR PROCESSING BIT
          SA1    A7+B1
          BX6    X6+X1
          SA6    A1
          RJ     STI         SET TAF INDEX
          RJ     SFD         SET FAMILY TO DEFAULT
          GET    TL          GET XXJ FILE
          SA5    TL
          BX4    X5
          MX2    8           CHECK FOR ATTACH ERROR
          LX4    59-17
          BX4    X2*X4
          SA0    B4
          SB5    B0
          NZ     X4,XXJ15    IF XXJ FILE NOT FOUND - ABORT
          MX3    42
          BX5    X3*X5
 
*         PROCESS *XXJ* HEADER.
 
          READ   TL
          READC  TL,XXJA,8   READ FIRST STATEMENT ON XXJ FILE
          SA1    XXJA
          RJ     ZFN         ZERO FILL NAME
          BX7    X1-X5
          NZ     X7,DIE9     IF HEADER WORD DOES NOT MATCH
 
*         PROCESS THE *ACCOUNT* OR *USER* STATEMENT.
 
 XXJ1     READC  TL,XXJA,8
          SB7    XXJP        FWA TO UNPACK STATEMENT
          SA5    XXJA        FIRST WORD TO UNPACK
          SA4    B4+         SAVE (B4)
          RJ     UPC
          MX3    42
          SB4    A4          RESTORE (B4) IN CASE OF AN ERROR
          SA1    B7
          BX1    X3*X1       CHECK FOR ACCOUNT NUMBER
          SA2    XXJB
          SA5    XXJO        *USER* STATEMENT
          BX2    X1-X2
          BX5    X1-X5
          SA3    B7+1        ACCOUNT NUMBER
          ZR     X2,XXJ2     IF *ACCOUNT* STATEMENT FOUND
          NZ     X5,DIE6     IF NO *USER* STATEMENT FOUND
 XXJ2     BX6    X3
          SA6    XXJD+2      USER NAME
          SA3    A3+B1       PASSWORD
          MX1    1           VALIDATE BATCH PASSWORD
          LX1    2-59
          BX7    X3+X1
          SA3    A3+B1       POSSIBLE FAMILY
          SA7    XXJD+1      PASSWORD
          SA5    INITQ       SET DEFAULT FAMILY
          BX7    X3
          NZ     X3,XXJ3     IF NOT DEFAULT FAMILY
          BX7    X5
 XXJ3     SA7    XXJD        FAMILY
          SA7    XXJR        SAVE USER FAMILY
          SX7    B0+         CLEAR DEVICE TYPE
          SA7    DTP
          RJ     VUN         VALIDATE USER NAME
          ZR     X6,DIE27    IF INCORRECT USER
          SA1    XXJD+2      USER NAME
          MX0    42
          BX6    X1+X6
          SA6    STIA+2
          SA1    XXJD        FAMILY NAME
          SX2    13B         FLAG SETTING FOR *SETPFP*
          BX6    X0*X1
          BX6    X2+X6
          SA6    STIA
          SETPFP STIA        SET PERMANENT FILE PARAMETERS
          SA1    STIA
          LX1    59-12
          SX7    B0
          NG     X1,DIE27    IF ERROR
          SA7    XXJA        CLEAR INPUT FOR NEXT READ
          READC  TL,XXJA,8
          SA5    XXJA
          NZ     X1,XXJX     IF NO MORE ENTRIES
 XXJ5     SX7    B0+
          SA7    DEV         CLEAR DEVICE TYPE FOR SUBSEQUENT USE
          SA7    PAC
          SA7    XXJQ        NO *BRF PASSED* FLAG
 
*         CHECK FOR *BRF* STATEMENT.
 
          SB7    XXJP
          RJ     UPC         UNPACK CONTROL STATEMENT
          SX2    3RBRF
          SA5    B7
          LX2    -18
          BX2    X5-X2
          NZ     X2,XXJX     IF NO *BRF* STATEMENT - EXIT
 
*         PROCESS *BRF* STATEMENT.
 
          BX7    X7-X7
          SA7    TTIP+TIQN
          SA7    XXJA        READ NEEDED FLAG
          SA5    B7+B1       NO. OF *BRF-S* TO USE FOR THIS D.B.
          SX7    B1
          SA7    XXJQ        *BRF PASSED* FLAG
          RJ     DXB
          NZ     X4,DIE51    IF NON-NUMERIC *BRF* PARAMETER
          NZ     X6,XXJ5.1   IF *BRF* SPECIFICATIONS NONTRIVIAL
          SB6    B6-3
          PL     B6,DIE51    IF TOO MANY OR INCORRECT PARAMETER(S)
 XXJ5.1   SX5    X6-BMAX-1
          PL     X5,DIE51    IF TOO MANY *BRF-S*
          SA6    TTIP+TIQN
          SB5    8
          SB2    TTIP
          SA1    CDBID
          NG     X1,DIE40    IF *CRM* IS NOT LOADED
          RJ     CRM
          SA4    TTIP+TIAM
          SB4    X4+         NEXT AVAILABLE MEMORY LOCATION
          EQ     XXJX        RETURN
 
 XXJ6     SA1    INTD
          SA5    XXJD+2      USER NAME
          SX4    B4          ADDRESS OF FIRST XXJORN FET
          SA2    X1+B1       SECOND WORD OF EDT HEADER
          LX4    18
          BX6    X4+X2
          BX7    X5
          SA5    XXJD+1      PASSWORD
          SA6    A2
          BX6    X5          PASSWORD
          SA7    A2+B1       EDT HEADER + 2
          SA6    A7+B1       EDT HEADER + 3
          SA2    XXJD        FAMILY NAME
          BX7    X2
          SA7    A7+4        EDT HEADER+4
 
*         INITIALIZE JOURNAL FILES.
 
          BX7    X7-X7
          SA0    B4
          SX6    A6+1        ADDRESS OF *EDT* HEADER+4
          SA7    XXJE        INITIALIZE JOURNAL FILE COUNT
          SA2    XXJA
          BX1    X1-X1       FLAG FOR MORE PROCESSING
          SA6    A5-B1       SAVE ADDRESS FOR PACK NAME PARAMETER
          NZ     X2,XXJ8     IF INFORMATION ALREADY PRESENT
 XXJ7     READC  TL,XXJA,8   READ STATEMENT IMAGE FROM *XXJ* FILE
          NZ     X1,XXJ30    IF NO MORE ENTRIES
 XXJ8     SB7    XXJP
          MX0    18
          SA5    XXJA
          BX6    X5
          LX6    12
          SX3    3RCRM
          LX3    59-17
          BX3    X3-X5
          BX3    X0*X3
          NZ     X3,XXJ9     IF NOT *CRM* STATEMENT
          SA1    XXJQ
          ZR     X1,DIE52    IF *CRM* STATEMENT WITHOUT PRECEDING *BRF*
          SB5    B0
          SA1    CDBID       CHECK IF *CRM* DATA MANAGER IS LOADED
          NG     X1,DIE40    IF *CRM* IS NOT LOADED
          RJ     CRM         PROCESS *CRM* STATEMENT
          READC  TL,XXJA,8   READ STATEMENT FROM *XXJ* FILE
          SB7    XXJP        FWA FOR UNPACK
          ZR     X1,XXJ8.1   IF MORE STATEMENTS
          SX7    A0+         FWA OF AVAILABLE MEMORY
          SB5    4
          SA7    TTIP+TIAM
          SB2    TTIP
          RJ     CRM         ALLOCATE FILE CONTROL ENTRIES
          EQ     XXJ30       NO MORE ENTRIES
 
 XXJ8.1   MX0    18
          SA5    XXJA
          SX3    3RIXN
          LX3    59-17
          BX3    X3-X5
          BX3    X0*X3
          ZR     X3,XXJ8.2   IF *IXN* STATEMENT
          SX7    A0          FWA OF AVAILABLE MEMORY
          SB5    4
          SA7    TTIP+TIAM
          SB2    TTIP
          RJ     CRM         ALLOCATE FILE CONTROL ENTRIES
          EQ     XXJ8        PROCESS STATEMENT
 
 XXJ8.2   RJ     IXN         PROCESS *IXN* STATEMENT
 XXJ8.3   READC  TL,XXJA,8   READ STATEMENT FROM *XXJ* FILE
          SB7    XXJP        FWA FOR UNPACK
          NZ     X1,DIE46    IF NO *AKY* STATEMENT
          SX3    3RAKY
          SA5    XXJA
          LX3    59-17
          MX0    18
          BX3    X3-X5
          BX3    X0*X3
          NZ     X3,DIE46    IF NOT *AKY* STATEMENT
          RJ     AKY         PROCESS *AKY* STATEMENT
          SA5    TTIP+TINK
          NZ     X5,XXJ8.3   IF MORE *AKY* STATEMENTS EXPECTED
          RJ     RMK         PROCESS *RMKDEF* STATEMENTS
          NZ     X1,XXJ30    IF NO MORE ENTRIES
          EQ     XXJ8        PROCESS NEXT STATEMENT
 
 XXJ9     SA6    TLF         SET *TOTAL* LOG FLAG
          SX7    X6-2RLG
          ZR     X7,XXJ17    IF LOGGING REQUESTED FOR TOTAL
          SX7    X6-2RBA
          ZR     X7,XXJ17    IF BEFORE AND AFTER IMAGE LOGGING
          SX7    X6-2RAI
          ZR     X7,XXJ17    IF AFTER IMAGE LOGGING
          SX7    X6-2RNL
          ZR     X7,XXJ19    IF NO LOGGING REQUESTED FOR TOTAL
          BX6    X5
          MX0    18
          BX6    X0*X6
          LX6    18
          SX7    X6-3RLG,
          ZR     X7,XXJ18    IF LOGGING REQUESTED FOR TOTAL
          SX7    X6-3RAI,
          ZR     X7,XXJ18    IF AFTER IMAGE LOGGING
          SX7    X6-3RBA,
          ZR     X7,XXJ18    IF BEFORE AND AFTER IMAGE LOGGING
          SX7    X6-3RNL.
          ZR     X7,XXJ19    IF NO LOGGING REQUESTED FOR TOTAL
 
*         PROCESS *XXJOR* STATEMENT.
 
          RJ     UPC         UNPACK PARAMETERS FROM STATEMENT
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
          SA1    TL
          SA2    B7          DATA BASE NAME
          MX6    12
          BX1    X6*X1
          BX3    X6*X2
          BX3    X3-X1
          SA4    XXJH
          BX2    -X6*X2
          BX1    X4-X2
          BX0    X1
          AX0    30
          NZ     X0,XXJ16    IF NOT *XXJOR*
          NZ     X3,DIE10    IF INCORRECT DATA BASE NAME
          SX3    1R0
          LX1    -24
          IX3    X1-X3
          SB2    B7+         FWA OF ARGUMENTS
          SA1    XXJE        CHECK NUMERIC FIELD IN FILE NAME
          SX7    B1
          IX7    X7+X1       BUMP JOURNAL FILE COUNT
          IX1    X3-X7
          SB4    B6-B1       ARGUMENT COUNT
          NZ     X1,DIE11    IF ERROR IN JOURNAL FILE NAME
          SA7    A1
          SA4    B2+B1       FIRST ARGUMENT
          SX7    X7-4
          PL     X7,DIE8     IF JOURNAL FILE LIMIT EXCEEDED
          SB5    XXJF        ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,DIE11    IF ARGUMENT ERROR
          SA1    TYP
          SX5    0
          ZR     X1,XXJ10    IF MS
          SX2    X1-1
          ZR     X2,XXJ10    IF MT
          SX1    1
          SX5    B1          SET NT FLAG
          LX5    56
 XXJ10    SA2    BNS
          LX1    59
          BX6    X2+X1       TAPE/DISK AND BUFFERED/NON BUFFERED STATUS
          SA6    A0+7
          SX4    B1+         ERROR PROCESSING
          ZR     X1,XXJ11    IF NOT A TAPE FILE
          SX4    3           ERROR AND USER PROCESSING
 XXJ11    SX6    DBBF
          SX2    JFETL-5     FET LENGTH VALUE
          LX4    44
          LX2    18
          BX2    X2+X4
          BX7    X6+X2
          SA7    A0+B1       FIRST
          SA6    A7+B1       IN
          SA6    A6+B1       OUT
          SA1    B7          FILE NAME
          SX7    DBBF+DBBFL
          SA7    A6+B1       LIMIT
          SX6    B1
          BX6    X1+X6       FILE NAME
          SA6    A0
          BX6    X6-X6
          SB4    A0          FET ADDRESS
          SB5    A0+8
          SB6    A0+13
+         SA6    B5          ZERO OUT FET AREA
          SB5    B5+B1
          NE     B5,B6,*     LOOP
          SB5    B4-IFL=
          PL     B5,DIE26    IF OVERFLOW DURING INITIALIZATION
          SA1    B4+7
          PL     X1,XXJ13    IF NOT A TAPE FILE
          MX6    1           ATTACH MODE FLAG
          RJ     ATT         ATTACH JOURNAL FILE
          ZR     X2,XXJ14    IF FILE NOT PREVIOUSLY ATTACHED
          SA1    B4+B1
          MX6    12
          BX1    X6*X1
          LX1    12
          SX2    X1-2RMT-4000B  DEVICE TYPE MT (UPPER BIT SET)
          ZR     X5,XXJ12    IF CHECK FOR 7 TRACK TAPE
          SX2    X1-2RNT-4000B  DEVICE TYPE NT (UPPER BIT SET)
 XXJ12    NZ     X2,DIE13    IF JOURNAL FILE TYPE DOES NOT MATCH
          SA3    B4
          MX6    36
          SX2    100B+1RT
          BX6    X6*X3
          LX2    -6
          LX6    -6
          BX0    X3          SAVE NAME OF TAPE JOURNAL FILE
          IX7    X2+X6
          SA0    B4          SAVE (B4)
          SA7    DISK        RENAME TAPE JOURNAL FILE (TXXJORN)
          SX6    B1+B1       FLAG FOR TAPE JOURNAL FILE PROCESSING
          SB4    A7
          RJ     ATT         ATTACH DISK JOURNAL ASSOCIATED WITH TAPE
          SB4    A0+         RESTORE ORIGINAL TAPE JOURNAL POINTER
          REWIND DISK
          WRITER X2
          EQ     XXJ14       CONTINUE PROCESSING
 
 XXJ13    BX6    X6-X6       ATTACH MODE FLAG
          RJ     ATT         ATTACH FILE IN MODIFY MODE
          SA1    B4+B1
          NG     X1,DIE13    IF JOURNAL FILE TYPE NOT DISK
 XXJ14    BX6    X5
          SA6    A0+8        MT/NT FLAG
          SX7    B0
          SA7    A6+B1
          SB4    B4+JFETL
          SA0    B4
          EQ     XXJ7        LOOP
 
 XXJ15    SA1    MSGQ
          MX2    18
          BX6    X2*X5       XXJ FILE NAME
          LX2    -6
          LX6    -6
          BX2    -X2*X1
          BX6    X2+X6       MERGE FILE NAME INTO MESSAGE
          SA6    A1
          MESSAGE  MSGQ,0,R  * XXJ FILE NOT FOUND.*
          ABORT              ABORT
 
*         PROCESS *XXTASKL* STATEMENT.
 
 XXJ16    SA4    XXJI
          IX6    X2-X4
          LX6    -24
          NZ     X6,DIE11    IF INCORRECT ENTRY
          NZ     X3,DIE10    IF INCORRECT DATA BASE NAME
          SB5    XXJJ        LIST FOR ARG
          RJ     UPK         UNPACK PARAMETERS
          SA3    DEV         DEVICE TYPE
          SA5    INTD        FWA OF EDT HEADER
          BX7    X7-X7
          BX6    X3
          SA6    X5+5        UPDATE EDT HEADER + 5
          SA7    A3          CLEAR DEVICE TYPE
          SA7    PAC         CLEAR PACK NAME
          SA1    TFLAG       XXJ FILE TYPE FLAG
          SA7    XXJA
          NZ     X1,XXJ7     IF TOTAL XXJ FILE
          EQ     XXJ30       GO TO NEXT STEP
 
*         ADD TERMINATOR TO *LG*, *AI*, OR *BA* STATEMENT.
 
 XXJ17    SX0    1R.
          LX0    47-5
          BX6    X5+X0
          SA6    A5
          BX5    X6
 
*         SETUP XXTLOG INFORMATION IN EDT AREA.
 
 XXJ18    RJ     UPC         UNPACK STATEMENT
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
          SB4    B6-1        NUMBER OF ARGUMENTS
          SB5    XXJJ        LIST FOR ARG
          RJ     UPK         GET TLOG PARAMETERS
          SX7    0
          SA7    XXJA        CLEAR FOR NEXT STATEMENT
          SA7    DEV
          SA7    DTP
          SA7    PAC
          SA2    XXJN        GET DATA BASE ID AND BUILD XXTLOG IN EDT
          SA3    IFARA
          SA6    A0+B1       SAVE IN EDT
          LX3    -12
          BX7    X2+X3
          SA7    A0
          SA0    A0+TFEN
          EQ     XXJ20       CONTINUE PROCESSING
 
*         SETUP START OF EDT AREA FOR NO LOGGING.
 
 XXJ19    SA2    XXJM
          BX7    X2
          SA7    A0          FAKE FILE NAME WHEN NO LOGGING
          SA0    A0+TFEN
 
*         INITIALIZE A DATA BASE FOR TOTAL.
 
 XXJ20    SA1    TDBID       CHECK IF *TOTAL* DATA MANAGER IS LOADED
          NG     X1,DIE42    IF *TOTAL* DATA MANAGER IS NOT LOADED
          SA1    XXJK        DBMOD NAME
          MX0    12
          BX3    X0*X1       DATA BASE ID
          SA2    TOTIN       INITIAL CALL HEADER
          LX3    12
          MX0    48
          BX2    X0*X2
          BX6    X2+X3
          SA6    A0+2*TMAXFIL  FIRST WORD OF SCHEMA LIST FOR INITL CALL
          SA2    A2+1
          SX7    A6
          MX0    24
          SA7    SA0         SAVE SCHEMA ADDRESS
          LX1    12
          BX1    X0*X1
          BX6    X1+X2
          SA6    A6+1        SECOND WORD OF LIST
          BX6    X6-X6
          SB5    60          INITIAL SHIFT COUNT FOR ACL
          SA6    A6+B1       CLEAR NEXT WORD
          BX7    X7-X7
          SX6    B5          SAVE B REG 5, 6
          SA7    XXJL        CLEAR FILE COUNT
          LX6    18
          SX7    A6          (B6) FOR ACL
          BX7    X6+X7
          SA7    SBS
          SA2    TLF         READ TOTAL LOG FLAG
          LX2    60-12
          MX0    12
          BX2    X0*X2
          SB7    B1+B1       NUMBER OF CHARACTERS
          RJ     ACL         PLACE CHARACTERS IN SCHEMA LIST
 
*         READ TOTAL DATA BASE FILE NAMES.
 
 XXJ21    READC  TL,XXJA,8   GET NEXT FILE NAME
          NZ     X1,XXJ23    IF NO MORE FILES
          SB7    XXJP        FWA FOR UNPACK
          SA5    XXJA
 
*         TEST FOR ONLY FILE NAME.
 
          MX0    24
          BX0    -X0*X5
          NZ     X0,XXJ22    IF MORE THAN FILE NAME
          SX0    1R.         ADD TERMINATOR
          LX0    35-5
          BX6    X0+X5
          SA6    A5
          BX5    X6
 XXJ22    RJ     UPC         UNPACK STATEMENT
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
          SB4    B6-1        AGRUMENT COUNT
          SB5    XXJJ        LIST FOR ARG
          RJ     UPK         UNPACK PARAMETERS
          SX7    0
          SA7    XXJA        CLEAR FOR NEXT STATEMENT
          SA7    DEV
          SA7    DTP
          SA7    PAC
          SA1    XXJL        CHECK IF TOO MANY FILES IN DATA BASE
          SA6    A0+1        PUT IN EDT
          SX0    X1-TMAXFIL-1
          SA2    XXJP        FILE NAME
          SA3    XXJN        DATA BASE ID
          LX2    -12
          SX7    X1+B1       ADVANCE FILE COUNT
          BX6    X2+X3
          LX2    12
          PL     X0,DIE21    IF TOO MANY FILES
          SA6    A0          SAVE NAME IN EDT
          SA7    A1          RESTORE FILE COUNT
          SA0    A0+TFEN
          SB7    4
          RJ     ACL         PLACE IN LIST
          SA2    PRIV
          SB7    4
          RJ     ACL         PLACE IN LIST
          SA2    STAT
          SB7    4
          RJ     ACL         PLACE IN LIST
          EQ     XXJ21       CONTINUE PROCESSING
 
 XXJ23    SA2    EOL         END.
          SB7    4
          RJ     ACL         PLACE IN LIST
          BX7    X7-X7
          SA7    B6+B1       MAKE SURE OF ZERO WORD
          SA2    SA0         SCHEMA ADDRESS
          SA1    SCHEMA      POINT TO SCHEMA LIST
          MX0    42
          BX1    X0*X1
          BX7    X1+X2       ADD LIST ADDRESS
          SA7    A1
          SA1    STAT
          BX6    X1
          SX7    A0
          SA6    STATUS
          SA1    TQUE        TOTAL INITIALIZATION QUEUE ENTRY
          SA7    SA0         SAVE A0
          BX6    X1
          SA6    IRIQA       QUEUE ENTRY
 XXJ24    RJ     XXJ24       INITIALIZE THE DATA BASE
*         RJ     =XTOTAL     (CALL TOTAL)
          SB1    1
 
*         WAIT FOR TOTAL TO COMPLETE THE INITL CALL.
 
          SA1    STATUS      STATUS WORD
          SA2    STAT        PRESET STATUS
          BX3    X1-X2
          NZ     X3,XXJ25    IF STATUS HAS CHANGED
          RECALL
          EQ     XXJ24       CONTINUE PROCESSING
 
*         CHECK IF TOTAL INITIALIZED CORRECTLY.
 
 XXJ25    SA3    SA0
          SA2    STATOK
          SA0    X3
          BX3    X1-X2
          BX6    X1
          ZR     X3,XXJ28    IF INITIALIZED OKAY
 
*         ISSUE MESSAGE AND ABORT TAF.
 
          SA1    SCHEMA      GET LIST ADDRESS
          SA6    TMES2+1     STATUS TO MESSAGE
          MX0    12
          SA2    X1
          SA4    A2+B1
          LX2    -12
          MX3    24
          BX2    X0*X2       DATA BASE NAME - UPPER TWO
          BX4    X3*X4
          SA3    TMES1
          MX0    36
          LX4    -12
          BX2    X2+X4       DATA BASE NAME
          BX3    -X0*X3
          BX6    X2+X3
          SA6    A3          SET IN MESSAGE
          MESSAGE  TMES1,,R  DBMOD NOT INITIALIZED
          MESSAGE  TMES2,,R  TOTAL STATUS
          SB7    A2-B1
 XXJ26    SA2    B7+B1       READ PARAMETER LIST AND DISPLAY
          ZR     X2,XXJ27    IF END OF PARAMETER LIST
          SB7    B7+B1
          BX6    X2
          SA6    TMES3
          MESSAGE  TMES3,,R  TOTAL PARAMETER LIST WORD
          EQ     XXJ26       CONTINUE PROCESSING
 
 XXJ27    ABORT
 
*         CLEAR TOTAL PARAMETER LIST.
 
 XXJ28    SA1    SCHEMA
          MX7    0
          SB7    X1          ADDRESS OF LIST
 XXJ29    SA1    B7
          ZR     X1,XXJ30    IF END OF LIST
          SB7    B7+B1
          SA7    A1
          EQ     XXJ29       CONTINUE PROCESSING
 
 
 XXJA     BSS    8           WORKING BUFFER
 XXJB     VFD    42/7LACCOUNT,18/0
 
*         *CPM* PARAMETER BLOCK.
 
 XXJD     CON    0           FAMILY NAME
          CON    0           PASSWORD
          CON    0           USER NAME
          BSSZ   10          PARAMETERS
 
 XXJE     BSS    1           JOURNAL FILE COUNT
 
 XXJF     BSS    0
 MS       ARG    -XXJG,TYP
 NT       ARG    -XXJG-2,TYP
 MT       ARG    -XXJG-1,TYP
 B        ARG    -XXJG,BNS
 R        ARG    -XXJG-1,BNS
          ARG
 
 XXJG     CON    0
          CON    1
          CON    2
 
 XXJH     VFD    12/0,18/0LJOR,30/0
 XXJI     VFD    12/0,30/0LTASKL,18/0
 XXJJ     BSS    0
 PN       ARG    XXJG,PAC
 R        ARG    XXJG,DEV
          ARG
 XXJK     CON    0           CURRENT DBMOD NAME
 XXJL     BSSZ   1           FILES IN DATA BASE
 XXJM     VFD    60/0LFILENAMES
 XXJN     BSSZ   1           CURRENT DATA BASE ID
 XXJO     DATA   0LUSER      CHECK FOR *USER* STATEMENT
 XXJP     BSS    14
 XXJQ     BSS    1           *BRF PASSED* FLAG
 XXJR     BSS    1           SAVE USER FAMILY NAME HERE
 XXJS     BSSZ   1           NUMBER OF ALTERNATE KEYS
 
 TYP      BSS    1           TAPE/DISK STATUS
 BNS      BSS    1           BUFFERED/NON BUFFERED STATUS
 PAC      BSSZ   1           PACK NAME
 DEV      BSSZ   1           DEVICE TYPE
 DTP      BSSZ   1           DEVICE TYPE AND UNIT FOR EDT
 
 
 SA0      BSSZ   1           SAVE A0
 SBS      BSSZ   1           SAVE B5 ABD B6
 TFLAG    BSSZ   1           TOTAL XXJ FLAG
 TLF      BSSZ   1           TOTAL LOG FLAG
 
 TOTIN    VFD    60/6L**TAF
          VFD    24/0,36/6LUPDATE
 STAT     VFD    60/4L++++
 STATOK   VFD    60/4L****
 TMES1    DATA   C*XXXXXX NOT INITIALIZED BY TOTAL.*
 TMES2    DATA   C*STATUS IS       *
 TMES3    DATA   C*                *
 
 
 TQUE     VFD    24/0,6/77B,6/0,1/1,5/0,18/ILIST
 ILIST    VFD    6/4,18/4,12/50B,6/33B,18/TYPE
          VFD    6/4,18/4,12/50B,6/33B,18/STATUS
 SCHEMA   VFD    6/4,18/4,12/50B,6/33B,18/-0
          VFD    6/4,18/4,12/50B,6/33B,18/EOL
          BSSZ   1
 TYPE     VFD    60/5LINITL
 STATUS   VFD    60/4L++++
 PRIV     VFD    60/4LPRIV
 EOL      VFD    60/4LEND.
 ACL      SPACE  4,10
**        ACL -  ADD CHARACTERS TO A LIST.
*
*         ENTRY  (X2) = CHARACTER STRING LEFT JUSTIFIED.
*                (B7) = NUMBER OF CHARACTERS IN STRING.
*                (SB5) = B REGISTERS 5, 6.
*
*         USES   X - ALL.
*                A - 4, 6, 7.
*                B - 4, 5, 6, 7.
 
 
 ACL2     SX6    B5          SAVE B5 AND B6
          SX7    B6
          LX6    18
          BX7    X6+X7
          SA7    SBS
 
 
 ACL      SUBR               ENTRY/EXIT
          SA1    SBS         SETUP B5 AND B6
          MX0    6
          SB6    X1
          LX1    -18
          SB5    X1
 ACL1     ZR     B7,ACL2     IF NO MORE CHARACTERS
          LX1    X0,B5
          LX3    X2,B5
          LX2    6
          SB5    B5-6
          SB7    B7-B1
          SA4    B6          READ CURRENT WORD OF LIST
          BX3    X1*X3
          BX6    X3+X4
          SA6    A4          CHARACTER MERGED
          NZ     B5,ACL1     IF SAME WORD
          SB6    B6+1
          MX7    0
          SB5    60
          SA7    B6          CLEAR NEXT WORD
          EQ     ACL1        CONTINUE PROCESSING
 ERR      EJECT
*         ERROR EXITS FOR DATA MANAGER INITIALIZATION.
*
*         ENTRY  (B5) - ERROR CODE NUMBER.
*                (B4) - FWA OF FET.
 
 
*         DATA MANAGER INITIALIZATION ERROR PROCESSOR.
 
 DIE      MX2    42
          SA5    B4          FIRST WORD OF FET
          BX5    X2*X5
          SX2    B4          FET FWA
          SB2    ERRTBLL
          GT     B5,B2,ERRA2 IF INCORRECT ERROR MESSAGE
          SA1    ERRTBL+B5-1 PICK UP ADDRESS OF ERROR MESSAGE
          SA4    X1
          SB2    6
          EQ     B2,B5,DIE12 IF ATTACH ERROR
          SB2    4
          NE     B2,B5,DIE1  IF NOT ERROR TYPE 4
          SA6    A4+2        D.B. TO ERROR MESSAGE
          EQ     ERRA1       PROCESS ERROR
 
 DIE1     SB2    5
          NE     B2,B5,ERRA1 NOT SPECIAL CASE ERROR
          SA6    A4+3        D.B. TO ERROR MESSAGE
          EQ     ERRA1
 
 DIE4     SX1    MSGD        * NO DATA BASE ID FOR DATA MANAGER.*
          EQ     ERRA1
 
 DIE5     SX1    MSGE        * TOO MANY DATA BASE NAMES.*
          EQ     ERRA1
 
 DIE6     SB5    MSGF        * NO USER STATEMENT IN XXJ FILE.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE7     SB2    1RX         REPLACEMENT CHARACTER IN MESSAGE
          SA1    TL          DATA BASE NAME
          MX0    42
          BX1    X0*X1
          RJ     SNM         SET NAME IN MESSAGE
          SX2    B5          ERROR MESSAGE
          EQ     ERRA3       WRITE ERROR MESSAGE
 
 DIE8     SB5    MSGG        * TOO MANY TAF JOURNAL FILES IN XXJ FILE.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE9     SB5    MSGH        * MISSING HEADER WORD ON XXJ FILE.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE10    SB5    MSGI        * INCORRECT DATA BASE IN XXJ FILE.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE11    SB5    MSGJ        * ERROR IN XXJ FILE ARGUMENTS.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE12    SB2    1RX
          SA1    X2+         READ DATA BASE FILE NAME
          MX0    42
          BX1    X0*X1
          SB5    MSGK        * ATTACH ERROR ON - XXXXXXX.*
          RJ     SNM         SET NAME IN MESSAGE
          SX1    B5
          EQ     ERRA1
 
 DIE13    SB5    MSGR        * JOURNAL TYPE DOES NOT MATCH XXJ FILE.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE14    SX1    MSGT        * NO DATA BASE NAME IN XXJ FOR TOTAL.*
          EQ     ERRA1
 
 DIE15    SX1    MSGU        * INCORRECT TCF ENTRY.*
          EQ     ERRA1
 
 DIE18    SX1    MSGX        * UNABLE TO ATTACH TOTAL BINARIES.*
          EQ     ERRA1
 
 DIE19    SX1    MSGY        * UNABLE TO ATTACH TOTAL DBMOD BINARIES.*
          EQ     ERRA1
 
 DIE20    SX1    MSGZ        * ERROR IN LOADING TOTAL.*
          EQ     ERRA1
 
 DIE21    SX1    MSGAA       * TOO MANY FILES IN TOTAL DATA BASE.*
          EQ     ERRA1
 
 DIE23    SX1    MSGAB       * ERROR IN LOADING AIP.*
          EQ     ERRA1       PROCESS ERROR
 
 DIE24    SX1    MSGAD       * INCORRECT DATA BASE NAME ON DMS.*
          EQ     ERRA1       PROCESS ERROR
 
 DIE25    SX1    MSGAE       * AIP TOO LARGE FOR LOADING.*
          EQ     ERRA1       PROCESS ERROR
 
 DIE26    SX1    MSGAF       * MEMORY OVERFLOW DURING INITIALIZATION.*
          EQ     ERRA1       PROCESS ERROR
 
 DIE27    MX0    42
          SA1    XXJD+2      READ INCORRECT USER NAME
          BX1    X0*X1
          SB2    1RX         REPLACEMENT CHARACTER
          SB5    MSGAI       FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          SA1    XXJD        READ FAMILY NAME
          SB2    1RY         REPLACEMENT CHARACTER
          SB5    MSGAI+2     FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          SX1    MSGAI
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE28    SX1    MSGAX       * ERROR IN LOADING AAMI.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE29    SX2    MSGAL       * FILE NAME MUST BE 2-7 CHARACTERS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE30    SX2    MSGAM       * FILE TYPE MUST BE AK, DA, OR IS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE31    SX2    MSGAN       * ATTACH MODE MUST BE W, M, R, OR RM.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE32    SX2    MSGAO       * INCORRECT NUMBER FOR USERS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE33    SX2    MSGAP       * INCORRECT NUMBER FOR LOCKS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE34    SX2    MSGAQ       * INCORRECT NUMBER FOR KEY LENGTH.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE35    SX2    MSGAR       * INCORRECT NUMBER FOR RECORD LENGTH.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE36    SX2    MSGAS       * FIELD LENGTH EXCEEDED FOR LOCKS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE37    SX2    MSGAT       * FIELD LENGTH EXCEEDED FOR USERS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE38    SX1    MSGAU       * FIELD LENGTH EXCEEDED FOR RECORD.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE40    SX2    MSGV        * XXJ FILE ERROR - CRM DM NOT LOADED.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE41    SX2    MSGAW       * FIELD LENGTH EXCEEDED FOR CMM.*
          EQ     ERRA3       WRITE ERROR MESSAGE
 
 DIE42    SX2    MSGW        * XXJ FILE ERROR - TOTAL DM NOT LOADED.*
          EQ     DIE7        PUT FILE NAME IN MESSAGE
 
 DIE43    SB5    MSGAZ       * FILE XXXXXXX NOT FOUND.*
 DIE44    SA1    TTIP+TIHR   HASHING ROUTINE
          SB2    1RX         REPLACEMENT CHARACTER IN MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          SX1    B5
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE45    SB5    MSGBA       * ERROR IN LOADING HASH CODE XXXXXXX.*
          EQ     DIE44       PUT FILE NAME IN MESSAGE
 
 DIE46    SX1    MSGBF       * MISSING AKY STATEMENT.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE47    SX2    MSGBG       * INCORRECT NUMBER OF ALTERNATE KEYS.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE48    SX2    MSGBH       * INCORRECT KEY ORDINAL.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE49    SX2    MSGBI       * INCORRECT KEY RELATIVE POSITION.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE50    SX2    MSGBJ       * INCORRECT KEY BEGINNING CHARACTER.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE51    SX2    MSGBK       * BRF PARAMETER TOO LARGE OR INCORRECT.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE52    SX2    MSGBL       * NO BRF STATEMENT FOR CRM DATA BASE.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE53    SX1    MSGBM       * RECOVERY FILE INCONSISTENT.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE54    SX2    MSGBN       * FILE ATTACH ERROR.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE55    SX1    MSGBO       * RECOVERY OF CRM DATA BASE IMPOSSIBLE.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE56    SX1    MSGBP       * BOTH AFTER IMAGE FILES ACTIVE.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE57    SX1    MSGBQ       * ACTIVE ARF IS FULL.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE58    SX2    MSGBR       * INCORRECT FWI IN CRM STATEMENT.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE59    SX2    MSGBS       * INCORRECT RECOVER OPTION IN CRM.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE60    SX2    MSGBT       * INCORRECT DEVICE TYPE IN CRM STATEMENT.*
          EQ     ERRA3       WRITE COMMAND
 
 DIE61    SX1    MSGBU       * CIO ERROR ON RECOVERY FILE.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE62    SX1    MSGBV       * NOT ENOUGH FL FOR RECOVERY BUFFERS.*
          EQ     ERRA1       WRITE ERROR MESSAGE.
 
 DIE63    SX1    MSGBW       * DATA BASE NOT IN EDT.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE64    SX1    MSGBX       * INCORRECT FAMILY IN EDT.*
          EQ     ERRA1       WRITE ERROR MESSAGE.
 
 DIE65    SX1    MSGBY       * RECOVERY ACTIVE ON DATA BASE.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE66    SX1    MSGBZ       *ARF BLOCK SIZE IS LARGER THAN THE BUFFER*
          EQ     ERRA1       WRITE ERROR MESSAGE.
 
 DIE67    SX1    MSGCA       * NOT ENOUGH FL FOR RECOVERY TABLES.*
          EQ     ERRA1       WRITE ERROR MESAGE
 
 DIE68    SX1    MSGCB       * XXJ FILE MUST HAVE RMKDEFS.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 DIE69    SX1    MSGCC       *CMM BFL IS NOT LARGE ENOUGH.*
          EQ     ERRA1       WRITE ERROR MESSAGE
 
 ERRA1    MESSAGE  X1,0,R    ISSUE APPROPRIATE MESSAGE FROM TABLE
 ERRA2    ABORT
 
 ERRA3    MESSAGE  XXJA      WRITE COMMAND IN ERROR
          BX1    X2
          EQ     ERRA1       WRITE ERROR MESSAGE
 
*         INITIALIZATION ERROR AND INFORMATIONAL MESSAGES.
 
 MSGD     DATA   C* NO DATA BASE ID FOR DATA MANAGER.*
 MSGE     DATA   C* TOO MANY DATA BASE NAMES.*
 MSGF     DATA   C* NO USER STATEMENT IN XXJ FILE.*
 MSGG     DATA   C* TOO MANY TAF JOURNAL FILES IN XXJ FILE.*
 MSGH     DATA   C* MISSING HEADER WORD ON XXJ FILE.*
 MSGI     DATA   C* INCORRECT DATA BASE IN XXJ FILE.*
 MSGJ     DATA   C* ERROR ON XXJ FILE ARGUMENTS.*
 MSGK     DATA   C* ATTACH ERROR ON - XXXXXXX.*
 MSGKL    EQU    *-MSGK      LENGTH OF MESSAGE
 MSGL     DATA   C* EDT TOO LARGE.*
 MSGM     DATA   C* EDT FILE EMPTY.*
 MSGN     DATA   C* FILE SPECIFIED AS EDT FILE IS NOT EDT FILE TYPE.*
 MSGO     DATA   C* DUAL RECORDED FILE  NNNNNNN   NOT ATTACHED.*
 MSGP     DATA   C* DUAL AND TRACE FLAGS FOR FILE NNNNNNN   .*
 MSGQ     DATA   C* XXJ FILE NOT FOUND.*
 MSGR     DATA   C* JOURNAL TYPE DOES NOT MATCH XXJ FILE.*
 MSGS     DATA   C* FATAL CIO ERROR STATUS.*
 MSGT     DATA   C* NO DATA BASE NAME IN XXJ FOR TOTAL.*
 MSGU     DATA   C* INCORRECT TCF ENTRY.*
 MSGV     DATA   C* XXJ FILE ERROR - CRM DM NOT LOADED.*
 MSGW     DATA   C* XXJ FILE ERROR - TOTAL DM NOT LOADED.*
 MSGX     DATA   C* UNABLE TO ATTACH TOTAL BINARIES.*
 MSGY     DATA   C* UNABLE TO ATTACH TOTAL DBMOD BINARIES.*
 MSGZ     DATA   C* ERROR IN LOADING TOTAL.*
 MSGAA    DATA   C* TOO MANY FILES IN TOTAL DATA BASE.*
 MSGAB    DATA   C* ERROR IN LOADING AIP.*
 MSGAD    DATA   C* INCORRECT DATA BASE NAME ON DMS STATEMENT.*
 MSGAE    DATA   C* AIP TOO LARGE FOR LOADING.*
 MSGAF    DATA   C* MEMORY OVERFLOW DURING INITIALIZATION.*
 MSGAG    DATA   C* XXXXXX WORDS REQUIRED FOR AIP LOADING.*
 MSGAH    DATA   C* AIP SUCCESSFULLY LOADED.*
 MSGAI    DATA   C* UN=XXXXXXX NOT VALID ON FM=YYYYYYY.*
 MSGAL    DATA   C* FILE NAME MUST BE 2-7 CHARACTERS.*
 MSGAM    DATA   C* FILE TYPE MUST BE AK, DA, OR IS.*
 MSGAN    DATA   C* ATTACH MODE MUST BE W, M, R, OR RM.*
 MSGAO    DATA   C* INCORRECT NUMBER FOR USERS.*
 MSGAP    DATA   C* INCORRECT NUMBER FOR LOCKS.*
 MSGAQ    DATA   C* INCORRECT NUMBER FOR KEY LENGTH.*
 MSGAR    DATA   C* INCORRECT NUMBER FOR RECORD LENGTH.*
 MSGAS    DATA   C* FIELD LENGTH EXCEEDED FOR LOCKS.*
 MSGAT    DATA   C* FIELD LENGTH EXCEEDED FOR USERS.*
 MSGAU    DATA   C* FIELD LENGTH EXCEEDED FOR RECORD.*
 MSGAW    DATA   C* FIELD LENGTH EXCEEDED FOR CMM.*
 MSGAX    DATA   C* ERROR IN LOADING AAMI.*
 MSGAY    BSS    MSGKL       ASSEMBLY AREA FOR MESSAGE *MSGK*
 MSGAZ    DATA   C* FILE XXXXXXX NOT FOUND.*
 MSGBA    DATA   C* ERROR IN LOADING HASH CODE XXXXXXX.*
 MSGBB    DATA   C* TAF DATA MANAGER SUCCESSFULLY LOADED.*
 MSGBC    DATA   C* TOTAL DATA MANAGER SUCCESSFULLY LOADED.*
 MSGBD    DATA   C* CRM DATA MANAGER SUCCESSFULLY LOADED.*
 MSGBE    DATA   C* DUPLICATE DATA BASE IN TCF - XX.*
 MSGBF    DATA   C* NUMBER OF AKY STATEMENTS MUST EQUAL NUMBER OF ALTERN
,ATE KEYS.*
 MSGBG    DATA   C* INCORRECT NUMBER OF ALTERNATE KEYS.*
 MSGBH    DATA   C* INCORRECT KEY ORDINAL.*
 MSGBI    DATA   C* INCORRECT KEY RELATIVE POSITION.*
 MSGBJ    DATA   C* INCORRECT KEY BEGINNING CHARACTER.*
 MSGBK    DATA   C* BRF PARAMETER TOO LARGE OR INCORRECT.*
 MSGBL    DATA   C* NO BRF STATEMENT FOR CRM DATA BASE.*
 MSGBM    DATA   C* TAF/CRM RECOVERY FILE INCONSISTENT.*
 MSGBN    DATA   C* FILE ATTACH/DEFINE ERROR.*
 MSGBO    DATA   C* RECOVERY OF CRM DATA BASE IMPOSSIBLE.*
 MSGBP    DATA   C* BOTH AFTER IMAGE FILES ACTIVE.*
 MSGBQ    DATA   C* AFTER IMAGE RECOVERY FILE IS FULL.*
 MSGBR    DATA   C* INCORRECT FWI IN THE CRM STATEMENT.*
 MSGBS    DATA   C* INCORRECT RECOVER OPTION IN THE CRM STATEMENT.*
 MSGBT    DATA   C* INCORRECT DEVICE TYPE IN CRM STATEMENT.*
 MSGBU    DATA   C* CIO ERROR ON RECOVERY FILE.*
 MSGBV    DATA   C* NOT ENOUGH FL FOR RECOVERY BUFFERS.*
 MSGBW    DATA   C* DATA BASE NOT IN EDT.*
 MSGBX    DATA   C* INCORRECT FAMILY NAME IN EDT.*
 MSGBY    DATA   C* BATCH RECOVERY ACTIVE ON DATA BASE.*
 MSGBZ    DATA   C* ARF BLOCK SIZE IS LARGER THAN THE BUFFER.*
 MSGCA    DATA   C* NOT ENOUGH FL FOR RECOVERY TABLES.*
 MSGCB    DATA   C* MISSING RMKDEF STATEMENT IN XXJ FILE.*
 MSGCC    DATA   C* CMM BFL IS NOT LARGE ENOUGH.*
 
 ERRTBL   BSS    0
          VFD    60/MSGL     ERROR 1 FROM COMBINT
          VFD    60/MSGM     ERROR 2 FROM COMBINT
          VFD    60/MSGN     ERROR 3 FROM COMBINT
          VFD    60/MSGO     ERROR 4 FROM COMBINT
          VFD    60/MSGP     ERROR 5 FROM COMBINT
          VFD    60/MSGK     ERROR 6 FROM COMBINT
 ERRTBLL  EQU    *-ERRTBL
 
 
 ERP$     SX5    X2
          SX1    MSGS
          EQ     ERRA1       ISSUE FATAL ERROR MESSAGE AND ABORT
          SPACE  4
*         INITIALIZATION PARAMETERS
 
 RCRL     EQU    101B        BUFFER SIZE FOR UNIT RECORD
 DSKL     EQU    401B        BUFFER SIZE FOR DISK
 TAPL     EQU    2001B       BUFFER SIZE FOR TAPE
 MAXDB    EQU    25          MAXIMUM NUMBER OF DATA BASES
 CCP      BSS    1           CURRENT CORE POSITION
 
 PDATE    BSS    1           PACKED TIME AND DATE
 
 DBID     BSS    0
 DBID     FILEC  HBUF,HBUFL,FET=13,EPR
 
 TL       BSS    0           TASK LIBRARY FET
 "TLFM"   RFILEB IBUF,IBUFL,FET=13,EPR
 
 TIF      BSS    0           TAF INITIALIZATION FILE
 "TIF"    FILEB  RBUF,RBUFL
 
 TCF      BSS    0           TAF CONFIGURATION FILE
 TCF      FILEC  TCBUF,TCBUFL,FET=13,EPR
 
 DISK     BSS    0
 DISK     RFILEB LBUF,LBUFL,FET=13,EPR
 
 TDBID    BSS    0
 TDBID    FILEC  THBUF,THBUFL,FET=12,EPR
 
 TOTALF   BSS    0
 TOTALE   FILEC  IBUF,IBUFL,FET=12,EPR
 
 TOTFILE  BSS    0
 DBMOD    FILEC  IBUF,IBUFL,FET=13,EPR
 
 CDBID    BSS    0           FET FOR *CRM* DATA MANAGER
 CDBID    FILEC  CBUF,CBUFL,FET=12,EPR
 
 OTHER    BSS    0           OTHER DATA BASES
 OTHER    FILEC  OTBUF,OTBUFL,FET=13,EPR
 
 ZZZZZDG  BSS    0
 ZZZZZDG  FILEB  IBUF,IBUFL,FET=2,EPR
 
 
 SETLA    DATA   C* LIBRARY DIRECTORY EMPTY - ZZZZZZZ.*
 
 SETLB    DATA   C* LIBRARY DIRECTORY TOO LONG - ZZZZZZZ.*
 
 SETLC    VFD    60/3LTLD    DIRECTORY HEADER WORD
 
 SETLD    DATA   C* LIBRARY DIRECTORY ERROR - ZZZZZZZ.*
 
 SETLE    VFD    60/0LZZCRF
 
 SETLG    BSS    0           OVERLAY ENTRY POINT LIST
 DISPLAY  HERE
          CON    0           TERINATOR
 SETLGL   EQU    *-SETLG     LENGTH OF LIST
 
 SETLH    BSS    0           OVERLAY RELOCATABLE INSTRUCTION CONTROL
 OREL     HERE
 SETLHL   EQU    *-SETLH     LENGTH OF LIST
 SETLI    DATA   C* LIBRARY DIRECTORY SPACE TOO LARGE. *
          TITLE  *CRM* INTERFACE ROUTINES.
 AKY      SPACE  4,20
**        AKY - PROCESS ACTUAL KEY.
*
*         ENTRY  (B7) = FWA FOR UNPACKING PARAMETERS.
*                (A0) = CURRENT MEMORY LOCATION.
*                (A5) = ADDRESS OF FIRST WORD.
*                (X5) = FIRST WORD OF COMMAND.
*
*         EXIT   TO *DIE11*, IF ERROR IN ARGUMENTS.
*                TO *DIE34*, IF INCORRECT KEY LENGTH PARAMETER.
*                TO *DIE48*, IF INCORRECT KEY ORDINAL PARAMETER.
*                TO *DIE49*, IF INCORRECT KEY POSITION PARAMETER.
*                TO *DIE50*, IF INCORRECT KEY BEGINNING CHARACTER.
*                (A0) = CURRENT MEMORY LOCATION.
*
*         USES   X - 0, 2, 5, 6, 7.
*                A - 2, 5, 6, 7.
*                B - 2, 5, 6.
*
*         CALLS  CRM, CTW, DXB, UPC.
 
 
 AKY      SUBR
          MX0    -1
          SA2    CRMI        BIT MAP OF FILE ORGANIZATIONS
          BX7    -X0+X2
          SA7    A2
          RJ     UPC         UNPACK COMMAND
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
 
*         PROCESS KEY ORDINAL.
 
          LT     B6,B1,DIE48 IF NO KEY ORDINAL
          SA5    B7+1        KEY ORDINAL
          RJ     DXB         CONVERT KEY ORDINAL TO BINARY
          SA2    TTIP+TIKO   LAST KEY ORDINAL
          NZ     X4,DIE48    IF INCORRECT KEY ORDINAL NUMBER
          SX2    X2+B1
          BX2    X6-X2
          NZ     X2,DIE48    IF WRONG ORDER
          SA6    A2          SAVE CURRENT KEY ORDINAL
 
*         PROCESS RELATIVE KEY POSITION.
 
          SB6    B6-2
          SA5    A5+B1       GET KEY OFFSET
          LT     B6,AKY2     IF NO KEY OFFSET
          RJ     DXB         CONVERT KEY POSITION TO BINARY
          NZ     X4,DIE49    IF INCORRECT KEY POSITION NUMBER
          ZR     X6,DIE50    IF KEY OFFSET .EQ. 0
          SX7    X6-1
          SA2    TTIP+TIRL   GET MAXIMUM RECORD LENGTH
          IX5    X2-X6
          NG     X5,DIE50    IF KEY OFFSET TOO LARGE
          RJ     CTW         CONVERT TO WORDS
          BX7    X1          WORDS
          SA6    TTIP+TIKP   STARTING CHARACTER POSITION
          SB6    B6-B1
          SA7    TTIP+TIKW   WORD POSITION
 
*         PROCESS KEY LENGTH.
 
          LT     B6,B1,DIE34 IF NO KEY LENGTH
          SA5    A5+1
          RJ     DXB         CONVERT KEY LENGTH TO BINARY
          NZ     X4,DIE34    IF INCORRECT KEY LENGTH NUMBER
          ZR     X6,DIE34    IF ZERO LENGTH
          SA6    TTIP+TIAL
          SA5    TTIP+TIMK   GET MAXIMUM KEY THIS FAR
          IX5    X5-X6
          SX7    A0
          PL     X5,AKY1     IF THIS KEY NOT GREATER
          SA6    TTIP+TIMK   SET NEW MAXIMUM KEY
 
*         PROCESS ALTERNATE KEY.
 
 AKY1     SA7    TTIP+TIAM
          SB2    TTIP        FWA OF TABLE OF PARAMETERS
          SB5    3           PROCESS *AKY* STATEMENT
          RJ     CRM         SAVE ALTERNATE KEY DESCRIPTION
          EQ     AKYX        NORMAL RETURN
 
*         PROCESS DELETED KEY.
 
 AKY2     SX6    -B1         SET DELETED KEY FLAG
          SX7    A0
          SA6    TTIP+TIKW
          EQ     AKY1        PROCESS ALTERNATE KEY
 CRM      SPACE  4,35
**        CRM - *CRM* INTERFACE ROUTINE.
*
*         ENTRY  (B5) = 0, IF PROCESSING *CRM* STATEMENT.
*                       2, IF PROCESSING *IXN* STATEMENT.
*                       3, IF PROCESSING *AKY* STATEMENT.
*                       4, IF ALLOCATING FILE CONTROL ENTRIES.
*                       5, IF ALLOCATING RECORD BUFFER.
*                       6, IF RECONSTRUCTING *AAMI* TABLES.
*                       7, IF ROLLING BACK *CRM* UPDATES.
*                       8, IF ALLOCATING *BRF* BUFFERS.
*                (B2) = *TTIP*, IF ALLOCATING RECORD BUFFER.
*                TL = FWA OF FET FOR *XXJ* FILE.
*                (B7) = FWA FOR UNPACKING PARAMETERS.
*
*         EXIT   TO *DIE11*, IF ERROR ON *CRM* STATEMENT ARGUMENTS.
*                TO *DIE30*, IF INCORRECT FILE TYPE PARAMETER.
*                TO *DIE31*, IF INCORRECT MODE PARAMETER.
*                TO *DIE32*, IF INCORRECT USER PARAMETER.
*                TO *DIE33*, IF INCORRECT LOCK PARAMETER.
*                TO *DIE34*, IF INCORRECT KEY PARAMETER.
*                TO *DIE35*, IF INCORRECT RECORD PARAMETER.
*                TO *DIE36*, IF NOT ENOUGH FL FOR *CMM*.
*                TO *DIE37*, IF NOT ENOUGH FL FOR USERS.
*                TO *DIE38*, IF NOT ENOUGH FL FOR RECORD.
*                TO *DIE43*, IF HASHING ROUTINE NOT FOUND.
*                TO *DIE45*, IF ERROR ON LOADING HASHING ROUTINE.
*                TO *DIE53*, IF RECOVERY FILE INCONSISTENT(EC=5).
*                TO *DIE54*, IF FILE ATTACH/DEFINE ERROR(EC=6).
*                TO *DIE55*, IF DATA BASE RECOVERY IMPOSSIBLE(EC=7)
*                TO *DIE56*, IF BOTH *ARF-S* ACTIVE (EC=10B).
*                TO *DIE57*, IF *ARF* IS FULL (EC = 11B).
*                TO *DIE58*, IF INCORRECT *FWI* IN *CRM* STATEMENT.
*                TO *DIE59*, IF INCORRECT *REC* IN *CRM* STATEMENT.
*                TO *DIE60*, IF INCORRECT *DEV* IN *CRM* STATEMENT.
*                TO *DIE61*, IF CIO ERROR ON RECOVERY FILE(EC=12B).
*                TO *DIE62*, IF NOT ENOUGH FL FOR BUFFERS(EC=13B).
*                TO *DIE63*, IF D.B. NOT IN EDT(EC=14B).
*                TO *DIE64*, IF INCORRECT FAMILY NAME IN EDT(EC=15B).
*                TO *DIE65*, IF *DMREC* ACTIVE FOR THIS D.B.(EC=16B).
*                TO *DIE66*, IF *ARF* BLOCK .GT. *ARF* BUFFER(EC=17B).
*                TO *DIE67*, IF NOT ENOUGH FL FOR TABLES(EC=20B).
*                TO *DIE69*, IF *BFL* NOT LARGE ENOUGH (EC=21B).
*                (A0) = CURRENT MEMORY LOCATION.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 5, 6, 7.
*                B - 1, 2, 4, 5, 6, 7.
*
*         CALLS  CER, DXB, IAM, UPC.
*
*         MACROS ATTACH, FILEC, GET, LDREQ, LOADER, STATUS.
 
 
 CRM      SUBR               ENTRY/EXIT
          ZR     B5,CRM2     IF *CRM* STATEMENT
 CRMA     BSS    0
 CRM1     RJ     0           MODIFIED BY *INIT*
*         RJ     =XIAM       INITIAL ACCESS METHOD
          SA1    TTIP+TIAM   UPDATE CURRENT CORE POSITION
          SA0    X1
          LX6    59-0
          SB7    X6
          JP     B7+TCRM     JUMP TO PROCESSING ROUTINE
 
 TCRM     PL     X6,CRMX     IF NO ERRORS
          EQ     DIE38       NOT ENOUGH FL FOR RECORD
          PL     X6,DIE37    IF NOT ENOUGH FL FOR USERS
          EQ     DIE36       NOT ENOUGH FL FOR LOCKS
          PL     X6,CRM12    IF NOT ENOUGH FL FOR *CMM*
          EQ     DIE53       RECOVERY FILE INCONSISTENT
          PL     X6,DIE54    IF FILE ATTACH ERROR
          EQ     DIE55       IF *CRM* DATA BASE RECOVERY IMPOSSIBLE
          PL     X6,DIE56    IF BOTH *ARF-S* ACTIVE
          EQ     DIE57       ACTIVE *ARF* IS FULL
          PL     X6,DIE61    IF CIO ERROR ON RECOVERY FILE.
          EQ     DIE62       IF NO FL FOR RECOVERY BUFFERS.
          PL     X6,DIE63    IF D.B. NOT IN EDT.
          EQ     DIE64       IF INCORRECT FAMILY IN EDT.
          PL     X6,DIE65    IF *DMREC* ACTIVE FOR THIS D.B.
          EQ     DIE66       IF *ARF* BLOCK .GT. *ARF* BUFFER
          PL     X6,DIE67    IF NO FL FOR RECOVERY TABLES.
          EQ     CRM13       IF *BFL* NOT LARGE ENOUGH
 
 CRM2     RJ     UPC         UNPACK COMMAND
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
 
*         PROCESS FILE NAME.
 
          SA1    TL
          LT     B6,B1,DIE29 IF NO FILE NAME
          SA2    B7+B1       FILE NAME FROM *CRM* STATEMENT
          MX6    12          MASK FOR DATA BASE
          BX1    X6*X1       DATA BASE
          BX3    X6*X2       DATA BASE OF FILE
          IX3    X3-X1
          BX7    X2
          NZ     X3,DIE29    IF INCORRECT DATA BASE
          SA7    TTIP+TIFN
          SX3    B1
          BX7    X7+X3
          SA7    CRMC        PUT LOGICAL FILE NAME IN FET
          MX0    12
          SA1    A7+B1
          BX6    -X0*X1
          BX7    X7-X7       CLEAR PACKNAME IN FET
          SA6    A1+
          SA7    CRMC+CFPK
          SA7    TTIP+TIRF   CLEAR *RECOVERABLE FILE* FLAG IN *TTIP*
          SA7    TTIP+TIPN   CLEAR PACKNAME
          SA7    TTIP+TIDV   CLEAR DEVICE TYPE
          SA7    TTIP+TIHR   CLEAR HASHING ROUTINE
          SA7    TTIP+TIFW   PRESET *FORCED WRITE* INDICATOR
          SA7    TTIP+TIAE   CLEAR ATTACH ERROR
 
*         PROCESS FILE TYPE, (ORGANIZATION).
 
          SB6    B6-2
          LT     B6,DIE30    IF NO FILE TYPE PARAMETER
          SX7    3           *CRM* CODE FOR INDEX SEQUENTIAL
          SA2    A2+B1       FILE TYPE
          LX2    11-59       RIGHT JUSTIFY TYPE
          SX3    X2-2RIS
          ZR     X3,CRM3     IF INDEX SEQUENTIAL
          SX7    6
          SX3    X2-2RAK
          ZR     X3,CRM3     IF ACTUAL KEY
          SX3    X2-2RDA
          NZ     X3,DIE30    IF NOT DIRECT ACCESS
          SX7    5           *CRM* CODE FOR DIRECT ACCESS
 CRM3     SA7    TTIP+TIFO   FILE ORGANIZATION
          MX0    -1
          SB4    X7
          LX0    B4          POSITION FILE ORGANIZATION BIT
          SA3    CRMI        BIT MAP OF FILE ORGANIZATIONS
          BX7    -X0+X3
          SA7    A3
 
*         CHECK MODE, (PROCESSING DIRECTION).
 
          SB6    B6-1
          BX7    X7-X7       ASSUME READ ONLY FILE MODE
          LT     B6,DIE31    IF NO MODE
          SA2    A2+B1       MODE
          MX0    12
          SA3    CRMB        LEGAL MODES
 CRM4     BX4    X0*X3
          BX5    X2-X4
          SX4    X7-3
          ZR     X5,CRM5     IF LEGAL MODE
          ZR     X4,DIE31    IF INCORRECT MODE
          LX3    15          NEXT LEGAL MODE
          SX7    X7+B1
          EQ     CRM4        CONTINUE CHECKING MODE
 
 CRM5     ZR     X7,CRM6     IF READ ONLY MODE
          SX7    3           *CRM* CODE FOR INPUT/OUTPUT
 CRM6     SA7    TTIP+TIPD   PROCESSING DIRECTION
          LX3    2-47
          MX0    -3
          BX6    -X0*X3      ATTACH MODE
 
*         PROCESS USERS.
 
          SB6    B6-B1
          SA6    CRMD
          SA6    TTIP+TIMD   SAVE THE ATTACH MODE
          LT     B6,DIE32    IF NO USER PARAMETER
          SA5    A2+1        USERS
          RJ     DXB         DISPLAY TO BINARY
          NZ     X4,DIE32    IF INCORRECT NUMBER
          ZR     X6,DIE32    IF ZERO USER
          SA6    TTIP+TIUS   NUMBER OF USERS
 
*         PROCESS LOCKS.
 
          SB6    B6-B1
          SA5    A5+B1       LOCKS
          LT     B6,DIE33    IF NO LOCK PARAMETER
          RJ     DXB         CONVERT LOCKS FROM DISPLAY TO BINARY
          NZ     X4,DIE33    IF INCORRECT LOCK NUMBER
          ZR     X6,DIE33    IF ZERO LOCKS
          SA6    TTIP+TILK   NUMBER OF LOCKS
 
*         PROCESS MAXIMUM RECORD LENGTH.
 
          SB6    B6-B1
          SA5    A5+B1       MAXIMUM RECORD LENGTH
          LT     B6,DIE35    IF NO MAXIMUM RECORD LENGTH PARAMETER
          RJ     DXB         CONVERT RECORD LENGTH TO BINARY
          NZ     X4,DIE35    IF INCORRECT RECORD LENGTH
          ZR     X6,DIE35    IF ZERO RECORD LENGTH
          SA6    TTIP+TIRL   RECORD LENGTH
          SA3    VBCT        BATCH CONCURRENCY SUBCP LENGTH
          MX0    -24
          BX5    -X0*X5      PREVIOUS LARGEST SUBCP LENGTH
          SX6    X6+9        INSURE LAST WORD AVAILABLE
          SX4    10
          IX6    X6/X4       RECORD BUFFER LENGTH IN WORDS
          SX6    X6+BSRB+NUAPL  SUBCP LENGTH INCLUDES SYSTEM AREA
          SX6    X6+63       ROUND UP TO 100B CM WORDS
          MX0    -6
          BX6    X0*X6
          IX5    X5-X6
          PL     X5,CRM6.1   IF THIS SUBCP LENGTH NOT GREATER
          BX6    X3+X6
          SA6    A3          SET NEW MAXIMUM SUBCP LENGTH
 
*         PROCESS KEY LENGTH.
 
 CRM6.1   SB6    B6-B1
          SA5    A5+B1       KEY LENGTH
          LT     B6,DIE34    IF NO KEY LENGTH PARAMETER
          RJ     DXB         CONVERT KEY LENGTH FROM DISPLAY TO BINARY
          NZ     X4,DIE34    IF INCORRECT KEY LENGTH NUMBER
          ZR     X6,DIE34    IF ZERO KEY LENGTH
          SA6    TTIP+TIKL   KEY LENGTH
          SA6    TTIP+TIMK   MAXIMUM KEY LENGTH
 
*         PROCESS HASHING ROUTINE.
 
          SB6    B6-B1
          SA5    A5+B1       HASHING ROUTINE FILE NAME
          LT     B6,CRM9     IF NO MORE PARAMETERS
          ZR     X5,CRM7     IF NO HASHING ROUTINE
          BX6    X5
          SA6    TTIP+TIHR
 
*         PROCESS FILE RECOVERABILITY INDICATOR.
 
 CRM7     SB6    B6-B1
          LE     B6,CRM9     IF NO MORE PARAMETERS
          SA5    A5+B1       RECOVERABILITY INDICATOR
          MX0    6
          ZR     X5,CRM7.1   IF OMITTED
          SX6    2RNR
          SX7    B1
          LX6    -12
          BX1    X5-X6
          BX1    X0*X1
          ZR     X1,CRM7.1   IF NOT RECOVERABLE
          LX6    6
          BX1    X5-X6
          BX1    X0*X1
          NZ     X1,DIE59    IF RECOVERIBILITY NOT *R* OR *N*
          SA7    TTIP+TIRF
 
*         PROCESS FORCED WRITE INDICATOR.
 
 CRM7.1   SB6    B6-B1
          LE     B6,CRM9     IF NO MORE PARAMETERS
          SA5    A5+B1       PICK FORCED WRITE INDICATOR
          ZR     X5,CRM7.2   IF DEFAULTED
          SX6    2RNY
          SX7    B1
          LX6    -12
          BX1    X5-X6
          BX1    X0*X1
          ZR     X1,CRM7.2   IF *FWI* IS *N*
          LX6    6
          BX1    X5-X6
          BX1    X0*X1
          NZ     X1,DIE58    IF FWI NEITHER *Y* NOR *N*
          SA7    TTIP+TIFW
 
*         PROCESS PACKNAME.
 
 CRM7.2   SB6    B6-B1
          LE     B6,CRM9     IF END OF PARAMETERS
          SA5    A5+B1       PACKNAME
          BX6    X5
          SA6    CRMC+CFPK
          SA6    TTIP+TIPN   PACKNAME INTO *TTIP*
 
*         PROCESS DEVICE.
 
 CRM8     SB6    B6-B1
          LE     B6,CRM9     IF NO MORE PARAMETERS
          SA5    A5+B1
          MX0    12
          BX6    X0*X5       ISOLATE DEVICE MNEMONIC
          SA1    CRMC+1
          SA6    TTIP+TIDV   DEVICE MNEMONIC INTO *TTIP*
          BX1    -X0*X1
          BX6    X6+X1
          BX5    -X0*X5      CLEAR MNEMONIC OUT OF DEV.TYPE
          SA6    A1          DEVICE INTO THE FET
          LX5    12
          SB7    -B1
          RJ     DXB
          NZ     X4,DIE60    IF NO. OF UNITS INCORRECT
          SX2    X6-9
          PL     X2,DIE60    IF NO. OF UNITS TOO LARGE
          ZR     X6,CRM9     IF NO. OF UNITS = 0
          SA1    CRMC+CFPK
          SA2    TTIP+TIDV
          BX7    X6+X1
          BX6    X6+X2
          SA7    A1          NO. OF UNITS INTO FET
          SA6    A2          NO. OF UNITS INTO *TTIP*
 CRM9     SB4    CRMC        FWA OF FET
 
*         CHECK IF FILE AT CONTROL POINT.
 
          STATUS B4
          SA1    B4          FET STATUS
          MX6    11
          LX1    59-11
          BX6    X6*X1
          NZ     X6,CRM9.1   IF FILE AT CONTROL POINT
 
*         ATTACH *CRM* FILE.
 
          SA2    XXJD+2      USER NAME
          MX0    42
          BX0    X0*X2
          ATTACH B4,,X0,,CRMD
          RJ     CER         CHECK ERRORS
          ZR     X1,CRM9.1   IF NO ATTACH ERROR
          SX6    B1+
          SA6    TTIP+TIAE   SET ATTACH ERROR
          SA1    CRMC        GET FILE NAME
          MX0    42
          BX1    X0*X1
          SB2    1RX         SUBSTITUTION CHARACTER
          SB5    -CRMJ       ERROR MESSAGE
          SB3    CRMK        ERROR MESSAGE ASSEMBLY AREA
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE CRMK,3     PUT MESSAGE IN DAYFILE
 CRM9.1   SA2    TTIP+TIHR   HASHING ROUTINE
          ZR     X2,CRM11    IF NO HASHING ROUTINE
          SB4    CRMC        FWA OF FET
          SX3    B1
          IX7    X2+X3
          SA7    B4          PUT LOGICAL FILE NAME IN FET
 
*         CHECK IF HASHING FILE AT CONTROL POINT.
 
          STATUS B4
          SA1    B4
          MX6    11
          LX1    59-11
          BX6    X6*X1
          NZ     X6,CRM10    IF FILE AT CONTROL POINT
 
*         GET HASHING ROUTINE.
 
          SA2    XXJD+2      USER NAME
          MX0    42
          BX0    X0*X2
          GET    B4,X0
          RJ     CER         CHECK ERRORS
          NZ     X1,DIE43    IF FILE NOT FOUND
 
*         LOAD HASHING ROUTINE.
 
 CRM10    SX2    3           REWIND FILE
          SA1    TTIP+TIHR   HASHING ROUTINE
          BX7    X1+X2
          BX6    X1
          SA7    CRMG+1      SET FILE NAME IN LOAD REQUEST
          MX0    18
          SX3    A0          FWA OF AVAILABLE MEMORY
          SA6    CRMH+1      SET ENTRY POINT IN ENTRY REQUEST
          LX3    47-17
          LX0    47-59
          SA2    CRMF        SETUP LOAD ADDRESS
          BX2    -X0*X2
          BX6    X3+X2
          SA6    A2+
          LOADER CRMF        LOAD HASHING ROUTINE
 
*         CHECK FOR LOADER ERRORS ON HASHING ROUTINE.
 
          SB1    1
          SA1    CRMF+2      LOAD STATUS
          MX0    2
          BX2    X0*X1
          NZ     X2,DIE45    IF ERROR IN LOADING HASHING ROUTINE
          SA3    CRMH+1      GET FWA OF HASH ENTRY POINT
          SX6    X3+
          ZR     X6,DIE45    IF ENTRY POINT NOT FOUND
          SA6    TTIP+TIHR
          SA1    LWPR        LWA + 1 OF LOAD
          SA0    X1+         FWA OF MEMORY ALLOCATION
 
*         ALLOCATE TABLES FOR *CRM*.
 
 CRM11    SX7    A0          FWA OF AVAILABLE MEMORY
          SB5    B0          PROCESS *CRM* STATEMENT
          SA7    TTIP+TIAM
          SB2    TTIP        FWA OF TABLE OF PARAMETERS
          EQ     CRM1        PROCESS TABLES FOR *CRM* STATEMENT
 
 CRM12    RJ     RBL         REPORT *BFL* INFORMATION
          EQ     DIE41       REPORT NOT ENOUGH FL FOR *CMM*
 
 CRM13    RJ     RBL         REPORT *BFL* INFORMATION
          EQ     DIE69       REPORT *BFL* NOT LARGE ENOUGH
*         LEGAL MODES FOR *CRM*.
 
 CRMB     VFD    12/1LR,3/PTRD,12/1LW,3/PTWR,12/1LM,3/PTMD
          VFD    12/2LRM,3/PTRM
 CRMC     FILEC  IBUF,IBUFL,FET=13,EPR  FET FOR *CRM* DATA BASE FILE
 CRMD     BSS    1           ATTACH MODE
 CRMF     LDREQ  BEGIN,LAST,IFL=,0,0
          LDREQ  MAP,BSEX,MAP
 CRMG     LDREQ  LOAD,(HASH/R)
          LDREQ  SATISFY
 CRMH     LDREQ  ENTRY,(HASH) HASH ENTRY POINT
          LDREQ  END
 CRMI     CON    0           BIT MAP OF FILE ORGANIZATIONS
 CRMJ     DATA   C* XXXXXXX FILE DOWN DUE TO ATTACH ERROR.*
 CRMK     BSSZ   4           ASSEMBLY AREA FOR *CRMJ*
 CTW      SPACE  4,10
**        CTW - CHARACTERS TO WORDS.
*
*         ENTRY  (X7) = LENGTH IN CHARACTERS.
*
*         EXIT   (X1) = LENGTH IN WORDS.
*                (X6) = REMAINDER IN CHARACTERS.
*
*         USES   X - 1, 4, 5, 6.
*                B - 7.
 
 
 CTW      SUBR               ENTRY/EXIT
          SX6    10          CHARACTERS PER WORD
          PX4    X7          COMPUTE LENGTH IN WORDS
          PX5    X6
          NX6    X5
          FX4    X4/X6
          UX6,B7 X4
          LX1    B7,X6
          PX6    X1          COMPUTE REMAINDER
          DX4    X6*X5
          UX6    X4
          IX6    X7-X6       REMAINDER
          EQ     CTWX        RETURN
 IXN      SPACE  4,20
**        IXN - PROCESS IXN PARAMETERS.
*
*         ENTRY  (B7) = FWA FOR UNPACKING PARAMETERS.
*                (A0) = CURRENT MEMORY LOCATION.
*                (A5) = ADDRESS OF FIRST WORD.
*                (X5) = FIRST WORD OF COMMAND.
*
*         EXIT   TO *DIE11*, IF ERROR ON *IXN* STATEMENT ARGUMENTS.
*                TO *DIE12*, IF ATTACH ERROR ON INDEX FILE.
*                TO *DIE29*, IF INCORRECT FILE NAME.
*                TO *DIE47*, IF INCORRECT NUMBER OF ALTERNATE KEYS.
*                (A0) = CURRENT MEMORY LOCATION.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 2, 4, 5, 6.
*
*         CALLS  CER, CRM, DXB, UPC.
*
*         MACROS ATTACH, STATUS.
 
 
 IXN      SUBR               ENTRY/EXIT
          RJ     UPC         UNPACK COMMAND
          NZ     X6,DIE11    IF ERROR IN ARGUMENTS
 
*         PROCESS FILE NAME.
 
          SA1    TL
          LT     B6,B1,DIE29 IF NO FILE NAME
          SA2    B7+B1       FILE NAME FROM *IXN* STATEMENT
          MX6    12          MASK FOR DATA BASE
          BX1    X6*X1       DATA BASE
          BX3    X6*X2       DATA BASE OF FILE
          IX3    X3-X1
          BX7    X2
          NZ     X3,DIE29    IF INCORRECT DATA BASE
          SA7    TTIP+TIXN
          SX3    B1
          BX7    X7+X3
          SA7    CRMC        PUT LOGICAL FILE NAME IN FET
          MX0    -48
          SA1    A7+B1
          BX6    -X0*X1
          MX7    0           CLEAR PACKNAME IN FET
          SA6    A1          CLEAR DEVICE
          SA7    CRMC+CFPK
          SA7    TTIP+TIHR   ZERO FILE NAME OF HASHING ROUTINE
 
*         PROCESS NUMBER OF ALTERNATE KEYS.
 
          SB6    B6-2
          LT     B6,DIE47    IF NO NUMBER OF ALTERNATE KEYS
          SA5    A2+B1
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,DIE47    IF INCORRECT NUMBER
          ZR     X6,DIE47    IF NUMBER OF ALTERNATE KEYS .EQ. ZERO
          SA6    TTIP+TINK
          SA6    XXJS        NUMBER OF ALTERNATE KEYS
 
*         PROCESS PACKNAME.
 
          SB6    B6-B1
          SA5    A5+B1
          LE     B6,IXN2     IF NO MORE PARAMETERS
          BX6    X5
          ZR     X5,IXN1     IF NO PACKNAME
          SA6    CRMC+CFPK
 
*         PROCESS DEVICE.
 
 IXN1     LT     B6,B1,IXN2  IF NO MORE PARAMETERS
          SA5    A5+B1
          MX0    12
          BX5    X0*X5
          SA1    CRMC+1
          BX6    X5+X1
          SA6    A1+
 
 
*         CHECK IF FILE AT CONTROL POINT.
 
 IXN2     SB4    CRMC        FWA OF FET
          STATUS B4
          SA1    B4          FET STATUS
          MX6    11
          LX1    59-11
          BX6    X6*X1
          NZ     X6,IXN3     IF FILE AT CONTROL POINT
 
*         ATTACH *IXN* INDEX FILE.
 
          SA2    XXJD+2      USER NAME
          MX0    42
          BX0    X0*X2
          ATTACH B4,,X0,,CRMD
          RJ     CER         CHECK ERRORS
          ZR     X1,IXN3     IF NO ATTACH ERROR
          SX6    B1+
          SA6    TTIP+TIAE   SET ATTACH ERROR
          SA1    CRMC        GET FILE NAME
          MX0    42
          BX1    X0*X1
          SB2    1RX         SUBSTITUTION CHARACTER
          SB5    -CRMJ       ERROR MESSAGE
          SB3    CRMK        ERROR MESSAGE ASSEMBLY AREA
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE CRMK,3     PUT MESSAGE IN DAYFILE
 
*         ALLOCATE TABLES FOR MIPPED FILE.
 
 IXN3     MX7    0
          SA7    TTIP+TIKO   INITIALIZE KEY ORDINAL
          SX7    A0          FWA OF AVAILABLE MEMORY
          SB5    B1+B1       PROCESS *IXN* STATEMENT
          SA7    TTIP+TIAM
          SB2    TTIP        FWA OF TABLE OF PARAMETERS
          RJ     CRM         INITIALIZE MIPPED FILE TABLES
          EQ     IXNX        NORMAL RETURN
 RMK      SPACE  4,15
**        RMK - PROCESS *RMKDEF* STATEMENTS.
*
*         ENTRY  (XXJS) = NUMBER OF ALTERNATE KEYS.
*
*         EXIT   TO *DIE11*, IF ARGUMENT ERROR.
*                TO *DIE68*, IF *RMKDEF* ERROR.
*                (X1) .NE. 0, IF NO MORE ENTRIES IN *XXJ* FILE.
*
*         USES   X - 1, 3, 5, 6.
*                A - 3, 5, 6.
*                B - 2, 7.
*
*         CALLS  DXB, UPC.
*
*         MACROS READC.
 
 
 RMK3     SA5    XXJS        NUMBER OF ALTERNATE KEYS
          NZ     X5,DIE68    IF *RMKDEF* STATEMENT ERROR
 
 RMK      SUBR               ENTRY/EXIT
 RMK1     READC  TL,XXJA,8   READ STATEMENT FROM *XXJ* FILE
          SB7    XXJP
          NZ     X1,RMK3     IF EOF
          SA5    XXJA
          RJ     UPC         UNPACK CONTROL STATEMENT
          NZ     X6,DIE11    IF UNPACK ERRORS
          SX1    X6
          SA5    B7
          MX3    42
          BX5    X3*X5
          SA3    RMKA
          BX3    X3-X5
          NZ     X3,RMK3     IF NOT *RMKDEF* STATEMENT
          SB2    4
          LE     B6,B2,RMK2  IF NO KEY LENGTH SPECIFIED
          SA5    B7+B2       KEY LENGTH
          RJ     DXB         CONVERT KEY LENGTH
          NZ     X4,DIE11    IF ERROR IN *RMKDEF* STATEMENT
          ZR     X6,RMK1     IF KEY LENGTH IS ZERO (SPARSE KEY)
 RMK2     SA5    XXJS
          SX6    X5-1        DECREMENT *RMKDEF* STATEMENT COUNT
          SA6    A5+
          EQ     RMK1        PROCESS NEXT STATEMENT
 
 
 RMKA     VFD    60/6LRMKDEF
          TITLE  TOTAL INTERFACE ROUTINES.
 IEOQ     SPACE  4,10
**        IEOQ - INITIALIZATION ENTER OUTPUT QUEUE.
*                DUMMY ROUTINE FOR TOTAL DURING INITIALIZATION.
 
 
 IEOQ     SUBR               ENTRY/EXIT
          EQ     IEOQX       RETURN
 IFAR     SPACE  4,10
**        IFAR - INITIALIZATION FILE ATTACH ROUTINE.
*                ATTACH FILES FOR TOTAL DURING INITIALIZATION.
*                IF FILE IS XXTLOG AND DOES NOT EXIST IT IS DEFINED.
*                THE XXTLOG FILE IS POSITIONED AT EOI.
*
*         ENTRY  (X2) = ADDRESS OF FILE NAME TO ATTACH.
*
*         EXIT   (X6) = 0 ATTACH WAS OKAY.
*                (X6) " 0 ERROR CODE.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 4, 6.
*                B - 1, 7.
*
*         CALLS  PFM=, CIO=.
 
 
 IFAR     SUBR               ENTRY/EXIT
          SA1    X2          FILE NAME TO ATTACH
          SB1    1
          MX0    42
          SX6    1
          BX1    X0*X1
          BX6    X6+X1
 
*         FIND FILE IN EDT AND PLACE PACK INFORMATION IN THE FET.
 
          SA2    SCHEMA
          SA6    IFARB
          SB7    X2-2*TMAXFIL-2  ADDRESS OF FIRST FILE NAME
 IFAR1    SA2    B7          FILE NAME
          SB7    B7+TFEN
          BX6    X1-X2
          ZR     X2,IFARX    IF FILE NAME NOT FOUND
          NZ     X6,IFAR1    IF NOT CORRECT FILE NAME
          MX7    48
          SA1    B7-B1       PACKNAME FOR FILE
          LX7    6
          BX6    X7*X1
          LX1    -6
          SA6    IFARB+CFPK  PACK NAME AND UNIT INTO FET
          MX4    -12
          SA2    IFARB+1
          BX4    -X4*X1      DEVICE TYPE
          MX7    -48
          LX4    -12
          BX2    -X7*X2
          IX6    X2+X4
          SA6    A2          DEVICE TYPE TO FET
          STATUS IFARB       CHECK IF FILE EXISTS
          SA1    IFARB
          MX6    11
          LX1    59-11
          BX3    X6*X1
          BX6    X6-X6
          NZ     X3,IFARX    IF FILE EXISTS
          ATTACH IFARB,,,,M
          SA1    X2          CHECK FOR ATTACH ERROR
          MX7    24
 
*         CHECK IF FILE IS XXTLOG.
 
          SA4    IFARA
          LX1    12          REMOVE TWO CHARACTER DATA BASE NAME
          MX0    -6
          BX5    X7*X1
          LX1    -12-10
          BX4    X4-X5
          BX6    -X0*X1
          NZ     X4,IFARX    IF NOT XXTLOG FILE
 
*         ATTACH XXTLOG FILE IN WRITE MODE.
 
          ATTACH IFARB,,,,W
          SA1    IFARB
          LX1    -10
          BX6    -X0*X1
          NZ     X6,IFAR2    IF ATTACH ERROR ON XXTLOG
          SKIPEI X2,R        POSITION XXTLOG AT EOI
          BX6    X6-X6       INDICATE NO ERRORS
          EQ     IFARX       RETURN
 
 IFAR2    SX5    X6-2
          NZ     X5,IFARX    IF NOT *FILE NOT FOUND*
          DEFINE X2
          SA4    IFARB       CHECK FOR ERROR ON DEFINE
          AX4    10
          BX6    -X0*X4
          EQ     IFARX       RETURN
 
 
 IFARA    VFD    60/0LTLOG
 IFARB    FILEC  IBUF,IBUFL,FET=13,EPR
 IGRA     SPACE  4,10
**        IGRA - INITIALIZATION GET REFERENCE ADDRESS.
*         RETURN THE RA, FL AND DATA BASE ID FOR TRANEX1.
*
*         ENTRY  (X1) = SUB CONTROL POINT NUMBER.
*
*         EXIT   (X5) = 0 (DATA BASE ID).
*                (X7) = FFL= (FL).
*                (X6) = 0 (RA).
*
*         USES   X- 5, 6, 7.
 
 
 IGRA     SUBR               ENTRY/EXIT
          BX5    X5-X5       DATA BASE ID
          BX6    X6-X6       RA
          SX7    FFL=        FL FOR INITIALIZATION
          EQ     IGRAX       RETURN
 IRIQ     SPACE  4,10
**        IRIQ - INITIALIZATION RETURN INPUT QUEUE.
*                RETURN AN INPUT QUEUE ENTRY TO TOTAL.
*
*         EXIT   (X6) = 0 - QUEUE IS EMPTY.
*                (X6) = QUEUE ENTRY.
*
*         USES   X - 1, 7.
*                A - 1, 7.
 
 
 IRIQ     SUBR               ENTRY/EXIT
          SA1    IRIQA       QUEUE ENTRY
          BX7    X7-X7
          BX6    X1
          SA7    A1          CLEAR ENTRY
          EQ     IRIQX       RETURN
 
 
 IRIQA    BSSZ   1           QUEUE ENTRY
          TITLE   LOADER= - INTERFACE TO LOADU.
 LOADER=  SPACE  4,10
**        LOADER= IS THE INTERFACE NEEDED TO CALL LOADU
*         FROM THE LOADER MACRO.
*
*         EXIT   DOES NOT RETURN FROM LDV CALL.
*                RETURN IS TO CALLING ADDRESS +2.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  SYS=.
 
 
 LOADER=  SUBR               ENTRY
          SA1    LOADER=
          LX1    30
          SX2    B1          ADVANCE THE RETURN ADDRESS
          SA3    X1
          IX7    X1+X2
          SX4    X7
          SA5    X3          FIRST WORD OF PARAMETER LIST
          SA0    IFL=        TRANEX1 FIELD LENGTH
          SB3    X5          LWA+1 OF LOADABLE AREA
          AX5    30
          MX0    -12
          SX5    X5
          SB5    X3+3
 
*         DETERMINE LWA+1 OF PARAMETER AREA.
 
 LOA1     SA1    B5          GET HEADER OF NEXT REQUEST
          LX1    -36
          BX2    -X0*X1      LENGTH OF REQUEST
          SX2    X2+B1
          SB5    B5+X2       NEXT PARAMETER ADDRESS
          NZ     X1,LOA1     IF NOT END OF PARAMETER AREA
 
*         PUT PARAMETERS IN REGISTERS FOR LOADU
*
*                (A0) = CM FIELD LENGTH.
*                (X0) = EXTENDED MEMORY FIELD LENGTH.
*                (B7) = FWA OF LOADABLE AREA. THIS IS THE ADDRESS
*                       WHERE LOADU IS LOADED.
*                (X6) = BITS  0-17 - FWA OF USER-CALL PARAMETER AREA.
*                            18-35 - LWA+1 OF USER-CALL PARAMETER AREA.
*                            36-53 - ADDRESS FOR LOADU TO RETURN TO.
*
 
          BX0    X0-X0       NO EXTENDED MEMORY FIELD LENGTH FOR LOAD
          SX6    B5          LWA OF REQUEST LIST
          SX7    X3          FWA OF REQUEST LIST
          LX4    36
          LX6    18
          BX6    X4+X6
          BX6    X6+X7
 
*         CALL LDV TO LOAD AND EXECUTE LOADU.
 
          SA1    LOAB        NAME OF LOADER OVERLAY
          SB7    X5          FWA OF LOADABLE AREA
          SX3    B3          LWA+1 OF LOAD
          SX4    141B        U-BIT, V-BIT, E-BIT
          BX7    X1
          SA7    LOAC        FIRST WORD OF LIST
          LX3    18
          LX4    36
          BX3    X3+X5
 
*         FORM LDV CALL WORD AND CALL LDV.
 
          SA1    LOAA
          BX7    X3+X4
          SX2    A7
          SA7    A7+B1       STORE THE SECOND WORD OF LIST
          BX7    X1+X2       LDV CALL
 LOA2     SA1    B1
          NO
          NZ     X1,LOA2     IF SYSTEM REQUEST NON ZERO
          SA7    A1          CALL LDV
 LOA3     NO
          NO
          EQ     LOA3        WAIT FOR LDV TO DROP CPU
 
 
 LOAA     VFD    18/0LLDV,42/0
 LOAB     VFD    60/0LLOADU
 LOAC     BSSZ   2           PARAMETER AREA FOR LDR CALL
                             AREA CURRENTLY BEING PROCESSED
 
          SEG
          SPACE  4,10
***       COMMON DECKS USED IN INITIALIZATION.
 
 
*CALL     COMCARG
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCOVL
*CALL     COMCPFM
*CALL     COMCRDC
*CALL     COMCRDO
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCUPC
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMKTIP
*CALL     COMKZFN
 BUFFERS  SPACE  4
*         INITIALIZATION FILE BUFFERS
 
 RBUFL    EQU    201B
 RBUF     BSS    RBUFL       *TAF* INITIALIZATION FILE BUFFER
 
 HBUFL    EQU    MAXDB       BUFFER FOR *TAF* DATA BASES
 HBUF     BSS    HBUFL
 
 THBUFL   EQU    MAXDB       BUFFER FOR *TOTAL* DATA BASES
 THBUF    BSS    THBUFL
 
 CBUFL    EQU    MAXDB       BUFFER FOR *CRM* DATA BASES
 CBUF     BSS    CBUFL
 
 OTBUFL   EQU    MAXDB       BUFFER FOR OTHER DATA BASES
 OTBUF    BSS    OTBUFL
 
 TCBUFL   EQU    HBUFL+THBUFL+CBUFL+OTBUFL
 TCBUF    BSS    TCBUFL      BUFFER FOR TCF
 
 LBUFL    EQU    101B
 LBUF     BSS    LBUFL
 
 IBUFL    EQU    401B
 IBUF     EQU    *           COMMON BUFFER FOR INITIALIZATION FILE WORK
 
          SPACE  4,10
 FFL1     EQU    *           END OF *TAF1*
 
 .FFL     MAX    IBUF+IBUFL+10B,FFL1
 FFL=     EQU    .FFL        FL REQUIRED FOR *TAF* *RFL*
          QUAL   *
 "PROD"2  TTL    "PROD"2 END/RECOVERY PROCESSOR - VER "VERT".
          EJECT
          QUAL   "PROD"2
          IDENT  "PROD"2,REC,REC,1,0          END/RECOVERY.
*COMMENT            TAF - END/RECOVERY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       TRANSACTION EXECUTIVE END/RECOVERY PROCESSOR.
*         J. R. HOGUE  72/05/06.
          SPACE  4
***       *TAF2* DOES THE END/RECOVERY PROCESSING FOR TAF.
*         THIS INCLUDES
*         1) FLUSHING BUFFERED JOURNAL FILES
*         2) ISSUING STATISTICS TO THE DAYFILE
*         3) CLOSING THE CRM DATA BASE FILES.
*         4) CLOSING THE AFTER IMAGE RECOVERY FILES IF THEY EXIST.
*         5) CLOSING THE TAF COMMUNICATION RECOVERY FILE(S).
*
*         TO RESTART TAF IN RECOVERY MODE, SENSE SWITCH 3 MUST BE *ON*.
*         *TAFREC* WILL THEN USE THE VALUES IN THE RECOVERY FILE
*         INSTEAD OF USING WHAT WAS SPECIFIED ON THE *TCF*.
          SPACE  4
***       EXTERNAL DECISION KEYS
*
*         SW4    IF SET - RESTART TRANEX AFTER A RECOVERY.
*         SW5    IF SET - CALL *DMD* AND *OUT*, AFTER AN ABORT OR DROP.
 REC      TITLE  END/RECOVERY DRIVER.
**        REC    DETERMINES RECOVERY OPTIONS BY EXAMINING THE SENSE
*                SWITCHES AND EXECUTES THE APPROPRIATE ROUTINES.
 
 
          ORG    TRFL
 REC      SB1    1
          MESSAGE RMES1,,R   *RECOVERY IN PROGRESS.*
          BX6    X6-X6
          SA6    B1+B1
          SA0    REC1        ERROR RETURN ADDRESS FOR *ERP$*
          MEMORY ECS,2,R,,NABORT
          STATUS  TIF        INITIALIZATION FILE
          SA1    X2
          MX6    11
          LX1    59-11
          BX1    X6*X1
          NZ     X1,REC2     IF INITIALIZATION FILE PRESENT
 REC1     MESSAGE RMES2      RECOVERY IMPOSSIBLE
          ENDRUN
 
 REC2     REWIND  TIF
          SA1    VFSCP       SAVE LAST VFSCP
          BX6    X1
          SA6    RECA
          READ   TIF
          READW  TIF,RECB,1  READ *TIF* STATUS WORD
          READW  TIF,VLOCS,VLOCL
          SA2    VINT        TRANEX1 COMPLETE FLAG
          SA1    TROA
          ZR     X2,REC1     IF TRANEX1 WAS NOT COMPLETE
          SA2    RECA        FWA OF SUB-CONTROL POINTS
          BX6    X2
          SA6    VFSCP
          ZR     X1,REC3     TRANEX NOT ROLLED OUT
          SA1    TROB+1      SET FIRST/IN/OUT/LIMIT TO USE SCRATCH AREA
          SX6    RBUF
          MX4    42
          SA6    A1+B1       IN
          BX1    X4*X1
          BX7    X1+X6
          SA6    A6+B1       OUT
          SA2    A6+B1
          SA7    A1          FIRST
          SX6    RBUF+RBUFL-1
          BX2    X4*X2
          BX7    X2+X6
          SA7    A2          LIMIT
          REWIND TROB,R      REWIND ROLLOUT FILE
          READ   TROB        INITIATE READ
          READW  TROB,ROFL,ROFL-TRFL  THROW AWAY FL WHICH RECOVERY USES
          SA5    CURFL       CURRENT FL
          SX0    X5+
          READW  TROB,ROFL,X0-ROFL    LOAD FL AFTER RECOVERY OVERLAY
 REC3     RJ     CSC         CHECK SUBCONTROL POINTS
          SA5    B0
          LX5    59-11       POSITION TO SENSE SWITCH 6
          PL     X5,REC4     IF SENSE SWITCH 6 SET
          WRITER OUTPUT,R
 
*         WRITE TERMINATION FLAG ON *CRF* FILE.
 
 REC4     RJ     TTR         TERMINATE COMMUNICATIONS RECOVERY FILES
 
*         FORCE TOTAL TO FLUSH BUFFERS.
 
          SA1    VTOT        READ TOTAL INITIALIZATION FLAG
          SA2    REC5        MODIFY CALL TO TOTAL
          ZR     X1,REC7     IF TOTAL WAS NOT LOADED
          LX1    30
          MX0    18
          LX0    -12
          BX6    -X0*X2
          BX6    X1+X6
          SA6    A2
          RJ     *           VOID THE INSTRUCTION STACK
 
*         PUT ENTRY INTO TOTAL INPUT QUEUE
 
          SA1    TDI+1       FIRST
          SA3    TQUE        QUEUE ENTRY
          SX6    X1+B1
          BX7    X1
          SA6    A1+B1       IN
          BX6    X3
          SA7    A6+B1       OUT
          SA6    X7          PUT INTO QUEUE
 REC5     RJ     REC5        CALL TOTAL
*         RJ     =XTOTAL     (CALL TOTAL)
          SA1    STATUS
          SA2    OSTAT       CHECK FOR TOTAL DONE ON FINAL CALL
          SB1    1
          BX3    X2-X1
          NZ     X3,REC6     IF TOTAL DONE
          RECALL
          EQ     REC5        TRY AGAIN
 
 REC6     SA2    STAT
          BX3    X2-X1
          BX6    X1
          ZR     X3,REC7     IF TOTAL RECOVERED
          SA6    RMEST2+1
          MESSAGE RMEST1,,R  RECOVERY OF TOTAL FAILED
          MESSAGE RMEST2,,R  TOTAL STATUS
 
*         CLOSE *CRM* FILES.
 
 REC7     SA1    VAAM        AAM INITIALIZATION FLAG
          ZR     X1,REC8     IF AAM WAS NOT LOADED
          RJ     CCF         CLOSE *CRM* FILES
 REC8     RJ     CAS         CHECK FOR ASSIGNED EQUIPMENT
          RJ     RJF         RECOVER JOURNAL FILES
 
          RJ     IDS         ISSUE DAYFILE STATISTICS
          MESSAGE RMES3,,R   RECOVERY COMPLETE
          SA1    B0
          LX1    -6-4        SW4
          PL     X1,REC9     IF NOT TO RESTART TRANEX
          ENDRUN
 REC9     MESSAGE RMES4      NORMAL TERMINATION
          ENDRUN
 
 RECA     BSS    1           FWA OF SUB-CONTROL POINTS
 RECB     BSS    1           *TIF* STATUS WORD
 
 
 TIF      BSS    0           *TAF* INITIALIZATION FILE
 "TIF"    FILEB  RBUF,RBUFL
 
 O        BSS    0           OUTPUT DUMP FILE
 OUTPUT   FILEB  RJF,1,FET=10
 CAS      SPACE  4
**        CAS    CHECK FOR ASSIGNED EQUIPMENT
*                IF A TAPE UNIT(S) HAS BEEN ASSIGNED VIA THE K-DISPLAY
*                AS A POOL UNIT FOR JOURNAL FILES, SET UP FOR USE IF
*                TAPE PARITY ERROR OR END OF REEL PROCESSING BECOMES
*                NECESSARY DURING BUFFERED JOURNAL FILE CLEAN UP
 
 
 CAS      PS
          REWIND SCR,R       SCRATCH FILE NUMBER 1
          SA1    X2+4
          BX4    X4-X4
          MX6    12
          BX6    X6*X1
          ZR     X6,CAS1     IF FILE NOT PRESENT
          SX4    X2
 CAS1     REWIND SCR1,R      CHECK SCRATCH FILE  2
          SA1    X2+4
          MX6    12
          BX6    X6*X1
          ZR     X6,CAS2     IF FILE NOT PRESENT
          LX4    18
          BX4    X4+X2
 CAS2     BX6    X4
          SA6    ASEQ        ASSIGNED EQUIPMENT WORD
          JP     CAS         *RETURN
 
 CCF      SPACE  4,15
**        CCF - CLOSE *CRM* FILES.
*
*         ENTRY  (VAAQ) = FWA OF QUEUE.
*                (X1) = ENTRY POINT FOR *AMI*.
*
*         EXIT   FILES ARE CLOSED.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 5, 6, 7.
*
*         CALLS  AMI, CFD, SFN, SNM.
*
*         MACROS MESSAGE.
 
 
 CCF      SUBR               ENTRY/EXIT
          SX6    B1          BUILD *RJ  =XAMI* INSTRUCTION
          LX6    24-0
          SX1    X1+         *AMI* ENTRY POINT.
          BX6    X6+X1
          LX6    30
          SA6    CCFA
          RJ     *           VOID THE INSTRUCTION STACK
 
*         PLACE RECOVERY ENTRY INTO AAM INPUT QUEUE.
 
 CCF1     SA1    VAAQ        FWA OF FET FOR INPUT QUEUE
          SA3    CCFB        RECOVERY REQUEST
          LX1    17-41
          SA1    X1+B1       FIRST WORD OF QUEUE
          SX6    X1+B1
          SA6    A1+B1       IN
          BX7    X1
          BX6    X3
          SA7    A6+B1       OUT
          SA6    X7          REQUEST INSERT IN QUEUE
          MX7    1           SET FLAG IN *AMST* TO INDICATE IDLE
          LX7    58-59
          SA1    VAAM
          SA7    X1-2
 CCF2     BSS    0
 CCFA     RJ     0           MODIFIED BY *CCF*
*         RJ     =XAMI       CALL ADVANCED ACCESS METHODS INTERFACE
          SA2    CCFC        D.B./FILE NAME
          MX1    12
          MX6    42
          BX1    X1*X2
          BX5    X6*X2
          LX2    59
          BX1    X1-X5
          PL     X2,CCF2     IF INCOMPLETE REQUEST
          ZR     X5,CCF4     IF NO MORE DATA BASES
          SX5    CCFD        ADDRESS OF THE COUNTERS
          SB7    CCFFL       NO. OF COUNTERS TO PROCESS
          SB6    CCFO
          ZR     X1,CCF3     IF DATA BASE COUNTERS
          SB7    CCFGL       ADJUST FOR FILE COUNTERS
          SB6    CCFK
 CCF3     SA1    X5+
          RJ     CFD
          SA6    CCFR        CONVERTED COUNTER
          SB2    1RX         SUBSTITUTE CHARACTER
          SB3    CCFS        MESSAGE ASSEMBLY AREA
          SA1    CCFC        D.B./FILE NAME
          SB5    -B6
          RJ     SNM
          SB7    B7-B1
          SX5    X5+B1
          SB6    B6+CCFQL
          MESSAGE CCFR
          NE     B7,CCF3     IF NOT ALL COUNTERS PROCESSED
          EQ     CCF1        ASK FOR NEXT FILE
 
 CCF4     MESSAGE CCFT
          EQ     CCFX        RETURN
 
 CCFB     VFD    24/0,6/0,6/TRTC,1/1,5/0,18/CCFC  RECOVERY REQUEST
 CCFC     BSS    1           FILE NAME OR DATA BASE NAME
 CCFD     BSS    1           NUMBER OF OPENS OR BEGINS
 CCFE     BSS    1           NUMBER OF OPEN REJECTS OR COMMITS
 CCFF     BSS    1           NUMBER OF LOCKS OR FREES
 CCFFL    EQU    *-CCFD
 CCFG     BSS    1           NUMBER OF LOCK REJECTS
 CCFGL    EQU    *-CCFD
 
 CCFK     DATA   C* KILO OPENS - XXXXXXX.       *
 CCFL     DATA   C* KILO OPEN REJECTS - XXXXXXX.*
 CCFM     DATA   C* KILO LOCKS - XXXXXXX.       *
 CCFN     DATA   C* KILO LOCK REJECTS - XXXXXXX.*
 CCFO     DATA   C* KILO BEGINS - XX.           *
 CCFP     DATA   C* KILO COMMITS - XX.          *
 CCFQ     DATA   C* KILO FREES - XX.            *
 CCFQL    EQU    *-CCFQ
 
 CCFR     BSS    1
 CCFS     BSS    CCFQL
 
 CCFT     DATA   C* AAM FILES CLOSED.*
 ASEQ     BSSZ   1           ASSIGNED EQUIPMENT WORD
 
 SCR      BSS    0           TAPE POOL EQUIPMENT ASSIGNMENT FILE 1
 SCR      RFILEB SCRB,SCRBL,FET=14
 
 SCR1     BSS    0           TAPE POOL EQUIPMENT ASSIGNMENT FILE 2
 SCR1     RFILEB SCRB,SCRBL,FET=14
 
 SCRBL    EQU    2001B       DUMMY LENGTH FOR SCR(1) FET
 SCRB     EQU    101B        DUMMY ADDRESS FOR SCR(1) FET
 CSC      SPACE  4,15
**        CSC - CHECK SUBCONTROL POINTS.
*
*         SEARCH ALL SUBCONTROL POINTS BEYOND *ITASK* TO CLEAR THE
*         STORAGE LOCK FLAG AND SET THE RELEASABLE
*         FLAG IN THE SUBCONTROL POINT TABLE.
*         *AVAILCM* AND *ITASK-S* SUBCONTROL POINT FREE SPACE IS
*         UPDATED.
*
*         ENTRY  (VCPA) = FWA OF SUBCONTROL POINT TABLE.
*
*         EXIT   ALL SUBCONTROL POINT TABLE ENTRIES UPDATED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 CSC2     SA4    A4-SCNSW    GET *ITASK-S* SUBCP TABLE
          LX4    SCFCN-SCFCS-1  RIGHT JUSTIFY *ITASK-S* FREE SPACE
          SA2    AVAILCM
          IX6    X4+X1       UPDATE *ITASK-S* FREE SPACE
          IX7    X2+X1       UPDATE *AVAILCM*
          LX6    SCFCS-SCFCN+1
          SA7    A2
          SA6    A4+
 
 CSC      SUBR               ENTRY/EXIT
          SA2    VCPA        GET FWA OF SUBCONTROL POINT
          LX2    -24
          SA2    X2
          SA4    A2+SCNSW    GET FWA OF SUBCP AFTER *ITASK*
          MX5    -SCFLN
          BX1    X1-X1
          SX2    X4+         FWA OF NEXT SUBCP
 CSC1     ZR     X2,CSC2     IF DONE SEARCHING SUBCP TABLE
          MX0    -59
          SA3    X2
          BX6    -X0*X3      CLEAR STORAGE LOCK FLAG
          LX0    SCRLS-59
          LX3    SCFLN-1-SCFLS
          BX4    -X5*X3      GET TASK FL
          SX4    X4+NUAPL    ADD SYSTEM AREA
          IX1    X1+X4
          BX7    X0+X6       ADD RELEASE SUBCONTROL POINT FLAG
          SA3    A3+SCNSW    GET NEXT SUBCP ADDRESS
          SA7    X2          UPDATE FWA OF SUBCP TABLE
          SX2    X3
          EQ     CSC1        CONTINUE SEARCH AT NEXT SUBCP
 RJF      SPACE  4
**        RJF    CHECKS JOURNAL FILE FETS AND ISSUES A *WRITER* FOR
*                EACH BUFFERED JOURNAL FILE.
 
 
 RJF      PS
          MEMORY CM,RJFC,R   GET CURRENT FIELD LENGTH
          SB6    RJF1        RETURN ADDRESS
          SA1    JOUR0+1     FIRST
          SB3    B1+B1
          EQ     RJF4        CHECK JOUR0 FET FOR LEGALITY
 
 RJF1     WRITEF JOUR0,R     FLUSH JOUR0
          SA1    VEDT
          LX1    -24
          SA2    X1          EDT HEADER WORD 1
          SX1    X1+1
          LX2    -18
          SX0    X2          EDT COUNT
 RJF2     ZR     X0,RJF      IF ALL EDT-S PROCESSED
          SA3    X1+
          LX3    -18
          SB5    X3-JFETL    ADDRESS OF FIRST JOURNAL FILE - JFETL
          MX6    -6
          LX3    -36
          BX3    -X6*X3
          SB4    X3          JOURNAL COUNT FOR THIS EDT
          SA1    A3-B1       HEADER WORD 1
          SX6    X1+1        ADDRESS OF EDT HEADER WORD 2
          SX0    X0-1        DECREMENT EDT COUNT
          SA6    RJFB        UPDATE EDT POINTER
 RJF3     SA1    RJFB        ADDRESS OF NEXT EDT
          ZR     B4,RJF2     IF DONE WITH THIS EDT
          SB5    B5+JFETL    BUMP FET POINTER FOR JOURNAL FILES
          SB3    B1+B1
          SB4    B4-B1       DECREMENT JOURNAL FILE COUNT
          SA2    B5+7        JOURNAL STATUS WORD
          SA1    B5+B1       FIRST
          LX2    -1
          NG     X2,RJF3     IF NOT BUFFERED JOURNAL FILE
          SB6    RJF6        RETURN ADDRESS
 RJF4     SA4    RJFC        CURRENT FIELD LENGTH
          SX6    JBUF0-1     LOWER LEGAL LIMIT
          LX4    30
          SX7    X4          UPPER LEGAL LIMIT
 
*         CHECK FET FOR VALIDITY
 
 RJF5     SA2    A1+B1
          SB3    B3-B1
          SX1    X1
          SX2    X2
          IX3    X1-X6
          IX4    X2-X6
          NG     X3,RJF3     IF FET ARGUMENT ERROR
          NG     X4,RJF3     IF FET ARGUMENT ERROR
          IX3    X1-X7
          IX4    X2-X7
          PL     X3,RJF3     IF FET ARGUMENT ERROR
          PL     X4,RJF3     IF FET ARGUMENT ERROR
          SA1    A1+2
          NZ     B3,RJF5     IF OUT/LIMIT NOT CHECKED YET
          JP     B6          FET VALIDATED
 RJF6     SA1    B5
          SA2    RJFA        CHECK FILE NAME
          BX4    X1
          MX3    18
          LX1    12
          BX3    X3*X1       CHARS 3 THROUGH 5 OF JOURNAL FILES
          IX3    X3-X2
          NZ     X3,RJF3     IF NOT *XXJOR* TYPE FILE
          LX4    59
          PL     X4,RJF8     IF LAST REQUEST NOT COMPLETE
          SX2    B5+
 
*         FLUSH BUFFER
 
          SA0    RJF7        RETURN ADDRESS
          WRITEF B5+,R       WRITE FILE MARK
 RJF7     SA0    RJF3        LOOP FOR ALL JOURNAL FILES
          EQ     ERP$        CHECK FOR ABNORMAL STATUS
 
*         REISSUE THE *CIO* REQUEST.
*         ENTRY (B5) = FET ADDRESS.
 
 RJF8     SA1    B5+FEMGW
          LX1    59-FEMGS
          NG     X1,RJF3     IF TAPE
          SA1    B5+FECRW    GET CURRENT RANDOM ADDRESS
          ZR     X1,RJF9     IF *CIO* NOT PROCESSED
          BX7    X1
          SA7    B5+FERRW    RESET RANDOM ADDRESS
          SA2    B5
          SX6    B1          SET COMPLETION FLAG
          SA1    B5+FEOOW    GET OLD OUT POINTER
          BX6    X2+X6
          BX7    X1
          SA6    B5
          SA7    B5+FEOUW    RESET OUT
          REWRITEF  B5,R     REISSUE *CIO* REQUEST
          EQ     RJF3        CONTINUE WITH NEXT FILE
 
 RJF9     SX6    B1          SET COMPLETION FLAG
          SA1    B5
          BX6    X1+X6
          SA6    B5
          WRITEF B5,R        REISSUE *CIO* REQUEST
          EQ     RJF3        CONTINUE WITH NEXT FILE
 
 RJFA     VFD    60/0LJOR    CHARACTERS 3 THROUGH 5 OF JOURNAL FILES
 RJFB     DATA   0           EDT POINTER
 RJFC     BSSZ   1           CURRENT FIELD LENGTH
 TTR      SPACE  4,15
**        TTR - TERMINATE COMMUNICATIONS RECOVERY FILES.
*
*         ENTRY  (IDLA) = ZERO IF ABNORMAL TERMINATION.
*                (VTST) = FIRST WORD OF *TST*.
*
*         EXIT   *CRF* HEADER UPDATED.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 1, 2, 3, 4, 5, 6, 7.
*                B - 3.
*
*         CALLS  FIO.
*
*         MACROS CLOCK, DATE, RECALL, REWIND.
 
 TTR      SUBR               ENTRY/EXIT
.B        IFEQ   IPTAR,1
          DATE   TTRA        DATE OF TERMINATION
          CLOCK  TTRB        TIME OF TERMINATION
          SX7    -B1
          SA7    TTRC        FIRST *CRF*
 TTR1     SA2    VTST        GET FWA OF *TST* HEADER
          LX2    -24
          SB3    X2-TTFTL
          SA1    TTRC
          SX7    X1+1        INCREMENT *CRF* ID
          LX1    X7,B1       MULTIPLY BY TWO
          SX6    X7-MAXRC
          ZR     X6,TTRX     IF ALL *CRF-S* PROCESSED
          SA7    A1          UPDATE *CRF* ID
          SA4    X1+B3
          ZR     X4,TTR1     IF NO *CRF* TO PROCESS
          SX7    A4+
          SA7    TTRE        SAVE ID
          SX5    X4+TTFTW    FWA OF FET
          SA1    X5
          LX1    59-FECLS
          NG     X1,TTR2     IF LAST *CIO* REQUEST COMPLETED
          MX0    FECON+FEFTN
          LX0    FECOS-59
          LX1    59-59-59+FECLS
          BX2    X0*X1
          SX3    X2-CIORW
          NZ     X3,TTR2     IF NOT REWRITE
          MX0    8
          LX1    59-17
          BX1    X0*X1
          NZ     X1,TTR4     IF ERROR ON FILE
          SA2    X5+B1       GET RANDOM ADDRESS
          SA3    X2+TTRAW-TTBFW
          BX7    X3
          SX6    X2
          SA7    X5+FERRW    RESET RANDOM ADDRESS
          SA6    X5+3        RESET OUT
          SYSTEM CIO,R,X5    REISSUE REWRITE REQUEST
 TTR2     SX2    1R0
          SA4    TTRE        GET ID
          MX0    -TFIDN
          SA1    X4+B1
          LX1    TFIDN-TFIDS-1
          BX7    -X0*X1
          IX2    X2+X7       BINARY TO DISPLAY
          LX2    29-5        FORM FILE NAME - *ZZCRFI*
          MX6    30
          SA3    CRF
          BX3    X6*X3
          BX6    X3+X2       FORM FILE NAME - *CRFI*
          SX4    3
          BX6    X6+X4       ADD COMPLETE/BINARY BITS
          SA6    CRF
 
*         READ  *CRF* HEADER.
 
          SX5    CRF         FET ADDRESS
          SX1    CIORD       READ FUNCTION
          SX2    B1+         ONE PRU TO READ
          SX6    B1+         PRU ADDRESS
          RJ     FIO         INITIATE READ
          RECALL X5          WAIT FOR *CRF* I/O TO COMPLETE
          SA1    X5          CHECK ERROR STATUS
          MX2    8
          LX1    59-17
          BX1    X2*X1
          NZ     X1,TTR4     IF ERROR ON FILE
          MX2    60-TRRSN
          SA3    IDLA
          SA1    RBUF+TRNRW
          LX2    TRRSS-TRRSN+1
          BX7    X2*X1       CLEAR SHUTDOWN FLAG
          NZ     X3,TTR3     IF NORMAL SHUT DOWN
          BX2    -X2
          BX7    X2+X1       ADD ABNORMAL SHUTDOWN FLAG
 TTR3     SA7    A1
          SA1    TTRA        DATE
          SA2    TTRB        TIME
          BX6    X1
          BX7    X2
          SA6    RBUF+TRTDW  TERMINATION DATE
          SA7    RBUF+TRTTW  TERMINATION TIME
 
*         REWRITE THE *CRF* HEADER.
 
          SX1    CIORW
          SX2    B1          ONE PRU TO WRITE
          SX6    B1          PRU ADDRESS
          SX5    CRF         FET ADDRESS
          RJ     FIO         REWRITE THE HEADER
          RECALL CRF
          REWIND CRF,R
          EQ     TTR1        PROCESS NEXT *CRF*
 
*         ERROR ON FILE *CRF* ISSUE DAYFILE MESSAGE.
 
 TTR4     SB2    1RX
          SA1    CRF         FILE NAME
          MX0    42
          SB3    DAYB        DAYFILE BUFFER
          BX1    X0*X1
          SB5    -TTRD
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  DAYB      ISSUE DAYFILE MESSAGE
          EQ     TTR1        CONTINUE PROCESS *CRF* FILE
 
 TTRA     BSS    1           DATE OF TERMINATION
 TTRB     BSS    1           TIME OF TERMINATION
 TTRC     BSS    1           CURRENT *CRF* ID BEING PROCESSED
 TTRD     DATA   C* ERROR ON FILE - XXXX.*
 TTRE     BSS    1           TEMPORARY
.B        ELSE
          EQ     TTRX        RETURN
.B        ENDIF
 ERP      SPACE  4
**        ERP$   PROCESS READ/WRITE FILE ERRORS
*
*         ENTRY  (A0) = RETURN ADDRESS (NEGATIVE IF NO PROCESSING)
*                (X2) = FET ADDRESS
*                (X7) = CIO FUNCTION CODE (NEGATIVE IF WITH AUTO RECALL)
*                (B6) = FWA ADDRESS WORKING BUFFER
*                (B7) = NUMBER OF WORDS LEFT TO TRANSFER
*
*         USES   X - 1, 2, 3, 4, 6, 7
*                A - 1, 2, 3, 4, 6, 7
*                B - 3
 
 
 ERP5     SB3    A0
          JP     B3          *RETURN
 
 ERP$     BSS    0           ENTRY
          SA1    X2          GET ERROR CODE
          MX6    -4
          SB3    A0          CHECK FOR NON JOURNAL FILE ERROR
          LX6    10
          BX4    -X6*X1
          BX6    X6*X1       CLEAR OUT ERROR CODE
          PL     B3,ERP1     IF PROCESSING SELECTED
          SB3    -B3
          SX3    X4          ERROR CODE
          BX4    X4-X4
          SA0    B3          ERROR RETURN ADDRESS
 ERP1     SA6    A1
          ZR     X4,ERP5     IF NO ABNORMAL CONDITIONS
          SX3    B6
          SA5    A1+1
          PL     X5,ERP5     IF NOT A TAPE FILE
          SX6    B7
          SA7    ERPA+1      SAVE X7
          LX3    18
          SX1    6000B
          BX6    X3+X6       SAVE B6 AND B7
          BX1    -X1*X4
          NZ     X1,ERP5     IF OTHER THAN PARITY/END OF REEL ERROR
          SA6    ERPA
          SA1    X2+B1       FIRST
          SA3    A1+B1       SAVE IN AND OUT POINTERS
          SX6    X1
          SA4    A3+B1
          LX3    18
          SA6    A3          SET OUT = IN = FIRST
          BX7    X3+X4
          SA6    A4
          SA7    ERPB
          SA4    CIO=        CIO= RETURN ADDRESS
          UNLOAD X2,R        UNLOAD AND RETURN TAPE
          SA1    ASEQ
          BX7    X4
          MX6    36
          SA7    CIO=        RESTORE CIO= RETURN ADDRESS
          NZ     X1,ERP3     IF TAPE(S) PREASSIGNED
          SA1    X2
          SX3    100B+1RT
          LX3    -6          REASSIGN *TXXJORN* TO *XXJORN*
          BX6    X6*X1
          LX6    -6
          BX6    X6+X3       *TXXJORN*
          SA6    A1
          RENAME X2,X1       RENAME DISK JOURNAL FILE TO *XXJORN*
 ERP2     SA1    ERPB        RESTORE IN AND OUT
          SX6    X1
          LX1    -18
          SA6    X2+3        OUT
          SX7    X1
          SA7    A6-B1       IN
          SA4    CIO=
          WRITER X2,R        EMPTY BUFFER WITH EOR WRITE
          BX7    X4
          SA7    A4          RESTORE ORIGINAL CIO= EXIT ADDRESS
          SA1    ERPA
          SB7    X1          RESTORE B6 AND B7
          SA3    A1+B1
          LX1    -18
          SB6    X1
          BX7    X3          RESTORE X7
          JP     CIO=+1      RESTART CIO=
 
*         ASSIGN NEW TAPE TO FILE
 
 ERP3     SX3    X1
          NZ     X3,ERP4     IF FET ADDRESS IN LOWER FIELD
          AX1    18
 ERP4     SA3    X1
          AX1    18          CLEAR FET ADDRESS
          BX7    X1
          SA1    X2          *XXJORN* FILE NAME
          BX6    X3
          SA7    ASEQ
          SA6    X2
          RENAME X2,X1       RENAME SCATCH TAPE FILE TO JOURNAL FILE
          JP     ERP2        CONTINUE WRITE ON NEW TAPE
 
 ERPA     BSS    2           STORAGE FOR B6/B7 AND X7 ENTRY PARAMETERS
 ERPB     BSS    1           STORAGE FOR IN AND OUT FET POINTERS
 IDS      SPACE  4
**        IDS - ISSUE TAF STATISTICS TO DAYFILE.
*
 
 
 IDS      PS
          SB6    IDSB
          SA1    STAT16      CALCULATE AVERAGE NUMBER OF ACTIVE SUBCP
          SX3    1000
          SA2    A1+B1
          IX1    X1*X3
          IX7    X1/X2
          SA7    A1
          SA2    STAT16+1
          SA1    STAT17      CALCULATE AVERAGE NUMBER OF *SSC* REQUEST
          IX1    X1*X3
          IX7    X1/X2
          SA7    A1
 IDS1     MX0    -12
          SB7    IDSA
          SA2    B6          POINTER TO QUANITY TO BE CONVERTED
          ZR     X2,IDS3     END OF TABLE
          SB6    B6+B1
          SA1    X2          GET QUANITY
 IDS2     SA2    A2+B1       MOVE MESSAGE
          SB6    B6+B1
          BX6    X2
          SA6    B7+B1
          SB7    B7+B1
          BX2    -X0*X2
          NZ     X2,IDS2     NOT END OF MESSAGE
          ZR     X1,IDS1     ZERO QUANITY - DONT ISSUE MESSAGE
          RJ     CFD         CONVERT FOR OUTPUT
          SA6    IDSA        PUT IN MESSAGE
          MESSAGE IDSA,,R    WRITE TO DAYFILE
          EQ     IDS1        LOOP
 
*         COMPUTE PER CENT CPU USAGE
 
 IDS3     RTIME  RTIME       REAL TIME CLOCK
          SA2    PTIME       TIME AT START OF PROGRAM
          SA4    RTIME       TIME NOW
          MX3    -36
          BX5    -X3*X2
          BX6    -X3*X4
          IX7    X6-X5       MSECS SINCE START OF PROGRAM
          TIME   RTIME
          SA4    RTIME       ACCUMULATED CPU TIME
          MX2    -12
          BX5    -X2*X4      MSECS ACCUMULATED
          SA1    CTIME
          LX4    60-12
          BX3    -X2*X4      SECS ACCUMULATED
          SX0    1000
          IX2    X0*X3       MULTIPLY BY 1000
          IX6    X2+X5       TOTAL MSECS ACCUMULATED
          IX6    X6-X1       TIME ACCUMULATED BEFORE PROGRAM
          SX1    100000
          IX3    X6*X1       MULTIPLY BY 100000
          IX1    X3/X7
          RJ     CFD         CONVERT FOR OUTPUT
          SA6    IDSC-1
          MESSAGE A6,,R      PER CENT CPU USAGE
          EQ     IDS         *RETURN
 
 IDSA     BSSZ   7           DAYFILE MESSAGE BUFFER
 
 IDSB     CON    TSEQ
          DIS    ,* KILO TRANSACTIONS PROCESSED.*
          CON    STAT5
          DIS    ,* KILO TRANSACTION ABORTS.*
          CON    STAT1
          DATA   C* KILO TASK RELOADS.*
          CON    STAT2
          DATA   C* KILO ITASK RELOADS.*
          CON    STAT6
          DATA   C* KILO TAF FL INCREASES.*
          CON    STAT4
          DATA   C* KILO STORAGE MOVES OF TASKS.*
          CON    STAT10
          DATA   C* KILO NO FL FOR TASK LOAD.*
          CON    STAT11
          DATA   C* KILO NO SUBCONTROL POINTS.*
          CON    STAT12
          DATA   C* KILO NO COMMUNICATION BLOCKS.*
          CON    STAT14
          DATA   C* KILO TASK ROLLOUT STARTS.*
          CON    STAT13
          DATA   C* KILO TASK ROLLOUT COMPLETES.*
          CON    STAT15
          DATA   C* KILO TASK RECALLS.*
          CON    STAT9
          DATA   C* KILO TASK RECALLS FOR OUTPUT.*
          CON    STAT16
          DATA   C* AVERAGE ACTIVE SUBCONTROL POINTS.*
          CON    STAT17
          DATA   C* AVERAGE OUTSTANDING CDCS REQUESTS.*
          CON    STAT18
          DATA   C* KILO CDCS REQUEST REJECTS FOR MAXR.*
          CON    STAT19
          DATA   C* KILO CDCS REQUEST REJECTS FOR BUSY.*
          CON    STAT20
          DATA   C* KILO CDCS REQUESTS FROM TASKS.*
          CON    0
 IDSC     DIS    ,* PER CENT CPU USAGE.*
 MSGQ     SPACE  4
*         END/RECOVERY MESSAGES
 
 RMES1    DIS    ,*RECOVERY IN PROGRESS.*
 
 RMES2    DIS    ,*RECOVERY IMPOSSIBLE.*
 
 RMES3    DIS    ,*RECOVERY COMPLETE.*
 
 RMES4    DATA   C*"PROD" TERMINATED.*
 
 RMEST1   DIS    ,*TOTAL DID NOT RECOVER PROPERLY.*
 RMEST2   DIS    ,*STATUS IS    *
 
*         PARAMETER LIST FOR TOTAL RECOVERY
 
 TQUE     VFD    24/0,6/77B,6/0,1/1,5/0,18/FLIST
 
 FLIST    VFD    6/4,18/4,12/50B,6/33B,18/TYPE
          VFD    6/4,18/4,12/50B,6/33B,18/STATUS
          VFD    6/4,18/4,12/50B,6/33B,18/SCHEMA
          VFD    6/4,18/4,12/50B,6/33B,18/EOL
          CON    0
 
 TYPE     VFD    60/5LFINAL
 STATUS   VFD    60/4L++++
 SCHEMA   VFD    60/10H**TRANEX**
          VFD    60/10H****UPDATE
          VFD    60/10HNLEND.
          BSSZ   1
 EOL      VFD    60/4LEND.
          BSSZ   1           END IF LIST
 STAT     VFD    60/4L****
 OSTAT    VFD    60/4L++++
 
*         COMMUNICATIONS RECOVERY FILE BUFFER.
 
 CRF      BSS    0
 ZZCRF    RFILEB RBUF,RBUFL,FET=14
 
 RBUF     BSSZ   411B        BUFFER FOR RECOVERY FILE
 RBUFL    EQU    *-RBUF
 
 CTEXT    TITLE  COMMON DECKS.
*CALL     COMCCFD
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCOVL
*CALL     COMCRDW
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMKFIO
 ROFL     BSS    0           UPPER LIMIT OF RECOVERY OVERLAY
 
          ERRNG  ENDR-*      *TAF2* OVERFLOWS INTO RESERVED AREA
 
          END