ASMB,R,L
      NAM DVR15  09601-16021  781108  REV 1901                  
      ENT I.15,C.15 
      SPC 4 
* 
*        ***HP 7261A RTE DVR 15***
* 
*        SOURCE TAPE: 09601-18021 
*        RELOC. TAPE: 09601-16021 
*        SMALL PROG.MANUAL: 07261-90010 
* 
*        MAY  1974      L.W. HENNESSEY
*        JUNE 1974      A.M. WERNICK
*        MAY  1978      D.POT 
* 
* 
* 
*  THIS DRIVER CAN CONVERT EITHER EBCDIC OR BCD CARDS:
      SPC 1 
*  WHEN CONFIGURING THIS DRIVER INTO RTE SYSTEM, ASSIGN CARD READER 
*  THREE LOGICAL UNIT NUMBERS 
*    LU#N = READER,SUBCHANNEL 0 
*    LU#M = READER,SUBCHANNEL 1 
*    LU#L = READER,SUBCHANNEL 2 
*  TO CONVERT EBCDIC PUNCH SET - ADDRESS READER AS SUBCHANNEL 0 
*  TO CONVERT BCD PUNCH SET - ADDRESS READER AS SUBCHANNEL 1
*  TO CONVERT EBCDIC-RDTS PUNCH SET - ADDRS READER AS SUBCHN 2
      SPC 2 
*  THIS CARD READER DRIVER PROCESSES READ AND CONTROL REQ'S.
*  WRITE REQ'S AND ILLEGAL CONTROL REQ'S ARE REJECTED.
      SPC 1 
*  TO PROCESS A READ, STATUS IS FIRST CHECKED.  IF IT IS
*  "OK TO PICK" A PICK COMMAND IS ISSUED AND A DMA TRANSFER 
*  IS BEGUN.  IF STATUS IS NOT "OK TO PICK" A NOT READY 
*  RETURN IS MADE TO THE SYSTEM.
*  THE DMA TRANSFER IS INTO THE DRIVER'S INTERNAL BUFFER. 
*  THE DRIVER IS ENTERED UPON DEVICE CONTROLLER INTERRUPT.
*  THE CARD DATA IS CONVERTED FROM COLUMN IMAGE TO THE FORMAT 
* 
*  SPECIFIED BY THE READ REQUEST AND STORED INTO THE CALLING
*  PROGRAM'S BUFFER.
*  THE THREE FORMATS A READ REQUEST CAN SPECIFY ARE:
*    ASCII           SUBFUNCTION 0
*    PACKED BINARY   SUBFUNCTION 3
*    COLUMN BINARY   SUBFUNCTION 1
      SPC 1 
*  THREE CONTROL REQUESTS ARE PROCESSED:
*    DYNAMIC STATUS  SUBFUNCTION 6
*    RING BELL       SUBFUNCTION 4      (REWIND LU) 
*    SELECT HOPPER   SUBFUNCTION 1      (ENDFILE LU)
*  THE LATTER TWO CONTROL REQ'S ARE PROCESSED ON "OK TO PICK" 
*  STATUS OR ELSE REJECTED AS IN THE CASE OF THE READ REQUEST.
*  NOTE THAT FOR EASE OF IMPLEMENTATION THESE TWO CONTROL REQ'S 
*  CAN BE ACCOMPLISHED WITH THE STANDARD HIGH-LEVEL (MAG TAPE)
*  REWIND AND ENDFILE STATEMENTS. 
      SPC 1 
*  INTERPRETATION OF STATUS BITS IN EQT:
*   0  DEVICE NOT READY 
*   1  ILLEGAL HOLLERITH IF ASCII OR WORD COUNT IF PACKED BINARY
*   4  PICK FAILURE (AFTER TEN ATTEMPTS)
*   5  HOPPER BAD 
*   7  END OF FILE (DEFINED AS LAST-CARD.AND.BLANK-CARD)
      HED ***  RTE OMR DRIVER,DVR15  ***
*     INITIATION SECTION
      SPC 1 
