*                                                                               
* THIS MODULE DESIGNED AND WRITTEN BY:                                          
*                                                                               
*                 GENE MALLORY                                                  
*                 5656 BUFFALO AVE.                                             
*                 VAN NUYS, CALIF.                                              
*                 91401                                                         
*                                                                               
*                 213-988-3975                                                  
*                                                                               
         PSYS     1                                                             
         SYSTEM   OPTIONS                                                       
         PSYS     0                                                             
         PAGE                                                                   
         DEF      CARD                                                          
         DO1      #CR71XX                                                       
         DEF      CRDIN,CRDINCU                                                 
         DO1      #CPUNCH                                                       
         DEF      CRDOUT,CRDOCU                                                 
         DO1      #CPUNLC                                                       
         DEF      CPLCOUT,CPLCCU                                                
         DO1      #CR31XX                                                       
         DEF      CARDPRE,CARDPOST                                              
CARD     RES      0                                                             
*                                                                               
*                                                                               
*                                                                               
OLAYFLAG EQU      'CARD'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '71XX CARD READER HANDLER'                                    
         DO       #CREAD                                                        
************************************************************************        
*  71XX CARD READER PRE-PROCESSOR                                               
************************************************************************        
CRDIN    LI,R10   DOTCR                                                         
         B        COMLIST           GO BUILD COMMAND LIST                       
         FIN      #CREAD                                                        
************************************************************************        
*    71XX CARD READER HANDLER POST-PROCESSOR                           *        
************************************************************************        
         DO       #CR71XX                                                       
CRDINCU  RES      0                                                             
         BAL,R9   NEWIOCK           ANY ERRORS                                  
         B        CRANALYZ          YES                                         
*                                   NO                                          
         FIN      #CR71XX                                                       
************************************************************************        
* 31XX & 71XX CARD READER EOD TEST                                     *        
************************************************************************        
         DO       #CREAD                                                        
CROK     RES      0                                                             
         LI,R12   TYCOK                                                         
         LB,R9    IOQ4,R3           CHECK INITIAL FUNCTION                      
         BEZ      IOSCU             BINARY                                      
         BAL,R5   4CHAR                                                         
         CW,R0    BANGEOD           IS IT A BANG EOD                            
         BNE      IOSCU                                                         
         LI,R12   TYCEOD            YES, SETUP TYC FOR EOD                      
         B        IOSCU                                                         
         FIN      #CREAD                                                        
         PAGE                                                                   
************************************************************************        
* 71XX CARD READER ERROR ANALYSIS                                      *        
************************************************************************        
         DO       #CR71XX                                                       
CRANALYZ RES      0                                                             
         CI,R8    (BIT1+BIT2)**-16  DEVICE OPERATIONAL                          
         BANZ     CRRETRY           NO                                          
*                                   YES                                         
         CI,R5    BIT14**-16        IOP HALT                                    
         BAZ      CR50              NO                                          
*                                   YES                                         
         CI,R5    (BIT11+BIT12+BIT13)**-16 IOP ERROR                            
         BANZ     CRRETRY           YES                                         
*                                   NO                                          
         CI,R8    (BIT9+BIT10)**-16 TRANSMISSION ERROR                          
         BANZ     CRRETRY           YES                                         
         B        CR60              NO                                          
*                                                                               
CR50     CI,R8    BIT4**-16         INVALID ORDER                               
         BANZ     CRRETRY           YES                                         
*                                   NO                                          
CR60     CI,R5    BIT8**-16         INCORRECT LENGTH                            
         BANZ     CROK              YES                                         
         B        CRRETRY           NO                                          
         PAGE                                                                   
************************************************************************        
* CARD READER RETRY LOGIC                                              *        
************************************************************************        
CRRETRY  RES      0                                                             
         BAL,R0   RE:ENT                                                        
*                                                                               
         LH,R0    DCT1,R1           GET DEVICE ADDRESS                          
         HIO,0    *R0               HIO IT JUST FOR LUCK                        
         ENABLE                                                                 
*                                                                               
         LI,R12   FLGRETRY          SET UP FOR RETRY                            
         LD,R8    DCT13,R1          GET TDV STATUS                              
         AND,R9   M16               R9=REMAINING BYTE COUNT                     
         AI,R9    3                 FUDGE FOR CR HARDWARE BUG                   
         CH,R9    IOQ9,R3           IS R9= ORIG. BYTE COUNT                     
         BL       CRFED             CARD WAS FED                                
*                                   CARD WAS NOT PICKED                         
         MTB,0    IOQ11,R3          ANY RETRIES LEFT                            
         BNEZ     IOSCU             YES, RETRY OPERATION                        
