RDWRT    DSECT    1
VERSION  EQU      2            1=BPM,2=UTS
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU       12
D2       EQU      13
D3       EQU      14
D4       EQU      15
CEOL     EQU      2
CEOF     EQU      3
CNEXT8   EQU      4
CNBC1    EQU      5
CNBC65   EQU      6
CBLANK   EQU      7
COBTOTAL EQU      108*8             MAX BIT COUNT OF CO RECORD
MAXCLMN  EQU      140
         PAGE
         TITLE    'RDWRT'
         SYSTEM   SIG7
*
* RDWRT           READ M:EI / WRITE M:EO
*
* INPUT
*        M:EI     INPUT DCB
*        M:EO     OUTPUT DCB
*        TOARG    OUTPUT ARGUMENT TABLE
*        ARGTBL   INPUT ARGUMENT TABLE
*        IOBUF    I/O BUFFER
* OUTPUT
*        RDFPT    READ FPT
         REF      DEV%IN,DEV%OUT
*        WRTFPT   WRITE FPT
*        TOSWT    DEFINED -TO-SWITCH
*        COMPLETE DEVICE/FILE COPY
*
*
         REF      LINE%NO
         REF      LINE%NO1,LINE%NO2
         REF      ERROR,GETPAGE,CLOSEO
         REF      M:EI,M:EO,TOARG,TOSWT,RDFPT,WRTFPT,IOBUF
         REF      RECNUM,HEXDUMP
         REF      BUFSIZE
         REF      CIBUSED,CIBLEFT,CIBTOTAL,CIWORD,RECSIZE,CISEQ
         REF      COBUSED,COBLEFT,COWORD
         REF      PRTBUF,ATTRB,IOERR,CODE
         REF      KEY,CARDSEQ
         REF      BIN2BCD
         REF      TABSET
         REF      MODE
         REF      RSSAVE
         REF      LINENO
         REF      BREAK,COPYSTDF
         REF      SEQNUM
         DEF      CCTAB
         REF      SELECT,J:JIT
         REF      M:UC,M:LO
         REF      DEVICE
         REF      COPYSK
         REF      GRANCNT
         REF      PRNTBUF,UNPRINT
         REF      ANSBLK,BLKBUFF
         REF      MBS,BCD2BIN
         REF      UNBADR,BLKSIZE
         REF      NPAGE
*
         USECT    RDWRT
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
*
*
         LI,R1    7                 INITIALIZE READ FPT
         LW,R2    R7
         AI,R2    RDFPT-1
         LW,R3    IRDFPT-1,R1
         STW,R3   *R2,R1
         BDR,R1   %-2
*
*
         LI,R1    WFPTSIZE          WRITE FPT SIZE
         LW,R2    R7
         AI,R2    WRTFPT-1
         LW,R3    IWRTFPT-1,R1
         STW,R3   *R2,R1
         BDR,R1   %-2
*
         STW,R0   GRANCNT           ZERO COPY ABORT FLAG
         LW,R1    BUFSIZE,R7
         LI,R3    X'30'
         CS,R3    M:EI+5            TEST IF RANDOM FILE
         BE       %+3
         CS,R3    M:EO+5
         BNE      READ16            NO
         LI,R1    2048              SET BUFFER SIZE TO ONE PAGE
         LW,R2    =X'F4000050'
         STW,R2   WRTFPT+1,R7       REMOVE KEY ADDRESS FROM WRTFPT
         STW,R0   WRTFPT+6,R7
READ16   STW,R1   RDFPT+5,R7        SET SIZE OF CURRENT RD/WR BUFFER
         LI,R2    IOBUF             ADD I/O BUFFER
         AW,R2    R7
         STW,R2   RDFPT+4,R7
         STW,R2   WRTFPT+4,R7
         LW,R1    ANSBLK+1          WAS REC SPECIFIED FOR ANS
         BEZ      %+2               NO
         STW,R1   RDFPT+5,R7        YES - CHANGE BUFFER SIZE
         LW,R2    ANSBLK            WAS BLOCKING REQUESTED
         BEZ      READ42            NO
         AI,R1    0
         BNEZ     %+2
         LW,R1    R2                LEAVE BLK SIZE FOR REC
         CI,R1    140
         BGE      %+2
         LI,R1    140               MINIMUM BUFFER SIZE
         AW,R2    R1
         AI,R2    6                 COMPUTE MAX BUFFER SIZE
         SLS,R2   -11               COMPUTE NUMBER OF PAGES NEEDED
         AI,R2    0
         BEZ      READ41            NO MORE PAGES NEEDED
         CAL1,8   GETPG             GET MORE PAGES
         BCS,8    EOF11             NOT AVAILABLE
         STW,SR1  NPAGE,R7
READ41   EQU      %
         AI,R1    3
         SLS,R1   -2                COMPUTE WORD SIZE OF REC
         AI,R1    IOBUF
         AW,R1    R7                BLOCK BUFFER ADDRESS
         STW,R1   WRTFPT+4,R7       SET WRITE ADR TO BLK BUF PTR
         SW,R1    R7
         SLS,R1   2
         STW,R1   BLKBUFF           INITIALIZE BLK BUFF POINTER
         B        READ43
READ42   LW,R1    DEVICE,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%IN,R7    SYSTEM INPUT DEVICE.
         CI,R1    7                 IS INPUT FROM ANS
         BNE      READ43            NO
         CW,R1    TOARG,R7          ANS TO ANS COPY
         BE       %+3          PCL DEVICE.
         CW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         BNE      READ44            NO
         MTW,0    TOARG+10,R7       SEQ OPTION PRESENT
         BNEZ     READ32            YES - ERROR
         LI,R1    X'FF00'
         CS,R1    TOARG+8,R7        TX OPTION USED
         BANZ     READ32            YES - ERROR
         SLS,R1   8
         CS,R1    TOARG+9,R7   NC OPTION USED.
         BANZ     READ32            YES - ERROR
READ44   EQU      %
         LH,R2    M:EI+3            GET BLKSZ
         SLS,R2   -1
         STW,R2   RDFPT+5,R7        SET SIZE FOR READ
         AI,R2    -1
         SLS,R2   -11               COMPUTE NUM OF EXTRA PAGES REQD
         AI,R2    0
         BLEZ     READ43            NO MORE
         CAL1,8   GETPG             GET EXTRA PAGES
         BCS,8    EOF11             NOT AVAILABLE
         STW,SR1  NPAGE,R7
READ43   EQU      %
         LI,R1    4
         CW,R1    TOARG+10,R7       LN OPTION SPECIFIED
         BNE      READ40            NO
         LI,R1    KEY
         AW,R1    R7
         STW,R1   WRTFPT+6,R7       ENTER KEY ADDRESS IN WRITE FPT
         LW,R1    =9999999
         STW,R1   TOARG+14,R7       SET MAX LN VALUE FOR COMPARE
READ40   EQU      %
         LI,R6    0                 CLEAR EOD COUNTER
         STW,R0   UNBADR            INITIALIZE FOR UNBLOCKING
         LI,R2    3
         CW,R2    CODE,R7           COMPRESSED INPUT
         BE       RDWRTCO           YES
         CW,R2    TOARG+5,R7        COMPRESSED OUTPUT
         BE       RDWRTCO           YES
READ9    CAL1,1   SETEI
         CAL1,1   SETEO
         LW,R1    SELECT,R7
         STW,R1   RSSAVE,R7         SAVE COUNT OF REC SELECTIONS
         LI,SR2   SELECT+1          INITIALIZE RS TABLE INDEX
READ4    STW,R0   RECNUM,R7         ZERO RECORD NUMBER COUNT
*
READ0    LI,R6    0                 CLEAR EOD COUNTER
*
READ1    LW,R1    ='    '           BLANK BUFFER
         LI,R3    34
         LW,R2    RDFPT+4,R7
         STW,R1   *R2,R3
         BDR,R3   %-1
         LW,R1    =X'00404040'
         STW,R1   0,R2              INITIALIZE FIRST WORD
         CAL1,1   RDFPT,R7          READ INPUT RECORD
READ14   EQU      %
         LW,R3    M:EI+4            TRANSFER RECORD SIZE TO WRITE FPT
         SLS,R3   -17
         LI,R1    X'F'
         AND,R1   M:EI              GET ASN FROM DCB
         CI,R1    2                 IS IT DEVICE OR ANS
         BG       %+2               YES
         LW,R3    M:EI+13           NO - GET SIZE FROM RWS WORD
         AI,R3    0                 TEST FOR NULL RECORD
         BNEZ     READ33            NO
         LW,R1    TOARG,R7
         CI,R1    8                 TEST IF OUTPUT TO ME,LP,CP
         BL       READ33            NO-OUTPUT NULL RECORD
         AI,R3    1                 FORCE ONE BLANK FOR OUTPUT
         LI,R1    X'40'
         STB,R1   *R2
READ33   EQU      %
         MTW,0    ANSBLK            IS BLOCKING WANTED FOR ANS
         BEZ      READ26            NO
         MTW,0    ANSBLK+1          YES - WAS REC SIZE GIVEN
         BNEZ     READ27            YES
         STW,R3   ANSBLK+1          SET REC TO SIZE OF 1ST REC
READ26   CI,R1    X'A'              IS INPUT FROM ANS TAPE
         BNE      READ28            NO
         CS,R1    M:EO
         BE       ANSCVT            OUTPUT IS ANS
         LW,R2    RDFPT+4,R7
         STW,R2   WRTFPT+4,R7       RESET WRITE ADDRESS
         STW,R3   BLKSIZE           SET TO SIZE OF INPUT
READ29   BAL,SR4  UNBLK             OUTPUT NOT ANS - GO UNBLOCK
         BCS,2    READ27            BLOCKED FORMAT
READ28   EQU      %
         MTW,0    ANSBLK+1          WAS REC SPECIFIED
         BEZ      %+2               NO
         LW,R3    ANSBLK+1          GET REC VALUE
         STW,R3   WRTFPT+5,R7       ENTER SIZE IN WRITE FPT
READ27   EQU      %
         MTW,1    RECNUM,R7
         DO1      VERSION=2
         MTW,1    RDFPT+6,R7        INC BLOCK FOR RANDOM
         MTW,0    SELECT,R7         ANY RS OPTIONS IN EFFECT
         BEZ      READ2             NO
         LW,R1    SR2               GET X-Y POINTER
         LW,R2    RECNUM,R7    GET CURRENT REC. NO.
         CW,R2    *R7,R1       COMPARE WITH X VALUE
         BL       READ17            NOT IN RANGE
         AI,R1    1                 STEP TO Y VALUE
         CW,R2    *R7,R1       COMPARE
         BLE      READ2             WITHIN RANGE - GO WRITE
         MTW,-1   SELECT,R7         DECREMENT NO. OF RS OPTIONS
         BEZ      EOF8              NO MORE
         AI,SR2   2                 POINT INDEX TO NEXT PAIR
         CW,R2    *SR2,R7      MUST FILE BE REPOSITIONED.
         BL       READ17            NO
         BE       READ2             GO WRITE RECORD