I.15  NOP 
      JSB SETIO     CONFIGURE IO
      BLF,SLB       STATUS OK-TO-PICK?
      JMP OK        YES 
      RBR,RBR       IF NOT, 
      SSB,SLB,RSS   STATUS EXTENDED-CARD? 
      ISZ EQT5,I    NO - SET CR NOT READY 
OK    LDB EQT5,I    LOAD STATUS 
      LDA EQT6,I    LOAD CONTROL WORD 
      AND D3        ISOLATE REQUEST CODE. 
      CPA D3        CONTROL REQUEST?
      JMP R3        YES - GO GET SUBFUNCTION
      SLA,ARS       NO - READ REQUEST?
      JMP READ      YES, CONTINUE.
      JMP I.15,I    REJECT
      SPC 1 
B400  OCT 400 
B600  OCT 600 
B3700 OCT 3700
      SPC 1 
R3    LDA EQT6,I    LOAD CONTROL WORD.
      AND B3700     ISOLATE THE FUNCTION CODE.
      CPA B100      HOPPER SELECT?
      JMP HOPR      YES 
      CPA B400      RING BELL?
      JMP BELL      YES 
      CPA B600      DYNAMIC STATUS? 
      JMP A4        YES, GO TO IMMEDIATE COMPLETION.
      SPC 1 
      LDA D2        CONTROL REQ UNDEFINED 
      JMP I.15,I    REJECT
      SPC 1 
READ  CPA EQT8,I    ZERO BUFFER LENGTH? 
      JMP SKIP      YES, GO CHECK THE MODE. 
READ0 SLB           CR READY? 
      JMP A3        NO - GO TO EXIT 
      LDA EQT4,I    SAVE
      AND B100      SUBCHANNEL
      RAR           FOR 
      STA EQT11,I   CONVERSION
      LDA N10       INITIALIZE
      STA EQT13,I   PICK FAIL COUNTER 
READ1 LDA SC        LOAD CR SELECT CODE 
DMA1  OTA DMA       ASSIGN DMA
      LDA BUFAD     LOAD THE INTERNAL BUFFER ADDRESS. 
DMA2  CLC DMA-4     PREPARE THE ADDRESS REGISTER. 
DMA3  OTA DMA-4     OUTPUT THE BUFFER ADDRESS.
      LDA N81       LOAD THE WORD COUNT 
DMA4  STC DMA-4     PREPARE DMA WORD COUNT
DMA5  OTA DMA-4     OUTPUT THE WORD COUNT 
CR1   STC CR,C      ISSUE A PICK COMMAND TO THE CR. 
DMA6  STC DMA,C     ACTIVATE DMA
DMA7  CLC DMA       CLEAR DMA 
      CLA 
      CPA I.15      PICK FAILURE RETRY? 
      JMP C.RTN     YES, GO TO CONTINUATION RETURN. 
      JMP I.15,I    NO, RETURN SUCCESSFUL INITIATION
      SPC 1 
A3    LDA D3        SET FOR CR NOT READY
      JMP I.15,I    RETURN
      SPC 1 
BELL  LDA B10       BIT 3 
      JMP CR2 
HOPR  LDA D4        BIT 2 
      SLB           CR READY? 
      JMP A3        NO - GO TO EXIT 
CR2   OTA CR        TURN ON BIT 
      SZA,RSS       10 U'SECS ELAPSED?
      JMP A4        YES - GO TO IMMEDIATE COMPLETION
D2    DEC 2         NO -
D3    DEC 3         BURN
D4    DEC 4         TIME
      CLA           TURN OFF
      LDB N10       WAIT 50 MICROSECS 
      INB 
      ISZ 1         DONE WAITING? 
      JMP *-2       NO
      JMP CR2       THAT BIT
      SPC 1 
SKIP  LDA EQT6,I    LOAD CONTROL WORD 
      AND B100      ISOLATE THE MODE BIT. 
      SZA           MODE BINARY?
      JMP READ0     YES, GO SKIP RECORD 
A4    LDA D4        SET FOR IMMEDIATE COMPLETION
      JMP I.15,I    RETURN
      SPC 2 
BUFAD DEF I.BUF,I   INTERNAL BUFFER FOR DMA 
SC    BSS 1         CR SELECT CODE
      SPC 1 