*                                   NO, ASK FOR HELP BEFORE QUITTING            
         LI,R12   FLGKEYC                                                       
         LI,R13   MSGNOPIC                                                      
         B        IOSCU                                                         
         PAGE                                                                   
CRFED    RES      0                                                             
         LI,R13   MSG2              SET UP ERROR MESSAGE                        
         LI,R12   FLGKEYC                                                       
         LB,R8    IOQ14,R3          GET REQUEST PRIORITY                        
         CI,R8    X'FF'             IS IT BACKGROUND                            
         BE       IOSCU             YES, ASK FOR HELP                           
*                                   NO                                          
         LI,R12   TYCERR+FLGMSG     FOR FOREGROUND, SETUP ERROR TERMINATION     
         B        IOSCU                                                         
         FIN      #CR71XX                                                       
         PAGE                                                                   
************************************************************************        
* TEXT STRINGS                                                         *        
************************************************************************        
BANGEOD  TEXT     '!EOD'                                                        
*                                                                               
MSGNOPIC TEXTC    ' CARD NOT FED'                                               
         TITLE    '31XX CARD READER HANDLER'                                    
************************************************************************        
* 31XX CARD READER PRE-HANDLER                                         *        
************************************************************************        
         DO       #CR31XX                                                       
CARDPRE  RES      0                                                             
         LI,R10   DOTCR                                                         
         B        COMLIST                                                       
*                                                                               
************************************************************************        
* 31XX CARD READER POST-HANDLER                                        *        
************************************************************************        
CARDPOST RES      0                                                             
         LB,R0    IOQ5,R3           GET CURRENT FUNCTION CODE                   
         CI,R0    SENSE1            SENSE 1 FUNCTION                            
         BE       CRSENSE           YES                                         
*                                   NO                                          
         CI,R0    SENSE2            SENSE 2 FUNCTION                            
         BE       CRSENSE           YES                                         
*                                   NO                                          
         BAL,R9   NEWIOCK           ANY ERRORS                                  
         B        CARDERR           YES                                         
         B        CROK              NO                                          
         PAGE                                                                   
************************************************************************        
* 31XX CARD READER ERROR ANALYSIS                                      *        
************************************************************************        
CARDERR  RES      0                                                             
         CI,R8    (BIT1+BIT2)**-16  IS DEVICE OK                                
         BANZ     CARDRTY           NO                                          
*                                   YES                                         
         LC       DCT20,R1          TDV CC                                      
         BCS,X'C' CARDRTY           DEVICE NOT ONLINE OR IN TEST MODE           
*                                   TDV STATUS OK                               
         CI,R5    BIT8**-16         TRANSMISSION DATA ERROR                     
         BANZ     CARDRTY           YES                                         
*                                   NO                                          
         CI,R8    BIT4**-16         UNUSUAL END                                 
         BANZ     CARDRTY           YES                                         
*                                   NO                                          
         CI,R5    BIT8**-16         INCORRECT LENGTH                            
         BANZ     CROK              OK                                          
         B        CARDRTY           NO, INCONSISTENT STATUS                     
         PAGE                                                                   
**************************************************************                  
* 31XX CARD READER RETRY                                                        
**************************************************************                  
CARDRTY  RES      0                                                             
         BAL,R0   RE:ENT                                                        
*                                                                               
         LH,R0    DCT1,R1           GET DEVICE ADDRESS                          
         HIO,R0   *R0               HIO IT JUST FOR LUCK                        
         ENABLE                                                                 
*                                                                               
         LI,R5    SENSE1**8                                                     
         LD,R8    DCT13,R1          GET TDV STATUS                              
         AND,R9   M16               MASK OUT REMAINING BYTE COUNT               
         CH,R9    IOQ9,R3           HAS ANY BYTES BEEN TRANSFERED               
         BE       CRRE:ENT          NO, CARD DIDNT MOVE                         
*                                   YES, CARD DID MOVE                          
         LI,R5    SENSE2**8                                                     
CRRE:ENT BAL,R0   RE:ENT            INHIBIT                                     
         STH,R5   DCT17,R1          RETRY SENSE BEFORE REPORTING                
*                                                                               
         LI,R12   FLGRETRY+FLGHOLD                                              
         B        IOSCU                                                         
         PAGE                                                                   
******************************************************************              
* CARD READER SENSE FOLLOW UP                                                   
******************************************************************              
CRSENSE  RES      0                                                             
         DO       #XRBM                                                         
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG           IS ERROR LOGGING ON                         
         BEZ      CRSENSED          NO                                          