READ3    LW,R1    DEVICE,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%IN,R7    SYSTEM INPUT DEVICE.
         CI,R1    1                 IS INPUT FROM CR
         BE       DEVERR            YES - ERROR
         CI,R1    7                 IS INPUT FROM ANS TAPE
         BE       DEVERR            YES - ERROR
         CAL1,1   PFIL              POSITION TO BOF
         B        READ4
READ17   LW,R3    *SR2,R7
         AI,R3    -1                IS PRECORD NEEDED
         LI,R1    3
         CS,R1    M:EI              TEST ASN
         BLE      READ1             NOT FILE OR LABEL - DONT PRECORD
         LI,R1    X'A'              CHECK FOR ANS
         CS,R1    M:EI
         BNE      READ17A           NOT ANS
         MTW,0    UNBADR
         BNEZ     READ29            MORE RECORDS IN BLOCK.
         B        READ0
READ17A  EQU      %
         LI,R1    X'30'
         CS,R1    M:EI+5            TEST IF ORG IS RANDOM
         BNE      READ25            NO
         DO1      VERSION=2
         STW,R3   RDFPT+6,R7        SET BLOCK FOR NEXT READ
         STW,R3   RECNUM,R7         UPDATE RECORD NUMBER
         B        READ1
READ25   EQU      %
         SW,R3    RECNUM,R7         COMPUTE NO. OF RECS TO SKIP
         BEZ      READ1             NONE
READ23   CI,R3    32767             ONLY ONE PREC REQUIRED
         BLE      READ24            YES
         LW,R2    R3                SAVE NO. RECS YET TO SKIP
         LI,R3    32767             PREC COUNT
         CAL1,1   PREC2
         AWM,R3   RECNUM,R7         BUMP RECORD COUNT
         LW,R3    R2
         AI,R3    -32767            COMPUTE NO. RECS YET TO SKIP
         B        READ23
READ24   EQU      %
         CAL1,1   PREC2             POSITION TO RECORD WANTED
         AWM,R3   RECNUM,R7         BUMP RECNUM BY PREC NUM
         B        READ1             GO READ
READ2    EQU      %
         LW,R3    WRTFPT+5,R7  LOAD RECORD LENGTH.
         BAL,SR4  NCCHK             CHECK FOR NC OPTION
         LW,R1    TOARG+8,R7
         CI,R1    X'FF00'           WAS TX OPTION SPECIFIED
         BAZ      READ52            NO
         LI,R1    IOBUF             BUFFER DISPLACEMENT
         BAL,SR4  TABEXP            EXPAND TABS
READ52   EQU      %
         LW,R1    TOARG+10,R7       TEST IF ANY SEQUENCING WANTED
         BNEZ     SEQID,R1          BR TO APPROPRIATE ROUTINE IF YES
WRITE2   EQU      %
         LI,D3    IOBUF             BUFFER ADR
         BAL,SR4  BLKTEST           TEST IF BLOCKING WANTED
         B        READ0             YES - GO GET NEXT RECORD
         LI,R5    6
         CW,R5    TOARG+5,R7        IS THERE AN 'X' PRESENT
         BNE      WRITE4            NO - HEX DUMP NOT WANTED
         BAL,SR4  HEXDUMP           YES; GO DO A HEXDUMP
         MTW,0    UNBADR            DO WE NEED TO UNBLOCK
         BNEZ     READ29            YES
         B        READ0
WRITE4   LW,R2    TOARG,R7
         CI,R2    10                TEST IF OUTPUT TO CP
         BNE      WRITE3            NO
         LW,R2    WRTFPT+4,R7
         LB,R2    *R2               TEST FIRST BYTE OF RECORD
         LI,R1    4
         CB,R2    BINVAL,R1         IS IT STANDARD BINARY CODE
         BE       %+3               YES
         BDR,R1   %-2
         B        WRITE1            NO
         CAL1,1   SETBIN            SET BIN MODE IN DCB
         B        WRITE1
WRITE3   LW,R1    TOARG+8,R7
         CW,R1    =X'00FF0000'      IS K OPTION PRESENT
         BAZ      WRITE1            NO
         LI,R3    X'F0'
         LI,R2    X'20'
         CS,R2    M:EI+5            IS FILE KEYED
         BNE      WRITE5            NO
         LW,R1    M:EI+10           KEY ADDRESS
         LB,R2    M:EI+12           GET KEY MAX
         CI,R2    3                 IS IT A 3-BYTE KEY
         BNE      WRITE6            NO
         LW,R1    *R1
         AND,R1   =X'00FFFFFF'      GET KEY
         BAL,SR4  BIN2BCD           CONVERT TO BCD
         SLD,R2   8
         LB,R1    R2                FIRST BYTE OF VALUE
         SLS,R2   8
         OR,R1    =X'40604000'
         OR,R2    =X'0000F04B'      EDIT NO. TO XXXX.XXX
         OR,R3    =X'F0F0F040'
         STW,R1   LINENO,R7         PUT IN BUFFER
         STW,R2   LINENO+1,R7
         STW,R3   LINENO+2,R7
         LW,R1    RECNUM,R7         GET RECORD NUMBER
         BAL,SR4  BIN2BCD           CONVERT TO BCD
         STW,R2   SEQNUM,R7
         STW,R3   SEQNUM+1,R7       PUT NUMBER IN BUFFER
         LI,R1    2
         STW,R1   WRTFPT+7,R7       ADD BTD
         LW,R4    WRTFPT+4,R7       SAVE BUFF ADR
         MTW,-5   WRTFPT+4,R7       CHANGE BUFFER ADDRESS
         LI,R1    18                INCREMENT WRITE COUNT
         AWM,R1   WRTFPT+5,R7
         B        WRITE1+1
*
WRITE6   EQU      %
         LD,R2    KEYX
         STW,R2   PRNTBUF,R7        SET UP LINE FOR PRINTING KEY
         STW,R3   PRNTBUF+1,R7
         LI,D3    PRNTBUF+1
         AW,D3    R7
         BAL,SR4  UNPRINT           ENTER KEY IN BUFFER
         CAL1,1   PRINT1            WRITE BLANK LINE
         AI,R2    5                 LENGTH OF PRINT LINE
         AI,D3    -1                COMPUTE BUFFER ADDRESS
         CAL1,1   PRINT2            PRINT KEY
         B        WRITE1
WRITE5   LW,R1    RECNUM,R7         GET RECORD NUMBER
         BAL,SR4  BIN2BCD           CONVERT TO BCD
         LI,R1    0
         STB,R3   R1                LAST BYTE TO R1
         OR,R1    =X'00406040'      ADD HYPHEN
         SLD,R2   -8                 POSITION OTHER BYTES
         STW,R2   LINENO,R7         ENTER IN BUFFER
         STW,R3   LINENO+1,R7
         STW,R1   LINENO+2,R7
         B        WRITE%5B
WRITE%5A EQU      %
         MTW,1    RECNUM,R7    UP RECORD COUNT.
         LI,R3    X'F0'
         LW,R1    RECNUM,R7    GET RECORD NUMBER
         BAL,SR4  BIN2BCD      CONVERT TO BCD
         LI,R1    0
         STB,R3   R1           LAST BYTE TO R1
         OR,R1    =X'00406040'   ADD HYPHEN
         SLD,R2   -8           POSITION OTHER BYTES
         STW,R2   LINE%NO,R7   ENTER IN BUFFER.
         STW,R3   LINE%NO1,R7
         STW,R1   LINE%NO2,R7
WRITE%5B EQU      %
         LI,R1    3
         STW,R1   WRTFPT+7,R7       BTD
         LW,R4    WRTFPT+4,R7       SAVE BUFF ADR
         MTW,-3   WRTFPT+4,R7       CHANGE BUFFER ADDRESS
         LI,R1    9                 INCREMENT WRITE COUNT
         AWM,R1   WRTFPT+5,R7
         B        WRITE1+1
*
WRITE1   EQU      %
         LW,R4    WRTFPT+4,R7       BUFFER ADDRESS
         LW,R2    TOARG,R7
         CI,R2    9                 IS OUTPUT TO LP
         BNE      WRITE7            NO
         LW,R2    WRTFPT+5,R7       GET SIZE OF RECORD
         LI,R3    X'100'
         CW,R3    M:EO       CHECK IF VFC OPTION SPECIFIED.
         BANZ     WRITE7       VFC OPTION PRESENT.
WRITE8   AI,R2    -132
         BLEZ     WRITE7            ONLY ONE LINE REQUIRED
         LI,R3    132
         STW,R3   WRTFPT+5,R7       PRINT 1ST(NEXT) 132 CHARS
         CAL1,1   WRTFPT,R7
         LI,R3    33
         AWM,R3   WRTFPT+4,R7       UPDATE BUFFER ADDRESS
         STW,R2   WRTFPT+5,R7       NO. REMAINING CHARS IN REC
         B        WRITE8
WRITE7   CAL1,1   WRTFPT,R7         WRITE OUTPUT RECORD
         STW,R4   WRTFPT+4,R7       RESTORE BUFFER ADDRESS
         BAL,SR4  BRCHK             CHECK BREAK FLAG
         MTW,0    UNBADR            DO WE NEED TO UNBLOCK
         BNEZ     READ29            YES
         LW,R1    CODE,R7
         CI,R1    3
         BE       READ6             COMPRESSED INPUT
         B        READ0
*
RDABN    LB,R3    SR3               GET ABNORMAL CODE
         CI,R3    5                 TEST FOR EOD
         BE       EOD1              EOD FOUND
         CI,R3    6                 EOF ENCOUNTERED
         BNE      EOF1              NO
EOD1     EQU      %
         LI,R5    6
         CW,R5    TOARG+5,R7        DOING A HEX DUMP
         BNE      EOD2              NO
         LI,R5    3
         CS,R5    M:EI              HEXDUMP FROM A DEVICE
         BNE      EOD2              NO
         LW,R1    MODE+3,R7
         CI,R1    X'FF'             TEST FOR DEOD OPTION
         BANZ     EOD2              YES
         LI,R2    18                MESSAGE SIZE
         LI,R1    M:EO              DCB ADDRESS
         CAL1,1   FPTEOD            YES-INDICATE --EOD-- ENCOUNDED