N10   DEC -10 
N81   DEC -81 
D8    EQU * 
B10   OCT 10
B100  OCT 100 
B700  OCT 700 
B4000 OCT 4000
B4200 OCT 4200
B4300 OCT 4300
      SKP 
*     CONFIGURATION SECTION 
      SPC 1 
SETIO NOP 
      STA SC        STORE SELECT CODE 
      SPC 1 
      IOR CLCSC     CONFIGURE 
      STA *+1       & EXECUTE 
      CLC CR        CLEAR CR
      SPC 1 
      XOR B5000 
      STA CR1       CONFIGURE 
      XOR B5200     CR IO 
      STA DSTAT 
      STA *+1 
      LIB CR        LOAD CR STATUS
      XOR B4300 
      STA CR2 
      SPC 1 
      LDA CHAN      SAVE ASSIGNED 
      STA EQT12,I   DMA CHANNEL 
      SPC 1 
      IOR CLCSC 
      STA DMA7
      XOR B5000 
      STA DMA6
      XOR B1600 
      STA DMA8
      XOR B700      CONFIGURE 
      STA DMA1      DMA IO
      XOR D4
      STA DMA3
      STA DMA5
      ADA B100
      STA DMA4
      ADA B4000 
      STA DMA2
      XOR B4200 
      STA DMA9
      STA DMA10 
      SPC 1 
      LDA EQT5,I
      AND HIHAF     CLEAR STATUS WORD 
      STA EQT5,I
      SPC 1 
      JMP SETIO,I 
      SPC 3 
BUF   DEF I.BUF 
CLCSC CLC 0 
      SPC 1 
EXTRA IOR CLCSC     CLEAR 
      STA *+1       INTERRUPTING
      CLC 0         SELECT CODE 
C.RTN ISZ C.15      INCREMENT FOR 
      JMP C.15,I    CONTINUATION RETURN 
      SKP 
*  STD HP EBCDIC CHARS
HWPTB DEF *+1 
      ASC 1,!$
      ASC 1,;]
      ASC 1,+^
      SPC 1 
*   EBCDIC-RDTS CHARS 
      OCT 56444     RDTS CHAR=VERT BAR,$
      OCT 35536     RDTS CHAR=;,] 
      OCT 25441     RDTS CHAR=+,UNDERSCORE
      SPC 2 
CRSET NOP           LAST EBCDIC CHAR SET
      SPC 2 
*     COMPLETION SECTION
      SPC 1 
C.15  NOP 
      LDB EQT1,I    INTERRUPT EXPECTED? 
      SZB,RSS 
      JMP EXTRA     NO - QUEUE EMPTY
      LDB EQT12,I   GET DMA NUMBER BEING USED 
      CPB A         DMA INTERRUPT?
      JMP EXTRA     YES - IGNORE IT 
      STB CHAN      UPDATE SYSTEM WORD
DSTAT LIB CR        GET CR STATUS 
DMA8  STF DMA       STOP ANY DMA TRANSFER 
      NOP 
      CLA 
      STA LAST      CLEAR LAST CARD SWITCH
      RBL,RBL       SHIFT BIT 14 TO BIT 0 
      SLB           ECIH SIGNAL PRESENT ? 
      JMP *+4       YES: IT IS OK TO PROCESS
DMA10 LIA DMA-4     LOAD DMA WORD COUNT REGISTER
      CPA N81       WAS ANY DATA TRANSMITTED ?
      JMP OPERR     NO: HARDWARE FAILURE
      CLA           RESTORE HARDWARE REGISTER 
      SSB,SLB,RSS   LAST CARD?
      ISZ LAST      YES - SET SWITCH
      CPA EQT8,I    WAS A RECORD BEING SKIPPED? 
      JMP R.ERR     YES, GO TO COMPLETION RETURN. 
      STA CNTR      NO, INITIALIZE THE WORD COUNTER.
      STA COUNT     INITIALIZE COLUMN COUNTER 
      STA NULL      INITIALIZE NULL SWITCH