*                                   YES                                         
         BAL,R0   RE:ENT                                                        
         LW,R7    IOQERROR,R3       IS THERE A LOG BUFFER                       
         BEZ      CRSENSED          NO                                          
*                                   YES                                         
         LI,R6    LOGSENSE                                                      
         LH,R5    DCT7,R1           GET CLIST PTR                               
         SLS,R5   1                 AS A WORD ADDRESS                           
*                                                                               
         LCI      4                                                             
         LM,R8    4,R5              GET SENSE DATA                              
         STM,R8   *R7,R6            AND PUT IN LOG BUFFER                       
*                                                                               
         LM,R8    ZEROS                                                         
         STM,R8   4,R5              CLEAR SENSE DATA IN CLIST                   
         FIN      #ERRORLOG                                                     
         FIN      #XRBM                                                         
         PAGE                                                                   
CRSENSED RES      0                                                             
         BAL,R0   RE:ENT            INHIBIT                                     
         LB,R0    IOQ4,R3           GET ORIGINAL FUNCTION CODE                  
         STH,R0   DCT17,R1          SET UP FOR FOLLOW ON                        
         ENABLE                                                                 
*                                                                               
         LI,R12   FLGFOLOW          SET UP FOR FOLLOW ON                        
         LB,R0    IOQ5,R3           GET CURRENT FUNCTION                        
         CI,R0    SENSE1            IS IT FROM A CARD NOT FED                   
         BNE      CARDFED           NO, CARD HAD FED                            
*                                   YES, CARD HAD NOT FED                       
         MTB,0    IOQ11,R3          ANY RETRIES LEFT                            
         BNEZ     IOSCU             YES, RETRY OPERATION                        
*                                   NO, ASK FOR HELP BEFORE QUITTING            
         LI,R13   MSGNOPIC                                                      
CARDHELP RES      0                                                             
         LI,R12   FLGKEYC                                                       
*                                                                               
         BAL,R0   RE:ENT                                                        
*                                                                               
         LB,R0    IOQ4,R3           GET INITIAL FUNCTION                        
         STB,R0   IOQ5,R3           STUFF CURRENT FUNCTION FOR RETRY KEYIN      
*                                                                               
         MTB,1    IOQ11,R3          ADD A RETRY COUNT FOR NEXT TIME             
         B        IOSCU                                                         
********                                                                        
CARDFED  RES      0                                                             
         LI,R13   MSG2              SET UP ERROR MESSAGE                        
         LB,R8    IOQ14,R3          GET REQUEST PRIORITY                        
         CI,R8    X'FF'             IS IT BACKGROUND                            
         BE       CARDHELP          YES, ASK FOR HELP                           
*                                   NO                                          
         LI,R12   TYCERR+FLGMSG     FOR FOREGROUND, SETUP ERROR TERMINATION     
         B        IOSCU                                                         
         PAGE                                                                   
**********************************************************************          
* SPECIAL CDW BUILD ROUTINE FOR SENSE                                           
**********************************************************************          
SENSELOG RES      0                                                             
         LH,R0    DCT7,R1           GET CLIST ADDRESS                           
         AI,R0    2                 POINT TO THIRD DW                           
         SLS,R0   3                 MAK IT A BYTE ADDRESS                       
         OR,R8    R0                OR IT INTO THE CDW                          
         B        USECOM            AND STORE IT                                
         FIN      #CR31XX                                                       
         PAGE                                                                   
         DO       #CREAD                                                        
************************************************************************        
*   COMMAND LIST OFFSETS FOR CARD READERS                              *        
************************************************************************        
*                                                                               
         BOUND    8                                                             
DOTCR    EQU      %                                                             
DOT      SET      %                                                             
*                                                                               
BINREAD  :DOT     RDCRB,2,0,0       0  READ CARD BINARY                         
AUTOREAD :DOT     RDCRA,2,1,0       1  READ CARD AUTOMATIC                      
         DO       #CR31XX                                                       
SENSE1   :DOT     CRSNS,1           SENSE AFTER A CARD DID NOT MOVE             
SENSE2   :DOT     CRSNS,1           SENSE AFTER A CARD DID MOVE IN ERROR        
         FIN      #CR31XX                                                       
************************************************************************        
*   COMMAND LISTS FOR CARD READERS                                     *        
************************************************************************        
RDCRB    :CLIST   READBIN           READ CARD BINARY                            
RDCRA    :CLIST   READAUTO          READ CARD AUTOMATIC                         
         DO1      #CR31XX                                                       
CRSNS    :CLIST   SENSECR,TESTCR    SENSE AND TEST                              
         PAGE                                                                   
