ASMB,R,L,T,C,B  ** READB: BUFFERED READ **
      HED ** READB: BUFFERED READ **                         REV A
      NAM READB 
      ENT READB 
      EXT .ENTR,.IOC.,.DIO.,.IOR.,.IOI.,.DST
      SKP 
UREF# OCT 0 
FMT   BSS 1 
ARRAY BSS 1 
#REDS BSS 1 
#ELMT BSS 1 
BUFR  BSS 1 
BUFL  BSS 1 
* 
READB NOP           ENTRY 
      JSB .ENTR 
      DEF UREF# 
* 
*     CONFIGURE I/O REQUESTS
* 
      LDA UREF#,I   GET VALUE OF <UNIT REFERENCE #> 
      AND =B77      ISOLATE TO 2 OCTAL DIGITS 
      LDB A         SAVE RESULT IN B
      IOR RARC      ADD IN REQ.CODE FOR ASCII READ
      STA RC1       PUT INTO CALLING
      STA RC2            SEQUENCES
      LDA SRC       GET REQ. CODE FOR STATUS CHECK
      IOR B         ADD IN <UNIT REF. #>
      STA RC3       PUT INTO CALLING
      STA RC4            SEQUENCES. 
* 
*     INITILIZE # OF READS COUNTER
* 
      LDA #REDS,I   GET VALUE OF <# OF READS> 
      CMA,INA       MAKE IT NEGATIVE
      STA RCNTR     PUT RESULT INTO COUNTR
* 
*     INITILIZE # OF ELEMENTS PER RECORD COUNTER
* 
      LDA #ELMT,I   GET VALUE OF <# OF ELEMENTS>
      CMA,INA       MAKE IT NEGATIVE
      STA ELCNT     PUT RESULT INTO TEMP STORAGE
* 
*     INITILIZE INPUT BUFFER POINTERS 
* 
      LDA BUFR      GET ADDR OF BUFFER
      STA BUF1A     PUT INTO CALLING SEQ. OF CALLS
      STA BUF1B          TO IOC AND FMTR
      LDA BUFL,I    GET VALUE OF <RECORD SIZE>
      INA 
      ARS           DIVIDE IT IN HALF 
      ADA BUFR      ADD ADDR OF <BUFFER> TO LENGTH
      STA BUF2A     PUT RESULT IN CALLING SEQ. OF I/O CALL
      STA BUF2B     PUT EESULT IN CALLING SEQ. OF CONV.CALL 
* 
*     INITILIZE INPUT BUFFER LENGHTS
* 
      LDA BUFL,I    GET VALUE OF <RECORD SIZE>
      CMA,INA       MAKE IT NEGATIVE
      STA BUF1L     PUT RESULT INTO CALLING 
      STA BUF2L          SEQENCES FOR LENGTH
* 
*     INITILIZE POINTERS TO FORMAT SPECIFICATION
* 
      LDB FMT       GET ADDR OF FORMAT SPECIFICATION
      INB           BYPASS CHAR. COUNT
      LDA B,I       GET FIRST TWO CHAR OF FMT SPEC
      AND =B077400  ISOLATE UPPER CHARACTER 
      CPA ASTR      IS IT A ASTERIC 
      CLB           YES:SET B=0 FOR FREE FEILD READ 
*                                  NO:LEAVE B WITH ADDR OF FMT SPEC 
      STB FMT1      PUT IT INTO CALLS TO FMTR 
      STB FMT2
* 
*     INITIATE FIRST READ INTO BUFFER 1 
* 
      JSB READ1 
* 
** MAIN LOOP ** 
* 
LOOP  ISZ RCNTR 
      RSS 
      JMP END1
* 
*     INITIATE READ INTO BUFFER 2, THEN CONVERT BUFFER 1
* 
      JSB READ2 
      JSB CONV1 
* 
*     TEST FOR MORE READS 
* 
      ISZ RCNTR 
      RSS 
      JMP END2
* 
*     INITIATE READ INTO BUFFER 1,THEN CONVERT BUFFER 2 
* 
      JSB READ1 
      JSB CONV2 
      JMP LOOP
* 
** END 1 ** 
* 
END1  JSB .IOC. 
RC3   OCT 040000
      SSA 
      JMP *-3 
      JSB CONV1 
      JMP READB,I EXIT
* 
** END 2 ** 
* 
END2 JSB .IOC.
RC4   OCT 040000
      SSA 
      JMP *-3 
      JSB CONV2 
      JMP READB,I EXIT
      SKP 
* 
*     SUBROUTINE TO READ INTO BUFFER 1
* 
READ1 NOP 
      JSB .IOC. 
RC1   OCT 010000
      JMP *-2 
BUF1A DEF BUFR,I
BUF1L OCT 0 
      JMP READ1,I 
* 
*     SUBROUTINE TO READ INTO BUFFER 2
* 
READ2 NOP 
      JSB .IOC. 
RC2   OCT 010000
      JMP *-2 
BUF2A DEF BUFR,I
BUF2L OCT 0 
      JMP READ2,I 
* 
***   SUBROUTINE TO CONVERT BUFFER1 *** 
* 
CONV1 NOP 
      CLA 
      CLB,INB 
      JSB .DIO. 
BUF1B DEF BUFR,I
FMT1  DEF FMT,I 
      DEF ECON1 
* 
*     INITILIZE # OF ELEMENTS COUNTER 
* 
      LDA ELCNT 
      STA ECNTR 
* 
*     CONVERT EACH ELEMENT AND STORE INTO ARRAY 
* 
NEXT1 JSB .IOR. 
      JSB .DST
      DEF ARRAY,I 
      ISZ ARRAY 
      ISZ ARRAY 
      ISZ ECNTR 
      JMP NEXT1 
ECON1 JMP CONV1,I 
* 
*** SUBROUTINE TO CONVERT BUFFER 2 ***
* 
CONV2 NOP 
      CLA 
      CLB,INB 
      JSB .DIO. 
BUF2B DEF BUFR,I
FMT2  DEF FMT,I 
      DEF ECON2 
* 
*     INITILIZE # OF ELEMENTS COUNTER 
* 
      LDA ELCNT 
      STA ECNTR 
* 
*     CONVERT EACH ELEMENT AND STORE INTO ARRAY 
* 
NEXT2 JSB .IOR. 
      JSB .DST
      DEF ARRAY,I 
      ISZ ARRAY 
      ISZ ARRAY 
      ISZ ECNTR 
      JMP NEXT2 
ECON2 JMP CONV2,I 
      SKP 
* 
*     STORAGE 
* 
A     EQU 0 
B     EQU 1 
ELCNT OCT 1 
ECNTR BSS 1 
RCNTR BSS 1 
* 
*     CONSTANTS 
* 
RARC  OCT 010400
SRC   OCT 040000
ASTR  OCT 025000    ASCII ASTERIC IN UPPER HALF 
      END 
                                                                        