EOD2     EQU      %
         MTW,0    ANSBLK            TEST IF BLOCKING FOR ANS
         BEZ      %+2               NO
         CAL1,1   WRTFPT,R7         WRITE LAST BLOCK
         AI,R6    1
         CI,R6    2                 TEST FOR DOUBLE EOD
         BE       EOF5
         LI,R5    3
         CW,R5    CODE,R7           INPUT COMPRESSED WANTED
         BE       RDWRTCO           YES
         CW,R5    TOARG+5,R7        OUTPUT COMPRESSED WANTED
         BNE      EOD3              NO
         STW,R0   RECSIZE,R7        INDICATE NO MORE INPUT
         LW,SR1   R3
         BAL,SR4  COMPRESS          OUTPUT LAST RECORD
         LW,R3    SR1
         LW,SR3   IOERR,R7          DID IO ERROR OCCUR
         BNEZ     EOERR             YES
EOD3     EQU      %
         MTW,0    SELECT,R7         ANY MORE RECORD SELECTIONS
         BNEZ     EOF5+2            YES
         LW,R1    MODE+3,R7
         CI,R1    X'FF'             DEOD OPTION
         BAZ      EOD4              NO
         LW,R1    RSSAVE,R7         INITIALIZE FOR RECORD SELECTION
         STW,R1   SELECT,R7
         LI,SR2   SELECT+1          INITIALIZE SELECT TABLE INDEX
         B        %+2
EOD4     EQU      %
         CAL1,1   WEOF              WRITE EOD
         CI,R3    6                 EOF ENCOUNTERED
         BE       RETURN            YES
         B        READ1
*
EOF1     EQU      %
         CI,R3    7                 TEST FOR LOST DATA
         BNE      EOR
         MTW,0    ANSBLK+1
         BNEZ     *SR1              IGNORE IF REC SIZE GIVEN FOR ANS
         BAL,SR4  GETPAGE           GET ADDITIONAL BUFFER PAGE
         CI,SR1   0                 DID WE GET SOME PAGES
         BNE      EOF2              YES
         MTW,1    GRANCNT           SET ABORT FLAG
         MTW,0    COPYSK            TEST IF COPYALL
         BEZ      %+3               NO
         LW,D4    =X'07000000'      SET ABN CODE
         B        RETURN1
EOF11    EQU      %
         LI,R1    33                ERROR-ADDITIONAL PAGE NOT AVAILABLE
         BAL,SR4  ERROR
         B        RETURN
EOF2     EQU      %
         LW,R2    RDFPT+5,R7        OLD BUFFER SIZE
         SLS,SR1  11                CONVERT PAGES TO BYTES
         AW,R2    SR1               NEW BUFFER SIZE
         LI,R1    X'F'
         AND,R1   M:EI              GET ASN FROM DCB
         CI,R1    2                 IS IT DEVICE OR ANS
         BLE      EOF4              NO
         LW,SR1   RDFPT+5,R7
         CI,SR1   X'7FFF'           YES-BUFFER CAN NOT BE LARGER
         BL       EOF3                  THAN  15 BITS
         LI,R1    38                ERROR-RECORD SIZE LARGER THAN 15 BIT
         BAL,SR4  ERROR
         B        RETURN
EOF3     CI,R2    X'7FFF'
         BL       EOF4              IF BUFFER LARGER THAN 15 BITS
         LI,R2    X'7FFF'           SET AT 15 BITS
EOF4     STW,R2   RDFPT+5,R7
         STW,R2   BUFSIZE,R7
         CAL1,1   PREC              POSITION BACK ONE RECORD
         B        READ1
EOF5     MTW,0    SELECT,R7         ANY RS OPTIONS
         BEZ      RETURN            NO
         LW,R3    RECNUM,R7         GET NO. OF LAST REC
         CW,R3    *SR2,R7           COMPARE WITH X VALUE
         BL       EOF7              ERROR-ENTIRE SELECTION NOT IN FILE
         AI,SR2   1                 POSITION TO Y VALUE
         CW,R3    *SR2,R7           LAST REC NO. VS Y VALUE
         BGE      EOF6              WITHIN FILE
         LI,R5    6
         CW,R5    TOARG+5,R7        DOING A HEX DUMP
         BE       EOF6              YES - DON'T REPEAT MESSAGE
         LI,R2    19
         LI,R1    M:UC
         MTW,0    J:JIT             ON-LINE
         BLZ      %+3               YES
         LI,R2    18                BATCH - DON'T PRINT NL CHAR
         LI,R1    M:LO
         CAL1,1   FPTEOD            PRINT 'EOD ENCOUNTERED'
EOF6     MTW,-1   SELECT,R7         DECREMENT NO. OF RS OPTIONS
         BNEZ     %+3
EOF8     CAL1,1   WEOF              NO MORE-WRITE EOF
         B        RETURN
         AI,SR2   1                 POSITION TO X VALUE
         CW,R3    *SR2,R7           TEST IF IN FILE
         BGE      READ3             YES - RE-READ FILE
EOF7     LI,R1    41                ERROR - NOT IN FILE
         BAL,SR4  ERROR
         AI,SR2   1                 POSITION TO Y VALUE
         B        EOF6              TRY NEXT RS PAIR
*
EOR      CI,R3    X'1C'             TEST FOR END OF REEL
         BNE      IOERR1
         LI,R3    EOCVOL2
         LI,R4    2
         BAL,SR4  ULBLCHK           TEST FOR TRAILER LABEL
         CAL1,1   EICVOL            ADVANCE TO NEXT INPUT TAPE REEL
         B        *SR1               CONTINUE TO READ
*
WRTABN   LB,R1    SR3               GET ABNORMAL CODE
         CI,R1    X'1C'             TEST FOR END OF REEL
         BNE      EOERR
         LW,R1    TOARG,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R1    4                 OUTPUT TO LABELED TAPE
         BNE      %+3               NO
         AI,SR1   -1                BACK UP TO WRITE CAL
         B        %+3
         CAL1,1   WEOF              DOUBLE EOF
         CAL1,1   WEOF              WRITE EOD
         CAL1,1   EOCVOL            CLOSE CURRENT OUTPUT VOLUME
         B        *SR1              CONTINUE READING AND WRITING
*
DEVERR   LI,R1    27                INVALID RS SPEC FOR DEVICE
         B        IOERR1+1          REPORT ERROR
EIERR    LB,R1    SR3               TEST FOR LAST REEL
         CI,R1    X'56'
         BNE      IOERR3            NO - SOME OTHER ERROR
         LI,R1    3
         CW,R1    TOARG+5,R7        COMPRESSED OUTPUT
         BNE      READ14            NO - WRITE LAST RECORD (FT)
         B        READ81            WRITE COMPRESSED RECORD
IOERR3   CI,R1    X'42'
         BNE      IOERR1
         LI,D4    0
         LI,R1    X'30'
         CS,R1    M:EI+5
         BE       RETURN2           END OF RANDOM FILE
         B        IOERR1
*
ULBLCHK  LW,R1    DEVICE,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%IN,R7    SYSTEM INPUT DEVICE.
         CI,R1    4                 IS INPUT FROM LT
         BE       %+3               YES
         CI,R1    7                 INPUT FROM ANS TAPE
         BNE      *SR4              NO
         LI,SR1   READ1                    RETURN LOC TO RESUME READ
         LW,R1    TOARG,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R1    4                 IS OUTPUT TO LT
         BE       %+3               YES
         CI,R1    7                 OUTPUT TO ANS TAPE
         BNE      *SR4              NO
         LW,R1    RDFPT+4,R7        ADDRESS OF READ BUFFER
         LW,R1    0,R1
         CW,R1    =X'00404040'      WAS A TRAILER LABEL READ
         BE       *SR4              NO
         LCI      3
         LM,R1    0,R3               MOVE FPT TO DATA AREA
         STM,R1   IOBUF+250,R7
         LW,R1    RDFPT+4,R7
         LW,R3    R7
         AW,R3    R4                COMPUTE ADR OF LABEL ENTRY
         STW,R1   IOBUF+250,R3      ENTER BUFFER ADDRESS
         CAL1,1   IOBUF+250,R7      DO CLOSE OR CLOSE VOLUME
         B        *SR4
EOERR    EQU      %
         STW,R0   TOSWT,R7          CLEAR DEFINED OUTPUT
*
IOERR1   LI,R1    0                 FLAG I/O ERROR
         MTW,1    GRANCNT           SET ABORT FLAG
         MTW,0    COPYSK            TEST IF COPYALL
         BEZ      %+3               NO
         LW,D4    SR3               GET ERR/ABN CODE
         B        RETURN1
         BAL,SR4  ERROR
*
RETURN   LW,R1    MODE+3,R7
         CI,R1    X'FF'             WAS DEOD SPECIFIED
         BAZ      %+2               NO
         CAL1,1   WEOF              YES - WRITE EOF
         LI,D4    0
RETURN1  EQU      %
         LI,R3    CLOSE2
         LI,R4    3
         BAL,SR4  ULBLCHK           TEST FOR TRAILER LABEL
         MTW,0    GRANCNT           WAS COPY ABORTED
         BNEZ     %+3               YES
         CI,D2    1                 ERROR CONDITION
         BLE      RETURN2           NO
         LW,R1    TOARG,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R1    DEV%OUT,R7   SYSTEM OUTPUT DEVICE.
         CI,R1    3                 GOING TO RAD FILE
         BE       %+3               YES
         CI,R1    5                 GOING TO DISK PACK
         BNE      RETURN2           NO
         LW,R1    M:EO
         CW,R1    =X'00200000'      IS OUTPUT FILE OPEN
         BAZ      RETURN2           NO
         CAL1,1   FPTREL            RELEASE BAD RAD FILE
RETURN2  LCI      7
         PLM,R5   *R7
         B        *SR4
*
WEOF     DATA     X'02000000'+M:EO
EICVOL   GEN,8,7,17      X'03',0,M:EI
         DATA     0
EOCVOL   DATA     X'03000000'+M:EO
         DATA     0
EOCVOL2  GEN,8,24 X'03',M:EO
         DATA     X'40000000'
CLOSE2   GEN,8,24 X'15',M:EO
         DATA     X'C0000000'
         DATA     2
PFILEO   GEN,8,24 X'1C',M:EO
         DATA     X'10'
*
PREC     DATA     X'1D000000'+M:EI
         DATA     X'10'
PREC2    GEN,8,24 X'1D',M:EI
         DATA     X'C0000000'
         PZE      *R3               C(R3)=NO. OF RECORDS
         DATA     EOF7              ABNORMAL
         BOUND    8
KEYX     TEXT     'KEY=    '
PRINT1   GEN,8,24 X'11',M:EO
         DATA     X'34000010'
         DATA     CITAB+1           BUFFER
         DATA     2                 SIZE
         DATA     0                 BTD
PRINT2   GEN,8,24 X'11',M:EO
         DATA     X'34000010'
         PZE      *D3               BUFFER
         PZE      *R2               SIZE
         DATA     0                 BTD
