         TITLE    ' M E D I A   PROCESSOR,  PART 2 '                            
         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 2             
*                                                                               
*                                                                               
         DEF      A:MED2                                                        
         DEF      MED2                                                          
*                                                                               
*                                                                               
         DEF      MED600            NORMAL ENTRY FROM PART 1                    
*                                                                               
         DEF      MED800            CONVERT NUMBER TO EBCDIC FORM               
         DEF      MED810            ACQUIRE A DEVICE FOR MEDIA USE              
         DEF      MED820            PRINT HEADERS, SET VFC FOR PRINTERS         
         DEF      MED830            PRINT TRAILER, RESET VFC                    
         DEF      MED840            REWIND/UNLOAD TAPES                         
         DEF      MED880            WAIT ROUTINE                                
*                                                                               
*                                                                               
         DEF      MED2EXIT          STANDARD EXIT FROM THIS SEGMENT             
         DEF      MED2XITA          SUBROUTINE EXIT                             
         DEF      MED2XITB          ANOTHER SUROUTINE EXIT POINT                
*                                                                               
*                                                                               
*                                                                               
OLAYFLAG EQU      'MED2'            TASK PART 2                                 
         SYSTEM   CPRMON                                                        
         TITLE    '               M E D I A   P R O C E S S O R,  II'           
         SPACE    2                                                             
***********************************************************************         
***********************************************************************         
**                                                                   **         
**                                                                   **         
**       M E D I A   T A S K :    TERMINATION CLEAN-UP - SUBROUTINES **         
**                                                                   **         
**                                                                   **         
***********************************************************************         
***********************************************************************         
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
A:MED2   EQU      %                 MEDIA PART 2                                
MED2     EQU      A:MED2                                                        
*                                                                               
*                                                                               
*                                                                               
MED600   EQU      %         ENTRY FROM PART 1                                   
*                                                                               
*                                                                               
MED610   EQU      %         TEST FOR DELETE FILE IF NO ERRORS                   
         MTW,00   MEDRERRS          WERE THERE ANY ERRORS ?                     
         BNEZ     MED620              YES, REPORT THEM                          
*                                                                               
         LI,R1    MEDPIOPT          PICK UP THE INPUT OPTIONS                   
         LH,R15   *R3,R1            FROM DATA PACKET                            
         CI,R15   MEDHDEL           DELETE SET ?                                
         BAZ      MED615              NO, DO NOT DELETE                         
*                                                                               
         CI,R15   MEDHFILE          IS A FILE SPECIFIED ?                       
         BAZ      MED615              NO, DELETE DONE                           
*                                                                               
         LW,R10   MEDPICTL,R3       GET AREA NAME                               
         AND,R10  M16                                                           
         OR,R10   MEDZ022           ADD IN FUNCTION CODE, P0                    
         LW,R11   MEDZ022A          GET P-BITS                                  
         LW,R12   MEDPIFIL,R3       AND TWO HALVES                              
         LW,R13   MEDPIFIL+1,R3                    OF THE FILE NAME             
         LCI      4                                                             
         STM,R10  MEDRFPTX                                                      
         CAL1,7   MEDRFPTX          DELETE THE DARN THING                       
         PAGE                                                                   
         SPACE    2                                                             
MED615   EQU      %         TELL OPERATOR THE THE REQUEST IS DONE OK            
         LI,R1    -MEDZ026#         MOVE MESSAGE                                
*                                                                               
MED617   EQU      %                                                             
         LW,R0    MEDZ026+MEDZ026#,R1                                           
         STW,R0   MEDRIMAG+MEDZ026#,R1                                          
         BIR,R1   MED617                                                        