************************************************************************        
* COMMAND DW SKELETONS FOR CARD READERS                                *        
************************************************************************        
         BOUND    8                                                             
READBIN  :CDW     2,0,NCC,2         READ CARD BINARY                            
READAUTO :CDW     6,0,NCC,2         READ CARD AUTOMATIC                         
         DO       #CR31XX                                                       
SENSECR  :CDW     4,SENSELOG,CC,4,16 SENSE FOR LOG                              
TESTCR   :CDW     7,BA(Y01),NCC,0,1 FORCE SELF-TEST                             
         FIN      #CR31XX                                                       
         FIN      #CREAD                                                        
         TITLE    'CARD PUNCH HANDLERS'                                         
************************************************************************        
* 7160 CARD PUNCH HANDLER DESCRIPTION                                  *        
************************************************************************        
*                                                                               
*        THIS DEVICE REQUIRES WHAT IS KNOWN AS THE TWO CARD                     
* RECOVERY PROCEDURE. THIS IS NECESSARY BECAUSE AS EACH CARD IS PUNCHED,        
* THE PREVIOUS CARD IS READ AND VERIFIED FOR THE CORRECT NUMBER OF HOLES        
* IF AN ERROR IS DETECTED DURING THIS READ, THE CARD IS SHUNTED INTO THE        
* ERROR HOPPER. IN ORDER TO RECOVER, THE CARD JUST PUNCHED MUST BE ALSO*        
* SHUNTED INTO THE ERROR HOPPER AND BOTH CARDS MUST BE PUNCHED OVER.   *        
*        IN ORDER TO DO  THIS, THE PREVIOUS CARD IMAGE AND MODE MUST BE         
* SAVED SO THAT THE CARD MAY BE RE-PUNCHED. IN THIS HANDLER, THE USERS *        
* CARD IMAGE IS MOVED INTO A 120 BYTE BUFFER IN THE CLIST AREA WHEN    *        
* A CARD IS SUCESSFULLY PUNCHED. A FLAG WORD IS ALSO SAVED WHICH INDICAT        
* WHICH MODE THE LAST CARD WAS PUNCHED IN.                             *        
*        CARE MUST BE TAKEN TO NOT ATTEMPT A TWO CARD RECOVERY WHEN EITH        
* PUNCHING THE FIRST CARD OVER OR WHEN A ERROR OCCURS ON THE CPARD BEING        
* PUNCHED AND ONLY THAT CARD NEEDS PUNCHING OVER.                      *        
*        ANOTHER REQUIREMENT IS THAT A FULL CARD IMAGE MUST BE SUPPLIED         
* FOR BOTH BINARY AND EBCDIC PUNCHING. FILLERS OF BLANK OR ZERO ARE    *        
* SUPPLIED USING DATA CHAINING. ZERO FILL USES A SKIP FUNCTION, BLANKS *        
* ARE SUPPLIED FROM A 80 BYTE BLANK STRING IN THE HANDLER.             *        
*        ALSO BECAUSE THE PUNCH IS NOT BUFFERED, THE STRING MUST BE             
* SUPPLIED 12 TIMES, ONE FOR EACH ROW. THIS IS DONE  BY USING          *        
* A TIC BACK AND FOLLOWED BY A STOP ORDER FOLLOWING THE TIC. THE TIC IS*        
* AUTOMATICLY IGNORED ON THE 12TH TIME BY THE HARDWARE                 *        
         PAGE                                                                   
*                                                                               
*        WHEN THIS DEVICE JAMS, IT GOES NOT-OPERATIONAL.  WHILE                 
* RECOVERY IS NOT ALWAYS POSSIBLE IN THESE CASES DUE TO A LACK         *        
* OF KNOWLEDGE OF THE POSITION OF THE JAM, A TWO CARD RETRY IS         *        
* ATTEMPTED ANYWAY.  UPON THE NEXT SIO, THE CARD PUNCH WILL            *        
* GIVE A SIO REJECT AND THE OPERATIOR SHOULD CLEAR AND THROW           *        
* AWAY ALL CARDS INVOLVED.  WHEN A DEVICE R KEYIN IS RECIEVED,         *        
* THE TWO CARD RECOVERY WILL BE DONE  AND THE TWO PREVIOUS CARDS       *        
* PUNCHED AGAIN.  NOTE THAT FOR FOREGROUND JOBS, THERE IS NO           *        
* KEYIN POSSIBLE AND AN ERROR WILL HAVE BEEN REPORTED TO THE           *        
* PROGRAM.  (TYC = 4)                                                  *        
*        IF THE RETRY COUNT IS RUN DOWN,  THE HANDLER WILL, FOR                 
* BACKGROUND, ASK FOR A KEYIN FROM THE OPERATOR AS A LAST RESORT.      *        
* THIS GIVES THE OPERATOR A CHANCE TO CLEAR UP THE PROBLEM             *        
* AND RETRY THE OPERATION. FOREGROUND PROGRAMS WILL GET THE NORMAL     *        
* TYC = 8 ERROR.                                                       *        
         PAGE                                                                   