GETPG    DATA     X'88000002'       GET PAGE FPT
*
SETEI    DATA     X'06000000'+M:EI
         DATA     X'C0000000'
         DATA     EIERR             ABNORMAL ADDRESS
         DATA     EIERR             ERROR ADDRESS
*
SETEO    DATA     X'06000000'+M:EO
         DATA     X'C0000000'
         DATA     EOERR             ABNORMAL ADDRESS
         DATA     EOERR             ERROR ADDRESS
*
IRDFPT   DATA     X'10000000'+M:EI
         DO1      VERSION=2
         DATA     X'F1000018'       EXISTENCE FLAGS
         DO1      VERSION=1
         DATA     X'F0000018'  EXISTENCE FLAGS.
         DATA     IOERR1            ERROR ADDRESS
         DATA     RDABN             ABNORMAL ADDRESS
         DATA     0                 BUFFER ADDRESS
         DATA     0                 BUFFER SIZE
         DATA     0                 BLOCK
*
IWRTFPT  DATA     X'11000000'+M:EO
         DATA     X'FC000050'       EXISTANCE FLAGS
         DATA     EOERR             ERROR ADDRESS
         DATA     WRTABN            ABNORMAL ADDRESS
         DATA     0                 BUFFER ADDRESS
         DATA     0                 BUFFER SIZE
         GEN,1,31 1,M:EI+10         KEY ADDRESS
         DATA     0                 NO BYTE DISPLACEMENT
WFPTSIZE EQU      %-IWRTFPT         WRITE FPT SIZE
FPTEOD   GEN,8,7,17      X'91',0,R1
         DATA     X'34000000'
         DATA     %+3               BUFFER
         PZE      *R2               SIZE
         DATA     0                 NO DISPLACEMENT
         TEXT     '--EOD--ENCOUNTERED
'
PFIL     GEN,8,7,17      X'1C',0,M:EI
         DATA     X'10'
FPTREL   GEN,8,24 X'15',M:EO
         DATA     X'80000000'
         DATA     1
         PAGE
*TEST IF BLOCKING WANTED FOR ANS.  IF SO, ADD RECORD TO OUTPUT BLOCK.
BLKTEST  EQU      %
         AI,SR4   1                 BUMP IN CASE NO BLOCKING
         MTW,0    ANSBLK            TEST IF BLOCKING WANTED
         BEZ      *SR4              NO
         LI,R2    X'40'
         AND,R2   M:EO+5
         BNEZ     *SR4              U FORMAT
         AI,SR4   -1                RESTORE LINK REG
         LCI      11
         PSM,R1   *R7
         LW,R2    WRTFPT+5,R7       GET CURRENT SIZE
         AW,R2    ANSBLK+1          ADD NEW REC
         CW,R2    ANSBLK            IS BUFFER FULL
         BLE      BLK2              NO
         CAL1,1   WRTFPT,R7         WRITE BLOCK
         LW,R1    WRTFPT+4,R7
         SW,R1    R7
         SLS,R1   2
         STW,R1   BLKBUFF           INITIALIZE BLK BUFFER PTR
         LW,R2    ANSBLK+1          INITIALIZE WRITE SIZE
BLK2     EQU      %
         STW,R2   WRTFPT+5,R7       INCREMENT WRITE SIZE
         LW,R1    ANSBLK+1          CURRENT REC SIZE
         LW,R3    BLKBUFF           CURRENT BLOCK POINTER
         AWM,R1   BLKBUFF           UPDATE BLOCK POINTER
         LW,R2    D3                BUFFER DISPLACEMENT
         SLS,R2   2                 BYTE DISP
         BAL,SR4  MBS               MOVE RECORD TO BLOCK
         LCI      11
         PLM,R1   *R7
         B        *SR4
         PAGE
*CONVERT FORMAT  ON ANS TO ANS COPY IF REQUESTED.
ANSCVT   LW,SR1   ANSBLK+2          GET FORMAT CODE FOR CONVERSION
         BEZ      WRITE2            NONE
         LW,R5    RDFPT+4,R7        ADDRESS OF INPUT BUFFER
         CI,SR1   2                 TEST FORMAT CODE
         BE       DECCVT            D
         BAL,SR4  CVT1              V - GO CONVERT BLOCK SIZE
         AI,R5    1                 ADDRESS OF FIRST REC HEADER
         AI,R1    IOBUF
         AW,R1    R7                COMPUTE BLOCK LIMIT
         LW,D3    R1
CVT0     BAL,SR4  CVT1              GO CONVERT REC SIZE
         AW,R5    R1
         AI,R5    1                 ADDRESS OF NEXT REC HEADER
         CW,R5    D3                TEST FOR END OF BLOCK
         BL       CVT0              NO
         B        READ27            YES
DECCVT   BAL,SR4  CVT2              GO CONVERT D FMT BLK SIZE
         AI,R5    1                 ADDRESS OF FIRST REC HEADER
         AI,R3    IOBUF
         AW,R3    R7                COMPUTE BLOCK LIMIT
         LW,D3    R3
CVT4     BAL,SR4  CVT2              CONVERT REC SIZE
         AW,R5    R3
         AI,R5    1                 ADDRESS OF NEXT REC HEADER
         CW,R5    D3                TEST FOR END OF BLOCK
         BL       CVT4              NO
         B        READ27            YES
CVT1     PSW,SR4  *R7
         LH,R1    *R5               GET V VALUE
         PSW,R1   *R7
         BAL,SR4  BIN2BCD           CONVERT TO BCD
         PLW,R1   *R7
         AI,R1    3
         SLS,R1   -2
         STW,R3   0,R5              PUT CONVERSION IN HEADER
         PLW,SR4  *R7
         B        *SR4
CVT2     PSW,SR4  *R7
         LW,R1    R5
         SW,R1    R7
         SLS,R1   2                 BYTE DISP OF D VALUE
         LI,R2    4                 SIZE
         BAL,SR4  BCD2BIN           CONVERT TO BINARY
         STH,R3   *R5               PUT IN FIRST HALF OF HEADER
         AI,R3    3
         SLS,R3   -2                CONVERT TO WORDS
         B        *SR4
         PAGE
*UNBLOCK ANS TO NON-ANS.
UNBLK    LI,R2    3
         LB,R1    M:EI+5,R2         GET FORMAT CODE
         SLS,R1   -4
         B        UNBTAB,R1
UNBTAB   B        UNBF              F FORMAT
         B        UNBF              F FORMAT
         B        UNBD              D FORMAT
         B        UNBV              V FORMAT
         LCI      8                 SIGNAL NOT BLOCKED
         B        *SR4              U FORMAT - NO UNBLOCKING
*
UNBF     LW,R3    M:EI+18
         SLS,R3   -17               GET LRCSZ FROM DCB
         STW,R3   WRTFPT+5,R7       PUT IN WRITE FPT
         LW,R4    WRTFPT+4,R7       GET CURRENT WRITE ADR
         SLS,R4   2
         MTW,0    UNBADR            IS THIS FIRST BLOCK
         BEZ      %+4          YES
         AW,R4    R3                COMPUTE BYTE ADR FOR THIS WRITE
         LW,R5    WRTFPT+7,R7   GET LAST BTD USED
         AW,R4    R5           ADD TO GET BYTE ADDRESS.
         LI,R5    0
         SLD,R4   -2                COMPUTE WRITE ADR AND BTD
         SCS,R5   2
         STW,R5   WRTFPT+7,R7       STORE BTD
         STW,R4   WRTFPT+4,R7       STORE NEW WRITE ADR
UNBF2    AW,R3    UNBADR
         CW,R3    BLKSIZE           COMPARE DISP WITH BLK SIZE
         BL       %+3          NOT THRU UNBLOCKING
         LI,R3    0                 INDICATE END OF BLOCK
         STW,R3   WRTFPT+7,R7  SET BTD=0 FOR NEXT BLOCK.
         STW,R3   UNBADR            UPDATE FOR NEXT WRITE
         LCI      2                 SIGNAL BLOCKED
         B        *SR4
*
UNBD     LW,R1    UNBADR            ARE WE AT BEG OF BLOCK
         BNEZ     UNBD2             NO
         LW,R1    RDFPT+4,R7
         SW,R1    R7
         SLS,R1   2                 BYTE DISP OF BLK HEADER
         LI,R2    4                 SIZE
         PSW,SR4  *R7
         BAL,SR4  BCD2BIN           CONVERT BLK SIZE TO BINARY
         PLW,SR4  *R7
         AI,R3    3
         SLS,R3   -2                COMPUTE NO. WDS IN BLOCK
         STW,R3   BLKSIZE           SAVE BLOCK SIZE
         LW,R1    RDFPT+4,R7
         AI,R1    1
         STW,R1   UNBADR            ADR OF FIRST REC HEADER
UNBD2    SW,R1    R7
         SLS,R1   2                 BYTE DISP OF REC HEADER
         LI,R2    4                 SIZE
         PSW,SR4  *R7
         BAL,SR4  BCD2BIN           CONVERT REC SIZE TO BINARY
         PLW,SR4  *R7
         LW,R1    UNBADR
UNBD3    STW,R3   WRTFPT+5,R7       PUT SIZE IN WRITE FPT
         AI,R1    1
         STW,R1   WRTFPT+4,R7       PUT WRITE ADR IN FPT
         AI,R3    7
         SLS,R3   -2                COMPUTE NO. WDS IN RECORD
         B        UNBF2
*
UNBV     LW,R1    UNBADR            ARE WE AT BEG OF BLOCK
         BNEZ     UNBV2             NO
         LW,R1    RDFPT+4,R7
         LH,R2    *R1               GET BLOCK SIZE
         AI,R2    3
         SLS,R2   -2                COMPUTE NO. WDS IN BLOCK
         STW,R2   BLKSIZE
         AI,R1    1
         STW,R1   UNBADR            ADR OF FIRST REC HEADER
UNBV2    LH,R3    *R1               GET REC SIZE
         B        UNBD3
         PAGE
NCCHK    LW,R5    TOARG+9,R7
         CW,R5    =X'00100000'      CR SPECIFIED
         BANZ     *SR4              YES-EXIT
         LW,R1    DEVICE,R7
         CI,R1    8                 INPUT FROM TERMINAL
         BE       NCC4              YES
         CI,R5    X'20000'          NC OPTION PRESENT
         BAZ      *SR4              NO-EXIT
NCC4     LW,R5    WRTFPT+4,R7       GET LOCATION OF OUTPUT BUFFER
NCCHKX   AI,R3    0                 NULL RECORD
         BEZ      *SR4              YES
         AI,R3    -1
         LB,R1    *R5,R3            GET LAST BYTE OF RECORD
         CI,R1    X'15'             TEST IF CARRIAGE RETURN
         BE       NCC2              YES
         CI,R1    X'0D'
         BNE      NCC1
NCC2     LI,R1    ' '
         STB,R1   *R5,R3            STORE BLANK OVER CR