*                                                                               
         LI,R4    BA(MEDRIMAG)         COMPUTE                                  
         AI,R4    ((MEDZ026#-1)**2)+3          LOC FOR ID NUMBER                
         LI,R1    MEDPMASN                                                      
         LB,R1    *R3,R1            GET FROM PACKET                             
         BAL,R8   MED800            CONVERT AND STORE                           
         B        MED630            TELL WORLD WHAT HAPPENED TO COPY            
         PAGE                                                                   
         SPACE    2                                                             
MED620   EQU      %         REPORT ERRORS FOUND                                 
         LI,R1    -MEDZ015#         MOVE MESSAGE                                
*                                                                               
MED623   EQU      %                                                             
         LW,R0    MEDZ015+MEDZ015#,R1                                           
         STW,R0   MEDRIMAG+MEDZ015#,R1                                          
         BIR,R1   MED623                                                        
*                                                                               
         LI,R4    BA(MEDRIMAG)      COMPUTE                                     
         AI,R4    ((MEDZ015#-2)**2)+1          LOC FOR ID NUMBER                
         LI,R1    MEDPMASN                                                      
         LB,R1    *R3,R1            GET FROM PACKET                             
         BAL,R8   MED800            CONVERT AND STORE                           
         LW,R0    MEDRERRS          MOVE ERROR CODE                             
         STW,R0   MEDRIMAG+MEDZ015#-1                                           
         LW,R10   MEDRERRS+1        IS TYC CODE SET NON-ZERO?                   
         BEZ      MED630              NO, NO SPECIAL ERROR CODE                 
*                                                                               
         LI,R0    ', '              EXTEND MESSAGE WITH TYC CODE                
         STH,R0   MEDRIMAG+MEDZ015#                                             
         MTB,4    MEDRIMAG          STEP LENGTH BY ADDED MESSAGE                
         SLD,R10  -4                SHIFT OUT SECOND DIGIT                      
         LI,R1    -2                SET DIGIT COUNT AND STORE INDEX             
         PAGE                                                                   
         SPACE    2                                                             
MED625   EQU      %         CONVERT AND STORE A HEX DIGIT                       
         AND,R10  M4                GET SINGLE DIGIT                            
         AI,R10   X'F0'   C'0'      CONVERT TO EBCDIC                           
         CI,R10   X'FA'                                                         
         BL       MED627            0 - 9, OK AS IS                             
         AI,R10   -(X'FA'-X'C1')    ADJUST FOR A-F                              
MED627   STB,R10  (MEDRIMAG+MEDZ015#+1),R1 STORE CHARACTER                      
         SLD,R10  4                 GET LAST DIGIT                              
         BIR,R1   MED625                                                        
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED630   EQU      %         TYPE WHAT HAPPENED, HOW WE FINISHED                 
         LCI      MEDZ004#                                                      
         LM,R10   MEDZ004                                                       
         STM,R10  MEDRFPTX                                                      
         CAL1,2   MEDRFPTX          TYPE OUT THE TERMINATION MSG                
*                                                                               
*                                                                               
*                                                                               
MED632   EQU      %         DELETE THE REQUEST'S ECB                            
         BAL,R8   EMDELECB                                                      
         NOP      0                                                             
         PAGE                                                                   
*                                                                               
*                          REMOVE ANY RESERVED BY MEDIA FLAGS, AND LOOK         
*                          FOR SYMB REQUEST FLAGS                               
         LI,R14   0                 SET NO SYMB REQUESTS FOUND                  
         LH,R1    DCT1              SET NUMBER OF DEVICES TO SCAN               
         LI,R15   KFF-DCTRBMM-DCTRBMMR  RESET MEDIA HAS DEVICE FLAG             
*                                                                               
         DISABLE                                                                
*                                                                               
MED635   EQU      %                                                             
         LB,R0    DCTRBM,R1                                                     
         CI,R0    DCTRBMR           IS DEVICE REQUESTED ?                       
         BAZ      %+2                 NO                                        
         AI,R14   1                   YES, STEP COUNT                           
         AND,R0   R15               REMOVE POSSIBLE MEDIA HAS BIT               
         STB,R0   DCTRBM,R1                                                     
         BDR,R1   MED635                                                        
         ENABLE                                                                 
*                                                                               
*                                                                               
         CI,R14   0                 WERE ANY SYMBIONT REQUESTS FOUND ?          
         BEZ      MED2EXIT            NO                                        
*                                                                               
*                                                                               
         LW,R1    *K:RTS              YES, 'START' SYMBIONTS                    
         LI,R0    MEDZ016#          MAKE ROOM IN STACK FOR FPT                  
         MSP,R0   *K:RTS                                                        
         LCI      MEDZ016#                                                      
         LM,R8    MEDZ016           MOVE THE FPT                                
         STM,R8   1,R1                                                          
         CAL1,7   1,R1              DO THE START                                
         LI,R0    -MEDZ016#                                                     
         MSP,R0   *K:RTS            POP THE STACK                               
         PAGE                                                                   
*                                                                               
*                                                                               
MED636   EQU      %         ALLOW A FEW SECONDS FOR SYMBIONTS TO START          
         BAL,R14  MED880            WAIT A BIT                                  
*                                                                               
*                                                                               
MED2EXIT B        MEDIATSK          START OVER: TRY A NEW REQUEST               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED2XITA B        *R14              RETURN                                      
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*                 CONVERT NUMBER TO EBCDIC DECIMAL                    *         
*                                                                     *         
***********************************************************************         
*                                                                     *         
*                                                                     *         
*        INPUTS:  R1 :   THE NUMBER TO BE CONVERTED                   *         
*                 R8 :   RETURN LINK                                  *         
*                 R4 :   BYTE ADDRESS OF WHERE TO STORE LAST DIGIT    *         
*                                                                     *         
*        OUTPUT:  CONVERTED NUMBER IN  (R4)-4 THRU (R4)               *         
*                                                                     *         
*        USES     R14: DIGIT COUNTER;  SET TO 0 ON EXIT               *         
*                 R0 : FOR CONVERSION OF NUMBER                       *         
*                                                                     *         
*                                                                     *         
MED800   EQU      %         CONVERT A NUMBER TO DECIMAL EBCDIC        *         
         LI,R14   4                 SET NUMBER OF PLACES              *         
*                                                                     *         
MED800A  EQU      %                                                   *         
         LI,R0    0                 CLEAR LEFT HALF OF NUMBER         *         
         DW,R0    MEDZ014           REMOVE A DECIMAL PLACE FROM RIGHT *         
         AI,R0    X'F0'             CONVERT TO EBCDIC                 *         
         STB,R0   0,R4              STORE THE CHARACTER               *         
         AI,R4    -1                STEP TO NEXT                      *         
         BDR,R14  MED800A           LOOP FOR NEXT                     *         
MED2XITB B        *R8               RETURN                            *         
*                                                                     *         
***********************************************************************         
         TITLE    '         ACQUIRE A DEVICE FOR MEDIA USE'                     
*                                                                     *         
***********************************************************************         
*                                                                     *         
*        THIS ROUTINE IS CALLED TO OBTAIN USE OF A DEVICE FOR MEDIA.  *         
*        IT IS TO HANDLE ALL ENQUEUEING CONFLICTS WITH THE SYMBIONT   *         
*        PROCESSOR.                                                   *         
*                                                                     *         
*        IT LOOKS THE DEVICE UP IN THE DEVICE LIST (DCT16), AND TESTS *         
*        IF IT IS IN USE BY THE SYMBIONT PROCESSOR.                   *         
*                                                                     *         
*        IF NOT, IT RESETS THE REQUEST FLAGS FOR ALL THE DEVICES OF THE         
*        SAME CLASS, SETS THE IN USE BY MEDIA FLAG FOR THE SPECIFIED  *         
*        DEVICE AND EXITS TO THE MARK + 1.                            *         
*                                                                     *         
*        IF THE DEVICE IS IN USE BY THE SYMBIONT PROCESSOR, IT TESTS  *         
*        TO SEE IF IT IS A SWITCHABLE DEVICE, (THAT IS, IF SOME       *         
*        OTHER DEVICE OF THE SAME TYPE MAY BE USED INSTEAD OF IT).    *         
*        THIS IS DONE BY GETTING DEVICE CLASS (READER, PUNCH, TAPE, ) *         
*        WORD FROM THE MEDZDEVS TABLE AND TESTING THE SWITCHABLE FLAG.*         
*        IF SWITCHABLE, THE ROUTINE THEN SEARCHES THE DEVICE LIST     *         
*        FOR OTHER DEVICES OF THE SAME TYPE THAT ARE NOT IN USE BY THE*         
*        SYMBIONT PROCESSOR.                                          *         
*                                                                     *         
*        IF A FREE DEVICE IS FOUND, THE GIVEN DEVICE NAME IS CHANGED TO         
*        THE NEW, FREE, NAME; IT IS THEN MARKED AS IN USE BY MEDIA AND*         
*        IS PROCESSED AS USUAL.                                       *         
*                                                                     *         
*        IF NO FREE DEVICES ARE FOUND, ALL DEVICES OF THE SAME CLASS ARE        
*        MARKED AS 'REQUESTED' OF THE SYMBIONT PROCESSOR AND THE ROUTINE        
*        RETURNS TO THE MARK.  THE CALLER THEN TAKES WHAT ACTION IS   *         
*        NECESSARY TO WAIT FOR ONE OF THE DEVICES TO FREE UP.         *         
*                                                                     *         
***********************************************************************         
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*        REGISTER USAGE:                                              *         
*                                                                     *         
*                 R0 :  WORK OR TEMP                                  *         
*                 R1 :  INDEX OF DEVICE IN DEVICE LIST                *         
*                 R2 :  ADDR OF ECB (NOT USED OR CHANGED HEREIN)      *         
*                 R3 :  ADDR OF PACKET (NOT USED OR CHANGED)          *         
*                 R4 :                                                *         
*                 R5 :  PARAM TO/ RESULT FROM MED811                  *         
*                 R6 :  ADDR OF CTRL INFO TO USE IN DATA PACKET       *         
*                 R7 :  DEVICE TYPE INDEX FROM DEVICE LIST            *         
*                 R8 :  DEVICE INFO & CONTROL WORD FROM MEDZDEVS,R7   *         
*        R9 :  DCB ADDRESS                                                      
*                 R10:  USUALLY WILL HAVE                             *         
*                 R11:                    THE DEVICE NAME             *         
*                 R12:                                                *         
*                 R13:                                                *         
*                 R14:  LINK TO ROUTINE; LINK TO MED811               *         
*                 R15:  TEMP                                          *         
*                                                                     *         
***********************************************************************         
         PAGE                                                                   
         SPACE    2                                                             
MED810   EQU      %                                                             
         LCI      MEDZ013#          SET UP THE 'SET DEVICE' FPT                 
         LM,R10   MEDZ013                                                       
         STM,R10  MEDRFPTX                                                      
         LW,R0    MEDPICTL,R6       GET CONTROL WORD FOR THE                    
         LB,R0    R0                PACKET TO PROCESS                           
         CI,R0    MEDOFILE          IS A FILE SPECIFIED ?/                      
         BAZ      MED810A             NO, DEVICE;  PROCESS                      
*                                                                               
         LW,R0    R6                COMPUTE ADDRESS OF FILE NAME                
         AI,R0    MEDPICTL          FROM DISPLACEMENT IN PACKET                 
         STW,R0   MEDRFPTX+3                                                    
*                                                                               
         AI,R0    MEDPIACN-MEDPICTL POINT TO ACCOUNT INFO                       
         STW,R0   MEDRFPTX+4        PUT IN FPT                                  
*                                                                               
         CAL1,1   MEDRFPTX          SET INFO INTO DCB                           
         LH,R8    MEDZDEVR          GET DEVICE INFO WORD                        
         AI,R14   1                 RETURN TO MARK + 1                          
         B        MED2XITA          'CAUSE ALL IS OK                            
         PAGE                                                                   
*                                                                               
* DEVICE ASSIGNMENT                                                             
*                                                                               
MED810A  EQU      %         DEVICE; MUST BE SURE WE CAN HAVE IT                 
         PUSH     R14               SAVE RETURN                                 
         LW,R0    MEDZ013D          SET UP TO STORE A DEVICE NAME               
         STW,R0   MEDRFPTX+1        INTO THE DCB                                
         LCI      2                 GET NAME OF DEVICE WE WANT TO               
         LM,R10   MEDPIFIL,R6       FIND                                        
         CD,R8    ZEROS             IS IT THE NULL DEVICE ?                     
         BNE      MED810AA            NO, FIND OUT WHICH                        
*                                                                               
MED810N  EQU      %         ASSIGNED TO NULL DEVICE; ACCEPT OK                  
         MTB,-2   MEDRFPTX+1  ##### REMOVE DEVICE P-BIT; NO ASSGN               
         LW,R8    MEDZDEVX          GET DEFAULT DEVICE INFO WORD                
         LI,R1    0                 AND SET NULL DEVICE INDEX                   
         B        MED810L             AND EXIT NORMALLY                         
         PAGE                                                                   
*                                                                               
*                                                                               
MED810AA EQU      %         SET UP TO LOOK IT UP IN LIST                        
         SLD,R10  -24               MASSAGE IT TO LOOK LIKE LIST                
         AW,R10   Y155A5A           ENTRIES (N/L,BANGS IN FRONT)                
         LH,R1    DCT1              SET LENGTH OF DEVICE LIST                   
*                                                                               
MED810B  EQU      %         LOOK THE NAME UP                                    
         CD,R10   DCT16,R1                                                      
         BE       MED810C           FOUND                                       
*                                                                               
         BDR,R1   MED810B                                                       
*                                                                               
*                                                                               
MED810BA EQU      %         FATAL ERROR; SET ERROR FLAG                         
         LW,R15   MEDZ097           SET ERROR FLAG, CODE                        
         STW,R15  MEDRERRS                                                      
         B        MED810H                                                       
*                                                                               
MED810G  EQU      %         MUST HAVE SPECIFIC DEVICE; SET SYM REQ              
         LB,R15   DCT3,R1           BUT FIRST TEST IF IT IS DOWN                
         CI,R15   X'20'             IS IT SO MARKED ?                           
         BANZ     MED810BA            YES, REPORT A FATAL ERROR                 
*                                                                               
         LI,R15   DCTRBMMR                                                      
         OR,R0    R15                                                           
         STB,R0   DCTRBM,R1         STORE BACK                                  
*                                                                               
MED810H  EQU      %         EXIT TO WAIT AVAILABILITY                           
         ENABLE                                                                 
         PULL     R14                                                           
         B        MED2XITA                                                      
*                                                                               
MED810C  EQU      %         DEVICE FOUND; IS IT AVAILABLE ?/                    
         LB,R7    DCT4,R1           GET DEVICE TYPE                             
         LH,R8    MEDZDEVS,R7       AND INFO WORD FOR LATER USE                 
         DISABLE                                                                
         LB,R0    DCTRBM,R1         IS THE DEVICE FREE ?/                       
         LB,R4    DCT3,R1           THAT IS, IS IT NOT MARKED DOWN ?            
         CI,R4    X'20'                                                         
*                                                                               
*                                                                               
        DO       #SYMB                                                          
         BANZ     MED810CD            MARKED DOWN, TRY SUBSTITUTE               
*                                                                               
         CI,R0    DCTRBMS             IE. NOT IN USE BY SYMBIONTS ?/            
         BAZ      MED810J             YES, RESERVE IT FOR OURSELVES             
*                                                                               
MED810CD EQU      %         DEVICE DOWN; TEST SWITCHABILITY                     
         CI,R8    MEDASW            IS IT SWITCHABLE ?/                         
         BAZ      MED810G             NO, MUST HAVE AS SPECIFIED                
*                                                                               
         LH,R5    DCT1              SET TO SCAN LIST FOR OTHER OF               
         AI,R5    1                 SAME CLASS AS IN R7                         
*                                                                               
MED810D  EQU      %         FIND EVERY DEVICE OF CLASS R8                       
         BAL,R14  MED811                                                        
         B        MED810E             LAST FOUND;  NONE AVAILABLE               
*                                                                               
         LB,R0    DCTRBM,R5         IN USE BY SYMBIONTS ?/                      
         CI,R0    DCTRBMS           CAN'T USE IT IF SO                          
         BANZ     MED810D             SO TRY AGAIN FOR ANOTHER                  
*                                                                               
         LW,R1    R5                FOUND; SET TO USE THIS ONE                  
         LD,R10   DCT16,R1          CHANGE NAME TO FREE DEVICE                  
         SLD,R10  24                REMOVE THE EXTRA STUFF                      
         OR,R11   BLANKS                                                        
         LCI      2                                                             
         STM,R10  MEDPIFIL,R6       AND STORE IN PACKET AREA                    
         B        MED810J           PRETEND IT WAS SPECIFIED ORIGINALLY         
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED810E  EQU      %         NO OTHER DEVICE OF SAME CLASS AVAILABLE             
         LI,R1    0                 SET 'HAVE NO OTHER DEVICE'                  
         LI,R7    0                 SET NO AVAILABLE DEVICES                    
         LH,R5    DCT1              REQUEST ALL OF THEM                         
         AI,R5    1                                                             
         LI,R15   DCTRBMMR          SET REQUEST FLAG                            
*                                                                               
MED810F  EQU      %                                                             
         BAL,R14  MED811                                                        
         B        MED810I           THEN EXIT AND WAIT FOR ONE (ANY)            
*                                                                               
         LB,R14   DCTRBM,R5                                                     
         OR,R14   R15                                                           
         STB,R14  DCTRBM,R5                                                     
         AI,R7    1                 STEP COUNT OF DEVICES AVAILABLE             
         B        MED810F                                                       
*                                                                               
*                                                                               
MED810I  EQU      %         ALL DEVICES REQUESTED: WERE THERE ANY ?             
         CI,R7    0                 IS AT LEAST 1 DEVICE AVAILABLE ?            
         BGZ      MED810H             YES, EXIT TO WAIT FOR IT                  
         B        MED810BA            NO, NONE; A FATAL ERROR                   
*                                                                               
        ELSE                                                                    
         BANZ     MED810BA          MARKED DOWN - FATAL ERROR                   
        FIN      #SYMB                                                          
*                                                                               
*                                                                               
MED810J  EQU      %         DEVICE FREE; SET MEDIA HAS IT                       
         LI,R15   KFF-DCTRBMMR-DCTRBMM                                          
         AND,R0   R15               RESET REQUEST & POSSIBLY 'MEDIA' BIT        
         AI,R0    DCTRBMM           THEN INSURE 'MEDIA' INDICATOR IS SET        
         STB,R0   DCTRBM,R1                                                     
*                                                                               
        DO       #SYMB                                                          
         CI,R8    MEDASW            IS IT A SWITCHABLE DEVICE ?/                
         BAZ      MED810L             NO, OK TO EXIT                            
*                                                                               
         LH,R5    DCT1              INSURE ALL OTHER REQUEST FLAGS ARE          
         AI,R5    1                 TURNED OFF                                  
*                                                                               
MED810K  EQU      %                                                             
         BAL,R14  MED811                                                        
         B        MED810L           END; EXIT                                   
*                                                                               
         LB,R0    DCTRBM,R5                                                     
         AND,R0   R15               REMOVE REQUEST, HAS                         
         STB,R0   DCTRBM,R5                                                     
         B        MED810K                                                       
        FIN      #SYMB                                                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
*                                                                               
MED810L  EQU      %         END OF ACQUISITION;  EXIT SUCCESSFULLY              
         ENABLE                                                                 
         AND,R8   M16               REMOVE SIGN EXTENSION IF ANY                
         STB,R1   R8                SAVE DCT INDEX IN CODE WORD                 
         LW,R0    R6                                                            
         AI,R0    MEDPIFIL          POINT AT DEVICE NAME IN PACKET              
         STW,R0   MEDRFPTX+3                                                    
         STW,R8   R10               SAVE COPY TO TEST FOR ERRORS                
         CAL1,1   MEDRFPTX          STORE INFO                                  
         CW,R8    R10               ANY ERRORS ?                                
         BNE      MED810MM            YES, REPORT FATAL DEVICE ERROR            
*                                                                               
         PULL     R14                                                           
         AI,R14   1                                                             
         B        MED2XITA          EXIT AT LAST                                
*                                                                               
*                                                                               
MED810MM EQU      %         FATAL ERROR ON SET DEVICE INTO DCB                  
         LB,R10   R10               GET TYC CODE                                
         STW,R10  MEDRERRS+1        AND SET FOR ERROR MESSAGE                   
*        LW,R15   MEDZ097           SET TYPE OF ERROR MESSAGE INSERT            
         B        MED810BA          STORE INSERT, EXIT WITH ERROR               
         TITLE    '          SCAN DEVICE LIST FOR DEVICE OF TYPE (R7)'          
        DO       #SYMB                                                          
*                 USED TO FIND ALL OTHER DEVICES OF CLASS IN R8.                
*                 THE DEVICE INDEX IN R1 WAS USED TO FIND THE DEVICE AND        
*                 DEVICE TYPE.  ALL OTHER DEVICES WITH INFO WORDS THAT          
*                 ARE THE SAME WILL BE FOUND.  DEVICE AT R1 IS SKIPPED,         
*                 AS ARE ALL DEVICES MARKED 'DOWN'.                             
*                                                                               
*        INPUTS:  R1   ORIGINAL DEVICE INDEX                                    
*                 R7   COUNTER OF DEVICES FOUND                                 
*                 R5   INDEX FOR SCANNING THE DEVICES                           
*                 R8   INFO WORD FOR DEVICE IN R1                               
*                                                                               
*        OUTPUT:  R5   INDEX OF NEXT DEVICE FOUND                               
*                                                                               
*        USES:    R4   TEMP, AND INDEX INTO MEDZDEVS TABLE                      
*                 R5   DEVICE INDEX                                             
*                 R14  RETURN ADDRESS (MARK)                                    
*                                                                               
*        LINK:    R14                                                           
*                                                                               
*        EXITS:   R14    NO MORE OF THE SAME CLASS                              
*                 R14+1  NEXT DEVICE FOUND; INDEX IN R5                         
*                                                                               
***********************************************************************         
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED811   EQU      %                                                             
         BDR,R5   MED811B           ANOTHER TO TEST                             
         B        *R14              NO MORE; EXIT END OF LIST                   
*                                                                               
MED811B  EQU      %                                                             
         CW,R5    R1                AT ORIGINAL DEVICE ?/                       
         BE       MED811              YES, SKIP OVER IT                         
*                                                                               
         LB,R4    DCT3,R5           GET DEVICE STATUS BYTE AND TEST             
         CI,R4    X'20'             IS IT MARKED 'DOWN' ??                      
         BANZ     MED811              YES, SKIP OVER IT                         
*                                                                               
         LB,R4    DCT4,R5           FETCH DEVICE TYPE FROM DEV LIST             
         CH,R8    MEDZDEVS,R4       DO THE INFO WORDS MATCH ?/                  
         BNE      MED811              NO, NOT SAME CLASS; TRY AGAIN             
         AI,R14   1                   YES, EXIT AT FOUND NEXT EXIT              
         B        *R14              OOKK                                        
        FIN      #SYMB                                                          
         TITLE    '         PERFORM PREP OPERATIONS ON PRINTER, TAPES'          
         SPACE    2                                                             
***********************************************************************         
*                                                                               
*                                                                               
*   MED820        WRITE HEADERS FOR PRINTER OUTPUT                              
*                                                                               
*                                                                               
*        INPUTS:                                                                
*                 R15 = 0 FOR BREAK PAGE OUTPUT                                 
*                       + FOR NO BREAK PAGES                                    
*                                                                               
*        OUTPUTS:   NONE, EXCEPT ON THE PRINTER                                 
*                                                                               
*        LINK:    R14 (R8 NOT USED AS CAL ERRORS ALTER IT)                      
*                                                                               
*        EXITS:   R14:    FATAL ERROR DURING PRINTING; CODE IN MEDRERRS         
*                 R14+1:  NORMAL EXIT, NO ERRORS                                
*                                                                               
*        USES:    R1 :  INDEX FOR VARIOUS PURPOSES                              
*                 R7 :  ADDRESS OF OUTPUT BUFFER                                
*                 R8 :  FILE-, JOB- NAME TEMPS; LINK TO GENCHARS                
*                 R9 :  2ND HALF OF R8                                          
*                 R10:  TEMP; PARAM TO GENCHARS                                 
*                 R11:  TEMP; PARAM TO GENCHARS                                 
*                 R14:  LINK TO INTERNAL SUBROUTINES                            
*                                                                               
*                                                                               
***********************************************************************         
*                                                                               
*                                                                               
MED820   EQU      %         WRITE HEADERS TO THE PRINTER: SET VFC               
         PUSH     R14               SAVE RETURN ADDRESS                         
         LI,R14   0                                                             
         STW,R14  MEDRRA+MEDRRBTD   RESET BTD VALUES                            
         STW,R14  MEDRRB+MEDRRBTD                                               
*                                                                               
         LW,R10   MEDZ025N          RESET VFC BYTE COUNT ADJUSTMENT             
         STW,R10  MEDRVFCA          TO NO-OPS                                   
         STW,R10  MEDRVFCB                                                      
         BAL,R14  MED850            TEST IF PRINTER; SET VFC IF YES             
         B        MED820XX            IS NOT PRINTER; EXIT NOW                  
*                                                                               
         CI,R15   0                                                             
         BNE      MED820K           SKIP BREAK PAGES IF NOT ZERO                
*                                                                               
         LI,R6    2                 SET NUMBER OF TIMES THROUGH LOOP            
*                                                                               
*                                                                               
MED820AA EQU      %         PRINT A SEPARATOR PAGE                              
         LI,R1    33                SET WIDTH OF LINE                           
         LW,R10   MEDZ019           OUT A ROW OF 'XEROX'S                       
*                                                                               
MED820A  EQU      %                                                             
         STW,R10  *R7,R1                                                        
         BDR,R1   MED820A                                                       
*                                                                               
         STW,R10  *R7                                                           
         LI,R10   X'F1'             GO TO TOP OF FORM                           
         STB,R10  *R7                                                           
         BAL,R14  MED860            PRINT THE LINE                              
         B        MED820Z             ERROR; TERMINATE AND EXIT NOW             
         LI,R10   X'C0'             SPACE 1 LINE AFTER PRINT ONLY               
         STB,R10  *R7                                                           
         LI,R1    3                 NUMBER OF LINES MORE TO PRINT               
*                                                                               
MED820B  EQU      %         PRINT SEPARATOR LINES                               
         BAL,R14  MED860            PRINT THEM                                  
         B        MED820Z             ERROR; TERMINATE AND EXIT NOW             
         BDR,R1   MED820B           PRINT ANOTHER                               
*                                                                               
         LI,R1    132                CLEAR LINE                                 
         LW,R10   BLANKS                                                        
         STB,R10  *R7,R1                                                        
         BDR,R1   %-1                                                           
*                                                                               
         LI,R10   X'C1'             UPSPACE ONE                                 
         STB,R10  *R7                                                           
         LW,R10   MEDZ034           MOVE 'ID= '                                 
         STW,R10  MEDRFPTX+2        SET   1ST HALF ID TEMP                      
         LI,R4    BA(MEDRFPTX)      PUT ID NUMBER INTO MEDRFPTX+2, X+3          
         AI,R4    12+3              RIGHT JUSTIFIED                             
         LI,R1    MEDPMASN                                                      
         LB,R1    *R3,R1            FETCH MASN FOR USER                         
         BAL,R8   MED800            CONVERT NUMBER                              
         LW,R10   MEDZ035           GET SEPARATER                               
         LCI      2                                                             
         LM,R8    MEDRFPTX+2        MOVE IN NUMBER TO LINE                      
         STM,R8   19,R7                                                         
         LM,R8    MEDZ030           MOVE LINE 'TASKNAME'                        
         STM,R8   1,R7                                                          
         STW,R10  3,R7                                                          
         LM,R8    MEDRTASK                                                      
         STM,R8   4,R7                                                          
         LM,R8    MEDZ031           MOVE 'JOB NAME' TO LINE                     
         STM,R8   7,R7                                                          
         STW,R10  9,R7                                                          
         LM,R8    MEDRJOB                                                       
         STM,R8   10,R7                                                         
         LM,R8    MEDZ033           MOVE 'INPUT' MESSAGE                        
         STM,R8   13,R7                                                         
         STW,R10  15,R7                                                         
         LI,R1    MEDPIOPT                                                      
         LH,R10   *R3,R1            GET OPTIONS FLAGS                           
         CI,R10   MEDHFILE          FILE SPECIFIED ?                            
         BANZ     MED820F             YES                                       
*                                                                               
         LI,R1    MEDPIFIL          NO, GET DEVICE NAME                         
         LCI      2                                                             
         LM,R8    *R3,R1                                                        
         STM,R8   16,R7             AND STORE                                   
         B        MED820H                                                       
*                                                                               
MED820F  EQU      %         GET AND ENTER FILE NAME                             
         LI,R1    MEDPIAR           ACCESS AREA NAME FIRST                      
         LH,R8    *R3,R1                                                        
         SLS,R8   16                LEFT JUSTIFY IN WORD                        
         AI,R8    C', '             PUT ',' AND ' ' AFTER IT,                   
         STW,R8   16,R7             AND STORE                                   
         LI,R1    MEDPIFIL                                                      
         LCI      2                                                             
         LM,R8    *R3,R1                                                        
         STM,R8   17,R7             AND STORE                                   
*                                                                               
*                                                                               
MED820H  EQU      %                                                             
         LW,R8    MEDZ027           FORM FPT TO PUT DATE/TIME IN LINE           
         AW,R8    R7                                                            
         CAL1,8   R8                MOVE IT THERE                               
         BAL,R14  MED860            PRINT THEM                                  
         B        MED820Z             ERROR; TERMINATE AND EXIT NOW             
*                                                                               
         LI,R1    MEDRODCB          SET DCB ADDR FOR CHAR PRINT                 
         LW,R10   R7                POINT AT THE PRINT LINE FOR IT              
         LI,R11   MEDRJOB           POINT AT 1ST LINE OF CHARS                  
         BAL,R8   GENCHARS          OUT THEM                                    
         BAL,R9   MED820Q           SEE IF RECOVERABLE ERROR                    
         LW,R10   R7                RESET ADDRESS OF BUFFER                     
         LI,R11   MEDRFPTX+2        POINT AT MEDIA ID NUMBER                    
         BAL,R8   GENCHARS          AND OUT THEM                                
         BAL,R9   MED820Q           SEE IF RECOVERABLE ERROR                    
*                                                                               
         BDR,R6   MED820AA          PRINT ANOTHER SIMILIAR PAGE                 
*                                                                               
         BAL,R14  MED830            TOP OF FORM                                 
         B        MED820Z           ERROR, TERMINATE AND EXIT                   
*                                   OK                                          
         BAL,R14  MED850            SET UP FOR PRINT W/VFC AGAIN                
         B        MED820Z           ERROR                                       
*                                   OK                                          
MED820K  RES      0                 ENTRY IF BREAK PAGES SKIPPED                
*                                                                               
         LI,R1    MEDPOOPT          FETCH OUTPUT OPTIONS INFO                   
         LH,R10   *R3,R1                                                        
         CI,R10   MEDHNVFC          IS NVFC REQUESTED ?                         
         BAZ      MED820X             NO,  USE VFC BYTE IN RECORD               
*                                                                               
         CI,R10   MEDHSPAC          DID USER SPECIFY SPACING ?                  
         BAZ      MED820N             NO, TURN VFC OFF                          
*                                                                               
         LW,R1    R10               COPY OPTION WORD WITH COUNT IN IT           
         SLS,R1   -4                RIGHT JUSTIFY THE COUNT,                    
         AND,R1   XF                EXTRACT IT,                                 
         LB,R1    MEDZ012,R1        AND USE TO GET VFC BYTE                     
         STB,R1   *(MEDRWA+MEDRWBUF)  STORE AS FIRST CHARACTER IN THE           
         STB,R1   *(MEDRWB+MEDRWBUF)  OUTPUT BUFFERS                            
*                                                                               
*                                                                               
MED820M  EQU      %         ADJUST READ ADDRESS TO SKIP VFC BYTE                
         MTW,+1   MEDRRA+MEDRRBTD   MOVE START BYTE IN FIRST WORD UP            
         MTW,+1   MEDRRB+MEDRRBTD   1 BYTE PAST VFC BYTE                        
         LW,R10   MEDZ025Y          SET TO INCREASE BYTE COUNT TO               
         STW,R10  MEDRVFCA          IN MAIN LOOP TO INCLUDE THE VFC             
         STW,R10  MEDRVFCB          BYTE                                        
         B        MED820X           AND EXIT                                    
*                                                                               
*                                                                               
MED820N  EQU      %         RESET VFC TO NOT USE IT                             
         LW,R10   MEDZ011           FETCH FIRST PART OF SET VFC FPT             
         LI,R11   0                 SET 'NO VFC'                                
         LCI      2                                                             
         STM,R10  MEDRFPTX          SET FPT                                     
         CAL1,1   MEDRFPTX          SET BIT IN DCB                              
         PAGE                                                                   
*                                                                               
*                                                                               
MED820X  EQU      %         EXIT HEADER PRINT ROUTINE                           
*                         CLEAN UP BY RESTORING WRITE 'A' FPT                   
         LW,R10   MEDRWA+1          RESET WAIT BIT IN FPT                       
         AND,R10  FFFFFFEF                                                      
         STW,R10  MEDRWA+1                                                      
         LW,R10   MEDRWB+MEDRWBYT   RESET WRITE BYTE COUNT TO PRESET            
         STW,R10  MEDRWA+MEDRWBYT   MINIMUM SIZE                                
*                                                                               
MED820XX EQU      %         RETURN AT OK OR ERROR EXIT                          
         PULL     R14               RECOVER RETURN ADDRESS                      
         AI,R14   1                                                             
         B        MED2XITA          AND RETURN                                  
*                                                                               
*                                                                               
MED820Z  EQU      %         FATAL ERROR; ADJUST EXIT                            
         PULL     R14               GET CURRENT RETURN ADDRESS                  
         AI,R14   -1                FIX SO OK EXIT IS REALLY ERROR EXIT         
         PUSH     R14               AND SAVE BCK                                
         B        MED820X           AND RESET VFC, FPT TO NORMAL STATE          
*                                                                               
*                                                                               
MED820Q  EQU      %         ERROR ROUTINE FOR BREAK PAGE PRINT                  
         BAL,R14  MED860E           PROCESS ERROR CODE                          
         B        MED820Z           FATAL ERROR; STOP NOW                       
         B        *R9               NOT FATAL; TRY RESET OF PAGES               
*                      R8 NOT USED SINCE MED860E MAY ALTER IT                   
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*                          WRITE TRAILER LABEL FOR PRINTER            *         
*                                   (RESET BTD WORD IN READ FPT'S)    *         
***********************************************************************         
*                                                                     *         
*                                                                     *         
*        INPUTS:  NONE                                                *         
*                                                                     *         
*        OUTPUTS: PRINTER SKIPPED TO TOP OF NEXT PAGE                 *         
*                                                                     *         
*        LINK:    R14                                                 *         
*                                                                     *         
*        EXITS:   R14  :  FATAL ERROR PRINTING TRAILER; CODE IN ERRS  *         
*                 R14+1:  NORMAL EXIT                                 *         
*                                                                     *         
*        USES:    R1 :  INDEX FOR CLEAR PRINT LINE LOOP               *         
*                 R7 :  ADDRESS OF PRINT LINE (SET BY MED850)         *         
*                 R14:  TEMP; LINK TO MED850, MED860                  *         
*                                                                     *         
***********************************************************************         
*                                                                               
MED830   EQU      %         WRITE TRAILER INFO TO PRINTER                       
         PUSH     R14               SAVE RETURN                                 
         BAL,R14  MED850            TEST AND SET UP PRINTER                     
         B        MED820XX            NOT PRINTER; EXIT NOW                     
*                                                                               
         STW,R14  *R7               GET FIRST WORD TOO                          
         LI,R14   X'F1'             SET TO SKIP TO TOP OF NEW PAGE              
         STB,R14  *R7                                                           
         LI,R1    1                 SET BYTE COUNT TO 1                         
         XW,R1    MEDRWA+5          TO FORCE IT TO JUST FORMAT                  
         BAL,R14  MED860            PRINT THE LINE                              
         B        MED820Z             ERROR, WE ARE ZAPPED                      
         STW,R1   MEDRWA+5          RESTORE BYTE COUNT                          
         B        MED820N           OK, RESET VFC, FPT, AND EXIT OK             
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*                                                                     *         
*  MED840         PROCESS REWIND/UNLOAD REQUESTS FOR TAPE INPUT/OUTPUT*         
*                 DEVICES.  NO OPERATION IS DONE IF NONE ARE REQUESTED*         
*                                                                     *         
*                                                                     *         
*                                                                     *         
*        INPUTS:  R9 :  ADDRESS OF DCB OF TAPE TO PROCESS             *         
*                 R14:  RETURN LINK ADDRESS                           *         
*                 R15:  CONTROL FLAGS FOR UNIT FROM DATA PACKET       *         
*                                                                     *         
*                                                                     *         
*        OUTPUT:  NONE, EXCEPT TAPE IS BEING REWOUND OR UNLOADED      *         
*                 IF SPECIFIED.                                       *         
*                                                                     *         
*                                                                     *         
*        USES:    R10:  FPT OPERATION WORD (1ST WORD OF FPT)          *         
*                 R11:  WAIT BIT FOR FPT   (2ND WORD OF FPT)          *         
*                                                                     *         
*                                                                     *         
***********************************************************************         
*                                                                               
*                                                                               
*                                                                               
MED840   EQU      %         PROCESS REWIND/UNLOAD FOR TAPES                     
         CI,R15   MEDHREW           IS REWIND REQUESTED ?                       
         BAZ      MED840A             NO                                        
*                                                                               
         LW,R10   MEDZ023             YES, SET FPT WORD FOR REWIND              
*                                                                               
MED840A  EQU      %         ARE WE TO UNLOAD THE TAPE ?                         
         CI,R15   MEDHUNLD          IS UNLOAD REQUESTED ?                       
         BAZ      MED840B             NO                                        
*                                                                               
         LW,R10   MEDZ024             YES, SET FOR UNLOAD                       
*                                                                               
MED840B  EQU      %         DO THE REWIND OR UNLOAD, BUT NOT BOTH               
         CI,R15   MEDHREW+MEDHUNLD  ARE EITHER REQUESTED ?                      
         BAZ      MED2XITA            NO, RETURN ALL DONE                       
*                                                                               
         STW,R10  MEDRFPTX          SET UP THE FPT                              
         LI,R11   F8                SET DELETE ON POST                          
         STW,R11  MEDRFPTX+1                                                    
         CAL1,1   MEDRFPTX          DO THE OP                                   
         B        MED2XITA          RETURN                                      
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*                                                                     *         
*  MED850         TEST IF DEVICE IS A PRINTER; SET VFC IN DCB AND     *         
*                 SET UP FPT FOR PRINTING 133 CHARACTERS WITH WAIT    *         
*                 FROM BUFFER 'A'.                                              
*                                                                     *         
*                                                                     *         
*                                                                     *         
*        INPUTS:  MEDROTMP, MEDRWA FPT                                *         
*                                                                     *         
*        OUTPUT:  R7 :  ADDRESS OF OUTPUT BUFFER                      *         
*                    :  VFC SET IN OUTPUT DCB                         *         
*                    :  WAIT BIT SET IN MEDRWA (WRITE 'A') FPT        *         
*                                                                     *         
*        USES:    R10:  TEMP;  MOVING SET VFC FPT                     *         
*                 R11:         MOVING SET VFC FPT                     *         
*                 R12:           ''    ''  ''  ''                     *         
*                 R13:           ''    ''  ''  ''                     *         
*                 R14:  RETURN ADDRESS                                *         
*                                                                     *         
***********************************************************************         
*                                                                               
*                                                                               
*                                                                               
MED850   EQU      %         TEST IF PRINTER; SET VFC, FIX FPT                   
         LW,R10   MEDROTMP          IS THE OUTPUT DEVICE A PRINTER ?            
         CI,R10   MEDAPRNT          PRINTER BIT SET?                            
         BAZ      *R14                NO, RETURN NOW ALL DONE                   
*                                                                               
         LCI      MEDZ011#          MOVE SET VFC                                
         LM,R10   MEDZ011                                                       
         STM,R10  MEDRFPTX                                                      
         CAL1,1   MEDRFPTX          AND TURN THE VFC BIT ON                     
         LW,R10   MEDRWA+1          ADD WAIT BIT TO WRITE FPT                   
         OR,R10   X10                                                           
         STW,R10  MEDRWA+1          SO CHECKS ARENT NEEDED                      
         LW,R7    MEDRWA+MEDRWBUF   GET ADDRESS OF OUTPUT BUFFER                
         LI,R10   133               SET SIZE OF PRINT LINE = MAX                
         STW,R10  MEDRWA+MEDRWBYT   TO PRINT FULL WIDTH HEADERS                 
         AI,R14   1                 EXIT AT PRINTER SET UP EXIT                 
         B        *R14                                                          
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*                                                                     *         
*  MED860         PRINT A LINE OF OUTPUT AND TEST FOR ERRORS          *         
*                                                                     *         
*                                                                     *         
*        LINK:    R14 (R8 NOT USED AS CAL ERROR ALTER IT)                       
*                                                                               
*        EXITS:   R14:    FATAL ERROR DURING PRINTING; CODE IN MEDRERRS         
*                 R14+1:  NORMAL EXIT, NO ERRORS                                
*                                                                               
*        USES:    R8 :  CHANGED BY ERR, ABN EXITS ON CALS             *         
*                 R10:  TEMP, AND SAME AS R8                          *         
*                                                                     *         
***********************************************************************         
*                                                                               
MED860   EQU      %         PRINT A LINE, TEST FOR ERRORS                       
         LW,R10   MEDRCTRL          TEST IF WE ARE TO STOP OR WAIT              
         CI,R10   MEDRABRT          ABORT REQUESTED ?                           
         BAZ      MED860C             NO, CONTINUE                              
*                                                                               
MED860A  EQU      %         SET ABORTED BY OPERATOR                             
         LW,R10   MEDZ090             YES, SET REASON CODE AND STOP             
         B        MED860X                                                       
*                                                                               
MED860C  EQU      %         TEST IF WE SHOULD SUSPEND OPERATIONS                
         CI,R10   MEDRSTOP                                                      
         BAZ      MED860P             NO, GO AHEAD AND PRINT                    
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED860I  EQU      %         STOP OPERATIONS FOR A WHILE                         
         DISABLE                                                                
         LW,R10   MEDRCTRL                                                      
         AND,R10  MEDZ005           CLEAR STATUS BITS OUT                       
         AI,R10   MEDRSTOP+MEDSHEDR    SET UP TO LOOK LIKE INOP                 
         STW,R10  MEDRCTRL                                                      
         ENABLE                                                                 
         BAL,R8   MEDIATSK          GO WAIT FOR STOP TO BE RESET                
         B        MED860A           ENTERED ABORT, SO DO SO                     
*                                                                               
MED860P  EQU      %         (CONTINUE) PRINT THE LINE                           
         LW,R10   TYCWNORM          SET NO ERRORS                               
         CAL1,1   MEDRWA            WRITE THE LINE                              
         CW,R10   TYCWNORM          ERRORS FOUND ?                              
         BNE      MED860E             ERROR OF SOME SORT; RECOVERABLE?          
*                                                                               
         AI,R14   1                 OK, EXIT                                    
         B        *R14                                                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MED860E  EQU      %         TEST IF A RECOVERABLE ERROR                         
         LB,R10   R10               FIND OUT WHAT IS WRONG                      
         CI,R10   X'30'             DID IT GO INOP ?                            
         BE       MED860W             YES, ALLOW CORRECTION                     
*                                                                               
         CI,R10   X'4D'             DID IT LOSE PAPER POSITION?                 
         BE       MED860W             YES, ALLOW THAT FIX TOO                   
*                                                                               
         STW,R10  MEDRERRS+1        SAVE ERROR CODE                             
         LW,R10   MEDZ096                                                       
*                                                                               
MED860X  EQU      %         SET ABORT CODE                                      
         STW,R10  MEDRERRS                                                      
         B        *R14              EXIT AT ERROR EXIT                          
*                                                                               
MED860W  EQU      %         DEVICE INOP; WAIT BEFORE RETRYING                   
         PUSH     R14               SAVE RETURN                                 
         BAL,R14  MED880            WAIT A WHILE                                
         PULL     R14               RECOVER RETURN ADDRESS                      
         B        MED860            AND THEN RETRY                              
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*  MED880         WAIT A FEW SECONDS                                  *         
*                                                                     *         
*        LINK:    R14                                                 *         
*                                                                     *         
*        ALL OTHER REGISTERS ARE SAVED                                *         
*                                                                     *         
***********************************************************************         
*                                                                               
*                                                                               
MED880   EQU      %         WAIT A FEW SECONDS (DEVICE INOP, ETC.)              
         PUSH     MEDZ010#,R8       SAVE REGISTERS WE WILL USE                  
         LCI      MEDZ010#          AND MOVE THE FPT                            
         LM,R8    MEDZ010                                                       
         CAL1,7   R8                THEN DO THE WAIT                            
         PULL     MEDZ010#,R8       RECOVER THE REGISTERS                       
         B        MED2XITA          AND RETURN                                  
         TITLE    'CONSTANTS, DEFAULTS, PROTO FPTS, ETC'                        
         SPACE    2                                                             
MEDZ002C GEN,1,7,8,16  1,X'15',0,R9  CLOSE FPT FIRST WORD                       
*                                                                               
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                   
*                                                                               
MEDZ010  GEN,8,1,23 X'44',1,0       STIMER FPT                                  
         DATA     P13+F3+F7         INTERVAL TIME, WAIT, ABORT OVERRIDE         
         DATA     09                WAIT 09 SECONDS BEFORE RETRYING             
MEDZ010# EQU      %-MEDZ010                                                     
*                                                                               
MEDZ011  GEN,8,24 X'05',MEDRODCB    SET VFC FOR OUTPUT PRINTERS                 
         DATA     X'10'             VFC BIT                                     
MEDZ011# EQU      %-MEDZ011                                                     
*                                                                               
MEDZ012  EQU      %                 VFC BYTES FOR GIVEN SPACE COUNTS            
*            SPACE 01234567  LINES BETWEEN EACH LINE                            
         TEXT     'AABCDEFG'        UP 1 IF GIVEN UP 0                          
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
MEDZ013  GEN,1,7,1,6,17  1,X'08',1,0,R9                                         
MEDZ013F DATA     P1+P4+P14+F7 +1   SET DEVICE CAL FOR FILES                    
         DATA     MEDR900    +2     NULL ERROR ROUTINE                          
MEDZ013# EQU      %-MEDZ013  +3                                                 
*                                                                               
MEDZ013D DATA     P1+P3+F7   +1     SET DEVICE CAL FOR DEVICES                  
*                                                                               
MEDZ014  DATA     10                FOR CONVERTING NUMBERS                      
*                                                                               
MEDZ015  TEXTC    '!!MEDIA: ABORTED REQ NNNN; YYYY'                             
MEDZ015# EQU      %-MEDZ015         LENGTH TO MOVE                              
*                                                                               
MEDZ016  RES      0                 START SYMBIONTS FPT                         
         GEN,8,1,23  X'4A',1,0                                                  
         DATA     P3+P4+P10+P11+F7                                              
******** DATA *** MEDR900 ********  NO ERROR ROUTINE                            
         TEXT     'SYMBIONT'        TASK NAME                                   
         DATA     0                 TYC CODE                                    
         TEXT     'CPR '            JOB NAME                                    
MEDZ016# EQU      %-MEDZ016         LENGTH OF FPR                               
*                                                                               
MEDZ019  TEXT     'OXER'   XEROX OVER AND OVER 'OXER'OXER'OXER'OXER'OX          
         PAGE                                                                   
*                                                                               
*                                                                               
MEDZ021  GEN,8,1,23  X'02',1,MEDRODCB   WRITE E-O-F TO OUTPUT FILE              
         DATA     F3                WAIT FOR IT                                 
MEDZ021# EQU      %-MEDZ021                                                     
*                                                                               
*                                                                               
MEDZ022  GEN,8,1,23  X'5B',1,0      DELETE SPECIFIED FILE                       
MEDZ022A DATA     P3+P4+F3+F7       WAIT, IGNORE ERRORS                         
*                                                                               
*                                                                               
MEDZ023  GEN,1,7,1,23  1,X'01',1,R9                                             
MEDZ024  GEN,1,7,1,23  1,X'03',1,R9                                             
*                                                                               
MEDZ025Y AI,R0    1                 STEP BYTE COUNT TO INCLUDE VFC BYTE         
MEDZ025N NOP      0                 DO NOT ALTER BYTE COUNT                     
*                                                                               
MEDZ026  TEXTC    '!!MEDIA: FINISHED: YYYY'                                     
MEDZ026# EQU      %-MEDZ026                                                     
*                                                                               
*                                                                               
MEDZ027  GEN,8,24 X'10',22          PUT DATE/TIME INTO LINE AT WORD 22          
*                                                                               
         BOUND    8                                                             
*                                                                               
MEDZ030  TEXT     'TASKNAME'                                                    
MEDZ031  TEXT     'JOB NAME'                                                    
*EDZ032  TEXT     'MEDIA ID'                                                    
MEDZ033  TEXT     'INPUT   '                                                    
MEDZ034  TEXT     'ID= '            FOR GENCHARS PRINT OF ID                    
MEDZ035  TEXT     ': = '            SEPARATER IN TITLE LINE                     
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
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 ERROR                         
         TITLE    'DEVICE CODE WORDS/ INFORMATION WORDS'                        
         SPACE    2                                                             
*                 WORDS ARE ORDERED BY DEVICE TYPE IN DCT4 TABLE                
*                 WORDS CONTAIN:                                                
*                                                                               
*                 BYTE 0:  CONTROL FLAGS                                        
*                 BYTE 1:  MAX NUMBER OF WORDS A RECORD MAY CONTAIN-1           
*                                                                               
*                          THIS TABLE STARTS AS A HALF-WORD TABLE, BUT          
*                          IS LOADED HALF AND STORED FULL.  THE LEFT            
*                          MOST BYTE THEN RECEIVES THE DCT INDEX OF             
*                          THE DEVICE THAT WAS USED TO ACCESS IT.               
*                          THIS IS THEN SAVED IN MEDRITMP (MEDROTMP)            
*                          THUSLY:                                              
*                                   BYTE 0:    1:    2:    3:                   
*                                        DCT   EMPTY CTRL  MAX REC              
*                                        INDEX (00)  FLAGS SIZE-1               
*                                                                               
*                                                                               
*                                                                               
         BOUND    4                                                             
MEDZDEVS RES      0                                                             
*                 OPTIONS+MAX REC SIZE              DCT4 DEVICE                 
         DATA,2   0+0                                  0 NO (IOEX)              
         DATA,2   MEDAOUOK+21-1                        1 TY                     
         DATA,2   0+0                                  2 PR                     
         DATA,2   0+0                                  3 PP                     
         DATA,2   MEDAINOK+20-1                        4 CR                     
         DATA,2   MEDAOUOK+20-1                        5 CP                     
         DATA,2   MEDASW+MEDAOUOK+MEDAPRNT+34-1        6 LP                     
         DATA,2   MEDAOUOK+MEDAINOK+256-1              7 DC                     
         DATA,2   MEDAOUOK+MEDAINOK+MEDATAPE+256-1     8 9T                     
         DATA,2   MEDAOUOK+MEDAINOK+MEDATAPE+256-1     9 7T                     
         DATA,2   MEDAOUOK+20-1                       10 CP LOW COST            
         DATA,2   MEDASW+MEDAOUOK+MEDAPRNT+34-1       11 LP LOW COST            
MEDZDEVR DATA,2   MEDAOUOK+MEDAINOK+256-1             12 DP                     
         DATA,2   0+0                                 13 PL                     
         DATA,2   MEDAOUOK+MEDAINOK+256-1             14 DP                     
         DATA,2   MEDASW+MEDAOUOK+MEDAPRNT+34-1       15 LP                     
         DATA,2   MEDAOUOK+MEDAINOK+MEDATAPE+256-1    16 9T                     
         DATA,2   MEDAOUOK+MEDAINOK+256-1             17 RB                     
         DATA,2   MEDAOUOK+MEDAINOK+256-1             18 SPECIAL                
         DATA,2   MEDAOUOK+MEDAINOK+256-1             19 LOGICAL DEV.           
         BOUND    4                                                             
MEDZDEVX DATA     (MEDAOUOK+MEDAINOK+20-1)            XX NULL DEVICE            
*                                                                               
*                                                                               
*                                                                               
         OLAYEND                                                                
*                                                                               
        FIN      #MEDIA                                                         
         SPACE    2                                                             
         END                                                                    
