         TITLE    ' M E D I A   CAL PROCESSOR'                                  
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
        DO       #MEDIA                                                         
*                                                                               
*                                                                               
*                 M E D I A   T A S K   P R O C E S S O R ,  PART 1             
*                                                                               
*                                                                               
         DEF      A:MED1                                                        
         DEF      MEDIATSK          START OF MEDIA TASK                         
         DEF      MED1                                                          
*                                                                               
*                                                                               
         DEF      MED090            ERROR IN A READ OPERATION                   
         DEF      MED094            ERROR IN A WRITE OPERATION                  
         DEF      MED099            DCB ERRORS                                  
         DEF      MED0EXIT          ENTRY FROM MAIN LOOP                        
*                                                                               
*                                                                               
         DEF      MED1EXIT          STANDARD EXIT FROM THIS SEGMENT             
         DEF      MED1XITA          NORMAL EXIT TO PART 2                       
*                                                                               
*                                                                               
*                                                                               
OLAYFLAG EQU      'MED1'            TASK PART 1                                 
         SYSTEM   CPRMON                                                        
         TITLE    '               M E D I A   P R O C E S S O R'                
         SPACE    2                                                             
***********************************************************************         
***********************************************************************         
**                                                                   **         
**                                                                   **         
**       M E D I A   T A S K :      PROCESS A REQUEST                **         
**                                                                   **         
**                                                                   **         
***********************************************************************         
***********************************************************************         
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
A:MED1   EQU      %                                                             
MEDIATSK EQU      A:MED1    MEDIA TASK START:  ENTER HERE ON 'START'S           
MED1     EQU      A:MED1                                                        
*                                                                               
         LW,R0    MEDRCTRL          TEST CONTROL FLAGS TO SEE IF WE             
         CI,R0    MEDRSTOP          HAVE BEEN 'STOP' PED BY SOMEONE             
         BANZ     MED008              YES, WAIT FOR A 'GO' CONDITION            
*                                                                               
         LI,R1    MEDRSTAT          INDEX TO STATUS BYTE                        
         DISABLE                                                                
         LB,R1    MEDRCTRL,R1       GET CURRENT STATUS BYTE                     
         LW,R15   MEDRCTRL          PICK UP CURRENT STATUS,                     
         AND,R15  MEDZ005A          TURN OFF STATUS BITS, THUS SETTING          
         STW,R15  MEDRCTRL          STATUS TO 'IDLE'                            
         ENABLE                                                                 
*                                                                               
         B        MED0JMP,R1        DECODE STATUS BY JUMP TABLE                 
*                                                                               
*                                                                               
*                                                                               
*              PROCESSOR    STATUS  MEANING                                     
*                 :  :        :       : :                                       
MED0JMP  EQU      %                                                             
         B        MED002    IDLE  0 IDLE                                        
         B        MED002          1 ABORT SET FOR IDLE                          
MED1EXIT B        *R8       INOP  2 DEVICE WAS INOP                             
         B        MED990          3 DEVICE WAS INOP; ABORT                      
         B        MED052    COPY  4 IN A COPY; 'STOP' PED, NOW RESTART          
         B        MED990          5 IN A COPY; 'ABORT' THE COPY                 
         B        MED095    ICPY  6 DEVICE INOP DURING A COPY                   
         B        MED990          7 DEVICE INOP DURING A COPY; ABORT            
         B        MED020    AQIR  8 ACQUIRING IN-, OUT- DEVICES                 
         B        MED990          9 ACQUIRING DEVICES; ABORT                    
         B        MED030    TAPE 10 WAITING TAPE MOUNT                          
         B        MED990         11 WAITING TAPE MOUNT; ABORT                   
         AI,R8    1         HEDR 12 PRINTING BREAK PAGES IN PART 2              
         B        MED1EXIT       13 PRINTING BREAK PAGES; ABORT                 
         PAGE                                                                   
         SPACE    2                                                             
MED002   EQU      %         TASK IN IDLE STATE; TEST IF IT REMAINS THERE        
*                           ABORT SET WHILS IN IDLE; IGNORE IT                  
         CI,R0    MEDREND           IS A 'END' SET ?/                           
         BANZ     MED008              YES, DON'T TRY TO START ANYTHING          
         LI,R0    0                 CLEAR ERROR SWITCH/ MESSAGE ID              
         STW,R0   MEDRERRS                                                      
         STW,R0   MEDRERRS+1        RESET TYC ERROR CODE WORD TOO               
         STW,R0   MEDRBB1           RESET BLOCKING BUFFER ADDRESSES             
         STW,R0   MEDRBB2                                                       
         LW,R1    M24               RESET OPEN BIT IN THE DCB'S TO              
         STS,R0   MEDRIDCB          INDICATE THEY ARE CLOSED                    
         STS,R0   MEDRODCB                                                      
*                                                                               
*                           SEARCH FOR A COPY REQUEST                           
         LI,R0    MEDKEYCL          SET CLASS MASK FOR SEARCH                   
         LI,R1    ECBCLASS          INDEX TO CLASS HALFWORD, AND                
         LW,R2    LMIRECB+MEDALMID  GET HEAD OF REQUEST LIST                    
*                                                                               
MED006   EQU      %         LOOK DOWN LIST (R-CHAIN) FOR KEY-IN REQ             
         AND,R2   M24               REMOVE FLAG, AT LAST ITEM ?/                
         BEZ      MED011              YES, NO KEY-INS; TRY CALS                 
*                                                                               
         CH,R0    *R2,R1            IS THIS A KEY-IN REQ ?/                     
         BANZ     MED010              YES, PROCESS IT                           
*                                                                               
         LW,R2    ECBRECB,R2          NO, GET NEXT ON LIST                      
         B        MED006            AND TEST IF AT END                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
*        W A I T        WAIT HERE DURING IDLE TIME FOR SOMETHING TO DO          
*                                                                               
MED008   EQU      %         ENTER (SUPER) WAIT FOR SOMETHING TO HAPPEN          
         CAL1,7   MEDRSTPS          STOP AND WAIT FOR SOMETHING                 
         B        MEDIATSK          SEE WHAT IT WAS                             
         PAGE                                                                   
         SPACE    2                                                             