NCC1     AI,R3    1                 RESTORE RECORD SIZE
         B        *SR4              EXIT
*
NCS      LW,R1    WRTFPT+5,R7       RECORD SIZE
         CI,R1    80                IS RECORD BCD
         BLE      NCS1              YES
         STW,R0   IOBUF+27,R7       ZERO BINARY SEQ FIELD
         STW,R0   IOBUF+28,R7
         STW,R0   IOBUF+29,R7
         B        WRITE2
NCS1     LW,R1    ='    '           BLANK OUT SEQUENCE FIELD
         STW,R1   IOBUF+18,R7
         STW,R1   IOBUF+19,R7
         B        WRITE2
*
CS       BAL,SR4  SEQOUT            CONSTRUCT SEQUENCE INFO
         LW,R1    WRTFPT+5,R7
         BNEZ     CS%1
         LW,R2    RDFPT+4,R7
         LW,R1    X'40'        ADJUSTMENT FOR ZERO LENGTH RECORD.
         STB,R1   0,R2
         B        CS2
CS%1     EQU      %
         CI,R1    80
         BLE      CS2               BCD
         BAL,SR4  SEQOUTB           SEQUENCE BINARY
         B        WRITE2            GO TO WRITE
CS2      LW,R1    CARDSEQ,R7        PUT SEQUENCE INFO IN OUTPUT BUFFER
         STW,R1   IOBUF+18,R7
         LW,R1    CARDSEQ+1,R7
         STW,R1   IOBUF+19,R7
         LI,R2    80                SIZE OF BCD RECORD
         STW,R2   WRTFPT+5,R7
         B        WRITE2
*
LN       BAL,SR4  LINENUM           CONSTRUCT WRITE KEY
         BCS,8    WRITE2            GO TO WRITE
         B        RETURN            ERROR
*
SEQID    EQU      %-1
         B        NCS               NCS
         B        WRITE2            NLN
         B        CS                CS
         B        LN                LN
SEQID2   B        READ20            NONE
         B        READ21            NCS
         B        READ20            NLN
         B        READ18            CS
         B        READ15            LN
         PAGE
BRCHK    MTW,0    BREAK             TEST FOR BREAK
         BEZ      *SR4              NOT SET
         MTW,0    COPYSK
         BNEZ     *SR4              COPYALL
         MTW,0    COPYSTDF,R7
         BNEZ     *SR4              COPYSTD
         CAL1,1   WRTMSG            WRITE 'ENTER X...'
         CAL1,1   PROMPT
         CAL1,1   RDREPLY           READ REPLY
         CAL1,1   WRTCR             WRITE CR
         CAL1,1   PROMPTR
         LB,R3    BREAK
         STW,R0   BREAK             ZERO BREAK FLAG
         CI,R3    'X'
         BNE      *SR4              CONTINUE
         MTW,1    GRANCNT           SET ABORT FLAG
         B        RETURN            ABORT COPY
*
WRTMSG   GEN,8,24 X'11',M:UC
         DATA     X'34000000'
         DATA     BRKMSG
         DATA     29
         DATA     0
RDREPLY  GEN,8,24 X'10',M:UC
         DATA     X'30000000'
         DATA     BREAK
         DATA     1
WRTCR    GEN,8,24 X'11',M:UC
         DATA     X'34000000'
         DATA     BRKMSG
         DATA     1                 LENGTH
         DATA     0                 BTD
PROMPT   GEN,8,16,8     X'2C',0,'.'
PROMPTR  GEN,8,16,8     X'2C',0,'<'
BRKMSG   TEXT     '
--ENTER X TO ABORT COMMAND.
'
         PAGE
RDWRTCO  LW,R2    CODE,R7
         CW,R2    TOARG+5,R7        C OPTION ON BOTH INPUT AND OUTPUT
         BE       READ12            YES - ERROR
         MTW,0    SELECT,R7         RECORD SELECTION SPECIFIED
         BNEZ     READ13            YES - ERROR
         LW,R2    DEVICE,R7
         BNEZ     %+2          PCL DEVICE.
         LW,R2    DEV%IN,R7    SYSTEM INPUT DEVICE
         CI,R2    7            IS INPUT FROM ANS?
         BNE      READ1A       NO.
         CW,R2    TOARG,R7          ANS TO ANS COPY
         BE       READ32            YES - ERROR
         CW,R2    DEV%OUT,R7
         BE       READ32       SYSTEM OUTPUT DEVICE.
READ1A   EQU      %
         STW,R0   RECNUM,R7         INITIALIZE RECORD COUNT
         LI,D3    PRTBUF
         AW,D3    R7                ENTER OUTPUT BUFFER LOC FOR
         STW,D3   WRTFPT+4,R7       COMPRESSED IN FPT
         LI,R5    3
         CW,R5    CODE,R7           COMPRESSED OPTION ON INPUT
         BNE      READ7             NO
         CAL1,1   SETEIC            SET ERR AND ABN IN M:EI DCB
         LI,R1    RCERR1
         STW,R1   RDFPT+2,R7        CHANGE ERR ADR IN FPT
         LI,R1    RCERR
         STW,R1   RDFPT+3,R7        CHANGE ABN ADR IN FPT
         STW,R0   CISEQ,R7          INITIALIZE FOR CI SEQUENCE CHECK
         BAL,SR4  READCOMP          READ FIRST RECORD
         BCS,8    READ6
         BCS,2    READ30            END OF FILE
*
READ10   LI,R1    42
         MTW,0    IOERR,R7          DID I/O ERROR OCCUR
         BNEZ     RETURN            YES
READ11   EQU      %
         BAL,SR4  ERROR             NO - ERROR IN COMPRESSED INPUT
         B        RETURN
READ30   LW,R3    D4
         B        RDABN+1
READ32   LI,R1    56                INVALID OPTION FOR ANS TO ANS
         B        READ11
*
READ6    LI,R6    0                 CLEAR EOD COUNTER
         BAL,SR4  DECOMPR           DECOMPRESS INPUT RECORD
         BCS,8    RDWRTCO           END OF INPUT
         BCS,2    READ10            ERROR
         BAL,SR4  SETEOD
         STW,R3   WRTFPT+5,R7       RECORD SIZE TO FPT
         BAL,SR4  NCCHK             CHECK FOR NC OPTION
         LW,R1    TOARG+8,R7
         CI,R1    X'FF00'           WAS TX OPTION SPECIFIED
         BAZ      %+3               NO
         LI,R1    PRTBUF            BUFFER DISPLACEMENT
         BAL,SR4  TABEXP            EXPAND TABS
         LW,R1    TOARG+10,R7       GET SEQUENCE ID
         B        SEQID2,R1         MAKE APPROPRIATE BRANCH
READ18   BAL,SR4  SEQOUT            CONSTRUCT SEQUENCE INFO
         LW,R1    CARDSEQ,R7        MOVE SEQUENCE INFO TO BUFFER
         STW,R1   PRTBUF+18,R7
         LW,R1    CARDSEQ+1,R7
READ19   STW,R1   PRTBUF+19,R7
         LI,R3    80
         STW,R3   WRTFPT+5,R7       RECORD SIZE TO FPT
READ20   LI,R1    6
         CW,R1    TOARG+5,R7        HEX DUMP WANTED
         BNE      READ22            NO
         MTW,1    RECNUM,R7         INCREMENT RECORD COUNT
         BAL,SR4  HEXDUMP
         B        READ6
READ21   LW,R1    ='    '
         STW,R1   PRTBUF+18,R7      REMOVE SEQUENCING
         B        READ19
READ22   EQU      %
         LI,D3    PRTBUF            BUFFER ADR
         BAL,SR4  BLKTEST           TEST IF BLOCKING WANTED
         B        READ6             YES - GO GET NEXT RECORD
         LI,D3    PRTBUF
         AW,D3    R7
         STW,D3   WRTFPT+4,R7  SET BUFF ADDRESS
         LW,R1    TOARG+8,R7
         CW,R1    =X'00FF0000'
         BANZ     WRITE%5A     K OPTION USED.
         CAL1,1   WRTFPT,R7         WRITE RECORD
         BAL,SR4  BRCHK             CHECK BREAK FLAG
         B        READ6
READ15   BAL,SR4  LINENUM
         BCS,8    READ20
         B        RETURN            ERROR
*
READ7    LI,R2    29                ZERO CO BUFFER
         STW,R0   *D3,R2
         BDR,R2   %-1
         AI,D3    1
         STW,D3   COWORD,R7         INITIALIZE TO 2ND WORD OF BUFFER
         LW,R1    =X'38FF0000'
         STW,R1   PRTBUF,R7         INITIALIZE FIRST WORD OF BUFFER
         LI,R1    WCERR
         STW,R1   WRTFPT+2,R7       CHANGE ERR ADR IN FPT
         LI,R1    WCABN
         STW,R1   WRTFPT+3,R7       CHANGE ABN ADR IN FPT
         CAL1,1   SETEOC            SET ERR AND ABN IN M:EO DCB
         CAL1,1   SETBIN            SET BINARY MODE FOR OUTPUT
         LI,R1    32
         STW,R1   COBUSED,R7
         STW,R1   COBLEFT,R7
READ8    EQU      %
         CAL1,1   RDFPT,R7          READ INPUT
READ81   LW,R3    M:EI+4
         SLS,R3   -17               GET SIZE OF INPUT RECORD
         LI,R1    X'F'
         AND,R1   M:EI              GET ASN FIELD
         CI,R1    2                 INPUT FROM A DEVICE OR ANS
         BG       %+2               YES
         LW,R3    M:EI+13
         AI,R3    0
         BEZ      READ8             SKIP NULL RECORD
         LI,SR3   IOBUF             DEFAULT BUFFER ADR
         MTW,0    ANSBLK            BLOCKING WANTED FOR ANS
         BEZ      READ84            NO
         MTW,0    ANSBLK+1          WAS REC GIVEN
         BNEZ     READ86            YES
         STW,R3   ANSBLK+1          SET TO SIZE OF THIS RECORD
READ84   CI,R1    X'A'              IS INPUT FROM ANS
         BNE      READ86            NO
         STW,R3   BLKSIZE           YES - SET BLOCK SIZE
READ85   BAL,SR4  UNBLK             GO UNBLOCK
         BCS,8    READ86            NOT BLOCKED FORMAT
         LW,R5    WRTFPT+4,R7       LOC OF THIS RECORD
         LW,R3    WRTFPT+5,R7       SIZE
         AW,R3    WRTFPT+7,R7       +BTD
         B        READ87
READ86   EQU      %
         STW,R3   WRTFPT+5,R7       ENTER SIZE IN OUTPUT FPT
         LW,R5    RDFPT+4,R7