*                                                                               
************************************************************************        
* 7160 CARD PUNCH CLIST AREA USAGE                                     *        
************************************************************************        
*        THE CLIST AREA IS USED SO:                                             
* WORD 0/1        PUNCH USERS BUFFER                                   *        
* WORD 2/3        PUNCH FILLER (SOME TIMES NOT PRESENT)                *        
* WORD 4/5        TIC TO WORD 0                                        *        
* WORD 6/7        STOP ORDER                                           *        
* WORD 8          FLAG WORD                                            *        
* WORD 9-38       LAST CARD BUFFER                                     *        
*                                                                               
*                                                                               
BUFFERD  EQU      9                                                             
FLAGD    EQU      8                                                             
         PAGE                                                                   
         DO       #CPUNCH                                                       
************************************************************************        
* 7160 CARD PUNCH PRE PROCESSING                                       *        
************************************************************************        
CRDOUT   RES      0                                                             
         LI,R10   DOTCP                                                         
         B        COMLIST                                                       
*                                                                               
************************************************************************        
* 7160 CARD PUNCH POST PROCESSING                                      *        
************************************************************************        
CRDOCU   RES      0                                                             
         BAL,R9   NEWIOCK           IS THERE ANY ERROR                          
         B        CRDOERR           YES                                         
*                                   NO                                          
         LB,R5    IOQ5,R3           GET CURRENT FUNCTION                        
         CI,R5    CPFUN2            IS IT A TWO CARD FUNCTION                   
         BE       STARTOVR          YES, FOLLOW ON TO NEXT CARD                 
         CI,R5    CPFUN3            AGAIN                                       
         BE       STARTOVR                                                      
         LI,R12   TYCOK             SET UP GOOD TYC                             
         PAGE                                                                   
************************************************************************        
* MOVE COMPLETED CARD TO HOLDING BUFFER FOR TWO CARD RECOVERIES        *        
************************************************************************        
CRDOMOVE  RES     0                                                             
         LB,R5    IOQ4,R3           GET INITIAL FUNCTION CODE                   
*                                   0 IF EBCDIC                                 
*                                   1 IF BINARY                                 
         LH,R6    DCT7,R1           GET CLIST DW ADDR                           
         SLS,R6   1                 MAKE IT A WA                                
         AI,R6    FLAGD             POINT TO FLAG CELL                          
         BAL,R0   RE:ENT                                                        
         STW,R5   0,R6              SAVE FUNCTION CODE                          
         ENABLE                                                                 
*                                                                               
         AI,R6    BUFFERD-FLAGD     POINT TO BUFFER AREA IN CLIST               
         SLS,R6   2                 MAKE IT A BYTE ADDR                         
         LH,R8    IOQ9,R3           GET BUFFER BYTE COUNT                       
         LW,R7    IOQ8,R3           GET BUFFER BYTE ADDRESS                     
CRDO10   RES      0                                                             
         BAL,R0   RE:ENT                                                        
         LB,R9    0,R7                                                          
         STB,R9   0,R6                                                          
         AI,R7    1                                                             
         AI,R6    1                                                             
         ENABLE                                                                 
         BDR,R8   CRDO10            MOVE IMAGE                                  
         PAGE                                                                   
         LB,R8    COUNT,R5          GET CARD COUNT                              
         LB,R9    FILLER,R5         GET FILLER CHARACTER                        
         SH,R8    IOQ9,R3           ADJUST COUNT                                
         BEZ      IOSCU             ALL DONE  ALREADY                           
CRDO20   RES      0                                                             
         BAL,R0   RE:ENT                                                        
         STB,R9   0,R6                                                          
         AI,R9    1                                                             
         ENABLE                                                                 
         BDR,R8   CRDO20            MOVE IN FILLER                              
         B        IOSCU                                                         
*                                                                               
************************************************************************        
* FILL AND COUNT TABLES                                                *        
************************************************************************        
COUNT    DATA,1   80,120,0,0                                                    
FILLER   DATA,1   ' ',0,0,0                                                     
         PAGE                                                                   