MED010   EQU      %         A KEY-IN REQ; FIND PACKET, DO INIT                  
         LW,R3    ECBDATA,R2        POINT AT DATA PACKET                        
         LCI      MEDZ000#                                                      
         LM,R12   MEDZ000           MOVE DEFAULT JOB-, TASK- NAMES              
         STM,R12  MEDRJOB           INTO RESIDENT FOR PRINT                     
         LI,R1    MEDPMASN          GET ID OF THIS REQUEST AND STORE            
         LB,R0    *R3,R1            AS THE LAST KEY-IN REQUEST                  
         LI,R1    MEDRKFIN          PROCESSED                                   
         LI,R4    MEDR#KEY          POINT AT KEY-IN QUEUE COUNTER               
         B        MED019            DO COMMON KEY-IN/CAL PROCESSING             
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED011   EQU      %         NO KEY-IN FOUND; DO A CAL IF ONE EXISTS             
         LW,R2    LMIRECB+MEDALMID  PICK UP START OF LIST AGAIN                 
         AND,R2   M24               IF LIST NOT EMPTY, 1ST IS A CAL REQ         
         BEZ      MED008              LIST IS NULL; WAIT FOR NEW REQ            
*                                                                               
         LW,R3    ECBDATA,R2        GET ADDRESS OF DATA PACKET                  
         LCI      4                 MOVE JOB-, TASK- NAMES FROM                 
         LM,R12   MEDPJOBN,R3       PACKET TO RESIDENT SLOTS                    
         STM,R12  MEDRJOB           TO BE SAME AS A KEY-IN REQ                  
         LW,R0    MEDPICTL,R3       UNPACK OUTPUT INFO FROM INPUT               
         AND,R0   Y3                CONTROL WORD                                
         CW,R0    Y2                SPACE SET ?/                                
         BAZ      %+2                 NO                                        
         OR,R0    Y002                YES, SET SPACE COUNT = 2                  
         STW,R0   MEDPOCTL,R3       AND STORE OUTPUT CONTROL INFO               
         LW,R0    MEDPICTL,R3       REFETCH INPUT WORD AND REMOVE THE           
         AND,R0   Y3                OUTPUT INFO FROM IT                         
         EOR,R0   MEDPICTL,R3       BUT SAVE INPUT INFO                         
         STW,R0   MEDPICTL,R3                                                   
*                                                                               
         LH,R15   MEDZ001           FIND OUT WHERE THE DEFAULT OPLABEL          
         LH,R1    *K:OPLBS1         IS; NUMBER OF OPLABELS TO SCAN              
MED012   CH,R15   *K:OPLBS1,R1      SEARCH LIST FOR THE 'MO' LABEL              
         BE       MED013            FOUND                                       
         BDR,R1   MED012              TEST ANOTHER                              
         LW,R15   MEDZ091           SET ERROR INDICATOR, MESSAGE                
         B        MED999C           GO SET IT, AND QUIT                         
*                                                                               
MED013   EQU      %         LABEL FOUND; GET DEVICE OR FILE                     
         LD,R8    ZEROS             SET NULL DEVICE IN CASE SO SET              
         LB,R1    OPLBS2,R1         GET INDEX TO DEVICE/RFT                     
         BEZ      MED015            NULL DEVICE; OK AS IS                       
*                                                                               
         CI,R1    X'80'             IS IT ASSIGNED TO A FILE ?/                 
         BANZ     MED017              YES                                       
*                                                                               
         LD,R8    DCT16,R1          GET DEVICE NAME                             
         SLD,R8   24                REMOVE BANG BANG PREFIX                     
         OR,R9    BLANKS                                                        
*                                                                               
MED015   EQU      %         STORE DEVICE NAME OR ZEROES IN PACKET               
         LCI      2                                                             
         STM,R8   MEDPOFIL,R3       AND STORE IN PACKET                         
         B        MED020            GO TO COMMON PROCESSOR                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED017   EQU      %         OPLABEL ASSIGNED TO A FILE; CONVERT TO NAME         
         AI,R1    -X'80'            REMOVE FILE FLAG                            
         LD,R8    RFT1,R1           GET NAME OF FILE                            
         LB,R1    RFT8,R1           THEN INDEX TO AREA NAMES                    
         LH,R1    MDNAME,R1         GET ACTUAL AREA NAME                        
         AND,R1   XFFFF             REMOVE EXTENDED SIGN                        
         LI,R0    MEDOFILE          SET FILE GIVEN OPTION INDICATOR             
         STB,R0   R1                INTO CONTROL WORD                           
         STS,R1   MEDPOCTL,R3       AND SAVE OPTION/AREA WORD                   
         LCI      2                                                             
         STM,R8   MEDPOFIL,R3       SAVE FILE NAME                              
         DO       #DFACNT                                                       
         LM,R8    RFTACNT,R1        GET ACCOUNT NAME                            
         STM,R8   MEDPOACN,R3       AND PUT IT IN PACKET                        
         FIN      #DFACNT                                                       
         LI,R1    MEDPMASN          GET ID OF THIS REQUEST AND STORE            
         LB,R0    *R3,R1            AS THE LAST CAL REQUEST                     
         LI,R1    MEDRCFIN          PROCESSED                                   
         LI,R4    MEDR#CAL          POINT AT CAL QUEUE COUNTER                  
*                                                                               
* PACKET NOW NORMALIZED                                                         
*                                                                               
MED019   EQU      %         UPDATE QUEUE INFO                                   
@#%1     CB,R0    MEDIARES,R1       PROCESSED THIS ONE BEFORE ?                 
@#%2     BE       MEDIACSH            YES, CRASH                                
         STB,R0   MEDIARES,R1                                                   
         MTB,-1   MEDIARES,R4                                                   
         PAGE                                                                   