READ87   EQU      %
         BAL,SR4  NCCHKX            TEST FOR CR ON RECORD
         LW,R1    TOARG+8,R7
         CI,R1    X'FF00'           WAS TX OPTION SPECIFIED
         BAZ      READ82            NO
         LW,R1    SR3               BUFFER ADR
         BAL,SR4  TABEXP            EXPAND TABS
READ82   EQU      %
         BAL,SR4  SETEODR
         LI,R1    108
         STW,R1   WRTFPT+5,R7       SET SIZE OF OUTPUT RECORD
         BAL,SR4  COMPRESS          COMPRESS AND WRITE RECORD
         CI,D2    1
         BG       RETURN
         BAL,SR4  BRCHK             TEST FOR BREAK
         MTW,0    UNBADR            TEST IF UNBLOCKING ANS TAPE
         BNEZ     READ85            YES
         B        READ8
READ12   LI,R1    43                COMPRESSED ON INPUT AND OUTPUT
         B        READ11
READ13   LI,R1    44                RECORD SELECTION USED W/COMP
         B        READ11
SETBIN   GEN,8,24 X'22',M:EO
         DATA     X'10'
BINVAL   DATA     X'003C1C38',X'18000000'    STANDARD BINARY CODES
         PAGE
* SUBROUTINE READCOMP READS COMPRESSED INPUT.
READCOMP LCI      11
         PSM,R1   *R7
         MTW,0    UNBADR            TEST IF UNBLOCKING ANS TAPE
         BNEZ     RC206             YES
         CAL1,1   RDFPT,R7          READ RECORD
RC200    LW,R6    M:EI+4
         SLS,R6   -17
         LI,R5    X'F'
         AND,R5   M:EI              GET ASN FIELD
         CI,R5    2                 IS IT DEVICE OR ANS
         BG       %+2
         LW,R6    M:EI+13
         MTW,0    ANSBLK            ARE WE BLOCKING ANS TAPE
         BEZ      RC205             NO
         MTW,0    ANSBLK+1          WAS REC SPECIFIED
         BNEZ     RC207             YES
         STW,R6   ANSBLK+1          SET TO SIZE OF THIS REC
RC205    CI,R5    X'A'              IS INPUT FROM ANS
         BNE      RC207             NO
         LW,R2    RDFPT+4,R7
         STW,R2   WRTFPT+4,R7       RESET WRITE ADDRESS
         STW,R6   BLKSIZE           SET BLOCK SIZE
RC206    BAL,SR4  UNBLK             GO UNBLOCK
         BCS,8    RC207             NOT BLOCKED FORMAT
         LW,R6    WRTFPT+5,R7       GET RECORD SIZE
         CI,R6    80
         BLE      RC290             ERROR
         LW,SR3   WRTFPT+4,R7       ADR OF THIS RECORD
         SW,SR3   R7
         B        RC212
RC207    EQU      %
         CI,R6    80                CHECK LENGTH OF RECORD
         BG       RC210             OK
RC290    LCI      11                NOT COMPRESSED - MAKE ERROR EXIT
         PLM,R1   *R7
         LCI      0
         B        *SR4
*
RC210    LI,SR3   IOBUF             DEFAULT REC ADR
RC212    LW,R6    R7
         SLS,R6   2
         LB,R3    *SR3,R6           CHECK ID
         AND,R3   L(X'1F')
         CI,R3    X'18'
         BNE      RC290
         LB,R4    CISEQ,R6
         MTB,1    CISEQ,R6          CHECK SEQ
         LI,R3    1
         LW,R6    SR3               RECORD ADDRESS
         AW,R6    R7
         CB,R4    *R6,R3
         BNE      RC290
*
         LI,R3    2                 COMPUTE CHECKSUM
         LB,R5    *R6,R3            ORIGINAL TO R5
         LI,R4    0
         STB,R4   *R6,R3            ZERO BYTE IN RECORD
         LI,R3    3
         LB,R4    *R6,R3            GET BYTE COUNT IN R4
         AI,R4    -1                DECREMENT
         LB,R2    *R6               START SUM IN R2
         LB,R3    *R6,R4
         AW,R2    R3                ADD EACH BYTE
         BDR,R4   %-2               ITERATE
         AND,R2   L(X'FF')
         CW,R5    R2                CHECK ORIGINAL AGAINST NEW
         BNE      RC290
*
         LI,R3    3                 SET UP BIT COUNT FOR THIS RECORD
         LB,R4    *R6,R3
         SLS,R4   3
         STW,R4   CIBTOTAL,R7
         LI,R4    32                INITIALIZE CONTROL WORDS
         STW,R4   CIBUSED,R7
         STW,R4   CIBLEFT,R7
         LI,R4    IOBUF+1
         AW,R4    R7
         STW,R4   CIWORD,R7
         LCI      11
         PLM,R1   *R7
         LCI      8
         B        *SR4              EXIT
*
RCERR    LB,R1    SR3
         CI,R1    X'56'
         BE       RC200
         CI,R1    6
         BE       RCERR2
         CI,R1    5
         BE       RCERR2
RCERR1   LI,R1    0                 REPORT IO ERROR
         BAL,SR4  ERROR
         B        RC290
RCERR2   LW,D4    R1                SAVE ABN CODE
         LCI      11
         PLM,R1   *R7
         LCI      2
         B        *SR4
         PAGE
* SUBROUTINE DECOMPR RECONSTRUCTS A SYMBOLIC RECORD FROM COMPRESSED
* INPUT.
DECOMPR  LCI      7
         PSM,R5   *R7
         LI,R1    0                 START IN BYTE ZERO
         LW,SR2   CIBUSED,R7        INITIALIZE INPUT CONTROL WORDS
         LW,R4    CIBLEFT,R7
         LI,D4    PRTBUF-1
         AW,D4    R7
         LI,R2    35
         LW,R3    ='    '           BLANK OUTPUT BUFFER
         STW,R3   *D4,R2
         BDR,R2   %-1
         AI,D4    1
DEC10    LI,R6    6                 GET 6 BIT BYTE
         BAL,SR4  DEC60
         CI,R2    6                 IF CONTROL BYTE (0-6)
         BLE      DEC20,R2          EXECUTE JUMP TABLE
         CI,R2    44                IF NOT CONTROL, EXTRACT 8-BIT
         BL       DEC15             EBCDIC CODE FROM APPROPRIATE
         AI,R2    -43               TABLE.
         LB,R5    SCCTAB,R2
         B        %+2
DEC15    LB,R5    CITAB,R2
         STB,R5   *D4,R1            PUT CODE IN OUTPUT BUFFER
         AI,R1    1                 ITERATE
*                                   ** CONTROL BYTE TABLE **
DEC20    B        DEC10             PADDING
         B        DEC10             UNASSIGNED
         B        DEC30             EOL
         B        DEC35             EOF
         B        DEC40             NEXT 8 BIT
         B        DEC45             NEXT COUNT+1
         B        DEC50             NEXT COUNT +65
*
DEC30    STW,SR2  CIBUSED,R7        RESTORE CONTROL WORDS
         STW,R4   CIBLEFT,R7
         LCI      7
         PLM,R5   *R7
         LCI      0                 SIGNAL EOL
         B        *SR4              EXIT
*
DEC35    STW,SR2  CIBUSED,R7        RESTORE CONTROL WORDS
         STW,R4   CIBLEFT,R7
         LI,R1    IOERR1
         STW,R1   RDFPT+2,R7        RESET ERR ADR IN READ FPT
         LI,R1    RDABN
         STW,R1   RDFPT+3,R7        RESET ABN ADR IN READ FPT
         LCI      7
         PLM,R5   *R7
         LCI      8                 SIGNAL EOF
         B        *SR4              EXIT
*
DEC40    LI,R6    8                 GET 8 BIT CODE FROM IOBUF
         BAL,SR4  DEC60
         STB,R2   *D4,R1            PUT IN OUTPUT BUFFER
         AI,R1    1
         B        DEC10             ITERATE
*
DEC45    LI,R6    6                 USE 6 BIT COUNT
         BAL,SR4  DEC60
         AI,R2    1                 +1
DEC47    LI,R5    ' '
         STB,R5   *D4,R1            EXPAND BLANK FIELD IN BUFFER
         AI,R1    1
         BDR,R2   %-2
         B        DEC10             ITERATE
*
DEC50    LI,R6    6                 USE 6 BIT COUNT
         BAL,SR4  DEC60
         AI,R2    65                +65
         B        DEC47
*
DEC60    AW,SR2   R6                EXTRACT (R6) BITS
         CW,SR2   CIBTOTAL,R7       ENOUGH LEFT IN CURRENT RECORD
         BLE      DEC65             YES
         LW,R5    SR4
         BAL,SR4  READCOMP          READ NEXT RECORD
         BCR,8    DEC75             MUST BE COMPRESSED. BR IF NOT
         LW,SR4   R5
         LW,SR2   CIBUSED,R7
         LW,R4    CIBLEFT,R7
         B        DEC60
*
DEC65    LI,R2    0                 INITIALIZE RESULT REGISTER
         LW,R5    CIWORD,R7         GET BUFFER POINTER
         LW,R3    0,R5              PICK UP CURRENT WORD
         SW,R4    R6                CHECK IF R3 CONTAINS TOTAL BYTE
         BGEZ     DEC67             BR IF YES
         AW,R6    R4                COMPUTE NO. OF BITS IN R3
         SLD,R2   0,R6              AND SHIFT TO R2
         AI,R5    1
         STW,R5   CIWORD,R7         INCREMENT BUFFER POINTER
         LW,R3    0,R5              GET WORD FROM BUFFER
         LCW,R4   R4                GET NO. BITS NEEDED FROM R3
         SLD,R2   0,R4              SHIFT INTO R2
         AI,R4    -32               COMPUTE BITS LEFT IN CURRENT WORD
         LCW,R4   R4
         B        DEC70
DEC67    SLD,R2   0,R6              SHIFT TOTAL BYTE TO R2
DEC70    STW,R3   0,R5              PUT CURRENT WORD BACK
         B        *SR4              EXIT
*
DEC75    LCI      7
         PLM,R5   *R7
         LCI      2                 SET ERROR FLAG
         B        *SR4              EXIT
         PAGE
* SUBROUTINE COMPRESS PRODUCES A COMPRESSED OUTPUT RECORD AND WRITES IT.
COMPRESS LCI      7
         PSM,R5   *R7
         LI,SR1   0                 SET BLANK COUNT ZERO
         LW,SR2   COBUSED,R7        PICK UP CONTROL WORDS
         LW,R4    COBLEFT,R7
         LW,R1    RECSIZE,R7        CHECK RECORD SIZE
         BGZ      CMP10             ZERO IMPLIES END OF OUTPUT FILE
         LI,R5    CEOF              EDIT EOF CONTROL BYTE
         LI,R6    6                 IN 6 BITS
         BAL,SR4  CMP60
         LW,R1    PRTBUF,R7         CHANGE ID FROM X'38'
         AND,R1   =X'18FFFFFF'      TO X'18' FOR LAST CO RECORD
         STW,R1   PRTBUF,R7
         BAL,SR4  WRITECO           WRITE LAST RECORD