************************************************************************        
* 7160 CARD PUNCH ERROR ANALYSIS                                       *        
************************************************************************        
CRDOERR  RES      0                                                             
         CI,R8    (BIT1+BIT2)**-16  IS THE DEVICE READY                         
         BANZ     TWOCARD           NO                                          
*                                   YES                                         
         CI,R5    BIT2**-16         IS IT A READ CHECK                          
         BAZ      ONECARD                                                       
         B        TWOCARD                                                       
         PAGE                                                                   
************************************************************************        
* TWO CARD RECOVERY LOGIC FOR 7160                                     *        
************************************************************************        
TWOCARD  RES      0                                                             
         LB,R5    IOQ5,R3           GET CURRENT FUNCTION CODE                   
         CI,R5    CPFUN2            IS IT AN ORIGINAL FUNCTION STEP             
         BGE      ONECARD           NO, NO TWO CARD RECOVERY                    
*                                   YES                                         
         LH,R5    DCT7,R1           GET CLIST PTR                               
         SLS,R5   1                 MAKE IT A WORD ADDR                         
         AI,R5    FLAGD             POINT TO FLAG WORD                          
         LW,R5    0,R5              GET FLAG WORD                               
         BLZ      ONECARD           LAST CARD NOT VALID                         
*                                   GOT LAST CARD FUNCTION CODE                 
         AI,R5    2                 FORM TWO CARD FUNCTION CODE                 
         SLS,R5   8                                                             
         BAL,R0   RE:ENT                                                        
         STH,R5   DCT17,R1          SET UP RETRY PTR                            
         PAGE                                                                   
************************************************************************        
* ONE CARD RECOVERY AND EXTENSION OF TWO CARD RECOVERY                 *        
************************************************************************        
ONECARD  RES      0                                                             
         LI,R12   FLGRETRY+FLGINTER                                             
*                                                                               
EXITHIO  RES      0                                                             
         BAL,R0   RE:ENT                                                        
         LH,R5    DCT1,R1                                                       
         HIO,R0   0,R5              HIO DEVICE                                  
*                                                                               
         MTB,0    IOQ11,R3          IS THIS THE LAST RETRY                      
         BNEZ     IOSCU             NO, GO RETRY OPERATION                      
*                                   YES                                         
         LH,R5    DCT7,R1           GET CLIST PTR                               
         SLS,R5   1                 MAKE IT A WORD ADDR                         
         AI,R5    FLAGD             POINT TO FLAG WORD                          
         LI,R6    -1                                                            
         STW,R6   0,R5              SET FLAG TO INVALIDATE OLD CARD             
*                                                                               
         LB,R8    IOQ14,R3          GET PRIORITY                                
         CI,R8    X'FF'             IS IT BACKGROUND                            
         BNE      IOSCU             NO                                          
*                                   YES, ASK FOR A KEY-IN                       
         LI,R12   FLGKEYC+FLGINTER                                              
         LI,R13   MSG2              ERROR MESSAGE                               
         B        IOSCU             AND CLEAN-UP                                
         PAGE                                                                   
************************************************************************        
* START OVER AND TRY TO PUNCH CARD AGAIN AFTER SUCCESS                 *        
* WITH RE-PUNCHING LAST CARD                                           *        
************************************************************************        
STARTOVR RES      0                                                             
         LB,R5    IOQ4,R3           GET ORIGINAL FUNCTION CODE                  
         BAL,R0   RE:ENT                                                        
         STH,R5   DCT17,R1          SAVE AS FOLLOW ON CODE                      
         LI,R12   FLGFOLOW+FLGINTER                                             
         B        IOSCU             AND CLEAN-UP                                
         PAGE                                                                   
************************************************************************        
* COMMAND LIST TABLE FOR 7160 CARD PUNCH                               *        
************************************************************************        
         BOUND    8                                                             
DOTCP    EQU      %                                                             
DOT      SET      %                                                             
CPFUN0   :DOT     CPCL0,1,CPFUN4,CPFUN99 PUNCH EBCDIC                           
CPFUN1   :DOT     CPCL1,1,CPFUN5,CPFUN99 PUNCH BINARY                           
CPFUN2   :DOT     CPCL2,1,CPFUN2,CPFUN99 RETRY OLD CARD IN EBCDIC               
CPFUN3   :DOT     CPCL3,1,CPFUN3,CPFUN99 RETRY OLD CARD IN BINARY               
CPFUN4   :DOT     CPCL4,1,CPFUN4,CPFUN99 RETRY NEW CARD IN EBCDIC               
CPFUN5   :DOT     CPCL5,1,CPFUN5,CPFUN99 RETRY NEW CARD IN BINARY               
CPFUN99  :DOT     CPFUN99,1,CPFUN99,CPFUN99                                     
         PAGE                                                                   