DMA9  LIA DMA-4     LOAD THE WORD COUNT REGISTER. 
      CPA N81       WAS ANY DATA TRANSMITTED? 
      JMP ERROR     NO, GO PROCESS ERROR
      CMA,INA       YES, WORD COUNT RESIDUE POSITIVE. 
      ADA N81       COMPUTE & 
      STA WCI       STORE THE WORD COUNT INDEX. 
      LDB BUF       LOAD INTERNAL BUFFER ADDRESS. 
      STB INPTR     STORE BUFFER ADDRESS INDEX. 
      STB TEMP      SAVE THE BUFFER ADDRESS INDEX.
      LDB EQT6,I    LOAD THE FUNCTION REQUEST CODE. 
      BLF,BLF       LOOK AT 
B5200 RBL           MODE BIT
      SSB           BINARY? 
      JMP BINRY     YES, GO PROCESS BINARY CARD.
      LDA EQT4,I    GET SUBCHN NO 
      AND B700
      CPA B100      BCD?
      JMP OUTS      YES-DONT FUSS WITH TABLE
      CPA CRSET     SAME AS LAST CHAR SET?
      JMP OUTS      YES 
      STA CRSET     UPDATE CRSET
      LDB HWPTB     ADDRS OF STD EBCDIC TABLE 
      CPA B200      RDTS EBCDIC?
      ADB D3        YES,USE RDTS CHARS
      LDA 1,I       GET 1ST CHAR
      STA LASC1     OVERLAY 1ST CHAR IN TABLE 
      INB           ADDRS OF NEXT CHAR
      LDA 1,I       GET 2ND CHAR
      STA LASC2 
      INB 
      LDA 1,I 
      STA LASC3 
OUTS  LDA WCI       RESTORE A REG 
      LDB EQT8,I    LOAD THE ORIGINAL REQUEST LENGTH. 
      SSB           IS THE REQUEST IN WORDS?
      CMB,INB,RSS   NO, COMPLEMENT CHARACTER COUNT. 
      RBL           YES, CONVERT WORDS TO CHARACTERS. 
      SSB           CHARACTER LENGTH OVERFLOW?
      JMP CHADR     YES, CONTINUE.
      ADA B         STORE LEAST 
      CMB,INB       OF # REQ'D
      SSA           OR # READ 
      STB WCI       AS WORD COUNT INDEX 
CHADR LDA EQT7,I    LOAD THE USER BUFFER ADDRESS. 
      CLE,ELA       SHIFT TO FORM CHARACTER ADDRESS.
      STA EXPTR     SAVE THE CHARACTER ADDRESS. 
LOOP  LDA INPTR,I   LOAD THE DATA COLUMN. 
      ISZ COUNT     INCREMENT THE COLUMN COUNTER. 
      AND B7777     GET RID OF STATUS 
      SZA,RSS       IF COLUMN IS BLANK, 
      JMP BLANK     SET CHARACTER A BLANK.
      ALF           LEFT JUSTIFY COLUMN 
      STA INPTR,I   & RESTORE IT
      CCB           PRESET BIT 8
      STB EIGHT     SWITCH
      LDB COUNT     LOAD THE CURRENT COLUMN COUNTER.
      STB CNTR      UPDATE CHARACTER COUNT
      SPC 1 
      AND B160      MASK OFF ALL BUT BITS 12,11,0 
      CLB           CLEAR B FOR LATER 
      SZA,RSS       ANY HIGH PUNCHES ?
      JMP NOHI      NO, TEST FOR LOW PUNCHES
      SPC 1 
      CPA B100      BIT 0 PUNCHED ? 
      LDB D32       YES, LOAD 32
      CPA B40       BIT 11 PUNCHED ?
      LDB D16       YES, LOAD 16
      CPA B20       BIT 12 PUNCHED ?
      LDB D48       YES, LOAD 48
      SZB,RSS       WAS ONLY ONE COLUMN PUNCHED ? 
      JMP BAD       NO, ILLEGAL PUNCH 
      SPC 1 