CMP5     STW,R4   COBLEFT,R7        RESTORE CONTROL WORDS
         STW,SR2  COBUSED,R7
         LCI      7
         PLM,R5   *R7
         B        *SR4              EXIT
*
CMP10    LI,R1    0                 COMPRESS STARTING AT BYTE ZERO
         LI,D4    IOBUF             COMPUTE BUFFER ADDRESS
         AW,D4    R7
CMP11    LB,R5    *D4,R1            GET NEXT BYTE
         CI,R5    X'C0'             CHECK FOR A-Z,0-9
         BLE      CMP15             CANT BE IF LESS THAN X'C0'
         AND,R5   =X'3F'
         LB,R5    COTAB,R5          GET 6 BIT COMPRESSED CODE
         BNEZ     CMP12
         LB,R5    *D4,R1            ZERO, USE ORIGINAL 8 BITS
         B        CMP17
*
CMP12    LI,R6    6                 SET BIT COUNT
         BAL,SR4  CMP60             ENTER IN OUTPUT BUFFER
CMP13    AI,R1    1                 POSITION TO NEXT BYTE
         CW,R1    RECSIZE,R7        STOP AT END OF RECORD
         BL       CMP11
         AI,R1    -80
         BGEZ     CMP14             OUTPUT NOT LESS THAN 80 BYTES
         LCW,R1   R1                PAD TO 80 BYTES
         AW,SR1   R1
CMP14    LI,R5    CEOL              ADD EOL TO RECORD
         LI,R6    6
         BAL,SR4  CMP60
         B        CMP5
*
CMP15    LB,R6    SCCTAB            NOT A-Z,0-9
         CB,R5    SCCTAB,R6
         BE       CMP20             CHECK SPECIAL 6 BIT CODES
         BDR,R6   %-2
         CI,R5    ' '
         BE       CMP25             BLANK
CMP17    STW,R5   ATTRB,R7          8-BIT CHAR MUST BE OUTPUT
         LI,R5    CNEXT8
         LI,R6    6
         BAL,SR4  CMP60             OUTPUT 6 BIT CONTROL CHARACTER
         LW,R5    ATTRB,R7
         LI,R6    8
         BAL,SR4  CMP60             OUTPUT 8 BIT CHARACTER
         B        CMP13             ITERATE
*
CMP20    AI,R6    43                FOUND IN SCCTAB
         LW,R5    R6                CODE IS INDEX+43
         B        CMP12
CMP25    AI,SR1   1                 ACCUMULATE BLANK
         B        CMP13
*
*
CMP60    PSW,SR4  *R7
         AI,SR1   0                 IS BLANK COUNT ZERO
         BGZ      CMP65             NO
CMP62    BAL,SR4  CMP70
         PLW,SR4  *R7
         B        *SR4
*
CMP65    LCI      2
         PSM,R5   *R7
         LI,R5    CBLANK
         LI,R6    6                 ENTER BLANK IN 6 BITS
         AI,SR1   -1
         BEZ      CMP68             ONLY ONE BLANK
         LI,R5    CNBC1
         CI,SR1   63
         BLE      CMP67             <=64 BLANKS, ENTER COUNT+1
         LI,R5    CNBC65            ENTER COUNT+65
         AI,SR1   -64               ADJUST COUNT
CMP67    BAL,SR4  CMP70             OUTPUT CONTROL BYTE
         LW,R5    SR1               GET COUNT
CMP68    BAL,SR4  CMP70             OUTPUT COUNT
         LCI      2
         PLM,R5   *R7
         LI,SR1   0                 SET NO. OF BLANKS TO ZERO
         B        CMP62             OUTPUT ORIGINAL BYTE
*
*
CMP70    LW,R2    R5                POSITION BYTE IN EVEN REGISTER
         AW,SR2   R6                INCREMENT TOTAL BIT COUNT
         CI,SR2   COBTOTAL
         BLE      CMP73             CAN FIT IN CURRENT RECORD
         PSW,SR4  *R7
         SW,SR2   R6                RESTORE PREVIOUS BIT COUNT
         LI,D3    PRTBUF            BUFFER ADR
         BAL,SR4  BLKTEST           GO TEST IF BLOCKING WANTED
         B        %+2               YES - SKIP WRITE
         BAL,SR4  WRITECO           WRITE RECORD
         PLW,SR4  *R7
         LI,SR2   32
         LI,R4    32
         MTW,0    IOERR,R7          DID IO ERROR OCCUR
         BEZ      CMP70             NO
         B        CMP5              YES - EXIT
CMP73    LW,R5    COWORD,R7         GET BUFFER POINTER
         SW,R4    R6
         BGEZ     CMP75             BYTE WILL FIT IN CURRENT CO WORD
         LI,R3    0
         SLD,R2   0,R4              ADJUST NUMBER OF BITS WHICH WILL FIT
         AWM,R2   0,R5              ENTER IN CO WORD
         MTW,1    COWORD,R7
         AWM,R3   1,R5              PUT OVERFLOW BITS IN NEXT WORD
         AI,R4    32                NUMBER OF BITS LEFT IN CO WORD
         B        *SR4              EXIT
CMP75    SLS,R2   0,R4              POSITION BYTE
         AWM,R2   0,R5              ENTER IN CO WORD
         B        *SR4              EXIT
         PAGE
* SUBROUTINE SETEOD FINDS COLUMN OF LAST NON-BLANK AND SETS RECSIZE
* TO TRUE BYTE COUNT.
SETEOD   LI,R2    PRTBUF            MAKE GROSS COMPARISON
         AW,R2    R7
         LI,R3    MAXCLMN/4-1
         LW,R4    ='    '
         CW,R4    *R2,R3
         BNE      %+2
         BDR,R3   %-2
*
         SLS,R3   2                 REVERT TO BYTE INDEXING
         AI,R3    3
SRS5     CB,R4    *R2,R3            ITERATE THROUGH BYTES OF WORD
         BNE      %+2
         BDR,R3   %-2
         AI,R3    1
         STW,R3   RECSIZE,R7        SAVE TRUE RECORD SIZE
         B        *SR4              EXIT
*
SETEODR  LW,R2    RDFPT+4,R7        BUFFER ADDRESS
         LW,R3    WRTFPT+5,R7       SIZE
         AI,R3    -1                ADJUST FOR INDEXING
         LI,R4    X'40'
         B        SRS5              GO STRIP TRAILING BLANKS
         PAGE
* SUBROUTINE WRITECO APPENDS CONTROL INFO. TO BUFFER AND WRITES
* COMPRESSED RECORD.
WRITECO  LCI      11
         PSM,R1   *R7
         AI,SR2   7                 COMPUTE NO. OF BYTES
         SLS,SR2  -3                FROM BIT COUNT
         LI,R5    3
         LI,D3    PRTBUF            GET BUFFER LOCATION
         AW,D3    R7
         STB,SR2  *D3,R5            PUT IN BUFFER
         LI,R5    1
         MTB,1    *D3,R5            INCREMENT SEQUENCE
         CI,SR2   4
         BLE      WRCO10            BYTE CNT NOT GR 4 - DONT WRITE
         LB,R5    *D3
         LW,R2    SR2
         AI,R2    -1
         LB,R6    *D3,R2            GET ALL BYTES
         AW,R5    R6                FORM CHECKSUM
         BDR,R2   %-2
         LI,R6    2
         STB,R5   *D3,R6            PUT IN BUFFER
         LW,R1    TOARG+10,R7       SEQUENCE OPTION SPECIFIED
         AI,R1    -3
         BLZ      WRCO5             NLN OR NCS OR NONE
         BGZ      WRCO30            LN
         BAL,SR4  SEQOUT            PREPARE SEQUENCE INFORMATION
         BAL,SR4  SEQOUTB           SEQUENCE RECORD
WRCO5    CAL1,1   WRTFPT,R7         WRITE RECORD
*
WRCO10   AI,D3    1
         STW,D3   COWORD,R7         INITIALIZE POINTER
         LI,R4    1
         LI,R6    0
         AI,D3    -1
         STH,R6   *D3,R4
         LI,R4    29                ZERO BUFFER
         STW,R6   *D3,R4
         BDR,R4   %-1
WRCO20   LCI      11
         PLM,R1   *R7
         B        *SR4
WRCO30   BAL,SR4  LINENUM           CONSTRUCT EDIT KEY
         BCS,8    WRCO5
         LI,R1    45                OVERFLOW OF MAX VALUE
         B        WCERR+1
*
WCABN    LB,R1    SR3
         CI,R1    X'1C'
         BE       WRTABN
WCERR    LI,R1    0
         BAL,SR4  ERROR
         B        WRCO20
         PAGE
SCCTAB   TEXTC    '.<(+|&%*);~-/,%>:''='    SPECIAL 6-BIT CHARACTERS
CITAB    EQU      %-1
         TEXT     '    0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
COTAB    DATA,1   0,18,19,20,21,22,23,24,25,26,0,0,0,0,0,0,;
                  0,27,28,29,30,31,32,33,34,35,0,0,0,0,0,0,;
                   0,0,36,37,38,39,40,41,42,43,0,0,0,0,0,0,;
                   8,9,10,11,12,13,14,15,16,17,0,0,0,0,0,0
SETEIC   GEN,8,7,17      X'06',0,M:EI
         DATA     X'C0000000'
         DATA     RCERR
         DATA     RCERR
SETEOC   GEN,8,7,17      X'06',0,M:EO
         DATA     X'C0000000'
         DATA     WCERR
         DATA     WCERR
         PAGE
* SUBROUTINE LINENUM CONSTRUCTS A WRITE KEY FROM THE CURRENT
* LINE NUMBER.
LINENUM  LW,R1    TOARG+12,R7
         CW,R1    TOARG+14,R7
         BG       LINE20            GR THAN MAX
         OR,R1    =X'03000000'      CONSTRUCT KEY
         STW,R1   KEY,R7
         LW,R1    TOARG+13,R7       INCREMENT FOR NEXT KEY
         AWM,R1   TOARG+12,R7
         LCI      8
         B        *SR4              EXIT
LINE20   PSW,SR4  *R7
         LI,R1    46
         BAL,SR4  ERROR
         PLW,SR4  *R7
         LCI      0                 ERROR FLAG
         B        *SR4
         PAGE