************************************************************************        
* CDW LISTS FOR 7160 CARD PUNCH                                        *        
************************************************************************        
*                                                                               
CPCL0    :CLIST   CPBCD,BKFILL,TIC,STP                                          
CPCL1    :CLIST   CPBIN,ZFILL,TIC,STP                                           
CPCL2    :CLIST   CPBCDOLD,TIC,STP                                              
CPCL3    :CLIST   CPBINOLD,TIC,STP                                              
CPCL4    :CLIST   CPBCDALT,BKFILL,TIC,STP                                       
CPCL5    :CLIST   CPBINALT,ZFILL,TIC,STP                                        
CPCL99   :CLIST   CDW99                                                         
         PAGE                                                                   
************************************************************************        
* CDW SKELETONS FOR THE 7160 CARD PUNCH                                *        
************************************************************************        
*                                                                               
         BOUND    8                                                             
CPBCD    :CDW     X'D',0,DC,2       PUNCH EBCDIC                                
CPBIN    :CDW     9,0,DC,2          PUNCH BINARY                                
CPBCDALT :CDW     X'15',0,DC,2      PUNCH EBCDIC AND STACK LAST ALTERNAT        
CPBINALT :CDW     X'11',0,DC,2      PUNCH BINARY AND STACK LAST ALTERNAT        
CPBCDOLD  :CDW    X'15',OLDIE,CC,4,80  PUNCH OLD EBCDICR                        
CPBINOLD :CDW     X'11',OLDIE,CC,4,120  PUNCH OLD BINARY                        
BKFILL   :CDW     0,PHILLIP,CC,4,80 BLANK FILL                                  
ZFILL    :CDW     0,PHILLIP,CC+SKIP,4,120 ZERO FILL                             
TIC      :CDW     8,TICKLE,CC,4     TIC BACK                                    
STP      :CDW     X'80',0,NCC,0     STOP                                        
CDW99    :CDW     0,IOINC,0,0                                                   
         PAGE                                                                   
************************************************************************        
* 7160 CWD BUILDING ROUTINES                                           *        
************************************************************************        
PHILLIP  RES      0                                                             
         SH,R9    IOQ9,R3           GET REMAINING COUNT                         
         CI,R9    X'FFFF'           ANY LEFT                                    
         BAZ      NOPHIL            NO, DONT  NEED PHIL                         
         AI,R8    BA(CPBLANKS)      FORM BYTE ADDR OF BLANK BUFFER              
         B        USECOM                                                        
*                                                                               
NOPHIL   RES      0                                                             
         AI,R7    -1                POINT TO PREVIOUS CDW                       
         LD,R8    0,R7              GET OLD CDW                                 
         LI,R0    CC                GET COMAND CHAIN FLAGS                      
         STB,R0   R9                SET FLAGS IN DW                             
         B        USECOM            AND USE THIS ONE AGAIN                      
*********                                                                       
TICKLE   RES      0                                                             
         AH,R8    DCT7,R1           ADD IN DA OF CLIST AREA                     
         B        USECOM            AND USE IT                                  
*********                                                                       
OLDIE    RES      0                                                             
         LH,R0    DCT7,R1           CLIST AREA DW ADDRESS                       
         SLS,R0   1                 FORM WORD ADDR                              
         AI,R0    BUFFERD           ADD WORD DISCPLACEMENT OF BUFFER            
         SLS,R0   2                 FORM BYTE ADDR                              
         OR,R8    R0                OR IN BYTE ADDRESS                          
         B        USECOM                                                        
         PAGE                                                                   
************************************************************************        
* BLANK BUFFER FOR CARD FILLER                                         *        
************************************************************************        
CPBLANKS RES      0                                                             
         DO       80                                                            
         LIST     0                                                             
         DATA,1   ' '                                                           
         LIST     1                                                             
         FIN                                                                    
         FIN      #CPUNCH                                                       
         PAGE                                                                   