NOHI  STB TOTAL     SET HIGH FIELD WEIGHT 
      XOR INPTR,I   ISOLATE LOWER BITS OF COLUMN
      SZA,RSS       ANY LOW BITS PUNCHED ?
      JMP NOLOW     NO, CHARACTER COMPLETED.
      SPC 1 
      CLE,SSA       BIT 9 SET ? 
      LDB D9        YES, LOAD WEIGHT
B1600 ELA           BIT 9 SET ? 
      SEZ 
      JMP SET       YES, TEST FOR MORE BITS.
      SPC 1 
      ELA           BIT 8 SET ? 
      CLB,SEZ,RSS   YES,CLEAR B FOR LATER 
      JMP *+4       BIT 8 WAS NOT SET.
      STB EIGHT     SET THE SWITH 
      CLE,SZA,RSS   WAS ONLY BIT 8 SET ?
      JMP BIT8      YES, EXIT TO FORM CHARACTER.
      SPC 1 
      LDB D7        LOAD WEIGHT COUNTER 
      ELA           IS BIT 7 SET ?
      SEZ 
      JMP SET       YES, CHECK FOR OTHER PUNCHES
      LDB D6
      ELA           IS BIT 6 SET ?
      SEZ 
      JMP SET       YES 
      LDB D5
      ELA           IS BIT 5 SET ?
      SEZ 
      JMP SET       YES 
      LDB D4
      ELA           IS BIT 4 SET ?
      SEZ 
      JMP SET       YES 
      LDB D3
      ELA           IS BIT 3 SET ?
      SEZ 
      JMP SET       YES 
      LDB D2
      ELA           IS BIT 2 SET ?
      SEZ,RSS       YES 
      JMP ONE       NO, BIT 1 MUST BE.
SET   SZA           ANY OTHER PUNCHES ? 
      JMP EXBAD     YES, ILLEGAL COMBINATION
      ISZ EIGHT     WAS BIT 8 SWITCH SET? 
BIT8  ADB D8        YES, ADD WEIGHT FOR IT. 
BIT1  ADB TOTAL     ADD WEIGHT FOR FIELD BITS.
NOLOW SLB,BRS       PLACE ODD BIT IN A-REG. 
      CLA,INA       SET ODD CHARACTER FLAG
      ADB TABLE     FIND PLACE IN 
      ADB EQT11,I   APPROPRIATE TABLE 
      CLE,SZA       ODD CHARACTER ? 
      CCE 
      LDA B,I       GET WORD WITH TWO CHARS.
      SEZ,RSS       ODD CHARACTER ? 
      ALF,ALF       YES, RIGHT JUSTIFY IT 
      AND LOHAF     ISOLATE THE CHARACTER.
      RSS 
      SPC 1 
BLANK LDA B40       LOAD ASCII BLANK
      SPC 1 
LEGAL ISZ INPTR     INCREMENT BUFFER ADDRESS POINTER. 
      LDB EXPTR     LOAD CHARACTER BUFFER ADDRESS.
      CLE,ERB       SHIFT, FORM WORD BUFFER ADDRESS.
      SEZ,RSS       IS NEW CHARACTER TO BE LOWER? 
      ALF,SLA,ALF   NO, SHIFT TO HIGH ORDER; SKIP.
      IOR B,I       YES, INCLUDE THE HIGH ORDER PART. 
      STA B,I       STORE THE WORD IN USER BUFFER.
      ISZ EXPTR     INCREMENT BUFFER ADDRESS POINTER. 
      ISZ WCI       IS THE BUFFER EXHAUSTED?
      JMP LOOP      NO, GO PROCESS NEXT COLUMN. 
      LDB CNTR      YES, LOAD # NON-BLANK CHARACTERS. 
      SZB,RSS       NULL CARD?
      JSB EOF       YES - GO CHECK FOR EOF
      LDA EQT8,I    LOAD THE ORIGINAL REQUEST TYPE. 
      CLE,SSA,RSS   WAS THE REQUEST IN CHARACTERS?
      ERB           NO, CONVERT CHARACTERS TO WORDS.
END.  CLA,SEZ       WAS THE CHARACTER COUNT ODD?
      INB           YES, INCREMENT THE WORD COUNT.
      JMP C.15,I    COMPLETION RETURN.
      SPC 1 