* SUBROUTINE TABEXP EXPANDS EMBEDDED TAB CHARACTERS IN A RECORD
* WHENEVER THE OUTPUT OPTION TX IS SPECIFIED. R1 CONTAINS BUFFER
* DISPLACEMENT RELATIVE TO R7.
TABEXP   LCI      7
         PSM,R5   *R7
         AW,R1    R7                COMPUTE ACTUAL BUFFER ADDRESS
         LI,R5    0                 START AT FIRST TAB
         LI,R6    0                 START AT FIRST CHAR IN BUFFER
         LW,SR1   TABSET+4,R7       GET TAB TABLE ADDRESS
         LI,R2    X'05'
         LI,SR2   ' '
         MTW,-1   WRTFPT+5,R7       DISPLACEMENT OF LAST CHAR IN RECORD
         BLZ      TAB8              NULL RECORD
TAB5     CB,R2    *R1,R6            TEST FOR TAB CHARACTER
         BE       TAB10
TAB6     AI,R6    1                 POSITION TO NEXT CHAR IN BUFFER
         CW,R6    WRTFPT+5,R7
         BLE      TAB5
TAB8     MTW,1    WRTFPT+5,R7       SET TRUE RECORD SIZE
         LCI      7                 END OF BUFFER - EXIT
         PLM,R5   *R7
         B        *SR4
*
TAB10    STB,SR2  *R1,R6            STORE BLANK OVER TAB CHAR
         AI,SR1   0                 WERE TABS SPECIFIED
         BEZ      TAB6              NO
TAB12    LB,R3    *SR1,R5           GET TAB VALUE
         BNEZ     TAB15
TAB13    LI,SR1   0                 NO MORE VALUES
         B        TAB6
TAB15    AI,R3    -1                IS THIS TAB POSITION GREATER THAN
         CW,R3    R6                POSITION OF TAB CODE
         BG       TAB17
         AI,R5    1                 NO - TRY NEXT TAB POSITION
         CI,R5    16
         BL       TAB12
         B        TAB13             MAX NUM OF TABS
TAB17    AI,R6    1                 INCREMENT TO NEXT CHAR IN BUFFER
         LW,R4    WRTFPT+5,R7       DETERMINE LAST CHAR POSITION
         SW,R3    R6                COMPUTE NUMBER OF BLANKS TO INSERT
         BEZ      TAB5              NONE
         AW,R3    R4                INCREMENT TO NEW LAST CHAR
         STW,R3   WRTFPT+5,R7       SET NEW RECORD SIZE
TAB19    LB,SR3   *R1,R4            GET LAST CHAR OF RECORD
         STB,SR2  *R1,R4            BLANK THIS CHAR IN RECORD
         STB,SR3  *R1,R3            MOVE CHAR UP TO NEW POSITION
         AI,R3    -1
         AI,R4    -1
         CW,R4    R6                GO TO CHAR JUST ABOVE TAB BLANK
         BGE      TAB19
         LW,R6    R3                INC CHAR POSITION TO LAST MOVED
         AI,R5    1                 INC TAB TABLE POINTER
         B        TAB5              LOOK FOR MORE TABS
         PAGE
* SUBROUTINE SEQOUT CONSTRUCTS SEQUENCE INFORMATION IN LOCATION
* CARDSEQ.
SEQOUT   LCI      7
         PSM,R5   *R7
         LW,R1    TOARG+12,R7       GET SEQUENCE NUMBER
         CW,R1    TOARG+14,R7
         BLE      SEQOUT1
         LW,R1    TOARG+11,R7       NCHAR IN SEQ ID
         LW,R2    CARDSEQ,R7
         AND,R2   ANDTBL,R1
         OR,R2    ORTBL,R1
         STW,R2   CARDSEQ,R7        RESET 1ST WORD OF SEQ INFO
         LI,R1    0                 GR THAN MAX - REVERT TO 0
         STW,R1   TOARG+12,R7
SEQOUT1  BAL,SR4  BIN2BCD           CONVERT TO BCD
         OR,R3    ORTBL
         STW,R3   CARDSEQ+1,R7      ENTER LAST 4 CHARS
         AI,R4    -4
         BLEZ     SEQOUT2
         LI,R3    3                 GR THAN 4 CHARS
         LI,R5    CARDSEQ
         AW,R5    R7
         LB,R1    R2,R3             ENTER REST OF NUMBER
         STB,R1   *R5,R3
         AI,R3    -1
         BDR,R4   %-3               LOOP ON SIGNIFICANT DIGITS -4
SEQOUT2  LW,R1    TOARG+13,R7
         AWM,R1   TOARG+12,R7       INCREMENT SEQUENCE NUMBER
         LCI      7
         PLM,R5   *R7
         B        *SR4              EXIT
ANDTBL   DATA     0,X'FF000000',X'FFFF0000',X'FFFFFF00',X'FFFFFFFF'
ORTBL    DATA     X'F0F0F0F0',X'00F0F0F0',X'0000F0F0',X'000000F0',0
         PAGE
* SUBROUTINE SEQOUTB CONVERTS SEQUENCE INFO IN LOCATION CARDSEQ TO
* BINARY FORMAT AND ENTERS IT IN THE LAST 3 WORDS OF THE OUTPUT
* BUFFER.
SEQOUTB  LCI      4
         PSM,R5   *R7
         LW,R5    WRTFPT+4,R7
         STW,R0   27,R5             ZERO SEQUENCE FIELD OF BUFFER
         STW,R0   28,R5
         STW,R0   29,R5
         LI,SR1   CARDSEQ
         AW,SR1   R7                LOCATION OF CARDSEQ
         LI,R6    8
         LI,R1    7                 BYTE DISP IN CARDSEQ
SEQ100   LI,R3    0
         LB,R2    *SR1,R1           GET BYTE FROM CARDSEQ
         LH,R2    CCTAB,R2          GET CONVERTED VALUE
         AND,R2   =X'00000FFF'      MASK OUT FLAG BITS
         EXU      SHIFT,R1          POSITION IN R2-R3
         LB,R4    R4TAB,R1          SET R4 TO BUFFER DISP
         AWM,R2   *R5,R4            ENTER VALUE IN BUFFER
         AI,R4    1
         AWM,R3   *R5,R4
         AI,R1    -1
         BDR,R6   SEQ100            LOOP TO CONVERT 8 BYTES
         LI,R1    120
         STW,R1   WRTFPT+5,R7       SET RECORD SIZE IN FPT
         LCI      4
         PLM,R5   *R7
         B        *SR4              EXIT
*
SHIFT    SLS,R2   20
         SLS,R2   8
         SLD,R2   -4
         SLS,R2   16
         SLS,R2   4
         SLD,R2   -8
         SLS,R2   12
         NOP
*
R4TAB    DATA,1   27,27,27,28,28,28,29,29
         PAGE
CCTAB    EQU      %
         DATA,2   X'8B03',X'8901',X'8881',X'8841',X'8821',X'8811'
         DATA,2   X'8809',X'8805',X'8803',X'8903',X'8883',X'8843'
         DATA,2   X'8823',X'8813',X'880B',X'8807',X'8D03',X'8501'
         DATA,2   X'8481',X'8441',X'8421',X'8411',X'8409',X'8405'
         DATA,2   X'8403',X'8503',X'8483',X'8443',X'8423',X'8413'
         DATA,2   X'840B',X'8407',X'8703',X'8301',X'8281',X'8241'
         DATA,2   X'8221',X'8211',X'8209',X'8205',X'8203',X'8303'
         DATA,2   X'8283',X'8243',X'8223',X'8213',X'820B',X'8207'
         DATA,2   X'8F03',X'8101',X'8081',X'8041',X'8021',X'8011'
         DATA,2   X'8009',X'8005',X'8003',X'8103',X'8083',X'8043'
         DATA,2   X'8023',X'8013',X'800B',X'8007',X'0000',X'8B01'
         DATA,2   X'8A81',X'8A41',X'8A21',X'8A11',X'8A09',X'8A05'
         DATA,2   X'8A03',X'8902',X'8882',X'0000',X'0822',X'0000'
         DATA,2   X'080A',X'0806',X'0800',X'8D01',X'8C81',X'8C41'
         DATA,2   X'8C21',X'8C11',X'8C09',X'8C05',X'8C03',X'8502'
         DATA,2   X'8482',X'0442',X'0422',X'0000',X'0000',X'8406'
         DATA,2   X'0400',X'0000',X'8681',X'8641',X'8621',X'8611'
         DATA,2   X'8609',X'8605',X'8603',X'8302',X'8C00',X'0000'
         DATA,2   X'0222',X'8212',X'020A',X'8206',X'8E00',X'8F01'
         DATA,2   X'8E81',X'8E41',X'8E21',X'8E11',X'8E09',X'8E05'
         DATA,2   X'8E03',X'8102',X'0082',X'0042',X'0022',X'0012'
         DATA,2   X'000A',X'8006',X'8B02',X'8B00',X'8A80',X'8A40'
         DATA,2   X'8A20',X'8A10',X'8A08',X'8A04',X'8A02',X'8A01'
         DATA,2   X'8A82',X'8A42',X'8A22',X'8A12',X'8A0A',X'8A06'
         DATA,2   X'8D02',X'8D00',X'8C80',X'8C40',X'8C20',X'8C10'
         DATA,2   X'8C08',X'8C04',X'8C02',X'8C01',X'8C82',X'8C42'
         DATA,2   X'8C22',X'8C12',X'8C0A',X'8C06',X'8702',X'8700'
         DATA,2   X'8680',X'8640',X'8620',X'8610',X'8608',X'8604'
         DATA,2   X'8602',X'8601',X'8682',X'8642',X'8622',X'8612'
         DATA,2   X'860A',X'8606',X'8F02',X'8F00',X'8E80',X'8E40'
         DATA,2   X'8E20',X'8E10',X'8E08',X'8E04',X'8E02',X'8E01'
         DATA,2   X'8E82',X'8E42',X'8E22',X'8E12',X'8E0A',X'8E06'
         DATA,2   X'8A00',X'0900',X'0880',X'0840',X'0820',X'0810'
         DATA,2   X'0808',X'0804',X'0802',X'0801',X'8A83',X'8A43'
         DATA,2   X'8A23',X'8A13',X'8A0B',X'8A07',X'8600',X'0500'
         DATA,2   X'0480',X'0440',X'0420',X'0410',X'0408',X'0404'
         DATA,2   X'0402',X'0401',X'8C83',X'8C43',X'8C23',X'8C13'
         DATA,2   X'8C0B',X'8C07',X'8282',X'8701',X'0280',X'0240'
         DATA,2   X'0220',X'0210',X'0208',X'0204',X'0202',X'0201'
         DATA,2   X'8683',X'8643',X'8623',X'8613',X'860B',X'8607'
         DATA,2   X'0200',X'0100',X'0080',X'0040',X'0020',X'0010'
         DATA,2   X'0008',X'0004',X'0002',X'0001',X'8E83',X'8E43'
         DATA,2   X'8E23',X'8E13',X'8E0B',X'8E07'
         END