*                                                                               
*          THIS DEVICE IS RATHER STRAIGHT FORWARD.  BOTH THE CARD               
* PUNCH AND VERIFY OPERATIONS TAKE PLACE ON THE SAME ORDER.  IF        *        
* AN ERROR IS DETECTED, THE ERRORED CARD IS OFFSET STACKED AUTOMATICLY.*        
* THE ONLY RECOVERY STRATEGY IS TO SIMPLY RETRY THE CURRENT CARD AGAIN.*        
*          CARE SHOULD BE TAKEN BY THE OPERATOR, THAT WHEN THE                  
* CARDS ARE REMOVED FROM THE HOPPER, THE OFFSET STACKED CARDS ARE      *        
* NOT SHAKEN DOWN  INTO THE DECK AND ARE INSTEAD REMOVED AND THROWN    *        
* AWAY.                                                                *        
*          IF THE DEVICE JAMS, IT GOES NOT OPERATIONAL.  AGAIN, JUST            
* RETRYING THE OPERATION WILL GIVE A SIO REJECT THE NEXT TIME          *        
* AN SIO IS DONE.  IN BACKGROUND, THIS GIVES THE OPERATOR A CHANCE TO  *        
* CLEAR THE FAULT AND RETRY THE OPERATION.  IN FOREGROUND, THE TYC = 4 *        
* IS GIVEN TO INDICATE A OPERATOR IS NEEDED TO FIX THE PROBLEM.        *        
*          IF THE RETRY COUNT IS RUN DOWN,  THE HANDLER WILL, FOR               
* BACKGROUND, ASK FOR A KEYIN AND GIVE THE OPERATOR A CHANCE           *        
* TO CLEAR UP THE PROBLEM.  FOREGROUND PROGRAMS WILL GET THE NORMAL    *        
* TYC = 8 ERROR CODE                                                   *        
         PAGE                                                                   
         DO       #CPUNLC                                                       
************************************************************************        
* 7165 CARD PUNCH PRE-PROCESSOR                                        *        
************************************************************************        
CPLCOUT  LI,R10   DOTCPLC                                                       
         B        COMLIST                                                       
************************************************************************        
* 7165 CARD PUNCH POST-PROCESSOR                                       *        
************************************************************************        
CPLCCU   RES      0                                                             
         BAL,R9   NEWIOCK                                                       
         B        CPLCERR                                                       
CPLCOK   RES      0                                                             
         LI,R12   TYCOK                                                         
         B        IOSCU                                                         
         PAGE                                                                   
************************************************************************        
* 7165 CARD PUNCH ERROR ANALYSIS                                       *        
************************************************************************        
CPLCERR  RES      0                                                             
         CI,R8    (BIT1+BIT2+BIT4)**-16 IS DEVICE NOT-OP OR UNUSUAL END         
         BANZ     CPLCRTY           YES                                         
*                                   NO                                          
         CI,R5    (BIT2+BIT14)**-16 PUNCH ERROR OR IOP HALT                     
         BANZ     CPLCRTY           YES                                         
*                                   NO                                          
         CI,R8    BIT4**-16         UNUSUAL END                                 
         BANZ     CPLCRTY           YES, ERROR                                  
*                                   NO                                          
         CI,R5    BIT8**-16         INCORRECT LENGTH                            
         BANZ     CPLCOK            YES, OK                                     
*                                   NO, ERROR                                   
CPLCRTY  RES      0                                                             
         LI,R12   FLGRETRY+FLGINTER                                             
         MTB,0    IOQ11,R3          IS THIS THE LAST RETRY                      
         BNEZ     IOSCU             NO                                          
*                                   YES                                         
         LB,R8    IOQ14,R3          GET PRIORITY                                
         CI,R8    X'FF'             IS IT BACKGROUND                            
         BNE      IOSCU             NO                                          
*                                   YES, ASK FOR KEY-IN                         
         LI,R12   FLGKEYC+FLGINTER                                              
         LI,R13   MSG2                                                          
         B        IOSCU                                                         
         FIN      #CPUNLC                                                       
         PAGE                                                                   
         DO       #CPUNLC                                                       
*                                                                               
************************************************************************        
* COMMAND LIST OFFSETS FOR 7165 CARD PUNCH                             *        
************************************************************************        
*                                                                               
         BOUND    8                                                             
DOTCPLC  EQU      %                                                             
DOT      SET      %                                                             
         :DOT     WCPLCBCD,1,0,0    0  WRITE EBCDIC                             
         :DOT     WCPLCBIN,1,1,0    1  WRITE BINARY                             
************************************************************************        
* COMMAND LISTS FOR 7165 CARD PUNCH                                    *        
************************************************************************        
WCPLCBCD :CLIST   WRECPLC                                                       
WCPLCBIN :CLIST   WRBCPLC                                                       
************************************************************************        
*   COMMAND DOUBLEWORDS  FOR 7165 CARD PUNCH                           *        
************************************************************************        
         BOUND    8                                                             
WRECPLC  :CDW     X'0D',0,NCC,2     WRITE EBCDIC 7165 CARD PUNCH                
WRBCPLC  :CDW     X'09',0,NCC,2     WRITE BINARY 7165 CARD PUNCH                
         FIN      #CPUNLC                                                       
         END                                                                    