BAD   LDB EQT11,I   DO EXTRA
      SZB,RSS       BCD TESTS?
      JMP OVERP     NO
      SPC 1 
      CPA B140      11 - 0  PUNCH ? 
      JMP BCDEX     YES, MAY BE ! 
      CPA B120      12 - 0  PUNCH ? 
      JMP BCDQU     YES, MAY BE ? 
      SPC 1 
EXBAD LDA EQT5,I    SET ILLEGAL PUNCH STATUS
      IOR D2
      STA EQT5,I
QUES  LDA B77       LOAD ASCII QUESTION MARK. 
      JMP LEGAL     STORE CHARACTER 
      SPC 1 
ONE   CLB,INB       SET WEIGHT, TEST BIT 8
      ISZ EIGHT     SWITCH
      JMP EXBAD     BIT 8 FLAG WAS ON, ILLEGAL PUNCH. 
      JMP BIT1      JUST BIT 1 PUNCHED
      SPC 1 
OVERP CPA B120      HOLLERITH 12 - 0 PUNCH ?
      RSS           YES 
      JMP EXBAD     ILLEGAL PUNCH 
      LDA B173      GET ASCII CODE
      JMP LEGAL 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D9    DEC 9 
D48   DEC 48
B160  OCT 160 
B77   OCT 77
B7777 OCT 7777
LOHAF OCT 377 
HIHAF OCT 177400
B173  OCT 173       ASCII FOR HOLLERITH 12-0 PUNCH
      SPC 1 
BCDEX XOR INPTR,I   TEST FOR OTHER BITS 
      SZA 
      JMP EXBAD     ILLEGAL PUNCHES 
      LDA B41       LOAD !
      JMP LEGAL     STORE SPECIAL CHARACTER 
      SPC 1 
BCDQU XOR INPTR,I   TEST FOR OTHER PUNCHES
      SZA 
      JMP EXBAD 
      JMP QUES      GO LOAD AND STORE  ?
      SPC 1 
B41   OCT 41        ! 
B120  OCT 120 
B140  OCT 140 
      SPC 1 
EOF   NOP 
      LDA LAST      LAST CARD?
      SZA,RSS       IF NOT, 
      JMP EOF,I     RETURN
      LDA EQT5,I    OTHERWISE,
      IOR B200      SET BIT 7 
      STA EQT5,I    TO INDICATE 
      CLA           END OF FILE 
      JMP R.ERR     GO TO COMPLETION RETURN 
      SPC 1 
B200  OCT 200 
      SKP 
BINRY STA COUNT     STORE WORD COUNT INDEX
RVRSE LDB B20       REVERSE CARD COLUMN 
      LDA TEMP,I    LOAD COLUMN 
      ERA           SHIFT OUT OF
      ELB           A THRU E INTO B 
      SEZ,RSS       COLUMN REVERSED?
      JMP *-3       NO
      STB TEMP,I    YES - STORE REVERSED COLUMN 
      SZB           WAS IT NULL?
      ISZ NULL      NO - TRIP SWITCH
      ISZ TEMP      POINT TO NEXT COLUMN
      ISZ COUNT     CARD REVERSED?
      JMP RVRSE     NO - GET NEXT COLUMN
      LDB NULL      WAS ENTIRE
      SZB,RSS       CARD NULL?
      JSB EOF       YES - GO CHECK FOR EOF
      LDB EQT6,I    GET CONTROL WORD
      BLF,BLF       DETERMINE IF
      SSB           PACKED BINARY 
      JMP PACKB     YES, GO PROCESS PACKED BINARY.
      LDA WCI       RELOAD WORD COUNT INDEX 
      JSB INDEX 
IMAGE LDA INPTR,I   LOAD THE DATA COLUMN. 
      ISZ INPTR     INCREMENT BUFFER ADDRESS POINTER. 
      STA EXPTR,I   STORE THE WORD IN USER BUFFER.
      ISZ EXPTR     INCREMENT BUFFER ADDRESS POINTER. 
      ISZ CNTR      INCREMENT THE WORD COUNTER. 
      ISZ WCI       IS THE BUFFER EXHAUSTED?
      JMP IMAGE     NO, CONTINUE. 
