TAF 
          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 