*                                                                               
*                                                                               
*                      PACKET NOW IN STANDARD FORM                              
*                                                                               
MED020   EQU      %         TRY TO ACQUIRE REQUIRED DEVICES                     
         LI,R9    MEDRIDCB          PROCESS INPUT FIRST                         
         LW,R6    R3                POINT AT INPUT'S INFO IN PACKET             
         BAL,R14  MED810            ACQUIRE THE DEVICE                          
         B        MED028            UNABLE TO ACQUIRE IT                        
         STW,R8   MEDRITMP          SAVE CODE INFO ON THE DEVICE                
         CI,R8    MEDAINOK          IS IT A LEGAL INPUT DEVICE ?                
         BAZ      MED020E             NO, GIVE ERROR                            
*                                                                               
         LI,R9    MEDRODCB          POINT AT OUTPUT DCB                         
         AI,R6    MEDPOCTL-MEDPICTL ADJ POINTER TO OUTPUT INFO                  
         BAL,R14  MED810            AND ACQUIRE THE OUTPUT DEVICE               
         B        MED025            UNABLE TO                                   
         STW,R8   MEDROTMP          SAVE CODE INFO                              
         CI,R8    MEDAOUOK          IS IT A LEGAL OUTPUT DEVICE ?               
         BAZ      MED020E             NO, GIVE ERROR                            
*                                                                               
*                                                                               
         LW,R10   MEDZ002O                                                      
         STW,R10  MEDROC                                                        
         CAL1,1   MEDROC            TRY TO OPEN OUTPUT FILE                     
         CW,R10   MEDZ002O          R10 CHANGED ?/ (ERROR ?/)                   
         BNE      MED022              YES, TEST TYPE OF ERROR                   
*                                                                               
         LI,R9    MEDRIDCB          PROCESS INPUT                               
         CAL1,1   MEDROC                                                        
         CW,R10   MEDZ002O          ANY ERRORS ON THIS ONE ?/                   
         BNE      MED023              YES, TEST TYPE                            
*                                                                               
         LW,R15   MEDRITMP          SEE IF A TAPE MOUNT MESSAGE                 
         OR,R15   MEDROTMP          IS REQUIRED TO GO TO THE OPERATOR ?/        
         CI,R15   MEDATAPE          TAPE INDICATOR FOR EITHER ?/                
         BAZ      MED038              NO, START PRECOPY PROCESSING              
*                                                                               
*                                                                               
*                           REQUEST OPERATOR TO MOUNT TAPE(S)                   
*                                                                               
         LI,R1    -MEDZ003#         MOVE MOUNT MESSAGE                          
         LW,R0    MEDZ003+MEDZ003#,R1                                           
         STW,R0   MEDRIMAG+MEDZ003#,R1 TO ASK OPER TO MOUNT TAPE(S)             
         BIR,R1   %-2                                                           