TLOG  LDA EQT8,I    LOAD THE ORIGINAL REQUEST TYPE. 
      LDB CNTR      LOAD THE TRANSMISSION LOG.
      CLE,SSA       WAS THE REQUEST IN CHARACTERS?
B5000 BLS           YES, CONVERT WORDS TO CHARACTERS. 
      JMP END.      GO ISSUE A COMPLETION RETURN. 
      SPC 2 
INDEX NOP 
      LDB EQT7,I    LOAD THE USER BUFFER ADDRESS. 
      STB EXPTR     SAVE THE USER BUFFER ADDRESS. 
      LDB EQT8,I    LOAD THE ORIGINAL REQUEST LENGTH. 
      SSB,RSS       IS THE REQUEST IN WORDS?
      CMB,INB,RSS   YES, COMPLEMENT WORD COUNT; SKIP. 
      BRS           NO, CONVERT CHARACTERS TO WORDS.
      CMA,INA       MAKE THE RECORD LENGTH POSITIVE.
      ADA B         STORE LEAST OF
      SSA,RSS       # REQ'D OR # READ 
      STB WCI       AS WORD COUNT INDEX 
      JMP INDEX,I 
      SPC 1 
B17   OCT 17
D60   DEC 60
      SPC 1 
PACKB LDA INPTR,I   LOAD THE FIRST DATA COLUMN. 
      RAR,RAR       SHIFT ROWS 12-5 TO LOWER. 
      RAR,RAR       SHIFT ROWS 12-5 TO LOWER. 
      AND LOHAF     ISOLATE THE RECORD WORD LENGTH. 
      CMA,INA,SZA,RSS ZERO RECORD LENGTH? 
      JMP ERROR     YES, GO FLAG WORD COUNT ERROR.
      STA WCI       NO, SAVE THE RECORD WORD LENGTH.
      JSB INDEX     GO COMPUTE THE WORD COUNT INDEX.
      LDA WCI       LOAD THE WORD COUNT INDEX.
      ADA D60 
      SSA           IS THE WORD COUNT > 60? 
      JMP ERROR     YES, GO FLAG WORD COUNT ERROR.
      LDB INPTR,I   NO, LOAD DATA COLUMN 1 OF 4.
      ISZ INPTR     INCREMENT BUFFER ADDRESS POINTER. 
UNPAK BLF           SHIFT COLUMN TO BITS 15-4.
      STB TEMP      SAVE THE DATA COLUMN. 
      LDA INPTR,I   LOAD DATA COLUMN 2 OF 4.
      ISZ INPTR     INCREMENT BUFFER ADDRESS POINTER. 
      ALF,ALF       SHIFT ROW 12 TO BIT 3.
      LDB A         SAVE THE DATA COLUMN. 
      AND B17       ISOLATE ROWS 12-1.
      IOR TEMP      INCLUDE COLUMN #1.
      JSB STORE     GO STORE DATA WORD 1 OF 3.
      AND HIHAF     ISOLATE ROWS 2-9. 
      STA TEMP      SAVE THE PARTIAL DATA COLUMN. 
      BLF,BLF       SHIFT ROW 12 TO BIT 7.
      BLF           SHIFT ROW 12 TO BIT 7.
      LDA B         LOAD DATA COLUMN 3 OF 4.
      AND LOHAF     ISOLATE ROWS 12-5.
      IOR TEMP      INCLUDE COLUMN #2.
      JSB STORE     GO STORE DATA WORD 2 OF 3.
      AND HIFOR     ISOLATE ROWS 6-9. 
      IOR B         INCLUDE DATA COLUMN 4 OF 4. 
      JSB STORE     GO STORE DATA WORD 3 OF 3.
      JMP UNPAK     GO PROCESS THE NEXT 4 COLUMNS.
      SPC 1 
HIFOR OCT 170000
D16   EQU * 
B20   OCT 20
D32   EQU * 
B40   OCT 40
      SPC 1 