*                                                                               
         LI,R1    MEDPMASN                                                      
         LB,R1    *R3,R1            GET MASN FROM PACKET                        
         LI,R4    BA(MEDRIMAG)        COMPUTE                                   
         AI,R4    (MEDZ003#-1)**2+3           WHERE TO PUT NUMBER               
         BAL,R8   MED800            CONVERT TO PRINT FORM                       
         LCI      MEDZ004#                                                      
         LM,R12   MEDZ004           MOVE TYPE FPT TO REAL CORE                  
         STM,R12  MEDRFPTX                                                      
         CAL1,2   MEDRFPTX          TYPE MESSAGE                                
         DISABLE                                                                
         LW,R15   MEDRCTRL          RESET STATUS BITS, THEN SET THE             
         AND,R15  MEDZ005           TASK STOPPED WAITING FOR TAPES              
         AI,R15   MEDRSTOP+MEDSTAPE   THEN WAIT FOR OPET TO TYPE                
         STW,R15  MEDRCTRL           '' GO ''                                   
         ENABLE                                                                 
         B        MED008            GO WAIT FOR HIM                             
*                                                                               
*                                                                               
MED020E  EQU      %         ILLEGAL INPUT OR OUTPUT DEVICE SPECIFIED            
         LW,R15   MEDZ097           SET MESSAGE SWITCH/ NAME                    
         B        MED999C           STORE AND STOP                              
         PAGE                                                                   
         SPACE    2                                                             
MED022   EQU      %         CANNOT OPEN OUTPUT FILE                             
         LB,R10   R10               TEST FOR EXCLUSIVE USE                      
         CI,R10   TYC78                                                         
         BE       MED024            THAT; SET TO WAIT & TRY AGAIN               
*                                                                               
         STW,R10  MEDRERRS+1        SAVE TYC CODE FOR ERROR MESSAGE             
         LW,R15   MEDZ093           SET ERROR                                   
         B        MED999C           MESSAGE AND STOP REQUEST                    
*                                                                               
*                                                                               
MED023   EQU      %         CANNOT OPEN INPUT; TEST WHY                         
         LB,R11   R10               SAVE ERROR CODE                             
         LW,R15   MEDZ002C          SET TO CLOSE OUTPUT                         
         STW,R15  MEDROC                                                        
         CAL1,1   MEDROC                                                        
         CI,R11   TYC78             INPUT WAS USED EXCLUSIVELY ?                
         BE       MED024              YES, WAIT A BIT TO TRY AGAIN              
*                                                                               
         STW,R11  MEDRERRS+1        SAVE TYC CODE FOR MESSAGE                   
         LW,R15   MEDZ092             NO, REPORT ERROR                          
         B        MED999C           SET MESSAGE AND ERROR INDICATOR             
*                                                                               
*                                                                               
MED024   EQU      %         EXCLUSIVE USE OF REQUIRED DEVICE; WAIT              
         BAL,R14  MED880            WAIT A BIT                                  
         B        MED020            AND TRY TO GET, OPEN THEM AGAIN             
         PAGE                                                                   
         SPACE    2                                                             
MED025   EQU      %         OUTPUT UNACQUIRABLE; SET REQ FOR INPUT              
        DO       #SYMB            NOT REQ FLAGS IF NO SYMBIONTS                 
         LB,R1    MEDRITMP          GET DEVICE INDEX FOR INPUT                  
         BEZ      MED028            DEVICE ?/   NO, FILE; NO REQ BIT            
*                                                                               
         LI,R14   KFF-DCTRBMM-DCTRBMMR  MASK TO RESET REQ, MED BITS             
         DISABLE                                                                
         LB,R0    DCTRBM,R1                                                     
         AND,R0   R14               RESET 'MEDIA'' BIT                          
         AI,R0    DCTRBMMR          SET 'REQUEST' ED BIT FOR MEDIA              
         STB,R0   DCTRBM,R1                                                     
         ENABLE                                                                 
        FIN      #SYMB                                                          
         SPACE    2                                                             
MED028   EQU      %         MUST WAIT FOR DEVICE AVAILABILITY                   
         MTW,00   MEDRERRS          WAS A FATAL ERROR DISCOVERED ?              
         BNEZ     MED500              YES, TERMINATE NOW                        
         DISABLE                                                                
         LW,R15   MEDRCTRL          RESET OTHER STATII, SET AQIR                
         AND,R15  MEDZ005           TO INDICATE TRYING TO ACQUIRE               
         AI,R15   MEDSAQIR          AN UNAVAILABLE DEVICE.                      
         STW,R15  MEDRCTRL                                                      
         ENABLE                                                                 
         B        MED008            GO DO A  WAIT ON SYMBIONTS                  
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*        THIS POSITIONING CODE SHOULD BE CHANGED TO CALL A COMMON   *           
*        SUBROUTINE THAT FUNCTIONS SIMILIAR TO THE CODE USED IN 'ADD' *         
*        BELOW.  TESTING FOR A SECOND TAPEMARK AFTER EVERY SKIP       *         
*        WILL PREVENT SFILE PROCESSING FROM RUNNING OFF THE END OF    *         
*        THE TAPE IF 'N' IS TOO LARGE.     R1 <= FILE COUNT           *         
*                                                                     *         
***********************************************************************         
         SPACE    2                                                             
MED030   EQU      %         POSITION TAPE FILES                                 
         LCI      MEDZ006#          MOVE PFIL FPT                               
         LM,R12   MEDZ006                                                       
         STM,R12  MEDRFPTX                                                      
*                                                                               
         LW,R15   MEDRITMP          TEST IF INPUT IS A TAPE                     
         CI,R15   MEDATAPE                                                      
         BAZ      MED033              NO, NO POSITIONING                        
*                                                                               
         LI,R1    MEDPISFL          GET SFILE COUNT FROM PACKET                 
         LB,R1    *R3,R1                                                        
         BEZ      MED032            NONE REQUESTED; SKIP SKIPS                  
*                                                                               
MED031   EQU      %         SKIP THE  'N' FILES FOR INPUT                       
         CAL1,1   MEDRFPTX          SKIP IT 1 FILE                              
         BDR,R1   MED031            DO IT  'N' TIMES                            
*                                                                               
*                                                                               
MED032   EQU      %         POSITION OUTPUT IF A TAPE                           
         LW,R15   MEDROTMP                                                      
         CI,R15   MEDATAPE          IS IT A TAPE ?/                             
         BAZ      MED038              NO, TEST FOR 'ADD' ON OTHER DEVICES       
*                                                                               
*                                                                               
MED033   EQU      %         PROCESS SFILE REQUESTS FOR OUTPUT TAPES             
         LI,R9    MEDRODCB          POINT AT OUTPUT DCB                         
         LI,R1    MEDPOSFL                                                      
         LB,R1    *R3,R1            GET SFILE COUNT FROM PACKET                 
         BEZ      MED035              NO SPECIFIED; SO WE ARE DONE              
*                                                                               
MED034   EQU      %                                                             
         CAL1,1   MEDRFPTX          SKIP FORWARD A RECORD                       
         BDR,R1   MED034             DO IT 'N' TIMES                            
*                                                                               
*                                                                               
MED035   EQU      %        PROCESS A TAPE 'ADD' REQUEST                         
         LI,R1    MEDPOOPT          GET OUTPUT OPTIONS FROM PACKET              
         LH,R15   *R3,R1                                                        
         CI,R15   MEDHADD           WAS 'ADD' SPECIFIED ?/                      
         BAZ      MED040              NO, END OF PREPROCESSING                  
*                                                                               
         LI,R14   MED036E           SET NEW ERROR EXIT FOR 'ADD'                
         STW,R14  MEDRFPTX+2        PFIL PROCESSING                             
         LW,R11   MEDZ008           SET SKIP A RECORD CODE WORD                 
*        LW,R12   MEDZ006 ALREADY SET SKIP A FILE CODE WORD                     
*                                                                               
*                                                                               
MED036   EQU      %         SKIP FORWARD A FILE; THEN RECORD                    
*                                   LOOKING FOR A TAPEMARK ON THE               
*                                   SKIP RECORD REQUEST.  THAT WILL             
*                                   MARK THE DOUBLE TAPEMARKS AT THE END        
*                                   OF THE TAPE                                 
         CAL1,1   MEDRFPTX                                                      
*                                                                               
         STW,R11  MEDRFPTX          SET SKIP RECORD                             
         CAL1,1   MEDRFPTX                                                      
         STW,R12  MEDRFPTX          RESET TO SKIP A FILE                        
         B        MED036            AND LOOP FOR NEXT FILE                      
*                                                                               
*                                                                               
MED036E  EQU      %         ERROR ROUTINE FOR 'ADD' PROCESSING                  
         LB,R10   R10               FETCH ERROR CODE WE GOT FOR OPER            
         CI,R10   X'30'             IS DEVICE INOPERABLE ?                      
         BE       MED037              YES, WAIT FOR FIX-UP                      
*                                                                               
         CI,R10   X'06'             WAS IT THE SECOND TAPEMARK ?/               
         BNE      MED994              NO, FATAL ERROR; ABORT                    
*                                                                               
         LW,R11   MEDZ009             YES, SKIP BACK OVER THAT                  
         STW,R11  MEDRFPTX+1        SECOND TAPEMARK                             
         CAL1,1   MEDRFPTX                                                      
         B        MED040            THEN PREPROCESSING IS COMPLETED             
*                                                                               
*                                                                               
MED037X  EQU      %         ERROR ROUTINE FOR SFILE PROCESSING                  
         LB,R10   R10               GET ERROR CODE                              
         CI,R10   X'30'             IS TAPE INOPERABLE (MANUAL) ?               
         BE       MED037              YES, ALLOW RECOVERY                       
         CI,R10   X'1C'             END OF THE TAPE ?!  (HUH?)                  
         BNE      MED994              NO, GIVE FATAL ERROR                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED037   EQU      %         SET STATUS = INOP DURING TAPE POSITIONING           
         AI,R8    -1                POINT BACK AT CAL THAT ERRORED              
         BAL,R14  MED880            WAIT A BIT FOR OPERATOR ACTION              
         B        *R8               AND THEN RETRY THE OPERATION                
*        DISABLE                                                                
*        LW,R15   MEDRCTRL                                                      
*        AND,R15  MEDZ005           GET, RESET CURRENT STATUS                   
*        AI,R15   MEDRSTOP+MEDSINOP   SET 'STOP' PED, 'INOP'                    
*        STW,R15  MEDRCTRL                                                      
*        ENABLE                                                                 
*        B        MED008            WAIT FOR IT TO BE FIXED                     
*                                                                               
*                                                                               
*                                                                               
MED038   EQU      %         POSITION OUTPUT FOR 'ADD', NON-TAPE DEVICE          
         LI,R1    MEDPOOPT          FETCH OUTPUT OPTIONS                        
         LH,R15   *R3,R1                                                        
         CI,R15   MEDHADD           'ADD' REQUESTED ?/                          
         BAZ      MED040              NO, NO PREPROCESSING;  QED, FINI          
*                                                                               
         LCI      MEDZ006#            YES, MOVE PFIL FPT                        
         LM,R12   MEDZ006                                                       
         STM,R12  MEDRFPTX                                                      
         LI,R9    MEDRODCB          POINT AT OUTPUT DEVICE/FILE DCB             
         CAL1,1   MEDRFPTX          SKIP THE FILE                               
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
**************************************************************************      
**                                                                   **         
**                                                                   **         
**       PREPROCESSING COMPLETE;  SET UP MAIN COPY LOOP              **         
**                                                                   **         
**                                                                   **         
***********************************************************************         
***********************************************************************         
         SPACE    3                                                             
MED040   EQU      %         DETERMINE MAX SIZE OF IN-, OUT- PUT RECORDS         
         LI,R1    3                                                             
         LB,R10   MEDROTMP,R1       GET MAX NUMBER OF WORDS TO OUTPUT           
         CB,R10   MEDRITMP,R1       IS IT BIGGER THAN WHAT CAN BE READ?         
         BL       %+2                 NO, USE OUTPUT AS MAX SIZE                
         LB,R10   MEDRITMP,R1       YES, WRITE ONLY WHAT IS READ                
         AI,R10   1                 ADJUST FROM WORD NUMBER TO NUM WORDS        
*                                                                               
         BAL,R5   FINDBB            GET A BUFFER FOR OUR 2 BUFFERS              
         B        MED995              NO BUFFER, GIVE ERROR AND STOP            
*                                                                               
         STW,R15  MEDRBB1           SAVE CONTROL WORD FOR THE BUFFER            
         LW,R11   *R15              GET ADDRESS OF START OF BUFFER              
         AND,R11  M17               FIRST HALF IS BUFFER 'A';                   
         LW,R12   R11               SECOND HALF IS BUFFER 'B'                   
         AI,R12   128                                                           
         CI,R10   128               DO WE NEED SEPARATE BLOCKING                
         BL       MED041            BUFFERS?   NO, SIZE < 1/2                   
*                                                                               
         BAL,R5   FINDBB              YES, GET ANOTHER                          
         B        MED995              ERROR, REPORT                             
*                                                                               
         STW,R15  MEDRBB2           SAVE WORD FOR THIS ONE TOO                  
         LW,R12   *R15              GET ADDRESS OF THIS BUFFER                  
         AND,R12  M17                                                           
*                                                                               
MED041   EQU      %                                                             
         LI,R13   0                 SET INITIAL BTD FOR WRITES                  
         SLS,R10  2                 CONVERT RECORD SIZE TO BYTES                
*                                                                               
         STW,R11  MEDRRA+MEDRRBUF   STORE                                       
         STW,R12  MEDRRB+MEDRRBUF     READ                                      
         STW,R11  MEDRWA+MEDRWBUF       AND                                     
         STW,R12  MEDRWB+MEDRWBUF         WRITE                                 
         STW,R13  MEDRRA+MEDRRBTD           ADDRESSES,                          
         STW,R13  MEDRRB+MEDRRBTD             BTD'S,                            
         STW,R10  MEDRRA+MEDRRBYT               BYTE                            
         STW,R10  MEDRRB+MEDRRBYT                 COUNTS                        
         STW,R10  MEDRWA+MEDRWBYT                   IN ALL                      
         STW,R10  MEDRWB+MEDRWBYT                     FPTS                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
*                 START ACTUAL COPY                                             
*                                                                               
*                                                                               
MED050   EQU      %         BEGIN OF COPY LOOP ( SET IT UP )                    
         LW,R15   TYCWNORM          SET LAST WRITE TO 'B' OK                    
         STW,R15  MEDRWB+6                                                      
         LI,R15   0                 FLAG FOR BREAK PAGES                        
         BAL,R14  MED820            OUTPUT HEADERS, FIX FOR PRINTERS            
         B        MED500            ERROR FOUND; CODE SET; TERM NOW             
*                                                                               
*                                                                               
*                                                                               
MED052   EQU      %         SET UP COPY LOOP; ENTER LOOP                        
         LI,R8    MEDRLOOP          SET ENTRY ADDRESS TO LOOP                   
*                                                                               
*                                                                               
MED054   EQU      %         SET UP LOOP PARAMETERS                              
         LI,R15   MEDRABRT+MEDRSTOP   SET LOOP EXIT FLAGS                       
         B        MED1EXIT          EXIT FROM HERE TO THERE                     
         PAGE                                                                   
         SPACE    2                                                             
MED0EXIT EQU      %         'STOP' OR 'ABORT' SET WHILE IN A COPY               
         DISABLE                                                                
         LW,R0    MEDRCTRL          TEST WHICH                                  
         AND,R0   MEDZ005A                                                      
         CI,R0    MEDRSTOP          'STOP' SET ?                                
         BAZ      MED0XITA            NO, ABORT                                 
*                                                                               
         AI,R0    MEDSCOPY                                                      
         STW,R0   MEDRCTRL                                                      
         ENABLE                                                                 
         B        MED008            AND WAIT FOR THE OPER TO SAY 'GO'           
*                                                                               
*                                                                               
MED0XITA EQU      %         'ABORT' GIVEN                                       
         STW,R0   MEDRCTRL                                                      
         ENABLE                                                                 
         B        MED990            GO SET ERROR CODE/MESSAGE                   
         PAGE                                                                   
         SPACE    2                                                             
MED090   EQU      %         ERROR DETECTED DURING READ                          
         LB,R11   R10               GET, COPY ERROR CODE                        
         CI,R11   X'1C'             WAS END-OF-TAPE REACHED ?                   
         BE       MED410              YES, TEST IF ALL DONE                     
         CI,R11   X'06'             WAS END-OF-FILE REACHED?                    
         BE       MED400              YES, STOP AND TEST IF MORE                
         CI,R11   X'05'             WAS END-OF-DATA FOUND?                      
         BE       MED400              YES, TEST IF ANOTHER FILE TO GO           
         CI,R11   X'30'             DID THE DEVICE GO INOP ?                    
         BNE      MED096              NO, FATAL ERROR                           
*                                                                               
MED092   EQU      %         DEVICE INOP; ALLOW CORRECTION; WAIT                 
         AI,R8    -1                BACK UP TO RETRY THE OPERATION              
         LW,R15   MEDRCTRL          SEE IF OPER WANTS US TO STOP/ABORT          
         CI,R15   MEDRABRT          IS ABORT SET ?                              
         BANZ     MED990              YES, SET OPERATOR ABORTED IT              
*                                                                               
         CI,R15   MEDRSTOP          DID HE ASK US TO STOP ?                     
         BAZ      MED093              NO, WAIT AND TRY OP OVER                  
*                                                                               
         DISABLE                                                                
         LW,R15   MEDRCTRL                                                      
         AND,R15  MEDZ005           RESET CURRENT STATUS FLAGS                  
         AI,R15   MEDRSTOP+MEDSICPY   SET STATUS WHEN STOPPED                   
         STW,R15  MEDRCTRL                                                      
         ENABLE                                                                 
         B        MED008            AWAIT OPER 'GO' KEY-IN                      
         PAGE                                                                   
         SPACE    2                                                             
MED093   EQU      %         WAIT BEFORE RETRY                                   
         BAL,R14  MED880            WAIT A BIT FOR OPERATOR FIX-UP              
*                                                                               
*                                                                               
*                                                                               
MED095   EQU      %         RECOVER FROM DEVICE INOP DURING COPY                
         LW,R15   R8                SAVE RETURN ADDRESS NOW IN R8               
         CAL1,1   *R9               REEXECUTE CAL THAT FOUND THE INOP           
         LW,R8    R15               RESTORE R8                                  
         B        MED054            AND RE-ENTER THE COPY LOOP                  
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED094   EQU      %         ERROR DETECTED IN WRITE                             
         LB,R11   R10               GET, COPY ERROR CODE                        
         CI,R11   X'30'             DEVICE INOP ?                               
         BE       MED092              YES, ALLOW RECOVERY                       
*                                                                               
         CI,R11   X'4B'             OR WAS PRINTER PAGE POS LOST ?              
         BE       MED092              YES, ALLOW RECOVERY                       
*                                                                               
*                                                                               
MED096   EQU      %         FATAL ERROR IN READ/WRITE                           
         STW,R11  MEDRERRS+1        SAVE TYC ERROR CODE                         
         LW,R15   MEDZ096           SET ERROR CODE                              
         B        MED999C           AND STOP COPY                               
*                                                                               
*                                                                               
*                                                                               
MED099   EQU      %         DCB ABNORMAL & ERROR ROUTINE                        
         LW,R0    *R10              FETCH 1ST WORD OF DCB IN ERROR              
         CW,R0    Y002              IS IT ALREADY OPEN ?                        
         BAZ      MED1EXIT            NO, RETURN TO PROCESS IN-LINE             
*                                                                               
         LB,R11   R10               YES, FATAL ERROR; SET ERROR CODE            
         B        MED096            AND TERMINATE                               
         PAGE                                                                   
         SPACE    2                                                             
MED400   EQU      %         EOF FOUND IN READ - END OF COPY                     
         LI,R7    MEDPIOPT          ACCESS THE INPUT OPTIONS WORD               
         LH,R14   *R3,R7            TO GET THE 'ALL' OPTION IF THERE            
         CI,R14   MEDHFILE          INPUT FROM A FILE ?                         
         BANZ     MED410              YES, ONLY 1 FILE ON INPUT; DONE           
*                                                                               
         CI,R14   MEDHALL           WAS 'ALL' SPECIFIED ?                       
         BAZ      MED410              NO, DON'T EVEN TEST IF MORE FILES         
*                                                                               
         CAL1,1   MEDRRB            READ THE NEXT RECORD TO 'B'                 
*                                                                               
*                                                                               
MED402   EQU      %         TEST IF ANOTHER FILE FOLLOWS TO COPY                
         LCI      MEDZ020#          THEN SET UP SPECIAL CHECK                   
         LM,R10   MEDZ020           TO TEST IF THERE IS A NEXT                  
         STM,R10  MEDRFPTX          RECORD OR AN END OF FILE                    
         LW,R10   TYCWNORM          SET RESULT = OK                             
         CAL1,1   MEDRFPTX          TEST IF THERE IS A NEXT                     
         LB,R10   R10               WAS AN END-OF-FILE FOUND ?                  
         CI,R10   X'06'             WAS AN EOF READ ?                           
         BE       MED410              YES, END OF COPY                          
*                                                                               
         CI,R10   X'1C'             END-OF-TAPE REACHED ?                       
         BE       MED410              YES, ALSO END OF COPY                     
*                                                                               
         CI,R10   X'05'             WAS IT AND END-OF-DATA ?                    
         BE       MED410              YES, END OF THE COPY                      
*                                                                               
         CI,R10   TYCNORM           WERE THERE ANY OTHER ERRORS ?               
         BNE      MED408              NO, CONTINUE FOR NEXT COPY                
*                                                                               
MED404   EQU      %         END OF PART OF A COPY; PREP FOR NEXT                
         LCI      MEDZ021#          MOVE WEOF FPT                               
         LM,R10   MEDZ021           SO AS TO                                    
         STM,R10  MEDRFPTX          WRITE A EOF, !EOD, OR WHATEVER              
         CAL1,1   MEDRFPTX          IS RIGHT FOR THE DEVICE                     
         LW,R0    MEDROTMP                                                      
         CI,R0    MEDAPRNT          OUT PUT TO A PRINTER ?                      
         BAZ      MED406              NO, SKIP TO RESTART                       
*                                                                               
         BAL,R14  MED830            OUT TRAILER INFO                            
         B        MED500            FATAL ERROR; STOP NOW                       
         LI,R15   1                 FLAG FOR NO BREAK PAGES                     
         BAL,R14  MED820            AND NEXT HEADER                             
         B        MED500            ERROR FOUND; CODE SET; TERM NOW             
*                                                                               
MED406   EQU      %         RE-ENTER COPY LOOP AFTER READ TO 'A' BUFFER         
         LI,R8    MEDRLOPA          TO SKIP OVER READ TO 'A' BUFFER             
         B        MED054            AND RESUME THE COPY                         
*                                                                               
MED408   EQU      %         ERROR FOUND IN COPY; TERMINATE WITH 'DEV'           
         STW,R10  MEDRERRS+1        SAVE ERROR CODE FOR ERROR MESSAGE           
         LW,R0    MEDZ096             YES, SET ERROR CODE                       
         STW,R0   MEDRERRS                                                      
         PAGE                                                                   
         SPACE    2                                                             
MED410   EQU      %         END OF A COPY; DO TERMINATION PROCESSING            
         LW,R0    MEDROTMP          TEST FOR TYPE OF FILE TERMINATION           
         CI,R0    MEDAPRNT          IS OUTPUT A PRINTER ?                       
         BANZ     MED415              YES, PRINT TRAILER INFO                   
*                                                                               
         LCI      MEDZ021#          MOVE WEOF                                   
         LM,R10   MEDZ021                                                       
         STM,R10  MEDRFPTX                                                      
         CI,R0    MEDATAPE          IS IT A TAPE ?                              
         BANZ     MED420              YES, WRITE EOFS, DO POSITIONING           
*                                                                               
         CAL1,1   MEDRFPTX          WRITE TO PUNCH, DISC, RAD, ETC              
         B        MED450            THEN SEE ABOUT DELETING INPUT,ETC           
*                                                                               
*                                                                               
MED415   EQU      %         PROCESS END OF FILE TO A PRINTER                    
         BAL,R14  MED830            DO IT                                       
         NOP      MED450            ERROR, BUT IGNORE IT                        
         B        MED450            AND SEE TO THE INPUT                        
*                                                                               
*                                                                               
MED420   EQU      %         DO POST COPY PROCESSING FOR A TAPE OUTPUT           
         LI,R1    MEDPOOPT          GET OUTPUT OPTIONS FOR COPY REQ             
         LH,R15   *R3,R1                                                        
         CI,R15   MEDHWEOF          WAS AN EOF COUNT GIVEN                      
         BANZ     MED421              YES, USE IT                               
*                                                                               
         LI,R1    2                   NO, SET TO DOUBLE TMS                     
         B        MED422            AND CONTINUE                                
*                                                                               
MED421   EQU      %         GET NUMBER OF TMS TO WRITE                          
         LI,R1    X'F'                                                          
         AND,R1   R15               GET COUNT IN TO R1                          
*                                                                               
MED422   EQU      %         WRITE REQUESTED TAPE MARKS                          
         CAL1,1   MEDRFPTX          WRITE IT, BABY, WRITE IT                    
         BDR,R1   MED422                                                        
*                                                                               
MED423   EQU      %         PROCESS REWIND/UNLOAD REQUEST                       
         LI,R9    MEDRODCB          POINT AT OUTPUT                             
         BAL,R14  MED840            REWIND AND/OR UNLOAD THE TAPE               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED450   EQU      %         PROCESS INPUT SPECIFICATION                         
         LI,R1    MEDPIOPT          PICK UP THE INPUT OPTIONS                   
         LH,R15   *R3,R1            FROM DATA PACKET                            
         LW,R0    MEDRITMP                                                      
         CI,R0    MEDATAPE          IS THE INPUT A TAPE ?                       
         BAZ      MED500              NO, CLEAN UP                              
*                                                                               
         LI,R9    MEDRIDCB          POINT AT INPUT                              
         BAL,R14  MED840            PROCESS REWIND AND/OR UNLOAD                
         PAGE                                                                   
         SPACE    2                                                             
MED500   EQU      %         END OF COPY; (ERR AND NORM), CLEAN UP               
         LW,R15   MEDZ017           WAIT FOR ALL OTHER I/O OPS TO STOP          
         STW,R15  MEDRFPTX                                                      
         CAL1,7   MEDRFPTX                                                      
*                                                                               
*                                                                               
         LW,R6    MEDRBB1           FETCH CONTROL WORD FOR 1ST BUFFER           
         BEZ      MED510              NONE, TEST OTHER ANYHOW...                
         BAL,R11  RELADBUF          RELEASE THE FIRST                           
         NOP      0                                                             
*                                                                               
MED510   EQU      %         RELEASE LAST BUFFER                                 
         LW,R6    MEDRBB2           GET CONTROL WORD FOR 2ND BUFFER             
         BEZ      MED520              NONE, FINISHED NOW                        
         BAL,R11  RELADBUF                                                      
         NOP      0                                                             
*                                                                               
MED520   EQU      %         ALL BUFFERS RELEASED; CLOSE DCBS                    
         LW,R10   MEDZ002C                                                      
         STW,R10  MEDROC                                                        
         LI,R9    MEDRODCB          POINT AT OUTPUT DCB                         
         LW,R10   *R9               GET 1ST WORD OF DCB                         
         CW,R10   Y002              IS THE DCB OPEN ?                           
         BAZ      MED530              NO, DON'T TRY TO CLOSE IT                 
*                                                                               
         CAL1,1   MEDROC            CLOSE IT                                    
*                                                                               
MED530   EQU      %         SEE IF INPUT DCB IS TO BE CLOSED                    
         LI,R9    MEDRIDCB          POINT AT INPUT DCB                          
         LW,R10   *R9               GET 1ST WORD OF THIS DCB                    
         CW,R10   Y002              WAS IT EVER OPENED ?                        
         BAZ      MED540              NO, SO DON'T TRY TO CLOSE IT              
*                                                                               
         CAL1,1   MEDROC            CLOSE IT TOO                                
*                                                                               
*                                                                               
*                                                                               
MED540   EQU      %         END OF OPERATIONS IN PART 1; GO TO PART 2           
MED1XITA B        MED600            CONTINUE IN PART 2                          
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
*                                                                               
MED990   EQU      %         SET 'ABORTED BY OPERATOR'                           
         LW,R15   MEDZ090           SET OPERATOR REQUESTED ABORT                
         B        MED999C           AND STOP COPY                               
*                                                                               
*                                                                               
MED994   EQU      %                                                             
         LW,R15   MEDZ094           SET ERROR                                   
         B        MED999C           GO TO COMMON EXIT                           
*                                                                               
*                                                                               
MED995   EQU      %         INSUFFICIENT BLOCKING BUFFERS                       
         LW,R15   MEDZ095                                                       
*                                                                               
*                                                                               
MED999C  EQU      %         COMMON SET ERROR CODE AND TERMINATE COPY            
         STW,R15  MEDRERRS          SET ERROR CODE NAME / ERROR SWITCH          
         B        MED500            START CLEAN-UP                              
         PAGE                       CONSTANTS, DEFAULTS, FPTS ETCS              
         SPACE    2                                                             
MEDZ000  TEXT     '     CPR'        DEFAULT JOB AND TASK NAMES FOR              
         TEXT     'OPERATOR'        KEY-IN REQUESTS                             
MEDZ000# EQU      %-MEDZ000                                                     
*                                                                               
MEDZ001  TEXT     'MO'              DEFAULT OPLABEL FOR CAL REQUESTS            
*                                                                               
*                                                                               
MEDZ002C GEN,1,7,8,16  1,X'15',0,R9  CLOSE FPT FIRST WORD                       
*                                                                               
MEDZ002O GEN,1,7,8,16  1,X'14',0,R9  OPEN FPT FOR IN-, OUT- PUT FILES           
*                                                                               
MEDZ003  TEXTC    '!!MEDIA: MOUNT TAPE(S) FOR XXXX'                             
MEDZ003# EQU      %-MEDZ003                                                     
         PAGE                                                                   
*                                                                               
*                                                                               
MEDZ004  DATA     X'02000000'       FPT FOR TYPING MESSAGES                     
         DATA     P1+F3                                                         
         DATA     MEDRIMAG                                                      
MEDZ004# EQU      %-MEDZ004          LENGTH                                     
*                                                                               
MEDZ005  DATA     X'FFFFFF01'-MEDRSTOP   RESET MASK FOR STATUS CHANGES          
MEDZ005A DATA     X'FFFFFF00'       RESET STATUS, ABORT FLAGS                   
*                                                                               
MEDZ006  GEN,1,7,1,6,17  1,X'1C',1,0,R9    SKIP FILES                           
         DATA     P2+P10+X'28'            FORWARD, GO OVER TM'S, WAIT           
         DATA     MED037X                                                       
*        DATA     0                 TYC CODE WORD                               
MEDZ006# EQU      %-MEDZ006                                                     
*                                                                               
MEDZ008  GEN,1,7,1,6,17  1,X'1D',1,0,R9    SKIP RECORDS, ONE AT A TIME          
MEDZ009  DATA     P1+P2+X'38'              BAC, OVER TM'S, WAIT                 
         PAGE                                                                   
*                                                                               
*                                                                               
MEDZ017  GEN,8,24 X'40',0           WAIT ALL I/O S                              
*                                                                               
MEDZ020  GEN,8,24 X'29',MEDRRB      CHECK READ 'B' BUFFER                       
         DATA     P1+P2+P10                                                     
         DATA     MEDR900           RETURN IF ERRORS                            
         DATA     MEDR900                                                       
MEDZ020# EQU      %-MEDZ020                                                     
*                                                                               
MEDZ021  GEN,8,1,23  X'02',1,MEDRODCB   WRITE E-O-F TO OUTPUT FILE              
         DATA     F3                WAIT FOR IT                                 
MEDZ021# EQU      %-MEDZ021                                                     
*                                                                               
         SPACE    2                                                             
*                                                                               
*                                                                               
MEDZ090  TEXT     'OPER'            OPERATOR  TERMINATED                        
MEDZ091  TEXT     'NOMO'            NO MO OPLABEL                               
MEDZ092  TEXT     'OPNI'            UNABLE TO OPEN INPUT                        
MEDZ093  TEXT     'OPNO'            UNABLE TO OPEN OUTPUT                       
MEDZ094  TEXT     'PREP'            ERROR IN PREPROCESSING                      
MEDZ095  TEXT     'BUFS'            INSUFFICIENT BUFFER SPACE                   
MEDZ096  TEXT     'DEV '            FATAL DEVICE ERROR                          
MEDZ097  TEXT     'SPEC'            SPECIFICATION IN ERROR                      
         PAGE                                                                   
         SPACE    2                                                             
MEDIACSH CRASH    'MEDIA REENTERED'                                             
         SPACE    2                                                             
         OLAYEND                                                                
*                                                                               
        FIN      #MEDIA                                                         
*                                                                               
         END                                                                    