STORE NOP 
      STA EXPTR,I   STORE THE BINARY DATA WORD. 
      ISZ EXPTR     INCREMENT BUFFER ADDRESS POINTER. 
      ISZ CNTR      INCREMENT THE WORD COUNTER. 
      LDA B         LOAD THE PREVIOUS DATA COLUMN.
      LDB INPTR,I   LOAD THE NEXT DATA COLUMN.
      ISZ INPTR     INCREMENT BUFFER ADDRESS POINTER. 
      ISZ WCI       IS THE BUFFER EXHAUSTED?
      JMP STORE,I   NO, RETURN. 
      JMP TLOG      YES, GO LOAD TRANSMISSION LOG.
      SPC 1 
OPERR CLA           RESTORE A REGISTER
      ELB           BIT 15 = FEED OK / BIT E = HOPPER 
      SSB           PICK FAILURE? 
      JMP PICKF     YES, GO CHECK FOR RETRY.
      SEZ,INA,RSS   GOOD HOPPERS = DEVICE INOPERABLE? 
      LDA B40       NO - BAD HOPPER 
NOPCK IOR EQT5,I    INCLUDE THE UPPER STATUS. 
      STA EQT5,I    UPDATE THE STATUS WORD. 
      CLA,INA       SET FOR NOT READY RETURN
R.ERR CLB 
      JMP C.15,I    RETURN
      SPC 1 
PICKF STA I.15      CLEAR THE INITIATION FLAG.
      ISZ EQT13,I   IS THIS THE LAST RETRY? 
      JMP READ1     NO, GO RETRY THE READ.
      LDA B20       YES - GO DO 
      JMP NOPCK     ERROR RETURN
      SPC 1 
ERROR LDA D2        SET IO ERROR STATUS 
      IOR EQT5,I    INCLUDE THE UPPER STATUS
      STA EQT5,I    UPDATE THE STATUS WORD
      CLA,INA       SET AREG=3 FOR TRANSMISSION 
      ADA D2        ERROR AND 
      JMP R.ERR     RETURN
      SKP 
TABLE DEF *+1       ASCII LOOKUP TABLE
      SPC 1 
*  EBCDIC PUNCH SET FOR EVEN SUBCHANNEL READERS 
      SPC 1 
      ASC 13, 123456789:#@'="-JKLMNOPQR 
LASC1 ASC 1,!$
      ASC 1,*)
LASC2 ASC 1,;]
      ASC 15,0/STUVWXYZ\,%_>?&ABCDEFGHI[.<( 
LASC3 ASC 1,+^
      SKP 
*  BCD PUNCH SET FOR ODD SUBCHANNEL READERS 
      SPC 1 
      ASC 16, 123456789?=':>?-JKLMNOPQR?$*];] 
      ASC 16,0/STUVWXYZ?,(_\?+ABCDEFGHI[.)[<^ 
      SPC 2 
I.BUF BSS 80        INTERNAL BUFFER 
LAST  BSS 1 
      SKP 
*     SYSTEM BASE PAGE COMMUNICATION AREA:
      SPC 1 
.     EQU 1650B     ESTABLISH AREA ORIGIN 
      SPC 1 
EQT1  EQU .+8       CR IO SUSPEND LIST
EQT4  EQU .+11      CONFIGURATION INFO
EQT5  EQU .+12      CR STATUS 
EQT6  EQU .+13      REQ CONTROL WORD
EQT7  EQU .+14      REQ BUFF ADDR 
EQT8  EQU .+15      REQ BUFF LNGTH
EQT11 EQU .+18      SUBCHANNEL SAVE WORD
EQT12 EQU .+81      DMA SAVE WORD 
EQT13 EQU .+82      PICK FAIL CNTR
      SPC 1 
CHAN  EQU .+19      CURRENT DMA CHANNEL 
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 1 
CR    EQU 0 
DMA   EQU 6 
      SPC 1 
INPTR EQU DMA1
EXPTR EQU DMA2
COUNT EQU DMA3
CNTR  EQU DMA4
TOTAL EQU DMA5
WCI   EQU DMA6
TEMP  EQU DMA7
EIGHT EQU DMA8
NULL  EQU CR1 
      SPC 1 
LNGTH EQU * 
      END 
                                                                                                                                                